Changeset 4358


Ignore:
Timestamp:
Nov 30, 2022, 4:37:30 PM (19 months ago)
Author:
dcugnet
Message:
  • remove "config_inca" variable from "control_mod" and "infotrac_phy" (read in infotrac)
  • only kept version of "type_trac" is in tracinca ; few tests are moved from infotrac to this module.
  • simplify and generalize a bit the routines "phyetat0_get" and "phyetat0_srf" from phyetat0, converted to a module.
  • fix the isotopic version: few "USE … » were misplaced between ISOVERIF CPP keys
  • fix the old water and derived isotopes names in the ISOTRAC case
Location:
LMDZ6/trunk/libf
Files:
12 edited
2 moved

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk/libf/dyn3d/conf_gcm.F90

    r4100 r4358  
    599599     type_trac = 'lmdz'
    600600     CALL getin('type_trac',type_trac)
    601 
    602      !Config  Key  = config_inca
    603      !Config  Desc = Choix de configuration de INCA
    604      !Config  Def  = none
    605      !Config  Help = Choix de configuration de INCA :
    606      !Config         'none' = sans INCA
    607      !Config         'chem' = INCA avec calcul de chemie
    608      !Config         'aero' = INCA avec calcul des aerosols
    609      config_inca = 'none'
    610      CALL getin('config_inca',config_inca)
    611601
    612602     !Config  Key  = ok_dynzon
    … …  
    672662     write(lunout,*)' offline = ', offline
    673663     write(lunout,*)' type_trac = ', type_trac
    674      write(lunout,*)' config_inca = ', config_inca
    675664     write(lunout,*)' ok_dynzon = ', ok_dynzon
    676665     write(lunout,*)' ok_dyn_ins = ', ok_dyn_ins
    … …  
    795784     type_trac = 'lmdz'
    796785     CALL getin('type_trac',type_trac)
    797 
    798      !Config  Key  = config_inca
    799      !Config  Desc = Choix de configuration de INCA
    800      !Config  Def  = none
    801      !Config  Help = Choix de configuration de INCA :
    802      !Config         'none' = sans INCA
    803      !Config         'chem' = INCA avec calcul de chemie
    804      !Config         'aero' = INCA avec calcul des aerosols
    805      config_inca = 'none'
    806      CALL getin('config_inca',config_inca)
    807786
    808787     !Config  Key  = ok_dynzon
    … …  
    912891     write(lunout,*)' offline = ', offline
    913892     write(lunout,*)' type_trac = ', type_trac
    914      write(lunout,*)' config_inca = ', config_inca
    915893     write(lunout,*)' ok_dynzon = ', ok_dynzon
    916894     write(lunout,*)' ok_dyn_ins = ', ok_dyn_ins

  • LMDZ6/trunk/libf/dyn3d_common/control_mod.F90

    r4146 r4358  
    2929  INTEGER,SAVE :: ip_ebil_dyn
    3030  LOGICAL,SAVE :: offline
    31   CHARACTER(len=4),SAVE :: config_inca
    3231  CHARACTER(len=10),SAVE :: planet_type ! planet type ('earth','mars',...)
    3332  LOGICAL,SAVE :: output_grads_dyn ! output dynamics diagnostics in

  • LMDZ6/trunk/libf/dyn3d_common/infotrac.F90

    r4325 r4358  
    6767!  | phase       | Phases list ("g"as / "l"iquid / "s"olid)             | /           | [g][l][s]              |
    6868!  | component   | Name(s) of the merged/cumulated section(s)           | /           | coma-separated names   |
    69 !  | iadv        | Advection scheme number                              | iadv        | 1-20,30 exc. 3-9,15,19 |
    7069!  | iGeneration | Generation (>=1)                                     | /           |                        |
    71 !  | isAdvected  | advected tracers flag (.TRUE. if iadv >= 0)          | /           | nqtrue  .TRUE. values  |
    72 !  | isInPhysics | tracers not extracted from the main table in physics | /           | nqtottr .TRUE. values  |
    7370!  | iqParent    | Index of the parent tracer                           | iqpere      | 1:nqtot                |
    7471!  | iqDescen    | Indexes of the childs       (all generations)        | iqfils      | 1:nqtot                |
    7572!  | nqDescen    | Number of the descendants   (all generations)        | nqdesc      | 1:nqtot                |
    7673!  | nqChildren  | Number of childs            (1st generation only)    | nqfils      | 1:nqtot                |
     74!  | keys        | key/val pairs accessible with "getKey" routine       | /           |                        |
     75!  | iadv        | Advection scheme number                              | iadv        | 1,2,10-20(exc.15,19),30|
     76!  | isAdvected  | advected tracers flag (.TRUE. if iadv >= 0)          | /           | nqtrue  .TRUE. values  |
     77!  | isInPhysics | tracers not extracted from the main table in physics | /           | nqtottr .TRUE. values  |
    7778!  | iso_iGroup  | Isotopes group index in isotopes(:)                  | /           | 1:nbIso                |
    7879!  | iso_iName   | Isotope  name  index in isotopes(iso_iGroup)%trac(:) | iso_indnum  | 1:niso                 |
    7980!  | iso_iZone   | Isotope  zone  index in isotopes(iso_iGroup)%zone(:) | zone_num    | 1:nzone                |
    8081!  | iso_iPhas   | Isotope  phase index in isotopes(iso_iGroup)%phas(:) | phase_num   | 1:nphas                |
    81 !  | keys        | key/val pairs accessible with "getKey" routine       | /           |                        |
    8282!  +-------------+------------------------------------------------------+-------------+------------------------+
    8383!
    … …  
    114114
    115115SUBROUTINE init_infotrac
    116    USE control_mod, ONLY: planet_type, config_inca
     116   USE control_mod, ONLY: planet_type
    117117#ifdef REPROBUS
    118118   USE CHEM_REP,    ONLY: Init_chem_rep_trac
    … …  
    182182      msg1 = 'For type_trac = "'//TRIM(types_trac(it))//'":'
    183183      SELECT CASE(types_trac(it))
    184          CASE('inca'); CALL msg(TRIM(msg1)//' coupling with INCA chemistry model, config_inca='//config_inca, modname)
     184         CASE('inca'); CALL msg(TRIM(msg1)//' coupling with INCA chemistry model',        modname)
    185185         CASE('inco'); CALL msg(TRIM(msg1)//' coupling jointly with INCA and CO2 cycle',  modname)
    186186         CASE('repr'); CALL msg(TRIM(msg1)//' coupling with REPROBUS chemistry model',    modname)
    … …  
    191191      END SELECT
    192192
    193       !--- COHERENCE TEST BETWEEN "type_trac" AND "config_inca"
    194       IF(ANY(['inca', 'inco'] == types_trac(it)) .AND. ALL(['aero', 'aeNP', 'chem'] /= config_inca)) &
    195          CALL abort_gcm(modname, 'Incoherence between type_trac and config_inca. Please modify "run.def"',1)
    196 
    197193      !--- COHERENCE TEST BETWEEN "type_trac" AND PREPROCESSING KEYS
    198194      SELECT CASE(types_trac(it))
    … …  
    214210   END DO
    215211   !---------------------------------------------------------------------------------------------------------------------------
    216 
    217    !--- DISABLE "config_inca" OPTION FOR A RUN WITHOUT "INCA" IF IT DIFFERS FROM "none"
    218    IF(fmsg('Setting config_inca="none" as you do not couple with INCA model', &
    219          modname, ALL(types_trac /= 'inca') .AND. ALL(types_trac /= 'inco') .AND. config_inca /= 'none')) config_inca = 'none'
    220212
    221213   nqCO2 = COUNT( [ANY(types_trac == 'inco') .OR. (ANY(types_trac == 'co2i') .AND. ANY(types_trac == 'inca'))] )

  • LMDZ6/trunk/libf/dyn3dmem/conf_gcm.F90

    r4146 r4358  
    644644     type_trac = 'lmdz'
    645645     CALL getin('type_trac',type_trac)
    646 
    647      !Config  Key  = config_inca
    648      !Config  Desc = Choix de configuration de INCA
    649      !Config  Def  = none
    650      !Config  Help = Choix de configuration de INCA :
    651      !Config         'none' = sans INCA
    652      !Config         'chem' = INCA avec calcul de chemie
    653      !Config         'aero' = INCA avec calcul des aerosols
    654      config_inca = 'none'
    655      CALL getin('config_inca',config_inca)
    656646
    657647     !Config  Key  = ok_dynzon
    … …  
    725715     write(lunout,*)' offline = ', offline
    726716     write(lunout,*)' type_trac = ', type_trac
    727      write(lunout,*)' config_inca = ', config_inca
    728717     write(lunout,*)' ok_dynzon = ', ok_dynzon
    729718     write(lunout,*)' ok_dyn_ins = ', ok_dyn_ins
    … …  
    855844     type_trac = 'lmdz'
    856845     CALL getin('type_trac',type_trac)
    857 
    858      !Config  Key  = config_inca
    859      !Config  Desc = Choix de configuration de INCA
    860      !Config  Def  = none
    861      !Config  Help = Choix de configuration de INCA :
    862      !Config         'none' = sans INCA
    863      !Config         'chem' = INCA avec calcul de chemie
    864      !Config         'aero' = INCA avec calcul des aerosols
    865      config_inca = 'none'
    866      CALL getin('config_inca',config_inca)
    867846
    868847     !Config  Key  = ok_dynzon
    … …  
    1006985     write(lunout,*)' offline = ', offline
    1007986     write(lunout,*)' type_trac = ', type_trac
    1008      write(lunout,*)' config_inca = ', config_inca
    1009987     write(lunout,*)' ok_dynzon = ', ok_dynzon
    1010988     write(lunout,*)' ok_dyn_ins = ', ok_dyn_ins

  • LMDZ6/trunk/libf/dynphy_lonlat/phylmd/iniphysiq_mod.F90

    r4325 r4358  
    3030  USE mod_phys_lmdz_omp_data, ONLY: klon_omp
    3131#endif
    32   USE control_mod, ONLY: dayref,anneeref,day_step,nday,offline, iphysiq, config_inca
     32  USE control_mod, ONLY: dayref,anneeref,day_step,nday,offline, iphysiq
    3333  USE inifis_mod, ONLY: inifis
    3434  USE time_phylmdz_mod, ONLY: init_time

  • LMDZ6/trunk/libf/misc/readTracFiles_mod.f90

    r4348 r4358  
    5454    CHARACTER(LEN=maxlen) :: phase       = 'g'             !--- Phase ('g'as / 'l'iquid / 's'olid)
    5555    CHARACTER(LEN=maxlen) :: component   = ''              !--- Coma-separated list of components (Ex: lmdz,inca)
    56     INTEGER               :: iadv        = 10              !--- Advection scheme used
    5756    INTEGER               :: iGeneration = -1              !--- Generation number (>=0)
    58     LOGICAL               :: isAdvected  = .FALSE.         !--- "true" tracers: iadv > 0.   COUNT(isAdvected )=nqtrue
    59     LOGICAL               :: isInPhysics = .TRUE.          !--- "true" tracers: in tr_seri. COUNT(isInPhysics)=nqtottr
    6057    INTEGER               :: iqParent    = 0               !--- Parent index
    6158    INTEGER,  ALLOCATABLE :: iqDescen(:)                   !--- Descendants index (in growing generation order)
    6259    INTEGER               :: nqDescen    = 0               !--- Number of descendants (all generations)
    6360    INTEGER               :: nqChildren  = 0               !--- Number of children  (first generation)
     61    TYPE(keys_type)       :: keys                          !--- <key>=<val> pairs vector
     62    INTEGER               :: iadv        = 10              !--- Advection scheme used
     63    LOGICAL               :: isAdvected  = .FALSE.         !--- "true" tracers: iadv > 0.   COUNT(isAdvected )=nqtrue
     64    LOGICAL               :: isInPhysics = .TRUE.          !--- "true" tracers: in tr_seri. COUNT(isInPhysics)=nqtottr
    6465    INTEGER               :: iso_iGroup  = 0               !--- Isotopes group index in isotopes(:)
    6566    INTEGER               :: iso_iName   = 0               !--- Isotope  name  index in isotopes(iso_iGroup)%trac(:)
    6667    INTEGER               :: iso_iZone   = 0               !--- Isotope  zone  index in isotopes(iso_iGroup)%zone(:)
    6768    INTEGER               :: iso_iPhase  = 0               !--- Isotope  phase index in isotopes(iso_iGroup)%phase
    68     TYPE(keys_type)       :: keys                          !--- <key>=<val> pairs vector
    6969  END TYPE trac_type
    7070!------------------------------------------------------------------------------------------------------------------------------
    … …  
    18951895  ip = getiPhase(newName)                                                      !--- Phase index
    18961896  IF(ip /= 0 .AND. PRESENT(iPhase)) iPhase = ip                                !--- Returning phase index
    1897   ix = strIdx(newH2OIso, newName)                                              !--- Index in the known H2O isotopes list
    1898   IF(ix /= 0) oldName = 'H2O'//'_'//TRIM(oldH2OIso(ix))                        !=== WATER ISOTOPE WITHOUT PHASE
     1897  ix = strIdx(newH2OIso, strHead(newName, '_'))                                !--- Index in the known H2O isotopes list
     1898  IF(ix /= 0) THEN
     1899    oldName = 'H2O'//'_'//TRIM(oldH2OIso(ix))                                  !=== WATER ISOTOPE WITHOUT PHASE
     1900    IF(newH2OIso(ix)/=newName) oldName=TRIM(oldName)//'_'//strTail(newName,'_')!=== WATER ISOTOPIC TAGGING TRACER WITHOUT PHASE
     1901  END IF
    18991902  IF(ix /= 0 .OR. ip == 0)           RETURN
    19001903  oldName = 'H2O'//old_phases(ip:ip)

  • LMDZ6/trunk/libf/misc/strings_mod.F90

    r4349 r4358  
    505505!=== Count the number of elements separated by "delimiter" in list "rawList". =================================================
    506506!==============================================================================================================================
    507 LOGICAL FUNCTION strCount_11(rawList, delimiter, nb, lSc) RESULT(out)
     507LOGICAL FUNCTION strCount_11(rawList, delimiter, nb, lSc) RESULT(lerr)
    508508  CHARACTER(LEN=*),  INTENT(IN)  :: rawList
    509509  CHARACTER(LEN=*),  INTENT(IN)  :: delimiter
    … …  
    513513  LOGICAL :: ll
    514514  ll = .FALSE.; IF(PRESENT(lSc)) ll = lSc
    515   out = strCount_1m(rawList, [delimiter], nb, ll)
     515  lerr = strCount_1m(rawList, [delimiter], nb, ll)
    516516END FUNCTION strCount_11
    517517!==============================================================================================================================
    518 LOGICAL FUNCTION strCount_m1(rawList, delimiter, nb, lSc) RESULT(out)
     518LOGICAL FUNCTION strCount_m1(rawList, delimiter, nb, lSc) RESULT(lerr)
    519519  CHARACTER(LEN=*),     INTENT(IN)  :: rawList(:)
    520520  CHARACTER(LEN=*),     INTENT(IN)  :: delimiter
    … …  
    525525  INTEGER :: id
    526526  ll  = .FALSE.; IF(PRESENT(lSc)) ll = lSc .AND. INDEX('+-', delimiter) /= 0
    527   out = .TRUE.
     527  lerr = .TRUE.
    528528  ALLOCATE(nb(SIZE(rawList)))
    529529  DO id = 1, SIZE(rawList)
    530     out = out .AND. strCount_1m(rawList(id), [delimiter], nb(id), ll)
     530    lerr = lerr .AND. strCount_1m(rawList(id), [delimiter], nb(id), ll)
    531531  END DO
    532532END FUNCTION strCount_m1

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

    r4328 r4358  
    7676!  | nqDescen    | Number of the descendants   (all generations)        | nqdesc      | 1:nqtot                |
    7777!  | nqChildren  | Number of childs            (1st generation only)    | nqfils      | 1:nqtot                |
     78!  | keys        | key/val pairs accessible with "getKey" routine       | /           |                        |
    7879!  | iso_iGroup  | Isotopes group index in isotopes(:)                  | /           | 1:nbIso                |
    7980!  | iso_iName   | Isotope  name  index in isotopes(iso_iGroup)%trac(:) | iso_indnum  | 1:niso                 |
    8081!  | iso_iZone   | Isotope  zone  index in isotopes(iso_iGroup)%zone(:) | zone_num    | 1:nzone                |
    8182!  | iso_iPhas   | Isotope  phase index in isotopes(iso_iGroup)%phas(:) | phase_num   | 1:nphas                |
    82 !  | keys        | key/val pairs accessible with "getKey" routine       | /           |                        |
    8383!  +-------------+------------------------------------------------------+-------------+------------------------+
    8484!
    … …  
    123123
    124124SUBROUTINE init_infotrac_phy
    125    USE control_mod, ONLY: planet_type, config_inca
    126125   USE ioipsl_getin_p_mod, ONLY: getin_p
    127126#ifdef REPROBUS
    128    USE CHEM_REP,    ONLY: Init_chem_rep_trac
     127   USE CHEM_REP, ONLY: Init_chem_rep_trac
    129128#endif
    130129   IMPLICIT NONE
    … …  
    200199      msg1 = 'For type_trac = "'//TRIM(types_trac(it))//'":'
    201200      SELECT CASE(types_trac(it))
    202          CASE('inca'); CALL msg(TRIM(msg1)//' coupling with INCA chemistry model, config_inca='//config_inca, modname)
     201         CASE('inca'); CALL msg(TRIM(msg1)//' coupling with INCA chemistry model',        modname)
    203202         CASE('inco'); CALL msg(TRIM(msg1)//' coupling jointly with INCA and CO2 cycle',  modname)
    204203         CASE('repr'); CALL msg(TRIM(msg1)//' coupling with REPROBUS chemistry model',    modname)
    … …  
    209208      END SELECT
    210209
    211       !--- COHERENCE TEST BETWEEN "type_trac" AND "config_inca"
    212       IF(ANY(['inca', 'inco'] == types_trac(it)) .AND. ALL(['aero', 'aeNP', 'chem'] /= config_inca)) &
    213          CALL abort_gcm(modname, 'Incoherence between type_trac and config_inca. Please modify "run.def"',1)
    214 
    215210      !--- COHERENCE TEST BETWEEN "type_trac" AND PREPROCESSING KEYS
    216211      SELECT CASE(types_trac(it))
    … …  
    236231   END IF
    237232!##############################################################################################################################
    238 
    239    !--- DISABLE "config_inca" OPTION FOR A RUN WITHOUT "INCA" IF IT DIFFERS FROM "none"
    240    IF(fmsg('Setting config_inca="none" as you do not couple with INCA model', &
    241          modname, ALL(types_trac /= 'inca') .AND. ALL(types_trac /= 'inco') .AND. config_inca /= 'none')) config_inca = 'none'
    242233
    243234   nqCO2 = COUNT( [ANY(types_trac == 'inco') .OR. (ANY(types_trac == 'co2i') .AND. ANY(types_trac == 'inca'))] )

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

    r4357 r4358  
    11! $Id$
     2
     3MODULE phyetat0_mod
     4
     5  PRIVATE
     6  PUBLIC :: phyetat0, phyetat0_get, phyetat0_srf
     7
     8  INTERFACE phyetat0_get
     9    MODULE PROCEDURE phyetat0_get10, phyetat0_get20, phyetat0_get11, phyetat0_get21
     10  END INTERFACE phyetat0_get
     11  INTERFACE phyetat0_srf
     12    MODULE PROCEDURE phyetat0_srf20, phyetat0_srf30, phyetat0_srf21, phyetat0_srf31
     13  END INTERFACE phyetat0_srf
     14
     15CONTAINS
    216
    317SUBROUTINE phyetat0 (fichnom, clesphy0, tabcntr0)
    … …  
    2438  USE iostart,          ONLY: close_startphy, get_field, get_var, open_startphy
    2539  USE infotrac_phy,     ONLY: nqtot, nbtr, type_trac, types_trac, tracers
     40  USE readTracFiles_mod,ONLY: maxlen, new2oldH2O
    2641  USE traclmdz_mod,     ONLY: traclmdz_from_restart
    2742  USE carbon_cycle_mod, ONLY: carbon_cycle_init, carbon_cycle_cpl, carbon_cycle_tr, carbon_cycle_rad, co2_send, RCO2_glo
    … …  
    7994  CHARACTER*7 str7
    8095  CHARACTER*2 str2
    81   LOGICAL :: found,phyetat0_get,phyetat0_srf
     96  LOGICAL :: found
    8297  REAL :: lon_startphy(klon), lat_startphy(klon)
     98  CHARACTER(LEN=maxlen) :: tname, t(2)
    8399
    84100  ! FH1D
    … …  
    260276!===================================================================
    261277
    262   found=phyetat0_get(1,ftsol(:,1),"TS","Surface temperature",283.)
     278  found=phyetat0_get(ftsol(:,1),"TS","Surface temperature",283.)
    263279  IF (found) THEN
    264280     DO nsrf=2,nbsrf
    … …  
    266282     ENDDO
    267283  ELSE
    268      found=phyetat0_srf(1,ftsol,"TS","Surface temperature",283.)
     284     found=phyetat0_srf(ftsol,"TS","Surface temperature",283.)
    269285  ENDIF
    270286
    … …  
    280296        ENDIF
    281297        WRITE(str2, '(i2.2)') isw
    282         found=phyetat0_srf(1,falb_dir(:, isw,:),"A_dir_SW"//str2//"srf","Direct Albedo",0.2)
    283         found=phyetat0_srf(1,falb_dif(:, isw,:),"A_dif_SW"//str2//"srf","Direct Albedo",0.2)
     298        found=phyetat0_srf(falb_dir(:, isw,:),"A_dir_SW"//str2//"srf","Direct Albedo",0.2)
     299        found=phyetat0_srf(falb_dif(:, isw,:),"A_dif_SW"//str2//"srf","Direct Albedo",0.2)
    284300     ENDDO
    285301  ENDDO
    286302
    287   found=phyetat0_srf(1,u10m,"U10M","u a 10m",0.)
    288   found=phyetat0_srf(1,v10m,"V10M","v a 10m",0.)
     303  found=phyetat0_srf(u10m,"U10M","u a 10m",0.)
     304  found=phyetat0_srf(v10m,"V10M","v a 10m",0.)
    289305
    290306!===================================================================
    … …  
    298314        ENDIF
    299315        WRITE(str2,'(i2.2)') isoil
    300         found=phyetat0_srf(1,tsoil(:, isoil,:),"Tsoil"//str2//"srf","Temp soil",0.)
     316        found=phyetat0_srf(tsoil(:, isoil,:),"Tsoil"//str2//"srf","Temp soil",0.)
    301317        IF (.NOT. found) THEN
    302318           PRINT*, "phyetat0: Le champ <Tsoil"//str7//"> est absent"
    … …  
    310326!=======================================================================
    311327
    312   found=phyetat0_srf(1,qsurf,"QS","Near surface hmidity",0.)
    313   found=phyetat0_get(1,qsol,"QSOL","Surface hmidity / bucket",0.)
    314   found=phyetat0_srf(1,snow,"SNOW","Surface snow",0.)
    315   found=phyetat0_srf(1,fevap,"EVAP","evaporation",0.)
    316   found=phyetat0_get(1,snow_fall,"snow_f","snow fall",0.)
    317   found=phyetat0_get(1,rain_fall,"rain_f","rain fall",0.)
     328  found=phyetat0_srf(qsurf,"QS","Near surface hmidity",0.)
     329  found=phyetat0_get(qsol,"QSOL","Surface hmidity / bucket",0.)
     330  found=phyetat0_srf(snow,"SNOW","Surface snow",0.)
     331  found=phyetat0_srf(fevap,"EVAP","evaporation",0.)
     332  found=phyetat0_get(snow_fall,"snow_f","snow fall",0.)
     333  found=phyetat0_get(rain_fall,"rain_f","rain fall",0.)
    318334
    319335!=======================================================================
    … …  
    321337!=======================================================================
    322338
    323   found=phyetat0_get(1,solsw,"solsw","net SW radiation surf",0.)
    324   found=phyetat0_get(1,solswfdiff,"solswfdiff","fraction of SW radiation surf that is diffuse",1.)
    325   found=phyetat0_get(1,sollw,"sollw","net LW radiation surf",0.)
    326   found=phyetat0_get(1,sollwdown,"sollwdown","down LW radiation surf",0.)
     339  found=phyetat0_get(solsw,"solsw","net SW radiation surf",0.)
     340  found=phyetat0_get(solswfdiff,"solswfdiff","fraction of SW radiation surf that is diffuse",1.)
     341  found=phyetat0_get(sollw,"sollw","net LW radiation surf",0.)
     342  found=phyetat0_get(sollwdown,"sollwdown","down LW radiation surf",0.)
    327343  IF (.NOT. found) THEN
    328344     sollwdown(:) = 0. ;  zts(:)=0.
    … …  
    333349  ENDIF
    334350
    335   found=phyetat0_get(1,radsol,"RADS","Solar radiation",0.)
    336   found=phyetat0_get(1,fder,"fder","Flux derivative",0.)
     351  found=phyetat0_get(radsol,"RADS","Solar radiation",0.)
     352  found=phyetat0_get(fder,"fder","Flux derivative",0.)
    337353
    338354
    339355  ! Lecture de la longueur de rugosite
    340   found=phyetat0_srf(1,z0m,"RUG","Z0m ancien",0.001)
     356  found=phyetat0_srf(z0m,"RUG","Z0m ancien",0.001)
    341357  IF (found) THEN
    342358     z0h(:,1:nbsrf)=z0m(:,1:nbsrf)
    343359  ELSE
    344      found=phyetat0_srf(1,z0m,"Z0m","Roughness length, momentum ",0.001)
    345      found=phyetat0_srf(1,z0h,"Z0h","Roughness length, enthalpy ",0.001)
     360     found=phyetat0_srf(z0m,"Z0m","Roughness length, momentum ",0.001)
     361     found=phyetat0_srf(z0h,"Z0h","Roughness length, enthalpy ",0.001)
    346362  ENDIF
    347363!FC
    … …  
    350366    treedrg(:,1:klev,1:nbsrf)= 0.0
    351367    CALL get_field("treedrg_ter", drg_ter(:,:), found)
    352 !  found=phyetat0_srf(1,treedrg,"treedrg","drag from vegetation" , 0.)
     368!  found=phyetat0_srf(treedrg,"treedrg","drag from vegetation" , 0.)
    353369    !lecture du profile de freinage des arbres
    354370    IF (.not. found ) THEN
    … …  
    356372    ELSE
    357373      treedrg(:,1:klev,is_ter)= drg_ter(:,:)
    358 !     found=phyetat0_srf(klev,treedrg,"treedrg","freinage arbres",0.)
     374!     found=phyetat0_get(treedrg,"treedrg","freinage arbres",0.)
    359375    ENDIF
    360376  ELSE
    … …  
    364380
    365381  ! Lecture de l'age de la neige:
    366   found=phyetat0_srf(1,agesno,"AGESNO","SNOW AGE",0.001)
     382  found=phyetat0_srf(agesno,"AGESNO","SNOW AGE",0.001)
    367383
    368384  ancien_ok=.true.
    369   ancien_ok=ancien_ok.AND.phyetat0_get(klev,t_ancien,"TANCIEN","TANCIEN",0.)
    370   ancien_ok=ancien_ok.AND.phyetat0_get(klev,q_ancien,"QANCIEN","QANCIEN",0.)
    371   ancien_ok=ancien_ok.AND.phyetat0_get(klev,ql_ancien,"QLANCIEN","QLANCIEN",0.)
    372   ancien_ok=ancien_ok.AND.phyetat0_get(klev,qs_ancien,"QSANCIEN","QSANCIEN",0.)
    373   ancien_ok=ancien_ok.AND.phyetat0_get(klev,rneb_ancien,"RNEBANCIEN","RNEBANCIEN",0.)
    374   ancien_ok=ancien_ok.AND.phyetat0_get(klev,u_ancien,"UANCIEN","UANCIEN",0.)
    375   ancien_ok=ancien_ok.AND.phyetat0_get(klev,v_ancien,"VANCIEN","VANCIEN",0.)
    376   ancien_ok=ancien_ok.AND.phyetat0_get(1,prw_ancien,"PRWANCIEN","PRWANCIEN",0.)
    377   ancien_ok=ancien_ok.AND.phyetat0_get(1,prlw_ancien,"PRLWANCIEN","PRLWANCIEN",0.)
    378   ancien_ok=ancien_ok.AND.phyetat0_get(1,prsw_ancien,"PRSWANCIEN","PRSWANCIEN",0.)
     385  ancien_ok=ancien_ok.AND.phyetat0_get(t_ancien,"TANCIEN","TANCIEN",0.)
     386  ancien_ok=ancien_ok.AND.phyetat0_get(q_ancien,"QANCIEN","QANCIEN",0.)
     387  ancien_ok=ancien_ok.AND.phyetat0_get(ql_ancien,"QLANCIEN","QLANCIEN",0.)
     388  ancien_ok=ancien_ok.AND.phyetat0_get(qs_ancien,"QSANCIEN","QSANCIEN",0.)
     389  ancien_ok=ancien_ok.AND.phyetat0_get(rneb_ancien,"RNEBANCIEN","RNEBANCIEN",0.)
     390  ancien_ok=ancien_ok.AND.phyetat0_get(u_ancien,"UANCIEN","UANCIEN",0.)
     391  ancien_ok=ancien_ok.AND.phyetat0_get(v_ancien,"VANCIEN","VANCIEN",0.)
     392  ancien_ok=ancien_ok.AND.phyetat0_get(prw_ancien,"PRWANCIEN","PRWANCIEN",0.)
     393  ancien_ok=ancien_ok.AND.phyetat0_get(prlw_ancien,"PRLWANCIEN","PRLWANCIEN",0.)
     394  ancien_ok=ancien_ok.AND.phyetat0_get(prsw_ancien,"PRSWANCIEN","PRSWANCIEN",0.)
    379395
    380396  ! Ehouarn: addtional tests to check if t_ancien, q_ancien contain
    … …  
    392408  ENDIF
    393409
    394   found=phyetat0_get(klev,clwcon,"CLWCON","CLWCON",0.)
    395   found=phyetat0_get(klev,rnebcon,"RNEBCON","RNEBCON",0.)
    396   found=phyetat0_get(klev,ratqs,"RATQS","RATQS",0.)
    397 
    398   found=phyetat0_get(1,run_off_lic_0,"RUNOFFLIC0","RUNOFFLIC0",0.)
     410  found=phyetat0_get(clwcon,"CLWCON","CLWCON",0.)
     411  found=phyetat0_get(rnebcon,"RNEBCON","RNEBCON",0.)
     412  found=phyetat0_get(ratqs,"RATQS","RATQS",0.)
     413
     414  found=phyetat0_get(run_off_lic_0,"RUNOFFLIC0","RUNOFFLIC0",0.)
    399415
    400416!==================================
    … …  
    403419!
    404420  IF (iflag_pbl>1) then
    405      found=phyetat0_srf(klev+1,pbl_tke,"TKE","Turb. Kinetic. Energ. ",1.e-8)
     421     found=phyetat0_srf(pbl_tke,"TKE","Turb. Kinetic. Energ. ",1.e-8)
    406422  ENDIF
    407423
    408424  IF (iflag_pbl>1 .AND. iflag_wake>=1  .AND. iflag_pbl_split >=1 ) then
    409     found=phyetat0_srf(klev+1,wake_delta_pbl_tke,"DELTATKE","Del TKE wk/env",0.)
    410 !!    found=phyetat0_srf(1,delta_tsurf,"DELTA_TSURF","Delta Ts wk/env ",0.)
    411     found=phyetat0_srf(1,delta_tsurf,"DELTATS","Delta Ts wk/env ",0.)
    412 !!    found=phyetat0_srf(1,beta_aridity,"BETA_S","Aridity factor ",1.)
    413     found=phyetat0_srf(1,beta_aridity,"BETAS","Aridity factor ",1.)
     425    found=phyetat0_srf(wake_delta_pbl_tke,"DELTATKE","Del TKE wk/env",0.)
     426!!    found=phyetat0_srf(delta_tsurf,"DELTA_TSURF","Delta Ts wk/env ",0.)
     427    found=phyetat0_srf(delta_tsurf,"DELTATS","Delta Ts wk/env ",0.)
     428!!    found=phyetat0_srf(beta_aridity,"BETA_S","Aridity factor ",1.)
     429    found=phyetat0_srf(beta_aridity,"BETAS","Aridity factor ",1.)
    414430  ENDIF   !(iflag_pbl>1 .AND. iflag_wake>=1 .AND. iflag_pbl_split >=1 )
    415431
    … …  
    419435
    420436! Emanuel
    421   found=phyetat0_get(klev,sig1,"sig1","sig1",0.)
    422   found=phyetat0_get(klev,w01,"w01","w01",0.)
     437  found=phyetat0_get(sig1,"sig1","sig1",0.)
     438  found=phyetat0_get(w01,"w01","w01",0.)
    423439
    424440! Wake
    425   found=phyetat0_get(klev,wake_deltat,"WAKE_DELTAT","Delta T wake/env",0.)
    426   found=phyetat0_get(klev,wake_deltaq,"WAKE_DELTAQ","Delta hum. wake/env",0.)
    427   found=phyetat0_get(1,wake_s,"WAKE_S","Wake frac. area",0.)
     441  found=phyetat0_get(wake_deltat,"WAKE_DELTAT","Delta T wake/env",0.)
     442  found=phyetat0_get(wake_deltaq,"WAKE_DELTAQ","Delta hum. wake/env",0.)
     443  found=phyetat0_get(wake_s,"WAKE_S","Wake frac. area",0.)
    428444!jyg<
    429445!  Set wake_dens to -1000. when there is no restart so that the actual
    430446!  initialization is made in calwake.
    431447!!  found=phyetat0_get(1,wake_dens,"WAKE_DENS","Wake num. /unit area",0.)
    432   found=phyetat0_get(1,wake_dens,"WAKE_DENS","Wake num. /unit area",-1000.)
    433   found=phyetat0_get(1,awake_dens,"AWAKE_DENS","Active Wake num. /unit area",0.)
    434   found=phyetat0_get(1,cv_gen,"CV_GEN","CB birth rate",0.)
     448  found=phyetat0_get(wake_dens,"WAKE_DENS","Wake num. /unit area",-1000.)
     449  found=phyetat0_get(awake_dens,"AWAKE_DENS","Active Wake num. /unit area",0.)
     450  found=phyetat0_get(cv_gen,"CV_GEN","CB birth rate",0.)
    435451!>jyg
    436   found=phyetat0_get(1,wake_cstar,"WAKE_CSTAR","WAKE_CSTAR",0.)
    437   found=phyetat0_get(1,wake_pe,"WAKE_PE","WAKE_PE",0.)
    438   found=phyetat0_get(1,wake_fip,"WAKE_FIP","WAKE_FIP",0.)
     452  found=phyetat0_get(wake_cstar,"WAKE_CSTAR","WAKE_CSTAR",0.)
     453  found=phyetat0_get(wake_pe,"WAKE_PE","WAKE_PE",0.)
     454  found=phyetat0_get(wake_fip,"WAKE_FIP","WAKE_FIP",0.)
    439455
    440456! Thermiques
    441   found=phyetat0_get(1,zmax0,"ZMAX0","ZMAX0",40.)
    442   found=phyetat0_get(1,f0,"F0","F0",1.e-5)
    443   found=phyetat0_get(klev+1,fm_therm,"FM_THERM","Thermals mass flux",0.)
    444   found=phyetat0_get(klev,entr_therm,"ENTR_THERM","Thermals Entrain.",0.)
    445   found=phyetat0_get(klev,detr_therm,"DETR_THERM","Thermals Detrain.",0.)
     457  found=phyetat0_get(zmax0,"ZMAX0","ZMAX0",40.)
     458  found=phyetat0_get(f0,"F0","F0",1.e-5)
     459  found=phyetat0_get(fm_therm,"FM_THERM","Thermals mass flux",0.)
     460  found=phyetat0_get(entr_therm,"ENTR_THERM","Thermals Entrain.",0.)
     461  found=phyetat0_get(detr_therm,"DETR_THERM","Thermals Detrain.",0.)
    446462
    447463! ALE/ALP
    448   found=phyetat0_get(1,ale_bl,"ALE_BL","ALE BL",0.)
    449   found=phyetat0_get(1,ale_bl_trig,"ALE_BL_TRIG","ALE BL_TRIG",0.)
    450   found=phyetat0_get(1,alp_bl,"ALP_BL","ALP BL",0.)
    451   found=phyetat0_get(1,ale_wake,"ALE_WAKE","ALE_WAKE",0.)
    452   found=phyetat0_get(1,ale_bl_stat,"ALE_BL_STAT","ALE_BL_STAT",0.)
     464  found=phyetat0_get(ale_bl,"ALE_BL","ALE BL",0.)
     465  found=phyetat0_get(ale_bl_trig,"ALE_BL_TRIG","ALE BL_TRIG",0.)
     466  found=phyetat0_get(alp_bl,"ALP_BL","ALP BL",0.)
     467  found=phyetat0_get(ale_wake,"ALE_WAKE","ALE_WAKE",0.)
     468  found=phyetat0_get(ale_bl_stat,"ALE_BL_STAT","ALE_BL_STAT",0.)
    453469
    454470! fisrtilp/Clouds 0.002 could be ratqsbas. But can stay like this as well
    455   found=phyetat0_get(klev,ratqs_inter,"RATQS_INTER","Relative width of the lsc sugrid scale water",0.002)
     471  found=phyetat0_get(ratqs_inter,"RATQS_INTER","Relative width of the lsc sugrid scale water",0.002)
    456472
    457473!===========================================
    … …  
    464480        ALLOCATE(co2_send(klon), stat=ierr)
    465481        IF (ierr /= 0) CALL abort_physic('phyetat0', 'pb allocation co2_send', 1)
    466         !found=phyetat0_get(1,co2_send,"co2_send","co2 send",co2_ppm)
    467         found=phyetat0_get(1,co2_send,"co2_send","co2 send",co2_ppm0)
     482        found=phyetat0_get(co2_send,"co2_send","co2 send",co2_ppm0)
    468483     ENDIF
    469484  ELSE IF (type_trac == 'lmdz') THEN
    … …  
    472487        IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE
    473488        it = it+1
    474         found=phyetat0_get(1,trs(:,it),"trs_"//TRIM(tracers(iq)%name), &
    475                                   "Surf trac"//TRIM(tracers(iq)%name),0.)
     489        tname = tracers(iq)%name
     490        t(1) = 'trs_'//TRIM(tname); t(2) = 'trs_'//TRIM(new2oldH2O(tname))
     491        found = phyetat0_get(trs(:,it), t(:), "Surf trac"//TRIM(tname), 0.)
    476492     END DO
    477493     CALL traclmdz_from_restart(trs)
    … …  
    485501!  ondes de gravite non orographiques
    486502  IF (ok_gwd_rando) found = &
    487        phyetat0_get(klev,du_gwd_rando,"du_gwd_rando","du_gwd_rando",0.)
     503       phyetat0_get(du_gwd_rando,"du_gwd_rando","du_gwd_rando",0.)
    488504  IF (.NOT. ok_hines .AND. ok_gwd_rando) found &
    489        = phyetat0_get(klev,du_gwd_front,"du_gwd_front","du_gwd_front",0.)
     505       = phyetat0_get(du_gwd_front,"du_gwd_front","du_gwd_front",0.)
    490506
    491507!  prise en compte du relief sous-maille
    492   found=phyetat0_get(1,zmea,"ZMEA","sub grid orography",0.)
    493   found=phyetat0_get(1,zstd,"ZSTD","sub grid orography",0.)
    494   found=phyetat0_get(1,zsig,"ZSIG","sub grid orography",0.)
    495   found=phyetat0_get(1,zgam,"ZGAM","sub grid orography",0.)
    496   found=phyetat0_get(1,zthe,"ZTHE","sub grid orography",0.)
    497   found=phyetat0_get(1,zpic,"ZPIC","sub grid orography",0.)
    498   found=phyetat0_get(1,zval,"ZVAL","sub grid orography",0.)
    499   found=phyetat0_get(1,zmea,"ZMEA","sub grid orography",0.)
    500   found=phyetat0_get(1,rugoro,"RUGSREL","sub grid orography",0.)
     508  found=phyetat0_get(zmea,"ZMEA","sub grid orography",0.)
     509  found=phyetat0_get(zstd,"ZSTD","sub grid orography",0.)
     510  found=phyetat0_get(zsig,"ZSIG","sub grid orography",0.)
     511  found=phyetat0_get(zgam,"ZGAM","sub grid orography",0.)
     512  found=phyetat0_get(zthe,"ZTHE","sub grid orography",0.)
     513  found=phyetat0_get(zpic,"ZPIC","sub grid orography",0.)
     514  found=phyetat0_get(zval,"ZVAL","sub grid orography",0.)
     515  found=phyetat0_get(zmea,"ZMEA","sub grid orography",0.)
     516  found=phyetat0_get(rugoro,"RUGSREL","sub grid orography",0.)
    501517
    502518!===========================================
    … …  
    507523      CALL ocean_slab_init(phys_tstep, pctsrf)
    508524      IF (nslay.EQ.1) THEN
    509         found=phyetat0_get(1,tslab,"tslab01","tslab",0.)
    510         IF (.NOT. found) THEN
    511             found=phyetat0_get(1,tslab,"tslab","tslab",0.)
    512         ENDIF
     525        found=phyetat0_get(tslab,["tslab01","tslab  "],"tslab",0.)
    513526      ELSE
    514527          DO i=1,nslay
    515528            WRITE(str2,'(i2.2)') i
    516             found=phyetat0_get(1,tslab(:,i),"tslab"//str2,"tslab",0.) 
     529            found=phyetat0_get(tslab(:,i),"tslab"//str2,"tslab",0.) 
    517530          ENDDO
    518531      ENDIF
    … …  
    527540      ! Sea ice variables
    528541      IF (version_ocean == 'sicINT') THEN
    529           found=phyetat0_get(1,tice,"slab_tice","slab_tice",0.)
     542          found=phyetat0_get(tice,"slab_tice","slab_tice",0.)
    530543          IF (.NOT. found) THEN
    531544              PRINT*, "phyetat0: Le champ <tice> est absent"
    … …  
    533546                  tice(:)=ftsol(:,is_sic)
    534547          ENDIF
    535           found=phyetat0_get(1,seaice,"seaice","seaice",0.)
     548          found=phyetat0_get(seaice,"seaice","seaice",0.)
    536549          IF (.NOT. found) THEN
    537550              PRINT*, "phyetat0: Le champ <seaice> est absent"
    … …  
    547560  if (activate_ocean_skin >= 1) then
    548561     if (activate_ocean_skin == 2 .and. type_ocean == 'couple') then
    549         found = phyetat0_get(1, delta_sal, "delta_sal", &
     562        found = phyetat0_get(delta_sal, "delta_sal", &
    550563             "ocean-air interface salinity minus bulk salinity", 0.)
    551         found = phyetat0_get(1, delta_sst, "delta_SST", &
     564        found = phyetat0_get(delta_sst, "delta_SST", &
    552565             "ocean-air interface temperature minus bulk SST", 0.)
    553566     end if
    554567     
    555      found = phyetat0_get(1, ds_ns, "dS_ns", "delta salinity near surface", 0.)
    556      found = phyetat0_get(1, dt_ns, "dT_ns", "delta temperature near surface", &
     568     found = phyetat0_get(ds_ns, "dS_ns", "delta salinity near surface", 0.)
     569     found = phyetat0_get(dt_ns, "dT_ns", "delta temperature near surface", &
    557570          0.)
    558571
    … …  
    584597END SUBROUTINE phyetat0
    585598
    586 !===================================================================
    587 FUNCTION phyetat0_get(nlev,field,name,descr,default)
    588 !===================================================================
    589 ! Lecture d'un champ avec contrôle
    590 ! Function logique dont le resultat indique si la lecture
    591 ! s'est bien passée
    592 ! On donne une valeur par defaut dans le cas contraire
    593 !===================================================================
    594 
    595 USE iostart, ONLY : get_field
    596 USE dimphy, only: klon
    597 USE print_control_mod, ONLY: lunout
    598 
    599 IMPLICIT NONE
    600 
    601 LOGICAL phyetat0_get
    602 
    603 ! arguments
    604 INTEGER,INTENT(IN) :: nlev
    605 CHARACTER*(*),INTENT(IN) :: name,descr
    606 REAL,INTENT(IN) :: default
    607 REAL,DIMENSION(klon,nlev),INTENT(INOUT) :: field
    608 
    609 ! Local variables
    610 LOGICAL found
    611 
    612    CALL get_field(name, field, found)
    613    IF (.NOT. found) THEN
    614      WRITE(lunout,*) "phyetat0: Le champ <",TRIM(name),"> est absent"
    615      WRITE(lunout,*) "Depart legerement fausse. Mais je continue"
    616      field(:,:)=default
    617    ENDIF
    618    WRITE(lunout,*) name, descr, MINval(field),MAXval(field)
    619    phyetat0_get=found
    620 
    621 RETURN
    622 END FUNCTION phyetat0_get
    623 
    624 !================================================================
    625 FUNCTION phyetat0_srf(nlev,field,name,descr,default)
    626 !===================================================================
    627 ! Lecture d'un champ par sous-surface avec contrôle
    628 ! Function logique dont le resultat indique si la lecture
    629 ! s'est bien passée
    630 ! On donne une valeur par defaut dans le cas contraire
    631 !===================================================================
    632 
    633 USE iostart, ONLY : get_field
    634 USE dimphy, only: klon
    635 USE indice_sol_mod, only: nbsrf
    636 USE print_control_mod, ONLY: lunout
    637 
    638 IMPLICIT NONE
    639 
    640 LOGICAL phyetat0_srf
    641 ! arguments
    642 INTEGER,INTENT(IN) :: nlev
    643 CHARACTER*(*),INTENT(IN) :: name,descr
    644 REAL,INTENT(IN) :: default
    645 REAL,DIMENSION(klon,nlev,nbsrf),INTENT(INOUT) :: field
    646 
    647 ! Local variables
    648 LOGICAL found,phyetat0_get
    649 INTEGER nsrf
    650 CHARACTER*2 str2
    651  
    652      IF (nbsrf.GT.99) THEN
    653         WRITE(lunout,*) "Trop de sous-mailles"
    654         call abort_physic("phyetat0", "", 1)
    655      ENDIF
    656 
    657      DO nsrf = 1, nbsrf
    658         WRITE(str2, '(i2.2)') nsrf
    659         found= phyetat0_get(nlev,field(:,:, nsrf), &
    660         name//str2,descr//" srf:"//str2,default)
    661      ENDDO
    662 
    663      phyetat0_srf=found
    664 
    665 RETURN
    666 END FUNCTION phyetat0_srf
    667 
     599!==============================================================================
     600LOGICAL FUNCTION phyetat0_get10(field, name, descr, default) RESULT(lFound)
     601! Read a field. Check whether reading succeded and use default value if not.
     602  IMPLICIT NONE
     603  REAL,             INTENT(INOUT) :: field(:) ! klon
     604  CHARACTER(LEN=*), INTENT(IN)    :: name
     605  CHARACTER(LEN=*), INTENT(IN)    :: descr
     606  REAL,             INTENT(IN)    :: default
     607!------------------------------------------------------------------------------
     608  REAL :: fld(SIZE(field),1)
     609  lFound = phyetat0_get21(fld, [name], descr, default); field = fld(:,1)
     610END FUNCTION phyetat0_get10
     611!==============================================================================
     612LOGICAL FUNCTION phyetat0_get20(field, name, descr, default) RESULT(lFound)
     613! Same as phyetat0_get11, field on multiple levels.
     614  IMPLICIT NONE
     615  REAL,             INTENT(INOUT) :: field(:,:) ! klon, nlev
     616  CHARACTER(LEN=*), INTENT(IN)    :: name
     617  CHARACTER(LEN=*), INTENT(IN)    :: descr
     618  REAL,             INTENT(IN)    :: default
     619!-----------------------------------------------------------------------------
     620  lFound = phyetat0_get21(field, [name], descr, default)
     621END FUNCTION phyetat0_get20
     622!==============================================================================
     623LOGICAL FUNCTION phyetat0_get11(field, name, descr, default) RESULT(lFound)
     624! Same as phyetat0_get11, multiple names.
     625  IMPLICIT NONE
     626  REAL,             INTENT(INOUT) :: field(:) ! klon
     627  CHARACTER(LEN=*), INTENT(IN)    :: name(:)
     628  CHARACTER(LEN=*), INTENT(IN)    :: descr
     629  REAL,             INTENT(IN)    :: default
     630!-----------------------------------------------------------------------------
     631  REAL :: fld(SIZE(field),1)
     632  lFound = phyetat0_get21(fld, name, descr, default); field = fld(:,1)
     633END FUNCTION phyetat0_get11
     634!==============================================================================
     635LOGICAL FUNCTION phyetat0_get21(field, name, descr, default, tname) RESULT(lFound)
     636! Same as phyetat0_get11, field on multiple levels, multiple names.
     637  USE iostart,           ONLY: get_field
     638  USE print_control_mod, ONLY: lunout
     639  IMPLICIT NONE
     640  REAL,             INTENT(INOUT) :: field(:,:) ! klon, nlev
     641  CHARACTER(LEN=*), INTENT(IN)    :: name(:)
     642  CHARACTER(LEN=*), INTENT(IN)    :: descr
     643  REAL,             INTENT(IN)    :: default
     644  CHARACTER(LEN=*), OPTIONAL, INTENT(OUT) :: tname
     645!-----------------------------------------------------------------------------
     646  CHARACTER(LEN=LEN(name)) :: tnam
     647  INTEGER :: i
     648  DO i = 1, SIZE(name)
     649    CALL get_field(TRIM(name(i)), field, lFound)
     650    IF(lFound) EXIT
     651    WRITE(lunout,*) "phyetat0: Missing field <",TRIM(name(i)),"> "
     652  END DO
     653  IF(.NOT.lFound) THEN
     654    WRITE(lunout,*) "Slightly distorted start ; continuing."
     655    field(:,:) = default
     656    tnam = name(1)
     657  ELSE
     658    tnam = name(i)
     659  END IF
     660  WRITE(lunout,'(2(a,ES14.7))') 'phyetat0: '//TRIM(tnam)//' ('//TRIM(descr)//') min/max=', &
     661    MINval(field),' ',MAXval(field)
     662  IF(PRESENT(tname)) tname = tnam
     663END FUNCTION phyetat0_get21
     664!==============================================================================
     665LOGICAL FUNCTION phyetat0_srf20(field, name, descr, default) RESULT(lFound)
     666! Read a field per sub-surface.
     667! Check whether reading succeded and use default value if not.
     668  IMPLICIT NONE
     669  REAL,             INTENT(INOUT) :: field(:,:)
     670  CHARACTER(LEN=*), INTENT(IN)    :: name
     671  CHARACTER(LEN=*), INTENT(IN)    :: descr
     672  REAL,             INTENT(IN)    :: default
     673!-----------------------------------------------------------------------------
     674  REAL :: fld(SIZE(field,1),1,SIZE(field,2))
     675  lFound = phyetat0_srf31(fld, [name], descr, default); field = fld(:,1,:)
     676END FUNCTION phyetat0_srf20
     677
     678!==============================================================================
     679LOGICAL FUNCTION phyetat0_srf30(field, name, descr, default) RESULT(lFound)
     680! Same as phyetat0_sfr11, multiple names tested one after the other.
     681  IMPLICIT NONE
     682  REAL,             INTENT(INOUT) :: field(:,:,:)
     683  CHARACTER(LEN=*), INTENT(IN)    :: name
     684  CHARACTER(LEN=*), INTENT(IN)    :: descr
     685  REAL,             INTENT(IN)    :: default
     686!-----------------------------------------------------------------------------
     687  lFound = phyetat0_srf31(field, [name], descr, default)
     688END FUNCTION phyetat0_srf30
     689
     690!==============================================================================
     691LOGICAL FUNCTION phyetat0_srf21(field, name, descr, default) RESULT(lFound)
     692! Same as phyetat0_sfr11, field on multiple levels.
     693  IMPLICIT NONE
     694  REAL,             INTENT(INOUT) :: field(:,:)
     695  CHARACTER(LEN=*), INTENT(IN)    :: name(:)
     696  CHARACTER(LEN=*), INTENT(IN)    :: descr
     697  REAL,             INTENT(IN)    :: default
     698!-----------------------------------------------------------------------------
     699  REAL :: fld(SIZE(field,1),1,SIZE(field,2))
     700  lFound = phyetat0_srf31(fld, name, descr, default); field = fld(:,1,:)
     701END FUNCTION phyetat0_srf21
     702
     703!==============================================================================
     704LOGICAL FUNCTION phyetat0_srf31(field, name, descr, default) RESULT(lFound)
     705! Same as phyetat0_sfr11, field on multiple levels, multiple names tested one after the other.
     706  USE iostart,           ONLY: get_field
     707  USE print_control_mod, ONLY: lunout
     708  USE strings_mod,       ONLY: int2str, maxlen
     709  IMPLICIT NONE
     710  REAL,             INTENT(INOUT) :: field(:,:,:)
     711  CHARACTER(LEN=*), INTENT(IN)    :: name(:)
     712  CHARACTER(LEN=*), INTENT(IN)    :: descr
     713  REAL,             INTENT(IN)    :: default
     714!-----------------------------------------------------------------------------
     715  INTEGER :: nsrf, i
     716  CHARACTER(LEN=maxlen), ALLOCATABLE :: nam(:)
     717  CHARACTER(LEN=maxlen) :: tname, des
     718  IF(SIZE(field,3)>99) CALL abort_physic("phyetat0", "Too much sub-cells", 1)
     719  DO nsrf = 1, SIZE(field,3)
     720    nam = [(TRIM(name(i))//TRIM(int2str(nsrf,2)), i=1, SIZE(name))]
     721    des = TRIM(descr)//" srf:"//int2str(nsrf,2)
     722    lFound = phyetat0_get21(field(:,:,nsrf), nam, TRIM(des), default, tname)
     723  END DO
     724  WRITE(lunout,'(2(a,ES14.7))') 'phyetat0: '//TRIM(tname)//' ('//TRIM(descr)//') min/max=', &
     725    MINval(field),' ',MAXval(field)
     726END FUNCTION phyetat0_srf31
     727
     728END MODULE phyetat0_mod
     729

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

    r4352 r4358  
    5454    USE pbl_surface_mod, ONLY : pbl_surface
    5555    USE phyaqua_mod, only: zenang_an
     56    USE phyetat0_mod, only: phyetat0
    5657    USE phystokenc_mod, ONLY: offline, phystokenc
    5758    USE phys_cal_mod, only: year_len, mth_len, days_elapsed, jh_1jan, &
    … …  
    802803    !C      EXTERNAL o3cm      ! initialiser l'ozone
    803804    EXTERNAL orbite    ! calculer l'orbite terrestre
    804     EXTERNAL phyetat0  ! lire l'etat initial de la physique
    805805    EXTERNAL phyredem  ! ecrire l'etat de redemarrage de la physique
    806806    EXTERNAL suphel    ! initialiser certaines constantes

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

    r2784 r4358  
    1212                     ! config_inca='chem' => INCA with chemistry
    1313                     ! config_inca='aero' => INCA with aerosols
     14                     ! config_inca='aeNP' => INCA with aerosols NP (?)
    1415CONTAINS
    1516
    … …  
    1718    ! This subroutine initialize some control varaibles.
    1819
    19     USE infotrac_phy, ONLY: nbtr
    20     USE ioipsl_getin_p_mod, ONLY: getin_p
     20    USE infotrac_phy, ONLY: nbtr, types_trac
    2121    IMPLICIT NONE
    2222   
    … …  
    2525    LOGICAL,INTENT(OUT) :: lessivage
    2626   
    27    
    2827    ! Initialization
    2928    lessivage  =.FALSE.
    3029    aerosol(:) = .FALSE.
     30
     31    !--- COHERENCE TEST BETWEEN "type_trac" AND "config_inca"
     32    IF((ANY(types_trac == 'inca') .OR. ANY(types_trac == 'inco')) .AND. ALL(config_inca /= ['aero', 'aeNP', 'chem']))&
     33       CALL abort_gcm('tracinca_init', 'INCA enabled, but unknown config_inca = "'//TRIM(config_inca)//'".'          &
     34                             //'Please modify "run.def"', 1)
     35
     36    !--- PROBLEM IF "config_inca" DIFFERS FROM "none" AND INCA HAS NOT BEEN ACTIVATED
     37    IF(ALL(types_trac /= 'inca') .AND. ALL(types_trac /= 'inco')  .AND.     config_inca /= 'none') &
     38       CALL abort_gcm('tracinca_init', 'INCA disabled, but config_inca = "'//TRIM(config_inca)//'" should be "none".'&
     39                             //'Please modify "run.def"', 1)
    3140
    3241  END SUBROUTINE tracinca_init

  • LMDZ6/trunk/libf/phylmdiso/isotopes_routines_mod.F90

    r4325 r4358  
    1650816508      end subroutine phyiso_etat0_dur
    1650916509
    16510       subroutine phyiso_etat0_fichier( &
    16511      &           snow,run_off_lic_0, &
    16512      &           xtsnow,xtrun_off_lic_0, &
    16513      &           Rland_ice)
    16514       USE dimphy, only: klon,klev
    16515       !USE mod_grid_phy_lmdz
    16516       !USE mod_phys_lmdz_para
    16517       USE iophy
    16518       USE phys_state_var_mod, ONLY: q_ancien,xt_ancien,wake_deltaq,wake_deltaxt, &
    16519 #ifdef ISOVERIF
    16520         rain_fall,snow_fall,fevap,qsol, &
    16521 #endif
    16522         xtrain_fall,xtsnow_fall,ql_ancien,xtl_ancien,qs_ancien,xts_ancien, &
    16523         fxtevap,xtsol
    16524       !USE iostart
    16525       !USE write_field_phy
    16526       USE indice_sol_mod, only: nbsrf 
    16527   USE isotopes_mod, ONLY: isoName,iso_HDO,iso_eau
    16528 #ifdef ISOVERIF
    16529   USE isotopes_verif_mod
     16510SUBROUTINE phyiso_etat0_fichier(snow, run_off_lic_0, xtsnow, xtrun_off_lic_0, Rland_ice)
     16511   USE dimphy,             ONLY: klon,klev
     16512   USE iophy
     16513   USE phys_state_var_mod, ONLY: q_ancien, xt_ancien, wake_deltaq, wake_deltaxt, &
     16514#ifdef ISOVERIF
     16515     rain_fall, snow_fall, fevap,qsol, &
     16516#endif
     16517     xtrain_fall, xtsnow_fall, ql_ancien, xtl_ancien, qs_ancien, xts_ancien, fxtevap, xtsol
     16518   USE indice_sol_mod,    ONLY: nbsrf 
     16519   USE isotopes_mod,      ONLY: isoName,iso_HDO,iso_eau
     16520   USE phyetat0_mod,      ONLY: phyetat0_get, phyetat0_srf
     16521   USE readTracFiles_mod, ONLY: new2oldH2O
     16522   USE strings_mod,       ONLY: strIdx, strHead, strTail, maxlen, msg, int2str
     16523#ifdef ISOVERIF
     16524   USE isotopes_verif_mod
    1653016525#endif
    1653116526#ifdef ISOTRAC
    16532  USE isotrac_mod, ONLY: strtrac,initialisation_isotrac,index_iso, &
    16533 &       index_zone,izone_init
    16534  USE readTracFiles_mod, ONLY: newH2Oiso, oldH2Oiso
    16535  USE strings_mod, ONLY: strIdx, strHead, strTail
    16536 
    16537 #endif
    16538         implicit none
     16527   USE isotrac_mod, ONLY: strtrac, initialisation_isotrac, index_iso, index_zone, izone_init
     16528#endif
     16529   IMPLICIT NONE
    1653916530
    1654016531#include "netcdf.inc"
    1654116532#include "dimsoil.h"
    1654216533#include "clesphys.h"
    16543 ! #include "thermcell.h"
    1654416534#include "compbl.h"   
    1654516535
    16546         ! inputs
    16547         !REAL qsol(klon)
    16548         REAL snow(klon,nbsrf)
    16549         !REAL evap(klon,nbsrf)
    16550         REAL run_off_lic_0(klon)
    16551         ! outputs   
    16552         !REAL xtsol(niso,klon)
    16553         REAL xtsnow(niso,klon,nbsrf)
    16554         !REAL xtevap(ntraciso,klon,nbsrf)     
    16555         REAL xtrun_off_lic_0(niso,klon)
    16556         REAL Rland_ice(niso,klon)
    16557 
    16558         ! locals
    16559         real iso_tmp(klon)
    16560         real iso_tmp_lonlev(klon,klev)
    16561         real iso_tmp_lonsrf(klon,nbsrf)
    16562         INTEGER ierr
    16563         integer i,ixt,k,nsrf
    16564         INTEGER nid, nvarid
    16565         CHARACTER*2 str2
    16566         CHARACTER*5 str5
    16567         real xmin,xmax   
    16568         CHARACTER*50 outiso, oldIso
    16569         integer lnblnk
    16570         LOGICAL :: found,phyetat0_get,phyetat0_srf
    16571 
    16572 !#ifdef ISOVERIF
    16573 !      integer iso_verif_egalite_nostop
    16574 !#endif
    16575 !#ifdef ISOVERIF
    16576 !        real deltaD
    16577 !        integer iso_verif_noNaN_nostop
    16578 !#endif
     16536   REAL, INTENT(IN) ::             snow     (klon,nbsrf)
     16537   REAL, INTENT(IN) ::    run_off_lic_0     (klon)
     16538   REAL, INTENT(OUT) ::          xtsnow(niso,klon,nbsrf)
     16539   REAL, INTENT(OUT) :: xtrun_off_lic_0(niso,klon)
     16540   REAL, INTENT(OUT) ::       Rland_ice(niso,klon)
     16541
     16542   INTEGER :: ierr, i, ixt, k, nsrf, nid, nvarid, lnblnk
     16543   CHARACTER(LEN=2) :: str2
     16544   CHARACTER(LEN=5) :: str5
     16545   CHARACTER(LEN=maxlen) :: outiso, oldIso, modname, nam(2)
     16546   REAL :: xmin, xmax
     16547   LOGICAL :: found
    1657916548#ifdef ISOTRAC
    16580         integer iiso,izone
    16581 #endif
    16582 
    16583 
    16584    write(*,*) 'phyiso_etat0_fichier 3'
    16585    write(*,*) 'niso=',niso
    16586    write(*,*) 'isoName(1)='//TRIM(isoName(1))
    16587 
    16588    do ixt=1,ntraciso
     16549   INTEGER :: iiso, izone
     16550#endif
     16551
     16552   modname = 'phyiso_etat0_fichier'
     16553   CALL msg('3', modname)
     16554   CALL msg('niso = '//TRIM(int2str(niso)), modname)
     16555   CALL msg('isoName(1) = '//TRIM(isoName(1)), modname)
     16556
     16557   DO ixt = 1, ntraciso
    1658916558
    1659016559      outiso = isoName(ixt)
    16591       k = strIdx(newH2Oiso, strHead(outiso, '_'))
    16592       oldIso = outiso; IF(k /= 0) oldIso = oldH2Oiso(k)
    16593       IF(INDEX(outiso, '_') /= 0) THEN
    16594         outiso = TRIM(outiso)//TRIM(strTail(outiso, '_'))
    16595         oldIso = TRIM(oldIso)//TRIM(strTail(outiso, '_'))
     16560      oldIso = strTail(new2oldH2O(outiso), '_', lFirst=.TRUE.)
     16561      ! on lit seulement si ixt<=niso ou si on initialise les traceurs d'après fichier:
     16562#ifdef ISOTRAC
     16563      IF(ixt <= niso .OR. initialisation_isotrac == 0) THEN
     16564#endif
     16565      found = phyetat0iso_srf3(xtsnow,      "XTSNOW", "Surface snow", 0.)
     16566      if (.NOT.found) CALL abort_physic('isotopes_routines_mod', 'phyiso_etat0_fichier 16581: unfound isotopic variable',1)
     16567      found = phyetat0iso_srf3(fxtevap,     "XTEVAP", "evaporation",  0.)
     16568      found = phyetat0iso_get2(xtrain_fall, "xtrain_f", "xrain fall", 0.)
     16569      found = phyetat0iso_get2(xtrain_fall, "xtsnow_f", "xsnow fall", 0.)
     16570      found = phyetat0iso_get3(xt_ancien,   "XTANCIEN",  "QANCIEN",   0.)
     16571      found = phyetat0iso_get3(xtl_ancien,  "XTLANCIEN", "QLANCIEN",  0.)
     16572      found = phyetat0iso_get3(xts_ancien,  "XTASNCIEN", "QSANCIEN",  0.)
     16573      found = phyetat0iso_get2(xtrun_off_lic_0, "XTRUNOFFLIC0", "RUNOFFLIC0", 0.)
     16574      found = phyetat0iso_get3(wake_deltaxt,  "WAKE_DELTAXT", "Delta hum. wake/env",  0.)
     16575#ifdef ISOVERIF
     16576      IF(ixt == iso_eau .AND. iso_eau > 0) THEN
     16577         DO i=1,klon
     16578            CALL iso_verif_egalite(xtrain_fall(iso_eau,i),rain_fall(i),TRIM(modname)//' 231a')
     16579            CALL iso_verif_egalite(xtsnow_fall(iso_eau,i),snow_fall(i),TRIM(modname)//' 231b')
     16580            DO nsrf = 1, nbsrf
     16581               CALL iso_verif_egalite(fxtevap(iso_eau,i,nsrf),fevap(i,nsrf),TRIM(modname)//' 231c')
     16582               CALL iso_verif_egalite( xtsnow(iso_eau,i,nsrf), snow(i,nsrf),TRIM(modname)//' 231d')
     16583            END DO
     16584         END DO
    1659616585      END IF
    16597            
    16598       ! on lit seulement si ixt<=niso ou si on initialise les traceurs d'après
    16599       ! fichier:
     16586      IF(ixt == iso_HDO .AND. iso_HDO > 0) THEN
     16587         DO k=1,klev
     16588            DO i=1,klon
     16589               IF(q_ancien(i,k) > 2e-3) &
     16590                  CALL iso_verif_aberrant(xt_ancien(iso_hdo,i,k)/q_ancien(i,k),TRIM(modname)//' 312')
     16591            END DO
     16592         END DO
     16593      END IF
     16594      IF(iso_eau > 0 .AND. ixt == iso_eau) THEN
     16595         DO i=1,klon
     16596            IF(iso_verif_egalite_nostop(run_off_lic_0(i),xtrun_off_lic_0(iso_eau,i),TRIM(modname)//' 326') == 1) THEN
     16597               WRITE(*,*) 'i=',i
     16598               STOP
     16599            END IF
     16600         END DO
     16601      END IF
     16602#endif
     16603      ! ces variables n'ont pas de traceurs:
     16604      IF(ixt <= niso) THEN
     16605         found = phyetat0iso_get2(xtsol, "XTSOL", "Surface humidity / bucket", 0.)
     16606         found = phyetat0iso_get2(Rland_ice, "Rland_ice", "SR land ice", 0.)
     16607#ifdef ISOVERIF
     16608
     16609         DO i=1,klon
     16610            IF(iso_verif_noNaN_nostop(xtsol(ixt,i),TRIM(modname)//' 95') == 1) THEN
     16611               WRITE(*,*) 'ixt,i=',ixt,i
     16612               STOP
     16613            END IF
     16614         END DO
     16615#endif
     16616      END IF
    1660016617#ifdef ISOTRAC
    16601       if ((ixt.le.niso).or.(initialisation_isotrac.eq.0)) then
    16602 #endif
    16603 
    16604       found=phyetat0_srf(1,iso_tmp_lonsrf,"XTSNOW"//TRIM(outiso),"Surface snow",0.)
    16605       if (.NOT.found.AND.k/=0) found=phyetat0_srf(1,iso_tmp_lonsrf,"XTSNOW"//TRIM(oldIso),"Surface snow",0.)
    16606       if (.NOT.found) CALL abort_physic('isotopes_routines_mod', 'phyiso_etat0_fichier 16581: variable isotopique not found',1)
    16607       xtsnow(ixt,:,:)=iso_tmp_lonsrf(:,:)
    16608      
    16609       found=phyetat0_srf(1,iso_tmp_lonsrf,"XTEVAP"//TRIM(outiso),"evaporation",0.)
    16610       if (.NOT.found.AND.k/=0) found=phyetat0_srf(1,iso_tmp_lonsrf,"XTEVAP"//TRIM(oldIso),"evaporation",0.)
    16611       fxtevap(ixt,:,:)=iso_tmp_lonsrf(:,:)
    16612 
    16613       found=phyetat0_get(1,iso_tmp,"xtrain_f"//TRIM(outiso),"xrain fall",0.)
    16614       if (.NOT.found.AND.k/=0) found=phyetat0_get(1,iso_tmp,"xtrain_f"//TRIM(oldIso),"xrain fall",0.)
    16615       xtrain_fall(ixt,:)=iso_tmp(:)
    16616 
    16617       found=phyetat0_get(1,iso_tmp,"xtsnow_f"//TRIM(outiso),"snow fall",0.)
    16618       if (.NOT.found.AND.k/=0) found=phyetat0_get(1,iso_tmp,"xtsnow_f"//TRIM(oldIso),"snow fall",0.)
    16619       xtsnow_fall(ixt,:)=iso_tmp(:)
    16620 
    16621       found=phyetat0_get(klev,iso_tmp_lonlev,"XTANCIEN"//TRIM(outiso),"QANCIEN",0.)
    16622       if (.NOT.found.AND.k/=0) found=phyetat0_get(1,iso_tmp_lonlev,"XTANCIEN"//TRIM(oldIso),"QANCIEN",0.)
    16623       xt_ancien(ixt,:,:)=iso_tmp_lonlev(:,:)
    16624 
    16625       found=phyetat0_get(klev,iso_tmp_lonlev,"XTLANCIEN"//TRIM(outiso),"QLANCIEN",0.)
    16626       if (.NOT.found.AND.k/=0) found=phyetat0_get(1,iso_tmp_lonlev,"XTLANCIEN"//TRIM(oldIso),"QLANCIEN",0.)
    16627       xtl_ancien(ixt,:,:)=iso_tmp_lonlev(:,:)
    16628 
    16629       found=phyetat0_get(klev,iso_tmp_lonlev,"XTSANCIEN"//TRIM(outiso),"QSANCIEN",0.)
    16630       if (.NOT.found.AND.k/=0) found=phyetat0_get(1,iso_tmp_lonlev,"XTSANCIEN"//TRIM(oldIso),"QSANCIEN",0.)
    16631       xts_ancien(ixt,:,:)=iso_tmp_lonlev(:,:)
    16632 
    16633       found=phyetat0_get(1,iso_tmp,"XTRUNOFFLIC0"//TRIM(outiso),"RUNOFFLIC0",0.) 
    16634       if (.NOT.found.AND.k/=0) found=phyetat0_get(1,iso_tmp,"XTRUNOFFLIC0"//TRIM(oldIso),"RUNOFFLIC0",0.)
    16635       xtrun_off_lic_0(ixt,:)=iso_tmp(:)
    16636 
    16637       found=phyetat0_get(klev,iso_tmp_lonlev,"WAKE_DELTAXT"//TRIM(outiso),"Delta hum. wake/env",0.) 
    16638       if (.NOT.found.AND.k/=0) found=phyetat0_get(1,iso_tmp_lonlev,"WAKE_DELTAXT"//TRIM(oldIso),"Delta hum. wake/env",0.)
    16639       wake_deltaxt(ixt,:,:)=iso_tmp_lonlev(:,:)
    16640 
    16641 #ifdef ISOVERIF           
    16642       if ((ixt.eq.iso_eau).and.(iso_eau.gt.0)) then
    16643         do i=1,klon
    16644          call iso_verif_egalite(xtrain_fall(iso_eau,i),rain_fall(i), &
    16645      &           'phyisoetat0_fichier 231a')
    16646          call iso_verif_egalite(xtsnow_fall(iso_eau,i),snow_fall(i), &
    16647      &           'phyisoetat0_fichier 231b')
    16648          DO nsrf = 1, nbsrf
    16649          call iso_verif_egalite(fxtevap(iso_eau,i,nsrf),fevap(i,nsrf), &
    16650      &           'phyisoetat0_fichier 231c')
    16651          call iso_verif_egalite(xtsnow(iso_eau,i,nsrf),snow(i,nsrf), &
    16652      &           'phyisoetat0_fichier 231d')
    16653          enddo !DO nsrf = 1, nbsrf
    16654         enddo !do i=1,klon       
    16655       endif !if (iso_eau.gt.0) then 
    16656         if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO)) then
    16657               do k=1,klev
    16658                do i=1,klon
    16659                 if (q_ancien(i,k).gt.2e-3) then
    16660                 call iso_verif_aberrant(xt_ancien(iso_hdo,i,k) &
    16661      &           /q_ancien(i,k),'phyisoetat0_fichier 312')
    16662                 endif !if (q_ancien(i,k).gt.2e-3) then
    16663                enddo !do i=1,klon
    16664               enddo !do k=1,klev
    16665       endif !if ((iso_HDO.gt.0).and.(ixt.eq.iso_HDO)) then
    16666       if (iso_eau.gt.0) then   
    16667         do i=1,klon
    16668           if (iso_verif_egalite_nostop(run_off_lic_0(i), &
    16669      &           xtrun_off_lic_0(iso_eau,i), &
    16670      &          'phyiso_etat0_fichier 326').eq.1) then
    16671             write(*,*) 'i=',i
    16672             stop
    16673           endif !if (iso_verif_egalite_nostop(run_off_lic_0(i),
    16674         enddo !do i=1,klon
    16675       endif !if (iso_eau.gt.0) then
    16676 #endif
    16677 
    16678        ! ces variables n'ont pas de traceurs:
    16679        if (ixt.le.niso) then
    16680         found=phyetat0_get(1,iso_tmp,"XTSOL"//TRIM(outiso),"Surface hmidity / bucket",0.) 
    16681         if (.NOT.found.AND.k/=0) found=phyetat0_get(1,iso_tmp,"XTSOL"//TRIM(oldIso),"Surface hmidity / bucket",0.)
    16682         xtsol(ixt,:)=iso_tmp(:)
    16683 
    16684         found=phyetat0_get(1,iso_tmp,"Rland_ice"//TRIM(outiso),"R land ice",0.)
    16685         if (.NOT.found.AND.k/=0) found=phyetat0_get(1,iso_tmp,"Rland_ice"//TRIM(oldIso),"R land ice",0.)
    16686         Rland_ice(ixt,:)=iso_tmp(:)
    16687 
    16688 #ifdef ISOVERIF
    16689       do i=1,klon
    16690           if (iso_verif_noNaN_nostop(xtsol(ixt,i), &
    16691      &          'phyiso_etat0_fichier 95').eq.1) then
    16692             write(*,*) 'ixt,i=',ixt,i
    16693             stop
    16694           endif       
    16695       enddo !do i=1,klon
    16696 #endif
    16697 
    16698        endif
     16618      END IF ! IF(ixt > niso .OR. initialisation_isotrac == 0))
     16619#endif
     16620
     16621   END DO
    1669916622
    1670016623#ifdef ISOTRAC
    16701      endif !if ((ixt.le.niso).or.(initialisation_isotrac.eq.0)) then
    16702 #endif
    16703 
    16704   enddo !do ixt=1,ntraciso
    16705 
    16706 #ifdef ISOTRAC
    16707         if (initialisation_isotrac.ne.0) then
    16708         ! on n'initialise pas d'après le fichier
    16709         ! l'eau normale est mise dans la zone izone_init
    16710 
    16711         do ixt=niso+1,ntraciso
    16712 
    16713              iiso=index_iso(ixt)
    16714 
    16715              if (index_zone(ixt).eq.izone_init) then
    16716                 do i=1,klon
    16717                  do nsrf = 1, nbsrf
    16718                   fxtevap(ixt,i,nsrf)=fxtevap(iiso,i,nsrf)
    16719                  enddo !do nsrf = 1, nbsrf
    16720                  xtsnow_fall(ixt,i)=xtsnow_fall(iiso,i)
    16721                  xtrain_fall(ixt,i)=xtrain_fall(iiso,i)
    16722                  do k=1,klev
    16723                    xt_ancien(ixt,i,k)=xt_ancien(iiso,i,k)
    16724                    xtl_ancien(ixt,i,k)=xtl_ancien(iiso,i,k)
    16725                    xts_ancien(ixt,i,k)=xts_ancien(iiso,i,k)
    16726                    wake_deltaxt(ixt,i,k)= wake_deltaxt(iiso,i,k)   
    16727                  enddo
    16728                 enddo !do i=1,klon
    16729              else !if (index_zone(ixt).eq.izone_init) then
    16730                 do i=1,klon
    16731                  do nsrf = 1, nbsrf
    16732                   fxtevap(ixt,i,nsrf)=0.0
    16733                  enddo !do nsrf = 1, nbsrf
    16734                  xtsnow_fall(ixt,i)=0.0
    16735                  xtrain_fall(ixt,i)=0.0
    16736                  do k=1,klev
    16737                    xt_ancien(ixt,i,k)=0.0
    16738                    xtl_ancien(ixt,i,k)=0.0
    16739                    xts_ancien(ixt,i,k)=0.0
    16740                  enddo
    16741                 enddo !do i=1,klon
    16742              endif !if (index_zone(ixt).eq.izone_init) then
    16743 
    16744          enddo  !do ixt=1,niso
    16745       endif !if (initialisation_isotrac.eq.0) then
    16746 
    16747 
    16748 #ifdef ISOVERIF
    16749         DO nsrf = 1, nbsrf
    16750          do i=1,klon
    16751                call iso_verif_traceur(fxtevap(1,i,nsrf), &
    16752      &                   'phyiso_etat0_fichier 426')
    16753          enddo !do i=1,klon
    16754         enddo !DO nsrf = 1, nbsrf
    16755         do i=1,klon
    16756            call iso_verif_traceur(xtrain_fall(1,i), &
    16757      &                   'phyiso_etat0_fichier 466')
    16758            call iso_verif_traceur(xtsnow_fall(1,i), &
    16759      &                   'phyiso_etat0_fichier 468')
    16760         enddo !do i=1,klon
    16761         do k=1,klev
    16762           do i=1,klon
    16763                call iso_verif_traceur(xt_ancien(1,i,k), &
    16764      &                   'phyiso_etat0_fichier 591')
    16765           enddo !do i=1,klon
    16766         enddo !do k=1,klev             
     16624   IF(initialisation_isotrac /= 0) THEN
     16625      ! On n'initialise pas d'apres le fichier. L'eau normale est mise dans la zone izone_init
     16626      DO ixt=niso+1,ntraciso
     16627         iiso=index_iso(ixt)
     16628         IF(index_zone(ixt) == izone_init) THEN
     16629            DO i = 1, klon
     16630               fxtevap(ixt,i,1:nsrf) = fxtevap(iiso,i,1:nsrf)
     16631               xtsnow_fall(ixt,i) = xtsnow_fall(iiso,i)
     16632               xtrain_fall(ixt,i) = xtrain_fall(iiso,i)
     16633               DO k = 1, klev
     16634                  xt_ancien   (ixt,i,k) = xt_ancien   (iiso,i,k)
     16635                  xtl_ancien  (ixt,i,k) = xtl_ancien  (iiso,i,k)
     16636                  xts_ancien  (ixt,i,k) = xts_ancien  (iiso,i,k)
     16637                  wake_deltaxt(ixt,i,k) = wake_deltaxt(iiso,i,k)   
     16638               END DO
     16639            END DO
     16640         ELSE
     16641            DO i = 1, klon
     16642               fxtevap(ixt,i,1:nbsrf)=0.0
     16643               xtsnow_fall(ixt,i)=0.0
     16644               xtrain_fall(ixt,i)=0.0
     16645               xt_ancien (ixt,i,1:klev) = 0.0
     16646               xtl_ancien(ixt,i,1:klev) = 0.0
     16647               xts_ancien(ixt,i,1:klev) = 0.0
     16648            END DO
     16649         END IF
     16650      END DO
     16651   END IF
     16652
     16653#ifdef ISOVERIF
     16654   DO nsrf = 1, nbsrf
     16655      DO i = 1, klon
     16656         CALL iso_verif_traceur(fxtevap(1,i,nsrf), 'phyiso_etat0_fichier 426')
     16657      END DO
     16658   END DO
     16659   DO i=1,klon
     16660      CALL iso_verif_traceur(xtrain_fall(1,i), 'phyiso_etat0_fichier 466')
     16661      CALL iso_verif_traceur(xtsnow_fall(1,i), 'phyiso_etat0_fichier 468')
     16662   END DO
     16663   DO k = 1, klev
     16664      DO i = 1, klon
     16665         CALL iso_verif_traceur(xt_ancien(1,i,k), 'phyiso_etat0_fichier 591')
     16666      END DO
     16667   END DO
    1676716668#endif
    1676816669        ! endif ISOVERIF       
    … …  
    1677016671        ! endif ISOTRAC     
    1677116672
    16772 ! on ferme le fichier
    16773 !      CALL close_startphy
    16774 ! déjà fermé dans phyetat0
     16673CONTAINS
     16674
     16675LOGICAL FUNCTION phyetat0iso_get2(field, pref, descr, default) RESULT(lFound)
     16676  REAL,             INTENT(INOUT) :: field(:,:)
     16677  CHARACTER(LEN=*), INTENT(IN)    :: pref, descr
     16678  REAL,             INTENT(IN)    :: default
     16679  REAL :: iso_tmp(klon)
     16680  nam(1) = TRIM(pref)//TRIM(outiso)
     16681  nam(2) = TRIM(pref)//TRIM(oldIso)
     16682  lFound = phyetat0_get(iso_tmp, nam, descr, default)
     16683  field(ixt,:) = iso_tmp
     16684END FUNCTION phyetat0iso_get2
     16685
     16686
     16687LOGICAL FUNCTION phyetat0iso_get3(field, pref, descr, default) RESULT(lFound)
     16688  REAL,             INTENT(INOUT) :: field(:,:,:)
     16689  CHARACTER(LEN=*), INTENT(IN)    :: pref, descr
     16690  REAL,             INTENT(IN)    :: default
     16691  REAL :: iso_tmp_lonlev(klon,klev)
     16692  nam(1) = TRIM(pref)//TRIM(outiso)
     16693  nam(2) = TRIM(pref)//TRIM(oldIso)
     16694  lFound = phyetat0_get(iso_tmp_lonlev, nam, descr, default)
     16695  field(ixt,:,:) = iso_tmp_lonlev(:,:)
     16696END FUNCTION phyetat0iso_get3
     16697
     16698LOGICAL FUNCTION phyetat0iso_srf3(field, pref, descr, default) RESULT(lFound)
     16699  REAL,             INTENT(INOUT) :: field(:,:,:)
     16700  CHARACTER(LEN=*), INTENT(IN)    :: pref, descr
     16701  REAL,             INTENT(IN)    :: default
     16702  REAL :: iso_tmp_lonsrf(klon,nbsrf)
     16703  nam(1) = TRIM(pref)//TRIM(outiso)
     16704  nam(2) = TRIM(pref)//TRIM(oldIso)
     16705  lFound = phyetat0_srf(iso_tmp_lonsrf, nam, descr, default)
     16706  field(ixt,:,:) = iso_tmp_lonsrf
     16707END FUNCTION phyetat0iso_srf3
    1677516708
    1677616709        end subroutine phyiso_etat0_fichier
     16710
     16711
    1677716712
    1677816713

  • LMDZ6/trunk/libf/phylmdiso/phyetat0_mod.F90

    r4357 r4358  
    11! $Id: phyetat0.F90 3890 2021-05-05 15:15:06Z jyg $
     2
     3MODULE phyetat0_mod
     4
     5  PRIVATE
     6  PUBLIC :: phyetat0, phyetat0_get, phyetat0_srf
     7
     8  INTERFACE phyetat0_get
     9    MODULE PROCEDURE phyetat0_get10, phyetat0_get20, phyetat0_get11, phyetat0_get21
     10  END INTERFACE phyetat0_get
     11  INTERFACE phyetat0_srf
     12    MODULE PROCEDURE phyetat0_srf20, phyetat0_srf30, phyetat0_srf21, phyetat0_srf31
     13  END INTERFACE phyetat0_srf
     14
     15CONTAINS
    216
    317SUBROUTINE phyetat0 (fichnom, clesphy0, tabcntr0)
    … …  
    1731       du_gwd_rando, du_gwd_front, entr_therm, f0, fm_therm, &
    1832       falb_dir, falb_dif, prw_ancien, prlw_ancien, prsw_ancien, &
    19        ftsol, pbl_tke, pctsrf, q_ancien, ql_ancien, qs_ancien, radpas, radsol, rain_fall, ratqs, &
     33       ftsol, pbl_tke, pctsrf, q_ancien, ql_ancien, qs_ancien, rneb_ancien, radpas, radsol, rain_fall, ratqs, &
    2034       rnebcon, rugoro, sig1, snow_fall, solaire_etat0, sollw, sollwdown, &
    2135       solsw, solswfdiff, t_ancien, u_ancien, v_ancien, w01, wake_cstar, wake_deltaq, &
    … …  
    3145  USE geometry_mod,     ONLY: longitude_deg, latitude_deg
    3246  USE iostart,          ONLY: close_startphy, get_field, get_var, open_startphy
    33   USE infotrac_phy,     ONLY: nqtot, nbtr, types_trac, tracers
     47  USE infotrac_phy,     ONLY: nqtot, nbtr, type_trac, types_trac, tracers
     48  USE readTracFiles_mod,ONLY: maxlen, new2oldH2O
    3449  USE traclmdz_mod,     ONLY: traclmdz_from_restart
    3550  USE carbon_cycle_mod, ONLY: carbon_cycle_init, carbon_cycle_cpl, carbon_cycle_tr, carbon_cycle_rad, co2_send, RCO2_glo
    … …  
    95110  CHARACTER*7 str7
    96111  CHARACTER*2 str2
    97   LOGICAL :: found,phyetat0_get,phyetat0_srf
     112  LOGICAL :: found
    98113  REAL :: lon_startphy(klon), lat_startphy(klon)
     114  CHARACTER(LEN=maxlen) :: tname, t(2)
    99115
    100116#ifdef ISO
    … …  
    281297!===================================================================
    282298
    283   found=phyetat0_get(1,ftsol(:,1),"TS","Surface temperature",283.)
     299  found=phyetat0_get(ftsol(:,1),"TS","Surface temperature",283.)
    284300  IF (found) THEN
    285301     DO nsrf=2,nbsrf
    … …  
    287303     ENDDO
    288304  ELSE
    289      found=phyetat0_srf(1,ftsol,"TS","Surface temperature",283.)
     305     found=phyetat0_srf(ftsol,"TS","Surface temperature",283.)
    290306  ENDIF
    291307
    … …  
    301317        ENDIF
    302318        WRITE(str2, '(i2.2)') isw
    303         found=phyetat0_srf(1,falb_dir(:, isw,:),"A_dir_SW"//str2//"srf","Direct Albedo",0.2)
    304         found=phyetat0_srf(1,falb_dif(:, isw,:),"A_dif_SW"//str2//"srf","Direct Albedo",0.2)
     319        found=phyetat0_srf(falb_dir(:, isw,:),"A_dir_SW"//str2//"srf","Direct Albedo",0.2)
     320        found=phyetat0_srf(falb_dif(:, isw,:),"A_dif_SW"//str2//"srf","Direct Albedo",0.2)
    305321     ENDDO
    306322  ENDDO
    307323
    308   found=phyetat0_srf(1,u10m,"U10M","u a 10m",0.)
    309   found=phyetat0_srf(1,v10m,"V10M","v a 10m",0.)
     324  found=phyetat0_srf(u10m,"U10M","u a 10m",0.)
     325  found=phyetat0_srf(v10m,"V10M","v a 10m",0.)
    310326
    311327!===================================================================
    … …  
    319335        ENDIF
    320336        WRITE(str2,'(i2.2)') isoil
    321         found=phyetat0_srf(1,tsoil(:, isoil,:),"Tsoil"//str2//"srf","Temp soil",0.)
     337        found=phyetat0_srf(tsoil(:, isoil,:),"Tsoil"//str2//"srf","Temp soil",0.)
    322338        IF (.NOT. found) THEN
    323339           PRINT*, "phyetat0: Le champ <Tsoil"//str7//"> est absent"
    … …  
    331347!=======================================================================
    332348
    333   found=phyetat0_srf(1,qsurf,"QS","Near surface hmidity",0.)
    334   found=phyetat0_get(1,qsol,"QSOL","Surface hmidity / bucket",0.)
    335   found=phyetat0_srf(1,snow,"SNOW","Surface snow",0.)
    336   found=phyetat0_srf(1,fevap,"EVAP","evaporation",0.)
    337   found=phyetat0_get(1,snow_fall,"snow_f","snow fall",0.)
    338   found=phyetat0_get(1,rain_fall,"rain_f","rain fall",0.)
     349  found=phyetat0_srf(qsurf,"QS","Near surface hmidity",0.)
     350  found=phyetat0_get(qsol,"QSOL","Surface hmidity / bucket",0.)
     351  found=phyetat0_srf(snow,"SNOW","Surface snow",0.)
     352  found=phyetat0_srf(fevap,"EVAP","evaporation",0.)
     353  found=phyetat0_get(snow_fall,"snow_f","snow fall",0.)
     354  found=phyetat0_get(rain_fall,"rain_f","rain fall",0.)
    339355
    340356!=======================================================================
    … …  
    342358!=======================================================================
    343359
    344   found=phyetat0_get(1,solsw,"solsw","net SW radiation surf",0.)
    345   found=phyetat0_get(1,solswfdiff,"solswfdiff","fraction of SW radiation surf that is diffuse",1.)
    346   found=phyetat0_get(1,sollw,"sollw","net LW radiation surf",0.)
    347   found=phyetat0_get(1,sollwdown,"sollwdown","down LW radiation surf",0.)
     360  found=phyetat0_get(solsw,"solsw","net SW radiation surf",0.)
     361  found=phyetat0_get(solswfdiff,"solswfdiff","fraction of SW radiation surf that is diffuse",1.)
     362  found=phyetat0_get(sollw,"sollw","net LW radiation surf",0.)
     363  found=phyetat0_get(sollwdown,"sollwdown","down LW radiation surf",0.)
    348364  IF (.NOT. found) THEN
    349365     sollwdown(:) = 0. ;  zts(:)=0.
    … …  
    354370  ENDIF
    355371
    356   found=phyetat0_get(1,radsol,"RADS","Solar radiation",0.)
    357   found=phyetat0_get(1,fder,"fder","Flux derivative",0.)
     372  found=phyetat0_get(radsol,"RADS","Solar radiation",0.)
     373  found=phyetat0_get(fder,"fder","Flux derivative",0.)
    358374
    359375
    360376  ! Lecture de la longueur de rugosite
    361   found=phyetat0_srf(1,z0m,"RUG","Z0m ancien",0.001)
     377  found=phyetat0_srf(z0m,"RUG","Z0m ancien",0.001)
    362378  IF (found) THEN
    363379     z0h(:,1:nbsrf)=z0m(:,1:nbsrf)
    364380  ELSE
    365      found=phyetat0_srf(1,z0m,"Z0m","Roughness length, momentum ",0.001)
    366      found=phyetat0_srf(1,z0h,"Z0h","Roughness length, enthalpy ",0.001)
     381     found=phyetat0_srf(z0m,"Z0m","Roughness length, momentum ",0.001)
     382     found=phyetat0_srf(z0h,"Z0h","Roughness length, enthalpy ",0.001)
    367383  ENDIF
    368384!FC
    … …  
    371387    treedrg(:,1:klev,1:nbsrf)= 0.0
    372388    CALL get_field("treedrg_ter", drg_ter(:,:), found)
    373 !  found=phyetat0_srf(1,treedrg,"treedrg","drag from vegetation" , 0.)
     389!  found=phyetat0_srf(treedrg,"treedrg","drag from vegetation" , 0.)
    374390    !lecture du profile de freinage des arbres
    375391    IF (.not. found ) THEN
    … …  
    377393    ELSE
    378394      treedrg(:,1:klev,is_ter)= drg_ter(:,:)
    379 !     found=phyetat0_srf(klev,treedrg,"treedrg","freinage arbres",0.)
     395!     found=phyetat0_get(treedrg,"treedrg","freinage arbres",0.)
    380396    ENDIF
    381397  ELSE
    … …  
    385401
    386402  ! Lecture de l'age de la neige:
    387   found=phyetat0_srf(1,agesno,"AGESNO","SNOW AGE",0.001)
     403  found=phyetat0_srf(agesno,"AGESNO","SNOW AGE",0.001)
    388404
    389405  ancien_ok=.true.
    390   ancien_ok=ancien_ok.AND.phyetat0_get(klev,t_ancien,"TANCIEN","TANCIEN",0.)
    391   ancien_ok=ancien_ok.AND.phyetat0_get(klev,q_ancien,"QANCIEN","QANCIEN",0.)
    392   ancien_ok=ancien_ok.AND.phyetat0_get(klev,ql_ancien,"QLANCIEN","QLANCIEN",0.)
    393   ancien_ok=ancien_ok.AND.phyetat0_get(klev,qs_ancien,"QSANCIEN","QSANCIEN",0.)
    394   ancien_ok=ancien_ok.AND.phyetat0_get(klev,u_ancien,"UANCIEN","UANCIEN",0.)
    395   ancien_ok=ancien_ok.AND.phyetat0_get(klev,v_ancien,"VANCIEN","VANCIEN",0.)
    396   ancien_ok=ancien_ok.AND.phyetat0_get(1,prw_ancien,"PRWANCIEN","PRWANCIEN",0.)
    397   ancien_ok=ancien_ok.AND.phyetat0_get(1,prlw_ancien,"PRLWANCIEN","PRLWANCIEN",0.)
    398   ancien_ok=ancien_ok.AND.phyetat0_get(1,prsw_ancien,"PRSWANCIEN","PRSWANCIEN",0.)
     406  ancien_ok=ancien_ok.AND.phyetat0_get(t_ancien,"TANCIEN","TANCIEN",0.)
     407  ancien_ok=ancien_ok.AND.phyetat0_get(q_ancien,"QANCIEN","QANCIEN",0.)
     408  ancien_ok=ancien_ok.AND.phyetat0_get(ql_ancien,"QLANCIEN","QLANCIEN",0.)
     409  ancien_ok=ancien_ok.AND.phyetat0_get(qs_ancien,"QSANCIEN","QSANCIEN",0.)
     410  ancien_ok=ancien_ok.AND.phyetat0_get(rneb_ancien,"RNEBANCIEN","RNEBANCIEN",0.)
     411  ancien_ok=ancien_ok.AND.phyetat0_get(u_ancien,"UANCIEN","UANCIEN",0.)
     412  ancien_ok=ancien_ok.AND.phyetat0_get(v_ancien,"VANCIEN","VANCIEN",0.)
     413  ancien_ok=ancien_ok.AND.phyetat0_get(prw_ancien,"PRWANCIEN","PRWANCIEN",0.)
     414  ancien_ok=ancien_ok.AND.phyetat0_get(prlw_ancien,"PRLWANCIEN","PRLWANCIEN",0.)
     415  ancien_ok=ancien_ok.AND.phyetat0_get(prsw_ancien,"PRSWANCIEN","PRSWANCIEN",0.)
    399416
    400417  ! Ehouarn: addtional tests to check if t_ancien, q_ancien contain
    … …  
    404421       (maxval(ql_ancien).EQ.minval(ql_ancien))     .OR. &
    405422       (maxval(qs_ancien).EQ.minval(qs_ancien))     .OR. &
     423       (maxval(rneb_ancien).EQ.minval(rneb_ancien)) .OR. &
    406424       (maxval(prw_ancien).EQ.minval(prw_ancien))   .OR. &
    407425       (maxval(prlw_ancien).EQ.minval(prlw_ancien)) .OR. &
    … …  
    411429  ENDIF
    412430
    413   found=phyetat0_get(klev,clwcon,"CLWCON","CLWCON",0.)
    414   found=phyetat0_get(klev,rnebcon,"RNEBCON","RNEBCON",0.)
    415   found=phyetat0_get(klev,ratqs,"RATQS","RATQS",0.)
    416 
    417   found=phyetat0_get(1,run_off_lic_0,"RUNOFFLIC0","RUNOFFLIC0",0.)
     431  found=phyetat0_get(clwcon,"CLWCON","CLWCON",0.)
     432  found=phyetat0_get(rnebcon,"RNEBCON","RNEBCON",0.)
     433  found=phyetat0_get(ratqs,"RATQS","RATQS",0.)
     434
     435  found=phyetat0_get(run_off_lic_0,"RUNOFFLIC0","RUNOFFLIC0",0.)
    418436
    419437!==================================
    … …  
    422440!
    423441  IF (iflag_pbl>1) then
    424      found=phyetat0_srf(klev+1,pbl_tke,"TKE","Turb. Kinetic. Energ. ",1.e-8)
     442     found=phyetat0_srf(pbl_tke,"TKE","Turb. Kinetic. Energ. ",1.e-8)
    425443  ENDIF
    426444
    427445  IF (iflag_pbl>1 .AND. iflag_wake>=1  .AND. iflag_pbl_split >=1 ) then
    428     found=phyetat0_srf(klev+1,wake_delta_pbl_tke,"DELTATKE","Del TKE wk/env",0.)
    429 !!    found=phyetat0_srf(1,delta_tsurf,"DELTA_TSURF","Delta Ts wk/env ",0.)
    430     found=phyetat0_srf(1,delta_tsurf,"DELTATS","Delta Ts wk/env ",0.)
    431 !!    found=phyetat0_srf(1,beta_aridity,"BETA_S","Aridity factor ",1.)
    432     found=phyetat0_srf(1,beta_aridity,"BETAS","Aridity factor ",1.)
     446    found=phyetat0_srf(wake_delta_pbl_tke,"DELTATKE","Del TKE wk/env",0.)
     447!!    found=phyetat0_srf(delta_tsurf,"DELTA_TSURF","Delta Ts wk/env ",0.)
     448    found=phyetat0_srf(delta_tsurf,"DELTATS","Delta Ts wk/env ",0.)
     449!!    found=phyetat0_srf(beta_aridity,"BETA_S","Aridity factor ",1.)
     450    found=phyetat0_srf(beta_aridity,"BETAS","Aridity factor ",1.)
    433451  ENDIF   !(iflag_pbl>1 .AND. iflag_wake>=1 .AND. iflag_pbl_split >=1 )
    434452
    … …  
    438456
    439457! Emanuel
    440   found=phyetat0_get(klev,sig1,"sig1","sig1",0.)
    441   found=phyetat0_get(klev,w01,"w01","w01",0.)
     458  found=phyetat0_get(sig1,"sig1","sig1",0.)
     459  found=phyetat0_get(w01,"w01","w01",0.)
    442460
    443461! Wake
    444   found=phyetat0_get(klev,wake_deltat,"WAKE_DELTAT","Delta T wake/env",0.)
    445   found=phyetat0_get(klev,wake_deltaq,"WAKE_DELTAQ","Delta hum. wake/env",0.)
    446   found=phyetat0_get(1,wake_s,"WAKE_S","Wake frac. area",0.)
     462  found=phyetat0_get(wake_deltat,"WAKE_DELTAT","Delta T wake/env",0.)
     463  found=phyetat0_get(wake_deltaq,"WAKE_DELTAQ","Delta hum. wake/env",0.)
     464  found=phyetat0_get(wake_s,"WAKE_S","Wake frac. area",0.)
    447465!jyg<
    448466!  Set wake_dens to -1000. when there is no restart so that the actual
    449467!  initialization is made in calwake.
    450468!!  found=phyetat0_get(1,wake_dens,"WAKE_DENS","Wake num. /unit area",0.)
    451   found=phyetat0_get(1,wake_dens,"WAKE_DENS","Wake num. /unit area",-1000.)
    452   found=phyetat0_get(1,awake_dens,"AWAKE_DENS","Active Wake num. /unit area",0.)
    453   found=phyetat0_get(1,cv_gen,"CV_GEN","CB birth rate",0.)
     469  found=phyetat0_get(wake_dens,"WAKE_DENS","Wake num. /unit area",-1000.)
     470  found=phyetat0_get(awake_dens,"AWAKE_DENS","Active Wake num. /unit area",0.)
     471  found=phyetat0_get(cv_gen,"CV_GEN","CB birth rate",0.)
    454472!>jyg
    455   found=phyetat0_get(1,wake_cstar,"WAKE_CSTAR","WAKE_CSTAR",0.)
    456   found=phyetat0_get(1,wake_pe,"WAKE_PE","WAKE_PE",0.)
    457   found=phyetat0_get(1,wake_fip,"WAKE_FIP","WAKE_FIP",0.)
     473  found=phyetat0_get(wake_cstar,"WAKE_CSTAR","WAKE_CSTAR",0.)
     474  found=phyetat0_get(wake_pe,"WAKE_PE","WAKE_PE",0.)
     475  found=phyetat0_get(wake_fip,"WAKE_FIP","WAKE_FIP",0.)
    458476
    459477! Thermiques
    460   found=phyetat0_get(1,zmax0,"ZMAX0","ZMAX0",40.)
    461   found=phyetat0_get(1,f0,"F0","F0",1.e-5)
    462   found=phyetat0_get(klev+1,fm_therm,"FM_THERM","Thermals mass flux",0.)
    463   found=phyetat0_get(klev,entr_therm,"ENTR_THERM","Thermals Entrain.",0.)
    464   found=phyetat0_get(klev,detr_therm,"DETR_THERM","Thermals Detrain.",0.)
     478  found=phyetat0_get(zmax0,"ZMAX0","ZMAX0",40.)
     479  found=phyetat0_get(f0,"F0","F0",1.e-5)
     480  found=phyetat0_get(fm_therm,"FM_THERM","Thermals mass flux",0.)
     481  found=phyetat0_get(entr_therm,"ENTR_THERM","Thermals Entrain.",0.)
     482  found=phyetat0_get(detr_therm,"DETR_THERM","Thermals Detrain.",0.)
    465483
    466484! ALE/ALP
    467   found=phyetat0_get(1,ale_bl,"ALE_BL","ALE BL",0.)
    468   found=phyetat0_get(1,ale_bl_trig,"ALE_BL_TRIG","ALE BL_TRIG",0.)
    469   found=phyetat0_get(1,alp_bl,"ALP_BL","ALP BL",0.)
    470   found=phyetat0_get(1,ale_wake,"ALE_WAKE","ALE_WAKE",0.)
    471   found=phyetat0_get(1,ale_bl_stat,"ALE_BL_STAT","ALE_BL_STAT",0.)
     485  found=phyetat0_get(ale_bl,"ALE_BL","ALE BL",0.)
     486  found=phyetat0_get(ale_bl_trig,"ALE_BL_TRIG","ALE BL_TRIG",0.)
     487  found=phyetat0_get(alp_bl,"ALP_BL","ALP BL",0.)
     488  found=phyetat0_get(ale_wake,"ALE_WAKE","ALE_WAKE",0.)
     489  found=phyetat0_get(ale_bl_stat,"ALE_BL_STAT","ALE_BL_STAT",0.)
    472490
    473491! fisrtilp/Clouds 0.002 could be ratqsbas. But can stay like this as well
    474   found=phyetat0_get(klev,ratqs_inter,"RATQS_INTER","Relative width of the lsc sugrid scale water",0.002)
     492  found=phyetat0_get(ratqs_inter,"RATQS_INTER","Relative width of the lsc sugrid scale water",0.002)
    475493
    476494!===========================================
    … …  
    483501        ALLOCATE(co2_send(klon), stat=ierr)
    484502        IF (ierr /= 0) CALL abort_physic('phyetat0', 'pb allocation co2_send', 1)
    485         found=phyetat0_get(1,co2_send,"co2_send","co2 send",co2_ppm0)
     503        found=phyetat0_get(co2_send,"co2_send","co2 send",co2_ppm0)
    486504     ENDIF
    487   ELSE IF (ANY(types_trac == 'lmdz')) THEN
     505  ELSE IF (type_trac == 'lmdz') THEN
    488506     it = 0
    489507     DO iq = 1, nqtot
    490508        IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE
    491509        it = it+1
    492         found=phyetat0_get(1,trs(:,it),"trs_"//TRIM(tracers(iq)%name), &
    493                                   "Surf trac"//TRIM(tracers(iq)%name),0.)
     510        tname = tracers(iq)%name
     511        t(1) = 'trs_'//TRIM(tname); t(2) = 'trs_'//TRIM(new2oldH2O(tname))
     512        found = phyetat0_get(trs(:,it), t(:), "Surf trac"//TRIM(tname), 0.)
    494513     END DO
    495514     CALL traclmdz_from_restart(trs)
    … …  
    523542!  ondes de gravite non orographiques
    524543  IF (ok_gwd_rando) found = &
    525        phyetat0_get(klev,du_gwd_rando,"du_gwd_rando","du_gwd_rando",0.)
     544       phyetat0_get(du_gwd_rando,"du_gwd_rando","du_gwd_rando",0.)
    526545  IF (.NOT. ok_hines .AND. ok_gwd_rando) found &
    527        = phyetat0_get(klev,du_gwd_front,"du_gwd_front","du_gwd_front",0.)
     546       = phyetat0_get(du_gwd_front,"du_gwd_front","du_gwd_front",0.)
    528547
    529548!  prise en compte du relief sous-maille
    530   found=phyetat0_get(1,zmea,"ZMEA","sub grid orography",0.)
    531   found=phyetat0_get(1,zstd,"ZSTD","sub grid orography",0.)
    532   found=phyetat0_get(1,zsig,"ZSIG","sub grid orography",0.)
    533   found=phyetat0_get(1,zgam,"ZGAM","sub grid orography",0.)
    534   found=phyetat0_get(1,zthe,"ZTHE","sub grid orography",0.)
    535   found=phyetat0_get(1,zpic,"ZPIC","sub grid orography",0.)
    536   found=phyetat0_get(1,zval,"ZVAL","sub grid orography",0.)
    537   found=phyetat0_get(1,zmea,"ZMEA","sub grid orography",0.)
    538   found=phyetat0_get(1,rugoro,"RUGSREL","sub grid orography",0.)
     549  found=phyetat0_get(zmea,"ZMEA","sub grid orography",0.)
     550  found=phyetat0_get(zstd,"ZSTD","sub grid orography",0.)
     551  found=phyetat0_get(zsig,"ZSIG","sub grid orography",0.)
     552  found=phyetat0_get(zgam,"ZGAM","sub grid orography",0.)
     553  found=phyetat0_get(zthe,"ZTHE","sub grid orography",0.)
     554  found=phyetat0_get(zpic,"ZPIC","sub grid orography",0.)
     555  found=phyetat0_get(zval,"ZVAL","sub grid orography",0.)
     556  found=phyetat0_get(zmea,"ZMEA","sub grid orography",0.)
     557  found=phyetat0_get(rugoro,"RUGSREL","sub grid orography",0.)
    539558
    540559!===========================================
    … …  
    545564      CALL ocean_slab_init(phys_tstep, pctsrf)
    546565      IF (nslay.EQ.1) THEN
    547         found=phyetat0_get(1,tslab,"tslab01","tslab",0.)
    548         IF (.NOT. found) THEN
    549             found=phyetat0_get(1,tslab,"tslab","tslab",0.)
    550         ENDIF
     566        found=phyetat0_get(tslab,["tslab01","tslab  "],"tslab",0.)
    551567      ELSE
    552568          DO i=1,nslay
    553569            WRITE(str2,'(i2.2)') i
    554             found=phyetat0_get(1,tslab(:,i),"tslab"//str2,"tslab",0.) 
     570            found=phyetat0_get(tslab(:,i),"tslab"//str2,"tslab",0.) 
    555571          ENDDO
    556572      ENDIF
    … …  
    565581      ! Sea ice variables
    566582      IF (version_ocean == 'sicINT') THEN
    567           found=phyetat0_get(1,tice,"slab_tice","slab_tice",0.)
     583          found=phyetat0_get(tice,"slab_tice","slab_tice",0.)
    568584          IF (.NOT. found) THEN
    569585              PRINT*, "phyetat0: Le champ <tice> est absent"
    … …  
    571587                  tice(:)=ftsol(:,is_sic)
    572588          ENDIF
    573           found=phyetat0_get(1,seaice,"seaice","seaice",0.)
     589          found=phyetat0_get(seaice,"seaice","seaice",0.)
    574590          IF (.NOT. found) THEN
    575591              PRINT*, "phyetat0: Le champ <seaice> est absent"
    … …  
    585601  if (activate_ocean_skin >= 1) then
    586602     if (activate_ocean_skin == 2 .and. type_ocean == 'couple') then
    587         found = phyetat0_get(1, delta_sal, "delta_sal", &
     603        found = phyetat0_get(delta_sal, "delta_sal", &
    588604             "ocean-air interface salinity minus bulk salinity", 0.)
    589         found = phyetat0_get(1, delta_sst, "delta_SST", &
     605        found = phyetat0_get(delta_sst, "delta_SST", &
    590606             "ocean-air interface temperature minus bulk SST", 0.)
    591607     end if
    592608     
    593      found = phyetat0_get(1, ds_ns, "dS_ns", "delta salinity near surface", 0.)
    594      found = phyetat0_get(1, dt_ns, "dT_ns", "delta temperature near surface", &
     609     found = phyetat0_get(ds_ns, "dS_ns", "delta salinity near surface", 0.)
     610     found = phyetat0_get(dt_ns, "dT_ns", "delta temperature near surface", &
    595611          0.)
    596612
    … …  
    633649END SUBROUTINE phyetat0
    634650
    635 !===================================================================
    636 FUNCTION phyetat0_get(nlev,field,name,descr,default)
    637 !===================================================================
    638 ! Lecture d'un champ avec contrôle
    639 ! Function logique dont le resultat indique si la lecture
    640 ! s'est bien passée
    641 ! On donne une valeur par defaut dans le cas contraire
    642 !===================================================================
    643 
    644 USE iostart, ONLY : get_field
    645 USE dimphy, only: klon
    646 USE print_control_mod, ONLY: lunout
    647 
    648 IMPLICIT NONE
    649 
    650 LOGICAL phyetat0_get
    651 
    652 ! arguments
    653 INTEGER,INTENT(IN) :: nlev
    654 CHARACTER*(*),INTENT(IN) :: name,descr
    655 REAL,INTENT(IN) :: default
    656 REAL,DIMENSION(klon,nlev),INTENT(INOUT) :: field
    657 
    658 ! Local variables
    659 LOGICAL found
    660 
    661    CALL get_field(name, field, found)
    662    IF (.NOT. found) THEN
    663      WRITE(lunout,*) "phyetat0: Le champ <",TRIM(name),"> est absent"
    664      WRITE(lunout,*) "Depart legerement fausse. Mais je continue"
    665      field(:,:)=default
    666    ENDIF
    667    WRITE(lunout,*) name, descr, MINval(field),MAXval(field)
    668    phyetat0_get=found
    669 
    670 RETURN
    671 END FUNCTION phyetat0_get
    672 
    673 !================================================================
    674 FUNCTION phyetat0_srf(nlev,field,name,descr,default)
    675 !===================================================================
    676 ! Lecture d'un champ par sous-surface avec contrôle
    677 ! Function logique dont le resultat indique si la lecture
    678 ! s'est bien passée
    679 ! On donne une valeur par defaut dans le cas contraire
    680 !===================================================================
    681 
    682 USE iostart, ONLY : get_field
    683 USE dimphy, only: klon
    684 USE indice_sol_mod, only: nbsrf
    685 USE print_control_mod, ONLY: lunout
    686 
    687 IMPLICIT NONE
    688 
    689 LOGICAL phyetat0_srf
    690 ! arguments
    691 INTEGER,INTENT(IN) :: nlev
    692 CHARACTER*(*),INTENT(IN) :: name,descr
    693 REAL,INTENT(IN) :: default
    694 REAL,DIMENSION(klon,nlev,nbsrf),INTENT(INOUT) :: field
    695 
    696 ! Local variables
    697 LOGICAL found,phyetat0_get
    698 INTEGER nsrf
    699 CHARACTER*2 str2
    700  
    701      IF (nbsrf.GT.99) THEN
    702         WRITE(lunout,*) "Trop de sous-mailles"
    703         call abort_physic("phyetat0", "", 1)
    704      ENDIF
    705 
    706      DO nsrf = 1, nbsrf
    707         WRITE(str2, '(i2.2)') nsrf
    708         found= phyetat0_get(nlev,field(:,:, nsrf), &
    709         name//str2,descr//" srf:"//str2,default)
    710      ENDDO
    711 
    712      phyetat0_srf=found
    713 
    714 RETURN
    715 END FUNCTION phyetat0_srf
    716 
     651!==============================================================================
     652LOGICAL FUNCTION phyetat0_get10(field, name, descr, default) RESULT(lFound)
     653! Read a field. Check whether reading succeded and use default value if not.
     654  IMPLICIT NONE
     655  REAL,             INTENT(INOUT) :: field(:) ! klon
     656  CHARACTER(LEN=*), INTENT(IN)    :: name
     657  CHARACTER(LEN=*), INTENT(IN)    :: descr
     658  REAL,             INTENT(IN)    :: default
     659!------------------------------------------------------------------------------
     660  REAL :: fld(SIZE(field),1)
     661  lFound = phyetat0_get21(fld, [name], descr, default); field = fld(:,1)
     662END FUNCTION phyetat0_get10
     663!==============================================================================
     664LOGICAL FUNCTION phyetat0_get20(field, name, descr, default) RESULT(lFound)
     665! Same as phyetat0_get11, field on multiple levels.
     666  IMPLICIT NONE
     667  REAL,             INTENT(INOUT) :: field(:,:) ! klon, nlev
     668  CHARACTER(LEN=*), INTENT(IN)    :: name
     669  CHARACTER(LEN=*), INTENT(IN)    :: descr
     670  REAL,             INTENT(IN)    :: default
     671!-----------------------------------------------------------------------------
     672  lFound = phyetat0_get21(field, [name], descr, default)
     673END FUNCTION phyetat0_get20
     674!==============================================================================
     675LOGICAL FUNCTION phyetat0_get11(field, name, descr, default) RESULT(lFound)
     676! Same as phyetat0_get11, multiple names.
     677  IMPLICIT NONE
     678  REAL,             INTENT(INOUT) :: field(:) ! klon
     679  CHARACTER(LEN=*), INTENT(IN)    :: name(:)
     680  CHARACTER(LEN=*), INTENT(IN)    :: descr
     681  REAL,             INTENT(IN)    :: default
     682!-----------------------------------------------------------------------------
     683  REAL :: fld(SIZE(field),1)
     684  lFound = phyetat0_get21(fld, name, descr, default); field = fld(:,1)
     685END FUNCTION phyetat0_get11
     686!==============================================================================
     687LOGICAL FUNCTION phyetat0_get21(field, name, descr, default, tname) RESULT(lFound)
     688! Same as phyetat0_get11, field on multiple levels, multiple names.
     689  USE iostart,           ONLY: get_field
     690  USE print_control_mod, ONLY: lunout
     691  IMPLICIT NONE
     692  REAL,             INTENT(INOUT) :: field(:,:) ! klon, nlev
     693  CHARACTER(LEN=*), INTENT(IN)    :: name(:)
     694  CHARACTER(LEN=*), INTENT(IN)    :: descr
     695  REAL,             INTENT(IN)    :: default
     696  CHARACTER(LEN=*), OPTIONAL, INTENT(OUT) :: tname
     697!-----------------------------------------------------------------------------
     698  CHARACTER(LEN=LEN(name)) :: tnam
     699  INTEGER :: i
     700  DO i = 1, SIZE(name)
     701    CALL get_field(TRIM(name(i)), field, lFound)
     702    IF(lFound) EXIT
     703    WRITE(lunout,*) "phyetat0: Missing field <",TRIM(name(i)),"> "
     704  END DO
     705  IF(.NOT.lFound) THEN
     706    WRITE(lunout,*) "Slightly distorted start ; continuing."
     707    field(:,:) = default
     708    tnam = name(1)
     709  ELSE
     710    tnam = name(i)
     711  END IF
     712  WRITE(lunout,'(2(a,ES14.7))') 'phyetat0: '//TRIM(tnam)//' ('//TRIM(descr)//') min/max=', &
     713    MINval(field),' ',MAXval(field)
     714  IF(PRESENT(tname)) tname = tnam
     715END FUNCTION phyetat0_get21
     716!==============================================================================
     717LOGICAL FUNCTION phyetat0_srf20(field, name, descr, default) RESULT(lFound)
     718! Read a field per sub-surface.
     719! Check whether reading succeded and use default value if not.
     720  IMPLICIT NONE
     721  REAL,             INTENT(INOUT) :: field(:,:)
     722  CHARACTER(LEN=*), INTENT(IN)    :: name
     723  CHARACTER(LEN=*), INTENT(IN)    :: descr
     724  REAL,             INTENT(IN)    :: default
     725!-----------------------------------------------------------------------------
     726  REAL :: fld(SIZE(field,1),1,SIZE(field,2))
     727  lFound = phyetat0_srf31(fld, [name], descr, default); field = fld(:,1,:)
     728END FUNCTION phyetat0_srf20
     729
     730!==============================================================================
     731LOGICAL FUNCTION phyetat0_srf30(field, name, descr, default) RESULT(lFound)
     732! Same as phyetat0_sfr11, multiple names tested one after the other.
     733  IMPLICIT NONE
     734  REAL,             INTENT(INOUT) :: field(:,:,:)
     735  CHARACTER(LEN=*), INTENT(IN)    :: name
     736  CHARACTER(LEN=*), INTENT(IN)    :: descr
     737  REAL,             INTENT(IN)    :: default
     738!-----------------------------------------------------------------------------
     739  lFound = phyetat0_srf31(field, [name], descr, default)
     740END FUNCTION phyetat0_srf30
     741
     742!==============================================================================
     743LOGICAL FUNCTION phyetat0_srf21(field, name, descr, default) RESULT(lFound)
     744! Same as phyetat0_sfr11, field on multiple levels.
     745  IMPLICIT NONE
     746  REAL,             INTENT(INOUT) :: field(:,:)
     747  CHARACTER(LEN=*), INTENT(IN)    :: name(:)
     748  CHARACTER(LEN=*), INTENT(IN)    :: descr
     749  REAL,             INTENT(IN)    :: default
     750!-----------------------------------------------------------------------------
     751  REAL :: fld(SIZE(field,1),1,SIZE(field,2))
     752  lFound = phyetat0_srf31(fld, name, descr, default); field = fld(:,1,:)
     753END FUNCTION phyetat0_srf21
     754
     755!==============================================================================
     756LOGICAL FUNCTION phyetat0_srf31(field, name, descr, default) RESULT(lFound)
     757! Same as phyetat0_sfr11, field on multiple levels, multiple names tested one after the other.
     758  USE iostart,           ONLY: get_field
     759  USE print_control_mod, ONLY: lunout
     760  USE strings_mod,       ONLY: int2str, maxlen
     761  IMPLICIT NONE
     762  REAL,             INTENT(INOUT) :: field(:,:,:)
     763  CHARACTER(LEN=*), INTENT(IN)    :: name(:)
     764  CHARACTER(LEN=*), INTENT(IN)    :: descr
     765  REAL,             INTENT(IN)    :: default
     766!-----------------------------------------------------------------------------
     767  INTEGER :: nsrf, i
     768  CHARACTER(LEN=maxlen), ALLOCATABLE :: nam(:)
     769  CHARACTER(LEN=maxlen) :: tname, des
     770  IF(SIZE(field,3)>99) CALL abort_physic("phyetat0", "Too much sub-cells", 1)
     771  DO nsrf = 1, SIZE(field,3)
     772    nam = [(TRIM(name(i))//TRIM(int2str(nsrf,2)), i=1, SIZE(name))]
     773    des = TRIM(descr)//" srf:"//int2str(nsrf,2)
     774    lFound = phyetat0_get21(field(:,:,nsrf), nam, TRIM(des), default, tname)
     775  END DO
     776  WRITE(lunout,'(2(a,ES14.7))') 'phyetat0: '//TRIM(tname)//' ('//TRIM(descr)//') min/max=', &
     777    MINval(field),' ',MAXval(field)
     778END FUNCTION phyetat0_srf31
     779
     780END MODULE phyetat0_mod
     781

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

    r4298 r4358  
    5353    USE pbl_surface_mod, ONLY : pbl_surface
    5454    USE phyaqua_mod, only: zenang_an
     55    USE phyetat0_mod, only: phyetat0
    5556    USE phystokenc_mod, ONLY: offline, phystokenc
    5657    USE phys_cal_mod, only: year_len, mth_len, days_elapsed, jh_1jan, &
    … …  
    869870    !C      EXTERNAL o3cm      ! initialiser l'ozone
    870871    EXTERNAL orbite    ! calculer l'orbite terrestre
    871     EXTERNAL phyetat0  ! lire l'etat initial de la physique
    872872    EXTERNAL phyredem  ! ecrire l'etat de redemarrage de la physique
    873873    EXTERNAL suphel    ! initialiser certaines constantes
Note: See TracChangeset for help on using the changeset viewer.