Ignore:
Timestamp:
Sep 20, 2024, 12:32:04 PM (4 months ago)
Author:
Laurent Fairhead
Message:

Updating cirrus branch to trunk revision 5171

Location:
LMDZ6/branches/cirrus
Files:
3 deleted
49 edited
3 copied

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/cirrus

  • LMDZ6/branches/cirrus/libf/phylmd/Dust/phys_output_write_spl_mod.F90

    r4619 r5202  
    325325         sissnow, runoff, albsol3_lic, evap_pot, &
    326326         t2m, fluxt, fluxlat, fsollw, fsolsw, &
    327          wfbils, wfbilo, cdragm, cdragh, cldl, cldm, &
     327         wfbils, cdragm, cdragh, cldl, cldm, &
    328328         cldh, cldt, JrNt, &
    329329         ! cldljn, cldmjn, cldhjn, cldtjn &
    … …  
    353353         toplwad_aero, toplwad0_aero, sollwad_aero, &
    354354         sollwad0_aero, toplwai_aero, sollwai_aero, &
    355          scdnc, cldncl, reffclws, reffclwc, cldnvi, &
    356          lcc, lcc3d, lcc3dcon, lcc3dstra, reffclwtop, &
     355         !scdnc, cldncl, reffclws, reffclwc, cldnvi, &
     356         !lcc, lcc3d, lcc3dcon, lcc3dstra, reffclwtop, &
    357357         ec550aer, flwc, fiwc, t_seri, theta, q_seri, &
    358358!jyg<
    … …  
    377377    USE phys_output_var_mod, ONLY: vars_defined, snow_o, zfra_o, bils_diss, &
    378378         bils_ec,bils_ech, bils_tke, bils_kinetic, bils_latent, bils_enthalp, &
    379          itau_con, nfiles, clef_files, nid_files, zvstr_gwd_rando
     379         itau_con, nfiles, clef_files, nid_files, zvstr_gwd_rando, &
     380         scdnc, cldncl, reffclws, reffclwc, cldnvi, &
     381         lcc, lcc3d, lcc3dcon, lcc3dstra, reffclwtop
    380382    USE ocean_slab_mod, ONLY: tslab, slab_bilg, tice, seaice
    381383    USE pbl_surface_mod, ONLY: snow
    … …  
    721723          IF (vars_defined)         zx_tmp_fi2d(1 : klon) = wfbils( 1 : klon, nsrf)
    722724          CALL histwrite_phy(o_wbils_srf(nsrf), zx_tmp_fi2d)
    723           IF (vars_defined)         zx_tmp_fi2d(1 : klon) = wfbilo( 1 : klon, nsrf)
    724           CALL histwrite_phy(o_wbilo_srf(nsrf), zx_tmp_fi2d)
    725725
    726726          IF (iflag_pbl > 1) THEN

  • LMDZ6/branches/cirrus/libf/phylmd/StratAer/aer_sedimnt.F90

    r3677 r5202  
    1717!-----------------------------------------------------------------------
    1818
    19   USE phys_local_var_mod, ONLY: mdw, budg_sed_part, DENSO4, f_r_wet, vsed_aer
     19  USE phys_local_var_mod, ONLY: mdw, budg_sed_part, DENSO4, DENSO4B, f_r_wet, f_r_wetB, vsed_aer
     20  USE strataer_local_var_mod, ONLY: flag_new_strat_compo
    2021  USE dimphy, ONLY : klon,klev
    2122  USE infotrac_phy
    … …  
    8990
    9091      ! stokes-velocity with cunnigham slip- flow correction
    91       ZVAER(JL,JK,nb) = 2./9.*(DENSO4(JL,JK)*1000.-ZRHO)*RG/zvis(JL,JK)*(f_r_wet(JL,JK)*mdw(nb)/2.)**2.* &
    92          (1.+ 2.*zlair(JL,JK)/(f_r_wet(JL,JK)*mdw(nb))*(1.257+0.4*EXP(-0.55*f_r_wet(JL,JK)*mdw(nb)/zlair(JL,JK))))
    93 
     92      IF(flag_new_strat_compo) THEN
     93         ! stokes-velocity with cunnigham slip- flow correction
     94         ZVAER(JL,JK,nb) = 2./9.*(DENSO4B(JL,JK,nb)*1000.-ZRHO)*RG/zvis(JL,JK)*(f_r_wetB(JL,JK,nb)*mdw(nb)/2.)**2.* &
     95              (1.+ 2.*zlair(JL,JK)/(f_r_wetB(JL,JK,nb)*mdw(nb))*(1.257+0.4*EXP(-0.55*f_r_wetB(JL,JK,nb)*mdw(nb)/zlair(JL,JK))))
     96      ELSE
     97         ZVAER(JL,JK,nb) = 2./9.*(DENSO4(JL,JK)*1000.-ZRHO)*RG/zvis(JL,JK)*(f_r_wet(JL,JK)*mdw(nb)/2.)**2.* &
     98              (1.+ 2.*zlair(JL,JK)/(f_r_wet(JL,JK)*mdw(nb))*(1.257+0.4*EXP(-0.55*f_r_wet(JL,JK)*mdw(nb)/zlair(JL,JK))))
     99      ENDIF
     100     
    94101      ZSEDFLX(JL,nb)=ZVAER(JL,JK,nb)*ZRHO
    95102      ZSOLAERB(nb)=ZSOLAERB(nb)+ZDTGDP*ZSEDFLX(JL,nb)

  • LMDZ6/branches/cirrus/libf/phylmd/StratAer/aerophys.F90

    r4601 r5202  
    55  IMPLICIT NONE
    66!
    7   REAL,PARAMETER                         :: ropx=1500.0              ! default aerosol particle mass density [kg/m3]
    8   REAL,PARAMETER                         :: dens_aer_dry=1848.682308 ! dry aerosol particle mass density at T_0=293K[kg/m3]
    9   REAL,PARAMETER                         :: dens_aer_ref=1483.905336 ! aerosol particle mass density with 75% H2SO4 at T_0=293K[kg/m3]
    10   REAL,PARAMETER                         :: mdwmin=0.002e-6          ! dry diameter of smallest aerosol particles [m]
    11   REAL,PARAMETER                         :: V_rat=2.0                ! volume ratio of neighboring size bins
    12   REAL,PARAMETER                         :: mfrac_H2SO4=0.75         ! default mass fraction of H2SO4 in the aerosol
    13   REAL, PARAMETER                        :: mAIRmol=28.949*1.66E-27  ! Average mass of an air molecule [kg]
    14   REAL, PARAMETER                        :: mH2Omol=18.016*1.66E-27  ! Mass of an H2O molecule [kg]
    15   REAL, PARAMETER                        :: mH2SO4mol=98.082*1.66E-27! Mass of an H2SO4 molecule [kg]
    16   REAL, PARAMETER                        :: mSO2mol=64.06*1.66E-27   ! Mass of an SO2 molecule [kg]
    17   REAL, PARAMETER                        :: mSatom=32.06*1.66E-27    ! Mass of a S atom [kg]
    18   REAL, PARAMETER                        :: mOCSmol=60.07*1.66E-27   ! Mass of an OCS molecule [kg]
    19   REAL, PARAMETER                        :: mClatom=35.45*1.66E-27   ! Mass of an Cl atom [kg]
    20   REAL, PARAMETER                        :: mHClmol=36.46*1.66E-27   ! Mass of an HCl molecule [kg]
    21   REAL, PARAMETER                        :: mBratom=79.90*1.66E-27   ! Mass of an Br atom [kg]
    22   REAL, PARAMETER                        :: mHBrmol=80.92*1.66E-27   ! Mass of an HBr molecule [kg]
    23   REAL, PARAMETER                        :: mNOmol=30.01*1.66E-27    ! Mass of an NO molecule [kg]
    24   REAL, PARAMETER                        :: mNO2mol=46.01*1.66E-27   ! Mass of an NO2 molecule [kg]
    25   REAL, PARAMETER                        :: mNatome=14.0067*1.66E-27 ! Mass of an N atome [kg]
     7  REAL,PARAMETER    :: ropx=1500.0              ! default aerosol particle mass density [kg/m3]
     8  REAL,PARAMETER    :: dens_aer_dry=1848.682308 ! dry aerosol particle mass density at T_0=293K[kg/m3]
     9  REAL,PARAMETER    :: dens_aer_ref=1483.905336 ! aerosol particle mass density with 75% H2SO4 at T_0=293K[kg/m3]
     10  REAL,PARAMETER    :: mdwmin=0.002e-6          ! dry diameter of smallest aerosol particles [m]
     11  REAL,PARAMETER    :: V_rat=2.0                ! volume ratio of neighboring size bins
     12  REAL,PARAMETER    :: mfrac_H2SO4=0.75         ! default mass fraction of H2SO4 in the aerosol
     13  REAL, PARAMETER   :: mAIRmol=28.949*1.66E-27  ! Average mass of an air molecule [kg]
     14  REAL, PARAMETER   :: mH2Omol=18.016*1.66E-27  ! Mass of an H2O molecule [kg]
     15  REAL, PARAMETER   :: mH2SO4mol=98.082*1.66E-27! Mass of an H2SO4 molecule [kg]
     16  REAL, PARAMETER   :: mSO2mol=64.06*1.66E-27   ! Mass of an SO2 molecule [kg]
     17  REAL, PARAMETER   :: mSatom=32.06*1.66E-27    ! Mass of a S atom [kg]
     18  REAL, PARAMETER   :: mOCSmol=60.07*1.66E-27   ! Mass of an OCS molecule [kg]
     19  REAL, PARAMETER   :: mClatom=35.45*1.66E-27   ! Mass of an Cl atom [kg]
     20  REAL, PARAMETER   :: mHClmol=36.46*1.66E-27   ! Mass of an HCl molecule [kg]
     21  REAL, PARAMETER   :: mBratom=79.90*1.66E-27   ! Mass of an Br atom [kg]
     22  REAL, PARAMETER   :: mHBrmol=80.92*1.66E-27   ! Mass of an HBr molecule [kg]
     23  REAL, PARAMETER   :: mNOmol=30.01*1.66E-27    ! Mass of an NO molecule [kg]
     24  REAL, PARAMETER   :: mNO2mol=46.01*1.66E-27   ! Mass of an NO2 molecule [kg]
     25  REAL, PARAMETER   :: mNatome=14.0067*1.66E-27 ! Mass of an N atome [kg]
     26  REAL, PARAMETER   :: rgas=8.3145 ! molar gas cste (J⋅K−1⋅mol−1=m3⋅Pa⋅K−1⋅mol−1=kg⋅m2⋅s−2⋅K−1⋅mol−1)
     27  !
     28  REAL, PARAMETER   :: MH2O  =1000.*mH2Omol     ! Mass of 1 molec [g] (18.016*1.66E-24)
     29  REAL, PARAMETER   :: MH2SO4=1000.*mH2SO4mol   ! Mass of 1 molec [g] (98.082*1.66E-24)
     30  REAL, PARAMETER   :: BOLZ  =1.381E-16         ! Boltzmann constant [dyn.cm/K]
    2631!
    2732END MODULE aerophys

  • LMDZ6/branches/cirrus/libf/phylmd/StratAer/coagulate.F90

    r4762 r5202  
    2626  USE aerophys
    2727  USE infotrac_phy
    28   USE phys_local_var_mod, ONLY: DENSO4, f_r_wet
    29 
     28  USE phys_local_var_mod, ONLY: DENSO4, DENSO4B, f_r_wet, f_r_wetB
     29  USE strataer_local_var_mod, ONLY: flag_new_strat_compo
     30 
    3031  IMPLICIT NONE
    3132
    … …  
    4344  ! local variables in coagulation routine
    4445  INTEGER                                       :: i,j,k,nb,ilon,ilev
    45   REAL, DIMENSION(nbtr_bin)                     :: radius ! aerosol particle radius in each bin [m]
     46  REAL, DIMENSION(nbtr_bin)                     :: radiusdry ! dry aerosol particle radius in each bin [m]
     47  REAL, DIMENSION(nbtr_bin)                     :: radiuswet ! wet aerosol particle radius in each bin [m]
    4648  REAL, DIMENSION(klon,klev,nbtr_bin)           :: tr_t ! Concentration Traceur at time t [U/KgA]
    4749  REAL, DIMENSION(klon,klev,nbtr_bin)           :: tr_tp1 ! Concentration Traceur at time t+1 [U/KgA]
    4850  REAL, DIMENSION(nbtr_bin,nbtr_bin,nbtr_bin)   :: ff   ! Volume fraction of intermediate particles
    49   REAL, DIMENSION(nbtr_bin)                     :: V    ! Volume of bins
     51  REAL, DIMENSION(nbtr_bin)                     :: Vdry ! Volume dry of bins
     52  REAL, DIMENSION(nbtr_bin)                     :: Vwet ! Volume wet of bins
    5053  REAL, DIMENSION(nbtr_bin,nbtr_bin)            :: Vij  ! Volume sum of i and j
    5154  REAL                                          :: eta  ! Dynamic viscosity of air
    … …  
    8285  include "YOMCST.h"
    8386
    84   DO i=1, nbtr_bin
    85    radius(i)=mdw(i)/2.
    86    V(i)= radius(i)**3.  !neglecting factor 4*RPI/3
    87   ENDDO
    88 
    89   DO j=1, nbtr_bin
    90   DO i=1, nbtr_bin
    91    Vij(i,j)= V(i)+V(j)
    92   ENDDO
    93   ENDDO
    94 
     87! ff(i,j,k): Volume fraction of Vi,j that is partitioned to each model bin k
     88! just need to be calculated in model initialization because mdw(:) size is fixed
     89! no need to recalculate radius, Vdry, Vij, and ff every timestep because it is for 
     90! dry aerosols
     91  DO i=1, nbtr_bin
     92     radiusdry(i)=mdw(i)/2.
     93     Vdry(i)=radiusdry(i)**3.  !neglecting factor 4*RPI/3
     94     Vwet(i)=0.0
     95  ENDDO
     96
     97  DO j=1, nbtr_bin
     98     DO i=1, nbtr_bin
     99        Vij(i,j)= Vdry(i)+Vdry(j)
     100     ENDDO
     101  ENDDO
     102 
    95103!--pre-compute the f(i,j,k) from Jacobson equation 13
    96104  ff=0.0
    … …  
    100108    IF (k.EQ.1) THEN
    101109      ff(i,j,k)= 0.0
    102     ELSEIF (k.GT.1.AND.V(k-1).LT.Vij(i,j).AND.Vij(i,j).LT.V(k)) THEN
     110    ELSEIF (k.GT.1.AND.Vdry(k-1).LT.Vij(i,j).AND.Vij(i,j).LT.Vdry(k)) THEN
    103111      ff(i,j,k)= 1.-ff(i,j,k-1)
    104112    ELSEIF (k.EQ.nbtr_bin) THEN
    105       IF (Vij(i,j).GE.v(k)) THEN
     113      IF (Vij(i,j).GE.Vdry(k)) THEN
    106114        ff(i,j,k)= 1.
    107115      ELSE
    108116        ff(i,j,k)= 0.0
    109117      ENDIF
    110     ELSEIF (k.LE.(nbtr_bin-1).AND.V(k).LE.Vij(i,j).AND.Vij(i,j).LT.V(k+1)) THEN
    111       ff(i,j,k)= V(k)/Vij(i,j)*(V(k+1)-Vij(i,j))/(V(k+1)-V(k))
     118    ELSEIF (k.LE.(nbtr_bin-1).AND.Vdry(k).LE.Vij(i,j).AND.Vij(i,j).LT.Vdry(k+1)) THEN
     119      ff(i,j,k)= Vdry(k)/Vij(i,j)*(Vdry(k+1)-Vij(i,j))/(Vdry(k+1)-Vdry(k))
    112120    ENDIF
    113121  ENDDO
    114122  ENDDO
    115123  ENDDO
    116 
     124! End of just need to be calculated at initialization because mdw(:) size is fixed
     125 
    117126  DO ilon=1, klon
    118127  DO ilev=1, klev
    … …  
    120129  IF (is_strato(ilon,ilev)) THEN
    121130  !compute actual wet particle radius & volume for every grid box
    122   DO i=1, nbtr_bin
    123    radius(i)=f_r_wet(ilon,ilev)*mdw(i)/2.
    124    V(i)= radius(i)**3.  !neglecting factor 4*RPI/3
    125   ENDDO
    126 
     131  IF(flag_new_strat_compo) THEN
     132     DO i=1, nbtr_bin
     133        radiuswet(i)=f_r_wetB(ilon,ilev,i)*mdw(i)/2.
     134        Vwet(i)= radiuswet(i)**3.  !neglecting factor 4*RPI/3
     135!!      Vwet(i)= Vdry(i)*(f_r_wetB(ilon,ilev,i)**3)
     136     ENDDO
     137  ELSE
     138     DO i=1, nbtr_bin
     139        radiuswet(i)=f_r_wet(ilon,ilev)*mdw(i)/2.
     140        Vwet(i)= radiuswet(i)**3.  !neglecting factor 4*RPI/3
     141!!      Vwet(i)= Vdry(i)*(f_r_wet(ilon,ilev)**3)
     142     ENDDO
     143  ENDIF
     144 
    127145!--Calculations for the coagulation kernel---------------------------------------------------------
    128146
    … …  
    150168  Di=0.0
    151169  DO i=1, nbtr_bin
    152    Kn(i)=mnfrpth/radius(i)
    153    Di(i)=RKBOL*t_seri(ilon,ilev)/(6.*RPI*radius(i)*eta)*(1.+Kn(i)*(1.249+0.42*exp(-0.87/Kn(i))))
     170      Kn(i)=mnfrpth/radiuswet(i)
     171      Di(i)=RKBOL*t_seri(ilon,ilev)/(6.*RPI*radiuswet(i)*eta)*(1.+Kn(i)*(1.249+0.42*exp(-0.87/Kn(i))))
    154172  ENDDO
    155173
    156174!--pre-compute the thermal velocity of a particle thvelpar(i) from equation 20
    157175  thvelpar=0.0
    158   DO i=1, nbtr_bin
    159    m_par(i)=4./3.*RPI*radius(i)**3.*DENSO4(ilon,ilev)*1000.
    160    thvelpar(i)=sqrt(8.*RKBOL*t_seri(ilon,ilev)/(RPI*m_par(i)))
    161   ENDDO
     176  IF(flag_new_strat_compo) THEN
     177     DO i=1, nbtr_bin
     178        m_par(i)=4./3.*RPI*radiuswet(i)**3.*DENSO4B(ilon,ilev,i)*1000.
     179        thvelpar(i)=sqrt(8.*RKBOL*t_seri(ilon,ilev)/(RPI*m_par(i)))
     180     ENDDO
     181  ELSE
     182     DO i=1, nbtr_bin
     183        m_par(i)=4./3.*RPI*radiuswet(i)**3.*DENSO4(ilon,ilev)*1000.
     184        thvelpar(i)=sqrt(8.*RKBOL*t_seri(ilon,ilev)/(RPI*m_par(i)))
     185     ENDDO
     186  ENDIF
    162187
    163188!--pre-compute the particle mean free path mfppar(i) from equation 22
    … …  
    171196  delta=0.0
    172197  DO i=1, nbtr_bin
    173    delta(i)=((2.*radius(i)+mfppar(i))**3.-(4.*radius(i)**2.+mfppar(i)**2.)**1.5)/ &
    174            & (6.*radius(i)*mfppar(i))-2.*radius(i)
    175   ENDDO
    176 
     198      delta(i)=((2.*radiuswet(i)+mfppar(i))**3.-(4.*radiuswet(i)**2.+mfppar(i)**2.)**1.5)/ &
     199           & (6.*radiuswet(i)*mfppar(i))-2.*radiuswet(i)
     200  ENDDO
     201
     202!   beta(i,j): coagulation kernel (rate coefficient) of 2 colliding particles i,j
    177203!--pre-compute the beta(i,j) from equation 17 in Jacobson
    178204  num=0.0
    … …  
    180206  DO i=1, nbtr_bin
    181207!
    182    num=4.*RPI*(radius(i)+radius(j))*(Di(i)+Di(j))
    183    denom=(radius(i)+radius(j))/(radius(i)+radius(j)+sqrt(delta(i)**2.+delta(j)**2.))+ &
    184         & 4.*(Di(i)+Di(j))/(sqrt(thvelpar(i)**2.+thvelpar(j)**2.)*(radius(i)+radius(j)))
    185    beta(i,j)=num/denom
     208     num=4.*RPI*(radiuswet(i)+radiuswet(j))*(Di(i)+Di(j))
     209     denom=(radiuswet(i)+radiuswet(j))/(radiuswet(i)+radiuswet(j)+sqrt(delta(i)**2.+delta(j)**2.))+ &
     210          & 4.*(Di(i)+Di(j))/(sqrt(thvelpar(i)**2.+thvelpar(j)**2.)*(radiuswet(i)+radiuswet(j)))
     211     beta(i,j)=num/denom
    186212!
    187213!--compute enhancement factor due to van der Waals forces
    188214   IF (ok_vdw .EQ. 0) THEN      !--no enhancement factor
    189      Evdw=1.0
     215      Evdw=1.0
    190216   ELSEIF (ok_vdw .EQ. 1) THEN  !--E(0) case
    191      AvdWi = AvdW/(RKBOL*t_seri(ilon,ilev))*(4.*radius(i)*radius(j))/(radius(i)+radius(j))**2.
    192      xvdW = LOG(1.+AvdWi)
    193      EvdW = 1. + avdW1*xvdW + avdW3*xvdW**3
     217      AvdWi = AvdW/(RKBOL*t_seri(ilon,ilev))*(4.*radiuswet(i)*radiuswet(j))/(radiuswet(i)+radiuswet(j))**2.
     218      xvdW = LOG(1.+AvdWi)
     219      EvdW = 1. + avdW1*xvdW + avdW3*xvdW**3
    194220   ELSEIF (ok_vdw .EQ. 2) THEN  !--E(infinity) case
    195      AvdWi = AvdW/(RKBOL*t_seri(ilon,ilev))*(4.*radius(i)*radius(j))/(radius(i)+radius(j))**2.
    196      xvdW = LOG(1.+AvdWi)
    197      EvdW = 1. + SQRT(AvdWi/3.)/(1.+bvdW0*SQRT(AvdWi)) + bvdW1*xvdW + bvdW3*xvdW**3.
     221      AvdWi = AvdW/(RKBOL*t_seri(ilon,ilev))*(4.*radiuswet(i)*radiuswet(j))/(radiuswet(i)+radiuswet(j))**2.
     222      xvdW = LOG(1.+AvdWi)
     223      EvdW = 1. + SQRT(AvdWi/3.)/(1.+bvdW0*SQRT(AvdWi)) + bvdW1*xvdW + bvdW3*xvdW**3.
    198224   ENDIF
    199225!
    … …  
    209235  denom=0.0
    210236  DO j=1, nbtr_bin
    211   denom=denom+(1.-ff(k,j,k))*beta(k,j)*tr_t(ilon,ilev,j)
     237     !    fraction of coagulation of k and j that is not giving k
     238     denom=denom+(1.-ff(k,j,k))*beta(k,j)*tr_t(ilon,ilev,j)
    212239  ENDDO
    213240
    … …  
    219246    num=0.0
    220247    DO j=1, k
    221     numi=0.0
    222     DO i=1, k-1
    223     numi=numi+ff(i,j,k)*beta(i,j)*V(i)*tr_tp1(ilon,ilev,i)*tr_t(ilon,ilev,j)
     248       numi=0.0
     249       DO i=1, k-1
     250!           
     251!           see Jacobson: " In order to conserve volume and volume concentration (which
     252!           coagulation physically does) while giving up some accuracy in number concentration"
     253!
     254!           Coagulation of i and j giving k
     255!           with V(i) and then V(j) because it considers i,j and j,i with the double loop
     256!
     257!           BUT WHY WET VOLUME V(i) in old STRATAER? tracers are already dry aerosols and coagulation
     258!           kernel beta(i,j) accounts for wet aerosols -> reply below
     259!
     260!             numi=numi+ff(i,j,k)*beta(i,j)*V(i)*tr_tp1(ilon,ilev,i)*tr_t(ilon,ilev,j)
     261            numi=numi+ff(i,j,k)*beta(i,j)*Vdry(i)*tr_tp1(ilon,ilev,i)*tr_t(ilon,ilev,j)
     262       ENDDO
     263       num=num+numi
    224264    ENDDO
    225     num=num+numi
    226     ENDDO
    227265
    228266!--calculate new concentration of other bins
    229     tr_tp1(ilon,ilev,k)=(V(k)*tr_t(ilon,ilev,k)+pdtcoag*num)/(1.+pdtcoag*denom)/V(k)
     267!      tr_tp1(ilon,ilev,k)=(V(k)*tr_t(ilon,ilev,k)+pdtcoag*num)/( (1.+pdtcoag*denom)*V(k) )
     268    tr_tp1(ilon,ilev,k)=(Vdry(k)*tr_t(ilon,ilev,k)+pdtcoag*num)/( (1.+pdtcoag*denom)*Vdry(k) )
     269!
     270!       In constant composition (no dependency on aerosol size because no kelvin effect)
     271!       V(l)= (f_r_wet(ilon,ilev)**3)*((mdw(l)/2.)**3) = (f_r_wet(ilon,ilev)**3)*Vdry(i)
     272!       so numi and num are proportional (f_r_wet(ilon,ilev)**3)
     273!       and so
     274!        tr_tp1(ilon,ilev,k)=(V(k)*tr_t(ilon,ilev,k)+pdtcoag*num)/( (1.+pdtcoag*denom)*V(k) )
     275!                     =(Vdry(k)*tr_t(ilon,ilev,k)+pdtcoag*num_dry)/( (1.+pdtcoag*denom)*Vdry(k) )
     276!          with num_dry=...beta(i,j)*Vdry(i)*....
     277!       so in old STRATAER (.not.flag_new_strat_compo), it was correct
    230278  ENDIF
    231279
    … …  
    234282!--convert tracer concentration back from [number/m3] to [number/KgA] and write into tr_seri
    235283  DO i=1, nbtr_bin
    236    tr_seri(ilon,ilev,i+nbtr_sulgas) = tr_tp1(ilon,ilev,i) / zrho
     284     tr_seri(ilon,ilev,i+nbtr_sulgas) = tr_tp1(ilon,ilev,i) / zrho
    237285  ENDDO
    238286
    … …  
    240288  ENDDO !--end of loop klev
    241289  ENDDO !--end of loop klon
     290! *********************************************
    242291
    243292END SUBROUTINE COAGULATE

  • LMDZ6/branches/cirrus/libf/phylmd/StratAer/cond_evap_tstep_mod.F90

    r3677 r5202  
    99CONTAINS
    1010
     11      SUBROUTINE condens_evapor_rate_kelvin(R2SO4G,t_seri,pplay,R2SO4, &
     12          & DENSO4,f_r_wet,R2SO4ik,DENSO4ik,f_r_wetik,FL,ASO4,DNDR)
     13!
     14!     INPUT:
     15!     R2SO4G: number density of gaseous H2SO4 [molecules/cm3]
     16!     t_seri: temperature (K)
     17!     pplay: pressure (Pa)
     18!     R2SO4: aerosol H2SO4 weight fraction (percent) - flat surface (does not depend on aerosol size)
     19!     DENSO4: aerosol density (gr/cm3)
     20!     f_r_wet: factor for converting dry to wet radius
     21!        assuming 'flat surface' composition (does not depend on aerosol size)
     22!     variables that depends on aerosol size because of Kelvin effect
     23!     R2SO4Gik: number density of gaseous H2SO4 [molecules/cm3] - depends on aerosol size
     24!     DENSO4ik: aerosol density (gr/cm3) - depends on aerosol size
     25!     f_r_wetik: factor for converting dry to wet radius - depends on aerosol size
     26!     RRSI: radius [cm]
     27
     28      USE aerophys
     29      USE infotrac_phy
     30      USE YOMCST, ONLY : RPI
     31      USE sulfate_aer_mod, ONLY : wph2so4, surftension, solh2so4, rpmvh2so4
     32      USE strataer_local_var_mod, ONLY : ALPH2SO4, RRSI
     33     
     34      IMPLICIT NONE
     35     
     36      REAL, PARAMETER :: third=1./3.
     37     
     38      ! input variables
     39      REAL            :: R2SO4G !H2SO4 number density [molecules/cm3]
     40      REAL            :: t_seri
     41      REAL            :: pplay
     42      REAL            :: R2SO4
     43      REAL            :: DENSO4
     44      REAL            :: f_r_wet
     45      REAL            :: R2SO4ik(nbtr_bin), DENSO4ik(nbtr_bin), f_r_wetik(nbtr_bin)
     46     
     47      ! output variables
     48      REAL            :: FL(nbtr_bin)
     49      REAL            :: ASO4(nbtr_bin)
     50      REAL            :: DNDR(nbtr_bin)
     51     
     52      ! local variables
     53      INTEGER            :: IK
     54      REAL            :: ALPHA,CST
     55      REAL            :: WH2(nbtr_bin)
     56      REAL            :: RP,VTK,AA,FL1,RKNUD
     57      REAL            :: DND
     58      REAL            :: ATOT,AH2O
     59      REAL            :: RRSI_wet(nbtr_bin)
     60      REAL            :: FPATH, WPP, XA, FKELVIN
     61      REAL            :: surtens, mvh2so4, temp
     62     
     63! ///    MOLEC CONDENSATION GROWTH (DUE TO CHANGES IN H2SO4 AND SO H2O)
     64!    ------------------------------------------------------------------
     65!                                  EXCEPT CN
     66!       RK:H2SO4 WEIGHT PERCENT DOESN'T CHANGE
     67!     BE CAREFUL,H2SO4 WEIGHT PERCENTAGE
     68
     69!                   MOLECULAR ACCOMODATION OF H2SO4
     70!     H2SO4 accommodation  coefficient [condensation/evaporation]
     71      ALPHA = ALPH2SO4
     72!      FPLAIR=(2.281238E-5)*TAIR/PAIR
     73!     1.E2 (m to cm),
     74      CST=1.E2*2.281238E-5
     75!     same expression as in coagulate
     76!     in coagulate: mean free path of air (Pruppacher and Klett, 2010, p.417) [m]
     77!     mnfrpth=6.6E-8*(1.01325E+5/pplay(ilon,ilev))*(t_seri(ilon,ilev)/293.15)
     78!     mnfrpth=2.28E-5*t_seri/pplay
     79     
     80      temp = min( max(t_seri, 190.), 300.) ! 190K <= temp <= 300K
     81     
     82      RRSI_wet(:)=RRSI(:)*f_r_wetik(:)
     83
     84!     Pruppa and Klett
     85      FPATH=CST*t_seri/pplay
     86   
     87!     H2SO4 mass fraction in aerosol
     88      WH2(:)=R2SO4ik(:)*1.0E-2
     89
     90!                               ACTIVITY COEFFICIENT(SEE GIAUQUE,1951)
     91!                               AYERS ET AL (1980)
     92!                                  (MU-MU0)
     93!      RP=-10156.0/t_seri +16.259-(ACTSO4*4.184)/(8.31441*t_seri)
     94!                                  DROPLET H2SO4 PRESSURE IN DYN.CM-2
     95!      RP=EXP(RP)*1.01325E6/0.086
     96!!      RP=EXP(RP)*1.01325E6
     97!                                  H2SO4 NUMBER DENSITY NEAR DROPLET
     98
     99!      DND=RP*6.02E23/(8.31E7*t_seri)
     100
     101!                                 KELVIN EFFECT FACTOR
     102!CK 20160613: bug fix, removed factor 250 (from original code by S. Bekki)
     103!!      AA =2.0*MH2O*72.0/(DENSO4*BOLZ*t_seri*250.0)
     104!      AA =2.0*MH2O*72.0/(DENSO4*BOLZ*t_seri)
     105
     106!                                  MEAN KINETIC VELOCITY
     107!     DYN*CM*K/(K*GR)=(CM/SEC2)*CM
     108!                                  IN CM/SEC
     109      VTK=SQRT(8.0*BOLZ*t_seri/(RPI*MH2SO4))
     110!                                 KELVIN EFFECT FACTOR
     111
     112!     Loop on bin radius (RRSI in cm)
     113      DO IK=1,nbtr_bin
     114
     115      IF(R2SO4ik(IK) > 0.0) THEN
     116
     117!       h2so4 mass fraction (0<wpp<1)
     118        wpp=R2SO4ik(IK)*1.e-2   
     119        xa=18.*wpp/(18.*wpp+98.*(1.-wpp))
     120!       equilibrium h2so4 number density over H2SO4/H2O solution (molec/cm3)
     121        DND=solh2so4(t_seri,xa)
     122!          KELVIN EFFECT: 
     123!       surface tension (mN/m=1.e-3.kg/s2) = f(T,h2so4 mole fraction)
     124        surtens=surftension(temp,xa)
     125!       partial molar volume of h2so4 (cm3.mol-1 =1.e-6.m3.mol-1)
     126        mvh2so4= rpmvh2so4(temp,R2SO4ik(IK))
     127!       Kelvin factor (MKS)
     128        fkelvin=exp( 2.*1.e-3*surtens*1.e-6*mvh2so4/ (1.e-2*RRSI_wet(IK)*rgas*temp) )
     129!                             
     130        DNDR(IK) =DND*fkelvin
     131
     132        FL1=RPI*ALPHA*VTK*(R2SO4G-DNDR(IK))
     133
     134!       TURCO(1979) FOR HNO3:ALH2SO4 CONDENSATION= ALH2SO4 EVAPORATION
     135!       RPI*R2*VTK IS EQUIVALENT TO DIFFUSION COEFFICIENT
     136!       EXTENSION OF THE RELATION FOR DIFFUSION KINETICS
     137!       KNUDSEN NUMBER FPATH/RRSI
     138!       NEW VERSION (SEE NOTES)
     139        RKNUD=FPATH/RRSI_wet(IK)
     140!       SENFELD
     141        FL(IK)=FL1*RRSI_wet(IK)**2*( 1.0 +RKNUD ) &
     142     &     /( 1.0 +ALPHA/(2.0*RKNUD) +RKNUD )
     143!       TURCO
     144!        RL= (4.0/3.0 +0.71/RKNUD)/(1.0+1.0/RKNUD)
     145!     *         +4.0*(1.0-ALPHA)/(3.0*ALPHA)
     146!        FL=FL1*RRSI(IK)*RRSI(IK)
     147!     *         /( (3.0*ALPHA/4.0)*(1.0/RKNUD+RL*ALPHA) )
     148
     149!                         INITIAL NUMBER OF H2SO4 MOLEC OF 1 DROPLET
     150        ATOT=4.0*RPI*DENSO4ik(IK)*(RRSI_wet(IK)**3)/3.0 !attention: g and cm
     151        ASO4(IK)=WH2(IK)*ATOT/MH2SO4 !attention: g
     152!        ATOT=4.0*RPI*dens_aer(I,J)/1000.*(RRSI(IK)**3)/3.0
     153!        ASO4=mfrac_H2SO4*ATOT/MH2SO4
     154!                        INITIAL NUMBER OF H2O MOLEC OF 1 DROPLET
     155        AH2O=(1.0-WH2(IK))*ATOT/MH2O !attention: g
     156
     157!       CHANGE OF THE NUMBER OF H2SO4 MOLEC OF 1 DROPLET DURING DT
     158!       IT IS FOR KEM BUT THERE ARE OTHER WAYS
     159
     160      ENDIF 
     161
     162      ENDDO !loop over bins
     163
     164      END SUBROUTINE condens_evapor_rate_kelvin
     165     
     166!********************************************************************
    11167      SUBROUTINE condens_evapor_rate(R2SO4G,t_seri,pplay,ACTSO4,R2SO4, &
    12                    & DENSO4,f_r_wet,RRSI,Vbin,FL,ASO4,DNDR)
     168                   & DENSO4,f_r_wet,FL,ASO4,DNDR)
    13169!
    14170!     INPUT:
    … …  
    22178      USE infotrac_phy
    23179      USE YOMCST, ONLY : RPI
     180      USE strataer_local_var_mod, ONLY : ALPH2SO4, RRSI
    24181
    25182      IMPLICIT NONE
    … …  
    33190      REAL DENSO4
    34191      REAL f_r_wet
    35       REAL RRSI(nbtr_bin)
    36       REAL Vbin(nbtr_bin)
    37 
     192     
    38193      ! output variables
    39194      REAL FL(nbtr_bin)
    … …  
    48203      REAL ATOT,AH2O
    49204      REAL RRSI_wet(nbtr_bin)
    50       REAL Vbin_wet(nbtr_bin)
    51       REAL MH2SO4,MH2O,BOLZ,FPATH
     205      REAL FPATH
    52206
    53207! ///    MOLEC CONDENSATION GROWTH (DUE TO CHANGES IN H2SO4 AND SO H2O)
    … …  
    57211!     BE CAREFUL,H2SO4 WEIGHT PERCENTAGE
    58212
    59 !                   WEIGHT OF 1 MOLEC IN G
    60       MH2O  =1000.*mH2Omol !18.016*1.66E-24
    61       MH2SO4=1000.*mH2SO4mol !98.082*1.66E-24
    62 !                   BOLTZMANN CONSTANTE IN DYN.CM/K
    63       BOLZ  =1.381E-16
    64213!                   MOLECULAR ACCOMODATION OF H2SO4
    65 !     raes and van dingen
    66       ALPHA =0.1   
     214!     H2SO4 accommodation coefficient [condensation/evaporation]
     215      ALPHA = ALPH2SO4
    67216!      FPLAIR=(2.281238E-5)*TAIR/PAIR
    68217!     1.E2 (m to cm),
    69218      CST=1.E2*2.281238E-5
    70219
    71       ! compute local wet particle radius and volume
     220      ! compute local wet particle radius [cm]
    72221      RRSI_wet(:)=RRSI(:)*f_r_wet
    73       Vbin_wet(:)=Vbin(:)*f_r_wet**3
    74 
     222     
    75223!     Pruppa and Klett
    76224      FPATH=CST*t_seri/pplay
    … …  
    138286
    139287!********************************************************************
    140       SUBROUTINE cond_evap_part(dt,FL,ASO4,f_r_wet,RRSI,Vbin,tr_seri)
     288      SUBROUTINE condens_evapor_part(dt,FL,ASO4,f_r_wet,tr_seri)
    141289
    142290      USE aerophys
    143291      USE infotrac_phy
    144292      USE YOMCST, ONLY : RPI
    145 
     293      USE strataer_local_var_mod, ONLY : RRSI,Vbin
     294     
    146295      IMPLICIT NONE
    147296
    … …  
    151300      REAL ASO4(nbtr_bin)
    152301      REAL f_r_wet
    153       REAL RRSI(nbtr_bin)
    154       REAL Vbin(nbtr_bin)
    155 
     302     
    156303      ! output variables
    157304      REAL tr_seri(nbtr)
    158 
     305     
    159306      ! local variables
    160307      REAL tr_seri_new(nbtr)
    … …  
    211358      tr_seri(:)=tr_seri_new(:)
    212359
    213       END SUBROUTINE cond_evap_part
     360      END SUBROUTINE condens_evapor_part
    214361
    215362END MODULE cond_evap_tstep_mod

  • LMDZ6/branches/cirrus/libf/phylmd/StratAer/micphy_tstep.F90

    r4601 r5202  
    88  USE aerophys
    99  USE infotrac_phy, ONLY : nbtr_bin, nbtr_sulgas, nbtr, id_H2SO4_strat
    10   USE phys_local_var_mod, ONLY: mdw, budg_3D_nucl, budg_3D_cond_evap, budg_h2so4_to_part, R2SO4, DENSO4, f_r_wet
     10  USE phys_local_var_mod, ONLY: mdw, budg_3D_nucl, budg_3D_cond_evap, budg_h2so4_to_part, R2SO4, DENSO4, &
     11       f_r_wet, R2SO4B, DENSO4B, f_r_wetB
    1112  USE nucleation_tstep_mod
    1213  USE cond_evap_tstep_mod
    … …  
    1415  USE YOMCST, ONLY : RPI, RD, RG
    1516  USE print_control_mod, ONLY: lunout
    16   USE strataer_local_var_mod
     17  USE strataer_local_var_mod ! contains also RRSI and Vbin
    1718 
    1819  IMPLICIT NONE
    … …  
    3536  REAL                      :: ntot !total number of molecules in the critical cluster (ntot>4)
    3637  REAL                      :: x    ! molefraction of H2SO4 in the critical cluster     
    37   REAL Vbin(nbtr_bin)
    3838  REAL a_xm, b_xm, c_xm
    3939  REAL PDT, dt
    4040  REAL H2SO4_init
    4141  REAL ACTSO4(klon,klev)
    42   REAL RRSI(nbtr_bin)
    4342  REAL nucl_rate
    4443  REAL cond_evap_rate
    … …  
    4847  REAL DNDR(nbtr_bin)
    4948  REAL H2SO4_sat
    50 
    51   DO it=1,nbtr_bin
    52     Vbin(it)=4.0*RPI*((mdw(it)/2.)**3)/3.0
    53   ENDDO
    54 
     49  REAL R2SO4ik(nbtr_bin), DENSO4ik(nbtr_bin), f_r_wetik(nbtr_bin)
     50 
    5551  !coefficients for H2SO4 density parametrization used for nucleation if ntot<4
    5652  a_xm = 0.7681724 + 1.*(2.1847140 + 1.*(7.1630022 + 1.*(-44.31447 + &
    … …  
    6157       & 1.*(7.990811e-4 + 1.*(-7.458060e-4 + 1.*2.58139e-4 )))))
    6258
    63   ! STRAACT (R2SO4, t_seri -> H2SO4 activity coefficient (ACTSO4)) for cond/evap
    64   CALL STRAACT(ACTSO4)
    65 
    66   ! compute particle radius in cm RRSI from diameter in m
    67   DO it=1,nbtr_bin
    68     RRSI(it)=mdw(it)/2.*100.
    69   ENDDO
    70 
     59  IF(.not.flag_new_strat_compo) THEN
     60     ! STRAACT (R2SO4, t_seri -> H2SO4 activity coefficient (ACTSO4)) for cond/evap
     61     CALL STRAACT(ACTSO4)
     62  ENDIF
     63 
    7164  DO ilon=1, klon
    7265!
    … …  
    10497      ENDIF
    10598      ! compute cond/evap rate in kg(H2SO4)/kgA/s
    106       CALL condens_evapor_rate(rhoa,t_seri(ilon,ilev),pplay(ilon,ilev), &
    107              & ACTSO4(ilon,ilev),R2SO4(ilon,ilev),DENSO4(ilon,ilev),f_r_wet(ilon,ilev), &
    108              & RRSI,Vbin,FL,ASO4,DNDR)
     99      IF(flag_new_strat_compo) THEN
     100         R2SO4ik(:)   = R2SO4B(ilon,ilev,:)
     101         DENSO4ik(:)  = DENSO4B(ilon,ilev,:)
     102         f_r_wetik(:) = f_r_wetB(ilon,ilev,:)
     103         CALL condens_evapor_rate_kelvin(rhoa,t_seri(ilon,ilev),pplay(ilon,ilev), &
     104              & R2SO4(ilon,ilev),DENSO4(ilon,ilev),f_r_wet(ilon,ilev), &
     105              & R2SO4ik,DENSO4ik,f_r_wetik,FL,ASO4,DNDR)
     106      ELSE
     107         CALL condens_evapor_rate(rhoa,t_seri(ilon,ilev),pplay(ilon,ilev), &
     108              & ACTSO4(ilon,ilev),R2SO4(ilon,ilev),DENSO4(ilon,ilev),f_r_wet(ilon,ilev), &
     109              & FL,ASO4,DNDR)
     110      ENDIF
    109111      ! Compute H2SO4 saturate vapor for big particules
    110112      H2SO4_sat = DNDR(nbtr_bin)/(pplay(ilon,ilev)/t_seri(ilon,ilev)/RD/1.E6/mH2SO4mol)
    … …  
    127129      tr_seri(ilon,ilev,id_H2SO4_strat)=MAX(0.,tr_seri(ilon,ilev,id_H2SO4_strat)-(nucl_rate+cond_evap_rate)*dt)
    128130      ! apply cond to bins
    129       CALL cond_evap_part(dt,FL,ASO4,f_r_wet(ilon,ilev),RRSI,Vbin,tr_seri(ilon,ilev,:))
     131      CALL condens_evapor_part(dt,FL,ASO4,f_r_wet(ilon,ilev),tr_seri(ilon,ilev,:))
    130132      ! apply nucl. to bins
    131       CALL nucleation_part(nucl_rate,ntot,x,dt,Vbin,tr_seri(ilon,ilev,:))
     133      CALL nucleation_part(nucl_rate,ntot,x,dt,tr_seri(ilon,ilev,:))
    132134      ! compute fluxes as diagnostic in [kg(S)/m2/layer/s] (now - for evap and + for cond)
    133135      budg_3D_cond_evap(ilon,ilev)=budg_3D_cond_evap(ilon,ilev)+mSatom/mH2SO4mol &
    … …  
    142144        & *pplay(ilon,ilev)/t_seri(ilon,ilev)/RD/1.E6/mH2SO4mol
    143145    ! compute cond/evap rate in kg(H2SO4)/kgA/s (now only evap for pdtphys)
    144     CALL condens_evapor_rate(rhoa,t_seri(ilon,ilev),pplay(ilon,ilev), &
    145            & ACTSO4(ilon,ilev),R2SO4(ilon,ilev),DENSO4(ilon,ilev),f_r_wet(ilon,ilev), &
    146            & RRSI,Vbin,FL,ASO4,DNDR)
     146    IF(flag_new_strat_compo) THEN
     147       CALL condens_evapor_rate_kelvin(rhoa,t_seri(ilon,ilev),pplay(ilon,ilev), &
     148            & R2SO4(ilon,ilev),DENSO4(ilon,ilev),f_r_wet(ilon,ilev), &
     149            & R2SO4ik,DENSO4ik,f_r_wetik,FL,ASO4,DNDR)
     150    ELSE
     151       CALL condens_evapor_rate(rhoa,t_seri(ilon,ilev),pplay(ilon,ilev), &
     152            & ACTSO4(ilon,ilev),R2SO4(ilon,ilev),DENSO4(ilon,ilev),f_r_wet(ilon,ilev), &
     153            & FL,ASO4,DNDR)
     154    ENDIF
    147155    ! limit evaporation (negative FL) over one physics time step to H2SO4 content of the droplet
    148156    DO it=1,nbtr_bin
    … …  
    159167    tr_seri(ilon,ilev,id_H2SO4_strat)=MAX(0.,tr_seri(ilon,ilev,id_H2SO4_strat)-evap_rate*pdtphys)
    160168    ! apply evap to bins
    161     CALL cond_evap_part(pdtphys,FL,ASO4,f_r_wet(ilon,ilev),RRSI,Vbin,tr_seri(ilon,ilev,:))
     169    CALL condens_evapor_part(pdtphys,FL,ASO4,f_r_wet(ilon,ilev),tr_seri(ilon,ilev,:))
    162170    ! compute fluxes as diagnostic in [kg(S)/m2/layer/s] (now - for evap and + for cond)
    163171    budg_3D_cond_evap(ilon,ilev)=budg_3D_cond_evap(ilon,ilev)+mSatom/mH2SO4mol &

  • LMDZ6/branches/cirrus/libf/phylmd/StratAer/miecalc_aer.F90

    r3677 r5202  
    1616
    1717  USE phys_local_var_mod, ONLY: tr_seri, mdw, alpha_bin, piz_bin, cg_bin
    18   USE aerophys
     18  USE aerophys, ONLY: dens_aer_dry, dens_aer_ref, V_rat
    1919  USE aero_mod
    2020  USE infotrac_phy, ONLY : nbtr, nbtr_bin, nbtr_sulgas, id_SO2_strat
    … …  
    226226    40000.000,    0.2500,   1.48400,   1.0000E-08, &
    227227    50000.000,    0.2000,   1.49800,   1.0000E-08 /), (/nb_lambda_h2so4,4/), order=(/2,1/) )
    228 
    229   !--initialising dry diameters to geometrically spaced mass/volume (see Jacobson 1994)
    230     mdw(1)=mdwmin
    231     IF (V_rat.LT.1.62) THEN ! compensate for dip in second bin for lower volume ratio
    232       mdw(2)=mdw(1)*2.**(1./3.)
    233       DO it=3, nbtr_bin
    234         mdw(it)=mdw(it-1)*V_rat**(1./3.)
    235       ENDDO
    236     ELSE
    237       DO it=2, nbtr_bin
    238         mdw(it)=mdw(it-1)*V_rat**(1./3.)
    239       ENDDO
    240     ENDIF
    241     WRITE(lunout,*) 'init mdw=', mdw
    242 
     228     
    243229    !--compute particle radius for a composition of 75% H2SO4 / 25% H2O at T=293K
    244230    DO bin_number=1, nbtr_bin

  • LMDZ6/branches/cirrus/libf/phylmd/StratAer/nucleation_tstep_mod.F90

    r4912 r5202  
    7070!--------------------------------------------------------------------------------------------------
    7171
    72 SUBROUTINE nucleation_part(nucl_rate,ntot,x,dt,Vbin,tr_seri)
     72SUBROUTINE nucleation_part(nucl_rate,ntot,x,dt,tr_seri)
    7373
    7474  USE aerophys
    7575  USE infotrac_phy
    76 
     76  USE strataer_local_var_mod, ONLY : Vbin
     77 
    7778  IMPLICIT NONE
    7879
    … …  
    8283  REAL x    ! mole raction of H2SO4 in the critical cluster
    8384  REAL dt
    84   REAL Vbin(nbtr_bin)
    85 
     85 
    8686  ! output variable
    8787  REAL tr_seri(nbtr)

  • LMDZ6/branches/cirrus/libf/phylmd/StratAer/strataer_local_var_mod.F90

    r4767 r5202  
    5151 
    5252  !============= NUCLEATION VARS =============
     53  ! MOLECULAR ACCOMODATION OF H2SO4 (Raes and Van Dingen)
     54  REAL,SAVE    :: ALPH2SO4               ! H2SO4 accommodation  coefficient [condensation/evaporation]
     55  !$OMP THREADPRIVATE(ALPH2SO4)
     56 
    5357  ! flag to constraint nucleation rate in a lat/pres box
    5458  LOGICAL,SAVE :: flag_nuc_rate_box      ! Nucleation rate limit or not to a lat/pres
    … …  
    6468  INTEGER,SAVE :: flh2o  ! ds stratemit : flh2o =0 (tr_seri), flh2o=1 (dq)
    6569  !$OMP THREADPRIVATE(flh2o)
    66 !  REAL,ALLOCATABLE,SAVE    :: d_q_emiss(:,:)
    67 !  !$OMP THREADPRIVATE(d_q_emiss)
    6870 
    6971  REAL,ALLOCATABLE,SAVE    :: budg_emi(:,:)            !DIMENSION(klon,n)
    … …  
    144146  !$OMP THREADPRIVATE(day_emit_roc)
    145147 
     148  REAL,ALLOCATABLE,SAVE    :: RRSI(:) ! radius [cm] for each aerosol size
     149  REAL,ALLOCATABLE,SAVE    :: Vbin(:) ! volume [m3] for each aerosol size 
     150  !$OMP THREADPRIVATE(RRSI, Vbin)
    146151  REAL,SAVE    :: dlat, dlon             ! delta latitude and d longitude of grid in degree
    147152  !$OMP THREADPRIVATE(dlat, dlon)
    … …  
    153158    USE print_control_mod, ONLY : lunout
    154159    USE mod_phys_lmdz_para, ONLY : is_master
    155     USE infotrac_phy, ONLY: id_OCS_strat,id_SO2_strat,id_H2SO4_strat,nbtr_sulgas
     160    USE infotrac_phy, ONLY: id_OCS_strat,id_SO2_strat,id_H2SO4_strat,nbtr_sulgas,nbtr_bin
     161    USE phys_local_var_mod, ONLY : mdw
     162    USE aerophys, ONLY: mdwmin, V_rat
     163    USE YOMCST  , ONLY : RPI
     164   
     165    INTEGER :: it
    156166   
    157167    WRITE(lunout,*) 'IN STRATAER_LOCAL_VAR INIT WELCOME!'
    … …  
    185195   
    186196    ! nuc init
     197    ALPH2SO4 = 0.1
    187198    flag_nuc_rate_box = .FALSE.
    188199    nuclat_min=0  ; nuclat_max=0
    … …  
    238249    ENDIF ! if master
    239250   
     251    !--initialising dry diameters to geometrically spaced mass/volume (see Jacobson 1994)
     252    mdw(1)=mdwmin
     253    IF (V_rat.LT.1.62) THEN ! compensate for dip in second bin for lower volume ratio
     254       mdw(2)=mdw(1)*2.**(1./3.)
     255       DO it=3, nbtr_bin
     256          mdw(it)=mdw(it-1)*V_rat**(1./3.)
     257       ENDDO
     258    ELSE
     259       DO it=2, nbtr_bin
     260          mdw(it)=mdw(it-1)*V_rat**(1./3.)
     261       ENDDO
     262    ENDIF
     263    IF (is_master) WRITE(lunout,*) 'init mdw=', mdw
     264   
     265    !   compute particle radius RRSI [cm] and volume Vbin [m3] from diameter mdw [m]
     266    ALLOCATE(RRSI(nbtr_bin), Vbin(nbtr_bin))
     267   
     268    DO it=1,nbtr_bin
     269       !     [cm]
     270       RRSI(it)=mdw(it)/2.*100.
     271       !     [m3]
     272       Vbin(it)=4.0*RPI*((mdw(it)/2.)**3)/3.0
     273    ENDDO
     274   
     275    IF (is_master) THEN
     276       WRITE(lunout,*) 'init RRSI=', RRSI
     277       WRITE(lunout,*) 'init Vbin=', Vbin
     278    ENDIF
     279   
    240280    WRITE(lunout,*) 'IN STRATAER INIT END'
    241281   

  • LMDZ6/branches/cirrus/libf/phylmd/StratAer/strataer_nuc_mod.F90

    r4601 r5202  
    1313    USE print_control_mod, ONLY : lunout
    1414    USE mod_phys_lmdz_para, ONLY : is_master
    15     USE strataer_local_var_mod, ONLY: flag_nuc_rate_box,nuclat_min,nuclat_max,nucpres_min,nucpres_max
     15    USE strataer_local_var_mod, ONLY: ALPH2SO4,flag_nuc_rate_box,nuclat_min,nuclat_max, &
     16         nucpres_min,nucpres_max
    1617   
    1718    !Config Key  = flag_nuc_rate_box
    … …  
    3031    CALL getin_p('nucpres_max',nucpres_max)
    3132   
     33    ! Read argument H2SO4 accommodation  coefficient [condensation/evaporation]
     34    CALL getin_p('alph2so4',ALPH2SO4)
     35   
    3236    !============= Print params =============
    3337    IF (is_master) THEN
     38       WRITE(lunout,*) 'IN STRATAER_NUC : ALPH2SO4 = ',alph2so4
    3439       WRITE(lunout,*) 'IN STRATAER_NUC : flag_nuc_rate_box = ',flag_nuc_rate_box
    3540       IF (flag_nuc_rate_box) THEN

  • LMDZ6/branches/cirrus/libf/phylmd/StratAer/sulfate_aer_mod.F90

    r4750 r5202  
    77
    88!*******************************************************************
    9   SUBROUTINE STRACOMP_BIN(sh,t_seri,pplay)
    10 !
    11 !   Aerosol H2SO4 weight fraction as a function of PH2O and temperature
    12 !   INPUT:
    13 !   sh: VMR of H2O
    14 !   t_seri: temperature (K)
    15 !   pplay: middle layer pression (Pa)
    16 !
    17 !   OUTPUT:
    18 !   R2SO4: aerosol H2SO4 weight fraction (percent)
     9      SUBROUTINE STRACOMP_KELVIN(sh,t_seri,pplay)
     10!
     11!     Aerosol H2SO4 weight fraction as a function of PH2O and temperature
     12!     INPUT:
     13!     sh: MMR of H2O
     14!     t_seri: temperature (K)
     15!     pplay: middle layer pression (Pa)
     16!
     17!     Modified in modules:
     18!     R2SO4: aerosol H2SO4 weight fraction (percent)
     19!     R2SO4B: aerosol H2SO4 weight fraction (percent) for each aerosol bin
     20!     DENSO4: aerosol density (gr/cm3)
     21!     DENSO4B: aerosol density (gr/cm3)for each aerosol bin
     22!     f_r_wet: factor for converting dry to wet radius
     23!        assuming 'flat surface' composition (does not depend on aerosol size)
     24!     f_r_wetB: factor for converting dry to wet radius
     25!        assuming 'curved surface' composition (depends on aerosol size)
    1926   
    20     USE dimphy, ONLY : klon,klev ! nb of longitude and altitude bands
    21     USE aerophys
    22     USE phys_local_var_mod, ONLY: R2SO4
     27      USE dimphy, ONLY : klon,klev ! nb of longitude and altitude bands
     28      USE infotrac_phy, ONLY : nbtr_bin
     29      USE aerophys
     30      USE phys_local_var_mod, ONLY: R2SO4, R2SO4B, DENSO4, DENSO4B, f_r_wet, f_r_wetB
     31      USE strataer_local_var_mod, ONLY: RRSI
     32!     WARNING: in phys_local_var_mod R2SO4B, DENSO4B, f_r_wetB (klon,klev,nbtr_bin)
     33!          and dens_aer_dry must be declared somewhere
    2334   
    24     IMPLICIT NONE
     35      IMPLICIT NONE
    2536   
    26     REAL,DIMENSION(klon,klev),INTENT(IN)          :: t_seri  ! Temperature
    27     REAL,DIMENSION(klon,klev),INTENT(IN)          :: pplay   ! pression in the middle of each layer (Pa)
    28     REAL,DIMENSION(klon,klev),INTENT(IN)          :: sh      ! specific humidity
     37      REAL,DIMENSION(klon,klev),INTENT(IN)    :: t_seri  ! Temperature
     38      REAL,DIMENSION(klon,klev),INTENT(IN)    :: pplay   ! pression in the middle of each layer (Pa)
     39      REAL,DIMENSION(klon,klev),INTENT(IN)    :: sh      ! specific humidity (kg h2o/kg air)
     40     
     41!     local variables
     42      integer         :: ilon,ilev,ik
     43      real, parameter :: rath2oair = mAIRmol/mH2Omol 
     44      real, parameter :: third = 1./3.
     45      real            :: pph2ogas(klon,klev)
     46      real            :: temp, wpp, xa, surtens, mvh2o, radwet, fkelvin, pph2okel, r2so4ik, denso4ik
     47!----------------------------------------
     48 
     49!     gas-phase h2o partial pressure (Pa)
     50!                                vmr=sh*rath2oair
     51      pph2ogas(:,:) = pplay(:,:)*sh(:,:)*rath2oair
    2952   
    30     REAL ks(7)
    31     REAL t,qh2o,ptot,pw
    32     REAL a,b,c,det
    33     REAL xsb,msb
     53      DO ilon=1,klon
     54      DO ilev=1,klev
     55         
     56        temp = max(t_seri(ilon,ilev),190.)
     57        temp = min(temp,300.)
     58
     59!    ***   H2SO4-H2O flat surface ***
     60!!       equilibrium H2O pressure over pure flat liquid water (Pa)
     61!!        pflath2o=psh2o(temp)
     62!       h2so4 weight percent(%) = f(P_h2o(Pa),T)
     63        R2SO4(ilon,ilev)=wph2so4(pph2ogas(ilon,ilev),temp) 
     64!       h2so4 mass fraction (0<wpp<1)
     65        wpp=R2SO4(ilon,ilev)*1.e-2     
     66!       mole fraction
     67        xa=18.*wpp/(18.*wpp+98.*(1.-wpp))
     68
     69!        CHECK:compare h2so4 sat/ pressure (see Marti et al., 97 & reef. therein)
     70!               R2SO4(ilon,ilev)=70.    temp=298.15
     71!        equilibrium h2so4 number density over H2SO4/H2O solution (molec/cm3)
     72!        include conversion from molec/cm3 to Pa
     73!        ph2so4=solh2so4(temp,xa)*(1.38065e-16*temp)/10.
     74!        print*,' ph2so4=',ph2so4,temp,R2SO4(ilon,ilev)
     75!        good match with Martin, et Ayers, not with Gmitro (the famous 0.086)
     76
     77!       surface tension (mN/m=1.e-3.kg/s2) = f(T,h2so4 mole fraction)
     78        surtens=surftension(temp,xa)
     79!       molar volume of pure h2o (cm3.mol-1 =1.e-6.m3.mol-1)
     80        mvh2o= rmvh2o(temp)
     81!       aerosol density (gr/cm3) = f(T,h2so4 mass fraction)
     82        DENSO4(ilon,ilev)=density(temp,wpp)
     83!           ->x1000., to have it in kg/m3
     84!       factor for converting dry to wet radius
     85        f_r_wet(ilon,ilev) = (dens_aer_dry/(DENSO4(ilon,ilev)*1.e3)/ &
     86                   &    (R2SO4(ilon,ilev)*1.e-2))**third
     87!    ***   End of H2SO4-H2O flat surface ***
     88
     89
     90!          Loop on bin radius (RRSI in cm)
     91           DO IK=1,nbtr_bin
     92 
     93!      ***   H2SO4-H2O curved surface - Kelvin effect factor ***
     94!            wet radius (m) (RRSI(IK) in [cm])
     95             if (f_r_wetB(ilon,ilev,IK) .gt. 1.0) then
     96               radwet = 1.e-2*RRSI(IK)*f_r_wetB(ilon,ilev,IK)
     97             else
     98!              H2SO4-H2O flat surface, only on the first timestep
     99               radwet = 1.e-2*RRSI(IK)*f_r_wet(ilon,ilev)
     100             endif
     101!            Kelvin factor:
     102!            surface tension (mN/m=1.e-3.kg/s2)
     103!            molar volume of pure h2o (cm3.mol-1 =1.e-6.m3.mol-1)
     104             fkelvin=exp( 2.*1.e-3*surtens*1.e-6*mvh2o/ (radwet*rgas*temp) )
     105!            equilibrium: pph2o(gas) = pph2o(liq) = pph2o(liq_flat) * fkelvin
     106!            equilibrium: pph2o(liq_flat) = pph2o(gas) / fkelvin
     107!            h2o liquid partial pressure before Kelvin effect (Pa)
     108             pph2okel = pph2ogas(ilon,ilev) / fkelvin
     109!            h2so4 weight percent(%) = f(P_h2o(Pa),temp)
     110             r2so4ik=wph2so4(pph2okel,temp)
     111!            h2so4 mass fraction (0<wpp<1)
     112             wpp=r2so4ik*1.e-2   
     113!            mole fraction
     114             xa=18.*wpp/(18.*wpp+98.*(1.-wpp))
     115!            aerosol density (gr/cm3) = f(T,h2so4 mass fraction)
     116             denso4ik=density(temp,wpp)
     117!           
     118!            recalculate Kelvin factor with surface tension and radwet
     119!                              with new R2SO4B and DENSO4B
     120             surtens=surftension(temp,xa)
     121!            wet radius (m)
     122             radwet = 1.e-2*RRSI(IK)*(dens_aer_dry/(denso4ik*1.e3)/ &
     123                   &    (r2so4ik*1.e-2))**third
     124             fkelvin=exp( 2.*1.e-3*surtens*1.e-6*mvh2o / (radwet*rgas*temp) )
     125             pph2okel=pph2ogas(ilon,ilev) / fkelvin
     126!            h2so4 weight percent(%) = f(P_h2o(Pa),temp)
     127             R2SO4B(ilon,ilev,IK)=wph2so4(pph2okel,temp)
     128!            h2so4 mass fraction (0<wpp<1)
     129             wpp=R2SO4B(ilon,ilev,IK)*1.e-2   
     130             xa=18.*wpp/(18.*wpp+98.*(1.-wpp))
     131!            aerosol density (gr/cm3) = f(T,h2so4 mass fraction)
     132             DENSO4B(ilon,ilev,IK)=density(temp,wpp)
     133!            factor for converting dry to wet radius
     134             f_r_wetB(ilon,ilev,IK) = (dens_aer_dry/(DENSO4B(ilon,ilev,IK)*1.e3)/ &
     135                   &    (R2SO4B(ilon,ilev,IK)*1.e-2))**third
     136!
     137!             print*,'R,Rwet(m),kelvin,h2so4(%),ro=',RRSI(ik),radwet,fkelvin, &
     138!              &  R2SO4B(ilon,ilev,IK),DENSO4B(ilon,ilev,IK)
     139!             print*,' equil.h2so4(molec/cm3), &
     140!              & sigma',solh2so4(temp,xa),surftension(temp,xa)
     141
     142           ENDDO
     143
     144      ENDDO
     145      ENDDO
     146
     147      RETURN
    34148   
    35     INTEGER ilon,ilev
    36     DATA ks/-21.661,2724.2,51.81,-15732.0,47.004,-6969.0,-4.6183/
    37    
    38 !*******************************************************************
    39 !***     liquid aerosols process
    40 !*******************************************************************
    41 !        BINARIES LIQUID AEROROLS:
    42    
    43     DO ilon=1,klon
    44        DO ilev=1,klev
    45          
    46           t = max(t_seri(ilon,ilev),185.)
    47           qh2o=sh(ilon,ilev)/18.*28.9
    48           ptot=pplay(ilon,ilev)/100.
    49           pw = qh2o*ptot/1013.0
    50           pw = min(pw,2.e-3/1013.)
    51           pw = max(pw,2.e-5/1013.)
    52          
    53 !*******************************************************************
    54 !***     binaries aerosols h2so4/h2o
    55 !*******************************************************************
    56           a = ks(3) + ks(4)/t
    57           b = ks(1) + ks(2)/t
    58           c = ks(5) + ks(6)/t + ks(7)*log(t) - log(pw)
    59          
    60           det = b**2 - 4.*a*c
    61          
    62           IF (det > 0.) THEN
    63              xsb = (-b - sqrt(det))/(2.*a)
    64              msb = 55.51*xsb/(1.0 - xsb)
    65           ELSE
    66              msb = 0.
    67           ENDIF
    68           R2SO4(ilon,ilev) = 100*msb*0.098076/(1.0 + msb*0.098076)
    69          
    70           ! H2SO4 min dilution: 0.5%
    71           R2SO4(ilon,ilev) = max( R2SO4(ilon,ilev), 0.005 )
    72        ENDDO
    73     ENDDO
    74 100 RETURN
    75    
    76   END SUBROUTINE STRACOMP_BIN
    77 
     149  END SUBROUTINE STRACOMP_KELVIN
    78150!********************************************************************
    79151    SUBROUTINE STRACOMP(sh,t_seri,pplay)
    … …  
    544616
    545617    END SUBROUTINE
    546 
    547 !****************************************************************
    548     SUBROUTINE DENH2SA_TABA(t_seri)
    549 
    550 !   AERSOL DENSITY AS A FUNCTION OF H2SO4 WEIGHT PERCENT AND T
    551 !   from Tabazadeh et al. (1994) abaques
    552 !   ---------------------------------------------
    553 
    554 !   
    555 !   INPUT:
    556 !   R2SO4: aerosol H2SO4 weight fraction (percent)
    557 !   t_seri: temperature (K)
    558 !   klon: number of latitude bands in the model domain
    559 !   klev: number of altitude bands in the model domain
    560 !   for IFS: perhaps add another dimension for longitude
    561 !
    562 !   OUTPUT:
    563 !   DENSO4: aerosol mass density (gr/cm3 = aerosol mass/aerosol volume)
    564 !   
    565     USE dimphy, ONLY : klon,klev
    566     USE phys_local_var_mod, ONLY: R2SO4, DENSO4
    567    
    568     IMPLICIT NONE
    569    
    570     REAL,DIMENSION(klon,klev),INTENT(IN)   :: t_seri  ! Temperature
    571        
    572     INTEGER i,j
    573    
    574 !----------------------------------------------------------------------
    575 !       ... Local variables
    576 !----------------------------------------------------------------------
    577       real, parameter :: a9 = -268.2616e4, a10 = 576.4288e3
    578      
    579       real :: a0, a1, a2, a3, a4, a5, a6, a7 ,a8
    580       real :: c1, c2, c3, c4, w
    581      
    582      
    583 !   Loop on model domain (2 dimension for UPMC model; 3 for IFS)
    584     DO i=1,klon
    585        DO j=1,klev
    586 !----------------------------------------------------------------------
    587 !       ... Temperature variables
    588 !----------------------------------------------------------------------
    589           c1 = t_seri(I,J)- 273.15
    590           c2 = c1**2
    591           c3 = c1*c2
    592           c4 = c1*c3
    593 !----------------------------------------------------------------------
    594 !       Polynomial Coefficients
    595 !----------------------------------------------------------------------
    596           a0 = 999.8426 + 334.5402e-4*c1 - 569.1304e-5*c2
    597           a1 = 547.2659 - 530.0445e-2*c1 + 118.7671e-4*c2 + 599.0008e-6*c3
    598           a2 = 526.295e1 + 372.0445e-1*c1 + 120.1909e-3*c2 - 414.8594e-5*c3 + 119.7973e-7*c4
    599           a3 = -621.3958e2 - 287.7670*c1 - 406.4638e-3*c2 + 111.9488e-4*c3 + 360.7768e-7*c4
    600           a4 = 409.0293e3 + 127.0854e1*c1 + 326.9710e-3*c2 - 137.7435e-4*c3 - 263.3585e-7*c4
    601           a5 = -159.6989e4 - 306.2836e1*c1 + 136.6499e-3*c2 + 637.3031e-5*c3
    602           a6 = 385.7411e4 + 408.3717e1*c1 - 192.7785e-3*c2
    603           a7 = -580.8064e4 - 284.4401e1*c1
    604           a8 = 530.1976e4 + 809.1053*c1
    605 !----------------------------------------------------------------------
    606 !       ... Summation
    607 !----------------------------------------------------------------------
    608 !     w : H2SO4 Weight fraction
    609           w=r2SO4(i,j)*0.01
    610           DENSO4(i,j) = 0.001*(a0 + w*(a1 + w*(a2 + w*(a3 + w*(a4 +  &
    611                w*(a5 + w*(a6 + w*(a7 + w*(a8 + w*(a9 + w*a10))))))))))
    612           DENSO4(i,j) = max (0.0, DENSO4(i,j) )
    613 
    614        ENDDO
    615     ENDDO
    616 
    617   END SUBROUTINE DENH2SA_TABA
    618618 
    619619!****************************************************************
    … …  
    764764       RETURN
    765765       END SUBROUTINE
    766 
     766!********************************************************************
     767!-----------------------------------------------------------------------
     768      real function psh2so4(T) result(psh2so4_out)
     769!     equilibrium H2SO4 pressure over pure H2SO4 solution (Pa)
     770!
     771!---->Ayers et.al. (1980), GRL (7) pp 433-436
     772!     plus corrections for lower temperatures by Kulmala and Laaksonen (1990)
     773!     and Noppel et al. (1990)
     774
     775      implicit none
     776      real, intent(in) :: T
     777      real, parameter ::      &
     778              &  b1=1.01325e5, &
     779              &  b2=11.5,  &
     780              &  b3=1.0156e4,  &
     781              &  b4=0.38/545., &
     782              &  tref=360.15
     783
     784!     saturation vapor pressure ( N/m2 = Pa = kg/(m.s2) )
     785      psh2so4_out=b1*exp(  -b2 +b3*( 1./tref-1./T  &
     786           &  +b4*(1.+log(tref/T)-tref/T) )   ) 
     787
     788       return
     789    end function psh2so4
     790!-----------------------------------------------------------------------
     791    real function ndsh2so4(T) result(ndsh2so4_out)
     792!     equilibrium H2SO4 number density over pure H2SO4 (molec/cm3)
     793
     794      implicit none
     795      real, intent(in) :: T
     796      real :: presat
     797
     798!     Boltzmann constant ( 1.38065e-23 J/K = m2⋅kg/(s2⋅K) )
     799!      akb idem in cm2⋅g/(s2⋅K)
     800      real, parameter :: akb=1.38065e-16
     801
     802!     pure h2so4 saturation vapor pressure (Pa)
     803      presat=psh2so4(T)
     804!     saturation number density (1/cm3) - (molec/cm3)
     805      ndsh2so4_out=presat*10./(akb*T)
     806
     807       return
     808     end function ndsh2so4
     809!-----------------------------------------------------------------------
     810     real function psh2o(T) result(psh2o_out)
     811!     equilibrium H2O pressure over pure liquid water (Pa)
     812!
     813      implicit none
     814      real, intent(in) :: T
     815
     816      if(T.gt.229.) then
     817!        Preining et al., 1981 (from Kulmala et al., 1998)
     818!        saturation vapor pressure (N/m2 = 1 Pa = 1 kg/(m·s2))
     819         psh2o_out=exp( 77.34491296  -7235.424651/T &
     820             &                 -8.2*log(T) + 5.7133e-3*T )
     821      else
     822!        Tabazadeh et al., 1997, parameterization for 185<T<260
     823!        saturation water vapor partial pressure (mb = hPa =1.E2 kg/(m·s2))
     824!        or from Clegg and Brimblecombe , J. Chem. Eng., p43, 1995.
     825;
     826         psh2o_out=18.452406985 -3505.1578807/T &
     827              &    -330918.55082/(T*T)             &
     828              &    +12725068.262/(T*T*T)
     829!        in Pa
     830         psh2o_out=100.*exp(psh2o_out)
     831      end if
     832!      print*,psh2o_out
     833     
     834       return
     835     end function psh2o
     836!-----------------------------------------------------------------------
     837     real function density(T,so4mfrac) result(density_out)
     838!        calculation of particle density (gr/cm3)
     839
     840!        requires Temperature (T) and acid mass fraction (so4mfrac)
     841!---->Vehkamaeki et al. (2002)
     842
     843      implicit none
     844      real, intent(in) :: T, so4mfrac
     845      real, parameter :: &
     846           &      a1= 0.7681724,&
     847           &      a2= 2.184714, &
     848           &      a3= 7.163002, &
     849           &      a4=-44.31447, &
     850           &      a5= 88.74606, &
     851           &      a6=-75.73729, &
     852           &      a7= 23.43228
     853      real, parameter :: &
     854           &      b1= 1.808225e-3, &
     855           &      b2=-9.294656e-3, &
     856           &      b3=-3.742148e-2, &
     857           &      b4= 2.565321e-1, &
     858           &      b5=-5.362872e-1, &
     859           &      b6= 4.857736e-1, &
     860           &      b7=-1.629592e-1
     861      real, parameter :: &
     862           &      c1=-3.478524e-6, &
     863           &      c2= 1.335867e-5, &
     864           &      c3= 5.195706e-5, &
     865           &      c4=-3.717636e-4, &
     866           &      c5= 7.990811e-4, &
     867           &      c6=-7.458060e-4, &
     868           &      c7= 2.581390e-4
     869      real :: a,b,c,so4m2,so4m3,so4m4,so4m5,so4m6
     870     
     871      so4m2=so4mfrac*so4mfrac
     872      so4m3=so4mfrac*so4m2
     873      so4m4=so4mfrac*so4m3
     874      so4m5=so4mfrac*so4m4
     875      so4m6=so4mfrac*so4m5
     876
     877      a=+a1+a2*so4mfrac+a3*so4m2+a4*so4m3 &
     878         &     +a5*so4m4+a6*so4m5+a7*so4m6
     879      b=+b1+b2*so4mfrac+b3*so4m2+b4*so4m3 &
     880         &     +b5*so4m4+b6*so4m5+b7*so4m6
     881      c=+c1+c2*so4mfrac+c3*so4m2+c4*so4m3 &
     882         &     +c5*so4m4+c6*so4m5+c7*so4m6
     883      density_out=(a+b*T+c*T*T) ! units are gm/cm**3
     884
     885       return
     886     end function density
     887!-----------------------------------------------------------------------
     888     real function surftension(T,so4frac) result(surftension_out)
     889!        calculation of surface tension (mN/meter)
     890!        requires Temperature (T) and acid mole fraction (so4frac)
     891!---->Vehkamaeki et al. (2002)
     892
     893      implicit none
     894      real,intent(in) :: T, so4frac
     895      real :: a,b,so4mfrac,so4m2,so4m3,so4m4,so4m5,so4sig
     896      real, parameter :: &
     897            &     a1= 0.11864, &
     898            &     a2=-0.11651, &
     899            &     a3= 0.76852, &
     900            &     a4=-2.40909, &
     901            &     a5= 2.95434, &
     902            &     a6=-1.25852
     903      real, parameter :: &
     904            &     b1=-1.5709e-4, &
     905            &     b2= 4.0102e-4, &
     906            &     b3=-2.3995e-3, &
     907            &     b4= 7.611235e-3, &
     908            &     b5=-9.37386e-3, &
     909            &     b6= 3.89722e-3
     910      real, parameter :: convfac=1.e3  ! convert from newton/m to dyne/cm
     911      real, parameter :: Mw=18.01528, Ma=98.079
     912
     913!     so4 mass fraction
     914      so4mfrac=Ma*so4frac/( Ma*so4frac+Mw*(1.-so4frac) )
     915      so4m2=so4mfrac*so4mfrac
     916      so4m3=so4mfrac*so4m2
     917      so4m4=so4mfrac*so4m3
     918      so4m5=so4mfrac*so4m4
     919
     920      a=+a1+a2*so4mfrac+a3*so4m2+a4*so4m3+a5*so4m4+a6*so4m5
     921      b=+b1+b2*so4mfrac+b3*so4m2+b4*so4m3+b5*so4m4+b6*so4m5
     922      so4sig=a+b*T
     923      surftension_out=so4sig*convfac
     924
     925       return
     926     end function surftension
     927!-----------------------------------------------------------------------
     928     real function wph2so4(pph2o,T) result(wph2so4_out)
     929!     Calculates the equilibrium composition of h2so4 aerosols
     930!     as a function of temperature and  H2O pressure, using
     931!     the parameterization of Tabazadeh et al., GRL, p1931, 1997.
     932!
     933!   Parameters
     934!
     935!    input:
     936!      T.....temperature (K)
     937!      pph2o..... amhbiant 2o pressure (Pa)
     938!
     939!    output:
     940!      wph2so4......sulfuric acid composition (weight percent wt % h2so4)
     941!                     = h2so4 mass fraction*100.
     942!
     943      implicit none
     944      real, intent(in) :: pph2o, T
     945     
     946      real :: aw, rh, y1, y2, sulfmolal
     947 
     948!       psh2o(T): equilibrium H2O pressure over pure liquid water (Pa)
     949!       relative humidity
     950        rh=pph2o/psh2o(T)
     951!       water activity
     952!        aw=min( 0.999,max(1.e-3,rh) )
     953        aw=min( 0.999999999,max(1.e-8,rh) )
     954
     955!       composition
     956!       calculation of h2so4 molality
     957            if(aw .le. 0.05 .and. aw .gt. 0.) then
     958               y1=12.372089320*aw**(-0.16125516114) &
     959                 &  -30.490657554*aw -2.1133114241
     960               y2=13.455394705*aw**(-0.19213122550) &
     961                 &  -34.285174607*aw -1.7620073078
     962            else if(aw .le. 0.85 .and. aw .gt. 0.05) then
     963               y1=11.820654354*aw**(-0.20786404244) &
     964                 &  -4.8073063730*aw -5.1727540348
     965               y2=12.891938068*aw**(-0.23233847708) &
     966                 &  -6.4261237757*aw -4.9005471319
     967            else
     968               y1=-180.06541028*aw**(-0.38601102592) &
     969                 &  -93.317846778*aw +273.88132245
     970               y2=-176.95814097*aw**(-0.36257048154) &
     971                 &  -90.469744201*aw +267.45509988
     972            end if
     973!        h2so4 molality (m=moles of h2so4 (solute)/ kg of h2o(solvent))
     974         sulfmolal = y1+((T-190.)*(y2-y1)/70.)
     975
     976!        for a solution containing mh2so4 and mh2o:
     977!        sulfmolal = (mh2so4(gr)/h2so4_molar_mass(gr/mole)) / (mh2o(gr)*1.e-3)
     978!        mh2o=1.e3*(mh2so4/Mh2so4)/sulfmolal=1.e3*mh2so4/(Mh2so4*sulfmolal)
     979!        h2so4_mass_fraction = mfh2so4 = mh2so4/(mh2o + mh2so4)
     980!        mh2o=mh2so4*(1-mfh2so4)/mfh2so4
     981!        combining the 2 equations
     982!        1.e3*mh2so4/(Mh2so4*sulfmolal) = mh2so4*(1-mfh2so4)/mfh2so4
     983!        1.e3/(Mh2so4*sulfmolal) = (1-mfh2so4)/mfh2so4
     984!        1000*mfh2so4 = (1-mfh2so4)*Mh2so4*sulfmolal
     985!        mfh2so4*(1000.+Mh2so4*sulfmolal) = Mh2so4*sulfmolal
     986!        mfh2so4 = Mh2so4*sulfmolal / (1000.+Mh2so4*sulfmolal)
     987!        wph2so4 (% mass fraction)= 100.*Mh2so4*sulfmolal / (1000.+Mh2so4*sulfmolal)
     988!        recall activity of i = a_i = P_i/P_pure_i and
     989!          activity coefficient of i = gamma_i = a_i/X_i (X_i: mole fraction of i)
     990!        so  P_i = gamma_i*X_i*P_pure_i
     991!        if ideal solution, gamma_i=1, P_i = X_i*P_pure_i
     992
     993!        h2so4 weight precent
     994         wph2so4_out = 9800.*sulfmolal/(98.*sulfmolal+1000.)
     995!         print*,rh,pph2o,psh2o(T),vpice(T)
     996!         print*,T,aw,sulfmolal,wph2so4_out
     997         wph2so4_out = max(wph2so4_out,15.)
     998         wph2so4_out = min(wph2so4_out,99.999)
     999
     1000       return
     1001     end function wph2so4
     1002!-----------------------------------------------------------------------
     1003     real function solh2so4(T,xa) result(solh2so4_out)
     1004!     equilibrium h2so4 number density over H2SO4/H2O solution (molec/cm3)
     1005
     1006      implicit none
     1007      real, intent(in) :: T, xa       ! T(K)  xa(H2SO4 mass fraction)
     1008     
     1009      real :: xw, a12,b12, cacta, presat
     1010     
     1011      xw=1.0-xa
     1012
     1013!     pure h2so4 saturation number density (molec/cm3)
     1014      presat=ndsh2so4(T)
     1015!     compute activity of acid
     1016      a12=5.672E3 -4.074E6/T +4.421E8/(T*T)
     1017      b12=1./0.527
     1018      cacta=10.**(a12*xw*xw/(xw+b12*xa)**2/T)
     1019!     h2so4 saturation number density over H2SO4/H2O solution (molec/cm3)
     1020      solh2so4_out=cacta*xa*presat
     1021
     1022       return
     1023     end function solh2so4
     1024!-----------------------------------------------------------------------     
     1025     real function rpmvh2so4(T,ws) result(rpmvh2so4_out)
     1026!     partial molar volume of h2so4 in h2so4/h2o solution (cm3/mole)
     1027
     1028      implicit none
     1029      real, intent(in) :: T, ws
     1030      real, dimension(22),parameter :: x=(/  &
     1031       & 2.393284E-02,-4.359335E-05,7.961181E-08,0.0,-0.198716351, &
     1032       & 1.39564574E-03,-2.020633E-06,0.51684706,-3.0539E-03,4.505475E-06, &
     1033       & -0.30119511,1.840408E-03,-2.7221253742E-06,-0.11331674116, &
     1034       & 8.47763E-04,-1.22336185E-06,0.3455282,-2.2111E-03,3.503768245E-06, &
     1035       & -0.2315332,1.60074E-03,-2.5827835E-06/)
     1036     
     1037      real :: w
     1038
     1039        w=ws*0.01
     1040        rpmvh2so4_out=x(5)+x(6)*T+x(7)*T*T+(x(8)+x(9)*T+x(10)*T*T)*w &
     1041          +(x(11)+x(12)*T+x(13)*T*T)*w*w
     1042!       h2so4 partial molar volume in h2so4/h2o solution (cm3/mole)
     1043        rpmvh2so4_out=rpmvh2so4_out*1000.
     1044       
     1045       return
     1046     end function rpmvh2so4
     1047!-----------------------------------------------------------------------
     1048     real function rmvh2o(T) result(rmvh2o_out)
     1049!     molar volume of pure h2o (cm3/mole)
     1050
     1051       implicit none
     1052       real, intent(in) :: T
     1053       real, parameter :: x1=2.393284E-02,x2=-4.359335E-05,x3=7.961181E-08
     1054
     1055!      1000: L/mole ->  cm3/mole
     1056!      pure h2o molar volume (cm3/mole)
     1057       rmvh2o_out=(x1+x2*T+x3*T*T)*1000.
     1058       
     1059       return
     1060     end function rmvh2o
     1061!
    7671062END MODULE sulfate_aer_mod

  • LMDZ6/branches/cirrus/libf/phylmd/StratAer/traccoag_mod.F90

    r4769 r5202  
    99       presnivs, xlat, xlon, pphis, pphi, &
    1010       t_seri, pplay, paprs, sh, rh, tr_seri)
    11 
     11   
    1212    USE phys_local_var_mod, ONLY: mdw, R2SO4, DENSO4, f_r_wet, surf_PM25_sulf, &
    13         & budg_emi_ocs, budg_emi_so2, budg_emi_h2so4, budg_emi_part
    14 
     13        & budg_emi_ocs, budg_emi_so2, budg_emi_h2so4, budg_emi_part, &
     14        & R2SO4B, DENSO4B, f_r_wetB, sulfmmr, SAD_sulfate, sulfmmr_mode, nd_mode, reff_sulfate
     15   
    1516    USE dimphy
    1617    USE infotrac_phy, ONLY : nbtr_bin, nbtr_sulgas, nbtr, id_SO2_strat
    … …  
    5657    REAL                                   :: m_aer_emiss_vol_daily ! daily injection mass emission
    5758    REAL                                   :: m_aer               ! aerosol mass
    58     INTEGER                                :: it, k, i, ilon, ilev, itime, i_int, ieru
     59    INTEGER                                :: it, k, i, j, ilon, ilev, itime, i_int, ieru
    5960    LOGICAL,DIMENSION(klon,klev)           :: is_strato           ! true = above tropopause, false = below
    6061    REAL,DIMENSION(klon,klev)              :: m_air_gridbox       ! mass of air in every grid box [kg]
    … …  
    8283    INTEGER                                :: injdur_sai          ! injection duration for SAI case [days]
    8384    INTEGER                                :: yr, is_bissext
     85    REAL                                   :: samoment2, samoment3! 2nd and 3rd order moments of size distribution
    8486
    8587    IF (is_mpi_root .AND. flag_verbose_strataer) THEN
    … …  
    8890    ENDIF
    8991   
     92    !   radius [m]
    9093    DO it=1, nbtr_bin
    9194      r_bin(it)=mdw(it)/2.
    … …  
    117120
    118121    IF(flag_new_strat_compo) THEN
    119        IF(debutphy) WRITE(lunout,*) 'traccoag: USE STRAT COMPO from Tabazadeh 1994', flag_new_strat_compo
    120        ! STRACOMP (H2O, P, t_seri -> aerosol composition (R2SO4)) : binary routine (from reprobus)
    121        ! H2SO4 mass fraction in aerosol (%) from Tabazadeh et al. (1994).
    122        CALL stracomp_bin(sh,t_seri,pplay)
    123        
    124        ! aerosol density (gr/cm3) - from Tabazadeh
    125        CALL denh2sa_taba(t_seri)
     122       IF(debutphy) WRITE(lunout,*) 'traccoag: COMPO/DENSITY (Tabazadeh 97) + H2O kelvin effect', flag_new_strat_compo
     123       ! STRACOMP (H2O, P, t_seri, R -> R2SO4 + Kelvin effect) : Taba97, Socol, etc...
     124       CALL stracomp_kelvin(sh,t_seri,pplay)
    126125    ELSE
    127        IF(debutphy) WRITE(lunout,*) 'traccoag: USE STRAT COMPO from Bekki 2D model', flag_new_strat_compo
     126       IF(debutphy) WRITE(lunout,*) 'traccoag: COMPO from Bekki 2D model', flag_new_strat_compo
    128127       ! STRACOMP (H2O, P, t_seri -> aerosol composition (R2SO4))
    129128       ! H2SO4 mass fraction in aerosol (%)
    … …  
    132131       ! aerosol density (gr/cm3)
    133132       CALL denh2sa(t_seri)
     133       
     134       ! compute factor for converting dry to wet radius (for every grid box)
     135       f_r_wet(:,:) = (dens_aer_dry/(DENSO4(:,:)*1000.)/(R2SO4(:,:)/100.))**(1./3.)
    134136    ENDIF
    135137   
    136 ! compute factor for converting dry to wet radius (for every grid box)
    137     f_r_wet(:,:) = (dens_aer_dry/(DENSO4(:,:)*1000.)/(R2SO4(:,:)/100.))**(1./3.)
    138 
    139138!--calculate mass of air in every grid box
    140139    DO ilon=1, klon
    … …  
    348347    ENDDO
    349348   
     349!--compute
     350!     sulfmmr: Sulfate aerosol concentration (dry mixing ratio) (condensed H2SO4 mmr)
     351!     SAD_sulfate: SAD all aerosols (cm2/cm3) (must be WET)
     352!     sulfmmr_mode: sulfate(=H2SO4 if dry) MMR in different modes (ambiguous but based on sulfmmr, it mus be DRY(?) mmr)
     353!     nd_mode: DRY(?) particle concentration in different modes (part/m3)
     354     sulfmmr(:,:)=0.0
     355     SAD_sulfate(:,:)=0.0
     356     sulfmmr_mode(:,:,:)=0.0
     357     nd_mode(:,:,:)=0.0
     358     reff_sulfate(:,:)=0.0
     359     
     360     DO i=1,klon
     361        DO j=1,klev
     362           samoment2=0.0
     363           samoment3=0.0
     364           DO it=1, nbtr_bin
     365              !surf_PM25_sulf(i)=surf_PM25_sulf(i)+tr_seri(i,1,it+nbtr_sulgas)*m_part(i,1,it) &
     366              !assume that particles consist of ammonium sulfate at the surface (132g/mol)
     367              !and are dry at T = 20 deg. C and 50 perc. humidity
     368             
     369              !     sulfmmr_mode: sulfate(=H2SO4 if dry) MMR in different modes (based on sulfmmr, it must be DRY mmr)
     370              !     equivalent to condensed H2SO4 mmr= H2SO4 kg / kgA in bin it
     371              sulfmmr_mode(i,j,it) = tr_seri(i,j,it+nbtr_sulgas) &        ! [DRY part/kgA in bin it]
     372                   &  *(4./3.)*RPI*(mdw(it)/2.)**3.   &                   ! [mdw: dry diameter in m]
     373                   &  *dens_aer_dry                                       ! [dry aerosol mass density in kg/m3]
     374             
     375              !     sulfmmr: Sulfate aerosol concentration (dry mass mixing ratio)
     376              !     equivalent to total condensed H2SO4 mmr (H2SO4 kg / kgA
     377              sulfmmr(i,j) = sulfmmr(i,j) + sulfmmr_mode(i,j,it)
     378             
     379              !     nd_mode: particle concentration in different modes (DRY part/m3)
     380              nd_mode(i,j,it) = tr_seri(i,j,it+nbtr_sulgas) &             ! [DRY part/kgA in bin it]
     381                   & *pplay(i,j)/t_seri(i,j)/RD                           ! [air mass concentration in kg air /m3A]
     382             
     383              IF(flag_new_strat_compo) THEN
     384                 !     SAD_sulfate: SAD WET sulfate aerosols (cm2/cm3)
     385                 SAD_sulfate(i,j) = SAD_sulfate(i,j) + nd_mode(i,j,it) &     ! [DRY part/m3A (in bin it)]
     386                      &  *4.*RPI*( mdw(it)*f_r_wetB(i,j,it)/2. )**2. &       ! [WET SA of part it in m2]
     387                      &  *1.e-2                                              ! conversion from m2/m3 to cm2/cm3A
     388!    samoment2 : 2nd order moment of WET sulfate aerosols (m2/m3)
     389                 samoment2 = samoment2 + nd_mode(i,j,it) &     ! [DRY part/m3A (in bin it)]
     390                      &  *( mdw(it)*f_r_wetB(i,j,it)/2. )**2.                     ! [WET SA of part it in m2]
     391!    samoment3 : 3nd order moment of WET sulfate aerosols (cm2/cm3)
     392                 samoment3 = samoment3 + nd_mode(i,j,it) &     ! [DRY part/m3A (in bin it)]
     393                      &  *( mdw(it)*f_r_wetB(i,j,it)/2. )**3.                     ! [WET SA of part it in m2]
     394              ELSE
     395!     SAD_sulfate: SAD WET sulfate aerosols (cm2/cm3)
     396                 SAD_sulfate(i,j) = SAD_sulfate(i,j) + nd_mode(i,j,it) &     ! [DRY part/m3A (in bin it)]
     397                      &  *4.*RPI*( mdw(it)*f_r_wet(i,j)/2. )**2. &           ! [WET SA of part it in m2]
     398                      &  *1.e-2                                              ! conversion from m2/m3 to cm2/cm3A
     399!    samoment2 : 2nd order moment of WET sulfate aerosols (m2/m3)
     400                 samoment2 = samoment2 + nd_mode(i,j,it) &     ! [DRY part/m3A (in bin it)]
     401                      &  *( mdw(it)*f_r_wet(i,j)/2. )**2.                          ! [WET SA of part it in m2]
     402!    samoment3 : 3nd order moment of WET sulfate aerosols (cm2/cm3)
     403                 samoment3 = samoment3 + nd_mode(i,j,it) &     ! [DRY part/m3A (in bin it)]
     404                      &  *( mdw(it)*f_r_wet(i,j)/2. )**3.                          ! [WET SA of part it in m2]
     405              ENDIF
     406           ENDDO
     407!     reff_sulfate: effective radius of WET sulfate aerosols (cm)
     408           reff_sulfate(i,j) = (samoment3 / samoment2) &
     409                & *1.e2                                              ! conversion from m to cm
     410        ENDDO
     411     ENDDO
     412     
    350413  END SUBROUTINE traccoag
    351414

  • LMDZ6/branches/cirrus/libf/phylmd/add_phys_tend_mod.F90

    r4738 r5202  
    774774      bilh_bnd = (-(rcw-rcpd)*t_seri(1,1) + rlvtt) * rain_lsc(1) &
    775775    &         + (-(rcs-rcpd)*t_seri(1,1) + rlstt) * snow_lsc(1)
    776   CASE("bs") param
     776  CASE("bsss") param
    777777      bilq_bnd = - bs_fall(1)
    778778      bilh_bnd = (-(rcs-rcpd)*t_seri(1,1) + rlstt) * bs_fall(1)

  • LMDZ6/branches/cirrus/libf/phylmd/cdrag_mod.F90

    r4777 r5202  
    2323
    2424  USE dimphy
     25  USE coare_cp_mod, ONLY: coare_cp
     26  USE coare30_flux_cnrm_mod, ONLY: coare30_flux_cnrm
    2527  USE indice_sol_mod
    2628  USE print_control_mod, ONLY: lunout, prt_level
    … …  
    341343         LPWG    = .false.
    342344         call ini_csts
    343          call coare30_flux_cnrm(z_0m,t1(i),tsurf(i), q1(i),  &
    344              sqrt(zdu2),zgeop1(i)/RG,zgeop1(i)/RG,psol(i),qsurf(i),PQSAT, &
    345              PSFTH,PFSTQ,PUSTAR,PCD,PCDN,PCH,PCE,PRI, &
    346              PRESA,prain,pat1(i),z_0h, LPRECIP, LPWG, coeffs)
     345         block
     346           real, dimension(1) :: z0m_1d, z_0h_1d, sqrt_zdu2_1d, zgeop1_rg_1d  ! convert scalar to 1D for call
     347           z0m_1d = z0m
     348           z_0h_1d = z0h
     349           sqrt_zdu2_1d = sqrt(zdu2)
     350           zgeop1_rg_1d=zgeop1(i)/RG
     351           call coare30_flux_cnrm(z0m_1d,t1(i),tsurf(i), q1(i),  &
     352               sqrt_zdu2_1d,zgeop1_rg_1d,zgeop1_rg_1d,psol(i),qsurf(i),PQSAT, &
     353               PSFTH,PFSTQ,PUSTAR,PCD,PCDN,PCH,PCE,PRI, &
     354               PRESA,prain,pat1(i),z_0h_1d, LPRECIP, LPWG, coeffs)
     355
     356         end block
    347357         cdmm(i) = coeffs(1)
    348358         cdhh(i) = coeffs(2)

  • LMDZ6/branches/cirrus/libf/phylmd/clesphys.h

    r4951 r5202  
    110110       LOGICAL :: ok_3Deffect
    111111
     112!OB flag to activate water mass fixer in physiq
     113       LOGICAL :: ok_water_mass_fixer
     114
    112115       COMMON/clesphys/                                                 &
    113116! REAL FIRST
    … …  
    161164     &     , iflag_phytrac, ok_new_lscp, ok_bs, ok_rad_bs               &
    162165     &     ,  iflag_thermals,nsplit_thermals, tau_thermals              &
    163      &     , iflag_physiq, ok_3Deffect
     166     &     , iflag_physiq, ok_3Deffect, ok_water_mass_fixer
    164167       save /clesphys/
    165168!$OMP THREADPRIVATE(/clesphys/)

  • LMDZ6/branches/cirrus/libf/phylmd/ecrad/lmdz/calcul_cloud_overlap_decorr_len.F90

    r4911 r5202  
    146146!  ENDIF
    147147ENDIF
    148 CALL writefield_phy('latitude',latitude_deg,1)
    149 CALL writefield_phy('pressure_hl',pressure_hl,klev+1)
    150 CALL writefield_phy('Ldecorel',PDECORR_LEN_EDGES_M,klev)
     148!CALL writefield_phy('latitude',latitude_deg,1)
     149!CALL writefield_phy('pressure_hl',pressure_hl,klev+1)
     150!CALL writefield_phy('Ldecorel',PDECORR_LEN_EDGES_M,klev)
    151151! -------------------------------------------------------------------
    152152

  • LMDZ6/branches/cirrus/libf/phylmd/ecrad/lmdz/radiation_setup.F90

    r4867 r5202  
    141141           &  -9, &
    142142           &   4 /)
    143 !   rad_config%aerosol_optics_override_file_name = 'aerosol_optics_lmdz.nc'
    144143
    145144

  • LMDZ6/branches/cirrus/libf/phylmd/ecrad/lmdz/readaerosol_optic_ecrad.F90

    r4853 r5202  
    44     flag_aerosol, flag_bc_internal_mixture, itap, rjourvrai, &
    55     pdtphys, pplay, paprs, t_seri, rhcl, presnivs, &
    6      tr_seri, mass_solu_aero, mass_solu_aero_pi)
     6     tr_seri, mass_solu_aero, mass_solu_aero_pi, m_allaer)
    77!     tau_aero, piz_aero, cg_aero, &
    88!     tausum_aero, drytausum_aero, tau3d_aero )
    … …  
    1818       concso4,concno3,concoa,concbc,concss,concdust,loadso4,loadoa,loadbc,loadss,loaddust, &
    1919       loadno3,load_tmp1,load_tmp2,load_tmp3,load_tmp4,load_tmp5,load_tmp6,load_tmp7, &
    20        load_tmp8,load_tmp9,load_tmp10,m_allaer
     20       load_tmp8,load_tmp9,load_tmp10
    2121
    2222  USE infotrac_phy, ONLY: tracers, nqtot, nbtr
    … …  
    4949  REAL, DIMENSION(klon,klev), INTENT(OUT)     :: mass_solu_aero    ! Total mass for all soluble aerosols
    5050  REAL, DIMENSION(klon,klev), INTENT(OUT)     :: mass_solu_aero_pi !     -"-     preindustrial values
     51  REAL, DIMENSION(klon,klev,naero_tot), INTENT(OUT) :: m_allaer
     52  ! AI a passer par la suite en argument si besoin pour ecrad
     53  !REAL, DIMENSION(klon,klev,naero_tot), INTENT(OUT) :: m_allaer_pi !RAF
     54
    5155!  REAL, DIMENSION(klon,klev,2,NSW), INTENT(OUT) :: tau_aero    ! Aerosol optical thickness
    5256!  REAL, DIMENSION(klon,klev,2,NSW), INTENT(OUT) :: piz_aero    ! Single scattering albedo aerosol
    … …  
    8690  REAL, DIMENSION(klon,klev)   :: nitrinscoarse_pi
    8791  REAL, DIMENSION(klon,klev)   :: pdel, zrho
    88 !  REAL, DIMENSION(klon,klev,naero_tot) :: m_allaer
    89   REAL, DIMENSION(klon,klev,naero_tot) :: m_allaer_pi !RAF 
     92  REAL, DIMENSION(klon,klev,naero_tot) :: m_allaer_pi
    9093
    9194  integer :: id_ASBCM, id_ASPOMM, id_ASSO4M, id_ASMSAM, id_CSSO4M, id_CSMSAM, id_SSSSM

  • LMDZ6/branches/cirrus/libf/phylmd/ecrad/radiation/radiation_mcica_lw.F90

    r4853 r5202  
    1818!   2017-07-12  R. Hogan  Call fast adding method if only clouds scatter
    1919!   2017-10-23  R. Hogan  Renamed single-character variables
    20 
    21 #include "ecrad_config.h"
    2220
    2321module radiation_mcica_lw
    … …  
    126124    ! Identify clear-sky layers
    127125    logical :: is_clear_sky_layer(nlev)
    128 
    129     ! Temporary storage for more efficient summation
    130 #ifdef DWD_REDUCTION_OPTIMIZATIONS
    131     real(jprb), dimension(nlev+1,2) :: sum_aux
    132 #else
    133     real(jprb) :: sum_up, sum_dn
    134 #endif
    135126
    136127    ! Index of the highest cloudy layer
    … …  
    188179
    189180      ! Sum over g-points to compute broadband fluxes
    190 #ifdef DWD_REDUCTION_OPTIMIZATIONS
    191       sum_aux(:,:) = 0.0_jprb
    192       do jg = 1,ng
    193         do jlev = 1,nlev+1
    194           sum_aux(jlev,1) = sum_aux(jlev,1) + flux_up_clear(jg,jlev)
    195           sum_aux(jlev,2) = sum_aux(jlev,2) + flux_dn_clear(jg,jlev)
    196         end do
    197       end do
    198       flux%lw_up_clear(jcol,:) = sum_aux(:,1)
    199       flux%lw_dn_clear(jcol,:) = sum_aux(:,2)
    200 #else
    201       do jlev = 1,nlev+1
    202         sum_up = 0.0_jprb
    203         sum_dn = 0.0_jprb
    204         !$omp simd reduction(+:sum_up, sum_dn)
    205         do jg = 1,ng
    206           sum_up = sum_up + flux_up_clear(jg,jlev)
    207           sum_dn = sum_dn + flux_dn_clear(jg,jlev)
    208         end do
    209         flux%lw_up_clear(jcol,jlev) = sum_up
    210         flux%lw_dn_clear(jcol,jlev) = sum_dn
    211       end do
    212 #endif
    213 
     181      flux%lw_up_clear(jcol,:) = sum(flux_up_clear,1)
     182      flux%lw_dn_clear(jcol,:) = sum(flux_dn_clear,1)
    214183      ! Store surface spectral downwelling fluxes
    215184      flux%lw_dn_surf_clear_g(:,jcol) = flux_dn_clear(:,nlev+1)
    … …  
    310279          else
    311280            ! Clear-sky layer: copy over clear-sky values
    312             do jg = 1,ng
    313               reflectance(jg,jlev) = ref_clear(jg,jlev)
    314               transmittance(jg,jlev) = trans_clear(jg,jlev)
    315               source_up(jg,jlev) = source_up_clear(jg,jlev)
    316               source_dn(jg,jlev) = source_dn_clear(jg,jlev)
    317             end do
     281            reflectance(:,jlev) = ref_clear(:,jlev)
     282            transmittance(:,jlev) = trans_clear(:,jlev)
     283            source_up(:,jlev) = source_up_clear(:,jlev)
     284            source_dn(:,jlev) = source_dn_clear(:,jlev)
    318285          end if
    319286        end do
    … …  
    340307       
    341308        ! Store overcast broadband fluxes
    342 #ifdef DWD_REDUCTION_OPTIMIZATIONS
    343         sum_aux(:,:) = 0._jprb
    344         do jg = 1, ng
    345           do jlev = 1, nlev+1
    346             sum_aux(jlev,1) = sum_aux(jlev,1) + flux_up(jg,jlev)
    347             sum_aux(jlev,2) = sum_aux(jlev,2) + flux_dn(jg,jlev)
    348           end do
    349         end do
    350         flux%lw_up(jcol,:) = sum_aux(:,1)
    351         flux%lw_dn(jcol,:) = sum_aux(:,2)
    352 #else
    353         do jlev = 1,nlev+1
    354           sum_up = 0.0_jprb
    355           sum_dn = 0.0_jprb
    356           !$omp simd reduction(+:sum_up, sum_dn)
    357           do jg = 1,ng
    358             sum_up = sum_up + flux_up(jg,jlev)
    359             sum_dn = sum_dn + flux_dn(jg,jlev)
    360           end do
    361           flux%lw_up(jcol,jlev) = sum_up
    362           flux%lw_dn(jcol,jlev) = sum_dn
    363         end do
    364 #endif
     309        flux%lw_up(jcol,:) = sum(flux_up,1)
     310        flux%lw_dn(jcol,:) = sum(flux_dn,1)
    365311
    366312        ! Cloudy flux profiles currently assume completely overcast
    367313        ! skies; perform weighted average with clear-sky profile
    368         do jlev = 1,nlev+1
    369           flux%lw_up(jcol,jlev) =  total_cloud_cover *flux%lw_up(jcol,jlev) &
    370              &       + (1.0_jprb - total_cloud_cover)*flux%lw_up_clear(jcol,jlev)
    371           flux%lw_dn(jcol,jlev) =  total_cloud_cover *flux%lw_dn(jcol,jlev) &
    372              &       + (1.0_jprb - total_cloud_cover)*flux%lw_dn_clear(jcol,jlev)
    373         end do
     314        flux%lw_up(jcol,:) =  total_cloud_cover *flux%lw_up(jcol,:) &
     315             &  + (1.0_jprb - total_cloud_cover)*flux%lw_up_clear(jcol,:)
     316        flux%lw_dn(jcol,:) =  total_cloud_cover *flux%lw_dn(jcol,:) &
     317             &  + (1.0_jprb - total_cloud_cover)*flux%lw_dn_clear(jcol,:)
    374318        ! Store surface spectral downwelling fluxes
    375319        flux%lw_dn_surf_g(:,jcol) = total_cloud_cover*flux_dn(:,nlev+1) &
    … …  
    391335        ! No cloud in profile and clear-sky fluxes already
    392336        ! calculated: copy them over
    393         do jlev = 1,nlev+1
    394           flux%lw_up(jcol,jlev) = flux%lw_up_clear(jcol,jlev)
    395           flux%lw_dn(jcol,jlev) = flux%lw_dn_clear(jcol,jlev)
    396         end do
     337        flux%lw_up(jcol,:) = flux%lw_up_clear(jcol,:)
     338        flux%lw_dn(jcol,:) = flux%lw_dn_clear(jcol,:)
    397339        flux%lw_dn_surf_g(:,jcol) = flux%lw_dn_surf_clear_g(:,jcol)
    398340        if (config%do_lw_derivatives) then

  • LMDZ6/branches/cirrus/libf/phylmd/ecrad/radiation/radiation_mcica_sw.F90

    r4853 r5202  
    1717!   2017-04-22  R. Hogan  Store surface fluxes at all g-points
    1818!   2017-10-23  R. Hogan  Renamed single-character variables
    19 
    20 #include "ecrad_config.h"
    2119
    2220module radiation_mcica_sw
    … …  
    121119    ! Total cloud cover output from the cloud generator
    122120    real(jprb) :: total_cloud_cover
    123 
    124     ! Temporary storage for more efficient summation
    125 #ifdef DWD_REDUCTION_OPTIMIZATIONS
    126     real(jprb), dimension(nlev+1,3) :: sum_aux
    127 #else
    128     real(jprb) :: sum_up, sum_dn_diff, sum_dn_dir
    129 #endif
    130121
    131122    ! Number of g points
    … …  
    184175       
    185176        ! Sum over g-points to compute and save clear-sky broadband
    186         ! fluxes. Note that the built-in "sum" function is very slow,
    187         ! and before being replaced by the alternatives below
    188         ! accounted for around 40% of the total cost of this routine.
    189 #ifdef DWD_REDUCTION_OPTIMIZATIONS
    190         ! Optimized summation for the NEC architecture
    191         sum_aux(:,:) = 0.0_jprb
    192         do jg = 1,ng
    193           do jlev = 1,nlev+1
    194             sum_aux(jlev,1) = sum_aux(jlev,1) + flux_up(jg,jlev)
    195             sum_aux(jlev,2) = sum_aux(jlev,2) + flux_dn_direct(jg,jlev)
    196             sum_aux(jlev,3) = sum_aux(jlev,3) + flux_dn_diffuse(jg,jlev)
    197           end do
    198         end do
    199         flux%sw_up_clear(jcol,:) = sum_aux(:,1)
    200         flux%sw_dn_clear(jcol,:) = sum_aux(:,2) + sum_aux(:,3)
     177        ! fluxes
     178        flux%sw_up_clear(jcol,:) = sum(flux_up,1)
    201179        if (allocated(flux%sw_dn_direct_clear)) then
    202           flux%sw_dn_direct_clear(jcol,:) = sum_aux(:,2)
     180          flux%sw_dn_direct_clear(jcol,:) &
     181               &  = sum(flux_dn_direct,1)
     182          flux%sw_dn_clear(jcol,:) = sum(flux_dn_diffuse,1) &
     183               &  + flux%sw_dn_direct_clear(jcol,:)
     184        else
     185          flux%sw_dn_clear(jcol,:) = sum(flux_dn_diffuse,1) &
     186               &  + sum(flux_dn_direct,1)
    203187        end if
    204 #else
    205         ! Optimized summation for the x86-64 architecture
    206         do jlev = 1,nlev+1
    207           sum_up      = 0.0_jprb
    208           sum_dn_diff = 0.0_jprb
    209           sum_dn_dir  = 0.0_jprb
    210           !$omp simd reduction(+:sum_up, sum_dn_diff, sum_dn_dir)
    211           do jg = 1,ng
    212             sum_up      = sum_up      + flux_up(jg,jlev)
    213             sum_dn_diff = sum_dn_diff + flux_dn_diffuse(jg,jlev)
    214             sum_dn_dir  = sum_dn_dir  + flux_dn_direct(jg,jlev)
    215           end do
    216           flux%sw_up_clear(jcol,jlev) = sum_up
    217           flux%sw_dn_clear(jcol,jlev) = sum_dn_diff + sum_dn_dir
    218           if (allocated(flux%sw_dn_direct_clear)) then
    219             flux%sw_dn_direct_clear(jcol,jlev) = sum_dn_dir
    220           end if
    221         end do
    222 #endif
    223        
    224188        ! Store spectral downwelling fluxes at surface
    225         do jg = 1,ng
    226           flux%sw_dn_diffuse_surf_clear_g(jg,jcol) = flux_dn_diffuse(jg,nlev+1)
    227           flux%sw_dn_direct_surf_clear_g(jg,jcol)  = flux_dn_direct(jg,nlev+1)
    228         end do
     189        flux%sw_dn_diffuse_surf_clear_g(:,jcol) = flux_dn_diffuse(:,nlev+1)
     190        flux%sw_dn_direct_surf_clear_g(:,jcol)  = flux_dn_direct(:,nlev+1)
    229191
    230192        ! Do cloudy-sky calculation
    … …  
    287249            else
    288250              ! Clear-sky layer: copy over clear-sky values
    289               do jg = 1,ng
    290                 reflectance(jg,jlev) = ref_clear(jg,jlev)
    291                 transmittance(jg,jlev) = trans_clear(jg,jlev)
    292                 ref_dir(jg,jlev) = ref_dir_clear(jg,jlev)
    293                 trans_dir_diff(jg,jlev) = trans_dir_diff_clear(jg,jlev)
    294                 trans_dir_dir(jg,jlev) = trans_dir_dir_clear(jg,jlev)
    295               end do
     251              reflectance(:,jlev) = ref_clear(:,jlev)
     252              transmittance(:,jlev) = trans_clear(:,jlev)
     253              ref_dir(:,jlev) = ref_dir_clear(:,jlev)
     254              trans_dir_diff(:,jlev) = trans_dir_diff_clear(:,jlev)
     255              trans_dir_dir(:,jlev) = trans_dir_dir_clear(:,jlev)
    296256            end if
    297257          end do
    … …  
    304264         
    305265          ! Store overcast broadband fluxes
    306 #ifdef DWD_REDUCTION_OPTIMIZATIONS
    307           sum_aux(:,:) = 0.0_jprb
    308           do jg = 1,ng
    309             do jlev = 1,nlev+1
    310               sum_aux(jlev,1) = sum_aux(jlev,1) + flux_up(jg,jlev)
    311               sum_aux(jlev,2) = sum_aux(jlev,2) + flux_dn_direct(jg,jlev)
    312               sum_aux(jlev,3) = sum_aux(jlev,3) + flux_dn_diffuse(jg,jlev)
    313             end do
    314           end do
    315           flux%sw_up(jcol,:) = sum_aux(:,1)
    316           flux%sw_dn(jcol,:) = sum_aux(:,2) + sum_aux(:,3)
     266          flux%sw_up(jcol,:) = sum(flux_up,1)
    317267          if (allocated(flux%sw_dn_direct)) then
    318             flux%sw_dn_direct(jcol,:) = sum_aux(:,2)
     268            flux%sw_dn_direct(jcol,:) = sum(flux_dn_direct,1)
     269            flux%sw_dn(jcol,:) = sum(flux_dn_diffuse,1) &
     270                 &  + flux%sw_dn_direct(jcol,:)
     271          else
     272            flux%sw_dn(jcol,:) = sum(flux_dn_diffuse,1) &
     273                 &  + sum(flux_dn_direct,1)
    319274          end if
    320 #else
    321           do jlev = 1,nlev+1
    322             sum_up      = 0.0_jprb
    323             sum_dn_diff = 0.0_jprb
    324             sum_dn_dir  = 0.0_jprb
    325             !$omp simd reduction(+:sum_up, sum_dn_diff, sum_dn_dir)
    326             do jg = 1,ng
    327               sum_up      = sum_up      + flux_up(jg,jlev)
    328               sum_dn_diff = sum_dn_diff + flux_dn_diffuse(jg,jlev)
    329               sum_dn_dir  = sum_dn_dir  + flux_dn_direct(jg,jlev)
    330             end do
    331             flux%sw_up(jcol,jlev) = sum_up
    332             flux%sw_dn(jcol,jlev) = sum_dn_diff + sum_dn_dir
    333             if (allocated(flux%sw_dn_direct)) then
    334               flux%sw_dn_direct(jcol,jlev) = sum_dn_dir
    335             end if
    336           end do
    337 #endif
    338          
     275
    339276          ! Cloudy flux profiles currently assume completely overcast
    340277          ! skies; perform weighted average with clear-sky profile
    341           do jlev = 1, nlev+1
    342             flux%sw_up(jcol,jlev) =  total_cloud_cover *flux%sw_up(jcol,jlev) &
    343                  &     + (1.0_jprb - total_cloud_cover)*flux%sw_up_clear(jcol,jlev)
    344             flux%sw_dn(jcol,jlev) =  total_cloud_cover *flux%sw_dn(jcol,jlev) &
    345                  &     + (1.0_jprb - total_cloud_cover)*flux%sw_dn_clear(jcol,jlev)
    346             if (allocated(flux%sw_dn_direct)) then
    347               flux%sw_dn_direct(jcol,jlev) = total_cloud_cover *flux%sw_dn_direct(jcol,jlev) &
    348                    &  + (1.0_jprb - total_cloud_cover)*flux%sw_dn_direct_clear(jcol,jlev)
    349             end if
    350           end do
     278          flux%sw_up(jcol,:) =  total_cloud_cover *flux%sw_up(jcol,:) &
     279               &  + (1.0_jprb - total_cloud_cover)*flux%sw_up_clear(jcol,:)
     280          flux%sw_dn(jcol,:) =  total_cloud_cover *flux%sw_dn(jcol,:) &
     281               &  + (1.0_jprb - total_cloud_cover)*flux%sw_dn_clear(jcol,:)
     282          if (allocated(flux%sw_dn_direct)) then
     283            flux%sw_dn_direct(jcol,:) = total_cloud_cover *flux%sw_dn_direct(jcol,:) &
     284                 &  + (1.0_jprb - total_cloud_cover)*flux%sw_dn_direct_clear(jcol,:)
     285          end if
    351286          ! Likewise for surface spectral fluxes
    352           do jg = 1,ng
    353             flux%sw_dn_diffuse_surf_g(jg,jcol) = flux_dn_diffuse(jg,nlev+1)
    354             flux%sw_dn_direct_surf_g(jg,jcol)  = flux_dn_direct(jg,nlev+1)
    355             flux%sw_dn_diffuse_surf_g(jg,jcol) = total_cloud_cover *flux%sw_dn_diffuse_surf_g(jg,jcol) &
    356                  &                 + (1.0_jprb - total_cloud_cover)*flux%sw_dn_diffuse_surf_clear_g(jg,jcol)
    357             flux%sw_dn_direct_surf_g(jg,jcol)  = total_cloud_cover *flux%sw_dn_direct_surf_g(jg,jcol) &
    358                  &                 + (1.0_jprb - total_cloud_cover)*flux%sw_dn_direct_surf_clear_g(jg,jcol)
    359           end do
    360 
     287          flux%sw_dn_diffuse_surf_g(:,jcol) = flux_dn_diffuse(:,nlev+1)
     288          flux%sw_dn_direct_surf_g(:,jcol)  = flux_dn_direct(:,nlev+1)
     289          flux%sw_dn_diffuse_surf_g(:,jcol) = total_cloud_cover *flux%sw_dn_diffuse_surf_g(:,jcol) &
     290               &     + (1.0_jprb - total_cloud_cover)*flux%sw_dn_diffuse_surf_clear_g(:,jcol)
     291          flux%sw_dn_direct_surf_g(:,jcol) = total_cloud_cover *flux%sw_dn_direct_surf_g(:,jcol) &
     292               &     + (1.0_jprb - total_cloud_cover)*flux%sw_dn_direct_surf_clear_g(:,jcol)
     293         
    361294        else
    362295          ! No cloud in profile and clear-sky fluxes already
    363296          ! calculated: copy them over
    364           do jlev = 1, nlev+1
    365             flux%sw_up(jcol,jlev) = flux%sw_up_clear(jcol,jlev)
    366             flux%sw_dn(jcol,jlev) = flux%sw_dn_clear(jcol,jlev)
    367             if (allocated(flux%sw_dn_direct)) then
    368               flux%sw_dn_direct(jcol,jlev) = flux%sw_dn_direct_clear(jcol,jlev)
    369             end if
    370           end do
    371           do jg = 1,ng
    372             flux%sw_dn_diffuse_surf_g(jg,jcol) = flux%sw_dn_diffuse_surf_clear_g(jg,jcol)
    373             flux%sw_dn_direct_surf_g(jg,jcol)  = flux%sw_dn_direct_surf_clear_g(jg,jcol)
    374           end do
     297          flux%sw_up(jcol,:) = flux%sw_up_clear(jcol,:)
     298          flux%sw_dn(jcol,:) = flux%sw_dn_clear(jcol,:)
     299          if (allocated(flux%sw_dn_direct)) then
     300            flux%sw_dn_direct(jcol,:) = flux%sw_dn_direct_clear(jcol,:)
     301          end if
     302          flux%sw_dn_diffuse_surf_g(:,jcol) = flux%sw_dn_diffuse_surf_clear_g(:,jcol)
     303          flux%sw_dn_direct_surf_g(:,jcol)  = flux%sw_dn_direct_surf_clear_g(:,jcol)
    375304
    376305        end if ! Cloud is present in profile
    … …  
    378307      else
    379308        ! Set fluxes to zero if sun is below the horizon
    380         do jlev = 1, nlev+1
    381           flux%sw_up(jcol,jlev) = 0.0_jprb
    382           flux%sw_dn(jcol,jlev) = 0.0_jprb
    383           if (allocated(flux%sw_dn_direct)) then
    384             flux%sw_dn_direct(jcol,jlev) = 0.0_jprb
    385           end if
    386           flux%sw_up_clear(jcol,jlev) = 0.0_jprb
    387           flux%sw_dn_clear(jcol,jlev) = 0.0_jprb
    388           if (allocated(flux%sw_dn_direct_clear)) then
    389             flux%sw_dn_direct_clear(jcol,jlev) = 0.0_jprb
    390           end if
    391         end do
    392         do jg = 1,ng
    393           flux%sw_dn_diffuse_surf_g(jg,jcol) = 0.0_jprb
    394           flux%sw_dn_direct_surf_g(jg,jcol)  = 0.0_jprb
    395           flux%sw_dn_diffuse_surf_clear_g(jg,jcol) = 0.0_jprb
    396           flux%sw_dn_direct_surf_clear_g(jg,jcol)  = 0.0_jprb
    397         end do
     309        flux%sw_up(jcol,:) = 0.0_jprb
     310        flux%sw_dn(jcol,:) = 0.0_jprb
     311        if (allocated(flux%sw_dn_direct)) then
     312          flux%sw_dn_direct(jcol,:) = 0.0_jprb
     313        end if
     314        flux%sw_up_clear(jcol,:) = 0.0_jprb
     315        flux%sw_dn_clear(jcol,:) = 0.0_jprb
     316        if (allocated(flux%sw_dn_direct_clear)) then
     317          flux%sw_dn_direct_clear(jcol,:) = 0.0_jprb
     318        end if
     319        flux%sw_dn_diffuse_surf_g(:,jcol) = 0.0_jprb
     320        flux%sw_dn_direct_surf_g(:,jcol)  = 0.0_jprb
     321        flux%sw_dn_diffuse_surf_clear_g(:,jcol) = 0.0_jprb
     322        flux%sw_dn_direct_surf_clear_g(:,jcol)  = 0.0_jprb
    398323      end if ! Sun above horizon
    399324

  • LMDZ6/branches/cirrus/libf/phylmd/ecrad/radiation/radiation_tripleclouds_lw.F90

    r4853 r5202  
    170170    logical :: is_clear_sky_layer(0:nlev+1)
    171171
    172     ! Temporaries to speed up summations
    173     real(jprb) :: sum_dn, sum_up
    174    
    175172    ! Index of the highest cloudy layer
    176173    integer :: i_cloud_top
    … …  
    264261      if (config%do_clear) then
    265262        ! Sum over g-points to compute broadband fluxes
    266         do jlev = 1,nlev+1
    267           sum_up = 0.0_jprb
    268           sum_dn = 0.0_jprb
    269           !$omp simd reduction(+:sum_up, sum_dn)
    270           do jg = 1,ng
    271             sum_up = sum_up + flux_up_clear(jg,jlev)
    272             sum_dn = sum_dn + flux_dn_clear(jg,jlev)
    273           end do
    274           flux%lw_up_clear(jcol,jlev) = sum_up
    275           flux%lw_dn_clear(jcol,jlev) = sum_dn
    276         end do
    277 
     263        flux%lw_up_clear(jcol,:) = sum(flux_up_clear,1)
     264        flux%lw_dn_clear(jcol,:) = sum(flux_dn_clear,1)
    278265        ! Store surface spectral downwelling fluxes / TOA upwelling
    279         do jg = 1,ng
    280           flux%lw_dn_surf_clear_g(jg,jcol) = flux_dn_clear(jg,nlev+1)
    281           flux%lw_up_toa_clear_g (jg,jcol) = flux_up_clear(jg,1)
    282         end do
     266        flux%lw_dn_surf_clear_g(:,jcol) = flux_dn_clear(:,nlev+1)
     267        flux%lw_up_toa_clear_g (:,jcol) = flux_up_clear(:,1)
    283268        ! Save the spectral fluxes if required
    284269        if (config%do_save_spectral_flux) then
    … …  
    468453          end if
    469454        else
    470           sum_dn = 0.0_jprb
    471           !$omp simd reduction(+:sum_dn)
    472           do jg = 1,ng
    473             sum_dn = sum_dn + flux_dn_clear(jg,jlev)
    474           end do
    475           flux%lw_dn(jcol,jlev) = sum_dn
     455          flux%lw_dn(jcol,:) = sum(flux_dn_clear(:,jlev))
    476456          if (config%do_save_spectral_flux) then
    477457            call indexed_sum(flux_dn_clear(:,jlev), &
    … …  
    490470           &  + total_albedo(:,1,i_cloud_top)*flux_dn_clear(:,i_cloud_top)
    491471      flux_up(:,2:) = 0.0_jprb
    492 
    493       sum_up = 0.0_jprb
    494       !$omp simd reduction(+:sum_up)
    495       do jg = 1,ng
    496         sum_up = sum_up + flux_up(jg,1)
    497       end do
    498       flux%lw_up(jcol,i_cloud_top) = sum_up
    499 
     472      flux%lw_up(jcol,i_cloud_top) = sum(flux_up(:,1))
    500473      if (config%do_save_spectral_flux) then
    501474        call indexed_sum(flux_up(:,1), &
    … …  
    505478      do jlev = i_cloud_top-1,1,-1
    506479        flux_up(:,1) = trans_clear(:,jlev)*flux_up(:,1) + source_up_clear(:,jlev)
    507         sum_up = 0.0_jprb
    508         !$omp simd reduction(+:sum_up)
    509         do jg = 1,ng
    510           sum_up = sum_up + flux_up(jg,1)
    511         end do
    512         flux%lw_up(jcol,jlev) = sum_up
     480        flux%lw_up(jcol,jlev) = sum(flux_up(:,1))
    513481        if (config%do_save_spectral_flux) then
    514482          call indexed_sum(flux_up(:,1), &
    … …  
    560528
    561529        ! Store the broadband fluxes
    562         sum_up = 0.0_jprb
    563         sum_dn = 0.0_jprb
    564         do jreg = 1,nregions
    565           !$omp simd reduction(+:sum_up, sum_dn)
    566           do jg = 1,ng
    567             sum_up = sum_up + flux_up(jg,jreg)
    568             sum_dn = sum_dn + flux_dn(jg,jreg)
    569           end do
    570         end do
    571         flux%lw_up(jcol,jlev+1) = sum_up
    572         flux%lw_dn(jcol,jlev+1) = sum_dn
     530        flux%lw_up(jcol,jlev+1) = sum(sum(flux_up,1))
     531        flux%lw_dn(jcol,jlev+1) = sum(sum(flux_dn,1))
    573532
    574533        ! Save the spectral fluxes if required

  • LMDZ6/branches/cirrus/libf/phylmd/ecrad/radiation/radiation_tripleclouds_lw.F90.or

    r4773 r5202  
    170170    logical :: is_clear_sky_layer(0:nlev+1)
    171171
     172    ! Temporaries to speed up summations
     173    real(jprb) :: sum_dn, sum_up
     174   
    172175    ! Index of the highest cloudy layer
    173176    integer :: i_cloud_top
    … …  
    249252        call calc_ref_trans_lw(ng*nlev, &
    250253             &  od(:,:,jcol), ssa(:,:,jcol), g(:,:,jcol), &
    251              &  planck_hl(:,1:jlev,jcol), planck_hl(:,2:jlev+1,jcol), &
     254             &  planck_hl(:,1:nlev,jcol), planck_hl(:,2:nlev+1,jcol), &
    252255             &  ref_clear, trans_clear, &
    253256             &  source_up_clear, source_dn_clear)
    … …  
    261264      if (config%do_clear) then
    262265        ! Sum over g-points to compute broadband fluxes
    263         flux%lw_up_clear(jcol,:) = sum(flux_up_clear,1)
    264         flux%lw_dn_clear(jcol,:) = sum(flux_dn_clear,1)
     266        do jlev = 1,nlev+1
     267          sum_up = 0.0_jprb
     268          sum_dn = 0.0_jprb
     269          !$omp simd reduction(+:sum_up, sum_dn)
     270          do jg = 1,ng
     271            sum_up = sum_up + flux_up_clear(jg,jlev)
     272            sum_dn = sum_dn + flux_dn_clear(jg,jlev)
     273          end do
     274          flux%lw_up_clear(jcol,jlev) = sum_up
     275          flux%lw_dn_clear(jcol,jlev) = sum_dn
     276        end do
     277
    265278        ! Store surface spectral downwelling fluxes / TOA upwelling
    266         flux%lw_dn_surf_clear_g(:,jcol) = flux_dn_clear(:,nlev+1)
    267         flux%lw_up_toa_clear_g (:,jcol) = flux_up_clear(:,1)
     279        do jg = 1,ng
     280          flux%lw_dn_surf_clear_g(jg,jcol) = flux_dn_clear(jg,nlev+1)
     281          flux%lw_up_toa_clear_g (jg,jcol) = flux_up_clear(jg,1)
     282        end do
    268283        ! Save the spectral fluxes if required
    269284        if (config%do_save_spectral_flux) then
    … …  
    453468          end if
    454469        else
    455           flux%lw_dn(jcol,:) = sum(flux_dn_clear(:,jlev))
     470          sum_dn = 0.0_jprb
     471          !$omp simd reduction(+:sum_dn)
     472          do jg = 1,ng
     473            sum_dn = sum_dn + flux_dn_clear(jg,jlev)
     474          end do
     475          flux%lw_dn(jcol,jlev) = sum_dn
    456476          if (config%do_save_spectral_flux) then
    457477            call indexed_sum(flux_dn_clear(:,jlev), &
    … …  
    470490           &  + total_albedo(:,1,i_cloud_top)*flux_dn_clear(:,i_cloud_top)
    471491      flux_up(:,2:) = 0.0_jprb
    472       flux%lw_up(jcol,i_cloud_top) = sum(flux_up(:,1))
     492
     493      sum_up = 0.0_jprb
     494      !$omp simd reduction(+:sum_up)
     495      do jg = 1,ng
     496        sum_up = sum_up + flux_up(jg,1)
     497      end do
     498      flux%lw_up(jcol,i_cloud_top) = sum_up
     499
    473500      if (config%do_save_spectral_flux) then
    474501        call indexed_sum(flux_up(:,1), &
    … …  
    478505      do jlev = i_cloud_top-1,1,-1
    479506        flux_up(:,1) = trans_clear(:,jlev)*flux_up(:,1) + source_up_clear(:,jlev)
    480         flux%lw_up(jcol,jlev) = sum(flux_up(:,1))
     507        sum_up = 0.0_jprb
     508        !$omp simd reduction(+:sum_up)
     509        do jg = 1,ng
     510          sum_up = sum_up + flux_up(jg,1)
     511        end do
     512        flux%lw_up(jcol,jlev) = sum_up
    481513        if (config%do_save_spectral_flux) then
    482514          call indexed_sum(flux_up(:,1), &
    … …  
    528560
    529561        ! Store the broadband fluxes
    530         flux%lw_up(jcol,jlev+1) = sum(sum(flux_up,1))
    531         flux%lw_dn(jcol,jlev+1) = sum(sum(flux_dn,1))
     562        sum_up = 0.0_jprb
     563        sum_dn = 0.0_jprb
     564        do jreg = 1,nregions
     565          !$omp simd reduction(+:sum_up, sum_dn)
     566          do jg = 1,ng
     567            sum_up = sum_up + flux_up(jg,jreg)
     568            sum_dn = sum_dn + flux_dn(jg,jreg)
     569          end do
     570        end do
     571        flux%lw_up(jcol,jlev+1) = sum_up
     572        flux%lw_dn(jcol,jlev+1) = sum_dn
    532573
    533574        ! Save the spectral fluxes if required

  • LMDZ6/branches/cirrus/libf/phylmd/ecrad/radiation/radiation_tripleclouds_sw.F90

    r4853 r5202  
    7474    ! Gas and aerosol optical depth, single-scattering albedo and
    7575    ! asymmetry factor at each shortwave g-point
    76     real(jprb), intent(in), dimension(config%n_g_sw,nlev,istartcol:iendcol) &
    77          &  :: od, ssa, g
     76!    real(jprb), intent(in), dimension(istartcol:iendcol,nlev,config%n_g_sw) :: &
     77    real(jprb), intent(in), dimension(config%n_g_sw,nlev,istartcol:iendcol) :: &
     78         &  od, ssa, g
    7879
    7980    ! Cloud and precipitation optical depth, single-scattering albedo and
    8081    ! asymmetry factor in each shortwave band
    81     real(jprb), intent(in), dimension(config%n_bands_sw,nlev,istartcol:iendcol) &
    82          &  :: od_cloud, ssa_cloud, g_cloud
     82    real(jprb), intent(in), dimension(config%n_bands_sw,nlev,istartcol:iendcol) :: &
     83         &  od_cloud, ssa_cloud, g_cloud
    8384
    8485    ! Optical depth, single scattering albedo and asymmetry factor in
    … …  
    9192    ! flux into a plane perpendicular to the incoming radiation at
    9293    ! top-of-atmosphere in each of the shortwave g points
    93     real(jprb), intent(in), dimension(config%n_g_sw,istartcol:iendcol) &
    94          &  :: albedo_direct, albedo_diffuse, incoming_sw
     94    real(jprb), intent(in), dimension(config%n_g_sw,istartcol:iendcol) :: &
     95         &  albedo_direct, albedo_diffuse, incoming_sw
    9596
    9697    ! Output
    … …  
    165166    real(jprb) :: scat_od, scat_od_cloud
    166167
    167     ! Temporaries to speed up summations
    168     real(jprb) :: sum_dn_diff, sum_dn_dir, sum_up
    169 
    170     ! Local cosine of solar zenith angle
    171168    real(jprb) :: mu0
    172169
    … …  
    447444      end if
    448445     
    449       ! Store the TOA broadband fluxes, noting that there is no
    450       ! diffuse downwelling at TOA. The intrinsic "sum" command has
    451       ! been found to be very slow; better performance is found on
    452       ! x86-64 architecture with explicit loops and the "omp simd
    453       ! reduction" directive.
    454       sum_up     = 0.0_jprb
    455       sum_dn_dir = 0.0_jprb
    456       do jreg = 1,nregions
    457         !$omp simd reduction(+:sum_up, sum_dn_dir)
    458         do jg = 1,ng
    459           sum_up     = sum_up     + flux_up(jg,jreg)
    460           sum_dn_dir = sum_dn_dir + direct_dn(jg,jreg)
    461         end do
    462       end do
    463       flux%sw_up(jcol,1) = sum_up
    464       flux%sw_dn(jcol,1) = mu0 * sum_dn_dir
     446      ! Store the TOA broadband fluxes
     447      flux%sw_up(jcol,1) = sum(sum(flux_up,1))
     448      flux%sw_dn(jcol,1) = mu0 * sum(sum(direct_dn,1))
    465449      if (allocated(flux%sw_dn_direct)) then
    466450        flux%sw_dn_direct(jcol,1) = flux%sw_dn(jcol,1)
    467451      end if
    468452      if (config%do_clear) then
    469         sum_up     = 0.0_jprb
    470         sum_dn_dir = 0.0_jprb
    471         !$omp simd reduction(+:sum_up, sum_dn_dir)
    472         do jg = 1,ng
    473           sum_up     = sum_up     + flux_up_clear(jg)
    474           sum_dn_dir = sum_dn_dir + direct_dn_clear(jg)
    475         end do
    476         flux%sw_up_clear(jcol,1) = sum_up
    477         flux%sw_dn_clear(jcol,1) = mu0 * sum_dn_dir
     453        flux%sw_up_clear(jcol,1) = sum(flux_up_clear)
     454        flux%sw_dn_clear(jcol,1) = mu0 * sum(direct_dn_clear)
    478455        if (allocated(flux%sw_dn_direct_clear)) then
    479456          flux%sw_dn_direct_clear(jcol,1) = flux%sw_dn_clear(jcol,1)
    … …  
    490467             &           config%i_spec_from_reordered_g_sw, &
    491468             &           flux%sw_dn_band(:,jcol,1))
    492         flux%sw_dn_band(:,jcol,1) = mu0 * flux%sw_dn_band(:,jcol,1)
     469        flux%sw_dn_band(:,jcol,1) = &
     470             &  mu0 * flux%sw_dn_band(:,jcol,1)
    493471        if (allocated(flux%sw_dn_direct_band)) then
    494472          flux%sw_dn_direct_band(:,jcol,1) = flux%sw_dn_band(:,jcol,1)
    … …  
    571549               ! nothing to do
    572550
    573         ! Store the broadband fluxes. The intrinsic "sum" command has
    574         ! been found to be very slow; better performance is found on
    575         ! x86-64 architecture with explicit loops and the "omp simd
    576         ! reduction" directive.
    577         sum_up      = 0.0_jprb
    578         sum_dn_dir  = 0.0_jprb
    579         sum_dn_diff = 0.0_jprb
    580         do jreg = 1,nregions
    581           !$omp simd reduction(+:sum_up, sum_dn_diff, sum_dn_dir)
    582           do jg = 1,ng
    583             sum_up      = sum_up      + flux_up(jg,jreg)
    584             sum_dn_diff = sum_dn_diff + flux_dn(jg,jreg)
    585             sum_dn_dir  = sum_dn_dir  + direct_dn(jg,jreg)
    586           end do
    587         end do
    588         flux%sw_up(jcol,jlev+1) = sum_up
    589         flux%sw_dn(jcol,jlev+1) = mu0 * sum_dn_dir + sum_dn_diff
     551        ! Store the broadband fluxes
     552        flux%sw_up(jcol,jlev+1) = sum(sum(flux_up,1))
    590553        if (allocated(flux%sw_dn_direct)) then
    591           flux%sw_dn_direct(jcol,jlev+1) = mu0 * sum_dn_dir
     554          flux%sw_dn_direct(jcol,jlev+1) = mu0 * sum(sum(direct_dn,1))
     555          flux%sw_dn(jcol,jlev+1) &
     556               &  = flux%sw_dn_direct(jcol,jlev+1) + sum(sum(flux_dn,1))
     557        else
     558          flux%sw_dn(jcol,jlev+1) = mu0 * sum(sum(direct_dn,1)) + sum(sum(flux_dn,1))   
    592559        end if
    593560        if (config%do_clear) then
    594           sum_up      = 0.0_jprb
    595           sum_dn_dir  = 0.0_jprb
    596           sum_dn_diff = 0.0_jprb
    597           !$omp simd reduction(+:sum_up, sum_dn_diff, sum_dn_dir)
    598           do jg = 1,ng
    599             sum_up      = sum_up      + flux_up_clear(jg)
    600             sum_dn_diff = sum_dn_diff + flux_dn_clear(jg)
    601             sum_dn_dir  = sum_dn_dir  + direct_dn_clear(jg)
    602           end do
    603           flux%sw_up_clear(jcol,jlev+1) = sum_up
    604           flux%sw_dn_clear(jcol,jlev+1) = mu0 * sum_dn_dir + sum_dn_diff
     561          flux%sw_up_clear(jcol,jlev+1) = sum(flux_up_clear)
    605562          if (allocated(flux%sw_dn_direct_clear)) then
    606             flux%sw_dn_direct_clear(jcol,jlev+1) = mu0 * sum_dn_dir
     563            flux%sw_dn_direct_clear(jcol,jlev+1) = mu0 * sum(direct_dn_clear)
     564            flux%sw_dn_clear(jcol,jlev+1) &
     565                 &  = flux%sw_dn_direct_clear(jcol,jlev+1) + sum(flux_dn_clear)
     566          else
     567            flux%sw_dn_clear(jcol,jlev+1) = mu0 * sum(direct_dn_clear) &
     568                 &  + sum(flux_dn_clear)
    607569          end if
    608570        end if
    … …  
    643605          end if
    644606        end if
     607
    645608      end do ! Final loop over levels
    646609     

  • LMDZ6/branches/cirrus/libf/phylmd/fonte_neige_mod.F90

    r4523 r5202  
    3636  REAL, ALLOCATABLE, DIMENSION(:)             :: runofflic_global
    3737  !$OMP THREADPRIVATE(runofflic_global)
     38#ifdef ISO
     39  REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE  :: xtrun_off_ter
     40  !$OMP THREADPRIVATE(xtrun_off_ter)
     41  REAL, ALLOCATABLE, DIMENSION(:,:)           :: xtrun_off_lic
     42  !$OMP THREADPRIVATE(xtrun_off_lic)
     43  REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE  :: xtrun_off_lic_0
     44  !$OMP THREADPRIVATE(xtrun_off_lic_0)
     45  REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE:: fxtfonte_global
     46  !$OMP THREADPRIVATE(fxtfonte_global)
     47  REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE:: fxtcalving_global
     48  !$OMP THREADPRIVATE(fxtcalving_global)
     49  REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE  :: xtrunofflic_global
     50  !$OMP THREADPRIVATE(xtrunofflic_global)
     51#endif
    3852
    3953CONTAINS
    … …  
    123137
    124138  END SUBROUTINE fonte_neige_init
     139
     140#ifdef ISO
     141  SUBROUTINE fonte_neige_init_iso(xtrestart_runoff)
     142
     143! This subroutine allocates and initialize variables in the module.
     144! The variable run_off_lic_0 is initialized to the field read from
     145! restart file. The other variables are initialized to zero.
     146
     147    USE infotrac_phy, ONLY: niso
     148#ifdef ISOVERIF
     149    USE isotopes_mod, ONLY: iso_eau,iso_HDO
     150    USE isotopes_verif_mod
     151#endif
     152!
     153!****************************************************************************************
     154! Input argument
     155    REAL, DIMENSION(niso,klon), INTENT(IN) :: xtrestart_runoff
     156
     157! Local variables
     158    INTEGER                           :: error
     159    CHARACTER (len = 80)              :: abort_message
     160    CHARACTER (len = 20)              :: modname = 'fonte_neige_init'
     161    INTEGER                           :: i
     162
     163
     164!****************************************************************************************
     165! Allocate run-off at landice and initilize with field read from restart
     166!
     167!****************************************************************************************
     168
     169    ALLOCATE(xtrun_off_lic_0(niso,klon), stat = error)
     170    IF (error /= 0) THEN
     171       abort_message='Pb allocation run_off_lic'
     172       CALL abort_gcm(modname,abort_message,1)
     173    ENDIF   
     174   
     175    xtrun_off_lic_0(:,:) = xtrestart_runoff(:,:)       
     176
     177#ifdef ISOVERIF
     178      IF (iso_eau > 0) THEN   
     179        CALL iso_verif_egalite_vect1D( &
     180     &           xtrun_off_lic_0,run_off_lic_0,'fonte_neige 100', &
     181     &           niso,klon)
     182      ENDIF !IF (iso_eau > 0) THEN
     183#endif       
     184
     185!****************************************************************************************
     186! Allocate other variables and initilize to zero
     187!
     188!****************************************************************************************
     189
     190    ALLOCATE(xtrun_off_ter(niso,klon), stat = error)
     191    IF (error /= 0) THEN
     192       abort_message='Pb allocation xtrun_off_ter'
     193       CALL abort_gcm(modname,abort_message,1)
     194    ENDIF
     195    xtrun_off_ter(:,:) = 0.
     196   
     197    ALLOCATE(xtrun_off_lic(niso,klon), stat = error)
     198    IF (error /= 0) THEN
     199       abort_message='Pb allocation xtrun_off_lic'
     200       CALL abort_gcm(modname,abort_message,1)
     201    ENDIF
     202    xtrun_off_lic(:,:) = 0.
     203
     204    ALLOCATE(fxtfonte_global(niso,klon,nbsrf))
     205    IF (error /= 0) THEN
     206       abort_message='Pb allocation fxtfonte_global'
     207       CALL abort_gcm(modname,abort_message,1)
     208    ENDIF
     209    fxtfonte_global(:,:,:) = 0.0
     210
     211    ALLOCATE(fxtcalving_global(niso,klon,nbsrf))
     212    IF (error /= 0) THEN
     213       abort_message='Pb allocation fxtcalving_global'
     214       CALL abort_gcm(modname,abort_message,1)
     215    ENDIF
     216    fxtcalving_global(:,:,:) = 0.0
     217
     218    ALLOCATE(xtrunofflic_global(niso,klon))
     219    IF (error /= 0) THEN
     220       abort_message='Pb allocation xtrunofflic_global'
     221       CALL abort_gcm(modname,abort_message,1)
     222    ENDIF
     223    xtrunofflic_global(:,:) = 0.0
     224
     225  END SUBROUTINE fonte_neige_init_iso
     226#endif
     227
    125228!
    126229!****************************************************************************************
    … …  
    128231  SUBROUTINE fonte_neige( knon, nisurf, knindex, dtime, &
    129232       tsurf, precip_rain, precip_snow, &
    130        snow, qsol, tsurf_new, evap)
    131 
    132   USE indice_sol_mod
     233       snow, qsol, tsurf_new, evap &
     234#ifdef ISO   
     235     & ,fq_fonte_diag,fqfonte_diag,snow_evap_diag,fqcalving_diag   &
     236     & ,max_eau_sol_diag,runoff_diag,run_off_lic_diag,coeff_rel_diag   &
     237#endif
     238     &   )
     239
     240    USE indice_sol_mod
     241#ifdef ISO
     242    USE infotrac_phy, ONLY: niso
     243    !use isotopes_mod, ONLY: ridicule_snow,iso_eau,iso_HDO
     244#ifdef ISOVERIF
     245    USE isotopes_verif_mod
     246#endif
     247#endif
    133248       
    134249! Routine de traitement de la fonte de la neige dans le cas du traitement
    … …  
    172287    REAL, DIMENSION(klon), INTENT(INOUT) :: tsurf_new
    173288    REAL, DIMENSION(klon), INTENT(INOUT) :: evap
     289
     290#ifdef ISO   
     291        ! sortie de quelques diagnostiques
     292    REAL, DIMENSION(klon), INTENT(OUT) :: fq_fonte_diag
     293    REAL, DIMENSION(klon), INTENT(OUT) :: fqfonte_diag
     294    REAL, DIMENSION(klon), INTENT(OUT) ::  snow_evap_diag
     295    REAL, DIMENSION(klon), INTENT(OUT) ::  fqcalving_diag 
     296    REAL,                  INTENT(OUT) :: max_eau_sol_diag 
     297    REAL, DIMENSION(klon), INTENT(OUT) ::  runoff_diag   
     298    REAL, DIMENSION(klon), INTENT(OUT) :: run_off_lic_diag 
     299    REAL,                  INTENT(OUT) :: coeff_rel_diag
     300#endif
    174301
    175302! Local variables
    … …  
    193320
    194321    LOGICAL               :: neige_fond
     322
     323#ifdef ISO
     324        max_eau_sol_diag=max_eau_sol
     325#endif
     326
    195327
    196328!****************************************************************************************
    … …  
    231363   
    232364    bil_eau_s(:) = (precip_rain(:) * dtime) - (evap(:) - snow_evap(:)) * dtime
     365#ifdef ISO
     366    snow_evap_diag(:) = snow_evap(:)
     367    coeff_rel_diag    = coeff_rel
     368#endif
     369
    233370
    234371
    … …  
    254391          bil_eau_s(i) = bil_eau_s(i) + fq_fonte
    255392          tsurf_new(i) = tsurf_new(i) - fq_fonte * chasno 
     393#ifdef ISO
     394          fq_fonte_diag(i) = fq_fonte
     395#endif
     396
    256397
    257398!IM cf JLD OK     
    … …  
    273414       snow(i)=MIN(snow(i),snow_max)
    274415    ENDDO
     416#ifdef ISO
     417    DO i = 1, knon
     418       fqcalving_diag(i) = fqcalving(i)
     419       fqfonte_diag(i)   = fqfonte(i)
     420    ENDDO !DO i = 1, knon
     421#endif
     422
    275423
    276424    IF (nisurf == is_ter) THEN
    … …  
    278426          qsol(i) = qsol(i) + bil_eau_s(i)
    279427          run_off_ter(i) = run_off_ter(i) + MAX(qsol(i) - max_eau_sol, 0.0)
     428#ifdef ISO
     429          runoff_diag(i) = MAX(qsol(i) - max_eau_sol, 0.0)
     430#endif
    280431          qsol(i) = MIN(qsol(i), max_eau_sol)
    281432       ENDDO
    … …  
    290441       ENDDO
    291442    ENDIF
     443
     444#ifdef ISO
     445    DO i = 1, klon   
     446      run_off_lic_diag(i) = run_off_lic(i)
     447    ENDDO ! DO i = 1, knon   
     448#endif
    292449   
    293450!****************************************************************************************
    … …  
    312469!****************************************************************************************
    313470!
    314   SUBROUTINE fonte_neige_final(restart_runoff)
     471  SUBROUTINE fonte_neige_final(restart_runoff &
     472#ifdef ISO     
     473     &                        ,xtrestart_runoff &
     474#endif   
     475     &                        )
    315476!
    316477! This subroutine returns run_off_lic_0 for later writing to restart file.
    317478!
     479#ifdef ISO
     480    USE infotrac_phy, ONLY: niso
     481#ifdef ISOVERIF
     482    USE isotopes_mod, ONLY: iso_eau
     483    USE isotopes_verif_mod
     484#endif
     485#endif
     486!
    318487!****************************************************************************************
    319488    REAL, DIMENSION(klon), INTENT(OUT) :: restart_runoff
     489#ifdef ISO     
     490    REAL, DIMENSION(niso,klon), INTENT(OUT) :: xtrestart_runoff
     491#ifdef ISOVERIF
     492    INTEGER :: i
     493#endif 
     494#endif
     495
     496
    320497
    321498!****************************************************************************************
    322499! Set the output variables
    323500    restart_runoff(:) = run_off_lic_0(:)
     501#ifdef ISO
     502    xtrestart_runoff(:,:) = xtrun_off_lic_0(:,:)
     503#ifdef ISOVERIF
     504    IF (iso_eau > 0) THEN   
     505      DO i=1,klon
     506        IF (iso_verif_egalite_nostop(run_off_lic_0(i) &
     507     &                              ,xtrun_off_lic_0(iso_eau,i) &
     508     &                              ,'fonte_neige 413') &
     509     &      == 1) then
     510          WRITE(*,*) 'i=',i
     511          STOP
     512        ENDIF
     513      ENDDO !DO i=1,klon
     514    ENDIF !IF (iso_eau > 0) then
     515#endif   
     516#endif
     517
     518
    324519
    325520! Deallocation of all varaibles in the module
    … …  
    334529    IF (ALLOCATED(fqcalving_global)) DEALLOCATE(fqcalving_global)
    335530    IF (ALLOCATED(runofflic_global)) DEALLOCATE(runofflic_global)
     531#ifdef ISO
     532    IF (ALLOCATED(xtrun_off_lic_0)) DEALLOCATE(xtrun_off_lic_0)
     533    IF (ALLOCATED(xtrun_off_ter)) DEALLOCATE(xtrun_off_ter)
     534    IF (ALLOCATED(xtrun_off_lic)) DEALLOCATE(xtrun_off_lic)
     535    IF (ALLOCATED(fxtfonte_global)) DEALLOCATE(fxtfonte_global)
     536    IF (ALLOCATED(fxtcalving_global)) DEALLOCATE(fxtcalving_global)
     537    IF (ALLOCATED(xtrunofflic_global)) DEALLOCATE(xtrunofflic_global)
     538#endif
     539
    336540
    337541  END SUBROUTINE fonte_neige_final
    … …  
    340544!
    341545  SUBROUTINE fonte_neige_get_vars(pctsrf, fqcalving_out, &
    342        fqfonte_out, ffonte_out, run_off_lic_out)
     546              fqfonte_out, ffonte_out, run_off_lic_out &
     547#ifdef ISO     
     548     &       ,fxtcalving_out, fxtfonte_out,xtrun_off_lic_out &
     549#endif     
     550     &       )
    343551
    344552
    … …  
    349557!****************************************************************************************
    350558
    351   USE indice_sol_mod
     559    USE indice_sol_mod
     560#ifdef ISO
     561    USE infotrac_phy, ONLY: niso
     562#endif
    352563
    353564    REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
    … …  
    358569    REAL, DIMENSION(klon), INTENT(OUT)      :: run_off_lic_out
    359570
     571#ifdef ISO
     572    REAL, DIMENSION(niso,klon), INTENT(OUT) :: fxtcalving_out
     573    REAL, DIMENSION(niso,klon), INTENT(OUT) :: fxtfonte_out
     574    REAL, DIMENSION(niso,klon), INTENT(OUT) :: xtrun_off_lic_out
     575    INTEGER   :: i,ixt
     576#endif
     577 
    360578    INTEGER   :: nisurf
    361579!****************************************************************************************
    … …  
    364582    fqfonte_out(:)   = 0.0
    365583    fqcalving_out(:) = 0.0
     584#ifdef ISO       
     585    fxtfonte_out(:,:)   = 0.0
     586    fxtcalving_out(:,:) = 0.0
     587#endif
    366588
    367589    DO nisurf = 1, nbsrf
    … …  
    373595    run_off_lic_out(:)=runofflic_global(:)
    374596
     597#ifdef ISO
     598    DO nisurf = 1, nbsrf
     599      DO i=1,klon
     600        DO ixt=1,niso
     601          fxtfonte_out(ixt,i) = fxtfonte_out(ixt,i) + fxtfonte_global(ixt,i,nisurf)*pctsrf(i,nisurf)
     602          fxtcalving_out(ixt,i) = fxtcalving_out(ixt,i) + fxtcalving_global(ixt,i,nisurf)*pctsrf(i,nisurf)
     603        ENDDO !DO ixt=1,niso
     604      ENDDO !DO i=1,klon
     605    ENDDO !DO nisurf = 1, nbsrf
     606    xtrun_off_lic_out(:,:) = xtrunofflic_global(:,:)
     607#endif
     608
    375609  END SUBROUTINE fonte_neige_get_vars
    376610!
    377611!****************************************************************************************
    378612!
     613!#ifdef ISO
     614!  subroutine fonte_neige_export_xtrun_off_lic_0(knon,xtrun_off_lic_0_diag)
     615!    use infotrac_phy, ONLY: niso
     616!
     617!    ! inputs
     618!    INTEGER, INTENT(IN)                      :: knon
     619!    real, INTENT(IN), DIMENSION(niso,klon)   :: xtrun_off_lic_0_diag
     620!
     621!    xtrun_off_lic_0(:,:)=xtrun_off_lic_0_diag(:,:)
     622!
     623!  end subroutine fonte_neige_export_xtrun_off_lic_0
     624!#endif
     625
     626#ifdef ISO
     627  SUBROUTINE gestion_neige_besoin_varglob_fonte_neige(klon,knon, &
     628     &           xtprecip_snow,xtprecip_rain, &
     629     &           fxtfonte_neige,fxtcalving, &
     630     &           knindex,nisurf,run_off_lic_diag,coeff_rel_diag)
     631
     632        ! dans cette routine, on a besoin des variables globales de
     633        ! fonte_neige_mod. Il faut donc la mettre dans fonte_neige_mod
     634        ! le reste de gestion_neige est dans isotopes_routines_mod car sinon pb
     635        ! de dépendance circulaire.
     636
     637    USE infotrac_phy, ONLY: ntiso,niso
     638    USE isotopes_mod, ONLY: iso_eau   
     639    USE indice_sol_mod   
     640#ifdef ISOVERIF
     641    USE isotopes_verif_mod
     642#endif
     643    IMPLICIT NONE
     644
     645    ! inputs
     646    INTEGER, INTENT(IN)                     :: klon,knon
     647    REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtprecip_snow, xtprecip_rain
     648    REAL, DIMENSION(niso,klon), INTENT(IN)  :: fxtfonte_neige,fxtcalving
     649    INTEGER, INTENT(IN)                     :: nisurf
     650    INTEGER, DIMENSION(klon), INTENT(IN)    :: knindex
     651    REAL, DIMENSION(klon), INTENT(IN)       :: run_off_lic_diag 
     652    REAL, INTENT(IN)                        :: coeff_rel_diag 
     653
     654    ! locals
     655    INTEGER :: i,ixt,j
     656       
     657#ifdef ISOVERIF
     658    IF (nisurf == is_lic) THEN
     659      IF (iso_eau > 0) THEN 
     660        DO i = 1, knon
     661           j = knindex(i)
     662           CALL iso_verif_egalite(xtrun_off_lic_0(iso_eau,j), &
     663     &             run_off_lic_0(j),'gestion_neige_besoin_varglob_fonte_neige 625')
     664        ENDDO
     665      ENDIF
     666    ENDIF
     667#endif
     668
     669! calcul de run_off_lic
     670
     671    IF (nisurf == is_lic) THEN
     672!         coeff_rel = dtime/(tau_calv * rday)
     673
     674      DO i = 1, knon
     675        j = knindex(i)
     676        DO ixt = 1, niso
     677          xtrun_off_lic(ixt,i)   = (coeff_rel_diag *  fxtcalving(ixt,i)) &
     678     &                            +(1. - coeff_rel_diag) * xtrun_off_lic_0(ixt,j)
     679          xtrun_off_lic_0(ixt,j) = xtrun_off_lic(ixt,i)
     680          xtrun_off_lic(ixt,i)   = xtrun_off_lic(ixt,i) + fxtfonte_neige(ixt,i) + xtprecip_rain(ixt,i)
     681        ENDDO !DO ixt=1,niso
     682#ifdef ISOVERIF
     683          IF (iso_eau > 0) THEN             
     684            IF (iso_verif_egalite_choix_nostop(xtrun_off_lic(iso_eau,i), &
     685     &                  run_off_lic_diag(i),'gestion_neige_besoin_varglob_fonte_neige 1201a', &
     686     &                  errmax,errmaxrel) == 1) THEN
     687               WRITE(*,*) 'i,j=',i,j   
     688               WRITE(*,*) 'coeff_rel_diag=',coeff_rel_diag
     689               STOP
     690            ENDIF
     691          ENDIF
     692#endif
     693      ENDDO
     694    ENDIF !IF (nisurf == is_lic) THEN 
     695
     696! Save ffonte, fqfonte and fqcalving in global arrays for each
     697! sub-surface separately
     698    DO i = 1, knon
     699      DO ixt = 1, niso
     700        fxtfonte_global(ixt,knindex(i),nisurf)   = fxtfonte_neige(ixt,i)
     701        fxtcalving_global(ixt,knindex(i),nisurf) = fxtcalving(ixt,i)
     702      ENDDO !do ixt=1,niso
     703    ENDDO   
     704
     705    IF (nisurf == is_lic) THEN
     706      DO i = 1, knon   
     707        DO ixt = 1, niso   
     708        xtrunofflic_global(ixt,knindex(i)) = xtrun_off_lic(ixt,i)
     709        ENDDO ! DO ixt=1,niso   
     710      ENDDO
     711    ENDIF
     712       
     713  END SUBROUTINE gestion_neige_besoin_varglob_fonte_neige
     714#endif
     715
     716
    379717END MODULE fonte_neige_mod

  • LMDZ6/branches/cirrus/libf/phylmd/infotrac_phy.F90

    r4638 r5202  
    55   USE       strings_mod, ONLY: msg, fmsg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse, strIdx
    66   USE readTracFiles_mod, ONLY: trac_type, readTracersFiles, tracers, setGeneration, itZonIso, nzone, tran0, isoZone, &
    7         delPhase, niso, getKey, isot_type, readIsotopesFile, isotope, maxTableWidth, iqIsoPha, nphas, ixIso, isoPhas, &
    8         addPhase, iH2O, addKey, isoSelect, testTracersFiles, isoKeys, indexUpdate,   isoCheck, nbIso, ntiso, isoName
     7        delPhase, niso, getKey, isot_type, processIsotopes, isotope, maxTableWidth, iqIsoPha, nphas, ixIso, isoPhas, &
     8        addPhase, iH2O, addKey, isoSelect, testTracersFiles, isoKeys, indexUpdate,  iqWIsoPha, nbIso, ntiso, isoName, isoCheck
    99   IMPLICIT NONE
    1010
    … …  
    2020   PUBLIC :: id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat, id_TEST_strat
    2121#endif
    22 #ifdef REPROBUS
    23    PUBLIC :: nbtr_bin, nbtr_sulgas
    24    PUBLIC :: id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat, &
    25              id_TEST_strat
    26 #endif
    27 
     22
     23   !=== FOR WATER
     24   PUBLIC :: ivap, iliq, isol
    2825   !=== FOR ISOTOPES: General
    2926   PUBLIC :: isot_type, nbIso                              !--- Derived type, full isotopes families database + nb of families
    … …  
    3734   PUBLIC :: itZonIso                                      !--- idx "it" (in "isoName(1:niso)") = function(tagging idx, isotope idx)
    3835   PUBLIC :: iqIsoPha                                      !--- idx "iq" (in "qx") = function(isotope idx, phase idx) + aliases
     36   PUBLIC :: iqWIsoPha                                      !--- Same as iqIsoPha but with normal water phases
     37
    3938   PUBLIC :: isoCheck                                      !--- Run isotopes checking routines
    4039   !=== FOR BOTH TRACERS AND ISOTOPES
    … …  
    7372!  | longName    | Long name (with adv. scheme suffix) for outputs      | ttext       |                        |
    7473!  | type        | Type (so far: tracer or tag)                         | /           | tracer,tag             |
    75 !  | phase       | Phases list ("g"as / "l"iquid / "s"olid / "b"lowing) | /           | [g][l][s][b]           |
     74!  | phase       | Phases list ("g"as / "l"iquid / "s"olid)             | /           | [g][l][s]              |
    7675!  | component   | Name(s) of the merged/cumulated section(s)           | /           | coma-separated names   |
    7776!  | iGeneration | Generation (>=1)                                     | /           |                        |
    … …  
    9897!  | trac   | ntiso  | Isotopes + tagging tracers list + number         | / | ntraciso       |                 |
    9998!  | zone   | nzone  | Geographic tagging zones   list + number         | / | ntraceurs_zone |                 |
    100 !  | phase  | nphas  | Phases                     list + number         |                    |[g][l][s][b] 1:4 |
     99!  | phase  | nphas  | Phases                     list + number         |                    | [g][l][s], 1:3 |
    101100!  | iqIsoPha        | Index in "qx"           = f(name(1:ntiso)),phas) | iqiso              | 1:nqtot         |
     101!  | iqWIsoPha       | Index in "qx"           = f(name(1:ntiso)),phas) | iqiso              | 1:nqtot         |
    102102!  | itZonIso        | Index in "trac(1:ntiso)"= f(zone, name(1:niso))  | index_trac         | 1:ntiso         |
    103103!  +-----------------+--------------------------------------------------+--------------------+-----------------+
    … …  
    112112!$OMP THREADPRIVATE(nqtot, nbtr, nqo, nqtottr, nqCO2, type_trac)
    113113
     114   !=== INDICES OF WATER
     115   INTEGER,               SAVE :: ivap,iliq,isol ! Indices for vap, liq and ice
     116!$OMP THREADPRIVATE(ivap,iliq,isol)
     117
    114118   !=== VARIABLES FOR INCA
    115119   INTEGER,               SAVE, ALLOCATABLE :: conv_flg(:), &   !--- Convection     activation ; needed for INCA        (nbtr)
    … …  
    123127  INTEGER, SAVE ::  id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat, id_TEST_strat
    124128!$OMP THREADPRIVATE(id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat, id_TEST_strat)
    125 #endif
    126 #ifdef REPROBUS
    127   INTEGER, SAVE ::  nbtr_bin, nbtr_sulgas
    128 !$OMP THREADPRIVATE(nbtr_bin, nbtr_sulgas)
    129   INTEGER, SAVE ::  id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat,&
    130                     id_TEST_strat
    131 !$OMP THREADPRIVATE(id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat)
    132 !$OMP THREADPRIVATE(id_TEST_strat)
    133129#endif
    134130
    … …  
    182178   INTEGER :: nqtrue                                                 !--- Tracers nb from tracer.def (no higher order moments)
    183179   INTEGER :: iad                                                    !--- Advection scheme number
    184    INTEGER :: ic, iq, jq, it, nt, im, nm, iz, k                      !--- Indexes and temporary variables
    185    LOGICAL :: lerr, ll, lInit
    186    CHARACTER(LEN=1) :: p
     180   INTEGER :: iq, jq, nt, im, nm, k                                 !--- Indexes and temporary variables
     181   LOGICAL :: lerr, lInit
    187182   TYPE(trac_type), ALLOCATABLE, TARGET :: ttr(:)
    188183   TYPE(trac_type), POINTER             :: t1, t(:)
    189    INTEGER :: ierr
    190184   CHARACTER(LEN=maxlen),   ALLOCATABLE :: types_trac(:)  !--- Keyword for tracers type(s), parsed version
    191185   
    … …  
    262256!##############################################################################################################################
    263257   IF(lInit) THEN
    264       IF(readTracersFiles(ttp, type_trac == 'repr')) CALL abort_physic(modname, 'problem with tracers file(s)',1)
     258      IF(readTracersFiles(ttp, lRepr=type_trac=='repr')) CALL abort_physic(modname, 'problem with tracers file(s)',1)
    265259   ELSE
    266260      CALL msg('No tracers description file(s) reading needed: already done in the dynamics', modname)
    … …  
    388382
    389383   !--- SET FIELDS %iqParent, %nqChildren, %iGeneration, %iqDescen, %nqDescen
    390    CALL indexUpdate(tracers)
     384   IF(indexUpdate(tracers)) CALL abort_gcm(modname, 'problem when processing isotopes parameters', 1)
    391385
    392386!##############################################################################################################################
    … …  
    404398   !=== READ PHYSICAL PARAMETERS FOR ISOTOPES
    405399   niso = 0; nzone = 0; nphas = nqo; ntiso = 0; isoCheck = .FALSE.
    406    IF(readIsotopesFile()) CALL abort_physic(modname, 'Problem when reading isotopes parameters', 1)
     400   IF(processIsotopes()) CALL abort_physic(modname, 'Problem when processing isotopes parameters', 1)
    407401
    408402!##############################################################################################################################
    … …  
    416410   nqtottr = nqtot - COUNT(delPhase(tracers%gen0Name) == 'H2O' .AND. tracers%component == 'lmdz')
    417411   IF(COUNT(tracers%iso_iName == 0) - COUNT(delPhase(tracers%name) == 'H2O' .AND. tracers%component == 'lmdz') /= nqtottr) &
    418       CALL abort_physic(modname, 'pb dans le calcul de nqtottr', 1)
     412      CALL abort_physic(modname, 'problem with the computation of nqtottr', 1)
    419413
    420414   !=== DISPLAY THE RESULTS
    … …  
    431425   t => tracers
    432426   CALL msg('Information stored in infotrac_phy :', modname)
    433    IF(dispTable('issssssssiiiiiiii', &
    434       ['iq    ', 'name  ', 'lName ', 'gen0N ', 'parent', 'type  ', 'phase ', 'compon', 'isPhy ',           &
    435                  'iGen  ', 'iqPar ', 'nqDes ', 'nqChld', 'iGroup', 'iName ', 'iZone ', 'iPhase'],          &
     427   IF(dispTable('issssssssiiiiiiii', ['iq  ', 'name', 'lNam', 'g0Nm', 'prnt', 'type', 'phas', 'comp',      &
     428                              'isPh', 'iGen', 'iqPr', 'nqDe', 'nqCh', 'iGrp', 'iNam', 'iZon', 'iPha'],     &
    436429      cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component, bool2str(t%isInPhysics)),&
    437430      cat([(iq, iq=1, nqtot)], t%iGeneration, t%iqParent, t%nqDescen, t%nqChildren, t%iso_iGroup,          &

  • LMDZ6/branches/cirrus/libf/phylmd/lmdz_atke_exchange_coeff.F90

    r4884 r5202  
    77subroutine atke_compute_km_kh(ngrid,nlay,dtime, &
    88                        wind_u,wind_v,temp,qvap,play,pinterf,cdrag_uv, &
    9                         tke,eps,Km_out,Kh_out)
     9                        tke,eps,tke_shear,tke_buoy,tke_trans,Km_out,Kh_out)
    1010
    1111!========================================================================
    … …  
    7979
    8080REAL, DIMENSION(ngrid,nlay+1), INTENT(OUT)    :: eps      ! output: TKE dissipation rate at interface between layers (m2/s3)
     81REAL, DIMENSION(ngrid,nlay+1), INTENT(OUT)    :: tke_shear! output: TKE shear production rate (m2/s3)
     82REAL, DIMENSION(ngrid,nlay+1), INTENT(OUT)    :: tke_buoy ! output: TKE buoyancy production rate (m2/s3)
     83REAL, DIMENSION(ngrid,nlay+1), INTENT(OUT)    :: tke_trans! output: TKE transport (diffusion) term (m2/s3)
    8184REAL, DIMENSION(ngrid,nlay), INTENT(OUT)      :: Km_out   ! output: Exchange coefficient for momentum at interface between layers (m2/s)
    8285REAL, DIMENSION(ngrid,nlay), INTENT(OUT)      :: Kh_out   ! output: Exchange coefficient for heat flux at interface between layers (m2/s)
    … …  
    261264                shear2(igrid,ilay) * (1. - Ri(igrid,ilay) / Prandtl(igrid,ilay))
    262265                eps(igrid,ilay) = (tke(igrid,ilay)**(3./2))/(cepsilon*l_exchange(igrid,ilay))
     266                tke_shear(igrid,ilay)=l_exchange(igrid,ilay)*Sm(igrid,ilay)*sqrt(tke(igrid,ilay))*shear2(igrid,ilay)
     267                tke_buoy(igrid,ilay)=-l_exchange(igrid,ilay)*Sm(igrid,ilay)*sqrt(tke(igrid,ilay))*shear2(igrid,ilay) &
     268                                    *(Ri(igrid,ilay) / Prandtl(igrid,ilay))
    263269            ENDDO
    264270        ENDDO
    … …  
    278284            qq=max(0.,qq)
    279285            tke(igrid,ilay)=0.5*(qq**2)
    280             eps(igrid,ilay) = (tke(igrid,ilay)**(3./2))/(cepsilon*l_exchange(igrid,ilay))
     286            eps(igrid,ilay) = (tke(igrid,ilay)**(3./2))/(cepsilon*l_exchange(igrid,ilay))
     287            tke_shear(igrid,ilay)=l_exchange(igrid,ilay)*Sm(igrid,ilay)*sqrt(tke(igrid,ilay))*shear2(igrid,ilay)
     288            tke_buoy(igrid,ilay)=-l_exchange(igrid,ilay)*Sm(igrid,ilay)*sqrt(tke(igrid,ilay))*shear2(igrid,ilay) &
     289                                *(Ri(igrid,ilay) / Prandtl(igrid,ilay))
    281290            ENDDO
    282291        ENDDO
    … …  
    293302            qq=(qq+l_exchange(igrid,ilay)*Sm(igrid,ilay)*dtime/sqrt(2.)      &
    294303                *shear2(igrid,ilay)*(1.-Ri(igrid,ilay)/Prandtl(igrid,ilay))) &
    295                 /(1.+qq*dtime/(cepsilon*l_exchange(igrid,ilay)*2.*sqrt(2.)))
     304                /(1.+qq*dtime/(cepsilon*l_exchange(igrid,ilay)*2.*sqrt(2.)))
     305            tke_shear(igrid,ilay)=l_exchange(igrid,ilay)*Sm(igrid,ilay)*qq/sqrt(2.)*shear2(igrid,ilay)
     306            tke_buoy(igrid,ilay)=-l_exchange(igrid,ilay)*Sm(igrid,ilay)*qq/sqrt(2.)*shear2(igrid,ilay) &
     307                                *(Ri(igrid,ilay) / Prandtl(igrid,ilay))
    296308            tke(igrid,ilay)=0.5*(qq**2)
    297309            eps(igrid,ilay) = (tke(igrid,ilay)**(3./2))/(cepsilon*l_exchange(igrid,ilay))
    … …  
    308320            eps(igrid,ilay) = (tke(igrid,ilay)**(3./2))/(cepsilon*l_exchange(igrid,ilay))
    309321            qq=max(sqrt(2.*tke(igrid,ilay)),1.e-10)
     322            tke_shear(igrid,ilay)=l_exchange(igrid,ilay)*Sm(igrid,ilay)*qq/sqrt(2.)*shear2(igrid,ilay)
     323            tke_buoy(igrid,ilay)=-l_exchange(igrid,ilay)*Sm(igrid,ilay)*qq/sqrt(2.)*shear2(igrid,ilay) &
     324                                *(Ri(igrid,ilay) / Prandtl(igrid,ilay))
    310325            IF (Ri(igrid,ilay) .LT. 0.) THEN
    311326                netloss=qq/(2.*sqrt(2.)*cepsilon*l_exchange(igrid,ilay))
    … …  
    327342            DO igrid=1,ngrid
    328343            qq=max(sqrt(2.*tke(igrid,ilay)),1.e-10)
     344            tke_shear(igrid,ilay)=l_exchange(igrid,ilay)*Sm(igrid,ilay)*qq/sqrt(2.)*shear2(igrid,ilay)
     345            tke_buoy(igrid,ilay)=-l_exchange(igrid,ilay)*Sm(igrid,ilay)*qq/sqrt(2.)*shear2(igrid,ilay) &
     346                                *(Ri(igrid,ilay) / Prandtl(igrid,ilay))
    329347            qq=(l_exchange(igrid,ilay)*Sm(igrid,ilay)/sqrt(2.)*shear2(igrid,ilay)*(1.-Ri(igrid,ilay)/Prandtl(igrid,ilay)) &
    330348                +qq*(1.+dtime*qq/(cepsilon*l_exchange(igrid,ilay)*2.*sqrt(2.)))) &
    … …  
    349367    tke(igrid,nlay+1)=0.
    350368    eps(igrid,nlay+1)=0.
     369    tke_shear(igrid,nlay+1)=0.
     370    tke_buoy(igrid,nlay+1)=0.
    351371END DO
    352372
    … …  
    359379    tke(igrid,1)=ctkes*(ustar**2)
    360380    eps(igrid,1)=0. ! arbitrary as TKE is not properly defined at the surface
     381    tke_shear(igrid,1)=0.
     382    tke_buoy(igrid,1)=0.
    361383END DO
    362384
    … …  
    364386! vertical diffusion of TKE
    365387!==========================
     388tke_trans(:,:)=0.
    366389IF (atke_ok_vdiff) THEN
    367     CALL atke_vdiff_tke(ngrid,nlay,dtime,z_lay,z_interf,temp,play,l_exchange,Sm,tke)
     390    CALL atke_vdiff_tke(ngrid,nlay,dtime,z_lay,z_interf,temp,play,l_exchange,Sm,tke,tke_trans)
    368391ENDIF
    369392
    … …  
    387410
    388411!===============================================================================================
    389 subroutine atke_vdiff_tke(ngrid,nlay,dtime,z_lay,z_interf,temp,play,l_exchange,Sm,tke)
     412subroutine atke_vdiff_tke(ngrid,nlay,dtime,z_lay,z_interf,temp,play,l_exchange,Sm,tke,tke_trans)
    390413
    391414! routine that computes the vertical diffusion of TKE by the turbulence
    … …  
    408431
    409432REAL, DIMENSION(ngrid,nlay+1), INTENT(INOUT)  :: tke    ! turbulent kinetic energy at interface between layers
    410 
     433REAL, DIMENSION(ngrid,nlay+1), INTENT(INOUT)  :: tke_trans ! turbulent kinetic energy transport term (m2/s3)
    411434
    412435
    … …  
    480503! update TKE
    481504tke(:,:)=tke(:,:)+dtke(:,:)
     505tke_trans(:,:)=dtke(:,:)/dtime
    482506
    483507

  • LMDZ6/branches/cirrus/libf/phylmd/lmdz_atke_turbulence_ini.F90

    r4804 r5202  
    5050      !!
    5151      !! ** Purpose :   Initialization of the atke module and choice of some constants
    52       !!               
     52      !!                Default values correspond to the  'best' configuration
     53      !!                from tuning on GABLS1 in Vignon et al. 2024, JAMES
    5354      !!----------------------------------------------------------------------
    5455
    … …  
    7374
    7475      ! flag that controls options in atke_compute_km_kh
    75       iflag_atke=0
     76      iflag_atke=1
    7677      CALL getin_p('iflag_atke',iflag_atke)
    7778
    7879      ! flag that controls the calculation of mixing length in atke
    79       iflag_atke_lmix=0
     80      iflag_atke_lmix=3
    8081      CALL getin_p('iflag_atke_lmix',iflag_atke_lmix)
    8182
    … …  
    8687
    8788      ! activate vertical diffusion of TKE or not
    88       atke_ok_vdiff=.false.
     89      atke_ok_vdiff=.true.
    8990      CALL getin_p('atke_ok_vdiff',atke_ok_vdiff)
    9091
    … …  
    101102      ! Sun et al 2011, JAMC
    102103      ! between 10 and 40
    103       l0=15.0
     104      l0=42.5279652116005
    104105      CALL getin_p('atke_l0',l0)
    105106
    106107      ! critical Richardson number
    107       ric=0.25
     108      ric=0.190537327781655
    108109      CALL getin_p('atke_ric',ric)
    109110
    110111      ! constant for tke dissipation calculation
    111       cepsilon=5.87 ! default value as in yamada4
     112      cepsilon=8.89273387537601
    112113      CALL getin_p('atke_cepsilon',cepsilon)
    113114
    … …  
    131132
    132133      ! slope of Pr=f(Ri) for stable conditions
    133       pr_slope=5.0 ! default value from Zilitinkevich et al. 2005
     134      pr_slope=4.67885738180385
    134135      CALL getin_p('atke_pr_slope',pr_slope)
    135136      if (pr_slope .le. 1) then
    … …  
    139140
    140141      ! value of turbulent prandtl number in neutral conditions (Ri=0)
    141       pr_neut=0.8
     142      pr_neut=0.837372701768868
    142143      CALL getin_p('atke_pr_neut',pr_neut)
    143144
    … …  
    151152
    152153      ! coefficient for mixing length depending on local stratification
    153       clmix=0.5
     154      clmix=0.648055235325291
    154155      CALL getin_p('atke_clmix',clmix)
    155156
    … …  
    160161      ! minimum anisotropy coefficient (defined here as minsqrt(Ez/Ek)) at large Ri.
    161162      ! From Zilitinkevich et al. 2013, it equals sqrt(0.03)~0.17 
    162       smmin=0.17
     163      smmin=0.0960838631869678
    163164      CALL getin_p('atke_smmin',smmin)
    164165
    165166      ! ratio between the eddy diffusivity coeff for tke wrt that for momentum
    166167      ! default value from Lenderink et al. 2004
    167       cke=2.
     168      cke=2.47069655134662
    168169      CALL getin_p('atke_cke',cke)
    169170

  • LMDZ6/branches/cirrus/libf/phylmd/lmdz_call_atke.F90

    r4881 r5202  
    88contains
    99
    10 subroutine call_atke(dtime,ngrid,nlay,cdrag_uv,cdrag_t,u_surf,v_surf,temp_surf, &
     10subroutine call_atke(dtime,ngrid,nlay,nsrf,ni,cdrag_uv,cdrag_t,u_surf,v_surf,temp_surf, &
    1111                        wind_u,wind_v,temp,qvap,play,pinterf, &
    1212                        tke,eps,Km_out,Kh_out)
    … …  
    1616
    1717USE lmdz_atke_turbulence_ini, ONLY : iflag_num_atke, rg, rd
     18USE phys_local_var_mod, ONLY: tke_shear, tke_buoy, tke_trans
    1819
    1920implicit none
    … …  
    2627INTEGER, INTENT(IN) :: ngrid ! number of horizontal index (flat grid)
    2728INTEGER, INTENT(IN) :: nlay ! number of vertical index 
     29INTEGER, INTENT(IN) :: nsrf ! surface tile index
     30INTEGER, DIMENSION(ngrid), INTENT(IN) :: ni ! array of indices to move from knon to klon arrays
    2831
    2932
    … …  
    5053
    5154
     55REAL, DIMENSION(ngrid,nlay+1) :: tke_shear_term,tke_buoy_term,tke_trans_term
    5256REAL, DIMENSION(ngrid,nlay) :: wind_u_predict, wind_v_predict
    5357REAL, DIMENSION(ngrid) ::  wind1
    54 INTEGER i
     58INTEGER i,j,k
    5559
    5660
    5761call atke_compute_km_kh(ngrid,nlay,dtime,&
    5862                        wind_u,wind_v,temp,qvap,play,pinterf,cdrag_uv,&
    59                         tke,eps,Km_out,Kh_out)
     63                        tke,eps,tke_shear_term,tke_buoy_term,tke_trans_term,Km_out,Kh_out)
    6064
    6165
    … …  
    7680   call atke_compute_km_kh(ngrid,nlay,dtime,&
    7781                        wind_u_predict,wind_v_predict,temp,qvap,play,pinterf,cdrag_uv, &
    78                         tke,eps,Km_out,Kh_out)
     82                        tke,eps,tke_shear_term,tke_buoy_term,tke_trans_term,Km_out,Kh_out)
    7983
    8084end if
    8185
    8286
     87! Diagnostics of tke loss/source terms
    8388
     89 DO k=1,nlay+1
     90    DO i=1,ngrid
     91       j=ni(i)
     92       tke_shear(j,k,nsrf)=tke_shear_term(i,k)
     93       tke_buoy(j,k,nsrf)=tke_buoy_term(i,k)
     94       tke_trans(j,k,nsrf)=tke_trans_term(i,k)
     95    ENDDO
     96 ENDDO
    8497
    8598

  • LMDZ6/branches/cirrus/libf/phylmd/lmdz_lscp.F90

    r5163 r5202  
    77!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    88SUBROUTINE lscp(klon,klev,dtime,missing_val,            &
    9      paprs,pplay,temp,qt,ptconv,ratqs,                  &
     9     paprs,pplay,temp,qt,qice_save,ptconv,ratqs,        &
    1010     d_t, d_q, d_ql, d_qi, rneb, rneblsvol,             &
    11      pfraclr,pfracld,                                   &
     11     pfraclr, pfracld,                                  &
     12     cldfraliq, sigma2_icefracturb,mean_icefracturb,    &
    1213     radocond, radicefrac, rain, snow,                  &
    1314     frac_impa, frac_nucl, beta,                        &
    14      prfl, psfl, rhcl, qta, fraca,                     &
    15      tv, pspsk, tla, thl, iflag_cld_th,             &
    16      iflag_ice_thermo, distcltop, temp_cltop, cell_area,&
    17      cf_seri, rvc_seri, u_seri, v_seri, pbl_eps,        &
     15     prfl, psfl, rhcl, qta, fraca,                      &
     16     tv, pspsk, tla, thl, iflag_cld_th,                 &
     17     iflag_ice_thermo, distcltop, temp_cltop,           &
     18     tke, tke_dissip,                                   &
     19     cell_area,                                         &
     20     cf_seri, rvc_seri, u_seri, v_seri,                 &
    1821     qsub, qissr, qcld, subfra, issrfra, gamma_cond,    &
    1922     ratio_qi_qtot, dcf_sub, dcf_con, dcf_mix,          &
    … …  
    100103! USE de modules contenant des fonctions.
    101104USE lmdz_cloudth, ONLY : cloudth, cloudth_v3, cloudth_v6, cloudth_mpc
    102 USE lmdz_lscp_tools, ONLY : calc_qsat_ecmwf, icefrac_lscp, calc_gammasat
     105USE lmdz_lscp_tools, ONLY : calc_qsat_ecmwf, calc_gammasat
     106USE lmdz_lscp_tools, ONLY : icefrac_lscp, icefrac_lscp_turb
    103107USE lmdz_lscp_tools, ONLY : fallice_velocity, distance_to_cloud_top
    104108USE lmdz_lscp_condensation, ONLY : condensation_lognormal, condensation_ice_supersat
    … …  
    115119USE lmdz_lscp_ini, ONLY : RCPD, RLSTT, RLVTT, RLMLT, RVTMP2, RTT, RD, RG
    116120USE lmdz_lscp_ini, ONLY : ok_poprecip
    117 USE lmdz_lscp_ini, ONLY : ok_external_lognormal, ok_ice_supersat, ok_unadjusted_clouds
     121USE lmdz_lscp_ini, ONLY : ok_external_lognormal, ok_ice_supersat, ok_unadjusted_clouds, iflag_icefrac
    118122
    119123IMPLICIT NONE
    … …  
    134138  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: temp            ! temperature (K)
    135139  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: qt              ! total specific humidity (in vapor phase in input) [kg/kg]
     140  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: qice_save       ! ice specific from previous time step [kg/kg]
    136141  INTEGER,                         INTENT(IN)   :: iflag_cld_th    ! flag that determines the distribution of convective clouds
    137142  INTEGER,                         INTENT(IN)   :: iflag_ice_thermo! flag to activate the ice thermodynamics
    … …  
    141146  !Inputs associated with thermal plumes
    142147
    143   REAL, DIMENSION(klon,klev),      INTENT(IN)   :: tv             ! virtual potential temperature [K]
    144   REAL, DIMENSION(klon,klev),      INTENT(IN)   :: qta            ! specific humidity within thermals [kg/kg]
    145   REAL, DIMENSION(klon,klev),      INTENT(IN)   :: fraca          ! fraction of thermals within the mesh [-]
    146   REAL, DIMENSION(klon,klev),      INTENT(IN)   :: pspsk          ! exner potential (p/100000)**(R/cp)
    147   REAL, DIMENSION(klon,klev),      INTENT(IN)   :: tla            ! liquid temperature within thermals [K]
     148  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: tv                  ! virtual potential temperature [K]
     149  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: qta                 ! specific humidity within thermals [kg/kg]
     150  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: fraca               ! fraction of thermals within the mesh [-]
     151  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: pspsk               ! exner potential (p/100000)**(R/cp)
     152  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: tla                 ! liquid temperature within thermals [K]
     153  REAL, DIMENSION(klon,klev+1),      INTENT(IN)   :: tke                 !--turbulent kinetic energy [m2/s2]
     154  REAL, DIMENSION(klon,klev+1),      INTENT(IN)   :: tke_dissip          !--TKE dissipation [m2/s3]
    148155
    149156  ! INPUT/OUTPUT variables
    150157  !------------------------
    151158 
    152   REAL, DIMENSION(klon,klev),      INTENT(INOUT)   :: thl          ! liquid potential temperature [K]
    153   REAL, DIMENSION(klon,klev),      INTENT(INOUT)   :: ratqs        ! function of pressure that sets the large-scale
     159  REAL, DIMENSION(klon,klev),      INTENT(INOUT)   :: thl              ! liquid potential temperature [K]
     160  REAL, DIMENSION(klon,klev),      INTENT(INOUT)   :: ratqs            ! function of pressure that sets the large-scale
    154161
    155162  ! INPUT/OUTPUT condensation and ice supersaturation
    … …  
    160167  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: u_seri           ! eastward wind [m/s]
    161168  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: v_seri           ! northward wind [m/s]
    162   REAL, DIMENSION(klon,klev+1),    INTENT(IN)   :: pbl_eps          ! TKE dissipation [?]
    163169  REAL, DIMENSION(klon),           INTENT(IN)   :: cell_area        ! area of each cell [m2]
    164170
    … …  
    179185  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: pfraclr          ! precip fraction clear-sky part [-]
    180186  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: pfracld          ! precip fraction cloudy part [-]
     187  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: cldfraliq           ! liquid fraction of cloud [-]
     188  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: sigma2_icefracturb  ! Variance of the diagnostic supersaturation distribution (icefrac_turb) [-]
     189  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: mean_icefracturb    ! Mean of the diagnostic supersaturation distribution (icefrac_turb) [-]
    181190  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: radocond         ! condensed water used in the radiation scheme [kg/kg]
    182191  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: radicefrac       ! ice fraction of condensed water for radiation scheme
    … …  
    190199  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: beta             ! conversion rate of condensed water
    191200
    192   ! fraction of aerosol scavenging through impaction and nucleation (for on-line)
     201  ! fraction of aerosol scavenging through impaction and nucleation    (for on-line)
    193202 
    194   REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: frac_impa        ! scavenging fraction due tu impaction [-]
    195   REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: frac_nucl        ! scavenging fraction due tu nucleation [-]
     203  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: frac_impa           ! scavenging fraction due tu impaction [-]
     204  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: frac_nucl           ! scavenging fraction due tu nucleation [-]
    196205 
    197206  ! for condensation and ice supersaturation
    … …  
    255264  ! LOCAL VARIABLES:
    256265  !----------------
    257 
    258   REAL,DIMENSION(klon) :: qsl, qsi
     266  REAL,DIMENSION(klon) :: qsl, qsi                                ! saturation threshold at current vertical level
    259267  REAL :: zct, zcl,zexpo
    260268  REAL, DIMENSION(klon,klev) :: ctot
    … …  
    263271  REAL :: zdelta, zcor, zcvm5
    264272  REAL, DIMENSION(klon) :: zdqsdT_raw
    265   REAL, DIMENSION(klon) :: gammasat,dgammasatdt                ! coefficient to make cold condensation at the correct RH and derivative wrt T
    266   REAL, DIMENSION(klon) :: Tbef,qlbef,DT
     273  REAL, DIMENSION(klon) :: gammasat,dgammasatdt                   ! coefficient to make cold condensation at the correct RH and derivative wrt T
     274  REAL, DIMENSION(klon) :: Tbef,qlbef,DT                          ! temperature, humidity and temp. variation during lognormal iteration
    267275  REAL :: num,denom
    268276  REAL :: cste
    269   REAL, DIMENSION(klon) :: zpdf_sig,zpdf_k,zpdf_delta
    270   REAL, DIMENSION(klon) :: Zpdf_a,zpdf_b,zpdf_e1,zpdf_e2
     277  REAL, DIMENSION(klon) :: zpdf_sig,zpdf_k,zpdf_delta             ! lognormal parameters
     278  REAL, DIMENSION(klon) :: Zpdf_a,zpdf_b,zpdf_e1,zpdf_e2          ! lognormal intermediate variables
    271279  REAL :: erf
    272280  REAL, DIMENSION(klon) :: zfice_th
    … …  
    285293  REAL :: zmelt,zrain,zsnow,zprecip
    286294  REAL, DIMENSION(klon) :: dzfice
     295  REAL, DIMENSION(klon) :: zfice_turb, dzfice_turb
    287296  REAL :: zsolid
    288297  REAL, DIMENSION(klon) :: qtot, qzero
    … …  
    315324  REAL, DIMENSION(klon,klev) :: radocondi, radocondl
    316325  REAL :: effective_zneb
    317   REAL, DIMENSION(klon) :: distcltop1D, temp_cltop1D
     326  REAL, DIMENSION(klon) :: zdistcltop, ztemp_cltop
     327  REAL, DIMENSION(klon) :: zqliq, zqice, zqvapcl        ! for icefrac_lscp_turb
    318328 
    319329  ! for condensation and ice supersaturation
    … …  
    328338  REAL :: min_qParent, min_ratio
    329339
    330 
    331340  INTEGER i, k, n, kk, iter
    332341  INTEGER, DIMENSION(klon) :: n_i
    … …  
    382391pfraclr(:,:)=0.0
    383392pfracld(:,:)=0.0
     393cldfraliq(:,:)=0.
     394sigma2_icefracturb(:,:)=0.
     395mean_icefracturb(:,:)=0.
    384396radocond(:,:) = 0.0
    385397radicefrac(:,:) = 0.0
    … …  
    391403zfice(:)=0.0
    392404dzfice(:)=0.0
     405zfice_turb(:)=0.0
     406dzfice_turb(:)=0.0
    393407zqprecl(:)=0.0
    394408zqpreci(:)=0.0
    … …  
    405419d_tot_zneb(:) = 0.0
    406420qzero(:) = 0.0
    407 distcltop1D(:)=0.0
    408 temp_cltop1D(:) = 0.0
     421zdistcltop(:)=0.0
     422ztemp_cltop(:) = 0.0
    409423ztupnew(:)=0.0
    410424
    … …  
    459473
    460474
    461 
    462475!c_iso: variable initialisation for iso
    463476
    … …  
    478491
    479492    ! Initialisation temperature and specific humidity
     493    ! temp(klon,klev) is not modified by the routine, instead all changes in temperature are made on zt
     494    ! at the end of the klon loop, a temperature incremtent d_t due to all processes
     495    ! (thermalization, evap/sub incoming precip, cloud formation, precipitation processes) is calculated
     496    ! d_t = temperature tendency due to lscp
     497    ! The temperature of the overlying layer is updated here because needed for thermalization
    480498    DO i = 1, klon
    481499        zt(i)=temp(i,k)
    … …  
    812830                ELSEIF (iflag_cloudth_vert .EQ. 7) THEN
    813831                   ! Updated version of Arnaud Jam (correction by E. Vignon) + adapted treatment
    814                    ! for boundary-layer mixed phase clouds following Vignon et al. 
     832                   ! for boundary-layer mixed phase clouds
    815833                    CALL cloudth_mpc(klon,klev,k,mpc_bl_points,zt,zq,qta(:,k),fraca(:,k), &
    816834                                     pspsk(:,k),paprs(:,k+1),paprs(:,k),pplay(:,k), tla(:,k), &
    … …  
    834852           
    835853                ! lognormal
    836             lognormale = .TRUE.
     854            lognormale(:) = .TRUE.
    837855
    838856        ELSEIF (iflag_cld_th .GE. 6) THEN
    839857           
    840858                ! lognormal distribution when no thermals
    841             lognormale = fraca(:,k) < min_frac_th_cld
     859            lognormale(:) = fraca(:,k) < min_frac_th_cld
    842860
    843861        ELSE
    844862                ! When iflag_cld_th=5, we always assume
    845863                ! bi-gaussian distribution
    846             lognormale = .FALSE.
     864            lognormale(:) = .FALSE.
    847865       
    848866        ENDIF
    … …  
    900918                  IF (iflag_t_glace.GE.4) THEN
    901919                  ! For iflag_t_glace GE 4 the phase partition function dependends on temperature AND distance to cloud top
    902                        CALL distance_to_cloud_top(klon,klev,k,temp,pplay,paprs,rneb,distcltop1D,temp_cltop1D)
     920                       CALL distance_to_cloud_top(klon,klev,k,temp,pplay,paprs,rneb,zdistcltop,ztemp_cltop)
    903921                  ENDIF
    904                   CALL icefrac_lscp(klon, zt(:), iflag_ice_thermo, distcltop1D(:),temp_cltop1D(:),zfice(:),dzfice(:))
    905 
     922
     923                  CALL icefrac_lscp(klon, zt(:), iflag_ice_thermo, zdistcltop(:),ztemp_cltop(:),zfice(:),dzfice(:))
    906924
    907925                  !--AB Activates a condensation scheme that allows for
    … …  
    938956                        pplay(:,k), paprs(:,k), paprs(:,k+1), &
    939957                        cf_seri(:,k), rvc_seri(:,k), ratio_qi_qtot(:,k), &
    940                         shear(:), pbl_eps(:,k), cell_area(:), &
     958                        shear(:), tke_dissip(:,k), cell_area(:), &
    941959                        Tbef(:), zq(:), zqs(:), gammasat(:), ratqs(:,k), keepgoing(:), &
    942960                        rneb(:,k), zqn(:), qvc(:), issrfra(:,k), qissr(:,k), &
    … …  
    10171035                            cste=RLSTT
    10181036                        ENDIF
    1019 
     1037                       
     1038                        ! LEA_R : check formule
    10201039                        IF ( ok_unadjusted_clouds ) THEN
    10211040                          !--AB We relax the saturation adjustment assumption
    … …  
    10591078        ! For iflag_t_glace GE 4 the phase partition function dependends on temperature AND distance to cloud top
    10601079        IF (iflag_t_glace.GE.4) THEN
    1061             CALL distance_to_cloud_top(klon,klev,k,temp,pplay,paprs,rneb,distcltop1D,temp_cltop1D)
    1062             distcltop(:,k)=distcltop1D(:)
    1063             temp_cltop(:,k)=temp_cltop1D(:)
    1064         ENDIF   
    1065         ! Partition function in stratiform clouds (will be overwritten in boundary-layer MPCs)
    1066         CALL icefrac_lscp(klon,zt,iflag_ice_thermo,distcltop1D,temp_cltop1D,zfice,dzfice)
    1067 
     1080           CALL distance_to_cloud_top(klon,klev,k,temp,pplay,paprs,rneb,zdistcltop,ztemp_cltop)
     1081           distcltop(:,k)=zdistcltop(:)
     1082           temp_cltop(:,k)=ztemp_cltop(:)
     1083        ENDIF
     1084
     1085        ! Partition function depending on temperature
     1086        CALL icefrac_lscp(klon, zt, iflag_ice_thermo, zdistcltop, ztemp_cltop, zfice, dzfice)
     1087
     1088        ! Partition function depending on tke for non shallow-convective clouds
     1089        IF (iflag_icefrac .GE. 1) THEN
     1090
     1091           CALL icefrac_lscp_turb(klon, dtime, Tbef, pplay(:,k), paprs(:,k), paprs(:,k+1), qice_save(:,k), ziflcld, zqn, &
     1092           rneb(:,k), tke(:,k), tke_dissip(:,k), zqliq, zqvapcl, zqice, zfice_turb, dzfice_turb, cldfraliq(:,k),sigma2_icefracturb(:,k), mean_icefracturb(:,k))
     1093
     1094        ENDIF
    10681095
    10691096        ! Water vapor update, Phase determination and subsequent latent heat exchange
    10701097        DO i=1, klon
    1071 
     1098            ! Overwrite phase partitioning in boundary layer mixed phase clouds when the
     1099            ! iflag_cloudth_vert=7 and specific param is activated
    10721100            IF (mpc_bl_points(i,k) .GT. 0) THEN
    1073                
    10741101                zcond(i) = MAX(0.0,qincloud_mpc(i))*rneb(i,k)
    10751102                ! following line is very strange and probably wrong
    … …  
    10781105                zq(i) = zq(i) - zcond(i)       
    10791106                zfice(i)=zfice_th(i)
    1080 
    10811107            ELSE
    1082 
    10831108                ! Checks on rneb, rhcl and zqn
    10841109                IF (rneb(i,k) .LE. 0.0) THEN
    … …  
    11081133                    ! following line is very strange and probably wrong:
    11091134                    rhcl(i,k)=(zqs(i)+zq(i))/2./zqs(i)
     1135                    ! Overwrite partitioning for non shallow-convective clouds if iflag_icefrac>1 (icefrac turb param)
     1136                    IF (iflag_icefrac .GE. 1) THEN
     1137                        IF (lognormale(i)) THEN 
     1138                           zcond(i)  = zqliq(i) + zqice(i)
     1139                           zfice(i)=zfice_turb(i)
     1140                           rhcl(i,k) = zqvapcl(i) * rneb(i,k) + (zq(i) - zqn(i)) * (1.-rneb(i,k))
     1141                        ENDIF
     1142                    ENDIF
    11101143                ENDIF
    11111144
    … …  
    14931526                znebprecipcld(i)=0.0
    14941527            ENDIF
    1495 
     1528        !IF ( ((1-zfice(i))*zoliq(i) .GT. 0.) .AND. (zt(i) .LE. 233.15) ) THEN
     1529        !print*,'WARNING LEA OLIQ A <-40°C '
     1530        !print*,'zt,Tbef,oliq,oice,cldfraliq,icefrac,rneb',zt(i),Tbef(i),(1-zfice(i))*zoliq(i),zfice(i)*zoliq(i),cldfraliq(i,k),zfice(i),rneb(i,k)
     1531        !ENDIF
    14961532        ENDDO
    14971533

  • LMDZ6/branches/cirrus/libf/phylmd/lmdz_lscp_ini.F90

    r5165 r5202  
    6767  !$OMP THREADPRIVATE(iflag_t_glace)
    6868
    69   INTEGER, SAVE, PROTECTED :: iflag_cloudth_vert=0         ! option for determining cloud fraction and content in convective boundary layers
     69  INTEGER, SAVE, PROTECTED :: iflag_cloudth_vert=0          ! option for determining cloud fraction and content in convective boundary layers
    7070  !$OMP THREADPRIVATE(iflag_cloudth_vert)
    7171
    72   INTEGER, SAVE, PROTECTED :: iflag_gammasat=0             ! which threshold for homogeneous nucleation below -40oC
     72  INTEGER, SAVE, PROTECTED :: iflag_gammasat=0              ! which threshold for homogeneous nucleation below -40oC
    7373  !$OMP THREADPRIVATE(iflag_gammasat)
    7474
    75   INTEGER, SAVE, PROTECTED :: iflag_rain_incloud_vol=0     ! use of volume cloud fraction for rain autoconversion
     75  INTEGER, SAVE, PROTECTED :: iflag_rain_incloud_vol=0      ! use of volume cloud fraction for rain autoconversion
    7676  !$OMP THREADPRIVATE(iflag_rain_incloud_vol)
    7777
    78   INTEGER, SAVE, PROTECTED :: iflag_bergeron=0             ! bergeron effect for liquid precipitation treatment 
     78  INTEGER, SAVE, PROTECTED :: iflag_bergeron=0              ! bergeron effect for liquid precipitation treatment 
    7979  !$OMP THREADPRIVATE(iflag_bergeron)
    8080
    81   INTEGER, SAVE, PROTECTED :: iflag_fisrtilp_qsat=0        ! qsat adjustment (iterative) during autoconversion
     81  INTEGER, SAVE, PROTECTED :: iflag_fisrtilp_qsat=0         ! qsat adjustment (iterative) during autoconversion
    8282  !$OMP THREADPRIVATE(iflag_fisrtilp_qsat)
    8383
    84   INTEGER, SAVE, PROTECTED :: iflag_pdf=0                  ! type of subgrid scale qtot pdf
     84  INTEGER, SAVE, PROTECTED :: iflag_pdf=0                   ! type of subgrid scale qtot pdf
    8585  !$OMP THREADPRIVATE(iflag_pdf)
    8686
    87   INTEGER, SAVE, PROTECTED :: iflag_autoconversion=0       ! autoconversion option
     87  INTEGER, SAVE, PROTECTED :: iflag_icefrac=0               ! which phase partitioning function to use
     88  !$OMP THREADPRIVATE(iflag_icefrac)
     89
     90  INTEGER, SAVE, PROTECTED :: iflag_autoconversion=0        ! autoconversion option
    8891  !$OMP THREADPRIVATE(iflag_autoconversion)
    8992
    90   LOGICAL, SAVE, PROTECTED :: reevap_ice=.false.           ! no liquid precip for T< threshold
     93
     94  LOGICAL, SAVE, PROTECTED :: reevap_ice=.false.            ! no liquid precip for T< threshold
    9195  !$OMP THREADPRIVATE(reevap_ice)
    9296
    93   REAL, SAVE, PROTECTED :: cld_lc_lsc=2.6e-4               ! liquid autoconversion coefficient, stratiform rain
     97  REAL, SAVE, PROTECTED :: cld_lc_lsc=2.6e-4                ! liquid autoconversion coefficient, stratiform rain
    9498  !$OMP THREADPRIVATE(cld_lc_lsc)
    9599
    … …  
    118122  !$OMP THREADPRIVATE(coef_eva)
    119123
    120   REAL, SAVE, PROTECTED :: coef_sub                        ! tuning coefficient ice precip sublimation
     124  REAL, SAVE, PROTECTED :: coef_sub                         ! tuning coefficient ice precip sublimation
    121125  !$OMP THREADPRIVATE(coef_sub)
    122126
    … …  
    124128  !$OMP THREADPRIVATE(expo_eva)
    125129
    126   REAL, SAVE, PROTECTED :: expo_sub                       ! tuning coefficient ice precip sublimation
     130  REAL, SAVE, PROTECTED :: expo_sub                         ! tuning coefficient ice precip sublimation
    127131  !$OMP THREADPRIVATE(expo_sub)
    128132
    … …  
    226230  !$OMP THREADPRIVATE(thresh_precip_frac)
    227231
     232  REAL, SAVE, PROTECTED :: tau_mixenv=100000                ! Homogeneization time of mixed phase clouds [s]
     233  !$OMP THREADPRIVATE(tau_mixenv)
     234
     235    REAL, SAVE, PROTECTED :: capa_crystal=1.                ! Sursaturation of ice part in mixed phase clouds [-]
     236  !$OMP THREADPRIVATE(capa_crystal)
     237
     238  REAL, SAVE, PROTECTED :: lmix_mpc=1000                    ! Length of turbulent zones in Mixed Phase Clouds [m]
     239  !$OMP THREADPRIVATE(lmix_mpc)
     240
     241  REAL, SAVE, PROTECTED :: naero5=0.5                       ! Number concentration of aerosol larger than 0.5 microns [scm-3]
     242  !$OMP THREADPRIVATE(naero5)
     243
     244  REAL, SAVE, PROTECTED :: gamma_snwretro = 0.              ! Proportion of snow taken into account in ice retroaction in icefrac_turb [-]
     245  !$OMP THREADPRIVATE(gamma_snwretro)
     246
     247  REAL, SAVE, PROTECTED :: gamma_taud = 1.                  ! Tuning coeff for tau_dissipturb [-]
     248  !$OMP THREADPRIVATE(gamma_taud)
     249
    228250  REAL, SAVE, PROTECTED :: gamma_col=1.                     ! A COMMENTER TODO [-]
    229251  !$OMP THREADPRIVATE(gamma_col)
    … …  
    235257  !$OMP THREADPRIVATE(gamma_rim)
    236258
    237   REAL, SAVE, PROTECTED :: rho_rain=1000.                    ! A COMMENTER TODO [kg/m3]
     259  REAL, SAVE, PROTECTED :: rho_rain=1000.                   ! Rain density [kg/m3]
    238260  !$OMP THREADPRIVATE(rho_rain)
    239261
    240   REAL, SAVE, PROTECTED :: rho_ice=920.                    ! A COMMENTER TODO [kg/m3]
     262  REAL, SAVE, PROTECTED :: rho_ice=920.                     ! Ice density [kg/m3]
    241263  !$OMP THREADPRIVATE(rho_ice)
    242264
    243   REAL, SAVE, PROTECTED :: r_rain=500.E-6                   ! A COMMENTER TODO [m]
     265  REAL, SAVE, PROTECTED :: r_rain=500.E-6                   ! Rain droplets radius for POPRECIP [m]
    244266  !$OMP THREADPRIVATE(r_rain)
    245267
    246   REAL, SAVE, PROTECTED :: r_snow=1.E-3                    ! A COMMENTER TODO [m]
     268  REAL, SAVE, PROTECTED :: r_snow=1.E-3                     ! Ice crystals radius for POPRECIP [m]
    247269  !$OMP THREADPRIVATE(r_snow)
    248270
    249   REAL, SAVE, PROTECTED :: tau_auto_snow_min=100.          ! A COMMENTER TODO [s]
     271  REAL, SAVE, PROTECTED :: tau_auto_snow_min=100.           ! A COMMENTER TODO [s]
    250272  !$OMP THREADPRIVATE(tau_auto_snow_min)
    251273
    … …  
    256278  !$OMP THREADPRIVATE(eps)
    257279
    258   REAL, SAVE, PROTECTED :: gamma_melt=1.                   ! A COMMENTER TODO [-]
     280  REAL, SAVE, PROTECTED :: gamma_melt=1.                    ! A COMMENTER TODO [-]
    259281  !$OMP THREADPRIVATE(gamma_melt)
    260282
    261   REAL, SAVE, PROTECTED :: alpha_freez=4.                 ! A COMMENTER TODO [-]
     283  REAL, SAVE, PROTECTED :: alpha_freez=4.                   ! A COMMENTER TODO [-]
    262284  !$OMP THREADPRIVATE(alpha_freez)
    263285
    264   REAL, SAVE, PROTECTED :: beta_freez=0.1                 ! A COMMENTER TODO [m-3.s-1]
     286  REAL, SAVE, PROTECTED :: beta_freez=0.1                   ! A COMMENTER TODO [m-3.s-1]
    265287  !$OMP THREADPRIVATE(beta_freez)
    266288
    267   REAL, SAVE, PROTECTED :: gamma_freez=1.                 ! A COMMENTER TODO [-]
     289  REAL, SAVE, PROTECTED :: gamma_freez=1.                   ! A COMMENTER TODO [-]
    268290  !$OMP THREADPRIVATE(gamma_freez)
    269291
    270   REAL, SAVE, PROTECTED :: rain_fallspeed=4.              ! A COMMENTER TODO [m/s]
     292  REAL, SAVE, PROTECTED :: rain_fallspeed=4.                ! A COMMENTER TODO [m/s]
    271293  !$OMP THREADPRIVATE(rain_fallspeed)
    272294
    273   REAL, SAVE, PROTECTED :: rain_fallspeed_clr              ! A COMMENTER TODO [m/s]
     295  REAL, SAVE, PROTECTED :: rain_fallspeed_clr                ! A COMMENTER TODO [m/s]
    274296  !$OMP THREADPRIVATE(rain_fallspeed_clr)
    275297
    276   REAL, SAVE, PROTECTED :: rain_fallspeed_cld             ! A COMMENTER TODO [m/s]
     298  REAL, SAVE, PROTECTED :: rain_fallspeed_cld               ! A COMMENTER TODO [m/s]
    277299  !$OMP THREADPRIVATE(rain_fallspeed_cld)
    278300
    279   REAL, SAVE, PROTECTED :: snow_fallspeed=1.             ! A COMMENTER TODO [m/s]
     301  REAL, SAVE, PROTECTED :: snow_fallspeed=1.               ! A COMMENTER TODO [m/s]
    280302  !$OMP THREADPRIVATE(snow_fallspeed)
    281303
    282   REAL, SAVE, PROTECTED :: snow_fallspeed_clr             ! A COMMENTER TODO [m/s]
     304  REAL, SAVE, PROTECTED :: snow_fallspeed_clr               ! A COMMENTER TODO [m/s]
    283305  !$OMP THREADPRIVATE(snow_fallspeed_clr)
    284306
    285   REAL, SAVE, PROTECTED :: snow_fallspeed_cld             ! A COMMENTER TODO [m/s]
     307  REAL, SAVE, PROTECTED :: snow_fallspeed_cld               ! A COMMENTER TODO [m/s]
    286308  !$OMP THREADPRIVATE(snow_fallspeed_cld)
    287309  !--End of the parameters for poprecip
    … …  
    325347    RLMLT=RLMLT_in
    326348    RTT=RTT_in
    327     RG=RG_in
     349    RV=RV_in
    328350    RVTMP2=RVTMP2_in
    329351    RPI=RPI_in
    … …  
    347369    CALL getin_p('iflag_fisrtilp_qsat',iflag_fisrtilp_qsat)
    348370    CALL getin_p('iflag_pdf',iflag_pdf)
     371    CALL getin_p('iflag_icefrac',iflag_icefrac)
    349372    CALL getin_p('reevap_ice',reevap_ice)
    350373    CALL getin_p('cld_lc_lsc',cld_lc_lsc)
    … …  
    368391    CALL getin_p('dist_liq',dist_liq)
    369392    CALL getin_p('tresh_cl',tresh_cl)
     393    CALL getin_p('tau_mixenv',tau_mixenv)
     394    CALL getin_p('capa_crystal',capa_crystal)
     395    CALL getin_p('lmix_mpc',lmix_mpc)
     396    CALL getin_p('naero5',naero5)
     397    CALL getin_p('gamma_snwretro',gamma_snwretro)
     398    CALL getin_p('gamma_taud',gamma_taud)
    370399    CALL getin_p('iflag_oldbug_fisrtilp',iflag_oldbug_fisrtilp)
    371400    CALL getin_p('temp_nowater',temp_nowater)
    … …  
    430459    WRITE(lunout,*) 'lscp_ini, iflag_fisrtilp_qsat:', iflag_fisrtilp_qsat
    431460    WRITE(lunout,*) 'lscp_ini, iflag_pdf', iflag_pdf
     461    WRITE(lunout,*) 'lscp_ini, iflag_icefrac', iflag_icefrac
    432462    WRITE(lunout,*) 'lscp_ini, reevap_ice', reevap_ice
    433463    WRITE(lunout,*) 'lscp_ini, cld_lc_lsc', cld_lc_lsc
    … …  
    448478    WRITE(lunout,*) 'lscp_ini, dist_liq', dist_liq
    449479    WRITE(lunout,*) 'lscp_ini, tresh_cl', tresh_cl
     480    WRITE(lunout,*) 'lscp_ini, tau_mixenv', tau_mixenv
     481    WRITE(lunout,*) 'lscp_ini, capa_crystal', capa_crystal
     482    WRITE(lunout,*) 'lscp_ini, lmix_mpc', lmix_mpc
     483    WRITE(lunout,*) 'lscp_ini, naero5', naero5
     484    WRITE(lunout,*) 'lscp_ini, gamma_snwretro', gamma_snwretro
     485    WRITE(lunout,*) 'lscp_ini, gamma_taud', gamma_taud
    450486    WRITE(lunout,*) 'lscp_ini, iflag_oldbug_fisrtilp', iflag_oldbug_fisrtilp
    451487    WRITE(lunout,*) 'lscp_ini, fl_cor_ebil', fl_cor_ebil

  • LMDZ6/branches/cirrus/libf/phylmd/lmdz_lscp_poprecip.F90

    r4974 r5202  
    559559
    560560    !--Same as for aggregation
    561     !--Eff_snow_liq formula: following Milbrandt and Yau 2005,
     561    !--Eff_snow_liq formula:
    562562    !--it s a product of a collection efficiency and a sticking efficiency
    563     Eff_snow_ice = 0.05 * EXP( 0.1 * ( temp(i) - RTT ) )
     563    ! Milbrandt and Yau formula that gives very low values:
     564    ! Eff_snow_ice = 0.05 * EXP( 0.1 * ( temp(i) - RTT ) )
     565    ! Lin 1983's formula
     566    Eff_snow_ice = EXP( 0.025 * MIN( ( temp(i) - RTT ), 0.) )
    564567    !--rho_snow formula follows Brandes et al. 2007 (JAMC)
    565568    rho_snow = 1.e3 * 0.178 * ( r_snow * 2. * 1000. )**(-0.922)
    … …  
    653656    !--NB.: this process needs a temperature adjustment
    654657
    655     !--Eff_snow_liq formula: following Seifert and Beheng 2006,
    656     !--assuming a cloud droplet diameter of 20 microns.
    657     Eff_snow_liq = 0.2
     658    !--Eff_snow_liq formula: following Ferrier 1994,
     659    !--assuming 1
     660    Eff_snow_liq = 1.0
    658661    !--rho_snow formula follows Brandes et al. 2007 (JAMC)
    659662    rho_snow = 1.e3 * 0.178 * ( r_snow * 2. * 1000. )**(-0.922)

  • LMDZ6/branches/cirrus/libf/phylmd/lmdz_lscp_tools.F90

    r5019 r5202  
    136136    CHARACTER (len = 80) :: abort_message
    137137
    138     IF ((iflag_t_glace.LT.2) .OR. (iflag_t_glace.GT.6)) THEN
     138    IF ((iflag_t_glace.LT.2)) THEN !.OR. (iflag_t_glace.GT.6)) THEN
    139139       abort_message = 'lscp cannot be used if iflag_t_glace<2 or >6'
    140140       CALL abort_physic(modname,abort_message,1)
    … …  
    194194
    195195        ! with CMIP6 function of temperature at cloud top
    196         IF (iflag_t_glace .EQ. 5) THEN
     196        IF ((iflag_t_glace .EQ. 5) .OR. (iflag_t_glace .EQ. 7)) THEN
    197197                liqfrac_tmp = (temp(i)-t_glace_min) / (t_glace_max-t_glace_min)
    198198                liqfrac_tmp =  MIN(MAX(liqfrac_tmp,0.0),1.0)
    … …  
    232232                ENDIF
    233233        ENDIF
    234 
     234     
    235235
    236236     ENDDO ! klon
    237  
    238237     RETURN
    239238 
    … …  
    241240!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    242241
     242SUBROUTINE ICEFRAC_LSCP_TURB(klon, dtime, temp, pplay, paprsdn, paprsup, qice_ini, snowcld, qtot_incl, cldfra, tke, tke_dissip, qliq, qvap_cld, qice, icefrac, dicefracdT, cldfraliq, sigma2_icefracturb, mean_icefracturb)
     243!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
     244  ! Compute the liquid, ice and vapour content (+ice fraction) based
     245  ! on turbulence (see Fields 2014, Furtado 2016, Raillard 2025)
     246  ! L.Raillard (30/08/24)
     247!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
     248
     249
     250   USE lmdz_lscp_ini, ONLY : prt_level, lunout
     251   USE lmdz_lscp_ini, ONLY : RCPD, RLSTT, RLVTT, RLMLT, RVTMP2, RTT, RD, RG, RV, RPI
     252   USE lmdz_lscp_ini, ONLY : seuil_neb, temp_nowater
     253   USE lmdz_lscp_ini, ONLY : tau_mixenv, lmix_mpc, naero5, gamma_snwretro, gamma_taud, capa_crystal
     254   USE lmdz_lscp_ini, ONLY : eps
     255
     256   IMPLICIT NONE
     257
     258   INTEGER,   INTENT(IN)                           :: klon              !--number of horizontal grid points
     259   REAL,      INTENT(IN)                           :: dtime             !--time step [s]
     260
     261   REAL,      INTENT(IN),       DIMENSION(klon)    :: temp              !--temperature
     262   REAL,      INTENT(IN),       DIMENSION(klon)    :: pplay             !--pressure in the middle of the layer       [Pa]
     263   REAL,      INTENT(IN),       DIMENSION(klon)    :: paprsdn           !--pressure at the bottom interface of the layer [Pa]
     264   REAL,      INTENT(IN),       DIMENSION(klon)    :: paprsup           !--pressure at the top interface of the layer [Pa]
     265   REAL,      INTENT(IN),       DIMENSION(klon)    :: qtot_incl         !--specific total cloud water content, in-cloud content [kg/kg]
     266   REAL,      INTENT(IN),       DIMENSION(klon)    :: cldfra            !--cloud fraction in gridbox [-]
     267   REAL,      INTENT(IN),       DIMENSION(klon)    :: tke               !--turbulent kinetic energy [m2/s2]
     268   REAL,      INTENT(IN),       DIMENSION(klon)    :: tke_dissip        !--TKE dissipation [m2/s3]
     269
     270   REAL,      INTENT(IN),       DIMENSION(klon)    :: qice_ini          !--initial specific ice content gridbox-mean [kg/kg]
     271   REAL,      INTENT(IN),       DIMENSION(klon)    :: snowcld
     272   REAL,      INTENT(OUT),      DIMENSION(klon)    :: qliq              !--specific liquid content gridbox-mean [kg/kg]
     273   REAL,      INTENT(OUT),      DIMENSION(klon)    :: qvap_cld          !--specific cloud vapor content, gridbox-mean [kg/kg]
     274   REAL,      INTENT(OUT),      DIMENSION(klon)    :: qice              !--specific ice content gridbox-mean [kg/kg]
     275   REAL,      INTENT(OUT),      DIMENSION(klon)    :: icefrac           !--fraction of ice in condensed water [-]
     276   REAL,      INTENT(OUT),      DIMENSION(klon)    :: dicefracdT
     277
     278   REAL,      INTENT(OUT),      DIMENSION(klon)    :: cldfraliq         !--fraction of cldfra which is liquid only
     279   REAL,      INTENT(OUT),      DIMENSION(klon)    :: sigma2_icefracturb     !--Temporary
     280   REAL,      INTENT(OUT),      DIMENSION(klon)    :: mean_icefracturb      !--Temporary
     281
     282   REAL, DIMENSION(klon) :: qzero, qsatl, dqsatl, qsati, dqsati         !--specific humidity saturation values
     283   INTEGER :: i
     284
     285   REAL :: qvap_incl, qice_incl, qliq_incl, qiceini_incl                !--In-cloud specific quantities [kg/kg]
     286   REAL :: qsnowcld_incl
     287   !REAL :: capa_crystal                                                 !--Capacitance of ice crystals  [-]
     288   REAL :: water_vapor_diff                                             !--Water-vapour diffusion coefficient in air [m2/s] (function of T&P)
     289   REAL :: air_thermal_conduct                                          !--Thermal conductivity of air [J/m/K/s] (function of T)
     290   REAL :: C0                                                           !--Lagrangian structure function [-]
     291   REAL :: tau_mixingenv
     292   REAL :: tau_dissipturb
     293   REAL :: invtau_phaserelax
     294   REAL :: sigma2_pdf, mean_pdf
     295   REAL :: ai, bi, B0
     296   REAL :: sursat_iceliq
     297   REAL :: sursat_env
     298   REAL :: liqfra_max
     299   REAL :: sursat_iceext
     300   REAL :: nb_crystals                                                  !--number concentration of ice crystals [#/m3]
     301   REAL :: moment1_PSD                                                  !--1st moment of ice PSD
     302   REAL :: N0_PSD, lambda_PSD                                           !--parameters of the exponential PSD
     303
     304   REAL :: rho_ice                                                      !--ice density [kg/m3]
     305   REAL :: cldfra1D
     306   REAL :: deltaz, rho_air
     307   REAL :: psati                                                        !--saturation vapor pressure wrt i [Pa]
     308   
     309   C0            = 10.                                                  !--value assumed in Field2014           
     310   rho_ice       = 950.
     311   sursat_iceext = -0.1
     312   !capa_crystal  = 1. !r_ice                                       
     313   qzero(:)      = 0.
     314   cldfraliq(:)  = 0.
     315   icefrac(:)    = 0.
     316   dicefracdT(:) = 0.
     317
     318   sigma2_icefracturb(:) = 0.
     319   mean_icefracturb(:)  = 0.
     320
     321   !--wrt liquid water
     322   CALL calc_qsat_ecmwf(klon,temp(:),qzero(:),pplay(:),RTT,1,.false.,qsatl(:),dqsatl(:))
     323   !--wrt ice
     324   CALL calc_qsat_ecmwf(klon,temp(:),qzero(:),pplay(:),RTT,2,.false.,qsati(:),dqsati(:))
     325
     326
     327    DO i=1,klon
     328
     329
     330     rho_air  = pplay(i) / temp(i) / RD
     331     !deltaz   = ( paprsdn(i) - paprsup(i) ) / RG / rho_air(i)
     332     ! because cldfra is intent in, but can be locally modified due to test
     333     cldfra1D = cldfra(i)
     334     IF (cldfra(i) .LE. 0.) THEN
     335        qvap_cld(i)   = 0.
     336        qliq(i)       = 0.
     337        qice(i)       = 0.
     338        cldfraliq(i)  = 0.
     339        icefrac(i)    = 0.
     340        dicefracdT(i) = 0.
     341
     342     ! If there is a cloud
     343     ELSE
     344        IF (cldfra(i) .GE. 1.0) THEN
     345           cldfra1D = 1.0
     346        END IF
     347       
     348        ! T>0°C, no ice allowed
     349        IF ( temp(i) .GE. RTT ) THEN
     350           qvap_cld(i)   = qsatl(i) * cldfra1D
     351           qliq(i)       = MAX(0.0,qtot_incl(i)-qsatl(i))  * cldfra1D
     352           qice(i)       = 0.
     353           cldfraliq(i)  = 1.
     354           icefrac(i)    = 0.
     355           dicefracdT(i) = 0.
     356       
     357        ! T<-38°C, no liquid allowed
     358        ELSE IF ( temp(i) .LE. temp_nowater) THEN
     359           qvap_cld(i)   = qsati(i) * cldfra1D
     360           qliq(i)       = 0.
     361           qice(i)       = MAX(0.0,qtot_incl(i)-qsati(i)) * cldfra1D
     362           cldfraliq(i)  = 0.
     363           icefrac(i)    = 1.
     364           dicefracdT(i) = 0.
     365
     366        ! MPC temperature
     367        ELSE
     368           ! Not enough TKE     
     369           IF ( tke_dissip(i) .LE. eps )  THEN
     370              qvap_cld(i)   = qsati(i) * cldfra1D
     371              qliq(i)       = 0.
     372              qice(i)       = MAX(0.,qtot_incl(i)-qsati(i)) * cldfra1D   
     373              cldfraliq(i)  = 0.
     374              icefrac(i)    = 1.
     375              dicefracdT(i) = 0.
     376           
     377           ! Enough TKE   
     378           ELSE 
     379              print*,"MOUCHOIRACTIVE"
     380              !---------------------------------------------------------
     381              !--               ICE SUPERSATURATION PDF   
     382              !---------------------------------------------------------
     383              !--If -38°C< T <0°C and there is enough turbulence,
     384              !--we compute the cloud liquid properties with a Gaussian PDF
     385              !--of ice supersaturation F(Si) (Field2014, Furtado2016).
     386              !--Parameters of the PDF are function of turbulence and
     387              !--microphysics/existing ice.
     388
     389              sursat_iceliq = qsatl(i)/qsati(i) - 1.
     390              psati         = qsati(i) * pplay(i) / (RD/RV)
     391
     392              !-------------- MICROPHYSICAL TERMS --------------
     393              !--We assume an exponential ice PSD whose parameters
     394              !--are computed following Morrison&Gettelman 2008
     395              !--Ice number density is assumed equals to INP density
     396              !--which is a function of temperature (DeMott 2010) 
     397              !--bi and B0 are microphysical function characterizing
     398              !--vapor/ice interactions
     399              !--tau_phase_relax is the typical time of vapor deposition
     400              !--onto ice crystals
     401             
     402              qiceini_incl  = qice_ini(i) / cldfra1D
     403              qsnowcld_incl = snowcld(i) * RG * dtime / ( paprsdn(i) - paprsup(i) ) / cldfra1D
     404              sursat_env    = max(0., (qtot_incl(i) - qiceini_incl)/qsati(i) - 1.)
     405              IF ( qiceini_incl .GT. eps ) THEN
     406                nb_crystals = 1.e3 * 5.94e-5 * ( RTT - temp(i) )**3.33 * naero5**(0.0264*(RTT-temp(i))+0.0033)
     407                lambda_PSD  = ( (RPI*rho_ice*nb_crystals) / (rho_air*(qiceini_incl + gamma_snwretro * qsnowcld_incl)) ) ** (1./3.)
     408                N0_PSD      = nb_crystals * lambda_PSD
     409                moment1_PSD = N0_PSD/lambda_PSD**2
     410              ELSE
     411                moment1_PSD = 0.
     412              ENDIF
     413
     414              !--Formulae for air thermal conductivity and water vapor diffusivity
     415              !--comes respectively from Beard and Pruppacher (1971)
     416              !--and  Hall and Pruppacher (1976)
     417
     418              air_thermal_conduct = ( 5.69 + 0.017 * ( temp(i) - RTT ) ) * 1.e-3 * 4.184
     419              water_vapor_diff    = 2.11*1e-5 * ( temp(i) / RTT )**1.94 * ( 101325 / pplay(i) )
     420             
     421              bi = 1./((qsati(i)+qsatl(i))/2.) + RLSTT**2 / RCPD / RV / temp(i)**2
     422              B0 = 4. * RPI * capa_crystal * 1. / (  RLSTT**2 / air_thermal_conduct / RV / temp(i)**2  &
     423                                                  +  RV * temp(i) / psati / water_vapor_diff  )
     424
     425              invtau_phaserelax  = (bi * B0 * moment1_PSD )
     426
     427!             Old way of estimating moment1 : spherical crystals + monodisperse PSD             
     428!             nb_crystals = rho_air * qiceini_incl / ( 4. / 3. * RPI * r_ice**3. * rho_ice )
     429!             moment1_PSD = nb_crystals * r_ice
     430
     431              !----------------- TURBULENT SOURCE/SINK TERMS -----------------
     432              !--Tau_mixingenv is the time needed to homogeneize the parcel
     433              !--with its environment by turbulent diffusion over the parcel
     434              !--length scale
     435              !--if lmix_mpc <0, tau_mixigenv value is prescribed
     436              !--else tau_mixigenv value is derived from tke_dissip and lmix_mpc
     437              !--Tau_dissipturb is the time needed turbulence to decay due to
     438              !--viscosity
     439
     440              ai = RG / RD / temp(i) * ( RD * RLSTT / RCPD / RV / temp(i) - 1. )
     441              IF ( lmix_mpc .GT. 0 ) THEN
     442                 tau_mixingenv = ( lmix_mpc**2. / tke_dissip(i) )**(1./3.)
     443              ELSE
     444                 tau_mixingenv = tau_mixenv
     445              ENDIF
     446             
     447              tau_dissipturb = gamma_taud * 2. * 2./3. * tke(i) / tke_dissip(i) / C0
     448
     449              !--------------------- PDF COMPUTATIONS ---------------------
     450              !--Formulae for sigma2_pdf (variance), mean of PDF in Furtado2016
     451              !--cloud liquid fraction and in-cloud liquid content are given
     452              !--by integrating resp. F(Si) and Si*F(Si)
     453              !--Liquid is limited by the available water vapor trough a
     454              !--maximal liquid fraction
     455
     456              liqfra_max = MAX(0., (MIN (1.,( qtot_incl(i) - qiceini_incl - qsati(i) * (1 + sursat_iceext ) ) / ( qsatl(i) - qsati(i) ) ) ) )
     457              sigma2_pdf = 1./2. * ( ai**2 ) *  2./3. * tke(i) * tau_dissipturb / ( invtau_phaserelax + 1./tau_mixingenv )
     458              mean_pdf   = sursat_env * 1./tau_mixingenv / ( invtau_phaserelax + 1./tau_mixingenv )
     459              cldfraliq(i) = 0.5 * (1. - erf( ( sursat_iceliq - mean_pdf) / (SQRT(2.* sigma2_pdf) ) ) )
     460              IF (cldfraliq(i) .GT. liqfra_max) THEN
     461                  cldfraliq(i) = liqfra_max
     462              ENDIF
     463             
     464              qliq_incl = qsati(i) * SQRT(sigma2_pdf) / SQRT(2.*RPI) * EXP( -1.*(sursat_iceliq - mean_pdf)**2. / (2.*sigma2_pdf) )  &
     465                        - qsati(i) * cldfraliq(i) * (sursat_iceliq - mean_pdf )
     466             
     467              sigma2_icefracturb(i)= sigma2_pdf
     468              mean_icefracturb(i)  = mean_pdf
     469     
     470              !------------ SPECIFIC VAPOR CONTENT AND WATER CONSERVATION  ------------
     471
     472              IF ( (qliq_incl .LE. eps) .OR. (cldfraliq(i) .LE. eps) ) THEN
     473                  qliq_incl    = 0.
     474                  cldfraliq(i) = 0.
     475              END IF
     476               
     477              !--Specific humidity is the max between qsati and the weighted mean between
     478              !--qv in MPC patches and qv in ice-only parts. We assume that MPC parts are
     479              !--always at qsatl and ice-only parts slightly subsaturated (qsati*sursat_iceext+1)
     480              !--The whole cloud can therefore be supersaturated but never subsaturated.
     481
     482              qvap_incl = MAX(qsati(i), ( 1. - cldfraliq(i) ) * (sursat_iceext + 1.) * qsati(i) + cldfraliq(i) * qsatl(i) )
     483
     484
     485              IF ( qvap_incl  .GE. qtot_incl(i) ) THEN
     486                 qvap_incl = qsati(i)
     487                 qliq_incl = qtot_incl(i) - qvap_incl
     488                 qice_incl = 0.
     489
     490              ELSEIF ( (qvap_incl + qliq_incl) .GE. qtot_incl(i) ) THEN
     491                 qliq_incl = MAX(0.0,qtot_incl(i) - qvap_incl)
     492                 qice_incl = 0.
     493              ELSE
     494                 qice_incl = qtot_incl(i) - qvap_incl - qliq_incl
     495              END IF
     496
     497              qvap_cld(i)   = qvap_incl * cldfra1D
     498              qliq(i)       = qliq_incl * cldfra1D
     499              qice(i)       = qice_incl * cldfra1D
     500              icefrac(i)    = qice(i) / ( qice(i) + qliq(i) )
     501              dicefracdT(i) = 0.
     502              !print*,'MPC turb'
     503
     504           END IF ! Enough TKE
     505
     506        END IF ! ! MPC temperature
     507
     508     END IF ! cldfra
     509   
     510   ENDDO ! klon
     511END SUBROUTINE ICEFRAC_LSCP_TURB
     512!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    243513
    244514

  • LMDZ6/branches/cirrus/libf/phylmd/lmdz_thermcell_plume_6A.F90

    r4678 r5202  
    6363      REAL,dimension(ngrid,nlay) :: zeps
    6464
    65       REAL, dimension(ngrid) ::    wmaxa(ngrid)
     65      REAL, dimension(ngrid) ::    wmaxa
    6666
    6767      INTEGER ig,l,k,lt,it,lm

  • LMDZ6/branches/cirrus/libf/phylmd/ocean_forced_mod.F90

    r4523 r5202  
    2222       radsol, snow, agesno, &
    2323       qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
    24        tsurf_new, dflux_s, dflux_l, sens_prec_liq, rhoa)
     24       tsurf_new, dflux_s, dflux_l, sens_prec_liq, rhoa &
     25#ifdef ISO
     26       ,xtprecip_rain, xtprecip_snow, xtspechum,Roce,rlat, &
     27       xtsnow,xtevap,h1 & 
     28#endif           
     29       )
    2530!
    2631! This subroutine treats the "open ocean", all grid points that are not entierly covered
    … …  
    3641    USE phys_output_var_mod, ONLY : sens_prec_liq_o, sens_prec_sol_o, lat_prec_liq_o, lat_prec_sol_o
    3742    use config_ocean_skin_m, only: activate_ocean_skin
     43#ifdef ISO
     44    USE infotrac_phy, ONLY: ntiso,niso
     45    USE isotopes_routines_mod, ONLY: calcul_iso_surf_oce_vectall, calcul_iso_surf_sic_vectall   
     46#ifdef ISOVERIF
     47    USE isotopes_mod, ONLY: iso_eau,ridicule
     48    !USE isotopes_verif_mod, ONLY: errmax,errmaxrel,iso_verif_egalite_choix
     49    USE isotopes_verif_mod
     50#endif
     51#endif
    3852
    3953    INCLUDE "YOMCST.h"
    … …  
    5771    real, intent(in):: rhoa(:) ! (knon) density of moist air  (kg / m3)
    5872
     73#ifdef ISO
     74    REAL, DIMENSION(ntiso,klon), INTENT(IN)  :: xtprecip_rain, xtprecip_snow
     75    REAL, DIMENSION(ntiso,klon), INTENT(IN)  :: xtspechum
     76    REAL, DIMENSION(klon),       INTENT(IN)  :: rlat
     77#endif
     78
    5979! In/Output arguments
    6080!****************************************************************************************
    … …  
    6282    REAL, DIMENSION(klon), INTENT(INOUT)     :: snow
    6383    REAL, DIMENSION(klon), INTENT(INOUT)     :: agesno !? put to 0 in ocean
    64  
     84#ifdef ISO     
     85    REAL, DIMENSION(niso,klon), INTENT(IN)   :: xtsnow
     86    REAL, DIMENSION(niso,klon), INTENT(INOUT):: Roce
     87#endif
     88
    6589! Output arguments
    6690!****************************************************************************************
    … …  
    7296    REAL, intent(out):: sens_prec_liq(:) ! (knon)
    7397
     98#ifdef ISO     
     99    REAL, DIMENSION(ntiso,klon), INTENT(OUT) :: xtevap ! isotopes in evaporation flux
     100    REAL, DIMENSION(klon),       INTENT(OUT) :: h1 ! just a diagnostic, not useful for the simulation
     101#endif
     102
    74103! Local variables
    75104!****************************************************************************************
    … …  
    80109    REAL, DIMENSION(klon)       :: u1_lay, v1_lay
    81110    LOGICAL                     :: check=.FALSE.
    82     REAL sens_prec_sol(knon)
    83     REAL, DIMENSION(klon) :: lat_prec_liq, lat_prec_sol   
     111    REAL, DIMENSION(knon)       :: sens_prec_sol
     112    REAL, DIMENSION(klon)       :: lat_prec_liq, lat_prec_sol   
     113#ifdef ISO   
     114    REAL, PARAMETER :: t_coup = 273.15     
     115#endif
     116
    84117
    85118!****************************************************************************************
    … …  
    87120!****************************************************************************************
    88121    IF (check) WRITE(*,*)' Entering ocean_forced_noice'
    89    
     122
     123#ifdef ISO
     124#ifdef ISOVERIF
     125    DO i = 1, knon
     126      IF (iso_eau > 0) THEN         
     127        CALL iso_verif_egalite_choix(xtspechum(iso_eau,i), &
     128     &                  spechum(i),'ocean_forced_mod 111', &
     129     &                  errmax,errmaxrel)     
     130        CALL iso_verif_egalite_choix(snow(i), &
     131     &                  xtsnow(iso_eau,i),'ocean_forced_mod 117', &
     132     &                  errmax,errmaxrel)
     133      ENDIF !IF (iso_eau > 0) THEN
     134    ENDDO !DO i=1,knon
     135#endif     
     136#endif
     137
    90138!****************************************************************************************
    91139! 1)   
    … …  
    103151
    104152    else ! GCM
    105       CALL limit_read_sst(knon,knindex,tsurf_lim)
     153      CALL limit_read_sst(knon,knindex,tsurf_lim &
     154#ifdef ISO
     155     &     ,Roce,rlat &
     156#endif     
     157     &     )
    106158    endif ! knon
    107159!sb--
    … …  
    161213         flux_u1, flux_v1) 
    162214
     215#ifdef ISO     
     216    CALL calcul_iso_surf_oce_vectall(klon, knon,t_coup, &
     217     &    ps,tsurf_new,spechum,u1_lay, v1_lay, xtspechum, &
     218     &    evap, Roce,xtevap,h1 &
     219#ifdef ISOTRAC
     220     &    ,knindex &
     221#endif
     222     &    )
     223#endif         
     224
     225#ifdef ISO
     226#ifdef ISOVERIF
     227!          write(*,*) 'ocean_forced_mod 176: sortie de ocean_forced_noice'
     228    IF (iso_eau > 0) THEN
     229      DO i = 1, knon               
     230        CALL iso_verif_egalite_choix(snow(i), &
     231     &          xtsnow(iso_eau,i),'ocean_forced_mod 180', &
     232     &          errmax,errmaxrel)
     233      ENDDO ! DO j=1,knon
     234    ENDIF !IF (iso_eau > 0) THEN
     235#endif
     236#endif   
     237
    163238  END SUBROUTINE ocean_forced_noice
    164239!
    … …  
    173248       radsol, snow, qsol, agesno, tsoil, &
    174249       qsurf, alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
    175        tsurf_new, dflux_s, dflux_l, rhoa)
     250       tsurf_new, dflux_s, dflux_l, rhoa &
     251#ifdef ISO
     252       ,xtprecip_rain, xtprecip_snow, xtspechum,Roce, &
     253       xtsnow, xtsol,xtevap,Rland_ice & 
     254#endif           
     255       )
    176256!
    177257! This subroutine treats the ocean where there is ice.
    … …  
    187267    USE indice_sol_mod
    188268    USE phys_output_var_mod, ONLY : sens_prec_liq_o, sens_prec_sol_o, lat_prec_liq_o, lat_prec_sol_o
     269#ifdef ISO
     270    USE infotrac_phy, ONLY: niso, ntiso
     271    USE isotopes_routines_mod, ONLY: calcul_iso_surf_oce_vectall, calcul_iso_surf_sic_vectall
     272#ifdef ISOVERIF
     273    USE isotopes_mod, ONLY: iso_eau,ridicule
     274    !USE isotopes_verif_mod, ONLY: errmax,errmaxrel,iso_verif_egalite_choix
     275    USE isotopes_verif_mod
     276#endif
     277#endif
    189278
    190279!   INCLUDE "indicesol.h"
    … …  
    209298    REAL, DIMENSION(klon), INTENT(IN)    :: u1, v1, gustiness
    210299    real, intent(in):: rhoa(:) ! (knon) density of moist air  (kg / m3)
     300#ifdef ISO
     301    REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtprecip_rain, xtprecip_snow
     302    REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtspechum
     303    REAL, DIMENSION(niso,klon),  INTENT(IN) :: Roce
     304    REAL, DIMENSION(niso,klon),  INTENT(IN) :: Rland_ice
     305#endif
    211306
    212307! In/Output arguments
    … …  
    216311    REAL, DIMENSION(klon), INTENT(INOUT)          :: agesno
    217312    REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
     313#ifdef ISO     
     314    REAL, DIMENSION(niso,klon), INTENT(INOUT)     :: xtsnow
     315    REAL, DIMENSION(niso,klon), INTENT(IN)        :: xtsol
     316#endif
    218317
    219318! Output arguments
    … …  
    226325    REAL, DIMENSION(klon), INTENT(OUT)            :: tsurf_new
    227326    REAL, DIMENSION(klon), INTENT(OUT)            :: dflux_s, dflux_l     
     327#ifdef ISO     
     328    REAL, DIMENSION(ntiso,klon), INTENT(OUT)      :: xtevap
     329#endif     
    228330
    229331! Local variables
    … …  
    238340    REAL, DIMENSION(klon)       :: u0, v0
    239341    REAL, DIMENSION(klon)       :: u1_lay, v1_lay
    240     REAL sens_prec_liq(knon), sens_prec_sol (knon)   
     342    REAL, DIMENSION(knon)       :: sens_prec_liq, sens_prec_sol
    241343    REAL, DIMENSION(klon)       :: lat_prec_liq, lat_prec_sol   
    242344
     345#ifdef ISO
     346    REAL, PARAMETER :: t_coup = 273.15
     347    REAL, DIMENSION(klon) :: fq_fonte_diag
     348    REAL, DIMENSION(klon) :: fqfonte_diag
     349    REAL, DIMENSION(klon) :: snow_evap_diag
     350    REAL, DIMENSION(klon) :: fqcalving_diag
     351    REAL, DIMENSION(klon) :: run_off_lic_diag
     352    REAL :: coeff_rel_diag
     353    REAL :: max_eau_sol_diag 
     354    REAL, DIMENSION(klon) :: runoff_diag   
     355    INTEGER IXT
     356    REAL, DIMENSION(niso,klon) :: xtsnow_prec, xtsol_prec
     357    REAL, DIMENSION(klon) :: snow_prec, qsol_prec 
     358#endif
    243359
    244360!****************************************************************************************
    … …  
    307423!
    308424!****************************************************************************************
     425#ifdef ISO
     426   ! verif
     427#ifdef ISOVERIF
     428    DO i = 1, knon
     429      IF (iso_eau > 0) THEN
     430        IF (snow(i) > ridicule) THEN
     431          CALL iso_verif_egalite_choix(xtsnow(iso_eau,i),snow(i), &
     432   &              'interfsurf 964',errmax,errmaxrel)
     433        ENDIF !IF ((snow(i) > ridicule)) THEN
     434      ENDIF !IF (iso_eau > 0) THEN     
     435    ENDDO !DO i=1,knon 
     436#endif
     437   ! end verif
     438
     439    DO i = 1, knon
     440      snow_prec(i) = snow(i)
     441      DO ixt = 1, niso
     442      xtsnow_prec(ixt,i) = xtsnow(ixt,i)
     443      ENDDO !DO ixt=1,niso
     444      ! initialisation:
     445      fq_fonte_diag(i) = 0.0
     446      fqfonte_diag(i)  = 0.0
     447      snow_evap_diag(i)= 0.0
     448    ENDDO !DO i=1,knon
     449#endif
     450
     451
    309452    CALL fonte_neige( knon, is_sic, knindex, dtime, &
    310453         tsurf_tmp, precip_rain, precip_snow, &
    311          snow, qsol, tsurf_new, evap)
     454         snow, qsol, tsurf_new, evap &
     455#ifdef ISO   
     456     &  ,fq_fonte_diag,fqfonte_diag,snow_evap_diag,fqcalving_diag   &
     457     &  ,max_eau_sol_diag,runoff_diag,run_off_lic_diag,coeff_rel_diag   &
     458#endif
     459     &   )
     460
     461
     462#ifdef ISO
     463! isotopes: tout est externalisé
     464!#ifdef ISOVERIF
     465!        write(*,*) 'ocean_forced_mod 377: call calcul_iso_surf_sic_vectall'
     466!        write(*,*) 'klon,knon=',klon,knon
     467!#endif
     468    CALL calcul_iso_surf_sic_vectall(klon,knon, &
     469     &          evap,snow_evap_diag,Tsurf_new,Roce,snow, &
     470     &          fq_fonte_diag,fqfonte_diag,dtime,t_coup, &
     471     &          precip_snow,xtprecip_snow,xtprecip_rain, snow_prec,xtsnow_prec, &
     472     &          xtspechum,spechum,ps, &
     473     &          xtevap,xtsnow,fqcalving_diag, &
     474     &          knindex,is_sic,run_off_lic_diag,coeff_rel_diag,Rland_ice &
     475     &   )
     476#ifdef ISOVERIF
     477        !write(*,*) 'ocean_forced_mod 391: sortie calcul_iso_surf_sic_vectall'
     478    IF (iso_eau > 0) THEN
     479      DO i = 1, knon 
     480        CALL iso_verif_egalite_choix(snow(i), &
     481     &           xtsnow(iso_eau,i),'ocean_forced_mod 396', &
     482     &           errmax,errmaxrel)
     483      ENDDO ! DO j=1,knon
     484    ENDIF !IF (iso_eau > 0) then
     485#endif
     486!#ifdef ISOVERIF
     487#endif   
     488!#ifdef ISO
    312489   
    313490! Calculation of albedo at snow (alb_neig) and update the age of snow (agesno)

  • LMDZ6/branches/cirrus/libf/phylmd/pbl_surface_mod.F90

    r4916 r5202  
    3333                                  wx_pbl_check, wx_pbl_dts_check, wx_evappot
    3434  use config_ocean_skin_m, only: activate_ocean_skin
     35#ifdef ISO
     36  USE infotrac_phy, ONLY: niso,ntraciso=>ntiso   
     37#endif
    3538
    3639  IMPLICIT NONE
    … …  
    4952  !$OMP THREADPRIVATE(ydTs0, ydqs0)
    5053
     54#ifdef ISO
     55  REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE, SAVE   :: xtsnow   ! snow at surface
     56  !$OMP THREADPRIVATE(xtsnow)
     57  REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE   :: Rland_ice   ! snow at surface
     58  !$OMP THREADPRIVATE(Rland_ice) 
     59  REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE   :: Roce   ! snow at surface
     60  !$OMP THREADPRIVATE(Roce) 
     61#endif
     62
    5163  INTEGER, SAVE :: iflag_pbl_surface_t2m_bug
    5264  !$OMP THREADPRIVATE(iflag_pbl_surface_t2m_bug)
    5365  INTEGER, SAVE :: iflag_new_t2mq2m
    5466  !$OMP THREADPRIVATE(iflag_new_t2mq2m)
     67  LOGICAL, SAVE :: ok_bug_zg_wk_pbl
     68  !$OMP THREADPRIVATE(ok_bug_zg_wk_pbl)
    5569
    5670!FC
    … …  
    176190
    177191  END SUBROUTINE pbl_surface_init
     192
     193#ifdef ISO
     194  SUBROUTINE pbl_surface_init_iso(xtsnow_rst,Rland_ice_rst)
     195
     196! This routine should be called after the restart file has been read.
     197! This routine initialize the restart variables and does some validation tests
     198! for the index of the different surfaces and tests the choice of type of ocean.
     199
     200    USE indice_sol_mod
     201    USE print_control_mod, ONLY: lunout
     202#ifdef ISOVERIF
     203    USE isotopes_mod, ONLY: iso_eau,ridicule
     204    USE isotopes_verif_mod
     205#endif
     206    IMPLICIT NONE
     207
     208    INCLUDE "dimsoil.h"
     209 
     210! Input variables
     211!****************************************************************************************
     212    REAL, DIMENSION(niso,klon, nbsrf), INTENT(IN)          :: xtsnow_rst
     213    REAL, DIMENSION(niso,klon), INTENT(IN)          :: Rland_ice_rst
     214 
     215! Local variables
     216!****************************************************************************************
     217    INTEGER                       :: ierr
     218    CHARACTER(len=80)             :: abort_message
     219    CHARACTER(len = 20)           :: modname = 'pbl_surface_init'
     220    integer i,ixt
     221   
     222!****************************************************************************************
     223! Allocate and initialize module variables with fields read from restart file.
     224!
     225!****************************************************************************************   
     226
     227    ALLOCATE(xtsnow(niso,klon,nbsrf), stat=ierr)
     228    IF (ierr /= 0) CALL abort_gcm('pbl_surface_init', 'pb in allocation',1)
     229
     230    ALLOCATE(Rland_ice(niso,klon), stat=ierr)
     231    IF (ierr /= 0) CALL abort_gcm('pbl_surface_init', 'pb in allocation',1)
     232
     233    ALLOCATE(Roce(niso,klon), stat=ierr)
     234    IF (ierr /= 0) CALL abort_gcm('pbl_surface_init', 'pb in allocation',1)
     235
     236    xtsnow(:,:,:)  = xtsnow_rst(:,:,:)
     237    Rland_ice(:,:) = Rland_ice_rst(:,:)
     238    Roce(:,:)      = 0.0
     239
     240#ifdef ISOVERIF
     241      IF (iso_eau >= 0) THEN
     242         CALL iso_verif_egalite_vect2D( &
     243     &           xtsnow,snow, &
     244     &           'pbl_surface_mod 170',niso,klon,nbsrf)
     245         DO i=1,klon 
     246            IF (iso_eau >= 0) THEN 
     247              CALL iso_verif_egalite(Rland_ice(iso_eau,i),1.0, &
     248     &         'pbl_surf_mod 177')
     249            ENDIF
     250         ENDDO
     251      ENDIF
     252#endif
     253
     254  END SUBROUTINE pbl_surface_init_iso
     255#endif
     256
    178257! 
    179258!****************************************************************************************
    … …  
    239318!FC
    240319!!!
    241                         )
     320#ifdef ISO
     321     &   ,xtrain_f, xtsnow_f,xt, &
     322     &   wake_dlxt,zxxtevap,xtevap, &
     323     &   d_xt,d_xt_w,d_xt_x, &
     324     &   xtsol,dflux_xt,zxxtsnow,zxfluxxt,flux_xt, &
     325     &   h1_diag,runoff_diag,xtrunoff_diag &
     326#endif     
     327     &   )
    242328!****************************************************************************************
    243329! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
    … …  
    314400    USE mod_grid_phy_lmdz,  ONLY : nbp_lon, nbp_lat, grid1dto2d_glo
    315401    USE print_control_mod,  ONLY : prt_level,lunout
     402#ifdef ISO
     403  USE isotopes_mod, ONLY: Rdefault,iso_eau
     404#ifdef ISOVERIF
     405        USE isotopes_verif_mod
     406#endif
     407#ifdef ISOTRAC
     408        USE isotrac_mod, only: index_iso
     409#endif
     410#endif
    316411    USE ioipsl_getin_p_mod, ONLY : getin_p
    317412    use phys_state_var_mod, only: ds_ns, dt_ns, delta_sst, delta_sal, dter, &
    … …  
    366461    REAL, DIMENSION(klon),        INTENT(IN)        :: gustiness ! gustiness
    367462
    368     REAL, DIMENSION(klon),        INTENT(IN)        :: cldt    ! total cloud fraction
     463    REAL, DIMENSION(klon),        INTENT(IN)        :: cldt    ! total cloud
     464
     465#ifdef ISO
     466    REAL, DIMENSION(ntraciso,klon,klev),   INTENT(IN)        :: xt       ! water vapour (kg/kg)
     467    REAL, DIMENSION(ntraciso,klon),        INTENT(IN)        :: xtrain_f  ! rain fall
     468    REAL, DIMENSION(ntraciso,klon),        INTENT(IN)        :: xtsnow_f  ! snow fall
     469#endif
    369470
    370471!!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
    … …  
    379480    REAL, DIMENSION(klon),        INTENT(IN)        :: wake_dens
    380481!!!
    381 
     482#ifdef ISO
     483    REAL, DIMENSION(ntraciso,klon,klev),   INTENT(IN)        :: wake_dlxt   
     484#endif
    382485! Input/Output variables
    383486!****************************************************************************************
    … …  
    448551    REAL, INTENT(OUT):: zcoefm(:, :, :) ! (klon, klev, nbsrf + 1)
    449552    ! coef for turbulent diffusion of U and V (?), mean for each grid point
     553#ifdef ISO
     554    REAL, DIMENSION(ntraciso,klon),        INTENT(OUT)       :: zxxtevap     ! water vapour flux at surface, positiv upwards
     555    REAL, DIMENSION(ntraciso,klon, klev),  INTENT(OUT)       :: d_xt        ! change in water vapour
     556    REAL, DIMENSION(klon),                 INTENT(OUT)       :: runoff_diag
     557    REAL, DIMENSION(niso,klon),            INTENT(OUT)       :: xtrunoff_diag
     558    REAL, DIMENSION(ntraciso,klon,klev),   INTENT(OUT)       :: d_xt_w
     559    REAL, DIMENSION(ntraciso,klon,klev),   INTENT(OUT)       :: d_xt_x
     560#endif
     561
     562
    450563
    451564!!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
    … …  
    511624    REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_v     ! v wind tension (kg m/s)/(m**2 s) or Pascal
    512625!FC
    513     REAL, DIMENSION(klon, klev, nbsrf), INTENT(INOUT)  :: treedrg      ! tree drag (m)               
     626    REAL, DIMENSION(klon, klev, nbsrf), INTENT(INOUT) :: treedrg  ! tree drag (m)               
     627#ifdef ISO       
     628    REAL, DIMENSION(niso,klon),   INTENT(OUT)       :: xtsol      ! water height in the soil (mm)
     629    REAL, DIMENSION(ntraciso,klon, nbsrf)           :: xtevap     ! evaporation at surface
     630    REAL, DIMENSION(klon),        INTENT(OUT)       :: h1_diag    ! just diagnostic, not useful
     631#endif
    514632
    515633
    … …  
    525643    REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_qbs   ! blowind snow vertical flux (kg/m**2
    526644
     645#ifdef ISO   
     646    REAL, DIMENSION(ntraciso,klon),              INTENT(OUT) :: dflux_xt    ! change of water vapour flux
     647    REAL, DIMENSION(niso,klon),                  INTENT(OUT) :: zxxtsnow    ! snow at surface, mean for each grid point
     648    REAL, DIMENSION(ntraciso,klon, klev),        INTENT(OUT) :: zxfluxxt    ! water vapour flux, mean for each grid point
     649    REAL, DIMENSION(ntraciso,klon, klev, nbsrf), INTENT(OUT) :: flux_xt     ! water vapour flux(latent flux) (kg/m**2/s) 
     650#endif
    527651
    528652! Martin
    … …  
    573697    REAL, DIMENSION(klon)              :: ysnow, yqsurf, yagesno, yqsol
    574698    REAL, DIMENSION(klon)              :: yrain_f, ysnow_f, ybs_f
     699#ifdef ISO
     700    REAL, DIMENSION(ntraciso,klon)     :: yxt1
     701    REAL, DIMENSION(niso,klon)         :: yxtsnow, yxtsol   
     702    REAL, DIMENSION(ntraciso,klon)     :: yxtrain_f, yxtsnow_f
     703    REAL, DIMENSION(klon)              :: yrunoff_diag
     704    REAL, DIMENSION(niso,klon)         :: yxtrunoff_diag
     705    REAL, DIMENSION(niso,klon)         :: yRland_ice   
     706#endif
    575707    REAL, DIMENSION(klon)              :: ysolsw, ysollw
    576708    REAL, DIMENSION(klon)              :: yfder
    … …  
    581713    REAL, DIMENSION(klon)              :: y_flux_t1, y_flux_q1
    582714    REAL, DIMENSION(klon)              :: y_dflux_t, y_dflux_q
     715#ifdef ISO
     716    REAL, DIMENSION(ntraciso,klon)     ::  y_flux_xt1
     717    REAL, DIMENSION(ntraciso,klon)     ::  y_dflux_xt
     718#endif
    583719    REAL, DIMENSION(klon)              :: y_flux_u1, y_flux_v1
    584720    REAL, DIMENSION(klon)              :: y_flux_bs, y_flux0
    … …  
    608744    REAL, DIMENSION(klon)              :: AcoefH_0, AcoefQ_0, BcoefH_0, BcoefQ_0
    609745    REAL, DIMENSION(klon)              :: AcoefH, AcoefQ, BcoefH, BcoefQ
     746#ifdef ISO
     747    REAL, DIMENSION(ntraciso,klon)     :: AcoefXT, BcoefXT
     748#endif
    610749    REAL, DIMENSION(klon)              :: AcoefU, AcoefV, BcoefU, BcoefV
    611750    REAL, DIMENSION(klon)              :: AcoefQBS, BcoefQBS
    … …  
    626765    REAL, DIMENSION(klon,klev)         :: yu, yv
    627766    REAL, DIMENSION(klon,klev)         :: yt, yq, yqbs
     767#ifdef ISO
     768    REAL, DIMENSION(ntraciso,klon)      :: yxtevap
     769    REAL, DIMENSION(ntraciso,klon,klev) :: y_d_xt
     770    REAL, DIMENSION(ntraciso,klon,klev) :: y_flux_xt
     771    REAL, DIMENSION(ntraciso,klon,klev) :: yxt   
     772#endif
    628773    REAL, DIMENSION(klon,klev)         :: ypplay, ydelp
    629774    REAL, DIMENSION(klon,klev)         :: delp
    … …  
    697842    REAL, DIMENSION(klon,klev)         :: Kcoef_hq_w, Kcoef_m_w, gama_h_w, gama_q_w
    698843    REAL, DIMENSION(klon)              :: alf_1, alf_2, alf_1_x, alf_2_x, alf_1_w, alf_2_w
     844#ifdef ISO
     845    REAL, DIMENSION(ntraciso,klon,klev)         :: yxt_x, yxt_w
     846    REAL, DIMENSION(ntraciso,klon)              :: y_flux_xt1_x , y_flux_xt1_w   
     847    REAL, DIMENSION(ntraciso,klon,klev)         :: y_flux_xt_x,y_d_xt_x,zxfluxxt_x
     848    REAL, DIMENSION(ntraciso,klon,klev)         :: y_flux_xt_w,y_d_xt_w,zxfluxxt_w
     849    REAL, DIMENSION(ntraciso,klon,klev,nbsrf)   :: flux_xt_x, flux_xt_w
     850    REAL, DIMENSION(ntraciso,klon)              :: AcoefXT_x, BcoefXT_x
     851    REAL, DIMENSION(ntraciso,klon)              :: AcoefXT_w, BcoefXT_w
     852    REAL, DIMENSION(ntraciso,klon,klev)         :: CcoefXT, DcoefXT
     853    REAL, DIMENSION(ntraciso,klon,klev)         :: CcoefXT_x, DcoefXT_x
     854    REAL, DIMENSION(ntraciso,klon,klev)         :: CcoefXT_w, DcoefXT_w
     855    REAL, DIMENSION(ntraciso,klon,klev)         :: gama_xt,gama_xt_x,gama_xt_w
     856#endif
    699857!!!
    700858!!!jyg le 08/02/2012
    … …  
    8891047    REAL, DIMENSION(klon)              :: yrmu0
    8901048    ! Martin
    891     REAL, DIMENSIOn(klon)              :: yri0
     1049    REAL, DIMENSION(klon)              :: yri0
    8921050
    8931051    REAL, DIMENSION(klon):: ydelta_sst, ydelta_sal, yds_ns, ydt_ns, ydter, &
    … …  
    8961054    ! dt_ds, tkt, tks, taur, sss on ocean points
    8971055    REAL :: missing_val
     1056#ifdef ISO
     1057    REAL, DIMENSION(klon)       :: h1
     1058    INTEGER                     :: ixt
     1059!#ifdef ISOVERIF
     1060!    integer iso_verif_positif_nostop
     1061!#endif   
     1062#endif
     1063
    8981064!****************************************************************************************
    8991065! End of declarations
    … …  
    9241090      iflag_split = iflag_split_ref
    9251091
     1092#ifdef ISO     
     1093#ifdef ISOVERIF
     1094      DO i=1,klon
     1095        DO ixt=1,niso
     1096          CALL iso_verif_noNaN(xtsol(ixt,i),'pbl_surface 608')
     1097        ENDDO
     1098      ENDDO
     1099#endif
     1100#ifdef ISOVERIF
     1101      DO i=1,klon 
     1102        IF (iso_eau >= 0) THEN 
     1103          CALL iso_verif_egalite_choix(Rland_ice(iso_eau,i),1.0, &
     1104     &         'pbl_surf_mod 585',errmax,errmaxrel)
     1105          CALL iso_verif_egalite_choix(xtsnow_f(iso_eau,i),snow_f(i), &
     1106     &         'pbl_surf_mod 594',errmax,errmaxrel)
     1107          IF (iso_verif_egalite_choix_nostop(xtsol(iso_eau,i),qsol(i), &
     1108     &         'pbl_surf_mod 596',errmax,errmaxrel) == 1) THEN
     1109                WRITE(*,*) 'i=',i
     1110                STOP
     1111          ENDIF
     1112          DO nsrf=1,nbsrf
     1113            CALL iso_verif_egalite_choix(xtsnow(iso_eau,i,nsrf),snow(i,nsrf), &
     1114     &         'pbl_surf_mod 598',errmax,errmaxrel)
     1115          ENDDO
     1116        ENDIF !IF (iso_eau >= 0) THEN   
     1117      ENDDO !DO i=1,knon 
     1118      DO k=1,klev
     1119        DO i=1,klon 
     1120          IF (iso_eau >= 0) THEN 
     1121            CALL iso_verif_egalite_choix(xt(iso_eau,i,k),q(i,k), &
     1122     &           'pbl_surf_mod 595',errmax,errmaxrel)
     1123          ENDIF !IF (iso_eau >= 0) THEN 
     1124        ENDDO !DO i=1,knon 
     1125      ENDDO !DO k=1,klev
     1126#endif
     1127#endif
     1128
     1129
    9261130!****************************************************************************************
    9271131! 1) Initialisation and validation tests
    … …  
    9351139       CALL getin_p('iflag_new_t2mq2m',iflag_new_t2mq2m)
    9361140       WRITE(lunout,*) 'pbl_iflag_new_t2mq2m=',iflag_new_t2mq2m
     1141
     1142       ok_bug_zg_wk_pbl=.TRUE.
     1143       CALL getin_p('ok_bug_zg_wk_pbl',ok_bug_zg_wk_pbl)
     1144       WRITE(lunout,*) 'ok_bug_zg_wk_pbl=',ok_bug_zg_wk_pbl
    9371145
    9381146       print*,'PBL SURFACE AVEC GUSTINESS'
    … …  
    9841192      PRINT*,'WARNING : On impose qsol=',qsol0
    9851193      qsol(:)=qsol0
     1194#ifdef ISO
     1195      DO ixt=1,niso
     1196        xtsol(ixt,:)=qsol0*Rdefault(ixt)
     1197      ENDDO
     1198#ifdef ISOTRAC     
     1199      DO ixt=1+niso,ntraciso
     1200        xtsol(ixt,:)=qsol0*Rdefault(index_iso(ixt))
     1201      ENDDO
     1202#endif       
     1203#endif
    9861204    ENDIF
    9871205!****************************************************************************************
    … …  
    10341252 qsnow(:)=0. ; snowhgt(:)=0. ; to_ice(:)=0. ; sissnow(:)=0.
    10351253 runoff(:)=0.
     1254#ifdef ISO
     1255zxxtevap(:,:)=0.
     1256 d_xt(:,:,:)=0.
     1257 d_xt_x(:,:,:)=0.
     1258 d_xt_w(:,:,:)=0.
     1259 flux_xt(:,:,:,:)=0.
     1260! xtsnow(:,:,:)=0.! attention, xtsnow est l'équivalent de snow et non de qsnow
     1261 xtevap(:,:,:)=0.
     1262#endif
    10361263    IF (iflag_pbl<20.or.iflag_pbl>=30) THEN
    10371264       zcoefh(:,:,:) = 0.0
    … …  
    11231350!FC
    11241351
     1352#ifdef ISO
     1353   yxtrain_f = 0.0 ; yxtsnow_f = 0.0
     1354   yxtsnow  = 0.0
     1355   yxt = 0.0
     1356   yxtsol = 0.0
     1357   flux_xt = 0.0
     1358   yRland_ice = 0.0
     1359!   d_xt = 0.0     
     1360   y_dflux_xt = 0.0 
     1361   dflux_xt=0.0
     1362   y_d_xt_x=0.      ; y_d_xt_w=0.       
     1363#endif
     1364
    11251365! >> PC
    11261366!the yfields_out variable is defined in (klon,nbcf_out) even if it is used on
    … …  
    11491389    fluxlat_x(:,:)=0. ;           fluxlat_w(:,:)=0.
    11501390!>jyg
     1391#ifdef ISO
     1392    flux_xt_x(:,:,:,:)=0. ;          flux_xt_w(:,:,:,:)=0.
     1393#endif
    11511394!
    11521395!jyg<
    … …  
    14481691          yfluxbs(j)=0.0
    14491692          y_flux_bs(j) = 0.0
     1693!!!
     1694#ifdef ISO
     1695          DO ixt=1,ntraciso
     1696            yxtrain_f(ixt,j) = xtrain_f(ixt,i)
     1697            yxtsnow_f(ixt,j) = xtsnow_f(ixt,i) 
     1698          ENDDO
     1699          DO ixt=1,niso
     1700            yxtsnow(ixt,j)   = xtsnow(ixt,i,nsrf)
     1701          ENDDO   
     1702          !IF (nsrf == is_lic) THEN
     1703          DO ixt=1,niso
     1704            yRland_ice(ixt,j)= Rland_ice(ixt,i) 
     1705          ENDDO   
     1706          !endif !IF (nsrf == is_lic) THEN
     1707#ifdef ISOVERIF
     1708          IF (iso_eau >= 0) THEN
     1709              call iso_verif_egalite_choix(ysnow_f(j), &
     1710     &          yxtsnow_f(iso_eau,j),'pbl_surf_mod 862', &
     1711     &          errmax,errmaxrel)
     1712              call iso_verif_egalite_choix(ysnow(j), &
     1713     &          yxtsnow(iso_eau,j),'pbl_surf_mod 872', &
     1714     &          errmax,errmaxrel)
     1715          ENDIF
     1716#endif
     1717#ifdef ISOVERIF
     1718         DO ixt=1,ntraciso
     1719           call iso_verif_noNaN(yxtsnow_f(ixt,j),'pbl_surf_mod 921')
     1720         ENDDO
     1721#endif
     1722#endif
    14501723       ENDDO
    14511724! >> PC
    … …  
    14871760             yq(j,k) = q(i,k)
    14881761             yqbs(j,k)=qbs(i,k)
     1762#ifdef ISO
     1763             DO ixt=1,ntraciso   
     1764               yxt(ixt,j,k) = xt(ixt,i,k)
     1765             ENDDO !DO ixt=1,ntraciso
     1766#endif
    14891767          ENDDO
    14901768        ENDDO
    … …  
    15041782             yq_w(j,k) = q(i,k)+(1.-wake_s(i))*wake_dlq(i,k)
    15051783!!!
     1784#ifdef ISO
     1785             DO ixt=1,ntraciso
     1786               yxt_x(ixt,j,k) = xt(ixt,i,k)-wake_s(i)*wake_dlxt(ixt,i,k)
     1787               yxt_w(ixt,j,k) = xt(ixt,i,k)+(1.-wake_s(i))*wake_dlxt(ixt,i,k)
     1788             ENDDO
     1789#endif
    15061790          ENDDO
    15071791        ENDDO
    … …  
    15591843             i = ni(j)
    15601844             yqsol(j) = qsol(i)
     1845#ifdef ISO
     1846             DO ixt=1,niso
     1847               yxtsol(ixt,j) = xtsol(ixt,i)
     1848             ENDDO
     1849#endif
    15611850          ENDDO
    15621851       ENDIF
    … …  
    16641953            ycdragm_w, ycdragh_w, zri1_w, pref_w, rain_f, zxtsol, ypplay(:,1) )
    16651954!
    1666 !!!bug !!        zgeo1(:) = wake_s(:)*zgeo1_w(:) + (1.-wake_s(:))*zgeo1_x(:)
    1667         zgeo1(1:knon) = wake_s(1:knon)*zgeo1_w(1:knon) + (1.-wake_s(1:knon))*zgeo1_x(1:knon)
     1955        IF(ok_bug_zg_wk_pbl) THEN
     1956         zgeo1(1:knon) = wake_s(1:knon)*zgeo1_w(1:knon) + (1.-wake_s(1:knon))*zgeo1_x(1:knon)
     1957        ELSE
     1958         zgeo1(1:knon) = ywake_s(1:knon)*zgeo1_w(1:knon) + (1.-ywake_s(1:knon))*zgeo1_x(1:knon)
     1959        ENDIF
    16681960
    16691961! --- special Dice. JYG+MPL 25112013 puis BOMEX
    … …  
    17041996
    17051997        IF (iflag_pbl>=50) THEN
    1706         CALL call_atke(dtime,knon,klev,ycdragm(1:knon), ycdragh(1:knon),yus0(1:knon),yvs0(1:knon),yts(1:knon), &
     1998        CALL call_atke(dtime,knon,klev,nsrf,ni,ycdragm(1:knon), ycdragh(1:knon),yus0(1:knon),yvs0(1:knon),yts(1:knon), &
    17071999                  yu(1:knon,:),yv(1:knon,:),yt(1:knon,:),yq(1:knon,:),ypplay(1:knon,:),ypaprs(1:knon,:),       &
    17082000                  ytke(1:knon,:),yeps(1:knon,:), ycoefm(1:knon,:), ycoefh(1:knon,:))
    … …  
    17492041        IF (iflag_pbl>=50) THEN
    17502042     
    1751         CALL call_atke(dtime,knon,klev,ycdragm_x(1:knon),ycdragh_x(1:knon),yus0(1:knon),yvs0(1:knon),yts_x(1:knon),    &
     2043        CALL call_atke(dtime,knon,klev,nsrf,ni,ycdragm_x(1:knon),ycdragh_x(1:knon),yus0(1:knon),yvs0(1:knon),yts_x(1:knon),    &
    17522044                       yu_x(1:knon,:),yv_x(1:knon,:),yt_x(1:knon,:),yq_x(1:knon,:),ypplay(1:knon,:),ypaprs(1:knon,:),  &
    17532045                       ytke_x(1:knon,:),yeps_x(1:knon,:),ycoefm_x(1:knon,:), ycoefh_x(1:knon,:))
    … …  
    17892081        IF (iflag_pbl>=50) THEN
    17902082       
    1791         CALL call_atke(dtime,knon,klev,ycdragm_w(1:knon),ycdragh_w(1:knon),yus0(1:knon),yvs0(1:knon),yts_w(1:knon), &
     2083        CALL call_atke(dtime,knon,klev,nsrf,ni,ycdragm_w(1:knon),ycdragh_w(1:knon),yus0(1:knon),yvs0(1:knon),yts_w(1:knon), &
    17922084                yu_w(1:knon,:),yv_w(1:knon,:),yt_w(1:knon,:),yq_w(1:knon,:),ypplay(1:knon,:),ypaprs(1:knon,:),      &
    17932085                ytke_w(1:knon,:),yeps_w(1:knon,:),ycoefm_w(1:knon,:),ycoefh_w(1:knon,:))
    … …  
    18502142            Kcoef_hq, gama_q, gama_h, &
    18512143!!!
    1852             AcoefH, AcoefQ, BcoefH, BcoefQ)
     2144            AcoefH, AcoefQ, BcoefH, BcoefQ &
     2145#ifdef ISO
     2146         &   ,yxt, CcoefXT, DcoefXT, gama_xt, AcoefXT, BcoefXT &
     2147#endif               
     2148         &   )
    18532149       ELSE  !(iflag_split .eq.0)
    18542150        CALL climb_hq_down(knon, ycoefh_x, ypaprs, ypplay, &
    … …  
    18582154            Kcoef_hq_x, gama_q_x, gama_h_x, &
    18592155!!!
    1860             AcoefH_x, AcoefQ_x, BcoefH_x, BcoefQ_x)
     2156            AcoefH_x, AcoefQ_x, BcoefH_x, BcoefQ_x &
     2157#ifdef ISO
     2158         &   ,yxt_x, CcoefXT_x, DcoefXT_x, gama_xt_x, AcoefXT_x, BcoefXT_x &
     2159#endif               
     2160         &   )
    18612161!!!
    18622162       IF (prt_level >=10) THEN
    … …  
    18732173            Kcoef_hq_w, gama_q_w, gama_h_w, &
    18742174!!!
    1875             AcoefH_w, AcoefQ_w, BcoefH_w, BcoefQ_w)
     2175            AcoefH_w, AcoefQ_w, BcoefH_w, BcoefQ_w &
     2176#ifdef ISO
     2177         &   ,yxt_w, CcoefXT_w, DcoefXT_w, gama_xt_w, AcoefXT_w, BcoefXT_w &
     2178#endif               
     2179         &   )
    18762180!!!
    18772181       IF (prt_level >=10) THEN
    … …  
    19552259         yt1(:) = yt(:,1)
    19562260         yq1(:) = yq(:,1)
     2261#ifdef ISO
     2262         yxt1(:,:) = yxt(:,:,1)
     2263#endif
     2264
    19572265       ELSE IF (iflag_split .ge. 1) THEN
     2266#ifdef ISO
     2267        call abort_gcm('pbl_surface_mod 2149','isos pas encore dans iflag_split=1',1)
     2268#endif
     2269
    19582270!
    19592271! Cdragq computation
    … …  
    21172429               yqsurf, ytsurf_new, y_dflux_t, y_dflux_q, &
    21182430               y_flux_u1, y_flux_v1, &
    2119                yveget,ylai,yheight )
     2431               yveget,ylai,yheight   &
     2432#ifdef ISO
     2433         &      ,yxtrain_f, yxtsnow_f,yxt1, &
     2434         &      yxtsnow,yxtsol,yxtevap,h1, &
     2435         &      yrunoff_diag,yxtrunoff_diag,yRland_ice &
     2436#endif               
     2437         &      )
    21202438 
    21212439!FC quid qd yveget ylai yheight ne sont pas definit
    … …  
    21472465          ENDDO
    21482466      ENDIF
    2149      
     2467
     2468#ifdef ISOVERIF
     2469        DO j=1,knon
     2470          DO ixt=1,ntraciso
     2471            CALL iso_verif_noNaN(yxtevap(ixt,j), &
     2472         &      'pbl_surface 1056a: apres surf_land')
     2473          ENDDO
     2474          DO ixt=1,niso
     2475            CALL iso_verif_noNaN(yxtsol(ixt,j), &
     2476         &      'pbl_surface 1056b: apres surf_land')
     2477          ENDDO
     2478        ENDDO
     2479#endif
     2480#ifdef ISOVERIF
     2481!        write(*,*) 'pbl_surface_mod 1038: sortie surf_land'
     2482        DO j=1,knon
     2483          IF (iso_eau >= 0) THEN     
     2484                 CALL iso_verif_egalite(yxtsnow(iso_eau,j), &
     2485     &                                  ysnow(j),'pbl_surf_mod 1043')
     2486          ENDIF !if (iso_eau.gt.0) then
     2487        ENDDO !DO i=1,klon
     2488#endif
     2489   
    21502490       CASE(is_lic)
    21512491          ! Martin
    … …  
    21682508                  ysnowhgt, yqsnow, ytoice, ysissnow, &
    21692509                  yalb3_new, yrunoff, &
    2170                   y_flux_u1, y_flux_v1)
     2510                  y_flux_u1, y_flux_v1 &
     2511#ifdef ISO
     2512                  &    ,yxtrain_f, yxtsnow_f,yxt1,yRland_ice &
     2513                  &    ,yxtsnow,yxtsol,yxtevap &
     2514#endif             
     2515                  &    )
    21712516             
    21722517             !jyg<
    … …  
    21902535                ENDDO
    21912536             ENDIF
    2192              
     2537
     2538#ifdef ISOVERIF
     2539             DO j=1,knon
     2540               DO ixt=1,ntraciso
     2541                 CALL iso_verif_noNaN(yxtevap(ixt,j), &
     2542                        &             'pbl_surface 1095a: apres surf_landice')
     2543               ENDDO
     2544                do ixt=1,niso
     2545                   call iso_verif_noNaN(yxtsol(ixt,j), &
     2546                        &      'pbl_surface 1095b: apres surf_landice')
     2547                enddo
     2548             enddo
     2549#endif
     2550#ifdef ISOVERIF
     2551             !write(*,*) 'pbl_surface_mod 1060: sortie surf_landice'
     2552             do j=1,knon
     2553               IF (iso_eau >= 0) THEN     
     2554                 CALL iso_verif_egalite(yxtsnow(iso_eau,j), &
     2555                        &               ysnow(j),'pbl_surf_mod 1064')
     2556               ENDIF !if (iso_eau >= 0) THEN
     2557             ENDDO !DO i=1,klon
     2558#endif
     2559           
    21932560          END IF
    21942561         
    … …  
    22072574               y_flux_u1, y_flux_v1, ydelta_sst(:knon), ydelta_sal(:knon), &
    22082575               yds_ns(:knon), ydt_ns(:knon), ydter(:knon), ydser(:knon), &
    2209                ydt_ds(:knon), ytkt(:knon), ytks(:knon), ytaur(:knon), ysss)
     2576               ydt_ds(:knon), ytkt(:knon), ytks(:knon), ytaur(:knon), ysss &
     2577#ifdef ISO
     2578         &      ,yxtrain_f, yxtsnow_f,yxt1,Roce, &
     2579         &      yxtsnow,yxtevap,h1 &
     2580#endif               
     2581         &      )
    22102582      IF (prt_level >=10) THEN
    22112583          print *,'arg de surf_ocean: ycdragh ',ycdragh(1:knon)
    … …  
    22482620!albedo SB <<<
    22492621               ytsurf_new, y_dflux_t, y_dflux_q, &
    2250                y_flux_u1, y_flux_v1)
     2622               y_flux_u1, y_flux_v1 &
     2623#ifdef ISO
     2624         &      ,yxtrain_f, yxtsnow_f,yxt1,Roce, &
     2625         &      yxtsnow,yxtsol,yxtevap,Rland_ice &
     2626#endif               
     2627         &      )
    22512628         
    22522629! Special DICE MPL 05082013 puis BOMEX MPL 20150410
    … …  
    22562633          y_flux_v1(j)=ycdragm(j)*(1.+sqrt(yu(j,1)*yu(j,1)+yv(j,1)*yv(j,1)))*yv(j,1)*ypplay(j,1)/RD/yt(j,1)
    22572634          ENDDO
    2258       ENDIF
     2635       ENDIF
     2636
     2637#ifdef ISOVERIF
     2638        DO j=1,knon
     2639          DO ixt=1,ntraciso
     2640            CALL iso_verif_noNaN(yxtevap(ixt,j), &
     2641         &                       'pbl_surface 1165a: apres surf_seaice')
     2642          ENDDO
     2643          DO ixt=1,niso
     2644            CALL iso_verif_noNaN(yxtsol(ixt,j), &
     2645         &      'pbl_surface 1165b: apres surf_seaice')
     2646          ENDDO
     2647        ENDDO
     2648#endif
     2649#ifdef ISOVERIF
     2650        !write(*,*) 'pbl_surface_mod 1077: sortie surf_seaice'
     2651        DO j=1,knon
     2652          IF (iso_eau >= 0) THEN     
     2653                 CALL iso_verif_egalite(yxtsnow(iso_eau,j), &
     2654     &                                  ysnow(j),'pbl_surf_mod 1106')
     2655          ENDIF !IF (iso_eau >= 0) THEN
     2656        ENDDO !DO i=1,klon
     2657#endif
    22592658
    22602659       CASE DEFAULT
    … …  
    23162715            yt1_new=(1./RCPD)*(AcoefH(j)+BcoefH(j)*y_flux_t1(j)*dtime)
    23172716            ytsurf_new(j)=yt1_new-y_flux_t1(j)/(Kech_h(j)*RCPD)
     2717            ! for cases forced in flux and for which forcing in Ts is needed
     2718            ! to prevent the latter to reach unrealistic value (even if not used,
     2719            ! Ts is calculated and hgardfou can appear during the calculation
     2720            ! of surface saturation humidity for example
     2721            if (ok_forc_tsurf) ytsurf_new(j)=tg
    23182722          ENDDO
    23192723
    … …  
    23262730          y_flux_t1(j) =  yfluxsens(j)
    23272731          y_flux_q1(j) = -yevap(j)
     2732#ifdef ISO
     2733          y_flux_xt1(:,:) = -yxtevap(:,:)
     2734#endif
    23282735          ENDDO
    23292736        ENDIF ! (ok_flux_surf)
    … …  
    23412748
    23422749       IF (iflag_split .GE. 1) THEN
     2750#ifdef ISO
     2751        call abort_gcm('pbl_surface_mod 2607','isos pas encore dans iflag_split=1',1)
     2752#endif
     2753!
    23432754!
    23442755         IF (nsrf .ne. is_oce) THEN
    … …  
    25582969            Kcoef_hq, gama_q, gama_h, &
    25592970!!!
    2560             y_flux_q(:,:), y_flux_t(:,:), y_d_q(:,:), y_d_t(:,:))   
     2971            y_flux_q(:,:), y_flux_t(:,:), y_d_q(:,:), y_d_t(:,:) &
     2972#ifdef ISO
     2973        &    ,yxt,y_flux_xt1 &
     2974        &    ,AcoefXT,BcoefXT,CcoefXT,DcoefXT,gama_xt &
     2975        &    ,y_flux_xt(:,:,:),y_d_xt(:,:,:) &
     2976#endif
     2977        &    )   
    25612978       ELSE  !(iflag_split .eq.0)
    25622979        CALL climb_hq_up(knon, dtime, yt_x, yq_x, &
    … …  
    25672984            Kcoef_hq_x, gama_q_x, gama_h_x, &
    25682985!!!
    2569             y_flux_q_x(:,:), y_flux_t_x(:,:), y_d_q_x(:,:), y_d_t_x(:,:))   
     2986            y_flux_q_x(:,:), y_flux_t_x(:,:), y_d_q_x(:,:), y_d_t_x(:,:) &
     2987#ifdef ISO
     2988        &    ,yxt_x,y_flux_xt1_x &
     2989        &    ,AcoefXT_x,BcoefXT_x,CcoefXT_x,DcoefXT_x,gama_xt_x &
     2990        &    ,y_flux_xt_x(:,:,:),y_d_xt_x(:,:,:) &
     2991#endif
     2992        &    )   
    25702993!
    25712994       CALL climb_hq_up(knon, dtime, yt_w, yq_w, &
    … …  
    25762999            Kcoef_hq_w, gama_q_w, gama_h_w, &
    25773000!!!
    2578             y_flux_q_w(:,:), y_flux_t_w(:,:), y_d_q_w(:,:), y_d_t_w(:,:))   
     3001            y_flux_q_w(:,:), y_flux_t_w(:,:), y_d_q_w(:,:), y_d_t_w(:,:) &
     3002#ifdef ISO
     3003        &    ,yxt_w,y_flux_xt1_w &
     3004        &    ,AcoefXT_w,BcoefXT_w,CcoefXT_w,DcoefXT_w,gama_xt_w &
     3005        &    ,y_flux_xt_w(:,:,:),y_d_xt_w(:,:,:) &
     3006#endif
     3007        &    )   
    25793008!!!
    25803009       ENDIF  ! (iflag_split .eq.0)
    … …  
    26943123             flux_u(i,k,nsrf) = y_flux_u(j,k)
    26953124             flux_v(i,k,nsrf) = y_flux_v(j,k)
     3125
     3126#ifdef ISO
     3127             DO ixt=1,ntraciso
     3128                y_d_xt(ixt,j,k)  = y_d_xt(ixt,j,k) * ypct(j)
     3129                flux_xt(ixt,i,k,nsrf) = y_flux_xt(ixt,j,k)
     3130             ENDDO ! DO ixt=1,ntraciso
     3131             h1_diag(i)=h1(j)
     3132#endif
     3133
    26963134           ENDDO
    26973135        ENDDO
     3136
     3137#ifdef ISO
     3138#ifdef ISOVERIF
     3139        if (iso_eau.gt.0) then
     3140         call iso_verif_egalite_vect2D( &
     3141                y_d_xt,y_d_q, &
     3142                'pbl_surface_mod 2600',ntraciso,klon,klev)
     3143        endif       
     3144#endif
     3145#endif
    26983146
    26993147       ELSE  !(iflag_split .eq.0)
    … …  
    27133161            flux_u_x(i,k,nsrf) = y_flux_u_x(j,k)
    27143162            flux_v_x(i,k,nsrf) = y_flux_v_x(j,k)
     3163
     3164#ifdef ISO
     3165            DO ixt=1,ntraciso
     3166              y_d_xt_x(ixt,j,k)  = y_d_xt_x(ixt,j,k) * ypct(j)
     3167              flux_xt_x(ixt,i,k,nsrf) = y_flux_xt_x(ixt,j,k)
     3168            ENDDO ! DO ixt=1,ntraciso
     3169#endif
    27153170          ENDDO
    27163171        ENDDO
    … …  
    27303185            flux_u_w(i,k,nsrf) = y_flux_u_w(j,k)
    27313186            flux_v_w(i,k,nsrf) = y_flux_v_w(j,k)
     3187
     3188#ifdef ISO
     3189            DO ixt=1,ntraciso
     3190              y_d_xt_w(ixt,j,k)  = y_d_xt_w(ixt,j,k) * ypct(j)
     3191              flux_xt_w(ixt,i,k,nsrf) = y_flux_xt_w(ixt,j,k)
     3192            ENDDO ! do ixt=1,ntraciso
     3193#endif
     3194
    27323195          ENDDO
    27333196        ENDDO
    … …  
    27413204            flux_u(i,k,nsrf) = flux_u_x(i,k,nsrf)+ywake_s(j)*(flux_u_w(i,k,nsrf)-flux_u_x(i,k,nsrf))
    27423205            flux_v(i,k,nsrf) = flux_v_x(i,k,nsrf)+ywake_s(j)*(flux_v_w(i,k,nsrf)-flux_v_x(i,k,nsrf))
     3206#ifdef ISO
     3207            DO ixt=1,ntraciso
     3208              flux_xt(ixt,i,k,nsrf) = flux_xt_x(ixt,i,k,nsrf)+ywake_s(j)*(flux_xt_w(ixt,i,k,nsrf)-flux_xt_x(ixt,i,k,nsrf))
     3209            ENDDO ! do ixt=1,ntraciso
     3210#endif
    27433211          ENDDO
    27443212        ENDDO
    … …  
    27983266          dflux_t(i) = dflux_t(i) + y_dflux_t(j)*ypct(j)
    27993267          dflux_q(i) = dflux_q(i) + y_dflux_q(j)*ypct(j)
     3268#ifdef ISO
     3269        DO ixt=1,niso
     3270          xtsnow(ixt,i,nsrf) = yxtsnow(ixt,j) 
     3271        ENDDO
     3272        DO ixt=1,ntraciso
     3273          xtevap(ixt,i,nsrf) = - flux_xt(ixt,i,1,nsrf)
     3274          dflux_xt(ixt,i) = dflux_xt(ixt,i) + y_dflux_xt(ixt,j)*ypct(j)
     3275        ENDDO 
     3276        IF (nsrf == is_lic) THEN
     3277          DO ixt=1,niso
     3278            Rland_ice(ixt,i) = yRland_ice(ixt,j) 
     3279          ENDDO
     3280        ENDIF !IF (nsrf == is_lic) THEN     
     3281#ifdef ISOVERIF
     3282        IF (iso_eau.gt.0) THEN 
     3283          call iso_verif_egalite_choix(Rland_ice(iso_eau,i),1.0, &
     3284     &         'pbl_surf_mod 1230',errmax,errmaxrel)
     3285        ENDIF !if (iso_eau.gt.0) then
     3286#endif       
     3287#endif
    28003288       ENDDO
    28013289
    … …  
    29023390             i = ni(j)
    29033391             qsol(i) = yqsol(j)
     3392#ifdef ISO
     3393             runoff_diag(i)=yrunoff_diag(j)   
     3394             DO ixt=1,niso
     3395               xtsol(ixt,i) = yxtsol(ixt,j)
     3396               xtrunoff_diag(ixt,i)=yxtrunoff_diag(ixt,j)
     3397             ENDDO
     3398#endif
    29043399          ENDDO
    29053400       ENDIF
    … …  
    29143409          ENDDO
    29153410       ENDDO
    2916        
     3411
     3412#ifdef ISO
     3413#ifdef ISOVERIF
     3414       !write(*,*) 'pbl_surface 2858'
     3415       DO i = 1, klon
     3416         DO ixt=1,niso
     3417           call iso_verif_noNaN(xtsol(ixt,i),'pbl_surface 1405')
     3418         ENDDO
     3419       ENDDO
     3420#endif
     3421#ifdef ISOVERIF
     3422     IF (iso_eau.gt.0) THEN
     3423        call iso_verif_egalite_vect2D( &
     3424                y_d_xt,y_d_q, &
     3425                'pbl_surface_mod 1261',ntraciso,klon,klev)
     3426     ENDIF !if (iso_eau.gt.0) then
     3427#endif
     3428#endif
    29173429!!! jyg le 07/02/2012
    29183430       IF (iflag_split .ge.1) THEN
    … …  
    29333445           d_u_w(i,k) = d_u_w(i,k) + y_d_u_w(j,k)
    29343446           d_v_w(i,k) = d_v_w(i,k) + y_d_v_w(j,k)
     3447#ifdef ISO
     3448           DO ixt=1,ntraciso
     3449             d_xt_x(ixt,i,k) = d_xt_x(ixt,i,k) + y_d_xt_x(ixt,j,k)
     3450             d_xt_w(ixt,i,k) = d_xt_w(ixt,i,k) + y_d_xt_w(ixt,j,k)
     3451           ENDDO ! DO ixt=1,ntraciso
     3452#endif
     3453
    29353454!
    29363455!!           d_wake_dlt(i,k) = d_wake_dlt(i,k) + y_d_t_w(i,k)-y_d_t_x(i,k)
    … …  
    29483467             d_t(i,k) = d_t(i,k) + y_d_t(j,k)
    29493468             d_q(i,k) = d_q(i,k) + y_d_q(j,k)
     3469#ifdef ISO
     3470             DO ixt=1,ntraciso
     3471               d_xt(ixt,i,k) = d_xt(ixt,i,k) + y_d_xt(ixt,j,k)
     3472             ENDDO !DO ixt=1,ntraciso
     3473#endif
    29503474             d_u(i,k) = d_u(i,k) + y_d_u(j,k)
    29513475             d_v(i,k) = d_v(i,k) + y_d_v(j,k)
    … …  
    29623486         ENDDO
    29633487        ENDIF
     3488
     3489#ifdef ISO
     3490#ifdef ISOVERIF
     3491!        write(*,*) 'd_q,d_xt(iso_eau,554,19)=',d_q(554,19),d_xt(iso_eau,554,19)
     3492!        write(*,*) 'pbl_surface 2929: d_q,d_xt(iso_eau,2,1)=',d_q(2,1),d_xt(iso_eau,2,1)
     3493!        write(*,*) 'y_d_q,y_d_xt(iso_eau,2,1)=',y_d_q(2,1),y_d_xt(iso_eau,2,1)
     3494!        write(*,*) 'iso_eau.gt.0=',iso_eau.gt.0
     3495        call iso_verif_noNaN_vect2D( &
     3496     &           d_xt, &
     3497     &           'pbl_surface 1385',ntraciso,klon,klev) 
     3498     IF (iso_eau >= 0) THEN
     3499        call iso_verif_egalite_vect2D( &
     3500                y_d_xt,y_d_q, &
     3501                'pbl_surface_mod 2945',ntraciso,klon,klev)
     3502        call iso_verif_egalite_vect2D( &
     3503                d_xt,d_q, &
     3504                'pbl_surface_mod 1276',ntraciso,klon,klev)
     3505     ENDIF !IF (iso_eau >= 0) THEN
     3506#endif
     3507#endif
    29643508
    29653509!      print*,'Dans pbl OK4'
    … …  
    33493893   iflag_split=iflag_split_ref
    33503894
     3895#ifdef ISO
     3896#ifdef ISOVERIF
     3897!        write(*,*) 'pbl_surface tmp 3249: d_q,d_xt(iso_eau,2,1)=',d_q(2,1),d_xt(iso_eau,2,1)
     3898    IF (iso_eau >= 0) THEN
     3899        call iso_verif_egalite_vect2D( &
     3900                d_xt,d_q, &
     3901                'pbl_surface_mod 1276',ntraciso,klon,klev)
     3902    ENDIF !IF (iso_eau >= 0) THEN
     3903#endif
     3904#endif
     3905
    33513906!****************************************************************************************
    33523907! 16) Calculate the mean value over all sub-surfaces for some variables
    … …  
    33703925    zxfluxt_w(:,:) = 0.0 ; zxfluxq_w(:,:) = 0.0
    33713926    zxfluxu_w(:,:) = 0.0 ; zxfluxv_w(:,:) = 0.0
     3927#ifdef ISO
     3928      zxfluxxt(:,:,:) = 0.0
     3929      zxfluxxt_x(:,:,:) = 0.0
     3930      zxfluxxt_w(:,:,:) = 0.0
     3931#endif
     3932
    33723933
    33733934!!! jyg le 07/02/2012
    … …  
    33883949              zxfluxu_w(i,k) = zxfluxu_w(i,k) + flux_u_w(i,k,nsrf) * pctsrf(i,nsrf)
    33893950              zxfluxv_w(i,k) = zxfluxv_w(i,k) + flux_v_w(i,k,nsrf) * pctsrf(i,nsrf)
     3951#ifdef ISO
     3952              DO ixt=1,ntraciso
     3953                zxfluxxt_x(ixt,i,k) = zxfluxxt_x(ixt,i,k) + flux_xt_x(ixt,i,k,nsrf) * pctsrf(i,nsrf)
     3954                zxfluxxt_w(ixt,i,k) = zxfluxxt_w(ixt,i,k) + flux_xt_w(ixt,i,k,nsrf) * pctsrf(i,nsrf)
     3955              ENDDO ! DO ixt=1,ntraciso
     3956#endif
    33903957            ENDDO
    33913958          ENDDO
    … …  
    34073974             zxfluxu(i,k) = zxfluxu(i,k) + flux_u(i,k,nsrf) * pctsrf(i,nsrf)
    34083975             zxfluxv(i,k) = zxfluxv(i,k) + flux_v(i,k,nsrf) * pctsrf(i,nsrf)
     3976#ifdef ISO
     3977             DO ixt=1,niso
     3978               zxfluxxt(ixt,i,k) = zxfluxxt(ixt,i,k) + flux_xt(ixt,i,k,nsrf) * pctsrf(i,nsrf)
     3979             ENDDO ! DO ixt=1,niso
     3980#endif
    34093981          ENDDO
    34103982       ENDDO
    … …  
    34314003       END DO
    34324004    endif
     4005
     4006#ifdef ISO
     4007    DO i = 1, klon
     4008      DO ixt=1,ntraciso
     4009        zxxtevap(ixt,i)     = - zxfluxxt(ixt,i,1)
     4010      ENDDO
     4011    ENDDO
     4012#endif
    34334013
    34344014!!!
    … …  
    36064186    zxqsurf(:) = 0.0
    36074187    zxsnow(:)  = 0.0
     4188#ifdef ISO
     4189    zxxtsnow(:,:)  = 0.0
     4190#endif
     4191
    36084192    DO nsrf = 1, nbsrf
    36094193       DO i = 1, klon
    36104194          zxqsurf(i) = zxqsurf(i) + MAX(qsurf(i,nsrf),0.0) * pctsrf(i,nsrf)
    36114195          zxsnow(i)  = zxsnow(i)  + snow(i,nsrf)  * pctsrf(i,nsrf)
     4196#ifdef ISO
     4197          DO ixt=1,niso
     4198            zxxtsnow(ixt,i)  = zxxtsnow(ixt,i)  + xtsnow(ixt,i,nsrf)  * pctsrf(i,nsrf)
     4199          ENDDO ! DO ixt=1,niso
     4200#endif
    36124201       ENDDO
    36134202    ENDDO
    … …  
    36214210!****************************************************************************************
    36224211!
    3623   SUBROUTINE pbl_surface_final(fder_rst, snow_rst, qsurf_rst, ftsoil_rst)
     4212  SUBROUTINE pbl_surface_final(fder_rst, snow_rst, qsurf_rst, ftsoil_rst &
     4213#ifdef ISO
     4214       ,xtsnow_rst,Rland_ice_rst &
     4215#endif       
     4216       )
    36244217
    36254218    USE indice_sol_mod
     4219#ifdef ISO
     4220#ifdef ISOVERIF
     4221    USE isotopes_mod, ONLY: iso_eau,ridicule
     4222    USE isotopes_verif_mod, ONLY: errmax,errmaxrel
     4223#endif   
     4224#endif
    36264225
    36274226    INCLUDE "dimsoil.h"
    … …  
    36334232    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)          :: qsurf_rst
    36344233    REAL, DIMENSION(klon, nsoilmx, nbsrf), INTENT(OUT) :: ftsoil_rst
     4234#ifdef ISO
     4235    REAL, DIMENSION(niso,klon, nbsrf), INTENT(OUT)     :: xtsnow_rst
     4236    REAL, DIMENSION(niso,klon), INTENT(OUT)            :: Rland_ice_rst
     4237#endif
    36354238
    36364239 
    … …  
    36434246    qsurf_rst(:,:)    = qsurf(:,:)
    36444247    ftsoil_rst(:,:,:) = ftsoil(:,:,:)
     4248#ifdef ISO
     4249    xtsnow_rst(:,:,:)  = xtsnow(:,:,:)
     4250    Rland_ice_rst(:,:) = Rland_ice(:,:)
     4251#endif
    36454252
    36464253!****************************************************************************************
    … …  
    36554262    IF (ALLOCATED(ydTs0)) DEALLOCATE(ydTs0)
    36564263    IF (ALLOCATED(ydqs0)) DEALLOCATE(ydqs0)
     4264#ifdef ISO
     4265    IF (ALLOCATED(xtsnow)) DEALLOCATE(xtsnow)
     4266    IF (ALLOCATED(Rland_ice)) DEALLOCATE(Rland_ice)
     4267    IF (ALLOCATED(Roce)) DEALLOCATE(Roce)
     4268#endif
    36574269
    36584270!jyg<
    … …  
    36734285  SUBROUTINE pbl_surface_newfrac(itime, pctsrf_new, pctsrf_old, &
    36744286       evap, z0m, z0h, agesno,                                  &
    3675        tsurf,alb_dir,alb_dif, ustar, u10m, v10m, tke) 
     4287       tsurf,alb_dir,alb_dif, ustar, u10m, v10m, tke &
     4288#ifdef ISO
     4289      ,xtevap  &
     4290#endif
     4291&      ) 
    36764292    !albedo SB <<<
    36774293    ! Give default values where new fraction has appread
    … …  
    37024318    REAL, DIMENSION(klon,nbsrf+1), INTENT(INOUT)        :: z0m,z0h
    37034319    REAL, DIMENSION(klon,klev+1,nbsrf+1), INTENT(INOUT) :: tke
     4320#ifdef ISO
     4321    REAL, DIMENSION(ntraciso,klon,nbsrf), INTENT(INOUT)        :: xtevap
     4322#endif
    37044323
    37054324! Local variables
    … …  
    37094328    CHARACTER(len=20) :: modname = 'pbl_surface_newfrac'
    37104329    INTEGER, DIMENSION(nbsrf) :: nfois=0, mfois=0, pfois=0
     4330#ifdef ISO
     4331    INTEGER           :: ixt
     4332#endif
    37114333!
    37124334! All at once !!
    … …  
    37544376                u10m(i,nsrf)  = u10m(i,nsrf_comp1)
    37554377                v10m(i,nsrf)  = v10m(i,nsrf_comp1)
     4378#ifdef ISO
     4379                DO ixt=1,ntraciso
     4380                  xtevap(ixt,i,nsrf) = xtevap(ixt,i,nsrf_comp1)       
     4381                ENDDO       
     4382#endif
    37564383                IF (iflag_pbl > 1) THEN
    37574384                 tke(i,:,nsrf) = tke(i,:,nsrf_comp1)
    … …  
    38094436                u10m(i,nsrf)  = u10m(i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) + u10m(i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3)
    38104437                v10m(i,nsrf)  = v10m(i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) + v10m(i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3)
     4438#ifdef ISO
     4439                DO ixt=1,ntraciso
     4440                  xtevap(ixt,i,nsrf) = xtevap(ixt,i,nsrf_comp2) *pctsrf_old(i,nsrf_comp2) &
     4441                                     + xtevap(ixt,i,nsrf_comp3) *pctsrf_old(i,nsrf_comp3)
     4442                ENDDO       
     4443#endif
    38114444                IF (iflag_pbl > 1) THEN
    38124445                 tke(i,:,nsrf) = tke(i,:,nsrf_comp2)*pctsrf_old(i,nsrf_comp2) + tke(i,:,nsrf_comp3)*pctsrf_old(i,nsrf_comp3)
    … …  
    38214454             agesno(i,nsrf)   = 0.
    38224455             ftsoil(i,:,nsrf) = tsurf(i,nsrf)
     4456#ifdef ISO           
     4457             xtsnow(:,i,nsrf) = 0.
     4458#endif
    38234459          ELSE
    38244460             pfois(nsrf) = pfois(nsrf)+ 1

  • LMDZ6/branches/cirrus/libf/phylmd/phys_local_var_mod.F90

    r4951 r5202  
    1414      REAL, SAVE, ALLOCATABLE :: ql_seri(:,:),qs_seri(:,:)
    1515      !$OMP THREADPRIVATE(ql_seri,qs_seri)
     16! SN 15/07/2024 ISO 4D
     17      REAL, SAVE, ALLOCATABLE :: qx_seri(:,:,:)
     18      !$OMP THREADPRIVATE(qx_seri)
     19! SN
    1620      REAL, SAVE, ALLOCATABLE :: qbs_seri(:,:)
    1721      !$OMP THREADPRIVATE(qbs_seri)
    … …  
    2428      REAL, SAVE, ALLOCATABLE :: pbl_eps(:,:,:)
    2529      !$OMP THREADPRIVATE(pbl_eps)
     30      REAL, SAVE, ALLOCATABLE :: tke_shear(:,:,:), tke_buoy(:,:,:), tke_trans(:,:,:)
     31      !$OMP THREADPRIVATE(tke_shear,tke_buoy,tke_trans)
    2632      REAL, SAVE, ALLOCATABLE :: tr_seri(:,:,:)
    2733      !$OMP THREADPRIVATE(tr_seri)
    … …  
    6470      REAL, SAVE, ALLOCATABLE :: d_t_eva(:,:),d_q_eva(:,:),d_ql_eva(:,:),d_qi_eva(:,:)
    6571      !$OMP THREADPRIVATE(d_t_eva,d_q_eva,d_ql_eva,d_qi_eva)
     72! SN 15/07/2024 ISO 4D
     73      REAL, SAVE, ALLOCATABLE :: d_qx_eva(:,:,:)
     74      !$OMP THREADPRIVATE(d_qx_eva)
     75! SN
    6676      REAL, SAVE, ALLOCATABLE :: d_t_lscst(:,:),d_q_lscst(:,:)
    6777      !$OMP THREADPRIVATE(d_t_lscst,d_q_lscst)
    … …  
    8494      REAL, SAVE, ALLOCATABLE :: d_t_vdf_x(:,:), d_q_vdf_x(:,:)
    8595      !$OMP THREADPRIVATE( d_t_vdf_x, d_q_vdf_x)
    86       REAL, SAVE, ALLOCATABLE :: d_t_bs(:,:), d_q_bs(:,:), d_qbs_bs(:,:)
    87       !$OMP THREADPRIVATE( d_t_bs,d_q_bs, d_qbs_bs)
     96      REAL, SAVE, ALLOCATABLE :: d_t_bsss(:,:), d_q_bsss(:,:), d_qbs_bsss(:,:)
     97      !$OMP THREADPRIVATE( d_t_bsss,d_q_bsss, d_qbs_bsss)
    8898!>nrlmd+jyg
    8999      REAL, SAVE, ALLOCATABLE :: d_t_oro(:,:)
    … …  
    117127      REAL, SAVE, ALLOCATABLE :: d_q_ch4(:,:)
    118128      !$OMP THREADPRIVATE(d_q_ch4)
     129#ifdef ISO
     130      REAL, SAVE, ALLOCATABLE :: xt_seri(:,:,:)
     131      !$OMP THREADPRIVATE( xt_seri)
     132      REAL, SAVE, ALLOCATABLE :: xtl_seri(:,:,:)
     133      !$OMP THREADPRIVATE( xtl_seri)
     134      REAL, SAVE, ALLOCATABLE :: xts_seri(:,:,:)
     135      !$OMP THREADPRIVATE( xts_seri)
     136      REAL, SAVE, ALLOCATABLE :: xtbs_seri(:,:,:)
     137      !$OMP THREADPRIVATE( xtbs_seri)
     138      REAL, SAVE, ALLOCATABLE :: d_xt_eva(:,:,:)
     139      !$OMP THREADPRIVATE( d_xt_eva)
     140      REAL, SAVE, ALLOCATABLE :: d_xtl_eva(:,:,:)
     141      !$OMP THREADPRIVATE( d_xtl_eva)
     142      REAL, SAVE, ALLOCATABLE :: d_xti_eva(:,:,:)
     143      !$OMP THREADPRIVATE( d_xti_eva)
     144      REAL, SAVE, ALLOCATABLE :: d_xt_vdf(:,:,:)
     145      !$OMP THREADPRIVATE( d_xt_vdf)
     146      REAL, SAVE, ALLOCATABLE :: d_xt_dyn(:,:,:)
     147      !$OMP THREADPRIVATE( d_xt_dyn)
     148      REAL, SAVE, ALLOCATABLE :: d_xtl_dyn(:,:,:), d_xts_dyn(:,:,:), d_xtbs_dyn(:,:,:)
     149      !$OMP THREADPRIVATE(d_xtl_dyn, d_xts_dyn, d_xtbs_dyn)
     150      REAL, SAVE, ALLOCATABLE :: d_xt_con(:,:,:)
     151      !$OMP THREADPRIVATE( d_xt_con)
     152      REAL, SAVE, ALLOCATABLE :: d_xt_wake(:,:,:)
     153      !$OMP THREADPRIVATE( d_xt_wake)
     154      REAL, SAVE, ALLOCATABLE :: d_xt_lsc(:,:,:),d_xtl_lsc(:,:,:),d_xti_lsc(:,:,:)
     155      !$OMP THREADPRIVATE( d_xt_lsc,d_xtl_lsc,d_xti_lsc)
     156      REAL, SAVE, ALLOCATABLE :: d_xt_ajsb(:,:,:)
     157      !$OMP THREADPRIVATE( d_xt_ajsb)
     158      REAL, SAVE, ALLOCATABLE :: d_xt_ajs(:,:,:)
     159      !$OMP THREADPRIVATE( d_xt_ajs)
     160      REAL, SAVE, ALLOCATABLE :: d_xt_ajs_w(:,:,:), d_xt_ajs_x(:,:,:)
     161      !$OMP THREADPRIVATE(d_xt_ajs_w, d_xt_ajs_x)
     162      REAL, SAVE, ALLOCATABLE :: d_xt_vdf_w(:,:,:), d_xt_vdf_x(:,:,:)
     163      !$OMP THREADPRIVATE(d_xt_vdf_w, d_xt_vdf_x)
     164      REAL, SAVE, ALLOCATABLE :: d_xt_ch4(:,:,:)
     165      !$OMP THREADPRIVATE( d_xt_ch4)
     166      REAL, SAVE, ALLOCATABLE :: d_xt_prod_nucl(:,:,:)
     167      !$OMP THREADPRIVATE( d_xt_prod_nucl)
     168      REAL, SAVE, ALLOCATABLE :: d_xt_cosmo(:,:,:)
     169      !$OMP THREADPRIVATE( d_xt_cosmo)
     170      REAL, SAVE, ALLOCATABLE :: d_xt_decroiss(:,:,:)
     171      !$OMP THREADPRIVATE( d_xt_decroiss)
     172#endif
    119173
    120174! tendance du a la conersion Ec -> E thermique
    … …  
    124178      !$OMP THREADPRIVATE(d_ts, d_tr)
    125179
    126 ! aerosols
    127       REAL, SAVE, ALLOCATABLE :: m_allaer (:,:,:)
    128       !$OMP THREADPRIVATE(m_allaer)
    129180! diagnostique pour le rayonnement
    130181      REAL, SAVE, ALLOCATABLE :: topswad_aero(:),  solswad_aero(:)      ! diag
    … …  
    307358!!!OMP THREADPRIVATE(d_s_the, d_dens_the)
    308359      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:)           :: d_deltat_ajs_cv, d_deltaq_ajs_cv
    309 !$OMP THREADPRIVATE(d_deltat_ajs_cv, d_deltaq_ajs_cv)                       
     360!$OMP THREADPRIVATE(d_deltat_ajs_cv, d_deltaq_ajs_cv)
     361#ifdef ISO
     362    REAL, SAVE, ALLOCATABLE,DIMENSION(:,:,:)          :: d_deltaxt_wk
     363!$OMP THREADPRIVATE(d_deltaxt_wk)
     364    REAL, SAVE, ALLOCATABLE,DIMENSION(:,:,:)          :: d_deltaxt_wk_gw
     365!$OMP THREADPRIVATE(d_deltaxt_wk_gw)
     366    REAL, SAVE, ALLOCATABLE,DIMENSION(:,:,:)          ::  d_deltaxt_the
     367!$OMP THREADPRIVATE(d_deltaxt_the)
     368    REAL, SAVE, ALLOCATABLE,DIMENSION(:,:,:)          ::  d_deltaxt_vdf
     369!$OMP THREADPRIVATE(d_deltaxt_vdf)
     370      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:)           ::  d_deltaxt_ajs_cv
     371!$OMP THREADPRIVATE(d_deltaxt_ajs_cv)
     372#endif                       
    310373!!         End of Wake variables
    311374!!
    … …  
    343406      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zxfluxlat, zxtsol, snow_lsc, zxfqfonte
    344407!$OMP THREADPRIVATE(zxfluxlat, zxtsol, snow_lsc, zxfqfonte)
    345       REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zxrunofflic
    346 !$OMP THREADPRIVATE(zxrunofflic)
     408!SN runoffdiag
     409      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zxrunofflic, runoff_diag
     410!$OMP THREADPRIVATE(zxrunofflic, runoff_diag)
    347411      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zxqsurf, rain_lsc, rain_num
    348412!$OMP THREADPRIVATE(zxqsurf, rain_lsc, rain_num)
     413#ifdef ISO
     414      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: xtevap,xtprw
     415!$OMP THREADPRIVATE(xtevap,xtprw)
     416      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: h1_diag
     417      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: xtrunoff_diag
     418!$OMP THREADPRIVATE(h1_diagv,xtrunoff_diag)
     419      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: zxfxtcalving
     420!$OMP THREADPRIVATE(zxfxtcalving)
     421      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: xtsnow_lsc, zxfxtfonte
     422!$OMP THREADPRIVATE(xtsnow_lsc, zxfxtfonte)
     423      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: zxxtrunofflic
     424!$OMP THREADPRIVATE(zxxtrunofflic)
     425      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: xtrain_lsc
     426!$OMP THREADPRIVATE(xtrain_lsc)
     427#endif
    349428!
    350429!jyg+nrlmd<
    … …  
    384463      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: kh, kh_x, kh_w
    385464!$OMP THREADPRIVATE(kh, kh_x, kh_w)
     465#ifdef ISO
     466      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: dxtvdf_x, dxtvdf_w
     467!$OMP THREADPRIVATE(dxtvdf_x, dxtvdf_w)
     468      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: xt_therm
     469!$OMP THREADPRIVATE(xt_therm)
     470#endif
    386471!!!
    387472!!!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
    … …  
    446531      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:):: sij
    447532!$OMP THREADPRIVATE(sij)
     533#ifdef ISO
     534      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: xtwdtrainA
     535!$OMP THREADPRIVATE(xtwdtrainA)
     536      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: xtev
     537!$OMP THREADPRIVATE(xtev)
     538      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: xttaa
     539!$OMP THREADPRIVATE(xttaa)
     540      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: xtclw
     541!$OMP THREADPRIVATE(xtclw)
     542#ifdef DIAGISO
     543      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:)  :: qlp
     544!$OMP THREADPRIVATE(qlp)
     545      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:)  :: qvp
     546!$OMP THREADPRIVATE(qvp)
     547      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:)  :: fq_detrainement
     548!$OMP THREADPRIVATE(fq_detrainement)
     549      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:)  :: fq_ddft
     550!$OMP THREADPRIVATE(fq_ddft)
     551      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:)  :: fq_fluxmasse
     552!$OMP THREADPRIVATE(fq_fluxmasse)
     553      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:)  :: fq_evapprecip
     554!$OMP THREADPRIVATE(fq_evapprecip)
     555      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:)  :: f_detrainement
     556!$OMP THREADPRIVATE(f_detrainement)
     557      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:)  :: q_detrainement
     558!$OMP THREADPRIVATE(q_detrainement)
     559      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: xt_detrainement
     560!$OMP THREADPRIVATE(xt_detrainement)
     561      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: xtlp
     562!$OMP THREADPRIVATE(xtlp)
     563      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: xtvp
     564!$OMP THREADPRIVATE(xtvp)
     565      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:)  :: q_the
     566!$OMP THREADPRIVATE(q_the)
     567      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: xt_the
     568!$OMP THREADPRIVATE(xt_the)
     569      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: fxt_detrainement
     570!$OMP THREADPRIVATE(fxt_detrainement)
     571      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: fxt_ddft
     572!$OMP THREADPRIVATE(fxt_ddft)
     573      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: fxt_fluxmasse
     574!$OMP THREADPRIVATE(fxt_fluxmasse)
     575      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:)  :: fxt_evapprecip
     576!$OMP THREADPRIVATE(fxt_evapprecip)
     577#endif
     578#endif
    448579!
    449580!      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: coefh, coefm, lambda_th
    … …  
    481612      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: pfraclr,pfracld
    482613!$OMP THREADPRIVATE(pfraclr,pfracld)
     614      REAL, SAVE, ALLOCATABLE :: cldfraliq(:,:)
     615!$OMP THREADPRIVATE(cldfraliq)
     616      REAL, SAVE, ALLOCATABLE ::mean_icefracturb(:,:)
     617!$OMP THREADPRIVATE(mean_icefracturb)
     618      REAL, SAVE, ALLOCATABLE :: sigma2_icefracturb(:,:)
     619!$OMP THREADPRIVATE(sigma2_icefracturb)
    483620
    484621! variables de sorties MM
    … …  
    487624!$OMP THREADPRIVATE(zxsnow,snowhgt,qsnow,to_ice)
    488625!$OMP THREADPRIVATE(sissnow,runoff,albsol3_lic)
     626#ifdef ISO
     627      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: zxxtsnow
     628!$OMP THREADPRIVATE(zxxtsnow)     
     629      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: xtVprecip,xtVprecipi
     630!$OMP THREADPRIVATE(xtVprecip,xtVprecipi)
     631      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:,:) :: pxtrfl, pxtsfl
     632!$OMP THREADPRIVATE(pxtrfl, pxtsfl)
     633#endif
    489634
    490635      REAL, ALLOCATABLE, SAVE, DIMENSION(:) :: p_tropopause, z_tropopause, t_tropopause
    … …  
    567712      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: R2SO4
    568713!$OMP THREADPRIVATE(R2SO4)
     714      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: R2SO4B
     715!$OMP THREADPRIVATE(R2SO4B)
    569716      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: DENSO4
    570717!$OMP THREADPRIVATE(DENSO4)
     718      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:, :) :: DENSO4B
     719!$OMP THREADPRIVATE(DENSO4B)     
    571720      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: f_r_wet
    572721!$OMP THREADPRIVATE(f_r_wet)
     722      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:, :) :: f_r_wetB
     723!$OMP THREADPRIVATE(f_r_wetB)
    573724      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: decfluxaer
    574725!$OMP THREADPRIVATE(decfluxaer)
    … …  
    599750      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vsed_aer
    600751!$OMP THREADPRIVATE(vsed_aer)
     752!     Sulfate aerosol concentration (dry mixing ratio) (condensed H2SO4 mmr)
     753      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sulfmmr
     754!$OMP THREADPRIVATE(sulfmmr)
     755!     SAD all aerosols (cm2/cm3)
     756      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: SAD_sulfate
     757!$OMP THREADPRIVATE(SAD_sulfate)
     758!     Effective radius of wet surface aerosols (cm)
     759      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: reff_sulfate
     760!$OMP THREADPRIVATE(reff_sulfate)
     761!     sulfate MMR in different modes (based on sulfmmr, it must be dry mmr)
     762      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sulfmmr_mode
     763!$OMP THREADPRIVATE(sulfmmr_mode)
     764!     particle concentration in different modes (part/m3)
     765      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: nd_mode
     766!$OMP THREADPRIVATE(nd_mode)
    601767!
    602768!---3D budget variables
    … …  
    647813SUBROUTINE phys_local_var_init
    648814USE dimphy
    649 USE infotrac_phy, ONLY : nbtr
     815USE infotrac_phy, ONLY : nbtr,nqtot
     816#ifdef ISO
     817USE infotrac_phy, ONLY : ntraciso=>ntiso,niso
     818#endif
    650819USE aero_mod
    651820USE indice_sol_mod
    652821USE phys_output_var_mod
    653822USE phys_state_var_mod
     823#ifdef CPP_StratAer
     824USE infotrac_phy, ONLY : nbtr_bin
     825#endif
    654826
    655827IMPLICIT NONE
    656828      ALLOCATE(t_seri(klon,klev),q_seri(klon,klev),ql_seri(klon,klev),qs_seri(klon,klev), qbs_seri(klon,klev))
     829! SN 4D ISO
     830      ALLOCATE(qx_seri(klon,klev,nqtot))
     831! SN
    657832      ALLOCATE(u_seri(klon,klev),v_seri(klon,klev))
    658833      ALLOCATE(cf_seri(klon,klev),rvc_seri(klon,klev))
    659834      ALLOCATE(l_mixmin(klon,klev+1,nbsrf),l_mix(klon,klev+1,nbsrf),wprime(klon,klev+1,nbsrf))
    660835      ALLOCATE(pbl_eps(klon,klev+1,nbsrf+1))
     836      ALLOCATE(tke_shear(klon,klev+1,nbsrf), tke_buoy(klon,klev+1,nbsrf), tke_trans(klon,klev+1,nbsrf))
    661837      pbl_eps(:,:,:)=0.
     838      tke_shear(:,:,:)=0.; tke_buoy(:,:,:)=0.; tke_trans(:,:,:)=0.
    662839      l_mix(:,:,:)=0.;l_mixmin(:,:,:)=0.;wprime(:,:,:)=0. ! doit etre initialse car pas toujours remplis
    663840      ALLOCATE(rhcl(klon,klev))
    … …  
    684861      ALLOCATE(d_u_ajs(klon,klev),d_v_ajs(klon,klev))
    685862      ALLOCATE(d_t_eva(klon,klev),d_q_eva(klon,klev))
     863! SN 4D ISO
     864      ALLOCATE(d_qx_eva(klon,klev,nqtot))
     865! SN
    686866      ALLOCATE(d_ql_eva(klon,klev),d_qi_eva(klon,klev))
    687867      ALLOCATE(d_t_lscst(klon,klev),d_q_lscst(klon,klev))
    … …  
    690870      ALLOCATE(d_t_vdf(klon,klev),d_q_vdf(klon,klev),d_t_diss(klon,klev))
    691871      ALLOCATE (d_qbs_vdf(klon,klev))
    692       ALLOCATE(d_t_bs(klon,klev),d_q_bs(klon,klev),d_qbs_bs(klon,klev))
     872      ALLOCATE(d_t_bsss(klon,klev),d_q_bsss(klon,klev),d_qbs_bsss(klon,klev))
    693873      ALLOCATE(d_t_vdf_w(klon,klev),d_q_vdf_w(klon,klev))
    694874      ALLOCATE(d_t_vdf_x(klon,klev),d_q_vdf_x(klon,klev))
     875#ifdef ISO
     876      allocate(xt_seri(ntraciso,klon,klev))
     877      allocate(xtl_seri(ntraciso,klon,klev))
     878      allocate(xts_seri(ntraciso,klon,klev))
     879      allocate(xtbs_seri(ntraciso,klon,klev))
     880      allocate(d_xt_dyn(ntraciso,klon,klev))
     881      allocate(d_xtl_dyn(ntraciso,klon,klev))
     882      allocate(d_xts_dyn(ntraciso,klon,klev))
     883      allocate(d_xtbs_dyn(ntraciso,klon,klev))
     884      allocate(d_xt_con(ntraciso,klon,klev))
     885      allocate(d_xt_wake(ntraciso,klon,klev))
     886      allocate(d_xt_lsc(ntraciso,klon,klev))
     887      allocate(d_xtl_lsc(ntraciso,klon,klev))
     888      allocate(d_xti_lsc(ntraciso,klon,klev))
     889      allocate(d_xt_ajsb(ntraciso,klon,klev))
     890      allocate(d_xt_ajs(ntraciso,klon,klev))
     891      allocate(d_xt_ajs_w(ntraciso,klon,klev))
     892      allocate(d_xt_ajs_x(ntraciso,klon,klev))
     893      allocate(d_xt_eva(ntraciso,klon,klev))
     894      allocate(d_xtl_eva(ntraciso,klon,klev))
     895      allocate(d_xti_eva(ntraciso,klon,klev))
     896      allocate(d_xt_vdf(ntraciso,klon,klev)) 
     897      allocate(d_xt_vdf_w(ntraciso,klon,klev))
     898      allocate(d_xt_vdf_x(ntraciso,klon,klev))
     899      allocate(d_xt_ch4(ntraciso,klon,klev))
     900      allocate(d_xt_prod_nucl(ntraciso,klon,klev))
     901      allocate(d_xt_cosmo(ntraciso,klon,klev))
     902      allocate(d_xt_decroiss(ntraciso,klon,klev))
     903#endif
    695904
    696905      ALLOCATE(d_u_vdf(klon,klev),d_v_vdf(klon,klev))
    … …  
    704913      ALLOCATE(d_ts(klon,nbsrf), d_tr(klon,klev,nbtr))
    705914
    706 ! aerosols
    707       ALLOCATE(m_allaer(klon,klev,naero_tot))
    708915! Special RRTM
    709916      ALLOCATE(ZLWFT0_i(klon,klev+1),ZSWFT0_i(klon,klev+1),ZFLDN0(klon,klev+1))
    … …  
    8131020!!      ALLOCATE( d_s_the(klon), d_dens_the(klon))
    8141021      ALLOCATE(d_deltat_ajs_cv(klon, klev), d_deltaq_ajs_cv(klon, klev))
     1022#ifdef ISO
     1023      ALLOCATE(d_deltaxt_wk(ntraciso,klon, klev))
     1024      ALLOCATE(d_deltaxt_wk_gw(ntraciso,klon, klev))
     1025      ALLOCATE(d_deltaxt_the(ntraciso,klon, klev))
     1026      ALLOCATE(d_deltaxt_vdf(ntraciso,klon, klev))
     1027      ALLOCATE(d_deltaxt_ajs_cv(ntraciso,klon, klev))
     1028#endif
    8151029!!         End of wake variables
    8161030!!
    … …  
    8341048      ALLOCATE(zxfqcalving(klon), zxfluxlat(klon))
    8351049      ALLOCATE(zxtsol(klon), snow_lsc(klon), zxfqfonte(klon), zxqsurf(klon))
    836       ALLOCATE(zxrunofflic(klon))
     1050! SN add runoff_diag
     1051      ALLOCATE(zxrunofflic(klon), runoff_diag(klon))
     1052      runoff_diag(:)=0.
    8371053      ALLOCATE(zxustartlic(klon), zxrhoslic(klon), zxqsaltlic(klon))
    8381054      zxustartlic(:)=0. ; zxrhoslic(:)=0. ; zxqsaltlic(:)=0.
    … …  
    8411057      ALLOCATE(qlth(klon,klev), qith(klon,klev), qsith(klon,klev), wiceth(klon,klev))
    8421058      !
     1059#ifdef ISO
     1060      ALLOCATE(xtevap(ntraciso,klon))
     1061      ALLOCATE(xtprw(ntraciso,klon))
     1062      ALLOCATE(zxfxtcalving(niso,klon))
     1063      ALLOCATE(xtsnow_lsc(ntraciso,klon), zxfxtfonte(niso,klon))
     1064      ALLOCATE(zxxtrunofflic(niso,klon))
     1065      ALLOCATE(xtrain_lsc(ntraciso,klon))
     1066      ALLOCATE(xtrunoff_diag(niso,klon))
     1067      ALLOCATE(h1_diag(klon))
     1068!SN
     1069      xtrunoff_diag(:,:)=0. ! because variables are only given values on knon grid points
     1070#endif
     1071!
    8431072      ALLOCATE(sens_x(klon), sens_w(klon))
    8441073      ALLOCATE(zxfluxlat_x(klon), zxfluxlat_w(klon))
    … …  
    8571086      ALLOCATE(cdragm_x(klon), cdragm_w(klon))
    8581087      ALLOCATE(kh(klon), kh_x(klon), kh_w(klon))
     1088#ifdef ISO
     1089      ALLOCATE(dxtvdf_x(ntraciso,klon,klev), dxtvdf_w(ntraciso,klon,klev))
     1090      ALLOCATE(xt_therm(ntraciso,klon,klev))
     1091#endif
    8591092!
    8601093      ALLOCATE(ptconv(klon,klev))
    … …  
    9121145      ALLOCATE(epmlmMm(klon,klev,klev), eplaMm(klon,klev))
    9131146      ALLOCATE(sij(klon,klev,klev))
     1147#ifdef ISO
     1148      ALLOCATE(xtwdtrainA(ntraciso,klon,klev))
     1149      ALLOCATE(xtev(ntraciso,klon,klev) )
     1150      ALLOCATE(xttaa(ntraciso,klon,klev) )
     1151      ALLOCATE(xtclw(ntraciso,klon,klev) )
     1152#ifdef DIAGISO
     1153      ALLOCATE(qlp(klon,klev))
     1154      ALLOCATE(qvp(klon,klev))
     1155      ALLOCATE(fq_detrainement(klon,klev))
     1156      ALLOCATE(fq_ddft(klon,klev))
     1157      ALLOCATE(fq_fluxmasse(klon,klev))
     1158      ALLOCATE(fq_evapprecip(klon,klev))
     1159      ALLOCATE(f_detrainement(klon,klev), q_detrainement(klon,klev))
     1160      ALLOCATE(xtlp(ntraciso,klon,klev))
     1161      ALLOCATE(xtvp(ntraciso,klon,klev))
     1162      ALLOCATE(q_the(klon,klev), xt_the(ntraciso,klon,klev))
     1163      ALLOCATE(fxt_detrainement(ntraciso,klon,klev))
     1164      ALLOCATE(fxt_ddft(ntraciso,klon,klev))
     1165      ALLOCATE(fxt_fluxmasse(ntraciso,klon,klev))
     1166      ALLOCATE(fxt_evapprecip(ntraciso,klon,klev))
     1167      ALLOCATE(xt_detrainement(ntraciso,klon,klev))
     1168#endif
     1169#endif
    9141170
    9151171      ALLOCATE(prfl(klon, klev+1))
    … …  
    9311187      ALLOCATE(pfraclr(klon,klev),pfracld(klon,klev))
    9321188      pfraclr(:,:)=0. ; pfracld(:,:)=0. ! because not always defined
     1189      ALLOCATE(cldfraliq(klon,klev))
     1190      ALLOCATE(sigma2_icefracturb(klon,klev))
     1191      ALLOCATE(mean_icefracturb(klon,klev))
    9331192      ALLOCATE(distcltop(klon,klev))
    9341193      ALLOCATE(temp_cltop(klon,klev))
    … …  
    9371196      ALLOCATE (zxsnow(klon),snowhgt(klon),qsnow(klon),to_ice(klon))
    9381197      ALLOCATE (sissnow(klon),runoff(klon),albsol3_lic(klon))
     1198#ifdef ISO
     1199      ALLOCATE (zxxtsnow(niso,klon))
     1200      ALLOCATE(xtVprecip(ntraciso,klon, klev+1),xtVprecipi(ntraciso,klon, klev+1))
     1201      ALLOCATE(pxtsfl(ntraciso,klon, klev+1),pxtrfl(ntraciso,klon, klev+1))
     1202#endif
    9391203
    9401204      ALLOCATE (p_tropopause(klon))
    … …  
    9681232      ALLOCATE (d_q_emiss(klon,klev))
    9691233      ALLOCATE (R2SO4(klon,klev))
     1234      ALLOCATE (R2SO4B(klon,klev,nbtr_bin))
    9701235      ALLOCATE (DENSO4(klon,klev))
     1236      ALLOCATE (DENSO4B(klon,klev,nbtr_bin))
    9711237      ALLOCATE (f_r_wet(klon,klev))
     1238      ALLOCATE (f_r_wetB(klon,klev,nbtr_bin))
    9721239      ALLOCATE (decfluxaer(klon,nbtr))
    9731240      ALLOCATE (mdw(nbtr))
    … …  
    10061273      ALLOCATE (surf_PM25_sulf(klon))
    10071274      ALLOCATE (vsed_aer(klon,klev))
     1275      ALLOCATE (sulfmmr(klon,klev))
     1276      ALLOCATE (SAD_sulfate(klon,klev))
     1277      ALLOCATE (reff_sulfate(klon,klev))
     1278      ALLOCATE (sulfmmr_mode(klon,klev,nbtr_bin))
     1279      ALLOCATE (nd_mode(klon,klev,nbtr_bin))
    10081280#endif
    10091281
    … …  
    10161288IMPLICIT NONE
    10171289      DEALLOCATE(t_seri,q_seri,ql_seri,qs_seri, qbs_seri)
     1290! SN 4D ISO
     1291      DEALLOCATE(qx_seri)
     1292! SN
    10181293      DEALLOCATE(u_seri,v_seri)
    10191294      DEALLOCATE(cf_seri,rvc_seri)
    10201295      DEALLOCATE(l_mixmin,l_mix,wprime)
     1296      DEALLOCATE(tke_shear,tke_buoy,tke_trans)
    10211297      DEALLOCATE(pbl_eps)
    10221298      DEALLOCATE(rhcl)
    … …  
    10431319      DEALLOCATE(d_u_ajs,d_v_ajs)
    10441320      DEALLOCATE(d_t_eva,d_q_eva)
     1321! SN 4D ISO
     1322      DEALLOCATE(d_qx_eva)
     1323! SN
    10451324      DEALLOCATE(d_ql_eva,d_qi_eva)
    10461325      DEALLOCATE(d_t_lscst,d_q_lscst)
    … …  
    10491328      DEALLOCATE(d_t_vdf,d_q_vdf,d_t_diss)
    10501329      DEALLOCATE(d_qbs_vdf)
    1051       DEALLOCATE(d_t_bs,d_q_bs,d_qbs_bs)
     1330      DEALLOCATE(d_t_bsss,d_q_bsss,d_qbs_bsss)
     1331#ifdef ISO
     1332      deallocate(xt_seri,xtl_seri,xts_seri,xtbs_seri)
     1333      DEALLOCATE(d_xtl_eva,d_xti_eva)
     1334      deallocate(d_xt_dyn,d_xtl_dyn,d_xts_dyn,d_xtbs_dyn)
     1335      deallocate(d_xt_con)
     1336      deallocate(d_xt_wake)
     1337      deallocate(d_xt_lsc)
     1338      deallocate(d_xtl_lsc,d_xti_lsc)
     1339      deallocate(d_xt_ajsb)
     1340      deallocate(d_xt_ajs)
     1341      deallocate(d_xt_ajs_w,d_xt_ajs_x)
     1342      deallocate(d_xt_eva)
     1343      deallocate(d_xtl_eva)
     1344      deallocate(d_xti_eva)
     1345      deallocate(d_xt_vdf)
     1346      deallocate(d_xt_vdf_w,d_xt_vdf_x)
     1347      deallocate(d_xt_ch4)
     1348      deallocate(d_xt_prod_nucl)
     1349      deallocate(d_xt_cosmo)
     1350      deallocate(d_xt_decroiss)
     1351#endif
     1352
    10521353      DEALLOCATE(d_u_vdf,d_v_vdf)
    10531354      DEALLOCATE(d_t_oli,d_t_oro)
    … …  
    11211422      DEALLOCATE(solsw_aerop, solsw0_aerop)
    11221423      DEALLOCATE(topswcf_aerop, solswcf_aerop)
    1123 !AI Aerosols
    1124       DEALLOCATE(m_allaer)
    11251424!CK LW diagnostics
    11261425      DEALLOCATE(toplwad_aerop, sollwad_aerop)
    … …  
    11551454!!      DEALLOCATE( d_s_the, d_dens_the)
    11561455      DEALLOCATE(d_deltat_ajs_cv, d_deltaq_ajs_cv)
     1456#ifdef ISO
     1457      DEALLOCATE(d_deltaxt_wk)
     1458      DEALLOCATE(d_deltaxt_wk_gw)
     1459      DEALLOCATE(d_deltaxt_ajs_cv)
     1460      DEALLOCATE(d_deltaxt_vdf)
     1461#endif
    11571462!
    11581463      DEALLOCATE(bils)
    … …  
    11731478      DEALLOCATE(uwat, vwat)
    11741479      DEALLOCATE(zxfqcalving, zxfluxlat)
    1175       DEALLOCATE(zxrunofflic)
     1480! SN runoff_diag
     1481      DEALLOCATE(zxrunofflic, runoff_diag)
    11761482      DEALLOCATE(zxustartlic, zxrhoslic, zxqsaltlic)
    11771483      DEALLOCATE(zxtsol, snow_lsc, zxfqfonte, zxqsurf)
    … …  
    11941500      DEALLOCATE(cdragm_x, cdragm_w)
    11951501      DEALLOCATE(kh, kh_x, kh_w)
     1502#ifdef ISO
     1503      DEALLOCATE(xtevap,xtprw)
     1504      DEALLOCATE(zxfxtcalving)
     1505      DEALLOCATE(zxxtrunofflic)
     1506      DEALLOCATE(xtsnow_lsc, zxfxtfonte)
     1507      DEALLOCATE(xtrain_lsc)
     1508      DEALLOCATE(dxtvdf_x, dxtvdf_w)
     1509      DEALLOCATE(xt_therm)
     1510      DEALLOCATE(h1_diag,xtrunoff_diag)
     1511#endif
    11961512!
    11971513      DEALLOCATE(ptconv)
    … …  
    12431559      DEALLOCATE(epmlmMm, eplaMm)
    12441560      DEALLOCATE(sij)
     1561#ifdef ISO
     1562      DEALLOCATE(xtwdtrainA)
     1563      DEALLOCATE(xttaa )
     1564      DEALLOCATE(xtclw )
     1565      DEALLOCATE(xtev )
     1566#ifdef DIAGISO
     1567      DEALLOCATE(qlp)
     1568      DEALLOCATE(qvp)
     1569      DEALLOCATE(fq_detrainement)
     1570      DEALLOCATE(fq_ddft)
     1571      DEALLOCATE(fq_fluxmasse)
     1572      DEALLOCATE(fq_evapprecip)
     1573      DEALLOCATE(f_detrainement,q_detrainement)
     1574      DEALLOCATE(xtlp)
     1575      DEALLOCATE(xtvp)
     1576      DEALLOCATE(q_the,xt_the)
     1577      DEALLOCATE(fxt_detrainement)
     1578      DEALLOCATE(fxt_ddft)
     1579      DEALLOCATE(fxt_fluxmasse)
     1580      DEALLOCATE(fxt_evapprecip)
     1581      DEALLOCATE(xt_detrainement)
     1582#endif
     1583#endif
    12451584
    12461585
    … …  
    12591598      DEALLOCATE(rneb)
    12601599      DEALLOCATE(pfraclr,pfracld)
     1600      DEALLOCATE(cldfraliq)
     1601      DEALLOCATE(sigma2_icefracturb)
     1602      DEALLOCATE(mean_icefracturb)
    12611603      DEALLOCATE (zxsnow,snowhgt,qsnow,to_ice,sissnow,runoff,albsol3_lic)
    12621604      DEALLOCATE(distcltop)
    12631605      DEALLOCATE(temp_cltop)
     1606#ifdef ISO
     1607      DEALLOCATE (zxxtsnow,xtVprecip,xtVprecipi,pxtrfl,pxtsfl)
     1608#endif
     1609
    12641610      DEALLOCATE (p_tropopause)
    12651611      DEALLOCATE (z_tropopause)
    … …  
    12911637! variables for strat. aerosol CK
    12921638      DEALLOCATE (d_q_emiss)
    1293       DEALLOCATE (R2SO4)
    1294       DEALLOCATE (DENSO4)
    1295       DEALLOCATE (f_r_wet)
     1639      DEALLOCATE (R2SO4, R2SO4B)
     1640      DEALLOCATE (DENSO4, DENSO4B)
     1641      DEALLOCATE (f_r_wet, f_r_wetB)
    12961642      DEALLOCATE (decfluxaer)
    12971643      DEALLOCATE (mdw)
    … …  
    13081654      DEALLOCATE (surf_PM25_sulf)
    13091655      DEALLOCATE (vsed_aer)
     1656      DEALLOCATE (sulfmmr)
     1657      DEALLOCATE (SAD_sulfate)
     1658      DEALLOCATE (reff_sulfate)
     1659      DEALLOCATE (sulfmmr_mode)
     1660      DEALLOCATE (nd_mode)
    13101661      DEALLOCATE (budg_3D_ocs_to_so2)
    13111662      DEALLOCATE (budg_3D_so2_to_h2so4)

  • LMDZ6/branches/cirrus/libf/phylmd/phys_output_ctrlout_mod.F90

    r4951 r5202  
    11121112  TYPE(ctrl_out), SAVE :: o_tke = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
    11131113    'tke ', 'TKE', 'm2/s2', (/ ('', i=1, 10) /))
     1114  TYPE(ctrl_out), SAVE :: o_tke_shear = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), &
     1115    'tke_shear ', 'TKE shear term', 'm2/s3', (/ ('', i=1, 10) /)) 
     1116  TYPE(ctrl_out), SAVE :: o_tke_buoy = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), &
     1117    'tke_buoy ', 'TKE buoyancy term', 'm2/s3', (/ ('', i=1, 10) /))
     1118  TYPE(ctrl_out), SAVE :: o_tke_trans = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), &
     1119    'tke_trans ', 'TKE transport term', 'm2/s3', (/ ('', i=1, 10) /))
    11141120  TYPE(ctrl_out), SAVE :: o_tke_dissip = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
    1115     'tke_dissip ', 'TKE DISSIPATION', 'm2/s3', (/ ('', i=1, 10) /))   
     1121    'tke_dissip ', 'TKE dissipation term', 'm2/s3', (/ ('', i=1, 10) /))
     1122
    11161123  TYPE(ctrl_out), SAVE :: o_tke_max = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
    11171124    'tke_max', 'TKE max', 'm2/s2',                                  &
    … …  
    14421449  TYPE(ctrl_out), SAVE :: o_tau_strat_1020 = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 1/), &
    14431450    'OD1020_strat_only', 'Stratospheric Aerosol Optical depth at 1020 nm ', '1', (/ ('', i=1, 10) /))
     1451  TYPE(ctrl_out), SAVE :: o_SAD_sulfate = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 1/), &
     1452    'SAD_sulfate', 'SAD WET sulfate aerosols', 'cm2/cm3', (/ ('', i=1, 10) /))
     1453  TYPE(ctrl_out), SAVE :: o_reff_sulfate = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 1/), &
     1454    'reff_sulfate', 'Effective radius of WET sulfate aerosols', 'cm', (/ ('', i=1, 10) /))
     1455  TYPE(ctrl_out), SAVE :: o_sulfmmr = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 1/), &
     1456    'sulfMMR', 'Sulfate aerosol concentration (dry mass mixing ratio)', 'kg(H2SO4)/kg(air)', (/ ('', i=1, 10) /))
     1457  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_nd_mode(:)
     1458  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_sulfmmr_mode(:)
    14441459!--chemistry
    14451460  TYPE(ctrl_out), SAVE :: o_R2SO4 = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 1/), &
    … …  
    15511566  TYPE(ctrl_out), SAVE :: o_rneb = ctrl_out((/ 2, 5, 10, 10, 10, 10, 11, 11, 11, 11/), &
    15521567    'rneb', 'Cloud fraction', '-', (/ ('', i=1, 10) /))
     1568  TYPE(ctrl_out), SAVE :: o_cldfraliq = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), &
     1569    'cldfraliq', 'Liquid fraction of the cloud', '-', (/ ('', i=1, 10) /))
     1570  TYPE(ctrl_out), SAVE :: o_sigma2_icefracturb = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), &
     1571    'sigma2_icefracturb', 'Variance of the diagnostic supersaturation distribution (icefrac_turb) [-]', '-', (/ ('', i=1, 10) /))
     1572  TYPE(ctrl_out), SAVE :: o_mean_icefracturb = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), &
     1573    'mean_icefracturb', 'Mean of the diagnostic supersaturation distribution (icefrac_turb) [-]', '-', (/ ('', i=1, 10) /))
     1574 
    15531575  TYPE(ctrl_out), SAVE :: o_rnebjn = ctrl_out((/ 2, 5, 10, 10, 10, 10, 11, 11,11, 11/), &     
    15541576    'rnebjn', 'Cloud fraction in day', '-', (/ ('', i=1, 10) /))
    … …  
    19812003  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dtr_dry(:)
    19822004
     2005#ifdef ISO
     2006  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_xtprecip(:)
     2007  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_xtevap(:)
     2008  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_xtevap_srf(:,:) ! ajout Camille 8 mai 2023
     2009  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_xtplul(:)
     2010  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_xtpluc(:)
     2011  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_xtovap(:)
     2012  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_xtoliq(:)
     2013  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_xtcond(:)
     2014  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_xtrunoff_diag(:)
     2015  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dxtdyn(:)
     2016  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dxtldyn(:)
     2017  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dxtvdf(:)
     2018  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dxtcon(:)
     2019  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dxtlsc(:)
     2020  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dxteva(:)
     2021  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dxtajs(:)
     2022  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dxtthe(:)
     2023  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dxtch4(:)
     2024  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dxtprod_nucl(:)
     2025  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dxtcosmo(:)
     2026  TYPE(ctrl_out), SAVE, ALLOCATABLE :: o_dxtdecroiss(:)
     2027#endif
     2028
    19832029  TYPE(ctrl_out), SAVE :: o_rsu = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
    19842030    'rsu', 'SW upward radiation', 'W m-2', (/ ('', i=1, 10) /))
    … …  
    20642110  TYPE(ctrl_out), SAVE :: o_runoff = ctrl_out((/ 1, 1, 10, 1, 10, 10, 11, 11, 11, 11/), &
    20652111    'runoff', 'Run-off rate land ice', 'kg/m2/s', (/ ('', i=1, 10) /))
     2112! SN add runoff_diag
     2113!#ifdef ISO
     2114  TYPE(ctrl_out), SAVE :: o_runoff_diag = ctrl_out((/ 1, 1, 10, 1, 10, 10, 11, 11, 11, 11/), &
     2115    'runoffland', 'Run-off rate land for bucket', 'kg/m2/s', (/ ('', i=1, 10) /))
     2116!#endif
    20662117  TYPE(ctrl_out), SAVE :: o_albslw3 = ctrl_out((/ 1, 1, 1, 1, 10, 10, 11, 11, 11, 11/), &
    20672118    'albslw3', 'Surface albedo LW3', '-', (/ ('', i=1, 10) /))

  • LMDZ6/branches/cirrus/libf/phylmd/phys_output_mod.F90

    r4619 r5202  
    3535    USE iophy
    3636    USE dimphy
    37     USE infotrac_phy, ONLY: nqtot, tracers, niso
     37    USE infotrac_phy, ONLY: nqtot, tracers, niso, ntraciso=>ntiso
    3838    USE strings_mod,  ONLY: maxlen
    3939    USE ioipsl
    … …  
    4949    ! ug Pour les sorties XIOS
    5050    USE wxios
     51#ifdef CPP_StratAer
     52   USE infotrac_phy, ONLY: nbtr_bin
     53#endif
     54#ifdef ISO
     55    USE isotopes_mod, ONLY: isoName,iso_HTO
     56#ifdef ISOTRAC
     57    use isotrac_mod, only: index_zone,index_iso,strtrac
     58#endif
     59#endif
    5160
    5261    IMPLICIT NONE
    … …  
    93102    CHARACTER(LEN=4), DIMENSION(nlevSTD)  :: clevSTD
    94103    REAL, DIMENSION(nlevSTD)              :: rlevSTD
    95     INTEGER                               :: nsrf, k, iq, iff, i, j, ilev, itr, ixt, iiso, izone
     104    INTEGER                               :: nsrf, k, iq, iff, i, j, ilev, itr, itrb, ixt, iiso, izone
    96105    INTEGER                               :: naero
    97106    LOGICAL                               :: ok_veget
    … …  
    112121    LOGICAL, DIMENSION(nfiles)            :: phys_out_filestations
    113122
     123#ifdef ISO
     124    CHARACTER(LEN=maxlen) :: outiso
     125    CHARACTER(LEN=20) :: unit
     126#endif
    114127    CHARACTER(LEN=maxlen) :: tnam, lnam, dn
    115128    INTEGER :: flag(nfiles)
    … …  
    158171    ALLOCATE(o_dtr_sscav(nqtot),o_dtr_sat(nqtot),o_dtr_uscav(nqtot))
    159172    ALLOCATE(o_dtr_dry(nqtot),o_dtr_vdf(nqtot))
     173#ifdef CPP_StratAer
     174    ALLOCATE(o_nd_mode(nbtr_bin),o_sulfmmr_mode(nbtr_bin))
     175#endif
     176#ifdef ISO
     177    ALLOCATE(o_xtprecip(ntraciso))
     178    ALLOCATE(o_xtplul(ntraciso))
     179    ALLOCATE(o_xtpluc(ntraciso))
     180    ALLOCATE(o_xtevap(ntraciso))
     181    ALLOCATE(o_xtevap_srf(ntraciso,4))
     182    ALLOCATE(o_xtovap(ntraciso))
     183    ALLOCATE(o_xtoliq(ntraciso))
     184    ALLOCATE(o_xtcond(ntraciso))
     185    ALLOCATE(o_xtrunoff_diag(ntraciso))
     186    ALLOCATE(o_dxtdyn(ntraciso))
     187    ALLOCATE(o_dxtldyn(ntraciso))
     188    ALLOCATE(o_dxtcon(ntraciso))
     189    ALLOCATE(o_dxtlsc(ntraciso))
     190    ALLOCATE(o_dxteva(ntraciso))
     191    ALLOCATE(o_dxtajs(ntraciso))
     192    ALLOCATE(o_dxtvdf(ntraciso))
     193    ALLOCATE(o_dxtthe(ntraciso))
     194    ALLOCATE(o_dxtch4(ntraciso))
     195    if (iso_HTO.gt.0) then
     196      ALLOCATE(o_dxtprod_nucl(ntraciso))
     197      ALLOCATE(o_dxtcosmo(ntraciso))
     198      ALLOCATE(o_dxtdecroiss(ntraciso))
     199    endif
     200#endif
    160201
    161202    levmax = [klev, klev, klev, klev, klev, klev, nlevSTD, nlevSTD, nlevSTD, klev]
    … …  
    467508     ENDIF ! clef_files
    468509
    469           itr = 0
     510          itr = 0; itrb = 0
    470511          DO iq = 1, nqtot
    471512            IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE
    … …  
    503544            lnam = 'Cumulated tracer '//TRIM(tracers(iq)%longName)
    504545            tnam = 'cum'//TRIM(tracers(iq)%name); o_trac_cum(itr) = ctrl_out(flag, tnam, lnam, "-", [('',i=1,nfiles)])
    505           ENDDO
     546           
     547#ifdef CPP_StratAer
     548            if(tracers(iq)%name(1:3)=='BIN') then
     549               itrb = itrb + 1
     550               flag = [11, 11, 11, 11, 11, 11, 11, 11, 11, 1]
     551               lnam = 'Dry particle concentration in '//TRIM(tracers(iq)%longName)
     552               tnam = TRIM(tracers(iq)%name)//'_nd_mode';     o_nd_mode       (itrb) = ctrl_out(flag, tnam, lnam, "part/m3", [('',i=1,nfiles)])
     553               lnam = 'Sulfate MMR in '//TRIM(tracers(iq)%longName)
     554               tnam = TRIM(tracers(iq)%name)//'_sulfmmr_mode';o_sulfmmr_mode  (itrb) = ctrl_out(flag, tnam, lnam, "kg(H2SO4)/kg(air)", [('',i=1,nfiles)])
     555            endif
     556#endif
     557         ENDDO
    506558
    507559   ENDDO !  iff
    508560
    509     ! Updated write frequencies due to phys_out_filetimesteps.
     561#ifdef ISO
     562    write(*,*) 'phys_output_mid 589'
     563    do ixt=1,ntraciso
     564      outiso = TRIM(isoName(ixt))
     565      i = INDEX(outiso, '_', .TRUE.)
     566      outiso = outiso(1:i-1)//outiso(i+1:LEN_TRIM(outiso))
     567
     568      flag = [1,  1,  1, 10,  5, 10, 11, 11, 11, 11]; unit = 'kg/(s*m2)'
     569      o_xtprecip(ixt)=ctrl_out(flag, 'precip'//TRIM(outiso), 'Precip Totale liq+sol', unit, [('',i=1,nfiles)])
     570      o_xtpluc  (ixt)=ctrl_out(flag,   'pluc'//TRIM(outiso),    'Convective Precip.', unit, [('',i=1,nfiles)])
     571
     572      flag = [1,  1,  1, 10, 10, 10, 11, 11, 11, 11]
     573      o_xtplul  (ixt)=ctrl_out(flag,   'plul'//TRIM(outiso),   'Large-scale Precip.', unit, [('',i=1,nfiles)])
     574      o_xtevap  (ixt)=ctrl_out(flag,   'evap'//TRIM(outiso),             'Evaporat.', unit, [('',i=1,nfiles)])
     575
     576      ! ajout Camille 8 mai 2023
     577      flag = [1, 6, 10, 10, 10, 10, 11, 11, 11, 11]
     578      o_xtevap_srf (ixt,1)=ctrl_out(flag,   'evap_ter'//TRIM(outiso), 'Evap sfc'//clnsurf(1), unit, [('',i=1,nfiles)])
     579      o_xtevap_srf (ixt,2)=ctrl_out(flag,   'evap_lic'//TRIM(outiso), 'Evap sfc'//clnsurf(2), unit, [('',i=1,nfiles)])
     580      o_xtevap_srf (ixt,3)=ctrl_out(flag,   'evap_oce'//TRIM(outiso), 'Evap sfc'//clnsurf(3), unit, [('',i=1,nfiles)])
     581      o_xtevap_srf (ixt,4)=ctrl_out(flag,   'evap_sic'//TRIM(outiso), 'Evap sfc'//clnsurf(4), unit, [('',i=1,nfiles)])
     582
     583      flag = [2,  3,  4, 10, 10, 10, 11, 11, 11, 11]; unit = 'kg/kg'
     584      o_xtovap  (ixt)=ctrl_out(flag,   'ovap'//TRIM(outiso),     'Specific humidity', unit, [('',i=1,nfiles)])
     585      o_xtoliq  (ixt)=ctrl_out(flag,   'oliq'//TRIM(outiso),          'Liquid water', unit, [('',i=1,nfiles)])
     586      o_xtcond  (ixt)=ctrl_out(flag,  'ocond'//TRIM(outiso),       'Condensed water', unit, [('',i=1,nfiles)])
     587
     588      flag = [1,  1,  1, 10, 5, 10, 11, 11, 11, 11]; unit = 'kg/m2/s'
     589      o_xtrunoff_diag  (ixt)=ctrl_out(flag, 'runoffland'//TRIM(outiso), 'Run-off rate land for bucket', unit, [('',i=1,nfiles)])
     590
     591      flag = [4, 10, 10, 10, 10, 10, 11, 11, 11, 11]; unit = '(kg/kg)/s'
     592      o_dxtdyn  (ixt)=ctrl_out(flag,  'dqdyn'//TRIM(outiso),           'Dynamics dQ', unit, [('',i=1,nfiles)])
     593      o_dxtldyn (ixt)=ctrl_out(flag, 'dqldyn'//TRIM(outiso),          'Dynamics dQL', unit, [('',i=1,nfiles)])
     594      o_dxtcon  (ixt)=ctrl_out(flag,  'dqcon'//TRIM(outiso),         'Convection dQ', unit, [('',i=1,nfiles)])
     595      o_dxteva  (ixt)=ctrl_out(flag,  'dqeva'//TRIM(outiso),      'Reevaporation dQ', unit, [('',i=1,nfiles)])
     596      o_dxtlsc  (ixt)=ctrl_out(flag,  'dqlsc'//TRIM(outiso),       'Condensation dQ', unit, [('',i=1,nfiles)])
     597      o_dxtajs  (ixt)=ctrl_out(flag,  'dqajs'//TRIM(outiso),        'Dry adjust. dQ', unit, [('',i=1,nfiles)])
     598      o_dxtvdf  (ixt)=ctrl_out(flag,  'dqvdf'//TRIM(outiso),     'Boundary-layer dQ', unit, [('',i=1,nfiles)])
     599      o_dxtthe  (ixt)=ctrl_out(flag,  'dqthe'//TRIM(outiso),            'Thermal dQ', unit, [('',i=1,nfiles)])
     600
     601      IF(ok_qch4) o_dxtch4(ixt)=ctrl_out(flag, 'dqch4'//TRIM(outiso), 'H2O due to CH4 oxidation & photolysis', &
     602                                                                                      unit, [('',i=1,nfiles)])
     603      IF(ixt == iso_HTO) THEN
     604      o_dxtprod_nucl(ixt)=ctrl_out(flag, 'dqprodnucl'//TRIM(outiso), 'dHTO/dt due to nuclear production',      &
     605                                                                                      unit, [('',i=1,nfiles)])
     606      o_dxtcosmo    (ixt)=ctrl_out(flag,    'dqcosmo'//TRIM(outiso), 'dHTO/dt due to cosmogenic production',   &
     607                                                                                      unit, [('',i=1,nfiles)])
     608      o_dxtdecroiss (ixt)=ctrl_out(flag, 'dqdecroiss'//TRIM(outiso), 'dHTO/dt due to radiative destruction',   &
     609                                                                                      unit, [('',i=1,nfiles)])
     610      END IF
     611    enddo !do ixt=1,niso
     612    write(*,*) 'phys_output_mid 596'
     613#endif
     614
     615   ! Updated write frequencies due to phys_out_filetimesteps.
    510616    ! Write frequencies are now in seconds. 
    511617    ecrit_mth = ecrit_files(1)

  • LMDZ6/branches/cirrus/libf/phylmd/phys_output_write_mod.F90

    r4951 r5202  
    6565         o_fder, o_ffonte, o_fqcalving, o_fqfonte, o_mrroli, o_runofflic, &
    6666         o_taux, o_tauy, o_snowsrf, o_qsnow, &
    67          o_snowhgt, o_toice, o_sissnow, o_runoff, &
     67! SN runoff_diag
     68         o_snowhgt, o_toice, o_sissnow, o_runoff, o_runoff_diag, &
    6869         o_albslw3, o_pourc_srf, o_fract_srf, &
    6970         o_taux_srf, o_tauy_srf, o_tsol_srf, &
    … …  
    141142         o_zfull, o_zhalf, o_rneb, o_rnebjn, o_rnebcon, &
    142143         o_rnebls, o_rneblsvol, o_rhum, o_rhl, o_rhi, o_ozone, o_ozone_light, &
    143          o_pfraclr, o_pfracld, &
     144         o_pfraclr, o_pfracld, o_cldfraliq, o_sigma2_icefracturb, o_mean_icefracturb,  &
    144145         o_qrainlsc, o_qsnowlsc, o_dqreva, o_dqrauto, o_dqrcol, o_dqrmelt, o_dqrfreez, &
    145146         o_dqssub, o_dqsauto, o_dqsagg, o_dqsrim, o_dqsmelt, o_dqsfreez, &
    … …  
    147148         o_dqsphy, o_dqsphy2d, o_dqbsphy, o_dqbsphy2d, o_albe_srf, o_z0m_srf, o_z0h_srf, &
    148149         o_ages_srf, o_snow_srf, o_alb1, o_alb2, o_tke, o_tke_dissip, &
    149          o_tke_max, o_kz, o_kz_max, o_clwcon, &
     150         o_tke_max, o_kz, o_kz_max, o_clwcon, o_tke_shear, o_tke_buoy, o_tke_trans,  &
    150151         o_dtdyn, o_dqdyn, o_dqdyn2d, o_dqldyn, o_dqldyn2d, &
    151152         o_dqsdyn, o_dqsdyn2d, o_dqbsdyn, o_dqbsdyn2d, o_dudyn, o_dvdyn, &
    … …  
    208209! Isotopes
    209210         o_xtprecip,o_xtplul,o_xtpluc,o_xtovap,o_xtoliq,o_xtcond, &
     211         o_xtrunoff_diag, &
    210212         o_xtevap,o_dxtdyn,o_dxtldyn,o_dxtcon,o_dxtlsc,o_dxteva, &
    211213         o_dxtajs,o_dxtvdf,o_dxtthe, o_dxtch4, &
    … …  
    248250
    249251#ifdef CPP_StratAer
     252    USE infotrac_phy, ONLY: nbtr_bin
    250253    USE phys_output_ctrlout_mod, ONLY:  &
    251254         o_budg_3D_nucl, o_budg_3D_cond_evap, o_budg_3D_ocs_to_so2, o_budg_3D_so2_to_h2so4, &
    … …  
    259262         o_budg_ocs_to_so2, o_budg_so2_to_h2so4, o_budg_h2so4_to_part, &
    260263         o_surf_PM25_sulf, o_ext_strat_550, o_tau_strat_550, &
    261          o_vsed_aer, o_tau_strat_1020, o_ext_strat_1020, o_f_r_wet
     264         o_vsed_aer, o_tau_strat_1020, o_ext_strat_1020, o_f_r_wet, &
     265         o_SAD_sulfate, o_reff_sulfate, o_sulfmmr, o_nd_mode, o_sulfmmr_mode
    262266#endif
    263267
    … …  
    314318         zn2mout, t2m_min_mon, t2m_max_mon, evap, &
    315319         snowerosion, zxustartlic, zxrhoslic, zxqsaltlic, &
    316          l_mixmin,l_mix, pbl_eps, &
     320         l_mixmin,l_mix, pbl_eps, tke_shear, tke_buoy, tke_trans, &
    317321         zu10m, zv10m, zq2m, zustar, zxqsurf, &
    318322         rain_lsc, rain_num, snow_lsc, bils, sens, fder, &
    319323         zxffonte, zxfqcalving, zxfqfonte, zxrunofflic, fluxu, &
    320324         fluxv, zxsnow, qsnow, snowhgt, to_ice, &
    321          sissnow, runoff, albsol3_lic, evap_pot, &
     325! SN runoff_diag
     326         sissnow, runoff, runoff_diag, albsol3_lic, evap_pot, &
    322327         t2m, fluxt, fluxlat, fsollw, fsolsw, &
    323328         wfbils, wfevap, &
    … …  
    367372         ql_seri, qs_seri, qbs_seri, tr_seri, qbs_seri,&
    368373         zphi, u_seri, v_seri, omega, cldfra, &
    369          rneb, rnebjn, rneblsvol, zx_rh, zx_rhl, zx_rhi, &
    370          pfraclr, pfracld,  &
     374         rneb, rnebjn, rneblsvol,  &
     375         zx_rh, zx_rhl, zx_rhi, &
     376         pfraclr, pfracld, cldfraliq, sigma2_icefracturb, mean_icefracturb, &
    371377         qraindiag, qsnowdiag, dqreva, dqssub, &
    372378         dqrauto,dqrcol,dqrmelt,dqrfreez, &
    … …  
    382388         d_t_lscst, d_q_lscth, d_q_lscst, plul_th, &
    383389         plul_st, d_t_vdf, d_t_diss, d_q_vdf, d_q_eva, &
    384          d_t_bs, d_q_bs, d_qbs_bs, d_qbs_vdf, &
     390         d_t_bsss, d_q_bsss, d_qbs_bsss, d_qbs_vdf, &
    385391         zw2, fraca, zmax_th, d_q_ajsb, d_t_ec, d_u_vdf, &
    386392         d_v_vdf, d_u_oro, d_v_oro, d_t_oro, d_u_lif, &
    … …  
    395401        d_xt_ajs, d_xt_ajsb, &
    396402        d_xt_prod_nucl,d_xt_cosmo,d_xt_decroiss, &
     403        xtrunoff_diag, &
    397404#endif
    398405         ep, epmax_diag, &  ! epmax_cape
    … …  
    416423         budg_ocs_to_so2, budg_so2_to_h2so4, budg_h2so4_to_part, &
    417424         surf_PM25_sulf, tau_strat_550, tausum_strat, &
    418          vsed_aer, tau_strat_1020, f_r_wet
     425         vsed_aer, tau_strat_1020, f_r_wet, &
     426         SAD_sulfate, reff_sulfate, sulfmmr, nd_mode, sulfmmr_mode
    419427#endif
    420428
    … …  
    449457    USE indice_sol_mod, ONLY: nbsrf
    450458#ifdef ISO
    451     USE isotopes_mod, ONLY: iso_HTO
     459    USE isotopes_mod, ONLY: iso_HTO, isoName
    452460#endif
    453461    USE geometry_mod, ONLY: cell_area, latitude_deg, longitude_deg
    … …  
    530538    CHARACTER(LEN=maxlen) :: unt
    531539#endif
     540
     541#ifdef ISO
     542    CHARACTER(LEN=maxlen) :: outiso
     543#endif
     544
    532545    REAL,DIMENSION(klon,klev) :: z, dz
    533546    REAL,DIMENSION(klon)      :: zrho, zt
    … …  
    13101323
    13111324       ENDDO
    1312        
    1313                
     1325
     1326
    13141327        IF (iflag_pbl > 1) THEN
    13151328          zx_tmp_fi3d=0.
    … …  
    13231336          ENDIF
    13241337         
    1325           CALL histwrite_phy(o_tke_dissip, zx_tmp_fi3d)   
     1338          CALL histwrite_phy(o_tke_dissip, zx_tmp_fi3d)   
     1339
     1340          zx_tmp_fi3d=0.
     1341          IF (vars_defined) THEN
     1342             DO nsrf=1,nbsrf
     1343                DO k=1,klev
     1344                   zx_tmp_fi3d(:,k)=zx_tmp_fi3d(:,k) &
     1345                        +pctsrf(:,nsrf)*tke_shear(:,k,nsrf)
     1346                ENDDO
     1347             ENDDO
     1348          ENDIF
     1349
     1350          CALL histwrite_phy(o_tke_shear, zx_tmp_fi3d)
     1351
     1352          zx_tmp_fi3d=0.
     1353          IF (vars_defined) THEN
     1354             DO nsrf=1,nbsrf
     1355                DO k=1,klev
     1356                   zx_tmp_fi3d(:,k)=zx_tmp_fi3d(:,k) &
     1357                        +pctsrf(:,nsrf)*tke_buoy(:,k,nsrf)
     1358                ENDDO
     1359             ENDDO
     1360          ENDIF
     1361
     1362          CALL histwrite_phy(o_tke_buoy, zx_tmp_fi3d)
     1363
     1364
     1365          zx_tmp_fi3d=0.
     1366          IF (vars_defined) THEN
     1367             DO nsrf=1,nbsrf
     1368                DO k=1,klev
     1369                   zx_tmp_fi3d(:,k)=zx_tmp_fi3d(:,k) &
     1370                        +pctsrf(:,nsrf)*tke_trans(:,k,nsrf)
     1371                ENDDO
     1372             ENDDO
     1373          ENDIF
     1374
     1375          CALL histwrite_phy(o_tke_trans, zx_tmp_fi3d)
     1376
    13261377       ENDIF
    13271378
    … …  
    18141865          CALL histwrite_phy(o_tau_strat_550, tausum_strat(:,1))
    18151866          CALL histwrite_phy(o_tau_strat_1020, tausum_strat(:,2))
     1867          CALL histwrite_phy(o_SAD_sulfate, SAD_sulfate)
     1868          CALL histwrite_phy(o_reff_sulfate, reff_sulfate)
     1869          CALL histwrite_phy(o_sulfmmr, sulfmmr)
     1870          ! All BINs fields
     1871          DO itr = 1, nbtr_bin
     1872             CALL histwrite_phy(o_nd_mode(itr), nd_mode(:,:,itr))
     1873             CALL histwrite_phy(o_sulfmmr_mode(itr), sulfmmr_mode(:,:,itr))
     1874          ENDDO !--itr
    18161875       ENDIF
    18171876#endif
    … …  
    20052064           CALL histwrite_phy(o_pfraclr, pfraclr)
    20062065           CALL histwrite_phy(o_pfracld, pfracld)
     2066           CALL histwrite_phy(o_cldfraliq, cldfraliq)
     2067           CALL histwrite_phy(o_sigma2_icefracturb, sigma2_icefracturb)
     2068           CALL histwrite_phy(o_mean_icefracturb, mean_icefracturb)
    20072069           IF (ok_poprecip) THEN
    20082070           CALL histwrite_phy(o_qrainlsc, qraindiag)
    … …  
    23062368          IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_qbs_vdf(1:klon,1:klev)/pdtphys
    23072369          CALL histwrite_phy(o_dqbsvdf, zx_tmp_fi3d)
    2308           IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_qbs_bs(1:klon,1:klev)/pdtphys
     2370          IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_qbs_bsss(1:klon,1:klev)/pdtphys
    23092371          CALL histwrite_phy(o_dqbsbs, zx_tmp_fi3d)
    2310           IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_bs(1:klon,1:klev)/pdtphys
     2372          IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_bsss(1:klon,1:klev)/pdtphys
    23112373          CALL histwrite_phy(o_dqbs, zx_tmp_fi3d)
    2312           IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_bs(1:klon,1:klev)/pdtphys
     2374          IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_bsss(1:klon,1:klev)/pdtphys
    23132375          CALL histwrite_phy(o_dtbs, zx_tmp_fi3d)
    23142376       ENDIF
    … …  
    28102872       end if
    28112873
     2874    !! runoff land bucket - ajout S. Nguyen 23 07 2024
     2875    CALL histwrite_phy(o_runoff_diag, runoff_diag)
     2876
    28122877#ifdef ISO
    2813     do ixt=1,ntiso
    2814 !        write(*,*) 'ixt'
     2878    !write(*,*) 'tmp phys_output_write: ntiso=',ntiso
     2879
     2880    DO ixt = 1, ntiso
     2881        !write(*,*) 'ixt,o_xtovap(ixt)=',ixt,o_xtovap(ixt)
    28152882        IF (vars_defined) zx_tmp_fi2d(:) = xtrain_fall(ixt,:) + xtsnow_fall(ixt,:)
    28162883        CALL histwrite_phy(o_xtprecip(ixt), zx_tmp_fi2d)
    … …  
    28242891        CALL histwrite_phy(o_xtovap(ixt),  xt_seri(ixt,:,:))
    28252892        CALL histwrite_phy(o_xtoliq(ixt), xtl_seri(ixt,:,:))
     2893
     2894        !! runoff land bucket - ajout S. Nguyen 25 avril 2024
     2895        CALL histwrite_phy(o_xtrunoff_diag(ixt), xtrunoff_diag(ixt,:))
     2896
    28262897
    28272898        DO nsrf = 1, nbsrf ! ajout Camille 8 mai 2023
    … …  
    28842955          ENDDO !  iff
    28852956#endif
     2957
     2958!SN activate water isotopes present in tracer.def
     2959#ifdef ISO
     2960          DO ixt = 1, ntiso
     2961            outiso = TRIM(isoName(ixt))
     2962            i = INDEX(outiso, '_', .TRUE.)
     2963            outiso = outiso(1:i-1)//outiso(i+1:LEN_TRIM(outiso))
     2964
     2965            CALL xios_set_fieldgroup_attr("iso2D_"//TRIM(outiso), enabled=.TRUE.)
     2966            CALL xios_set_fieldgroup_attr("iso3D_"//TRIM(outiso), enabled=.TRUE.)
     2967
     2968          ENDDO
     2969#endif
    28862970          !On finalise l'initialisation:
    28872971          IF (using_xios) CALL wxios_closedef()

  • LMDZ6/branches/cirrus/libf/phylmd/phys_state_var_mod.F90

    r4951 r5202  
    8787!$OMP THREADPRIVATE(prw_ancien, prlw_ancien, prsw_ancien, prbsw_ancien)
    8888#ifdef ISO
    89       REAL, ALLOCATABLE, SAVE :: xt_ancien(:,:,:),xtl_ancien(:,:,:),xts_ancien(:,:,:)
    90 !$OMP THREADPRIVATE(xt_ancien,xtl_ancien,xts_ancien)
     89      REAL, ALLOCATABLE, SAVE :: xt_ancien(:,:,:),xtl_ancien(:,:,:),xts_ancien(:,:,:), &
     90              xtbs_ancien(:,:,:)
     91!$OMP THREADPRIVATE(xt_ancien,xtl_ancien,xts_ancien,xtbs_ancien)
    9192#endif
    9293      REAL, ALLOCATABLE, SAVE :: u_ancien(:,:), v_ancien(:,:)
    … …  
    760761      ALLOCATE(xtl_ancien(ntraciso,klon,klev))
    761762      ALLOCATE(xts_ancien(ntraciso,klon,klev))
     763      ALLOCATE(xtbs_ancien(ntraciso,klon,klev))
    762764      ALLOCATE(xtrain_fall(ntraciso,klon))
    763765      ALLOCATE(xtsnow_fall(ntraciso,klon))
    … …  
    950952#ifdef ISO   
    951953      DEALLOCATE(xtsol,fxtevap) 
    952       DEALLOCATE(xt_ancien,xtl_ancien,xts_ancien, fxtd, wake_deltaxt)
     954      DEALLOCATE(xt_ancien,xtl_ancien,xts_ancien,xtbs_ancien, fxtd, wake_deltaxt)
    953955      DEALLOCATE(xtrain_fall, xtsnow_fall, xtrain_con, xtsnow_con)
    954956#ifdef ISOTRAC

  • LMDZ6/branches/cirrus/libf/phylmd/physiq_mod.F90

    r4951 r5202  
    1 !
     1
    22! $Id$
    33!
    … …  
    184184       d_ts, &
    185185       !
    186        d_t_bs,d_q_bs,d_qbs_bs, &
     186       d_t_bsss,d_q_bsss,d_qbs_bsss, &
    187187       !
    188188!       d_t_oli,d_u_oli,d_v_oli, &
    … …  
    333333       !
    334334       rneblsvol, &
    335        pfraclr,pfracld, &
    336        distcltop,temp_cltop, &
     335       pfraclr, pfracld, cldfraliq, sigma2_icefracturb, mean_icefracturb, &
     336       distcltop, temp_cltop, &
    337337       !-- LSCP - condensation and ice supersaturation variables
    338338       qsub, qissr, qcld, subfra, issrfra, gamma_cond, ratio_qi_qtot, &
    … …  
    909909    REAL zdtime, zdtime1, zdtime2, zlongi
    910910    !
    911     REAL qcheck
    912911    REAL z_avant(klon), z_apres(klon), z_factor(klon)
    913912    LOGICAL zx_ajustq
    … …  
    11331132    REAL, DIMENSION(klon,klev)     :: mass_solu_aero_pi
    11341133    ! - " - (pre-industrial value)
     1134    REAL, DIMENSION(klon,klev,naero_tot) :: m_allaer
    11351135
    11361136    ! Parameters
    … …  
    12711271
    12721272    !--OB variables for mass fixer (hard coded for now)
    1273     LOGICAL, PARAMETER :: mass_fixer=.FALSE.
    12741273    REAL qql1(klon),qql2(klon),corrqql
    12751274
    … …  
    14011400       IF (read_climoz>=1 .AND. create_etat0_limit .AND. grid_type==unstructured) &
    14021401          CALL regr_horiz_time_climoz(read_climoz,ok_daily_climoz)
    1403 
    1404 #ifdef REPROBUS
    1405        CALL strataer_init
    1406        CALL strataer_emiss_init
    1407 #endif
    1408 
    1409 #ifdef CPP_StratAer
    1410        CALL strataer_init
    1411        CALL strataer_nuc_init
    1412        CALL strataer_emiss_init
    1413 #endif
    14141402
    14151403       print*, '================================================='
    … …  
    15271515       iflag_phytrac = 1 ! by default we do want to call phytrac
    15281516       CALL getin_p('iflag_phytrac',iflag_phytrac)
     1517
     1518       ok_water_mass_fixer=.FALSE.  ! OB: by default we do not apply the mass fixer
     1519       CALL getin_p('ok_water_mass_fixer',ok_water_mass_fixer)
    15291520#ifdef CPP_Dust
    15301521       IF (iflag_phytrac.EQ.0) THEN
    … …  
    15511542       WRITE(lunout,*) 'fl_cor_ebil=',        fl_cor_ebil
    15521543       WRITE(lunout,*) 'iflag_phytrac=',      iflag_phytrac
     1544       WRITE(lunout,*) 'ok_water_mass_fixer=',ok_water_mass_fixer
    15531545       WRITE(lunout,*) 'NVM=',                nvm_lmdz
    15541546
    … …  
    18021794      IF (.NOT. create_etat0_limit) CALL init_readaerosolstrato(flag_aerosol_strat)  !! initialise aero strato from file for XIOS interpolation (unstructured_grid)
    18031795
     1796      ! A.I : Initialisations pour le 1er passage a Cosp
    18041797      if (ok_cosp) then
     1798
    18051799#ifdef CPP_COSP
    1806         ! A.I : Initialisations pour le 1er passage a Cosp
    18071800        CALL ini_COSP(ref_liq_cosp0,ref_ice_cosp0,pctsrf_cosp0,zu10m_cosp0,zv10m_cosp0, &
    18081801               zxtsol_cosp0,zx_rh_cosp0,cldfra_cosp0,rnebcon_cosp0,flwc_cosp0, &
    … …  
    18241817#endif
    18251818
    1826 #ifdef CPP_COSP2
    1827         CALL ini_COSP(ref_liq_cosp0,ref_ice_cosp0,pctsrf_cosp0,zu10m_cosp0,zv10m_cosp0, &
     1819#ifdef CPP_COSPV2
     1820          CALL ini_COSP(ref_liq_cosp0,ref_ice_cosp0,pctsrf_cosp0,zu10m_cosp0,zv10m_cosp0, &
    18281821               zxtsol_cosp0,zx_rh_cosp0,cldfra_cosp0,rnebcon_cosp0,flwc_cosp0, &
    18291822               fiwc_cosp0,prfl_cosp0,psfl_cosp0,pmflxr_cosp0,pmflxs_cosp0, &
    18301823               mr_ozone_cosp0,cldtau_cosp0,cldemi_cosp0,JrNt_cosp0)
    1831      
    1832         CALL phys_cosp2(itap,phys_tstep,freq_cosp, &
    1833                ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, &
    1834                ecrit_mth,ecrit_day,ecrit_hf, ok_all_xml, missing_val, &
    1835                klon,klev,longitude_deg,latitude_deg,presnivs,overlap, &
    1836                JrNt,ref_liq,ref_ice, &
    1837                pctsrf(:,is_ter)+pctsrf(:,is_lic), &
    1838                zu10m,zv10m,pphis, &
    1839                zphi,paprs(:,1:klev),pplay,zxtsol,t_seri, &
    1840                qx(:,:,ivap),zx_rh,cldfra,rnebcon,flwc,fiwc, &
    1841                prfl(:,1:klev),psfl(:,1:klev), &
    1842                pmflxr(:,1:klev),pmflxs(:,1:klev), &
    1843                mr_ozone,cldtau, cldemi)
    1844 #endif
    1845 
    1846 #ifdef CPP_COSPV2
     1824
    18471825          CALL lmdz_cosp_interface(itap,phys_tstep,freq_cosp, &
    18481826               ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, &
    18491827               ecrit_mth,ecrit_day,ecrit_hf, ok_all_xml, missing_val, &
    18501828               klon,klev,longitude_deg,latitude_deg,presnivs,overlap, &
    1851                JrNt,ref_liq,ref_ice, &
    1852                pctsrf(:,is_ter)+pctsrf(:,is_lic), &
    1853                zu10m,zv10m,pphis, &
    1854                phicosp,paprs(:,1:klev),pplay,zxtsol,t_seri, &
    1855                qx(:,:,ivap),zx_rh,cldfra,rnebcon,flwc,fiwc, &
    1856                prfl(:,1:klev),psfl(:,1:klev), &
    1857                pmflxr(:,1:klev),pmflxs(:,1:klev), &
    1858                mr_ozone,cldtau, cldemi)
     1829               JrNt_cosp0,ref_liq_cosp0,ref_ice_cosp0, &
     1830               pctsrf_cosp0, &
     1831               zu10m_cosp0,zv10m_cosp0,pphis, &
     1832               pphi,paprs(:,1:klev),pplay,zxtsol_cosp0,t, &
     1833               qx(:,:,ivap),zx_rh_cosp0,cldfra_cosp0,rnebcon_cosp0,flwc_cosp0,fiwc_cosp0, &
     1834               prfl_cosp0(:,1:klev),psfl_cosp0(:,1:klev), &
     1835               pmflxr_cosp0(:,1:klev),pmflxs_cosp0(:,1:klev), &
     1836               mr_ozone_cosp0,cldtau_cosp0, cldemi_cosp0)
    18591837#endif
    1860       ENDIF
     1838      endif  ! ok_cosp
    18611839
    18621840       !
    … …  
    19081886       !
    19091887!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1888#ifdef REPROBUS
     1889       CALL strataer_init
     1890       CALL strataer_emiss_init
     1891#endif
     1892
     1893#ifdef CPP_StratAer
     1894       CALL strataer_init
     1895       CALL strataer_nuc_init
     1896       CALL strataer_emiss_init
     1897#endif
    19101898
    19111899#ifdef CPP_Dust
    … …  
    19481936       ELSE IF (klon_glo==1) THEN
    19491937          pbl_tke(:,:,is_ave) = 0.
     1938          pbl_eps(:,:,is_ave) = 0.
    19501939          DO nsrf=1,nbsrf
    19511940            DO k = 1,klev+1
    19521941                 pbl_tke(:,k,is_ave) = pbl_tke(:,k,is_ave) &
    19531942                     +pctsrf(:,nsrf)*pbl_tke(:,k,nsrf)
     1943                 pbl_eps(:,k,is_ave) = pbl_eps(:,k,is_ave) &
     1944                     +pctsrf(:,nsrf)*pbl_eps(:,k,nsrf)
    19541945            ENDDO
    19551946          ENDDO
    … …  
    19571948          pbl_tke(:,:,is_ave) = 0. !ym missing init : maybe must be initialized in the same way that for klon_glo==1 ??
    19581949!>jyg
     1950          pbl_eps(:,:,is_ave) = 0.
    19591951       ENDIF
    19601952       !IM begin
    … …  
    24702462    ENDDO
    24712463    !
    2472     !--OB mass fixer
    2473     IF (mass_fixer) THEN
     2464    !--OB water mass fixer
     2465    IF (ok_water_mass_fixer) THEN
    24742466    !--store initial water burden
    24752467    qql1(:)=0.0
    … …  
    30243016    ! Blowing snow sublimation and sedimentation
    30253017
    3026     d_t_bs(:,:)=0.
    3027     d_q_bs(:,:)=0.
    3028     d_qbs_bs(:,:)=0.
     3018    d_t_bsss(:,:)=0.
     3019    d_q_bsss(:,:)=0.
     3020    d_qbs_bsss(:,:)=0.
    30293021    bsfl(:,:)=0.
    30303022    bs_fall(:)=0.
    … …  
    30323024
    30333025     CALL call_blowing_snow_sublim_sedim(klon,klev,phys_tstep,t_seri,q_seri,qbs_seri,pplay,paprs, &
    3034                                         d_t_bs,d_q_bs,d_qbs_bs,bsfl,bs_fall)
     3026                                        d_t_bsss,d_q_bsss,d_qbs_bsss,bsfl,bs_fall)
    30353027
    30363028     CALL add_phys_tend &
    3037                (du0,dv0,d_t_bs,d_q_bs,dql0,dqi0,d_qbs_bs,paprs,&
    3038                'bs',abortphy,flag_inhib_tend,itap,0)
     3029               (du0,dv0,d_t_bsss,d_q_bsss,dql0,dqi0,d_qbs_bsss,paprs,&
     3030               'bsss',abortphy,flag_inhib_tend,itap,0)
    30393031
    30403032    ENDIF
    … …  
    30793071       ENDDO
    30803072    ENDDO
    3081     IF (check) THEN
    3082        za = qcheck(klon,klev,paprs,q_seri,ql_seri,cell_area)
    3083        WRITE(lunout,*) "avantcon=", za
    3084     ENDIF
    3085     zx_ajustq = .FALSE.
    3086     IF (iflag_con.EQ.2) zx_ajustq=.TRUE.
    3087     IF (zx_ajustq) THEN
    3088        DO i = 1, klon
    3089           z_avant(i) = 0.0
    3090        ENDDO
    3091        DO k = 1, klev
    3092           DO i = 1, klon
    3093              z_avant(i) = z_avant(i) + (q_seri(i,k)+ql_seri(i,k)) &
    3094                   *(paprs(i,k)-paprs(i,k+1))/RG
    3095           ENDDO
    3096        ENDDO
    3097     ENDIF
    30983073
    30993074    ! Calcule de vitesse verticale a partir de flux de masse verticale
    … …  
    34883463       CALL writefield_phy('q_seri',q_seri,nbp_lev)
    34893464    ENDIF
    3490 
    3491     IF (check) THEN
    3492        za = qcheck(klon,klev,paprs,q_seri,ql_seri,cell_area)
    3493        WRITE(lunout,*)"aprescon=", za
    3494        zx_t = 0.0
    3495        za = 0.0
    3496        DO i = 1, klon
    3497           za = za + cell_area(i)/REAL(klon)
    3498           zx_t = zx_t + (rain_con(i)+ &
    3499                snow_con(i))*cell_area(i)/REAL(klon)
    3500        ENDDO
    3501        zx_t = zx_t/za*phys_tstep
    3502        WRITE(lunout,*)"Precip=", zx_t
    3503     ENDIF
    3504     IF (zx_ajustq) THEN
    3505        DO i = 1, klon
    3506           z_apres(i) = 0.0
    3507        ENDDO
    3508        DO k = 1, klev
    3509           DO i = 1, klon
    3510              z_apres(i) = z_apres(i) + (q_seri(i,k)+ql_seri(i,k)) &
    3511                   *(paprs(i,k)-paprs(i,k+1))/RG
    3512           ENDDO
    3513        ENDDO
    3514        DO i = 1, klon
    3515           z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*phys_tstep) &
    3516                /z_apres(i)
    3517        ENDDO
    3518        DO k = 1, klev
    3519           DO i = 1, klon
    3520              IF (z_factor(i).GT.(1.0+1.0E-08) .OR. &
    3521                   z_factor(i).LT.(1.0-1.0E-08)) THEN
    3522                 q_seri(i,k) = q_seri(i,k) * z_factor(i)
    3523              ENDIF
    3524           ENDDO
    3525        ENDDO
    3526     ENDIF
    3527     zx_ajustq=.FALSE.
    35283465
    35293466    !
    … …  
    39213858
    39223859    CALL lscp(klon,klev,phys_tstep,missing_val,paprs,pplay, &
    3923          t_seri, q_seri,ptconv,ratqs, &
     3860         t_seri, q_seri,qs_ancien,ptconv,ratqs, &
    39243861         d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, rneblsvol, &
    3925          pfraclr,pfracld, &
     3862         pfraclr, pfracld, cldfraliq, sigma2_icefracturb, mean_icefracturb, &
    39263863         radocond, picefra, rain_lsc, snow_lsc, &
    39273864         frac_impa, frac_nucl, beta_prec_fisrt, &
    39283865         prfl, psfl, rhcl,  &
    39293866         zqasc, fraca,ztv,zpspsk,ztla,zthl,iflag_cld_th, &
    3930          iflag_ice_thermo, distcltop, temp_cltop, cell_area, &
    3931          cf_seri, rvc_seri, u_seri, v_seri, pbl_eps(:,:,is_ave), &
     3867         iflag_ice_thermo, distcltop, temp_cltop,   &
     3868         pbl_tke(:,:,is_ave), pbl_eps(:,:,is_ave), &
     3869         cell_area, &
     3870         cf_seri, rvc_seri, u_seri, v_seri, &
    39323871         qsub, qissr, qcld, subfra, issrfra, gamma_cond, ratio_qi_qtot, &
    39333872         dcf_sub, dcf_con, dcf_mix, dqi_adj, dqi_sub, dqi_con, dqi_mix, &
    … …  
    40213960       ENDIF
    40223961
    4023     ENDIF
    4024 
    4025     IF (check) THEN
    4026        za = qcheck(klon,klev,paprs,q_seri,ql_seri,cell_area)
    4027        WRITE(lunout,*)"apresilp=", za
    4028        zx_t = 0.0
    4029        za = 0.0
    4030        DO i = 1, klon
    4031           za = za + cell_area(i)/REAL(klon)
    4032           zx_t = zx_t + (rain_lsc(i) &
    4033                + snow_lsc(i))*cell_area(i)/REAL(klon)
    4034        ENDDO
    4035        zx_t = zx_t/za*phys_tstep
    4036        WRITE(lunout,*)"Precip=", zx_t
    40373962    ENDIF
    40383963
    … …  
    44054330                  flag_aerosol, flag_bc_internal_mixture, itap, jD_cur-jD_ref, &
    44064331                  pdtphys, pplay, paprs, t_seri, rhcl, presnivs,  &
    4407                   tr_seri, mass_solu_aero, mass_solu_aero_pi) 
     4332                  tr_seri, mass_solu_aero, mass_solu_aero_pi, m_allaer) 
    44084333#else
    44094334                abort_message='You should compile with -rad ecrad if running with iflag_rrtm=2'
    … …  
    46514576               ! Rajoute par OB pour RRTM
    46524577               tau_aero_lw_rrtm, &
    4653                cldtaupirad, &
     4578               cldtaupirad, m_allaer, &
    46544579!              zqsat, flwcrad, fiwcrad, &
    46554580               zqsat, flwc, fiwc, &
    … …  
    47294654                                ! Rajoute par OB pour RRTM
    47304655                     tau_aero_lw_rrtm, &
    4731                      cldtaupi, &
     4656                     cldtaupi, m_allaer, &
    47324657!                    zqsat, flwcrad, fiwcrad, &
    47334658                     zqsat, flwc, fiwc, &
    … …  
    47754700                     tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm, &
    47764701                     tau_aero_lw_rrtm, &
    4777                      cldtaupi, &
     4702                     cldtaupi, m_allaer, &
    47784703                     zqsat, flwc, fiwc, &
    47794704                     ref_liq, ref_ice, ref_liq_pi, ref_ice_pi, &
    … …  
    55085433    !--currently flag is turned off
    55095434    !==================================================================
    5510     IF (mass_fixer) THEN
     5435    IF (ok_water_mass_fixer) THEN
    55115436    qql2(:)=0.0
    55125437    DO k = 1, klev

  • LMDZ6/branches/cirrus/libf/phylmd/phystokenc_mod.F90

    r2343 r5202  
    4646! Objet: Ecriture des variables pour transport offline
    4747!
     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.
    4850!======================================================================
    4951

  • LMDZ6/branches/cirrus/libf/phylmd/radlwsw_m.F90

    r4866 r5202  
    2121       tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,& ! rajoute par OB RRTM
    2222       tau_aero_lw_rrtm, &              ! rajoute par C.Kleinschmitt pour RRTM
    23        cldtaupi, &
     23       cldtaupi, m_allaer, &
    2424       qsat, flwc, fiwc, &
    2525       ref_liq, ref_ice, ref_liq_pi, ref_ice_pi, &
    … …  
    8080    ! Besoin pour ECRAD de pctsrf, zmasq, longitude, altitude
    8181#ifdef CPP_ECRAD
    82     USE phys_local_var_mod, ONLY: rhcl, m_allaer
    8382    USE geometry_mod, ONLY: latitude, longitude
    8483    USE phys_state_var_mod, ONLY: pctsrf
    … …  
    247246    REAL,    INTENT(in)  :: ref_liq_pi(klon,klev) ! cloud droplet radius pre-industrial from newmicro
    248247    REAL,    INTENT(in)  :: ref_ice_pi(klon,klev) ! ice crystal radius   pre-industrial from newmicro
     248    REAL,    INTENT(in)  :: m_allaer(klon,klev,naero_tot) ! mass aero
    249249
    250250    CHARACTER(len=512), INTENT(in) :: namelist_ecrad_file
    … …  
    706706             zsollw0(i)=0.
    707707             zsollwdown(i)=0.
     708             ztoplwad0aero(i) = 0.
     709             ztoplwadaero(i) = 0.
    708710          ENDDO
    709711          ! Old radiation scheme, used for AR4 runs

  • LMDZ6/branches/cirrus/libf/phylmd/surf_land_bucket_mod.F90

    r3974 r5202  
    1616       snow, qsol, agesno, tsoil, &
    1717       qsurf, z0_new, alb1_new, alb2_new, evap, &
    18        fluxsens, fluxlat, tsurf_new, dflux_s, dflux_l)
     18       fluxsens, fluxlat, tsurf_new, dflux_s, dflux_l &
     19#ifdef ISO
     20       ,xtprecip_rain, xtprecip_snow,xtspechum, &
     21       xtsnow, xtsol,xtevap,h1, &
     22       runoff_diag,xtrunoff_diag,Rland_ice &
     23#endif           
     24            )
    1925
    2026    USE limit_read_mod
    … …  
    2834    USE mod_phys_lmdz_para
    2935    USE indice_sol_mod
     36#ifdef ISO
     37    use infotrac_phy, ONLY: ntiso,niso
     38    USE isotopes_mod, ONLY: iso_eau, iso_HDO, iso_O18, iso_O17, &
     39        ridicule_qsol
     40    USE isotopes_routines_mod, ONLY: calcul_iso_surf_ter_vectall
     41#ifdef ISOVERIF
     42    USE isotopes_verif_mod, ONLY: errmax,errmaxrel,iso_verif_noNaN, &
     43        iso_verif_aberrant_o17,iso_verif_egalite_choix,iso_verif_egalite
     44#endif
     45#endif
    3046!****************************************************************************************
    3147! Bucket calculations for surface.
    … …  
    5268    REAL, DIMENSION(klon), INTENT(IN)       :: rugoro
    5369    REAL, DIMENSION(klon), INTENT(IN)       :: swnet, lwnet
     70#ifdef ISO
     71    REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtprecip_rain, xtprecip_snow
     72    REAL, DIMENSION(ntiso,klon), INTENT(IN) :: xtspechum   
     73#endif
    5474
    5575! In/Output variables
    … …  
    5878    REAL, DIMENSION(klon), INTENT(INOUT)          :: agesno
    5979    REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
     80#ifdef ISO
     81    REAL, DIMENSION(niso,klon), INTENT(INOUT)       :: xtsnow,xtsol
     82#endif
    6083
    6184! Output variables
    … …  
    6790    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
    6891    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
     92#ifdef ISO
     93    REAL, DIMENSION(ntiso,klon), INTENT(OUT) :: xtevap
     94    REAL, DIMENSION(klon),       INTENT(OUT) :: h1
     95    REAL, DIMENSION(niso,klon),  INTENT(OUT) :: xtrunoff_diag
     96    REAL, DIMENSION(klon),       INTENT(OUT) :: runoff_diag
     97    REAL, DIMENSION(niso,klon),  INTENT(IN)  :: Rland_ice
     98#endif
    6999
    70100! Local variables
    … …  
    78108    REAL, DIMENSION(klon) :: dummy_riverflow,dummy_coastalflow
    79109    INTEGER               :: i
    80 !
    81 !****************************************************************************************
    82 
     110#ifdef ISO
     111    INTEGER               :: ixt
     112    REAL, DIMENSION(niso,klon) :: xtsnow_prec,xtsol_prec
     113    REAL, DIMENSION(klon) :: snow_prec,qsol_prec
     114    REAL, PARAMETER       :: t_coup = 273.15
     115    REAL, DIMENSION(klon) :: fq_fonte_diag
     116    REAL, DIMENSION(klon) :: fqfonte_diag
     117    REAL, DIMENSION(klon) :: snow_evap_diag
     118    REAL, DIMENSION(klon) :: fqcalving_diag
     119    REAL                  :: max_eau_sol_diag 
     120    REAL, DIMENSION(klon) :: run_off_lic_diag
     121    REAL :: coeff_rel_diag
     122#endif
     123!
     124!****************************************************************************************
     125
     126#ifdef ISO
     127#ifdef ISOVERIF
     128        !write(*,*) 'surf_land_bucket 152'
     129        DO i=1,knon
     130          IF (iso_eau > 0) THEN
     131            CALL iso_verif_egalite_choix(precip_snow(i), &
     132     &                                   xtprecip_snow(iso_eau,i),'surf_land_bucket 131', &
     133     &                                   errmax,errmaxrel)
     134            CALL iso_verif_egalite_choix(qsol(i), &
     135     &                                   xtsol(iso_eau,i),'surf_land_bucket 134', &
     136     &                                   errmax,errmaxrel)
     137          ENDIF
     138        ENDDO
     139#endif
     140#ifdef ISOVERIF
     141        DO i=1,knon
     142          DO ixt=1,niso
     143            CALL iso_verif_noNaN(xtsol(ixt,i),'surf_land_mod_bucket 142')
     144          ENDDO !do ixt=1,niso
     145        ENDDO !do i=1,knon
     146        !write(*,*) 'surf_land_bucket 152'
     147#endif
     148#endif
    83149
    84150!
    … …  
    131197         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
    132198   
     199#ifdef ISO
     200   ! verif
     201#ifdef ISOVERIF
     202    !write(*,*) 'surf_land_bucket 211'
     203    DO i=1,knon
     204      IF (iso_eau > 0) THEN
     205        CALL iso_verif_egalite_choix(xtsnow(iso_eau,i), &
     206     &           snow(i),'surf_land_bucket 522', &
     207     &           errmax,errmaxrel)
     208      ENDIF !IF (iso_eau > 0) then
     209    ENDDO !DO i=1,knon
     210#endif
     211   ! end verif
     212#endif         
     213#ifdef ISO
     214    DO i=1,knon
     215      snow_prec(i)=snow(i)
     216      qsol_prec(i)=qsol(i)
     217      DO ixt=1,niso
     218        xtsnow_prec(ixt,i)=xtsnow(ixt,i)
     219        xtsol_prec(ixt,i) =xtsol(ixt,i)
     220      ENDDO !DO ixt=1,niso
     221      ! initialisation:
     222      fqfonte_diag(i)  =0.0
     223      fq_fonte_diag(i) =0.0
     224      snow_evap_diag(i)=0.0
     225    ENDDO !DO i=1,knon
     226#ifdef ISOVERIF
     227    ! write(*,*) 'surf_land_bucket 235'
     228    DO i=1,knon 
     229      IF (iso_eau > 0) THEN
     230        CALL iso_verif_egalite(qsol_prec(i),xtsol_prec(iso_eau,i), &
     231    &                              'surf_land_bucket 141')
     232      ENDIF
     233    ENDDO !DO i=1,knon
     234#endif   
     235#endif   
    133236!
    134237!* Calculate snow height, run_off, age of snow
    … …  
    136239    CALL fonte_neige( knon, is_ter, knindex, dtime, &
    137240         tsurf, precip_rain, precip_snow, &
    138          snow, qsol, tsurf_new, evap)
     241         snow, qsol, tsurf_new, evap &
     242#ifdef ISO   
     243     & ,fq_fonte_diag,fqfonte_diag,snow_evap_diag,fqcalving_diag   &
     244     & ,max_eau_sol_diag,runoff_diag,run_off_lic_diag,coeff_rel_diag   &
     245#endif
     246     &   )
     247
     248#ifdef ISO
     249#ifdef ISOVERIF
     250        DO i=1,knon
     251          DO ixt=1,niso
     252            CALL iso_verif_noNaN(xtsol_prec(ixt,i),'surf_land_burcket 237')
     253          ENDDO
     254        ENDDO
     255#endif
     256#ifdef ISOVERIF
     257        !write(*,*) 'surf_land_bucket 235'
     258        DO i=1,knon
     259          IF (iso_eau > 0) THEN
     260            CALL iso_verif_egalite_choix(qsol_prec(i), &
     261     &                                   xtsol_prec(iso_eau,i),'surf_land_bucket 628', &
     262     &                                   errmax,errmaxrel)
     263            CALL iso_verif_egalite_choix(precip_snow(i), &
     264     &                                   xtprecip_snow(iso_eau,i),'surf_land_bucket 227', &
     265     &                                   errmax,errmaxrel)
     266             ! attention, dans fonte_neige, on modifie snow sans modifier
     267             ! xtsnow
     268             ! c'est fait plus tard dans gestion_neige
     269!            write(*,*) 'surf_land_bucket 287: i=',i
     270!            write(*,*) 'snow(i)=',snow(i)
     271            CALL iso_verif_egalite_choix(xtsnow(iso_eau,i), &
     272     &                                   snow_prec(i),'surf_land_bucket 245', &
     273     &                                   errmax,errmaxrel)
     274          ENDIF 
     275          IF ((iso_O17 > 0).AND.(iso_O18 > 0)) THEN
     276              IF (qsol_prec(i) > ridicule_qsol) THEN
     277                CALL iso_verif_aberrant_o17(xtsol_prec(iso_O17,i)/qsol_prec(i) &
     278     &                                     ,xtsol_prec(iso_O18,i)/qsol_prec(i) &
     279     &                                     ,'surf_land_bucket 642')
     280              ENDIF !IF ((qsol_prec(i) > ridicule_qsol) &
     281          ENDIF !IF ((iso_O17 > 0).AND.(iso_O18 > 0)) THEN
     282        ENDDO  !DO i=1,knon
     283        !write(*,*) 'surf_land_mod 291'
     284        !write(*,*) 'snow_evap_diag(1)=',snow_evap_diag(1)
     285#endif         
     286        CALL calcul_iso_surf_ter_vectall(klon,knon, &
     287     &           evap,snow_evap_diag,snow, &
     288     &           fq_fonte_diag,fqfonte_diag,dtime,precip_rain,xtprecip_rain, &
     289     &           precip_snow,xtprecip_snow, snow_prec,xtsnow_prec, &
     290     &           tsurf_new,xtspechum,pref,spechum,t_coup,u1_lay,v1_lay,p1lay, &
     291     &           qsol,xtsol,qsol_prec,xtsol_prec, &
     292     &           max_eau_sol_diag, &
     293     &           xtevap,xtsnow,h1,runoff_diag,xtrunoff_diag,fqcalving_diag, &
     294     &           knindex,is_ter,run_off_lic_diag,coeff_rel_diag,Rland_ice &
     295     &   )
     296!#ifdef ISOVERIF
     297!        write(*,*) 'surf_land_bucket 303'
     298!#endif
     299#endif
     300
    139301!
    140302!* Calculate the age of snow

  • LMDZ6/branches/cirrus/libf/phylmd/surf_land_mod.F90

    r4526 r5202  
    2020       qsurf, tsurf_new, dflux_s, dflux_l, &
    2121       flux_u1, flux_v1 , &
    22        veget,lai,height)
     22       veget,lai,height &
     23#ifdef ISO
     24       ,xtprecip_rain, xtprecip_snow,xtspechum, &
     25       xtsnow, xtsol,xtevap,h1, &
     26       runoff_diag,xtrunoff_diag,Rland_ice &
     27#endif               
     28               )
    2329
    2430    USE dimphy
    … …  
    5965    USE calcul_fluxs_mod
    6066    USE indice_sol_mod
     67#ifdef ISO
     68    use infotrac_phy, ONLY: ntiso,niso
     69    use isotopes_mod, ONLY: nudge_qsol, iso_eau
     70#ifdef ISOVERIF
     71    use isotopes_verif_mod
     72#endif
     73#endif
     74
    6175    USE print_control_mod, ONLY: lunout
    6276
    … …  
    92106                                                         ! corresponds to previous sollwdown
    93107    REAL, DIMENSION(klon), INTENT(IN)       :: q2m, t2m
    94 
     108#ifdef ISO
     109    REAL, DIMENSION(ntiso,klon), INTENT(IN)       :: xtprecip_rain, xtprecip_snow
     110    REAL, DIMENSION(ntiso,klon), INTENT(IN)       :: xtspechum
     111#endif
    95112! In/Output variables
    96113!****************************************************************************************
    … …  
    98115    REAL, DIMENSION(klon), INTENT(INOUT)          :: agesno
    99116    REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
     117#ifdef ISO
     118    REAL, DIMENSION(niso,klon), INTENT(INOUT)    :: xtsnow, xtsol
     119#endif
    100120
    101121! Output variables
    … …  
    116136    REAL, DIMENSION(klon,nvm_lmdz), INTENT(OUT) :: veget,lai
    117137    REAL, DIMENSION(klon,nvm_lmdz), INTENT(OUT) :: height
     138#ifdef ISO
     139    REAL, DIMENSION(ntiso,klon), INTENT(OUT)      :: xtevap
     140    REAL, DIMENSION(klon), INTENT(OUT)      :: h1
     141    REAL, DIMENSION(niso,klon), INTENT(OUT)      :: xtrunoff_diag
     142    REAL, DIMENSION(klon), INTENT(OUT)      :: runoff_diag
     143    REAL, DIMENSION(niso,klon), INTENT(IN)        :: Rland_ice
     144#endif
    118145
    119146! Local variables
    … …  
    132159!albedo SB <<<
    133160
    134 
     161#ifdef ISO       
     162      real, parameter :: t_coup = 273.15
     163      real, dimension(klon) :: fqfonte_diag
     164      real, dimension(klon) :: snow_evap_diag
     165      real, dimension(klon) :: fqcalving_diag
     166      integer :: ixt
     167#endif
    135168!****************************************************************************************
    136169!Total solid precip
    … …  
    142175ENDIF
    143176!****************************************************************************************
     177#ifdef ISO
     178#ifdef ISOVERIF
     179!        write(*,*) 'surf_land_mod 162'
     180        do i=1,knon
     181          if (iso_eau.gt.0) then
     182            call iso_verif_egalite_choix(precip_snow(i), &
     183     &          xtprecip_snow(iso_eau,i),'surf_land_mod 129', &
     184     &          errmax,errmaxrel)
     185            call iso_verif_egalite_choix(qsol(i), &
     186     &          xtsol(iso_eau,i),'surf_land_mod 139', &
     187     &          errmax,errmaxrel)
     188          endif 
     189        enddo
     190#endif
     191#ifdef ISOVERIF
     192!       write(*,*) 'surf_land 169: ok_veget=',ok_veget
     193        do i=1,knon
     194         do ixt=1,ntiso
     195           call iso_verif_noNaN(xtprecip_snow(ixt,i),'surf_land 146')
     196         enddo
     197        enddo
     198#endif
     199#endif
    144200
    145201
    … …  
    172228       END DO
    173229
     230#ifdef ISO
     231      CALL abort_gcm('surf_land_mod 220','isos pas prevus dans orchidee',1)
     232#endif
    174233       ! temporary for keeping same results using lwdown_m instead of lwdown
    175234       CALL surf_land_orchidee(itime, dtime, date0, knon, &
    … …  
    183242            tsol_rad, tsurf_new, alb1_new, alb2_new, &
    184243            emis_new, z0m, z0h, qsurf, &
    185             veget, lai, height)       
     244            veget, lai, height &
     245!#ifdef ISO
     246!            , xtprecip_rain, xtprecip_snow, xtspechum, xtevap &
     247!#endif
     248            )                 
     249
     250#ifdef ISO
     251#ifdef ISOVERIF
     252     write(*,*) 'surf_land 193: apres surf_land_orchidee'   
     253     do i=1,knon
     254        if (iso_eau.gt.0) then
     255             call iso_verif_egalite_choix(xtevap(iso_eau,i),evap(i), &
     256    &            'surf_land 197',errmax,errmaxrel)
     257        endif !if (iso_eau.gt.0) then     
     258      enddo !do i=1,knon 
     259#endif
     260#endif
    186261! 
    187262!* Add contribution of relief to surface roughness
    … …  
    196271!
    197272!****************************************************************************************
     273#ifdef ISO
     274#ifdef ISOVERIF
     275!       write(*,*) 'surf_land 247'
     276        call iso_verif_egalite_vect1D( &
     277     &           xtsnow,snow,'surf_land_mod 207',niso,klon)
     278#endif
     279#endif
     280
     281#ifdef ISO
     282        if (nudge_qsol.eq.1) then
     283          call surf_land_nudge_qsol(knon,rlat,rlon,qsol,xtsol,knindex)
     284        endif
     285        !write(*,*) 'surf_land 258'
     286#endif
    198287       CALL surf_land_bucket(itime, jour, knon, knindex, debut, dtime,&
    199288            tsurf, p1lay, cdragh, precip_rain, precip_totsnow, temp_air, &
    … …  
    202291            snow, qsol, agesno, tsoil, &
    203292            qsurf, z0m, alb1_new, alb2_new, evap, &
    204             fluxsens, fluxlat, tsurf_new, dflux_s, dflux_l)
     293            fluxsens, fluxlat, tsurf_new, dflux_s, dflux_l &
     294#ifdef ISO
     295            ,xtprecip_rain, xtprecip_snow,xtspechum, &
     296            xtsnow, xtsol,xtevap,h1, &
     297     &      runoff_diag, xtrunoff_diag,Rland_ice &
     298#endif           
     299     &       )
    205300        z0h(1:knon)=z0m(1:knon) ! En attendant mieux
    206301
    … …  
    224319         p1lay, temp_air, &
    225320         flux_u1, flux_v1)
     321
     322#ifdef ISO
     323#ifdef ISOVERIF
     324!     write(*,*) 'surf_land 237: sortie'   
     325      DO i=1,knon
     326        IF (iso_eau >= 0) THEN
     327             call iso_verif_egalite_choix(xtsnow(iso_eau,i),snow(i), &
     328    &            'surf_land 241',errmax,errmaxrel)
     329        ENDIF !if (iso_eau.gt.0) then     
     330      ENDDO !do i=1,knon 
     331#endif
     332#endif
    226333
    227334!albedo SB >>>
    … …  
    248355   
    249356  END SUBROUTINE surf_land
     357
     358
     359#ifdef ISO
     360  SUBROUTINE surf_land_nudge_qsol(knon,rlat,rlon,qsol,xtsol,knindex)
     361
     362    USE dimphy   
     363    USE infotrac_phy, ONLY: niso
     364    USE isotopes_mod, ONLY: region_nudge_qsol   
     365    INTEGER, INTENT(IN)                       :: knon         
     366    REAL, DIMENSION(klon), INTENT(IN)         :: rlon, rlat
     367    REAL, DIMENSION(klon), INTENT(INOUT)      :: qsol
     368    INTEGER, DIMENSION(klon), INTENT(IN)      :: knindex   
     369    REAL, DIMENSION(niso,klon), INTENT(INOUT) :: xtsol
     370    REAL :: lat_min_nudge_qsol,lat_max_nudge_qsol
     371    REAL :: lon_min_nudge_qsol,lon_max_nudge_qsol
     372    INTEGER :: i,ixt
     373    REAL :: qsol_new
     374
     375    IF (region_nudge_qsol == 1) THEN
     376        ! Aamzonie du Sud
     377        lat_min_nudge_qsol=-15.0
     378        lat_max_nudge_qsol=-5.0
     379        lon_min_nudge_qsol=-70.0
     380        lon_max_nudge_qsol=-50.0
     381    ELSE IF (region_nudge_qsol == 2) THEN
     382        ! Aamzonie du Nord
     383        lat_min_nudge_qsol=-5.0
     384        lat_max_nudge_qsol=5.0
     385        lon_min_nudge_qsol=-70.0
     386        lon_max_nudge_qsol=-50.0
     387    ELSE
     388        WRITE(*,*) 'surf_land 298: cas pas prevu'
     389        WRITE(*,*) 'region_nudge_qsol=',region_nudge_qsol
     390        stop
     391    ENDIF
     392
     393!    write(*,*) 'surf_land 314: knon=',knon
     394!    write(*,*) 'rlat=',rlat
     395!    write(*,*) 'rlon=',rlon
     396!    write(*,*) 'region_nudge_qsol=',region_nudge_qsol
     397
     398    DO i=1,knon
     399      IF ((rlat(knindex(i)) >= lat_min_nudge_qsol).and. &
     400  &       (rlat(knindex(i)) <= lat_max_nudge_qsol).and. &
     401  &       (rlon(knindex(i)) >= lon_min_nudge_qsol).and. &
     402  &       (rlon(knindex(i)) <= lon_max_nudge_qsol)) THEN
     403!        write(*,*) 'surf_land 324: bon domaine: rlat,rlon,qsol=', &
     404!  &             rlat(knindex(i)),rlon(knindex(i)),qsol(knindex(i))
     405        qsol_new=qsol(i)
     406        IF (region_nudge_qsol == 1) THEN   
     407           qsol_new=max(qsol(i),50.0)   
     408        ELSE IF (region_nudge_qsol == 2) THEN     
     409           qsol_new=max(qsol(i),120.0)
     410        ELSE !if (region_nudge_qsol.eq.1) then
     411           WRITE(*,*) 'surf_land 317: cas pas prevu'
     412           WRITE(*,*) 'region_nudge_qsol=',region_nudge_qsol
     413           STOP
     414        ENDIF !if (region_nudge_qsol.eq.1) then
     415        IF (qsol(i) > 0.0) THEN
     416           DO ixt=1,niso
     417              xtsol(ixt,i)=xtsol(ixt,i)*qsol_new/qsol(i)
     418           ENDDO
     419        ELSE !IF (qsol(i) > 0.0) THEN
     420           DO ixt=1,niso
     421             xtsol(ixt,i)=0.0
     422           ENDDO
     423        ENDIF !IF (qsol(i) > 0.0) THEN
     424        qsol(i)=qsol_new
     425        WRITE(*,*) 'surf_land 346: qsol_new=',qsol(i)     
     426     ENDIF ! if ((rlat(i).ge.lat_min_nudge_qsol).and.
     427  ENDDO !DO i=1,knon
     428
     429  END SUBROUTINE surf_land_nudge_qsol
     430#endif
     431
    250432!
    251433!****************************************************************************************

  • LMDZ6/branches/cirrus/libf/phylmd/surf_landice_mod.F90

    r4916 r5202  
    2323       snowhgt, qsnow, to_ice, sissnow, &
    2424       alb3, runoff, &
    25        flux_u1, flux_v1)
     25       flux_u1, flux_v1 &
     26#ifdef ISO
     27         &      ,xtprecip_rain, xtprecip_snow,xtspechum,Rland_ice &
     28         &      ,xtsnow,xtsol,xtevap &
     29#endif               
     30           &    )
    2631
    2732    USE dimphy
    … …  
    3338    USE phys_local_var_mod, ONLY : zxrhoslic, zxustartlic, zxqsaltlic
    3439    USE phys_output_var_mod, ONLY : snow_o,zfra_o
     40#ifdef ISO   
     41    USE fonte_neige_mod,  ONLY : xtrun_off_lic
     42    USE infotrac_phy,     ONLY : ntiso,niso
     43    USE isotopes_routines_mod, ONLY: calcul_iso_surf_lic_vectall
     44#ifdef ISOVERIF
     45    USE isotopes_mod, ONLY: iso_eau,ridicule
     46    USE isotopes_verif_mod
     47#endif
     48#endif
     49 
    3550!FC
    3651    USE ioipsl_getin_p_mod, ONLY : getin_p
    … …  
    6883    REAL, DIMENSION(klon), INTENT(IN)             :: rugoro
    6984    REAL, DIMENSION(klon,nbsrf), INTENT(IN)       :: pctsrf
     85#ifdef ISO
     86    REAL, DIMENSION(ntiso,klon), INTENT(IN)       :: xtprecip_rain, xtprecip_snow
     87    REAL, DIMENSION(ntiso,klon), INTENT(IN)       :: xtspechum
     88#endif
     89
    7090
    7191    LOGICAL,  INTENT(IN)                          :: debut   !true if first step
    … …  
    85105    REAL, DIMENSION(klon), INTENT(INOUT)          :: agesno
    86106    REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
     107#ifdef ISO
     108    REAL, DIMENSION(niso,klon), INTENT(INOUT)     :: xtsnow, xtsol
     109    REAL, DIMENSION(niso,klon), INTENT(INOUT)     :: Rland_ice
     110#endif
     111
    87112
    88113! Output variables
    … …  
    108133    REAL, DIMENSION(klon), INTENT(OUT)           :: sissnow
    109134    REAL, DIMENSION(klon), INTENT(OUT)           :: runoff  !Land ice runoff
     135#ifdef ISO
     136    REAL, DIMENSION(ntiso,klon), INTENT(OUT)     :: xtevap     
     137!    real, DIMENSION(niso,klon) :: xtrun_off_lic_0_diag ! est une variable globale de
     138!    fonte_neige
     139#endif
    110140 
    111141
    … …  
    120150    REAL, DIMENSION(klon)    :: fqfonte,ffonte
    121151    REAL, DIMENSION(klon)    :: run_off_lic_frac
     152#ifdef ISO       
     153    REAL, PARAMETER          :: t_coup = 273.15
     154    REAL, DIMENSION(klon)    :: fqfonte_diag
     155    REAL, DIMENSION(klon)    :: fq_fonte_diag
     156    REAL, DIMENSION(klon)    ::  snow_evap_diag
     157    REAL, DIMENSION(klon)    ::  fqcalving_diag
     158    REAL max_eau_sol_diag 
     159    REAL, DIMENSION(klon)    ::  runoff_diag
     160    REAL, DIMENSION(klon)    ::    run_off_lic_diag
     161    REAL                     ::  coeff_rel_diag
     162    INTEGER                  :: ixt
     163    REAL, DIMENSION(niso,klon) :: xtsnow_prec,xtsol_prec
     164    REAL, DIMENSION(klon) :: snow_prec,qsol_prec
     165!    real, DIMENSION(klon) :: run_off_lic_0_diag
     166#endif
     167
     168
    122169    REAL, DIMENSION(klon)    :: emis_new                  !Emissivity
    123170    REAL, DIMENSION(klon)    :: swdown,lwdown
    … …  
    146193    REAL, DIMENSION(klon)  :: fluxbs_1, fluxbs_2, bsweight_fresh
    147194    LOGICAL, DIMENSION(klon) :: ok_remaining_freshsnow
     195    REAL  :: ta1, ta2, ta3, z01, z02, z03, coefa, coefb, coefc, coefd
     196
    148197
    149198! End definition
    … …  
    161210!FC firtscall initializations
    162211!******************************************************************************************
     212#ifdef ISO
     213#ifdef ISOVERIF
     214!     write(*,*) 'surf_land_ice 1499'   
     215  DO i=1,knon
     216    IF (iso_eau > 0) THEN
     217      CALL iso_verif_egalite_choix(xtsnow(iso_eau,i),snow(i), &
     218    &                              'surf_land_ice 126',errmax,errmaxrel)
     219    ENDIF !IF (iso_eau > 0) THEN     
     220  ENDDO !DO i=1,knon 
     221#endif
     222#endif
     223
    163224  IF (firstcall) THEN
    164225  alb_vis_sno_lic=0.77
    … …  
    200261!****************************************************************************************
    201262#ifdef CPP_INLANDSIS
     263
     264#ifdef ISO
     265        CALL abort_gcm('surf_landice 235','isotopes pas dans INLANDSIS',1)
     266#endif
    202267
    203268        debut_is=debut
    … …  
    321386         tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l)
    322387
     388#ifdef ISO
     389#ifdef ISOVERIF
     390     !write(*,*) 'surf_land_ice 1499'   
     391     DO i=1,knon
     392       IF (iso_eau > 0) THEN
     393         IF (snow(i) > ridicule) THEN
     394           CALL iso_verif_egalite_choix(xtsnow(iso_eau,i),snow(i), &
     395    &                                   'surf_land_ice 1151',errmax,errmaxrel)
     396         ENDIF !IF ((snow(i) > ridicule)) THEN
     397       ENDIF !IF (iso_eau > 0) THEN
     398     ENDDO !DO i=1,knon 
     399#endif
     400
     401    DO i=1,knon
     402      snow_prec(i)=snow(i)
     403      DO ixt=1,niso
     404        xtsnow_prec(ixt,i)=xtsnow(ixt,i)
     405      ENDDO !DO ixt=1,niso
     406      ! initialisation:
     407      fq_fonte_diag(i)=0.0
     408      fqfonte_diag(i)=0.0
     409      snow_evap_diag(i)=0.0
     410    ENDDO !DO i=1,knon
     411#endif         
     412
    323413    CALL calcul_flux_wind(knon, dtime, &
    324414         u0, v0, u1, v1, gustiness, cdragm, &
    … …  
    350440!
    351441!****************************************************************************************
    352     z0m = z0m_landice
    353     z0h = z0h_landice
    354     !z0m = SQRT(z0m**2+rugoro**2)
    355 
     442
     443if (z0m_landice .GT. 0.) then
     444    z0m(1:knon) = z0m_landice
     445    z0h(1:knon) = z0h_landice
     446else
     447    ! parameterization of z0=f(T) following measurements in Adelie Land by Amory et al 2018
     448    coefa = 0.1658 !0.1862 !Ant
     449    coefb = -50.3869 !-55.7718 !Ant
     450    ta1 = 253.15 !255. Ant
     451    ta2 = 273.15
     452    ta3 = 273.15+3
     453    z01 = exp(coefa*ta1 + coefb) !~0.2 ! ~0.25 mm
     454    z02 = exp(coefa*ta2 + coefb) !~6  !~7 mm
     455    z03 = z01
     456    coefc = log(z03/z02)/(ta3-ta2)
     457    coefd = log(z03)-coefc*ta3
     458    do j=1,knon
     459      if (temp_air(j) .lt. ta1) then
     460        z0m(j) = z01
     461      else if (temp_air(j).ge.ta1 .and. temp_air(j).lt.ta2) then
     462        z0m(j) = exp(coefa*temp_air(j) + coefb)
     463      else if (temp_air(j).ge.ta2 .and. temp_air(j).lt.ta3) then
     464        ! if st > 0, melting induce smooth surface
     465        z0m(j) = exp(coefc*temp_air(j) + coefd)
     466      else
     467        z0m(j) = z03
     468      endif
     469      z0h(j)=z0m(j)
     470    enddo
     471
     472endif   
     473 
    356474
    357475!****************************************************************************************
    … …  
    366484   if (ok_bs) then
    367485       fluxbs(:)=0.
    368        do j=1,klon
     486       do j=1,knon
    369487          ws1(j)=(u1(j)**2+v1(j)**2)**0.5
    370488          ustar(j)=(cdragm(j)*(u1(j)**2+v1(j)**2))**0.5
    … …  
    493611 
    494612    CALL fonte_neige(knon, is_lic, knindex, dtime, &
    495          tsurf, precip_rain, precip_totsnow,  &
    496          snow, qsol, tsurf_new, evap_totsnow)
     613         tsurf, precip_rain, precip_totsnow, &
     614         snow, qsol, tsurf_new, evap_totsnow &
     615#ifdef ISO   
     616     &  ,fq_fonte_diag,fqfonte_diag,snow_evap_diag,fqcalving_diag     &
     617     &  ,max_eau_sol_diag,runoff_diag,run_off_lic_diag,coeff_rel_diag &
     618#endif
     619     &   )
     620
     621
     622#ifdef ISO
     623#ifdef ISOVERIF
     624    DO i=1,knon 
     625      IF (iso_eau > 0) THEN 
     626        CALL iso_verif_egalite_choix(Rland_ice(iso_eau,i),1.0, &
     627     &                               'surf_landice_mod 217',errmax,errmaxrel)
     628      ENDIF !IF (iso_eau > 0) THEN
     629    ENDDO !DO i=1,knon
     630#endif
     631
     632    CALL calcul_iso_surf_lic_vectall(klon,knon, &
     633     &    evap,snow_evap_diag,Tsurf_new,snow, &
     634     &    fq_fonte_diag,fqfonte_diag,dtime,t_coup, &
     635     &    precip_snow,xtprecip_snow,precip_rain,xtprecip_rain, snow_prec,xtsnow_prec, &
     636     &    xtspechum,spechum,ps,Rland_ice, &
     637     &    xtevap,xtsnow,fqcalving_diag, &
     638     &    knindex,is_lic,run_off_lic_diag,coeff_rel_diag &
     639     &   )
     640
     641!        call fonte_neige_export_xtrun_off_lic_0(knon,xtrun_off_lic_0_diag)
     642
     643#endif
    497644   
    498    
    499645    WHERE (snow(1 : knon) .LT. 0.0001) agesno(1 : knon) = 0.                                         
    500646    zfra(1:knon) = MAX(0.0,MIN(1.0,snow(1:knon)/(snow(1:knon)+10.0))) 

  • LMDZ6/branches/cirrus/libf/phylmd/surf_ocean_mod.F90

    r4526 r5202  
    2121       tsurf_new, dflux_s, dflux_l, lmt_bils, &
    2222       flux_u1, flux_v1, delta_sst, delta_sal, ds_ns, dt_ns, dter, dser, &
    23        dt_ds, tkt, tks, taur, sss)
     23       dt_ds, tkt, tks, taur, sss &
     24#ifdef ISO
     25        &       ,xtprecip_rain, xtprecip_snow,xtspechum,Roce, &
     26        &       xtsnow,xtevap,h1 &
     27#endif               
     28        &       )
    2429
    2530    use albedo, only: alboc, alboc_cd
    … …  
    3136    USE ocean_cpl_mod, ONLY    : ocean_cpl_noice
    3237    USE indice_sol_mod, ONLY : nbsrf, is_oce
     38#ifdef ISO
     39    USE infotrac_phy, ONLY : ntraciso=>ntiso,niso
     40#ifdef ISOVERIF
     41    USE isotopes_mod, ONLY: iso_eau,ridicule
     42    USE isotopes_verif_mod
     43#endif
     44#endif
    3345    USE limit_read_mod
    34     use config_ocean_skin_m, only: activate_ocean_skin
     46    USE config_ocean_skin_m, ONLY: activate_ocean_skin
    3547    !
    3648    ! This subroutine will make a call to ocean_XXX_noice according to the ocean mode (force,
    … …  
    6880    REAL, DIMENSION(klon), INTENT(IN)        :: rugoro
    6981    REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf
     82#ifdef ISO
     83    REAL, DIMENSION(ntraciso,klon), INTENT(IN) :: xtprecip_rain, xtprecip_snow
     84    REAL, DIMENSION(ntraciso,klon), INTENT(IN) :: xtspechum
     85#endif
    7086
    7187    ! In/Output variables
    … …  
    7591    REAL, DIMENSION(klon), INTENT(INOUT)     :: agesno
    7692    REAL, DIMENSION(klon), INTENT(inOUT)     :: z0h
     93#ifdef ISO
     94    REAL, DIMENSION(niso,klon), INTENT(IN)   :: xtsnow
     95    REAL, DIMENSION(niso,klon), INTENT(INOUT):: Roce 
     96#endif
    7797
    7898    REAL, intent(inout):: delta_sst(:) ! (knon)
    … …  
    136156    ! size klon because of the coupling machinery.)
    137157
     158#ifdef ISO
     159    REAL, DIMENSION(ntraciso,klon), INTENT(out) :: xtevap ! isotopes in surface evaporation flux
     160    REAL, DIMENSION(klon), INTENT(out)          :: h1 ! just a diagnostic, not useful for the simulation   
     161#endif
     162
    138163    ! Local variables
    139164    !*************************************************************************
    … …  
    146171    REAL, DIMENSION(klon) :: precip_totsnow
    147172    CHARACTER(len=20),PARAMETER :: modname="surf_ocean"
    148     real rhoa(knon) ! density of moist air  (kg / m3)
     173    REAL rhoa(knon) ! density of moist air  (kg / m3)
    149174    REAL sens_prec_liq(knon)
    150175
    151176    REAL t_int(knon) ! ocean-air interface temperature, in K
    152     real s_int(knon) ! ocean-air interface salinity, in ppt
     177    REAL s_int(knon) ! ocean-air interface salinity, in ppt
    153178
    154179    !**************************************************************************
    155180
     181#ifdef ISO
     182#ifdef ISOVERIF
     183    DO i = 1, knon
     184      IF (iso_eau > 0) THEN         
     185        CALL iso_verif_egalite_choix(xtspechum(iso_eau,i), &
     186     &          spechum(i),'surf_ocean_mod 117', &
     187     &          errmax,errmaxrel)         
     188        CALL iso_verif_egalite_choix(xtsnow(iso_eau,i), &
     189     &          snow(i),'surf_ocean_mod 127', &
     190     &          errmax,errmaxrel)
     191      ENDIF !IF (iso_eau > 0) then
     192    ENDDO !DO i=1,klon
     193#endif     
     194#endif
    156195
    157196    !******************************************************************************
    … …  
    230269            radsol, snow, agesno, &
    231270            qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
    232             tsurf_new, dflux_s, dflux_l, sens_prec_liq, rhoa)
     271            tsurf_new, dflux_s, dflux_l, sens_prec_liq, rhoa &
     272#ifdef ISO
     273            ,xtprecip_rain, xtprecip_snow, xtspechum,Roce,rlat, &
     274            xtsnow,xtevap,h1 & 
     275#endif           
     276            )
    233277    END SELECT
    234278

  • LMDZ6/branches/cirrus/libf/phylmd/surf_seaice_mod.F90

    r3815 r5202  
    2121       z0m, z0h, SFRWL, alb_dir_new, alb_dif_new, evap, fluxsens, fluxlat, & 
    2222       tsurf_new, dflux_s, dflux_l, &
    23        flux_u1, flux_v1)
     23       flux_u1, flux_v1 &
     24#ifdef ISO
     25         &      ,xtprecip_rain, xtprecip_snow,xtspechum,Roce, &
     26         &      xtsnow,xtsol,xtevap,Rland_ice &
     27#endif               
     28         &      )
    2429
    2530  USE dimphy
    … …  
    2934  USE ocean_slab_mod, ONLY   : ocean_slab_ice
    3035  USE indice_sol_mod
     36#ifdef ISO
     37  USE infotrac_phy, ONLY : ntiso,niso
     38#endif
    3139
    3240!
    … …  
    6270    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1, gustiness
    6371    REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf
     72#ifdef ISO
     73    REAL, DIMENSION(ntiso,klon), INTENT(IN)  :: xtprecip_rain, xtprecip_snow
     74    REAL, DIMENSION(klon),       INTENT(IN)  :: xtspechum
     75    REAL, DIMENSION(niso,klon),  INTENT(IN)  :: Roce
     76    REAL, DIMENSION(niso,klon),  INTENT(IN)  :: Rland_ice
     77#endif
    6478
    6579! In/Output arguments
    … …  
    6882    REAL, DIMENSION(klon), INTENT(INOUT)          :: agesno
    6983    REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
     84#ifdef ISO
     85    REAL, DIMENSION(niso,klon), INTENT(INOUT)     :: xtsnow 
     86    REAL, DIMENSION(niso,klon), INTENT(IN)        :: xtsol
     87#endif
    7088
    7189! Output arguments
    … …  
    82100    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
    83101    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
     102#ifdef ISO
     103    REAL, DIMENSION(ntiso,klon), INTENT(OUT) :: xtevap
     104#endif
    84105
    85106! Local arguments
    86107!****************************************************************************************
    87108    REAL, DIMENSION(klon)  :: radsol
     109#ifdef ISO
     110#ifdef ISOVERIF
     111    INTEGER :: j
     112#endif
     113#endif
    88114
    89115!albedo SB >>>
    … …  
    145171            radsol, snow, qsol, agesno, tsoil, &
    146172            qsurf, alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
    147             tsurf_new, dflux_s, dflux_l, rhoa)
     173            tsurf_new, dflux_s, dflux_l, rhoa &
     174#ifdef ISO
     175            ,xtprecip_rain, xtprecip_snow, xtspechum,Roce, &
     176            xtsnow, xtsol,xtevap,Rland_ice & 
     177#endif           
     178            )
    148179
    149180    END IF
Note: See TracChangeset for help on using the changeset viewer.