Changeset 4013


Ignore:
Timestamp:
Nov 19, 2021, 4:58:59 PM (3 years ago)
Author:
lguez
Message:

Sync latest trunk changes to Ocean_skin

Location:
LMDZ6/branches/Ocean_skin
Files:
12 deleted
90 edited
18 copied

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Ocean_skin

  • LMDZ6/branches/Ocean_skin/DefLists/context_lmdz.xml

    r3812 r4013  
    118118        <axis axis_ref="plev" />
    119119     </grid>
     120
     121     <grid id="grid_glo_plev17">
     122        <domain id="dom_glo" />
     123          <axis axis_ref="pres" long_name="pressure" n_glo="17" name="plev" positive="down" standard_name="air_pressure" unit="Pa" value="(0,16)[ 100000. 92500. 85000. 70000. 60000. 50000. 40000. 30000. 25000. 20000. 15000. 10000. 7000. 5000. 3000. 2000. 1000. ]"><interpolate_axis coordinate="pres" order="1" type="polynomial" />
     124        </axis>
     125     </grid>
     126
    120127     <grid id="grid_out_plev">
    121128        <domain domain_ref="dom_out" />

  • LMDZ6/branches/Ocean_skin/DefLists/context_lmdz_sans_cosp.xml

    r3798 r4013  
    107107     </grid>
    108108
     109     <grid id="grid_glo_plev17">
     110        <domain id="dom_glo" />
     111          <axis axis_ref="pres" long_name="pressure" n_glo="17" name="plev" positive="down" standard_name="air_pressure" unit="Pa" value="(0,16)[ 100000. 92500. 85000. 70000. 60000. 50000. 40000. 30000. 25000. 20000. 15000. 10000. 7000. 5000. 3000. 2000. 1000. ]"><interpolate_axis coordinate="pres" order="1" type="polynomial" />
     112        </axis>
     113     </grid>
     114
    109115     <grid id="grid_out_plev">
    110116        <domain domain_ref="dom_out" />

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

    r3812 r4013  
    5656        <field id="t2m_oce"    long_name="Temp 2m oce"    unit="K" />
    5757        <field id="t2m_sic"    long_name="Temp 2m sic"    unit="K" />
     58        <field id="nt2mout"    long_name="nt2m hors intervalle, calc.complet" unit="-" />
     59        <field id="nq2mout"    long_name="nq2m hors intervalle, calc. complet" unit="-" />
     60        <field id="nu2mout"    long_name="nu2m hors intervalle, calc. complet" unit="-" />
     61            <field id="nt2moutfg"  long_name="nt2m hors intervalle, calc. complet/fg" unit="-" />
     62            <field id="nq2moutfg"  long_name="nq2m hors intervalle, calc. complet/fg" unit="-" />
     63            <field id="nu2moutfg"  long_name="nu2m hors intervalle, calc. complet/fg" unit="-" />
    5864        <field id="t2m_probsup25"   field_ref="t2m" long_name="Prob. t2m exceeds 25 degC" unit="-"> t2m &gt; 298.15 </field>
    5965        <field id="t2m_probsup28"   field_ref="t2m" long_name="Prob. t2m exceeds 28 degC" unit="-"> t2m &gt; 301.15 </field>
    … …  
    204210        <field id="tsol_oce"    long_name="Temperature oce"    unit="K" />
    205211        <field id="tsol_sic"    long_name="Temperature sic"    unit="K" />
    206         <field id="evappot_ter"    long_name="Temperature ter"    unit="K" />
    207         <field id="evappot_lic"    long_name="Temperature lic"    unit="K" />
    208         <field id="evappot_oce"    long_name="Temperature oce"    unit="K" />
    209         <field id="evappot_sic"    long_name="Temperature sic"    unit="K" />
     212        <field id="evappot_ter"    long_name="Potential evaporation ter"    unit="kg/(m2*s)" />
     213        <field id="evappot_lic"    long_name="Potential evaporation lic"    unit="kg/(m2*s)" />
     214        <field id="evappot_oce"    long_name="Potential evaporation oce"    unit="kg/(m2*s)" />
     215        <field id="evappot_sic"    long_name="Potential evaporation sic"    unit="kg/(m2*s)" />
    210216        <field id="sens_ter"    long_name="Sensible heat flux ter"    unit="W/m2" />
    211217        <field id="sens_lic"    long_name="Sensible heat flux lic"    unit="W/m2" />
    … …  
    520526        <field id="flx_co2_land"   long_name="CO2 flux from land"             unit="kg CO2/m2/s" />    <!-- Added OB -->
    521527        <field id="flx_co2_ocean"  long_name="CO2 flux from ocean"            unit="kg CO2/m2/s" />    <!-- Added OB -->
     528        <field id="flx_co2_ocean_cor"  long_name="correction of the CO2 flux from ocean"          unit="kg CO2/m2/s" />    <!-- Added PC -->
     529        <field id="flx_co2_land_cor"   long_name="correction of the CO2 flux from land"           unit="kg CO2/m2/s" />    <!-- Added PC -->
    522530        <field id="flx_co2_ff"     long_name="CO2 flux from ff"               unit="kg CO2/m2/s" />    <!-- Added OB -->
    523531        <field id="flx_co2_bb"     long_name="CO2 flux from bb"               unit="kg CO2/m2/s" />    <!-- Added OB -->

  • LMDZ6/branches/Ocean_skin/DefLists/file_def_histLES_lmdz.xml

    r3605 r4013  
    22<file_definition>
    33    <file_group id="defile">
    4         <file id="histLES" name="XhistLES" output_freq="1h" output_level="11" enabled="false" compression_level="0">
     4        <file id="histLES" name="XhistLES" output_freq="1h" output_level="11" enabled=".FALSE." compression_level="0">
    55           
    66            <!-- VARS 1D -->

  • LMDZ6/branches/Ocean_skin/DefLists/file_def_histins_lmdz.xml

    r3605 r4013  
    22<file_definition>
    33    <file_group id="defile">
    4         <file id="histins" name="Xhistins" output_freq="1ts" output_level="11" enabled="false" compression_level="0">
     4        <file id="histins" name="Xhistins" output_freq="1ts" output_level="11" enabled=".FALSE." compression_level="0">
    55           
    66            <!-- VARS 1D -->
    … …  
    374374                <field field_ref="lcc" level="10" />
    375375                <field field_ref="wvapp" level="10" />
    376                 <field field_ref="ozone_daylight" level="10" />
    377376                <field field_ref="albe_ter" level="10" />
    378377                <field field_ref="albe_lic" level="10" />
    … …  
    626625                <field field_ref="rsdcs4co2" level="10" />
    627626                <field field_ref="rldcs4co2" level="10" />
     627                <field field_ref="ozone_daylight" level="10" />
    628628            </field_group>
    629629          </field_group>

  • LMDZ6/branches/Ocean_skin/DefLists/file_def_histmth_lmdz.xml

    r3812 r4013  
    280280                <field field_ref="colO3_strat" level="2" />     <!-- Added ThL -->
    281281                <field field_ref="colO3_trop"  level="2" />     <!-- Added ThL -->
     282                <field field_ref="flx_co2_ocean"  level="1" />
     283                <field field_ref="flx_co2_land"   level="1" />
     284                <field field_ref="flx_co2_ocean_cor" level="1" /> <!-- Added PC -->
     285                <field field_ref="flx_co2_land_cor"  level="1" /> <!-- Added PC -->
     286                <field field_ref="flx_co2_ff"  level="1" />
     287                <field field_ref="flx_co2_bb"  level="1" />
    282288
    283289                <field_group operation="average" detect_missing_value=".true.">
    … …  
    689695            </field_group>
    690696
     697<!--
     698                <field field_ref="psbg" level="5" />
     699                <field field_ref="tro3" level="5" />
     700                <field field_ref="tro3_daylight" level="5" />
     701-->
     702
     703            <!-- VARS 3D -->
     704            <field_group operation="average" grid_ref="grid_glo_plev17">
     705                <field field_ref="temp" name="ta" grid_ref="grid_glo_plev17" level="4" />
     706                <field field_ref="geop" name="zg" grid_ref="grid_glo_plev17" level="4" />
     707                <field field_ref="ovap" name="hus" grid_ref="grid_glo_plev17" level="4" />
     708                <field field_ref="rhum" name="hur" grid_ref="grid_glo_plev17" level="4" />
     709                <field field_ref="vitu" name="ua" grid_ref="grid_glo_plev17" level="4" />
     710                <field field_ref="vitv" name="va" grid_ref="grid_glo_plev17" level="4" />
     711                <field field_ref="vitw" name="wap" grid_ref="grid_glo_plev17" level="4" />
     712<!--
     713                <field field_ref="tro3" name="tro3" grid_ref="grid_glo_plev17" level="4" />
     714                <field field_ref="tro3_daylight" name="tro3_daylight" grid_ref="grid_glo_plev17" level="4" />
     715                <field field_ref="tnondef" name="psbg" grid_ref="grid_glo_plev17" level="4" />
     716                <field field_ref="vitu_vitv" name="uv" grid_ref="grid_glo_plev17" level="4" />
     717                <field field_ref="vitv_ovap" name="vq" grid_ref="grid_glo_plev17" level="4" />
     718                <field field_ref="vitv_temp" name="vT" grid_ref="grid_glo_plev17" level="4" />
     719                <field field_ref="vitw_ovap" name="wq" grid_ref="grid_glo_plev17" level="4" />
     720                <field field_ref="vitv_geop" name="vphi" grid_ref="grid_glo_plev17" level="4" />
     721                <field field_ref="vitw_temp" name="wT" grid_ref="grid_glo_plev17" level="4" />
     722                <field field_ref="vtiu_vitu" name="u2" grid_ref="grid_glo_plev17" level="4" />
     723                <field field_ref="vitv_vitv" name="v2" grid_ref="grid_glo_plev17" level="4" />
     724                <field field_ref="temp_temp" name="T2" grid_ref="grid_glo_plev17" level="4" />
     725-->
     726            </field_group>
     727
    691728            <!-- VARS 3D -->
    692729            <field_group operation="average" grid_ref="grid_out_spectband">

  • LMDZ6/branches/Ocean_skin/DefLists/physiq.def_NPv6.1

    r3812 r4013  
    169169iflag_albedo=1
    170170
     171    # Controle de la definition de l'inertie thermique du sol dans le modele "bucket":
     172    #   0 (default) : constant
     173    #   1 : fonction lineaire de qsol
     174    #   2 : 2 fonctions lineaires de qsol :
     175    #       une pour "sable" (boite lat/lon pour Sahara), une pour le reste (limons et argile)
     176    #   3 : fonction lineaire de qsol, valeurs entre 900 pour qsol=0 et 2000 pour qsol=150
     177iflag_inertie=0
     178
    171179          # Frequence appel convection. Nombre appels par jour
    172180nbapp_cv=48

  • LMDZ6/branches/Ocean_skin/arch/arch-X64_IRENE-AMD.fcm

    r3798 r4013  
    99%PROD_FFLAGS         -O3 -mavx2 -fp-model fast=2
    1010%DEV_FFLAGS          -fp-model strict -p -g -O2 -traceback -fp-stack-check
    11 %DEBUG_FFLAGS        -fp-model strict -p -g -traceback -fp-stack-check -ftrapuv
    12 #%DEBUG_FFLAGS        -fp-model strict -p -g -traceback -fp-stack-check -ftrapuv -check bounds,noarg_temp_created,pointers,stack,uninit -debug full -init=arrays -init=snan
     11%DEBUG_FFLAGS        -fp-model strict -p -g -traceback -fp-stack-check -ftrapuv -check bounds,noarg_temp_created,pointers,stack,uninit -debug full -init=arrays -init=snan
    1312%MPI_FFLAGS
    1413%OMP_FFLAGS          -qopenmp

  • LMDZ6/branches/Ocean_skin/arch/arch-X64_IRENE.fcm

    r3605 r4013  
    1010%PROD_FFLAGS         -O3 -axAVX,SSE4.2 -fp-model fast=2
    1111%DEV_FFLAGS          -fp-model strict -p -g -O2 -traceback -fp-stack-check
    12 %DEBUG_FFLAGS        -fp-model strict -p -g -traceback -fp-stack-check -ftrapuv
    13 #%DEBUG_FFLAGS        -fp-model strict -p -g -traceback -fp-stack-check -ftrapuv -check bounds,noarg_temp_created,pointers,stack,uninit -debug full -init=arrays -init=snan
     12%DEBUG_FFLAGS        -fp-model strict -p -g -traceback -fp-stack-check -ftrapuv -check bounds,noarg_temp_created,pointers,stack,uninit -debug full -init=arrays -init=snan
    1413%MPI_FFLAGS
    1514%OMP_FFLAGS          -qopenmp

  • LMDZ6/branches/Ocean_skin/bld.cfg

    r3812 r4013  
    2626src::dyn_phys %DYN_PHYS
    2727src::dyn_phys_sub %DYN_PHYS_SUB
    28 src::sisvat  %SISVAT
    2928src::inlandsis  %INLANDSIS
    30 src::rrtm    %RRTM
     29src::rad    %RAD
    3130src::dust    %DUST
    3231src::strataer %STRATAER
    … …  
    3837src::cosp    %COSP
    3938src::ext_src %EXT_SRC
     39src::Ocean_skin %SRC_PATH/%PHYS/Ocean_skin
    4040
    4141bld::lib            lmdz

  • LMDZ6/branches/Ocean_skin/libf/dyn3d/conf_gcm.F90

    r3605 r4013  
    595595     !Config         'inca' = model de chime INCA
    596596     !Config         'repr' = model de chime REPROBUS
     597     !Config         'inco' = INCA + CO2i (temporaire)
    597598     type_trac = 'lmdz'
    598599     CALL getin('type_trac',type_trac)
    … …  
    790791     !Config         'inca' = model de chime INCA
    791792     !Config         'repr' = model de chime REPROBUS
     793     !Config         'inco' = INCA + CO2i (temporaire)
    792794     type_trac = 'lmdz'
    793795     CALL getin('type_trac',type_trac)

  • LMDZ6/branches/Ocean_skin/libf/dyn3d/dynredem.F90

    r3811 r4013  
    227227!--- Tracers in file "start_trac.nc" (added by Anne)
    228228  lread_inca=.FALSE.; fil="start_trac.nc"
    229   IF(type_trac=='inca') INQUIRE(FILE=fil,EXIST=lread_inca)
     229  IF(type_trac=='inca' .OR. type_trac=='inco') INQUIRE(FILE=fil,EXIST=lread_inca)
    230230  IF(lread_inca) CALL err(NF90_OPEN(fil,NF90_NOWRITE,nid_trac),"open")
    231231

  • LMDZ6/branches/Ocean_skin/libf/dyn3d/guide_mod.F90

    r3811 r4013  
    99!=======================================================================
    1010
    11   USE getparam
     11  USE getparam, only: ini_getparam, fin_getparam, getpar
    1212  USE Write_Field
    13   use netcdf, only: nf90_nowrite, nf90_open, nf90_inq_varid, nf90_close
    14   use pres2lev_mod
     13  use netcdf, only: nf90_nowrite, nf90_open, nf90_inq_varid, nf90_close, &
     14                    nf90_inq_dimid, nf90_inquire_dimension
     15  use pres2lev_mod, only: pres2lev
    1516
    1617  IMPLICIT NONE
    … …  
    2021! ---------------------------------------------
    2122  INTEGER, PRIVATE, SAVE  :: iguide_read,iguide_int,iguide_sav
    22   INTEGER, PRIVATE, SAVE  :: nlevnc
     23  INTEGER, PRIVATE, SAVE  :: nlevnc, guide_plevs
    2324  LOGICAL, PRIVATE, SAVE  :: guide_u,guide_v,guide_T,guide_Q,guide_P
    2425  LOGICAL, PRIVATE, SAVE  :: guide_hr,guide_teta 
    2526  LOGICAL, PRIVATE, SAVE  :: guide_BL,guide_reg,guide_add,gamma4,guide_zon
    26   LOGICAL, PRIVATE, SAVE  :: guide_modele,invert_p,invert_y,ini_anal
    27   LOGICAL, PRIVATE, SAVE  :: guide_2D,guide_sav
     27  LOGICAL, PRIVATE, SAVE  :: invert_p,invert_y,ini_anal
     28  LOGICAL, PRIVATE, SAVE  :: guide_2D,guide_sav,guide_modele
     29!FC
     30  LOGICAL, PRIVATE, SAVE  :: convert_Pa
    2831 
    2932  REAL, PRIVATE, SAVE     :: tau_min_u,tau_max_u
    … …  
    4952  REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE, SAVE   :: tnat1,tnat2
    5053  REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE, SAVE   :: qnat1,qnat2
     54  REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE, SAVE   :: pnat1,pnat2
    5155  REAL, ALLOCATABLE, DIMENSION(:,:),   PRIVATE, SAVE   :: psnat1,psnat2
    5256  REAL, ALLOCATABLE, DIMENSION(:),     PRIVATE, SAVE   :: apnc,bpnc
    … …  
    7579    CHARACTER (len = 80)   :: abort_message
    7680    CHARACTER (len = 20)   :: modname = 'guide_init'
     81    CHARACTER (len = 20)   :: namedim
    7782
    7883! ---------------------------------------------
    … …  
    140145        iguide_int=day_step*iguide_int
    141146    ENDIF
    142     CALL getpar('guide_modele',.false.,guide_modele,'guidage niveaux modele')
     147    CALL getpar('guide_plevs',0,guide_plevs,'niveaux pression fichiers guidage')
     148    ! Pour compatibilite avec ancienne version avec guide_modele
     149    CALL getpar('guide_modele',.false.,guide_modele,'niveaux pression ap+bp*psol')
     150    IF (guide_modele) THEN
     151        guide_plevs=1
     152    ENDIF
     153!FC
     154    CALL getpar('convert_Pa',.true.,convert_Pa,'Convert Pressure levels in Pa')
     155    ! Fin raccord
    143156    CALL getpar('ini_anal',.false.,ini_anal,'Etat initial = analyse')
    144157    CALL getpar('guide_invertp',.true.,invert_p,'niveaux p inverses')
    … …  
    153166! ---------------------------------------------
    154167    ncidpl=-99
    155     if (guide_modele) then
     168    if (guide_plevs.EQ.1) then
    156169       if (ncidpl.eq.-99) then
    157170          rcod=nf90_open('apbp.nc',Nf90_NOWRITe, ncidpl)
    158171          if (rcod.NE.NF_NOERR) THEN
    159              CALL abort_gcm(modname, &
    160                   'Guide: probleme -> pas de fichier apbp.nc',1)
     172             abort_message=' Nudging error -> no file apbp.nc'
     173             CALL abort_gcm(modname,abort_message,1)
    161174          endif
    162175       endif
    163     else
    164          if (guide_u) then
     176    elseif (guide_plevs.EQ.2) then
     177       if (ncidpl.EQ.-99) then
     178          rcod=nf90_open('P.nc',Nf90_NOWRITe,ncidpl)
     179          if (rcod.NE.NF_NOERR) THEN
     180             abort_message=' Nudging error -> no file P.nc'
     181             CALL abort_gcm(modname,abort_message,1)
     182          endif
     183       endif
     184
     185    elseif (guide_u) then
    165186           if (ncidpl.eq.-99) then
    166187               rcod=nf90_open('u.nc',Nf90_NOWRITe,ncidpl)
    167188               if (rcod.NE.NF_NOERR) THEN
    168189                  CALL abort_gcm(modname, &
    169                        'Guide: probleme -> pas de fichier u.nc',1)
     190                       ' Nudging error -> no file u.nc',1)
    170191               endif
    171192           endif
    172          elseif (guide_v) then
     193
     194    elseif (guide_v) then
    173195           if (ncidpl.eq.-99) then
    174196               rcod=nf90_open('v.nc',nf90_nowrite,ncidpl)
    175197               if (rcod.NE.NF_NOERR) THEN
    176198                  CALL abort_gcm(modname, &
    177                        'Guide: probleme -> pas de fichier v.nc',1)
     199                       ' Nudging error -> no file v.nc',1)
    178200               endif
    179201           endif
    180          elseif (guide_T) then
     202    elseif (guide_T) then
    181203           if (ncidpl.eq.-99) then
    182204               rcod=nf90_open('T.nc',nf90_nowrite,ncidpl)
    183205               if (rcod.NE.NF_NOERR) THEN
    184206                  CALL abort_gcm(modname, &
    185                        'Guide: probleme -> pas de fichier T.nc',1)
     207                       ' Nudging error -> no file T.nc',1)
    186208               endif
    187209           endif
    188          elseif (guide_Q) then
     210    elseif (guide_Q) then
    189211           if (ncidpl.eq.-99) then
    190212               rcod=nf90_open('hur.nc',nf90_nowrite, ncidpl)
    191213               if (rcod.NE.NF_NOERR) THEN
    192214                  CALL abort_gcm(modname, &
    193                        'Guide: probleme -> pas de fichier hur.nc',1)
     215                       ' Nudging error -> no file hur.nc',1)
    194216               endif
    195217           endif
    196          endif
     218
     219
    197220    endif
    198221    error=NF_INQ_DIMID(ncidpl,'LEVEL',rid)
    199222    IF (error.NE.NF_NOERR) error=NF_INQ_DIMID(ncidpl,'PRESSURE',rid)
    200223    IF (error.NE.NF_NOERR) THEN
    201         CALL abort_gcm(modname,'Guide: probleme lecture niveaux pression',1)
     224        CALL abort_gcm(modname,'Nudging: error reading pressure levels',1)
    202225    ENDIF
    203226    error=NF_INQ_DIMLEN(ncidpl,rid,nlevnc)
    204     print *,'Guide: nombre niveaux vert. nlevnc', nlevnc
     227    write(*,*)trim(modname)//' : number of vertical levels nlevnc', nlevnc
    205228    rcod = nf90_close(ncidpl)
    206229
    … …  
    208231! Allocation des variables
    209232! ---------------------------------------------
    210     abort_message='pb in allocation guide'
     233    abort_message='nudging allocation error'
    211234
    212235    ALLOCATE(apnc(nlevnc), stat = error)
    … …  
    278301    ENDIF
    279302
    280     IF (guide_P.OR.guide_modele) THEN
     303    IF (guide_plevs.EQ.2) THEN
     304        ALLOCATE(pnat1(iip1,jjp1,nlevnc), stat = error)
     305        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
     306        ALLOCATE(pnat2(iip1,jjp1,nlevnc), stat = error)
     307        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
     308        pnat1=0.;pnat2=0.;
     309    ENDIF
     310
     311    IF (guide_P.OR.guide_plevs.EQ.1) THEN
    281312        ALLOCATE(psnat1(iip1,jjp1), stat = error)
    282313        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
    … …  
    305336    IF (guide_T) tnat1=tnat2
    306337    IF (guide_Q) qnat1=qnat2
    307     IF (guide_P.OR.guide_modele) psnat1=psnat2
     338    IF (guide_plevs.EQ.2) pnat1=pnat2
     339    IF (guide_P.OR.guide_plevs.EQ.1) psnat1=psnat2
    308340
    309341  END SUBROUTINE guide_init
    … …  
    312344  SUBROUTINE guide_main(itau,ucov,vcov,teta,q,masse,ps)
    313345
     346    USE exner_hyb_m, ONLY: exner_hyb
     347    USE exner_milieu_m, ONLY: exner_milieu
    314348    USE control_mod, ONLY: day_step, iperiod
    315     USE comconst_mod, ONLY: dtvr, daysec
    316     USE comvert_mod, ONLY: ap, bp, preff, presnivs
     349    USE comconst_mod, ONLY: cpp, dtvr, daysec,kappa
     350    USE comvert_mod, ONLY: ap, bp, preff, presnivs, pressure_exner
    317351 
    318352    IMPLICIT NONE
    … …  
    331365    LOGICAL       :: f_out ! sortie guidage
    332366    REAL, DIMENSION (ip1jmp1,llm) :: f_add ! var aux: champ de guidage
    333     REAL, DIMENSION (ip1jmp1,llm) :: p ! besoin si guide_P
     367    REAL :: pk(ip1jmp1,llm) ! Exner at mid-layers
     368    REAL :: pks(ip1jmp1) ! Exner at the surface
     369    REAL :: unskap ! 1./kappa
     370    REAL, DIMENSION (ip1jmp1,llmp1) :: p ! Pressure at inter-layers
    334371    ! Compteurs temps:
    335372    INTEGER, SAVE :: step_rea,count_no_rea,itau_test ! lecture guidage
    … …  
    339376   
    340377    INTEGER       :: l
     378    CHARACTER(LEN=20) :: modname="guide_main"
    341379
    342380!-----------------------------------------------------------------------
    … …  
    379417        ENDIF
    380418! Verification structure guidage
    381         IF (guide_u) THEN
    382             CALL writefield('unat',unat1)
    383             CALL writefield('ucov',RESHAPE(ucov,(/iip1,jjp1,llm/)))
    384         ENDIF
    385         IF (guide_T) THEN
    386             CALL writefield('tnat',tnat1)
    387             CALL writefield('teta',RESHAPE(teta,(/iip1,jjp1,llm/)))
    388         ENDIF
     419!        IF (guide_u) THEN
     420!            CALL writefield('unat',unat1)
     421!            CALL writefield('ucov',RESHAPE(ucov,(/iip1,jjp1,llm/)))
     422!        ENDIF
     423!        IF (guide_T) THEN
     424!            CALL writefield('tnat',tnat1)
     425!            CALL writefield('teta',RESHAPE(teta,(/iip1,jjp1,llm/)))
     426!        ENDIF
    389427
    390428    ENDIF !first
    … …  
    404442      IF (reste.EQ.0.) THEN
    405443          IF (itau_test.EQ.itau) THEN
    406               write(*,*)'deuxieme passage de advreel a itau=',itau
    407               stop
     444            write(*,*)trim(modname)//' second pass in advreel at itau=',&
     445            itau
     446            stop
    408447          ELSE
    409448              IF (guide_v) vnat1=vnat2
    … …  
    411450              IF (guide_T) tnat1=tnat2
    412451              IF (guide_Q) qnat1=qnat2
    413               IF (guide_P.OR.guide_modele) psnat1=psnat2
     452              IF (guide_plevs.EQ.2) pnat1=pnat2
     453              IF (guide_P.OR.guide_plevs.EQ.1) psnat1=psnat2
    414454              step_rea=step_rea+1
    415455              itau_test=itau
    416               print*,'Lecture fichiers guidage, pas ',step_rea, &
    417                     'apres ',count_no_rea,' non lectures'
     456              write(*,*)trim(modname)//' Reading nudging files, step ',&
     457                     step_rea,'after ',count_no_rea,' skips'
    418458              IF (guide_2D) THEN
    419459                  CALL guide_read2D(step_rea)
    … …  
    447487! Sauvegarde du guidage?
    448488    f_out=((MOD(itau,iguide_sav).EQ.0).AND.guide_sav) 
    449     IF (f_out) CALL guide_out("SP",jjp1,1,ps)
     489    IF (f_out) THEN
     490      ! compute pressures at layer interfaces
     491      CALL pression(ip1jmp1,ap,bp,ps,p)
     492      if (pressure_exner) then
     493        call exner_hyb(ip1jmp1,ps,p,pks,pk)
     494      else
     495        call exner_milieu(ip1jmp1,ps,p,pks,pk)
     496      endif
     497      unskap=1./kappa
     498      ! Now compute pressures at mid-layer
     499      do l=1,llm
     500        p(:,l)=preff*(pk(:,l)/cpp)**unskap
     501      enddo
     502      CALL guide_out("SP",jjp1,llm,p(:,1:llm))
     503    ENDIF
    450504   
    451505    if (guide_u) then
    … …  
    483537        if (guide_zon) CALL guide_zonave(2,jjp1,1,f_add(1:ip1jmp1,1))
    484538        CALL guide_addfield(ip1jmp1,1,f_add(1:ip1jmp1,1),alpha_P)
    485         IF (f_out) CALL guide_out("ps",jjp1,1,f_add(1:ip1jmp1,1)/factt)
     539!        IF (f_out) CALL guide_out("ps",jjp1,1,f_add(1:ip1jmp1,1)/factt)
    486540        ps=ps+f_add(1:ip1jmp1,1)
    487541        CALL pression(ip1jmp1,ap,bp,ps,p)
    … …  
    637691 
    638692  INTEGER                            :: i,j,l,ij
     693  CHARACTER(LEN=20),PARAMETER :: modname="guide_interp"
    639694 
    640     print *,'Guide: conversion variables guidage'
     695    write(*,*)trim(modname)//': interpolate nudging variables'
    641696! -----------------------------------------------------------------
    642697! Calcul des niveaux de pression champs guidage
    … …  
    664719    if (first) then
    665720        first=.FALSE.
    666         print*,'Guide: verification ordre niveaux verticaux'
    667         print*,'LMDZ :'
     721        write(*,*)trim(modname)//' : check vertical level order'
     722        write(*,*)trim(modname)//' LMDZ :'
    668723        do l=1,llm
    669             print*,'PL(',l,')=',(ap(l)+ap(l+1))/2. &
     724          write(*,*)trim(modname)//' PL(',l,')=',(ap(l)+ap(l+1))/2. &
    670725                  +psi(1,jjp1)*(bp(l)+bp(l+1))/2.
    671726        enddo
    672         print*,'Fichiers guidage'
     727        write(*,*)trim(modname)//' nudging file :'
    673728        do l=1,nlevnc
    674              print*,'PL(',l,')=',plnc2(1,1,l)
     729          write(*,*)trim(modname)//' PL(',l,')=',plnc2(1,1,l)
    675730        enddo
    676         print *,'inversion de l''ordre: invert_p=',invert_p
     731        write(*,*)trim(modname)//' invert ordering: invert_p=',invert_p
    677732        if (guide_u) then
    678733            do l=1,nlevnc
    679                 print*,'U(',l,')=',unat2(1,1,l)
     734              write(*,*)trim(modname)//' U(',l,')=',unat2(1,1,l)
    680735            enddo
    681736        endif
    682737        if (guide_T) then
    683738            do l=1,nlevnc
    684                 print*,'T(',l,')=',tnat2(1,1,l)
     739              write(*,*)trim(modname)//' T(',l,')=',tnat2(1,1,l)
    685740            enddo
    686741        endif
    … …  
    881936    real alphamin,alphamax,xi
    882937    integer i,j,ilon,ilat
     938    character(len=20),parameter :: modname="tau2alpha"
    883939
    884940
    … …  
    9691025            ! Calcul de gamma
    9701026            if (abs(grossismx-1.).lt.0.1.or.abs(grossismy-1.).lt.0.1) then
    971                  print*,'ATTENTION modele peu zoome'
    972                  print*,'ATTENTION on prend une constante de guidage cste'
    973                  gamma=0.
     1027              write(*,*)trim(modname)//' ATTENTION modele peu zoome'
     1028              write(*,*)trim(modname)//' ATTENTION on prend une constante de guidage cste'
     1029              gamma=0.
    9741030            else
    975                 gamma=(dxdy_max-2.*dxdy_min)/(dxdy_max-dxdy_min)
    976                 print*,'gamma=',gamma
    977                 if (gamma.lt.1.e-5) then
    978                   print*,'gamma =',gamma,'<1e-5'
    979                   stop
    980                 endif
    981                 gamma=log(0.5)/log(gamma)
    982                 if (gamma4) then
    983                   gamma=min(gamma,4.)
    984                 endif
    985                 print*,'gamma=',gamma
     1031              gamma=(dxdy_max-2.*dxdy_min)/(dxdy_max-dxdy_min)
     1032              write(*,*)trim(modname)//' gamma=',gamma
     1033              if (gamma.lt.1.e-5) then
     1034                write(*,*)trim(modname)//' gamma =',gamma,'<1e-5'
     1035                stop
     1036              endif
     1037              gamma=log(0.5)/log(gamma)
     1038              if (gamma4) then
     1039                gamma=min(gamma,4.)
     1040              endif
     1041              write(*,*)trim(modname)//' gamma=',gamma
    9861042            endif
    9871043        ENDIF !first
    … …  
    10241080    IMPLICIT NONE
    10251081
    1026 #include "netcdf.inc"
    1027 #include "dimensions.h"
    1028 #include "paramet.h"
     1082    include "netcdf.inc"
     1083    include "dimensions.h"
     1084    include "paramet.h"
    10291085
    10301086    INTEGER, INTENT(IN)   :: timestep
    … …  
    10321088    LOGICAL, SAVE         :: first=.TRUE.
    10331089! Identification fichiers et variables NetCDF:
    1034     INTEGER, SAVE         :: ncidu,varidu,ncidv,varidv,ncidQ
    1035     INTEGER, SAVE         :: varidQ,ncidt,varidt,ncidps,varidps
    1036     INTEGER               :: ncidpl,varidpl,varidap,varidbp
     1090    INTEGER, SAVE         :: ncidu,varidu,ncidv,varidv,ncidp,varidp
     1091    INTEGER, SAVE         :: ncidQ,varidQ,ncidt,varidt,ncidps,varidps
     1092    INTEGER               :: ncidpl,varidpl,varidap,varidbp,dimid,lendim
    10371093! Variables auxiliaires NetCDF:
    10381094    INTEGER, DIMENSION(4) :: start,count
    10391095    INTEGER               :: status,rcode
    1040 
    10411096    CHARACTER (len = 80)   :: abort_message
    10421097    CHARACTER (len = 20)   :: modname = 'guide_read'
     1098    CHARACTER (len = 20)   :: namedim
     1099
    10431100! -----------------------------------------------------------------
    10441101! Premier appel: initialisation de la lecture des fichiers
    … …  
    10461103    if (first) then
    10471104         ncidpl=-99
    1048          print*,'Guide: ouverture des fichiers guidage '
     1105         write(*,*),trim(modname)//': opening nudging files '
    10491106! Niveaux de pression si non constants
    1050          if (guide_modele) then
    1051              print *,'Lecture du guidage sur niveaux modele'
     1107         if (guide_plevs.EQ.1) then
     1108             write(*,*),trim(modname)//' Reading nudging on model levels'
    10521109             rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
    10531110             IF (rcode.NE.NF_NOERR) THEN
    1054               print *,'Guide: probleme -> pas de fichier apbp.nc'
     1111              abort_message='Nudging: error -> no file apbp.nc'
    10551112              CALL abort_gcm(modname,abort_message,1)
    10561113             ENDIF
    10571114             rcode = nf90_inq_varid(ncidpl, 'AP', varidap)
    10581115             IF (rcode.NE.NF_NOERR) THEN
    1059               print *,'Guide: probleme -> pas de variable AP, fichier apbp.nc'
     1116              abort_message='Nudging: error -> no AP variable in file apbp.nc'
    10601117              CALL abort_gcm(modname,abort_message,1)
    10611118             ENDIF
    10621119             rcode = nf90_inq_varid(ncidpl, 'BP', varidbp)
    10631120             IF (rcode.NE.NF_NOERR) THEN
    1064               print *,'Guide: probleme -> pas de variable BP, fichier apbp.nc'
     1121              abort_message='Nudging: error -> no BP variable in file apbp.nc'
    10651122              CALL abort_gcm(modname,abort_message,1)
    10661123             ENDIF
    1067              print*,'ncidpl,varidap',ncidpl,varidap
     1124             write(*,*),trim(modname)//' ncidpl,varidap',ncidpl,varidap
    10681125         endif
     1126
     1127! Pression si guidage sur niveaux P variables
     1128         if (guide_plevs.EQ.2) then
     1129             rcode = nf90_open('P.nc', nf90_nowrite, ncidp)
     1130             IF (rcode.NE.NF_NOERR) THEN
     1131              abort_message='Nudging: error -> no file P.nc'
     1132              CALL abort_gcm(modname,abort_message,1)
     1133             ENDIF
     1134             rcode = nf90_inq_varid(ncidp, 'PRES', varidp)
     1135             IF (rcode.NE.NF_NOERR) THEN
     1136              abort_message='Nudging: error -> no PRES variable in file P.nc'
     1137              CALL abort_gcm(modname,abort_message,1)
     1138             ENDIF
     1139             write(*,*),trim(modname)//' ncidp,varidp',ncidp,varidp
     1140             if (ncidpl.eq.-99) ncidpl=ncidp
     1141         endif
     1142
    10691143! Vent zonal
    10701144         if (guide_u) then
    10711145             rcode = nf90_open('u.nc', nf90_nowrite, ncidu)
    10721146             IF (rcode.NE.NF_NOERR) THEN
    1073               print *,'Guide: probleme -> pas de fichier u.nc'
     1147              abort_message='Nudging: error -> no file u.nc'
    10741148              CALL abort_gcm(modname,abort_message,1)
    10751149             ENDIF
    10761150             rcode = nf90_inq_varid(ncidu, 'UWND', varidu)
    10771151             IF (rcode.NE.NF_NOERR) THEN
    1078               print *,'Guide: probleme -> pas de variable UWND, fichier u.nc'
     1152              abort_message='Nudging: error -> no UWND variable in file u.nc'
    10791153              CALL abort_gcm(modname,abort_message,1)
    10801154             ENDIF
    1081              print*,'ncidu,varidu',ncidu,varidu
     1155             write(*,*),trim(modname)//' ncidu,varidu',ncidu,varidu
    10821156             if (ncidpl.eq.-99) ncidpl=ncidu
     1157
     1158             status=NF90_INQ_DIMID(ncidu, "LONU", dimid)
     1159             status=NF90_INQUIRE_DIMENSION(ncidu,dimid,namedim,lendim)
     1160             IF (lendim .NE. iip1) THEN
     1161                abort_message='dimension LONU different from iip1 in u.nc'
     1162                CALL abort_gcm(modname,abort_message,1)
     1163             ENDIF
     1164
     1165             status=NF90_INQ_DIMID(ncidu, "LATU", dimid)
     1166             status=NF90_INQUIRE_DIMENSION(ncidu,dimid,namedim,lendim)
     1167             IF (lendim .NE. jjp1) THEN
     1168                abort_message='dimension LATU different from jjp1 in u.nc'
     1169                CALL abort_gcm(modname,abort_message,1)
     1170             ENDIF
     1171
    10831172         endif
     1173
    10841174! Vent meridien
    10851175         if (guide_v) then
    10861176             rcode = nf90_open('v.nc', nf90_nowrite, ncidv)
    10871177             IF (rcode.NE.NF_NOERR) THEN
    1088               print *,'Guide: probleme -> pas de fichier v.nc'
     1178              abort_message='Nudging: error -> no file v.nc'
    10891179              CALL abort_gcm(modname,abort_message,1)
    10901180             ENDIF
    10911181             rcode = nf90_inq_varid(ncidv, 'VWND', varidv)
    10921182             IF (rcode.NE.NF_NOERR) THEN
    1093               print *,'Guide: probleme -> pas de variable VWND, fichier v.nc'
     1183              abort_message='Nudging: error -> no VWND variable in file v.nc'
    10941184              CALL abort_gcm(modname,abort_message,1)
    10951185             ENDIF
    1096              print*,'ncidv,varidv',ncidv,varidv
     1186             write(*,*),trim(modname)//' ncidv,varidv',ncidv,varidv
    10971187             if (ncidpl.eq.-99) ncidpl=ncidv
     1188             
     1189             status=NF90_INQ_DIMID(ncidv, "LONV", dimid)
     1190             status=NF90_INQUIRE_DIMENSION(ncidv,dimid,namedim,lendim)
     1191             
     1192                IF (lendim .NE. iip1) THEN
     1193                abort_message='dimension LONV different from iip1 in v.nc'
     1194                CALL abort_gcm(modname,abort_message,1)
     1195             ENDIF
     1196
     1197
     1198             status=NF90_INQ_DIMID(ncidv, "LATV", dimid)
     1199             status=NF90_INQUIRE_DIMENSION(ncidv,dimid,namedim,lendim)
     1200             IF (lendim .NE. jjm) THEN
     1201                abort_message='dimension LATV different from jjm in v.nc'
     1202                CALL abort_gcm(modname,abort_message,1)
     1203             ENDIF
     1204       
    10981205         endif
     1206
    10991207! Temperature
    11001208         if (guide_T) then
    11011209             rcode = nf90_open('T.nc', nf90_nowrite, ncidt)
    11021210             IF (rcode.NE.NF_NOERR) THEN
    1103               print *,'Guide: probleme -> pas de fichier T.nc'
     1211              abort_message='Nudging: error -> no file T.nc'
    11041212              CALL abort_gcm(modname,abort_message,1)
    11051213             ENDIF
    11061214             rcode = nf90_inq_varid(ncidt, 'AIR', varidt)
    11071215             IF (rcode.NE.NF_NOERR) THEN
    1108               print *,'Guide: probleme -> pas de variable AIR, fichier T.nc'
     1216              abort_message='Nudging: error -> no AIR variable in file T.nc'
    11091217              CALL abort_gcm(modname,abort_message,1)
    11101218             ENDIF
    1111              print*,'ncidT,varidT',ncidt,varidt
     1219             write(*,*),trim(modname)//' ncidT,varidT',ncidt,varidt
    11121220             if (ncidpl.eq.-99) ncidpl=ncidt
     1221
     1222             status=NF90_INQ_DIMID(ncidt, "LONV", dimid)
     1223             status=NF90_INQUIRE_DIMENSION(ncidt,dimid,namedim,lendim)
     1224             IF (lendim .NE. iip1) THEN
     1225                abort_message='dimension LONV different from iip1 in T.nc'
     1226                CALL abort_gcm(modname,abort_message,1)
     1227             ENDIF
     1228
     1229             status=NF90_INQ_DIMID(ncidt, "LATU", dimid)
     1230             status=NF90_INQUIRE_DIMENSION(ncidt,dimid,namedim,lendim)
     1231             IF (lendim .NE. jjp1) THEN
     1232                abort_message='dimension LATU different from jjp1 in T.nc'
     1233                CALL abort_gcm(modname,abort_message,1)
     1234             ENDIF
     1235
    11131236         endif
     1237
    11141238! Humidite
    11151239         if (guide_Q) then
    11161240             rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ)
    11171241             IF (rcode.NE.NF_NOERR) THEN
    1118               print *,'Guide: probleme -> pas de fichier hur.nc'
     1242              abort_message='Nudging: error -> no file hur.nc'
    11191243              CALL abort_gcm(modname,abort_message,1)
    11201244             ENDIF
    11211245             rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)
    11221246             IF (rcode.NE.NF_NOERR) THEN
    1123               print *,'Guide: probleme -> pas de variable RH, fichier hur.nc'
     1247              abort_message='Nudging: error -> no RH variable in file hur.nc'
    11241248              CALL abort_gcm(modname,abort_message,1)
    11251249             ENDIF
    1126              print*,'ncidQ,varidQ',ncidQ,varidQ
     1250             write(*,*),trim(modname)//' ncidQ,varidQ',ncidQ,varidQ
    11271251             if (ncidpl.eq.-99) ncidpl=ncidQ
     1252
     1253             status=NF90_INQ_DIMID(ncidQ, "LONV", dimid)
     1254             status=NF90_INQUIRE_DIMENSION(ncidQ,dimid,namedim,lendim)
     1255             IF (lendim .NE. iip1) THEN
     1256                abort_message='dimension LONV different from iip1 in hur.nc'
     1257                CALL abort_gcm(modname,abort_message,1)
     1258             ENDIF
     1259
     1260             status=NF90_INQ_DIMID(ncidQ, "LATU", dimid)
     1261             status=NF90_INQUIRE_DIMENSION(ncidQ,dimid,namedim,lendim)
     1262             IF (lendim .NE. jjp1) THEN
     1263                abort_message='dimension LATU different from jjp1 in hur.nc'
     1264                CALL abort_gcm(modname,abort_message,1)
     1265             ENDIF
     1266
    11281267         endif
     1268
    11291269! Pression de surface
    11301270         if ((guide_P).OR.(guide_modele)) then
    11311271             rcode = nf90_open('ps.nc', nf90_nowrite, ncidps)
    11321272             IF (rcode.NE.NF_NOERR) THEN
    1133               print *,'Guide: probleme -> pas de fichier ps.nc'
     1273              abort_message='Nudging: error -> no file ps.nc'
    11341274              CALL abort_gcm(modname,abort_message,1)
    11351275             ENDIF
    11361276             rcode = nf90_inq_varid(ncidps, 'SP', varidps)
    11371277             IF (rcode.NE.NF_NOERR) THEN
    1138               print *,'Guide: probleme -> pas de variable SP, fichier ps.nc'
     1278              abort_message='Nudging: error -> no SP variable in file ps.nc'
    11391279              CALL abort_gcm(modname,abort_message,1)
    11401280             ENDIF
    1141              print*,'ncidps,varidps',ncidps,varidps
     1281             write(*,*),trim(modname)//' ncidps,varidps',ncidps,varidps
    11421282         endif
    11431283! Coordonnee verticale
    1144          if (.not.guide_modele) then
     1284         if (guide_plevs.EQ.0) then
    11451285              rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
    11461286              IF (rcode.NE.0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
    1147               print*,'ncidpl,varidpl',ncidpl,varidpl
     1287              write(*,*),trim(modname)//' ncidpl,varidpl',ncidpl,varidpl
    11481288         endif
    11491289! Coefs ap, bp pour calcul de la pression aux differents niveaux
    1150          if (guide_modele) then
     1290         if (guide_plevs.EQ.1) then
    11511291#ifdef NC_DOUBLE
    11521292             status=NF_GET_VARA_DOUBLE(ncidpl,varidap,1,nlevnc,apnc)
    … …  
    11561296             status=NF_GET_VARA_REAL(ncidpl,varidbp,1,nlevnc,bpnc)
    11571297#endif
    1158          else
     1298         ELSEIF (guide_plevs.EQ.0) THEN
    11591299#ifdef NC_DOUBLE
    11601300             status=NF_GET_VARA_DOUBLE(ncidpl,varidpl,1,nlevnc,apnc)
    … …  
    11621302             status=NF_GET_VARA_REAL(ncidpl,varidpl,1,nlevnc,apnc)
    11631303#endif
    1164              apnc=apnc*100.! conversion en Pascals
     1304!FC Pour les corrections la pression est deja en Pascals on commente la ligne ci-dessous
     1305             IF(convert_Pa) apnc=apnc*100.! conversion en Pascals
    11651306             bpnc(:)=0.
    11661307         endif
    … …  
    11821323     count(3)=nlevnc
    11831324     count(4)=1
     1325
     1326! Pression
     1327     if (guide_plevs.EQ.2) then
     1328#ifdef NC_DOUBLE
     1329         status=NF_GET_VARA_DOUBLE(ncidp,varidp,start,count,pnat2)
     1330#else
     1331         status=NF_GET_VARA_REAL(ncidp,varidp,start,count,pnat2)
     1332#endif
     1333         IF (invert_y) THEN
     1334!           PRINT*,"Invertion impossible actuellement"
     1335!           CALL abort_gcm(modname,abort_message,1)
     1336           CALL invert_lat(iip1,jjp1,nlevnc,pnat2)
     1337         ENDIF
     1338     endif
    11841339
    11851340!  Vent zonal
    … …  
    12571412    IMPLICIT NONE
    12581413
    1259 #include "netcdf.inc"
    1260 #include "dimensions.h"
    1261 #include "paramet.h"
     1414    include "netcdf.inc"
     1415    include "dimensions.h"
     1416    include "paramet.h"
    12621417
    12631418    INTEGER, INTENT(IN)   :: timestep
    … …  
    12651420    LOGICAL, SAVE         :: first=.TRUE.
    12661421! Identification fichiers et variables NetCDF:
    1267     INTEGER, SAVE         :: ncidu,varidu,ncidv,varidv,ncidQ
    1268     INTEGER, SAVE         :: varidQ,ncidt,varidt,ncidps,varidps
     1422    INTEGER, SAVE         :: ncidu,varidu,ncidv,varidv,ncidp,varidp
     1423    INTEGER, SAVE         :: ncidQ,varidQ,ncidt,varidt,ncidps,varidps
    12691424    INTEGER               :: ncidpl,varidpl,varidap,varidbp
    12701425! Variables auxiliaires NetCDF:
    … …  
    12831438    if (first) then
    12841439         ncidpl=-99
    1285          print*,'Guide: ouverture des fichiers guidage '
    1286 ! Niveaux de pression si non constants
    1287          if (guide_modele) then
    1288              print *,'Lecture du guidage sur niveaux modele'
    1289              rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
    1290              IF (rcode.NE.NF_NOERR) THEN
    1291               print *,'Guide: probleme -> pas de fichier apbp.nc'
    1292               CALL abort_gcm(modname,abort_message,1)
    1293              ENDIF
    1294              rcode = nf90_inq_varid(ncidpl, 'AP', varidap)
    1295              IF (rcode.NE.NF_NOERR) THEN
    1296               print *,'Guide: probleme -> pas de variable AP, fichier apbp.nc'
    1297               CALL abort_gcm(modname,abort_message,1)
    1298              ENDIF
    1299              rcode = nf90_inq_varid(ncidpl, 'BP', varidbp)
    1300              IF (rcode.NE.NF_NOERR) THEN
    1301               print *,'Guide: probleme -> pas de variable BP, fichier apbp.nc'
    1302               CALL abort_gcm(modname,abort_message,1)
    1303              ENDIF
    1304              print*,'ncidpl,varidap',ncidpl,varidap
     1440         write(*,*)trim(modname)//' : opening nudging files '
     1441! Ap et Bp si niveaux de pression hybrides
     1442         if (guide_plevs.EQ.1) then
     1443           write(*,*)trim(modname)//' Reading nudging on model levels'
     1444           rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
     1445           IF (rcode.NE.NF_NOERR) THEN
     1446             abort_message='Nudging: error -> no file apbp.nc'
     1447           CALL abort_gcm(modname,abort_message,1)
     1448           ENDIF
     1449           rcode = nf90_inq_varid(ncidpl, 'AP', varidap)
     1450           IF (rcode.NE.NF_NOERR) THEN
     1451             abort_message='Nudging: error -> no AP variable in file apbp.nc'
     1452           CALL abort_gcm(modname,abort_message,1)
     1453           ENDIF
     1454           rcode = nf90_inq_varid(ncidpl, 'BP', varidbp)
     1455           IF (rcode.NE.NF_NOERR) THEN
     1456             abort_message='Nudging: error -> no BP variable in file apbp.nc'
     1457             CALL abort_gcm(modname,abort_message,1)
     1458           ENDIF
     1459           write(*,*)trim(modname)//'ncidpl,varidap',ncidpl,varidap
     1460         endif
     1461! Pression
     1462         if (guide_plevs.EQ.2) then
     1463           rcode = nf90_open('P.nc', nf90_nowrite, ncidp)
     1464           IF (rcode.NE.NF_NOERR) THEN
     1465             abort_message='Nudging: error -> no file P.nc'
     1466             CALL abort_gcm(modname,abort_message,1)
     1467           ENDIF
     1468           rcode = nf90_inq_varid(ncidp, 'PRES', varidp)
     1469           IF (rcode.NE.NF_NOERR) THEN
     1470             abort_message='Nudging: error -> no PRES variable in file P.nc'
     1471             CALL abort_gcm(modname,abort_message,1)
     1472           ENDIF
     1473           write(*,*)trim(modname)//' ncidp,varidp',ncidp,varidp
     1474           if (ncidpl.eq.-99) ncidpl=ncidp
    13051475         endif
    13061476! Vent zonal
    13071477         if (guide_u) then
    1308              rcode = nf90_open('u.nc', nf90_nowrite, ncidu)
    1309              IF (rcode.NE.NF_NOERR) THEN
    1310               print *,'Guide: probleme -> pas de fichier u.nc'
    1311               CALL abort_gcm(modname,abort_message,1)
    1312              ENDIF
    1313              rcode = nf90_inq_varid(ncidu, 'UWND', varidu)
    1314              IF (rcode.NE.NF_NOERR) THEN
    1315               print *,'Guide: probleme -> pas de variable UWND, fichier u.nc'
    1316               CALL abort_gcm(modname,abort_message,1)
    1317              ENDIF
    1318              print*,'ncidu,varidu',ncidu,varidu
    1319              if (ncidpl.eq.-99) ncidpl=ncidu
     1478           rcode = nf90_open('u.nc', nf90_nowrite, ncidu)
     1479           IF (rcode.NE.NF_NOERR) THEN
     1480             abort_message='Nudging: error -> no file u.nc'
     1481             CALL abort_gcm(modname,abort_message,1)
     1482           ENDIF
     1483           rcode = nf90_inq_varid(ncidu, 'UWND', varidu)
     1484           IF (rcode.NE.NF_NOERR) THEN
     1485             abort_message='Nudging: error -> no UWND variable in file u.nc'
     1486             CALL abort_gcm(modname,abort_message,1)
     1487           ENDIF
     1488           write(*,*)trim(modname)//' ncidu,varidu',ncidu,varidu
     1489           if (ncidpl.eq.-99) ncidpl=ncidu
    13201490         endif
    13211491! Vent meridien
    13221492         if (guide_v) then
    1323              rcode = nf90_open('v.nc', nf90_nowrite, ncidv)
    1324              IF (rcode.NE.NF_NOERR) THEN
    1325               print *,'Guide: probleme -> pas de fichier v.nc'
    1326               CALL abort_gcm(modname,abort_message,1)
    1327              ENDIF
    1328              rcode = nf90_inq_varid(ncidv, 'VWND', varidv)
    1329              IF (rcode.NE.NF_NOERR) THEN
    1330               print *,'Guide: probleme -> pas de variable VWND, fichier v.nc'
    1331               CALL abort_gcm(modname,abort_message,1)
    1332              ENDIF
    1333              print*,'ncidv,varidv',ncidv,varidv
    1334              if (ncidpl.eq.-99) ncidpl=ncidv
     1493           rcode = nf90_open('v.nc', nf90_nowrite, ncidv)
     1494           IF (rcode.NE.NF_NOERR) THEN
     1495             abort_message='Nudging: error -> no file v.nc'
     1496             CALL abort_gcm(modname,abort_message,1)
     1497           ENDIF
     1498           rcode = nf90_inq_varid(ncidv, 'VWND', varidv)
     1499           IF (rcode.NE.NF_NOERR) THEN
     1500             abort_message='Nudging: error -> no VWND variable in file v.nc'
     1501             CALL abort_gcm(modname,abort_message,1)
     1502           ENDIF
     1503           write(*,*)trim(modname)//' ncidv,varidv',ncidv,varidv
     1504           if (ncidpl.eq.-99) ncidpl=ncidv
    13351505         endif
    13361506! Temperature
    13371507         if (guide_T) then
    1338              rcode = nf90_open('T.nc', nf90_nowrite, ncidt)
    1339              IF (rcode.NE.NF_NOERR) THEN
    1340               print *,'Guide: probleme -> pas de fichier T.nc'
    1341               CALL abort_gcm(modname,abort_message,1)
    1342              ENDIF
    1343              rcode = nf90_inq_varid(ncidt, 'AIR', varidt)
    1344              IF (rcode.NE.NF_NOERR) THEN
    1345               print *,'Guide: probleme -> pas de variable AIR, fichier T.nc'
    1346               CALL abort_gcm(modname,abort_message,1)
    1347              ENDIF
    1348              print*,'ncidT,varidT',ncidt,varidt
    1349              if (ncidpl.eq.-99) ncidpl=ncidt
     1508           rcode = nf90_open('T.nc', nf90_nowrite, ncidt)
     1509           IF (rcode.NE.NF_NOERR) THEN
     1510             abort_message='Nudging: error -> no file T.nc'
     1511             CALL abort_gcm(modname,abort_message,1)
     1512           ENDIF
     1513           rcode = nf90_inq_varid(ncidt, 'AIR', varidt)
     1514           IF (rcode.NE.NF_NOERR) THEN
     1515             abort_message='Nudging: error -> no AIR variable in file T.nc'
     1516             CALL abort_gcm(modname,abort_message,1)
     1517           ENDIF
     1518           write(*,*)trim(modname)//' ncidT,varidT',ncidt,varidt
     1519           if (ncidpl.eq.-99) ncidpl=ncidt
    13501520         endif
    13511521! Humidite
    13521522         if (guide_Q) then
    1353              rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ)
    1354              IF (rcode.NE.NF_NOERR) THEN
    1355               print *,'Guide: probleme -> pas de fichier hur.nc'
    1356               CALL abort_gcm(modname,abort_message,1)
    1357              ENDIF
    1358              rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)
    1359              IF (rcode.NE.NF_NOERR) THEN
    1360               print *,'Guide: probleme -> pas de variable RH, fichier hur.nc'
    1361               CALL abort_gcm(modname,abort_message,1)
    1362              ENDIF
    1363              print*,'ncidQ,varidQ',ncidQ,varidQ
    1364              if (ncidpl.eq.-99) ncidpl=ncidQ
     1523           rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ)
     1524           IF (rcode.NE.NF_NOERR) THEN
     1525             abort_message='Nudging: error -> no file hur.nc'
     1526             CALL abort_gcm(modname,abort_message,1)
     1527           ENDIF
     1528           rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)
     1529           IF (rcode.NE.NF_NOERR) THEN
     1530             abort_message='Nudging: error -> no RH,variable in file hur.nc'
     1531             CALL abort_gcm(modname,abort_message,1)
     1532           ENDIF
     1533           write(*,*)trim(modname)//' ncidQ,varidQ',ncidQ,varidQ
     1534           if (ncidpl.eq.-99) ncidpl=ncidQ
    13651535         endif
    13661536! Pression de surface
    13671537         if ((guide_P).OR.(guide_modele)) then
    1368              rcode = nf90_open('ps.nc', nf90_nowrite, ncidps)
    1369              IF (rcode.NE.NF_NOERR) THEN
    1370               print *,'Guide: probleme -> pas de fichier ps.nc'
    1371               CALL abort_gcm(modname,abort_message,1)
    1372              ENDIF
    1373              rcode = nf90_inq_varid(ncidps, 'SP', varidps)
    1374              IF (rcode.NE.NF_NOERR) THEN
    1375               print *,'Guide: probleme -> pas de variable SP, fichier ps.nc'
    1376               CALL abort_gcm(modname,abort_message,1)
    1377              ENDIF
    1378              print*,'ncidps,varidps',ncidps,varidps
     1538           rcode = nf90_open('ps.nc', nf90_nowrite, ncidps)
     1539           IF (rcode.NE.NF_NOERR) THEN
     1540             abort_message='Nudging: error -> no file ps.nc'
     1541             CALL abort_gcm(modname,abort_message,1)
     1542           ENDIF
     1543           rcode = nf90_inq_varid(ncidps, 'SP', varidps)
     1544           IF (rcode.NE.NF_NOERR) THEN
     1545             abort_message='Nudging: error -> no SP variable in file ps.nc'
     1546             CALL abort_gcm(modname,abort_message,1)
     1547           ENDIF
     1548           write(*,*)trim(modname)//' ncidps,varidps',ncidps,varidps
    13791549         endif
    13801550! Coordonnee verticale
    1381          if (.not.guide_modele) then
    1382               rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
    1383               IF (rcode.NE.0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
    1384               print*,'ncidpl,varidpl',ncidpl,varidpl
     1551         if (guide_plevs.EQ.0) then
     1552           rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
     1553           IF (rcode.NE.0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
     1554           write(*,*)trim(modname)//' ncidpl,varidpl',ncidpl,varidpl
    13851555         endif
    13861556! Coefs ap, bp pour calcul de la pression aux differents niveaux
    1387          if (guide_modele) then
     1557         if (guide_plevs.EQ.1) then
    13881558#ifdef NC_DOUBLE
    13891559             status=NF_GET_VARA_DOUBLE(ncidpl,varidap,1,nlevnc,apnc)
    … …  
    13931563             status=NF_GET_VARA_REAL(ncidpl,varidbp,1,nlevnc,bpnc)
    13941564#endif
    1395          else
     1565         elseif (guide_plevs.EQ.0) THEN
    13961566#ifdef NC_DOUBLE
    13971567             status=NF_GET_VARA_DOUBLE(ncidpl,varidpl,1,nlevnc,apnc)
    … …  
    14201590     count(4)=1
    14211591
     1592!  Pression
     1593     if (guide_plevs.EQ.2) then
     1594#ifdef NC_DOUBLE
     1595         status=NF_GET_VARA_DOUBLE(ncidp,varidp,start,count,zu)
     1596#else
     1597         status=NF_GET_VARA_REAL(ncidp,varidp,start,count,zu)
     1598#endif
     1599         DO i=1,iip1
     1600             pnat2(i,:,:)=zu(:,:)
     1601         ENDDO
     1602
     1603         IF (invert_y) THEN
     1604!           PRINT*,"Invertion impossible actuellement"
     1605!           CALL abort_gcm(modname,abort_message,1)
     1606           CALL invert_lat(iip1,jjp1,nlevnc,pnat2)
     1607         ENDIF
     1608     endif
    14221609!  Vent zonal
    14231610     if (guide_u) then
    … …  
    14901677
    14911678!  Pression de surface
    1492      if ((guide_P).OR.(guide_modele))  then
     1679     if ((guide_P).OR.(guide_plevs.EQ.1))  then
    14931680         start(3)=timestep
    14941681         start(4)=0
    … …  
    15431730    INTEGER                :: ierr, varid,l
    15441731    REAL, DIMENSION (iip1,hsize,vsize) :: field2
    1545 
    1546     print *,'Guide: output timestep',timestep,'var ',varname
     1732    CHARACTER(LEN=20),PARAMETER :: modname="guide_out"
     1733
     1734    write(*,*)trim(modname)//': output timestep',timestep,'var ',varname
    15471735    IF (timestep.EQ.0) THEN
    15481736! ----------------------------------------------
    … …  
    15661754        ierr=NF_DEF_VAR(nid,"LEVEL",NF_FLOAT,1,id_lev,vid_lev)
    15671755        ierr=NF_DEF_VAR(nid,"cu",NF_FLOAT,2,(/id_lonu,id_latu/),vid_cu)
     1756        ierr=NF_DEF_VAR(nid,"cv",NF_FLOAT,2,(/id_lonv,id_latv/),vid_cv)
    15681757        ierr=NF_DEF_VAR(nid,"au",NF_FLOAT,2,(/id_lonu,id_latu/),vid_au)
    1569         ierr=NF_DEF_VAR(nid,"cv",NF_FLOAT,2,(/id_lonv,id_latv/),vid_cv)
    15701758        ierr=NF_DEF_VAR(nid,"av",NF_FLOAT,2,(/id_lonv,id_latv/),vid_av)
    15711759        call nf95_def_var(nid, "alpha_T", nf90_float, (/id_lonv, id_latu/), &
    … …  
    16041792! --------------------------------------------------------------------
    16051793        ierr = NF_REDEF(nid)
    1606 ! Surface pressure (GCM)
    1607         dim3=(/id_lonv,id_latu,id_tim/)
    1608         ierr = NF_DEF_VAR(nid,"SP",NF_FLOAT,3,dim3,varid)
     1794! Pressure (GCM)
     1795        dim4=(/id_lonv,id_latu,id_lev,id_tim/)
     1796        ierr = NF_DEF_VAR(nid,"SP",NF_FLOAT,4,dim4,varid)
    16091797! Surface pressure (guidage)
    16101798        IF (guide_P) THEN
    … …  
    16511839    SELECT CASE (varname)
    16521840    CASE ("SP","ps")
    1653         start=(/1,1,timestep,0/)
    1654         count=(/iip1,jjp1,1,0/)
     1841        start=(/1,1,1,timestep/)
     1842        count=(/iip1,jjp1,llm,1/)
    16551843    CASE ("v","va","vcov")
    16561844        start=(/1,1,1,timestep/)

  • LMDZ6/branches/Ocean_skin/libf/dyn3d/iniacademic.F90

    r2622 r4013  
    6767  LOGICAL ok_geost             ! Initialisation vent geost. ou nul
    6868  LOGICAL ok_pv                ! Polar Vortex
    69   REAL phi_pv,dphi_pv,gam_pv   ! Constantes pour polar vortex
     69  REAL phi_pv,dphi_pv,gam_pv,tetanoise   ! Constantes pour polar vortex
    7070
    7171  real zz,ran1
    … …  
    117117  CALL inigeom
    118118  CALL inifilr
     119
     120  ! Initialize pressure and mass field if read_start=.false.
     121  IF (.NOT. read_start) THEN
     122     ! surface pressure
     123     if (iflag_phys>2) then
     124        ! specific value for CMIP5 aqua/terra planets
     125        ! "Specify the initial dry mass to be equivalent to
     126        !  a global mean surface pressure (101325 minus 245) Pa."
     127        ps(:)=101080. 
     128     else
     129        ! use reference surface pressure
     130        ps(:)=preff
     131     endif
     132     ! ground geopotential
     133     phis(:)=0.
     134     CALL pression ( ip1jmp1, ap, bp, ps, p       )
     135     if (pressure_exner) then
     136       CALL exner_hyb( ip1jmp1, ps, p, pks, pk)
     137     else
     138       call exner_milieu(ip1jmp1,ps,p,pks,pk)
     139     endif
     140     CALL massdair(p,masse)
     141  ENDIF
    119142
    120143  if (llm == 1) then
    … …  
    167190     gam_pv=4.              ! -dT/dz vortex (in K/km)
    168191     CALL getin('gam_pv',gam_pv)
     192     tetanoise=0.005
     193     CALL getin('tetanoise',tetanoise)
     194
    169195
    170196     ! 2. Initialize fields towards which to relax
    … …  
    219245     ! 3. Initialize fields (if necessary)
    220246     IF (.NOT. read_start) THEN
    221         ! surface pressure
    222         if (iflag_phys>2) then
    223            ! specific value for CMIP5 aqua/terra planets
    224            ! "Specify the initial dry mass to be equivalent to
    225            !  a global mean surface pressure (101325 minus 245) Pa."
    226            ps(:)=101080. 
    227         else
    228            ! use reference surface pressure
    229            ps(:)=preff
    230         endif
    231        
    232         ! ground geopotential
    233         phis(:)=0.
    234 
    235         CALL pression ( ip1jmp1, ap, bp, ps, p       )
    236         if (pressure_exner) then
    237           CALL exner_hyb( ip1jmp1, ps, p, pks, pk)
    238         else
    239           call exner_milieu(ip1jmp1,ps,p,pks,pk)
    240         endif
    241         CALL massdair(p,masse)
    242 
    243247        ! bulk initialization of temperature
    244         teta(:,:)=tetarappel(:,:)
     248
     249        IF (iflag_phys>10000) THEN
     250        ! Particular case to impose a constant temperature T0=0.01*iflag_physx
     251           teta(:,:)= 0.01*iflag_phys/(pk(:,:)/cpp)
     252        ELSE
     253           teta(:,:)=tetarappel(:,:)
     254        ENDIF
    245255
    246256        ! geopotential
    247257        CALL geopot(ip1jmp1,teta,pk,pks,phis,phi)
     258
     259        DO l=1,llm
     260          print*,'presnivs,play,l',presnivs(l),(pk(1,l)/cpp)**(1./kappa)*preff
     261         !pks(ij) = (cpp/preff) * ps(ij)
     262         !pk(ij,1) = .5*pks(ij)
     263         ! pk = cpp * (p/preff)^kappa
     264        ENDDO
    248265
    249266        ! winds
    … …  
    292309        do l=1,llm
    293310           do ij=iip2,ip1jm
    294               teta(ij,l)=teta(ij,l)*(1.+0.005*ran1(idum))
     311              teta(ij,l)=teta(ij,l)*(1.+tetanoise*ran1(idum))
    295312           enddo
    296313        enddo

  • LMDZ6/branches/Ocean_skin/libf/dyn3d/leapfrog.F

    r3416 r4013  
    748748
    749749              CLOSE(99)
     750              if (ok_guide) then
     751                ! set ok_guide to false to avoid extra output
     752                ! in following forward step
     753                ok_guide=.false.
     754              endif
    750755              !!! Ehouarn: Why not stop here and now?
    751756            ENDIF ! of IF (itau.EQ.itaufin)
    … …  
    868873     &                           vcov,ucov,teta,q,masse,ps)
    869874!                endif ! of if (planet_type.eq."earth")
     875                if (ok_guide) then
     876                  ! set ok_guide to false to avoid extra output
     877                  ! in following forward step
     878                  ok_guide=.false.
     879                endif
    870880              ENDIF ! of IF(itau.EQ.itaufin)
    871881

  • LMDZ6/branches/Ocean_skin/libf/dyn3d/vlsplt.F

    r2603 r4013  
    139139      END
    140140      RECURSIVE SUBROUTINE vlx(q,pente_max,masse,u_m,iq)
    141       USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils ! CRisi
     141      USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils, ! CRisi
     142     &                     qperemin,masseqmin,ratiomin ! MVals et CRisi
    142143
    143144c     Auteurs:   P.Le Van, F.Hourdin, F.Forget
    … …  
    456457          DO ij=iip2,ip1jm
    457458           ! On a besoin de q et masse seulement entre iip2 et ip1jm
    458            masseq(ij,l,iq2)=masse(ij,l,iq)*q(ij,l,iq)
    459            Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
     459           !masseq(ij,l,iq2)=masse(ij,l,iq)*q(ij,l,iq)
     460           !Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
     461           !Mvals: veiller a ce qu'on n'ait pas de denominateur nul
     462           masseq(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),masseqmin)
     463           if (q(ij,l,iq).gt.qperemin) then
     464             Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
     465           else
     466             Ratio(ij,l,iq2)=ratiomin
     467           endif
    460468          enddo   
    461469         enddo
    … …  
    473481      DO l=1,llm
    474482         DO ij=iip2+1,ip1jm
    475             new_m=masse(ij,l,iq)+u_m(ij-1,l)-u_m(ij,l)
     483            !MVals: veiller a ce qu'on ait pas de denominateur nul
     484            new_m=max(masse(ij,l,iq)+u_m(ij-1,l)-u_m(ij,l),masseqmin)
    476485            q(ij,l,iq)=(q(ij,l,iq)*masse(ij,l,iq)+
    477486     &      u_mq(ij-1,l)-u_mq(ij,l))
    … …  
    489498      ! On calcule q entre iip2+1,ip1jm -> on fait pareil pour ratio
    490499      ! puis on boucle en longitude
    491       if (nqdesc(iq).gt.0) then 
     500      if (nqfils(iq).gt.0) then 
    492501       do ifils=1,nqdesc(iq)
    493502         iq2=iqfils(ifils,iq) 
    … …  
    510519      END
    511520      RECURSIVE SUBROUTINE vly(q,pente_max,masse,masse_adv_v,iq)
    512       USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils ! CRisi
     521      USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils, ! CRisi
     522     &                     qperemin,masseqmin,ratiomin ! MVals et CRisi
    513523c
    514524c     Auteurs:   P.Le Van, F.Hourdin, F.Forget
    … …  
    777787           ! attention, chaque fils doit avoir son masseq, sinon, le 1er
    778788           ! fils ecrase le masseq de ses freres.
    779            masseq(ij,l,iq2)=masse(ij,l,iq)*q(ij,l,iq)
    780            Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)     
     789           !masseq(ij,l,iq2)=masse(ij,l,iq)*q(ij,l,iq)
     790           !Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)     
     791           !MVals: veiller a ce qu'on n'ait pas de denominateur nul
     792           masseq(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),masseqmin)
     793           if (q(ij,l,iq).gt.qperemin) then
     794             Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
     795           else
     796             Ratio(ij,l,iq2)=ratiomin
     797           endif
    781798          enddo   
    782799         enddo
    … …  
    871888      END
    872889      RECURSIVE SUBROUTINE vlz(q,pente_max,masse,w,iq)
    873       USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils ! CRisi
     890      USE infotrac, ONLY : nqtot,nqfils,nqdesc,iqfils, ! CRisi
     891     &                     qperemin,masseqmin,ratiomin ! MVals et CRisi
    874892c
    875893c     Auteurs:   P.Le Van, F.Hourdin, F.Forget
    … …  
    9971015         DO l=1,llm
    9981016          DO ij=1,ip1jmp1
    999            masseq(ij,l,iq2)=masse(ij,l,iq)*q(ij,l,iq)
    1000            Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)       
     1017           !masseq(ij,l,iq2)=masse(ij,l,iq)*q(ij,l,iq)
     1018           !Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)       
     1019           !MVals: veiller a ce qu'on n'ait pas de denominateur nul
     1020           masseq(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),masseqmin)
     1021           if (q(ij,l,iq).gt.qperemin) then
     1022             Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
     1023           else
     1024             Ratio(ij,l,iq2)=ratiomin
     1025           endif     
    10011026          enddo   
    10021027         enddo

  • LMDZ6/branches/Ocean_skin/libf/dyn3d_common/infotrac.F90

    r3811 r4013  
    1212  INTEGER, SAVE :: nbtr
    1313
    14 ! CRisi: nb traceurs pères= directement advectés par l'air
     14! CRisi: on retranche les isotopes des traceurs habituels
     15! On fait un tableaux d'indices des traceurs qui passeront dans phytrac
     16  INTEGER, SAVE :: nqtottr
     17  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: itr_indice
     18
     19! CRisi: nb traceurs peres= directement advectes par l'air
    1520  INTEGER, SAVE :: nqperes
    1621
     22! ThL: nb traceurs INCA
     23  INTEGER, SAVE :: nqINCA
     24
     25! ThL: nb traceurs CO2
     26  INTEGER, SAVE :: nqCO2
     27
    1728! Name variables
    18   CHARACTER(len=20), ALLOCATABLE, DIMENSION(:), SAVE :: tname ! tracer short name for restart and diagnostics
    19   CHARACTER(len=23), ALLOCATABLE, DIMENSION(:), SAVE :: ttext ! tracer long name for diagnostics
     29  INTEGER,PARAMETER :: tname_lenmax=128
     30  CHARACTER(len=tname_lenmax), ALLOCATABLE, DIMENSION(:), SAVE :: tname ! tracer short name for restart and diagnostics
     31  CHARACTER(len=tname_lenmax+3), ALLOCATABLE, DIMENSION(:), SAVE :: ttext ! tracer long name for diagnostics
    2032
    2133! iadv  : index of trasport schema for each tracer
    … …  
    2840! CRisi: tableaux de fils
    2941  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: nqfils
    30   INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: nqdesc ! nombres de fils + nombre de tous les petits fils sur toutes les générations
     42  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE    :: nqdesc ! nombres de fils + nombre de tous les petits fils sur toutes les generations
    3143  INTEGER, SAVE :: nqdesc_tot
    3244  INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE    :: iqfils
    … …  
    4254  CHARACTER(len=4),SAVE :: type_trac
    4355  CHARACTER(len=8),DIMENSION(:),ALLOCATABLE, SAVE :: solsym
    44    
     56
    4557! CRisi: cas particulier des isotopes
    4658  LOGICAL,SAVE :: ok_isotopes,ok_iso_verif,ok_isotrac,ok_init_iso
    … …  
    5062  LOGICAL, DIMENSION(niso_possibles),SAVE ::  use_iso
    5163  INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE ::  iqiso ! donne indice iq en fn de (ixt,phase)
    52   INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  iso_num ! donne numéro iso entre 1 et niso_possibles en fn de nqtot
    53   INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  iso_indnum ! donne numéro iso entre 1 et niso effectif en fn de nqtot
    54   INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  zone_num ! donne numéro de la zone de tracage en fn de nqtot
    55   INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  phase_num ! donne numéro de la zone de tracage en fn de nqtot
    56   INTEGER, DIMENSION(niso_possibles), SAVE :: indnum_fn_num ! donne indice entre entre 1 et niso en fonction du numéro d isotope entre 1 et niso_possibles
    57   INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE ::  index_trac ! numéro ixt en fn izone, indnum entre 1 et niso
     64  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  iso_num ! donne numero iso entre 1 et niso_possibles en fn de nqtot
     65  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  iso_indnum ! donne numero iso entre 1 et niso effectif en fn de nqtot
     66  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  zone_num ! donne numero de la zone de tracage en fn de nqtot
     67  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  phase_num ! donne numero de la zone de tracage en fn de nqtot
     68  INTEGER, DIMENSION(niso_possibles), SAVE :: indnum_fn_num ! donne indice entre entre 1 et niso en fonction du numero d isotope entre 1 et niso_possibles
     69  INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE ::  index_trac ! numero ixt en fn izone, indnum entre 1 et niso
    5870  INTEGER,SAVE :: niso,ntraceurs_zone,ntraciso
    5971
    … …  
    103115    INTEGER, ALLOCATABLE, DIMENSION(:) :: vadv_inca  ! index of vertical trasport schema
    104116
    105     CHARACTER(len=15), ALLOCATABLE, DIMENSION(:) :: tnom_0  ! tracer short name
    106     CHARACTER(len=15), ALLOCATABLE, DIMENSION(:) :: tnom_transp ! transporting fluid short name: CRisi
     117    INTEGER, ALLOCATABLE, DIMENSION(:) :: conv_flg_inca
     118    INTEGER, ALLOCATABLE, DIMENSION(:) :: pbl_flg_inca
     119    CHARACTER(len=8), ALLOCATABLE, DIMENSION(:) :: solsym_inca
     120
     121    CHARACTER(len=tname_lenmax), ALLOCATABLE, DIMENSION(:) :: tnom_0  ! tracer short name
     122    CHARACTER(len=tname_lenmax), ALLOCATABLE, DIMENSION(:) :: tnom_transp ! transporting fluid short name: CRisi
    107123    CHARACTER(len=3), DIMENSION(30) :: descrq
    108124    CHARACTER(len=1), DIMENSION(3)  :: txts
    109125    CHARACTER(len=2), DIMENSION(9)  :: txtp
    110     CHARACTER(len=23)               :: str1,str2
     126    CHARACTER(len=tname_lenmax)               :: str1,str2
    111127 
    112128    INTEGER :: nqtrue  ! number of tracers read from tracer.def, without higer order of moment
    113     INTEGER :: iq, new_iq, iiq, jq, ierr
     129    INTEGER :: iq, new_iq, iiq, jq, ierr,itr
    114130    INTEGER :: ifils,ipere,generation ! CRisi
    115131    LOGICAL :: continu,nouveau_traceurdef
    116132    INTEGER :: IOstatus ! gestion de la retrocompatibilite de traceur.def
    117     CHARACTER(len=15) :: tchaine   
     133    CHARACTER(len=2*tname_lenmax+1) :: tchaine   
    118134
    119135    character(len=*),parameter :: modname="infotrac_init"
     136
    120137!-----------------------------------------------------------------------
    121138! Initialization :
    … …  
    138155    ! Coherence test between parameter type_trac, config_inca and preprocessing keys
    139156    IF (type_trac=='inca') THEN
    140        WRITE(lunout,*) 'You have choosen to couple with INCA chemestry model : type_trac=', &
     157       WRITE(lunout,*) 'You have chosen to couple with INCA chemistry model : type_trac=', &
    141158            type_trac,' config_inca=',config_inca
    142159       IF (config_inca/='aero' .AND. config_inca/='aeNP' .AND. config_inca/='chem') THEN
    143160          WRITE(lunout,*) 'Incoherence between type_trac and config_inca. Model stops. Modify run.def'
    144161          CALL abort_gcm('infotrac_init','Incoherence between type_trac and config_inca',1)
    145        END IF
     162       ENDIF
    146163#ifndef INCA
    147164       WRITE(lunout,*) 'To run this option you must add cpp key INCA and compile with INCA code'
    … …  
    149166#endif
    150167    ELSE IF (type_trac=='repr') THEN
    151        WRITE(lunout,*) 'You have choosen to couple with REPROBUS chemestry model : type_trac=', type_trac
     168       WRITE(lunout,*) 'You have chosen to couple with REPROBUS chemestry model : type_trac=', type_trac
    152169#ifndef REPROBUS
    153170       WRITE(lunout,*) 'To run this option you must add cpp key REPROBUS and compile with REPRPBUS code'
    … …  
    164181    ELSE IF (type_trac == 'lmdz') THEN
    165182       WRITE(lunout,*) 'Tracers are treated in LMDZ only : type_trac=', type_trac
     183    ELSE IF (type_trac == 'inco') THEN ! ThL
     184       WRITE(lunout,*) 'Using jointly INCA and CO2 cycle: type_trac =', type_trac
     185       IF (config_inca/='aero' .AND. config_inca/='aeNP' .AND. config_inca/='chem') THEN
     186          WRITE(lunout,*) 'Incoherence between type_trac and config_inca. Model stops. Modify run.def'
     187          CALL abort_gcm('infotrac_init','Incoherence between type_trac and config_inca',1)
     188       ENDIF
     189#ifndef INCA
     190       WRITE(lunout,*) 'To run this option you must add cpp key INCA and compilewith INCA code'
     191       CALL abort_gcm('infotrac_init','You must compile with cpp key INCA',1)
     192#endif   
    166193    ELSE
    167194       WRITE(lunout,*) 'type_trac=',type_trac,' not possible. Model stops'
    168195       CALL abort_gcm('infotrac_init','bad parameter',1)
    169     END IF
     196    ENDIF
    170197
    171198    ! Test if config_inca is other then none for run without INCA
    172     IF (type_trac/='inca' .AND. config_inca/='none') THEN
     199    IF (type_trac/='inca' .AND. type_trac/='inco' .AND. config_inca/='none') THEN
    173200       WRITE(lunout,*) 'config_inca will now be changed to none as you do not couple with INCA model'
    174201       config_inca='none'
    175     END IF
     202    ENDIF
    176203
    177204!-----------------------------------------------------------------------
    … …  
    182209!-----------------------------------------------------------------------
    183210    IF (type_trac == 'lmdz' .OR. type_trac == 'repr' .OR. type_trac == 'coag' .OR. type_trac == 'co2i') THEN
     211       IF (type_trac=='co2i') THEN
     212          nqCO2 = 1
     213       ELSE
     214          nqCO2 = 0
     215       ENDIF
    184216       OPEN(90,file='traceur.def',form='formatted',status='old', iostat=ierr)
    185217       IF(ierr.EQ.0) THEN
    … …  
    188220          write(lunout,*) 'nqtrue=',nqtrue
    189221       ELSE
    190           WRITE(lunout,*) trim(modname),': Problem in opening traceur.def'
    191           WRITE(lunout,*) trim(modname),': WARNING using defaut values'
    192           IF (planet_type=='earth') THEN
    193             nqtrue=4 ! Default value for Earth
    194           ELSE
    195             nqtrue=1 ! Default value for other planets
    196           ENDIF
     222          WRITE(lunout,*) trim(modname),': Failed opening traceur.def'
     223          CALL abort_gcm(modname,"file traceur.def not found!",1)
    197224       ENDIF
    198225!jyg<
    … …  
    206233!!       endif
    207234!>jyg
    208     ELSE ! type_trac=inca
     235    ELSE ! type_trac=inca or inco
     236       IF (type_trac=='inco') THEN
     237          nqCO2 = 1
     238       ELSE
     239          nqCO2 = 0
     240       ENDIF
    209241!jyg<
    210242       ! The traceur.def file is used to define the number "nqo" of water phases
    … …  
    215247          READ(90,*) nqo
    216248       ELSE
    217           WRITE(lunout,*) trim(modname),': Using default value for nqo'
    218           nqo=2
     249          WRITE(lunout,*) trim(modname),': Failed opening traceur.def'
     250          CALL abort_gcm(modname,"file traceur.def not found!",1)
    219251       ENDIF
    220252       IF (nqo /= 2 .AND. nqo /= 3 ) THEN
    221           WRITE(lunout,*) trim(modname),': nqo=',nqo, ' is not allowded. Only 2 or 3 water phases allowed'
     253          IF (nqo == 4 .AND. type_trac=='inco') THEN ! ThL
     254             WRITE(lunout,*) trim(modname),': you are coupling with INCA, and also using CO2i.'
     255             nqo = 3    ! A ameliorier... je force 3 traceurs eau...  ThL
     256             WRITE(lunout,*) trim(modname),': nqo = ',nqo
     257          ELSE
     258          WRITE(lunout,*) trim(modname),': nqo=',nqo, ' is not allowed. Only 2 or 3 water phases allowed'
    222259          CALL abort_gcm('infotrac_init','Bad number of water phases',1)
    223        END IF
     260          ENDIF
     261       ENDIF
    224262       ! nbtr has been read from INCA by init_const_lmdz() in gcm.F
    225263#ifdef INCA
    226        CALL Init_chem_inca_trac(nbtr)
    227 #endif       
     264       CALL Init_chem_inca_trac(nqINCA)
     265#else
     266       nqINCA=0
     267#endif
     268       nbtr=nqINCA+nqCO2
    228269       nqtrue=nbtr+nqo
    229 
    230        ALLOCATE(hadv_inca(nbtr), vadv_inca(nbtr))
    231 
    232     ENDIF   ! type_trac
     270       WRITE(lunout,*) trim(modname),': nqo = ',nqo
     271       WRITE(lunout,*) trim(modname),': nbtr = ',nbtr
     272       WRITE(lunout,*) trim(modname),': nqtrue = ',nqtrue
     273       WRITE(lunout,*) trim(modname),': nqCO2 = ',nqCO2
     274       WRITE(lunout,*) trim(modname),': nqINCA = ',nqINCA
     275       ALLOCATE(hadv_inca(nqINCA), vadv_inca(nqINCA), conv_flg_inca(nqINCA), pbl_flg_inca(nqINCA), solsym_inca(nqINCA))
     276    ENDIF   ! type_trac 'inca' ou 'inco'
    233277!>jyg
    234278
    235279    IF ((planet_type=="earth").and.(nqtrue < 2)) THEN
    236        WRITE(lunout,*) trim(modname),': nqtrue=',nqtrue, ' is not allowded. 2 tracers is the minimum'
     280       WRITE(lunout,*) trim(modname),': nqtrue=',nqtrue, ' is not allowed. 2 tracers is the minimum'
    237281       CALL abort_gcm('infotrac_init','Not enough tracers',1)
    238     END IF
     282    ENDIF
    239283   
    240284!jyg<
    241 ! Transfert number of tracers to Reprobus
    242 !!    IF (type_trac == 'repr') THEN
    243 !!#ifdef REPROBUS
    244 !!       CALL Init_chem_rep_trac(nbtr)
    245 !!#endif
    246 !!    END IF
    247 !>jyg
    248285       
    249286!
    … …  
    252289    ALLOCATE(tnom_0(nqtrue), hadv(nqtrue), vadv(nqtrue),tnom_transp(nqtrue))
    253290
    254 !
    255 !jyg<
    256 !!    ALLOCATE(conv_flg(nbtr), pbl_flg(nbtr), solsym(nbtr))
    257 !!    conv_flg(:) = 1 ! convection activated for all tracers
    258 !!    pbl_flg(:)  = 1 ! boundary layer activated for all tracers
    259 !>jyg
    260291
    261292!-----------------------------------------------------------------------
    … …  
    271302!     iadv = 13   schema  Frederic Hourdin II
    272303!     iadv = 16   schema  PPM Monotone(Collela & Woodward 1984)
    273 !     iadv = 17   schema  PPM Semi Monotone (overshoots autorisés)
    274 !     iadv = 18   schema  PPM Positif Defini (overshoots undershoots autorisés)
     304!     iadv = 17   schema  PPM Semi Monotone (overshoots autorises)
     305!     iadv = 18   schema  PPM Positif Defini (overshoots undershoots autorises)
    275306!     iadv = 20   schema  Slopes
    276307!     iadv = 30   schema  Prather
    … …  
    286317!---------------------------------------------------------------------
    287318    IF (type_trac == 'lmdz' .OR. type_trac == 'repr' .OR. type_trac == 'coag' .OR. type_trac == 'co2i') THEN
    288        IF(ierr.EQ.0) THEN
     319
    289320          ! Continue to read tracer.def
    290321          DO iq=1,nqtrue
    … …  
    319350                write(lunout,*) 'C''est la nouvelle version de traceur.def'
    320351                tnom_0(iq)=tchaine(1:iiq-1)
    321                 tnom_transp(iq)=tchaine(iiq+1:15)
     352                tnom_transp(iq)=tchaine(iiq+1:)
    322353             else
    323354                write(lunout,*) 'C''est l''ancienne version de traceur.def'
    … …  
    329360             write(lunout,*) 'tnom_transp(iq)=<',trim(tnom_transp(iq)),'>'
    330361
    331           END DO !DO iq=1,nqtrue
     362          ENDDO!DO iq=1,nqtrue
     363
    332364          CLOSE(90) 
    333365
    334        ELSE ! Without tracer.def, set default values
    335          if (planet_type=="earth") then
    336           ! for Earth, default is to have 4 tracers
    337           hadv(1) = 14
    338           vadv(1) = 14
    339           tnom_0(1) = 'H2Ov'
    340           tnom_transp(1) = 'air'
    341           hadv(2) = 10
    342           vadv(2) = 10
    343           tnom_0(2) = 'H2Ol'
    344           tnom_transp(2) = 'air'
    345           hadv(3) = 10
    346           vadv(3) = 10
    347           tnom_0(3) = 'RN'
    348           tnom_transp(3) = 'air'
    349           hadv(4) = 10
    350           vadv(4) = 10
    351           tnom_0(4) = 'PB'
    352           tnom_transp(4) = 'air'
    353          else ! default for other planets
    354           hadv(1) = 10
    355           vadv(1) = 10
    356           tnom_0(1) = 'dummy'
    357           tnom_transp(1) = 'dummy'
    358          endif ! of if (planet_type=="earth")
    359        END IF
    360        
    361366       WRITE(lunout,*) trim(modname),': Valeur de traceur.def :'
    362        WRITE(lunout,*) trim(modname),': nombre de traceurs ',nqtrue
     367       WRITE(lunout,*) trim(modname),': nombre total de traceurs ',nqtrue
    363368       DO iq=1,nqtrue
    364           WRITE(lunout,*) hadv(iq),vadv(iq),tnom_0(iq),tnom_transp(iq)
     369          WRITE(lunout,*) hadv(iq),vadv(iq),' ',trim(tnom_0(iq)),' ',trim(tnom_transp(iq))
    365370       END DO
    366371
    … …  
    418423#endif
    419424
    420     ENDIF  ! (type_trac == 'lmdz' .OR. type_trac == 'repr' .OR. type_trac = 'coag')
     425    ENDIF  ! (type_trac == 'lmdz' .OR. type_trac == 'repr' .OR. type_trac = 'coag' .OR. type_trac = 'co2i')
    421426!jyg<
    422427!
     428
    423429! Transfert number of tracers to Reprobus
    424430    IF (type_trac == 'repr') THEN
    … …  
    426432       CALL Init_chem_rep_trac(nbtr,nqo,tnom_0)
    427433#endif
    428     END IF
     434    ENDIF
    429435!
    430436! Allocate variables depending on nbtr
    … …  
    433439    conv_flg(:) = 1 ! convection activated for all tracers
    434440    pbl_flg(:)  = 1 ! boundary layer activated for all tracers
    435 !
    436 !!    ELSE  ! type_trac=inca : config_inca='aero' ou 'chem'
    437 !
    438     IF (type_trac == 'inca') THEN   ! config_inca='aero' ou 'chem'
     441
     442    IF (type_trac == 'inca' .OR. type_trac == 'inco') THEN   ! config_inca='aero' ou 'chem'
    439443!>jyg
    440444! le module de chimie fournit les noms des traceurs
    441445! et les schemas d'advection associes. excepte pour ceux lus
    442446! dans traceur.def
    443        IF (ierr .eq. 0) then
    444           DO iq=1,nqo
     447
     448          DO iq=1,nqo+nqCO2
    445449
    446450             write(*,*) 'infotrac 237: iq=',iq
    … …  
    459463             nouveau_traceurdef=.false.
    460464             iiq=1
     465
    461466             do while (continu)
    462467                if (tchaine(iiq:iiq).eq.' ') then
    … …  
    469474                endif
    470475             enddo
     476
    471477             write(*,*) 'iiq,nouveau_traceurdef=',iiq,nouveau_traceurdef
     478
    472479             if (nouveau_traceurdef) then
    473480                write(lunout,*) 'C''est la nouvelle version de traceur.def'
    474481                tnom_0(iq)=tchaine(1:iiq-1)
    475                 tnom_transp(iq)=tchaine(iiq+1:15)
     482                tnom_transp(iq)=tchaine(iiq+1:)
    476483             else
    477484                write(lunout,*) 'C''est l''ancienne version de traceur.def'
    … …  
    480487                tnom_transp(iq) = 'air'
    481488             endif
     489
    482490             write(lunout,*) 'tnom_0(iq)=<',trim(tnom_0(iq)),'>'
    483491             write(lunout,*) 'tnom_transp(iq)=<',trim(tnom_transp(iq)),'>'
    484492
    485           END DO !DO iq=1,nqtrue
     493          ENDDO  !DO iq=1,nqo
    486494          CLOSE(90) 
    487        ELSE  !! if traceur.def doesn't exist
    488           tnom_0(1)='H2Ov'
    489           tnom_transp(1) = 'air'
    490           tnom_0(2)='H2Ol'
    491           tnom_transp(2) = 'air'
    492           hadv(1) = 10
    493           hadv(2) = 10
    494           vadv(1) = 10
    495           vadv(2) = 10
    496        ENDIF
     495
    497496 
    498497#ifdef INCA
    … …  
    500499            hadv_inca, &
    501500            vadv_inca, &
    502             conv_flg, &
    503             pbl_flg,  &
    504             solsym)
     501            conv_flg_inca, &
     502            pbl_flg_inca,  &
     503            solsym_inca)
     504
     505       conv_flg(1+nqCO2:nbtr) = conv_flg_inca
     506       pbl_flg(1+nqCO2:nbtr) = pbl_flg_inca
     507       solsym(1+nqCO2:nbtr) = solsym_inca
     508
     509       IF (type_trac == 'inco') THEN
     510          conv_flg(1:nqCO2) = 1
     511          pbl_flg(1:nqCO2) = 1
     512          solsym(1:nqCO2) = 'CO2'
     513       ENDIF
    505514#endif
    506515
    507 
    508516!jyg<
    509        DO iq = nqo+1, nqtrue
    510           hadv(iq) = hadv_inca(iq-nqo)
    511           vadv(iq) = vadv_inca(iq-nqo)
    512           tnom_0(iq)=solsym(iq-nqo)
     517       DO iq = nqo+nqCO2+1, nqtrue
     518          hadv(iq) = hadv_inca(iq-nqo-nqCO2)
     519          vadv(iq) = vadv_inca(iq-nqo-nqCO2)
     520          tnom_0(iq)=solsym_inca(iq-nqo-nqCO2)
    513521          tnom_transp(iq) = 'air'
    514522       END DO
    515523
    516     END IF ! (type_trac == 'inca')
     524    ENDIF ! (type_trac == 'inca' or 'inco')
    517525
    518526!-----------------------------------------------------------------------
    … …  
    534542          WRITE(lunout,*) trim(modname),': This choice of advection schema is not available',iq,hadv(iq),vadv(iq)
    535543          CALL abort_gcm('infotrac_init','Bad choice of advection schema - 1',1)
    536        END IF
     544       ENDIF
    537545    END DO
    538546   
    … …  
    550558       ! The true number of tracers is also the total number
    551559       nqtot = nqtrue
    552     END IF
     560    ENDIF
    553561
    554562!
    … …  
    576584
    577585          CALL abort_gcm('infotrac_init','Bad choice of advection schema - 2',1)
    578        END IF
     586       ENDIF
    579587     
    580588       str1=tnom_0(iq)
    … …  
    584592       ELSE
    585593          ttext(new_iq)=trim(tnom_0(iq))//descrq(iadv(new_iq))
    586        END IF
     594       ENDIF
    587595
    588596       ! schemas tenant compte des moments d'ordre superieur
    … …  
    602610             tname(new_iq)=trim(str1)//txtp(jq)
    603611          END DO
    604        END IF
     612       ENDIF
    605613    END DO
    606614
    … …  
    621629    WRITE(lunout,*) trim(modname),': Information stored in infotrac :'
    622630    WRITE(lunout,*) trim(modname),': iadv  niadv tname  ttext :'
     631
    623632    DO iq=1,nqtot
    624        WRITE(lunout,*) iadv(iq),niadv(iq),&
    625        ' ',trim(tname(iq)),' ',trim(ttext(iq))
     633       WRITE(lunout,*) iadv(iq),niadv(iq), ' ',trim(tname(iq)),' ',trim(ttext(iq))
    626634    END DO
    627635
    … …  
    637645          WRITE(lunout,*)trim(modname),'STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ'
    638646          CALL abort_gcm('infotrac_init','In this version iadv=14 is only permitted for water vapour!',1)
    639        END IF
     647       ENDIF
    640648    END DO
    641649
    642650
    643 ! CRisi: quels sont les traceurs fils et les traceurs pères.
    644 ! initialiser tous les tableaux d'indices liés aux traceurs familiaux
    645 ! + vérifier que tous les pères sont écrits en premières positions
     651! CRisi: quels sont les traceurs fils et les traceurs peres.
     652! initialiser tous les tableaux d'indices lies aux traceurs familiaux
     653! + verifier que tous les peres sont ecrits en premieres positions
    646654    ALLOCATE(nqfils(nqtot),nqdesc(nqtot))   
    647655    ALLOCATE(iqfils(nqtot,nqtot))   
    … …  
    655663    DO iq=1,nqtot
    656664      if (tnom_transp(iq) == 'air') then
    657         ! ceci est un traceur père
     665        ! ceci est un traceur pere
    658666        WRITE(lunout,*) 'Le traceur',iq,', appele ',trim(tnom_0(iq)),', est un pere'
    659667        nqperes=nqperes+1
    660668        iqpere(iq)=0
    661669      else !if (tnom_transp(iq) == 'air') then
    662         ! ceci est un fils. Qui est son père?
     670        ! ceci est un fils. Qui est son pere?
    663671        WRITE(lunout,*) 'Le traceur',iq,', appele ',trim(tnom_0(iq)),', est un fils'
    664672        continu=.true.
    … …  
    666674        do while (continu)           
    667675          if (tnom_transp(iq) == tnom_0(ipere)) then
    668             ! Son père est ipere
     676            ! Son pere est ipere
    669677            WRITE(lunout,*) 'Le traceur',iq,'appele ', &
    670678      &          trim(tnom_0(iq)),' est le fils de ',ipere,'appele ',trim(tnom_0(ipere))
     679            if (iq.eq.ipere) then
     680                CALL abort_gcm('infotrac_init','Un fils est son propre pere',1)
     681            endif
    671682            nqfils(ipere)=nqfils(ipere)+1 
    672683            iqfils(nqfils(ipere),ipere)=iq
    … …  
    689700    WRITE(lunout,*) 'iqfils=',iqfils
    690701
    691 ! Calculer le nombre de descendants à partir de iqfils et de nbfils
     702! Calculer le nombre de descendants a partir de iqfils et de nbfils
    692703    DO iq=1,nqtot   
    693704      generation=0
    … …  
    712723    WRITE(lunout,*) 'nqdesc_tot=',nqdesc_tot
    713724
    714 ! Interdire autres schémas que 10 pour les traceurs fils, et autres schémas
    715 ! que 10 et 14 si des pères ont des fils
     725! Interdire autres schemas que 10 pour les traceurs fils, et autres schemas
     726! que 10 et 14 si des peres ont des fils
    716727    do iq=1,nqtot
    717728      if (iqpere(iq).gt.0) then
    718         ! ce traceur a un père qui n'est pas l'air
    719         ! Seul le schéma 10 est autorisé
     729        ! ce traceur a un pere qui n'est pas l'air
     730        ! Seul le schema 10 est autorise
    720731        if (iadv(iq)/=10) then
    721732           WRITE(lunout,*)trim(modname),' STOP : The option iadv=',iadv(iq),' is not implemented for sons'
    722733          CALL abort_gcm('infotrac_init','Sons should be advected by scheme 10',1)
    723734        endif
    724         ! Le traceur père ne peut être advecté que par schéma 10 ou 14:
     735        ! Le traceur pere ne peut etre advecte que par schema 10 ou 14:
    725736        IF (iadv(iqpere(iq))/=10 .AND. iadv(iqpere(iq))/=14) THEN
    726737          WRITE(lunout,*)trim(modname),' STOP : The option iadv=',iadv(iq),' is not implemented for fathers'
    … …  
    730741    enddo !do iq=1,nqtot
    731742
    732     WRITE(lunout,*) 'infotrac init fin'
     743
    733744
    734745! detecter quels sont les traceurs isotopiques parmi des traceurs
    735746    call infotrac_isoinit(tnom_0,nqtrue)
    736        
     747
     748!    if (ntraciso.gt.0) then
     749! le 18 sep 2020: on enleve la condition ntraciso.gt.0 car nqtottr doit etre
     750! connu meme si il n'y a pas d'isotopes!
     751        write(lunout,*) 'infotrac 702: nbtr,ntraciso=',nbtr,ntraciso
     752! retrancher les traceurs isotopiques de la liste des traceurs qui passent dans
     753! phytrac
     754        nbtr=nbtr-nqo*ntraciso
     755
     756! faire un tableau d'indice des traceurs qui passeront dans phytrac
     757        nqtottr=nqtot-nqo*(1+ntraciso)
     758        write(lunout,*) 'infotrac 704: nqtottr,nqtot,nqo=',nqtottr,nqtot,nqo
     759        ! Rq: nqtottr n'est pas forcement egal a nbtr dans le cas ou new_iq /= nqtrue
     760        ALLOCATE (itr_indice(nqtottr)) 
     761        itr_indice(:)=0 
     762        itr=0
     763        do iq=nqo+1, nqtot
     764          if (iso_num(iq).eq.0) then
     765            itr=itr+1
     766            write(*,*) 'itr=',itr
     767            itr_indice(itr)=iq
     768          endif !if (iso_num(iq).eq.0) then
     769        enddo
     770        if (itr.ne.nqtottr) then
     771            CALL abort_gcm('infotrac_init','pb dans le calcul de nqtottr',1)
     772        endif
     773        write(lunout,*) 'itr_indice=',itr_indice
     774!    endif !if (ntraciso.gt.0) then
     775
    737776!-----------------------------------------------------------------------
    738777! Finalize :
    … …  
    740779    DEALLOCATE(tnom_0, hadv, vadv,tnom_transp)
    741780
     781    WRITE(lunout,*) 'infotrac init fin'
    742782
    743783  END SUBROUTINE infotrac_init
    … …  
    754794 
    755795    ! inputs
    756     INTEGER nqtrue
    757     CHARACTER(len=15) tnom_0(nqtrue)
     796    INTEGER,INTENT(IN) :: nqtrue
     797    CHARACTER(len=*),INTENT(IN) :: tnom_0(nqtrue)
    758798   
    759799    ! locals   
    … …  
    762802    INTEGER, ALLOCATABLE,DIMENSION(:) :: nb_isoind
    763803    INTEGER :: ntraceurs_zone_prec,iq,phase,ixt,iiso,izone
    764     CHARACTER(len=19) :: tnom_trac
     804    CHARACTER(len=tname_lenmax) :: tnom_trac
    765805    INCLUDE "iniprint.h"
    766806
    … …  
    838878
    839879        if (nb_iso(ixt,1).eq.1) then
    840           ! on vérifie que toutes les phases ont le même nombre de
     880          ! on verifie que toutes les phases ont le meme nombre de
    841881          ! traceurs
    842882          do phase=2,nqo
    … …  
    851891          ntraceurs_zone=nb_traciso(ixt,1)
    852892
    853           ! on vérifie que toutes les phases ont le même nombre de
     893          ! on verifie que toutes les phases ont le meme nombre de
    854894          ! traceurs
    855895          do phase=2,nqo
    … …  
    860900            endif 
    861901          enddo  !do phase=2,nqo
    862           ! on vérifie que tous les isotopes ont le même nombre de
     902          ! on verifie que tous les isotopes ont le meme nombre de
    863903          ! traceurs
    864904          if (ntraceurs_zone_prec.gt.0) then               

  • LMDZ6/branches/Ocean_skin/libf/dyn3dmem/dynetat0_loc.F90

    r3043 r4013  
    225225END SUBROUTINE get_var1
    226226
    227 
    228227SUBROUTINE get_var2(var,v)
    229228  CHARACTER(LEN=*), INTENT(IN)  :: var
    230229  REAL,             INTENT(OUT) :: v(:,:)
    231   REAL,             ALLOCATABLE :: w4(:,:,:,:)
     230  REAL,             ALLOCATABLE :: w4(:,:,:,:), w3(:,:,:)
    232231  INTEGER :: nn(4), dids(4), k, nd
     232
     233
    233234  CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
    234   ierr=NF90_INQUIRE_VARIABLE(fID,vID,dimids=dids,ndims=nd)
     235  ierr=NF90_INQUIRE_VARIABLE(fID,vID,ndims=nd)
     236
     237  IF(nd==1) THEN
     238    CALL err(NF90_GET_VAR(fID,vID,v),"get",var); RETURN
     239  END IF
     240  ierr=NF90_INQUIRE_VARIABLE(fID,vID,dimids=dids)
     241
    235242  DO k=1,nd; ierr=NF90_INQUIRE_DIMENSION(fID,dids(k),len=nn(k)); END DO
    236   ALLOCATE(w4(nn(1),nn(2),nn(3),nn(4)))
    237   CALL err(NF90_GET_VAR(fID,vID,w4),"get",var)
    238   v=RESHAPE(w4,[nn(1)*nn(2),nn(3)]); DEALLOCATE(w4)
     243
     244  SELECT CASE(nd)
     245  CASE(3); ALLOCATE(w3(nn(1),nn(2),nn(3)))
     246     CALL err(NF90_GET_VAR(fID,vID,w3),"get",var)
     247     v=RESHAPE(w3,[nn(1)*nn(2),nn(3)]); DEALLOCATE(w3)
     248  CASE(4);  ALLOCATE(w4(nn(1),nn(2),nn(3),nn(4)))
     249     CALL err(NF90_GET_VAR(fID,vID,w4),"get",var)
     250     v=RESHAPE(w4,[nn(1)*nn(2),nn(3)]); DEALLOCATE(w4)
     251  END SELECT
    239252END SUBROUTINE get_var2
    240253

  • LMDZ6/branches/Ocean_skin/libf/dyn3dmem/dynredem_loc.F90

    r3811 r4013  
    242242!$OMP MASTER
    243243  fil="start_trac.nc"
    244   IF(type_trac=='inca') INQUIRE(FILE=fil,EXIST=lread_inca)
     244  IF(type_trac=='inca' .OR. type_trac=='inco') INQUIRE(FILE=fil,EXIST=lread_inca)
    245245  IF(lread_inca) CALL err(NF90_OPEN(fil,NF90_NOWRITE,nid_trac),"open")
    246246!$OMP END MASTER

  • LMDZ6/branches/Ocean_skin/libf/dyn3dmem/guide_loc_mod.F90

    r3811 r4013  
    99!=======================================================================
    1010
    11   USE getparam
     11  USE getparam, only: ini_getparam, fin_getparam, getpar
    1212  USE Write_Field_loc
    13   use netcdf, only: nf90_nowrite, nf90_open, nf90_inq_varid, nf90_close
     13  use netcdf, only: nf90_nowrite, nf90_open, nf90_inq_varid, nf90_close, &
     14                    nf90_inq_dimid, nf90_inquire_dimension
    1415  USE parallel_lmdz
    15   USE pres2lev_mod
     16  USE pres2lev_mod, only: pres2lev
    1617
    1718  IMPLICIT NONE
    … …  
    6263  REAL, ALLOCATABLE, DIMENSION(:),   PRIVATE, SAVE   :: psgui1,psgui2
    6364 
    64   INTEGER,SAVE,PRIVATE :: ijbu,ijbv,ijeu,ijev,ijnu,ijnv
     65  INTEGER,SAVE,PRIVATE :: ijbu,ijbv,ijeu,ijev !,ijnu,ijnv
    6566  INTEGER,SAVE,PRIVATE :: jjbu,jjbv,jjeu,jjev,jjnu,jjnv
    6667
    … …  
    8384    CHARACTER (len = 80)   :: abort_message
    8485    CHARACTER (len = 20)   :: modname = 'guide_init'
     86    CHARACTER (len = 20)   :: namedim
    8587
    8688! ---------------------------------------------
    … …  
    173175          rcod=nf90_open('apbp.nc',Nf90_NOWRITe, ncidpl)
    174176          if (rcod.NE.NF_NOERR) THEN
    175              print *,'Guide: probleme -> pas de fichier apbp.nc'
     177             abort_message=' Nudging error -> no file apbp.nc'
    176178             CALL abort_gcm(modname,abort_message,1)
    177179          endif
    … …  
    181183          rcod=nf90_open('P.nc',Nf90_NOWRITe,ncidpl)
    182184          if (rcod.NE.NF_NOERR) THEN
    183              print *,'Guide: probleme -> pas de fichier P.nc'
     185             abort_message=' Nudging error -> no file P.nc'
    184186             CALL abort_gcm(modname,abort_message,1)
    185187          endif
    186188       endif
     189
    187190    elseif (guide_u) then
    188191       if (ncidpl.eq.-99) then
    189192          rcod=nf90_open('u.nc',Nf90_NOWRITe,ncidpl)
    190193          if (rcod.NE.NF_NOERR) THEN
    191              print *,'Guide: probleme -> pas de fichier u.nc'
     194             abort_message=' Nudging error -> no file u.nc'
    192195             CALL abort_gcm(modname,abort_message,1)
    193196          endif
     197         
    194198       endif
     199
     200
    195201    elseif (guide_v) then
    196202       if (ncidpl.eq.-99) then
    197203          rcod=nf90_open('v.nc',nf90_nowrite,ncidpl)
    198204          if (rcod.NE.NF_NOERR) THEN
    199              print *,'Guide: probleme -> pas de fichier v.nc'
     205             abort_message=' Nudging error -> no file v.nc'
    200206             CALL abort_gcm(modname,abort_message,1)
    201207          endif
    202208       endif
     209
     210   
    203211    elseif (guide_T) then
    204212       if (ncidpl.eq.-99) then
    205213          rcod=nf90_open('T.nc',nf90_nowrite,ncidpl)
    206214          if (rcod.NE.NF_NOERR) THEN
    207              print *,'Guide: probleme -> pas de fichier T.nc'
     215             abort_message=' Nudging error -> no file T.nc'
    208216             CALL abort_gcm(modname,abort_message,1)
    209217          endif
    210218       endif
     219
     220
     221
    211222    elseif (guide_Q) then
    212223       if (ncidpl.eq.-99) then
    213224          rcod=nf90_open('hur.nc',nf90_nowrite, ncidpl)
    214225          if (rcod.NE.NF_NOERR) THEN
    215              print *,'Guide: probleme -> pas de fichier hur.nc'
     226             abort_message=' Nudging error -> no file hur.nc'
    216227             CALL abort_gcm(modname,abort_message,1)
    217228          endif
    218229       endif
     230
     231
    219232    endif
    220233    error=NF_INQ_DIMID(ncidpl,'LEVEL',rid)
    221234    IF (error.NE.NF_NOERR) error=NF_INQ_DIMID(ncidpl,'PRESSURE',rid)
    222235    IF (error.NE.NF_NOERR) THEN
    223         print *,'Guide: probleme lecture niveaux pression'
     236        abort_message='Nudging: error reading pressure levels'
    224237        CALL abort_gcm(modname,abort_message,1)
    225238    ENDIF
    226239    error=NF_INQ_DIMLEN(ncidpl,rid,nlevnc)
    227     print *,'Guide: nombre niveaux vert. nlevnc', nlevnc
     240    write(*,*)trim(modname)//' : number of vertical levels nlevnc', nlevnc
    228241    rcod = nf90_close(ncidpl)
    229242
    … …  
    231244! Allocation des variables
    232245! ---------------------------------------------
    233     abort_message='pb in allocation guide'
     246    abort_message='nudging allocation error'
    234247
    235248    ALLOCATE(apnc(nlevnc), stat = error)
    … …  
    382395   
    383396    INTEGER       :: i,j,l
    384     INTEGER,EXTERNAL :: OMP_GET_THREAD_NUM
     397    CHARACTER(LEN=20) :: modname="guide_main"
    385398       
    386399!$OMP MASTER   
    387     ijbu=ij_begin ; ijeu=ij_end ; ijnu=ijeu-ijbu+1 
     400    ijbu=ij_begin ; ijeu=ij_end
    388401    jjbu=jj_begin ; jjeu=jj_end ; jjnu=jjeu-jjbu+1
    389     ijbv=ij_begin ; ijev=ij_end ; ijnv=ijev-ijbv+1   
     402    ijbv=ij_begin ; ijev=ij_end
    390403    jjbv=jj_begin ; jjev=jj_end ; jjnv=jjev-jjbv+1
    391404    IF (pole_sud) THEN
     405      ijeu=ij_end-iip1
    392406      ijev=ij_end-iip1
    393407      jjev=jj_end-1
    394       ijnv=ijev-ijbv+1
    395408      jjnv=jjev-jjbv+1
     409    ENDIF
     410    IF (pole_nord) THEN
     411      ijbu=ij_begin+iip1
     412      ijbv=ij_begin
    396413    ENDIF
    397414!$OMP END MASTER
    … …  
    480497      IF (reste.EQ.0.) THEN
    481498          IF (itau_test.EQ.itau) THEN
    482               write(*,*)'deuxieme passage de advreel a itau=',itau
    483               stop
     499            write(*,*)trim(modname)//' second pass in advreel at itau=',&
     500            itau
     501            stop
    484502          ELSE
    485503!$OMP MASTER
    … …  
    494512              step_rea=step_rea+1
    495513              itau_test=itau
    496               print*,'Lecture fichiers guidage, pas ',step_rea, &
    497                     'apres ',count_no_rea,' non lectures'
     514              if (is_master) then
     515                write(*,*)trim(modname)//' Reading nudging files, step ',&
     516                    step_rea,'after ',count_no_rea,' skips'
     517              endif
    498518              IF (guide_2D) THEN
    499519!$OMP MASTER
    … …  
    534554   
    535555   
    536         !-----------------------------------------------------------------------
     556!-----------------------------------------------------------------------
    537557!   Ajout des champs de guidage
    538558!-----------------------------------------------------------------------
    … …  
    563583        ENDDO
    564584
    565 !!$OMP MASTER
    566 !     DO l=1,llm,5
    567 !         print*,'avant dump2d l=',l,mpi_rank,OMP_GET_THREAD_NUM()
    568 !         print*,'avant dump2d l=',l,mpi_rank
    569 !         CALL dump2d(iip1,jjnb_u,p(:,l),'ppp   ')
    570 !      ENDDO
    571 !!$OMP END MASTER
    572 !!$OMP BARRIER
    573 
    574585        CALL guide_out("SP",jjp1,llm,p(ijb_u:ije_u,1:llm),1.)
    575586    ENDIF
    … …  
    592603        if (guide_zon) CALL guide_zonave_u(1,llm,f_addu)
    593604        CALL guide_addfield_u(llm,f_addu,alpha_u)
    594 !       IF (f_out) CALL guide_out("ua",jjp1,llm,ugui1(ijb_u:ije_u,:),factt)
    595605        IF (f_out) CALL guide_out("ua",jjp1,llm,(1.-tau)*ugui1(ijb_u:ije_u,:)+tau*ugui2(ijb_u:ije_u,:),factt)
    596606        IF (f_out) CALL guide_out("u",jjp1,llm,ucov(ijb_u:ije_u,:),factt)
    597         IF (f_out) CALL guide_out("ucov",jjp1,llm,f_addu(ijb_u:ije_u,:),factt)
     607        IF (f_out) THEN
     608         ! Ehouarn: fill the gaps adequately...
     609         IF (ijbu>ijb_u) f_addu(ijb_u:ijbu-1,:)=0
     610         IF (ijeu<ije_u) f_addu(ijeu+1:ije_u,:)=0
     611         CALL guide_out("ucov",jjp1,llm,f_addu(ijb_u:ije_u,:)/factt,factt)
     612        ENDIF
    598613!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    599614        DO l=1,llm
    … …  
    690705        IF (f_out) CALL guide_out("v",jjm,llm,vcov(ijb_v:ije_v,:),factt)
    691706        IF (f_out) CALL guide_out("va",jjm,llm,(1.-tau)*vgui1(ijb_v:ije_v,:)+tau*vgui2(ijb_v:ije_v,:),factt)
    692         IF (f_out) CALL guide_out("vcov",jjm,llm,f_addv(:,:)/factt,factt)
     707        IF (f_out) THEN
     708          ! Ehouarn: Fill in the gaps adequately
     709          IF (ijbv>ijb_v) f_addv(ijb_v:ijbv-1,:)=0
     710          IF (ijev<ije_v) f_addv(ijev+1:ije_v,:)=0
     711          CALL guide_out("vcov",jjm,llm,f_addv(ijb_v:ije_v,:)/factt,factt)
     712        ENDIF
    693713
    694714!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    … …  
    926946 
    927947  INTEGER                            :: i,j,l,ij
     948  CHARACTER(LEN=20),PARAMETER :: modname="guide_interp"
    928949  TYPE(Request),SAVE :: Req 
    929950!$OMP THREADPRIVATE(Req)
    930     print *,'Guide: conversion variables guidage'
     951   
     952    if (is_master) write(*,*)trim(modname)//': interpolate nudging variables'
    931953! -----------------------------------------------------------------
    932954! Calcul des niveaux de pression champs guidage (pour T et Q)
    … …  
    973995        first=.FALSE.
    974996!$OMP MASTER
    975         print*,'Guide: verification ordre niveaux verticaux'
    976         print*,'LMDZ :'
     997        write(*,*)trim(modname)//' : check vertical level order'
     998        write(*,*)trim(modname)//' LMDZ :'
    977999        do l=1,llm
    978             print*,'PL(',l,')=',(ap(l)+ap(l+1))/2. &
     1000          write(*,*)trim(modname)//' PL(',l,')=',(ap(l)+ap(l+1))/2. &
    9791001                  +psi(1,jjeu)*(bp(l)+bp(l+1))/2.
    9801002        enddo
    981         print*,'Fichiers guidage'
     1003        write(*,*)trim(modname)//' nudging file :'
    9821004        SELECT CASE (guide_plevs)
    9831005        CASE (0)
    9841006            do l=1,nlevnc
    985                  print*,'PL(',l,')=',plnc2(1,jjbu,l)
     1007              write(*,*)trim(modname)//' PL(',l,')=',plnc2(1,jjbu,l)
    9861008            enddo
    9871009        CASE (1)
    9881010            DO l=1,nlevnc
    989                  print*,'PL(',l,')=',apnc(l)+bpnc(l)*psnat2(i,jjbu)
    990              ENDDO
     1011              write(*,*)trim(modname)//' PL(',l,')=',&
     1012                        apnc(l)+bpnc(l)*psnat2(i,jjbu)
     1013            ENDDO
    9911014        CASE (2)
    9921015            do l=1,nlevnc
    993                  print*,'PL(',l,')=',pnat2(1,jjbu,l)
     1016              write(*,*)trim(modname)//' PL(',l,')=',pnat2(1,jjbu,l)
    9941017            enddo
    9951018        END SELECT
    996         print *,'inversion de l''ordre: invert_p=',invert_p
     1019        write(*,*)trim(modname)//' invert ordering: invert_p=',invert_p
    9971020        if (guide_u) then
    9981021            do l=1,nlevnc
    999                 print*,'U(',l,')=',unat2(1,jjbu,l)
     1022              write(*,*)trim(modname)//' U(',l,')=',unat2(1,jjbu,l)
    10001023            enddo
    10011024        endif
    10021025        if (guide_T) then
    10031026            do l=1,nlevnc
    1004                 print*,'T(',l,')=',tnat2(1,jjbu,l)
     1027              write(*,*)trim(modname)//' T(',l,')=',tnat2(1,jjbu,l)
    10051028            enddo
    10061029        endif
    10071030!$OMP END MASTER
    1008     endif
     1031    endif ! of if (first)
    10091032   
    10101033! -----------------------------------------------------------------
    … …  
    14021425    real alphamin,alphamax,xi
    14031426    integer i,j,ilon,ilat
     1427    character(len=20),parameter :: modname="tau2alpha"
    14041428
    14051429
    … …  
    14901514            ! Calcul de gamma
    14911515            if (abs(grossismx-1.).lt.0.1.or.abs(grossismy-1.).lt.0.1) then
    1492                  print*,'ATTENTION modele peu zoome'
    1493                  print*,'ATTENTION on prend une constante de guidage cste'
    1494                  gamma=0.
     1516              write(*,*)trim(modname)//' ATTENTION modele peu zoome'
     1517              write(*,*)trim(modname)//' ATTENTION on prend une constante de guidage cste'
     1518              gamma=0.
    14951519            else
    1496                 gamma=(dxdy_max-2.*dxdy_min)/(dxdy_max-dxdy_min)
    1497                 print*,'gamma=',gamma
    1498                 if (gamma.lt.1.e-5) then
    1499                   print*,'gamma =',gamma,'<1e-5'
    1500                   stop
    1501                 endif
    1502                 gamma=log(0.5)/log(gamma)
    1503                 if (gamma4) then
    1504                   gamma=min(gamma,4.)
    1505                 endif
    1506                 print*,'gamma=',gamma
     1520              gamma=(dxdy_max-2.*dxdy_min)/(dxdy_max-dxdy_min)
     1521              write(*,*)trim(modname)//' gamma=',gamma
     1522              if (gamma.lt.1.e-5) then
     1523                write(*,*)trim(modname)//' gamma =',gamma,'<1e-5'
     1524                stop
     1525              endif
     1526              gamma=log(0.5)/log(gamma)
     1527              if (gamma4) then
     1528                gamma=min(gamma,4.)
     1529              endif
     1530              write(*,*)trim(modname)//' gamma=',gamma
    15071531            endif
    15081532        ENDIF !first
    … …  
    15451569    IMPLICIT NONE
    15461570
    1547 #include "netcdf.inc"
    1548 #include "dimensions.h"
    1549 #include "paramet.h"
     1571    include "netcdf.inc"
     1572    include "dimensions.h"
     1573    include "paramet.h"
    15501574
    15511575    INTEGER, INTENT(IN)   :: timestep
    … …  
    15551579    INTEGER, SAVE         :: ncidu,varidu,ncidv,varidv,ncidp,varidp
    15561580    INTEGER, SAVE         :: ncidQ,varidQ,ncidt,varidt,ncidps,varidps
    1557     INTEGER               :: ncidpl,varidpl,varidap,varidbp
     1581    INTEGER               :: ncidpl,varidpl,varidap,varidbp,dimid,lendim
    15581582! Variables auxiliaires NetCDF:
    15591583    INTEGER, DIMENSION(4) :: start,count
    … …  
    15611585    CHARACTER (len = 80)   :: abort_message
    15621586    CHARACTER (len = 20)   :: modname = 'guide_read'
     1587    CHARACTER (len = 20)   :: namedim
    15631588    abort_message='pb in guide_read'
    15641589
    … …  
    15681593    if (first) then
    15691594         ncidpl=-99
    1570          print*,'Guide: ouverture des fichiers guidage '
     1595         write(*,*),trim(modname)//': opening nudging files '
    15711596! Ap et Bp si Niveaux de pression hybrides
    15721597         if (guide_plevs.EQ.1) then
    1573              print *,'Lecture du guidage sur niveaux modele'
     1598             write(*,*),trim(modname)//' Reading nudging on model levels'
    15741599             rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
    15751600             IF (rcode.NE.NF_NOERR) THEN
    1576               print *,'Guide: probleme -> pas de fichier apbp.nc'
     1601              abort_message='Nudging: error -> no file apbp.nc'
    15771602              CALL abort_gcm(modname,abort_message,1)
    15781603             ENDIF
    15791604             rcode = nf90_inq_varid(ncidpl, 'AP', varidap)
    15801605             IF (rcode.NE.NF_NOERR) THEN
    1581               print *,'Guide: probleme -> pas de variable AP, fichier apbp.nc'
     1606              abort_message='Nudging: error -> no AP variable in file apbp.nc'
    15821607              CALL abort_gcm(modname,abort_message,1)
    15831608             ENDIF
    15841609             rcode = nf90_inq_varid(ncidpl, 'BP', varidbp)
    15851610             IF (rcode.NE.NF_NOERR) THEN
    1586               print *,'Guide: probleme -> pas de variable BP, fichier apbp.nc'
     1611              abort_message='Nudging: error -> no BP variable in file apbp.nc'
    15871612              CALL abort_gcm(modname,abort_message,1)
    15881613             ENDIF
    1589              print*,'ncidpl,varidap',ncidpl,varidap
     1614             write(*,*),trim(modname)//' ncidpl,varidap',ncidpl,varidap
    15901615         endif
     1616         
    15911617! Pression si guidage sur niveaux P variables
    15921618         if (guide_plevs.EQ.2) then
    15931619             rcode = nf90_open('P.nc', nf90_nowrite, ncidp)
    15941620             IF (rcode.NE.NF_NOERR) THEN
    1595               print *,'Guide: probleme -> pas de fichier P.nc'
     1621              abort_message='Nudging: error -> no file P.nc'
    15961622              CALL abort_gcm(modname,abort_message,1)
    15971623             ENDIF
    15981624             rcode = nf90_inq_varid(ncidp, 'PRES', varidp)
    15991625             IF (rcode.NE.NF_NOERR) THEN
    1600               print *,'Guide: probleme -> pas de variable PRES, fichier P.nc'
     1626              abort_message='Nudging: error -> no PRES variable in file P.nc'
    16011627              CALL abort_gcm(modname,abort_message,1)
    16021628             ENDIF
    1603              print*,'ncidp,varidp',ncidp,varidp
     1629             write(*,*),trim(modname)//' ncidp,varidp',ncidp,varidp
    16041630             if (ncidpl.eq.-99) ncidpl=ncidp
    16051631         endif
     1632
    16061633! Vent zonal
    16071634         if (guide_u) then
    16081635             rcode = nf90_open('u.nc', nf90_nowrite, ncidu)
    16091636             IF (rcode.NE.NF_NOERR) THEN
    1610               print *,'Guide: probleme -> pas de fichier u.nc'
     1637              abort_message='Nudging: error -> no file u.nc'
    16111638              CALL abort_gcm(modname,abort_message,1)
    16121639             ENDIF
    16131640             rcode = nf90_inq_varid(ncidu, 'UWND', varidu)
    16141641             IF (rcode.NE.NF_NOERR) THEN
    1615               print *,'Guide: probleme -> pas de variable UWND, fichier u.nc'
     1642              abort_message='Nudging: error -> no UWND variable in file u.nc'
    16161643              CALL abort_gcm(modname,abort_message,1)
    16171644             ENDIF
    1618              print*,'ncidu,varidu',ncidu,varidu
     1645             write(*,*),trim(modname)//' ncidu,varidu',ncidu,varidu
    16191646             if (ncidpl.eq.-99) ncidpl=ncidu
     1647
     1648   
     1649             status=NF90_INQ_DIMID(ncidu, "LONU", dimid)
     1650             status=NF90_INQUIRE_DIMENSION(ncidu,dimid,namedim,lendim)
     1651             IF (lendim .NE. iip1) THEN
     1652                abort_message='dimension LONU different from iip1 in u.nc'
     1653                CALL abort_gcm(modname,abort_message,1)
     1654             ENDIF
     1655
     1656             status=NF90_INQ_DIMID(ncidu, "LATU", dimid)
     1657             status=NF90_INQUIRE_DIMENSION(ncidu,dimid,namedim,lendim)
     1658             IF (lendim .NE. jjp1) THEN
     1659                abort_message='dimension LATU different from jjp1 in u.nc'
     1660                CALL abort_gcm(modname,abort_message,1)
     1661             ENDIF
     1662 
    16201663         endif
     1664
    16211665! Vent meridien
    16221666         if (guide_v) then
    16231667             rcode = nf90_open('v.nc', nf90_nowrite, ncidv)
    16241668             IF (rcode.NE.NF_NOERR) THEN
    1625               print *,'Guide: probleme -> pas de fichier v.nc'
     1669              abort_message='Nudging: error -> no file v.nc'
    16261670              CALL abort_gcm(modname,abort_message,1)
    16271671             ENDIF
    16281672             rcode = nf90_inq_varid(ncidv, 'VWND', varidv)
    16291673             IF (rcode.NE.NF_NOERR) THEN
    1630               print *,'Guide: probleme -> pas de variable VWND, fichier v.nc'
     1674              abort_message='Nudging: error -> no VWND variable in file v.nc'
    16311675              CALL abort_gcm(modname,abort_message,1)
    16321676             ENDIF
    1633              print*,'ncidv,varidv',ncidv,varidv
     1677             write(*,*),trim(modname)//' ncidv,varidv',ncidv,varidv
    16341678             if (ncidpl.eq.-99) ncidpl=ncidv
    1635          endif
     1679             
     1680             status=NF90_INQ_DIMID(ncidv, "LONV", dimid)
     1681             status=NF90_INQUIRE_DIMENSION(ncidv,dimid,namedim,lendim)
     1682             
     1683                IF (lendim .NE. iip1) THEN
     1684                abort_message='dimension LONV different from iip1 in v.nc'
     1685                CALL abort_gcm(modname,abort_message,1)
     1686             ENDIF
     1687
     1688
     1689             status=NF90_INQ_DIMID(ncidv, "LATV", dimid)
     1690             status=NF90_INQUIRE_DIMENSION(ncidv,dimid,namedim,lendim)
     1691             IF (lendim .NE. jjm) THEN
     1692                abort_message='dimension LATV different from jjm in v.nc'
     1693                CALL abort_gcm(modname,abort_message,1)
     1694             ENDIF
     1695       
     1696        endif
     1697
    16361698! Temperature
    16371699         if (guide_T) then
    16381700             rcode = nf90_open('T.nc', nf90_nowrite, ncidt)
    16391701             IF (rcode.NE.NF_NOERR) THEN
    1640               print *,'Guide: probleme -> pas de fichier T.nc'
     1702              abort_message='Nudging: error -> no file T.nc'
    16411703              CALL abort_gcm(modname,abort_message,1)
    16421704             ENDIF
    16431705             rcode = nf90_inq_varid(ncidt, 'AIR', varidt)
    16441706             IF (rcode.NE.NF_NOERR) THEN
    1645               print *,'Guide: probleme -> pas de variable AIR, fichier T.nc'
     1707              abort_message='Nudging: error -> no AIR variable in file T.nc'
    16461708              CALL abort_gcm(modname,abort_message,1)
    16471709             ENDIF
    1648              print*,'ncidT,varidT',ncidt,varidt
     1710             write(*,*),trim(modname)//' ncidT,varidT',ncidt,varidt
    16491711             if (ncidpl.eq.-99) ncidpl=ncidt
     1712
     1713             status=NF90_INQ_DIMID(ncidt, "LONV", dimid)
     1714             status=NF90_INQUIRE_DIMENSION(ncidt,dimid,namedim,lendim)
     1715             IF (lendim .NE. iip1) THEN
     1716                abort_message='dimension LONV different from iip1 in T.nc'
     1717                CALL abort_gcm(modname,abort_message,1)
     1718             ENDIF
     1719
     1720             status=NF90_INQ_DIMID(ncidt, "LATU", dimid)
     1721             status=NF90_INQUIRE_DIMENSION(ncidt,dimid,namedim,lendim)
     1722             IF (lendim .NE. jjp1) THEN
     1723                abort_message='dimension LATU different from jjp1 in T.nc'
     1724                CALL abort_gcm(modname,abort_message,1)
     1725             ENDIF
     1726
    16501727         endif
     1728
    16511729! Humidite
    16521730         if (guide_Q) then
    16531731             rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ)
    16541732             IF (rcode.NE.NF_NOERR) THEN
    1655               print *,'Guide: probleme -> pas de fichier hur.nc'
     1733              abort_message='Nudging: error -> no file hur.nc'
    16561734              CALL abort_gcm(modname,abort_message,1)
    16571735             ENDIF
    16581736             rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)
    16591737             IF (rcode.NE.NF_NOERR) THEN
    1660               print *,'Guide: probleme -> pas de variable RH, fichier hur.nc'
     1738              abort_message='Nudging: error -> no RH variable in file hur.nc'
    16611739              CALL abort_gcm(modname,abort_message,1)
    16621740             ENDIF
    1663              print*,'ncidQ,varidQ',ncidQ,varidQ
     1741             write(*,*),trim(modname)//' ncidQ,varidQ',ncidQ,varidQ
    16641742             if (ncidpl.eq.-99) ncidpl=ncidQ
     1743
     1744
     1745             status=NF90_INQ_DIMID(ncidQ, "LONV", dimid)
     1746             status=NF90_INQUIRE_DIMENSION(ncidQ,dimid,namedim,lendim)
     1747             IF (lendim .NE. iip1) THEN
     1748                abort_message='dimension LONV different from iip1 in hur.nc'
     1749                CALL abort_gcm(modname,abort_message,1)
     1750             ENDIF
     1751
     1752             status=NF90_INQ_DIMID(ncidQ, "LATU", dimid)
     1753             status=NF90_INQUIRE_DIMENSION(ncidQ,dimid,namedim,lendim)
     1754             IF (lendim .NE. jjp1) THEN
     1755                abort_message='dimension LATU different from jjp1 in hur.nc'
     1756                CALL abort_gcm(modname,abort_message,1)
     1757             ENDIF
     1758
     1759
    16651760         endif
    16661761! Pression de surface
    … …  
    16681763             rcode = nf90_open('ps.nc', nf90_nowrite, ncidps)
    16691764             IF (rcode.NE.NF_NOERR) THEN
    1670               print *,'Guide: probleme -> pas de fichier ps.nc'
     1765              abort_message='Nudging: error -> no file ps.nc'
    16711766              CALL abort_gcm(modname,abort_message,1)
    16721767             ENDIF
    16731768             rcode = nf90_inq_varid(ncidps, 'SP', varidps)
    16741769             IF (rcode.NE.NF_NOERR) THEN
    1675               print *,'Guide: probleme -> pas de variable SP, fichier ps.nc'
     1770              abort_message='Nudging: error -> no SP variable in file ps.nc'
    16761771              CALL abort_gcm(modname,abort_message,1)
    16771772             ENDIF
    1678              print*,'ncidps,varidps',ncidps,varidps
     1773             write(*,*),trim(modname)//' ncidps,varidps',ncidps,varidps
    16791774         endif
    16801775! Coordonnee verticale
    … …  
    16821777              rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
    16831778              IF (rcode.NE.0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
    1684               print*,'ncidpl,varidpl',ncidpl,varidpl
     1779              write(*,*),trim(modname)//' ncidpl,varidpl',ncidpl,varidpl
    16851780         endif
    16861781! Coefs ap, bp pour calcul de la pression aux differents niveaux
    … …  
    18271922    IMPLICIT NONE
    18281923
    1829 #include "netcdf.inc"
    1830 #include "dimensions.h"
    1831 #include "paramet.h"
     1924    include "netcdf.inc"
     1925    include "dimensions.h"
     1926    include "paramet.h"
    18321927
    18331928    INTEGER, INTENT(IN)   :: timestep
    … …  
    18541949    if (first) then
    18551950         ncidpl=-99
    1856          print*,'Guide: ouverture des fichiers guidage '
     1951         write(*,*)trim(modname)//' : opening nudging files '
    18571952! Ap et Bp si niveaux de pression hybrides
    18581953         if (guide_plevs.EQ.1) then
    1859              print *,'Lecture du guidage sur niveaux mod�le'
    1860              rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
    1861              IF (rcode.NE.NF_NOERR) THEN
    1862               print *,'Guide: probleme -> pas de fichier apbp.nc'
    1863               CALL abort_gcm(modname,abort_message,1)
    1864              ENDIF
    1865              rcode = nf90_inq_varid(ncidpl, 'AP', varidap)
    1866              IF (rcode.NE.NF_NOERR) THEN
    1867               print *,'Guide: probleme -> pas de variable AP, fichier apbp.nc'
    1868               CALL abort_gcm(modname,abort_message,1)
    1869              ENDIF
    1870              rcode = nf90_inq_varid(ncidpl, 'BP', varidbp)
    1871              IF (rcode.NE.NF_NOERR) THEN
    1872               print *,'Guide: probleme -> pas de variable BP, fichier apbp.nc'
    1873               CALL abort_gcm(modname,abort_message,1)
    1874              ENDIF
    1875              print*,'ncidpl,varidap',ncidpl,varidap
     1954           write(*,*)trim(modname)//' Reading nudging on model levels'
     1955           rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
     1956           IF (rcode.NE.NF_NOERR) THEN
     1957             abort_message='Nudging: error -> no file apbp.nc'
     1958           CALL abort_gcm(modname,abort_message,1)
     1959           ENDIF
     1960           rcode = nf90_inq_varid(ncidpl, 'AP', varidap)
     1961           IF (rcode.NE.NF_NOERR) THEN
     1962             abort_message='Nudging: error -> no AP variable in file apbp.nc'
     1963           CALL abort_gcm(modname,abort_message,1)
     1964           ENDIF
     1965           rcode = nf90_inq_varid(ncidpl, 'BP', varidbp)
     1966           IF (rcode.NE.NF_NOERR) THEN
     1967             abort_message='Nudging: error -> no BP variable in file apbp.nc'
     1968             CALL abort_gcm(modname,abort_message,1)
     1969           ENDIF
     1970           write(*,*)trim(modname)//'ncidpl,varidap',ncidpl,varidap
    18761971         endif
    18771972! Pression
    18781973         if (guide_plevs.EQ.2) then
    1879              rcode = nf90_open('P.nc', nf90_nowrite, ncidp)
    1880              IF (rcode.NE.NF_NOERR) THEN
    1881               print *,'Guide: probleme -> pas de fichier P.nc'
    1882               CALL abort_gcm(modname,abort_message,1)
    1883              ENDIF
    1884              rcode = nf90_inq_varid(ncidp, 'PRES', varidp)
    1885              IF (rcode.NE.NF_NOERR) THEN
    1886               print *,'Guide: probleme -> pas de variable PRES, fichier P.nc'
    1887               CALL abort_gcm(modname,abort_message,1)
    1888              ENDIF
    1889              print*,'ncidp,varidp',ncidp,varidp
    1890              if (ncidpl.eq.-99) ncidpl=ncidp
     1974           rcode = nf90_open('P.nc', nf90_nowrite, ncidp)
     1975           IF (rcode.NE.NF_NOERR) THEN
     1976             abort_message='Nudging: error -> no file P.nc'
     1977             CALL abort_gcm(modname,abort_message,1)
     1978           ENDIF
     1979           rcode = nf90_inq_varid(ncidp, 'PRES', varidp)
     1980           IF (rcode.NE.NF_NOERR) THEN
     1981             abort_message='Nudging: error -> no PRES variable in file P.nc'
     1982             CALL abort_gcm(modname,abort_message,1)
     1983           ENDIF
     1984           write(*,*)trim(modname)//' ncidp,varidp',ncidp,varidp
     1985           if (ncidpl.eq.-99) ncidpl=ncidp
    18911986         endif
    18921987! Vent zonal
    18931988         if (guide_u) then
    1894              rcode = nf90_open('u.nc', nf90_nowrite, ncidu)
    1895              IF (rcode.NE.NF_NOERR) THEN
    1896               print *,'Guide: probleme -> pas de fichier u.nc'
    1897               CALL abort_gcm(modname,abort_message,1)
    1898              ENDIF
    1899              rcode = nf90_inq_varid(ncidu, 'UWND', varidu)
    1900              IF (rcode.NE.NF_NOERR) THEN
    1901               print *,'Guide: probleme -> pas de variable UWND, fichier u.nc'
    1902               CALL abort_gcm(modname,abort_message,1)
    1903              ENDIF
    1904              print*,'ncidu,varidu',ncidu,varidu
    1905              if (ncidpl.eq.-99) ncidpl=ncidu
     1989           rcode = nf90_open('u.nc', nf90_nowrite, ncidu)
     1990           IF (rcode.NE.NF_NOERR) THEN
     1991             abort_message='Nudging: error -> no file u.nc'
     1992             CALL abort_gcm(modname,abort_message,1)
     1993           ENDIF
     1994           rcode = nf90_inq_varid(ncidu, 'UWND', varidu)
     1995           IF (rcode.NE.NF_NOERR) THEN
     1996             abort_message='Nudging: error -> no UWND variable in file u.nc'
     1997             CALL abort_gcm(modname,abort_message,1)
     1998           ENDIF
     1999           write(*,*)trim(modname)//' ncidu,varidu',ncidu,varidu
     2000           if (ncidpl.eq.-99) ncidpl=ncidu
    19062001         endif
    19072002
    19082003! Vent meridien
    19092004         if (guide_v) then
    1910              rcode = nf90_open('v.nc', nf90_nowrite, ncidv)
    1911              IF (rcode.NE.NF_NOERR) THEN
    1912               print *,'Guide: probleme -> pas de fichier v.nc'
    1913               CALL abort_gcm(modname,abort_message,1)
    1914              ENDIF
    1915              rcode = nf90_inq_varid(ncidv, 'VWND', varidv)
    1916              IF (rcode.NE.NF_NOERR) THEN
    1917               print *,'Guide: probleme -> pas de variable VWND, fichier v.nc'
    1918               CALL abort_gcm(modname,abort_message,1)
    1919              ENDIF
    1920              print*,'ncidv,varidv',ncidv,varidv
    1921              if (ncidpl.eq.-99) ncidpl=ncidv
    1922          endif
     2005           rcode = nf90_open('v.nc', nf90_nowrite, ncidv)
     2006           IF (rcode.NE.NF_NOERR) THEN
     2007             abort_message='Nudging: error -> no file v.nc'
     2008             CALL abort_gcm(modname,abort_message,1)
     2009           ENDIF
     2010           rcode = nf90_inq_varid(ncidv, 'VWND', varidv)
     2011           IF (rcode.NE.NF_NOERR) THEN
     2012             abort_message='Nudging: error -> no VWND variable in file v.nc'
     2013             CALL abort_gcm(modname,abort_message,1)
     2014           ENDIF
     2015           write(*,*)trim(modname)//' ncidv,varidv',ncidv,varidv
     2016           if (ncidpl.eq.-99) ncidpl=ncidv
     2017        endif
    19232018! Temperature
    19242019         if (guide_T) then
    1925              rcode = nf90_open('T.nc', nf90_nowrite, ncidt)
    1926              IF (rcode.NE.NF_NOERR) THEN
    1927               print *,'Guide: probleme -> pas de fichier T.nc'
    1928               CALL abort_gcm(modname,abort_message,1)
    1929              ENDIF
    1930              rcode = nf90_inq_varid(ncidt, 'AIR', varidt)
    1931              IF (rcode.NE.NF_NOERR) THEN
    1932               print *,'Guide: probleme -> pas de variable AIR, fichier T.nc'
    1933               CALL abort_gcm(modname,abort_message,1)
    1934              ENDIF
    1935              print*,'ncidT,varidT',ncidt,varidt
    1936              if (ncidpl.eq.-99) ncidpl=ncidt
     2020           rcode = nf90_open('T.nc', nf90_nowrite, ncidt)
     2021           IF (rcode.NE.NF_NOERR) THEN
     2022             abort_message='Nudging: error -> no file T.nc'
     2023             CALL abort_gcm(modname,abort_message,1)
     2024           ENDIF
     2025           rcode = nf90_inq_varid(ncidt, 'AIR', varidt)
     2026           IF (rcode.NE.NF_NOERR) THEN
     2027             abort_message='Nudging: error -> no AIR variable in file T.nc'
     2028             CALL abort_gcm(modname,abort_message,1)
     2029           ENDIF
     2030           write(*,*)trim(modname)//' ncidT,varidT',ncidt,varidt
     2031           if (ncidpl.eq.-99) ncidpl=ncidt
    19372032         endif
    19382033! Humidite
    19392034         if (guide_Q) then
    1940              rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ)
    1941              IF (rcode.NE.NF_NOERR) THEN
    1942               print *,'Guide: probleme -> pas de fichier hur.nc'
    1943               CALL abort_gcm(modname,abort_message,1)
    1944              ENDIF
    1945              rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)
    1946              IF (rcode.NE.NF_NOERR) THEN
    1947               print *,'Guide: probleme -> pas de variable RH, fichier hur.nc'
    1948               CALL abort_gcm(modname,abort_message,1)
    1949              ENDIF
    1950              print*,'ncidQ,varidQ',ncidQ,varidQ
    1951              if (ncidpl.eq.-99) ncidpl=ncidQ
     2035           rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ)
     2036           IF (rcode.NE.NF_NOERR) THEN
     2037             abort_message='Nudging: error -> no file hur.nc'
     2038             CALL abort_gcm(modname,abort_message,1)
     2039           ENDIF
     2040           rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)
     2041           IF (rcode.NE.NF_NOERR) THEN
     2042             abort_message='Nudging: error -> no RH,variable in file hur.nc'
     2043             CALL abort_gcm(modname,abort_message,1)
     2044           ENDIF
     2045           write(*,*)trim(modname)//' ncidQ,varidQ',ncidQ,varidQ
     2046           if (ncidpl.eq.-99) ncidpl=ncidQ
    19522047         endif
    19532048! Pression de surface
    19542049         if ((guide_P).OR.(guide_plevs.EQ.1)) then
    1955              rcode = nf90_open('ps.nc', nf90_nowrite, ncidps)
    1956              IF (rcode.NE.NF_NOERR) THEN
    1957               print *,'Guide: probleme -> pas de fichier ps.nc'
    1958               CALL abort_gcm(modname,abort_message,1)
    1959              ENDIF
    1960              rcode = nf90_inq_varid(ncidps, 'SP', varidps)
    1961              IF (rcode.NE.NF_NOERR) THEN
    1962               print *,'Guide: probleme -> pas de variable SP, fichier ps.nc'
    1963               CALL abort_gcm(modname,abort_message,1)
    1964              ENDIF
    1965              print*,'ncidps,varidps',ncidps,varidps
     2050           rcode = nf90_open('ps.nc', nf90_nowrite, ncidps)
     2051           IF (rcode.NE.NF_NOERR) THEN
     2052             abort_message='Nudging: error -> no file ps.nc'
     2053             CALL abort_gcm(modname,abort_message,1)
     2054           ENDIF
     2055           rcode = nf90_inq_varid(ncidps, 'SP', varidps)
     2056           IF (rcode.NE.NF_NOERR) THEN
     2057             abort_message='Nudging: error -> no SP variable in file ps.nc'
     2058             CALL abort_gcm(modname,abort_message,1)
     2059           ENDIF
     2060           write(*,*)trim(modname)//' ncidps,varidps',ncidps,varidps
    19662061         endif
    19672062! Coordonnee verticale
    19682063         if (guide_plevs.EQ.0) then
    1969               rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
    1970               IF (rcode.NE.0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
    1971               print*,'ncidpl,varidpl',ncidpl,varidpl
     2064           rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
     2065           IF (rcode.NE.0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
     2066           write(*,*)trim(modname)//' ncidpl,varidpl',ncidpl,varidpl
    19722067         endif
    19732068! Coefs ap, bp pour calcul de la pression aux differents niveaux
    … …  
    21632258    REAL zu(ip1jmp1),zv(ip1jm), zt(iip1, jjp1), zq(iip1, jjp1)
    21642259    REAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: field_glo
     2260    CHARACTER(LEN=20),PARAMETER :: modname="guide_out"
    21652261   
    21662262!$OMP MASTER
    … …  
    21692265!$OMP BARRIER
    21702266
    2171     print*,'gvide_out apres allocation ',hsize,vsize
     2267!    write(*,*)trim(modname)//' after allocation ',hsize,vsize
    21722268
    21732269    IF (hsize==jjp1) THEN
    … …  
    21772273    ENDIF
    21782274
    2179     print*,'guide_out apres gather '
     2275!    write(*,*)trim(modname)//' after gather '
    21802276    CALL Gather_field_u(alpha_u,zu,1)
    21812277    CALL Gather_field_u(alpha_t,zt,1)
    … …  
    23472443!$OMP BARRIER
    23482444
    2349     RETURN
    2350 
    23512445  END SUBROUTINE guide_out
    23522446   

  • LMDZ6/branches/Ocean_skin/libf/dyn3dmem/iniacademic_loc.F90

    r3605 r4013  
    7373  LOGICAL ok_geost             ! Initialisation vent geost. ou nul
    7474  LOGICAL ok_pv                ! Polar Vortex
    75   REAL phi_pv,dphi_pv,gam_pv   ! Constantes pour polar vortex
     75  REAL phi_pv,dphi_pv,gam_pv,tetanoise   ! Constantes pour polar vortex
    7676
    7777  real zz,ran1
    … …  
    122122  CALL inigeom
    123123  CALL inifilr
     124
     125  ! Initialize pressure and mass field if read_start=.false.
     126  IF (.NOT. read_start) THEN
     127    ! allocate global fields:
     128!    allocate(vcov_glo(ip1jm,llm))
     129    allocate(ucov_glo(ip1jmp1,llm))
     130    allocate(teta_glo(ip1jmp1,llm))
     131    allocate(ps_glo(ip1jmp1))
     132    allocate(masse_glo(ip1jmp1,llm))
     133    allocate(phis_glo(ip1jmp1))
     134
     135     ! surface pressure
     136     if (iflag_phys>2) then
     137        ! specific value for CMIP5 aqua/terra planets
     138        ! "Specify the initial dry mass to be equivalent to
     139        !  a global mean surface pressure (101325 minus 245) Pa."
     140        ps_glo(:)=101080. 
     141     else
     142        ! use reference surface pressure
     143        ps_glo(:)=preff
     144     endif
     145     
     146     ! ground geopotential
     147     phis_glo(:)=0.
     148
     149     CALL pression ( ip1jmp1, ap, bp, ps_glo, p       )
     150     if (pressure_exner) then
     151       CALL exner_hyb( ip1jmp1, ps_glo, p, pks, pk )
     152     else
     153       call exner_milieu(ip1jmp1,ps_glo,p,pks,pk)
     154     endif
     155     CALL massdair(p,masse_glo)
     156  ENDIF
     157
    124158
    125159  if (llm == 1) then
    … …  
    172206     gam_pv=4.              ! -dT/dz vortex (in K/km)
    173207     CALL getin('gam_pv',gam_pv)
     208     tetanoise=0.005
     209     CALL getin('tetanoise',tetanoise)
    174210
    175211     ! 2. Initialize fields towards which to relax
    … …  
    224260     ! 3. Initialize fields (if necessary)
    225261     IF (.NOT. read_start) THEN
    226        ! allocate global fields:
    227 !       allocate(vcov_glo(ip1jm,llm))
    228        allocate(ucov_glo(ip1jmp1,llm))
    229        allocate(teta_glo(ip1jmp1,llm))
    230        allocate(ps_glo(ip1jmp1))
    231        allocate(masse_glo(ip1jmp1,llm))
    232        allocate(phis_glo(ip1jmp1))
    233 
    234         ! surface pressure
    235         if (iflag_phys>2) then
    236            ! specific value for CMIP5 aqua/terra planets
    237            ! "Specify the initial dry mass to be equivalent to
    238            !  a global mean surface pressure (101325 minus 245) Pa."
    239            ps_glo(:)=101080. 
    240         else
    241            ! use reference surface pressure
    242            ps_glo(:)=preff
    243         endif
    244        
    245         ! ground geopotential
    246         phis_glo(:)=0.
    247 
    248         CALL pression ( ip1jmp1, ap, bp, ps_glo, p       )
    249         if (pressure_exner) then
    250           CALL exner_hyb( ip1jmp1, ps_glo, p, pks, pk )
    251         else
    252           call exner_milieu(ip1jmp1,ps_glo,p,pks,pk)
    253         endif
    254         CALL massdair(p,masse_glo)
    255 
    256262        ! bulk initialization of temperature
    257         teta_glo(:,:)=tetarappel(:,:)
    258 
     263        IF (iflag_phys>10000) THEN
     264        ! Particular case to impose a constant temperature T0=0.01*iflag_phys
     265           teta_glo(:,:)= 0.01*iflag_phys/(pk(:,:)/cpp)
     266        ELSE
     267           teta_glo(:,:)=tetarappel(:,:)
     268        ENDIF
    259269        ! geopotential
    260270        CALL geopot(ip1jmp1,teta_glo,pk,pks,phis_glo,phi)
    … …  
    306316        do l=1,llm
    307317           do ij=iip2,ip1jm
    308               teta_glo(ij,l)=teta_glo(ij,l)*(1.+0.005*ran1(idum))
     318              teta_glo(ij,l)=teta_glo(ij,l)*(1.+tetanoise*ran1(idum))
    309319           enddo
    310320        enddo

  • LMDZ6/branches/Ocean_skin/libf/dyn3dmem/leapfrog_loc.F

    r3798 r4013  
    15381538c$OMP END MASTER
    15391539
     1540         if (ok_guide) then
     1541           ! set ok_guide to false to avoid extra output
     1542           ! in following forward step
     1543           ok_guide=.false.
     1544         endif
     1545
    15401546#ifdef INCA
    1541          if (type_trac == 'inca') then
     1547         if (type_trac == 'inca' .OR. type_trac == 'inco') then
    15421548            call finalize_inca
    15431549         endif
    … …  
    15941600
    15951601#ifdef INCA
    1596               if (type_trac == 'inca') then
     1602              if (type_trac == 'inca' .OR. type_trac == 'inco') then
    15971603                 call finalize_inca
    15981604              endif
    … …  
    16811687     &                           vcov,ucov,teta,q,masse,ps)
    16821688!              endif ! of if (planet_type.eq."earth")
     1689                if (ok_guide) then
     1690                  ! set ok_guide to false to avoid extra output
     1691                  ! in following forward step
     1692                  ok_guide=.false.
     1693                endif
    16831694
    16841695!              CLOSE(99)
    … …  
    17501761
    17511762#ifdef INCA
    1752                  if (type_trac == 'inca') then
     1763                 if (type_trac == 'inca' .OR. type_trac == 'inco') then
    17531764                    call finalize_inca
    17541765                 endif
    … …  
    18271838     .                               vcov,ucov,teta,q,masse,ps)
    18281839!               endif ! of if (planet_type.eq."earth")
     1840                if (ok_guide) then
     1841                  ! set ok_guide to false to avoid extra output
     1842                  ! in following forward step
     1843                  ok_guide=.false.
     1844                endif
     1845
    18291846              ENDIF ! of IF(itau.EQ.itaufin)
    18301847
    … …  
    18451862
    18461863#ifdef INCA
    1847       if (type_trac == 'inca') then
     1864      if (type_trac == 'inca' .OR. type_trac == 'inco') then
    18481865         call finalize_inca
    18491866      endif

  • LMDZ6/branches/Ocean_skin/libf/dyn3dmem/parallel_lmdz.F90

    r2771 r4013  
    1212    INTEGER,PARAMETER :: halo_max=3
    1313   
    14     LOGICAL,SAVE :: using_mpi
    15     LOGICAL,SAVE :: using_omp
     14    LOGICAL,SAVE :: using_mpi ! .true. if using MPI
     15    LOGICAL,SAVE :: using_omp ! .true. if using OpenMP
     16    LOGICAL,SAVE :: is_master ! .true. if the core is both MPI & OpenMP master
     17!$OMP THREADPRIVATE(is_master)
    1618   
    1719    integer, save :: mpi_size
    … …  
    248250!$OMP END PARALLEL         
    249251      CALL create_distrib(jj_nb_para,current_dist)
     252     
     253      IF ((mpi_rank==0).and.(omp_rank==0)) THEN
     254        is_master=.true.
     255      ELSE
     256        is_master=.false.
     257      ENDIF
    250258     
    251259    end subroutine init_parallel

  • LMDZ6/branches/Ocean_skin/libf/dynphy_lonlat/inigeomphy_mod.F90

    r3605 r4013  
    9393  ALLOCATE(boundslat_reg(jjm+1,2))
    9494 
    95   DO i=1,iim
    96    boundslon_reg(i,east)=rlonu(i+1)
    97    boundslon_reg(i,west)=rlonu(i)
     95  ! specific handling of the -180 longitude scalar grid point boundaries
     96  boundslon_reg(1,east)=rlonu(1)
     97  boundslon_reg(1,west)=rlonu(iim)-2*PI
     98  DO i=2,iim
     99   boundslon_reg(i,east)=rlonu(i)
     100   boundslon_reg(i,west)=rlonu(i-1)
    98101  ENDDO
    99102
    … …  
    124127    cufi_glo(1) = cu(1)
    125128    cvfi_glo(1) = cv(1)
    126     boundslonfi_glo(1,north_east)=0
     129    boundslonfi_glo(1,north_east)=PI
    127130    boundslatfi_glo(1,north_east)=PI/2
    128     boundslonfi_glo(1,north_west)=2*PI
     131    boundslonfi_glo(1,north_west)=-PI
    129132    boundslatfi_glo(1,north_west)=PI/2
    130     boundslonfi_glo(1,south_west)=2*PI
     133    boundslonfi_glo(1,south_west)=-PI
    131134    boundslatfi_glo(1,south_west)=rlatv(1)
    132     boundslonfi_glo(1,south_east)=0
     135    boundslonfi_glo(1,south_east)=PI
    133136    boundslatfi_glo(1,south_east)=rlatv(1)
    134137    DO j=2,jjm
    … …  
    141144        boundslonfi_glo(k,north_east)=rlonu(i)
    142145        boundslatfi_glo(k,north_east)=rlatv(j-1)
    143         boundslonfi_glo(k,north_west)=rlonu(i+1)
     146        if (i.eq.1) then
     147          ! special case for the first longitude's west bound
     148          boundslonfi_glo(k,north_west)=rlonu(iim)-2*PI
     149          boundslonfi_glo(k,south_west)=rlonu(iim)-2*PI
     150        else
     151          boundslonfi_glo(k,north_west)=rlonu(i-1)
     152          boundslonfi_glo(k,south_west)=rlonu(i-1)
     153        endif
    144154        boundslatfi_glo(k,north_west)=rlatv(j-1)
    145         boundslonfi_glo(k,south_west)=rlonu(i+1)
    146155        boundslatfi_glo(k,south_west)=rlatv(j)
    147156        boundslonfi_glo(k,south_east)=rlonu(i)
    … …  
    154163    cufi_glo(klon_glo) = cu((iim+1)*jjm+1)
    155164    cvfi_glo(klon_glo) = cv((iim+1)*jjm-iim)
    156     boundslonfi_glo(klon_glo,north_east)= 0
     165    boundslonfi_glo(klon_glo,north_east)= PI
    157166    boundslatfi_glo(klon_glo,north_east)= rlatv(jjm)
    158     boundslonfi_glo(klon_glo,north_west)= 2*PI
     167    boundslonfi_glo(klon_glo,north_west)= -PI
    159168    boundslatfi_glo(klon_glo,north_west)= rlatv(jjm)
    160     boundslonfi_glo(klon_glo,south_west)= 2*PI
     169    boundslonfi_glo(klon_glo,south_west)= -PI
    161170    boundslatfi_glo(klon_glo,south_west)= -PI/2
    162     boundslonfi_glo(klon_glo,south_east)= 0
     171    boundslonfi_glo(klon_glo,south_east)= PI
    163172    boundslatfi_glo(klon_glo,south_east)= -Pi/2
    164173

  • LMDZ6/branches/Ocean_skin/libf/dynphy_lonlat/phylmd/etat0phys_netcdf.F90

    r3798 r4013  
    119119  INTEGER :: flag_aerosol
    120120  INTEGER :: flag_aerosol_strat
     121  INTEGER :: flag_volc_surfstrat
    121122  LOGICAL :: flag_aer_feedback
    122123  LOGICAL :: flag_bc_internal_mixture
    … …  
    138139                   iflag_cldcon,                                        &
    139140                   iflag_ratqs,ratqsbas,ratqshaut,tau_ratqs,            &
    140                    ok_ade, ok_aie, ok_alw, ok_cdnc, ok_volcan,          &
    141                    aerosol_couple,                                      &
    142                    chemistry_couple, flag_aerosol, flag_aerosol_strat,  &
    143                    flag_aer_feedback,                                   &
    144                    flag_bc_internal_mixture, bl95_b0, bl95_b1, &
     141                   ok_ade, ok_aie, ok_alw, ok_cdnc, ok_volcan, flag_volc_surfstrat,     &
     142                   aerosol_couple, chemistry_couple, flag_aerosol, flag_aerosol_strat,  &
     143                   flag_aer_feedback, flag_bc_internal_mixture, bl95_b0, bl95_b1,       &
    145144                   read_climoz, alp_offset)
    146145  CALL phys_state_var_init(read_climoz)
    … …  
    240239 
    241240  z0m(:,is_oce) = rugmer(:)
    242   z0m(:,is_ter) = MAX(1.0e-05,zstd(:)*zsig(:)/2.0)
    243   z0m(:,is_lic) = MAX(1.0e-05,zstd(:)*zsig(:)/2.0)
     241  z0m(:,is_ter) = 0.01 !MAX(1.0e-05,zstd(:)*zsig(:)/2.0)
     242  z0m(:,is_lic) = 0.001 !MAX(1.0e-05,zstd(:)*zsig(:)/2.0)
    244243  z0m(:,is_sic) = 0.001
    245244  z0h(:,:)=z0m(:,:)

  • LMDZ6/branches/Ocean_skin/libf/dynphy_lonlat/phylmd/iniphysiq_mod.F90

    r3798 r4013  
    1616  USE mod_phys_lmdz_para, ONLY: klon_omp ! number of columns (on local omp grid)
    1717  USE vertical_layers_mod, ONLY : init_vertical_layers
    18   USE infotrac, ONLY: nqtot,nqo,nbtr,tname,ttext,type_trac,&
     18  USE infotrac, ONLY: nqtot,nqo,nbtr,nqCO2,tname,ttext,type_trac,&
    1919                      niadv,conv_flg,pbl_flg,solsym,&
    2020                      nqfils,nqdesc,nqdesc_tot,iqfils,iqpere,&
    … …  
    2424                      iso_indnum,zone_num,phase_num,&
    2525                      indnum_fn_num,index_trac,&
    26                       niso,ntraceurs_zone,ntraciso
     26                      niso,ntraceurs_zone,ntraciso,nqtottr,itr_indice
    2727#ifdef CPP_StratAer
    2828  USE infotrac, ONLY: nbtr_bin, nbtr_sulgas, id_OCS_strat, &
    … …  
    146146
    147147  ! Initialize tracer names, numbers, etc. for physics
    148   CALL init_infotrac_phy(nqtot,nqo,nbtr,tname,ttext,type_trac,&
     148  CALL init_infotrac_phy(nqtot,nqo,nbtr,nqtottr,nqCO2,tname,ttext,type_trac,&
    149149                         niadv,conv_flg,pbl_flg,solsym,&
    150150                         nqfils,nqdesc,nqdesc_tot,iqfils,iqpere,&
    … …  
    154154                         iso_indnum,zone_num,phase_num,&
    155155                         indnum_fn_num,index_trac,&
    156                          niso,ntraceurs_zone,ntraciso&
     156                         niso,ntraceurs_zone,ntraciso,itr_indice &
    157157#ifdef CPP_StratAer
    158158                         ,nbtr_bin,nbtr_sulgas&
    … …  
    172172!$OMP END PARALLEL
    173173
    174   IF (type_trac == 'inca') THEN
     174  IF (type_trac == 'inca' .OR. type_trac == 'inco') THEN
    175175#ifdef INCA
    176176     call init_const_lmdz( &
    … …  
    198198  END IF
    199199
    200   IF (type_trac == 'inca') THEN
     200  IF (type_trac == 'inca' .OR. type_trac == 'inco') THEN
    201201#ifdef INCA
    202202     CALL init_inca_dim(klon_omp,nbp_lev,nbp_lon,nbp_lat - 1, &

  • LMDZ6/branches/Ocean_skin/libf/phy_common/print_control_mod.F90

    r3605 r4013  
    55  INTEGER,SAVE :: prt_level ! debug output level
    66  LOGICAL,SAVE :: debug ! flag to specify if in "debug mode"
    7 !$OMP THREADPRIVATE(lunout,prt_level,debug)
     7  LOGICAL,SAVE :: alert_first_call = .TRUE. ! for printing alerts on first call to routine only           
     8  LOGICAL,SAVE :: call_alert ! (combination of is_master and alert_first_call for easier use     
     9!$OMP THREADPRIVATE(lunout,prt_level,debug, alert_first_call, call_alert)
    810
    911  ! NB: Module variable Initializations done by set_print_control
    … …  
    1517  SUBROUTINE set_print_control(lunout_,prt_level_,debug_)
    1618  IMPLICIT NONE
    17     INTEGER :: lunout_
    18     INTEGER :: prt_level_
    19     LOGICAL :: debug_
     19    INTEGER, INTENT(IN) :: lunout_
     20    INTEGER, INTENT(IN) :: prt_level_
     21    LOGICAL, INTENT(IN) :: debug_
    2022     
    2123    lunout = lunout_
    … …  
    2527  END SUBROUTINE set_print_control
    2628
     29  SUBROUTINE prt_alerte(message, modname, niv_alerte)
     30    ! Function to print different values of alarms when first encountered
     31    ! Meant for informative purposee
     32    IMPLICIT NONE
     33    ! Arguments:
     34    ! message: message to print out
     35    ! modname: module/routine name
     36    ! niv_alerte: alert level (0/1/2)
     37    CHARACTER(LEN=*), INTENT(IN) :: modname
     38    CHARACTER(LEN=*) :: message
     39    INTEGER :: niv_alerte
     40    ! local variables
     41    CHARACTER(LEN=7), DIMENSION(0:2) :: alarm_color = (/ 'VERTE  ','ORANGE ','ROUGE  ' /)
     42    CHARACTER(LEN=7) :: alarm_couleur
     43    INTEGER :: alarm_file=15 ! in case we want/need to print out the special alarms in a separate file     
     44
     45    IF ( alert_first_call) then
     46       IF ( alarm_file .ne. lunout ) THEN
     47          OPEN(unit = alarm_file, file = "ALERTES.txt")
     48       ENDIF
     49    ENDIF
     50
     51    alarm_couleur = alarm_color(niv_alerte)
     52    IF (niv_alerte < 0 .OR. niv_alerte > 3) then
     53       message = 'NIVEAU ALERTE INVALIDE  '//message
     54       alarm_couleur='NOIRE  '
     55    ENDIF
     56
     57    WRITE(alarm_file, *)' ALERTE ',alarm_couleur, trim(modname),  trim(message)
     58   
     59  END SUBROUTINE prt_alerte
     60
     61 
    2762END MODULE print_control_mod

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

    r3811 r4013  
    695695
    696696  ALLOCATE(  tsol(klon)              )
     697
     698!AS: IF permettant le debranchage des coefs de Jeronimo Escribano: fichiers *_meta
     699! nbreg_* sont initialisés à 1 dans phytracr_spl, if debutphy,
     700! avant d'appeler la subroutine presente, phytracr_spl_ini
     701! (phytracr_spl_ini appele readregionsdims2_spl,
     702! qui lit et fait "bcast" de nbreg_ind,_bb,_dust,_wstardust dans fichiers regions_*_meta)
     703IF("ASSIM"=="YES") THEN
    697704  fileregionsdimsind='regions_ind_meta'
    698705  fileregionsdimsdust='regions_dustacc_meta'
    … …  
    704711  call  readregionsdims2_spl(nbreg_bb,fileregionsdimsbb)
    705712  call  readregionsdims2_spl(nbreg_wstardust,fileregionsdimswstar)
     713  ENDIF ! ASSIM
     714! fin debranchage
    706715
    707716!readregions_spl()
    … …  
    748757
    749758  !temporal hardcoded null inicialization of assimilation emmision factors
     759!AS: scale_param sont ensuite lus dans modvalues.nc
     760! par la subroutine read_scalenc, appelee par readscaleparamsnc_spl
    750761  scale_param_ssacc=1.
    751762  scale_param_sscoa=1.
    … …  
    758769  param_wstarBLperregion(:)=0.
    759770  param_wstarWAKEperregion(:)=0.
    760 
    761771
    762772
    … …  
    926936      INTEGER :: aux_mask1
    927937      INTEGER :: aux_mask2
    928       INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: iregion_so4 !Defines regions for SO4
     938      INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: iregion_so4 !Defines regions for SO4 ; AS: PAS UTILISE!
    929939      INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: iregion_ind  !Defines regions for SO2, BC & OM
    930940      INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: iregion_bb   !Defines regions for SO2, BC & OM
    … …  
    12391249      if (debutphy) then
    12401250#ifdef IOPHYS_DUST
    1241          CALL iophys_ini
     1251         CALL iophys_ini(pdtphys)
    12421252#endif
    12431253         nbreg_ind=1
    … …  
    12771287
    12781288  filescaleparams='modvalues.nc'
    1279   CALL readscaleparamsnc_spl(scale_param_ind,                        &
     1289!AS: debranchage de lecture des coefs d'assmilation de Jeronimo Escribano
     1290  IF("ASSIM"=="YES") THEN
     1291    CALL readscaleparamsnc_spl(scale_param_ind,                        &
    12801292        nbreg_ind, paramname_ind,                                    &
    12811293        scale_param_ff, nbreg_ind,paramname_ff,                      &
    … …  
    12891301        scale_param_sscoa  ,  paramname_sscoa,                    &
    12901302           filescaleparams,ijulday,jH_cur, pdtphys,debutphy)
    1291 ! add seasalt
     1303  ENDIF ! ASSIM
     1304!AS: le commentaire suivant "add seasalt" ne semble pas avoir ete mis en pratique.
     1305! Des fichiers regions_ssacc et _sscoa existent mais ne semblent pas lus.
     1306! Ca reste donc aux valeurs initialisées: nbreg_ss=1, scale_param_ss*=1, cf fichiers ss et modvalues
     1307!! add seasalt
    12921308
    12931309  print *,'JE : check scale_params'
    … …  
    18531869
    18541870
    1855 
    1856        IF (debutphy) then
    1857 
     1871      IF (debutphy) then
     1872
     1873! AS: initialisation des indices par point de grille physique iregion_*
     1874! (variables tenant de l'assimilation, a eliminer dans un 2eme temps)
     1875       iregion_dust(:)=1
     1876       iregion_ind(:)=1
     1877       iregion_bb(:)=1
     1878       iregion_wstardust(:)=1
     1879
     1880!AS: lecture des indices dans fichiers "regions_*" eliminee par IF("ASSIM"="YES") (faux donc)
     1881       IF("ASSIM"=="YES") THEN
    18581882      c_FullName1='regions_dustacc'
    18591883      !c_FullName1='regions_dust'
    … …  
    19431967!$OMP END MASTER
    19441968!$OMP BARRIER
     1969
     1970      ENDIF  ! ASSIM
    19451971
    19461972      ENDIF  ! debutphy
    … …  
    35653591!  SAVING AEROSOL RELATED VARIABLES INTO FILE
    35663592!======================================================================
    3567 !
    3568 !JE20141224      IF (ok_histrac) THEN
    35693593!
    35703594      ndex2d = 0
    … …  
    37023726         fluxss(i)=fluxssfine(i)+fluxsscoa(i)
    37033727      ENDDO
     3728
    37043729!      prepare outputs cvltr
    37053730

  • LMDZ6/branches/Ocean_skin/libf/phylmd/StratAer/strataer_mod.F90

    r3605 r4013  
    194194    USE mod_grid_phy_lmdz, ONLY: nbp_lat, nbp_lon
    195195    USE print_control_mod, ONLY : lunout
    196     USE YOMCST, ONLY : RPI
     196
     197    INCLUDE "YOMCST.h"  !--RPI
    197198
    198199    ! local var

  • LMDZ6/branches/Ocean_skin/libf/phylmd/acama_gwd_rando_m.F90

    r3605 r4013  
    138138    ENDIF
    139139    firstcall=.false.
    140 !    CALL iophys_ini
     140!    CALL iophys_ini(dtime)
    141141  ENDIF
    142142

  • LMDZ6/branches/Ocean_skin/libf/phylmd/calcratqs.F90

    r2534 r4013  
    22           iflag_ratqs,iflag_con,iflag_cld_th,pdtphys, &
    33           ratqsbas,ratqshaut,ratqsp0,ratqsdp, &
    4            tau_ratqs,fact_cldcon,   &
    5            ptconv,ptconvth,clwcon0th, rnebcon0th,      &
    6            paprs,pplay,q_seri,zqsat,fm_therm,          &
    7            ratqs,ratqsc)
     4           tau_ratqs,fact_cldcon,wake_s, wake_deltaq,   &
     5           ptconv,ptconvth,clwcon0th, rnebcon0th,       &
     6           paprs,pplay,t_seri,q_seri,                   &
     7           qtc_cv, sigt_cv, zqsat,             &
     8           tke,tke_dissip,lmix,wprime, &
     9           t2m,q2m,fm_therm, &
     10           ratqs,ratqsc,ratqs_inter)
     11
     12
     13USE indice_sol_mod
     14USE phys_state_var_mod, ONLY: pctsrf
     15USE calcratqs_multi_mod, ONLY: calcratqs_inter, calcratqs_oro, calcratqs_hetero, calcratqs_tke
    816
    917implicit none
    … …  
    2331real,intent(in) :: pdtphys,ratqsbas,ratqshaut,fact_cldcon,tau_ratqs
    2432real,intent(in) :: ratqsp0, ratqsdp
    25 real, dimension(klon,klev+1),intent(in) :: paprs
    26 real, dimension(klon,klev),intent(in) :: pplay,q_seri,zqsat,fm_therm
     33real, dimension(klon,klev+1),intent(in) :: paprs,tke,tke_dissip,lmix,wprime
     34real, dimension(klon,klev),intent(in) :: pplay,t_seri,q_seri,zqsat,fm_therm, qtc_cv, sigt_cv
    2735logical, dimension(klon,klev),intent(in) :: ptconv
    2836real, dimension(klon,klev),intent(in) :: rnebcon0th,clwcon0th
    29 
     37real, dimension(klon,klev),intent(in) :: wake_deltaq,wake_s
     38real, dimension(klon,nbsrf),intent(in) :: t2m,q2m
    3039! Output
    31 real, dimension(klon,klev),intent(inout) :: ratqs,ratqsc
     40real, dimension(klon,klev),intent(inout) :: ratqs,ratqsc,ratqs_inter
     41
    3242logical, dimension(klon,klev),intent(inout) :: ptconvth
    3343
    … …  
    3646real, dimension(klon,klev) :: ratqss
    3747real facteur,zfratqs1,zfratqs2
     48real, dimension(klon,klev) :: ratqs_hetero,ratqs_oro,ratqs_tke
     49
    3850
    3951!-------------------------------------------------------------------------
    … …  
    124136         enddo
    125137
    126       else if (iflag_ratqs==4) then
     138      else if (iflag_ratqs==4) then 
    127139         do k=1,klev
    128140           ratqss(:,k)=ratqsbas+0.5*(ratqshaut-ratqsbas) &
    … …  
    131143         enddo
    132144
     145       else if (iflag_ratqs .GT. 9) then
     146 
     147       ! interactive ratqs calculations that depend on cold pools, orography, surface heterogeneity and small-scale turbulence
     148       ! This should help getting a more realistic ratqs in the low and mid troposphere
     149       ! We however need a "background" ratqs to account for subgrid distribution of qt (or qt/qs)
     150       ! in the high troposphere
     151       
     152       ! background ratqs and initialisations
     153          do k=1,klev
     154             do i=1,klon
     155              ratqss(i,k)=ratqsbas+0.5*(ratqshaut-ratqsbas) &
     156              *( tanh( (ratqsp0-pplay(i,k))/ratqsdp) + 1.)
     157              ratqss(i,k)=max(ratqss(i,k),0.0)
     158
     159              ratqs_hetero(i,k)=0.
     160              ratqs_oro(i,k)=0.
     161              ratqs_tke(i,k)=0.
     162              ratqs_inter(i,k)=0
     163             enddo
     164          enddo
     165     
     166          if (iflag_ratqs .EQ. 10) then
     167             ! interactive ratqs in presence of cold pools     
     168             call calcratqs_inter(klon,klev,iflag_ratqs,pdtphys,ratqsbas,wake_deltaq,wake_s,q_seri,qtc_cv, sigt_cv,ratqs_inter)
     169             do k=1,klev
     170                do i=1,klon
     171                    ratqs_inter(i,k)=ratqs_inter(i,k)-0.5*ratqs_inter(i,k)*(tanh((ratqsp0-pplay(i,k))/ratqsdp)+1.)
     172                enddo
     173             enddo
     174             ratqss=ratqss+ratqs_inter
     175          else if (iflag_ratqs .EQ. 11) then
     176            ! interactive ratqs with several sources
     177            call calcratqs_inter(klon,klev,iflag_ratqs,pdtphys,ratqsbas,wake_deltaq,wake_s,q_seri,qtc_cv, sigt_cv,ratqs_inter)
     178             ratqss=ratqss+ratqs_inter
     179          else if (iflag_ratqs .EQ. 12) then
     180             ! contribution of surface heterogeneities to ratqs
     181             call calcratqs_hetero(klon,klev,t2m,q2m,t_seri,q_seri,pplay,paprs,ratqs_hetero)
     182             ratqss=ratqss+ratqs_hetero
     183          else if (iflag_ratqs .EQ. 13) then
     184             ! contribution of ubgrid orography to ratqs
     185             call calcratqs_oro(klon,klev,zqsat,t_seri,pplay,paprs,ratqs_oro)
     186             ratqss=ratqss+ratqs_oro
     187          else if (iflag_ratqs .EQ. 14) then
     188             ! effect of subgrid-scale TKE on ratqs (in development)
     189             call calcratqs_tke(klon,klev,pdtphys,t_seri,q_seri,zqsat,pplay,paprs,tke,tke_dissip,lmix,wprime,ratqs_tke)     
     190             ratqss=ratqss+ratqs_tke
     191          endif
     192         
     193     
    133194      endif
    134 
    135 
    136195
    137196

  • LMDZ6/branches/Ocean_skin/libf/phylmd/calcul_fluxs_mod.F90

    r3687 r4013  
    261261!
    262262! calcul de l'enthalpie des precipitations liquides et solides
    263 !
    264 !       if (PRESENT(enth_prec_liq))                   &
    265 !       enth_prec_liq(i) = rcw * (t1lay(i) - tsurf(i)) * &
    266 !                          precip_rain(i)
    267 !       if (PRESENT(enth_prec_sol))                  &
    268 !       enth_prec_sol(i) = rcs * (t1lay(i) - tsurf(i)) * &
    269 !                          precip_snow(i)
    270 ! On calcule par rapport a T=0
    271263       if (PRESENT(sens_prec_liq)) sens_prec_liq(i) &
    272264            = - sens_heat_rain(precip_rain(i) + precip_snow(i), t1lay(i), &
    273265            q1lay(i), rhoa(i), rlvtt, tsurf_new(i), ps(i))
    274266       if (PRESENT(sens_prec_sol)) sens_prec_sol(i) = 0.
     267       ! On calcule par rapport a T=0
     268       !! sens_prec_liq(i) = rcw * (t1lay(i) - RTT) * precip_rain(i)
     269       !! sens_prec_sol(i) = rcs * (t1lay(i) - RTT) * precip_snow(i)
     270
    275271       if (PRESENT(lat_prec_liq))                    &
    276272         lat_prec_liq(i) =  precip_rain(i) * (RLVTT - RLVTT)

  • LMDZ6/branches/Ocean_skin/libf/phylmd/carbon_cycle_mod.F90

    r3798 r4013  
    3939  LOGICAL, PUBLIC :: carbon_cycle_tr        ! 3D transport of CO2 in the atmosphere, parameter read in conf_phys
    4040!$OMP THREADPRIVATE(carbon_cycle_tr)
    41   LOGICAL, PUBLIC :: carbon_cycle_rad       ! CO2 interactive radiatively
     41  LOGICAL, PUBLIC :: carbon_cycle_rad       ! flag to activate CO2 interactive radiatively
    4242!$OMP THREADPRIVATE(carbon_cycle_rad)
    43   INTEGER, PUBLIC :: level_coupling_esm ! Level of coupling for the ESM - 0, 1, 2, 3
     43  INTEGER, PUBLIC :: level_coupling_esm     ! Level of coupling for the ESM - 0, 1, 2, 3
    4444!$OMP THREADPRIVATE(level_coupling_esm)
     45  LOGICAL, PUBLIC :: read_fco2_ocean_cor    ! flag to read corrective oceanic CO2 flux
     46!$OMP THREADPRIVATE(read_fco2_ocean_cor) 
     47  REAL, PUBLIC :: var_fco2_ocean_cor        ! corrective oceanic CO2 flux
     48!$OMP THREADPRIVATE(var_fco2_ocean_cor)
     49  REAL, PUBLIC :: ocean_area_tot            ! total oceanic area to convert flux
     50!$OMP THREADPRIVATE(ocean_area_tot)
     51  LOGICAL, PUBLIC :: read_fco2_land_cor     ! flag to read corrective land CO2 flux
     52!$OMP THREADPRIVATE(read_fco2_land_cor) 
     53  REAL, PUBLIC :: var_fco2_land_cor         ! corrective land CO2 flux
     54!$OMP THREADPRIVATE(var_fco2_land_cor)
     55  REAL, PUBLIC :: land_area_tot             ! total land area to convert flux
     56!$OMP THREADPRIVATE(land_area_tot)
     57
    4558  REAL, PUBLIC :: RCO2_glo
    4659!$OMP THREADPRIVATE(RCO2_glo)
    … …  
    95108  REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_ocean ! Net flux from ocean [kgCO2/m2/s]
    96109!$OMP THREADPRIVATE(fco2_ocean)
     110  REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_ocean_cor ! Net corrective flux from ocean [kgCO2/m2/s]
     111!$OMP THREADPRIVATE(fco2_ocean_cor)
     112  REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_land_cor  ! Net corrective flux from land [kgCO2/m2/s]
     113!$OMP THREADPRIVATE(fco2_land_cor)
    97114
    98115  REAL, DIMENSION(:,:), ALLOCATABLE :: dtr_add       ! Tracer concentration to be injected
    … …  
    252269       IF (.NOT.ALLOCATED(fco2_ocean)) ALLOCATE(fco2_ocean(klon), stat=ierr)
    253270       IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_ocean',1)
    254        fco2_bb(1:klon) = 0.
     271       fco2_ocean(1:klon) = 0.
     272
     273       IF (.NOT.ALLOCATED(fco2_ocean_cor)) ALLOCATE(fco2_ocean_cor(klon), stat=ierr)
     274       IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_ocean_cor',1)
     275       fco2_ocean_cor(1:klon) = 0.
     276       IF (.NOT.ALLOCATED(fco2_land_cor)) ALLOCATE(fco2_land_cor(klon), stat=ierr)
     277       IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_land_cor',1)
     278       fco2_land_cor(1:klon) = 0.
     279
    255280    ENDIF
    256281

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

    r3605 r4013  
    9393       LOGICAL :: adjust_tropopause
    9494       LOGICAL :: ok_daily_climoz
     95       LOGICAL :: ok_new_lscp
    9596! flag to bypass or not the phytrac module
    9697       INTEGER :: iflag_phytrac
    … …  
    141142     &     , ok_chlorophyll,ok_conserv_q, adjust_tropopause             &
    142143     &     , ok_daily_climoz, ok_all_xml, ok_lwoff                      &
    143      &     , iflag_phytrac
     144     &     , iflag_phytrac, ok_new_lscp
    144145     
    145146       save /clesphys/

  • LMDZ6/branches/Ocean_skin/libf/phylmd/cloudth_mod.F90

    r3605 r4013  
    655655      REAL zqs(ngrid), qcloud(ngrid)
    656656      REAL erf
    657 
    658657
    659658
    … …  
    911910      END DO
    912911
    913 
    914912!------------------------------------------------------------------------------
    915913! Initialize
    916914!------------------------------------------------------------------------------
     915
    917916      sigma1(:,:)=0.
    918917      sigma2(:,:)=0.
    … …  
    10131012!zqsatth = qsat thermals
    10141013!ztla = Tl thermals
    1015 
    10161014!------------------------------------------------------------------------------
    10171015! s standard deviation
    … …  
    12171215      else  ! gaussienne environnement seule
    12181216     
     1217
    12191218      zqenv(ind1)=po(ind1)
    12201219      Tbef=t(ind1,ind2)
    … …  
    15341533
    15351534END SUBROUTINE cloudth_v6
     1535
     1536
     1537
     1538
     1539
     1540!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
     1541SUBROUTINE cloudth_mpc(klon,klev,ind2,mpc_bl_points,                     &
     1542&           temp,ztv,po,zqta,fraca,zpspsk,paprs,pplay,ztla,zthl,            &
     1543&           ratqs,zqs,snowflux,qcloud,qincloud,icefrac,ctot,ctot_vol)
     1544!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
     1545! Author : Arnaud Octavio Jam (LMD/CNRS), Etienne Vignon (LMDZ/CNRS)
     1546! Date: Adapted from cloudth_vert_v3 in 2021
     1547! Aim : computes qc and rneb in thermals with cold microphysical considerations
     1548!       + for mixed phase boundary layer clouds, calculate ql and qi from
     1549!       a stationary MPC model
     1550! IMPORTANT NOTE: we assume iflag_clouth_vert=3
     1551!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
     1552
     1553
     1554      USE ioipsl_getin_p_mod, ONLY : getin_p
     1555      USE phys_output_var_mod, ONLY : cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv
     1556      USE lscp_tools_mod, ONLY: CALC_QSAT_ECMWF, ICEFRAC_LSCP
     1557      USE phys_local_var_mod, ONLY : qlth, qith
     1558
     1559      IMPLICIT NONE
     1560
     1561#include "YOMCST.h"
     1562#include "YOETHF.h"
     1563#include "FCTTRE.h"
     1564#include "thermcell.h"
     1565#include "nuage.h"
     1566     
     1567
     1568!------------------------------------------------------------------------------
     1569! Declaration
     1570!------------------------------------------------------------------------------
     1571
     1572! INPUT/OUTPUT
     1573
     1574      INTEGER, INTENT(IN)                         :: klon,klev,ind2
     1575      INTEGER, DIMENSION(klon,klev), INTENT(INOUT)   ::  mpc_bl_points ! 1 where BL MPC, 0 otherwise
     1576
     1577      REAL, DIMENSION(klon,klev), INTENT(IN)      ::  temp          ! Temperature [K]
     1578      REAL, DIMENSION(klon,klev), INTENT(IN)      ::  ztv           ! Virtual potential temp [K]
     1579      REAL, DIMENSION(klon),      INTENT(IN)      ::  po            ! specific humidity [kg/kg]
     1580      REAL, DIMENSION(klon,klev), INTENT(IN)      ::  zqta          ! specific humidity within thermals [kg/kg]
     1581      REAL, DIMENSION(klon,klev+1), INTENT(IN)    ::  fraca         ! Fraction of the mesh covered by thermals [0-1]
     1582      REAL, DIMENSION(klon,klev), INTENT(IN)      ::  zpspsk
     1583      REAL, DIMENSION(klon,klev+1), INTENT(IN)    ::  paprs         ! Pressure at layer interfaces [Pa]
     1584      REAL, DIMENSION(klon,klev), INTENT(IN)      ::  pplay         ! Pressure at the center of layers [Pa]
     1585      REAL, DIMENSION(klon,klev), INTENT(IN)      ::  ztla          ! Liquid temp [K]
     1586      REAL, DIMENSION(klon,klev), INTENT(INOUT)      ::  zthl       ! Liquid potential temp [K]
     1587      REAL, DIMENSION(klon,klev), INTENT(IN)      ::  ratqs         ! Parameter that determines the width of the total water distrib.
     1588      REAL, DIMENSION(klon),      INTENT(IN)      ::  zqs           ! Saturation specific humidity in the mesh [kg/kg]
     1589      REAL, DIMENSION(klon,klev+1), INTENT(IN)    ::  snowflux      ! snow flux at the interface of the layer [kg/m2/s]
     1590
     1591
     1592      REAL, DIMENSION(klon,klev), INTENT(OUT)      ::  ctot         ! Cloud fraction [0-1]
     1593      REAL, DIMENSION(klon,klev), INTENT(OUT)      ::  ctot_vol     ! Volume cloud fraction [0-1]
     1594      REAL, DIMENSION(klon),      INTENT(OUT)      ::  qcloud       ! In cloud total water content [kg/kg]
     1595      REAL, DIMENSION(klon),      INTENT(OUT)      ::  qincloud       ! In cloud condensed water content [kg/kg]
     1596      REAL, DIMENSION(klon,klev), INTENT(OUT)      ::  icefrac      ! Fraction of ice in clouds [0-1]
     1597
     1598
     1599! LOCAL VARIABLES
     1600
     1601      INTEGER itap,ind1,l,ig,iter,k
     1602      LOGICAL flag_topthermals
     1603
     1604
     1605      REAL zqsatth(klon,klev), zqsatenv(klon,klev)
     1606      REAL sigma1(klon,klev)                                                         
     1607      REAL sigma2(klon,klev)
     1608      REAL qcth(klon,klev)
     1609      REAL qcenv(klon,klev)
     1610      REAL qctot(klon,klev)
     1611      REAL cth(klon,klev)
     1612      REAL cenv(klon,klev)   
     1613      REAL cth_vol(klon,klev)
     1614      REAL cenv_vol(klon,klev)
     1615      REAL rneb(klon,klev)
     1616      REAL zqenv(klon)   
     1617
     1618      REAL qsatmmussig1,qsatmmussig2,sqrtpi,sqrt2,sqrt2pi,pi
     1619      REAL rdd,cppd,Lv
     1620      REAL alth,alenv,ath,aenv
     1621      REAL sth,senv,sigma1s,sigma2s,sigma1s_fraca,sigma1s_ratqs
     1622      REAL inverse_rho,beta,a_Brooks,b_Brooks,A_Maj_Brooks,Dx_Brooks,f_Brooks
     1623      REAL xth,xenv,exp_xenv1,exp_xenv2,exp_xth1,exp_xth2
     1624      REAL xth1,xth2,xenv1,xenv2,deltasth, deltasenv
     1625      REAL IntJ,IntI1,IntI2,IntI3,IntJ_CF,IntI1_CF,IntI3_CF,coeffqlenv,coeffqlth
     1626      REAL Tbef,zdelta,qsatbef,zcor
     1627      REAL qlbef,dqsatdt
     1628      REAL erf
     1629      REAL zpdf_sig(klon),zpdf_k(klon),zpdf_delta(klon)
     1630      REAL zpdf_a(klon),zpdf_b(klon),zpdf_e1(klon),zpdf_e2(klon)
     1631      REAL rhodz(klon,klev)
     1632      REAL zrho(klon,klev)
     1633      REAL dz(klon,klev)
     1634      REAL qslth, qsith, qslenv, alenvl, aenvl
     1635      REAL sthi, sthl, althl, athl
     1636      REAL senvi, senvl, qbase, sbase, qliqth, qiceth
     1637      REAL qimax, ttarget, stmp, cout, coutref
     1638      REAL maxi, mini, pas, temp_lim
     1639      REAL deltazlev_mpc(klev),qth_mpc(klev), temp_mpc(klev), pres_mpc(klev), fraca_mpc(klev+1), snowf_mpc(klev+1)
     1640
     1641      INTEGER, SAVE :: niter=20
     1642
     1643      ! Modifty the saturation deficit PDF in thermals
     1644      ! in the presence of ice crystals
     1645      REAL,SAVE :: C_mpc
     1646      !$OMP THREADPRIVATE(C_mpc)
     1647      ! Change the width of the PDF used for vertical subgrid scale heterogeneity
     1648      ! (J Jouhaud, JL Dufresne, JB Madeleine)
     1649      REAL,SAVE :: vert_alpha, vert_alpha_th
     1650      !$OMP THREADPRIVATE(vert_alpha, vert_alpha_th)
     1651      REAL,SAVE :: sigma1s_factor=1.1
     1652      REAL,SAVE :: sigma1s_power=0.6
     1653      REAL,SAVE :: sigma2s_factor=0.09
     1654      REAL,SAVE :: sigma2s_power=0.5
     1655      REAL,SAVE :: cloudth_ratqsmin=-1.
     1656      !$OMP THREADPRIVATE(sigma1s_factor,sigma1s_power,sigma2s_factor,sigma2s_power,cloudth_ratqsmin)
     1657      INTEGER, SAVE :: iflag_cloudth_vert_noratqs=0
     1658      !$OMP THREADPRIVATE(iflag_cloudth_vert_noratqs)
     1659      LOGICAL, SAVE :: firstcall = .TRUE.
     1660      !$OMP THREADPRIVATE(firstcall)
     1661
     1662      CHARACTER (len = 80) :: abort_message
     1663      CHARACTER (len = 20) :: routname = 'cloudth_mpc'
     1664
     1665
     1666!------------------------------------------------------------------------------
     1667! Initialisation
     1668!------------------------------------------------------------------------------
     1669
     1670
     1671! Few initial checksS
     1672
     1673      IF (iflag_cloudth_vert.NE.3) THEN
     1674         abort_message = 'clouth_mpc cannot be used if iflag_cloudth_vert .NE. 3'
     1675         CALL abort_physic(routname,abort_message,1)
     1676      ENDIF
     1677
     1678      DO k = 1,klev
     1679      DO ind1 = 1, klon
     1680        rhodz(ind1,k) = (paprs(ind1,k)-paprs(ind1,k+1))/rg !kg/m2
     1681        zrho(ind1,k) = pplay(ind1,k)/temp(ind1,k)/rd !kg/m3
     1682        dz(ind1,k) = rhodz(ind1,k)/zrho(ind1,k) !m : epaisseur de la couche en metre
     1683      END DO
     1684      END DO
     1685
     1686
     1687      sigma1(:,:)=0.
     1688      sigma2(:,:)=0.
     1689      qcth(:,:)=0.
     1690      qcenv(:,:)=0. 
     1691      qctot(:,:)=0.
     1692      qlth(:,ind2)=0.
     1693      qith(:,ind2)=0.
     1694      rneb(:,:)=0.
     1695      qcloud(:)=0.
     1696      cth(:,:)=0.
     1697      cenv(:,:)=0.
     1698      ctot(:,:)=0.
     1699      cth_vol(:,:)=0.
     1700      cenv_vol(:,:)=0.
     1701      ctot_vol(:,:)=0.
     1702      qsatmmussig1=0.
     1703      qsatmmussig2=0.
     1704      rdd=287.04
     1705      cppd=1005.7
     1706      pi=3.14159
     1707      sqrt2pi=sqrt(2.*pi)
     1708      sqrt2=sqrt(2.)
     1709      sqrtpi=sqrt(pi)
     1710      icefrac(:,ind2)=0.
     1711
     1712
     1713
     1714      IF (firstcall) THEN
     1715
     1716        vert_alpha=0.5
     1717        CALL getin_p('cloudth_vert_alpha',vert_alpha)
     1718        WRITE(*,*) 'cloudth_vert_alpha = ', vert_alpha
     1719        ! The factor used for the thermal is equal to that of the environment
     1720        !   if nothing is explicitly specified in the def file
     1721        vert_alpha_th=vert_alpha
     1722        CALL getin_p('cloudth_vert_alpha_th',vert_alpha_th)
     1723        WRITE(*,*) 'cloudth_vert_alpha_th = ', vert_alpha_th
     1724        ! Factor used in the calculation of sigma1s
     1725        CALL getin_p('cloudth_sigma1s_factor',sigma1s_factor)
     1726        WRITE(*,*) 'cloudth_sigma1s_factor = ', sigma1s_factor
     1727        ! Power used in the calculation of sigma1s
     1728        CALL getin_p('cloudth_sigma1s_power',sigma1s_power)
     1729        WRITE(*,*) 'cloudth_sigma1s_power = ', sigma1s_power
     1730        ! Factor used in the calculation of sigma2s
     1731        CALL getin_p('cloudth_sigma2s_factor',sigma2s_factor)
     1732        WRITE(*,*) 'cloudth_sigma2s_factor = ', sigma2s_factor
     1733        ! Power used in the calculation of sigma2s
     1734        CALL getin_p('cloudth_sigma2s_power',sigma2s_power)
     1735        WRITE(*,*) 'cloudth_sigma2s_power = ', sigma2s_power
     1736        ! Minimum value for the environmental air subgrid water distrib
     1737        CALL getin_p('cloudth_ratqsmin',cloudth_ratqsmin)
     1738        WRITE(*,*) 'cloudth_ratqsmin = ', cloudth_ratqsmin
     1739        ! Remove the dependency to ratqs from the variance of the vertical PDF
     1740        CALL getin_p('iflag_cloudth_vert_noratqs',iflag_cloudth_vert_noratqs)
     1741        WRITE(*,*) 'iflag_cloudth_vert_noratqs = ', iflag_cloudth_vert_noratqs
     1742        ! Modifies the PDF in thermals when ice crystals are present
     1743        C_mpc=1.e2
     1744        CALL getin_p('C_mpc',C_mpc)
     1745        WRITE(*,*) 'C_mpc = ', C_mpc
     1746
     1747        firstcall=.FALSE.
     1748
     1749      ENDIF
     1750
     1751
     1752
     1753!-------------------------------------------------------------------------------
     1754! Identify grid points with potential mixed-phase conditions
     1755!-------------------------------------------------------------------------------
     1756
     1757      temp_lim=RTT-40.0
     1758
     1759      DO ind1=1,klon
     1760            IF ((temp(ind1,ind2) .LT. RTT) .AND. (temp(ind1,ind2) .GT. temp_lim) &
     1761            .AND. (iflag_mpc_bl .GE. 2) .AND. (ind2<=klev-2)  &
     1762            .AND. (ztv(ind1,1).GT.ztv(ind1,2)) .AND.(fraca(ind1,ind2).GT.1.e-10)) THEN
     1763                mpc_bl_points(ind1,ind2)=1
     1764            ELSE
     1765                mpc_bl_points(ind1,ind2)=0
     1766            ENDIF
     1767      ENDDO
     1768
     1769
     1770!-------------------------------------------------------------------------------
     1771! Thermal fraction calculation and standard deviation of the distribution
     1772!------------------------------------------------------------------------------- 
     1773
     1774    DO ind1=1,klon
     1775
     1776
     1777    IF ((ztv(ind1,1).GT.ztv(ind1,2)).AND.(fraca(ind1,ind2).GT.1.e-10)) THEN !Thermal and environnement
     1778
     1779
     1780! Environment:
     1781
     1782        zqenv(ind1)=(po(ind1)-fraca(ind1,ind2)*zqta(ind1,ind2))/(1.-fraca(ind1,ind2)) !qt = a*qtth + (1-a)*qtenv
     1783        Tbef=zthl(ind1,ind2)*zpspsk(ind1,ind2)
     1784           
     1785        CALL CALC_QSAT_ECMWF(Tbef,0.,paprs(ind1,ind2),RTT,0,.false.,qsatbef,dqsatdt)
     1786        zqsatenv(ind1,ind2)=qsatbef
     1787
     1788        IF (Tbef .GE. RTT) THEN
     1789               Lv=RLVTT
     1790        ELSE
     1791               Lv=RLSTT
     1792        ENDIF
     1793       
     1794
     1795        alenv=(0.622*Lv*zqsatenv(ind1,ind2))/(rdd*zthl(ind1,ind2)**2)     !qsl, p84
     1796        aenv=1./(1.+(alenv*Lv/cppd))                                      !al, p84
     1797        senv=aenv*(po(ind1)-zqsatenv(ind1,ind2))                          !s, p84
     1798     
     1799        ! For MPCs:
     1800        IF (mpc_bl_points(ind1,ind2) .EQ. 1) THEN
     1801        CALL CALC_QSAT_ECMWF(Tbef,0.,paprs(ind1,ind2),RTT,1,.false.,qslenv,dqsatdt)
     1802        alenvl=(0.622*RLVTT*qslenv)/(rdd*zthl(ind1,ind2)**2)     
     1803        aenvl=1./(1.+(alenv*Lv/cppd))         
     1804        senvl=aenvl*(po(ind1)-qslenv)   
     1805        ENDIF
     1806
     1807
     1808! Thermals:
     1809
     1810        Tbef=ztla(ind1,ind2)*zpspsk(ind1,ind2)
     1811        CALL CALC_QSAT_ECMWF(Tbef,0.,paprs(ind1,ind2),RTT,0,.false.,qsatbef,dqsatdt)
     1812        zqsatth(ind1,ind2)=qsatbef
     1813
     1814        IF (Tbef .GE. RTT) THEN
     1815            Lv=RLVTT
     1816        ELSE
     1817            Lv=RLSTT
     1818        ENDIF
     1819
     1820       
     1821        alth=(0.622*Lv*zqsatth(ind1,ind2))/(rdd*ztla(ind1,ind2)**2)       
     1822        ath=1./(1.+(alth*Lv/cppd))                                                         
     1823        sth=ath*(zqta(ind1,ind2)-zqsatth(ind1,ind2))                     
     1824
     1825       ! For MPCs:
     1826        IF (mpc_bl_points(ind1,ind2) .GT. 0) THEN
     1827         CALL CALC_QSAT_ECMWF(Tbef,0.,paprs(ind1,ind2),RTT,1,.false.,qslth,dqsatdt)
     1828         CALL CALC_QSAT_ECMWF(Tbef,0.,paprs(ind1,ind2),RTT,2,.false.,qsith,dqsatdt)
     1829         althl=(0.622*RLVTT*qslth)/(rdd*ztla(ind1,ind2)**2)                   
     1830         athl=1./(1.+(alth*RLVTT/cppd))                                       
     1831         sthl=athl*(zqta(ind1,ind2)-qslth)   
     1832         sthi=athl*(zqta(ind1,ind2)-qsith) 
     1833        ENDIF     
     1834
     1835
     1836
     1837!-------------------------------------------------------------------------------
     1838!  Version 3: Changes by J. Jouhaud; condensation for q > -delta s
     1839!  Rq: in this subroutine, we assume iflag_clouth_vert .EQ. 3
     1840!-------------------------------------------------------------------------------
     1841
     1842        IF (mpc_bl_points(ind1,ind2) .EQ. 0) THEN ! No BL MPC
     1843
     1844       ! Standard deviation of the distributions
     1845
     1846           sigma1s_fraca = (sigma1s_factor**0.5)*(fraca(ind1,ind2)**sigma1s_power) / &
     1847           &                (1-fraca(ind1,ind2))*((sth-senv)**2)**0.5
     1848
     1849           IF (cloudth_ratqsmin>0.) THEN
     1850             sigma1s_ratqs = cloudth_ratqsmin*po(ind1)
     1851           ELSE
     1852             sigma1s_ratqs = ratqs(ind1,ind2)*po(ind1)
     1853           ENDIF
     1854 
     1855           sigma1s = sigma1s_fraca + sigma1s_ratqs
     1856           sigma2s=(sigma2s_factor*(((sth-senv)**2)**0.5)/((fraca(ind1,ind2)+0.02)**sigma2s_power))+0.002*zqta(ind1,ind2)
     1857
     1858
     1859           deltasenv=aenv*vert_alpha*sigma1s
     1860           deltasth=ath*vert_alpha_th*sigma2s
     1861
     1862           xenv1=-(senv+deltasenv)/(sqrt(2.)*sigma1s)
     1863           xenv2=-(senv-deltasenv)/(sqrt(2.)*sigma1s)
     1864           exp_xenv1 = exp(-1.*xenv1**2)
     1865           exp_xenv2 = exp(-1.*xenv2**2)
     1866           xth1=-(sth+deltasth)/(sqrt(2.)*sigma2s)
     1867           xth2=-(sth-deltasth)/(sqrt(2.)*sigma2s)
     1868           exp_xth1 = exp(-1.*xth1**2)
     1869           exp_xth2 = exp(-1.*xth2**2)
     1870     
     1871      !surface CF
     1872
     1873           cth(ind1,ind2)=0.5*(1.-1.*erf(xth1))
     1874           cenv(ind1,ind2)=0.5*(1.-1.*erf(xenv1))
     1875           ctot(ind1,ind2)=fraca(ind1,ind2)*cth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv(ind1,ind2)
     1876
     1877
     1878      !volume CF and condensed water
     1879
     1880            !environnement
     1881
     1882            IntJ=0.5*senv*(1-erf(xenv2))+(sigma1s/sqrt2pi)*exp_xenv2
     1883            IntJ_CF=0.5*(1.-1.*erf(xenv2))
     1884
     1885            IF (deltasenv .LT. 1.e-10) THEN
     1886              qcenv(ind1,ind2)=IntJ
     1887              cenv_vol(ind1,ind2)=IntJ_CF
     1888            ELSE
     1889              IntI1=(((senv+deltasenv)**2+(sigma1s)**2)/(8*deltasenv))*(erf(xenv2)-erf(xenv1))
     1890              IntI2=(sigma1s**2/(4*deltasenv*sqrtpi))*(xenv1*exp_xenv1-xenv2*exp_xenv2)
     1891              IntI3=((sqrt2*sigma1s*(senv+deltasenv))/(4*sqrtpi*deltasenv))*(exp_xenv1-exp_xenv2)
     1892              IntI1_CF=((senv+deltasenv)*(erf(xenv2)-erf(xenv1)))/(4*deltasenv)
     1893              IntI3_CF=(sqrt2*sigma1s*(exp_xenv1-exp_xenv2))/(4*sqrtpi*deltasenv)
     1894              qcenv(ind1,ind2)=IntJ+IntI1+IntI2+IntI3
     1895              cenv_vol(ind1,ind2)=IntJ_CF+IntI1_CF+IntI3_CF
     1896            ENDIF
     1897             
     1898
     1899
     1900            !thermals
     1901
     1902            IntJ=0.5*sth*(1-erf(xth2))+(sigma2s/sqrt2pi)*exp_xth2
     1903            IntJ_CF=0.5*(1.-1.*erf(xth2))
     1904     
     1905            IF (deltasth .LT. 1.e-10) THEN
     1906              qcth(ind1,ind2)=IntJ
     1907              cth_vol(ind1,ind2)=IntJ_CF
     1908            ELSE
     1909              IntI1=(((sth+deltasth)**2+(sigma2s)**2)/(8*deltasth))*(erf(xth2)-erf(xth1))
     1910              IntI2=(sigma2s**2/(4*deltasth*sqrtpi))*(xth1*exp_xth1-xth2*exp_xth2)
     1911              IntI3=((sqrt2*sigma2s*(sth+deltasth))/(4*sqrtpi*deltasth))*(exp_xth1-exp_xth2)
     1912              IntI1_CF=((sth+deltasth)*(erf(xth2)-erf(xth1)))/(4*deltasth)
     1913              IntI3_CF=(sqrt2*sigma2s*(exp_xth1-exp_xth2))/(4*sqrtpi*deltasth)
     1914              qlth(ind1,ind2)=IntJ+IntI1+IntI2+IntI3
     1915              cth_vol(ind1,ind2)=IntJ_CF+IntI1_CF+IntI3_CF
     1916            ENDIF
     1917
     1918              qctot(ind1,ind2)=fraca(ind1,ind2)*qcth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qcenv(ind1,ind2)
     1919              ctot_vol(ind1,ind2)=fraca(ind1,ind2)*cth_vol(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv_vol(ind1,ind2)
     1920             
     1921
     1922            IF (cenv(ind1,ind2).LT.1.e-10.or.cth(ind1,ind2).LT.1.e-10) THEN
     1923                ctot(ind1,ind2)=0.
     1924                ctot_vol(ind1,ind2)=0.
     1925                qcloud(ind1)=zqsatenv(ind1,ind2)
     1926                qincloud(ind1)=0.
     1927            ELSE               
     1928                qcloud(ind1)=qctot(ind1,ind2)/ctot(ind1,ind2)+zqs(ind1)
     1929                qincloud(ind1)=qctot(ind1,ind2)/ctot(ind1,ind2)
     1930            ENDIF
     1931
     1932
     1933        ELSE ! mpc_bl_points>0
     1934
     1935            ! Treat boundary layer mixed phase clouds
     1936           
     1937            ! thermals
     1938            !=========
     1939
     1940            ! ice phase
     1941            !...........
     1942
     1943            deltazlev_mpc=dz(ind1,:)
     1944            temp_mpc=ztla(ind1,:)*zpspsk(ind1,:)
     1945            pres_mpc=pplay(ind1,:)
     1946            fraca_mpc=fraca(ind1,:)
     1947            snowf_mpc=snowflux(ind1,:)
     1948            qth_mpc=zqta(ind1,:)
     1949            flag_topthermals=.FALSE.
     1950            IF ((mpc_bl_points(ind1,ind2) .EQ. 1) .AND. (mpc_bl_points(ind1,ind2+1) .EQ. 0))  THEN
     1951                flag_topthermals = .TRUE.
     1952            ENDIF
     1953
     1954            CALL ICE_MPC_BL_CLOUDS(ind1,ind2,klev,flag_topthermals,temp_mpc,pres_mpc,qth_mpc,qlth(ind1,:),qith(ind1,:),deltazlev_mpc,snowf_mpc,fraca_mpc,qiceth)
     1955
     1956
     1957
     1958            ! We account for the effect of ice crystals in thermals on sthl
     1959            ! and on the width of the distribution
     1960
     1961            sthl=sthl*1./(1.+C_mpc*qiceth)  &
     1962                + (1.-1./(1.+C_mpc*qiceth)) * athl*(zqta(ind1,ind2)-(qsith+qiceth)) 
     1963
     1964            sthi=sthi*1./(1.+C_mpc*qiceth)  &
     1965                + (1.-1./(1.+C_mpc*qiceth)) * athl*(zqta(ind1,ind2)-(qsith+qiceth)) 
     1966
     1967           ! standard deviation of the water distribution in thermals
     1968            sth=sthl
     1969            senv=senvl
     1970            sigma2s=(sigma2s_factor*((MAX((sth-senv),0.)**2)**0.5)/((fraca(ind1,ind2)+0.02)**sigma2s_power))+0.002*zqta(ind1,ind2)
     1971            deltasth=athl*vert_alpha_th*sigma2s
     1972     
     1973            ! Liquid phase
     1974            !.............
     1975            xth1=-(sthl+deltasth)/(sqrt(2.)*sigma2s)
     1976            xth2=-(sthl-deltasth)/(sqrt(2.)*sigma2s)           
     1977            exp_xth1 = exp(-1.*xth1**2)
     1978            exp_xth2 = exp(-1.*xth2**2)
     1979            IntJ=0.5*sthl*(1-erf(xth2))+(sigma2s/sqrt2pi)*exp_xth2
     1980            IntJ_CF=0.5*(1.-1.*erf(xth2))
     1981            IntI1=(((sthl+deltasth)**2+(sigma2s)**2)/(8*deltasth))*(erf(xth2)-erf(xth1))
     1982            IntI2=(sigma2s**2/(4*deltasth*sqrtpi))*(xth1*exp_xth1-xth2*exp_xth2)
     1983            IntI3=((sqrt2*sigma2s*(sthl+deltasth))/(4*sqrtpi*deltasth))*(exp_xth1-exp_xth2)
     1984            IntI1_CF=((sthl+deltasth)*(erf(xth2)-erf(xth1)))/(4*deltasth)
     1985            IntI3_CF=(sqrt2*sigma2s*(exp_xth1-exp_xth2))/(4*sqrtpi*deltasth)
     1986            qliqth=IntJ+IntI1+IntI2+IntI3
     1987
     1988            ! qimax calculation
     1989            xth1=-(sthi+deltasth)/(sqrt(2.)*sigma2s)
     1990            xth2=-(sthi-deltasth)/(sqrt(2.)*sigma2s)           
     1991            exp_xth1 = exp(-1.*xth1**2)
     1992            exp_xth2 = exp(-1.*xth2**2)
     1993            IntJ=0.5*sthi*(1-erf(xth2))+(sigma2s/sqrt2pi)*exp_xth2
     1994            IntJ_CF=0.5*(1.-1.*erf(xth2))
     1995            IntI1=(((sthi+deltasth)**2+(sigma2s)**2)/(8*deltasth))*(erf(xth2)-erf(xth1))
     1996            IntI2=(sigma2s**2/(4*deltasth*sqrtpi))*(xth1*exp_xth1-xth2*exp_xth2)
     1997            IntI3=((sqrt2*sigma2s*(sthi+deltasth))/(4*sqrtpi*deltasth))*(exp_xth1-exp_xth2)
     1998            IntI1_CF=((sthi+deltasth)*(erf(xth2)-erf(xth1)))/(4*deltasth)
     1999            IntI3_CF=(sqrt2*sigma2s*(exp_xth1-exp_xth2))/(4*sqrtpi*deltasth)
     2000            qimax=IntJ+IntI1+IntI2+IntI3
     2001            qimax=qimax-qliqth
     2002
     2003
     2004            ! Condensed water
     2005            ! Guarantee the consistency between qiceth and the subgrid scale PDF of total water
     2006            qlth(ind1,ind2)=MAX(0.,qliqth)
     2007            qith(ind1,ind2)=MAX(0.,MIN(qiceth,qimax))
     2008            qcth(ind1,ind2)=qlth(ind1,ind2)+qith(ind1,ind2)
     2009
     2010            ! calculation of qbase which is the value of the water vapor within mixed phase clouds
     2011            ! such that the total water in cloud = qbase+qliqth+qiceth
     2012            ! sbase is the value of s such that int_sbase^\intfy s ds = cloud fraction
     2013            ! sbase and qbase calculation (note that sbase is wrt liq so negative)
     2014            ! look for an approximate solution with iteration
     2015           
     2016            ttarget=qcth(ind1,ind2)
     2017            mini=athl*(qsith-qslth)
     2018            maxi=0.
     2019            pas=(maxi-mini)/niter
     2020            stmp=mini
     2021            sbase=stmp
     2022            coutref=1.E6
     2023            DO iter=1,niter
     2024                cout=ABS(sigma2s/SQRT(2.*RPI)*EXP(-((sthl-stmp)/sigma2s)**2)+(sthl-stmp)/SQRT(2.)*(1.-erf(-(sthl-stmp)/sigma2s)) &
     2025                     + stmp/2.*(1.-erf(-(sthl-stmp)/sigma2s)) -ttarget)
     2026               IF (cout .LT. coutref) THEN
     2027                     sbase=stmp
     2028                     coutref=cout
     2029                ELSE
     2030                     stmp=stmp+pas
     2031                ENDIF
     2032            ENDDO
     2033            qbase=MAX(0., sbase/athl+qslth)
     2034
     2035            ! surface cloud fraction in thermals
     2036            cth(ind1,ind2)=0.5*(1.-erf((sbase-sthl)/sqrt(2.)/sigma2s))
     2037            cth(ind1,ind2)=MIN(MAX(cth(ind1,ind2),0.),1.)
     2038
     2039
     2040            !volume cloud fraction in thermals
     2041            !to be checked
     2042            xth1=-(sthl+deltasth-sbase)/(sqrt(2.)*sigma2s)
     2043            xth2=-(sthl-deltasth-sbase)/(sqrt(2.)*sigma2s)           
     2044            exp_xth1 = exp(-1.*xth1**2)
     2045            exp_xth2 = exp(-1.*xth2**2)
     2046
     2047            IntJ=0.5*sthl*(1-erf(xth2))+(sigma2s/sqrt2pi)*exp_xth2
     2048            IntJ_CF=0.5*(1.-1.*erf(xth2))
     2049     
     2050            IF (deltasth .LT. 1.e-10) THEN
     2051              cth_vol(ind1,ind2)=IntJ_CF
     2052            ELSE
     2053              IntI1=(((sthl+deltasth-sbase)**2+(sigma2s)**2)/(8*deltasth))*(erf(xth2)-erf(xth1))
     2054              IntI2=(sigma2s**2/(4*deltasth*sqrtpi))*(xth1*exp_xth1-xth2*exp_xth2)
     2055              IntI3=((sqrt2*sigma2s*(sth+deltasth))/(4*sqrtpi*deltasth))*(exp_xth1-exp_xth2)
     2056              IntI1_CF=((sthl-sbase+deltasth)*(erf(xth2)-erf(xth1)))/(4*deltasth)
     2057              IntI3_CF=(sqrt2*sigma2s*(exp_xth1-exp_xth2))/(4*sqrtpi*deltasth)
     2058              cth_vol(ind1,ind2)=IntJ_CF+IntI1_CF+IntI3_CF
     2059            ENDIF
     2060              cth_vol(ind1,ind2)=MIN(MAX(0.,cth_vol(ind1,ind2)),1.)
     2061
     2062            ! Environment
     2063            !=============
     2064            ! In the environment/downdrafts, only liquid clouds
     2065            ! See Shupe et al. 2008, JAS
     2066
     2067            ! standard deviation of the distribution in the environment
     2068            sth=sthl
     2069            senv=senvl
     2070            sigma1s_fraca = (sigma1s_factor**0.5)*(fraca(ind1,ind2)**sigma1s_power) / &
     2071                          &                (1-fraca(ind1,ind2))*(MAX((sth-senv),0.)**2)**0.5
     2072            ! for mixed phase clouds, there is no contribution from large scale ratqs to the distribution
     2073            ! in the environement
     2074
     2075            sigma1s_ratqs=1E-10
     2076            IF (cloudth_ratqsmin>0.) THEN
     2077                sigma1s_ratqs = cloudth_ratqsmin*po(ind1)
     2078            ENDIF
     2079
     2080            sigma1s = sigma1s_fraca + sigma1s_ratqs
     2081            deltasenv=aenvl*vert_alpha*sigma1s
     2082            xenv1=-(senvl+deltasenv)/(sqrt(2.)*sigma1s)
     2083            xenv2=-(senvl-deltasenv)/(sqrt(2.)*sigma1s)
     2084            exp_xenv1 = exp(-1.*xenv1**2)
     2085            exp_xenv2 = exp(-1.*xenv2**2)
     2086
     2087            !surface CF
     2088            cenv(ind1,ind2)=0.5*(1.-1.*erf(xenv1))
     2089
     2090            !volume CF and condensed water
     2091            IntJ=0.5*senvl*(1-erf(xenv2))+(sigma1s/sqrt2pi)*exp_xenv2
     2092            IntJ_CF=0.5*(1.-1.*erf(xenv2))
     2093
     2094            IF (deltasenv .LT. 1.e-10) THEN
     2095              qcenv(ind1,ind2)=IntJ
     2096              cenv_vol(ind1,ind2)=IntJ_CF
     2097            ELSE
     2098              IntI1=(((senvl+deltasenv)**2+(sigma1s)**2)/(8*deltasenv))*(erf(xenv2)-erf(xenv1))
     2099              IntI2=(sigma1s**2/(4*deltasenv*sqrtpi))*(xenv1*exp_xenv1-xenv2*exp_xenv2)
     2100              IntI3=((sqrt2*sigma1s*(senv+deltasenv))/(4*sqrtpi*deltasenv))*(exp_xenv1-exp_xenv2)
     2101              IntI1_CF=((senvl+deltasenv)*(erf(xenv2)-erf(xenv1)))/(4*deltasenv)
     2102              IntI3_CF=(sqrt2*sigma1s*(exp_xenv1-exp_xenv2))/(4*sqrtpi*deltasenv)
     2103              qcenv(ind1,ind2)=IntJ+IntI1+IntI2+IntI3 ! only liquid water in environment
     2104              cenv_vol(ind1,ind2)=IntJ_CF+IntI1_CF+IntI3_CF
     2105            ENDIF
     2106
     2107            qcenv(ind1,ind2)=MAX(qcenv(ind1,ind2),0.)
     2108            cenv_vol(ind1,ind2)=MIN(MAX(cenv_vol(ind1,ind2),0.),1.)
     2109
     2110
     2111           
     2112            ! Thermals + environment
     2113            ctot(ind1,ind2)=fraca(ind1,ind2)*cth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv(ind1,ind2)
     2114            qctot(ind1,ind2)=fraca(ind1,ind2)*qcth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qcenv(ind1,ind2)
     2115            ctot_vol(ind1,ind2)=fraca(ind1,ind2)*cth_vol(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*cenv_vol(ind1,ind2)
     2116            IF (qcth(ind1,ind2) .GT. 0) THEN
     2117                icefrac(ind1,ind2)=fraca(ind1,ind2)*qith(ind1,ind2)/(fraca(ind1,ind2)*qcth(ind1,ind2)+(1.-1.*fraca(ind1,ind2))*qcenv(ind1,ind2))
     2118                icefrac(ind1,ind2)=MAX(MIN(1.,icefrac(ind1,ind2)),0.)
     2119            ELSE
     2120                icefrac(ind1,ind2)=0.
     2121            ENDIF
     2122
     2123            IF (cenv(ind1,ind2).LT.1.e-10.or.cth(ind1,ind2).LT.1.e-10) THEN
     2124                ctot(ind1,ind2)=0.
     2125                ctot_vol(ind1,ind2)=0.
     2126                qincloud(ind1)=0.
     2127                qcloud(ind1)=zqsatenv(ind1,ind2)
     2128            ELSE               
     2129                qcloud(ind1)=fraca(ind1,ind2)*(qcth(ind1,ind2)/cth(ind1,ind2)+qbase) &
     2130                            +(1.-1.*fraca(ind1,ind2))*(qcenv(ind1,ind2)/cenv(ind1,ind2)+qslenv)
     2131                qincloud(ind1)=MAX(fraca(ind1,ind2)*(qcth(ind1,ind2)/cth(ind1,ind2)) &
     2132                            +(1.-1.*fraca(ind1,ind2))*(qcenv(ind1,ind2)/cenv(ind1,ind2)),0.)
     2133            ENDIF
     2134
     2135        ENDIF ! mpc_bl_points
     2136
     2137
     2138    ELSE  ! gaussian for environment only
     2139
     2140     
     2141        zqenv(ind1)=po(ind1)
     2142        Tbef=temp(ind1,ind2)
     2143
     2144        CALL CALC_QSAT_ECMWF(Tbef,0.,paprs(ind1,ind2),RTT,0,.false.,qsatbef,dqsatdt)
     2145        zqsatenv(ind1,ind2)=qsatbef
     2146
     2147        IF (Tbef .GE. RTT) THEN
     2148                Lv=RLVTT
     2149        ELSE
     2150                Lv=RLSTT
     2151        ENDIF
     2152       
     2153
     2154        zthl(ind1,ind2)=temp(ind1,ind2)*(101325./paprs(ind1,ind2))**(rdd/cppd)
     2155        alenv=(0.622*Lv*zqsatenv(ind1,ind2))/(rdd*zthl(ind1,ind2)**2)
     2156        aenv=1./(1.+(alenv*Lv/cppd))
     2157        senv=aenv*(po(ind1)-zqsatenv(ind1,ind2))
     2158        sth=0.
     2159     
     2160        sigma1s=ratqs(ind1,ind2)*zqenv(ind1)
     2161        sigma2s=0.
     2162
     2163        sqrt2pi=sqrt(2.*pi)
     2164        xenv=senv/(sqrt(2.)*sigma1s)
     2165        ctot(ind1,ind2)=0.5*(1.+1.*erf(xenv))
     2166        ctot_vol(ind1,ind2)=ctot(ind1,ind2)
     2167        qctot(ind1,ind2)=sigma1s*((exp(-1.*xenv**2)/sqrt2pi)+xenv*sqrt(2.)*cenv(ind1,ind2))
     2168     
     2169        IF (ctot(ind1,ind2).LT.1.e-3) THEN
     2170          ctot(ind1,ind2)=0.
     2171          qcloud(ind1)=zqsatenv(ind1,ind2)
     2172          qincloud(ind1)=0.
     2173        ELSE
     2174          qcloud(ind1)=qctot(ind1,ind2)/ctot(ind1,ind2)+zqsatenv(ind1,ind2)
     2175          qincloud(ind1)=MAX(qctot(ind1,ind2)/ctot(ind1,ind2),0.)
     2176        ENDIF
     2177 
     2178
     2179    ENDIF       ! From the separation (thermal/envrionnement) and (environnement only,) l.335 et l.492
     2180
     2181    ! Outputs used to check the PDFs
     2182    cloudth_senv(ind1,ind2) = senv
     2183    cloudth_sth(ind1,ind2) = sth
     2184    cloudth_sigmaenv(ind1,ind2) = sigma1s
     2185    cloudth_sigmath(ind1,ind2) = sigma2s
     2186
     2187
     2188    ENDDO       !loop on klon
     2189
     2190RETURN
     2191
     2192
     2193END SUBROUTINE cloudth_mpc
     2194
     2195!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
     2196SUBROUTINE ICE_MPC_BL_CLOUDS(ind1,ind2,klev,flag_topthermals,temp,pres,qth,qlth,qith,deltazlev,snowf,fraca,qi)
     2197
     2198! parameterization of ice for boundary
     2199! layer mixed-phase clouds assuming a stationary system
     2200!
     2201! Note that vapor deposition on ice crystals and riming of liquid droplets
     2202! depend on the ice number concentration Ni
     2203! One could assume that Ni depends on qi, e.g.,  Ni=beta*(qi*rho)**xi
     2204! and use values from Hong et al. 2004, MWR for instance
     2205! One may also estimate Ni as a function of T, as in Meyers 1922 or Fletcher 1962
     2206! One could also think of a more complex expression of Ni;
     2207! function of qi, T, the concentration in aerosols or INP ..
     2208! Here we prefer fixing Ni to a tuning parameter
     2209! By default we take 2.0L-1=2.0e3m-3, median value from measured vertical profiles near Svalbard
     2210! in Mioche et al. 2017
     2211!
     2212!
     2213! References:
     2214!------------
     2215! This parameterization is thoroughly described in Vignon et al.
     2216!
     2217! More specifically
     2218! for the Water vapor deposition process:
     2219!
     2220! Rotstayn, L. D., 1997: A physically based scheme for the treat-
     2221! ment of stratiform cloudfs and precipitation in large-scale
     2222! models. I: Description and evaluation of the microphysical
     2223! processes. Quart. J. Roy. Meteor. Soc., 123, 1227–1282.
     2224!
     2225!  Morrison, H., and A. Gettelman, 2008: A new two-moment bulk
     2226!  stratiform cloud microphysics scheme in the NCAR Com-
     2227!  munity Atmosphere Model (CAM3). Part I: Description and
     2228!  numerical tests. J. Climate, 21, 3642–3659
     2229!
     2230! for the Riming process:
     2231!
     2232! Rutledge, S. A., and P. V. Hobbs, 1983: The mesoscale and micro-
     2233! scale structure and organization of clouds and precipitation in
     2234! midlatitude cyclones. VII: A model for the ‘‘seeder-feeder’’
     2235! process in warm-frontal rainbands. J. Atmos. Sci., 40, 1185–1206
     2236!
     2237! Thompson, G., R. M. Rasmussen, and K. Manning, 004: Explicit
     2238! forecasts of winter precipitation using an improved bulk
     2239! microphysics scheme. Part I: Description and sensitivityThompson, G., R. M. Rasmussen, and K. Manning, 2004: Explicit
     2240! forecasts of winter precipitation using an improved bulk
     2241! microphysics scheme. Part I: Description and sensitivity analysis. Mon. Wea. Rev., 132, 519–542
     2242!
     2243! For the formation of clouds by thermals:
     2244!
     2245! Rio, C., & Hourdin, F. (2008). A thermal plume model for the convective boundary layer : Representation of cumulus clouds. Journal of
     2246! the Atmospheric Sciences, 65, 407–425.
     2247!
     2248! Jam, A., Hourdin, F., Rio, C., & Couvreux, F. (2013). Resolved versus parametrized boundary-layer plumes. Part III: Derivation of a
     2249! statistical scheme for cumulus clouds. Boundary-layer Meteorology, 147, 421–441. https://doi.org/10.1007/s10546-012-9789-3
     2250!
     2251!
     2252!
     2253! Contact: Etienne Vignon, etienne.vignon@lmd.ipsl.fr
     2254!=============================================================================
     2255
     2256    USE lscp_tools_mod, ONLY: CALC_QSAT_ECMWF
     2257    USE ioipsl_getin_p_mod, ONLY : getin_p
     2258    USE phys_state_var_mod, ONLY : fm_therm, detr_therm, entr_therm
     2259
     2260    IMPLICIT none
     2261
     2262
     2263    INCLUDE "YOMCST.h"
     2264    INCLUDE "nuage.h"
     2265
     2266    INTEGER, INTENT(IN) :: ind1,ind2, klev ! horizontal and vertical indices and dimensions
     2267    LOGICAL, INTENT(IN) :: flag_topthermals ! uppermost layer of thermals ?
     2268    REAL,  DIMENSION(klev), INTENT(IN) :: temp       ! temperature [K] within thermals
     2269    REAL,  DIMENSION(klev), INTENT(IN) :: pres       ! pressure [Pa]
     2270    REAL,  DIMENSION(klev), INTENT(IN) :: qth        ! mean specific water content in thermals [kg/kg]
     2271    REAL,  DIMENSION(klev), INTENT(IN) :: qlth       ! condensed liquid water in thermals, approximated value [kg/kg]
     2272    REAL,  DIMENSION(klev), INTENT(IN) :: qith       ! condensed ice water , thermals [kg/kg]
     2273    REAL,  DIMENSION(klev), INTENT(IN) :: deltazlev  ! layer thickness [m]
     2274    REAL,  DIMENSION(klev+1), INTENT(IN) :: snowf      ! snow flux at the upper inferface
     2275    REAL,  DIMENSION(klev+1), INTENT(IN) :: fraca      ! fraction of the mesh covered by thermals
     2276
     2277    REAL,  INTENT(OUT) :: qi        ! ice cloud specific content [kg/kg]
     2278
     2279
     2280    REAL, SAVE    :: Ni,  C_cap, Ei, d_top
     2281    !$OMP THREADPRIVATE(Ni, C_cap,Ei, d_top)
     2282    LOGICAL, SAVE :: firstcall = .TRUE.
     2283    !$OMP THREADPRIVATE(firstcall)
     2284
     2285
     2286    INTEGER ind2p1,ind2p2
     2287    REAL rho(klev)
     2288    REAL unsurtaudet, unsurtaustardep, unsurtaurim
     2289    REAL qsl, qsi, dqs, AA, BB, Ka, Dv, rhoi
     2290    REAL  p0, t0
     2291    REAL alpha, flux_term
     2292    REAL det_term, precip_term, rim_term, dep_term
     2293
     2294 
     2295    IF (firstcall) THEN
     2296        Ni=2.0e3
     2297        CALL getin_p('Ni', Ni)
     2298        WRITE(*,*) 'Ni = ', Ni
     2299
     2300        Ei=0.5
     2301        CALL getin_p('Ei', Ei)
     2302        WRITE(*,*) 'Ei = ', Ei
     2303
     2304        C_cap=0.5
     2305        CALL getin_p('C_cap', C_cap)
     2306        WRITE(*,*) 'C_cap = ', C_cap
     2307
     2308        d_top=0.8
     2309        CALL getin_p('d_top', d_top)
     2310        WRITE(*,*) 'd_top = ', d_top
     2311
     2312
     2313        firstcall=.FALSE.
     2314    ENDIF
     2315
     2316
     2317    ind2p1=ind2+1
     2318    ind2p2=ind2+2
     2319
     2320    ! Liquid water content:
     2321    !=====================
     2322    ! the liquid water content is not calculated in this routine
     2323
     2324    ! Ice water content
     2325    ! ==================
     2326
     2327    rho=pres/temp/RD  ! air density kg/m3
     2328
     2329    Ka=2.4e-2      ! thermal conductivity of the air, SI
     2330    p0=101325.0    ! ref pressure
     2331    T0=273.15      ! ref temp
     2332    rhoi=500.0     ! cloud ice density following Reisner et al. 1998
     2333    alpha=700.     ! fallvelocity param
     2334
     2335
     2336    IF (flag_topthermals) THEN ! uppermost thermals level, solve a third order polynomial with Cardan's method
     2337
     2338    Dv=0.0001*0.211*(p0/pres(ind2))*((temp(ind2)/T0)**1.94) ! water vapor diffusivity in air, SI
     2339
     2340    ! Detrainment term:
     2341    unsurtaudet=detr_therm(ind1,ind2)/rho(ind2)/deltazlev(ind2)
     2342 
     2343    ! vertical flux
     2344   
     2345    flux_term=d_top*fm_therm(ind1,ind2)/deltazlev(ind2)
     2346
     2347    ! Deposition term
     2348    CALL CALC_QSAT_ECMWF(temp(ind2),0.,pres(ind2),RTT,2,.false.,qsi,dqs)
     2349    CALL CALC_QSAT_ECMWF(temp(ind2),0.,pres(ind2),RTT,1,.false.,qsl,dqs)
     2350    AA=RLSTT/Ka/temp(ind2)*(RLSTT/RV/temp(ind2)-1.)
     2351    BB=1./(rho(ind2)*Dv*qsi)
     2352    unsurtaustardep=C_cap*(Ni**0.66)*(qsl-qsi)/qsi*4.*RPI/(AA+BB)*(6.*rho(ind2)/rhoi/RPI/Gamma(4.))**(0.33)
     2353
     2354    ! Riming term  neglected at this level
     2355    !unsurtaurim=rho(ind2)*alpha*3./rhoi/2.*Ei*qlth(ind2)*((p0/pres(ind2))**0.4)
     2356
     2357    qi=rho(ind2)*unsurtaustardep/MAX((rho(ind2)*unsurtaudet-flux_term),1E-12)
     2358    qi=MAX(qi,0.)**(3./2.)
     2359
     2360    ELSE ! other levels, estimate qi(k) from variables at k+1 and k+2
     2361
     2362    Dv=0.0001*0.211*(p0/pres(ind2p1))*((temp(ind2p1)/T0)**1.94) ! water vapor diffusivity in air, SI
     2363
     2364    ! Detrainment term:
     2365
     2366    unsurtaudet=detr_therm(ind1,ind2p1)/rho(ind2p1)/deltazlev(ind2p1)
     2367    det_term=-unsurtaudet*qith(ind2p1)*rho(ind2p1)
     2368   
     2369   
     2370    ! Deposition term
     2371
     2372    CALL CALC_QSAT_ECMWF(temp(ind2p1),0.,pres(ind2p1),RTT,2,.false.,qsi,dqs)
     2373    CALL CALC_QSAT_ECMWF(temp(ind2p1),0.,pres(ind2p1),RTT,1,.false.,qsl,dqs)
     2374    AA=RLSTT/Ka/temp(ind2p1)*(RLSTT/RV/temp(ind2p1)-1.)
     2375    BB=1./(rho(ind2p1)*Dv*qsi)
     2376    unsurtaustardep=C_cap*(Ni**0.66)*(qsl-qsi)/qsi*4.*RPI/(AA+BB)*(6.*rho(ind2p1)/rhoi/RPI/Gamma(4.))**(0.33)
     2377    dep_term=rho(ind2p1)*(qith(ind2p1)**0.33)*unsurtaustardep
     2378 
     2379    ! Riming term
     2380
     2381    unsurtaurim=rho(ind2p1)*alpha*3./rhoi/2.*Ei*qlth(ind2p1)*((p0/pres(ind2p1))**0.4)
     2382    rim_term=rho(ind2p1)*qith(ind2p1)*unsurtaurim
     2383
     2384    ! Precip term
     2385
     2386    !precip_term=-1./deltazlev(ind2p1)*(fraca(ind2p2)*snowf(ind2p2)-fraca(ind2p1)*snowf(ind2p1))
     2387    ! We assume that there is no solid precipitation outside thermals (so no multiplication by fraca)
     2388    precip_term=-1./deltazlev(ind2p1)*(snowf(ind2p2)-snowf(ind2p1))
     2389
     2390    ! Calculation in a top-to-bottom loop
     2391
     2392    IF (fm_therm(ind1,ind2p1) .GT. 0.) THEN
     2393       qi= 1./fm_therm(ind1,ind2p1)* &
     2394          (deltazlev(ind2p1)*(-rim_term-dep_term-det_term-precip_term) + &
     2395          fm_therm(ind1,ind2p2)*(qith(ind2p1)))
     2396    ELSE
     2397       qi=0.
     2398    ENDIF
     2399
     2400    ENDIF ! flag_topthermals
     2401 
     2402    qi=MAX(0.,qi)
     2403
     2404    RETURN
     2405
     2406END SUBROUTINE ICE_MPC_BL_CLOUDS
     2407
     2408
     2409
     2410
    15362411END MODULE cloudth_mod
    15372412

  • LMDZ6/branches/Ocean_skin/libf/phylmd/comsoil.h

    r2915 r4013  
    44
    55      common /comsoil/inertie_sol,inertie_sno,inertie_sic,inertie_lic,  &
    6      &                iflag_sic
     6     &                iflag_sic,iflag_inertie
    77      real inertie_sol,inertie_sno,inertie_sic,inertie_lic
    8       integer iflag_sic
     8      integer iflag_sic,iflag_inertie
    99!$OMP THREADPRIVATE(/comsoil/)

  • LMDZ6/branches/Ocean_skin/libf/phylmd/conf_phys_m.F90

    r3798 r4013  
    1717       iflag_cld_th, &
    1818       iflag_ratqs,ratqsbas,ratqshaut,tau_ratqs, &
    19        ok_ade, ok_aie, ok_alw, ok_cdnc, ok_volcan, aerosol_couple, chemistry_couple, &
    20        flag_aerosol, flag_aerosol_strat, flag_aer_feedback, &
     19       ok_ade, ok_aie, ok_alw, ok_cdnc, ok_volcan, flag_volc_surfstrat, aerosol_couple, &
     20       chemistry_couple, flag_aerosol, flag_aerosol_strat, flag_aer_feedback, &
    2121       flag_bc_internal_mixture, bl95_b0, bl95_b1,&
    2222       read_climoz, &
    … …  
    2727    USE phys_cal_mod
    2828    USE carbon_cycle_mod,  ONLY: carbon_cycle_tr, carbon_cycle_cpl, carbon_cycle_rad, level_coupling_esm
     29    USE carbon_cycle_mod,  ONLY: read_fco2_ocean_cor,var_fco2_ocean_cor
     30    USE carbon_cycle_mod,  ONLY: read_fco2_land_cor,var_fco2_land_cor
    2931    USE mod_grid_phy_lmdz, ONLY: klon_glo
    3032    USE print_control_mod, ONLY: lunout
    … …  
    6567    ! bl95_b*: parameters in the formula to link CDNC to aerosol mass conc
    6668    ! ok_volcan: activate volcanic diags (SW heat & LW cool rate, SW & LW flux)
     69    ! flag_volc_surfstrat: VolMIP flag, activate forcing surface cooling rate (=1), strato heating rate (=2) or nothing (=0, default)
    6770    !
    6871
    … …  
    7780    INTEGER              :: flag_aerosol
    7881    INTEGER              :: flag_aerosol_strat
     82    INTEGER              :: flag_volc_surfstrat
    7983    LOGICAL              :: flag_aer_feedback
    8084    LOGICAL              :: flag_bc_internal_mixture
    … …  
    8892    CHARACTER (len = 8), SAVE  :: aer_type_omp
    8993    INTEGER, SAVE       :: landice_opt_omp
    90     INTEGER, SAVE       :: n_dtis_omp
    91     INTEGER, SAVE       :: iflag_tsurf_inlandsis_omp
    92     INTEGER, SAVE       :: iflag_albzenith_omp   
    93     LOGICAL, SAVE       :: SnoMod_omp,BloMod_omp,ok_outfor_omp
     94    INTEGER, SAVE       :: iflag_tsurf_inlandsis_omp,iflag_temp_inlandsis_omp
     95    INTEGER, SAVE       :: iflag_albcalc_omp,iflag_z0m_snow_omp   
     96    LOGICAL, SAVE       :: SnoMod_omp,BloMod_omp,ok_outfor_omp,ok_zsn_ii_omp
     97    LOGICAL, SAVE       :: discret_xf_omp,opt_runoff_ac_omp 
     98    LOGICAL, SAVE       :: is_ok_slush_omp,is_ok_z0h_rn_omp,is_ok_density_kotlyakov_omp
     99    REAL, SAVE          :: prescribed_z0m_snow_omp,correc_alb_omp
     100    REAL, SAVE          :: buf_sph_pol_omp,buf_siz_pol_omp
    94101    LOGICAL, SAVE       :: ok_newmicro_omp
    95102    LOGICAL, SAVE       :: ok_all_xml_omp
    … …  
    102109    INTEGER, SAVE       :: flag_aerosol_omp
    103110    INTEGER, SAVE       :: flag_aerosol_strat_omp
     111    INTEGER, SAVE       :: flag_volc_surfstrat_omp
    104112    LOGICAL, SAVE       :: flag_aer_feedback_omp
    105113    LOGICAL, SAVE       :: flag_bc_internal_mixture_omp
    … …  
    174182    INTEGER,SAVE :: iflag_cloudth_vert_omp
    175183    INTEGER,SAVE :: iflag_rain_incloud_vol_omp
     184    INTEGER,SAVE :: iflag_vice_omp
    176185    REAL,SAVE :: rad_froid_omp, rad_chau1_omp, rad_chau2_omp
    177186    REAL,SAVE :: t_glace_min_omp, t_glace_max_omp
    178187    REAL,SAVE :: exposant_glace_omp
     188    INTEGER,SAVE :: iflag_gammasat_omp, iflag_mpc_bl_omp
    179189    REAL,SAVE :: rei_min_omp, rei_max_omp
    180     INTEGER,SAVE :: iflag_sic_omp
     190    INTEGER,SAVE :: iflag_sic_omp, iflag_inertie_omp
    181191    REAL,SAVE :: inertie_sol_omp,inertie_sno_omp,inertie_sic_omp
    182192    REAL,SAVE :: inertie_lic_omp
    … …  
    237247    LOGICAL, SAVE :: carbon_cycle_rad_omp
    238248    INTEGER, SAVE :: level_coupling_esm_omp
     249    LOGICAL, SAVE :: read_fco2_ocean_cor_omp
     250    REAL, SAVE    :: var_fco2_ocean_cor_omp
     251    LOGICAL, SAVE :: read_fco2_land_cor_omp
     252    REAL, SAVE    :: var_fco2_land_cor_omp
    239253    LOGICAL, SAVE :: adjust_tropopause_omp
    240254    LOGICAL, SAVE :: ok_daily_climoz_omp
     255    LOGICAL, SAVE :: ok_new_lscp_omp
     256    LOGICAL, SAVE :: ok_icefra_lscp_omp
    241257
    242258    INTEGER, INTENT(OUT):: read_climoz ! read ozone climatology, OpenMP shared
    … …  
    327343    ! Martin et Etienne
    328344    !Config Key  = landice_opt
    329     !Config Desc = which landice snow model (BULK, SISVAT or INLANDSIS)
     345    !Config Desc = which landice snow model (BULK, or INLANDSIS)
    330346    !Config Def  = 0
    331347    landice_opt_omp = 0
    … …  
    334350
    335351    !Etienne
     352    !Config Key  = iflag_temp_inlandsis
     353    !Config Desc = which method to calculate temp within the soil in INLANDSIS
     354    !Config Def  = 0
     355    iflag_temp_inlandsis_omp = 0
     356    CALL getin('iflag_temp_inlandsis', iflag_temp_inlandsis_omp)
     357
     358    !Etienne
    336359    !Config Key  = iflag_tsurf_inlandsis
    337360    !Config Desc = which method to calculate tsurf in INLANDSIS
    338361    !Config Def  = 0
    339     iflag_tsurf_inlandsis_omp = 0
     362    iflag_tsurf_inlandsis_omp = 1
    340363    CALL getin('iflag_tsurf_inlandsis', iflag_tsurf_inlandsis_omp)
    341364
     365
    342366    !Etienne
    343     !Config Key  = iflag_albzenith
    344     !Config Desc = method to account for albedo sensitivity to solar zenith angle
    345     !Config Def  = 0
    346     iflag_albzenith_omp = 0
    347     CALL getin('iflag_albzenith', iflag_albzenith_omp)
    348 
    349     !Etienne
    350     !Config Key  = n_dtis
    351     !Config Desc = number of subtimesteps for INLANDSIS
    352     !Config Def  = 1
    353     n_dtis_omp = 1
    354     CALL getin('n_dtis', n_dtis_omp)
     367    !Config Key  = iflag_albcalc
     368    !Config Desc = method to calculate snow albedo in INLANDSIS
     369    !Config Def  = 0
     370    iflag_albcalc_omp = 0
     371    CALL getin('iflag_albcalc', iflag_albcalc_omp)
     372
    355373
    356374    !Etienne
    357375    !Config Key  = SnoMod
    358376    !Config Desc = activation of snow modules in inlandsis
    359     !Config Def  = 1
     377    !Config Def  = .TRUE.
    360378    SnoMod_omp = .TRUE.
    361379    CALL getin('SnoMod', SnoMod_omp)
    … …  
    364382    !Config Key  = BloMod
    365383    !Config Desc = activation of blowing snow in inlandsis
    366     !Config Def  = 1
     384    !Config Def  = .FALSE.
    367385    BloMod_omp = .FALSE.
    368386    CALL getin('BloMod', BloMod_omp)
    … …  
    371389    !Config Key  = ok_outfor
    372390    !Config Desc = activation of output ascii file in inlandsis
    373     !Config Def  = 1
    374    ok_outfor_omp = .FALSE.
     391    !Config Def  = .FALSE.
     392    ok_outfor_omp = .FALSE.
    375393    CALL getin('ok_outfor', ok_outfor_omp)
    376394
    377395
     396    !Etienne
     397    !Config Key  = ok_sn_ii
     398    !Config Desc = activation of ice/snow detection
     399    !Config Def  = .TRUE.
     400    ok_zsn_ii_omp = .TRUE.
     401    CALL getin('ok_zsn_ii', ok_zsn_ii_omp)
     402
     403
     404    !Etienne
     405    !Config Key  = discret_xf
     406    !Config Desc = snow discretization following XF
     407    !Config Def  = .TRUE.
     408    discret_xf_omp = .TRUE.
     409    CALL getin('discret_xf', discret_xf_omp)
     410
     411
     412    !Etienne
     413    !Config Key  = is_ok_slush
     414    !Config Desc = activation of the slush option
     415    !Config Def  = .TRUE.
     416    is_ok_slush_omp = .TRUE.
     417    CALL getin('is_ok_slush', is_ok_slush_omp)
     418
     419    !Etienne
     420    !Config Key  = opt_runoff_ac
     421    !Config Desc = option runoff AC
     422    !Config Def  = .TRUE.
     423    opt_runoff_ac_omp = .TRUE.
     424    CALL getin('opt_runoff_ac', opt_runoff_ac_omp)
     425
     426    !Etienne
     427    !Config Key  = is_ok_z0h_rn
     428    !Config Desc = z0h calculation following RN method
     429    !Config Def  = .TRUE.
     430    is_ok_z0h_rn_omp = .TRUE.
     431    CALL getin('is_ok_z0h_rn', is_ok_z0h_rn_omp)
     432
     433
     434    !Etienne
     435    !Config Key  = is_ok_density_kotlyakov
     436    !Config Desc = snow density calculation following kotlyakov
     437    !Config Def  = .FALSE.
     438    is_ok_density_kotlyakov_omp = .FALSE.
     439    CALL getin('is_ok_density_kotlyakov', is_ok_density_kotlyakov_omp)
     440
     441
     442    !Etienne
     443    !Config Key  = prescribed_z0m_snow
     444    !Config Desc = prescribed snow z0m
     445    !Config Def  = 0.005
     446    prescribed_z0m_snow_omp = 0.005
     447    CALL getin('prescribed_z0m_snow', prescribed_z0m_snow_omp)
     448
     449
     450    !Etienne
     451    !Config Key  = iflag_z0m_snow
     452    !Config Desc = method to calculate snow z0m
     453    !Config Def  = 0
     454    iflag_z0m_snow_omp = 0
     455    CALL getin('iflag_z0m_snow', iflag_z0m_snow_omp)
     456
     457
     458    !Etienne
     459    !Config Key  = correc_alb
     460    !Config Desc = correction term for albedo
     461    !Config Def  = 1.01
     462    correc_alb_omp=1.01
     463    CALL getin('correc_alb', correc_alb_omp)
     464
     465
     466    !Etienne
     467    !Config Key  = buf_sph_pol
     468    !Config Desc = sphericity of buffer layer in polar regions
     469    !Config Def  = 99.
     470    buf_sph_pol_omp=99.
     471    CALL getin('buf_sph_pol', buf_sph_pol_omp)
     472
     473    !Etienne
     474    !Config Key  = buf_siz_pol
     475    !Config Desc = grain size of buffer layer in polar regions in e-4m
     476    !Config Def  = 4.
     477    buf_siz_pol_omp=4.
     478    CALL getin('buf_siz_pol', buf_siz_pol_omp)
    378479
    379480    !==================================================================
    … …  
    457558    ok_volcan_omp = .FALSE.
    458559    CALL getin('ok_volcan', ok_volcan_omp)
     560
     561    !
     562    !Config Key  = flag_volc_surfstrat
     563    !Config Desc = impose cooling rate at the surface (=1),
     564    !              heating rate in the strato (=2), or nothing (=0)
     565    !Config Def  = 0
     566    !Config Help = Used in radlwsw_m.F
     567    !
     568    flag_volc_surfstrat_omp = 0 ! NL: SURFSTRAT
     569    CALL getin('flag_volc_surfstrat', flag_volc_surfstrat_omp)
    459570
    460571    !
    … …  
    12311342    CALL getin('iflag_sic',iflag_sic_omp)
    12321343    !
     1344    !Config Key  = iflag_inertie
     1345    !Config Desc =
     1346    !Config Def  = 0
     1347    !Config Help =
     1348    !
     1349    iflag_inertie_omp = 0
     1350    CALL getin('iflag_inertie',iflag_inertie_omp)
     1351    !
    12331352    !Config Key  = inertie_sic
    12341353    !Config Desc = 
    … …  
    13181437
    13191438    !
     1439    !Config Key  = iflag_gammasat
     1440    !Config Desc = 
     1441    !Config Def  = 0
     1442    !Config Help =
     1443    !
     1444    iflag_gammasat_omp=0
     1445    CALL getin('iflag_gammasat',iflag_gammasat_omp)
     1446
     1447
     1448    !
     1449    !Config Key  = iflag_mpc_bl
     1450    !Config Desc =
     1451    !Config Def  = 0
     1452    !Config Help =
     1453    !
     1454    iflag_mpc_bl_omp=0
     1455    CALL getin('iflag_mpc_bl',iflag_mpc_bl_omp)
     1456
     1457
     1458
     1459    !
    13201460    !Config Key  = iflag_t_glace
    13211461    !Config Desc = 
    … …  
    13431483    iflag_rain_incloud_vol_omp = 0
    13441484    CALL getin('iflag_rain_incloud_vol',iflag_rain_incloud_vol_omp)
     1485
     1486    !
     1487    !Config Key  = iflag_vice
     1488    !Config Desc = 
     1489    !Config Def  = 0
     1490    !Config Help =
     1491    !
     1492    iflag_vice_omp = 0
     1493    CALL getin('iflag_vice',iflag_vice_omp)
     1494
     1495
    13451496
    13461497    !
    … …  
    21982349    !Config Help = .FALSE. ensure much fewer (no calendar dependency)
    21992350    !  and lighter monthly climoz files, inetrpolated in time at gcm run time.
    2200     !
     2351   
     2352    ok_new_lscp_omp = .FALSE.
     2353    CALL getin('ok_new_lscp', ok_new_lscp_omp)
     2354    !
     2355    !Config Key  = ok_new_lscp_omp
     2356    !Config Desc = new cloud scheme ith ice and mixed phase (Etienne and JB)
     2357    !Config Def  = .FALSE.
     2358    !Config Help = ...
     2359
     2360
     2361
     2362    ok_icefra_lscp_omp = .FALSE.
     2363    CALL getin('ok_icefra_lscp', ok_icefra_lscp_omp)
     2364    !
     2365    !Config Key  = ok_icefra_lscp_omp
     2366    !Config Desc = ice fraction in radiation from lscp
     2367    !Config Def  = .FALSE.
     2368    !Config Help = ...
     2369
     2370
     2371
     2372
    22012373    ecrit_LES_omp = 1./8.
    22022374    CALL getin('ecrit_LES', ecrit_LES_omp)
    … …  
    22142386    CALL getin('carbon_cycle_rad',carbon_cycle_rad_omp)
    22152387
    2216     ! >> PC
     2388    read_fco2_ocean_cor_omp=.FALSE.
     2389    CALL getin('read_fco2_ocean_cor',read_fco2_ocean_cor_omp)
     2390
     2391    var_fco2_ocean_cor_omp=0. ! default value
     2392    CALL getin('var_fco2_ocean_cor',var_fco2_ocean_cor_omp)
     2393
     2394    read_fco2_land_cor_omp=.FALSE.
     2395    CALL getin('read_fco2_land_cor',read_fco2_land_cor_omp)
     2396
     2397    var_fco2_land_cor_omp=0. ! default value
     2398    CALL getin('var_fco2_land_cor',var_fco2_land_cor_omp)
     2399
    22172400    ! level_coupling_esm : level of coupling of the biogeochemical fields between LMDZ, ORCHIDEE and NEMO
    22182401    ! Definitions of level_coupling_esm in physiq.def
    … …  
    22272410    level_coupling_esm_omp=0 ! default value
    22282411    CALL getin('level_coupling_esm',level_coupling_esm_omp)
    2229     ! << PC
    22302412
    22312413    !$OMP END MASTER
    … …  
    22912473    albsno0 = albsno0_omp
    22922474    iflag_sic = iflag_sic_omp
     2475    iflag_inertie = iflag_inertie_omp
    22932476    inertie_sol = inertie_sol_omp
    22942477    inertie_sic = inertie_sic_omp
    … …  
    23012484    t_glace_max = t_glace_max_omp
    23022485    exposant_glace = exposant_glace_omp
     2486    iflag_gammasat=iflag_gammasat_omp
     2487    iflag_mpc_bl=iflag_mpc_bl_omp
    23032488    iflag_t_glace = iflag_t_glace_omp
    23042489    iflag_cloudth_vert=iflag_cloudth_vert_omp
    23052490    iflag_rain_incloud_vol=iflag_rain_incloud_vol_omp
     2491    iflag_vice=iflag_vice_omp
    23062492    iflag_ice_thermo = iflag_ice_thermo_omp
    23072493    rei_min = rei_min_omp
    … …  
    23442530       ok_veget=.FALSE.
    23452531    ENDIF
    2346     ! SISVAT and INLANDSIS
     2532    ! INLANDSIS
    23472533    !=================================================
    23482534    landice_opt = landice_opt_omp
    23492535    iflag_tsurf_inlandsis = iflag_tsurf_inlandsis_omp
    2350     iflag_albzenith = iflag_albzenith_omp
    2351     n_dtis=n_dtis_omp
     2536    iflag_temp_inlandsis = iflag_temp_inlandsis_omp
     2537    iflag_albcalc = iflag_albcalc_omp
    23522538    SnoMod=SnoMod_omp
    23532539    BloMod=BloMod_omp
    23542540    ok_outfor=ok_outfor_omp
     2541    is_ok_slush=is_ok_slush_omp
     2542    opt_runoff_ac=opt_runoff_ac_omp
     2543    is_ok_z0h_rn=is_ok_z0h_rn_omp
     2544    is_ok_density_kotlyakov=is_ok_density_kotlyakov_omp
     2545    prescribed_z0m_snow=prescribed_z0m_snow_omp
     2546    correc_alb=correc_alb_omp
     2547    iflag_z0m_snow=iflag_z0m_snow_omp
     2548    ok_zsn_ii=ok_zsn_ii_omp
     2549    discret_xf=discret_xf_omp
     2550    buf_sph_pol=buf_sph_pol_omp
     2551    buf_siz_pol=buf_siz_pol_omp
    23552552    !=================================================
    23562553    ok_all_xml = ok_all_xml_omp
    … …  
    23702567    ok_cdnc = ok_cdnc_omp
    23712568    ok_volcan = ok_volcan_omp
     2569    flag_volc_surfstrat = flag_volc_surfstrat_omp
    23722570    aerosol_couple = aerosol_couple_omp
    23732571    chemistry_couple = chemistry_couple_omp
    2374     flag_aerosol=flag_aerosol_omp
    2375     flag_aerosol_strat=flag_aerosol_strat_omp
    2376     flag_aer_feedback=flag_aer_feedback_omp
     2572    flag_aerosol = flag_aerosol_omp
     2573    flag_aerosol_strat = flag_aerosol_strat_omp
     2574    flag_aer_feedback = flag_aer_feedback_omp
    23772575    flag_bc_internal_mixture=flag_bc_internal_mixture_omp
    23782576    aer_type = aer_type_omp
    … …  
    24932691    carbon_cycle_rad = carbon_cycle_rad_omp
    24942692    level_coupling_esm = level_coupling_esm_omp
     2693    ok_new_lscp = ok_new_lscp_omp
     2694    ok_icefra_lscp=ok_icefra_lscp_omp
     2695    read_fco2_ocean_cor = read_fco2_ocean_cor_omp
     2696    var_fco2_ocean_cor = var_fco2_ocean_cor_omp
     2697    read_fco2_land_cor = read_fco2_land_cor_omp
     2698    var_fco2_land_cor = var_fco2_land_cor_omp
    24952699
    24962700    ! Test of coherence between type_ocean and version_ocean
    … …  
    25152719      ENDIF
    25162720    ELSE IF (iflag_rrtm .EQ. 1) THEN
     2721      IF (NSW.NE.2.AND.NSW.NE.4.AND.NSW.NE.6) THEN
     2722        WRITE(lunout,*) ' ERROR iflag_rrtm=1 and NSW<>2,4,6 not possible'
     2723        CALL abort_physic('conf_phys','choice NSW not valid',1)
     2724      ENDIF
     2725   ELSE IF (iflag_rrtm .EQ. 2) THEN
    25172726      IF (NSW.NE.2.AND.NSW.NE.4.AND.NSW.NE.6) THEN
    25182727        WRITE(lunout,*) ' ERROR iflag_rrtm=1 and NSW<>2,4,6 not possible'
    … …  
    25902799       CALL abort_physic('conf_phys', 'flag_bc_internal_mixture can only be activated with flag_aerosol=6',1)
    25912800    ENDIF
     2801
     2802    ! test sur flag_volc_surfstrat
     2803    IF (flag_volc_surfstrat.LT.0.OR.flag_volc_surfstrat.GT.2) THEN
     2804       CALL abort_physic('conf_phys', 'flag_volc_surfstrat can only be 0 1 or 2',1)
     2805    ENDIF
     2806    IF ((.NOT.ok_volcan.OR..NOT.ok_ade.OR..NOT.ok_aie).AND.flag_volc_surfstrat.GT.0) THEN
     2807       CALL abort_physic('conf_phys', 'ok_ade, ok_aie, ok_volcan need to be activated if flag_volc_surfstrat is 1 or 2',1)
     2808    ENDIF
    25922809
    25932810    ! Test on carbon cycle
    … …  
    26942911    WRITE(lunout,*) ' t_glace_max = ',t_glace_max
    26952912    WRITE(lunout,*) ' exposant_glace = ',exposant_glace
     2913    WRITE(lunout,*) ' iflag_gammasat = ',iflag_gammasat
     2914    WRITE(lunout,*) ' iflag_mpc_bl = ',iflag_mpc_bl
    26962915    WRITE(lunout,*) ' iflag_t_glace = ',iflag_t_glace
    26972916    WRITE(lunout,*) ' iflag_cloudth_vert = ',iflag_cloudth_vert
    26982917    WRITE(lunout,*) ' iflag_rain_incloud_vol = ',iflag_rain_incloud_vol
     2918    WRITE(lunout,*) ' iflag_vice = ',iflag_vice
    26992919    WRITE(lunout,*) ' iflag_ice_thermo = ',iflag_ice_thermo
    27002920    WRITE(lunout,*) ' rei_min = ',rei_min
    … …  
    27122932    WRITE(lunout,*) ' ok_ade = ',ok_ade
    27132933    WRITE(lunout,*) ' ok_volcan = ',ok_volcan
     2934    WRITE(lunout,*) ' flag_volc_surfstrat = ',flag_volc_surfstrat
    27142935    WRITE(lunout,*) ' ok_aie = ',ok_aie
    27152936    WRITE(lunout,*) ' ok_alw = ',ok_alw
    … …  
    27572978    WRITE(lunout,*) ' albsno0 = ', albsno0
    27582979    WRITE(lunout,*) ' iflag_sic = ', iflag_sic
     2980    WRITE(lunout,*) ' iflag_inertie = ', iflag_inertie
    27592981    WRITE(lunout,*) ' inertie_sol = ', inertie_sol
    27602982    WRITE(lunout,*) ' inertie_sic = ', inertie_sic
    … …  
    28073029    WRITE(lunout,*) ' adjust_tropopause = ', adjust_tropopause
    28083030    WRITE(lunout,*) ' ok_daily_climoz = ',ok_daily_climoz
     3031    WRITE(lunout,*) ' ok_new_lscp = ', ok_new_lscp
     3032    WRITE(lunout,*) ' ok_icefra_lscp = ', ok_icefra_lscp
    28093033    WRITE(lunout,*) ' read_climoz = ', read_climoz
    28103034    WRITE(lunout,*) ' carbon_cycle_tr = ', carbon_cycle_tr
    … …  
    28123036    WRITE(lunout,*) ' carbon_cycle_rad = ', carbon_cycle_rad
    28133037    WRITE(lunout,*) ' level_coupling_esm = ', level_coupling_esm
     3038    WRITE(lunout,*) ' read_fco2_ocean_cor = ', read_fco2_ocean_cor
     3039    WRITE(lunout,*) ' var_fco2_ocean_cor = ', var_fco2_ocean_cor
     3040    WRITE(lunout,*) ' read_fco2_land_cor = ', read_fco2_land_cor
     3041    WRITE(lunout,*) ' var_fco2_land_cor = ', var_fco2_land_cor
    28143042    WRITE(lunout,*) ' iflag_tsurf_inlandsis = ', iflag_tsurf_inlandsis
    2815     WRITE(lunout,*) ' iflag_albzenith = ', iflag_albzenith
    2816     WRITE(lunout,*) ' n_dtis = ', n_dtis
     3043    WRITE(lunout,*) ' iflag_temp_inlandsis = ', iflag_temp_inlandsis
     3044    WRITE(lunout,*) ' iflag_albcalc = ', iflag_albcalc
    28173045    WRITE(lunout,*) ' SnoMod = ', SnoMod
    28183046    WRITE(lunout,*) ' BloMod = ', BloMod
    28193047    WRITE(lunout,*) ' ok_outfor = ', ok_outfor
    2820 
     3048    WRITE(lunout,*) ' is_ok_slush = ', is_ok_slush
     3049    WRITE(lunout,*) ' opt_runoff_ac = ', opt_runoff_ac
     3050    WRITE(lunout,*) ' is_ok_z0h_rn = ', is_ok_z0h_rn
     3051    WRITE(lunout,*) ' is_ok_density_kotlyakov = ', is_ok_density_kotlyakov
     3052    WRITE(lunout,*) ' prescribed_z0m_snow = ', prescribed_z0m_snow
     3053    WRITE(lunout,*) ' iflag_z0m_snow = ', iflag_z0m_snow
     3054    WRITE(lunout,*) ' ok_zsn_ii = ', ok_zsn_ii
     3055    WRITE(lunout,*) ' discret_xf = ', discret_xf
     3056    WRITE(lunout,*) ' correc_alb= ', correc_alb
     3057    WRITE(lunout,*) ' buf_sph_pol = ', buf_sph_pol
     3058    WRITE(lunout,*) ' buf_siz_pol= ', buf_siz_pol
    28213059
    28223060    !$OMP END MASTER

  • LMDZ6/branches/Ocean_skin/libf/phylmd/create_etat0_unstruct.F90

    r3605 r4013  
    209209    z0m(:,is_oce) = rugmer(:)
    210210
    211    z0m(:,is_ter) = MAX(1.0e-05,zstd(:)*zsig(:)/2.0)
    212    z0m(:,is_lic) = MAX(1.0e-05,zstd(:)*zsig(:)/2.0)
     211   z0m(:,is_ter) = 0.01 ! MAX(1.0e-05,zstd(:)*zsig(:)/2.0)
     212   z0m(:,is_lic) = 0.001 !MAX(1.0e-05,zstd(:)*zsig(:)/2.0)
    213213
    214214   z0m(:,is_sic) = 0.001

  • LMDZ6/branches/Ocean_skin/libf/phylmd/dimsoil.h

    r3798 r4013  
    88
    99      INTEGER nsnowmx
    10       PARAMETER (nsnowmx=35)
     10      PARAMETER (nsnowmx=30)
    1111     
    1212      INTEGER nsismx
    13       PARAMETER (nsismx=46)
     13      PARAMETER (nsismx=41)
    1414
    1515! nsismx should be equal to nsoilmx+nsnowmx

  • LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/compar1d.h

    r3605 r4013  
    88      real :: nat_surf
    99      real :: tsurf
     10      real :: beta_surf
    1011      real :: rugos
    1112      real :: rugosh
    … …  
    4546      real    :: p_nudging_u, p_nudging_v, p_nudging_w, p_nudging_t, p_nudging_qv
    4647      common/com_par1d/                                                 &
    47      & nat_surf,tsurf,rugos,rugosh,                                     &
     48     & nat_surf,tsurf,beta_surf,rugos,rugosh,                           &
    4849     & xqsol,qsurf,psurf,zsurf,albedo,time,time_ini,xlat,xlon,airefi,   &
    4950     & wtsurf,wqsurf,restart_runoff,xagesno,qsolinp,zpicinp,            &

  • LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/old_lmdz1d.F90

    r3798 r4013  
    1111       du_gwd_rando, du_gwd_front, entr_therm, f0, fm_therm, &
    1212       falb_dir, falb_dif, &
    13        ftsol, pbl_tke, pctsrf, radsol, rain_fall, snow_fall, ratqs, &
     13       ftsol, beta_aridity, pbl_tke, pctsrf, radsol, rain_fall, snow_fall, ratqs, &
    1414       rnebcon, rugoro, sig1, w01, solaire_etat0, sollw, sollwdown, &
    15        solsw, t_ancien, q_ancien, u_ancien, v_ancien, wake_cstar, &
     15       solsw, solswfdiff, t_ancien, q_ancien, u_ancien, v_ancien, &
    1616       wake_delta_pbl_TKE, delta_tsurf, wake_fip, wake_pe, &
    1717       wake_deltaq, wake_deltat, wake_s, wake_dens, &
     18       awake_dens, cv_gen, wake_cstar, &
    1819       zgam, zmax0, zmea, zpic, zsig, &
    1920       zstd, zthe, zval, ale_bl, ale_bl_trig, alp_bl, ql_ancien, qs_ancien, &
    … …  
    656657      qsol = qsolinp
    657658      qsurf = fq_sat(tsurf,psurf/100.)
     659      beta_surf = 1.
     660      beta_aridity(:,:) = beta_surf
    658661      day1= day_ini
    659662      time=daytime-day
    … …  
    795798
    796799        fder=0.
     800        snsrf(1,:)=snowmass ! masse de neige des sous surface
    797801        print *, 'snsrf', snsrf
    798         snsrf(1,:)=snowmass ! masse de neige des sous surface
    799802        qsurfsrf(1,:)=qsurf ! humidite de l'air des sous surface
    800803        fevap=0.
    … …  
    878881        snow_fall=0.
    879882        solsw=0.
     883        solswfdiff=0.
    880884        sollw=0.
    881885        sollwdown=rsigma*tsurf**4
    … …  
    893897        sig1=0.
    894898        w01=0.
    895         wake_cstar = 0.
     899!
    896900        wake_deltaq = 0.
    897901        wake_deltat = 0.
    … …  
    902906        wake_s = 0.
    903907        wake_dens = 0.
     908        awake_dens = 0.
     909        cv_gen = 0.
     910        wake_cstar = 0.
    904911        ale_bl = 0.
    905912        ale_bl_trig = 0.
    … …  
    926933! pctsrf(:,is_sic),ftsol(:,nsrf),tsoil(:,isoil,nsrf),qsurf(:,nsrf)
    927934! qsol,falb_dir(:,nsrf),falb_dif(:,nsrf),evap(:,nsrf),snow(:,nsrf)
    928 ! radsol,solsw,sollw, sollwdown,fder,rain_fall,snow_fall,frugs(:,nsrf)
     935! radsol,solsw,solswfdiff,sollw, sollwdown,fder,rain_fall,snow_fall,frugs(:,nsrf)
    929936! agesno(:,nsrf),zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro
    930937! t_ancien,q_ancien,,frugs(:,is_oce),clwcon(:,1),rnebcon(:,1),ratqs(:,1)
    931938! run_off_lic_0,pbl_tke(:,1:klev,nsrf), zmax0,f0,sig1,w01
    932 ! wake_deltat,wake_deltaq,wake_s,wake_dens,wake_cstar,
     939! wake_deltat,wake_deltaq,wake_s,wake_dens,awake_dens,cv_gen,wake_cstar,
    933940! wake_fip,wake_delta_pbl_tke(:,1:klev,nsrf)
    934941!
    … …  
    10261033!
    10271034!=====================================================================
    1028        CALL iophys_ini
     1035       CALL iophys_ini(timestep)
    10291036! START OF THE TEMPORAL LOOP :
    10301037!=====================================================================

  • LMDZ6/branches/Ocean_skin/libf/phylmd/dyn1d/scm.F90

    r3798 r4013  
    77       du_gwd_rando, du_gwd_front, entr_therm, f0, fm_therm, &
    88       falb_dir, falb_dif, &
    9        ftsol, pbl_tke, pctsrf, radsol, rain_fall, snow_fall, ratqs, &
     9       ftsol, beta_aridity, pbl_tke, pctsrf, radsol, rain_fall, snow_fall, ratqs, &
    1010       rnebcon, rugoro, sig1, w01, solaire_etat0, sollw, sollwdown, &
    11        solsw, t_ancien, q_ancien, u_ancien, v_ancien, wake_cstar, &
     11       solsw, solswfdiff, t_ancien, q_ancien, u_ancien, v_ancien, &
    1212       wake_delta_pbl_TKE, delta_tsurf, wake_fip, wake_pe, &
    1313       wake_deltaq, wake_deltat, wake_s, wake_dens, &
     14       awake_dens, cv_gen, wake_cstar, &
    1415       zgam, zmax0, zmea, zpic, zsig, &
    1516       zstd, zthe, zval, ale_bl, ale_bl_trig, alp_bl, ql_ancien, qs_ancien, &
    … …  
    429430      qsol = qsolinp
    430431      qsurf = fq_sat(tsurf,psurf/100.)
     432      beta_aridity(:,:) = beta_surf
    431433      day1= day_ini
    432434      time=daytime-day
    … …  
    644646        snow_fall=0.
    645647        solsw=0.
     648        solswfdiff=0.
    646649        sollw=0.
    647650        sollwdown=rsigma*tsurf**4
    … …  
    659662        sig1=0.
    660663        w01=0.
    661         wake_cstar = 0.
     664!
    662665        wake_deltaq = 0.
    663666        wake_deltat = 0.
    … …  
    668671        wake_s = 0.
    669672        wake_dens = 0.
     673        awake_dens = 0.
     674        cv_gen = 0.
     675        wake_cstar = 0.
    670676        ale_bl = 0.
    671677        ale_bl_trig = 0.
    … …  
    692698! pctsrf(:,is_sic),ftsol(:,nsrf),tsoil(:,isoil,nsrf),qsurf(:,nsrf)
    693699! qsol,falb_dir(:,nsrf),falb_dif(:,nsrf),evap(:,nsrf),snow(:,nsrf)
    694 ! radsol,solsw,sollw, sollwdown,fder,rain_fall,snow_fall,frugs(:,nsrf)
     700! radsol,solsw,solswfdiff,sollw, sollwdown,fder,rain_fall,snow_fall,frugs(:,nsrf)
    695701! agesno(:,nsrf),zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro
    696702! t_ancien,q_ancien,,frugs(:,is_oce),clwcon(:,1),rnebcon(:,1),ratqs(:,1)
    697703! run_off_lic_0,pbl_tke(:,1:klev,nsrf), zmax0,f0,sig1,w01
    698 ! wake_deltat,wake_deltaq,wake_s,wake_dens,wake_cstar,
     704! wake_deltat,wake_deltaq,wake_s,wake_dens,awake_dens,cv_gen,wake_cstar,
    699705! wake_fip,wake_delta_pbl_tke(:,1:klev,nsrf)
    700706!
    … …  
    783789!=====================================================================
    784790#ifdef OUTPUT_PHYS_SCM
    785        CALL iophys_ini
     791       CALL iophys_ini(timestep)
    786792#endif
    787793

  • LMDZ6/branches/Ocean_skin/libf/phylmd/fisrtilp.F90

    r3605 r4013  
    1 !
    21! $Id$
    32!
    … …  
    107106  !$OMP THREADPRIVATE(seuil_neb)
    108107
     108  !<LTP
     109  REAL smallestreal
     110  REAL, SAVE :: rain_int_min=0.001 !intensité locale minimum pour la pluie avant diminution de la fraction précipitante associée = 0.001 mm/s
     111  !>LTP 
     112  !$OMP THREADPRIVATE(rain_int_min)
     113
    109114
    110115  INTEGER ninter ! sous-intervals pour la precipitation
    … …  
    149154  REAL qcloud(klon)
    150155 
    151   REAL zrfl(klon), zrfln(klon), zqev, zqevt
     156  REAL zrfl(klon), zrfln(klon), zqev, zqevt
     157!<LTP
     158  REAL zrflclr(klon), zrflcld(klon)
     159  REAL d_zrfl_clr_cld(klon), d_zifl_clr_cld(klon)
     160  REAL d_zrfl_cld_clr(klon), d_zifl_cld_clr(klon)
     161!>LTP
     162
    152163  REAL zifl(klon), zifln(klon), zqev0,zqevi, zqevti
     164!<LTP
     165  REAL ziflclr(klon), ziflcld(klon)
     166!>LTP
    153167  REAL zoliq(klon), zcond(klon), zq(klon), zqn(klon), zdelq
    154168  REAL zoliqp(klon), zoliqi(klon)
    … …  
    161175  REAL zdz(klon),zrho(klon),ztot      , zrhol(klon)
    162176  REAL zchau      ,zfroi      ,zfice(klon),zneb(klon),znebprecip(klon)
     177!<LTP
     178  REAL znebprecipclr(klon), znebprecipcld(klon)
     179  REAL tot_zneb(klon), tot_znebn(klon), d_tot_zneb(klon)
     180  REAL d_znebprecip_clr_cld(klon), d_znebprecip_cld_clr(klon)
     181!>LTP
     182
    163183  REAL zmelt, zpluie, zice
    164184  REAL dzfice(klon)
    … …  
    219239!  ice_thermo = iflag_ice_thermo .GE. 1
    220240
     241 
    221242  itap=itap+1
    222243  znebprecip(:)=0.
     244
     245!<LTP
     246  smallestreal=1.e-9
     247  znebprecipclr(:)=0.
     248  znebprecipcld(:)=0.
     249!>LTP
    223250
    224251  ice_thermo = (iflag_ice_thermo .EQ. 1).OR.(iflag_ice_thermo .GE. 3)
    … …  
    232259     CALL getin_p('iflag_evap_prec',iflag_evap_prec)
    233260     CALL getin_p('seuil_neb',seuil_neb)
     261!<LTP   
     262     CALL getin_p('rain_int_min',rain_int_min)
     263!>LTP
    234264     write(lunout,*)' iflag_oldbug_fisrtilp =',iflag_oldbug_fisrtilp
    235265     !
    236266     WRITE(lunout,*) 'fisrtilp, ninter:', ninter
    237267     WRITE(lunout,*) 'fisrtilp, iflag_evap_prec:', iflag_evap_prec
     268!<LTP   
     269     WRITE(lunout,*) 'fisrtilp, rain_int_min:', rain_int_min
     270!>LTP   
    238271     WRITE(lunout,*) 'fisrtilp, cpartiel:', cpartiel
     272     WRITE(lunout,*) 'FISRTILP VERSION LUDO'
    239273     
    240274     IF (ABS(dtime/REAL(ninter)-360.0).GT.0.001) THEN
    … …  
    303337
    304338  !cdir collapse
     339
    305340  DO k = 1, klev
    306341     DO i = 1, klon
    … …  
    326361     zrfl(i) = 0.0
    327362     zifl(i) = 0.0
     363!<LTP
     364     zrflclr(i) = 0.0
     365     ziflclr(i) = 0.0
     366     zrflcld(i) = 0.0
     367     ziflcld(i) = 0.0
     368     tot_zneb(i) = 0.0
     369     tot_znebn(i) = 0.0
     370     d_tot_zneb(i) = 0.0
     371!>LTP
     372
    328373     zneb(i) = seuil_neb
    329374  ENDDO
    … …  
    492537!      ================================
    493538        DO i = 1, klon
     539
     540
    494541!AJ<
    495542!        S'il y a des precipitations
    496543         IF (zrfl(i)+zifl(i).GT.0.) THEN
     544
     545        !LTP<
     546        !On ne tient compte que du flux de précipitation en ciel clair dans le calcul de l'évaporation.
     547                IF (iflag_evap_prec==4) THEN
     548                        zrfl(i) = zrflclr(i)
     549                        zifl(i) = ziflclr(i)
     550                ENDIF
     551       
     552        !>LTP
    497553
    498554         IF (iflag_evap_prec==1) THEN
    … …  
    501557            znebprecip(i)=MAX(zneb(i),znebprecip(i))
    502558         ENDIF
    503      
     559         
     560         IF (iflag_evap_prec==4) THEN
     561        ! Evap max pour ne pas saturer toute la maille
     562         zqev0 = MAX (0.0, zqs(i)-zq(i))
     563         ELSE
    504564        ! Evap max pour ne pas saturer la fraction sous le nuage
    505565         zqev0 = MAX (0.0, (zqs(i)-zq(i))*znebprecip(i) )
     566         ENDIF
    506567
    507568         !JAM
    … …  
    523584              *SQRT(zrfl(i)/max(1.e-4,znebprecip(i))) &
    524585              *(paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
    525          ELSE
     586!<LTP
     587         ELSE IF (iflag_evap_prec==4) THEN
     588         zqevt = znebprecipclr(i)*coef_eva*(1.0-zq(i)/qsl) &
     589              *SQRT(zrfl(i)/max(1.e-8,znebprecipclr(i))) &
     590              *(paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
     591!>LTP
     592        ELSE
    526593         zqevt = 1.*coef_eva*(1.0-zq(i)/qsl)*SQRT(zrfl(i)) &
    527594              *(paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
    … …  
    544611              *SQRT(zifl(i)/max(1.e-4,znebprecip(i))) &
    545612              *(paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
     613!<LTP
     614         ELSE IF (iflag_evap_prec==4) THEN
     615         zqevti = znebprecipclr(i)*coef_eva*(1.0-zq(i)/qsi) &
     616              *SQRT(zifl(i)/max(1.e-8,znebprecipclr(i))) &
     617              *(paprs(i,k)-paprs(i,k+1))/pplay(i,k)*zt(i)*RD/RG
     618!>LTP
    546619         ELSE
    547620         zqevti = 1.*coef_eva*(1.0-zq(i)/qsi)*SQRT(zifl(i)) &
    … …  
    551624              *RG*dtime/(paprs(i,k)-paprs(i,k+1))   
    552625
     626       
    553627        !JAM
    554628        ! Limitation de l'evaporation. On s'assure qu'on ne sature pas
    … …  
    573647             ENDIF
    574648         ENDIF
     649
    575650         ! Nouveaux flux de precip liquide et solide
    576651         zrfln(i) = Max(0.,zrfl(i) - zqev*(paprs(i,k)-paprs(i,k+1)) &
    … …  
    602677         zrfl(i) = zrfln(i)
    603678         zifl(i) = zifln(i)
     679
     680!<LTP
     681        IF (iflag_evap_prec==4) THEN
     682                zrflclr(i) = zrfl(i)
     683                ziflclr(i) = zifl(i)   
     684                IF(zrflclr(i) + ziflclr(i) .LE. 0) THEN
     685                        znebprecipclr(i) = 0.
     686                ENDIF   
     687                zrfl(i) = zrflclr(i) + zrflcld(i)
     688                zifl(i) = ziflclr(i) + ziflcld(i)
     689        ENDIF
     690!>LTP       
     691
     692
    604693!        print*,'REEVAP ',itap,k,znebprecip(1),zqev0,zqev,zqevi,zrfl(1)
    605694
    … …  
    612701           zmelt = MIN(MAX(zmelt,0.),1.)
    613702           ! Fusion de la glace
    614            zrfl(i)=zrfl(i)+zmelt*zifl(i)
     703!<LTP
     704           IF (iflag_evap_prec==4) THEN
     705                   zrflclr(i)=zrflclr(i)+zmelt*ziflclr(i)
     706                   zrflcld(i)=zrflcld(i)+zmelt*ziflcld(i)
     707                   zrfl(i)=zrflclr(i)+zrflcld(i)
     708!>LTP       
     709           ELSE
     710                   zrfl(i)=zrfl(i)+zmelt*zifl(i)
     711           ENDIF
    615712           if (fl_cor_ebil .LE. 0) then
    616713             ! the following line should not be here. Indeed, if zifl is modified
    … …  
    628725        end if
    629726           if (fl_cor_ebil .GT. 0) then ! correction bug, deplacement ligne precedente
    630              zifl(i)=zifl(i)*(1.-zmelt)
     727!<LTP
     728             IF (iflag_evap_prec==4) THEN
     729                   ziflclr(i)=ziflclr(i)*(1.-zmelt)
     730                   ziflcld(i)=ziflcld(i)*(1.-zmelt)
     731                   zifl(i)=ziflclr(i)+ziflcld(i)
     732!>LTP       
     733             ELSE
     734                   zifl(i)=zifl(i)*(1.-zmelt)
     735             ENDIF
    631736           end if
    632737
    … …  
    10191124           ENDIF
    10201125        ENDDO
     1126
     1127       
    10211128        ! If vertical heterogeneity, change fraction by volume as well
    10221129        if (iflag_cloudth_vert>=3) then
    … …  
    11161223     ! Partager l'eau condensee en precipitation et eau liquide nuageuse
    11171224     !
     1225
     1226!<LTP
     1227
     1228IF (iflag_evap_prec==4) THEN
     1229        !Partitionnement des precipitations venant du dessus en précipitations nuageuses
     1230        !et précipitations ciel clair
     1231
     1232        !0) Calculate tot_zneb, la fraction nuageuse totale au-dessus du nuage
     1233        !en supposant un recouvrement maximum aléatoire (voir Jakob and Klein, 2000)
     1234       
     1235        DO i=1, klon
     1236                tot_znebn(i) = 1 - (1-tot_zneb(i))*(1 - max(rneb(i,k),zneb(i))) &
     1237                        /(1-min(zneb(i),1-smallestreal))
     1238                d_tot_zneb(i) = tot_znebn(i) - tot_zneb(i)
     1239                tot_zneb(i) = tot_znebn(i)
     1240
     1241
     1242                !1) Cloudy to clear air
     1243                d_znebprecip_cld_clr(i) = znebprecipcld(i) - min(rneb(i,k),znebprecipcld(i))
     1244                IF (znebprecipcld(i) .GT. 0) THEN
     1245                        d_zrfl_cld_clr(i) = d_znebprecip_cld_clr(i)/znebprecipcld(i)*zrflcld(i)
     1246                        d_zifl_cld_clr(i) = d_znebprecip_cld_clr(i)/znebprecipcld(i)*ziflcld(i)
     1247                ELSE
     1248                        d_zrfl_cld_clr(i) = 0.
     1249                        d_zifl_cld_clr(i) = 0.
     1250                ENDIF
     1251
     1252                !2) Clear to cloudy air
     1253                d_znebprecip_clr_cld(i) = max(0., min(znebprecipclr(i), rneb(i,k) &
     1254                        - d_tot_zneb(i) - zneb(i)))
     1255                IF (znebprecipclr(i) .GT. 0) THEN
     1256                        d_zrfl_clr_cld(i) = d_znebprecip_clr_cld(i)/znebprecipclr(i)*zrflclr(i)
     1257                        d_zifl_clr_cld(i) = d_znebprecip_clr_cld(i)/znebprecipclr(i)*ziflclr(i)
     1258                ELSE
     1259                        d_zrfl_clr_cld(i) = 0.
     1260                        d_zifl_clr_cld(i) = 0.
     1261                ENDIF
     1262
     1263                !Update variables
     1264                znebprecipcld(i) = znebprecipcld(i) + d_znebprecip_clr_cld(i) - d_znebprecip_cld_clr(i) 
     1265                znebprecipclr(i) = znebprecipclr(i) + d_znebprecip_cld_clr(i) - d_znebprecip_clr_cld(i)
     1266                zrflcld(i) = zrflcld(i) + d_zrfl_clr_cld(i) - d_zrfl_cld_clr(i)
     1267                ziflcld(i) = ziflcld(i) + d_zifl_clr_cld(i) - d_zifl_cld_clr(i)
     1268                zrflclr(i) = zrflclr(i) + d_zrfl_cld_clr(i) - d_zrfl_clr_cld(i)
     1269                ziflclr(i) = ziflclr(i) + d_zifl_cld_clr(i) - d_zifl_clr_cld(i)
     1270
     1271        ENDDO
     1272ENDIF
     1273
     1274!>LTP
     1275
     1276
    11181277
    11191278     ! Initialisation de zoliq (eau condensee moyenne dans la maille)
    … …  
    12931452             d_ql(i,k) = (1-zfice(i))*zoliq(i)
    12941453             d_qi(i,k) = zfice(i)*zoliq(i)
    1295              zrfl(i) = zrfl(i)+ zqprecl(i) &
     1454!<LTP
     1455             IF (iflag_evap_prec == 4) THEN
     1456                zrflcld(i) = zrflcld(i)+zqprecl(i) &
     1457                 *(paprs(i,k)-paprs(i,k+1))/(RG*dtime)
     1458                ziflcld(i) = ziflcld(i)+ zqpreci(i) &
     1459                      *(paprs(i,k)-paprs(i,k+1))/(RG*dtime)
     1460                znebprecipcld(i) = rneb(i,k)
     1461                zrfl(i) = zrflcld(i) + zrflclr(i)
     1462                zifl(i) = ziflcld(i) + ziflclr(i)       
     1463!>LTP
     1464             ELSE
     1465                zrfl(i) = zrfl(i)+ zqprecl(i) &
    12961466                 *(paprs(i,k)-paprs(i,k+1))/(RG*dtime)
    1297              zifl(i) = zifl(i)+ zqpreci(i) &
     1467                zifl(i) = zifl(i)+ zqpreci(i) &
    12981468                      *(paprs(i,k)-paprs(i,k+1))/(RG*dtime) 
     1469             
     1470             ENDIF !iflag_evap_prec==4
     1471
    12991472           ENDIF                     
    13001473         ENDDO
    … …  
    13141487           d_qi(i,k) = zfice(i)*zoliq(i)
    13151488!           endif
     1489!<LTP
     1490             IF (iflag_evap_prec == 4) THEN
     1491                zrflcld(i) = zrflcld(i)+ MAX(zcond(i)*(1.-zfice(i))-zoliqp(i),0.0) &
     1492                       *(paprs(i,k)-paprs(i,k+1))/(RG*dtime)
     1493                ziflcld(i) = ziflcld(i)+ MAX(zcond(i)*zfice(i)-zoliqi(i),0.0) &
     1494                        *(paprs(i,k)-paprs(i,k+1))/(RG*dtime) 
     1495                znebprecipcld(i) = rneb(i,k)
     1496                zrfl(i) = zrflcld(i) + zrflclr(i)
     1497                zifl(i) = ziflcld(i) + ziflclr(i)       
     1498!>LTP
     1499             ELSE
    13161500!AJ<
    1317            zrfl(i) = zrfl(i)+ MAX(zcond(i)*(1.-zfice(i))-zoliqp(i),0.0) &
    1318                *(paprs(i,k)-paprs(i,k+1))/(RG*dtime)
    1319            zifl(i) = zifl(i)+ MAX(zcond(i)*zfice(i)-zoliqi(i),0.0) &
    1320                     *(paprs(i,k)-paprs(i,k+1))/(RG*dtime) 
     1501                   zrfl(i) = zrfl(i)+ MAX(zcond(i)*(1.-zfice(i))-zoliqp(i),0.0) &
     1502                       *(paprs(i,k)-paprs(i,k+1))/(RG*dtime)
     1503                        zifl(i) = zifl(i)+ MAX(zcond(i)*zfice(i)-zoliqi(i),0.0) &
     1504                        *(paprs(i,k)-paprs(i,k+1))/(RG*dtime) 
    13211505     !      zrfl(i) = zrfl(i)+  zpluie                         &
    13221506     !          *(paprs(i,k)-paprs(i,k+1))/(RG*dtime)
    13231507     !      zifl(i) = zifl(i)+  zice                    &
    13241508     !               *(paprs(i,k)-paprs(i,k+1))/(RG*dtime)                                   
     1509             ENDIF !iflag_evap_prec == 4             
    13251510
    13261511!CR : on prend en compte l'effet Bergeron dans les flux de precipitation
    13271512           IF ((iflag_bergeron .EQ. 1) .AND. (zt(i) .LT. 273.15)) THEN
    1328               zsolid = zrfl(i)
    1329               zifl(i) = zifl(i)+zrfl(i)
    1330               zrfl(i) = 0.
     1513!<LTP
     1514                IF (iflag_evap_prec == 4) THEN
     1515                     zsolid = zrfl(i)
     1516                     ziflclr(i) = ziflclr(i) +zrflclr(i)
     1517                     ziflcld(i) = ziflcld(i) +zrflcld(i)
     1518                     zifl(i) = ziflclr(i)+ziflcld(i)
     1519                     zrflcld(i)=0.
     1520                     zrflclr(i)=0.   
     1521                     zrfl(i) = zrflclr(i)+zrflcld(i)
     1522!>LTP
     1523                ELSE
     1524                     zsolid = zrfl(i)
     1525                     zifl(i) = zifl(i)+zrfl(i)
     1526                     zrfl(i) = 0.
     1527                 ENDIF!iflag_evap_prec==4
     1528
    13311529           if (fl_cor_ebil .GT. 0) then
    13321530              zt(i)=zt(i)+zsolid*(RG*dtime)/(paprs(i,k)-paprs(i,k+1)) &
    … …  
    13581556!       ENDDO
    13591557!     ENDIF
     1558
     1559
     1560!<LTP
     1561
     1562!Limitation de la fraction surfacique couverte par les précipitations lorsque l'intensité locale du flux de précipitation descend en
     1563!dessous de rain_int_min
     1564    IF (iflag_evap_prec==4) THEN
     1565        DO i=1, klon
     1566            IF (zrflclr(i) + ziflclr(i) .GT. 0 ) THEN
     1567                znebprecipclr(i) = min(znebprecipclr(i), max(zrflclr(i)/(znebprecipclr(i)*rain_int_min), ziflclr(i)/(znebprecipclr(i)*rain_int_min)))
     1568            ELSE
     1569                znebprecipclr(i)=0.
     1570            ENDIF
     1571
     1572            IF (zrflcld(i) + ziflcld(i) .GT. 0 ) THEN
     1573                znebprecipcld(i) = min(znebprecipcld(i), max(zrflcld(i)/(znebprecipcld(i)*rain_int_min), ziflcld(i)/(znebprecipcld(i)*rain_int_min)))
     1574            ELSE
     1575                znebprecipcld(i)=0.
     1576            ENDIF
     1577       ENDDO
     1578    ENDIf
     1579
     1580!>LTP
     1581
     1582
     1583
    13601584
    13611585       

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

    r3102 r4013  
    2828  REAL, PRIVATE                               :: tau_calv 
    2929  !$OMP THREADPRIVATE(tau_calv)
    30   REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE  :: ffonte_global
     30  REAL, ALLOCATABLE, DIMENSION(:,:)           :: ffonte_global
    3131  !$OMP THREADPRIVATE(ffonte_global)
    32   REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE  :: fqfonte_global
     32  REAL, ALLOCATABLE, DIMENSION(:,:)           :: fqfonte_global
    3333  !$OMP THREADPRIVATE(fqfonte_global)
    34   REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE  :: fqcalving_global
     34  REAL, ALLOCATABLE, DIMENSION(:,:)           :: fqcalving_global
    3535  !$OMP THREADPRIVATE(fqcalving_global)
    36   REAL, ALLOCATABLE, DIMENSION(:), PRIVATE  :: runofflic_global
     36  REAL, ALLOCATABLE, DIMENSION(:)             :: runofflic_global
    3737  !$OMP THREADPRIVATE(runofflic_global)
    3838

  • LMDZ6/branches/Ocean_skin/libf/phylmd/indice_sol_mod.F90

    • Property svn:keywords set to Id
    r3319 r4013  
    1313!FC
    1414           INTEGER, SAVE    :: nvm_orch ! Nombre de type de vegetation ds ORCHIDEE                 
     15           !$OMP THREADPRIVATE(nvm_orch)
    1516
    1617      END MODULE indice_sol_mod

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

    r3798 r4013  
    2020  INTEGER, SAVE :: nbtr
    2121!$OMP THREADPRIVATE(nbtr)
     22
     23  INTEGER, SAVE :: nqtottr
     24!$OMP THREADPRIVATE(nqtottr)
     25
     26! ThL : number of CO2 tracers                   ModThL
     27  INTEGER, SAVE :: nqCO2
     28!$OMP THREADPRIVATE(nqCO2)
    2229
    2330#ifdef CPP_StratAer
    … …  
    3542
    3643! Name variables
    37   CHARACTER(len=20), ALLOCATABLE, DIMENSION(:), SAVE :: tname ! tracer short name for restart and diagnostics
    38   CHARACTER(len=23), ALLOCATABLE, DIMENSION(:), SAVE :: ttext ! tracer long name for diagnostics
     44  INTEGER,PARAMETER :: tname_lenmax=128
     45  CHARACTER(len=tname_lenmax), ALLOCATABLE, DIMENSION(:), SAVE :: tname ! tracer short name for restart and diagnostics
     46  CHARACTER(len=tname_lenmax+3), ALLOCATABLE, DIMENSION(:), SAVE :: ttext ! tracer long name for diagnostics
    3947!$OMP THREADPRIVATE(tname,ttext)
    4048
    … …  
    93101    INTEGER,SAVE :: niso,ntraceurs_zone,ntraciso
    94102!$OMP THREADPRIVATE(niso,ntraceurs_zone,ntraciso)
     103
     104    INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  itr_indice ! numéro iq entre 1 et nqtot qui correspond au traceur itr entre 1 et nqtottr
     105!$OMP THREADPRIVATE(itr_indice)
    95106 
    96107CONTAINS
    97108
    98   SUBROUTINE init_infotrac_phy(nqtot_,nqo_,nbtr_,tname_,ttext_,type_trac_,&
     109  SUBROUTINE init_infotrac_phy(nqtot_,nqo_,nbtr_,nqtottr_,nqCO2_,tname_,ttext_,type_trac_,&
    99110                               niadv_,conv_flg_,pbl_flg_,solsym_,&
    100111                               nqfils_,nqdesc_,nqdesc_tot_,iqfils_,iqpere_,&
    … …  
    104115                               iso_indnum_,zone_num_,phase_num_,&
    105116                               indnum_fn_num_,index_trac_,&
    106                                niso_,ntraceurs_zone_,ntraciso_&
     117                               niso_,ntraceurs_zone_,ntraciso_,itr_indice_&
    107118#ifdef CPP_StratAer
    108119                               ,nbtr_bin_,nbtr_sulgas_&
    … …  
    118129    INTEGER,INTENT(IN) :: nqo_
    119130    INTEGER,INTENT(IN) :: nbtr_
     131    INTEGER,INTENT(IN) :: nqtottr_
     132    INTEGER,INTENT(IN) :: nqCO2_
    120133#ifdef CPP_StratAer
    121134    INTEGER,INTENT(IN) :: nbtr_bin_
    … …  
    126139    INTEGER,INTENT(IN) :: id_BIN01_strat_
    127140#endif
    128     CHARACTER(len=20),INTENT(IN) :: tname_(nqtot_) ! tracer short name for restart and diagnostics
    129     CHARACTER(len=23),INTENT(IN) :: ttext_(nqtot_) ! tracer long name for diagnostics
    130     CHARACTER(len=4),INTENT(IN) :: type_trac_
     141    CHARACTER(len=*),INTENT(IN) :: tname_(nqtot_) ! tracer short name for restart and diagnostics
     142    CHARACTER(len=*),INTENT(IN) :: ttext_(nqtot_) ! tracer long name for diagnostics
     143    CHARACTER(len=*),INTENT(IN) :: type_trac_
    131144    INTEGER,INTENT(IN) :: niadv_ (nqtot_) ! equivalent dyn / physique
    132145    INTEGER,INTENT(IN) :: conv_flg_(nbtr_)
    133146    INTEGER,INTENT(IN) :: pbl_flg_(nbtr_)
    134     CHARACTER(len=8),INTENT(IN) :: solsym_(nbtr_)
     147    CHARACTER(len=*),INTENT(IN) :: solsym_(nbtr_)
    135148    ! Isotopes:
    136149    INTEGER,INTENT(IN) :: nqfils_(nqtot_)
    … …  
    157170    INTEGER,INTENT(IN) :: ntraceurs_zone_
    158171    INTEGER,INTENT(IN) :: ntraciso_
     172    INTEGER,INTENT(IN) :: itr_indice_(nqtottr_)
    159173
    160174    CHARACTER(LEN=30) :: modname="init_infotrac_phy"
    … …  
    163177    nqo=nqo_
    164178    nbtr=nbtr_
     179    nqCO2=nqCO2_
     180    nqtottr=nqtottr_
    165181#ifdef CPP_StratAer
    166182    nbtr_bin=nbtr_bin_
    … …  
    184200    ALLOCATE(solsym(nbtr))
    185201    solsym(:)=solsym_(:)
    186  
     202     
    187203    IF(prt_level.ge.1) THEN
    188       write(lunout,*) TRIM(modname)//": nqtot,nqo,nbtr",nqtot,nqo,nbtr
     204      write(lunout,*) TRIM(modname)//": nqtot,nqo,nbtr,nqCO2",nqtot,nqo,nbtr,nqCO2
    189205    ENDIF
    190206   
    … …  
    236252      ALLOCATE(index_trac(ntraceurs_zone,niso))
    237253      index_trac(:,:)=index_trac_(:,:)
     254
     255      ALLOCATE(itr_indice(nqtottr))
     256      itr_indice(:)=itr_indice_(:)
    238257    ENDIF ! of IF(ok_isotopes)
    239258 

  • LMDZ6/branches/Ocean_skin/libf/phylmd/inlandsis/VARphy.F90

    r3792 r4013  
    2626      INTEGER, PARAMETER ::  iun=1                                             
    2727      REAL, PARAMETER    ::  zer0 = 0.0e+0, half = 0.5e+0, un_1 = 1.0e+0,     &
    28      &                       eps6 = 1.0e-6, R_1000=1.e3      
     28     &                       eps6 = 1.0e-6, R_1000=1.e3   
    2929      REAL, PARAMETER    ::  zero = 0.0e+0, demi = 0.5e+0, unun = 1.0e+0,     &
    3030     &                       epsi = 1.0e-6, eps9 = 1.0e-9         
    … …  
    9191! A1.6 Turbulent and molecular diffusion
    9292!----------------------------------------
    93       REAL, PARAMETER    ::  A_MolV = 1.35e-5, vonKrm = 0.40e0
     93      REAL, PARAMETER    ::  A_MolV = 1.35e-5, vonKrm = 0.40e0, r_turb=3.0
     94      REAL, PARAMETER    ::  A_turb=5.8, akmol=1.35e-5
    9495!C +...                A_MolV: Air Viscosity                 = 1.35d-5 m2/s   
    9596!C +                   vonKrm: von Karman constant           = 0.4           
    96                                                                          
     97!C +                   r_turb:   Turbulent Diffusivities Ratio K*/Km       
     98!C +                   A_turb:    Stability  Coefficient Moment                                 
     99!C +                   Air Viscosity                 = 1.35d-5 m2/s                 
     100
     101
    97102
    98103END MODULE VARphy

  • LMDZ6/branches/Ocean_skin/libf/phylmd/inlandsis/VARtSV.F90

    r3792 r4013  
    4141
    4242  SUBROUTINE INIT_VARtSV
     43 
    4344  IMPLICIT NONE
    44  
     45
     46  INTEGER ikl
     47
     48
     49
     50
     51
     52
     53
    4554      ALLOCATE(toicSV(klonv))
    4655
    … …  
    5968      ALLOCATE(rsolSV(klonv))                ! Radiation balance surface
    6069
     70      DO ikl=1,klonv       
     71           
     72         toicSV(ikl)   = 0.
     73         dz1_SV(ikl,:) = 0.
     74         dz2_SV(ikl,:) = 0.
     75         Tsf_SV(ikl)   = 0.
     76         TsfnSV(ikl)   = 0.
     77         AcoHSV(ikl)   = 0.
     78         BcoHSV(ikl)   = 0.
     79         AcoQSV(ikl)   = 0.
     80         ps__SV(ikl)   = 0.
     81         p1l_SV(ikl)   = 0.
     82         cdH_SV(ikl)   = 0.
     83         cdM_SV(ikl)   = 0.
     84         rsolSV(ikl)   = 0.
     85      END DO
     86
     87
     88
    6189  END SUBROUTINE INIT_VARtSV
    6290

  • LMDZ6/branches/Ocean_skin/libf/phylmd/inlandsis/VARxSV.F90

    r3792 r4013  
    6767      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   QaT_SV  ! SBL Top   Specific Humidity     
    6868!$OMP THREADPRIVATE(QaT_SV)
     69      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   QsT_SV  ! SBL Top   Specific Humidity
     70!$OMP THREADPRIVATE(QsT_SV)
    6971      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   dQa_SV  ! SBL Flux  Limitation of Qa     
    7072!$OMP THREADPRIVATE(dQa_SV)
    … …  
    7880
    7981                                                             
    80       REAL,SAVE                      ::   zSBLSV  ! SBL Height (Initial Value)     
    81 !$OMP THREADPRIVATE(zSBLSV)
    8282      REAL,SAVE                      ::   dt__SV  ! Time Step                       
    8383!$OMP THREADPRIVATE(dt__SV)
    … …  
    160160      REAL,ALLOCATABLE,SAVE    ::   agsnSV(:,:)  ! Snow Age                       
    161161!$OMP THREADPRIVATE(agsnSV)
     162      REAL,ALLOCATABLE,SAVE    ::   DOPsnSV(:,:)  ! Snow optical diameter [m]
     163!$OMP THREADPRIVATE(DOPsnSV)
    162164      REAL, DIMENSION(:),ALLOCATABLE,SAVE    ::   BufsSV  ! Snow Buffer Layer               
    163165!$OMP THREADPRIVATE(BufsSV)
    … …  
    260262      ALLOCATE(dLdTSV(klonv))  ! Latent   Heat Flux T Derivat.   
    261263      ALLOCATE(rhT_SV(klonv))  ! SBL Top   Air  Density         
    262       ALLOCATE(QaT_SV(klonv))  ! SBL Top   Specific Humidity     
     264      ALLOCATE(QaT_SV(klonv))  ! SBL Top   Specific Humidity   
     265      ALLOCATE(QsT_SV(klonv))  ! surface   Specific Humidity
    263266      ALLOCATE(dQa_SV(klonv))  ! SBL Flux  Limitation of Qa     
    264267      ALLOCATE(qsnoSV(klonv))  ! SBL Mean  Snow       Content   
    … …  
    309312      ALLOCATE(dzsnSV(klonv,    0:nsno))  ! Snow Layer  Thickness           
    310313      ALLOCATE(agsnSV(klonv,    0:nsno))  ! Snow Age                       
     314      ALLOCATE(DOPsnSV(klonv,    0:nsno))  ! Snow Optical diameter                       
    311315      ALLOCATE(BufsSV(klonv))  ! Snow Buffer Layer               
    312316      ALLOCATE(rusnSV(klonv))  ! Surficial   Water               
    … …  
    339343
    340344      DO ikl=1,klonv       
    341         LSmask(ikl)   = 0
    342         isotSV(ikl)   = 0               
    343         iWaFSV(ikl)   = 0
    344         isnoSV(ikl)   = 0 
    345         ispiSV(ikl)   = 0
    346         iiceSV(ikl)   = 0         
    347         istoSV(ikl,:) = 0
    348         ii__SV(ikl)   = 0
    349         jj__SV(ikl)   = 0
    350         nn__SV(ikl)   = 0
     345
     346
     347      isnoSV(ikl)  =0.       
     348      ispiSV(ikl)  =0.   
     349      iiceSV(ikl)  =0.       
     350      istoSV(ikl,:)=0.                                                                       
     351      alb_SV(ikl)  =0.     
     352      emi_SV(ikl)  =0.   
     353      IRs_SV(ikl)  =0.     
     354      LMO_SV(ikl)  =0.
     355      us__SV(ikl)  =0.
     356      uts_SV(ikl)  =0.
     357      cutsSV(ikl)  =0.
     358      uqs_SV(ikl)  =0.
     359      uss_SV(ikl)  =0.
     360      usthSV(ikl)  =0.
     361      rCDmSV(ikl)  =0.
     362      rCDhSV(ikl)  =0.
     363      Z0m_SV(ikl)  =0.
     364      Z0mmSV(ikl)  =0.
     365      Z0mnSV(ikl)  =0.
     366      Z0roSV(ikl)  =0.
     367      Z0SaSV(ikl)  =0.
     368      Z0e_SV(ikl)  =0.
     369      Z0emSV(ikl)  =0.
     370      Z0enSV(ikl)  =0.
     371      Z0h_SV(ikl)  =0.
     372      Z0hmSV(ikl)  =0.
     373      Z0hnSV(ikl)  =0.
     374                                                                         
     375                                                                       
     376      TsisSV(ikl,:)  =0.
     377      ro__SV(ikl,:)  =0.
     378      eta_SV(ikl,:)  =0.
     379      G1snSV(ikl,:)  =0. 
     380      G2snSV(ikl,:)  =0.         
     381      dzsnSV(ikl,:)  =0.     
     382      agsnSV(ikl,:)  =0.             
     383      DOPsnSV(ikl,:) =0.                 
     384      BufsSV(ikl)  =0.         
     385      rusnSV(ikl)  =0.     
     386      SWf_SV(ikl)  =0.       
     387      SWS_SV(ikl)  =0.
     388      HFraSV(ikl)  =0.       
     389                                                                           
     390      zWE_SV(ikl)  =0.
     391      zWEcSV(ikl)  =0.
     392      wem_SV(ikl)  =0.
     393      wer_SV(ikl)  =0.
     394      wes_SV(ikl)  =0.
     395      zn4_SV(ikl)  =0.
     396      zn5_SV(ikl)  =0.                                                       
     397                                       
     398                                                                                                                                                         
     399      ii__SV(ikl)  =0.
     400      jj__SV(ikl)  =0.
     401      nn__SV(ikl)  =0.
     402                                                                               
     403      IRu_SV(ikl)  =0.
     404      hSalSV(ikl)  =0.     
     405      qSalSV(ikl)  =0.
     406      RnofSV(ikl)  =0.   
     407      RuofSV(ikl,:)  =0.
     408
     409
     410
     411
    351412      END DO
    352413  END SUBROUTINE INIT_VARxSV

  • LMDZ6/branches/Ocean_skin/libf/phylmd/inlandsis/VARySV.F90

    r3792 r4013  
    2222      REAL, DIMENSION(:),SAVE,ALLOCATABLE    ::   alb3sv  ! Surface Albedo FIR     
    2323!$OMP THREADPRIVATE(alb3sv)
    24 
     24      REAL, DIMENSION(:,:),SAVE,ALLOCATABLE  ::   alb6sv  ! 6 band-albedo   
     25!$OMP THREADPRIVATE(alb6sv)
    2526      REAL, DIMENSION(:),SAVE,ALLOCATABLE    ::   albssv  ! Soil               Albedo [-]   
    2627!$OMP THREADPRIVATE(albssv)
    … …  
    8384      ALLOCATE(alb2sv(klonv))  ! Surface Albedo NIR     
    8485      ALLOCATE(alb3sv(klonv))  ! Surface Albedo FIR       
     86      ALLOCATE(alb6sv(klonv,6))! 6-band  Albedo     
    8587
    8688      !
    … …  
    110112
    111113      DO ikl=1,klonv
    112         NLaysv(ikl)   = 0
    113         i_thin(ikl)   = 0
    114         LIndsv(ikl)   = 0
     114
     115      NLaysv(ikl) =0.
     116      i_thin(ikl) =0.
     117      LIndsv(ikl) =0.
     118      albisv(ikl) =0.
     119      alb1sv(ikl) =0.
     120      alb2sv(ikl) =0.   
     121      alb3sv(ikl) =0.
     122      alb6sv(ikl,:)=0.
     123      albssv(ikl) =0.
     124      SoSosv(ikl) =0.
     125      Eso_sv(ikl) =0.
     126      HSv_sv(ikl) =0.   
     127      HLv_sv(ikl) =0.
     128      HSs_sv(ikl) =0.       
     129      HLs_sv(ikl) =0.
     130      sqrCm0(ikl) =0.   
     131      sqrCh0(ikl) =0.   
     132      Lx_H2O(ikl) =0.
     133      ram_sv(ikl) =0.
     134      rah_sv(ikl) =0.
     135      Fh__sv(ikl) =0.     
     136      dFh_sv(ikl) =0.
     137      Evp_sv(ikl) =0.
     138      EvT_sv(ikl) =0.
     139      LSdzsv(ikl) =0.
     140      Tsrfsv(ikl) =0.
     141      sEX_sv(ikl,:)  =0.
     142      zzsnsv(ikl,:)  =0.
     143      psi_sv(ikl,:)  =0.
     144      Khydsv(ikl,:)  =0.
     145      EExcsv(ikl)  =0.   
     146
     147
    115148      END DO
    116149

  • LMDZ6/branches/Ocean_skin/libf/phylmd/inlandsis/inlandsis.F

    r3792 r4013  
    1       subroutine INLANDSIS(SnoMod,BloMod,jjtime)
     1      subroutine INLANDSIS(SnoMod,BloMod,jjtime,debut)
    22
    33      USE dimphy
    … …  
    173173      USE VARySV
    174174      USE VARtSV
    175       USE surface_data, only: iflag_tsurf_inlandsis
    176 
     175      USE surface_data, ONLY: is_ok_z0h_rn,
     176     .                        is_ok_density_kotlyakov,
     177     .                        prescribed_z0m_snow,
     178     .                        iflag_z0m_snow,
     179     .                        iflag_tsurf_inlandsis,
     180     .                        iflag_temp_inlandsis,
     181     .                        discret_xf, buf_sph_pol,buf_siz_pol     
    177182
    178183      IMPLICIT NONE
    … …  
    180185      logical   SnoMod
    181186      logical   BloMod
     187      logical   debut
    182188      integer   jjtime
    183189
    … …  
    213219      integer   IceMsk,IcIndx(klonv)          !      Ice / No      Ice Mask
    214220      integer   SnoMsk                        ! Snow     / No Snow     Mask
    215 
    216221      real      roSMin,roSMax,roSn_1,roSn_2,roSn_3   ! Fallen Snow Density (PAHAUT)
    217222      real      Dendr1,Dendr2,Dendr3          ! Fallen Snow Dendric.(GIRAUD)
    218223      real      Spher1,Spher2,Spher3,Spher4   ! Fallen Snow Spheric.(GIRAUD)
    219224      real      Polair                        ! Polar  Snow Switch
    220       real      PorSno,Por_BS,Salt_f,PorRef   !
     225      real      PorSno,Salt_f,PorRef   !
    221226c #sw real      PorVol,rWater                 !
    222227c #sw real      rusNEW,rdzNEW,etaNEW          !
    … …  
    244249      real      Z0m_Sn,Z0m_90                 ! Snow  Surface Roughness Length
    245250      real      SnoWat                        ! Snow Layer    Switch
    246 c #RN real      rstar,alors                   !
    247 c #RN real      rstar0,rstar1,rstar2          !
     251      real      rstar,alors                   !
     252      real      rstar0,rstar1,rstar2          !
    248253      real      SameOK                        ! 1. => Same Type of Grains
    249254      real      G1same                        ! Averaged G1,  same Grains
    … …  
    263268      real      Sph_av                        ! Averaged    Grain Spher.
    264269      real      Den_av                        ! Averaged    Grain Dendr.
    265       real      DendOK                        ! 1. => Average is  Dendr.
    266270      real      G1diff                        ! Averaged G1, diff. Grains
    267271      real      G2diff                        ! Averaged G2, diff. Grains
    … …  
    277281      real      tt_c,vv_c                     ! Critical param.
    278282      real      tt_tmp,vv_tmp,vv_virt         ! Temporary variables
    279       logical   density_kotlyakov             ! .true. if Kotlyakov 1961
    280283      real      e_prad,e1pRad,A_Rad0,absg_V,absgnI,exdRad ! variables for SoSosv calculations
    281284      real      zm1, zm2, coefslope                    ! variables for surface temperature extrapolation
    282 
     285! for Aeolian erosion and blowing snow
     286      integer   nit   ,iit
     287      real      Fac                           ! Correc. factor for drift ratio
     288      real      dusuth,signus
     289      real      sss__F,sss__N
     290      real      sss__K,sss__G
     291      real      us_127,us_227,us_327,us_427,us_527
     292      real      VVa_OK, usuth0
     293      real      ssstar
     294      real      SblPom
     295      real      rCd10n                        ! Square root of drag coefficient
     296      real      DendOK                        ! Dendricity Switch
     297      real      SaltOK                        ! Saltation  Switch
     298      real      MeltOK                        ! Saltation  Switch (Melting Snow)
     299      real      SnowOK                        ! Pack Top   Switch
     300      real      SaltM1,SaltM2,SaltMo,SaltMx   ! Saltation  Parameters
     301      real      ShearX, ShearS                ! Arg. Max Shear Stress
     302      real      Por_BS                        ! Snow Porosity
     303      real      Salt_us                       ! New thresh.friction velocity u*t
     304      real      Fac_Mo,ArguSi,FacRho          ! Numerical factors for u*t
     305      real      SaltSI(klonv,0:nsno)          ! Snow Drift Index              !
     306      real      MIN_Mo                        ! Minimum Mobility Fresh Fallen *
     307      character*3    qsalt_param              ! Switch for saltation flux param.
     308      character*3    usth_param               ! Switch for u*t param
    283309
    284310
    … …  
    287313
    288314      data      T__Min / 200.00/              ! Minimum realistic Temperature
    289       data      TaPole / 263.15/              ! Maximum Polar     Temperature
    290       data      roSMin /  30.  /              ! Minimum Snow  Density
     315      data      TaPole / 268.15/              ! Maximum Polar Temperature (value from C. Agosta)
     316      data      roSMin / 300.  /              ! Minimum Snow  Density
    291317      data      roSMax / 400.  /              ! Max Fresh Snow Density
    292318      data      tt_c   / -2.0  /              ! Critical Temp. (degC)
    … …  
    305331      data      EmiWat /   0.99999999/        ! Emissivity of a Water Area
    306332      data      EmiSno /   0.99999999/        ! Emissivity of Snow
     333
    307334     
    308335!     DATA      Emissivities                  ! Pielke, 1984, pp. 383,409
    … …  
    321348      data      Z0_ICE/    0.0010/            ! Sea-Ice Z0 = 0.0010 m (Andreas)
    322349!                                             !    (Ice Station Weddel -- ISW)
     350! for aerolian erosion
     351      data      SblPom/ 1.27/   ! Lower Boundary Height Parameter
     352C +                             ! for Suspension
     353C +                             ! Pommeroy, Gray and Landine 1993,
     354C +                             ! J. Hydrology, 144(8) p.169
     355      data      nit   / 5   /   ! us(is0,uth) recursivity: Nb Iterations
     356cc#AE data      qsalt_param/"bin"/ ! saltation part. conc. from Bintanja 2001 (p
     357      data      qsalt_param/"pom"/ ! saltation part. conc. from Pomeroy and Gray
     358cc#AE data      usth_param/"lis"/  ! u*t from Liston et al. 2007
     359      data      usth_param/"gal"/  ! u*t from Gallee et al. 2001
     360      data      SaltMx/-5.83e-2/
     361
    323362      vk2    =  vonKrm  *  vonKrm             ! Square of Von Karman Constant
    324363
    … …  
    352391
    353392
    354 ! Blowing Particles Threshold Friction velocity
    355 ! =============================================
    356 
    357 c #AE       usthSV(ikl) =                     1.0e+2
    358 !          END DO
    359 !xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
    360 
    361 
    362 
    363 
    364 ! Contribution of Snow to the Surface Snow Pack
    365 ! =============================================
    366 
    367       IF (SnoMod)                                                 THEN
    368 
    369 
    370  
    371 C +--Blowing Snow
    372 C +  ------------
    373  
    374         IF (BloMod) then
    375          if (klonv.eq.1) then
     393
     394
     395
     396      IF (SnoMod)                            THEN
     397
     398 
     399C +--Aeolian erosion and Blowing Snow
     400C +==================================
     401
     402
     403
     404        DO ikl=1,knonv
     405            usthSV(ikl) =                     1.0e+2
     406        END DO
     407
     408
     409        IF (BloMod) THEN
     410 
     411        if (klonv.eq.1) then
    376412          if(isnoSV(1).ge.2                   .and.
    377      .       TsisSV(1,max(1,isnoSV(1)))<273.  .and.
    378      .       ro__SV(1,max(1,isnoSV(1)))<500.  .and.
    379      .       eta_SV(1,max(1,isnoSV(1)))<epsi) then
     413     .         TsisSV(1,max(1,isnoSV(1)))<273.  .and.
     414     .         ro__SV(1,max(1,isnoSV(1)))<500.  .and.
     415     .         eta_SV(1,max(1,isnoSV(1)))<epsi) then
    380416C +                       **********
    381417                     call SISVAT_BSn
    … …  
    384420                     call SISVAT_BSn
    385421C +                       **********
    386          endif
    387         ENDIF
    388  
    389 
    390 
     422        endif
     423
     424
     425
     426
     427
     428
     429
     430! Calculate threshold erosion velocity for next time step
     431! Unlike in sisvat, computation is of threshold velocity made here (instead of sisvaesbl)
     432! since we do not use sisvatesbl for the coupling with LMDZ
     433
     434C +--Computation of threshold friction velocity for snow erosion
     435C ---------------------------------------------------------------
     436
     437        rCd10n =  1. / 26.5 ! Vt / u*t = 26.5
     438                     ! Budd et al. 1965, Antarct. Res. Series Fig.13
     439                     ! ratio developped during assumed neutral conditions
     440 
     441
     442C +--Snow Properties
     443C +  ~~~~~~~~~~~~~~~
     444
     445        DO ikl = 1,knonv
     446
     447          isn      =  isnoSV(ikl)
     448
     449
     450 
     451          DendOK   =  max(zero,sign(unun,epsi-G1snSV(ikl,isn)  ))  !
     452          SaltOK   =  min(1   , max(istdSV(2)-istoSV(ikl,isn),0))  !
     453          MeltOK   =     (unun                                     !
     454     .             -max(zero,sign(unun,TfSnow-epsi                 !
     455     .             -TsisSV(ikl,isn)  )))                           ! Melting Snow
     456     .             *  min(unun,DendOK                              !
     457     .                  +(1.-DendOK)                               !
     458     .                      *sign(unun,     G2snSV(ikl,isn)-1.0))  ! 1.0 for 1mm
     459          SnowOK   =  min(1   , max(isnoSV(ikl)      +1 -isn ,0))  ! Snow Switch
     460 
     461          G1snSV(ikl,isn) =      SnowOK *    G1snSV(ikl,isn)
     462     .                  + (1.- SnowOK)*min(G1snSV(ikl,isn),G1_dSV)
     463          G2snSV(ikl,isn) =      SnowOK *    G2snSV(ikl,isn)
     464     .                  + (1.- SnowOK)*min(G2snSV(ikl,isn),G1_dSV)
     465 
     466          SaltOK   =  min(unun, SaltOK + MeltOK) * SnowOK
     467 
     468 
     469C +--Mobility Index (Guyomarc'h & Merindol 1997, Ann.Glaciol.)
     470C +  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
     471          SaltM1   = -0.750e-2 * G1snSV(ikl,isn)
     472     .             -0.500e-2 * G2snSV(ikl,isn)+ 0.500e00 !dendritic case
     473C +     CAUTION:  Guyomarc'h & Merindol Dendricity Sign is +
     474C +     ^^^^^^^^                    MAR Dendricity Sign is -
     475          SaltM2   = -0.833d-2 * G1snSV(ikl,isn)
     476     .             -0.583d-2 * G2snSV(ikl,isn)+ 0.833d00 !non-dendritic case
     477 
     478c       SaltMo   = (DendOK   * SaltM1 + (1.-DendOK) *     SaltM2       )
     479          SaltMo   = 0.625 !SaltMo pour d=s=0.5
     480 
     481!weighting SaltMo with surface snow density (Vionnet et al. 2012)
     482cc#AE   FacRho   = 1.25 - 0.0042 * ro__SV(ikl,isn)
     483cc#AE   SaltMo   = 0.34 * SaltMo + 0.66 * FacRho !needed for polar snow
     484          MIN_Mo   =  0.
     485c       SaltMo   =  max(SaltMo,MIN_Mo)
     486c       SaltMo   =  SaltOK   * SaltMo + (1.-SaltOK) * min(SaltMo,SaltMx)
     487c #TUNE SaltMo   =  SaltOK   * SaltMo - (1.-SaltOK) *     0.9500
     488          SaltMo   =  max(SaltMo,epsi-unun)
     489 
     490C +--Influence of Density on Threshold Shear Stress
     491C +  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
     492          Por_BS =  1. - 300. / ro_Ice
     493          ShearS = Por_BS / (1.-Por_BS)
     494C +...         SheaBS =  Arg(sqrt(shear = max shear stress in snow)):
     495C +            shear  =  3.420d00 * exp(-(Por_BS      +Por_BS)
     496C +  .                                  /(unun        -Por_BS))
     497C +            SheaBS :  see de Montmollin         (1978),
     498C +                      These Univ. Sci. Medic. Grenoble, Fig. 1 p. 124
     499 
     500C +--Snow Drift Index (Guyomarc'h & Merindol 1997, Ann.Glaciol.)
     501C +  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
     502          ArguSi      =     -0.085 *us__SV(ikl)/rCd10n
     503!V=u*/sqrt(CD) eqs 2 to 4 Gallee et al. 2001
     504 
     505          SaltSI(ikl,isn) = -2.868 * exp(ArguSi) + 1 + SaltMo
     506 
     507
     508C +--Threshold Friction Velocity
     509C +  ~~~~~~~~~~~~~~~~~~~~~~~~~~~
     510          if(ro__SV(ikl,isn)>300.) then
     511             Por_BS      =  1.000       - ro__SV(ikl,isn)     /ro_Ice
     512          else
     513             Por_BS      =  1.000  - 300. /ro_Ice
     514          endif
     515 
     516          ShearX =  Por_BS/max(epsi,1.-Por_BS)
     517          Fac_Mo = exp(-ShearX+ShearS)
     518C +     Gallee et al., 2001    eq 5, p5
     519 
     520          if (usth_param .eq. "gal") then
     521            Salt_us   =   (log(2.868) - log(1 + SaltMo)) * rCd10n/0.085
     522            Salt_us   = Salt_us * Fac_Mo
     523C +...  Salt_us   :  Extension of  Guyomarc'h & Merindol 1998 with
     524C +...              de Montmollin (1978). Gallee et al. 2001
     525          endif
     526 
     527          if (usth_param .eq. "lis") then !Liston et al. 2007
     528            if(ro__SV(ikl,isn)>300.) then
     529              Salt_us   = 0.005*exp(0.013*ro__SV(ikl,isn))
     530            else
     531              Salt_us   = 0.01*exp(0.003*ro__SV(ikl,isn))
     532            endif
     533          endif
     534 
     535          SnowOK   =  1 -min(1,iabs(isn-isnoSV(ikl))) !Switch new vs old snow
     536 
     537          usthSV(ikl) =     SnowOK *   (Salt_us)
     538     .                + (1.-SnowOK)*    usthSV(ikl)
     539 
     540        END DO
     541
     542
     543 
     544!  Feeback between blowing snow turbulent Scale  u* (commented here
     545!  since ustar is an input variable (not in/out) of inlandsis)
     546!  -----------------------------------------------------------------
     547
     548
     549!           VVa_OK      =  max(0.000001,       VVaSBL(ikl))
     550!           sss__N      =  vonkar      *       VVa_OK
     551!           sss__F      = (sqrCm0(ikl) - psim_z + psim_0)
     552!           usuth0      =  sss__N /sss__F                ! u* if NO Blow. Snow
     553 
     554!           sss__G      =  0.27417     * gravit
     555 
     556! !  ______________               _____
     557! !  Newton-Raphson (! Iteration, BEGIN)
     558! !  ~~~~~~~~~~~~~~               ~~~~~
     559!           DO iit=1,nit
     560!           sss__K      =  gravit      * r_Turb * A_Turb *za__SV(ikl)
     561!      .                                     *rCDmSV(ikl)*rCDmSV(ikl)
     562!      .                           /(1.+0.608*QaT_SV(ikl)-qsnoSV(ikl))
     563!           us_127      =  exp(    SblPom *log(us__SV(ikl)))
     564!           us_227      =  us_127         *    us__SV(ikl)
     565!           us_327      =  us_227         *    us__SV(ikl)
     566!           us_427      =  us_327         *    us__SV(ikl)
     567!           us_527      =  us_427         *    us__SV(ikl)
     568 
     569!           us__SV(ikl) =  us__SV(ikl)
     570!      .    - (  us_527     *sss__F     /sss__N
     571!      .      -  us_427
     572!      .      -  us_227     *qsnoSV(ikl)*sss__K
     573!      .      + (us__SV(ikl)*us__SV(ikl)-usthSV(ikl)*usthSV(ikl))/sss__G)
     574!      .     /(  us_427*5.27*sss__F     /sss__N
     575!      .      -  us_327*4.27
     576!      .      -  us_127*2.27*qsnoSV(ikl)*sss__K
     577!      .      +  us__SV(ikl)*2.0                                 /sss__G)
     578 
     579!           us__SV(ikl)= min(us__SV(ikl),usuth0)
     580!           us__SV(ikl)= max(us__SV(ikl),epsi  )
     581!           rCDmSV(ikl)=     us__SV(ikl)/VVa_OK
     582! ! #AE     sss__F     =     vonkar     /rCDmSV(ikl)
     583!           ENDDO
     584 
     585! !  ______________               ___
     586! !  Newton-Raphson (! Iteration, END  )
     587! !  ~~~~~~~~~~~~~~               ~~~
     588 
     589!           us_127      =  exp(    SblPom *log(us__SV(ikl)))
     590!           us_227      =  us_127         *    us__SV(ikl)
     591 
     592! !  Momentum            Turbulent Scale  u*: 0-Limit in case of no Blow. Snow
     593! !  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
     594!           dusuth      =  us__SV(ikl) - usthSV(ikl)       ! u* - uth*
     595!           signus      =  max(sign(unun,dusuth),zero)     ! 1 <=> u* - uth* > 0
     596!           us__SV(ikl) =                                  !
     597!      .                   us__SV(ikl)  *signus  +         ! u* (_BS)
     598!      .                   usuth0                          ! u* (nBS)
     599!      .                            *(1.-signus)           !       
     600
     601
     602
     603
     604!  Blowing Snow        Turbulent Scale ss*
     605!  ---------------------------------------
     606 
     607        hSalSV(ikl) = 8.436e-2  * us__SV(ikl)**SblPom
     608 
     609        if (qsalt_param .eq. "pom") then
     610          qSalSV(ikl) = (us__SV(ikl)**2 - usthSV(ikl)**2) *signus
     611     .               / (hSalSV(ikl) * gravit * us__SV(ikl) * 3.25)
     612        endif
     613 
     614        if (qsalt_param .eq. "bin") then
     615          qSalSV(ikl) = (us__SV(ikl) * us__SV(ikl)
     616     .                -usthSV(ikl) * usthSV(ikl))*signus
     617     .                * 0.535 / (hSalSV(ikl) * gravit)
     618        endif
     619 
     620        qSalSV(ikl) = qSalSV(ikl)/rht_SV(ikl) ! conversion kg/m3 to kg/kg
     621 
     622        ssstar      = rCDmSV(ikl) * (qsnoSV(ikl) - qSalSV(ikl))
     623     .              * r_Turb !Bintanja 2000, BLM
     624!r_Turb compensates for an overestim. of the blown snow part. fall velocity
     625 
     626        uss_SV(ikl) = min(zero    , us__SV(ikl) *ssstar)
     627        uss_SV(ikl) = max(-0.0001 , uss_SV(ikl))   
     628
     629
     630
     631
     632        ENDIF   ! BloMod
     633 
     634C + ------------------------------------------------------
    391635C +--Buffer Layer
    392 C +  ------------
     636C +  -----------------------------------------------------
    393637 
    394638          DO ikl=1,knonv
    … …  
    414658c #NP.         104. *sqrt( max( VV10SV(ikl)-6.0,0.0)))  ! Kotlyakov (1961)
    415659 
    416             density_kotlyakov = .true.
    417 c #AC       density_kotlyakov = .false.  !C.Agosta snow densisty as if BS is on b
     660!          C.Agosta option for snow density, same as for BS i.e.
     661!          is_ok_density_kotlyakov=.false.
    418662c #BS       density_kotlyakov = .false.  !C.Amory BS 2018
    419663C + ...     Fallen Snow Density, Adapted for Antarctica
    420             if (density_kotlyakov) then
     664            if (is_ok_density_kotlyakov) then
    421665                tt_tmp = TaT_SV(ikl)-TfSnow
    422666                !vv_tmp = VV10SV(ikl)
    … …  
    452696!    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    453697 
    454 c #BS       Bros_N      = frsno
    455 c #BS       ro_new      = ro__SV(ikl,max(1,isnoSV(ikl)))
    456 c #BS       ro_new      = max(Bros_N,min(roBdSV,ro_new))
    457 c #BS       Fac         = 1-((ro__SV(ikl,max(1,isnoSV(ikl)))
    458 c #BS.                     -roBdSV)/(500.-roBdSV))
    459 c #BS       Fac         = max(0.,min(1.,Fac))
    460 c #BS       dsnbSV(ikl) = Fac*dsnbSV(ikl)
    461 c #BS       Bros_N      = Bros_N     * (1.0-dsnbSV(ikl))
    462 c #BS.                  + ro_new     *      dsnbSV(ikl)
    463 
     698         if (BloMod) then
     699         Bros_N      = frsno
     700         ro_new      = ro__SV(ikl,max(1,isnoSV(ikl)))
     701         ro_new      = max(Bros_N,min(roBdSV,ro_new))
     702         Fac         = 1-((ro__SV(ikl,max(1,isnoSV(ikl)))
     703     .               -roBdSV)/(500.-roBdSV))
     704         Fac         = max(0.,min(1.,Fac))
     705         dsnbSV(ikl) = Fac*dsnbSV(ikl)
     706         Bros_N      = Bros_N     * (1.0-dsnbSV(ikl))
     707     .               + ro_new     *      dsnbSV(ikl)
     708         endif
    464709
    465710 
    … …  
    480725     .               max(Spher1*VV__SV(ikl)+Spher2,     !     Sphericity
    481726     .                   Spher3                   ))    !
     727! EV: now control buf_sph_pol and bug_siz_pol in physiq.def
    482728            Buf_G1      = (1. - Polair) *   Buf_G1      ! Temperate Snow
    483      .                        + Polair  *   G1_dSV      ! Polar     Snow
     729     .                        + Polair  *   buf_sph_pol ! Polar Snow
    484730            Buf_G2      = (1. - Polair) *   Buf_G2      ! Temperate Snow
    485      .                        + Polair  *   ADSdSV      ! Polar    Snow
     731     .                        + Polair  *   buf_siz_pol ! Polar Snow
    486732                G1      =                   Buf_G1      ! NO  Blown Snow
    487733                G2      =                   Buf_G2      ! NO  Blown Snow
    488734
    489  
     735
     736
     737            IF (BloMod) THEN
     738
    490739!     S.1. Meme  Type  de Neige  / same Grain Type
    491740!          ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
    492 c #BS       SameOK  =  max(zero,
    493 c #BS.                     sign(unun,    Buf_G1             *G1_dSV
    494 c #BS.                                 - eps_21                    ))
    495 c #BS       G1same  = ((1.0-dsnbSV(ikl))*Buf_G1+dsnbSV(ikl) *G1_dSV)
    496 c #BS       G2same  = ((1.0-dsnbSV(ikl))*Buf_G2+dsnbSV(ikl) *ADSdSV)
     741
     742           SameOK  =  max(zero,
     743     .         sign(unun,    Buf_G1             *G1_dSV
     744     .                            - eps_21                    ))
     745           G1same  = ((1.0-dsnbSV(ikl))*Buf_G1+dsnbSV(ikl) *G1_dSV)
     746           G2same  = ((1.0-dsnbSV(ikl))*Buf_G2+dsnbSV(ikl) *ADSdSV)
    497747!           Blowing Snow Properties:                         G1_dSV, ADSdSV
    498748 
    499749!     S.2. Types differents / differents Types
    500750!          ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
    501 c #BS       typ__1  =  max(zero,sign(unun,epsi-Buf_G1))   ! =1.=> Dendritic
    502 c #BS       zroNEW  =     typ__1  *(1.0-dsnbSV(ikl))      ! fract.Dendr.Lay.
    503 c #BS.              + (1.-typ__1) *     dsnbSV(ikl)       !
    504 c #BS       G1_NEW  =     typ__1  *Buf_G1                 ! G1 of Dendr.Lay.
    505 c #BS.              + (1.-typ__1) *G1_dSV                 !
    506 c #BS       G2_NEW  =     typ__1  *Buf_G2                 ! G2 of Dendr.Lay.
    507 c #BS.              + (1.-typ__1) *ADSdSV                 !
    508 c #BS       zroOLD  = (1.-typ__1) *(1.0-dsnbSV(ikl))      ! fract.Spher.Lay.
    509 c #BS.              +     typ__1  *     dsnbSV(ikl)       !
    510 c #BS       G1_OLD  = (1.-typ__1) *Buf_G1                 ! G1 of Spher.Lay.
    511 c #BS.              +     typ__1  *G1_dSV                 !
    512 c #BS       G2_OLD  = (1.-typ__1) *Buf_G2                 ! G2 of Spher.Lay.
    513 c #BS.              +     typ__1  *ADSdSV                 !
    514 c #BS       SizNEW  =    -G1_NEW  *DDcdSV/G1_dSV          ! Size  Dendr.Lay.
    515 c #BS.               +(1.+G1_NEW         /G1_dSV)         !
    516 c #BS.                  *(G2_NEW  *DScdSV/G1_dSV          !
    517 c #BS.               +(1.-G2_NEW         /G1_dSV)*DFcdSV) !
    518 c #BS       SphNEW  =     G2_NEW         /G1_dSV          ! Spher.Dendr.Lay.
    519 c #BS       SizOLD  =     G2_OLD                          ! Size  Spher.Lay.
    520 c #BS       SphOLD  =     G1_OLD         /G1_dSV          ! Spher.Spher.Lay.
    521 c #BS       Siz_av =     (zroNEW*SizNEW+zroOLD*SizOLD)    ! Averaged Size
    522 c #BS       Sph_av = min( zroNEW*SphNEW+zroOLD*SphOLD     !
    523 c #BS.                   ,  unun)                         ! Averaged Sphericity
    524 c #BS       Den_av = min((Siz_av -(    Sph_av *DScdSV     !
    525 c #BS.                            +(1.-Sph_av)*DFcdSV))   !
    526 c #BS.                 / (DDcdSV -(    Sph_av *DScdSV     !
    527 c #BS.                            +(1.-Sph_av)*DFcdSV))   !
    528 c #BS.                   ,  unun)                         !
    529 c #BS       DendOK  = max(zero,                           !
    530 c #BS.                    sign(unun,     Sph_av *DScdSV   ! Small   Grains
    531 c #BS.                              +(1.-Sph_av)*DFcdSV   ! Faceted Grains
    532 c #BS.                              -    Siz_av        )) !
     751           typ__1  =  max(zero,sign(unun,epsi-Buf_G1))   ! =1.=> Dendritic
     752           zroNEW  =     typ__1  *(1.0-dsnbSV(ikl))      ! fract.Dendr.Lay.
     753     .            + (1.-typ__1) *     dsnbSV(ikl)       !
     754           G1_NEW  =     typ__1  *Buf_G1                 ! G1 of Dendr.Lay.
     755     .            + (1.-typ__1) *G1_dSV                 !
     756           G2_NEW  =     typ__1  *Buf_G2                 ! G2 of Dendr.Lay.
     757     .            + (1.-typ__1) *ADSdSV                 !
     758           zroOLD  = (1.-typ__1) *(1.0-dsnbSV(ikl))      ! fract.Spher.Lay.
     759     .            +     typ__1  *     dsnbSV(ikl)       !
     760           G1_OLD  = (1.-typ__1) *Buf_G1                 ! G1 of Spher.Lay.
     761     .            +     typ__1  *G1_dSV                 !
     762           G2_OLD  = (1.-typ__1) *Buf_G2                 ! G2 of Spher.Lay.
     763     .            +     typ__1  *ADSdSV                 !
     764           SizNEW  =    -G1_NEW  *DDcdSV/G1_dSV          ! Size  Dendr.Lay.
     765     .            +(1.+G1_NEW         /G1_dSV)          !
     766     .                  *(G2_NEW  *DScdSV/G1_dSV        !
     767     .            +(1.-G2_NEW         /G1_dSV)*DFcdSV) !
     768           SphNEW  =     G2_NEW         /G1_dSV          ! Spher.Dendr.Lay.
     769           SizOLD  =     G2_OLD                          ! Size  Spher.Lay.
     770           SphOLD  =     G1_OLD         /G1_dSV          ! Spher.Spher.Lay.
     771           Siz_av  =     (zroNEW*SizNEW+zroOLD*SizOLD)   ! Averaged Size
     772           Sph_av  = min( zroNEW*SphNEW+zroOLD*SphOLD    !
     773     .                 ,  unun)                         ! Averaged Sphericity
     774           Den_av  = min((Siz_av -(    Sph_av *DScdSV    !
     775     .            +(1.-Sph_av)*DFcdSV))                 !
     776     .            / (DDcdSV -(    Sph_av *DScdSV        !
     777     .            +(1.-Sph_av)*DFcdSV))                 !
     778     .                   ,  unun)                       !
     779           DendOK  = max(zero,                           !
     780     .                    sign(unun,     Sph_av *DScdSV   ! Small   Grains
     781     .                              +(1.-Sph_av)*DFcdSV   ! Faceted Grains
     782     .                              -    Siz_av        )) !
    533783C +...      REMARQUE: le  type moyen (dendritique ou non) depend
    534784C +         ^^^^^^^^  de la  comparaison avec le diametre optique
    … …  
    538788C +                   of a recent snow    having zero dendricity
    539789 
    540 c #BS       G1diff  =(   -DendOK *Den_av
    541 c #BS.               +(1.-DendOK)*Sph_av) *G1_dSV
    542 c #BS       G2diff  =     DendOK *Sph_av  *G1_dSV
    543 c #BS.               +(1.-DendOK)*Siz_av
    544 c #BS       G1      =     SameOK *G1same
    545 c #BS.               +(1.-SameOK)*G1diff
    546 c #BS       G2      =     SameOK *G2same
    547 c #BS.               +(1.-SameOK)*G2diff
    548  
     790           G1diff  =(   -DendOK *Den_av
     791     .            +(1.-DendOK)*Sph_av) *G1_dSV
     792           G2diff  =     DendOK *Sph_av  *G1_dSV
     793     .            +(1.-DendOK)*Siz_av
     794           G1      =     SameOK *G1same
     795     .            +(1.-SameOK)*G1diff
     796           G2      =     SameOK *G2same
     797     .            +(1.-SameOK)*G2diff
     798           ENDIF
     799
    549800
    550801 
    … …  
    634885     .                            /max(epsi,BrosSV(ikl))!& [m w.e.] -> [m]
    635886 
    636 
    637887 
    638888          END DO
    … …  
    640890
    641891
    642 ! Snow Pack Discretization
    643 ! ========================
    644 
    645 !            **********
     892! Snow Pack Discretization(option XF in MAR)
     893! ==========================================
     894
     895         
     896      if (discret_xf.AND.klonv.eq.1) then
     897
     898       if(isnoSV(1).ge.1.or.NLaysv(1).ge.1) then
     899C +          **********
     900         call SISVAT_zSn
     901C +          **********
     902       endif
     903      else
     904C +          **********
    646905        call SISVAT_zSn
    647 !            **********
    648 
    649 !            **********
     906C +          **********
     907      endif
     908 
     909C +          **********
    650910! #ve   call SISVAT_wEq('_zSn  ',0)
    651 !            **********
    652 
    653 
     911C +          **********
    654912
    655913! Add a new Snow Layer
    … …  
    664922            TsisSV(ikl,isn) = TsisSV(ikl,isn) * (1-NLaysv(ikl))
    665923     .                  + min(TaT_SV(ikl),Tf_Sno) *NLaysv(ikl)
    666 
    667924            ro__SV(ikl,isn) = ro__SV(ikl,isn) * (1-NLaysv(ikl))
    668925     .                      + Brossv(ikl)     *    NLaysv(ikl)
    … …  
    699956
    700957
    701       END IF
     958      END IF  ! SnoMod
    702959
    703960
    … …  
    740997! =============================
    741998!Etienne: as in inlandis we do not call vgopt, we need to define
    742 !the albedo  alb_SV and to calculate the
     999!the albedo alb_SV and to calculate the
    7431000!absorbed Solar Radiation by Surfac (Normaliz)[-] SoSosv
    7441001
    … …  
    8101067
    8111068
    812 ! Aerodynamic Resistance
    813 ! ^^^^^^^^^^^^^^^^^^^^^^
    814 
    815 
    816        DO ikl=1,knonv
    817           ram_sv(ikl) = 1./(cdM_SV(ikl)*max(VV__SV(ikl),eps6))
    818           rah_sv(ikl) = 1./(cdH_SV(ikl)*max(VV__SV(ikl),eps6))
    819         END DO
     1069! Aerodynamic Resistance (calculated from drags given by LMDZ)
     1070! Commented because already calculated in surf_inlandsis_mod
     1071! ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
     1072!       DO ikl=1,knonv
     1073!          ram_sv(ikl) = 1./(cdM_SV(ikl)*max(VV__SV(ikl),eps6))
     1074!          rah_sv(ikl) = 1./(cdH_SV(ikl)*max(VV__SV(ikl),eps6))
     1075!        END DO
    8201076
    8211077
    … …  
    8251081
    8261082
    827       if (iflag_tsurf_inlandsis .eq. 0) then
     1083      if (iflag_temp_inlandsis .eq. 0) then
    8281084
    8291085       call SISVAT_TSo
    8301086
    8311087      else
     1088        DO ikl=1,knonv
     1089        Tsf_SV(ikl)=Tsrfsv(ikl)
     1090        END DO
    8321091
    8331092       call SISVAT_TS2
    … …  
    9381197! Surface Temperature
    9391198! ^^^^^^^^^^^^^^^^^^^^
    940 !           Tsrfsv(ikl) =TsisSV(ikl,isnoSV(ikl))
    941 
     1199
     1200          IF (iflag_tsurf_inlandsis .EQ. 0) THEN   
     1201
     1202            Tsrfsv(ikl) =TsisSV(ikl,isnoSV(ikl))
     1203
     1204          ELSE IF (iflag_tsurf_inlandsis .GT. 0) THEN
    9421205! Etienne: extrapolation from the two uppermost levels:
    9431206
    … …  
    9591222
    9601223
    961         END DO
    962 
     1224         ELSE !(default)
     1225
     1226           Tsrfsv(ikl) =TsisSV(ikl,isnoSV(ikl))
     1227
     1228         END IF
     1229
     1230
     1231         END DO
    9631232
    9641233! Snow Pack Properties (sphericity, dendricity, size)
    … …  
    9671236      IF (SnoMod)                                                 THEN
    9681237
    969 !            **********
     1238      if (discret_xf .AND. klonv.eq.1) then
     1239      if(isnoSV(1).ge.1) then
     1240C +          **********
     1241      call SISVAT_GSn
     1242C +          **********
     1243      endif
     1244      else
     1245C +          **********
    9701246        call SISVAT_GSn
    971 !            **********
    972 
    973 !            **********
    974 ! #ve   call SISVAT_wEq('_GSn  ',0)
    975 !            **********
    976 
     1247C +          **********
     1248      endif
    9771249
    9781250
    … …  
    9901262C +--Roughness Length for Momentum
    9911263C +  -----------------------------
     1264
     1265! ETIENNE WARNING: changes have been made wrt original SISVAT
    9921266 
    9931267C +--Land+Sea-Ice / Ice-free Sea Mask
    9941268C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
    995         DO ikl=1,klonv
     1269        DO ikl=1,knonv
    9961270          IcIndx(ikl) = 0
    9971271        ENDDO
    9981272        DO isn=1,nsno
    999         DO ikl=1,klonv
     1273        DO ikl=1,knonv
     1274
    10001275          IcIndx(ikl) = max(IcIndx(ikl),
    1001      .                      isn*max(0,
    1002      .                              sign(1,
    1003      .                                   int(ro__SV(ikl,isn)-900.))))
     1276     .                  isn*max(0,
     1277     .                  sign(1,
     1278     .                  int(ro__SV(ikl,isn)-900.))))
    10041279        ENDDO
    10051280        ENDDO
    10061281 
    1007         DO ikl=1,klonv
     1282        DO ikl=1,knonv
    10081283          LISmsk    =     1. ! in inlandsis, land only
    10091284          IceMsk    =     max(0,sign(1   ,IcIndx(ikl)-1)  )
    10101285          SnoMsk    = max(min(isnoSV(ikl)-iiceSV(ikl),1),0)
    10111286
    1012  
    1013 
    1014           Z0mLnd      =max( Z0_ICE    ,    5.e-5  )  ! Min set := Z0 on *
    10151287
    10161288C +--Z0 Smooth Regime over Snow (Andreas 1995, CRREL Report 95-16, p. 8)
    10171289C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^
    10181290          Z0m_nu =       5.e-5 ! z0s~(10-d)*exp(-vonkar/sqrt(1.1e-03))
    1019  
     1291
    10201292C +--Z0 Saltat.Regime over Snow (Gallee  et al., 2001, BLM 99 (19) p.11)
    10211293C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^
     1294
    10221295          u2star =       us__SV(ikl) *us__SV(ikl)
    10231296          Z0mBSn =       u2star      *0.536e-3   -  61.8e-6
    10241297          Z0mBSn =   max(Z0mBS0      ,Z0mBSn)
    1025  
     1298
    10261299C +--Z0 Smooth + Saltat. Regime
    10271300C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^
    10281301          Z0enSV(ikl) =  Z0m_nu
    10291302     .                +  Z0mBSn
    1030  
    1031 C +--Rough   Snow Surface Roughness Length (Typical Value)
    1032 C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
    1033 c #tz     Z0m_Sn =    0.250e-3 ! Andreas 1995, CRREL Report 95-16, fig.1&p.2
    1034                                ! z0r~(10-d)*exp(-vonkar/sqrt(1.5e-03))-5.e-5
    1035           Z0m_Sn =    2.000e-3 ! Calibration    of MAR
    1036 c #TZ     Z0m_Sn =    1.000e-3 ! Exemple Tuning in RACMO
    1037 c #TZ     Z0m_Sn =    0.500e-3 ! Exemple Tuning in MAR
    1038  
     1303
     1304       
     1305! Calculation of snow roughness length
     1306!=====================================
     1307          IF (iflag_z0m_snow .EQ. 0) THEN
     1308
     1309          Z0m_Sn=prescribed_z0m_snow
     1310
     1311          ELSE IF (iflag_z0m_snow .EQ. 1) THEN
     1312
     1313          Z0m_Sn=Z0enSV(ikl)
     1314
     1315          ELSE IF (iflag_z0m_snow .EQ. 2) THEN                             
     1316
    10391317C +--Rough   Snow Surface Roughness Length (Variable Sastrugi Height)
    10401318C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
    … …  
    10451323! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    10461324! Z0=f(T) deduced from observations, Adelie Land, dec2012-dec2013
     1325
     1326         
    10471327          coefa = 0.1658 !0.1862 !Ant
    10481328          coefb = -50.3869 !-55.7718 !Ant
    … …  
    10551335          coefc = log(z03/z02)/(ta3-ta2)
    10561336          coefd = log(z03)-coefc*ta3
     1337
    10571338          if (TaT_SV(ikl) .lt. ta1) then
    10581339            Z0_obs = z01
    … …  
    10661347          endif
    10671348 
    1068 
    1069 ! pour le moment, on choisit une valeur fixe
    1070           Z0_obs = 1.000e-3
    1071  
    1072 cCA       Snow roughness lenght deduced from observations
    1073 cCA       (parametrization if no Blowing Snow)
    1074 cCA       ----------------------------------- C. Agosta 09-2016 -----
    1075 cCA       Substract Z0enSV(ikl) because re-added later in Z0mnSV(ikl)
    1076           Z0m_Sn = Z0_obs - Z0enSV(ikl)
    1077 cCA       -----------------------------------------------------------
    1078  
    1079           param = Z0_obs/1. ! param(s) | 1.(m/s)=TUNING
    1080  
     1349          Z0m_Sn=Z0_obs
     1350
     1351
     1352          ELSE
     1353
     1354          Z0m_Sn=0.500e-3  ! default=0.500e-3m (tuning of MAR)
     1355
     1356          ENDIF
     1357 
     1358
     1359
     1360!          param = Z0_obs/1. ! param(s) | 1.(m/s)=TUNING
    10811361c #SZ     Z0Sa_N =                   (us__SV(ikl) -0.2)*param   ! 0.0001=TUNING
    10821362c #SZ.           * max(zero,sign(unun,TfSnow-eps9
    … …  
    11091389c #ZN     Z0enSV(ikl) =  max(Z0enSV(ikl), Z0m_nu)
    11101390 
     1391
    11111392C +--Z0 Smooth Regime over Snow (Andreas etAl., 2004
    11121393C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^  ams.confex.com/ams/pdfpapers/68601.pdf)
    … …  
    11321413c #ZA     Z0m_Sn =           DDs_SV(ikl)* Z0m_90 / 45.
    11331414c #ZA.         - DDs_SV(ikl)*DDs_SV(ikl)* Z0m_90 /(90.*90.)
    1134  
    1135 C +--Z0  (Erosion)    over Snow (instantaneous or time average)
     1415
     1416
     1417
     1418
     1419C +--Z0  (Erosion)    over Snow (instantaneous)
    11361420C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^
    11371421          Z0e_SV(ikl) =  Z0enSV(ikl)
    1138           Z0e_SV(ikl) =  Z0emSV(ikl)
    1139  
    1140 C +--Momentum  Roughness Length
    1141 C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^                              ! Contribution of
    1142           Z0mnSV(ikl) =  Z0mLnd                              ! land Form
    1143      .                + (Z0m_Sn                              ! Sastrugi   Form
    1144      .                +  Z0enSV(ikl))   *SnoMsk              ! Snow    Erosion
     1422 
     1423C +--Momentum  Roughness Length (Etienne: changes wrt original SISVAT)
     1424C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^                             
     1425          Z0mnSV(ikl) =  Z0m_nu *(1-SnoMsk)                     ! Ice z0
     1426     .                + (Z0m_Sn)*SnoMsk                         ! Snow Sastrugi Form and Snow Erosion
    11451427 
    11461428
    … …  
    11541436c #GL.                     /(920.00                 -600.))) !
    11551437 
    1156 C +--Mom. Roughness Length, Instantaneous OR Box Moving Average in Time
    1157 C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
     1438C +--Mom. Roughness Length, Instantaneous
     1439C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
    11581440          Z0m_SV(ikl) =  Z0mnSV(ikl)                         ! Z0mnSV  instant.
    1159 !          Z0m_SV(ikl) =  Z0mmSV(ikl)                         ! Z0mnSV  Average
    1160  
    1161 C +--Corrected Threshold Friction Velocity before Erosion    ! Marticorena and
    1162 C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^    ! Bergametti 1995
    1163 ! not used anymore since Marticorena and Bergametti disabled !CK 18/07/2018
    1164 cc #BS     Z0e_SV(ikl) =   min(Z0m_SV(ikl),Z0e_SV(ikl))       !
    1165 cc #MB     f_eff=    log(0.35*(0.1        /Z0e_SV(ikl))**0.8) ! JGR 100
    1166 cc #MB     f_eff=1.-(log(      Z0m_SV(ikl)/Z0e_SV(ikl)      ))! (20) p. 16420
    1167 cc #MB.            /(max(      f_eff      ,epsi             ))! p.16426 2nd ?
    1168 cc #MB     f_eff=    max(      f_eff      ,epsi              )! CONTROL
    1169 cc #MB     f_eff=1.0   -(1.0 - f_eff)     /5.00               ! TUNING
    1170 cc #MB     f_eff=    min(      f_eff      ,1.00              )!
    1171 cc #MB    usthSV(ikl) =       usthSV(ikl)/f_eff              !
    1172  
    11731441 
    11741442 
    … …  
    11771445 
    11781446          Z0hnSV(ikl) =     Z0mnSV(ikl)/  7.4
    1179 c #SH     Z0hnSV(ikl) =     Z0mnSV(ikl)/100.0
    1180 C +                         Z0h = Z0m  /100.0   over the Sahel
    1181 C +                                            (Taylor & Clark, QJRMS 127,p864)
    1182  
    1183 c #RN     rstar       =     Z0mnSV(ikl) * us__SV(ikl) / akmol
    1184 c #RN     rstar       = max(epsi,min(rstar,thous))
    1185 c #RN     alors       =          log(rstar)
    1186 c #RN     rstar0      = 1.250e0 * max(zero,sign(unun,0.135e0 - rstar))
    1187 c #RN.                +(1.      - max(zero,sign(unun,0.135e0 - rstar)))
    1188 c #RN.                *(0.149e0 * max(zero,sign(unun,2.500e0 - rstar))
    1189 c #RN.                + 0.317e0
    1190 c #RN.                *(1.      - max(zero,sign(unun,2.500e0 - rstar))))
    1191 c #RN     rstar1      = 0.      * max(zero,sign(unun,0.135e0 - rstar))
    1192 c #RN.                +(1.      - max(zero,sign(unun,0.135e0 - rstar)))
    1193 c #RN.                *(-0.55e0 * max(zero,sign(unun,2.500e0 - rstar))
    1194 c #RN.                - 0.565
    1195 c #RN.                *(1.      - max(zero,sign(unun,2.500e0 - rstar))))
    1196 c #RN     rstar2      = 0.      * max(zero,sign(unun,0.135e0 - rstar))
    1197 c #RN.                +(1.      - max(zero,sign(unun,0.135e0 - rstar)))
    1198 c #RN.                *(0.      * max(zero,sign(unun,2.500e0 - rstar))
    1199 c #RN.                - 0.183
    1200 c #RN.                *(unun    - max(zero,sign(unun,2.500e0 - rstar))))
    1201  
    1202 cXF    #RN does not work over bare ice
    1203 cXF    MAR is then too warm and not enough melt
    1204  
    1205 c #RN     if(ro__SV(ikl,isnoSV(ikl))>50
    1206 c #RN.  .and.ro__SV(ikl,isnoSV(ikl))<roSdSV)then
    1207  
    1208 c #RN     Z0hnSV(ikl) = max(zero
    1209 c #RN.                , sign(unun,zzsnsv(ikl,isnoSV(ikl))-epsi))
    1210 c #RN.                * exp(rstar0+rstar1*alors+rstar2*alors*alors)
    1211 c #RN.                * 0.001e0 + Z0hnSV(ikl) * ( 1. - max(zero
    1212 c #RN.                , sign(unun,zzsnsv(ikl,isnoSV(ikl))-epsi)))
    1213  
    1214 c #RN     endif
     1447 
     1448          IF (is_ok_z0h_rn) THEN
     1449
     1450          rstar       =     Z0mnSV(ikl) * us__SV(ikl) / akmol
     1451          rstar       = max(epsi,min(rstar,R_1000))
     1452          alors       =          log(rstar)
     1453          rstar0      = 1.250e0 * max(zero,sign(unun,0.135e0 - rstar))
     1454     .                +(1.      - max(zero,sign(unun,0.135e0 - rstar)))
     1455     .                *(0.149e0 * max(zero,sign(unun,2.500e0 - rstar))
     1456     .                + 0.317e0
     1457     .                *(1.      - max(zero,sign(unun,2.500e0 - rstar))))
     1458          rstar1      = 0.      * max(zero,sign(unun,0.135e0 - rstar))
     1459     .                +(1.      - max(zero,sign(unun,0.135e0 - rstar)))
     1460     .                *(-0.55e0 * max(zero,sign(unun,2.500e0 - rstar))
     1461     .                - 0.565
     1462     .                *(1.      - max(zero,sign(unun,2.500e0 - rstar))))
     1463          rstar2      = 0.      * max(zero,sign(unun,0.135e0 - rstar))
     1464     .                +(1.      - max(zero,sign(unun,0.135e0 - rstar)))
     1465     .                *(0.      * max(zero,sign(unun,2.500e0 - rstar))
     1466     .                - 0.183
     1467     .                *(unun    - max(zero,sign(unun,2.500e0 - rstar))))
     1468 
     1469         
     1470
     1471!XF    #RN (is_ok_z0h_rn) does not work well over bare ice
     1472!XF    MAR is then too warm and not enough melt
     1473 
     1474         if(ro__SV(ikl,isnoSV(ikl))>50
     1475     .  .and.ro__SV(ikl,isnoSV(ikl))<roSdSV)then
     1476 
     1477             Z0hnSV(ikl) = max(zero
     1478     .                , sign(unun,zzsnsv(ikl,isnoSV(ikl))-epsi))
     1479     .                * exp(rstar0+rstar1*alors+rstar2*alors*alors)
     1480     .                * 0.001e0 + Z0hnSV(ikl) * ( 1. - max(zero
     1481     .                , sign(unun,zzsnsv(ikl,isnoSV(ikl))-epsi)))
     1482 
     1483          endif
     1484
     1485
     1486          ENDIF
    12151487 
    12161488          Z0h_SV(ikl) =     Z0hnSV(ikl)
    1217 !          Z0h_SV(ikl) =     Z0hmSV(ikl)
    12181489 
    12191490

  • LMDZ6/branches/Ocean_skin/libf/phylmd/inlandsis/sisvat_bsn.F

    r3792 r4013  
    99C |                                                                        |
    1010C |   SISVAT_bsn computes the snow erosion mass according to both the      |
    11 C |   theoretical maximum erosion amount computed in SISVATesbl and the    |
     11C |   theoretical maximum erosion amount computed in inlandsis and the     |
    1212C |   availability of snow (currently in the uppermost snow layer only)    |
    1313C |                                                                        |
    14 C |   Preprocessing  Option: SISVAT IO (not always a standard preprocess.) |
    15 C |   ^^^^^^^^^^^^^^^^^^^^^  ^^^^^^^^^                                     |
    16 C |   FILE                 |      CONTENT                                  |
    17 C |   ~~~~~~~~~~~~~~~~~~~~~+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
    18 C | # stdout               | #sb: OUTPUT of Snow Erosion                   |
    19 C |                        |      unit  6, SubRoutine  SISVAT_BSn **ONLY** |
    2014C +------------------------------------------------------------------------+
    2115 

  • LMDZ6/branches/Ocean_skin/libf/phylmd/inlandsis/sisvat_qsn.F

    r3792 r4013  
    6161      use VARxSV
    6262      use VARySV
     63      use surface_data, only: is_ok_slush,opt_runoff_ac
     64
    6365
    6466      IMPLICIT NONE
    … …  
    235237 
    236238      DO ikl=1,knonv
    237        DO isn=min(nsno,isnoSV(ikl)+1),1,-1
     239
     240      DO isn=min(nsno,isnoSV(ikl)+1),1,-1
    238241! EV          DO isn=nsno,1,-1
    239242C +--Energy, store Previous Content
    … …  
    243246     .                + ro__SV(ikl,isn) * Cn_dSV * dTSnow
    244247     .                                           * dzsnSV(ikl,isn)
    245 
    246           Tsave       = TsisSV(ikl,isn)
    247 
    248248          TsisSV(ikl,isn) =                        TfSnow
    249249 
    … …  
    312312          rdzNEW      = WaFrez + rdzsno
    313313          ro__SV(ikl,isn) =      rdzNEW /max(epsi, dzsnSV(ikl,isn))
    314 
    315 ! EV: condition on Enfrez
    316 !          if (EnFrez .eq. 0.) then
    317          
    318           TsisSV(ikl,isn) = Tsave
    319 !          else
    320314          TsisSV(ikl,isn) =      TfSnow
    321315     .                + EnFrez /(Cn_dSV *max(epsi, rdzNEW)        )
    322 !          end if
    323316          EExcsv(ikl) =          EExcsv(ikl)     - EnFrez
    324317          wer_SV(ikl) = WaFrez
    … …  
    499492          rusnew      = rusnSV(ikl) * SWf_SV(ikl)
    500493 
    501           if(isnoSV(ikl)<=1) rusnew = 0.
     494          if(isnoSV(ikl)<=1 .OR. opt_runoff_ac) rusnew = 0.
    502495          !if(ivgtSV(ikl)>=1) rusnew = 0.
    503496 
    504497c #EU                        rusnew = 0.
    505 c #AC                        rusnew = 0.
     498c #AC               rusnew = 0.
     499
    506500          RnofSV(ikl) = RnofSV(ikl)
    507501     .                +(rusnSV(ikl) - rusnew     ) / dt__SV
    … …  
    545539        ENDDO
    546540 
    547 C +--Slush Formation (CAUTION: ADD RunOff Possibility before Activation)
     541C +--Slush Formation (Activated. CAUTION: ADD RunOff Possibility before Activation)
    548542C +  ---------------  ^^^^^^^  ^^^
    549543 
    550  
    551 c #SU DO  ikl=1,knonv
    552 c #SU  DO isn=1,isnoSV(ikl)
    553 c #SU     kSlush = min(1,max(0,isn+1-ispiSV(ikl)))        ! Slush Switch
     544      IF (is_ok_slush) THEN
     545
     546      DO  ikl=1,knonv
     547       DO isn=1,isnoSV(ikl)
     548          kSlush = min(1,max(0,isn+1-ispiSV(ikl)))        ! Slush Switch
    554549 
    555550C +--Available Additional Pore   Volume [-]
    556551C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
    557 c #SU     PorVol = 1. - ro__SV(ikl,isn)                    ! [--]
    558 c #SU.           *(1. - eta_SV(ikl,isn))/ ro_Ice           !
    559 c #SU.           -      eta_SV(ikl,isn)                    !
    560 c #SU.                 *ro__SV(ikl,isn) / ro_Wat           !
    561 c #SU     PorVol =  max(PorVol          , zero  )          !
    562 c #SU     zWater =      dzsnSV(ikl,isn) * PorVol * 1000.   ! [mm] OR [kg/m2]
    563 c #SU.           * (1. -SWS_SV(ikl)                        ! 0 <=> freezing
    564 c #SU.                *(1 -min(1,iabs(isn-isnoSV(ikl)))))  ! 1 <=> isn=isnoSV
    565 c #SU     zSlush =  min(rusnSV(ikl)     , zWater)          ! [mm] OR [kg/m2]
    566 c #SU     ro_new      =(dzsnSV(ikl,isn) * ro__SV(ikl,isn)  !
    567 c #SU.                 +zSlush                           ) !
    568 c #SU.            / max(dzsnSV(ikl,isn) , epsi           ) !
    569 c #SU     if(ro_new<ro_Ice+20) then ! MAX 940kg/m3         !
    570 c #SU      rusnSV(ikl)  = rusnSV(ikl)          - zSlush    ! [mm] OR [kg/m2]
    571 c #SU      RuofSV(ikl,4)= max(0.,RuofSV(ikl,4) - zSlush/dt__SV)
    572 c #SU      eta_SV(ikl,isn) =(ro_new - ro__SV(ikl,isn)      !
    573 c #SU.                     *(1.     - eta_SV(ikl,isn)))    !
    574 c #SU.                / max (ro_new , epsi            )    !
    575 c #SU      ro__SV(ikl,isn) =      ro_new                   !
    576 c #SU     endif
    577 c #SU   END DO
    578 c #SU END DO
    579  
     552          PorVol = 1. - ro__SV(ikl,isn)                    ! [--]
     553     .           *(1. - eta_SV(ikl,isn))/ ro_Ice           !
     554     .           -      eta_SV(ikl,isn)                    !
     555     .                 *ro__SV(ikl,isn) / ro_Wat           !
     556          PorVol =  max(PorVol          , zero  )          !
     557          zWater =      dzsnSV(ikl,isn) * PorVol * 1000.   ! [mm] OR [kg/m2]
     558     .           * (1. -SWS_SV(ikl)                        ! 0 <=> freezing
     559     .                *(1 -min(1,iabs(isn-isnoSV(ikl)))))  ! 1 <=> isn=isnoSV
     560          zSlush =  min(rusnSV(ikl)     , zWater)          ! [mm] OR [kg/m2]
     561          ro_new      =(dzsnSV(ikl,isn) * ro__SV(ikl,isn)  !
     562     .                 +zSlush                           ) !
     563     .            / max(dzsnSV(ikl,isn) , epsi           ) !
     564          if(ro_new<ro_Ice+20) then ! MAX 940kg/m3         !
     565           rusnSV(ikl)  = rusnSV(ikl)          - zSlush    ! [mm] OR [kg/m2]
     566           RuofSV(ikl,4)= max(0.,RuofSV(ikl,4) - zSlush/dt__SV)
     567           eta_SV(ikl,isn) =(ro_new - ro__SV(ikl,isn)      !
     568     .                     *(1.     - eta_SV(ikl,isn)))    !
     569     .                / max (ro_new , epsi            )    !
     570           ro__SV(ikl,isn) =      ro_new                   !
     571          endif
     572        END DO
     573      END DO
     574      END IF
    580575 
    581576C +--Impact of the Sublimation/Deposition on the Surface Mass Balance

  • LMDZ6/branches/Ocean_skin/libf/phylmd/inlandsis/sisvat_tso.F

    r3792 r4013  
    132132
    133133      integer   nt_srf,it_srf,itEuBk          ! HL: Surface Scheme
    134       parameter(nt_srf=10)                    !
     134      parameter(nt_srf=10)                     ! 10 before
    135135      real      agpsrf,xgpsrf,dt_srf,dt_ver   !
    136136      real      etaBAK(knonv)                 !
    … …  
    153153C +                                           ! including   Snow Melt  Energy
    154154 
    155  
     155C +-- Initilialisation of local arrays
     156C +   ================================
     157        DO ikl=1,knonv
     158
     159          mu_sno(ikl)=0.
     160          mu__dz(ikl,:)=0.   
     161          dtC_sv(ikl,:)=0.     
     162          IRs__D(ikl)=0.                 
     163          dIRsdT(ikl)=0.                 
     164          f_HSHL(ikl)=0.                 
     165          dRidTs(ikl)=0.                 
     166          HS___D(ikl)=0.               
     167          f___HL(ikl)=0.             
     168          HL___D(ikl)=0.           
     169          TSurf0(ikl)=0.     
     170          qsatsg(ikl)=0.
     171          dqs_dT(ikl)=0.                 
     172          Psi(ikl)=0.               
     173          RHuSol(ikl)=0.                 
     174          Diag_A(ikl,:)=0.     
     175          Diag_B(ikl,:)=0.     
     176          Diag_C(ikl,:)=0.     
     177          Term_D(ikl,:)=0.     
     178          Aux__P(ikl,:)=0.     
     179          Aux__Q(ikl,:)=0.     
     180          etaBAK(ikl)=0.               
     181          etaNEW(ikl)=0.               
     182          etEuBk(ikl)=0.                 
     183          fac_dt(ikl)=0.
     184          faceta(ikl)=0. 
     185          PsiArg(ikl)=0.
     186          SHuSol(ikl)=0. 
     187
     188        END DO
     189
     190       
    156191
    157192C +--Heat Conduction Coefficient (zero in the Layers over the highest one)
    … …  
    336371C +--Snow highest Layer (dummy!)
    337372C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^
    338         isl=  min(isnoSV(1)+1,nsno)
    339         DO ikl=1,knonv
     373
     374        !EV!isl=  min(isnoSV(1)+1,nsno)
     375
     376        DO ikl=1,knonv
     377! EV try to calculate isl at the ikl grid point
     378          isl=  min(isnoSV(ikl)+1,nsno)
     379
    340380          Elem_A          =  dtC_sv(ikl,isl)  *mu__dz(ikl,isl)
    341381          Elem_C          =  0.
    … …  
    384424c    .                                   / den_qs              !
    385425c         qsatsg(ikl) = .0038 *        exp(arg_qs)             !
    386 
    387426!          sp = (pst_SV(ikl) + ptopSV) * 10.
    388427
    389           sp=ps__SV(ikl)
     428          !sp=ps__SV(ikl)
     429          ! Etienne: in the formula herebelow sp should be in hPa, not
     430          ! in Pa so I divide by 100.
     431          sp=ps__SV(ikl)/100.
    390432          psat_ice = 6.1070 * exp(6150. *(1./273.16 -
    391433     .                                              1./TsisSV(ikl,isl)))
    … …  
    399441            qsatsg(ikl) = 0.622 * psat_wat / (sp - 0.378 * psat_wat)
    400442          endif
     443          QsT_SV(ikl)=qsatsg(ikl)
    401444
    402445c         dqs_dT(ikl) = qsatsg(ikl)* 4099.2   /(den_qs *den_qs)!
    403446          fac_dt(ikl) = f_HSHL(ikl)/(ro_Wat   * dz_dSV(0))     !
    404447        END DO
     448
     449
    405450 
    406451C +--Surface: Latent    Heat Flux: Surface    Relative Humidity
    … …  
    410455     .                             /(   1.0-xgpsrf**nt_srf)    !
    411456              dt_srf       = agpsrf                            !
    412               dt_ver       = 0.                                !
     457              dt_ver       = 0.               
     458
    413459            DO ikl=1,knonv
    414               isl          =          isnoSV(ikl)              !
     460              isl          =          isnoSV(ikl)             
     461              ist          = max(0,isotSV(ikl)-100*isnoSV(ikl))! 0 if    H2O                         
     462              ist__s       = min(1,ist)                                                                             
    415463              etaBAK(ikl)  = max(epsi,eta_SV(ikl ,isl))        !
    416464              etaNEW(ikl)  =          etaBAK(ikl)              !
    417465              etEuBk(ikl)  =          etaNEW(ikl)              !
    418             END DO                                             !
     466            END DO     
     467
     468        if(ist__s==1) then ! to reduce computer time                                                 
     469                                          !
    419470        DO it_srf=1,nt_srf                                     !
    420471              dt_ver       = dt_ver     +dt_srf                !
    … …  
    458509            END DO                                             !
    459510              dt_srf      =      dt_srf         * xgpsrf       !
    460         END DO                                                 !
     511        END DO         
     512
     513
     514        endif                                       !
    461515 
    462516C +--Surface: Latent    Heat Flux: Soil/Water Surface Contributions
    … …  
    579633       
    580634      END DO
     635
     636
    581637 
    582638C +--Temperature Limits (avoids problems in case of no Snow Layers)
    … …  
    584640        DO ikl=     1,knonv
    585641           isl              = isnoSV(ikl)
    586           dTSurf            = TsisSV(ikl,isl) -     TSurf0(ikl)
     642
     643           dTSurf            = TsisSV(ikl,isl) -     TSurf0(ikl)
    587644          TsisSV(ikl,isl)   = TSurf0(ikl) + sign(1.,dTSurf) ! 180.0 dgC/hr
    588645     .              * min(abs(dTSurf),5.e-2*dt__SV)         ! =0.05 dgC/s
    … …  
    602659C +--Update Surface    Fluxes
    603660C +  ========================
    604  
     661       
     662
     663
    605664        DO ikl=      1,knonv
    606665          isl         = isnoSV(ikl)
    … …  
    613672        END DO
    614673
    615  
    616  
    617674      return
    618675      end

  • LMDZ6/branches/Ocean_skin/libf/phylmd/inlandsis/sisvat_zsn.F

    r3792 r4013  
    5252      use VARxSV
    5353      use VARySV
     54      use surface_data, only: ok_zsn_ii
    5455
    5556      IMPLICIT NONE
    … …  
    716717        END DO
    717718
     719
     720C +--Search new Ice/Snow Interface (option II in MAR)
     721C +  ===============================================
     722
     723        IF (ok_zsn_ii) THEN
     724       
     725        DO ikl=1,knonv
     726          iiceSV(ikl) =  0
     727        END DO
     728 
     729        DO ikl=1,knonv
     730        DO   isn=1,isnoSV(ikl)
     731          OK_ICE      = max(zero,sign(unun,ro__SV(ikl,isn)-ro_ice+20.))
     732     .                * max(zero,sign(unun,dzsnSV(ikl,isn)-epsi))
     733          iiceSV(ikl) = (1.-OK_ICE)       *iiceSV(ikl)
     734     .                +     OK_ICE        *isn
     735        END DO
     736        END DO
     737
     738        END IF
    718739 
    719740      return

  • LMDZ6/branches/Ocean_skin/libf/phylmd/inlandsis/surf_inlandsis_mod.F90

    r3792 r4013  
    11MODULE surf_inlandsis_mod
    22
    3   IMPLICIT NONE
    4 
     3    IMPLICIT NONE
     4
     5CONTAINS
     6
     7
     8SUBROUTINE surf_inlandsis(knon, rlon, rlat, ikl2i, itime, dtime, debut, lafin, &
     9            rmu0, swdown, lwdown, albedo_old, pexner, ps, p1lay, &
     10            precip_rain, precip_snow, &
     11            zsl_height, wind_velo, ustar, temp_air, dens_air, spechum, tsurf, &
     12            rugos, snow_cont_air, alb_soil, alt, slope, cloudf, &
     13            radsol, qsol, tsoil, snow, zfra, snowhgt, qsnow, to_ice, sissnow, agesno, &
     14            AcoefH, AcoefQ, BcoefH, BcoefQ, cdragm, cdragh, &
     15            runoff_lic, fqfonte, ffonte, evap, erod, fluxsens, fluxlat, dflux_s,dflux_l, &
     16            tsurf_new, alb1, alb2, alb3, alb6, emis_new, z0m, z0h, qsurf)
     17
     18        ! |                                                                        |
     19        ! |   SubRoutine surf_inlandsis: Interfacing Lmdz AND Sisvat's Ice and Snow|
     20        ! |                              (INLANDSIS)                               |
     21        ! |   SISVAT (Soil/Ice Snow Vegetation Atmosphere Transfer Scheme)         |
     22        ! |   surface scheme of the Modele Atmospherique Regional (MAR)            |
     23        ! |   Author: Heinz Juergen Punge, LSCE                June 2009           |
     24        ! |     based on the MAR-SISVAT interface by Hubert Gallee                 |
     25        ! |   Updated by Etienne Vignon, Cecile Agosta                             |
     26        ! |                                                                        |
     27        ! +------------------------------------------------------------------------+
     28        ! |
     29        ! |   In the current setup, SISVAT is used only to model the land ice      |
     30        ! |   part of the surface; hence it is called with the compressed variables|
     31        ! |   from pbl_surface, and only by the surf_landice routine.              |
     32        ! |                                                                        |
     33        ! |   In this interface it is assumed that the partitioning of the soil,   |
     34        ! |   and hence the number of grid points is constant during a simulation, |
     35        ! |   hence eg. snow properties remain stored in the global SISVAT         |
     36        ! |   variables between the calls and don't need to be handed over as      |
     37        ! |   arguments. When the partitioning is supposed to change, make sure to |
     38        ! |   update the variables.                                                |
     39        ! |                                                                        |
     40        ! |   INPUT    (via MODULES VARxSV, VARySV, VARtSV ...)                    |
     41        ! |   ^^^^^     xxxxSV: SISVAT/LMDZ interfacing variables                  |
     42        ! |                                                                        |
     43        ! +------------------------------------------------------------------------+
     44
     45        USE dimphy
     46        USE VAR_SV
     47        USE VARdSV
     48        USE VARxSV
     49        USE VARySV
     50        USE VARtSV
     51        USE VARphy
     52        USE surface_data, only : iflag_tsurf_inlandsis, SnoMod, BloMod, ok_outfor
     53
     54        IMPLICIT NONE
     55
     56        ! +--INTERFACE Variables
     57        ! +  ===================
     58        !    include  "dimsoil.h"
     59
     60        ! +--Global Variables
     61        ! +  ================
     62        ! Input Variables for SISVAT
     63        INTEGER, INTENT(IN) :: knon
     64        INTEGER, INTENT(IN) :: itime
     65        REAL, INTENT(IN) :: dtime
     66        LOGICAL, INTENT(IN) :: debut     ! true if first step
     67        LOGICAL, INTENT(IN) :: lafin     ! true if last step
     68
     69        INTEGER, DIMENSION(klon), INTENT(IN) :: ikl2i     ! Index Decompression
     70        REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat
     71        REAL, DIMENSION(klon), INTENT(IN) :: rmu0      ! cos sol. zenith angle
     72        REAL, DIMENSION(klon), INTENT(IN) :: swdown    !
     73        REAL, DIMENSION(klon), INTENT(IN) :: lwdown    !
     74        REAL, DIMENSION(klon), INTENT(IN) :: albedo_old
     75        REAL, DIMENSION(klon), INTENT(IN) :: pexner    ! Exner potential
     76        REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow
     77        REAL, DIMENSION(klon), INTENT(IN) :: zsl_height, wind_velo
     78        REAL, DIMENSION(klon), INTENT(IN) :: temp_air, spechum, ps, p1lay
     79        REAL, DIMENSION(klon), INTENT(IN) :: dens_air, tsurf
     80        REAL, DIMENSION(klon), INTENT(IN) :: rugos
     81        REAL, DIMENSION(klon), INTENT(IN) :: snow_cont_air
     82        REAL, DIMENSION(klon), INTENT(IN) :: alb_soil, slope
     83        REAL, DIMENSION(klon), INTENT(IN) :: alt       ! surface elevation
     84        REAL, DIMENSION(klon), INTENT(IN) :: cloudf
     85        REAL, DIMENSION(klon), INTENT(IN) :: AcoefH, AcoefQ
     86        REAL, DIMENSION(klon), INTENT(IN) :: BcoefH, BcoefQ
     87        REAL, DIMENSION(klon), INTENT(IN) :: cdragm, cdragh
     88        REAL, DIMENSION(klon), INTENT(IN) :: ustar   ! friction velocity
     89
     90        ! Variables exchanged between LMDZ and SISVAT
     91        REAL, DIMENSION(klon), INTENT(IN) :: radsol    ! Surface absorbed rad.
     92        REAL, DIMENSION(klon), INTENT(INOUT) :: snow      ! Tot snow mass [kg/m2]
     93        REAL, DIMENSION(klon), INTENT(INOUT) :: zfra      ! snwo surface fraction [0-1]
     94        REAL, DIMENSION(klon, nsoilmx), INTENT(OUT) :: tsoil ! Soil Temperature
     95        REAL, DIMENSION(klon), INTENT(OUT) :: qsol      ! Soil Water Content
     96        REAL, DIMENSION(klon), INTENT(INOUT) :: z0m    ! Momentum Roughn Lgt
     97        REAL, DIMENSION(klon), INTENT(INOUT) :: z0h    ! Momentum Roughn Lgt
     98
     99        ! Output Variables for LMDZ
     100        REAL, DIMENSION(klon), INTENT(OUT) :: alb1      ! Albedo SW
     101        REAL, DIMENSION(klon), INTENT(OUT) :: alb2, alb3 ! Albedo NIR and LW
     102        REAL, DIMENSION(klon,6), INTENT(OUT) :: alb6 ! 6 band Albedo
     103        REAL, DIMENSION(klon), INTENT(OUT) :: emis_new  ! Surface Emissivity
     104        REAL, DIMENSION(klon), INTENT(OUT) :: runoff_lic ! Runoff
     105        REAL, DIMENSION(klon), INTENT(OUT) :: ffonte    ! enthalpy flux due to surface melting
     106        REAL, DIMENSION(klon), INTENT(OUT) :: fqfonte   ! water flux due to surface melting
     107        REAL, DIMENSION(klon), INTENT(OUT) :: dflux_s   ! d/dT sens. ht flux
     108        REAL, DIMENSION(klon), INTENT(OUT) :: dflux_l   ! d/dT latent ht flux
     109        REAL, DIMENSION(klon), INTENT(OUT) :: fluxsens  ! Sensible ht flux
     110        REAL, DIMENSION(klon), INTENT(OUT) :: fluxlat   ! Latent heat flux
     111        REAL, DIMENSION(klon), INTENT(OUT) :: evap      ! Evaporation
     112        REAL, DIMENSION(klon), INTENT(OUT) :: erod      ! Erosion of surface snow (flux)
     113        REAL, DIMENSION(klon), INTENT(OUT) :: agesno    ! Snow age (top layer)
     114        REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new ! Surface Temperature
     115        REAL, DIMENSION(klon), INTENT(OUT) :: qsurf     ! Surface Humidity
     116
     117        ! Specific INLANDIS outputs
     118        REAL, DIMENSION(klon), INTENT(OUT) :: qsnow     ! Total H2O snow[kg/m2]
     119        REAL, DIMENSION(klon), INTENT(OUT) :: snowhgt   ! Snow height (m)
     120        REAL, DIMENSION(klon), INTENT(OUT) :: to_ice    ! Snow passed to ice
     121        REAL, DIMENSION(klon), INTENT(OUT) :: sissnow   ! Snow in model (kg/m2)
     122
     123        ! +--Internal  Variables
     124        ! +  ===================
     125
     126        CHARACTER(len = 20) :: fn_outfor ! Name for output file
     127        CHARACTER (len = 80)              :: abort_message
     128        CHARACTER (len = 20)              :: modname = 'surf_inlandsis_mod'
     129
     130        INTEGER :: i, ig, ikl, isl, isn, nt
     131        INTEGER :: gp_outfor, un_outfor
     132        REAL, PARAMETER :: f1 = 0.5
     133        REAL, PARAMETER :: sn_upp = 10000., sn_low = 500.
     134        REAL, PARAMETER :: sn_add = 400., sn_div = 2.
     135        ! snow mass upper,lower limit,
     136        ! added mass/division lowest layer
     137        REAL, PARAMETER :: c1_zuo = 12.960e+4, c2_zuo = 2.160e+6
     138        REAL, PARAMETER :: c3_zuo = 1.400e+2, czemin = 1.e-3
     139        ! Parameters for drainage
     140        ! c1_zuo/ 2.796e+4/,c2_zuo/2.160e+6/,c3_zuo/1.400e+2/ !     Tuning
     141        ! +...        Run Off Parameters
     142        ! +           86400*1.5 day     ...*25 days (Modif. ETH Camp: 86400*0.3day)
     143        ! +           (Zuo and Oerlemans 1996, J.Glacio. 42, 305--317)
     144
     145        REAL, DIMENSION(klon) :: eps0SL          ! surface Emissivity
     146        REAL :: zsigma, Ua_min, Us_min, lati
     147        REAL, PARAMETER :: cdmax=0.05
     148        REAL :: lambda          ! Par. soil discret.
     149        REAL, DIMENSION(nsoilmx), SAVE :: dz1, dz2         ! Soil layer thicknesses
     150        !$OMP THREADPRIVATE(dz1,dz2)
     151        LOGICAL, SAVE :: firstcall
     152        !$OMP THREADPRIVATE(firstcall)
     153
     154        INTEGER :: iso
     155        LOGICAL :: file_exists
     156        CHARACTER(len = 20) :: fichnom
     157        LOGICAL :: is_init_domec
     158        ! CA initialization
     159        ! dz_profil_15 : 1 m in 15 layers [m]
     160        real, parameter :: dz_profil_15(15) = (/0.005, 0.01, 0.015, 0.02, 0.03, 0.04, 0.05, &
     161                                                0.06, 0.07, 0.08, 0.09, 0.1, 0.12, 0.14, 0.17/)
     162        ! mean_temp : mean annual surface temperature [K]
     163        real, dimension(klon) :: mean_temp
     164        ! mean_dens : mean surface density [kg/m3]
     165        real, dimension(klon) :: mean_dens
     166        ! lat_scale : temperature lapse rate against latitude [K degree-1]
     167        real :: lat_scale
     168        ! sh_scale : temperature lapse rate against altitude [K km-1]
     169        real :: sh_scale
     170        ! variables for density profile
     171        ! E0, E1 : exponent
     172        real :: E0, E1
     173        ! depth at which 550 kg m-3 is reached [m]
     174        real :: z550
     175        ! depths of snow layers
     176        real :: depth, snow_depth, distup
     177        ! number of initial snow layers
     178        integer :: nb_snow_layer
     179        ! For density calc.
     180        real :: alpha0, alpha1, ln_smb
     181        ! theoritical densities [kg m-3]
     182        real :: rho0, rho1, rho1_550
     183        ! constants for density profile
     184        ! C0, C1 : constant, 0.07 for z <= 550 kg m-3
     185        real, parameter :: C0 = 0.07
     186        real, parameter :: C1 = 0.03
     187        ! rho_i : ice density [kg m-3]
     188        real, parameter :: rho_ice = 917.
     189        ! E_c : activation energy [J mol-1]
     190        real, parameter :: E_c = 60000.
     191        ! E_g : activation energy [J mol-1]
     192        real, parameter :: E_g = 42400.
     193        ! R : gas constant [J mol-1 K-1]
     194        real, parameter :: R = 8.3144621
     195
     196     
     197     
     198
     199
     200        ! + PROGRAM START
     201        ! + -----------------------------------------
     202
     203        zsigma = 1000.
     204        dt__SV = dtime
     205
     206        IF (debut) THEN
     207            firstcall = .TRUE.
     208            INI_SV = .false.
     209        ELSE
     210            firstcall = .false.
     211            INI_SV = .true.
     212        END IF
     213
     214        IF (ok_outfor) THEN
     215            un_outfor = 51    ! unit number for point output file
     216            gp_outfor = 1    ! grid point number for point output 1 for 1D, 273 for zoom-nudg DC
     217            fn_outfor = 'outfor_SV.dat'
     218        END IF
     219
     220        ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
     221        ! + INITIALISATION: BEGIN +++
     222        ! + -----------------------------------------
     223        IF (firstcall) THEN
     224
     225            ! +--Array size
     226            ! +  -----------------------
     227
     228            klonv = klon
     229            knonv = knon
     230                write(*, *) 'ikl, lon and lat in INLANDSIS'
     231
     232            DO ikl = 1, knon
     233                i=ikl2i(ikl)
     234                write(*, *) 'ikl=', ikl, 'rlon=', rlon(i), 'rlat=', rlat(i)
     235            END DO
     236
     237            ! +--Variables initizialisation
     238            ! +  ---------------------------
     239
     240            CALL INIT_VARtSV
     241            CALL INIT_VARxSV
     242            CALL INIT_VARySV
     243
     244
     245
     246            ! +--Surface Fall Line Slope
     247            ! +  -----------------------
     248            IF (SnoMod)  THEN
     249                DO ikl = 1, knon
     250                    slopSV(ikl) = slope(ikl)
     251                    SWf_SV(ikl) = &   ! Normalized Decay of the
     252                            exp(-dt__SV             &   ! Surficial Water Content
     253                                    / (c1_zuo                &   !(Zuo and Oerlemans 1996,
     254                                            + c2_zuo * exp(-c3_zuo * abs(slopSV(ikl)))))  ! J.Glacio. 42, 305--317)
     255                END DO
     256            END IF
     257
     258
     259
     260            ! +--Soil layer thickness . Compute soil discretization (as for LMDZ)
     261            ! +  ----------------------------------------------------------------
     262            !        write(*,'(/a)') 'Start SISVAT init: soil discretization ', nsoilmx
     263            CALL get_soil_levels(dz1, dz2, lambda)
     264
     265            lambSV = lambda
     266            dz1_SV(1:knon, 1:) = 0.
     267            dz2_SV(1:knon, 1:) = 0.
     268
     269            DO isl = -nsol, 0
     270                dz_dSV(isl) = 0.5e-3 * dz2(1 - isl)           ! Soil layer thickness
     271                DO ikl = 1, knon
     272                    dz1_SV(ikl, isl) = dz1(1 - isl)    !1.e-3*
     273                    dz2_SV(ikl, isl) = dz2(1 - isl)    !1.e-3*
     274                END DO
     275            END DO
     276
     277
     278            ! Set variables
     279            ! =============
     280            DO ikl = 1, knon
     281                ! LSmask : Land/Sea Mask
     282                LSmask(ikl) = 1
     283                ! isotSV : Soil Type -> 12 = ice
     284                isotSV(ikl) = 12
     285                ! iWaFSV : Soil Drainage (1,0)=(y,n)
     286                iWaFSV(ikl) = 1
     287                ! eps0SL : Surface Emissivity
     288                eps0SL(ikl) = 1.
     289                ! alb0SV : Soil Albedo
     290                alb0SV(ikl) = alb_soil(ikl)
     291                ! Tsf_SV : Surface Temperature, must be bellow freezing
     292                Tsf_SV(ikl) = min(temp_air(ikl), TfSnow)
     293            END DO
     294
     295            ! +--Initialization of soil and snow variables in case startsis is not read
     296            ! +  ----------------------------------------------------------------------
     297
     298            is_init_domec=.FALSE.
     299
     300
     301            IF (is_init_domec) THEN
     302            ! Coarse initilization inspired from vertcical profiles at Dome C,
     303            ! Antarctic Plateaui (10m of snow, 19 levels)
     304
     305                 DO ikl = 1,knon
     306! + Soil
     307                 DO isl =   -nsol,0   
     308                   TsisSV(ikl,isl) = min(tsoil(ikl,1+nsol),TfSnow-0.2)   !temp_air(ikl)
     309                   !tsoil(ikl,1-isl)   Soil Temperature
     310                   !TsisSV(ikl,isl) = min(temp_air(ikl),TfSnow-0.2)
     311                   eta_SV(ikl,isl) = epsi           !etasoil(ikl,1-isl) Soil Water[m3/m3]
     312                   ro__SV(ikl,isl) = rhoIce         !rosoil(ikl,1-isl) volumic mass
     313                 END DO   
     314
     315
     316           ! Snow
     317                 isnoSV(ikl) = 19
     318                 istoSV(ikl, 1:isnoSV(ikl)) = 100
     319                 ro__SV(ikl, 1:isnoSV(ikl)) = 350.
     320                 eta_SV(ikl, 1:isnoSV(ikl)) = epsi
     321                 TsisSV(ikl, 1:isnoSV(ikl)) = min(tsoil(ikl, 1), TfSnow - 0.2)
     322                 G1snSV(ikl, 1:isnoSV(ikl)) = 99.
     323                 G2snSV(ikl, 1:isnoSV(ikl)) = 2.
     324                 agsnSV(ikl, 1:isnoSV(ikl)) = 50.
     325                 dzsnSV(ikl, 19) = 0.015
     326                 dzsnSV(ikl, 18) = 0.015
     327                 dzsnSV(ikl, 17) = 0.020
     328                 dzsnSV(ikl, 16) = 0.030
     329                 dzsnSV(ikl, 15) = 0.040
     330                 dzsnSV(ikl, 14) = 0.060
     331                 dzsnSV(ikl, 13) = 0.080
     332                 dzsnSV(ikl, 12) = 0.110
     333                 dzsnSV(ikl, 11) = 0.150
     334                 dzsnSV(ikl, 10) = 0.200
     335                 dzsnSV(ikl, 9) = 0.300
     336                 dzsnSV(ikl, 8) = 0.420
     337                 dzsnSV(ikl, 7) = 0.780
     338                 dzsnSV(ikl, 6) = 1.020
     339                 dzsnSV(ikl, 5) = 0.980
     340                 dzsnSV(ikl, 4) = 1.020
     341                 dzsnSV(ikl, 3) = 3.970
     342                 dzsnSV(ikl, 2) = 1.020
     343                 dzsnSV(ikl, 1) = 1.020
     344
     345                 END DO
     346            ELSE
     347
     348            ! Initilialisation with climatological temperature and density
     349            ! profiles as in MAR. Methodology developed by Cecile Agosta
     350 
     351            ! initialize with 0., for unused snow layers
     352            dzsnSV = 0.
     353            G1snSV = 0.
     354            G2snSV = 0.
     355            istoSV = 0
     356            TsisSV = 0.
     357
     358
     359            ! initialize mean variables (unrealistic)
     360            mean_temp = TfSnow
     361            mean_dens = 300.
     362            ! loop on grid cells
     363            DO ikl = 1, knon
     364                lati=rlat(ikl2i(ikl))
     365                ! approximations for mean_temp and mean_dens
     366                ! from Feulner et al., 2013 (DOI: 10.1175/JCLI-D-12-00636.1)
     367                ! Fig. 3 and 5 : the lapse rate vs. latitude at high latitude is about 0.55 °C °lat-1
     368                ! with a moist-adiabatic lapse rate of 5 °C km-1 everywhere except for Antarctica,
     369                ! for Antarctica, a dry-adiabatic lapse rate of 9.8 °C km-1 is assumed.
     370                if (lati > 60.) then
     371                    ! CA todo : add longitude bounds
     372                    ! Greenland mean temperature : function of altitude and latitude
     373                    ! for altitudes 0. to 1000. m, lat_scale varies from 0.9 to 0.75 °C °lat-1
     374                    lat_scale = (0.75 - 0.9) / 1000. * alt(ikl) + 0.9
     375                    lat_scale = max(min(lat_scale, 0.9), 0.75)
     376                    ! sh_scale equals the environmental lapse rate : 6.5 °C km-1
     377                    sh_scale = 6.5
     378                    mean_temp(ikl) = TfSnow + 1.5 - sh_scale * alt(ikl) / 1000. - lat_scale * (lati - 60.)
     379                    ! surface density: Fausto et al. 2018, https://doi.org/10.3389/feart.2018.00051
     380                    mean_dens(ikl) = 315.
     381                else if (lati < -60.) then
     382                    ! Antarctica mean temperature : function of altitude and latitude
     383                    ! for altitudes 0. to 500. m, lat_scale varies from 1.3 to 0.6 °C °lat-1
     384                    lat_scale = (0.6 - 1.3) / 500. * alt(ikl) + 1.3
     385                    lat_scale = max(min(lat_scale, 1.3), 0.6)
     386                    ! for altitudes 0. to 500. m, sh_scale varies from 6.5 to 9.8 °C km-1
     387                    sh_scale = (9.8 - 6.5) / 500. * alt(ikl) + 6.5
     388                    sh_scale = max(min(sh_scale, 9.8), 6.5)
     389                    mean_temp(ikl) = TfSnow - 7. - sh_scale * alt(ikl) / 1000. + lat_scale * (lati + 60.)
     390                    ! Antarctica surface density : function of mean annual temperature
     391                    ! surface density of 350. kg m-3 at Dome C and 450. kg m-3 at Prud'homme (Agosta et al. 2013)
     392                    ! 350 kg m-3 is a typical value for the Antarctic plateau around 3200 m.
     393                    ! Weinhart et al 2020  https://doi.org/10.5194/tc-14-3663-2020 and Sugiyama et al. 2011 oi: 10.3189/2012JoG11J201
     394                    ! 320 kg m-3 is reached at Dome A, 4100 m a.s.l.
     395                    ! Dome C : st_ant_param(3233, -75.1) = -47.7
     396                    ! Dumont d'Urville : st_ant_param(0, -66.66) = -15.7
     397                    mean_dens(ikl) =  (450. - 320.) / (-15.7 + 47.7) * (mean_temp(ikl) - TfSnow + 15.7) + 450.
     398                    mean_dens(ikl) = min(450., max(320., mean_dens(ikl)))
     399                else
     400
     401                !    write(*, *) 'Attention: temperature initialization is only defined for Greenland and Antarctica'
     402
     403                     mean_dens(ikl) =350.
     404                     mean_temp(ikl) = min(tsoil(ikl,1),TfSnow-0.2)
     405
     406                !abort_message='temperature initialization is only defined for Greenland and Antarctica'
     407                !CALL abort_physic(modname,abort_message,1)
     408
     409                end if
    5410 
    6   CONTAINS
    7 
    8                                        
    9 
    10   SUBROUTINE surf_inlandsis(knon,rlon,rlat, ikl2i, itime, dtime, debut, lafin, &
    11              rmu0, swdown, lwdown, albedo_old, pexner, ps, p1lay, &
    12              precip_rain, precip_snow, precip_snow_adv, snow_adv, &
    13              zsl_height, wind_velo, ustar, temp_air, dens_air, spechum, tsurf, &
    14              rugos, snow_cont_air, alb_soil, slope, cloudf, &
    15              radsol, qsol, tsoil, snow, zfra, snowhgt, qsnow, to_ice, sissnow, agesno, &
    16              AcoefH, AcoefQ, BcoefH, BcoefQ, cdragm, cdragh, &
    17              runoff_lic, evap, fluxsens, fluxlat, dflux_s, dflux_l, &     
    18              tsurf_new, alb1, alb2, alb3, &
    19              emis_new, z0m, z0h, qsurf)       
    20                                                                              
    21 ! +------------------------------------------------------------------------+   
    22 ! |                                                                        |   
    23 ! |   SubRoutine surf_inlandsis: Interfacing Lmdz AND Sisvat's Ice and Snow|
    24 ! |                              (INLANDSIS)                               |
    25 ! |   SISVAT (Soil/Ice Snow Vegetation Atmosphere Transfer Scheme)         |   
    26 ! |   surface scheme of the Modele Atmospherique Regional (MAR)            |
    27 ! |   Author: Heinz Juergen Punge, LSCE                June 2009           |
    28 ! |     based on the MAR-SISVAT interface by Hubert Gallee                 |
    29 ! |           Update Etienne Vignon, LMD, Novembre 2020                    |
    30 ! |                                                                        |   
    31 ! +------------------------------------------------------------------------+   
    32 ! |   
    33 ! |   In the current setup, SISVAT is used only to model the land ice      |
    34 ! |   part of the surface; hence it is called with the compressed variables|
    35 ! |   from pbl_surface, and only by the surf_landice routine.              |
    36 ! |                                                                        |   
    37 ! |   In this interface it is assumed that the partitioning of the soil,   |
    38 ! |   and hence the number of grid points is constant during a simulation, |
    39 ! |   hence eg. snow properties remain stored in the global SISVAT         |
    40 ! |   variables between the calls and don't need to be handed over as      |
    41 ! |   arguments. When the partitioning is supposed to change, make sure to |
    42 ! |   update the variables.                                                |
    43 ! |                                                                        | 
    44 ! |   INPUT                                                                | 
    45 ! |             SnoMod: Snow Pack is set up when .T.                       | 
    46 ! |             reaLBC: Update Bound.Condit.when .T.                       |   
    47 ! |                                                                        | 
    48 ! |   INPUT    (via MODULES VARxSV, VARySV, VARtSV)                        | 
    49 ! |   ^^^^^     xxxxSV: SISVAT/LMDZ interfacing variables                  |   
    50 ! |                                                                        | 
    51 ! |   Preprocessing  Option: SISVAT PHYSICS                                |   
    52 ! |   ^^^^^^^^^^^^^^^^^^^^^  ^^^^^^^^^^^^^^                                |   
    53 ! | #                       #HY                                            |   
    54 ! | #                       #SN: Snow         Model                        |   
    55 ! | #                       #BS: Blowing Snow Parameterization             |   
    56 ! +------------------------------------------------------------------------+
    57        
    58     USE dimphy                                           
    59     USE VAR_SV
    60     USE VARdSV
    61     USE VARxSV
    62     USE VARySV
    63     USE VARtSV
    64     USE VARphy
    65     USE surface_data, only: iflag_tsurf_inlandsis,SnoMod,BloMod,ok_outfor                                       
    66 
    67     IMPLICIT NONE   
    68                                                                
    69 ! +--INTERFACE Variables                                                     
    70 ! +  ===================
    71                                            
    72 !    include  "dimsoil.h"                                     
    73                                                                    
    74 
    75 ! +--Global Variables                                                         
    76 ! +  ================ 
    77 ! Input Variables for SISVAT
    78     INTEGER,               INTENT(IN)      :: knon
    79     INTEGER,               INTENT(IN)      :: itime   
    80     REAL,                  INTENT(IN)      :: dtime
    81     LOGICAL,               INTENT(IN)      :: debut     ! true if first step
    82     LOGICAL,               INTENT(IN)      :: lafin     ! true if last step
    83 
    84     INTEGER, DIMENSION(klon), INTENT(IN)   :: ikl2i     ! Index Decompression
    85     REAL, DIMENSION(klon), INTENT(IN)      :: rlon, rlat
    86     REAL, DIMENSION(klon), INTENT(IN)      :: rmu0      ! cos sol. zenith angle
    87     REAL, DIMENSION(klon), INTENT(IN)      :: swdown    !
    88     REAL, DIMENSION(klon), INTENT(IN)      :: lwdown    !
    89     REAL, DIMENSION(klon), INTENT(IN)      :: albedo_old   
    90     REAL, DIMENSION(klon), INTENT(IN)      :: pexner    ! Exner potential
    91     REAL, DIMENSION(klon), INTENT(IN)      :: precip_rain, precip_snow
    92     REAL, DIMENSION(klon), INTENT(IN)      :: precip_snow_adv, snow_adv
    93                                                         !Snow Drift
    94     REAL, DIMENSION(klon), INTENT(IN)      :: zsl_height, wind_velo
    95     REAL, DIMENSION(klon), INTENT(IN)      :: temp_air, spechum, ps,p1lay
    96     REAL, DIMENSION(klon), INTENT(IN)      :: dens_air, tsurf           
    97     REAL, DIMENSION(klon), INTENT(IN)      :: rugos,snow_cont_air
    98     REAL, DIMENSION(klon), INTENT(IN)      :: alb_soil, slope
    99     REAL, DIMENSION(klon), INTENT(IN)      :: cloudf   
    100     REAL, DIMENSION(klon), INTENT(IN)      :: AcoefH, AcoefQ
    101     REAL, DIMENSION(klon), INTENT(IN)      :: BcoefH, BcoefQ
    102     REAL, DIMENSION(klon), INTENT(IN)      :: cdragm, cdragh
    103     REAL, DIMENSION(klon), INTENT(IN)      :: ustar   ! friction velocity
    104 
    105 ! Variables exchanged between LMDZ and SISVAT
    106     REAL, DIMENSION(klon), INTENT(IN)      :: radsol    ! Surface absorbed rad.
    107     REAL, DIMENSION(klon), INTENT(INOUT)   :: snow      ! Tot snow mass [kg/m2]
    108     REAL, DIMENSION(klon), INTENT(INOUT)   :: zfra      ! snwo surface fraction [0-1]
    109     REAL, DIMENSION(klon,nsoilmx), INTENT(OUT) :: tsoil ! Soil Temperature
    110     REAL, DIMENSION(klon), INTENT(OUT)       :: qsol      ! Soil Water Content 
    111     REAL, DIMENSION(klon), INTENT(INOUT)     :: z0m    ! Momentum Roughn Lgt
    112     REAL, DIMENSION(klon), INTENT(INOUT)     :: z0h    ! Momentum Roughn Lgt
    113 
    114 
    115 ! Output Variables for LMDZ
    116     REAL, DIMENSION(klon), INTENT(OUT)     :: alb1      ! Albedo SW
    117     REAL, DIMENSION(klon), INTENT(OUT)     :: alb2,alb3 ! Albedo NIR and LW
    118     REAL, DIMENSION(klon), INTENT(OUT)     :: emis_new  ! Surface Emissivity
    119     REAL, DIMENSION(klon), INTENT(OUT)     :: runoff_lic ! Runoff           
    120     REAL, DIMENSION(klon), INTENT(OUT)     :: dflux_s   ! d/dT sens. ht flux 
    121     REAL, DIMENSION(klon), INTENT(OUT)     :: dflux_l   ! d/dT latent ht flux
    122     REAL, DIMENSION(klon), INTENT(OUT)     :: fluxsens  ! Sensible ht flux   
    123     REAL, DIMENSION(klon), INTENT(OUT)     :: fluxlat   ! Latent heat flux
    124     REAL, DIMENSION(klon), INTENT(OUT)     :: evap      ! Evaporation
    125     REAL, DIMENSION(klon), INTENT(OUT)     :: agesno    ! Snow age (top layer)
    126     REAL, DIMENSION(klon), INTENT(OUT)     :: tsurf_new ! Surface Temperature
    127     REAL, DIMENSION(klon), INTENT(OUT)     :: qsurf     ! Surface Humidity
    128 
    129 ! Specific INLANDIS outputs
    130 
    131     REAL, DIMENSION(klon), INTENT(OUT)     :: qsnow     ! Total H2O snow[kg/m2]
    132     REAL, DIMENSION(klon), INTENT(OUT)     :: snowhgt   ! Snow height (m)
    133     REAL, DIMENSION(klon), INTENT(OUT)     :: to_ice    ! Snow passed to ice
    134     REAL, DIMENSION(klon), INTENT(OUT)     :: sissnow   ! Snow in model (kg/m2)
    135 
    136                                                                          
    137 
    138                                                                    
    139 ! +--Internal  Variables                                                       
    140 ! +  ===================                                         
    141 
    142     CHARACTER(len=20)               :: fn_outfor ! Name for output file
    143     INTEGER                         :: i, ig, ikl, isl, isn, nt
    144     INTEGER                         :: gp_outfor, un_outfor
    145     REAL, PARAMETER                 :: f1=0.5
    146     REAL, PARAMETER                 :: sn_upp=5000.,sn_low=500.
    147     REAL, PARAMETER                 :: sn_add=400.,sn_div=2.
    148                                              ! snow mass upper,lower limit,
    149                                              ! added mass/division lowest layer
    150     REAL, PARAMETER                 :: c1_zuo=12.960e+4, c2_zuo=2.160e+6
    151     REAL, PARAMETER                 :: c3_zuo=1.400e+2,  czemin=1.e-3 
    152                                              ! Parameters for drainage
    153 ! c1_zuo/ 2.796e+4/,c2_zuo/2.160e+6/,c3_zuo/1.400e+2/ !     Tuning
    154 ! +...        Run Off Parameters                                             
    155 ! +           86400*1.5 day     ...*25 days (Modif. ETH Camp: 86400*0.3day)   
    156 ! +           (Zuo and Oerlemans 1996, J.Glacio. 42, 305--317)             
    157 
    158     REAL, DIMENSION(klon)           :: eps0SL          ! surface Emissivity
    159     REAL                            :: zsigma, Ua_min, Us_min
    160     REAL                            :: lambda          ! Par. soil discret.
    161     REAL, DIMENSION(nsoilmx), SAVE  :: dz1,dz2         ! Soil layer thicknesses
    162 !$OMP THREADPRIVATE(dz1,dz2)
    163     LOGICAL, SAVE                   :: firstcall
    164 !$OMP THREADPRIVATE(firstcall)               
    165 
    166                
    167                                        
    168 ! +--Internal Variables
    169 ! +  ==================
    170 
    171     INTEGER                         ::  iso
    172     LOGICAL                         ::  file_exists
    173     CHARACTER(len=20)               ::  fichnom
    174 !========================================================================
    175 
    176       PRINT*, 'je rentre dans inlandsis'
    177 
    178       zsigma=1000.
    179       dt__SV=dtime
    180      
    181    
    182 
    183 !     write(*,*)'Start of simulation? ',debut        !hj
    184 
    185       IF (debut) THEN
    186         firstcall=.TRUE.
    187         INI_SV=.false.
    188 
    189       ELSE
    190         firstcall=.false.
    191         INI_SV=.true.
    192       END IF
    193 
    194 
    195 
    196 
    197        IF (ok_outfor) THEN
    198         un_outfor=51                 ! unit number for point output file
    199         gp_outfor= 1        ! grid point number for point output
    200         fn_outfor='outfor_SV.dat'
    201        END IF
    202 
    203 ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    204 
    205 
    206 
    207 
    208 ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    209 ! + INITIALISATION: BEGIN +++
    210 ! + -------------------------
    211 ! +
    212 ! + Compute soil discretization (as for LMDZ)
    213 ! + ----------------------------------------- 
    214       IF (firstcall) THEN
    215 
    216 ! +--Array size
    217      klonv=klon
    218      knonv=knon
    219 
    220 
    221         write(*,*)'klon',klon,'klonv',klonv,'knon',knon,'nsol',nsol,'nsno',nsno
    222 
    223 
    224         CALL INIT_VARtSV
    225         CALL INIT_VARxSV
    226         CALL INIT_VARySV
    227 
    228         eps0SL(:)=0.
    229        
    230        
    231 ! +--Soil layer thickness                                                   
    232 ! +  ----------------------- 
    233 !        write(*,'(/a)') 'Start SISVAT init: soil discretization ', nsoilmx
    234         CALL get_soil_levels(dz1,dz2,lambda)
    235 
    236        
    237         lambSV=lambda
    238         dz1_SV(1:knon,1:) = 0.     
    239         dz2_SV(1:knon,1:) = 0.
    240                      
    241         DO isl =   -nsol,0   
    242           dz_dSV(isl) = 0.5e-3*dz2(1-isl)           ! Soil layer thickness
    243           DO ikl=1,knon
    244             dz1_SV(ikl,isl) = dz1(1-isl)    !1.e-3*
    245             dz2_SV(ikl,isl) = dz2(1-isl)    !1.e-3*
    246           END DO
     411                ! mean_temp is defined for ice ground only
     412                mean_temp(ikl) = min(mean_temp(ikl), TfSnow - 0.2)
     413
     414                ! Soil layers
     415                ! ===========
     416                DO isl = -nsol, 0
     417                    ! TsisSV : Temperature [K]
     418                    TsisSV(ikl, isl) = mean_temp(ikl)
     419                    ! eta_SV : Soil Water [m3/m3]
     420                    eta_SV(ikl, isl) = epsi
     421                    ! ro__SV : Volumic Mass [kg/m3]
     422                    ro__SV(ikl, isl) = rhoIce
     423                END DO
     424
     425                ! Snow layers
     426                ! ===========
     427                ! snow_depth : initial snow depth
     428                snow_depth = 20.
     429                ! nb_snow_layer : initial nb of snow layers
     430                nb_snow_layer = 15
     431                ! isnoSV : total nb of snow layers
     432                isnoSV(ikl) = nb_snow_layer
     433                ! depth : depth of each layer
     434                depth = snow_depth
     435                do isl = 1, nb_snow_layer
     436                    ! dzsnSV : snow layer thickness
     437                    dzsnSV(ikl, isl) = max(0.01, snow_depth * dz_profil_15(nb_snow_layer - isl + 1))
     438                    ! G1snSV : dendricity (<0) or sphericity (>0) : 99. = sperical
     439                    G1snSV(ikl, isl) = 99.
     440                    ! G2snSV : Sphericity (>0) or Size [1/10 mm] : 2. = small grain size
     441                    G2snSV(ikl, isl) = 3.
     442                    agsnSV(ikl, isl) = 0.
     443                    istoSV(ikl, isl) = 0
     444                    ! eta_SV : Liquid Water Content [m3/m3]
     445                    eta_SV(ikl, isl) = 0.
     446                    ! distance to surface
     447                    depth = depth - dzsnSV(ikl,isl) / 2.
     448                    distup = min(1., max(0., depth / snow_depth))
     449                    ! TsisSV : Temperature [K], square interpolation between Tsf_SV (surface) and mean_temp (bottom)
     450                    TsisSV(ikl, isl) = Tsf_SV(ikl) * (1. - distup**2) + mean_temp(ikl) * distup**2
     451                    ! firn density : densification formulas from :
     452                    ! Ligtenberg et al 2011 eq. (6) (www.the-cryosphere.net/5/809/2011/)
     453                    ! equivalent to Arthern et al. 2010 eq. (4) "Nabarro-Herring" (doi:10.1029/2009JF001306)
     454                    ! Integration of the steady state equation
     455                    ! ln_smb approximated as a function of temperature
     456                    ln_smb = max((mean_temp(ikl) - TfSnow) * 5. / 60. + 8., 3.)
     457                    ! alpha0, alpha1 : correction coefficient as a function of ln_SMB from Ligtenberg 2011, adjusted for alpha1
     458                    alpha0 = max(1.435 - 0.151 * ln_smb, 0.25)
     459                    alpha1 = max(2.0111 - 0.2051 * ln_smb, 0.25)
     460                    E0 = C0 * gravit * exp((E_g - E_c)/(R * mean_temp(ikl))) * rho_ice * alpha0
     461                    E1 = C1 * gravit * exp((E_g - E_c)/(R * mean_temp(ikl))) * rho_ice * alpha1
     462                    z550 = log((rho_ice/mean_dens(ikl) - 1.)/(rho_ice/550. - 1.)) / E0
     463                    rho0 = exp(E0 * depth) / (rho_ice / mean_dens(ikl) - 1 + exp(E0 * depth)) * rho_ice
     464                    rho1 = exp(E1 * depth) / (rho_ice / mean_dens(ikl) - 1 + exp(E1 * depth)) * rho_ice
     465                    if (depth <= z550) then
     466                        ro__SV(ikl, isl) = exp(E0 * depth) / (rho_ice / mean_dens(ikl) - 1 + exp(E0 * depth)) * rho_ice
     467                    else
     468                        ro__SV(ikl, isl) = exp(E1 * (depth - z550)) / (rho_ice / 550. - 1 + exp(E1 * (depth - z550))) * rho_ice
     469                    end if
     470                    depth = depth - dzsnSV(ikl,isl) / 2.
     471                   
     472                end do
     473
     474            END DO
     475
     476            END IF
     477
     478
     479            ! + Numerics paramaters, SISVAT_ini
     480            ! +  ----------------------
     481            CALL SISVAT_ini(knon)
     482
     483
     484            ! +--Read restart file
     485            ! +  =================================================
     486
     487            INQUIRE(FILE = "startsis.nc", EXIST = file_exists)
     488            IF (file_exists) THEN
     489                CALL sisvatetat0("startsis.nc", ikl2i)
     490            END IF
     491
     492
     493
     494            ! +--Output ascii file
     495            ! +  =================================================
     496
     497            ! open output file
     498            IF (ok_outfor) THEN
     499                open(unit = un_outfor, status = 'replace', file = fn_outfor)
     500                ikl = gp_outfor     ! index sur la grille land ice
     501                write(un_outfor, *) fn_outfor, ikl, dt__SV, rlon(ikl2i(ikl)), rlat(ikl2i(ikl))
     502                write(un_outfor, *) 'nsnow - albedo - z0m - z0h , dz [m,30], temp [K,41], rho [kg/m3,41], eta [kg/kg,41] &
     503                        & G1 [-,30], G2 [-,30], agesnow [d,30], history [-,30], DOP [m,30]'
     504            END IF
     505
     506        END IF  ! firstcall
     507        ! +
     508        ! +  +++  INITIALISATION:  END  +++
     509        ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
     510
     511
     512
     513        ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
     514        ! + READ FORCINGS
     515        ! + ------------------------
     516
     517        ! + Update Forcings for SISVAT given by the LMDZ model.
     518        ! +
     519        DO ikl = 1, knon
     520
     521            ! +--Atmospheric Forcing                                    (INPUT)
     522            ! +  ^^^^^^^^^^^^^^^^^^^                                     ^^^^^
     523            za__SV(ikl) = zsl_height(ikl)               ! surface layer height (fisr model level) [m]
     524            Ua_min = 0.2 * sqrt(za__SV(ikl))            !
     525            VV__SV(ikl) = max(Ua_min, wind_velo(ikl))   ! Wind velocity       [m/s]
     526            TaT_SV(ikl) = temp_air(ikl)                 ! BL top Temperature    [K]
     527            ExnrSV(ikl) = pexner(ikl)                   ! Exner potential
     528            rhT_SV(ikl) = dens_air(ikl)                 ! Air density
     529            QaT_SV(ikl) = spechum(ikl)                  ! Specific humidity
     530            ps__SV(ikl) = ps(ikl)                       ! surface pressure     [Pa]
     531            p1l_SV(ikl) = p1lay(ikl)                    ! lowest atm. layer press[Pa]
     532
     533            ! +--Surface properties
     534            ! +  ^^^^^^^^^^^^^^^^^^
     535
     536            Z0m_SV(ikl) = z0m(ikl)                      ! Moment.Roughn.L.
     537            Z0h_SV(ikl) = z0h(ikl)                      ! Moment.Roughn.L.
     538
     539            ! +--Energy Fluxes                                          (INPUT)
     540            ! +  ^^^^^^^^^^^^^                                           ^^^^^
     541            coszSV(ikl) = max(czemin, rmu0(ikl))         ! cos(zenith.Dist.)
     542            sol_SV(ikl) = swdown(ikl)                   ! downward Solar
     543            IRd_SV(ikl) = lwdown(ikl)                   ! downward IR
     544            rsolSV(ikl) = radsol(ikl)                   ! surface absorbed rad.
     545
     546            ! +--Water  Fluxes                                          (INPUT)
     547            ! +  ^^^^^^^^^^^^^                                           ^^^^^
     548            drr_SV(ikl) = precip_rain(ikl)              ! Rain fall rate  [kg/m2/s]
     549            dsn_SV(ikl) = precip_snow(ikl)              ! Snow fall rate  [kg/m2/s]
     550
     551            ! #BS    dbs_SV(ikl) = blowSN(i,j,n)
     552            ! dbs_SV = Maximum potential erosion amount [kg/m2]
     553            ! => Upper bound for eroded snow mass
     554            !        uss_SV(ikl) = SLussl(i,j,n) ! u*qs* (only for Tv in sisvatesbl.f)
     555            ! #BS  if(dsn_SV(ikl)>eps12.and.erprev(i,j,n).gt.eps9) then
     556            ! #BS    dsnbSV(ikl) =1.0-min(qsHY(i,j,kB)     !BS neglib. at kb ~100 magl)
     557            ! #BS.                        /max(qshy(i,j,mz),eps9),unun)
     558            ! #BS    dsnbSV(ikl) = max(dsnbSV(ikl),erprev(i,j,n)/dsn_SV(ikl))
     559            ! #BS    dsnbSV(ikl) = max(0.,min(1.,dsnbSV(ikl)))
     560            ! #BS  else
     561            ! #BS    dsnbSV(ikl) = 0.
     562            ! #BS  endif
     563            !      dsnbSV is the drift fraction of deposited snow updated in sisvat.f
     564            !      will be used for characterizing the Buffer Layer
     565            !      (see update of  Bros_N, G1same, G2same, zroOLD, zroNEW)
     566            ! #BS  if(n==1) qbs_HY(i,j) = dsnbSV(ikl)
     567            qsnoSV(ikl) = snow_cont_air(ikl)
     568
     569
     570
     571            ! +--Soil/BL                                      (INPUT)
     572            ! +  ^^^^^^^                                       ^^^^^
     573            alb0SV(ikl) = alb_soil(ikl)                 ! Soil background Albedo
     574            AcoHSV(ikl) = AcoefH(ikl)
     575            BcoHSV(ikl) = BcoefH(ikl)
     576            AcoQSV(ikl) = AcoefQ(ikl)
     577            BcoQSV(ikl) = BcoefQ(ikl)
     578            cdH_SV(ikl) = min(cdragh(ikl),cdmax)
     579            cdM_SV(ikl) = min(cdragm(ikl),cdmax)
     580            rcdmSV(ikl) = sqrt(cdM_SV(ikl))
     581            Us_min = 0.01
     582            us__SV(ikl) = max(Us_min, ustar(ikl))
     583            ram_sv(ikl) = 1. / (cdM_SV(ikl) * max(VV__SV(ikl), eps6))
     584            rah_sv(ikl) = 1. / (cdH_SV(ikl) * max(VV__SV(ikl), eps6))
     585
     586            ! +--Energy Fluxes                                          (INPUT/OUTPUT)
     587            ! +  ^^^^^^^^^^^^^                                           ^^^^^^^^^^^^
     588            !IF (.not.firstcall) THEN
     589            Tsrfsv(ikl)  = tsurf(ikl)                     !hj 12 03 2010
     590            cld_SV(ikl) = cloudf(ikl)                    ! Cloudiness
     591            !END IF
     592
     593         END DO
     594
     595        !
     596        ! +  +++  READ FORCINGS:  END  +++
     597        ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
     598 
     599
     600        ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
     601        ! +--SISVAT EXECUTION
     602        ! +  ----------------
     603
     604        call  INLANDSIS(SnoMod, BloMod, 1)
     605
     606
     607       
     608        ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
     609        ! + RETURN RESULTS
     610        ! + --------------
     611        ! + Return (compressed) SISVAT variables to LMDZ
     612        ! +
     613        DO  ikl = 1, knon                  ! use only 1:knon (actual ice sheet..)
     614            dflux_s(ikl) = dSdTSV(ikl)         ! Sens.H.Flux T-Der.
     615            dflux_l(ikl) = dLdTSV(ikl)         ! Latn.H.Flux T-Der.
     616            fluxsens(ikl) = HSs_sv(ikl)         ! HS
     617            fluxlat(ikl) = HLs_sv(ikl)         ! HL
     618            evap(ikl) = -1*HLs_sv(ikl) / LHvH2O  ! Evaporation
     619            erod(ikl) = 0.
     620
     621            IF (BloMod) THEN
     622                ! + Blowing snow
     623
     624                !       SLussl(i,j,n)= 0.
     625                ! #BS   SLussl(i,j,n)=                     !Effective erosion
     626                ! #BS. (- dbs_ER(ikl))/(dt*rhT_SV(ikl))    !~u*qs* from previous time step
     627                ! #BS   blowSN(i,j,n)=  dt*uss_SV(ikl)     !New max. pot. Erosion [kg/m2]
     628                ! #BS.                    *rhT_SV(ikl)     !(further bounded in sisvat_bsn.f)
     629                ! #BS  erprev(i,j,n) =     dbs_Er(ikl)/dt__SV
     630                erod(ikl) = dbs_Er(ikl) / dt__SV
     631            ENDIF
     632
     633            ! +   Check snow thickness,  substract if too thick, add if too thin
     634
     635            sissnow(ikl) = 0.  !()
     636            DO  isn = 1, isnoSV(ikl)
     637                sissnow(ikl) = sissnow(ikl) + dzsnSV(ikl, isn) * ro__SV(ikl, isn)
     638            END DO
     639
     640            IF (sissnow(ikl) .LE. sn_low) THEN  !add snow
     641                IF (isnoSV(ikl).GE.1) THEN
     642                    dzsnSV(ikl, 1) = dzsnSV(ikl, 1) + sn_add / max(ro__SV(ikl, 1), epsi)
     643                    toicSV(ikl) = toicSV(ikl) - sn_add
     644                ELSE
     645                    write(*, *) 'Attention, bare ice... point ', ikl
     646                    isnoSV(ikl) = 1
     647                    istoSV(ikl, 1) = 0
     648                    ro__SV(ikl, 1) = 350.
     649                    dzsnSV(ikl, 1) = sn_add / max(ro__SV(ikl, 1), epsi)  ! 1.
     650                    eta_SV(ikl, 1) = epsi
     651                    TsisSV(ikl, 1) = min(TsisSV(ikl, 0), TfSnow - 0.2)
     652                    G1snSV(ikl, 1) = 0.
     653                    G2snSV(ikl, 1) = 0.3
     654                    agsnSV(ikl, 1) = 10.
     655                    toicSV(ikl) = toicSV(ikl) - sn_add
     656                END IF
     657            END IF
     658
     659            IF (sissnow(ikl) .ge. sn_upp) THEN  !thinnen snow layer below
     660                dzsnSV(ikl, 1) = dzsnSV(ikl, 1) / sn_div
     661                toicSV(ikl) = toicSV(ikl) + dzsnSV(ikl, 1) * ro__SV(ikl, 1) / sn_div
     662            END IF
     663
     664            sissnow(ikl) = 0.
     665            qsnow(ikl) = 0.
     666            snow(ikl) = 0.
     667            snowhgt(ikl) = 0.
     668
     669            DO  isn = 1, isnoSV(ikl)
     670                sissnow(ikl) = sissnow(ikl) + dzsnSV(ikl, isn) * ro__SV(ikl, isn)
     671                snowhgt(ikl) = snowhgt(ikl) + dzsnSV(ikl, isn)
     672                ! Etienne: check calc qsnow
     673                qsnow(ikl) = qsnow(ikl) + rhoWat * eta_SV(ikl, isn) * dzsnSV(ikl, isn)
     674            END DO
     675
     676            zfra(ikl) = max(min(isnoSV(ikl) - iiceSV(ikl), 1), 0)
     677            ! Etienne: comment following line
     678            ! snow(ikl)    = sissnow(ikl)+toicSV(ikl)
     679            snow(ikl) = sissnow(ikl)
     680
     681            to_ice(ikl) = toicSV(ikl)
     682            runoff_lic(ikl) = RnofSV(ikl)    ! RunOFF: intensity (flux due to melting + liquid precip)
     683            fqfonte(ikl)= max(0., (wem_SV(ikl)-wer_SV(ikl))/dtime) ! net melting = melting - refreezing
     684            ffonte(ikl)=fqfonte(ikl)*Lf_H2O
     685
     686            qsol(ikl) = 0.
     687            DO  isl = -nsol, 0
     688                tsoil(ikl, 1 - isl) = TsisSV(ikl, isl)       ! Soil Temperature
     689                ! Etienne: check calc qsol
     690                qsol(ikl) = qsol(ikl)                      &
     691                        + eta_SV(ikl, isl) * dz_dSV(isl)
     692            END DO
     693            agesno(ikl) = agsnSV(ikl, isnoSV(ikl))        !          [day]
     694
     695            alb1(ikl) = alb1sv(ikl)             ! Albedo VIS
     696!            alb2(ikl) = ((So1dSV - f1) * alb1sv(ikl)                   &
     697!                    & + So2dSV * alb2sv(ikl) + So3dSV * alb3sv(ikl)) / f1
     698            alb2(ikl)=alb2sv(ikl)
     699            ! Albedo NIR
     700            alb3(ikl) = alb3sv(ikl)             ! Albedo FIR
     701            ! 6 band Albedo
     702            alb6(ikl,:)=alb6sv(ikl,:)
     703
     704            tsurf_new(ikl) = Tsrfsv(ikl)
     705
     706            qsurf(ikl) = QsT_SV(ikl)
     707            emis_new(ikl) = eps0SL(ikl)
     708            z0m(ikl) = Z0m_SV(ikl)
     709            z0h(ikl) = Z0h_SV(ikl)
     710
    247711
    248712        END DO
    249713
    250 
    251 
    252 
    253         DO ikl=1,knon     
    254 
    255 
    256 ! Initialise variables
    257          
    258           ispiSV(ikl)             = 0
    259           iiceSV(ikl)             = 0 
    260           rusnSV(ikl)             = 0.   
    261           toicSV(ikl)             = 0.     
    262           isnoSV(ikl)             = 0.       ! # snow layers                           
    263           istoSV(ikl,:)           = 0.
    264           eta_SV(ikl,:)           = 0.     
    265           TsisSV(ikl,:)           = 0.
    266           ro__SV(ikl,:)           = 0.       
    267           G1snSV(ikl,:)           = 0. 
    268           G2snSV(ikl,:)           = 0.
    269           agsnSV(ikl,:)           = 0.
    270           dzsnSV(ikl,:)           = 0.
    271           zzsnsv(ikl,:)           = 0.                                           
    272           BufsSV(ikl)             = 0.   
    273           qsnoSV(ikl)             = 0.     ! BL snow content 
    274           zWEcSV(ikl)             = 0.
    275           dbs_SV(ikl)             = 0.
    276           dsnbSV(ikl)             = 0.
    277           esnbSV(ikl)             = 0.
    278           BrosSV(ikl)             = 0.
    279           BG1sSV(ikl)             = 0.         
    280           BG2sSV(ikl)             = 0.
    281           SWS_SV(ikl)             = 0.
    282           RnofSV(ikl)             = 0.     ! RunOFF Intensity
    283           RRs_SV(ikl)             = 0.
    284           DDs_SV(ikl)             = 0.
    285           VVs_SV(ikl)             = 0.
    286           cld_SV(ikl)             = 0.     
    287           uts_SV(ikl)             = 0.     ! u*T*  arbitrary 
    288           uqs_SV(ikl)             = 0.     ! u*q*    "
    289           uss_SV(ikl)             = 0.     ! u*s*    "
    290           LMO_SV(ikl)             = 0.
    291 
    292 
    293 ! Set variables
    294 
    295           LSmask(ikl) = 1                          ! Land/Sea   Mask   
    296           isotSV(ikl) = 12                         ! Soil       Type  -> 12= ice 
    297           iWaFSV(ikl) = 1                          ! Soil Drainage                                     
    298           eps0SL(ikl )= 1.
    299           alb0SV(ikl) = alb_soil(ikl)                 ! Soil Albedo       
    300           Z0m_SV(ikl) = z0m(ikl)                      ! Moment.Roughn.L.
    301           Z0h_SV(ikl) = z0h(ikl)                      ! heat Roughn.L.
    302 
    303 ! + Soil Upward IR Flux, Water Fluxes, roughness length 
    304           IRs_SV(ikl) =                               &
    305               -eps0SL(ikl)* StefBo*(temp_air(ikl)**4)   ! Upward IR Flux   
    306           Tsf_SV(ikl) = min(temp_air(ikl),TfSnow)       
    307          
    308 ! + Soil
    309         DO isl =   -nsol,0   
    310           TsisSV(ikl,isl) = min(tsoil(ikl,1+nsol),TfSnow-0.2)   !temp_air(ikl)  !tsoil(ikl,1-isl)   Soil Temperature
    311           !TsisSV(ikl,isl) = min(temp_air(ikl),TfSnow-0.2)
    312           eta_SV(ikl,isl) = epsi                        !etasoil(ikl,1-isl) Soil Water[m3/m3]
    313           ro__SV(ikl,isl) = rhoIce                         !rosoil(ikl,1-isl)  volumic mass
    314         END DO     
    315 
    316 
    317 
    318 !! Initialise with snow
    319           !  G1snSV(ikl,0)          = 0.                   !      [-]     
    320           !  G2snSV(ikl,0)          = 1.6                  ! [-] [0.0001 m]
    321           !  dzsnSV(ikl,0)          = dz_dSV(0)            !           [m]
    322 
    323 
    324           ! if (snow(ikl) .GT. 0.) then
    325           !   isnoSV(ikl)             = 1       ! snow layers                           
    326           !   istoSV(ikl,1:nsno)      = 0     ! 0,...,5 :   Snow     History (see istdSV data)
    327           !   eta_SV(ikl,1:nsno)      = epsi     
    328           !   TsisSV(ikl,1:nsno)      = tsoil(ikl,1)         
    329           !   ro__SV(ikl,1:nsno)      = 350.0       
    330           !   G1snSV(ikl,1:nsno)      = 0.   !      [-] 
    331           !   G2snSV(ikl,1:nsno)      = 1.6   !     [-] [0.0001 m]
    332           !   agsnSV(ikl,1:nsno)      = 50.   !          [day]
    333           !   dzsnSV(ikl,1)           = snow(ikl)/max(ro__SV(ikl,1),epsi) ![m]
    334 ! ! ecrete si trop de neige:
    335 !              IF (snow(ikl) .ge. sn_upp) THEN  !thinnen snow layer below
    336 !               dzsnSV(ikl,1)      = dzsnSV(ikl,1)/sn_div
    337 !               toicSV(ikl) = toicSV(ikl)+dzsnSV(ikl,1)*ro__SV(ikl,1)/sn_div
    338 !              END IF
    339 !            zzsnsv(ikl,1)      =  dzsnSV(ikl,1)                    ! Total snow pack thickness
    340 !          endif
    341 
    342 
    343 ! Initialise la neige avec un profil de densité prochde des conditions de Dôme C (~10m de neige avec 19 niveaux) (Etienne):
    344           isnoSV(ikl)                    = 19
    345           istoSV(ikl,1:isnoSV(ikl))      = 100
    346           ro__SV(ikl,1:isnoSV(ikl))      = 350.     
    347           eta_SV(ikl,1:isnoSV(ikl))      = epsi
    348           TsisSV(ikl,1:isnoSV(ikl))      = min(tsoil(ikl,1),TfSnow-0.2)
    349           G1snSV(ikl,1:isnoSV(ikl))      = 0
    350           G2snSV(ikl,1:isnoSV(ikl))      = 1.6
    351           agsnSV(ikl,1:isnoSV(ikl))      = 50.   
    352           dzsnSV(ikl,19)                  = 0.015
    353           dzsnSV(ikl,18)                  =0.015
    354           dzsnSV(ikl,17)                  =0.020
    355           dzsnSV(ikl,16)                  =0.030
    356           dzsnSV(ikl,15)                  =0.040
    357           dzsnSV(ikl,14)                  =0.060
    358           dzsnSV(ikl,13)                  =0.080
    359           dzsnSV(ikl,12)                  =0.110
    360           dzsnSV(ikl,11)                  =0.150
    361           dzsnSV(ikl,10)                  =0.200
    362           dzsnSV(ikl,9)                   =0.300
    363           dzsnSV(ikl,8)                   =0.420
    364           dzsnSV(ikl,7)                   =0.780
    365           dzsnSV(ikl,6)                   =1.020
    366           dzsnSV(ikl,5)                   =0.980
    367           dzsnSV(ikl,4)                   =1.020
    368           dzsnSV(ikl,3)                   =3.970
    369           dzsnSV(ikl,2)                   =1.020
    370           dzsnSV(ikl,1)                   =0.100
    371 
    372 
    373         END DO                                           
    374 
    375 ! +--Surface Fall Line Slope                                                   
    376 ! +  ----------------------- 
    377         IF (SnoMod)  THEN               
    378           DO ikl=1,knon 
    379             slopSV(ikl) = slope(ikl)
    380             SWf_SV(ikl) =             &   ! Normalized Decay of the 
    381               exp(-dt__SV             &   ! Surficial Water Content 
    382               /(c1_zuo                &   !(Zuo and Oerlemans 1996, 
    383             +c2_zuo*exp(-c3_zuo*abs(slopSV(ikl)))))  ! J.Glacio. 42, 305--317)
    384           END DO                                     
    385         END IF                           
    386 
    387 ! + SISVAT_ini (as for use with MAR, but not computing soil layers)
    388 ! + -------------------------------------------------------------
    389 !        write(*,'(/a)') 'Start SISVAT initialization: SISVAT_ini'
    390         CALL SISVAT_ini(knon)
    391 
    392 
    393 ! +--Read restart file
    394 ! +  =================================================   
    395        
    396         INQUIRE(FILE="startsis.nc", EXIST=file_exists)
    397         IF (file_exists) THEN
    398         CALL sisvatetat0("startsis.nc",ikl2i)
     714            IF (ok_outfor) THEN
     715             ikl= gp_outfor
     716            write(un_outfor, *) '+++++++++++', rlon(ikl2i(ikl)), rlat(ikl2i(ikl)),alt(ikl),'+++++++++++'
     717            write(un_outfor, *) isnoSV(ikl), alb_SV(ikl), Z0m_SV(ikl), Z0h_SV(ikl),HSs_sv(ikl),HLs_sv(ikl),alb1(ikl),alb2(ikl)
     718            write(un_outfor, *) dzsnSV(ikl, :)
     719            write(un_outfor, *) TsisSV(ikl, :)
     720            write(un_outfor, *) ro__SV(ikl, :)
     721            write(un_outfor, *) eta_SV(ikl, :)
     722            write(un_outfor, *) G1snSV(ikl, :)
     723            write(un_outfor, *) G2snSV(ikl, :)
     724            write(un_outfor, *) agsnSV(ikl, :)
     725            write(un_outfor, *) istoSV(ikl, :)
     726            write(un_outfor, *) DOPsnSV(ikl, :)
     727        ENDIF
     728
     729
     730
     731        ! +  -----------------------------
     732        ! +  END --- RETURN RESULTS
     733        ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
     734        IF (lafin) THEN
     735            fichnom = "restartsis.nc"
     736            CALL sisvatredem("restartsis.nc", ikl2i, rlon, rlat)
     737
     738            IF (ok_outfor) THEN
     739                close(unit = un_outfor)
     740            END IF
    399741        END IF
    400        
    401        
    402        
    403 ! +--Output ascii file
    404 ! +  =================================================   
    405                
    406        
    407        
    408         ! open output file
    409         IF (ok_outfor) THEN
    410           open(unit=un_outfor,status='replace',file=fn_outfor)         
    411           ikl=gp_outfor     ! index sur la grille land ice
    412           write(un_outfor,*) fn_outfor, ikl, dt__SV   
    413           write(un_outfor,*) 'nsnow - albedo - z0m - z0h , dz [m,35], temp [K,46], rho [kg/m3,46], eta [kg/kg,46] &
    414            & G1 [-,35], G2 [-,35], agesnow [d,35], history [-,35]'
    415 
    416         END IF
    417  
    418       END IF  ! firstcall                       
    419 ! +                               
    420 ! +  +++  INITIALISATION:  END  +++                               
    421 ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    422 
    423 
    424 
    425 ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    426 ! + READ FORCINGS 
    427 ! + ------------------------
    428 
    429 ! + Update Forcings for SISVAT given by the LMDZ model.
    430 ! +
    431       DO ikl=1,knon
    432 
    433 ! +--Atmospheric Forcing                                    (INPUT)           
    434 ! +  ^^^^^^^^^^^^^^^^^^^                                     ^^^^^
    435         zSBLSV      = 1000.                         ! [m]               
    436         za__SV(ikl) = zsl_height(ikl)               ! surface layer height (fisr model level) [m]
    437         Ua_min      = epsi                          !
    438         Ua_min      = 0.2 * sqrt(za__SV(ikl)   )    !                   
    439         VV__SV(ikl) = max(Ua_min, wind_velo(ikl))   ! Wind velocity       [m/s]
    440         TaT_SV(ikl) = temp_air(ikl)                 ! BL top Temperature    [K]
    441         ExnrSV(ikl) = pexner(ikl)                   ! Exner potential         
    442         rhT_SV(ikl) = dens_air(ikl)                 ! Air density           
    443         QaT_SV(ikl) = spechum(ikl)                  ! Specific humidity
    444         ps__SV(ikl) = ps(ikl)                       ! surface pressure     [Pa]
    445         p1l_SV(ikl) = p1lay(ikl)                    ! lowest atm. layer press[Pa]
    446 
    447 ! +--Surface properties
    448 ! +  ^^^^^^^^^^^^^^^^^^
    449 
    450         Z0m_SV(ikl) = z0m(ikl)                      ! Moment.Roughn.L.
    451         Z0h_SV(ikl) = z0h(ikl)                      ! Moment.Roughn.L.
    452 
    453 ! +--Energy Fluxes                                          (INPUT)           
    454 ! +  ^^^^^^^^^^^^^                                           ^^^^^             
    455         coszSV(ikl) = max(czemin,rmu0(ikl))         ! cos(zenith.Dist.) 
    456         sol_SV(ikl) = swdown(ikl)                   ! downward Solar 
    457         IRd_SV(ikl) = lwdown(ikl)                   ! downward IR   
    458         rsolSV(ikl) = radsol(ikl)                   ! surface absorbed rad.   
    459 
    460 ! +--Water  Fluxes                                          (INPUT)           
    461 ! +  ^^^^^^^^^^^^^                                           ^^^^^             
    462         drr_SV(ikl) = precip_rain(ikl)              ! Rain fall rate  [kg/m2/s]
    463         dsn_SV(ikl) = precip_snow(ikl)              ! Snow fall rate  [kg/m2/s]
    464 !c #BS  dbsnow      = -SLussl(i,j,n)                ! Erosion   
    465 !c #BS.               *dtPhys     *rhT_SV(ikl) /ro_Wat                   
    466 !c #BS  dsnbSV(ikl) = snow_adv(ikl)  ! min(max(zero,dbsnow)             
    467 !c #BS.                    /    max(epsi,d_snow),unun)                   
    468 !c #BS  dbs_SV(ikl) = snow_cont_air(ikl)
    469 !c #BS                  blowSN(i,j,n)               !          [kg/m2] 
    470                                                                              
    471 ! +--Soil/BL                                      (INPUT)           
    472 ! +  ^^^^^^^                                       ^^^^^           
    473         alb0SV(ikl) = alb_soil(ikl)                 ! Soil background Albedo
    474         AcoHSV(ikl) = AcoefH(ikl) 
    475         BcoHSV(ikl) = BcoefH(ikl)                     
    476         AcoQSV(ikl) = AcoefQ(ikl) 
    477         BcoQSV(ikl) = BcoefQ(ikl)             
    478         cdH_SV(ikl) = cdragh(ikl)     
    479         cdM_SV(ikl) = cdragm(ikl)     
    480         Us_min      = 0.01
    481         us__SV(ikl) = max(Us_min, ustar(ikl))
    482         ram_sv(ikl) = 1./(cdragm(ikl)*max(VV__SV(ikl),eps6))
    483         rah_sv(ikl) = 1./(cdragh(ikl)*max(VV__SV(ikl),eps6))   
    484 
    485 ! +--Energy Fluxes                                          (INPUT/OUTPUT)   
    486 ! +  ^^^^^^^^^^^^^                                           ^^^^^^^^^^^^   
    487         IF (.not.firstcall) THEN 
    488         Tsf_SV(ikl) = tsurf(ikl)                     !hj 12 03 2010
    489         cld_SV(ikl) = cloudf(ikl)                    ! Cloudiness         
    490         END IF
    491  
    492 
    493       END DO
    494 
    495 !                           
    496 ! +  +++  READ FORCINGS:  END  +++   
    497 ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    498 
    499 
    500 
    501 ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    502 ! +--SISVAT EXECUTION                                                         
    503 ! +  ----------------                                                         
    504 
    505       call  INLANDSIS(SnoMod,BloMod,1)
    506 
    507 ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    508 ! + RETURN RESULTS 
    509 ! + --------------
    510 ! + Return (compressed) SISVAT variables to LMDZ             
    511 ! +
    512       DO  ikl=1,knon                  ! use only 1:knon (actual ice sheet..)
    513         runoff_lic(ikl)    = RnofSV(ikl)*dtime   ! RunOFF: intensity* time step
    514         dflux_s(ikl)       = dSdTSV(ikl)         ! Sens.H.Flux T-Der.
    515         dflux_l(ikl)       = dLdTSV(ikl)         ! Latn.H.Flux T-Der.
    516         fluxsens(ikl)      = HSs_sv(ikl)         ! HS                 
    517         fluxlat(ikl)       = HLs_sv(ikl)         ! HL                 
    518         evap(ikl)          = HLs_sv(ikl)/LHvH2O  ! Evaporation 
    519         snow(ikl)          = 0.
    520         snowhgt(ikl)       = 0.
    521         qsnow(ikl)         = 0.
    522         qsol(ikl)          = 0.
    523 ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    524 ! +
    525 ! +   Check snow thickness,  substract if too thick   (commended by etienne: add if too thin)
    526 
    527         sissnow(ikl)       = 0.  !()
    528       DO  isn = 1,isnoSV(ikl)                                               
    529         sissnow(ikl)       = sissnow(ikl)+dzsnSV(ikl,isn)* ro__SV(ikl,isn)   
    530       END DO
    531 
    532        IF (sissnow(ikl) .LE. sn_low) THEN  !add snow
    533        IF (isnoSV(ikl).GE.1) THEN
    534          dzsnSV(ikl,1)      = dzsnSV(ikl,1) + sn_add/max(ro__SV(ikl,1),epsi) 
    535          toicSV(ikl)        = toicSV(ikl)   - sn_add
    536 !       ELSE
    537 !         write(*,*) 'Attention, bare ice... point ',ikl
    538 !         isnoSV(ikl)        = 1
    539 !         istoSV(ikl,1)      = 0
    540 !         ro__SV(ikl,1)      = 350.     
    541 !         dzsnSV(ikl,1)      = sn_add/max(ro__SV(ikl,1),epsi)  ! 1.
    542 !         eta_SV(ikl,1)      = epsi
    543 !         TsisSV(ikl,1)      = min(TsisSV(ikl,0),TfSnow-0.2)   
    544 !         G1snSV(ikl,1)      = 0.
    545 !         G2snSV(ikl,1)      = 0.3
    546 !         agsnSV(ikl,1)      = 10.   
    547 !         toicSV(ikl)        = toicSV(ikl)   - sn_add
    548        END IF
    549        END IF
    550 
    551       IF (sissnow(ikl) .ge. sn_upp) THEN  !thinnen snow layer below
    552         dzsnSV(ikl,1)      = dzsnSV(ikl,1)/sn_div
    553         toicSV(ikl) = toicSV(ikl)+dzsnSV(ikl,1)*ro__SV(ikl,1)/sn_div
    554       END IF
    555 
    556         sissnow(ikl)       = 0.  !()
    557 
    558         DO  isn = 1,isnoSV(ikl)                                               
    559         sissnow(ikl) = sissnow(ikl)+dzsnSV(ikl,isn)* ro__SV(ikl,isn)           
    560         snowhgt(ikl) = snowhgt(ikl)+dzsnSV(ikl,isn)             
    561         qsnow(ikl)   = qsnow(ikl)+1e03*eta_SV(ikl,isn)*dzsnSV(ikl,isn)   
    562         END DO
    563 
    564         ! Etienne: pourquoi ajouter toicSV ici? Pour bilan d'eau?
    565         snow(ikl)    = sissnow(ikl)+toicSV(ikl)
    566         to_ice(ikl)  = toicSV(ikl)
    567 
    568 
    569       DO  isl =   -nsol,0   
    570         tsoil(ikl,1-isl)   = TsisSV(ikl,isl)       ! Soil Temperature 
    571         qsol(ikl)          = qsol(ikl)                      &   
    572                             +eta_SV(ikl,isl) * dz_dSV(isl) 
    573       END DO                                               
    574         agesno(ikl)        = agsnSV(ikl,isnoSV(ikl))        !          [day]
    575 
    576         alb1(ikl)          = alb1sv(ikl)             ! Albedo VIS 
    577         alb2(ikl)          = ((So1dSV-f1)*alb1sv(ikl)                   &
    578      &                       +So2dSV*alb2sv(ikl)+So3dSV*alb3sv(ikl))/f1   
    579                                                      ! Albedo NIR
    580         alb3(ikl)          = alb3sv(ikl)             ! Albedo FIR 
    581 
    582         tsurf_new(ikl)     =Tsrfsv(ikl)
    583 
    584         zfra(ikl)          = max(min(isnoSV(ikl)-iiceSV(ikl),1),0)
    585         qsurf(ikl)         = QaT_SV(ikl)
    586         emis_new(ikl)      = eps0SL(ikl) 
    587         z0m(ikl)           = Z0m_SV(ikl)
    588         z0h(ikl)           = Z0h_SV(ikl)
    589 
    590       END DO  ! ikl
    591      
    592 
    593 
    594 
    595 
    596 
    597 ! write variables in output file
    598 
    599       IF (ok_outfor) THEN
    600         ikl=gp_outfor
    601 
    602 !        write(un_outfor,*) 'nsnow [-,1], dz [m,35], temp [K,46], rho [kg/m3,46], eta [kg/kg,46]'
    603 !        write(un_outfor,*) 'G1 [-,35], G2 [-,35], agesnow [d,35], history [-,35]'
    604         write(un_outfor,*) '+++++++++++++++++++++++++++++++++++++++++++++++'
    605         write(un_outfor,*) isnoSV(ikl), alb_SV(ikl), Z0m_SV(ikl), Z0h_SV(ikl)
    606         write(un_outfor,*) dzsnSV(ikl,:)
    607         write(un_outfor,*) TsisSV(ikl,:)
    608         write(un_outfor,*) ro__SV(ikl,:)
    609         write(un_outfor,*) eta_SV(ikl,:)
    610         write(un_outfor,*) G1snSV(ikl,:)
    611         write(un_outfor,*) G2snSV(ikl,:)
    612         write(un_outfor,*) agsnSV(ikl,:)
    613         write(un_outfor,*) istoSV(ikl,:)
    614        
    615       ENDIF
    616 
    617 
    618 
    619 
    620 ! +  -----------------------------                             
    621 ! +  END --- RETURN RESULTS   
    622 ! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    623       IF (lafin) THEN
    624         fichnom = "restartsis.nc"
    625         CALL sisvatredem("restartsis.nc",ikl2i,rlon,rlat)     
    626        
    627         IF (ok_outfor) THEN
    628           close(unit=un_outfor)                   
    629         END IF
    630       END IF                                                         
    631 
    632 
    633   END SUBROUTINE surf_inlandsis
    634 
    635 
    636 
    637 
    638 
    639 
    640 
    641 
    642 
    643 
    644 
    645 
    646 
    647 
    648 !=======================================================================
    649 
    650   SUBROUTINE get_soil_levels(dz1, dz2, lambda)
    651 ! ======================================================================
    652 ! Routine to compute the vertical discretization of the soil in analogy
    653 ! to LMDZ. In LMDZ it is done in soil.F, which is not used in the case
    654 ! of SISVAT, therefore it's needed here.
    655 !
    656     USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
    657     USE mod_phys_lmdz_para
    658     USE VAR_SV
    659 
    660 
    661 !    INCLUDE "dimsoil.h"
    662 
    663     REAL, DIMENSION(nsoilmx), INTENT(OUT) :: dz2, dz1
    664     REAL, INTENT(OUT)                     :: lambda
    665 
    666 
    667 !-----------------------------------------------------------------------
    668 !   Depthts:
    669 !   --------
    670     REAL fz,rk,fz1,rk1,rk2
    671     REAL min_period, dalph_soil
    672     INTEGER ierr,jk
    673 
    674     fz(rk)=fz1*(dalph_soil**rk-1.)/(dalph_soil-1.)
    675 
    676 !    write(*,*)'Start soil level computation'
    677 !-----------------------------------------------------------------------
    678 ! Calculation of some constants
    679 ! NB! These constants do not depend on the sub-surfaces
    680 !-----------------------------------------------------------------------
    681 !-----------------------------------------------------------------------
    682 !   ground levels
    683 !   grnd=z/l where l is the skin depth of the diurnal cycle:
    684 !-----------------------------------------------------------------------
    685 
    686      min_period=1800. ! en secondes
    687      dalph_soil=2.    ! rapport entre les epaisseurs de 2 couches succ.
    688 ! !$OMP MASTER
    689 !     IF (is_mpi_root) THEN
    690 !        OPEN(99,file='soil.def',status='old',form='formatted',iostat=ierr)
    691 !        IF (ierr == 0) THEN ! Read file only if it exists
    692 !           READ(99,*) min_period
    693 !           READ(99,*) dalph_soil
    694 !           PRINT*,'Discretization for the soil model'
    695 !           PRINT*,'First level e-folding depth',min_period, &
    696 !                '   dalph',dalph_soil
    697 !           CLOSE(99)
    698 !        END IF
    699 !     ENDIF
    700 ! !$OMP END MASTER
    701 !     CALL bcast(min_period)
    702 !     CALL bcast(dalph_soil)
    703 
    704 !   la premiere couche represente un dixieme de cycle diurne
    705      fz1=SQRT(min_period/3.14)
    706      
    707      DO jk=1,nsoilmx
    708         rk1=jk
    709         rk2=jk-1
    710         dz2(jk)=fz(rk1)-fz(rk2)
    711      ENDDO
    712      DO jk=1,nsoilmx-1
    713         rk1=jk+.5
    714         rk2=jk-.5
    715         dz1(jk)=1./(fz(rk1)-fz(rk2))
    716      ENDDO
    717      lambda=fz(.5)*dz1(1)
    718      PRINT*,'full layers, intermediate layers (seconds)'
    719      DO jk=1,nsoilmx
    720         rk=jk
    721         rk1=jk+.5
    722         rk2=jk-.5
    723         PRINT *,'fz=', &
    724              fz(rk1)*fz(rk2)*3.14,fz(rk)*fz(rk)*3.14
    725      ENDDO
    726 
    727   END SUBROUTINE get_soil_levels
    728  
    729 
    730 
    731 
    732 
    733 
    734 
    735 
    736 
    737 
    738 
    739 
    740 
    741 
    742 
    743 
    744 
    745 !===========================================================================
    746 
    747   SUBROUTINE SISVAT_ini(knon)                                                     
    748                                                                                
    749 !C +------------------------------------------------------------------------+ 
    750 !C | MAR          SISVAT_ini                             Jd 11-10-2007  MAR |
    751 !C |   SubRoutine SISVAT_ini generates non time dependant SISVAT parameters | 
    752 !C +------------------------------------------------------------------------+ 
    753 !C |   PARAMETERS:  klonv: Total Number of columns =                        | 
    754 !C |   ^^^^^^^^^^        = Total Number of continental     grid boxes       | 
    755 !C |                     X       Number of Mosaic Cell per grid box         | 
    756 !C |                                                                        | 
    757 !C |   INPUT:   dt__SV   : Time  Step                                   [s] |
    758 !C |   ^^^^^    dz_dSV   : Layer Thickness                              [m] | 
    759 !C |                                                                        | 
    760 !C |   OUTPUT:             [-] | 
    761 !C |   ^^^^^^   rocsSV   : Soil Contrib. to (ro c)_s exclud.Water  [J/kg/K] | 
    762 !C |            etamSV   : Soil Minimum Humidity                    [m3/m3] | 
    763 !C |                      (based on a prescribed Soil Relative Humidity)    | 
    764 !C |            s1__SV   : Factor of eta**( b+2) in Hydraul.Diffusiv.       | 
    765 !C |            s2__SV   : Factor of eta**( b+2) in Hydraul.Conduct.        | 
    766 !C |            aKdtSV   : KHyd: Piecewise Linear Profile:  a * dt    [m]   | 
    767 !C |            bKdtSV   : KHyd: Piecewise Linear Profile:  b * dt    [m/s] | 
    768 !C |            dzsnSV(0): Soil first Layer Thickness                   [m] | 
    769 !C |            dzmiSV   : Distance between two contiguous levels       [m] | 
    770 !C |            dz78SV   : 7/8 (Layer Thickness)                        [m] |
    771 !C |            dz34SV   : 3/4 (Layer Thickness)                        [m] |
    772 !C |            dz_8SV   : 1/8 (Layer Thickness)                        [m] |
    773 !C |            dzAvSV   : 1/8  dz_(i-1) + 3/4 dz_(i) + 1/8 dz_(i+1)    [m] |
    774 !C |            dtz_SV   : dt/dz                                      [s/m] |
    775 !C |            OcndSV   : Swab Ocean / Soil Ratio                      [-] |
    776 !C |            Implic   : Implicit Parameter  (0.5:  Crank-Nicholson)      | 
    777 !C |            Explic   : Explicit Parameter = 1.0 - Implic                | 
    778 !C |                                                                        |
    779 !C | # OPTIONS: #ER: Richards Equation is not smoothed                      |
    780 !C | # ^^^^^^^  #kd: De Ridder   Discretization                             |
    781 !C | #          #SH: Hapex-Sahel Values                                     ! 
    782 !C |                                                                        |
    783 !C +------------------------------------------------------------------------+ 
    784 !                                                                             
    785 !                                                                             
    786                                                                              
    787 !C +--Global Variables                                                         
    788 !C +  ================         
    789 
    790       USE dimphy
    791       USE VARphy                                           
    792       USE VAR_SV                                                     
    793       USE VARdSV                                                         
    794       USE VAR0SV                                                           
    795       USE VARxSV
    796       USE VARtSV
    797       USE VARxSV
    798       USE VARySV
    799       IMPLICIT NONE                                                           
    800                                                                              
    801                                                                              
    802                                                                              
    803 !C +--Arguments                                                     
    804 !C +  ==================                                                     
    805        INTEGER,INTENT(IN) ::  knon                                       
    806 
    807 !C +--Internal Variables                                                     
    808 !C +  ==================                                                     
    809                                                                                
    810       INTEGER ::  ivt   ,ist   ,ikl   ,isl   ,isn   ,ikh               
    811       INTEGER ::  misl_2,nisl_2                                             
    812       REAL    ::  d__eta,eta__1,eta__2,Khyd_1,Khyd_2                           
    813       REAL,PARAMETER  ::  RHsMin=  0.001        ! Min.Soil Relative Humidity   
    814       REAL    ::  PsiMax                        ! Max.Soil Water    Potential
    815       REAL    ::  a_Khyd,b_Khyd                 ! Piecewis.https://www.lequipe.fr/Water Conductivity
    816 
    817 
    818 !c #WR REAL    ::  Khyd_x,Khyd_y                                               
    819                                                                              
    820                                                                              
    821                                                                  
    822 !C +--Non Time Dependant SISVAT parameters                                   
    823 !C +  ====================================                               
    824                                                                              
    825 !C +--Soil Discretization                                                     
    826 !C +  -------------------                                                     
    827                                                                              
    828 !C +--Numerical Scheme Parameters                                             
    829 !C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^                                             
     742
     743    END SUBROUTINE surf_inlandsis
     744
     745
     746    !=======================================================================
     747
     748    SUBROUTINE get_soil_levels(dz1, dz2, lambda)
     749        ! ======================================================================
     750        ! Routine to compute the vertical discretization of the soil in analogy
     751        ! to LMDZ. In LMDZ it is done in soil.F, which is not used in the case
     752        ! of SISVAT, therefore it's needed here.
     753        !
     754        USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root
     755        USE mod_phys_lmdz_para
     756        USE VAR_SV
     757
     758
     759        !    INCLUDE "dimsoil.h"
     760
     761        REAL, DIMENSION(nsoilmx), INTENT(OUT) :: dz2, dz1
     762        REAL, INTENT(OUT) :: lambda
     763
     764
     765        !-----------------------------------------------------------------------
     766        !   Depthts:
     767        !   --------
     768        REAL fz, rk, fz1, rk1, rk2
     769        REAL min_period, dalph_soil
     770        INTEGER ierr, jk
     771
     772        fz(rk) = fz1 * (dalph_soil**rk - 1.) / (dalph_soil - 1.)
     773
     774        !    write(*,*)'Start soil level computation'
     775        !-----------------------------------------------------------------------
     776        ! Calculation of some constants
     777        ! NB! These constants do not depend on the sub-surfaces
     778        !-----------------------------------------------------------------------
     779        !-----------------------------------------------------------------------
     780        !   ground levels
     781        !   grnd=z/l where l is the skin depth of the diurnal cycle:
     782        !-----------------------------------------------------------------------
     783
     784        min_period = 1800. ! en secondes
     785        dalph_soil = 2.    ! rapport entre les epaisseurs de 2 couches succ.
     786        ! !$OMP MASTER
     787        !     IF (is_mpi_root) THEN
     788        !        OPEN(99,file='soil.def',status='old',form='formatted',iostat=ierr)
     789        !        IF (ierr == 0) THEN ! Read file only if it exists
     790        !           READ(99,*) min_period
     791        !           READ(99,*) dalph_soil
     792        !           PRINT*,'Discretization for the soil model'
     793        !           PRINT*,'First level e-folding depth',min_period, &
     794        !                '   dalph',dalph_soil
     795        !           CLOSE(99)
     796        !        END IF
     797        !     ENDIF
     798        ! !$OMP END MASTER
     799        !     CALL bcast(min_period)
     800        !     CALL bcast(dalph_soil)
     801
     802        !   la premiere couche represente un dixieme de cycle diurne
     803        fz1 = SQRT(min_period / 3.14)
     804
     805        DO jk = 1, nsoilmx
     806            rk1 = jk
     807            rk2 = jk - 1
     808            dz2(jk) = fz(rk1) - fz(rk2)
     809        ENDDO
     810        DO jk = 1, nsoilmx - 1
     811            rk1 = jk + .5
     812            rk2 = jk - .5
     813            dz1(jk) = 1. / (fz(rk1) - fz(rk2))
     814        ENDDO
     815        lambda = fz(.5) * dz1(1)
     816        DO jk = 1, nsoilmx
     817            rk = jk
     818            rk1 = jk + .5
     819            rk2 = jk - .5
     820        ENDDO
     821
     822    END SUBROUTINE get_soil_levels
     823
     824
     825    !===========================================================================
     826
     827    SUBROUTINE SISVAT_ini(knon)
     828
     829        !C +------------------------------------------------------------------------+
     830        !C | MAR          SISVAT_ini                             Jd 11-10-2007  MAR |
     831        !C |   SubRoutine SISVAT_ini generates non time dependant SISVAT parameters |
     832        !C +------------------------------------------------------------------------+
     833        !C |   PARAMETERS:  klonv: Total Number of columns =                        |
     834        !C |   ^^^^^^^^^^        = Total Number of continental     grid boxes       |
     835        !C |                     X       Number of Mosaic Cell per grid box         |
     836        !C |                                                                        |
     837        !C |   INPUT:   dt__SV   : Time  Step                                   [s] |
     838        !C |   ^^^^^    dz_dSV   : Layer Thickness                              [m] |
     839        !C |                                                                        |
     840        !C |   OUTPUT:             [-] |
     841        !C |   ^^^^^^   rocsSV   : Soil Contrib. to (ro c)_s exclud.Water  [J/kg/K] |
     842        !C |            etamSV   : Soil Minimum Humidity                    [m3/m3] |
     843        !C |                      (based on a prescribed Soil Relative Humidity)    |
     844        !C |            s1__SV   : Factor of eta**( b+2) in Hydraul.Diffusiv.       |
     845        !C |            s2__SV   : Factor of eta**( b+2) in Hydraul.Conduct.        |
     846        !C |            aKdtSV   : KHyd: Piecewise Linear Profile:  a * dt    [m]   |
     847        !C |            bKdtSV   : KHyd: Piecewise Linear Profile:  b * dt    [m/s] |
     848        !C |            dzsnSV(0): Soil first Layer Thickness                   [m] |
     849        !C |            dzmiSV   : Distance between two contiguous levels       [m] |
     850        !C |            dz78SV   : 7/8 (Layer Thickness)                        [m] |
     851        !C |            dz34SV   : 3/4 (Layer Thickness)                        [m] |
     852        !C |            dz_8SV   : 1/8 (Layer Thickness)                        [m] |
     853        !C |            dzAvSV   : 1/8  dz_(i-1) + 3/4 dz_(i) + 1/8 dz_(i+1)    [m] |
     854        !C |            dtz_SV   : dt/dz                                      [s/m] |
     855        !C |            OcndSV   : Swab Ocean / Soil Ratio                      [-] |
     856        !C |            Implic   : Implicit Parameter  (0.5:  Crank-Nicholson)      |
     857        !C |            Explic   : Explicit Parameter = 1.0 - Implic                |
     858        !C |                                                                        |
     859        !C | # OPTIONS: #ER: Richards Equation is not smoothed                      |
     860        !C | # ^^^^^^^  #kd: De Ridder   Discretization                             |
     861        !C | #          #SH: Hapex-Sahel Values                                     !
     862        !C |                                                                        |
     863        !C +------------------------------------------------------------------------+
     864        !
     865        !
     866
     867        !C +--Global Variables
     868        !C +  ================
     869
     870        USE dimphy
     871        USE VARphy
     872        USE VAR_SV
     873        USE VARdSV
     874        USE VAR0SV
     875        USE VARxSV
     876        USE VARtSV
     877        USE VARxSV
     878        USE VARySV
     879        IMPLICIT NONE
     880
     881
     882
     883        !C +--Arguments
     884        !C +  ==================
     885        INTEGER, INTENT(IN) :: knon
     886
     887        !C +--Internal Variables
     888        !C +  ==================
     889
     890        INTEGER :: ivt, ist, ikl, isl, isn, ikh
     891        INTEGER :: misl_2, nisl_2
     892        REAL :: d__eta, eta__1, eta__2, Khyd_1, Khyd_2
     893        REAL, PARAMETER :: RHsMin = 0.001        ! Min.Soil Relative Humidity
     894        REAL :: PsiMax                        ! Max.Soil Water    Potential
     895        REAL :: a_Khyd, b_Khyd                 ! Water conductivity
     896
     897
     898        !c #WR REAL    ::  Khyd_x,Khyd_y
     899
     900
     901
     902        !C +--Non Time Dependant SISVAT parameters
     903        !C +  ====================================
     904
     905        !C +--Soil Discretization
     906        !C +  -------------------
     907
     908        !C +--Numerical Scheme Parameters
     909        !C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^
    830910        Implic = 0.75                           ! 0.5  <==> Crank-Nicholson 
    831911        Explic = 1.00 - Implic                  !                           
    832                                                                              
    833 !C +--Soil/Snow Layers Indices                                               
    834 !C +  ^^^^^^^^^^^^^^^^^^^^^^^^                                               
    835       DO  isl=-nsol,0                                                         
    836         islpSV(isl) =           isl+1                                         
    837         islpSV(isl) = min(      islpSV(isl),0)                               
    838         islmSV(isl) =           isl-1                                         
    839         islmSV(isl) = max(-nsol,islmSV(isl))                                 
    840       END DO                                                                 
    841                                                                                
    842       DO  isn=1,nsno                                                           
    843         isnpSV(isn) =           isn+1                                         
    844         isnpSV(isn) = min(      isnpSV(isn),nsno)                           
    845       END DO                                                                 
    846                                                                              
    847 !C +--Soil      Layers Thicknesses                                             
    848 !C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^ 
    849 ! Not used here as LMDZ method is applied, see SUBROUTINE get_soil_levels!   
    850 !c #kd IF (nsol.gt.4)                                              THEN       
    851 !c #kd   DO isl=-5,-nsol,-1                                                   
    852 !c #kd     dz_dSV(isl)=   1.                                                 
    853 !c #kd   END DO                                                               
    854 !c #kd END IF                                                                 
    855 !                                                                             
    856 !      IF (nsol.ne.4)                                              THEN       
    857 !        DO isl= 0,-nsol,-1                                                   
    858 !          misl_2 =     -mod(isl,2)                                         
    859 !          nisl_2 =         -isl/2                                           
    860 !          dz_dSV(isl)=(((1-misl_2) * 0.001                                   
    861 !     .                  +  misl_2  * 0.003) * 10**(nisl_2)) * 4.             
    862 !C +...    dz_dSV(0)  =         Hapex-Sahel Calibration:       4 mm           
    863 !                                                                             
    864 !c +SH     dz_dSV(isl)=(((1-misl_2) * 0.001                                   
    865 !c +SH.                  +  misl_2  * 0.003) * 10**(nisl_2)) * 1.             
    866 !                                                                             
    867 !c #05     dz_dSV(isl)=(((1-misl_2) * 0.001                                   
    868 !c #05.                  +  misl_2  * 0.008) * 10**(nisl_2)) * 0.5             
    869 !        END DO                                                               
    870 !          dz_dSV(0)  =               0.001                                   
    871 !          dz_dSV(-1) = dz_dSV(-1)  - dz_dSV(0)              + 0.004         
    872 !      END IF           
    873 
    874                                                                                
    875         zz_dSV      = 0.                                                     
    876       DO  isl=-nsol,0                                                       
    877         dzmiSV(isl) = 0.500*(dz_dSV(isl)        +dz_dSV(islmSV(isl)))       
    878         dziiSV(isl) = 0.500* dz_dSV(isl)        /dzmiSV(isl)                 
    879         dzi_SV(isl) = 0.500* dz_dSV(islmSV(isl))/dzmiSV(isl)                   
    880         dtz_SV(isl) =        dt__SV             /dz_dSV(isl) 
    881         dtz_SV2(isl) =        1.            /dz_dSV(isl)                         
    882         dz78SV(isl) = 0.875* dz_dSV(isl)                                     
    883         dz34SV(isl) = 0.750* dz_dSV(isl)                                     
    884         dz_8SV(isl) = 0.125* dz_dSV(isl)                                       
    885         dzAvSV(isl) = 0.125* dz_dSV(islmSV(isl))                        &
    886      &              + 0.750* dz_dSV(isl)                                &
    887      &              + 0.125* dz_dSV(islpSV(isl))                                                             
    888         zz_dSV      = zz_dSV+dz_dSV(isl)                                     
    889       END DO                                                                 
    890       DO ikl=1,knon !v                                                         
    891         dzsnSV(ikl,0) =      dz_dSV(0)                                       
    892       END DO                                                                 
    893                                                                              
    894 !C +--Conversion to a 50 m Swab Ocean Discretization                           
    895 !C +  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~                           
    896         OcndSV = 0.                                                           
    897       DO isl=-nsol,0                                                         
    898         OcndSV = OcndSV +dz_dSV(isl)                                           
    899       END DO                                                                   
    900         OcndSV = 50.    /OcndSV                                               
    901                                                                                                            
    902                                                                                                                                                                                                                                
    903 !C +--Secondary Soil       Parameters                                         
    904 !C +  -------------------------------                                         
    905                                                                                
    906       DO  ist=0,nsot                                                           
    907          rocsSV(ist)=(1.0-etadSV(ist))*1.2E+6   ! Soil Contrib. to (ro c)_s   
    908          s1__SV(ist)=     bCHdSV(ist)          & ! Factor of (eta)**(b+2)     
    909      &  *psidSV(ist)     *Ks_dSV(ist)          & !    in DR97, Eqn.(3.36)     
    910      & /(etadSV(ist)**(   bCHdSV(ist)+3.))     !                             
    911          s2__SV(ist)=     Ks_dSV(ist)          & ! Factor of (eta)**(2b+3)     
    912      & /(etadSV(ist)**(2.*bCHdSV(ist)+3.))     !    in DR97, Eqn.(3.35)       
    913                                                                              
    914 !C +--Soil Minimum Humidity (from a prescribed minimum relative Humidity)     
    915 !C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^   
    916          Psimax = -(log(RHsMin))/7.2E-5        ! DR97, Eqn 3.15 Inversion   
    917          etamSV(ist) =  etadSV(ist)                                      &
    918      &         *(PsiMax/psidSV(ist))**(-min(10.,1./bCHdSV(ist)))             
    919       END DO                                                                 
    920          etamSV(12)  =  0.                                                   
    921                                                                              
    922 !C +--Piecewise Hydraulic Conductivity Profiles                               
    923 !C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^                               
    924       DO   ist=0,nsot                                                         
    925  
    926                                                                              
    927           d__eta          =  etadSV(ist)/nkhy                                 
    928           eta__1          =  0.                                             
    929           eta__2          =  d__eta                                           
    930         DO ikh=0,nkhy                                                         
    931           Khyd_1          =  s2__SV(ist)             & ! DR97, Eqn.(3.35)     
    932      &  *(eta__1      **(2. *bCHdSV(ist)+3.))        !                       
    933           Khyd_2          =  s2__SV(ist)             &!                       
    934      &  *(eta__2      **(2. *bCHdSV(ist)+3.))        !                       
    935                                                                              
    936           a_Khyd          = (Khyd_2-Khyd_1)/d__eta   !                       
    937           b_Khyd          =  Khyd_1-a_Khyd *eta__1   !                       
    938 !c #WR     Khyd_x          =  a_Khyd*eta__1 +b_Khyd   !                       
    939 !c #WR     Khyd_y          =  a_Khyd*eta__2 +b_Khyd   !                       
    940           aKdtSV(ist,ikh) =  a_Khyd       * dt__SV   !                       
    941           bKdtSV(ist,ikh) =  b_Khyd       * dt__SV   !                         
    942                
    943           eta__1          = eta__1  + d__eta                             
    944           eta__2          = eta__2  + d__eta                             
    945         END DO                                                             
    946       END DO                                                               
    947 
    948                                                                            
    949       return                                                               
    950 
    951   END SUBROUTINE SISVAT_ini
    952 
    953 
    954 
    955 
    956 
    957 
    958 
    959 !***************************************************************************
    960 
    961     SUBROUTINE sisvatetat0 (fichnom,ikl2i)
    962 
    963     USE dimphy
    964     USE mod_grid_phy_lmdz
    965     USE mod_phys_lmdz_para
    966 
    967     USE iostart
    968     USE VAR_SV
    969     USE VARdSV
    970     USE VARxSV         
    971     USE VARtSV
    972     USE indice_sol_mod
    973 
    974       IMPLICIT none
    975 !======================================================================
    976 ! Auteur(s) HJ PUNGE (LSCE) date: 07/2009
    977 ! Objet: Lecture du fichier de conditions initiales pour SISVAT
    978 !======================================================================
    979     include "netcdf.inc"
    980 !    include "indicesol.h"
    981 
    982 !    include "dimsoil.h"
    983     include "clesphys.h"
    984     include "thermcell.h"
    985     include "compbl.h"
    986 
    987 !======================================================================
    988     CHARACTER(LEN=*) :: fichnom
    989 
    990 
    991     INTEGER, DIMENSION(klon), INTENT(IN) :: ikl2i
    992     REAL, DIMENSION(klon) :: rlon
    993     REAL, DIMENSION(klon) :: rlat
    994 
    995 ! les variables globales ecrites dans le fichier restart
    996     REAL, DIMENSION(klon) :: isno
    997     REAL, DIMENSION(klon) :: ispi
    998     REAL, DIMENSION(klon) :: iice
    999     REAL, DIMENSION(klon) :: rusn
    1000     REAL, DIMENSION(klon, nsno) :: isto
    1001 
    1002     REAL, DIMENSION(klon, nsismx) :: Tsis
    1003     REAL, DIMENSION(klon, nsismx) :: eta
    1004     REAL, DIMENSION(klon, nsismx) :: ro
    1005 
    1006     REAL, DIMENSION(klon, nsno) :: dzsn     
    1007     REAL, DIMENSION(klon, nsno) :: G1sn
    1008     REAL, DIMENSION(klon, nsno) :: G2sn
    1009     REAL, DIMENSION(klon, nsno) :: agsn
    1010 
    1011     REAL, DIMENSION(klon) :: toic
    1012 
    1013 
    1014     INTEGER  :: isl, ikl, i, isn , errT, erreta, errro, errdz, snopts
    1015     CHARACTER (len=2) :: str2
    1016     LOGICAL :: found
    1017  
    1018     errT=0
    1019     errro=0
    1020     erreta=0
    1021     errdz=0
    1022     snopts=0
    1023 ! Ouvrir le fichier contenant l'etat initial:
    1024 
    1025       CALL open_startphy(fichnom)
    1026 
    1027 ! Lecture des latitudes, longitudes (coordonnees):
    1028 
    1029       CALL get_field("latitude",rlat,found)
    1030       CALL get_field("longitude",rlon,found)
    1031 
    1032       CALL get_field("n_snows", isno,found)
    1033       IF (.NOT. found) THEN
    1034         PRINT*, 'phyetat0: Le champ <n_snows> est absent'
    1035         PRINT *, 'fichier startsisvat non compatible avec sisvatetat0'
    1036       ENDIF
    1037 
    1038       CALL get_field("n_ice_top",ispi,found)
    1039       CALL get_field("n_ice",iice,found)
    1040       CALL get_field("surf_water",rusn,found)
    1041 !      IF (.NOT. found) THEN
    1042 !        PRINT*, 'phyetat0: Le champ <surf_water> est absent'
    1043 !        rusn(:)=0. 
    1044 !      ENDIF
    1045 
    1046 
    1047       CALL get_field("to_ice",toic,found)
    1048       IF (.NOT. found) THEN
    1049         PRINT*, 'phyetat0: Le champ <to_ice> est absent'
    1050         toic(:)=0. 
    1051       ENDIF
    1052 
    1053 
    1054 
    1055       DO isn = 1,nsno
    1056         IF (isn.LE.99) THEN
    1057             WRITE(str2,'(i2.2)') isn
    1058             CALL get_field("AGESNOW"//str2, &
    1059                           agsn(:,isn),found)
    1060         ELSE
    1061             PRINT*, "Trop de couches"
    1062             CALL abort
     912
     913        !C +--Soil/Snow Layers Indices
     914        !C +  ^^^^^^^^^^^^^^^^^^^^^^^^
     915        DO  isl = -nsol, 0
     916            islpSV(isl) = isl + 1
     917            islpSV(isl) = min(islpSV(isl), 0)
     918            islmSV(isl) = isl - 1
     919            islmSV(isl) = max(-nsol, islmSV(isl))
     920        END DO
     921
     922        DO  isn = 1, nsno
     923            isnpSV(isn) = isn + 1
     924            isnpSV(isn) = min(isnpSV(isn), nsno)
     925        END DO
     926
     927        !C +--Soil      Layers Thicknesses
     928        !C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
     929        ! Not used here as LMDZ method is applied, see SUBROUTINE get_soil_levels!
     930        !c #kd IF (nsol.gt.4)                                              THEN
     931        !c #kd   DO isl=-5,-nsol,-1
     932        !c #kd     dz_dSV(isl)=   1.
     933        !c #kd   END DO
     934        !c #kd END IF
     935        !
     936        !      IF (nsol.ne.4)                                              THEN
     937        !        DO isl= 0,-nsol,-1
     938        !          misl_2 =     -mod(isl,2)
     939        !          nisl_2 =         -isl/2
     940        !          dz_dSV(isl)=(((1-misl_2) * 0.001
     941        !     .                  +  misl_2  * 0.003) * 10**(nisl_2)) * 4.
     942        !C +...    dz_dSV(0)  =         Hapex-Sahel Calibration:       4 mm
     943        !
     944        !c +SH     dz_dSV(isl)=(((1-misl_2) * 0.001
     945        !c +SH.                  +  misl_2  * 0.003) * 10**(nisl_2)) * 1.
     946        !
     947        !c #05     dz_dSV(isl)=(((1-misl_2) * 0.001
     948        !c #05.                  +  misl_2  * 0.008) * 10**(nisl_2)) * 0.5
     949        !        END DO
     950        !          dz_dSV(0)  =               0.001
     951        !          dz_dSV(-1) = dz_dSV(-1)  - dz_dSV(0)              + 0.004
     952        !      END IF
     953
     954        zz_dSV = 0.
     955        DO  isl = -nsol, 0
     956            dzmiSV(isl) = 0.500 * (dz_dSV(isl) + dz_dSV(islmSV(isl)))
     957            dziiSV(isl) = 0.500 * dz_dSV(isl) / dzmiSV(isl)
     958            dzi_SV(isl) = 0.500 * dz_dSV(islmSV(isl)) / dzmiSV(isl)
     959            dtz_SV(isl) = dt__SV / dz_dSV(isl)
     960            dtz_SV2(isl) = 1. / dz_dSV(isl)
     961            dz78SV(isl) = 0.875 * dz_dSV(isl)
     962            dz34SV(isl) = 0.750 * dz_dSV(isl)
     963            dz_8SV(isl) = 0.125 * dz_dSV(isl)
     964            dzAvSV(isl) = 0.125 * dz_dSV(islmSV(isl))                        &
     965                    & + 0.750 * dz_dSV(isl)                                &
     966                    & + 0.125 * dz_dSV(islpSV(isl))
     967            zz_dSV = zz_dSV + dz_dSV(isl)
     968        END DO
     969        DO ikl = 1, knon !v
     970            dzsnSV(ikl, 0) = dz_dSV(0)
     971        END DO
     972
     973        !C +--Conversion to a 50 m Swab Ocean Discretization
     974        !C +  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
     975        OcndSV = 0.
     976        DO isl = -nsol, 0
     977            OcndSV = OcndSV + dz_dSV(isl)
     978        END DO
     979        OcndSV = 50. / OcndSV
     980
     981
     982        !C +--Secondary Soil       Parameters
     983        !C +  -------------------------------
     984
     985        DO  ist = 0, nsot
     986            rocsSV(ist) = (1.0 - etadSV(ist)) * 1.2E+6   ! Soil Contrib. to (ro c)_s
     987            s1__SV(ist) = bCHdSV(ist)          & ! Factor of (eta)**(b+2)
     988                    & * psidSV(ist) * Ks_dSV(ist)          & !    in DR97, Eqn.(3.36)
     989                    & / (etadSV(ist)**(bCHdSV(ist) + 3.))     !
     990            s2__SV(ist) = Ks_dSV(ist)          & ! Factor of (eta)**(2b+3)
     991                    & / (etadSV(ist)**(2. * bCHdSV(ist) + 3.))     !    in DR97, Eqn.(3.35)
     992
     993            !C +--Soil Minimum Humidity (from a prescribed minimum relative Humidity)
     994            !C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
     995            Psimax = -(log(RHsMin)) / 7.2E-5        ! DR97, Eqn 3.15 Inversion
     996            etamSV(ist) = etadSV(ist)                                      &
     997                    & * (PsiMax / psidSV(ist))**(-min(10., 1. / bCHdSV(ist)))
     998        END DO
     999        etamSV(12) = 0.
     1000
     1001        !C +--Piecewise Hydraulic Conductivity Profiles
     1002        !C +  ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
     1003        DO   ist = 0, nsot
     1004
     1005            d__eta = etadSV(ist) / nkhy
     1006            eta__1 = 0.
     1007            eta__2 = d__eta
     1008            DO ikh = 0, nkhy
     1009                Khyd_1 = s2__SV(ist)             & ! DR97, Eqn.(3.35)
     1010                        & * (eta__1      **(2. * bCHdSV(ist) + 3.))        !
     1011                Khyd_2 = s2__SV(ist)             &!
     1012                        & * (eta__2      **(2. * bCHdSV(ist) + 3.))        !
     1013
     1014                a_Khyd = (Khyd_2 - Khyd_1) / d__eta   !
     1015                b_Khyd = Khyd_1 - a_Khyd * eta__1   !
     1016                !c #WR     Khyd_x          =  a_Khyd*eta__1 +b_Khyd   !
     1017                !c #WR     Khyd_y          =  a_Khyd*eta__2 +b_Khyd   !
     1018                aKdtSV(ist, ikh) = a_Khyd * dt__SV   !
     1019                bKdtSV(ist, ikh) = b_Khyd * dt__SV   !
     1020
     1021                eta__1 = eta__1 + d__eta
     1022                eta__2 = eta__2 + d__eta
     1023            END DO
     1024        END DO
     1025
     1026        return
     1027
     1028    END SUBROUTINE SISVAT_ini
     1029
     1030
     1031    !***************************************************************************
     1032
     1033    SUBROUTINE sisvatetat0 (fichnom, ikl2i)
     1034
     1035        USE dimphy
     1036        USE mod_grid_phy_lmdz
     1037        USE mod_phys_lmdz_para
     1038
     1039        USE iostart
     1040        USE VAR_SV
     1041        USE VARdSV
     1042        USE VARxSV
     1043        USE VARtSV
     1044        USE indice_sol_mod
     1045
     1046        IMPLICIT none
     1047        !======================================================================
     1048        ! Auteur(s) HJ PUNGE (LSCE) date: 07/2009
     1049        ! Objet: Lecture du fichier de conditions initiales pour SISVAT
     1050        !======================================================================
     1051        include "netcdf.inc"
     1052        !    include "indicesol.h"
     1053
     1054        !    include "dimsoil.h"
     1055        include "clesphys.h"
     1056        include "thermcell.h"
     1057        include "compbl.h"
     1058
     1059        !======================================================================
     1060        CHARACTER(LEN = *) :: fichnom
     1061
     1062        INTEGER, DIMENSION(klon), INTENT(IN) :: ikl2i
     1063        REAL, DIMENSION(klon) :: rlon
     1064        REAL, DIMENSION(klon) :: rlat
     1065
     1066        ! les variables globales ecrites dans le fichier restart
     1067        REAL, DIMENSION(klon) :: isno
     1068        REAL, DIMENSION(klon) :: ispi
     1069        REAL, DIMENSION(klon) :: iice
     1070        REAL, DIMENSION(klon) :: rusn
     1071        REAL, DIMENSION(klon, nsno) :: isto
     1072
     1073        REAL, DIMENSION(klon, nsismx) :: Tsis
     1074        REAL, DIMENSION(klon, nsismx) :: eta
     1075        REAL, DIMENSION(klon, nsismx) :: ro
     1076
     1077        REAL, DIMENSION(klon, nsno) :: dzsn
     1078        REAL, DIMENSION(klon, nsno) :: G1sn
     1079        REAL, DIMENSION(klon, nsno) :: G2sn
     1080        REAL, DIMENSION(klon, nsno) :: agsn
     1081
     1082        REAL, DIMENSION(klon) :: toic
     1083
     1084        INTEGER :: isl, ikl, i, isn, errT, erreta, errro, errdz, snopts
     1085        CHARACTER (len = 2) :: str2
     1086        LOGICAL :: found
     1087
     1088        errT = 0
     1089        errro = 0
     1090        erreta = 0
     1091        errdz = 0
     1092        snopts = 0
     1093        ! Ouvrir le fichier contenant l'etat initial:
     1094
     1095        CALL open_startphy(fichnom)
     1096
     1097        ! Lecture des latitudes, longitudes (coordonnees):
     1098
     1099        CALL get_field("latitude", rlat, found)
     1100        CALL get_field("longitude", rlon, found)
     1101
     1102        CALL get_field("n_snows", isno, found)
     1103        IF (.NOT. found) THEN
     1104            PRINT*, 'phyetat0: Le champ <n_snows> est absent'
     1105            PRINT *, 'fichier startsisvat non compatible avec sisvatetat0'
    10631106        ENDIF
    1064       ENDDO
    1065       DO isn = 1,nsno
    1066         IF (isn.LE.99) THEN
    1067             WRITE(str2,'(i2.2)') isn
    1068             CALL get_field("DZSNOW"//str2, &
    1069                           dzsn(:,isn),found)
    1070         ELSE
    1071             PRINT*, "Trop de couches"
    1072             CALL abort
     1107
     1108        CALL get_field("n_ice_top", ispi, found)
     1109        CALL get_field("n_ice", iice, found)
     1110        CALL get_field("surf_water", rusn, found)
     1111
     1112
     1113        CALL get_field("to_ice", toic, found)
     1114        IF (.NOT. found) THEN
     1115            PRINT*, 'phyetat0: Le champ <to_ice> est absent'
     1116            toic(:) = 0.
    10731117        ENDIF
    1074       ENDDO
    1075       DO isn = 1,nsno
    1076         IF (isn.LE.99) THEN
    1077             WRITE(str2,'(i2.2)') isn
    1078             CALL get_field("G2SNOW"//str2, &
    1079                           G2sn(:,isn),found)
    1080         ELSE
    1081             PRINT*, "Trop de couches"
    1082             CALL abort
    1083         ENDIF
    1084       ENDDO
    1085       DO isn = 1,nsno
    1086         IF (isn.LE.99) THEN
    1087             WRITE(str2,'(i2.2)') isn
    1088             CALL get_field("G1SNOW"//str2, &
    1089                           G1sn(:,isn),found)
    1090         ELSE
    1091             PRINT*, "Trop de couches"
    1092             CALL abort
    1093         ENDIF
    1094       ENDDO
    1095       DO isn = 1,nsismx
    1096         IF (isn.LE.99) THEN
    1097             WRITE(str2,'(i2.2)') isn
    1098             CALL get_field("ETA"//str2, &
    1099                           eta(:,isn),found)
    1100         ELSE
    1101             PRINT*, "Trop de couches"
    1102             CALL abort
    1103         ENDIF
    1104       ENDDO
    1105       DO isn = 1,nsismx
    1106         IF (isn.LE.99) THEN
    1107             WRITE(str2,'(i2.2)') isn
    1108             CALL get_field("RO"//str2, &
    1109                           ro(:,isn),found)
    1110         ELSE
    1111             PRINT*, "Trop de couches"
    1112             CALL abort
    1113         ENDIF
    1114       ENDDO
    1115       DO isn = 1,nsismx
    1116         IF (isn.LE.99) THEN
    1117             WRITE(str2,'(i2.2)') isn
    1118             CALL get_field("TSS"//str2, &
    1119                           Tsis(:,isn),found)
    1120         ELSE
    1121             PRINT*, "Trop de couches"
    1122             CALL abort
    1123         ENDIF
    1124       ENDDO
    1125       DO isn = 1,nsno
    1126         IF (isn.LE.99) THEN
    1127             WRITE(str2,'(i2.2)') isn
    1128             CALL get_field("HISTORY"//str2, &
    1129                           isto(:,isn),found)
    1130         ELSE
    1131             PRINT*, "Trop de couches"
    1132             CALL abort
    1133         ENDIF
    1134       ENDDO
    1135       write(*,*)'Read ',fichnom,' finished!!'
    1136 
    1137 !*********************************************************************************
    1138 ! Compress restart file variables for SISVAT
    1139 
    1140 
    1141       DO  ikl = 1,klon                                                   
    1142           i   = ikl2i(ikl)   
    1143           IF (i > 0) THEN
    1144               isnoSV(ikl)     = INT(isno(i))          ! Nb Snow/Ice Lay.   
    1145               ispiSV(ikl)     = INT(ispi(i))          ! Nb Supr.Ice Lay. 
    1146               iiceSV(ikl)     = INT(iice(i))          ! Nb      Ice Lay.   
    1147                                                                              
    1148 
    1149             DO isl =   -nsol,0   
    1150               ro__SV(ikl,isl) = ro(i,nsno+1-isl)       !                   
    1151               eta_SV(ikl,isl) = eta(i,nsno+1-isl)         ! Soil Humidity     
    1152 !hjp 15/10/2010
    1153               IF (eta_SV(ikl,isl) <= 1.e-6) THEN          !hj check
    1154                 eta_SV(ikl,isl) = 1.e-6
    1155               ENDIF
    1156               TsisSV(ikl,isl) = Tsis(i,nsno+1-isl)        ! Soil Temperature 
    1157               IF (TsisSV(ikl,isl) <= 1.) THEN             !hj check
    1158 !                errT=errT+1
    1159                 TsisSV(ikl,isl) = 273.15-0.2              ! Etienne: negative temperature since soil is ice
    1160               ENDIF
    1161 
    1162             END DO       
    1163             write(*,*)'Copy histo', ikl
    1164    
    1165    
    1166             DO  isn = 1,isnoSV(ikl) !nsno     
    1167               snopts=snopts+1
    1168               IF (isto(i,isn) > 10.) THEN          !hj check
    1169                 write(*,*)'Irregular isto',ikl,i,isn,isto(i,isn)
    1170                 isto(i,isn) = 1.
    1171               ENDIF
    1172 
    1173               istoSV(ikl,isn) = INT(isto(i,isn))     ! Snow     History
    1174               ro__SV(ikl,isn) = ro(i,isn)            !        [kg/m3]     
    1175               eta_SV(ikl,isn) = eta(i,isn)           !        [m3/m3] 
    1176               TsisSV(ikl,isn) = Tsis(i,isn)          !            [K] 
    1177 
    1178              IF (TsisSV(ikl,isn) <= 1.) THEN          !hj check
    1179               errT=errT+1
    1180               TsisSV(ikl,isn) = TsisSV(ikl,0)
    1181              ENDIF 
    1182              IF (TsisSV(ikl,isn) <= 1.) THEN          !hj check
    1183               TsisSV(ikl,isn) = 263.15
    1184              ENDIF
    1185              IF (eta_SV(ikl,isn) < 1.e-9) THEN          !hj check
    1186               eta_SV(ikl,isn) = 1.e-6 
    1187               erreta=erreta+1
    1188              ENDIF 
    1189              IF (ro__SV(ikl,isn) <= 10.) THEN          !hj check
    1190               ro__SV(ikl,isn) = 11.
    1191               errro=errro+1
    1192              ENDIF
    1193               write(*,*)ikl,i,isn,Tsis(i,isn),G1sn(i,isn)
    1194               G1snSV(ikl,isn) = G1sn(i,isn)          ! [-]        [-]     
    1195               G2snSV(ikl,isn) = G2sn(i,isn)          ! [-] [0.0001 m]
    1196               dzsnSV(ikl,isn) = dzsn(i,isn)          !            [m]         
    1197               agsnSV(ikl,isn) = agsn(i,isn)          !          [day]     
    1198             END DO 
    1199               rusnSV(ikl)     = rusn(i)              ! Surficial Water   
    1200               toicSV(ikl)     = toic(i)              ! bilan snow to ice   
    1201           END IF                       
    1202         END DO   
     1118
     1119        DO isn = 1, nsno
     1120            IF (isn.LE.99) THEN
     1121                WRITE(str2, '(i2.2)') isn
     1122                CALL get_field("AGESNOW" // str2, &
     1123                        agsn(:, isn), found)
     1124            ELSE
     1125                PRINT*, "Trop de couches"
     1126                CALL abort
     1127            ENDIF
     1128        ENDDO
     1129        DO isn = 1, nsno
     1130            IF (isn.LE.99) THEN
     1131                WRITE(str2, '(i2.2)') isn
     1132                CALL get_field("DZSNOW" // str2, &
     1133                        dzsn(:, isn), found)
     1134            ELSE
     1135                PRINT*, "Trop de couches"
     1136                CALL abort
     1137            ENDIF
     1138        ENDDO
     1139        DO isn = 1, nsno
     1140            IF (isn.LE.99) THEN
     1141                WRITE(str2, '(i2.2)') isn
     1142                CALL get_field("G2SNOW" // str2, &
     1143                        G2sn(:, isn), found)
     1144            ELSE
     1145                PRINT*, "Trop de couches"
     1146                CALL abort
     1147            ENDIF
     1148        ENDDO
     1149        DO isn = 1, nsno
     1150            IF (isn.LE.99) THEN
     1151                WRITE(str2, '(i2.2)') isn
     1152                CALL get_field("G1SNOW" // str2, &
     1153                        G1sn(:, isn), found)
     1154            ELSE
     1155                PRINT*, "Trop de couches"
     1156                CALL abort
     1157            ENDIF
     1158        ENDDO
     1159        DO isn = 1, nsismx
     1160            IF (isn.LE.99) THEN
     1161                WRITE(str2, '(i2.2)') isn
     1162                CALL get_field("ETA" // str2, &
     1163                        eta(:, isn), found)
     1164            ELSE
     1165                PRINT*, "Trop de couches"
     1166                CALL abort
     1167            ENDIF
     1168        ENDDO
     1169        DO isn = 1, nsismx
     1170            IF (isn.LE.99) THEN
     1171                WRITE(str2, '(i2.2)') isn
     1172                CALL get_field("RO" // str2, &
     1173                        ro(:, isn), found)
     1174            ELSE
     1175                PRINT*, "Trop de couches"
     1176                CALL abort
     1177            ENDIF
     1178        ENDDO
     1179        DO isn = 1, nsismx
     1180            IF (isn.LE.99) THEN
     1181                WRITE(str2, '(i2.2)') isn
     1182                CALL get_field("TSS" // str2, &
     1183                        Tsis(:, isn), found)
     1184            ELSE
     1185                PRINT*, "Trop de couches"
     1186                CALL abort
     1187            ENDIF
     1188        ENDDO
     1189        DO isn = 1, nsno
     1190            IF (isn.LE.99) THEN
     1191                WRITE(str2, '(i2.2)') isn
     1192                CALL get_field("HISTORY" // str2, &
     1193                        isto(:, isn), found)
     1194            ELSE
     1195                PRINT*, "Trop de couches"
     1196                CALL abort
     1197            ENDIF
     1198        ENDDO
     1199        write(*, *)'Read ', fichnom, ' finished!!'
     1200
     1201        !*********************************************************************************
     1202        ! Compress restart file variables for SISVAT
     1203
     1204        DO  ikl = 1, klon
     1205            i = ikl2i(ikl)
     1206            IF (i > 0) THEN
     1207                isnoSV(ikl) = INT(isno(i))          ! Nb Snow/Ice Lay.
     1208                ispiSV(ikl) = INT(ispi(i))          ! Nb Supr.Ice Lay.
     1209                iiceSV(ikl) = INT(iice(i))          ! Nb      Ice Lay.
     1210
     1211                DO isl = -nsol, 0
     1212                    ro__SV(ikl, isl) = ro(i, nsno + 1 - isl)       !
     1213                    eta_SV(ikl, isl) = eta(i, nsno + 1 - isl)         ! Soil Humidity
     1214                    !hjp 15/10/2010
     1215                    IF (eta_SV(ikl, isl) <= 1.e-6) THEN          !hj check
     1216                        eta_SV(ikl, isl) = 1.e-6
     1217                    ENDIF
     1218                    TsisSV(ikl, isl) = Tsis(i, nsno + 1 - isl)        ! Soil Temperature
     1219                    IF (TsisSV(ikl, isl) <= 1.) THEN             !hj check
     1220                        !                errT=errT+1
     1221                        TsisSV(ikl, isl) = 273.15 - 0.2              ! Etienne: negative temperature since soil is ice
     1222                    ENDIF
     1223
     1224                END DO
     1225                write(*, *)'Copy histo', ikl
     1226
     1227                DO  isn = 1, isnoSV(ikl) !nsno
     1228                    snopts = snopts + 1
     1229                    IF (isto(i, isn) > 10.) THEN          !hj check
     1230                        write(*, *)'Irregular isto', ikl, i, isn, isto(i, isn)
     1231                        isto(i, isn) = 1.
     1232                    ENDIF
     1233
     1234                    istoSV(ikl, isn) = INT(isto(i, isn))     ! Snow     History
     1235                    ro__SV(ikl, isn) = ro(i, isn)            !        [kg/m3]
     1236                    eta_SV(ikl, isn) = eta(i, isn)           !        [m3/m3]
     1237                    TsisSV(ikl, isn) = Tsis(i, isn)          !            [K]
     1238
     1239                    IF (TsisSV(ikl, isn) <= 1.) THEN          !hj check
     1240                        errT = errT + 1
     1241                        TsisSV(ikl, isn) = TsisSV(ikl, 0)
     1242                    ENDIF
     1243                    IF (TsisSV(ikl, isn) <= 1.) THEN          !hj check
     1244                        TsisSV(ikl, isn) = 263.15
     1245                    ENDIF
     1246                    IF (eta_SV(ikl, isn) < 1.e-9) THEN          !hj check
     1247                        eta_SV(ikl, isn) = 1.e-6
     1248                        erreta = erreta + 1
     1249                    ENDIF
     1250                    IF (ro__SV(ikl, isn) <= 10.) THEN          !hj check
     1251                        ro__SV(ikl, isn) = 11.
     1252                        errro = errro + 1
     1253                    ENDIF
     1254                    write(*, *)ikl, i, isn, Tsis(i, isn), G1sn(i, isn)
     1255                    G1snSV(ikl, isn) = G1sn(i, isn)          ! [-]        [-]
     1256                    G2snSV(ikl, isn) = G2sn(i, isn)          ! [-] [0.0001 m]
     1257                    dzsnSV(ikl, isn) = dzsn(i, isn)          !            [m]
     1258                    agsnSV(ikl, isn) = agsn(i, isn)          !          [day]
     1259                END DO
     1260                rusnSV(ikl) = rusn(i)              ! Surficial Water
     1261                toicSV(ikl) = toic(i)              ! bilan snow to ice
     1262            END IF
     1263        END DO
    12031264
    12041265    END SUBROUTINE sisvatetat0
    12051266
    12061267
    1207 
    1208 
    1209 !======================================================================
    1210     SUBROUTINE sisvatredem (fichnom,ikl2i,rlon,rlat)
    1211    
    1212      
    1213    
    1214 !======================================================================
    1215 ! Auteur(s) HJ PUNGE (LSCE) date: 07/2009
    1216 ! Objet: Ecriture de l'etat de redemarrage pour SISVAT
    1217 !======================================================================
    1218     USE mod_grid_phy_lmdz
    1219     USE mod_phys_lmdz_para
    1220     USE iostart
    1221     USE VAR_SV
    1222     USE VARxSV         
    1223     USE VARySV !hj tmp 12 03 2010
    1224     USE VARtSV
    1225     USE indice_sol_mod
    1226     USE dimphy
    1227 
    1228 
    1229     IMPLICIT none
    1230 
    1231     include "netcdf.inc"
    1232 !    include "indicesol.h"
    1233 !    include "dimsoil.h"
    1234     include "clesphys.h"
    1235     include "thermcell.h"
    1236     include "compbl.h"
    1237 
    1238 !======================================================================
    1239 
    1240     CHARACTER(LEN=*) :: fichnom
    1241     INTEGER, DIMENSION(klon), INTENT(IN) :: ikl2i
    1242     REAL, DIMENSION(klon), INTENT(IN) :: rlon
    1243     REAL, DIMENSION(klon), INTENT(IN) :: rlat
    1244 
    1245 ! les variables globales ecrites dans le fichier restart
    1246     REAL, DIMENSION(klon) :: isno
    1247     REAL, DIMENSION(klon) :: ispi
    1248     REAL, DIMENSION(klon) :: iice
    1249     REAL, DIMENSION(klon, nsnowmx) :: isto
    1250 
    1251     REAL, DIMENSION(klon, nsismx) :: Tsis
    1252     REAL, DIMENSION(klon, nsismx) :: eta
    1253     REAL, DIMENSION(klon, nsnowmx) :: dzsn
    1254     REAL, DIMENSION(klon, nsismx) :: ro       
    1255     REAL, DIMENSION(klon, nsnowmx) :: G1sn
    1256     REAL, DIMENSION(klon, nsnowmx) :: G2sn
    1257     REAL, DIMENSION(klon, nsnowmx) :: agsn
    1258     REAL, DIMENSION(klon) :: IRs
    1259     REAL, DIMENSION(klon) :: LMO
    1260     REAL, DIMENSION(klon) :: rusn
    1261     REAL, DIMENSION(klon) :: toic
    1262     REAL, DIMENSION(klon) :: Bufs
    1263     REAL, DIMENSION(klon) :: alb1,alb2,alb3
    1264 
    1265     INTEGER isl, ikl, i, isn, ierr
    1266     CHARACTER (len=2) :: str2
    1267     INTEGER           :: pass
    1268 
    1269       isno(:)       = 0       
    1270       ispi(:)       = 0
    1271       iice(:)       = 0                               
    1272       IRs(:)        = 0.
    1273       LMO(:)        = 0.                             
    1274       eta(:,:)      = 0.     
    1275       Tsis(:,:)     = 0.         
    1276       isto(:,:)     = 0
    1277       ro(:,:)       = 0.       
    1278       G1sn(:,:)     = 0.   
    1279       G2sn(:,:)     = 0.
    1280       dzsn(:,:)     = 0.       
    1281       agsn(:,:)     = 0.
    1282       rusn(:)       = 0.   
    1283       toic(:)       = 0.   
    1284       Bufs(:)       = 0.   
    1285       alb1(:)       = 0.
    1286       alb2(:)       = 0.
    1287       alb3(:)       = 0.
    1288 
    1289 !***************************************************************************
    1290 ! Uncompress SISVAT output variables for storage
    1291            
    1292 
    1293       print*, 'je rentre dans restart inlandsis'     
    1294       DO  ikl = 1,klon 
    1295            i   = ikl2i(ikl)
    1296       IF (i > 0) THEN
    1297         isno(i)       = 1.*isnoSV(ikl)               ! Nb Snow/Ice Lay.   
    1298         ispi(i)       = 1.*ispiSV(ikl)               ! Nb Supr.Ice Lay.   
    1299         iice(i)       = 1.*iiceSV(ikl)               ! Nb      Ice Lay.       
    1300    
    1301 !        IRs(i)        = IRs_SV(ikl)
    1302 !        LMO(i)        = LMO_SV(ikl)                             
    1303 
    1304 
    1305         DO isl =   -nsol,0                           !                   
    1306           eta(i,nsno+1-isl)  = eta_SV(ikl,isl)            ! Soil Humidity     
    1307           Tsis(i,nsno+1-isl) = TsisSV(ikl,isl)            ! Soil Temperature   
    1308           ro(i,nsno+1-isl)   = ro__SV(ikl,isl)            !        [kg/m3]   
    1309         END DO       
    1310  
    1311  
    1312         DO  isn = 1,nsno             
    1313           isto(i,isn)   = 1.*istoSV(ikl,isn)         ! Snow     History
    1314           ro(i,isn)     = ro__SV(ikl,isn)            !        [kg/m3]     
    1315           eta(i,isn)    = eta_SV(ikl,isn)            !        [m3/m3] 
    1316           Tsis(i,isn)   = TsisSV(ikl,isn)            !            [K]   
    1317           G1sn(i,isn)   = G1snSV(ikl,isn)            ! [-]        [-]     
    1318           G2sn(i,isn)   = G2snSV(ikl,isn)            ! [-] [0.0001 m]
    1319           dzsn(i,isn)   = dzsnSV(ikl,isn)            !            [m]         
    1320           agsn(i,isn)   = agsnSV(ikl,isn)            !          [day]     
    1321         END DO 
    1322         rusn(i)       = rusnSV(ikl)                  ! Surficial Water 
    1323         toic(i)       = toicSV(ikl)                  ! to ice
    1324         alb1(i)       = alb1sv(ikl)
    1325         alb2(i)       = alb2sv(ikl)
    1326         alb3(i)       = alb3sv(ikl)
    1327 !        Bufs(i)       = BufsSV(ikl)     
    1328       END IF                     
    1329       END DO                                               
    1330 
    1331 
    1332       print*, 'je call open_restart'     
    1333 
    1334       CALL open_restartphy(fichnom)
    1335 
    1336       print*, 'je sors open_restart'     
    1337 
    1338 
    1339       DO pass = 1, 2
    1340         CALL put_field(pass,"longitude", &
    1341                     "Longitudes de la grille physique",rlon)     
    1342         CALL put_field(pass,"latitude","Latitudes de la grille physique",rlat)
    1343  
    1344         CALL put_field(pass,"n_snows", "number of snow/ice layers",isno)
    1345         CALL put_field(pass,"n_ice_top", "number of top ice layers",ispi)
    1346         CALL put_field(pass,"n_ice", "number of ice layers",iice)
    1347         CALL put_field(pass,"IR_soil", "Soil IR flux",IRs)
    1348         CALL put_field(pass,"LMO", "Monin-Obukhov Scale",LMO)
    1349         CALL put_field(pass,"surf_water", "Surficial water",rusn)
    1350         CALL put_field(pass,"snow_buffer", "Snow buffer layer",Bufs)
    1351         CALL put_field(pass,"alb_1", "albedo sw",alb1)
    1352         CALL put_field(pass,"alb_2", "albedo nIR",alb2)
    1353         CALL put_field(pass,"alb_3", "albedo fIR",alb3)
    1354         CALL put_field(pass,"to_ice", "Snow passed to ice",toic)
    1355 
    1356 
    1357 
    1358         DO isn = 1,nsno
    1359           IF (isn.LE.99) THEN
    1360             WRITE(str2,'(i2.2)') isn
    1361             CALL put_field(pass,"AGESNOW"//str2, &
    1362                          "Age de la neige layer No."//str2, &
    1363                          agsn(:,isn))
    1364           ELSE
    1365             PRINT*, "Trop de couches"
    1366             CALL abort
    1367           ENDIF
     1268    !======================================================================
     1269    SUBROUTINE sisvatredem (fichnom, ikl2i, rlon, rlat)
     1270
     1271
     1272
     1273        !======================================================================
     1274        ! Auteur(s) HJ PUNGE (LSCE) date: 07/2009
     1275        ! Objet: Ecriture de l'etat de redemarrage pour SISVAT
     1276        !======================================================================
     1277        USE mod_grid_phy_lmdz
     1278        USE mod_phys_lmdz_para
     1279        USE iostart
     1280        USE VAR_SV
     1281        USE VARxSV
     1282        USE VARySV !hj tmp 12 03 2010
     1283        USE VARtSV
     1284        USE indice_sol_mod
     1285        USE dimphy
     1286
     1287        IMPLICIT none
     1288
     1289        include "netcdf.inc"
     1290        !    include "indicesol.h"
     1291        !    include "dimsoil.h"
     1292        include "clesphys.h"
     1293        include "thermcell.h"
     1294        include "compbl.h"
     1295
     1296        !======================================================================
     1297
     1298        CHARACTER(LEN = *) :: fichnom
     1299        INTEGER, DIMENSION(klon), INTENT(IN) :: ikl2i
     1300        REAL, DIMENSION(klon), INTENT(IN) :: rlon
     1301        REAL, DIMENSION(klon), INTENT(IN) :: rlat
     1302
     1303        ! les variables globales ecrites dans le fichier restart
     1304        REAL, DIMENSION(klon) :: isno
     1305        REAL, DIMENSION(klon) :: ispi
     1306        REAL, DIMENSION(klon) :: iice
     1307        REAL, DIMENSION(klon, nsnowmx) :: isto
     1308
     1309        REAL, DIMENSION(klon, nsismx) :: Tsis
     1310        REAL, DIMENSION(klon, nsismx) :: eta
     1311        REAL, DIMENSION(klon, nsnowmx) :: dzsn
     1312        REAL, DIMENSION(klon, nsismx) :: ro
     1313        REAL, DIMENSION(klon, nsnowmx) :: G1sn
     1314        REAL, DIMENSION(klon, nsnowmx) :: G2sn
     1315        REAL, DIMENSION(klon, nsnowmx) :: agsn
     1316        REAL, DIMENSION(klon) :: IRs
     1317        REAL, DIMENSION(klon) :: LMO
     1318        REAL, DIMENSION(klon) :: rusn
     1319        REAL, DIMENSION(klon) :: toic
     1320        REAL, DIMENSION(klon) :: Bufs
     1321        REAL, DIMENSION(klon) :: alb1, alb2, alb3
     1322
     1323        INTEGER isl, ikl, i, isn, ierr
     1324        CHARACTER (len = 2) :: str2
     1325        INTEGER :: pass
     1326
     1327        isno(:) = 0
     1328        ispi(:) = 0
     1329        iice(:) = 0
     1330        IRs(:) = 0.
     1331        LMO(:) = 0.
     1332        eta(:, :) = 0.
     1333        Tsis(:, :) = 0.
     1334        isto(:, :) = 0
     1335        ro(:, :) = 0.
     1336        G1sn(:, :) = 0.
     1337        G2sn(:, :) = 0.
     1338        dzsn(:, :) = 0.
     1339        agsn(:, :) = 0.
     1340        rusn(:) = 0.
     1341        toic(:) = 0.
     1342        Bufs(:) = 0.
     1343        alb1(:) = 0.
     1344        alb2(:) = 0.
     1345        alb3(:) = 0.
     1346
     1347        !***************************************************************************
     1348        ! Uncompress SISVAT output variables for storage
     1349
     1350        DO  ikl = 1, klon
     1351            i = ikl2i(ikl)
     1352            IF (i > 0) THEN
     1353                isno(i) = 1. * isnoSV(ikl)               ! Nb Snow/Ice Lay.
     1354                ispi(i) = 1. * ispiSV(ikl)               ! Nb Supr.Ice Lay.
     1355                iice(i) = 1. * iiceSV(ikl)               ! Nb      Ice Lay.
     1356
     1357                !        IRs(i)        = IRs_SV(ikl)
     1358                !        LMO(i)        = LMO_SV(ikl)
     1359
     1360                DO isl = -nsol, 0                           !
     1361                    eta(i, nsno + 1 - isl) = eta_SV(ikl, isl)            ! Soil Humidity
     1362                    Tsis(i, nsno + 1 - isl) = TsisSV(ikl, isl)            ! Soil Temperature
     1363                    ro(i, nsno + 1 - isl) = ro__SV(ikl, isl)            !        [kg/m3]
     1364                END DO
     1365
     1366                DO  isn = 1, nsno
     1367                    isto(i, isn) = 1. * istoSV(ikl, isn)         ! Snow     History
     1368                    ro(i, isn) = ro__SV(ikl, isn)            !        [kg/m3]
     1369                    eta(i, isn) = eta_SV(ikl, isn)            !        [m3/m3]
     1370                    Tsis(i, isn) = TsisSV(ikl, isn)            !            [K]
     1371                    G1sn(i, isn) = G1snSV(ikl, isn)            ! [-]        [-]
     1372                    G2sn(i, isn) = G2snSV(ikl, isn)            ! [-] [0.0001 m]
     1373                    dzsn(i, isn) = dzsnSV(ikl, isn)            !            [m]
     1374                    agsn(i, isn) = agsnSV(ikl, isn)            !          [day]
     1375                END DO
     1376                rusn(i) = rusnSV(ikl)                  ! Surficial Water
     1377                toic(i) = toicSV(ikl)                  ! to ice
     1378                alb1(i) = alb1sv(ikl)
     1379                alb2(i) = alb2sv(ikl)
     1380                alb3(i) = alb3sv(ikl)
     1381                !        Bufs(i)       = BufsSV(ikl)
     1382            END IF
     1383        END DO
     1384
     1385        CALL open_restartphy(fichnom)
     1386
     1387        DO pass = 1, 2
     1388            CALL put_field(pass, "longitude", &
     1389                    "Longitudes de la grille physique", rlon)
     1390            CALL put_field(pass, "latitude", "Latitudes de la grille physique", rlat)
     1391
     1392            CALL put_field(pass, "n_snows", "number of snow/ice layers", isno)
     1393            CALL put_field(pass, "n_ice_top", "number of top ice layers", ispi)
     1394            CALL put_field(pass, "n_ice", "number of ice layers", iice)
     1395            CALL put_field(pass, "IR_soil", "Soil IR flux", IRs)
     1396            CALL put_field(pass, "LMO", "Monin-Obukhov Scale", LMO)
     1397            CALL put_field(pass, "surf_water", "Surficial water", rusn)
     1398            CALL put_field(pass, "snow_buffer", "Snow buffer layer", Bufs)
     1399            CALL put_field(pass, "alb_1", "albedo sw", alb1)
     1400            CALL put_field(pass, "alb_2", "albedo nIR", alb2)
     1401            CALL put_field(pass, "alb_3", "albedo fIR", alb3)
     1402            CALL put_field(pass, "to_ice", "Snow passed to ice", toic)
     1403
     1404            DO isn = 1, nsno
     1405                IF (isn.LE.99) THEN
     1406                    WRITE(str2, '(i2.2)') isn
     1407                    CALL put_field(pass, "AGESNOW" // str2, &
     1408                            "Age de la neige layer No." // str2, &
     1409                            agsn(:, isn))
     1410                ELSE
     1411                    PRINT*, "Trop de couches"
     1412                    CALL abort
     1413                ENDIF
     1414            ENDDO
     1415            DO isn = 1, nsno
     1416                IF (isn.LE.99) THEN
     1417                    WRITE(str2, '(i2.2)') isn
     1418                    CALL put_field(pass, "DZSNOW" // str2, &
     1419                            "Snow/ice thickness layer No." // str2, &
     1420                            dzsn(:, isn))
     1421                ELSE
     1422                    PRINT*, "Trop de couches"
     1423                    CALL abort
     1424                ENDIF
     1425            ENDDO
     1426            DO isn = 1, nsno
     1427                IF (isn.LE.99) THEN
     1428                    WRITE(str2, '(i2.2)') isn
     1429                    CALL put_field(pass, "G2SNOW" // str2, &
     1430                            "Snow Property 2, layer No." // str2, &
     1431                            G2sn(:, isn))
     1432                ELSE
     1433                    PRINT*, "Trop de couches"
     1434                    CALL abort
     1435                ENDIF
     1436            ENDDO
     1437            DO isn = 1, nsno
     1438                IF (isn.LE.99) THEN
     1439                    WRITE(str2, '(i2.2)') isn
     1440                    CALL put_field(pass, "G1SNOW" // str2, &
     1441                            "Snow Property 1, layer No." // str2, &
     1442                            G1sn(:, isn))
     1443                ELSE
     1444                    PRINT*, "Trop de couches"
     1445                    CALL abort
     1446                ENDIF
     1447            ENDDO
     1448            DO isn = 1, nsismx
     1449                IF (isn.LE.99) THEN
     1450                    WRITE(str2, '(i2.2)') isn
     1451                    CALL put_field(pass, "ETA" // str2, &
     1452                            "Soil/snow water content layer No." // str2, &
     1453                            eta(:, isn))
     1454                ELSE
     1455                    PRINT*, "Trop de couches"
     1456                    CALL abort
     1457                ENDIF
     1458            ENDDO
     1459            DO isn = 1, nsismx   !nsno
     1460                IF (isn.LE.99) THEN
     1461                    WRITE(str2, '(i2.2)') isn
     1462                    CALL put_field(pass, "RO" // str2, &
     1463                            "Snow density layer No." // str2, &
     1464                            ro(:, isn))
     1465                ELSE
     1466                    PRINT*, "Trop de couches"
     1467                    CALL abort
     1468                ENDIF
     1469            ENDDO
     1470            DO isn = 1, nsismx
     1471                IF (isn.LE.99) THEN
     1472                    WRITE(str2, '(i2.2)') isn
     1473                    CALL put_field(pass, "TSS" // str2, &
     1474                            "Soil/snow temperature layer No." // str2, &
     1475                            Tsis(:, isn))
     1476                ELSE
     1477                    PRINT*, "Trop de couches"
     1478                    CALL abort
     1479                ENDIF
     1480            ENDDO
     1481            DO isn = 1, nsno
     1482                IF (isn.LE.99) THEN
     1483                    WRITE(str2, '(i2.2)') isn
     1484                    CALL put_field(pass, "HISTORY" // str2, &
     1485                            "Snow history layer No." // str2, &
     1486                            isto(:, isn))
     1487                ELSE
     1488                    PRINT*, "Trop de couches"
     1489                    CALL abort
     1490                ENDIF
     1491            ENDDO
     1492
     1493            CALL enddef_restartphy
    13681494        ENDDO
    1369         DO isn = 1,nsno
    1370           IF (isn.LE.99) THEN
    1371             WRITE(str2,'(i2.2)') isn
    1372             CALL put_field(pass,"DZSNOW"//str2, &
    1373                          "Snow/ice thickness layer No."//str2, &
    1374                          dzsn(:,isn))
    1375           ELSE
    1376             PRINT*, "Trop de couches"
    1377             CALL abort
    1378           ENDIF
    1379         ENDDO
    1380         DO isn = 1,nsno
    1381           IF (isn.LE.99) THEN
    1382             WRITE(str2,'(i2.2)') isn
    1383             CALL put_field(pass,"G2SNOW"//str2, &
    1384                          "Snow Property 2, layer No."//str2, &
    1385                          G2sn(:,isn))
    1386           ELSE
    1387             PRINT*, "Trop de couches"
    1388             CALL abort
    1389           ENDIF
    1390         ENDDO
    1391         DO isn = 1,nsno
    1392           IF (isn.LE.99) THEN
    1393             WRITE(str2,'(i2.2)') isn
    1394             CALL put_field(pass,"G1SNOW"//str2, &
    1395                          "Snow Property 1, layer No."//str2, &
    1396                          G1sn(:,isn))
    1397           ELSE
    1398             PRINT*, "Trop de couches"
    1399             CALL abort
    1400           ENDIF
    1401         ENDDO
    1402         DO isn = 1,nsismx
    1403           IF (isn.LE.99) THEN
    1404             WRITE(str2,'(i2.2)') isn
    1405             CALL put_field(pass,"ETA"//str2, &
    1406                          "Soil/snow water content layer No."//str2, &
    1407                          eta(:,isn))
    1408           ELSE
    1409             PRINT*, "Trop de couches"
    1410             CALL abort
    1411           ENDIF
    1412         ENDDO
    1413         DO isn = 1,nsismx   !nsno
    1414           IF (isn.LE.99) THEN
    1415             WRITE(str2,'(i2.2)') isn
    1416             CALL put_field(pass,"RO"//str2, &
    1417                            "Snow density layer No."//str2, &
    1418                            ro(:,isn))
    1419           ELSE
    1420             PRINT*, "Trop de couches"
    1421             CALL abort
    1422           ENDIF
    1423         ENDDO
    1424         DO isn = 1,nsismx
    1425           IF (isn.LE.99) THEN
    1426             WRITE(str2,'(i2.2)') isn
    1427             CALL put_field(pass,"TSS"//str2, &
    1428                            "Soil/snow temperature layer No."//str2, &
    1429                            Tsis(:,isn))
    1430           ELSE
    1431             PRINT*, "Trop de couches"
    1432             CALL abort
    1433           ENDIF
    1434         ENDDO
    1435         DO isn = 1,nsno
    1436           IF (isn.LE.99) THEN
    1437             WRITE(str2,'(i2.2)') isn
    1438             CALL put_field(pass,"HISTORY"//str2, &
    1439                            "Snow history layer No."//str2, &
    1440                            isto(:,isn))
    1441           ELSE
    1442             PRINT*, "Trop de couches"
    1443             CALL abort
    1444           ENDIF
    1445         ENDDO
    1446 
    1447       CALL enddef_restartphy
    1448       ENDDO
    1449       CALL close_restartphy
    1450 
    1451 
    1452   END SUBROUTINE sisvatredem
     1495        CALL close_restartphy
     1496
     1497    END SUBROUTINE sisvatredem
    14531498
    14541499END MODULE surf_inlandsis_mod

  • LMDZ6/branches/Ocean_skin/libf/phylmd/iophys.F90

    r3115 r4013  
    5656
    5757
     58
    5859      CALL Gather(px,xglo)
    5960!$OMP MASTER
    … …  
    109110
    110111!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    111       SUBROUTINE iophys_ini
     112      SUBROUTINE iophys_ini(timestep)
    112113      USE mod_phys_lmdz_para, ONLY: is_mpi_root
    113114      USE vertical_layers_mod, ONLY: presnivs
    … …  
    115116      USE dimphy, ONLY: klev
    116117      USE mod_grid_phy_lmdz, ONLY: klon_glo
     118      USE temps_mod, ONLY : day_ini,annee_ref,day_ref
     119      USE temps_mod, ONLY : jD_ref,jH_ref,start_time, calend
     120      USE comconst_mod, ONLY: daysec
     121
    117122
    118123      IMPLICIT NONE
    … …  
    136141real pi
    137142INTEGER nlat_eff
     143INTEGER jour0,mois0,an0
     144REAL timestep,t0
     145CHARACTER(len=20) :: calendrier
    138146
    139147!   Arguments:
    140148!   ----------
     149
    141150
    142151!$OMP MASTER
    … …  
    152161ENDIF
    153162pi=2.*asin(1.)
    154 call iotd_ini('phys.nc   ', &
    155 size(lon_reg),nlat_eff,klev,lon_reg(:)*180./pi,lat_reg*180./pi,presnivs)
     163
     164! print*,'day_ini,annee_ref,day_ref',day_ini,annee_ref,day_ref
     165! print*,'jD_ref,jH_ref,start_time, calend',jD_ref,jH_ref,start_time, calend
     166
     167! Attention : les lignes ci dessous supposent un calendrier en 360 jours
     168! Pourrait être retravaillé
     169
     170jour0=day_ref-30*(day_ref/30)
     171mois0=day_ref/30+1
     172an0=annee_ref
     173t0=(day_ini-1)*daysec
     174calendrier=calend
     175
     176if ( calendrier == "earth_360d" ) calendrier="360d"
     177
     178call iotd_ini('phys.nc', &
     179size(lon_reg),nlat_eff,klev,lon_reg(:)*180./pi,lat_reg*180./pi,presnivs,jour0,mois0,an0,t0,timestep,calendrier)
    156180    ENDIF
    157181!$OMP END MASTER

  • LMDZ6/branches/Ocean_skin/libf/phylmd/iotd.h

    r3102 r4013  
    1212      integer imax,jmax,lmax,nid
    1313      INTEGER dim_coord(4)
    14       real iotd_ts
     14      real iotd_ts,iotd_t0
     15      integer :: n_names_iotd_def
     16      character*20, dimension(200) :: names_iotd_def
     17      character*20 :: un_nom
    1518
    16       common/ecritd_c/imax,jmax,lmax,nid,dim_coord,iotd_ts
     19      common/iotd_ca/imax,jmax,lmax,nid,dim_coord,iotd_t0,iotd_ts
     20      common/iotd_cb/n_names_iotd_def,names_iotd_def
     21!$OMP THREADPRIVATE(/iotd_ca/)
     22!$OMP THREADPRIVATE(/iotd_cb/)

  • LMDZ6/branches/Ocean_skin/libf/phylmd/iotd_ecrit.F90

    r3102 r4013  
    6363     
    6464
     65
     66       if (n_names_iotd_def>0 .and..not.any(names_iotd_def==nom)) return
    6567!***************************************************************
    6668! Initialisation of 'firstnom' and create/open the "diagfi.nc" NetCDF file
    … …  
    7476
    7577
    76 ! Compute/write/extend 'Time' coordinate (date given in days)
     78! Compute/write/extend 'time' coordinate (date given in days)
    7779! (done every "first call" (at given time level) to writediagfi)
    7880! Note: date is incremented as 1 step ahead of physics time
    … …  
    8486        endif
    8587
    86 !      print*,'nom ',nom,firstnom
     88       !print*,'nom ',nom,firstnom
    8789
    8890!! Quand on tombe sur la premiere variable on ajoute un pas de temps
    … …  
    9395
    9496!!          print*,'ntime ',ntime
    95            date=ntime
     97           date=iotd_t0+ntime*iotd_ts
     98           !print*,'iotd_ecrit ',iotd_ts,ntime, date
    9699!          date= float (zitau +1)/float (day_step)
    97100
    98101           ! compute corresponding date (in days and fractions thereof)
    99            ! Get NetCDF ID of 'Time' variable
     102           ! Get NetCDF ID of 'time' variable
    100103
    101104           ierr=NF_SYNC(nid)
    102105
    103            ierr= NF_INQ_VARID(nid,"Time",varid)
    104            ! Write (append) the new date to the 'Time' array
     106           ierr= NF_INQ_VARID(nid,"time",varid)
     107           ! Write (append) the new date to the 'time' array
    105108
    106109
    … …  
    159162          ierr = NF_REDEF (nid)
    160163          ierr = NF_DEF_VAR(nid,nom,NF_FLOAT,ndim,dim_cc,varid)
    161           print*,'DEF ',nom,nid,varid
     164          !print*,'DEF ',nom,nid,varid
    162165          ierr = NF_ENDDEF(nid)
    163166      else
    164167         ierr= NF_INQ_VARID(nid,nom,varid)
    165           print*,'INQ ',nom,nid,varid
     168          !print*,'INQ ',nom,nid,varid
    166169! Commandes pour recuperer automatiquement les coordonnees
    167170!             ierr= NF_INQ_DIMID(nid,"longitude",id(1))

  • LMDZ6/branches/Ocean_skin/libf/phylmd/iotd_ini.F90

    r3102 r4013  
    1       SUBROUTINE iotd_ini(fichnom,iim,jjm,llm,prlonv,prlatu,pcoordv)
     1      SUBROUTINE iotd_ini(fichnom,iim,jjm,llm,prlon,prlat,pcoordv,jour0,mois0,an0,t0,timestep,calendrier)
    22      IMPLICIT NONE
    33
    … …  
    2323
    2424      integer iim,jjm,llm
    25       real prlonv(iim),prlatu(jjm),pcoordv(llm),timestep
     25      real prlon(iim),prlat(jjm),pcoordv(llm),timestep,t0
    2626      INTEGER id_FOCE
     27      INTEGER jour0,mois0,an0
     28      CHARACTER*(*) calendrier
    2729
    2830      integer corner(4),edges(4),ndim
    2931      real  px(1000)
    3032      character (len=10) :: nom
     33      real*4 rlon(iim),rlat(jjm),coordv(llm)
    3134
    3235!   Local:
    3336!   ------
    34       INTEGER ierr
     37      CHARACTER*3,DIMENSION(12) :: cmois=(/'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP','OCT','NOV','DEC'/)
     38      CHARACTER*10 date0
     39      CHARACTER*11 date0b
     40
     41      INTEGER :: ierr
    3542
    3643      integer :: nvarid
    3744      integer, dimension(2) :: id 
    38       integer :: varid
    3945
    40       character*10 fichnom
    41       real*4 rlonv(iim),rlatu(jjm),coordv(llm)
     46      character*(*) fichnom
    4247
    4348      real pi
    4449
    45       print*,'INIIO prlonv ',prlonv
     50      iotd_ts=timestep
     51      iotd_t0=t0
     52      print*,'iotd_ini, ',timestep,iotd_ts
    4653      imax=iim
    4754      jmax=jjm
    4855      lmax=llm
    49 
    50       rlonv=prlonv
    51       rlatu=prlatu
     56      ! Utile pour passer en real*4 pour les ecritures
     57      rlon=prlon
     58      rlat=prlat
    5259      coordv=pcoordv
    5360
    54 !-----------------------------------------------------------------------
     61
     62      !-----------------------------------------------------------------------
     63      ! Possibilité de spécifier une liste de variables à sortir
     64      ! dans iotd.def
     65      ! Si iotd.def existe et est non vide,
     66      ! seules les variables faisant à la fois l'objet d'un call iotd_ecrit
     67      ! et étant spécifiées dans iotd.def sont sorties.
     68      ! Sinon, toutes les variables faisant l'objet d'un call iotd_ecrit
     69      ! sont sorties
     70      !-----------------------------------------------------------------------
     71      n_names_iotd_def=0
     72      open(99,file='iotd.def',form='formatted',status='old',iostat=ierr)
     73         if ( ierr.eq.0 ) then
     74            ierr=0
     75            do while (ierr==0)
     76               read(99,*,iostat=ierr) un_nom
     77               if (ierr==0) then
     78                  n_names_iotd_def=n_names_iotd_def+1
     79                  names_iotd_def(n_names_iotd_def)=un_nom
     80               endif
     81            enddo
     82         endif
     83         print*,n_names_iotd_def,names_iotd_def(1:n_names_iotd_def)
     84      close(99)
    5585
    5686
    … …  
    5989! Define dimensions
    6090   
    61          ! Create the NetCDF file
    62          ierr=NF_CREATE(fichnom, NF_CLOBBER, nid)
    63          ! Define the 'Time' dimension
    64          ierr=nf_def_dim(nid,"Time",NF_UNLIMITED,dim_coord(4))
    65          ! Define the 'Time' variable
    66          ierr=NF_DEF_VAR(nid, "Time", NF_FLOAT, 1, dim_coord(4),varid)
    67 !        ! Add a long_name attribute
    68 !        ierr=NF_PUT_ATT_TEXT(nid, varid, "long_name",4,"Time")
    69 !        ! Add a units attribute
    70          ierr=NF_PUT_ATT_TEXT(nid, varid,'units',29,"days since 0000-00-0 00:00:00")
    71          ! Switch out of NetCDF Define mode
     91      ! Create the NetCDF file
     92      ierr=NF_CREATE(fichnom, NF_CLOBBER, nid)
     93      ierr=NF_DEF_DIM(nid, "lon", iim, dim_coord(1))
     94      ierr=NF_DEF_DIM(nid, "lat", jjm, dim_coord(2))
     95      ierr=NF_DEF_DIM(nid, "lev", llm, dim_coord(3))
     96      ierr=NF_DEF_DIM(nid,"time",NF_UNLIMITED,dim_coord(4))
     97      ierr = NF_PUT_ATT_TEXT(nid,NF_GLOBAL,'Conventions',6,"CF-1.1")
     98      !ierr = NF_PUT_ATT_TEXT(nid,NF_GLOBAL,'file_name',TRIM(fname))
     99      ierr=NF_ENDDEF(nid)
    72100
    73       ierr=NF_DEF_DIM(nid, "longitude", iim, dim_coord(1))
    74       ierr=NF_DEF_DIM(nid, "latitude", jjm, dim_coord(2))
    75       ierr=NF_DEF_DIM(nid, "altitude", llm, dim_coord(3))
     101      ! Switch out of NetCDF Define mode
    76102
    77103
    … …  
    79105!
    80106!  Contol parameters for this run
    81 ! --------------------------
     107! ---- longitude -----------
    82108
    83109      ierr=NF_REDEF(nid)
    84       ierr=NF_DEF_VAR(nid,"longitude", NF_FLOAT, 1, dim_coord(1),nvarid)
    85 !     ierr=NF_PUT_ATT_TEXT(nid,nvarid,"long_name", 14,
    86 !    .      "East longitude")
    87 !     ierr=NF_PUT_ATT_TEXT(nid,nvarid,'units',12,"degrees_east")
     110      ierr=NF_DEF_VAR(nid,"lon", NF_FLOAT, 1, dim_coord(1),nvarid)
     111      ierr = NF_PUT_ATT_TEXT(nid,nvarid,'axis',1,'X')
     112      ierr=NF_PUT_ATT_TEXT(nid,nvarid,'units',12,"degrees_east")
    88113      ierr=NF_ENDDEF(nid)
    89       ierr=NF_PUT_VAR_REAL(nid,nvarid,rlonv)
     114      ierr=NF_PUT_VAR_REAL(nid,nvarid,rlon)
    90115       print*,ierr
    91116
    92 ! --------------------------
     117! ---- latitude ------------
    93118      ierr=NF_REDEF(nid)
    94       ierr=NF_DEF_VAR(nid, "latitude", NF_FLOAT, 1, dim_coord(2),nvarid)
    95 !     ierr=NF_PUT_ATT_TEXT(nid,nvarid,'units',13,"degrees_north")
    96 !     ierr=NF_PUT_ATT_TEXT(nid,nvarid,"long_name", 14,"North latitude")
     119      ierr=NF_DEF_VAR(nid, "lat", NF_FLOAT, 1, dim_coord(2),nvarid)
     120      ierr = NF_PUT_ATT_TEXT(nid,nvarid,'axis',1,'Y')
     121      ierr=NF_PUT_ATT_TEXT(nid,nvarid,'units',13,"degrees_north")
    97122      ierr=NF_ENDDEF(nid)
    98       ierr=NF_PUT_VAR_REAL(nid,nvarid,rlatu)
     123      ierr=NF_PUT_VAR_REAL(nid,nvarid,rlat)
    99124!
    100 ! --------------------------
     125! ---- vertical ------------
    101126      ierr=NF_REDEF(nid)
    102       ierr=NF_DEF_VAR(nid, "altitude", NF_FLOAT, 1,dim_coord(3),nvarid)
    103       ierr=NF_PUT_ATT_TEXT(nid,nvarid,"long_name",10,"pseudo-alt")
    104 !     ierr=NF_PUT_ATT_TEXT(nid,nvarid,'units',2,"km")
    105       if ( pcoordv(2)>pcoordv(1) ) then
     127      ierr=NF_DEF_VAR(nid, "lev", NF_FLOAT, 1,dim_coord(3),nvarid)
     128      ierr=NF_PUT_ATT_TEXT(nid,nvarid,"long_name",10,"vert level")
     129      if ( coordv(2)>coordv(1) ) then
    106130         ierr=NF_PUT_ATT_TEXT(nid,nvarid,"long_name",10,"pseudo-alt")
    107131         ierr=NF_PUT_ATT_TEXT(nid,nvarid,'positive',2,"up")
    … …  
    111135      endif
    112136      ierr=NF_ENDDEF(nid)
     137      ierr=NF_PUT_VAR_REAL(nid,nvarid,coordv)
    113138
    114       ierr=NF_PUT_VAR_REAL(nid,nvarid,coordv)
    115139!
     140! ---- time ----------------
     141      ierr=NF_REDEF(nid)
     142      ! Define the 'time' variable
     143      ierr=NF_DEF_VAR(nid, "time", NF_FLOAT, 1, dim_coord(4),nvarid)
     144!     ! Add attributes
     145      ierr = NF_PUT_ATT_TEXT(nid,nvarid,'axis',1,'T')
     146      ierr = NF_PUT_ATT_TEXT(nid,nvarid,'standard_name',4,'time')
     147      WRITE(date0,'(i4.4,"-",i2.2,"-",i2.2)') an0,mois0,jour0
     148      ierr=NF_PUT_ATT_TEXT(nid, nvarid,'units',33, &
     149     & "seconds since "//date0//" 00:00:00")
     150      ierr = NF_PUT_ATT_TEXT(nid,nvarid,'calendar',9,calendrier)
     151      !ierr = NF_PUT_ATT_TEXT(nid,nvarid,'calendar',4,'360d')
     152      ierr = NF_PUT_ATT_TEXT(nid,nvarid,'title',4,'Time')
     153      ierr = NF_PUT_ATT_TEXT(nid,nvarid,'long_name',9,'Time axis')
     154      WRITE(date0b,'(i4.4,"-",a3,"-",i2.2)') an0,cmois(mois0),jour0
     155      ierr = NF_PUT_ATT_TEXT(nid,nvarid,'time_origin',20, &
     156     &        date0b//' 00:00:00')
     157      ierr=NF_ENDDEF(nid)
     158
     159
    116160      END

  • LMDZ6/branches/Ocean_skin/libf/phylmd/newmicro.F90

    r3281 r4013  
    11! $Id$
    22
    3 SUBROUTINE newmicro(flag_aerosol, ok_cdnc, bl95_b0, bl95_b1, paprs, pplay, t, pqlwp, pclc, &
     3SUBROUTINE newmicro(flag_aerosol, ok_cdnc, bl95_b0, bl95_b1, paprs, pplay, t, pqlwp, picefra, pclc, &
    44    pcltau, pclemi, pch, pcl, pcm, pct, pctlwp, xflwp, xfiwp, xflwc, xfiwc, &
    55    mass_solu_aero, mass_solu_aero_pi, pcldtaupi, re, fl, reliq, reice, &
    … …  
    99  USE phys_local_var_mod, ONLY: scdnc, cldncl, reffclwtop, lcc, reffclws, &
    1010      reffclwc, cldnvi, lcc3d, lcc3dcon, lcc3dstra, icc3dcon, icc3dstra,  &
    11       zfice, dNovrN
     11      zfice, dNovrN, ptconv
    1212  USE phys_state_var_mod, ONLY: rnebcon, clwcon
    1313  USE icefrac_lsc_mod ! computes ice fraction (JBM 3/14)
    1414  USE ioipsl_getin_p_mod, ONLY : getin_p
    1515  USE print_control_mod, ONLY: lunout
     16  USE lscp_tools_mod, only: icefrac_lscp
     17
    1618
    1719
    … …  
    3133  ! pqlwp---input-R-eau liquide nuageuse dans l'atmosphere dans la partie
    3234  ! nuageuse (kg/kg)
     35  ! picefra--input-R-fraction de glace dans les nuages
    3336  ! pclc----input-R-couverture nuageuse pour le rayonnement (0 a 1)
    3437  ! mass_solu_aero-----input-R-total mass concentration for all soluble
    … …  
    5861  include "radepsi.h"
    5962  include "radopt.h"
     63  include "clesphys.h"
    6064
    6165  ! choix de l'hypothese de recouvrement nuageuse via radopt.h (IM, 19.07.2016)
    … …  
    8185  REAL t(klon, klev)
    8286  REAL pclc(klon, klev)
    83   REAL pqlwp(klon, klev)
     87  REAL pqlwp(klon, klev), picefra(klon,klev)
    8488  REAL pcltau(klon, klev)
    8589  REAL pclemi(klon, klev)
    … …  
    148152  ! jq-end
    149153  ! IM cf. CR:parametres supplementaires
     154  REAL dzfice(klon,klev)
    150155  REAL zclear(klon)
    151156  REAL zcloud(klon)
    … …  
    229234  ELSE ! of IF (iflag_t_glace.EQ.0)
    230235    DO k = 1, klev
    231         CALL icefrac_lsc(klon,t(:,k),pplay(:,k)/paprs(:,1),zfice(:,k))
    232  
    233 
    234         ! JBM: icefrac_lsc is now contained icefrac_lsc_mod
     236
     237! JBM: icefrac_lsc is now contained icefrac_lsc_mod
    235238!       zfice(i, k) = icefrac_lsc(t(i,k), t_glace_min, &
    236239!                                 t_glace_max, exposant_glace)
    237       DO i = 1, klon
     240
     241      IF (ok_new_lscp) THEN
     242          CALL icefrac_lscp(klon,t(:,k),pplay(:,k)/paprs(:,1),zfice(:,k),dzfice(:,k))
     243      ELSE
     244          CALL icefrac_lsc(klon,t(:,k),pplay(:,k)/paprs(:,1),zfice(:,k))
     245      ENDIF
     246
     247      DO i = 1, klon
     248       
     249        IF ((.NOT. ptconv(i,k)) .AND. ok_new_lscp .AND. ok_icefra_lscp) THEN
     250        ! EV: take the ice fraction directly from the lscp code
     251        ! consistent only for non convective grid points
     252        ! critical for mixed phase clouds
     253            zfice(i,k)=picefra(i,k)
     254        ENDIF
     255
    238256        ! -layer calculation
    239257        rhodz(i, k) = (paprs(i,k)-paprs(i,k+1))/rg ! kg/m2

  • LMDZ6/branches/Ocean_skin/libf/phylmd/nuage.F90

    r2346 r4013  
    11! $Id$
    22
    3 SUBROUTINE nuage(paprs, pplay, t, pqlwp, pclc, pcltau, pclemi, pch, pcl, pcm, &
     3SUBROUTINE nuage(paprs, pplay, t, pqlwp,picefra, pclc, pcltau, pclemi, pch, pcl, pcm, &
    44    pct, pctlwp, ok_aie, mass_solu_aero, mass_solu_aero_pi, bl95_b0, bl95_b1, &
    55    cldtaupi, re, fl)
    66  USE dimphy
     7  USE lscp_tools_mod, only: icefrac_lscp
    78  USE icefrac_lsc_mod ! computes ice fraction (JBM 3/14)
     9  USE phys_local_var_mod, ONLY: ptconv
    810  IMPLICIT NONE
    911  ! ======================================================================
    … …  
    1416  ! t-------input-R-temperature
    1517  ! pqlwp---input-R-eau liquide nuageuse dans l'atmosphere (kg/kg)
     18  ! picefra--inout-R-fraction de glace dans les nuages (-)
    1619  ! pclc----input-R-couverture nuageuse pour le rayonnement (0 a 1)
    1720  ! ok_aie--input-L-apply aerosol indirect effect or not
    … …  
    3639  include "YOMCST.h"
    3740  include "nuage.h" ! JBM 3/14
     41  include "clesphys.h"
    3842
    3943  REAL paprs(klon, klev+1), pplay(klon, klev)
    … …  
    4145
    4246  REAL pclc(klon, klev)
    43   REAL pqlwp(klon, klev)
     47  REAL pqlwp(klon, klev), picefra(klon,klev)
    4448  REAL pcltau(klon, klev), pclemi(klon, klev)
    4549
    … …  
    8993
    9094  REAL cldtaupi(klon, klev) ! pre-industrial cloud opt thickness for diag
     95  REAl dzfice(klon)
    9196  ! jq-end
    9297
    … …  
    106111!       zfice(i) = icefrac_lsc(t(i,k), t_glace_min, &
    107112!                           t_glace_max, exposant_glace)
    108          CALL icefrac_lsc(klon,t(:,k),pplay(:,k)/paprs(:,1),zfice(:))
     113        IF (ok_new_lscp) THEN
     114            CALL icefrac_lscp(klon,t(:,k),pplay(:,k)/paprs(:,1),zfice(:),dzfice(:))
     115        ELSE
     116            CALL icefrac_lsc(klon,t(:,k),pplay(:,k)/paprs(:,1),zfice(:))
     117
     118        ENDIF
     119
     120        IF ((.NOT. ptconv(i,k)) .AND. ok_new_lscp .AND. ok_icefra_lscp) THEN
     121        ! EV: take the ice fraction directly from the lscp code
     122        ! consistent only for non convective grid points
     123        ! critical for mixed phase clouds
     124            DO i=1,klon
     125            zfice(i)=picefra(i,k)
     126            ENDDO
     127        ENDIF
     128
     129
    109130     ENDIF
    110131

  • LMDZ6/branches/Ocean_skin/libf/phylmd/nuage.h

    r2945 r4013  
    1111      INTEGER iflag_t_glace, iflag_cloudth_vert, iflag_cld_cv
    1212      INTEGER iflag_rain_incloud_vol
     13   
     14      INTEGER iflag_mpc_bl, iflag_gammasat, iflag_vice
     15      LOGICAL ok_icefra_lscp
    1316
    1417      common /nuagecom/ rad_froid,rad_chau1, rad_chau2,t_glace_max,     &
    … …  
    1720     &                  tmax_fonte_cv,                                  &
    1821     &                  iflag_t_glace,iflag_cloudth_vert,iflag_cld_cv,  &
    19      &                  iflag_rain_incloud_vol
     22     &                  iflag_rain_incloud_vol,                         &
     23     &                  ok_icefra_lscp,                                 &
     24     &                  iflag_mpc_bl, iflag_gammasat, iflag_vice   
    2025!$OMP THREADPRIVATE(/nuagecom/)

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

    r3798 r4013  
    180180!
    181181    USE dimphy
     182    USE geometry_mod, ONLY: longitude,latitude
    182183    USE calcul_fluxs_mod
    183184    USE surface_data,     ONLY : calice, calsno
    … …  
    260261    IF (soil_model) THEN
    261262! update tsoil and calculate soilcap and soilflux
    262        CALL soil(dtime, is_sic, knon, snow, tsurf_tmp, tsoil,soilcap, soilflux)
     263       CALL soil(dtime, is_sic, knon, snow, tsurf_tmp, qsol, &
     264        & longitude(knindex(1:knon)), latitude(knindex(1:knon)), tsoil,soilcap, soilflux)
    263265       cal(1:knon) = RCPD / soilcap(1:knon)
    264266       radsol(1:knon) = radsol(1:knon)  + soilflux(1:knon)

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

    r3798 r4013  
    2323  USE climb_wind_mod,      ONLY : climb_wind_down, climb_wind_up
    2424  USE coef_diff_turb_mod,  ONLY : coef_diff_turb
    25   USE wx_pbl_mod,          ONLY : wx_pbl_init, wx_pbl_final, &
    26 !!                                  wx_pbl_fuse_no_dts, wx_pbl_split_no_dts, &
    27 !!                                  wx_pbl_fuse, wx_pbl_split
    28                                   wx_pbl0_fuse, wx_pbl0_split
     25  USE ioipsl_getin_p_mod,  ONLY : getin_p
     26  USE cdrag_mod
     27  USE stdlevvar_mod
     28  USE wx_pbl_var_mod,      ONLY : wx_pbl_init, wx_pbl_final, &
     29                                  wx_pbl_prelim_0, wx_pbl_prelim_beta
     30  USE wx_pbl_mod,          ONLY : wx_pbl0_merge, wx_pbl_split, wx_pbl_dts_merge, &
     31                                  wx_pbl_check, wx_pbl_dts_check, wx_evappot
    2932  use config_ocean_skin_m, only: activate_ocean_skin
    3033
    … …  
    3437  REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE     :: fder   ! flux drift
    3538  !$OMP THREADPRIVATE(fder)
    36   REAL, ALLOCATABLE, DIMENSION(:,:), PUBLIC, SAVE   :: snow   ! snow at surface
     39  REAL, ALLOCATABLE, DIMENSION(:,:), PUBLIC, SAVE    :: snow   ! snow at surface
    3740  !$OMP THREADPRIVATE(snow)
    3841  REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE   :: qsurf  ! humidity at surface
    3942  !$OMP THREADPRIVATE(qsurf)
    40   REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: ftsoil ! soil temperature
     43  REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE          :: ftsoil ! soil temperature
    4144  !$OMP THREADPRIVATE(ftsoil)
     45  REAL, ALLOCATABLE, DIMENSION(:), SAVE              :: ydTs0, ydqs0 
     46                                                     ! nul forced temperature and humidity differences
     47  !$OMP THREADPRIVATE(ydTs0, ydqs0)
    4248
    4349  INTEGER, SAVE :: iflag_pbl_surface_t2m_bug
    4450  !$OMP THREADPRIVATE(iflag_pbl_surface_t2m_bug)
     51  INTEGER, SAVE :: iflag_new_t2mq2m
     52  !$OMP THREADPRIVATE(iflag_new_t2mq2m)
     53
    4554!FC
    4655!  integer, save :: iflag_frein
    … …  
    93102    IF (ierr /= 0) CALL abort_physic('pbl_surface_init', 'pb in allocation',1)
    94103
     104    ALLOCATE(ydTs0(klon), stat=ierr)
     105    IF (ierr /= 0) CALL abort_physic('pbl_surface_init', 'pb in allocation',1)
     106
     107    ALLOCATE(ydqs0(klon), stat=ierr)
     108    IF (ierr /= 0) CALL abort_physic('pbl_surface_init', 'pb in allocation',1)
     109
    95110    fder(:)       = fder_rst(:)
    96111    snow(:,:)     = snow_rst(:,:)
    97112    qsurf(:,:)    = qsurf_rst(:,:)
    98113    ftsoil(:,:,:) = ftsoil_rst(:,:,:)
     114    ydTs0(:) = 0.
     115    ydqs0(:) = 0.
    99116
    100117!****************************************************************************************
    … …  
    142159    iflag_pbl_surface_t2m_bug=0
    143160    CALL getin_p('iflag_pbl_surface_t2m_bug',iflag_pbl_surface_t2m_bug)
     161    WRITE(lunout,*) 'iflag_pbl_surface_t2m_bug=',iflag_pbl_surface_t2m_bug
    144162!FC
    145163!    iflag_frein = 0
    … …  
    164182       debut,     lafin,                              &
    165183       rlon,      rlat,      rugoro,   rmu0,          &
    166        zsig,      lwdown_m,  pphi,     cldt,          &
     184       lwdown_m,  cldt,          &
    167185       rain_f,    snow_f,    solsw_m,  solswfdiff_m, sollw_m,       &
    168186       gustiness,                                     &
    … …  
    176194       ts,SFRWL,   alb_dir, alb_dif,ustar, u10m, v10m,wstar, &
    177195       cdragh,    cdragm,   zu1,    zv1,              &
     196!jyg<   (26/09/2019)
     197       beta, &
     198!>jyg
    178199       alb_dir_m,    alb_dif_m,  zxsens,   zxevap,    &
    179200       alb3_lic,  runoff,    snowhgt,   qsnow,     to_ice,    sissnow,  &
    180        zxtsol,    zxfluxlat, zt2m,     qsat2m,       &
     201       zxtsol,    zxfluxlat, zt2m,     qsat2m, zn2mout, &
    181202       d_t,       d_q,       d_u,      d_v, d_t_diss, &
    182203!!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
    … …  
    199220       s_therm,   s_trmb1,   s_trmb2,  s_trmb3,       &
    200221       zustar,zu10m,  zv10m,    fder_print,    &
    201        zxqsurf,   rh2m,      zxfluxu,  zxfluxv,       &
     222       zxqsurf, delta_qsurf,                       &
     223       rh2m,      zxfluxu,  zxfluxv,               &
    202224       z0m, z0h,   agesno,  sollw,    solsw,         &
    203225       d_ts,      evap,    fluxlat,  t2m,           &
    … …  
    255277! z0m, z0h ----input-R- longeur de rugosite (en m)
    256278! Martin
    257 ! zsig-----input-R- slope
    258279! cldt-----input-R- total cloud fraction
    259 ! pphi-----input-R- geopotentiel de chaque couche (g z) (reference sol)
    260280! Martin
    261281!
    … …  
    293313    USE print_control_mod,  ONLY : prt_level,lunout
    294314    USE ioipsl_getin_p_mod, ONLY : getin_p
    295     use phys_state_var_mod, only: ds_ns, dt_ns, delta_sst, delta_sal
     315    use phys_state_var_mod, only: ds_ns, dt_ns, delta_sst, delta_sal, zsig, zmea
    296316    use phys_output_var_mod, only: dter, dser, tkt, tks, taur, sss
    297317#ifdef CPP_XIOS
    … …  
    300320    use netcdf, only: missing_val => nf90_fill_real
    301321#endif
     322
     323     
     324
    302325
    303326    IMPLICIT NONE
    … …  
    337360    REAL, DIMENSION(klon, nbsrf), INTENT(IN)        :: pctsrf  ! sub-surface fraction
    338361! Martin
    339     REAL, DIMENSION(klon),        INTENT(IN)        :: zsig    ! slope
    340362    REAL, DIMENSION(klon),        INTENT(IN)        :: lwdown_m ! downward longwave radiation at mean s   
    341363    REAL, DIMENSION(klon),        INTENT(IN)        :: gustiness ! gustiness
    342364
    343365    REAL, DIMENSION(klon),        INTENT(IN)        :: cldt    ! total cloud fraction
    344     REAL, DIMENSION(klon,klev),   INTENT(IN)        :: pphi    ! geopotential (m2/s2)
    345 ! Martin
    346366
    347367!!! nrlmd+jyg le 02/05/2011 et le 20/02/2012
    … …  
    359379! Input/Output variables
    360380!****************************************************************************************
     381!jyg<
     382    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: beta    ! Aridity factor
     383!>jyg
    361384    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: ts      ! temperature at surface (K)
    362385    REAL, DIMENSION(klon, nbsrf), INTENT(INOUT)     :: delta_tsurf !surface temperature difference between
    … …  
    404427    REAL, DIMENSION(klon),        INTENT(OUT)       :: zxfluxlat  ! latent flux, mean for each grid point
    405428    REAL, DIMENSION(klon),        INTENT(OUT)       :: zt2m       ! temperature at 2m, mean for each grid point
     429    INTEGER, DIMENSION(klon, 6),  INTENT(OUT)       :: zn2mout    ! number of times the 2m temperature is out of the [tsol,temp]
    406430    REAL, DIMENSION(klon),        INTENT(OUT)       :: qsat2m
    407431    REAL, DIMENSION(klon, klev),  INTENT(OUT)       :: d_t        ! change in temperature
    … …  
    460484    REAL, DIMENSION(klon),        INTENT(OUT)       :: fder_print ! fder for printing (=fder(i) + dflux_t(i) + dflux_q(i))
    461485    REAL, DIMENSION(klon),        INTENT(OUT)       :: zxqsurf    ! humidity at surface, mean for each grid point
     486    REAL, DIMENSION(klon),        INTENT(OUT)       :: delta_qsurf! humidity difference at surface, mean for each grid point
    462487    REAL, DIMENSION(klon),        INTENT(OUT)       :: rh2m       ! relative humidity at 2m
    463488    REAL, DIMENSION(klon, klev),  INTENT(OUT)       :: zxfluxu    ! u wind tension, mean for each grid point
    … …  
    494519
    495520! Martin
    496 ! sisvat
     521! inlandsis
    497522    REAL, DIMENSION(klon),       INTENT(OUT)        :: qsnow      ! snow water content
    498523    REAL, DIMENSION(klon),       INTENT(OUT)        :: snowhgt    ! snow height
    … …  
    521546    INTEGER                            :: n
    522547! << PC
    523     INTEGER                            :: iflag_split
     548    INTEGER                            :: iflag_split, iflag_split_ref
    524549    INTEGER                            :: i, k, nsrf
    525550    INTEGER                            :: knon, j
    … …  
    532557    REAL, DIMENSION(klon)              :: r_co2_ppm     ! taux CO2 atmosphere
    533558    REAL, DIMENSION(klon)              :: yts, yz0m, yz0h, ypct
     559    REAL, DIMENSION(klon)              :: yz0h_old
    534560!albedo SB >>>
    535561    REAL, DIMENSION(klon)              :: yalb,yalb_vis
    536562!albedo SB <<<
    537563    REAL, DIMENSION(klon)              :: yt1, yq1, yu1, yv1
     564    REAL, DIMENSION(klon)              :: yqa
    538565    REAL, DIMENSION(klon)              :: ysnow, yqsurf, yagesno, yqsol
    539566    REAL, DIMENSION(klon)              :: yrain_f, ysnow_f
    … …  
    547574    REAL, DIMENSION(klon)              :: y_flux_u1, y_flux_v1
    548575    REAL, DIMENSION(klon)              :: yt2m, yq2m, yu10m
     576    INTEGER, DIMENSION(klon, nbsrf, 6) :: yn2mout, yn2mout_x, yn2mout_w
     577    INTEGER, DIMENSION(klon, nbsrf, 6) :: n2mout, n2mout_x, n2mout_w
    549578    REAL, DIMENSION(klon)              :: yustar
    550579    REAL, DIMENSION(klon)              :: ywstar
    … …  
    567596    REAL, DIMENSION(klon)              :: yz0h_oupas
    568597    REAL, DIMENSION(klon)              :: yfluxsens
     598    REAL, DIMENSION(klon)              :: AcoefH_0, AcoefQ_0, BcoefH_0, BcoefQ_0
    569599    REAL, DIMENSION(klon)              :: AcoefH, AcoefQ, BcoefH, BcoefQ
    570600    REAL, DIMENSION(klon)              :: AcoefU, AcoefV, BcoefU, BcoefV
    571601    REAL, DIMENSION(klon)              :: ypsref
    572     REAL, DIMENSION(klon)              :: yevap, ytsurf_new, yalb3_new
     602    REAL, DIMENSION(klon)              :: yevap, yevap_pot, ytsurf_new, yalb3_new
    573603!albedo SB >>>
    574604    REAL, DIMENSION(klon,nsw)          :: yalb_dir_new, yalb_dif_new
    … …  
    582612    REAL, DIMENSION(klon,klev)         :: y_flux_u, y_flux_v
    583613    REAL, DIMENSION(klon,klev)         :: ycoefh, ycoefm,ycoefq
    584     REAL, DIMENSION(klon)              :: ycdragh, ycdragm
     614    REAL, DIMENSION(klon)              :: ycdragh, ycdragq, ycdragm
    585615    REAL, DIMENSION(klon,klev)         :: yu, yv
    586616    REAL, DIMENSION(klon,klev)         :: yt, yq
    … …  
    614644    REAL, DIMENSION(klon,klev)         :: ycoefh_x, ycoefm_x, ycoefh_w, ycoefm_w
    615645    REAL, DIMENSION(klon,klev)         :: ycoefq_x, ycoefq_w
    616     REAL, DIMENSION(klon)              :: ycdragh_x, ycdragm_x, ycdragh_w, ycdragm_w
     646    REAL, DIMENSION(klon)              :: ycdragh_x, ycdragh_w, ycdragq_x, ycdragq_w
     647    REAL, DIMENSION(klon)              :: ycdragm_x, ycdragm_w
    617648    REAL, DIMENSION(klon)              :: AcoefH_x, AcoefQ_x, BcoefH_x, BcoefQ_x
    618649    REAL, DIMENSION(klon)              :: AcoefH_w, AcoefQ_w, BcoefH_w, BcoefQ_w
    … …  
    634665    REAL, DIMENSION(klon, klev)        :: zxfluxu_x, zxfluxv_x, zxfluxu_w, zxfluxv_w
    635666    REAL                               :: zx_qs_surf, zcor_surf, zdelta_surf
    636     REAL, DIMENSION(klon)              :: ytsurf_th, yqsatsurf
     667!jyg<
    637668    REAL, DIMENSION(klon)              :: ybeta
     669    REAL, DIMENSION(klon)              :: ybeta_prev
     670!>jyg
    638671    REAL, DIMENSION(klon, klev)        :: d_u_x
    639672    REAL, DIMENSION(klon, klev)        :: d_u_w
    … …  
    770803!!! nrlmd le 13/06/2011
    771804    REAL, DIMENSION(klon)              :: y_delta_flux_t1, y_delta_flux_q1, y_delta_flux_u1, y_delta_flux_v1
    772     REAL, DIMENSION(klon)              :: y_delta_tsurf,delta_coef,tau_eq
     805    REAL, DIMENSION(klon)              :: y_delta_tsurf, y_delta_tsurf_new
     806    REAL, DIMENSION(klon)              :: delta_coef, tau_eq
     807    REAL, DIMENSION(klon)              :: HTphiT_b, dd_HTphiT, HTphiQ_b, dd_HTphiQ, HTRn_b, dd_HTRn
     808    REAL, DIMENSION(klon)              :: phiT0_b, dphiT0, phiQ0_b, dphiQ0, Rn0_b, dRn0
     809    REAL, DIMENSION(klon)              :: y_delta_qsurf
     810    REAL, DIMENSION(klon)              :: y_delta_qsats
     811    REAL, DIMENSION(klon)              :: yg_T, yg_Q
     812    REAL, DIMENSION(klon)              :: yGamma_dTs_phiT, yGamma_dQs_phiQ
     813    REAL, DIMENSION(klon)              :: ydTs_ins, ydqs_ins
     814!
    773815    REAL, PARAMETER                    :: facteur=2./sqrt(3.14)
    774816    REAL, PARAMETER                    :: inertia=2000.
    775     REAL, DIMENSION(klon)              :: ytsurf_th_x,ytsurf_th_w,yqsatsurf_x,yqsatsurf_w
    776817    REAL, DIMENSION(klon)              :: ydtsurf_th
    777818    REAL                               :: zdelta_surf_x,zdelta_surf_w,zx_qs_surf_x,zx_qs_surf_w
    … …  
    783824    REAL, DIMENSION(klon)              :: Kech_m
    784825    REAL, DIMENSION(klon)              :: Kech_m_x, Kech_m_w
    785     REAL, DIMENSION(klon)              :: yts_x,yts_w
     826    REAL, DIMENSION(klon)              :: yts_x, yts_w
     827    REAL, DIMENSION(klon)              :: yqsatsrf0_x, yqsatsrf0_w
     828    REAL, DIMENSION(klon)              :: yqsurf_x, yqsurf_w
    786829!jyg<
    787830!!    REAL, DIMENSION(klon)              :: Kech_Hp, Kech_H_xp, Kech_H_wp
    … …  
    790833!!    REAL, DIMENSION(klon)              :: Kech_Vp, Kech_V_xp, Kech_V_wp
    791834!>jyg
    792 !jyg<
    793     REAL, DIMENSION(klon)              :: ah, bh     ! coefficients of the delta_Tsurf equation
    794 !>jyg
     835
     836    REAL                               :: fact_cdrag
     837    REAL                               :: z1lay
    795838
    796839    REAL                               :: vent
    … …  
    826869    REAL, DIMENSION(klon)              :: ytoice
    827870    REAL, DIMENSION(klon)              :: ysnowhgt, yqsnow, ysissnow, yrunoff
     871    REAL, DIMENSION(klon)              :: yzmea
    828872    REAL, DIMENSION(klon)              :: yzsig
    829     REAL, DIMENSION(klon,klev)         :: ypphi
    830873    REAL, DIMENSION(klon)              :: ycldt
    831874    REAL, DIMENSION(klon)              :: yrmu0
    832875    ! Martin
    833876
    834     real, DIMENSION(klon):: ydelta_sst, ydelta_sal, yds_ns, ydt_ns, ydter, ydser, &
     877    REAL, DIMENSION(klon):: ydelta_sst, ydelta_sal, yds_ns, ydt_ns, ydter, ydser, &
    835878         ytkt, ytks, ytaur, ysss
    836879    ! compression of delta_sst, delta_sal, ds_ns, dt_ns, dter, dser, tkt, tks,
    … …  
    844887!
    845888!!jyg      iflag_split = mod(iflag_pbl_split,2)
    846       iflag_split = mod(iflag_pbl_split,10)
     889!!jyg      iflag_split = mod(iflag_pbl_split,10)
     890!
     891! Flags controlling the splitting of the turbulent boundary layer:
     892!   iflag_split_ref = 0  ==> no splitting
     893!                   = 1  ==> splitting without coupling with surface temperature
     894!                   = 2  ==> splitting with coupling with surface temperature over land
     895!                   = 3  ==> splitting over ocean; no splitting over land
     896!   iflag_split: actual flag controlling the splitting.
     897!   iflag_split = iflag_split_ref outside the sub-surface loop
     898!               = iflag_split_ref if iflag_split_ref = 0, 1, or 2
     899!               = 0 over land  if iflga_split_ref = 3
     900!               = 1 over ocean if iflga_split_ref = 3
     901
     902      iflag_split_ref = mod(iflag_pbl_split,10)
     903      iflag_split = iflag_split_ref
    847904
    848905!****************************************************************************************
    … …  
    853910
    854911    IF (first_call) THEN
     912
     913       iflag_new_t2mq2m=1
     914       CALL getin_p('iflag_new_t2mq2m',iflag_new_t2mq2m)
     915       WRITE(lunout,*) 'pbl_iflag_new_t2mq2m=',iflag_new_t2mq2m
     916
    855917       print*,'PBL SURFACE AVEC GUSTINESS'
    856918       first_call=.FALSE.
    857919     
    858920       ! Initialize ok_flux_surf (for 1D model)
    859        if (klon_glo>1) ok_flux_surf=.FALSE.
    860        if (klon_glo>1) ok_forc_tsurf=.FALSE.
     921       IF (klon_glo>1) ok_flux_surf=.FALSE.
     922       IF (klon_glo>1) ok_forc_tsurf=.FALSE.
    861923
    862924       ! intialize beta_land
    … …  
    919981 zxfluxlat(:)=0.
    920982 zt2m(:)=0. ; zq2m(:)=0. ; qsat2m(:)=0. ; rh2m(:)=0.
     983 zn2mout(:,:)=0 ;
    921984 d_t(:,:)=0. ; d_t_diss(:,:)=0. ; d_q(:,:)=0. ; d_u(:,:)=0. ; d_v(:,:)=0.
    922985 zcoefh(:,:,:)=0. ; zcoefm(:,:,:)=0.
    … …  
    934997 fder_print(:)=0.
    935998 zxqsurf(:)=0.
     999 delta_qsurf(:) = 0.
    9361000 zxfluxu(:,:)=0. ; zxfluxv(:,:)=0.
    9371001 solsw(:,:)=0. ; sollw(:,:)=0.
    … …  
    10001064    ysnowhgt = 0.0; yqsnow = 0.0     ; yrunoff = 0.0   ; ytoice =0.0
    10011065    yalb3_new = 0.0  ; ysissnow = 0.0
    1002     ypphi = 0.0   ; ycldt = 0.0      ; yrmu0 = 0.0
     1066    ycldt = 0.0      ; yrmu0 = 0.0
    10031067    ! Martin
    10041068
    … …  
    10161080    y_delta_flux_t1=0.
    10171081    ydtsurf_th=0.
    1018     yts_x=0.      ; yts_w=0.
    1019     y_delta_tsurf=0.
     1082    yts_x(:)=0.      ; yts_w(:)=0.
     1083    y_delta_tsurf(:)=0. ; y_delta_qsurf(:)=0.
     1084    yqsurf_x(:)=0.      ; yqsurf_w(:)=0.
     1085    yg_T(:) = 0. ;        yg_Q(:) = 0.
     1086    yGamma_dTs_phiT(:) = 0. ; yGamma_dQs_phiQ(:) = 0.
     1087    ydTs_ins(:) = 0. ; ydqs_ins(:) = 0.
     1088
    10201089!!!
    10211090    ytsoil = 999999.
    … …  
    11921261       DO i = 1, klon
    11931262          sollw(i,nsrf) = sollw_m(i) + 4.0*RSIGMA*ztsol(i)**3 * (ztsol(i)-ts(i,nsrf))
    1194 
    1195 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    1196 !         ! Martin
    1197 ! Apparently introduced for sisvat but not used
    1198 !         sollwd(i,nsrf)= sollwd_m(i)
    1199 !         ! Martin
    1200 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    1201 
    12021263!--OB this line is not satisfactory because alb is the direct albedo not total albedo
    12031264          solsw(i,nsrf) = solsw_m(i) * (1.-alb(i,nsrf)) / (1.-alb_m(i))
    … …  
    12481309!
    12491310!****************************************************************************************
    1250    
    1251     loop_nbsrf: DO nsrf = 1, nbsrf
     1311                                                                          !<<<<<<<<<<<<<
     1312    loop_nbsrf: DO nsrf = 1, nbsrf                                        !<<<<<<<<<<<<<
     1313                                                                          !<<<<<<<<<<<<<
    12521314       IF (prt_level >=10) print *,' Loop nsrf ',nsrf
     1315!
     1316       IF (iflag_split_ref == 3) THEN
     1317         IF (nsrf == is_oce) THEN
     1318            iflag_split = 1
     1319         ELSE
     1320            iflag_split=0
     1321         ENDIF   !! (nsrf == is_oce)
     1322       ELSE                     
     1323         iflag_split = iflag_split_ref
     1324       ENDIF   !! (iflag_split_ref == 3)
    12531325
    12541326! Search for index(ni) and size(knon) of domaine to treat
    … …  
    12861358!****************************************************************************************
    12871359
     1360!
     1361!jyg<    (20190926)
     1362!   Provisional : set ybeta to standard values
     1363       IF (nsrf .NE. is_ter) THEN
     1364           ybeta(:) = 1.
     1365       ELSE
     1366           IF (iflag_split .EQ. 0) THEN
     1367              ybeta(:) = 1.
     1368           ELSE
     1369             DO j = 1, knon
     1370                i = ni(j)
     1371                ybeta(j)   = beta(i,nsrf)
     1372             ENDDO
     1373           ENDIF  ! (iflag_split .LE.1)
     1374       ENDIF !  (nsrf .NE. is_ter)
     1375!>jyg
     1376!
    12881377       DO j = 1, knon
    12891378          i = ni(j)
    … …  
    13181407          ywindsp(j) = windsp(i,nsrf)
    13191408!>jyg
    1320           ! Martin
     1409          ! Martin and Etienne
     1410          yzmea(j)   = zmea(i)
    13211411          yzsig(j)   = zsig(i)
    13221412          ycldt(j)   = cldt(i)
    … …  
    14531543!
    14541544!****************************************************************************************
     1545
    14551546
    14561547!!! jyg le 07/02/2012
    … …  
    15031594           speed_x(i) = SQRT(yu_x(i,1)**2+yv_x(i,1)**2)
    15041595        ENDDO
    1505         CALL cdrag(knon, nsrf, &
     1596
     1597
     1598            CALL cdrag(knon, nsrf, &
    15061599            speed_x, yt_x(:,1), yq_x(:,1), zgeo1_x, ypaprs(:,1),&
    1507             yts_x, yqsurf, yz0m, yz0h, &
     1600            yts_x, yqsurf_x, yz0m, yz0h, &
    15081601            ycdragm_x, ycdragh_x, zri1_x, pref_x )
    15091602
    … …  
    15321625        CALL cdrag(knon, nsrf, &
    15331626            speed_w, yt_w(:,1), yq_w(:,1), zgeo1_w, ypaprs(:,1),&
    1534             yts_w, yqsurf, yz0m, yz0h, &
     1627            yts_w, yqsurf_w, yz0m, yz0h, &
    15351628            ycdragm_w, ycdragh_w, zri1_w, pref_w )
    15361629!
    … …  
    16051698       ENDIF
    16061699        CALL coef_diff_turb(dtime, nsrf, knon, ni,  &
    1607             ypaprs, ypplay, yu_x, yv_x, yq_x, yt_x, yts_x, yqsurf, ycdragm_x, &
     1700            ypaprs, ypplay, yu_x, yv_x, yq_x, yt_x, yts_x, yqsurf_x, ycdragm_x, &
    16081701            ycoefm_x, ycoefh_x, ytke_x,y_treedrg)
    16091702!            ycoefm_x, ycoefh_x, ytke_x)
    … …  
    16331726       ENDIF
    16341727        CALL coef_diff_turb(dtime, nsrf, knon, ni,  &
    1635             ypaprs, ypplay, yu_w, yv_w, yq_w, yt_w, yts_w, yqsurf, ycdragm_w, &
     1728            ypaprs, ypplay, yu_w, yv_w, yq_w, yt_w, yts_w, yqsurf_w, ycdragm_w, &
    16361729            ycoefm_w, ycoefh_w, ytke_w,y_treedrg)
    16371730!            ycoefm_w, ycoefh_w, ytke_w)
    … …  
    17701863         yt1(:) = yt(:,1)
    17711864         yq1(:) = yq(:,1)
    1772 !!       ELSE IF (iflag_split .eq. 1) THEN
    1773 !!!
    1774 !jyg<
    1775 !!         CALL wx_pbl_fuse_no_dts(knon, dtime, ypplay, ywake_s, &
    1776 !!                                 yt_x, yt_w, yq_x, yq_w, &
    1777 !!                                 yu_x, yu_w, yv_x, yv_w, &
    1778 !!                                 ycdragh_x, ycdragh_w, ycdragm_x, ycdragm_w, &
    1779 !!                                 AcoefH_x, AcoefH_w, AcoefQ_x, AcoefQ_w, &
    1780 !!                                 AcoefU_x, AcoefU_w, AcoefV_x, AcoefV_w, &
    1781 !!                                 BcoefH_x, BcoefH_w, BcoefQ_x, BcoefQ_w, &
    1782 !!                                 BcoefU_x, BcoefU_w, BcoefV_x, BcoefV_w, &
    1783 !!                                 AcoefH, AcoefQ, AcoefU, AcoefV, &
    1784 !!                                 BcoefH, BcoefQ, BcoefU, BcoefV, &
    1785 !!                                 ycdragh, ycdragm, &
    1786 !!                                 yt1, yq1, yu1, yv1 &
    1787 !!                                 )
    17881865       ELSE IF (iflag_split .ge. 1) THEN
    1789          CALL wx_pbl0_fuse(knon, dtime, ypplay, ywake_s, &
     1866!
     1867! Cdragq computation
     1868! ------------------
     1869    !******************************************************************************
     1870    ! Cdragq computed from cdrag
     1871    ! The difference comes only from a factor (f_z0qh_oce) on z0, so that
     1872    ! it can be computed inside wx_pbl0_merge
     1873    ! More complicated appraches may require the propagation through
     1874    ! pbl_surface of an independant cdragq variable.
     1875    !******************************************************************************
     1876!
     1877    IF ( f_z0qh_oce .ne. 1. .and. nsrf .eq.is_oce) THEN
     1878       ! Si on suit les formulations par exemple de Tessel, on
     1879       ! a z0h=0.4*nu/u*, z0q=0.62*nu/u*, d'ou f_z0qh_oce=0.62/0.4=1.55
     1880!!       ycdragq_x(1:knon)=ycdragh_x(1:knon)*                                      &
     1881!!            log(z1lay(1:knon)/yz0h(1:knon))/log(z1lay(1:knon)/(f_z0qh_oce*yz0h(1:knon)))
     1882!!       ycdragq_w(1:knon)=ycdragh_w(1:knon)*                                      &
     1883!!            log(z1lay(1:knon)/yz0h(1:knon))/log(z1lay(1:knon)/(f_z0qh_oce*yz0h(1:knon)))
     1884!
     1885       DO j = 1,knon
     1886         z1lay = zgeo1(j)/RG
     1887         fact_cdrag = log(z1lay/yz0h(j))/log(z1lay/(f_z0qh_oce*yz0h(j)))
     1888         ycdragq_x(j)=ycdragh_x(j)*fact_cdrag
     1889         ycdragq_w(j)=ycdragh_w(j)*fact_cdrag
     1890!!     Print *,'YYYYpbl0: fact_cdrag ', fact_cdrag
     1891       ENDDO  ! j = 1,knon
     1892!
     1893!!  Print *,'YYYYpbl0: z1lay, yz0h, f_z0qh_oce, ycdragh_w, ycdragq_w ', &
     1894!!                z1lay, yz0h(1:knon), f_z0qh_oce, ycdragh_w(1:knon), ycdragq_w(1:knon)
     1895    ELSE
     1896       ycdragq_x(1:knon)=ycdragh_x(1:knon)
     1897       ycdragq_w(1:knon)=ycdragh_w(1:knon)
     1898    ENDIF  ! ( f_z0qh_oce .ne. 1. .and. nsrf .eq.is_oce)
     1899!
     1900         CALL wx_pbl_prelim_0(knon, nsrf, dtime, ypplay, ypaprs, ywake_s,  &
     1901                         yts, y_delta_tsurf, ygustiness, &
    17901902                         yt_x, yt_w, yq_x, yq_w, &
    17911903                         yu_x, yu_w, yv_x, yv_w, &
    1792                          ycdragh_x, ycdragh_w, ycdragm_x, ycdragm_w, &
     1904                         ycdragh_x, ycdragh_w, ycdragq_x, ycdragq_w, &
     1905                         ycdragm_x, ycdragm_w, &
    17931906                         AcoefH_x, AcoefH_w, AcoefQ_x, AcoefQ_w, &
    17941907                         AcoefU_x, AcoefU_w, AcoefV_x, AcoefV_w, &
    17951908                         BcoefH_x, BcoefH_w, BcoefQ_x, BcoefQ_w, &
    17961909                         BcoefU_x, BcoefU_w, BcoefV_x, BcoefV_w, &
    1797                          AcoefH, AcoefQ, AcoefU, AcoefV, &
    1798                          BcoefH, BcoefQ, BcoefU, BcoefV, &
    1799                          ycdragh, ycdragm, &
     1910                         Kech_h_x, Kech_h_w, Kech_h  &
     1911                         )
     1912         CALL wx_pbl_prelim_beta(knon, dtime, ywake_s, ybeta,  &
     1913                         BcoefQ_x, BcoefQ_w  &
     1914                         )
     1915         CALL wx_pbl0_merge(knon, ypplay, ypaprs,  &
     1916                         ywake_s, ydTs0, ydqs0, &
     1917                         yt_x, yt_w, yq_x, yq_w, &
     1918                         yu_x, yu_w, yv_x, yv_w, &
     1919                         ycdragh_x, ycdragh_w, ycdragq_x, ycdragq_w, &
     1920                         ycdragm_x, ycdragm_w, &
     1921                         AcoefH_x, AcoefH_w, AcoefQ_x, AcoefQ_w, &
     1922                         AcoefU_x, AcoefU_w, AcoefV_x, AcoefV_w, &
     1923                         BcoefH_x, BcoefH_w, BcoefQ_x, BcoefQ_w, &
     1924                         BcoefU_x, BcoefU_w, BcoefV_x, BcoefV_w, &
     1925                         AcoefH_0, AcoefQ_0, AcoefU, AcoefV, &
     1926                         BcoefH_0, BcoefQ_0, BcoefU, BcoefV, &
     1927                         ycdragh, ycdragq, ycdragm, &
    18001928                         yt1, yq1, yu1, yv1 &
    18011929                         )
    1802 !!       ELSE IF (iflag_split .ge.2) THEN
    1803 !!!    Provisoire
    1804 !!         ah(:) = 0.
    1805 !!         bh(:) = 0.
    1806 !!         IF (nsrf == is_oce) THEN
    1807 !!           ybeta(:) = 1.
    1808 !!         ELSE
    1809 !!           ybeta(:) = beta_land
    1810 !!         ENDIF
    1811 !!         ycdragh(:) = ywake_s(:)*ycdragh_w(:) + (1.-ywake_s(:))*ycdragh_x(:)
    1812 !!         CALL wx_dts(knon, nsrf, ywake_cstar, ywake_s, ywake_dens, &
    1813 !!                     yts, ypplay(:,1), ybeta, ycdragh , ypaprs(:,1), &
    1814 !!                     yq(:,1), yt(:,1), yu(:,1), yv(:,1), ygustiness, &
    1815 !!                     ah, bh &
    1816 !!                     )
    1817 !!!
    1818 !!         CALL wx_pbl_fuse(knon, dtime, ypplay, ywake_s, &
    1819 !!                         yt_x, yt_w, yq_x, yq_w, &
    1820 !!                         yu_x, yu_w, yv_x, yv_w, &
    1821 !!                         ycdragh_x, ycdragh_w, ycdragm_x, ycdragm_w, &
    1822 !!                         AcoefH_x, AcoefH_w, AcoefQ_x, AcoefQ_w, &
    1823 !!                         AcoefU_x, AcoefU_w, AcoefV_x, AcoefV_w, &
    1824 !!                         BcoefH_x, BcoefH_w, BcoefQ_x, BcoefQ_w, &
    1825 !!                         BcoefU_x, BcoefU_w, BcoefV_x, BcoefV_w, &
    1826 !!                         ah, bh, &
    1827 !!                         AcoefH, AcoefQ, AcoefU, AcoefV, &
    1828 !!                         BcoefH, BcoefQ, BcoefU, BcoefV, &
    1829 !!                         ycdragh, ycdragm, &
    1830 !!                         yt1, yq1, yu1, yv1 &
    1831 !!                         )
    1832 !>jyg
    1833 !!!
    1834          ENDIF  ! (iflag_split .eq.0)
     1930         IF (iflag_split .eq. 2 .AND. nsrf .ne. is_oce) THEN
     1931           CALL wx_pbl_dts_merge(knon, dtime, ypplay, ypaprs, &
     1932                           ywake_s, ybeta, ywake_cstar, ywake_dens, &
     1933                           AcoefH_x, AcoefH_w, &
     1934                           BcoefH_x, BcoefH_w, &
     1935                           AcoefH_0, AcoefQ_0, BcoefH_0, BcoefQ_0,  &
     1936                           AcoefH, AcoefQ, BcoefH, BcoefQ,  &
     1937                           HTphiT_b, dd_HTphiT, HTphiQ_b, dd_HTphiQ, HTRn_b, dd_HTRn, &
     1938                           phiT0_b, dphiT0, phiQ0_b, dphiQ0, Rn0_b, dRn0, &
     1939                           yg_T, yg_Q, &
     1940                           yGamma_dTs_phiT, yGamma_dQs_phiQ, &
     1941                           ydTs_ins, ydqs_ins &
     1942                           )
     1943         ELSE !
     1944           AcoefH(:) = AcoefH_0(:)
     1945           AcoefQ(:) = AcoefQ_0(:)
     1946           BcoefH(:) = BcoefH_0(:)
     1947           BcoefQ(:) = BcoefQ_0(:)
     1948           yg_T(:) = 0.
     1949           yg_Q(:) = 0.
     1950           yGamma_dTs_phiT(:) = 0.
     1951           yGamma_dQs_phiQ(:) = 0.
     1952           ydTs_ins(:) = 0.
     1953           ydqs_ins(:) = 0.
     1954         ENDIF   ! (iflag_split .eq. 2)
     1955       ENDIF  ! (iflag_split .eq.0)
    18351956!!!
    18361957       IF (prt_level >=10) THEN
    1837          PRINT *,'pbl_surface (fuse->): yt(1,:) ',yt(1,:)
    1838          PRINT *,'pbl_surface (fuse->): yq(1,:) ',yq(1,:)
    1839          PRINT *,'pbl_surface (fuse->): yu(1,:) ',yu(1,:)
    1840          PRINT *,'pbl_surface (fuse->): yv(1,:) ',yv(1,:)
    1841          PRINT *,'pbl_surface (fuse->): AcoefH(1) ',AcoefH(1)
    1842          PRINT *,'pbl_surface (fuse->): BcoefH(1) ',BcoefH(1)
     1958         PRINT *,'pbl_surface (merge->): yt(1,:) ',yt(1,:)
     1959         PRINT *,'pbl_surface (merge->): yq(1,:) ',yq(1,:)
     1960         PRINT *,'pbl_surface (merge->): yu(1,:) ',yu(1,:)
     1961         PRINT *,'pbl_surface (merge->): yv(1,:) ',yv(1,:)
     1962         PRINT *,'pbl_surface (merge->): AcoefH(1), AcoefQ(1), AcoefU(1), AcoefV(1) ', &
     1963                                         AcoefH(1), AcoefQ(1), AcoefU(1), AcoefV(1)
     1964         PRINT *,'pbl_surface (merge->): BcoefH(1), BcoefQ(1), BcoefU(1), BcoefV(1) ', &
     1965                                         BcoefH(1), BcoefQ(1), BcoefU(1), BcoefV(1)
     1966
    18431967       ENDIF
    18441968
     1969!  Save initial value of z0h for use in evappot (z0h wiil be computed again in the surface models)
     1970          yz0h_old(1:knon) = yz0h(1:knon)
     1971!
    18451972!****************************************************************************************
    18461973!
    … …  
    18571984
    18581985          ! Calculate the temperature et relative humidity at 2m and the wind at 10m
     1986          IF (iflag_new_t2mq2m==1) THEN
     1987           CALL stdlevvarn(klon, knon, is_ter, zxli, &
     1988               yu(:,1), yv(:,1), yt(:,1), yq(:,1), zgeo1, &
     1989               yts, yqsurf, yz0m, yz0h, ypaprs(:,1), ypplay(:,1), &
     1990               yt2m, yq2m, yt10m, yq10m, yu10m, yustar, &
     1991               yn2mout(:, nsrf, :))
     1992          ELSE
    18591993          CALL stdlevvar(klon, knon, is_ter, zxli, &
    18601994               yu(:,1), yv(:,1), yt(:,1), yq(:,1), zgeo1, &
    18611995               yts, yqsurf, yz0m, yz0h, ypaprs(:,1), ypplay(:,1), &
    18621996               yt2m, yq2m, yt10m, yq10m, yu10m, yustar)
     1997          ENDIF
    18631998         
    18641999       ENDIF
    … …  
    19232058          CALL surf_landice(itap, dtime, knon, ni, &
    19242059               rlon, rlat, debut, lafin, &
    1925                yrmu0, ylwdown, yalb, ypphi(:,1), &
     2060               yrmu0, ylwdown, yalb, zgeo1, &
    19262061               ysolsw, ysollw, yts, ypplay(:,1), &
    19272062!!jyg               ycdragh, ycdragm, yrain_f, ysnow_f, yt(:,1), yq(:,1),&
    … …  
    19332068               ytsoil, yz0m, yz0h, SFRWL, yalb_dir_new, yalb_dif_new, yevap,yfluxsens,yfluxlat, &
    19342069               ytsurf_new, y_dflux_t, y_dflux_q, &
    1935                yzsig, ycldt, &
     2070               yzmea, yzsig, ycldt, &
    19362071               ysnowhgt, yqsnow, ytoice, ysissnow, &
    19372072               yalb3_new, yrunoff, &
    … …  
    20932228          y_flux_q1(j) = -yevap(j)
    20942229          ENDDO
    2095         ENDIF
    2096 
    2097        IF (prt_level >=10) THEN
    2098         DO j=1,knon
    2099          print*,'y_flux_t1,yfluxlat,wakes' &
    2100  &             ,  y_flux_t1(j), yfluxlat(j), ywake_s(j)
    2101          print*,'beta,ytsurf_new', ybeta(j), ytsurf_new(j)
    2102          print*,'inertia,facteur,cstar', inertia, facteur,wake_cstar(j)
    2103         ENDDO
    2104        ENDIF
    2105 
    2106 !!! jyg le 07/02/2012 puis le 10/04/2013
    2107 !!       IF (iflag_split .eq.1) THEN
    2108 !!!!!
    2109 !!!jyg<
    2110 !!         CALL wx_pbl_split_no_dts(knon, ywake_s, &
    2111 !!                                AcoefH_x, AcoefH_w, &
    2112 !!                                AcoefQ_x, AcoefQ_w, &
    2113 !!                                AcoefU_x, AcoefU_w, &
    2114 !!                                AcoefV_x, AcoefV_w, &
    2115 !!                                y_flux_t1, y_flux_q1, y_flux_u1, y_flux_v1, &
    2116 !!                                y_flux_t1_x, y_flux_t1_w, &
    2117 !!                                y_flux_q1_x, y_flux_q1_w, &
    2118 !!                                y_flux_u1_x, y_flux_u1_w, &
    2119 !!                                y_flux_v1_x, y_flux_v1_w, &
    2120 !!                                yfluxlat_x, yfluxlat_w &
    2121 !!                                )
    2122 !!       ELSE IF (iflag_split .ge. 2) THEN
     2230        ENDIF ! (ok_flux_surf)
     2231!
     2232! ------------------------------------------------------------------------------
     2233! 12a)  Splitting
     2234! ------------------------------------------------------------------------------
     2235
    21232236       IF (iflag_split .GE. 1) THEN
    2124          CALL wx_pbl0_split(knon, dtime, ywake_s, &
     2237!
     2238         IF (nsrf .ne. is_oce) THEN
     2239!
     2240!         Compute potential evaporation and aridity factor  (jyg, 20200328)
     2241          ybeta_prev(:) = ybeta(:)
     2242             DO j = 1, knon
     2243               yqa(j) = AcoefQ(j) - BcoefQ(j)*yevap(j)*dtime
     2244             ENDDO
     2245!
     2246          CALL wx_evappot(knon, yqa, yTsurf_new, yevap_pot)
     2247!
     2248          ybeta(1:knon) = min(yevap(1:knon)/yevap_pot(1:knon), 1.)
     2249         
     2250          IF (prt_level >=10) THEN
     2251           DO j=1,knon
     2252            print*,'y_flux_t1,yfluxlat,wakes' &
     2253 &                ,  y_flux_t1(j), yfluxlat(j), ywake_s(j)
     2254            print*,'beta_prev, beta, ytsurf_new', ybeta_prev(j), ybeta(j), ytsurf_new(j)
     2255            print*,'inertia,facteur,cstar', inertia, facteur,wake_cstar(j)
     2256           ENDDO
     2257          ENDIF  ! (prt_level >=10)
     2258!
     2259! Second call to wx_pbl0_merge and wx_pbl_dts_merge in order to take into account
     2260! the update of the aridity coeficient beta.
     2261!
     2262        CALL wx_pbl_prelim_beta(knon, dtime, ywake_s, ybeta,  &
     2263                        BcoefQ_x, BcoefQ_w  &
     2264                        )
     2265        CALL wx_pbl0_merge(knon, ypplay, ypaprs,  &
     2266                          ywake_s, ydTs0, ydqs0, &
     2267                          yt_x, yt_w, yq_x, yq_w, &
     2268                          yu_x, yu_w, yv_x, yv_w, &
     2269                          ycdragh_x, ycdragh_w, ycdragq_x, ycdragq_w, &
     2270                          ycdragm_x, ycdragm_w, &
     2271                          AcoefH_x, AcoefH_w, AcoefQ_x, AcoefQ_w, &
     2272                          AcoefU_x, AcoefU_w, AcoefV_x, AcoefV_w, &
     2273                          BcoefH_x, BcoefH_w, BcoefQ_x, BcoefQ_w, &
     2274                          BcoefU_x, BcoefU_w, BcoefV_x, BcoefV_w, &
     2275                          AcoefH_0, AcoefQ_0, AcoefU, AcoefV, &
     2276                          BcoefH_0, BcoefQ_0, BcoefU, BcoefV, &
     2277                          ycdragh, ycdragq, ycdragm, &
     2278                          yt1, yq1, yu1, yv1 &
     2279                          )
     2280          IF (iflag_split .eq. 2) THEN
     2281            CALL wx_pbl_dts_merge(knon, dtime, ypplay, ypaprs, &
     2282                            ywake_s, ybeta, ywake_cstar, ywake_dens, &
     2283                            AcoefH_x, AcoefH_w, &
     2284                            BcoefH_x, BcoefH_w, &
     2285                            AcoefH_0, AcoefQ_0, BcoefH_0, BcoefQ_0,  &
     2286                            AcoefH, AcoefQ, BcoefH, BcoefQ,  &
     2287                            HTphiT_b, dd_HTphiT, HTphiQ_b, dd_HTphiQ, HTRn_b, dd_HTRn, &
     2288                            phiT0_b, dphiT0, phiQ0_b, dphiQ0, Rn0_b, dRn0, &
     2289                            yg_T, yg_Q, &
     2290                            yGamma_dTs_phiT, yGamma_dQs_phiQ, &
     2291                            ydTs_ins, ydqs_ins &
     2292                            )
     2293          ELSE !
     2294            AcoefH(:) = AcoefH_0(:)
     2295            AcoefQ(:) = AcoefQ_0(:)
     2296            BcoefH(:) = BcoefH_0(:)
     2297            BcoefQ(:) = BcoefQ_0(:)
     2298            yg_T(:) = 0.
     2299            yg_Q(:) = 0.
     2300            yGamma_dTs_phiT(:) = 0.
     2301            yGamma_dQs_phiQ(:) = 0.
     2302            ydTs_ins(:) = 0.
     2303            ydqs_ins(:) = 0.
     2304          ENDIF   ! (iflag_split .eq. 2)
     2305!
     2306        ELSE    ! (nsrf .ne. is_oce)
     2307          ybeta(1:knon) = 1.
     2308          yevap_pot(1:knon) = yevap(1:knon)
     2309          AcoefH(:) = AcoefH_0(:)
     2310          AcoefQ(:) = AcoefQ_0(:)
     2311          BcoefH(:) = BcoefH_0(:)
     2312          BcoefQ(:) = BcoefQ_0(:)
     2313          yg_T(:) = 0.
     2314          yg_Q(:) = 0.
     2315          yGamma_dTs_phiT(:) = 0.
     2316          yGamma_dQs_phiQ(:) = 0.
     2317          ydTs_ins(:) = 0.
     2318          ydqs_ins(:) = 0.
     2319        ENDIF   ! (nsrf .ne. is_oce)
     2320!
     2321        CALL wx_pbl_split(knon, nsrf, dtime, ywake_s, ybeta, iflag_split, &
     2322                       yg_T, yg_Q, &
     2323                       yGamma_dTs_phiT, yGamma_dQs_phiQ, &
     2324                       ydTs_ins, ydqs_ins, &
    21252325                       y_flux_t1, y_flux_q1, y_flux_u1, y_flux_v1, &
     2326!!!!                       HTRn_b, dd_HTRn, HTphiT_b, dd_HTphiT, &
     2327                       phiQ0_b, phiT0_b, &
    21262328                       y_flux_t1_x, y_flux_t1_w, &
    21272329                       y_flux_q1_x, y_flux_q1_w, &
    … …  
    21292331                       y_flux_v1_x, y_flux_v1_w, &
    21302332                       yfluxlat_x, yfluxlat_w, &
    2131                        y_delta_tsurf &
     2333                       y_delta_qsats, &
     2334                       y_delta_tsurf_new, y_delta_qsurf &
    21322335                       )
     2336!
     2337         CALL wx_pbl_check(knon, dtime, ypplay, ypaprs, ywake_s, ybeta, iflag_split, &
     2338                       yTs, y_delta_tsurf,  &
     2339                       yqsurf, yTsurf_new,  &
     2340                       y_delta_tsurf_new, y_delta_qsats,  &
     2341                       AcoefH_x, AcoefH_w, &
     2342                       BcoefH_x, BcoefH_w, &
     2343                       AcoefH_0, AcoefQ_0, BcoefH_0, BcoefQ_0,  &
     2344                       AcoefH, AcoefQ, BcoefH, BcoefQ,  &
     2345                       y_flux_t1, y_flux_q1,  &
     2346                       y_flux_t1_x, y_flux_t1_w, &
     2347                       y_flux_q1_x, y_flux_q1_w)
     2348!
     2349         IF (nsrf .ne. is_oce) THEN
     2350           CALL wx_pbl_dts_check(knon, dtime, ypplay, ypaprs, ywake_s, ybeta, iflag_split, &
     2351                         yTs, y_delta_tsurf,  &
     2352                         yqsurf, yTsurf_new,  &
     2353                         y_delta_qsats, y_delta_tsurf_new, y_delta_qsurf,  &
     2354                         AcoefH_x, AcoefH_w, &
     2355                         BcoefH_x, BcoefH_w, &
     2356                         AcoefH_0, AcoefQ_0, BcoefH_0, BcoefQ_0,  &
     2357                         AcoefH, AcoefQ, BcoefH, BcoefQ,  &
     2358                         HTphiT_b, dd_HTphiT, HTphiQ_b, dd_HTphiQ, HTRn_b, dd_HTRn, &
     2359                         phiT0_b, dphiT0, phiQ0_b, dphiQ0, Rn0_b, dRn0, &
     2360                         yg_T, yg_Q, &
     2361                         yGamma_dTs_phiT, yGamma_dQs_phiQ, &
     2362                         ydTs_ins, ydqs_ins, &
     2363                         y_flux_t1, y_flux_q1,  &
     2364                         y_flux_t1_x, y_flux_t1_w, &
     2365                         y_flux_q1_x, y_flux_q1_w )
     2366         ENDIF   ! (nsrf .ne. is_oce)
     2367!
     2368       ELSE  ! (iflag_split .ge. 1)
     2369         ybeta(1:knon) = 1.
     2370         yevap_pot(1:knon) = yevap(1:knon)
    21332371       ENDIF  ! (iflag_split .ge. 1)
     2372!
     2373       IF (prt_level >= 10) THEN
     2374         print *,'pbl_surface, ybeta , yevap, yevap_pot ', &
     2375                               ybeta , yevap, yevap_pot
     2376       ENDIF  ! (prt_level >= 10)
     2377!
    21342378!>jyg
    21352379!
    … …  
    21802424         print*,'Chx,Chw,Ch', ycdragh_x(j), ycdragh_w(j), ycdragh(j)
    21812425         print*,'Khx,Khw,Kh', Kech_h_x(j), Kech_h_w(j), Kech_h(j)
    2182 !         print*,'tsurf_x,tsurf_w,tsurf,t1', ytsurf_th_x(j), ytsurf_th_w(j), ytsurf_th(j), yt(j,1)
    2183          print*,'tsurf_x,t1x,tsurf_w,t1w,tsurf,t1,t1_ancien', &
    2184  &               ytsurf_th_x(j), yt_x(j,1), ytsurf_th_w(j), yt_w(j,1), ytsurf_th(j), yt(j,1),t(j,1)
    2185          print*,'qsatsurf,qsatsurf_x,qsatsurf_w', yqsatsurf(j), yqsatsurf_x(j), yqsatsurf_w(j)
     2426         print*,'t1x, t1w, t1, t1_ancien', &
     2427 &               yt_x(j,1), yt_w(j,1),  yt(j,1), t(j,1)
    21862428         print*,'delta_coef,delta_flux,delta_tsurf,tau', delta_coef(j), y_delta_flux_t1(j), y_delta_tsurf(j), tau_eq(j)
    21872429        ENDDO
    … …  
    21902432         print*,'fluxT_x, fluxT_w, y_flux_t1, fluxQ_x, fluxQ_w, yfluxlat, wakes' &
    21912433 &             , y_flux_t1_x(j), y_flux_t1_w(j), y_flux_t1(j), y_flux_q1_x(j)*RLVTT, y_flux_q1_w(j)*RLVTT, yfluxlat(j), ywake_s(j)
    2192          print*,'beta,ytsurf_new,yqsatsurf', ybeta(j), ytsurf_new(j), yqsatsurf(j)
    2193          print*,'inertia,facteur,cstar', inertia, facteur,wake_cstar(j)
     2434         print*,'beta, ytsurf_new ', ybeta(j), ytsurf_new(j)
     2435         print*,'inertia, facteur, cstar', inertia, facteur,wake_cstar(j)
    21942436        ENDDO
    21952437       ENDIF  ! (prt_level >=10)
    … …  
    22942536       ENDIF  ! (iflag_split .eq.0)
    22952537!!!
    2296 
    2297         DO j = 1, knon
    2298           y_dflux_t(j) = y_dflux_t(j) * ypct(j)
    2299           y_dflux_q(j) = y_dflux_q(j) * ypct(j)
    2300         ENDDO
    2301 
     2538!!
     2539!!        DO j = 1, knon
     2540!!          y_dflux_t(j) = y_dflux_t(j) * ypct(j)
     2541!!          y_dflux_q(j) = y_dflux_q(j) * ypct(j)
     2542!!        ENDDO
     2543!!
    23022544!****************************************************************************************
    23032545! 13) Transform variables for output format :
    … …  
    24142656          i = ni(j)
    24152657          evap(i,nsrf) = - flux_q(i,1,nsrf)                  !jyg
     2658          beta(i,nsrf) = ybeta(j)                             !jyg
    24162659          d_ts(i,nsrf) = y_d_ts(j)
    24172660!albedo SB >>>
    … …  
    24292672          cdragh(i) = cdragh(i) + ycdragh(j)*ypct(j)
    24302673          cdragm(i) = cdragm(i) + ycdragm(j)*ypct(j)
    2431           dflux_t(i) = dflux_t(i) + y_dflux_t(j)
    2432           dflux_q(i) = dflux_q(i) + y_dflux_q(j)
     2674          dflux_t(i) = dflux_t(i) + y_dflux_t(j)*ypct(j)
     2675          dflux_q(i) = dflux_q(i) + y_dflux_q(j)*ypct(j)
    24332676       ENDDO
    24342677
    … …  
    24462689!!! nrlmd le 13/06/2011
    24472690!!jyg20170131          delta_tsurf(i,nsrf)=y_delta_tsurf(j)*ypct(j)
    2448           delta_tsurf(i,nsrf)=y_delta_tsurf(j)
     2691!!jyg20210118          delta_tsurf(i,nsrf)=y_delta_tsurf(j)
     2692          delta_tsurf(i,nsrf)=y_delta_tsurf_new(j)
     2693!
     2694          delta_qsurf(i) = delta_qsurf(i) + y_delta_qsurf(j)*ypct(j)
    24492695!
    24502696          cdragh_x(i) = cdragh_x(i) + ycdragh_x(j)*ypct(j)
    … …  
    26102856          sss(ni(:knon)) = ysss(:knon)
    26112857       end if
     2858
    26122859
    26132860!****************************************************************************************
    … …  
    26472894               * (ypaprs(j,1)-ypplay(j,1))
    26482895          tairsol(j) = yts(j) + y_d_ts(j)
    2649           tairsol_x(j) = tairsol(j) - ywake_s(j)*y_delta_tsurf(j)
     2896!!          tairsol_x(j) = tairsol(j) - ywake_s(j)*y_delta_tsurf(j)
     2897          tairsol_x(j) = tairsol(j) - ywake_s(j)*y_delta_tsurf_new(j)
    26502898          qairsol(j) = yqsurf(j)
    26512899        ENDDO
    … …  
    26862934!!! jyg le 07/02/2012
    26872935       IF (iflag_split .eq.0) THEN
     2936        IF (iflag_new_t2mq2m==1) THEN
     2937         CALL stdlevvarn(klon, knon, nsrf, zxli, &
     2938            uzon, vmer, tair1, qair1, zgeo1, &
     2939            tairsol, qairsol, yz0m, yz0h_oupas, psfce, patm, &
     2940            yt2m, yq2m, yt10m, yq10m, yu10m, yustar, &
     2941            yn2mout(:, nsrf, :))
     2942        ELSE
    26882943        CALL stdlevvar(klon, knon, nsrf, zxli, &
    26892944            uzon, vmer, tair1, qair1, zgeo1, &
    26902945            tairsol, qairsol, yz0m, yz0h_oupas, psfce, patm, &
    26912946            yt2m, yq2m, yt10m, yq10m, yu10m, yustar)
     2947        ENDIF
    26922948       ELSE  !(iflag_split .eq.0)
     2949        IF (iflag_new_t2mq2m==1) THEN
     2950         CALL stdlevvarn(klon, knon, nsrf, zxli, &
     2951            uzon_x, vmer_x, tair1_x, qair1_x, zgeo1_x, &
     2952            tairsol_x, qairsol, yz0m, yz0h_oupas, psfce, patm, &
     2953            yt2m_x, yq2m_x, yt10m_x, yq10m_x, yu10m_x, yustar_x, &
     2954            yn2mout_x(:, nsrf, :))
     2955         CALL stdlevvarn(klon, knon, nsrf, zxli, &
     2956            uzon_w, vmer_w, tair1_w, qair1_w, zgeo1_w, &
     2957            tairsol_w, qairsol, yz0m, yz0h_oupas, psfce, patm, &
     2958            yt2m_w, yq2m_w, yt10m_w, yq10m_w, yu10m_w, yustar_w, &
     2959            yn2mout_w(:, nsrf, :))
     2960        ELSE
    26932961        CALL stdlevvar(klon, knon, nsrf, zxli, &
    26942962            uzon_x, vmer_x, tair1_x, qair1_x, zgeo1_x, &
    … …  
    26992967            tairsol_w, qairsol, yz0m, yz0h_oupas, psfce, patm, &
    27002968            yt2m_w, yq2m_w, yt10m_w, yq10m_w, yu10m_w, yustar_w)
     2969        ENDIF
    27012970!!!
    27022971       ENDIF  ! (iflag_split .eq.0)
    … …  
    27122981          u10m(i,nsrf)=(yu10m(j) * uzon(j))/SQRT(uzon(j)**2+vmer(j)**2)
    27132982          v10m(i,nsrf)=(yu10m(j) * vmer(j))/SQRT(uzon(j)**2+vmer(j)**2)
     2983!
     2984          DO k = 1, 6
     2985           n2mout(i,nsrf,k) = yn2mout(j,nsrf,k)
     2986          END DO 
     2987!
    27142988        ENDDO
    27152989       ELSE  !(iflag_split .eq.0)
    … …  
    27222996          u10m_x(i,nsrf)=(yu10m_x(j) * uzon_x(j))/SQRT(uzon_x(j)**2+vmer_x(j)**2)
    27232997          v10m_x(i,nsrf)=(yu10m_x(j) * vmer_x(j))/SQRT(uzon_x(j)**2+vmer_x(j)**2)
     2998!
     2999          DO k = 1, 6
     3000           n2mout_x(i,nsrf,k) = yn2mout_x(j,nsrf,k)
     3001          END DO 
     3002!
    27243003        ENDDO
    27253004        DO j=1, knon
    … …  
    27353014          u10m(i,nsrf) = u10m_x(i,nsrf) + wake_s(i)*(u10m_w(i,nsrf)-u10m_x(i,nsrf))
    27363015          v10m(i,nsrf) = v10m_x(i,nsrf) + wake_s(i)*(v10m_w(i,nsrf)-v10m_x(i,nsrf))
     3016!
     3017          DO k = 1, 6
     3018           n2mout_w(i,nsrf,k) = yn2mout_w(j,nsrf,k)
     3019          END DO 
     3020!
    27373021        ENDDO
    27383022!!!
    … …  
    29173201!****************************************************************************************
    29183202    ENDDO loop_nbsrf
     3203!
     3204!----------------------------------------------------------------------------------------
     3205!   Reset iflag_split
     3206!
     3207   iflag_split=iflag_split_ref
    29193208
    29203209!****************************************************************************************
    … …  
    29863275    ENDDO
    29873276!!!
    2988    
     3277
    29893278!
    29903279! Incrementer la temperature du sol
    29913280!
    29923281    zxtsol(:) = 0.0  ; zxfluxlat(:) = 0.0
    2993     zt2m(:) = 0.0    ; zq2m(:) = 0.0
     3282    zt2m(:) = 0.0    ; zq2m(:) = 0.0 ; zn2mout(:,:) = 0
    29943283    zustar(:)=0.0 ; zu10m(:) = 0.0   ; zv10m(:) = 0.0
    29953284    s_pblh(:) = 0.0  ; s_plcl(:) = 0.0
    … …  
    30443333          zt2m(i)  = zt2m(i)  + t2m(i,nsrf)  * pctsrf(i,nsrf)
    30453334          zq2m(i)  = zq2m(i)  + q2m(i,nsrf)  * pctsrf(i,nsrf)
     3335!
     3336          DO k = 1, 6
     3337           zn2mout(i,k)  = zn2mout(i,k)  + n2mout(i,nsrf,k)  * pctsrf(i,nsrf)
     3338          ENDDO 
     3339!
    30463340          zustar(i) = zustar(i) + ustar(i,nsrf) * pctsrf(i,nsrf)
    30473341          wstar(i,is_ave)=wstar(i,is_ave)+wstar(i,nsrf)*pctsrf(i,nsrf)
    … …  
    30753369          zt2m(i)  = zt2m(i)  + (t2m_x(i,nsrf)+wake_s(i)*(t2m_w(i,nsrf)-t2m_x(i,nsrf))) * pctsrf(i,nsrf)
    30763370          zq2m(i)  = zq2m(i)  + q2m_x(i,nsrf)  * pctsrf(i,nsrf)
     3371!
     3372          DO k = 1, 6
     3373           zn2mout(i,k)  = zn2mout(i,k)  + n2mout_x(i,nsrf,k)  * pctsrf(i,nsrf)
     3374          ENDDO
     3375!
    30773376          zustar(i) = zustar(i) + ustar_x(i,nsrf) * pctsrf(i,nsrf)
    30783377          wstar(i,is_ave)=wstar(i,is_ave)+wstar_x(i,nsrf)*pctsrf(i,nsrf)
    … …  
    31533452    DO nsrf = 1, nbsrf
    31543453       DO i = 1, klon
    3155           zxqsurf(i) = zxqsurf(i) + qsurf(i,nsrf) * pctsrf(i,nsrf)
     3454          zxqsurf(i) = zxqsurf(i) + MAX(qsurf(i,nsrf),0.0) * pctsrf(i,nsrf)
    31563455          zxsnow(i)  = zxsnow(i)  + snow(i,nsrf)  * pctsrf(i,nsrf)
    31573456       ENDDO
    … …  
    31983497    IF (ALLOCATED(qsurf)) DEALLOCATE(qsurf)
    31993498    IF (ALLOCATED(ftsoil)) DEALLOCATE(ftsoil)
     3499    IF (ALLOCATED(ydTs0)) DEALLOCATE(ydTs0)
     3500    IF (ALLOCATED(ydqs0)) DEALLOCATE(ydqs0)
    32003501
    32013502!jyg<

  • LMDZ6/branches/Ocean_skin/libf/phylmd/phyetat0.F90

    r3798 r4013  
    1616       rnebcon, rugoro, sig1, snow_fall, solaire_etat0, sollw, sollwdown, &
    1717       solsw, solswfdiff, t_ancien, u_ancien, v_ancien, w01, wake_cstar, wake_deltaq, &
    18        wake_deltat, wake_delta_pbl_TKE, delta_tsurf, wake_fip, wake_pe, &
    19        wake_s, wake_dens, zgam, zmax0, zmea, zpic, zsig, &
     18       wake_deltat, wake_delta_pbl_TKE, delta_tsurf, beta_aridity, wake_fip, wake_pe, &
     19       wake_s, wake_dens, awake_dens, cv_gen, zgam, zmax0, zmea, zpic, zsig, &
    2020       zstd, zthe, zval, ale_bl, ale_bl_trig, alp_bl, u10m, v10m, treedrg, &
    21        ale_wake, ale_bl_stat, ds_ns, dt_ns, delta_sst, delta_sal
     21       ale_wake, ale_bl_stat, ds_ns, dt_ns, delta_sst, delta_sal, ratqs_inter
    2222!FC
    2323  USE geometry_mod, ONLY : longitude_deg, latitude_deg
    … …  
    396396  IF (iflag_pbl>1 .AND. iflag_wake>=1  .AND. iflag_pbl_split >=1 ) then
    397397    found=phyetat0_srf(klev+1,wake_delta_pbl_tke,"DELTATKE","Del TKE wk/env",0.)
    398     found=phyetat0_srf(1,delta_tsurf,"DELTA_TSURF","Delta Ts wk/env ",0.)
     398!!    found=phyetat0_srf(1,delta_tsurf,"DELTA_TSURF","Delta Ts wk/env ",0.)
     399    found=phyetat0_srf(1,delta_tsurf,"DELTATS","Delta Ts wk/env ",0.)
     400!!    found=phyetat0_srf(1,beta_aridity,"BETA_S","Aridity factor ",1.)
     401    found=phyetat0_srf(1,beta_aridity,"BETAS","Aridity factor ",1.)
    399402  ENDIF   !(iflag_pbl>1 .AND. iflag_wake>=1 .AND. iflag_pbl_split >=1 )
    400403
    … …  
    416419!!  found=phyetat0_get(1,wake_dens,"WAKE_DENS","Wake num. /unit area",0.)
    417420  found=phyetat0_get(1,wake_dens,"WAKE_DENS","Wake num. /unit area",-1000.)
     421  found=phyetat0_get(1,awake_dens,"AWAKE_DENS","Active Wake num. /unit area",0.)
     422  found=phyetat0_get(1,cv_gen,"CV_GEN","CB birth rate",0.)
    418423!>jyg
    419424  found=phyetat0_get(1,wake_cstar,"WAKE_CSTAR","WAKE_CSTAR",0.)
    … …  
    434439  found=phyetat0_get(1,ale_wake,"ALE_WAKE","ALE_WAKE",0.)
    435440  found=phyetat0_get(1,ale_bl_stat,"ALE_BL_STAT","ALE_BL_STAT",0.)
     441
     442! fisrtilp/Clouds 0.002 could be ratqsbas. But can stay like this as well
     443  found=phyetat0_get(klev,ratqs_inter,"RATQS_INTER","Relative width of the lsc sugrid scale water",0.002)
    436444
    437445!===========================================
    … …  
    449457  ENDIF
    450458
    451 !--OB now this is for co2i
    452   IF (type_trac == 'co2i') THEN
     459  IF (type_trac == 'co2i' .OR. type_trac == 'inco') THEN
    453460     IF (carbon_cycle_cpl) THEN
    454461        ALLOCATE(co2_send(klon), stat=ierr)

  • LMDZ6/branches/Ocean_skin/libf/phylmd/phyredem.F90

    r3798 r4013  
    1212  USE fonte_neige_mod,  ONLY : fonte_neige_final
    1313  USE pbl_surface_mod,  ONLY : pbl_surface_final
    14   USE phys_state_var_mod, ONLY: radpas, zmasq, pctsrf, ftsol, falb_dir,      &
     14  USE phys_state_var_mod, ONLY: radpas, zmasq, pctsrf,                       &
     15                                ftsol, beta_aridity, delta_tsurf, falb_dir,  &
    1516                                falb_dif, qsol, fevap, radsol, solsw, sollw, &
    1617                                sollwdown, rain_fall, snow_fall, z0m, z0h,   &
    … …  
    2223                                wake_delta_pbl_tke, zmax0, f0, sig1, w01,    &
    2324                                wake_deltat, wake_deltaq, wake_s, wake_dens, &
     25                                awake_dens, cv_gen,                          &
    2426                                wake_cstar,                                  &
    2527                                wake_pe, wake_fip, fm_therm, entr_therm,     &
    … …  
    2830                                du_gwd_rando, du_gwd_front, u10m, v10m, &
    2931                                treedrg, solswfdiff, delta_sal, ds_ns, dt_ns, &
    30                                 delta_sst
     32                                delta_sst, ratqs_inter
    3133
    3234  USE geometry_mod, ONLY : longitude_deg, latitude_deg
    … …  
    157159    END IF
    158160
     161!    Surface variables
    159162    CALL put_field_srf1(pass,"TS","Temperature",ftsol(:,:))
     163
     164!!    CALL put_field_srf1(pass,"DELTA_TS","w-x surface temperature difference", delta_tsurf(:,:))
     165    CALL put_field_srf1(pass,"DELTATS","w-x surface temperature difference", delta_tsurf(:,:))
     166
     167!    CALL put_field_srf1(pass,"BETA_S","Aridity factor", beta_aridity(:,:))
     168    CALL put_field_srf1(pass,"BETAS","Aridity factor", beta_aridity(:,:))
     169!    End surface variables
    160170
    161171! ================== Albedo =======================================
    … …  
    280290    CALL put_field(pass,"WAKE_DENS", "Wake num. /unit area", wake_dens)
    281291
     292    CALL put_field(pass,"AWAKE_DENS", "Active Wake num. /unit area", awake_dens)
     293
     294    CALL put_field(pass,"CV_GEN", "CB birth rate", cv_gen)
     295
    282296    CALL put_field(pass,"WAKE_CSTAR", "WAKE_CSTAR", wake_cstar)
    283297
    … …  
    303317
    304318    CALL put_field(pass,"ALE_BL_STAT", "ALE_BL_STAT", ale_bl_stat)
     319
     320
     321    ! fisrtilp/clouds
     322    CALL put_field(pass,"RATQS_INTER","Relative width of the lsc sugrid scale water",ratqs_inter)
    305323
    306324
    … …  
    313331          CALL put_field(pass,"trs_"//tname(iiq), "", trs(:, it))
    314332       END DO
     333    END IF
     334
     335    IF (type_trac == 'co2i' .OR. type_trac == 'inco') THEN
    315336       IF (carbon_cycle_cpl) THEN
    316337          IF (.NOT. ALLOCATED(co2_send)) THEN

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

    r3798 r4013  
    1616      REAL, SAVE, ALLOCATABLE :: u_seri(:,:), v_seri(:,:)
    1717      !$OMP THREADPRIVATE(u_seri, v_seri)
    18       REAL, SAVE, ALLOCATABLE :: l_mixmin(:,:,:), l_mix(:,:,:), tke_dissip(:,:,:)
    19       !$OMP THREADPRIVATE(l_mixmin, l_mix, tke_dissip)
     18      REAL, SAVE, ALLOCATABLE :: l_mixmin(:,:,:),l_mix(:,:,:),tke_dissip(:,:,:),wprime(:,:,:)
     19      !$OMP THREADPRIVATE(l_mixmin, l_mix, tke_dissip,wprime)
    2020      REAL, SAVE, ALLOCATABLE :: tr_seri(:,:,:)
    2121      !$OMP THREADPRIVATE(tr_seri)
    … …  
    340340      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zxfluxlat_x, zxfluxlat_w
    341341!$OMP THREADPRIVATE(zxfluxlat_x, zxfluxlat_w)
     342      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: delta_qsurf
     343!$OMP THREADPRIVATE(delta_qsurf)
    342344!jyg<
    343345!!! Entrees supplementaires couche-limite
    … …  
    378380      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: t2m_min_mon, t2m_max_mon
    379381!$OMP THREADPRIVATE(t2m_min_mon, t2m_max_mon)
    380       REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zq2m_cor, zt2m_cor
    381 !$OMP THREADPRIVATE(zq2m_cor, zt2m_cor)
    382       REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zu10m_cor, zv10m_cor
    383 !$OMP THREADPRIVATE(zu10m_cor, zv10m_cor)
    384       REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: zrh2m_cor, zqsat2m_cor
    385 !$OMP THREADPRIVATE(zrh2m_cor, zqsat2m_cor)
    386382      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: weak_inversion
    387383!$OMP THREADPRIVATE(weak_inversion)
    … …  
    394390      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: proba_notrig, random_notrig
    395391!$OMP THREADPRIVATE(proba_notrig, random_notrig)
    396       REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: cv_gen
    397 !$OMP THREADPRIVATE(cv_gen)
    398392      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: fsolsw, wfbils, wfbilo
    399393!$OMP THREADPRIVATE(fsolsw, wfbils, wfbilo)
    … …  
    440434      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: cldemi, cldfra, cldtau, fiwc, fl, re, flwc
    441435!$OMP THREADPRIVATE(cldemi, cldfra, cldtau, fiwc, fl, re, flwc)
     436      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: qlth, qith
     437!$OMP THREADPRIVATE(qlth, qith)
    442438      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: ref_liq, ref_ice, theta, zphi
    443439!$OMP THREADPRIVATE(ref_liq, ref_ice, theta, zphi)
    … …  
    473469      REAL, ALLOCATABLE, SAVE, DIMENSION(:) :: p_tropopause, z_tropopause, t_tropopause
    474470!$OMP THREADPRIVATE(p_tropopause, z_tropopause, t_tropopause)
     471
     472      INTEGER,ALLOCATABLE,SAVE,DIMENSION(:,:) :: zn2mout
     473!$OMP THREADPRIVATE(zn2mout)
    475474
    476475#ifdef CPP_StratAer
    … …  
    560559      ALLOCATE(t_seri(klon,klev),q_seri(klon,klev),ql_seri(klon,klev),qs_seri(klon,klev))
    561560      ALLOCATE(u_seri(klon,klev),v_seri(klon,klev))
    562       ALLOCATE(l_mixmin(klon,klev+1,nbsrf), l_mix(klon,klev+1,nbsrf), tke_dissip(klon,klev+1,nbsrf))
    563       l_mix(:,:,:)=0. ; l_mixmin(:,:,:)=0. ; tke_dissip(:,:,:)=0. ! doit etre initialse car pas toujours remplis
     561      ALLOCATE(l_mixmin(klon,klev+1,nbsrf),l_mix(klon,klev+1,nbsrf),tke_dissip(klon,klev+1,nbsrf),wprime(klon,klev+1,nbsrf))
     562      l_mix(:,:,:)=0.;l_mixmin(:,:,:)=0.;tke_dissip(:,:,:)=0.;wprime(:,:,:)=0. ! doit etre initialse car pas toujours remplis
    564563
    565564      ALLOCATE(tr_seri(klon,klev,nbtr))
    … …  
    733732      ALLOCATE(rain_lsc(klon))
    734733      ALLOCATE(rain_num(klon))
    735 !
     734      ALLOCATE(qlth(klon,klev), qith(klon,klev))
     735      !
    736736      ALLOCATE(sens_x(klon), sens_w(klon))
    737737      ALLOCATE(zxfluxlat_x(klon), zxfluxlat_w(klon))
     738      ALLOCATE(delta_qsurf(klon))
    738739!jyg<
    739740!!      ALLOCATE(t_x(klon,klev), t_w(klon,klev))
    … …  
    757758      ALLOCATE(zt2m_min_mon(klon), zt2m_max_mon(klon))
    758759      ALLOCATE(t2m_min_mon(klon), t2m_max_mon(klon))
    759       ALLOCATE(zq2m_cor(klon), zt2m_cor(klon), zu10m_cor(klon), zv10m_cor(klon))
    760       ALLOCATE(zrh2m_cor(klon), zqsat2m_cor(klon))
    761760      ALLOCATE(sens(klon), flwp(klon), fiwp(klon))
    762761      ALLOCATE(alp_bl_conv(klon), alp_bl_det(klon))
    … …  
    767766      alp_bl_stat(:)=0
    768767      ALLOCATE(proba_notrig(klon), random_notrig(klon))
    769       ALLOCATE(cv_gen(klon))
    770768
    771769      ALLOCATE(dnwd0(klon, klev))
    … …  
    828826      ALLOCATE (z_tropopause(klon))
    829827      ALLOCATE (t_tropopause(klon))
     828
     829      ALLOCATE(zn2mout(klon,6))
    830830
    831831#ifdef CPP_StratAer
    … …  
    878878      DEALLOCATE(t_seri,q_seri,ql_seri,qs_seri)
    879879      DEALLOCATE(u_seri,v_seri)
    880       DEALLOCATE(l_mixmin,l_mix, tke_dissip)
     880      DEALLOCATE(l_mixmin,l_mix, tke_dissip,wprime)
    881881
    882882      DEALLOCATE(tr_seri)
    … …  
    10321032      DEALLOCATE(rain_lsc)
    10331033      DEALLOCATE(rain_num)
     1034      DEALLOCATE(qlth, qith)
    10341035!
    10351036      DEALLOCATE(sens_x, sens_w)
    10361037      DEALLOCATE(zxfluxlat_x, zxfluxlat_w)
     1038      DEALLOCATE(delta_qsurf)
    10371039!jyg<
    10381040!!      DEALLOCATE(t_x, t_w)
    … …  
    10541056      DEALLOCATE(zt2m_min_mon, zt2m_max_mon)
    10551057      DEALLOCATE(t2m_min_mon, t2m_max_mon)
    1056       DEALLOCATE(zq2m_cor, zt2m_cor, zu10m_cor, zv10m_cor)
    1057       DEALLOCATE(zrh2m_cor, zqsat2m_cor)
    10581058      DEALLOCATE(sens, flwp, fiwp)
    10591059      DEALLOCATE(alp_bl_conv,alp_bl_det)
    … …  
    10611061      DEALLOCATE(alp_bl_stat, n2, s2)
    10621062      DEALLOCATE(proba_notrig, random_notrig)
    1063       DEALLOCATE(cv_gen)
    10641063
    10651064      DEALLOCATE(dnwd0)
    … …  
    11161115      DEALLOCATE (z_tropopause)
    11171116      DEALLOCATE (t_tropopause)
     1117      DEALLOCATE(zn2mout)
    11181118
    11191119#ifdef CPP_StratAer

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

    r3798 r4013  
    272272    't2m_sic', "Temp 2m "//clnsurf(4), "K", (/ ('', i=1, 10) /)) /)
    273273
     274  TYPE(ctrl_out), SAVE :: o_nt2mout = ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/), &
     275    'nt2mout', 'Nbt2m out of range complete computation', '-', (/ ('', i=1, 10) /))
     276  TYPE(ctrl_out), SAVE :: o_nq2mout = ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/), &
     277    'nq2mout', 'Nbq2m out of range complete computation', '-', (/ ('', i=1, 10) /))
     278  TYPE(ctrl_out), SAVE :: o_nu2mout = ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/), &
     279    'nu2mout', 'Nbu2m out of range complete computation', '-', (/ ('', i=1, 10) /))
     280
     281  TYPE(ctrl_out), SAVE :: o_nt2moutfg = ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/), &
     282    'nt2moutfg', 'Nbt2m out of range complete/fgRi1 computation', '-', (/ ('', i=1, 10) /))
     283  TYPE(ctrl_out), SAVE :: o_nq2moutfg = ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/), &
     284    'nq2moutfg', 'Nbq2m out of range complete/fgRi1 computation', '-', (/ ('', i=1, 10) /))
     285  TYPE(ctrl_out), SAVE :: o_nu2moutfg = ctrl_out((/ 1, 1, 1, 5, 10, 10, 11, 11, 11, 11/), &
     286    'nu2moutfg', 'Nbu2m out of range complete/fgRi1 computation', '-', (/ ('', i=1, 10) /))
     287
    274288  TYPE(ctrl_out), SAVE :: o_gusts = ctrl_out((/ 1, 1, 1, 10, 10, 10, 11, 11, 11, 11/), &
    275289    'gusts', 'surface gustiness', 'm2/s2', (/ ('', i=1, 10) /))
    … …  
    347361  TYPE(ctrl_out), SAVE :: o_qsol = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
    348362    'qsol', 'Soil watter content', 'mm', (/ ('', i=1, 10) /))
    349   TYPE(ctrl_out), SAVE :: o_tsoil_deep_land &
    350        = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
    351        'tsoil_deep_land', 'temperature of land deep soil', 'K', &
    352        (/ ('', i=1, 10) /))
    353363  TYPE(ctrl_out), SAVE :: o_ndayrain = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
    354364    'ndayrain', 'Number of dayrain(liq+sol)', '-', &
    … …  
    572582  TYPE(ctrl_out), SAVE, DIMENSION(4) :: o_evappot_srf  = (/ &
    573583      ctrl_out((/ 1, 6, 10, 10, 10, 10, 11, 11, 11, 11/),'evappot_ter',    &
    574       "Temperature"//clnsurf(1),"K", (/ ('', i=1, 10) /)),   &
     584      "Potential evaporation "//clnsurf(1),"kg/(m2*s)", (/ ('', i=1, 10) /)),   &
    575585      ctrl_out((/ 4, 6, 10, 10, 10, 10, 11, 11, 11, 11/),'evappot_lic',    &
    576       "Temperature"//clnsurf(2),"K", (/ ('', i=1, 10) /)),   &
     586      "Potential evaporation "//clnsurf(2),"kg/(m2*s)", (/ ('', i=1, 10) /)),   &
    577587      ctrl_out((/ 4, 6, 10, 10, 10, 10, 11, 11, 11, 11/),'evappot_oce',    &
    578       "Temperature"//clnsurf(3),"K", (/ ('', i=1, 10) /)),   &
     588      "Potential evaporation "//clnsurf(3),"kg/(m2*s)", (/ ('', i=1, 10) /)),   &
    579589      ctrl_out((/ 4, 6, 10, 10, 10, 10, 11, 11, 11, 11/),'evappot_sic',    &
    580       "Temperature"//clnsurf(4),"K", (/ ('', i=1, 10) /)) /)
     590      "Potential evaporation "//clnsurf(4),"kg/(m2*s)", (/ ('', i=1, 10) /)) /)
    581591
    582592  TYPE(ctrl_out), SAVE, DIMENSION(4) :: o_sens_srf     = (/          &
    … …  
    804814'flat_w', 'flat within_wake', 'W/m2', (/ ('', i=1, 10) /))
    805815!!
    806   type(ctrl_out),save :: o_delta_tsurf    = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
    807 'delta_tsurf', 'Temperature difference (w-x)', 'K', (/ ('', i=1, 10) /))
    808816  type(ctrl_out),save :: o_cdragh_x       = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
    809817'cdragh_x', 'cdragh off-wake', '', (/ ('', i=1, 10) /))
    … …  
    10841092      ctrl_out((/ 10, 4, 10, 10, 10, 10, 11, 11, 11, 11/),'dltpbltke_sic',       &
    10851093      "TKE difference (w - x) "//clnsurf(4),"-", (/ ('', i=1, 10) /)) /)
     1094
     1095  TYPE(ctrl_out), SAVE :: o_delta_tsurf = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
     1096    'delta_tsurf ', 'T_surf difference (w - x)', 'K', (/ ('', i=1, 10) /))
     1097  TYPE(ctrl_out), SAVE, DIMENSION(4) :: o_delta_tsurf_srf      = (/             &
     1098      ctrl_out((/ 10, 4, 10, 10, 10, 10, 11, 11, 11, 11/),'delta_tsurf_ter',       &
     1099      "T_surf difference (w - x) "//clnsurf(1),"-", (/ ('', i=1, 10) /)), &
     1100      ctrl_out((/ 10, 4, 10, 10, 10, 10, 11, 11, 11, 11/),'delta_tsurf_lic',       &
     1101      "T_surf difference (w - x) "//clnsurf(2),"-", (/ ('', i=1, 10) /)), &
     1102      ctrl_out((/ 10, 4, 10, 10, 10, 10, 11, 11, 11, 11/),'delta_tsurf_oce',       &
     1103      "T_surf difference (w - x) "//clnsurf(3),"-", (/ ('', i=1, 10) /)), &
     1104      ctrl_out((/ 10, 4, 10, 10, 10, 10, 11, 11, 11, 11/),'delta_tsurf_sic',       &
     1105      "T_surf difference (w - x) "//clnsurf(4),"-", (/ ('', i=1, 10) /)) /)
    10861106
    10871107  TYPE(ctrl_out), SAVE :: o_kz = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11, 11/), &
    … …  
    13111331  TYPE(ctrl_out), SAVE :: o_flx_co2_land = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 1/), &
    13121332    'flx_co2_land', 'CO2 flux from the land', '1', (/ ('', i=1, 10) /))
     1333  TYPE(ctrl_out), SAVE :: o_flx_co2_ocean_cor = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 1/), &
     1334    'flx_co2_ocean_cor', 'correction of the CO2 flux from the ocean', 'kg CO2 m-2 s-1', (/ ('', i=1, 10) /))
     1335  TYPE(ctrl_out), SAVE :: o_flx_co2_land_cor = ctrl_out((/ 11, 11, 11, 11, 11, 11, 11, 11, 11, 1/), &
     1336    'flx_co2_land_cor', 'correction of the CO2 flux from the land', 'kg CO2 m-2 s-1', (/ ('', i=1, 10) /))
    13131337
    13141338#ifdef CPP_StratAer

  • LMDZ6/branches/Ocean_skin/libf/phylmd/phys_output_var_mod.F90

    r3740 r4013  
    9090  ! swaerofree_diag : flag indicates if it is necessary to do calculation for some aerosol diagnostics
    9191  ! dryaod_diag : flag indicates if it is necessary to do calculation for some aerosol diagnostics
    92   !--OB: this needs to be set to TRUE by default and changed back to FALSE after first radiation call
    93   !--    and corrected back to TRUE based on output requests
    94   LOGICAL, SAVE                                :: swaerofree_diag=.TRUE.
    95   LOGICAL, SAVE                                :: swaero_diag=.TRUE.
    96   LOGICAL, SAVE                                :: dryaod_diag=.TRUE.
     92  !--OB: this needs to be set to FALSE by default and changed back to TRUE based on output requests
     93  LOGICAL, SAVE                                :: swaerofree_diag=.FALSE.
     94  LOGICAL, SAVE                                :: swaero_diag=.FALSE.
     95  LOGICAL, SAVE                                :: dryaod_diag=.FALSE.
    9796  !$OMP THREADPRIVATE(swaerofree_diag, swaero_diag, dryaod_diag)
     97 
    9898  ! ok_4xCO2atm : flag indicates if it is necessary to do a second call of
    9999  ! radiation code with a 4xCO2 or another different GES to assess SW/LW
    100100  ! in this case
    101   !--IM: as for swaero_diag or dryaod_diag this needs to be set to TRUE by default and
    102   !--    changed back to FALSE after first radiation call and corrected back to TRUE
    103   !--    based on output requests
    104   LOGICAL, SAVE                                :: ok_4xCO2atm=.TRUE.
     101  !--IM: as for swaero_diag this needs to be set to FALSE by default and
     102  !      changed back to TRUE based on output requests
     103  LOGICAL, SAVE                                :: ok_4xCO2atm=.FALSE.
    105104  !$OMP THREADPRIVATE(ok_4xCO2atm)
    106105

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

    r3798 r4013  
    3838         o_t2m, o_t2m_min, o_t2m_max, &
    3939         o_t2m_min_mon, o_t2m_max_mon, &
     40         o_nt2mout, o_nt2moutfg, &
     41         o_nq2mout, o_nq2moutfg, &
     42         o_nu2mout, o_nu2moutfg, &
    4043         o_q2m, o_ustar, o_u10m, o_v10m, &
    4144         o_wind10m, o_wind10max, o_wind100m, o_gusts, o_sicf, &
    … …  
    8487         o_dtvdf_x    , o_dtvdf_w    , o_dqvdf_x    , o_dqvdf_w    , &
    8588         o_sens_x     , o_sens_w     , o_flat_x     , o_flat_w     , &
    86          o_delta_tsurf, &
     89         o_delta_tsurf, o_delta_tsurf_srf, &
    8790         o_cdragh_x   , o_cdragh_w   , o_cdragm_x   , o_cdragm_w   , &
    8891         o_kh         , o_kh_x       , o_kh_w       , &
    … …  
    199202         o_col_O3_strato, o_col_O3_tropo,                 &
    200203!--interactive CO2
    201          o_flx_co2_ocean, o_flx_co2_land, o_flx_co2_ff, o_flx_co2_bb, &
     204         o_flx_co2_ocean, o_flx_co2_ocean_cor, &
     205         o_flx_co2_land, o_flx_co2_land_cor, &
     206         o_flx_co2_ff, o_flx_co2_bb, &
    202207         o_delta_sst, o_delta_sal, o_ds_ns, o_dt_ns, o_dter, o_dser, o_tkt, &
    203208         o_tks, o_taur, o_sss
    … …  
    234239         wstar, cape, ema_pcb, ema_pct, &
    235240         ema_cbmf, Mipsh, Ma, fm_therm, ale_bl, alp_bl, ale, &
    236          alp, cin, wake_pe, wake_dens, wake_s, wake_deltat, &
     241         alp, cin, wake_pe, wake_dens, cv_gen, wake_s, wake_deltat, &
    237242         wake_deltaq, ftd, fqd, ale_bl_trig, albsol1, &
    238243         ale_wake, ale_bl_stat, &
    … …  
    251256
    252257    USE phys_local_var_mod, ONLY: zxfluxlat, slp, ptstar, pt0, zxtsol, zt2m, &
    253          zt2m_cor,zq2m_cor,zu10m_cor,zv10m_cor, zrh2m_cor, zqsat2m_cor, &
    254          t2m_min_mon, t2m_max_mon, evap, &
     258         zn2mout, t2m_min_mon, t2m_max_mon, evap, &
    255259         l_mixmin,l_mix, tke_dissip, &
    256260         zu10m, zv10m, zq2m, zustar, zxqsurf, &
    … …  
    274278         cdragh_x   ,cdragh_w   ,cdragm_x   ,cdragm_w   , &
    275279         kh         ,kh_x       ,kh_w       , &
    276          cv_gen, wake_h, &
     280         wake_h, &
    277281         wake_omg, d_t_wake, d_q_wake, Vprecip, qtaa, Clw, &
    278282         wdtrainA, wdtrainS, wdtrainM, n2, s2, proba_notrig, &
    … …  
    334338
    335339    USE carbon_cycle_mod, ONLY: fco2_ff, fco2_bb, fco2_land, fco2_ocean
     340    USE carbon_cycle_mod, ONLY: fco2_ocean_cor, fco2_land_cor
    336341
    337342    USE phys_output_var_mod, ONLY: vars_defined, snow_o, zfra_o, bils_diss, &
    … …  
    447452    REAL,DIMENSION(klon,klev) :: z, dz
    448453    REAL,DIMENSION(klon)      :: zrho, zt
     454
     455    INTEGER :: nqup
    449456
    450457    ! On calcul le nouveau tau:
    … …  
    683690       CALL histwrite_phy(o_slp, slp)
    684691       CALL histwrite_phy(o_tsol, zxtsol)
    685        CALL histwrite_phy(o_t2m, zt2m_cor)
    686        CALL histwrite_phy(o_t2m_min, zt2m_cor)
    687        CALL histwrite_phy(o_t2m_max, zt2m_cor)
     692       CALL histwrite_phy(o_t2m, zt2m)
     693       CALL histwrite_phy(o_t2m_min, zt2m)
     694       CALL histwrite_phy(o_t2m_max, zt2m)
    688695       CALL histwrite_phy(o_t2m_max_mon, t2m_max_mon)
    689696       CALL histwrite_phy(o_t2m_min_mon, t2m_min_mon)
    … …  
    691698       IF (vars_defined) THEN
    692699          DO i=1, klon
    693              zx_tmp_fi2d(i)=SQRT(zu10m_cor(i)*zu10m_cor(i)+zv10m_cor(i)*zv10m_cor(i))
     700             zx_tmp_fi2d(i)=real(zn2mout(i,1))
     701          ENDDO
     702       ENDIF
     703       CALL histwrite_phy(o_nt2mout, zx_tmp_fi2d)
     704
     705       IF (vars_defined) THEN
     706          DO i=1, klon
     707             zx_tmp_fi2d(i)=real(zn2mout(i,2))
     708          ENDDO
     709       ENDIF
     710       CALL histwrite_phy(o_nt2moutfg, zx_tmp_fi2d)
     711
     712       IF (vars_defined) THEN
     713          DO i=1, klon
     714             zx_tmp_fi2d(i)=real(zn2mout(i,3))
     715          ENDDO
     716       ENDIF
     717       CALL histwrite_phy(o_nq2mout, zx_tmp_fi2d)
     718
     719       IF (vars_defined) THEN
     720          DO i=1, klon
     721             zx_tmp_fi2d(i)=real(zn2mout(i,4))
     722          ENDDO
     723       ENDIF
     724       CALL histwrite_phy(o_nq2moutfg, zx_tmp_fi2d)
     725
     726       IF (vars_defined) THEN
     727          DO i=1, klon
     728             zx_tmp_fi2d(i)=real(zn2mout(i,5))
     729          ENDDO
     730       ENDIF
     731       CALL histwrite_phy(o_nu2mout, zx_tmp_fi2d)
     732
     733       IF (vars_defined) THEN
     734          DO i=1, klon
     735             zx_tmp_fi2d(i)=real(zn2mout(i,6))
     736          ENDDO
     737       ENDIF
     738       CALL histwrite_phy(o_nu2moutfg, zx_tmp_fi2d)
     739
     740       IF (vars_defined) THEN
     741          DO i=1, klon
     742             zx_tmp_fi2d(i)=SQRT(zu10m(i)*zu10m(i)+zv10m(i)*zv10m(i))
    694743          ENDDO
    695744       ENDIF
    … …  
    698747       IF (vars_defined) THEN
    699748          DO i=1, klon
    700              zx_tmp_fi2d(i)=SQRT(zu10m_cor(i)*zu10m_cor(i)+zv10m_cor(i)*zv10m_cor(i))
     749             zx_tmp_fi2d(i)=SQRT(zu10m(i)*zu10m(i)+zv10m(i)*zv10m(i))
    701750          ENDDO
    702751       ENDIF
    … …  
    777826       ENDIF
    778827       CALL histwrite_phy(o_sicf, zx_tmp_fi2d)
    779        CALL histwrite_phy(o_q2m, zq2m_cor)
    780        CALL histwrite_phy(o_ustar, zustar)
    781        CALL histwrite_phy(o_u10m, zu10m_cor)
    782        CALL histwrite_phy(o_v10m, zv10m_cor)
     828       CALL histwrite_phy(o_q2m, zq2m)
     829       IF (vars_defined) zx_tmp_fi2d = zustar
     830       CALL histwrite_phy(o_ustar, zx_tmp_fi2d)
     831       CALL histwrite_phy(o_u10m, zu10m)
     832       CALL histwrite_phy(o_v10m, zv10m)
    783833
    784834       IF (vars_defined) THEN
    … …  
    10041054       CALL histwrite_phy(o_tauy, zx_tmp_fi2d)
    10051055
    1006        IF (landice_opt .GE. 1) THEN
    1007           CALL histwrite_phy(o_snowsrf, snow_o)
    1008           CALL histwrite_phy(o_qsnow, qsnow)
    1009           CALL histwrite_phy(o_snowhgt,snowhgt)
    1010           CALL histwrite_phy(o_toice,to_ice)
    1011           CALL histwrite_phy(o_sissnow,sissnow)
    1012           CALL histwrite_phy(o_runoff,runoff)
    1013           CALL histwrite_phy(o_albslw3,albsol3_lic)
    1014        ENDIF
     1056       ! Etienne: test sorties pour compil sur JZ
     1057!       IF (landice_opt .GE. 1) THEN
     1058!          CALL histwrite_phy(o_snowsrf, snow_o)
     1059!          CALL histwrite_phy(o_qsnow, qsnow)
     1060!          CALL histwrite_phy(o_snowhgt,snowhgt)
     1061!          CALL histwrite_phy(o_toice,to_ice)
     1062!          CALL histwrite_phy(o_sissnow,sissnow)
     1063!          CALL histwrite_phy(o_runoff,runoff)
     1064!          CALL histwrite_phy(o_albslw3,albsol3_lic)
     1065!       ENDIF
    10151066
    10161067       DO nsrf = 1, nbsrf
    … …  
    13041355!
    13051356               CALL histwrite_phy(o_dqvdf_w    ,zx_tmp_fi3d)
    1306                CALL histwrite_phy(o_sens_x     ,sens_x     )
    1307                CALL histwrite_phy(o_sens_w     ,sens_w     )
     1357       IF (vars_defined)  zx_tmp_fi2d(1:klon)=-1*sens_x(1:klon)
     1358               CALL histwrite_phy(o_sens_x     ,zx_tmp_fi2d)
     1359       IF (vars_defined)  zx_tmp_fi2d(1:klon)=-1*sens_w(1:klon)
     1360               CALL histwrite_phy(o_sens_w     ,zx_tmp_fi2d)
    13081361               CALL histwrite_phy(o_flat_x     ,zxfluxlat_x)
    13091362               CALL histwrite_phy(o_flat_w     ,zxfluxlat_w)
    1310                CALL histwrite_phy(o_delta_tsurf,delta_tsurf)
     1363          zx_tmp_fi2d=0.
     1364          IF (vars_defined) THEN
     1365             DO nsrf=1,nbsrf
     1366                   zx_tmp_fi2d(:)=zx_tmp_fi2d(:) &
     1367                        +pctsrf(:,nsrf)*delta_tsurf(:,nsrf)
     1368             ENDDO
     1369          ENDIF
     1370               CALL histwrite_phy(o_delta_tsurf,zx_tmp_fi2d)
    13111371               CALL histwrite_phy(o_cdragh_x   ,cdragh_x   )
    13121372               CALL histwrite_phy(o_cdragh_w   ,cdragh_w   )
    … …  
    13711431          CALL histwrite_phy(o_slab_bils, slab_wfbils)
    13721432          IF (nslay.EQ.1) THEN
    1373               zx_tmp_fi2d(:)=tslab(:,1)
     1433              IF (vars_defined) zx_tmp_fi2d(:)=tslab(:,1)
    13741434              CALL histwrite_phy(o_tslab, zx_tmp_fi2d)
    1375               zx_tmp_fi2d(:)=dt_qflux(:,1)
     1435              IF (vars_defined) zx_tmp_fi2d(:)=dt_qflux(:,1)
    13761436              CALL histwrite_phy(o_slab_qflux, zx_tmp_fi2d)
    13771437          ELSE
    … …  
    13891449          IF (slab_hdiff) THEN
    13901450            IF (nslay.EQ.1) THEN
    1391                 zx_tmp_fi2d(:)=dt_hdiff(:,1)
     1451                IF (vars_defined) zx_tmp_fi2d(:)=dt_hdiff(:,1)
    13921452                CALL histwrite_phy(o_slab_hdiff, zx_tmp_fi2d)
    13931453            ELSE
    … …  
    13971457          IF (slab_ekman.GT.0) THEN
    13981458            IF (nslay.EQ.1) THEN
    1399                 zx_tmp_fi2d(:)=dt_ekman(:,1)
     1459                IF (vars_defined) zx_tmp_fi2d(:)=dt_ekman(:,1)
    14001460                CALL histwrite_phy(o_slab_ekman, zx_tmp_fi2d)
    14011461            ELSE
    … …  
    14161476       IF (vars_defined) THEN
    14171477          DO i=1, klon
    1418              zx_tmp_fi2d(i)=MIN(100.,rh2m(i)*100.)
     1478             IF (zt2m(i).LE.273.15) then
     1479                zx_tmp_fi2d(i)=MAX(0.,rh2m(i)*100.)
     1480             ELSE
     1481                zx_tmp_fi2d(i)=MAX(0.,MIN(100.,rh2m(i)*100.))
     1482             ENDIF
    14191483          ENDDO
    14201484       ENDIF
    … …  
    14351499!       CALL histwrite_phy(o_rh2m_max, zx_tmp_fi2d)
    14361500
    1437        CALL histwrite_phy(o_qsat2m, zqsat2m_cor)
     1501       CALL histwrite_phy(o_qsat2m, qsat2m)
    14381502       CALL histwrite_phy(o_tpot, tpot)
    14391503       CALL histwrite_phy(o_tpote, tpote)
    … …  
    23822446           CALL histwrite_phy(o_flx_co2_land,  fco2_land)
    23832447           CALL histwrite_phy(o_flx_co2_ocean, fco2_ocean)
     2448           CALL histwrite_phy(o_flx_co2_ocean_cor, fco2_ocean_cor)
     2449           CALL histwrite_phy(o_flx_co2_land_cor, fco2_land_cor)
    23842450           CALL histwrite_phy(o_flx_co2_ff,    fco2_ff)
    23852451           CALL histwrite_phy(o_flx_co2_bb,    fco2_bb)
    23862452         ENDIF !--type_trac co2i
     2453
     2454         IF (type_trac == 'inco') THEN
     2455           nqup = nqo+1
     2456           DO iq=nqo+1, nqup
     2457             !--3D fields
     2458             CALL histwrite_phy(o_trac(iq-nqo), tr_seri(:,:,iq-nqo))
     2459             CALL histwrite_phy(o_dtr_vdf(iq-nqo),d_tr_cl(:,:,iq-nqo))
     2460             CALL histwrite_phy(o_dtr_the(iq-nqo),d_tr_th(:,:,iq-nqo))
     2461             CALL histwrite_phy(o_dtr_con(iq-nqo),d_tr_cv(:,:,iq-nqo))
     2462             !--2D fields
     2463             !--CO2 burden
     2464             zx_tmp_fi2d=0.
     2465             IF (vars_defined) THEN
     2466                DO k=1,klev
     2467                   zx_tmp_fi2d(:)=zx_tmp_fi2d(:)+zmasse(:,k)*tr_seri(:,k,iq-nqo)
     2468                ENDDO
     2469             ENDIF
     2470             CALL histwrite_phy(o_trac_cum(iq-nqo), zx_tmp_fi2d)
     2471           ENDDO !--iq
     2472           !--CO2 net fluxes
     2473           CALL histwrite_phy(o_flx_co2_land,  fco2_land)
     2474           CALL histwrite_phy(o_flx_co2_ocean, fco2_ocean)
     2475           CALL histwrite_phy(o_flx_co2_ocean_cor, fco2_ocean_cor)
     2476           CALL histwrite_phy(o_flx_co2_land_cor, fco2_land_cor)
     2477           CALL histwrite_phy(o_flx_co2_ff,    fco2_ff)
     2478           CALL histwrite_phy(o_flx_co2_bb,    fco2_bb)
     2479         ENDIF !--type_trac inco
    23872480
    23882481       ENDIF   !(iflag_phytrac==1)

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

    r3798 r4013  
    3232      REAL, ALLOCATABLE, SAVE :: ftsol(:,:)
    3333!$OMP THREADPRIVATE(ftsol)
     34      REAL, ALLOCATABLE, SAVE :: beta_aridity(:,:)
     35!$OMP THREADPRIVATE(beta_aridity)
    3436      REAL,ALLOCATABLE,SAVE :: qsol(:),fevap(:,:),z0m(:,:),z0h(:,:),agesno(:,:)
    3537!$OMP THREADPRIVATE(qsol,fevap,z0m,z0h,agesno)
    … …  
    9698      REAL, ALLOCATABLE, SAVE :: coefm(:,:,:) ! Kz momentum
    9799!$OMP THREADPRIVATE(pbl_tke, coefh,coefm)
    98 !nrlmd<
    99       REAL, ALLOCATABLE, SAVE :: delta_tsurf(:,:) ! Surface temperature difference inside-outside cold pool
    100 !$OMP THREADPRIVATE(delta_tsurf)
    101 !>nrlmd
    102100      REAL, ALLOCATABLE, SAVE :: zmax0(:), f0(:) !
    103101!$OMP THREADPRIVATE(zmax0,f0)
    … …  
    251249! awake_dens  : number of active wakes per unit area
    252250! wake_dens   : number of wakes per unit area
     251! cv_gen      : birth rate of cumulonimbus per unit area.
    253252! wake_occ    : occurence of wakes (= 1 if wakes occur, =0 otherwise)
    254253! wake_Cstar  : vitesse d'etalement de la poche
    … …  
    263262      REAL,ALLOCATABLE,SAVE :: awake_dens(:), wake_dens(:)
    264263!$OMP THREADPRIVATE(awake_dens, wake_dens)
     264      REAL,ALLOCATABLE,SAVE :: cv_gen(:)
     265!$OMP THREADPRIVATE(cv_gen)
    265266      REAL,ALLOCATABLE,SAVE :: wake_Cstar(:)
    266267!$OMP THREADPRIVATE(wake_Cstar)
    … …  
    276277      REAL,ALLOCATABLE,SAVE :: wake_delta_pbl_TKE(:,:,:)
    277278!$OMP THREADPRIVATE(wake_delta_pbl_TKE)
     279!nrlmd<
     280      REAL, ALLOCATABLE, SAVE :: delta_tsurf(:,:) ! Surface temperature difference inside-outside cold pool
     281!$OMP THREADPRIVATE(delta_tsurf)
     282!>nrlmd
    278283!>jyg
    279284!
    … …  
    418423!$OMP THREADPRIVATE(ccm)
    419424
    420 !!! nrlmd le 10/04/2012
    421425      REAL,SAVE,ALLOCATABLE :: ale_bl_trig(:)
    422426!$OMP THREADPRIVATE(ale_bl_trig)
    423 !!! fin nrlmd le 10/04/2012
     427
     428      REAL,SAVE,ALLOCATABLE :: ratqs_inter(:,:)
     429!$OMP THREADPRIVATE(ratqs_inter)
    424430
    425431      REAL, ALLOCATABLE, SAVE:: du_gwd_rando(:, :), du_gwd_front(:, :)
    … …  
    477483      ALLOCATE(pctsrf(klon,nbsrf))
    478484      ALLOCATE(ftsol(klon,nbsrf))
     485      ALLOCATE(beta_aridity(klon,nbsrf))
    479486      ALLOCATE(qsol(klon),fevap(klon,nbsrf))
    480487      ALLOCATE(z0m(klon,nbsrf+1),z0h(klon,nbsrf+1),agesno(klon,nbsrf))
    … …  
    486493      print*, 'allocate falb'
    487494      ALLOCATE(falb_dir(klon,nsw,nbsrf),falb_dif(klon,nsw,nbsrf))
    488       print*, 'allocate falb good', falb_dir(1,1,1)
     495!!      print*, 'allocate falb good', falb_dir(1,1,1)
    489496      ALLOCATE(chl_con(klon))
    490497!albedo SB <<<
    … …  
    584591      ALLOCATE(wake_deltat(klon,klev), wake_deltaq(klon,klev))
    585592      ALLOCATE(wake_s(klon), awake_dens(klon), wake_dens(klon))
    586       awake_dens = 0.
     593!!      awake_dens = 0.  ! initialized in phyetat0
     594      ALLOCATE(cv_gen(klon))
    587595      ALLOCATE(wake_Cstar(klon))
    588596      ALLOCATE(wake_pe(klon), wake_fip(klon))
    … …  
    648656      ALLOCATE(cg_aero_lw_rrtm(klon,klev,2,nbands_lw_rrtm))
    649657      ALLOCATE(ccm(klon,klev,nbands))
    650 
    651 !!! nrlmd le 10/04/2012
    652658      ALLOCATE(ale_bl_trig(klon))
    653 !!! fin nrlmd le 10/04/2012
     659      ALLOCATE(ratqs_inter(klon,klev))
    654660      IF (ok_gwd_rando) THEN
    655661        ALLOCATE(du_gwd_rando(klon, klev))
    … …  
    675681
    676682      DEALLOCATE(pctsrf, ftsol, falb1, falb2)
     683      DEALLOCATE(beta_aridity)
    677684      DEALLOCATE(qsol,fevap,z0m,z0h,agesno)
    678685!FC
    … …  
    688695      DEALLOCATE(tr_ancien)                           !RomP
    689696      DEALLOCATE(ratqs, pbl_tke,coefh,coefm)
    690 !nrlmd<
    691       DEALLOCATE(delta_tsurf)
    692 !>nrlmd
    693697      DEALLOCATE(zmax0, f0)
    694698      DEALLOCATE(sig1, w01)
    … …  
    742746      DEALLOCATE(wake_deltat, wake_deltaq)
    743747      DEALLOCATE(wake_s, awake_dens, wake_dens)
     748      DEALLOCATE(cv_gen)
    744749      DEALLOCATE(wake_Cstar, wake_pe, wake_fip)
    745750!jyg<
    746751      DEALLOCATE(wake_delta_pbl_TKE)
     752!nrlmd<
     753      DEALLOCATE(delta_tsurf)
     754!>nrlmd
    747755!>jyg
    748756      DEALLOCATE(pfrac_impa, pfrac_nucl)
    … …  
    794802      if (ok_gwd_rando) DEALLOCATE(du_gwd_rando)
    795803      if (.not. ok_hines .and. ok_gwd_rando) DEALLOCATE(du_gwd_front)
    796        
    797 !!! nrlmd le 10/04/2012
    798804      DEALLOCATE(ale_bl_trig)
    799 !!! fin nrlmd le 10/04/2012
     805      DEALLOCATE(ratqs_inter)
    800806
    801807      if (activate_ocean_skin >= 1) deALLOCATE(delta_sal, ds_ns, dt_ns, &

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

    r3798 r4013  
    3939    USE ioipsl_getin_p_mod, ONLY : getin_p
    4040    USE indice_sol_mod
    41     USE infotrac_phy, ONLY: nqtot, nbtr, nqo, type_trac
     41    USE infotrac_phy, ONLY: nqtot, nbtr, nqo, type_trac, nqCO2
    4242    USE iophy
    4343    USE limit_read_mod, ONLY : init_limit_read
    … …  
    5959    USE phys_output_mod
    6060    USE phys_output_ctrlout_mod
    61     USE print_control_mod, ONLY: mydebug=>debug , lunout, prt_level
     61    USE print_control_mod, ONLY: mydebug=>debug , lunout, prt_level, &
     62         alert_first_call, call_alert, prt_alerte
    6263    USE readaerosol_mod, ONLY : init_aero_fromfile
    6364    USE readaerosolstrato_m, ONLY : init_readaerosolstrato
    … …  
    7374    USE VERTICAL_LAYERS_MOD, ONLY: aps,bps, ap, bp
    7475    USE write_field_phy
     76    USE lscp_mod, ONLY : lscp
    7577
    7678    !USE cmp_seri_mod
    … …  
    197199       cdragm, cdragh,                   &
    198200       zustar, zu10m, zv10m, rh2m, qsat2m, &
    199        zq2m, zt2m, weak_inversion, &
    200        zq2m_cor,zt2m_cor,zu10m_cor,zv10m_cor, & ! pour corriger d'un bug
    201        zrh2m_cor,zqsat2m_cor, &
     201       zq2m, zt2m, zn2mout, weak_inversion, &
    202202       zt2m_min_mon, zt2m_max_mon,   &         ! pour calcul_divers.h
    203203       t2m_min_mon, t2m_max_mon,  &            ! pour calcul_divers.h
    … …  
    212212       zxrunofflic,                            &
    213213       zxtsol, snow_lsc, zxfqfonte, zxqsurf,   &
     214       delta_qsurf,                            &
    214215       rain_lsc, rain_num,                     &
    215216       !
    … …  
    219220       d_t_vdf_x, d_t_vdf_w, &
    220221       d_q_vdf_x, d_q_vdf_w, &
    221        pbl_tke_input, &
     222       pbl_tke_input, tke_dissip, l_mix, wprime,&
    222223       t_therm, q_therm, u_therm, v_therm, &
    223224       cdragh_x, cdragh_w, &
    … …  
    246247       alp_bl_stat, n2, s2,  &
    247248       proba_notrig, random_notrig,  &
    248        cv_gen,  &
     249!!       cv_gen,  &  !moved to phys_state_var_mod
    249250       !
    250251       dnwd0,  &
    … …  
    355356    LOGICAL, SAVE :: ok_volcan ! pour activer les diagnostics volcaniques
    356357    !$OMP THREADPRIVATE(ok_volcan)
     358    INTEGER, SAVE :: flag_volc_surfstrat ! pour imposer le cool/heat rate à la surf ou dans la strato
     359    !$OMP THREADPRIVATE(flag_volc_surfstrat)
    357360    LOGICAL ok_cvl  ! pour activer le nouveau driver pour convection KE
    358361    PARAMETER (ok_cvl=.TRUE.)
    … …  
    617620    !$OMP THREADPRIVATE(iflag_alp_wk_cond)
    618621
    619     INTEGER,  SAVE               :: iflag_bug_t2m_ipslcm61=1 !
    620     !$OMP THREADPRIVATE(iflag_bug_t2m_ipslcm61)
    621     INTEGER,  SAVE               :: iflag_bug_t2m_stab_ipslcm61=-1 !
    622     !$OMP THREADPRIVATE(iflag_bug_t2m_stab_ipslcm61)
    623 
    624622    REAL t_w(klon,klev),q_w(klon,klev) ! temperature and moisture profiles in the wake region
    625623    REAL t_x(klon,klev),q_x(klon,klev) ! temperature and moisture profiles in the off-wake region
    … …  
    963961    !IM cf. AM 081204 BEG
    964962    LOGICAL ptconvth(klon,klev)
     963
     964    REAL picefra(klon,klev)
    965965    !IM cf. AM 081204 END
    966966    !
    … …  
    10341034!JLD    REAL zstophy, zout
    10351035
    1036     CHARACTER*20 modname
    1037     CHARACTER*80 abort_message
     1036    CHARACTER (LEN=20) :: modname='physiq_mod'
     1037    CHARACTER*80 message, abort_message
    10381038    LOGICAL, SAVE ::  ok_sync, ok_sync_omp
    10391039    !$OMP THREADPRIVATE(ok_sync)
    … …  
    11861186    integer iostat
    11871187
     1188    REAL, dimension(klon,klev+1) :: tke_dissip_ave, l_mix_ave, wprime_ave
    11881189    REAL zzz
    11891190    !albedo SB >>>
    … …  
    12001201    pi = 4. * ATAN(1.)
    12011202
     1203    ! set-up call to alerte function
     1204    call_alert = (alert_first_call .AND. is_master)
     1205   
    12021206    ! Ehouarn: set value of jjmp1 since it is no longer a "fixed parameter"
    12031207    jjmp1=nbp_lat
    … …  
    12611265            fact_cldcon, facttemps,ok_newmicro,iflag_radia, &
    12621266            iflag_cld_th,iflag_ratqs,ratqsbas,ratqshaut,tau_ratqs, &
    1263             ok_ade, ok_aie, ok_alw, ok_cdnc, ok_volcan, aerosol_couple, &
    1264             chemistry_couple, &
    1265             flag_aerosol, flag_aerosol_strat, flag_aer_feedback, &
     1267            ok_ade, ok_aie, ok_alw, ok_cdnc, ok_volcan, flag_volc_surfstrat, aerosol_couple, &
     1268            chemistry_couple, flag_aerosol, flag_aerosol_strat, flag_aer_feedback, &
    12661269            flag_bc_internal_mixture, bl95_b0, bl95_b1, &
    12671270                                ! nv flags pour la convection et les
    … …  
    13171320    forall (k=1: nbp_lev) zmasse(:, k) = (paprs(:, k)-paprs(:, k+1)) / rg
    13181321
    1319     modname = 'physiq'
    13201322
    13211323    IF (debut) THEN
    … …  
    13281330       tau_gl=86400.*tau_gl
    13291331       WRITE(lunout,*) 'debut physiq_mod tau_gl=',tau_gl
    1330 
    1331        iflag_bug_t2m_ipslcm61 = 1
    1332        CALL getin_p('iflag_bug_t2m_ipslcm61', iflag_bug_t2m_ipslcm61)
    1333        iflag_bug_t2m_stab_ipslcm61 = -1
    1334        CALL getin_p('iflag_bug_t2m_stab_ipslcm61', iflag_bug_t2m_stab_ipslcm61)
    13351332
    13361333       CALL getin_p('iflag_alp_wk_cond', iflag_alp_wk_cond)
    … …  
    14241421       tau_overturning_th(:)=0.
    14251422
    1426        IF (type_trac == 'inca') THEN
     1423       IF (type_trac == 'inca' .OR. type_trac == 'inco') THEN
    14271424          ! jg : initialisation jusqu'au ces variables sont dans restart
    14281425          ccm(:,:,:) = 0.
    … …  
    15351532       ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    15361533       CALL init_iophy_new(latitude_deg,longitude_deg)
    1537        CALL create_etat0_limit_unstruct
    1538        CALL phyetat0 ("startphy.nc",clesphy0,tabcntr0)
    15391534
    15401535          !===================================================================
    … …  
    17031698
    17041699       CALL iniradia(klon,klev,paprs(1,1:klev+1))
    1705 
    1706        ! Initialisation des champs dans phytrac* qui sont utilisés par phys_output_write*
     1700       !
     1701!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1702       ! Initialisation des champs dans phytrac* qui sont utilises par phys_output_write*
     1703       !
     1704!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1705
    17071706#ifdef CPP_Dust
    17081707       ! Quand on utilise SPLA, on force iflag_phytrac=1
    … …  
    17331732#endif
    17341733       IF(read_climoz>=1 .AND. create_etat0_limit) CALL regr_horiz_time_climoz(read_climoz,ok_daily_climoz)
     1734       CALL create_etat0_limit_unstruct
     1735       CALL phyetat0 ("startphy.nc",clesphy0,tabcntr0)
    17351736
    17361737!jyg<
    … …  
    17471748            ENDDO
    17481749          ENDDO
    1749         ELSE
     1750       ELSE
    17501751          pbl_tke(:,:,is_ave) = 0. !ym missing init : maybe must be initialized in the same way that for klon_glo==1 ??
    17511752!>jyg
    … …  
    17911792          CALL abort_physic(modname,abort_message,1)
    17921793       ENDIF
     1794
     1795!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1796       ! Initialisation pour la convection de K.E. et pour les poches froides
     1797       !
     1798!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1799
    17931800       WRITE(lunout,*)"Clef pour la convection, iflag_con=", iflag_con
    1794        WRITE(lunout,*)"Clef pour le driver de la convection, ok_cvl=", &
    1795             ok_cvl
     1801       WRITE(lunout,*)"Clef pour le driver de la convection, ok_cvl=", ok_cvl
    17961802       !
    17971803       !KE43
    … …  
    18401846             d_s_wk(:) = 0.
    18411847             d_dens_wk(:) = 0.
    1842           ENDIF
     1848          ENDIF  !  (iflag_wake>=1)
    18431849
    18441850          !        do i = 1,klon
    … …  
    18511857       !   ALLOCATE(lonGCM(0), latGCM(0))
    18521858       !   ALLOCATE(iGCM(0), jGCM(0))
    1853        ENDIF
    1854 
     1859       ENDIF  !  (iflag_con.GE.3)
     1860       !
    18551861       DO i=1,klon
    18561862          rugoro(i) = f_rugoro * MAX(1.0e-05, zstd(i)*zsig(i)/2.0)
    … …  
    19211927       !$OMP BARRIER
    19221928       missing_val=missing_val_omp
     1929       !
     1930       ! Now we activate some double radiation call flags only if some
     1931       ! diagnostics are requested, otherwise there is no point in doing this
     1932       IF (is_master) THEN
     1933         !--setting up swaero_diag to TRUE in XIOS case
     1934         IF (xios_field_is_active("topswad").OR.xios_field_is_active("topswad0").OR. &
     1935            xios_field_is_active("solswad").OR.xios_field_is_active("solswad0").OR. &
     1936            xios_field_is_active("topswai").OR.xios_field_is_active("solswai").OR.  &
     1937              (iflag_rrtm==1.AND.(xios_field_is_active("toplwad").OR.xios_field_is_active("toplwad0").OR. &
     1938                                  xios_field_is_active("sollwad").OR.xios_field_is_active("sollwad0"))))  &
     1939            !!!--for now these fields are not in the XML files so they are omitted
     1940            !!!  xios_field_is_active("toplwai").OR.xios_field_is_active("sollwai") !))) &
     1941            swaero_diag=.TRUE.
     1942 
     1943         !--setting up swaerofree_diag to TRUE in XIOS case
     1944         IF (xios_field_is_active("SWdnSFCcleanclr").OR.xios_field_is_active("SWupSFCcleanclr").OR. &
     1945            xios_field_is_active("SWupTOAcleanclr").OR.xios_field_is_active("rsucsaf").OR.   &
     1946            xios_field_is_active("rsdcsaf") .OR. xios_field_is_active("LWdnSFCcleanclr").OR. &
     1947            xios_field_is_active("LWupTOAcleanclr")) &
     1948            swaerofree_diag=.TRUE.
     1949 
     1950         !--setting up dryaod_diag to TRUE in XIOS case
     1951         DO naero = 1, naero_tot-1
     1952          IF (xios_field_is_active("dryod550_"//name_aero_tau(naero))) dryaod_diag=.TRUE.
     1953         ENDDO
     1954         !
     1955         !--setting up ok_4xCO2atm to TRUE in XIOS case
     1956         IF (xios_field_is_active("rsut4co2").OR.xios_field_is_active("rlut4co2").OR. &
     1957            xios_field_is_active("rsutcs4co2").OR.xios_field_is_active("rlutcs4co2").OR. &
     1958            xios_field_is_active("rsu4co2").OR.xios_field_is_active("rsucs4co2").OR. &
     1959            xios_field_is_active("rsd4co2").OR.xios_field_is_active("rsdcs4co2").OR. &
     1960            xios_field_is_active("rlu4co2").OR.xios_field_is_active("rlucs4co2").OR. &
     1961            xios_field_is_active("rld4co2").OR.xios_field_is_active("rldcs4co2")) &
     1962            ok_4xCO2atm=.TRUE.
     1963       ENDIF
     1964       !$OMP BARRIER
     1965       CALL bcast(swaero_diag)
     1966       CALL bcast(swaerofree_diag)
     1967       CALL bcast(dryaod_diag)
     1968       CALL bcast(ok_4xCO2atm)
    19231969#endif
    1924 
    1925 
     1970       !
    19261971       CALL printflag( tabcntr0,radpas,ok_journe, &
    19271972            ok_instan, ok_region )
    19281973       !
    19291974       !
    1930        !
    19311975       ! Prescrire l'ozone dans l'atmosphere
    1932        !
    19331976       !
    19341977       !c         DO i = 1, klon
    … …  
    19381981       !c         ENDDO
    19391982       !
    1940        IF (type_trac == 'inca') THEN
     1983       IF (type_trac == 'inca' .OR. type_trac == 'inco') THEN                   ! ModThL
    19411984#ifdef INCA
    19421985          CALL VTe(VTphysiq)
    … …  
    19551998               klon, &
    19561999               nqtot, &
    1957                nqo, &
     2000               nqo+nqCO2, &
    19582001               pdtphys, &
    19592002               annee_ref, &
    … …  
    19862029#endif
    19872030       ENDIF
     2031       !
    19882032       IF (type_trac == 'repr') THEN
    19892033#ifdef REPROBUS
    … …  
    20342078          SFRWL(6)=3.02191470E-02
    20352079       END SELECT
    2036 
    2037 
    20382080       !albedo SB <<<
    20392081
    … …  
    21582200      ! RomP <<<
    21592201    ENDIF
    2160 
    21612202    !
    21622203    ! Ne pas affecter les valeurs entrees de u, v, h, et q
    … …  
    24972538    !   s_therm,   s_trmb1,   s_trmb2, s_trmb3,
    24982539    !   zu10m,     zv10m,   fder,
    2499     !   zxqsurf,   rh2m,      zxfluxu, zxfluxv,
     2540    !   zxqsurf,   delta_qsurf,
     2541    !   rh2m,      zxfluxu, zxfluxv,
    25002542    !   frugs,     agesno,    fsollw,  fsolsw,
    25012543    !   d_ts,      fevap,     fluxlat, t2m,
    … …  
    25472589            debut,     lafin, &
    25482590            longitude_deg, latitude_deg, rugoro,  zrmu0,      &
    2549             zsig,      sollwdown, pphi,    cldt,      &
     2591             sollwdown,    cldt,      &
    25502592            rain_fall, snow_fall, solsw,   solswfdiff, sollw,     &
    25512593            gustiness,                                &
    … …  
    25582600                                !albedo SB <<<
    25592601            cdragh,    cdragm,  u1,    v1,            &
     2602            beta_aridity, &
    25602603                                !albedo SB >>>
    25612604                                ! albsol1,   albsol2,   sens,    evap,      &
    … …  
    25632606                                !albedo SB <<<
    25642607            albsol3_lic,runoff,   snowhgt,   qsnow, to_ice, sissnow, &
    2565             zxtsol,    zxfluxlat, zt2m,    qsat2m,  &
     2608            zxtsol,    zxfluxlat, zt2m,    qsat2m,  zn2mout, &
    25662609            d_t_vdf,   d_q_vdf,   d_u_vdf, d_v_vdf, d_t_diss, &
    25672610                                !nrlmd<
    … …  
    25842627            s_therm,   s_trmb1,   s_trmb2, s_trmb3, &
    25852628            zustar, zu10m,     zv10m,   fder, &
    2586             zxqsurf,   rh2m,      zxfluxu, zxfluxv, &
     2629            zxqsurf, delta_qsurf,   rh2m,      zxfluxu, zxfluxv, &
    25872630            z0m, z0h,     agesno,    fsollw,  fsolsw, &
    25882631            d_ts,      fevap,     fluxlat, t2m, &
    … …  
    26102653!>jyg
    26112654       ENDIF
    2612 
    2613 !add limitation for t,q at and wind at 10m
    2614         if ( iflag_bug_t2m_ipslcm61 == 0 ) THEN
    2615           CALL borne_var_surf( klon,klev,nbsrf,                 &
    2616             iflag_bug_t2m_stab_ipslcm61,                        &
    2617             t_seri(:,1),q_seri(:,1),u_seri(:,1),v_seri(:,1),    &
    2618             ftsol,zxqsurf,pctsrf,paprs,                         &
    2619             t2m, q2m, u10m, v10m,                               &
    2620             zt2m_cor, zq2m_cor, zu10m_cor, zv10m_cor,           &
    2621             zrh2m_cor, zqsat2m_cor)
    2622         ELSE
    2623           zt2m_cor(:)=zt2m(:)
    2624           zq2m_cor(:)=zq2m(:)
    2625           zu10m_cor(:)=zu10m(:)
    2626           zv10m_cor(:)=zv10m(:)
    2627           zqsat2m_cor=999.999
    2628         ENDIF
    26292655
    26302656       !---------------------------------------------------------------------
    … …  
    34733499    ! Computation of ratqs, the width (normalized) of the subrid scale
    34743500    ! water distribution
     3501
     3502    tke_dissip_ave(:,:)=0.
     3503    l_mix_ave(:,:)=0.
     3504    wprime_ave(:,:)=0.
     3505
     3506
     3507    DO nsrf = 1, nbsrf
     3508       DO i = 1, klon
     3509          tke_dissip_ave(i,:) = tke_dissip_ave(i,:) + tke_dissip(i,:,nsrf)*pctsrf(i,nsrf)
     3510          l_mix_ave(i,:) = l_mix_ave(i,:) + l_mix(i,:,nsrf)*pctsrf(i,nsrf)
     3511          wprime_ave(i,:) = wprime_ave(i,:) + wprime(i,:,nsrf)*pctsrf(i,nsrf)
     3512       ENDDO
     3513    ENDDO
     3514
     3515
    34753516    CALL  calcratqs(klon,klev,prt_level,lunout,        &
    34763517         iflag_ratqs,iflag_con,iflag_cld_th,pdtphys,  &
    34773518         ratqsbas,ratqshaut,ratqsp0, ratqsdp, &
    3478          tau_ratqs,fact_cldcon,   &
     3519         tau_ratqs,fact_cldcon,wake_s, wake_deltaq,   &
    34793520         ptconv,ptconvth,clwcon0th, rnebcon0th,     &
    3480          paprs,pplay,q_seri,zqsat,fm_therm, &
    3481          ratqs,ratqsc)
    3482 
     3521         paprs,pplay,t_seri,q_seri, qtc_cv, sigt_cv, zqsat, &
     3522         pbl_tke(:,:,is_ave),tke_dissip_ave,l_mix_ave,wprime_ave,t2m,q2m,fm_therm, &
     3523         ratqs,ratqsc,ratqs_inter)
    34833524
    34843525    !
    … …  
    34893530       print *,'itap, ->fisrtilp ',itap
    34903531    ENDIF
    3491     !
     3532
     3533    picefra(:,:)=0.
     3534
     3535    IF (ok_new_lscp) THEN
     3536
     3537    CALL lscp(phys_tstep,paprs,pplay, &
     3538         t_seri, q_seri,ptconv,ratqs, &
     3539         d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, cldliq, picefra, &
     3540         rain_lsc, snow_lsc, &
     3541         pfrac_impa, pfrac_nucl, pfrac_1nucl, &
     3542         frac_impa, frac_nucl, beta_prec_fisrt, &
     3543         prfl, psfl, rhcl,  &
     3544         zqasc, fraca,ztv,zpspsk,ztla,zthl,iflag_cld_th, &
     3545         iflag_ice_thermo)
     3546
     3547    ELSE
    34923548    CALL fisrtilp(phys_tstep,paprs,pplay, &
    34933549         t_seri, q_seri,ptconv,ratqs, &
    … …  
    34993555         zqasc, fraca,ztv,zpspsk,ztla,zthl,iflag_cld_th, &
    35003556         iflag_ice_thermo)
    3501     !
     3557    ENDIF
    35023558    WHERE (rain_lsc < 0) rain_lsc = 0.
    35033559    WHERE (snow_lsc < 0) snow_lsc = 0.
    … …  
    37683824    ENDDO
    37693825
    3770     IF (type_trac == 'inca') THEN
     3826    IF (type_trac == 'inca' .OR. type_trac == 'inco') THEN      ! ModThL
    37713827#ifdef INCA
    37723828       CALL VTe(VTphysiq)
    … …  
    38113867            nbp_lon, &
    38123868            nbp_lat-1, &
    3813             tr_seri, &
     3869            tr_seri(:,:,1+nqCO2:nbtr), &
    38143870            ftsol, &
    38153871            paprs, &
    … …  
    38223878       CALL VTe(VTinca)
    38233879       CALL VTb(VTphysiq)
    3824 #endif 
    3825     ENDIF !type_trac = inca
     3880#endif
     3881    ENDIF !type_trac = inca or inco
    38263882    IF (type_trac == 'repr') THEN
    38273883#ifdef REPROBUS
    … …  
    39944050
    39954051       IF (ok_newmicro) then
    3996           IF (iflag_rrtm.NE.0) THEN
     4052! AI          IF (iflag_rrtm.NE.0) THEN
     4053          IF (iflag_rrtm.EQ.1) THEN
    39974054#ifdef CPP_RRTM
    39984055             IF (ok_cdnc.AND.NRADLP.NE.3) THEN
    … …  
    40084065          ENDIF
    40094066          CALL newmicro (flag_aerosol, ok_cdnc, bl95_b0, bl95_b1, &
    4010                paprs, pplay, t_seri, cldliq, cldfra, &
     4067               paprs, pplay, t_seri, cldliq, picefra, cldfra, &
    40114068               cldtau, cldemi, cldh, cldl, cldm, cldt, cldq, &
    40124069               flwp, fiwp, flwc, fiwc, &
    … …  
    40164073       ELSE
    40174074          CALL nuage (paprs, pplay, &
    4018                t_seri, cldliq, cldfra, cldtau, cldemi, &
     4075               t_seri, cldliq, picefra, cldfra, cldtau, cldemi, &
    40194076               cldh, cldl, cldm, cldt, cldq, &
    40204077               ok_aie, &
    … …  
    41684225               t_seri,q_seri,wo, &
    41694226               cldfrarad, cldemirad, cldtaurad, &
    4170                ok_ade.OR.flag_aerosol_strat.GT.0, ok_aie,  ok_volcan, &
    4171                flag_aerosol, &
    4172                flag_aerosol_strat, flag_aer_feedback, &
     4227               ok_ade.OR.flag_aerosol_strat.GT.0, ok_aie,  ok_volcan, flag_volc_surfstrat, &
     4228               flag_aerosol, flag_aerosol_strat, flag_aer_feedback, &
    41734229               tau_aero, piz_aero, cg_aero, &
    41744230               tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm, &
    … …  
    42114267 
    42124268#ifndef CPP_XIOS
    4213           !--OB 30/05/2016 modified 21/10/2016
    4214           !--here we return swaero_diag and dryaod_diag to FALSE
    4215           !--and histdef will switch it back to TRUE if necessary
    4216           !--this is necessary to get the right swaero at first step
    4217           !--but only in the case of no XIOS as XIOS is covered elsewhere
    4218           IF (debut) swaerofree_diag = .FALSE.
    4219           IF (debut) swaero_diag = .FALSE.
    4220           IF (debut) dryaod_diag = .FALSE.
    4221           !--IM 15/09/2017 here we return ok_4xCO2atm to FALSE
    4222           !--as for swaero_diag, see above
    4223           IF (debut) ok_4xCO2atm = .FALSE.
    4224 
    4225           !
     4269
    42264270          !IM 2eme calcul radiatif pour le cas perturbe ou au moins un
    42274271          !IM des taux doit etre different du taux actuel
    … …  
    42554299                     t_seri,q_seri,wo, &
    42564300                     cldfrarad, cldemirad, cldtaurad, &
    4257                      ok_ade.OR.flag_aerosol_strat.GT.0, ok_aie,  ok_volcan, &
    4258                      flag_aerosol, &
    4259                      flag_aerosol_strat, flag_aer_feedback, &
     4301                     ok_ade.OR.flag_aerosol_strat.GT.0, ok_aie,  ok_volcan, flag_volc_surfstrat, &
     4302                     flag_aerosol, flag_aerosol_strat, flag_aer_feedback, &
    42604303                     tau_aero, piz_aero, cg_aero, &
    42614304                     tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm, &
    … …  
    42864329                     ZLWFT0_i, ZFLDN0, ZFLUP0, &
    42874330                     ZSWFT0_i, ZFSDN0, ZFSUP0)
    4288           endif !ok_4xCO2atm
     4331          ENDIF !ok_4xCO2atm
    42894332       ENDIF ! aerosol_couple
    42904333       itaprad = 0
    … …  
    46674710
    46684711    CALL tend_to_tke(pdtphys,paprs,exner,t_seri,u_seri,v_seri,dtadd,duadd,dvadd,pctsrf,pbl_tke)
    4669 
     4712   !
     4713   ! Prevent pbl_tke_w from becoming negative
     4714    wake_delta_pbl_tke(:,:,:) = max(wake_delta_pbl_tke(:,:,:), -pbl_tke(:,:,:))
     4715   !
    46704716
    46714717       ENDIF
    … …  
    48104856    ELSE
    48114857       sh_in(:,:) = qx(:,:,ivap)
    4812        ch_in(:,:) = qx(:,:,iliq)
     4858       IF (nqo .EQ. 3) THEN
     4859          ch_in(:,:) = qx(:,:,iliq) + qx(:,:,isol)
     4860       ELSE
     4861          ch_in(:,:) = qx(:,:,iliq)
     4862       ENDIF
    48134863    ENDIF
    48144864
    … …  
    49494999    ENDDO
    49505000    !
    4951     IF (type_trac == 'inca') THEN
     5001    IF (type_trac == 'inca' .OR. type_trac == 'inco') THEN
    49525002#ifdef INCA
    49535003       CALL VTe(VTphysiq)
    … …  
    49585008            pplay, &
    49595009            t_seri, &
    4960             tr_seri, &
     5010            tr_seri(:,:,1+nqCO2:nbtr), &
    49615011            nbtr, &
    49625012            paprs, &
    … …  
    51915241#endif
    51925242
    5193 ! Pour XIOS : On remet des variables a .false. apres un premier appel
    5194     IF (debut) THEN
    5195 #ifdef CPP_XIOS
    5196       swaero_diag=.FALSE.
    5197       swaerofree_diag=.FALSE.
    5198       dryaod_diag=.FALSE.
    5199       ok_4xCO2atm= .FALSE.
    5200 !      write (lunout,*)'ok_4xCO2atm= ',swaero_diag, swaerofree_diag, dryaod_diag, ok_4xCO2atm
    5201 
    5202       IF (is_master) THEN
    5203         !--setting up swaero_diag to TRUE in XIOS case
    5204         IF (xios_field_is_active("topswad").OR.xios_field_is_active("topswad0").OR. &
    5205            xios_field_is_active("solswad").OR.xios_field_is_active("solswad0").OR. &
    5206            xios_field_is_active("topswai").OR.xios_field_is_active("solswai").OR.  &
    5207              (iflag_rrtm==1.AND.(xios_field_is_active("toplwad").OR.xios_field_is_active("toplwad0").OR. &
    5208                                  xios_field_is_active("sollwad").OR.xios_field_is_active("sollwad0"))))  &
    5209            !!!--for now these fields are not in the XML files so they are omitted
    5210            !!!  xios_field_is_active("toplwai").OR.xios_field_is_active("sollwai") !))) &
    5211            swaero_diag=.TRUE.
    5212 
    5213         !--setting up swaerofree_diag to TRUE in XIOS case
    5214         IF (xios_field_is_active("SWdnSFCcleanclr").OR.xios_field_is_active("SWupSFCcleanclr").OR. &
    5215            xios_field_is_active("SWupTOAcleanclr").OR.xios_field_is_active("rsucsaf").OR.   &
    5216            xios_field_is_active("rsdcsaf") .OR. xios_field_is_active("LWdnSFCcleanclr").OR. &
    5217            xios_field_is_active("LWupTOAcleanclr")) &
    5218            swaerofree_diag=.TRUE.
    5219 
    5220         !--setting up dryaod_diag to TRUE in XIOS case
    5221         DO naero = 1, naero_tot-1
    5222          IF (xios_field_is_active("dryod550_"//name_aero_tau(naero))) dryaod_diag=.TRUE.
    5223         ENDDO
    5224         !
    5225         !--setting up ok_4xCO2atm to TRUE in XIOS case
    5226         IF (xios_field_is_active("rsut4co2").OR.xios_field_is_active("rlut4co2").OR. &
    5227            xios_field_is_active("rsutcs4co2").OR.xios_field_is_active("rlutcs4co2").OR. &
    5228            xios_field_is_active("rsu4co2").OR.xios_field_is_active("rsucs4co2").OR. &
    5229            xios_field_is_active("rsd4co2").OR.xios_field_is_active("rsdcs4co2").OR. &
    5230            xios_field_is_active("rlu4co2").OR.xios_field_is_active("rlucs4co2").OR. &
    5231            xios_field_is_active("rld4co2").OR.xios_field_is_active("rldcs4co2")) &
    5232            ok_4xCO2atm=.TRUE.
    5233       ENDIF
    5234       !$OMP BARRIER
    5235       CALL bcast(swaero_diag)
    5236       CALL bcast(swaerofree_diag)
    5237       CALL bcast(dryaod_diag)
    5238       CALL bcast(ok_4xCO2atm)
    5239 !      write (lunout,*)'ok_4xCO2atm= ',swaero_diag, swaerofree_diag, dryaod_diag, ok_4xCO2atm
    5240 #endif
    5241     ENDIF
    5242 
    52435243    !====================================================================
    52445244    ! Arret du modele apres hgardfou en cas de detection d'un
    … …  
    52585258    !
    52595259
     5260    ! Disabling calls to the prt_alerte function
     5261    alert_first_call = .FALSE.
     5262   
    52605263    IF (lafin) THEN
    52615264       itau_phy = itau_phy + itap

  • LMDZ6/branches/Ocean_skin/libf/phylmd/phytrac_mod.F90

    r3798 r4013  
    5656  SUBROUTINE phytrac_init()
    5757    USE dimphy
    58     USE infotrac_phy, ONLY: nbtr, type_trac
     58    USE infotrac_phy, ONLY: nbtr, nqCO2, type_trac
    5959    USE tracco2i_mod, ONLY: tracco2i_init
    6060    IMPLICIT NONE
    … …  
    8181    CASE('co2i')
    8282       !   -- CO2 interactif --
     83       CALL tracco2i_init()
     84    CASE('inco')
    8385       CALL tracco2i_init()
    8486    END SELECT
    … …  
    122124    USE phys_cal_mod, only : hour
    123125    USE dimphy
    124     USE infotrac_phy, ONLY: nbtr, type_trac, conv_flg, solsym, pbl_flg
     126    USE infotrac_phy, ONLY: nbtr, nqCO2, type_trac, conv_flg, solsym, pbl_flg
    125127    USE mod_grid_phy_lmdz
    126128    USE mod_phys_lmdz_para
    … …  
    176178    REAL,DIMENSION(klon,klev),INTENT(IN)   :: sh      ! humidite specifique
    177179    REAL,DIMENSION(klon,klev),INTENT(IN)   :: rh      ! humidite relative
    178     REAL,DIMENSION(klon,klev),INTENT(IN)   :: ch      ! eau liquide
     180    REAL,DIMENSION(klon,klev),INTENT(IN)   :: ch      ! eau liquide (+ glace si le traceur existe)
    179181    REAL,DIMENSION(klon,klev+1),INTENT(IN) :: paprs   ! pression pour chaque inter-couche (en Pa)
    180182    REAL,DIMENSION(klon,klev),INTENT(IN)   :: pplay   ! pression pour le mileu de chaque couche (en Pa)
    … …  
    305307
    306308    !
    307     !Entrees/Sorties: (cf ini_histrac.h et write_histrac.h) 
     309    !Entrees/Sorties:
    308310    !---------------
    309311    INTEGER                   :: iiq, ierr
    … …  
    332334    !----------
    333335    REAL,DIMENSION(klon,klev,nbtr) :: flestottr ! flux de lessivage dans chaque couche
    334     REAL,DIMENSION(klon,klev)      :: zmasse    ! densité atmosphérique Kg/m2
     336    REAL,DIMENSION(klon,klev)      :: zmasse    ! densite atmospherique Kg/m2
    335337    REAL,DIMENSION(klon,klev)      :: ztra_th
    336338    !PhH
    … …  
    505507          iflag_vdf_trac= 1
    506508          iflag_con_trac= 1
     509       CASE('inco')
     510          source(:,1:nqCO2) = 0.                          ! from CO2i   ModThL
     511          source(:,nqCO2+1:nbtr)=init_source(:,:)         ! from INCA   ModThL
     512          aerosol(1:nqCO2) = .FALSE.                      ! from CO2i   ModThL
     513          CALL tracinca_init(aerosol(nqCO2+1:nbtr),lessivage)     ! from INCA   ModThL
     514          pbl_flg(1:nqCO2) = 1              ! From CO2i         ModThL
     515          iflag_the_trac= 1           ! From CO2i
     516          iflag_vdf_trac= 1           ! From CO2i
     517          iflag_con_trac= 1           ! From CO2i
    507518#ifdef CPP_StratAer
    508519       CASE('coag')
    … …  
    571582                !--co2 tracers are not scavenged
    572583                flag_cvltr(it)=.FALSE.
    573 
     584             CASE('inco')     ! Add ThL
     585                flag_cvltr(it)=.FALSE.
    574586#ifdef CPP_StratAer
    575587             CASE('coag')
    … …  
    590602          flag_cvltr(:) = .FALSE.
    591603       ENDIF
    592        !
    593        ! Initialize diagnostic output
    594        ! ----------------------------
    595 #ifdef CPP_IOIPSL
    596        !     INCLUDE "ini_histrac.h"
    597 #endif
    598604       !
    599605       ! print out all tracer flags
    … …  
    614620       write(lunout,*)  'flag_cvltr    = ', flag_cvltr
    615621
    616        IF (lessivage .AND. type_trac .EQ. 'inca') THEN
     622       IF (lessivage .AND. (type_trac .EQ. 'inca' .OR. type_trac .EQ. 'inco')) THEN     ! Mod ThL
    617623          CALL abort_physic('phytrac', 'lessivage=T config_inca=inca impossible',1)
    618624!          STOP
    … …  
    666672       !   -- sign convention : positive into the atmosphere
    667673
     674       CALL tracco2i(pdtphys, debutphy, &
     675            xlat, xlon, pphis, pphi, &
     676            t_seri, pplay, paprs, tr_seri, source)
     677    CASE('inco')      ! Add ThL
    668678       CALL tracco2i(pdtphys, debutphy, &
    669679            xlat, xlon, pphis, pphi, &
    … …  
    10921102
    10931103    !    -- CHIMIE INCA  config_inca = aero or chem --
    1094     IF (type_trac == 'inca') THEN
     1104    IF (type_trac == 'inca' .OR. type_trac == 'inco') THEN  ! ModThL
    10951105
    10961106       CALL tracinca(&
    … …  
    11041114            tau_aero, piz_aero, cg_aero,        ccm,       &
    11051115            rfname,                                        &
    1106             tr_seri,  source)     
    1107        
    1108        
     1116            tr_seri(:,:,1+nqCO2:nbtr),  source(:,1+nqCO2:nbtr))  ! ModThL 
    11091117    ENDIF
    1110     !=============================================================
    1111     !   Ecriture des sorties
    1112     !=============================================================
    1113 #ifdef CPP_IOIPSL
    1114     ! INCLUDE "write_histrac.h"
    1115 #endif
    11161118
    11171119  END SUBROUTINE phytrac

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

    r3798 r4013  
    1616   t,q,wo,&
    1717   cldfra, cldemi, cldtaupd,&
    18    ok_ade, ok_aie, ok_volcan, flag_aerosol,&
     18   ok_ade, ok_aie, ok_volcan, flag_volc_surfstrat, flag_aerosol,&
    1919   flag_aerosol_strat, flag_aer_feedback, &
    2020   tau_aero, piz_aero, cg_aero,&
    21    tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,& ! rajoute par OB pour RRTM
    22    tau_aero_lw_rrtm, &                                   ! rajoute par C. Kleinschmitt pour RRTM
     21   tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,& ! rajoute par OB RRTM
     22   tau_aero_lw_rrtm, &              ! rajoute par C.Kleinschmitt pour RRTM
    2323   cldtaupi, &
    2424   qsat, flwc, fiwc, &
    … …  
    4545   ZSWFT0_i, ZFSDN0, ZFSUP0)
    4646
    47 
    48 
     47! Modules necessaires
    4948  USE DIMPHY
    5049  USE assert_m, ONLY : assert
    5150  USE infotrac_phy, ONLY : type_trac
    5251  USE write_field_phy
     52
    5353#ifdef REPROBUS
    5454  USE CHEM_REP, ONLY : solaireTIME, ok_SUNTIME, ndimozon
    5555#endif
     56
    5657#ifdef CPP_RRTM
    5758!    modules necessaires au rayonnement
    5859!    -----------------------------------------
    59 !     USE YOMCST   , ONLY : RG       ,RD       ,RTT      ,RPI
    60 !     USE YOERAD   , ONLY : NSW      ,LRRTM    ,LINHOM   , LCCNL,LCCNO,
    61 !     USE YOERAD   , ONLY : NSW      ,LRRTM    ,LCCNL    ,LCCNO ,&
    62 ! NSW mis dans .def MPL 20140211
    63 ! NLW ajoute par OB
    6460      USE YOERAD   , ONLY : NLW, LRRTM    ,LCCNL    ,LCCNO ,&
    6561          NRADIP   , NRADLP , NICEOPT, NLIQOPT ,RCCNLND  , RCCNSEA
    … …  
    7369          RFLDD1   ,RFLDD2   ,RFLDD3   ,RFUETA   ,RASWCA,&
    7470          RASWCB   ,RASWCC   ,RASWCD   ,RASWCE   ,RASWCF
    75 !    &    RASWCB   ,RASWCC   ,RASWCD   ,RASWCE   ,RASWCF, RLINLI
    7671      USE YOERDU   , ONLY : NUAER  ,NTRAER ,REPLOG ,REPSC  ,REPSCW ,DIFF
    77 !      USE YOETHF   , ONLY : RTICE
    7872      USE YOERRTWN , ONLY : DELWAVE   ,TOTPLNK     
    7973      USE YOMPHY3  , ONLY : RII0
    … …  
    8175      USE aero_mod
    8276
     77! AI 02.2021
     78! Besoin pour ECRAD de pctsrf, zmasq, longitude, altitude
     79#ifdef CPP_ECRAD
     80      USE geometry_mod, ONLY: latitude, longitude
     81      USE phys_state_var_mod, ONLY: pctsrf
     82      USE indice_sol_mod
     83      USE time_phylmdz_mod, only: current_time
     84      USE phys_cal_mod, only: day_cur
     85#endif
     86
    8387  !======================================================================
    8488  ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19960719
    8589  ! Objet: interface entre le modele et les rayonnements
    8690  ! Arguments:
    87   ! dist-----input-R- distance astronomique terre-soleil
    88   ! rmu0-----input-R- cosinus de l'angle zenithal
    89   ! fract----input-R- duree d'ensoleillement normalisee
    90   ! co2_ppm--input-R- concentration du gaz carbonique (en ppm)
    91   ! paprs----input-R- pression a inter-couche (Pa)
    92   ! pplay----input-R- pression au milieu de couche (Pa)
    93   ! tsol-----input-R- temperature du sol (en K)
    94   ! alb1-----input-R- albedo du sol(entre 0 et 1) dans l'interval visible
    95   ! alb2-----input-R- albedo du sol(entre 0 et 1) dans l'interval proche infra-rouge   
    96   ! t--------input-R- temperature (K)
    97   ! q--------input-R- vapeur d'eau (en kg/kg)
    98   ! cldfra---input-R- fraction nuageuse (entre 0 et 1)
    99   ! cldtaupd---input-R- epaisseur optique des nuages dans le visible (present-day value)
    100   ! cldemi---input-R- emissivite des nuages dans l'IR (entre 0 et 1)
    101   ! ok_ade---input-L- apply the Aerosol Direct Effect or not?
    102   ! ok_aie---input-L- apply the Aerosol Indirect Effect or not?
    103   ! ok_volcan-input-L- activate volcanic diags (SW heat & LW cool rate, SW & LW flux)
    104   ! flag_aerosol-input-I- aerosol flag from 0 to 6
    105   ! flag_aerosol_strat-input-I- use stratospheric aerosols flag (0, 1, 2)
    106   ! flag_aer_feedback-input-I- activate aerosol radiative feedback (T, F)
    107   ! tau_ae, piz_ae, cg_ae-input-R- aerosol optical properties (calculated in aeropt.F)
    108   ! cldtaupi-input-R- epaisseur optique des nuages dans le visible
     91  !                  INPUTS
     92  ! dist----- input-R- distance astronomique terre-soleil
     93  ! rmu0----- input-R- cosinus de l'angle zenithal
     94  ! fract---- input-R- duree d'ensoleillement normalisee
     95  ! co2_ppm-- input-R- concentration du gaz carbonique (en ppm)
     96  ! paprs---- input-R- pression a inter-couche (Pa)
     97  ! pplay---- input-R- pression au milieu de couche (Pa)
     98  ! tsol----- input-R- temperature du sol (en K)
     99  ! alb1----- input-R- albedo du sol(entre 0 et 1) dans l'interval visible
     100  ! alb2----- input-R- albedo du sol(entre 0 et 1) dans l'interval proche infra-rouge   
     101  ! t-------- input-R- temperature (K)
     102  ! q-------- input-R- vapeur d'eau (en kg/kg)
     103  ! cldfra--- input-R- fraction nuageuse (entre 0 et 1)
     104  ! cldtaupd- input-R- epaisseur optique des nuages dans le visible (present-day value)
     105  ! cldemi--- input-R- emissivite des nuages dans l'IR (entre 0 et 1)
     106  ! ok_ade--- input-L- apply the Aerosol Direct Effect or not?
     107  ! ok_aie--- input-L- apply the Aerosol Indirect Effect or not?
     108  ! ok_volcan input-L- activate volcanic diags (SW heat & LW cool rate, SW & LW flux)
     109  ! flag_volc_surfstrat input-I- activate volcanic surf cooling or strato heating (or nothing)
     110  ! flag_aerosol input-I- aerosol flag from 0 to 6
     111  ! flag_aerosol_strat input-I- use stratospheric aerosols flag (0, 1, 2)
     112  ! flag_aer_feedback  input-I- activate aerosol radiative feedback (T, F)
     113  ! tau_ae, piz_ae, cg_ae input-R- aerosol optical properties (calculated in aeropt.F)
     114  ! cldtaupi  input-R- epaisseur optique des nuages dans le visible
    109115  !                   calculated for pre-industrial (pi) aerosol concentrations, i.e. with smaller
    110116  !                   droplet concentration, thus larger droplets, thus generally cdltaupi cldtaupd
    111117  !                   it is needed for the diagnostics of the aerosol indirect radiative forcing     
    112118  !
     119  !                  OUTPUTS
    113120  ! heat-----output-R- echauffement atmospherique (visible) (K/jour)
    114121  ! cool-----output-R- refroidissement dans l'IR (K/jour)
    … …  
    177184  !
    178185  ! ====================================================================
     186
     187! ==============
     188! DECLARATIONS
     189! ==============
    179190  include "YOETHF.h"
    180191  include "YOMCST.h"
    … …  
    200211  LOGICAL, INTENT(in)  :: ok_ade, ok_aie                                 ! switches whether to use aerosol direct (indirect) effects or not
    201212  LOGICAL, INTENT(in)  :: ok_volcan                                      ! produce volcanic diags (SW/LW heat flux and rate)
    202   LOGICAL              :: lldebug
     213  INTEGER, INTENT(in)  :: flag_volc_surfstrat                            ! allow to impose volcanic cooling rate at surf or heating in strato
     214  LOGICAL              :: lldebug=.false.
    203215  INTEGER, INTENT(in)  :: flag_aerosol                                   ! takes value 0 (no aerosol) or 1 to 6 (aerosols)
    204216  INTEGER, INTENT(in)  :: flag_aerosol_strat                             ! use stratospheric aerosols
    … …  
    286298  REAL(KIND=8) PTAVE(kdlon,kflev)
    287299  REAL(KIND=8) PWV(kdlon,kflev), PQS(kdlon,kflev)
     300
     301!!!!!!! Declarations specifiques pour ECRAD !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     302! AI 02.2021
     303#ifdef CPP_ECRAD
     304! ATTENTION les dimensions klon, kdlon ???
     305! INPUTS
     306  REAL, DIMENSION(kdlon,kflev+1) :: ZSWFT0_ii, ZLWFT0_ii
     307  REAL(KIND=8) ZEMISW(klon), &              ! LW emissivity inside the window region
     308               ZEMIS(klon)                  ! LW emissivity outside the window region
     309  REAL(KIND=8) ZGELAM(klon), &              ! longitudes en rad
     310               ZGEMU(klon)                  ! sin(latitude)
     311  REAL(KIND=8) ZCO2(klon,klev), &           ! CO2 mass mixing ratios on full levels
     312               ZCH4(klon,klev), &           ! CH4 mass mixing ratios on full levels
     313               ZN2O(klon,klev), &           ! N2O mass mixing ratios on full levels
     314               ZNO2(klon,klev), &           ! NO2 mass mixing ratios on full levels
     315               ZCFC11(klon,klev), &         ! CFC11
     316               ZCFC12(klon,klev), &         ! CFC12
     317               ZHCFC22(klon,klev), &        ! HCFC22
     318               ZCCL4(klon,klev)           ! CCL4
     319!               ZO3_DP(klon,klev), ZO3_DP_i(klon,klev)            ! Ozone
     320  REAL(KIND=8) ZQ_RAIN(klon,klev), &        ! Rain cloud mass mixing ratio (kg/kg) ?
     321               ZQ_SNOW(klon,klev)           ! Snow cloud mass mixing ratio (kg/kg) ?
     322  REAL(KIND=8) ZAEROSOL_OLD(KLON,6,KLEV), &  !
     323               ZAEROSOL(KLON,KLEV,naero_tot) !
     324! OUTPUTS
     325  REAL(KIND=8) ZFLUX_DIR(klon), &           ! Direct compt of surf flux into horizontal plane
     326               ZFLUX_DIR_CLEAR(klon), &     ! CS Direct
     327               ZFLUX_DIR_INTO_SUN(klon), &  !
     328               ZFLUX_UV(klon), &            ! UV flux
     329               ZFLUX_PAR(klon), &           ! photosynthetically active radiation similarly
     330               ZFLUX_PAR_CLEAR(klon), &     ! CS photosynthetically
     331               ZFLUX_SW_DN_TOA(klon), &     ! DN SW flux at TOA
     332               ZEMIS_OUT(klon)              ! effective broadband emissivity
     333  REAL(KIND=8) ZLWDERIVATIVE(klon,klev+1)   ! LW derivatives
     334  REAL(KIND=8) ZSWDIFFUSEBAND(klon,NSW), &  ! SW DN flux in diffuse albedo band
     335               ZSWDIRECTBAND(klon,NSW)      ! SW DN flux in direct albedo band
     336#endif
     337!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    288338
    289339  REAL(kind=8) POZON(kdlon, kflev, size(wo, 3)) ! mass fraction of ozone
    … …  
    317367  REAL(KIND=8) ztopswaiaero(kdlon), zsolswaiaero(kdlon)     ! dito, indirect
    318368!--NL
    319   REAL(KIND=8) zswadaero(kdlon,kflev+1)                       ! SW Aerosol direct forcing
    320   REAL(KIND=8) zlwadaero(kdlon,kflev+1)                       ! LW Aerosol direct forcing
     369  REAL(KIND=8) zswadaero(kdlon,kflev+1)                     ! SW Aerosol direct forcing
     370  REAL(KIND=8) zlwadaero(kdlon,kflev+1)                     ! LW Aerosol direct forcing
     371  REAL(KIND=8) volmip_solsw(kdlon)                          ! SW clear sky in the case of VOLMIP
    321372!-LW by CK
    322373  REAL(KIND=8) ztoplwadaero(kdlon), zsollwadaero(kdlon)     ! LW Aerosol direct forcing at TOAand surface
    … …  
    401452  REAL zdir, zdif
    402453
     454! =========  INITIALISATIONS ==============================================
     455 IF (lldebug) THEN
     456  print*,'Entree dans radlwsw '
     457  print*,'************* INITIALISATIONS *****************************'
     458  print*,'klon, kdlon, klev, kflev =',klon, kdlon, klev, kflev
     459 ENDIF
     460
    403461  CALL assert(size(wo, 1) == klon, size(wo, 2) == klev, "radlwsw wo")
    404   ! initialisation
     462 
    405463  ist=1
    406464  iend=klon
    407465  ktdia=1
    408466  kmode=ist
     467! Aeros
    409468  tauaero(:,:,:,:)=0.
    410469  pizaero(:,:,:,:)=0.
    411470  cgaero(:,:,:,:)=0.
    412   lldebug=.FALSE.
     471!  lldebug=.FALSE.
    413472
    414473  ztopsw_aero(:,:)  = 0. !ym missing init : warning : not initialized in SW_AEROAR4
    … …  
    462521  ENDIF
    463522
     523 IF (lldebug) THEN
     524  print*,'************** Debut boucle de 1 a ', nb_gr
     525 ENDIF
     526
    464527  DO j = 1, nb_gr
    465528    iof = kdlon*(j-1)
    466529    DO i = 1, kdlon
    467530      zfract(i) = fract(iof+i)
    468 !     zfract(i) = 1.     !!!!!!  essai MPL 19052010
    469531      zrmu0(i) = rmu0(iof+i)
    470532
    471533
    472 !albedo SB >>>
    473 !
    474534      IF (iflag_rrtm==0) THEN
    475 !
     535!     Albedo
    476536        PALBD(i,1)=alb_dif(iof+i,1)
    477537        PALBD(i,2)=alb_dif(iof+i,2)
    478538        PALBP(i,1)=alb_dir(iof+i,1)
    479539        PALBP(i,2)=alb_dir(iof+i,2)
    480 !
    481       ELSEIF (iflag_rrtm==1) THEn
    482 !
     540! AI 02.2021 cas iflag_rrtm=1 et 2
     541       ELSEIF (iflag_rrtm==1.OR.iflag_rrtm==2) THEN
    483542        DO kk=1,NSW
    484543          PALBD_NEW(i,kk)=alb_dif(iof+i,kk)
    … …  
    488547      ENDIF
    489548!albedo SB <<<
    490 
    491549
    492550      PEMIS(i) = 1.0    !!!!! A REVOIR (MPL)
    … …  
    569627      ENDDO
    570628    ENDDO
     629!
     630! AI 02.2021
     631#ifdef CPP_ECRAD
     632  ZEMIS = 1.0
     633  ZEMISW = 1.0
     634  ZGELAM = longitude
     635  ZGEMU = sin(latitude)
     636  ZCO2 = RCO2
     637  ZCH4 = RCH4
     638  ZN2O = RN2O
     639  ZNO2 = 0.0
     640  ZCFC11 = RCFC11
     641  ZCFC12 = RCFC12
     642  ZHCFC22 = 0.0
     643  ZCCL4 = 0.0
     644  ZQ_RAIN = 0.0
     645  ZQ_SNOW = 0.0
     646  ZAEROSOL_OLD = 0.0
     647  ZAEROSOL = 0.0
     648#endif
    571649!
    572650!===== iflag_rrtm ================================================
    … …  
    693771       ENDDO 
    694772!
    695     ELSE
     773    ELSE IF (iflag_rrtm == 1) then
    696774#ifdef CPP_RRTM
    697775!      if (prt_level.gt.10)write(lunout,*)'CPP_RRTM=.T.'
    … …  
    804882            ENDDO
    805883         ENDDO
     884
    806885!       print *,'RADLWSW: avant RECMWFL, RI0,rmu0=',solaire,rmu0
    807886
    … …  
    819898! RII0 = RIP0M15 ! =rip0m if Morcrette non-each time step call.
    820899         RII0=solaire/zdist/zdist
    821 !print*,'+++ radlwsw: solaire ,RII0',solaire,RII0
    822900!  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    823901! Ancien appel a RECMWF (celui du cy25)
    … …  
    852930         PALBD_NEW,PALBP_NEW, paprs_i , pplay_i , RCO2   , cldfra_i,&
    853931         POZON_i  , PAER_i  , PDP_i   , PEMIS   , rmu0   ,&
    854           q_i     , qsat_i  , fiwc_i  , flwc_i  , zmasq  , t_i  ,tsol,&
     932         q_i     , qsat_i  , fiwc_i  , flwc_i  , zmasq  , t_i  ,tsol,&
    855933         ref_liq_i, ref_ice_i, &
    856934         ref_liq_pi_i, ref_ice_pi_i, &   ! rajoute par OB pour diagnostiquer effet indirect
    … …  
    873951         ZTOPLWAIAERO,ZSOLLWAIAERO, &
    874952         ZLWADAERO, & !--NL
     953         volmip_solsw, flag_volc_surfstrat, & !--VOLMIP
    875954         ok_ade, ok_aie, ok_volcan, flag_aerosol,flag_aerosol_strat, flag_aer_feedback) ! flags aerosols
     955
     956!--OB diagnostics
     957! & PTOPSWAIAERO,PSOLSWAIAERO,&
     958! & PTOPSWCFAERO,PSOLSWCFAERO,&
     959! & PSWADAERO,& !--NL
     960!!--LW diagnostics CK
     961! & PTOPLWADAERO,PSOLLWADAERO,&
     962! & PTOPLWAD0AERO,PSOLLWAD0AERO,&
     963! & PTOPLWAIAERO,PSOLLWAIAERO,&
     964! & PLWADAERO,& !--NL
     965!!..end
     966! & ok_ade, ok_aie, ok_volcan, flag_aerosol,flag_aerosol_strat,&
     967! & flag_aer_feedback)
     968
    876969           
    877970!        print *,'RADLWSW: apres RECMWF'
    … …  
    902995        CALL writefield_phy('zfcup_i',ZFCUP_i,klev+1)
    903996      ENDIF
    904 ! --------- output RECMWFL
    905 !  ZEMTD        (KPROMA,KLEV+1)  ; TOTAL DOWNWARD LONGWAVE EMISSIVITY
    906 !  ZEMTU        (KPROMA,KLEV+1)  ; TOTAL UPWARD   LONGWAVE EMISSIVITY
    907 !  ZTRSO        (KPROMA,KLEV+1)  ; TOTAL SHORTWAVE TRANSMISSIVITY
    908 !  ZTH          (KPROMA,KLEV+1)  ; HALF LEVEL TEMPERATURE
    909 !  ZCTRSO       (KPROMA,2)       ; CLEAR-SKY SHORTWAVE TRANSMISSIVITY
    910 !  ZCEMTR       (KPROMA,2)       ; CLEAR-SKY NET LONGWAVE EMISSIVITY
    911 !  ZTRSOD       (KPROMA)         ; TOTAL-SKY SURFACE SW TRANSMISSITY
    912 !  ZLWFC        (KPROMA,2)       ; CLEAR-SKY LONGWAVE FLUXES
    913 !  ZLWFT        (KPROMA,KLEV+1)  ; TOTAL-SKY LONGWAVE FLUXES
    914 !  ZSWFC        (KPROMA,2)       ; CLEAR-SKY SHORTWAVE FLUXES
    915 !  ZSWFT        (KPROMA,KLEV+1)  ; TOTAL-SKY SHORTWAVE FLUXES
    916 !  PPIZA_TOT    (KPROMA,KLEV,NSW); Single scattering albedo of total aerosols
    917 !  PCGA_TOT     (KPROMA,KLEV,NSW); Assymetry factor for total aerosols
    918 !  PTAU_TOT     (KPROMA,KLEV,NSW); Optical depth of total aerosols
    919 !  PPIZA_NAT    (KPROMA,KLEV,NSW); Single scattering albedo of natural aerosols
    920 !  PCGA_NAT     (KPROMA,KLEV,NSW); Assymetry factor for natural aerosols
    921 !  PTAU_NAT     (KPROMA,KLEV,NSW); Optical depth of natiral aerosols
    922 !  PTAU_LW_TOT  (KPROMA,KLEV,NLW); LW Optical depth of total aerosols 
    923 !  PTAU_LW_NAT  (KPROMA,KLEV,NLW); LW Optical depth of natural aerosols 
    924 !  PSFSWDIR     (KPROMA,NSW)     ;
    925 !  PSFSWDIF     (KPROMA,NSW)     ;
    926 !  PFSDNN       (KPROMA)         ;
    927 !  PFSDNV       (KPROMA)         ;
     997
    928998! ---------
    929999! ---------
    … …  
    9831053      ZSOLSWCF_AERO(:,3)=ZSOLSWCF_AERO(:,3)*fract(:)
    9841054
    985 !     print*,'SW_RRTM ZFSDN0 1 , klev:',ZFSDN0(1:klon,1),ZFSDN0(1:klon,klev)
    986 !     print*,'SW_RRTM ZFSUP0 1 , klev:',ZFSUP0(1:klon,1),ZFSUP0(1:klon,klev)
    987 !     print*,'SW_RRTM ZFSDN  1 , klev:',ZFSDN(1:klon,1),ZFSDN(1:klon,klev)
    988 !     print*,'SW_RRTM ZFSUP  1 , klev:',ZFSUP(1:klon,1),ZFSUP(1:klon,klev)     
    989 !     print*,'OK1'
    9901055! ---------
    9911056! ---------
    … …  
    10341099!     print*,'OK2'
    10351100
     1101!--add VOLMIP (surf cool or strat heat activate)
     1102      IF (flag_volc_surfstrat > 0) THEN
     1103         DO i = 1, kdlon
     1104            zsolsw(i)    = volmip_solsw(i)*fract(i)
     1105         ENDDO
     1106      ENDIF
     1107
    10361108! extrait de SW_AR4
    10371109!     DO k = 1, KFLEV
    … …  
    10611133    call abort_physic(modname, abort_message, 1)
    10621134#endif
    1063     ENDIF ! iflag_rrtm
     1135!======================================================================
     1136! AI fev 2021
     1137    ELSE IF(iflag_rrtm == 2) THEN
     1138    print*,'Traitement cas iflag_rrtm = ',iflag_rrtm
     1139!    print*,'Mise a zero des flux '
     1140#ifdef CPP_ECRAD
     1141      DO k = 1, kflev+1
     1142      DO i = 1, kdlon
     1143        ZEMTD_i(i,k)=0.
     1144        ZEMTU_i(i,k)=0.
     1145        ZTRSO_i(i,k)=0.
     1146        ZTH_i(i,k)=0.
     1147        ZLWFT_i(i,k)=0.
     1148        ZSWFT_i(i,k)=0.
     1149        ZFLUX_i(i,1,k)=0.
     1150        ZFLUX_i(i,2,k)=0.
     1151        ZFLUC_i(i,1,k)=0.
     1152        ZFLUC_i(i,2,k)=0.
     1153        ZFSDWN_i(i,k)=0.
     1154        ZFCDWN_i(i,k)=0.
     1155        ZFCCDWN_i(i,k)=0.
     1156        ZFSUP_i(i,k)=0.
     1157        ZFCUP_i(i,k)=0.
     1158        ZFCCUP_i(i,k)=0.
     1159        ZFLCCDWN_i(i,k)=0.
     1160        ZFLCCUP_i(i,k)=0.
     1161      ENDDO
     1162      ENDDO
     1163!
     1164! AI ATTENTION Aerosols A REVOIR
     1165!      DO i = 1, kdlon
     1166!      DO k = 1, kflev
     1167!      DO kk=1, NSW
     1168!
     1169!      PTAU_TOT(i,kflev+1-k,kk)=tau_aero_sw_rrtm(i,k,2,kk)
     1170!      PPIZA_TOT(i,kflev+1-k,kk)=piz_aero_sw_rrtm(i,k,2,kk)
     1171!      PCGA_TOT(i,kflev+1-k,kk)=cg_aero_sw_rrtm(i,k,2,kk)
     1172!
     1173!      PTAU_NAT(i,kflev+1-k,kk)=tau_aero_sw_rrtm(i,k,1,kk)
     1174!      PPIZA_NAT(i,kflev+1-k,kk)=piz_aero_sw_rrtm(i,k,1,kk)
     1175!      PCGA_NAT(i,kflev+1-k,kk)=cg_aero_sw_rrtm(i,k,1,kk)
     1176!
     1177!      ENDDO
     1178!      ENDDO
     1179!      ENDDO
     1180!-end OB
     1181!
     1182!      DO i = 1, kdlon
     1183!      DO k = 1, kflev
     1184!      DO kk=1, NLW
     1185!
     1186!      PTAU_LW_TOT(i,kflev+1-k,kk)=tau_aero_lw_rrtm(i,k,2,kk)
     1187!      PTAU_LW_NAT(i,kflev+1-k,kk)=tau_aero_lw_rrtm(i,k,1,kk)
     1188!
     1189!      ENDDO
     1190!      ENDDO
     1191!      ENDDO
     1192!-end C. Kleinschmitt
     1193!     
     1194      DO i = 1, kdlon
     1195      ZCTRSO(i,1)=0.
     1196      ZCTRSO(i,2)=0.
     1197      ZCEMTR(i,1)=0.
     1198      ZCEMTR(i,2)=0.
     1199      ZTRSOD(i)=0.
     1200      ZLWFC(i,1)=0.
     1201      ZLWFC(i,2)=0.
     1202      ZSWFC(i,1)=0.
     1203      ZSWFC(i,2)=0.
     1204      PFSDNN(i)=0.
     1205      PFSDNV(i)=0.
     1206      DO kk = 1, NSW
     1207        PSFSWDIR(i,kk)=0.
     1208        PSFSWDIF(i,kk)=0.
     1209      ENDDO
     1210      ENDDO
     1211!----- Fin des mises a zero des tableaux output -------------------             
     1212
     1213! On met les donnees dans l'ordre des niveaux ecrad
     1214!         print*,'On inverse sur la verticale '
     1215         paprs_i(:,1)=paprs(:,klev+1)
     1216         DO k=1,klev
     1217            paprs_i(1:klon,k+1) =paprs(1:klon,klev+1-k)
     1218            pplay_i(1:klon,k)   =pplay(1:klon,klev+1-k)
     1219            cldfra_i(1:klon,k)  =cldfra(1:klon,klev+1-k)
     1220            PDP_i(1:klon,k)     =PDP(1:klon,klev+1-k)
     1221            t_i(1:klon,k)       =t(1:klon,klev+1-k)
     1222            q_i(1:klon,k)       =q(1:klon,klev+1-k)
     1223            qsat_i(1:klon,k)    =qsat(1:klon,klev+1-k)
     1224            flwc_i(1:klon,k)    =flwc(1:klon,klev+1-k)
     1225            fiwc_i(1:klon,k)    =fiwc(1:klon,klev+1-k)
     1226            ref_liq_i(1:klon,k) =ref_liq(1:klon,klev+1-k)
     1227            ref_ice_i(1:klon,k) =ref_ice(1:klon,klev+1-k)
     1228!-OB
     1229            ref_liq_pi_i(1:klon,k) =ref_liq_pi(1:klon,klev+1-k)
     1230            ref_ice_pi_i(1:klon,k) =ref_ice_pi(1:klon,klev+1-k)
     1231         ENDDO
     1232         DO k=1,kflev
     1233            POZON_i(1:klon,k,:)=POZON(1:klon,kflev+1-k,:)
     1234!            ZO3_DP_i(1:klon,k)=ZO3_DP(1:klon,kflev+1-k)
     1235!            DO i=1,6
     1236            PAER_i(1:klon,k,:)=PAER(1:klon,kflev+1-k,:)
     1237!            ENDDO
     1238         ENDDO
     1239! AI 02.2021
     1240! Calcul de ZTH_i (temp aux interfaces 1:klev+1)
     1241         DO K=2,KLEV
     1242            ZTH_i(:,K)=&
     1243              & (t_i(:,K-1)*pplay_i(:,K-1)*(pplay_i(:,K)-paprs_i(:,K))&
     1244              & +t_i(:,K)*pplay_i(:,K)*(paprs_i(:,K)-pplay_i(:,K-1)))&
     1245              & *(1.0/(paprs_i(:,K)*(pplay_i(:,K)-pplay_i(:,K-1))))
     1246         ENDDO
     1247            ZTH_i(:,KLEV+1)=tsol(:)
     1248            ZTH_i(:,1)=t_i(:,1)-pplay_i(:,1)*(t_i(:,1)-ZTH_i(:,2))&
     1249                      & /(pplay_i(:,1)-paprs_i(:,2))
     1250
     1251      print *,'RADLWSW: avant RADIATION_SCHEME '
     1252      IF (lldebug) THEN
     1253        CALL writefield_phy('rmu0',rmu0,1)
     1254        CALL writefield_phy('tsol',tsol,1)
     1255        CALL writefield_phy('emissiv_out',ZEMIS,1)
     1256        CALL writefield_phy('emissiv_in',ZEMISW,1)
     1257        CALL writefield_phy('pctsrf_ter',pctsrf(:,is_ter),1)
     1258        CALL writefield_phy('pctsrf_oce',pctsrf(:,is_oce),1)
     1259        CALL writefield_phy('ZGELAM',ZGELAM,1)
     1260        CALL writefield_phy('ZGEMU',ZGEMU,1)
     1261        CALL writefield_phy('zmasq',zmasq,1)
     1262        CALL writefield_phy('paprs_i',paprs_i,klev+1)
     1263        CALL writefield_phy('pplay_i',pplay_i,klev)
     1264        CALL writefield_phy('t_i',t_i,klev)
     1265        CALL writefield_phy('ZTH_i',ZTH_i,klev+1)
     1266        CALL writefield_phy('cldfra_i',cldfra_i,klev)
     1267        CALL writefield_phy('paer_i',PAER_i,klev)
     1268        CALL writefield_phy('q_i',q_i,klev)
     1269        CALL writefield_phy('fiwc_i',fiwc_i,klev)
     1270        CALL writefield_phy('flwc_i',flwc_i,klev)
     1271        CALL writefield_phy('palbd_new',PALBD_NEW,NSW)
     1272        CALL writefield_phy('palbp_new',PALBP_NEW,NSW)
     1273!        CALL writefield_phy('ZO3_DP',ZO3_DP,klev)
     1274      ENDIF
     1275 
     1276      CALL RADIATION_SCHEME &
     1277      & (ist, iend, klon, klev, naero_tot, NSW, &
     1278! ??? naero_tot
     1279      & day_cur, current_time, &
     1280!      & solaire, &
     1281      & PSCT, &
     1282      & rmu0, tsol, PALBD_NEW,PALBP_NEW, &   
     1283!       PEMIS_WINDOW (???), &
     1284      & ZEMIS, ZEMISW, &
     1285!       PCCN_LAND, PCCN_SEA, & ???
     1286      & pctsrf(:,is_ter), pctsrf(:,is_oce), &
     1287!       longitude(rad), sin(latitude), PMASQ_ ???
     1288      & ZGELAM, ZGEMU, zmasq, &
     1289!       pression et temp aux milieux
     1290      & pplay_i, t_i, &
     1291!       PTEMPERATURE_H ?,
     1292      & paprs_i, ZTH_i, q_i, qsat_i, &
     1293!       Gas
     1294       & ZCO2, ZCH4, ZN2O, ZNO2, ZCFC11, ZCFC12, ZHCFC22, ZCCL4, POZON_i(:,:,1), &
     1295!       nuages :
     1296      & cldfra_i, flwc_i, fiwc_i, ZQ_RAIN, ZQ_SNOW, & 
     1297      & ref_liq_i, ref_ice_i, &
     1298!       aerosols
     1299      & ZAEROSOL_OLD, ZAEROSOL, &
     1300! Outputs
     1301!       Net flux :
     1302      & ZSWFT_i, ZLWFT_i, ZSWFT0_ii, ZLWFT0_ii, &
     1303!       DWN flux :
     1304      & ZFSDWN_i, ZFLUX_i(:,2,:), ZFCDWN_i, ZFLUC_i(:,2,:), &
     1305!       UP flux :
     1306      & ZFSUP_i, ZFLUX_i(:,1,:), ZFCUP_i, ZFLUC_i(:,1,:), &
     1307!       Surf Direct flux : ATTENTION
     1308      & ZFLUX_DIR, ZFLUX_DIR_CLEAR, ZFLUX_DIR_INTO_SUN, &
     1309!       UV and para flux
     1310      & ZFLUX_UV, ZFLUX_PAR, ZFLUX_PAR_CLEAR, &
     1311!      & ZFLUX_SW_DN_TOA,
     1312      & ZEMIS_OUT, ZLWDERIVATIVE, &
     1313      & PSFSWDIF, PSFSWDIR)
     1314
     1315      print *,'========= RADLWSW: apres RADIATION_SCHEME ==================== '
     1316
     1317      IF (lldebug) THEN
     1318        CALL writefield_phy('zlwft_i',ZLWFT_i,klev+1)
     1319        CALL writefield_phy('zlwft0_ii',ZLWFT0_ii,klev+1)
     1320        CALL writefield_phy('zswft_i',ZSWFT_i,klev+1)
     1321        CALL writefield_phy('zswft0_i',ZSWFT0_ii,klev+1)
     1322        CALL writefield_phy('zfsdwn_i',ZFSDWN_i,klev+1)
     1323        CALL writefield_phy('zflux2_i',ZFLUX_i(:,2,:),klev+1)
     1324        CALL writefield_phy('zfcdwn_i',ZFCDWN_i,klev+1)
     1325        CALL writefield_phy('zfluc2_i',ZFLUC_i(:,2,:),klev+1)
     1326        CALL writefield_phy('psfswdir',PSFSWDIR,6)
     1327        CALL writefield_phy('psfswdif',PSFSWDIF,6)
     1328        CALL writefield_phy('zflux1_i',ZFLUX_i(:,1,:),klev+1)
     1329        CALL writefield_phy('zfluc1_i',ZFLUC_i(:,1,:),klev+1)
     1330        CALL writefield_phy('zfsup_i',ZFSUP_i,klev+1)
     1331        CALL writefield_phy('zfcup_i',ZFCUP_i,klev+1)
     1332      ENDIF
     1333! ---------
     1334! On retablit l'ordre des niveaux lmd pour les tableaux de sortie
     1335! D autre part, on multiplie les resultats SW par fract pour etre coherent
     1336! avec l ancien rayonnement AR4. Si nuit, fract=0 donc pas de
     1337! rayonnement SW. (MPL 260609)
     1338      print*,'On retablit l ordre des niveaux verticaux pour LMDZ'
     1339      print*,'On multiplie les flux SW par fract et LW dwn par -1'
     1340      DO k=0,klev
     1341         DO i=1,klon
     1342         ZEMTD(i,k+1)  = ZEMTD_i(i,klev+1-k)
     1343         ZEMTU(i,k+1)  = ZEMTU_i(i,klev+1-k)
     1344         ZTRSO(i,k+1)  = ZTRSO_i(i,klev+1-k)
     1345!         ZTH(i,k+1)    = ZTH_i(i,klev+1-k)
     1346! AI ATTENTION
     1347          ZLWFT(i,k+1)  = ZLWFT_i(i,klev+1-k)
     1348          ZSWFT(i,k+1)  = ZSWFT_i(i,klev+1-k)*fract(i)
     1349          ZSWFT0_i(i,k+1) = ZSWFT0_ii(i,klev+1-k)*fract(i)
     1350          ZLWFT0_i(i,k+1) = ZLWFT0_ii(i,klev+1-k)
     1351!
     1352         ZFLUP(i,k+1)  = ZFLUX_i(i,1,klev+1-k)
     1353         ZFLDN(i,k+1)  = -1.*ZFLUX_i(i,2,klev+1-k)
     1354         ZFLUP0(i,k+1) = ZFLUC_i(i,1,klev+1-k)
     1355         ZFLDN0(i,k+1) = -1.*ZFLUC_i(i,2,klev+1-k)
     1356         ZFSDN(i,k+1)  = ZFSDWN_i(i,klev+1-k)*fract(i)
     1357         ZFSDN0(i,k+1) = ZFCDWN_i(i,klev+1-k)*fract(i)
     1358         ZFSDNC0(i,k+1)= ZFCCDWN_i(i,klev+1-k)*fract(i)
     1359         ZFSUP (i,k+1) = ZFSUP_i(i,klev+1-k)*fract(i)
     1360         ZFSUP0(i,k+1) = ZFCUP_i(i,klev+1-k)*fract(i)
     1361         ZFSUPC0(i,k+1)= ZFCCUP_i(i,klev+1-k)*fract(i)
     1362         ZFLDNC0(i,k+1)= -1.*ZFLCCDWN_i(i,klev+1-k)
     1363         ZFLUPC0(i,k+1)= ZFLCCUP_i(i,klev+1-k)
     1364         IF (ok_volcan) THEN
     1365            ZSWADAERO(i,k+1)=ZSWADAERO(i,klev+1-k)*fract(i) !--NL
     1366         ENDIF
     1367         
     1368!   Nouveau calcul car visiblement ZSWFT et ZSWFC sont nuls dans RRTM cy32
     1369!   en sortie de radlsw.F90 - MPL 7.01.09
     1370! AI ATTENTION
     1371!         ZSWFT(i,k+1)  = (ZFSDWN_i(i,k+1)-ZFSUP_i(i,k+1))*fract(i)
     1372!         ZSWFT0_i(i,k+1) = (ZFCDWN_i(i,k+1)-ZFCUP_i(i,k+1))*fract(i)
     1373!         ZLWFT(i,k+1) =-ZFLUX_i(i,2,k+1)-ZFLUX_i(i,1,k+1)
     1374!         ZLWFT0_i(i,k+1)=-ZFLUC_i(i,2,k+1)-ZFLUC_i(i,1,k+1)
     1375         ENDDO
     1376      ENDDO
     1377
     1378!--ajout OB
     1379      ZTOPSWADAERO(:) =ZTOPSWADAERO(:) *fract(:)
     1380      ZSOLSWADAERO(:) =ZSOLSWADAERO(:) *fract(:)
     1381      ZTOPSWAD0AERO(:)=ZTOPSWAD0AERO(:)*fract(:)
     1382      ZSOLSWAD0AERO(:)=ZSOLSWAD0AERO(:)*fract(:)
     1383      ZTOPSWAIAERO(:) =ZTOPSWAIAERO(:) *fract(:)
     1384      ZSOLSWAIAERO(:) =ZSOLSWAIAERO(:) *fract(:)
     1385      ZTOPSWCF_AERO(:,1)=ZTOPSWCF_AERO(:,1)*fract(:)
     1386      ZTOPSWCF_AERO(:,2)=ZTOPSWCF_AERO(:,2)*fract(:)
     1387      ZTOPSWCF_AERO(:,3)=ZTOPSWCF_AERO(:,3)*fract(:)
     1388      ZSOLSWCF_AERO(:,1)=ZSOLSWCF_AERO(:,1)*fract(:)
     1389      ZSOLSWCF_AERO(:,2)=ZSOLSWCF_AERO(:,2)*fract(:)
     1390      ZSOLSWCF_AERO(:,3)=ZSOLSWCF_AERO(:,3)*fract(:)
     1391
     1392! ---------
     1393! On renseigne les champs LMDz, pour avoir la meme chose qu'en sortie de
     1394! LW_LMDAR4 et SW_LMDAR4
     1395
     1396      !--fraction of diffuse radiation in surface SW downward radiation
     1397      DO i = 1, kdlon
     1398       IF (fract(i).GT.0.0) THEN
     1399         zdir=SUM(PSFSWDIR(i,:))
     1400         zdif=SUM(PSFSWDIF(i,:))
     1401         zsolswfdiff(i) = zdif/(zdir+zdif)
     1402       ELSE  !--night
     1403         zsolswfdiff(i) = 1.0
     1404       ENDIF
     1405      ENDDO
     1406!
     1407      DO i = 1, kdlon
     1408         zsolsw(i)    = ZSWFT(i,1)
     1409         zsolsw0(i)   = ZSWFT0_i(i,1)
     1410         ztopsw(i)    = ZSWFT(i,klev+1)
     1411         ztopsw0(i)   = ZSWFT0_i(i,klev+1)
     1412         zsollw(i)    = ZLWFT(i,1)
     1413         zsollw0(i)   = ZLWFT0_i(i,1)
     1414         ztoplw(i)    = ZLWFT(i,klev+1)*(-1)
     1415         ztoplw0(i)   = ZLWFT0_i(i,klev+1)*(-1)
     1416!         
     1417         zsollwdown(i)= -1.*ZFLDN(i,1)
     1418      ENDDO
     1419
     1420      DO k=1,kflev
     1421         DO i=1,kdlon
     1422           zheat(i,k)=(ZSWFT(i,k+1)-ZSWFT(i,k))*RDAY*RG/RCPD/PDP(i,k)
     1423           zheat0(i,k)=(ZSWFT0_i(i,k+1)-ZSWFT0_i(i,k))*RDAY*RG/RCPD/PDP(i,k)
     1424           zcool(i,k)=(ZLWFT(i,k)-ZLWFT(i,k+1))*RDAY*RG/RCPD/PDP(i,k)
     1425           zcool0(i,k)=(ZLWFT0_i(i,k)-ZLWFT0_i(i,k+1))*RDAY*RG/RCPD/PDP(i,k)
     1426           IF (ok_volcan) THEN
     1427              zheat_volc(i,k)=(ZSWADAERO(i,k+1)-ZSWADAERO(i,k))*RG/RCPD/PDP(i,k) !NL
     1428              zcool_volc(i,k)=(ZLWADAERO(i,k)-ZLWADAERO(i,k+1))*RG/RCPD/PDP(i,k) !NL
     1429           ENDIF
     1430         ENDDO
     1431      ENDDO
     1432#endif 
     1433  print*,'Fin traitement ECRAD'
     1434! Fin ECRAD
     1435  ENDIF        ! iflag_rrtm
     1436! ecrad
    10641437!======================================================================
    10651438
    … …  
    11021475          solswad_aero(iof+i) = zsolswadaero(i)
    11031476          solswad0_aero(iof+i) = zsolswad0aero(i)
    1104 ! MS the following lines seem to be wrong, why is iof on right hand side???
    1105 !          topsw_aero(iof+i,:) = ztopsw_aero(iof+i,:)
    1106 !          topsw0_aero(iof+i,:) = ztopsw0_aero(iof+i,:)
    1107 !          solsw_aero(iof+i,:) = zsolsw_aero(iof+i,:)
    1108 !          solsw0_aero(iof+i,:) = zsolsw0_aero(iof+i,:)
    11091477          topsw_aero(iof+i,:) = ztopsw_aero(i,:)
    11101478          topsw0_aero(iof+i,:) = ztopsw0_aero(i,:)
    … …  
    11711539 ENDDO ! j = 1, nb_gr
    11721540
     1541IF (lldebug) THEN
     1542 if (0.eq.1) then
     1543! Verifs dans le cas 1D
     1544 print*,'================== Sortie de radlw ================='
     1545 print*,'******** LW LW LW *******************'
     1546 print*,'ZLWFT =',ZLWFT
     1547 print*,'ZLWFT0_i =',ZLWFT0_i
     1548 print*,'ZFLUP0 =',ZFLUP0
     1549 print*,'ZFLDN0 =',ZFLDN0
     1550 print*,'ZFLDNC0 =',ZFLDNC0
     1551 print*,'ZFLUPC0 =',ZFLUPC0
     1552
     1553 print*,'******** SW SW SW *******************'
     1554 print*,'ZSWFT =',ZSWFT
     1555 print*,'ZSWFT0_i =',ZSWFT0_i
     1556 print*,'ZFSDN =',ZFSDN
     1557 print*,'ZFSDN0 =',ZFSDN0
     1558 print*,'ZFSDNC0 =',ZFSDNC0
     1559 print*,'ZFSUP =',ZFSUP
     1560 print*,'ZFSUP0 =',ZFSUP0
     1561 print*,'ZFSUPC0 =',ZFSUPC0
     1562
     1563 print*,'******** LMDZ  *******************'
     1564 print*,'cool = ', cool
     1565 print*,'heat = ', heat
     1566 print*,'topsw = ', topsw
     1567 print*,'toplw = ', toplw
     1568 print*,'sollw = ', sollw
     1569 print*,'solsw = ', solsw
     1570 print*,'lwdn = ', lwdn
     1571 print*,'lwup = ', lwup
     1572 print*,'swdn = ', swdn
     1573 print*,'swup =', swup
     1574 endif
     1575ENDIF
     1576
    11731577END SUBROUTINE radlwsw
    11741578

  • LMDZ6/branches/Ocean_skin/libf/phylmd/rrtm/recmwf_aero.F90

    r3605 r4013  
    3636 & PTOPLWAIAERO,PSOLLWAIAERO,&
    3737 & PLWADAERO,& !--NL
     38!--ajout volmip
     39 & volmip_solsw, flag_volc_surfstrat,&
    3840!..end
    3941 & ok_ade, ok_aie, ok_volcan, flag_aerosol,flag_aerosol_strat,&
    … …  
    259261REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFLCCDN(KPROMA,KLEV+1) ! LW clear sky clean (no aerosol) flux down
    260262REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFLCCUP(KPROMA,KLEV+1) ! LW clear sky clean (no aerosol) flux up
     263!--ajout VOLMIP
     264REAL(KIND=JPRB)   ,INTENT(OUT)   :: volmip_solsw(KPROMA) ! SW clear sky in the case of VOLMIP
     265INTEGER, INTENT(IN)              :: flag_volc_surfstrat !--VOlMIP Modif
    261266
    262267!     ==== COMPUTED IN RADITE ===
    … …  
    795800ENDIF
    796801
     802!--VolMIP Strat/Surf
     803!--only ok_ade + ok_aie case treated
     804IF (ok_ade.AND.ok_aie.AND.ok_volcan) THEN
     805   !--in this case the fluxes used for the heating rates come from case 4 but SW surface radiation is kept from case 2
     806   IF (flag_volc_surfstrat.EQ.2) THEN ! STRAT HEATING
     807      volmip_solsw(:)= ZFSDN_AERO(:,1,2)-ZFSUP_AERO(:,1,2)
     808   ELSEIF (flag_volc_surfstrat.EQ.1) THEN ! SURF COOLING
     809      !--in this case the fluxes used for the heating rates come from case 2 but SW surface radiation is kept from case 4
     810      PFSUP(:,:) =    ZFSUP_AERO(:,:,2)
     811      PFSDN(:,:) =    ZFSDN_AERO(:,:,2)
     812      PFSCUP(:,:) =   ZFSUP0_AERO(:,:,2)
     813      PFSCDN(:,:) =   ZFSDN0_AERO(:,:,2)
     814      PFLUX(:,1,:) =  LWUP_AERO(:,:,2)
     815      PFLUX(:,2,:) =  LWDN_AERO(:,:,2)
     816      PFLUC(:,1,:) =  LWDN0_AERO(:,:,2)
     817      PFLUC(:,2,:) =  LWDN0_AERO(:,:,2)
     818      volmip_solsw(:)= ZFSDN_AERO(:,1,4)-ZFSUP_AERO(:,1,4)
     819   ENDIF
     820ENDIF
     821!--End VolMIP Strat/Surf
     822
    797823IF (swaerofree_diag) THEN
    798824! copy shortwave clear-sky clean (no aerosol) case

  • LMDZ6/branches/Ocean_skin/libf/phylmd/soil.F90

    r2915 r4013  
    22! $Header$
    33!
    4 SUBROUTINE soil(ptimestep, indice, knon, snow, ptsrf, &
    5      ptsoil, pcapcal, pfluxgrd)
     4SUBROUTINE soil(ptimestep, indice, knon, snow, ptsrf, qsol, &
     5     lon, lat, ptsoil, pcapcal, pfluxgrd)
    66 
    77  USE dimphy
    … …  
    2121!                            the surface conduction flux pcapcal
    2222!
     23!   Update: 2021/07 : soil thermal inertia, formerly a constant value,
     24!   ------   can also be now a function of soil moisture (F Cheruy's idea)
     25!            depending on iflag_inertie, read from physiq.def via conf_phys_m.F90
     26!            ("Stage L3" Eve Rebouillat, with E Vignon, A Sima, F Cheruy)
    2327!
    2428!   Method: Implicit time integration
    … …  
    4852!   snow(klon)           snow
    4953!   ptsrf(klon)          surface temperature at time-step t (K)
     54!   qsol(klon)           soil moisture (kg/m2 or mm)
     55!   lon(klon)            longitude in radian
     56!   lat(klon)            latitude in radian
    5057!   ptsoil(klon,nsoilmx) temperature inside the ground (K)
    5158!   pcapcal(klon)        surfacic specific heat (W*m-2*s*K-1)
    … …  
    6067! ---------
    6168  REAL, INTENT(IN)                     :: ptimestep
    62   INTEGER, INTENT(IN)                  :: indice, knon
     69  INTEGER, INTENT(IN)                  :: indice, knon !, knindex
    6370  REAL, DIMENSION(klon), INTENT(IN)    :: snow
    6471  REAL, DIMENSION(klon), INTENT(IN)    :: ptsrf
    65  
     72  REAL, DIMENSION(klon), INTENT(IN)    :: qsol
     73  REAL, DIMENSION(klon), INTENT(IN)    :: lon
     74  REAL, DIMENSION(klon), INTENT(IN)    :: lat
     75
    6676  REAL, DIMENSION(klon,nsoilmx), INTENT(INOUT) :: ptsoil
    6777  REAL, DIMENSION(klon), INTENT(OUT)           :: pcapcal
    … …  
    182192!      knon, knindex, ztherm_i)
    183193  ELSE IF (indice == is_ter) THEN
     194     !
     195     ! La relation entre l'inertie thermique du sol et qsol change d'apres
     196     !   iflag_inertie, defini dans physiq.def, et appele via comsoil.h
     197     !
    184198     DO ig = 1, knon
    185         ztherm_i(ig)   = inertie_sol
     199        ! iflag_inertie=0 correspond au cas inertie=constant, comme avant
     200        IF (iflag_inertie==0) THEN         
     201           ztherm_i(ig)   = inertie_sol
     202        ELSE IF (iflag_inertie == 1) THEN
     203          ! I = a_qsol * qsol + b  modele lineaire deduit d'une
     204          ! regression lineaire I = a_mrsos * mrsos + b obtenue sur
     205          ! sorties MO d'une simulation LMDZOR(CMIP6) sur l'annee 2000
     206          ! sur tous les points avec frac_snow=0
     207          ! Difference entre qsol et mrsos prise en compte par un
     208          ! facteur d'echelle sur le coefficient directeur de regression:
     209          ! fact = 35./150. = mrsos_max/qsol_max
     210          ! et a_qsol = a_mrsos * fact (car a = dI/dHumidite)
     211            ztherm_i(ig) = 30.0 *35.0/150.0 *qsol(ig) +770.0
     212          ! AS : pour qsol entre 0 - 150, on a I entre 770 - 1820
     213        ELSE IF (iflag_inertie == 2) THEN
     214          ! deux regressions lineaires, sur les memes sorties, 
     215          ! distinguant le type de sol : sable ou autre (limons/argile)
     216          ! Implementation simple : regression type "sable" seulement pour
     217          ! Sahara, defini par une "boite" lat/lon (NB : en radians !! )
     218          IF (lon(ig)>-0.35 .AND. lon(ig)<0.70 .AND. lat(ig)>0.17 .AND. lat(ig)<0.52) THEN
     219              ! Valeurs theoriquement entre 728 et 2373 ; qsol valeurs basses
     220              ztherm_i(ig) = 47. *35.0/150.0 *qsol(ig) +728.  ! boite type "sable" pour Sahara
     221          ELSE
     222              ! Valeurs theoriquement entre 550 et 1940 ; qsol valeurs moyennes et hautes
     223              ztherm_i(ig) = 41. *35.0/150.0 *qsol(ig) +505.
     224          ENDIF
     225        ELSE IF (iflag_inertie == 3) THEN
     226          ! AS : idee a tester :
     227          ! si la relation doit etre une droite,
     228          ! definissons-la en fonction des valeurs min et max de qsol (0:150),
     229          ! et de l'inertie (900 : 2000 ou 2400 ; choix ici: 2000)
     230          ! I = I_min + qsol * (I_max - I_min)/(qsol_max - qsol_min)
     231              ztherm_i(ig) = 900. + qsol(ig) * (2000. - 900.)/150.
     232        ELSE         
     233          WRITE (lunout,*) "Le choix iflag_inertie = ",iflag_inertie," n'est pas defini. Veuillez choisir un entier entre 0 et 3"
     234        ENDIF
     235     !
     236     ! Fin de l'introduction de la relation entre l'inertie thermique du sol et qsol
     237     !-------------------------------------------
     238        !AS : donc le moindre flocon de neige sur un point de grid
     239        ! fait que l'inertie du point passe a la valeur pour neige !
    186240        IF (snow(ig) > 0.0) ztherm_i(ig)   = inertie_sno
     241       
    187242     ENDDO
    188243!    CALL iophys_ecrit_index('ztherm_ter', 1, 'ztherm_ter', 'USI', &

  • LMDZ6/branches/Ocean_skin/libf/phylmd/suphel.F90

    r3605 r4013  
    134134  retv = rv/rd - 1.
    135135  WRITE (UNIT=6, FMT='('' *** Thermodynamic, gas     ***'')')
    136   WRITE (UNIT=6, FMT='('' Perfect gas  = '',e13.7)') r
    137   WRITE (UNIT=6, FMT='('' Dry air mass = '',e13.7)') rmd
    138   WRITE (UNIT=6, FMT='('' Ozone   mass = '',e13.7)') rmo3
    139   WRITE (UNIT=6, FMT='('' CO2     mass = '',e13.7)') rmco2
    140   WRITE (UNIT=6, FMT='('' C       mass = '',e13.7)') rmc
    141   WRITE (UNIT=6, FMT='('' CH4     mass = '',e13.7)') rmch4
    142   WRITE (UNIT=6, FMT='('' N2O     mass = '',e13.7)') rmn2o
    143   WRITE (UNIT=6, FMT='('' CFC11   mass = '',e13.7)') rmcfc11
    144   WRITE (UNIT=6, FMT='('' CFC12   mass = '',e13.7)') rmcfc12
    145   WRITE (UNIT=6, FMT='('' Vapour  mass = '',e13.7)') rmv
    146   WRITE (UNIT=6, FMT='('' Dry air cst. = '',e13.7)') rd
    147   WRITE (UNIT=6, FMT='('' Vapour  cst. = '',e13.7)') rv
    148   WRITE (UNIT=6, FMT='(''         Cpd  = '',e13.7)') rcpd
    149   WRITE (UNIT=6, FMT='(''         Cvd  = '',e13.7)') rcvd
    150   WRITE (UNIT=6, FMT='(''         Cpv  = '',e13.7)') rcpv
    151   WRITE (UNIT=6, FMT='(''         Cvv  = '',e13.7)') rcvv
     136  WRITE (UNIT=6, FMT='('' Perfect gas  = '',e13.7,'' J mol-1 K-1'')') r
     137  WRITE (UNIT=6, FMT='('' Dry air mass = '',e13.7,'' g mol-1'')') rmd
     138  WRITE (UNIT=6, FMT='('' Ozone   mass = '',e13.7,'' g mol-1'')') rmo3
     139  WRITE (UNIT=6, FMT='('' CO2     mass = '',e13.7,'' g mol-1'')') rmco2
     140  WRITE (UNIT=6, FMT='('' C       mass = '',e13.7,'' g mol-1'')') rmc
     141  WRITE (UNIT=6, FMT='('' CH4     mass = '',e13.7,'' g mol-1'')') rmch4
     142  WRITE (UNIT=6, FMT='('' N2O     mass = '',e13.7,'' g mol-1'')') rmn2o
     143  WRITE (UNIT=6, FMT='('' CFC11   mass = '',e13.7,'' g mol-1'')') rmcfc11
     144  WRITE (UNIT=6, FMT='('' CFC12   mass = '',e13.7,'' g mol-1'')') rmcfc12
     145  WRITE (UNIT=6, FMT='('' Vapour  mass = '',e13.7,'' g mol-1'')') rmv
     146  WRITE (UNIT=6, FMT='('' Dry air cst. = '',e13.7,'' J K-1 kg-1'')') rd
     147  WRITE (UNIT=6, FMT='('' Vapour  cst. = '',e13.7,'' J K-1 kg-1'')') rv
     148  WRITE (UNIT=6, FMT='(''         Cpd  = '',e13.7,'' J K-1 kg-1'')') rcpd
     149  WRITE (UNIT=6, FMT='(''         Cvd  = '',e13.7,'' J K-1 kg-1'')') rcvd
     150  WRITE (UNIT=6, FMT='(''         Cpv  = '',e13.7,'' J K-1 kg-1'')') rcpv
     151  WRITE (UNIT=6, FMT='(''         Cvv  = '',e13.7,'' J K-1 kg-1'')') rcvv
    152152  WRITE (UNIT=6, FMT='(''      Rd/Cpd  = '',e13.7)') rkappa
    153153  WRITE (UNIT=6, FMT='(''     Rv/Rd-1  = '',e13.7)') retv
     154  WRITE (UNIT=6, FMT='(''        Rd/Rv = '',e13.7)') eps_w
    154155
    155156  ! ----------------------------------------------------------------
    … …  
    160161  rcw = rcpv
    161162  WRITE (UNIT=6, FMT='('' *** Thermodynamic, liquid  ***'')')
    162   WRITE (UNIT=6, FMT='(''         Cw   = '',E13.7)') rcw
     163  WRITE (UNIT=6, FMT='(''         Cw   = '',E13.7,'' J K-1 kg-1'')') rcw
    163164
    164165  ! ----------------------------------------------------------------
    … …  
    169170  rcs = rcpv
    170171  WRITE (UNIT=6, FMT='('' *** thermodynamic, solid   ***'')')
    171   WRITE (UNIT=6, FMT='(''         Cs   = '',E13.7)') rcs
     172  WRITE (UNIT=6, FMT='(''         Cs   = '',E13.7,'' J K-1 kg-1'')') rcs
    172173
    173174  ! ----------------------------------------------------------------
    … …  
    182183  ratm = 100000.
    183184  WRITE (UNIT=6, FMT='('' *** Thermodynamic, trans.  ***'')')
    184   WRITE (UNIT=6, FMT='('' Fusion point  = '',E13.7)') rtt
    185   WRITE (UNIT=6, FMT='(''        RLvTt  = '',E13.7)') rlvtt
    186   WRITE (UNIT=6, FMT='(''        RLsTt  = '',E13.7)') rlstt
    187   WRITE (UNIT=6, FMT='(''        RLMlt  = '',E13.7)') rlmlt
    188   WRITE (UNIT=6, FMT='('' Normal press. = '',E13.7)') ratm
     185  WRITE (UNIT=6, FMT='('' Fusion point  = '',E13.7,'' K'')') rtt
     186  WRITE (UNIT=6, FMT='(''        RLvTt  = '',E13.7,'' J kg-1'')') rlvtt
     187  WRITE (UNIT=6, FMT='(''        RLsTt  = '',E13.7,'' J kg-1'')') rlstt
     188  WRITE (UNIT=6, FMT='(''        RLMlt  = '',E13.7,'' J kg-1'')') rlmlt
     189  WRITE (UNIT=6, FMT='('' Normal press. = '',E13.7,'' Pa'')') ratm
    189190  WRITE (UNIT=6, FMT='('' Latent heat :  '')')
    190191
    … …  
    194195  ! --------------------------
    195196
    196   restt = 611.14
     197  restt = 611.14   !--saturation water vapour pressure at triple point (Pa)
    197198  rgamw = (rcw-rcpv)/rv
    198199  rbetw = rlvtt/rv + rgamw*rtt

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

    r2351 r4013  
    2424    USE cpl_mod
    2525    USE dimphy
    26     USE geometry_mod, ONLY: latitude
     26    USE geometry_mod, ONLY: longitude,latitude
    2727    USE mod_grid_phy_lmdz
    2828    USE mod_phys_lmdz_para
    … …  
    103103       
    104104! calculate temperature, heat capacity and conduction flux in soil
    105     IF (soil_model) THEN
    106        CALL soil(dtime, is_ter, knon, snow, tsurf, tsoil, soilcap, soilflux)
     105    IF (soil_model) THEN
     106       CALL soil(dtime, is_ter, knon, snow, tsurf, qsol,  &
     107        & longitude(knindex(1:knon)), latitude(knindex(1:knon)), tsoil, soilcap, soilflux)
     108
    107109       DO i=1, knon
    108110          cal(i) = RCPD / soilcap(i)

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

    r3798 r4013  
    1919       tsoil, z0m, z0h, SFRWL, alb_dir, alb_dif, evap, fluxsens, fluxlat, &
    2020       tsurf_new, dflux_s, dflux_l, &
    21        slope, cloudf, &
     21       alt, slope, cloudf, &
    2222       snowhgt, qsnow, to_ice, sissnow, &
    2323       alb3, runoff, &
    … …  
    2525
    2626    USE dimphy
    27     USE surface_data,     ONLY : type_ocean, calice, calsno, landice_opt, n_dtis
    28     USE fonte_neige_mod,  ONLY : fonte_neige, run_off_lic
     27    USE geometry_mod,     ONLY : longitude,latitude
     28    USE surface_data,     ONLY : type_ocean, calice, calsno, landice_opt, iflag_albcalc
     29    USE fonte_neige_mod,  ONLY : fonte_neige,run_off_lic,fqcalving_global,ffonte_global,fqfonte_global,runofflic_global
    2930    USE cpl_mod,          ONLY : cpl_send_landice_fields
    3031    USE calcul_fluxs_mod
    … …  
    3334    USE ioipsl_getin_p_mod, ONLY : getin_p
    3435
    35 #ifdef CPP_SISVAT
    36     USE surf_sisvat_mod,  ONLY : surf_sisvat
    37 #endif
    3836
    3937#ifdef CPP_INLANDSIS
    … …  
    7573    REAL, DIMENSION(klon), INTENT(IN)             :: albedo  !mean albedo
    7674    REAL, DIMENSION(klon), INTENT(IN)             :: pphi1   
     75    REAL, DIMENSION(klon), INTENT(IN)             :: alt   !mean altitude of the grid box 
    7776    REAL, DIMENSION(klon), INTENT(IN)             :: slope   !mean slope in grid box 
    7877    REAL, DIMENSION(klon), INTENT(IN)             :: cloudf  !total cloud fraction
    … …  
    115114    REAL, DIMENSION(klon)    :: u0, v0, u1_lay, v1_lay, ustar
    116115    INTEGER                  :: i,j,nt
    117 
     116    REAL, DIMENSION(klon)    :: fqfonte,ffonte
    118117    REAL, DIMENSION(klon)    :: emis_new                  !Emissivity
    119118    REAL, DIMENSION(klon)    :: swdown,lwdown
    120     REAL, DIMENSION(klon)    :: precip_snow_adv, snow_adv !Snow Drift precip./advection
    121     REAL, DIMENSION(klon)    :: zsl_height, wind_velo      !surface layer height, wind spd
     119    REAL, DIMENSION(klon)    :: precip_snow_adv, snow_adv !Snow Drift precip./advection (not used in inlandsis)
     120    REAL, DIMENSION(klon)    :: erod                      !erosion of surface snow (flux, kg/m2/s like evap)
     121    REAL, DIMENSION(klon)    :: zsl_height, wind_velo     !surface layer height, wind spd
    122122    REAL, DIMENSION(klon)    :: dens_air,  snow_cont_air  !air density; snow content air
    123123    REAL, DIMENSION(klon)    :: alb_soil                  !albedo of underlying ice
    … …  
    132132
    133133
    134 !albedo SB >>>
    135     real,dimension(klon) :: alb1,alb2
    136 !albedo SB <<<
    137 
     134    REAL,DIMENSION(klon) :: alb1,alb2
     135    REAL, DIMENSION (klon,6) :: alb6
    138136! End definition
    139137!****************************************************************************************
    … …  
    179177!****************************************************************************************
    180178!  landice_opt = 0 : soil_model, calcul_flux, fonte_neige, ... 
    181 !  landice_opt = 1  : prepare and call SISVAT snow model
    182 !  landice_opt = 2  : prepare and call INLANDSIS snow model
     179!  landice_opt = 1  : prepare and call INterace Lmdz SISvat (INLANDSIS)
    183180!****************************************************************************************
    184181
    185182
    186183    IF (landice_opt .EQ. 1) THEN
    187    
    188 !****************************************************************************************
    189 ! CALL to SISVAT interface
    190 !****************************************************************************************
    191 
    192 #ifdef CPP_SISVAT
    193        ! Prepare for calling SISVAT
    194        
    195        ! Calculate incoming flux for SW and LW interval: swdown, lwdown
    196        swdown(:)        = 0.0
    197        lwdown(:)        = 0.0
    198        DO i = 1, knon
    199           swdown(i)        = swnet(i)/(1-albedo(i))
    200           lwdown(i)        = lwdownm(i)
    201        END DO
    202        
    203        ! Set constants and compute some input for SISVAT
    204        snow_adv(:)      = 0.                          ! no snow blown in for now
    205        snow_cont_air(:) = 0.       
    206        alb_soil(:)      = albedo(:)
    207        pref             = 100000.                     ! = 1000 hPa
    208        DO i = 1, knon
    209           wind_velo(i)     = u1(i)**2 + v1(i)**2
    210           wind_velo(i)     = wind_velo(i)**0.5
    211           pexner(i)        = (p1lay(i)/pref)**(RD/RCPD)
    212           dens_air(i)      = p1lay(i)/RD/temp_air(i)  ! dry air density
    213           zsl_height(i)     = pphi1(i)/RG             
    214        END DO
    215 
    216 
    217        ! config: compute everything with SV but temperatures afterwards with soil/calculfluxs
    218        DO i = 1, knon
    219           tsoil0(i,:)=tsoil(i,:)
    220        END DO
    221            ! Martin
    222            PRINT*, 'on appelle surf_sisvat'
    223            ! Martin
    224        CALL surf_sisvat(knon, rlon, rlat, knindex, itime, dtime, debut, lafin, &
    225             rmu0, swdown, lwdown, pexner, ps, p1lay, &
    226             precip_rain, precip_snow, precip_snow_adv, snow_adv, &
    227             zsl_height, wind_velo, temp_air, dens_air, spechum, tsurf, &
    228             rugoro, snow_cont_air, alb_soil, slope, cloudf, &
    229             radsol, qsol, tsoil0, snow, snowhgt, qsnow, to_ice,sissnow, agesno, &
    230             AcoefH, AcoefQ, BcoefH, BcoefQ, cdragh, &
    231             run_off_lic, evap, fluxsens, fluxlat, dflux_s, dflux_l, &       
    232             tsurf_new, alb1, alb2, alb3, &
    233             emis_new, z0m, qsurf)
    234        z0h(1:knon)=z0m(1:knon) ! en attendant mieux
    235        
    236        ! Suppose zero surface speed
    237        u0(:)            = 0.0
    238        v0(:)            = 0.0
    239        ! The calculation of heat/water fluxes, otherwise done by "CALL calcul_fluxs" is
    240        ! integrated in SISVAT, using the same method. It can be found in "sisvat.f", in the
    241        ! subroutine "SISVAT_TS2".
    242        ! u0, v0=0., dif_grnd=0. and beta=1 are assumed there!
    243        
    244        CALL calcul_flux_wind(knon, dtime, &
    245             u0, v0, u1, v1, gustiness, cdragm, &
    246             AcoefU, AcoefV, BcoefU, BcoefV, &
    247             p1lay, temp_air, &
    248             flux_u1, flux_v1)
    249 #else
    250        abort_message='Pb de coherence: landice_opt = 1 mais CPP_SISVAT = .false.'
    251        CALL abort_physic(modname,abort_message,1)
    252 #endif
    253 
    254 !****************************************************************************************
     184
     185!****************************************************************************************   
    255186! CALL to INLANDSIS interface
    256187!****************************************************************************************
    257 
    258     ELSE IF (landice_opt .EQ. 2) THEN
    259188#ifdef CPP_INLANDSIS
    260189
    … …  
    278207       swdown(:)        = 0.0
    279208       lwdown(:)        = 0.0
    280        snow_adv(:)      = 0.  ! no snow blown in for now
    281        snow_cont_air(:) = 0.       
     209       snow_cont_air(:) = 0.  ! the snow content in air is not a prognostic variable of the model     
    282210       alb_soil(:)      = 0.4 ! before albedo(:) but here it is the ice albedo that we have to set
    283211       ustar(:)         = 0.
    … …  
    296224       
    297225
    298        ! Subtimestepping
    299        
    300         dtis=dtime/n_dtis
    301 
    302         DO nt=1,n_dtis
    303 
    304           IF (lafin .and. nt.eq.n_dtis) THEN
     226
     227        dtis=dtime
     228
     229          IF (lafin) THEN
    305230            lafin_is=.true.
    306231          END IF
    307232
    308         !PRINT*,'RENTRE DANS INLANDSIS','itime',itime,'dtime',dtime,'dtis',dtis
    309         CALL surf_inlandsis(knon, rlon, rlat, knindex, itime, dtis, debut_is, lafin_is, &
    310             rmu0, swdown, lwdown, albedo, pexner, ps, p1lay, &
    311             precip_rain, precip_snow, precip_snow_adv, snow_adv, &
    312             zsl_height, wind_velo, ustar, temp_air, dens_air, spechum, tsurf, &
    313             rugoro, snow_cont_air, alb_soil, slope, cloudf, &
    314             radsol, qsol, tsoil0, snow, zfra, snowhgt, qsnow, to_ice,sissnow, agesno, &
     233          CALL surf_inlandsis(knon, rlon, rlat, knindex, itime, dtis, debut_is, lafin_is,&
     234            rmu0, swdown, lwdown, albedo, pexner, ps, p1lay, precip_rain, precip_snow,   &
     235            zsl_height, wind_velo, ustar, temp_air, dens_air, spechum, tsurf,&
     236            rugoro, snow_cont_air, alb_soil, alt, slope, cloudf, &
     237            radsol, qsol, tsoil0, snow, zfra, snowhgt, qsnow, to_ice, sissnow,agesno,   &
    315238            AcoefH, AcoefQ, BcoefH, BcoefQ, cdragm, cdragh, &
    316             run_off_lic, evap, fluxsens, fluxlat, dflux_s, dflux_l, &       
    317             tsurf_new, alb1, alb2, alb3, &
    318             emis_new, z0m, z0h, qsurf)     
    319 
    320          debut_is=.false.
    321 
    322         END DO
     239            run_off_lic, fqfonte, ffonte, evap, erod, fluxsens, fluxlat,dflux_s, dflux_l, &
     240            tsurf_new, alb1, alb2, alb3, alb6, &
     241            emis_new, z0m, z0h, qsurf)
     242
     243          debut_is=.false.
     244
     245
     246        ! Treatment of snow melting and calving
     247
     248        ! for consistency with standard LMDZ, add calving to run_off_lic
     249        run_off_lic(:)=run_off_lic(:) + to_ice(:)
     250
     251        DO i = 1, knon
     252           ffonte_global(knindex(i),is_lic)    = ffonte(i)
     253           fqfonte_global(knindex(i),is_lic)   = fqfonte(i)! net melting= melting - refreezing
     254           fqcalving_global(knindex(i),is_lic) = to_ice(i) ! flux
     255           runofflic_global(knindex(i)) = run_off_lic(i)
     256        ENDDO
     257        ! Here, we assume that the calving term is equal to the to_ice term
     258        ! (no ice accumulation)
    323259
    324260
    325261#else
    326        abort_message='Pb de coherence: landice_opt = 2 mais CPP_INLANDSIS = .false.'
     262       abort_message='Pb de coherence: landice_opt = 1 mais CPP_INLANDSIS = .false.'
    327263       CALL abort_physic(modname,abort_message,1)
    328264#endif
    … …  
    343279    ! use soil model and recalculate properly cal
    344280    IF (soil_model) THEN
    345        CALL soil(dtime, is_lic, knon, snow, tsurf, tsoil, soilcap, soilflux)
     281       CALL soil(dtime, is_lic, knon, snow, tsurf, qsol, &
     282        & longitude(knindex(1:knon)), latitude(knindex(1:knon)), tsoil, soilcap, soilflux)
    346283       cal(1:knon) = RCPD / soilcap(1:knon)
    347284       radsol(1:knon)  = radsol(1:knon) + soilflux(1:knon)
    … …  
    420357
    421358
    422 
    423    
    424 
    425359    END IF ! landice_opt
    426360
    … …  
    428362!****************************************************************************************
    429363! Send run-off on land-ice to coupler if coupled ocean.
    430 ! run_off_lic has been calculated in fonte_neige or surf_sisvat
     364! run_off_lic has been calculated in fonte_neige or surf_inlandsis
    431365!
    432366!****************************************************************************************
    … …  
    476410       alb_dir(1:knon,5)=alb2(1:knon)
    477411       alb_dir(1:knon,6)=alb2(1:knon)
     412
     413       IF ((landice_opt .EQ. 1) .AND. (iflag_albcalc .EQ. 2)) THEN
     414       alb_dir(1:knon,1)=alb6(1:knon,1)
     415       alb_dir(1:knon,2)=alb6(1:knon,2)
     416       alb_dir(1:knon,3)=alb6(1:knon,3)
     417       alb_dir(1:knon,4)=alb6(1:knon,4)
     418       alb_dir(1:knon,5)=alb6(1:knon,5)
     419       alb_dir(1:knon,6)=alb6(1:knon,6)
     420       ENDIF
     421
    478422     end select
    479423alb_dif=alb_dir
    480424!albedo SB <<<
    481425
    482 
    483 
     426 
     427 
    484428
    485429  END SUBROUTINE surf_landice

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

    r3797 r4013  
    5656    REAL, DIMENSION(klon), INTENT(IN)        :: rmu0 
    5757    REAL, DIMENSION(klon), INTENT(IN)        :: fder
    58     REAL, INTENT(IN):: tsurf_in(klon) ! defined only for subscripts 1:knon
     58    REAL, DIMENSION(klon), INTENT(IN)        :: tsurf_in    ! defined only for subscripts 1:knon
    5959    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay,z1lay ! pression (Pa) et altitude (m) du premier niveau
    6060    REAL, DIMENSION(klon), INTENT(IN)        :: cdragh
    … …  
    7474    REAL, DIMENSION(klon), INTENT(INOUT)     :: qsurf
    7575    REAL, DIMENSION(klon), INTENT(INOUT)     :: agesno
    76     REAL, DIMENSION(klon), INTENT(inOUT):: z0h
     76    REAL, DIMENSION(klon), INTENT(inOUT)     :: z0h
    7777
    7878    REAL, intent(inout):: delta_sst(:) ! (knon)
    … …  
    9898    REAL, DIMENSION(klon), INTENT(OUT)       :: z0m
    9999    !albedo SB >>>
    100     !    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new  ! new albedo in visible SW interval
    101     !    REAL, DIMENSION(klon), INTENT(OUT)       :: alb2_new  ! new albedo in near IR interval
    102     REAL, DIMENSION(6), INTENT(IN)          :: SFRWL
    103     REAL, DIMENSION(klon,nsw), INTENT(OUT)       :: alb_dir_new,alb_dif_new
     100    !    REAL, DIMENSION(klon), INTENT(OUT)  :: alb1_new  ! new albedo in visible SW interval
     101    !    REAL, DIMENSION(klon), INTENT(OUT)  :: alb2_new  ! new albedo in near IR interval
     102    REAL, DIMENSION(6), INTENT(IN)           :: SFRWL
     103    REAL, DIMENSION(klon,nsw), INTENT(OUT)   :: alb_dir_new,alb_dif_new
    104104    !albedo SB <<<     
    105105    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
    106     REAL, INTENT(OUT):: tsurf_new(klon) ! sea surface temperature, in K
     106    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new    ! sea surface temperature, in K
    107107    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
    108108    REAL, DIMENSION(klon), INTENT(OUT)       :: lmt_bils

  • LMDZ6/branches/Ocean_skin/libf/phylmd/surface_data.F90

    r3798 r4013  
    2929  ! FOR INLANDSIS:
    3030  !===============
    31 
    32    INTEGER, SAVE          :: landice_opt       ! 1 for coupling with SISVAT, 2 for coupling with INLANDSIS
     31 
     32   ! 1 for coupling with INLANDSIS
     33   INTEGER, SAVE          :: landice_opt   ! 1 for coupling with INLANDSIS
    3334  !$OMP THREADPRIVATE(landice_opt)
    3435
    35    INTEGER, SAVE          :: iflag_tsurf_inlandsis ! 0 SISVAT method, 1 LMDZ method
    36   !$OMP THREADPRIVATE(iflag_tsurf_inlandsis)
     36  ! temperature calculation options within the soil and at the surface
     37   INTEGER, SAVE          :: iflag_tsurf_inlandsis,iflag_temp_inlandsis
     38   !$OMP THREADPRIVATE(iflag_tsurf_inlandsis,iflag_temp_inlandsis)
    3739
    38    INTEGER, SAVE          :: iflag_albzenith ! dependency of albedo to zenith angle
    39   !$OMP THREADPRIVATE(iflag_albzenith) 
    40 
    41    INTEGER, SAVE          :: n_dtis           ! number of subtimesteps for INLANDSIS
    42   !$OMP THREADPRIVATE(n_dtis)
     40  ! flags for albedo and roughness calc.
     41   INTEGER, SAVE          :: iflag_albcalc,iflag_z0m_snow
     42  !$OMP THREADPRIVATE(iflag_albcalc,iflag_z0m_snow) 
    4343
    4444  ! with or without snow module/ blowing snow, ascii outfile
    45    LOGICAL, SAVE           :: SnoMod,BloMod,ok_outfor
     45   LOGICAL, SAVE          :: SnoMod,BloMod,ok_outfor
    4646  !$OMP THREADPRIVATE(SnoMod,BloMod,ok_outfor)   
    4747
     48  ! activate slush, korlyakov snow density, RN z0h calc.
     49   LOGICAL, SAVE          :: is_ok_slush,is_ok_density_kotlyakov,is_ok_z0h_rn
     50  !$OMP THREADPRIVATE(is_ok_slush,is_ok_density_kotlyakov,is_ok_z0h_rn)
     51
     52  ! activate detection snow/ice layers and option XF discrtet/option runoff AC
     53   LOGICAL, SAVE          :: ok_zsn_ii,discret_xf,opt_runoff_ac
     54  !$OMP THREADPRIVATE(ok_zsn_ii,discret_xf, opt_runoff_ac)
     55
     56  ! value of z0m snow when prescribed and albedo correction term
     57   REAL, SAVE             :: prescribed_z0m_snow,correc_alb
     58  !$OMP THREADPRIVATE(prescribed_z0m_snow, correc_alb)
     59
     60  ! value of sphericity [0-99] and snow grain size [e-4m] for polar buffer snow
     61  ! layer
     62   REAL, SAVE             :: buf_sph_pol,buf_siz_pol
     63  !$OMP THREADPRIVATE(buf_sph_pol,buf_siz_pol)
     64
     65
     66
    4867END MODULE surface_data

  • LMDZ6/branches/Ocean_skin/libf/phylmd/tracco2i_mod.F90

    r3798 r4013  
    3434    USE carbon_cycle_mod, ONLY: id_CO2, nbcf_in, fields_in, cfname_in
    3535    USE carbon_cycle_mod, ONLY: fco2_ocn_day, fco2_ff, fco2_bb, fco2_land, fco2_ocean
     36    USE carbon_cycle_mod, ONLY: read_fco2_ocean_cor,var_fco2_ocean_cor,fco2_ocean_cor
     37    USE carbon_cycle_mod, ONLY: read_fco2_land_cor,var_fco2_land_cor,fco2_land_cor
     38    USE carbon_cycle_mod, ONLY: co2_send
    3639    USE carbon_cycle_mod, ONLY: fco2_land_nbp, fco2_land_nep, fco2_land_fLuc
    3740    USE carbon_cycle_mod, ONLY: fco2_land_fwoodharvest, fco2_land_fHarvest
    3841    USE carbon_cycle_mod, ONLY: carbon_cycle_cpl, carbon_cycle_tr, carbon_cycle_rad, RCO2_glo, RCO2_tot
     42    USE carbon_cycle_mod, ONLY: ocean_area_tot
     43    USE carbon_cycle_mod, ONLY: land_area_tot
    3944    USE mod_grid_phy_lmdz
    4045    USE mod_phys_lmdz_mpi_data, ONLY: is_mpi_root
    4146    USE mod_phys_lmdz_para, ONLY: gather, bcast, scatter
     47    USE mod_phys_lmdz_omp_data, ONLY: is_omp_root
    4248    USE phys_cal_mod
    4349    USE phys_state_var_mod, ONLY: pctsrf
    … …  
    7581    REAL, DIMENSION(klon_glo,klev) :: co2_glo   ! variable temporaire sur la grille global
    7682    REAL, DIMENSION(klon_glo,klev) :: m_air_glo ! variable temporaire sur la grille global
     83    REAL, DIMENSION(klon_glo,nbsrf):: pctsrf_glo      !--fractions de maille sur la grille globale
     84    REAL, DIMENSION(klon_glo)      :: pctsrf_ter_glo
     85    REAL, DIMENSION(klon_glo)      :: pctsrf_oce_glo
     86    REAL, DIMENSION(klon_glo)      :: pctsrf_sic_glo
     87    REAL, DIMENSION(klon_glo)      :: cell_area_glo   !--aire des mailles sur la grille globale
    7788
    7889    LOGICAL, SAVE :: check_fCO2_nbp_in_cfname
    … …  
    8091    INTEGER, SAVE :: day_pre=-1
    8192!$OMP THREADPRIVATE(day_pre)
     93
     94    REAL, PARAMETER :: secinday=86400.
    8295
    8396    IF (is_mpi_root) THEN
    … …  
    100113        IF (cfname_in(nb)=="fCO2_nbp") check_fCO2_nbp_in_cfname=.TRUE.
    101114      ENDDO
     115
     116      CALL gather(pctsrf,pctsrf_glo)
     117      CALL gather(pctsrf(:,is_ter),pctsrf_ter_glo)
     118      CALL gather(pctsrf(:,is_oce),pctsrf_oce_glo)
     119      CALL gather(pctsrf(:,is_sic),pctsrf_sic_glo)
     120      CALL gather(cell_area(:),cell_area_glo)
    102121
    103122    ENDIF
    … …  
    146165    ENDDO
    147166
     167    PRINT *, 'tracco2i_mod.F90 --- read_fco2_ocean_cor ',read_fco2_ocean_cor
     168    PRINT *, 'tracco2i_mod.F90 --- read_fco2_land_cor ',read_fco2_land_cor
     169
     170IF (debutphy) THEN
     171
     172    IF (read_fco2_ocean_cor) THEN
     173!$OMP MASTER
     174       IF (is_mpi_root .AND. is_omp_root) THEN
     175          ocean_area_tot=0.
     176          PRINT *, 'tracco2i_mod.F90 --- var_fco2_ocean_cor (PgC/yr) ',var_fco2_ocean_cor
     177          DO i=1, klon_glo
     178             ocean_area_tot = ocean_area_tot + (pctsrf_oce_glo(i)+pctsrf_sic_glo(i))*cell_area_glo(i)
     179          ENDDO
     180      ENDIF !--is_mpi_root and is_omp_root
     181!$OMP END MASTER
     182      CALL bcast(ocean_area_tot)
     183     PRINT *, 'tracco2i_mod.F90 --- ocean_area_tot (debutphy) ',ocean_area_tot
     184    ENDIF
     185
     186    IF (read_fco2_land_cor) THEN
     187!$OMP MASTER
     188       IF (is_mpi_root .AND. is_omp_root) THEN
     189          land_area_tot=0.
     190          PRINT *, 'tracco2i_mod.F90 --- var_fco2_land_cor (PgC/yr) ',var_fco2_land_cor
     191          DO i=1, klon_glo
     192             land_area_tot = land_area_tot + pctsrf_ter_glo(i)*cell_area_glo(i)
     193          ENDDO
     194      ENDIF !--is_mpi_root and is_omp_root
     195!$OMP END MASTER
     196      CALL bcast(land_area_tot)
     197     PRINT *, 'tracco2i_mod.F90 --- land_area_tot (debutphy) ',land_area_tot
     198ENDIF
     199
     200    ENDIF !-- debutphy 
     201
     202    PRINT *, 'tracco2i_mod.F90 --- ocean_area_tot (m2) ',ocean_area_tot
     203    PRINT *, 'tracco2i_mod.F90 --- land_area_tot (m2) ',land_area_tot
     204
     205    IF (read_fco2_ocean_cor) THEN
     206! var_fco2_ocean_cor: correction of the surface downward CO2 flux into the ocean fgco2 (PgC/yr)
     207! This is the correction of the the net air to ocean carbon flux. Positive flux is into the ocean.
     208!    PRINT *, 'tracco2i_mod.F90 --- var_fco2_ocean_cor (PgC/yr) ',var_fco2_ocean_cor
     209
     210!var_fco2_ocean_cor: correction of the net air to ocean carbon flux (input data is a scalar in PgC/yr and must be converted in kg CO2 m-2 s-1)
     211
     212! Factors for carbon and carbon dioxide
     213! 1 mole CO2 = 44.009 g CO2 = 12.011 g C
     214! 1 ppm by volume of atmosphere CO2 = 2.13 Gt C
     215! 1 gC = 44.009/12.011 gCO2
     216
     217! ocean_area_tot: ocean area (m2)
     218
     219! year_len: year length (in days)
     220
     221! conversion: PgC/yr --> kg CO2 m-2 s-1
     222! fco2_ocean_cor  / (86400.*year_len): PgC/yr to PgC/s
     223! fco2_ocean_cor  / (86400.*year_len)*(pctsrf(i,is_oce)+pctsrf(i,is_sic))/ocean_area_tot: PgC/s to PgC/s/m2
     224! (fco2_ocean_cor / (86400.*year_len)*(pctsrf(i,is_oce)+pctsrf(i,is_sic))/ocean_area_tot) *1e12: PgC/s/m2 to kgC/s/m2
     225! (fco2_ocean_cor / (86400.*year_len)*(pctsrf(i,is_oce)+pctsrf(i,is_sic))/ocean_area_tot) * 1e12 * (RMCO2/RMC): kgC/s/m2 to kgCO2/s/m2
     226
     227      DO i=1, klon 
     228          fco2_ocean_cor(i)=(var_fco2_ocean_cor*(RMCO2/RMC)*(pctsrf(i,is_oce)+pctsrf(i,is_sic))/ocean_area_tot/(secinday*year_len))*1.e12
     229      ENDDO
     230
     231      PRINT *, 'tracco2i_mod.F90 --- MINVAL(fco2_ocean_cor) ',MINVAL(fco2_ocean_cor)
     232      PRINT *, 'tracco2i_mod.F90 --- MAXVAL(fco2_ocean_cor) ',MAXVAL(fco2_ocean_cor)
     233
     234    ELSE
     235    fco2_ocean_cor(:)=0.
     236    ENDIF
     237
     238    IF (read_fco2_land_cor) THEN
     239! var_fco2_land_cor: correction of the carbon Mass Flux out of Atmosphere Due to Net Biospheric Production on Land  (PgC/yr)
     240! This is the correction of the net mass flux of carbon between land and atmosphere calculated as
     241! photosynthesis MINUS the sum of plant and soil respiration, carbon fluxes from
     242! fire, harvest, grazing and land use change. Positive flux is into the land.
     243!    PRINT *, 'tracco2i_mod.F90 --- var_fco2_land_cor (m2) ',var_fco2_land_cor
     244
     245!var_fco2_land_cor: correction of the et air to land carbon flux (input data is a scalar in PgC/yr and must be converted in kg CO2 m-2 s-1)
     246
     247! Factors for carbon and carbon dioxide
     248! 1 mole CO2 = 44.009 g CO2 = 12.011 g C
     249! 1 ppm by volume of atmosphere CO2 = 2.13 Gt C
     250! 1 gC = 44.009/12.011 gCO2
     251
     252! land_area_tot: land area (m2)
     253
     254! year_len: year length (in days)
     255
     256! conversion: PgC/yr --> kg CO2 m-2 s-1
     257! fco2_land_cor  / (86400.*year_len): PgC/yr to PgC/s
     258! fco2_land_cor  / (86400.*year_len)*pctsrf(i,is_ter)/land_area_tot: PgC/s to PgC/s/m2
     259! (fco2_land_cor / (86400.*year_len)*pctsrf(i,is_ter)/land_area_tot) *1e12: PgC/s/m2 to kgC/s/m2
     260! (fco2_land_cor / (86400.*year_len)*pctsrf(i,is_ter)/land_area_tot) * 1e12 * (RMCO2/RMC): kgC/s/m2 to kgCO2/s/m2
     261
     262      DO i=1, klon
     263         fco2_land_cor(i)=var_fco2_land_cor*RMCO2/RMC*pctsrf(i,is_ter)/land_area_tot/(secinday*year_len)*1.e12
     264      ENDDO
     265
     266      PRINT *, 'tracco2i_mod.F90 --- MINVAL(fco2_land_cor) ',MINVAL(fco2_land_cor)
     267      PRINT *, 'tracco2i_mod.F90 --- MAXVAL(fco2_land_cor) ',MAXVAL(fco2_land_cor)
     268
     269    ELSE
     270      fco2_land_cor(:)=0.
     271    ENDIF
     272
    148273!--if fCO2_nbp is transferred we use it, otherwise we use the sum of what has been passed from ORCHIDEE
    149274    IF (check_fCO2_nbp_in_cfname)  THEN
    … …  
    167292!
    168293!--build final source term for CO2
    169     source(:,id_CO2)=fco2_ff(:)+fco2_bb(:)+fco2_land(:)+fco2_ocean(:)
     294    source(:,id_CO2)=fco2_ff(:)+fco2_bb(:)+fco2_land(:)+fco2_ocean(:)-fco2_ocean_cor(:)-fco2_land_cor(:)
    170295
    171296!--computing global mean CO2 for radiation
    … …  
    195320    ENDIF
    196321
     322    PRINT *, 'tracco2i_mod.F90 --- MINVAL(tr_seri(:,1,id_CO2)*1.e6*RMD/RMCO2): L1: ',MINVAL(tr_seri(:,1,id_CO2)*1.e6*RMD/RMCO2)
     323    PRINT *, 'tracco2i_mod.F90 --- MAXVAL(tr_seri(:,1,id_CO2)*1.e6*RMD/RMCO2): L1: ',MAXVAL(tr_seri(:,1,id_CO2)*1.e6*RMD/RMCO2)
     324
     325    PRINT *, 'tracco2i_mod.F90 --- MINVAL(tr_seri(:,79,id_CO2)*1.e6*RMD/RMCO2): L79: ',MINVAL(tr_seri(:,79,id_CO2)*1.e6*RMD/RMCO2)
     326    PRINT *, 'tracco2i_mod.F90 --- MAXVAL(tr_seri(:,79,id_CO2)*1.e6*RMD/RMCO2): L79: ',MAXVAL(tr_seri(:,79,id_CO2)*1.e6*RMD/RMCO2)
     327
     328    co2_send(:) = tr_seri(:,1,id_CO2)*1.e6*RMD/RMCO2
     329
     330    PRINT *, 'tracco2i_mod.F90 --- MINVAL(co2_send) ',MINVAL(co2_send)
     331    PRINT *, 'tracco2i_mod.F90 --- MAXVAL(co2_send) ',MAXVAL(co2_send)
     332
    197333  END SUBROUTINE tracco2i
    198334
    … …  
    252388      IF (readco2ff) THEN
    253389
    254         ! ... Open the COZff file
     390        ! ... Open the CO2ff file
    255391        CALL nf95_open("sflx_lmdz_co2_ff.nc", nf90_nowrite, ncid_in)
    256392

  • LMDZ6/branches/Ocean_skin/libf/phylmd/wx_pbl_mod.F90

    r3181 r4013  
    11MODULE wx_pbl_mod
    22!
    3 ! Planetary Boundary Layer and Surface module
    4 !
    5 ! This module manage the calculation of turbulent diffusion in the boundary layer
    6 ! and all interactions towards the differents sub-surfaces.
    7 !
     3! Split Planetary Boundary Layer
     4!
     5! This module manages the splitting of the boundary layer between two regions; the (w)
     6! region (inside cold pools) and the (x) region (outside cold pools)
    87!
    98  USE dimphy
    … …  
    1110  IMPLICIT NONE
    1211
    13   REAL, ALLOCATABLE, DIMENSION(:), SAVE        :: Kech_Tp, Kech_T_xp, Kech_T_wp
    14   REAL, ALLOCATABLE, DIMENSION(:), SAVE        :: dd_KTp, KxKwTp, dd_AT, dd_BT
    15 !$OMP THREADPRIVATE(Kech_Tp, Kech_T_xp, Kech_T_wp, dd_KTp, KxKwTp, dd_AT, dd_BT)
    16   REAL, ALLOCATABLE, DIMENSION(:), SAVE        :: Kech_Qp, Kech_Q_xp, Kech_Q_wp
    17   REAL, ALLOCATABLE, DIMENSION(:), SAVE        :: dd_KQp, KxKwQp, dd_AQ, dd_BQ
    18 !$OMP THREADPRIVATE(Kech_Qp, Kech_Q_xp, Kech_Q_wp, dd_KQp, KxKwQp, dd_AQ, dd_BQ)
    19   REAL, ALLOCATABLE, DIMENSION(:), SAVE        :: Kech_Up, Kech_U_xp, Kech_U_wp
    20   REAL, ALLOCATABLE, DIMENSION(:), SAVE        :: dd_KUp, KxKwUp, dd_AU, dd_BU
    21 !$OMP THREADPRIVATE(Kech_Up, Kech_U_xp, Kech_U_wp, dd_KUp, KxKwUp, dd_AU, dd_BU)
    22   REAL, ALLOCATABLE, DIMENSION(:), SAVE        :: Kech_Vp, Kech_V_xp, Kech_V_wp
    23   REAL, ALLOCATABLE, DIMENSION(:), SAVE        :: dd_KVp, KxKwVp, dd_AV, dd_BV
    24 !$OMP THREADPRIVATE(Kech_Vp, Kech_V_xp, Kech_V_wp, dd_KVp, KxKwVp, dd_AV, dd_BV)
    25 
    2612CONTAINS
    2713!
    2814!****************************************************************************************
    2915!
    30 SUBROUTINE wx_pbl_init
    31 
    32 ! Local variables
    33 !****************************************************************************************
    34     INTEGER                       :: ierr
    35  
    36 
    37 !****************************************************************************************
    38 ! Allocate module variables
    39 !
    40 !****************************************************************************************   
    41 
    42     ierr = 0
    43 
    44     ALLOCATE(Kech_Tp(klon), stat=ierr)
    45     IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
    46 
    47     ALLOCATE(Kech_T_xp(klon), stat=ierr)
    48     IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
    49 
    50     ALLOCATE(Kech_T_wp(klon), stat=ierr)
    51     IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
    52 
    53     ALLOCATE(dd_KTp(klon), stat=ierr)
    54     IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
    55 
    56     ALLOCATE(KxKwTp(klon), stat=ierr)
    57     IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
    58 
    59     ALLOCATE(dd_AT(klon), stat=ierr)
    60     IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
    61 
    62     ALLOCATE(dd_BT(klon), stat=ierr)
    63     IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
    64 
    65 !----------------------------------------------------------------------------
    66     ALLOCATE(Kech_Qp(klon), stat=ierr)
    67     IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
    68 
    69     ALLOCATE(Kech_Q_xp(klon), stat=ierr)
    70     IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
    71 
    72     ALLOCATE(Kech_Q_wp(klon), stat=ierr)
    73     IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
    74 
    75     ALLOCATE(dd_KQp(klon), stat=ierr)
    76     IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
    77 
    78     ALLOCATE(KxKwQp(klon), stat=ierr)
    79     IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
    80 
    81     ALLOCATE(dd_AQ(klon), stat=ierr)
    82     IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
    83 
    84     ALLOCATE(dd_BQ(klon), stat=ierr)
    85     IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
    86 
    87 !----------------------------------------------------------------------------
    88     ALLOCATE(Kech_Up(klon), stat=ierr)
    89     IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
    90 
    91     ALLOCATE(Kech_U_xp(klon), stat=ierr)
    92     IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
    93 
    94     ALLOCATE(Kech_U_wp(klon), stat=ierr)
    95     IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
    96 
    97     ALLOCATE(dd_KUp(klon), stat=ierr)
    98     IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
    99 
    100     ALLOCATE(KxKwUp(klon), stat=ierr)
    101     IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
    102 
    103     ALLOCATE(dd_AU(klon), stat=ierr)
    104     IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
    105 
    106     ALLOCATE(dd_BU(klon), stat=ierr)
    107     IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
    108 
    109 !----------------------------------------------------------------------------
    110     ALLOCATE(Kech_Vp(klon), stat=ierr)
    111     IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
    112 
    113     ALLOCATE(Kech_V_xp(klon), stat=ierr)
    114     IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
    115 
    116     ALLOCATE(Kech_V_wp(klon), stat=ierr)
    117     IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
    118 
    119     ALLOCATE(dd_KVp(klon), stat=ierr)
    120     IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
    121 
    122     ALLOCATE(KxKwVp(klon), stat=ierr)
    123     IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
    124 
    125     ALLOCATE(dd_AV(klon), stat=ierr)
    126     IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
    127 
    128     ALLOCATE(dd_BV(klon), stat=ierr)
    129     IF (ierr /= 0) CALL abort_physic('wx_pbl_init', 'pb in allocation',1)
    130 
    131 !----------------------------------------------------------------------------
    132 
    133 END SUBROUTINE wx_pbl_init
    134 
    135 SUBROUTINE wx_pbl0_fuse(knon, dtime, ypplay, ywake_s, &
     16SUBROUTINE wx_pbl0_merge(knon, ypplay, ypaprs,  &
     17                                 sigw, dTs_forcing, dqs_forcing,  &
    13618                                 yt_x, yt_w, yq_x, yq_w, &
    13719                                 yu_x, yu_w, yv_x, yv_w, &
    138                                  ycdragh_x, ycdragh_w, ycdragm_x, ycdragm_w, &
     20                                 ycdragh_x, ycdragh_w, ycdragq_x, ycdragq_w, &
     21                                 ycdragm_x, ycdragm_w, &
    13922                                 AcoefT_x, AcoefT_w, AcoefQ_x, AcoefQ_w, &
    14023                                 AcoefU_x, AcoefU_w, AcoefV_x, AcoefV_w, &
    … …  
    14326                                 AcoefT, AcoefQ, AcoefU, AcoefV, &
    14427                                 BcoefT, BcoefQ, BcoefU, BcoefV, &
    145                                  ycdragh, ycdragm, &
     28                                 ycdragh, ycdragq, ycdragm, &
    14629                                 yt1, yq1, yu1, yv1 &
    14730                                 )
    14831!
     32
     33    USE wx_pbl_var_mod
     34
    14935    USE print_control_mod, ONLY: prt_level,lunout
     36    USE indice_sol_mod, ONLY: is_oce
    15037!
    15138    INCLUDE "YOMCST.h"
     39    INCLUDE "FCTTRE.h"
     40    INCLUDE "YOETHF.h"
     41    INCLUDE "clesphys.h"
    15242!
    15343    INTEGER,                      INTENT(IN)        :: knon    ! number of grid cells
    154     REAL,                         INTENT(IN)        :: dtime   ! time step size (s)
    15544    REAL, DIMENSION(knon,klev),   INTENT(IN)        :: ypplay  ! mid-layer pressure (Pa)
    156     REAL, DIMENSION(knon),        INTENT(IN)        :: ywake_s ! cold pools fractional area
     45    REAL, DIMENSION(knon,klev),   INTENT(IN)        :: ypaprs  ! pressure at layer interfaces (pa)
     46    REAL, DIMENSION(knon),        INTENT(IN)        :: sigw ! cold pools fractional area
     47    REAL, DIMENSION(knon),        INTENT(IN)        :: dTs_forcing ! forced temperature difference (w)-(x)
     48    REAL, DIMENSION(knon),        INTENT(IN)        :: dqs_forcing ! forced humidity difference (w)-(x)
    15749    REAL, DIMENSION(knon,klev),   INTENT(IN)        :: yt_x, yt_w, yq_x, yq_w
    15850    REAL, DIMENSION(knon,klev),   INTENT(IN)        :: yu_x, yu_w, yv_x, yv_w
    159     REAL, DIMENSION(knon),        INTENT(IN)        :: ycdragh_x, ycdragh_w, ycdragm_x, ycdragm_w
     51    REAL, DIMENSION(knon),        INTENT(IN)        :: ycdragh_x, ycdragh_w, ycdragq_x, ycdragq_w
     52    REAL, DIMENSION(knon),        INTENT(IN)        :: ycdragm_x, ycdragm_w
    16053    REAL, DIMENSION(knon),        INTENT(IN)        :: AcoefT_x, AcoefT_w, AcoefQ_x, AcoefQ_w
    16154    REAL, DIMENSION(knon),        INTENT(IN)        :: AcoefU_x, AcoefU_w, AcoefV_x, AcoefV_w
    … …  
    16457    REAL, DIMENSION(knon),        INTENT(OUT)       :: AcoefT, AcoefQ, AcoefU, AcoefV
    16558    REAL, DIMENSION(knon),        INTENT(OUT)       :: BcoefT, BcoefQ, BcoefU, BcoefV
    166     REAL, DIMENSION(knon),        INTENT(OUT)       :: ycdragh, ycdragm
     59    REAL, DIMENSION(knon),        INTENT(OUT)       :: ycdragh, ycdragq, ycdragm
    16760    REAL, DIMENSION(knon),        INTENT(OUT)       :: yt1, yq1, yu1, yv1  ! Apparent T, q, u, v at first level, as
    16861                                                                           !seen by surface modules
    … …  
    17063! Local variables
    17164    INTEGER                    :: j
    172     REAL                       :: rho1
    173     REAL                       :: mod_wind_x
    174     REAL                       :: mod_wind_w   
    175     REAL                       :: dd_Cdragh
    176     REAL                       :: dd_Cdragm
    17765    REAL                       :: dd_Kh
     66    REAL                       :: dd_Kq
    17867    REAL                       :: dd_Km
    17968    REAL                       :: dd_u
    … …  
    18271    REAL                       :: dd_q
    18372!
    184     REAL                       :: KCT, KCQ, KCU, KCV
    185 !
    186     REAL                       :: BBT, BBQ, BBU, BBV
    187     REAL                       :: DDT, DDQ, DDU, DDV
    188     REAL                       :: LambdaT, LambdaQ, LambdaU, LambdaV
    18973    REAL                       :: LambdaTs, LambdaQs, LambdaUs, LambdaVs
    19074!
    19175    REAL, DIMENSION(knon)      :: sigx       ! fractional area of (x) region
    192 
    193     REAL, DIMENSION(knon)      :: Kech_h    ! Energy exchange coefficient
    194     REAL, DIMENSION(knon)      :: Kech_h_x, Kech_h_w
    195     REAL, DIMENSION(knon)      :: Kech_m    ! Momentum exchange coefficient
    196     REAL, DIMENSION(knon)      :: Kech_m_x, Kech_m_w
    197 
    198 !!!
    199 !!! jyg le 09/04/2013 ; passage aux nouvelles expressions en differences
    200 
    201         sigx(:) = 1.-ywake_s(:)
    202 
     76!
     77!
     78   sigx(1:knon) = 1.-sigw(1:knon)
     79!                                           
     80!
    20381        DO j=1,knon
    20482!
    205 ! Calcul des coefficients d echange
    206          mod_wind_x = 1.0+SQRT(yu_x(j,1)**2+yv_x(j,1)**2)
    207          mod_wind_w = 1.0+SQRT(yu_w(j,1)**2+yv_w(j,1)**2)
    208 !!         rho1 = ypplay(j,1)/(RD*yt(j,1))
    209          rho1 = ypplay(j,1)/(RD*(yt_x(j,1) + ywake_s(j)*(yt_w(j,1)-yt_x(j,1))))
    210          Kech_h_x(j) = ycdragh_x(j) * mod_wind_x * rho1
    211          Kech_h_w(j) = ycdragh_w(j) * mod_wind_w * rho1
    212          Kech_m_x(j) = ycdragm_x(j) * mod_wind_x * rho1
    213          Kech_m_w(j) = ycdragm_w(j) * mod_wind_w * rho1
    214 !
    215          dd_Kh = Kech_h_w(j) - Kech_h_x(j)
    216          dd_Km = Kech_m_w(j) - Kech_m_x(j)
    217          IF (prt_level >=10) THEN
    218           print *,' mod_wind_x, mod_wind_w ', mod_wind_x, mod_wind_w
    219           print *,' rho1 ',rho1
    220           print *,' ycdragh_x(j),ycdragm_x(j) ',ycdragh_x(j),ycdragm_x(j)
    221           print *,' ycdragh_w(j),ycdragm_w(j) ',ycdragh_w(j),ycdragm_w(j)
    222           print *,' dd_Kh: ',dd_Kh
    223          ENDIF
    224 !
    225          Kech_h(j) = Kech_h_x(j) + ywake_s(j)*dd_Kh
    226          Kech_m(j) = Kech_m_x(j) + ywake_s(j)*dd_Km
    227 !
    228 ! Calcul des coefficients d echange corriges des retroactions
    229         Kech_T_xp(j) = Kech_h_x(j)/(1.-BcoefT_x(j)*Kech_h_x(j)*dtime)
    230         Kech_T_wp(j) = Kech_h_w(j)/(1.-BcoefT_w(j)*Kech_h_w(j)*dtime)
    231         Kech_Q_xp(j) = Kech_h_x(j)/(1.-BcoefQ_x(j)*Kech_h_x(j)*dtime)
    232         Kech_Q_wp(j) = Kech_h_w(j)/(1.-BcoefQ_w(j)*Kech_h_w(j)*dtime)
    233         Kech_U_xp(j) = Kech_m_x(j)/(1.-BcoefU_x(j)*Kech_m_x(j)*dtime)
    234         Kech_U_wp(j) = Kech_m_w(j)/(1.-BcoefU_w(j)*Kech_m_w(j)*dtime)
    235         Kech_V_xp(j) = Kech_m_x(j)/(1.-BcoefV_x(j)*Kech_m_x(j)*dtime)
    236         Kech_V_wp(j) = Kech_m_w(j)/(1.-BcoefV_w(j)*Kech_m_w(j)*dtime)
    237 !
    238          dd_KTp(j) = Kech_T_wp(j) - Kech_T_xp(j)
    239          dd_KQp(j) = Kech_Q_wp(j) - Kech_Q_xp(j)
    240          dd_KUp(j) = Kech_U_wp(j) - Kech_U_xp(j)
    241          dd_KVp(j) = Kech_V_wp(j) - Kech_V_xp(j)
    242 !
    243         Kech_Tp(j) = Kech_T_xp(j) + ywake_s(j)*dd_KTp(j)
    244         Kech_Qp(j) = Kech_Q_xp(j) + ywake_s(j)*dd_KQp(j)
    245         Kech_Up(j) = Kech_U_xp(j) + ywake_s(j)*dd_KUp(j)
    246         Kech_Vp(j) = Kech_V_xp(j) + ywake_s(j)*dd_KVp(j)
    247 !
    248 ! Calcul des differences w-x
    249        dd_Cdragm = ycdragm_w(j) - ycdragm_x(j)
    250        dd_Cdragh = ycdragh_w(j) - ycdragh_x(j)
     83!
     84! Compute w-x differences
     85       dd_t = yt_w(j,1) - yt_x(j,1)
     86       dd_q = yq_w(j,1) - yq_x(j,1)
    25187       dd_u = yu_w(j,1) - yu_x(j,1)
    25288       dd_v = yv_w(j,1) - yv_x(j,1)
    253        dd_t = yt_w(j,1) - yt_x(j,1)
    254        dd_q = yq_w(j,1) - yq_x(j,1)
    255        dd_AT(j) = AcoefT_w(j) - AcoefT_x(j)
    256        dd_AQ(j) = AcoefQ_w(j) - AcoefQ_x(j)
    257        dd_AU(j) = AcoefU_w(j) - AcoefU_x(j)
    258        dd_AV(j) = AcoefV_w(j) - AcoefV_x(j)
    259        dd_BT(j) = BcoefT_w(j) - BcoefT_x(j)
    260        dd_BQ(j) = BcoefQ_w(j) - BcoefQ_x(j)
    261        dd_BU(j) = BcoefU_w(j) - BcoefU_x(j)
    262        dd_BV(j) = BcoefV_w(j) - BcoefV_x(j)
    263 !
    264        KxKwTp(j) = Kech_T_xp(j)*Kech_T_wp(j)
    265        KxKwQp(j) = Kech_Q_xp(j)*Kech_Q_wp(j)
    266        KxKwUp(j) = Kech_U_xp(j)*Kech_U_wp(j)
    267        KxKwVp(j) = Kech_V_xp(j)*Kech_V_wp(j)
    268        BBT = (BcoefT_x(j) + sigx(j)*dd_BT(j))*dtime
    269        BBQ = (BcoefQ_x(j) + sigx(j)*dd_BQ(j))*dtime
    270        BBU = (BcoefU_x(j) + sigx(j)*dd_BU(j))*dtime
    271        BBV = (BcoefV_x(j) + sigx(j)*dd_BV(j))*dtime
    272        KCT = Kech_h(j)
    273        KCQ = Kech_h(j)
    274        KCU = Kech_m(j)
    275        KCV = Kech_m(j)
    276        DDT = Kech_Tp(j)
    277        DDQ = Kech_Qp(j)
    278        DDU = Kech_Up(j)
    279        DDV = Kech_Vp(j)
    280        LambdaT = dd_Kh/KCT
    281        LambdaQ = dd_Kh/KCQ
    282        LambdaU = dd_Km/KCU
    283        LambdaV = dd_Km/KCV
    284        LambdaTs = dd_KTp(j)/DDT
    285        LambdaQs = dd_KQp(j)/DDQ
    286        LambdaUs = dd_KUp(j)/DDU
    287        LambdaVs = dd_KVp(j)/DDV
    288 !
    289        IF (prt_level >=10) THEN
    290           print *,'Variables pour la fusion : Kech_T_xp(j)' ,Kech_T_xp(j)
    291           print *,'Variables pour la fusion : Kech_T_wp(j)' ,Kech_T_wp(j)
    292           print *,'Variables pour la fusion : Kech_Tp(j)' ,Kech_Tp(j)
    293           print *,'Variables pour la fusion : Kech_h(j)' ,Kech_h(j)
    294        ENDIF
     89!
     90! Merged exchange coefficients
     91         dd_Kh = Kech_h_w(j) - Kech_h_x(j)
     92         dd_Kq = Kech_q_w(j) - Kech_q_x(j)
     93         dd_Km = Kech_m_w(j) - Kech_m_x(j)
     94!
     95       LambdaTs = dd_KTp(j)/Kech_Tp(j)
     96       LambdaQs = dd_KQs(j)/Kech_Qs(j)
     97       LambdaUs = dd_KUp(j)/Kech_Up(j)
     98       LambdaVs = dd_KVp(j)/Kech_Vp(j)
    29599!
    296100! Calcul des coef A, B \'equivalents dans la couche 1
    297101!
    298        AcoefT(j) = AcoefT_x(j) + ywake_s(j)*dd_AT(j)*(1.+sigx(j)*LambdaTs)
    299        AcoefQ(j) = AcoefQ_x(j) + ywake_s(j)*dd_AQ(j)*(1.+sigx(j)*LambdaQs)
    300        AcoefU(j) = AcoefU_x(j) + ywake_s(j)*dd_AU(j)*(1.+sigx(j)*LambdaUs)
    301        AcoefV(j) = AcoefV_x(j) + ywake_s(j)*dd_AV(j)*(1.+sigx(j)*LambdaVs)
     102! The dTs_forcing and dqs_forcing terms are added for diagnostic purpose ; they should be zero in normal operation.
     103       AcoefT(j) = AcoefT_x(j) + sigw(j)*(1.+sigx(j)*LambdaTs)*(dd_AT(j) - C_p(j)*dTs_forcing(j))
     104       AcoefQ(j) = AcoefQ_x(j) + sigw(j)*(1.+sigx(j)*LambdaQs)*(dd_AQ(j) - dqs_forcing(j))
     105       AcoefU(j) = AcoefU_x(j) + sigw(j)*(1.+sigx(j)*LambdaUs)*dd_AU(j)
     106       AcoefV(j) = AcoefV_x(j) + sigw(j)*(1.+sigx(j)*LambdaVs)*dd_AV(j)
    302107!                                           
    303        BcoefT(j) = BcoefT_x(j) + ywake_s(j)*BcoefT_x(j)*sigx(j)*LambdaT*LambdaTs &
    304                                + ywake_s(j)*dd_BT(j)*(1.+sigx(j)*LambdaT)*(1.+sigx(j)*LambdaTs)
    305                                            
    306        BcoefQ(j) = BcoefQ_x(j) + ywake_s(j)*BcoefQ_x(j)*sigx(j)*LambdaQ*LambdaQs &
    307                                + ywake_s(j)*dd_BQ(j)*(1.+sigx(j)*LambdaQ)*(1.+sigx(j)*LambdaQs)
    308                                            
    309        BcoefU(j) = BcoefU_x(j) + ywake_s(j)*BcoefU_x(j)*sigx(j)*LambdaU*LambdaUs &
    310                                + ywake_s(j)*dd_BU(j)*(1.+sigx(j)*LambdaU)*(1.+sigx(j)*LambdaUs)
    311                                            
    312        BcoefV(j) = BcoefV_x(j) + ywake_s(j)*BcoefV_x(j)*sigx(j)*LambdaV*LambdaVs &
    313                                + ywake_s(j)*dd_BV(j)*(1.+sigx(j)*LambdaV)*(1.+sigx(j)*LambdaVs)
    314 
     108!
     109!!       BcoefT(j) = (sigw(j)*Kech_h_w(j)*Kech_T_pw(j)*BcoefT_w(j) + &
     110!!                sigx(j)*Kech_h_x(j)*Kech_T_px(j)*BcoefT_x(j) )/(Kech_h(j)*Kech_Tp(j))
     111!!       BcoefQ(j) = (sigw(j)*Kech_q_w(j)*Kech_Q_pw(j)*BcoefQ_w(j) + &
     112!!                sigx(j)*Kech_q_x(j)*Kech_Q_px(j)*BcoefQ_x(j) )/(Kech_q(j)*Kech_Qp(j))
     113!!       BcoefU(j) = (sigw(j)*Kech_m_w(j)*Kech_U_pw(j)*BcoefU_w(j) + &
     114!!                sigx(j)*Kech_m_x(j)*Kech_U_px(j)*BcoefU_x(j) )/(Kech_m(j)*Kech_Up(j))
     115!!       BcoefV(j) = (sigw(j)*Kech_m_w(j)*Kech_V_pw(j)*BcoefV_w(j) + &
     116!!                sigx(j)*Kech_m_x(j)*Kech_V_px(j)*BcoefV_x(j) )/(Kech_m(j)*Kech_Vp(j))
     117!
     118!!  Print *,'YYYYpbl0: BcoefT_x, sigw, sigx, dd_Kh, dd_KTp, Kech_h_w ', &
     119!!                     BcoefT_x, sigw, sigx, dd_Kh, dd_KTp, Kech_h_w
     120!!  Print *,'YYYYpbl0: Kech_T_pw, dd_BT, Kech_h, Kech_Tp ', &
     121!!                     Kech_T_pw, dd_BT, Kech_h, Kech_Tp
     122       BcoefT(j) = BcoefT_x(j) + sigw(j)*(sigx(j)*dd_Kh*dd_KTp(j)*BcoefT_x(j) + &
     123                                  Kech_h_w(j)*Kech_T_pw(j)*dd_BT(j))/(Kech_h(j)*Kech_Tp(j))
     124       BcoefQ(j) = BcoefQ_x(j) + sigw(j)*(sigx(j)*dd_Kq*dd_KQs(j)*BcoefQ_x(j) + &
     125                                  Kech_q_w(j)*Kech_Q_sw(j)*dd_BQ(j))/(Kech_q(j)*Kech_Qs(j))
     126       BcoefU(j) = BcoefU_x(j) + sigw(j)*(sigx(j)*dd_Km*dd_KUp(j)*BcoefU_x(j) + &
     127                                  Kech_m_w(j)*Kech_U_pw(j)*dd_BU(j))/(Kech_m(j)*Kech_Up(j))
     128       BcoefV(j) = BcoefV_x(j) + sigw(j)*(sigx(j)*dd_Km*dd_KVp(j)*BcoefV_x(j) + &
     129                                  Kech_m_w(j)*Kech_V_pw(j)*dd_BV(j))/(Kech_m(j)*Kech_Vp(j))
     130!>jyg
     131!
    315132!
    316133! Calcul des cdrag \'equivalents dans la couche
    317134!
    318        ycdragm(j) = ycdragm_x(j) + ywake_s(j)*dd_Cdragm
    319        ycdragh(j) = ycdragh_x(j) + ywake_s(j)*dd_Cdragh
     135       ycdragm(j) = ycdragm_x(j) + sigw(j)*dd_Cdragm(j)
     136       ycdragh(j) = ycdragh_x(j) + sigw(j)*dd_Cdragh(j)
     137       ycdragq(j) = ycdragq_x(j) + sigw(j)*dd_Cdragq(j)
    320138!
    321139! Calcul de T, q, u et v \'equivalents dans la couche 1
    322 !!       yt1(j) = yt_x(j,1) + ywake_s(j)*dd_t*(1.+sigx(j)*dd_Kh/KCT)
    323 !!       yq1(j) = yq_x(j,1) + ywake_s(j)*dd_q*(1.+sigx(j)*dd_Kh/KCQ)
    324 !!       yu1(j) = yu_x(j,1) + ywake_s(j)*dd_u*(1.+sigx(j)*dd_Km/KCU)
    325 !!       yv1(j) = yv_x(j,1) + ywake_s(j)*dd_v*(1.+sigx(j)*dd_Km/KCV)
    326        yt1(j) = yt_x(j,1) + ywake_s(j)*dd_t
    327        yq1(j) = yq_x(j,1) + ywake_s(j)*dd_q
    328        yu1(j) = yu_x(j,1) + ywake_s(j)*dd_u
    329        yv1(j) = yv_x(j,1) + ywake_s(j)*dd_v
     140!!       yt1(j) = yt_x(j,1) + sigw(j)*dd_t*(1.+sigx(j)*dd_Kh/KCT)
     141!!       yq1(j) = yq_x(j,1) + sigw(j)*dd_q*(1.+sigx(j)*dd_Kh/KCQ)
     142!!       yu1(j) = yu_x(j,1) + sigw(j)*dd_u*(1.+sigx(j)*dd_Km/KCU)
     143!!       yv1(j) = yv_x(j,1) + sigw(j)*dd_v*(1.+sigx(j)*dd_Km/KCV)
     144       yt1(j) = yt_x(j,1) + sigw(j)*dd_t
     145       yq1(j) = yq_x(j,1) + sigw(j)*dd_q
     146       yu1(j) = yu_x(j,1) + sigw(j)*dd_u
     147       yv1(j) = yv_x(j,1) + sigw(j)*dd_v
    330148
    331149
    … …  
    334152        RETURN
    335153
    336 END SUBROUTINE wx_pbl0_fuse
    337 
    338 SUBROUTINE wx_pbl0_split(knon, dtime, ywake_s, &
    339                        y_flux_t1, y_flux_q1, y_flux_u1, y_flux_v1, &
    340                        y_flux_t1_x, y_flux_t1_w, &
    341                        y_flux_q1_x, y_flux_q1_w, &
    342                        y_flux_u1_x, y_flux_u1_w, &
    343                        y_flux_v1_x, y_flux_v1_w, &
    344                        yfluxlat_x, yfluxlat_w, &
    345                        y_delta_tsurf &
    346                        )
    347 !
     154END SUBROUTINE wx_pbl0_merge
     155
     156SUBROUTINE wx_pbl_dts_merge(knon, dtime, ypplay, ypaprs, &
     157                                 sigw, beta, wcstar, wdens, &
     158                                 AT_x, AT_w, &
     159                                 BT_x, BT_w, &
     160                                 AcoefT0, AcoefQ0, BcoefT0, BcoefQ0, &
     161                                 AcoefT,  AcoefQ,  BcoefT,  BcoefQ, &
     162                                 HTphiT_b, dd_HTphiT, HTphiQ_b, dd_HTphiQ, HTRn_b, dd_HTRn, &
     163                                 phiT0_b, dphiT0, phiQ0_b, dphiQ0, Rn0_b, dRn0, &
     164                                 g_T, g_Q, &
     165                                 Gamma_phiT, Gamma_phiQ, &
     166                                 dTs_ins, dqsatsrf_ins &
     167                                 )
     168!
     169
     170    USE wx_pbl_var_mod
     171
    348172    USE print_control_mod, ONLY: prt_level,lunout
    349173!
    350174    INCLUDE "YOMCST.h"
     175    INCLUDE "FCTTRE.h"
     176    INCLUDE "YOETHF.h"
    351177!
    352178    INTEGER,                      INTENT(IN)        :: knon    ! number of grid cells
    353179    REAL,                         INTENT(IN)        :: dtime   ! time step size (s)
    354     REAL, DIMENSION(knon),        INTENT(IN)        :: ywake_s ! cold pools fractional area
    355     REAL, DIMENSION(knon),        INTENT(IN)        :: y_flux_t1, y_flux_q1, y_flux_u1, y_flux_v1
    356 !
    357     REAL, DIMENSION(knon),        INTENT(OUT)       :: y_flux_t1_x, y_flux_t1_w
    358     REAL, DIMENSION(knon),        INTENT(OUT)       :: y_flux_q1_x, y_flux_q1_w
    359     REAL, DIMENSION(knon),        INTENT(OUT)       :: y_flux_u1_x, y_flux_u1_w
    360     REAL, DIMENSION(knon),        INTENT(OUT)       :: y_flux_v1_x, y_flux_v1_w
    361     REAL, DIMENSION(knon),        INTENT(OUT)       :: yfluxlat_x, yfluxlat_w
    362     REAL, DIMENSION(knon),        INTENT(OUT)       :: y_delta_tsurf
     180    REAL, DIMENSION(knon,klev),   INTENT(IN)        :: ypplay  ! mid-layer pressure (Pa)
     181    REAL, DIMENSION(knon,klev),   INTENT(IN)        :: ypaprs  ! pressure at layer interfaces (pa)
     182    REAL, DIMENSION(knon),        INTENT(IN)        :: sigw    ! cold pool fractional area
     183    REAL, DIMENSION(knon),        INTENT(IN)        :: beta    ! evaporation by potential evaporation
     184    REAL, DIMENSION(knon),        INTENT(IN)        :: wcstar   ! cold pool gust front speed
     185    REAL, DIMENSION(knon),        INTENT(IN)        :: wdens    ! cold pool number density
     186    REAL, DIMENSION(knon),        INTENT(IN)        :: AT_x, AT_w
     187    REAL, DIMENSION(knon),        INTENT(IN)        :: BT_x, BT_w
     188    REAL, DIMENSION(knon),        INTENT(IN)        :: AcoefT0, AcoefQ0, BcoefT0, BcoefQ0
     189!
     190    REAL, DIMENSION(knon),        INTENT(OUT)       :: AcoefT, AcoefQ, BcoefT, BcoefQ
     191    REAL, DIMENSION(knon),        INTENT(OUT)       :: HTphiT_b, dd_HTphiT, HTphiQ_b, dd_HTphiQ, HTRn_b, dd_HTRn
     192    REAL, DIMENSION(knon),        INTENT(OUT)       :: phiT0_b, dphiT0, phiQ0_b, dphiQ0, Rn0_b, dRn0
     193    REAL, DIMENSION(knon),        INTENT(OUT)       :: g_T, g_Q
     194    REAL, DIMENSION(knon),        INTENT(OUT)       :: Gamma_phiT, Gamma_phiQ
     195    REAL, DIMENSION(knon),        INTENT(OUT)       :: dTs_ins, dqsatsrf_ins
     196!
     197! Local variables
     198    REAL, DIMENSION(knon)      :: qsat_x
     199    REAL, DIMENSION(knon)      :: qsat_w
     200    REAL, DIMENSION(knon)      :: dqsatdT_x
     201    REAL, DIMENSION(knon)      :: dqsatdT_w
     202!
     203    REAL, DIMENSION(knon)      :: T10_x
     204    REAL, DIMENSION(knon)      :: T10_w
     205    REAL, DIMENSION(knon)      :: phiT0_x
     206    REAL, DIMENSION(knon)      :: phiT0_w
     207    REAL, DIMENSION(knon)      :: phiQ0_x
     208    REAL, DIMENSION(knon)      :: phiQ0_w
     209    REAL, DIMENSION(knon)      :: Rn0_x
     210    REAL, DIMENSION(knon)      :: Rn0_w
     211    REAL, DIMENSION(knon)      :: Rp1_x
     212    REAL, DIMENSION(knon)      :: Rp1_w
     213    REAL, DIMENSION(knon)      :: Rps_x
     214    REAL, DIMENSION(knon)      :: Rps_w
     215!
     216    REAL, DIMENSION(knon)      :: HTphiT_x
     217    REAL, DIMENSION(knon)      :: HTphiT_w
     218    REAL, DIMENSION(knon)      :: HTphiQ_x
     219    REAL, DIMENSION(knon)      :: HTphiQ_w
     220    REAL, DIMENSION(knon)      :: HTRn_x
     221    REAL, DIMENSION(knon)      :: HTRn_w
     222!
     223    REAL, DIMENSION(knon)      :: HQphiT_x
     224    REAL, DIMENSION(knon)      :: HQphiT_w
     225    REAL, DIMENSION(knon)      :: HQphiQ_x
     226    REAL, DIMENSION(knon)      :: HQphiQ_w
     227    REAL, DIMENSION(knon)      :: HQRn_x
     228    REAL, DIMENSION(knon)      :: HQRn_w
     229!
     230    REAL, DIMENSION(knon)      :: HQphiT_b
     231    REAL, DIMENSION(knon)      :: dd_HQphiT
     232    REAL, DIMENSION(knon)      :: HQphiQ_b
     233    REAL, DIMENSION(knon)      :: dd_HQphiQ
     234    REAL, DIMENSION(knon)      :: HQRn_b
     235    REAL, DIMENSION(knon)      :: dd_HQRn
     236!
     237
     238    REAL, DIMENSION(knon)    :: sigx
     239!
     240    REAL, DIMENSION(knon)    :: Ts, T1
     241!!!    REAL, DIMENSION(knon)    :: qsat, dqsat_dT
     242!!!    REAL, DIMENSION(knon)    :: phiT0
     243!
     244!!!    REAL, DIMENSION(knon)    :: Cp, Lv
     245    REAL, DIMENSION(knon)    :: tau, Inert
     246!
     247    REAL                     :: dd_Kh
     248    REAL                     :: zdelta, zcvm5, zcor
     249    REAL                     :: qsat
     250!
     251    INTEGER                  :: j
     252
     253
     254!----------------------------------------------------------------------------
     255!  Reference state
     256!  ---------------
     257!   dqsat_dT_w = dqsat_dT(Ts0_w)                          dqsat_dT_x = dqsat_dT(Ts0_x)
     258!   T10_w = (AT_w/Cp - Kech_T_w BT_w dtime Ts0_w)/(1 - Kech_T_w BT_w dtime)
     259!                                                T10_x = (AT_x/Cp - Kech_T_x BT_x dtime Ts0_x)/(1 - Kech_T_x BT_x dtime)
     260!   phiT0_w = Kech_T_pw (AT_w - Cp Ts0_w)                 phiT0_x = Kech_T_px (AT_x - Cp Ts0_x)
     261!   phiQ0_w = Kech_Q_sw (beta AQ_w - qsatsrf0_w)          phiQ0_x = Kech_Q_sx (beta AQ_x - qsatsrf0_x)
     262!   Rn0_w = eps_1 Rsigma T10_w^4 - Rsigma Ts0_w^4         Rn0_x = eps_1 Rsigma T10_x^4 - Rsigma Ts0_x^4
     263!   Rp1_w = 4 eps_1 Rsigma T10_w^3                        Rp1_x = 4 eps_1 Rsigma T10_x^3
     264!   Rps_w = 4 Rsigma Ts0_w^3                              Rps_x = 4 Rsigma Ts0_x^3
     265!
     266!   phiT0_b = sigw phiT0_w + sigx phiT0_x
     267!   dphiT0 = phiT0_w - phiT0_x
     268!   phiQ0_b = sigw phiQ0_w + sigx phiQ0_x
     269!   dphiQ0 = phiQ0_w - phiQ0_x
     270!   Rn0_b = sigw Rn0_w + sigx Rn0_x
     271    dRn0 = Rn0_w - Rn0_x
     272!
     273!
     274!----------------------------------------------------------------------------
     275!  Elementary enthalpy equations
     276!  -----------------------------
     277!   phiT_w = phiT0_w - HTphiT_w (Ts_w-Ts0_w)            phiT_x = phiT0_x - HTphiT_x (Ts_x-Ts0_x)
     278!   phiQ_w = phiQ0_w - HTphiQ_w (Ts_w-Ts0_w)            phiQ_x = phiQ0_x - HTphiQ_x (Ts_x-Ts0_x)
     279!   Rn_w   = Rn0_w   - HTRn_w   (Ts_w-Ts0_w)            Rn_x   = Rn0_x   - HTRn_x   (Ts_x-Ts0_x)
     280!  DFlux_DT coefficients
     281!  ---------------------
     282!   Heat flux equation
     283!     HTphiT_w = Cp Kech_T_pw                            HTphiT_x = Cp Kech_T_px
     284!   Moisture flux equation
     285!     HTphiQ_w = beta Kech_Q_sw dqsat_dT_w               HTphiQ_x = beta Kech_Q_sx dqsat_dT_x
     286!   Radiation equation
     287!     HTRn_w = Rp1_w Kech_T_pw BcoefT_w dtime + Rps_w    HTRn_x = Rp1_x Kech_T_px BcoefT_x dtime + Rps_x
     288!
     289!----------------------------------------------------------------------------
     290!  Elementary moisture equations
     291!  -----------------------------
     292!   beta Ts_w   = beta Ts0_w    + QQ_w     (qsatsrf_w-qsatsrf0_w)    beta Ts_x   = beta Ts0_x    + QQ_x     (qsatsrf_x-qsatsrf0_x)
     293!   beta phiT_w = beta phiT0_w - HQphiT_w (qsatsrf_w-qsatsrf0_w)    beta phiQ_x = beta phiQ0_x - HTphiQ_x (qsatsrf_x-qsatsrf0_x)
     294!   beta phiQ_w = beta phiQ0_w - HQphiQ_w (qsatsrf_w-qsatsrf0_w)    beta phiQ_x = beta phiQ0_x - HTphiQ_x (qsatsrf_x-qsatsrf0_x)
     295!   beta Rn_w   = beta Rn0_w   - HQRn_w   (qsatsrf_w-qsatsrf0_w)    beta Rn_x   = beta Rn0_x   - HTRn_x   (qsatsrf_x-qsatsrf0_x)
     296!  DFluxDQ coefficients
     297!  ---------------------
     298!   dqsat_dT equation
     299!     QQ_w = 1. / dqsat_dT_w                             QQ_x = 1. / dqsat_dT_x
     300!   Heat flux equation
     301!     HQphiT_w = Cp Kech_T_pw QQ_w                       HQphiT_x = Cp Kech_T_px QQ_x
     302!   Moisture flux equation
     303!     HQphiQ_w = beta Kech_Q_sw                          HQphiQ_x = beta Kech_Q_sx
     304!   Radiation equation
     305!     HQRn_w = (Rp1_w Kech_T_pw BcoefT_w dtime + Rps_w) QQ_w
     306!                                         HQRn_x = (Rp1_x Kech_T_px BcoefT_x dtime + Rps_x) QQ_x
     307!
     308!----------------------------------------------------------------------------
     309! Mean values and w-x differences
     310! -------------------------------
     311!  HTphiT_b = sigw HTphiT_w + sigx HTphiT_x               dd_HTphiT = HTphiT_w - HTphiT_x
     312!  HTphiQ_b = sigw HTphiQ_w + sigx HTphiQ_x               dd_HTphiQ = HTphiQ_w - HTphiQ_x
     313!  HTRn_b   = sigw HTRn_w   + sigx HTRn_x                 dd_HTRn   = HTRn_w   - HTRn_x
     314!
     315!  QQ_b     = sigw QQ_w     + sigx QQ_x                   dd_QQ     = QQ_w     - QQ_x
     316!  HQphiT_b = sigw HQphiT_w + sigx HQphiT_x               dd_HQphiT = HQphiT_w - HQphiT_x
     317!  HQphiQ_b = sigw HQphiQ_w + sigx HQphiQ_x               dd_HQphiQ = HQphiQ_w - HQphiQ_x
     318!  HQRn_b   = sigw HQRn_w   + sigx HQRn_x                 dd_HQRn   = HQRn_w   - HQRn_x
     319!
     320!----------------------------------------------------------------------------
     321!  Equations
     322!  ---------
     323! (1 - g_T) dTs    = dTs_ins    + Gamma_phiT phiT
     324! (1 - g_Q) dqsatsrf = dqsatsrf_ins + Gamma_phiQ phiQ
     325!
     326! Feedback Gains
     327! --------------
     328! g_T = - (sqrt(tau)/I) [ HTphiT_b + Lv HTphiQ_b + HTRn_b +  &
     329!                        (dd_HTphiT + Lv dd_HTphiQ + dd_HTRn) (sigx - sigw - sigw sigx dd_HTphiT/HTphiT_b) ]
     330! g_Q = - (sqrt(tau)/(I QQ_b)) ( HQphiT_b + Lv HQphiQ_b + HQRn_b ) -  &
     331!         (sigx - sigw - sigw sigx dd_HQphiQ/HQphiQ_b)   &
     332!                          [ dd_QQ/QQ_b + (sqrt(tau)/(I QQ_b))(dd_HQphiT + Lv dd_HQphiQ + dd_HQRn) ]
     333!
     334!  Ts, qs Coupling coefficients                /
     335!  ----------------------------
     336! Gamma_phiT = (sqrt(tau)/(I HTphiT_b)) (dd_HTphiT + Lv dd_HTphiQ + dd_HTRn)
     337! Gamma_phiQ = (1/(HQphiQ_b QQ_b)) [ dd_QQ +  (sqrt(tau)/(I )) (dd_HQphiT + Lv dd_HQphiQ + dd_HQRn) ]
     338!
     339!  Insensitive changes
     340!  -------------------
     341! dTs_ins    = (1 - g_T) dTs0    - Gamma_phiT phiT0_b
     342! dqsatsrf_ins = (1 - g_Q) dqsatsrf0 - Gamma_phiQ phiQ0_b
     343!
     344!----------------------------------------------------------------------------
     345!  Effective coefficients Acoef and Bcoef
     346!  --------------------------------------
     347!  Equations
     348!  ---------
     349! Cp Ta = AcoefT + BcoefT phiT dtime
     350!    qa = AcoefQ + BcoefQ phiQ dtime
     351!  Coefficients
     352!  ------------
     353! AcoefT = AcoefT0 - sigw sigx (dd_KTp/Kech_Tp) Cp dTs_ins/(1 - g_T)
     354! BcoefT = BcoefT0 - sigw sigx (dd_KTp/Kech_Tp) Cp Gamma_phiT/(1 - g_T)/dtime
     355!
     356! AcoefQ = AcoefQ0 - sigw sigx (dd_KQp/Kech_Qp) dqs_ins/(1 - g_Q)
     357! BcoefQ = BcoefQ0 - sigw sigx (dd_KQp/Kech_Qp) Gamma_phiq/(1 - g_Q)/dtime
     358!
     359!==============================================================================
     360!
     361!
     362!  Parameters
     363!  ----------
     364   Inert(1:knon) = 2000.
     365   tau(1:knon) = sqrt(sigw(1:knon)/max(rpi*wdens(1:knon)*wcstar(1:knon)**2 , &
     366                                       sigw(1:knon)*1.e-12,smallestreal))
     367   sigx(1:knon) = 1.-sigw(1:knon)
     368!! Compute Cp, Lv, qsat, dqsat_dT.
     369!   C_p(1:knon) = RCpd
     370!   L_v(1:knon) = RLvtt
     371!
     372!      print *,' AAAA wx_pbl_dTs, C_p(j), qsat0(j), Ts0(j) : ', C_p(:), qsat0(:), Ts0(:)
     373!
     374!
     375   T10_x(1:knon) = (AT_x(1:knon)/C_p(1:knon) - Kech_h_x(1:knon)*BT_x(1:knon)*dtime*Ts0_x(1:knon))/  &
     376                   (1 - Kech_h_x(1:knon)*BT_x(1:knon)*dtime)
     377   T10_w(1:knon) = (AT_w(1:knon)/C_p(1:knon) - Kech_h_w(1:knon)*BT_w(1:knon)*dtime*Ts0_w(1:knon))/  &
     378                   (1 - Kech_h_w(1:knon)*BT_w(1:knon)*dtime)
     379!
     380   phiT0_x(1:knon) = Kech_T_px(1:knon)*(AT_x(1:knon) - C_p(1:knon)*Ts0_x(1:knon))
     381   phiT0_w(1:knon) = Kech_T_pw(1:knon)*(AT_w(1:knon) - C_p(1:knon)*Ts0_w(1:knon))
     382!
     383   phiQ0_x(1:knon) = Kech_Q_sx(1:knon)*(beta(1:knon)*AQ_x(1:knon) - qsatsrf0_x(1:knon))
     384   phiQ0_w(1:knon) = Kech_Q_sw(1:knon)*(beta(1:knon)*AQ_w(1:knon) - qsatsrf0_w(1:knon))
     385!
     386   Rn0_x(1:knon) = eps_1*Rsigma*T10_x(1:knon)**4 - Rsigma*Ts0_x(1:knon)**4
     387   Rn0_w(1:knon) = eps_1*Rsigma*T10_w(1:knon)**4 - Rsigma*Ts0_w(1:knon)**4
     388!
     389   Rp1_x(1:knon) = 4*eps_1*Rsigma*T10_x(1:knon)**3
     390   Rp1_w(1:knon) = 4*eps_1*Rsigma*T10_w(1:knon)**3
     391!
     392   Rps_x(1:knon) = 4*Rsigma*Ts0_x(1:knon)**3
     393   Rps_w(1:knon) = 4*Rsigma*Ts0_w(1:knon)**3
     394!
     395!  DFlux_DT coefficients
     396!  ---------------------
     397!   Heat flux equation
     398     HTphiT_x(1:knon) = C_p(1:knon)*Kech_T_px(1:knon)
     399     HTphiT_w(1:knon) = C_p(1:knon)*Kech_T_pw(1:knon)                       
     400!   Moisture flux equation
     401     HTphiQ_x(1:knon) = beta(1:knon)*Kech_Q_sx(1:knon)*dqsatdT0_x(1:knon)
     402     HTphiQ_w(1:knon) = beta(1:knon)*Kech_Q_sw(1:knon)*dqsatdT0_w(1:knon)         
     403!   Radiation equation
     404     HTRn_x(1:knon) = Rp1_x(1:knon)*Kech_T_px(1:knon)*BT_x(1:knon)*dtime + Rps_x(1:knon)
     405     HTRn_w(1:knon) = Rp1_w(1:knon)*Kech_T_pw(1:knon)*BT_w(1:knon)*dtime + Rps_w(1:knon) 
     406!
     407!  DFluxDQ coefficients
     408!  ---------------------
     409!   Heat flux equation
     410     HQphiT_x(1:knon) = C_p(1:knon)*Kech_T_px(1:knon)*QQ_x(1:knon)
     411     HQphiT_w(1:knon) = C_p(1:knon)*Kech_T_pw(1:knon)*QQ_w(1:knon)                 
     412!   Moisture flux equation
     413     HQphiQ_x(1:knon) = beta(1:knon)*Kech_Q_sx(1:knon)
     414     HQphiQ_w(1:knon) = beta(1:knon)*Kech_Q_sw(1:knon)                   
     415!   Radiation equation
     416     HQRn_x(1:knon) = (Rp1_x(1:knon)*Kech_T_px(1:knon)*BT_x(1:knon)*dtime + Rps_x(1:knon))*QQ_x(1:knon)
     417     HQRn_w(1:knon) = (Rp1_w(1:knon)*Kech_T_pw(1:knon)*BT_w(1:knon)*dtime + Rps_w(1:knon))*QQ_w(1:knon)
     418!
     419! Mean values and w-x differences
     420! -------------------------------
     421  phiT0_b(1:knon) = sigw(1:knon)*phiT0_w(1:knon) + sigx(1:knon)*phiT0_x(1:knon)           
     422  phiQ0_b(1:knon) = sigw(1:knon)*phiQ0_w(1:knon) + sigx(1:knon)*phiQ0_x(1:knon)         
     423  Rn0_b(1:knon)   = sigw(1:knon)*Rn0_w(1:knon)   + sigx(1:knon)*Rn0_x(1:knon)         
     424!
     425  dphiT0(1:knon) = phiT0_w(1:knon) - phiT0_x(1:knon)           
     426  dphiQ0(1:knon) = phiQ0_w(1:knon) - phiQ0_x(1:knon)         
     427  dRn0(1:knon)   = Rn0_w(1:knon)   - Rn0_x(1:knon)         
     428!
     429  HTphiT_b(1:knon) = sigw(1:knon)*HTphiT_w(1:knon) + sigx(1:knon)*HTphiT_x(1:knon)           
     430  dd_HTphiT(1:knon) = HTphiT_w(1:knon) - HTphiT_x(1:knon)
     431!
     432  HTphiQ_b(1:knon) = sigw(1:knon)*HTphiQ_w(1:knon) + sigx(1:knon)*HTphiQ_x(1:knon)         
     433  dd_HTphiQ(1:knon) = HTphiQ_w(1:knon) - HTphiQ_x(1:knon)
     434!
     435  HTRn_b(1:knon)   = sigw(1:knon)*HTRn_w(1:knon)   + sigx(1:knon)*HTRn_x(1:knon)           
     436  dd_HTRn(1:knon)   = HTRn_w(1:knon)   - HTRn_x(1:knon)
     437!
     438  HQphiT_b(1:knon) = sigw(1:knon)*HQphiT_w(1:knon) + sigx(1:knon)*HQphiT_x(1:knon)         
     439  dd_HQphiT(1:knon) = HQphiT_w(1:knon) - HQphiT_x(1:knon)
     440!
     441  HQphiQ_b(1:knon) = sigw(1:knon)*HQphiQ_w(1:knon) + sigx(1:knon)*HQphiQ_x(1:knon)         
     442  dd_HQphiQ(1:knon) = HQphiQ_w - HQphiQ_x(1:knon)
     443!
     444  HQRn_b(1:knon)   = sigw(1:knon)*HQRn_w(1:knon)   + sigx(1:knon)*HQRn_x(1:knon)             
     445  dd_HQRn(1:knon)   = HQRn_w(1:knon)   - HQRn_x(1:knon)
     446!
     447! Feedback Gains
     448! --------------
     449 g_T(1:knon) = - (sqrt(tau(1:knon))/Inert(1:knon))  &
     450               * (HTphiT_b(1:knon) + L_v(1:knon)*HTphiQ_b(1:knon) + HTRn_b(1:knon)  &
     451                 + (dd_HTphiT(1:knon) + L_v(1:knon)*dd_HTphiQ(1:knon) + dd_HTRn(1:knon))  &
     452                 * (sigx(1:knon) - sigw(1:knon) - sigw(1:knon)*sigx(1:knon)*dd_HTphiT(1:knon)/HTphiT_b(1:knon)) )
     453!
     454!!!! DO j = 1,knon
     455!!!!  IF (mod(j,20) .eq.0) THEN
     456!!!!   print *, '   j     dd_QQ       QQ_b  dd_HQphiQ  dd_HQphiT   dd_HQRn   HQphiQ_b   HQphiT_b     HQRn_b '
     457!!!!  ENDIF
     458!!!!   print 1789, j, dd_QQ(j), QQ_b(j), dd_HQphiQ(j), dd_HQphiT(j), dd_HQRn(j), HQphiQ_b(j), HQphiT_b(j), HQRn_b(j)
     459!!!! 1789 FORMAT( I4, 10(1X,E10.2))
     460!!!! ENDDO
     461   g_Q(1:knon) = - (dd_QQ(1:knon)/QQ_b(1:knon)) *  &
     462                    (sigx(1:knon)-sigw(1:knon)-sigw(1:knon)*sigx(1:knon)*dd_KQs(1:knon)/Kech_Qs(1:knon)) &
     463                 - sqrt(tau(1:knon))/(Inert(1:knon)*QQ_b(1:knon)) *  &
     464                   ( HQphiT_b(1:knon) + L_v(1:knon)*HQphiQ_b(1:knon) + HQRn_b(1:knon) +  &
     465                      (sigx(1:knon) - sigw(1:knon) - sigw(1:knon)*sigx(1:knon)*dd_KQs(1:knon)/Kech_Qs(1:knon)) *  &
     466                       (dd_HQphiT(1:knon) + L_v(1:knon)*dd_HQphiQ(1:knon) + dd_HQRn(1:knon)) )
     467
     468!!   g_Q(1:knon) = - (dd_QQ(1:knon)/QQ_b(1:knon)) *  &
     469!!                    (sigx(1:knon)-sigw(1:knon)-sigw(1:knon)*sigx(1:knon)*dd_HQphiQ(1:knon)/HQphiQ_b(1:knon)) &
     470!!                 - sqrt(tau(1:knon))/(Inert(1:knon)*QQ_b(1:knon)) *  &
     471!!                   ( HQphiT_b(1:knon) + L_v(1:knon)*HQphiQ_b(1:knon) + HQRn_b(1:knon) +  &
     472!!                      (sigx(1:knon) - sigw(1:knon) - sigw(1:knon)*sigx(1:knon)*dd_HQphiQ(1:knon)/HQphiQ_b(1:knon)) *  &
     473!!                       (dd_HQphiT(1:knon) + L_v(1:knon)*dd_HQphiQ(1:knon) + dd_HQRn(1:knon)) )
     474
     475!! g_Q(1:knon) = - (sqrt(tau(1:knon))/(Inert(1:knon)*QQ_b(1:knon))) *  &
     476!!                 ( HQphiT_b(1:knon) + L_v(1:knon)*HQphiQ_b(1:knon) + HQRn_b(1:knon) )  &
     477!!               - (sigx(1:knon) - sigw(1:knon) - sigw(1:knon)*sigx(1:knon)*dd_HQphiQ(1:knon)/HQphiQ_b(1:knon)) *   &
     478!!                 ( dd_QQ(1:knon)/QQ_b(1:knon)   &
     479!!                 + (sqrt(tau(1:knon))/(Inert(1:knon)*QQ_b(1:knon)))  &
     480!!                 * (dd_HQphiT(1:knon) + L_v(1:knon)*dd_HQphiQ(1:knon) + dd_HQRn(1:knon)) )
     481
     482!  Ts, qs Coupling coefficients                /
     483!  ----------------------------
     484  Gamma_phiT(1:knon) = (sqrt(tau(1:knon))/(Inert(1:knon)*HTphiT_b(1:knon)))  &
     485                     * (dd_HTphiT(1:knon) + L_v(1:knon)*dd_HTphiQ(1:knon) + dd_HTRn(1:knon))
     486!
     487  Gamma_phiQ(1:knon) = (1./(Kech_Qs(1:knon)*QQ_b(1:knon))) * &
     488                        ( dd_QQ(1:knon)   &
     489                         + (sqrt(tau(1:knon))/(Inert(1:knon))) *  &
     490                          (dd_HQphiT(1:knon) + L_v(1:knon)*dd_HQphiQ(1:knon) + dd_HQRn(1:knon)) )
     491
     492!!  Gamma_phiQ(1:knon) = (beta(1:knon)/(HQphiQ_b(1:knon)*QQ_b(1:knon))) * &
     493!!                        ( dd_QQ(1:knon)   &
     494!!                         + (sqrt(tau(1:knon))/(Inert(1:knon))) *  &
     495!!                          (dd_HQphiT(1:knon) + L_v(1:knon)*dd_HQphiQ(1:knon) + dd_HQRn(1:knon)) )
     496
     497!!  Gamma_phiQ(1:knon) = (1/(HQphiQ_b(1:knon)*QQ_b(1:knon)))   &
     498!!                     * ( dd_QQ(1:knon)   &
     499!!                       + (sqrt(tau(1:knon))/(Inert(1:knon)))  &
     500!!                       * (dd_HQphiT(1:knon) + L_v(1:knon)*dd_HQphiQ(1:knon) + dd_HQRn(1:knon)) )
     501!
     502!  Insensitive changes
     503!  -------------------
     504  dTs_ins(1:knon)    = (sqrt(tau(1:knon))/Inert(1:knon))*  &
     505                       (dphiT0(1:knon) + L_v(1:knon)*dphiQ0(1:knon) + dRn0(1:knon))
     506!
     507  dqsatsrf_ins(1:knon) = (beta(1:knon)/QQ_b(1:knon))*dTs_ins(1:knon)
     508!
     509   IF (prt_level .Ge. 10) THEN
     510      print *,'wx_pbl_merge, tau         ', tau
     511      print *,'wx_pbl_merge, AcoefT0     ', AcoefT0
     512      print *,'wx_pbl_merge, AcoefQ0     ', AcoefQ0
     513      print *,'wx_pbl_merge, BcoefT0     ', BcoefT0
     514      print *,'wx_pbl_merge, BcoefQ0     ', BcoefQ0
     515      print *,'wx_pbl_merge, qsat0_w, qsat0_x ', (qsat0_w(j), qsat0_x(j),j=1,knon)
     516      print *,'wx_pbl_merge, dqsatdT0_w, dqsatdT0_x ', (dqsatdT0_w(j), dqsatdT0_x(j),j=1,knon)
     517   ENDIF
     518!
     519!----------------------------------------------------------------------------
     520! 
     521!------------------------------------------------------------------------------
     522! 
     523!    Effective coefficients Acoef and Bcoef
     524!    --------------------------------------
     525   DO j = 1,knon
     526     AcoefT(j) = AcoefT0(j) - sigw(j)*sigx(j)*(dd_KTp(j)/Kech_Tp(j))*C_p(j)*   &
     527                 (dTs0(j) + (dTs_ins(j)-dTs0(j)-Gamma_phiT(j)*phiT0_b(j))/(1. - g_T(j)))
     528     BcoefT(j) = BcoefT0(j) - sigw(j)*sigx(j)*(dd_KTp(j)/Kech_Tp(j))*C_p(j)*Gamma_phiT(j)/(1. - g_T(j))/dtime
     529     
     530     AcoefQ(j) = AcoefQ0(j) - sigw(j)*sigx(j)*(dd_KQs(j)/Kech_Qs(j))*    &
     531                 (dqsatsrf0(j) + (dqsatsrf_ins(j)-(beta(j)/QQ_b(j))*dTs0(j)-Gamma_phiQ(j)*phiQ0_b(j))/(1 - g_Q(j)))/ &
     532                 max(beta(j),1.e-4)
     533     BcoefQ(j) = BcoefQ0(j) - sigw(j)*sigx(j)*(dd_KQs(j)/Kech_Qs(j))*Gamma_phiQ(j)/(1 - g_Q(j))/ &
     534                 (max(beta(j),1.e-4)*dtime)
     535!!     AcoefQ(j) = AcoefQ0(j) - sigw(j)*sigx(j)*(dd_KQs(j)/Kech_Qs(j))*    &
     536!!                 (dqsatsrf0(j) + (dqsatsrf_ins(j)-(beta(j)/QQ_b(j))*dTs0(j)-Gamma_phiQ(j)*phiQ0_b(j))/(1 - g_Q(j)))/ &
     537!!                 beta(j)
     538!!     BcoefQ(j) = BcoefQ0(j) - sigw(j)*sigx(j)*(dd_KQs(j)/Kech_Qs(j))*Gamma_phiQ(j)/(1 - g_Q(j))/(beta(j)*dtime)
     539   ENDDO ! j = 1,knon
     540   
     541   IF (prt_level .Ge. 10) THEN
     542   print *,'wx_pbl_dts AAAA BcoefQ, BcoefQ0, sigw ', &
     543                            BcoefQ, BcoefQ0, sigw
     544      print *,'wx_pbl_dts_merge, dTs_ins      ', dTs_ins
     545      print *,'wx_pbl_dts_merge, dqs_ins      ', dqsatsrf_ins
     546   ENDIF
     547
     548     RETURN
     549
     550END SUBROUTINE wx_pbl_dts_merge
     551
     552SUBROUTINE wx_pbl_split(knon, nsrf, dtime, sigw, beta, iflag_split, &
     553                       g_T, g_Q, &
     554                       Gamma_phiT, Gamma_phiQ, &
     555                       dTs_ins, dqsatsrf_ins, &
     556                       phiT, phiQ, phiU, phiV, &
     557!!!!                       HTRn_b, dd_HTRn, HTphiT_b, dd_HTphiT, &
     558                       phiQ0_b, phiT0_b, &
     559                       phiT_x, phiT_w, &
     560                       phiQ_x, phiQ_w, &
     561                       phiU_x, phiU_w, &
     562                       phiV_x, phiV_w, &
     563                       philat_x, philat_w, &
     564!!!!                       Rn_b, dRn, &
     565                       dqsatsrf, &
     566                       dTs, delta_qsurf &
     567                       )
     568!
     569
     570    USE wx_pbl_var_mod
     571
     572    USE print_control_mod, ONLY: prt_level,lunout
     573    USE indice_sol_mod, ONLY: is_oce
     574!
     575    INCLUDE "YOMCST.h"
     576!
     577    INTEGER,                      INTENT(IN)        :: knon    ! number of grid cells
     578    INTEGER,                      INTENT(IN)        :: nsrf    ! surface type
     579    REAL,                         INTENT(IN)        :: dtime   ! time step size (s)
     580    REAL, DIMENSION(knon),        INTENT(IN)        :: sigw ! cold pools fractional area
     581    REAL, DIMENSION(knon),        INTENT(IN)        :: beta ! aridity factor
     582    INTEGER,                      INTENT(IN)        :: iflag_split
     583    REAL, DIMENSION(knon),        INTENT(IN)        :: g_T, g_Q
     584    REAL, DIMENSION(knon),        INTENT(IN)        :: Gamma_phiT, Gamma_phiQ
     585    REAL, DIMENSION(knon),        INTENT(IN)        :: dTs_ins, dqsatsrf_ins
     586    REAL, DIMENSION(knon),        INTENT(IN)        :: phiT, phiQ, phiU, phiV
     587    REAL, DIMENSION(knon),        INTENT(IN)        :: phiQ0_b, phiT0_b
     588!
     589    REAL, DIMENSION(knon),        INTENT(OUT)       :: phiT_x, phiT_w
     590    REAL, DIMENSION(knon),        INTENT(OUT)       :: phiQ_x, phiQ_w
     591    REAL, DIMENSION(knon),        INTENT(OUT)       :: phiU_x, phiU_w
     592    REAL, DIMENSION(knon),        INTENT(OUT)       :: phiV_x, phiV_w
     593    REAL, DIMENSION(knon),        INTENT(OUT)       :: philat_x, philat_w
     594    REAL, DIMENSION(knon),        INTENT(OUT)       :: dqsatsrf      ! beta delta(qsat(Ts))
     595    REAL, DIMENSION(knon),        INTENT(OUT)       :: dTs           ! Temperature difference at surface
     596    REAL, DIMENSION(knon),        INTENT(OUT)       :: delta_qsurf
    363597!
    364598!! Local variables
    365599    INTEGER                    :: j
    366     REAL, DIMENSION(knon)      :: y_delta_flux_t1, y_delta_flux_q1, y_delta_flux_u1, y_delta_flux_v1
    367 !
    368     REAL                       :: DDT, DDQ, DDU, DDV
    369     REAL                       :: LambdaTs, LambdaQs, LambdaUs, LambdaVs
     600    REAL, DIMENSION(knon)      :: dphiT, dphiQ, dphiU, dphiV
     601    REAL, DIMENSION(knon)      :: q1_x, q1_w
    370602!
    371603    REAL, DIMENSION(knon)      :: sigx       ! fractional area of (x) region
     604
     605!----------------------------------------------------------------------------
     606!  Equations
     607!  ---------
     608!!!!!! (1 - g_T) dTs    = dTs_ins    + Gamma_phiT phiT
     609!!!!!! (1 - g_Q) dqsatsrf = dqsatsrf_ins + Gamma_phiQ phiQ
     610!!!!!! dphiT = (dd_KTp/KTp) phiT + (     dd_AT - C_p dTs)*KxKwTp/KTp
     611!!!!!! dphiQ = (dd_KQs/KQs) phiQ + (beta dd_AQ - dqsatsrf )*KxKwQs/KQs
     612!!!!!! dphiU = (dd_KUp/KUp) phiU + (     dd_AU          )*KxKwUp/KUp
     613!!!!!! dphiV = (dd_KVp/KVp) phiV + (     dd_AV          )*KxKwVp/KVp
     614!
     615! (1 - g_T) (dTs-dTs0)    = dTs_ins-dTs0    + Gamma_phiT (phiT-phiT0)
     616! (1 - g_Q) dqsatsrf = dqsatsrf_ins + Gamma_phiQ phiQ
     617! dphiT = (dd_KTp/KTp) phiT + (     dd_AT - C_p dTs)*KxKwTp/KTp
     618! dphiQ = (dd_KQs/KQs) phiQ + (beta dd_AQ - dqsatsrf )*KxKwQs/KQs
     619! dphiU = (dd_KUp/KUp) phiU + (     dd_AU          )*KxKwUp/KUp
     620! dphiV = (dd_KVp/KVp) phiV + (     dd_AV          )*KxKwVp/KVp
     621!
    372622!!
    373         sigx(:) = 1.-ywake_s(:)
    374 
    375         DO j=1,knon
    376 !
    377        DDT = Kech_Tp(j)
    378        DDQ = Kech_Qp(j)
    379        DDU = Kech_Up(j)
    380        DDV = Kech_Vp(j)
    381 !
    382        LambdaTs =  dd_KTp(j)/DDT
    383        LambdaQs =  dd_KQp(j)/DDQ
    384        LambdaUs =  dd_KUp(j)/DDU
    385        LambdaVs =  dd_KVp(j)/DDV
    386 !
    387          y_delta_flux_t1(j) = y_flux_t1(j)*LambdaTs + dd_AT(j)*KxKwTp(j)/DDT
    388          y_delta_flux_q1(j) = y_flux_q1(j)*LambdaQs + dd_AQ(j)*KxKwQp(j)/DDQ
    389          y_delta_flux_u1(j) = y_flux_u1(j)*LambdaUs + dd_AU(j)*KxKwUp(j)/DDU
    390          y_delta_flux_v1(j) = y_flux_v1(j)*LambdaVs + dd_AV(j)*KxKwVp(j)/DDV
    391 !
    392          y_flux_t1_x(j)=y_flux_t1(j) - ywake_s(j)*y_delta_flux_t1(j)
    393          y_flux_t1_w(j)=y_flux_t1(j) + (1.-ywake_s(j))*y_delta_flux_t1(j)
    394          y_flux_q1_x(j)=y_flux_q1(j) - ywake_s(j)*y_delta_flux_q1(j)
    395          y_flux_q1_w(j)=y_flux_q1(j) + (1.-ywake_s(j))*y_delta_flux_q1(j)
    396          y_flux_u1_x(j)=y_flux_u1(j) - ywake_s(j)*y_delta_flux_u1(j)
    397          y_flux_u1_w(j)=y_flux_u1(j) + (1.-ywake_s(j))*y_delta_flux_u1(j)
    398          y_flux_v1_x(j)=y_flux_v1(j) - ywake_s(j)*y_delta_flux_v1(j)
    399          y_flux_v1_w(j)=y_flux_v1(j) + (1.-ywake_s(j))*y_delta_flux_v1(j)
    400 !
    401          yfluxlat_x(j)=y_flux_q1_x(j)*RLVTT
    402          yfluxlat_w(j)=y_flux_q1_w(j)*RLVTT
    403 !
    404 !       Delta_tsurf computation
    405 !!         y_delta_tsurf(j) = (1./RCPD)*(ah(j)*dd_AT(j) + &
    406 !!                                       ah(j)*y_flux_t1(j)*dd_BT(j)*dtime + &
    407 !!                                       y_delta_flux_t1(j)*(ah(j)*BBT+bh(j)) )
    408 !
    409            y_delta_tsurf(j) = 0.
    410 !
    411         ENDDO
     623        sigx(:) = 1.-sigw(:)
     624!
     625!      print *,' AAAA wx_pbl_split, C_p(j), qsat0(j), Ts0(j) : ', C_p(:), qsat0(:), Ts0(:)
     626!
     627   IF (iflag_split .EQ. 2 .AND. nsrf .NE. is_oce) THEN
     628!
     629!   Delta_tsurf and  Delta_qsurf computation
     630!   -----------------------------------------
     631      IF (prt_level >=10 ) THEN
     632        print *,' wx_pbl_split, dTs_ins, dTs0 , Gamma_phiT, g_T ', dTs_ins, dTs0, Gamma_phiT, g_T
     633        print *,' wx_pbl_split, dqsatsrf_ins, Gamma_phiQ, g_q ', dqsatsrf_ins, Gamma_phiQ, g_q
     634      ENDIF
     635!
     636      DO j = 1,knon
     637        dTs(j)    = dTs0(j) + (dTs_ins(j) - dTs0(j) + Gamma_phiT(j)*(phiT(j)-phiT0_b(j)) )/(1 - g_T(j))
     638        dqsatsrf(j) = dqsatsrf0(j) + (dqsatsrf_ins(j) - (beta(j)/QQ_b(j))*dTs0(j) + &
     639                       Gamma_phiQ(j)*(phiQ(j)-phiQ0_b(j)) )/(1 - g_Q(j))
     640      ENDDO ! j = 1,knon
     641!
     642        IF (prt_level >=10 ) THEN
     643          print *,' wx_pbl_split, dqsatsrf0, QQ_b ', dqsatsrf0, QQ_b
     644          print *,' wx_pbl_split, phiT0_b, phiT, dTs ', phiT0_b, phiT, dTs
     645          print *,' wx_pbl_split, phiQ0_b, phiQ, dqsatsrf ', phiQ0_b, phiQ, dqsatsrf
     646        ENDIF
     647   ELSE
     648        dTs(:) = 0.
     649        dqsatsrf(:) = 0.
     650   ENDIF ! (iflag_split .EQ. 2 .AND. nsrf .NE. is_oce)
     651!
     652     DO j = 1,knon
     653       dphiT(j) = (phiT(j)*dd_KTp(j) + (        dd_AT(j) - C_p(j)*dTs(j))*KxKwTp(j))/Kech_Tp(j)
     654       dphiQ(j) = (phiQ(j)*dd_KQs(j) + (beta(j)*dd_AQ(j) -        dqsatsrf(j))*KxKwQs(j))/Kech_Qs(j)
     655       dphiU(j) = (phiU(j)*dd_KUp(j) +          dd_AU(j)                 *KxKwUp(j))/Kech_Up(j)
     656       dphiV(j) = (phiV(j)*dd_KVp(j) +          dd_AV(j)                 *KxKwVp(j))/Kech_Vp(j)
     657!
     658       phiT_x(j)=phiT(j) - sigw(j)*dphiT(j)
     659       phiT_w(j)=phiT(j) + sigx(j)*dphiT(j)
     660       phiQ_x(j)=phiQ(j) - sigw(j)*dphiQ(j)
     661       phiQ_w(j)=phiQ(j) + sigx(j)*dphiQ(j)
     662       phiU_x(j)=phiU(j) - sigw(j)*dphiU(j)
     663       phiU_w(j)=phiU(j) + sigx(j)*dphiU(j)
     664       phiV_x(j)=phiV(j) - sigw(j)*dphiV(j)
     665       phiV_w(j)=phiV(j) + sigx(j)*dphiV(j)
     666!
     667       philat_x(j)=phiQ_x(j)*RLVTT
     668       philat_w(j)=phiQ_w(j)*RLVTT
     669     ENDDO ! j = 1,knon
     670!
     671     DO j = 1,knon
     672       q1_x(j) = AQ_x(j) + BQ_x(j)*phiQ_x(j)*dtime
     673       q1_w(j) = AQ_w(j) + BQ_w(j)*phiQ_w(j)*dtime
     674     ENDDO ! j = 1,knon
     675     DO j = 1,knon
     676       delta_qsurf(j) = (1.-beta(j))*(q1_w(j) - q1_x(j)) + dqsatsrf(j)
     677     ENDDO ! j = 1,knon
     678!
     679!!  Do j = 1,knon
     680!!     print *,'XXXsplit : j, q1_x(j), AQ_x(j), BQ_x(j), phiQ_x(j) ', j, q1_x(j), AQ_x(j), BQ_x(j), phiQ_x(j)
     681!!     print *,'XXXsplit : j, q1_w(j), AQ_w(j), BQ_w(j), phiQ_w(j) ', j, q1_w(j), AQ_w(j), BQ_w(j), phiQ_w(j)
     682!!  ENDDO
     683!
     684        IF (prt_level >=10 ) THEN
     685          print *,' wx_pbl_split, phiT, dphiT, dTs ', phiT, dphiT, dTs
     686          print *,' wx_pbl_split, phiQ, dphiQ, dqsatsrf ', phiQ, dphiQ, dqsatsrf
     687        ENDIF
     688!
     689        IF (prt_level >=10 ) THEN
     690!!          print *,' wx_pbl_split, verif dqsatsrf = beta dqsatdT0 dTs '
     691!!          print *,' wx_pbl_split, dqsatsrf, dqsatdT0*dTs ', dqsatsrf, dqsatdT0*dTs
     692        ENDIF
     693!
     694!!    IF (knon .NE. 0) THEN
     695!!       call  iophys_ecrit('sigw', 1,'sigw', '.',sigw)
     696!!       call  iophys_ecrit('phit', 1,'phit', 'W/m2',phit)
     697!!       call  iophys_ecrit('phit_w', 1,'phit_w', 'W/m2',phit_w)
     698!!       call  iophys_ecrit('phit_x', 1,'phit_x', 'W/m2',phit_x)
     699!!       call  iophys_ecrit('phiq', 1,'phiq', 'kg/m2/s',phiq)
     700!!       call  iophys_ecrit('phiq_w', 1,'phiq_w', 'kg/m2/s',phiq_w)
     701!!       call  iophys_ecrit('phiq_x', 1,'phiq_x', 'kg/m2/s',phiq_x)
     702!!       call  iophys_ecrit('q1_w', 1,'q1_w', '.',q1_w)
     703!!       call  iophys_ecrit('q1_x', 1,'q1_x', '.',q1_x)
     704!!    ENDIF  ! (knon .NE. 0)
    412705!
    413706        RETURN
    414707
    415 END SUBROUTINE wx_pbl0_split
    416 
    417 SUBROUTINE wx_pbl_final
    418 !
    419 !****************************************************************************************
    420 ! Deallocate module variables
    421 !
    422 !****************************************************************************************   
    423 !
    424     IF (ALLOCATED(Kech_Tp))        DEALLOCATE(Kech_Tp)
    425     IF (ALLOCATED(Kech_T_xp))      DEALLOCATE(Kech_T_xp)
    426     IF (ALLOCATED(Kech_T_wp))      DEALLOCATE(Kech_T_wp)
    427     IF (ALLOCATED(dd_KTp))         DEALLOCATE(dd_KTp)
    428     IF (ALLOCATED(KxKwTp))         DEALLOCATE(KxKwTp)
    429     IF (ALLOCATED(dd_AT))          DEALLOCATE(dd_AT)
    430     IF (ALLOCATED(dd_BT))          DEALLOCATE(dd_BT)
    431     IF (ALLOCATED(Kech_Qp))        DEALLOCATE(Kech_Qp)
    432     IF (ALLOCATED(Kech_Q_xp))      DEALLOCATE(Kech_Q_xp)
    433     IF (ALLOCATED(Kech_Q_wp))      DEALLOCATE(Kech_Q_wp)
    434     IF (ALLOCATED(dd_KQp))         DEALLOCATE(dd_KQp)
    435     IF (ALLOCATED(KxKwQp))         DEALLOCATE(KxKwQp)
    436     IF (ALLOCATED(dd_AQ))          DEALLOCATE(dd_AQ)
    437     IF (ALLOCATED(dd_BQ))          DEALLOCATE(dd_BQ)
    438     IF (ALLOCATED(Kech_Up))        DEALLOCATE(Kech_Up)
    439     IF (ALLOCATED(Kech_U_xp))      DEALLOCATE(Kech_U_xp)
    440     IF (ALLOCATED(Kech_U_wp))      DEALLOCATE(Kech_U_wp)
    441     IF (ALLOCATED(dd_KUp))         DEALLOCATE(dd_KUp)
    442     IF (ALLOCATED(KxKwUp))         DEALLOCATE(KxKwUp)
    443     IF (ALLOCATED(dd_AU))          DEALLOCATE(dd_AU)
    444     IF (ALLOCATED(dd_BU))          DEALLOCATE(dd_BU)
    445     IF (ALLOCATED(Kech_Vp))        DEALLOCATE(Kech_Vp)
    446     IF (ALLOCATED(Kech_V_xp))      DEALLOCATE(Kech_V_xp)
    447     IF (ALLOCATED(Kech_V_wp))      DEALLOCATE(Kech_V_wp)
    448     IF (ALLOCATED(KxKwVp))         DEALLOCATE(KxKwVp)
    449     IF (ALLOCATED(dd_KVp))         DEALLOCATE(dd_KVp)
    450     IF (ALLOCATED(dd_AV))          DEALLOCATE(dd_AV)
    451     IF (ALLOCATED(dd_BV))          DEALLOCATE(dd_BV)
    452 
    453 END SUBROUTINE wx_pbl_final
     708END SUBROUTINE wx_pbl_split
     709
     710SUBROUTINE wx_pbl_check( knon, dtime, ypplay, ypaprs, &
     711                               sigw, beta, iflag_split,   &
     712                               Ts0_b9, dTs09,   &
     713                               qs_b9, Ts_b9,  &                         ! yqsurf, Tsurf_new
     714                               dTs9, dqsatsrf9,   &
     715                               AcoefT_x, AcoefT_w, &
     716                               BcoefT_x, BcoefT_w, &
     717                               AcoefT0, AcoefQ0, BcoefT0, BcoefQ0, &
     718                               AcoefT,  AcoefQ,  BcoefT,  BcoefQ, &
     719                               phiT_b9, phiQ_b9,  &
     720                               phiT_x9, phiT_w9, &
     721                               phiQ_x9, phiQ_w9 &
     722                               )
     723!
     724
     725    USE wx_pbl_var_mod
     726
     727    USE print_control_mod, ONLY: prt_level,lunout
     728!
     729    INCLUDE "YOMCST.h"
     730    INCLUDE "FCTTRE.h"
     731    INCLUDE "YOETHF.h"
     732!
     733    INTEGER,                      INTENT(IN)        :: knon         ! number of grid cells
     734    REAL,                         INTENT(IN)        :: dtime        ! time step size (s)
     735    REAL, DIMENSION(knon,klev),   INTENT(IN)        :: ypplay       ! mid-layer pressure (Pa)
     736    REAL, DIMENSION(knon,klev),   INTENT(IN)        :: ypaprs       ! pressure at layer interfaces (pa)
     737    REAL, DIMENSION(knon),        INTENT(IN)        :: sigw         ! cold pools fractional area
     738    REAL, DIMENSION(knon),        INTENT(IN)        :: beta         ! aridity factor
     739    INTEGER,                      INTENT(IN)        :: iflag_split
     740    REAL, DIMENSION(knon),        INTENT(IN)        :: Ts0_b9, dTs09
     741    REAL, DIMENSION(knon),        INTENT(IN)        :: qs_b9, Ts_b9         ! yqsurf, Tsurf_new
     742    REAL, DIMENSION(knon),        INTENT(IN)        :: dTs9, dqsatsrf9
     743    REAL, DIMENSION(knon),        INTENT(IN)        :: AcoefT_x, AcoefT_w
     744    REAL, DIMENSION(knon),        INTENT(IN)        :: BcoefT_x, BcoefT_w
     745    REAL, DIMENSION(knon),        INTENT(IN)        :: AcoefT0, AcoefQ0, BcoefT0, BcoefQ0
     746!
     747    REAL, DIMENSION(knon),        INTENT(IN)        :: AcoefT, AcoefQ, BcoefT, BcoefQ
     748    REAL, DIMENSION(knon),        INTENT(IN)        :: phiT_b9, phiQ_b9
     749    REAL, DIMENSION(knon),        INTENT(IN)        :: phiT_x9, phiT_w9
     750    REAL, DIMENSION(knon),        INTENT(IN)        :: phiQ_x9, phiQ_w9
     751!
     752!! Local variables
     753    INTEGER                    :: j
     754    REAL, DIMENSION(knon)      :: sigx                 ! fractional area of (x) region
     755    REAL, DIMENSION(knon)      :: AcoefT_b, AcoefQ_b   ! mean values of AcoefT and AcoefQ
     756    REAL                       :: zzt, zzq, zzqsat
     757    REAL                       :: zdelta, zcvm5, zcor, qsat
     758    REAL, DIMENSION(knon)      :: qsat_w, qsat_x
     759    REAL, DIMENSION(knon)      :: dqsatdT_w, dqsatdT_x
     760    REAL, DIMENSION(knon)      :: qsat_bs              ! qsat(Ts_b)
     761    REAL, DIMENSION(knon)      :: qsat01, dqsatdT01
     762    REAL, DIMENSION(knon)      :: Ts_x, Ts_w, qs_x, qs_w
     763    REAL, DIMENSION(knon)      :: T1_x, T1_w, q1_x, q1_w
     764    REAL, DIMENSION(knon)      :: Rn_x, Rn_w
     765    REAL, DIMENSION(knon)      :: phiQ0_x, phiQ0_w
     766    REAL, DIMENSION(knon)      :: Ta, qa
     767    REAL, DIMENSION(knon)      :: qsatsrf_w, qsatsrf_x, qsatsrf_b
     768    REAL, DIMENSION(knon)      :: qsurf_w, qsurf_x
     769    REAL                       :: dphiT, dphiQ
     770    REAL                       :: dqsatsrf1
     771    REAL                       :: phiT_w1, phiT_w2
     772    REAL                       :: phiT_x1, phiT_x2
     773    REAL                       :: phiQ_w1, phiQ_w2, phiQ_w3
     774    REAL                       :: phiQ_x1, phiQ_x2, phiQ_x3
     775    REAL                       :: phiT_b1, phiQ_b1
     776    REAL                       :: Kech_Q_sw1, Kech_Q_sx1
     777    REAL                       :: evap_pot
     778
     779!----------------------------------------------------------------------------
     780! Equations to be checked:
     781! -----------------------
     782!  Input : Ts0_b, dTs0, Ts_b, dTs, qsatsrf_b, dqsatsrf,
     783!          phiT_b, phiQ_b, phiT_w, phiT_x, phiQ_w, phiQ_x,
     784!         
     785!          AcoefT, AcoefQ, AcoefT_w, AcoefQ_w, AcoefT_x, AcoefQ_x,
     786!          BcoefT, BcoefQ, BcoefT_w, BcoefQ_w, BcoefT_x, BcoefQ_x
     787!
     788!  C_p T1_w = AcoefT_w + BcoefT_w phiT_w Delta t          C_p T1_x = AcoefT_x + BcoefT_x phiT_x Delta t
     789!  q1_w = AQ_w + BQ_w phiQ_w Delta t                      q1_x = AQ_x + BQ_x phiQ_x Delta t
     790!  qsatsrf_w = beta qsat(Ts_w)                            qsatsrf_x = beta qsat(Ts_x)
     791!  qsurf_w = (1-beta) q1_w + qsatsrf_w                    qsurf_x = (1-beta) q1_x + qsatsrf_x
     792!  phiT_w = Kech_h_w C_p ( T1_w - Ts_w)                   phiT_x = Kech_h_x C_p ( T1_x - Ts_x)             
     793!  phiT_w = Kech_T_pw ( AcoefT_w - C_p Ts_w)              phiT_x = Kech_T_px ( AcoefT_x - C_p Ts_x)
     794!  phiq_w = Kech_h_w ( beta q1_w - qsatsrf_w)             phiq_x = Kech_h_x ( beta q1_x - qsatsrf_x))
     795!  phiq_w = Kech_Q_sw (beta AQ_w -qsatsrf_w)              phiq_x = Kech_Q_sx (beta AQ_x -qsatsrf_x)
     796!  phiq_w = Kech_h_w (q1_w - qsurf_w)                     phiq_x = Kech_h_x (q1_x - qsurf_x)
     797!  phiT_b = sigw phiT_w + sigx phiT_x                     dphiT = phiT_w - phiT_x
     798!  phiQ_b = sigw phiQ_w + sigx phiQ_x                     dphiQ = phiQ_w - phiQ_x
     799!  Ts_b = sigw Ts_w + sigx Ts_x                           dTs = Ts_w - Ts_x
     800!  qsatsrf_b = sigw qsatsrf_w + sigx qsatsrf_x
     801!  C_p Ta = AcoefT + BcoefT phiT_b Delta t
     802!  qa = AcoefQ + BcoefQ phiQ_b Delta t
     803!  phiT_b = Kech_h C_p (Ta - Ts_b)
     804!  phiQ_b = beta Kech_h (qa - qsatsrf_b)
     805!  dTs = sqrt(tau)/I (dphit + L_v dphiq + dR)
     806
     807!----------------------------------------------------------------------------
     808!
     809!!
     810        sigx(:) = 1.-sigw(:)
     811        AcoefT_b(1:knon) = AcoefT_x(1:knon) + sigw(1:knon)*dd_AT(1:knon)
     812        AcoefQ_b(1:knon) = AQ_x(1:knon) + sigw(1:knon)*dd_AQ(1:knon)
     813
     814! Compute the three qsat and dqsatdTs
     815! ---------------------------------------------
     816!!   C_p(1:knon) = RCpd
     817!!   L_v(1:knon) = RLvtt
     818    IF (prt_level >=10 ) THEN
     819      print *,' AAAA wx_pbl_check, C_p(j), qsat0(j), Ts0(j) : ', C_p(:), qsat0(:), Ts0(:)
     820    ENDIF ! (prt_level >=10 )
     821!
     822   DO j = 1, knon
     823      zdelta = MAX(0.,SIGN(1.,RTT-Ts0_b9(j)))
     824      zcvm5 = R5LES*(1.-zdelta) + R5IES*zdelta
     825      qsat = R2ES*FOEEW(Ts0_b9(j),zdelta)/ypaprs(j,1)
     826      qsat = MIN(0.5,qsat)
     827      zcor = 1./(1.-RETV*qsat)
     828      qsat01(j) = fqsat*qsat*zcor
     829!!      dqsatdT0(j) = FOEDE(Ts0_b(j),zdelta,zcvm5,qsat0(j),zcor)/RLVTT    ! jyg 20210116
     830!!      dqsatdT0(j) = (RLvtt*(1.-zdelta)+RLSTT*zdelta)*qsat0(j)/(Rv*Ts0_b(j)*Ts0_b(j))
     831      dqsatdT01(j) = fqsat*FOEDE(Ts0_b9(j),zdelta,zcvm5,qsat01(j),zcor)
     832   ENDDO
     833!
     834!--------------------------------------------------------------------------------------------------
     835        IF (prt_level >=10 ) THEN
     836!
     837          DO j = 1, knon
     838!
     839   print *,'wx_pbl_check: Kech_h, Kech_q ', Kech_h(j), Kech_q(j)
     840!
     841  Ta(j) = (AcoefT(j) + BcoefT(j)*phiT_b9(j)*dtime)/C_p(j)
     842  qa(j) = AcoefQ(j) + BcoefQ(j)*phiQ_b9(j)*dtime
     843    print *, 'wx_pbl_check: j, Ta, qa ', Ta(j), qa(j)
     844!
     845  qsat_bs(j) = qsat01(j) + dqsatdT01(j)*(Ts_b9(j)-Ts0_b9(j))
     846!
     847   print *,'wx_pbl_check: qsat01, qsat_bs ', j,qsat01(j), qsat_bs(j)
     848!
     849  Ts_x(j) = Ts_b9(j) - sigw(j)*dTs9(j)
     850  Ts_w(j) = Ts_b9(j) + sigx(j)*dTs9(j)
     851    print *, 'wx_pbl_check: j, Ts_b9, Ts_w, Ts_x ', j, Ts_b9(j), Ts_w(j), Ts_x(j)
     852!
     853  qsat_x(j) = qsat0_x(j) + dqsatdT0_x(j)*(Ts_x(j)-Ts0_x(j))
     854  qsat_w(j) = qsat0_w(j) + dqsatdT0_w(j)*(Ts_w(j)-Ts0_w(j))
     855!
     856   print *,'wx_pbl_check: qsat0_w, qsat0_x, qsat_w, qsat_x ', qsat0_w(j), qsat0_x(j), qsat_w(j), qsat_x(j)
     857!
     858  T1_x(j) = (AcoefT_x(j) + BcoefT_x(j)*phiT_x9(j)*dtime) / C_p(j)
     859  T1_w(j) = (AcoefT_w(j) + BcoefT_w(j)*phiT_w9(j)*dtime) / C_p(j)
     860    print *, 'wx_pbl_check: j, T1_w, T1_x ', j, T1_w(j), T1_x(j)
     861!
     862  q1_x(j) = AQ_x(j) + BQ_x(j)*phiQ_x9(j)*dtime
     863  q1_w(j) = AQ_w(j) + BQ_w(j)*phiQ_w9(j)*dtime
     864    print *, 'wx_pbl_check: j, q1_w, q1_x ', j, q1_w(j), q1_x(j)
     865!
     866   qsatsrf_x(j) = beta(j)*qsat_x(j)
     867   qsatsrf_w(j) = beta(j)*qsat_w(j)
     868   qsatsrf_b(j) = sigw(j)*qsatsrf_w(j) + sigx(j)*qsatsrf_x(j)
     869!
     870   dqsatsrf1 = qsatsrf_w(j) - qsatsrf_x(j)
     871    print *, 'wx_pbl_check: j, qsatsrf_w, qsatsrf_x, dqsatsrf1, dqsatsrf9 ', &
     872                          qsatsrf_w(j), qsatsrf_x(j), dqsatsrf1, dqsatsrf9(j)
     873!
     874   qsurf_x(j) = (1-beta(j))*q1_x(j) + qsatsrf_x(j)
     875   qsurf_w(j) = (1-beta(j))*q1_w(j) + qsatsrf_w(j)
     876    print *, 'wx_pbl_check: j, qsurf_w, qsurf_x ', j, qsurf_w(j), qsurf_x(j)
     877!
     878!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     879!  Test qsat01 = qsat0    et   dqsatdT01 = dqsatdT0
     880!------------------------------------------------------------------------------------------------------
     881   print *, 'wx_pbl_check: j, qsat01(j), qsat0(j) ', j, qsat01(j), qsat0(j)
     882   print *, 'wx_pbl_check: j, dqsatdT01(j), dqsatdT0(j) ', j, dqsatdT01(j), dqsatdT0(j)
     883!
     884!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     885!  Test Kexh_Q_sw = Kech_q_w/(1.-beta*Kech_q_w*BcoefQ)   Kexh_Q_sx = Kech_q_x/(1.-beta*Kech_q_x*BcoefQ)
     886!------------------------------------------------------------------------------------------------------
     887  Kech_Q_sx1 = Kech_q_x(j)/(1.-beta(j)*Kech_q_x(j)*BQ_x(j)*dtime)
     888  Kech_Q_sw1 = Kech_q_w(j)/(1.-beta(j)*Kech_q_w(j)*BQ_w(j)*dtime)
     889    print *, 'wx_pbl_check: j, Kech_Q_sx1, Kech_Q_sx(j)', j, Kech_Q_sx1, Kech_Q_sx(j)
     890    print *, 'wx_pbl_check: j, Kech_Q_sw1, Kech_Q_sw(j)', j, Kech_Q_sw1, Kech_Q_sw(j)
     891!
     892!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     893!  Test phiT_w = Kech_h_w*C_p(j)*(T1_w(j)-Ts_w(j))        phiT_x = Kech_h_x*C_p(j)*(T1_x(j)-Ts_x(j))
     894!-----------------------------------------------------
     895    phiT_x1 = Kech_h_x(j)*C_p(j)*(T1_x(j)-Ts_x(j))
     896    phiT_w1 = Kech_h_w(j)*C_p(j)*(T1_w(j)-Ts_w(j))
     897!
     898!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     899!  Test phiT_w = Kech_T_pw*(AcoefT_w(j)-C_p(j)*Ts_w(j))   phiT_x = Kech_T_px*(AcoefT_x(j)-C_p(j)*Ts_x(j))
     900!-----------------------------------------------------
     901    phiT_x2 = Kech_T_px(j)*(AcoefT_x(j)-C_p(j)*Ts_x(j))
     902    phiT_w2 = Kech_T_pw(j)*(AcoefT_w(j)-C_p(j)*Ts_w(j))
     903    print *, 'wx_pbl_check: j, phiT_w1, phiT_w2, phiT_w9 ', j, phiT_w1, phiT_w2, phiT_w9(j)
     904    print *, 'wx_pbl_check: j, phiT_x1, phiT_x2, phiT_x9 ', j, phiT_x1, phiT_x2, phiT_x9(j)
     905!
     906!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     907!  Test phiq_w = Kech_q_w ( beta q1_w - qsatsrf_w)    phiq_x = Kech_q_x ( beta q1_x - qsatsrf_x))
     908!--------------------------------------------------------------
     909    phiq_x1 = Kech_q_x(j)*( beta(j)*q1_x(j) - qsatsrf_x(j))
     910    phiq_w1 = Kech_q_w(j)*( beta(j)*q1_w(j) - qsatsrf_w(j))
     911!
     912!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     913!  Test  phiq_w = Kech_Q_sw (beta AQ_w -qsatsrf_w)     phiq_x = Kech_Q_sx (beta AQ_x -qsatsrf_x)
     914!--------------------------------------------------------------
     915    phiq_x2 = Kech_Q_sx(j)*(beta(j)*AQ_x(j) -qsatsrf_x(j))
     916    phiq_w2 = Kech_Q_sw(j)*(beta(j)*AQ_w(j) -qsatsrf_w(j))
     917!
     918!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     919!  Test phiq_w = Kech_q_w ( q1_w - qsurf_w)    phiq_x = Kech_q_x ( q1_x - qsurf_x))
     920!--------------------------------------------------------------
     921    phiq_x3 = Kech_q_x(j)*( q1_x(j) - qsurf_x(j))
     922    phiq_w3 = Kech_q_w(j)*( q1_w(j) - qsurf_w(j))
     923    print *, 'wx_pbl_check: j, phiQ_w1, phiQ_w2, phiQ_w3, phiQ_w9 ', j, phiQ_w1, phiQ_w2, phiQ_w3, phiQ_w9(j)
     924    print *, 'wx_pbl_check: j, phiQ_x1, phiQ_x2, phiQ_x3, phiQ_x9 ', j, phiQ_x1, phiQ_x2, phiQ_x3, phiQ_x9(j)
     925!
     926!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     927!  Test phiT_b = Kech_h C_p (Ta - Ts_b)
     928!--------------------------------------------------------------
     929   phiT_b1 = Kech_h(j)*C_p(j)*(Ta(j) - Ts_b9(j))
     930   print *, 'wx_pbl_check: j, phiT_b1, PhiT_b9 ', j, phiT_b1, PhiT_b9(j)
     931!
     932!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     933!  Test phiQ_b = beta Kech_q (qa - qsat_bs)
     934!--------------------------------------------------------------
     935   evap_pot = Kech_q(j)*(qa(j) - qsat_bs(j))
     936   phiQ_b1 = beta(j)*Kech_q(j)*(qa(j) - qsat_bs(j))
     937   print *, 'wx_pbl_check: j, beta, evap_pot, phiQ_b1, PhiQ_b9 ', j, beta(j), evap_pot, phiQ_b1, PhiQ_b9(j)
     938!
     939!
     940          ENDDO  ! j = 1, knon
     941         
     942        ENDIF   ! (prt_level >=10 )
     943!--------------------------------------------------------------------------------------------------
     944
     945        RETURN
     946
     947END SUBROUTINE wx_pbl_check
     948
     949SUBROUTINE wx_pbl_dts_check( knon, dtime, ypplay, ypaprs, &
     950                               sigw, beta, iflag_split,   &
     951                               Ts0_b9, dTs09,   &
     952                               qs_b9, Ts_b9,  &                         ! yqsurf, Tsurf_new
     953                               dqsatsrf9, dTs9, delta_qsurf9,   &
     954                               AcoefT_x, AcoefT_w, &
     955                               BcoefT_x, BcoefT_w, &
     956                               AcoefT0, AcoefQ0, BcoefT0, BcoefQ0, &
     957                               AcoefT,  AcoefQ,  BcoefT,  BcoefQ, &
     958                               HTphiT_b, dd_HTphiT, HTphiQ_b, dd_HTphiQ, HTRn_b, dd_HTRn, &
     959                               phiT0_b9, dphiT09, phiQ0_b9, dphiQ09, Rn0_b9, dRn09, &
     960                               g_T, g_Q, &
     961                               Gamma_phiT, Gamma_phiQ, &
     962                               dTs_ins, dqsatsrf_ins, &
     963                               phiT_b9, phiQ_b9,  &
     964                               phiT_x9, phiT_w9, &
     965                               phiQ_x9, phiQ_w9  &
     966                               )
     967!
     968
     969    USE wx_pbl_var_mod
     970
     971    USE print_control_mod, ONLY: prt_level,lunout
     972!
     973    INCLUDE "YOMCST.h"
     974    INCLUDE "FCTTRE.h"
     975    INCLUDE "YOETHF.h"
     976!
     977    INTEGER,                      INTENT(IN)        :: knon         ! number of grid cells
     978    REAL,                         INTENT(IN)        :: dtime        ! time step size (s)
     979    REAL, DIMENSION(knon,klev),   INTENT(IN)        :: ypplay       ! mid-layer pressure (Pa)
     980    REAL, DIMENSION(knon,klev),   INTENT(IN)        :: ypaprs       ! pressure at layer interfaces (pa)
     981    REAL, DIMENSION(knon),        INTENT(IN)        :: sigw         ! cold pools fractional area
     982    REAL, DIMENSION(knon),        INTENT(IN)        :: beta         ! aridity factor
     983    INTEGER,                      INTENT(IN)        :: iflag_split
     984    REAL, DIMENSION(knon),        INTENT(IN)        :: Ts0_b9, dTs09
     985    REAL, DIMENSION(knon),        INTENT(IN)        :: qs_b9, Ts_b9         ! yqsurf, Tsurf_new
     986    REAL, DIMENSION(knon),        INTENT(IN)        :: dTs9, dqsatsrf9
     987    REAL, DIMENSION(knon),        INTENT(IN)        :: delta_qsurf9
     988    REAL, DIMENSION(knon),        INTENT(IN)        :: AcoefT_x, AcoefT_w
     989    REAL, DIMENSION(knon),        INTENT(IN)        :: BcoefT_x, BcoefT_w
     990    REAL, DIMENSION(knon),        INTENT(IN)        :: AcoefT0, AcoefQ0, BcoefT0, BcoefQ0
     991!
     992    REAL, DIMENSION(knon),        INTENT(IN)        :: AcoefT, AcoefQ, BcoefT, BcoefQ
     993    REAL, DIMENSION(knon),        INTENT(IN)        :: HTphiT_b, dd_HTphiT, HTphiQ_b, dd_HTphiQ, HTRn_b, dd_HTRn
     994    REAL, DIMENSION(knon),        INTENT(IN)        :: phiT0_b9, dphiT09, phiQ0_b9, dphiQ09, Rn0_b9, dRn09
     995    REAL, DIMENSION(knon),        INTENT(IN)        :: g_T, g_Q
     996    REAL, DIMENSION(knon),        INTENT(IN)        :: Gamma_phiT, Gamma_phiQ
     997    REAL, DIMENSION(knon),        INTENT(IN)        :: dTs_ins, dqsatsrf_ins
     998    REAL, DIMENSION(knon),        INTENT(IN)        :: phiT_b9, phiQ_b9
     999    REAL, DIMENSION(knon),        INTENT(IN)        :: phiT_x9, phiT_w9
     1000    REAL, DIMENSION(knon),        INTENT(IN)        :: phiQ_x9, phiQ_w9
     1001!
     1002!! Local variables
     1003    INTEGER                    :: j
     1004    REAL, DIMENSION(knon)      :: sigx       ! fractional area of (x) region
     1005    REAL, DIMENSION(knon)      :: AcoefT_b, AcoefQ_b   ! mean values of AcoefT and AcoefQ
     1006    REAL                       :: zzt, zzq, zzqsat
     1007    REAL                       :: zdelta, zcvm5, zcor, qsat
     1008    REAL, DIMENSION(knon)      :: qsat_w, qsat_x
     1009    REAL, DIMENSION(knon)      :: Ts_x, Ts_w, qs_x, qs_w
     1010    REAL, DIMENSION(knon)      :: T1_x, T1_w, q1_x, q1_w
     1011    REAL, DIMENSION(knon)      :: Rn_x, Rn_w
     1012    REAL, DIMENSION(knon)      :: Rn_b, dRn
     1013    REAL, DIMENSION(knon)      :: phiQ0_x, phiQ0_w
     1014    REAL, DIMENSION(knon)      :: Ta, qa
     1015    REAL, DIMENSION(knon)      :: err_phiT_w, err_phiT_x
     1016    REAL, DIMENSION(knon)      :: err_phiq_w, err_phiq_x
     1017    REAL, DIMENSION(knon)      :: err_phiT_b
     1018    REAL, DIMENSION(knon)      :: err_phiQ_b
     1019    REAL, DIMENSION(knon)      :: err2_phiT_b
     1020    REAL                       :: T1A_x, T1A_w, q1A_x, q1A_w
     1021    REAL                       :: qsatsrf_w, qsatsrf_x, qsatsrfb, qsbA
     1022    REAL                       :: dphiT, dphiQ
     1023    REAL                       :: dphiT_H, dphiQ_H
     1024    REAL                       :: phiQ_pot
     1025    REAL                       :: phiQ_w_m_phiQ0_w
     1026    REAL                       :: phiQ_x_m_phiQ0_x
     1027    REAL                       :: dphiQ_m_dphiQ0
     1028    REAL                       :: dphiT_m_dphiT0
     1029    REAL                       :: dRN_m_dRn0
     1030    REAL                       :: phiTb_m_phiT0b
     1031
     1032!----------------------------------------------------------------------------
     1033! Equations to be checked:
     1034! -----------------------
     1035!  Input : Ts0_b, dTs0, Ts_b, dTs, qsatsrf_b, dqsatsrf,
     1036!          phiT_b, phiQ_b, phiT_w, phiT_x, phiQ_w, phiQ_x,
     1037!         
     1038!          AcoefT, AcoefQ, AcoefT_w, AcoefQ_w, AcoefT_x, AcoefQ_x,
     1039!          BcoefT, BcoefQ, BcoefT_w, BcoefQ_w, BcoefT_x, BcoefQ_x
     1040!
     1041!  Ts_w = Ts_b + sigx dTs                                 Ts_x = Ts_b - sigw dTs
     1042!  T1_w = AcoefT_w + BcoefT_w phiT_w Delta t              T1_x = AcoefT_x + BcoefT_x phiT_x Delta t
     1043!  q1_w = AcoefQ_w + BcoefQ_w phiQ_w Delta t              q1_x = AcoefQ_x + BcoefQ_x phiQ_x Delta t
     1044!  phiT_w = Kech_h_w ( T1_w - Ts_w)                       phiT_x = Kech_h_x ( T1_x - Ts_x)             
     1045!  phiq_w = beta Kech_h_w ( q1_w - qsat(Ts_w))            phiq_x = beta Kech_h_x ( q1_x - qsat(Ts_x))
     1046!  phiT_b = sigw phiT_w + sigx phiT_x                     dphiT = phiT_w - phiT_x
     1047!  phiQ_b = sigw phiQ_w + sigx phiQ_x                     dphiQ = phiQ_w - phiQ_x
     1048!  Ts_b = sigw Ts_w + sigx Ts_x                           dTs = Ts_w - Ts_x
     1049!  Ta = AcoefT + BcoefT phiT_b Delta t
     1050!  qa = AcoefQ + BcoefQ phiQ_b Delta t
     1051!  phiT_b = Kech_h (Ta - Ts_b)
     1052!  phiQ_b = beta Kech_h (qa - qsat(Ts_b))
     1053!  dTs = sqrt(tau)/I (dphit + L_v dphiq + dR)
     1054
     1055!----------------------------------------------------------------------------
     1056!
     1057!!
     1058        sigx(:) = 1.-sigw(:)
     1059        AcoefT_b(1:knon) = AcoefT_x(1:knon) + sigw(1:knon)*dd_AT(1:knon)
     1060        AcoefQ_b(1:knon) = AQ_x(1:knon) + sigw(1:knon)*dd_AQ(1:knon)
     1061
     1062   IF (prt_level >=10 ) THEN
     1063    print *,'->wx_pbl_dts_check, HTphiT_b, HTphiQ_b, HTRn_b ', &
     1064                             HTphiT_b, HTphiQ_b, HTRn_b
     1065    print *,'->wx_pbl_dts_check, dd_HTphiT, dd_HTphiQ, dd_HTRn ', &
     1066                             dd_HTphiT, dd_HTphiQ, dd_HTRn
     1067   ENDIF ! (prt_level >=10 )
     1068!
     1069! Compute the three qsat and dqsatdTs
     1070! ---------------------------------------------
     1071!!      print *,' AAAA wx_pbl_dts_check, C_p(j), qsat0(j), Ts0(j) : ',  &
     1072!!                                      (C_p(j), qsat0(j), Ts0(j), j = 1,knon)
     1073!
     1074!
     1075!--------------------------------------------------------------------------------------------------
     1076        IF (prt_level >=10 ) THEN
     1077!
     1078          DO j = 1, knon
     1079  Ts_x(j) = Ts_b9(j) - sigw(j)*dTs9(j)
     1080  Ts_w(j) = Ts_b9(j) + sigx(j)*dTs9(j)
     1081    print *, 'wx_pbl_dts_check: j, Ts_b9, Ts_w, Ts_x ', j, Ts_b9(j), Ts_w(j), Ts_x(j)
     1082!
     1083  qsat_x(j) = qsat0_x(j) + dqsatdT0_x(j)*(Ts_x(j)-Ts0_x(j))
     1084  qsat_w(j) = qsat0_w(j) + dqsatdT0_w(j)*(Ts_w(j)-Ts0_w(j))
     1085!
     1086  T1_x(j) = (AcoefT_x(j) + BcoefT_x(j)*phiT_x9(j)*dtime) / C_p(j)
     1087  T1_w(j) = (AcoefT_w(j) + BcoefT_w(j)*phiT_w9(j)*dtime) / C_p(j)
     1088    print *, 'wx_pbl_dts_check: j, T1_w, T1_x ', j, T1_w(j), T1_x(j)
     1089!
     1090  q1_x(j) = AQ_x(j) + BQ_x(j)*phiQ_x9(j)*dtime
     1091  q1_w(j) = AQ_w(j) + BQ_w(j)*phiQ_w9(j)*dtime
     1092    print *, 'wx_pbl_dts_check: j, q1_w, q1_x ', j, q1_w(j), q1_x(j)
     1093!
     1094    Rn_x(j) = eps_1*Rsigma*T1_x(j)**4 - Rsigma*Ts_x(j)**4
     1095    Rn_w(j) = eps_1*Rsigma*T1_w(j)**4 - Rsigma*Ts_w(j)**4
     1096    Rn_b(j) = sigw(j)*Rn_w(j) + sigx(j)*Rn_x(j)
     1097    dRn(j) = dRn09(j) - ( HTRn_b(j) &
     1098                        +(sigx(j)-sigw(j))*dd_HTRn(j) &
     1099                        -sigw(j)*sigx(j)*dd_HTRn(j)*dd_HTphiT(j)/HTphiT_b(j) &
     1100                       )*(dTs9(j)-dTs09(j)) &
     1101                    + dd_HTRn(j)/HTphiT_b(j)*(phiT_b9(j)-phiT0_b9(j))
     1102!
     1103          print *,'wx_pbl_dts_check, dphiT, L_v*dphiQ, dRn, dTs ', &
     1104              phiT_w9(j)-phiT_x9(j), L_v(j)*(phiQ_w9(j)-phiQ_x9(j)), dRn(j), dTs9(j)
     1105!
     1106  phiQ0_x(j) = PhiQ0_b9(j) - sigw(j)*dphiQ09(j)
     1107  phiQ0_w(j) = PhiQ0_b9(j) + sigx(j)*dphiQ09(j)
     1108!
     1109!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1110!  Test phiQ_w-phiQ0_w = -beta*Kech_Q_sw*dqsatdT_w*(Ts_w-Ts0_w)
     1111!--------------------------------------------------------------
     1112  print *,'wx_pbl_dts_check: beta(j), Kech_Q_sw(j), dqsatdT0_w(j), Ts_w(j), Ts0_w(j) ', &
     1113                         beta(j), Kech_Q_sw(j), dqsatdT0_w(j), Ts_w(j), Ts0_w(j)
     1114  phiQ_w_m_phiQ0_w = -beta(j)*Kech_Q_sw(j)*dqsatdT0_w(j)*(Ts_w(j)-Ts0_w(j))
     1115    print *,'wx_pbl_dts_check: j, phiQ_w9-phiQ0_w, phiQ_w_m_phiQ0_w ', &
     1116                           j, phiQ_w9(j)-phiQ0_w(j), phiQ_w_m_phiQ0_w
     1117!
     1118!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1119!  Test phiQ_x-phiQ0_x = -beta*Kech_Q_sx*dqsatdT_x*(Ts_x-Ts0_x)
     1120!--------------------------------------------------------------
     1121  phiQ_x_m_phiQ0_x = -beta(j)*Kech_Q_sx(j)*dqsatdT0_x(j)*(Ts_x(j)-Ts0_x(j))
     1122    print *,'wx_pbl_dts_check: j, phiQ_x9-phiQ0_x, phiQ_x_m_phiQ0_x ', &
     1123                           j, phiQ_x9(j)-phiQ0_x(j), phiQ_x_m_phiQ0_x
     1124!
     1125!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1126!  Test dphiT-dphiT0 = -(HTphiT_b+(sigx-sigw)*dd_HTphiT)*(dTs-dTs0) - dd_HTphiT*(Ts_b-Ts0_b)
     1127!-------------------------------------------------------------------------------------------
     1128 dphiT = phiT_w9(j) - phiT_x9(j)
     1129 dphiT_m_dphiT0 = -(HTphiT_b(j)+(sigx(j)-sigw(j))*dd_HTphiT(j))*(dTs9(j)-dTs09(j)) &
     1130                  - dd_HTphiT(j)*(Ts_b9(j)-Ts0_b9(j))
     1131 print *,'wx_pbl_dts_check: j, dphiT-dphiT09, dphiT_m_dphiT0 ',j, dphiT-dphiT09(j), dphiT_m_dphiT0
     1132!
     1133!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1134!  Test dphiQ-dphiQ0 = -(HTphiQ_b+(sigx-sigw)*dd_HTphiQ)*(dTs-dTs0) - dd_HTphiQ*(Ts_b-Ts0_b)
     1135!-------------------------------------------------------------------------------------------
     1136 dphiQ = phiQ_w9(j) - phiQ_x9(j)
     1137 dphiQ_m_dphiQ0 = -(HTphiQ_b(j)+(sigx(j)-sigw(j))*dd_HTphiQ(j))*(dTs9(j)-dTs09(j)) &
     1138                  - dd_HTphiQ(j)*(Ts_b9(j)-Ts0_b9(j))
     1139 print *,'wx_pbl_dts_check: j, dphiQ-dphiQ09, dphiQ_m_dphiQ0 ',j, dphiQ-dphiQ09(j), dphiQ_m_dphiQ0
     1140!
     1141!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1142!  Test dRn-dRn0 = -(HTRn_b+(sigx-sigw)*dd_HTRn)*(dTs-dTs0) - dd_HTRn*(Ts_b-Ts0_b)
     1143!-------------------------------------------------------------------------------------------
     1144 dRn_m_dRn0 = -(HTRn_b(j)+(sigx(j)-sigw(j))*dd_HTRn(j))*(dTs9(j)-dTs09(j)) &
     1145                  - dd_HTRn(j)*(Ts_b9(j)-Ts0_b9(j))
     1146 print *,'wx_pbl_dts_check: j, dRn-dRn09, dRn_m_dRn0 ',j, dRn-dRn09(j), dRn_m_dRn0
     1147!
     1148!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1149!  Test phiT_b-phiT0_b = -sigx*sigw*dd_HTphiT*(dTs-dTs0) - HTphiT_b*(Ts_b-Ts0_b)
     1150!-------------------------------------------------------------------------------
     1151   phiTb_m_phiT0b = -sigx(j)*sigw(j)*dd_HTphiT(j)*(dTs9(j)-dTs09(j)) - HTphiT_b(j)*(Ts_b9(j)-Ts0_b9(j))
     1152   print *,'wx_pbl_dts_check: j, phiT_b9-phiT0_b9, phiTb_m_phiT0b ',j ,phiT_b9(j)-phiT0_b9(j), phiTb_m_phiT0b
     1153!
     1154!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1155!  Test phiT_w, phiT_x, dphiT from HTphiT
     1156!------------------------------------------
     1157!  phiT_w = Kech_h_w C_p ( T1_w - Ts_w)                   phiT_x = Kech_h_x C_p ( T1_x - Ts_x)             
     1158  err_phiT_x(j) = Kech_h_x(j)*C_p(j)*(T1_x(j) - Ts_x(j)) - phiT_x9(j)
     1159  err_phiT_w(j) = Kech_h_w(j)*C_p(j)*(T1_w(j) - Ts_w(j)) - phiT_w9(j)
     1160    print *, 'wx_pbl_dts_check: j, phiT_w9, phiT_x9, err_phiT_w, err_phiT_x ',   &
     1161                            j, phiT_w9(j), phiT_x9(j), err_phiT_w(j), err_phiT_x(j)
     1162  dphiT = phiT_w9(j) - phiT_x9(j)
     1163  dphiT_H = dphiT09(j) - ( HTphiT_b(j) &
     1164                            +(sigx(j)-sigw(j))*dd_HTphiT(j) &
     1165                            -sigw(j)*sigx(j)*dd_HTphiT(j)*dd_HTphiT(j)/HTphiT_b(j) &
     1166                           )*(dTs9(j)-dTs09(j)) &
     1167                         + dd_HTphiT(j)/HTphiT_b(j)*(phiT_b9(j)-phiT0_b9(j))
     1168    print *,'wx_pbl_dts_check: j, dphiT, dphiT_H ', j, dphiT, dphiT_H
     1169
     1170!
     1171!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1172!  Test phiq_w, phiq_x, dphiq from HTphiq
     1173!------------------------------------------
     1174!
     1175!  phiq_w = beta Kech_q_w ( q1_w - qsat(Ts_w))            phiq_x = beta Kech_q_x ( q1_x - qsat(Ts_x))
     1176  err_phiq_x(j) = beta(j)*Kech_q_x(j)*( q1_x(j) - qsat_x(j)) - phiq_x9(j)
     1177  err_phiq_w(j) = beta(j)*Kech_q_w(j)*( q1_w(j) - qsat_w(j)) - phiq_w9(j)
     1178  dphiQ = phiQ_w9(j) - phiQ_x9(j)
     1179  dphiQ_H = dphiQ09(j) - ( HTphiQ_b(j) &
     1180                            +(sigx(j)-sigw(j))*dd_HTphiQ(j) &
     1181                            -sigw(j)*sigx(j)*dd_HTphiQ(j)*dd_HTphiT(j)/HTphiT_b(j) &
     1182                           )*(dTs9(j)-dTs09(j)) &
     1183                         + dd_HTphiQ(j)/HTphiT_b(j)*(phiT_b9(j)-phiT0_b9(j))
     1184    print *,'wx_pbl_dts_check: j, dphiQ, dphiQ_H ', j, dphiQ, dphiQ_H
     1185!
     1186!  phiT_b = sigw phiT_w + sigx phiT_x                     dphiT = phiT_w - phiT_x
     1187  err_phiT_b(j) = sigw(j)*phiT_w9(j) + sigx(j)*phiT_x9(j) - phiT_b9(j)
     1188!
     1189!  phiQ_b = sigw phiQ_w + sigx phiQ_x                     dphiQ = phiQ_w - phiQ_x
     1190  err_phiQ_b(j) = sigw(j)*phiQ_w9(j) + sigx(j)*phiQ_x9(j) - phiQ_b9(j)
     1191!
     1192!  Ta = AcoefT + BcoefT phiT_b Delta t
     1193!  phiT_b = Kech_h C_p (Ta - Ts_b)
     1194  Ta(j) = (AcoefT(j) + BcoefT(j)*phiT_b9(j)*dtime) / C_p(j)
     1195  err2_phiT_b(j) = Kech_h(j)*C_p(j)*(Ta(j) - Ts_b9(j)) - phiT_b9(j)
     1196    print *, 'wx_pbl_dts_check: j, Ta, phiT_b9, err2_phiT_b ',   &
     1197                            j, Ta(j), phiT_b9(j), err2_phiT_b(j)
     1198!
     1199          ENDDO  ! j = 1, knon
     1200         
     1201        ENDIF   ! (prt_level >=10 )
     1202!--------------------------------------------------------------------------------------------------
     1203        RETURN
     1204
     1205END SUBROUTINE wx_pbl_dts_check
     1206
     1207SUBROUTINE wx_evappot(knon, q1, Ts, evap_pot)
     1208
     1209    USE wx_pbl_var_mod
     1210
     1211    INTEGER,                      INTENT(IN)        :: knon     ! number of grid cells
     1212    REAL, DIMENSION(knon),        INTENT(IN)        :: q1       ! specific humidity in layer 1
     1213    REAL, DIMENSION(knon),        INTENT(IN)        :: Ts       ! surface temperature
     1214!
     1215    REAL, DIMENSION(knon),        INTENT(OUT)       :: evap_pot ! potential evaporation
     1216!
     1217    INTEGER                   :: j
     1218    REAL                      :: qsat_bs
     1219!
     1220 DO j = 1,knon
     1221   evap_pot(j) = Kech_q(j)*(qsat0(j)+dqsatdT0(j)*(Ts(j)-Ts0(j))-q1(j))
     1222!
     1223  qsat_bs = qsat0(j)+dqsatdT0(j)*(Ts(j)-Ts0(j))
     1224!!  print *,'wx_evappot : Kech_q, qsat_bs, qa, evap_pot ', Kech_q(j), qsat_bs, q1(j), evap_pot(j)
     1225 ENDDO
     1226!
     1227 RETURN
     1228END SUBROUTINE wx_evappot
    4541229
    4551230END MODULE wx_pbl_mod

  • LMDZ6/branches/Ocean_skin/libf/phylmd/yamada4.F90

    r3798 r4013  
    66  USE dimphy
    77  USE ioipsl_getin_p_mod, ONLY : getin_p
    8   USE phys_local_var_mod, only: tke_dissip
     8  USE phys_local_var_mod, only: tke_dissip,wprime
    99 
    1010  IMPLICIT NONE
    … …  
    726726      lyam(1:ngrid, 2:klev)*5.17*kn(1:ngrid, 2:klev)*n2(1:ngrid, 2:klev)/ &
    727727      sqrt(q2(1:ngrid,2:klev))
    728 
     728 
    729729    t2yam(1:ngrid, 2:klev) = 9.1*kn(1:ngrid, 2:klev)* &
    730730      dtetadz(1:ngrid, 2:klev)**2/sqrt(q2(1:ngrid,2:klev))* &
    … …  
    750750
    751751!============================================================================
    752 ! Diagnostique de la dissipation
     752! Diagnostique de la dissipation et vitesse verticale
    753753!============================================================================
    754754
    755755! Diagnostics
    756756 tke_dissip(1:ngrid,:,nsrf)=0.
    757 ! DO k=2,klev
    758 !    DO ig=1,ngrid
    759 !       jg=ni(ig)
    760 !       tke_dissip(jg,k,nsrf)=dissip(ig,k)
    761 !    ENDDO
    762 ! ENDDO
     757 wprime(1:ngrid,:,nsrf)=0.
     758 DO k=2,klev
     759    DO ig=1,ngrid
     760       jg=ni(ig)
     761       wprime(jg,k,nsrf)=sqrt(MAX(1./3*q2(ig,k),0.))
     762       tke_dissip(jg,k,nsrf)=dissip(ig,k)
     763    ENDDO
     764 ENDDO
    763765 
    764766!=============================================================================

  • LMDZ6/branches/Ocean_skin/libf/phylmd/yamada_c.F90

    r2680 r4013  
    139139#define IOPHYS
    140140#ifdef IOPHYS
    141 !        call iophys_ini
     141!        call iophys_ini(timestep)
    142142#endif
    143143        firstcall=.false.

  • LMDZ6/branches/Ocean_skin/makegcm

    r3798 r4013  
    4141set cosp2=false
    4242set cospv2=false
    43 set sisvat=false
    4443set inlandsis=false
    4544
    … …  
    517516     case -cospv2
    518517        set cospv2="$2"; shift ; shift ; goto top
    519      case -sisvat
    520         set sisvat="$2" ; shift ; shift ; goto top
    521518     case -inlandsis
    522519        set inlandsis="$2" ; shift ; shift ; goto top
    … …  
    621618
    622619
    623 if ( "$sisvat" == 'true' ) then
    624     set cppflags="$cppflags -DCPP_SISVAT"
    625 endif
    626 
    627620if ( "$inlandsis" == 'true' ) then
    628621    set cppflags="$cppflags -DCPP_INLANDSIS"

  • LMDZ6/branches/Ocean_skin/makelmdz

    r3798 r4013  
    1919chimie=false
    2020parallel=none
    21 paramem="par"
     21paramem="mem"
    2222compil_mod=prod
    2323io=ioipsl
    … …  
    2727cosp2=false
    2828cospv2=false
    29 sisvat=false
    3029inlandsis=false
    3130rrtm=false
    32 rrtm=false
     31rad=""
    3332dust=false
    3433strataer=false
    … …  
    8786########################################################################
    8887
    89 CPP_KEY=""
     88CPP_KEY="IN_LMDZ"
    9089INCLUDE='-I$(LIBF)/grid -I$(LIBF)/misc -I$(LIBF)/filtrez -I. '
    9190LIB=""
    … …  
    122121[-cosp2 true/false]    : compile with/without cosp2 package (default: false)
    123122[-cospv2 true/false]    : compile with/without cospv2 package (default: false)
    124 [-sisvat true/false]  : compile with/without sisvat package (default: false)
    125123[-inlandsis true/false]  : compile with/without inlandsis package (default: false)
    126124[-rrtm true/false]    : compile with/without rrtm package (default: false)
     125[-rad old/rrtm/ecrad]    : compile with old/rrtm/ecrad radiatif code (default: old)
    127126[-dust true/false]    : compile with/without the dust package from Boucher et al. (default: false)
    128127[-strataer true/false]    : compile with/without the strat aer package from Boucher et al. (default: false)
    … …  
    133132[-cpp CPP_KEY]             : additional preprocessing definitions
    134133[-adjnt]                   : adjoint model, not operational ...
    135 [-mem]                     : reduced memory dynamics (if in parallel mode)
     134[-mem]                     : reduced memory dynamics (obsolete flag; always on in parallel mode)
    136135[-filtre NOMFILTRE]        : use filtre from libf/NOMFILTRE (default: filtrez)
    137136[-full]                    : Full (re)compilation (from scratch)
    … …  
    192191          cospv2="$2" ; shift ; shift ;;
    193192     
    194       "-sisvat")
    195           sisvat="$2" ; shift ; shift ;;
    196 
    197193      "-inlandsis")
    198194          inlandsis="$2" ; shift ; shift ;; 
    199195
    200196      "-rrtm")
    201           rrtm="$2" ; shift ; shift ;;
     197          rrtm="$2" ; if [ "$2" = "false" ] ; then rad="old" ; else rad="rrtm" ; fi ; shift ; shift ;;
     198
     199      "-rad")
     200          rad="$2" ; shift ; shift ;;
    202201
    203202      "-dust")
    … …  
    208207     
    209208      "-mem")
     209          echo "option -mem is obsolete (now always on in parallel)"
    210210          paramem="mem" ; shift ;;
    211211
    … …  
    353353if [[ "${physique:0:5}" == "venus" ]] ; then phys_root=venus ; fi
    354354if [[ "${physique:0:5}" == "titan" ]] ; then phys_root=titan ; fi
    355 if [[ "${physique:0:3}" == "mar" ]] ; then phys_root=mar ; fi
    356355if [[ "${physique:0:3}" == "dev" ]] ; then phys_root=dev ; fi
    357356
    … …  
    518517
    519518
    520 if [[ "$sisvat" == "true" ]]
    521 then
    522    CPP_KEY="$CPP_KEY CPP_SISVAT"
    523    src_dirs="$src_dirs phy${physique}/sisvat"
    524 fi
    525 
    526 
    527519if [[ "$inlandsis" == "true" ]]
    528520then
    … …  
    532524
    533525
    534 if [[ "$rrtm" == "true" ]]
     526if [[ "$rad" == "rrtm" ]]
    535527then
    536528   CPP_KEY="$CPP_KEY CPP_RRTM"
    537529   src_dirs="$src_dirs phy${physique}/rrtm"
    538530fi
     531if [[ "$rad" == "ecrad" ]]
     532then
     533   CPP_KEY="$CPP_KEY CPP_ECRAD"
     534   src_dirs="$src_dirs phy${physique}/ecrad"
     535fi
    539536
    540537if [[ "$dust" == "true" ]]
    … …  
    549546   src_dirs="$src_dirs phy${physique}/StratAer"
    550547fi
     548
     549#add new ocean skin modelisation to source dir by default
     550
     551src_dirs="$src_dirs phy${physique}/Ocean_skin"
    551552
    552553

  • LMDZ6/branches/Ocean_skin/makelmdz_fcm

    r3812 r4013  
    2323couple=false
    2424veget=false
    25 sisvat=false
    2625inlandsis=false
    2726rrtm=false
     27rad="old"
    2828dust=false
    2929strataer=false
    3030chimie=false
    3131parallel=none
    32 paramem="par"
     32paramem="mem"
    3333compil_mod=prod
    3434io=ioipsl
    … …  
    4040full=''
    4141libphy=false
     42isotopes=false
     43isoverif=false
     44diagiso=false
     45isotrac=false
    4246
    4347arch_defined="FALSE"
    … …  
    5458DYN_PHYS_SUB_PATH=$LMDGCM/.void_dir
    5559PHY_COMMON_PATH=$LMDGCM/.void_dir
    56 RRTM_PATH=$LMDGCM/.void_dir
     60RAD_PATH=$LMDGCM/.void_dir
     61INLANDSIS_PATH=$LMDGCM/.void_dir
    5762DUST_PATH=$LMDGCM/.void_dir
    5863STRATAER_PATH=$LMDGCM/.void_dir
    59 SISVAT_PATH=$LMDGCM/.void_dir
    6064COSP_PATH=$LMDGCM/.void_dir
    6165fcm_path=$LMDGCM/tools/fcm/bin
    … …  
    99103[-cosp2 true/false]    : compile with/without cosp2 package (default: false)
    100104[-cospv2 true/false]    : compile with/without cospv2 package (default: false)
    101 [-sisvat true/false]  : compile with/without sisvat package (default: false)
    102105[-inlandsis true/false]  : compile with/without inlandsis package (default: false)
    103106[-rrtm true/false]    : compile with/without rrtm package (default: false)
     107[-rad old/rrtm/ecrad]    : compile with old/rrtm/ecrad radiatif code (default: old)
    104108[-dust true/false]    : compile with/without the dust package by Boucher and co (default: false)
    105109[-strataer true/false]    : compile with/without the strat aer package by Boucher and co (default: false)
     110[-isotopes true/false]    : compile with/without water isotopes in the physics
     111[-isoverif true/false]    : compile with/without verifications for water isotopes in the physics
     112[-diagiso true/false]    : compile with/without special diagnostics for water isotopes in the physics
     113[-isotrac true/false]    : compile with/without tracers of water isotopes in the physics
    106114[-parallel none/mpi/omp/mpi_omp] : parallelism (default: none) : mpi, openmp or mixted mpi_openmp
    107115[-g GRI]                   : grid configuration in dyn3d/GRI_xy.h  (default: reg, inclues a zoom)
    … …  
    110118[-cpp CPP_KEY]             : additional preprocessing definitions
    111119[-adjnt]                   : adjoint model, not operational ...
    112 [-mem]                     : reduced memory dynamics (if in parallel mode)
     120[-mem]                     : reduced memory dynamics (obsolete flag; always on in parallel mode)
    113121[-filtre NOMFILTRE]        : use filtre from libf/NOMFILTRE (default: filtrez)
    114122[-link LINKS]              : additional links with other libraries
    … …  
    151159          veget="$2" ; shift ; shift ;;
    152160
    153       "-sisvat")
    154           sisvat="$2" ; shift ; shift ;;
    155 
    156161      "-inlandsis")
    157     inlandsis="$2" ; shift ; shift ;;
     162          inlandsis="$2" ; shift ; shift ;;
    158163
    159164      "-rrtm")
    160           rrtm="$2" ; shift ; shift ;;
     165          rrtm="$2" ; if [ "$2" = "false" ] ; then rad="old" ; else rad="rrtm" ; fi ; shift ; shift ;;
     166
     167      "-rad")
     168          rad="$2" ; shift ; shift ;;
    161169
    162170      "-dust")
    … …  
    168176      "-chimie")
    169177          chimie="$2" ; shift ; shift ;;
     178
     179      "-isotopes")
     180          isotopes="$2" ; shift ; shift ;;
     181
     182      "-isoverif")
     183          isoverif="$2" ; shift ; shift ;;
     184
     185      "-diagiso")
     186          diagiso="$2" ; shift ; shift ;;
     187
     188      "-isotrac")
     189          isotrac="$2" ; shift ; shift ;;
    170190
    171191      "-parallel")
    … …  
    193213     
    194214      "-mem")
     215          echo "option -mem is obsolete (now always on in parallel)"
    195216          paramem="mem" ; shift ;;
    196217
    … …  
    312333if [[ "${physique:0:5}" == "venus" ]] ; then phys_root=venus ; fi
    313334if [[ "${physique:0:5}" == "titan" ]] ; then phys_root=titan ; fi
    314 if [[ "${physique:0:3}" == "mar" ]] ; then phys_root=mar ; fi
    315335if [[ "${physique:0:3}" == "dev" ]] ; then phys_root=dev ; fi
    316336
    … …  
    341361   INCLUDE="$INCLUDE -I${INCA_INCDIR}"
    342362   LIB="$LIB -L${INCA_LIBDIR} -lchimie"
     363fi
     364
     365if [[ "$isotopes" == "true" ]]
     366then
     367   CPP_KEY="$CPP_KEY ISO"
     368fi
     369
     370if [[ "$isoverif" == "true" ]]
     371then
     372   CPP_KEY="$CPP_KEY ISOVERIF"
     373fi
     374
     375if [[ "$diagiso" == "true" ]]
     376then
     377   CPP_KEY="$CPP_KEY DIAGISO"
     378fi
     379
     380if [[ "$isotrac" == "true" ]]
     381then
     382   CPP_KEY="$CPP_KEY ISOTRAC"
    343383fi
    344384
    … …  
    414454fi
    415455
    416 if [[ "$sisvat" == "true" ]]
    417 then
    418    CPP_KEY="$CPP_KEY CPP_SISVAT"
    419    SISVAT_PATH="$LIBFGCM/%PHYS/sisvat"
    420 fi
    421 
    422456if [[ "$inlandsis" == "true" ]]
    423457then
    … …  
    427461
    428462
    429 if [[ "$rrtm" == "true" ]]
     463if [[ "$rad" == "rrtm" ]]
    430464then
    431465   CPP_KEY="$CPP_KEY CPP_RRTM"
    432    RRTM_PATH="$LIBFGCM/%PHYS/rrtm"
     466   RAD_PATH="$LIBFGCM/%PHYS/rrtm"
     467fi
     468if [[ "$rad" == "ecrad" ]]
     469then
     470   CPP_KEY="$CPP_KEY CPP_ECRAD"
     471   RAD_PATH="$LIBFGCM/%PHYS/ecrad"
    433472fi
    434473
    … …  
    658697fi
    659698
     699if [[ "$isotopes" == "true" ]]
     700then
     701  SUFF_NAME=${SUFF_NAME}_iso
     702fi
     703if [[ "$isoverif" == "true" ]]
     704then
     705  SUFF_NAME=${SUFF_NAME}_isoverif
     706fi
     707if [[ "$isotrac" == "true" ]]
     708then
     709  SUFF_NAME=${SUFF_NAME}_isotrac
     710fi
     711if [[ "$diagiso" == "true" ]]
     712then
     713  SUFF_NAME=${SUFF_NAME}_diagiso
     714fi
     715
    660716if [[ $libphy == "true" ]]
    661717then
    … …  
    694750echo "%DYN_PHYS      $DYN_PHYS_PATH" >> $config_fcm
    695751echo "%DYN_PHYS_SUB  $DYN_PHYS_SUB_PATH" >> $config_fcm
    696 echo "%RRTM          $RRTM_PATH"     >> $config_fcm
     752echo "%RAD           $RAD_PATH"     >> $config_fcm
    697753echo "%DUST          $DUST_PATH"     >> $config_fcm
    698754echo "%STRATAER      $STRATAER_PATH" >> $config_fcm
    699 echo "%SISVAT        $SISVAT_PATH"   >> $config_fcm
    700755echo "%INLANDSIS     $INLANDSIS_PATH" >> $config_fcm
    701756echo "%COSP          $COSP_PATH"     >> $config_fcm
Note: See TracChangeset for help on using the changeset viewer.