! Copyright 2008-2021 Earth Sciences Department, BSC-CNS
!
! This file is part of MONARCH.
!
! MONARCH is free software: you can redistribute it and/or modify
! it under the terms of the GNU General Public License as published by
! the Free Software Foundation, either version 3 of the License, or
! (at your option) any later version.
!
! MONARCH is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
! GNU General Public License for more details.
!
! You should have received a copy of the GNU General Public License
! along with MONARCH. If not, see <http://www.gnu.org/licenses/>.
!-----------------------------------------------------------------------
                        module module_BSC_SPINUP_DUST
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

use module_kinds

USE MODULE_EXCHANGE,ONLY: HALO_EXCH

use module_dm_parallel,only : dstrb

implicit none

!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
                        contains
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++


!-----------------------------------------------------------------------
                        subroutine couple_spinup_dust &
      (kss,couple_netcdf &
      ,sp &
      ,num_tracers_total,tracers &
      ,num_tracers_chem &
      ,num_aero &
      ,couple_dust,adiabatic &
      ,num_gas_total &
      ,cat_aero &
      ,ids,ide,jds,jde &
      ,ims,ime,jms,jme &
      ,its,ite,jts,jte &
      ,lm &
      ,my_domain_id &
      ,mype_share,mpi_comm_comp &
       )

!-----------------------------------------------------------------------
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!-----------------------------------------------------------------------
!
      use netcdf
      implicit none
!
!-----------------------------------------------------------------------
!       
integer(kind=kint),intent(in) :: &
       ids,ide,jds,jde &
      ,ims,ime,jms,jme &
      ,its,ite,jts,jte &
      ,lm &
      ,my_domain_id &
      ,mype_share,mpi_comm_comp

logical(kind=klog),intent(in) :: &
 couple_dust &
,couple_netcdf &
,adiabatic
!
integer(kind=kint),intent(in) :: &
 num_aero &
,num_tracers_chem &
,num_tracers_total &
,num_gas_total &
,cat_aero &
,kss    

real(kind=kfpt),dimension(ims:ime,jms:jme,1:lm,1:num_tracers_total),intent(out) :: &
 tracers

real(kind=kfpt),dimension(ims:ime,jms:jme,1:lm,kss:num_tracers_total),intent(out) :: &
 sp

!-----------------------------------------------------------------------
!--local variables------------------------------------------------------
!-----------------------------------------------------------------------
!
integer(kind=kint) :: &
 i &
,j &
,l &                         ! index in p direction
,n

integer(kind=kint) :: &      ! number of soil levels
 nsoil

logical(kind=klog) :: &
 opened

real(kind=kfpt),allocatable,dimension(:,:) :: &
 tempdust

integer(kind=kint) :: skip2,mype

character*100 :: couplefile,message

integer(kind=kint) :: stat,input_id,varid

character*3 :: num_var

character*11 :: name_variable

!
!-----------------------------------------------------------------------
!
        mype=mype_share

!
        ALLOCATE(tempdust(IDS:IDE,JDS:JDE),STAT=I)
!
!-----------------------------------------------------------------------
!
!
netcdf_if: if(couple_netcdf)then
!
          write(couplefile,'(a,i2.2,a)')'history_INIT_TRACERS_d',my_domain_id,'.hhh.nc'
          if(mype==0)then
            write(0,*) 'Open ',trim(couplefile)
            stat = nf90_open(couplefile,nf90_nowrite,input_id)
            message='open netcdf file '//trim(couplefile)
            call check_stat(stat,message)
          endif
!
          if(mype==0)then
            print*,'SPINUP TRACERS AEROSOLS AND GASES'
          endif
!
          do n=num_tracers_total-num_tracers_chem+1,num_tracers_total
            do l=1,lm
              if(mype==0)then
                write(num_var,'(I3.3)')n
                name_variable='TRACERS_'//num_var
                stat = nf90_inq_varid(input_id,name_variable,varid)
                message='inquire varid '//trim(name_variable)
                call check_stat(stat,message)
                stat = nf90_get_var(input_id,varid,tempdust,start=(/1,1,l/),count=(/IDE,JDE,1/))
                message='get_var '//trim(name_variable)
                call check_stat(stat,message)
              endif
              do j=jms,jme
                do i=ims,ime
                  tracers(i,j,l,n)=0.
                enddo
              enddo
              call dstrb(tempdust,tracers(:,:,:,n),1,1,1,lm,l,mype,mpi_comm_comp)
            enddo
            call halo_exch(tracers(ims:ime,jms:jme,1:lm,n),lm,2,2)
          enddo
!
          if(mype==0)then
             stat=nf90_close(input_id)
             message='close file '//trim(couplefile)
             call check_stat(stat,message)
          endif
!
        else
!
        couplefile='history_INIT.hhh'
        if(mype==0)then
        open(unit=31,file=couplefile,status='old',access='sequential'       &
            ,form='unformatted')
        endif
!
!-----------------------------------------------------------------------
!
        nsoil=4
!
        if(.not.adiabatic) then
             skip2=171+11*lm+lm+1+10*lm+3*nsoil
        elseif(adiabatic) then
             print *,'WARNING COUPLE_SPINUP_TRACER ADIABATIC OPTION NOT READY'
        endif

        if(mype==0)then
          print*,'COUPLE_SPINUP_AEROSOL skip: ',skip2
          do n=1,skip2
            read(31)
          enddo
        endif

        do l=1,num_aero
          if(mype==0)then
            read(31) tempdust                                    ! AERO_ACPREC
          endif
        enddo

        do l=1,num_aero
          if(mype==0)then
            read(31) tempdust                                    ! AERO_CUPREC
          endif
        enddo

        do l=1,num_aero
          if(mype==0)then
            read(31) tempdust                                    ! AERO_DEPDRY
          endif
        enddo

!AOD CALCULATED IN RRTM. TOTAL OF 6 AEROSOLS: DU,SS,OM,BC,SU,TOTAL NEEDS TO BE FIXED TO 6
!IF NOT BSC THIS 6 DIMENSION COMES FROM GOCART
       do l=1,6
          if(mype==0)then
            read(31) tempdust                                      !AERO_AOD_R 
          endif
       enddo

!        do l=1,lm
!          if(mype==0)then
!            read(31) tempdust                                    ! DUST_EXT
!          endif
!        enddo
        do l=1,num_aero
          if(mype==0)then
            read(31) tempdust                                    ! DLOAD
          endif
        enddo

        do l=1,num_aero
          if(mype==0)then
            read(31) tempdust                                    ! EMISS_AERO
          endif
        enddo

!        do l=1,num_aero
!          if(mype==0)then
!            read(31) tempdust                                    ! AERO02
!          endif
!        enddo

      if(num_gas_total==0)then
        if(mype==0)then
          read(31) !adrydep gas
          read(31) !wetdep gas
        endif
      else
        do l=1,num_gas_total
          if(mype==0)then
            read(31) tempdust                                    ! ADRYDEP GAS
          endif
        enddo

        do l=1,num_gas_total
          if(mype==0)then
            read(31) tempdust                                    ! WETDEP GAS
          endif
        enddo

      endif

        do l=1,lm
          if(mype==0)then
            read(31) tempdust                                    !PHOT GAS
          endif
        enddo

!TRACERS ARRAY IS STORED FROM 4 TO END      
        do n=4,num_tracers_total-num_tracers_chem                !SKIP met tracers and water array
        do l=1,lm
          if(mype==0)then
            read(31) tempdust
          endif
        enddo
        enddo

        do n=num_tracers_total-num_tracers_chem+1,num_tracers_total 
        do l=1,lm
          if(mype==0)then
            read(31) tempdust
          endif
          do j=jms,jme
          do i=ims,ime
            tracers(i,j,l,n)=0.
          enddo
          enddo
          call dstrb(tempdust,tracers(:,:,:,n),1,1,1,lm,l,mype,mpi_comm_comp)
        enddo
        call halo_exch(tracers(ims:ime,jms:jme,1:lm,n),lm,2,2)
        enddo
!         
!        if(mype==0)then
!          read(31)                                               ! FACT10
!        endif

        if(mype==0)then
          close(31)
        endif
!
        endif netcdf_if
!         
!-----------------------------------------------------------------------
!
        DEALLOCATE(tempdust)
!
!-----------------------------------------------------------------------
     do n=num_tracers_total-num_tracers_chem+1,num_tracers_total
      do l=1,lm
        do j=jms,jme
          do i=ims,ime
             sp(i,j,l,n  )=sqrt(max(tracers  (i,j,l,n),0.))
          enddo
        enddo
      enddo
     enddo
!
!-----------------------------------------------------------------------
!
                       end subroutine couple_spinup_dust
!
!-----------------------------------------------------------------------
!***********************************************************************
      subroutine check_stat(stat,message)
      use netcdf
      implicit none
      include 'netcdf.inc'

      integer, intent(in)       :: stat
      character*100, intent(in) :: message

      if ( stat /= nf90_NoErr ) then
        print*, 'error in netcdf status while...'
        print*, TRIM(message)
        STOP
      endif

      end subroutine check_stat
!#######################################################################
!-----------------------------------------------------------------------
!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
!-----------------------------------------------------------------------
!
                       end module module_BSC_SPINUP_DUST
!
!-----------------------------------------------------------------------
!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
!-----------------------------------------------------------------------
