source: LMDZ6/trunk/libf/phylmd/phystokenc_mod.F90 @ 5134

!
! $Id: phystokenc_mod.F90 5131 2024-07-26 07:43:31Z abarral $
!
MODULE phystokenc_mod

   IMPLICIT NONE
 
   LOGICAL,SAVE :: offline
 !$OMP THREADPRIVATE(offline)
   INTEGER,SAVE :: istphy
 !$OMP THREADPRIVATE(istphy)
 
 
 CONTAINS
 
   SUBROUTINE init_phystokenc(offline_dyn,istphy_dyn)
     IMPLICIT NONE
     LOGICAL,INTENT(IN) :: offline_dyn
     INTEGER,INTENT(IN) :: istphy_dyn
 
     offline=offline_dyn
     istphy=istphy_dyn
 
   END SUBROUTINE init_phystokenc
 
 SUBROUTINE phystokenc (nlon,nlev,pdtphys,rlon,rlat, &
      pt,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
      pfm_therm,pentr_therm, &
      cdragh, pcoefh,pyu1,pyv1,pftsol,pctsrf, &
      frac_impa,frac_nucl, &
      pphis,paire,dtime,itap, &
      psh, pda, pphi, pmp, pupwd, pdnwd,pwght)
   
   USE ioipsl
   USE dimphy
   USE infotrac_phy, ONLY : nqtot
   USE iophy
   USE indice_sol_mod
   USE print_control_mod, ONLY: lunout
   USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat
   USE phys_local_var_mod, ONLY : t_stok, mfu_stok, mfd_stok, de_u_stok,de_d_stok, en_d_stok,  &
          yu1_stok,yv1_stok, en_u_stok,coefh_stok, fm_therm_stok,sh_stok,&
          da_stok, phi_stok, mp_stok, upwd_stok, dnwd_stok, wght_stok,entr_therm_stok, pctsrf_stok,ftsol_stok,write_offline
  USE write_field_phy

  IMPLICIT NONE

 !======================================================================
 ! Auteur(s) FH
 ! Objet: Ecriture des variables pour transport offline
 !
 !======================================================================
 
 ! Arguments:
 !
   REAL,DIMENSION(klon,klev), INTENT(IN)     :: psh   ! humidite specifique
   REAL, DIMENSION(klon,klev),  INTENT(in)    :: pt    ! temperature
   !Variables convectives KE
   REAL,DIMENSION(klon,klev), INTENT(IN)     :: pda
   REAL,DIMENSION(klon,klev,klev), INTENT(IN):: pphi
   REAL,DIMENSION(klon,klev), INTENT(IN)     :: pmp
   REAL,DIMENSION(klon,klev), INTENT(IN)     :: pupwd ! saturated updraft mass flux
   REAL,DIMENSION(klon,klev), INTENT(IN)     :: pdnwd ! saturated downdraft mass flux
   REAL,DIMENSION(klon,klev), INTENT(IN)      :: pwght
   !Variables TIE
   REAL, DIMENSION(klon,klev),  INTENT(in)    :: pmfu   ! flux de masse dans le panache montant
   REAL, DIMENSION(klon,klev),  INTENT(in)    :: pmfd   ! flux de masse dans le panache descendant
   REAL, DIMENSION(klon,klev),  INTENT(in)    :: pen_u  ! flux entraine dans le panache montant
   REAL, DIMENSION(klon,klev),  INTENT(in)    :: pde_u  ! flux detraine dans le panache montant
   REAL, DIMENSION(klon,klev),  INTENT(in)    :: pen_d  ! flux entraine dans le panache descendant
   REAL, DIMENSION(klon,klev),  INTENT(in)    :: pde_d  ! flux detraine dans le panache descendant
   !Couche limite
   REAL, DIMENSION(klon), INTENT(in) ::  pyv1,pyu1
   REAL, DIMENSION(klon), INTENT(in) ::  pphis,paire
   REAL, DIMENSION(klon,klev), INTENT(in) ::  pcoefh     ! coeff melange CL
   REAL, DIMENSION(klon), INTENT(in) ::  cdragh          ! cdragi
   REAL, INTENT(in) ::  pftsol(klon,nbsrf) !  Temperature du sol (surf)(Kelvin)
   REAL, INTENT(in) ::  pctsrf(klon,nbsrf) ! Pourcentage de sol f(nature du sol)
   !Thermiques
   REAL,DIMENSION(klon,klev+1), INTENT(IN)    :: pfm_therm
   REAL, DIMENSION(klon,klev), INTENT(in) ::  pentr_therm
   !Divers
   INTEGER, INTENT(in) :: nlon,nlev 
   REAL,INTENT(in)  :: pdtphys,dtime
   INTEGER,INTENT(in) :: itap
   REAL, INTENT(in)    :: frac_impa(klon,klev)   ! Lessivage
   REAL, INTENT(in)    :: frac_nucl(klon,klev)   ! Lessivage
   INTEGER, SAVE :: physid
   REAL pcoefh_buf(klon,klev) ! coeff melange CL + cdrag
   REAL rlon(klon), rlat(klon)
 !
 ! Arguments necessaires pour les sources et puits de traceur
 !
 !======================================================================
   INTEGER i, k, kk
   REAL, SAVE :: dtcum
   INTEGER, SAVE:: iadvtr=0
 !$OMP THREADPRIVATE(dtcum,iadvtr)
   REAL zmin,zmax
 !======================================================================
   write_offline=.true.
 ! Dans le meme vecteur on recombine le drag et les coeff d'echange
   pcoefh_buf(:,1)      = cdragh(:)
   pcoefh_buf(:,2:klev) = pcoefh(:,2:klev)
  
   iadvtr=iadvtr+1
 
 ! Set to zero cumulating fields
 !======================================================================
   IF (MOD(iadvtr,istphy)==1.OR.istphy==1) THEN
      WRITE(lunout,*)'reinitialisation des champs cumules a iadvtr=',iadvtr
      mfu_stok(:,:)=0.
      mfd_stok(:,:)=0.
      de_u_stok(:,:)=0.
      en_d_stok(:,:)=0.
      de_d_stok(:,:)=0.
      en_u_stok(:,:)=0.
      coefh_stok(:,:)=0.
      t_stok(:,:)=0.
      fm_therm_stok(:,:)=0.
      entr_therm_stok(:,:)=0.
      da_stok(:,:)=0.
      phi_stok(:,:,:)=0.
      mp_stok(:,:)=0.
      upwd_stok(:,:)=0.
      dnwd_stok(:,:)=0.
      wght_stok(:,:)=0.
      sh_stok(:,:)=0.
      yu1_stok(:)=0
      yv1_stok(:)=0
      ftsol_stok(:,:)=0
      pctsrf_stok(:,:)=0
 
      dtcum=0.
   ENDIF
   
 
 ! Cumulate fields at each time step
 !======================================================================
   DO k=1,klev
      DO i=1,klon
         mfu_stok(i,k)=mfu_stok(i,k)+pmfu(i,k)*pdtphys
         mfd_stok(i,k)=mfd_stok(i,k)+pmfd(i,k)*pdtphys
         de_u_stok(i,k)=de_u_stok(i,k)+pde_u(i,k)*pdtphys
         en_d_stok(i,k)=en_d_stok(i,k)+pen_d(i,k)*pdtphys
         coefh_stok(i,k)=coefh_stok(i,k)+pcoefh_buf(i,k)*pdtphys
         t_stok(i,k)=t_stok(i,k)+pt(i,k)*pdtphys
         fm_therm_stok(i,k)=fm_therm_stok(i,k)+pfm_therm(i,k)*pdtphys
         entr_therm_stok(i,k)=entr_therm_stok(i,k)+pentr_therm(i,k)*pdtphys
         da_stok(i,k) = da_stok(i,k) + pda(i,k)*pdtphys
         mp_stok(i,k) = mp_stok(i,k) + pmp(i,k)*pdtphys
         upwd_stok(i,k) = upwd_stok(i,k) + pupwd(i,k)*pdtphys
         dnwd_stok(i,k) = dnwd_stok(i,k) + pdnwd(i,k)*pdtphys
         wght_stok(i,k) = wght_stok(i,k) + pwght(i,k)*pdtphys
      ENDDO
   ENDDO
   DO k=1,nbsrf
       DO i=1,klon
          ftsol_stok(i,k)=ftsol_stok(i,k)+pftsol(i,k)*pdtphys
          pctsrf_stok(i,k)=pctsrf_stok(i,k)+pctsrf(i,k)*pdtphys
       ENDDO
   END DO
   DO i=1,klon
          yu1_stok(i)=yu1_stok(i)+pyu1(i)*pdtphys
          yv1_stok(i)=yv1_stok(i)+pyv1(i)*pdtphys
   ENDDO
   DO kk=1,klev
      DO k=1,klev
         DO i=1,klon
            phi_stok(i,k,kk) = phi_stok(i,k,kk) + pphi(i,k,kk)*pdtphys
         END DO
      END DO
   END DO
 
 ! Add time step to cumulated time
   dtcum=dtcum+pdtphys
   
 ! Write fields to file, if it is time to do so
 !======================================================================
   IF(MOD(iadvtr,istphy)==0) THEN

      mfu_stok(:,:)=mfu_stok(:,:)/dtcum
      mfd_stok(:,:)=mfd_stok/dtcum
      de_u_stok(:,:)=de_u_stok/dtcum
      en_d_stok(:,:)=en_d_stok/dtcum
      de_d_stok(:,:)=de_d_stok/dtcum
      en_u_stok(:,:)=en_u_stok/dtcum
      coefh_stok(:,:)=coefh_stok/dtcum
      t_stok(:,:)=t_stok/dtcum
      fm_therm_stok(:,:)=fm_therm_stok/dtcum
      entr_therm_stok(:,:)=entr_therm_stok/dtcum
      da_stok(:,:)=da_stok/dtcum
      phi_stok(:,:,:)=phi_stok/dtcum
      mp_stok(:,:)=mp_stok/dtcum
      upwd_stok(:,:)=upwd_stok/dtcum
      dnwd_stok(:,:)=dnwd_stok/dtcum
      wght_stok(:,:)=wght_stok/dtcum
      sh_stok(:,:)=sh_stok/dtcum
      yu1_stok(:)=yu1_stok/dtcum
      yv1_stok(:)=yv1_stok/dtcum
      ftsol_stok(:,:)=ftsol_stok/dtcum
      pctsrf_stok(:,:)=pctsrf_stok/dtcum

      write_offline=.true.
 
   ENDIF  
      
 
 END SUBROUTINE phystokenc
 
 END MODULE phystokenc_mod