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

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

File:
1 edited

Legend:

Unmodified
Added
Removed

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