Changeset 2366 for trunk/LMDZ.TITAN/libf


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
Files:
1 added
7 deleted
28 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

  • trunk/LMDZ.TITAN/libf/phytitan/callcorrk.F90

    r2138 r2366  
    1717      use comcstfi_mod, only: pi, mugaz, cpp
    1818      use callkeys_mod, only: diurnal,tracer,seashaze,corrk_recombin,   &
    19                               strictboundcorrk,specOLR,diagdtau
     19                              strictboundcorrk,specOLR,diagdtau,        &
     20                              tplanckmin,tplanckmax
    2021      use geometry_mod, only: latitude
    2122
    … …  
    115116      real*8 taugsurf(L_NSPECTV,L_NGAUSS-1)
    116117      real*8 taugsurfi(L_NSPECTI,L_NGAUSS-1)
     118
     119      ! Miscellaneous :
     120      character(len=100) :: message
     121      character(len=10),parameter :: subname="callcorrk"
    117122
    118123      logical OLRz
    … …  
    377382            endif
    378383         endif
     384
     385         if (tlevrad(k).lt.tplanckmin) then
     386            print*,'Minimum temperature is outside the boundaries for'
     387            print*,'Planck function integration set in callphys.def, aborting.'
     388            print*,"k=",k," tlevrad(k)=",tlevrad(k)
     389            print*,"tplanckmin=",tplanckmin
     390            message="Minimum temperature outside Planck function bounds - Change tplanckmin in callphys.def"
     391            call abort_physic(subname,message,1)
     392          else if (tlevrad(k).gt.tplanckmax) then
     393            print*,'Maximum temperature is outside the boundaries for'
     394            print*,'Planck function integration set in callphys.def, aborting.'
     395            print*,"k=",k," tlevrad(k)=",tlevrad(k)
     396            print*,"tplanckmax=",tplanckmax
     397            message="Maximum temperature outside Planck function bounds - Change tplanckmax in callphys.def"
     398            call abort_physic(subname,message,1)
     399          endif
     400
    379401      enddo
     402
    380403      do k=1,L_NLAYRAD+1
    381404         if(tmid(k).lt.tgasmin)then

  • trunk/LMDZ.TITAN/libf/phytitan/callkeys_mod.F90

    r2245 r2366  
    6060      real,save :: szangle
    6161!$OMP THREADPRIVATE(szangle)
     62
     63      real,save :: tplanckmin
     64      real,save :: tplanckmax
     65      real,save :: dtplanck
     66!$OMP THREADPRIVATE(tplanckmin,tplanckmax,dtplanck)
    6267      real,save :: Fat1AU
    6368      real,save :: stelTbb
    … …  
    7681      real,save :: surfemis
    7782!$OMP THREADPRIVATE(surfalbedo,surfemis)
    78 
     83      real,save :: noseason_day
     84!$OMP THREADPRIVATE(noseason_day)
    7985      logical,save :: iscallphys=.false.!existence of callphys.def
    8086!$OMP THREADPRIVATE(iscallphys)

  • trunk/LMDZ.TITAN/libf/phytitan/comsaison_h.F90

    r1327 r2366  
    44       implicit none
    55
    6        integer isaison
    7        logical callsais
    8        real dist_star,declin,right_ascen
     6!       integer,save :: isaison
     7!       logical,save :: callsais
     8!!$OMP THREADPRIVATE(isaison,callsais)
     9
     10       real,save :: dist_star,declin,right_ascen
     11!$OMP THREADPRIVATE(dist_star,declin,right_ascen)
    912
    1013       real, allocatable, dimension(:) :: mu0,fract
    11 !$OMP THREADPRIVATE(isaison,callsais,dist_star,declin,mu0,fract)
     14!$OMP THREADPRIVATE(mu0,fract)
    1215
    1316       end module comsaison_h

  • trunk/LMDZ.TITAN/libf/phytitan/dyn1d/abort_gcm.F

    r1403 r2366  
    1 link ../../dyn3d/abort_gcm.F
     1link ../../../../LMDZ.COMMON/libf/dyn3d/abort_gcm.F

  • trunk/LMDZ.TITAN/libf/phytitan/dyn1d/comconst_mod.F90

    r1422 r2366  
    1 link ../../dyn3d/comconst_mod.F90
     1link ../../../../LMDZ.COMMON/libf/dyn3d_common/comconst_mod.F90

  • trunk/LMDZ.TITAN/libf/phytitan/dyn1d/comgeom.h

    r1403 r2366  
    1 link ../../dyn3d/comgeom.h
     1link ../../../../LMDZ.COMMON/libf/dyn3d_common/comgeom.h

  • trunk/LMDZ.TITAN/libf/phytitan/dyn1d/comvert_mod.F90

    r1422 r2366  
    1 link ../../dyn3d/comvert_mod.F90
     1link ../../../../LMDZ.COMMON/libf/dyn3d_common/comvert_mod.F90

  • trunk/LMDZ.TITAN/libf/phytitan/dyn1d/control_mod.F90

    r1403 r2366  
    1 link ../../dyn3d/control_mod.F90
     1link ../../../../LMDZ.COMMON/libf/dyn3d_common/control_mod.F90

  • trunk/LMDZ.TITAN/libf/phytitan/dyn1d/ener_mod.F90

    r1422 r2366  
    1 link ../../dyn3d/ener_mod.F90
     1link ../../../../LMDZ.COMMON/libf/dyn3d_common/ener_mod.F90

  • trunk/LMDZ.TITAN/libf/phytitan/dyn1d/infotrac.F90

    r1403 r2366  
    1 link ../../dyn3d/infotrac.F90
     1link ../../../../LMDZ.COMMON/libf/dyn3d_common/infotrac.F90

  • trunk/LMDZ.TITAN/libf/phytitan/dyn1d/logic_mod.F90

    r1422 r2366  
    1 link ../../dyn3d/logic_mod.F90
     1link ../../../../LMDZ.COMMON/libf/dyn3d/logic_mod.F90

  • trunk/LMDZ.TITAN/libf/phytitan/dyn1d/mod_const_mpi.F90

    r1403 r2366  
    1 link ../../dyn3d/mod_const_mpi.F90
     1link ../../../../LMDZ.COMMON/libf/dyn3d/mod_const_mpi.F90

  • trunk/LMDZ.TITAN/libf/phytitan/dyn1d/paramet.h

    r1403 r2366  
    1 link ../../dyn3d/paramet.h
     1link ../../../../LMDZ.COMMON/libf/dyn3d_common/paramet.h

  • trunk/LMDZ.TITAN/libf/phytitan/dyn1d/rcm1d.F

    r2116 r2366  
    2828     &                       presnivs,pseudoalt,scaleheight
    2929      USE vertical_layers_mod, ONLY: init_vertical_layers
    30       USE logic_mod, ONLY: hybrid,autozlevs
     30      USE logic_mod, ONLY: hybrid
    3131      use regular_lonlat_mod, only: init_regular_lonlat
    3232      use planete_mod, only: ini_planete_mod
    … …  
    3535      use mod_interface_dyn_phys, only: init_interface_dyn_phys
    3636      use inifis_mod, only: inifis
     37      use phys_state_var_mod, only: phys_state_var_init
    3738      use physiq_mod, only: physiq
    3839      implicit none
    … …  
    118119
    119120!     added by RW for autozlevs computation
     121      logical autozlevs
    120122      real nu, xx, pMIN, zlev, Htop
    121123      real logplevs(llm)
    … …  
    132134c INITIALISATION
    133135c=======================================================================
    134 ! initialize "serial/parallel" related stuff
    135 !      CALL init_phys_lmdz(iim,jjm+1,llm,1,(/(jjm-1)*iim+2/))
    136 !      CALL init_phys_lmdz(1,1,llm,1,(/1/))
    137 !      call initcomgeomphy
    138 
    139       !! those are defined in surfdat_h.F90
    140       IF (.not. ALLOCATED(albedodat)) ALLOCATE(albedodat(1))
    141       IF (.not. ALLOCATED(phisfi)) ALLOCATE(phisfi(1))
    142       IF (.not. ALLOCATED(zmea)) ALLOCATE(zmea(1))
    143       IF (.not. ALLOCATED(zstd)) ALLOCATE(zstd(1))
    144       IF (.not. ALLOCATED(zsig)) ALLOCATE(zsig(1))
    145       IF (.not. ALLOCATED(zgam)) ALLOCATE(zgam(1))
    146       IF (.not. ALLOCATED(zthe)) ALLOCATE(zthe(1))
    147       !! those are defined in comdiurn_h.F90
    148       IF (.not.ALLOCATED(sinlat)) ALLOCATE(sinlat(1))
    149       IF (.not.ALLOCATED(coslat)) ALLOCATE(coslat(1))
    150       IF (.not.ALLOCATED(sinlon)) ALLOCATE(sinlon(1))
    151       IF (.not.ALLOCATED(coslon)) ALLOCATE(coslon(1))
    152 
     136
     137      ! read nq from traceur.def
     138      open(90,file='traceur.def',status='old',form='formatted',
     139     &       iostat=ierr)
     140      if (ierr.eq.0) then
     141        read(90,*,iostat=ierr) nq
     142      else
     143        nq=0
     144      endif
     145      close(90)
     146     
     147      ! Initialize dimphy module
     148      call init_dimphy(1,llm)
     149      ! now initialize arrays using phys_state_var_init
     150      call phys_state_var_init(nq)
     151     
    153152      saveprofile=.false.
    154153      saveprofile=.true.
    … …  
    480479!      call init_vertical_layers(nlayer,preff,scaleheight,
    481480!     &                      ap,bp,aps,bps,presnivs,pseudoalt)
    482       call init_dimphy(1,nlayer) ! Initialize dimphy module
     481!      call init_dimphy(1,nlayer) ! Initialize dimphy module
    483482      call ini_planete_mod(nlayer,preff,ap,bp)
    484483
    … …  
    643642      endif
    644643
    645       call disvert
     644      call disvert_noterre
    646645      ! now that disvert has been called, initialize module vertical_layers_mod
    647646      call init_vertical_layers(nlayer,preff,scaleheight,
    … …  
    669668         ENDDO
    670669         
     670
     671
    671672         DO ilayer=1,nlayer
    672673!     zlay(ilayer)=-300.E+0 *r*log(play(ilayer)/plev(1))

  • trunk/LMDZ.TITAN/libf/phytitan/dyn1d/serre_mod.F90

    r1422 r2366  
    1 link ../../dyn3d/serre_mod.F90
     1link ../../../../LMDZ.COMMON/libf/dyn3d_common/serre_mod.F90

  • trunk/LMDZ.TITAN/libf/phytitan/gfluxi.F

    r2095 r2366  
    8585         LAMDA(L) = ALPHA(L)*(1.0D0-W0(L)*COSBAR(L))/UBARI
    8686         
    87          NT    = int(TLEV(2*L)*NTfac)   - NTstar+1
    88          NT2   = int(TLEV(2*L+2)*NTfac) - NTstar+1
     87         NT    = int(TLEV(2*L)*NTfac)   - NTstart+1
     88         NT2   = int(TLEV(2*L+2)*NTfac) - NTstart+1
    8989         
    9090! AB : PLANCKIR(NW,NT) is replaced by P1, the linear interpolation result for a temperature NT
    … …  
    112112      ! -- same results for most thin atmospheres
    113113      ! -- and stabilizes integrations
    114       NT    = int(TLEV(2*L+1)*NTfac) - NTstar+1
     114      NT    = int(TLEV(2*L+1)*NTfac) - NTstart+1
    115115      !! For deep, opaque, thick first layers (e.g. Saturn)
    116116      !! what is below works much better, not unstable, ...
    117117      !! ... and actually fully accurate because 1st layer temp (JL)
    118       !NT    = int(TLEV(2*L)*NTfac) - NTstar+1
     118      !NT    = int(TLEV(2*L)*NTfac) - NTstart+1
    119119      !! (or this one yields same results
    120       !NT    = int( (TLEV(2*L)+TLEV(2*L+1))*0.5*NTfac ) - NTstar+1
    121      
    122       NT2   = int(TLEV(2*L)*NTfac)   - NTstar+1
     120      !NT    = int( (TLEV(2*L)+TLEV(2*L+1))*0.5*NTfac ) - NTstart+1
     121     
     122      NT2   = int(TLEV(2*L)*NTfac)   - NTstart+1
    123123     
    124124! AB : PLANCKIR(NW,NT) is replaced by P1, the linear interpolation result for a temperature NT

  • trunk/LMDZ.TITAN/libf/phytitan/inifis_mod.F90

    r2245 r2366  
    1111  use init_print_control_mod, only: init_print_control
    1212  use radinc_h, only: ini_radinc_h
    13   use datafile_mod
    1413  use comdiurn_h, only: sinlat, coslat, sinlon, coslon
    1514  use comgeomfi_h, only: totarea, totarea_planet
    … …  
    5958!   declarations:
    6059!   -------------
     60  use datafile_mod
    6161  use ioipsl_getin_p_mod, only: getin_p
    6262  IMPLICIT NONE
    … …  
    9090
    9191  ! Initialize some "temporal and calendar" related variables
     92#ifndef MESOSCALE
    9293  CALL init_time(day_ini,pdaysec,nday,ptimestep)
     94#endif
    9395
    9496  ! read in some parameters from "run.def" for physics,
    … …  
    147149     call getin_p("season",season)
    148150     write(*,*) " season = ",season
     151     
     152     write(*,*) "No seasonal cycle: initial day to lock the run during restart"
     153     noseason_day=0.0 ! default value
     154     call getin_p("noseason_day",noseason_day)
     155     write(*,*) "noseason_day=", noseason_day
    149156
    150157     write(*,*) "Tidally resonant rotation ?"
    … …  
    276283     write(*,*) "strictboundcorrk = ",strictboundcorrk
    277284
     285     write(*,*) "Minimum atmospheric temperature for Planck function integration ?"
     286     tplanckmin=30.0 ! default value
     287     call getin_p("tplanckmin",tplanckmin)
     288     write(*,*) " tplanckmin = ",tplanckmin
     289 
     290     write(*,*) "Maximum atmospheric temperature for Planck function integration ?"
     291     tplanckmax=1500.0 ! default value
     292     call getin_p("tplanckmax",tplanckmax)
     293     write(*,*) " tplanckmax = ",tplanckmax
     294 
     295     write(*,*) "Temperature step for Planck function integration ?"
     296     dtplanck=0.1 ! default value
     297     call getin_p("dtplanck",dtplanck)
     298     write(*,*) " dtplanck = ",dtplanck
     299 
    278300     write(*,*) "call gaseous absorption in the visible bands?", &
    279301                    "(matters only if callrad=T)"
    … …  
    548570     endif ! of if (force_cpp)
    549571     
    550      
    551572     call su_gases(nlayer,tracer)     
    552      call calc_cpp_mugaz
    553      
    554      
     573     call calc_cpp_mugaz
     574
    555575     PRINT*,'--------------------------------------------'
    556576     PRINT*
    … …  
    579599
    580600  ! Initializations for comgeomfi_h
     601#ifndef MESOSCALE
    581602  totarea=SSUM(ngrid,parea,1)
    582603  call planetwide_sumval(parea,totarea_planet)
    … …  
    594615     coslon(ig)=cos(plon(ig))
    595616  ENDDO
    596 
     617#endif
    597618  ! initialize variables in radinc_h
    598   call ini_radinc_h(nlayer)
     619  call ini_radinc_h(nlayer,tplanckmin,tplanckmax,dtplanck)
    599620 
    600621  ! allocate "comsoil_h" arrays
    601622  call ini_comsoil_h(ngrid)
    602      
     623   
    603624  END SUBROUTINE inifis
    604625

  • trunk/LMDZ.TITAN/libf/phytitan/optcv.F90

    r2242 r2366  
    1111                          callclouds,callmufi,seashaze,uncoupl_optic_haze
    1212  use tracer_h, only: nmicro,nice
    13   use MMP_OPTICS
    1413
    1514  implicit none

  • trunk/LMDZ.TITAN/libf/phytitan/phys_state_var_mod.F90

    r2328 r2366  
    1010! Declaration des variables
    1111      USE dimphy, only : klon,klev
     12      use comchem_h, only: nkim
     13      USE callkeys_mod, only: callchim
    1214      USE comsoil_h, only : nsoilmx
    1315      use comsaison_h, only: mu0, fract
    1416      use radcommon_h, only: gzlat, gzlat_ig, Cmk
    1517      USE radinc_h, only : L_NSPECTI, L_NSPECTV,naerkind
     18      use surfdat_h, only: phisfi, albedodat,  &
     19                        zmea, zstd, zsig, zgam, zthe
    1620      use turb_mod, only: q2,sensibFlux,wstar,ustar,tstar,hfmax_th,zmax_th
    1721
    18       real,allocatable,dimension(:,:),save :: ztprevious ! Previous loop Atmospheric Temperature (K) ! Useful for Dynamical Heating calculation.
    19       real,allocatable,dimension(:,:),save :: zuprevious ! Previous loop Zonal Wind (m.s-1)          ! Useful for Zonal Wind tendency calculation.
     22      real,allocatable,dimension(:,:),save :: ztprevious ! Previous loop Atmospheric Temperature (K)
     23! Useful for Dynamical Heating calculation.
     24      real,allocatable,dimension(:,:),save :: zuprevious
     25!$OMP THREADPRIVATE(ztprevious,zuprevious)
    2026
    2127      real, dimension(:),allocatable,save ::  tsurf                ! Surface temperature (K).
    … …  
    4046      real,dimension(:),allocatable,save :: fluxgrd     ! Surface conduction flux (W.m-2).
    4147      real,dimension(:,:),allocatable,save :: qsurf     ! Tracer on surface (e.g. kg.m-2).
    42 
    4348!$OMP THREADPRIVATE(emis,dtrad,fluxrad_sky,fluxrad,capcal,fluxgrd,qsurf,q2)
    4449
    … …  
    4853      real,dimension(:),allocatable,save :: fluxsurf_sw     ! Incident Short Wave (stellar) surface flux (W.m-2).
    4954      real,dimension(:),allocatable,save :: fluxsurfabs_sw  ! Absorbed Short Wave (stellar) flux by the surface (W.m-2).
     55!$OMP THREADPRIVATE(fluxsurf_lw,fluxsurf_sw,fluxsurfabs_sw)
    5056
    5157      real,dimension(:),allocatable,save :: fluxtop_lw      ! Outgoing LW (IR) flux to space (W.m-2).
    … …  
    5359      real,dimension(:),allocatable,save :: fluxtop_dn      ! Incoming SW (stellar) radiation at the top of the atmosphere (W.m-2).
    5460      real,dimension(:),allocatable,save :: fluxdyn         ! Horizontal heat transport by dynamics (W.m-2).
     61!$OMP THREADPRIVATE(fluxtop_lw,fluxabs_sw,fluxtop_dn,fluxdyn)
    5562
    5663      real,dimension(:,:),allocatable,save :: OLR_nu        ! Outgoing LW radiation in each band (Normalized to the band width (W/m2/cm-1)).
    … …  
    5966      real,dimension(:,:),allocatable,save :: zdtsw         ! SW heating tendencies (K/s).
    6067      !real,dimension(:),allocatable,save :: sensibFlux      ! Turbulent flux given by the atmosphere to the surface (W.m-2).
     68!$OMP THREADPRIVATE(OLR_nu,OSR_nu,zdtlw,zdtsw)
     69
    6170      real,dimension(:,:,:),allocatable,save :: int_dtauv   ! VI optical thickness of layers within narrowbands for diags ().
    6271      real,dimension(:,:,:),allocatable,save :: int_dtaui   ! IR optical thickness of layers within narrowbands for diags ().
    63 
    64 !$OMPTHREADPRIVATE(fluxsurf_lw,fluxsurf_sw,fluxsurfabs_sw,fluxtop_lw,fluxabs_sw,fluxtop_dn,fluxdyn,OLR_nu,OSR_nu,&       
    65         !$OMP zdtlw,zdtsw,sensibFlux,int_dtauv,int_dtaui))
     72!$OMP THREADPRIVATE(int_dtaui,int_dtauv)
    6673
    6774      real,allocatable,dimension(:,:),save :: qsurf_hist
    6875!$OMP THREADPRIVATE(qsurf_hist)
     76
     77      ! For chemistry
     78      real, dimension(:,:,:), allocatable, save   :: dycchi  ! NB : Only for chem tracers. Saved since chemistry is not called every step.
     79!$OMP THREADPRIVATE(dycchi)
    6980 
    7081CONTAINS
    … …  
    119130        ALLOCATE(int_dtaui(klon,klev,L_NSPECTI))
    120131        ALLOCATE(int_dtauv(klon,klev,L_NSPECTV))
     132        allocate(dycchi(klon,klev,nkim))
    121133        ! This is defined in comsaison_h
    122134        ALLOCATE(mu0(klon))
    … …  
    126138        ALLOCATE(gzlat_ig(klev))
    127139        ALLOCATE(Cmk(klev))
     140        ! This is defined in surfdat_h
     141        ALLOCATE(albedodat(klon))
     142        ALLOCATE(phisfi(klon))
     143        ALLOCATE(zmea(klon))
     144        ALLOCATE(zstd(klon))
     145        ALLOCATE(zsig(klon))
     146        ALLOCATE(zgam(klon))
     147        ALLOCATE(zthe(klon))
    128148        ! This is defined in turb_mod
    129149        allocate(wstar(klon))
    … …  
    171191        DEALLOCATE(int_dtaui)
    172192        DEALLOCATE(int_dtauv)
     193        DEALLOCATE(dycchi)
    173194        DEALLOCATE(mu0)
    174195        DEALLOCATE(fract)
    … …  
    176197        DEALLOCATE(gzlat_ig)
    177198        DEALLOCATE(Cmk)
     199        DEALLOCATE(phisfi)
     200        DEALLOCATE(albedodat)
     201        DEALLOCATE(zmea)
     202        DEALLOCATE(zstd)
     203        DEALLOCATE(zsig)
     204        DEALLOCATE(zgam)
     205        DEALLOCATE(zthe)
    178206        deallocate(wstar)
    179207        deallocate(ustar)

  • trunk/LMDZ.TITAN/libf/phytitan/physiq_mod.F90

    r2328 r2366  
    1616      use radinc_h, only : L_NSPECTI,L_NSPECTV
    1717      use radcommon_h, only: sigma, gzlat, grav, BWNV
    18       use surfdat_h, only: phisfi, zmea, zstd, zsig, zgam, zthe
    1918      use comchem_h, only: nkim, cnames, nlaykim_up, ykim_up, ykim_tot, botCH4
    2019      use comdiurn_h, only: coslat, sinlat, coslon, sinlon
    … …  
    3433      use comcstfi_mod, only: pi, g, rcp, r, rad, mugaz, cpp
    3534      use time_phylmdz_mod, only: daysec
     35#ifndef MESOSCALE
    3636      use logic_mod, only: moyzon_ch
    3737      use moyzon_mod, only:  zphibar, zphisbar, zplevbar, zplaybar, &
    3838                             zzlevbar, zzlaybar, ztfibar, zqfibar
     39#endif
    3940      use callkeys_mod
    4041      use phys_state_var_mod
    … …  
    4243#ifndef MESOSCALE
    4344      use vertical_layers_mod, only: presnivs, pseudoalt
    44       use ioipsl_getin_p_mod, only: getin_p
    4545      use mod_phys_lmdz_omp_data, ONLY: is_omp_master
    4646#else
    … …  
    5656      use wxios, only: wxios_context_init, xios_context_finalize
    5757#endif
    58       use MMP_OPTICS
    5958      use muphy_diag
    6059      implicit none
    … …  
    177176!   -------
    178177
    179 
    180178      integer,intent(in) :: ngrid             ! Number of atmospheric columns.
    181179      integer,intent(in) :: nlayer            ! Number of atmospheric layers.
    … …  
    211209! Local saved variables:
    212210! ----------------------
    213 
    214211      integer,save :: day_ini                                      ! Initial date of the run (sol since Ls=0).
    215212      integer,save :: icount                                       ! Counter of calls to physiq during the run.
    216 
     213!$OMP THREADPRIVATE(day_ini,icount)
    217214
    218215! Local variables :
    … …  
    289286
    290287
    291 
    292288! local variables for DIAGNOSTICS : (diagfi & stat)
    293289! -------------------------------------------------
    … …  
    299295      real zdtdyn(ngrid,nlayer)                          ! Dynamical Heating (K/s).
    300296      real zdudyn(ngrid,nlayer)                          ! Dynamical Zonal Wind tendency (m.s-2).
    301 !$OMP THREADPRIVATE(ztprevious,zuprevious)
    302297
    303298      real zhorizwind(ngrid,nlayer) ! Horizontal Wind ( sqrt(u**+v*v))
    … …  
    329324      real tf, ntf   
    330325
    331 !$OMP THREADPRIVATE(qsurf_hist)
    332    
    333326      ! Miscellaneous :
    334327      character(len=10) :: tmp1
    … …  
    336329     
    337330      character*2 :: str2
     331
     332#ifndef MESOSCALE
    338333
    339334! Local variables for Titan chemistry and microphysics
    … …  
    348343
    349344      ! Molar fraction tendencies ( chemistry, condensation and evaporation ) for tracers (mol/mol/s)
    350       real, dimension(:,:,:), allocatable, save   :: dycchi         ! NB : Only for chem tracers. Saved since chemistry is not called every step.
    351 !$OMP THREADPRIVATE(dycchi)
    352345      real, dimension(ngrid,nlayer,nq)            :: dyccond        ! Condensation rate. NB : for all tracers, as we want to use indx on it.
    353346      real, dimension(ngrid,nlayer,nq)            :: dyccondbar     ! For 2D chemistry
    … …  
    360353      real :: i2e(ngrid,nlayer)      ! int 2 ext factor ( X.kg-1 -> X.m-3 for diags )
    361354
     355#ifdef USE_QTEST
    362356      real,save,dimension(:,:,:), allocatable :: tpq ! Tracers for decoupled microphysical tests ( temporary in 01/18 )
    363357!$OMP THREADPRIVATE(tpq)
    364358      real,dimension(ngrid,nlayer,nq) :: dtpq ! (temporary in 01/18)
     359#endif
    365360
    366361      logical file_ok
    … …  
    385380      END SUBROUTINE calmufi
    386381    END INTERFACE
     382
     383#endif
    387384     
    388385!==================================================================================================
    … …  
    396393! --------------------------------
    397394      if (firstcall) then
    398 #ifndef MESOSCALE
     395
     396#ifdef USE_QTEST
    399397        allocate(tpq(ngrid,nlayer,nq))
    400398        tpq(:,:,:) = pq(:,:,:)
    401 
     399#endif
    402400        ! Initialisation of nmicro as well as tracers names, indexes ...
    403401        if (ngrid.ne.1) then ! Already done in rcm1d
    … …  
    405403        endif
    406404
    407         call phys_state_var_init(nq)
    408 
     405        ! Allocate saved arrays (except for 1D model, where this has already been done)
     406#ifndef MESOSCALE
     407        if (ngrid>1) call phys_state_var_init(nq)
    409408#endif
    410409
    … …  
    453452         endif
    454453
     454#ifndef MESOSCALE
    455455!        Initialize names and timestep for chemistry
    456456!        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    … …  
    463463               stop
    464464            endif
    465 
    466             allocate(dycchi(ngrid,nlayer,nkim)) ! only for chemical tracers
    467            
     465           
    468466            ! Chemistry timestep
    469467            ctimestep = ptimestep*REAL(ichim)
    … …  
    482480
    483481         ENDIF
     482#endif
    484483
    485484#ifdef CPP_XIOS
    … …  
    492491!        ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    493492#ifndef MESOSCALE
    494          call phyetat0(startphy_file,ngrid,nlayer,"startfi.nc",0,0,nsoilmx,nq,      &
     493         call phyetat0(startphy_file,                                 &
     494                       ngrid,nlayer,"startfi.nc",0,0,nsoilmx,nq,      &
    495495                       day_ini,time_phys,tsurf,tsoil,emis,q2,qsurf,tankCH4)                       
    496496#else
    … …  
    498498         q2(:,:)=0.0
    499499         qsurf(:,:)=0.0
     500         tankCH4(:)=0.0
    500501         day_ini = pday
    501502#endif
    … …  
    534535         call iniorbit(apoastr,periastr,year_day,peri_day,obliquit)
    535536
     537
    536538         if(tlocked)then
    537539            print*,'Planet is tidally locked at resonance n=',nres
    … …  
    576578
    577579#ifndef MESOSCALE
    578          if (ngrid.ne.1) then
    579             ! Note : no need to create a restart file in 1d.
     580         if (ngrid.ne.1) then ! Note : no need to create a restart file in 1d.
    580581            call physdem0("restartfi.nc",longitude,latitude,nsoilmx,ngrid,nlayer,nq, &
    581                           ptimestep,pday+nday,time_phys,cell_area,          &
    582                           albedo_bareground,inertiedat,zmea,zstd,zsig,zgam,zthe)
    583          endif
    584 #endif
     582                         ptimestep,pday+nday,time_phys,cell_area,          &
     583                         albedo_bareground,inertiedat,zmea,zstd,zsig,zgam,zthe)
     584         endif
     585#endif         
    585586         
    586587         ! XIOS outputs
    … …  
    624625         call stellarlong(zday,zls)
    625626      else
    626          call stellarlong(float(day_ini),zls)
     627         call stellarlong(noseason_day,zls)
    627628      end if
    628629
    … …  
    686687      ! JVO 19 : We shall always have correct altitudes in chemistry no matter what's in physics
    687688      ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
     689#ifndef MESOSCALE
    688690      if (moyzon_ch) then ! Zonal averages
    689691         
    … …  
    716718
    717719      else !  if not moyzon
     720#endif
    718721     
    719722        DO ig=1,ngrid
    … …  
    730733        ENDDO
    731734
     735#ifndef MESOSCALE
    732736      endif  ! moyzon
     737#endif
    733738
    734739      ! -------------------------------------------------------------------------------------
    … …  
    10281033      if (tracer) then
    10291034
     1035
     1036#ifndef MESOSCALE
     1037!! JVO 20 : For now, no chemistry or microphysics in MESOSCALE, but why not in the future ?
     1038
    10301039  ! -------------------
    10311040  !   V.1 Microphysics
    … …  
    11951204           
    11961205         endif ! end of 'callchim'
     1206
     1207#endif
    11971208
    11981209  ! ---------------

  • trunk/LMDZ.TITAN/libf/phytitan/radcommon_h.F90

    r2133 r2366  
    11module radcommon_h
    2       use radinc_h, only: L_NSPECTI, L_NSPECTV, NTstar, NTstop
     2      use radinc_h, only: L_NSPECTI, L_NSPECTV, NTstart, NTstop
    33      implicit none
    44
    … …  
    7878      REAL,SAVE :: tstellar ! Stellar brightness temperature (SW)
    7979
    80       real*8,save :: planckir(L_NSPECTI,NTstop-NTstar+1)
     80      REAL*8, DIMENSION(:,:), ALLOCATABLE, SAVE :: planckir
    8181
    8282      real*8,save :: PTOP

  • trunk/LMDZ.TITAN/libf/phytitan/radinc_h.F90

    r2050 r2366  
    7272
    7373      ! For Planck function integration:
    74       ! equivalent temperatures are 1/NTfac of these values
    75       integer, parameter :: NTstar = 500
    76       integer, parameter :: NTstop = 15000 ! new default for all non hot Jupiter runs
    77       real*8, parameter :: NTfac = 1.0D+1 
    78       !integer, parameter :: NTstar = 1000
    79       !integer, parameter :: NTstop = 25000
    80       !real*8,parameter :: NTfac = 5.0D+1   
    81       !integer, parameter :: NTstar = 2000
    82       !integer, parameter :: NTstop = 50000
    83       !real*8,parameter :: NTfac = 1.0D+2   
     74      ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
     75      ! Integration boundary temperatures are NTstart/NTfac and Ntstop/NTfac
     76      ! -- JVO 20 : Now read boundary T and integration dT as inputs in callphys.def
     77      !             NTstart, Nstop and NTfac then set by ini_radinc_h
     78      !             Smart user can adjust values depending he's running hot or cold atm
     79      !             Default is wide range : 30K-1500K, with 0.1K step
     80      !             ->  NTstart=300, Nstop=15000, NTfac=10
     81      integer :: NTstart, NTstop
     82      real*8  :: NTfac
     83
    8484
    8585contains
    8686
    87   subroutine ini_radinc_h(nbp_lev)
     87  subroutine ini_radinc_h(nbp_lev,tplanckmin,tplanckmax,dtplanck)
    8888  ! Initialize module variables
    8989  implicit none
    9090  integer,intent(in) :: nbp_lev
     91  real*8, intent(in) :: tplanckmin
     92  real*8, intent(in) :: tplanckmax
     93  real*8, intent(in) :: dtplanck
    9194 
    9295  L_NLAYRAD = nbp_lev
    93   L_LEVELS = 2*(nbp_lev-1)+3
     96  L_LEVELS  = 2*(nbp_lev-1)+3
    9497  L_NLEVRAD = nbp_lev+1
    95  
     98
     99  NTfac   = 1.D0 / dtplanck
     100  NTstart = int(tplanckmin * NTfac)
     101  NTstop  = int(tplanckmax * NTfac)
     102 
    96103  end subroutine
    97104

  • trunk/LMDZ.TITAN/libf/phytitan/setspi.F90

    r1897 r2366  
    2222!==================================================================
    2323
    24       use radinc_h,    only: L_NSPECTI,NTstar,NTstop,NTfac
     24      use radinc_h,    only: L_NSPECTI,NTstart,NTstop,NTfac
    2525      use radcommon_h, only: BWNI,WNOI,DWNI,WAVEI,planckir,sigma
    2626      use datafile_mod, only: datadir, corrkdir, banddir
    … …  
    151151      print*,''
    152152      print*,'setspi: Current Planck integration range:'
    153       print*,'T = ',dble(NTstar)/NTfac, ' to ',dble(NTstop)/NTfac,' K.'
     153      print*,'T = ',dble(NTstart)/NTfac, ' to ',dble(NTstop)/NTfac,' K.'
     154
     155      IF(.NOT.ALLOCATED(planckir)) ALLOCATE(planckir(L_NSPECTI,NTstop-NTstart+1))
    154156
    155157      do NW=1,L_NSPECTI
    … …  
    158160         bpa = (b+a)/2.0D0
    159161         bma = (b-a)/2.0D0
    160          do nt=NTstar,NTstop
     162         do nt=NTstart,NTstop
    161163            T   = dble(NT)/NTfac
    162164            ans = 0.0D0
    … …  
    167169            end do
    168170
    169             planckir(NW,nt-NTstar+1) = ans*bma/(PI*DWNI(NW))
     171            planckir(NW,nt-NTstart+1) = ans*bma/(PI*DWNI(NW))
    170172         end do
    171173      end do
    … …  
    174176      if(forceEC)then
    175177         print*,'setspi: Force F=sigma*eps*T^4 for all values of T!'
    176          do nt=NTstar,NTstop
     178         do nt=NTstart,NTstop
    177179            plancksum=0.0D0
    178180            T=dble(NT)/NTfac
    … …  
    180182            do NW=1,L_NSPECTI
    181183               plancksum=plancksum+  &
    182                   planckir(NW,nt-NTstar+1)*DWNI(NW)*pi
     184                  planckir(NW,nt-NTstart+1)*DWNI(NW)*pi
    183185            end do
    184186
    185187            do NW=1,L_NSPECTI
    186                planckir(NW,nt-NTstar+1)=     &
    187                   planckir(NW,nt-NTstar+1)*  &
     188               planckir(NW,nt-NTstart+1)=     &
     189                  planckir(NW,nt-NTstart+1)*  &
    188190                          sigma*(dble(nt)/NTfac)**4/plancksum
    189191            end do
    … …  
    194196         ! check energy conservation at lower temperature boundary
    195197         plancksum=0.0D0
    196          nt=NTstar
     198         nt=NTstart
    197199         do NW=1,L_NSPECTI
    198             plancksum=plancksum+planckir(NW,nt-NTstar+1)*DWNI(NW)*pi
     200            plancksum=plancksum+planckir(NW,nt-NTstart+1)*DWNI(NW)*pi
    199201         end do
    200202         print*,'setspi: At lower limit:'
    … …  
    206208         nt=NTstop
    207209         do NW=1,L_NSPECTI
    208             plancksum=plancksum+planckir(NW,nt-NTstar+1)*DWNI(NW)*pi
     210            plancksum=plancksum+planckir(NW,nt-NTstart+1)*DWNI(NW)*pi
    209211         end do
    210212         print*,'setspi: At upper limit:'

  • trunk/LMDZ.TITAN/libf/phytitan/sfluxi.F

    r2095 r2366  
    6767      TSURF = TLEV(L_LEVELS)
    6868
    69       NTS   = int(TSURF*NTfac)-NTstar+1
    70       NTT   = int(TTOP *NTfac)-NTstar+1
     69      NTS   = int(TSURF*NTfac)-NTstart+1
     70      NTT   = int(TTOP *NTfac)-NTstart+1
    7171
    7272!JL12 corrects the surface planck function so that its integral is equal to sigma Tsurf^4
Note: See TracChangeset for help on using the changeset viewer.