Changeset 5131 for LMDZ6/trunk/libf


Ignore:
Timestamp:
Jul 26, 2024, 9:43:31 AM (4 months ago)
Author:
acozic
Message:

update to write mass flow files in physiq - work begin with rev[4608]

Location:
LMDZ6/trunk/libf/phylmd
Files:
3 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk/libf/phylmd/phys_local_var_mod.F90

    r5109 r5131  
    817817#endif
    818818
     819      ! --- Offline -----------------------------------------------------------
     820      LOGICAL, SAVE :: write_offline
     821      !$OMP THREADPRIVATE(write_offline)
     822      REAL,ALLOCATABLE,SAVE :: ftsol_stok(:,:)  ! flux de masse dans le panache montant
     823      REAL,ALLOCATABLE,SAVE :: pctsrf_stok(:,:)  ! flux de masse dans le panache descendant
     824      !$OMP THREADPRIVATE(ftsol_stok,pctsrf_stok)
     825      REAL,ALLOCATABLE,SAVE :: mfu_stok(:,:)  ! flux de masse dans le panache montant
     826      REAL,ALLOCATABLE,SAVE :: mfd_stok(:,:)  ! flux de masse dans le panache descendant
     827      REAL,ALLOCATABLE,SAVE :: de_u_stok(:,:) ! flux de traine dans le panache montant
     828      REAL,ALLOCATABLE,SAVE :: en_d_stok(:,:) ! flux en traine dans le panache descendant
     829      REAL,ALLOCATABLE,SAVE :: de_d_stok(:,:) ! flux de traine dans le panache montant
     830      REAL,ALLOCATABLE,SAVE :: en_u_stok(:,:) ! flux en traine dans le panache descendant
     831      REAL,ALLOCATABLE,SAVE :: coefh_stok(:,:) ! flux de traine dans le panache descendant
     832      !$OMP THREADPRIVATE(mfu_stok,mfd_stok,de_u_stok,en_d_stok,de_d_stok)
     833      !$OMP THREADPRIVATE(en_u_stok,coefh_stok)
     834      REAL,ALLOCATABLE,SAVE :: entr_therm_stok(:,:) ! Les Thermiques :(Abderr25 1102)
     835      REAL,ALLOCATABLE,SAVE :: fm_therm_stok(:,:)   ! Les Thermiques :(Abderr25 1102)
     836      !$OMP THREADPRIVATE(entr_therm_stok, fm_therm_stok)
     837      REAL,DIMENSION(:), ALLOCATABLE,SAVE     :: yu1_stok
     838      REAL,DIMENSION(:), ALLOCATABLE,SAVE   :: yv1_stok
     839      !$OMP THREADPRIVATE(yu1_stok, yv1_stok)
     840      REAL,DIMENSION(:,:), ALLOCATABLE,SAVE     :: da_stok
     841      REAL,DIMENSION(:,:,:), ALLOCATABLE,SAVE   :: phi_stok
     842      REAL,DIMENSION(:,:), ALLOCATABLE,SAVE     :: mp_stok
     843      REAL,DIMENSION(:,:), ALLOCATABLE,SAVE     :: upwd_stok
     844      REAL,DIMENSION(:,:), ALLOCATABLE,SAVE     :: dnwd_stok
     845      REAL,DIMENSION(:,:), ALLOCATABLE,SAVE     :: wght_stok
     846      !$OMPTHREADPRIVATE(da_stok,phi_stok,mp_stok,upwd_stok,dnwd_stok,wght_stok)
     847      REAL,ALLOCATABLE,SAVE :: t_stok(:,:)   ! convection
     848      REAL,ALLOCATABLE,SAVE :: sh_stok(:,:)   ! convection
     849      !$OMP THREADPRIVATE(t_stok,sh_stok)
     850      ! -----------------------------------------------------------------------
     851
     852
     853     
    819854CONTAINS
    820855
    … …  
    12811316#endif
    12821317
     1318      ! --- Offline -----------------------------------------------------------
     1319      ALLOCATE(t_stok(klon,klev))
     1320      ALLOCATE(sh_stok(klon,klev))
     1321      ALLOCATE(mfu_stok(klon,klev))
     1322      ALLOCATE(mfd_stok(klon,klev))
     1323      ALLOCATE(de_u_stok(klon,klev))
     1324      ALLOCATE(en_d_stok(klon,klev))
     1325      ALLOCATE(de_d_stok(klon,klev))
     1326      ALLOCATE(en_u_stok(klon,klev))
     1327      ALLOCATE(coefh_stok(klon,klev))
     1328      ALLOCATE(entr_therm_stok(klon,klev))
     1329      ALLOCATE(fm_therm_stok(klon,klev))
     1330      ALLOCATE(da_stok(klon,klev))
     1331      ALLOCATE(phi_stok(klon,klev,klev))
     1332      ALLOCATE(mp_stok(klon,klev))
     1333      ALLOCATE(upwd_stok(klon,klev))
     1334      ALLOCATE(dnwd_stok(klon,klev))
     1335      ALLOCATE(wght_stok(klon,klev))
     1336      ALLOCATE(yu1_stok(klon))
     1337      ALLOCATE(yv1_stok(klon))
     1338      ALLOCATE(ftsol_stok(klon,nbsrf))
     1339      ALLOCATE(pctsrf_stok(klon,nbsrf))
     1340      ! -----------------------------------------------------------------------
     1341
     1342
     1343     
    12831344END SUBROUTINE phys_local_var_init
    12841345
    … …  
    16761737#endif
    16771738
     1739            ! --- Offline -----------------------------------------------------------
     1740      DEALLOCATE(t_stok)
     1741      DEALLOCATE(sh_stok)
     1742      DEALLOCATE(mfu_stok)
     1743      DEALLOCATE(mfd_stok)
     1744      DEALLOCATE(de_u_stok)
     1745      DEALLOCATE(en_d_stok)
     1746      DEALLOCATE(de_d_stok)
     1747      DEALLOCATE(en_u_stok)
     1748      DEALLOCATE(coefh_stok)
     1749      DEALLOCATE(entr_therm_stok)
     1750      DEALLOCATE(fm_therm_stok)
     1751      DEALLOCATE(da_stok)
     1752      DEALLOCATE(phi_stok)
     1753      DEALLOCATE(mp_stok)
     1754      DEALLOCATE(upwd_stok)
     1755      DEALLOCATE(dnwd_stok)
     1756      DEALLOCATE(wght_stok)
     1757      DEALLOCATE(yu1_stok)
     1758      DEALLOCATE(yv1_stok)
     1759      DEALLOCATE(ftsol_stok)
     1760      DEALLOCATE(pctsrf_stok)
     1761      ! -----------------------------------------------------------------------
     1762
    16781763END SUBROUTINE phys_local_var_end
    16791764

  • LMDZ6/trunk/libf/phylmd/physiq_mod.F90

    r5084 r5131  
    53735373            frac_impa, frac_nucl, &
    53745374            pphis,cell_area,phys_tstep,itap, &
    5375             qx(:,:,ivap),da,phi,mp,upwd,dnwd)
     5375            qx(:,:,ivap),da,phi,mp,upwd,dnwd,wght_cvfd)
    53765376
    53775377

  • LMDZ6/trunk/libf/phylmd/phystokenc_mod.F90

    r2343 r5131  
    44MODULE phystokenc_mod
    55
     6   IMPLICIT NONE
     7 
     8   LOGICAL,SAVE :: offline
     9 !$OMP THREADPRIVATE(offline)
     10   INTEGER,SAVE :: istphy
     11 !$OMP THREADPRIVATE(istphy)
     12 
     13 
     14 CONTAINS
     15 
     16   SUBROUTINE init_phystokenc(offline_dyn,istphy_dyn)
     17     IMPLICIT NONE
     18     LOGICAL,INTENT(IN) :: offline_dyn
     19     INTEGER,INTENT(IN) :: istphy_dyn
     20 
     21     offline=offline_dyn
     22     istphy=istphy_dyn
     23 
     24   END SUBROUTINE init_phystokenc
     25 
     26 SUBROUTINE phystokenc (nlon,nlev,pdtphys,rlon,rlat, &
     27      pt,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
     28      pfm_therm,pentr_therm, &
     29      cdragh, pcoefh,pyu1,pyv1,pftsol,pctsrf, &
     30      frac_impa,frac_nucl, &
     31      pphis,paire,dtime,itap, &
     32      psh, pda, pphi, pmp, pupwd, pdnwd,pwght)
     33   
     34   USE ioipsl
     35   USE dimphy
     36   USE infotrac_phy, ONLY : nqtot
     37   USE iophy
     38   USE indice_sol_mod
     39   USE print_control_mod, ONLY: lunout
     40   USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat
     41   USE phys_local_var_mod, ONLY : t_stok, mfu_stok, mfd_stok, de_u_stok,de_d_stok, en_d_stok,  &
     42          yu1_stok,yv1_stok, en_u_stok,coefh_stok, fm_therm_stok,sh_stok,&
     43          da_stok, phi_stok, mp_stok, upwd_stok, dnwd_stok, wght_stok,entr_therm_stok, pctsrf_stok,ftsol_stok,write_offline
     44  USE write_field_phy
     45
    646  IMPLICIT NONE
    747
    8   LOGICAL,SAVE :: offline
    9 !$OMP THREADPRIVATE(offline)
    10   INTEGER,SAVE :: istphy
    11 !$OMP THREADPRIVATE(istphy)
    12 
    13 
    14 CONTAINS
    15 
    16   SUBROUTINE init_phystokenc(offline_dyn,istphy_dyn)
    17     IMPLICIT NONE
    18     LOGICAL,INTENT(IN) :: offline_dyn
    19     INTEGER,INTENT(IN) :: istphy_dyn
    20 
    21     offline=offline_dyn
    22     istphy=istphy_dyn
    23 
    24   END SUBROUTINE init_phystokenc
    25 
    26 SUBROUTINE phystokenc (nlon,nlev,pdtphys,rlon,rlat, &
    27      pt,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
    28      pfm_therm,pentr_therm, &
    29      cdragh, pcoefh,yu1,yv1,ftsol,pctsrf, &
    30      frac_impa,frac_nucl, &
    31      pphis,paire,dtime,itap, &
    32      psh, pda, pphi, pmp, pupwd, pdnwd)
     48 !======================================================================
     49 ! Auteur(s) FH
     50 ! Objet: Ecriture des variables pour transport offline
     51 !
     52 !======================================================================
     53 
     54 ! Arguments:
     55 !
     56   REAL,DIMENSION(klon,klev), INTENT(IN)     :: psh   ! humidite specifique
     57   REAL, DIMENSION(klon,klev),  INTENT(in)    :: pt    ! temperature
     58   !Variables convectives KE
     59   REAL,DIMENSION(klon,klev), INTENT(IN)     :: pda
     60   REAL,DIMENSION(klon,klev,klev), INTENT(IN):: pphi
     61   REAL,DIMENSION(klon,klev), INTENT(IN)     :: pmp
     62   REAL,DIMENSION(klon,klev), INTENT(IN)     :: pupwd ! saturated updraft mass flux
     63   REAL,DIMENSION(klon,klev), INTENT(IN)     :: pdnwd ! saturated downdraft mass flux
     64   REAL,DIMENSION(klon,klev), INTENT(IN)      :: pwght
     65   !Variables TIE
     66   REAL, DIMENSION(klon,klev),  INTENT(in)    :: pmfu   ! flux de masse dans le panache montant
     67   REAL, DIMENSION(klon,klev),  INTENT(in)    :: pmfd   ! flux de masse dans le panache descendant
     68   REAL, DIMENSION(klon,klev),  INTENT(in)    :: pen_u  ! flux entraine dans le panache montant
     69   REAL, DIMENSION(klon,klev),  INTENT(in)    :: pde_u  ! flux detraine dans le panache montant
     70   REAL, DIMENSION(klon,klev),  INTENT(in)    :: pen_d  ! flux entraine dans le panache descendant
     71   REAL, DIMENSION(klon,klev),  INTENT(in)    :: pde_d  ! flux detraine dans le panache descendant
     72   !Couche limite
     73   REAL, DIMENSION(klon), INTENT(in) ::  pyv1,pyu1
     74   REAL, DIMENSION(klon), INTENT(in) ::  pphis,paire
     75   REAL, DIMENSION(klon,klev), INTENT(in) ::  pcoefh     ! coeff melange CL
     76   REAL, DIMENSION(klon), INTENT(in) ::  cdragh          ! cdragi
     77   REAL, INTENT(in) ::  pftsol(klon,nbsrf) !  Temperature du sol (surf)(Kelvin)
     78   REAL, INTENT(in) ::  pctsrf(klon,nbsrf) ! Pourcentage de sol f(nature du sol)
     79   !Thermiques
     80   REAL,DIMENSION(klon,klev+1), INTENT(IN)    :: pfm_therm
     81   REAL, DIMENSION(klon,klev), INTENT(in) ::  pentr_therm
     82   !Divers
     83   INTEGER, INTENT(in) :: nlon,nlev
     84   REAL,INTENT(in)  :: pdtphys,dtime
     85   INTEGER,INTENT(in) :: itap
     86   REAL, INTENT(in)    :: frac_impa(klon,klev)   ! Lessivage
     87   REAL, INTENT(in)    :: frac_nucl(klon,klev)   ! Lessivage
     88   INTEGER, SAVE :: physid
     89   REAL pcoefh_buf(klon,klev) ! coeff melange CL + cdrag
     90   REAL rlon(klon), rlat(klon)
     91 !
     92 ! Arguments necessaires pour les sources et puits de traceur
     93 !
     94 !======================================================================
     95   INTEGER i, k, kk
     96   REAL, SAVE :: dtcum
     97   INTEGER, SAVE:: iadvtr=0
     98 !$OMP THREADPRIVATE(dtcum,iadvtr)
     99   REAL zmin,zmax
     100 !======================================================================
     101   write_offline=.true.
     102 ! Dans le meme vecteur on recombine le drag et les coeff d'echange
     103   pcoefh_buf(:,1)      = cdragh(:)
     104   pcoefh_buf(:,2:klev) = pcoefh(:,2:klev)
    33105 
    34   USE ioipsl
    35   USE dimphy
    36   USE infotrac_phy, ONLY : nqtot
    37   USE iophy
    38   USE indice_sol_mod
    39   USE print_control_mod, ONLY: lunout
    40   USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat
    41  
    42   IMPLICIT NONE
    43  
    44 !======================================================================
    45 ! Auteur(s) FH
    46 ! Objet: Ecriture des variables pour transport offline
    47 !
    48 !======================================================================
    49 
    50 ! Arguments:
    51 !
    52   REAL,DIMENSION(klon,klev), INTENT(IN)     :: psh   ! humidite specifique
    53   REAL,DIMENSION(klon,klev), INTENT(IN)     :: pda
    54   REAL,DIMENSION(klon,klev,klev), INTENT(IN):: pphi
    55   REAL,DIMENSION(klon,klev), INTENT(IN)     :: pmp
    56   REAL,DIMENSION(klon,klev), INTENT(IN)     :: pupwd ! saturated updraft mass flux
    57   REAL,DIMENSION(klon,klev), INTENT(IN)     :: pdnwd ! saturated downdraft mass flux
    58 
    59 !   EN ENTREE:
    60 !   ==========
    61 !
    62 !   divers:
    63 !   -------
    64 !
    65   INTEGER nlon ! nombre de points horizontaux
    66   INTEGER nlev ! nombre de couches verticales
    67   REAL pdtphys ! pas d'integration pour la physique (seconde)
    68   INTEGER itap
    69   INTEGER, SAVE :: physid
    70 !$OMP THREADPRIVATE(physid)
    71 
    72 !   convection:
    73 !   -----------
    74 !
    75   REAL pmfu(klon,klev)  ! flux de masse dans le panache montant
    76   REAL pmfd(klon,klev)  ! flux de masse dans le panache descendant
    77   REAL pen_u(klon,klev) ! flux entraine dans le panache montant
    78   REAL pde_u(klon,klev) ! flux detraine dans le panache montant
    79   REAL pen_d(klon,klev) ! flux entraine dans le panache descendant
    80   REAL pde_d(klon,klev) ! flux detraine dans le panache descendant
    81   REAL pt(klon,klev)
    82   REAL,ALLOCATABLE,SAVE :: t(:,:)
    83 !$OMP THREADPRIVATE(t)
    84 !
    85   REAL rlon(klon), rlat(klon), dtime
    86   REAL zx_tmp_3d(nbp_lon,nbp_lat,klev),zx_tmp_2d(nbp_lon,nbp_lat)
    87 
    88 !   Couche limite:
    89 !   --------------
    90 !
    91   REAL cdragh(klon)          ! cdrag
    92   REAL pcoefh(klon,klev)     ! coeff melange CL
    93   REAL pcoefh_buf(klon,klev) ! coeff melange CL + cdrag
    94   REAL yv1(klon)
    95   REAL yu1(klon),pphis(klon),paire(klon)
    96 
    97 !   Les Thermiques : (Abderr 25 11 02)
    98 !   ---------------
    99   REAL, INTENT(IN) ::  pfm_therm(klon,klev+1)
    100   REAL pentr_therm(klon,klev)
    101  
    102   REAL,ALLOCATABLE,SAVE :: entr_therm(:,:)
    103   REAL,ALLOCATABLE,SAVE :: fm_therm(:,:)
    104 !$OMP THREADPRIVATE(entr_therm)
    105 !$OMP THREADPRIVATE(fm_therm)
    106 !
    107 !   Lessivage:
    108 !   ----------
    109 !
    110   REAL frac_impa(klon,klev)
    111   REAL frac_nucl(klon,klev)
    112 !
    113 ! Arguments necessaires pour les sources et puits de traceur
    114 !
    115   REAL ftsol(klon,nbsrf)  ! Temperature du sol (surf)(Kelvin)
    116   REAL pctsrf(klon,nbsrf) ! Pourcentage de sol f(nature du sol)
    117 !======================================================================
    118 !
    119   INTEGER i, k, kk
    120   REAL,ALLOCATABLE,SAVE :: mfu(:,:)  ! flux de masse dans le panache montant
    121   REAL,ALLOCATABLE,SAVE :: mfd(:,:)  ! flux de masse dans le panache descendant
    122   REAL,ALLOCATABLE,SAVE :: en_u(:,:) ! flux entraine dans le panache montant
    123   REAL,ALLOCATABLE,SAVE :: de_u(:,:) ! flux detraine dans le panache montant
    124   REAL,ALLOCATABLE,SAVE :: en_d(:,:) ! flux entraine dans le panache descendant
    125   REAL,ALLOCATABLE,SAVE :: de_d(:,:) ! flux detraine dans le panache descendant
    126   REAL,ALLOCATABLE,SAVE :: coefh(:,:) ! flux detraine dans le panache descendant
    127  
    128   REAL,ALLOCATABLE,SAVE :: pyu1(:)
    129   REAL,ALLOCATABLE,SAVE :: pyv1(:)
    130   REAL,ALLOCATABLE,SAVE :: pftsol(:,:)
    131   REAL,ALLOCATABLE,SAVE :: ppsrf(:,:)
    132 !$OMP THREADPRIVATE(mfu,mfd,en_u,de_u,en_d,de_d,coefh)
    133 !$OMP THREADPRIVATE(pyu1,pyv1,pftsol,ppsrf)
    134 
    135 
    136   REAL,DIMENSION(:,:), ALLOCATABLE,SAVE     :: sh 
    137   REAL,DIMENSION(:,:), ALLOCATABLE,SAVE     :: da
    138   REAL,DIMENSION(:,:,:), ALLOCATABLE,SAVE   :: phi
    139   REAL,DIMENSION(:,:), ALLOCATABLE,SAVE     :: mp
    140   REAL,DIMENSION(:,:), ALLOCATABLE,SAVE     :: upwd
    141   REAL,DIMENSION(:,:), ALLOCATABLE,SAVE     :: dnwd
    142  
    143   REAL, SAVE :: dtcum
    144   INTEGER, SAVE:: iadvtr=0
    145 !$OMP THREADPRIVATE(dtcum,iadvtr)
    146   REAL zmin,zmax
    147   LOGICAL ok_sync
    148   CHARACTER(len=12) :: nvar
    149   logical, parameter :: lstokenc=.FALSE.
    150 !
    151 !======================================================================
    152 
    153   iadvtr=iadvtr+1
    154 
    155 ! Dans le meme vecteur on recombine le drag et les coeff d'echange
    156   pcoefh_buf(:,1)      = cdragh(:)
    157   pcoefh_buf(:,2:klev) = pcoefh(:,2:klev)
    158  
    159   ok_sync = .TRUE.
    160 
    161 ! Initialization done only once
    162 !======================================================================
    163   IF (iadvtr==1) THEN
    164      ALLOCATE( t(klon,klev))
    165      ALLOCATE( mfu(klon,klev)) 
    166      ALLOCATE( mfd(klon,klev)) 
    167      ALLOCATE( en_u(klon,klev))
    168      ALLOCATE( de_u(klon,klev))
    169      ALLOCATE( en_d(klon,klev))
    170      ALLOCATE( de_d(klon,klev))
    171      ALLOCATE( coefh(klon,klev))
    172      ALLOCATE( entr_therm(klon,klev))
    173      ALLOCATE( fm_therm(klon,klev))
    174      ALLOCATE( pyu1(klon))
    175      ALLOCATE( pyv1(klon))
    176      ALLOCATE( pftsol(klon,nbsrf))
    177      ALLOCATE( ppsrf(klon,nbsrf))
    178      
    179      ALLOCATE(sh(klon,klev))
    180      ALLOCATE(da(klon,klev))
    181      ALLOCATE(phi(klon,klev,klev))
    182      ALLOCATE(mp(klon,klev))
    183      ALLOCATE(upwd(klon,klev))
    184      ALLOCATE(dnwd(klon,klev))
    185 
    186      CALL initphysto('phystoke', dtime, dtime*istphy,dtime*istphy,physid)
    187      
    188      ! Write field phis and aire only once
    189      CALL histwrite_phy(physid,lstokenc,"phis",itap,pphis)
    190      CALL histwrite_phy(physid,lstokenc,"aire",itap,paire)
    191      CALL histwrite_phy(physid,lstokenc,"longitudes",itap,rlon)
    192      CALL histwrite_phy(physid,lstokenc,"latitudes",itap,rlat)
    193 
    194   END IF
    195  
    196  
    197 ! Set to zero cumulating fields
    198 !======================================================================
    199   IF (MOD(iadvtr,istphy)==1.OR.istphy==1) THEN
    200      WRITE(lunout,*)'reinitialisation des champs cumules a iadvtr=',iadvtr
    201      mfu(:,:)=0.
    202      mfd(:,:)=0.
    203      en_u(:,:)=0.
    204      de_u(:,:)=0.
    205      en_d(:,:)=0.
    206      de_d(:,:)=0.
    207      coefh(:,:)=0.
    208      t(:,:)=0.
    209      fm_therm(:,:)=0.
    210      entr_therm(:,:)=0.
    211      pyv1(:)=0.
    212      pyu1(:)=0.
    213      pftsol(:,:)=0.
    214      ppsrf(:,:)=0.
    215      sh(:,:)=0.
    216      da(:,:)=0.
    217      phi(:,:,:)=0.
    218      mp(:,:)=0.
    219      upwd(:,:)=0.
    220      dnwd(:,:)=0.
    221      dtcum=0.
    222   ENDIF
    223  
    224 
    225 ! Cumulate fields at each time step
    226 !======================================================================
    227   DO k=1,klev
    228      DO i=1,klon
    229         mfu(i,k)=mfu(i,k)+pmfu(i,k)*pdtphys
    230         mfd(i,k)=mfd(i,k)+pmfd(i,k)*pdtphys
    231         en_u(i,k)=en_u(i,k)+pen_u(i,k)*pdtphys
    232         de_u(i,k)=de_u(i,k)+pde_u(i,k)*pdtphys
    233         en_d(i,k)=en_d(i,k)+pen_d(i,k)*pdtphys
    234         de_d(i,k)=de_d(i,k)+pde_d(i,k)*pdtphys
    235         coefh(i,k)=coefh(i,k)+pcoefh_buf(i,k)*pdtphys
    236         t(i,k)=t(i,k)+pt(i,k)*pdtphys
    237         fm_therm(i,k)=fm_therm(i,k)+pfm_therm(i,k)*pdtphys
    238         entr_therm(i,k)=entr_therm(i,k)+pentr_therm(i,k)*pdtphys
    239         sh(i,k) = sh(i,k) + psh(i,k)*pdtphys
    240         da(i,k) = da(i,k) + pda(i,k)*pdtphys
    241         mp(i,k) = mp(i,k) + pmp(i,k)*pdtphys
    242         upwd(i,k) = upwd(i,k) + pupwd(i,k)*pdtphys
    243         dnwd(i,k) = dnwd(i,k) + pdnwd(i,k)*pdtphys
    244      ENDDO
    245   ENDDO
    246 
    247   DO kk=1,klev
    248      DO k=1,klev
    249         DO i=1,klon
    250            phi(i,k,kk) = phi(i,k,kk) + pphi(i,k,kk)*pdtphys
    251         END DO
    252      END DO
    253   END DO
    254 
    255   DO i=1,klon
    256      pyv1(i)=pyv1(i)+yv1(i)*pdtphys
    257      pyu1(i)=pyu1(i)+yu1(i)*pdtphys
    258   END DO
    259   DO k=1,nbsrf
    260      DO i=1,klon
    261         pftsol(i,k)=pftsol(i,k)+ftsol(i,k)*pdtphys
    262         ppsrf(i,k)=ppsrf(i,k)+pctsrf(i,k)*pdtphys
    263      ENDDO
    264   ENDDO
    265  
    266 ! Add time step to cumulated time
    267   dtcum=dtcum+pdtphys
    268  
    269 
    270 ! Write fields to file, if it is time to do so
    271 !======================================================================
    272   IF(MOD(iadvtr,istphy)==0) THEN
    273 
    274      ! normalize with time period
    275      DO k=1,klev
    276         DO i=1,klon
    277            mfu(i,k)=mfu(i,k)/dtcum
    278            mfd(i,k)=mfd(i,k)/dtcum
    279            en_u(i,k)=en_u(i,k)/dtcum
    280            de_u(i,k)=de_u(i,k)/dtcum
    281            en_d(i,k)=en_d(i,k)/dtcum
    282            de_d(i,k)=de_d(i,k)/dtcum
    283            coefh(i,k)=coefh(i,k)/dtcum
    284            t(i,k)=t(i,k)/dtcum 
    285            fm_therm(i,k)=fm_therm(i,k)/dtcum
    286            entr_therm(i,k)=entr_therm(i,k)/dtcum
    287            sh(i,k)=sh(i,k)/dtcum
    288            da(i,k)=da(i,k)/dtcum
    289            mp(i,k)=mp(i,k)/dtcum
    290            upwd(i,k)=upwd(i,k)/dtcum
    291            dnwd(i,k)=dnwd(i,k)/dtcum
    292         ENDDO
    293      ENDDO
    294      DO kk=1,klev
    295         DO k=1,klev
    296            DO i=1,klon
    297               phi(i,k,kk) = phi(i,k,kk)/dtcum
    298            END DO
    299         END DO
    300      END DO
    301      DO i=1,klon
    302         pyv1(i)=pyv1(i)/dtcum
    303         pyu1(i)=pyu1(i)/dtcum
    304      END DO
    305      DO k=1,nbsrf
    306         DO i=1,klon
    307            pftsol(i,k)=pftsol(i,k)/dtcum
    308            ppsrf(i,k)=ppsrf(i,k)/dtcum
    309         ENDDO
    310      ENDDO
    311 
    312      ! write fields
    313      CALL histwrite_phy(physid,lstokenc,"t",itap,t)
    314      CALL histwrite_phy(physid,lstokenc,"mfu",itap,mfu)
    315      CALL histwrite_phy(physid,lstokenc,"mfd",itap,mfd)
    316      CALL histwrite_phy(physid,lstokenc,"en_u",itap,en_u)
    317      CALL histwrite_phy(physid,lstokenc,"de_u",itap,de_u)
    318      CALL histwrite_phy(physid,lstokenc,"en_d",itap,en_d)
    319      CALL histwrite_phy(physid,lstokenc,"de_d",itap,de_d)
    320      CALL histwrite_phy(physid,lstokenc,"coefh",itap,coefh)     
    321      CALL histwrite_phy(physid,lstokenc,"fm_th",itap,fm_therm)
    322      CALL histwrite_phy(physid,lstokenc,"en_th",itap,entr_therm)
    323      CALL histwrite_phy(physid,lstokenc,"frac_impa",itap,frac_impa)
    324      CALL histwrite_phy(physid,lstokenc,"frac_nucl",itap,frac_nucl)
    325      CALL histwrite_phy(physid,lstokenc,"pyu1",itap,pyu1)
    326      CALL histwrite_phy(physid,lstokenc,"pyv1",itap,pyv1)
    327      CALL histwrite_phy(physid,lstokenc,"ftsol1",itap,pftsol(:,1))
    328      CALL histwrite_phy(physid,lstokenc,"ftsol2",itap,pftsol(:,2))
    329      CALL histwrite_phy(physid,lstokenc,"ftsol3",itap,pftsol(:,3))
    330      CALL histwrite_phy(physid,lstokenc,"ftsol4",itap,pftsol(:,4))
    331      CALL histwrite_phy(physid,lstokenc,"psrf1",itap,ppsrf(:,1))
    332      CALL histwrite_phy(physid,lstokenc,"psrf2",itap,ppsrf(:,2))
    333      CALL histwrite_phy(physid,lstokenc,"psrf3",itap,ppsrf(:,3))
    334      CALL histwrite_phy(physid,lstokenc,"psrf4",itap,ppsrf(:,4))
    335      CALL histwrite_phy(physid,lstokenc,"sh",itap,sh)
    336      CALL histwrite_phy(physid,lstokenc,"da",itap,da)
    337      CALL histwrite_phy(physid,lstokenc,"mp",itap,mp)
    338      CALL histwrite_phy(physid,lstokenc,"upwd",itap,upwd)
    339      CALL histwrite_phy(physid,lstokenc,"dnwd",itap,dnwd)
    340 
    341 
    342 ! phi
    343      DO k=1,klev
    344         IF (k<10) THEN
    345            WRITE(nvar,'(i1)') k
    346         ELSE IF (k<100) THEN
    347            WRITE(nvar,'(i2)') k
    348         ELSE
    349            WRITE(nvar,'(i3)') k
    350         END IF
    351         nvar='phi_lev'//trim(nvar)
    352        
    353         CALL histwrite_phy(physid,lstokenc,nvar,itap,phi(:,:,k))
    354      END DO
    355      
    356      ! Syncronize file
    357 !$OMP MASTER
    358      IF (ok_sync) CALL histsync(physid)
    359 !$OMP END MASTER
    360      
    361      
    362      ! Calculate min and max values for some fields (coefficients de lessivage)
    363      zmin=1e33
    364      zmax=-1e33
    365      DO k=1,klev
    366         DO i=1,klon
    367            zmax=MAX(zmax,frac_nucl(i,k))
    368            zmin=MIN(zmin,frac_nucl(i,k))
    369         ENDDO
    370      ENDDO
    371      WRITE(lunout,*)'------ coefs de lessivage (min et max) --------'
    372      WRITE(lunout,*)'facteur de nucleation ',zmin,zmax
    373      zmin=1e33
    374      zmax=-1e33
    375      DO k=1,klev
    376         DO i=1,klon
    377            zmax=MAX(zmax,frac_impa(i,k))
    378            zmin=MIN(zmin,frac_impa(i,k))
    379         ENDDO
    380      ENDDO
    381      WRITE(lunout,*)'facteur d impaction ',zmin,zmax
    382      
    383   ENDIF ! IF(MOD(iadvtr,istphy)==0)
    384 
    385 END SUBROUTINE phystokenc
    386 
    387 END MODULE phystokenc_mod
     106   iadvtr=iadvtr+1
     107 
     108 ! Set to zero cumulating fields
     109 !======================================================================
     110   IF (MOD(iadvtr,istphy)==1.OR.istphy==1) THEN
     111      WRITE(lunout,*)'reinitialisation des champs cumules a iadvtr=',iadvtr
     112      mfu_stok(:,:)=0.
     113      mfd_stok(:,:)=0.
     114      de_u_stok(:,:)=0.
     115      en_d_stok(:,:)=0.
     116      de_d_stok(:,:)=0.
     117      en_u_stok(:,:)=0.
     118      coefh_stok(:,:)=0.
     119      t_stok(:,:)=0.
     120      fm_therm_stok(:,:)=0.
     121      entr_therm_stok(:,:)=0.
     122      da_stok(:,:)=0.
     123      phi_stok(:,:,:)=0.
     124      mp_stok(:,:)=0.
     125      upwd_stok(:,:)=0.
     126      dnwd_stok(:,:)=0.
     127      wght_stok(:,:)=0.
     128      sh_stok(:,:)=0.
     129      yu1_stok(:)=0
     130      yv1_stok(:)=0
     131      ftsol_stok(:,:)=0
     132      pctsrf_stok(:,:)=0
     133 
     134      dtcum=0.
     135   ENDIF
     136   
     137 
     138 ! Cumulate fields at each time step
     139 !======================================================================
     140   DO k=1,klev
     141      DO i=1,klon
     142         mfu_stok(i,k)=mfu_stok(i,k)+pmfu(i,k)*pdtphys
     143         mfd_stok(i,k)=mfd_stok(i,k)+pmfd(i,k)*pdtphys
     144         de_u_stok(i,k)=de_u_stok(i,k)+pde_u(i,k)*pdtphys
     145         en_d_stok(i,k)=en_d_stok(i,k)+pen_d(i,k)*pdtphys
     146         coefh_stok(i,k)=coefh_stok(i,k)+pcoefh_buf(i,k)*pdtphys
     147         t_stok(i,k)=t_stok(i,k)+pt(i,k)*pdtphys
     148         fm_therm_stok(i,k)=fm_therm_stok(i,k)+pfm_therm(i,k)*pdtphys
     149         entr_therm_stok(i,k)=entr_therm_stok(i,k)+pentr_therm(i,k)*pdtphys
     150         da_stok(i,k) = da_stok(i,k) + pda(i,k)*pdtphys
     151         mp_stok(i,k) = mp_stok(i,k) + pmp(i,k)*pdtphys
     152         upwd_stok(i,k) = upwd_stok(i,k) + pupwd(i,k)*pdtphys
     153         dnwd_stok(i,k) = dnwd_stok(i,k) + pdnwd(i,k)*pdtphys
     154         wght_stok(i,k) = wght_stok(i,k) + pwght(i,k)*pdtphys
     155      ENDDO
     156   ENDDO
     157   DO k=1,nbsrf
     158       DO i=1,klon
     159          ftsol_stok(i,k)=ftsol_stok(i,k)+pftsol(i,k)*pdtphys
     160          pctsrf_stok(i,k)=pctsrf_stok(i,k)+pctsrf(i,k)*pdtphys
     161       ENDDO
     162   END DO
     163   DO i=1,klon
     164          yu1_stok(i)=yu1_stok(i)+pyu1(i)*pdtphys
     165          yv1_stok(i)=yv1_stok(i)+pyv1(i)*pdtphys
     166   ENDDO
     167   DO kk=1,klev
     168      DO k=1,klev
     169         DO i=1,klon
     170            phi_stok(i,k,kk) = phi_stok(i,k,kk) + pphi(i,k,kk)*pdtphys
     171         END DO
     172      END DO
     173   END DO
     174 
     175 ! Add time step to cumulated time
     176   dtcum=dtcum+pdtphys
     177   
     178 ! Write fields to file, if it is time to do so
     179 !======================================================================
     180   IF(MOD(iadvtr,istphy)==0) THEN
     181
     182      mfu_stok(:,:)=mfu_stok(:,:)/dtcum
     183      mfd_stok(:,:)=mfd_stok/dtcum
     184      de_u_stok(:,:)=de_u_stok/dtcum
     185      en_d_stok(:,:)=en_d_stok/dtcum
     186      de_d_stok(:,:)=de_d_stok/dtcum
     187      en_u_stok(:,:)=en_u_stok/dtcum
     188      coefh_stok(:,:)=coefh_stok/dtcum
     189      t_stok(:,:)=t_stok/dtcum
     190      fm_therm_stok(:,:)=fm_therm_stok/dtcum
     191      entr_therm_stok(:,:)=entr_therm_stok/dtcum
     192      da_stok(:,:)=da_stok/dtcum
     193      phi_stok(:,:,:)=phi_stok/dtcum
     194      mp_stok(:,:)=mp_stok/dtcum
     195      upwd_stok(:,:)=upwd_stok/dtcum
     196      dnwd_stok(:,:)=dnwd_stok/dtcum
     197      wght_stok(:,:)=wght_stok/dtcum
     198      sh_stok(:,:)=sh_stok/dtcum
     199      yu1_stok(:)=yu1_stok/dtcum
     200      yv1_stok(:)=yv1_stok/dtcum
     201      ftsol_stok(:,:)=ftsol_stok/dtcum
     202      pctsrf_stok(:,:)=pctsrf_stok/dtcum
     203
     204      write_offline=.true.
     205 
     206   ENDIF 
     207     
     208 
     209 END SUBROUTINE phystokenc
     210 
     211 END MODULE phystokenc_mod
     212 
Note: See TracChangeset for help on using the changeset viewer.