Changeset 5148 for LMDZ6/trunk/libf


Ignore:
Timestamp:
Jul 31, 2024, 10:21:57 AM (4 months ago)
Author:
acozic
Message:

undo commit 5131 - when we compile with inca we don't use anymore phystokenc to calculate offline flux

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

Legend:

Unmodified
Added
Removed

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

    r5147 r5148  
    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       !$OMP THREADPRIVATE(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      
    854819CONTAINS
    855820
    … …  
    13161281#endif
    13171282
    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      
    13441283END SUBROUTINE phys_local_var_init
    13451284
    … …  
    17371676#endif
    17381677
    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 
    17631678END SUBROUTINE phys_local_var_end
    17641679

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

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

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

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