Ignore:
Timestamp:
Jun 11, 2020, 7:40:22 PM (5 years ago)
Author:
jvatant
Message:

Titan GCM : Major maintenance catching up commits from the generic including :

  • r2356 and 2354 removing obsolete old dynamical core
  • various minor addition to physics and gestion of phys_state_var_mode, especially in dyn1d
  • adding MESOSCALE CPP keys around chemistry and microphysics (disabled in mesoscale for now)
Location:
trunk/LMDZ.TITAN/libf/dynphy_lonlat/phytitan
Files:
1 deleted
4 edited
2 copied

Legend:

Unmodified
Added
Removed

  • trunk/LMDZ.TITAN/libf/dynphy_lonlat/phytitan/lect_start_archive.F

    r2136 r2366  
    22     &     date,tsurf,tsoil,emis,q2,
    33     &     t,ucov,vcov,ps,h,phisold_newgrid,
    4      &     q,qsurf,surfith,nid)
    5 
    6 !      USE surfdat_h
     4     &     q,qsurf,tankCH4,surfith,nid)
     5
    76      USE comchem_h, only : cnames, nkim
    87      USE comchem_newstart_h
    98      USE comsoil_h, ONLY: nsoilmx, layer, mlayer, volcapa, inertiedat
    109      USE infotrac, ONLY: tname, nqtot
    11 !      USE control_mod
    12 ! to use  'getin'
    1310      USE callkeys_mod, only: callchim
    1411      USE comvert_mod, ONLY: ap,bp,aps,bps,preff
    … …  
    1714c=======================================================================
    1815c
    19 c
    20 c   Auteur:    05/1997 , 12/2003 : coord hybride  FF
    21 c   ------
    22 c
    23 c
    24 c   Objet:     Lecture des variables d'un fichier "start_archive"
    25 c              Plus besoin de régler ancienne valeurs grace
    26 c              a l'allocation dynamique de memoire (Yann Wanherdrick)
    27 c
    28 c
     16c    Routine to load variables from the "start_archive.nc" file
    2917c
    3018c=======================================================================
    … …  
    3220      implicit none
    3321
    34 #include "dimensions.h"
    35 !#include "dimphys.h"
    36 !#include "planete.h"
    37 #include "paramet.h"
    38 #include "comgeom2.h"
    39 !#include "control.h"
    40 #include "netcdf.inc"
    41 !#include"advtrac.h"
     22      include "dimensions.h"
     23      include "paramet.h"
     24      include "comgeom2.h"
     25      include "netcdf.inc"
     26
    4227c=======================================================================
    4328c   Declarations
    … …  
    4934c------------------------------------
    5035      INTEGER   imold,jmold,lmold,nsoilold,nqold
     36
    5137
    5238c Variables pour les lectures des fichiers "ini"
    … …  
    6046      CHARACTER*2   str2
    6147
    62 !      REAL dimfirst(4) ! tableau contenant les 1ers elements des dimensions
    63 
    64 !      REAL dimlast(4) ! tableau contenant les derniers elements des dimensions
    65 
    66 !      REAL dimcycl(4) ! tableau contenant les periodes des dimensions
    67 !      CHARACTER*120 dimsource
    68 !      CHARACTER*16 dimname
    69 !      CHARACTER*80 dimtitle
    70 !      CHARACTER*40 dimunits
    71 !      INTEGER   dimtype
    72 
    73 !      INTEGER dimord(4)  ! tableau contenant l''ordre
    74 !      data dimord /1,2,3,4/ ! de sortie des dimensions
    75 
    76 !      INTEGER vardim(4)
    77       REAL date
     48      REAL,INTENT(OUT) :: date
    7849      INTEGER   memo
    7950!      character (len=50) :: tmpname
    … …  
    8152c Variable histoire
    8253c------------------
    83       REAL vcov(iip1,jjm,llm),ucov(iip1,jjp1,llm) ! vents covariants
    84       REAL h(iip1,jjp1,llm),ps(iip1,jjp1)
    85       REAL q(iip1,jjp1,llm,nqtot),qtot(iip1,jjp1,llm)
    86 
    87 c autre variables dynamique nouvelle grille
    88 c------------------------------------------
    89 
    90 c!-*-
    91 !      integer klatdat,klongdat
    92 !      PARAMETER (klatdat=180,klongdat=360)
     54      REAL,INTENT(OUT) :: vcov(iip1,jjm,llm),ucov(iip1,jjp1,llm) ! vents covariants
     55      REAL,INTENT(OUT) :: h(iip1,jjp1,llm),ps(iip1,jjp1)
     56      REAL,INTENT(OUT) :: q(iip1,jjp1,llm,nqtot)
    9357
    9458c Physique sur grille scalaire
    … …  
    9761c variable physique
    9862c------------------
    99       REAL tsurf(ngrid) ! surface temperature
    100       REAL tsoil(ngrid,nsoilmx) ! soil temperature
    101       REAL emis(ngrid)
    102       REAL q2(ngrid,llm+1),qsurf(ngrid,nqtot)
     63      REAL,INTENT(OUT) :: tsurf(ngrid) ! surface temperature
     64      REAL,INTENT(OUT) :: tsoil(ngrid,nsoilmx) ! soil temperature
     65      REAL,INTENT(OUT) :: emis(ngrid)
     66      REAL,INTENT(OUT) :: q2(ngrid,llm+1),qsurf(ngrid,nqtot)
     67      REAL,INTENT(OUT) :: tankCH4(ngrid)
    10368c     REAL phisfi(ngrid)
    10469
    10570      INTEGER i,j,l
    106       INTEGER nid,nvarid
     71      INTEGER,INTENT(IN) :: nid
     72      INTEGER :: nvarid
    10773c     REAL year_day,periheli,aphelie,peri_day
    10874c     REAL obliquit,z0,emin_turb,lmixmin
    … …  
    11682c------------------------------------------------------
    11783      real us(iip1,jjp1,llm),vs(iip1,jjp1,llm)
    118       REAL phisold_newgrid(iip1,jjp1)
    119       REAL t(iip1,jjp1,llm)
     84      REAL,INTENT(OUT) :: phisold_newgrid(iip1,jjp1)
     85      REAL,INTENT(OUT) :: t(iip1,jjp1,llm)
    12086      real tsurfS(iip1,jjp1),tsoilS(iip1,jjp1,nsoilmx)
    12187      real inertiedatS(iip1,jjp1,nsoilmx)
    12288      real emisS(iip1,jjp1)
    12389      REAL q2S(iip1,jjp1,llm+1),qsurfS(iip1,jjp1,nqtot)
    124      
     90      REAL tankCH4S(iip1,jjp1)     
     91 
    12592      real ptotal
    12693
    … …  
    148115      real, dimension(:,:), allocatable :: tsurfold
    149116      real, dimension(:,:), allocatable :: emisold
     117      real, dimension(:,:), allocatable :: tankCH4old
    150118      real, dimension(:,:,:,:), allocatable :: qold
    151119     
    … …  
    167135      real, dimension(:), allocatable :: newval
    168136
    169       real surfith(iip1,jjp1) ! surface thermal inertia
     137      real,intent(out) :: surfith(iip1,jjp1) ! surface thermal inertia
    170138      ! surface thermal inertia at old horizontal grid resolution
    171139      real, dimension(:,:), allocatable :: surfithold
    … …  
    293261      allocate(tsurfold(imold+1,jmold+1))
    294262      allocate(emisold(imold+1,jmold+1))
     263      allocate(tankCH4old(imold+1,jmold+1))
    295264      allocate(q2old(imold+1,jmold+1,lmold+1))
    296265!      allocate(tsoilold(imold+1,jmold+1,nsoilmx))
    … …  
    312281      allocate(varp1 (imold+1,jmold+1,llm+1))
    313282
    314       write(*,*) 'q2',ngrid,llm+1
    315       write(*,*) 'q2S',iip1,jjp1,llm+1
    316       write(*,*) 'q2old',imold+1,jmold+1,lmold+1
     283      write(*,*) 'lect_start_archive: q2',ngrid,llm+1
     284      write(*,*) 'lect_start_archive: q2S',iip1,jjp1,llm+1
     285      write(*,*) 'lect_start_archive: q2old',imold+1,jmold+1,lmold+1
    317286
    318287!-----------------------------------------------------------------------
    … …  
    327296      ierr = NF_INQ_VARID (nid, "controle", nvarid)
    328297      IF (ierr .NE. NF_NOERR) THEN
    329          PRINT*, "Lect_start_archive: champ <controle> est absent"
     298         PRINT*, "Lect_start_archive: Field <controle> not found"
    330299         CALL abort
    331300      ENDIF
    … …  
    348317      ierr = NF_INQ_VARID (nid, "rlonv", nvarid)
    349318      IF (ierr .NE. NF_NOERR) THEN
    350          PRINT*, "lect_start_archive: Le champ <rlonv> est absent"
     319         PRINT*, "lect_start_archive: Field <rlonv> not found"
    351320         CALL abort
    352321      ENDIF
    … …  
    357326#endif
    358327      IF (ierr .NE. NF_NOERR) THEN
    359          PRINT*, "lect_start_archive: Lecture echouee pour <rlonv>"
     328         PRINT*, "lect_start_archive: Failed loading <rlonv>"
    360329         CALL abort
    361330      ENDIF
    … …  
    363332      ierr = NF_INQ_VARID (nid, "rlatu", nvarid)
    364333      IF (ierr .NE. NF_NOERR) THEN
    365          PRINT*, "lect_start_archive: Le champ <rlatu> est absent"
     334         PRINT*, "lect_start_archive: Field <rlatu> not found"
    366335         CALL abort
    367336      ENDIF
    … …  
    372341#endif
    373342      IF (ierr .NE. NF_NOERR) THEN
    374          PRINT*, "lect_start_archive: Lecture echouee pour <rlatu>"
     343         PRINT*, "lect_start_archive: Failed loading <rlatu>"
    375344         CALL abort
    376345      ENDIF
    … …  
    378347      ierr = NF_INQ_VARID (nid, "rlonu", nvarid)
    379348      IF (ierr .NE. NF_NOERR) THEN
    380          PRINT*, "lect_start_archive: Le champ <rlonu> est absent"
     349         PRINT*, "lect_start_archive: Field <rlonu> not found"
    381350         CALL abort
    382351      ENDIF
    … …  
    387356#endif
    388357      IF (ierr .NE. NF_NOERR) THEN
    389          PRINT*, "lect_start_archive: Lecture echouee pour <rlonu>"
     358         PRINT*, "lect_start_archive: Failed loading <rlonu>"
    390359         CALL abort
    391360      ENDIF
    … …  
    393362      ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
    394363      IF (ierr .NE. NF_NOERR) THEN
    395          PRINT*, "lect_start_archive: Le champ <rlatv> est absent"
     364         PRINT*, "lect_start_archive: Field <rlatv> not found"
    396365         CALL abort
    397366      ENDIF
    … …  
    402371#endif
    403372      IF (ierr .NE. NF_NOERR) THEN
    404          PRINT*, "lect_start_archive: Lecture echouee pour <rlatv>"
     373         PRINT*, "lect_start_archive: Failed loading <rlatv>"
    405374         CALL abort
    406375      ENDIF
    … …  
    413382      ierr = NF_INQ_VARID (nid, "aps", nvarid)
    414383      IF (ierr .NE. NF_NOERR) THEN
    415          PRINT*, "lect_start_archive: Le champ <aps> est absent"
     384         PRINT*, "lect_start_archive: Field <aps> not found"
    416385         apsold=0
    417386         PRINT*, "<aps> set to 0"
    … …  
    423392#endif
    424393         IF (ierr .NE. NF_NOERR) THEN
    425             PRINT*, "lect_start_archive: Lecture echouee pour <aps>"
     394            PRINT*, "lect_start_archive: Failed loading <aps>"
    426395         ENDIF
    427396      ENDIF
    … …  
    429398      ierr = NF_INQ_VARID (nid, "bps", nvarid)
    430399      IF (ierr .NE. NF_NOERR) THEN
    431          PRINT*, "lect_start_archive: Le champ <bps> est absent"
     400         PRINT*, "lect_start_archive: Field <bps> not found"
    432401         PRINT*, "It must be an old start_archive, lets look for sig_s"
    433402         ierr = NF_INQ_VARID (nid, "sig_s", nvarid)
    … …  
    443412#endif
    444413      IF (ierr .NE. NF_NOERR) THEN
    445          PRINT*, "lect_start_archive: Lecture echouee pour <bps>"
     414         PRINT*, "lect_start_archive: Failed loading <bps>"
    446415         CALL abort
    447416      END IF
    … …  
    532501      ierr=NF_INQ_VARID(nid,"preskim",nvarid)
    533502      IF (ierr .NE. NF_NOERR) THEN
    534          PRINT*, "lect_start_archive: Le champ <preskim> est absent"
     503         PRINT*, "lect_start_archive: Field <preskim> not found"
    535504         CALL abort
    536505      ENDIF
    … …  
    541510#endif
    542511      IF (ierr .NE. NF_NOERR) THEN
    543          PRINT*, "lect_start_archive: Lecture echouee pour <preskim>"
     512         PRINT*, "lect_start_archive: Failed reading <preskim>"
    544513         CALL abort
    545514      ENDIF
    … …  
    551520      ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
    552521      IF (ierr .NE. NF_NOERR) THEN
    553          PRINT*, "lect_start_archive: Le champ <phisinit> est absent"
     522         PRINT*, "lect_start_archive: Field <phisinit> not found"
    554523         CALL abort
    555524      ENDIF
    … …  
    560529#endif
    561530      IF (ierr .NE. NF_NOERR) THEN
    562          PRINT*, "lect_start_archive: Lecture echouee pour <phisinit>"
     531         PRINT*, "lect_start_archive: Failed loading <phisinit>"
    563532         CALL abort
    564533      ENDIF
    … …  
    579548         ierr = NF_INQ_DIMID (nid, "temps", nvarid)
    580549         IF (ierr .NE. NF_NOERR) THEN
    581             PRINT*, "lect_start_archive: Le champ <Time> est absent"
     550            PRINT*, "lect_start_archive: Field <Time> not found"
    582551            CALL abort
    583552         endif
    … …  
    594563#endif
    595564      IF (ierr .NE. NF_NOERR) THEN
    596          PRINT*, "lect_start_archive: Lecture echouee pour <Time>"
     565         PRINT*, "lect_start_archive: Failed loading <Time>"
    597566         CALL abort
    598567      ENDIF
    … …  
    600569      write(*,*)
    601570      write(*,*)
    602       write(*,*) 'Differentes dates des etats initiaux stockes:'
    603       write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
     571      write(*,*) 'Available dates for the stored initial conditions:'
     572      write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
    604573      pi=2.*ASIN(1.)
    605574      do i=1,timelen
    606575c       call solarlong(timelist(i),sollong(i))
    607576c       sollong(i) = sollong(i)*180./pi
    608         write(*,*) 'etat initial au jour martien' ,int(timelist(i))
     577        write(*,*) 'initial state for day ' ,int(timelist(i))
    609578c       write(*,6) nint(timelist(i)),nint(mod(timelist(i),669)),
    610579c    .    sollong(i)
    … …  
    614583 
    615584      write(*,*)
    616       write(*,*) 'Choix de la date'
     585      write(*,*) 'Choice for the date'
    617586 123  read(*,*,iostat=ierr) date
    618587      if(ierr.ne.0) goto 123
    … …  
    627596        write(*,*)
    628597        write(*,*)
    629         write(*,*) 'He alors... Y sait pas lire !?!'
     598        write(*,*) "Wrong value... can't you read !?!"
    630599        write(*,*)
    631         write(*,*) 'Differentes dates des etats initiaux stockes:'
    632         write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
     600        write(*,*) 'Available dates for the stored initial conditions:'
     601        write(*,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
    633602        do i=1,timelen
    634           write(*,*) 'etat initial au jour martien' ,nint(timelist(i))
     603          write(*,*) 'initial state for day ' ,nint(timelist(i))
    635604c         write(*,6) nint(timelist(i)),nint(mod(timelist(i),669))
    636605        end do
    … …  
    644613
    645614c-----------------------------------------------------------------------
    646 c 5.1 Lecture des champs 2D (emis,ps,tsurf,Tg[10], qsurf)
     615c 5.1 Lecture des champs 2D (emis,ps,tsurf,Tg[10], qsurf,tankCH4)
    647616c-----------------------------------------------------------------------
    648617 
    … …  
    650619      count=(/imold+1,jmold+1,1,0/)
    651620       
    652 
    653621      ierr = NF_INQ_VARID (nid, "emis", nvarid)
    654622      IF (ierr .NE. NF_NOERR) THEN
    655          PRINT*, "lect_start_archive: Le champ <emis> est absent"
     623         PRINT*, "lect_start_archive: Field <emis> not found"
    656624         CALL abort
    657625      ENDIF
    … …  
    662630#endif
    663631      IF (ierr .NE. NF_NOERR) THEN
    664          PRINT*, "lect_start_archive: Lecture echouee pour <emis>"
     632         PRINT*, "lect_start_archive: Failed loading <emis>"
    665633         CALL abort
    666634      ENDIF
    … …  
    668636      ierr = NF_INQ_VARID (nid, "ps", nvarid)
    669637      IF (ierr .NE. NF_NOERR) THEN
    670          PRINT*, "lect_start_archive: Le champ <ps> est absent"
     638         PRINT*, "lect_start_archive: Field <ps> not found"
    671639         CALL abort
    672640      ENDIF
    … …  
    677645#endif
    678646      IF (ierr .NE. NF_NOERR) THEN
    679          PRINT*, "lect_start_archive: Lecture echouee pour <ps>"
     647         PRINT*, "lect_start_archive: Failed loading <ps>"
    680648         CALL abort
    681649      ENDIF
    … …  
    683651      ierr = NF_INQ_VARID (nid, "tsurf", nvarid)
    684652      IF (ierr .NE. NF_NOERR) THEN
    685          PRINT*, "lect_start_archive: Le champ <tsurf> est absent"
     653         PRINT*, "lect_start_archive: Field <tsurf> not found"
    686654         CALL abort
    687655      ENDIF
    … …  
    692660#endif
    693661      IF (ierr .NE. NF_NOERR) THEN
    694          PRINT*, "lect_start_archive: Lecture echouee pour <tsurf>"
     662         PRINT*, "lect_start_archive: Failed loading <tsurf>"
    695663         CALL abort
    696664      ENDIF
    … …  
    698666      ierr = NF_INQ_VARID (nid, "q2surf", nvarid)
    699667      IF (ierr .NE. NF_NOERR) THEN
    700          PRINT*, "lect_start_archive: Le champ <q2surf> est absent"
     668         PRINT*, "lect_start_archive: Field <q2surf> not found"
    701669         CALL abort
    702670      ENDIF
    … …  
    707675#endif
    708676      IF (ierr .NE. NF_NOERR) THEN
    709          PRINT*, "lect_start_archive: Lecture echouee pour <q2surf>"
     677         PRINT*, "lect_start_archive: Failed loading <q2surf>"
    710678         CALL abort
    711679      ENDIF
    … …  
    721689        call initial0((jmold+1)*(imold+1), qsurfold(1,1,iq))
    722690      enddo
    723 
    724 
    725 !      print*,'tname=',tname
    726 !      print*,'nid',nid
    727 !      print*,'nvarid',nvarid
    728 !      stop
    729691
    730692      DO iq=1,nqtot
    … …  
    751713     &             " Failed loading <",trim(txt),">"
    752714          write (*,*) trim(txt),'    is set to 0'
    753 !          call initial0((jmold+1)*(imold+1), qsurfold(1,1,iq))
    754715        ENDIF
    755716
    756717      ENDDO ! of DO iq=1,nqtot
    757 
     718c
     719      ierr = NF_INQ_VARID (nid, "tankCH4", nvarid)
     720      IF (ierr .NE. NF_NOERR) THEN
     721         PRINT*, "lect_start_archive: Field <tankCH4> not found"
     722         CALL abort
     723      ENDIF
     724#ifdef NC_DOUBLE
     725      ierr = NF_GET_VARA_DOUBLE(nid, nvarid,start,count,tankCH4old)
     726#else
     727      ierr = NF_GET_VARA_REAL(nid, nvarid,start,count,tqnkCH4old)
     728#endif
     729      IF (ierr .NE. NF_NOERR) THEN
     730         PRINT*, "lect_start_archive: Failed loading <tankCH4>"
     731         CALL abort
     732      ENDIF
    758733
    759734!-----------------------------------------------------------------------
    … …  
    813788      endif ! of if (olddepthdef)
    814789
    815 !
    816 ! Read soil thermal inertias
    817 !
    818 !      if (.not.olddepthdef) then ! no thermal inertia data in "old" archives
    819 !       ierr=NF_INQ_VARID(nid,"inertiedat",nvarid)
    820 !       if (ierr.ne.NF_NOERR) then
    821 !        write(*,*)"lect_start_archive: Cannot find <inertiedat>"
    822 !       call abort
    823 !       else
    824 !#ifdef NC_DOUBLE
    825 !      ierr=NF_GET_VARA_DOUBLE(nid,nvarid,start,count,inertiedatold)
    826 !#else
    827 !      ierr=NF_GET_VARA_REAL(nid,nvarid,start,count,inertiedatold)
    828 !#endif
    829 !       endif ! of if (ierr.ne.NF_NOERR)
    830 !      endif
    831 
    832 
    833790c-----------------------------------------------------------------------
    834791c 5.3 Read 3D upper chemistry fields, if needed
    … …  
    847804      IF (ierr .NE. NF_NOERR) THEN ! H_up not found
    848805     
    849          PRINT*, "lect_start_archive: Le champ <H_up> est absent..."       
     806         PRINT*, "lect_start_archive: Field <H_up> not found..."       
    850807         IF (callchim) THEN
    851            PRINT*, "... mais callchim=.TRUE. dans callphys.def !"
    852            PRINT*, "Verifiez start_archive.nc ou desactivez callchim !"
     808           PRINT*, "... but callchim=.TRUE. in callphys.def !"
     809           PRINT*, "Check start_archive.nc or deactivate callchim !"
    853810           CALL abort
    854811         ELSE
    … …  
    861818     
    862819        IF (.not.callchim) THEN
    863           PRINT*, "lect_start_archive: Le champ <H_up> est present..."
    864           PRINT*, "... mais callchim=.FALSE. dans callphys.def !"
    865           PRINT*, "Si vous voulez gerer la chimie activez callchim !"
     820          PRINT*, "lect_start_archive: Field <H_up> found..."
     821          PRINT*, "... but callchim=.FALSE. in callphys.def !"
     822          PRINT*, "If you want to have chemistry, activate callchim !"
    866823          ! CALL abort ! This is too violent to abort here we can start from an archive with chemistry and don't want to use it - JVO !
    867824        ELSE
    … …  
    874831#endif
    875832          IF (ierr .NE. NF_NOERR) THEN
    876              PRINT*, "lect_start_archive: Lecture echouee pour <H_up>"
     833             PRINT*, "lect_start_archive: Failed reading <H_up>"
    877834             CALL abort
    878835          ENDIF
    … …  
    882839            ierr=NF_INQ_VARID(nid,trim(cnames(iq))//"_up",nvarid)
    883840            IF (ierr .NE. NF_NOERR) THEN
    884               PRINT*, "lect_start_archive: Le champ <"
    885      &//trim(cnames(iq))//"_up> est absent..."
     841              PRINT*, "lect_start_archive: Field <"
     842     &//trim(cnames(iq))//"_up> not found..."
    886843              CALL abort
    887844            ENDIF
    … …  
    894851#endif
    895852            IF (ierr .NE. NF_NOERR) THEN
    896                PRINT*, "lect_start_archive: Lecture echouee pour <"
     853               PRINT*, "lect_start_archive: Failed reading <"
    897854     &//trim(cnames(iq))//"_up>"
    898855               CALL abort
    … …  
    916873      ierr = NF_INQ_VARID (nid,"temp", nvarid)
    917874      IF (ierr .NE. NF_NOERR) THEN
    918          PRINT*, "lect_start_archive: Le champ <temp> est absent"
     875         PRINT*, "lect_start_archive: Field <temp> not found"
    919876         CALL abort
    920877      ENDIF
    … …  
    925882#endif
    926883      IF (ierr .NE. NF_NOERR) THEN
    927          PRINT*, "lect_start_archive: Lecture echouee pour <temp>"
     884         PRINT*, "lect_start_archive: Failed loading <temp>"
    928885         CALL abort
    929886      ENDIF
    … …  
    931888      ierr = NF_INQ_VARID (nid,"u", nvarid)
    932889      IF (ierr .NE. NF_NOERR) THEN
    933          PRINT*, "lect_start_archive: Le champ <u> est absent"
     890         PRINT*, "lect_start_archive: Field <u> not found"
    934891         CALL abort
    935892      ENDIF
    … …  
    940897#endif
    941898      IF (ierr .NE. NF_NOERR) THEN
    942          PRINT*, "lect_start_archive: Lecture echouee pour <u>"
     899         PRINT*, "lect_start_archive: Failed loading <u>"
    943900         CALL abort
    944901      ENDIF
    … …  
    946903      ierr = NF_INQ_VARID (nid,"v", nvarid)
    947904      IF (ierr .NE. NF_NOERR) THEN
    948          PRINT*, "lect_start_archive: Le champ <v> est absent"
     905         PRINT*, "lect_start_archive: Field <v> not found"
    949906         CALL abort
    950907      ENDIF
    … …  
    955912#endif
    956913      IF (ierr .NE. NF_NOERR) THEN
    957          PRINT*, "lect_start_archive: Lecture echouee pour <v>"
     914         PRINT*, "lect_start_archive: Failed loading <v>"
    958915         CALL abort
    959916      ENDIF
    … …  
    961918      ierr = NF_INQ_VARID (nid,"q2atm", nvarid)
    962919      IF (ierr .NE. NF_NOERR) THEN
    963          PRINT*, "lect_start_archive: Le champ <q2atm> est absent"
     920         PRINT*, "lect_start_archive: Field <q2atm> not found"
    964921         CALL abort
    965922      ENDIF
    … …  
    970927#endif
    971928      IF (ierr .NE. NF_NOERR) THEN
    972          PRINT*, "lect_start_archive: Lecture echouee pour <q2atm>"
     929         PRINT*, "lect_start_archive: Failed loading <q2atm>"
    973930         CALL abort
    974931      ENDIF
    … …  
    10711028
    10721029      write(*,*)
    1073       write(*,*)'Ancienne grille: masse de l atm :',ptotalold
    1074       write(*,*)'Nouvelle grille: masse de l atm :',ptotal
     1030      write(*,*)'Old grid: atmospheric mass :',ptotalold
     1031      write(*,*)'New grid: atmospheric mass :',ptotal
    10751032      write (*,*) 'Ratio new atm./ old atm =', ptotal/ptotalold
    10761033      write(*,*)
    … …  
    14291386      deallocate(ykim_upoldS)
    14301387
    1431 !      write(*,*)'lect_start_archive: END'
    1432       return
    14331388      end

  • trunk/LMDZ.TITAN/libf/dynphy_lonlat/phytitan/newstart.F

    r2136 r2366  
    3939      use iniphysiq_mod, only: iniphysiq
    4040      use phyetat0_mod, only: phyetat0
     41      use exner_hyb_m, only: exner_hyb
    4142      use tracer_h
    4243      implicit none
    … …  
    125126      REAL :: xpn,xps,xppn(iim),xpps(iim)
    126127      REAL :: p3d(iip1, jjp1, llm+1)
    127       REAL :: beta(iip1,jjp1,llm)
    128128!      REAL dteta(ip1jmp1,llm)
    129129
    … …  
    542542     &   date,tsurf,tsoil,emis,q2,
    543543     &   t,ucov,vcov,ps,teta,phisold_newgrid,
    544      &   q,qsurf,surfith,nid)
     544     &   q,qsurf,tankCH4,surfith,nid)
    545545        write(*,*) "OK, read start_archive file"
    546546        ! copy soil thermal inertia
    … …  
    11201120c-----------------------------------------------------------------------
    11211121
    1122       CALL exner_hyb(ip1jmp1, ps, p3d, beta, pks, pk, pkf)
     1122      CALL exner_hyb(ip1jmp1, ps, p3d, pks, pk, pkf)
    11231123! Calcul de la temperature potentielle teta
    11241124

  • trunk/LMDZ.TITAN/libf/dynphy_lonlat/phytitan/start2archive.F

    r1903 r2366  
    2222      USE comsoil_h
    2323      USE comchem_h, only : cnames, nkim, nlaykim_up, preskim, ykim_up
    24 !      USE comgeomfi_h, ONLY: lati, long, area
    25 !      use control_mod
    26 !      use comgeomphy, only: initcomgeomphy
    27 ! to use  'getin'
    28       USE ioipsl_getincom
     24      USE ioipsl_getincom, only: getin
    2925      USE planete_mod, only: year_day
    3026      USE mod_const_mpi, ONLY: COMM_LMDZ
    … …  
    3531      USE temps_mod, ONLY: day_ini
    3632      USE iniphysiq_mod, ONLY: iniphysiq
     33      use phys_state_var_mod, only: phys_state_var_init
    3734      use phyetat0_mod, only: phyetat0
    3835      use tracer_h
     36      use exner_hyb_m, only: exner_hyb
    3937      implicit none
    4038
    … …  
    4442      include "comdissip.h"
    4543      include "comgeom.h"
    46 !#include "control.h"
    47 
    48 !#include "dimphys.h"
    49 !#include "planete.h"
    50 !#include"advtrac.h"
     44
    5145      include "netcdf.inc"
    5246c-----------------------------------------------------------------------
    … …  
    6256      REAL pk(ip1jmp1,llm)
    6357      REAL pkf(ip1jmp1,llm)
    64       REAL beta(iip1,jjp1,llm)
    6558      REAL phis(ip1jmp1)                     ! geopotentiel au sol
    6659      REAL masse(ip1jmp1,llm)                ! masse de l'atmosphere
    … …  
    262255      Lmodif=0
    263256
     257! Allocate saved arrays (as in firstcall of physiq)
     258      call phys_state_var_init(nqtot)
     259     
    264260! Initialize tracer names, indexes and properties
    265261      CALL initracer2(nqtot,tname)
    … …  
    312308
    313309      CALL pression(ip1jmp1, ap, bp, ps, p3d)
    314       call exner_hyb(ip1jmp1, ps, p3d, beta, pks, pk, pkf)
     310      call exner_hyb(ip1jmp1, ps, p3d, pks, pk, pkf)
    315311
    316312c=======================================================================

  • trunk/LMDZ.TITAN/libf/dynphy_lonlat/phytitan/write_archive.F

    r1886 r2366  
    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         
    … …  
    183183          ! define the variable
    184184          write(*,*)"====================="
    185           write(*,*)"defining ",nom
     185          write(*,*)"defining variable ",trim(nom)
    186186          call def_var(nid,nom,titre,unite,4,id,varid,ierr)
    187187
    … …  
    203203           ierr= NF_PUT_VARA_REAL(nid,varid,corner,edges,px)
    204204#endif
     205
    205206
    206207
    … …  
    222223
    223224              write (*,*) "====================="
    224               write (*,*) "creation de ",nom
     225              write (*,*) "defining variable ",trim(nom)
    225226
    226227              call def_var(nid,nom,titre,unite,3,id,varid,ierr)
    … …  
    243244
    244245           if (ierr.ne.NF_NOERR) then
    245               write(*,*) "***** PUT_VAR matter in write_archive"
     246              write(*,*) "***** PUT_VAR problem in write_archive"
    246247              write(*,*) "***** with ",nom,nf_STRERROR(ierr)
    247248              call abort
    … …  
    264265
    265266              write (*,*) "====================="
    266               write (*,*) "creation de ",nom
     267              write (*,*) "defining variable ",trim(nom)
    267268
    268269              call def_var(nid,nom,titre,unite,1,id,varid,ierr)
    … …  
    279280#endif
    280281           if (ierr.ne.NF_NOERR) then
    281               write(*,*) "***** PUT_VAR matter in write_archive"
     282              write(*,*) "***** PUT_VAR problem in write_archive"
    282283              write(*,*) "***** with ",nom,nf_STRERROR(ierr)
    283284              call abort
    … …  
    289290        endif ! of if (dim.eq.3) else if (dim.eq.-3) ....
    290291
    291       return
    292292      end
    293293
Note: See TracChangeset for help on using the changeset viewer.