Ignore:
Timestamp:
Nov 30, 2022, 4:37:30 PM (3 years 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/phylmdiso
Files:
2 edited
1 moved

Legend:

Unmodified
Added
Removed

  • 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.