Ignore:
Timestamp:
Apr 9, 2009, 12:11:35 PM (16 years ago)
Author:
Laurent Fairhead
Message:

Réintegration dans le tronc des modifications issues de la branche LMDZ-dev
comprises entre la révision 1074 et 1145
Validation: une simulation de 1 jour en séquentiel sur PC donne les mêmes
résultats entre la trunk et la dev
LF

Location:
LMDZ4/trunk
Files:
5 deleted
26 edited
3 copied

Legend:

Unmodified
Added
Removed

  • LMDZ4/trunk

  • LMDZ4/trunk/libf/dyn3d/addfi.F

    r524 r1146  
    22! $Header$
    33!
    4       SUBROUTINE addfi(nq, pdt, leapf, forward,
     4      SUBROUTINE addfi(pdt, leapf, forward,
    55     S          pucov, pvcov, pteta, pq   , pps ,
    66     S          pdufi, pdvfi, pdhfi,pdqfi, pdpfi  )
     7
     8      USE infotrac, ONLY : nqtot
    79      IMPLICIT NONE
    810c
    … …  
    5254c    -----------
    5355c
    54       INTEGER nq
    55 
    5656      REAL pdt
    5757c
    5858      REAL pvcov(ip1jm,llm),pucov(ip1jmp1,llm)
    59       REAL pteta(ip1jmp1,llm),pq(ip1jmp1,llm,nq),pps(ip1jmp1)
     59      REAL pteta(ip1jmp1,llm),pq(ip1jmp1,llm,nqtot),pps(ip1jmp1)
    6060c
    6161      REAL pdvfi(ip1jm,llm),pdufi(ip1jmp1,llm)
    62       REAL pdqfi(ip1jmp1,llm,nq),pdhfi(ip1jmp1,llm),pdpfi(ip1jmp1)
     62      REAL pdqfi(ip1jmp1,llm,nqtot),pdhfi(ip1jmp1,llm),pdpfi(ip1jmp1)
    6363c
    6464      LOGICAL leapf,forward
    … …  
    125125      ENDDO
    126126
    127       DO iq = 3, nq
     127      DO iq = 3, nqtot
    128128         DO k = 1,llm
    129129            DO j = 1,ip1jmp1
    … …  
    148148
    149149
    150       DO iq = 1, nq
     150      DO iq = 1, nqtot
    151151        DO  k    = 1, llm
    152152          DO  ij   = 1, iim

  • LMDZ4/trunk/libf/dyn3d/advtrac.F

    r960 r1146  
    1515c            M.A Filiberti (04/2002)
    1616c
     17      USE infotrac
     18
    1719      IMPLICIT NONE
    1820c
    … …  
    2830#include "ener.h"
    2931#include "description.h"
    30 #include "advtrac.h"
    3132
    3233c-------------------------------------------------------------------
    … …  
    3940      INTEGER iapptrac
    4041      REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
    41       REAL q(ip1jmp1,llm,nqmx),masse(ip1jmp1,llm)
     42      REAL q(ip1jmp1,llm,nqtot),masse(ip1jmp1,llm)
    4243      REAL p( ip1jmp1,llmp1 ),teta(ip1jmp1,llm)
    4344      REAL pk(ip1jmp1,llm)
    … …  
    5253      REAL pbarug(ip1jmp1,llm),pbarvg(ip1jm,llm),wg(ip1jmp1,llm)
    5354      REAL (kind=kind(1.d0)) :: t_initial, t_final, tps_cpu
    54       real cpuadv(nqmx)
    55       common/cpuadv/cpuadv
    56 
    5755      INTEGER iadvtr
    5856      INTEGER ij,l,iq,iiq
    … …  
    6967      REAL psppm(iim,jjp1) ! pression  au sol
    7068      REAL unatppm(iim,jjp1,llm),vnatppm(iim,jjp1,llm)
    71       REAL qppm(iim*jjp1,llm,nqmx)
     69      REAL qppm(iim*jjp1,llm,nqtot)
    7270      REAL fluxwppm(iim,jjp1,llm)
    7371      REAL apppm(llmp1), bpppm(llmp1)
    … …  
    153151c     Appel des sous programmes d'advection
    154152c-----------------------------------------------------------
    155       do iq=1,nqmx
     153      do iq=1,nqtot
    156154c        call clock(t_initial)
    157155        if(iadv(iq) == 0) cycle

  • LMDZ4/trunk/libf/dyn3d/caladvtrac.F

    r960 r1146  
    88     *                   flxw, pk)
    99c
     10      USE infotrac
    1011      IMPLICIT NONE
    1112c
    … …  
    2425#include "comconst.h"
    2526#include "control.h"
    26 #include "advtrac.h"
    2727
    2828c   Arguments:
    2929c   ----------
    3030      REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm),masse(ip1jmp1,llm)
    31       REAL p( ip1jmp1,llmp1),q( ip1jmp1,llm,nqmx),dq( ip1jmp1,llm,2 )
     31      REAL p( ip1jmp1,llmp1),q( ip1jmp1,llm,nqtot),dq( ip1jmp1,llm,2 )
    3232      REAL teta( ip1jmp1,llm),pk( ip1jmp1,llm)
    3333      REAL               :: flxw(ip1jmp1,llm)

  • LMDZ4/trunk/libf/dyn3d/calfis.F

    r960 r1146  
    44C
    55C
    6       SUBROUTINE calfis(nq,
    7      $                  lafin,
     6      SUBROUTINE calfis(lafin,
    87     $                  rdayvrai,
    98     $                  heure,
    … …  
    3231c    Auteur :  P. Le Van, F. Hourdin
    3332c   .........
     33      USE infotrac
    3434
    3535      IMPLICIT NONE
    … …  
    9090#include "paramet.h"
    9191#include "temps.h"
    92 #include "advtrac.h"
    93 
    94       INTEGER ngridmx,nq
     92
     93      INTEGER ngridmx
    9594      PARAMETER( ngridmx = 2+(jjm-1)*iim - 1/jjm   )
    9695
    … …  
    109108      REAL pteta(iip1,jjp1,llm)
    110109      REAL pmasse(iip1,jjp1,llm)
    111       REAL pq(iip1,jjp1,llm,nqmx)
     110      REAL pq(iip1,jjp1,llm,nqtot)
    112111      REAL pphis(iip1,jjp1)
    113112      REAL pphi(iip1,jjp1,llm)
    … …  
    116115      REAL pducov(iip1,jjp1,llm)
    117116      REAL pdteta(iip1,jjp1,llm)
    118       REAL pdq(iip1,jjp1,llm,nqmx)
     117      REAL pdq(iip1,jjp1,llm,nqtot)
    119118c
    120119      REAL pps(iip1,jjp1)
    … …  
    125124      REAL pdufi(iip1,jjp1,llm)
    126125      REAL pdhfi(iip1,jjp1,llm)
    127       REAL pdqfi(iip1,jjp1,llm,nqmx)
     126      REAL pdqfi(iip1,jjp1,llm,nqtot)
    128127      REAL pdpsfi(iip1,jjp1)
    129128
    … …  
    142141c
    143142      REAL zufi(ngridmx,llm), zvfi(ngridmx,llm)
    144       REAL ztfi(ngridmx,llm),zqfi(ngridmx,llm,nqmx)
     143      REAL ztfi(ngridmx,llm),zqfi(ngridmx,llm,nqtot)
    145144c
    146145      REAL pcvgu(ngridmx,llm), pcvgv(ngridmx,llm)
    … …  
    148147c
    149148      REAL zdufi(ngridmx,llm),zdvfi(ngridmx,llm)
    150       REAL zdtfi(ngridmx,llm),zdqfi(ngridmx,llm,nqmx)
     149      REAL zdtfi(ngridmx,llm),zdqfi(ngridmx,llm,nqtot)
    151150      REAL zdpsrf(ngridmx)
    152151c
    … …  
    275274c   ---------------
    276275c
    277       DO iq=1,nq
     276      DO iq=1,nqtot
    278277          iiq=niadv(iq)
    279278         DO l=1,llm
    … …  
    444443      CALL physiq (ngridmx,
    445444     .             llm,
    446      .             nq,
    447445     .             debut,
    448446     .             lafin,
    … …  
    505503c   ---------------------
    506504
    507       DO iq=1,nqmx
     505      DO iq=1,nqtot
    508506         DO l=1,llm
    509507            DO i=1,iip1
    … …  
    526524      pdqfi=0.
    527525C
    528       DO iq=1,nq
     526      DO iq=1,nqtot
    529527         iiq=niadv(iq)
    530528         DO l=1,llm

  • LMDZ4/trunk/libf/dyn3d/comdissip.h

    r524 r1146  
    22! $Header$
    33!
    4 c-----------------------------------------------------------------------
    5 c INCLUDE dissip.h
     4!-----------------------------------------------------------------------
     5! INCLUDE comdissip.h
    66
    7       COMMON/comdissip/
    8      $    lstardis,niterdis,coefdis,tetavel,tetatemp,gamdissip
     7      COMMON/comdissip/                                                 &
     8     &    niterdis,coefdis,tetavel,tetatemp,gamdissip
    99
    1010
    11       LOGICAL lstardis
    1211      INTEGER niterdis
    1312
    1413      REAL tetavel,tetatemp,coefdis,gamdissip
    1514
    16 c-----------------------------------------------------------------------
     15!-----------------------------------------------------------------------

  • LMDZ4/trunk/libf/dyn3d/comgeom.h

    r524 r1146  
    22! $Header$
    33!
    4 *CDK comgeom
    5       COMMON/comgeom/
    6      1 cu(ip1jmp1),cv(ip1jm),unscu2(ip1jmp1),unscv2(ip1jm),
    7      2 aire(ip1jmp1),airesurg(ip1jmp1),aireu(ip1jmp1),
    8      3 airev(ip1jm),unsaire(ip1jmp1),apoln,apols,
    9      4 unsairez(ip1jm),airuscv2(ip1jm),airvscu2(ip1jm),
    10      5 aireij1(ip1jmp1),aireij2(ip1jmp1),aireij3(ip1jmp1),
    11      6 aireij4(ip1jmp1),alpha1(ip1jmp1),alpha2(ip1jmp1),
    12      7 alpha3(ip1jmp1),alpha4(ip1jmp1),alpha1p2(ip1jmp1),
    13      8 alpha1p4(ip1jmp1),alpha2p3(ip1jmp1),alpha3p4(ip1jmp1),
    14      9 fext(ip1jm),constang(ip1jmp1),rlatu(jjp1),rlatv(jjm),
    15      1 rlonu(iip1),rlonv(iip1),cuvsurcv(ip1jm),cvsurcuv(ip1jm),
    16      1 cvusurcu(ip1jmp1),cusurcvu(ip1jmp1),cuvscvgam1(ip1jm),
    17      2 cuvscvgam2(ip1jm),cvuscugam1(ip1jmp1),
    18      3 cvuscugam2(ip1jmp1),cvscuvgam(ip1jm),cuscvugam(ip1jmp1),
    19      4 unsapolnga1,unsapolnga2,unsapolsga1,unsapolsga2,
    20      5 unsair_gam1(ip1jmp1),unsair_gam2(ip1jmp1),unsairz_gam(ip1jm),
    21      6 aivscu2gam(ip1jm),aiuscv2gam(ip1jm),xprimu(iip1),xprimv(iip1)
     4!CDK comgeom
     5      COMMON/comgeom/                                                   &
     6     & cu(ip1jmp1),cv(ip1jm),unscu2(ip1jmp1),unscv2(ip1jm),             &
     7     & aire(ip1jmp1),airesurg(ip1jmp1),aireu(ip1jmp1),                  &
     8     & airev(ip1jm),unsaire(ip1jmp1),apoln,apols,                       &
     9     & unsairez(ip1jm),airuscv2(ip1jm),airvscu2(ip1jm),                 &
     10     & aireij1(ip1jmp1),aireij2(ip1jmp1),aireij3(ip1jmp1),              &
     11     & aireij4(ip1jmp1),alpha1(ip1jmp1),alpha2(ip1jmp1),                &
     12     & alpha3(ip1jmp1),alpha4(ip1jmp1),alpha1p2(ip1jmp1),               &
     13     & alpha1p4(ip1jmp1),alpha2p3(ip1jmp1),alpha3p4(ip1jmp1),           &
     14     & fext(ip1jm),constang(ip1jmp1),rlatu(jjp1),rlatv(jjm),            &
     15     & rlonu(iip1),rlonv(iip1),cuvsurcv(ip1jm),cvsurcuv(ip1jm),         &
     16     & cvusurcu(ip1jmp1),cusurcvu(ip1jmp1),cuvscvgam1(ip1jm),           &
     17     & cuvscvgam2(ip1jm),cvuscugam1(ip1jmp1),                           &
     18     & cvuscugam2(ip1jmp1),cvscuvgam(ip1jm),cuscvugam(ip1jmp1),         &
     19     & unsapolnga1,unsapolnga2,unsapolsga1,unsapolsga2,                 &
     20     & unsair_gam1(ip1jmp1),unsair_gam2(ip1jmp1),unsairz_gam(ip1jm),    &
     21     & aivscu2gam(ip1jm),aiuscv2gam(ip1jm),xprimu(iip1),xprimv(iip1)
    2222
    23 c
    24         REAL
    25      1 cu,cv,unscu2,unscv2,aire,airesurg,aireu,airev,unsaire,apoln     ,
    26      2 apols,unsairez,airuscv2,airvscu2,aireij1,aireij2,aireij3,aireij4,
    27      3 alpha1,alpha2,alpha3,alpha4,alpha1p2,alpha1p4,alpha2p3,alpha3p4 ,
    28      4 fext,constang,rlatu,rlatv,rlonu,rlonv,cuvscvgam1,cuvscvgam2     ,
    29      5 cvuscugam1,cvuscugam2,cvscuvgam,cuscvugam,unsapolnga1,unsapolnga2
    30      6 ,unsapolsga1,unsapolsga2,unsair_gam1,unsair_gam2,unsairz_gam    ,
    31      7 aivscu2gam ,aiuscv2gam,cuvsurcv,cvsurcuv,cvusurcu,cusurcvu,xprimu
    32      8 , xprimv
    33 c
     23!
     24        REAL                                                            &
     25     & cu,cv,unscu2,unscv2,aire,airesurg,aireu,airev,unsaire,apoln     ,&
     26     & apols,unsairez,airuscv2,airvscu2,aireij1,aireij2,aireij3,aireij4,&
     27     & alpha1,alpha2,alpha3,alpha4,alpha1p2,alpha1p4,alpha2p3,alpha3p4 ,&
     28     & fext,constang,rlatu,rlatv,rlonu,rlonv,cuvscvgam1,cuvscvgam2     ,&
     29     & cvuscugam1,cvuscugam2,cvscuvgam,cuscvugam,unsapolnga1,unsapolnga2&
     30     & ,unsapolsga1,unsapolsga2,unsair_gam1,unsair_gam2,unsairz_gam    ,&
     31     & aivscu2gam ,aiuscv2gam,cuvsurcv,cvsurcuv,cvusurcu,cusurcvu,xprimu&
     32     & , xprimv
     33!

  • LMDZ4/trunk/libf/dyn3d/conf_gcm.F

    r1046 r1146  
    66      SUBROUTINE conf_gcm( tapedef, etatinit, clesphy0 )
    77c
     8#ifdef CPP_IOIPSL
    89      use IOIPSL
     10#else
     11! if not using IOIPSL, we still need to use (a local version of) getin
     12      use ioipsl_getincom
     13#endif
    914      IMPLICIT NONE
    1015c-----------------------------------------------------------------------
    … …  
    99104c  Parametres de controle du run:
    100105c-----------------------------------------------------------------------
     106!Config  Key  = planet_type
     107!Config  Desc = planet type ("earth", "mars", "venus", ...)
     108!Config  Def  = earth
     109!Config  Help = this flag sets the type of atymosphere that is considered
     110      planet_type="earth"
     111      CALL getin('planet_type',planet_type)
    101112
    102113!Config  Key  = dayref
    … …  
    179190       CALL getin('periodav',periodav)
    180191
     192!Config  Key  = output_grads_dyn
     193!Config  Desc = output dynamics diagnostics in 'dyn.dat' file
     194!Config  Def  = n
     195!Config  Help = output dynamics diagnostics in Grads-readable 'dyn.dat' file
     196       output_grads_dyn=.false.
     197       CALL getin('output_grads_dyn',output_grads_dyn)
     198
    181199!Config  Key  = idissip
    182200!Config  Desc = periode de la dissipation
    … …  
    274292c    ...............................................................
    275293
     294!Config  Key  =  read_start
     295!Config  Desc = Initialize model using a 'start.nc' file
     296!Config  Def  = y
     297!Config  Help = y: intialize dynamical fields using a 'start.nc' file
     298!               n: fields are initialized by 'iniacademic' routine
     299       read_start= .true.
     300       CALL getin('read_start',read_start)
     301
    276302!Config  Key  = iflag_phys
    277303!Config  Desc = Avec ls physique
    … …  
    330356c
    331357      IF( ABS(clat - clatt).GE. 0.001 )  THEN
    332         PRINT *,' La valeur de clat passee par run.def est differente de
    333      * celle lue sur le fichier  start '
     358        write(lunout,*)'conf_gcm: La valeur de clat passee par run.def',
     359     &    ' est differente de celle lue sur le fichier  start '
    334360        STOP
    335361      ENDIF
    … …  
    345371
    346372      IF( ABS(grossismx - grossismxx).GE. 0.001 )  THEN
    347         PRINT *,' La valeur de grossismx passee par run.def est differente 
    348      * de celle lue sur le fichier  start '
     373        write(lunout,*)'conf_gcm: La valeur de grossismx passee par ',
     374     &  'run.def est differente de celle lue sur le fichier  start '
    349375        STOP
    350376      ENDIF
    … …  
    359385
    360386      IF( ABS(grossismy - grossismyy).GE. 0.001 )  THEN
    361         PRINT *,' La valeur de grossismy passee par run.def est differen
    362      * te de celle lue sur le fichier  start '
     387        write(lunout,*)'conf_gcm: La valeur de grossismy passee par ',
     388     & 'run.def est differente de celle lue sur le fichier  start '
    363389        STOP
    364390      ENDIF
    365391     
    366392      IF( grossismx.LT.1. )  THEN
    367         PRINT *,' ***  ATTENTION !! grossismx < 1 .   *** '
     393        write(lunout,*)
     394     &       'conf_gcm: ***  ATTENTION !! grossismx < 1 .   *** '
    368395         STOP
    369396      ELSE
    … …  
    373400
    374401      IF( grossismy.LT.1. )  THEN
    375         PRINT *,' ***  ATTENTION !! grossismy < 1 .   *** '
     402        write(lunout,*)
     403     &       'conf_gcm: ***  ATTENTION !! grossismy < 1 .   *** '
    376404         STOP
    377405      ELSE
    … …  
    379407      ENDIF
    380408
    381       PRINT *,' alphax alphay defrun ',alphax,alphay
     409      write(lunout,*)'conf_gcm: alphax alphay',alphax,alphay
    382410c
    383411c    alphax et alphay sont les anciennes formulat. des grossissements
    … …  
    394422
    395423      IF( .NOT.fxyhypb )  THEN
    396            IF( fxyhypbb )     THEN
    397               PRINT *,' ********  PBS DANS  DEFRUN  ******** '
    398               PRINT *,' *** fxyhypb lu sur le fichier start est F ',
    399      *       'alors  qu il est  T  sur  run.def  ***'
     424         IF( fxyhypbb )     THEN
     425            write(lunout,*)' ********  PBS DANS  CONF_GCM  ******** '
     426            write(lunout,*)' *** fxyhypb lu sur le fichier start est ',
     427     *       'F alors  qu il est  T  sur  run.def  ***'
    400428              STOP
    401            ENDIF
     429         ENDIF
    402430      ELSE
    403            IF( .NOT.fxyhypbb )   THEN
    404               PRINT *,' ********  PBS DANS  DEFRUN  ******** '
    405               PRINT *,' ***  fxyhypb lu sur le fichier start est T ',
    406      *        'alors  qu il est  F  sur  run.def  ****  '
     431         IF( .NOT.fxyhypbb )   THEN
     432            write(lunout,*)' ********  PBS DANS  CONF_GCM  ******** '
     433            write(lunout,*)' ***  fxyhypb lu sur le fichier start est ',
     434     *        'T alors  qu il est  F  sur  run.def  ****  '
    407435              STOP
    408            ENDIF
     436         ENDIF
    409437      ENDIF
    410438c
    … …  
    419447      IF( fxyhypb )  THEN
    420448       IF( ABS(dzoomx - dzoomxx).GE. 0.001 )  THEN
    421         PRINT *,' La valeur de dzoomx passee par run.def est differente
    422      *  de celle lue sur le fichier  start '
     449        write(lunout,*)'conf_gcm: La valeur de dzoomx passee par ',
     450     *  'run.def est differente de celle lue sur le fichier  start '
    423451        STOP
    424452       ENDIF
    … …  
    435463      IF( fxyhypb )  THEN
    436464       IF( ABS(dzoomy - dzoomyy).GE. 0.001 )  THEN
    437         PRINT *,' La valeur de dzoomy passee par run.def est differente
    438      * de celle lue sur le fichier  start '
     465        write(lunout,*)'conf_gcm: La valeur de dzoomy passee par ',
     466     * 'run.def est differente de celle lue sur le fichier  start '
    439467        STOP
    440468       ENDIF
    … …  
    450478      IF( fxyhypb )  THEN
    451479       IF( ABS(taux - tauxx).GE. 0.001 )  THEN
    452         PRINT *,' La valeur de taux passee par run.def est differente
    453      * de celle lue sur le fichier  start '
     480        write(lunout,*)'conf_gcm: La valeur de taux passee par ',
     481     * 'run.def est differente de celle lue sur le fichier  start '
    454482        STOP
    455483       ENDIF
    … …  
    465493      IF( fxyhypb )  THEN
    466494       IF( ABS(tauy - tauyy).GE. 0.001 )  THEN
    467         PRINT *,' La valeur de tauy passee par run.def est differente
    468      * de celle lue sur le fichier  start '
     495        write(lunout,*)'conf_gcm: La valeur de tauy passee par ',
     496     * 'run.def est differente de celle lue sur le fichier  start '
    469497        STOP
    470498       ENDIF
    … …  
    484512
    485513        IF( .NOT.ysinus )  THEN
    486            IF( ysinuss )     THEN
    487               PRINT *,' ********  PBS DANS  DEFRUN  ******** '
    488               PRINT *,' *** ysinus lu sur le fichier start est F ',
    489      *       'alors  qu il est  T  sur  run.def  ***'
     514          IF( ysinuss )     THEN
     515            write(lunout,*)' ********  PBS DANS  CONF_GCM  ******** '
     516            write(lunout,*)' *** ysinus lu sur le fichier start est F',
     517     *       ' alors  qu il est  T  sur  run.def  ***'
     518            STOP
     519          ENDIF
     520        ELSE
     521          IF( .NOT.ysinuss )   THEN
     522            write(lunout,*)' ********  PBS DANS  CONF_GCM  ******** '
     523            write(lunout,*)' *** ysinus lu sur le fichier start est T',
     524     *        ' alors  qu il est  F  sur  run.def  ****  '
    490525              STOP
    491            ENDIF
    492         ELSE
    493            IF( .NOT.ysinuss )   THEN
    494               PRINT *,' ********  PBS DANS  DEFRUN  ******** '
    495               PRINT *,' ***  ysinus lu sur le fichier start est T ',
    496      *        'alors  qu il est  F  sur  run.def  ****  '
    497               STOP
    498            ENDIF
     526          ENDIF
    499527        ENDIF
    500       ENDIF
     528      ENDIF ! of IF( .NOT.fxyhypb  )
    501529c
    502530!Config  Key  = offline
    … …  
    519547
    520548
     549!Config  Key  = ok_dynzon
     550!Config  Desc = calcul et sortie des transports
     551!Config  Def  = n
     552!Config  Help = Permet de mettre en route le calcul des transports
     553!Config         
     554      ok_dynzon = .FALSE.
     555      CALL getin('ok_dynzon',ok_dynzon)
     556
    521557      write(lunout,*)' #########################################'
    522558      write(lunout,*)' Configuration des parametres du gcm: '
     559      write(lunout,*)' planet_type = ', planet_type
    523560      write(lunout,*)' dayref = ', dayref
    524561      write(lunout,*)' anneeref = ', anneeref
    … …  
    529566      write(lunout,*)' iecri = ', iecri
    530567      write(lunout,*)' periodav = ', periodav
     568      write(lunout,*)' output_grads_dyn = ', output_grads_dyn
    531569      write(lunout,*)' idissip = ', idissip
    532570      write(lunout,*)' lstardis = ', lstardis
    … …  
    539577      write(lunout,*)' coefdis = ', coefdis
    540578      write(lunout,*)' purmats = ', purmats
     579      write(lunout,*)' read_start = ', read_start
    541580      write(lunout,*)' iflag_phys = ', iflag_phys
    542581      write(lunout,*)' iphysiq = ', iphysiq
    … …  
    552591      write(lunout,*)' offline = ', offline
    553592      write(lunout,*)' config_inca = ', config_inca
     593      write(lunout,*)' ok_dynzon = ', ok_dynzon
    554594
    555595      RETURN
    … …  
    590630
    591631      IF( grossismx.LT.1. )  THEN
    592         PRINT *,' ***  ATTENTION !! grossismx < 1 .   *** '
     632        write(lunout,*)
     633     &   'conf_gcm: ***  ATTENTION !! grossismx < 1 .   *** '
    593634         STOP
    594635      ELSE
    … …  
    598639
    599640      IF( grossismy.LT.1. )  THEN
    600         PRINT *,' ***  ATTENTION !! grossismy < 1 .   *** '
     641        write(lunout,*)
     642     &  'conf_gcm: ***  ATTENTION !! grossismy < 1 .   *** '
    601643         STOP
    602644      ELSE
    … …  
    604646      ENDIF
    605647
    606       PRINT *,' alphax alphay defrun ',alphax,alphay
     648      write(lunout,*)'conf_gcm: alphax alphay ',alphax,alphay
    607649c
    608650c    alphax et alphay sont les anciennes formulat. des grossissements
    … …  
    675717      CALL getin('config_inca',config_inca)
    676718
     719!Config  Key  = ok_dynzon
     720!Config  Desc = calcul et sortie des transports
     721!Config  Def  = n
     722!Config  Help = Permet de mettre en route le calcul des transports
     723!Config         
     724       ok_dynzon = .FALSE.
     725       CALL getin('ok_dynzon',ok_dynzon)
     726
    677727!Config key = ok_strato
    678728!Config  Desc = activation de la version strato
    … …  
    693743      write(lunout,*)' #########################################'
    694744      write(lunout,*)' Configuration des parametres du gcm: '
     745      write(lunout,*)' planet_type = ', planet_type
    695746      write(lunout,*)' dayref = ', dayref
    696747      write(lunout,*)' anneeref = ', anneeref
    … …  
    701752      write(lunout,*)' iecri = ', iecri
    702753      write(lunout,*)' periodav = ', periodav
     754      write(lunout,*)' output_grads_dyn = ', output_grads_dyn
    703755      write(lunout,*)' idissip = ', idissip
    704756      write(lunout,*)' lstardis = ', lstardis
    … …  
    711763      write(lunout,*)' coefdis = ', coefdis
    712764      write(lunout,*)' purmats = ', purmats
     765      write(lunout,*)' read_start = ', read_start
    713766      write(lunout,*)' iflag_phys = ', iflag_phys
    714767      write(lunout,*)' iphysiq = ', iphysiq
    715       write(lunout,*)' clonn = ', clonn
    716       write(lunout,*)' clatt = ', clatt
     768      write(lunout,*)' clon = ', clon
     769      write(lunout,*)' clat = ', clat
    717770      write(lunout,*)' grossismx = ', grossismx
    718771      write(lunout,*)' grossismy = ', grossismy
    719       write(lunout,*)' fxyhypbb = ', fxyhypbb
     772      write(lunout,*)' fxyhypb = ', fxyhypb
    720773      write(lunout,*)' dzoomx = ', dzoomx
    721774      write(lunout,*)' dzoomy = ', dzoomy
    … …  
    724777      write(lunout,*)' offline = ', offline
    725778      write(lunout,*)' config_inca = ', config_inca
     779      write(lunout,*)' ok_dynzon = ', ok_dynzon
    726780      write(lunout,*)' ok_strato = ', ok_strato
    727781      write(lunout,*)' ok_gradsfile = ', ok_gradsfile

  • LMDZ4/trunk/libf/dyn3d/control.h

    r962 r1146  
    1414     &              iperiod,iapp_tracvl,iconser,iecri,idissip,iphysiq , &
    1515     &              periodav,iecrimoy,dayref,anneeref,                  &
    16      &              raz_date,offline,ip_ebil_dyn,config_inca
     16     &              raz_date,offline,ip_ebil_dyn,config_inca,           &
     17     &              planet_type,output_grads_dyn,ok_dynzon
    1718
    1819      INTEGER   nday,day_step,iperiod,iapp_tracvl,iconser,iecri,        &
    … …  
    2021     &          ,ip_ebil_dyn
    2122      REAL periodav
    22       logical offline
     23      LOGICAL offline
    2324      CHARACTER (len=4) :: config_inca
     25      CHARACTER(len=10) :: planet_type ! planet type ('earth','mars',...)
     26      LOGICAL :: output_grads_dyn ! output dynamics diagnostics in
     27                                  ! binary grads file 'dyn.dat' (y/n)
     28      LOGICAL :: ok_dynzon
    2429!-----------------------------------------------------------------------

  • LMDZ4/trunk/libf/dyn3d/create_etat0_limit.F

    r1016 r1146  
    55       USE dimphy
    66       USE comgeomphy
    7 
     7       USE infotrac
    88c
    99c
    … …  
    2828#include "paramet.h"
    2929#include "indicesol.h"
    30 #include "advtrac.h"
    3130#include  "control.h"
    3231      REAL :: masque(iip1,jjp1)
    3332!      REAL :: pctsrf(iim*(jjm-1)+2, nbsrf)
    3433
    35 c initialisation traceurs
    36       hadv_flg(:) = 0.
    37       vadv_flg(:) = 0.
    38       conv_flg(:) = 0.
    39       pbl_flg(:)  = 0.
    40       tracnam(:)  = '        '
    41       nprath = 1
    42       nbtrac = 0
    43       mmt_adj(:,:,:,:) = 1
    44 
    4534      IF (config_inca /= 'none') THEN
    4635#ifdef INCA
    4736         call init_const_lmdz(
    48      $        nbtrac,anneeref,dayref,
     37     $        nbtr,anneeref,dayref,
    4938     $        iphysiq, day_step,nday)
    5039#endif
    51          print *, 'nbtrac =' , nbtrac
     40         print *, 'nbtr =' , nbtr
    5241      END IF
    5342
    54       CALL Init_Phys_lmdz(iim,jjp1,llm,nqmx-2,1,(jjm-1)*iim+2)
     43      CALL Init_Phys_lmdz(iim,jjp1,llm,1,(jjm-1)*iim+2)
    5544      call InitComgeomphy
    5645

  • LMDZ4/trunk/libf/dyn3d/diagedyn.F

    r524 r1146  
    5858#include "paramet.h"
    5959#include "comgeom.h"
    60 
    61 #ifdef CPP_PHYS
     60#include "iniprint.h"
     61
     62#ifdef CPP_EARTH
    6263#include "../phylmd/YOMCST.h"
    6364#include "../phylmd/YOETHF.h"
    … …  
    139140
    140141
    141 #ifdef CPP_PHYS
     142#ifdef CPP_EARTH
    142143c======================================================================
    143144C     Compute Kinetic enrgy
    … …  
    314315C
    315316#else
    316       print*,'Pour l instant diagedyn a besoin de la physique'
     317      write(lunout,*),'diagedyn: Needs Earth physics to function'
    317318#endif
     319! #endif of #ifdef CPP_EARTH
    318320      RETURN
    319321      END

  • LMDZ4/trunk/libf/dyn3d/dynetat0.F

    r541 r1146  
    22! $Header$
    33!
    4       SUBROUTINE dynetat0(fichnom,nq,vcov,ucov,
     4      SUBROUTINE dynetat0(fichnom,vcov,ucov,
    55     .                    teta,q,masse,ps,phis,time)
     6
     7      USE infotrac
    68      IMPLICIT NONE
    79
    … …  
    3234#include "serre.h"
    3335#include "logic.h"
    34 #include "advtrac.h"
    3536
    3637c   Arguments:
    … …  
    3839
    3940      CHARACTER*(*) fichnom
    40       INTEGER nq
    4141      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
    42       REAL q(ip1jmp1,llm,nq),masse(ip1jmp1,llm)
     42      REAL q(ip1jmp1,llm,nqtot),masse(ip1jmp1,llm)
    4343      REAL ps(ip1jmp1),phis(ip1jmp1)
    4444
    … …  
    315315
    316316
    317       IF(nq.GE.1) THEN
    318       DO iq=1,nq
     317      IF(nqtot.GE.1) THEN
     318      DO iq=1,nqtot
    319319        ierr =  NF_INQ_VARID (nid, tname(iq), nvarid)
    320320        IF (ierr .NE. NF_NOERR) THEN

  • LMDZ4/trunk/libf/dyn3d/dynredem.F

    r960 r1146  
    33!
    44c
    5       SUBROUTINE dynredem0(fichnom,iday_end,phis,nq)
     5      SUBROUTINE dynredem0(fichnom,iday_end,phis)
    66      USE IOIPSL
     7      USE infotrac
    78      IMPLICIT NONE
    89c=======================================================================
    … …  
    2223#include "description.h"
    2324#include "serre.h"
    24 #include "advtrac.h"
    2525
    2626c   Arguments:
    … …  
    2929      REAL phis(ip1jmp1)
    3030      CHARACTER*(*) fichnom
    31       INTEGER nq
    3231
    3332c   Local:
    … …  
    458457      dims4(3) = idim_s
    459458      dims4(4) = idim_tim
    460       IF(nq.GE.1) THEN
    461       DO iq=1,nq
     459      IF(nqtot.GE.1) THEN
     460      DO iq=1,nqtot
    462461cIM 220306 BEG
    463462#ifdef NC_DOUBLE
    … …  
    508507      END
    509508      SUBROUTINE dynredem1(fichnom,time,
    510      .                     vcov,ucov,teta,q,nq,masse,ps)
     509     .                     vcov,ucov,teta,q,masse,ps)
     510      USE infotrac
    511511      IMPLICIT NONE
    512512c=================================================================
    … …  
    519519#include "comvert.h"
    520520#include "comgeom.h"
    521 #include "advtrac.h"
    522521#include "temps.h"
    523522#include "control.h"
    524523
    525       INTEGER nq, l
     524      INTEGER l
    526525      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm)
    527526      REAL teta(ip1jmp1,llm)                   
    528527      REAL ps(ip1jmp1),masse(ip1jmp1,llm)                   
    529       REAL q(ip1jmp1,llm,nq)
     528      REAL q(ip1jmp1,llm,nqtot)
    530529      CHARACTER*(*) fichnom
    531530     
    … …  
    633632      END IF
    634633
    635       IF(nq.GE.1) THEN
    636       do iq=1,nq
     634      IF(nqtot.GE.1) THEN
     635      do iq=1,nqtot
    637636
    638637         IF (config_inca == 'none') THEN

  • LMDZ4/trunk/libf/dyn3d/etat0_netcdf.F

    r1058 r1146  
    55c
    66      SUBROUTINE etat0_netcdf (interbar, masque)
    7    
     7#ifdef CPP_EARTH       
    88      USE startvar
    99      USE ioipsl
    1010      USE dimphy
     11      USE infotrac
    1112      USE fonte_neige_mod
    1213      USE pbl_surface_mod
    1314      USE phys_state_var_mod
     15      USE filtreg_mod
     16#endif
     17!#endif of #ifdef CPP_EARTH
    1418      !
    1519      IMPLICIT NONE
    … …  
    2327!     .KLON=KFDIA-KIDIA+1,KLEV=llm
    2428      !
     29#ifdef CPP_EARTH   
    2530#include "comgeom2.h"
    2631#include "comvert.h"
    … …  
    2934#include "dimsoil.h"
    3035#include "temps.h"
    31       !
     36#endif
     37!#endif of #ifdef CPP_EARTH
     38      ! arguments:
    3239      LOGICAL interbar
     40      REAL :: masque(iip1,jjp1)
     41
     42#ifdef CPP_EARTH
     43      ! local variables:
    3344      REAL :: latfi(klon), lonfi(klon)
    34       REAL :: orog(iip1,jjp1), rugo(iip1,jjp1), masque(iip1,jjp1),
    35      . psol(iip1, jjp1), phis(iip1, jjp1)
     45      REAL :: orog(iip1,jjp1), rugo(iip1,jjp1)
     46      REAL :: psol(iip1, jjp1), phis(iip1, jjp1)
    3647      REAL :: p3d(iip1, jjp1, llm+1)
    3748      REAL :: uvent(iip1, jjp1, llm)
    3849      REAL :: vvent(iip1, jjm, llm)
    3950      REAL :: t3d(iip1, jjp1, llm), tpot(iip1, jjp1, llm)
    40       REAL :: q3d(iip1, jjp1, llm,nqmx), qsat(iip1, jjp1, llm)
     51      REAL, ALLOCATABLE, DIMENSION(:,:,:,:) :: q3d
     52      REAL :: qsat(iip1, jjp1, llm)
    4153      REAL :: tsol(klon), qsol(klon), sn(klon)
    4254      REAL :: tsolsrf(klon,nbsrf), qsolsrf(klon,nbsrf),snsrf(klon,nbsrf)
    … …  
    6375      !
    6476      INTEGER :: i,j, ig, l, ji,ii1,ii2
    65       INTEGER :: nq
    6677      REAL :: xpi
    6778      !
    … …  
    141152      !
    142153      preff     = 101325.
     154      pa        =  50000.
    143155      unskap = 1./kappa
    144156      !
    … …  
    164176      print*,'dtvr',dtvr
    165177
    166       CALL inicons0()
     178
     179
     180      CALL iniconst()
    167181      CALL inigeom()
    168       !
     182
     183! Initialisation pour traceurs
     184      CALL infotrac_init
     185      ALLOCATE(q3d(iip1,jjp1,llm,nqtot))
     186
     187
    169188      CALL inifilr()
    170189      CALL phys_state_var_init()
    … …  
    623642      phis(iip1,:) = phis(1,:)
    624643
    625 C init pour traceurs
    626       call iniadvtrac(nq)
    627644C Ecriture
    628645      CALL inidissip( lstardis, nitergdiv, nitergrot, niterh   ,
    … …  
    648665     *                phi,w, pbaru,pbarv,time+iday-dayref   )
    649666       print*,'sortie caldyn0'     
    650       CALL dynredem0("start.nc",dayref,phis,nqmx)
     667      CALL dynredem0("start.nc",dayref,phis)
    651668      print*,'sortie dynredem0'
    652       CALL dynredem1("start.nc",0.0,vvent,uvent,tpot,q3d,nqmx,masse ,
     669      CALL dynredem1("start.nc",0.0,vvent,uvent,tpot,q3d,masse ,
    653670     .                            psol)
    654671      print*,'sortie dynredem1'
    … …  
    741758      visu_file='Etat0_visu.nc'
    742759      CALL initdynav(visu_file,dayref,anneeref,time_step,
    743      .              t_ops, t_wrt, nqmx, visuid)
    744       CALL writedynav(visuid, nqmx, itau,vvent ,
     760     .              t_ops, t_wrt, visuid)
     761      CALL writedynav(visuid, itau,vvent ,
    745762     .                uvent,tpot,pk,phi,q3d,masse,psol,phis)
    746763      else
    … …  
    749766      print*,'entree histclo'
    750767      CALL histclo
     768
     769      DEALLOCATE(q3d)
     770
     771#endif
     772!#endif of #ifdef CPP_EARTH
    751773      RETURN
    752774      !

  • LMDZ4/trunk/libf/dyn3d/fluxstokenc.F

    r697 r1146  
    5656        CALL initfluxsto( 'fluxstoke',
    5757     .  time_step,istdyn* time_step,istdyn* time_step,
    58      . nqmx, fluxid,fluxvid,fluxdid)
     58     . fluxid,fluxvid,fluxdid)
    5959       
    6060        ndex(1) = 0

  • LMDZ4/trunk/libf/dyn3d/gcm.F

    r962 r1146  
    88#ifdef CPP_IOIPSL
    99      USE IOIPSL
    10 #endif
     10#else
     11! if not using IOIPSL, we still need to use (a local version of) getin
     12      USE ioipsl_getincom
     13#endif
     14
     15      USE filtreg_mod
     16      USE infotrac
    1117
    1218!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    … …  
    1420! A nettoyer. On ne veut qu'une ou deux routines d'interface
    1521! dynamique -> physique pour l'initialisation
    16 #ifdef CPP_PHYS
     22! Ehouarn: for now these only apply to Earth:
     23#ifdef CPP_EARTH
    1724      USE dimphy
    1825      USE comgeomphy
    … …  
    6875#include "iniprint.h"
    6976#include "tracstoke.h"
    70 #include "advtrac.h"
    7177
    7278      INTEGER         longcles
    … …  
    8389      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
    8490      REAL teta(ip1jmp1,llm)                 ! temperature potentielle
    85       REAL q(ip1jmp1,llm,nqmx)               ! champs advectes
     91      REAL, ALLOCATABLE, DIMENSION(:,:,:):: q! champs advectes
    8692      REAL ps(ip1jmp1)                       ! pression  au sol
    8793      REAL p (ip1jmp1,llmp1  )               ! pression aux interfac.des couches
    … …  
    137143c    variables pour l'initialisation de la physique :
    138144c    ------------------------------------------------
    139       INTEGER ngridmx,nq
     145      INTEGER ngridmx
    140146      PARAMETER( ngridmx = 2+(jjm-1)*iim - 1/jjm   )
    141147      REAL zcufi(ngridmx),zcvfi(ngridmx)
    … …  
    155161      dynhistave_file = 'dyn_hist_ave.nc'
    156162
    157 c initialisation Anne
    158       hadv_flg(:) = 0.
    159       vadv_flg(:) = 0.
    160       conv_flg(:) = 0.
    161       pbl_flg(:)  = 0.
    162       tracnam(:)  = '        '
    163       nprath = 1
    164       nbtrac = 0
    165       mmt_adj(:,:,:,:) = 1
    166 
    167 
    168 c--------------------------------------------------------------------------
    169 c   Iflag_phys controle l'appel a la physique :
    170 c   -------------------------------------------
    171 c      0 : pas de physique
    172 c      1 : Normale (appel a phylmd, phymars ...)
    173 c      2 : rappel Newtonien pour la temperature + friction au sol
    174       iflag_phys=1
    175 
    176 c--------------------------------------------------------------------------
    177 c   Lecture de l'etat initial :
    178 c   ---------------------------
    179 c     T : on lit start.nc
    180 c     F : le modele s'autoinitialise avec un cas academique (iniacademic)
    181       read_start=.true.
    182 #ifdef CPP_IOIPSL
    183 #else
    184       read_start=.false.
    185 #endif
    186 #ifdef CPP_PHYS
    187 #else
    188       read_start=.false.
    189 #endif
     163
    190164
    191165c-----------------------------------------------------------------------
    … …  
    204178c  ---------------------------------------
    205179c
    206 #ifdef CPP_IOIPSL
     180! Ehouarn: dump possibility of using defrun
     181!#ifdef CPP_IOIPSL
    207182      CALL conf_gcm( 99, .TRUE. , clesphy0 )
    208 #else
    209       CALL defrun( 99, .TRUE. , clesphy0 )
    210 #endif
     183!#else
     184!      CALL defrun( 99, .TRUE. , clesphy0 )
     185!#endif
    211186
    212187!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    … …  
    214189! A nettoyer. On ne veut qu'une ou deux routines d'interface
    215190! dynamique -> physique pour l'initialisation
    216 #ifdef CPP_PHYS
    217       CALL Init_Phys_lmdz(iim,jjp1,llm,nqmx-2,1,(jjm-1)*iim+2)
     191! Ehouarn : temporarily (?) keep this only for Earth
     192      if (planet_type.eq."earth") then
     193#ifdef CPP_EARTH
     194      CALL Init_Phys_lmdz(iim,jjp1,llm,1,(jjm-1)*iim+2)
    218195      call InitComgeomphy
    219196#endif
     197      endif
    220198!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    221199
    222200      IF (config_inca /= 'none') THEN
    223201#ifdef INCA
    224       call init_const_lmdz(nbtrac,anneeref,dayref,iphysiq,day_step,nday)
     202      call init_const_lmdz(nbtr,anneeref,dayref,iphysiq,day_step,nday)
    225203      call init_inca_para(iim,jjm+1,klon,1,klon_mpi_para_nb,0)
    226204#endif
    … …  
    237215c   Initialisation des traceurs
    238216c   ---------------------------
    239 c  Choix du schema pour l'advection
    240 c  dans fichier trac.def ou via INCA
    241 
    242        call iniadvtrac(nq)
    243 c
     217c  Choix du nombre de traceurs et du schema pour l'advection
     218c  dans fichier traceur.def, par default ou via INCA
     219      call infotrac_init
     220
     221c Allocation de la tableau q : champs advectes   
     222      allocate(q(ip1jmp1,llm,nqtot))
     223
    244224c-----------------------------------------------------------------------
    245225c   Lecture de l'etat initial :
    … …  
    248228c  lecture du fichier start.nc
    249229      if (read_start) then
    250 #ifdef CPP_IOIPSL
    251          CALL dynetat0("start.nc",nqmx,vcov,ucov,
     230      ! we still need to run iniacademic to initialize some
     231      ! constants & fields, if we run the 'newtonian' case:
     232        if (iflag_phys.eq.2) then
     233          CALL iniacademic(vcov,ucov,teta,q,masse,ps,phis,time_0)
     234        endif
     235!#ifdef CPP_IOIPSL
     236        if (planet_type.eq."earth") then
     237#ifdef CPP_EARTH
     238! Load an Earth-format start file
     239         CALL dynetat0("start.nc",vcov,ucov,
    252240     .              teta,q,masse,ps,phis, time_0)
     241#endif
     242        endif ! of if (planet_type.eq."earth")
    253243c       write(73,*) 'ucov',ucov
    254244c       write(74,*) 'vcov',vcov
    … …  
    257247c       write(77,*) 'q',q
    258248
    259 #endif
    260       endif
     249      endif ! of if (read_start)
    261250
    262251      IF (config_inca /= 'none') THEN
    … …  
    270259c le cas echeant, creation d un etat initial
    271260      IF (prt_level > 9) WRITE(lunout,*)
    272      .                 'AVANT iniacademic AVANT AVANT AVANT AVANT'
     261     .              'GCM: AVANT iniacademic AVANT AVANT AVANT AVANT'
    273262      if (.not.read_start) then
    274          CALL iniacademic(nqmx,vcov,ucov,teta,q,masse,ps,phis,time_0)
     263         CALL iniacademic(vcov,ucov,teta,q,masse,ps,phis,time_0)
    275264      endif
    276265
    … …  
    304293      if (annee_ref .ne. anneeref .or. day_ref .ne. dayref) then
    305294        write(lunout,*)
    306      .  ' Attention les dates initiales lues dans le fichier'
     295     .  'GCM: Attention les dates initiales lues dans le fichier'
    307296        write(lunout,*)
    308297     .  ' restart ne correspondent pas a celles lues dans '
    … …  
    310299        if (raz_date .ne. 1) then
    311300          write(lunout,*)
    312      .    ' On garde les dates du fichier restart'
     301     .    'GCM: On garde les dates du fichier restart'
    313302        else
    314303          annee_ref = anneeref
    … …  
    319308          time_0 = 0.
    320309          write(lunout,*)
    321      .   ' On reinitialise a la date lue dans gcm.def'
     310     .   'GCM: On reinitialise a la date lue dans gcm.def'
    322311        endif
    323312      ELSE
    … …  
    356345c   Initialisation de la physique :
    357346c   -------------------------------
    358 #ifdef CPP_PHYS
    359       IF (call_iniphys.and.iflag_phys.eq.1) THEN
     347
     348      IF (call_iniphys.and.(iflag_phys.eq.1)) THEN
    360349         latfi(1)=rlatu(1)
    361350         lonfi(1)=0.
    … …  
    376365         CALL gr_dyn_fi(1,iip1,jjp1,ngridmx,aire,airefi)
    377366         WRITE(lunout,*)
    378      .           'WARNING!!! vitesse verticale nulle dans la physique'
     367     .       'GCM: WARNING!!! vitesse verticale nulle dans la physique'
     368! Earth:
     369         if (planet_type.eq."earth") then
     370#ifdef CPP_EARTH
    379371         CALL iniphysiq(ngridmx,llm,daysec,day_ini,dtphys ,
    380372     ,                latfi,lonfi,airefi,zcufi,zcvfi,rad,g,r,cpp     )
     373#endif
     374         endif ! of if (planet_type.eq."earth")
    381375         call_iniphys=.false.
    382       ENDIF
    383 #endif
     376      ENDIF ! of IF (call_iniphys.and.(iflag_phys.eq.1))
     377!#endif
    384378
    385379c  numero de stockage pour les fichiers de redemarrage:
    … …  
    392386      day_end = day_ini + nday
    393387      WRITE(lunout,300)day_ini,day_end
     388 300  FORMAT('1'/,15x,'run du jour',i7,2x,'au jour',i7//)
     389
     390      if (planet_type.eq."earth") then
     391#ifdef CPP_EARTH
     392      CALL dynredem0("restart.nc", day_end, phis)
     393#endif
     394      endif
     395
     396      ecripar = .TRUE.
    394397
    395398#ifdef CPP_IOIPSL
    396       CALL dynredem0("restart.nc", day_end, phis, nqmx)
    397 
    398       ecripar = .TRUE.
    399 
    400399      if ( 1.eq.1) then
    401400      time_step = zdtvr
    … …  
    403402      t_wrt = iecri * daysec
    404403      CALL inithist(dynhist_file,day_ref,annee_ref,time_step,
    405      .              t_ops, t_wrt, nqmx, histid, histvid)
    406 
    407       t_ops = iperiod * time_step
    408       t_wrt = periodav * daysec
    409       CALL initdynav(dynhistave_file,day_ref,annee_ref,time_step,
    410      .              t_ops, t_wrt, nqmx, histaveid)
    411 
     404     .              t_ops, t_wrt, histid, histvid)
     405
     406      IF (ok_dynzon) THEN
     407         t_ops = iperiod * time_step
     408         t_wrt = periodav * daysec
     409         CALL initdynav(dynhistave_file,day_ref,annee_ref,time_step,
     410     .        t_ops, t_wrt, histaveid)
     411      END IF
    412412      dtav = iperiod*dtvr/daysec
    413413      endif
    … …  
    415415
    416416#endif
     417! #endif of #ifdef CPP_IOIPSL
    417418
    418419c  Choix des frequences de stokage pour le offline
    … …  
    435436
    436437
    437       CALL leapfrog(ucov,vcov,teta,ps,masse,phis,nq,q,clesphy0,
     438      CALL leapfrog(ucov,vcov,teta,ps,masse,phis,q,clesphy0,
    438439     .              time_0)
    439440
    440 
    441 
    442  300  FORMAT('1'/,15x,'run du pas',i7,2x,'au pas',i7,2x,
    443      . 'c''est a dire du jour',i7,3x,'au jour',i7//)
    444441      END
    445442

  • LMDZ4/trunk/libf/dyn3d/groupeun.F

    r524 r1146  
    22! $Header$
    33!
    4       subroutine groupeun(jjmax,llmax,q)
    5       implicit none
     4      SUBROUTINE groupeun(jjmax,llmax,q)
     5      IMPLICIT NONE
    66
    77#include "dimensions.h"
    … …  
    1010#include "comgeom2.h"
    1111
    12       integer jjmax,llmax
    13       real q(iip1,jjmax,llmax)
     12      INTEGER jjmax,llmax
     13      REAL q(iip1,jjmax,llmax)
    1414
    15       integer ngroup
    16       parameter (ngroup=3)
     15      INTEGER ngroup
     16      PARAMETER (ngroup=3)
    1717
    18       real airen,airecn,qn
    19       real aires,airecs,qs
     18      REAL airecn,qn
     19      REAL airecs,qs
    2020
    21       integer i,j,l,ig,j1,j2,i0,jd
     21      INTEGER i,j,l,ig,j1,j2,i0,jd
    2222
    23 Champs 3D
     23c--------------------------------------------------------------------c
     24c Strategie d'optimisation                                           c
     25c stocker les valeurs systematiquement recalculees                   c
     26c et identiques d'un pas de temps sur l'autre. Il s'agit des         c
     27c aires des cellules qui sont sommees. S'il n'y a pas de changement  c
     28c de grille au cours de la simulation tout devrait bien se passer.   c
     29c Autre optimisation : determination des bornes entre lesquelles "j" c
     30c varie, au lieu de faire un test à chaque fois...
     31c--------------------------------------------------------------------c
     32
     33      INTEGER j_start, j_finish
     34
     35      REAL, SAVE :: airen_tab(iip1,jjp1,0:1)
     36      REAL, SAVE :: aires_tab(iip1,jjp1,0:1)
     37
     38      LOGICAL, SAVE :: first = .TRUE.
     39
     40      IF (first) THEN
     41         CALL INIT_GROUPEUN(airen_tab, aires_tab)
     42         first = .FALSE.
     43      ENDIF
     44
     45c Champs 3D
    2446      jd=jjp1-jjmax
    25       do l=1,llm
    26       j1=1+jd
    27       j2=2
    28       do ig=1,ngroup
    29          do j=j1-jd,j2-jd
    30 c           print*,'groupe ',ig,'  j= ',j,2**(ngroup-ig+1),'pts groupes'
    31             do i0=1,iim,2**(ngroup-ig+1)
    32                airen=0.
    33                airecn=0.
    34                qn=0.
    35                aires=0.
    36                airecs=0.
    37                qs=0.
    38                do i=i0,i0+2**(ngroup-ig+1)-1
    39                   airen=airen+aire(i,j)
    40                   aires=aires+aire(i,jjp1-j+1)
    41                   qn=qn+q(i,j,l)
    42                   qs=qs+q(i,jjp1-j+1-jd,l)
    43                enddo
    44                airecn=0.
    45                airecs=0.
    46                do i=i0,i0+2**(ngroup-ig+1)-1
    47                   q(i,j,l)=qn*aire(i,j)/airen
    48                   q(i,jjp1-j+1-jd,l)=qs*aire(i,jjp1-j+1)/aires
    49                enddo
    50             enddo
    51             q(iip1,j,l)=q(1,j,l)
    52             q(iip1,jjp1-j+1-jd,l)=q(1,jjp1-j+1-jd,l)
    53          enddo
    54          j1=j2+1
    55          j2=j2+2**ig
    56       enddo
    57       enddo
    5847
    59       return
    60       end
     48      DO l=1,llm
     49         j1=1+jd
     50         j2=2
     51         DO ig=1,ngroup
     52
     53c     Concerne le pole nord
     54            j_start  = j1-jd
     55            j_finish = j2-jd
     56            DO j=j_start, j_finish
     57               DO i0=1,iim,2**(ngroup-ig+1)
     58                  qn=0.
     59                  DO i=i0,i0+2**(ngroup-ig+1)-1
     60                     qn=qn+q(i,j,l)
     61                  ENDDO
     62                  DO i=i0,i0+2**(ngroup-ig+1)-1
     63                     q(i,j,l)=qn*airen_tab(i,j,jd)
     64                  ENDDO
     65               ENDDO
     66               q(iip1,j,l)=q(1,j,l)
     67            ENDDO
     68       
     69!c     Concerne le pole sud
     70            j_start  = j1-jd
     71            j_finish = j2-jd
     72            DO j=j_start, j_finish
     73               DO i0=1,iim,2**(ngroup-ig+1)
     74                  qs=0.
     75                  DO i=i0,i0+2**(ngroup-ig+1)-1
     76                     qs=qs+q(i,jjp1-j+1-jd,l)
     77                  ENDDO
     78                  DO i=i0,i0+2**(ngroup-ig+1)-1
     79                     q(i,jjp1-j+1-jd,l)=qs*aires_tab(i,jjp1-j+1,jd)
     80                  ENDDO
     81               ENDDO
     82               q(iip1,jjp1-j+1-jd,l)=q(1,jjp1-j+1-jd,l)
     83            ENDDO
     84       
     85            j1=j2+1
     86            j2=j2+2**ig
     87         ENDDO
     88      ENDDO
     89
     90      RETURN
     91      END
     92
     93
     94
     95      SUBROUTINE INIT_GROUPEUN(airen_tab, aires_tab)
     96      IMPLICIT NONE
     97
     98#include "dimensions.h"
     99#include "paramet.h"
     100#include "comconst.h"
     101#include "comgeom2.h"
     102
     103      INTEGER ngroup
     104      PARAMETER (ngroup=3)
     105
     106      REAL airen,airecn
     107      REAL aires,airecs
     108
     109      INTEGER i,j,l,ig,j1,j2,i0,jd
     110
     111      INTEGER j_start, j_finish
     112
     113      REAL :: airen_tab(iip1,jjp1,0:1)
     114      REAL :: aires_tab(iip1,jjp1,0:1)
     115
     116      DO jd=0, 1
     117         j1=1+jd
     118         j2=2
     119         DO ig=1,ngroup
     120           
     121!     c     Concerne le pole nord
     122            j_start = j1-jd
     123            j_finish = j2-jd
     124            DO j=j_start, j_finish
     125               DO i0=1,iim,2**(ngroup-ig+1)
     126                  airen=0.
     127                  DO i=i0,i0+2**(ngroup-ig+1)-1
     128                     airen = airen+aire(i,j)
     129                  ENDDO
     130                  DO i=i0,i0+2**(ngroup-ig+1)-1
     131                     airen_tab(i,j,jd) =
     132     &                    aire(i,j) / airen
     133                  ENDDO
     134               ENDDO
     135            ENDDO
     136           
     137!     c     Concerne le pole sud
     138            j_start = j1-jd
     139            j_finish = j2-jd
     140            DO j=j_start, j_finish
     141               DO i0=1,iim,2**(ngroup-ig+1)
     142                  aires=0.
     143                  DO i=i0,i0+2**(ngroup-ig+1)-1
     144                     aires=aires+aire(i,jjp1-j+1)
     145                  ENDDO
     146                  DO i=i0,i0+2**(ngroup-ig+1)-1
     147                     aires_tab(i,jjp1-j+1,jd) =
     148     &                    aire(i,jjp1-j+1) / aires
     149                  ENDDO
     150               ENDDO
     151            ENDDO
     152           
     153            j1=j2+1
     154            j2=j2+2**ig
     155         ENDDO
     156      ENDDO
     157     
     158      RETURN
     159      END

  • LMDZ4/trunk/libf/dyn3d/guide.F

    r1046 r1146  
    33!
    44      subroutine guide(itau,ucov,vcov,teta,q,masse,ps)
     5
     6      use netcdf
    57
    68      IMPLICIT NONE
    … …  
    225227c lecture d'un fichier netcdf pour determiner le nombre de niveaux
    226228         if (guide_modele) then
    227            if (ncidpl.eq.-99) ncidpl=NCOPN('apbp.nc',NCNOWRIT,rcod)
     229           if (ncidpl.eq.-99) rcod=nf90_open('apbp.nc',Nf90_NOWRITe,
     230     $           ncidpl)
    228231         else
    229232         if (guide_u) then
    230            if (ncidpl.eq.-99) ncidpl=NCOPN('u.nc',NCNOWRIT,rcod)
     233           if (ncidpl.eq.-99) rcod=nf90_open('u.nc',Nf90_NOWRITe,ncidpl)
    231234         endif
    232235c
    233236         if (guide_v) then
    234            if (ncidpl.eq.-99) ncidpl=NCOPN('v.nc',NCNOWRIT,rcod)
     237           if (ncidpl.eq.-99) rcod=nf90_open('v.nc',nf90_nowrite,ncidpl)
    235238         endif
    236239c
    237240         if (guide_T) then
    238            if (ncidpl.eq.-99) ncidpl=NCOPN('T.nc',NCNOWRIT,rcod)
     241           if (ncidpl.eq.-99) rcod=nf90_open('T.nc',nf90_nowrite,ncidpl)
    239242         endif
    240243c
    241244         if (guide_Q) then
    242            if (ncidpl.eq.-99) ncidpl=NCOPN('hur.nc',NCNOWRIT,rcod)
     245           if (ncidpl.eq.-99) rcod=nf90_open('hur.nc',nf90_nowrite,
     246     $           ncidpl)
    243247         endif
    244248c
    … …  
    251255          status=NF_INQ_DIMLEN(ncidpl,rid,nlev)
    252256         print *,'nlev guide', nlev
    253          call ncclos(ncidpl,rcod)
     257         rcod = nf90_close(ncidpl)
    254258c   Lecture du premier etat des reanalyses.
    255259         call read_reanalyse(1,ps

  • LMDZ4/trunk/libf/dyn3d/iniacademic.F

    r524 r1146  
    44c
    55c
    6       SUBROUTINE iniacademic(nq,vcov,ucov,teta,q,masse,ps,phis,time_0)
     6      SUBROUTINE iniacademic(vcov,ucov,teta,q,masse,ps,phis,time_0)
     7
     8      USE filtreg_mod
     9      USE infotrac, ONLY : nqtot
    710
    811c%W%    %G%
    … …  
    4245#include "temps.h"
    4346#include "control.h"
     47#include "iniprint.h"
    4448
    4549c   Arguments:
    4650c   ----------
    4751
    48       integer nq
    4952      real time_0
    5053
    … …  
    5255      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
    5356      REAL teta(ip1jmp1,llm)                 ! temperature potentielle
    54       REAL q(ip1jmp1,llm,nq)               ! champs advectes
     57      REAL q(ip1jmp1,llm,nqtot)               ! champs advectes
    5558      REAL ps(ip1jmp1)                       ! pression  au sol
    5659      REAL masse(ip1jmp1,llm)                ! masse d'air
     60      REAL phis(ip1jmp1)                     ! geopotentiel au sol
     61
     62c   Local:
     63c   ------
     64
    5765      REAL p (ip1jmp1,llmp1  )               ! pression aux interfac.des couches
    5866      REAL pks(ip1jmp1)                      ! exner au  sol
    5967      REAL pk(ip1jmp1,llm)                   ! exner au milieu des couches
    6068      REAL pkf(ip1jmp1,llm)                  ! exner filt.au milieu des couches
    61       REAL phis(ip1jmp1)                     ! geopotentiel au sol
    6269      REAL phi(ip1jmp1,llm)                  ! geopotentiel
    63 
    64 
    65 
    66 
    67 
    68 c   Local:
    69 c   ------
    70 
    7170      REAL ddsin,tetarappelj,tetarappell,zsig
    7271      real tetajl(jjp1,llm)
    … …  
    7978
    8079c-----------------------------------------------------------------------
     80! 1. Initializations for Earth-like case
     81! --------------------------------------
     82      if (planet_type=="earth") then
     83c
     84        time_0=0.
    8185
    82 c
    83       time_0=0.
     86        im         = iim
     87        jm         = jjm
     88        day_ini    = 0
     89        omeg       = 4.*asin(1.)/86400.
     90        rad    = 6371229.
     91        g      = 9.8
     92        daysec = 86400.
     93        dtvr    = daysec/FLOAT(day_step)
     94        zdtvr=dtvr
     95        kappa  = 0.2857143
     96        cpp    = 1004.70885
     97        preff     = 101325.
     98        pa        =  50000.
     99        etot0      = 0.
     100        ptot0      = 0.
     101        ztot0      = 0.
     102        stot0      = 0.
     103        ang0       = 0.
    84104
    85       im         = iim
    86       jm         = jjm
    87       day_ini    = 0
    88       omeg       = 4.*asin(1.)/86400.
    89       rad    = 6371229.
    90       g      = 9.8
    91       daysec = 86400.
    92       dtvr    = daysec/FLOAT(day_step)
    93       zdtvr=dtvr
    94       kappa  = 0.2857143
    95       cpp    = 1004.70885
    96       preff     = 101325.
    97       pa        =  50 000.
    98       etot0      = 0.
    99       ptot0      = 0.
    100       ztot0      = 0.
    101       stot0      = 0.
    102       ang0       = 0.
    103       pa         = 0.
     105        CALL iniconst
     106        CALL inigeom
     107        CALL inifilr
    104108
    105       CALL inicons0
    106       CALL inigeom
    107       CALL inifilr
    108 
    109       ps=0.
    110       phis=0.
     109        ps=0.
     110        phis=0.
    111111c---------------------------------------------------------------------
    112112
    113       taurappel=10.*daysec
     113        taurappel=10.*daysec
    114114
    115115c---------------------------------------------------------------------
    … …  
    117117c   --------------------------------------
    118118
    119       DO l=1,llm
    120        zsig=ap(l)/preff+bp(l)
    121        if (zsig.gt.0.3) then
    122          lsup=l
    123          tetarappell=1./8.*(-log(zsig)-.5)
    124          DO j=1,jjp1
    125             ddsin=sin(rlatu(j))-sin(pi/20.)
    126             tetajl(j,l)=300.*(1+1./18.*(1.-3.*ddsin*ddsin)+tetarappell)
    127          ENDDO
    128         else
     119        DO l=1,llm
     120         zsig=ap(l)/preff+bp(l)
     121         if (zsig.gt.0.3) then
     122           lsup=l
     123           tetarappell=1./8.*(-log(zsig)-.5)
     124           DO j=1,jjp1
     125             ddsin=sin(rlatu(j))-sin(pi/20.)
     126             tetajl(j,l)=300.*(1+1./18.*(1.-3.*ddsin*ddsin)+tetarappell)
     127           ENDDO
     128          else
    129129c   Choix isotherme au-dessus de 300 mbar
    130          do j=1,jjp1
    131             tetajl(j,l)=tetajl(j,lsup)*(0.3/zsig)**kappa
    132          enddo
    133         endif
    134       ENDDO
     130           do j=1,jjp1
     131             tetajl(j,l)=tetajl(j,lsup)*(0.3/zsig)**kappa
     132           enddo
     133          endif ! of if (zsig.gt.0.3)
     134        ENDDO ! of DO l=1,llm
    135135
    136       do l=1,llm
    137          do j=1,jjp1
    138             do i=1,iip1
    139                ij=(j-1)*iip1+i
    140                tetarappel(ij,l)=tetajl(j,l)
    141             enddo
    142          enddo
    143       enddo
     136        do l=1,llm
     137           do j=1,jjp1
     138              do i=1,iip1
     139                 ij=(j-1)*iip1+i
     140                 tetarappel(ij,l)=tetajl(j,l)
     141              enddo
     142           enddo
     143        enddo
    144144
    145 c     call dump2d(jjp1,llm,tetajl,'TEQ   ')
     145c       call dump2d(jjp1,llm,tetajl,'TEQ   ')
    146146
    147       ps=1.e5
    148       phis=0.
    149       CALL pression ( ip1jmp1, ap, bp, ps, p       )
    150       CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
    151       CALL massdair(p,masse)
     147        ps=1.e5
     148        phis=0.
     149        CALL pression ( ip1jmp1, ap, bp, ps, p       )
     150        CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
     151        CALL massdair(p,masse)
    152152
    153153c  intialisation du vent et de la temperature
    154       teta(:,:)=tetarappel(:,:)
    155       CALL geopot(ip1jmp1,teta,pk,pks,phis,phi)
    156       call ugeostr(phi,ucov)
    157       vcov=0.
    158       q(:,:,1   )=1.e-10
    159       q(:,:,2   )=1.e-15
    160       q(:,:,3:nq)=0.
     154        teta(:,:)=tetarappel(:,:)
     155        CALL geopot(ip1jmp1,teta,pk,pks,phis,phi)
     156        call ugeostr(phi,ucov)
     157        vcov=0.
     158        q(:,:,1   )=1.e-10
     159        q(:,:,2   )=1.e-15
     160        q(:,:,3:nqtot)=0.
    161161
    162162
    163 c   perturbation al\351atoire sur la temp\351rature
    164       idum  = -1
    165       zz = ran1(idum)
    166       idum  = 0
    167       do l=1,llm
    168          do ij=iip2,ip1jm
    169             teta(ij,l)=teta(ij,l)*(1.+0.005*ran1(idum))
    170          enddo
    171       enddo
     163c   perturbation aleatoire sur la temperature
     164        idum  = -1
     165        zz = ran1(idum)
     166        idum  = 0
     167        do l=1,llm
     168           do ij=iip2,ip1jm
     169              teta(ij,l)=teta(ij,l)*(1.+0.005*ran1(idum))
     170           enddo
     171        enddo
    172172
    173       do l=1,llm
    174          do ij=1,ip1jmp1,iip1
    175             teta(ij+iim,l)=teta(ij,l)
    176          enddo
    177       enddo
     173        do l=1,llm
     174           do ij=1,ip1jmp1,iip1
     175              teta(ij+iim,l)=teta(ij,l)
     176           enddo
     177        enddo
    178178
    179179
    … …  
    185185
    186186c   initialisation d'un traceur sur une colonne
    187       j=jjp1*3/4
    188       i=iip1/2
    189       ij=(j-1)*iip1+i
    190       q(ij,:,3)=1.
    191 
     187        j=jjp1*3/4
     188        i=iip1/2
     189        ij=(j-1)*iip1+i
     190        q(ij,:,3)=1.
     191     
     192      else
     193        write(lunout,*)"iniacademic: planet types other than earth",
     194     &                 " not implemented (yet)."
     195        stop
     196      endif ! of if (planet_type=="earth")
    192197      return
    193198      END

  • LMDZ4/trunk/libf/dyn3d/integrd.F

    r524 r1146  
    3232#include "temps.h"
    3333#include "serre.h"
    34 #include "advtrac.h"
    3534
    3635c   Arguments:

  • LMDZ4/trunk/libf/dyn3d/leapfrog.F

    r1060 r1146  
    22c
    33c
    4       SUBROUTINE leapfrog(ucov,vcov,teta,ps,masse,phis,nq,q,clesphy0,
     4      SUBROUTINE leapfrog(ucov,vcov,teta,ps,masse,phis,q,clesphy0,
    55     &                    time_0)
    66
    77
    88cIM : pour sortir les param. du modele dans un fis. netcdf 110106
    9       USE IOIPSL
     9#ifdef CPP_IOIPSL
     10      use IOIPSL
     11#endif
     12      USE infotrac
    1013
    1114      IMPLICIT NONE
    … …  
    5659#include "com_io_dyn.h"
    5760#include "iniprint.h"
    58 #include "advtrac.h"
    59 c#include "tracstoke.h"
    60 
    6161#include "academic.h"
    6262
    6363! FH 2008/05/09 On elimine toutes les clefs physiques dans la dynamique
    6464! #include "clesphys.h"
    65 
    66       integer nq
    6765
    6866      INTEGER         longcles
    … …  
    7674      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
    7775      REAL teta(ip1jmp1,llm)                 ! temperature potentielle
    78       REAL q(ip1jmp1,llm,nqmx)               ! champs advectes
     76      REAL q(ip1jmp1,llm,nqtot)               ! champs advectes
    7977      REAL ps(ip1jmp1)                       ! pression  au sol
    8078      REAL p (ip1jmp1,llmp1  )               ! pression aux interfac.des couches
    … …  
    9795c   tendances dynamiques
    9896      REAL dv(ip1jm,llm),du(ip1jmp1,llm)
    99       REAL dteta(ip1jmp1,llm),dq(ip1jmp1,llm,nqmx),dp(ip1jmp1)
     97      REAL dteta(ip1jmp1,llm),dq(ip1jmp1,llm,nqtot),dp(ip1jmp1)
    10098
    10199c   tendances de la dissipation
    … …  
    105103c   tendances physiques
    106104      REAL dvfi(ip1jm,llm),dufi(ip1jmp1,llm)
    107       REAL dtetafi(ip1jmp1,llm),dqfi(ip1jmp1,llm,nqmx),dpfi(ip1jmp1)
     105      REAL dtetafi(ip1jmp1,llm),dqfi(ip1jmp1,llm,nqtot),dpfi(ip1jmp1)
    108106
    109107c   variables pour le fichier histoire
    … …  
    165163
    166164      character*80 dynhist_file, dynhistave_file
    167       character*20 modname
     165      character(len=20) :: modname
    168166      character*80 abort_message
    169167
    … …  
    182180      PARAMETER (testita = 9)
    183181
    184       logical , parameter :: flag_verif = .false.
     182      logical , parameter :: flag_verif = .true.
    185183     
    186184
    … …  
    190188      itaufin   = nday*day_step
    191189      itaufinp1 = itaufin +1
    192 
     190      modname="leapfrog"
     191     
    193192
    194193      itau = 0
    … …  
    220219        call guide(itau,ucov,vcov,teta,q,masse,ps)
    221220      else
    222         IF(prt_level>9)WRITE(*,*)'attention on ne guide pas les ',
    223      .    '6 dernieres heures'
     221        IF(prt_level>9)WRITE(lunout,*)'leapfrog: attention on ne ',
     222     .    'guide pas les 6 dernieres heures'
    224223      endif
    225224#endif
    … …  
    230229c     ENDIF
    231230c
     231
     232! Save fields obtained at previous time step as '...m1'
    232233      CALL SCOPY( ijmllm ,vcov , 1, vcovm1 , 1 )
    233234      CALL SCOPY( ijp1llm,ucov , 1, ucovm1 , 1 )
    … …  
    245246      CALL filtreg ( finvmaold ,jjp1, llm, -2,2, .TRUE., 1 )
    246247
    247       call minmax(ijp1llm,q(:,:,3),zqmin,zqmax)
     248! Ehouarn: what is this for? zqmin & zqmax are not used anyway ...
     249!      call minmax(ijp1llm,q(:,:,3),zqmin,zqmax)
    248250
    249251   2  CONTINUE
    … …  
    305307
    306308
    307          ENDIF
    308 c
    309       ENDIF
     309         ENDIF ! of IF (offline)
     310c
     311      ENDIF ! of IF( forward. OR . leapf )
    310312
    311313
    … …  
    353355c   -----------------------------------------------------
    354356
    355 #ifdef CPP_PHYS
    356357c+jld
    357358
    358359c  Diagnostique de conservation de l'énergie : initialisation
    359       IF (ip_ebil_dyn.ge.1 ) THEN
     360         IF (ip_ebil_dyn.ge.1 ) THEN
    360361          ztit='bil dyn'
    361           CALL diagedyn(ztit,2,1,1,dtphys
    362      e  , ucov    , vcov , ps, p ,pk , teta , q(:,:,1), q(:,:,2))
    363       ENDIF
     362! Ehouarn: be careful, diagedyn is Earth-specific (includes ../phylmd/..)!
     363           IF (planet_type.eq."earth") THEN
     364            CALL diagedyn(ztit,2,1,1,dtphys
     365     &    , ucov    , vcov , ps, p ,pk , teta , q(:,:,1), q(:,:,2))
     366           ENDIF
     367         ENDIF ! of IF (ip_ebil_dyn.ge.1 )
    364368c-jld
     369#ifdef CPP_IOIPSL
    365370cIM : pour sortir les param. du modele dans un fis. netcdf 110106
    366       IF (first) THEN
    367        first=.false.
     371         IF (first) THEN
     372          first=.false.
    368373#include "ini_paramLMDZ_dyn.h"
    369       ENDIF
     374         ENDIF
    370375c
    371376#include "write_paramLMDZ_dyn.h"
    372377c
    373 
    374         CALL calfis( nq, lafin ,rdayvrai,time  ,
     378#endif
     379! #endif of #ifdef CPP_IOIPSL
     380         CALL calfis( lafin ,rdayvrai,time  ,
    375381     $               ucov,vcov,teta,q,masse,ps,p,pk,phis,phi ,
    376382     $               du,dv,dteta,dq,
    … …  
    378384     $               clesphy0, dufi,dvfi,dtetafi,dqfi,dpfi  )
    379385
    380        IF (ok_strato) THEN
    381          CALL top_bound( vcov,ucov,teta, dufi,dvfi,dtetafi)
    382        ENDIF
     386         IF (ok_strato) THEN
     387           CALL top_bound( vcov,ucov,teta, dufi,dvfi,dtetafi)
     388         ENDIF
    383389       
    384390c      ajout des tendances physiques:
    385391c      ------------------------------
    386           CALL addfi( nqmx, dtphys, leapf, forward   ,
     392          CALL addfi( dtphys, leapf, forward   ,
    387393     $                  ucov, vcov, teta , q   ,ps ,
    388394     $                 dufi, dvfi, dtetafi , dqfi ,dpfi  )
    389395c
    390396c  Diagnostique de conservation de l'énergie : difference
    391       IF (ip_ebil_dyn.ge.1 ) THEN
     397         IF (ip_ebil_dyn.ge.1 ) THEN
    392398          ztit='bil phys'
    393           CALL diagedyn(ztit,2,1,1,dtphys
    394      e  , ucov    , vcov , ps, p ,pk , teta , q(:,:,1), q(:,:,2))
    395       ENDIF
    396 #endif
     399          IF (planet_type.eq."earth") THEN
     400           CALL diagedyn(ztit,2,1,1,dtphys
     401     &     , ucov    , vcov , ps, p ,pk , teta , q(:,:,1), q(:,:,2))
     402          ENDIF
     403         ENDIF ! of IF (ip_ebil_dyn.ge.1 )
     404
    397405       ENDIF ! of IF( apphys )
    398406
    399       IF(iflag_phys.EQ.2) THEN ! "Newtonian physics" case
     407      IF(iflag_phys.EQ.2) THEN ! "Newtonian" case
    400408c   Calcul academique de la physique = Rappel Newtonien + friction
    401409c   --------------------------------------------------------------
    … …  
    475483
    476484
    477       END IF
     485      END IF ! of IF(apdiss)
    478486
    479487c ajout debug
    … …  
    509517            IF( itau. EQ. itaufinp1 ) then 
    510518              if (flag_verif) then
    511                 write(79,*) 'ucov',ucov
    512                 write(80,*) 'vcov',vcov
    513                 write(81,*) 'teta',teta
    514                 write(82,*) 'ps',ps
    515                 write(83,*) 'q',q
     519                write(80,*) 'ucov',ucov
     520                write(81,*) 'vcov',vcov
     521                write(82,*) 'teta',teta
     522                write(83,*) 'ps',ps
     523                write(84,*) 'q',q
    516524                WRITE(85,*) 'q1 = ',q(:,:,1)
    517525                WRITE(86,*) 'q3 = ',q(:,:,3)
     526                write(90) ucov
     527                write(91) vcov
     528                write(92) teta
     529                write(93) ps
     530                write(94) q
    518531              endif
    519532
    … …  
    532545                  iav=0
    533546               ENDIF
     547               
     548               IF (ok_dynzon) THEN
    534549#ifdef CPP_IOIPSL
    535               CALL writedynav(histaveid, nqmx, itau,vcov ,
    536      ,                          ucov,teta,pk,phi,q,masse,ps,phis)
    537                call bilan_dyn (2,dtvr*iperiod,dtvr*day_step*periodav,
    538      ,           ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q)
    539 #endif
     550                  CALL writedynav(histaveid, itau,vcov ,
     551     ,                 ucov,teta,pk,phi,q,masse,ps,phis)
     552                  CALL bilan_dyn (2,dtvr*iperiod,dtvr*day_step*periodav,
     553     ,                 ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q)
     554#endif
     555               END IF
    540556
    541557            ENDIF
    … …  
    548564c           IF( MOD(itau,iecri*day_step).EQ.0) THEN
    549565
    550                nbetat = nbetatdem
    551        CALL geopot  ( ip1jmp1, teta  , pk , pks,  phis  , phi        )
    552         unat=0.
    553         do l=1,llm
    554            unat(iip2:ip1jm,l)=ucov(iip2:ip1jm,l)/cu(iip2:ip1jm)
    555            vnat(:,l)=vcov(:,l)/cv(:)
    556         enddo
     566              nbetat = nbetatdem
     567              CALL geopot(ip1jmp1,teta,pk,pks,phis,phi)
     568              unat=0.
     569              do l=1,llm
     570                unat(iip2:ip1jm,l)=ucov(iip2:ip1jm,l)/cu(iip2:ip1jm)
     571                vnat(:,l)=vcov(:,l)/cv(:)
     572              enddo
    557573#ifdef CPP_IOIPSL
    558 c        CALL writehist(histid,histvid, nqmx,itau,vcov,
    559 c     s                       ucov,teta,phi,q,masse,ps,phis)
    560 #else
     574c             CALL writehist(histid,histvid,itau,vcov,
     575c     &                      ucov,teta,phi,q,masse,ps,phis)
     576#endif
     577! For some Grads outputs of fields
     578             if (output_grads_dyn) then
    561579#include "write_grads_dyn.h"
    562 #endif
    563 
    564 
    565             ENDIF
     580             endif
     581
     582            ENDIF ! of IF(MOD(itau,iecri).EQ.0)
    566583
    567584            IF(itau.EQ.itaufin) THEN
    568585
    569586
    570 #ifdef CPP_IOIPSL
    571        CALL dynredem1("restart.nc",0.0,
    572      ,                     vcov,ucov,teta,q,nqmx,masse,ps)
    573 #endif
     587              if (planet_type.eq."earth") then
     588#ifdef CPP_EARTH
     589! Write an Earth-format restart file
     590                CALL dynredem1("restart.nc",0.0,
     591     &                         vcov,ucov,teta,q,masse,ps)
     592#endif
     593              endif ! of if (planet_type.eq."earth")
    574594
    575595              CLOSE(99)
    576             ENDIF
     596            ENDIF ! of IF (itau.EQ.itaufin)
    577597
    578598c-----------------------------------------------------------------------
    … …  
    596616                        leapf =  .TRUE.
    597617                        dt  =  2.*dtvr
    598                         GO TO 2
    599                    END IF
     618                        GO TO 2 
     619                   END IF ! of IF (forward)
    600620            ELSE
    601621
    … …  
    605625                 dt  = 2.*dtvr
    606626                 GO TO 2
    607             END IF
    608 
    609       ELSE
     627            END IF ! of IF (MOD(itau,iperiod).EQ.0)
     628                   !    ELSEIF (MOD(itau-1,iperiod).EQ.0)
     629
     630      ELSE ! of IF (.not.purmats)
    610631
    611632c       ........................................................
    … …  
    630651               GO TO 2
    631652
    632             ELSE
    633 
    634             IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin) THEN
     653            ELSE ! of IF(forward)
     654
     655              IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin) THEN
    635656               IF(itau.EQ.itaufin) THEN
    636657                  iav=1
    … …  
    638659                  iav=0
    639660               ENDIF
     661
     662               IF (ok_dynzon) THEN
    640663#ifdef CPP_IOIPSL
    641               CALL writedynav(histaveid, nqmx, itau,vcov ,
    642      ,                          ucov,teta,pk,phi,q,masse,ps,phis)
    643                call bilan_dyn (2,dtvr*iperiod,dtvr*day_step*periodav,
    644      ,           ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q)
    645 #endif
    646 
    647             ENDIF
    648 
    649                IF(MOD(itau,iecri         ).EQ.0) THEN
     664                  CALL writedynav(histaveid, itau,vcov ,
     665     ,                 ucov,teta,pk,phi,q,masse,ps,phis)
     666                  CALL bilan_dyn (2,dtvr*iperiod,dtvr*day_step*periodav,
     667     ,                 ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q)
     668#endif
     669               END IF
     670
     671              ENDIF ! of IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin)
     672
     673              IF(MOD(itau,iecri         ).EQ.0) THEN
    650674c              IF(MOD(itau,iecri*day_step).EQ.0) THEN
    651                   nbetat = nbetatdem
    652        CALL geopot  ( ip1jmp1, teta  , pk , pks,  phis  , phi       )
    653         unat=0.
    654         do l=1,llm
    655            unat(iip2:ip1jm,l)=ucov(iip2:ip1jm,l)/cu(iip2:ip1jm)
    656            vnat(:,l)=vcov(:,l)/cv(:)
    657         enddo
     675                nbetat = nbetatdem
     676                CALL geopot(ip1jmp1,teta,pk,pks,phis,phi)
     677                unat=0.
     678                do l=1,llm
     679                  unat(iip2:ip1jm,l)=ucov(iip2:ip1jm,l)/cu(iip2:ip1jm)
     680                  vnat(:,l)=vcov(:,l)/cv(:)
     681                enddo
    658682#ifdef CPP_IOIPSL
    659 c       CALL writehist( histid, histvid, nqmx, itau,vcov ,
    660 c    ,                           ucov,teta,phi,q,masse,ps,phis)
    661 #else
     683c               CALL writehist( histid, histvid, itau,vcov ,
     684c    &                           ucov,teta,phi,q,masse,ps,phis)
     685#endif
     686! For some Grads outputs
     687                if (output_grads_dyn) then
    662688#include "write_grads_dyn.h"
    663 #endif
    664 
    665 
    666                ENDIF
    667 
    668 #ifdef CPP_IOIPSL
    669                  IF(itau.EQ.itaufin)
    670      . CALL dynredem1("restart.nc",0.0,
    671      .                     vcov,ucov,teta,q,nqmx,masse,ps)
    672 #endif
    673 
    674                  forward = .TRUE.
    675                  GO TO  1
    676 
    677             ENDIF
    678 
    679       END IF
     689                endif
     690
     691              ENDIF ! of IF(MOD(itau,iecri         ).EQ.0)
     692
     693              IF(itau.EQ.itaufin) THEN
     694                if (planet_type.eq."earth") then
     695#ifdef CPP_EARTH
     696                  CALL dynredem1("restart.nc",0.0,
     697     &                           vcov,ucov,teta,q,masse,ps)
     698#endif
     699                endif ! of if (planet_type.eq."earth")
     700              ENDIF ! of IF(itau.EQ.itaufin)
     701
     702              forward = .TRUE.
     703              GO TO  1
     704
     705            ENDIF ! of IF (forward)
     706
     707      END IF ! of IF(.not.purmats)
    680708
    681709      STOP

  • LMDZ4/trunk/libf/dyn3d/qminimum.F

    r524 r1146  
    4242c
    4343      DO 1000 k = 1, llm
    44       DO 1040 i = 1, ip1jmp1
    45             zx_defau      = AMAX1( seuil_liq - q(i,k,iq_liq), 0.0 )
    46             q(i,k,iq_vap) = q(i,k,iq_vap) - zx_defau
    47             q(i,k,iq_liq) = q(i,k,iq_liq) + zx_defau
    48  1040 CONTINUE
     44        DO 1040 i = 1, ip1jmp1
     45          if (seuil_liq - q(i,k,iq_liq) .gt. 0.d0 ) then
     46             q(i,k,iq_vap) = q(i,k,iq_vap) + q(i,k,iq_liq) - seuil_liq
     47             q(i,k,iq_liq) = seuil_liq
     48           endif
     49 1040   CONTINUE
    4950 1000 CONTINUE
    5051c
    … …  
    5657      DO k = llm, 2, -1
    5758ccc      zx_abc = dpres(k) / dpres(k-1)
    58       DO i = 1, ip1jmp1
    59          zx_abc = deltap(i,k)/deltap(i,k-1)
    60          zx_defau    = AMAX1( seuil_vap - q(i,k,iq), 0.0 )
    61          q(i,k-1,iq) =  q(i,k-1,iq) - zx_defau * zx_abc
    62          q(i,k,iq)   =  q(i,k,iq)   + zx_defau 
    63       ENDDO
     59        DO i = 1, ip1jmp1
     60          if ( seuil_vap - q(i,k,iq) .gt. 0.d0 ) then
     61            q(i,k-1,iq) =  q(i,k-1,iq) - ( seuil_vap - q(i,k,iq) ) *
     62     &                     deltap(i,k) / deltap(i,k-1)
     63            q(i,k,iq)   =  seuil_vap 
     64          endif
     65        ENDDO
    6466      ENDDO
    6567c

  • LMDZ4/trunk/libf/dyn3d/read_reanalyse.F

    r1122 r1146  
    1313c   Declarations
    1414c -----------------------------------------------------------------
     15      use netcdf
     16
    1517      IMPLICIT NONE
    1618
    … …  
    7274            print *,'Vous êtes entrain de lire des données sur
    7375     .               niveaux modèle'
    74             ncidpl=NCOPN('apbp.nc',NCNOWRIT,rcode)
    75             varidap=NCVID(ncidpl,'AP',rcode)
    76             varidbp=NCVID(ncidpl,'BP',rcode)
     76            rcode=nf90_open('apbp.nc',nf90_nowrite,ncidpl)
     77            rcode = nf90_inq_varid(ncidpl, 'AP', varidap)
     78            rcode = nf90_inq_varid(ncidpl, 'BP', varidbp)
    7779            print*,'ncidpl,varidap',ncidpl,varidap
    7880            endif
    … …  
    8082c Vent zonal
    8183            if (guide_u) then
    82             ncidu=NCOPN('u.nc',NCNOWRIT,rcode)
    83             varidu=NCVID(ncidu,'UWND',rcode)
    84             print*,'ncidu,varidu',ncidu,varidu
    85             if (ncidpl.eq.-99) ncidpl=ncidu
     84               rcode=nf90_open('u.nc',nf90_nowrite,ncidu)
     85               rcode = nf90_inq_varid(ncidu, 'UWND', varidu)
     86               print*,'ncidu,varidu',ncidu,varidu
     87               if (ncidpl.eq.-99) ncidpl=ncidu
    8688            endif
    8789
    8890c Vent meridien
    8991            if (guide_v) then
    90             ncidv=NCOPN('v.nc',NCNOWRIT,rcode)
    91             varidv=NCVID(ncidv,'VWND',rcode)
     92            rcode=nf90_open('v.nc',nf90_nowrite,ncidv)
     93            rcode = nf90_inq_varid(ncidv, 'VWND', varidv)
    9294            print*,'ncidv,varidv',ncidv,varidv
    9395            if (ncidpl.eq.-99) ncidpl=ncidv
    … …  
    9698c Temperature
    9799            if (guide_T) then
    98             ncidt=NCOPN('T.nc',NCNOWRIT,rcode)
    99             varidt=NCVID(ncidt,'AIR',rcode)
     100            rcode=nf90_open('T.nc',nf90_nowrite,ncidt)
     101            rcode = nf90_inq_varid(ncidt, 'AIR', varidt)
    100102            print*,'ncidt,varidt',ncidt,varidt
    101103            if (ncidpl.eq.-99) ncidpl=ncidt
    … …  
    104106c Humidite
    105107            if (guide_Q) then
    106             ncidQ=NCOPN('hur.nc',NCNOWRIT,rcode)
    107             varidQ=NCVID(ncidQ,'RH',rcode)
     108            rcode=nf90_open('hur.nc',nf90_nowrite,ncidQ)
     109            rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)
    108110            print*,'ncidQ,varidQ',ncidQ,varidQ
    109111            if (ncidpl.eq.-99) ncidpl=ncidQ
    … …  
    112114c Pression de surface
    113115            if ((guide_P).OR.(guide_modele)) then
    114             ncidps=NCOPN('ps.nc',NCNOWRIT,rcode)
    115             varidps=NCVID(ncidps,'SP',rcode)
     116            rcode=nf90_open('ps.nc',nf90_nowrite,ncidps)
     117            rcode = nf90_inq_varid(ncidps, 'SP', varidps)
    116118            print*,'ncidps,varidps',ncidps,varidps
    117119            endif
    … …  
    119121c Coordonnee verticale
    120122            if (.not.guide_modele) then
    121               if (ncep) then
    122                print*,'Vous etes entrain de lire des donnees NCEP'
    123                varidpl=NCVID(ncidpl,'LEVEL',rcode)
    124               else
    125                print*,'Vous etes entrain de lire des donnees ECMWF'
    126                varidpl=NCVID(ncidpl,'PRESSURE',rcode)
    127               endif
    128               print*,'ncidpl,varidpl',ncidpl,varidpl
     123               if (ncep) then
     124                  print*,'Vous etes entrain de lire des donnees NCEP'
     125                  rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
     126               else
     127                  print*,'Vous etes entrain de lire des donnees ECMWF'
     128                  rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
     129               endif
     130               print*,'ncidpl,varidpl',ncidpl,varidpl
    129131            endif
    130132! endif (first)

  • LMDZ4/trunk/libf/dyn3d/serre.h

    r524 r1146  
    22! $Header$
    33!
    4 c
    5 c
    6 c..include serre.h
    7 c
    8        REAL clon,clat,transx,transy,alphax,alphay,pxo,pyo,
    9      ,  grossismx, grossismy, dzoomx, dzoomy,taux,tauy
    10        COMMON/serre/clon,clat,transx,transy,alphax,alphay,pxo,pyo ,
    11      ,  grossismx, grossismy, dzoomx, dzoomy,taux,tauy
     4!c
     5!c
     6!c..include serre.h
     7!c
     8       REAL clon,clat,transx,transy,alphax,alphay,pxo,pyo,              &
     9     &  grossismx, grossismy, dzoomx, dzoomy,taux,tauy
     10       COMMON/serre/clon,clat,transx,transy,alphax,alphay,pxo,pyo ,     &
     11     &  grossismx, grossismy, dzoomx, dzoomy,taux,tauy

  • LMDZ4/trunk/libf/dyn3d/test_period.F

    r524 r1146  
    99c                           teta, q , p et phis                 ..........
    1010c
     11      USE infotrac
    1112c     IMPLICIT NONE
    1213c
    … …  
    1718c
    1819      REAL ucov(ip1jmp1,llm), vcov(ip1jm,llm), teta(ip1jmp1,llm) ,
    19      ,      q(ip1jmp1,llm,nqmx), p(ip1jmp1,llmp1), phis(ip1jmp1)
     20     ,      q(ip1jmp1,llm,nqtot), p(ip1jmp1,llmp1), phis(ip1jmp1)
    2021c
    2122c   .....  Variables  locales  .....
    … …  
    6869     
    6970c
    70       DO nq =1, nqmx
     71      DO nq =1, nqtot
    7172        DO l =1, llm
    7273          DO ij = 1, ip1jmp1, iip1

  • LMDZ4/trunk/libf/dyn3d/write_grads_dyn.h

    r524 r1146  
    2424      string10='teta'
    2525      CALL wrgrads(1,llm,teta,string10,string10)
    26       do iq=1,nqmx
     26      do iq=1,nqtot
    2727         string10='q'
    2828         write(string10(2:2),'(i1)') iq
Note: See TracChangeset for help on using the changeset viewer.