Ignore:
Timestamp:
Nov 30, 2022, 4:37:30 PM (22 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
File:
1 moved

Legend:

Unmodified
Added
Removed

  • 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
Note: See TracChangeset for help on using the changeset viewer.