Changeset 5717 for LMDZ6


Ignore:
Timestamp:
Jun 18, 2025, 5:12:20 PM (7 days ago)
Author:
aborella
Message:

Merge with trunk r5653

Location:
LMDZ6/branches/contrails
Files:
6 deleted
53 edited
10 copied

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/contrails

  • LMDZ6/branches/contrails/DefLists

  • LMDZ6/branches/contrails/DefLists/context_input_lmdz.xml

    r5623 r5717  
    7777-->
    7878
     79<!-- Case with ERA files -->
     80<!--
     81      <file id="sstk_era" name="sstk"  >
     82        <field id="sst_reg" name="sstk" domain_ref="domain_limit_amip" axis_ref="time_sst" operation="instant" freq_offset="1ts"/>
     83      </file>
     84 
     85      <file id="ci_era" name="ci" >
     86         <field id="sic_reg" name="ci" domain_ref="domain_limit_amip" axis_ref="time_sic" operation="instant" freq_offset="1ts"/>
     87      </file>
     88-->
    7989
    8090      <file id="rugos" name="Rugos" >

  • LMDZ6/branches/contrails/DefLists/field_def_lmdz.xml

    r5641 r5717  
    731731        <field id="sigma2_icefracturb"    long_name="Variance of the diagnostic supersaturation distribution (icefrac_turb)"    unit="-" />
    732732        <field id="mean_icefracturb"     long_name="Mean of the diagnostic supersaturation distribution (icefrac_turb)"    unit="-" />
     733        <field id="cldfraliqth"          long_name="Fraction of liquid cloud in thermals"    unit="-" />
     734        <field id="sigma2_icefracturbth"    long_name="Variance of the diagnostic supersaturation distribution in thermals (icefrac_turb)"    unit="-" />
     735        <field id="mean_icefracturbth"     long_name="Mean of the diagnostic supersaturation distribution in thermals (icefrac_turb)"    unit="-" />
    733736        <field id="rnebcon"    long_name="Convective Cloud Fraction"    unit="-" />
    734737        <field id="rnebls"    long_name="LS Cloud fraction"    unit="-" />
    … …  
    10671070
    10681071    <field_group id="fields_strataer_3D" grid_ref="grid_glo_presnivs" operation="average" >
     1072        <field id="ext_strat_443"        long_name="Strat. aerosol extinction coefficient at 443 nm"       unit="1/m" />
    10691073        <field id="ext_strat_550"        long_name="Strat. aerosol extinction coefficient at 550 nm"       unit="1/m" />
    1070         <field id="ext_strat_1020"       long_name="Strat. aerosol extinction coefficient at 1020 nm"      unit="1/m" />
     1074        <field id="ext_strat_670"        long_name="Strat. aerosol extinction coefficient at 670 nm"       unit="1/m" />
     1075        <field id="ext_strat_765"        long_name="Strat. aerosol extinction coefficient at 765 nm"       unit="1/m" />
     1076        <field id="ext_strat_1020"      long_name="Strat. aerosol extinction coefficient at 1020 nm"     unit="1/m" />
     1077        <field id="ext_strat_10um"     long_name="Strat. aerosol extinction coefficient at 10 um"         unit="1/m" />
    10711078        <field id="budg_3D_nucl"         long_name="H2SO4 nucleation mass flux"                            unit="kg(S)/m2/layer/s" />
    10721079        <field id="budg_3D_cond_evap"    long_name="H2SO4 net condensation/evaporation mass flux"          unit="kg(S)/m2/layer/s" />
    … …  
    10781085        <field id="SAD_sulfate"                long_name="SAD WET sulfate aerosols"                        unit="cm2/cm3" />
    10791086        <field id="reff_sulfate"                long_name="Effective    radius of WET sulfate aerosols"              unit="cm" />
    1080         <field id="sulfMMR"                long_name="Sulfate aerosol concentration (dry mass mixing ratio)"                        unit="kg(H2SO4)/kg(air)" />
     1087        <field id="sulfMMR"                long_name="Sulfate aerosol concentration (dry mass mixing ratio)"  unit="kg(H2SO4)/kg(air)" />
     1088        <field id="SO2_CHLM"            long_name="SO2 chemical loss rate"                        unit="mole/cm3/s" />
    10811089        <field id="OCS_lifetime"         long_name="OCS lifetime"                                          unit="s" />
    10821090        <field id="SO2_lifetime"         long_name="SO2 lifetime"                                          unit="s" />
    … …  
    12011209
    12021210    <field_group id="fields_strataer_2D" grid_ref="grid_glo" operation="average">
     1211        <field id="OD443_strat_only"   long_name="Stratospheric Aerosol Optical depth at 443 nm "        unit="1" />
    12031212        <field id="OD550_strat_only"   long_name="Stratospheric Aerosol Optical depth at 550 nm "        unit="1" />
     1213        <field id="OD670_strat_only"   long_name="Stratospheric Aerosol Optical depth at 670 nm "        unit="1" />
     1214        <field id="OD765_strat_only"   long_name="Stratospheric Aerosol Optical depth at 765 nm "        unit="1" />
    12041215        <field id="OD1020_strat_only"  long_name="Stratospheric Aerosol Optical depth at 1020 nm "       unit="1" />
     1216        <field id="OD10um_strat_only"  long_name="Stratospheric Aerosol Optical depth at 10 um "       unit="1" />
    12051217        <field id="surf_PM25_sulf"     long_name="Sulfate PM2.5 concentration at the surface"            unit="ug/m3" />
    12061218        <field id="budg_dep_dry_ocs"   long_name="OCS dry deposition flux"                               unit="kg(S)/m2/s" />

  • LMDZ6/branches/contrails/DefLists/file_def_histdaystrataer_lmdz.xml

    r5150 r5717  
    44     
    55      <field_group grid_ref="grid_out"  level="3">
    6         <field field_ref="OD550_strat_only" level="1" />
    7         <field field_ref="OD1020_strat_only" level="1" />
     6        <field field_ref="OD443_strat_only" level="2" />
     7        <field field_ref="OD550_strat_only" level="1" />
     8        <field field_ref="OD670_strat_only" level="2" />
     9        <field field_ref="OD765_strat_only" level="2" />
     10        <field field_ref="OD1020_strat_only" level="1" />
     11        <field field_ref="OD10um_strat_only" level="2" />
    812        <field field_ref="surf_PM25_sulf" level="2" />
    913        <field field_ref="budg_dep_dry_ocs" level="3" />
    … …  
    2933     
    3034      <field_group grid_ref="grid_out_presnivs" level="10">
    31         <field field_ref="ext_strat_550" level="1" />
    32         <field field_ref="ext_strat_1020" level="5" />
     35        <field field_ref="ext_strat_443"  level="5" />
     36        <field field_ref="ext_strat_550"  level="1" />
     37        <field field_ref="ext_strat_670"  level="5" />
     38        <field field_ref="ext_strat_765"  level="5" />
     39        <field field_ref="ext_strat_1020" level="5" />
     40        <field field_ref="ext_strat_10um" level="5" />
    3341        <field field_ref="budg_3D_nucl" level="10" />
    3442        <field field_ref="budg_3D_cond_evap" level="10" />
    … …  
    4149        <field field_ref="reff_sulfate" level="5" />
    4250        <field field_ref="sulfMMR" level="1" />
     51        <field field_ref="SO2_CHLM" level="3" />
    4352        <field field_ref="OCS_lifetime" level="10" />
    4453        <field field_ref="SO2_lifetime" level="10" />

  • LMDZ6/branches/contrails/DefLists/file_def_histstrataer_lmdz.xml

    r5150 r5717  
    77       
    88        <field_group grid_ref="grid_out"  level="3">
    9           <field field_ref="OD550_strat_only" level="1" />
    10           <field field_ref="OD1020_strat_only" level="1" />
     9          <field field_ref="OD443_strat_only" level="2" />
     10          <field field_ref="OD550_strat_only" level="1" />
     11          <field field_ref="OD670_strat_only" level="2" />
     12          <field field_ref="OD765_strat_only" level="2" />
     13          <field field_ref="OD1020_strat_only" level="1" />
     14          <field field_ref="OD10um_strat_only" level="2" />
    1115          <field field_ref="surf_PM25_sulf" level="1" />
    1216          <field field_ref="budg_dep_dry_ocs" level="3" />
    … …  
    3236       
    3337        <field_group grid_ref="grid_out_presnivs" level="5">
    34           <field field_ref="ext_strat_550"  level="1" />
    35           <field field_ref="ext_strat_1020" level="1" />
     38          <field field_ref="ext_strat_443"  level="2" />
     39          <field field_ref="ext_strat_550"  level="1" />
     40          <field field_ref="ext_strat_670"  level="2" />
     41          <field field_ref="ext_strat_765"  level="2" />
     42          <field field_ref="ext_strat_1020" level="1" />
     43          <field field_ref="ext_strat_10um" level="2" />
    3644          <field field_ref="budg_3D_nucl" level="1" />
    3745          <field field_ref="budg_3D_cond_evap" level="1" />
    … …  
    4452          <field field_ref="reff_sulfate" level="1" />
    4553          <field field_ref="sulfMMR" level="1" />
     54          <field field_ref="SO2_CHLM" level="1" />
    4655          <field field_ref="OCS_lifetime" level="1" />
    4756          <field field_ref="SO2_lifetime" level="1" />
    4857          <field field_ref="vsed_aer" level="2" />
    4958          <field field_ref="f_r_wet" level="1" />
    50           <field field_ref="mass" level="2" />
    51           <field field_ref="temp" level="2" />
    52           <field field_ref="pres" level="2" />
     59          <field field_ref="mass" level="1" />
     60          <field field_ref="temp" level="1" />
     61          <field field_ref="pres" level="1" />
    5362          <field field_ref="h2o"  level="1" />
    5463          <field field_ref="dqch4" level="1" />

  • LMDZ6/branches/contrails/arch/arch-local-gfortran.env

    r5618 r5717  
    1 export PATH=".:/home/hourdin/bin:/home/hourdin/miniconda3/condabin:.:/home/hourdin/bin:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/games:/usr/local/games:/snap/bin:/snap/bin:/home/hourdin/LMDZ/Replay:/home/hourdin/.local/bin:/home/hourdin/LMDZ/Replay:$PATH" # netcdf bin path auto-added by install_lmdz.sh
    21# empty

  • LMDZ6/branches/contrails/libf/dyn3d/conf_gcm.f90

    r5601 r5717  
    923923     write(lunout,*)' ok_guide = ', ok_guide
    924924     write(lunout,*)' read_orop = ', read_orop
     925     write(lunout,*)' adv_qsat_liq = ', adv_qsat_liq
     926
    925927  ENDIF test_etatinit
    926928

  • LMDZ6/branches/contrails/libf/dyn3dmem/conf_gcm.F90

    r5285 r5717  
    870870     CALL getin('type_trac',type_trac)
    871871
     872     !Config  Key  = adv_qsat_liq
     873     !Config  Desc = option for qsat calculation in the dynamics
     874     !Config  Def  = n
     875     !Config  Help = controls which phase is considered for qsat calculation
     876     !Config         
     877     adv_qsat_liq = .FALSE.
     878     CALL getin('adv_qsat_liq',adv_qsat_liq)
     879
    872880     !Config  Key  = ok_dynzon
    873881     !Config  Desc = sortie des transports zonaux dans la dynamique
    … …  
    10141022     write(lunout,*)' ok_dyn_ave = ', ok_dyn_ave
    10151023     write(lunout,*)' ok_dyn_xios = ', ok_dyn_xios
     1024     write(lunout,*)' adv_qsat_liq = ', adv_qsat_liq
    10161025     write(lunout,*)' use_filtre_fft = ', use_filtre_fft
    10171026     write(lunout,*)' use_mpi_alloc = ', use_mpi_alloc

  • LMDZ6/branches/contrails/libf/phylmd/Dust/coarsemission.f90

    r5337 r5717  
    55        xlat,xlon,debutphy, &
    66        zu10m,zv10m,wstar,ale_bl,ale_wake, &
     7        nsurfwind,wind10ms,probu, &
    78        scale_param_ssacc,scale_param_sscoa, &
    89        scale_param_dustacc,scale_param_dustcoa, &
    … …  
    5455  REAL, intent(in) ::  xlat(klon)    ! latitudes pour chaque point
    5556  REAL, intent(in) ::  xlon(klon)    ! longitudes pour chaque point
     57  INTEGER, intent(in) ::  nsurfwind
    5658  REAL,DIMENSION(klon),INTENT(IN)    :: zu10m
    5759  REAL,DIMENSION(klon),INTENT(IN)    :: zv10m
    5860  REAL,DIMENSION(klon),INTENT(IN)    :: wstar,Ale_bl,ale_wake
     61  REAL,DIMENSION(klon,nsurfwind),INTENT(IN)    :: wind10ms
     62  REAL,DIMENSION(klon,nsurfwind),INTENT(IN)    :: probu
    5963
    6064  !
    … …  
    190194  param_wstarWAKE(i)=param_wstarWAKEperregion(iregion_wstardust(i))
    191195  ENDDO
    192 
    193 
    194   CALL dustemission( debutphy, xlat, xlon, pctsrf, &
     196 
     197
     198  CALL dustemission( debutphy, xlat, xlon, nsurfwind, pctsrf, &
    195199        zu10m,zv10m,wstar,ale_bl,ale_wake, &
    196200        param_wstarBL, param_wstarWAKE, &
     201        wind10ms, probu, &
    197202        dustsourceacc,dustsourcecoa, &
    198203        dustsourcesco,maskd)

  • LMDZ6/branches/contrails/libf/phylmd/Dust/dustemission_mod.f90

    r5337 r5717  
    1111  INTEGER, PARAMETER     :: nmode=3   ! number of soil-dust modes
    1212  INTEGER, PARAMETER     :: ntyp=5   ! number of soil types
    13   INTEGER, PARAMETER     :: nwb=12   ! number of points for the 10m wind
     13  !INTEGER, PARAMETER     :: nwb=12   ! number of points for the 10m wind
    1414! speed weibull distribution (>=2)
    1515  real   ,parameter     :: z10m=1000. !10m in cm
    … …  
    165165  END SUBROUTINE dustemis_out_init
    166166
    167   SUBROUTINE dustemission( debutphy, xlat, xlon, &    !Input
     167  SUBROUTINE dustemission( debutphy, xlat, xlon, nsurfwind, &    !Input
    168168                          pctsrf,zu10m,zv10m,wstar, & !Input
    169169                          ale_bl,ale_wake, &          !Input
    170                           param_wstarBL, param_wstarWAKE, &  !Input
     170                          param_wstarBL, param_wstarWAKE, & !Input
     171                          wind10ms, probu, & !Input
    171172                          emdustacc,emdustcoa,emdustsco,maskdust)    !Output
    172173  USE dimphy
    … …  
    182183  ! first:
    183184  ! Model grid parameters
     185  INTEGER, INTENT(IN)                :: nsurfwind
    184186  REAL,DIMENSION(klon),     INTENT(IN)     :: xlat
    185187  REAL,DIMENSION(klon),     INTENT(IN)     :: xlon
    … …  
    190192  REAL,DIMENSION(klon),INTENT(IN)          :: ale_bl
    191193  REAL,DIMENSION(klon),INTENT(IN)          :: ale_wake
     194  !REAL,DIMENSION(klon),INTENT(IN)          :: wake_s
     195  !REAL,DIMENSION(klon),INTENT(IN)          :: wake_Cstar
     196  !REAL,DIMENSION(klon),INTENT(IN)          :: zustar
    192197  REAL,DIMENSION(klon), INTENT(IN) :: param_wstarWAKE
    193198  REAL,DIMENSION(klon), INTENT(IN) :: param_wstarBL
    194199 
    195200 
     201  REAL,DIMENSION(klon,nsurfwind), INTENT(IN) :: wind10ms
     202  REAL,DIMENSION(klon,nsurfwind), INTENT(IN) :: probu
     203 
    196204  LOGICAL  :: debutphy ! First physiqs run or not
    197205  ! Intermediate variable: 12 bins emissions
    198   REAL,DIMENSION(:,:), ALLOCATABLE,SAVE  :: emisbinloc ! vertical emission fluxes
     206  !REAL,DIMENSION(:,:), ALLOCATABLE,SAVE  :: emisbinloc ! vertical emission fluxes
     207  REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: emisbinloc
    199208
    200209  !OUT variables
    … …  
    206215!  REAL,DIMENSION(klon_glo) :: raux_klon_glo ! auxiliar
    207216
    208 !$OMP THREADPRIVATE(emisbinloc)
     217 INTEGER :: nwb
     218 nwb = nsurfwind
     219!!!$OMP THREADPRIVATE(emisbinloc)
    209220!!!!!!$OMP THREADPRIVATE(maskdust)
    210221  IF (debutphy) THEN
    … …  
    217228
    218229!JE20141124  CALL  calcdustemission(debutphy,zu10m,zv10m,wstar,ale_bl,ale_wake,emisbinloc)
    219   CALL  calcdustemission(debutphy,zu10m,zv10m,wstar,ale_bl,ale_wake,param_wstarBL,param_wstarWAKE, & !I
    220                          emisbinloc)   !O
     230  CALL  calcdustemission(debutphy,nsurfwind,zu10m,zv10m,wstar,ale_bl,ale_wake,param_wstarBL,param_wstarWAKE, & !I
     231                         wind10ms,probu,emisbinloc)   !O
    221232
    222233  CALL makemask(maskdust)
    … …  
    654665  varname='A'
    655666  CALL read_surface(varname,Aini)
    656 print *,'beforewritephy',mpi_rank,omp_rank
     667!print *,'beforewritephy',mpi_rank,omp_rank
    657668  CALL writefield_phy("SOLinit",solini,5)
    658669  CALL writefield_phy("Pinit",Pini,5)
    … …  
    662673  CALL writefield_phy("Dinit",Dini,5)
    663674  CALL writefield_phy("Ainit",Aini,5)
    664 print *,'afterwritephy',mpi_rank,omp_rank
     675!print *,'afterwritephy',mpi_rank,omp_rank
    665676
    666677  DO i=1,klon
    … …  
    765776      enddo
    76677730   continue
    767       print*,'IK5'
     778!      print*,'IK5'
    768779      ncl=i-1
    769       print*,'   soil size classes used   ',ncl,' / ',nclass
    770       print*,'   soil size min: ',sizeclass(1),' soil size max: ',sizeclass(ncl)
     780!     print*,'   soil size classes used   ',ncl,' / ',nclass
     781!     print*,'   soil size min: ',sizeclass(1),' soil size max: ',sizeclass(ncl)
    771782      if(ncl.gt.nclass)stop
    772783
    … …  
    775786!if (.true.) then
    776787!c 0: Iversen and White 1982
    777        print *,'Using  Iversen and White 1982 Uth'
     788!        print *,'Using  Iversen and White 1982 Uth'
    778789         do i=1,ncl
    779790            bb=adust*(sizeclass(i)**xdust)+bdust
    … …  
    11071118!--------------------------------------------------------------------------------------
    11081119
    1109   SUBROUTINE calcdustemission(debutphy,zu10m,zv10m,wstar, &
     1120  SUBROUTINE calcdustemission(debutphy,nsurfwind,zu10m,zv10m,wstar, &
    11101121                              ale_bl,ale_wake,param_wstarBL,param_wstarWAKE, &
     1122                              wind10ms, probu, &
    11111123                              emisbin)
    11121124  ! emisions over 12 dust bin
    … …  
    11171129  ! Input
    11181130  LOGICAL, INTENT(IN)                   :: debutphy ! First physiqs run or not
     1131  INTEGER, INTENT(IN)                   :: nsurfwind ! First physiqs run or not
    11191132  REAL,DIMENSION(klon),INTENT(IN)          :: zu10m   ! 10m zonal wind
    11201133  REAL,DIMENSION(klon),INTENT(IN)          :: zv10m   ! meridional 10m wind
    … …  
    11221135  REAL,DIMENSION(klon),INTENT(IN)          :: ale_bl
    11231136  REAL,DIMENSION(klon),INTENT(IN)          :: ale_wake
     1137  REAL,DIMENSION(klon,nsurfwind),INTENT(IN)          :: wind10ms
     1138  REAL,DIMENSION(klon,nsurfwind),INTENT(IN)          :: probu
    11241139 
    11251140  ! Local variables
    … …  
    11301145  REAL,DIMENSION(klon), INTENT(IN) :: param_wstarBL
    11311146  REAL,DIMENSION(:,:), ALLOCATABLE,SAVE :: fluxdust ! horizonal emission fluxes in UNITS for the nmod soil aerosol modes
    1132   REAL,DIMENSION(:), ALLOCATABLE,SAVE   :: wind10ms   ! 10m wind distribution in m/s
    1133   REAL,DIMENSION(:), ALLOCATABLE,SAVE   :: wind10cm   ! 10m wind distribution in cm/s
     1147  !REAL,DIMENSION(:), ALLOCATABLE,SAVE   :: wind10ms   ! 10m wind distribution in m/s
     1148  !REAL,DIMENSION(:), ALLOCATABLE,SAVE   :: wind10cm   ! 10m wind distribution in cm/s
    11341149  REAL,DIMENSION(klon)                  :: zwstar   
    1135   REAL,DIMENSION(nwb)                :: probu
     1150  !REAL,DIMENSION(nwb)                :: probu
    11361151!  REAL, DIMENSION(nmode) :: fluxN,ftN,adN,fdpN,pN,eN ! in the original code N=1,2,3
    11371152  REAL :: flux1,flux2,flux3,ft1,ft2,ft3
    … …  
    11471162  REAL :: dfec1,dfec2,dfec3,t1,t2,t3,p1,p2,p3,dec,ec
    11481163  ! auxiliar counters
    1149   INTEGER                               :: kwb
     1164  INTEGER                               :: kwb, nwb
    11501165  INTEGER                               :: i,j,k,l,n
    11511166  INTEGER  :: kfin,ideb,ifin,kfin2,istep
    … …  
    11551170  !REAL,DIMENSION(:,:), ALLOCATABLE,SAVE  :: emisbin ! vertical emission fluxes in UNITS for the 12 bins
    11561171  REAL,DIMENSION(klon,nbins)  :: emisbin ! vertical emission fluxes in UNITS for the 12 bins
    1157 !$OMP THREADPRIVATE(fluxdust)
    1158 !$OMP THREADPRIVATE(wind10ms)
    1159 !$OMP THREADPRIVATE(wind10cm)
     1172  !$OMP THREADPRIVATE(fluxdust)
     1173!!!$OMP THREADPRIVATE(wind10ms)
     1174!!!$OMP THREADPRIVATE(wind10cm)
     1175
    11601176
    11611177  !----------------------------------------------------
    … …  
    11651181!   ALLOCATE( emisbin(klon,nbins) )
    11661182   ALLOCATE( fluxdust(klon,nmode) )
    1167    ALLOCATE( wind10ms(nwb) )
    1168    ALLOCATE( wind10cm(nwb) )
     1183  ! ALLOCATE( wind10ms(klon,nsurfwind) )
     1184   !ALLOCATE( wind10cm(nwb) )
    11691185  ENDIF !debutphy
    11701186
    … …  
    11901206  !
    11911207    DO i=1,klon  ! main loop
    1192      zwstar(i)=sqrt(2.*(param_wstarBL(i)*ale_bl(i)+param_wstarWAKE(i)*ale_wake(i)))
    1193      U10mMOD=MAX(woff,sqrt(zu10m(i)*zu10m(i)+zv10m(i)*zv10m(i)))
    1194      pdfcum=0.
     1208   !  zwstar(i)=sqrt(2.*(param_wstarBL(i)*ale_bl(i)+param_wstarWAKE(i)*ale_wake(i)))
     1209     zwstar(i)=sqrt(2.*(param_wstarBL(i)*ale_bl(i)))
    11951210     ! Wind weibull distribution:
    1196 
     1211           nwb = nsurfwind
     1212!          print*,'GGGGGGGGGGGGGGGGGGGGGGGGG nwb=',nwb
    11971213           DO kwb=1,nwb
    11981214                flux1=0.
    … …  
    12041220! lambda=U10mMOD/gamma(1+1/kref)
    12051221! gamma function estimated with stirling formula
    1206                 auxreal=1.+1./kref
    1207                 weilambda = U10mMOD/exp(auxreal*log(auxreal)-auxreal &
    1208                          - 0.5*log(auxreal/(2.*pi))+1./(12.*auxreal) &
    1209                          -1./(360.*(auxreal**3.))+1./(1260.*(auxreal**5.)))
    1210                 IF(nwb.gt.1)THEN
    1211                    wind10ms(kwb)=kwb*2.*U10mMOD/nwb
    1212 !original
    1213 !                   pdfu=(kref/U10mMOD)*(wind10ms(kwb)/U10mMOD)**(kref-1) &
    1214 !                      *exp(-(wind10ms(kwb)/U10mMOD)**kref)
    1215                    pdfu=(kref/weilambda)*(wind10ms(kwb)/weilambda)**(kref-1) &
    1216                       *exp(-(wind10ms(kwb)/weilambda)**kref)
    1217 !                   !print *,'JEdbg  U10mMOD weilambda  ',U10mMOD,weilambda
    1218 !JE20141205>>
    1219 
    1220                    probu(kwb)=pdfu*2.*U10mMOD/nwb
    1221                    pdfcum=pdfcum+probu(kwb)
    1222                       IF(probu(kwb).le.1.e-2)GOTO 70
    1223                 ELSE
    1224                    wind10ms(kwb)=U10mMOD
    1225                    probu(kwb)=1.
    1226                 ENDIF
    1227              wind10cm(kwb)=wind10ms(kwb)*100.
    12281222             DO n=1,ntyp
    12291223                   ft1=0.
    … …  
    12681262! Cas ou wsta=0.
    12691263                      cdnms=vkarm/(log(z10m/z0salt))
    1270                       modwm=sqrt((wind10ms(kwb)**2)+(1.2*zwstar(i))**2)
     1264                      modwm=sqrt((wind10ms(i,kwb)**2)+(1.2*zwstar(i))**2)
    12711265                      ustarns=cdnms*modwm*100.
    12721266                    ustarsalt=ustarns
    1273 
     1267!                   print*,'LAAAAAAAAAAAAAAAAAA modwm=',modwm
    12741268
    12751269                   IF(ustarsalt.lt.umin/ceff)GOTO 80
    … …  
    13271321             ENDDO !n=1,ntyp
    1328132270 CONTINUE
    1329         fluxdust(i,1)=fluxdust(i,1)+flux1*probu(kwb)
    1330         fluxdust(i,2)=fluxdust(i,2)+flux2*probu(kwb)
    1331         fluxdust(i,3)=fluxdust(i,3)+flux3*probu(kwb)
     1323        fluxdust(i,1)=fluxdust(i,1)+flux1*probu(i,kwb)
     1324        fluxdust(i,2)=fluxdust(i,2)+flux2*probu(i,kwb)
     1325        fluxdust(i,3)=fluxdust(i,3)+flux3*probu(i,kwb)
    13321326   ENDDO !kwb=1,nwb
    13331327      m1dflux(i)=10.*fluxdust(i,1)
    … …  
    14101404         enddo
    14111405         if(kfin.ge.nclass)then
    1412             print*,'$$$$ Tables dimension problem:',kfin,'>',nclass
     1406!           print*,'$$$$ Tables dimension problem:',kfin,'>',nclass
    14131407         endif
    14141408!---------------       

  • LMDZ6/branches/contrails/libf/phylmd/Dust/phytracr_spl_mod.F90

    r5618 r5717  
    804804                      beta_fisrt,beta_v1,                              &  ! I
    805805                      zu10m,zv10m,wstar,ale_bl,ale_wake,               &  ! I
     806                      nsurfwind,wind10ms,probu,                        &  ! I 
    806807                      d_tr_dyn,tr_seri)                                            ! O
    807808!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    … …  
    847848!  divers:
    848849!  -------
    849 !
     850      INTEGER, intent(in) ::  nsurfwind
     851      REAL,DIMENSION(klon,nsurfwind),INTENT(IN)    :: wind10ms
     852      REAL,DIMENSION(klon,nsurfwind),INTENT(IN)    :: probu
    850853      real,intent(in) :: pdtphys  ! pas d'integration pour la physique (seconde)
    851854      REAL, intent(in):: jD_cur, jH_cur
    … …  
    21532156                        rlat,rlon,debutphy,                                &
    21542157                        zu10m,zv10m,wstar,ale_bl,ale_wake,                 &
     2158                        nsurfwind,wind10ms,probu,                          &
    21552159                        scale_param_ssacc,scale_param_sscoa,               &
    21562160                        scale_param_dustacc,scale_param_dustcoa,           &

  • LMDZ6/branches/contrails/libf/phylmd/StratAer/calcaerosolstrato_rrtm.f90

    r5618 r5717  
    77  USE iniprint_mod_h
    88  USE phys_state_var_mod, ONLY: tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm, tau_aero_lw_rrtm
    9   USE phys_local_var_mod, ONLY: mdw, tausum_aero, tausum_strat, tau_strat_550, tau_strat_1020, stratomask
     9  USE phys_local_var_mod, ONLY: mdw, tausum_aero, tausum_strat, tau_strat_443, tau_strat_550, &
     10       tau_strat_670, tau_strat_765, tau_strat_1020, tau_strat_10um, stratomask
    1011  USE aero_mod
    1112  USE dimphy
    … …  
    8687  DO k=1,klev
    8788    IF (stratomask(i,k).GT.0.5) THEN
    88       tausum_strat(i,1)=tausum_strat(i,1)+tau_strat_wave(i,k,2)  !--550 nm
    89       tausum_strat(i,2)=tausum_strat(i,2)+tau_strat_wave(i,k,5)  !--1020 nm
    90       tausum_strat(i,3)=tausum_strat(i,3)+tau_strat_wave(i,k,6)  !--10 um
     89      tausum_strat(i,1)=tausum_strat(i,1)+tau_strat_wave(i,k,1)  !--443 nm
     90      tausum_strat(i,2)=tausum_strat(i,2)+tau_strat_wave(i,k,2)  !--550 nm
     91      tausum_strat(i,3)=tausum_strat(i,3)+tau_strat_wave(i,k,3)  !--670 nm
     92      tausum_strat(i,4)=tausum_strat(i,4)+tau_strat_wave(i,k,4)  !--765 nm
     93      tausum_strat(i,5)=tausum_strat(i,5)+tau_strat_wave(i,k,5)  !--1020 nm
     94      tausum_strat(i,6)=tausum_strat(i,6)+tau_strat_wave(i,k,6)  !--10 um
    9195    ENDIF
    9296  ENDDO
    … …  
    97101    zrho=pplay(i,k)/t_seri(i,k)/RD            !air density in kg/m3
    98102    zdz=(paprs(i,k)-paprs(i,k+1))/zrho/RG     !thickness of layer in m
    99     tau_strat_550(i,k)=tau_strat_wave(i,k,2)/zdz
    100     tau_strat_1020(i,k)=tau_strat_wave(i,k,5)/zdz
     103        tau_strat_443(i,k)=tau_strat_wave(i,k,1)/zdz
     104        tau_strat_550(i,k)=tau_strat_wave(i,k,2)/zdz
     105        tau_strat_670(i,k)=tau_strat_wave(i,k,3)/zdz
     106        tau_strat_765(i,k)=tau_strat_wave(i,k,4)/zdz
     107        tau_strat_1020(i,k)=tau_strat_wave(i,k,5)/zdz
     108        tau_strat_10um(i,k)=tau_strat_wave(i,k,6)/zdz
    101109  ENDDO
    102110  ENDDO

  • LMDZ6/branches/contrails/libf/phylmd/StratAer/so2_to_h2so4.f90

    r5268 r5717  
    99  USE yomcst_mod_h, ONLY : RG, RD
    1010  ! lifetime (sec) et O3_clim (VMR)
    11   USE phys_local_var_mod, ONLY : SO2_lifetime, H2SO4_lifetime, O3_clim, budg_3D_so2_to_h2so4, budg_so2_to_h2so4
     11  USE phys_local_var_mod, ONLY : SO2_lifetime,H2SO4_lifetime,O3_clim,budg_3D_so2_to_h2so4,budg_so2_to_h2so4,SO2_chlm
    1212  USE strataer_local_var_mod, ONLY : flag_OH_reduced, flag_H2SO4_photolysis, flag_min_rreduce
    1313 
    … …  
    3232  budg_3D_so2_to_h2so4(:,:)=0.0
    3333  budg_so2_to_h2so4(:)=0.0
    34 
     34  SO2_chlm(:,:)=0.0
     35 
    3536  DO ilon=1, klon
    3637     DO ilev=1, klev
    … …  
    108109           ! IF (SO2_lifetime(ilon,ilev).GT.0.0 .AND. SO2_lifetime(ilon,ilev).LT.1.E10) THEN
    109110           
     111           SO2_chlm(ilon,ilev) = tr_seri(ilon,ilev,id_SO2_strat)*(1.0-exp(-pdtphys/rreduce)) * &
     112                pplay(ilon,ilev)/(t_seri(ilon,ilev)*1.38e-19)  / pdtphys  !SO2 loss rate [mole.cm-3.s-1]
    110113           
    111114           IF (flag_H2SO4_photolysis) THEN
    … …  
    145148                (paprs(ilon,ilev)-paprs(ilon,ilev+1))/RG/pdtphys
    146149           budg_so2_to_h2so4(ilon)=budg_so2_to_h2so4(ilon)+budg_3D_so2_to_h2so4(ilon,ilev)
     150        ELSE
     151           ! troposphere
     152           ! SO2 tropospheric lifetime (in sec) set to 5 days
     153           rreduce =  5.0*24.0*60.0*60.0
     154           rrate =tr_seri(ilon,ilev,id_SO2_strat)*(1.0-exp(-pdtphys/rreduce))
     155           tr_seri(ilon,ilev,id_SO2_strat)=tr_seri(ilon,ilev,id_SO2_strat) - rrate
     156           SO2_chlm(ilon,ilev) = rrate * &
     157                pplay(ilon,ilev)/(t_seri(ilon,ilev)*1.38e-19)  / pdtphys  !SO2 loss rate [moleccm-3s-1]
    147158        ENDIF
    148159        ! IF (is_strato(ilon,ilev)) THEN

  • LMDZ6/branches/contrails/libf/phylmd/StratAer/strataer_local_var_mod.f90

    r5618 r5717  
    259259   
    260260    !--initialising dry diameters to geometrically spaced mass/volume (see Jacobson 1994)
    261     mdw(1)=mdwmin
    262     IF (V_rat.LT.1.62) THEN ! compensate for dip in second bin for lower volume ratio
    263        mdw(2)=mdw(1)*2.**(1./3.)
    264        DO it=3, nbtr_bin
    265           mdw(it)=mdw(it-1)*V_rat**(1./3.)
    266        ENDDO
     261    IF(nbtr_bin < 3) THEN
     262       WRITE(lunout,*) 'WARNING: There are less than 3 sulfur aerosol class, it could be a problem for StratAer usage !'
     263       WRITE(lunout,*) 'NBTR_BIN=',nbtr_bin
    267264    ELSE
    268        DO it=2, nbtr_bin
    269           mdw(it)=mdw(it-1)*V_rat**(1./3.)
    270        ENDDO
    271     ENDIF
    272     IF (is_master) WRITE(lunout,*) 'init mdw=', mdw
     265       mdw(1)=mdwmin
     266       IF (V_rat.LT.1.62) THEN ! compensate for dip in second bin for lower volume ratio
     267          mdw(2)=mdw(1)*2.**(1./3.)
     268          DO it=3, nbtr_bin
     269             mdw(it)=mdw(it-1)*V_rat**(1./3.)
     270          ENDDO
     271       ELSE
     272          DO it=2, nbtr_bin
     273             mdw(it)=mdw(it-1)*V_rat**(1./3.)
     274          ENDDO
     275       ENDIF
     276       IF (is_master) WRITE(lunout,*) 'init mdw=', mdw
     277    ENDIF
    273278   
    274279    !   compute particle radius RRSI [cm] and volume Vbin [m3] from diameter mdw [m]

  • LMDZ6/branches/contrails/libf/phylmd/clesphys_mod_h.f90

    r5618 r5717  
    2727          , ecrit_mth, ecrit_tra, ecrit_reg                            &
    2828          , top_height                                                 &
    29           , iflag_cycle_diurne, soil_model, new_oliq                   &
     29          , iflag_cycle_diurne, soil_model, liqice_in_radocond         &
    3030          , ok_orodr, ok_orolf, ok_limitvrai, nbapp_rad                &
    3131          , iflag_con, nbapp_cv, nbapp_wk                              &
    … …  
    5151          , iflag_phytrac, ok_new_lscp, ok_bs, ok_rad_bs               &
    5252          , iflag_thermals, nsplit_thermals              &
    53           , iflag_physiq, ok_3Deffect, ok_water_mass_fixer
     53          , iflag_physiq, ok_3Deffect, ok_water_mass_fixer             &
     54          , ok_mass_dtcon, ok_mass_dqcon, ok_mass_duvcon
    5455
    5556
    … …  
    5758  REAL nm_oro_t, zpmm_orodr_t, zpmm_orolf_t, zstd_orodr_t
    5859  INTEGER iflag_cycle_diurne
    59   LOGICAL soil_model, new_oliq, ok_orodr, ok_orolf
     60  LOGICAL soil_model, liqice_in_radocond, ok_orodr, ok_orolf
    6061  LOGICAL ok_limitvrai
    6162  LOGICAL ok_all_xml
    … …  
    160161  LOGICAL :: ok_water_mass_fixer
    161162
     163  ! for conservation when calling deep convection every n time steps
     164  LOGICAL :: ok_mass_dtcon, ok_mass_dqcon, ok_mass_duvcon
     165
     166
    162167
    163168  !$OMP THREADPRIVATE(co2_ppm, solaire                                           &
    … …  
    184189  !$OMP      , ecrit_mth, ecrit_tra, ecrit_reg                            &
    185190  !$OMP      , top_height                                                 &
    186   !$OMP      , iflag_cycle_diurne, soil_model, new_oliq                   &
     191  !$OMP      , iflag_cycle_diurne, soil_model, liqice_in_radocond         &
    187192  !$OMP      , ok_orodr, ok_orolf, ok_limitvrai, nbapp_rad                &
    188193  !$OMP      , iflag_con, nbapp_cv, nbapp_wk                              &
    … …  
    208213  !$OMP      , iflag_phytrac, ok_new_lscp, ok_bs, ok_rad_bs               &
    209214  !$OMP      , iflag_thermals, nsplit_thermals              &
    210   !$OMP      , iflag_physiq, ok_3Deffect, ok_water_mass_fixer)
     215  !$OMP      , iflag_physiq, ok_3Deffect, ok_water_mass_fixer             &
     216  !$OMP      , ok_mass_dtcon, ok_mass_dqcon, ok_mass_duvcon )
    211217
    212218END MODULE clesphys_mod_h

  • LMDZ6/branches/contrails/libf/phylmd/compbl_mod_h.f90

    r5296 r5717  
    33MODULE compbl_mod_h
    44  IMPLICIT NONE; PRIVATE
    5   PUBLIC iflag_pbl, iflag_pbl_split, iflag_order2_sollw, ifl_pbltree
     5  PUBLIC iflag_pbl, iflag_pbl_split, iflag_order2_sollw, ifl_pbltree, iflag_hetero_surf
    66
    77  !!      integer iflag_pbl,iflag_pbl_split
    … …  
    99  !!FC      integer iflag_pbl, iflag_pbl_split, iflag_order2_sollw
    1010  !FC      common/compbl/iflag_pbl, iflag_pbl_split, iflag_order2_sollw
    11   INTEGER iflag_pbl, iflag_pbl_split, iflag_order2_sollw, ifl_pbltree
    12   !$OMP THREADPRIVATE(iflag_pbl, iflag_pbl_split, iflag_order2_sollw, ifl_pbltree)
     11  INTEGER iflag_pbl, iflag_pbl_split, iflag_order2_sollw, ifl_pbltree, iflag_hetero_surf
     12  !$OMP THREADPRIVATE(iflag_pbl, iflag_pbl_split, iflag_order2_sollw, ifl_pbltree, iflag_hetero_surf)
    1313
    1414  !>jyg+al1

  • LMDZ6/branches/contrails/libf/phylmd/conf_phys_m.f90

    r5618 r5717  
    193193    REAL,SAVE :: Cd_frein_omp
    194194!FC
     195!AM
     196    INTEGER,SAVE :: iflag_hetero_surf_omp
    195197    INTEGER,SAVE :: iflag_order2_sollw_omp
    196198    INTEGER, SAVE :: lev_histins_omp, lev_histLES_omp
    … …  
    216218    REAL, SAVE    :: zpmm_orodr_t_omp, zpmm_orolf_t_omp
    217219    INTEGER, SAVE :: iflag_cycle_diurne_omp
    218     LOGICAL, SAVE :: soil_model_omp,new_oliq_omp
     220    LOGICAL, SAVE :: soil_model_omp,liqice_in_radocond_omp
    219221    LOGICAL, SAVE :: ok_orodr_omp, ok_orolf_omp, ok_limitvrai_omp
    220222    INTEGER, SAVE :: nbapp_rad_omp, iflag_con_omp
    … …  
    247249    INTEGER,SAVE  :: kz0_omp
    248250    LOGICAL, SAVE :: ok_bs_omp, ok_rad_bs_omp
    249 
     251    LOGICAL, SAVE :: ok_mass_dtcon_omp, ok_mass_dqcon_omp, ok_mass_duvcon_omp
    250252
    251253    INTEGER, INTENT(OUT):: read_climoz ! read ozone climatology, OpenMP shared
    … …  
    869871    CALL getin('soil_model',soil_model_omp)
    870872
    871     !Config  Key  = new_oliq
    872     !Config  Desc = Nouvelle eau liquide
     873    !Config  Key  = liqice_in_radocond
     874    !Config  Desc = liquid + ice seen by radiation
    873875    !Config  Def  = y
    874     !Config  Help = Permet de mettre en route la
    875     !Config         nouvelle parametrisation de l'eau liquide !
    876     new_oliq_omp = .TRUE.
    877     CALL getin('new_oliq',new_oliq_omp)
     876    liqice_in_radocond_omp = .TRUE.
     877    ! old name of the flag (new_oliq)
     878    CALL getin('new_oliq',liqice_in_radocond_omp)
     879    CALL getin('liqice_in_radocond',liqice_in_radocond_omp)
    878880
    879881    !Config  Key  = ok_orodr
    … …  
    10101012    ok_conserv_q_omp = .FALSE.
    10111013    CALL getin('ok_conserv_q',ok_conserv_q_omp)
     1014
     1015
     1016
     1017    !Config  Key  = ok_mass_dtcon
     1018    !Config  Desc = for conservation when calling deep convection every n time steps
     1019    !Config  Def  = y
     1020    !Config  Help = for conservation when calling deep convection every n time steps
     1021    ok_mass_dtcon_omp = .TRUE.
     1022    CALL getin('ok_mass_dtcon',ok_mass_dtcon_omp)
     1023
     1024    !Config  Key  = ok_mass_dqcon
     1025    !Config  Desc = for conservation when calling deep convection every n time steps
     1026    !Config  Def  = y
     1027    !Config  Help = for conservation when calling deep convection every n time steps
     1028    ok_mass_dqcon_omp = .TRUE.
     1029    CALL getin('ok_mass_dqcon',ok_mass_dqcon_omp)
     1030
     1031    !Config  Key  = ok_mass_duvcon
     1032    !Config  Desc = for conservation when calling deep convection every n time steps
     1033    !Config  Def  = y
     1034    !Config  Help = for conservation when calling deep convection every n time steps
     1035    ok_mass_duvcon_omp = .TRUE.
     1036    CALL getin('ok_mass_duvcon',ok_mass_duvcon_omp)
     1037
    10121038
    10131039    !
    … …  
    15241550    Cd_frein_omp = 7.5E-02
    15251551    CALL getin('Cd_frein',Cd_frein_omp)
    1526 
     1552!AM
     1553    !Config Key  = iflag_hetero_surf
     1554    !Config Desc = type of treatment for heterogeneous continental sub-surfaces
     1555    !Config Def  = 0
     1556    !Config Help = 0: homo. surface; 1: heteo. surface with parameter aggregation; 2: heteo surface with flux aggregation
     1557    !
     1558    iflag_hetero_surf_omp = 0
     1559    CALL getin('iflag_hetero_surf',iflag_hetero_surf_omp)
    15271560    !
    15281561    !Config Key  = iflag_pbl_split
    … …  
    23272360    iflag_cycle_diurne = iflag_cycle_diurne_omp
    23282361    soil_model = soil_model_omp
    2329     new_oliq = new_oliq_omp
     2362    liqice_in_radocond = liqice_in_radocond_omp
    23302363    ok_orodr = ok_orodr_omp
    23312364    ok_orolf = ok_orolf_omp
    … …  
    23402373    nbapp_wk = nbapp_wk_omp
    23412374    iflag_ener_conserv = iflag_ener_conserv_omp
     2375    ok_mass_dtcon = ok_mass_dtcon_omp
     2376    ok_mass_dqcon = ok_mass_dqcon_omp
     2377    ok_mass_duvcon = ok_mass_duvcon_omp
    23422378    ok_conserv_q = ok_conserv_q_omp
    23432379    epmax = epmax_omp
    … …  
    23822418    ifl_pbltree = ifl_pbltree_omp
    23832419    Cd_frein    =Cd_frein_omp
     2420!AM
     2421    iflag_hetero_surf = iflag_hetero_surf_omp
    23842422    iflag_order2_sollw = iflag_order2_sollw_omp
    23852423    lev_histhf = lev_histhf_omp
    … …  
    27482786    WRITE(lunout,*) ' iflag_cycle_diurne=',iflag_cycle_diurne
    27492787    WRITE(lunout,*) ' soil_model=',soil_model
    2750     WRITE(lunout,*) ' new_oliq=',new_oliq
     2788    WRITE(lunout,*) ' liqice_in_radocond=',liqice_in_radocond
    27512789    WRITE(lunout,*) ' ok_orodr=',ok_orodr
    27522790    WRITE(lunout,*) ' ok_orolf=',ok_orolf
    … …  
    27622800    WRITE(lunout,*) ' iflag_ener_conserv=',iflag_ener_conserv
    27632801    WRITE(lunout,*) ' ok_conserv_q=',ok_conserv_q
     2802    WRITE(lunout,*) ' ok_mass_dtcon=',ok_mass_dtcon
     2803    WRITE(lunout,*) ' ok_mass_dqcon=',ok_mass_dqcon
     2804    WRITE(lunout,*) ' ok_mass_duvcon=',ok_mass_duvcon
    27642805    WRITE(lunout,*) ' epmax = ', epmax
    27652806    WRITE(lunout,*) ' coef_epmax_cape = ', coef_epmax_cape
    … …  
    28302871    WRITE(lunout,*) ' ifl_pbltree = ', ifl_pbltree
    28312872    WRITE(lunout,*) ' Cd_frein = ', Cd_frein
     2873!AM
     2874    WRITE(lunout,*) ' iflag_hetero_surf = ', iflag_hetero_surf
    28322875    WRITE(lunout,*) ' iflag_pbl_split = ', iflag_pbl_split
    28332876    WRITE(lunout,*) ' iflag_order2_sollw = ', iflag_order2_sollw

  • LMDZ6/branches/contrails/libf/phylmd/cv3_routines.f90

    r5618 r5717  
    1212  USE conema3_mod_h
    1313  USE lmdz_cv_ini, ONLY : alpha,alpha1,beta,betad,coef_peel,cv_flag_feed,delta,dpbase,dtcrit,dtovsh,dttrig,ejectice,ejectliq,elcrit,flag_epkeorig,flag_wb,minorig,nl,nlm,nlp,noconv_stop,noff,omtrain,pbcrit,ptcrit,sigdz,spfac,t_top_max,tau,tau_stop,tlcrit,wbmax
    14   USE lmdz_cv_ini, ONLY : keep_bug_indices_cv3_tracer, keep_bug_q_nocons_cv
     14  USE lmdz_cv_ini, ONLY : keep_bug_indices_cv3_tracer
    1515
    1616
    … …  
    142142     keep_bug_indices_cv3_tracer = .FALSE.
    143143     CALL getin_p('keep_bug_indices_cv3_tracer', keep_bug_indices_cv3_tracer)
    144      keep_bug_q_nocons_cv = .TRUE.
    145      CALL getin_p('keep_bug_q_nocons_cv', keep_bug_q_nocons_cv)
    146144
    147145
    … …  
    171169    WRITE (*, *) 'keepbug_ice_frac =', keepbug_ice_frac
    172170    WRITE (*, *) 'keep_bug_indices_cv3_tracer =', keep_bug_indices_cv3_tracer
    173     WRITE (*, *) 'keep_bug_q_nocons_cv =', keep_bug_q_nocons_cv
    174171
    175172    first = .FALSE.
    … …  
    27072704                     wdtrainA, wdtrainS, wdtrainM)                                      ! RomP
    27082705  USE lmdz_cv_ini, ONLY : cpd,ginv,grav,nl,nlp,sigdz
    2709   USE lmdz_cv_ini, ONLY : keep_bug_q_nocons_cv
    27102706  USE cvflag_mod_h
    27112707  USE print_control_mod, ONLY: prt_level, lunout
    … …  
    29122908  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    29132909  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    2914   IF (keep_bug_q_nocons_cv) THEN
    2915   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    2916         DO il = 1, ncum
    2917           IF (i<=inb(il) .AND. lwork(il)) THEN
    2918             wdtrain(il) = grav*ep(il, i)*m(il, i)*clw(il, i)
    2919             wdtrainS(il, i) = wdtrain(il)/grav                                            !   Ps   jyg
    2920           END IF
    2921         END DO
    2922    
    2923         IF (i>1) THEN
    2924           DO j = 1, i - 1
    2925             DO il = 1, ncum
    2926               IF (i<=inb(il) .AND. lwork(il)) THEN
    2927                 awat = elij(il, j, i) - (1.-ep(il,i))*clw(il, i)
    2928                 awat = max(awat, 0.0)
    2929                 wdtrain(il) = wdtrain(il) + grav*awat*ment(il, j, i)
    2930                 wdtrainM(il, i) = wdtrain(il)/grav - wdtrainS(il, i)    !   Pm  jyg
    2931               END IF
    2932             END DO
    2933           END DO
    2934         END IF
    2935    
    2936         IF (cvflag_prec_eject) THEN
    2937     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    2938           IF (adiab_ascent_mass_flux_depends_on_ejectliq) THEN
    2939     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    2940     !!! Warning : this option leads to water conservation violation
    2941     !!!           Expert only
    2942     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    2943               IF ( i > 1) THEN
    2944                 DO il = 1, ncum
    2945                   IF (i<=inb(il) .AND. lwork(il)) THEN
    2946                     wdtrainA(il,i) = ma(il, i+1)*(qta(il, i-1)-qta(il,i))/(1. - qta(il, i-1))    !   Pa   jygprl
    2947                     wdtrain(il) = wdtrain(il) + grav*wdtrainA(il,i)
    2948                   END IF
    2949                 END DO
    2950               ENDIF  ! ( i > 1)
    2951     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    2952           ELSE ! (adiab_ascent_mass_flux_depends_on_ejectliq)
    2953     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    2954               IF ( i > 1) THEN
    2955                 DO il = 1, ncum
    2956                   IF (i<=inb(il) .AND. lwork(il)) THEN
    2957                     wdtrainA(il,i) = ma(il, i+1)*(qta(il, i-1)-qta(il,i))                        !   Pa   jygprl
    2958                     wdtrain(il) = wdtrain(il) + grav*wdtrainA(il,i)
    2959                   END IF
    2960                 END DO
    2961               ENDIF  ! ( i > 1)
    2962    
    2963           ENDIF ! (adiab_ascent_mass_flux_depends_on_ejectliq) ELSE
    2964     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    2965         ENDIF  ! (cvflag_prec_eject)
    2966    
    2967   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    2968   ELSE ! (keep_bug_q_nocons_cv)
    2969   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    29702910        DO il = 1, ncum
    29712911          IF (i<=inb(il) .AND. lwork(il)) THEN
    … …  
    30232963        ENDIF  ! ( i > 1)
    30242964   
    3025   !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    3026   ENDIF ! (keep_bug_q_nocons_cv)
    30272965  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    30282966  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    … …  
    35193457    USE cvflag_mod_h
    35203458   USE lmdz_cv_ini, ONLY : grav,minorig,nl,nlp,rowl,rrd,nl,ci,cl,cpd,cpv
    3521    USE lmdz_cv_ini, ONLY : keep_bug_q_nocons_cv
    35223459  IMPLICIT NONE
    35233460
    … …  
    40954032           IF (ok_optim_yield) THEN                       !|
    40964033!-----------------------------------------------------------
    4097     IF (keep_bug_q_nocons_cv) THEN    !!jyg20250215
    4098       DO il = 1, ncum
    4099          amp1(il) = upwd(il,i+1)
    4100          ad(il) = dnwd(il,i)
    4101       ENDDO
    4102     ELSE  ! (keep_bug_q_nocons_cv)
    41034034      DO il = 1, ncum
    41044035         amp1(il) = upwd(il,i+1)
    41054036         ad(il) = - dnwd(il,i)
    41064037      ENDDO
    4107     ENDIF  ! (keep_bug_q_nocons_cv)
    41084038!-----------------------------------------------------------
    41094039        ELSE !(ok_optim_yield)                            !|

  • LMDZ6/branches/contrails/libf/phylmd/dimphy.f90

    r5618 r5717  
    1212  INTEGER,SAVE :: klevm1
    1313  INTEGER,SAVE :: kflev
     14  INTEGER,SAVE :: nbtersrf !AM
     15  INTEGER,SAVE :: nbtsoildepths !AM
    1416
    1517!$OMP THREADPRIVATE(klon,kfdia,kidia,kdlon)
    … …  
    4446  END SUBROUTINE Init_dimphy
    4547
    46   SUBROUTINE Init_dimphy1D(klon0,klev0)
     48  SUBROUTINE Init_dimphy1D(klon0,klev0,nbtersrf0,nbtsoildepths0)
    4749! 1D special version of dimphy without ALLOCATE(zmasq)
    4850! which will be allocated in iniphysiq
    … …  
    5153    INTEGER, INTENT(in) :: klon0
    5254    INTEGER, INTENT(in) :: klev0
    53    
     55    INTEGER, INTENT(in), OPTIONAL :: nbtersrf0
     56    INTEGER, INTENT(in), OPTIONAL :: nbtsoildepths0
     57
    5458    klon=klon0
    5559    kdlon=klon
    … …  
    6064    klevm1=klev-1
    6165    kflev=klev
    62    
     66
     67    IF (PRESENT(nbtersrf0)) THEN
     68      nbtersrf=nbtersrf0
     69    ELSE
     70      nbtersrf = 0
     71    ENDIF
     72    IF (PRESENT(nbtsoildepths0)) THEN
     73      nbtsoildepths=nbtsoildepths0
     74    ELSE
     75      nbtsoildepths = 0
     76    ENDIF
     77
    6378  END SUBROUTINE Init_dimphy1D
    6479

  • LMDZ6/branches/contrails/libf/phylmd/dyn1d/1DUTILS.h

    r5392 r5717  
    415415       CALL getin('tau_soil_nudge',tau_soil_nudge)
    416416
     417!Config  Key  = nb_ter_srf
     418!Config  Desc = nb_ter_srf
     419!Config  Def  = 0
     420!Config  Help =
     421       nb_ter_srf = 0
     422       CALL getin('nb_ter_srf',nb_ter_srf)
     423
     424!Config  Key  = alpha_soil_ter_srf
     425!Config  Desc = alpha_soil_ter_srf
     426!Config  Def  = 2.
     427!Config  Help =
     428       alpha_soil_ter_srf = 2.
     429       CALL getin('alpha_soil_ter_srf',alpha_soil_ter_srf)
     430
     431!Config  Key  = period_ter_srf
     432!Config  Desc = period_ter_srf
     433!Config  Def  = 1800.
     434!Config  Help =
     435       period_ter_srf = 1800.
     436       CALL getin('period_ter_srf',period_ter_srf)
     437
     438!Config  Key  = frac_ter_srf
     439!Config  Desc = frac_ter_srf
     440!Config  Def  = 0.
     441!Config  Help =
     442       frac_ter_srf = 0.
     443       CALL getin('frac_ter_srf',frac_ter_srf)
     444
     445!Config  Key  = rugos_ter_srf
     446!Config  Desc = rugos_ter_srf
     447!Config  Def  = 0.
     448!Config  Help =
     449       rugos_ter_srf = 0.
     450       CALL getin('rugos_ter_srf',rugos_ter_srf)
     451
     452!Config  Key  = ratio_z0m_z0h_ter_srf
     453!Config  Desc = ratio_z0m_z0h_ter_srf
     454!Config  Def  = 10.
     455!Config  Help =
     456       ratio_z0m_z0h_ter_srf = 10.
     457       CALL getin('ratio_z0m_z0h_ter_srf',ratio_z0m_z0h_ter_srf)
     458
     459!Config  Key  = albedo_ter_srf
     460!Config  Desc = albedo_ter_srf
     461!Config  Def  = 0.
     462!Config  Help =
     463       albedo_ter_srf = 0.
     464       CALL getin('albedo_ter_srf',albedo_ter_srf)
     465
     466!Config  Key  = beta_ter_srf
     467!Config  Desc = beta_ter_srf
     468!Config  Def  = 0.
     469!Config  Help =
     470       beta_ter_srf = 0.
     471       CALL getin('beta_ter_srf',beta_ter_srf)
     472
     473!Config  Key  = inertie_ter_srf
     474!Config  Desc = inertie_ter_srf
     475!Config  Def  = 0.
     476!Config  Help =
     477       inertie_ter_srf = 0.
     478       CALL getin('inertie_ter_srf',inertie_ter_srf)
     479
     480!Config  Key  = hcond_ter_srf
     481!Config  Desc = hcond_ter_srf
     482!Config  Def  = 0.
     483!Config  Help =
     484       hcond_ter_srf = 0.
     485       CALL getin('hcond_ter_srf',hcond_ter_srf)
     486
     487!Config  Key  = tsurf_ter_srf
     488!Config  Desc = tsurf_ter_srf
     489!Config  Def  = 283.
     490!Config  Help =
     491       tsurf_ter_srf = 283.
     492       CALL getin('tsurf_ter_srf',tsurf_ter_srf)
     493
     494!Config  Key  = tsoil_ter_srf
     495!Config  Desc = tsoil_ter_srf
     496!Config  Def  = 283.
     497!Config  Help =
     498       tsoil_ter_srf = 283.
     499       CALL getin('tsoil_ter_srf',tsoil_ter_srf)
     500
     501!Config  Key  = tsoil_depths
     502!Config  Desc = tsoil_depths
     503!Config  Def  = 0.
     504!Config  Help =
     505       tsoil_depths = 0.
     506       CALL getin('tsoil_depths',tsoil_depths)
     507
     508!Config  Key  = nb_tsoil_depths
     509!Config  Desc = nb_tsoil_depths
     510!Config  Def  = 0
     511!Config  Help =
     512       nb_tsoil_depths = 0
     513       CALL getin('nb_tsoil_depths',nb_tsoil_depths)
     514
    417515!----------------------------------------------------------
    418516! Param??tres de for??age pour les forcages communs:
    … …  
    631729      write(lunout,*)' nudging_t  = ', nudging_t
    632730      write(lunout,*)' nudging_qv  = ', nudging_qv
     731      write(lunout,*)' nb_ter_srf = ', nb_ter_srf
     732      write(lunout,*)' alpha_soil_ter_srf = ', alpha_soil_ter_srf
     733      write(lunout,*)' period_ter_srf = ', period_ter_srf
     734      write(lunout,*)' frac_ter_srf = ', frac_ter_srf
     735      write(lunout,*)' rugos_ter_srf = ', rugos_ter_srf
     736      write(lunout,*)' ratio_z0m_z0h_ter_srf = ', ratio_z0m_z0h_ter_srf
     737      write(lunout,*)' albedo_ter_srf = ', albedo_ter_srf
     738      write(lunout,*)' beta_ter_srf = ', beta_ter_srf
     739      write(lunout,*)' inertie_ter_srf = ', inertie_ter_srf
     740      write(lunout,*)' hcond_ter_srf = ', hcond_ter_srf
     741      write(lunout,*)' tsurf_ter_srf = ', tsurf_ter_srf
     742      write(lunout,*)' tsoil_ter_srf = ', tsoil_ter_srf
     743
    633744      IF (forcing_type .eq.40) THEN
    634745        write(lunout,*) '--- Forcing type GCSS Old --- with:'

  • LMDZ6/branches/contrails/libf/phylmd/dyn1d/compar1d_mod_h.f90

    r5302 r5717  
    88          iflag_nudge, snowmass, &
    99          restart, ok_old_disvert, &
     10          nb_ter_srf, alpha_soil_ter_srf, period_ter_srf, frac_ter_srf, &
     11          rugos_ter_srf, ratio_z0m_z0h_ter_srf, albedo_ter_srf, beta_ter_srf, &
     12          inertie_ter_srf, hcond_ter_srf, tsurf_ter_srf, tsoil_ter_srf, &
     13          tsoil_depths, nb_tsoil_depths, &
    1014          tadv, tadvv, tadvh, qadv, qadvv, qadvh, thadv, thadvv, thadvh, &
    1115          trad, forc_omega, forc_u, forc_v, forc_w, forc_geo, forc_ustar, &
    … …  
    4448  LOGICAL :: ok_old_disvert
    4549
     50  INTEGER :: nb_ter_srf
     51  REAL :: alpha_soil_ter_srf
     52  REAL :: period_ter_srf
     53  REAL, DIMENSION(5) :: frac_ter_srf
     54  REAL, DIMENSION(5) :: rugos_ter_srf
     55  REAL, DIMENSION(5) :: ratio_z0m_z0h_ter_srf
     56  REAL, DIMENSION(5) :: albedo_ter_srf
     57  REAL, DIMENSION(5) :: beta_ter_srf
     58  REAL, DIMENSION(5) :: inertie_ter_srf
     59  REAL, DIMENSION(5) :: hcond_ter_srf
     60  REAL, DIMENSION(5) :: tsurf_ter_srf
     61  REAL, DIMENSION(5*5) :: tsoil_ter_srf
     62  REAL, DIMENSION(5*5) :: tsoil_depths
     63  INTEGER :: nb_tsoil_depths
     64
    4665  ! Pour les forcages communs: ces entiers valent 0 ou 1
    4766  ! tadv= advection tempe, tadvv= adv tempe verticale, tadvh= adv tempe horizontale
    … …  
    6584  !$OMP      iflag_nudge, snowmass, &
    6685  !$OMP      restart, ok_old_disvert, &
     86  !$OMP      nb_ter_srf, frac_ter_srf, rugos_ter_srf, albedo_ter_srf,         &
     87  !$OMP      beta_ter_srf, inertie_ter_srf, alpha_soil_ter_srf,               &
     88  !$OMP      period_ter_srf, hcond_ter_srf, ratio_z0m_z0h_ter_srf,            &
     89  !$OMP      tsurf_ter_srf, tsoil_ter_srf, tsoil_depths, nb_tsoil_depths,     &
    6790  !$OMP      tadv, tadvv, tadvh, qadv, qadvv, qadvh, thadv, thadvv, thadvh, &
    6891  !$OMP      trad, forc_omega, forc_u, forc_v, forc_w, forc_geo, forc_ustar, &

  • LMDZ6/branches/contrails/libf/phylmd/dyn1d/scm.f90

    r5626 r5717  
    88       clwcon, detr_therm, &
    99       qsol, fevap, z0m, z0h, agesno, &
     10       frac_tersrf, z0m_tersrf, ratio_z0m_z0h_tersrf, &
     11       albedo_tersrf, beta_tersrf, inertie_tersrf, &
     12       alpha_soil_tersrf, period_tersrf, hcond_tersrf, &
     13       tsurfi_tersrf, tsoili_tersrf, tsoil_depth, &
    1014       du_gwd_rando, du_gwd_front, entr_therm, f0, fm_therm, &
    1115       falb_dir, falb_dif, &
    … …  
    179183      real :: fder(1),snsrf(1,nbsrf),qsurfsrf(1,nbsrf)
    180184      real :: tsoil(1,nsoilmx,nbsrf)
     185      ! AM
     186      REAL, ALLOCATABLE, DIMENSION(:,:) :: tsoil_ter_srf2 ! resized initial soil temperature on vertical levels (K)
     187      REAL, ALLOCATABLE, DIMENSION(:,:) :: tsoil_depths2  ! resized soil depth at which inititial temperature is given (m)
    181188
    182189!---------------------------------------------------------------------
    … …  
    223230!                           <> 0, tendencies of forcing are not added
    224231      INTEGER :: flag_inhib_forcing = 0
    225 
     232      CHARACTER(len=80) :: abort_message
     233      CHARACTER(len=20) :: modname = 'scm'
    226234
    227235      print*,'VOUS ENTREZ DANS LE 1D FORMAT STANDARD'
    … …  
    386394!     call init_phys_lmdz(1,1,llm,1,(/1/)) ! job now done via iniphysiq
    387395!     but we still need to initialize dimphy module (klon,klev,etc.)  here.
    388       call init_dimphy1D(1,llm)
     396      call init_dimphy1D(1,llm,nb_ter_srf,nb_tsoil_depths)
    389397      call suphel
    390398      call init_infotrac
    … …  
    561569        agesno  = xagesno
    562570        tsoil(:,:,:)=tsurf
     571
     572        iflag_hetero_surf = 0
     573        CALL getin('iflag_hetero_surf',iflag_hetero_surf)
     574
     575        IF (iflag_hetero_surf .GT. 0) THEN
     576          PRINT*, 'scm iflag_hetero_surf', iflag_hetero_surf
     577          IF ((nbtersrf .LT. 2) .OR. (nbtersrf .GT. max_nbtersrf)) THEN
     578            abort_message='The number of continental sub-surfaces (nb_ter_srf) must be between 2 and 5'
     579            CALL abort_physic(modname,abort_message,1)
     580          ENDIF
     581          ! resized initial soil temperature on vertical levels and soil depth at which inititial temperature is given
     582          ALLOCATE(tsoil_ter_srf2(nbtsoildepths,nbtersrf))
     583          ALLOCATE(tsoil_depths2(nbtsoildepths,nbtersrf))
     584          tsoil_ter_srf2(:,:) = 0.
     585          tsoil_depths2(:,:) = 0.
     586          DO i=1, nbtersrf
     587            DO l=1, nbtsoildepths
     588              k = nbtsoildepths*(i-1)+l
     589              tsoil_ter_srf2(l,i) = tsoil_ter_srf(k)
     590              tsoil_depths2(l,i) = tsoil_depths(k)
     591            ENDDO
     592          ENDDO
     593          !
     594          DO i=1, nbtersrf
     595            frac_tersrf(:,i) = frac_ter_srf(i)                   ! fraction of land surface heterogeneity (-)
     596            z0m_tersrf(:,i) = rugos_ter_srf(i)                   ! roughness length for momentum of land sub-surfaces (m)
     597            ratio_z0m_z0h_tersrf(:,i) = ratio_z0m_z0h_ter_srf(i) ! ratio of heat to momentum roughness length of land sub-surfaces (-)
     598            albedo_tersrf(:,i) = albedo_ter_srf(i)               ! albedo of land sub-surfaces (-)
     599            beta_tersrf(:,i) = beta_ter_srf(i)                   ! evapotranspiration coef of land sub-surfaces (-)
     600            inertie_tersrf(:,i) = inertie_ter_srf(i)             ! soil thermal inertia of land sub-surfaces (J/m2/K/s1/2)
     601            hcond_tersrf(:,i) = hcond_ter_srf(i)                 ! soil heat conductivity (W/(m.K))
     602            tsurfi_tersrf(:,i) = tsurf_ter_srf(i)                ! initial surface temperature (K)
     603            DO l=1, nbtsoildepths
     604              tsoili_tersrf(:,l,i) = tsoil_ter_srf2(l,i)         ! initial soil temperature on vertical levels (K)
     605              tsoil_depth(:,l,i) = tsoil_depths2(l,i)
     606            ENDDO
     607          ENDDO
     608          alpha_soil_tersrf = alpha_soil_ter_srf               ! ratio between the thicknesses of 2 successive layers (-)
     609          period_tersrf = period_ter_srf                       ! temperature oscillation amplitude period
     610          !
     611          DEALLOCATE(tsoil_ter_srf2)
     612          DEALLOCATE(tsoil_depths2)
     613        ENDIF
     614
    563615!-----------------------------------------------------------------------
    564616        call pbl_surface_init(fder, snsrf, qsurfsrf, tsoil)

  • LMDZ6/branches/contrails/libf/phylmd/indice_sol_mod.f90

    r5268 r5717  
    1414           INTEGER, SAVE    :: nvm_orch ! Nombre de type de vegetation ds ORCHIDEE                 
    1515           !$OMP THREADPRIVATE(nvm_orch)
     16!
     17!AM heterogeneous continental sub-surfaces
     18            !!! If max_nbtersrf is modified, please change also the output number in phys_output_ctrlout_mod.F90
     19            INTEGER, PARAMETER :: max_nbtersrf = 5  ! maximal number of continental sub-surfaces
     20            CHARACTER(len=1), DIMENSION(max_nbtersrf), PARAMETER :: nb_tersrf = (/'1', '2', '3', '4', '5'/)
     21            !!! nsoilout must be lower than nsoilmx
     22            INTEGER, PARAMETER :: nsoilout = 10  ! number of soil layers for output
     23            CHARACTER(len=2), DIMENSION(nsoilout), PARAMETER :: nb_soil = (/'01','02','03','04','05','06','07','08','09','10'/)!,'11','12','13','14'/)
    1624
    1725      END MODULE indice_sol_mod

  • LMDZ6/branches/contrails/libf/phylmd/lmdz_blowing_snow_ini.f90

    r5400 r5717  
    5858         CALL getin_p('qbst_bs',qbst_bs)
    5959
    60          pbst_bs= 0.0003
     60         pbst_bs= 0.00003
    6161         CALL getin_p('pbst_bs',pbst_bs)
    6262
    63          prt_bs= 0.0003
     63         prt_bs= 0.00003
    6464         CALL getin_p('prt_bs',prt_bs)
    6565
    66          zeta_bs= 3.
     66         zeta_bs= 1.
    6767         CALL getin_p('zeta_bs',zeta_bs)
    6868
    69          fallv_bs = 0.1
     69         fallv_bs = 0.5
    7070         CALL getin_p('fallv_bs',fallv_bs)
    7171

  • LMDZ6/branches/contrails/libf/phylmd/lmdz_cloud_optics_prop.f90

    r5691 r5717  
    2929  USE lmdz_cloud_optics_prop_ini , ONLY : k_ice0, df
    3030  USE lmdz_cloud_optics_prop_ini , ONLY : rg, rd, rpi
    31   USE lmdz_cloud_optics_prop_ini , ONLY : rad_chau1, rad_chau2, rad_froid, iflag_rei
     31  USE lmdz_cloud_optics_prop_ini , ONLY : rad_chau1, rad_chau2, iflag_rei
    3232  USE lmdz_cloud_optics_prop_ini , ONLY : ok_icefra_lscp, rei_max, rei_min
    3333  USE lmdz_cloud_optics_prop_ini , ONLY : rei_coef, rei_min_temp
    … …  
    207207  reice_pi = 0.
    208208
    209   IF (iflag_t_glace.EQ.0) THEN
     209  IF ((.NOT. ok_new_lscp) .AND. iflag_t_glace.EQ.0) THEN
    210210    DO k = 1, klev
    211211      DO i = 1, klon
    … …  
    233233
    234234      DO i = 1, klon
    235        
     235
    236236        IF ((.NOT. ptconv(i,k)) .AND. ok_new_lscp .AND. ok_icefra_lscp) THEN
    237237        ! EV: take the ice fraction directly from the lscp code

  • LMDZ6/branches/contrails/libf/phylmd/lmdz_cloud_optics_prop_ini.f90

    r5691 r5717  
    2020  REAL, PROTECTED :: cdnc_min_m3=-1.
    2121  REAL, PROTECTED :: rpi, rg, rd
    22   REAL, PROTECTED :: rad_chau1, rad_chau2, rad_froid
     22  REAL, PROTECTED :: rad_chau1, rad_chau2
    2323  REAL, PROTECTED :: rei_max, rei_min
    2424  REAL, PROTECTED :: rei_coef, rei_min_temp
    … …  
    4141!$OMP THREADPRIVATE(bl95_b0, bl95_b1, cdnc_max, cdnc_max_m3)
    4242!$OMP THREADPRIVATE(cdnc_min, cdnc_min_m3, rpi, rg, rd)
    43 !$OMP THREADPRIVATE(rad_chau1, rad_chau2, rad_froid, rei_max, rei_min)
     43!$OMP THREADPRIVATE(rad_chau1, rad_chau2, rei_max, rei_min)
    4444!$OMP THREADPRIVATE(rei_coef, rei_min_temp)
    4545!$OMP THREADPRIVATE(zepsec)
    … …  
    9999    CALL getin_p('rad_chau1',rad_chau1)
    100100    CALL getin_p('rad_chau2',rad_chau2)
    101     CALL getin_p('rad_froid ',rad_froid)
    102101    CALL getin_p('ok_icefra_lscp', ok_icefra_lscp)
    103102    iflag_rei = 0

  • LMDZ6/branches/contrails/libf/phylmd/lmdz_cv_ini.f90

    r5618 r5717  
    1414          nl, nlp, nlm
    1515  PUBLIC cpd, cpv, cl, ci, rrv, rrd, lv0, lf0, g, rowl, t0, clmcpv, clmcpd, cpdmcp, cpvmcpd, cpvmcl,  &
    16           clmci, eps, epsi, epsim1, ginv, hrd, grav, keep_bug_indices_cv3_tracer, &
    17           keep_bug_q_nocons_cv
     16          clmci, eps, epsi, epsim1, ginv, hrd, grav, keep_bug_indices_cv3_tracer
    1817
    1918
    … …  
    7271LOGICAL keep_bug_indices_cv3_tracer
    7372 !$OMP THREADPRIVATE( keep_bug_indices_cv3_tracer)
    74 LOGICAL keep_bug_q_nocons_cv
    75  !$OMP THREADPRIVATE( keep_bug_q_nocons_cv)
    7673
    7774END MODULE lmdz_cv_ini

  • LMDZ6/branches/contrails/libf/phylmd/lmdz_lscp_condensation.f90

    r5716 r5717  
    16901690!**********************************************************************************
    16911691
     1692
     1693!**********************************************************************************
     1694SUBROUTINE  condensation_cloudth(klon,                     &
     1695&           temp,qt,qt_th,frac_th,zpspsk,play,thetal_th,   &
     1696&           ratqs,sigma_qtherm,qsth,qsenv,qcloud,ctot,ctotth,ctot_vol,  &
     1697&           cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv)
     1698! This routine computes the condensation of clouds in convective boundary layers
     1699! with thermals assuming two separate distribution of the saturation deficit in
     1700! the thermal plumes and in the environment
     1701! It is based on the work of Arnaud Jam (Jam et al. 2013, BLM)
     1702! Author : Etienne Vignon (LMDZ/CNRS)
     1703! Date: February 2025
     1704! Date: Adapted from cloudth_vert_v3 in 2023 by Arnaud Otavio Jam
     1705! IMPORTANT NOTE: we assume iflag_cloudth_vert=7
     1706!-----------------------------------------------------------------------------------
     1707
     1708      use lmdz_lscp_ini,    only: iflag_cloudth_vert,iflag_ratqs,iflag_cloudth_vert_noratqs
     1709      use lmdz_lscp_ini,    only: vert_alpha, vert_alpha_th ,sigma1s_factor,sigma1s_power,sigma2s_factor,sigma2s_power,cloudth_ratqsmin
     1710      use lmdz_lscp_ini,    only: RTT, RG, RPI, RD, RV, RCPD, RLVTT, RLSTT, temp_nowater, min_frac_th_cld, min_neb_th
     1711
     1712      IMPLICIT NONE
     1713
     1714
     1715!------------------------------------------------------------------------------
     1716! Declarations
     1717!------------------------------------------------------------------------------
     1718
     1719! INPUT/OUTPUT
     1720
     1721      INTEGER, INTENT(IN)                         :: klon
     1722     
     1723
     1724      REAL, DIMENSION(klon),      INTENT(IN)      ::  temp          ! Temperature (liquid temperature) in the mesh [K] : has seen evap of precip
     1725      REAL, DIMENSION(klon),      INTENT(IN)      ::  qt            ! total water specific humidity in the mesh [kg/kg]: has seen evap of precip
     1726      REAL, DIMENSION(klon),      INTENT(IN)      ::  qt_th         ! total water specific humidity in thermals [kg/kg]: has not seen evap of precip
     1727      REAL, DIMENSION(klon),      INTENT(IN)      ::  thetal_th     ! Liquid potential temperature in thermals [K]: has not seen the evap of precip
     1728      REAL, DIMENSION(klon),      INTENT(IN)      ::  frac_th       ! Fraction of the mesh covered by thermals [0-1]
     1729      REAL, DIMENSION(klon),      INTENT(IN)      ::  zpspsk        ! Exner potential
     1730      REAL, DIMENSION(klon),      INTENT(IN)      ::  play          ! Pressure of layers [Pa]
     1731      REAL, DIMENSION(klon),      INTENT(IN)      ::  ratqs         ! Parameter that determines the width of the water distrib     [-]
     1732      REAL, DIMENSION(klon),      INTENT(IN)      ::  sigma_qtherm  ! Parameter determining the width of the distrib in thermals   [-]
     1733      REAL, DIMENSION(klon),      INTENT(IN)      ::  qsth          ! Saturation specific humidity in thermals
     1734      REAL, DIMENSION(klon),      INTENT(IN)      ::  qsenv         ! Saturation specific humidity in environment
     1735     
     1736      REAL, DIMENSION(klon),      INTENT(INOUT)      ::  ctot         ! Cloud fraction [0-1]
     1737      REAL, DIMENSION(klon),      INTENT(INOUT)      ::  ctotth       ! Cloud fraction [0-1] in thermals
     1738      REAL, DIMENSION(klon),      INTENT(INOUT)      ::  ctot_vol     ! Volume cloud fraction [0-1]
     1739      REAL, DIMENSION(klon),      INTENT(INOUT)      ::  qcloud       ! In cloud total water content [kg/kg]
     1740      REAL, DIMENSION(klon),      INTENT(OUT)      ::  cloudth_sth    ! mean saturation deficit in thermals
     1741      REAL, DIMENSION(klon),      INTENT(OUT)      ::  cloudth_senv   ! mean saturation deficit in environment
     1742      REAL, DIMENSION(klon),      INTENT(OUT)      ::  cloudth_sigmath  ! std of saturation deficit in thermals
     1743      REAL, DIMENSION(klon),      INTENT(OUT)      ::  cloudth_sigmaenv ! std of saturation deficit in environment
     1744
     1745
     1746! LOCAL VARIABLES
     1747
     1748      INTEGER itap,ind1,l,ig,iter,k
     1749      INTEGER iflag_topthermals, niter
     1750
     1751      REAL qcth(klon)
     1752      REAL qcenv(klon)
     1753      REAL qctot(klon)
     1754      REAL cth(klon)
     1755      REAL cenv(klon)   
     1756      REAL cth_vol(klon)
     1757      REAL cenv_vol(klon)
     1758      REAL qt_env(klon), thetal_env(klon)
     1759      REAL sqrtpi,sqrt2,sqrt2pi
     1760      REAL alth,alenv,ath,aenv
     1761      REAL sth,senv,sigma1s,sigma2s,sigma1s_fraca,sigma1s_ratqs
     1762      REAL inverse_rho,beta,a_Brooks,b_Brooks,A_Maj_Brooks,Dx_Brooks,f_Brooks
     1763      REAL xth,xenv,exp_xenv1,exp_xenv2,exp_xth1,exp_xth2
     1764      REAL xth1,xth2,xenv1,xenv2,deltasth, deltasenv
     1765      REAL IntJ,IntI1,IntI2,IntI3,IntJ_CF,IntI1_CF,IntI3_CF,coeffqlenv,coeffqlth
     1766      REAL zdelta,qsatbef,zcor
     1767      REAL Tbefth(klon), Tbefenv(klon)
     1768      REAL qlbef
     1769      REAL dqsatenv(klon), dqsatth(klon)
     1770      REAL zpdf_sig(klon),zpdf_k(klon),zpdf_delta(klon)
     1771      REAL zpdf_a(klon),zpdf_b(klon),zpdf_e1(klon),zpdf_e2(klon)
     1772      REAL qincloud(klon)
     1773      REAL alenvl, aenvl
     1774      REAL sthi, sthl, sthil, althl, athl, althi, athi, sthlc, deltasthc, sigma2sc
     1775
     1776
     1777!------------------------------------------------------------------------------
     1778! Initialisation
     1779!------------------------------------------------------------------------------
     1780
     1781
     1782      sqrt2pi=sqrt(2.*rpi)
     1783      sqrt2=sqrt(2.)
     1784      sqrtpi=sqrt(rpi)
     1785
     1786!-------------------------------------------------------------------------------
     1787! Thermal fraction calculation and standard deviation of the distribution
     1788!------------------------------------------------------------------------------- 
     1789
     1790! initialisations and calculation of temperature, humidity and saturation specific humidity
     1791
     1792cloudth_senv(:) = 0.
     1793cloudth_sth(:) = 0.
     1794cloudth_sigmaenv(:) = 0.
     1795cloudth_sigmath(:) = 0.
     1796
     1797
     1798DO ind1=1,klon
     1799 
     1800   Tbefenv(ind1) = temp(ind1)
     1801   thetal_env(ind1) = Tbefenv(ind1)/zpspsk(ind1)
     1802   Tbefth(ind1)  = thetal_th(ind1)*zpspsk(ind1)
     1803   qt_env(ind1)  = (qt(ind1)-frac_th(ind1)*qt_th(ind1))/(1.-frac_th(ind1)) !qt = a*qtth + (1-a)*qtenv
     1804
     1805ENDDO
     1806
     1807
     1808
     1809DO ind1=1,klon
     1810
     1811
     1812    IF (frac_th(ind1).GT.min_frac_th_cld) THEN !Thermal and environnement
     1813
     1814! Environment:
     1815
     1816
     1817        alenv=(RD/RV*RLVTT*qsenv(ind1))/(rd*thetal_env(ind1)**2)     
     1818        aenv=1./(1.+(alenv*RLVTT/rcpd))                             
     1819        senv=aenv*(qt_env(ind1)-qsenv(ind1))                           
     1820     
     1821
     1822! Thermals:
     1823
     1824
     1825        alth=(RD/RV*RLVTT*qsth(ind1))/(rd*thetal_th(ind1)**2)       
     1826        ath=1./(1.+(alth*RLVTT/rcpd))                                                         
     1827        sth=ath*(qt_th(ind1)-qsth(ind1))                     
     1828
     1829
     1830! Standard deviation of the distributions
     1831
     1832           ! environment
     1833           sigma1s_fraca = (sigma1s_factor**0.5)*(frac_th(ind1)**sigma1s_power) / &
     1834           &                (1-frac_th(ind1))*((sth-senv)**2)**0.5
     1835
     1836           IF (cloudth_ratqsmin>0.) THEN
     1837             sigma1s_ratqs = cloudth_ratqsmin*qt(ind1)
     1838           ELSE
     1839             sigma1s_ratqs = ratqs(ind1)*qt(ind1)
     1840           ENDIF
     1841           sigma1s = sigma1s_fraca + sigma1s_ratqs
     1842
     1843           IF (iflag_ratqs.eq.10.or.iflag_ratqs.eq.11) then
     1844              sigma1s = ratqs(ind1)*qt(ind1)*aenv
     1845           ENDIF
     1846
     1847           ! thermals
     1848           sigma2s=(sigma2s_factor*(((sth-senv)**2)**0.5)/((frac_th(ind1)+0.02)**sigma2s_power))+0.002*qt_th(ind1)
     1849
     1850          IF (iflag_ratqs.eq.10.and.sigma_qtherm(ind1).ne.0) then
     1851             sigma2s = sigma_qtherm(ind1)*ath
     1852          ENDIF
     1853
     1854 
     1855! surface cloud fraction
     1856
     1857           deltasenv=aenv*vert_alpha*sigma1s
     1858           deltasth=ath*vert_alpha_th*sigma2s
     1859
     1860           xenv1=-(senv+deltasenv)/(sqrt(2.)*sigma1s)
     1861           xenv2=-(senv-deltasenv)/(sqrt(2.)*sigma1s)
     1862           exp_xenv1 = exp(-1.*xenv1**2)
     1863           exp_xenv2 = exp(-1.*xenv2**2)
     1864           xth1=-(sth+deltasth)/(sqrt(2.)*sigma2s)
     1865           xth2=-(sth-deltasth)/(sqrt(2.)*sigma2s)
     1866           exp_xth1 = exp(-1.*xth1**2)
     1867           exp_xth2 = exp(-1.*xth2**2)
     1868           cth(ind1)=0.5*(1.-1.*erf(xth1))
     1869           cenv(ind1)=0.5*(1.-1.*erf(xenv1))
     1870           ctot(ind1)=frac_th(ind1)*cth(ind1)+(1.-1.*frac_th(ind1))*cenv(ind1)
     1871           ctotth(ind1)=frac_th(ind1)*cth(ind1)
     1872       
     1873
     1874!volume cloud fraction and condensed water
     1875
     1876            !environnement
     1877
     1878            IntJ=0.5*senv*(1-erf(xenv2))+(sigma1s/sqrt2pi)*exp_xenv2
     1879            IntJ_CF=0.5*(1.-1.*erf(xenv2))
     1880
     1881            IF (deltasenv .LT. 1.e-10) THEN
     1882              qcenv(ind1)=IntJ
     1883              cenv_vol(ind1)=IntJ_CF
     1884            ELSE
     1885              IntI1=(((senv+deltasenv)**2+(sigma1s)**2)/(8*deltasenv))*(erf(xenv2)-erf(xenv1))
     1886              IntI2=(sigma1s**2/(4*deltasenv*sqrtpi))*(xenv1*exp_xenv1-xenv2*exp_xenv2)
     1887              IntI3=((sqrt2*sigma1s*(senv+deltasenv))/(4*sqrtpi*deltasenv))*(exp_xenv1-exp_xenv2)
     1888              IntI1_CF=((senv+deltasenv)*(erf(xenv2)-erf(xenv1)))/(4*deltasenv)
     1889              IntI3_CF=(sqrt2*sigma1s*(exp_xenv1-exp_xenv2))/(4*sqrtpi*deltasenv)
     1890              qcenv(ind1)=IntJ+IntI1+IntI2+IntI3
     1891              cenv_vol(ind1)=IntJ_CF+IntI1_CF+IntI3_CF
     1892            ENDIF
     1893             
     1894
     1895
     1896            !thermals
     1897
     1898            IntJ=0.5*sth*(1-erf(xth2))+(sigma2s/sqrt2pi)*exp_xth2
     1899            IntJ_CF=0.5*(1.-1.*erf(xth2))
     1900     
     1901            IF (deltasth .LT. 1.e-10) THEN
     1902              qcth(ind1)=IntJ
     1903              cth_vol(ind1)=IntJ_CF
     1904            ELSE
     1905              IntI1=(((sth+deltasth)**2+(sigma2s)**2)/(8*deltasth))*(erf(xth2)-erf(xth1))
     1906              IntI2=(sigma2s**2/(4*deltasth*sqrtpi))*(xth1*exp_xth1-xth2*exp_xth2)
     1907              IntI3=((sqrt2*sigma2s*(sth+deltasth))/(4*sqrtpi*deltasth))*(exp_xth1-exp_xth2)
     1908              IntI1_CF=((sth+deltasth)*(erf(xth2)-erf(xth1)))/(4*deltasth)
     1909              IntI3_CF=(sqrt2*sigma2s*(exp_xth1-exp_xth2))/(4*sqrtpi*deltasth)
     1910              qcth(ind1)=IntJ+IntI1+IntI2+IntI3
     1911              cth_vol(ind1)=IntJ_CF+IntI1_CF+IntI3_CF
     1912            ENDIF
     1913
     1914            ! total
     1915
     1916            qctot(ind1)=frac_th(ind1)*qcth(ind1)+(1.-1.*frac_th(ind1))*qcenv(ind1)
     1917            ctot_vol(ind1)=frac_th(ind1)*cth_vol(ind1)+(1.-1.*frac_th(ind1))*cenv_vol(ind1)
     1918
     1919            IF (cenv(ind1).LT.min_neb_th.and.cth(ind1).LT.min_neb_th) THEN
     1920                ctot(ind1)=0.
     1921                ctot_vol(ind1)=0.
     1922                qcloud(ind1)=qsenv(ind1)
     1923                qincloud(ind1)=0.
     1924            ELSE             
     1925                qincloud(ind1)=qctot(ind1)/ctot(ind1)
     1926                !to prevent situations with cloud condensed water greater than available total water
     1927                qincloud(ind1)=min(qincloud(ind1),qt(ind1)/ctot(ind1))
     1928                ! we assume that water vapor in cloud is qsenv
     1929                qcloud(ind1)=qincloud(ind1)+qsenv(ind1)
     1930            ENDIF
     1931
     1932
     1933
     1934           ! Outputs used to check the PDFs
     1935           cloudth_senv(ind1) = senv
     1936           cloudth_sth(ind1) = sth
     1937           cloudth_sigmaenv(ind1) = sigma1s
     1938           cloudth_sigmath(ind1) = sigma2s
     1939
     1940      ENDIF       ! selection of grid points concerned by thermals
     1941
     1942
     1943    ENDDO       !loop on klon
     1944
     1945
     1946RETURN
     1947
     1948
     1949END SUBROUTINE condensation_cloudth
     1950
     1951
     1952!*****************************************************************************************
     1953!*****************************************************************************************
     1954! pre-cmip7 routines are below and are becoming obsolete
     1955!*****************************************************************************************
     1956!*****************************************************************************************
     1957
     1958
     1959       SUBROUTINE cloudth(ngrid,klev,ind2,  &
     1960     &           ztv,po,zqta,fraca, &
     1961     &           qcloud,ctot,zpspsk,paprs,pplay,ztla,zthl, &
     1962     &           ratqs,zqs,t, &
     1963     &           cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv)
     1964
     1965
     1966      use lmdz_lscp_ini, only: iflag_cloudth_vert,iflag_ratqs
     1967
     1968      USE yomcst_mod_h
     1969      USE yoethf_mod_h
     1970IMPLICIT NONE
     1971
     1972
     1973!===========================================================================
     1974! Auteur : Arnaud Octavio Jam (LMD/CNRS)
     1975! Date : 25 Mai 2010
     1976! Objet : calcule les valeurs de qc et rneb dans les thermiques
     1977!===========================================================================
     1978
     1979      INCLUDE "FCTTRE.h"
     1980
     1981      INTEGER itap,ind1,ind2
     1982      INTEGER ngrid,klev,klon,l,ig
     1983      real, dimension(ngrid,klev), intent(out) :: cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv
     1984     
     1985      REAL ztv(ngrid,klev)
     1986      REAL po(ngrid)
     1987      REAL zqenv(ngrid)   
     1988      REAL zqta(ngrid,klev)
     1989         
     1990      REAL fraca(ngrid,klev+1)
     1991      REAL zpspsk(ngrid,klev)
     1992      REAL paprs(ngrid,klev+1)
     1993      REAL pplay(ngrid,klev)
     1994      REAL ztla(ngrid,klev)
     1995      REAL zthl(ngrid,klev)
     1996
     1997      REAL zqsatth(ngrid,klev)
     1998      REAL zqsatenv(ngrid,klev)
     1999     
     2000     
     2001      REAL sigma1(ngrid,klev)
     2002      REAL sigma2(ngrid,klev)
     2003      REAL qlth(ngrid,klev)
     2004      REAL qlenv(ngrid,klev)
     2005      REAL qltot(ngrid,klev)
     2006      REAL cth(ngrid,klev) 
     2007      REAL cenv(ngrid,klev)   
     2008      REAL ctot(ngrid,klev)
     2009      REAL rneb(ngrid,klev)
     2010      REAL t(ngrid,klev)
     2011      REAL qsatmmussig1,qsatmmussig2,sqrt2pi,pi
     2012      REAL rdd,cppd,Lv
     2013      REAL alth,alenv,ath,aenv
     2014      REAL sth,senv,sigma1s,sigma2s,xth,xenv
     2015      REAL Tbef,zdelta,qsatbef,zcor
     2016      REAL qlbef 
     2017      REAL ratqs(ngrid,klev) ! determine la largeur de distribution de vapeur
     2018     
     2019      REAL zpdf_sig(ngrid),zpdf_k(ngrid),zpdf_delta(ngrid)
     2020      REAL zpdf_a(ngrid),zpdf_b(ngrid),zpdf_e1(ngrid),zpdf_e2(ngrid)
     2021      REAL zqs(ngrid), qcloud(ngrid)
     2022
     2023
     2024
     2025
     2026!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     2027! Gestion de deux versions de cloudth
     2028!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     2029
     2030      IF (iflag_cloudth_vert.GE.1) THEN
     2031      CALL cloudth_vert(ngrid,klev,ind2,  &
     2032     &           ztv,po,zqta,fraca, &
     2033     &           qcloud,ctot,zpspsk,paprs,pplay,ztla,zthl, &
     2034     &           ratqs,zqs,t)
     2035      RETURN
     2036      ENDIF
     2037!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     2038
     2039
     2040!-------------------------------------------------------------------------------
     2041! Initialisation des variables r?elles
     2042!-------------------------------------------------------------------------------
     2043      sigma1(:,ind2)=0.
     2044      sigma2(:,ind2)=0.
     2045      qlth(:,ind2)=0.
     2046      qlenv(:,ind2)=0. 
     2047      qltot(:,ind2)=0.
     2048      rneb(:,ind2)=0.
     2049      qcloud(:)=0.
     2050      cth(:,ind2)=0.
     2051      cenv(:,ind2)=0.
     2052      ctot(:,ind2)=0.
     2053      qsatmmussig1=0.
     2054      qsatmmussig2=0.
     2055      rdd=287.04
     2056      cppd=1005.7
     2057      pi=3.14159
     2058      Lv=2.5e6
     2059      sqrt2pi=sqrt(2.*pi)
     2060
     2061
     2062
     2063!-------------------------------------------------------------------------------
     2064! Calcul de la fraction du thermique et des ?cart-types des distributions
     2065!-------------------------------------------------------------------------------                 
     2066      do ind1=1,ngrid
     2067
     2068      if ((ztv(ind1,1).gt.ztv(ind1,2)).and.(fraca(ind1,ind2).gt.1.e-10)) then
     2069
     2070      zqenv(ind1)=(po(ind1)-fraca(ind1,ind2)*zqta(ind1,ind2))/(1.-fraca(ind1,ind2))
     2071
     2072
     2073!      zqenv(ind1)=po(ind1)
     2074      Tbef=zthl(ind1,ind2)*zpspsk(ind1,ind2)
     2075      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
     2076      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
     2077      qsatbef=MIN(0.5,qsatbef)
     2078      zcor=1./(1.-retv*qsatbef)
     2079      qsatbef=qsatbef*zcor
     2080      zqsatenv(ind1,ind2)=qsatbef
     2081
     2082
     2083
     2084
     2085      alenv=(0.622*Lv*zqsatenv(ind1,ind2))/(rdd*zthl(ind1,ind2)**2) 
     2086      aenv=1./(1.+(alenv*Lv/cppd))
     2087      senv=aenv*(po(ind1)-zqsatenv(ind1,ind2))
     2088
     2089
     2090
     2091
     2092      Tbef=ztla(ind1,ind2)*zpspsk(ind1,ind2)
     2093      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
     2094      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
     2095      qsatbef=MIN(0.5,qsatbef)
     2096      zcor=1./(1.-retv*qsatbef)
     2097      qsatbef=qsatbef*zcor
     2098      zqsatth(ind1,ind2)=qsatbef
     2099           
     2100      alth=(0.622*Lv*zqsatth(ind1,ind2))/(rdd*ztla(ind1,ind2)**2)   
     2101      ath=1./(1.+(alth*Lv/cppd))
     2102      sth=ath*(zqta(ind1,ind2)-zqsatth(ind1,ind2))
     2103     
     2104     
     2105
     2106!------------------------------------------------------------------------------
     2107! Calcul des ?cart-types pour s
     2108!------------------------------------------------------------------------------
     2109
     2110!      sigma1s=(1.1**0.5)*(fraca(ind1,ind2)**0.6)/(1-fraca(ind1,ind2))*((sth-senv)**2)**0.5+ratqs(ind1,ind2)*po(ind1)
     2111!      sigma2s=0.11*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.02)**0.4+0.002*zqta(ind1,ind2)
     2112!       if (paprs(ind1,ind2).gt.90000) then
     2113!       ratqs(ind1,ind2)=0.002
     2114!       else
     2115!       ratqs(ind1,ind2)=0.002+0.0*(90000-paprs(ind1,ind2))/20000
     2116!       endif
     2117       sigma1s=(1.1**0.5)*(fraca(ind1,ind2)**0.6)/(1-fraca(ind1,ind2))*((sth-senv)**2)**0.5+0.002*po(ind1)
     2118       sigma2s=0.11*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.01)**0.4+0.002*zqta(ind1,ind2)
     2119!       sigma1s=ratqs(ind1,ind2)*po(ind1)
     2120!      sigma2s=0.11*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.02)**0.4+0.00003 
     2121 
     2122!------------------------------------------------------------------------------
     2123! Calcul de l'eau condens?e et de la couverture nuageuse
     2124!------------------------------------------------------------------------------
     2125      sqrt2pi=sqrt(2.*pi)
     2126      xth=sth/(sqrt(2.)*sigma2s)
     2127      xenv=senv/(sqrt(2.)*sigma1s)
     2128      cth(ind1,ind2)=0.5*(1.+1.*erf(xth))
     2129      cenv(ind1,ind2)=0.5*(1.+1.*erf(xenv))
     2130      ctot(ind1,ind2)=fraca(ind1,ind2)*cth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv(ind1,ind2)   
     2131
     2132      qlth(ind1,ind2)=sigma2s*((exp(-1.*xth**2)/sqrt2pi)+xth*sqrt(2.)*cth(ind1,ind2))
     2133      qlenv(ind1,ind2)=sigma1s*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt(2.)*cenv(ind1,ind2))   
     2134      qltot(ind1,ind2)=fraca(ind1,ind2)*qlth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)
     2135
     2136!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     2137      if (ctot(ind1,ind2).lt.1.e-10) then
     2138      ctot(ind1,ind2)=0.
     2139      qcloud(ind1)=zqsatenv(ind1,ind2)
     2140
     2141      else   
     2142               
     2143      ctot(ind1,ind2)=ctot(ind1,ind2)
     2144      qcloud(ind1)=qltot(ind1,ind2)/ctot(ind1,ind2)+zqs(ind1)
     2145
     2146      endif                           
     2147     
     2148         
     2149
     2150
     2151      else  ! gaussienne environnement seule
     2152     
     2153      zqenv(ind1)=po(ind1)
     2154      Tbef=t(ind1,ind2)
     2155      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
     2156      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
     2157      qsatbef=MIN(0.5,qsatbef)
     2158      zcor=1./(1.-retv*qsatbef)
     2159      qsatbef=qsatbef*zcor
     2160      zqsatenv(ind1,ind2)=qsatbef
     2161     
     2162
     2163!      qlbef=Max(po(ind1)-zqsatenv(ind1,ind2),0.)
     2164      zthl(ind1,ind2)=t(ind1,ind2)*(101325/paprs(ind1,ind2))**(rdd/cppd)
     2165      alenv=(0.622*Lv*zqsatenv(ind1,ind2))/(rdd*zthl(ind1,ind2)**2) 
     2166      aenv=1./(1.+(alenv*Lv/cppd))
     2167      senv=aenv*(po(ind1)-zqsatenv(ind1,ind2))
     2168     
     2169
     2170      sigma1s=ratqs(ind1,ind2)*zqenv(ind1)
     2171
     2172      sqrt2pi=sqrt(2.*pi)
     2173      xenv=senv/(sqrt(2.)*sigma1s)
     2174      ctot(ind1,ind2)=0.5*(1.+1.*erf(xenv))
     2175      qltot(ind1,ind2)=sigma1s*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt(2.)*cenv(ind1,ind2))
     2176     
     2177      if (ctot(ind1,ind2).lt.1.e-3) then
     2178      ctot(ind1,ind2)=0.
     2179      qcloud(ind1)=zqsatenv(ind1,ind2)
     2180
     2181      else   
     2182               
     2183      ctot(ind1,ind2)=ctot(ind1,ind2)
     2184      qcloud(ind1)=qltot(ind1,ind2)/ctot(ind1,ind2)+zqsatenv(ind1,ind2)
     2185
     2186      endif   
     2187 
     2188 
     2189 
     2190 
     2191 
     2192 
     2193      endif   
     2194      enddo
     2195     
     2196      return
     2197!     end
     2198END SUBROUTINE cloudth
     2199
     2200
     2201
     2202!===========================================================================
     2203     SUBROUTINE cloudth_vert(ngrid,klev,ind2,  &
     2204     &           ztv,po,zqta,fraca, &
     2205     &           qcloud,ctot,zpspsk,paprs,pplay,ztla,zthl, &
     2206     &           ratqs,zqs,t)
     2207
     2208!===========================================================================
     2209! Auteur : Arnaud Octavio Jam (LMD/CNRS)
     2210! Date : 25 Mai 2010
     2211! Objet : calcule les valeurs de qc et rneb dans les thermiques
     2212!===========================================================================
     2213
     2214
     2215USE yoethf_mod_h
     2216            use lmdz_lscp_ini, only: iflag_cloudth_vert, vert_alpha
     2217
     2218      USE yomcst_mod_h
     2219IMPLICIT NONE
     2220
     2221
     2222      INCLUDE "FCTTRE.h"
     2223     
     2224      INTEGER itap,ind1,ind2
     2225      INTEGER ngrid,klev,klon,l,ig
     2226     
     2227      REAL ztv(ngrid,klev)
     2228      REAL po(ngrid)
     2229      REAL zqenv(ngrid)   
     2230      REAL zqta(ngrid,klev)
     2231         
     2232      REAL fraca(ngrid,klev+1)
     2233      REAL zpspsk(ngrid,klev)
     2234      REAL paprs(ngrid,klev+1)
     2235      REAL pplay(ngrid,klev)
     2236      REAL ztla(ngrid,klev)
     2237      REAL zthl(ngrid,klev)
     2238
     2239      REAL zqsatth(ngrid,klev)
     2240      REAL zqsatenv(ngrid,klev)
     2241     
     2242     
     2243      REAL sigma1(ngrid,klev)                                                         
     2244      REAL sigma2(ngrid,klev)
     2245      REAL qlth(ngrid,klev)
     2246      REAL qlenv(ngrid,klev)
     2247      REAL qltot(ngrid,klev)
     2248      REAL cth(ngrid,klev) 
     2249      REAL cenv(ngrid,klev)   
     2250      REAL ctot(ngrid,klev)
     2251      REAL rneb(ngrid,klev)
     2252      REAL t(ngrid,klev)                                                                 
     2253      REAL qsatmmussig1,qsatmmussig2,sqrt2pi,pi
     2254      REAL rdd,cppd,Lv,sqrt2,sqrtpi
     2255      REAL alth,alenv,ath,aenv
     2256      REAL sth,senv,sigma1s,sigma2s,xth,xenv
     2257      REAL xth1,xth2,xenv1,xenv2,deltasth, deltasenv
     2258      REAL IntJ,IntI1,IntI2,IntI3,coeffqlenv,coeffqlth
     2259      REAL Tbef,zdelta,qsatbef,zcor
     2260      REAL qlbef 
     2261      REAL ratqs(ngrid,klev) ! determine la largeur de distribution de vapeur
     2262      ! Change the width of the PDF used for vertical subgrid scale heterogeneity
     2263      ! (J Jouhaud, JL Dufresne, JB Madeleine)
     2264     
     2265      REAL zpdf_sig(ngrid),zpdf_k(ngrid),zpdf_delta(ngrid)
     2266      REAL zpdf_a(ngrid),zpdf_b(ngrid),zpdf_e1(ngrid),zpdf_e2(ngrid)
     2267      REAL zqs(ngrid), qcloud(ngrid)
     2268
     2269!------------------------------------------------------------------------------
     2270! Initialisation des variables r?elles
     2271!------------------------------------------------------------------------------
     2272      sigma1(:,ind2)=0.
     2273      sigma2(:,ind2)=0.
     2274      qlth(:,ind2)=0.
     2275      qlenv(:,ind2)=0. 
     2276      qltot(:,ind2)=0.
     2277      rneb(:,ind2)=0.
     2278      qcloud(:)=0.
     2279      cth(:,ind2)=0.
     2280      cenv(:,ind2)=0.
     2281      ctot(:,ind2)=0.
     2282      qsatmmussig1=0.
     2283      qsatmmussig2=0.
     2284      rdd=287.04
     2285      cppd=1005.7
     2286      pi=3.14159
     2287      Lv=2.5e6
     2288      sqrt2pi=sqrt(2.*pi)
     2289      sqrt2=sqrt(2.)
     2290      sqrtpi=sqrt(pi)
     2291
     2292!-------------------------------------------------------------------------------
     2293! Calcul de la fraction du thermique et des ?cart-types des distributions
     2294!-------------------------------------------------------------------------------                 
     2295      do ind1=1,ngrid
     2296
     2297      if ((ztv(ind1,1).gt.ztv(ind1,2)).and.(fraca(ind1,ind2).gt.1.e-10)) then
     2298
     2299      zqenv(ind1)=(po(ind1)-fraca(ind1,ind2)*zqta(ind1,ind2))/(1.-fraca(ind1,ind2))
     2300
     2301
     2302!      zqenv(ind1)=po(ind1)
     2303      Tbef=zthl(ind1,ind2)*zpspsk(ind1,ind2)
     2304      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
     2305      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
     2306      qsatbef=MIN(0.5,qsatbef)
     2307      zcor=1./(1.-retv*qsatbef)
     2308      qsatbef=qsatbef*zcor
     2309      zqsatenv(ind1,ind2)=qsatbef
     2310
     2311
     2312
     2313
     2314      alenv=(0.622*Lv*zqsatenv(ind1,ind2))/(rdd*zthl(ind1,ind2)**2) 
     2315      aenv=1./(1.+(alenv*Lv/cppd))
     2316      senv=aenv*(po(ind1)-zqsatenv(ind1,ind2))
     2317
     2318
     2319
     2320
     2321      Tbef=ztla(ind1,ind2)*zpspsk(ind1,ind2)
     2322      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
     2323      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
     2324      qsatbef=MIN(0.5,qsatbef)
     2325      zcor=1./(1.-retv*qsatbef)
     2326      qsatbef=qsatbef*zcor
     2327      zqsatth(ind1,ind2)=qsatbef
     2328           
     2329      alth=(0.622*Lv*zqsatth(ind1,ind2))/(rdd*ztla(ind1,ind2)**2)   
     2330      ath=1./(1.+(alth*Lv/cppd))
     2331      sth=ath*(zqta(ind1,ind2)-zqsatth(ind1,ind2))
     2332     
     2333     
     2334
     2335!------------------------------------------------------------------------------
     2336! Calcul des ?cart-types pour s
     2337!------------------------------------------------------------------------------
     2338
     2339      sigma1s=(0.92**0.5)*(fraca(ind1,ind2)**0.5)/(1-fraca(ind1,ind2))*((sth-senv)**2)**0.5+ratqs(ind1,ind2)*po(ind1)
     2340      sigma2s=0.09*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.02)**0.5+0.002*zqta(ind1,ind2)
     2341!       if (paprs(ind1,ind2).gt.90000) then
     2342!       ratqs(ind1,ind2)=0.002
     2343!       else
     2344!       ratqs(ind1,ind2)=0.002+0.0*(90000-paprs(ind1,ind2))/20000
     2345!       endif
     2346!       sigma1s=(1.1**0.5)*(fraca(ind1,ind2)**0.6)/(1-fraca(ind1,ind2))*((sth-senv)**2)**0.5+0.002*po(ind1)
     2347!       sigma2s=0.11*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.01)**0.4+0.002*zqta(ind1,ind2)
     2348!       sigma1s=ratqs(ind1,ind2)*po(ind1)
     2349!      sigma2s=0.11*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.02)**0.4+0.00003 
     2350 
     2351!------------------------------------------------------------------------------
     2352! Calcul de l'eau condens?e et de la couverture nuageuse
     2353!------------------------------------------------------------------------------
     2354      sqrt2pi=sqrt(2.*pi)
     2355      xth=sth/(sqrt(2.)*sigma2s)
     2356      xenv=senv/(sqrt(2.)*sigma1s)
     2357      cth(ind1,ind2)=0.5*(1.+1.*erf(xth))
     2358      cenv(ind1,ind2)=0.5*(1.+1.*erf(xenv))
     2359      ctot(ind1,ind2)=fraca(ind1,ind2)*cth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv(ind1,ind2)   
     2360
     2361      qlth(ind1,ind2)=sigma2s*((exp(-1.*xth**2)/sqrt2pi)+xth*sqrt(2.)*cth(ind1,ind2))
     2362      qlenv(ind1,ind2)=sigma1s*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt(2.)*cenv(ind1,ind2))   
     2363      qltot(ind1,ind2)=fraca(ind1,ind2)*qlth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)
     2364     
     2365       IF (iflag_cloudth_vert == 1) THEN
     2366!-------------------------------------------------------------------------------
     2367!  Version 2: Modification selon J.-Louis. On condense ?? partir de qsat-ratqs
     2368!-------------------------------------------------------------------------------
     2369!      deltasenv=aenv*ratqs(ind1,ind2)*po(ind1)
     2370!      deltasth=ath*ratqs(ind1,ind2)*zqta(ind1,ind2)
     2371      deltasenv=aenv*ratqs(ind1,ind2)*zqsatenv(ind1,ind2)
     2372      deltasth=ath*ratqs(ind1,ind2)*zqsatth(ind1,ind2)
     2373!      deltasenv=aenv*0.01*po(ind1)
     2374!     deltasth=ath*0.01*zqta(ind1,ind2)   
     2375      xenv1=(senv-deltasenv)/(sqrt(2.)*sigma1s)
     2376      xenv2=(senv+deltasenv)/(sqrt(2.)*sigma1s)
     2377      xth1=(sth-deltasth)/(sqrt(2.)*sigma2s)
     2378      xth2=(sth+deltasth)/(sqrt(2.)*sigma2s)
     2379      coeffqlenv=(sigma1s)**2/(2*sqrtpi*deltasenv)
     2380      coeffqlth=(sigma2s)**2/(2*sqrtpi*deltasth)
     2381     
     2382      cth(ind1,ind2)=0.5*(1.+1.*erf(xth2))
     2383      cenv(ind1,ind2)=0.5*(1.+1.*erf(xenv2))
     2384      ctot(ind1,ind2)=fraca(ind1,ind2)*cth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv(ind1,ind2)   
     2385
     2386      IntJ=sigma1s*(exp(-1.*xenv1**2)/sqrt2pi)+0.5*senv*(1+erf(xenv1))
     2387      IntI1=coeffqlenv*0.5*(0.5*sqrtpi*(erf(xenv2)-erf(xenv1))+xenv1*exp(-1.*xenv1**2)-xenv2*exp(-1.*xenv2**2))
     2388      IntI2=coeffqlenv*xenv2*(exp(-1.*xenv2**2)-exp(-1.*xenv1**2))
     2389      IntI3=coeffqlenv*0.5*sqrtpi*xenv2**2*(erf(xenv2)-erf(xenv1))
     2390
     2391      qlenv(ind1,ind2)=IntJ+IntI1+IntI2+IntI3
     2392!      qlenv(ind1,ind2)=IntJ
     2393!      print*, qlenv(ind1,ind2),'VERIF EAU'
     2394
     2395
     2396      IntJ=sigma2s*(exp(-1.*xth1**2)/sqrt2pi)+0.5*sth*(1+erf(xth1))
     2397!      IntI1=coeffqlth*((0.5*xth1-xth2)*exp(-1.*xth1**2)+0.5*xth2*exp(-1.*xth2**2))
     2398!      IntI2=coeffqlth*0.5*sqrtpi*(0.5+xth2**2)*(erf(xth2)-erf(xth1))
     2399      IntI1=coeffqlth*0.5*(0.5*sqrtpi*(erf(xth2)-erf(xth1))+xth1*exp(-1.*xth1**2)-xth2*exp(-1.*xth2**2))
     2400      IntI2=coeffqlth*xth2*(exp(-1.*xth2**2)-exp(-1.*xth1**2))
     2401      IntI3=coeffqlth*0.5*sqrtpi*xth2**2*(erf(xth2)-erf(xth1))
     2402      qlth(ind1,ind2)=IntJ+IntI1+IntI2+IntI3
     2403!      qlth(ind1,ind2)=IntJ
     2404!      print*, IntJ,IntI1,IntI2,IntI3,qlth(ind1,ind2),'VERIF EAU2'
     2405      qltot(ind1,ind2)=fraca(ind1,ind2)*qlth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)
     2406
     2407      ELSE IF (iflag_cloudth_vert == 2) THEN
     2408
     2409!-------------------------------------------------------------------------------
     2410!  Version 3: Modification Jean Jouhaud. On condense a partir de -delta s
     2411!-------------------------------------------------------------------------------
     2412!      deltasenv=aenv*ratqs(ind1,ind2)*po(ind1)
     2413!      deltasth=ath*ratqs(ind1,ind2)*zqta(ind1,ind2)
     2414!      deltasenv=aenv*ratqs(ind1,ind2)*zqsatenv(ind1,ind2)
     2415!      deltasth=ath*ratqs(ind1,ind2)*zqsatth(ind1,ind2)
     2416      deltasenv=aenv*vert_alpha*sigma1s
     2417      deltasth=ath*vert_alpha*sigma2s
     2418     
     2419      xenv1=-(senv+deltasenv)/(sqrt(2.)*sigma1s)
     2420      xenv2=-(senv-deltasenv)/(sqrt(2.)*sigma1s)
     2421      xth1=-(sth+deltasth)/(sqrt(2.)*sigma2s)
     2422      xth2=-(sth-deltasth)/(sqrt(2.)*sigma2s)
     2423!     coeffqlenv=(sigma1s)**2/(2*sqrtpi*deltasenv)
     2424!     coeffqlth=(sigma2s)**2/(2*sqrtpi*deltasth)
     2425     
     2426      cth(ind1,ind2)=0.5*(1.-1.*erf(xth1))
     2427      cenv(ind1,ind2)=0.5*(1.-1.*erf(xenv1))
     2428      ctot(ind1,ind2)=fraca(ind1,ind2)*cth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv(ind1,ind2)
     2429
     2430      IntJ=0.5*senv*(1-erf(xenv2))+(sigma1s/sqrt2pi)*exp(-1.*xenv2**2)
     2431      IntI1=(((senv+deltasenv)**2+(sigma1s)**2)/(8*deltasenv))*(erf(xenv2)-erf(xenv1))
     2432      IntI2=(sigma1s**2/(4*deltasenv*sqrtpi))*(xenv1*exp(-1.*xenv1**2)-xenv2*exp(-1.*xenv2**2))
     2433      IntI3=((sqrt2*sigma1s*(senv+deltasenv))/(4*sqrtpi*deltasenv))*(exp(-1.*xenv1**2)-exp(-1.*xenv2**2))
     2434
     2435!      IntI1=0.5*(0.5*sqrtpi*(erf(xenv2)-erf(xenv1))+xenv1*exp(-1.*xenv1**2)-xenv2*exp(-1.*xenv2**2))
     2436!      IntI2=xenv2*(exp(-1.*xenv2**2)-exp(-1.*xenv1**2))
     2437!      IntI3=0.5*sqrtpi*xenv2**2*(erf(xenv2)-erf(xenv1))
     2438
     2439      qlenv(ind1,ind2)=IntJ+IntI1+IntI2+IntI3
     2440!      qlenv(ind1,ind2)=IntJ
     2441!      print*, qlenv(ind1,ind2),'VERIF EAU'
     2442
     2443      IntJ=0.5*sth*(1-erf(xth2))+(sigma2s/sqrt2pi)*exp(-1.*xth2**2)
     2444      IntI1=(((sth+deltasth)**2+(sigma2s)**2)/(8*deltasth))*(erf(xth2)-erf(xth1))
     2445      IntI2=(sigma2s**2/(4*deltasth*sqrtpi))*(xth1*exp(-1.*xth1**2)-xth2*exp(-1.*xth2**2))
     2446      IntI3=((sqrt2*sigma2s*(sth+deltasth))/(4*sqrtpi*deltasth))*(exp(-1.*xth1**2)-exp(-1.*xth2**2))
     2447     
     2448      qlth(ind1,ind2)=IntJ+IntI1+IntI2+IntI3
     2449!      qlth(ind1,ind2)=IntJ
     2450!      print*, IntJ,IntI1,IntI2,IntI3,qlth(ind1,ind2),'VERIF EAU2'
     2451      qltot(ind1,ind2)=fraca(ind1,ind2)*qlth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)
     2452     
     2453
     2454
     2455
     2456      ENDIF ! of if (iflag_cloudth_vert==1 or 2)
     2457
     2458!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     2459
     2460      if (cenv(ind1,ind2).lt.1.e-10.or.cth(ind1,ind2).lt.1.e-10) then
     2461      ctot(ind1,ind2)=0.
     2462      qcloud(ind1)=zqsatenv(ind1,ind2)
     2463
     2464      else
     2465               
     2466      ctot(ind1,ind2)=ctot(ind1,ind2)
     2467      qcloud(ind1)=qltot(ind1,ind2)/ctot(ind1,ind2)+zqs(ind1)
     2468!      qcloud(ind1)=fraca(ind1,ind2)*qlth(ind1,ind2)/cth(ind1,ind2) &
     2469!    &             +(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)/cenv(ind1,ind2)+zqs(ind1)
     2470
     2471      endif 
     2472                       
     2473     
     2474         
     2475!     print*,sth,sigma2s,qlth(ind1,ind2),ctot(ind1,ind2),qltot(ind1,ind2),'verif'
     2476
     2477
     2478      else  ! gaussienne environnement seule
     2479     
     2480      zqenv(ind1)=po(ind1)
     2481      Tbef=t(ind1,ind2)
     2482      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
     2483      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
     2484      qsatbef=MIN(0.5,qsatbef)
     2485      zcor=1./(1.-retv*qsatbef)
     2486      qsatbef=qsatbef*zcor
     2487      zqsatenv(ind1,ind2)=qsatbef
     2488     
     2489
     2490!      qlbef=Max(po(ind1)-zqsatenv(ind1,ind2),0.)
     2491      zthl(ind1,ind2)=t(ind1,ind2)*(101325/paprs(ind1,ind2))**(rdd/cppd)
     2492      alenv=(0.622*Lv*zqsatenv(ind1,ind2))/(rdd*zthl(ind1,ind2)**2) 
     2493      aenv=1./(1.+(alenv*Lv/cppd))
     2494      senv=aenv*(po(ind1)-zqsatenv(ind1,ind2))
     2495     
     2496
     2497      sigma1s=ratqs(ind1,ind2)*zqenv(ind1)
     2498
     2499      sqrt2pi=sqrt(2.*pi)
     2500      xenv=senv/(sqrt(2.)*sigma1s)
     2501      ctot(ind1,ind2)=0.5*(1.+1.*erf(xenv))
     2502      qltot(ind1,ind2)=sigma1s*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt(2.)*cenv(ind1,ind2))
     2503     
     2504      if (ctot(ind1,ind2).lt.1.e-3) then
     2505      ctot(ind1,ind2)=0.
     2506      qcloud(ind1)=zqsatenv(ind1,ind2)
     2507
     2508      else   
     2509               
     2510      ctot(ind1,ind2)=ctot(ind1,ind2)
     2511      qcloud(ind1)=qltot(ind1,ind2)/ctot(ind1,ind2)+zqsatenv(ind1,ind2)
     2512
     2513      endif   
     2514 
     2515 
     2516 
     2517 
     2518 
     2519 
     2520      endif   
     2521      enddo
     2522     
     2523      return
     2524!     end
     2525END SUBROUTINE cloudth_vert
     2526
     2527
     2528
     2529
     2530       SUBROUTINE cloudth_v3(ngrid,klev,ind2,  &
     2531     &           ztv,po,zqta,fraca, &
     2532     &           qcloud,ctot,ctot_vol,zpspsk,paprs,pplay,ztla,zthl, &
     2533     &           ratqs,sigma_qtherm,zqs,t, &
     2534     &           cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv)
     2535
     2536      use lmdz_lscp_ini, only: iflag_cloudth_vert
     2537
     2538      USE yomcst_mod_h
     2539      USE yoethf_mod_h
     2540IMPLICIT NONE
     2541
     2542
     2543!===========================================================================
     2544! Author : Arnaud Octavio Jam (LMD/CNRS)
     2545! Date : 25 Mai 2010
     2546! Objet : calcule les valeurs de qc et rneb dans les thermiques
     2547!===========================================================================
     2548      INCLUDE "FCTTRE.h"
     2549
     2550      integer, intent(in) :: ind2
     2551      integer, intent(in) :: ngrid,klev
     2552     
     2553      real, dimension(ngrid,klev), intent(in) :: ztv
     2554      real, dimension(ngrid), intent(in) :: po
     2555      real, dimension(ngrid,klev), intent(in) :: zqta
     2556      real, dimension(ngrid,klev+1), intent(in) :: fraca
     2557      real, dimension(ngrid), intent(out) :: qcloud
     2558      real, dimension(ngrid,klev), intent(out) :: ctot
     2559      real, dimension(ngrid,klev), intent(out) :: ctot_vol
     2560      real, dimension(ngrid,klev), intent(in) :: zpspsk
     2561      real, dimension(ngrid,klev+1), intent(in) :: paprs
     2562      real, dimension(ngrid,klev), intent(in) :: pplay
     2563      real, dimension(ngrid,klev), intent(in) :: ztla
     2564      real, dimension(ngrid,klev), intent(inout) :: zthl
     2565      real, dimension(ngrid,klev), intent(in) :: ratqs,sigma_qtherm
     2566      real, dimension(ngrid), intent(in) :: zqs
     2567      real, dimension(ngrid,klev), intent(in) :: t
     2568      real, dimension(ngrid,klev), intent(out) :: cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv
     2569
     2570
     2571      REAL zqenv(ngrid)   
     2572      REAL zqsatth(ngrid,klev)
     2573      REAL zqsatenv(ngrid,klev)
     2574     
     2575      REAL sigma1(ngrid,klev)                                                         
     2576      REAL sigma2(ngrid,klev)
     2577      REAL qlth(ngrid,klev)
     2578      REAL qlenv(ngrid,klev)
     2579      REAL qltot(ngrid,klev)
     2580      REAL cth(ngrid,klev)
     2581      REAL cenv(ngrid,klev)   
     2582      REAL cth_vol(ngrid,klev)
     2583      REAL cenv_vol(ngrid,klev)
     2584      REAL rneb(ngrid,klev)     
     2585      REAL qsatmmussig1,qsatmmussig2,sqrt2pi,sqrt2,sqrtpi,pi
     2586      REAL rdd,cppd,Lv
     2587      REAL alth,alenv,ath,aenv
     2588      REAL sth,senv,sigma1s,sigma2s,xth,xenv, exp_xenv1, exp_xenv2,exp_xth1,exp_xth2
     2589      REAL inverse_rho,beta,a_Brooks,b_Brooks,A_Maj_Brooks,Dx_Brooks,f_Brooks
     2590      REAL Tbef,zdelta,qsatbef,zcor
     2591      REAL qlbef 
     2592      REAL zpdf_sig(ngrid),zpdf_k(ngrid),zpdf_delta(ngrid)
     2593      REAL zpdf_a(ngrid),zpdf_b(ngrid),zpdf_e1(ngrid),zpdf_e2(ngrid)
     2594
     2595
     2596      INTEGER :: ind1,l, ig
     2597
     2598      IF (iflag_cloudth_vert.GE.1) THEN
     2599      CALL cloudth_vert_v3(ngrid,klev,ind2,  &
     2600     &           ztv,po,zqta,fraca, &
     2601     &           qcloud,ctot,ctot_vol,zpspsk,paprs,pplay,ztla,zthl, &
     2602     &           ratqs,sigma_qtherm,zqs,t, &
     2603     &           cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv)
     2604      RETURN
     2605      ENDIF
     2606!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     2607
     2608
     2609!-------------------------------------------------------------------------------
     2610! Initialisation des variables r?elles
     2611!-------------------------------------------------------------------------------
     2612      sigma1(:,ind2)=0.
     2613      sigma2(:,ind2)=0.
     2614      qlth(:,ind2)=0.
     2615      qlenv(:,ind2)=0. 
     2616      qltot(:,ind2)=0.
     2617      rneb(:,ind2)=0.
     2618      qcloud(:)=0.
     2619      cth(:,ind2)=0.
     2620      cenv(:,ind2)=0.
     2621      ctot(:,ind2)=0.
     2622      cth_vol(:,ind2)=0.
     2623      cenv_vol(:,ind2)=0.
     2624      ctot_vol(:,ind2)=0.
     2625      qsatmmussig1=0.
     2626      qsatmmussig2=0.
     2627      rdd=287.04
     2628      cppd=1005.7
     2629      pi=3.14159
     2630      Lv=2.5e6
     2631      sqrt2pi=sqrt(2.*pi)
     2632      sqrt2=sqrt(2.)
     2633      sqrtpi=sqrt(pi)
     2634
     2635
     2636!-------------------------------------------------------------------------------
     2637! Cloud fraction in the thermals and standard deviation of the PDFs
     2638!-------------------------------------------------------------------------------                 
     2639      do ind1=1,ngrid
     2640
     2641      if ((ztv(ind1,1).gt.ztv(ind1,2)).and.(fraca(ind1,ind2).gt.1.e-10)) then
     2642
     2643      zqenv(ind1)=(po(ind1)-fraca(ind1,ind2)*zqta(ind1,ind2))/(1.-fraca(ind1,ind2))
     2644
     2645      Tbef=zthl(ind1,ind2)*zpspsk(ind1,ind2)
     2646      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
     2647      qsatbef= R2ES*FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
     2648      qsatbef=MIN(0.5,qsatbef)
     2649      zcor=1./(1.-retv*qsatbef)
     2650      qsatbef=qsatbef*zcor
     2651      zqsatenv(ind1,ind2)=qsatbef
     2652
     2653
     2654      alenv=(0.622*Lv*zqsatenv(ind1,ind2))/(rdd*zthl(ind1,ind2)**2)     !qsl, p84
     2655      aenv=1./(1.+(alenv*Lv/cppd))                                      !al, p84
     2656      senv=aenv*(po(ind1)-zqsatenv(ind1,ind2))                          !s, p84
     2657
     2658!po = qt de l'environnement ET des thermique
     2659!zqenv = qt environnement
     2660!zqsatenv = qsat environnement
     2661!zthl = Tl environnement
     2662
     2663
     2664      Tbef=ztla(ind1,ind2)*zpspsk(ind1,ind2)
     2665      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
     2666      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
     2667      qsatbef=MIN(0.5,qsatbef)
     2668      zcor=1./(1.-retv*qsatbef)
     2669      qsatbef=qsatbef*zcor
     2670      zqsatth(ind1,ind2)=qsatbef
     2671           
     2672      alth=(0.622*Lv*zqsatth(ind1,ind2))/(rdd*ztla(ind1,ind2)**2)       !qsl, p84
     2673      ath=1./(1.+(alth*Lv/cppd))                                        !al, p84
     2674      sth=ath*(zqta(ind1,ind2)-zqsatth(ind1,ind2))                      !s, p84
     2675     
     2676!zqta = qt thermals
     2677!zqsatth = qsat thermals
     2678!ztla = Tl thermals
     2679
     2680!------------------------------------------------------------------------------
     2681! s standard deviations
     2682!------------------------------------------------------------------------------
     2683
     2684!     tests
     2685!     sigma1s=(1.1**0.5)*(fraca(ind1,ind2)**0.6)/(1-fraca(ind1,ind2))*((sth-senv)**2)**0.5+0.002*po(ind1)
     2686!     sigma1s=(0.92*(fraca(ind1,ind2)**0.5)/(1-fraca(ind1,ind2))*(((sth-senv)**2)**0.5))+ratqs(ind1,ind2)*po(ind1)
     2687!     sigma2s=(0.09*(((sth-senv)**2)**0.5)/((fraca(ind1,ind2)+0.02)**0.5))+0.002*zqta(ind1,ind2)
     2688!     final option
     2689      sigma1s=(1.1**0.5)*(fraca(ind1,ind2)**0.6)/(1-fraca(ind1,ind2))*((sth-senv)**2)**0.5+ratqs(ind1,ind2)*po(ind1)
     2690      sigma2s=0.11*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.01)**0.4+0.002*zqta(ind1,ind2)
     2691 
     2692!------------------------------------------------------------------------------
     2693! Condensed water and cloud cover
     2694!------------------------------------------------------------------------------
     2695      xth=sth/(sqrt2*sigma2s)
     2696      xenv=senv/(sqrt2*sigma1s)
     2697      cth(ind1,ind2)=0.5*(1.+1.*erf(xth))       !4.18 p 111, l.7 p115 & 4.20 p 119 thesis Arnaud Jam
     2698      cenv(ind1,ind2)=0.5*(1.+1.*erf(xenv))     !4.18 p 111, l.7 p115 & 4.20 p 119 thesis Arnaud Jam
     2699      ctot(ind1,ind2)=fraca(ind1,ind2)*cth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv(ind1,ind2)
     2700      ctot_vol(ind1,ind2)=ctot(ind1,ind2)
     2701
     2702      qlth(ind1,ind2)=sigma2s*((exp(-1.*xth**2)/sqrt2pi)+xth*sqrt2*cth(ind1,ind2))
     2703      qlenv(ind1,ind2)=sigma1s*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt2*cenv(ind1,ind2))
     2704      qltot(ind1,ind2)=fraca(ind1,ind2)*qlth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)
     2705
     2706      if (ctot(ind1,ind2).lt.1.e-10) then
     2707      ctot(ind1,ind2)=0.
     2708      qcloud(ind1)=zqsatenv(ind1,ind2)
     2709      else
     2710      qcloud(ind1)=qltot(ind1,ind2)/ctot(ind1,ind2)+zqs(ind1)
     2711      endif
     2712
     2713      else  ! Environnement only, follow the if l.110
     2714     
     2715      zqenv(ind1)=po(ind1)
     2716      Tbef=t(ind1,ind2)
     2717      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
     2718      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
     2719      qsatbef=MIN(0.5,qsatbef)
     2720      zcor=1./(1.-retv*qsatbef)
     2721      qsatbef=qsatbef*zcor
     2722      zqsatenv(ind1,ind2)=qsatbef
     2723
     2724!     qlbef=Max(po(ind1)-zqsatenv(ind1,ind2),0.)
     2725      zthl(ind1,ind2)=t(ind1,ind2)*(101325/paprs(ind1,ind2))**(rdd/cppd)
     2726      alenv=(0.622*Lv*zqsatenv(ind1,ind2))/(rdd*zthl(ind1,ind2)**2) 
     2727      aenv=1./(1.+(alenv*Lv/cppd))
     2728      senv=aenv*(po(ind1)-zqsatenv(ind1,ind2))
     2729     
     2730      sigma1s=ratqs(ind1,ind2)*zqenv(ind1)
     2731
     2732      xenv=senv/(sqrt2*sigma1s)
     2733      ctot(ind1,ind2)=0.5*(1.+1.*erf(xenv))
     2734      ctot_vol(ind1,ind2)=ctot(ind1,ind2)
     2735      qltot(ind1,ind2)=sigma1s*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt2*cenv(ind1,ind2))
     2736
     2737      if (ctot(ind1,ind2).lt.1.e-3) then
     2738      ctot(ind1,ind2)=0.
     2739      qcloud(ind1)=zqsatenv(ind1,ind2)
     2740      else   
     2741      qcloud(ind1)=qltot(ind1,ind2)/ctot(ind1,ind2)+zqsatenv(ind1,ind2)
     2742      endif
     2743
     2744
     2745      endif       ! From the separation (thermal/envrionnement) et (environnement) only, l.110 et l.183
     2746      enddo       ! from the loop on ngrid l.108
     2747      return
     2748!     end
     2749END SUBROUTINE cloudth_v3
     2750
     2751
     2752
     2753!===========================================================================
     2754     SUBROUTINE cloudth_vert_v3(ngrid,klev,ind2,  &
     2755     &           ztv,po,zqta,fraca, &
     2756     &           qcloud,ctot,ctot_vol,zpspsk,paprs,pplay,ztla,zthl, &
     2757     &           ratqs,sigma_qtherm,zqs,t, &
     2758     &           cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv)
     2759
     2760!===========================================================================
     2761! Auteur : Arnaud Octavio Jam (LMD/CNRS)
     2762! Date : 25 Mai 2010
     2763! Objet : calcule les valeurs de qc et rneb dans les thermiques
     2764!===========================================================================
     2765
     2766      use yoethf_mod_h
     2767      use lmdz_lscp_ini, only : iflag_cloudth_vert,iflag_ratqs
     2768      use lmdz_lscp_ini, only : vert_alpha,vert_alpha_th, sigma1s_factor, sigma1s_power , sigma2s_factor , sigma2s_power , cloudth_ratqsmin , iflag_cloudth_vert_noratqs
     2769
     2770      USE yomcst_mod_h
     2771IMPLICIT NONE
     2772
     2773
     2774
     2775
     2776      INCLUDE "FCTTRE.h"
     2777     
     2778      INTEGER itap,ind1,ind2
     2779      INTEGER ngrid,klev,klon,l,ig
     2780      real, dimension(ngrid,klev), intent(out) :: cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv
     2781     
     2782      REAL ztv(ngrid,klev)
     2783      REAL po(ngrid)
     2784      REAL zqenv(ngrid)   
     2785      REAL zqta(ngrid,klev)
     2786         
     2787      REAL fraca(ngrid,klev+1)
     2788      REAL zpspsk(ngrid,klev)
     2789      REAL paprs(ngrid,klev+1)
     2790      REAL pplay(ngrid,klev)
     2791      REAL ztla(ngrid,klev)
     2792      REAL zthl(ngrid,klev)
     2793
     2794      REAL zqsatth(ngrid,klev)
     2795      REAL zqsatenv(ngrid,klev)
     2796     
     2797      REAL sigma1(ngrid,klev)                                                         
     2798      REAL sigma2(ngrid,klev)
     2799      REAL qlth(ngrid,klev)
     2800      REAL qlenv(ngrid,klev)
     2801      REAL qltot(ngrid,klev)
     2802      REAL cth(ngrid,klev)
     2803      REAL cenv(ngrid,klev)   
     2804      REAL ctot(ngrid,klev)
     2805      REAL cth_vol(ngrid,klev)
     2806      REAL cenv_vol(ngrid,klev)
     2807      REAL ctot_vol(ngrid,klev)
     2808      REAL rneb(ngrid,klev)
     2809      REAL t(ngrid,klev)                                                                 
     2810      REAL qsatmmussig1,qsatmmussig2,sqrtpi,sqrt2,sqrt2pi,pi
     2811      REAL rdd,cppd,Lv
     2812      REAL alth,alenv,ath,aenv
     2813      REAL sth,senv,sigma1s,sigma2s,sigma1s_fraca,sigma1s_ratqs
     2814      REAL inverse_rho,beta,a_Brooks,b_Brooks,A_Maj_Brooks,Dx_Brooks,f_Brooks
     2815      REAL xth,xenv,exp_xenv1,exp_xenv2,exp_xth1,exp_xth2
     2816      REAL xth1,xth2,xenv1,xenv2,deltasth, deltasenv
     2817      REAL IntJ,IntI1,IntI2,IntI3,IntJ_CF,IntI1_CF,IntI3_CF,coeffqlenv,coeffqlth
     2818      REAL Tbef,zdelta,qsatbef,zcor
     2819      REAL qlbef 
     2820      REAL ratqs(ngrid,klev),sigma_qtherm(ngrid,klev) ! determine la largeur de distribution de vapeur
     2821      ! Change the width of the PDF used for vertical subgrid scale heterogeneity
     2822      ! (J Jouhaud, JL Dufresne, JB Madeleine)
     2823
     2824      REAL zpdf_sig(ngrid),zpdf_k(ngrid),zpdf_delta(ngrid)
     2825      REAL zpdf_a(ngrid),zpdf_b(ngrid),zpdf_e1(ngrid),zpdf_e2(ngrid)
     2826      REAL zqs(ngrid), qcloud(ngrid)
     2827
     2828      REAL rhodz(ngrid,klev)
     2829      REAL zrho(ngrid,klev)
     2830      REAL dz(ngrid,klev)
     2831
     2832      DO ind1 = 1, ngrid
     2833        !Layer calculation
     2834        rhodz(ind1,ind2) = (paprs(ind1,ind2)-paprs(ind1,ind2+1))/rg !kg/m2
     2835        zrho(ind1,ind2) = pplay(ind1,ind2)/t(ind1,ind2)/rd !kg/m3
     2836        dz(ind1,ind2) = rhodz(ind1,ind2)/zrho(ind1,ind2) !m : epaisseur de la couche en metre
     2837      END DO
     2838
     2839!------------------------------------------------------------------------------
     2840! Initialize
     2841!------------------------------------------------------------------------------
     2842
     2843      sigma1(:,ind2)=0.
     2844      sigma2(:,ind2)=0.
     2845      qlth(:,ind2)=0.
     2846      qlenv(:,ind2)=0. 
     2847      qltot(:,ind2)=0.
     2848      rneb(:,ind2)=0.
     2849      qcloud(:)=0.
     2850      cth(:,ind2)=0.
     2851      cenv(:,ind2)=0.
     2852      ctot(:,ind2)=0.
     2853      cth_vol(:,ind2)=0.
     2854      cenv_vol(:,ind2)=0.
     2855      ctot_vol(:,ind2)=0.
     2856      qsatmmussig1=0.
     2857      qsatmmussig2=0.
     2858      rdd=287.04
     2859      cppd=1005.7
     2860      pi=3.14159
     2861      Lv=2.5e6
     2862      sqrt2pi=sqrt(2.*pi)
     2863      sqrt2=sqrt(2.)
     2864      sqrtpi=sqrt(pi)
     2865
     2866
     2867
     2868!-------------------------------------------------------------------------------
     2869! Calcul de la fraction du thermique et des ecart-types des distributions
     2870!-------------------------------------------------------------------------------                 
     2871      do ind1=1,ngrid
     2872
     2873      if ((ztv(ind1,1).gt.ztv(ind1,2)).and.(fraca(ind1,ind2).gt.1.e-10)) then !Thermal and environnement
     2874
     2875      zqenv(ind1)=(po(ind1)-fraca(ind1,ind2)*zqta(ind1,ind2))/(1.-fraca(ind1,ind2)) !qt = a*qtth + (1-a)*qtenv
     2876
     2877
     2878      Tbef=zthl(ind1,ind2)*zpspsk(ind1,ind2)
     2879      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
     2880      qsatbef= R2ES*FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
     2881      qsatbef=MIN(0.5,qsatbef)
     2882      zcor=1./(1.-retv*qsatbef)
     2883      qsatbef=qsatbef*zcor
     2884      zqsatenv(ind1,ind2)=qsatbef
     2885
     2886
     2887      alenv=(0.622*Lv*zqsatenv(ind1,ind2))/(rdd*zthl(ind1,ind2)**2)     !qsl, p84
     2888      aenv=1./(1.+(alenv*Lv/cppd))                                      !al, p84
     2889      senv=aenv*(po(ind1)-zqsatenv(ind1,ind2))                          !s, p84
     2890
     2891!zqenv = qt environnement
     2892!zqsatenv = qsat environnement
     2893!zthl = Tl environnement
     2894
     2895
     2896      Tbef=ztla(ind1,ind2)*zpspsk(ind1,ind2)
     2897      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
     2898      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
     2899      qsatbef=MIN(0.5,qsatbef)
     2900      zcor=1./(1.-retv*qsatbef)
     2901      qsatbef=qsatbef*zcor
     2902      zqsatth(ind1,ind2)=qsatbef
     2903           
     2904      alth=(0.622*Lv*zqsatth(ind1,ind2))/(rdd*ztla(ind1,ind2)**2)       !qsl, p84
     2905      ath=1./(1.+(alth*Lv/cppd))                                        !al, p84
     2906      sth=ath*(zqta(ind1,ind2)-zqsatth(ind1,ind2))                      !s, p84
     2907     
     2908     
     2909!zqta = qt thermals
     2910!zqsatth = qsat thermals
     2911!ztla = Tl thermals
     2912!------------------------------------------------------------------------------
     2913! s standard deviation
     2914!------------------------------------------------------------------------------
     2915
     2916      sigma1s_fraca = (sigma1s_factor**0.5)*(fraca(ind1,ind2)**sigma1s_power) / &
     2917     &                (1-fraca(ind1,ind2))*((sth-senv)**2)**0.5
     2918!     sigma1s_fraca = (1.1**0.5)*(fraca(ind1,ind2)**0.6)/(1-fraca(ind1,ind2))*((sth-senv)**2)**0.5
     2919      IF (cloudth_ratqsmin>0.) THEN
     2920         sigma1s_ratqs = cloudth_ratqsmin*po(ind1)
     2921      ELSE
     2922         sigma1s_ratqs = ratqs(ind1,ind2)*po(ind1)
     2923      ENDIF
     2924      sigma1s = sigma1s_fraca + sigma1s_ratqs
     2925      sigma2s=(sigma2s_factor*(((sth-senv)**2)**0.5)/((fraca(ind1,ind2)+0.02)**sigma2s_power))+0.002*zqta(ind1,ind2)
     2926      IF (iflag_ratqs.eq.10.or.iflag_ratqs.eq.11) then
     2927         sigma1s = ratqs(ind1,ind2)*po(ind1)*aenv
     2928         IF (iflag_ratqs.eq.10.and.sigma_qtherm(ind1,ind2).ne.0) then
     2929            sigma2s = sigma_qtherm(ind1,ind2)*ath
     2930         ENDIF
     2931      ENDIF
     2932     
     2933!      tests
     2934!      sigma1s=(0.92**0.5)*(fraca(ind1,ind2)**0.5)/(1-fraca(ind1,ind2))*((sth-senv)**2)**0.5+ratqs(ind1,ind2)*po(ind1)
     2935!      sigma1s=(0.92*(fraca(ind1,ind2)**0.5)/(1-fraca(ind1,ind2))*(((sth-senv)**2)**0.5))+0.002*zqenv(ind1)
     2936!      sigma2s=0.09*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.02)**0.5+0.002*zqta(ind1,ind2)
     2937!      sigma2s=(0.09*(((sth-senv)**2)**0.5)/((fraca(ind1,ind2)+0.02)**0.5))+ratqs(ind1,ind2)*zqta(ind1,ind2)
     2938!       if (paprs(ind1,ind2).gt.90000) then
     2939!       ratqs(ind1,ind2)=0.002
     2940!       else
     2941!       ratqs(ind1,ind2)=0.002+0.0*(90000-paprs(ind1,ind2))/20000
     2942!       endif
     2943!       sigma1s=(1.1**0.5)*(fraca(ind1,ind2)**0.6)/(1-fraca(ind1,ind2))*((sth-senv)**2)**0.5+0.002*po(ind1)
     2944!       sigma2s=0.11*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.01)**0.4+0.002*zqta(ind1,ind2)
     2945!       sigma1s=ratqs(ind1,ind2)*po(ind1)
     2946!      sigma2s=0.11*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.02)**0.4+0.00003 
     2947 
     2948       IF (iflag_cloudth_vert == 1) THEN
     2949!-------------------------------------------------------------------------------
     2950!  Version 2: Modification from Arnaud Jam according to JL Dufrense. Condensate from qsat-ratqs
     2951!-------------------------------------------------------------------------------
     2952
     2953      deltasenv=aenv*ratqs(ind1,ind2)*zqsatenv(ind1,ind2)
     2954      deltasth=ath*ratqs(ind1,ind2)*zqsatth(ind1,ind2)
     2955
     2956      xenv1=(senv-deltasenv)/(sqrt(2.)*sigma1s)
     2957      xenv2=(senv+deltasenv)/(sqrt(2.)*sigma1s)
     2958      xth1=(sth-deltasth)/(sqrt(2.)*sigma2s)
     2959      xth2=(sth+deltasth)/(sqrt(2.)*sigma2s)
     2960      coeffqlenv=(sigma1s)**2/(2*sqrtpi*deltasenv)
     2961      coeffqlth=(sigma2s)**2/(2*sqrtpi*deltasth)
     2962     
     2963      cth(ind1,ind2)=0.5*(1.+1.*erf(xth2))
     2964      cenv(ind1,ind2)=0.5*(1.+1.*erf(xenv2))
     2965      ctot(ind1,ind2)=fraca(ind1,ind2)*cth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv(ind1,ind2)   
     2966
     2967      ! Environment
     2968      IntJ=sigma1s*(exp(-1.*xenv1**2)/sqrt2pi)+0.5*senv*(1+erf(xenv1))
     2969      IntI1=coeffqlenv*0.5*(0.5*sqrtpi*(erf(xenv2)-erf(xenv1))+xenv1*exp(-1.*xenv1**2)-xenv2*exp(-1.*xenv2**2))
     2970      IntI2=coeffqlenv*xenv2*(exp(-1.*xenv2**2)-exp(-1.*xenv1**2))
     2971      IntI3=coeffqlenv*0.5*sqrtpi*xenv2**2*(erf(xenv2)-erf(xenv1))
     2972
     2973      qlenv(ind1,ind2)=IntJ+IntI1+IntI2+IntI3
     2974
     2975      ! Thermal
     2976      IntJ=sigma2s*(exp(-1.*xth1**2)/sqrt2pi)+0.5*sth*(1+erf(xth1))
     2977      IntI1=coeffqlth*0.5*(0.5*sqrtpi*(erf(xth2)-erf(xth1))+xth1*exp(-1.*xth1**2)-xth2*exp(-1.*xth2**2))
     2978      IntI2=coeffqlth*xth2*(exp(-1.*xth2**2)-exp(-1.*xth1**2))
     2979      IntI3=coeffqlth*0.5*sqrtpi*xth2**2*(erf(xth2)-erf(xth1))
     2980      qlth(ind1,ind2)=IntJ+IntI1+IntI2+IntI3
     2981      qltot(ind1,ind2)=fraca(ind1,ind2)*qlth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)
     2982
     2983      ELSE IF (iflag_cloudth_vert >= 3) THEN
     2984      IF (iflag_cloudth_vert < 5) THEN
     2985!-------------------------------------------------------------------------------
     2986!  Version 3: Changes by J. Jouhaud; condensation for q > -delta s
     2987!-------------------------------------------------------------------------------
     2988!      deltasenv=aenv*ratqs(ind1,ind2)*po(ind1)
     2989!      deltasth=ath*ratqs(ind1,ind2)*zqta(ind1,ind2)
     2990!      deltasenv=aenv*ratqs(ind1,ind2)*zqsatenv(ind1,ind2)
     2991!      deltasth=ath*ratqs(ind1,ind2)*zqsatth(ind1,ind2)
     2992      IF (iflag_cloudth_vert == 3) THEN
     2993        deltasenv=aenv*vert_alpha*sigma1s
     2994        deltasth=ath*vert_alpha_th*sigma2s
     2995      ELSE IF (iflag_cloudth_vert == 4) THEN
     2996        IF (iflag_cloudth_vert_noratqs == 1) THEN
     2997          deltasenv=vert_alpha*max(sigma1s_fraca,1e-10)
     2998          deltasth=vert_alpha_th*sigma2s
     2999        ELSE
     3000          deltasenv=vert_alpha*sigma1s
     3001          deltasth=vert_alpha_th*sigma2s
     3002        ENDIF
     3003      ENDIF
     3004     
     3005      xenv1=-(senv+deltasenv)/(sqrt(2.)*sigma1s)
     3006      xenv2=-(senv-deltasenv)/(sqrt(2.)*sigma1s)
     3007      exp_xenv1 = exp(-1.*xenv1**2)
     3008      exp_xenv2 = exp(-1.*xenv2**2)
     3009      xth1=-(sth+deltasth)/(sqrt(2.)*sigma2s)
     3010      xth2=-(sth-deltasth)/(sqrt(2.)*sigma2s)
     3011      exp_xth1 = exp(-1.*xth1**2)
     3012      exp_xth2 = exp(-1.*xth2**2)
     3013     
     3014      !CF_surfacique
     3015      cth(ind1,ind2)=0.5*(1.-1.*erf(xth1))
     3016      cenv(ind1,ind2)=0.5*(1.-1.*erf(xenv1))
     3017      ctot(ind1,ind2)=fraca(ind1,ind2)*cth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv(ind1,ind2)
     3018
     3019
     3020      !CF_volumique & eau condense
     3021      !environnement
     3022      IntJ=0.5*senv*(1-erf(xenv2))+(sigma1s/sqrt2pi)*exp_xenv2
     3023      IntJ_CF=0.5*(1.-1.*erf(xenv2))
     3024      if (deltasenv .lt. 1.e-10) then
     3025      qlenv(ind1,ind2)=IntJ
     3026      cenv_vol(ind1,ind2)=IntJ_CF
     3027      else
     3028      IntI1=(((senv+deltasenv)**2+(sigma1s)**2)/(8*deltasenv))*(erf(xenv2)-erf(xenv1))
     3029      IntI2=(sigma1s**2/(4*deltasenv*sqrtpi))*(xenv1*exp_xenv1-xenv2*exp_xenv2)
     3030      IntI3=((sqrt2*sigma1s*(senv+deltasenv))/(4*sqrtpi*deltasenv))*(exp_xenv1-exp_xenv2)
     3031      IntI1_CF=((senv+deltasenv)*(erf(xenv2)-erf(xenv1)))/(4*deltasenv)
     3032      IntI3_CF=(sqrt2*sigma1s*(exp_xenv1-exp_xenv2))/(4*sqrtpi*deltasenv)
     3033      qlenv(ind1,ind2)=IntJ+IntI1+IntI2+IntI3
     3034      cenv_vol(ind1,ind2)=IntJ_CF+IntI1_CF+IntI3_CF
     3035      endif
     3036
     3037      !thermique
     3038      IntJ=0.5*sth*(1-erf(xth2))+(sigma2s/sqrt2pi)*exp_xth2
     3039      IntJ_CF=0.5*(1.-1.*erf(xth2))
     3040      if (deltasth .lt. 1.e-10) then
     3041      qlth(ind1,ind2)=IntJ
     3042      cth_vol(ind1,ind2)=IntJ_CF
     3043      else
     3044      IntI1=(((sth+deltasth)**2+(sigma2s)**2)/(8*deltasth))*(erf(xth2)-erf(xth1))
     3045      IntI2=(sigma2s**2/(4*deltasth*sqrtpi))*(xth1*exp_xth1-xth2*exp_xth2)
     3046      IntI3=((sqrt2*sigma2s*(sth+deltasth))/(4*sqrtpi*deltasth))*(exp_xth1-exp_xth2)
     3047      IntI1_CF=((sth+deltasth)*(erf(xth2)-erf(xth1)))/(4*deltasth)
     3048      IntI3_CF=(sqrt2*sigma2s*(exp_xth1-exp_xth2))/(4*sqrtpi*deltasth)
     3049      qlth(ind1,ind2)=IntJ+IntI1+IntI2+IntI3
     3050      cth_vol(ind1,ind2)=IntJ_CF+IntI1_CF+IntI3_CF
     3051      endif
     3052
     3053      qltot(ind1,ind2)=fraca(ind1,ind2)*qlth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)
     3054      ctot_vol(ind1,ind2)=fraca(ind1,ind2)*cth_vol(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv_vol(ind1,ind2)
     3055
     3056      ELSE IF (iflag_cloudth_vert == 5) THEN
     3057         sigma1s=(0.71794+0.000498239*dz(ind1,ind2))*(fraca(ind1,ind2)**0.5) &
     3058              /(1-fraca(ind1,ind2))*(((sth-senv)**2)**0.5) &
     3059              +ratqs(ind1,ind2)*po(ind1) !Environment
     3060      sigma2s=(0.03218+0.000092655*dz(ind1,ind2))/((fraca(ind1,ind2)+0.02)**0.5)*(((sth-senv)**2)**0.5)+0.002*zqta(ind1,ind2)                   !Thermals
     3061      !sigma1s=(1.1**0.5)*(fraca(ind1,ind2)**0.6)/(1-fraca(ind1,ind2))*((sth-senv)**2)**0.5+0.002*po(ind1)
     3062      !sigma2s=0.11*((sth-senv)**2)**0.5/(fraca(ind1,ind2)+0.01)**0.4+0.002*zqta(ind1,ind2)
     3063      xth=sth/(sqrt(2.)*sigma2s)
     3064      xenv=senv/(sqrt(2.)*sigma1s)
     3065
     3066      !Volumique
     3067      cth_vol(ind1,ind2)=0.5*(1.+1.*erf(xth))
     3068      cenv_vol(ind1,ind2)=0.5*(1.+1.*erf(xenv))
     3069      ctot_vol(ind1,ind2)=fraca(ind1,ind2)*cth_vol(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv_vol(ind1,ind2)
     3070      !print *,'jeanjean_CV=',ctot_vol(ind1,ind2)
     3071
     3072      qlth(ind1,ind2)=sigma2s*((exp(-1.*xth**2)/sqrt2pi)+xth*sqrt(2.)*cth_vol(ind1,ind2))
     3073      qlenv(ind1,ind2)=sigma1s*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt(2.)*cenv_vol(ind1,ind2)) 
     3074      qltot(ind1,ind2)=fraca(ind1,ind2)*qlth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)
     3075
     3076      !Surfacique
     3077      !Neggers
     3078      !beta=0.0044
     3079      !inverse_rho=1.+beta*dz(ind1,ind2)
     3080      !print *,'jeanjean : beta=',beta
     3081      !cth(ind1,ind2)=cth_vol(ind1,ind2)*inverse_rho
     3082      !cenv(ind1,ind2)=cenv_vol(ind1,ind2)*inverse_rho
     3083      !ctot(ind1,ind2)=fraca(ind1,ind2)*cth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv(ind1,ind2)
     3084
     3085      !Brooks
     3086      a_Brooks=0.6694
     3087      b_Brooks=0.1882
     3088      A_Maj_Brooks=0.1635 !-- sans shear
     3089      !A_Maj_Brooks=0.17   !-- ARM LES
     3090      !A_Maj_Brooks=0.18   !-- RICO LES
     3091      !A_Maj_Brooks=0.19   !-- BOMEX LES
     3092      Dx_Brooks=200000.
     3093      f_Brooks=A_Maj_Brooks*(dz(ind1,ind2)**(a_Brooks))*(Dx_Brooks**(-b_Brooks))
     3094      !print *,'jeanjean_f=',f_Brooks
     3095
     3096      cth(ind1,ind2)=1./(1.+exp(-1.*f_Brooks)*((1./max(1.e-15,min(cth_vol(ind1,ind2),1.)))- 1.))
     3097      cenv(ind1,ind2)=1./(1.+exp(-1.*f_Brooks)*((1./max(1.e-15,min(cenv_vol(ind1,ind2),1.)))- 1.))
     3098      ctot(ind1,ind2)=1./(1.+exp(-1.*f_Brooks)*((1./max(1.e-15,min(ctot_vol(ind1,ind2),1.)))- 1.))
     3099      !print *,'JJ_ctot_1',ctot(ind1,ind2)
     3100
     3101
     3102
     3103
     3104
     3105      ENDIF ! of if (iflag_cloudth_vert<5)
     3106      ENDIF ! of if (iflag_cloudth_vert==1 or 3 or 4)
     3107
     3108!      if (ctot(ind1,ind2).lt.1.e-10) then
     3109      if (cenv(ind1,ind2).lt.1.e-10.or.cth(ind1,ind2).lt.1.e-10) then
     3110      ctot(ind1,ind2)=0.
     3111      ctot_vol(ind1,ind2)=0.
     3112      qcloud(ind1)=zqsatenv(ind1,ind2)
     3113
     3114      else
     3115               
     3116      qcloud(ind1)=qltot(ind1,ind2)/ctot(ind1,ind2)+zqs(ind1)
     3117!      qcloud(ind1)=fraca(ind1,ind2)*qlth(ind1,ind2)/cth(ind1,ind2) &
     3118!    &             +(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)/cenv(ind1,ind2)+zqs(ind1)
     3119
     3120      endif 
     3121
     3122      else  ! gaussienne environnement seule
     3123     
     3124
     3125      zqenv(ind1)=po(ind1)
     3126      Tbef=t(ind1,ind2)
     3127      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
     3128      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
     3129      qsatbef=MIN(0.5,qsatbef)
     3130      zcor=1./(1.-retv*qsatbef)
     3131      qsatbef=qsatbef*zcor
     3132      zqsatenv(ind1,ind2)=qsatbef
     3133     
     3134
     3135!      qlbef=Max(po(ind1)-zqsatenv(ind1,ind2),0.)
     3136      zthl(ind1,ind2)=t(ind1,ind2)*(101325/paprs(ind1,ind2))**(rdd/cppd)
     3137      alenv=(0.622*Lv*zqsatenv(ind1,ind2))/(rdd*zthl(ind1,ind2)**2)
     3138      aenv=1./(1.+(alenv*Lv/cppd))
     3139      senv=aenv*(po(ind1)-zqsatenv(ind1,ind2))
     3140      sth=0.
     3141     
     3142
     3143      sigma1s=ratqs(ind1,ind2)*zqenv(ind1)
     3144      sigma2s=0.
     3145
     3146      sqrt2pi=sqrt(2.*pi)
     3147      xenv=senv/(sqrt(2.)*sigma1s)
     3148      ctot(ind1,ind2)=0.5*(1.+1.*erf(xenv))
     3149      ctot_vol(ind1,ind2)=ctot(ind1,ind2)
     3150      qltot(ind1,ind2)=sigma1s*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt(2.)*cenv(ind1,ind2))
     3151     
     3152      if (ctot(ind1,ind2).lt.1.e-3) then
     3153      ctot(ind1,ind2)=0.
     3154      qcloud(ind1)=zqsatenv(ind1,ind2)
     3155
     3156      else   
     3157               
     3158!      ctot(ind1,ind2)=ctot(ind1,ind2)
     3159      qcloud(ind1)=qltot(ind1,ind2)/ctot(ind1,ind2)+zqsatenv(ind1,ind2)
     3160
     3161      endif 
     3162 
     3163
     3164
     3165
     3166      endif       ! From the separation (thermal/envrionnement) et (environnement) only, l.335 et l.492
     3167      ! Outputs used to check the PDFs
     3168      cloudth_senv(ind1,ind2) = senv
     3169      cloudth_sth(ind1,ind2) = sth
     3170      cloudth_sigmaenv(ind1,ind2) = sigma1s
     3171      cloudth_sigmath(ind1,ind2) = sigma2s
     3172
     3173      enddo       ! from the loop on ngrid l.333
     3174      return
     3175!     end
     3176END SUBROUTINE cloudth_vert_v3
     3177!
     3178
     3179
     3180
     3181
     3182
     3183
     3184
     3185
     3186
     3187
     3188
     3189       SUBROUTINE cloudth_v6(ngrid,klev,ind2,  &
     3190     &           ztv,po,zqta,fraca, &
     3191     &           qcloud,ctot_surf,ctot_vol,zpspsk,paprs,pplay,ztla,zthl, &
     3192     &           ratqs,zqs,T, &
     3193     &           cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv)
     3194
     3195      USE yoethf_mod_h
     3196      USE lmdz_lscp_ini, only: iflag_cloudth_vert
     3197
     3198      USE yomcst_mod_h
     3199IMPLICIT NONE
     3200
     3201
     3202
     3203      INCLUDE "FCTTRE.h"
     3204
     3205
     3206        !Domain variables
     3207      INTEGER ngrid !indice Max lat-lon
     3208      INTEGER klev  !indice Max alt
     3209      real, dimension(ngrid,klev), intent(out) :: cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv
     3210      INTEGER ind1  !indice in [1:ngrid]
     3211      INTEGER ind2  !indice in [1:klev]
     3212        !thermal plume fraction
     3213      REAL fraca(ngrid,klev+1)   !thermal plumes fraction in the gridbox
     3214        !temperatures
     3215      REAL T(ngrid,klev)       !temperature
     3216      REAL zpspsk(ngrid,klev)  !factor (p/p0)**kappa (used for potential variables)
     3217      REAL ztv(ngrid,klev)     !potential temperature (voir thermcell_env.F90)
     3218      REAL ztla(ngrid,klev)    !liquid temperature in the thermals (Tl_th)
     3219      REAL zthl(ngrid,klev)    !liquid temperature in the environment (Tl_env)
     3220        !pressure
     3221      REAL paprs(ngrid,klev+1)   !pressure at the interface of levels
     3222      REAL pplay(ngrid,klev)     !pressure at the middle of the level
     3223        !humidity
     3224      REAL ratqs(ngrid,klev)   !width of the total water subgrid-scale distribution
     3225      REAL po(ngrid)           !total water (qt)
     3226      REAL zqenv(ngrid)        !total water in the environment (qt_env)
     3227      REAL zqta(ngrid,klev)    !total water in the thermals (qt_th)
     3228      REAL zqsatth(ngrid,klev)   !water saturation level in the thermals (q_sat_th)
     3229      REAL zqsatenv(ngrid,klev)  !water saturation level in the environment (q_sat_env)
     3230      REAL qlth(ngrid,klev)    !condensed water in the thermals
     3231      REAL qlenv(ngrid,klev)   !condensed water in the environment
     3232      REAL qltot(ngrid,klev)   !condensed water in the gridbox
     3233        !cloud fractions
     3234      REAL cth_vol(ngrid,klev)   !cloud fraction by volume in the thermals
     3235      REAL cenv_vol(ngrid,klev)  !cloud fraction by volume in the environment
     3236      REAL ctot_vol(ngrid,klev)  !cloud fraction by volume in the gridbox
     3237      REAL cth_surf(ngrid,klev)  !cloud fraction by surface in the thermals
     3238      REAL cenv_surf(ngrid,klev) !cloud fraction by surface in the environment 
     3239      REAL ctot_surf(ngrid,klev) !cloud fraction by surface in the gridbox
     3240        !PDF of saturation deficit variables
     3241      REAL rdd,cppd,Lv
     3242      REAL Tbef,zdelta,qsatbef,zcor
     3243      REAL alth,alenv,ath,aenv
     3244      REAL sth,senv              !saturation deficits in the thermals and environment
     3245      REAL sigma_env,sigma_th    !standard deviations of the biGaussian PDF
     3246        !cloud fraction variables
     3247      REAL xth,xenv
     3248      REAL inverse_rho,beta                                  !Neggers et al. (2011) method
     3249      REAL a_Brooks,b_Brooks,A_Maj_Brooks,Dx_Brooks,f_Brooks !Brooks et al. (2005) method
     3250        !Incloud total water variables
     3251      REAL zqs(ngrid)    !q_sat
     3252      REAL qcloud(ngrid) !eau totale dans le nuage
     3253        !Some arithmetic variables
     3254      REAL  pi,sqrt2,sqrt2pi
     3255        !Depth of the layer
     3256      REAL dz(ngrid,klev)    !epaisseur de la couche en metre
     3257      REAL rhodz(ngrid,klev)
     3258      REAL zrho(ngrid,klev)
     3259      DO ind1 = 1, ngrid
     3260        rhodz(ind1,ind2) = (paprs(ind1,ind2)-paprs(ind1,ind2+1))/rg ![kg/m2]
     3261        zrho(ind1,ind2) = pplay(ind1,ind2)/T(ind1,ind2)/rd          ![kg/m3]
     3262        dz(ind1,ind2) = rhodz(ind1,ind2)/zrho(ind1,ind2)            ![m]
     3263      END DO
     3264
     3265!------------------------------------------------------------------------------
     3266! Initialization
     3267!------------------------------------------------------------------------------
     3268      qlth(:,ind2)=0.
     3269      qlenv(:,ind2)=0. 
     3270      qltot(:,ind2)=0.
     3271      cth_vol(:,ind2)=0.
     3272      cenv_vol(:,ind2)=0.
     3273      ctot_vol(:,ind2)=0.
     3274      cth_surf(:,ind2)=0.
     3275      cenv_surf(:,ind2)=0.
     3276      ctot_surf(:,ind2)=0.
     3277      qcloud(:)=0.
     3278      rdd=287.04
     3279      cppd=1005.7
     3280      pi=3.14159
     3281      Lv=2.5e6
     3282      sqrt2=sqrt(2.)
     3283      sqrt2pi=sqrt(2.*pi)
     3284
     3285
     3286      DO ind1=1,ngrid
     3287!-------------------------------------------------------------------------------
     3288!Both thermal and environment in the gridbox
     3289!-------------------------------------------------------------------------------
     3290      IF ((ztv(ind1,1).gt.ztv(ind1,2)).and.(fraca(ind1,ind2).gt.1.e-10)) THEN
     3291        !--------------------------------------------
     3292        !calcul de qsat_env
     3293        !--------------------------------------------
     3294      Tbef=zthl(ind1,ind2)*zpspsk(ind1,ind2)
     3295      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
     3296      qsatbef= R2ES*FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
     3297      qsatbef=MIN(0.5,qsatbef)
     3298      zcor=1./(1.-retv*qsatbef)
     3299      qsatbef=qsatbef*zcor
     3300      zqsatenv(ind1,ind2)=qsatbef
     3301        !--------------------------------------------
     3302        !calcul de s_env
     3303        !--------------------------------------------
     3304      alenv=(0.622*Lv*zqsatenv(ind1,ind2))/(rdd*zthl(ind1,ind2)**2)     !qsl, p84 these Arnaud Jam
     3305      aenv=1./(1.+(alenv*Lv/cppd))                                      !al, p84 these Arnaud Jam
     3306      senv=aenv*(po(ind1)-zqsatenv(ind1,ind2))                          !s, p84 these Arnaud Jam
     3307        !--------------------------------------------
     3308        !calcul de qsat_th
     3309        !--------------------------------------------
     3310      Tbef=ztla(ind1,ind2)*zpspsk(ind1,ind2)
     3311      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
     3312      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
     3313      qsatbef=MIN(0.5,qsatbef)
     3314      zcor=1./(1.-retv*qsatbef)
     3315      qsatbef=qsatbef*zcor
     3316      zqsatth(ind1,ind2)=qsatbef
     3317        !--------------------------------------------
     3318        !calcul de s_th 
     3319        !--------------------------------------------
     3320      alth=(0.622*Lv*zqsatth(ind1,ind2))/(rdd*ztla(ind1,ind2)**2)       !qsl, p84 these Arnaud Jam
     3321      ath=1./(1.+(alth*Lv/cppd))                                        !al, p84 these Arnaud Jam
     3322      sth=ath*(zqta(ind1,ind2)-zqsatth(ind1,ind2))                      !s, p84 these Arnaud Jam
     3323        !--------------------------------------------
     3324        !calcul standard deviations bi-Gaussian PDF
     3325        !--------------------------------------------
     3326      sigma_th=(0.03218+0.000092655*dz(ind1,ind2))/((fraca(ind1,ind2)+0.01)**0.5)*(((sth-senv)**2)**0.5)+0.002*zqta(ind1,ind2)
     3327      sigma_env=(0.71794+0.000498239*dz(ind1,ind2))*(fraca(ind1,ind2)**0.5) &
     3328           /(1-fraca(ind1,ind2))*(((sth-senv)**2)**0.5) &
     3329           +ratqs(ind1,ind2)*po(ind1)
     3330      xth=sth/(sqrt2*sigma_th)
     3331      xenv=senv/(sqrt2*sigma_env)
     3332        !--------------------------------------------
     3333        !Cloud fraction by volume CF_vol
     3334        !--------------------------------------------
     3335      cth_vol(ind1,ind2)=0.5*(1.+1.*erf(xth))
     3336      cenv_vol(ind1,ind2)=0.5*(1.+1.*erf(xenv))
     3337      ctot_vol(ind1,ind2)=fraca(ind1,ind2)*cth_vol(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv_vol(ind1,ind2)
     3338        !--------------------------------------------
     3339        !Condensed water qc
     3340        !--------------------------------------------
     3341      qlth(ind1,ind2)=sigma_th*((exp(-1.*xth**2)/sqrt2pi)+xth*sqrt2*cth_vol(ind1,ind2))
     3342      qlenv(ind1,ind2)=sigma_env*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt2*cenv_vol(ind1,ind2)) 
     3343      qltot(ind1,ind2)=fraca(ind1,ind2)*qlth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qlenv(ind1,ind2)
     3344        !--------------------------------------------
     3345        !Cloud fraction by surface CF_surf
     3346        !--------------------------------------------
     3347        !Method Neggers et al. (2011) : ok for cumulus clouds only
     3348      !beta=0.0044 (Jouhaud et al.2018)
     3349      !inverse_rho=1.+beta*dz(ind1,ind2)
     3350      !ctot_surf(ind1,ind2)=ctot_vol(ind1,ind2)*inverse_rho
     3351        !Method Brooks et al. (2005) : ok for all types of clouds
     3352      a_Brooks=0.6694
     3353      b_Brooks=0.1882
     3354      A_Maj_Brooks=0.1635 !-- sans dependence au cisaillement de vent
     3355      Dx_Brooks=200000.   !-- si l'on considere des mailles de 200km de cote
     3356      f_Brooks=A_Maj_Brooks*(dz(ind1,ind2)**(a_Brooks))*(Dx_Brooks**(-b_Brooks))
     3357      ctot_surf(ind1,ind2)=1./(1.+exp(-1.*f_Brooks)*((1./max(1.e-15,min(ctot_vol(ind1,ind2),1.)))- 1.))
     3358        !--------------------------------------------
     3359        !Incloud Condensed water qcloud
     3360        !--------------------------------------------
     3361      if (ctot_surf(ind1,ind2) .lt. 1.e-10) then
     3362      ctot_vol(ind1,ind2)=0.
     3363      ctot_surf(ind1,ind2)=0.
     3364      qcloud(ind1)=zqsatenv(ind1,ind2)
     3365      else
     3366      qcloud(ind1)=qltot(ind1,ind2)/ctot_vol(ind1,ind2)+zqs(ind1)
     3367      endif
     3368
     3369
     3370
     3371!-------------------------------------------------------------------------------
     3372!Environment only in the gridbox
     3373!-------------------------------------------------------------------------------
     3374      ELSE
     3375        !--------------------------------------------
     3376        !calcul de qsat_env
     3377        !--------------------------------------------
     3378      Tbef=zthl(ind1,ind2)*zpspsk(ind1,ind2)
     3379      zdelta=MAX(0.,SIGN(1.,RTT-Tbef))
     3380      qsatbef= R2ES * FOEEW(Tbef,zdelta)/paprs(ind1,ind2)
     3381      qsatbef=MIN(0.5,qsatbef)
     3382      zcor=1./(1.-retv*qsatbef)
     3383      qsatbef=qsatbef*zcor
     3384      zqsatenv(ind1,ind2)=qsatbef
     3385        !--------------------------------------------
     3386        !calcul de s_env
     3387        !--------------------------------------------
     3388      alenv=(0.622*Lv*zqsatenv(ind1,ind2))/(rdd*zthl(ind1,ind2)**2)     !qsl, p84 these Arnaud Jam
     3389      aenv=1./(1.+(alenv*Lv/cppd))                                      !al, p84 these Arnaud Jam
     3390      senv=aenv*(po(ind1)-zqsatenv(ind1,ind2))                          !s, p84 these Arnaud Jam
     3391        !--------------------------------------------
     3392        !calcul standard deviations Gaussian PDF
     3393        !--------------------------------------------
     3394      zqenv(ind1)=po(ind1)
     3395      sigma_env=ratqs(ind1,ind2)*zqenv(ind1)
     3396      xenv=senv/(sqrt2*sigma_env)
     3397        !--------------------------------------------
     3398        !Cloud fraction by volume CF_vol
     3399        !--------------------------------------------
     3400      ctot_vol(ind1,ind2)=0.5*(1.+1.*erf(xenv))
     3401        !--------------------------------------------
     3402        !Condensed water qc
     3403        !--------------------------------------------
     3404      qltot(ind1,ind2)=sigma_env*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt2*ctot_vol(ind1,ind2))
     3405        !--------------------------------------------
     3406        !Cloud fraction by surface CF_surf
     3407        !--------------------------------------------
     3408        !Method Neggers et al. (2011) : ok for cumulus clouds only
     3409      !beta=0.0044 (Jouhaud et al.2018)
     3410      !inverse_rho=1.+beta*dz(ind1,ind2)
     3411      !ctot_surf(ind1,ind2)=ctot_vol(ind1,ind2)*inverse_rho
     3412        !Method Brooks et al. (2005) : ok for all types of clouds
     3413      a_Brooks=0.6694
     3414      b_Brooks=0.1882
     3415      A_Maj_Brooks=0.1635 !-- sans dependence au shear
     3416      Dx_Brooks=200000.
     3417      f_Brooks=A_Maj_Brooks*(dz(ind1,ind2)**(a_Brooks))*(Dx_Brooks**(-b_Brooks))
     3418      ctot_surf(ind1,ind2)=1./(1.+exp(-1.*f_Brooks)*((1./max(1.e-15,min(ctot_vol(ind1,ind2),1.)))- 1.))
     3419        !--------------------------------------------
     3420        !Incloud Condensed water qcloud
     3421        !--------------------------------------------
     3422      if (ctot_surf(ind1,ind2) .lt. 1.e-8) then
     3423      ctot_vol(ind1,ind2)=0.
     3424      ctot_surf(ind1,ind2)=0.
     3425      qcloud(ind1)=zqsatenv(ind1,ind2)
     3426      else
     3427      qcloud(ind1)=qltot(ind1,ind2)/ctot_vol(ind1,ind2)+zqsatenv(ind1,ind2)
     3428      endif
     3429
     3430
     3431      END IF  ! From the separation (thermal/envrionnement) et (environnement only)
     3432
     3433      ! Outputs used to check the PDFs
     3434      cloudth_senv(ind1,ind2) = senv
     3435      cloudth_sth(ind1,ind2) = sth
     3436      cloudth_sigmaenv(ind1,ind2) = sigma_env
     3437      cloudth_sigmath(ind1,ind2) = sigma_th
     3438
     3439      END DO  ! From the loop on ngrid
     3440      return
     3441
     3442END SUBROUTINE cloudth_v6
     3443
     3444
    16923445END MODULE lmdz_lscp_condensation

  • LMDZ6/branches/contrails/libf/phylmd/lmdz_lscp_ini.f90

    r5716 r5717  
    99  !$OMP THREADPRIVATE(RCPD, RLSTT, RLVTT, RLMLT, RVTMP2, RTT, RD, RV, RG, RPI, EPS_W)
    1010 
    11   REAL, SAVE, PROTECTED :: seuil_neb=0.001      ! cloud fraction threshold: a cloud can precipitate when exceeded
     11  INTEGER, SAVE, PROTECTED :: iflag_ratqs        ! control of ratqs option
     12  !$OMP THREADPRIVATE(iflag_ratqs)
     13 
     14  REAL, SAVE, PROTECTED :: seuil_neb=0.001       ! cloud fraction threshold: a cloud can precipitate when exceeded
    1215  !$OMP THREADPRIVATE(seuil_neb)
    1316
    … …  
    6770  !$OMP THREADPRIVATE(iflag_t_glace)
    6871
    69   INTEGER, SAVE, PROTECTED :: iflag_cloudth_vert=0          ! option for determining cloud fraction and content in convective boundary layers
    70   !$OMP THREADPRIVATE(iflag_cloudth_vert)
    71 
    7272  INTEGER, SAVE, PROTECTED :: iflag_gammasat=0              ! which threshold for homogeneous nucleation below -40oC
    7373  !$OMP THREADPRIVATE(iflag_gammasat)
    … …  
    136136  !$OMP THREADPRIVATE(expo_sub)
    137137
    138   REAL, SAVE, PROTECTED :: cice_velo=1.645                  ! factor in the ice fall velocity formulation
     138  REAL, SAVE, PROTECTED :: cice_velo=1.645                  ! factor in the ice fall velocity formulation. It is half the value of
     139                                                            ! Heymsfield and Donner 1990 to concur with previous LMDZ versions
    139140  !$OMP THREADPRIVATE(cice_velo)
    140141
    … …  
    274275  !--End of the parameters for aviation
    275276
    276   !--Parameters for poprecip
     277  !--Parameters for poprecip and cloud phase
    277278  LOGICAL, SAVE, PROTECTED :: ok_poprecip=.FALSE.           ! use the processes-oriented formulation of precipitations
    278279  !$OMP THREADPRIVATE(ok_poprecip)
    … …  
    281282  !$OMP THREADPRIVATE(ok_corr_vap_evasub)
    282283
    283   LOGICAL, SAVE, PROTECTED :: ok_growth_precip_deposition=.FALSE.
     284  LOGICAL, SAVE, PROTECTED :: ok_growth_precip_deposition=.FALSE. ! allows growth of snowfall through vapor deposition in supersat. regions
    284285  !$OMP THREADPRIVATE(ok_growth_precip_deposition)
    285286
    … …  
    305306  !$OMP THREADPRIVATE(gamma_snwretro)
    306307
     308  REAL, SAVE, PROTECTED :: gamma_mixth = 1.                 ! Tuning coeff for mixing with thermals/env in lscp_icefrac_turb [-]
     309  !$OMP THREADPRIVATE(gamma_mixth)
     310
    307311  REAL, SAVE, PROTECTED :: gamma_taud = 1.                  ! Tuning coeff for Lagrangian decorrelation timescale in lscp_icefrac_turb [-]
    308312  !$OMP THREADPRIVATE(gamma_taud)
    … …  
    326330  !$OMP THREADPRIVATE(rho_rain)
    327331
    328   REAL, SAVE, PROTECTED :: rho_ice=920.                     ! Ice density [kg/m3]
     332  REAL, SAVE, PROTECTED :: rho_ice=920.                     ! Ice crystal density (assuming spherical geometry) [kg/m3]
    329333  !$OMP THREADPRIVATE(rho_ice)
    330334
    … …  
    335339  !$OMP THREADPRIVATE(r_snow)
    336340
    337   REAL, SAVE, PROTECTED :: expo_tau_auto_snow=0.1
    338   !$OMP THREADPRIVATE(expo_tau_auto_snow)
    339 
    340341  REAL, SAVE, PROTECTED :: tau_auto_snow_min=100.           ! Snow autoconversion minimal timescale (when liquid) [s]
    341342  !$OMP THREADPRIVATE(tau_auto_snow_min)
    … …  
    343344  REAL, SAVE, PROTECTED :: tau_auto_snow_max=1000.          ! Snow autoconversion minimal timescale (when only ice) [s]
    344345  !$OMP THREADPRIVATE(tau_auto_snow_max)
     346
     347  REAL, SAVE, PROTECTED :: expo_tau_auto_snow=0.1          ! Snow autoconversion timescale exponent for icefrac dependency
     348  !$OMP THREADPRIVATE(expo_tau_auto_snow)
    345349
    346350  REAL, SAVE, PROTECTED :: eps=1.E-10                       ! Treshold 0 [-]
    … …  
    381385  !--End of the parameters for poprecip
    382386
    383 ! Two parameters used for lmdz_lscp_old only
     387  ! Parameters for cloudth routines
     388  LOGICAL, SAVE, PROTECTED :: ok_lscp_mergecond=.false.     ! more consistent condensation stratiform and shallow convective clouds
     389  !$OMP THREADPRIVATE(ok_lscp_mergecond)
     390 
     391  INTEGER, SAVE, PROTECTED :: iflag_cloudth_vert=0          ! option for determining cloud fraction and content in convective boundary layers
     392  !$OMP THREADPRIVATE(iflag_cloudth_vert)
     393
     394  INTEGER, SAVE, PROTECTED :: iflag_cloudth_vert_noratqs=0  ! option to control the width of gaussian distrib in a specific case
     395  !$OMP THREADPRIVATE(iflag_cloudth_vert_noratqs)
     396
     397  REAL, SAVE, PROTECTED :: cloudth_ratqsmin=-1.             ! minimum ratqs in cloudth
     398  !$OMP THREADPRIVATE(cloudth_ratqsmin)
     399
     400  REAL, SAVE, PROTECTED :: sigma1s_factor=1.1               ! factor for standard deviation of gaussian distribution of environment
     401  !$OMP THREADPRIVATE(sigma1s_factor)
     402
     403  REAL, SAVE, PROTECTED :: sigma2s_factor=0.09              ! factor for standard deviation of gaussian distribution of thermals
     404  !$OMP THREADPRIVATE(sigma2s_factor)
     405
     406
     407  REAL, SAVE, PROTECTED :: sigma1s_power=0.6                ! exponent for standard deviation of gaussian distribution of environment
     408  !$OMP THREADPRIVATE(sigma1s_power)
     409   
     410  REAL, SAVE, PROTECTED :: sigma2s_power=0.5                ! exponent for standard deviation of gaussian distribution of thermals
     411  !$OMP THREADPRIVATE(sigma2s_power)
     412
     413  REAL, SAVE, PROTECTED :: vert_alpha=0.5                   ! tuning coefficient for standard deviation of gaussian distribution of thermals
     414  !$OMP THREADPRIVATE(vert_alpha)
     415
     416  REAL, SAVE, PROTECTED :: vert_alpha_th=0.5                ! tuning coefficient for standard deviation of gaussian distribution of thermals
     417  !$OMP THREADPRIVATE(vert_alpha_th)
     418  ! End of parameters for cloudth routines
     419
     420  ! Two parameters used for lmdz_lscp_old only
    384421  INTEGER, SAVE, PROTECTED :: iflag_oldbug_fisrtilp=0, fl_cor_ebil
    385422  !$OMP THREADPRIVATE(iflag_oldbug_fisrtilp,fl_cor_ebil)
    … …  
    389426SUBROUTINE lscp_ini(dtime, lunout_in, prt_level_in, ok_ice_supersat_in, &
    390427                    ok_no_issr_strato_in, ok_plane_contrail_in, &
    391                     iflag_ratqs, fl_cor_ebil_in, &
     428                    iflag_ratqs_in, fl_cor_ebil_in, &
    392429                    RCPD_in, RLSTT_in, RLVTT_in, RLMLT_in, RVTMP2_in, &
    393430                    RTT_in, RD_in, RV_in, RG_in, RPI_in, EPS_W_in)
    … …  
    395432
    396433   USE ioipsl_getin_p_mod, ONLY : getin_p
    397    USE lmdz_cloudth_ini, ONLY : cloudth_ini
    398434
    399435   REAL, INTENT(IN)      :: dtime
    400    INTEGER, INTENT(IN)   :: lunout_in,prt_level_in,iflag_ratqs,fl_cor_ebil_in
     436   INTEGER, INTENT(IN)   :: lunout_in,prt_level_in,iflag_ratqs_in,fl_cor_ebil_in
    401437   LOGICAL, INTENT(IN)   :: ok_ice_supersat_in, ok_no_issr_strato_in, ok_plane_contrail_in
    402438
    … …  
    410446    prt_level=prt_level_in
    411447    fl_cor_ebil=fl_cor_ebil_in
    412 
     448    iflag_ratqs=iflag_ratqs_in
    413449    ok_ice_supersat=ok_ice_supersat_in
    414450    ok_no_issr_strato=ok_no_issr_strato_in
    … …  
    439475    CALL getin_p('iflag_vice',iflag_vice)
    440476    CALL getin_p('iflag_t_glace',iflag_t_glace)
    441     CALL getin_p('iflag_cloudth_vert',iflag_cloudth_vert)
    442477    CALL getin_p('iflag_gammasat',iflag_gammasat)
    443478    CALL getin_p('iflag_rain_incloud_vol',iflag_rain_incloud_vol)
    … …  
    457492    CALL getin_p('ffallv_lsc',ffallv_lsc)
    458493    CALL getin_p('ffallv_lsc',ffallv_con)
     494    ! for poprecip and cloud phase
    459495    CALL getin_p('coef_eva',coef_eva)
    460496    coef_sub=coef_eva
    … …  
    471507    CALL getin_p('gamma_snwretro',gamma_snwretro)
    472508    CALL getin_p('gamma_taud',gamma_taud)
     509    CALL getin_p('gamma_mixth',gamma_mixth)
    473510    CALL getin_p('iflag_oldbug_fisrtilp',iflag_oldbug_fisrtilp)
    474511    CALL getin_p('temp_nowater',temp_nowater)
    475512    CALL getin_p('ok_bug_phase_lscp',ok_bug_phase_lscp)
    476513    CALL getin_p('ok_bug_ice_fallspeed',ok_bug_ice_fallspeed)
    477     ! for poprecip
    478514    CALL getin_p('ok_poprecip',ok_poprecip)
    479515    CALL getin_p('ok_corr_vap_evasub',ok_corr_vap_evasub)
    … …  
    487523    CALL getin_p('tau_auto_snow_max',tau_auto_snow_max)
    488524    CALL getin_p('tau_auto_snow_min',tau_auto_snow_min)
     525    CALL getin_p('expo_tau_auto_snow', expo_tau_auto_snow)
     526    CALL getin_p('alpha_freez',alpha_freez)
     527    CALL getin_p('beta_freez',beta_freez)
    489528    CALL getin_p('r_snow',r_snow)
    490529    CALL getin_p('rain_fallspeed',rain_fallspeed)
    … …  
    542581    CALL getin_p('fallice_cirrus_contrails',fallice_cirrus_contrails)
    543582    CALL getin_p('aviation_coef',aviation_coef)
    544 
    545 
     583    ! for cloudth routines
     584    CALL getin_p('ok_lscp_mergecond',ok_lscp_mergecond)
     585    CALL getin_p('iflag_cloudth_vert',iflag_cloudth_vert)
     586    CALL getin_p('cloudth_ratqsmin',cloudth_ratqsmin)
     587    CALL getin_p('cloudth_sigma1s_factor',sigma1s_factor)
     588    CALL getin_p('cloudth_sigma1s_power',sigma1s_power)
     589    CALL getin_p('cloudth_sigma2s_factor',sigma2s_factor)
     590    CALL getin_p('cloudth_sigma2s_power',sigma2s_power)
     591    CALL getin_p('cloudth_vert_alpha',vert_alpha)
     592    vert_alpha_th=vert_alpha
     593    CALL getin_p('cloudth_vert_alpha_th',vert_alpha_th)
     594    CALL getin_p('iflag_cloudth_vert_noratqs',iflag_cloudth_vert_noratqs)
    546595
    547596    WRITE(lunout,*) 'lscp_ini, niter_lscp:', niter_lscp
    … …  
    554603    WRITE(lunout,*) 'lscp_ini, iflag_vice:', iflag_vice
    555604    WRITE(lunout,*) 'lscp_ini, iflag_t_glace:', iflag_t_glace
    556     WRITE(lunout,*) 'lscp_ini, iflag_cloudth_vert:', iflag_cloudth_vert
    557605    WRITE(lunout,*) 'lscp_ini, iflag_gammasat:', iflag_gammasat
    558606    WRITE(lunout,*) 'lscp_ini, iflag_rain_incloud_vol:', iflag_rain_incloud_vol
    … …  
    582630    WRITE(lunout,*) 'lscp_ini, naero5', naero5
    583631    WRITE(lunout,*) 'lscp_ini, gamma_snwretro', gamma_snwretro
     632    WRITE(lunout,*) 'lscp_ini, gamma_mixth', gamma_mixth
    584633    WRITE(lunout,*) 'lscp_ini, gamma_taud', gamma_taud
    585634    WRITE(lunout,*) 'lscp_ini, iflag_oldbug_fisrtilp', iflag_oldbug_fisrtilp
    … …  
    600649    WRITE(lunout,*) 'lscp_ini, tau_auto_snow_max:',tau_auto_snow_max
    601650    WRITE(lunout,*) 'lscp_ini, tau_auto_snow_min:',tau_auto_snow_min
     651    WRITE(lunout,*) 'lscp_ini, expo_tau_auto_snow:',expo_tau_auto_snow
    602652    WRITE(lunout,*) 'lscp_ini, r_snow:', r_snow
     653    WRITE(lunout,*) 'lscp_ini, alpha_freez:', alpha_freez
     654    WRITE(lunout,*) 'lscp_ini, beta_freez:', beta_freez
    603655    WRITE(lunout,*) 'lscp_ini, rain_fallspeed_clr:', rain_fallspeed_clr
    604656    WRITE(lunout,*) 'lscp_ini, rain_fallspeed_cld:', rain_fallspeed_cld
    … …  
    647699    WRITE(lunout,*) 'lscp_ini, fallice_cirrus_contrails:', fallice_cirrus_contrails
    648700    WRITE(lunout,*) 'lscp_ini, aviation_coef:', aviation_coef
    649 
    650 
     701    ! for cloudth routines
     702    WRITE(lunout,*) 'lscp_ini, ok_lscp_mergecond:', ok_lscp_mergecond
     703    WRITE(lunout,*) 'lscp_ini, iflag_cloudth_vert:', iflag_cloudth_vert
     704    WRITE(lunout,*) 'lscp_ini, cloudth_ratqsmin:', cloudth_ratqsmin
     705    WRITE(lunout,*) 'lscp_ini, cloudth_sigma1s_factor:', sigma1s_factor
     706    WRITE(lunout,*) 'lscp_ini, cloudth_sigma1s_power:', sigma1s_power
     707    WRITE(lunout,*) 'lscp_ini, cloudth_sigma2s_factor:', sigma2s_factor
     708    WRITE(lunout,*) 'lscp_ini, cloudth_sigma2s_power:', sigma2s_power
     709    WRITE(lunout,*) 'lscp_ini, cloudth_vert_alpha:', vert_alpha
     710    WRITE(lunout,*) 'lscp_ini, cloudth_vert_alpha_th:', vert_alpha_th
     711    WRITE(lunout,*) 'lscp_ini, iflag_cloudth_vert_noratqs:', iflag_cloudth_vert_noratqs
     712
     713
     714    ! check consistency for cloud phase partitioning options
     715
     716    IF ((iflag_icefrac .GE. 2) .AND. (.NOT. ok_lscp_mergecond)) THEN
     717      abort_message = 'in lscp, iflag_icefrac .GE. 2 works only if ok_lscp_mergecond=.TRUE.'
     718      CALL abort_physic (modname,abort_message,1)
     719    ENDIF
    651720
    652721    ! check for precipitation sub-time steps
    … …  
    659728    ! and other options
    660729   
    661     IF (iflag_autoconversion .EQ. 2) THEN
     730    IF ((iflag_autoconversion .EQ. 2) .AND. .NOT. ok_poprecip) THEN
    662731        IF ((iflag_vice .NE. 0) .OR. (niter_lscp .GT. 1)) THEN
    663732           abort_message = 'in lscp, iflag_autoconversion=2 requires iflag_vice=0 and niter_lscp=1'
    … …  
    677746    ENDIF
    678747
     748    IF ( (iflag_icefrac .GE. 1) .AND. (.NOT. ok_poprecip .AND. (iflag_evap_prec .LT. 4)) ) THEN
     749      abort_message = 'in lscp, icefracturb works with poprecip or with precip evap option >=4'
     750      CALL abort_physic (modname,abort_message,1)
     751    ENDIF
     752
    679753    !--Calculated here to lighten calculations
    680754    corr_incld_depsub = GAMMA(nu_iwc_pdf_lscp + 1./3.) / GAMMA(nu_iwc_pdf_lscp) &
    681755                      / nu_iwc_pdf_lscp**(1./3.)
    682 
    683756
    684757    !AA Temporary initialisation
    … …  
    688761    a_tr_sca(4) = -0.5
    689762   
    690     CALL cloudth_ini(iflag_cloudth_vert,iflag_ratqs)
    691763
    692764RETURN

  • LMDZ6/branches/contrails/libf/phylmd/lmdz_lscp_main.f90

    r5614 r5717  
    88SUBROUTINE lscp(klon, klev, dtime, missing_val,         &
    99     paprs, pplay, omega, temp, qt, ql_seri, qi_seri,   &
    10      ptconv, ratqs, sigma_qtherm,                       &
     10     ratqs, sigma_qtherm, ptconv, cfcon_old, qvcon_old, &
     11     qccon_old, cfcon, qvcon, qccon,                    &
    1112     d_t, d_q, d_ql, d_qi, rneb, rneblsvol,             &
    1213     pfraclr, pfracld,                                  &
    … …  
    2122     tke, tke_dissip,                                   &
    2223     entr_therm, detr_therm,                            &
    23      cell_area,                                         &
    24      cf_seri, rvc_seri, u_seri, v_seri,                 &
     24     cell_area, stratomask,                             &
     25     cf_seri, qvc_seri, u_seri, v_seri,                 &
    2526     qsub, qissr, qcld, subfra, issrfra, gamma_cond,    &
    26      dcf_sub, dcf_con, dcf_mix,          &
     27     dcf_sub, dcf_con, dcf_mix, dqised, dcfsed, dqvcsed,&
    2728     dqi_adj, dqi_sub, dqi_con, dqi_mix, dqvc_adj,      &
    2829     dqvc_sub, dqvc_con, dqvc_mix, qsatl, qsati,        &
    29      Tcontr, qcontr, qcontr2, fcontrN, fcontrP, dcf_avi,&
    30      dqi_avi, dqvc_avi, flight_dist, flight_h2o,        &
    31      cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv, &
     30     cfl_seri, cfc_seri, qtl_seri, qtc_seri,            &
     31     qice_lincont, qice_circont, flight_dist,           &
     32     flight_h2o, qradice_lincont, qradice_circont,      &
     33     Tcritcont, qcritcont, potcontfraP, potcontfraNP,   &
     34     cloudth_sth,                                       &
     35     cloudth_senv, cloudth_sigmath, cloudth_sigmaenv,   &
    3236     qraindiag, qsnowdiag, dqreva, dqssub, dqrauto,     &
    3337     dqrcol, dqrmelt, dqrfreez, dqsauto, dqsagg, dqsrim,&
    … …  
    122126USE lmdz_lscp_ini, ONLY : ok_poprecip, ok_bug_phase_lscp
    123127USE lmdz_lscp_ini, ONLY : ok_ice_supersat, ok_unadjusted_clouds, iflag_icefrac
     128USE lmdz_lscp_ini, ONLY : ok_weibull_warm_clouds, ok_no_issr_strato
     129USE lmdz_lscp_ini, ONLY : ok_plane_contrail, ok_precip_contrails, ok_ice_sedim
     130USE lmdz_lscp_ini, ONLY : ok_nodeep_lscp, ok_nodeep_lscp_rad
    124131USE lmdz_lscp_ini, ONLY : ok_lscp_mergecond, gamma_mixth
     132
     133! Temporary call for Lamquin et al (2012) diagnostics
     134USE phys_local_var_mod, ONLY : issrfra100to150, issrfra150to200, issrfra200to250
     135USE phys_local_var_mod, ONLY : issrfra250to300, issrfra300to400, issrfra400to500
     136USE phys_local_var_mod, ONLY : dcfl_ini, dqil_ini, dqtl_ini, dcfl_sub, dqil_sub, dqtl_sub
     137USE phys_local_var_mod, ONLY : dcfl_cir, dqtl_cir, dcfl_mix, dqil_mix, dqtl_mix
     138USE phys_local_var_mod, ONLY : dcfc_sub, dqic_sub, dqtc_sub, dcfc_mix, dqic_mix, dqtc_mix
     139USE geometry_mod, ONLY: longitude_deg, latitude_deg
    125140
    126141IMPLICIT NONE
    … …  
    149164  REAL, DIMENSION(klon,klev+1),    INTENT(IN)   :: tke             ! turbulent kinetic energy [m2/s2]
    150165  REAL, DIMENSION(klon,klev+1),    INTENT(IN)   :: tke_dissip      ! TKE dissipation [m2/s3]
    151   REAL, DIMENSION(klon,klev),      INTENT(IN)   :: entr_therm      ! thermal plume entrainment rate [kg/s/m2] ! per mesh surface unit
    152   REAL, DIMENSION(klon,klev),      INTENT(IN)   :: detr_therm      ! thermal plume detrainment rate [kg/s/m2] ! per mesh surface unit
     166  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: entr_therm      ! thermal plume entrainment rate * dz [kg/s/m2]
     167  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: detr_therm      ! thermal plume detrainment rate * dz [kg/s/m2]
    153168
    154169
    155170 
    156171  LOGICAL, DIMENSION(klon,klev),   INTENT(IN)   :: ptconv          ! grid points where deep convection scheme is active
     172  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: cfcon_old       ! cloud fraction from deep convection from previous timestep [-]
     173  REAL, DIMENSION(klon,klev),      INTENT(INOUT):: qvcon_old       ! in-cloud vapor specific humidity from deep convection from previous timestep [kg/kg]
     174  REAL, DIMENSION(klon,klev),      INTENT(INOUT):: qccon_old       ! in-cloud condensed specific humidity from deep convection from previous timestep [kg/kg]
     175  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: cfcon           ! cloud fraction from deep convection [-]
     176  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: qvcon           ! in-cloud vapor specific humidity from deep convection [kg/kg]
     177  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: qccon           ! in-cloud condensed specific humidity from deep convection [kg/kg]
    157178
    158179  !Inputs associated with thermal plumes
    … …  
    179200  !--------------------------------------------------
    180201  REAL, DIMENSION(klon,klev),      INTENT(INOUT):: cf_seri          ! cloud fraction [-]
    181   REAL, DIMENSION(klon,klev),      INTENT(INOUT):: rvc_seri         ! cloudy water vapor to total water vapor ratio [-]
     202  REAL, DIMENSION(klon,klev),      INTENT(INOUT):: qvc_seri         ! cloudy water vapor [kg/kg]
    182203  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: u_seri           ! eastward wind [m/s]
    183204  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: v_seri           ! northward wind [m/s]
    184205  REAL, DIMENSION(klon),           INTENT(IN)   :: cell_area        ! area of each cell [m2]
     206  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: stratomask       ! fraction of stratosphere (0 or 1)
    185207
    186208  ! INPUT/OUTPUT aviation
    187209  !--------------------------------------------------
    188   REAL, DIMENSION(klon,klev),      INTENT(IN)   :: flight_dist      ! Aviation distance flown within the mesh [m/s/mesh]
    189   REAL, DIMENSION(klon,klev),      INTENT(IN)   :: flight_h2o       ! Aviation H2O emitted within the mesh [kg H2O/s/mesh]
    190  
     210  REAL, DIMENSION(klon,klev),      INTENT(INOUT):: cfl_seri         ! linear contrails fraction [-]
     211  REAL, DIMENSION(klon,klev),      INTENT(INOUT):: cfc_seri         ! contrail cirrus fraction [-]
     212  REAL, DIMENSION(klon,klev),      INTENT(INOUT):: qtl_seri         ! linear contrails total specific humidity [kg/kg]
     213  REAL, DIMENSION(klon,klev),      INTENT(INOUT):: qtc_seri         ! contrail cirrus total specific humidity [kg/kg]
     214  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: flight_dist      ! aviation distance flown within the mesh [m/s/mesh]
     215  REAL, DIMENSION(klon,klev),      INTENT(IN)   :: flight_h2o       ! aviation H2O emitted within the mesh [kgH2O/s/mesh]
     216
    191217  ! OUTPUT variables
    192218  !-----------------
    … …  
    241267  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: dqvc_con       !--specific cloud water vapor tendency because of condensation [kg/kg/s]
    242268  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: dqvc_mix       !--specific cloud water vapor tendency because of cloud mixing [kg/kg/s]
     269  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: dqised         !--ice water content tendency due to sedmentation of ice crystals [kg/kg/s]
     270  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: dcfsed         !--cloud fraction tendency due to sedimentation of ice crystals [kg/kg/s]
     271  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: dqvcsed        !--cloud water vapor tendency due to sedimentation of ice crystals [kg/kg/s]
    243272  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: qsatl          !--saturation specific humidity wrt liquid [kg/kg]
    244273  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: qsati          !--saturation specific humidity wrt ice [kg/kg] 
    … …  
    246275  ! for contrails and aviation
    247276
    248   REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: Tcontr         !--threshold temperature for contrail formation [K]
    249   REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: qcontr         !--threshold humidity for contrail formation [kg/kg]
    250   REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: qcontr2        !--// (2nd expression more consistent with LMDZ expression of q)
    251   REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: fcontrN        !--fraction of grid favourable to non-persistent contrails
    252   REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: fcontrP        !--fraction of grid favourable to persistent contrails
    253   REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: dcf_avi        !--cloud fraction tendency because of aviation [s-1]
    254   REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: dqi_avi        !--specific ice content tendency because of aviation [kg/kg/s]
    255   REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: dqvc_avi       !--specific cloud water vapor tendency because of aviation [kg/kg/s]
     277  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: qice_lincont   !--condensed water in linear contrails [kg/kg]
     278  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: qice_circont   !--condensed water in contrail cirrus [kg/kg]
     279  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: qradice_lincont!--condensed water in linear contrails used in the radiation scheme [kg/kg]
     280  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: qradice_circont!--condensed water in contrail cirrus used in the radiation scheme [kg/kg]
     281  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: Tcritcont      !--critical temperature for contrail formation [K]
     282  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: qcritcont      !--critical specific humidity for contrail formation [kg/kg]
     283  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: potcontfraP    !--potential persistent contrail fraction [-]
     284  REAL, DIMENSION(klon,klev),      INTENT(OUT)  :: potcontfraNP   !--potential non-persistent contrail fraction [-]
    256285
    257286
    … …  
    282311  ! LOCAL VARIABLES:
    283312  !----------------
     313  REAL, DIMENSION(klon) :: qliq_in, qice_in, qvc_in, cldfra_in
    284314  REAL, DIMENSION(klon,klev) :: ctot, rnebth, ctot_vol
    285315  REAL, DIMENSION(klon,klev) :: wls                                 !-- large scalce vertical velocity [m/s]
    … …  
    289319  REAL, DIMENSION(klon) :: zdqsdT_raw
    290320  REAL, DIMENSION(klon) :: gammasat,dgammasatdt                   ! coefficient to make cold condensation at the correct RH and derivative wrt T
    291   REAL, DIMENSION(klon) :: Tbef,Tbefth,qlibef,DT                  ! temperature, humidity and temp. variation during condensation iteration
     321  REAL, DIMENSION(klon) :: Tbef,Tbefth,Tbefthm1,qlibef,DT                  ! temperature, humidity and temp. variation during condensation iteration
    292322  REAL :: num,denom
    293323  REAL :: cste
    … …  
    297327  REAL, DIMENSION(klon) :: zoliql, zoliqi
    298328  REAL, DIMENSION(klon) :: zt, zp
    299   REAL, DIMENSION(klon) :: zfice, zficeth, zficeenv, zneb, zcf, zqi_ini, zsnow
     329  REAL, DIMENSION(klon) :: zfice, zficeth, zficeenv, zneb, zcf, zsnow
    300330  REAL, DIMENSION(klon) :: dzfice, dzficeth, dzficeenv
    301331  REAL, DIMENSION(klon) :: qtot, zeroklon
    … …  
    312342  REAL, DIMENSION(klon) :: znebprecip, znebprecipclr, znebprecipcld
    313343  REAL, DIMENSION(klon) :: tot_zneb
    314   REAL, DIMENSION(klon) :: zdistcltop, ztemp_cltop
     344  REAL, DIMENSION(klon) :: zdistcltop, ztemp_cltop, zdeltaz
    315345  REAL, DIMENSION(klon) :: zqliq, zqice, zqvapcl, zqliqth, zqiceth, zqvapclth, sursat_e, invtau_e ! for icefrac_lscp_turb
     346  ! for ice sedimentation
     347  REAL, DIMENSION(klon) :: dzsed, flsed, cfsed
     348  REAL, DIMENSION(klon) :: dzsed_abv, flsed_abv, cfsed_abv
     349  REAL :: qice_sedim
    316350
    317351  ! for quantity of condensates seen by radiation
    … …  
    321355  ! for condensation and ice supersaturation
    322356  REAL, DIMENSION(klon) :: qvc, qvcl, shear
    323   REAL :: delta_z
    324   !--Added for ice supersaturation (ok_ice_supersat) and contrails (ok_plane_contrails)
    325   ! Constants used for calculating ratios that are advected (using a parent-child
    326   ! formalism). This is not done in the dynamical core because at this moment,
    327   ! only isotopes can use this parent-child formalism. Note that the two constants
    328   ! are the same as the one use in the dynamical core, being also defined in
    329   ! dyn3d_common/infotrac.F90
    330   REAL :: min_qParent, min_ratio
     357  REAL :: delta_z, deepconv_coef
     358  ! for contrails
     359  REAL, DIMENSION(klon) :: lincontfra, circontfra, qlincont, qcircont
     360  REAL, DIMENSION(klon) :: totfra_in, qtot_in
     361  LOGICAL, DIMENSION(klon) :: pt_pron_clds
     362  REAL, DIMENSION(klon) :: dzsed_lincont, flsed_lincont, cfsed_lincont
     363  REAL, DIMENSION(klon) :: dzsed_circont, flsed_circont, cfsed_circont
     364  REAL, DIMENSION(klon) :: dzsed_lincont_abv, flsed_lincont_abv, cfsed_lincont_abv
     365  REAL, DIMENSION(klon) :: dzsed_circont_abv, flsed_circont_abv, cfsed_circont_abv
     366  REAL :: qice_cont
     367  !--for Lamquin et al 2012 diagnostics
     368  REAL, DIMENSION(klon) :: issrfra100to150UP, issrfra150to200UP, issrfra200to250UP
     369  REAL, DIMENSION(klon) :: issrfra250to300UP, issrfra300to400UP, issrfra400to500UP
    331370
    332371  INTEGER i, k, kk, iter
    … …  
    411450dcf_con(:,:)    = 0.
    412451dcf_mix(:,:)    = 0.
     452dcfsed(:,:)     = 0.
    413453dqi_adj(:,:)    = 0.
    414454dqi_sub(:,:)    = 0.
    415455dqi_con(:,:)    = 0.
    416456dqi_mix(:,:)    = 0.
     457dqised(:,:)     = 0.
    417458dqvc_adj(:,:)   = 0.
    418459dqvc_sub(:,:)   = 0.
    419460dqvc_con(:,:)   = 0.
    420461dqvc_mix(:,:)   = 0.
    421 fcontrN(:,:)    = 0.
    422 fcontrP(:,:)    = 0.
    423 Tcontr(:,:)     = missing_val
    424 qcontr(:,:)     = missing_val
    425 qcontr2(:,:)    = missing_val
    426 dcf_avi(:,:)    = 0.
    427 dqi_avi(:,:)    = 0.
    428 dqvc_avi(:,:)   = 0.
     462dqvcsed(:,:)    = 0.
    429463qvc(:)          = 0.
    430464shear(:)        = 0.
    431 min_qParent     = 1.e-30
    432 min_ratio       = 1.e-16
     465flsed(:)        = 0.
     466pt_pron_clds(:) = .FALSE.
     467
     468!--for Lamquin et al (2012) diagnostics
     469issrfra100to150(:)   = 0.
     470issrfra100to150UP(:) = 0.
     471issrfra150to200(:)   = 0.
     472issrfra150to200UP(:) = 0.
     473issrfra200to250(:)   = 0.
     474issrfra200to250UP(:) = 0.
     475issrfra250to300(:)   = 0.
     476issrfra250to300UP(:) = 0.
     477issrfra300to400(:)   = 0.
     478issrfra300to400UP(:) = 0.
     479issrfra400to500(:)   = 0.
     480issrfra400to500UP(:) = 0.
    433481
    434482!-- poprecip
    … …  
    486534        zq(i)=qt(i,k)
    487535        zp(i)=pplay(i,k)
    488         zqi_ini(i)=qi_seri(i,k)
     536        qliq_in(i) = ql_seri(i,k)
     537        qice_in(i) = qi_seri(i,k)
    489538        zcf(i) = 0.
    490539        zfice(i) = 1.0   ! initialized at 1 as by default we assume mpc to be at ice saturation
    … …  
    504553        !c_iso init of iso
    505554    ENDDO
     555    IF ( ok_ice_supersat ) THEN
     556      cldfra_in(:) = cf_seri(:,k)
     557      qvc_in(:) = qvc_seri(:,k)
     558    ENDIF
    506559
    507560    ! --------------------------------------------------------------------
    … …  
    517570      CALL poprecip_precld(klon, dtime, iftop, paprs(:,k), paprs(:,k+1), zp, &
    518571                        zt, ztupnew, zq, zmqc, znebprecipclr, znebprecipcld, &
    519                         zqvapclr, zqupnew, &
    520                         cf_seri(:,k), rvc_seri(:,k), ql_seri(:,k), qi_seri(:,k), &
     572                        zqvapclr, zqupnew, flsed, &
     573                        cldfra_in, qvc_in, qliq_in, qice_in, &
    521574                        zrfl, zrflclr, zrflcld, &
    522575                        zifl, ziflclr, ziflcld, &
    … …  
    528581
    529582      CALL histprecip_precld(klon, dtime, iftop, paprs(:,k), paprs(:,k+1), zp, &
    530                         zt, ztupnew, zq, zmqc, zneb, znebprecip, znebprecipclr, &
     583                        zt, ztupnew, zq, zmqc, zneb, znebprecip, znebprecipclr, flsed, &
    531584                        zrfl, zrflclr, zrflcld, &
    532585                        zifl, ziflclr, ziflcld, &
    … …  
    536589    ENDIF ! (ok_poprecip)
    537590   
    538     ! Calculation of qsat, L/Cp*dqsat/dT and ncoreczq counter
     591    ! Calculation of qsat,L/cp*dqsat/dT and ncoreczq counter
    539592    !-------------------------------------------------------
    540593
    … …  
    647700        ENDIF ! .not. ok_lscp_mergecond
    648701        !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    649        
     702
     703
     704        IF ( ok_ice_supersat ) THEN
     705
     706          !--Initialisation
     707          IF ( ok_plane_contrail ) THEN
     708            IF ( iftop ) THEN
     709              dzsed_lincont_abv(:) = 0.
     710              flsed_lincont_abv(:) = 0.
     711              cfsed_lincont_abv(:) = 0.
     712              dzsed_circont_abv(:) = 0.
     713              flsed_circont_abv(:) = 0.
     714              cfsed_circont_abv(:) = 0.
     715            ELSE
     716              dzsed_lincont_abv(:) = dzsed_lincont(:)
     717              flsed_lincont_abv(:) = flsed_lincont(:)
     718              cfsed_lincont_abv(:) = cfsed_lincont(:)
     719              dzsed_circont_abv(:) = dzsed_circont(:)
     720              flsed_circont_abv(:) = flsed_circont(:)
     721              cfsed_circont_abv(:) = cfsed_circont(:)
     722            ENDIF
     723            dzsed_lincont(:) = 0.
     724            flsed_lincont(:) = 0.
     725            cfsed_lincont(:) = 0.
     726            dzsed_circont(:) = 0.
     727            flsed_circont(:) = 0.
     728            cfsed_circont(:) = 0.
     729            lincontfra(:)    = 0.
     730            circontfra(:)    = 0.
     731            qlincont(:)      = 0.
     732            qcircont(:)      = 0.
     733          ENDIF
     734
     735          IF ( iftop ) THEN
     736            dzsed_abv(:) = 0.
     737            flsed_abv(:) = 0.
     738            cfsed_abv(:) = 0.
     739          ELSE
     740            dzsed_abv(:) = dzsed(:)
     741            flsed_abv(:) = flsed(:)
     742            cfsed_abv(:) = cfsed(:)
     743          ENDIF
     744          dzsed(:) = 0.
     745          flsed(:) = 0.
     746          cfsed(:) = 0.
     747
     748          DO i = 1, klon
     749            pt_pron_clds(i) = ( cfcon(i,k) .LT. ( 1. - eps ) )
     750          ENDDO
     751          IF ( .NOT. ok_weibull_warm_clouds ) THEN
     752            DO i = 1, klon
     753              pt_pron_clds(i) = pt_pron_clds(i) .AND. ( zt(i) .LE. temp_nowater )
     754            ENDDO
     755          ENDIF
     756          IF ( ok_no_issr_strato ) THEN
     757            DO i = 1, klon
     758              pt_pron_clds(i) = pt_pron_clds(i) .AND. ( stratomask(i,k) .EQ. 0. )
     759            ENDDO
     760          ENDIF
     761
     762          totfra_in(:) = 1.
     763          qtot_in(:) = zq(:)
     764
     765          IF ( ok_nodeep_lscp ) THEN
     766            DO i = 1, klon
     767              !--If deep convection is activated, the condensation scheme activates
     768              !--only in the environment. NB. the clear sky fraction will the be
     769              !--maximised by 1. - cfcon(i,k)
     770              IF ( pt_pron_clds(i) .AND. ptconv(i,k) ) THEN
     771                totfra_in(i) = 1. - cfcon(i,k)
     772                qtot_in(i) = zq(i) - ( qvcon(i,k) + qccon(i,k) ) * cfcon(i,k)
     773              ENDIF
     774            ENDDO
     775          ENDIF
     776
     777          DO i = 1, klon
     778            IF ( pt_pron_clds(i) ) THEN
     779              IF ( cfcon(i,k) .LT. cfcon_old(i,k) ) THEN
     780                !--If deep convection is weakening, we add the clouds that are not anymore
     781                !--'in' deep convection to the advected clouds
     782                cldfra_in(i) = cldfra_in(i) + ( cfcon_old(i,k) - cfcon(i,k) )
     783                qvc_in(i) = qvc_in(i) + qvcon_old(i,k) * ( cfcon_old(i,k) - cfcon(i,k) )
     784                qice_in(i) = qice_in(i) + qccon_old(i,k) * ( cfcon_old(i,k) - cfcon(i,k) )
     785              ELSE
     786                !--Else if deep convection is strengthening, it consumes the existing cloud
     787                !--fraction (which does not at this moment represent deep convection)
     788                deepconv_coef = 1. - ( cfcon(i,k) - cfcon_old(i,k) ) / ( 1. - cfcon_old(i,k) )
     789                cldfra_in(i) = cldfra_in(i) * deepconv_coef
     790                qvc_in(i)    = qvc_in(i)    * deepconv_coef
     791                qice_in(i)   = qice_in(i)   * deepconv_coef
     792                IF ( ok_plane_contrail ) THEN
     793                  !--If contrails are activated, their fraction is also reduced when deep
     794                  !--convection is active
     795                  cfl_seri(i,k) = cfl_seri(i,k) * deepconv_coef
     796                  qtl_seri(i,k) = qtl_seri(i,k) * deepconv_coef
     797                  cfc_seri(i,k) = cfc_seri(i,k) * deepconv_coef
     798                  qtc_seri(i,k) = qtc_seri(i,k) * deepconv_coef
     799                ENDIF
     800              ENDIF
     801
     802              !--Calculate the shear value (input for condensation and ice supersat)
     803              !--Cell thickness [m]
     804              delta_z = ( paprs(i,k) - paprs(i,k+1) ) / RG / pplay(i,k) * zt(i) * RD
     805              IF ( iftop ) THEN
     806                ! top
     807                shear(i) = SQRT( ( (u_seri(i,k) - u_seri(i,k-1)) / delta_z )**2. &
     808                               + ( (v_seri(i,k) - v_seri(i,k-1)) / delta_z )**2. )
     809              ELSEIF ( k .EQ. 1 ) THEN
     810                ! surface
     811                shear(i) = SQRT( ( (u_seri(i,k+1) - u_seri(i,k)) / delta_z )**2. &
     812                               + ( (v_seri(i,k+1) - v_seri(i,k)) / delta_z )**2. )
     813              ELSE
     814                ! other layers
     815                shear(i) = SQRT( ( ( (u_seri(i,k+1) + u_seri(i,k)) / 2. &
     816                                   - (u_seri(i,k) + u_seri(i,k-1)) / 2. ) / delta_z )**2. &
     817                               + ( ( (v_seri(i,k+1) + v_seri(i,k)) / 2. &
     818                                   - (v_seri(i,k) + v_seri(i,k-1)) / 2. ) / delta_z )**2. )
     819              ENDIF
     820            ENDIF
     821          ENDDO
     822        ENDIF
     823
     824
    650825        DT(:) = 0.
    651826        n_i(:)=0
    … …  
    653828        qlibef(:)=0.
    654829        Tbefth(:)=tla(:,k)*pspsk(:,k)
    655         zqth=qta(:,k)
     830        IF (k .GT. 1) THEN
     831         Tbefthm1(:)=tla(:,k-1)*pspsk(:,k-1)
     832        ELSE
     833         Tbefthm1(:)=Tbefth(:)       
     834        ENDIF
     835        zqth(:)=qta(:,k)
     836        zdeltaz(:)=(paprs(:,k)-paprs(:,k+1))/RG/zp(:)*RD*zt(:)
    656837
    657838        ! Treatment of stratiform clouds (lognormale or ice-sursat) or all clouds (including cloudth
    … …  
    732913                  IF (ok_ice_supersat) THEN
    733914
    734                     !--Calculate the shear value (input for condensation and ice supersat)
    735                     DO i = 1, klon
    736                       !--Cell thickness [m]
    737                       delta_z = ( paprs(i,k) - paprs(i,k+1) ) / RG / pplay(i,k) * Tbef(i) * RD
    738                       IF ( iftop ) THEN
    739                         shear(i) = SQRT( ( (u_seri(i,k) - u_seri(i,k-1)) / delta_z )**2. &
    740                                        + ( (v_seri(i,k) - v_seri(i,k-1)) / delta_z )**2. )
    741                       ELSEIF ( k .EQ. 1 ) THEN
    742                         ! surface
    743                         shear(i) = SQRT( ( (u_seri(i,k+1) - u_seri(i,k)) / delta_z )**2. &
    744                                        + ( (v_seri(i,k+1) - v_seri(i,k)) / delta_z )**2. )
    745                       ELSE
    746                         ! other layers
    747                         shear(i) = SQRT( ( ( (u_seri(i,k+1) + u_seri(i,k)) / 2. &
    748                                            - (u_seri(i,k) + u_seri(i,k-1)) / 2. ) / delta_z )**2. &
    749                                        + ( ( (v_seri(i,k+1) + v_seri(i,k)) / 2. &
    750                                            - (v_seri(i,k) + v_seri(i,k-1)) / 2. ) / delta_z )**2. )
    751                       ENDIF
    752                     ENDDO
    753 
    754915                    !---------------------------------------------
    755916                    !--   CONDENSATION AND ICE SUPERSATURATION  --
    … …  
    757918
    758919                    CALL condensation_ice_supersat( &
    759                         klon, dtime, missing_val, &
    760                         zp, paprs(:,k), paprs(:,k+1), &
    761                         cf_seri(:,k), rvc_seri(:,k), ql_seri(:,k), qi_seri(:,k), &
    762                         shear, tke_dissip(:,k), cell_area, &
    763                         Tbef, zq, zqs, gammasat, ratqs(:,k), keepgoing, &
     920                        klon, dtime, pplay(:,k), paprs(:,k), paprs(:,k+1), &
     921                        totfra_in, cldfra_in, qvc_in, qliq_in, qice_in, &
     922                        shear, tke_dissip(:,k), cell_area, Tbef, qtot_in, zqs, &
     923                        gammasat, ratqs(:,k), keepgoing, pt_pron_clds, &
     924                        dzsed_abv, flsed_abv, cfsed_abv, &
     925                        dzsed_lincont_abv, flsed_lincont_abv, cfsed_lincont_abv, &
     926                        dzsed_circont_abv, flsed_circont_abv, cfsed_circont_abv, &
     927                        dzsed, flsed, cfsed, dzsed_lincont, flsed_lincont, cfsed_lincont, &
     928                        dzsed_circont, flsed_circont, cfsed_circont, &
    764929                        rneb(:,k), zqn, qvc, issrfra(:,k), qissr(:,k), &
    765                         dcf_sub(:,k), dcf_con(:,k), dcf_mix(:,k), &
    766                         dqi_adj(:,k), dqi_sub(:,k), dqi_con(:,k), dqi_mix(:,k), &
    767                         dqvc_adj(:,k), dqvc_sub(:,k), dqvc_con(:,k), dqvc_mix(:,k), &
    768                         Tcontr(:,k), qcontr(:,k), qcontr2(:,k), fcontrN(:,k), fcontrP(:,k), &
     930                        dcf_sub(:,k), dcf_con(:,k), dcf_mix(:,k), dcfsed(:,k), &
     931                        dqi_adj(:,k), dqi_sub(:,k), dqi_con(:,k), dqi_mix(:,k), dqised(:,k), &
     932                        dqvc_adj(:,k), dqvc_sub(:,k), dqvc_con(:,k), dqvc_mix(:,k), dqvcsed(:,k), &
     933                        cfl_seri(:,k), cfc_seri(:,k), qtl_seri(:,k), qtc_seri(:,k), &
    769934                        flight_dist(:,k), flight_h2o(:,k), &
    770                         dcf_avi(:,k), dqi_avi(:,k), dqvc_avi(:,k))
    771 
     935                        lincontfra, circontfra, qlincont, qcircont, &
     936                        Tcritcont(:,k), qcritcont(:,k), potcontfraP(:,k), potcontfraNP(:,k), &
     937                        dcfl_ini(:,k), dqil_ini(:,k), dqtl_ini(:,k), &
     938                        dcfl_sub(:,k), dqil_sub(:,k), dqtl_sub(:,k), &
     939                        dcfl_cir(:,k), dqtl_cir(:,k), &
     940                        dcfl_mix(:,k), dqil_mix(:,k), dqtl_mix(:,k), &
     941                        dcfc_sub(:,k), dqic_sub(:,k), dqtc_sub(:,k), &
     942                        dcfc_mix(:,k), dqic_mix(:,k), dqtc_mix(:,k))
     943
     944                    IF ( ok_nodeep_lscp ) THEN
     945                      DO i = 1, klon
     946                        !--If prognostic clouds are activated, deep convection vapor is
     947                        !--re-added to the total water vapor
     948                        IF ( keepgoing(i) .AND. ptconv(i,k) .AND. pt_pron_clds(i) ) THEN
     949                          IF ( ( rneb(i,k) + cfcon(i,k) ) .GT. eps ) THEN
     950                            zqn(i) = ( zqn(i) * rneb(i,k) &
     951                                + ( qccon(i,k) + qvcon(i,k) ) * cfcon(i,k) ) &
     952                                / ( rneb(i,k) + cfcon(i,k) )
     953                          ELSE
     954                            zqn(i) = 0.
     955                          ENDIF
     956                          rneb(i,k) = rneb(i,k) + cfcon(i,k)
     957                          qvc(i) = qvc(i) + qvcon(i,k) * cfcon(i,k)
     958                        ENDIF
     959                      ENDDO
     960                    ENDIF
    772961
    773962                  ELSE
    … …  
    8171006                        invtau_e(i) = 0.
    8181007                     ENDDO
    819                      CALL icefrac_lscp_turb(klon, dtime, pticefracturb, Tbef, zp, paprs(:,k), paprs(:,k+1), wls(:,k), zqi_ini, ziflcld, qincloud, &
    820                      zcf, tke(:,k), tke_dissip(:,k), sursat_e, invtau_e, zqliq, zqvapcl, zqice, zficeenv, dzficeenv,                   &
    821                      cldfraliq(:,k),sigma2_icefracturb(:,k),mean_icefracturb(:,k))                     
     1008                     CALL icefrac_lscp_turb(klon, dtime, pticefracturb, Tbef, zp, paprs(:,k), paprs(:,k+1), wls(:,k), qice_in,    &
     1009                     ziflcld, znebprecipcld, qincloud, zcf, tke(:,k), tke_dissip(:,k), sursat_e, invtau_e, zqliq, zqvapcl, zqice, &
     1010                     zficeenv, dzficeenv, cldfraliq(:,k),sigma2_icefracturb(:,k),mean_icefracturb(:,k))                     
    8221011                     DO i=1,klon
    8231012                        IF (pticefracturb(i)) THEN
    … …  
    8371026                     DO i=1,klon
    8381027                        IF (fraca(i,k) .GT. min_frac_th_cld) THEN
    839                            zcf(i)=MIN(MAX(rnebth(i,k),0.), 1.)*fraca(i,k)
    840                            qincloud(i)=zqn(i)/fraca(i,k)
     1028                           zcf(i)=MIN(MAX(rnebth(i,k),0.), 1.)/fraca(i,k)
     1029                           qincloud(i)=zqn(i)*fraca(i,k)
    8411030                        ELSE
    8421031                           zcf(i) = 0.
    … …  
    8441033                        ENDIF
    8451034                        sursat_e(i)=cloudth_senv(i,k)/zqsi(i)
    846                         invtau_e(i)=gamma_mixth*MAX(entr_therm(i,k)-detr_therm(i,k),0.)*RD*Tbef(i)/zp(i)
     1035                        invtau_e(i)=gamma_mixth*MAX(entr_therm(i,k)-detr_therm(i,k),0.)*RD*Tbef(i)/zp(i)/zdeltaz(i)
    8471036                     ENDDO
    848                      CALL icefrac_lscp_turb(klon, dtime, pticefracturb, Tbefth, zp, paprs(:,k), paprs(:,k+1), wth(:,k), zqi_ini, zeroklon, qincloud, &
    849                      zcf, zeroklon, zeroklon, sursat_e, invtau_e, zqliqth, zqvapclth, zqiceth, zficeth, dzficeth,                      &
    850                      cldfraliqth(:,k), sigma2_icefracturbth(:,k), mean_icefracturbth(:,k))
     1037                     CALL icefrac_lscp_turb(klon, dtime, pticefracturb, Tbefth, zp, paprs(:,k), paprs(:,k+1), wth(:,k), qice_in, &
     1038                     zeroklon, znebprecipcld, qincloud, zcf, zeroklon, zeroklon, sursat_e, invtau_e, zqliqth, zqvapclth, zqiceth, &
     1039                     zficeth, dzficeth,cldfraliqth(:,k), sigma2_icefracturbth(:,k), mean_icefracturbth(:,k))
    8511040                     !Environment
    8521041                     DO i=1,klon
    853                         qincloud(i)=zqn(i)/(1.-fraca(i,k))
    854                         zcf(i)=MIN(MAX(rneb(i,k)-rnebth(i,k), 0.),1.)*(1.-fraca(i,k))
    855                         sursat_e(i)=cloudth_sth(i,k)/zqsith(i)
    856                         invtau_e(i)=gamma_mixth*MAX(detr_therm(i,k)-entr_therm(i,k),0.)*RD*Tbef(i)/zp(i)
     1042                        qincloud(i)=zqn(i)*(1.-fraca(i,k))
     1043                        zcf(i)=MIN(MAX(rneb(i,k)-rnebth(i,k), 0.),1.)/(1.-fraca(i,k))
     1044                        IF (k .GT. 1) THEN
     1045                           ! evaluate the mixing sursaturation using saturation deficit at level below
     1046                           ! as air pacels detraining into clouds have not (less) seen yet entrainement from above
     1047                           sursat_e(i)=cloudth_sth(i,k-1)/(zqsith(i)+zdqsith(i)*RCPD/RLSTT*(Tbefthm1(i)-Tbefth(i)))
     1048                           ! mixing is assumed to scales with intensity of net detrainment/entrainment rate (D/dz-E/dz) / rho
     1049                           invtau_e(i)=gamma_mixth*MAX(detr_therm(i,k)-entr_therm(i,k),0.)*RD*Tbef(i)/zp(i)/zdeltaz(i)
     1050                        ELSE
     1051                           sursat_e(i)=0.
     1052                           invtau_e(i)=0.
     1053                        ENDIF
    8571054                     ENDDO
    858                      CALL icefrac_lscp_turb(klon, dtime, pticefracturb, Tbef, zp, paprs(:,k), paprs(:,k+1), wls(:,k), zqi_ini, ziflcld, qincloud, &
    859                      zcf, tke(:,k), tke_dissip(:,k), sursat_e, invtau_e, zqliq, zqvapcl, zqice, zfice, dzfice,                      &
    860                      cldfraliq(:,k),sigma2_icefracturb(:,k), mean_icefracturb(:,k))
     1055                     CALL icefrac_lscp_turb(klon, dtime, pticefracturb, Tbef, zp, paprs(:,k), paprs(:,k+1), wls(:,k), qice_in,    &
     1056                     ziflcld, znebprecipcld, qincloud, zcf, tke(:,k), tke_dissip(:,k), sursat_e, invtau_e, zqliq, zqvapcl, zqice, &
     1057                     zfice, dzfice, cldfraliq(:,k),sigma2_icefracturb(:,k), mean_icefracturb(:,k))
    8611058 
    8621059                    ! adjust zfice to account for condensates in thermals'fraction
    … …  
    8991096                        ELSE
    9001097                          qlibef(i)=max(0.,zqn(i)-zqs(i))
     1098                        ENDIF
     1099
     1100                        IF ( ok_ice_sedim ) THEN
     1101                          qice_sedim = flsed(i) / ( paprs(i,k) - paprs(i,k+1) ) * RG * dtime
     1102                          ! Add the ice that was sedimented, as it is not included in zqn
     1103                          qlibef(i) = qlibef(i) + qice_sedim
    9011104                        ENDIF
    9021105
    … …  
    9751178                zq(i) = zq(i) - zcond(i)
    9761179
     1180                IF ( ok_ice_sedim ) THEN
     1181                  qice_sedim = flsed(i) / ( paprs(i,k) - paprs(i,k+1) ) * RG * dtime
     1182                  ! Remove the ice that was sedimented. As it is not included in zqn,
     1183                  ! we only remove it from the total water
     1184                  zq(i) = zq(i) - qice_sedim
     1185                  ! Temperature update due to phase change (sedimented ice was condensed)
     1186                  zt(i) = zt(i) + qice_sedim &
     1187                        * RLSTT / RCPD / ( 1. + RVTMP2 * ( zq(i) + zmqc(i) + zcond(i) ) )
     1188                ENDIF
    9771189                       
    9781190                ! temperature update due to phase change
    … …  
    9981210    ENDDO
    9991211
     1212    IF (ok_plane_contrail) THEN
     1213
     1214      !--Ice water content of contrails
     1215      qice_lincont(:,k) = qlincont(:) - zqs(:) * lincontfra(:)
     1216      qice_circont(:,k) = qcircont(:) - zqs(:) * circontfra(:)
     1217
     1218      !--Contrails precipitate as natural clouds. We save the partition of ice
     1219      !--between natural clouds and contrails
     1220      !--NB. we use qlincont / qcircont as a temporary variable to save this partition
     1221      IF ( ok_precip_contrails ) THEN
     1222        DO i = 1, klon
     1223          IF ( zoliqi(i) .GT. 0. ) THEN
     1224            qlincont(i) = qice_lincont(i,k) / zoliqi(i)
     1225            qcircont(i) = qice_circont(i,k) / zoliqi(i)
     1226          ELSE
     1227            qlincont(i) = 0.
     1228            qcircont(i) = 0.
     1229          ENDIF
     1230        ENDDO
     1231      ELSE
     1232        !--If linear contrails do not precipitate, they are removed temporarily from
     1233        !--the cloud variables
     1234        DO i = 1, klon
     1235          qice_cont = qice_lincont(i,k) + qice_circont(i,k)
     1236          rneb(i,k) = rneb(i,k) - ( lincontfra(i) + circontfra(i) )
     1237          zoliq(i) = zoliq(i) - qice_cont
     1238          zoliqi(i) = zoliqi(i) - qice_cont
     1239        ENDDO
     1240      ENDIF
     1241    ENDIF
     1242
    10001243    !================================================================
    10011244    ! Flag for the new and more microphysical treatment of precipitation from Atelier Nuage (R)
    … …  
    10051248                            ctot_vol(:,k), ptconv(:,k), &
    10061249                            zt, zq, zoliql, zoliqi, zfice, &
    1007                             rneb(:,k), znebprecipclr, znebprecipcld, &
     1250                            rneb(:,k), flsed, znebprecipclr, znebprecipcld, &
    10081251                            zrfl, zrflclr, zrflcld, &
    10091252                            zifl, ziflclr, ziflcld, &
    … …  
    10111254                            dqrcol(:,k), dqrmelt(:,k), dqrfreez(:,k), &
    10121255                            dqsauto(:,k), dqsagg(:,k), dqsrim(:,k), &
    1013                             dqsmelt(:,k), dqsfreez(:,k) &
     1256                            dqsmelt(:,k), dqsfreez(:,k), dqised(:,k) &
    10141257                            )
    10151258      DO i = 1, klon
    … …  
    10211264
    10221265      CALL histprecip_postcld(klon, dtime, iftop, paprs(:,k), paprs(:,k+1), zp, &
    1023                             ctot_vol(:,k), ptconv(:,k), zdqsdT_raw, &
    1024                             zt, zq, zoliq, zoliql, zoliqi, zcond, zfice, zmqc, &
     1266                            ctot_vol(:,k), ptconv(:,k), pt_pron_clds, zdqsdT_raw, &
     1267                            zt, zq, zoliq, zoliql, zoliqi, zcond, zfice, zmqc, flsed, &
    10251268                            rneb(:,k), znebprecipclr, znebprecipcld, &
    10261269                            zneb, tot_zneb, zrho_up, zvelo_up, &
    10271270                            zrfl, zrflclr, zrflcld, zifl, ziflclr, ziflcld, &
    1028                             zradocond, zradoice, dqrauto(:,k), dqsauto(:,k) &
     1271                            zradocond, zradoice, dqrauto(:,k), dqsauto(:,k), dqised(:,k) &
    10291272                            )
    10301273
    10311274    ENDIF ! ok_poprecip
     1275
     1276    IF ( ok_plane_contrail ) THEN
     1277      !--Contrails fraction is left unchanged, but contrails water has changed
     1278      !--We alse compute the ice content that will be seen by radiation
     1279      !--(qradice_lincont/circont)
     1280      IF ( ok_precip_contrails ) THEN
     1281        DO i = 1, klon
     1282          IF ( zoliqi(i) .GT. 0. ) THEN
     1283            qradice_lincont(i,k) = zradocond(i) * qlincont(i)
     1284            qlincont(i) = zqs(i) * lincontfra(i) + zoliqi(i) * qlincont(i)
     1285            qradice_circont(i,k) = zradocond(i) * qcircont(i)
     1286            qcircont(i) = zqs(i) * circontfra(i) + zoliqi(i) * qcircont(i)
     1287          ELSE
     1288            qradice_lincont(i,k) = 0.
     1289            lincontfra(i) = 0.
     1290            qlincont(i) = 0.
     1291            qradice_circont(i,k) = 0.
     1292            circontfra(i) = 0.
     1293            qcircont(i) = 0.
     1294          ENDIF
     1295        ENDDO
     1296      ELSE
     1297        !--If contrails do not precipitate, they are put back into
     1298        !--the cloud variables
     1299        DO i = 1, klon
     1300          rneb(i,k) = rneb(i,k) + ( lincontfra(i) + circontfra(i) )
     1301          qice_cont = qice_lincont(i,k) + qice_circont(i,k)
     1302          zoliq(i) = zoliq(i) + qice_cont
     1303          zoliqi(i) = zoliqi(i) + qice_cont
     1304          zradocond(i) = zradocond(i) + qice_cont
     1305          zradoice(i) = zradoice(i) + qice_cont
     1306          qradice_lincont(i,k) = qice_lincont(i,k)
     1307          qradice_circont(i,k) = qice_circont(i,k)
     1308        ENDDO
     1309      ENDIF
     1310    ENDIF
    10321311
    10331312    ! End of precipitation processes after cloud formation
    … …  
    11191398    ! P6 > write diagnostics and outputs
    11201399    !------------------------------------------------------------
     1400
     1401    CALL calc_qsat_ecmwf(klon,zt,zeroklon,zp,RTT,1,.false.,qsatl(:,k),zdqs)
     1402    CALL calc_qsat_ecmwf(klon,zt,zeroklon,zp,RTT,2,.false.,qsati(:,k),zdqs)
    11211403   
    11221404    !--AB Write diagnostics and tracers for ice supersaturation
     1405    IF ( ok_plane_contrail ) THEN
     1406      DO i = 1, klon
     1407        IF ( zoliq(i) .LE. 0. ) THEN
     1408          lincontfra(i) = 0.
     1409          circontfra(i) = 0.
     1410          qlincont(i) = 0.
     1411          qcircont(i) = 0.
     1412        ENDIF
     1413      ENDDO
     1414      cfl_seri(:,k) = lincontfra(:)
     1415      cfc_seri(:,k) = circontfra(:)
     1416      qtl_seri(:,k) = qlincont(:)
     1417      qtc_seri(:,k) = qcircont(:)
     1418    ENDIF
     1419
    11231420    IF ( ok_ice_supersat ) THEN
    1124       CALL calc_qsat_ecmwf(klon,zt,zeroklon,zp,RTT,1,.false.,qsatl(:,k),zdqs)
    1125       CALL calc_qsat_ecmwf(klon,zt,zeroklon,zp,RTT,2,.false.,qsati(:,k),zdqs)
    11261421
    11271422      DO i = 1, klon
    11281423
     1424        !--We save the cloud properties that will be advected
     1425        cf_seri(i,k) = rneb(i,k)
     1426        qvc_seri(i,k) = qvc(i)
     1427
     1428        !--We keep convective clouds properties in memory, and account for
     1429        !--the sink of condensed water from precipitation
     1430        IF ( ptconv(i,k) ) THEN
     1431          IF ( zoliq(i) .GT. 0. ) THEN
     1432            qvcon_old(i,k) = qvcon(i,k)
     1433            qccon_old(i,k) = qccon(i,k) * zoliq(i) / zcond(i)
     1434          ELSE
     1435            qvcon_old(i,k) = 0.
     1436            qccon_old(i,k) = 0.
     1437          ENDIF
     1438        ELSE
     1439          qvcon_old(i,k) = 0.
     1440          qccon_old(i,k) = 0.
     1441        ENDIF
     1442
     1443        !--Deep convection clouds properties are not advected
     1444        IF ( ptconv(i,k) .AND. pt_pron_clds(i) .AND. ok_nodeep_lscp ) THEN
     1445          cf_seri(i,k) = MAX(0., cf_seri(i,k) - cfcon(i,k))
     1446          qvc_seri(i,k) = MAX(0., qvc_seri(i,k) - qvcon_old(i,k) * cfcon(i,k))
     1447          zoliq(i) = MAX(0., zoliq(i) - qccon_old(i,k) * cfcon(i,k))
     1448          zoliqi(i) = MAX(0., zoliqi(i) - qccon_old(i,k) * cfcon(i,k))
     1449        ENDIF
     1450        !--Deep convection clouds properties are removed from radiative properties
     1451        !--outputed from lscp (NB. rneb and radocond are only used for the radiative
     1452        !--properties and are NOT prognostics)
     1453        !--We must have iflag_coupl == 5 for this coupling to work
     1454        IF ( ptconv(i,k) .AND. pt_pron_clds(i) .AND. ok_nodeep_lscp_rad ) THEN
     1455          rneb(i,k) = MAX(0., rneb(i,k) - cfcon(i,k))
     1456          radocond(i,k) = MAX(0., radocond(i,k) - qccon_old(i,k) * cfcon(i,k))
     1457        ENDIF
     1458
     1459        !--If everything was precipitated, the remaining empty cloud is dissipated
     1460        !--and everything is transfered to the subsaturated clear sky region
     1461        !--NB. we do not change rneb, as it is a diagnostic only
    11291462        IF ( zoliq(i) .LE. 0. ) THEN
    1130           !--If everything was precipitated, the remaining empty cloud is dissipated
    1131           !--and everything is transfered to the subsaturated clear sky region
    1132           rneb(i,k) = 0.
     1463          cf_seri(i,k) = 0.
     1464          qvc_seri(i,k) = 0.
    11331465          qvc(i) = 0.
    11341466        ENDIF
    1135 
    1136         cf_seri(i,k) = rneb(i,k)
    1137 
    1138         IF ( .NOT. ok_unadjusted_clouds ) THEN
    1139           qvc(i) = zqs(i) * rneb(i,k)
    1140         ENDIF
    1141         IF ( zq(i) .GT. min_qParent ) THEN
    1142           rvc_seri(i,k) = qvc(i) / zq(i)
    1143         ELSE
    1144           rvc_seri(i,k) = min_ratio
    1145         ENDIF
    1146         !--The MIN barrier is NEEDED because of:
    1147         !-- 1) very rare pathological cases of the lsc scheme (rvc = 1. + 1e-16 sometimes)
    1148         !-- 2) the thermal scheme does NOT guarantee that qvc <= qvap (or even qincld <= qtot)
    1149         !--The MAX barrier is a safeguard that should not be activated
    1150         rvc_seri(i,k) = MIN(MAX(rvc_seri(i,k), 0.), 1.)
    11511467
    11521468        !--Diagnostics
    … …  
    11551471        qsub(i,k) = zq(i) - qvc(i) - qissr(i,k)
    11561472        qcld(i,k) = qvc(i) + zoliq(i)
     1473
     1474        !--Calculation of the ice supersaturated fraction following Lamquin et al (2012)
     1475        !--methodology: in each layer, we make a maximum random overlap assumption for
     1476        !--ice supersaturation
     1477        IF ( ( paprs(i,k) .GT. 10000. ) .AND. ( paprs(i,k) .LE. 15000. ) ) THEN
     1478                IF ( issrfra100to150UP(i) .GT. ( 1. - eps ) ) THEN
     1479                        issrfra100to150(i) = 1.
     1480                ELSE
     1481                        issrfra100to150(i) = 1. - ( 1. - issrfra100to150(i) ) * &
     1482                                ( 1. - MAX( issrfra(i,k), issrfra100to150UP(i) ) ) &
     1483                              / ( 1. - issrfra100to150UP(i) )
     1484                        issrfra100to150UP(i) = issrfra(i,k)
     1485                ENDIF
     1486        ELSEIF ( ( paprs(i,k) .GT. 15000. ) .AND. ( paprs(i,k) .LE. 20000. ) ) THEN
     1487                IF ( issrfra150to200UP(i) .GT. ( 1. - eps ) ) THEN
     1488                        issrfra150to200(i) = 1.
     1489                ELSE
     1490                        issrfra150to200(i) = 1. - ( 1. - issrfra150to200(i) ) * &
     1491                                ( 1. - MAX( issrfra(i,k), issrfra150to200UP(i) ) ) &
     1492                              / ( 1. - issrfra150to200UP(i) )
     1493                        issrfra150to200UP(i) = issrfra(i,k)
     1494                ENDIF
     1495        ELSEIF ( ( paprs(i,k) .GT. 20000. ) .AND. ( paprs(i,k) .LE. 25000. ) ) THEN
     1496                IF ( issrfra200to250UP(i) .GT. ( 1. - eps ) ) THEN
     1497                        issrfra200to250(i) = 1.
     1498                ELSE
     1499                        issrfra200to250(i) = 1. - ( 1. - issrfra200to250(i) ) * &
     1500                                ( 1. - MAX( issrfra(i,k), issrfra200to250UP(i) ) ) &
     1501                              / ( 1. - issrfra200to250UP(i) )
     1502                        issrfra200to250UP(i) = issrfra(i,k)
     1503                ENDIF
     1504        ELSEIF ( ( paprs(i,k) .GT. 25000. ) .AND. ( paprs(i,k) .LE. 30000. ) ) THEN
     1505                IF ( issrfra250to300UP(i) .GT. ( 1. - eps ) ) THEN
     1506                        issrfra250to300(i) = 1.
     1507                ELSE
     1508                        issrfra250to300(i) = 1. - ( 1. - issrfra250to300(i) ) * &
     1509                                ( 1. - MAX( issrfra(i,k), issrfra250to300UP(i) ) ) &
     1510                              / ( 1. - issrfra250to300UP(i) )
     1511                        issrfra250to300UP(i) = issrfra(i,k)
     1512                ENDIF
     1513        ELSEIF ( ( paprs(i,k) .GT. 30000. ) .AND. ( paprs(i,k) .LE. 40000. ) ) THEN
     1514                IF ( issrfra300to400UP(i) .GT. ( 1. - eps ) ) THEN
     1515                        issrfra300to400(i) = 1.
     1516                ELSE
     1517                        issrfra300to400(i) = 1. - ( 1. - issrfra300to400(i) ) * &
     1518                                ( 1. - MAX( issrfra(i,k), issrfra300to400UP(i) ) ) &
     1519                              / ( 1. - issrfra300to400UP(i) )
     1520                        issrfra300to400UP(i) = issrfra(i,k)
     1521                ENDIF
     1522        ELSEIF ( ( paprs(i,k) .GT. 40000. ) .AND. ( paprs(i,k) .LE. 50000. ) ) THEN
     1523                IF ( issrfra400to500UP(i) .GT. ( 1. - eps ) ) THEN
     1524                        issrfra400to500(i) = 1.
     1525                ELSE
     1526                        issrfra400to500(i) = 1. - ( 1. - issrfra400to500(i) ) * &
     1527                                ( 1. - MAX( issrfra(i,k), issrfra400to500UP(i) ) ) &
     1528                              / ( 1. - issrfra400to500UP(i) )
     1529                        issrfra400to500UP(i) = issrfra(i,k)
     1530                ENDIF
     1531        ENDIF
     1532
    11571533      ENDDO
    11581534    ENDIF
    … …  
    11941570  ENDDO
    11951571
     1572  IF ( ok_ice_sedim ) THEN
     1573    DO i = 1, klon
     1574      snow(i) = snow(i) + flsed(i)
     1575    ENDDO
     1576  ENDIF
     1577
    11961578  IF (ncoreczq>0) THEN
    11971579      WRITE(lunout,*)'WARNING : ZQ in LSCP ',ncoreczq,' val < 1.e-15.'

  • LMDZ6/branches/contrails/libf/phylmd/lmdz_lscp_old.f90

    r5618 r5717  
    7070  USE yomcst_mod_h
    7171  USE icefrac_lsc_mod ! compute ice fraction (JBM 3/14)
    72   USE lmdz_cloudth, only : cloudth, cloudth_v3, cloudth_v6
     72  USE lmdz_lscp_condensation, only : cloudth, cloudth_v3, cloudth_v6
    7373
    7474  USE lmdz_lscp_ini, ONLY: prt_level, lunout

  • LMDZ6/branches/contrails/libf/phylmd/lmdz_lscp_precip.f90

    r5691 r5717  
    361361REAL,    INTENT(IN)                     :: dtime          !--time step [s]
    362362LOGICAL, INTENT(IN)                     :: iftop          !--if top of the column
     363
    363364
    364365REAL,    INTENT(IN),    DIMENSION(klon) :: paprsdn        !--pressure at the bottom interface of the layer [Pa]
    … …  
    660661    ! Computation of DT if all the liquid precip freezes
    661662    DeltaT = RLMLT*zqprecl(i) / (zcp*(1.+coef1))
     663   
     664
    662665    ! T should not exceed the freezing point
    663666    ! that is Delta > RTT-zt(i)
    … …  
    982985DO i = 1, klon
    983986
    984   dqrevap = 0.
    985   dqssubl = 0.
     987  dqrevap   = 0.
     988  dqssubl   = 0.
    986989  !--If there is precipitation from the layer above
    987990  IF ( ( rain(i) + snow(i) ) .GT. 0. ) THEN
    … …  
    10211024      ENDIF
    10221025      IF (  precipfraccld(i)  .GT. eps ) THEN
    1023         qvapcld = MAX(qtotupnew(i)-qvapclrup(i) , 0.) / qtotupnew(i) * qvap(i) /  precipfraccld(i)
     1026        qvapcld = MAX(qtotupnew(i)-qvapclrup(i) , 0.) / qtotupnew(i) * qvap(i) /  precipfraccld(i) 
    10241027      ELSE
    10251028        qvapcld = 0.
    … …  
    10711074      !--NB. with ok_ice_supersat activated, this barrier should be useless
    10721075      drainclreva = MIN(0., drainclreva)
    1073 
     1076     
     1077      ! we set it to 0 as not sufficiently tested
     1078      drainclreva = 0.
    10741079
    10751080      !--Sublimation of the solid precipitation coming from above
    … …  
    11181123
    11191124    ELSE
    1120       !--All the precipitation is sublimated if the fraction is zero
    1121       drainclreva = - rainclr_tmp(i)
    1122       dsnowclrsub = - snowclr_tmp(i)
     1125           
     1126    !--All the precipitation is sublimated if the fraction is zero
     1127       drainclreva = - rainclr_tmp(i)
     1128       dsnowclrsub = - snowclr_tmp(i)
    11231129
    11241130    ENDIF ! precipfracclr_tmp .GT. eps
    … …  
    11361142      !--Exact explicit formulation (raincld is resolved exactly, qvap explicitly)
    11371143      !--which does not need a barrier on raincld, because included in the formula
     1144     
    11381145      draincldeva = precipfraccld_tmp(i) * MAX(0., &
    11391146                  - coef_eva * ( 1. - expo_eva ) * (1. - qvapcld / qsatl(i)) * dz(i) &
    11401147                  + ( raincld_tmp(i) / precipfraccld_tmp(i) )**( 1. - expo_eva ) &
    11411148                  )**( 1. / ( 1. - expo_eva ) ) - raincld_tmp(i)
    1142                
     1149
    11431150      !--Evaporation is limited by 0
    11441151      !--NB. with ok_ice_supersat activated, this barrier should be useless
    … …  
    14121419
    14131420USE lmdz_lscp_ini, ONLY : cld_lc_con, cld_tau_con, cld_expo_con, seuil_neb,    &
    1414                           cld_lc_lsc, cld_tau_lsc, cld_expo_lsc, rain_int_min, &
     1421                          cld_lc_lsc, cld_tau_lsc, cld_expo_lsc,               &
    14151422                          thresh_precip_frac, gamma_col, gamma_agg, gamma_rim, &
    14161423                          rho_rain, r_rain, r_snow, rho_ice,                   &
     1424                          expo_tau_auto_snow,                                  &
    14171425                          tau_auto_snow_min, tau_auto_snow_max,                &
    1418                           expo_tau_auto_snow, thresh_precip_frac, eps,         &
     1426                          thresh_precip_frac, eps, rain_int_min,               &
    14191427                          gamma_melt, alpha_freez, beta_freez, temp_nowater,   &
    14201428                          iflag_cloudth_vert, iflag_rain_incloud_vol,          &
    … …  
    14781486REAL, DIMENSION(klon) :: dhum_to_dflux
    14791487REAL, DIMENSION(klon) :: qtot                             !--includes vap, liq, ice and precip
     1488REAL                  :: min_precip                       !--minimum precip flux below which precip fraction decreases
    14801489
    14811490!--Collection, aggregation and riming
    … …  
    16781687               - ( qice(i) / eff_cldfra / qthresh_auto_snow ) ** expo_auto_snow ) ) ) )
    16791688
    1680 
    16811689    !--Barriers so that we don't create more rain/snow
    16821690    !--than there is liquid/ice
    … …  
    16871695    qliq(i) = qliq(i) + dqlauto
    16881696    qice(i) = qice(i) + dqiauto
     1697
    16891698    raincld(i) = raincld(i) - dqlauto * dhum_to_dflux(i)
    16901699    snowcld(i) = snowcld(i) - dqiauto * dhum_to_dflux(i)
    … …  
    18541863  !--second: immersion freezing following (inspired by Bigg 1953)
    18551864  !--the latter is parameterized as an exponential decrease of the rain
    1856   !--water content with a homemade formulya
     1865  !--water content with a homemade formula
    18571866  !--This is based on a caracteritic time of freezing, which
    18581867  !--exponentially depends on temperature so that it is
    … …  
    18611870  !--NB.: this process needs a temperature adjustment
    18621871  !--dqrfreez_max : maximum rain freezing so that temperature
    1863   !--              stays lower than 273 K [kg/kg]
     1872  !--               stays lower than 273 K [kg/kg]
    18641873  !--tau_freez    : caracteristic time of freezing [s]
    18651874  !--gamma_freez  : tuning parameter [s-1]
    … …  
    19421951              * EXP( - alpha_freez * ( temp(i) - temp_nowater ) / ( RTT - temp_nowater ) ) )
    19431952
    1944 
    19451953    !--In clear air
    19461954    IF ( rainclr(i) .GT. 0. ) THEN
    … …  
    19711979    !--Add tendencies
    19721980    !--The MAX is needed because in some cases, the flux can be slightly negative (numerical precision)
     1981   
    19731982    rainclr(i) = MAX(0., rainclr(i) + dqrclrfreez * dhum_to_dflux(i))
    19741983    raincld(i) = MAX(0., raincld(i) + dqrcldfreez * dhum_to_dflux(i))
    … …  
    19771986
    19781987
     1988
    19791989    !--Temperature adjustment with the uptake of latent
    19801990    !--heat because of freezing
     1991
    19811992    temp(i) = temp(i) - dqrtotfreez_step2 * RLMLT / RCPD &
    19821993                      / ( 1. + RVTMP2 * qtot(i) )
    1983 
    19841994    !--Diagnostic tendencies
    19851995    dqrtotfreez = dqrtotfreez_step1 + dqrtotfreez_step2         
    … …  
    20282038
    20292039
    2030   !--If the local flux of rain+snow in clear/cloudy air is lower than rain_int_min,
    2031   !--we reduce the precipiration fraction in the clear/cloudy air so that the new
    2032   !--local flux of rain+snow is equal to rain_int_min.
     2040  !--If the local flux of rain+snow in clear air is lower than min_precip,
     2041  !--we reduce the precipiration fraction in the clear air so that the new
     2042  !--local flux of rain+snow is equal to min_precip.
     2043  !--we apply the minimum only on the clear-sky fraction because the cloudy precip fraction
     2044  !--already decreases out of clouds
    20332045  !--Here, rain+snow is the gridbox-mean flux of precip.
    20342046  !--Therefore, (rain+snow)/precipfrac is the local flux of precip.
    2035   !--If the local flux of precip is lower than rain_int_min, i.e.,
    2036   !-- (rain+snow)/precipfrac < rain_int_min , i.e.,
    2037   !-- (rain+snow)/rain_int_min < precipfrac , then we want to reduce
    2038   !--the precip fraction to the equality, i.e., precipfrac = (rain+snow)/rain_int_min.
     2047  !--If the local flux of precip is lower than min_precip, i.e.,
     2048  !-- (rain+snow)/precipfrac < min_precip , i.e.,
     2049  !-- (rain+snow)/min_precip < precipfrac , then we want to reduce
     2050  !--the precip fraction to the equality, i.e., precipfrac = (rain+snow)/min_precip.
    20392051  !--Note that this is physically different than what is proposed in LTP thesis.
    2040   precipfracclr(i) = MIN( precipfracclr(i), ( rainclr(i) + snowclr(i) ) / rain_int_min )
     2052  !--min_precip is either equal to rain_int_min or calculated as a very small fraction
     2053  !--of the minimum precip flux estimated as the flux associated with the
     2054  !--autoconversion threshold mass content
     2055  !min_precip=1.e-6*(pplay(i)/RD/temp(i))*MIN(rain_fallspeed_clr*cld_lc_lsc,snow_fallspeed_clr*cld_lc_lsc_snow)
     2056  min_precip=rain_int_min
     2057  precipfracclr(i) = MIN( precipfracclr(i), ( rainclr(i) + snowclr(i) ) / min_precip )
    20412058
    20422059  !--Calculate outputs

  • LMDZ6/branches/contrails/libf/phylmd/lmdz_lscp_tools.f90

    r5609 r5717  
    234234        ENDIF
    235235
    236         ! if temperature of cloud top <-40°C,
     236        ! if temperature or temperature of cloud top <-40°C,
    237237        IF (iflag_t_glace .GE. 4) THEN
    238238                IF ((temp_cltop(i) .LE. temp_nowater) .AND. (temp(i) .LE. t_glace_max)) THEN
    … …  
    250250
    251251
    252 SUBROUTINE ICEFRAC_LSCP_TURB(klon, dtime, temp, pplay, paprsdn, paprsup, omega, qice_ini, snowcld, qtot_incl, cldfra, tke,   &
    253                              tke_dissip, qliq, qvap_cld, qice, icefrac, dicefracdT, cldfraliq, sigma2_icefracturb, mean_icefracturb)
     252SUBROUTINE ICEFRAC_LSCP_TURB(klon, dtime, pticefracturb, temp, pplay, paprsdn, paprsup, wvel, qice_ini, snowcld, snowfracld, qtot_incl, cldfra, tke,   &
     253                             tke_dissip, sursat_e, invtau_e, qliq, qvap_cld, qice, icefrac, dicefracdT, cldfraliq, sigma2_icefracturb, mean_icefracturb)
    254254!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    255255  ! Compute the liquid, ice and vapour content (+ice fraction) based
    256256  ! on turbulence (see Fields 2014, Furtado 2016, Raillard 2025)
    257257  ! L.Raillard (23/09/24)
     258  ! E.Vignon (03/2025) : additional elements for treatment of convective
     259  !                      boundary layer clouds
    258260!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    259261
    … …  
    262264   USE lmdz_lscp_ini, ONLY : RCPD, RLSTT, RLVTT, RLMLT, RVTMP2, RTT, RD, RG, RV, RPI
    263265   USE lmdz_lscp_ini, ONLY : seuil_neb, temp_nowater
    264    USE lmdz_lscp_ini, ONLY : naero5, gamma_snwretro, gamma_taud, capa_crystal
    265    USE lmdz_lscp_ini, ONLY : eps
     266   USE lmdz_lscp_ini, ONLY : naero5, gamma_snwretro, gamma_taud, capa_crystal, rho_ice
     267   USE lmdz_lscp_ini, ONLY : eps, snow_fallspeed
    266268
    267269   IMPLICIT NONE
    … …  
    269271   INTEGER,   INTENT(IN)                           :: klon                !--number of horizontal grid points
    270272   REAL,      INTENT(IN)                           :: dtime               !--time step [s]
    271 
     273   LOGICAL,   INTENT(IN),       DIMENSION(klon)    :: pticefracturb       !--grid points concerned by this routine 
    272274   REAL,      INTENT(IN),       DIMENSION(klon)    :: temp                !--temperature
    273275   REAL,      INTENT(IN),       DIMENSION(klon)    :: pplay               !--pressure in the middle of the layer           [Pa]
    274276   REAL,      INTENT(IN),       DIMENSION(klon)    :: paprsdn             !--pressure at the bottom interface of the layer [Pa]
    275277   REAL,      INTENT(IN),       DIMENSION(klon)    :: paprsup             !--pressure at the top interface of the layer    [Pa]
    276    REAL,      INTENT(IN),       DIMENSION(klon)    :: omega               !--resolved vertical velocity                    [Pa/s]
     278   REAL,      INTENT(IN),       DIMENSION(klon)    :: wvel                !--vertical velocity                             [m/s]
    277279   REAL,      INTENT(IN),       DIMENSION(klon)    :: qtot_incl           !--specific total cloud water in-cloud content   [kg/kg]
    278280   REAL,      INTENT(IN),       DIMENSION(klon)    :: cldfra              !--cloud fraction in gridbox                     [-]
    … …  
    281283
    282284   REAL,      INTENT(IN),       DIMENSION(klon)    :: qice_ini            !--initial specific ice content gridbox-mean     [kg/kg]
    283    REAL,      INTENT(IN),       DIMENSION(klon)    :: snowcld
     285   REAL,      INTENT(IN),       DIMENSION(klon)    :: snowcld             !--in-cloud snowfall flux                        [kg/m2/s]
     286   REAL,      INTENT(IN),       DIMENSION(klon)    :: snowfracld          !--cloudy precip fraction                        [-]
     287   REAL,      INTENT(IN),       DIMENSION(klon)    :: sursat_e            !--environment supersaturation                   [-]
     288   REAL,      INTENT(IN),       DIMENSION(klon)    :: invtau_e            !--inverse time-scale of mixing with environment [s-1]
    284289   REAL,      INTENT(OUT),      DIMENSION(klon)    :: qliq                !--specific liquid content gridbox-mean          [kg/kg]
    285290   REAL,      INTENT(OUT),      DIMENSION(klon)    :: qvap_cld            !--specific cloud vapor content, gridbox-mean    [kg/kg]
    286291   REAL,      INTENT(OUT),      DIMENSION(klon)    :: qice                !--specific ice content gridbox-mean             [kg/kg]
    287    REAL,      INTENT(OUT),      DIMENSION(klon)    :: icefrac             !--fraction of ice in condensed water            [-]
    288    REAL,      INTENT(OUT),      DIMENSION(klon)    :: dicefracdT
     292
     293   REAL,      INTENT(INOUT),    DIMENSION(klon)    :: icefrac             !--fraction of ice in condensed water            [-]
     294   REAL,      INTENT(INOUT),    DIMENSION(klon)    :: dicefracdT
    289295
    290296   REAL,      INTENT(OUT),      DIMENSION(klon)    :: cldfraliq           !--fraction of cldfra where liquid               [-]
    … …  
    300306   REAL :: C0                                                             !--Lagrangian structure function                 [-]
    301307   REAL :: tau_dissipturb
    302    REAL :: tau_phaserelax
    303    REAL :: sigma2_pdf, mean_pdf
     308   REAL :: invtau_phaserelax
     309   REAL :: sigma2_pdf
    304310   REAL :: ai, bi, B0
    305311   REAL :: sursat_iceliq
    … …  
    311317   REAL :: N0_PSD, lambda_PSD                                             !--parameters of the exponential PSD
    312318
    313    REAL :: rho_ice                                                        !--ice density                                   [kg/m3]
    314319   REAL :: cldfra1D
    315320   REAL :: rho_air
    316321   REAL :: psati                                                          !--saturation vapor pressure wrt ice             [Pa]
    317    
    318    REAL :: vitw                                                           !--vertical velocity                             [m/s]
     322
    319323                                                                       
     324    REAL :: tempvig1, tempvig2
     325
     326   tempvig1    = -21.06 + RTT
     327   tempvig2    = -30.35 + RTT
    320328   C0            = 10.                                                    !--value assumed in Field2014           
    321    rho_ice       = 950.
    322329   sursat_iceext = -0.1
    323330   qzero(:)      = 0.
    324331   cldfraliq(:)  = 0.
    325    icefrac(:)    = 0.
    326    dicefracdT(:) = 0.
    327 
     332   qliq(:)       = 0.
     333   qice(:)      = 0.
     334   qvap_cld(:)   = 0.
    328335   sigma2_icefracturb(:) = 0.
    329336   mean_icefracturb(:)   = 0.
    … …  
    336343
    337344    DO i=1,klon
    338 
    339345     rho_air  = pplay(i) / temp(i) / RD
    340 
    341346     ! because cldfra is intent in, but can be locally modified due to test
    342347     cldfra1D = cldfra(i)
    343      IF (cldfra(i) .LE. 0.) THEN
    344         qvap_cld(i)   = 0.
    345         qliq(i)       = 0.
    346         qice(i)       = 0.
    347         cldfraliq(i)  = 0.
    348         icefrac(i)    = 0.
    349         dicefracdT(i) = 0.
    350 
    351      ! If there is a cloud
    352      ELSE
     348     ! activate param for concerned grid points and for cloudy conditions
     349     IF ((pticefracturb(i)) .AND. (cldfra(i) .GT. 0.)) THEN
    353350        IF (cldfra(i) .GE. 1.0) THEN
    354351           cldfra1D = 1.0
    … …  
    373370           dicefracdT(i) = 0.
    374371
     372
    375373        !---------------------------------------------------------
    376374        !--             MIXED PHASE TEMPERATURE REGIME         
    … …  
    383381        ELSE
    384382
    385            vitw = -omega(i) / RG / rho_air
    386            qiceini_incl  = qice_ini(i) / cldfra1D + snowcld(i) * RG * dtime / ( paprsdn(i) - paprsup(i) ) / cldfra1D
    387 
    388            !--1. No preexisting ice : if vertical motion, fully liquid
     383           ! gamma_snwretro controls the contribution of snowflakes to the negative feedback
     384           ! note that for reasons related to inetarctions with the condensation iteration in lscp_main
     385           ! we consider here the mean snowflake concentration in the mesh (not the in-cloud concentration)
     386           ! when poprecip is active, it will be worth testing considering the incloud fraction, dividing
     387           ! by snowfracld     
     388           ! qiceini_incl  = qice_ini(i) / cldfra1D + &
     389           !              gamma_snwretro * snowcld(i) * RG * dtime / ( paprsdn(i) - paprsup(i) )
     390           ! assuming constant snowfall velocity
     391           qiceini_incl  = qice_ini(i) / cldfra1D + gamma_snwretro * snowcld(i) / pplay(i) * RD * temp(i) / snow_fallspeed
     392
     393           !--1. No preexisting ice and no mixing with environment: if vertical motion, fully liquid
    389394           !--cloud else fully iced cloud
    390            IF ( qiceini_incl .LT. eps ) THEN
    391               IF ( (vitw .GT. eps) .OR. (tke(i) .GT. eps) ) THEN
     395           IF ( (qiceini_incl .LT. eps) .AND. (invtau_e(i) .LT. eps) ) THEN
     396              IF ( (wvel(i) .GT. eps) .OR. (tke(i) .GT. eps) ) THEN
    392397                 qvap_cld(i)   = qsatl(i) * cldfra1D
    393398                 qliq(i)       = MAX(0.,qtot_incl(i)-qsatl(i)) * cldfra1D
    … …  
    406411           
    407412
    408            !--2. Pre-existing ice :computation of ice properties for
     413           !--2. Pre-existing ice and/or mixing with environment:computation of ice properties for
    409414           !--feedback
    410415           ELSE
    411               ai = RG / RD / temp(i) * ( RD * RLSTT / RCPD / RV / temp(i) - 1. )
    412 
    413               sursat_equ    = ai * vitw * tau_phaserelax
    414416
    415417              sursat_iceliq = qsatl(i)/qsati(i) - 1.
    … …  
    419421              !--are computed following Morrison&Gettelman 2008
    420422              !--Ice number density is assumed equals to INP density
    421               !--which is a function of temperature (DeMott 2010) 
     423              !--which is for naero5>0 a function of temperature (DeMott 2010)   
    422424              !--bi and B0 are microphysical function characterizing
    423425              !--vapor/ice interactions
    … …  
    425427              !--onto ice crystals
    426428
    427               nb_crystals = 1.e3 * 5.94e-5 * ( RTT - temp(i) )**3.33 * naero5**(0.0264*(RTT-temp(i))+0.0033)
    428               lambda_PSD  = ( (RPI*rho_ice*nb_crystals) / (rho_air * qiceini_incl ) ) ** (1./3.)
     429              !--For naero5<=0 INP density is derived from the empirical fit
     430              !--from MARCUS campaign from Vignon 2021
     431              !--/!\ Note that option is very specific and should be use for
     432              !--the Southern Ocean and the Antarctic
     433
     434              IF (naero5 .LE. 0) THEN
     435                 IF ( temp(i) .GT. tempvig1 ) THEN
     436                      nb_crystals = 1.e3 * 10**(-0.14*(temp(i)-tempvig1) - 2.88)
     437                 ELSE IF ( temp(i) .GT. tempvig2 ) THEN
     438                      nb_crystals = 1.e3 * 10**(-0.31*(temp(i)-tempvig1) - 2.88)
     439                 ELSE
     440                      nb_crystals = 1.e3 * 10**(0.)
     441                 ENDIF
     442              ELSE
     443                 nb_crystals = 1.e3 * 5.94e-5 * ( RTT - temp(i) )**3.33 * naero5**(0.0264*(RTT-temp(i))+0.0033)
     444              ENDIF
     445              lambda_PSD  = ( (RPI*rho_ice*nb_crystals) / (rho_air * MAX(qiceini_incl , eps) ) ) ** (1./3.)
    429446              N0_PSD      = nb_crystals * lambda_PSD
    430447              moment1_PSD = N0_PSD/lambda_PSD**2
    … …  
    440457              B0 = 4. * RPI * capa_crystal * 1. / (  RLSTT**2 / air_thermal_conduct / RV / temp(i)**2  &
    441458                                                  +  RV * temp(i) / psati / water_vapor_diff  )
    442               tau_phaserelax = 1. / (bi * B0 * moment1_PSD )
     459              invtau_phaserelax = bi * B0 * moment1_PSD
    443460             
    444461              ai = RG / RD / temp(i) * ( RD * RLSTT / RCPD / RV / temp(i) - 1. )
    445 
    446               !--2A. No TKE : stationnary binary solution depending on omega
     462              sursat_equ    = (ai * wvel(i) + sursat_e(i)*invtau_e(i)) / (invtau_phaserelax + invtau_e(i))
     463              ! as sursaturation is by definition lower than -1 and
     464              ! because local supersaturation > 1 are never found in the atmosphere
     465
     466              !--2A. No TKE : stationnary binary solution depending on vertical velocity and mixing with env.
    447467              ! If Sequ > Siw liquid cloud, else ice cloud
    448468              IF ( tke_dissip(i) .LE. eps )  THEN
     469                 sigma2_icefracturb(i)= 0.
     470                 mean_icefracturb(i)  = sursat_equ
    449471                 IF (sursat_equ .GT. sursat_iceliq) THEN
    450472                    qvap_cld(i)   = qsatl(i) * cldfra1D
    … …  
    483505
    484506                 liqfra_max = MAX(0., (MIN (1.,( qtot_incl(i) - (qice_ini(i) / cldfra1D) - qsati(i) * (1 + sursat_iceext ) ) / ( qsatl(i) - qsati(i) ) ) ) )
    485                  sigma2_pdf = 1./2. * ( ai**2 ) *  2./3. * tke(i) * tau_dissipturb * tau_phaserelax
    486                  
    487                  mean_pdf = ai * vitw * tau_phaserelax
    488                  
    489                  cldfraliq(i) = 0.5 * (1. - erf( ( sursat_iceliq - mean_pdf) / (SQRT(2.* sigma2_pdf) ) ) )
     507                 sigma2_pdf = 1./2. * ( ai**2 ) *  2./3. * tke(i) * tau_dissipturb / (invtau_phaserelax + invtau_e(i))
     508                 ! sursat ranges between -1 and 1, so we prevent sigma2 so exceed 1
     509                 cldfraliq(i) = 0.5 * (1. - erf( ( sursat_iceliq - sursat_equ) / (SQRT(2.* sigma2_pdf) ) ) )
    490510                 IF (cldfraliq(i) .GT. liqfra_max) THEN
    491511                     cldfraliq(i) = liqfra_max
    492512                 ENDIF
    493513                 
    494                  qliq_incl = qsati(i) * SQRT(sigma2_pdf) / SQRT(2.*RPI) * EXP( -1.*(sursat_iceliq - mean_pdf)**2. / (2.*sigma2_pdf) )  &
    495                            - qsati(i) * cldfraliq(i) * (sursat_iceliq - mean_pdf )
     514                 qliq_incl = qsati(i) * SQRT(sigma2_pdf) / SQRT(2.*RPI) * EXP( -1.*(sursat_iceliq - sursat_equ)**2. / (2.*sigma2_pdf) )  &
     515                           - qsati(i) * cldfraliq(i) * (sursat_iceliq - sursat_equ )
    496516                 
    497517                 sigma2_icefracturb(i)= sigma2_pdf
    498                  mean_icefracturb(i)  = mean_pdf
     518                 mean_icefracturb(i)  = sursat_equ
    499519     
    500520                 !------------ SPECIFIC VAPOR CONTENT AND WATER CONSERVATION  ------------
    … …  
    514534                 IF ( qvap_incl  .GE. qtot_incl(i) ) THEN
    515535                    qvap_incl = qsati(i)
    516                     qliq_incl = qtot_incl(i) - qvap_incl
     536                    qliq_incl = MAX(0.0,qtot_incl(i) - qvap_incl)
    517537                    qice_incl = 0.
    518538
    … …  
    527547                 qliq(i)       = qliq_incl * cldfra1D
    528548                 qice(i)       = qice_incl * cldfra1D
    529                  icefrac(i)    = qice(i) / ( qice(i) + qliq(i) )
     549                 IF ((qice(i)+qliq(i)) .GT. 0.) THEN
     550                    icefrac(i)    = qice(i) / ( qice(i) + qliq(i) )
     551                 ELSE
     552                    icefrac(i)    = 1. ! to keep computation of qsat wrt ice in condensation loop in lmdz_lscp_main
     553                 ENDIF
    530554                 dicefracdT(i) = 0.
    531555
    … …  
    536560        END IF ! ! MPC temperature
    537561
    538      END IF ! cldfra
     562     END IF ! pticefracturb and cldfra
    539563   
    540564   ENDDO ! klon

  • LMDZ6/branches/contrails/libf/phylmd/lmdz_surf_wind.f90

    r5618 r5717  
    22        CONTAINS
    33
    4 SUBROUTINE surf_wind(klon,nsurfwind,zu10m,zv10m,sigmaw,cstar,ustar,wstar,wind10ms,probu)
     4SUBROUTINE surf_wind(klon,nsurfwind,zu10m,zv10m,sigmaw,cstar,ustar,ale_bl,wind10ms,probu)
    55
    66USE lmdz_surf_wind_ini, ONLY : iflag_surf_wind
     7USE lmdz_surf_wind_ini, ONLY : surf_wind_ktwake
     8USE lmdz_surf_wind_ini, ONLY : surf_wind_kttherm
     9USE lmdz_surf_wind_ini, ONLY : surf_wind_kztherm
    710
    811IMPLICIT NONE
    … …  
    1114REAL, DIMENSION(klon), INTENT(IN)  :: cstar
    1215REAL, DIMENSION(klon), INTENT(IN)  :: sigmaw
    13 REAL, DIMENSION(klon), INTENT(IN)  :: ustar, wstar
     16REAL, DIMENSION(klon), INTENT(IN)  :: ustar, ale_bl
    1417REAL, DIMENSION(klon,nsurfwind), INTENT(OUT)         :: wind10ms, probu
    15 
     18REAL, PARAMETER                    :: woff=0.5  ! min value of 10m wind speed accepted for emissions
    1619
    1720REAL, DIMENSION(klon,nsurfwind)         :: sigma_th, sigma_wk
    18 REAL, DIMENSION(klon,nsurfwind)         :: xp, yp, zz
     21REAL, DIMENSION(klon,nsurfwind)         :: xp, yp
    1922REAL, DIMENSION(klon,nsurfwind)         :: vwx, vwy, vw
    2023REAL, DIMENSION(klon,nsurfwind)         :: vtx, vty
    … …  
    2730REAL    :: pi, pdfu
    2831REAL    :: auxreal, kref
    29 REAL    :: ray, ray2, theta,rr, xx, yy
    30 REAL    :: ktwk, ktth, kzth
     32REAL    :: ray, ray2, theta,rr, xx, yy, zz
    3133
    32 !print*,'LLLLLLLLLLLLLLLLLLLLL nsurfwind=',nsurfwind
    3334pi=2.*acos(0.)
    3435ray=7000.
    35 ktwk=0.5
    36 ktth=2.
    37 kzth=1.
     36!ktwk=0.5
     37!ktth=2.
     38!kzth=1.
    3839kref=3
    3940nwb=nsurfwind
    4041
    41 ubwk(klon) = zu10m(klon)
    42 vbwk(klon) = zv10m(klon)
     42Do i=1,klon
     43    ubwk(i) = zu10m(i)
     44    vbwk(i) = zv10m(i)
     45ENDDO
    4346
    4447DO i=1,klon
    45     U10mMOD(i)=sqrt(zu10m(i)*zu10m(i)+zv10m(i)*zv10m(i))
     48     U10mMOD(i)=MAX(woff,sqrt(zu10m(i)*zu10m(i)+zv10m(i)*zv10m(i)))   
     49     !U10mMOD(i)=sqrt(zu10m(i)*zu10m(i)+zv10m(i)*zv10m(i))
    4650ENDDO
    4751
    … …  
    9397            ! Utilisation de la distribution du vent a l interieur et a l exterieur des poches
    9498            call Random_number(zz)     ! tirage uniforme entre 0 et 1.
    95             IF (ALL(zz <= sigmaw(klon))) THEN    ! quand on est a l interieur de la poche
     99            IF (zz <= sigmaw(i)) THEN    ! quand on est a l interieur de la poche
     100            !IF (zz <= 1.) THEN    ! test pour tourner uniquement avec le modele de vent dans les poches
    96101 
    97102                  call Random_number(xx)   
    … …  
    110115
    111116                  ! On relie la variance au module du vent au carree (sigma ^ 2 = k || v || ^ 2)
    112                   sigma_wk(i,nmc) =  ktwk*(vw(i,nmc))
     117                  !sigma_wk(i,nmc) =  ktwk*(vw(i,nmc))
     118                  sigma_wk(i,nmc) =  surf_wind_ktwake*(vw(i,nmc))
    113119
    114120                  ! tirage du vent turbulent vt
    … …  
    116122                  vtx(i,nmc) = sigma_wk(i,nmc)*xx
    117123                  vty(i,nmc) = sigma_wk(i,nmc)*yy
    118 
     124                 ! print*,'ZZZZZZZZZZZZZZZZZZZZ xx=',xx
    119125                  ! vent total = vent dans la poche (vw) + le vent turbulent(vt)
    120126                  windx(i,nmc) = vwx(i,nmc) + vtx(i,nmc)
    … …  
    122128                  wind(i,nmc) = sqrt(windx(i,nmc)**2 + windy(i,nmc)**2)
    123129                  wind10ms(i,nmc) = wind(i,nmc)
    124                   probu(i,nmc) = wind(i,nmc)/nsurfwind
     130                  probu(i,nmc) = 1./nsurfwind
    125131
    126132            ELSE
    … …  
    131137
    132138                  !sigma_th(i,nmc) = sqrt((ktth*ustar(i))**2 + (kzth*wstar(i))**2)  ! a voir
    133                   sigma_th(i,nmc) = 1.8
     139                  ! On remplace wstar par sqrt(2*ale_bl)
     140                  sigma_th(i,nmc) = sqrt((surf_wind_kttherm*ustar(i))**2 + (surf_wind_kztherm*sqrt(2*ale_bl(i)))**2)                 
    134141
    135142                  ! tirage du vent turbulent vt
    … …  
    143150                  wind(i,nmc) = sqrt(windx(i,nmc)**2 + windy(i,nmc)**2)
    144151                  wind10ms(i,nmc) = wind(i,nmc)
    145                   probu(i,nmc) = wind(i,nmc)/nsurfwind
     152                  probu(i,nmc) = 1./nsurfwind
    146153                  ! print*, 'wind10ms', wind10ms(i,nmc)         
    147154            ENDIF
     155    ! print*,'WWWWWWWWWWWWWWWWWWWW wind10ms=',wind10ms(i,nmc)
    148156    ! enlver     
    149     !call histogram(wind(i,nmc), 0., 20., nbin, hist)
    150     !call histogram(windx(i,nmc), -20., 20., nbin1, histx)
    151     !call histogram(windy(i,nmc), -20., 20., nbin1, histy)
     157    ! call histogram(wind(i,nmc), 0., 20., nbin, hist)
     158    ! call histogram(windx(i,nmc), -20., 20., nbin1, histx)
     159    ! call histogram(windy(i,nmc), -20., 20., nbin1, histy)
    152160       ENDDO
    153161   ENDDO

  • LMDZ6/branches/contrails/libf/phylmd/lmdz_surf_wind_ini.f90

    r5450 r5717  
    99   integer, protected :: lunout
    1010   integer, protected :: iflag_surf_wind=0
    11    !$OMP THREADPRIVATE(lunout,iflag_surf_wind)
     11   real, protected :: surf_wind_ktwake=0.5
     12   real, protected :: surf_wind_kttherm=2.
     13   real, protected :: surf_wind_kztherm=1.
     14
     15   !$OMP THREADPRIVATE(lunout, iflag_surf_wind, surf_wind_ktwake, surf_wind_kttherm, surf_wind_kztherm)
     16
     17!!   !$OMP THREADPRIVATE(lunout,iflag_surf_wind)
     18!!   !$OMP THREADPRIVATE(lunout,surf_wind_ktwake)
     19!!   !$OMP THREADPRIVATE(lunout,surf_wind_kttherm)
     20!!   !$OMP THREADPRIVATE(lunout,surf_wind_kztherm)
    1221
    1322CONTAINS
    … …  
    3645  lunout=lunout_i
    3746  CALL getin_p('iflag_surf_wind',iflag_surf_wind)
     47  CALL getin_p('surf_wind_ktwake',surf_wind_ktwake)
     48  CALL getin_p('surf_wind_kttherm',surf_wind_kttherm)
     49  CALL getin_p('surf_wind_kztherm',surf_wind_kztherm)
    3850
    3951  write(lunout,*) 'Initialisation wind10m'
    4052  write(lunout,*) 'lmdz_surf_wind_ini, iflag_surf_wind=',iflag_surf_wind
     53  write(lunout,*) 'lmdz_surf_wind_ini, surf_wind_ktwake=',surf_wind_ktwake
     54  write(lunout,*) 'lmdz_surf_wind_ini, surf_wind_kttherm=',surf_wind_kttherm
     55  write(lunout,*) 'lmdz_surf_wind_ini, surf_wind_kztherm=',surf_wind_kztherm
    4156
    4257 RETURN

  • LMDZ6/branches/contrails/libf/phylmd/lmdz_thermcell_plume_6A.f90

    r5618 r5717  
    224224        zta_est(ig,l)=ztva_est(ig,l)
    225225        ztva_est(ig,l) = ztva_est(ig,l)/zpspsk(ig,l)
    226         ztva_est(ig,l) = ztva_est(ig,l)*(1.+RETV*(zqta(ig,l-1)  &
    227      &      -zqla_est(ig,l))-zqla_est(ig,l))
     226        ztva_est(ig,l) = ztva_est(ig,l)*(1.+RETV*(zqta(ig,l-1)-zqla_est(ig,l)))
    228227 
    229228
    … …  
    566565!on rajoute le calcul de zha pour diagnostiques (temp potentielle)
    567566           zha(ig,l) = ztva(ig,l)
    568            ztva(ig,l) = ztva(ig,l)*(1.+RETV*(zqta(ig,l)  &
    569      &              -zqla(ig,l))-zqla(ig,l))
     567           ztva(ig,l) = ztva(ig,l)*(1.+RETV*(zqta(ig,l)-zqla(ig,l)))
    570568           zbuoy(ig,l)=RG*(ztva(ig,l)-ztv(ig,l))/ztv(ig,l)
    571569           zdz=zlev(ig,l+1)-zlev(ig,l)

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

    r5618 r5717  
    313313!!        tke_x,     tke_w                              &
    314314       wake_dltke,                                   &
    315         treedrg                                      &
     315        treedrg,                                      &
    316316!FC
     317!AM heterogeneous continental sub-surfaces
     318       tsurf_tersrf, tsoil_tersrf, qsurf_tersrf, tsurf_new_tersrf, &
     319       cdragm_tersrf, cdragh_tersrf, &
     320       swnet_tersrf, lwnet_tersrf, fluxsens_tersrf, fluxlat_tersrf &
    317321!!!
    318322#ifdef ISO
    … …  
    390394! pblT-----output-R- T au nveau HCL
    391395! treedrg--output-R- tree drag (m)               
    392 !
     396! qsurf_tersrf--output-R- surface specific humidity of continental sub-surfaces
     397! cdragm_tersrf--output-R- momentum drag coefficient of continental sub-surfaces
     398! cdragh_tersrf--output-R- heat drag coefficient of continental sub-surfaces
     399! tsurf_new_tersrf--output-R- surface temperature of continental sub-surfaces
     400! swnet_tersrf--output-R- net shortwave radiation of continental sub-surfaces
     401! lwnet_tersrf--output-R- net longwave radiation of continental sub-surfaces
     402! fluxsens_tersrf--output-R- sensible heat flux of continental sub-surfaces
     403! fluxlat_tersrf--output-R- latent heat flux of continental sub-surfaces
     404
    393405    USE carbon_cycle_mod,   ONLY : carbon_cycle_cpl, carbon_cycle_tr, level_coupling_esm
    394406    USE carbon_cycle_mod,   ONLY : co2_send, nbcf_out, fields_out, yfields_out, cfname_out
    … …  
    414426    USE ioipsl_getin_p_mod, ONLY : getin_p
    415427    use phys_state_var_mod, only: ds_ns, dt_ns, delta_sst, delta_sal, dter, &
    416          dser, dt_ds, zsig, zmea
     428         dser, dt_ds, zsig, zmea, &
     429         frac_tersrf, z0m_tersrf, ratio_z0m_z0h_tersrf, albedo_tersrf !AM
    417430    use phys_output_var_mod, only: tkt, tks, taur, sss
    418431    use lmdz_blowing_snow_ini, only : zeta_bs
    … …  
    420433    USE netcdf, only: missing_val_netcdf => nf90_fill_real
    421434    USE dimsoil_mod_h, ONLY: nsoilmx
     435    USE surf_param_mod, ONLY: eff_surf_param  !AM
    422436
    423437    USE yomcst_mod_h
    … …  
    620634    REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_v     ! v wind tension (kg m/s)/(m**2 s) or Pascal
    621635!FC
    622     REAL, DIMENSION(klon, klev, nbsrf), INTENT(INOUT) :: treedrg  ! tree drag (m)               
     636    REAL, DIMENSION(klon, klev, nbsrf), INTENT(INOUT) :: treedrg  ! tree drag (m)     
     637!AM heterogeneous continental sub-surfaces
     638    REAL, DIMENSION(klon, nbtersrf), INTENT(INOUT) :: tsurf_tersrf     ! surface temperature of continental sub-surfaces (K)               
     639    REAL, DIMENSION(klon, nbtersrf), INTENT(INOUT) :: qsurf_tersrf     ! surface specific humidity of continental sub-surfaces (kg/kg)               
     640    REAL, DIMENSION(klon, nbtersrf), INTENT(INOUT) :: tsurf_new_tersrf ! surface temperature of continental sub-surfaces (K)               
     641    REAL, DIMENSION(klon, nbtersrf), INTENT(INOUT) :: cdragm_tersrf    ! momentum drag coefficient of continental sub-surfaces (-)               
     642    REAL, DIMENSION(klon, nbtersrf), INTENT(INOUT) :: cdragh_tersrf    ! heat drag coefficient of continental sub-surfaces (-)               
     643    REAL, DIMENSION(klon, nbtersrf), INTENT(INOUT) :: swnet_tersrf     ! net shortwave radiation of continental sub-surfaces (W/m2)               
     644    REAL, DIMENSION(klon, nbtersrf), INTENT(INOUT) :: lwnet_tersrf     ! net longwave radiation of continental sub-surfaces (W/m2)               
     645    REAL, DIMENSION(klon, nbtersrf), INTENT(INOUT) :: fluxsens_tersrf  ! sensible heat flux of continental sub-surfaces (W/m2)               
     646    REAL, DIMENSION(klon, nbtersrf), INTENT(INOUT) :: fluxlat_tersrf   ! latent heat flux of continental sub-surfaces (W/m2)               
     647    REAL, DIMENSION(klon, nsoilmx, nbtersrf), INTENT(INOUT) :: tsoil_tersrf ! soil temperature of continental sub-surfaces (K)               
    623648#ifdef ISO       
    624649    REAL, DIMENSION(niso,klon),   INTENT(OUT)       :: xtsol      ! water height in the soil (mm)
    … …  
    10501075    ! dt_ds, tkt, tks, taur, sss on ocean points
    10511076    REAL :: missing_val
     1077    ! AM !
     1078    REAL, DIMENSION(klon) :: z0m_eff, z0h_eff, ratio_z0m_z0h_eff, albedo_eff
     1079    REAL, DIMENSION(klon, nbtersrf) :: z0h_tersrf
    10521080#ifdef ISO
    10531081    REAL, DIMENSION(klon)       :: h1
    … …  
    14741502    ENDDO
    14751503
     1504    ! AM heterogeneous continental subsurfaces
     1505    ! compute time-independent effective surface parameters
     1506    IF (iflag_hetero_surf .GT. 0) THEN
     1507      albedo_eff = eff_surf_param(klon, nbtersrf, albedo_tersrf, frac_tersrf, 'ARI')
     1508    ENDIF
     1509
    14761510! Mean calculations of albedo
    14771511!
    … …  
    14861520     DO nsrf = 1, nbsrf
    14871521       DO i = 1, klon
     1522          ! AM heterogeneous continental sub-surfaces
     1523          IF (nsrf .EQ. is_ter .AND. iflag_hetero_surf .GT. 0) THEN
     1524            alb_dir(i,k,nsrf) = albedo_eff(i)
     1525            alb_dif(i,k,nsrf) = albedo_eff(i)
     1526          ENDIF
     1527          !
    14881528          alb_dir_m(i,k) = alb_dir_m(i,k) + alb_dir(i,k,nsrf) * pctsrf(i,nsrf)
    14891529          alb_dif_m(i,k) = alb_dif_m(i,k) + alb_dif(i,k,nsrf) * pctsrf(i,nsrf)
    … …  
    18831923           speed(i) = SQRT(yu(i,1)**2+yv(i,1)**2)
    18841924        ENDDO
     1925!       
     1926        !!! AM heterogeneous continental subsurfaces
     1927        IF (nsrf .EQ. is_ter) THEN
     1928          ! compute time-dependent effective surface parameters (function of zgeo1) !! AM
     1929          IF (iflag_hetero_surf .GT. 0) THEN
     1930            DO i=1,klon
     1931              DO j=1,nbtersrf
     1932                IF (ratio_z0m_z0h_tersrf(i,j) .NE. 0.) THEN
     1933                  z0h_tersrf(i,j) = z0m_tersrf(i,j) / ratio_z0m_z0h_tersrf(i,j)
     1934                ELSE
     1935                  z0h_tersrf(i,j) = 0.
     1936                ENDIF
     1937              ENDDO
     1938            ENDDO
     1939            !
     1940            z0m_eff = eff_surf_param(klon, nbtersrf, z0m_tersrf, frac_tersrf, 'CDN', zgeo1/RG)
     1941            z0h_eff = eff_surf_param(klon, nbtersrf, z0h_tersrf, frac_tersrf, 'CDN', zgeo1/RG)
     1942            yz0m = z0m_eff
     1943            yz0h = z0h_eff
     1944            !
     1945          ENDIF
     1946        ENDIF
     1947!
    18851948        CALL cdrag(knon, nsrf, &
    18861949            speed, yt(:,1), yq(:,1), zgeo1, ypaprs(:,1), s_pblh, &
    … …  
    24252488               yqsurf, ytsurf_new, y_dflux_t, y_dflux_q, &
    24262489               y_flux_u1, y_flux_v1, &
    2427                yveget,ylai,yheight   &
     2490               yveget,ylai,yheight, tsurf_tersrf, tsoil_tersrf, qsurf_tersrf, tsurf_new_tersrf, &
     2491               cdragm_tersrf, cdragh_tersrf, &
     2492               swnet_tersrf, lwnet_tersrf, fluxsens_tersrf, fluxlat_tersrf  &
    24282493#ifdef ISO
    24292494         &      ,yxtrain_f, yxtsnow_f,yxt1, &
    … …  
    24322497#endif               
    24332498         &      )
    2434  
     2499
     2500          tsurf_tersrf(:,:) =  tsurf_new_tersrf(:,:) ! for next time step
     2501
    24352502!FC quid qd yveget ylai yheight ne sont pas definit
    24362503!FC  yveget,ylai,yheight, &

  • LMDZ6/branches/contrails/libf/phylmd/phyaqua_mod.f90

    r5285 r5717  
    279279    clesphy0(3) = 1. ! cycle_diurne
    280280    clesphy0(4) = 1. ! soil_model
    281     clesphy0(5) = 1. ! new_oliq
     281    clesphy0(5) = 1. ! liqice_in_radocond
    282282    clesphy0(6) = 0. ! ok_orodr
    283283    clesphy0(7) = 0. ! ok_orolf
    … …  
    355355    alp_bl =0.
    356356    treedrg(:,:,:)=0.
     357    tsurf_tersrf(:,:) = 0.
     358    qsurf_tersrf(:,:) = 0.
     359    cdragm_tersrf(:,:) = 0.
     360    cdragh_tersrf(:,:) = 0.
     361    swnet_tersrf(:,:) = 0.
     362    lwnet_tersrf(:,:) = 0.
     363    fluxsens_tersrf(:,:) = 0.
     364    fluxlat_tersrf(:,:) = 0.
    357365
    358366    u10m = 0.

  • LMDZ6/branches/contrails/libf/phylmd/phyetat0_mod.f90

    r5641 r5717  
    1111
    1212  USE clesphys_mod_h
    13   USE dimphy, only: klon, zmasq, klev
     13  USE dimphy, only: klon, zmasq, klev, nbtersrf, nbtsoildepths
    1414  USE iophy, ONLY : init_iophy_new
    1515  USE ocean_cpl_mod,    ONLY : ocean_cpl_init
    … …  
    3131       zstd, zthe, zval, ale_bl, ale_bl_trig, alp_bl, u10m, v10m, treedrg, &
    3232       ale_wake, ale_bl_stat, ds_ns, dt_ns, delta_sst, delta_sal, dter, dser, &
    33        dt_ds, ratqs_inter_
     33       dt_ds, ratqs_inter_, frac_tersrf, z0m_tersrf, ratio_z0m_z0h_tersrf, &
     34       albedo_tersrf, beta_tersrf, inertie_tersrf, alpha_soil_tersrf, &
     35       period_tersrf, hcond_tersrf, tsurfi_tersrf, tsoili_tersrf, tsoil_depth, &
     36       qsurf_tersrf, tsurf_tersrf, tsoil_tersrf, tsurf_new_tersrf, cdragm_tersrf, &
     37       cdragh_tersrf, swnet_tersrf, lwnet_tersrf, fluxsens_tersrf, fluxlat_tersrf
    3438!FC
    3539  USE geometry_mod,     ONLY: longitude_deg, latitude_deg
    … …  
    4549  use netcdf, only: missing_val_netcdf => nf90_fill_real
    4650  use config_ocean_skin_m, only: activate_ocean_skin
     51  USE surf_param_mod, ONLY: average_surf_var, interpol_tsoil !AM
    4752  USE dimsoil_mod_h, ONLY: nsoilmx
    4853  USE yomcst_mod_h
    … …  
    154159  IF (iflag_cycle_diurne.GE.1) tab_cntrl( 7) = iflag_cycle_diurne
    155160  IF (soil_model) tab_cntrl( 8) =1.
    156   IF (new_oliq) tab_cntrl( 9) =1.
     161  IF (liqice_in_radocond) tab_cntrl( 9) =1.
    157162  IF (ok_orodr) tab_cntrl(10) =1.
    158163  IF (ok_orolf) tab_cntrl(11) =1.
    … …  
    387392  ENDIF
    388393
     394  IF (iflag_hetero_surf .GT. 0) THEN
     395    found=phyetat0_srf(frac_tersrf,"frac_tersrf","fraction of continental sub-surfaces",0.)
     396    found=phyetat0_srf(z0m_tersrf,"z0m_tersrf","roughness length for momentum of continental sub-surfaces",0.)
     397    found=phyetat0_srf(ratio_z0m_z0h_tersrf,"ratio_z0m_z0h_tersrf","ratio of heat to momentum roughness length of continental sub-surfaces",0.)
     398    found=phyetat0_srf(albedo_tersrf,"albedo_tersrf","albedo of continental sub-surfaces",0.)
     399    found=phyetat0_srf(beta_tersrf,"beta_tersrf","evapotranspiration coef of continental sub-surfaces",0.)
     400    found=phyetat0_srf(inertie_tersrf,"inertie_tersrf","soil thermal inertia of continental sub-surfaces",0.)
     401    found=phyetat0_srf(hcond_tersrf,"hcond_tersrf","heat conductivity of continental sub-surfaces",0.)
     402    found=phyetat0_srf(tsurfi_tersrf,"tsurfi_tersrf","initial surface temperature of continental sub-surfaces",0.)
     403    !
     404    ! Check if the sum of the sub-surface fractions is equal to 1
     405    DO it=1,klon
     406      IF (SUM(frac_tersrf(it,:)) .NE. 1.) THEN
     407        PRINT*, 'SUM(frac_tersrf) = ', SUM(frac_tersrf(it,:))
     408        CALL abort_physic('conf_phys', 'the sum of fractions of heterogeneous land subsurfaces must be equal &
     409                          & to 1 for iflag_hetero_surf = 1 and 2',1)
     410      ENDIF
     411    ENDDO
     412    !
     413    ! Initialisation of surface and soil temperatures (potentially different initial temperatures between sub-surfaces)
     414    DO iq=1,nbtersrf
     415      DO it=1,klon
     416        tsurf_tersrf(it,iq) = tsurfi_tersrf(it,iq)
     417      ENDDO
     418    ENDDO
     419    !
     420    DO isoil=1, nbtsoildepths
     421      IF (isoil.GT.99) THEN
     422        PRINT*, "Trop de couches "
     423        CALL abort_physic("phyetat0", "", 1)
     424      ENDIF
     425      WRITE(str2,'(i2.2)') isoil
     426      found=phyetat0_srf(tsoil_depth(:,isoil,:),"tsoil_depth"//str2//"srf","soil depth of continental sub-surfaces",0.)
     427      found=phyetat0_srf(tsoili_tersrf(:,isoil,:),"Tsoili"//str2//"srf","initial soil temperature of continental sub-surfaces",0.)
     428      IF (.NOT. found) THEN
     429        PRINT*, "phyetat0: Le champ <Tsoili"//str2//"> est absent"
     430        PRINT*, "          Il prend donc la valeur de surface"
     431        tsoili_tersrf(:, isoil, :) = tsurfi_tersrf(:, :)
     432      ENDIF
     433    ENDDO
     434    !
     435    tsoil_tersrf = interpol_tsoil(klon, nbtersrf, nsoilmx, nbtsoildepths, alpha_soil_tersrf, period_tersrf, &
     436                   inertie_tersrf, hcond_tersrf, tsoil_depth, tsurf_tersrf, tsoili_tersrf)
     437    !
     438    ! initialise also average surface and soil temperatures
     439    ftsol(:,is_ter) = average_surf_var(klon, nbtersrf, tsurf_tersrf, frac_tersrf, 'ARI')
     440    DO k=1, nsoilmx
     441      tsoil(:,k,is_ter) = average_surf_var(klon, nbtersrf, tsoil_tersrf(:,k,:), frac_tersrf, 'ARI')
     442    ENDDO
     443    !
     444  ENDIF ! iflag_hetero_surf > 0
     445
    389446  endif ! iflag_physiq <= 1
    390447

  • LMDZ6/branches/contrails/libf/phylmd/phyredem.f90

    r5641 r5717  
    3636                                du_gwd_rando, du_gwd_front, u10m, v10m, &
    3737                                treedrg, solswfdiff, delta_sal, ds_ns, dt_ns, &
    38                                 delta_sst, ratqs_inter_, dter, dser, dt_ds
     38                                delta_sst, ratqs_inter_, dter, dser, dt_ds,  &
     39                                frac_tersrf, z0m_tersrf, ratio_z0m_z0h_tersrf, &
     40                                albedo_tersrf, beta_tersrf, inertie_tersrf,  &
     41                                hcond_tersrf, tsurfi_tersrf, tsoili_tersrf, tsoil_depth, &
     42                                qsurf_tersrf, tsurf_tersrf, tsoil_tersrf, tsurf_new_tersrf, &
     43                                cdragm_tersrf, cdragh_tersrf, &
     44                                swnet_tersrf, lwnet_tersrf, fluxsens_tersrf, fluxlat_tersrf
    3945
    4046  USE geometry_mod, ONLY : longitude_deg, latitude_deg
    … …  
    102108  IF( iflag_cycle_diurne.GE.1 ) tab_cntrl( 7 ) = iflag_cycle_diurne
    103109  IF(   soil_model ) tab_cntrl( 8 ) = 1.
    104   IF(     new_oliq ) tab_cntrl( 9 ) = 1.
     110  IF(     liqice_in_radocond ) tab_cntrl( 9 ) = 1.
    105111  IF(     ok_orodr ) tab_cntrl(10 ) = 1.
    106112  IF(     ok_orolf ) tab_cntrl(11 ) = 1.
    … …  
    191197!  CALL put_field_srf2("treedrg","freinage arbres",treedrg(:,:,:))
    192198    CALL put_field(pass,"treedrg_ter","freinage arbres",treedrg(:,:,is_ter))
    193 
     199!AM
     200    CALL put_field_srf1(pass,"frac_tersrf","fraction sous surface", frac_tersrf(:,:))
     201    CALL put_field_srf1(pass,"z0m_tersrf","rugosite sous surface", z0m_tersrf(:,:))
     202    CALL put_field_srf1(pass,"ratio_z0m_z0h_tersrf","ratio rugosites sous surface", ratio_z0m_z0h_tersrf(:,:))
     203    CALL put_field_srf1(pass,"albedo_tersrf","albedo sous surface", albedo_tersrf(:,:))
     204    CALL put_field_srf1(pass,"beta_tersrf","beta sous surface", beta_tersrf(:,:))
     205    CALL put_field_srf1(pass,"inertie_tersrf","inertie sous surface", inertie_tersrf(:,:))
     206    CALL put_field_srf1(pass,"hcond_tersrf","conductivité thermique sous surface", hcond_tersrf(:,:))
     207    CALL put_field_srf1(pass,"tsurfi_tersrf","temperature surface sous surface initiale", tsurfi_tersrf(:,:))
     208    CALL put_field_srf2(pass,"Tsoili","temperature sol sous surface initiale", tsoili_tersrf(:,:,:))
     209    CALL put_field_srf2(pass,"tsoil_depth","profondeur temperature sol sous surface", tsoil_depth(:,:,:))
     210    CALL put_field_srf1(pass,"qsurf_tersrf","humidite surface sous surface", qsurf_tersrf(:,:))
     211    CALL put_field_srf1(pass,"tsurf_tersrf","temperature surface sous surface", tsurf_tersrf(:,:))
     212    CALL put_field_srf1(pass,"tsurf_new_tersrf","temperature surface sous surface", tsurf_new_tersrf(:,:))
     213    CALL put_field_srf1(pass,"cdragm_tersrf","coeff trainee quantite mouvement sous surface", cdragm_tersrf(:,:))
     214    CALL put_field_srf1(pass,"cdragh_tersrf","coeff trainee chaleur sous surface", cdragh_tersrf(:,:))
     215    CALL put_field_srf1(pass,"swnet_tersrf","shortwave net sous surface", swnet_tersrf(:,:))
     216    CALL put_field_srf1(pass,"lwnet_tersrf","longwave net sous surface", lwnet_tersrf(:,:))
     217    CALL put_field_srf1(pass,"fluxsens_tersrf","flux sensible sous surface", fluxsens_tersrf(:,:))
     218    CALL put_field_srf1(pass,"fluxlat_tersrf","flux latent sous surface", fluxlat_tersrf(:,:))
     219    CALL put_field_srf2(pass,"tsoil_tersrf","temperature sol sous surface", tsoil_tersrf(:,:,:))
    194220
    195221    CALL put_field_srf1(pass,"QS"  , "Humidite",qsurf(:,:))

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

    r5684 r5717  
    4747      REAL, SAVE, ALLOCATABLE :: d_tr_dyn(:,:,:)
    4848      !$OMP THREADPRIVATE(d_tr_dyn)
    49       REAL, SAVE, ALLOCATABLE :: d_t_con(:,:),d_q_con(:,:),d_q_con_zmasse(:,:)
    50       !$OMP THREADPRIVATE(d_t_con,d_q_con,d_q_con_zmasse)
     49      REAL, SAVE, ALLOCATABLE :: d_t_con(:,:),d_q_con(:,:)
     50      !$OMP THREADPRIVATE(d_t_con,d_q_con)
    5151      REAL, SAVE, ALLOCATABLE :: d_u_con(:,:),d_v_con(:,:)
    5252      !$OMP THREADPRIVATE(d_u_con,d_v_con)
     53      REAL, SAVE, ALLOCATABLE :: d_t_con_zmasse(:,:),d_q_con_zmasse(:,:)
     54      !$OMP THREADPRIVATE(d_t_con_zmasse,d_q_con_zmasse)
     55      REAL, SAVE, ALLOCATABLE :: d_u_con_zmasse(:,:),d_v_con_zmasse(:,:)
     56      !$OMP THREADPRIVATE(d_u_con_zmasse,d_v_con_zmasse)
    5357      REAL, SAVE, ALLOCATABLE :: d_t_wake(:,:),d_q_wake(:,:)
    5458      !$OMP THREADPRIVATE( d_t_wake,d_q_wake)
    … …  
    623627      REAL, SAVE, ALLOCATABLE :: sigma2_icefracturb(:,:)
    624628!$OMP THREADPRIVATE(sigma2_icefracturb)
     629      REAL, SAVE, ALLOCATABLE :: cldfraliqth(:,:)
     630!$OMP THREADPRIVATE(cldfraliqth)
     631      REAL, SAVE, ALLOCATABLE ::mean_icefracturbth(:,:)
     632!$OMP THREADPRIVATE(mean_icefracturbth)
     633      REAL, SAVE, ALLOCATABLE :: sigma2_icefracturbth(:,:)
     634!$OMP THREADPRIVATE(sigma2_icefracturbth)
    625635
    626636! variables de sorties MM
    … …  
    789799      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: cg_bin
    790800!$OMP THREADPRIVATE(cg_bin)
     801      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: SO2_chlm
     802!$OMP THREADPRIVATE(SO2_chlm)
     803      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tau_strat_443
     804!$OMP THREADPRIVATE(tau_strat_443)
    791805      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tau_strat_550
    792806!$OMP THREADPRIVATE(tau_strat_550)
     807      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tau_strat_670
     808!$OMP THREADPRIVATE(tau_strat_670)
     809      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tau_strat_765
     810!$OMP THREADPRIVATE(tau_strat_765)
    793811      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tau_strat_1020
    794812!$OMP THREADPRIVATE(tau_strat_1020)
     813      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tau_strat_10um
     814!$OMP THREADPRIVATE(tau_strat_10um)
    795815      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tausum_strat
    796816!$OMP THREADPRIVATE(tausum_strat)
    … …  
    888908      ALLOCATE(d_cf_dyn(klon,klev),d_qvc_dyn(klon,klev))
    889909      ALLOCATE(d_tr_dyn(klon,klev,nbtr))                   !RomP
    890       ALLOCATE(d_t_con(klon,klev),d_q_con(klon,klev),d_q_con_zmasse(klon,klev))
     910      ALLOCATE(d_t_con(klon,klev),d_q_con(klon,klev))
    891911      ALLOCATE(d_u_con(klon,klev),d_v_con(klon,klev))
     912      ALLOCATE(d_t_con_zmasse(klon,klev),d_q_con_zmasse(klon,klev))
     913      ALLOCATE(d_u_con_zmasse(klon,klev),d_v_con_zmasse(klon,klev))
    892914      ALLOCATE(d_t_wake(klon,klev),d_q_wake(klon,klev))
    893915      ALLOCATE(d_t_lsc(klon,klev),d_q_lsc(klon,klev))
    … …  
    12351257      ALLOCATE(sigma2_icefracturb(klon,klev))
    12361258      ALLOCATE(mean_icefracturb(klon,klev))
     1259      ALLOCATE(cldfraliqth(klon,klev))
     1260      ALLOCATE(sigma2_icefracturbth(klon,klev))
     1261      ALLOCATE(mean_icefracturbth(klon,klev))
    12371262      ALLOCATE(distcltop(klon,klev))
    12381263      ALLOCATE(temp_cltop(klon,klev))
    … …  
    13191344      ALLOCATE (piz_bin(nbands_sw_rrtm+nbands_lw_rrtm+nwave,nbtr))
    13201345      ALLOCATE (cg_bin(nbands_sw_rrtm+nbands_lw_rrtm+nwave,nbtr))
     1346      ALLOCATE (SO2_chlm(klon,klev))
     1347      ALLOCATE (tau_strat_443(klon,klev))
    13211348      ALLOCATE (tau_strat_550(klon,klev))
     1349      ALLOCATE (tau_strat_670(klon,klev))
     1350      ALLOCATE (tau_strat_765(klon,klev))
    13221351      ALLOCATE (tau_strat_1020(klon,klev))
    1323       ALLOCATE (tausum_strat(klon,3))
     1352      ALLOCATE (tau_strat_10um(klon,klev))
     1353      ALLOCATE (tausum_strat(klon,6))
    13241354      ALLOCATE (budg_dep_dry_ocs(klon))
    13251355      ALLOCATE (budg_dep_wet_ocs(klon))
    … …  
    13711401      DEALLOCATE(d_cf_dyn,d_qvc_dyn)
    13721402      DEALLOCATE(d_tr_dyn)                      !RomP
    1373       DEALLOCATE(d_t_con,d_q_con,d_q_con_zmasse)
     1403      DEALLOCATE(d_t_con,d_q_con)
    13741404      DEALLOCATE(d_u_con,d_v_con)
     1405      DEALLOCATE(d_t_con_zmasse,d_q_con_zmasse)
     1406      DEALLOCATE(d_u_con_zmasse,d_v_con_zmasse)
    13751407      DEALLOCATE(d_t_wake,d_q_wake)
    13761408      DEALLOCATE(d_t_lsc,d_q_lsc)
    … …  
    16691701      DEALLOCATE(sigma2_icefracturb)
    16701702      DEALLOCATE(mean_icefracturb)
     1703      DEALLOCATE(cldfraliqth)
     1704      DEALLOCATE(sigma2_icefracturbth)
     1705      DEALLOCATE(mean_icefracturbth)
    16711706      DEALLOCATE (zxsnow,snowhgt,qsnow,to_ice,sissnow,runoff,albsol3_lic)
    16721707      DEALLOCATE(distcltop)
    … …  
    17301765      DEALLOCATE (piz_bin)
    17311766      DEALLOCATE (cg_bin)
     1767      DEALLOCATE (SO2_chlm)
     1768      DEALLOCATE (tau_strat_443)
    17321769      DEALLOCATE (tau_strat_550)
     1770      DEALLOCATE (tau_strat_670)
     1771      DEALLOCATE (tau_strat_765)
    17331772      DEALLOCATE (tau_strat_1020)
     1773      DEALLOCATE (tau_strat_10um)
    17341774      DEALLOCATE (tausum_strat)
    17351775      DEALLOCATE (surf_PM25_sulf)

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

    r5641 r5717  
    538538  TYPE(ctrl_out), SAVE :: o_tauy = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
    539539    'tauy', 'Meridional wind stress', 'Pa', (/ ('', i=1, 10) /))
     540
     541! AM
     542  !!! The number of continental sub-surfaces (max_nbtersrf) is defined in indice_sol_mod
     543
     544  TYPE(ctrl_out), SAVE, DIMENSION(max_nbtersrf) :: o_frac_tersrf     = (/ &
     545    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'frac_tersrf'//nb_tersrf(1),  &
     546    "Fraction of each continental sub-surface "//nb_tersrf(1),"K", (/ ('', i=1, 10) /)),  &
     547    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'frac_tersrf'//nb_tersrf(2),  &
     548    "Fraction of each continental sub-surface "//nb_tersrf(2),"K", (/ ('', i=1, 10) /)),  &
     549    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'frac_tersrf'//nb_tersrf(3),  &
     550    "Fraction of each continental sub-surface "//nb_tersrf(3),"K", (/ ('', i=1, 10) /)),  &
     551    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'frac_tersrf'//nb_tersrf(4),  &
     552    "Fraction of each continental sub-surface "//nb_tersrf(4),"K", (/ ('', i=1, 10) /)),  &
     553    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'frac_tersrf'//nb_tersrf(5),  &
     554    "Fraction of each continental sub-surface "//nb_tersrf(5),"K", (/ ('', i=1, 10) /)) /)
     555
     556  TYPE(ctrl_out), SAVE, DIMENSION(max_nbtersrf) :: o_qsurf_tersrf     = (/ &
     557    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'qsurf_tersrf'//nb_tersrf(1),  &
     558    "Surface humidity of continental sub-surface "//nb_tersrf(1),"K", (/ ('', i=1, 10) /)),  &
     559    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'qsurf_tersrf'//nb_tersrf(2),  &
     560    "Surface humidity of continental sub-surface "//nb_tersrf(2),"K", (/ ('', i=1, 10) /)),  &
     561    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'qsurf_tersrf'//nb_tersrf(3),  &
     562    "Surface humidity of continental sub-surface "//nb_tersrf(3),"K", (/ ('', i=1, 10) /)),  &
     563    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'qsurf_tersrf'//nb_tersrf(4),  &
     564    "Surface humidity of continental sub-surface "//nb_tersrf(4),"K", (/ ('', i=1, 10) /)),  &
     565    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'qsurf_tersrf'//nb_tersrf(5),  &
     566    "Surface humidity of continental sub-surface "//nb_tersrf(5),"K", (/ ('', i=1, 10) /)) /)
     567
     568  TYPE(ctrl_out), SAVE, DIMENSION(max_nbtersrf) :: o_tsurf_new_tersrf     = (/ &
     569    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsol_tersrf'//nb_tersrf(1),  &
     570    "Surface temperature of continental sub-surface "//nb_tersrf(1),"K", (/ ('', i=1, 10) /)),  &
     571    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsol_tersrf'//nb_tersrf(2),  &
     572    "Surface temperature of continental sub-surface "//nb_tersrf(2),"K", (/ ('', i=1, 10) /)),  &
     573    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsol_tersrf'//nb_tersrf(3),  &
     574    "Surface temperature of continental sub-surface "//nb_tersrf(3),"K", (/ ('', i=1, 10) /)),  &
     575    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsol_tersrf'//nb_tersrf(4),  &
     576    "Surface temperature of continental sub-surface "//nb_tersrf(4),"K", (/ ('', i=1, 10) /)),  &
     577    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsol_tersrf'//nb_tersrf(5),  &
     578    "Surface temperature of continental sub-surface "//nb_tersrf(5),"K", (/ ('', i=1, 10) /)) /)
     579  TYPE(ctrl_out), SAVE, DIMENSION(max_nbtersrf) :: o_swnet_tersrf     = (/ &
     580    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'sols_tersrf'//nb_tersrf(1),  &
     581    "Net SW radiation of continental sub-surface "//nb_tersrf(1),"K", (/ ('', i=1, 10) /)),  &
     582    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'sols_tersrf'//nb_tersrf(2),  &
     583    "Net SW radiation of continental sub-surface "//nb_tersrf(2),"K", (/ ('', i=1, 10) /)),  &
     584    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'sols_tersrf'//nb_tersrf(3),  &
     585    "Net SW radiation of continental sub-surface "//nb_tersrf(3),"K", (/ ('', i=1, 10) /)),  &
     586    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'sols_tersrf'//nb_tersrf(4),  &
     587    "Net SW radiation of continental sub-surface "//nb_tersrf(4),"K", (/ ('', i=1, 10) /)),  &
     588    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'sols_tersrf'//nb_tersrf(5),  &
     589    "Net SW radiation of continental sub-surface "//nb_tersrf(5),"K", (/ ('', i=1, 10) /)) /)
     590
     591  TYPE(ctrl_out), SAVE, DIMENSION(max_nbtersrf) :: o_lwnet_tersrf     = (/ &
     592    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'soll_tersrf'//nb_tersrf(1),  &
     593    "Net LW radiation of continental sub-surface "//nb_tersrf(1),"K", (/ ('', i=1, 10) /)),  &
     594    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'soll_tersrf'//nb_tersrf(2),  &
     595    "Net LW radiation of continental sub-surface "//nb_tersrf(2),"K", (/ ('', i=1, 10) /)),  &
     596    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'soll_tersrf'//nb_tersrf(3),  &
     597    "Net LW radiation of continental sub-surface "//nb_tersrf(3),"K", (/ ('', i=1, 10) /)),  &
     598    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'soll_tersrf'//nb_tersrf(4),  &
     599    "Net LW radiation of continental sub-surface "//nb_tersrf(4),"K", (/ ('', i=1, 10) /)),  &
     600    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'soll_tersrf'//nb_tersrf(5),  &
     601    "Net LW radiation of continental sub-surface "//nb_tersrf(5),"K", (/ ('', i=1, 10) /)) /)
     602
     603  TYPE(ctrl_out), SAVE, DIMENSION(max_nbtersrf) :: o_fluxsens_tersrf     = (/ &
     604    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'sens_tersrf'//nb_tersrf(1),  &
     605    "Sensible heat flux of continental sub-surface "//nb_tersrf(1),"K", (/ ('', i=1, 10) /)),  &
     606    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'sens_tersrf'//nb_tersrf(2),  &
     607    "Sensible heat flux of continental sub-surface "//nb_tersrf(2),"K", (/ ('', i=1, 10) /)),  &
     608    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'sens_tersrf'//nb_tersrf(3),  &
     609    "Sensible heat flux of continental sub-surface "//nb_tersrf(3),"K", (/ ('', i=1, 10) /)),  &
     610    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'sens_tersrf'//nb_tersrf(4),  &
     611    "Sensible heat flux of continental sub-surface "//nb_tersrf(4),"K", (/ ('', i=1, 10) /)),  &
     612    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'sens_tersrf'//nb_tersrf(5),  &
     613    "Sensible heat flux of continental sub-surface "//nb_tersrf(5),"K", (/ ('', i=1, 10) /)) /)
     614 TYPE(ctrl_out), SAVE, DIMENSION(max_nbtersrf) :: o_fluxlat_tersrf     = (/ &
     615    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'flat_tersrf'//nb_tersrf(1),  &
     616    "Latent heat flux of continental sub-surface "//nb_tersrf(1),"K", (/ ('', i=1, 10) /)),  &
     617    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'flat_tersrf'//nb_tersrf(2),  &
     618    "Latent heat flux of continental sub-surface "//nb_tersrf(2),"K", (/ ('', i=1, 10) /)),  &
     619    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'flat_tersrf'//nb_tersrf(3),  &
     620    "Latent heat flux of continental sub-surface "//nb_tersrf(3),"K", (/ ('', i=1, 10) /)),  &
     621    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'flat_tersrf'//nb_tersrf(4),  &
     622    "Latent heat flux of continental sub-surface "//nb_tersrf(4),"K", (/ ('', i=1, 10) /)),  &
     623    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'flat_tersrf'//nb_tersrf(5),  &
     624    "Latent heat flux of continental sub-surface "//nb_tersrf(5),"K", (/ ('', i=1, 10) /)) /)
     625 TYPE(ctrl_out), SAVE, DIMENSION(max_nbtersrf) :: o_cdragm_tersrf     = (/ &
     626    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'cdrm_tersrf'//nb_tersrf(1),  &
     627    "Momentum drag coefficient of continental sub-surface "//nb_tersrf(1),"K", (/ ('', i=1, 10) /)),  &
     628    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'cdrm_tersrf'//nb_tersrf(2),  &
     629    "Momentum drag coefficient of continental sub-surface "//nb_tersrf(2),"K", (/ ('', i=1, 10) /)),  &
     630    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'cdrm_tersrf'//nb_tersrf(3),  &
     631    "Momentum drag coefficient of continental sub-surface "//nb_tersrf(3),"K", (/ ('', i=1, 10) /)),  &
     632    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'cdrm_tersrf'//nb_tersrf(4),  &
     633    "Momentum drag coefficient of continental sub-surface "//nb_tersrf(4),"K", (/ ('', i=1, 10) /)),  &
     634    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'cdrm_tersrf'//nb_tersrf(5),  &
     635    "Momentum drag coefficient of continental sub-surface "//nb_tersrf(5),"K", (/ ('', i=1, 10) /)) /)
     636
     637  TYPE(ctrl_out), SAVE, DIMENSION(max_nbtersrf) :: o_cdragh_tersrf     = (/ &
     638    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'cdrh_tersrf'//nb_tersrf(1),  &
     639    "Heat drag coefficient of continental sub-surface "//nb_tersrf(1),"K", (/ ('', i=1, 10) /)),  &
     640    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'cdrh_tersrf'//nb_tersrf(2),  &
     641    "Heat drag coefficient of continental sub-surface "//nb_tersrf(2),"K", (/ ('', i=1, 10) /)),  &
     642    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'cdrh_tersrf'//nb_tersrf(3),  &
     643    "Heat drag coefficient of continental sub-surface "//nb_tersrf(3),"K", (/ ('', i=1, 10) /)),  &
     644    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'cdrh_tersrf'//nb_tersrf(4),  &
     645    "Heat drag coefficient of continental sub-surface "//nb_tersrf(4),"K", (/ ('', i=1, 10) /)),  &
     646    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'cdrh_tersrf'//nb_tersrf(5),  &
     647    "Heat drag coefficient of continental sub-surface "//nb_tersrf(5),"K", (/ ('', i=1, 10) /)) /)
     648
     649  TYPE(ctrl_out), SAVE, DIMENSION(max_nbtersrf*nsoilout) :: o_tsoil_tersrf     = (/ &
     650    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(1)//"_l"//nb_soil(1),  &
     651    "Soil temperature of continental sub-surface "//nb_tersrf(1)//" layer "//nb_soil(1),"K", (/ ('', i=1, 10) /)),  &
     652    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(1)//"_l"//nb_soil(2),  &
     653    "Soil temperature of continental sub-surface "//nb_tersrf(1)//" layer "//nb_soil(2),"K", (/ ('', i=1, 10) /)),  &
     654    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(1)//"_l"//nb_soil(3),  &
     655    "Soil temperature of continental sub-surface "//nb_tersrf(1)//" layer "//nb_soil(3),"K", (/ ('', i=1, 10) /)),  &
     656    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(1)//"_l"//nb_soil(4),  &
     657    "Soil temperature of continental sub-surface "//nb_tersrf(1)//" layer "//nb_soil(4),"K", (/ ('', i=1, 10) /)),  &
     658    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(1)//"_l"//nb_soil(5),  &
     659    "Soil temperature of continental sub-surface "//nb_tersrf(1)//" layer "//nb_soil(5),"K", (/ ('', i=1, 10) /)),  &
     660    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(1)//"_l"//nb_soil(6),  &
     661    "Soil temperature of continental sub-surface "//nb_tersrf(1)//" layer "//nb_soil(6),"K", (/ ('', i=1, 10) /)),  &
     662    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(1)//"_l"//nb_soil(7),  &
     663    "Soil temperature of continental sub-surface "//nb_tersrf(1)//" layer "//nb_soil(7),"K", (/ ('', i=1, 10) /)),  &
     664    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(1)//"_l"//nb_soil(8),  &
     665    "Soil temperature of continental sub-surface "//nb_tersrf(1)//" layer "//nb_soil(8),"K", (/ ('', i=1, 10) /)),  &
     666    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(1)//"_l"//nb_soil(9),  &
     667    "Soil temperature of continental sub-surface "//nb_tersrf(1)//" layer "//nb_soil(9),"K", (/ ('', i=1, 10) /)),  &
     668    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(1)//"_l"//nb_soil(10),  &
     669    "Soil temperature of continental sub-surface "//nb_tersrf(1)//" layer "//nb_soil(10),"K", (/ ('', i=1, 10) /)),  &
     670    !ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(1)//"_l"//nb_soil(11),  &
     671    !"Soil temperature of continental sub-surface "//nb_tersrf(1)//" layer "//nb_soil(11),"K", (/ ('', i=1, 10) /)),  &
     672    !ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(1)//"_l"//nb_soil(12),  &
     673    !"Soil temperature of continental sub-surface "//nb_tersrf(1)//" layer "//nb_soil(12),"K", (/ ('', i=1, 10) /)),  &
     674    !ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(1)//"_l"//nb_soil(13),  &
     675    !"Soil temperature of continental sub-surface "//nb_tersrf(1)//" layer "//nb_soil(13),"K", (/ ('', i=1, 10) /)),  &
     676    !ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(1)//"_l"//nb_soil(14),  &
     677    !"Soil temperature of continental sub-surface "//nb_tersrf(1)//" layer "//nb_soil(14),"K", (/ ('', i=1, 10) /)),  &
     678    !
     679    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(2)//"_l"//nb_soil(1),  &
     680    "Soil temperature of continental sub-surface "//nb_tersrf(2)//" layer "//nb_soil(1),"K", (/ ('', i=1, 10) /)),  &
     681    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(2)//"_l"//nb_soil(2),  &
     682    "Soil temperature of continental sub-surface "//nb_tersrf(2)//" layer "//nb_soil(2),"K", (/ ('', i=1, 10) /)),  &
     683    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(2)//"_l"//nb_soil(3),  &
     684    "Soil temperature of continental sub-surface "//nb_tersrf(2)//" layer "//nb_soil(3),"K", (/ ('', i=1, 10) /)),  &
     685    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(2)//"_l"//nb_soil(4),  &
     686    "Soil temperature of continental sub-surface "//nb_tersrf(2)//" layer "//nb_soil(4),"K", (/ ('', i=1, 10) /)),  &
     687    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(2)//"_l"//nb_soil(5),  &
     688    "Soil temperature of continental sub-surface "//nb_tersrf(2)//" layer "//nb_soil(5),"K", (/ ('', i=1, 10) /)),  &
     689    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(2)//"_l"//nb_soil(6),  &
     690    "Soil temperature of continental sub-surface "//nb_tersrf(2)//" layer "//nb_soil(6),"K", (/ ('', i=1, 10) /)),  &
     691    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(2)//"_l"//nb_soil(7),  &
     692    "Soil temperature of continental sub-surface "//nb_tersrf(2)//" layer "//nb_soil(7),"K", (/ ('', i=1, 10) /)),  &
     693    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(2)//"_l"//nb_soil(8),  &
     694    "Soil temperature of continental sub-surface "//nb_tersrf(2)//" layer "//nb_soil(8),"K", (/ ('', i=1, 10) /)),  &
     695    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(2)//"_l"//nb_soil(9),  &
     696    "Soil temperature of continental sub-surface "//nb_tersrf(2)//" layer "//nb_soil(9),"K", (/ ('', i=1, 10) /)),  &
     697    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(2)//"_l"//nb_soil(10),  &
     698    "Soil temperature of continental sub-surface "//nb_tersrf(2)//" layer "//nb_soil(10),"K", (/ ('', i=1, 10) /)),  &
     699    !ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(2)//"_l"//nb_soil(11),  &
     700    !"Soil temperature of continental sub-surface "//nb_tersrf(2)//" layer "//nb_soil(11),"K", (/ ('', i=1, 10) /)),  &
     701    !ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(2)//"_l"//nb_soil(12),  &
     702    !"Soil temperature of continental sub-surface "//nb_tersrf(2)//" layer "//nb_soil(12),"K", (/ ('', i=1, 10) /)),  &
     703    !ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(2)//"_l"//nb_soil(13),  &
     704    !"Soil temperature of continental sub-surface "//nb_tersrf(2)//" layer "//nb_soil(13),"K", (/ ('', i=1, 10) /)),  &
     705    !ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(2)//"_l"//nb_soil(14),  &
     706    !"Soil temperature of continental sub-surface "//nb_tersrf(2)//" layer "//nb_soil(14),"K", (/ ('', i=1, 10) /)),  &
     707    !
     708    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(3)//"_l"//nb_soil(1),  &
     709    "Soil temperature of continental sub-surface "//nb_tersrf(3)//" layer "//nb_soil(1),"K", (/ ('', i=1, 10) /)),  &
     710    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(3)//"_l"//nb_soil(2),  &
     711    "Soil temperature of continental sub-surface "//nb_tersrf(3)//" layer "//nb_soil(2),"K", (/ ('', i=1, 10) /)),  &
     712    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(3)//"_l"//nb_soil(3),  &
     713    "Soil temperature of continental sub-surface "//nb_tersrf(3)//" layer "//nb_soil(3),"K", (/ ('', i=1, 10) /)),  &
     714    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(3)//"_l"//nb_soil(4),  &
     715    "Soil temperature of continental sub-surface "//nb_tersrf(3)//" layer "//nb_soil(4),"K", (/ ('', i=1, 10) /)),  &
     716    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(3)//"_l"//nb_soil(5),  &
     717    "Soil temperature of continental sub-surface "//nb_tersrf(3)//" layer "//nb_soil(5),"K", (/ ('', i=1, 10) /)),  &
     718    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(3)//"_l"//nb_soil(6),  &
     719    "Soil temperature of continental sub-surface "//nb_tersrf(3)//" layer "//nb_soil(6),"K", (/ ('', i=1, 10) /)),  &
     720    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(1)//"_l"//nb_soil(7),  &
     721    "Soil temperature of continental sub-surface "//nb_tersrf(3)//" layer "//nb_soil(7),"K", (/ ('', i=1, 10) /)),  &
     722    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(3)//"_l"//nb_soil(8),  &
     723    "Soil temperature of continental sub-surface "//nb_tersrf(3)//" layer "//nb_soil(8),"K", (/ ('', i=1, 10) /)),  &
     724    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(3)//"_l"//nb_soil(9),  &
     725    "Soil temperature of continental sub-surface "//nb_tersrf(3)//" layer "//nb_soil(9),"K", (/ ('', i=1, 10) /)),  &
     726    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(3)//"_l"//nb_soil(10),  &
     727    "Soil temperature of continental sub-surface "//nb_tersrf(3)//" layer "//nb_soil(10),"K", (/ ('', i=1, 10) /)),  &
     728    !ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(3)//"_l"//nb_soil(11),  &
     729    !"Soil temperature of continental sub-surface "//nb_tersrf(3)//" layer "//nb_soil(11),"K", (/ ('', i=1, 10) /)),  &
     730    !ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(3)//"_l"//nb_soil(12),  &
     731    !"Soil temperature of continental sub-surface "//nb_tersrf(3)//" layer "//nb_soil(12),"K", (/ ('', i=1, 10) /)),  &
     732    !ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(3)//"_l"//nb_soil(13),  &
     733    !"Soil temperature of continental sub-surface "//nb_tersrf(3)//" layer "//nb_soil(13),"K", (/ ('', i=1, 10) /)),  &
     734    !ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(3)//"_l"//nb_soil(14),  &
     735    !"Soil temperature of continental sub-surface "//nb_tersrf(3)//" layer "//nb_soil(14),"K", (/ ('', i=1, 10) /)),  &
     736    !
     737    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(4)//"_l"//nb_soil(1),  &
     738    "Soil temperature of continental sub-surface "//nb_tersrf(4)//" layer "//nb_soil(1),"K", (/ ('', i=1, 10) /)),  &
     739    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(4)//"_l"//nb_soil(2),  &
     740    "Soil temperature of continental sub-surface "//nb_tersrf(4)//" layer "//nb_soil(2),"K", (/ ('', i=1, 10) /)),  &
     741    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(4)//"_l"//nb_soil(3),  &
     742    "Soil temperature of continental sub-surface "//nb_tersrf(4)//" layer "//nb_soil(3),"K", (/ ('', i=1, 10) /)),  &
     743    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(4)//"_l"//nb_soil(4),  &
     744    "Soil temperature of continental sub-surface "//nb_tersrf(4)//" layer "//nb_soil(4),"K", (/ ('', i=1, 10) /)),  &
     745    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(4)//"_l"//nb_soil(5),  &
     746    "Soil temperature of continental sub-surface "//nb_tersrf(4)//" layer "//nb_soil(5),"K", (/ ('', i=1, 10) /)),  &
     747    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(4)//"_l"//nb_soil(6),  &
     748    "Soil temperature of continental sub-surface "//nb_tersrf(4)//" layer "//nb_soil(6),"K", (/ ('', i=1, 10) /)),  &
     749    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(4)//"_l"//nb_soil(7),  &
     750    "Soil temperature of continental sub-surface "//nb_tersrf(4)//" layer "//nb_soil(7),"K", (/ ('', i=1, 10) /)),  &
     751    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(4)//"_l"//nb_soil(8),  &
     752    "Soil temperature of continental sub-surface "//nb_tersrf(4)//" layer "//nb_soil(8),"K", (/ ('', i=1, 10) /)),  &
     753    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(4)//"_l"//nb_soil(9),  &
     754    "Soil temperature of continental sub-surface "//nb_tersrf(4)//" layer "//nb_soil(9),"K", (/ ('', i=1, 10) /)),  &
     755    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(4)//"_l"//nb_soil(10),  &
     756    "Soil temperature of continental sub-surface "//nb_tersrf(4)//" layer "//nb_soil(10),"K", (/ ('', i=1, 10) /)),  &
     757    !ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(4)//"_l"//nb_soil(11),  &
     758    !"Soil temperature of continental sub-surface "//nb_tersrf(4)//" layer "//nb_soil(11),"K", (/ ('', i=1, 10) /)),  &
     759    !ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(4)//"_l"//nb_soil(12),  &
     760    !"Soil temperature of continental sub-surface "//nb_tersrf(4)//" layer "//nb_soil(12),"K", (/ ('', i=1, 10) /)),  &
     761    !ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(4)//"_l"//nb_soil(13),  &
     762    !"Soil temperature of continental sub-surface "//nb_tersrf(4)//" layer "//nb_soil(13),"K", (/ ('', i=1, 10) /)),  &
     763    !ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(4)//"_l"//nb_soil(14),  &
     764    !"Soil temperature of continental sub-surface "//nb_tersrf(4)//" layer "//nb_soil(14),"K", (/ ('', i=1, 10) /)),  &
     765    !
     766    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(5)//"_l"//nb_soil(1),  &
     767    "Soil temperature of continental sub-surface "//nb_tersrf(5)//" layer "//nb_soil(1),"K", (/ ('', i=1, 10) /)),  &
     768    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(5)//"_l"//nb_soil(2),  &
     769    "Soil temperature of continental sub-surface "//nb_tersrf(5)//" layer "//nb_soil(2),"K", (/ ('', i=1, 10) /)),  &
     770    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(5)//"_l"//nb_soil(3),  &
     771    "Soil temperature of continental sub-surface "//nb_tersrf(5)//" layer "//nb_soil(3),"K", (/ ('', i=1, 10) /)),  &
     772    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(5)//"_l"//nb_soil(4),  &
     773    "Soil temperature of continental sub-surface "//nb_tersrf(5)//" layer "//nb_soil(4),"K", (/ ('', i=1, 10) /)),  &
     774    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(5)//"_l"//nb_soil(5),  &
     775    "Soil temperature of continental sub-surface "//nb_tersrf(5)//" layer "//nb_soil(5),"K", (/ ('', i=1, 10) /)),  &
     776    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(5)//"_l"//nb_soil(6),  &
     777    "Soil temperature of continental sub-surface "//nb_tersrf(5)//" layer "//nb_soil(6),"K", (/ ('', i=1, 10) /)),  &
     778    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(5)//"_l"//nb_soil(7),  &
     779    "Soil temperature of continental sub-surface "//nb_tersrf(5)//" layer "//nb_soil(7),"K", (/ ('', i=1, 10) /)),  &
     780    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(5)//"_l"//nb_soil(8),  &
     781    "Soil temperature of continental sub-surface "//nb_tersrf(5)//" layer "//nb_soil(8),"K", (/ ('', i=1, 10) /)),  &
     782    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(5)//"_l"//nb_soil(9),  &
     783    "Soil temperature of continental sub-surface "//nb_tersrf(5)//" layer "//nb_soil(9),"K", (/ ('', i=1, 10) /)),  &
     784    ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(5)//"_l"//nb_soil(10),  &
     785    "Soil temperature of continental sub-surface "//nb_tersrf(5)//" layer "//nb_soil(10),"K", (/ ('', i=1, 10) /)) /)
     786    !ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(5)//"_l"//nb_soil(11),  &
     787    !"Soil temperature of continental sub-surface "//nb_tersrf(5)//" layer "//nb_soil(11),"K", (/ ('', i=1, 10) /)),  &
     788    !ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(5)//"_l"//nb_soil(12),  &
     789    !"Soil temperature of continental sub-surface "//nb_tersrf(5)//" layer "//nb_soil(12),"K", (/ ('', i=1, 10) /)),  &
     790    !ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(5)//"_l"//nb_soil(13),  &
     791    !"Soil temperature of continental sub-surface "//nb_tersrf(5)//" layer "//nb_soil(13),"K", (/ ('', i=1, 10) /)),  &
     792    !ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/),'tsoil_tersrf'//nb_tersrf(5)//"_l"//nb_soil(14),  &
     793    !"Soil temperature of continental sub-surface "//nb_tersrf(5)//" layer "//nb_soil(14),"K", (/ ('', i=1, 10) /)) /)
     794
     795  TYPE(ctrl_out), SAVE, DIMENSION(nsoilout) :: o_ftsoil = (/ &
     796    ctrl_out((/ 1, 2, 10, 10, 10, 10, 11, 11, 11, 11/), 'tsoil'//nb_soil(1), &
     797    'Continental soil temperature layer '//nb_soil(1), 'K', (/ ('', i=1, 10) /)), &
     798    ctrl_out((/ 1, 2, 10, 10, 10, 10, 11, 11, 11, 11/), 'tsoil'//nb_soil(2), &
     799    'Continental soil temperature layer '//nb_soil(2), 'K', (/ ('', i=1, 10) /)), &
     800    ctrl_out((/ 1, 2, 10, 10, 10, 10, 11, 11, 11, 11/), 'tsoil'//nb_soil(3), &
     801    'Continental soil temperature layer '//nb_soil(3), 'K', (/ ('', i=1, 10) /)), &
     802    ctrl_out((/ 1, 2, 10, 10, 10, 10, 11, 11, 11, 11/), 'tsoil'//nb_soil(4), &
     803    'Continental soil temperature layer '//nb_soil(4), 'K', (/ ('', i=1, 10) /)), &
     804    ctrl_out((/ 1, 2, 10, 10, 10, 10, 11, 11, 11, 11/), 'tsoil'//nb_soil(5), &
     805    'Continental soil temperature layer '//nb_soil(5), 'K', (/ ('', i=1, 10) /)), &
     806    ctrl_out((/ 1, 2, 10, 10, 10, 10, 11, 11, 11, 11/), 'tsoil'//nb_soil(6), &
     807    'Continental soil temperature layer '//nb_soil(6), 'K', (/ ('', i=1, 10) /)), &
     808    ctrl_out((/ 1, 2, 10, 10, 10, 10, 11, 11, 11, 11/), 'tsoil'//nb_soil(7), &
     809    'Continental soil temperature layer '//nb_soil(7), 'K', (/ ('', i=1, 10) /)), &
     810    ctrl_out((/ 1, 2, 10, 10, 10, 10, 11, 11, 11, 11/), 'tsoil'//nb_soil(8), &
     811    'Continental soil temperature layer '//nb_soil(8), 'K', (/ ('', i=1, 10) /)), &
     812    ctrl_out((/ 1, 2, 10, 10, 10, 10, 11, 11, 11, 11/), 'tsoil'//nb_soil(9), &
     813    'Continental soil temperature layer '//nb_soil(9), 'K', (/ ('', i=1, 10) /)), &
     814    ctrl_out((/ 1, 2, 10, 10, 10, 10, 11, 11, 11, 11/), 'tsoil'//nb_soil(10), &
     815    'Continental soil temperature layer '//nb_soil(10), 'K', (/ ('', i=1, 10) /)) /)
     816    !ctrl_out((/ 1, 2, 10, 10, 10, 10, 11, 11, 11, 11/), 'tsoil'//nb_soil(11), &
     817    !'Continental soil temperature layer '//nb_soil(11), 'K', (/ ('', i=1, 10) /)), &
     818    !ctrl_out((/ 1, 2, 10, 10, 10, 10, 11, 11, 11, 11/), 'tsoil'//nb_soil(12), &
     819    !'Continental soil temperature layer '//nb_soil(12), 'K', (/ ('', i=1, 10) /)), &
     820    !ctrl_out((/ 1, 2, 10, 10, 10, 10, 11, 11, 11, 11/), 'tsoil'//nb_soil(13), &
     821    !'Continental soil temperature layer '//nb_soil(13), 'K', (/ ('', i=1, 10) /)), &
     822    !ctrl_out((/ 1, 2, 10, 10, 10, 10, 11, 11, 11, 11/), 'tsoil'//nb_soil(14), &
     823    !'Continental soil temperature layer '//nb_soil(14), 'K', (/ ('', i=1, 10) /)) /)
     824! AM
    540825
    541826!AI Ecrad 3Deffect
    … …  
    14471732
    14481733!--extinction coefficient
     1734  TYPE(ctrl_out), SAVE :: o_ext_strat_443 = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 1/), &
     1735    'ext_strat_443', 'Strat. aerosol extinction coefficient at 443 nm', '1/m', (/ ('', i=1, 10) /))
    14491736  TYPE(ctrl_out), SAVE :: o_ext_strat_550 = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 1/), &
    14501737    'ext_strat_550', 'Strat. aerosol extinction coefficient at 550 nm', '1/m', (/ ('', i=1, 10) /))
     1738  TYPE(ctrl_out), SAVE :: o_ext_strat_670 = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 1/), &
     1739    'ext_strat_670', 'Strat. aerosol extinction coefficient at 670 nm', '1/m', (/ ('', i=1, 10) /))
     1740  TYPE(ctrl_out), SAVE :: o_ext_strat_765 = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 1/), &
     1741    'ext_strat_765', 'Strat. aerosol extinction coefficient at 765 nm', '1/m', (/ ('', i=1, 10) /))
    14511742  TYPE(ctrl_out), SAVE :: o_ext_strat_1020 = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 1/), &
    14521743    'ext_strat_1020', 'Strat. aerosol extinction coefficient at 1020 nm', '1/m', (/ ('', i=1, 10) /))
     1744  TYPE(ctrl_out), SAVE :: o_ext_strat_10um = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 1/), &
     1745    'ext_strat_10um', 'Strat. aerosol extinction coefficient at 10 um', '1/m', (/ ('', i=1, 10) /))
    14531746!--strat aerosol optical depth
     1747  TYPE(ctrl_out), SAVE :: o_tau_strat_443 = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 1/), &
     1748    'OD443_strat_only', 'Stratospheric Aerosol Optical depth at 443 nm ', '1', (/ ('', i=1, 10) /))
    14541749  TYPE(ctrl_out), SAVE :: o_tau_strat_550 = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 1/), &
    14551750    'OD550_strat_only', 'Stratospheric Aerosol Optical depth at 550 nm ', '1', (/ ('', i=1, 10) /))
     1751  TYPE(ctrl_out), SAVE :: o_tau_strat_670 = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 1/), &
     1752    'OD670_strat_only', 'Stratospheric Aerosol Optical depth at 670 nm ', '1', (/ ('', i=1, 10) /))
     1753  TYPE(ctrl_out), SAVE :: o_tau_strat_765 = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 1/), &
     1754    'OD765_strat_only', 'Stratospheric Aerosol Optical depth at 765 nm ', '1', (/ ('', i=1, 10) /))
    14561755  TYPE(ctrl_out), SAVE :: o_tau_strat_1020 = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 1/), &
    14571756    'OD1020_strat_only', 'Stratospheric Aerosol Optical depth at 1020 nm ', '1', (/ ('', i=1, 10) /))
     1757  TYPE(ctrl_out), SAVE :: o_tau_strat_10um = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 1/), &
     1758    'OD10um_strat_only', 'Stratospheric Aerosol Optical depth at 10 um ', '1', (/ ('', i=1, 10) /))
    14581759  TYPE(ctrl_out), SAVE :: o_SAD_sulfate = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 1/), &
    14591760    'SAD_sulfate', 'SAD WET sulfate aerosols', 'cm2/cm3', (/ ('', i=1, 10) /))
    … …  
    14671768  TYPE(ctrl_out), SAVE :: o_R2SO4 = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 1/), &
    14681769    'R2SO4', 'H2SO4 mass fraction in aerosol', '%', (/ ('', i=1, 10) /))
     1770  TYPE(ctrl_out), SAVE :: o_SO2_chlm = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 1/), &
     1771    'SO2_CHLM', 'SO2 chemical loss rate', 'part/cm3/s', (/ ('', i=1, 10) /))
    14691772  TYPE(ctrl_out), SAVE :: o_OCS_lifetime = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 1/), &
    14701773    'OCS_lifetime', 'OCS lifetime', 's', (/ ('', i=1, 10) /))
    … …  
    15741877  TYPE(ctrl_out), SAVE :: o_rneb = ctrl_out((/ 2, 5, 10, 10, 10, 10, 11, 11, 11, 11/), &
    15751878    'rneb', 'Cloud fraction', '-', (/ ('', i=1, 10) /))
     1879  TYPE(ctrl_out), SAVE :: o_distcltop = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), &
     1880    'distcltop', 'Distance from cloud top', 'm', (/ ('', i=1, 10) /))
     1881  TYPE(ctrl_out), SAVE :: o_tempcltop = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), &
     1882    'tempcltop', 'Cloud top temperature', 'K', (/ ('', i=1, 10) /))
    15761883  TYPE(ctrl_out), SAVE :: o_cldfraliq = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), &
    1577     'cldfraliq', 'Liquid fraction of the cloud', '-', (/ ('', i=1, 10) /))
     1884    'cldfraliq', 'Liquid fraction of the cloud part of the mesh', '-', (/ ('', i=1, 10) /))
    15781885  TYPE(ctrl_out), SAVE :: o_sigma2_icefracturb = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), &
    15791886    'sigma2_icefracturb', 'Variance of the diagnostic supersaturation distribution (icefrac_turb) [-]', '-', (/ ('', i=1, 10) /))
    15801887  TYPE(ctrl_out), SAVE :: o_mean_icefracturb = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), &
    15811888    'mean_icefracturb', 'Mean of the diagnostic supersaturation distribution (icefrac_turb) [-]', '-', (/ ('', i=1, 10) /))
    1582  
     1889   TYPE(ctrl_out), SAVE :: o_cldfraliqth = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), &
     1890    'cldfraliqth', 'Liquid fraction of clouds in thermals', '-', (/ ('', i=1, 10) /))
     1891  TYPE(ctrl_out), SAVE :: o_sigma2_icefracturbth = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), &
     1892    'sigma2_icefracturbth', 'Variance of the diagnostic supersaturation distribution in thermals (icefrac_turb) [-]', '-', (/ ('', i=1, 10) /))
     1893  TYPE(ctrl_out), SAVE :: o_mean_icefracturbth = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 11/), &
     1894    'mean_icefracturbth', 'Mean of the diagnostic supersaturation distribution in thermals (icefrac_turb) [-]', '-', (/ ('', i=1, 10) /))
    15831895  TYPE(ctrl_out), SAVE :: o_rnebjn = ctrl_out((/ 2, 5, 10, 10, 10, 10, 11, 11,11, 11/), &     
    15841896    'rnebjn', 'Cloud fraction in day', '-', (/ ('', i=1, 10) /))

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

    r5641 r5717  
    2525    ! defined and initialised in phys_output_mod.F90
    2626
    27     USE dimphy, ONLY: klon, klev, klevp1
     27    USE dimphy, ONLY: klon, klev, klevp1, nbtersrf
    2828    USE infotrac_phy, ONLY: nbtr, nqtot, nqo, type_trac, tracers, niso, ntiso
    2929    USE strings_mod,  ONLY: maxlen
    … …  
    6565         o_bils_ec,o_bils_ech, o_bils_tke, o_bils_kinetic, &
    6666         o_bils_latent, o_bils_enthalp, o_sens, &
    67          o_fder, o_ffonte, o_fqcalving, o_fqfonte, o_mrroli, o_runofflic, &
     67         o_fder, o_ftsoil, o_ffonte, o_fqcalving, o_fqfonte, o_mrroli, o_runofflic, &
    6868         o_taux, o_tauy, o_snowsrf, o_qsnow, &
    6969! SN runoff_diag
    … …  
    145145         o_zfull, o_zhalf, o_rneb, o_rnebjn, o_rnebcon, &
    146146         o_rnebls, o_rneblsvol, o_rhum, o_rhl, o_rhi, o_ozone, o_ozone_light, &
     147         o_distcltop, o_tempcltop,  &
    147148         o_pfraclr, o_pfracld, o_cldfraliq, o_sigma2_icefracturb, o_mean_icefracturb,  &
     149         o_cldfraliqth, o_sigma2_icefracturbth, o_mean_icefracturbth,  &
    148150         o_qrainlsc, o_qsnowlsc, o_dqreva, o_dqrauto, o_dqrcol, o_dqrmelt, o_dqrfreez, &
    149151         o_dqssub, o_dqsauto, o_dqsagg, o_dqsrim, o_dqsmelt, o_dqsfreez, &
    … …  
    202204         o_lat_prec_sol_oce, o_lat_prec_sol_sic, &
    203205         o_sza, &
     206! AM
     207         o_frac_tersrf, o_qsurf_tersrf, o_tsurf_new_tersrf, &
     208         o_cdragm_tersrf, o_cdragh_tersrf, &
     209         o_swnet_tersrf, o_lwnet_tersrf, o_fluxsens_tersrf, o_fluxlat_tersrf, &
     210         o_tsoil_tersrf, &
    204211! Marine
    205212         o_map_prop_hc, o_map_prop_hist, o_map_emis_hc, o_map_iwp_hc, &
    … …  
    275282         o_budg_emi_ocs, o_budg_emi_so2, o_budg_emi_h2so4, o_budg_emi_part, &
    276283         o_budg_ocs_to_so2, o_budg_so2_to_h2so4, o_budg_h2so4_to_part, &
    277          o_surf_PM25_sulf, o_ext_strat_550, o_tau_strat_550, &
    278          o_vsed_aer, o_tau_strat_1020, o_ext_strat_1020, o_f_r_wet, &
    279          o_SAD_sulfate, o_reff_sulfate, o_sulfmmr, o_nd_mode, o_sulfmmr_mode
    280 
    281     USE lmdz_lscp_ini, ONLY: ok_poprecip, ok_ice_sedim
     284         o_surf_PM25_sulf, o_ext_strat_443, o_tau_strat_443, o_ext_strat_550, o_tau_strat_550, &
     285         o_ext_strat_670, o_tau_strat_670, o_ext_strat_765, o_tau_strat_765, o_vsed_aer, &
     286         o_tau_strat_1020, o_ext_strat_1020, o_tau_strat_10um, o_ext_strat_10um, o_f_r_wet, &
     287         o_SAD_sulfate, o_reff_sulfate, o_sulfmmr, o_nd_mode, o_sulfmmr_mode,o_SO2_chlm
     288
     289    USE lmdz_lscp_ini, ONLY: ok_poprecip, iflag_icefrac, ok_ice_sedim
    282290
    283291    USE phys_output_ctrlout_mod, ONLY: o_heat_volc, o_cool_volc !NL
    … …  
    311319         rhlevSTD, O3STD, O3daySTD, uvSTD, vqSTD, vTSTD, wqSTD, vphiSTD, &
    312320         wTSTD, u2STD, v2STD, T2STD, missing_val_nf90, delta_sal, ds_ns, &
     321         frac_tersrf, qsurf_tersrf, tsurf_new_tersrf, cdragm_tersrf, cdragh_tersrf, &
     322         swnet_tersrf, lwnet_tersrf, fluxsens_tersrf, fluxlat_tersrf, tsoil_tersrf, &
    313323#ifdef ISO
    314324         xtrain_con, xtsnow_con, xtrain_fall, xtsnow_fall, fxtevap, &
    … …  
    397407         zphi, u_seri, v_seri, omega, cldfra, &
    398408         rneb, rnebjn, rneblsvol,  &
    399          zx_rh, zx_rhl, zx_rhi, &
     409         zx_rh, zx_rhl, zx_rhi, distcltop, temp_cltop, &
    400410         pfraclr, pfracld, cldfraliq, sigma2_icefracturb, mean_icefracturb, &
     411         cldfraliqth, sigma2_icefracturbth, mean_icefracturbth, &
    401412         qraindiag, qsnowdiag, dqreva, dqssub, &
    402413         dqrauto,dqrcol,dqrmelt,dqrfreez, &
    … …  
    446457         budg_emi_ocs, budg_emi_so2, budg_emi_h2so4, budg_emi_part, &
    447458         budg_ocs_to_so2, budg_so2_to_h2so4, budg_h2so4_to_part, &
    448          surf_PM25_sulf, tau_strat_550, tausum_strat, &
    449          vsed_aer, tau_strat_1020, f_r_wet, &
    450          SAD_sulfate, reff_sulfate, sulfmmr, nd_mode, sulfmmr_mode
     459         surf_PM25_sulf,  tau_strat_443, tau_strat_550, tau_strat_670, tau_strat_765, &
     460         tausum_strat, vsed_aer, tau_strat_1020, tau_strat_10um, f_r_wet, &
     461         SAD_sulfate, reff_sulfate, sulfmmr, nd_mode, sulfmmr_mode, SO2_chlm
    451462
    452463    USE carbon_cycle_mod, ONLY: fco2_ff, fco2_bb, fco2_land, fco2_ocean
    … …  
    477488    USE ocean_slab_mod, ONLY: nslay, tslab, slab_bilg, tice, seaice, &
    478489        slab_ekman,slab_hdiff,slab_gm,dt_ekman, dt_hdiff, dt_gm, dt_qflux
    479     USE pbl_surface_mod, ONLY: snow
    480     USE indice_sol_mod, ONLY: nbsrf
     490    USE pbl_surface_mod, ONLY: snow, ftsoil
     491    USE indice_sol_mod, ONLY: nbsrf, nsoilout
    481492#ifdef ISO
    482493    USE isotopes_mod, ONLY: iso_HTO, isoName
    … …  
    536547    ! Local
    537548    INTEGER :: itau_w
    538     INTEGER :: i, iinit, iinitend=1, iff, iq, nsrf, k, ll, naero
     549    INTEGER :: i, iinit, iinitend=1, iff, iq, nsrf, k, ll, naero, j
    539550    REAL, DIMENSION (klon) :: zx_tmp_fi2d, zpt_conv2d, wind100m
    540551    REAL, DIMENSION (klon,klev) :: zx_tmp_fi3d, zpt_conv
    … …  
    962973       CALL histwrite_phy(o_topl, toplw)
    963974       CALL histwrite_phy(o_topl0, toplw0)
     975
     976       !AM heterogeneous continental sub-surfaces
     977       IF (iflag_hetero_surf .EQ. 2) THEN
     978         iq = 0
     979         DO j = 1, nbtersrf
     980           IF (vars_defined) zx_tmp_fi2d(1 : klon) = frac_tersrf( 1 : klon, j)
     981           CALL histwrite_phy(o_frac_tersrf(j), zx_tmp_fi2d)
     982           IF (vars_defined) zx_tmp_fi2d(1 : klon) = qsurf_tersrf( 1 : klon, j)
     983           CALL histwrite_phy(o_qsurf_tersrf(j), zx_tmp_fi2d)
     984           IF (vars_defined) zx_tmp_fi2d(1 : klon) = tsurf_new_tersrf( 1 : klon, j)
     985           CALL histwrite_phy(o_tsurf_new_tersrf(j), zx_tmp_fi2d)
     986           IF (vars_defined) zx_tmp_fi2d(1 : klon) = cdragm_tersrf( 1 : klon, j)
     987           CALL histwrite_phy(o_cdragm_tersrf(j), zx_tmp_fi2d)
     988           IF (vars_defined) zx_tmp_fi2d(1 : klon) = cdragh_tersrf( 1 : klon, j)
     989           CALL histwrite_phy(o_cdragh_tersrf(j), zx_tmp_fi2d)
     990           IF (vars_defined) zx_tmp_fi2d(1 : klon) = swnet_tersrf( 1 : klon, j)
     991           CALL histwrite_phy(o_swnet_tersrf(j), zx_tmp_fi2d)
     992           IF (vars_defined) zx_tmp_fi2d(1 : klon) = lwnet_tersrf( 1 : klon, j)
     993           CALL histwrite_phy(o_lwnet_tersrf(j), zx_tmp_fi2d)
     994           IF (vars_defined) zx_tmp_fi2d(1 : klon) = fluxsens_tersrf( 1 : klon, j)
     995           CALL histwrite_phy(o_fluxsens_tersrf(j), zx_tmp_fi2d)
     996           IF (vars_defined) zx_tmp_fi2d(1 : klon) = fluxlat_tersrf( 1 : klon, j)
     997           CALL histwrite_phy(o_fluxlat_tersrf(j), zx_tmp_fi2d)
     998           !
     999           DO k = 1, nsoilout
     1000             iq = iq + 1
     1001             IF (vars_defined) zx_tmp_fi2d(1 : klon) = tsoil_tersrf( 1 : klon, k, j)
     1002             CALL histwrite_phy(o_tsoil_tersrf(iq), zx_tmp_fi2d)
     1003           ENDDO
     1004         ENDDO
     1005       ENDIF
     1006       ! add tsoil as output
     1007       IF (iflag_hetero_surf .GT. 0) THEN
     1008         DO k = 1, nsoilout
     1009           IF (vars_defined) zx_tmp_fi2d(1 : klon) = ftsoil( 1 : klon, k, is_ter)
     1010           CALL histwrite_phy(o_ftsoil(k), zx_tmp_fi2d)
     1011         ENDDO
     1012       ENDIF
     1013       !AM
    9641014
    9651015! offline
    … …  
    18931943          CALL histwrite_phy(o_vsed_aer, vsed_aer)
    18941944          CALL histwrite_phy(o_f_r_wet, f_r_wet)
     1945          CALL histwrite_phy(o_SO2_chlm, SO2_chlm)
     1946          CALL histwrite_phy(o_ext_strat_443, tau_strat_443)
    18951947          CALL histwrite_phy(o_ext_strat_550, tau_strat_550)
     1948          CALL histwrite_phy(o_ext_strat_670, tau_strat_670)
     1949          CALL histwrite_phy(o_ext_strat_765, tau_strat_765)
    18961950          CALL histwrite_phy(o_ext_strat_1020, tau_strat_1020)
    1897           CALL histwrite_phy(o_tau_strat_550, tausum_strat(:,1))
    1898           CALL histwrite_phy(o_tau_strat_1020, tausum_strat(:,2))
     1951          CALL histwrite_phy(o_ext_strat_10um, tau_strat_10um)
     1952          CALL histwrite_phy(o_tau_strat_443, tausum_strat(:,1))
     1953          CALL histwrite_phy(o_tau_strat_550, tausum_strat(:,2))
     1954          CALL histwrite_phy(o_tau_strat_670, tausum_strat(:,3))
     1955          CALL histwrite_phy(o_tau_strat_765, tausum_strat(:,4))
     1956          CALL histwrite_phy(o_tau_strat_1020, tausum_strat(:,5))
     1957          CALL histwrite_phy(o_tau_strat_10um, tausum_strat(:,6))
    18991958          CALL histwrite_phy(o_SAD_sulfate, SAD_sulfate)
    19001959          CALL histwrite_phy(o_reff_sulfate, reff_sulfate)
    … …  
    20992158           CALL histwrite_phy(o_pfraclr, pfraclr)
    21002159           CALL histwrite_phy(o_pfracld, pfracld)
     2160           IF (iflag_icefrac .GT. 0) THEN
    21012161           CALL histwrite_phy(o_cldfraliq, cldfraliq)
    21022162           CALL histwrite_phy(o_sigma2_icefracturb, sigma2_icefracturb)
    21032163           CALL histwrite_phy(o_mean_icefracturb, mean_icefracturb)
     2164           CALL histwrite_phy(o_cldfraliqth, cldfraliqth)
     2165           CALL histwrite_phy(o_sigma2_icefracturbth, sigma2_icefracturbth)
     2166           CALL histwrite_phy(o_mean_icefracturbth, mean_icefracturbth)
     2167           ELSE
     2168           CALL histwrite_phy(o_distcltop, distcltop)
     2169           CALL histwrite_phy(o_tempcltop, temp_cltop)
     2170           ENDIF
    21042171           IF (ok_poprecip) THEN
    21052172           CALL histwrite_phy(o_qrainlsc, qraindiag)

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

    r5641 r5717  
    1010! Declaration des variables
    1111      USE dimphy
     12      USE dimsoil_mod_h, ONLY: nsoilmx
    1213      USE netcdf, only: nf90_fill_real
    1314      INTEGER, PARAMETER :: nlevSTD=17
    … …  
    3940      REAL, ALLOCATABLE, SAVE :: treedrg(:,:,:)
    4041!$OMP THREADPRIVATE(treedrg)
     42!AM land surface heterogeneities
     43      REAL, SAVE :: alpha_soil_tersrf
     44!$OMP THREADPRIVATE(alpha_soil_tersrf)
     45      REAL, SAVE :: period_tersrf
     46!$OMP THREADPRIVATE(period_tersrf)
     47      REAL, ALLOCATABLE, SAVE :: frac_tersrf(:,:)
     48!$OMP THREADPRIVATE(frac_tersrf)
     49      REAL, ALLOCATABLE, SAVE :: z0m_tersrf(:,:)
     50!$OMP THREADPRIVATE(z0m_tersrf)
     51      REAL, ALLOCATABLE, SAVE :: ratio_z0m_z0h_tersrf(:,:)
     52!$OMP THREADPRIVATE(ratio_z0m_z0h_tersrf)
     53      REAL, ALLOCATABLE, SAVE :: albedo_tersrf(:,:)
     54!$OMP THREADPRIVATE(albedo_tersrf)
     55      REAL, ALLOCATABLE, SAVE :: beta_tersrf(:,:)
     56!$OMP THREADPRIVATE(beta_tersrf)
     57      REAL, ALLOCATABLE, SAVE :: inertie_tersrf(:,:)
     58!$OMP THREADPRIVATE(inertie_tersrf)
     59      REAL, ALLOCATABLE, SAVE :: hcond_tersrf(:,:)
     60!$OMP THREADPRIVATE(hcond_tersrf)
     61      REAL, ALLOCATABLE, SAVE :: tsurfi_tersrf(:,:)
     62!$OMP THREADPRIVATE(tsurfi_tersrf)
     63      REAL, ALLOCATABLE, SAVE :: tsoili_tersrf(:,:,:)
     64!$OMP THREADPRIVATE(tsoili_tersrf)
     65      REAL, ALLOCATABLE, SAVE :: tsoil_depth(:,:,:)
     66!$OMP THREADPRIVATE(tsoil_depth)
     67      REAL, ALLOCATABLE, SAVE :: tsurf_tersrf(:,:)
     68!$OMP THREADPRIVATE(tsurf_tersrf)
     69     REAL, ALLOCATABLE, SAVE :: tsoil_tersrf(:,:,:)
     70!$OMP THREADPRIVATE(tsoil_tersrf)
     71      REAL, ALLOCATABLE, SAVE :: qsurf_tersrf(:,:)
     72!$OMP THREADPRIVATE(qsurf_tersrf)
     73      REAL, ALLOCATABLE, SAVE :: tsurf_new_tersrf(:,:)
     74!$OMP THREADPRIVATE(tsurf_new_tersrf)
     75      REAL, ALLOCATABLE, SAVE :: cdragm_tersrf(:,:)
     76!$OMP THREADPRIVATE(cdragm_tersrf)
     77      REAL, ALLOCATABLE, SAVE :: cdragh_tersrf(:,:)
     78!$OMP THREADPRIVATE(cdragh_tersrf)
     79      REAL, ALLOCATABLE, SAVE :: swnet_tersrf(:,:)
     80!$OMP THREADPRIVATE(swnet_tersrf)
     81      REAL, ALLOCATABLE, SAVE :: lwnet_tersrf(:,:)
     82!$OMP THREADPRIVATE(lwnet_tersrf)
     83      REAL, ALLOCATABLE, SAVE :: fluxsens_tersrf(:,:)
     84!$OMP THREADPRIVATE(fluxsens_tersrf)
     85      REAL, ALLOCATABLE, SAVE :: fluxlat_tersrf(:,:)
     86!$OMP THREADPRIVATE(fluxlat_tersrf)
    4187
    4288!      character(len=6), SAVE :: ocean
    … …  
    570616!FC
    571617      ALLOCATE(treedrg(klon,klev,nbsrf))
     618!AM
     619      ALLOCATE(frac_tersrf(klon,nbtersrf))
     620      ALLOCATE(z0m_tersrf(klon,nbtersrf))
     621      ALLOCATE(ratio_z0m_z0h_tersrf(klon,nbtersrf))
     622      ALLOCATE(albedo_tersrf(klon,nbtersrf))
     623      ALLOCATE(beta_tersrf(klon,nbtersrf))
     624      ALLOCATE(inertie_tersrf(klon,nbtersrf))
     625      ALLOCATE(hcond_tersrf(klon,nbtersrf))
     626      ALLOCATE(tsurfi_tersrf(klon,nbtersrf))
     627      ALLOCATE(tsoili_tersrf(klon,nbtsoildepths,nbtersrf))
     628      ALLOCATE(tsoil_depth(klon,nbtsoildepths,nbtersrf))
     629      ALLOCATE(tsurf_tersrf(klon,nbtersrf))
     630      ALLOCATE(tsoil_tersrf(klon,nsoilmx,nbtersrf))
     631      ALLOCATE(qsurf_tersrf(klon,nbtersrf))
     632      ALLOCATE(tsurf_new_tersrf(klon,nbtersrf))
     633      ALLOCATE(cdragm_tersrf(klon,nbtersrf))
     634      ALLOCATE(cdragh_tersrf(klon,nbtersrf))
     635      ALLOCATE(swnet_tersrf(klon,nbtersrf))
     636      ALLOCATE(lwnet_tersrf(klon,nbtersrf))
     637      ALLOCATE(fluxsens_tersrf(klon,nbtersrf))
     638      ALLOCATE(fluxlat_tersrf(klon,nbtersrf))
     639
    572640      ALLOCATE(falb1(klon,nbsrf))
    573641      ALLOCATE(falb2(klon,nbsrf))
    … …  
    816884!FC
    817885      DEALLOCATE(treedrg)
     886!AM
     887      DEALLOCATE(frac_tersrf)
     888      DEALLOCATE(z0m_tersrf)
     889      DEALLOCATE(ratio_z0m_z0h_tersrf)
     890      DEALLOCATE(albedo_tersrf)
     891      DEALLOCATE(beta_tersrf)
     892      DEALLOCATE(inertie_tersrf)
     893      DEALLOCATE(hcond_tersrf)
     894      DEALLOCATE(tsurfi_tersrf)
     895      DEALLOCATE(tsoili_tersrf)
     896      DEALLOCATE(tsoil_depth)
     897      DEALLOCATE(tsurf_tersrf)
     898      DEALLOCATE(tsoil_tersrf)
     899      DEALLOCATE(qsurf_tersrf)
     900      DEALLOCATE(tsurf_new_tersrf)
     901      DEALLOCATE(cdragm_tersrf)
     902      DEALLOCATE(cdragh_tersrf)
     903      DEALLOCATE(swnet_tersrf)
     904      DEALLOCATE(lwnet_tersrf)
     905      DEALLOCATE(fluxsens_tersrf)
     906      DEALLOCATE(fluxlat_tersrf)
    818907      DEALLOCATE(rain_fall, snow_fall, bs_fall,solsw, solswfdiff, sollw, radsol, swradcorr)
    819908      DEALLOCATE(zmea, zstd, zsig, zgam)

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

    r5684 r5717  
    7777    USE lmdz_aviation, ONLY : init_read_aviation_emissions, read_aviation_emissions, &
    7878        aviation_water_emissions, vertical_interpolation_aviation
    79     USE lmdz_lscp, ONLY : lscp
     79    USE lmdz_lscp_main, ONLY : lscp
    8080    USE lmdz_call_cloud_optics_prop, ONLY : call_cloud_optics_prop
    8181    USE lmdz_lscp_old, ONLY : fisrtilp, fisrtilp_first
    … …  
    8383    USE calwake_mod, ONLY : calwake, calwake_first
    8484    USE lmdz_wake_ini, ONLY : wake_ini
    85     USE lmdz_surf_wind_ini, ONLY : surf_wind_ini, iflag_surf_wind
     85    USE lmdz_surf_wind_ini, ONLY : surf_wind_ini
    8686    USE lmdz_surf_wind, ONLY : surf_wind
    8787    USE yamada_ini_mod, ONLY : yamada_ini
    … …  
    157157       d_q_dyn2d,d_ql_dyn2d,d_qs_dyn2d,d_qbs_dyn2d, &
    158158       ! Physic tendencies
    159        d_t_con,d_q_con,d_q_con_zmasse,d_u_con,d_v_con, &
     159       d_t_con,d_q_con,d_u_con,d_v_con, &
     160       d_t_con_zmasse,d_q_con_zmasse,d_u_con_zmasse,d_v_con_zmasse, &       
    160161       d_tr, &                              !! to be removed?? (jyg)
    161162       d_t_wake,d_q_wake, &
    … …  
    325326       !
    326327       rneblsvol, &
    327        pfraclr, pfracld, cldfraliq, sigma2_icefracturb, mean_icefracturb,  &
     328       pfraclr, pfracld, &
     329       cldfraliq, sigma2_icefracturb, mean_icefracturb,  &
     330       cldfraliqth, sigma2_icefracturbth, mean_icefracturbth,  &
    328331       distcltop, temp_cltop,  &
    329332       !-- LSCP - condensation and ice supersaturation variables
    … …  
    469472    !cc      PARAMETER (soil_model=.FALSE.)
    470473    !======================================================================
    471     ! Dans les versions precedentes, l'eau liquide nuageuse utilisee dans
    472     ! le calcul du rayonnement est celle apres la precipitation des nuages.
    473     ! Si cette cle new_oliq est activee, ce sera une valeur moyenne entre
    474     ! la condensation et la precipitation. Cette cle augmente les impacts
    475     ! radiatifs des nuages.
    476     !cc      LOGICAL new_oliq
    477     !cc      PARAMETER (new_oliq=.FALSE.)
    478     !======================================================================
    479474    ! Clefs controlant deux parametrisations de l'orographie:
    480475    !c      LOGICAL ok_orodr
    … …  
    12621257    !--OB variables for mass fixer (hard coded for now)
    12631258    REAL qql1(klon),qql2(klon),corrqql
    1264 
    1265     !--OB flag to activate better conservation of water tendency when convection is not called every timestep
    1266     LOGICAL, PARAMETER :: ok_conserv_d_q_con=.FALSE.
    12671259
    12681260    REAL, dimension(klon,klev) :: t_env,q_env
    … …  
    30022994            wake_delta_pbl_TKE, &
    30032995                                !>nrlmd+jyg
    3004              treedrg )
     2996             treedrg, &
    30052997!FC
     2998!AM
     2999            tsurf_tersrf, tsoil_tersrf, qsurf_tersrf, tsurf_new_tersrf, &
     3000            cdragm_tersrf, cdragh_tersrf, &
     3001            swnet_tersrf, lwnet_tersrf, fluxsens_tersrf, fluxlat_tersrf)
    30063002       !
    30073003       !  Add turbulent diffusion tendency to the wake difference variables
    … …  
    34843480    ENDIF
    34853481
    3486     !--saving d_q_con * zmass for next timestep if convection is not called every timestep
    3487     IF (ok_conserv_d_q_con) THEN
     3482    !--saving d_X_con * zmass for next timestep if convection is not called every timestep
     3483    IF (ok_mass_dqcon) THEN
    34883484      d_q_con_zmasse(:,:) = d_q_con(:,:) * zmasse(:,:)
    34893485    ENDIF
     3486
     3487    IF (ok_mass_dtcon) THEN
     3488      d_t_con_zmasse(:,:) = d_t_con(:,:) * zmasse(:,:)
     3489    ENDIF
     3490
     3491    IF (ok_mass_duvcon) THEN
     3492      d_u_con_zmasse(:,:) = d_u_con(:,:) * zmasse(:,:)
     3493      d_v_con_zmasse(:,:) = d_v_con(:,:) * zmasse(:,:)
     3494    ENDIF
     3495
    34903496
    34913497    !     CALL homogene(paprs, q_seri, d_q_con, u_seri,v_seri,
    … …  
    35193525!!
    35203526
    3521     !--recompute d_q_con with zmasse from new timestep
    3522     IF (ok_conserv_d_q_con) THEN
     3527    !--recompute d_X_con with zmasse from new timestep
     3528    IF (ok_mass_dqcon) THEN
    35233529      d_q_con(:,:)=d_q_con_zmasse(:,:)/zmasse(:,:)
    35243530    ENDIF
     3531
     3532    IF (ok_mass_dtcon) THEN
     3533      d_t_con(:,:)=d_t_con_zmasse(:,:)/zmasse(:,:)
     3534    ENDIF
     3535
     3536    IF (ok_mass_duvcon) THEN
     3537      d_u_con(:,:)=d_u_con_zmasse(:,:)/zmasse(:,:)
     3538      d_v_con(:,:)=d_v_con_zmasse(:,:)/zmasse(:,:)
     3539    ENDIF
     3540
     3541
    35253542
    35263543    CALL add_phys_tend(d_u_con, d_v_con, d_t_con, d_q_con, dql0, dqi0, dqbs0, paprs, &
    … …  
    38973914    !===================================================================
    38983915    ! Computation of subrgid scale near-surface wind distribution
    3899     call surf_wind(klon,nsurfwind,u10m,v10m,wake_s,wake_Cstar,ustar,wstar,surf_wind_value,surf_wind_proba)
     3916    ! Developed for dust lifting. Could be extended to coupling with ocean and others
     3917    ! by default : 1 bin equal to the mean wind
     3918
     3919     call surf_wind(klon,nsurfwind,zu10m,zv10m,wake_s,wake_Cstar,zustar,ale_bl,surf_wind_value,surf_wind_proba)
    39003920
    39013921    !===================================================================
    … …  
    39773997         ptconv, rnebcon, qvcon, qccon, rnebcon0, zqsat, clwcon0, &
    39783998         d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, rneblsvol, &
    3979          pfraclr, pfracld, cldfraliq, sigma2_icefracturb, mean_icefracturb,  &
     3999         pfraclr, pfracld, cldfraliq, cldfraliqth,              &
     4000         sigma2_icefracturb, sigma2_icefracturbth,              &
     4001         mean_icefracturb,  mean_icefracturbth,                 &
    39804002         radocond, picefra, rain_lsc, snow_lsc, &
    39814003         frac_impa, frac_nucl, beta_prec_fisrt, &
    39824004         prfl, psfl, rhcl,  &
    3983          zqasc, fraca,ztv,zpspsk,ztla,zthl,iflag_cld_th, &
     4005         zqasc, fraca,ztv,zpspsk,ztla,zthl,zw2,iflag_cld_th, &
    39844006         iflag_ice_thermo, distcltop, temp_cltop,   &
    39854007         pbl_tke(:,:,is_ave), pbl_eps(:,:,is_ave), &
     4008         entr_therm, detr_therm, &
    39864009         cell_area, stratomask, &
    39874010         cf_seri, qvc_seri, u_seri, v_seri, &
    39884011         qsub, qissr, qcld, subfra, issrfra, gamma_cond,  &
    3989          dcf_sub, dcf_con, dcf_mix, dqi_adj, dqi_sub, dqi_con, dqi_mix, &
     4012         dcf_sub, dcf_con, dcf_mix, dqised, dcfsed, dqvcsed, &
     4013         dqi_adj, dqi_sub, dqi_con, dqi_mix, &
    39904014         dqvc_adj, dqvc_sub, dqvc_con, dqvc_mix, qsatliq, qsatice, &
    39914015         cfl_seri, cfc_seri, qtl_seri, qtc_seri, qice_lincont, qice_circont, &
    … …  
    39944018         cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv, &
    39954019         qraindiag, qsnowdiag, dqreva, dqssub, dqrauto, dqrcol, dqrmelt, &
    3996          dqrfreez, dqsauto, dqsagg, dqsrim, dqsmelt, dqsfreez, &
    3997          dqised, dcfsed, dqvcsed)
     4020         dqrfreez, dqsauto, dqsagg, dqsrim, dqsmelt, dqsfreez)
    39984021
    39994022    ELSE
    … …  
    40504073       DO i = 1, klon
    40514074          cldfra(i,k) = rneb(i,k)
    4052           !CR: a quoi ca sert? Faut-il ajouter qs_seri?
    4053           !EV: en effet etrange, j'ajouterais aussi qs_seri
    4054           !    plus largement, je nettoierais (enleverrais) ces lignes
    4055           IF (.NOT.new_oliq) radocond(i,k) = ql_seri(i,k)
     4075          ! keep only liquid droplets in radocond if not liqice_in_radocond
     4076          IF (.NOT.liqice_in_radocond) radocond(i,k) = ql_seri(i,k)
    40564077       ENDDO
    40574078    ENDDO
    … …  
    54855506
    54865507IF (CPPKEY_DUST) THEN
    5487     !  Avec SPLA, iflag_phytrac est forcé =1
    5488     CALL       phytracr_spl ( debut,lafin , jD_cur,jH_cur,iflag_con,       &  ! I
    5489                       pdtphys,ftsol,                                   &  ! I
    5490                       t,q_seri,paprs,pplay,RHcl,                  &  ! I
    5491                       pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,          &  ! I
    5492                       coefh(1:klon,1:klev,is_ave), cdragh, cdragm, u1, v1,                 &  ! I
    5493                       u_seri, v_seri, latitude_deg, longitude_deg,  &
    5494                       pphis,pctsrf,pmflxr,pmflxs,prfl,psfl,            &  ! I
    5495                       da,phi,phi2,d1a,dam,mp,ep,sigd,sij,clw,elij,     &  ! I
    5496                       epmlmMm,eplaMm,upwd,dnwd,itop_con,ibas_con,      &  ! I
    5497                       ev,wdtrainAS,  wdtrainM,wght_cvfd,              &  ! I
    5498                       fm_therm, entr_therm, rneb,                      &  ! I
    5499                       beta_prec_fisrt,beta_prec, & !I
    5500                       zu10m,zv10m,wstar,ale_bl,ale_wake,               &  ! I
     5508    ! Avec SPLA, iflag_phytrac est forcé =1
     5509
     5510    CALL       phytracr_spl ( debut,lafin , jD_cur,jH_cur,iflag_con,       &
     5511                      pdtphys,ftsol,                                       &
     5512                      t,q_seri,paprs,pplay,RHcl,                           &
     5513                      pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,              &
     5514                      coefh(1:klon,1:klev,is_ave), cdragh, cdragm, u1, v1, & 
     5515                      u_seri, v_seri, latitude_deg, longitude_deg,         &
     5516                      pphis,pctsrf,pmflxr,pmflxs,prfl,psfl,                &
     5517                      da,phi,phi2,d1a,dam,mp,ep,sigd,sij,clw,elij,         &
     5518                      epmlmMm,eplaMm,upwd,dnwd,itop_con,ibas_con,          &
     5519                      ev,wdtrainA,  wdtrainM,wght_cvfd,                    &
     5520                      fm_therm, entr_therm, rneb,                          &
     5521                      beta_prec_fisrt,beta_prec,                           &
     5522                      zu10m,zv10m,wstar,ale_bl,ale_wake,                   &
     5523                      nsurfwind,surf_wind_value, surf_wind_proba,          &
    55015524                      d_tr_dyn,tr_seri)
    55025525

  • LMDZ6/branches/contrails/libf/phylmd/printflag.f90

    r5282 r5717  
    1212
    1313  REAL tabcntr0(100)
    14   LOGICAL cycle_diurn0, soil_model0, new_oliq0, ok_orodr0
     14  LOGICAL cycle_diurn0, soil_model0, liqice_in_radocond0, ok_orodr0
    1515  LOGICAL ok_orolf0, ok_limitvr0
    1616  LOGICAL ok_journe, ok_instan, ok_region
    … …  
    4848  PRINT 100
    4949
    50   PRINT 11, new_oliq, ok_orodr, ok_orolf
     50  PRINT 11, liqice_in_radocond, ok_orodr, ok_orolf
    5151  PRINT 100
    5252
    … …  
    6767  cycle_diurn0 = .FALSE.
    6868  soil_model0 = .FALSE.
    69   new_oliq0 = .FALSE.
     69  liqice_in_radocond0 = .FALSE.
    7070  ok_orodr0 = .FALSE.
    7171  ok_orolf0 = .FALSE.
    … …  
    7474  IF (tabcntr0(7)==1.) cycle_diurn0 = .TRUE.
    7575  IF (tabcntr0(8)==1.) soil_model0 = .TRUE.
    76   IF (tabcntr0(9)==1.) new_oliq0 = .TRUE.
     76  IF (tabcntr0(9)==1.) liqice_in_radocond0 = .TRUE.
    7777  IF (tabcntr0(10)==1.) ok_orodr0 = .TRUE.
    7878  IF (tabcntr0(11)==1.) ok_orolf0 = .TRUE.
    … …  
    109109  END IF
    110110
    111   IF (new_oliq0 .AND. .NOT. new_oliq .OR. .NOT. new_oliq0 .AND. new_oliq) &
     111  IF (liqice_in_radocond0 .AND. .NOT. liqice_in_radocond .OR. .NOT. liqice_in_radocond0 .AND. liqice_in_radocond) &
    112112      THEN
    113     PRINT 16, new_oliq0, new_oliq
     113    PRINT 16, liqice_in_radocond0, liqice_in_radocond
    114114    PRINT 100
    115115  END IF
    … …  
    151151
    152152
    153 11 FORMAT (2X, 5('*'), '  new_oliq = ', L3, 3X, ', Ok_orodr = ', L3, 3X, &
     15311 FORMAT (2X, 5('*'), '  liqice_in_radocond = ', L3, 3X, ', Ok_orodr = ', L3, 3X, &
    154154    ', Ok_orolf = ', L3, 3X, 5('*'))
    155155
    … …  
    167167    10X, ' startphy = ', L3, 2X, ' et  run.def = ', L3)
    168168
    169 16 FORMAT (2X, '$$$$$$$$   Attention !!      new_oliq  different  sur', /1X, &
     16916 FORMAT (2X, '$$$$$$$$   Attention !!      liqice_in_radocond  different  sur', /1X, &
    170170    10X, ' startphy = ', L3, 2X, ' et  run.def = ', L3)
    171171

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

    r5305 r5717  
    2020       qsurf, tsurf_new, dflux_s, dflux_l, &
    2121       flux_u1, flux_v1 , &
    22        veget,lai,height &
     22       veget,lai,height, tsurf_tersrf, tsoil_tersrf, qsurf_tersrf, tsurf_new_tersrf, &
     23       cdragm_tersrf, cdragh_tersrf, &
     24       swnet_tersrf, lwnet_tersrf, fluxsens_tersrf, fluxlat_tersrf &
    2325#ifdef ISO
    2426       ,xtprecip_rain, xtprecip_snow,xtspechum, &
    … …  
    6365   
    6466    USE surf_land_bucket_mod
     67    USE surf_land_bucket_hetero_mod
    6568    USE calcul_fluxs_mod
    6669    USE indice_sol_mod
    … …  
    7881USE print_control_mod, ONLY: lunout
    7982    USE dimsoil_mod_h, ONLY: nsoilmx
    80 
     83    USE compbl_mod_h
    8184
    8285! Input variables 
    … …  
    8992    LOGICAL, INTENT(IN)                     :: debut, lafin
    9093    REAL, INTENT(IN)                        :: dtime
    91     REAL, DIMENSION(klon), INTENT(IN)       :: zlev, ccanopy
     94    REAL, DIMENSION(klon), INTENT(IN)       :: ccanopy
    9295    REAL, DIMENSION(klon), INTENT(IN)       :: swnet, lwnet
    9396    REAL, DIMENSION(klon), INTENT(IN)       :: albedo  ! albedo for whole short-wave interval
    … …  
    106109                                                         ! corresponds to previous sollwdown
    107110    REAL, DIMENSION(klon), INTENT(IN)       :: q2m, t2m
     111    REAL, DIMENSION(klon, nbtersrf), INTENT(IN) :: tsurf_tersrf
    108112#ifdef ISO
    109113    REAL, DIMENSION(ntiso,klon), INTENT(IN)       :: xtprecip_rain, xtprecip_snow
    … …  
    115119    REAL, DIMENSION(klon), INTENT(INOUT)          :: agesno
    116120    REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
     121    REAL, DIMENSION(klon), INTENT(INOUT)          :: zlev
     122    REAL, DIMENSION(klon, nsoilmx, nbtersrf), INTENT(INOUT) :: tsoil_tersrf
    117123#ifdef ISO
    118124    REAL, DIMENSION(niso,klon), INTENT(INOUT)    :: xtsnow, xtsol
    … …  
    136142    REAL, DIMENSION(klon,nvm_lmdz), INTENT(OUT) :: veget,lai
    137143    REAL, DIMENSION(klon,nvm_lmdz), INTENT(OUT) :: height
     144! AM
     145    REAL, DIMENSION(klon, nbtersrf), INTENT(OUT) :: tsurf_new_tersrf
     146    REAL, DIMENSION(klon, nbtersrf), INTENT(OUT) :: qsurf_tersrf
     147    REAL, DIMENSION(klon, nbtersrf), INTENT(OUT) :: cdragm_tersrf
     148    REAL, DIMENSION(klon, nbtersrf), INTENT(OUT) :: cdragh_tersrf
     149    REAL, DIMENSION(klon, nbtersrf), INTENT(OUT) :: swnet_tersrf
     150    REAL, DIMENSION(klon, nbtersrf), INTENT(OUT) :: lwnet_tersrf
     151    REAL, DIMENSION(klon, nbtersrf), INTENT(OUT) :: fluxsens_tersrf
     152    REAL, DIMENSION(klon, nbtersrf), INTENT(OUT) :: fluxlat_tersrf
    138153#ifdef ISO
    139154    REAL, DIMENSION(ntiso,klon), INTENT(OUT)      :: xtevap
    … …  
    153168    REAL, DIMENSION(klon) :: u0, v0     ! surface speed
    154169    REAL, DIMENSION(klon) :: precip_totsnow     ! total solid precip
    155     INTEGER               :: i
     170    INTEGER               :: i,j
     171    CHARACTER (len = 20)  :: modname = 'surf_land'
     172    CHARACTER (len = 100) :: abort_message
    156173
    157174!albedo SB >>>
    … …  
    285302        !write(*,*) 'surf_land 258'
    286303#endif
     304      IF (iflag_hetero_surf .GT. 0) THEN
     305        IF (klon .EQ. 1) THEN
     306          !
     307          CALL surf_land_bucket_hetero(itime, jour, knon, knindex, debut, dtime,&
     308              tsurf, p1lay, cdragh, precip_rain, precip_totsnow, temp_air, &
     309              spechum, AcoefH, AcoefQ, BcoefH, BcoefQ, pref, zlev, &
     310              u1, v1, gustiness, rugoro, swnet, lwnet, &
     311              snow, qsol, agesno, tsoil, &
     312              qsurf, z0m, z0h, alb1_new, alb2_new, evap, &
     313              fluxsens, fluxlat, tsurf_new, dflux_s, dflux_l, &
     314              tsurf_tersrf, tsoil_tersrf, qsurf_tersrf, tsurf_new_tersrf, &
     315              cdragm_tersrf, cdragh_tersrf, &
     316              swnet_tersrf, lwnet_tersrf, fluxsens_tersrf, fluxlat_tersrf)
     317        ELSE
     318          abort_message = 'Heterogeneous continental subsurfaces (iflag_hetero_surf > 0) are only compatible in 1D cases.'
     319          CALL abort_physic(modname,abort_message,1)
     320        ENDIF
     321      !
     322      ELSE
    287323       CALL surf_land_bucket(itime, jour, knon, knindex, debut, dtime,&
    288324            tsurf, p1lay, cdragh, precip_rain, precip_totsnow, temp_air, &
    … …  
    300336        z0h(1:knon)=z0m(1:knon) ! En attendant mieux
    301337
     338      ENDIF ! iflag_hetero_surf
    302339
    303340    ENDIF ! ok_veget

  • LMDZ6/branches/contrails/libf/phylmd/tropopause_m.f90

    r5618 r5717  
    11MODULE tropopause_m
    22
    3   USE yomcst_mod_h
    4 IMPLICIT NONE
     3  IMPLICIT NONE
     4
    55  PRIVATE
     6
    67  PUBLIC :: dyn_tropopause
    78
     9  REAL,    PARAMETER :: DynPTrMin = 8.E+3                  !--- Dyn tropopause pressures < DynPTrMin are set to DynPTrMin  (Pa)
     10  REAL,    PARAMETER :: DynPTrMax = 4.E+4                  !--- Dyn tropopause pressures > DynPTrMax are set to DynPTrMax  (Pa)
     11  REAL,    PARAMETER :: theta0 = 380.                      !--- Default threshold for theta-defined tropopause              (K)
     12  REAL,    PARAMETER :: pVort0 = 2.0                       !--- Default threshold for PV-defined tropopause               (PVU)
     13  REAL,    PARAMETER :: sg0  = 0.75                        !--- Bottom->top PV=pv0e search loop starts at sigma=sg0 level
     14  INTEGER, PARAMETER :: nadj = 3                           !--- Threshold must be exceeded on nadj adjacent levels
     15  INTEGER, PARAMETER :: ns   = 2                           !--- Number of neighbours used each side for vertical smoothing
     16
    817CONTAINS
    918
    10 !-------------------------------------------------------------------------------
    11 !
    12 FUNCTION dyn_tropopause(t, ts, paprs, pplay, rot, itrop, thet0, pvor0)
    13 !
    14 !-------------------------------------------------------------------------------
     19!===============================================================================================================================
     20FUNCTION dyn_tropopause(t, ts, paprs, pplay, rot, itrop, thet0, potV0) RESULT(pTrop)
    1521  USE assert_m,     ONLY: assert
    1622  USE assert_eq_m,  ONLY: assert_eq
    1723  USE dimphy,       ONLY: klon, klev
    18   USE geometry_mod, ONLY: latitude_deg, longitude_deg
    19   USE vertical_layers_mod, ONLY: aps, bps, preff
     24  USE geometry_mod, ONLY: latitude
     25  USE strings_mod,  ONLY: maxlen
     26  USE yomcst_mod_h, ONLY: ROMEGA, RKAPPA, RG
     27  USE vertical_layers_mod,    ONLY: aps, bps, preff
    2028  USE lmdz_reprobus_wrappers, ONLY: itroprep
    21   USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_REPROBUS
    22   USE print_control_mod, ONLY: lunout
    23 
    24 !-------------------------------------------------------------------------------
    25 ! Arguments:
    26   REAL ::     dyn_tropopause(klon) !--- Pressure at tropopause
    27   REAL, INTENT(IN)  ::      t(:,:) !--- Cells-centers temperature
    28   REAL, INTENT(IN)  ::     ts(:)   !--- Surface       temperature
    29   REAL, INTENT(IN)  ::  paprs(:,:) !--- Cells-edges   pressure
    30   REAL, INTENT(IN)  ::  pplay(:,:) !--- Cells-centers pressure
    31   REAL, INTENT(IN)  ::    rot(:,:) !--- Cells-centers relative vorticity
    32   INTEGER, INTENT(OUT), OPTIONAL :: itrop(klon) !--- Last tropospheric layer idx
    33   REAL,    INTENT(IN),  OPTIONAL :: thet0, pvor0
    34 !-------------------------------------------------------------------------------
    35 ! Local variables:
    36 
    37   REAL, PARAMETER :: DynPTrMin =8.E+3 !--- Thresholds for minimum and maximum
    38   REAL, PARAMETER :: DynPTrMax =4.E+4 !    dynamical tropopause pressure (Pa).
    39   CHARACTER(LEN=80)  :: sub
    40   INTEGER :: i, k, kb, kt, kp, ib, ie, nw
    41   REAL    :: al, th0, pv0
    42   REAL,    DIMENSION(klon,klev) :: tpot_cen, tpot_edg, pvor_cen
    43   REAL,    PARAMETER :: sg0=0.75  !--- Start level for PV=cte search loop
    44   INTEGER, PARAMETER :: nadj=3    !--- Adjacent levs nb for thresholds detection
    45   REAL,    PARAMETER :: w(5)=[0.1,0.25,0.3,0.25,0.1] !--- Vertical smoothing
    46   INTEGER, SAVE :: k0
    47   INTEGER :: savkt
    48   LOGICAL, SAVE :: first=.TRUE.
    49 !$OMP THREADPRIVATE(k0,first)
    50 !-------------------------------------------------------------------------------
    51   sub='dyn_tropopause'
    52   CALL assert(SIZE(t ,1)==klon, TRIM(sub)//" t klon")
    53   CALL assert(SIZE(t ,2)==klev, TRIM(sub)//" t klev")
    54   CALL assert(SIZE(ts,1)==klon, TRIM(sub)//" ts klon")
    55   CALL assert(SHAPE(paprs)==[klon,klev+1],TRIM(sub)//" paprs shape")
    56   CALL assert(SHAPE(pplay)==[klon,klev  ],TRIM(sub)//" pplay shape")
    57   CALL assert(SHAPE(rot)  ==[klon,klev  ],TRIM(sub)//" rot shape")
    58 
    59   !--- DEFAULT THRESHOLDS
    60   th0=380.; IF(PRESENT(thet0)) th0=thet0   !--- In kelvins
    61   pv0=  2.; IF(PRESENT(pvor0)) pv0=pvor0   !--- In PVU
    62   IF(first) THEN
    63     DO k0=1,klev; IF(aps(k0)/preff+bps(k0)<sg0) EXIT; END DO; first=.FALSE.
     29  USE lmdz_cppkeys_wrapper,   ONLY: CPPKEY_REPROBUS
     30  USE mod_phys_lmdz_para,     ONLY: is_master
     31  USE mod_phys_lmdz_transfert_para, ONLY : bcast
     32  IMPLICIT NONE
     33  REAL                           :: pTrop(klon)            !--- Pressure at dynamical tropopause                           (Pa)
     34  REAL,              INTENT(IN)  ::      t(:,:)            !--- Temperature at layers centers                               (K)
     35  REAL,              INTENT(IN)  ::     ts(:)              !--- Temperature on surface layer interface                      (K)
     36  REAL,              INTENT(IN)  ::  paprs(:,:)            !--- Pressure at layers interfaces                              (Pa)
     37  REAL,              INTENT(IN)  ::  pplay(:,:)            !--- Pressure at layers centers                                 (Pa)
     38  REAL,              INTENT(IN)  ::    rot(:,:)            !--- Relative vorticity at layers centers                      (s-1)
     39  INTEGER, OPTIONAL, INTENT(OUT) :: itrop(klon)            !--- Last tropospheric layer idx
     40  REAL,    OPTIONAL, INTENT(IN)  :: thet0                  !--- Potential temperature at the tropopause (tropical region)   (K)
     41  REAL,    OPTIONAL, INTENT(IN)  :: potV0                  !--- Potential vorticity   at the tropopause (rest of globe)   (PVU)
     42!------------------------------------------------------------------------------------------------------------------------------
     43  CHARACTER(LEN=maxlen) :: modname                         !--- Current routine name
     44  REAL                  ::    Temp_edg(klon,klev)          !--- Regular   temperature at layers interfaces (except last one)(K)
     45  REAL                  :: potTemp_edg(klon,klev)          !--- Potential temperature at layers interfaces (except last one)(K)
     46  REAL                  :: potTemp_cen(klon,klev)          !--- Potential temperature at layers centers                     (K)
     47  REAL                  :: potVort_cen(klon,klev)          !--- Potential vorticity   at layers centers                     (K)
     48  REAL                  :: p_th0(klon)                     !--- Pressures at theta=380K                                    (Pa)
     49  REAL                  :: p_pv0(klon)                     !--- Pressures at PV=2PVU                                       (Pa)
     50  REAL                  :: al, th0, pv0                    !--- Interpolation coefficient + potential temp. and PV thresholds
     51  INTEGER               :: i, k, kb, kt, kp, ib, ie, nw, n
     52  INTEGER               :: ith(klon)                       !--- Indices of first TH=380K layers (top -> bottom search)
     53  INTEGER               :: ipv(klon)                       !--- Indices of first PV=2PVU layers (top -> bottom search)
     54  INTEGER               :: ipv0(klon)                      !--- Indices of first PV=2PVU layers (bottom -> top search)
     55  INTEGER               :: ncons(klon)                     !--- Number of consecutive matching values found in vertical loops
     56  INTEGER               :: itr(klon)                       !--- Index of last layer with a center pressure lower than pTrop
     57  INTEGER               :: co(2*ns+1)                      !--- Binomial coefficients used compute smoothing weights "w(:,:)"
     58  INTEGER,           SAVE :: k0                            !--- Start index (sigma=sg0) for 2PVU bottom->top search loop
     59  REAL, ALLOCATABLE, SAVE :: fac(:)                        !--- Coriolis parameter: 2*ROMEGA*SIN(cells centers latitudes) (s-1)
     60  REAL, ALLOCATABLE, SAVE :: w(:,:)                        !--- Coefficients for vertical smoothing froutine "smooth"
     61  LOGICAL,           SAVE :: lFirst = .TRUE.
     62!$OMP THREADPRIVATE(k0, fac, w, lFirst)
     63!------------------------------------------------------------------------------------------------------------------------------
     64  modname = 'dyn_tropopause'
     65  CALL assert(SIZE(t,  DIM=1) == klon,        TRIM(modname)//" t klon")
     66  CALL assert(SIZE(t,  DIM=2) == klev,        TRIM(modname)//" t klev")
     67  CALL assert(SIZE(ts, DIM=1) == klon,        TRIM(modname)//" ts klon")
     68  CALL assert(SHAPE(paprs) == [klon, klev+1], TRIM(modname)//" paprs shape")
     69  CALL assert(SHAPE(pplay) == [klon, klev  ], TRIM(modname)//" pplay shape")
     70  CALL assert(SHAPE(rot)   == [klon, klev  ], TRIM(modname)//" rot shape")
     71
     72  !--- MODIFY THE THRESHOLDS FOR THE DYNAMICAL TROPOPAUSE DEFINITION IN CASE THE CORRESPONDING OPTIONAL ARGUMENTS ARE USED
     73  th0 = theta0; IF(PRESENT(thet0)) th0 = thet0            !--- Potential temperature at the tropopause (tropical region)   (K)
     74  pv0 = pVort0; IF(PRESENT(potV0)) pv0 = potV0            !--- Potential vorticity   at the tropopause (rest of globe)   (PVU)
     75
     76  IF(lFirst) THEN
     77     ALLOCATE(fac(klon), w(ns+1, ns+1))
     78
     79     !--- COMPUTE THE CORIOLIS PARAMETER FOR PV ALCULATION ROUTINE "potentialVorticity"
     80     DO i = 1, klon
     81        fac(i) = 2. * ROMEGA * SIN(latitude(i))
     82     END DO
     83!$OMP BARRIER
     84
     85     IF(is_master) THEN
     86
     87       !--- GET THE INDEX "k0" OF THE FIRST LOWER INTERFACE LAYER WITH SIGMA COORDINATE LOWER THAN "sg0"
     88       !--- NOTE: "k0" DEPENDS ON VERTICAL DISCRETIZATION ONLY (VIA HYBRID COEFFS aps, bps) AND IS NOT SIMULATION-DEPENDENT
     89        DO k0 = 1, klev; IF( aps(k0) / preff + bps(k0) < sg0 ) EXIT; END DO     !--- START INDEX FOR BOTTOM->TOP PV SEARCH LOOP
     90
     91        !--- COMPUTE THE WEIGHTS FOR THE VERTICAL SMOOTHING ROUTINE "smooth"
     92        co(:) = 0;  w(:, :) = 0.
     93        co(1) = 1;  w(1, 1) = 1.
     94        DO i = 1, ns
     95           co(2:2*ns+1) = co(2:2*ns+1) + co(1:2*ns)        !--- C(n+1,p+1) = C(n,p+1) + C(n,p)
     96           co(2:2*ns+1) = co(2:2*ns+1) + co(1:2*ns)        !--- C(n+1,p+1) = C(n,p+1) + C(n,p) AGAIN
     97           w(i+1, 1:i+1) = REAL(co(i+1:2*i+1))/REAL(SUM(co(i+1:2*i+1)))
     98        END DO
     99
     100        lFirst=.FALSE.
     101     END IF
     102     CALL bcast(k0)
     103     CALL bcast(w)
     104     CALL bcast(lFirst)
    64105  END IF
    65106
    66   !--- POTENTIAL TEMPERATURE AT CELLS CENTERS AND INTERFACES
    67   DO i = 1,klon
    68     tpot_cen(i,1) = t(i,1)*(preff/pplay(i,1))**RKAPPA
    69     tpot_edg(i,1) = ts(i) *(preff/paprs(i,1))**RKAPPA
    70     DO k=2,klev
    71       al = LOG(pplay(i,k-1)/paprs(i,k))/LOG(pplay(i,k-1)/pplay(i,k))
    72       tpot_cen(i,k) =  t(i,k)                        *(preff/pplay(i,k))**RKAPPA
    73       tpot_edg(i,k) = (t(i,k-1)+al*(t(i,k)-t(i,k-1)))*(preff/paprs(i,k))**RKAPPA
    74       !--- FORCE QUANTITIES TO BE GROWING
    75       IF(tpot_edg(i,k)<tpot_edg(i,k-1)) tpot_edg(i,k)=tpot_edg(i,k-1)+1.E-5
    76       IF(tpot_cen(i,k)<tpot_cen(i,k-1)) tpot_cen(i,k)=tpot_cen(i,k-1)+1.E-5
    77     END DO
    78     !--- VERTICAL SMOOTHING
    79     tpot_cen(i,:)=smooth(tpot_cen(i,:),w)
    80     tpot_edg(i,:)=smooth(tpot_edg(i,:),w)
    81   END DO
    82 
    83   !--- ERTEL POTENTIAL VORTICITY AT CELLS CENTERS (except in top layer)
    84   DO i = 1, klon
    85     DO k= 1, klev-1
    86       pvor_cen(i,k)=-1.E6*RG*(rot(i,k)+2.*ROMEGA*SIN(latitude_deg(i)*RPI/180.))&
    87                    * (tpot_edg(i,k+1)-tpot_edg(i,k)) / (paprs(i,k+1)-paprs(i,k))
    88     END DO
    89     !--- VERTICAL SMOOTHING
    90     pvor_cen(i,1:klev-1)=smooth(pvor_cen(i,1:klev-1),w)
    91   END DO
    92 
    93   !--- LOCATE TROPOPAUSE: LOWEST POINT BETWEEN THETA=380K AND PV=2PVU SURFACES.
    94   DO i = 1, klon
    95     !--- UPPER TROPOPAUSE: |PV|=2PVU POINT STARTING FROM TOP
    96 !    DO kt=klev-1,1,-1
    97 !      savkt = kt
    98 !      IF (kt-nadj == 0) THEN
    99 !        WRITE(lunout,*)'ABORT_PHYSIC tropopause_m kt= ',kt
    100 !        call abort_physic("tropopause_m", " kt = nadj", 1)
    101 !      ENDIF
    102 !      IF(ALL(ABS(pvor_cen(i,kt-nadj:kt))<=pv0)) THEN
    103 !        EXIT
    104 !      ENDIF
    105 !    END DO
    106     DO kt=klev-1,nadj+1,-1; savkt = kt; IF(ALL(ABS(pvor_cen(i,kt-nadj:kt))<=pv0))  EXIT; END DO
    107     kt = savkt
    108     !--- LOWER TROPOPAUSE: |PV|=2PVU POINT STARTING FROM BOTTOM
    109     DO kb=k0,klev-1;   IF(ALL(ABS(pvor_cen(i,kb:kb+nadj))> pv0)) EXIT; END DO; kb=kb-1
    110     !--- ISO-THETA POINT: THETA=380K       STARTING FROM TOP
    111     DO kp=klev-1,1,-1; IF(ALL(ABS(tpot_cen(i,kp-nadj:kp))<=th0)) EXIT; END DO
    112     !--- CHOOSE BETWEEN LOWER AND UPPER TROPOPAUSE
    113     IF(2*COUNT(ABS(pvor_cen(i,kb:kt))>pv0)>kt-kb+1) kt=kb
    114     !--- PV-DEFINED TROPOPAUSE
    115     al = (ABS(pvor_cen(i,kt+1))-pv0)/ABS(pvor_cen(i,kt+1)-pvor_cen(i,kt))
    116     dyn_tropopause(i) = pplay(i,kt+1)*(pplay(i,kt)/pplay(i,kt+1))**al
    117     !--- THETA=380K IN THE TROPICAL REGION
    118     al = (tpot_cen(i,kp+1)-th0)/(tpot_cen(i,kp+1)-tpot_cen(i,kp))
    119     dyn_tropopause(i) = MAX( pplay(i,kp+1)*(pplay(i,kp)/pplay(i,kp+1))**al,    &
    120                             dyn_tropopause(i) )
    121     !--- UNREALISTIC VALUES DETECTION
    122     IF(dyn_tropopause(i)<DynPTrMin.OR.dyn_tropopause(i)>DynPTrMax) THEN
    123       dyn_tropopause(i)=MIN(MAX(dyn_tropopause(i),DynPTrMax),DynPTrMin)
    124       DO kt=1,klev-1; IF(pplay(i,kt+1)>dyn_tropopause(i)) EXIT; END DO; kp=kt
    125     END IF
    126 IF (CPPKEY_REPROBUS) THEN
    127     itroprep(i)=MAX(kt,kp)
    128 END IF
    129     !--- LAST TROPOSPHERIC LAYER INDEX NEEDED
    130     IF(PRESENT(itrop)) itrop(i)=MAX(kt,kp)
    131   END DO
     107  !=== DETERMINE THE PRESSURE AT WHICH THETA = th0 ============================================================================
     108  CALL potentialTemperature(pplay, t, potTemp_cen)                             !--- POTENTIAL TEMPERATURE @ LAYERS CENTERS
     109
     110  !--- INDEX OF FIRST LAYERS WITH THETA<380K @ CENTER ON "nadj" CONSECUTIVE LAYERS
     111  CALL getLayerIdx(potTemp_cen, th0, -1, nadj, ith)                            !--- FROM TOP TO BOTTOM
     112
     113  CALL getPressure(potTemp_cen, th0, ith, pplay, paprs, p_th0)                 !--- PRESSURE @ THETA = th0 SURFACE
     114
     115  !=== DETERMINE THE PRESSURE AT WHICH PV = pv0 ===============================================================================
     116  CALL cen2edg(t, ts, pplay, paprs(:,1:klev), temp_edg)                        !--- TEMP @ LAYERS INTERFACES (EXCEPT LAST ONE)
     117
     118  CALL potentialTemperature (paprs(:,1:klev), temp_edg, potTemp_edg)           !--- TPOT @ LAYERS INTERFACES (EXCEPT LAST ONE)
     119
     120  CALL potentialVorticity(rot, potTemp_edg, paprs(:,1:klev), potVort_cen)      !--- ERTEL POTENTIAL VORTICITY @ LAYERS CENTERS
     121
     122  !--- INDEX OF FIRST LAYERS WITH PV<=2PVU @ CENTER ON "nadj" CONSECUTIVE LAYERS
     123  CALL getLayerIdx(potVort_cen, pv0, -1, nadj, ipv)                            !--- FROM TOP TO BOTTOM
     124  CALL getLayerIdx(potVort_cen, pv0, k0, nadj, ipv0)                           !--- FROM LAYER @ sig=sig0 TO TOP
     125  DO i = 1, klon; n = 0                                                        !--- CHOOSE BETWEEN BOTTOM AND TOP INDEX
     126     IF(ipv0(i) == k0-1 .OR. ipv0(i) > ipv(i)) CYCLE                           !--- ipv0 CAN'T BE USED
     127     DO k = ipv0(i), ipv(i); IF(potVort_cen(i, k) > pv0) n = n+1; END DO       !--- NUMBER OF POINTS WITH PV>2PVU
     128     IF(2 * n >= ipv(i)-ipv0(i)+1) ipv(i) = ipv0(i)                            !--- MORE THAN 50% > pv0 => LOWER POINT KEPT
     129  END DO
     130
     131  CALL getPressure(potVort_cen, pv0, ipv, pplay, paprs, p_pv0)                  !--- PRESSURE @ PV = pv0 SURFACE
     132
     133  !=== DETERMINE THE UNFILTERED DYNAMICAL TROPOPAUSE PRESSURE FIELD (LOWER POINT BETWEEN THETA=380K AND PV=2PVU) ==============
     134  DO i = 1, klon
     135     pTrop(i) = MAX(p_th0(i), p_pv0(i))
     136  END DO
     137
     138  !=== FILTER THE PRESSURE FIELD: TOO HIGH AND TOO LOW VALUES ARE CLIPPED =====================================================
     139  DO i = 1, klon
     140     IF(pTrop(i) < DynPTrMin) pTrop(i) = DynPTrMin
     141     IF(pTrop(i) > DynPTrMax) pTrop(i) = DynPTrMax
     142  END DO
     143
     144  !=== LAST VERTICAL INDEX WITH A PRESSURE HIGHER THAN TROPOPAUSE PRESSURE ====================================================
     145  IF(.NOT.(PRESENT(itrop) .OR. CPPKEY_REPROBUS)) RETURN
     146  DO i = 1, klon
     147     DO k = 1, klev
     148        IF(pplay(i,k+1) <= pTrop(i)) EXIT
     149     END DO
     150     IF(PRESENT(itrop )) itrop(i)    = k
     151     IF(CPPKEY_REPROBUS) itroprep(i) = k
     152  END DO
     153
     154CONTAINS
     155
     156!===============================================================================================================================
     157SUBROUTINE cen2edg(v_cen, v0_edg, p_cen, p_edg, v_edg)
     158  IMPLICIT NONE
     159  REAL, DIMENSION(klon, klev), INTENT(IN)  :: v_cen, p_cen, p_edg
     160  REAL, DIMENSION(klon),       INTENT(IN)  :: v0_edg
     161  REAL, DIMENSION(klon, klev), INTENT(OUT) :: v_edg
     162  INTEGER :: i, k
     163  DO i = 1, klon
     164     v_edg(i, 1) = v0_edg(i)
     165  END DO
     166  DO k = 2, klev
     167     DO i = 1, klon
     168        al = LOG(p_edg(i, k-1)/p_cen(i, k)) / LOG(p_cen(i, k-1)/p_cen(i, k))   !--- CENTER -> INTERFACE INTERPOLATION COEFF
     169        v_edg(i, k) = v_cen(i, k-1) + al * (v_cen(i, k) - v_cen(i, k-1))       !--- FIELD AT LAYER INTERFACE
     170     END DO
     171  END DO
     172END SUBROUTINE cen2edg
     173!===============================================================================================================================
     174SUBROUTINE getPressure(v_cen, v0, ix, p_cen, p_int, pre_v0)
     175  IMPLICIT NONE
     176  REAL,    INTENT(IN)  :: v_cen(klon, klev), v0
     177  INTEGER, INTENT(IN)  ::    ix(klon)
     178  REAL,    INTENT(IN)  :: p_cen(klon, klev), p_int(klon, klev+1)
     179  REAL,    INTENT(OUT) :: pre_v0(klon)
     180  REAL    :: al
     181  INTEGER :: i, k
     182  DO i = 1, klon; k = ix(i)
     183     IF(k == 0) THEN
     184        pre_v0(i) = p_int(i,1)
     185     ELSE IF(k == klev) THEN
     186        pre_v0(i) = p_int(i,klev+1)
     187     ELSE
     188        al =  (v0 - v_cen(i, k+1)) / (v_cen(i, k) - v_cen(i, k+1))
     189        pre_v0(i) = p_cen(i, k+1)  * (p_cen(i, k) / p_cen(i, k+1))**al
     190     END IF
     191  END DO
     192END SUBROUTINE getPressure
     193!===============================================================================================================================
     194SUBROUTINE getLayerIdx(v, v0, k0, nadj, ix)
     195! Purpose: Search for the index of the last layer ix(i) with a value v(i,k) lower than or equal to v0.
     196!          At least nadj adjacent layers must satisfy the criterium (less - as much as possible - near top or bottom).
     197!          The search is done from:    * top to bottom if k0 < 0 (from k=klev to k=|k0|)
     198!                                      * bottom to top if k0 > 0 (from k=k0   to k=klev)
     199!          - nominal case: k0 <= ix(i) < klev
     200!          - special case: ix(i) == klev:   ALL(v(i,k0:klev) <= v0)
     201!          - special case: ix(i) == |k0|-1: ALL(v(i,k0:klev) >  v0)
     202  IMPLICIT NONE
     203  REAL,    INTENT(IN)  ::  v(klon, klev), v0
     204  INTEGER, INTENT(IN)  :: k0, nadj
     205  INTEGER, INTENT(OUT) :: ix(klon)
     206  INTEGER :: i, k, nc(klon)
     207  nc(:) = 0
     208  ix(:) = 0
     209  IF(k0 < 0) THEN
     210     !=== SEARCH FROM TOP TO BOTTOM: klev -> -k0
     211     !--- ix(i) depends on nc(i), the number of adjacent layers with v(i,:) <= v0 (k is the index of the last tested layer)
     212     !---  *     nc(i) == nadj   nominal case: enough matching values   => ix(i) = k+nadj-1   (|k0|+nadj-1 <= k <= klev-nadj+1)
     213     !---                     particular case: all values are matching  => ix(i) = klev       (k = klev-nadj+1)
     214     !---  * 0 < nc(i) < nadj  bottom reached: nc<nadj matching values  => ix(i) = k+nc(i)-1  (k = |k0|)
     215     !---  *     nc(i) == 0    bottom reached:      no matching values  => ix(i) = k          (k = |k0|-1)
     216     !--- So ix(i) = MAX(k, k+nc(i)-1) fits for each case.
     217     DO k = klev, -1, -k0
     218        DO i = 1, klon
     219           IF(ix(i) /= 0) CYCLE                                                !--- ADEQUATE LAYER ALREADY FOUND
     220           nc(i) = nc(i) + 1
     221           IF(ABS(v(i, k)) > v0) nc(i) = 0
     222           IF(nc(i) /= nadj) CYCLE                                             !--- nc<nadj ADJACENT LAYERS WITH v<=v0 FOUND
     223           ix(i) = 1                                                           !--- FAKE /=0 VALUE TO SKIP FOLLOWING ITERATIONS
     224        END DO
     225     END DO
     226     DO i = 1, klon
     227        ix(i) = MAX(k, k+nc(i)-1)                                              !--- INDEX OF LOWEST LAYER WITH v<=v0
     228     END DO
     229  ELSE
     230     !=== SEARCH FROM BOTTOM TO TOP: k0 -> klev
     231     !--- ix(i) depends on nc(i), the number of adjacent layers with v(i,:) > v0 (k is the index of the last tested layer)
     232     !---  *     nc(i) == nadj   nominal case: enough matching values   => ix(i) = k-nadj     ( k0 +nadj-1 <= k <= klev-nadj+1)
     233     !---                     particular case: all values are matching  => ix(i) = k0-1       (k = k0+nadj-1)
     234     !---  * 0 < nc(i) < nadj     top reached: nc<nadj matching values  => ix(i) = k-nc(i)    (k = klev)
     235     !---  *     nc(i) == 0       top reached:      no matching values  => ix(i) = k          (k = klev)
     236     !--- So ix(i) = k-nc(i) fits for each case.
     237     DO k = k0, klev
     238        DO i = 1, klon
     239           IF(ix(i) /= 0) CYCLE                                                !--- ADEQUATE LAYER ALREADY FOUND
     240           nc(i) = nc(i) + 1
     241           IF(ABS(v(i, k)) <= v0) nc(i) = 0
     242           IF(nc(i) /= nadj) CYCLE                                             !--- nc<nadj ADJACENT LAYERS WITH v<=v0 FOUND
     243           ix(i) = 1                                                           !--- FAKE /=0 VALUE TO SKIP FOLLOWING ITERATIONS
     244        END DO
     245     END DO
     246     DO i = 1, klon
     247        ix(i) = k-nc(i)                                                        !--- INDEX OF LOWEST LAYER WITH v<=v0
     248     END DO
     249  END IF
     250END SUBROUTINE getLayerIdx
     251!===============================================================================================================================
     252SUBROUTINE potentialTemperature(pre, temp, tPot)
     253  IMPLICIT NONE
     254  REAL, DIMENSION(:, :),                       INTENT(IN)  :: pre, temp
     255  REAL, DIMENSION(SIZE(pre, 1), SIZE(pre, 2)), INTENT(OUT) :: tPot
     256  REAL, ALLOCATABLE :: tmp(:,:)
     257  CHARACTER(LEN=maxlen) :: modname
     258  INTEGER :: i, k, ni, nk
     259  modname = 'potentialTemperature'
     260  ni = SIZE(pre, 1)
     261  nk = SIZE(pre, 2)
     262  CALL assert(SIZE(temp, DIM=1) == ni, TRIM(modname)//" SIZE(temp,1) SIZE(pre,1)")
     263  CALL assert(SIZE(temp, DIM=2) == nk, TRIM(modname)//" SIZE(temp,2) SIZE(pre,2)")
     264  ALLOCATE(tmp(ni, nk))
     265  DO k = 1, nk                                                                 !--- COMPUTE RAW FIELD
     266     DO i = 1, ni
     267        tmp(i, k) = temp(i, k) * (100000. / pre(i, k))**RKAPPA
     268     END DO
     269  END DO
     270  DO k = 2, nk                                                                 !--- ENSURE GROWING FIELD WITH ALTITUDE
     271     DO i = 1, ni
     272        IF(tmp(i, k)< tmp(i, k-1)) tmp(i, k) = tmp(i, k-1) + 1.E-5
     273     END DO
     274  END DO
     275  CALL smooth(tmp, tPot)                                                       !--- FILTER THE FIELD
     276END SUBROUTINE potentialTemperature
     277!===============================================================================================================================
     278SUBROUTINE potentialVorticity(rot_cen, th_int, pint, pVor_cen)
     279  IMPLICIT NONE
     280  REAL, DIMENSION(klon, klev), INTENT(IN)  :: rot_cen, th_int, pint
     281  REAL, DIMENSION(klon, klev), INTENT(OUT) :: pVor_cen
     282  REAL ::     tmp(klon, klev)
     283  INTEGER :: i, k, kp
     284  DO k = 1, klev-1                                                             !--- COMPUTE RAW FIELD
     285     DO i = 1, klon
     286        tmp(i, k) = -1.E6 * RG * (rot_cen(i, k) + fac(i)) * (th_int(i, k+1)-th_int(i, k)) / (pint(i, k+1)-pint(i, k))
     287     END DO
     288  END DO
     289  DO i = 1, klon
     290     tmp(i, klev) = tmp(i, klev-1)
     291  END DO
     292  CALL smooth(tmp, pVor_cen)                                                   !--- FILTER THE FIELD
     293END SUBROUTINE potentialVorticity
     294!===============================================================================================================================
     295SUBROUTINE smooth(v, vs)
     296! Purpose: Vertical smoothing of each profile v(i,:) using 2*ns+1 centered binomial weights (+/- ns points).
     297! Note:    For levels near the bottom (k <= ns) or the top (k > klev-ns), a narrower set of weights (n<ns) is used.
     298!          => in particular, first and last levels are left untouched.
     299  IMPLICIT NONE
     300  REAL,    INTENT(IN)  :: v (klon, klev)
     301  REAL,    INTENT(OUT) :: vs(klon, klev)
     302  INTEGER :: i, j, k
     303  vs(:, :) = 0.
     304  DO k = 1, klev
     305     n = MIN(k-1, klev-k, ns)
     306     DO j = k-n, k+n
     307        DO i = 1, klon
     308           vs(i, k) = vs(i, k) + v(i, j) * w(n+1, 1+ABS(j-k))
     309        END DO
     310     END DO
     311  END DO
     312END SUBROUTINE smooth
    132313
    133314END FUNCTION dyn_tropopause
    134315
    135 
    136 !-------------------------------------------------------------------------------
    137 !
    138 FUNCTION smooth(v,w)
    139 !
    140 !-------------------------------------------------------------------------------
    141 ! Arguments:
    142   REAL, INTENT(IN)         :: v(:), w(:)
    143   REAL, DIMENSION(SIZE(v)) :: smooth
    144 !-------------------------------------------------------------------------------
    145 ! Local variables:
    146   INTEGER :: nv, nw, k, kb, ke, lb, le
    147 !-------------------------------------------------------------------------------
    148   nv=SIZE(v); nw=(SIZE(w)-1)/2
    149   DO k=1,nv
    150     kb=MAX(k-nw,1 ); lb=MAX(2+nw   -k,1)
    151     ke=MIN(k+nw,nv); le=MIN(1+nw+nv-k,1+2*nw)
    152     smooth(k)=SUM(v(kb:ke)*w(lb:le))/SUM(w(lb:le))
    153   END DO
    154 
    155 END FUNCTION smooth
    156 !
    157 !-------------------------------------------------------------------------------
    158 
    159316END MODULE tropopause_m

  • LMDZ6/branches/contrails/libf/phylmdiso/lmdz_lscp_old.F90

    r5285 r5717  
    2222  USE icefrac_lsc_mod ! compute ice fraction (JBM 3/14)
    2323  USE print_control_mod, ONLY: prt_level, lunout
    24   USE lmdz_cloudth, only : cloudth, cloudth_v3, cloudth_v6
     24  USE lmdz_lscp_condensation, only : cloudth, cloudth_v3, cloudth_v6
    2525  USE ioipsl_getin_p_mod, ONLY : getin_p
    2626  USE phys_local_var_mod, ONLY: ql_seri,qs_seri

  • LMDZ6/branches/contrails/libf/phylmdiso/phyaqua_mod.F90

    r5285 r5717  
    294294    clesphy0(3) = 1. ! cycle_diurne
    295295    clesphy0(4) = 1. ! soil_model
    296     clesphy0(5) = 1. ! new_oliq
     296    clesphy0(5) = 1. ! liqice_in_radocond
    297297    clesphy0(6) = 0. ! ok_orodr
    298298    clesphy0(7) = 0. ! ok_orolf

  • LMDZ6/branches/contrails/libf/phylmdiso/phyetat0_mod.F90

    r5618 r5717  
    175175  IF (iflag_cycle_diurne.GE.1) tab_cntrl( 7) = iflag_cycle_diurne
    176176  IF (soil_model) tab_cntrl( 8) =1.
    177   IF (new_oliq) tab_cntrl( 9) =1.
     177  IF (liqice_in_radocond) tab_cntrl( 9) =1.
    178178  IF (ok_orodr) tab_cntrl(10) =1.
    179179  IF (ok_orolf) tab_cntrl(11) =1.

  • LMDZ6/branches/contrails/libf/phylmdiso/phyredem.F90

    r5618 r5717  
    121121  IF( iflag_cycle_diurne.GE.1 ) tab_cntrl( 7 ) = iflag_cycle_diurne
    122122  IF(   soil_model ) tab_cntrl( 8 ) = 1.
    123   IF(     new_oliq ) tab_cntrl( 9 ) = 1.
     123  IF(     liqice_in_radocond ) tab_cntrl( 9 ) = 1.
    124124  IF(     ok_orodr ) tab_cntrl(10 ) = 1.
    125125  IF(     ok_orolf ) tab_cntrl(11 ) = 1.

  • LMDZ6/branches/contrails/libf/phylmdiso/physiq_mod.F90

    r5618 r5717  
    7575    USE write_field_phy
    7676    use wxios_mod, ONLY: g_ctx, wxios_set_context
    77     USE lmdz_lscp, ONLY : lscp
     77    USE lmdz_lscp_main, ONLY : lscp
    7878    USE lmdz_call_cloud_optics_prop, ONLY : call_cloud_optics_prop
    7979    USE lmdz_lscp_old, ONLY : fisrtilp
    8080    USE lmdz_call_blowing_snow, ONLY : call_blowing_snow_sublim_sedim
    8181    USE lmdz_wake_ini, ONLY : wake_ini
     82    USE lmdz_surf_wind_ini, ONLY : surf_wind_ini
     83    USE lmdz_surf_wind, ONLY : surf_wind
    8284    USE yamada_ini_mod, ONLY : yamada_ini
    8385    USE lmdz_atke_turbulence_ini, ONLY : atke_ini
    … …  
    365367       rneblsvol, &
    366368       pfraclr, pfracld, cldfraliq, sigma2_icefracturb, mean_icefracturb,  &
     369       cldfraliqth, sigma2_icefracturbth, mean_icefracturbth,  &
    367370       distcltop, temp_cltop,  &
    368371       !-- LSCP - condensation and ice supersaturation variables
    … …  
    525528    !cc      PARAMETER (soil_model=.FALSE.)
    526529    !======================================================================
    527     ! Dans les versions precedentes, l'eau liquide nuageuse utilisee dans
    528     ! le calcul du rayonnement est celle apres la precipitation des nuages.
    529     ! Si cette cle new_oliq est activee, ce sera une valeur moyenne entre
    530     ! la condensation et la precipitation. Cette cle augmente les impacts
    531     ! radiatifs des nuages.
    532     !cc      LOGICAL new_oliq
    533     !cc      PARAMETER (new_oliq=.FALSE.)
    534     !======================================================================
    535530    ! Clefs controlant deux parametrisations de l'orographie:
    536531    !c      LOGICAL ok_orodr
    … …  
    13701365    !AI namelist pour gerer le double appel de Ecrad
    13711366    CHARACTER(len=512) :: namelist_ecrad_file
     1367
     1368    ! Subgrid scale wind :
     1369    ! Need to be allocatable/save because the number of bin is not known (provided by surf_wind_ini)
     1370    integer, save :: nsurfwind=1
     1371    real, dimension(:,:), allocatable, save :: surf_wind_value, surf_wind_proba ! module and probability of sugrdi wind wind sample
     1372    !$OMP THREADPRIVATE(nsurfwind,surf_wind_value, surf_wind_proba)
    13721373
    13731374    !======================================================================!
    … …  
    19731974
    19741975       CALL iniradia(klon,klev,paprs(1,1:klev+1))
     1976
     1977
     1978!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1979       CALL surf_wind_ini(klon,lunout)
     1980       CALL getin_p('nsurfwind',nsurfwind)
     1981       allocate(surf_wind_value(klon,nsurfwind),surf_wind_proba(klon,nsurfwind))
    19751982
    19761983!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    … …  
    33413348                                !>nrlmd+jyg
    33423349             treedrg &           
     3350!AM
     3351            , tsurf_tersrf, tsoil_tersrf, qsurf_tersrf, tsurf_new_tersrf, &
     3352            cdragm_tersrf, cdragh_tersrf, &
     3353            swnet_tersrf, lwnet_tersrf, fluxsens_tersrf, fluxlat_tersrf &
    33433354#ifdef ISO
    33443355     &   ,xtrain_fall, xtsnow_fall,xt_seri, &
    … …  
    49444955
    49454956    ENDIF
     4957
     4958    !
     4959    !===================================================================
     4960    ! Computation of subrgid scale near-surface wind distribution
     4961    ! Developed for dust lifting. Could be extended to coupling with ocean and others
     4962    ! by default : 1 bin equal to the mean wind
     4963       
     4964     call surf_wind(klon,nsurfwind,zu10m,zv10m,wake_s,wake_Cstar,zustar,ale_bl,surf_wind_value,surf_wind_proba)
     4965   
     4966
    49464967    !
    49474968    !===================================================================
    … …  
    50815102         t_seri, q_seri, ql_seri_lscp, qi_seri_lscp, ptconv, ratqs, sigma_qtherm, &
    50825103         d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, rneblsvol, &
    5083          pfraclr, pfracld, cldfraliq, sigma2_icefracturb, mean_icefracturb,  &
     5104         pfraclr, pfracld, cldfraliq, cldfraliqth, &
     5105         sigma2_icefracturb, sigma2_icefracturbth, &
     5106         mean_icefracturb, mean_icefracturbth,     &
    50845107         radocond, picefra, rain_lsc, snow_lsc, &
    50855108         frac_impa, frac_nucl, beta_prec_fisrt, &
    50865109         prfl, psfl, rhcl,  &
    5087          zqasc, fraca,ztv,zpspsk,ztla,zthl,iflag_cld_th, &
     5110         zqasc, fraca,ztv,zpspsk,ztla,zthl,zw2,iflag_cld_th, &
    50885111         iflag_ice_thermo, distcltop, temp_cltop,   &
    50895112         pbl_tke(:,:,is_ave), pbl_eps(:,:,is_ave), &
     5113         entr_therm, detr_therm, &
    50905114         cell_area, &
    50915115         cf_seri, rvc_seri, u_seri, v_seri, &
    … …  
    51955219       DO i = 1, klon
    51965220          cldfra(i,k) = rneb(i,k)
    5197           !CR: a quoi ca sert? Faut-il ajouter qs_seri?
    5198           !EV: en effet etrange, j'ajouterais aussi qs_seri
    5199           !    plus largement, je nettoierais (enleverrais) ces lignes
    5200           IF (.NOT.new_oliq) radocond(i,k) = ql_seri(i,k)
     5221          ! keep only liquid droplets in radocond if not liqice_in_radocond
     5222          IF (.NOT.liqice_in_radocond) radocond(i,k) = ql_seri(i,k)
    52015223       ENDDO
    52025224    ENDDO
    … …  
    69016923IF (CPPKEY_DUST) THEN
    69026924    !  Avec SPLA, iflag_phytrac est forcé =1
    6903     CALL       phytracr_spl ( debut,lafin , jD_cur,jH_cur,iflag_con,       &  ! I
    6904                       pdtphys,ftsol,                                   &  ! I
    6905                       t,q_seri,paprs,pplay,RHcl,                  &  ! I
    6906                       pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,          &  ! I
    6907                       coefh(1:klon,1:klev,is_ave), cdragh, cdragm, u1, v1,                 &  ! I
    6908                       u_seri, v_seri, latitude_deg, longitude_deg,  &
    6909                       pphis,pctsrf,pmflxr,pmflxs,prfl,psfl,            &  ! I
    6910                       da,phi,phi2,d1a,dam,mp,ep,sigd,sij,clw,elij,     &  ! I
    6911                       epmlmMm,eplaMm,upwd,dnwd,itop_con,ibas_con,      &  ! I
    6912                       ev,wdtrainA,  wdtrainM,wght_cvfd,              &  ! I
    6913                       fm_therm, entr_therm, rneb,                      &  ! I
    6914                       beta_prec_fisrt,beta_prec, & !I
    6915                       zu10m,zv10m,wstar,ale_bl,ale_wake,               &  ! I
     6925    CALL       phytracr_spl ( debut,lafin , jD_cur,jH_cur,iflag_con,       &
     6926                      pdtphys,ftsol,                                       &
     6927                      t,q_seri,paprs,pplay,RHcl,                           &
     6928                      pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,              &
     6929                      coefh(1:klon,1:klev,is_ave), cdragh, cdragm, u1, v1, &
     6930                      u_seri, v_seri, latitude_deg, longitude_deg,         &
     6931                      pphis,pctsrf,pmflxr,pmflxs,prfl,psfl,                &
     6932                      da,phi,phi2,d1a,dam,mp,ep,sigd,sij,clw,elij,         &
     6933                      epmlmMm,eplaMm,upwd,dnwd,itop_con,ibas_con,          &
     6934                      ev,wdtrainA,  wdtrainM,wght_cvfd,                    &
     6935                      fm_therm, entr_therm, rneb,                          &
     6936                      beta_prec_fisrt,beta_prec,                           &
     6937                      zu10m,zv10m,wstar,ale_bl,ale_wake,                   &
     6938                      nsurfwind,surf_wind_value, surf_wind_proba,          &
    69166939                      d_tr_dyn,tr_seri)
    69176940
Note: See TracChangeset for help on using the changeset viewer.