Changeset 2336 for trunk/LMDZ.GENERIC


Ignore:
Timestamp:
Jun 5, 2020, 9:44:36 AM (5 years ago)
Author:
emillour
Message:

Generic GCM:
Update start2archive/newstart programs to handle recently introduced
non-orographic GW variables in (re-)start files.
EM

Location:
trunk/LMDZ.GENERIC
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • trunk/LMDZ.GENERIC/README

    r2309 r2336  
    15761576== 05/05/2020 (r2308) == JVO
    15771577Fix a nasty copy-paste bug from r2297 in n-layer aerosol scheme
     1578
     1579== 05/06/2020 == EM
     1580Update start2archive/newstart programs to handle recently introduced
     1581non-orographic GW variables in (re-)start files.
  • trunk/LMDZ.GENERIC/libf/dynphy_lonlat/phystd/lect_start_archive.F

    r1478 r2336  
    33     &     t,ucov,vcov,ps,h,phisold_newgrid,
    44     &     q,qsurf,surfith,nid,
    5      &     rnat,pctsrf_sic,tslab,tsea_ice,sea_ice)
    6 
    7 !      USE surfdat_h
     5     &     rnat,pctsrf_sic,tslab,tsea_ice,sea_ice,
     6     &     du_nonoro_gwd,dv_nonoro_gwd,east_gwstress,west_gwstress)
     7
    88      USE comsoil_h, ONLY: nsoilmx, layer, mlayer, volcapa, inertiedat
    99      USE tracer_h, ONLY: igcm_co2_ice
    1010      USE infotrac, ONLY: tname, nqtot
    1111      USE slab_ice_h, ONLY: noceanmx
    12 !      USE control_mod
    13 ! to use  'getin'
    1412      USE callkeys_mod, ONLY: ok_slab_ocean
    1513      USE comvert_mod, ONLY: ap,bp,aps,bps,preff
     
    1816c=======================================================================
    1917c
    20 c
    21 c   Auteur:    05/1997 , 12/2003 : coord hybride  FF
    22 c   ------
    23 c
    24 c
    25 c   Objet:     Lecture des variables d'un fichier "start_archive"
    26 c              Plus besoin de régler ancienne valeurs grace
    27 c              a l'allocation dynamique de memoire (Yann Wanherdrick)
    28 c
    29 c
     18c    Routine to load variables from the "start_archive.nc" file
    3019c
    3120c=======================================================================
     
    3322      implicit none
    3423
    35 #include "dimensions.h"
    36 !#include "dimphys.h"
    37 !#include "planete.h"
    38 #include "paramet.h"
    39 #include "comgeom2.h"
    40 !#include "control.h"
    41 #include "netcdf.inc"
    42 !#include"advtrac.h"
     24      include "dimensions.h"
     25      include "paramet.h"
     26      include "comgeom2.h"
     27      include "netcdf.inc"
     28
    4329c=======================================================================
    4430c   Declarations
     
    6248      CHARACTER*2   str2
    6349
    64 !      REAL dimfirst(4) ! tableau contenant les 1ers elements des dimensions
    65 
    66 !      REAL dimlast(4) ! tableau contenant les derniers elements des dimensions
    67 
    68 !      REAL dimcycl(4) ! tableau contenant les periodes des dimensions
    69 !      CHARACTER*120 dimsource
    70 !      CHARACTER*16 dimname
    71 !      CHARACTER*80 dimtitle
    72 !      CHARACTER*40 dimunits
    73 !      INTEGER   dimtype
    74 
    75 !      INTEGER dimord(4)  ! tableau contenant l''ordre
    76 !      data dimord /1,2,3,4/ ! de sortie des dimensions
    77 
    78 !      INTEGER vardim(4)
    79       REAL date
     50      REAL,INTENT(OUT) :: date
    8051      INTEGER   memo
    8152!      character (len=50) :: tmpname
     
    8354c Variable histoire
    8455c------------------
    85       REAL vcov(iip1,jjm,llm),ucov(iip1,jjp1,llm) ! vents covariants
    86       REAL h(iip1,jjp1,llm),ps(iip1,jjp1)
    87       REAL q(iip1,jjp1,llm,nqtot),qtot(iip1,jjp1,llm)
    88 
    89 c autre variables dynamique nouvelle grille
    90 c------------------------------------------
    91 
    92 c!-*-
    93 !      integer klatdat,klongdat
    94 !      PARAMETER (klatdat=180,klongdat=360)
     56      REAL,INTENT(OUT) :: vcov(iip1,jjm,llm),ucov(iip1,jjp1,llm) ! vents covariants
     57      REAL,INTENT(OUT) :: h(iip1,jjp1,llm),ps(iip1,jjp1)
     58      REAL,INTENT(OUT) :: q(iip1,jjp1,llm,nqtot)
    9559
    9660c Physique sur grille scalaire
     
    9963c variable physique
    10064c------------------
    101       REAL tsurf(ngrid) ! surface temperature
    102       REAL tsoil(ngrid,nsoilmx) ! soil temperature
     65      REAL,INTENT(OUT) :: tsurf(ngrid) ! surface temperature
     66      REAL,INTENT(OUT) :: tsoil(ngrid,nsoilmx) ! soil temperature
    10367      REAL co2ice(ngrid) ! CO2 ice layer
    104       REAL emis(ngrid)
    105       REAL q2(ngrid,llm+1),qsurf(ngrid,nqtot)
    106       REAL tslab(ngrid,noceanmx)
    107       REAL rnat(ngrid),pctsrf_sic(ngrid)
    108       REAL tsea_ice(ngrid),sea_ice(ngrid)
     68      REAL,INTENT(OUT) :: emis(ngrid)
     69      REAL,INTENT(OUT) :: q2(ngrid,llm+1),qsurf(ngrid,nqtot)
     70      REAL,INTENT(OUT) :: tslab(ngrid,noceanmx)
     71      REAL ,INTENT(OUT) ::rnat(ngrid),pctsrf_sic(ngrid)
     72      REAL,INTENT(OUT) :: tsea_ice(ngrid),sea_ice(ngrid)
    10973c     REAL phisfi(ngrid)
     74      REAL,INTENT(OUT):: du_nonoro_gwd(ngrid,llm)
     75      REAL,INTENT(OUT):: dv_nonoro_gwd(ngrid,llm)
     76      REAL,INTENT(OUT):: east_gwstress(ngrid,llm)
     77      REAL,INTENT(OUT):: west_gwstress(ngrid,llm)
    11078
    11179      INTEGER i,j,l
    112       INTEGER nid,nvarid
     80      INTEGER,INTENT(IN) :: nid
     81      INTEGER :: nvarid
    11382c     REAL year_day,periheli,aphelie,peri_day
    11483c     REAL obliquit,z0,emin_turb,lmixmin
     
    12291c------------------------------------------------------
    12392      real us(iip1,jjp1,llm),vs(iip1,jjp1,llm)
    124       REAL phisold_newgrid(iip1,jjp1)
    125       REAL t(iip1,jjp1,llm)
     93      REAL,INTENT(OUT) :: phisold_newgrid(iip1,jjp1)
     94      REAL,INTENT(OUT) :: t(iip1,jjp1,llm)
    12695      real tsurfS(iip1,jjp1),tsoilS(iip1,jjp1,nsoilmx)
    12796      real inertiedatS(iip1,jjp1,nsoilmx)
     
    132101      real pctsrf_sicS(iip1,jjp1),tsea_iceS(iip1,jjp1)
    133102      real rnatS(iip1,jjp1), sea_iceS(iip1,jjp1)
     103      real du_nonoro_gwdS(iip1,jjp1,llm),dv_nonoro_gwdS(iip1,jjp1,llm)
     104      real east_gwstressS(iip1,jjp1,llm),west_gwstressS(iip1,jjp1,llm)
    134105
    135106      real ptotal, co2icetotal
     
    163134      real, dimension(:,:), allocatable :: rnatold,pctsrf_sicold
    164135      real, dimension(:,:), allocatable :: tsea_iceold,sea_iceold
    165 
     136      real,allocatable :: du_nonoro_gwdold(:,:,:)
     137      real,allocatable :: dv_nonoro_gwdold(:,:,:)
     138      real,allocatable :: east_gwstressold(:,:,:)
     139      real,allocatable :: west_gwstressold(:,:,:)
    166140
    167141      real tab_cntrl(100)
     
    181155      real, dimension(:), allocatable :: newval
    182156
    183       real surfith(iip1,jjp1) ! surface thermal inertia
     157      real,intent(out) :: surfith(iip1,jjp1) ! surface thermal inertia
    184158      ! surface thermal inertia at old horizontal grid resolution
    185159      real, dimension(:,:), allocatable :: surfithold
     
    319293      allocate(sea_iceold(imold+1,jmold+1))
    320294
     295      allocate(du_nonoro_gwdold(imold+1,jmold+1,lmold))
     296      allocate(dv_nonoro_gwdold(imold+1,jmold+1,lmold))
     297      allocate(east_gwstressold(imold+1,jmold+1,lmold))
     298      allocate(west_gwstressold(imold+1,jmold+1,lmold))
     299
    321300      allocate(var (imold+1,jmold+1,llm))
    322301      allocate(varp1 (imold+1,jmold+1,llm+1))
    323302
    324       write(*,*) 'q2',ngrid,llm+1
    325       write(*,*) 'q2S',iip1,jjp1,llm+1
    326       write(*,*) 'q2old',imold+1,jmold+1,lmold+1
     303      write(*,*) 'lect_start_archive: q2',ngrid,llm+1
     304      write(*,*) 'lect_start_archive: q2S',iip1,jjp1,llm+1
     305      write(*,*) 'lect_start_archive: q2old',imold+1,jmold+1,lmold+1
    327306
    328307!-----------------------------------------------------------------------
     
    337316      ierr = NF_INQ_VARID (nid, "controle", nvarid)
    338317      IF (ierr .NE. NF_NOERR) THEN
    339          PRINT*, "Lect_start_archive: champ <controle> est absent"
     318         PRINT*, "Lect_start_archive: champ <controle> not found"
    340319         CALL abort
    341320      ENDIF
     
    358337      ierr = NF_INQ_VARID (nid, "rlonv", nvarid)
    359338      IF (ierr .NE. NF_NOERR) THEN
    360          PRINT*, "lect_start_archive: Le champ <rlonv> est absent"
     339         PRINT*, "lect_start_archive: Field <rlonv> not found"
    361340         CALL abort
    362341      ENDIF
     
    367346#endif
    368347      IF (ierr .NE. NF_NOERR) THEN
    369          PRINT*, "lect_start_archive: Lecture echouee pour <rlonv>"
     348         PRINT*, "lect_start_archive: Failed loading <rlonv>"
    370349         CALL abort
    371350      ENDIF
     
    373352      ierr = NF_INQ_VARID (nid, "rlatu", nvarid)
    374353      IF (ierr .NE. NF_NOERR) THEN
    375          PRINT*, "lect_start_archive: Le champ <rlatu> est absent"
     354         PRINT*, "lect_start_archive: Field <rlatu> not found"
    376355         CALL abort
    377356      ENDIF
     
    382361#endif
    383362      IF (ierr .NE. NF_NOERR) THEN
    384          PRINT*, "lect_start_archive: Lecture echouee pour <rlatu>"
     363         PRINT*, "lect_start_archive: Failed loading <rlatu>"
    385364         CALL abort
    386365      ENDIF
     
    388367      ierr = NF_INQ_VARID (nid, "rlonu", nvarid)
    389368      IF (ierr .NE. NF_NOERR) THEN
    390          PRINT*, "lect_start_archive: Le champ <rlonu> est absent"
     369         PRINT*, "lect_start_archive: Field <rlonu> not found"
    391370         CALL abort
    392371      ENDIF
     
    397376#endif
    398377      IF (ierr .NE. NF_NOERR) THEN
    399          PRINT*, "lect_start_archive: Lecture echouee pour <rlonu>"
     378         PRINT*, "lect_start_archive: Failed loading <rlonu>"
    400379         CALL abort
    401380      ENDIF
     
    403382      ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
    404383      IF (ierr .NE. NF_NOERR) THEN
    405          PRINT*, "lect_start_archive: Le champ <rlatv> est absent"
     384         PRINT*, "lect_start_archive: Field <rlatv> not found"
    406385         CALL abort
    407386      ENDIF
     
    412391#endif
    413392      IF (ierr .NE. NF_NOERR) THEN
    414          PRINT*, "lect_start_archive: Lecture echouee pour <rlatv>"
     393         PRINT*, "lect_start_archive: Failed loading <rlatv>"
    415394         CALL abort
    416395      ENDIF
     
    423402      ierr = NF_INQ_VARID (nid, "aps", nvarid)
    424403      IF (ierr .NE. NF_NOERR) THEN
    425          PRINT*, "lect_start_archive: Le champ <aps> est absent"
     404         PRINT*, "lect_start_archive: Field <aps> not found"
    426405         apsold=0
    427406         PRINT*, "<aps> set to 0"
     
    433412#endif
    434413         IF (ierr .NE. NF_NOERR) THEN
    435             PRINT*, "lect_start_archive: Lecture echouee pour <aps>"
     414            PRINT*, "lect_start_archive: Failed loading <aps>"
    436415         ENDIF
    437416      ENDIF
     
    439418      ierr = NF_INQ_VARID (nid, "bps", nvarid)
    440419      IF (ierr .NE. NF_NOERR) THEN
    441          PRINT*, "lect_start_archive: Le champ <bps> est absent"
     420         PRINT*, "lect_start_archive: Field <bps> not found"
    442421         PRINT*, "It must be an old start_archive, lets look for sig_s"
    443422         ierr = NF_INQ_VARID (nid, "sig_s", nvarid)
     
    453432#endif
    454433      IF (ierr .NE. NF_NOERR) THEN
    455          PRINT*, "lect_start_archive: Lecture echouee pour <bps>"
     434         PRINT*, "lect_start_archive: Failed loading <bps>"
    456435         CALL abort
    457436      END IF
     
    542521      ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
    543522      IF (ierr .NE. NF_NOERR) THEN
    544          PRINT*, "lect_start_archive: Le champ <phisinit> est absent"
     523         PRINT*, "lect_start_archive: Field <phisinit> not found"
    545524         CALL abort
    546525      ENDIF
     
    551530#endif
    552531      IF (ierr .NE. NF_NOERR) THEN
    553          PRINT*, "lect_start_archive: Lecture echouee pour <phisinit>"
     532         PRINT*, "lect_start_archive: Failed loading <phisinit>"
    554533         CALL abort
    555534      ENDIF
     
    571550         ierr = NF_INQ_DIMID (nid, "temps", nvarid)
    572551         IF (ierr .NE. NF_NOERR) THEN
    573             PRINT*, "lect_start_archive: Le champ <Time> est absent"
     552            PRINT*, "lect_start_archive: Field <Time> not found"
    574553            CALL abort
    575554         endif
     
    586565#endif
    587566      IF (ierr .NE. NF_NOERR) THEN
    588          PRINT*, "lect_start_archive: Lecture echouee pour <Time>"
     567         PRINT*, "lect_start_archive: Failed loading <Time>"
    589568         CALL abort
    590569      ENDIF
     
    592571      write(*,*)
    593572      write(*,*)
    594       write(*,*) 'Differentes dates des etats initiaux stockes:'
    595       write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
     573      write(*,*) 'Available dates for the stored initial conditions:'
     574      write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
    596575      pi=2.*ASIN(1.)
    597576      do i=1,timelen
    598577c       call solarlong(timelist(i),sollong(i))
    599578c       sollong(i) = sollong(i)*180./pi
    600         write(*,*) 'etat initial au jour martien' ,int(timelist(i))
     579        write(*,*) 'initial state for day ' ,int(timelist(i))
    601580c       write(*,6) nint(timelist(i)),nint(mod(timelist(i),669)),
    602581c    .    sollong(i)
     
    606585 
    607586      write(*,*)
    608       write(*,*) 'Choix de la date'
     587      write(*,*) 'Choice for the date'
    609588 123  read(*,*,iostat=ierr) date
    610589      if(ierr.ne.0) goto 123
     
    619598        write(*,*)
    620599        write(*,*)
    621         write(*,*) 'He alors... Y sait pas lire !?!'
     600        write(*,*) "Wrong value... can't you read !?!"
    622601        write(*,*)
    623         write(*,*) 'Differentes dates des etats initiaux stockes:'
    624         write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
     602        write(*,*) 'Available dates for the stored initial conditions:'
     603        write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
    625604        do i=1,timelen
    626           write(*,*) 'etat initial au jour martien' ,nint(timelist(i))
     605          write(*,*) 'initial state for day ' ,nint(timelist(i))
    627606c         write(*,6) nint(timelist(i)),nint(mod(timelist(i),669))
    628607        end do
     
    642621      count=(/imold+1,jmold+1,1,0/)
    643622       
    644 ! CO2ice is now in qsurf(igcm_co2_ice) ...
    645 !      ierr = NF_INQ_VARID (nid, "co2ice", nvarid)
    646 !      IF (ierr .NE. NF_NOERR) THEN
    647 !         PRINT*, "lect_start_archive: Le champ <co2ice> est absent"
    648 !         CALL abort
    649 !      ENDIF
    650 !#ifdef NC_DOUBLE
    651 !      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,co2iceold)
    652 !#else
    653 !      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,co2iceold)
    654 !#endif
    655 !      IF (ierr .NE. NF_NOERR) THEN
    656 !         PRINT*, "lect_start_archive: Lecture echouee pour <co2ice>"
    657 !         PRINT*, NF_STRERROR(ierr)
    658 !         CALL abort
    659 !      ENDIF
    660 c
    661623      ierr = NF_INQ_VARID (nid, "emis", nvarid)
    662624      IF (ierr .NE. NF_NOERR) THEN
    663          PRINT*, "lect_start_archive: Le champ <emis> est absent"
     625         PRINT*, "lect_start_archive: Field <emis> not found"
    664626         CALL abort
    665627      ENDIF
     
    670632#endif
    671633      IF (ierr .NE. NF_NOERR) THEN
    672          PRINT*, "lect_start_archive: Lecture echouee pour <emis>"
     634         PRINT*, "lect_start_archive: Failed loading <emis>"
    673635         CALL abort
    674636      ENDIF
     
    676638      ierr = NF_INQ_VARID (nid, "ps", nvarid)
    677639      IF (ierr .NE. NF_NOERR) THEN
    678          PRINT*, "lect_start_archive: Le champ <ps> est absent"
     640         PRINT*, "lect_start_archive: Field <ps> not found"
    679641         CALL abort
    680642      ENDIF
     
    685647#endif
    686648      IF (ierr .NE. NF_NOERR) THEN
    687          PRINT*, "lect_start_archive: Lecture echouee pour <ps>"
     649         PRINT*, "lect_start_archive: Failed loading <ps>"
    688650         CALL abort
    689651      ENDIF
     
    691653      ierr = NF_INQ_VARID (nid, "tsurf", nvarid)
    692654      IF (ierr .NE. NF_NOERR) THEN
    693          PRINT*, "lect_start_archive: Le champ <tsurf> est absent"
     655         PRINT*, "lect_start_archive: Field <tsurf> not found"
    694656         CALL abort
    695657      ENDIF
     
    700662#endif
    701663      IF (ierr .NE. NF_NOERR) THEN
    702          PRINT*, "lect_start_archive: Lecture echouee pour <tsurf>"
     664         PRINT*, "lect_start_archive: Failed loading <tsurf>"
    703665         CALL abort
    704666      ENDIF
     
    706668      ierr = NF_INQ_VARID (nid, "q2surf", nvarid)
    707669      IF (ierr .NE. NF_NOERR) THEN
    708          PRINT*, "lect_start_archive: Le champ <q2surf> est absent"
     670         PRINT*, "lect_start_archive: Field <q2surf> not found"
    709671         CALL abort
    710672      ENDIF
     
    715677#endif
    716678      IF (ierr .NE. NF_NOERR) THEN
    717          PRINT*, "lect_start_archive: Lecture echouee pour <q2surf>"
     679         PRINT*, "lect_start_archive: Failed loading <q2surf>"
    718680         CALL abort
    719681      ENDIF
     
    734696#endif
    735697      IF (ierr .NE. NF_NOERR) THEN
    736          PRINT*, "lect_start_archive: Lecture echouee pour <tslab>"
     698         PRINT*, "lect_start_archive: Failed loading <tslab>"
    737699      ENDIF
    738700
     
    744706      ierr = NF_INQ_VARID (nid, "rnat", nvarid)
    745707      IF (ierr .NE. NF_NOERR) THEN
    746          PRINT*, "lect_start_archive: Le champ <rnat> est absent"
     708         PRINT*, "lect_start_archive: Field <rnat> not found"
    747709      ENDIF
    748710#ifdef NC_DOUBLE
     
    752714#endif
    753715      IF (ierr .NE. NF_NOERR) THEN
    754          PRINT*, "lect_start_archive: Lecture echouee pour <rnat>"
     716         PRINT*, "lect_start_archive: Failed loading <rnat>"
    755717      ENDIF
    756718c
    757719      ierr = NF_INQ_VARID (nid, "pctsrf_sic", nvarid)
    758720      IF (ierr .NE. NF_NOERR) THEN
    759          PRINT*, "lect_start_archive: Le champ <pctsrf_sic> est absent"
     721         PRINT*, "lect_start_archive: Field <pctsrf_sic> not found"
    760722      ENDIF
    761723#ifdef NC_DOUBLE
     
    765727#endif
    766728      IF (ierr .NE. NF_NOERR) THEN
    767          PRINT*, "lect_start_archive: Lecture echouee pour <pctsrf_sic>"
     729         PRINT*, "lect_start_archive: Failed loading <pctsrf_sic>"
    768730      ENDIF
    769731c
    770732      ierr = NF_INQ_VARID (nid, "tsea_ice", nvarid)
    771733      IF (ierr .NE. NF_NOERR) THEN
    772          PRINT*, "lect_start_archive: Le champ <tsea_ice> est absent"
     734         PRINT*, "lect_start_archive: Field <tsea_ice> not found"
    773735      ENDIF
    774736#ifdef NC_DOUBLE
     
    778740#endif
    779741      IF (ierr .NE. NF_NOERR) THEN
    780          PRINT*, "lect_start_archive: Lecture echouee pour <tsea_ice>"
     742         PRINT*, "lect_start_archive: Failed loading <tsea_ice>"
    781743      ENDIF
    782744c
    783745      ierr = NF_INQ_VARID (nid, "sea_ice", nvarid)
    784746      IF (ierr .NE. NF_NOERR) THEN
    785          PRINT*, "lect_start_archive: Le champ <sea_ice> est absent"
     747         PRINT*, "lect_start_archive: Field <sea_ice> not found"
    786748      ENDIF
    787749#ifdef NC_DOUBLE
     
    791753#endif
    792754      IF (ierr .NE. NF_NOERR) THEN
    793          PRINT*, "lect_start_archive: Lecture echouee pour <sea_ice>"
     755         PRINT*, "lect_start_archive: Failed loading <sea_ice>"
    794756      ENDIF
    795757 
     
    801763
    802764! Surface tracers:     
    803       do iq=1,nqtot
    804         ! initialize all surface tracers to zero
    805         call initial0((jmold+1)*(imold+1), qsurfold(1,1,iq))
    806       enddo
    807 
    808 
    809 !      print*,'tname=',tname
    810 !      print*,'nid',nid
    811 !      print*,'nvarid',nvarid
    812 !      stop
     765      ! initialize all surface tracers to zero
     766      qsurfold(1:imold+1,1:jmold+1,1:nqtot)=0
    813767
    814768      DO iq=1,nqtot
     
    843797     &             " Failed loading <",trim(txt),">"
    844798          write (*,*) trim(txt),'    is set to 0'
    845 !          call initial0((jmold+1)*(imold+1), qsurfold(1,1,iq))
    846799        ENDIF
    847800
     
    905858      endif ! of if (olddepthdef)
    906859
    907 !
    908 ! Read soil thermal inertias
    909 !
    910 !      if (.not.olddepthdef) then ! no thermal inertia data in "old" archives
    911 !       ierr=NF_INQ_VARID(nid,"inertiedat",nvarid)
    912 !       if (ierr.ne.NF_NOERR) then
    913 !        write(*,*)"lect_start_archive: Cannot find <inertiedat>"
    914 !       call abort
    915 !       else
    916 !#ifdef NC_DOUBLE
    917 !      ierr=NF_GET_VARA_DOUBLE(nid,nvarid,start,count,inertiedatold)
    918 !#else
    919 !      ierr=NF_GET_VARA_REAL(nid,nvarid,start,count,inertiedatold)
    920 !#endif
    921 !       endif ! of if (ierr.ne.NF_NOERR)
    922 !      endif
    923 
    924860c-----------------------------------------------------------------------
    925861c 5.3   Lecture des champs 3D (t,u,v, q2atm,q)
     
    932868      ierr = NF_INQ_VARID (nid,"temp", nvarid)
    933869      IF (ierr .NE. NF_NOERR) THEN
    934          PRINT*, "lect_start_archive: Le champ <temp> est absent"
     870         PRINT*, "lect_start_archive: Field <temp> not found"
    935871         CALL abort
    936872      ENDIF
     
    941877#endif
    942878      IF (ierr .NE. NF_NOERR) THEN
    943          PRINT*, "lect_start_archive: Lecture echouee pour <temp>"
     879         PRINT*, "lect_start_archive: Failed loading <temp>"
    944880         CALL abort
    945881      ENDIF
     
    947883      ierr = NF_INQ_VARID (nid,"u", nvarid)
    948884      IF (ierr .NE. NF_NOERR) THEN
    949          PRINT*, "lect_start_archive: Le champ <u> est absent"
     885         PRINT*, "lect_start_archive: Field <u> not found"
    950886         CALL abort
    951887      ENDIF
     
    956892#endif
    957893      IF (ierr .NE. NF_NOERR) THEN
    958          PRINT*, "lect_start_archive: Lecture echouee pour <u>"
     894         PRINT*, "lect_start_archive: Failed loading <u>"
    959895         CALL abort
    960896      ENDIF
     
    962898      ierr = NF_INQ_VARID (nid,"v", nvarid)
    963899      IF (ierr .NE. NF_NOERR) THEN
    964          PRINT*, "lect_start_archive: Le champ <v> est absent"
     900         PRINT*, "lect_start_archive: Field <v> not found"
    965901         CALL abort
    966902      ENDIF
     
    971907#endif
    972908      IF (ierr .NE. NF_NOERR) THEN
    973          PRINT*, "lect_start_archive: Lecture echouee pour <v>"
     909         PRINT*, "lect_start_archive: Failed loading <v>"
    974910         CALL abort
    975911      ENDIF
     
    977913      ierr = NF_INQ_VARID (nid,"q2atm", nvarid)
    978914      IF (ierr .NE. NF_NOERR) THEN
    979          PRINT*, "lect_start_archive: Le champ <q2atm> est absent"
     915         PRINT*, "lect_start_archive: Field <q2atm> not found"
    980916         CALL abort
    981917      ENDIF
     
    986922#endif
    987923      IF (ierr .NE. NF_NOERR) THEN
    988          PRINT*, "lect_start_archive: Lecture echouee pour <q2atm>"
     924         PRINT*, "lect_start_archive: Failed loading <q2atm>"
    989925         CALL abort
    990926      ENDIF
     
    992928
    993929! Tracers:     
    994       do iq=1,nqtot
    995          call initial0((jmold+1)*(imold+1)*lmold,qold(1,1,1,iq) )
    996       enddo
     930      qold(1:imold+1,1:jmold+1,1:lmold,1:nqtot)=0.
    997931
    998932      DO iq=1,nqtot
     
    1025959      ENDDO ! of DO iq=1,nqtot
    1026960
     961! Non-orographic GWs:
     962      write(*,*)"lect_start_archive: loading du_nonoro_gwd"
     963      ierr = NF_INQ_VARID (nid,"du_nonoro_gwd", nvarid)
     964      IF (ierr .NE. NF_NOERR) THEN
     965         PRINT*, "lect_start_archive: Field <du_nonoro_gwd> not found"
     966         PRINT*, "Setting it to zero"
     967         du_nonoro_gwdold(:,:,:)=0
     968      ENDIF
     969#ifdef NC_DOUBLE
     970      ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,du_nonoro_gwdold)
     971#else
     972      ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,du_nonoro_gwdold)
     973#endif
     974      IF (ierr .NE. NF_NOERR) THEN
     975         PRINT*, "lect_start_archive: Failed loading <du_nonoro_gwd>"
     976         CALL abort
     977      ENDIF
     978
     979      write(*,*)"lect_start_archive: loading dv_nonoro_gwd"
     980      ierr = NF_INQ_VARID (nid,"dv_nonoro_gwd", nvarid)
     981      IF (ierr .NE. NF_NOERR) THEN
     982         PRINT*, "lect_start_archive: Field <dv_nonoro_gwd> not found"
     983         PRINT*, "Setting it to zero"
     984         dv_nonoro_gwdold(:,:,:)=0
     985      ENDIF
     986#ifdef NC_DOUBLE
     987      ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,dv_nonoro_gwdold)
     988#else
     989      ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,dv_nonoro_gwdold)
     990#endif
     991      IF (ierr .NE. NF_NOERR) THEN
     992         PRINT*, "lect_start_archive: Failed loading <dv_nonoro_gwd>"
     993         CALL abort
     994      ENDIF
     995
     996      write(*,*)"lect_start_archive: loading east_gwstress"
     997      ierr = NF_INQ_VARID (nid,"east_gwstress", nvarid)
     998      IF (ierr .NE. NF_NOERR) THEN
     999         PRINT*, "lect_start_archive: Field <east_gwstress> not found"
     1000         PRINT*, "Setting it to zero"
     1001         east_gwstressold(:,:,:)=0
     1002      ENDIF
     1003#ifdef NC_DOUBLE
     1004      ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,east_gwstressold)
     1005#else
     1006      ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,east_gwstressold)
     1007#endif
     1008      IF (ierr .NE. NF_NOERR) THEN
     1009         PRINT*, "lect_start_archive: Failed loading <east_gwstress>"
     1010         CALL abort
     1011      ENDIF
     1012
     1013      write(*,*)"lect_start_archive: loading west_gwstress"
     1014      ierr = NF_INQ_VARID (nid,"west_gwstress", nvarid)
     1015      IF (ierr .NE. NF_NOERR) THEN
     1016         PRINT*, "lect_start_archive: Field <west_gwstress> not found"
     1017         PRINT*, "Setting it to zero"
     1018         west_gwstressold(:,:,:)=0
     1019      ENDIF
     1020#ifdef NC_DOUBLE
     1021      ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,count,west_gwstressold)
     1022#else
     1023      ierr = NF_GET_VARA_REAL(nid,nvarid,start,count,west_gwstressold)
     1024#endif
     1025      IF (ierr .NE. NF_NOERR) THEN
     1026         PRINT*, "lect_start_archive: Failed loading <west_gwstress>"
     1027         CALL abort
     1028      ENDIF
    10271029
    10281030!=======================================================================
     
    11061108
    11071109      write(*,*)
    1108       write(*,*)'Ancienne grille: masse de l atm :',ptotalold
    1109       write(*,*)'Nouvelle grille: masse de l atm :',ptotal
     1110      write(*,*)'Old grid: atmospheric mass :',ptotalold
     1111      write(*,*)'New grid: atmospheric mass :',ptotal
    11101112      write (*,*) 'Ratio new atm./ old atm =', ptotal/ptotalold
    11111113      write(*,*)
    1112       write(*,*)'Ancienne grille: masse de la glace CO2:',co2icetotalold
    1113       write(*,*)'Nouvelle grille: masse de la glace CO2:',co2icetotal
     1114      write(*,*)'Old grid: mass of CO2 ice:',co2icetotalold
     1115      write(*,*)'New grid: mass of CO2 ice:',co2icetotal
    11141116      if (co2icetotalold.ne.0.) then
    11151117      write(*,*)'Ratio new ice./old ice =',co2icetotal/co2icetotalold
     
    13251327     &                   rlonuold,rlatvold,rlonu,rlatv)
    13261328      write (*,*) 'lect_start_archive: t ', t(1,jjp1,1)  ! INFO
     1329
     1330! Non-orographic GW
     1331      call interp_vert
     1332     &    (du_nonoro_gwdold,var,lmold,llm,apsold,bpsold,aps,bps,
     1333     &     psold,(imold+1)*(jmold+1))
     1334      call interp_horiz(var,du_nonoro_gwdS,imold,jmold,iim,jjm,llm,
     1335     &                   rlonuold,rlatvold,rlonu,rlatv)
     1336      call gr_dyn_fi(llm,iim+1,jjm+1,ngrid,du_nonoro_gwdS,du_nonoro_gwd)
     1337     
     1338      call interp_vert
     1339     &    (dv_nonoro_gwdold,var,lmold,llm,apsold,bpsold,aps,bps,
     1340     &     psold,(imold+1)*(jmold+1))
     1341      call interp_horiz(var,dv_nonoro_gwdS,imold,jmold,iim,jjm,llm,
     1342     &                   rlonuold,rlatvold,rlonu,rlatv)
     1343      call gr_dyn_fi(llm,iim+1,jjm+1,ngrid,dv_nonoro_gwdS,dv_nonoro_gwd)
     1344     
     1345      call interp_vert
     1346     &    (east_gwstressold,var,lmold,llm,apsold,bpsold,aps,bps,
     1347     &     psold,(imold+1)*(jmold+1))
     1348      call interp_horiz(var,east_gwstressS,imold,jmold,iim,jjm,llm,
     1349     &                   rlonuold,rlatvold,rlonu,rlatv)
     1350      call gr_dyn_fi(llm,iim+1,jjm+1,ngrid,east_gwstressS,east_gwstress)
     1351     
     1352      call interp_vert
     1353     &    (west_gwstressold,var,lmold,llm,apsold,bpsold,aps,bps,
     1354     &     psold,(imold+1)*(jmold+1))
     1355      call interp_horiz(var,west_gwstressS,imold,jmold,iim,jjm,llm,
     1356     &                   rlonuold,rlatvold,rlonu,rlatv)
     1357      call gr_dyn_fi(llm,iim+1,jjm+1,ngrid,west_gwstressS,west_gwstress)
    13271358
    13281359c q2 : pbl wind variance
     
    14881519      deallocate(sea_iceold)
    14891520
    1490 !      write(*,*)'lect_start_archive: END'
    1491       return
    14921521      end
  • trunk/LMDZ.GENERIC/libf/dynphy_lonlat/phystd/newstart.F

    r1807 r2336  
    2323      USE surfdat_h, ONLY: phisfi, albedodat,
    2424     &                     zmea, zstd, zsig, zgam, zthe
     25      USE nonoro_gwd_ran_mod, ONLY: du_nonoro_gwd, dv_nonoro_gwd,
     26     &                              east_gwstress, west_gwstress
    2527      use datafile_mod, only: datadir, surfdir
    2628      use ioipsl_getin_p_mod, only: getin_p
     
    3840      USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0
    3941      use tabfi_mod, only: tabfi
     42      use dimphy, only: init_dimphy
    4043      use iniphysiq_mod, only: iniphysiq
     44      use phys_state_var_mod, only: phys_state_var_init
    4145      use phyetat0_mod, only: phyetat0
    4246      implicit none
     
    283287      call initracer(ngridmx,nqtot,tname)
    284288
    285 ! Take care of arrays in common modules
    286       ! ALLOCATE ARRAYS in surfdat_h (if not already done, e.g. when using start_archive)
    287       IF (.not. ALLOCATED(albedodat)) ALLOCATE(albedodat(ngridmx))
    288       IF (.not. ALLOCATED(phisfi)) ALLOCATE(phisfi(ngridmx))
    289       IF (.not. ALLOCATED(zmea)) ALLOCATE(zmea(ngridmx))
    290       IF (.not. ALLOCATED(zstd)) ALLOCATE(zstd(ngridmx))
    291       IF (.not. ALLOCATED(zsig)) ALLOCATE(zsig(ngridmx))
    292       IF (.not. ALLOCATED(zgam)) ALLOCATE(zgam(ngridmx))
    293       IF (.not. ALLOCATED(zthe)) ALLOCATE(zthe(ngridmx))
     289! Initialize dimphy module (klon,klev,..)
     290      call init_dimphy(ngridmx,llm)
     291! Allocate saved arrays (as in firstcall of physiq)
     292      call phys_state_var_init(nqtot)
    294293
    295294c-----------------------------------------------------------------------
     
    552551     &   t,ucov,vcov,ps,teta,phisold_newgrid,q,qsurf,
    553552     &   surfith,nid,
    554      &   rnat,pctsrf_sic,tslab,tsea_ice,sea_ice)
     553     &   rnat,pctsrf_sic,tslab,tsea_ice,sea_ice,
     554     &   du_nonoro_gwd,dv_nonoro_gwd,east_gwstress,west_gwstress)
    555555        write(*,*) "OK, read start_archive file"
    556556        ! copy soil thermal inertia
     
    11281128           CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
    11291129
    1130 c$$$           do ig=1,ngridmx
    1131 c$$$             j=(ig-2)/iim +2
    1132 c$$$              if(ig.eq.1) j=1
    1133 c$$$              if (rlatu(j)*180./pi.gt.80.) then
    1134 c$$$
    1135 c$$$                   qsurf(ig,igcm_h2o_ice)=1.e5
    1136 c$$$                   qsurf(ig,igcm_h2o_vap)=0.0!1.e5
    1137 c$$$
    1138 c$$$                   write(*,*) 'ig=',ig,'    H2O ice mass (kg/m2)= ',
    1139 c$$$     &              qsurf(ig,igcm_h2o_ice)
    1140 c$$$
    1141 c$$$                   write(*,*)'     ==> Ice mesh South boundary (deg)= ',
    1142 c$$$     &              rlatv(j)*180./pi
    1143 c$$$                end if
    1144 c$$$           enddo
    1145 
    11461130c      watercaps : H20 ice on permanent southern cap
    11471131c      -------------------------------------------------
     
    11691153           ENDDO
    11701154           CALL gr_dyn_fi(nsoilmx,iip1,jjp1,ngridmx,ith,ithfi)
    1171 
    1172 c$$$           do ig=1,ngridmx
    1173 c$$$               j=(ig-2)/iim +2
    1174 c$$$               if(ig.eq.1) j=1
    1175 c$$$               if (rlatu(j)*180./pi.lt.-80.) then
    1176 c$$$                  qsurf(ig,igcm_h2o_ice)=1.e5
    1177 c$$$                  qsurf(ig,igcm_h2o_vap)=0.0 !1.e5
    1178 c$$$
    1179 c$$$                  write(*,*) 'ig=',ig,'   H2O ice mass (kg/m2)= ',
    1180 c$$$     &                 qsurf(ig,igcm_h2o_ice)
    1181 c$$$                  write(*,*)'     ==> Ice mesh North boundary (deg)= ',
    1182 c$$$     &                 rlatv(j-1)*180./pi
    1183 c$$$               end if
    1184 c$$$           enddo
    11851155
    11861156
  • trunk/LMDZ.GENERIC/libf/dynphy_lonlat/phystd/start2archive.F

    r1694 r2336  
    2222      USE comsoil_h
    2323     
    24 !      USE comgeomfi_h, ONLY: lati, long, area
    25 !      use control_mod
    26 !      use comgeomphy, only: initcomgeomphy
    2724      use slab_ice_h, only: noceanmx
    28 ! to use  'getin'
    29       USE ioipsl_getincom
     25      USE ioipsl_getincom, only: getin
    3026      USE planete_mod, only: year_day
    3127      USE mod_const_mpi, ONLY: COMM_LMDZ
     
    3733      USE temps_mod, ONLY: day_ini
    3834      USE iniphysiq_mod, ONLY: iniphysiq
     35      use phys_state_var_mod, only: phys_state_var_init
    3936      use phyetat0_mod, only: phyetat0
     37      use nonoro_gwd_ran_mod, only: du_nonoro_gwd, dv_nonoro_gwd,
     38     &                          east_gwstress, west_gwstress
    4039      implicit none
    4140
     
    4544      include "comdissip.h"
    4645      include "comgeom.h"
    47 !#include "control.h"
    48 
    49 !#include "dimphys.h"
    50 !#include "planete.h"
    51 !#include"advtrac.h"
     46
    5247      include "netcdf.inc"
    5348c-----------------------------------------------------------------------
     
    111106      REAL tslabS(ip1jmp1,noceanmx),tsea_iceS(ip1jmp1)
    112107
     108!     For non-orographic GW
     109      REAL du_nonoro_gwdS(ip1jmp1,llm),dv_nonoro_gwdS(ip1jmp1,llm)
     110      REAL east_gwstressS(ip1jmp1,llm),west_gwstressS(ip1jmp1,llm)
    113111
    114112c Variables intermediaires : vent naturel, mais pas coord scalaire
     
    234232      Lmodif=0
    235233
     234! Allocate saved arrays (as in firstcall of physiq)
     235      call phys_state_var_init(nqtot)
     236     
    236237! Initialize tracer names, indexes and properties
    237238      CALL initracer(ngridmx,nqtot,tname)
     
    357358      call gr_fi_dyn(noceanmx,ngridmx,iip1,jjp1,tslab,tslabS)
    358359
     360      call gr_fi_dyn(llm,ngridmx,iip1,jjp1,du_nonoro_gwd,du_nonoro_gwdS)
     361      call gr_fi_dyn(llm,ngridmx,iip1,jjp1,dv_nonoro_gwd,dv_nonoro_gwdS)
     362      call gr_fi_dyn(llm,ngridmx,iip1,jjp1,east_gwstress,east_gwstressS)
     363      call gr_fi_dyn(llm,ngridmx,iip1,jjp1,west_gwstress,west_gwstressS)
    359364c=======================================================================
    360365c Info pour controler
     
    370375         ENDDO
    371376      ENDDO
    372       write(*,*)'Ancienne grille : masse de l''atm :',ptotal
     377      write(*,*)'Old grid: : atmospheric mass :',ptotal
    373378!      write(*,*)'Ancienne grille : masse de la glace CO2 :',co2icetotal
    374379
     
    519524      IF(ierr.EQ.0) THEN
    520525
    521 
    522          write(*,*) "Use slab-ocean ?"
    523          ok_slab_ocean=.false.         ! default value
    524          call getin("ok_slab_ocean",ok_slab_ocean)
    525          write(*,*) "ok_slab_ocean = ",ok_slab_ocean
    526 
    527       if(ok_slab_ocean) then
    528       call write_archive(nid,ntime,'rnat'
    529      &        ,'rnat','',2,rnatS)
    530       call write_archive(nid,ntime,'pctsrf_sic'
    531      &        ,'pctsrf_sic','',2,pctsrf_sicS)
    532       call write_archive(nid,ntime,'sea_ice'
    533      &        ,'sea_ice','',2,sea_iceS)
    534       call write_archive(nid,ntime,'tslab'
    535      &        ,'tslab','',-2,tslabS)
    536       call write_archive(nid,ntime,'tsea_ice'
    537      &        ,'tsea_ice','',2,tsea_iceS)
    538       endif !ok_slab_ocean
    539       ENDIF
     526        write(*,*) "Use slab-ocean ?"
     527        ok_slab_ocean=.false.         ! default value
     528        call getin("ok_slab_ocean",ok_slab_ocean)
     529        write(*,*) "ok_slab_ocean = ",ok_slab_ocean
     530
     531        if(ok_slab_ocean) then
     532          call write_archive(nid,ntime,'rnat'
     533     &            ,'rnat','',2,rnatS)
     534          call write_archive(nid,ntime,'pctsrf_sic'
     535     &            ,'pctsrf_sic','',2,pctsrf_sicS)
     536          call write_archive(nid,ntime,'sea_ice'
     537     &            ,'sea_ice','',2,sea_iceS)
     538          call write_archive(nid,ntime,'tslab'
     539     &            ,'tslab','',-2,tslabS)
     540          call write_archive(nid,ntime,'tsea_ice'
     541     &            ,'tsea_ice','',2,tsea_iceS)
     542        endif !ok_slab_ocean
     543     
     544      ENDIF ! of IF(ierr.EQ.0)
     545
     546! Non-orographic gavity waves
     547      call write_archive(nid,ntime,"du_nonoro_gwd",
     548     &     "Zonal wind tendency due to GW",'m.s-1',3,du_nonoro_gwdS)
     549      call write_archive(nid,ntime,"dv_nonoro_gwd",
     550     &     "Meridional wind tendency due to GW",'m.s-1',
     551     &     3,dv_nonoro_gwdS)
     552      call write_archive(nid,ntime,"east_gwstress",
     553     &     "Eastward stress profile due to GW",'kg.m-1.s-2',
     554     &     3,east_gwstressS)
     555      call write_archive(nid,ntime,"west_gwstress",
     556     &     "Westward stress profile due to GW",'kg.m-1.s-2',
     557     &     3,west_gwstressS)
     558
    540559c-----------------------------------------------------------------------
    541560c Fin
  • trunk/LMDZ.GENERIC/libf/dynphy_lonlat/phystd/write_archive.F

    r1478 r2336  
    3737      implicit none
    3838
    39 #include "dimensions.h"
    40 #include "paramet.h"
    41 #include "comgeom.h"
    42 #include "netcdf.inc"
     39      include "dimensions.h"
     40      include "paramet.h"
     41      include "comgeom.h"
     42      include "netcdf.inc"
    4343
    4444c-----------------------------------------------------------------------
     
    8383
    8484              write (*,*) "====================="
    85               write (*,*) "creation de ",nom
     85              write (*,*) "defining ",nom
    8686              call def_var(nid,nom,titre,unite,4,id,varid,ierr)
    8787
     
    113113
    114114           if (ierr.ne.NF_NOERR) then
    115               write(*,*) "***** PUT_VAR matter in write_archive"
    116               write(*,*) "***** with ",nom," ",nf_STRERROR(ierr)
     115              write(*,*) "***** PUT_VAR problem in write_archive"
     116              write(*,*) "***** with ",trim(nom)," ",nf_STRERROR(ierr)
    117117              call abort
    118118           endif
     
    140140          ! define the variable
    141141          write(*,*)"====================="
    142           write(*,*)"defining ",nom
     142          write(*,*)"defining variable ",trim(nom)
    143143          call def_var(nid,nom,titre,unite,4,id,varid,ierr)
    144144         
     
    182182          ! define the variable
    183183          write(*,*)"====================="
    184           write(*,*)"defining ",nom
     184          write(*,*)"defining variable ",trim(nom)
    185185          call def_var(nid,nom,titre,unite,4,id,varid,ierr)
    186186
     
    222222
    223223              write (*,*) "====================="
    224               write (*,*) "creation de ",nom
     224              write (*,*) "defining variable ",trim(nom)
    225225
    226226              call def_var(nid,nom,titre,unite,3,id,varid,ierr)
     
    243243
    244244           if (ierr.ne.NF_NOERR) then
    245               write(*,*) "***** PUT_VAR matter in write_archive"
     245              write(*,*) "***** PUT_VAR problem in write_archive"
    246246              write(*,*) "***** with ",nom,nf_STRERROR(ierr)
    247247              call abort
     
    264264
    265265              write (*,*) "====================="
    266               write (*,*) "creation de ",nom
     266              write (*,*) "defining variable ",trim(nom)
    267267
    268268              call def_var(nid,nom,titre,unite,1,id,varid,ierr)
     
    279279#endif
    280280           if (ierr.ne.NF_NOERR) then
    281               write(*,*) "***** PUT_VAR matter in write_archive"
     281              write(*,*) "***** PUT_VAR problem in write_archive"
    282282              write(*,*) "***** with ",nom,nf_STRERROR(ierr)
    283283              call abort
     
    289289        endif ! of if (dim.eq.3) else if (dim.eq.-3) ....
    290290
    291       return
    292291      end
    293292
Note: See TracChangeset for help on using the changeset viewer.