Changeset 1146 for LMDZ4/trunk/libf


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:
20 deleted
121 edited
10 copied

Legend:

Unmodified
Added
Removed

  • LMDZ4/trunk

  • LMDZ4/trunk/libf/bibio/initdynav.F

    r761 r1146  
    55c
    66      subroutine initdynav(infile,day0,anne0,tstep,t_ops,t_wrt
    7      .                     ,nq,fileid)
     7     .                     ,fileid)
    88
    99       USE IOIPSL
     10       USE infotrac, ONLY : nqtot, ttext
    1011
    1112      implicit none
    … …  
    2829C      t_ops: frequence de l'operation pour IOIPSL
    2930C      t_wrt: frequence d'ecriture sur le fichier
    30 C      nq: nombre de traceurs
    3131C
    3232C   Sortie:
    … …  
    4848#include "description.h"
    4949#include "serre.h"
    50 #include "advtrac.h"
    5150
    5251C   Arguments
    … …  
    5655      real tstep, t_ops, t_wrt
    5756      integer fileid
    58       integer nq
    5957      integer thoriid, zvertiid
    6058
    … …  
    136134C  Traceurs
    137135C
    138         DO iq=1,nq
     136        DO iq=1,nqtot
    139137          call histdef(fileid, ttext(iq), ttext(iq), '-',
    140138     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,

  • LMDZ4/trunk/libf/bibio/initfluxsto.F

    r761 r1146  
    33!
    44      subroutine initfluxsto
    5      .  (infile,tstep,t_ops,t_wrt,nq,
     5     .  (infile,tstep,t_ops,t_wrt,
    66     .                    fileid,filevid,filedid)
    77
    … …  
    2727C      t_ops: frequence de l'operation pour IOIPSL
    2828C      t_wrt: frequence d'ecriture sur le fichier
    29 C      nq: nombre de traceurs
    3029C
    3130C   Sortie:
    … …  
    5554      real tstep, t_ops, t_wrt
    5655      integer fileid, filevid,filedid
    57       integer nq,ndex(1)
     56      integer ndex(1)
    5857      real nivd(1)
    5958

  • LMDZ4/trunk/libf/bibio/inithist.F

    r761 r1146  
    22! $Header$
    33!
    4       subroutine inithist(infile,day0,anne0,tstep,t_ops,t_wrt,nq,fileid,
     4      subroutine inithist(infile,day0,anne0,tstep,t_ops,t_wrt,fileid,
    55     .                    filevid)
    66
    77       USE IOIPSL
     8       USE infotrac, ONLY : nqtot, ttext
    89
    910      implicit none
    … …  
    4748#include "description.h"
    4849#include "serre.h"
    49 #include "advtrac.h"
    5050
    5151C   Arguments
    … …  
    5555      real tstep, t_ops, t_wrt
    5656      integer fileid, filevid
    57       integer nq
    5857
    5958C   Variables locales
    … …  
    154153C  Traceurs
    155154C
    156         DO iq=1,nq
     155        DO iq=1,nqtot
    157156          call histdef(fileid, ttext(iq),  ttext(iq), '-',
    158157     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,

  • LMDZ4/trunk/libf/bibio/writedynav.F

    r524 r1146  
    22! $Header$
    33!
    4       subroutine writedynav( histid, nq, time, vcov,
     4      subroutine writedynav( histid, time, vcov,
    55     ,                          ucov,teta,ppk,phi,q,masse,ps,phis)
    66
    77      USE ioipsl
     8      USE infotrac, ONLY : nqtot, ttext
    89      implicit none
    910
    … …  
    1516C   Entree:
    1617C      histid: ID du fichier histoire
    17 C      nqmx: nombre maxi de traceurs
    1818C      time: temps de l'ecriture
    1919C      vcov: vents v covariants
    … …  
    4545#include "description.h"
    4646#include "serre.h"
    47 #include "advtrac.h"
    4847
    4948C
    … …  
    5150C
    5251
    53       INTEGER histid, nq
     52      INTEGER histid
    5453      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm)
    5554      REAL teta(ip1jmp1*llm),phi(ip1jmp1,llm),ppk(ip1jmp1*llm)                 
    5655      REAL ps(ip1jmp1),masse(ip1jmp1,llm)                   
    5756      REAL phis(ip1jmp1)                 
    58       REAL q(ip1jmp1,llm,nq)
     57      REAL q(ip1jmp1,llm,nqtot)
    5958      integer time
    6059
    … …  
    119118C  Traceurs
    120119C
    121         DO iq=1,nq
     120        DO iq=1,nqtot
    122121          call histwrite(histid, ttext(iq), itau_w, q(:,:,iq),
    123122     .                   iip1*jjp1*llm, ndex3d)

  • LMDZ4/trunk/libf/bibio/writehist.F

    r524 r1146  
    22! $Header$
    33!
    4       subroutine writehist( histid, histvid, nq, time, vcov,
     4      subroutine writehist( histid, histvid, time, vcov,
    55     ,                          ucov,teta,phi,q,masse,ps,phis)
    66
    77      USE ioipsl
     8      USE infotrac, ONLY : nqtot, ttext
    89      implicit none
    910
    … …  
    1617C      histid: ID du fichier histoire
    1718C      histvid:ID du fichier histoire pour les vents V (appele a disparaitre)
    18 C      nqmx: nombre maxi de traceurs
    1919C      time: temps de l'ecriture
    2020C      vcov: vents v covariants
    … …  
    4646#include "description.h"
    4747#include "serre.h"
    48 #include "advtrac.h"
    4948
    5049C
    … …  
    5251C
    5352
    54       INTEGER histid, nq, histvid
     53      INTEGER histid, histvid
    5554      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm)
    5655      REAL teta(ip1jmp1,llm),phi(ip1jmp1,llm)                   
    5756      REAL ps(ip1jmp1),masse(ip1jmp1,llm)                   
    5857      REAL phis(ip1jmp1)                 
    59       REAL q(ip1jmp1,llm,nq)
     58      REAL q(ip1jmp1,llm,nqtot)
    6059      integer time
    6160
    … …  
    102101C  Traceurs
    103102C
    104         DO iq=1,nq
     103        DO iq=1,nqtot
    105104          call histwrite(histid, ttext(iq), itau_w, q(:,:,iq),
    106105     .                   iip1*jjp1*llm, ndexu)

  • 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

  • LMDZ4/trunk/libf/dyn3dpar/addfi_p.F

    r774 r1146  
    22! $Header$
    33!
    4       SUBROUTINE addfi_p(nq, pdt, leapf, forward,
     4      SUBROUTINE addfi_p(pdt, leapf, forward,
    55     S          pucov, pvcov, pteta, pq   , pps ,
    66     S          pdufi, pdvfi, pdhfi,pdqfi, pdpfi  )
    77      USE parallel
     8      USE infotrac, ONLY : nqtot
    89      IMPLICIT NONE
    910c
    … …  
    5354c    -----------
    5455c
    55       INTEGER nq
    56 
    5756      REAL pdt
    5857c
    5958      REAL pvcov(ip1jm,llm),pucov(ip1jmp1,llm)
    60       REAL pteta(ip1jmp1,llm),pq(ip1jmp1,llm,nq),pps(ip1jmp1)
     59      REAL pteta(ip1jmp1,llm),pq(ip1jmp1,llm,nqtot),pps(ip1jmp1)
    6160c
    6261      REAL pdvfi(ip1jm,llm),pdufi(ip1jmp1,llm)
    63       REAL pdqfi(ip1jmp1,llm,nq),pdhfi(ip1jmp1,llm),pdpfi(ip1jmp1)
     62      REAL pdqfi(ip1jmp1,llm,nqtot),pdhfi(ip1jmp1,llm),pdpfi(ip1jmp1)
    6463c
    6564      LOGICAL leapf,forward
    … …  
    166165      ENDDO
    167166
    168       DO iq = 3, nq
     167      DO iq = 3, nqtot
    169168c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    170169         DO k = 1,llm
    … …  
    208207
    209208      if (pole_nord) then
    210         DO iq = 1, nq
     209        DO iq = 1, nqtot
    211210c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    212211          DO  k    = 1, llm
    … …  
    225224     
    226225      if (pole_sud) then
    227         DO iq = 1, nq
     226        DO iq = 1, nqtot
    228227c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    229228          DO  k    = 1, llm

  • LMDZ4/trunk/libf/dyn3dpar/advtrac_p.F

    r985 r1146  
    2222      USE Vampir
    2323      USE times
     24      USE infotrac
    2425      IMPLICIT NONE
    2526c
    … …  
    3536#include "ener.h"
    3637#include "description.h"
    37 #include "advtrac.h"
    3838
    3939c-------------------------------------------------------------------
    … …  
    4646      INTEGER iapptrac
    4747      REAL pbaru(ip1jmp1,llm),pbarv(ip1jm,llm)
    48       REAL q(ip1jmp1,llm,nqmx),masse(ip1jmp1,llm)
     48      REAL q(ip1jmp1,llm,nqtot),masse(ip1jmp1,llm)
    4949      REAL p( ip1jmp1,llmp1 ),teta(ip1jmp1,llm)
    5050      REAL pk(ip1jmp1,llm)
    … …  
    5959      REAL,SAVE::pbarug(ip1jmp1,llm),pbarvg(ip1jm,llm),wg(ip1jmp1,llm)
    6060      REAL (kind=kind(1.d0)) :: t_initial, t_final, tps_cpu
    61       real cpuadv(nqmx)
    62       common/cpuadv/cpuadv
    63 
    6461      INTEGER iadvtr
    6562      INTEGER ij,l,iq,iiq
    … …  
    7673      REAL psppm(iim,jjp1) ! pression  au sol
    7774      REAL unatppm(iim,jjp1,llm),vnatppm(iim,jjp1,llm)
    78       REAL qppm(iim*jjp1,llm,nqmx)
     75      REAL qppm(iim*jjp1,llm,nqtot)
    7976      REAL fluxwppm(iim,jjp1,llm)
    8077      REAL apppm(llmp1), bpppm(llmp1)
    … …  
    8885      REAL,SAVE :: teta_tmp(ip1jmp1,llm)
    8986      REAL,SAVE :: pk_tmp(ip1jmp1,llm)
    90      
     87
    9188      ijb_u=ij_begin
    9289      ije_u=ij_end
    … …  
    196193      call Register_SwapFieldHallo(pk_tmp,pk_tmp,ip1jmp1,llm,
    197194     *                             jj_Nb_vanleer,1,1,Request_vanleer)
    198       do j=1,nqmx
     195      do j=1,nqtot
    199196        call Register_SwapFieldHallo(q(1,1,j),q(1,1,j),ip1jmp1,llm,
    200197     *                             jj_nb_vanleer,0,0,Request_vanleer)
    … …  
    279276c     Appel des sous programmes d'advection
    280277c-----------------------------------------------------------
    281       do iq=1,nqmx
     278      do iq=1,nqtot
    282279c        call clock(t_initial)
    283280        if(iadv(iq) == 0) cycle
    … …  
    479476c$OMP END MASTER
    480477
    481         do j=1,nqmx
     478        do j=1,nqtot
    482479          call Register_SwapFieldHallo(q(1,1,j),q(1,1,j),ip1jmp1,llm,
    483480     *                             jj_nb_caldyn,0,0,Request_vanleer)

  • LMDZ4/trunk/libf/dyn3dpar/caladvtrac_p.F

    r960 r1146  
    88     *                   flxw, pk, iapptrac)
    99      USE parallel
     10      USE infotrac
    1011c
    1112      IMPLICIT NONE
    … …  
    2526#include "comconst.h"
    2627#include "control.h"
    27 #include "advtrac.h"
    2828
    2929c   Arguments:
    3030c   ----------
    3131      REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm),masse(ip1jmp1,llm)
    32       REAL p( ip1jmp1,llmp1),q( ip1jmp1,llm,nqmx),dq( ip1jmp1,llm,2 )
     32      REAL p( ip1jmp1,llmp1),q( ip1jmp1,llm,nqtot),dq( ip1jmp1,llm,2 )
    3333      REAL teta( ip1jmp1,llm),pk( ip1jmp1,llm)
    3434      REAL               :: flxw(ip1jmp1,llm)
    … …  
    4848      REAL finmasse(ip1jmp1,llm), dtvrtrac
    4949     
    50 
    5150cc
    5251c

  • LMDZ4/trunk/libf/dyn3dpar/calfis_p.F

    r1000 r1146  
    44C
    55C
    6       SUBROUTINE calfis_p(nq,
    7      $                  lafin,
     6      SUBROUTINE calfis_p(lafin,
    87     $                  rdayvrai,
    98     $                  heure,
    … …  
    4039      USE Times
    4140      USE IOPHY
     41      USE infotrac
     42
    4243      IMPLICIT NONE
    4344c=======================================================================
    … …  
    9899#include "paramet.h"
    99100#include "temps.h"
    100 #include "advtrac.h"
    101 
    102       INTEGER ngridmx,nq
     101
     102      INTEGER ngridmx
    103103      PARAMETER( ngridmx = 2+(jjm-1)*iim - 1/jjm   )
    104104
    … …  
    119119      REAL pteta(iip1,jjp1,llm)
    120120      REAL pmasse(iip1,jjp1,llm)
    121       REAL pq(iip1,jjp1,llm,nqmx)
     121      REAL pq(iip1,jjp1,llm,nqtot)
    122122      REAL pphis(iip1,jjp1)
    123123      REAL pphi(iip1,jjp1,llm)
    … …  
    126126      REAL pducov(iip1,jjp1,llm)
    127127      REAL pdteta(iip1,jjp1,llm)
    128       REAL pdq(iip1,jjp1,llm,nqmx)
     128      REAL pdq(iip1,jjp1,llm,nqtot)
    129129c
    130130      REAL pps(iip1,jjp1)
    … …  
    135135      REAL pdufi(iip1,jjp1,llm)
    136136      REAL pdhfi(iip1,jjp1,llm)
    137       REAL pdqfi(iip1,jjp1,llm,nqmx)
     137      REAL pdqfi(iip1,jjp1,llm,nqtot)
    138138      REAL pdpsfi(iip1,jjp1)
    139139
    … …  
    253253      ALLOCATE(zphi(klon,llm),zphis(klon))
    254254      ALLOCATE(zufi(klon,llm), zvfi(klon,llm))
    255       ALLOCATE(ztfi(klon,llm),zqfi(klon,llm,nqmx))
     255      ALLOCATE(ztfi(klon,llm),zqfi(klon,llm,nqtot))
    256256      ALLOCATE(pcvgu(klon,llm), pcvgv(klon,llm))
    257257      ALLOCATE(pcvgt(klon,llm), pcvgq(klon,llm,2))
    258258c      ALLOCATE(pvervel(klon,llm))
    259259      ALLOCATE(zdufi(klon,llm),zdvfi(klon,llm))
    260       ALLOCATE(zdtfi(klon,llm),zdqfi(klon,llm,nqmx))
     260      ALLOCATE(zdtfi(klon,llm),zdqfi(klon,llm,nqtot))
    261261      ALLOCATE(zdpsrf(klon))
    262262      ALLOCATE(zdufi2(klon+iim,llm),zdvfi2(klon+iim,llm))
    … …  
    335335c
    336336
    337       DO iq=1,nq
     337      DO iq=1,nqtot
    338338         iiq=niadv(iq)
    339339c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    … …  
    369369      CALL gr_dyn_fi_p(llm,iip1,jjp1,klon,pphi,zphi)
    370370
    371 c$OMP MASTER
    372371      CALL gr_dyn_fi_p(1,iip1,jjp1,klon,pphis,zphis)
    373 c$OMP END MASTER
     372
    374373c$OMP BARRIER
    375374
    … …  
    527526cc$OMP  PARALLEL DEFAULT(NONE)
    528527cc$OMP+ PRIVATE(i,l,offset,iq)
    529 cc$OMP+ SHARED(klon_omp_nb,nq,klon_omp_begin,
     528cc$OMP+ SHARED(klon_omp_nb,nqtot,klon_omp_begin,
    530529cc$OMP+        debut,lafin,rdayvrai,heure,dtphys,zplev,zplay,
    531530cc$OMP+        zphi,zphis,presnivs,clesphy0,zufi,zvfi,ztfi,
    … …  
    549548        allocate(zvfi_omp(klon,llm))
    550549        allocate(ztfi_omp(klon,llm))
    551         allocate(zqfi_omp(klon,llm,nq))
     550        allocate(zqfi_omp(klon,llm,nqtot))
    552551c        allocate(pvervel_omp(klon,llm))
    553552        allocate(zdufi_omp(klon,llm))
    554553        allocate(zdvfi_omp(klon,llm))
    555554        allocate(zdtfi_omp(klon,llm))
    556         allocate(zdqfi_omp(klon,llm,nq))
     555        allocate(zdqfi_omp(klon,llm,nqtot))
    557556        allocate(zdpsrf_omp(klon))
    558557        allocate(flxwfi_omp(klon,llm))
    … …  
    609608      enddo
    610609       
    611       do iq=1,nq
     610      do iq=1,nqtot
    612611        do l=1,llm
    613612          do i=1,klon
    … …  
    641640      enddo
    642641       
    643       do iq=1,nq
     642      do iq=1,nqtot
    644643        do l=1,llm
    645644          do i=1,klon
    … …  
    664663      CALL physiq (klon,
    665664     .             llm,
    666      .             nq,
    667665     .             debut,
    668666     .             lafin,
    … …  
    743741      enddo
    744742       
    745       do iq=1,nq
     743      do iq=1,nqtot
    746744        do l=1,llm
    747745          do i=1,klon
    … …  
    775773      enddo
    776774       
    777       do iq=1,nq
     775      do iq=1,nqtot
    778776        do l=1,llm
    779777          do i=1,klon
    … …  
    896894c  tendance sur la pression :
    897895c  -----------------------------------
    898 c$OMP MASTER
    899896      CALL gr_fi_dyn_p(1,klon,iip1,jjp1,zdpsrf,pdpsfi)
    900 c$OMP END MASTER
    901897c
    902898c   62. enthalpie potentielle
    … …  
    937933c   ---------------------
    938934
    939       DO iq=1,nqmx
     935      DO iq=1,nqtot
    940936c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    941937         DO l=1,llm
    … …  
    976972C
    977973
    978       DO iq=1,nq
     974      DO iq=1,nqtot
    979975         iiq=niadv(iq)
    980976c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)

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

    r774 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/dyn3dpar/comgeom.h

    r774 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/dyn3dpar/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      use misc_mod
    1015      use mod_filtre_fft, ONLY : use_filtre_fft
    … …  
    109114c  Parametres de controle du run:
    110115c-----------------------------------------------------------------------
     116!Config  Key  = planet_type
     117!Config  Desc = planet type ("earth", "mars", "venus", ...)
     118!Config  Def  = earth
     119!Config  Help = this flag sets the type of atymosphere that is considered
     120      planet_type="earth"
     121      CALL getin('planet_type',planet_type)
    111122
    112123!Config  Key  = dayref
    … …  
    189200       CALL getin('periodav',periodav)
    190201
     202!Config  Key  = output_grads_dyn
     203!Config  Desc = output dynamics diagnostics in 'dyn.dat' file
     204!Config  Def  = n
     205!Config  Help = output dynamics diagnostics in Grads-readable 'dyn.dat' file
     206       output_grads_dyn=.false.
     207       CALL getin('output_grads_dyn',output_grads_dyn)
     208
    191209!Config  Key  = idissip
    192210!Config  Desc = periode de la dissipation
    … …  
    284302c    ...............................................................
    285303
     304!Config  Key  =  read_start
     305!Config  Desc = Initialize model using a 'start.nc' file
     306!Config  Def  = y
     307!Config  Help = y: intialize dynamical fields using a 'start.nc' file
     308!               n: fields are initialized by 'iniacademic' routine
     309       read_start= .true.
     310       CALL getin('read_start',read_start)
     311
    286312!Config  Key  = iflag_phys
    287313!Config  Desc = Avec ls physique
    … …  
    341367c
    342368      IF( ABS(clat - clatt).GE. 0.001 )  THEN
    343         PRINT *,' La valeur de clat passee par run.def est differente de
    344      * celle lue sur le fichier  start '
     369        write(lunout,*)'conf_gcm: La valeur de clat passee par run.def',
     370     &    ' est differente de celle lue sur le fichier  start '
    345371        STOP
    346372      ENDIF
    … …  
    356382
    357383      IF( ABS(grossismx - grossismxx).GE. 0.001 )  THEN
    358         PRINT *,' La valeur de grossismx passee par run.def est differente 
    359      * de celle lue sur le fichier  start '
     384        write(lunout,*)'conf_gcm: La valeur de grossismx passee par ',
     385     &  'run.def est differente de celle lue sur le fichier  start '
    360386        STOP
    361387      ENDIF
    … …  
    370396
    371397      IF( ABS(grossismy - grossismyy).GE. 0.001 )  THEN
    372         PRINT *,' La valeur de grossismy passee par run.def est differen
    373      * te de celle lue sur le fichier  start '
     398        write(lunout,*)'conf_gcm: La valeur de grossismy passee par ',
     399     & 'run.def est differente de celle lue sur le fichier  start '
    374400        STOP
    375401      ENDIF
    376402     
    377403      IF( grossismx.LT.1. )  THEN
    378         PRINT *,' ***  ATTENTION !! grossismx < 1 .   *** '
     404        write(lunout,*)
     405     &       'conf_gcm: ***  ATTENTION !! grossismx < 1 .   *** '
    379406         STOP
    380407      ELSE
    … …  
    384411
    385412      IF( grossismy.LT.1. )  THEN
    386         PRINT *,' ***  ATTENTION !! grossismy < 1 .   *** '
     413        write(lunout,*)
     414     &       'conf_gcm: ***  ATTENTION !! grossismy < 1 .   *** '
    387415         STOP
    388416      ELSE
    … …  
    390418      ENDIF
    391419
    392       PRINT *,' alphax alphay defrun ',alphax,alphay
     420      write(lunout,*)'conf_gcm: alphax alphay',alphax,alphay
    393421c
    394422c    alphax et alphay sont les anciennes formulat. des grossissements
    … …  
    405433
    406434      IF( .NOT.fxyhypb )  THEN
    407            IF( fxyhypbb )     THEN
    408               PRINT *,' ********  PBS DANS  DEFRUN  ******** '
    409               PRINT *,' *** fxyhypb lu sur le fichier start est F ',
    410      *       'alors  qu il est  T  sur  run.def  ***'
     435         IF( fxyhypbb )     THEN
     436            write(lunout,*)' ********  PBS DANS  CONF_GCM  ******** '
     437            write(lunout,*)' *** fxyhypb lu sur le fichier start est ',
     438     *       'F alors  qu il est  T  sur  run.def  ***'
    411439              STOP
    412            ENDIF
     440         ENDIF
    413441      ELSE
    414            IF( .NOT.fxyhypbb )   THEN
    415               PRINT *,' ********  PBS DANS  DEFRUN  ******** '
    416               PRINT *,' ***  fxyhypb lu sur le fichier start est T ',
    417      *        'alors  qu il est  F  sur  run.def  ****  '
     442         IF( .NOT.fxyhypbb )   THEN
     443            write(lunout,*)' ********  PBS DANS  CONF_GCM  ******** '
     444            write(lunout,*)' ***  fxyhypb lu sur le fichier start est ',
     445     *        'T alors  qu il est  F  sur  run.def  ****  '
    418446              STOP
    419            ENDIF
     447         ENDIF
    420448      ENDIF
    421449c
    … …  
    430458      IF( fxyhypb )  THEN
    431459       IF( ABS(dzoomx - dzoomxx).GE. 0.001 )  THEN
    432         PRINT *,' La valeur de dzoomx passee par run.def est differente
    433      *  de celle lue sur le fichier  start '
     460        write(lunout,*)'conf_gcm: La valeur de dzoomx passee par ',
     461     *  'run.def est differente de celle lue sur le fichier  start '
    434462        STOP
    435463       ENDIF
    … …  
    446474      IF( fxyhypb )  THEN
    447475       IF( ABS(dzoomy - dzoomyy).GE. 0.001 )  THEN
    448         PRINT *,' La valeur de dzoomy passee par run.def est differente
    449      * de celle lue sur le fichier  start '
     476        write(lunout,*)'conf_gcm: La valeur de dzoomy passee par ',
     477     * 'run.def est differente de celle lue sur le fichier  start '
    450478        STOP
    451479       ENDIF
    … …  
    461489      IF( fxyhypb )  THEN
    462490       IF( ABS(taux - tauxx).GE. 0.001 )  THEN
    463         PRINT *,' La valeur de taux passee par run.def est differente
    464      * de celle lue sur le fichier  start '
     491        write(lunout,*)'conf_gcm: La valeur de taux passee par ',
     492     * 'run.def est differente de celle lue sur le fichier  start '
    465493        STOP
    466494       ENDIF
    … …  
    476504      IF( fxyhypb )  THEN
    477505       IF( ABS(tauy - tauyy).GE. 0.001 )  THEN
    478         PRINT *,' La valeur de tauy passee par run.def est differente
    479      * de celle lue sur le fichier  start '
     506        write(lunout,*)'conf_gcm: La valeur de tauy passee par ',
     507     * 'run.def est differente de celle lue sur le fichier  start '
    480508        STOP
    481509       ENDIF
    … …  
    495523
    496524        IF( .NOT.ysinus )  THEN
    497            IF( ysinuss )     THEN
    498               PRINT *,' ********  PBS DANS  DEFRUN  ******** '
    499               PRINT *,' *** ysinus lu sur le fichier start est F ',
    500      *       'alors  qu il est  T  sur  run.def  ***'
     525          IF( ysinuss )     THEN
     526            write(lunout,*)' ********  PBS DANS  CONF_GCM  ******** '
     527            write(lunout,*)' *** ysinus lu sur le fichier start est F',
     528     *       ' alors  qu il est  T  sur  run.def  ***'
     529            STOP
     530          ENDIF
     531        ELSE
     532          IF( .NOT.ysinuss )   THEN
     533            write(lunout,*)' ********  PBS DANS  CONF_GCM  ******** '
     534            write(lunout,*)' *** ysinus lu sur le fichier start est T',
     535     *        ' alors  qu il est  F  sur  run.def  ****  '
    501536              STOP
    502            ENDIF
    503         ELSE
    504            IF( .NOT.ysinuss )   THEN
    505               PRINT *,' ********  PBS DANS  DEFRUN  ******** '
    506               PRINT *,' ***  ysinus lu sur le fichier start est T ',
    507      *        'alors  qu il est  F  sur  run.def  ****  '
    508               STOP
    509            ENDIF
     537          ENDIF
    510538        ENDIF
    511       ENDIF
     539      ENDIF ! of IF( .NOT.fxyhypb  )
    512540c
    513541!Config  Key  = offline
    … …  
    529557      CALL getin('config_inca',config_inca)
    530558
     559!Config  Key  = ok_dynzon
     560!Config  Desc = calcul et sortie des transports
     561!Config  Def  = n
     562!Config  Help = Permet de mettre en route le calcul des transports
     563!Config         
     564      ok_dynzon = .FALSE.
     565      CALL getin('ok_dynzon',ok_dynzon)
     566
    531567
    532568      write(lunout,*)' #########################################'
    533569      write(lunout,*)' Configuration des parametres du gcm: '
     570      write(lunout,*)' planet_type = ', planet_type
    534571      write(lunout,*)' dayref = ', dayref
    535572      write(lunout,*)' anneeref = ', anneeref
    … …  
    540577      write(lunout,*)' iecri = ', iecri
    541578      write(lunout,*)' periodav = ', periodav
     579      write(lunout,*)' output_grads_dyn = ', output_grads_dyn
    542580      write(lunout,*)' idissip = ', idissip
    543581      write(lunout,*)' lstardis = ', lstardis
    … …  
    550588      write(lunout,*)' coefdis = ', coefdis
    551589      write(lunout,*)' purmats = ', purmats
     590      write(lunout,*)' read_start = ', read_start
    552591      write(lunout,*)' iflag_phys = ', iflag_phys
    553592      write(lunout,*)' clonn = ', clonn
    … …  
    562601      write(lunout,*)' offline = ', offline
    563602      write(lunout,*)' config_inca = ', config_inca
     603      write(lunout,*)' ok_dynzon = ', ok_dynzon
    564604
    565605      RETURN
    … …  
    600640
    601641      IF( grossismx.LT.1. )  THEN
    602         PRINT *,' ***  ATTENTION !! grossismx < 1 .   *** '
     642        write(lunout,*)
     643     &   'conf_gcm: ***  ATTENTION !! grossismx < 1 .   *** '
    603644         STOP
    604645      ELSE
    … …  
    608649
    609650      IF( grossismy.LT.1. )  THEN
    610         PRINT *,' ***  ATTENTION !! grossismy < 1 .   *** '
     651        write(lunout,*)
     652     &  'conf_gcm: ***  ATTENTION !! grossismy < 1 .   *** '
    611653         STOP
    612654      ELSE
    … …  
    614656      ENDIF
    615657
    616       PRINT *,' alphax alphay defrun ',alphax,alphay
     658      write(lunout,*)'conf_gcm: alphax alphay ',alphax,alphay
    617659c
    618660c    alphax et alphay sont les anciennes formulat. des grossissements
    … …  
    685727      CALL getin('config_inca',config_inca)
    686728
     729!Config  Key  = ok_dynzon
     730!Config  Desc = calcul et sortie des transports
     731!Config  Def  = n
     732!Config  Help = Permet de mettre en route le calcul des transports
     733!Config         
     734      ok_dynzon = .FALSE.
     735      CALL getin('ok_dynzon',ok_dynzon)
     736
    687737!Config  Key  = use_filtre_fft
    688738!Config  Desc = flag d'activation des FFT pour le filtre
    … …  
    692742      use_filtre_fft=.FALSE.
    693743      CALL getin('use_filtre_fft',use_filtre_fft)
     744
     745      IF (use_filtre_fft .AND. grossismx /= 1.0) THEN
     746        write(lunout,*)'WARNING !!! '
     747        write(lunout,*)"Le zoom en longitude est incompatible",
     748     &                 " avec l'utilisation du filtre FFT ",
     749     &                 "---> filtre FFT désactivé "
     750       use_filtre_fft=.FALSE.
     751      ENDIF
     752     
     753 
    694754     
    695755!Config  Key  = use_mpi_alloc
    696 !Config  Desc = Utilise un buffer MPI en mémoire globale
     756!Config  Desc = Utilise un buffer MPI en m�moire globale
    697757!Config  Def  = false
    698758!Config  Help = permet d'activer l'utilisation d'un buffer MPI
    699 !Config         en mémoire globale a l'aide de la fonction MPI_ALLOC.
    700 !Config         Cela peut améliorer la bande passante des transferts MPI
     759!Config         en m�moire globale a l'aide de la fonction MPI_ALLOC.
     760!Config         Cela peut am�liorer la bande passante des transferts MPI
    701761!Config         d'un facteur 2 
    702762      use_mpi_alloc=.FALSE.
    … …  
    706766!Config  Desc = taille des blocs openmp
    707767!Config  Def  = 1
    708 !Config  Help = defini la taille des packets d'itération openmp
    709 !Config         distribuée à chaque tâche lors de l'entrée dans une
    710 !Config         boucle parallélisée
     768!Config  Help = defini la taille des packets d'it�ration openmp
     769!Config         distribu�e � chaque t�che lors de l'entr�e dans une
     770!Config         boucle parall�lis�e
    711771 
    712772      omp_chunk=1
    … …  
    716776!Config  Desc = activation de la version strato
    717777!Config  Def  = .FALSE.
    718 !Config  Help = active la version stratosphérique de LMDZ de F. Lott
     778!Config  Help = active la version stratosph�rique de LMDZ de F. Lott
    719779
    720780      ok_strato=.FALSE.
    … …  
    731791      write(lunout,*)' #########################################'
    732792      write(lunout,*)' Configuration des parametres du gcm: '
     793      write(lunout,*)' planet_type = ', planet_type
    733794      write(lunout,*)' dayref = ', dayref
    734795      write(lunout,*)' anneeref = ', anneeref
    … …  
    739800      write(lunout,*)' iecri = ', iecri
    740801      write(lunout,*)' periodav = ', periodav
     802      write(lunout,*)' output_grads_dyn = ', output_grads_dyn
    741803      write(lunout,*)' idissip = ', idissip
    742804      write(lunout,*)' lstardis = ', lstardis
    … …  
    749811      write(lunout,*)' coefdis = ', coefdis
    750812      write(lunout,*)' purmats = ', purmats
     813      write(lunout,*)' read_start = ', read_start
    751814      write(lunout,*)' iflag_phys = ', iflag_phys
    752815      write(lunout,*)' clon = ', clon
    … …  
    754817      write(lunout,*)' grossismx = ', grossismx
    755818      write(lunout,*)' grossismy = ', grossismy
    756       write(lunout,*)' fxyhypbb = ', fxyhypbb
     819      write(lunout,*)' fxyhypb = ', fxyhypb
    757820      write(lunout,*)' dzoomx = ', dzoomx
    758821      write(lunout,*)' dzoomy = ', dzoomy
    … …  
    761824      write(lunout,*)' offline = ', offline
    762825      write(lunout,*)' config_inca = ', config_inca
     826      write(lunout,*)' ok_dynzon = ', ok_dynzon
    763827      write(lunout,*)' use_filtre_fft = ', use_filtre_fft
    764828      write(lunout,*)' use_mpi_alloc = ', use_mpi_alloc

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

    r985 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,        &
    … …  
    2122      REAL periodav
    2223      logical offline
    23       CHARACTER*4 config_inca
     24      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/dyn3dpar/covnat_p.F

    r1000 r1146  
    6161      END DO
    6262
    63       ijb=ij_begin
     63      ijb=ij_begin-iip1
    6464      ije=ij_end
     65      if (pole_nord) ijb=ij_begin
    6566      if (pole_sud)  ije=ij_end-iip1
    6667     

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

    r1017 r1146  
    88       USE mod_const_mpi
    99       USE phys_state_var_mod     
     10       USE infotrac
    1011       IMPLICIT NONE
    1112c
    … …  
    3132#include "paramet.h"
    3233#include "indicesol.h"
    33 #include "advtrac.h"
    3434#include  "control.h"
    3535#include "clesphys.h"
    … …  
    3737!      REAL :: pctsrf(iim*(jjm-1)+2, nbsrf)
    3838
    39 c initialisation traceurs
    40       hadv_flg(:) = 0.
    41       vadv_flg(:) = 0.
    42       conv_flg(:) = 0.
    43       pbl_flg(:)  = 0.
    44       tracnam(:)  = '        '
    45       nprath = 1
    46       nbtrac = 0
    47       mmt_adj(:,:,:,:) = 1
    48 
    4939      IF (config_inca /= 'none') THEN
    5040#ifdef INCA
    5141         call init_const_lmdz(
    52      $        nbtrac,anneeref,dayref,
     42     $        nbtr,anneeref,dayref,
    5343     $        iphysiq,day_step,nday)
    5444#endif
    55          print *, 'nbtrac =' , nbtrac
     45         print *, 'nbtr =' , nbtr
    5646      END IF
    5747
    … …  
    5949
    6050
    61       CALL Init_Phys_lmdz(iim,jjp1,llm,nqmx-2,1,(/(jjm-1)*iim+2/))
     51      CALL Init_Phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/))
    6252      PRINT *,'---> klon=',klon
    6353

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

    r774 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/dyn3dpar/dynetat0.F

    r774 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      USE infotrac
    67      IMPLICIT NONE
    78
    … …  
    3233#include "serre.h"
    3334#include "logic.h"
    34 #include "advtrac.h"
    3535
    3636c   Arguments:
    … …  
    3838
    3939      CHARACTER*(*) fichnom
    40       INTEGER nq
    4140      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
    42       REAL q(ip1jmp1,llm,nq),masse(ip1jmp1,llm)
     41      REAL q(ip1jmp1,llm,nqtot),masse(ip1jmp1,llm)
    4342      REAL ps(ip1jmp1),phis(ip1jmp1)
    4443
    … …  
    5352
    5453c-----------------------------------------------------------------------
    55 
    5654c  Ouverture NetCDF du fichier etat initial
    5755
    … …  
    315313
    316314
    317       IF(nq.GE.1) THEN
    318       DO iq=1,nq
     315      DO iq=1,nqtot
    319316        ierr =  NF_INQ_VARID (nid, tname(iq), nvarid)
    320317        IF (ierr .NE. NF_NOERR) THEN
    … …  
    334331        ENDIF
    335332      ENDDO
    336       ENDIF
    337333
    338334      ierr = NF_INQ_VARID (nid, "masse", nvarid)

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

    r1000 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
     460      DO iq=1,nqtot
    462461cIM 220306 BEG
    463462#ifdef NC_DOUBLE
    … …  
    469468      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,ttext(iq))
    470469      ENDDO
    471       ENDIF
    472470c
    473471      dims4(1) = idim_rlonv
    … …  
    508506      END
    509507      SUBROUTINE dynredem1(fichnom,time,
    510      .                     vcov,ucov,teta,q,nq,masse,ps)
     508     .                     vcov,ucov,teta,q,masse,ps)
     509      USE infotrac
    511510      IMPLICIT NONE
    512511c=================================================================
    … …  
    519518#include "comvert.h"
    520519#include "comgeom.h"
    521 #include "advtrac.h"
    522520#include "temps.h"
    523521#include "control.h"
    524522
    525       INTEGER nq, l
     523      INTEGER l
    526524      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm)
    527525      REAL teta(ip1jmp1,llm)                   
    528526      REAL ps(ip1jmp1),masse(ip1jmp1,llm)                   
    529       REAL q(ip1jmp1,llm,nq)
     527      REAL q(ip1jmp1,llm,nqtot)
    530528      CHARACTER*(*) fichnom
    531529     
    … …  
    633631      END IF
    634632
    635       IF(nq.GE.1) THEN
    636       do iq=1,nq
     633      do iq=1,nqtot
    637634
    638635         IF (config_inca == 'none') THEN
    … …  
    704701     
    705702      ENDDO
    706       ENDIF
    707703c
    708704      ierr = NF_INQ_VARID(nid, "masse", nvarid)

  • LMDZ4/trunk/libf/dyn3dpar/dynredem_p.F

    r1084 r1146  
    33!
    44c
    5       SUBROUTINE dynredem0_p(fichnom,iday_end,phis,nq)
     5      SUBROUTINE dynredem0_p(fichnom,iday_end,phis)
    66      USE IOIPSL
    77      USE parallel
     8      USE infotrac
    89      IMPLICIT NONE
    910c=======================================================================
    … …  
    2324#include "description.h"
    2425#include "serre.h"
    25 #include "advtrac.h"
    2626
    2727c   Arguments:
    … …  
    3030      REAL phis(ip1jmp1)
    3131      CHARACTER*(*) fichnom
    32       INTEGER nq
    3332
    3433c   Local:
    … …  
    5453      INTEGER yyears0,jjour0, mmois0
    5554      character*30 unites
    56 
    5755
    5856c-----------------------------------------------------------------------
    … …  
    461459      dims4(3) = idim_s
    462460      dims4(4) = idim_tim
    463       IF(nq.GE.1) THEN
    464       DO iq=1,nq
     461
     462      DO iq=1,nqtot
    465463cIM 220306 BEG
    466464#ifdef NC_DOUBLE
    … …  
    472470      ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,ttext(iq))
    473471      ENDDO
    474       ENDIF
    475472c
    476473      dims4(1) = idim_rlonv
    … …  
    513510      END
    514511      SUBROUTINE dynredem1_p(fichnom,time,
    515      .                     vcov,ucov,teta,q,nq,masse,ps)
     512     .                     vcov,ucov,teta,q,masse,ps)
    516513      USE parallel
     514      USE infotrac
    517515      IMPLICIT NONE
    518516c=================================================================
    … …  
    525523#include "comvert.h"
    526524#include "comgeom.h"
    527 #include "advtrac.h"
    528525#include "temps.h"
    529526#include "control.h"
    530527
    531       INTEGER nq, l
     528      INTEGER l
    532529      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm)
    533530      REAL teta(ip1jmp1,llm)                   
    534531      REAL ps(ip1jmp1),masse(ip1jmp1,llm)                   
    535       REAL q(ip1jmp1,llm,nq)
     532      REAL q(ip1jmp1,llm,nqtot)
    536533      CHARACTER*(*) fichnom
    537534     
    … …  
    559556      call Gather_Field(ps,ip1jmp1,1,0)
    560557     
    561       do iq=1,nq
     558      do iq=1,nqtot
    562559        call Gather_Field(q(1,1,iq),ip1jmp1,llm,0)
    563560      enddo
    … …  
    660657      END IF
    661658
    662       IF(nq.GE.1) THEN
    663       do iq=1,nq
     659      do iq=1,nqtot
    664660
    665661         IF (config_inca == 'none') THEN
    … …  
    731727     
    732728      ENDDO
    733       ENDIF
    734 
    735729
    736730

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

    r1058 r1146  
    55c
    66      SUBROUTINE etat0_netcdf (interbar, masque)
    7    
     7#ifdef CPP_EARTH       
    88      USE startvar
    99      USE ioipsl
    … …  
    1212      USE pbl_surface_mod
    1313      USE phys_state_var_mod
     14      USE filtreg_mod
     15      USE infotrac
     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),
     45      REAL :: orog(iip1,jjp1), rugo(iip1,jjp1),
    3546     . psol(iip1, jjp1), phis(iip1, jjp1)
    3647      REAL :: p3d(iip1, jjp1, llm+1)
    … …  
    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 :: qsat(iip1, jjp1, llm)
     52      REAL,ALLOCATABLE :: q3d(:, :, :,:)
    4153      REAL :: tsol(klon), qsol(klon), sn(klon)
    4254      REAL :: tsolsrf(klon,nbsrf), qsolsrf(klon,nbsrf),snsrf(klon,nbsrf)
    … …  
    141153      !
    142154      preff     = 101325.
     155      pa        =  50000.
    143156      unskap = 1./kappa
    144157      !
    … …  
    164177      print*,'dtvr',dtvr
    165178
    166       CALL inicons0()
     179      CALL iniconst()
    167180      CALL inigeom()
    168181      !
    169182      CALL inifilr()
     183C init pour traceurs
     184      call infotrac_init
     185      ALLOCATE(q3d(iip1, jjp1, llm,nqtot))
    170186!      CALL phys_state_var_init()
    171187      !
    … …  
    623639      phis(iip1,:) = phis(1,:)
    624640
    625 C init pour traceurs
    626       call iniadvtrac(nq)
    627641C Ecriture
    628642      CALL inidissip( lstardis, nitergdiv, nitergrot, niterh   ,
    … …  
    648662     *                phi,w, pbaru,pbarv,time+iday-dayref   )
    649663       print*,'sortie caldyn0'     
    650       CALL dynredem0("start.nc",dayref,phis,nqmx)
     664      CALL dynredem0("start.nc",dayref,phis)
    651665      print*,'sortie dynredem0'
    652       CALL dynredem1("start.nc",0.0,vvent,uvent,tpot,q3d,nqmx,masse ,
     666      CALL dynredem1("start.nc",0.0,vvent,uvent,tpot,q3d,masse ,
    653667     .                            psol)
    654668      print*,'sortie dynredem1'
    … …  
    742756      visu_file='Etat0_visu.nc'
    743757      CALL initdynav(visu_file,dayref,anneeref,time_step,
    744      .              t_ops, t_wrt, nqmx, visuid)
    745       CALL writedynav(visuid, nqmx, itau,vvent ,
     758     .              t_ops, t_wrt, visuid)
     759      CALL writedynav(visuid, itau,vvent ,
    746760     .                uvent,tpot,pk,phi,q3d,masse,psol,phis)
    747761      else
    … …  
    750764      print*,'entree histclo'
    751765      CALL histclo
     766
     767#endif
     768!#endif of #ifdef CPP_EARTH
    752769      RETURN
    753770      !

  • LMDZ4/trunk/libf/dyn3dpar/filtreg_p.F

    r985 r1146  
    22
    33      SUBROUTINE filtreg_p ( champ, ibeg, iend, nlat, nbniv,
    4      .                       ifiltre, iaire, griscal ,iter)
    5       USE Parallel, only : OMP_CHUNK 
     4     &     ifiltre, iaire, griscal ,iter)
     5      USE Parallel, only : OMP_CHUNK
    66      USE mod_filtre_fft
    77      USE timer_filtre
     8     
     9      USE filtreg_mod
     10     
    811      IMPLICIT NONE
    9 
     12     
    1013c=======================================================================
    1114c
    … …  
    5053#include "dimensions.h"
    5154#include "paramet.h"
    52 #include "parafilt.h"
    5355#include "coefils.h"
    5456c
    … …  
    5759      INTEGER iim2,immjm
    5860      INTEGER jdfil1,jdfil2,jffil1,jffil2,jdfil,jffil
    59 
     61     
    6062      REAL  champ( iip1,nlat,nbniv)
    61       REAL matriceun,matriceus,matricevn,matricevs,matrinvn,matrinvs
    62       COMMON/matrfil/matriceun(iim,iim,nfilun),matriceus(iim,iim,nfilus)
    63      ,             , matricevn(iim,iim,nfilvn),matricevs(iim,iim,nfilvs)
    64      ,             ,  matrinvn(iim,iim,nfilun),matrinvs (iim,iim,nfilus)
    65 cym      REAL  eignq(iim), sdd1(iim),sdd2(iim)
    66 
    67       REAL  eignq(iim)
    68       REAL :: sdd1(iim),sdd2(iim)
    6963     
    7064      LOGICAL    griscal
    … …  
    7468      REAL :: champ_in(iip1,nlat,nbniv)
    7569     
    76       REAL,SAVE,TARGET :: sddu_loc(iim)
    77       REAL,SAVE,TARGET :: sddv_loc(iim)
    78       REAL,SAVE,TARGET :: unsddu_loc(iim)
    79       REAL,SAVE,TARGET :: unsddv_loc(iim)
    80 c$OMP THREADPRIVATE(sddu_loc,sddv_loc,unsddu_loc,unsddv_loc)
    8170      LOGICAL,SAVE     :: first=.TRUE.
    8271c$OMP THREADPRIVATE(first)
    8372
     73      REAL, DIMENSION(iip1,nlat,nbniv) :: champ_loc
     74      INTEGER :: ll_nb, nbniv_loc
     75      REAL, SAVE :: sdd12(iim,4)
     76c$OMP THREADPRIVATE(sdd12)
     77
     78      INTEGER, PARAMETER :: type_sddu=1
     79      INTEGER, PARAMETER :: type_sddv=2
     80      INTEGER, PARAMETER :: type_unsddu=3
     81      INTEGER, PARAMETER :: type_unsddv=4
     82
     83      INTEGER :: sdd1_type, sdd2_type
     84
    8485      IF (first) THEN
    85         sddu_loc(1:iim)=sddu(1:iim)
    86         sddv_loc(1:iim)=sddv(1:iim)
    87         unsddu_loc(1:iim)=unsddu(1:iim)
    88         unsddv_loc(1:iim)=unsddv(1:iim)
    89         CALL Init_timer
    90         first=.FALSE.
    91 c       PRINT *,"----> sddu_loc=",sddu_loc
    92 c       PRINT *,"----> sddv_loc=",sddv_loc
    93 c       PRINT *,"----> unsddu_loc=",unsddu_loc
    94 c       PRINT *,"----> unsddv_loc=",unsddv_loc
     86         sdd12(1:iim,type_sddu) = sddu(1:iim)
     87         sdd12(1:iim,type_sddv) = sddv(1:iim)
     88         sdd12(1:iim,type_unsddu) = unsddu(1:iim)
     89         sdd12(1:iim,type_unsddv) = unsddv(1:iim)
     90
     91         CALL Init_timer
     92         first=.FALSE.
    9593      ENDIF
    9694
    … …  
    9997c$OMP END MASTER
    10098
     99c-------------------------------------------------------c
     100
    101101      IF(ifiltre.EQ.1.or.ifiltre.EQ.-1)
    102      *    STOP'Pas de transformee simple dans cette version'
    103 
     102     &     STOP'Pas de transformee simple dans cette version'
     103     
    104104      IF( iter.EQ. 2 )  THEN
    105        PRINT *,' Pas d iteration du filtre dans cette version !'
    106      * , ' Utiliser old_filtreg et repasser !'
    107            STOP
     105         PRINT *,' Pas d iteration du filtre dans cette version !'
     106     &        , ' Utiliser old_filtreg et repasser !'
     107         STOP
    108108      ENDIF
    109109
    110110      IF( ifiltre.EQ. -2 .AND..NOT.griscal )     THEN
    111        PRINT *,' Cette routine ne calcule le filtre inverse que ',
    112      * ' sur la grille des scalaires !'
    113            STOP
     111         PRINT *,' Cette routine ne calcule le filtre inverse que '
     112     &        , ' sur la grille des scalaires !'
     113         STOP
    114114      ENDIF
    115115
    116116      IF( ifiltre.NE.2 .AND.ifiltre.NE. - 2 )  THEN
    117        PRINT *,' Probleme dans filtreg car ifiltre NE 2 et NE -2'
    118      *,' corriger et repasser !'
    119            STOP
     117         PRINT *,' Probleme dans filtreg car ifiltre NE 2 et NE -2'
     118     &        , ' corriger et repasser !'
     119         STOP
    120120      ENDIF
    121121c
    … …  
    127127      IF( griscal )   THEN
    128128         IF( nlat. NE. jjp1 )  THEN
    129              PRINT  1111
    130              STOP
     129            PRINT  1111
     130            STOP
    131131         ELSE
    132 c
    133              IF( iaire.EQ.1 )  THEN
    134 cym                CALL SCOPY(  iim,    sddv, 1,  sdd1, 1 )
    135 cym                CALL SCOPY(  iim,  unsddv, 1,  sdd2, 1 )
    136 cym               sdd1=>sddv_loc
    137 cym               sdd2=>unsddv_loc
    138                sdd1(1:iim)=sddv_loc(1:iim)
    139                sdd2(1:iim)=unsddv_loc(1:iim)
    140              ELSE
    141 cym                CALL SCOPY(  iim,  unsddv, 1,  sdd1, 1 )
    142 cym                CALL SCOPY(  iim,    sddv, 1,  sdd2, 1 )
    143                sdd1(1:iim)=unsddv_loc(1:iim)
    144                sdd2(1:iim)=sddv_loc(1:iim)
    145              END IF
    146 c
    147              jdfil1 = 2
    148              jffil1 = jfiltnu
    149              jdfil2 = jfiltsu
    150              jffil2 = jjm
    151           END IF
     132c     
     133            IF( iaire.EQ.1 )  THEN
     134               sdd1_type = type_sddv
     135               sdd2_type = type_unsddv
     136            ELSE
     137               sdd1_type = type_unsddv
     138               sdd2_type = type_sddv
     139            ENDIF
     140c
     141            jdfil1 = 2
     142            jffil1 = jfiltnu
     143            jdfil2 = jfiltsu
     144            jffil2 = jjm
     145         ENDIF
    152146      ELSE
    153           IF( nlat.NE.jjm )  THEN
    154              PRINT  2222
    155              STOP
    156           ELSE
    157 c
    158              IF( iaire.EQ.1 )  THEN
    159 cym                CALL SCOPY(  iim,    sddu, 1,  sdd1, 1 )
    160 cym                CALL SCOPY(  iim,  unsddu, 1,  sdd2, 1 )
    161 cym                sdd1=>sddu_loc
    162 cym                sdd2=>unsddu_loc
    163                 sdd1(1:iim)=sddu_loc(1:iim)
    164                 sdd2(1:iim)=unsddu_loc(1:iim)
    165 
    166              ELSE
    167 cym                CALL SCOPY(  iim,  unsddu, 1,  sdd1, 1 )
    168 cym                CALL SCOPY(  iim,    sddu, 1,  sdd2, 1 )
    169 cym               sdd1=>unsddu_loc
    170 cym               sdd2=>sddu_loc
    171                sdd1(1:iim)=unsddu_loc(1:iim)
    172                sdd2(1:iim)=sddu_loc(1:iim)
    173              END IF
    174 c
    175              jdfil1 = 1
    176              jffil1 = jfiltnv
    177              jdfil2 = jfiltsv
    178              jffil2 = jjm
    179           END IF
    180       END IF
    181 
    182 c      PRINT *,"APPEL a filtreg --> sdd1=",sdd1
    183 c      PRINT *,"APPEL a filtreg --> sdd2=",sdd2
    184 c      PRINT *,"----> sddu_loc=",sddu_loc
    185 c       PRINT *,"----> sddv_loc=",sddv_loc
    186 c       PRINT *,"----> unsddu_loc=",unsddu_loc
    187 c       PRINT *,"----> unsddv_loc=",unsddv_loc
    188  
    189 c
    190 c
    191       DO 100  hemisph = 1, 2
    192 c
    193       IF ( hemisph.EQ.1 )  THEN
    194 c ym
    195           jdfil = max(jdfil1,ibeg)
    196           jffil = min(jffil1,iend)
    197       ELSE
    198 c ym
    199           jdfil = max(jdfil2,ibeg)
    200           jffil = min(jffil2,iend)
    201       END IF
     147         IF( nlat.NE.jjm )  THEN
     148            PRINT  2222
     149            STOP
     150         ELSE
     151c
     152            IF( iaire.EQ.1 )  THEN
     153               sdd1_type = type_sddu
     154               sdd2_type = type_unsddu
     155            ELSE
     156               sdd1_type = type_unsddu
     157               sdd2_type = type_sddu
     158            ENDIF
     159c     
     160            jdfil1 = 1
     161            jffil1 = jfiltnv
     162            jdfil2 = jfiltsv
     163            jffil2 = jjm
     164         ENDIF
     165      ENDIF
     166c     
     167      DO hemisph = 1, 2
     168c     
     169         IF ( hemisph.EQ.1 )  THEN
     170cym
     171            jdfil = max(jdfil1,ibeg)
     172            jffil = min(jffil1,iend)
     173         ELSE
     174cym
     175            jdfil = max(jdfil2,ibeg)
     176            jffil = min(jffil2,iend)
     177         ENDIF
    202178
    203179
    … …  
    206182cccccccccccccccccccccccccccccccccccccccccccc
    207183
    208       IF (.NOT. use_filtre_fft) THEN
    209      
    210 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)   
    211       DO 50  l = 1, nbniv
    212         DO 30  j = jdfil,jffil
    213  
    214  
    215           DO  5  i = 1, iim
    216             champ(i,j,l) = champ(i,j,l) * sdd1(i)
    217    5      CONTINUE
    218 c
    219 
    220           IF( hemisph. EQ. 1 )      THEN
    221 
    222             IF( ifiltre. EQ. -2 )   THEN
    223 
    224 
    225               CALL SGEMV("N", iim,iim, 1.0, matrinvn(1,1,j),iim,
    226      .                     champ(1,j,l), 1, 0.0, eignq, 1)
    227 
    228 
    229             ELSE IF ( griscal )     THEN
    230 
    231               CALL SGEMV("N", iim,iim, 1.0, matriceun(1,1,j),iim,
    232      .                    champ(1,j,l), 1, 0.0, eignq, 1)
    233 
    234             ELSE
    235 
    236               CALL SGEMV("N", iim,iim, 1.0, matricevn(1,1,j),iim,
    237      .                   champ(1,j,l), 1, 0.0, eignq, 1)
    238             ENDIF
    239 
    240           ELSE
    241 
    242             IF( ifiltre. EQ. -2 )   THEN
    243      
    244               CALL SGEMV("N",iim,iim,1.0, matrinvs(1,1,j-jfiltsu+1),iim,
    245      .                   champ(1,j,l), 1, 0.0, eignq, 1)
    246      
    247             ELSE IF ( griscal )     THEN
    248      
    249               CALL SGEMV("N",iim,iim,1.0,matriceus(1,1,j-jfiltsu+1),iim,
    250      .                   champ(1,j,l), 1, 0.0, eignq, 1)
    251             ELSE
    252          
    253               CALL SGEMV("N",iim,iim,1.0,matricevs(1,1,j-jfiltsv+1),iim,
    254      .                    champ(1,j,l), 1, 0.0, eignq, 1)
    255             ENDIF
    256 
    257           ENDIF
    258 
    259 
    260 c
    261           IF( ifiltre.EQ. 2 )  THEN
    262          
    263             DO 15 i = 1, iim
    264               champ( i,j,l ) = ( champ(i,j,l) + eignq(i) ) * sdd2(i)
    265   15        CONTINUE
    266          
    267           ELSE
    268        
    269             DO 16 i=1,iim
    270                champ( i,j,l ) = ( champ(i,j,l) - eignq(i) ) * sdd2(i)
    271 16          CONTINUE
    272          
    273           ENDIF
    274 c
    275           champ( iip1,j,l ) = champ( 1,j,l )
    276 c
    277   30    CONTINUE
    278 c
    279   50  CONTINUE
     184         IF (.NOT. use_filtre_fft) THEN
     185     
     186c     !---------------------------------!
     187c     ! Agregation des niveau verticaux !
     188c     ! uniquement necessaire pour une  !
     189c     ! execution OpenMP                !
     190c     !---------------------------------!
     191            ll_nb = 0
     192c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     193            DO l = 1, nbniv
     194               ll_nb = ll_nb+1
     195               DO j = jdfil,jffil
     196                  DO i = 1, iim
     197                     champ_loc(i,j,ll_nb) =
     198     &                    champ(i,j,l) * sdd12(i,sdd1_type)
     199                  ENDDO
     200               ENDDO
     201            ENDDO
    280202c$OMP END DO NOWAIT
    281203
     204            nbniv_loc = ll_nb
     205
     206            IF( hemisph.EQ.1 )      THEN
     207               
     208               IF( ifiltre.EQ.-2 )   THEN
     209                  DO j = jdfil,jffil
     210                     CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0,
     211     &                    matrinvn(1,1,j), iim,
     212     &                    champ_loc(1,j,1), iip1*nlat, 0.0,
     213     &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
     214                  ENDDO
     215                 
     216               ELSE IF ( griscal )     THEN
     217                  DO j = jdfil,jffil
     218                     CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0,
     219     &                    matriceun(1,1,j), iim,
     220     &                    champ_loc(1,j,1), iip1*nlat, 0.0,
     221     &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
     222                  ENDDO
     223                 
     224               ELSE
     225                  DO j = jdfil,jffil
     226                     CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0,
     227     &                    matricevn(1,1,j), iim,
     228     &                    champ_loc(1,j,1), iip1*nlat, 0.0,
     229     &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
     230                  ENDDO
     231                 
     232               ENDIF
     233               
     234            ELSE
     235               
     236               IF( ifiltre.EQ.-2 )   THEN
     237                  DO j = jdfil,jffil
     238                     CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0,
     239     &                    matrinvs(1,1,j-jfiltsu+1), iim,
     240     &                    champ_loc(1,j,1), iip1*nlat, 0.0,
     241     &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
     242                  ENDDO
     243                 
     244               ELSE IF ( griscal )     THEN
     245                 
     246                  DO j = jdfil,jffil
     247                     CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0,
     248     &                    matriceus(1,1,j-jfiltsu+1), iim,
     249     &                    champ_loc(1,j,1), iip1*nlat, 0.0,
     250     &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
     251                  ENDDO
     252                 
     253               ELSE
     254                 
     255                  DO j = jdfil,jffil
     256                     CALL DGEMM("N", "N", iim, nbniv_loc, iim, 1.0,
     257     &                    matricevs(1,1,j-jfiltsv+1), iim,
     258     &                    champ_loc(1,j,1), iip1*nlat, 0.0,
     259     &                    champ_fft(1,j-jdfil+1,1), iip1*nlat)
     260                  ENDDO
     261                 
     262               ENDIF
     263               
     264            ENDIF
     265!     c     
     266            IF( ifiltre.EQ.2 )  THEN
     267               
     268c     !-------------------------------------!
     269c     ! Dés-agregation des niveau verticaux !
     270c     ! uniquement necessaire pour une      !
     271c     ! execution OpenMP                    !
     272c     !-------------------------------------!
     273               ll_nb = 0
     274c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     275               DO l = 1, nbniv
     276                  ll_nb = ll_nb + 1
     277                  DO j = jdfil,jffil
     278                     DO i = 1, iim
     279                        champ( i,j,l ) = (champ_loc(i,j,ll_nb)
     280     &                       + champ_fft(i,j-jdfil+1,ll_nb))
     281     &                       * sdd12(i,sdd2_type)
     282                     ENDDO
     283                  ENDDO
     284               ENDDO
     285c$OMP END DO NOWAIT
     286               
     287            ELSE
     288               
     289               ll_nb = 0
     290c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     291               DO l = 1, nbniv_loc
     292                  ll_nb = ll_nb + 1
     293                  DO j = jdfil,jffil
     294                     DO i = 1, iim
     295                        champ( i,j,l ) = (champ_loc(i,j,ll_nb)
     296     &                       - champ_fft(i,j-jdfil+1,ll_nb))
     297     &                       * sdd12(i,sdd2_type)
     298                     ENDDO
     299                  ENDDO
     300               ENDDO
     301c$OMP END DO NOWAIT
     302               
     303            ENDIF
     304           
     305c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     306            DO l = 1, nbniv
     307               DO j = jdfil,jffil
     308                  champ( iip1,j,l ) = champ( 1,j,l )
     309               ENDDO
     310            ENDDO
     311c$OMP END DO NOWAIT
     312           
    282313ccccccccccccccccccccccccccccccccccccccccccccc
    283314c Utilisation du filtre FFT
    284315ccccccccccccccccccccccccccccccccccccccccccccc
    285316       
    286        ELSE
     317         ELSE
    287318       
    288319c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    289           DO l=1,nbniv
    290             DO j=jdfil,jffil
    291               DO  i = 1, iim
    292                 champ( i,j,l)= champ(i,j,l)*sdd1(i)
    293                 champ_fft( i,j,l) = champ(i,j,l)
    294               ENDDO
     320            DO l=1,nbniv
     321               DO j=jdfil,jffil
     322                  DO  i = 1, iim
     323                     champ( i,j,l)= champ(i,j,l)*sdd12(i,sdd1_type)
     324                     champ_fft( i,j,l) = champ(i,j,l)
     325                  ENDDO
     326               ENDDO
    295327            ENDDO
    296           ENDDO
    297328c$OMP END DO NOWAIT
    298329
    299       IF (jdfil<=jffil) THEN
    300         IF( ifiltre. EQ. -2 )   THEN
    301           CALL Filtre_inv_fft(champ_fft,nlat,jdfil,jffil,nbniv)
    302         ELSE IF ( griscal )     THEN
    303           CALL Filtre_u_fft(champ_fft,nlat,jdfil,jffil,nbniv)
    304         ELSE
    305           CALL Filtre_v_fft(champ_fft,nlat,jdfil,jffil,nbniv)
    306         ENDIF
    307       ENDIF
    308 
    309 
    310         IF( ifiltre.EQ. 2 )  THEN
     330            IF (jdfil<=jffil) THEN
     331               IF( ifiltre. EQ. -2 )   THEN
     332                  CALL Filtre_inv_fft(champ_fft,nlat,jdfil,jffil,nbniv)
     333               ELSE IF ( griscal )     THEN
     334                  CALL Filtre_u_fft(champ_fft,nlat,jdfil,jffil,nbniv)
     335               ELSE
     336                  CALL Filtre_v_fft(champ_fft,nlat,jdfil,jffil,nbniv)
     337               ENDIF
     338            ENDIF
     339
     340
     341            IF( ifiltre.EQ. 2 )  THEN
    311342c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)         
    312           DO l=1,nbniv
    313             DO j=jdfil,jffil
    314               DO  i = 1, iim
    315                 champ( i,j,l)=(champ(i,j,l)+champ_fft(i,j,l))
    316      .                             *sdd2(i)
    317               ENDDO
    318             ENDDO
    319           ENDDO
     343               DO l=1,nbniv
     344                  DO j=jdfil,jffil
     345                     DO  i = 1, iim
     346                        champ( i,j,l)=(champ(i,j,l)+champ_fft(i,j,l))
     347     &                       *sdd12(i,sdd2_type)
     348                     ENDDO
     349                  ENDDO
     350               ENDDO
    320351c$OMP END DO NOWAIT       
    321         ELSE
     352            ELSE
    322353       
    323354c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 
    324           DO l=1,nbniv
    325             DO j=jdfil,jffil
    326               DO  i = 1, iim
    327                 champ(i,j,l)=(champ(i,j,l)-champ_fft(i,j,l))
    328      .                            *sdd2(i)
    329               ENDDO
     355               DO l=1,nbniv
     356                  DO j=jdfil,jffil
     357                     DO  i = 1, iim
     358                        champ(i,j,l)=(champ(i,j,l)-champ_fft(i,j,l))
     359     &                       *sdd12(i,sdd2_type)
     360                     ENDDO
     361                  ENDDO
     362               ENDDO
     363c$OMP END DO NOWAIT         
     364            ENDIF
     365c
     366c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     367            DO l=1,nbniv
     368               DO j=jdfil,jffil
     369!            champ_FFT( iip1,j,l ) = champ_FFT( 1,j,l )
     370                  champ( iip1,j,l ) = champ( 1,j,l )
     371               ENDDO
    330372            ENDDO
    331           ENDDO
    332 c$OMP END DO NOWAIT         
    333         ENDIF
    334 c
    335 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    336         DO l=1,nbniv
    337           DO j=jdfil,jffil
    338 !            champ_FFT( iip1,j,l ) = champ_FFT( 1,j,l )
    339             champ( iip1,j,l ) = champ( 1,j,l )
    340           ENDDO
    341         ENDDO
    342373c$OMP END DO NOWAIT             
    343       ENDIF
     374         ENDIF
    344375c Fin de la zone de filtrage
    345376
    346377       
    347  100  CONTINUE
     378      ENDDO
    348379
    349380!      DO j=1,nlat
    … …  
    359390     
    360391c
    361 1111 FORMAT(//20x,'ERREUR dans le dimensionnement du tableau  CHAMP a
    362      *filtrer, sur la grille des scalaires'/)
    363 2222 FORMAT(//20x,'ERREUR dans le dimensionnement du tableau CHAMP a fi
    364      *ltrer, sur la grille de V ou de Z'/)
     392 1111 FORMAT(//20x,'ERREUR dans le dimensionnement du tableau  CHAMP a
     393     &     filtrer, sur la grille des scalaires'/)
     394 2222 FORMAT(//20x,'ERREUR dans le dimensionnement du tableau CHAMP a fi
     395     &     ltrer, sur la grille de V ou de Z'/)
    365396c$OMP MASTER     
    366397      CALL stop_timer

  • LMDZ4/trunk/libf/dyn3dpar/fluxstokenc_p.F

    r1021 r1146  
    6161        CALL initfluxsto_p( 'fluxstoke',
    6262     .  time_step,istdyn* time_step,istdyn* time_step,
    63      . nqmx, fluxid,fluxvid,fluxdid)
     63     . fluxid,fluxvid,fluxdid)
    6464       
    6565        ijb=ij_begin

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

    r1084 r1146  
    99      USE IOIPSL
    1010#endif
     11
    1112      USE mod_const_mpi, ONLY: init_const_mpi
    1213      USE parallel
    1314      USE mod_phys_lmdz_para, ONLY : klon_mpi_para_nb
    14       USE mod_grid_phy_lmdz
    15       USE mod_phys_lmdz_omp_data, ONLY: klon_omp
    16       USE dimphy
     15      USE infotrac
    1716      USE mod_interface_dyn_phys
    18       USE comgeomphy
    1917      USE mod_hallo
    2018      USE Bands
     19
     20      USE filtreg_mod
     21
     22! Ehouarn: for now these only apply to Earth:
     23#ifdef CPP_EARTH
     24      USE mod_grid_phy_lmdz
     25      USE mod_phys_lmdz_omp_data, ONLY: klon_omp
     26      USE dimphy
     27      USE comgeomphy
     28#endif
    2129      IMPLICIT NONE
    2230
    … …  
    6573#include "iniprint.h"
    6674#include "tracstoke.h"
    67 #include "advtrac.h"
    6875
    6976      INTEGER         longcles
    … …  
    8188      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
    8289      REAL teta(ip1jmp1,llm)                 ! temperature potentielle
    83       REAL q(ip1jmp1,llm,nqmx)              ! champs advectes
     90      REAL, ALLOCATABLE, DIMENSION(:,:,:) :: q ! champs advectes
    8491      REAL ps(ip1jmp1)                       ! pression  au sol
    8592c      REAL p (ip1jmp1,llmp1  )               ! pression aux interfac.des couches
    … …  
    136143c    variables pour l'initialisation de la physique :
    137144c    ------------------------------------------------
    138       INTEGER ngridmx,nq
     145      INTEGER ngridmx
    139146      PARAMETER( ngridmx = 2+(jjm-1)*iim - 1/jjm   )
    140147      REAL zcufi(ngridmx),zcvfi(ngridmx)
    … …  
    158165
    159166
    160 c initialisation Anne
    161       hadv_flg(:) = 0.
    162       vadv_flg(:) = 0.
    163       conv_flg(:) = 0.
    164       pbl_flg(:)  = 0.
    165       tracnam(:)  = '        '
    166       nprath = 1
    167       nbtrac = 0
    168       mmt_adj(:,:,:,:) = 1
    169 
    170 
    171 c--------------------------------------------------------------------------
    172 c   Iflag_phys controle l'appel a la physique :
    173 c   -------------------------------------------
    174 c      0 : pas de physique
    175 c      1 : Normale (appel a phylmd, phymars ...)
    176 c      2 : rappel Newtonien pour la temperature + friction au sol
    177       iflag_phys=1
    178 
    179 c--------------------------------------------------------------------------
    180 c   Lecture de l'etat initial :
    181 c   ---------------------------
    182 c     T : on lit start.nc
    183 c     F : le modele s'autoinitialise avec un cas academique (iniacademic)
    184 #ifdef CPP_IOIPSL
    185       read_start=.true.
    186 #else
    187       read_start=.false.
    188 #endif
    189 
    190167c-----------------------------------------------------------------------
    191168c   Choix du calendrier
    … …  
    203180c  ---------------------------------------
    204181c
    205 #ifdef CPP_IOIPSL
     182! Ehouarn: dump possibility of using defrun
     183!#ifdef CPP_IOIPSL
    206184      CALL conf_gcm( 99, .TRUE. , clesphy0 )
    207 #else
    208       CALL defrun( 99, .TRUE. , clesphy0 )
    209 #endif
     185!#else
     186!      CALL defrun( 99, .TRUE. , clesphy0 )
     187!#endif
    210188c
    211189c
    … …  
    217195      call init_parallel
    218196      call Read_Distrib
    219       CALL Init_Phys_lmdz(iim,jjp1,llm,nqmx-2,mpi_size,distrib_phys)
     197! Ehouarn : temporarily (?) keep this only for Earth
     198      if (planet_type.eq."earth") then
     199#ifdef CPP_EARTH
     200        CALL Init_Phys_lmdz(iim,jjp1,llm,mpi_size,distrib_phys)
     201#endif
     202      endif ! of if (planet_type.eq."earth")
    220203      CALL set_bands
    221204      CALL Init_interface_dyn_phys
    … …  
    229212c$OMP END PARALLEL
    230213
     214! Ehouarn : temporarily (?) keep this only for Earth
     215      if (planet_type.eq."earth") then
     216#ifdef CPP_EARTH
    231217c$OMP PARALLEL
    232218      call InitComgeomphy
    233219c$OMP END PARALLEL
     220#endif
     221      endif ! of if (planet_type.eq."earth")
    234222
    235223      IF (config_inca /= 'none') THEN
    236224#ifdef INCA
    237225         call init_const_lmdz(
    238      $        nbtrac,anneeref,dayref,
     226     $        nbtr,anneeref,dayref,
    239227     $        iphysiq,day_step,nday)
    240228
    … …  
    248236c   Initialisation des traceurs
    249237c   ---------------------------
    250 c  Choix du schema pour l'advection
    251 c  dans fichier trac.def ou via INCA
    252 
    253        call iniadvtrac(nq)
    254 c
     238c  Choix du nombre de traceurs et du schema pour l'advection
     239c  dans fichier traceur.def, par default ou via INCA
     240      call infotrac_init
     241
     242c Allocation de la tableau q : champs advectes   
     243      ALLOCATE(q(ip1jmp1,llm,nqtot))
     244
    255245c-----------------------------------------------------------------------
    256246c   Lecture de l'etat initial :
    … …  
    259249c  lecture du fichier start.nc
    260250      if (read_start) then
    261 #ifdef CPP_IOIPSL
    262          CALL dynetat0("start.nc",nqmx,vcov,ucov,
     251      ! we still need to run iniacademic to initialize some
     252      ! constants & fields, if we run the 'newtonian' case:
     253        if (iflag_phys.eq.2) then
     254          CALL iniacademic(vcov,ucov,teta,q,masse,ps,phis,time_0)
     255        endif
     256!#ifdef CPP_IOIPSL
     257        if (planet_type.eq."earth") then
     258#ifdef CPP_EARTH
     259! Load an Earth-format start file
     260         CALL dynetat0("start.nc",vcov,ucov,
    263261     .              teta,q,masse,ps,phis, time_0)
     262#endif
     263        endif ! of if (planet_type.eq."earth")
    264264c       write(73,*) 'ucov',ucov
    265265c       write(74,*) 'vcov',vcov
    … …  
    268268c       write(77,*) 'q',q
    269269
    270 #endif
    271       endif
     270      endif ! of if (read_start)
    272271
    273272c le cas echeant, creation d un etat initial
    274273      IF (prt_level > 9) WRITE(lunout,*)
    275      .                 'AVANT iniacademic AVANT AVANT AVANT AVANT'
     274     .              'GCM: AVANT iniacademic AVANT AVANT AVANT AVANT'
    276275      if (.not.read_start) then
    277          CALL iniacademic(nqmx,vcov,ucov,teta,q,masse,ps,phis,time_0)
     276         CALL iniacademic(vcov,ucov,teta,q,masse,ps,phis,time_0)
    278277      endif
    279 
    280278
    281279c-----------------------------------------------------------------------
    … …  
    359357c   Initialisation de la physique :
    360358c   -------------------------------
    361 #ifdef CPP_PHYS
    362359      IF (call_iniphys.and.iflag_phys.eq.1) THEN
    363360         latfi(1)=rlatu(1)
    … …  
    380377
    381378         WRITE(lunout,*)
    382      .           'WARNING!!! vitesse verticale nulle dans la physique'
    383 
     379     .       'GCM: WARNING!!! vitesse verticale nulle dans la physique'
     380! Earth:
     381         if (planet_type.eq."earth") then
     382#ifdef CPP_EARTH
    384383         CALL iniphysiq(ngridmx,llm,daysec,day_ini,dtphys ,
    385384     ,                latfi,lonfi,airefi,zcufi,zcvfi,rad,g,r,cpp     )
    386 
     385#endif
     386         endif ! of if (planet_type.eq."earth")
    387387         call_iniphys=.false.
    388 
    389       ENDIF
    390 #endif
     388      ENDIF ! of IF (call_iniphys.and.(iflag_phys.eq.1))
    391389
    392390
    … …  
    404402
    405403c-----------------------------------------------------------------------
     404c   Initialisation des dimensions d'INCA :
     405c   --------------------------------------
     406      IF (config_inca /= 'none') THEN
     407!$OMP PARALLEL
     408#ifdef INCA
     409         CALL init_inca_dim(klon_omp,llm,iim,jjm,
     410     $        rlonu,rlatu,rlonv,rlatv)
     411#endif
     412!$OMP END PARALLEL
     413      END IF
     414
     415c-----------------------------------------------------------------------
    406416c   Initialisation des I/O :
    407417c   ------------------------
    … …  
    410420      day_end = day_ini + nday
    411421      WRITE(lunout,300)day_ini,day_end
     422 300  FORMAT('1'/,15x,'run du jour',i7,2x,'au jour',i7//)
     423
     424!#ifdef CPP_IOIPSL
     425      if (planet_type.eq."earth") then
     426#ifdef CPP_EARTH
     427      CALL dynredem0_p("restart.nc", day_end, phis)
     428#endif
     429      endif
     430
     431      ecripar = .TRUE.
    412432
    413433#ifdef CPP_IOIPSL
    414       CALL dynredem0_p("restart.nc", day_end, phis, nqmx)
    415 
    416       ecripar = .TRUE.
    417 
    418434      if ( 1.eq.1) then
    419435      time_step = zdtvr
    … …  
    421437      t_wrt = iecri * daysec
    422438      CALL inithist_p(dynhist_file,day_ref,annee_ref,time_step,
    423      .              t_ops, t_wrt, nqmx, histid, histvid)
    424 
    425       t_ops = iperiod * time_step
    426       t_wrt = periodav * daysec
    427       CALL initdynav_p(dynhistave_file,day_ref,annee_ref,time_step,
    428      .              t_ops, t_wrt, nqmx, histaveid)
    429 
     439     .              t_ops, t_wrt, histid, histvid)
     440
     441      IF (ok_dynzon) THEN
     442         t_ops = iperiod * time_step
     443         t_wrt = periodav * daysec
     444         CALL initdynav_p(dynhistave_file,day_ref,annee_ref,time_step,
     445     .        t_ops, t_wrt, histaveid)
     446      END IF
    430447      dtav = iperiod*dtvr/daysec
    431448      endif
    … …  
    433450
    434451#endif
     452! #endif of #ifdef CPP_IOIPSL
    435453
    436454c  Choix des frequences de stokage pour le offline
    … …  
    453471
    454472c$OMP PARALLEL DEFAULT(SHARED) COPYIN(/temps/,/logic/)
    455       CALL leapfrog_p(ucov,vcov,teta,ps,masse,phis,nq,q,clesphy0,
     473      CALL leapfrog_p(ucov,vcov,teta,ps,masse,phis,q,clesphy0,
    456474     .              time_0)
    457475c$OMP END PARALLEL
    458476
    459477
    460  300  FORMAT('1'/,15x,'run du pas',i7,2x,'au pas',i7,2x,
    461      . 'c''est a dire du jour',i7,3x,'au jour',i7//)
    462478      END
    463479

  • LMDZ4/trunk/libf/dyn3dpar/groupeun_p.F

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

  • LMDZ4/trunk/libf/dyn3dpar/guide_p.F

    r1049 r1146  
    44      subroutine guide_pp(itau,ucov,vcov,teta,q,masse,ps)
    55      USE parallel
     6      use netcdf
    67
    78      IMPLICIT NONE
    … …  
    229230         IF (mpi_rank==0) THEN
    230231          if (guide_modele) then
    231             if (ncidpl.eq.-99) ncidpl=NCOPN('apbp.nc',NCNOWRIT,rcod)
    232           else 
    233            if (guide_u) then
    234             if (ncidpl.eq.-99) ncidpl=NCOPN('u.nc',NCNOWRIT,rcod)
    235           endif
    236 c
    237           if (guide_v) then
    238             if (ncidpl.eq.-99) ncidpl=NCOPN('v.nc',NCNOWRIT,rcod)
    239           endif
    240 c
    241           if (guide_T) then
    242             if (ncidpl.eq.-99) ncidpl=NCOPN('T.nc',NCNOWRIT,rcod)
    243           endif
    244 c
    245           if (guide_Q) then
    246             if (ncidpl.eq.-99) ncidpl=NCOPN('hur.nc',NCNOWRIT,rcod)
    247           endif
     232             if (ncidpl.eq.-99) rcod=nf90_open('apbp.nc',Nf90_NOWRITe,
     233     $            ncidpl)
     234          else
     235             if (guide_u) then
     236                if (ncidpl.eq.-99) rcod=nf90_open('u.nc',Nf90_NOWRITe,
     237     $               ncidpl)
     238             endif
     239c
     240             if (guide_v) then
     241                if (ncidpl.eq.-99) rcod=nf90_open('v.nc',nf90_nowrite,
     242     $               ncidpl)
     243             endif
     244c
     245             if (guide_T) then
     246                if (ncidpl.eq.-99) rcod=nf90_open('T.nc',nf90_nowrite,
     247     $               ncidpl)
     248             endif
     249c
     250             if (guide_Q) then
     251                if (ncidpl.eq.-99) rcod=nf90_open('hur.nc',nf90_nowrite,
     252     $               ncidpl)
     253             endif
    248254c
    249255          endif  !guide_modele
    … …  
    256262          status=NF_INQ_DIMLEN(ncidpl,rid,nlev)
    257263         print *,'nlev guide', nlev
    258          call ncclos(ncidpl,rcod)
     264         rcod = nf90_close(ncidpl)
    259265c   Lecture du premier etat des reanalyses.
    260266         call Gather_Field(ps,ip1jmp1,1,0)

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

    r774 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/dyn3dpar/initdynav_p.F

    r1000 r1146  
    44c
    55c
    6       subroutine initdynav_p(infile,day0,anne0,tstep,t_ops,t_wrt
    7      .                     ,nq,fileid)
     6      subroutine initdynav_p(infile,day0,anne0,tstep,t_ops,t_wrt,fileid)
    87
    98       USE IOIPSL
    … …  
    1110       use Write_field
    1211       use misc_mod
     12       USE infotrac
     13
    1314      implicit none
    1415
    … …  
    3031C      t_ops: frequence de l'operation pour IOIPSL
    3132C      t_wrt: frequence d'ecriture sur le fichier
    32 C      nq: nombre de traceurs
    3333C
    3434C   Sortie:
    … …  
    5050#include "description.h"
    5151#include "serre.h"
    52 #include "advtrac.h"
    5352
    5453C   Arguments
    … …  
    5857      real tstep, t_ops, t_wrt
    5958      integer fileid
    60       integer nq
    6159      integer thoriid, zvertiid
    6260
    … …  
    8280     
    8381      INTEGER :: dynave_domain_id
    84      
    8582     
    8683      if (adjust) return
    … …  
    169166C  Traceurs
    170167C
    171         DO iq=1,nq
     168        DO iq=1,nqtot
    172169          call histdef(fileid, ttext(iq), ttext(iq), '-',
    173170     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,

  • LMDZ4/trunk/libf/dyn3dpar/initfluxsto_p.F

    r1000 r1146  
    33!
    44      subroutine initfluxsto_p
    5      .  (infile,tstep,t_ops,t_wrt,nq,
     5     .  (infile,tstep,t_ops,t_wrt,
    66     .                    fileid,filevid,filedid)
    77
    … …  
    3030C      t_ops: frequence de l'operation pour IOIPSL
    3131C      t_wrt: frequence d'ecriture sur le fichier
    32 C      nq: nombre de traceurs
    3332C
    3433C   Sortie:
    … …  
    5857      real tstep, t_ops, t_wrt
    5958      integer fileid, filevid,filedid
    60       integer nq,ndex(1)
     59      integer ndex(1)
    6160      real nivd(1)
    6261
    … …  
    8786      INTEGER :: dynu_domain_id
    8887      INTEGER :: dynv_domain_id
    89 
    9088
    9189C

  • LMDZ4/trunk/libf/dyn3dpar/inithist_p.F

    r1000 r1146  
    22! $Header$
    33!
    4       subroutine inithist_p(infile,day0,anne0,tstep,t_ops,t_wrt,nq,
     4      subroutine inithist_p(infile,day0,anne0,tstep,t_ops,t_wrt,
    55     .                      fileid,filevid)
    66
    … …  
    99       use Write_field
    1010       use misc_mod
     11       USE infotrac
    1112
    1213      implicit none
    … …  
    2930C      t_ops: frequence de l'operation pour IOIPSL
    3031C      t_wrt: frequence d'ecriture sur le fichier
    31 C      nq: nombre de traceurs
    3232C
    3333C   Sortie:
    … …  
    5050#include "description.h"
    5151#include "serre.h"
    52 #include "advtrac.h"
    5352
    5453C   Arguments
    … …  
    5857      real tstep, t_ops, t_wrt
    5958      integer fileid, filevid
    60       integer nq
    6159
    6260C   Variables locales
    … …  
    8381      INTEGER :: dynu_domain_id
    8482      INTEGER :: dynv_domain_id
     83
    8584C
    8685C  Initialisations
    … …  
    217216C  Traceurs
    218217C
    219         DO iq=1,nq
     218        DO iq=1,nqtot
    220219          call histdef(fileid, ttext(iq),  ttext(iq), '-',
    221220     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,

  • LMDZ4/trunk/libf/dyn3dpar/integrd_p.F

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

  • LMDZ4/trunk/libf/dyn3dpar/leapfrog_p.F

    r1000 r1146  
    44c
    55c
    6 #define IO_DEBUG
    7 
    8 #undef CPP_IOIPSL
    9 #define CPP_IOIPSL
    10 
    11       SUBROUTINE leapfrog_p(ucov,vcov,teta,ps,masse,phis,nq,q,clesphy0,
     6
     7      SUBROUTINE leapfrog_p(ucov,vcov,teta,ps,masse,phis,q,clesphy0,
    128     &                    time_0)
    139
    … …  
    2117       USE vampir
    2218       USE timer_filtre, ONLY : print_filtre_timer
     19       USE infotrac
    2320
    2421      IMPLICIT NONE
    … …  
    6966#include "com_io_dyn.h"
    7067#include "iniprint.h"
    71 
    72 c#include "tracstoke.h"
    73 
    7468#include "academic.h"
    75 !#include "clesphys.h"
    76 #include "advtrac.h"
    7769     
    78       integer nq
    79 
    8070      INTEGER         longcles
    8171      PARAMETER     ( longcles = 20 )
    … …  
    8878      REAL :: vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
    8979      REAL :: teta(ip1jmp1,llm)                 ! temperature potentielle
    90       REAL :: q(ip1jmp1,llm,nqmx)               ! champs advectes
     80      REAL :: q(ip1jmp1,llm,nqtot)              ! champs advectes
    9181      REAL :: ps(ip1jmp1)                       ! pression  au sol
    9282      REAL,SAVE :: p (ip1jmp1,llmp1  )               ! pression aux interfac.des couches
    … …  
    10999c   tendances dynamiques
    110100      REAL,SAVE :: dv(ip1jm,llm),du(ip1jmp1,llm)
    111       REAL,SAVE :: dteta(ip1jmp1,llm),dq(ip1jmp1,llm,nqmx),dp(ip1jmp1)
     101      REAL,SAVE :: dteta(ip1jmp1,llm),dp(ip1jmp1)
     102      REAL,DIMENSION(:,:,:), ALLOCATABLE, SAVE :: dq
    112103
    113104c   tendances de la dissipation
    … …  
    118109      REAL,SAVE :: dvfi(ip1jm,llm),dufi(ip1jmp1,llm)
    119110      REAL,SAVE :: dtetafi(ip1jmp1,llm)
    120       REAL,SAVE :: dqfi(ip1jmp1,llm,nqmx),dpfi(ip1jmp1)
     111      REAL,SAVE :: dpfi(ip1jmp1)
     112      REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: dqfi
    121113
    122114c   variables pour le fichier histoire
    … …  
    186178      type(Request) :: Request_physic
    187179      REAL,SAVE :: dvfi_tmp(iip1,llm),dufi_tmp(iip1,llm)
    188       REAL,SAVE :: dtetafi_tmp(iip1,llm),dqfi_tmp(iip1,llm,nqmx)
     180      REAL,SAVE :: dtetafi_tmp(iip1,llm)
     181      REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: dqfi_tmp
    189182      REAL,SAVE :: dpfi_tmp(iip1)
    190183
    … …  
    195188      INTEGER :: var_time
    196189      LOGICAL :: ok_start_timer=.FALSE.
     190      LOGICAL, SAVE :: firstcall=.TRUE.
    197191
    198192c$OMP MASTER
    … …  
    208202      itaufin   = nday*day_step
    209203      itaufinp1 = itaufin +1
    210 
     204      modname="leapfrog_p"
    211205
    212206      itau = 0
    … …  
    217211          iday = iday+1
    218212         ENDIF
     213
     214c Allocate variables depending on dynamic variable nqtot
     215c$OMP MASTER
     216         IF (firstcall) THEN
     217            firstcall=.FALSE.
     218            ALLOCATE(dq(ip1jmp1,llm,nqtot))
     219            ALLOCATE(dqfi(ip1jmp1,llm,nqtot))
     220            ALLOCATE(dqfi_tmp(iip1,llm,nqtot))
     221         END IF
     222c$OMP END MASTER     
     223c$OMP BARRIER
    219224
    220225c-----------------------------------------------------------------------
    … …  
    276281c$OMP BARRIER
    277282       else
    278          
     283! Save fields obtained at previous time step as '...m1'
    279284         ijb=ij_begin
    280285         ije=ij_end
    … …  
    303308     .                    llm, -2,2, .TRUE., 1 )
    304309
    305        endif
     310       endif ! of if (FirstCaldyn)
    306311       
    307312      forward = .TRUE.
    … …  
    347352         IF( MOD(itau,idissip ).EQ.0.AND..NOT.forward ) apdiss = .TRUE.
    348353         IF( MOD(itau,iphysiq ).EQ.0.AND..NOT.forward
    349      s          .and. iflag_phys.NE.0                 ) apphys = .TRUE.
     354     s          .and. iflag_phys.EQ.1                 ) apphys = .TRUE.
    350355      ELSE
    351356         IF( MOD(itau   ,iconser) .EQ. 0              ) conser = .TRUE.
    352357         IF( MOD(itau+1,idissip)  .EQ. 0              ) apdiss = .TRUE.
    353          IF( MOD(itau+1,iphysiq).EQ.0.AND.iflag_phys.NE.0) apphys=.TRUE.
     358         IF( MOD(itau+1,iphysiq).EQ.0.AND.iflag_phys.EQ.1) apphys=.TRUE.
    354359      END IF
    355360
    … …  
    455460     &                                jj_Nb_caldyn,0,0,TestRequest)
    456461 
    457         do j=1,nqmx
     462        do j=1,nqtot
    458463         call Register_SwapFieldHallo(q(1,1,j),q(1,1,j),ip1jmp1,llm,
    459464     &                                jj_nb_caldyn,0,0,TestRequest)
    … …  
    490495       call Register_Hallo(p,ip1jmp1,llmp1,1,1,1,1,TestRequest)
    491496       
    492 c       do j=1,nqmx
     497c       do j=1,nqtot
    493498c         call Register_Hallo(q(1,1,j),ip1jmp1,llm,1,1,1,1,
    494499c     *                       TestRequest)
    … …  
    516521        call WriteField_p('pkf',reshape(pkf,(/iip1,jmp1,llm/)))
    517522        call WriteField_p('phis',reshape(phis,(/iip1,jmp1/)))
    518         do j=1,nqmx
     523        do j=1,nqtot
    519524          call WriteField_p('q'//trim(int2str(j)),
    520525     .                reshape(q(:,:,j),(/iip1,jmp1,llm/)))
    … …  
    528533
    529534c$OMP MASTER
    530       print*,"Iteration No",True_itau
     535      IF (prt_level>9) THEN
     536        WRITE(lunout,*)"leapfrog_p: Iteration No",True_itau
     537      ENDIF
    531538
    532539
    … …  
    585592
    586593
    587          ENDIF
    588 c
    589       ENDIF
     594         ENDIF ! of IF (offline)
     595c
     596      ENDIF ! of IF( forward. OR . leapf )
    590597cc$OMP END PARALLEL
    591598
    … …  
    608615c$OMP BARRIER
    609616!       CALL FTRACE_REGION_BEGIN("integrd")
     617
    610618       CALL integrd_p ( 2,vcovm1,ucovm1,tetam1,psm1,massem1 ,
    611619     $         dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps,masse,phis ,
    … …  
    625633c
    626634c      call WriteField_p('ps',reshape(ps,(/iip1,jmp1/)))
    627 c      do j=1,nqmx
     635c      do j=1,nqtot
    628636c        call WriteField_p('q'//trim(int2str(j)),
    629637c     .                reshape(q(:,:,j),(/iip1,jmp1,llm/)))
    … …  
    663671c$OMP MASTER
    664672         call suspend_timer(timer_caldyn)
    665          print*,'Entree dans la physique : Iteration No ',true_itau
     673
     674         write(lunout,*)
     675     &   'leapfrog_p: Entree dans la physique : Iteration No ',true_itau
    666676c$OMP END MASTER
    667677
    … …  
    669679
    670680c$OMP BARRIER
    671 
    672681         CALL exner_hyb_p(  ip1jmp1, ps, p,alpha,beta,pks, pk, pkf )
    673682c$OMP BARRIER
    … …  
    683692c   -----------------------------------------------------
    684693
    685 #ifdef CPP_PHYS
    686694c+jld
    687695
    … …  
    689697      IF (ip_ebil_dyn.ge.1 ) THEN
    690698          ztit='bil dyn'
    691           CALL diagedyn(ztit,2,1,1,dtphys
    692      e  , ucov    , vcov , ps, p ,pk , teta , q(:,:,1), q(:,:,2))
     699! Ehouarn: be careful, diagedyn is Earth-specific (includes ../phylmd/..)!
     700           IF (planet_type.eq."earth") THEN
     701            CALL diagedyn(ztit,2,1,1,dtphys
     702     &    , ucov    , vcov , ps, p ,pk , teta , q(:,:,1), q(:,:,2))
     703           ENDIF
    693704      ENDIF
    694705c-jld
    … …  
    725736       
    726737c        call SetDistrib(jj_nb_vanleer)
    727         do j=1,nqmx
     738        do j=1,nqtot
    728739 
    729740          call Register_SwapFieldHallo(q(1,1,j),q(1,1,j),ip1jmp1,llm,
    … …  
    756767cc$OMP BARRIER
    757768!        CALL FTRACE_REGION_BEGIN("calfis")
    758         CALL calfis_p( nq, lafin ,rdayvrai,time  ,
     769        CALL calfis_p(lafin ,rdayvrai,time  ,
    759770     $               ucov,vcov,teta,q,masse,ps,p,pk,phis,phi ,
    760771     $               du,dv,dteta,dq,
    … …  
    777788          dpfi_tmp(1:iip1)     = dpfi(ijb:ijb+iim) 
    778789c$OMP END MASTER
    779         endif
     790        endif ! of if ( .not. pole_nord)
    780791
    781792c$OMP BARRIER
    … …  
    799810     *                      1,0,0,1,Request_physic)
    800811
    801         do j=1,nqmx
     812        do j=1,nqtot
    802813          call Register_Hallo(dqfi(1,1,j),ip1jmp1,llm,
    803814     *                        1,0,0,1,Request_physic)
    … …  
    833844c$OMP END MASTER
    834845         
    835         endif
     846        endif ! of if (.not. pole_nord)
    836847c$OMP BARRIER
    837848cc$OMP MASTER       
    … …  
    842853cc$OMP END MASTER
    843854c     
    844 c      do j=1,nqmx
     855c      do j=1,nqtot
    845856c        call WriteField_p('dqfi'//trim(int2str(j)),
    846857c     .                reshape(dqfi(:,:,j),(/iip1,jmp1,llm/)))
    … …  
    853864         ENDIF
    854865       
    855           CALL addfi_p( nqmx, dtphys, leapf, forward   ,
     866          CALL addfi_p( dtphys, leapf, forward   ,
    856867     $                  ucov, vcov, teta , q   ,ps ,
    857868     $                 dufi, dvfi, dtetafi , dqfi ,dpfi  )
    … …  
    889900     *                               jj_Nb_caldyn,Request_physic)
    890901
    891         do j=1,nqmx
     902        do j=1,nqtot
    892903       
    893904          call Register_SwapField(q(1,1,j),q(1,1,j),ip1jmp1,llm,
    … …  
    922933cc$OMP END MASTER
    923934
    924 #else
    925 
     935
     936c-jld
     937c$OMP MASTER
     938         call resume_timer(timer_caldyn)
     939         if (FirstPhysic) then
     940           ok_start_timer=.TRUE.
     941           FirstPhysic=.false.
     942         endif
     943c$OMP END MASTER
     944       ENDIF ! of IF( apphys )
     945
     946      IF(iflag_phys.EQ.2) THEN ! "Newtonian" case
    926947c   Calcul academique de la physique = Rappel Newtonien + fritcion
    927948c   --------------------------------------------------------------
    … …  
    939960
    940961       call friction_p(ucov,vcov,iphysiq*dtvr)
    941 
    942 #endif
    943 
    944 c-jld
    945 c$OMP MASTER
    946          call resume_timer(timer_caldyn)
    947          if (FirstPhysic) then
    948            ok_start_timer=.TRUE.
    949            FirstPhysic=.false.
    950          endif
    951 c$OMP END MASTER
    952        ENDIF
     962      ENDIF ! of IF(iflag_phys.EQ.2)
     963
    953964
    954965        CALL pression_p ( ip1jmp1, ap, bp, ps, p                  )
    955966c$OMP BARRIER
    956 
    957 
    958967        CALL exner_hyb_p( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
    959968c$OMP BARRIER
    … …  
    12851294               ENDIF
    12861295#ifdef CPP_IOIPSL
     1296             IF (ok_dynzon) THEN
    12871297             call Register_Hallo(vcov,ip1jm,llm,1,0,0,1,TestRequest)
    12881298             call SendRequest(TestRequest)
    … …  
    12911301c$OMP BARRIER
    12921302c$OMP MASTER
    1293               CALL writedynav_p(histaveid, nqmx, itau,vcov ,
     1303              CALL writedynav_p(histaveid, itau,vcov ,
    12941304     ,                          ucov,teta,pk,phi,q,masse,ps,phis)
    1295 c$OMP END MASTER
    1296 
     1305
     1306c ATTENTION!!! bilan_dyn_p ne marche probablement pas avec OpenMP
     1307              CALL bilan_dyn_p(2,dtvr*iperiod,dtvr*day_step*periodav,
     1308     ,             ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q)
     1309c$OMP END MASTER
     1310              ENDIF !ok_dynzon
    12971311#endif
    12981312            ENDIF
    … …  
    13041318c      IF( MOD(itau,iecri         ).EQ.0) THEN
    13051319
    1306            IF( MOD(itau,iecri*day_step).EQ.0) THEN
    1307 c$OMP BARRIER
    1308 c$OMP MASTER
    1309                nbetat = nbetatdem
    1310         CALL geopot_p  ( ip1jmp1, teta  , pk , pks,  phis  , phi )
     1320            IF( MOD(itau,iecri*day_step).EQ.0) THEN
     1321c$OMP BARRIER
     1322c$OMP MASTER
     1323              nbetat = nbetatdem
     1324              CALL geopot_p(ip1jmp1,teta,pk,pks,phis,phi)
    13111325       
    13121326cym        unat=0.
    13131327       
    1314         ijb=ij_begin
    1315         ije=ij_end
    1316        
    1317         if (pole_nord) then
    1318           ijb=ij_begin+iip1
    1319           unat(1:iip1,:)=0.
    1320         endif
    1321        
    1322         if (pole_sud) then
    1323           ije=ij_end-iip1
    1324           unat(ij_end-iip1+1:ij_end,:)=0.
    1325         endif
     1328              ijb=ij_begin
     1329              ije=ij_end
     1330       
     1331              if (pole_nord) then
     1332                ijb=ij_begin+iip1
     1333                unat(1:iip1,:)=0.
     1334              endif
     1335       
     1336              if (pole_sud) then
     1337                ije=ij_end-iip1
     1338                unat(ij_end-iip1+1:ij_end,:)=0.
     1339              endif
    13261340           
    1327         do l=1,llm
    1328            unat(ijb:ije,l)=ucov(ijb:ije,l)/cu(ijb:ije)
    1329         enddo
    1330 
    1331         ijb=ij_begin
    1332         ije=ij_end
    1333         if (pole_sud) ije=ij_end-iip1
    1334        
    1335         do l=1,llm
    1336            vnat(ijb:ije,l)=vcov(ijb:ije,l)/cv(ijb:ije)
    1337         enddo
     1341              do l=1,llm
     1342                unat(ijb:ije,l)=ucov(ijb:ije,l)/cu(ijb:ije)
     1343              enddo
     1344
     1345              ijb=ij_begin
     1346              ije=ij_end
     1347              if (pole_sud) ije=ij_end-iip1
     1348       
     1349              do l=1,llm
     1350                vnat(ijb:ije,l)=vcov(ijb:ije,l)/cv(ijb:ije)
     1351              enddo
    13381352       
    13391353#ifdef CPP_IOIPSL
    13401354 
    1341         CALL writehist_p(histid,histvid, nqmx,itau,vcov,
    1342      s                       ucov,teta,phi,q,masse,ps,phis)
     1355              CALL writehist_p(histid,histvid, itau,vcov,
     1356     &                         ucov,teta,phi,q,masse,ps,phis)
    13431357
    13441358#endif
    1345 c$OMP END MASTER
    1346            ENDIF
     1359! For some Grads outputs of fields
     1360              if (output_grads_dyn) then
     1361! Ehouarn: hope this works the way I think it does:
     1362                  call Gather_Field(unat,ip1jmp1,llm,0)
     1363                  call Gather_Field(vnat,ip1jm,llm,0)
     1364                  call Gather_Field(teta,ip1jmp1,llm,0)
     1365                  call Gather_Field(ps,ip1jmp1,1,0)
     1366                  do iq=1,nqtot
     1367                    call Gather_Field(q(1,1,iq),ip1jmp1,llm,0)
     1368                  enddo
     1369                  if (mpi_rank==0) then
     1370#include "write_grads_dyn.h"
     1371                  endif
     1372              endif ! of if (output_grads_dyn)
     1373c$OMP END MASTER
     1374            ENDIF ! of IF(MOD(itau,iecri).EQ.0)
    13471375
    13481376            IF(itau.EQ.itaufin) THEN
    … …  
    13511379c$OMP MASTER
    13521380
    1353 c#ifdef CPP_IOIPSL
    1354 
    1355        CALL dynredem1_p("restart.nc",0.0,
    1356      ,                     vcov,ucov,teta,q,nqmx,masse,ps)
    1357 c#endif
     1381              if (planet_type.eq."earth") then
     1382#ifdef CPP_EARTH
     1383! Write an Earth-format restart file
     1384                CALL dynredem1_p("restart.nc",0.0,
     1385     &                           vcov,ucov,teta,q,masse,ps)
     1386
     1387#endif
     1388              endif ! of if (planet_type.eq."earth")
    13581389
    13591390              CLOSE(99)
    13601391c$OMP END MASTER
    1361             ENDIF
     1392            ENDIF ! of IF (itau.EQ.itaufin)
    13621393
    13631394c-----------------------------------------------------------------------
    … …  
    13901421                 dt  = 2.*dtvr
    13911422                 GO TO 2
    1392             END IF
    1393 
    1394       ELSE
     1423            END IF ! of IF (MOD(itau,iperiod).EQ.0)
     1424                   !    ELSEIF (MOD(itau-1,iperiod).EQ.0)
     1425
     1426
     1427      ELSE ! of IF (.not.purmats)
    13951428
    13961429c       ........................................................
    … …  
    14191452               GO TO 2
    14201453
    1421             ELSE
    1422 
    1423             IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin) THEN
     1454            ELSE ! of IF(forward)
     1455
     1456              IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin) THEN
    14241457               IF(itau.EQ.itaufin) THEN
    14251458                  iav=1
    … …  
    14281461               ENDIF
    14291462#ifdef CPP_IOIPSL
    1430 c$OMP BARRIER
    1431 
    1432               call Register_Hallo(vcov,ip1jm,llm,1,0,0,1,TestRequest)
    1433               call SendRequest(TestRequest)
    1434 c$OMP BARRIER
    1435               call WaitRequest(TestRequest)
    1436 
    1437 c$OMP BARRIER
    1438 c$OMP MASTER
    1439               CALL writedynav_p(histaveid, nqmx, itau,vcov ,
     1463               IF (ok_dynzon) THEN
     1464c$OMP BARRIER
     1465
     1466               call Register_Hallo(vcov,ip1jm,llm,1,0,0,1,TestRequest)
     1467               call SendRequest(TestRequest)
     1468c$OMP BARRIER
     1469               call WaitRequest(TestRequest)
     1470
     1471c$OMP BARRIER
     1472c$OMP MASTER
     1473               CALL writedynav_p(histaveid, itau,vcov ,
    14401474     ,                          ucov,teta,pk,phi,q,masse,ps,phis)
    1441                call bilan_dyn_p (2,dtvr*iperiod,dtvr*day_step*periodav,
     1475               CALL bilan_dyn_p(2,dtvr*iperiod,dtvr*day_step*periodav,
    14421476     ,           ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q)
    14431477c$OMP END MASTER
     1478               END IF !ok_dynzon
    14441479#endif
    1445             ENDIF
     1480              ENDIF ! of IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin)
     1481
    14461482
    14471483c               IF(MOD(itau,iecri         ).EQ.0) THEN
    … …  
    14491485c$OMP BARRIER
    14501486c$OMP MASTER
    1451                   nbetat = nbetatdem
    1452        CALL geopot_p( ip1jmp1, teta  , pk , pks,  phis  , phi   )
     1487                nbetat = nbetatdem
     1488                CALL geopot_p(ip1jmp1,teta,pk,pks,phis,phi)
    14531489
    14541490cym        unat=0.
    1455         ijb=ij_begin
    1456         ije=ij_end
    1457        
    1458         if (pole_nord) then
    1459           ijb=ij_begin+iip1
    1460           unat(1:iip1,:)=0.
    1461         endif
    1462        
    1463         if (pole_sud) then
    1464           ije=ij_end-iip1
    1465           unat(ij_end-iip1+1:ij_end,:)=0.
    1466         endif
     1491                ijb=ij_begin
     1492                ije=ij_end
     1493       
     1494                if (pole_nord) then
     1495                  ijb=ij_begin+iip1
     1496                  unat(1:iip1,:)=0.
     1497                endif
     1498       
     1499                if (pole_sud) then
     1500                  ije=ij_end-iip1
     1501                  unat(ij_end-iip1+1:ij_end,:)=0.
     1502                endif
    14671503           
    1468         do l=1,llm
    1469            unat(ijb:ije,l)=ucov(ijb:ije,l)/cu(ijb:ije)
    1470         enddo
    1471 
    1472         ijb=ij_begin
    1473         ije=ij_end
    1474         if (pole_sud) ije=ij_end-iip1
    1475        
    1476         do l=1,llm
    1477            vnat(ijb:ije,l)=vcov(ijb:ije,l)/cv(ijb:ije)
    1478         enddo
     1504                do l=1,llm
     1505                  unat(ijb:ije,l)=ucov(ijb:ije,l)/cu(ijb:ije)
     1506                enddo
     1507
     1508                ijb=ij_begin
     1509                ije=ij_end
     1510                if (pole_sud) ije=ij_end-iip1
     1511       
     1512                do l=1,llm
     1513                  vnat(ijb:ije,l)=vcov(ijb:ije,l)/cv(ijb:ije)
     1514                enddo
    14791515
    14801516#ifdef CPP_IOIPSL
    14811517
    1482        CALL writehist_p( histid, histvid, nqmx, itau,vcov ,
    1483      ,                           ucov,teta,phi,q,masse,ps,phis)
    1484 c#else
    1485 c      call Gather_Field(unat,ip1jmp1,llm,0)
    1486 c      call Gather_Field(vnat,ip1jm,llm,0)
    1487 c      call Gather_Field(teta,ip1jmp1,llm,0)
    1488 c      call Gather_Field(ps,ip1jmp1,1,0)
    1489 c      do iq=1,nqmx
    1490 c        call Gather_Field(q(1,1,iq),ip1jmp1,llm,0)
    1491 c      enddo
     1518                CALL writehist_p(histid, histvid, itau,vcov ,
     1519     &                           ucov,teta,phi,q,masse,ps,phis)
     1520#endif
     1521! For some Grads output (but does it work?)
     1522                if (output_grads_dyn) then
     1523                  call Gather_Field(unat,ip1jmp1,llm,0)
     1524                  call Gather_Field(vnat,ip1jm,llm,0)
     1525                  call Gather_Field(teta,ip1jmp1,llm,0)
     1526                  call Gather_Field(ps,ip1jmp1,1,0)
     1527                  do iq=1,nqtot
     1528                    call Gather_Field(q(1,1,iq),ip1jmp1,llm,0)
     1529                  enddo
    14921530c     
    1493 c      if (mpi_rank==0) then
    1494 c#include "write_grads_dyn.h"
    1495 c      endif
     1531                  if (mpi_rank==0) then
     1532#include "write_grads_dyn.h"
     1533                  endif
     1534                endif ! of if (output_grads_dyn)
     1535
     1536c$OMP END MASTER
     1537              ENDIF ! of IF(MOD(itau,iecri*day_step).EQ.0)
     1538
     1539              IF(itau.EQ.itaufin) THEN
     1540                if (planet_type.eq."earth") then
     1541#ifdef CPP_EARTH
     1542c$OMP MASTER
     1543                   CALL dynredem1_p("restart.nc",0.0,
     1544     .                               vcov,ucov,teta,q,masse,ps)
     1545c$OMP END MASTER
    14961546#endif
    1497 
    1498 c$OMP END MASTER
    1499                ENDIF
    1500 
    1501                  IF(itau.EQ.itaufin) THEN
    1502 c$OMP MASTER
    1503                    CALL dynredem1_p("restart.nc",0.0,
    1504      .                               vcov,ucov,teta,q,nqmx,masse,ps)
    1505 c$OMP END MASTER
    1506                  ENDIF
    1507                  forward = .TRUE.
    1508                  GO TO  1
    1509 
    1510             ENDIF
    1511 
    1512       END IF
    1513 c$OMP MASTER
    1514         call finalize_parallel
    1515 c$OMP END MASTER
    1516         RETURN
     1547                endif ! of if (planet_type.eq."earth")
     1548              ENDIF ! of IF(itau.EQ.itaufin)
     1549
     1550              forward = .TRUE.
     1551              GO TO  1
     1552
     1553            ENDIF ! of IF (forward)
     1554
     1555      END IF ! of IF(.not.purmats)
     1556c$OMP MASTER
     1557      call finalize_parallel
     1558c$OMP END MASTER
     1559      RETURN
    15171560      END

  • LMDZ4/trunk/libf/dyn3dpar/parallel.F90

    r1000 r1146  
    5151#else
    5252       using_mpi=.FALSE.
     53#endif
     54     
     55
     56#ifdef CPP_OMP
     57       using_OMP=.TRUE.
     58#else
     59       using_OMP=.FALSE.
    5360#endif
    5461     

  • LMDZ4/trunk/libf/dyn3dpar/qminimum_p.F

    r985 r1146  
    5050      DO 1000 k = 1, llm
    5151      DO 1040 i = ijb, ije
    52             zx_defau      = AMAX1( seuil_liq - q(i,k,iq_liq), 0.0 )
    53             q(i,k,iq_vap) = q(i,k,iq_vap) - zx_defau
    54             q(i,k,iq_liq) = q(i,k,iq_liq) + zx_defau
     52            if (seuil_liq - q(i,k,iq_liq) .gt. 0.d0 ) then
     53               q(i,k,iq_vap) = q(i,k,iq_vap) + q(i,k,iq_liq) - seuil_liq
     54               q(i,k,iq_liq) = seuil_liq
     55            endif
    5556 1040 CONTINUE
    5657 1000 CONTINUE
    … …  
    6970c$OMP DO SCHEDULE(STATIC)
    7071      DO i = ijb, ije
    71          zx_abc = deltap(i,k)/deltap(i,k-1)
    72          zx_defau    = AMAX1( seuil_vap - q(i,k,iq), 0.0 )
    73          q(i,k-1,iq) =  q(i,k-1,iq) - zx_defau * zx_abc
    74          q(i,k,iq)   =  q(i,k,iq)   + zx_defau 
     72         if ( seuil_vap - q(i,k,iq) .gt. 0.d0 ) then
     73            q(i,k-1,iq) =  q(i,k-1,iq) - ( seuil_vap - q(i,k,iq) ) *
     74     &           deltap(i,k) / deltap(i,k-1)
     75            q(i,k,iq)   =  seuil_vap 
     76         endif
    7577      ENDDO
    7678c$OMP END DO NOWAIT

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

    r1122 r1146  
    1111
    1212       USE parallel
     13       use netcdf
    1314c -----------------------------------------------------------------
    1415c   Declarations
    … …  
    7273            print *,'Vous êtes entrain de lire des données sur
    7374     .               niveaux modèle'
    74             ncidpl=NCOPN('apbp.nc',NCNOWRIT,rcode)
    75             varidap=NCVID(ncidpl,'AP',rcode)
    76             varidbp=NCVID(ncidpl,'BP',rcode)
     75            rcode=nf90_open('apbp.nc',nf90_nowrite,ncidpl)
     76            rcode = nf90_inq_varid(ncidpl, 'AP', varidap)
     77            rcode = nf90_inq_varid(ncidpl, 'BP', varidbp)
    7778            print*,'ncidpl,varidap',ncidpl,varidap
    7879            endif
    … …  
    8081c Vent zonal
    8182            if (guide_u) then
    82                ncidu=NCOPN('u.nc',NCNOWRIT,rcode)
    83                varidu=NCVID(ncidu,'UWND',rcode)
     83               rcode=nf90_open('u.nc',nf90_nowrite,ncidu)
     84               rcode = nf90_inq_varid(ncidu, 'UWND', varidu)
    8485               print*,'ncidu,varidu',ncidu,varidu
    8586               if (ncidpl.eq.-99) ncidpl=ncidu
    … …  
    8889c Vent meridien
    8990            if (guide_v) then
    90                ncidv=NCOPN('v.nc',NCNOWRIT,rcode)
    91                varidv=NCVID(ncidv,'VWND',rcode)
     91               rcode=nf90_open('v.nc',nf90_nowrite,ncidv)
     92               rcode = nf90_inq_varid(ncidv, 'VWND', varidv)
    9293               print*,'ncidv,varidv',ncidv,varidv
    9394               if (ncidpl.eq.-99) ncidpl=ncidv
    … …  
    9697c Temperature
    9798            if (guide_T) then
    98                ncidt=NCOPN('T.nc',NCNOWRIT,rcode)
    99                varidt=NCVID(ncidt,'AIR',rcode)
     99               rcode=nf90_open('T.nc',nf90_nowrite,ncidt)
     100               rcode = nf90_inq_varid(ncidt, 'AIR', varidt)
    100101               print*,'ncidt,varidt',ncidt,varidt
    101102               if (ncidpl.eq.-99) ncidpl=ncidt
    … …  
    104105c Humidite
    105106            if (guide_Q) then
    106                ncidQ=NCOPN('hur.nc',NCNOWRIT,rcode)
    107                varidQ=NCVID(ncidQ,'RH',rcode)
     107               rcode=nf90_open('hur.nc',nf90_nowrite,ncidQ)
     108               rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)
    108109               print*,'ncidQ,varidQ',ncidQ,varidQ
    109110               if (ncidpl.eq.-99) ncidpl=ncidQ
    … …  
    112113c Pression de surface
    113114            if ((guide_P).OR.(guide_modele)) then
    114                ncidps=NCOPN('ps.nc',NCNOWRIT,rcode)
    115                varidps=NCVID(ncidps,'SP',rcode)
     115               rcode=nf90_open('ps.nc',nf90_nowrite,ncidps)
     116               rcode = nf90_inq_varid(ncidps, 'SP', varidps)
    116117               print*,'ncidps,varidps',ncidps,varidps
    117118            endif
    … …  
    119120c Coordonnee verticale
    120121            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
     122               if (ncep) then
     123                  print*,'Vous etes entrain de lire des donnees NCEP'
     124                  rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
     125               else
     126                  print*,'Vous etes entrain de lire des donnees ECMWF'
     127                  rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
     128               endif
     129               print*,'ncidpl,varidpl',ncidpl,varidpl
    129130            endif
    130131            print*,'ncidu,varidpl',ncidu,varidpl

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

    r774 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/dyn3dpar/test_period.F

    r774 r1146  
    33!
    44      SUBROUTINE test_period ( ucov, vcov, teta, q, p, phis )
     5      USE infotrac, ONLY : nqtot
    56c
    67c     Auteur : P. Le Van 
    … …  
    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/dyn3dpar/times.F90

    r1000 r1146  
    207207      endif
    208208     
    209     ENDIF  ! using_mpî
     209    ENDIF  ! using_mp�
    210210  end subroutine allgather_timer_average
    211211 
    … …  
    222222  end subroutine InitTime
    223223 
    224   function DiffTime
     224  function DiffTime()
    225225  implicit none
    226226    double precision :: DiffTime
    … …  
    236236  end function DiffTime
    237237 
    238   function DiffCpuTime
     238  function DiffCpuTime()
    239239  implicit none
    240240    real :: DiffCpuTime

  • LMDZ4/trunk/libf/dyn3dpar/vlspltgen_p.F

    r985 r1146  
    2626      USE Write_Field_p
    2727      USE VAMPIR
     28      USE infotrac, ONLY : nqtot
    2829      IMPLICIT NONE
    2930
    … …  
    3839c   Arguments:
    3940c   ----------
    40       INTEGER iadv(nqmx)
     41      INTEGER iadv(nqtot)
    4142      REAL masse(ip1jmp1,llm),pente_max
    4243      REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm)
    43       REAL q(ip1jmp1,llm,nqmx)
     44      REAL q(ip1jmp1,llm,nqtot)
    4445      REAL w(ip1jmp1,llm),pdt
    4546      REAL p(ip1jmp1,llmp1),teta(ip1jmp1,llm),pk(ip1jmp1,llm)
    … …  
    5152c
    5253      REAL,SAVE :: qsat(ip1jmp1,llm)
    53       REAL,SAVE :: zm(ip1jmp1,llm,nqmx)
     54      REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: zm
    5455      REAL,SAVE :: mu(ip1jmp1,llm)
    5556      REAL,SAVE :: mv(ip1jm,llm)
    5657      REAL,SAVE :: mw(ip1jmp1,llm+1)
    57       REAL,SAVE :: zq(ip1jmp1,llm,nqmx)
     58      REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: zq
    5859      REAL zzpbar, zzw
    5960
    … …  
    6768      REAL tempe(ip1jmp1)
    6869      INTEGER ijb,ije,iq
     70      LOGICAL, SAVE :: firstcall=.TRUE.
     71!$OMP THREADPRIVATE(firstcall)
    6972      type(request) :: MyRequest1
    7073      type(request) :: MyRequest2
    … …  
    8487        rtt  = 273.16
    8588
     89c Allocate variables depending on dynamic variable nqtot
     90
     91         IF (firstcall) THEN
     92            firstcall=.FALSE.
     93!$OMP MASTER
     94            ALLOCATE(zm(ip1jmp1,llm,nqtot))
     95            ALLOCATE(zq(ip1jmp1,llm,nqtot))
     96!$OMP END MASTER
     97!$OMP BARRIER
     98         END IF
    8699c-- Calcul de Qsat en chaque point
    87100c-- approximation: au milieu des couches play(l)=(p(l)+p(l+1))/2
    … …  
    164177       ije=ij_end
    165178
    166       DO iq=1,nqmx
     179      DO iq=1,nqtot
    167180c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    168181        DO l=1,llm
    … …  
    175188
    176189c$OMP BARRIER           
    177       DO iq=1,nqmx
     190      DO iq=1,nqtot
    178191
    179192        if(iadv(iq) == 0) then
    … …  
    245258c$OMP END MASTER       
    246259c$OMP BARRIER
    247       do iq=1,nqmx
     260      do iq=1,nqtot
    248261
    249262        if(iadv(iq) == 0) then
    … …  
    285298c$OMP BARRIER
    286299 
    287       do iq=1,nqmx
     300      do iq=1,nqtot
    288301
    289302        if(iadv(iq) == 0) then
    … …  
    308321
    309322
    310       do iq=1,nqmx
     323      do iq=1,nqtot
    311324
    312325        if(iadv(iq) == 0) then
    … …  
    359372
    360373c$OMP BARRIER
    361       do iq=1,nqmx
     374      do iq=1,nqtot
    362375
    363376        if(iadv(iq) == 0) then
    … …  
    398411
    399412
    400       do iq=1,nqmx
     413      do iq=1,nqtot
    401414
    402415        if(iadv(iq) == 0) then
    … …  
    420433       enddo
    421434
    422       do iq=1,nqmx
     435      do iq=1,nqtot
    423436
    424437        if(iadv(iq) == 0) then
    … …  
    450463
    451464
    452       DO iq=1,nqmx
     465      DO iq=1,nqtot
    453466
    454467c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)         

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

    r774 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

  • LMDZ4/trunk/libf/dyn3dpar/writedynav_p.F

    r1000 r1146  
    22! $Header$
    33!
    4       subroutine writedynav_p( histid, nq, time, vcov,
     4      subroutine writedynav_p( histid, time, vcov,
    55     ,                          ucov,teta,ppk,phi,q,masse,ps,phis)
    66
    … …  
    88      USE parallel
    99      USE misc_mod
     10      USE infotrac
    1011      implicit none
    1112
    … …  
    1718C   Entree:
    1819C      histid: ID du fichier histoire
    19 C      nqmx: nombre maxi de traceurs
    2020C      time: temps de l'ecriture
    2121C      vcov: vents v covariants
    … …  
    4747#include "description.h"
    4848#include "serre.h"
    49 #include "advtrac.h"
    5049
    5150C
    … …  
    5352C
    5453
    55       INTEGER histid, nq
     54      INTEGER histid
    5655      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm)
    5756      REAL teta(ip1jmp1,llm),phi(ip1jmp1,llm),ppk(ip1jmp1,llm)                 
    5857      REAL ps(ip1jmp1),masse(ip1jmp1,llm)                   
    5958      REAL phis(ip1jmp1)                 
    60       REAL q(ip1jmp1,llm,nq)
     59      REAL q(ip1jmp1,llm,nqtot)
    6160      integer time
    6261
    … …  
    105104C  Vents V scalaire
    106105C
    107       if (pole_sud) ije=ij_end-iip1
    108       if (pole_sud) jjn=jj_nb-1
    109106     
    110107      call gr_v_scal_p(llm, vnat, vs)
    … …  
    114111C  Temperature potentielle moyennee
    115112C
    116       ijb=ij_begin
    117       ije=ij_end
    118       jjn=jj_nb
    119      
     113     
    120114      call histwrite(histid, 'theta', itau_w, teta(ijb:ije,:),
    121115     .                iip1*jjn*llm, ndex3d)
    … …  
    139133C  Traceurs
    140134C
    141         DO iq=1,nq
     135        DO iq=1,nqtot
    142136          call histwrite(histid, ttext(iq), itau_w, q(ijb:ije,:,iq),
    143137     .                   iip1*jjn*llm, ndex3d)

  • LMDZ4/trunk/libf/dyn3dpar/writehist_p.F

    r1000 r1146  
    22! $Header$
    33!
    4       subroutine writehist_p( histid, histvid, nq, time, vcov,
     4      subroutine writehist_p( histid, histvid, time, vcov,
    55     ,                          ucov,teta,phi,q,masse,ps,phis)
    66
    … …  
    88      USE parallel
    99      USE misc_mod
     10      USE infotrac
    1011      implicit none
    1112
    … …  
    1819C      histid: ID du fichier histoire
    1920C      histvid:ID du fichier histoire pour les vents V (appele a disparaitre)
    20 C      nqmx: nombre maxi de traceurs
    2121C      time: temps de l'ecriture
    2222C      vcov: vents v covariants
    … …  
    4848#include "description.h"
    4949#include "serre.h"
    50 #include "advtrac.h"
    5150
    5251C
    … …  
    5453C
    5554
    56       INTEGER histid, nq, histvid
     55      INTEGER histid, histvid
    5756      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm)
    5857      REAL teta(ip1jmp1,llm),phi(ip1jmp1,llm)                   
    5958      REAL ps(ip1jmp1),masse(ip1jmp1,llm)                   
    6059      REAL phis(ip1jmp1)                 
    61       REAL q(ip1jmp1,llm,nq)
     60      REAL q(ip1jmp1,llm,nqtot)
    6261      integer time
    6362
    … …  
    119118C  Traceurs
    120119C
    121         DO iq=1,nq
     120        DO iq=1,nqtot
    122121          call histwrite(histid, ttext(iq), itau_w, q(ijb:ije,:,iq),
    123122     .                   iip1*jjn*llm, ndexu)

  • LMDZ4/trunk/libf/filtrez/coefils.h

    r524 r1146  
    22! $Header$
    33!
    4       COMMON/coefils/jfiltnu,jfiltsu,jfiltnv,jfiltsv,sddu(iim),sddv(iim)
    5      * ,unsddu(iim),unsddv(iim),coefilu(iim,jjm),coefilv(iim,jjm),
    6      * modfrstu(jjm),modfrstv(jjm),eignfnu(iim,iim),eignfnv(iim,iim)
    7      * ,coefilu2(iim,jjm),coefilv2(iim,jjm)
    8 c
     4      COMMON/coefils/jfiltnu,jfiltsu,jfiltnv,jfiltsv,sddu(iim),sddv(iim)&
     5     & ,unsddu(iim),unsddv(iim),coefilu(iim,jjm),coefilv(iim,jjm),      &
     6     & modfrstu(jjm),modfrstv(jjm),eignfnu(iim,iim),eignfnv(iim,iim)    &
     7     & ,coefilu2(iim,jjm),coefilv2(iim,jjm)
     8!c
    99      INTEGER jfiltnu,jfiltsu,jfiltnv,jfiltsv,modfrstu,modfrstv
    1010      REAL    sddu,sddv,unsddu,unsddv,coefilu,coefilv,eignfnu,eignfnv

  • LMDZ4/trunk/libf/filtrez/filtreg.F

    r524 r1146  
    33!
    44      SUBROUTINE filtreg ( champ, nlat, nbniv, ifiltre,iaire,
    5      .   griscal ,iter)
    6 
     5     &     griscal ,iter)
     6     
     7      USE filtreg_mod
     8     
    79      IMPLICIT NONE
    810c=======================================================================
    … …  
    4648#include "dimensions.h"
    4749#include "paramet.h"
    48 #include "parafilt.h"
    4950#include "coefils.h"
    50 c
    51       INTEGER nlat,nbniv,ifiltre,iter
    52       INTEGER i,j,l,k
    53       INTEGER iim2,immjm
    54       INTEGER jdfil1,jdfil2,jffil1,jffil2,jdfil,jffil
    55 
    56       REAL  champ( iip1,nlat,nbniv)
    57       REAL matriceun,matriceus,matricevn,matricevs,matrinvn,matrinvs
    58       COMMON/matrfil/matriceun(iim,iim,nfilun),matriceus(iim,iim,nfilus)
    59      ,             , matricevn(iim,iim,nfilvn),matricevs(iim,iim,nfilvs)
    60      ,             ,  matrinvn(iim,iim,nfilun),matrinvs (iim,iim,nfilus)
    61       REAL  eignq(iim), sdd1(iim),sdd2(iim)
     51
     52      INTEGER    nlat,nbniv,ifiltre,iter
     53      INTEGER    i,j,l,k
     54      INTEGER    iim2,immjm
     55      INTEGER    jdfil1,jdfil2,jffil1,jffil2,jdfil,jffil
     56
     57      REAL       champ( iip1,nlat,nbniv)
     58
     59      REAL       eignq(iim,nlat,nbniv), sdd1(iim),sdd2(iim)
    6260      LOGICAL    griscal
    6361      INTEGER    hemisph, iaire
    64 c
     62
     63      LOGICAL,SAVE     :: first=.TRUE.
     64
     65      REAL, SAVE :: sdd12(iim,4)
     66
     67      INTEGER, PARAMETER :: type_sddu=1
     68      INTEGER, PARAMETER :: type_sddv=2
     69      INTEGER, PARAMETER :: type_unsddu=3
     70      INTEGER, PARAMETER :: type_unsddv=4
     71
     72      INTEGER :: sdd1_type, sdd2_type
     73
     74      IF (first) THEN
     75         sdd12(1:iim,type_sddu) = sddu(1:iim)
     76         sdd12(1:iim,type_sddv) = sddv(1:iim)
     77         sdd12(1:iim,type_unsddu) = unsddu(1:iim)
     78         sdd12(1:iim,type_unsddv) = unsddv(1:iim)
     79
     80         first=.FALSE.
     81      ENDIF
    6582
    6683      IF(ifiltre.EQ.1.or.ifiltre.EQ.-1)
    67      *    STOP'Pas de transformee simple dans cette version'
    68 
     84     &     STOP'Pas de transformee simple dans cette version'
     85     
    6986      IF( iter.EQ. 2 )  THEN
    70        PRINT *,' Pas d iteration du filtre dans cette version !'
    71      * , ' Utiliser old_filtreg et repasser !'
    72            STOP
     87         PRINT *,' Pas d iteration du filtre dans cette version !'
     88     &        , ' Utiliser old_filtreg et repasser !'
     89         STOP
    7390      ENDIF
    74 
     91     
    7592      IF( ifiltre.EQ. -2 .AND..NOT.griscal )     THEN
    76        PRINT *,' Cette routine ne calcule le filtre inverse que ',
    77      * ' sur la grille des scalaires !'
    78            STOP
     93         PRINT *,' Cette routine ne calcule le filtre inverse que '
     94     &        , ' sur la grille des scalaires !'
     95         STOP
    7996      ENDIF
    80 
     97     
    8198      IF( ifiltre.NE.2 .AND.ifiltre.NE. - 2 )  THEN
    82        PRINT *,' Probleme dans filtreg car ifiltre NE 2 et NE -2'
    83      *,' corriger et repasser !'
    84            STOP
     99         PRINT *,' Probleme dans filtreg car ifiltre NE 2 et NE -2'
     100     &        , ' corriger et repasser !'
     101         STOP
    85102      ENDIF
    86 c
    87 
     103     
    88104      iim2   = iim * iim
    89105      immjm  = iim * jjm
    90 c
    91 c
     106
    92107      IF( griscal )   THEN
    93108         IF( nlat. NE. jjp1 )  THEN
    94              PRINT  1111
    95              STOP
    96          ELSE
    97 c
    98              IF( iaire.EQ.1 )  THEN
    99                 CALL SCOPY(  iim,    sddv, 1,  sdd1, 1 )
    100                 CALL SCOPY(  iim,  unsddv, 1,  sdd2, 1 )
    101              ELSE
    102                 CALL SCOPY(  iim,  unsddv, 1,  sdd1, 1 )
    103                 CALL SCOPY(  iim,    sddv, 1,  sdd2, 1 )
    104              END IF
    105 c
    106              jdfil1 = 2
    107              jffil1 = jfiltnu
    108              jdfil2 = jfiltsu
    109              jffil2 = jjm
    110           END IF
     109            PRINT  1111
     110            STOP
     111         ELSE
     112           
     113            IF( iaire.EQ.1 )  THEN
     114               sdd1_type = type_sddu
     115               sdd2_type = type_unsddu
     116            ELSE
     117               sdd1_type = type_unsddu
     118               sdd2_type = type_sddu
     119            ENDIF
     120
     121c            IF( iaire.EQ.1 )  THEN
     122c               CALL SCOPY(  iim,    sddv, 1,  sdd1, 1 )
     123c               CALL SCOPY(  iim,  unsddv, 1,  sdd2, 1 )
     124c            ELSE
     125c               CALL SCOPY(  iim,  unsddv, 1,  sdd1, 1 )
     126c               CALL SCOPY(  iim,    sddv, 1,  sdd2, 1 )
     127c            END IF
     128           
     129            jdfil1 = 2
     130            jffil1 = jfiltnu
     131            jdfil2 = jfiltsu
     132            jffil2 = jjm
     133         END IF
    111134      ELSE
    112           IF( nlat.NE.jjm )  THEN
    113              PRINT  2222
    114              STOP
    115           ELSE
    116 c
    117              IF( iaire.EQ.1 )  THEN
    118                 CALL SCOPY(  iim,    sddu, 1,  sdd1, 1 )
    119                 CALL SCOPY(  iim,  unsddu, 1,  sdd2, 1 )
    120              ELSE
    121                 CALL SCOPY(  iim,  unsddu, 1,  sdd1, 1 )
    122                 CALL SCOPY(  iim,    sddu, 1,  sdd2, 1 )
    123              END IF
    124 c
    125              jdfil1 = 1
    126              jffil1 = jfiltnv
    127              jdfil2 = jfiltsv
    128              jffil2 = jjm
    129           END IF
     135         IF( nlat.NE.jjm )  THEN
     136            PRINT  2222
     137            STOP
     138         ELSE
     139           
     140            IF( iaire.EQ.1 )  THEN
     141               sdd1_type = type_sddu
     142               sdd2_type = type_unsddu
     143            ELSE
     144               sdd1_type = type_unsddu
     145               sdd2_type = type_sddu
     146            ENDIF
     147
     148c            IF( iaire.EQ.1 )  THEN
     149c               CALL SCOPY(  iim,    sddu, 1,  sdd1, 1 )
     150c               CALL SCOPY(  iim,  unsddu, 1,  sdd2, 1 )
     151c            ELSE
     152c               CALL SCOPY(  iim,  unsddu, 1,  sdd1, 1 )
     153c               CALL SCOPY(  iim,    sddu, 1,  sdd2, 1 )
     154c            END IF
     155           
     156            jdfil1 = 1
     157            jffil1 = jfiltnv
     158            jdfil2 = jfiltsv
     159            jffil2 = jjm
     160         END IF
    130161      END IF
    131 c
    132 c
    133       DO 100  hemisph = 1, 2
    134 c
    135       IF ( hemisph.EQ.1 )  THEN
    136           jdfil = jdfil1
    137           jffil = jffil1
    138       ELSE
    139           jdfil = jdfil2
    140           jffil = jffil2
    141       END IF
    142 
    143  
    144       DO 50  l = 1, nbniv
    145       DO 30  j = jdfil,jffil
    146  
    147  
    148       DO  5  i = 1, iim
    149       champ(i,j,l) = champ(i,j,l) * sdd1(i)
    150    5  CONTINUE
    151 c
    152 
    153       IF( hemisph. EQ. 1 )      THEN
    154 
    155         IF( ifiltre. EQ. -2 )   THEN
    156 #ifdef CRAY
    157          CALL MXVA( matrinvn(1,1,j), 1, iim, champ(1,j,l), 1, eignq  ,
    158      *                             1, iim, iim                         )
    159 #else
    160 #ifdef BLAS
    161       CALL SGEMV("N", iim,iim, 1.0, matrinvn(1,1,j),iim,
    162      .           champ(1,j,l), 1, 0.0, eignq, 1)
    163 #else
    164       DO k = 1, iim
    165          eignq(k) = 0.0
     162     
     163      DO hemisph = 1, 2
     164         
     165         IF ( hemisph.EQ.1 )  THEN
     166            jdfil = jdfil1
     167            jffil = jffil1
     168         ELSE
     169            jdfil = jdfil2
     170            jffil = jffil2
     171         END IF
     172         
     173         DO l = 1, nbniv
     174            DO j = jdfil,jffil
     175               DO i = 1, iim
     176                  champ(i,j,l) = champ(i,j,l) * sdd12(i,sdd1_type) ! sdd1(i)
     177               END DO
     178            END DO
     179         END DO
     180         
     181         IF( hemisph. EQ. 1 )      THEN
     182           
     183            IF( ifiltre. EQ. -2 )   THEN
     184               
     185               DO j = jdfil,jffil
     186#ifdef BLAS
     187                  CALL DGEMM("N", "N", iim, nbniv, iim, 1.0,
     188     &                 matrinvn(1,1,j),
     189     &                 iim, champ(1,j,1), iip1*nlat, 0.0,
     190     &                 eignq(1,j-jdfil+1,1), iim*nlat)
     191#else
     192                  eignq(:,j-jdfil+1,:)
     193     $                 = matmul(matrinvn(:,:,j), champ(:iim,j,:))
     194#endif
     195               END DO
     196               
     197            ELSE IF ( griscal )     THEN
     198               
     199               DO j = jdfil,jffil
     200#ifdef BLAS
     201                  CALL DGEMM("N", "N", iim, nbniv, iim, 1.0,
     202     &                 matriceun(1,1,j),
     203     &                 iim, champ(1,j,1), iip1*nlat, 0.0,
     204     &                 eignq(1,j-jdfil+1,1), iim*nlat)
     205#else
     206                  eignq(:,j-jdfil+1,:)
     207     $                 = matmul(matriceun(:,:,j), champ(:iim,j,:))
     208#endif
     209               END DO
     210               
     211            ELSE
     212               
     213               DO j = jdfil,jffil
     214#ifdef BLAS
     215                  CALL DGEMM("N", "N", iim, nbniv, iim, 1.0,
     216     &                 matricevn(1,1,j),
     217     &                 iim, champ(1,j,1), iip1*nlat, 0.0,
     218     &                 eignq(1,j-jdfil+1,1), iim*nlat)
     219#else
     220                  eignq(:,j-jdfil+1,:)
     221     $                 = matmul(matricevn(:,:,j), champ(:iim,j,:))
     222#endif
     223               END DO
     224               
     225            ENDIF
     226           
     227         ELSE
     228           
     229            IF( ifiltre. EQ. -2 )   THEN
     230               
     231               DO j = jdfil,jffil
     232#ifdef BLAS
     233                  CALL DGEMM("N", "N", iim, nbniv, iim, 1.0,
     234     &                 matrinvs(1,1,j-jfiltsu+1),
     235     &                 iim, champ(1,j,1), iip1*nlat, 0.0,
     236     &                 eignq(1,j-jdfil+1,1), iim*nlat)
     237#else
     238                  eignq(:,j-jdfil+1,:)
     239     $                 = matmul(matrinvs(:,:,j-jfiltsu+1),
     240     $                 champ(:iim,j,:))
     241#endif
     242               END DO
     243               
     244               
     245            ELSE IF ( griscal )     THEN
     246               
     247               DO j = jdfil,jffil
     248#ifdef BLAS
     249                  CALL DGEMM("N", "N", iim, nbniv, iim, 1.0,
     250     &                 matriceus(1,1,j-jfiltsu+1),
     251     &                 iim, champ(1,j,1), iip1*nlat, 0.0,
     252     &                 eignq(1,j-jdfil+1,1), iim*nlat)
     253#else
     254                  eignq(:,j-jdfil+1,:)
     255     $                 = matmul(matriceus(:,:,j-jfiltsu+1),
     256     $                 champ(:iim,j,:))
     257#endif
     258               END DO
     259                             
     260            ELSE
     261               
     262               DO j = jdfil,jffil
     263#ifdef BLAS
     264                  CALL DGEMM("N", "N", iim, nbniv, iim, 1.0,
     265     &                 matricevs(1,1,j-jfiltsv+1),
     266     &                 iim, champ(1,j,1), iip1*nlat, 0.0,
     267     &                 eignq(1,j-jdfil+1,1), iim*nlat)
     268#else
     269                  eignq(:,j-jdfil+1,:)
     270     $                 = matmul(matricevs(:,:,j-jfiltsv+1),
     271     $                 champ(:iim,j,:))
     272#endif
     273               END DO
     274                             
     275            ENDIF
     276           
     277         ENDIF
     278         
     279         IF( ifiltre.EQ. 2 )  THEN
     280           
     281            DO l = 1, nbniv
     282               DO j = jdfil,jffil
     283                  DO i = 1, iim
     284                     champ( i,j,l ) =
     285     &                    (champ(i,j,l) + eignq(i,j-jdfil+1,l))
     286     &                    * sdd12(i,sdd2_type) ! sdd2(i)
     287                  END DO
     288               END DO
     289            END DO
     290
     291         ELSE
     292
     293            DO l = 1, nbniv
     294               DO j = jdfil,jffil
     295                  DO i = 1, iim
     296                     champ( i,j,l ) =
     297     &                    (champ(i,j,l) - eignq(i,j-jdfil+1,l))
     298     &                    * sdd12(i,sdd2_type) ! sdd2(i)
     299                  END DO
     300               END DO
     301            END DO
     302
     303         ENDIF
     304
     305         DO l = 1, nbniv
     306            DO j = jdfil,jffil
     307               champ( iip1,j,l ) = champ( 1,j,l )
     308            END DO
     309         END DO
     310
     311     
    166312      ENDDO
    167       DO k = 1, iim
    168       DO i = 1, iim
    169          eignq(k) = eignq(k) + matrinvn(k,i,j)*champ(i,j,l)
    170       ENDDO
    171       ENDDO
    172 #endif
    173 #endif
    174         ELSE IF ( griscal )     THEN
    175 #ifdef CRAY
    176          CALL MXVA( matriceun(1,1,j), 1, iim, champ(1,j,l), 1, eignq ,
    177      *                             1, iim, iim                         )
    178 #else
    179 #ifdef BLAS
    180       CALL SGEMV("N", iim,iim, 1.0, matriceun(1,1,j),iim,
    181      .           champ(1,j,l), 1, 0.0, eignq, 1)
    182 #else
    183       DO k = 1, iim
    184          eignq(k) = 0.0
    185       ENDDO
    186       DO i = 1, iim
    187       DO k = 1, iim
    188          eignq(k) = eignq(k) + matriceun(k,i,j)*champ(i,j,l)
    189       ENDDO
    190       ENDDO
    191 #endif
    192 #endif
    193         ELSE
    194 #ifdef CRAY
    195          CALL MXVA( matricevn(1,1,j), 1, iim, champ(1,j,l), 1, eignq ,
    196      *                             1, iim, iim                         )
    197 #else
    198 #ifdef BLAS
    199       CALL SGEMV("N", iim,iim, 1.0, matricevn(1,1,j),iim,
    200      .           champ(1,j,l), 1, 0.0, eignq, 1)
    201 #else
    202       DO k = 1, iim
    203          eignq(k) = 0.0
    204       ENDDO
    205       DO i = 1, iim
    206       DO k = 1, iim
    207          eignq(k) = eignq(k) + matricevn(k,i,j)*champ(i,j,l)
    208       ENDDO
    209       ENDDO
    210 #endif
    211 #endif
    212         ENDIF
    213 
    214       ELSE
    215 
    216         IF( ifiltre. EQ. -2 )   THEN
    217 #ifdef CRAY
    218          CALL MXVA( matrinvs(1,1,j-jfiltsu+1),  1, iim, champ(1,j,l),1 , 
    219      *                          eignq,  1, iim, iim                    )
    220 #else
    221 #ifdef BLAS
    222       CALL SGEMV("N", iim,iim, 1.0, matrinvs(1,1,j-jfiltsu+1),iim,
    223      .           champ(1,j,l), 1, 0.0, eignq, 1)
    224 #else
    225       DO k = 1, iim
    226          eignq(k) = 0.0
    227       ENDDO
    228       DO i = 1, iim
    229       DO k = 1, iim
    230          eignq(k) = eignq(k) + matrinvs(k,i,j-jfiltsu+1)*champ(i,j,l)
    231       ENDDO
    232       ENDDO
    233 #endif
    234 #endif
    235         ELSE IF ( griscal )     THEN
    236 #ifdef CRAY
    237          CALL MXVA( matriceus(1,1,j-jfiltsu+1), 1, iim, champ(1,j,l),1 ,
    238      *                          eignq,  1, iim, iim                    )
    239 #else
    240 #ifdef BLAS
    241       CALL SGEMV("N", iim,iim, 1.0, matriceus(1,1,j-jfiltsu+1),iim,
    242      .           champ(1,j,l), 1, 0.0, eignq, 1)
    243 #else
    244       DO k = 1, iim
    245          eignq(k) = 0.0
    246       ENDDO
    247       DO i = 1, iim
    248       DO k = 1, iim
    249          eignq(k) = eignq(k) + matriceus(k,i,j-jfiltsu+1)*champ(i,j,l)
    250       ENDDO
    251       ENDDO
    252 #endif
    253 #endif
    254         ELSE
    255 #ifdef CRAY
    256          CALL MXVA( matricevs(1,1,j-jfiltsv+1), 1, iim, champ(1,j,l),1 ,
    257      *                          eignq,  1, iim, iim                    )
    258 #else
    259 #ifdef BLAS
    260       CALL SGEMV("N", iim,iim, 1.0, matricevs(1,1,j-jfiltsv+1),iim,
    261      .           champ(1,j,l), 1, 0.0, eignq, 1)
    262 #else
    263       DO k = 1, iim
    264          eignq(k) = 0.0
    265       ENDDO
    266       DO i = 1, iim
    267       DO k = 1, iim
    268          eignq(k) = eignq(k) + matricevs(k,i,j-jfiltsv+1)*champ(i,j,l)
    269       ENDDO
    270       ENDDO
    271 #endif
    272 #endif
    273         ENDIF
    274 
    275       ENDIF
    276 c
    277       IF( ifiltre.EQ. 2 )  THEN
    278         DO 15 i = 1, iim
    279         champ( i,j,l ) = ( champ(i,j,l) + eignq(i) ) * sdd2(i)
    280   15    CONTINUE
    281       ELSE
    282         DO 16 i=1,iim
    283         champ( i,j,l ) = ( champ(i,j,l) - eignq(i) ) * sdd2(i)
    284 16      CONTINUE
    285       ENDIF
    286 c
    287       champ( iip1,j,l ) = champ( 1,j,l )
    288 c
    289   30  CONTINUE
    290 c
    291   50  CONTINUE
    292 c   
    293  100  CONTINUE
    294 c
     313
    2953141111  FORMAT(//20x,'ERREUR dans le dimensionnement du tableau  CHAMP a
    296      *filtrer, sur la grille des scalaires'/)
     315     &     filtrer, sur la grille des scalaires'/)
    2973162222  FORMAT(//20x,'ERREUR dans le dimensionnement du tableau CHAMP a fi
    298      *ltrer, sur la grille de V ou de Z'/)
     317     &     ltrer, sur la grille de V ou de Z'/)
    299318      RETURN
    300319      END

  • LMDZ4/trunk/libf/filtrez/inifgn.F

    r524 r1146  
    11!
    2 ! $Header$
     2! $Header: /home/cvsroot/LMDZ4/libf/filtrez/inifgn.F,v 1.1.1.1 2004-05-19 12:53:09 lmdzadmin Exp $
    33!
    44      SUBROUTINE inifgn(dv)

  • LMDZ4/trunk/libf/filtrez/parafilt.h

    r1024 r1146  
    33!
    44        INTEGER nfilun, nfilus, nfilvn, nfilvs
    5 
    6       PARAMETER (nfilun=24, nfilus=23, nfilvn=24, nfilvs=24)
    7 
    8 c
    9 c
    10 c      Ici , on a exagere  les nombres de lignes de latitudes a filtrer .
    11 c
    12 c      La premiere fois que  le Gcm  rentrera  dans le Filtre ,
    13 c
    14 c      il indiquera  les bonnes valeurs  de  nfilun , nflius, nfilvn  et
    15 c
    16 c      nfilvs  a  mettre .  Il suffira alors de changer ces valeurs dans
    17 c
    18 c      Parameter  ci-dessus  et de relancer  le  run . 
    19 

  • LMDZ4/trunk/libf/grid/dimension/makdim

    r795 r1146  
    1 nqmx=$1
    2 shift
    31for i in $* ; do
    42   list=$list.$i
    53done
    6 fichdim=dimensions${list}.t${nqmx}
     4fichdim=dimensions${list}
    75
    86if [ ! -f $fichdim ] ; then
    … …  
    5351!   dimensions.h contient les dimensions du modele
    5452!   ndm est tel que iim=2**ndm
    55 !   nqmx est la dimension de la variable traceur q
    5653!-----------------------------------------------------------------------
    5754
    … …  
    5956
    6057      PARAMETER (iim= $im,jjm=$jm,llm=$lm,ndm=$ndm)
    61 
    62       integer nqmx
    63       parameter (nqmx=$nqmx)
    6458
    6559!-----------------------------------------------------------------------

  • LMDZ4/trunk/libf/phylmd/calcul_STDlev.h

    r684 r1146  
    5656cIM on interpole sur les niveaux STD de pression a chaque pas de temps de la physique
    5757c
    58        DO k=1, nlevSTD
    59 c
    60         CALL plevel(klon,klev,.true.,pplay,rlevSTD(k),
    61      .              t_seri,tlevSTD(:,k))
    62         CALL plevel(klon,klev,.true.,pplay,rlevSTD(k),
    63      .             u_seri,ulevSTD(:,k))
    64         CALL plevel(klon,klev,.true.,pplay,rlevSTD(k),
    65      .             v_seri,vlevSTD(:,k))
    66 c
     58c-------------------------------------------------------c
     59c positionnement de l'argument logique a .false.        c
     60c pour ne pas recalculer deux fois la meme chose !      c
     61c a cet effet un appel a plevel_new a ete deplace       c
     62c a la fin de la serie d'appels                         c
     63c la boucle 'DO k=1, nlevSTD' a ete internalisee        c
     64c dans plevel_new, d'ou la creation de cette routine... c
     65c-------------------------------------------------------c
     66c
     67        CALL plevel_new(klon,klev,nlevSTD,.true.,pplay,rlevSTD,
     68     &              t_seri,tlevSTD)
     69        CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD,
     70     &             u_seri,ulevSTD)
     71        CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD,
     72     &             v_seri,vlevSTD)
     73c
     74
     75c
     76        CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD,
     77     &             zphi/RG,philevSTD)
     78        CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD,
     79     &             qx(:,:,ivap),qlevSTD)
     80        CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD,
     81     &             zx_rh*100.,rhlevSTD)
     82c
     83        DO l=1, klev
     84         DO i=1, klon
     85          zx_tmp_fi3d(i,l)=u_seri(i,l)*v_seri(i,l)
     86         ENDDO !i
     87        ENDDO !l
     88        CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD,
     89     &             zx_tmp_fi3d,uvSTD)
     90c
     91        DO l=1, klev
     92         DO i=1, klon
     93          zx_tmp_fi3d(i,l)=v_seri(i,l)*q_seri(i,l)
     94         ENDDO !i
     95        ENDDO !l
     96        CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD,
     97     &             zx_tmp_fi3d,vqSTD)
     98c
     99        DO l=1, klev
     100         DO i=1, klon
     101          zx_tmp_fi3d(i,l)=v_seri(i,l)*t_seri(i,l)
     102         ENDDO !i
     103        ENDDO !l
     104        CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD,
     105     &             zx_tmp_fi3d,vTSTD)
     106c
     107        DO l=1, klev
     108         DO i=1, klon
     109          zx_tmp_fi3d(i,l)=omega(i,l)*qx(i,l,ivap)
     110         ENDDO !i
     111        ENDDO !l
     112        CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD,
     113     &             zx_tmp_fi3d,wqSTD)
     114c
     115        DO l=1, klev
     116         DO i=1, klon
     117          zx_tmp_fi3d(i,l)=v_seri(i,l)*zphi(i,l)/RG
     118         ENDDO !i
     119        ENDDO !l
     120        CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD,
     121     &             zx_tmp_fi3d,vphiSTD)
     122c
     123        DO l=1, klev
     124         DO i=1, klon
     125          zx_tmp_fi3d(i,l)=omega(i,l)*t_seri(i,l)
     126         ENDDO !i
     127        ENDDO !l
     128        CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD,
     129     &             zx_tmp_fi3d,wTSTD)
     130c
     131        DO l=1, klev
     132         DO i=1, klon
     133          zx_tmp_fi3d(i,l)=u_seri(i,l)*u_seri(i,l)
     134         ENDDO !i
     135        ENDDO !l
     136        CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD,
     137     &             zx_tmp_fi3d,u2STD)
     138c
     139        DO l=1, klev
     140         DO i=1, klon
     141          zx_tmp_fi3d(i,l)=v_seri(i,l)*v_seri(i,l)
     142         ENDDO !i
     143        ENDDO !l
     144        CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD,
     145     &             zx_tmp_fi3d,v2STD)
     146c
     147        DO l=1, klev
     148         DO i=1, klon
     149          zx_tmp_fi3d(i,l)=t_seri(i,l)*t_seri(i,l)
     150         ENDDO !i
     151        ENDDO !l
     152        CALL plevel_new(klon,klev,nlevSTD,.false.,pplay,rlevSTD,
     153     &             zx_tmp_fi3d,T2STD)
     154
     155
    67156        DO l=1, klev
    68157        DO i=1, klon
    … …  
    70159        ENDDO !i
    71160        ENDDO !l
    72         CALL plevel(klon,klev,.true.,zx_tmp_fi3d,rlevSTD(k),
    73      .             omega,wlevSTD(:,k))
    74 c
    75         CALL plevel(klon,klev,.true.,pplay,rlevSTD(k),
    76      .             zphi/RG,philevSTD(:,k))
    77         CALL plevel(klon,klev,.true.,pplay,rlevSTD(k),
    78      .             qx(:,:,ivap),qlevSTD(:,k))
    79         CALL plevel(klon,klev,.true.,pplay,rlevSTD(k),
    80      .             zx_rh*100.,rhlevSTD(:,k))
    81 c
    82         DO l=1, klev
    83          DO i=1, klon
    84           zx_tmp_fi3d(i,l)=u_seri(i,l)*v_seri(i,l)
    85          ENDDO !i
    86         ENDDO !l
    87         CALL plevel(klon,klev,.true.,pplay,rlevSTD(k),
    88      .             zx_tmp_fi3d,uvSTD(:,k))
    89 c
    90         DO l=1, klev
    91          DO i=1, klon
    92           zx_tmp_fi3d(i,l)=v_seri(i,l)*q_seri(i,l)
    93          ENDDO !i
    94         ENDDO !l
    95         CALL plevel(klon,klev,.true.,pplay,rlevSTD(k),
    96      .             zx_tmp_fi3d,vqSTD(:,k))
    97 c
    98         DO l=1, klev
    99          DO i=1, klon
    100           zx_tmp_fi3d(i,l)=v_seri(i,l)*t_seri(i,l)
    101          ENDDO !i
    102         ENDDO !l
    103         CALL plevel(klon,klev,.true.,pplay,rlevSTD(k),
    104      .             zx_tmp_fi3d,vTSTD(:,k))
    105 c
    106         DO l=1, klev
    107          DO i=1, klon
    108           zx_tmp_fi3d(i,l)=omega(i,l)*qx(i,l,ivap)
    109          ENDDO !i
    110         ENDDO !l
    111         CALL plevel(klon,klev,.true.,pplay,rlevSTD(k),
    112      .             zx_tmp_fi3d,wqSTD(:,k))
    113 c
    114         DO l=1, klev
    115          DO i=1, klon
    116           zx_tmp_fi3d(i,l)=v_seri(i,l)*zphi(i,l)/RG
    117          ENDDO !i
    118         ENDDO !l
    119         CALL plevel(klon,klev,.true.,pplay,rlevSTD(k),
    120      .             zx_tmp_fi3d,vphiSTD(:,k))
    121 c
    122         DO l=1, klev
    123          DO i=1, klon
    124           zx_tmp_fi3d(i,l)=omega(i,l)*t_seri(i,l)
    125          ENDDO !i
    126         ENDDO !l
    127         CALL plevel(klon,klev,.true.,pplay,rlevSTD(k),
    128      .             zx_tmp_fi3d,wTSTD(:,k))
    129 c
    130         DO l=1, klev
    131          DO i=1, klon
    132           zx_tmp_fi3d(i,l)=u_seri(i,l)*u_seri(i,l)
    133          ENDDO !i
    134         ENDDO !l
    135         CALL plevel(klon,klev,.true.,pplay,rlevSTD(k),
    136      .             zx_tmp_fi3d,u2STD(:,k))
    137 c
    138         DO l=1, klev
    139          DO i=1, klon
    140           zx_tmp_fi3d(i,l)=v_seri(i,l)*v_seri(i,l)
    141          ENDDO !i
    142         ENDDO !l
    143         CALL plevel(klon,klev,.true.,pplay,rlevSTD(k),
    144      .             zx_tmp_fi3d,v2STD(:,k))
    145 c
    146         DO l=1, klev
    147          DO i=1, klon
    148           zx_tmp_fi3d(i,l)=t_seri(i,l)*t_seri(i,l)
    149          ENDDO !i
    150         ENDDO !l
    151         CALL plevel(klon,klev,.true.,pplay,rlevSTD(k),
    152      .             zx_tmp_fi3d,T2STD(:,k))
    153 c
    154        ENDDO !k=1,nlevSTD
     161        CALL plevel_new(klon,klev,nlevSTD,.true.,zx_tmp_fi3d,rlevSTD,
     162     &             omega,wlevSTD)
     163
    155164c
    156165cIM on somme les valeurs definies a chaque pas de temps de la physique ou

  • LMDZ4/trunk/libf/phylmd/calltherm.F90

    r1026 r1146  
    1616#include "thermcell.h"
    1717#include "iniprint.h"
    18 
    19 !  A inclure eventuellement dans les fichiers de configuration
    20       data r_aspect_thermals,l_mix_thermals/2.,30./
    21       data w2di_thermals/1/
    2218
    2319!IM 140508
    … …  
    126122         do k=1,klev
    127123            do i=1,klon
    128                logexpr2(i,k)=.not.q_seri(i,k).ge.0.
     124! Attention teste abderr 19-03-09
     125!               logexpr2(i,k)=.not.q_seri(i,k).ge.0.
     126                logexpr2(i,k)=.not.q_seri(i,k).ge.1.e-15
    129127               if (logexpr2(i,k)) then
    130128                q_seri(i,k)=1.e-15
    … …  
    174172     &      ,tau_thermals,3)
    175173          else if (iflag_thermals.eq.11) then
    176             stop'cas non prevu dans calltherm'
     174            stop 'cas non prevu dans calltherm'
    177175!           CALL thermcell_pluie(klon,klev,zdt  &
    178176!   &      ,pplay,paprs,pphi,zlev  &

  • LMDZ4/trunk/libf/phylmd/clesphys.h

    r1067 r1146  
    4040       INTEGER lev_histhf, lev_histday, lev_histmth
    4141       CHARACTER*4 type_run
     42! aer_type: pour utiliser un fichier constant dans readsulfate
     43       CHARACTER*8 :: aer_type
    4244       LOGICAL ok_isccp, ok_regdyn
    4345       REAL lonmin_ins, lonmax_ins, latmin_ins, latmax_ins
    … …  
    6264     &     , ecrit_mth, ecrit_tra, ecrit_reg                            &
    6365     &     , freq_ISCCP, ecrit_ISCCP, ip_ebil_phy                       &
    64      &     , ok_lic_melt, cvl_corr                                      &
     66     &     , ok_lic_melt, cvl_corr, aer_type                            &
    6567     &     , qsol0, iflag_rrtm, ok_strato,ok_hines,ecrit_LES
    6668     

  • LMDZ4/trunk/libf/phylmd/concvl.F

    r987 r1146  
    55      SUBROUTINE concvl (iflag_con,iflag_clos,
    66     .             dtime,paprs,pplay,
    7      .             t,q,t_wake,q_wake,u,v,tra,ntra,
     7     .             t,q,t_wake,q_wake,s_wake,u,v,tra,ntra,
    88     .             ALE,ALP,work1,work2,
    99     .             d_t,d_q,d_u,d_v,d_tra,
    … …  
    2525c
    2626      USE dimphy
     27      USE infotrac, ONLY : nbtr
    2728      IMPLICIT none
    2829c======================================================================
    … …  
    6768c
    6869#include "dimensions.h"
    69 cccccc#include "dimphy.h"
    70 c
    71       integer NTRAC
    72       PARAMETER (NTRAC=nqmx-2)
    7370c
    7471       INTEGER iflag_con,iflag_clos
    … …  
    7774       REAL t(klon,klev),q(klon,klev),u(klon,klev),v(klon,klev)
    7875       REAL t_wake(klon,klev),q_wake(klon,klev)
    79        REAL tra(klon,klev,ntrac)
     76       Real s_wake(klon)
     77       REAL tra(klon,klev,nbtr)
    8078       INTEGER ntra
    8179       REAL work1(klon,klev),work2(klon,klev),ptop2(klon)
    … …  
    8583       REAL d_t(klon,klev),d_q(klon,klev),d_u(klon,klev),d_v(klon,klev)
    8684       REAL dd_t(klon,klev),dd_q(klon,klev)
    87        REAL d_tra(klon,klev,ntrac)
     85       REAL d_tra(klon,klev,nbtr)
    8886       REAL rain(klon),snow(klon)
    8987c
    … …  
    349347      CALL cva_driver(klon,klev,klev+1,ntra,nloc,
    350348     $              iflag_con,iflag_mix,iflag_clos,dtime,
    351      :              t,q,qs,t_wake,q_wake,qs_wake,u,v,tra,
     349     :              t,q,qs,t_wake,q_wake,qs_wake,s_wake,u,v,tra,
    352350     $              em_p,em_ph,
    353351     .              ALE,ALP,

  • LMDZ4/trunk/libf/phylmd/conema3.F

    r766 r1146  
    1010
    1111      USE dimphy
     12      USE infotrac, ONLY : nbtr
    1213      IMPLICIT none
    1314c======================================================================
    … …  
    5556c
    5657#include "dimensions.h"
    57 cym#include "dimphy.h"
    5858#include "conema3.h"
    5959      INTEGER i, l,m,itra
    60       INTEGER ntra,ntrac !number of tracers; if no tracer transport
     60      INTEGER ntra       ! if no tracer transport
    6161                         ! is needed, set ntra = 1 (or 0)
    62       PARAMETER (ntrac=nqmx-2)
    6362      REAL dtime
    6463c
    … …  
    9796      REAL,ALLOCATABLE,SAVE :: em_qs(:)
    9897c$OMP THREADPRIVATE(em_qs) 
    99 cym      REAL em_u(klev), em_v(klev), em_tra(klev,ntrac)
     98cym      REAL em_u(klev), em_v(klev), em_tra(klev,nbtr)
    10099      REAL,ALLOCATABLE,SAVE :: em_u(:),em_v(:),em_tra(:,:)
    101100c$OMP THREADPRIVATE(em_u,em_v,em_tra)     
    … …  
    111110      REAL,ALLOCATABLE,SAVE :: em_d_t(:),em_d_q(:)
    112111c$OMP THREADPRIVATE(em_d_t,em_d_q)
    113 cym      REAL em_d_u(klev), em_d_v(klev), em_d_tra(klev,ntrac)
     112cym      REAL em_d_u(klev), em_d_v(klev), em_d_tra(klev,nbtr)
    114113      REAL,ALLOCATABLE,SAVE ::em_d_u(:),em_d_v(:),em_d_tra(:,:)
    115114c$OMP THREADPRIVATE(em_d_u,em_d_v,em_d_tra)     
    … …  
    188187        allocate(em_q(klev))
    189188        allocate(em_qs(klev))
    190         allocate(em_u(klev), em_v(klev), em_tra(klev,ntrac))
     189        allocate(em_u(klev), em_v(klev), em_tra(klev,nbtr))
    191190        allocate(em_ph(klev+1), em_p(klev))
    192191        allocate(em_work1(klev), em_work2(klev))
    193192        allocate(em_d_t(klev), em_d_q(klev))
    194         allocate(em_d_u(klev), em_d_v(klev), em_d_tra(klev,ntrac))
     193        allocate(em_d_u(klev), em_d_v(klev), em_d_tra(klev,nbtr))
    195194        allocate(em_upwd(klev), em_dnwd(klev), em_dnwdbis(klev))
    196195        allocate(emmip(klev))

  • LMDZ4/trunk/libf/phylmd/conemav.F

    r766 r1146  
    1010c
    1111      USE dimphy
     12      USE infotrac, ONLY : nbtr
    1213      IMPLICIT none
    1314c======================================================================
    … …  
    4445c
    4546#include "dimensions.h"
    46 cym#include "dimphy.h"
    4747c
    48       integer NTRAC
    49       PARAMETER (NTRAC=nqmx-2)
    5048c
    5149       REAL dtime, paprs(klon,klev+1),pplay(klon,klev)
    5250       REAL t(klon,klev),q(klon,klev),u(klon,klev),v(klon,klev)
    53        REAL tra(klon,klev,ntrac)
     51       REAL tra(klon,klev,nbtr)
    5452       INTEGER ntra
    5553       REAL work1(klon,klev),work2(klon,klev)
    5654c
    5755       REAL d_t(klon,klev),d_q(klon,klev),d_u(klon,klev),d_v(klon,klev)
    58        REAL d_tra(klon,klev,ntrac)
     56       REAL d_tra(klon,klev,nbtr)
    5957       REAL rain(klon),snow(klon)
    6058c
    … …  
    7472       INTEGER i,k,itra
    7573       REAL qs(klon,klev)
    76 cym       REAL cbmf(klon)
    77 cym       SAVE cbmf
    7874       REAL,ALLOCATABLE,SAVE :: cbmf(:)
    7975c$OMP THREADPRIVATE(cbmf)

  • LMDZ4/trunk/libf/phylmd/conf_phys.F90

    r1054 r1146  
    6666
    6767  character (len = 6),SAVE  :: type_ocean_omp, version_ocean_omp, ocean_omp
     68  CHARACTER(len = 8),SAVE   :: aer_type_omp
    6869  logical,SAVE              :: ok_veget_omp, ok_newmicro_omp
    6970  logical,SAVE        :: ok_journe_omp, ok_mensuel_omp, ok_instan_omp, ok_hf_omp       
    … …  
    238239  CALL getin('aerosol_couple',aerosol_couple_omp)
    239240
     241!
     242!Config Key  = aer_type
     243!Config Desc = Use a constant field for the aerosols
     244!Config Def  = scenario
     245!Config Help = Used in readsulfate.F
     246!
     247  aer_type_omp = 'scenario'
     248  call getin('aer_type', aer_type_omp)
     249
    240250!
    241251!Config Key  = bl95_b0
    … …  
    462472!Config  Help = Connais pas !
    463473       ok_orolf_omp = .TRUE.
    464        CALL getin('ok_orolf_omp', ok_orolf_omp)
     474       CALL getin('ok_orolf', ok_orolf_omp)
    465475
    466476!Config  Key  = ok_limitvrai
    … …  
    12561266    ok_aie = ok_aie_omp
    12571267    aerosol_couple = aerosol_couple_omp
     1268    aer_type = aer_type_omp
    12581269    bl95_b0 = bl95_b0_omp
    12591270    bl95_b1 = bl95_b1_omp
    … …  
    13101321    END IF
    13111322
    1312     IF (type_ocean=='slab' .AND. version_ocean/='xxxxxx') THEN
     1323    IF (type_ocean=='slab' .AND. version_ocean=='xxxxxx') THEN
    13131324       version_ocean='sicOBS'
    13141325    ELSE IF (type_ocean=='slab' .AND. version_ocean/='sicOBS') THEN
    … …  
    13851396  write(numout,*)' ok_aie = ',ok_aie
    13861397  write(numout,*)' aerosol_couple = ', aerosol_couple
     1398  write(numout,*)' aer_type = ',aer_type
    13871399  write(numout,*)' bl95_b0 = ',bl95_b0
    13881400  write(numout,*)' bl95_b1 = ',bl95_b1
    … …  
    13941406  write(numout,*)' iflag_thermals_ed = ', iflag_thermals_ed
    13951407  write(numout,*)' iflag_thermals_optflux = ', iflag_thermals_optflux
     1408  write(numout,*)' iflag_clos = ', iflag_clos
    13961409  write(numout,*)' type_run = ',type_run
    13971410  write(numout,*)' ok_isccp = ',ok_isccp

  • LMDZ4/trunk/libf/phylmd/convect3.F

    r766 r1146  
    1919c#################################################################
    2020      USE dimphy
     21      USE infotrac, ONLY : NBTR
    2122
    2223#include "dimensions.h"
    23 cym#include "dimphy.h"
     24      INTEGER NA
    2425      PARAMETER (NA=60)
    2526
    26       integer NTRAC
    27       PARAMETER (NTRAC=nqmx-2)
    2827      REAL DELTAC              ! cld
    2928      PARAMETER (DELTAC=0.01)  ! cld
    3029
    3130      INTEGER NENT(NA)
     31      INTEGER ND, NDP1, NL, NTRA, IFLAG, icb, inb
     32      REAL DTIME, EPMAX, DELT, PRECIP, CAPE
     33      REAL DPLCLDT, DPLCLDR
    3234      REAL T1(ND),R1(ND),RS(ND),U(ND),V(ND),TRA(ND,NTRA)
    3335      REAL P(ND),PH(NDP1)
    3436      REAL FT(ND),FR(ND),FU(ND),FV(ND),FTRA(ND,NTRA)
    3537      REAL SIG(ND),W0(ND)
    36       REAL UENT(NA,NA),VENT(NA,NA),TRAENT(NA,NA,NTRAC),TRATM(NA)
    37       REAL UP(NA),VP(NA),TRAP(NA,NTRAC)
     38      REAL UENT(NA,NA),VENT(NA,NA),TRAENT(NA,NA,NBTR),TRATM(NA)
     39      REAL UP(NA),VP(NA),TRAP(NA,NBTR)
    3840      REAL M(NA),MP(NA),MENT(NA,NA),QENT(NA,NA),ELIJ(NA,NA)
    3941      REAL SIJ(NA,NA),TVP(NA),TV(NA),WATER(NA)

  • LMDZ4/trunk/libf/phylmd/cpl_mod.F90

    r1067 r1146  
    278278    USE surface_data
    279279    USE phys_state_var_mod, ONLY : rlon, rlat
    280     USE Write_Field
    281280
    282281    INCLUDE "indicesol.h"
    … …  
    338337! Save each field in a 2D array.
    339338!$OMP MASTER
    340        IF (version_ocean=='nemo') THEN
    341           read_sst(:,:)     = tab_read_flds(:,:,1)  ! Sea surface temperature
    342           read_sic(:,:)     = tab_read_flds(:,:,2)  ! Sea ice concentration
    343           read_sit(:,:)     = tab_read_flds(:,:,3)  ! Sea ice temperature
    344           read_alb_sic(:,:) = tab_read_flds(:,:,4)  ! Albedo at sea ice
    345        ELSE IF (version_ocean=='opa8') THEN
    346           read_sst(:,:)     = tab_read_flds(:,:,1)  ! Sea surface temperature (multiplicated by fraction)
    347           read_sic(:,:)     = tab_read_flds(:,:,2)  ! Sea ice concentration
    348           read_alb_sic(:,:) = tab_read_flds(:,:,3)  ! Albedo at sea ice (multiplicated by fraction)
    349           read_sit(:,:)     = tab_read_flds(:,:,4)  ! Sea ice temperature (multiplicated by fraction)
    350        END IF
     339       read_sst(:,:)     = tab_read_flds(:,:,1)  ! Sea surface temperature
     340       read_sic(:,:)     = tab_read_flds(:,:,2)  ! Sea ice concentration
     341       read_alb_sic(:,:) = tab_read_flds(:,:,3)  ! Albedo at sea ice
     342       read_sit(:,:)     = tab_read_flds(:,:,4)  ! Sea ice temperature
    351343!$OMP END MASTER
    352344
    … …  
    366358               read_u0(:,:), read_v0(:,:), tmp_r0(:,:))
    367359!$OMP END MASTER
    368           CALL WriteField('read_u0',read_u0)
    369           CALL WriteField('read_v0',read_v0)
    370           CALL WriteField('read_r0',tmp_r0)
     360
    371361       ELSE
    372362          read_u0(:,:) = 0.
    … …  
    449439
    450440  SUBROUTINE cpl_receive_seaice_fields(knon, knindex, &
    451        tsurf_new, alb_new)
     441       tsurf_new, alb_new, u0_new, v0_new)
    452442!
    453443! This routine returns the fields for the seaice that have been read from the coupler
    … …  
    466456    REAL, DIMENSION(klon), INTENT(OUT)      :: tsurf_new
    467457    REAL, DIMENSION(klon), INTENT(OUT)      :: alb_new
     458    REAL, DIMENSION(klon), INTENT(OUT)      :: u0_new
     459    REAL, DIMENSION(klon), INTENT(OUT)      :: v0_new
    468460
    469461! Local variables
    … …  
    479471    CALL cpl2gath(read_alb_sic, alb_new, knon, knindex)
    480472    CALL cpl2gath(read_sic, sic_new, knon, knindex)
     473    CALL cpl2gath(read_u0, u0_new, knon, knindex)
     474    CALL cpl2gath(read_v0, v0_new, knon, knindex)
    481475
    482476!*************************************************************************************
    … …  
    620614       
    621615
    622        CALL gath2cpl(cpl_sols(1,cpl_index), cpl_sols2D(1,1,cpl_index), &
    623             knon, knindex)
    624 
    625        CALL gath2cpl(cpl_nsol(1,cpl_index), cpl_nsol2D(1,1,cpl_index), &
    626             knon, knindex)
    627 
    628        CALL gath2cpl(cpl_rain(1,cpl_index), cpl_rain2D(1,1,cpl_index), &
    629             knon, knindex)
    630 
    631        CALL gath2cpl(cpl_snow(1,cpl_index), cpl_snow2D(1,1,cpl_index), &
    632             knon, knindex)
    633 
    634        CALL gath2cpl(cpl_evap(1,cpl_index), cpl_evap2D(1,1,cpl_index), &
     616       CALL gath2cpl(cpl_sols(:,cpl_index), cpl_sols2D(:,:,cpl_index), &
     617            knon, knindex)
     618
     619       CALL gath2cpl(cpl_nsol(:,cpl_index), cpl_nsol2D(:,:,cpl_index), &
     620            knon, knindex)
     621
     622       CALL gath2cpl(cpl_rain(:,cpl_index), cpl_rain2D(:,:,cpl_index), &
     623            knon, knindex)
     624
     625       CALL gath2cpl(cpl_snow(:,cpl_index), cpl_snow2D(:,:,cpl_index), &
     626            knon, knindex)
     627
     628       CALL gath2cpl(cpl_evap(:,cpl_index), cpl_evap2D(:,:,cpl_index), &
    635629            knon, knindex)
    636630
    637631! cpl_tsol2D(:,:,:) not used!
    638        CALL gath2cpl(cpl_tsol(1,cpl_index), cpl_tsol2D(1,1, cpl_index), &
     632       CALL gath2cpl(cpl_tsol(:,cpl_index), cpl_tsol2D(:,:, cpl_index), &
    639633            knon, knindex)
    640634
    641635! cpl_fder2D(:,:,1) not used, only cpl_fder(:,:,2)!
    642        CALL gath2cpl(cpl_fder(1,cpl_index), cpl_fder2D(1,1,cpl_index), &
     636       CALL gath2cpl(cpl_fder(:,cpl_index), cpl_fder2D(:,:,cpl_index), &
    643637            knon, knindex)
    644638
    645639! cpl_albe2D(:,:,:) not used!
    646        CALL gath2cpl(cpl_albe(1,cpl_index), cpl_albe2D(1,1,cpl_index), &
    647             knon, knindex)
    648 
    649        CALL gath2cpl(cpl_taux(1,cpl_index), cpl_taux2D(1,1,cpl_index), &
    650             knon, knindex)
    651 
    652        CALL gath2cpl(cpl_tauy(1,cpl_index), cpl_tauy2D(1,1,cpl_index), &
    653             knon, knindex)
    654 
    655        CALL gath2cpl(cpl_windsp(1,cpl_index), cpl_windsp2D(1,1), &
     640       CALL gath2cpl(cpl_albe(:,cpl_index), cpl_albe2D(:,:,cpl_index), &
     641            knon, knindex)
     642
     643       CALL gath2cpl(cpl_taux(:,cpl_index), cpl_taux2D(:,:,cpl_index), &
     644            knon, knindex)
     645
     646       CALL gath2cpl(cpl_tauy(:,cpl_index), cpl_tauy2D(:,:,cpl_index), &
     647            knon, knindex)
     648
     649       CALL gath2cpl(cpl_windsp(:,cpl_index), cpl_windsp2D(:,:), &
    656650            knon, knindex)
    657651
    … …  
    698692    CHARACTER(len = 25)                     :: modname = 'cpl_send_seaice_fields'
    699693    CHARACTER(len = 80)                     :: abort_message
    700 
     694    REAL, DIMENSION(klon)                   :: cpl_fder_tmp
    701695
    702696!*************************************************************************************
    … …  
    788782       ENDIF
    789783
    790        CALL gath2cpl(cpl_sols(1,cpl_index), cpl_sols2D(1,1,cpl_index), &
    791             knon, knindex)
    792 
    793        CALL gath2cpl(cpl_nsol(1,cpl_index), cpl_nsol2D(1,1,cpl_index), &
    794             knon, knindex)
    795 
    796        CALL gath2cpl(cpl_rain(1,cpl_index), cpl_rain2D(1,1,cpl_index), &
    797             knon, knindex)
    798 
    799        CALL gath2cpl(cpl_snow(1,cpl_index), cpl_snow2D(1,1,cpl_index), &
    800             knon, knindex)
    801 
    802        CALL gath2cpl(cpl_evap(1,cpl_index), cpl_evap2D(1,1,cpl_index), &
     784       CALL gath2cpl(cpl_sols(:,cpl_index), cpl_sols2D(:,:,cpl_index), &
     785            knon, knindex)
     786
     787       CALL gath2cpl(cpl_nsol(:,cpl_index), cpl_nsol2D(:,:,cpl_index), &
     788            knon, knindex)
     789
     790       CALL gath2cpl(cpl_rain(:,cpl_index), cpl_rain2D(:,:,cpl_index), &
     791            knon, knindex)
     792
     793       CALL gath2cpl(cpl_snow(:,cpl_index), cpl_snow2D(:,:,cpl_index), &
     794            knon, knindex)
     795
     796       CALL gath2cpl(cpl_evap(:,cpl_index), cpl_evap2D(:,:,cpl_index), &
    803797            knon, knindex)
    804798
    805799! cpl_tsol2D(:,:,:) not used!
    806        CALL gath2cpl(cpl_tsol(1,cpl_index), cpl_tsol2D(1,1, cpl_index), &
    807             knon, knindex)
    808 
    809        CALL gath2cpl(cpl_fder(1,cpl_index), cpl_fder2D(1,1,cpl_index), &
    810             knon, knindex)
     800       CALL gath2cpl(cpl_tsol(:,cpl_index), cpl_tsol2D(:,:, cpl_index), &
     801            knon, knindex)
     802
     803       ! Set default value and decompress before gath2cpl
     804       cpl_fder_tmp(:) = -20.
     805       DO ig = 1, knon
     806          cpl_fder_tmp(knindex(ig))=cpl_fder(ig,cpl_index)
     807       END DO
     808       CALL gath2cpl(cpl_fder_tmp(:), cpl_fder2D(:,:,cpl_index), &
     809            klon, unity)
    811810
    812811! cpl_albe2D(:,:,:) not used!
    813        CALL gath2cpl(cpl_albe(1,cpl_index), cpl_albe2D(1,1,cpl_index), &
    814             knon, knindex)
    815 
    816        CALL gath2cpl(cpl_taux(1,cpl_index), cpl_taux2D(1,1,cpl_index), &
    817             knon, knindex)
    818 
    819        CALL gath2cpl(cpl_tauy(1,cpl_index), cpl_tauy2D(1,1,cpl_index), &
     812       CALL gath2cpl(cpl_albe(:,cpl_index), cpl_albe2D(:,:,cpl_index), &
     813            knon, knindex)
     814
     815       CALL gath2cpl(cpl_taux(:,cpl_index), cpl_taux2D(:,:,cpl_index), &
     816            knon, knindex)
     817
     818       CALL gath2cpl(cpl_tauy(:,cpl_index), cpl_tauy2D(:,:,cpl_index), &
    820819            knon, knindex)
    821820
    … …  
    995994!*************************************************************************************
    996995! All fields are stored in a table tab_flds(:,:,:)
    997 ! First store the fields 7 to 18 which are already on the right format
     996! First store the fields which are already on the right format
    998997!
    999998!*************************************************************************************
    1000999!$OMP MASTER
     1000    tab_flds(:,:,7)  = cpl_windsp2D(:,:)
     1001    tab_flds(:,:,8)  = cpl_sols2D(:,:,2)
     1002    tab_flds(:,:,10) = cpl_nsol2D(:,:,2)
     1003    tab_flds(:,:,12) = cpl_fder2D(:,:,2)
     1004   
    10011005    IF (version_ocean=='nemo') THEN
    1002        tab_flds(:,:,7)  = cpl_windsp2D(:,:)
    1003        tab_flds(:,:,14) = cpl_sols2D(:,:,2)
    1004        tab_flds(:,:,12) = cpl_sols2D(:,:,1)
    1005        tab_flds(:,:,15) = cpl_nsol2D(:,:,2)
    1006        tab_flds(:,:,13) = cpl_nsol2D(:,:,1)
    1007        tab_flds(:,:,16) = cpl_fder2D(:,:,2)
    1008        tab_flds(:,:,11) = cpl_evap2D(:,:,2)
    1009        tab_flds(:,:,18) = cpl_rriv2D(:,:)
    1010        tab_flds(:,:,19) = cpl_rcoa2D(:,:)
     1006       tab_flds(:,:,18) = cpl_rriv2D(:,:) + cpl_rcoa2D(:,:)
    10111007    ELSE IF (version_ocean=='opa8') THEN
    1012        tab_flds(:,:,7)  = cpl_windsp2D(:,:)
    1013        tab_flds(:,:,8)  = cpl_sols2D(:,:,2)
    10141008       tab_flds(:,:,9)  = cpl_sols2D(:,:,1)
    1015        tab_flds(:,:,10) = cpl_nsol2D(:,:,2)
    10161009       tab_flds(:,:,11) = cpl_nsol2D(:,:,1)
    1017        tab_flds(:,:,12) = cpl_fder2D(:,:,2)
    10181010       tab_flds(:,:,13) = cpl_evap2D(:,:,2)
    10191011       tab_flds(:,:,14) = cpl_evap2D(:,:,1)
    … …  
    10211013       tab_flds(:,:,18) = cpl_rriv2D(:,:)
    10221014    END IF
    1023    
     1015
    10241016!*************************************************************************************
    10251017! Transform the fraction of sub-surfaces from 1D to 2D array
    … …  
    10811073! fractions of ocean and seaice.
    10821074!
    1083 ! Store the fields for rain and snow directly in tab_flds(:,:,15) and
    1084 ! tab_flds(:,:,16) respectively.
    1085 !
    10861075!*************************************************************************************   
    10871076       ! fraction oce+seaice
    … …  
    10891078
    10901079       IF (version_ocean=='nemo') THEN
    1091           tab_flds(:,:,10) = 0.0
     1080          tab_flds(:,:,9)  = 0.0
     1081          tab_flds(:,:,11) = 0.0
     1082          tab_flds(:,:,13) = 0.0
     1083          tab_flds(:,:,14) = 0.0
     1084          tab_flds(:,:,15) = 0.0
     1085 
    10921086          tmp_taux(:,:)    = 0.0
    10931087          tmp_tauy(:,:)    = 0.0
    10941088          ! For all valid grid cells containing some fraction of ocean or sea-ice
    10951089          WHERE ( deno(:,:) /= 0 )
    1096              tab_flds(:,:,10) = cpl_snow2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
    1097                   cpl_snow2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
    1098              
    10991090             tmp_taux = cpl_taux2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
    11001091                  cpl_taux2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
    11011092             tmp_tauy = cpl_tauy2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
    11021093                  cpl_tauy2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
    1103           ENDWHERE
    1104           tab_flds(:,:,8) = (cpl_evap2D(:,:,1) - ( cpl_rain2D(:,:,1) + cpl_snow2D(:,:,1)))
    1105           tab_flds(:,:,9) = (cpl_evap2D(:,:,2) - ( cpl_rain2D(:,:,2) + cpl_snow2D(:,:,2)))
     1094             
     1095             tab_flds(:,:,9) = cpl_sols2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
     1096                  cpl_sols2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
     1097             tab_flds(:,:,11) = cpl_nsol2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
     1098                  cpl_nsol2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
     1099             tab_flds(:,:,13) = cpl_rain2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
     1100                  cpl_rain2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
     1101             tab_flds(:,:,14) = cpl_snow2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
     1102                  cpl_snow2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
     1103             tab_flds(:,:,15) = cpl_evap2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
     1104                  cpl_evap2D(:,:,2)  * pctsrf2D(:,:,is_sic) / deno(:,:)
     1105         ENDWHERE
     1106
     1107          tab_flds(:,:,16) = cpl_evap2D(:,:,2)
    11061108         
    11071109       ELSE IF (version_ocean=='opa8') THEN
     1110          ! Store fields for rain and snow in tab_flds(:,:,15) and tab_flds(:,:,16)
    11081111          tab_flds(:,:,15) = 0.0
    11091112          tab_flds(:,:,16) = 0.0

  • LMDZ4/trunk/libf/phylmd/cv3_cine.F

    r879 r1146  
    3333      integer ifst(nloc),isublcl(nloc)
    3434      logical lswitch(nloc),lswitch1(nloc),lswitch2(nloc)
     35      logical exist_lfc(nloc)
     36      real plfc(nloc)
    3537      real dpmax
    3638      real deltap,dcin
    3739      real buoylcl(nloc),tvplcl(nloc),tvlcl(nloc)
    38       real plfc(nloc),p0(nloc)
     40      real p0(nloc)
    3941      real buoyz(nloc), buoy(nloc,nd)
    4042c
    … …  
    5052c      Recompute buoyancies
    5153c--------------------------------------------------------------
    52       DO k = 1,nl
     54      DO k = 1,nd
    5355        DO il = 1,ncum
     56!      print*,'tvp tv=',tvp(il,k),tv(il,k)
    5457          buoy(il,k) = tvp(il,k) - tv(il,k)
    5558        ENDDO
    5659      ENDDO
    57 c
    58 c---------------------------------------------------------------
    59 c premiere couche contenant un  niveau de flotabilite positive
    60 c et premiere couche contenant un  niveau de flotabilite negative
    61 c  au dessus du niveau de condensation
    62 c---------------------------------------------------------------
    63       do il = 1,ncum
    64         itop(il) =nl-1
    65         ineg(il) = nl-1
    66       enddo
    67       do 100 k=nl,1,-1
    68        do 110 il=1,ncum
    69         if (k .ge. icb(il)) then
    70          if (buoy(il,k) .gt. 0.) then
    71           itop(il)=k
    72          else
    73           ineg(il)=k
    74          endif
    75         endif
    76 110    continue
    77 100   continue
    78 c      print *,' itop, ineg, icb ',itop(1),ineg(1), icb(1)
    79 c
    8060c---------------------------------------------------------------
    8161c
    … …  
    10989c
    11090c---------------------------------------------------------------
     91c premiere couche contenant un  niveau de flotabilite positive
     92c et premiere couche contenant un  niveau de flotabilite negative
     93c  au dessus du niveau de condensation
     94c---------------------------------------------------------------
     95      do il = 1,ncum
     96        itop(il) =nl-1
     97        ineg(il) = nl-1
     98        exist_lfc(il) = .FALSE.
     99      enddo
     100      do 100 k=nl-1,1,-1
     101       do 110 il=1,ncum
     102        if (k .ge. ifst(il)) then
     103         if (buoy(il,k) .gt. 0.) then
     104          itop(il)=k
     105          exist_lfc(il) = .TRUE.
     106         else
     107          ineg(il)=k
     108         endif
     109        endif
     110110    continue
     111100   continue
     112c
     113c---------------------------------------------------------------
     114c When there is no positive buoyancy level, set Plfc, Cina and Cinb
     115c to arbitrary extreme values.
     116c---------------------------------------------------------------
     117      DO il = 1,ncum
     118       IF (.NOT.exist_lfc(il)) THEN
     119         Plfc(il) = 1.111
     120         Cinb(il) = -1111.
     121         Cina(il) = -1112.
     122       ENDIF
     123      ENDDO
     124c
     125c
     126c---------------------------------------------------------------
    111127c -- Two cases : BUOYlcl >= 0 and BUOYlcl < 0.
    112128c---------------------------------------------------------------
    … …  
    118134      DPMAX = 50.
    119135      DO il = 1,ncum
    120         lswitch1(il)=BUOYlcl(il) .GE. 0.
     136        lswitch1(il)=BUOYlcl(il) .GE. 0. .AND. exist_lfc(il)
    121137        lswitch(il) = lswitch1(il)
    122138      ENDDO
    … …  
    233249C
    234250      DO il = 1,ncum
    235         lswitch1(il)=BUOYlcl(il) .LT. 0.
     251        lswitch1(il)=BUOYlcl(il) .LT. 0. .AND. exist_lfc(il)
    236252        lswitch(il) = lswitch1(il)
    237253      ENDDO
    … …  
    239255c 2.0.1 Premiere  couche ou la flotabilite est negative au dessus du sol
    240256c ----------------------------------------------------
    241 c    au cas ou il existe  sinon ilow=1 (nk apres)
     257c    au cas ou elle existe  sinon ilow=1 (nk apres)
    242258c      on suppose que la parcelle part de la premiere couche
    243259c
    … …  
    248264      ENDDO
    249265c
    250       do 200 i=nl,1,-1
     266      do 200 k=nl,1,-1
    251267        DO il = 1,ncum
    252268        IF (lswitch(il) .AND. k .LE.icb(il)-1) THEN
    … …  
    292308        dcin = RD*(BUOYz(il)+BUOYlcl(il))*deltap/(P0(il)+Plcl(il))
    293309        CINB(il) = min(0.,dcin)
    294 cc        print *,'buoyz(il),buoylcl(il),deltap,p0(il),plcl(il),dcin ',
    295 cc     $           buoyz(il),buoylcl(il),deltap,p0(il),plcl(il),dcin
    296       ENDIF
    297       ENDDO
    298 c        print*, 'CINB ',CINB(1),'DCIN ',DCIN,I,BUOYz(1),BUOYlcl(1)
     310      ENDIF
     311      ENDDO
    299312c
    300313      DO il = 1,ncum
    … …  
    316329      ENDDO
    317330c
    318       IF (lswitch(1)) THEN
    319 c        print*,'ilow= ',ilow(1),'DCIN0 ',DCIN,P0(1),P(1,ilow(1))
    320 c        print*,'buoy',(BUOY(1,k),k=1,itop(1))
    321       ENDIF
    322331c
    323332C  Middle part of CINB : integral from P(ilow) to P(isublcl)
    … …  
    332341        ENDIF
    333342        ENDDO
    334 c      print*, 'CINB ', CINB(1), 'DCIN',DCIN,k,BUOY(1,k),BUOY(1,k+1)
    335343      ENDDO
    336344c
    … …  
    345353      ENDDO
    346354C
    347 c        print*, ' CINB ', CINB(1), 'Dcin ',dcin
    348355c
    349356cc      ENDIF
    … …  
    439446      ENDDO
    440447cc      ENDIF
    441 c       Print *,' Plcl,P(itop-1),P(itop),PLFC,BUOYlcl'
    442 c     $      ,Plcl(1),P(1,itop(1)-1),P(1,itop(1)),PLFC(1),BUOYlcl(1)
    443 C
    444 c        print*, 'CIN above', CINA(1), 'CIN below',CINB(1)
    445448c
    446449

  • LMDZ4/trunk/libf/phylmd/cv3_inip.F

    r987 r1146  
    8989              aire=aire+(Qmix(ff+df) - Qmix(ff)) * (1.-ff)
    9090              mu = mu + pdf * ff * df
    91               write(*,*) pdf,  Qmix(ff), aire, ff
     91         IF(prt_level>9)WRITE(lunout,*)                                 &
     92     &               pdf,  Qmix(ff), aire, ff
    9293         ff=ff+df
    9394         enddo

  • LMDZ4/trunk/libf/phylmd/cv3_routines.F

    r1044 r1146  
    11!
    2 ! $Header$
     2! $Header: /home/cvsroot/LMDZ4/libf/phylmd/cv3_routines.F,v 1.16 2008-11-06 16:29:35 lmdzadmin Exp $
    33!
    44c
    … …  
    120120
    121121c ori      do 110 k=1,nlp
    122       do 110 k=1,nl ! convect3
     122! abderr     do 110 k=1,nl ! convect3
     123       do 110 k=1,nlp
     124     
    123125        do 100 i=1,len
    124126cdebug          lv(i,k)= lv0-clmcpv*(t(i,k)-t0)
    … …  
    22562258      SUBROUTINE cv3_yield(nloc,ncum,nd,na,ntra
    22572259     :                    ,icb,inb,delt
    2258      :                    ,t,rr,t_wake,rr_wake,u,v,tra
     2260     :                    ,t,rr,t_wake,rr_wake,s_wake,u,v,tra
    22592261     :                    ,gz,p,ph,h,hp,lv,cpn,th,th_wake
    22602262     :                    ,ep,clw,m,tp,mp,rp,up,vp,trap
    … …  
    22832285      real t(nloc,nd), rr(nloc,nd), u(nloc,nd), v(nloc,nd)
    22842286      real t_wake(nloc,nd), rr_wake(nloc,nd)
     2287      real s_wake(nloc)
    22852288      real tra(nloc,nd,ntra), sig(nloc,nd)
    22862289      real gz(nloc,na), ph(nloc,nd+1), h(nloc,na), hp(nloc,na)
    … …  
    23272330      real esum(nloc), fsum(nloc), gsum(nloc), hsum(nloc)
    23282331      real th_wake(nloc,nd)
     2332      real alpha_qpos(nloc)
    23292333      real qcond(nloc,nd), nqcond(nloc,nd), wa(nloc,nd)  ! cld
    23302334      real siga(nloc,nd), sax(nloc,nd), mac(nloc,nd)      ! cld
    … …  
    29612965c   ***          integrated enthalpy and water tendencies         ***
    29622966c
     2967c Correction bug le 18-03-09
    29632968      do 503 il=1,ncum
    29642969      IF (iflag(il) .le. 1) THEN
    2965       ax=0.1*ment(il,inb(il),inb(il))*(hp(il,inb(il))-h(il,inb(il))
    2966      : +t(il,inb(il))*(cpv-cpd)
     2970        if (cvflag_grav) then
     2971      ax=0.01*grav*ment(il,inb(il),inb(il))*(hp(il,inb(il))
     2972     : -h(il,inb(il))+t(il,inb(il))*(cpv-cpd)
    29672973     : *(rr(il,inb(il))-qent(il,inb(il),inb(il))))
    29682974     :  /(cpn(il,inb(il))*(ph(il,inb(il))-ph(il,inb(il)+1)))
    … …  
    29722978     :    *(ph(il,inb(il)-1)-ph(il,inb(il))))
    29732979
     2980      bx=0.01*grav*ment(il,inb(il),inb(il))*(qent(il,inb(il),inb(il))
     2981     :    -rr(il,inb(il)))/(ph(il,inb(il))-ph(il,inb(il)+1))
     2982      fr(il,inb(il))=fr(il,inb(il))-bx
     2983      fr(il,inb(il)-1)=fr(il,inb(il)-1)
     2984     :   +bx*(ph(il,inb(il))-ph(il,inb(il)+1))
     2985     :      /(ph(il,inb(il)-1)-ph(il,inb(il)))
     2986
     2987      cx=0.01*grav*ment(il,inb(il),inb(il))*(uent(il,inb(il),inb(il))
     2988     :       -u(il,inb(il)))/(ph(il,inb(il))-ph(il,inb(il)+1))
     2989      fu(il,inb(il))=fu(il,inb(il))-cx
     2990      fu(il,inb(il)-1)=fu(il,inb(il)-1)
     2991     :     +cx*(ph(il,inb(il))-ph(il,inb(il)+1))
     2992     :        /(ph(il,inb(il)-1)-ph(il,inb(il)))
     2993
     2994      dx=0.01*grav*ment(il,inb(il),inb(il))*(vent(il,inb(il),inb(il))
     2995     :      -v(il,inb(il)))/(ph(il,inb(il))-ph(il,inb(il)+1))
     2996      fv(il,inb(il))=fv(il,inb(il))-dx
     2997      fv(il,inb(il)-1)=fv(il,inb(il)-1)
     2998     :    +dx*(ph(il,inb(il))-ph(il,inb(il)+1))
     2999     :       /(ph(il,inb(il)-1)-ph(il,inb(il)))
     3000       else
     3001       ax=0.1*ment(il,inb(il),inb(il))*(hp(il,inb(il))
     3002     : -h(il,inb(il))+t(il,inb(il))*(cpv-cpd)
     3003     : *(rr(il,inb(il))-qent(il,inb(il),inb(il))))
     3004     :  /(cpn(il,inb(il))*(ph(il,inb(il))-ph(il,inb(il)+1)))
     3005      ft(il,inb(il))=ft(il,inb(il))-ax
     3006      ft(il,inb(il)-1)=ft(il,inb(il)-1)+ax*cpn(il,inb(il))
     3007     :    *(ph(il,inb(il))-ph(il,inb(il)+1))/(cpn(il,inb(il)-1)
     3008     :    *(ph(il,inb(il)-1)-ph(il,inb(il))))
     3009
    29743010      bx=0.1*ment(il,inb(il),inb(il))*(qent(il,inb(il),inb(il))
    29753011     :    -rr(il,inb(il)))/(ph(il,inb(il))-ph(il,inb(il)+1))
    … …  
    29923028     :    +dx*(ph(il,inb(il))-ph(il,inb(il)+1))
    29933029     :       /(ph(il,inb(il)-1)-ph(il,inb(il)))
     3030       endif
    29943031      ENDIF    !iflag
    29953032503   continue
    … …  
    30653102       enddo
    30663103      enddo
     3104
     3105c
     3106c   ***   Check that moisture stays positive. If not, scale tendencies
     3107c        in order to ensure moisture positivity
     3108      DO il = 1,ncum
     3109       IF (iflag(il) .le. 1) THEN
     3110        alpha_qpos(il) = max(1. , -delt*fr(il,1)/
     3111     :     (s_wake(il)*rr_wake(il,1)+(1.-s_wake(il))*rr(il,1)))
     3112       ENDIF
     3113      ENDDO
     3114      DO i = 2,nl
     3115       DO il = 1,ncum
     3116        IF (iflag(il) .le. 1) THEN
     3117        alpha_qpos(il) = max(alpha_qpos(il) , -delt*fr(il,i)/
     3118     :     (s_wake(il)*rr_wake(il,i)+(1.-s_wake(il))*rr(il,i)))
     3119        ENDIF
     3120       ENDDO
     3121      ENDDO
     3122      DO il = 1,ncum
     3123       IF (iflag(il) .le. 1 .and. alpha_qpos(il) .gt. 1.001) THEN
     3124        alpha_qpos(il) = alpha_qpos(il)*1.1
     3125       ENDIF
     3126      ENDDO
     3127      DO il = 1,ncum
     3128       IF (iflag(il) .le. 1) THEN
     3129        sigd(il) = sigd(il)/alpha_qpos(il)
     3130        precip(il) = precip(il)/alpha_qpos(il)
     3131       ENDIF
     3132      ENDDO
     3133      DO i = 1,nl
     3134       DO il = 1,ncum
     3135        IF (iflag(il) .le. 1) THEN
     3136         fr(il,i) = fr(il,i)/alpha_qpos(il)
     3137         ft(il,i) = ft(il,i)/alpha_qpos(il)
     3138         fqd(il,i) = fqd(il,i)/alpha_qpos(il)
     3139         ftd(il,i) = ftd(il,i)/alpha_qpos(il)
     3140         fu(il,i) = fu(il,i)/alpha_qpos(il)
     3141         fv(il,i) = fv(il,i)/alpha_qpos(il)
     3142         m(il,i) = m(il,i)/alpha_qpos(il)
     3143         mp(il,i) = mp(il,i)/alpha_qpos(il)
     3144         Vprecip(il,i) = Vprecip(il,i)/alpha_qpos(il)
     3145        ENDIF
     3146       ENDDO
     3147      ENDDO
     3148      DO i = 1,nl
     3149      DO j = 1,nl
     3150       DO il = 1,ncum
     3151        IF (iflag(il) .le. 1) THEN
     3152         ment(il,i,j) = ment(il,i,j)/alpha_qpos(il)
     3153        ENDIF
     3154       ENDDO
     3155      ENDDO
     3156      ENDDO
     3157      DO j = 1,ntra
     3158      DO i = 1,nl
     3159       DO il = 1,ncum
     3160        IF (iflag(il) .le. 1) THEN
     3161         ftra(il,i,j) = ftra(il,i,j)/alpha_qpos(il)
     3162        ENDIF
     3163       ENDDO
     3164      ENDDO
     3165      ENDDO
     3166
    30673167c
    30683168c   ***           reset counter and return           ***

  • LMDZ4/trunk/libf/phylmd/cv3a_compress.F

    r972 r1146  
    33     :    ,plcl1,tnk1,qnk1,gznk1,hnk1,unk1,vnk1
    44     :    ,wghti1,pbase1,buoybase1
    5      :    ,t1,q1,qs1,t1_wake,q1_wake,qs1_wake,u1,v1,gz1,th1,th1_wake
     5     :    ,t1,q1,qs1,t1_wake,q1_wake,qs1_wake,s1_wake
     6     :    ,u1,v1,gz1,th1,th1_wake
    67     :    ,tra1
    78     :    ,h1     ,lv1     ,cpn1   ,p1,ph1,tv1    ,tp1,tvp1,clw1
    … …  
    1213     o    ,plcl,tnk,qnk,gznk,hnk,unk,vnk
    1314     o    ,wghti,pbase,buoybase
    14      o    ,t,q,qs,t_wake,q_wake,qs_wake,u,v,gz,th,th_wake
     15     o    ,t,q,qs,t_wake,q_wake,qs_wake,s_wake
     16     o    ,u,v,gz,th,th_wake
    1517     o    ,tra
    1618     o    ,h     ,lv     ,cpn    ,p,ph,tv    ,tp,tvp,clw
    … …  
    3941      real t1(len,nd),q1(len,nd),qs1(len,nd)
    4042      real t1_wake(len,nd),q1_wake(len,nd),qs1_wake(len,nd)
     43      real s1_wake(len)
    4144      real u1(len,nd),v1(len,nd)
    4245      real gz1(len,nd),th1(len,nd),th1_wake(len,nd)
    … …  
    5861      real t(len,nd),q(len,nd),qs(len,nd)
    5962      real t_wake(len,nd),q_wake(len,nd),qs_wake(len,nd)
     63      real s_wake(len)
    6064      real u(len,nd),v(len,nd)
    6165      real gz(len,nd),th(len,nd),th_wake(len,nd)
    … …  
    131135      if(iflag1(i).eq.0)then
    132136      nn=nn+1
     137      s_wake(nn)=s1_wake(i)
    133138      iflag(nn)=iflag1(i)
    134139      nk(nn)=nk1(i)

  • LMDZ4/trunk/libf/phylmd/cva_driver.F

    r1062 r1146  
    22     &                   iflag_con,iflag_mix,
    33     &                   iflag_clos,delt,
    4      &                   t1,q1,qs1,t1_wake,q1_wake,qs1_wake,
     4     &                   t1,q1,qs1,t1_wake,q1_wake,qs1_wake,s1_wake,
    55     &                   u1,v1,tra1,
    66     &                   p1,ph1,
    … …  
    5050C      q1_wake       Real           Input        specific hum(unsat draught envt)
    5151C      qs1_wake      Real           Input        sat specific hum(unsat draughts envt)
     52C      s1_wake       Real           Input        fractionnal area covered by wakes
    5253C      u1            Real           Input        u-wind
    5354C      v1            Real           Input        v-wind
    … …  
    121122      real q1_wake(len,nd)
    122123      real qs1_wake(len,nd)
     124      real s1_wake(len)
    123125      real u1(len,nd)
    124126      real v1(len,nd)
    … …  
    198200!       Must be defined at same grid levels as T.
    199201!
     202!s_wake: Array of fractionnal area occupied by the wakes.
     203!
    200204!  u:   Array of zonal wind velocity (m/s) of dimension ND, witth first
    201205!       index corresponding with the lowest model level. Defined at
    … …  
    358362      real t(nloc,klev),q(nloc,klev),qs(nloc,klev)
    359363      real t_wake(nloc,klev),q_wake(nloc,klev),qs_wake(nloc,klev)
     364      real s_wake(nloc)
    360365      real u(nloc,klev),v(nloc,klev)
    361366      real gz(nloc,klev),h(nloc,klev)     ,hm(nloc,klev)
    … …  
    531536        print*,'Emanuel version 3 nouvelle'
    532537       endif
    533 
     538!       print*,'t1, q1 ',t1,q1
    534539       CALL cv3_prelim(len,nd,ndp1,t1,q1,p1,ph1      ! nd->na
    535540     o               ,lv1,cpn1,tv1,gz1,h1,hm1,th1)
    … …  
    668673
    669674      if (iflag_con.eq.3) then
    670      
     675!       print*,'ncum tv1 ',ncum,tv1
     676!       print*,'tvp1 ',tvp1
    671677       CALL cv3a_compress( len,nloc,ncum,nd,ntra
    672678     :    ,iflag1,nk1,icb1,icbs1
    673679     :    ,plcl1,tnk1,qnk1,gznk1,hnk1,unk1,vnk1
    674680     :    ,wghti1,pbase1,buoybase1
    675      :    ,t1,q1,qs1,t1_wake,q1_wake,qs1_wake,u1,v1,gz1,th1,th1_wake
     681     :    ,t1,q1,qs1,t1_wake,q1_wake,qs1_wake,s1_wake
     682     :    ,u1,v1,gz1,th1,th1_wake
    676683     :    ,tra1
    677684     :    ,h1     ,lv1     ,cpn1   ,p1,ph1,tv1    ,tp1,tvp1,clw1
    … …  
    682689     o    ,plcl,tnk,qnk,gznk,hnk,unk,vnk
    683690     o    ,wghti,pbase,buoybase
    684      o    ,t,q,qs,t_wake,q_wake,qs_wake,u,v,gz,th,th_wake
     691     o    ,t,q,qs,t_wake,q_wake,qs_wake,s_wake
     692     o    ,u,v,gz,th,th_wake
    685693     o    ,tra
    686694     o    ,h     ,lv     ,cpn    ,p,ph,tv    ,tp,tvp,clw
    … …  
    688696     o    ,sig,w0,ptop2
    689697     o    ,Ale,Alp  )
     698
     699!       print*,'tv ',tv
     700!       print*,'tvp ',tvp
    690701
    691702      endif
    … …  
    856867       CALL cv3_yield(nloc,ncum,nd,nd,ntra            ! na->nd
    857868     :                     ,icb,inb,delt
    858      :                     ,t,q,t_wake,q_wake,u,v,tra
     869     :                     ,t,q,t_wake,q_wake,s_wake,u,v,tra
    859870     :                     ,gz,p,ph,h,hp,lv,cpn,th,th_wake
    860871     :                     ,ep,clw,m,tp,mp,qp,up,vp,trap

  • LMDZ4/trunk/libf/phylmd/dimphy.F90

    r776 r1146  
    55  INTEGER,SAVE :: kfdia
    66  INTEGER,SAVE :: kidia
    7   INTEGER,SAVE :: nbtr
    87  INTEGER,SAVE :: klev
    98  INTEGER,SAVE :: klevp1
    … …  
    1716CONTAINS
    1817 
    19   SUBROUTINE Init_dimphy(klon0,klev0,nbtr0)
     18  SUBROUTINE Init_dimphy(klon0,klev0)
    2019  IMPLICIT NONE
    2120 
    2221    INTEGER, INTENT(in) :: klon0
    2322    INTEGER, INTENT(in) :: klev0
    24     INTEGER, INTENT(in) :: nbtr0
    2523   
    2624    klon=klon0
    … …  
    3129!$OMP MASTER
    3230    klev=klev0
    33     nbtr=nbtr0
    3431    klevp1=klev+1
    3532    klevm1=klev-1

  • LMDZ4/trunk/libf/phylmd/fisrtilp.F

    r883 r1146  
    231231C surface.
    232232C
    233       DO i = 1, klon
     233      IF(k.LE.klevm1) THEN         
     234         DO i = 1, klon
    234235cIM
    235        IF(k.LE.klevm1) THEN         
    236         zmair=(paprs(i,k)-paprs(i,k+1))/RG
    237         zcpair=RCPD*(1.0+RVTMP2*zq(i))
    238         zcpeau=RCPD*RVTMP2
    239         zt(i) = ( (t(i,k+1)+d_t(i,k+1))*zrfl(i)*dtime*zcpeau
    240      $      + zmair*zcpair*zt(i) )
    241      $      / (zmair*zcpair + zrfl(i)*dtime*zcpeau)
    242 CC        WRITE (6,*) 'cppluie ', zt(i)-(t(i,k+1)+d_t(i,k+1))
    243        ENDIF
    244       ENDDO
     236            zmair=(paprs(i,k)-paprs(i,k+1))/RG
     237            zcpair=RCPD*(1.0+RVTMP2*zq(i))
     238            zcpeau=RCPD*RVTMP2
     239            zt(i) = ( (t(i,k+1)+d_t(i,k+1))*zrfl(i)*dtime*zcpeau
     240     $           + zmair*zcpair*zt(i) )
     241     $           / (zmair*zcpair + zrfl(i)*dtime*zcpeau)
     242C     C        WRITE (6,*) 'cppluie ', zt(i)-(t(i,k+1)+d_t(i,k+1))
     243         ENDDO
     244      ENDIF
    245245c
    246246c
    … …  
    372372        endif ! iflag_pdf
    373373
    374          do i=1,klon
    375             IF (rneb(i,k) .LE. 0.0) zqn(i) = 0.0
    376             IF (rneb(i,k) .GE. 1.0) zqn(i) = zq(i)
    377             rneb(i,k) = MAX(0.0,MIN(1.0,rneb(i,k)))
    378 c           zcond(i) = MAX(0.0,zqn(i)-zqs(i))*rneb(i,k)/(1.+zdqs(i))
    379 c  On ne divise pas par 1+zdqs pour forcer a avoir l'eau predite par
    380 c  la convection.
    381 c  ATTENTION !!! Il va falloir verifier tout ca.
    382             zcond(i) = MAX(0.0,zqn(i)-zqs(i))*rneb(i,k)
    383 c           print*,'ZDQS ',zdqs(i)
    384 c--Olivier
    385             rhcl(i,k)=(zqs(i)+zq(i)-zdelq)/2./zqs(i)
    386             IF (rneb(i,k) .LE. 0.0) rhcl(i,k)=zq(i)/zqs(i)
    387             IF (rneb(i,k) .GE. 1.0) rhcl(i,k)=1.0
    388 c--fin
    389            ENDDO
     374        DO i=1,klon
     375           IF (rneb(i,k) .LE. 0.0) THEN
     376              zqn(i) = 0.0
     377              rneb(i,k) = 0.0
     378              zcond(i) = 0.0
     379              rhcl(i,k)=zq(i)/zqs(i)
     380           ELSE IF (rneb(i,k) .GE. 1.0) THEN
     381              zqn(i) = zq(i)
     382              rneb(i,k) = 1.0                 
     383              zcond(i) = MAX(0.0,zqn(i)-zqs(i))
     384              rhcl(i,k)=1.0
     385           ELSE
     386              zcond(i) = MAX(0.0,zqn(i)-zqs(i))*rneb(i,k)
     387              rhcl(i,k)=(zqs(i)+zq(i)-zdelq)/2./zqs(i)
     388           ENDIF
     389        ENDDO
     390!         do i=1,klon
     391!            IF (rneb(i,k) .LE. 0.0) zqn(i) = 0.0
     392!            IF (rneb(i,k) .GE. 1.0) zqn(i) = zq(i)
     393!            rneb(i,k) = MAX(0.0,MIN(1.0,rneb(i,k)))
     394!c           zcond(i) = MAX(0.0,zqn(i)-zqs(i))*rneb(i,k)/(1.+zdqs(i))
     395!c  On ne divise pas par 1+zdqs pour forcer a avoir l'eau predite par
     396!c  la convection.
     397!c  ATTENTION !!! Il va falloir verifier tout ca.
     398!            zcond(i) = MAX(0.0,zqn(i)-zqs(i))*rneb(i,k)
     399!c           print*,'ZDQS ',zdqs(i)
     400!c--Olivier
     401!            rhcl(i,k)=(zqs(i)+zq(i)-zdelq)/2./zqs(i)
     402!            IF (rneb(i,k) .LE. 0.0) rhcl(i,k)=zq(i)/zqs(i)
     403!            IF (rneb(i,k) .GE. 1.0) rhcl(i,k)=1.0
     404!c--fin
     405!           ENDDO
    390406      ELSE
    391407         DO i = 1, klon

  • LMDZ4/trunk/libf/phylmd/geo2atm.F90

    r1072 r1146  
    55  USE dimphy
    66  USE mod_phys_lmdz_para
    7    
     7
    88  IMPLICIT NONE
    9   include 'dimensions.h'
     9  INCLUDE 'dimensions.h'
     10  INCLUDE 'YOMCST.h'
    1011
    11 ! Change wind corrdinates from cartesian geocentric to local spherical
     12! Change wind coordinates from cartesian geocentric to local spherical
    1213! NB! Fonctionne probablement uniquement en MPI seul (sans OpenMP)
    1314!
    … …  
    1718  REAL, DIMENSION (im,jm), INTENT(OUT) :: pu, pv, pr
    1819
    19   REAL, PARAMETER :: rpi = 3.141592653E0
    20   REAL, PARAMETER :: rad = rpi / 180.0E0
     20  REAL :: rad
     21
     22
     23  rad = rpi / 180.0E0
    2124 
    22   REAL, DIMENSION (im,jm) :: zsinlon, zcoslon
    23   REAL, DIMENSION (im,jm) :: zsinlat, zcoslat
     25  pu(:,:) = &
     26       - px(:,:) * SIN(rad * plon(:,:)) &
     27       + py(:,:) * COS(rad * plon(:,:))
    2428
    25   zsinlon = SIN (rad * plon)
    26   zcoslon = COS (rad * plon)
    27   zsinlat = SIN (rad * plat)
    28   zcoslat = COS (rad * plat)
     29  pv(:,:) = &
     30       - px(:,:) * SIN(rad * plat(:,:)) * COS(rad * plon(:,:)) &
     31       - py(:,:) * SIN(rad * plat(:,:)) * SIN(rad * plon(:,:)) &
     32       + pz(:,:) * COS(rad * plat(:,:)) 
    2933
    30   pu = - px * zsinlon         + py * zcoslon
    31   pv = - px * zsinlat*zcoslon - py * zsinlat*zsinlon + pz * zcoslat 
    32   pr =   px * zcoslat*zcoslon + py * zcoslat*zsinlon + pz * zsinlat
     34  pr(:,:) = &
     35       + px(:,:) * COS(rad * plat(:,:)) * COS(rad * plon(:,:)) &
     36       + py(:,:) * COS(rad * plat(:,:)) * SIN(rad * plon(:,:)) &
     37       + pz(:,:) * SIN(rad * plat(:,:))
    3338
    34 ! Value at North Pole
     39  ! Value at North Pole
    3540  IF (is_north_pole) THEN
    36      pu(:,1) = - py(1,1)
    37      pv(:,1) = - px(1,1)
    38      pr(:,1) = 0.
     41     pu(:, 1) = pu(1, 1)
     42     pv(:, 1) = pv(1, 1)
     43     pr(:, 1) = pr(1, 1)
    3944  ENDIF
    40 
    41 ! Value at South Pole     
     45 
     46  ! Value at South Pole     
    4247  IF (is_south_pole) THEN
    43      pu(:,jm) = py(1,jm)
    44      pv(:,jm) = px(1,jm)
    45      pr(:,jm) = 0.
     48     pu(:,jm) = pu(1,jm)
     49     pv(:,jm) = pv(1,jm)
     50     pr(:,jm) = pr(1,jm)
    4651  ENDIF
    47  
     52  
    4853END SUBROUTINE geo2atm

  • LMDZ4/trunk/libf/phylmd/hgardfou.F

    r987 r1146  
    1 !
    2 ! $Header$
    31!
    42      SUBROUTINE hgardfou (t,tsol,text)
    … …  
    5351           ok = .FALSE.
    5452           DO i = 1, jbad
    55             PRINT *,'i,k,temperature rlon rlat=',jadrs(i),k,zt(jadrs(i))
    56      $      ,rlon(jadrs(i)),rlat(jadrs(i))
     53             PRINT *,'i,k,temperature,lon,lat,pourc ter,oce,lic,sic =',
     54     $       jadrs(i),k,zt(jadrs(i)),rlon(jadrs(i)),rlat(jadrs(i)),
     55     $       (pctsrf(jadrs(i),nsrf),nsrf=1,nbsrf)
    5756           ENDDO
    5857         ENDIF
    … …  
    7271           ok = .FALSE.
    7372           DO i = 1, jbad
    74             PRINT *,'i,k,temperature rlon rlat=',jadrs(i),k,zt(jadrs(i))
    75      $      ,rlon(jadrs(i)),rlat(jadrs(i))
     73             PRINT *,'i,k,temperature,lon,lat,pourc ter,oce,lic,sic =',
     74     $       jadrs(i),k,zt(jadrs(i)),rlon(jadrs(i)),rlat(jadrs(i)),
     75     $       (pctsrf(jadrs(i),nsrf),nsrf=1,nbsrf)
    7676           ENDDO
    7777         ENDIF
    … …  
    9696           ok = .FALSE.
    9797           DO i = 1, jbad
    98              PRINT *,'i,nsrf,temperature =',jadrs(i),nsrf,zt(jadrs(i)),
    99      $       rlon(jadrs(i)),rlat(jadrs(i))
     98            PRINT *,'i,nsrf,temperature,lon,lat,pourc ter,oce,lic,sic ='
     99     $      ,jadrs(i),nsrf,zt(jadrs(i)),rlon(jadrs(i)),rlat(jadrs(i))
     100     $      ,pctsrf(jadrs(i),nsrf)
    100101           ENDDO
    101102         ENDIF
    … …  
    115116           ok = .FALSE.
    116117           DO i = 1, jbad
    117              PRINT *,'i,nsrf,temperature =',jadrs(i),nsrf,zt(jadrs(i)),
    118      $       rlon(jadrs(i)),rlat(jadrs(i))
     118            PRINT *,'i,nsrf,temperature,lon,lat,pourc ter,oce,lic,sic ='
     119     $      ,jadrs(i),nsrf,zt(jadrs(i)),rlon(jadrs(i)),rlat(jadrs(i))
     120     $      ,pctsrf(jadrs(i),nsrf)
    119121           ENDDO
    120122         ENDIF

  • LMDZ4/trunk/libf/phylmd/ini_histrac.h

    r1030 r1146  
    22! $Header$
    33!
    4       IF (config_inca == 'none') THEN
     4      IF (ecrit_tra>0. .AND. config_inca == 'none') THEN
    55c$OMP MASTER
    66         CALL ymds2ju(annee_ref, 1, day_ref, 0.0, zjulian)
    … …  
    2323     .                iim,jj_nb,nhori, 1,1,1, -99, 32,
    2424     .                "once",  zsto,zout)
    25          DO it=1,nqmax
     25         DO it=1,nbtr
    2626C champ 2D
    2727         iq=it+2
    2828         iiq=niadv(iq)
    29          CALL histdef(nid_tra, tnom(iq), ttext(iiq), "U/kga",
     29         CALL histdef(nid_tra, tname(iiq), ttext(iiq), "U/kga",
    3030     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
    3131     .                "ave(X)", zsto,zout)
    3232         if (lessivage) THEN
    33          CALL histdef(nid_tra, "fl"//tnom(iq),"Flux "//ttext(iiq),
     33         CALL histdef(nid_tra, "fl"//tname(iiq),"Flux "//ttext(iiq),
    3434     .              "U/m2/s",iim,jj_nb,nhori, klev,1,klev,nvert, 32,
    3535     .              "ave(X)", zsto,zout)
    … …  
    3737
    3838c---Ajout Olivia
    39          CALL histdef(nid_tra, "d_tr_th_"//tnom(iq),
     39         CALL histdef(nid_tra, "d_tr_th_"//tname(iiq),
    4040     .                "tendance thermique"// ttext(iiq), "?",
    4141     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
    … …  
    4343c
    4444         if(iflag_con.GE.2) then
    45          CALL histdef(nid_tra, "d_tr_cv_"//tnom(iq),
     45         CALL histdef(nid_tra, "d_tr_cv_"//tname(iiq),
    4646     .                "tendance convection"// ttext(iiq), "?",
    4747     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
    4848     .                "ave(X)", zsto,zout)
    4949             endif !(iflag_con.GE.2) then
    50          CALL histdef(nid_tra, "d_tr_cl_"//tnom(iq),
     50         CALL histdef(nid_tra, "d_tr_cl_"//tname(iiq),
    5151     .                "tendance couche limite"// ttext(iiq), "?",
    5252     .                iim,jj_nb,nhori, klev,1,klev,nvert, 32,
    … …  
    121121         ndex = 0
    122122c$OMP END MASTER
    123       END IF
     123      END IF ! ecrit_tra>0. .AND. config_inca == 'none'

  • LMDZ4/trunk/libf/phylmd/init_phys_lmdz.F90

    r775 r1146  
    22!$Header$
    33!
    4 SUBROUTINE Init_Phys_lmdz(iim,jjp1,llm,nbtr,nb_proc,distrib)
     4SUBROUTINE Init_Phys_lmdz(iim,jjp1,llm,nb_proc,distrib)
    55  USE mod_phys_lmdz_para
    66  USE mod_grid_phy_lmdz
    … …  
    1111    INTEGER,INTENT(in) :: jjp1
    1212    INTEGER,INTENT(in) :: llm
    13     INTEGER,INTENT(in) :: nbtr
    1413    INTEGER,INTENT(in) :: nb_proc
    1514    INTEGER,INTENT(in) :: distrib(0:nb_proc-1)
    … …  
    1918    CALL Init_phys_lmdz_para(iim,jjp1,nb_proc,distrib)
    2019!$OMP PARALLEL
    21     CALL Init_dimphy(klon_omp,nbp_lev,nbtr)
     20    CALL Init_dimphy(klon_omp,nbp_lev)
    2221!$OMP END PARALLEL
    2322 

  • LMDZ4/trunk/libf/phylmd/initrrnpb.F

    r766 r1146  
    55     .                   ,vdeptr,scavtr)
    66      USE dimphy
     7      USE infotrac, ONLY : nbtr
    78      IMPLICIT none
    89c======================================================================

  • LMDZ4/trunk/libf/phylmd/isccp_cloud_types.F

    r776 r1146  
    530530!     Initialised frac_out to zero
    531531
    532       do ibox=1,ncol
    533         do ilev=1,nlev
     532      do ilev=1,nlev
     533        do ibox=1,ncol
    534534          do j=1,npoints
    535535            frac_out(j,ibox,ilev)=0.0
    … …  
    12191219          enddo
    12201220          do 29 ilev=1,nlev-1
    1221             !cdir nodep
     1221!cdir nodep
    12221222            do j=1,npoints
    12231223              if ((at(j,ilev)   .ge. tb(j,ibox) .and.

  • LMDZ4/trunk/libf/phylmd/newmicro.F

    r766 r1146  
    110110      REAL zclear(klon)
    111111      REAL zcloud(klon)
     112
     113c **************************
     114c *                        *
     115c * DEBUT PARTIE OPTIMISEE *
     116c *                        *
     117c **************************
     118
     119      REAL diff_paprs(klon, klev), zfice1, zfice2(klon, klev)
     120      REAL rad_chaud_tab(klon, klev), zflwp_var, zfiwp_var
     121
    112122c
    113123c Calculer l'epaisseur optique et l'emmissivite des nuages
    114124c
    115 cIM inversion des DO
    116       DO i = 1, klon
    117        xflwp(i)=0.
    118        xfiwp(i)=0.
    119 cccccccccccc!CDIR NOVECTOR
     125c     IM inversion des DO
     126      xflwp = 0.d0
     127      xfiwp = 0.d0
     128      xflwc = 0.d0
     129      xfiwc = 0.d0
     130
    120131      DO k = 1, klev
    121 c
    122        xflwc(i,k)=0.
    123        xfiwc(i,k)=0.
    124 c
    125          rad_chaud = rad_chau1
    126          IF (k.LE.3) rad_chaud = rad_chau2
    127          pclc(i,k) = MAX(pclc(i,k), seuil_neb)
    128          zflwp(i) = 1000.*pqlwp(i,k)/RG/pclc(i,k)
    129      .          *(paprs(i,k)-paprs(i,k+1))
    130          zfice = 1.0 - (t(i,k)-t_glace) / (273.13-t_glace)
    131          zfice = MIN(MAX(zfice,0.0),1.0)
    132          zfice = zfice**nexpo
    133          radius = rad_chaud * (1.-zfice) + rad_froid * zfice
    134          coef = coef_chau * (1.-zfice) + coef_froi * zfice
    135          pcltau(i,k) = 3.0/2.0 * zflwp(i) / radius
    136          pclemi(i,k) = 1.0 - EXP( - coef * zflwp(i))
    137 
    138          if (ok_newmicro) then
    139 
    140 c -- liquid/ice cloud water paths:
    141 
    142          zfice = 1.0 - (t(i,k)-t_glace) / (273.13-t_glace)
    143          zfice = MIN(MAX(zfice,0.0),1.0)
    144 
    145          zflwp(i) = 1000.*(1.-zfice)*pqlwp(i,k)/pclc(i,k)
    146      :          *(paprs(i,k)-paprs(i,k+1))/RG
    147          zfiwp(i) = 1000.*zfice*pqlwp(i,k)/pclc(i,k)
    148      :          *(paprs(i,k)-paprs(i,k+1))/RG
    149 
    150          xflwp(i) = xflwp(i)+ (1.-zfice)*pqlwp(i,k)
    151      :          *(paprs(i,k)-paprs(i,k+1))/RG
    152          xfiwp(i) = xfiwp(i)+ zfice*pqlwp(i,k)
    153      :          *(paprs(i,k)-paprs(i,k+1))/RG
    154 
    155 cIM Total Liquid/Ice water content
    156          xflwc(i,k) = xflwc(i,k)+(1.-zfice)*pqlwp(i,k)
    157          xfiwc(i,k) = xfiwc(i,k)+zfice*pqlwp(i,k)
    158 cIM In-Cloud Liquid/Ice water content
    159 c        xflwc(i,k) = xflwc(i,k)+(1.-zfice)*pqlwp(i,k)/pclc(i,k)
    160 c        xfiwc(i,k) = xfiwc(i,k)+zfice*pqlwp(i,k)/pclc(i,k)
    161 
    162 c -- effective cloud droplet radius (microns):
    163 
    164 c for liquid water clouds:
     132         DO i = 1, klon
     133            diff_paprs(i,k) = (paprs(i,k)-paprs(i,k+1))/RG
     134         ENDDO
     135      ENDDO
     136
     137      IF (ok_newmicro) THEN
     138
     139
     140         DO k = 1, klev
     141            DO i = 1, klon
     142               zfice2(i,k) = 1.0 - (t(i,k)-t_glace) / (273.13-t_glace)
     143               zfice2(i,k) = MIN(MAX(zfice2(i,k),0.0),1.0)
     144c     IM Total Liquid/Ice water content                                   
     145               xflwc(i,k) = (1.-zfice2(i,k))*pqlwp(i,k)
     146               xfiwc(i,k) = zfice2(i,k)*pqlwp(i,k)
     147c     IM In-Cloud Liquid/Ice water content
     148c     xflwc(i,k) = xflwc(i,k)+(1.-zfice)*pqlwp(i,k)/pclc(i,k)
     149c     xfiwc(i,k) = xfiwc(i,k)+zfice*pqlwp(i,k)/pclc(i,k)
     150            ENDDO
     151         ENDDO
     152
    165153         IF (ok_aie) THEN
    166             ! Formula "D" of Boucher and Lohmann, Tellus, 1995
    167             !             
    168             cdnc(i,k) = 10.**(bl95_b0+bl95_b1*
    169      .           log(MAX(sulfate(i,k),1.e-4))/log(10.))*1.e6 !-m-3
    170             ! Cloud droplet number concentration (CDNC) is restricted
    171             ! to be within [20, 1000 cm^3]
    172             !
    173             cdnc(i,k)=MIN(1000.e6,MAX(20.e6,cdnc(i,k)))
    174             !
    175             !
    176             cdnc_pi(i,k) = 10.**(bl95_b0+bl95_b1*
    177      .           log(MAX(sulfate_pi(i,k),1.e-4))/log(10.))*1.e6 !-m-3
    178             cdnc_pi(i,k)=MIN(1000.e6,MAX(20.e6,cdnc_pi(i,k)))
    179             !           
    180             !
    181             ! air density: pplay(i,k) / (RD * zT(i,k))
    182             ! factor 1.1: derive effective radius from volume-mean radius
    183             ! factor 1000 is the water density
    184             ! _chaud means that this is the CDR for liquid water clouds
    185             !
    186             rad_chaud =
    187      .           1.1 * ( (pqlwp(i,k) * pplay(i,k) / (RD * T(i,k)) ) 
    188      .               / (4./3. * RPI * 1000. * cdnc(i,k)) )**(1./3.)
    189             !
    190             ! Convert to um. CDR shall be at least 3 um.
    191             !
    192 c           rad_chaud = MAX(rad_chaud*1.e6, 3.)
    193             rad_chaud = MAX(rad_chaud*1.e6, 5.)
    194            
    195             ! Pre-industrial cloud opt thickness
    196             !
    197             ! "radius" is calculated as rad_chaud above (plus the
    198             ! ice cloud contribution) but using cdnc_pi instead of
    199             ! cdnc.
    200             radius =
    201      .           1.1 * ( (pqlwp(i,k) * pplay(i,k) / (RD * T(i,k)) ) 
    202      .               / (4./3. * RPI * 1000. * cdnc_pi(i,k)) )**(1./3.)
    203             radius = MAX(radius*1.e6, 5.)
    204            
    205             tc = t(i,k)-273.15
    206             rei = 0.71*tc + 61.29
    207             if (tc.le.-81.4) rei = 3.5
    208             if (zflwp(i).eq.0.) radius = 1.
    209             if (zfiwp(i).eq.0. .or. rei.le.0.) rei = 1.
    210             cldtaupi(i,k) = 3.0/2.0 * zflwp(i) / radius
    211      .             + zfiwp(i) * (3.448e-03  + 2.431/rei)
    212          ENDIF                  ! ok_aie
    213          ! For output diagnostics
    214          !
    215          ! Cloud droplet effective radius [um]
    216          !
    217          ! we multiply here with f * xl (fraction of liquid water
    218          ! clouds in the grid cell) to avoid problems in the
    219          ! averaging of the output.
    220          ! In the output of IOIPSL, derive the real cloud droplet
    221          ! effective radius as re/fl
    222          !
    223          fl(i,k) = pclc(i,k)*(1.-zfice)           
    224          re(i,k) = rad_chaud*fl(i,k)
    225            
    226 c-jq end         
     154            DO k = 1, klev
     155               DO i = 1, klon
     156                                ! Formula "D" of Boucher and Lohmann, Tellus, 1995
     157                                !             
     158                  cdnc(i,k) = 10.**(bl95_b0+bl95_b1*
     159     &                 log(MAX(sulfate(i,k),1.e-4))/log(10.))*1.e6 !-m-3
     160                                ! Cloud droplet number concentration (CDNC) is restricted
     161                                ! to be within [20, 1000 cm^3]
     162                                !
     163                  cdnc(i,k)=MIN(1000.e6,MAX(20.e6,cdnc(i,k)))
     164                                !
     165                                !
     166                  cdnc_pi(i,k) = 10.**(bl95_b0+bl95_b1*
     167     &                 log(MAX(sulfate_pi(i,k),1.e-4))/log(10.))*1.e6 !-m-3
     168                  cdnc_pi(i,k)=MIN(1000.e6,MAX(20.e6,cdnc_pi(i,k)))
     169               ENDDO
     170            ENDDO
     171            DO k = 1, klev
     172               DO i = 1, klon
     173!                  rad_chaud_tab(i,k) =
     174!     &                 MAX(1.1e6
     175!     &                 *((pqlwp(i,k)*pplay(i,k)/(RD * T(i,k))) 
     176!     &                 /(4./3*RPI*1000.*cdnc(i,k)) )**(1./3.),5.)
     177                  rad_chaud_tab(i,k) =
     178     &                 1.1
     179     &                 *((pqlwp(i,k)*pplay(i,k)/(RD * T(i,k))) 
     180     &                 /(4./3*RPI*1000.*cdnc(i,k)) )**(1./3.)
     181                  rad_chaud_tab(i,k) = MAX(rad_chaud_tab(i,k) * 1e6, 5.)
     182               ENDDO           
     183            ENDDO
     184         ELSE
     185            DO k = 1, MIN(3,klev)
     186               DO i = 1, klon
     187                  rad_chaud_tab(i,k) = rad_chau2
     188               ENDDO           
     189            ENDDO
     190            DO k = MIN(3,klev)+1, klev
     191               DO i = 1, klon
     192                  rad_chaud_tab(i,k) = rad_chau1
     193               ENDDO           
     194            ENDDO
     195
     196         ENDIF
    227197         
    228          rel = rad_chaud
    229 c for ice clouds: as a function of the ambiant temperature
    230 c [formula used by Iacobellis and Somerville (2000), with an
    231 c asymptotical value of 3.5 microns at T<-81.4 C added to be
    232 c consistent with observations of Heymsfield et al. 1986]:
    233          tc = t(i,k)-273.15
    234          rei = 0.71*tc + 61.29
    235          if (tc.le.-81.4) rei = 3.5
    236 
    237 c -- cloud optical thickness :
    238 
    239 c [for liquid clouds, traditional formula,
    240 c  for ice clouds, Ebert & Curry (1992)]
    241 
    242          if (zflwp(i).eq.0.) rel = 1.
    243          if (zfiwp(i).eq.0. .or. rei.le.0.) rei = 1.
    244          pcltau(i,k) = 3.0/2.0 * ( zflwp(i)/rel )
    245      .             + zfiwp(i) * (3.448e-03  + 2.431/rei)
    246 
    247 c -- cloud infrared emissivity:
    248 
    249 c [the broadband infrared absorption coefficient is parameterized
    250 c  as a function of the effective cld droplet radius]
    251 
    252 c Ebert and Curry (1992) formula as used by Kiehl & Zender (1995):
    253          k_ice = k_ice0 + 1.0/rei
    254 
    255          pclemi(i,k) = 1.0
    256      .      - EXP( - coef_chau*zflwp(i) - DF*k_ice*zfiwp(i) )
    257 
    258          endif ! ok_newmicro
    259 
    260          lo = (pclc(i,k) .LE. seuil_neb)
    261          IF (lo) pclc(i,k) = 0.0
    262          IF (lo) pcltau(i,k) = 0.0
    263          IF (lo) pclemi(i,k) = 0.0
    264          
    265          IF (lo) cldtaupi(i,k) = 0.0
    266          IF (.NOT.ok_aie) cldtaupi(i,k)=pcltau(i,k)           
    267       ENDDO
    268       ENDDO
    269 ccc      DO k = 1, klev
    270 ccc      DO i = 1, klon
    271 ccc         t(i,k) = t(i,k)
    272 ccc         pclc(i,k) = MAX( 1.e-5 , pclc(i,k) )
    273 ccc         lo = pclc(i,k) .GT. (2.*1.e-5)
    274 ccc         zflwp = pqlwp(i,k)*1000.*(paprs(i,k)-paprs(i,k+1))
    275 ccc     .          /(rg*pclc(i,k))
    276 ccc         zradef = 10.0 + (1.-sigs(k))*45.0
    277 ccc         pcltau(i,k) = 1.5 * zflwp / zradef
    278 ccc         zfice=1.0-MIN(MAX((t(i,k)-263.)/(273.-263.),0.0),1.0)
    279 ccc         zmsac = 0.13*(1.0-zfice) + 0.08*zfice
    280 ccc         pclemi(i,k) = 1.-EXP(-zmsac*zflwp)
    281 ccc         if (.NOT.lo) pclc(i,k) = 0.0
    282 ccc         if (.NOT.lo) pcltau(i,k) = 0.0
    283 ccc         if (.NOT.lo) pclemi(i,k) = 0.0
    284 ccc      ENDDO
    285 ccc      ENDDO
    286 cccccc      print*, 'pas de nuage dans le rayonnement'
    287 cccccc      DO k = 1, klev
    288 cccccc      DO i = 1, klon
    289 cccccc         pclc(i,k) = 0.0
    290 cccccc         pcltau(i,k) = 0.0
    291 cccccc         pclemi(i,k) = 0.0
    292 cccccc      ENDDO
    293 cccccc      ENDDO
    294 C
    295 C COMPUTE CLOUD LIQUID PATH AND TOTAL CLOUDINESS
    296 C
    297 cIM cf. CR:test: calcul prenant ou non en compte le recouvrement
    298 cinitialisations
     198         DO k = 1, klev
     199!            IF(.not.ok_aie) THEN
     200            rad_chaud = rad_chau1
     201            IF (k.LE.3) rad_chaud = rad_chau2
     202!            ENDIF
     203            DO i = 1, klon
     204               IF (pclc(i,k) .LE. seuil_neb) THEN
     205               
     206c     -- effective cloud droplet radius (microns):
     207               
     208c     for liquid water clouds:
     209                                ! For output diagnostics
     210                                !
     211                                ! Cloud droplet effective radius [um]
     212                                !
     213                                ! we multiply here with f * xl (fraction of liquid water
     214                                ! clouds in the grid cell) to avoid problems in the
     215                                ! averaging of the output.
     216                                ! In the output of IOIPSL, derive the real cloud droplet
     217                                ! effective radius as re/fl
     218                                !
     219                                   
     220                  fl(i,k) = seuil_neb*(1.-zfice2(i,k))           
     221                  re(i,k) = rad_chaud_tab(i,k)*fl(i,k)
     222                 
     223                  pclc(i,k) = 0.0
     224                  pcltau(i,k) = 0.0
     225                  pclemi(i,k) = 0.0
     226                  cldtaupi(i,k) = 0.0                 
     227               ELSE
     228
     229c     -- liquid/ice cloud water paths:
     230                 
     231                  zflwp_var= 1000.*(1.-zfice2(i,k))*pqlwp(i,k)/pclc(i,k)
     232     &                 *diff_paprs(i,k)
     233                  zfiwp_var= 1000.*zfice2(i,k)*pqlwp(i,k)/pclc(i,k)
     234     &                 *diff_paprs(i,k)
     235                 
     236c     -- effective cloud droplet radius (microns):
     237               
     238c     for liquid water clouds:
     239                                   
     240                  IF (ok_aie) THEN
     241                     radius =
     242     &                    1.1
     243     &                    *((pqlwp(i,k)*pplay(i,k)/(RD * T(i,k))) 
     244     &                    /(4./3.*RPI*1000.*cdnc_pi(i,k)))**(1./3.)
     245                     radius = MAX(radius*1e6, 5.)
     246                 
     247                     tc = t(i,k)-273.15
     248                     rei = 0.71*tc + 61.29
     249                     if (tc.le.-81.4) rei = 3.5
     250                     if (zflwp_var.eq.0.) radius = 1.
     251                     if (zfiwp_var.eq.0. .or. rei.le.0.) rei = 1.
     252                     cldtaupi(i,k) = 3.0/2.0 * zflwp_var / radius
     253     &                    + zfiwp_var * (3.448e-03  + 2.431/rei)
     254                  ENDIF         ! ok_aie
     255                                ! For output diagnostics
     256                                !
     257                                ! Cloud droplet effective radius [um]
     258                                !
     259                                ! we multiply here with f * xl (fraction of liquid water
     260                                ! clouds in the grid cell) to avoid problems in the
     261                                ! averaging of the output.
     262                                ! In the output of IOIPSL, derive the real cloud droplet
     263                                ! effective radius as re/fl
     264                                !
     265 
     266                  fl(i,k) = pclc(i,k)*(1.-zfice2(i,k))           
     267                  re(i,k) = rad_chaud_tab(i,k)*fl(i,k)
     268                 
     269                  rel = rad_chaud_tab(i,k)
     270c     for ice clouds: as a function of the ambiant temperature
     271c     [formula used by Iacobellis and Somerville (2000), with an
     272c     asymptotical value of 3.5 microns at T<-81.4 C added to be
     273c     consistent with observations of Heymsfield et al. 1986]:
     274                  tc = t(i,k)-273.15
     275                  rei = 0.71*tc + 61.29
     276                  if (tc.le.-81.4) rei = 3.5
     277c     -- cloud optical thickness :
     278               
     279c     [for liquid clouds, traditional formula,
     280c     for ice clouds, Ebert & Curry (1992)]
     281                 
     282                  if (zflwp_var.eq.0.) rel = 1.
     283                  if (zfiwp_var.eq.0. .or. rei.le.0.) rei = 1.
     284                  pcltau(i,k) = 3.0/2.0 * ( zflwp_var/rel )
     285     &                 + zfiwp_var * (3.448e-03  + 2.431/rei)
     286c     -- cloud infrared emissivity:
     287               
     288c     [the broadband infrared absorption coefficient is parameterized
     289c     as a function of the effective cld droplet radius]
     290               
     291c     Ebert and Curry (1992) formula as used by Kiehl & Zender (1995):
     292                  k_ice = k_ice0 + 1.0/rei
     293                 
     294                  pclemi(i,k) = 1.0
     295     &                 - EXP( -coef_chau*zflwp_var - DF*k_ice*zfiwp_var)
     296
     297               ENDIF
     298               
     299            ENDDO
     300         ENDDO
     301
     302         DO k = 1, klev
     303            DO i = 1, klon
     304               xflwp(i) = xflwp(i)+ xflwc(i,k) * diff_paprs(i,k)
     305               xfiwp(i) = xfiwp(i)+ xfiwc(i,k) * diff_paprs(i,k)
     306            ENDDO
     307         ENDDO
     308
     309      ELSE
     310         DO k = 1, klev
     311            rad_chaud = rad_chau1
     312            IF (k.LE.3) rad_chaud = rad_chau2
     313            DO i = 1, klon
     314                             
     315               IF (pclc(i,k) .LE. seuil_neb) THEN
     316
     317                  pclc(i,k) = 0.0
     318                  pcltau(i,k) = 0.0
     319                  pclemi(i,k) = 0.0
     320                  cldtaupi(i,k) = 0.0
     321
     322               ELSE
     323
     324                  zflwp_var = 1000.*pqlwp(i,k)*diff_paprs(i,k)
     325     &                 /pclc(i,k)
     326                 
     327                  zfice1 = MIN(
     328     &                 MAX( 1.0 - (t(i,k)-t_glace) / (273.13-t_glace)
     329     &                 ,0.0),1.0)**nexpo
     330                 
     331                  radius = rad_chaud * (1.-zfice1) + rad_froid * zfice1
     332                  coef   = coef_chau * (1.-zfice1) + coef_froi * zfice1
     333
     334                  pcltau(i,k) = 3.0 * zflwp_var / (2.0 * radius)
     335                  pclemi(i,k) = 1.0 - EXP( - coef * zflwp_var)
     336
     337               ENDIF
     338                             
     339            ENDDO
     340         ENDDO
     341      ENDIF
     342     
     343      IF (.NOT.ok_aie) THEN
     344         DO k = 1, klev
     345            DO i = 1, klon
     346               cldtaupi(i,k)=pcltau(i,k)
     347            ENDDO
     348         ENDDO               
     349      ENDIF
     350
     351ccc   DO k = 1, klev
     352ccc   DO i = 1, klon
     353ccc   t(i,k) = t(i,k)
     354ccc   pclc(i,k) = MAX( 1.e-5 , pclc(i,k) )
     355ccc   lo = pclc(i,k) .GT. (2.*1.e-5)
     356ccc   zflwp = pqlwp(i,k)*1000.*(paprs(i,k)-paprs(i,k+1))
     357ccc   .          /(rg*pclc(i,k))
     358ccc   zradef = 10.0 + (1.-sigs(k))*45.0
     359ccc   pcltau(i,k) = 1.5 * zflwp / zradef
     360ccc   zfice=1.0-MIN(MAX((t(i,k)-263.)/(273.-263.),0.0),1.0)
     361ccc   zmsac = 0.13*(1.0-zfice) + 0.08*zfice
     362ccc   pclemi(i,k) = 1.-EXP(-zmsac*zflwp)
     363ccc   if (.NOT.lo) pclc(i,k) = 0.0
     364ccc   if (.NOT.lo) pcltau(i,k) = 0.0
     365ccc   if (.NOT.lo) pclemi(i,k) = 0.0
     366ccc   ENDDO
     367ccc   ENDDO
     368ccccc print*, 'pas de nuage dans le rayonnement'
     369ccccc DO k = 1, klev
     370ccccc DO i = 1, klon
     371ccccc pclc(i,k) = 0.0
     372ccccc pcltau(i,k) = 0.0
     373ccccc pclemi(i,k) = 0.0
     374ccccc ENDDO
     375ccccc ENDDO
     376C     
     377C     COMPUTE CLOUD LIQUID PATH AND TOTAL CLOUDINESS
     378C     
     379c     IM cf. CR:test: calcul prenant ou non en compte le recouvrement
     380c     initialisations
    299381      DO i=1,klon
    300382         zclear(i)=1.
    … …  
    308390cIM cf CR DO k=1,klev
    309391      DO k = klev, 1, -1
    310       DO i = 1, klon
    311          pctlwp(i) = pctlwp(i)
    312      .             + pqlwp(i,k)*(paprs(i,k)-paprs(i,k+1))/RG
    313 cIM cf. CR
    314             IF (NOVLP.EQ.1) THEN
     392         DO i = 1, klon
     393            pctlwp(i) = pctlwp(i)
     394     &           + pqlwp(i,k)*diff_paprs(i,k)
     395         ENDDO
     396      ENDDO
     397c     IM cf. CR
     398      IF (NOVLP.EQ.1) THEN
     399         DO k = klev, 1, -1
     400            DO i = 1, klon
    315401               zclear(i)=zclear(i)*(1.-MAX(pclc(i,k),zcloud(i)))
    316      s                            /(1.-MIN(zcloud(i),1.-ZEPSEC))
     402     &              /(1.-MIN(zcloud(i),1.-ZEPSEC))
    317403               pct(i)=1.-zclear(i)
    318                if (pplay(i,k).LE.cetahb*paprs(i,1)) then
     404               IF (pplay(i,k).LE.cetahb*paprs(i,1)) THEN
    319405                  pch(i) = pch(i)*(1.-MAX(pclc(i,k),zcloud(i)))
    320      s                            /(1.-MIN(zcloud(i),1.-ZEPSEC))
    321                else if (pplay(i,k).GT.cetahb*paprs(i,1) .AND.
    322      .                  pplay(i,k).LE.cetamb*paprs(i,1)) then
     406     &                 /(1.-MIN(zcloud(i),1.-ZEPSEC))
     407               ELSE IF (pplay(i,k).GT.cetahb*paprs(i,1) .AND.
     408     &                 pplay(i,k).LE.cetamb*paprs(i,1)) THEN
    323409                  pcm(i) = pcm(i)*(1.-MAX(pclc(i,k),zcloud(i)))
    324      s                            /(1.-MIN(zcloud(i),1.-ZEPSEC))
    325                else if (pplay(i,k).GT.cetamb*paprs(i,1)) then
     410     &                 /(1.-MIN(zcloud(i),1.-ZEPSEC))
     411               ELSE IF (pplay(i,k).GT.cetamb*paprs(i,1)) THEN
    326412                  pcl(i) = pcl(i)*(1.-MAX(pclc(i,k),zcloud(i)))
    327      s                            /(1.-MIN(zcloud(i),1.-ZEPSEC))
     413     &                 /(1.-MIN(zcloud(i),1.-ZEPSEC))
    328414               endif
    329415               zcloud(i)=pclc(i,k)
    330             ELSE IF (NOVLP.EQ.2) THEN
     416            ENDDO
     417         ENDDO
     418      ELSE IF (NOVLP.EQ.2) THEN
     419         DO k = klev, 1, -1
     420            DO i = 1, klon
    331421               zcloud(i)=MAX(pclc(i,k),zcloud(i))
    332422               pct(i)=zcloud(i)
    333                if (pplay(i,k).LE.cetahb*paprs(i,1)) then
     423               IF (pplay(i,k).LE.cetahb*paprs(i,1)) THEN
    334424                  pch(i) = MIN(pclc(i,k),pch(i))
    335                else if (pplay(i,k).GT.cetahb*paprs(i,1) .AND.
    336      .                  pplay(i,k).LE.cetamb*paprs(i,1)) then
     425               ELSE IF (pplay(i,k).GT.cetahb*paprs(i,1) .AND.
     426     &                 pplay(i,k).LE.cetamb*paprs(i,1)) THEN
    337427                  pcm(i) = MIN(pclc(i,k),pcm(i))
    338                else if (pplay(i,k).GT.cetamb*paprs(i,1)) then
     428               ELSE IF (pplay(i,k).GT.cetamb*paprs(i,1)) THEN
    339429                  pcl(i) = MIN(pclc(i,k),pcl(i))
    340430               endif
    341             ELSE IF (NOVLP.EQ.3) THEN
     431            ENDDO
     432         ENDDO
     433      ELSE IF (NOVLP.EQ.3) THEN
     434         DO k = klev, 1, -1
     435            DO i = 1, klon
    342436               zclear(i)=zclear(i)*(1.-pclc(i,k))
    343437               pct(i)=1-zclear(i)
    344                if (pplay(i,k).LE.cetahb*paprs(i,1)) then
    345                pch(i) = pch(i)*(1.0-pclc(i,k))
    346                else if (pplay(i,k).GT.cetahb*paprs(i,1) .AND.
    347      .                  pplay(i,k).LE.cetamb*paprs(i,1)) then
    348                pcm(i) = pcm(i)*(1.0-pclc(i,k))
    349                else if (pplay(i,k).GT.cetamb*paprs(i,1)) then
    350                pcl(i) = pcl(i)*(1.0-pclc(i,k))
     438               IF (pplay(i,k).LE.cetahb*paprs(i,1)) THEN
     439                  pch(i) = pch(i)*(1.0-pclc(i,k))
     440               ELSE IF (pplay(i,k).GT.cetahb*paprs(i,1) .AND.
     441     &                 pplay(i,k).LE.cetamb*paprs(i,1)) THEN
     442                  pcm(i) = pcm(i)*(1.0-pclc(i,k))
     443               ELSE IF (pplay(i,k).GT.cetamb*paprs(i,1)) THEN
     444                  pcl(i) = pcl(i)*(1.0-pclc(i,k))
    351445               endif
    352             ENDIF
    353          ENDDO
    354       ENDDO
    355 C
     446            ENDDO
     447         ENDDO
     448      ENDIF
     449     
     450C     
    356451      DO i = 1, klon
    357 cIM cf. CR          pct(i)=1.-pct(i)
     452c     IM cf. CR          pct(i)=1.-pct(i)
    358453         pch(i)=1.-pch(i)
    359454         pcm(i)=1.-pcm(i)
    360455         pcl(i)=1.-pcl(i)
    361456      ENDDO
     457     
    362458C
    363459      RETURN

  • LMDZ4/trunk/libf/phylmd/oasis.F90

    r1107 r1146  
    146146!************************************************************************************
    147147!     Define symbolic name for fields exchanged from atmos to coupler,
    148 !         must be the same as (1) of the field  definition in namcouple:
     148!         must be the same as (1) of the field definition in namcouple:
     149!
     150!   Initialization
     151    cl_writ(:)='NOFLDATM'
    149152
    150153    cl_writ(1)='COTAUXXU'
    … …  
    155158    cl_writ(6)='COTAUZZV'
    156159    cl_writ(7)='COWINDSP'
    157    
     160    cl_writ(8)='COSHFICE'
     161    cl_writ(10)='CONSFICE'
     162    cl_writ(12)='CODFLXDT'
     163
    158164    IF (version_ocean=='nemo') THEN
    159       cl_writ(8) ='COPEFWAT'
    160       cl_writ(9) ='COPEFICE'
    161       cl_writ(10)='COTOSPSU'
    162       cl_writ(11)='COICEVAP'
    163       cl_writ(12)='COSWFLDO'
    164       cl_writ(13)='CONSFLDO'
    165       cl_writ(14)='COSHFLIC'
    166       cl_writ(15)='CONSFLIC'
    167       cl_writ(16)='CODFLXDT'
    168       cl_writ(17)='CRWOCEIS'
    169       cl_writ(18)='CRWOCERD'
    170       cl_writ(19)='CRWOCECD'
     165      cl_writ(9)='COQSRMIX'
     166      cl_writ(11)='COQNSMIX'
     167      cl_writ(13)='COTOTRAI'
     168      cl_writ(14)='COTOTSNO'
     169      cl_writ(15)='COTOTEVA'
     170      cl_writ(16)='COICEVAP'
     171      cl_writ(17)='COCALVIN'
     172      cl_writ(18)='COLIQRUN'
    171173    ELSE IF (version_ocean=='opa8') THEN
    172       cl_writ(8) ='COSHFICE'
    173       cl_writ(9) ='COSHFOCE'
    174       cl_writ(10)='CONSFICE'
    175       cl_writ(11)='CONSFOCE'
    176       cl_writ(12)='CODFLXDT'
    177       cl_writ(13)='COTFSICE'
    178       cl_writ(14)='COTFSOCE'
    179       cl_writ(15)='COTOLPSU'
    180       cl_writ(16)='COTOSPSU'
    181       cl_writ(17)='CORUNCOA'
    182       cl_writ(18)='CORIVFLU'
    183       cl_writ(19)='COCALVIN'
     174       cl_writ(9)='COSHFOCE'
     175       cl_writ(11)='CONSFOCE'
     176       cl_writ(13)='COTFSICE'
     177       cl_writ(14)='COTFSOCE'
     178       cl_writ(15)='COTOLPSU'
     179       cl_writ(16)='COTOSPSU'
     180       cl_writ(17)='CORUNCOA'
     181       cl_writ(18)='CORIVFLU'
     182       cl_writ(19)='COCALVIN'
    184183    ENDIF
    185184
    186185!
    187186!     Define symbolic name for fields exchanged from coupler to atmosphere,
    188 !         must be the same as (2) of the field  definition in namcouple:
    189 !
    190     IF (version_ocean=='nemo') THEN
    191        cl_read(1)='SISUTESW'
    192        cl_read(2)='SIICECOV'
    193        cl_read(4)='SIICEALW'
    194        cl_read(3)='SIICTEMW'
    195     ELSE IF (version_ocean=='opa8') THEN
    196        cl_read(1)='SISUTESW'
    197        cl_read(2)='SIICECOV'
    198        cl_read(3)='SIICEALW'
    199        cl_read(4)='SIICTEMW'
     187!         must be the same as (2) of the field definition in namcouple:
     188!
     189!   Initialization
     190    cl_read(:)='NOFLDATM'
     191
     192    cl_read(1)='SISUTESW'
     193    cl_read(2)='SIICECOV'
     194    cl_read(3)='SIICEALW'
     195    cl_read(4)='SIICTEMW'
     196
     197    IF (cpl_current) THEN
     198       cl_read(5)='CURRENTX'
     199       cl_read(6)='CURRENTY'
     200       cl_read(7)='CURRENTZ'
    200201    END IF
    201     cl_read(5)='CURRENTX'
    202     cl_read(6)='CURRENTY'
    203     cl_read(7)='CURRENTZ'
    204202
    205203    il_var_nodims(1) = 2

  • LMDZ4/trunk/libf/phylmd/ocean_cpl_mod.F90

    r1067 r1146  
    259259
    260260    CALL cpl_receive_seaice_fields(knon, knindex, &
    261          tsurf_cpl, alb_cpl)
     261         tsurf_cpl, alb_cpl, u0, v0)
    262262
    263263    alb1_new(1:knon) = alb_cpl(1:knon)
    … …  
    273273    beta = 1.0
    274274   
    275 ! Suppose zero surface speed
    276     u0(:)=0.0
    277     v0(:)=0.0
    278     u1_lay(:) = u1(:) - u0(:)
    279     v1_lay(:) = v1(:) - v0(:)
     275    DO i = 1, knon
     276       u1_lay(i) = u1(i) - u0(i)
     277       v1_lay(i) = v1(i) - v0(i)
     278    END DO
    280279
    281280    CALL calcul_fluxs(knon, is_sic, dtime, &

  • LMDZ4/trunk/libf/phylmd/pbl_surface_mod.F90

    r1069 r1146  
    460460!****************************************************************************************
    461461! Declarations specifiques pour le 1D. A reprendre
    462   REAL  :: fsens,flat
    463   LOGICAL ok_flux_surf
    464   DATA ok_flux_surf/.FALSE./
    465 !ym pas glop !!
    466   COMMON /flux_arp/fsens,flat,ok_flux_surf
    467 !$OMP THREADPRIVATE(/flux_arp/)
     462  REAL,SAVE    :: fsens,flat
     463  LOGICAL,SAVE :: ok_flux_surf=.FALSE.
     464!$OMP THREADPRIVATE(fsens,flat,ok_flux_surf)
    468465
    469466!****************************************************************************************
    … …  
    768765       r_co2_ppm(:) = co2_ppm
    769766
     767
     768!****************************************************************************************
     769!
     770! Calulate t2m and q2m for the case of calculation at land grid points
     771! t2m and q2m are needed as input to ORCHIDEE
     772!
     773!****************************************************************************************
     774       IF (nsrf == is_ter) THEN
     775
     776          DO i = 1, knon
     777             zgeo1(i) = RD * yt(i,1) / (0.5*(ypaprs(i,1)+ypplay(i,1))) &
     778                  * (ypaprs(i,1)-ypplay(i,1))
     779          END DO
     780
     781          ! Calculate the temperature et relative humidity at 2m and the wind at 10m
     782          CALL stdlevvar(klon, knon, is_ter, zxli, &
     783               yu(:,1), yv(:,1), yt(:,1), yq(:,1), zgeo1, &
     784               yts, yqsurf, yrugos, ypaprs(:,1), ypplay(:,1), &
     785               yt2m, yq2m, yt10m, yq10m, yu10m, yustar)
     786         
     787       END IF
     788
    770789!****************************************************************************************
    771790!
    … …  
    790809               AcoefU, AcoefV, BcoefU, BcoefV, &
    791810               ypsref, yu1, yv1, yrugoro, pctsrf, &
     811               ylwdown, yq2m, yt2m, &
    792812               ysnow, yqsol, yagesno, ytsoil, &
    793813               yz0_new, yalb1_new, yalb2_new, yevap, yfluxsens, yfluxlat, &
    794814               yqsurf, ytsurf_new, y_dflux_t, y_dflux_q, &
    795                y_flux_u1, y_flux_v1, &
    796                ylwdown)
     815               y_flux_u1, y_flux_v1 )
     816               
    797817     
    798818       CASE(is_lic)

  • LMDZ4/trunk/libf/phylmd/phys_local_var_mod.F90

    r1054 r1146  
    7171SUBROUTINE phys_local_var_init
    7272use dimphy
     73use infotrac, ONLY : nbtr
    7374IMPLICIT NONE
    7475#include "indicesol.h"

  • LMDZ4/trunk/libf/phylmd/phys_output_mod.F90

    r1100 r1146  
    1212  IMPLICIT NONE
    1313
    14   private histdef2d, histdef3d
     14  private histdef2d, histdef3d, conf_physoutputs
     15
    1516
    1617   integer, parameter                           :: nfiles = 5
    … …  
    2728!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    2829!! Definition pour chaque variable du niveau d ecriture dans chaque fichier
    29 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!/ histmth, histday, histhf, histins /)!!!!!!!!!!!!
     30!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!/ histmth, histday, histhf, histins /),'!!!!!!!!!!!!
    3031!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    3132
    … …  
    3334  integer, private:: levmax(nfiles)
    3435
     36  TYPE ctrl_out
     37   integer,dimension(5) :: flag
     38   character(len=20)     :: name
     39  END TYPE ctrl_out
     40
     41
    3542!!! 1D
    36   integer, dimension(nfiles) , save :: flag_phis         = (/ 1, 1, 10, 1, 1 /)
    37   integer, dimension(nfiles) , save :: flag_aire         = (/ 1, 1, 10,  1, 1 /)
    38   integer, dimension(nfiles) , save :: flag_contfracATM  = (/ 10, 1,  1, 10, 10 /)
    39   integer, dimension(nfiles) , save :: flag_contfracOR   = (/ 10, 1,  1, 10, 10 /)
    40   integer, dimension(nfiles) , save :: flag_aireTER      = (/ 10, 10, 1, 10, 10 /)
     43  type(ctrl_out) :: o_phis         = ctrl_out((/ 1, 1, 10, 1, 1 /), 'phis')
     44  type(ctrl_out) :: o_aire         = ctrl_out((/ 1, 1, 10,  1, 1 /),'aire')
     45  type(ctrl_out) :: o_contfracATM  = ctrl_out((/ 10, 1,  1, 10, 10 /),'contfracATM')
     46  type(ctrl_out) :: o_contfracOR   = ctrl_out((/ 10, 1,  1, 10, 10 /),'contfracOR')
     47  type(ctrl_out) :: o_aireTER      = ctrl_out((/ 10, 10, 1, 10, 10 /),'aireTER')
    4148 
    4249!!! 2D
    43   integer, dimension(nfiles) , save :: flag_flat         = (/ 10, 1, 10, 10, 1 /)
    44   integer, dimension(nfiles) , save :: flag_slp          = (/ 1, 1, 1, 10, 1 /)
    45   integer, dimension(nfiles) , save :: flag_tsol         = (/ 1, 1, 1, 1, 1 /)
    46   integer, dimension(nfiles) , save :: flag_t2m          = (/ 1, 1, 1, 1, 1 /)
    47   integer, dimension(nfiles) , save :: flag_t2m_min      = (/ 1, 1, 10, 10, 10 /)
    48   integer, dimension(nfiles) , save :: flag_t2m_max      = (/ 1, 1, 10, 10, 10 /)
    49   integer, dimension(nfiles) , save :: flag_t2m_sol      = (/ 10, 4, 10, 10, 10 /)
    50   integer, dimension(nfiles) , save :: flag_wind10m      = (/ 1, 1, 1, 10, 10 /)
    51   integer, dimension(nfiles) , save :: flag_wind10max    = (/ 10, 1, 10, 10, 10 /)
    52   integer, dimension(nfiles) , save :: flag_sicf         = (/ 1, 1, 10, 10, 10 /)
    53   integer, dimension(nfiles) , save :: flag_q2m          = (/ 1, 1, 1, 1, 1 /)
    54   integer, dimension(nfiles) , save :: flag_u10m         = (/ 1, 1, 1, 1, 1 /)
    55   integer, dimension(nfiles) , save :: flag_v10m         = (/ 1, 1, 1, 1, 1 /)
    56   integer, dimension(nfiles) , save :: flag_psol         = (/ 1, 1, 1, 1, 1 /)
    57   integer, dimension(nfiles) , save :: flag_qsurf        = (/ 1, 10, 10, 10, 10 /)
    58 
    59   integer, dimension(nfiles) , save :: flag_u10m_sol     = (/ 10, 4, 10, 10, 10 /)
    60   integer, dimension(nfiles) , save :: flag_v10m_sol     = (/ 10, 4, 10, 10, 10 /)
    61 
    62   integer, dimension(nfiles) , save :: flag_qsol         = (/ 1, 10, 10, 1, 1 /)
    63 
    64   integer, dimension(nfiles),save   :: flag_ndayrain     = (/ 1, 10, 10, 10, 10 /)
    65   integer, dimension(nfiles),save   :: flag_precip       = (/ 1, 1, 1, 1, 1 /)
    66   integer,  dimension(nfiles), save :: flag_plul         = (/ 1, 1, 1, 1, 10 /)
    67 
    68   integer, dimension(nfiles) , save :: flag_pluc         = (/ 1, 1, 1, 1, 10 /)
    69   integer, dimension(nfiles) , save :: flag_snow         = (/ 1, 1, 10, 1, 10 /)
    70   integer, dimension(nfiles) , save :: flag_evap         = (/ 1, 1, 10, 1, 10 /)
    71   integer, dimension(nfiles) , save :: flag_tops         = (/ 1, 1, 10, 10, 10 /)
    72   integer, dimension(nfiles) , save :: flag_tops0        = (/ 1, 5, 10, 10, 10 /)
    73   integer, dimension(nfiles) , save :: flag_topl         = (/ 1, 1, 10, 1, 10 /)
    74   integer, dimension(nfiles) , save :: flag_topl0        = (/ 1, 5, 10, 10, 10 /)
    75   integer, dimension(nfiles) , save :: flag_SWupTOA      = (/ 1, 4, 10, 10, 10 /)
    76   integer, dimension(nfiles) , save :: flag_SWupTOAclr   = (/ 1, 4, 10, 10, 10 /)
    77   integer, dimension(nfiles) , save :: flag_SWdnTOA      = (/ 1, 4, 10, 10, 10 /)
    78   integer, dimension(nfiles) , save :: flag_SWdnTOAclr   = (/ 1, 4, 10, 10, 10 /)
    79   integer, dimension(nfiles) , save :: flag_SWup200      = (/ 1, 10, 10, 10, 10 /)
    80   integer, dimension(nfiles) , save :: flag_SWup200clr   = (/ 10, 1, 10, 10, 10 /)
    81   integer, dimension(nfiles) , save :: flag_SWdn200      = (/ 1, 10, 10, 10, 10 /)
    82   integer, dimension(nfiles) , save :: flag_SWdn200clr   = (/ 10, 1, 10, 10, 10 /)
     50  type(ctrl_out) :: o_flat         = ctrl_out((/ 10, 1, 10, 10, 1 /),'flat')
     51  type(ctrl_out) :: o_slp          = ctrl_out((/ 1, 1, 1, 10, 1 /),'slp')
     52  type(ctrl_out) :: o_tsol         = ctrl_out((/ 1, 1, 1, 1, 1 /),'tsol')
     53  type(ctrl_out) :: o_t2m          = ctrl_out((/ 1, 1, 1, 1, 1 /),'t2m')
     54  type(ctrl_out) :: o_t2m_min      = ctrl_out((/ 1, 1, 10, 10, 10 /),'t2m_min')
     55  type(ctrl_out) :: o_t2m_max      = ctrl_out((/ 1, 1, 10, 10, 10 /),'t2m_max')
     56  type(ctrl_out),dimension(4) :: o_t2m_srf      = (/ ctrl_out((/ 10, 4, 10, 10, 10 /),'t2m_ter'), &
     57                                                 ctrl_out((/ 10, 4, 10, 10, 10 /),'t2m_lic'), &
     58                                                 ctrl_out((/ 10, 4, 10, 10, 10 /),'t2m_oce'), &
     59                                                 ctrl_out((/ 10, 4, 10, 10, 10 /),'t2m_sic') /)
     60
     61  type(ctrl_out) :: o_wind10m      = ctrl_out((/ 1, 1, 1, 10, 10 /),'wind10m')
     62  type(ctrl_out) :: o_wind10max    = ctrl_out((/ 10, 1, 10, 10, 10 /),'wind10max')
     63  type(ctrl_out) :: o_sicf         = ctrl_out((/ 1, 1, 10, 10, 10 /),'sicf')
     64  type(ctrl_out) :: o_q2m          = ctrl_out((/ 1, 1, 1, 1, 1 /),'q2m')
     65  type(ctrl_out) :: o_u10m         = ctrl_out((/ 1, 1, 1, 1, 1 /),'u10m')
     66  type(ctrl_out) :: o_v10m         = ctrl_out((/ 1, 1, 1, 1, 1 /),'v10m')
     67  type(ctrl_out) :: o_psol         = ctrl_out((/ 1, 1, 1, 1, 1 /),'psol')
     68  type(ctrl_out) :: o_qsurf        = ctrl_out((/ 1, 10, 10, 10, 10 /),'qsurf')
     69
     70  type(ctrl_out),dimension(4) :: o_u10m_srf     = (/ ctrl_out((/ 10, 4, 10, 10, 10 /),'u10m_ter'), &
     71                                              ctrl_out((/ 10, 4, 10, 10, 10 /),'u10m_lic'), &
     72                                              ctrl_out((/ 10, 4, 10, 10, 10 /),'u10m_oce'), &
     73                                              ctrl_out((/ 10, 4, 10, 10, 10 /),'u10m_sic') /)
     74
     75  type(ctrl_out),dimension(4) :: o_v10m_srf     = (/ ctrl_out((/ 10, 4, 10, 10, 10 /),'v10m_ter'), &
     76                                              ctrl_out((/ 10, 4, 10, 10, 10 /),'v10m_lic'), &
     77                                              ctrl_out((/ 10, 4, 10, 10, 10 /),'v10m_oce'), &
     78                                              ctrl_out((/ 10, 4, 10, 10, 10 /),'v10m_sic') /)
     79
     80  type(ctrl_out) :: o_qsol         = ctrl_out((/ 1, 10, 10, 1, 1 /),'qsol')
     81
     82  type(ctrl_out) :: o_ndayrain     = ctrl_out((/ 1, 10, 10, 10, 10 /),'ndayrain')
     83  type(ctrl_out) :: o_precip       = ctrl_out((/ 1, 1, 1, 1, 1 /),'precip')
     84  type(ctrl_out) :: o_plul         = ctrl_out((/ 1, 1, 1, 1, 10 /),'plul')
     85
     86  type(ctrl_out) :: o_pluc         = ctrl_out((/ 1, 1, 1, 1, 10 /),'pluc')
     87  type(ctrl_out) :: o_snow         = ctrl_out((/ 1, 1, 10, 1, 10 /),'snow')
     88  type(ctrl_out) :: o_evap         = ctrl_out((/ 1, 1, 10, 1, 10 /),'evap')
     89  type(ctrl_out) :: o_tops         = ctrl_out((/ 1, 1, 10, 10, 10 /),'tops')
     90  type(ctrl_out) :: o_tops0        = ctrl_out((/ 1, 5, 10, 10, 10 /),'tops0')
     91  type(ctrl_out) :: o_topl         = ctrl_out((/ 1, 1, 10, 1, 10 /),'topl')
     92  type(ctrl_out) :: o_topl0        = ctrl_out((/ 1, 5, 10, 10, 10 /),'topl0')
     93  type(ctrl_out) :: o_SWupTOA      = ctrl_out((/ 1, 4, 10, 10, 10 /),'SWupTOA')
     94  type(ctrl_out) :: o_SWupTOAclr   = ctrl_out((/ 1, 4, 10, 10, 10 /),'SWupTOAclr')
     95  type(ctrl_out) :: o_SWdnTOA      = ctrl_out((/ 1, 4, 10, 10, 10 /),'SWdnTOA')
     96  type(ctrl_out) :: o_SWdnTOAclr   = ctrl_out((/ 1, 4, 10, 10, 10 /),'SWdnTOAclr')
     97  type(ctrl_out) :: o_SWup200      = ctrl_out((/ 1, 10, 10, 10, 10 /),'SWup200')
     98  type(ctrl_out) :: o_SWup200clr   = ctrl_out((/ 10, 1, 10, 10, 10 /),'SWup200clr')
     99  type(ctrl_out) :: o_SWdn200      = ctrl_out((/ 1, 10, 10, 10, 10 /),'SWdn200')
     100  type(ctrl_out) :: o_SWdn200clr   = ctrl_out((/ 10, 1, 10, 10, 10 /),'SWdn200clr')
    83101
    84102! arajouter
    85 !  integer, dimension(nfiles) , save :: flag_LWupTOA     = (/ 1, 4, 10, 10, 10 /)
    86 !  integer, dimension(nfiles) , save :: flag_LWupTOAclr  = (/ 1, 4, 10, 10, 10 /)
    87 !  integer, dimension(nfiles) , save :: flag_LWdnTOA     = (/ 1, 4, 10, 10, 10 /)
    88 !  integer, dimension(nfiles) , save :: flag_LWdnTOAclr  = (/ 1, 4, 10, 10, 10 /)
    89 
    90   integer, dimension(nfiles) , save :: flag_LWup200      = (/ 1, 10, 10, 10, 10 /)
    91   integer, dimension(nfiles) , save :: flag_LWup200clr   = (/ 1, 10, 10, 10, 10 /)
    92   integer, dimension(nfiles) , save :: flag_LWdn200      = (/ 1, 10, 10, 10, 10 /)
    93   integer, dimension(nfiles) , save :: flag_LWdn200clr   = (/ 1, 10, 10, 10, 10 /)
    94   integer, dimension(nfiles) , save :: flag_sols         = (/ 1, 1, 10, 1, 10 /)
    95   integer, dimension(nfiles) , save :: flag_sols0        = (/ 1, 5, 10, 10, 10 /)
    96   integer, dimension(nfiles) , save :: flag_soll         = (/ 1, 1, 10, 1, 10 /)
    97   integer, dimension(nfiles) , save :: flag_soll0        = (/ 1, 5, 10, 10, 10 /)
    98   integer, dimension(nfiles) , save :: flag_radsol       = (/ 1, 1, 10, 10, 10 /)
    99   integer, dimension(nfiles) , save :: flag_SWupSFC      = (/ 1, 4, 10, 10, 10 /)
    100   integer, dimension(nfiles) , save :: flag_SWupSFCclr   = (/ 1, 4, 10, 10, 10 /)
    101   integer, dimension(nfiles) , save :: flag_SWdnSFC      = (/ 1, 1, 10, 10, 10 /)
    102   integer, dimension(nfiles) , save :: flag_SWdnSFCclr   = (/ 1, 4, 10, 10, 10 /)
    103   integer, dimension(nfiles) , save :: flag_LWupSFC      = (/ 1, 4, 10, 10, 10 /)
    104   integer, dimension(nfiles) , save :: flag_LWupSFCclr   = (/ 1, 4, 10, 10, 10 /)
    105   integer, dimension(nfiles) , save :: flag_LWdnSFC      = (/ 1, 4, 10, 10, 10 /)
    106   integer, dimension(nfiles) , save :: flag_LWdnSFCclr   = (/ 1, 4, 10, 10, 10 /)
    107   integer, dimension(nfiles) , save :: flag_bils         = (/ 1, 2, 10, 1, 10 /)
    108   integer, dimension(nfiles) , save :: flag_sens         = (/ 1, 1, 10, 1, 1 /)
    109   integer, dimension(nfiles) , save :: flag_fder         = (/ 1, 2, 10, 1, 10 /)
    110   integer, dimension(nfiles) , save :: flag_ffonte       = (/ 1, 10, 10, 10, 10 /)
    111   integer, dimension(nfiles) , save :: flag_fqcalving    = (/ 1, 10, 10, 10, 10 /)
    112   integer, dimension(nfiles) , save :: flag_fqfonte      = (/ 1, 10, 10, 10, 10 /)
    113 
    114   integer, dimension(nfiles) , save :: flag_taux_sol     = (/ 1, 4, 10, 1, 10 /)
    115   integer, dimension(nfiles) , save :: flag_tauy_sol     = (/ 1, 4, 10, 1, 10 /)
    116 
    117   integer, dimension(nfiles) , save :: flag_pourc_sol    = (/ 1, 4, 10, 1, 10 /)
    118   integer, dimension(nfiles) , save :: flag_fract_sol    = (/ 1, 4, 10, 1, 10 /)
    119   integer, dimension(nfiles) , save :: flag_tsol_sol     = (/ 1, 4, 10, 1, 10 /)
    120   integer, dimension(nfiles) , save :: flag_sens_sol     = (/ 1, 4, 10, 1, 10 /)
    121   integer, dimension(nfiles) , save :: flag_lat_sol      = (/ 1, 4, 10, 1, 10 /)
    122   integer, dimension(nfiles) , save :: flag_flw_sol      = (/ 1, 10, 10, 10, 10 /)
    123   integer, dimension(nfiles) , save :: flag_fsw_sol      = (/ 1, 10, 10, 10, 10 /)
    124   integer, dimension(nfiles) , save :: flag_wbils_sol    = (/ 1, 10, 10, 10, 10 /)
    125   integer, dimension(nfiles) , save :: flag_wbilo_sol    = (/ 1, 10, 10, 10, 10 /)
    126 
    127   integer, dimension(nfiles) , save :: flag_cdrm         = (/ 1, 10, 10, 1, 10 /)
    128   integer, dimension(nfiles) , save :: flag_cdrh         = (/ 1, 10, 10, 1, 10 /)
    129   integer, dimension(nfiles) , save :: flag_cldl         = (/ 1, 1, 10, 10, 10 /)
    130   integer, dimension(nfiles) , save :: flag_cldm         = (/ 1, 1, 10, 10, 10 /)
    131   integer, dimension(nfiles) , save :: flag_cldh         = (/ 1, 1, 10, 10, 10 /)
    132   integer, dimension(nfiles) , save :: flag_cldt         = (/ 1, 1, 2, 10, 10 /)
    133   integer, dimension(nfiles) , save :: flag_cldq         = (/ 1, 1, 10, 10, 10 /)
    134   integer, dimension(nfiles) , save :: flag_lwp          = (/ 1, 5, 10, 10, 10 /)
    135   integer, dimension(nfiles) , save :: flag_iwp          = (/ 1, 5, 10, 10, 10 /)
    136   integer, dimension(nfiles) , save :: flag_ue           = (/ 1, 10, 10, 10, 10 /)
    137   integer, dimension(nfiles) , save :: flag_ve           = (/ 1, 10, 10, 10, 10 /)
    138   integer, dimension(nfiles) , save :: flag_uq           = (/ 1, 10, 10, 10, 10 /)
    139   integer, dimension(nfiles) , save :: flag_vq           = (/ 1, 10, 10, 10, 10 /)
     103!  type(ctrl_out) :: o_LWupTOA     = ctrl_out((/ 1, 4, 10, 10, 10 /),'LWupTOA')
     104!  type(ctrl_out) :: o_LWupTOAclr  = ctrl_out((/ 1, 4, 10, 10, 10 /),'LWupTOAclr')
     105!  type(ctrl_out) :: o_LWdnTOA     = ctrl_out((/ 1, 4, 10, 10, 10 /),'LWdnTOA')
     106!  type(ctrl_out) :: o_LWdnTOAclr  = ctrl_out((/ 1, 4, 10, 10, 10 /),'LWdnTOAclr')
     107
     108  type(ctrl_out) :: o_LWup200      = ctrl_out((/ 1, 10, 10, 10, 10 /),'LWup200')
     109  type(ctrl_out) :: o_LWup200clr   = ctrl_out((/ 1, 10, 10, 10, 10 /),'LWup200clr')
     110  type(ctrl_out) :: o_LWdn200      = ctrl_out((/ 1, 10, 10, 10, 10 /),'LWdn200')
     111  type(ctrl_out) :: o_LWdn200clr   = ctrl_out((/ 1, 10, 10, 10, 10 /),'LWdn200clr')
     112  type(ctrl_out) :: o_sols         = ctrl_out((/ 1, 1, 10, 1, 10 /),'sols')
     113  type(ctrl_out) :: o_sols0        = ctrl_out((/ 1, 5, 10, 10, 10 /),'sols0')
     114  type(ctrl_out) :: o_soll         = ctrl_out((/ 1, 1, 10, 1, 10 /),'soll')
     115  type(ctrl_out) :: o_soll0        = ctrl_out((/ 1, 5, 10, 10, 10 /),'soll0')
     116  type(ctrl_out) :: o_radsol       = ctrl_out((/ 1, 1, 10, 10, 10 /),'radsol')
     117  type(ctrl_out) :: o_SWupSFC      = ctrl_out((/ 1, 4, 10, 10, 10 /),'SWupSFC')
     118  type(ctrl_out) :: o_SWupSFCclr   = ctrl_out((/ 1, 4, 10, 10, 10 /),'SWupSFCclr')
     119  type(ctrl_out) :: o_SWdnSFC      = ctrl_out((/ 1, 1, 10, 10, 10 /),'SWdnSFC')
     120  type(ctrl_out) :: o_SWdnSFCclr   = ctrl_out((/ 1, 4, 10, 10, 10 /),'SWdnSFCclr')
     121  type(ctrl_out) :: o_LWupSFC      = ctrl_out((/ 1, 4, 10, 10, 10 /),'LWupSFC')
     122  type(ctrl_out) :: o_LWupSFCclr   = ctrl_out((/ 1, 4, 10, 10, 10 /),'LWupSFCclr')
     123  type(ctrl_out) :: o_LWdnSFC      = ctrl_out((/ 1, 4, 10, 10, 10 /),'LWdnSFC')
     124  type(ctrl_out) :: o_LWdnSFCclr   = ctrl_out((/ 1, 4, 10, 10, 10 /),'LWdnSFCclr')
     125  type(ctrl_out) :: o_bils         = ctrl_out((/ 1, 2, 10, 1, 10 /),'bils')
     126  type(ctrl_out) :: o_sens         = ctrl_out((/ 1, 1, 10, 1, 1 /),'sens')
     127  type(ctrl_out) :: o_fder         = ctrl_out((/ 1, 2, 10, 1, 10 /),'fder')
     128  type(ctrl_out) :: o_ffonte       = ctrl_out((/ 1, 10, 10, 10, 10 /),'ffonte')
     129  type(ctrl_out) :: o_fqcalving    = ctrl_out((/ 1, 10, 10, 10, 10 /),'fqcalving')
     130  type(ctrl_out) :: o_fqfonte      = ctrl_out((/ 1, 10, 10, 10, 10 /),'fqfonte')
     131
     132  type(ctrl_out),dimension(4) :: o_taux_srf     = (/ ctrl_out((/ 1, 4, 10, 1, 10 /),'taux_ter'), &
     133                                                 ctrl_out((/ 1, 4, 10, 1, 10 /),'taux_lic'), &
     134                                                 ctrl_out((/ 1, 4, 10, 1, 10 /),'taux_oce'), &
     135                                                 ctrl_out((/ 1, 4, 10, 1, 10 /),'taux_sic') /)
     136
     137  type(ctrl_out),dimension(4) :: o_tauy_srf     = (/ ctrl_out((/ 1, 4, 10, 1, 10 /),'tauy_ter'), &
     138                                                 ctrl_out((/ 1, 4, 10, 1, 10 /),'tauy_lic'), &
     139                                                 ctrl_out((/ 1, 4, 10, 1, 10 /),'tauy_oce'), &
     140                                                 ctrl_out((/ 1, 4, 10, 1, 10 /),'tauy_sic') /)
     141
     142
     143  type(ctrl_out),dimension(4) :: o_pourc_srf    = (/ ctrl_out((/ 1, 4, 10, 1, 10 /),'pourc_ter'), &
     144                                                 ctrl_out((/ 1, 4, 10, 1, 10 /),'pourc_lic'), &
     145                                                 ctrl_out((/ 1, 4, 10, 1, 10 /),'pourc_oce'), &
     146                                                 ctrl_out((/ 1, 4, 10, 1, 10 /),'pourc_sic') /)     
     147
     148  type(ctrl_out),dimension(4) :: o_fract_srf    = (/ ctrl_out((/ 1, 4, 10, 1, 10 /),'fract_ter'), &
     149                                                 ctrl_out((/ 1, 4, 10, 1, 10 /),'fract_lic'), &
     150                                                 ctrl_out((/ 1, 4, 10, 1, 10 /),'fract_oce'), &
     151                                                 ctrl_out((/ 1, 4, 10, 1, 10 /),'fract_sic') /)
     152
     153  type(ctrl_out),dimension(4) :: o_tsol_srf     = (/ ctrl_out((/ 1, 4, 10, 1, 10 /),'tsol_ter'), &
     154                                                 ctrl_out((/ 1, 4, 10, 1, 10 /),'tsol_lic'), &
     155                                                 ctrl_out((/ 1, 4, 10, 1, 10 /),'tsol_oce'), &
     156                                                 ctrl_out((/ 1, 4, 10, 1, 10 /),'tsol_sic') /)
     157
     158  type(ctrl_out),dimension(4) :: o_sens_srf     = (/ ctrl_out((/ 1, 4, 10, 1, 10 /),'sens_ter'), &
     159                                                 ctrl_out((/ 1, 4, 10, 1, 10 /),'sens_lic'), &
     160                                                 ctrl_out((/ 1, 4, 10, 1, 10 /),'sens_oce'), &
     161                                                 ctrl_out((/ 1, 4, 10, 1, 10 /),'sens_sic') /)
     162
     163  type(ctrl_out),dimension(4) :: o_lat_srf      = (/ ctrl_out((/ 1, 4, 10, 1, 10 /),'lat_ter'), &
     164                                                 ctrl_out((/ 1, 4, 10, 1, 10 /),'lat_lic'), &
     165                                                 ctrl_out((/ 1, 4, 10, 1, 10 /),'lat_oce'), &
     166                                                 ctrl_out((/ 1, 4, 10, 1, 10 /),'lat_sic') /)
     167
     168  type(ctrl_out),dimension(4) :: o_flw_srf      = (/ ctrl_out((/ 1, 10, 10, 10, 10 /),'flw_ter'), &
     169                                                 ctrl_out((/ 1, 10, 10, 10, 10 /),'flw_lic'), &
     170                                                 ctrl_out((/ 1, 10, 10, 10, 10 /),'flw_oce'), &
     171                                                 ctrl_out((/ 1, 10, 10, 10, 10 /),'flw_sic') /)
     172                                                 
     173  type(ctrl_out),dimension(4) :: o_fsw_srf      = (/ ctrl_out((/ 1, 10, 10, 10, 10 /),'fsw_ter'), &
     174                                                  ctrl_out((/ 1, 10, 10, 10, 10 /),'fsw_lic'), &
     175                                                  ctrl_out((/ 1, 10, 10, 10, 10 /),'fsw_oce'), &
     176                                                  ctrl_out((/ 1, 10, 10, 10, 10 /),'fsw_sic') /)
     177
     178  type(ctrl_out),dimension(4) :: o_wbils_srf    = (/ ctrl_out((/ 1, 10, 10, 10, 10 /),'wbils_ter'), &
     179                                                 ctrl_out((/ 1, 10, 10, 10, 10 /),'wbils_lic'), &
     180                                                 ctrl_out((/ 1, 10, 10, 10, 10 /),'wbils_oce'), &
     181                                                 ctrl_out((/ 1, 10, 10, 10, 10 /),'wbils_sic') /)
     182
     183  type(ctrl_out),dimension(4) :: o_wbilo_srf    = (/ ctrl_out((/ 1, 10, 10, 10, 10 /),'wbilo_ter'), &
     184                                                     ctrl_out((/ 1, 10, 10, 10, 10 /),'wbilo_lic'), &
     185                                                 ctrl_out((/ 1, 10, 10, 10, 10 /),'wbilo_oce'), &
     186                                                 ctrl_out((/ 1, 10, 10, 10, 10 /),'wbilo_sic') /)
     187
     188
     189  type(ctrl_out) :: o_cdrm         = ctrl_out((/ 1, 10, 10, 1, 10 /),'cdrm')
     190  type(ctrl_out) :: o_cdrh         = ctrl_out((/ 1, 10, 10, 1, 10 /),'cdrh')
     191  type(ctrl_out) :: o_cldl         = ctrl_out((/ 1, 1, 10, 10, 10 /),'cldl')
     192  type(ctrl_out) :: o_cldm         = ctrl_out((/ 1, 1, 10, 10, 10 /),'cldm')
     193  type(ctrl_out) :: o_cldh         = ctrl_out((/ 1, 1, 10, 10, 10 /),'cldh')
     194  type(ctrl_out) :: o_cldt         = ctrl_out((/ 1, 1, 2, 10, 10 /),'cldt')
     195  type(ctrl_out) :: o_cldq         = ctrl_out((/ 1, 1, 10, 10, 10 /),'cldq')
     196  type(ctrl_out) :: o_lwp          = ctrl_out((/ 1, 5, 10, 10, 10 /),'lwp')
     197  type(ctrl_out) :: o_iwp          = ctrl_out((/ 1, 5, 10, 10, 10 /),'iwp')
     198  type(ctrl_out) :: o_ue           = ctrl_out((/ 1, 10, 10, 10, 10 /),'ue')
     199  type(ctrl_out) :: o_ve           = ctrl_out((/ 1, 10, 10, 10, 10 /),'ve')
     200  type(ctrl_out) :: o_uq           = ctrl_out((/ 1, 10, 10, 10, 10 /),'uq')
     201  type(ctrl_out) :: o_vq           = ctrl_out((/ 1, 10, 10, 10, 10 /),'vq')
    140202 
    141   integer, dimension(nfiles) , save :: flag_cape         = (/ 1, 10, 10, 10, 10 /)
    142   integer, dimension(nfiles) , save :: flag_pbase        = (/ 1, 10, 10, 10, 10 /)
    143   integer, dimension(nfiles) , save :: flag_ptop         = (/ 1, 4, 10, 10, 10 /)
    144   integer, dimension(nfiles) , save :: flag_fbase        = (/ 1, 10, 10, 10, 10 /)
    145   integer, dimension(nfiles) , save :: flag_prw          = (/ 1, 1, 10, 10, 10 /)
    146 
    147   integer, dimension(nfiles) , save :: flag_s_pblh       = (/ 1, 10, 10, 1, 1 /)
    148   integer, dimension(nfiles) , save :: flag_s_pblt       = (/ 1, 10, 10, 1, 1 /)
    149   integer, dimension(nfiles) , save :: flag_s_lcl       = (/ 1, 10, 10, 1, 10 /)
    150   integer, dimension(nfiles) , save :: flag_s_capCL      = (/ 1, 10, 10, 1, 10 /)
    151   integer, dimension(nfiles) , save :: flag_s_oliqCL    = (/ 1, 10, 10, 1, 10 /)
    152   integer, dimension(nfiles) , save :: flag_s_cteiCL     = (/ 1, 10, 10, 1, 1 /)
    153   integer, dimension(nfiles) , save :: flag_s_therm      = (/ 1, 10, 10, 1, 1 /)
    154   integer, dimension(nfiles) , save :: flag_s_trmb1      = (/ 1, 10, 10, 1, 10 /)
    155   integer, dimension(nfiles) , save :: flag_s_trmb2      = (/ 1, 10, 10, 1, 10 /)
    156   integer, dimension(nfiles) , save :: flag_s_trmb3      = (/ 1, 10, 10, 1, 10 /)
    157 
    158   integer, dimension(nfiles) , save :: flag_slab_bils    = (/ 1, 1, 10, 10, 10 /)
    159 
    160   integer, dimension(nfiles) , save :: flag_ale_bl    = (/ 1, 1, 1, 1, 10 /)
    161   integer, dimension(nfiles) , save :: flag_alp_bl    = (/ 1, 1, 1, 1, 10 /)
    162   integer, dimension(nfiles) , save :: flag_ale_wk    = (/ 1, 1, 1, 1, 10 /)
    163   integer, dimension(nfiles) , save :: flag_alp_wk    = (/ 1, 1, 1, 1, 10 /)
    164 
    165   integer, dimension(nfiles) , save :: flag_ale       = (/ 1, 1, 1, 1, 10 /)
    166   integer, dimension(nfiles) , save :: flag_alp       = (/ 1, 1, 1, 1, 10 /)
    167   integer, dimension(nfiles) , save :: flag_cin       = (/ 1, 1, 1, 1, 10 /)
    168   integer, dimension(nfiles) , save :: flag_wape       = (/ 1, 1, 1, 1, 10 /)
     203  type(ctrl_out) :: o_cape         = ctrl_out((/ 1, 10, 10, 10, 10 /),'cape')
     204  type(ctrl_out) :: o_pbase        = ctrl_out((/ 1, 10, 10, 10, 10 /),'pbase')
     205  type(ctrl_out) :: o_ptop         = ctrl_out((/ 1, 4, 10, 10, 10 /),'ptop')
     206  type(ctrl_out) :: o_fbase        = ctrl_out((/ 1, 10, 10, 10, 10 /),'fbase')
     207  type(ctrl_out) :: o_prw          = ctrl_out((/ 1, 1, 10, 10, 10 /),'prw')
     208
     209  type(ctrl_out) :: o_s_pblh       = ctrl_out((/ 1, 10, 10, 1, 1 /),'s_pblh')
     210  type(ctrl_out) :: o_s_pblt       = ctrl_out((/ 1, 10, 10, 1, 1 /),'s_pblt')
     211  type(ctrl_out) :: o_s_lcl        = ctrl_out((/ 1, 10, 10, 1, 10 /),'s_lcl')
     212  type(ctrl_out) :: o_s_capCL      = ctrl_out((/ 1, 10, 10, 1, 10 /),'s_capCL')
     213  type(ctrl_out) :: o_s_oliqCL     = ctrl_out((/ 1, 10, 10, 1, 10 /),'s_oliqCL')
     214  type(ctrl_out) :: o_s_cteiCL     = ctrl_out((/ 1, 10, 10, 1, 1 /),'s_cteiCL')
     215  type(ctrl_out) :: o_s_therm      = ctrl_out((/ 1, 10, 10, 1, 1 /),'s_therm')
     216  type(ctrl_out) :: o_s_trmb1      = ctrl_out((/ 1, 10, 10, 1, 10 /),'s_trmb1')
     217  type(ctrl_out) :: o_s_trmb2      = ctrl_out((/ 1, 10, 10, 1, 10 /),'s_trmb2')
     218  type(ctrl_out) :: o_s_trmb3      = ctrl_out((/ 1, 10, 10, 1, 10 /),'s_trmb3')
     219
     220  type(ctrl_out) :: o_slab_bils    = ctrl_out((/ 1, 1, 10, 10, 10 /),'slab_bils_oce')
     221
     222  type(ctrl_out) :: o_ale_bl       = ctrl_out((/ 1, 1, 1, 1, 10 /),'ale_bl')
     223  type(ctrl_out) :: o_alp_bl       = ctrl_out((/ 1, 1, 1, 1, 10 /),'alp_bl')
     224  type(ctrl_out) :: o_ale_wk       = ctrl_out((/ 1, 1, 1, 1, 10 /),'ale_wk')
     225  type(ctrl_out) :: o_alp_wk       = ctrl_out((/ 1, 1, 1, 1, 10 /),'alp_wk')
     226
     227  type(ctrl_out) :: o_ale          = ctrl_out((/ 1, 1, 1, 1, 10 /),'ale')
     228  type(ctrl_out) :: o_alp          = ctrl_out((/ 1, 1, 1, 1, 10 /),'alp')
     229  type(ctrl_out) :: o_cin          = ctrl_out((/ 1, 1, 1, 1, 10 /),'cin')
     230  type(ctrl_out) :: o_wape         = ctrl_out((/ 1, 1, 1, 1, 10 /),'wape')
    169231
    170232
    … …  
    177239!      on ecrit ph  a 500   au niv 3
    178240
    179   integer, dimension(nfiles) , save :: flag_ulevsSTD     = (/ 1, 1, 3, 10, 10 /)
    180   integer, dimension(nfiles) , save :: flag_vlevsSTD     = (/ 1, 1, 3, 10, 10 /)
    181   integer, dimension(nfiles) , save :: flag_wlevsSTD     = (/ 1, 1, 10, 10, 10 /)
    182   integer, dimension(nfiles) , save :: flag_tlevsSTD     = (/ 10, 10, 3, 10, 10 /)
    183   integer, dimension(nfiles) , save :: flag_qlevsSTD     = (/ 10, 10, 3, 10, 10 /)
    184   integer, dimension(nfiles) , save :: flag_philevsSTD   = (/ 1, 1, 1, 10, 10 /)
    185 
    186   integer, dimension(nfiles) , save :: flag_t_oce_sic    = (/ 1, 10, 10, 10, 10 /)
    187 
    188   integer, dimension(nfiles) , save :: flag_weakinv      = (/ 10, 1, 10, 10, 10 /)
    189   integer, dimension(nfiles) , save :: flag_dthmin       = (/ 10, 1, 10, 10, 10 /)
    190   integer, dimension(nfiles) , save :: flag_u10_sol      = (/ 10, 4, 10, 10, 10 /)
    191   integer, dimension(nfiles) , save :: flag_v10_sol      = (/ 10, 4, 10, 10, 10 /)
    192   integer, dimension(nfiles) , save :: flag_cldtau       = (/ 10, 5, 10, 10, 10 /)                     
    193   integer, dimension(nfiles) , save :: flag_cldemi       = (/ 10, 5, 10, 10, 10 /)
    194   integer, dimension(nfiles) , save :: flag_rh2m         = (/ 10, 5, 10, 10, 10 /)
    195   integer, dimension(nfiles) , save :: flag_qsat2m       = (/ 10, 5, 10, 10, 10 /)
    196   integer, dimension(nfiles) , save :: flag_tpot         = (/ 10, 5, 10, 10, 10 /)
    197   integer, dimension(nfiles) , save :: flag_tpote        = (/ 10, 5, 10, 10, 10 /)
    198   integer, dimension(nfiles) , save :: flag_tke          = (/ 4, 10, 10, 10, 10 /)
    199   integer, dimension(nfiles) , save :: flag_tke_max      = (/ 4, 10, 10, 10, 10 /)
    200   integer, dimension(nfiles) , save :: flag_tke_sol      = (/ 10, 4, 10, 10, 10 /)
    201   integer, dimension(nfiles) , save :: flag_tke_max_sol  = (/ 10, 4, 10, 10, 10 /)
    202   integer, dimension(nfiles) , save :: flag_kz           = (/ 4, 10, 10, 10, 10 /)
    203   integer, dimension(nfiles) , save :: flag_kz_max       = (/ 4, 10, 10, 10, 10 /)
    204   integer, dimension(nfiles) , save :: flag_SWnetOR      = (/ 10, 10, 2, 10, 10 /)
    205   integer, dimension(nfiles) , save :: flag_SWdownOR     = (/ 10, 10, 2, 10, 10 /)
    206   integer, dimension(nfiles) , save :: flag_LWdownOR     = (/ 10, 10, 2, 10, 10 /)
    207 
    208   integer, dimension(nfiles) , save :: flag_snowl         = (/ 10, 1, 10, 10, 10 /)
    209   integer, dimension(nfiles) , save :: flag_cape_max      = (/ 10, 1, 10, 10, 10 /)
    210   integer, dimension(nfiles) , save :: flag_solldown      = (/ 10, 1, 10, 1, 10 /)
    211 
    212   integer, dimension(nfiles) , save :: flag_dtsvdfo       = (/ 10, 10, 10, 1, 10 /)
    213   integer, dimension(nfiles) , save :: flag_dtsvdft       = (/ 10, 10, 10, 1, 10 /)
    214   integer, dimension(nfiles) , save :: flag_dtsvdfg       = (/ 10, 10, 10, 1, 10 /)
    215   integer, dimension(nfiles) , save :: flag_dtsvdfi       = (/ 10, 10, 10, 1, 10 /)
    216   integer, dimension(nfiles) , save :: flag_rugs          = (/ 10, 10, 10, 1, 1 /)
    217 
     241                                             
     242  type(ctrl_out),dimension(4) :: o_uSTDlevs     = (/ ctrl_out((/ 1, 1, 3, 10, 10 /),'u850'), &
     243                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'u700'), &
     244                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'u500'), &
     245                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'u200') /)
     246
     247  type(ctrl_out),dimension(4) :: o_vSTDlevs     = (/ ctrl_out((/ 1, 1, 3, 10, 10 /),'v850'), &
     248                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'v700'), &
     249                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'v500'), &
     250                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'v200') /)
     251
     252  type(ctrl_out),dimension(4) :: o_wSTDlevs     = (/ ctrl_out((/ 1, 1, 3, 10, 10 /),'w850'), &
     253                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'w700'), &
     254                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'w500'), &
     255                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'w200') /)
     256
     257  type(ctrl_out),dimension(4) :: o_tSTDlevs     = (/ ctrl_out((/ 1, 1, 3, 10, 10 /),'t850'), &
     258                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'t700'), &
     259                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'t500'), &
     260                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'t200') /)
     261
     262  type(ctrl_out),dimension(4) :: o_qSTDlevs     = (/ ctrl_out((/ 1, 1, 3, 10, 10 /),'q850'), &
     263                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'q700'), &
     264                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'q500'), &
     265                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'q200') /)
     266
     267  type(ctrl_out),dimension(4) :: o_phiSTDlevs   = (/ ctrl_out((/ 1, 1, 3, 10, 10 /),'phi850'), &
     268                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'phi700'), &
     269                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'phi500'), &
     270                                                     ctrl_out((/ 1, 1, 3, 10, 10 /),'phi200') /)
     271
     272
     273  type(ctrl_out) :: o_t_oce_sic    = ctrl_out((/ 1, 10, 10, 10, 10 /),'t_oce_sic')
     274
     275  type(ctrl_out) :: o_weakinv      = ctrl_out((/ 10, 1, 10, 10, 10 /),'weakinv')
     276  type(ctrl_out) :: o_dthmin       = ctrl_out((/ 10, 1, 10, 10, 10 /),'dthmin')
     277  type(ctrl_out),dimension(4) :: o_u10_srf      = (/ ctrl_out((/ 10, 4, 10, 10, 10 /),'u10_ter'), &
     278                                                     ctrl_out((/ 10, 4, 10, 10, 10 /),'u10_lic'), &
     279                                                     ctrl_out((/ 10, 4, 10, 10, 10 /),'u10_oce'), &
     280                                                     ctrl_out((/ 10, 4, 10, 10, 10 /),'u10_sic') /)
     281
     282  type(ctrl_out),dimension(4) :: o_v10_srf      = (/ ctrl_out((/ 10, 4, 10, 10, 10 /),'v10_ter'), &
     283                                                     ctrl_out((/ 10, 4, 10, 10, 10 /),'v10_lic'), &
     284                                                     ctrl_out((/ 10, 4, 10, 10, 10 /),'v10_oce'), &
     285                                                     ctrl_out((/ 10, 4, 10, 10, 10 /),'v10_sic') /)
     286
     287  type(ctrl_out) :: o_cldtau       = ctrl_out((/ 10, 5, 10, 10, 10 /),'cldtau')                     
     288  type(ctrl_out) :: o_cldemi       = ctrl_out((/ 10, 5, 10, 10, 10 /),'cldemi')
     289  type(ctrl_out) :: o_rh2m         = ctrl_out((/ 10, 5, 10, 10, 10 /),'rh2m')
     290  type(ctrl_out) :: o_qsat2m       = ctrl_out((/ 10, 5, 10, 10, 10 /),'qsat2m')
     291  type(ctrl_out) :: o_tpot         = ctrl_out((/ 10, 5, 10, 10, 10 /),'tpot')
     292  type(ctrl_out) :: o_tpote        = ctrl_out((/ 10, 5, 10, 10, 10 /),'tpote')
     293  type(ctrl_out) :: o_tke          = ctrl_out((/ 4, 10, 10, 10, 10 /),'tke ')
     294  type(ctrl_out) :: o_tke_max      = ctrl_out((/ 4, 10, 10, 10, 10 /),'tke_max')
     295
     296  type(ctrl_out),dimension(4) :: o_tke_srf      = (/ ctrl_out((/ 10, 4, 10, 10, 10 /),'tke_ter'), &
     297                                                     ctrl_out((/ 10, 4, 10, 10, 10 /),'tke_lic'), &
     298                                                     ctrl_out((/ 10, 4, 10, 10, 10 /),'tke_oce'), &
     299                                                     ctrl_out((/ 10, 4, 10, 10, 10 /),'tke_sic') /)
     300
     301  type(ctrl_out),dimension(4) :: o_tke_max_srf  = (/ ctrl_out((/ 10, 4, 10, 10, 10 /),'tke_max_ter'), &
     302                                                     ctrl_out((/ 10, 4, 10, 10, 10 /),'tke_max_lic'), &
     303                                                     ctrl_out((/ 10, 4, 10, 10, 10 /),'tke_max_oce'), &
     304                                                     ctrl_out((/ 10, 4, 10, 10, 10 /),'tke_max_sic') /)
     305
     306  type(ctrl_out) :: o_kz           = ctrl_out((/ 4, 10, 10, 10, 10 /),'kz')
     307  type(ctrl_out) :: o_kz_max       = ctrl_out((/ 4, 10, 10, 10, 10 /),'kz_max')
     308  type(ctrl_out) :: o_SWnetOR      = ctrl_out((/ 10, 10, 2, 10, 10 /),'SWnetOR')
     309  type(ctrl_out) :: o_SWdownOR     = ctrl_out((/ 10, 10, 2, 10, 10 /),'SWdownOR')
     310  type(ctrl_out) :: o_LWdownOR     = ctrl_out((/ 10, 10, 2, 10, 10 /),'LWdownOR')
     311
     312  type(ctrl_out) :: o_snowl        = ctrl_out((/ 10, 1, 10, 10, 10 /),'snowl')
     313  type(ctrl_out) :: o_cape_max     = ctrl_out((/ 10, 1, 10, 10, 10 /),'cape_max')
     314  type(ctrl_out) :: o_solldown     = ctrl_out((/ 10, 1, 10, 1, 10 /),'solldown')
     315
     316  type(ctrl_out) :: o_dtsvdfo      = ctrl_out((/ 10, 10, 10, 1, 10 /),'dtsvdfo')
     317  type(ctrl_out) :: o_dtsvdft      = ctrl_out((/ 10, 10, 10, 1, 10 /),'dtsvdft')
     318  type(ctrl_out) :: o_dtsvdfg      = ctrl_out((/ 10, 10, 10, 1, 10 /),'dtsvdfg')
     319  type(ctrl_out) :: o_dtsvdfi      = ctrl_out((/ 10, 10, 10, 1, 10 /),'dtsvdfi')
     320  type(ctrl_out) :: o_rugs         = ctrl_out((/ 10, 10, 10, 1, 1 /),'rugs')
     321
     322  type(ctrl_out) :: o_topswad      = ctrl_out((/ 4, 10, 10, 10, 10 /),'topswad')
     323  type(ctrl_out) :: o_topswai      = ctrl_out((/ 4, 10, 10, 10, 10 /),'topswai')
     324  type(ctrl_out) :: o_solswad      = ctrl_out((/ 4, 10, 10, 10, 10 /),'solswad')
     325  type(ctrl_out) :: o_solswai      = ctrl_out((/ 4, 10, 10, 10, 10 /),'solswai')
    218326!!!!!!!!!!!!!!!!!!!!!! 3D !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    219   integer, dimension(nfiles) , save :: flag_lwcon        = (/ 2, 5, 10, 10, 1 /)
    220   integer, dimension(nfiles) , save :: flag_iwcon        = (/ 2, 5, 10, 10, 10 /)
    221   integer, dimension(nfiles) , save :: flag_temp         = (/ 2, 3, 4, 1, 1 /)
    222   integer, dimension(nfiles) , save :: flag_theta         = (/ 2, 3, 4, 1, 1 /)
    223   integer, dimension(nfiles) , save :: flag_ovap         = (/ 2, 3, 4, 1, 1 /)
    224   integer, dimension(nfiles) , save :: flag_wvapp        = (/ 2, 10, 10, 10, 10 /)
    225   integer, dimension(nfiles) , save :: flag_geop         = (/ 2, 3, 10, 1, 1 /)
    226   integer, dimension(nfiles) , save :: flag_vitu         = (/ 2, 3, 4, 1, 1 /)
    227   integer, dimension(nfiles) , save :: flag_vitv         = (/ 2, 3, 4, 1, 1 /)
    228   integer, dimension(nfiles) , save :: flag_vitw         = (/ 2, 3, 10, 10, 1 /)
    229   integer, dimension(nfiles) , save :: flag_pres         = (/ 2, 3, 10, 1, 1 /)
    230   integer, dimension(nfiles) , save :: flag_rneb         = (/ 2, 5, 10, 10, 1 /)
    231   integer, dimension(nfiles) , save :: flag_rnebcon      = (/ 2, 5, 10, 10, 1 /)
    232   integer, dimension(nfiles) , save :: flag_rhum         = (/ 2, 10, 10, 10, 10 /)
    233   integer, dimension(nfiles) , save :: flag_ozone        = (/ 2, 10, 10, 10, 10 /)
    234   integer, dimension(nfiles) , save :: flag_upwd         = (/ 2, 10, 10, 10, 10 /)
    235   integer, dimension(nfiles) , save :: flag_dtphy        = (/ 2, 10, 10, 10, 1 /)
    236   integer, dimension(nfiles) , save :: flag_dqphy        = (/ 2, 10, 10, 10, 1 /)
    237   integer, dimension(nfiles) , save :: flag_pr_con_l     = (/ 2, 10, 10, 10, 10 /)
    238   integer, dimension(nfiles) , save :: flag_pr_con_i     = (/ 2, 10, 10, 10, 10 /)
    239   integer, dimension(nfiles) , save :: flag_pr_lsc_l     = (/ 2, 10, 10, 10, 10 /)
    240   integer, dimension(nfiles) , save :: flag_pr_lsc_i     = (/ 2, 10, 10, 10, 10 /)
     327  type(ctrl_out) :: o_lwcon        = ctrl_out((/ 2, 5, 10, 10, 1 /),'lwcon')
     328  type(ctrl_out) :: o_iwcon        = ctrl_out((/ 2, 5, 10, 10, 10 /),'iwcon')
     329  type(ctrl_out) :: o_temp         = ctrl_out((/ 2, 3, 4, 1, 1 /),'temp')
     330  type(ctrl_out) :: o_theta        = ctrl_out((/ 2, 3, 4, 1, 1 /),'theta')
     331  type(ctrl_out) :: o_ovap         = ctrl_out((/ 2, 3, 4, 1, 1 /),'ovap')
     332  type(ctrl_out) :: o_ovapinit         = ctrl_out((/ 2, 3, 4, 1, 1 /),'ovapinit')
     333  type(ctrl_out) :: o_wvapp        = ctrl_out((/ 2, 10, 10, 10, 10 /),'wvapp')
     334  type(ctrl_out) :: o_geop         = ctrl_out((/ 2, 3, 10, 1, 1 /),'geop')
     335  type(ctrl_out) :: o_vitu         = ctrl_out((/ 2, 3, 4, 1, 1 /),'vitu')
     336  type(ctrl_out) :: o_vitv         = ctrl_out((/ 2, 3, 4, 1, 1 /),'vitv')
     337  type(ctrl_out) :: o_vitw         = ctrl_out((/ 2, 3, 10, 10, 1 /),'vitw')
     338  type(ctrl_out) :: o_pres         = ctrl_out((/ 2, 3, 10, 1, 1 /),'pres')
     339  type(ctrl_out) :: o_rneb         = ctrl_out((/ 2, 5, 10, 10, 1 /),'rneb')
     340  type(ctrl_out) :: o_rnebcon      = ctrl_out((/ 2, 5, 10, 10, 1 /),'rnebcon')
     341  type(ctrl_out) :: o_rhum         = ctrl_out((/ 2, 10, 10, 10, 10 /),'rhum')
     342  type(ctrl_out) :: o_ozone        = ctrl_out((/ 2, 10, 10, 10, 10 /),'ozone')
     343  type(ctrl_out) :: o_upwd         = ctrl_out((/ 2, 10, 10, 10, 10 /),'upwd')
     344  type(ctrl_out) :: o_dtphy        = ctrl_out((/ 2, 10, 10, 10, 1 /),'dtphy')
     345  type(ctrl_out) :: o_dqphy        = ctrl_out((/ 2, 10, 10, 10, 1 /),'dqphy')
     346  type(ctrl_out) :: o_pr_con_l     = ctrl_out((/ 2, 10, 10, 10, 10 /),'pr_con_l')
     347  type(ctrl_out) :: o_pr_con_i     = ctrl_out((/ 2, 10, 10, 10, 10 /),'pr_con_i')
     348  type(ctrl_out) :: o_pr_lsc_l     = ctrl_out((/ 2, 10, 10, 10, 10 /),'pr_lsc_l')
     349  type(ctrl_out) :: o_pr_lsc_i     = ctrl_out((/ 2, 10, 10, 10, 10 /),'pr_lsc_i')
    241350!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    242351
    243   integer, dimension(nfiles) , save :: flag_albe_sol     = (/ 3, 4, 10, 1, 10 /)
    244   integer, dimension(nfiles) , save :: flag_ages_sol     = (/ 3, 10, 10, 10, 10 /)
    245   integer, dimension(nfiles) , save :: flag_rugs_sol     = (/ 3, 4, 10, 1, 10 /)
    246 
    247   integer, dimension(nfiles) , save :: flag_albs         = (/ 3, 10, 10, 1, 10 /)
    248   integer, dimension(nfiles) , save :: flag_albslw       = (/ 3, 10, 10, 1, 10 /)
    249 
    250   integer, dimension(nfiles) , save :: flag_clwcon       = (/ 4, 10, 10, 10, 10 /)
    251   integer, dimension(nfiles) , save :: flag_Ma           = (/ 4, 10, 10, 10, 10 /)
    252   integer, dimension(nfiles) , save :: flag_dnwd         = (/ 4, 10, 10, 10, 10 /)
    253   integer, dimension(nfiles) , save :: flag_dnwd0        = (/ 4, 10, 10, 10, 10 /)
    254   integer, dimension(nfiles) , save :: flag_dtdyn        = (/ 4, 10, 10, 10, 1 /)
    255   integer, dimension(nfiles) , save :: flag_dqdyn        = (/ 4, 10, 10, 10, 1 /)
    256   integer, dimension(nfiles) , save :: flag_dudyn        = (/ 4, 10, 10, 10, 1 /) !AXC
    257   integer, dimension(nfiles) , save :: flag_dvdyn        = (/ 4, 10, 10, 10, 1 /) !AXC
    258   integer, dimension(nfiles) , save :: flag_dtcon        = (/ 4, 5, 10, 10, 10 /)
    259   integer, dimension(nfiles) , save :: flag_ducon        = (/ 4, 10, 10, 10, 10 /)
    260   integer, dimension(nfiles) , save :: flag_dqcon        = (/ 4, 5, 10, 10, 10 /)
    261   integer, dimension(nfiles) , save :: flag_dtwak        = (/ 4, 5, 10, 10, 10 /)
    262   integer, dimension(nfiles) , save :: flag_dqwak        = (/ 4, 5, 10, 10, 10 /)
    263   integer, dimension(nfiles) , save :: flag_wake_h       = (/ 4, 5, 10, 10, 10 /)
    264   integer, dimension(nfiles) , save :: flag_wake_s       = (/ 4, 5, 10, 10, 10 /)
    265   integer, dimension(nfiles) , save :: flag_wake_deltat  = (/ 4, 5, 10, 10, 10 /)
    266   integer, dimension(nfiles) , save :: flag_wake_deltaq  = (/ 4, 5, 10, 10, 10 /)
    267   integer, dimension(nfiles) , save :: flag_wake_omg     = (/ 4, 5, 10, 10, 10 /)
    268   integer, dimension(nfiles) , save :: flag_Vprecip      = (/ 4, 5, 10, 10, 10 /)
    269   integer, dimension(nfiles) , save :: flag_ftd          = (/ 4, 5, 10, 10, 10 /)
    270   integer, dimension(nfiles) , save :: flag_fqd          = (/ 4, 5, 10, 10, 10 /)
    271   integer, dimension(nfiles) , save :: flag_dtlsc        = (/ 4, 10, 10, 10, 10 /)
    272   integer, dimension(nfiles) , save :: flag_dtlschr      = (/ 4, 10, 10, 10, 10 /)
    273   integer, dimension(nfiles) , save :: flag_dqlsc        = (/ 4, 10, 10, 10, 10 /)
    274   integer, dimension(nfiles) , save :: flag_dtvdf        = (/ 4, 10, 10, 1, 10 /)
    275   integer, dimension(nfiles) , save :: flag_dqvdf        = (/ 4, 10, 10, 1, 10 /)
    276   integer, dimension(nfiles) , save :: flag_dteva        = (/ 4, 10, 10, 10, 10 /)
    277   integer, dimension(nfiles) , save :: flag_dqeva        = (/ 4, 10, 10, 10, 10 /)
    278   integer, dimension(nfiles) , save :: flag_ptconv       = (/ 4, 10, 10, 10, 10 /)
    279   integer, dimension(nfiles) , save :: flag_ratqs        = (/ 4, 10, 10, 10, 10 /)
    280   integer, dimension(nfiles) , save :: flag_dtthe        = (/ 4, 10, 10, 10, 10 /)
    281   integer, dimension(nfiles) , save :: flag_f_th        = (/ 4, 10, 10, 10, 10 /)
    282   integer, dimension(nfiles) , save :: flag_e_th        = (/ 4, 10, 10, 10, 10 /)
    283   integer, dimension(nfiles) , save :: flag_w_th        = (/ 4, 10, 10, 10, 10 /)
    284   integer, dimension(nfiles) , save :: flag_lambda_th        = (/ 4, 10, 10, 10, 10 /)
    285   integer, dimension(nfiles) , save :: flag_q_th        = (/ 4, 10, 10, 10, 10 /)
    286   integer, dimension(nfiles) , save :: flag_a_th        = (/ 4, 10, 10, 10, 10 /)
    287   integer, dimension(nfiles) , save :: flag_d_th        = (/ 4, 10, 10, 10, 10 /)
    288   integer, dimension(nfiles) , save :: flag_f0_th        = (/ 4, 10, 10, 10, 10 /)
    289   integer, dimension(nfiles) , save :: flag_zmax_th        = (/ 4, 10, 10, 10, 10 /)
    290   integer, dimension(nfiles) , save :: flag_dqthe        = (/ 4, 10, 10, 10, 1 /)
    291   integer, dimension(nfiles) , save :: flag_dtajs        = (/ 4, 10, 10, 10, 10 /)
    292   integer, dimension(nfiles) , save :: flag_dqajs        = (/ 4, 10, 10, 10, 10 /)
    293   integer, dimension(nfiles) , save :: flag_dtswr        = (/ 4, 10, 10, 10, 1 /)
    294   integer, dimension(nfiles) , save :: flag_dtsw0        = (/ 4, 10, 10, 10, 10 /)
    295   integer, dimension(nfiles) , save :: flag_dtlwr        = (/ 4, 10, 10, 10, 1 /)
    296   integer, dimension(nfiles) , save :: flag_dtlw0        = (/ 4, 10, 10, 10, 10 /)
    297   integer, dimension(nfiles) , save :: flag_dtec         = (/ 4, 10, 10, 10, 10 /)
    298   integer, dimension(nfiles) , save :: flag_duvdf        = (/ 4, 10, 10, 10, 10 /)
    299   integer, dimension(nfiles) , save :: flag_dvvdf        = (/ 4, 10, 10, 10, 10 /)
    300   integer, dimension(nfiles) , save :: flag_duoro        = (/ 4, 10, 10, 10, 10 /)
    301   integer, dimension(nfiles) , save :: flag_dvoro        = (/ 4, 10, 10, 10, 10 /)
    302   integer, dimension(nfiles) , save :: flag_dulif        = (/ 4, 10, 10, 10, 10 /)
    303   integer, dimension(nfiles) , save :: flag_dvlif        = (/ 4, 10, 10, 10, 10 /)
    304   integer, dimension(nfiles) , save :: flag_trac         = (/ 4, 10, 10, 10, 10 /)
    305 
     352  type(ctrl_out),dimension(4) :: o_albe_srf     = (/ ctrl_out((/ 3, 4, 10, 1, 10 /),'albe_ter'), &
     353                                                     ctrl_out((/ 3, 4, 10, 1, 10 /),'albe_lic'), &
     354                                                     ctrl_out((/ 3, 4, 10, 1, 10 /),'albe_oce'), &
     355                                                     ctrl_out((/ 3, 4, 10, 1, 10 /),'albe_sic') /)
     356
     357  type(ctrl_out),dimension(4) :: o_ages_srf     = (/ ctrl_out((/ 3, 10, 10, 10, 10 /),'ages_ter'), &
     358                                                     ctrl_out((/ 3, 10, 10, 10, 10 /),'ages_lic'), &
     359                                                     ctrl_out((/ 3, 10, 10, 10, 10 /),'ages_oce'), &
     360                                                     ctrl_out((/ 3, 10, 10, 10, 10 /),'ages_sic') /)
     361
     362  type(ctrl_out),dimension(4) :: o_rugs_srf     = (/ ctrl_out((/ 3, 4, 10, 1, 10 /),'rugs_ter'), &
     363                                                     ctrl_out((/ 3, 4, 10, 1, 10 /),'rugs_lic'), &
     364                                                     ctrl_out((/ 3, 4, 10, 1, 10 /),'rugs_oce'), &
     365                                                     ctrl_out((/ 3, 4, 10, 1, 10 /),'rugs_sic') /)
     366
     367  type(ctrl_out) :: o_albs         = ctrl_out((/ 3, 10, 10, 1, 10 /),'albs')
     368  type(ctrl_out) :: o_albslw       = ctrl_out((/ 3, 10, 10, 1, 10 /),'albslw')
     369
     370  type(ctrl_out) :: o_clwcon       = ctrl_out((/ 4, 10, 10, 10, 10 /),'clwcon')
     371  type(ctrl_out) :: o_Ma           = ctrl_out((/ 4, 10, 10, 10, 10 /),'Ma')
     372  type(ctrl_out) :: o_dnwd         = ctrl_out((/ 4, 10, 10, 10, 10 /),'dnwd')
     373  type(ctrl_out) :: o_dnwd0        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dnwd0')
     374  type(ctrl_out) :: o_dtdyn        = ctrl_out((/ 4, 10, 10, 10, 1 /),'dtdyn')
     375  type(ctrl_out) :: o_dqdyn        = ctrl_out((/ 4, 10, 10, 10, 1 /),'dqdyn')
     376  type(ctrl_out) :: o_dudyn        = ctrl_out((/ 4, 10, 10, 10, 1 /),'dudyn')  !AXC
     377  type(ctrl_out) :: o_dvdyn        = ctrl_out((/ 4, 10, 10, 10, 1 /),'dvdyn')  !AXC
     378  type(ctrl_out) :: o_dtcon        = ctrl_out((/ 4, 5, 10, 10, 10 /),'dtcon')
     379  type(ctrl_out) :: o_ducon        = ctrl_out((/ 4, 10, 10, 10, 10 /),'ducon')
     380  type(ctrl_out) :: o_dqcon        = ctrl_out((/ 4, 5, 10, 10, 10 /),'dqcon')
     381  type(ctrl_out) :: o_dtwak        = ctrl_out((/ 4, 5, 10, 10, 10 /),'dtwak')
     382  type(ctrl_out) :: o_dqwak        = ctrl_out((/ 4, 5, 10, 10, 10 /),'dqwak')
     383  type(ctrl_out) :: o_wake_h       = ctrl_out((/ 4, 5, 10, 10, 10 /),'wake_h')
     384  type(ctrl_out) :: o_wake_s       = ctrl_out((/ 4, 5, 10, 10, 10 /),'wake_s')
     385  type(ctrl_out) :: o_wake_deltat  = ctrl_out((/ 4, 5, 10, 10, 10 /),'wake_deltat')
     386  type(ctrl_out) :: o_wake_deltaq  = ctrl_out((/ 4, 5, 10, 10, 10 /),'wake_deltaq')
     387  type(ctrl_out) :: o_wake_omg     = ctrl_out((/ 4, 5, 10, 10, 10 /),'wake_omg')
     388  type(ctrl_out) :: o_Vprecip      = ctrl_out((/ 10, 10, 10, 10, 10 /),'Vprecip')
     389  type(ctrl_out) :: o_ftd          = ctrl_out((/ 4, 5, 10, 10, 10 /),'ftd')
     390  type(ctrl_out) :: o_fqd          = ctrl_out((/ 4, 5, 10, 10, 10 /),'fqd')
     391  type(ctrl_out) :: o_dtlsc        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dtlsc')
     392  type(ctrl_out) :: o_dtlschr      = ctrl_out((/ 4, 10, 10, 10, 10 /),'dtlschr')
     393  type(ctrl_out) :: o_dqlsc        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dqlsc')
     394  type(ctrl_out) :: o_dtvdf        = ctrl_out((/ 4, 10, 10, 1, 10 /),'dtvdf')
     395  type(ctrl_out) :: o_dqvdf        = ctrl_out((/ 4, 10, 10, 1, 10 /),'dqvdf')
     396  type(ctrl_out) :: o_dteva        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dteva')
     397  type(ctrl_out) :: o_dqeva        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dqeva')
     398  type(ctrl_out) :: o_ptconv       = ctrl_out((/ 4, 10, 10, 10, 10 /),'ptconv')
     399  type(ctrl_out) :: o_ratqs        = ctrl_out((/ 4, 10, 10, 10, 10 /),'ratqs')
     400  type(ctrl_out) :: o_dtthe        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dtthe')
     401  type(ctrl_out) :: o_f_th         = ctrl_out((/ 4, 10, 10, 10, 10 /),'f_th')
     402  type(ctrl_out) :: o_e_th         = ctrl_out((/ 4, 10, 10, 10, 10 /),'e_th')
     403  type(ctrl_out) :: o_w_th         = ctrl_out((/ 4, 10, 10, 10, 10 /),'w_th')
     404  type(ctrl_out) :: o_lambda_th    = ctrl_out((/ 4, 10, 10, 10, 10 /),'lambda_th')
     405  type(ctrl_out) :: o_q_th         = ctrl_out((/ 4, 10, 10, 10, 10 /),'q_th')
     406  type(ctrl_out) :: o_a_th         = ctrl_out((/ 4, 10, 10, 10, 10 /),'a_th')
     407  type(ctrl_out) :: o_d_th         = ctrl_out((/ 4, 10, 10, 10, 10 /),'d_th')
     408  type(ctrl_out) :: o_f0_th        = ctrl_out((/ 4, 10, 10, 10, 10 /),'f0_th')
     409  type(ctrl_out) :: o_zmax_th      = ctrl_out((/ 4, 10, 10, 10, 10 /),'zmax_th')
     410  type(ctrl_out) :: o_dqthe        = ctrl_out((/ 4, 10, 10, 10, 1 /),'dqthe')
     411  type(ctrl_out) :: o_dtajs        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dtajs')
     412  type(ctrl_out) :: o_dqajs        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dqajs')
     413  type(ctrl_out) :: o_dtswr        = ctrl_out((/ 4, 10, 10, 10, 1 /),'dtswr')
     414  type(ctrl_out) :: o_dtsw0        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dtsw0')
     415  type(ctrl_out) :: o_dtlwr        = ctrl_out((/ 4, 10, 10, 10, 1 /),'dtlwr')
     416  type(ctrl_out) :: o_dtlw0        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dtlw0')
     417  type(ctrl_out) :: o_dtec         = ctrl_out((/ 4, 10, 10, 10, 10 /),'dtec')
     418  type(ctrl_out) :: o_duvdf        = ctrl_out((/ 4, 10, 10, 10, 10 /),'duvdf')
     419  type(ctrl_out) :: o_dvvdf        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dvvdf')
     420  type(ctrl_out) :: o_duoro        = ctrl_out((/ 4, 10, 10, 10, 10 /),'duoro')
     421  type(ctrl_out) :: o_dvoro        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dvoro')
     422  type(ctrl_out) :: o_dulif        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dulif')
     423  type(ctrl_out) :: o_dvlif        = ctrl_out((/ 4, 10, 10, 10, 10 /),'dvlif')
     424
     425! Attention a refaire correctement
     426  type(ctrl_out),dimension(2) :: o_trac         = (/ ctrl_out((/ 4, 10, 10, 10, 10 /),'trac01'), &
     427                                                     ctrl_out((/ 4, 10, 10, 10, 10 /),'trac02') /)
    306428    CONTAINS
    307429
    … …  
    311433!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    312434 
    313   SUBROUTINE phys_output_open(jjmp1,nqmax,nlevSTD,clevSTD,nbteta, &
     435  SUBROUTINE phys_output_open(jjmp1,nlevSTD,clevSTD,nbteta, &
    314436                              ctetaSTD,dtime, presnivs, ok_veget, &
    315                               ocean, iflag_pbl,ok_mensuel,ok_journe, &
    316                               ok_hf,ok_instan,ok_LES)   
     437                              type_ocean, iflag_pbl,ok_mensuel,ok_journe, &
     438                              ok_hf,ok_instan,ok_LES,ok_ade,ok_aie)   
    317439
    318440  USE iophy
    319441  USE dimphy
     442  USE infotrac
    320443  USE ioipsl
    321444  USE mod_phys_lmdz_para
    … …  
    325448  include "temps.h"
    326449  include "indicesol.h"
    327   include "advtrac.h"
    328450  include "clesphys.h"
    329451  include "thermcell.h"
    330452
    331   integer                               :: jjmp1, nqmax
     453  integer                               :: jjmp1
    332454  integer                               :: nbteta, nlevSTD, radpas
    333455  logical                               :: ok_mensuel, ok_journe, ok_hf, ok_instan
    334   logical                               :: ok_LES
     456  logical                               :: ok_LES,ok_ade,ok_aie
    335457  real                                  :: dtime
    336458  integer                               :: idayref
    … …  
    338460  real, dimension(klev)                 :: presnivs
    339461  character(len=4), dimension(nlevSTD)  :: clevSTD
    340   integer                               :: nsrf, k, iq, iiq, iff, i, j
     462  integer                               :: nsrf, k, iq, iiq, iff, i, j, ilev
    341463  logical                               :: ok_veget
    342464  integer                               :: iflag_pbl
    343   CHARACTER(len=3)                      :: bb2
     465  CHARACTER(len=4)                      :: bb2
    344466  CHARACTER(len=2)                      :: bb3
    345   character(len=6)                      :: ocean
     467  character(len=6)                      :: type_ocean
    346468  CHARACTER(len=3)                      :: ctetaSTD(nbteta)
    347469  real, dimension(nfiles)               :: ecrit_files
    … …  
    355477!                 entre [lonmin_reg,lonmax_reg] et [latmin_reg,latmax_reg]
    356478
    357   logical, dimension(nfiles), save  :: ok_reglim         = (/ .false., .false., .false., .false., .true. /) 
     479  logical, dimension(nfiles), save  :: ok_reglim         = (/ .false., .false., .false., .false., .true. /)
    358480  real, dimension(nfiles), save     :: lonmin_reg        = (/ 0., -45., 0., 0., -162. /)
    359481  real, dimension(nfiles), save     :: lonmax_reg        = (/ 90., 45., 90., 90., -144. /)
    … …  
    456578!     &                     nhorim, nid_hf3d)
    457579
    458 !         CALL histvert(nid_hf3d,"presnivs", &
    459 !     &                 "Vertical levels","mb", &
     580!         CALL histvert(nid_hf3d, "presnivs", &
     581!     &                 "Vertical levels", "mb", &
    460582!     &                 klev, presnivs/100., nvertm)
    461583!          ENDIF
    462584
    463585!!! Champs 1D !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    464  CALL histdef2d(iff,flag_phis,"phis","Surface geop.height","m2/s2")
     586 CALL histdef2d(iff,o_phis%flag,o_phis%name,"Surface geop.height", "m2/s2")
    465587   type_ecri(1) = 'once'
    466588   type_ecri(2) = 'once'
    467589   type_ecri(3) = 'once'
    468590   type_ecri(4) = 'once'
    469  CALL histdef2d(iff,flag_aire,"aire","Grid area","-")
    470  CALL histdef2d(iff,flag_contfracATM,"contfracATM","% sfce ter+lic","-")
     591   type_ecri(5) = 'once'
     592 CALL histdef2d(iff,o_aire%flag,o_aire%name,"Grid area", "-")
     593 CALL histdef2d(iff,o_contfracATM%flag,o_contfracATM%name,"% sfce ter+lic", "-")
    471594   type_ecri(1) = 'ave(X)'
    472595   type_ecri(2) = 'ave(X)'
    473596   type_ecri(3) = 'ave(X)'
    474597   type_ecri(4) = 'inst(X)'
     598   type_ecri(5) = 'ave(X)'
    475599
    476600!!! Champs 2D !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    477  CALL histdef2d(iff,flag_contfracOR,"contfracOR","% sfce terre OR","-" )
    478  CALL histdef2d(iff,flag_aireTER,"aireTER","Grid area CONT","-" )
    479  CALL histdef2d(iff,flag_flat,"flat","Latent heat flux","W/m2")
    480  CALL histdef2d(iff,flag_slp,"slp","Sea Level Pressure", "Pa" )
    481  CALL histdef2d(iff,flag_tsol,"tsol","Surface Temperature", "K")
    482  CALL histdef2d( iff,flag_t2m,"t2m","Temperature 2m", "K" )
    483  CALL histdef2d(iff,flag_t2m_min,"t2m_min","Temp 2m min", "K" )
    484  CALL histdef2d(iff,flag_t2m_max,"t2m_max", "Temp 2m max", "K" )
    485  CALL histdef2d(iff,flag_wind10m,"wind10m","10-m wind speed","m/s")
    486  CALL histdef2d(iff,flag_wind10max,"wind10max","10m wind speed max","m/s")
    487  CALL histdef2d(iff,flag_sicf,"sicf","Sea-ice fraction", "-" )
    488  CALL histdef2d(iff,flag_q2m,"q2m","Specific humidity 2m", "kg/kg")
    489  CALL histdef2d(iff,flag_u10m,"u10m","Vent zonal 10m", "m/s" )
    490  CALL histdef2d(iff,flag_v10m,"v10m","Vent meridien 10m", "m/s")
    491  CALL histdef2d(iff,flag_psol,"psol","Surface Pressure","Pa" )
    492  CALL histdef2d(iff,flag_qsurf,"qsurf","Surface Air humidity", "kg/kg")
     601 CALL histdef2d(iff,o_contfracOR%flag,o_contfracOR%name,"% sfce terre OR", "-" )
     602 CALL histdef2d(iff,o_aireTER%flag,o_aireTER%name,"Grid area CONT", "-" )
     603 CALL histdef2d(iff,o_flat%flag,o_flat%name, "Latent heat flux", "W/m2")
     604 CALL histdef2d(iff,o_slp%flag,o_slp%name, "Sea Level Pressure", "Pa" )
     605 CALL histdef2d(iff,o_tsol%flag,o_tsol%name, "Surface Temperature", "K")
     606 CALL histdef2d(iff,o_t2m%flag,o_t2m%name, "Temperature 2m", "K" )
     607   type_ecri(1) = 't_min(X)'
     608   type_ecri(2) = 't_min(X)'
     609   type_ecri(3) = 't_min(X)'
     610   type_ecri(4) = 't_min(X)'
     611   type_ecri(5) = 't_min(X)'
     612 CALL histdef2d(iff,o_t2m_min%flag,o_t2m_min%name, "Temp 2m min", "K" )
     613   type_ecri(1) = 't_max(X)'
     614   type_ecri(2) = 't_max(X)'
     615   type_ecri(3) = 't_max(X)'
     616   type_ecri(4) = 't_max(X)'
     617   type_ecri(5) = 't_max(X)'
     618 CALL histdef2d(iff,o_t2m_max%flag,o_t2m_max%name, "Temp 2m max", "K" )
     619   type_ecri(1) = 'ave(X)'
     620   type_ecri(2) = 'ave(X)'
     621   type_ecri(3) = 'ave(X)'
     622   type_ecri(4) = 'inst(X)'
     623   type_ecri(5) = 'ave(X)'
     624 CALL histdef2d(iff,o_wind10m%flag,o_wind10m%name, "10-m wind speed", "m/s")
     625 CALL histdef2d(iff,o_wind10max%flag,o_wind10max%name, "10m wind speed max", "m/s")
     626 CALL histdef2d(iff,o_sicf%flag,o_sicf%name, "Sea-ice fraction", "-" )
     627 CALL histdef2d(iff,o_q2m%flag,o_q2m%name, "Specific humidity 2m", "kg/kg")
     628 CALL histdef2d(iff,o_u10m%flag,o_u10m%name, "Vent zonal 10m", "m/s" )
     629 CALL histdef2d(iff,o_v10m%flag,o_v10m%name, "Vent meridien 10m", "m/s")
     630 CALL histdef2d(iff,o_psol%flag,o_psol%name, "Surface Pressure", "Pa" )
     631 CALL histdef2d(iff,o_qsurf%flag,o_qsurf%name, "Surface Air humidity", "kg/kg")
    493632
    494633  if (.not. ok_veget) then
    495  CALL histdef2d(iff,flag_qsol,"qsol","Soil watter content", "mm" )
     634 CALL histdef2d(iff,o_qsol%flag,o_qsol%name, "Soil watter content", "mm" )
    496635  endif
    497636
    498  CALL histdef2d(iff,flag_ndayrain,"ndayrain","Number of dayrain(liq+sol)","-")
    499  CALL histdef2d(iff,flag_precip,"precip","Precip Totale liq+sol","kg/(s*m2)" )
    500  CALL histdef2d(iff,flag_plul,"plul","Large-scale Precip.","kg/(s*m2)")
    501  CALL histdef2d(iff,flag_pluc,"pluc","Convective Precip.","kg/(s*m2)")
    502  CALL histdef2d(iff,flag_snow,"snow","Snow fall","kg/(s*m2)" )
    503  CALL histdef2d(iff,flag_evap,"evap","Evaporat", "kg/(s*m2)" )
    504  CALL histdef2d(iff,flag_tops,"tops","Solar rad. at TOA","W/m2")
    505  CALL histdef2d(iff,flag_tops0,"tops0","CS Solar rad. at TOA", "W/m2")
    506  CALL histdef2d(iff,flag_topl,"topl","IR rad. at TOA", "W/m2" )
    507  CALL histdef2d(iff,flag_topl0,"topl0", "IR rad. at TOA","W/m2")
    508  CALL histdef2d(iff,flag_SWupTOA,"SWupTOA","SWup at TOA","W/m2")
    509  CALL histdef2d(iff,flag_SWupTOAclr,"SWupTOAclr","SWup clear sky at TOA","W/m2")
    510  CALL histdef2d(iff,flag_SWdnTOA, "SWdnTOA","SWdn at TOA","W/m2" )
    511  CALL histdef2d(iff,flag_SWdnTOAclr,"SWdnTOAclr","SWdn clear sky at TOA","W/m2")
    512  CALL histdef2d(iff,flag_SWup200,"SWup200","SWup at 200mb","W/m2" )
    513  CALL histdef2d(iff,flag_SWup200clr,"SWup200clr","SWup clear sky at 200mb","W/m2")
    514  CALL histdef2d(iff,flag_SWdn200,"SWdn200","SWdn at 200mb","W/m2" )
    515  CALL histdef2d(iff,flag_SWdn200clr,"SWdn200clr","SWdn clear sky at 200mb","W/m2")
    516  CALL histdef2d(iff,flag_LWup200,"LWup200","LWup at 200mb","W/m2")
    517  CALL histdef2d(iff,flag_LWup200clr, "LWup200clr","LWup clear sky at 200mb","W/m2")
    518  CALL histdef2d(iff,flag_LWdn200,"LWdn200","LWdn at 200mb","W/m2")
    519  CALL histdef2d(iff,flag_LWdn200clr, "LWdn200clr","LWdn clear sky at 200mb","W/m2")
    520  CALL histdef2d(iff,flag_sols,"sols","Solar rad. at surf.","W/m2")
    521  CALL histdef2d(iff,flag_sols0,"sols0","Solar rad. at surf.","W/m2")
    522  CALL histdef2d(iff,flag_soll,"soll","IR rad. at surface","W/m2") 
    523  CALL histdef2d(iff,flag_radsol,"radsol","Rayonnement au sol","W/m2")
    524  CALL histdef2d(iff,flag_soll0,"soll0","IR rad. at surface","W/m2")
    525  CALL histdef2d(iff,flag_SWupSFC,"SWupSFC","SWup at surface","W/m2")
    526  CALL histdef2d(iff,flag_SWupSFCclr,"SWupSFCclr","SWup clear sky at surface","W/m2")
    527  CALL histdef2d(iff,flag_SWdnSFC,"SWdnSFC","SWdn at surface","W/m2")
    528  CALL histdef2d(iff,flag_SWdnSFCclr,"SWdnSFCclr","SWdn clear sky at surface","W/m2")
    529  CALL histdef2d(iff,flag_LWupSFC,"LWupSFC","Upwd. IR rad. at surface","W/m2")
    530  CALL histdef2d(iff,flag_LWdnSFC,"LWdnSFC","Down. IR rad. at surface","W/m2")
    531  CALL histdef2d(iff,flag_LWupSFCclr,"LWupSFCclr","CS Upwd. IR rad. at surface","W/m2")
    532  CALL histdef2d(iff,flag_LWdnSFCclr,"LWdnSFCclr","Down. CS IR rad. at surface","W/m2")
    533  CALL histdef2d(iff,flag_bils,"bils","Surf. total heat flux","W/m2")
    534  CALL histdef2d(iff,flag_sens,"sens","Sensible heat flux","W/m2")
    535  CALL histdef2d(iff,flag_fder,"fder","Heat flux derivation","W/m2")
    536  CALL histdef2d(iff,flag_ffonte,"ffonte","Thermal flux for snow melting","W/m2")
    537  CALL histdef2d(iff,flag_fqcalving,"fqcalving","Ice Calving","kg/m2/s")
    538  CALL histdef2d(iff,flag_fqfonte,"fqfonte","Land ice melt","kg/m2/s")
     637 CALL histdef2d(iff,o_ndayrain%flag,o_ndayrain%name, "Number of dayrain(liq+sol)", "-")
     638 CALL histdef2d(iff,o_precip%flag,o_precip%name, "Precip Totale liq+sol", "kg/(s*m2)" )
     639 CALL histdef2d(iff,o_plul%flag,o_plul%name, "Large-scale Precip.", "kg/(s*m2)")
     640 CALL histdef2d(iff,o_pluc%flag,o_pluc%name, "Convective Precip.", "kg/(s*m2)")
     641 CALL histdef2d(iff,o_snow%flag,o_snow%name, "Snow fall", "kg/(s*m2)" )
     642 CALL histdef2d(iff,o_evap%flag,o_evap%name, "Evaporat", "kg/(s*m2)" )
     643 CALL histdef2d(iff,o_tops%flag,o_tops%name, "Solar rad. at TOA", "W/m2")
     644 CALL histdef2d(iff,o_tops0%flag,o_tops0%name, "CS Solar rad. at TOA", "W/m2")
     645 CALL histdef2d(iff,o_topl%flag,o_topl%name, "IR rad. at TOA", "W/m2" )
     646 CALL histdef2d(iff,o_topl0%flag,o_topl0%name, "IR rad. at TOA", "W/m2")
     647 CALL histdef2d(iff,o_SWupTOA%flag,o_SWupTOA%name, "SWup at TOA", "W/m2")
     648 CALL histdef2d(iff,o_SWupTOAclr%flag,o_SWupTOAclr%name, "SWup clear sky at TOA", "W/m2")
     649 CALL histdef2d(iff,o_SWdnTOA%flag,o_SWdnTOA%name, "SWdn at TOA", "W/m2" )
     650 CALL histdef2d(iff,o_SWdnTOAclr%flag,o_SWdnTOAclr%name, "SWdn clear sky at TOA", "W/m2")
     651 CALL histdef2d(iff,o_SWup200%flag,o_SWup200%name, "SWup at 200mb", "W/m2" )
     652 CALL histdef2d(iff,o_SWup200clr%flag,o_SWup200clr%name, "SWup clear sky at 200mb", "W/m2")
     653 CALL histdef2d(iff,o_SWdn200%flag,o_SWdn200%name, "SWdn at 200mb", "W/m2" )
     654 CALL histdef2d(iff,o_SWdn200clr%flag,o_SWdn200clr%name, "SWdn clear sky at 200mb", "W/m2")
     655 CALL histdef2d(iff,o_LWup200%flag,o_LWup200%name, "LWup at 200mb", "W/m2")
     656 CALL histdef2d(iff,o_LWup200clr%flag,o_LWup200clr%name, "LWup clear sky at 200mb", "W/m2")
     657 CALL histdef2d(iff,o_LWdn200%flag,o_LWdn200%name, "LWdn at 200mb", "W/m2")
     658 CALL histdef2d(iff,o_LWdn200clr%flag,o_LWdn200clr%name, "LWdn clear sky at 200mb", "W/m2")
     659 CALL histdef2d(iff,o_sols%flag,o_sols%name, "Solar rad. at surf.", "W/m2")
     660 CALL histdef2d(iff,o_sols0%flag,o_sols0%name, "Solar rad. at surf.", "W/m2")
     661 CALL histdef2d(iff,o_soll%flag,o_soll%name, "IR rad. at surface", "W/m2") 
     662 CALL histdef2d(iff,o_radsol%flag,o_radsol%name, "Rayonnement au sol", "W/m2")
     663 CALL histdef2d(iff,o_soll0%flag,o_soll0%name, "IR rad. at surface", "W/m2")
     664 CALL histdef2d(iff,o_SWupSFC%flag,o_SWupSFC%name, "SWup at surface", "W/m2")
     665 CALL histdef2d(iff,o_SWupSFCclr%flag,o_SWupSFCclr%name, "SWup clear sky at surface", "W/m2")
     666 CALL histdef2d(iff,o_SWdnSFC%flag,o_SWdnSFC%name, "SWdn at surface", "W/m2")
     667 CALL histdef2d(iff,o_SWdnSFCclr%flag,o_SWdnSFCclr%name, "SWdn clear sky at surface", "W/m2")
     668 CALL histdef2d(iff,o_LWupSFC%flag,o_LWupSFC%name, "Upwd. IR rad. at surface", "W/m2")
     669 CALL histdef2d(iff,o_LWdnSFC%flag,o_LWdnSFC%name, "Down. IR rad. at surface", "W/m2")
     670 CALL histdef2d(iff,o_LWupSFCclr%flag,o_LWupSFCclr%name, "CS Upwd. IR rad. at surface", "W/m2")
     671 CALL histdef2d(iff,o_LWdnSFCclr%flag,o_LWdnSFCclr%name, "Down. CS IR rad. at surface", "W/m2")
     672 CALL histdef2d(iff,o_bils%flag,o_bils%name, "Surf. total heat flux", "W/m2")
     673 CALL histdef2d(iff,o_sens%flag,o_sens%name, "Sensible heat flux", "W/m2")
     674 CALL histdef2d(iff,o_fder%flag,o_fder%name, "Heat flux derivation", "W/m2")
     675 CALL histdef2d(iff,o_ffonte%flag,o_ffonte%name, "Thermal flux for snow melting", "W/m2")
     676 CALL histdef2d(iff,o_fqcalving%flag,o_fqcalving%name, "Ice Calving", "kg/m2/s")
     677 CALL histdef2d(iff,o_fqfonte%flag,o_fqfonte%name, "Land ice melt", "kg/m2/s")
    539678
    540679     DO nsrf = 1, nbsrf
    541  CALL histdef2d(iff,flag_pourc_sol,"pourc_"//clnsurf(nsrf),"% "//clnsurf(nsrf),"%")
    542  CALL histdef2d(iff,flag_fract_sol,"fract_"//clnsurf(nsrf),"Fraction "//clnsurf(nsrf),"1")
    543  CALL histdef2d(iff,flag_taux_sol,"taux_"//clnsurf(nsrf),"Zonal wind stress"//clnsurf(nsrf),"Pa")
    544  CALL histdef2d(iff,flag_tauy_sol,"tauy_"//clnsurf(nsrf),"Meridional wind stress "//clnsurf(nsrf),"Pa")
    545  CALL histdef2d(iff,flag_tsol_sol,"tsol_"//clnsurf(nsrf),"Temperature "//clnsurf(nsrf),"K")
    546  CALL histdef2d(iff,flag_u10m_sol,"u10m_"//clnsurf(nsrf),"Vent Zonal 10m "//clnsurf(nsrf),"m/s")
    547  CALL histdef2d(iff,flag_v10m_sol,"v10m_"//clnsurf(nsrf),"Vent meredien 10m "//clnsurf(nsrf),"m/s")
    548  CALL histdef2d(iff,flag_t2m_sol,"t2m_"//clnsurf(nsrf),"Temp 2m "//clnsurf(nsrf),"K")
    549  CALL histdef2d(iff,flag_sens_sol,"sens_"//clnsurf(nsrf),"Sensible heat flux "//clnsurf(nsrf),"W/m2")
    550  CALL histdef2d(iff,flag_lat_sol,"lat_"//clnsurf(nsrf),"Latent heat flux "//clnsurf(nsrf),"W/m2")
    551  CALL histdef2d(iff,flag_flw_sol,"flw_"//clnsurf(nsrf),"LW "//clnsurf(nsrf),"W/m2")
    552  CALL histdef2d(iff,flag_fsw_sol,"fsw_"//clnsurf(nsrf),"SW "//clnsurf(nsrf),"W/m2")
    553  CALL histdef2d(iff,flag_wbils_sol,"wbils_"//clnsurf(nsrf),"Bilan sol "//clnsurf(nsrf),"W/m2" )
    554  CALL histdef2d(iff,flag_wbilo_sol,"wbilo_"//clnsurf(nsrf),"Bilan eau "//clnsurf(nsrf),"kg/(m2*s)")
     680 CALL histdef2d(iff,o_pourc_srf(nsrf)%flag,o_pourc_srf(nsrf)%name,"% "//clnsurf(nsrf),"%")
     681 CALL histdef2d(iff,o_fract_srf(nsrf)%flag,o_fract_srf(nsrf)%name,"Fraction "//clnsurf(nsrf),"1")
     682 CALL histdef2d(iff,o_taux_srf(nsrf)%flag,o_taux_srf(nsrf)%name,"Zonal wind stress"//clnsurf(nsrf),"Pa")
     683 CALL histdef2d(iff,o_tauy_srf(nsrf)%flag,o_tauy_srf(nsrf)%name,"Meridional wind stress "//clnsurf(nsrf),"Pa")
     684 CALL histdef2d(iff,o_tsol_srf(nsrf)%flag,o_tsol_srf(nsrf)%name,"Temperature "//clnsurf(nsrf),"K")
     685 CALL histdef2d(iff,o_u10m_srf(nsrf)%flag,o_u10m_srf(nsrf)%name,"Vent Zonal 10m "//clnsurf(nsrf),"m/s")
     686 CALL histdef2d(iff,o_v10m_srf(nsrf)%flag,o_v10m_srf(nsrf)%name,"Vent meredien 10m "//clnsurf(nsrf),"m/s")
     687 CALL histdef2d(iff,o_t2m_srf(nsrf)%flag,o_t2m_srf(nsrf)%name,"Temp 2m "//clnsurf(nsrf),"K")
     688 CALL histdef2d(iff,o_sens_srf(nsrf)%flag,o_sens_srf(nsrf)%name,"Sensible heat flux "//clnsurf(nsrf),"W/m2")
     689 CALL histdef2d(iff,o_lat_srf(nsrf)%flag,o_lat_srf(nsrf)%name,"Latent heat flux "//clnsurf(nsrf),"W/m2")
     690 CALL histdef2d(iff,o_flw_srf(nsrf)%flag,o_flw_srf(nsrf)%name,"LW "//clnsurf(nsrf),"W/m2")
     691 CALL histdef2d(iff,o_fsw_srf(nsrf)%flag,o_fsw_srf(nsrf)%name,"SW "//clnsurf(nsrf),"W/m2")
     692 CALL histdef2d(iff,o_wbils_srf(nsrf)%flag,o_wbils_srf(nsrf)%name,"Bilan sol "//clnsurf(nsrf),"W/m2" )
     693 CALL histdef2d(iff,o_wbilo_srf(nsrf)%flag,o_wbilo_srf(nsrf)%name,"Bilan eau "//clnsurf(nsrf),"kg/(m2*s)")
    555694  if (iflag_pbl>1 .and. lev_files(iff).gt.10 ) then
    556  CALL histdef2d(iff,flag_tke_sol,"tke_"//clnsurf(nsrf),"Max Turb. Kinetic Energy "//clnsurf(nsrf),"-")
    557  CALL histdef2d(iff,flag_tke_max_sol,"tke_max_"//clnsurf(nsrf),"Max Turb. Kinetic Energy "//clnsurf(nsrf),"-")
     695 CALL histdef2d(iff,o_tke_srf(nsrf)%flag,o_tke_srf(nsrf)%name,"Max Turb. Kinetic Energy "//clnsurf(nsrf),"-")
     696   type_ecri(1) = 't_max(X)'
     697   type_ecri(2) = 't_max(X)'
     698   type_ecri(3) = 't_max(X)'
     699   type_ecri(4) = 't_max(X)'
     700   type_ecri(5) = 't_max(X)'
     701 CALL histdef2d(iff,o_tke_max_srf(nsrf)%flag,o_tke_max_srf(nsrf)%name,"Max Turb. Kinetic Energy "//clnsurf(nsrf),"-")
     702   type_ecri(1) = 'ave(X)'
     703   type_ecri(2) = 'ave(X)'
     704   type_ecri(3) = 'ave(X)'
     705   type_ecri(4) = 'inst(X)'
     706   type_ecri(5) = 'ave(X)'
    558707  endif
    559  CALL histdef2d(iff,flag_albe_sol, "albe_"//clnsurf(nsrf),"Albedo surf. "//clnsurf(nsrf),"-")
    560  CALL histdef2d(iff,flag_rugs_sol,"rugs_"//clnsurf(nsrf),"Latent heat flux "//clnsurf(nsrf),"W/m2")
    561  CALL histdef2d(iff,flag_ages_sol,"ages_"//clnsurf(nsrf),"Snow age","day")
     708 CALL histdef2d(iff,o_albe_srf(nsrf)%flag,o_albe_srf(nsrf)%name,"Albedo surf. "//clnsurf(nsrf),"-")
     709 CALL histdef2d(iff,o_rugs_srf(nsrf)%flag,o_rugs_srf(nsrf)%name,"Latent heat flux "//clnsurf(nsrf),"W/m2")
     710 CALL histdef2d(iff,o_ages_srf(nsrf)%flag,o_ages_srf(nsrf)%name,"Snow age", "day")
    562711     END DO
    563712
    564  CALL histdef2d(iff,flag_albs,"albs","Surface albedo","-")
    565  CALL histdef2d(iff,flag_albslw,"albslw","Surface albedo LW","-")
    566  CALL histdef2d(iff,flag_cdrm,"cdrm","Momentum drag coef.", "-")
    567  CALL histdef2d(iff,flag_cdrh,"cdrh","Heat drag coef.", "-" )
    568  CALL histdef2d(iff,flag_cldl,"cldl","Low-level cloudiness", "-")
    569  CALL histdef2d(iff,flag_cldm,"cldm","Mid-level cloudiness", "-")
    570  CALL histdef2d(iff,flag_cldh,"cldh","High-level cloudiness", "-")
    571  CALL histdef2d(iff,flag_cldt,"cldt","Total cloudiness","%")
    572  CALL histdef2d(iff,flag_cldq,"cldq","Cloud liquid water path","kg/m2")
    573  CALL histdef2d(iff,flag_lwp,"lwp","Cloud water path","kg/m2")
    574  CALL histdef2d(iff,flag_iwp,"iwp","Cloud ice water path","kg/m2" )
    575  CALL histdef2d(iff,flag_ue,"ue","Zonal energy transport","-")
    576  CALL histdef2d(iff,flag_ve,"ve","Merid energy transport", "-")
    577  CALL histdef2d(iff,flag_uq,"uq","Zonal humidity transport", "-")
    578  CALL histdef2d(iff,flag_vq,"vq","Merid humidity transport", "-")
     713 IF (ok_ade) THEN
     714  CALL histdef2d(iff,o_topswad%flag,o_topswad%name, "ADE at TOA", "W/m2")
     715  CALL histdef2d(iff,o_solswad%flag,o_solswad%name, "ADE at SRF", "W/m2")
     716 ENDIF
     717
     718 IF (ok_aie) THEN
     719  CALL histdef2d(iff,o_topswai%flag,o_topswai%name, "AIE at TOA", "W/m2")
     720  CALL histdef2d(iff,o_solswai%flag,o_solswai%name, "AIE at SFR", "W/m2")
     721 ENDIF
     722
     723
     724 CALL histdef2d(iff,o_albs%flag,o_albs%name, "Surface albedo", "-")
     725 CALL histdef2d(iff,o_albslw%flag,o_albslw%name, "Surface albedo LW", "-")
     726 CALL histdef2d(iff,o_cdrm%flag,o_cdrm%name, "Momentum drag coef.", "-")
     727 CALL histdef2d(iff,o_cdrh%flag,o_cdrh%name, "Heat drag coef.", "-" )
     728 CALL histdef2d(iff,o_cldl%flag,o_cldl%name, "Low-level cloudiness", "-")
     729 CALL histdef2d(iff,o_cldm%flag,o_cldm%name, "Mid-level cloudiness", "-")
     730 CALL histdef2d(iff,o_cldh%flag,o_cldh%name, "High-level cloudiness", "-")
     731 CALL histdef2d(iff,o_cldt%flag,o_cldt%name, "Total cloudiness", "%")
     732 CALL histdef2d(iff,o_cldq%flag,o_cldq%name, "Cloud liquid water path", "kg/m2")
     733 CALL histdef2d(iff,o_lwp%flag,o_lwp%name, "Cloud water path", "kg/m2")
     734 CALL histdef2d(iff,o_iwp%flag,o_iwp%name, "Cloud ice water path", "kg/m2" )
     735 CALL histdef2d(iff,o_ue%flag,o_ue%name, "Zonal energy transport", "-")
     736 CALL histdef2d(iff,o_ve%flag,o_ve%name, "Merid energy transport", "-")
     737 CALL histdef2d(iff,o_uq%flag,o_uq%name, "Zonal humidity transport", "-")
     738 CALL histdef2d(iff,o_vq%flag,o_vq%name, "Merid humidity transport", "-")
    579739
    580740     IF(iflag_con.GE.3) THEN ! sb
    581  CALL histdef2d(iff,flag_cape,"cape","Conv avlbl pot ener","J/kg")
    582  CALL histdef2d(iff,flag_pbase,"pbase","Cld base pressure", "mb")
    583  CALL histdef2d(iff,flag_ptop,"ptop","Cld top pressure", "mb")
    584  CALL histdef2d(iff,flag_fbase,"fbase","Cld base mass flux","kg/m2/s")
    585  CALL histdef2d(iff,flag_prw,"prw","Precipitable water","kg/m2")
    586  CALL histdef2d(iff,flag_cape_max,"cape_max","CAPE max.", "J/kg")
    587  CALL histdef3d(iff,flag_upwd,"upwd","saturated updraft", "kg/m2/s")
    588  CALL histdef3d(iff,flag_Ma,"Ma","undilute adiab updraft","kg/m2/s")
    589  CALL histdef3d(iff,flag_dnwd,"dnwd","saturated downdraft","kg/m2/s")
    590  CALL histdef3d(iff,flag_dnwd0,"dnwd0","unsat. downdraft", "kg/m2/s")
     741 CALL histdef2d(iff,o_cape%flag,o_cape%name, "Conv avlbl pot ener", "J/kg")
     742 CALL histdef2d(iff,o_pbase%flag,o_pbase%name, "Cld base pressure", "mb")
     743 CALL histdef2d(iff,o_ptop%flag,o_ptop%name, "Cld top pressure", "mb")
     744 CALL histdef2d(iff,o_fbase%flag,o_fbase%name, "Cld base mass flux", "kg/m2/s")
     745 CALL histdef2d(iff,o_prw%flag,o_prw%name, "Precipitable water", "kg/m2")
     746   type_ecri(1) = 't_max(X)'
     747   type_ecri(2) = 't_max(X)'
     748   type_ecri(3) = 't_max(X)'
     749   type_ecri(4) = 't_max(X)'
     750   type_ecri(5) = 't_max(X)'
     751 CALL histdef2d(iff,o_cape_max%flag,o_cape_max%name, "CAPE max.", "J/kg")
     752   type_ecri(1) = 'ave(X)'
     753   type_ecri(2) = 'ave(X)'
     754   type_ecri(3) = 'ave(X)'
     755   type_ecri(4) = 'inst(X)'
     756   type_ecri(5) = 'ave(X)'
     757 CALL histdef3d(iff,o_upwd%flag,o_upwd%name, "saturated updraft", "kg/m2/s")
     758 CALL histdef3d(iff,o_Ma%flag,o_Ma%name, "undilute adiab updraft", "kg/m2/s")
     759 CALL histdef3d(iff,o_dnwd%flag,o_dnwd%name, "saturated downdraft", "kg/m2/s")
     760 CALL histdef3d(iff,o_dnwd0%flag,o_dnwd0%name, "unsat. downdraft", "kg/m2/s")
    591761     ENDIF !iflag_con .GE. 3
    592762
    593  CALL histdef2d(iff,flag_s_pblh,"s_pblh","Boundary Layer Height","m")
    594  CALL histdef2d(iff,flag_s_pblt,"s_pblt","t at Boundary Layer Height","K")
    595  CALL histdef2d(iff,flag_s_lcl,"s_lcl","Condensation level","m")
    596  CALL histdef2d(iff,flag_s_capCL,"s_capCL","Conv avlbl pot enerfor ABL", "J/m2" )
    597  CALL histdef2d(iff,flag_s_oliqCL,"s_oliqCL","Liq Water in BL","kg/m2")
    598  CALL histdef2d(iff,flag_s_cteiCL,"s_cteiCL","Instability criteria(ABL)","K")
    599  CALL histdef2d(iff,flag_s_therm,"s_therm","Exces du thermique", "K")
    600  CALL histdef2d(iff,flag_s_trmb1,"s_trmb1","deep_cape(HBTM2)","J/m2")
    601  CALL histdef2d(iff,flag_s_trmb2,"s_trmb2","inhibition (HBTM2)","J/m2")
    602  CALL histdef2d(iff,flag_s_trmb3,"s_trmb3","Point Omega (HBTM2)","m")
     763 CALL histdef2d(iff,o_s_pblh%flag,o_s_pblh%name, "Boundary Layer Height", "m")
     764 CALL histdef2d(iff,o_s_pblt%flag,o_s_pblt%name, "t at Boundary Layer Height", "K")
     765 CALL histdef2d(iff,o_s_lcl%flag,o_s_lcl%name, "Condensation level", "m")
     766 CALL histdef2d(iff,o_s_capCL%flag,o_s_capCL%name, "Conv avlbl pot enerfor ABL", "J/m2" )
     767 CALL histdef2d(iff,o_s_oliqCL%flag,o_s_oliqCL%name, "Liq Water in BL", "kg/m2")
     768 CALL histdef2d(iff,o_s_cteiCL%flag,o_s_cteiCL%name, "Instability criteria(ABL)", "K")
     769 CALL histdef2d(iff,o_s_therm%flag,o_s_therm%name, "Exces du thermique", "K")
     770 CALL histdef2d(iff,o_s_trmb1%flag,o_s_trmb1%name, "deep_cape(HBTM2)", "J/m2")
     771 CALL histdef2d(iff,o_s_trmb2%flag,o_s_trmb2%name, "inhibition (HBTM2)", "J/m2")
     772 CALL histdef2d(iff,o_s_trmb3%flag,o_s_trmb3%name, "Point Omega (HBTM2)", "m")
    603773
    604774! Champs interpolles sur des niveaux de pression
    … …  
    614784   type_ecri(3) = 'inst(X)'
    615785   type_ecri(4) = 'inst(X)'
     786   type_ecri(5) = 'inst(X)'
     787
     788! Attention a reverifier
     789
     790        ilev=0       
    616791        DO k=1, nlevSTD
    617792     IF(k.GE.2.AND.k.LE.12) bb2=clevSTD(k)
    618      IF(k.GE.13.AND.k.LE.17) bb3=clevSTD(k)
     793!     IF(k.GE.13.AND.k.LE.17) bb3=clevSTD(k)
    619794     IF(bb2.EQ."850".OR.bb2.EQ."700".OR.bb2.EQ."500".OR.bb2.EQ."200")THEN
    620  CALL histdef2d(iff,flag_ulevsSTD,"u"//bb2,"Zonal wind "//bb2//"mb","m/s")
    621  CALL histdef2d(iff,flag_vlevsSTD,"v"//bb2,"Meridional wind "//bb2//"mb","m/s")
    622  CALL histdef2d(iff,flag_wlevsSTD,"w"//bb2,"Vertical wind "//bb2//"mb","m/s")
    623  CALL histdef2d(iff,flag_philevsSTD,"phi"//bb2,"Geopotential "//bb2//"mb","m")
    624  CALL histdef2d(iff,flag_qlevsSTD,"q"//bb2,"Specific humidity "//bb2//"mb","kg/kg" )
    625  CALL histdef2d(iff,flag_tlevsSTD,"t"//bb2,"Temperature "//bb2//"mb","K")
    626      ENDIF !(bb2.EQ."850".OR.bb2.EQ."700".OR.
     795      ilev=ilev+1
     796      print*,'ilev bb2 flag name ',ilev,bb2,o_uSTDlevs(ilev)%flag,o_uSTDlevs(ilev)%name
     797 CALL histdef2d(iff,o_uSTDlevs(ilev)%flag,o_uSTDlevs(ilev)%name,"Zonal wind "//bb2//"mb", "m/s")
     798 CALL histdef2d(iff,o_vSTDlevs(ilev)%flag,o_vSTDlevs(ilev)%name,"Meridional wind "//bb2//"mb", "m/s")
     799 CALL histdef2d(iff,o_wSTDlevs(ilev)%flag,o_wSTDlevs(ilev)%name,"Vertical wind "//bb2//"mb", "Pa/s")
     800 CALL histdef2d(iff,o_phiSTDlevs(ilev)%flag,o_phiSTDlevs(ilev)%name,"Geopotential "//bb2//"mb", "m")
     801 CALL histdef2d(iff,o_qSTDlevs(ilev)%flag,o_qSTDlevs(ilev)%name,"Specific humidity "//bb2//"mb", "kg/kg" )
     802 CALL histdef2d(iff,o_tSTDlevs(ilev)%flag,o_tSTDlevs(ilev)%name,"Temperature "//bb2//"mb", "K")
     803     ENDIF !(bb2.EQ."850".OR.bb2.EQ."700".OR."500".OR.bb2.EQ."200")
    627804       ENDDO
    628805   zstophym(iff) = dtime
    … …  
    631808   type_ecri(3) = 'ave(X)'
    632809   type_ecri(4) = 'inst(X)'
    633 
    634  CALL histdef2d(iff,flag_t_oce_sic,"t_oce_sic","Temp mixte oce-sic","K")
    635 
    636  IF (ocean=='slab') &
    637       CALL histdef2d(iff,flag_slab_bils, "slab_wbils_oce","Bilan au sol sur ocean slab", "W/m2")
    638 
    639  IF (iflag_con.EQ.3) THEN
    640  CALL histdef2d(iff,flag_ale,"ale","ALE","m2/s2")
    641  CALL histdef2d(iff,flag_alp,"alp","ALP","W/m2")
    642  CALL histdef2d(iff,flag_cin,"cin","Convective INhibition","m2/s2")
    643  IF (iflag_coupl.EQ.1) THEN
    644   CALL histdef2d(iff,flag_ale_bl,"ale_bl","ALE BL","m2/s2")
    645   CALL histdef2d(iff,flag_alp_bl,"alp_bl","ALP BL","m2/s2")
    646  ENDIF !iflag_coupl.EQ.1
    647  IF (iflag_wake.EQ.1) THEN
    648   CALL histdef2d(iff,flag_ale_wk,"ale_wk","ALE WK","m2/s2")
    649   CALL histdef2d(iff,flag_alp_wk,"alp_wk","ALP WK","m2/s2")
    650   CALL histdef2d(iff,flag_wape,"WAPE","WAPE","m2/s2")
    651   CALL histdef2d(iff,flag_wake_h,"wake_h","wake_h", "-")
    652   CALL histdef2d(iff,flag_wake_s,"wake_s","wake_s", "-")
    653   CALL histdef3d(iff,flag_dtwak,"dtwak","Wake dT","K/s")
    654   CALL histdef3d(iff,flag_dqwak,"dqwak","Wake dQ","(kg/kg)/s")
    655   CALL histdef3d(iff,flag_wake_deltat,"wake_deltat","wake_deltat", " ")
    656   CALL histdef3d(iff,flag_wake_deltaq,"wake_deltaq","wake_deltaq", " ")
    657   CALL histdef3d(iff,flag_wake_omg,"wake_omg","wake_omg", " ")
    658   CALL histdef3d(iff,flag_ftd,"ftd","tend temp due aux descentes precip","-")
    659   CALL histdef3d(iff,flag_fqd,"fqd","tend vap eau due aux descentes precip","-")
    660  ENDIF !iflag_wake.EQ.1
    661   CALL histdef3d(iff,flag_Vprecip,"Vprecip","precipitation vertical profile","-")
    662  ENDIF !(iflag_con.EQ.3)
    663 
    664  CALL histdef2d(iff,flag_weakinv, "weakinv","Weak inversion", "-")
    665  CALL histdef2d(iff,flag_dthmin,"dthmin","dTheta mini", "K/m")
    666  CALL histdef2d(iff,flag_rh2m,"rh2m","Relative humidity at 2m", "%" )
    667  CALL histdef2d(iff,flag_qsat2m,"qsat2m","Saturant humidity at 2m", "%")
    668  CALL histdef2d(iff,flag_tpot,"tpot","Surface air potential temperature","K")
    669  CALL histdef2d(iff,flag_tpote,"tpote","Surface air equivalent potential temperature","K")
    670  CALL histdef2d(iff,flag_SWnetOR,"SWnetOR","Sfce net SW radiation OR", "W/m2")
    671  CALL histdef2d(iff,flag_SWdownOR,"SWdownOR","Sfce incident SW radiation OR","W/m2")
    672  CALL histdef2d(iff,flag_LWdownOR,"LWdownOR","Sfce incident LW radiation OR","W/m2")
    673  CALL histdef2d(iff,flag_snowl,"snowl","Solid Large-scale Precip.","kg/(m2*s)")
    674  CALL histdef2d(iff,flag_solldown,"solldown","Down. IR rad. at surface","W/m2")
    675  CALL histdef2d(iff,flag_dtsvdfo,"dtsvdfo","Boundary-layer dTs(o)","K/s")
    676  CALL histdef2d(iff,flag_dtsvdft,"dtsvdft","Boundary-layer dTs(t)","K/s")
    677  CALL histdef2d(iff,flag_dtsvdfg,"dtsvdfg","Boundary-layer dTs(g)","K/s")
    678  CALL histdef2d(iff,flag_dtsvdfi,"dtsvdfi","Boundary-layer dTs(g)","K/s")
    679  CALL histdef2d(iff,flag_rugs,"rugs","rugosity", "-" )
     810   type_ecri(5) = 'ave(X)'
     811
     812 CALL histdef2d(iff,o_t_oce_sic%flag,o_t_oce_sic%name, "Temp mixte oce-sic", "K")
     813
     814 IF (type_ocean=='slab') &
     815     CALL histdef2d(iff,o_slab_bils%flag, o_slab_bils%name,"Bilan au sol sur ocean slab", "W/m2")
     816
     817! Couplage conv-CL
     818 IF (iflag_con.GE.3) THEN
     819    IF (iflag_coupl.EQ.1) THEN
     820 CALL histdef2d(iff,o_ale_bl%flag,o_ale_bl%name, "ALE BL", "m2/s2")
     821 CALL histdef2d(iff,o_alp_bl%flag,o_alp_bl%name, "ALP BL", "m2/s2")
     822    ENDIF
     823 ENDIF !(iflag_con.GE.3)
     824
     825
     826 CALL histdef2d(iff,o_weakinv%flag,o_weakinv%name, "Weak inversion", "-")
     827 CALL histdef2d(iff,o_dthmin%flag,o_dthmin%name, "dTheta mini", "K/m")
     828 CALL histdef2d(iff,o_rh2m%flag,o_rh2m%name, "Relative humidity at 2m", "%" )
     829 CALL histdef2d(iff,o_qsat2m%flag,o_qsat2m%name, "Saturant humidity at 2m", "%")
     830 CALL histdef2d(iff,o_tpot%flag,o_tpot%name, "Surface air potential temperature", "K")
     831 CALL histdef2d(iff,o_tpote%flag,o_tpote%name, "Surface air equivalent potential temperature", "K")
     832 CALL histdef2d(iff,o_SWnetOR%flag,o_SWnetOR%name, "Sfce net SW radiation OR", "W/m2")
     833 CALL histdef2d(iff,o_SWdownOR%flag,o_SWdownOR%name, "Sfce incident SW radiation OR", "W/m2")
     834 CALL histdef2d(iff,o_LWdownOR%flag,o_LWdownOR%name, "Sfce incident LW radiation OR", "W/m2")
     835 CALL histdef2d(iff,o_snowl%flag,o_snowl%name, "Solid Large-scale Precip.", "kg/(m2*s)")
     836 CALL histdef2d(iff,o_solldown%flag,o_solldown%name, "Down. IR rad. at surface", "W/m2")
     837 CALL histdef2d(iff,o_dtsvdfo%flag,o_dtsvdfo%name, "Boundary-layer dTs(o)", "K/s")
     838 CALL histdef2d(iff,o_dtsvdft%flag,o_dtsvdft%name, "Boundary-layer dTs(t)", "K/s")
     839 CALL histdef2d(iff,o_dtsvdfg%flag,o_dtsvdfg%name, "Boundary-layer dTs(g)", "K/s")
     840 CALL histdef2d(iff,o_dtsvdfi%flag,o_dtsvdfi%name, "Boundary-layer dTs(g)", "K/s")
     841 CALL histdef2d(iff,o_rugs%flag,o_rugs%name, "rugosity", "-" )
    680842
    681843! Champs 3D:
    682  CALL histdef3d(iff,flag_lwcon,"lwcon","Cloud liquid water content","kg/kg")
    683  CALL histdef3d(iff,flag_iwcon,"iwcon","Cloud ice water content","kg/kg")
    684  CALL histdef3d(iff,flag_temp,"temp","Air temperature","K" )
    685  CALL histdef3d(iff,flag_theta,"theta","Potential air temperature","K" )
    686  CALL histdef3d(iff,flag_ovap,"ovap","Specific humidity","kg/kg" )
    687  CALL histdef3d(iff,flag_geop,"geop","Geopotential height","m2/s2")
    688  CALL histdef3d(iff,flag_vitu,"vitu","Zonal wind", "m/s" )
    689  CALL histdef3d(iff,flag_vitv,"vitv","Meridional wind","m/s" )
    690  CALL histdef3d(iff,flag_vitw,"vitw","Vertical wind","Pa/s" )
    691  CALL histdef3d(iff,flag_pres,"pres","Air pressure", "Pa" )
    692  CALL histdef3d(iff,flag_rneb,"rneb","Cloud fraction","-")
    693  CALL histdef3d(iff,flag_rnebcon,"rnebcon","Convective Cloud Fraction","-")
    694  CALL histdef3d(iff,flag_rhum,"rhum","Relative humidity","-")
    695  CALL histdef3d(iff,flag_ozone,"ozone","Ozone concentration", "ppmv")
    696  CALL histdef3d(iff,flag_dtphy,"dtphy","Physics dT","K/s")
    697  CALL histdef3d(iff,flag_dqphy,"dqphy","Physics dQ", "(kg/kg)/s")
    698  CALL histdef3d(iff,flag_cldtau,"cldtau","Cloud optical thickness","1")
    699  CALL histdef3d(iff,flag_cldemi,"cldemi","Cloud optical emissivity","1")
     844 CALL histdef3d(iff,o_lwcon%flag,o_lwcon%name, "Cloud liquid water content", "kg/kg")
     845 CALL histdef3d(iff,o_iwcon%flag,o_iwcon%name, "Cloud ice water content", "kg/kg")
     846 CALL histdef3d(iff,o_temp%flag,o_temp%name, "Air temperature", "K" )
     847 CALL histdef3d(iff,o_theta%flag,o_theta%name, "Potential air temperature", "K" )
     848 CALL histdef3d(iff,o_ovap%flag,o_ovap%name, "Specific humidity + dqphy", "kg/kg" )
     849 CALL histdef3d(iff,o_ovapinit%flag,o_ovapinit%name, "Specific humidity", "kg/kg" )
     850 CALL histdef3d(iff,o_geop%flag,o_geop%name, "Geopotential height", "m2/s2")
     851 CALL histdef3d(iff,o_vitu%flag,o_vitu%name, "Zonal wind", "m/s" )
     852 CALL histdef3d(iff,o_vitv%flag,o_vitv%name, "Meridional wind", "m/s" )
     853 CALL histdef3d(iff,o_vitw%flag,o_vitw%name, "Vertical wind", "Pa/s" )
     854 CALL histdef3d(iff,o_pres%flag,o_pres%name, "Air pressure", "Pa" )
     855 CALL histdef3d(iff,o_rneb%flag,o_rneb%name, "Cloud fraction", "-")
     856 CALL histdef3d(iff,o_rnebcon%flag,o_rnebcon%name, "Convective Cloud Fraction", "-")
     857 CALL histdef3d(iff,o_rhum%flag,o_rhum%name, "Relative humidity", "-")
     858 CALL histdef3d(iff,o_ozone%flag,o_ozone%name, "Ozone concentration", "ppmv")
     859 CALL histdef3d(iff,o_dtphy%flag,o_dtphy%name, "Physics dT", "K/s")
     860 CALL histdef3d(iff,o_dqphy%flag,o_dqphy%name, "Physics dQ", "(kg/kg)/s")
     861 CALL histdef3d(iff,o_cldtau%flag,o_cldtau%name, "Cloud optical thickness", "1")
     862 CALL histdef3d(iff,o_cldemi%flag,o_cldemi%name, "Cloud optical emissivity", "1")
    700863!IM: bug ?? dimensionnement variables (klon,klev+1) pmflxr, pmflxs, prfl, psfl
    701 ! CALL histdef3d(iff,flag_pr_con_l,"pmflxr","Convective precipitation lic"," ")
    702 ! CALL histdef3d(iff,flag_pr_con_i,"pmflxs","Convective precipitation ice"," ")
    703 ! CALL histdef3d(iff,flag_pr_lsc_l,"prfl","Large scale precipitation lic"," ")
    704 ! CALL histdef3d(iff,flag_pr_lsc_i,"psfl","Large scale precipitation ice"," ")
     864! CALL histdef3d(iff,o_pr_con_l%flag,o_pmflxr%name, "Convective precipitation lic", " ")
     865! CALL histdef3d(iff,o_pr_con_i%flag,o_pmflxs%name, "Convective precipitation ice", " ")
     866! CALL histdef3d(iff,o_pr_lsc_l%flag,o_prfl%name, "Large scale precipitation lic", " ")
     867! CALL histdef3d(iff,o_pr_lsc_i%flag,o_psfl%name, "Large scale precipitation ice", " ")
    705868
    706869!FH Sorties pour la couche limite
    707870     if (iflag_pbl>1) then
    708  CALL histdef3d(iff,flag_tke,"tke","TKE","m2/s2")
    709  CALL histdef3d(iff,flag_tke_max,"tke_max","TKE max","m2/s2")
     871 CALL histdef3d(iff,o_tke%flag,o_tke%name, "TKE", "m2/s2")
     872   type_ecri(1) = 't_max(X)'
     873   type_ecri(2) = 't_max(X)'
     874   type_ecri(3) = 't_max(X)'
     875   type_ecri(4) = 't_max(X)'
     876   type_ecri(5) = 't_max(X)'
     877 CALL histdef3d(iff,o_tke_max%flag,o_tke_max%name, "TKE max", "m2/s2")
     878   type_ecri(1) = 'ave(X)'
     879   type_ecri(2) = 'ave(X)'
     880   type_ecri(3) = 'ave(X)'
     881   type_ecri(4) = 'inst(X)'
     882   type_ecri(5) = 'ave(X)'
    710883     endif
    711884
    712  CALL histdef3d(iff,flag_kz,"kz","Kz melange","m2/s")
    713  CALL histdef3d(iff,flag_kz_max,"kz_max","Kz melange max","m2/s" )
    714  CALL histdef3d(iff,flag_clwcon,"clwcon","Convective Cloud Liquid water content", "kg/kg")
    715  CALL histdef3d(iff,flag_dtdyn,"dtdyn","Dynamics dT","K/s")
    716  CALL histdef3d(iff,flag_dqdyn,"dqdyn","Dynamics dQ", "(kg/kg)/s")
    717  CALL histdef3d(iff,flag_dudyn,"dudyn","Dynamics dU","m/s2")
    718  CALL histdef3d(iff,flag_dvdyn,"dvdyn","Dynamics dV","m/s2")
    719  CALL histdef3d(iff,flag_dtcon,"dtcon","Convection dT","K/s")
    720  CALL histdef3d(iff,flag_ducon,"ducon","Convection du","m/s2")
    721  CALL histdef3d(iff,flag_dqcon,"dqcon","Convection dQ", "(kg/kg)/s")
    722 
    723  CALL histdef3d(iff,flag_dtlsc,"dtlsc","Condensation dT", "K/s")
    724  CALL histdef3d(iff,flag_dtlschr,"dtlschr","Large-scale condensational heating rate","K/s")
    725  CALL histdef3d(iff,flag_dqlsc,"dqlsc","Condensation dQ","(kg/kg)/s")
    726  CALL histdef3d(iff,flag_dtvdf,"dtvdf","Boundary-layer dT", "K/s")
    727  CALL histdef3d(iff,flag_dqvdf,"dqvdf","Boundary-layer dQ","(kg/kg)/s")
    728  CALL histdef3d(iff,flag_dteva,"dteva","Reevaporation dT", "K/s")
    729  CALL histdef3d(iff,flag_dqeva,"dqeva","Reevaporation dQ","(kg/kg)/s")
    730  CALL histdef3d(iff,flag_ptconv,"ptconv","POINTS CONVECTIFS"," ")
    731  CALL histdef3d(iff,flag_ratqs,"ratqs", "RATQS"," ")
    732  CALL histdef3d(iff,flag_dtthe,"dtthe","Dry adjust. dT", "K/s")
     885 CALL histdef3d(iff,o_kz%flag,o_kz%name, "Kz melange", "m2/s")
     886   type_ecri(1) = 't_max(X)'
     887   type_ecri(2) = 't_max(X)'
     888   type_ecri(3) = 't_max(X)'
     889   type_ecri(4) = 't_max(X)'
     890   type_ecri(5) = 't_max(X)'
     891 CALL histdef3d(iff,o_kz_max%flag,o_kz_max%name, "Kz melange max", "m2/s" )
     892   type_ecri(1) = 'ave(X)'
     893   type_ecri(2) = 'ave(X)'
     894   type_ecri(3) = 'ave(X)'
     895   type_ecri(4) = 'inst(X)'
     896   type_ecri(5) = 'ave(X)'
     897 CALL histdef3d(iff,o_clwcon%flag,o_clwcon%name, "Convective Cloud Liquid water content", "kg/kg")
     898 CALL histdef3d(iff,o_dtdyn%flag,o_dtdyn%name, "Dynamics dT", "K/s")
     899 CALL histdef3d(iff,o_dqdyn%flag,o_dqdyn%name, "Dynamics dQ", "(kg/kg)/s")
     900 CALL histdef3d(iff,o_dudyn%flag,o_dudyn%name, "Dynamics dU", "m/s2")
     901 CALL histdef3d(iff,o_dvdyn%flag,o_dvdyn%name, "Dynamics dV", "m/s2")
     902 CALL histdef3d(iff,o_dtcon%flag,o_dtcon%name, "Convection dT", "K/s")
     903 CALL histdef3d(iff,o_ducon%flag,o_ducon%name, "Convection du", "m/s2")
     904 CALL histdef3d(iff,o_dqcon%flag,o_dqcon%name, "Convection dQ", "(kg/kg)/s")
     905
     906! Wakes
     907 IF(iflag_con.EQ.3) THEN
     908 IF (iflag_wake == 1) THEN
     909   CALL histdef2d(iff,o_ale_wk%flag,o_ale_wk%name, "ALE WK", "m2/s2")
     910   CALL histdef2d(iff,o_alp_wk%flag,o_alp_wk%name, "ALP WK", "m2/s2")
     911   CALL histdef2d(iff,o_ale%flag,o_ale%name, "ALE", "m2/s2")
     912   CALL histdef2d(iff,o_alp%flag,o_alp%name, "ALP", "W/m2")
     913   CALL histdef2d(iff,o_cin%flag,o_cin%name, "Convective INhibition", "m2/s2")
     914   CALL histdef2d(iff,o_wape%flag,o_WAPE%name, "WAPE", "m2/s2")
     915   CALL histdef2d(iff,o_wake_h%flag,o_wake_h%name, "wake_h", "-")
     916   CALL histdef2d(iff,o_wake_s%flag,o_wake_s%name, "wake_s", "-")
     917   CALL histdef3d(iff,o_dtwak%flag,o_dtwak%name, "Wake dT", "K/s")
     918   CALL histdef3d(iff,o_dqwak%flag,o_dqwak%name, "Wake dQ", "(kg/kg)/s")
     919   CALL histdef3d(iff,o_wake_deltat%flag,o_wake_deltat%name, "wake_deltat", " ")
     920   CALL histdef3d(iff,o_wake_deltaq%flag,o_wake_deltaq%name, "wake_deltaq", " ")
     921   CALL histdef3d(iff,o_wake_omg%flag,o_wake_omg%name, "wake_omg", " ")
     922 ENDIF
     923   CALL histdef3d(iff,o_Vprecip%flag,o_Vprecip%name, "precipitation vertical profile", "-")
     924   CALL histdef3d(iff,o_ftd%flag,o_ftd%name, "tend temp due aux descentes precip", "-")
     925   CALL histdef3d(iff,o_fqd%flag,o_fqd%name,"tend vap eau due aux descentes precip", "-")
     926 ENDIF !(iflag_con.EQ.3)
     927
     928 CALL histdef3d(iff,o_dtlsc%flag,o_dtlsc%name, "Condensation dT", "K/s")
     929 CALL histdef3d(iff,o_dtlschr%flag,o_dtlschr%name,"Large-scale condensational heating rate","K/s")
     930 CALL histdef3d(iff,o_dqlsc%flag,o_dqlsc%name, "Condensation dQ", "(kg/kg)/s")
     931 CALL histdef3d(iff,o_dtvdf%flag,o_dtvdf%name, "Boundary-layer dT", "K/s")
     932 CALL histdef3d(iff,o_dqvdf%flag,o_dqvdf%name, "Boundary-layer dQ", "(kg/kg)/s")
     933 CALL histdef3d(iff,o_dteva%flag,o_dteva%name, "Reevaporation dT", "K/s")
     934 CALL histdef3d(iff,o_dqeva%flag,o_dqeva%name, "Reevaporation dQ", "(kg/kg)/s")
     935 CALL histdef3d(iff,o_ptconv%flag,o_ptconv%name, "POINTS CONVECTIFS", " ")
     936 CALL histdef3d(iff,o_ratqs%flag,o_ratqs%name, "RATQS", " ")
     937 CALL histdef3d(iff,o_dtthe%flag,o_dtthe%name, "Dry adjust. dT", "K/s")
    733938
    734939if(iflag_thermals.gt.1) THEN
    735  CALL histdef3d(iff,flag_f_th,"f_th","Thermal plume mass flux", "K/s")
    736  CALL histdef3d(iff,flag_e_th,"e_th","Thermal plume entrainment", "K/s")
    737  CALL histdef3d(iff,flag_w_th,"w_th","Thermal plume vertical velocity", "m/s")
    738  CALL histdef3d(iff,flag_lambda_th,"lambda_th","Thermal plume vertical velocity", "m/s")
    739  CALL histdef3d(iff,flag_q_th,"q_th","Thermal plume total humidity", "kg/kg")
    740  CALL histdef3d(iff,flag_a_th,"a_th","Thermal plume fraction", "")
    741  CALL histdef3d(iff,flag_d_th,"d_th","Thermal plume detrainment", "K/s")
     940 CALL histdef3d(iff,o_f_th%flag,o_f_th%name, "Thermal plume mass flux", "K/s")
     941 CALL histdef3d(iff,o_e_th%flag,o_e_th%name,"Thermal plume entrainment","K/s")
     942 CALL histdef3d(iff,o_w_th%flag,o_w_th%name,"Thermal plume vertical velocity","m/s")
     943 CALL histdef3d(iff,o_lambda_th%flag,o_lambda_th%name,"Thermal plume vertical velocity","m/s")
     944 CALL histdef3d(iff,o_q_th%flag,o_q_th%name, "Thermal plume total humidity", "kg/kg")
     945 CALL histdef3d(iff,o_a_th%flag,o_a_th%name, "Thermal plume fraction", "")
     946 CALL histdef3d(iff,o_d_th%flag,o_d_th%name, "Thermal plume detrainment", "K/s")
    742947endif !iflag_thermals.gt.1
    743  CALL histdef2d(iff,flag_f0_th,"f0_th","Thermal closure mass flux", "K/s")
    744  CALL histdef2d(iff,flag_zmax_th,"zmax_th","Thermal plume height", "K/s")
    745  CALL histdef3d(iff,flag_dqthe,"dqthe","Dry adjust. dQ","(kg/kg)/s")
    746  CALL histdef3d(iff,flag_dtajs,"dtajs","Dry adjust. dT", "K/s")
    747  CALL histdef3d(iff,flag_dqajs,"dqajs","Dry adjust. dQ","(kg/kg)/s")
    748  CALL histdef3d(iff,flag_dtswr,"dtswr","SW radiation dT","K/s")
    749  CALL histdef3d(iff,flag_dtsw0,"dtsw0","CS SW radiation dT","K/s")
    750  CALL histdef3d(iff,flag_dtlwr,"dtlwr","LW radiation dT","K/s")
    751  CALL histdef3d(iff,flag_dtlw0,"dtlw0", "CS LW radiation dT","K/s")
    752  CALL histdef3d(iff,flag_dtec,"dtec","Cinetic dissip dT","K/s")
    753  CALL histdef3d(iff,flag_duvdf,"duvdf","Boundary-layer dU","m/s2")
    754  CALL histdef3d(iff,flag_dvvdf,"dvvdf","Boundary-layer dV", "m/s2")
     948 CALL histdef2d(iff,o_f0_th%flag,o_f0_th%name, "Thermal closure mass flux", "K/s")
     949 CALL histdef2d(iff,o_zmax_th%flag,o_zmax_th%name, "Thermal plume height", "K/s")
     950 CALL histdef3d(iff,o_dqthe%flag,o_dqthe%name, "Dry adjust. dQ", "(kg/kg)/s")
     951 CALL histdef3d(iff,o_dtajs%flag,o_dtajs%name, "Dry adjust. dT", "K/s")
     952 CALL histdef3d(iff,o_dqajs%flag,o_dqajs%name, "Dry adjust. dQ", "(kg/kg)/s")
     953 CALL histdef3d(iff,o_dtswr%flag,o_dtswr%name, "SW radiation dT", "K/s")
     954 CALL histdef3d(iff,o_dtsw0%flag,o_dtsw0%name, "CS SW radiation dT", "K/s")
     955 CALL histdef3d(iff,o_dtlwr%flag,o_dtlwr%name, "LW radiation dT", "K/s")
     956 CALL histdef3d(iff,o_dtlw0%flag,o_dtlw0%name, "CS LW radiation dT", "K/s")
     957 CALL histdef3d(iff,o_dtec%flag,o_dtec%name, "Cinetic dissip dT", "K/s")
     958 CALL histdef3d(iff,o_duvdf%flag,o_duvdf%name, "Boundary-layer dU", "m/s2")
     959 CALL histdef3d(iff,o_dvvdf%flag,o_dvvdf%name, "Boundary-layer dV", "m/s2")
    755960
    756961     IF (ok_orodr) THEN
    757  CALL histdef3d(iff,flag_duoro,"duoro","Orography dU","m/s2")
    758  CALL histdef3d(iff,flag_dvoro,"dvoro","Orography dV", "m/s2")
     962 CALL histdef3d(iff,o_duoro%flag,o_duoro%name, "Orography dU", "m/s2")
     963 CALL histdef3d(iff,o_dvoro%flag,o_dvoro%name, "Orography dV", "m/s2")
    759964     ENDIF
    760965
    761966     IF (ok_orolf) THEN
    762  CALL histdef3d(iff,flag_dulif,"dulif","Orography dU","m/s2")
    763  CALL histdef3d(iff,flag_dvlif,"dvlif","Orography dV", "m/s2")
     967 CALL histdef3d(iff,o_dulif%flag,o_dulif%name, "Orography dU", "m/s2")
     968 CALL histdef3d(iff,o_dvlif%flag,o_dvlif%name, "Orography dV", "m/s2")
    764969     ENDIF
    765970
    766       if (nqmax>=3) THEN
    767     DO iq=3,nqmax
     971      if (nqtot>=3) THEN
     972!Attention    DO iq=3,nqtot
     973    DO iq=3,4 
    768974       iiq=niadv(iq)
    769  CALL histdef3d ( iff, flag_trac, tnom(iq),ttext(iiq), "-" )
     975! CALL histdef3d (iff, o_trac%flag,'o_'//tnom(iq)%name,ttext(iiq), "-" )
     976  CALL histdef3d (iff, o_trac(iq-2)%flag,o_trac(iq-2)%name,ttext(iiq), "-" )
    770977    ENDDO
    771978      endif
    … …  
    792999       include "temps.h"
    7931000       include "indicesol.h"
    794        include "advtrac.h"
    7951001       include "clesphys.h"
    7961002
    7971003       integer                          :: iff
    7981004       integer, dimension(nfiles)       :: flag_var
    799        character(len=*)                 :: nomvar
     1005       character(len=20)                 :: nomvar
    8001006       character(len=*)                 :: titrevar
    8011007       character(len=*)                 :: unitvar
     1008
     1009! Appel a la lecture des noms et niveau d'ecriture des variables dans output.def
     1010       call conf_physoutputs(nomvar,flag_var)
    8021011       
    8031012       if ( flag_var(iff)<=lev_files(iff) ) then
    … …  
    8191028       include "temps.h"
    8201029       include "indicesol.h"
    821        include "advtrac.h"
    8221030       include "clesphys.h"
    8231031
    8241032       integer                          :: iff
    8251033       integer, dimension(nfiles)       :: flag_var
    826        character(len=*)                 :: nomvar
     1034       character(len=20)                 :: nomvar
    8271035       character(len=*)                 :: titrevar
    8281036       character(len=*)                 :: unitvar
     1037
     1038! Appel a la lecture des noms et niveau d'ecriture des variables dans output.def
     1039       call conf_physoutputs(nomvar,flag_var)
    8291040
    8301041       if ( flag_var(iff)<=lev_files(iff) ) then
    … …  
    8361047      end subroutine histdef3d
    8371048
     1049      SUBROUTINE conf_physoutputs(nam_var,flag_var)
     1050!!! Lecture des noms et niveau de sortie des variables dans output.def
     1051!   en utilisant les routines getin de IOIPSL 
     1052       use ioipsl
     1053
     1054       IMPLICIT NONE
     1055
     1056       include 'iniprint.h'
     1057
     1058       character(len=20)                :: nam_var
     1059       integer, dimension(nfiles)      :: flag_var
     1060       integer, dimension(nfiles),save :: flag_var_omp
     1061       character(len=20),save           :: nam_var_omp
     1062
     1063        flag_var_omp = flag_var
     1064        nam_var_omp = nam_var
     1065        IF(prt_level>10) WRITE(lunout,*)'Avant getin: nam_var flag_var ',nam_var,flag_var(:)
     1066        call getin('flag_'//nam_var,flag_var_omp)
     1067        flag_var = flag_var_omp
     1068        call getin('name_'//nam_var,nam_var_omp)
     1069        nam_var=nam_var_omp
     1070       
     1071        IF(prt_level>10) WRITE(lunout,*)'Apres getin: nam_var flag_var ',nam_var,flag_var(:)
     1072
     1073      END SUBROUTINE conf_physoutputs
     1074
    8381075END MODULE phys_output_mod
    8391076

  • LMDZ4/trunk/libf/phylmd/phys_output_write.h

    r1100 r1146  
    88
    99!!! Champs 1D !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    10        IF (flag_phis(iff)<=lev_files(iff)) THEN
     10       IF (o_phis%flag(iff)<=lev_files(iff)) THEN
    1111         CALL histwrite_phy(nid_files(iff),
    12      $                      "phis",itau_w,pphis)
    13        ENDIF
    14 
    15        IF (flag_aire(iff)<=lev_files(iff)) THEN
    16        CALL histwrite_phy(nid_files(iff),"aire",itau_w,airephy)
    17        ENDIF
    18 
    19        IF (flag_pourc_sol(iff)<=lev_files(iff)) THEN
    20       zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, is_ter)* 100.
    21       CALL histwrite_phy(nid_files(iff),
    22      $                   "pourc_"//clnsurf(is_ter),itau_w,
    23      $                   zx_tmp_fi2d)
    24        ENDIF
    25 
    26        IF (flag_fract_sol(iff)<=lev_files(iff)) THEN
    27       zx_tmp_fi2d(1 : klon) = pctsrf(1 : klon, is_ter)
    28       CALL histwrite_phy(nid_files(iff),
    29      $               "fract_"//clnsurf(is_ter),itau_w,
    30      $               zx_tmp_fi2d)
    31        ENDIF
    32 
    33        IF (flag_contfracATM(iff)<=lev_files(iff)) THEN
     12     $                      o_phis%name,itau_w,pphis)
     13       ENDIF
     14
     15       IF (o_aire%flag(iff)<=lev_files(iff)) THEN
     16       CALL histwrite_phy(nid_files(iff),o_aire%name,itau_w,airephy)
     17       ENDIF
     18
     19       IF (o_contfracATM%flag(iff)<=lev_files(iff)) THEN
    3420      DO i=1, klon
    3521       zx_tmp_fi2d(i)=pctsrf(i,is_ter)+pctsrf(i,is_lic)
    3622      ENDDO
    3723      CALL histwrite_phy(nid_files(iff),
    38      $                   "contfracATM",itau_w,zx_tmp_fi2d)
    39        ENDIF
    40 
    41        IF (flag_contfracOR(iff)<=lev_files(iff)) THEN
    42       CALL histwrite_phy(nid_files(iff),"contfracOR",itau_w,
     24     $             o_contfracATM%name,itau_w,zx_tmp_fi2d)
     25       ENDIF
     26
     27       IF (o_contfracOR%flag(iff)<=lev_files(iff)) THEN
     28      CALL histwrite_phy(nid_files(iff),o_contfracOR%name,itau_w,
    4329     $                   pctsrf(:,is_ter))
    4430       ENDIF
    4531
    46        IF (flag_aireTER(iff)<=lev_files(iff)) THEN
    47       CALL histwrite_phy(nid_files(iff),
    48      $                  "aireTER",itau_w,paire_ter)
     32       IF (o_aireTER%flag(iff)<=lev_files(iff)) THEN
     33      CALL histwrite_phy(nid_files(iff),
     34     $                  o_aireTER%name,itau_w,paire_ter)
    4935       ENDIF
    5036
    5137!!! Champs 2D !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    5238
    53        IF (flag_flat(iff)<=lev_files(iff)) THEN
    54       CALL histwrite_phy(nid_files(iff),"flat",itau_w,zxfluxlat)
    55        ENDIF
    56 
    57        IF (flag_slp(iff)<=lev_files(iff)) THEN
    58       CALL histwrite_phy(nid_files(iff),"slp",itau_w,slp)
    59        ENDIF
    60 
    61        IF (flag_tsol(iff)<=lev_files(iff)) THEN
    62       CALL histwrite_phy(nid_files(iff),"tsol",itau_w,zxtsol)
    63        ENDIF
    64 
    65        IF (flag_t2m(iff)<=lev_files(iff)) THEN
    66       CALL histwrite_phy(nid_files(iff),"t2m",itau_w,zt2m)
    67        ENDIF
    68 
    69        IF (flag_t2m_min(iff)<=lev_files(iff)) THEN
    70       CALL histwrite_phy(nid_files(iff),"t2m_min",itau_w,zt2m)
    71        ENDIF
    72 
    73        IF (flag_t2m_max(iff)<=lev_files(iff)) THEN
    74       CALL histwrite_phy(nid_files(iff),"t2m_max",itau_w,zt2m)
    75        ENDIF
    76 
    77        IF (flag_wind10m(iff)<=lev_files(iff)) THEN
     39       IF (o_flat%flag(iff)<=lev_files(iff)) THEN
     40      CALL histwrite_phy(nid_files(iff),o_flat%name,itau_w,zxfluxlat)
     41       ENDIF
     42
     43       IF (o_slp%flag(iff)<=lev_files(iff)) THEN
     44      CALL histwrite_phy(nid_files(iff),o_slp%name,itau_w,slp)
     45       ENDIF
     46
     47       IF (o_tsol%flag(iff)<=lev_files(iff)) THEN
     48      CALL histwrite_phy(nid_files(iff),o_tsol%name,itau_w,zxtsol)
     49       ENDIF
     50
     51       IF (o_t2m%flag(iff)<=lev_files(iff)) THEN
     52      CALL histwrite_phy(nid_files(iff),o_t2m%name,itau_w,zt2m)
     53       ENDIF
     54
     55       IF (o_t2m_min%flag(iff)<=lev_files(iff)) THEN
     56      CALL histwrite_phy(nid_files(iff),o_t2m_min%name,itau_w,zt2m)
     57       ENDIF
     58
     59       IF (o_t2m_max%flag(iff)<=lev_files(iff)) THEN
     60      CALL histwrite_phy(nid_files(iff),o_t2m_max%name,itau_w,zt2m)
     61       ENDIF
     62
     63       IF (o_wind10m%flag(iff)<=lev_files(iff)) THEN
    7864      DO i=1, klon
    7965       zx_tmp_fi2d(i)=SQRT(zu10m(i)*zu10m(i)+zv10m(i)*zv10m(i))
    8066      ENDDO
    81       CALL histwrite_phy(nid_files(iff),"wind10m",itau_w,zx_tmp_fi2d)
    82        ENDIF
    83 
    84        IF (flag_wind10max(iff)<=lev_files(iff)) THEN
     67      CALL histwrite_phy(nid_files(iff),
     68     s                  o_wind10m%name,itau_w,zx_tmp_fi2d)
     69       ENDIF
     70
     71       IF (o_wind10max%flag(iff)<=lev_files(iff)) THEN
    8572      DO i=1, klon
    8673       zx_tmp_fi2d(i)=SQRT(zu10m(i)*zu10m(i)+zv10m(i)*zv10m(i))
    8774      ENDDO
    88       CALL histwrite_phy(nid_files(iff),"wind10max",
     75      CALL histwrite_phy(nid_files(iff),o_wind10max%name,
    8976     $                   itau_w,zx_tmp_fi2d)
    9077       ENDIF
    9178
    92        IF (flag_sicf(iff)<=lev_files(iff)) THEN
     79       IF (o_sicf%flag(iff)<=lev_files(iff)) THEN
    9380      DO i = 1, klon
    9481         zx_tmp_fi2d(i) = pctsrf(i,is_sic)
    9582      ENDDO
    96       CALL histwrite_phy(nid_files(iff),"sicf",itau_w,zx_tmp_fi2d)
    97        ENDIF
    98 
    99        IF (flag_q2m(iff)<=lev_files(iff)) THEN
    100       CALL histwrite_phy(nid_files(iff),"q2m",itau_w,zq2m)
    101        ENDIF
    102 
    103        IF (flag_u10m(iff)<=lev_files(iff)) THEN
    104       CALL histwrite_phy(nid_files(iff),"u10m",itau_w,zu10m)
    105        ENDIF
    106 
    107        IF (flag_v10m(iff)<=lev_files(iff)) THEN
    108       CALL histwrite_phy(nid_files(iff),"v10m",itau_w,zv10m)
    109        ENDIF
    110 
    111        IF (flag_psol(iff)<=lev_files(iff)) THEN
     83      CALL histwrite_phy(nid_files(iff),
     84     $                   o_sicf%name,itau_w,zx_tmp_fi2d)
     85       ENDIF
     86
     87       IF (o_q2m%flag(iff)<=lev_files(iff)) THEN
     88      CALL histwrite_phy(nid_files(iff),o_q2m%name,itau_w,zq2m)
     89       ENDIF
     90
     91       IF (o_u10m%flag(iff)<=lev_files(iff)) THEN
     92      CALL histwrite_phy(nid_files(iff),o_u10m%name,itau_w,zu10m)
     93       ENDIF
     94
     95       IF (o_v10m%flag(iff)<=lev_files(iff)) THEN
     96      CALL histwrite_phy(nid_files(iff),o_v10m%name,itau_w,zv10m)
     97       ENDIF
     98
     99       IF (o_psol%flag(iff)<=lev_files(iff)) THEN
    112100      DO i = 1, klon
    113101         zx_tmp_fi2d(i) = paprs(i,1)
    114102      ENDDO
    115       CALL histwrite_phy(nid_files(iff),"psol",itau_w,zx_tmp_fi2d)
    116        ENDIF
    117 
    118        IF (flag_qsurf(iff)<=lev_files(iff)) THEN
    119       CALL histwrite_phy(nid_files(iff),"qsurf",itau_w,zxqsurf)
     103      CALL histwrite_phy(nid_files(iff),
     104     s                   o_psol%name,itau_w,zx_tmp_fi2d)
     105       ENDIF
     106
     107       IF (o_qsurf%flag(iff)<=lev_files(iff)) THEN
     108      CALL histwrite_phy(nid_files(iff),o_qsurf%name,itau_w,zxqsurf)
    120109       ENDIF
    121110
    122111       if (.not. ok_veget) then
    123          IF (flag_qsol(iff)<=lev_files(iff)) THEN
    124         CALL histwrite_phy(nid_files(iff),"qsol",itau_w,qsol)
     112         IF (o_qsol%flag(iff)<=lev_files(iff)) THEN
     113        CALL histwrite_phy(nid_files(iff),o_qsol%name,itau_w,qsol)
    125114         ENDIF
    126115       endif
    127116
    128       IF (flag_precip(iff)<=lev_files(iff)) THEN
     117      IF (o_precip%flag(iff)<=lev_files(iff)) THEN
    129118       DO i = 1, klon
    130119         zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
    131120       ENDDO
    132       CALL histwrite_phy(nid_files(iff),"precip",itau_w,zx_tmp_fi2d)
    133       ENDIF
    134 
    135        IF (flag_ndayrain(iff)<=lev_files(iff)) THEN
    136       CALL histwrite_phy(nid_files(iff),"ndayrain",itau_w,nday_rain)
    137        ENDIF
    138 
    139       IF (flag_plul(iff)<=lev_files(iff)) THEN
     121      CALL histwrite_phy(nid_files(iff),o_precip%name,
     122     s                   itau_w,zx_tmp_fi2d)
     123      ENDIF
     124
     125       IF (o_ndayrain%flag(iff)<=lev_files(iff)) THEN
     126      CALL histwrite_phy(nid_files(iff),o_ndayrain%name,
     127     s                   itau_w,nday_rain)
     128       ENDIF
     129
     130      IF (o_plul%flag(iff)<=lev_files(iff)) THEN
    140131       DO i = 1, klon
    141132         zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)
    142133       ENDDO
    143       CALL histwrite_phy(nid_files(iff),"plul",itau_w,zx_tmp_fi2d)
    144       ENDIF
    145 
    146       IF (flag_pluc(iff)<=lev_files(iff)) THEN
     134      CALL histwrite_phy(nid_files(iff),o_plul%name,itau_w,zx_tmp_fi2d)
     135      ENDIF
     136
     137      IF (o_pluc%flag(iff)<=lev_files(iff)) THEN
    147138      DO i = 1, klon
    148139         zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)
    149140      ENDDO
    150       CALL histwrite_phy(nid_files(iff),"pluc",itau_w,zx_tmp_fi2d)
    151       ENDIF
    152 
    153        IF (flag_snow(iff)<=lev_files(iff)) THEN
    154       CALL histwrite_phy(nid_files(iff),"snow",itau_w,snow_fall)
    155        ENDIF
    156 
    157        IF (flag_evap(iff)<=lev_files(iff)) THEN
    158       CALL histwrite_phy(nid_files(iff),"evap",itau_w,evap)
    159        ENDIF
    160 
    161        IF (flag_tops(iff)<=lev_files(iff)) THEN
    162       CALL histwrite_phy(nid_files(iff),"tops",itau_w,topsw)
    163        ENDIF
    164 
    165        IF (flag_tops0(iff)<=lev_files(iff)) THEN
    166       CALL histwrite_phy(nid_files(iff),"tops0",itau_w,topsw0)
    167        ENDIF
    168 
    169        IF (flag_topl(iff)<=lev_files(iff)) THEN
    170       CALL histwrite_phy(nid_files(iff),"topl",itau_w,toplw)
    171        ENDIF
    172 
    173        IF (flag_topl0(iff)<=lev_files(iff)) THEN
    174       CALL histwrite_phy(nid_files(iff),"topl0",itau_w,toplw0)
    175        ENDIF
    176 
    177        IF (flag_SWupTOA(iff)<=lev_files(iff)) THEN
     141      CALL histwrite_phy(nid_files(iff),o_pluc%name,itau_w,zx_tmp_fi2d)
     142      ENDIF
     143
     144       IF (o_snow%flag(iff)<=lev_files(iff)) THEN
     145      CALL histwrite_phy(nid_files(iff),o_snow%name,itau_w,snow_fall)
     146       ENDIF
     147
     148       IF (o_evap%flag(iff)<=lev_files(iff)) THEN
     149      CALL histwrite_phy(nid_files(iff),o_evap%name,itau_w,evap)
     150       ENDIF
     151
     152       IF (o_tops%flag(iff)<=lev_files(iff)) THEN
     153      CALL histwrite_phy(nid_files(iff),o_tops%name,itau_w,topsw)
     154       ENDIF
     155
     156       IF (o_tops0%flag(iff)<=lev_files(iff)) THEN
     157      CALL histwrite_phy(nid_files(iff),o_tops0%name,itau_w,topsw0)
     158       ENDIF
     159
     160       IF (o_topl%flag(iff)<=lev_files(iff)) THEN
     161      CALL histwrite_phy(nid_files(iff),o_topl%name,itau_w,toplw)
     162       ENDIF
     163
     164       IF (o_topl0%flag(iff)<=lev_files(iff)) THEN
     165      CALL histwrite_phy(nid_files(iff),o_topl0%name,itau_w,toplw0)
     166       ENDIF
     167
     168       IF (o_SWupTOA%flag(iff)<=lev_files(iff)) THEN
    178169      zx_tmp_fi2d(1 : klon) = swup ( 1 : klon, klevp1 )
    179       CALL histwrite_phy(nid_files(iff), "SWupTOA",itau_w,zx_tmp_fi2d)
    180        ENDIF
    181 
    182        IF (flag_SWupTOAclr(iff)<=lev_files(iff)) THEN
     170      CALL histwrite_phy(nid_files(iff),o_SWupTOA%name,
     171     s                     itau_w,zx_tmp_fi2d)
     172       ENDIF
     173
     174       IF (o_SWupTOAclr%flag(iff)<=lev_files(iff)) THEN
    183175      zx_tmp_fi2d(1 : klon) = swup0 ( 1 : klon, klevp1 )
    184176      CALL histwrite_phy(nid_files(iff),
    185      $                  "SWupTOAclr",itau_w,zx_tmp_fi2d)
    186        ENDIF
    187 
    188        IF (flag_SWdnTOA(iff)<=lev_files(iff)) THEN
     177     $                  o_SWupTOAclr%name,itau_w,zx_tmp_fi2d)
     178       ENDIF
     179
     180       IF (o_SWdnTOA%flag(iff)<=lev_files(iff)) THEN
    189181      zx_tmp_fi2d(1 : klon) = swdn ( 1 : klon, klevp1 )
    190       CALL histwrite_phy(nid_files(iff), "SWdnTOA",itau_w,zx_tmp_fi2d)
    191        ENDIF
    192 
    193        IF (flag_SWdnTOAclr(iff)<=lev_files(iff)) THEN
     182      CALL histwrite_phy(nid_files(iff),
     183     s                  o_SWdnTOA%name,itau_w,zx_tmp_fi2d)
     184       ENDIF
     185
     186       IF (o_SWdnTOAclr%flag(iff)<=lev_files(iff)) THEN
    194187      zx_tmp_fi2d(1 : klon) = swdn0 ( 1 : klon, klevp1 )
    195188      CALL histwrite_phy(nid_files(iff),
    196      $                  "SWdnTOAclr",itau_w,zx_tmp_fi2d)
    197        ENDIF
    198 
    199        IF (flag_SWup200(iff)<=lev_files(iff)) THEN
    200       CALL histwrite_phy(nid_files(iff),"SWup200",itau_w,SWup200)
    201        ENDIF
    202 
    203        IF (flag_SWup200clr(iff)<=lev_files(iff)) THEN
    204       CALL histwrite_phy(nid_files(iff),"SWup200clr",itau_w,SWup200clr)
    205        ENDIF
    206 
    207        IF (flag_SWdn200(iff)<=lev_files(iff)) THEN
    208       CALL histwrite_phy(nid_files(iff),"SWdn200",itau_w,SWdn200)
    209        ENDIF
    210 
    211        IF (flag_SWdn200clr(iff)<=lev_files(iff)) THEN
    212       CALL histwrite_phy(nid_files(iff),"SWdn200clr",itau_w,SWdn200clr)
    213        ENDIF
    214 
    215        IF (flag_LWup200(iff)<=lev_files(iff)) THEN
    216       CALL histwrite_phy(nid_files(iff),"LWup200",itau_w,LWup200)
    217        ENDIF
    218 
    219        IF (flag_LWup200clr(iff)<=lev_files(iff)) THEN
    220       CALL histwrite_phy(nid_files(iff),"LWup200clr",itau_w,LWup200clr)
    221        ENDIF
    222 
    223        IF (flag_LWdn200(iff)<=lev_files(iff)) THEN
    224       CALL histwrite_phy(nid_files(iff),"LWdn200",itau_w,zx_tmp_fi2d)
    225        ENDIF
    226 
    227        IF (flag_LWdn200clr(iff)<=lev_files(iff)) THEN
    228       CALL histwrite_phy(nid_files(iff),"LWdn200clr",itau_w,zx_tmp_fi2d)
    229        ENDIF
    230 
    231        IF (flag_sols(iff)<=lev_files(iff)) THEN
    232       CALL histwrite_phy(nid_files(iff),"sols",itau_w,solsw)
    233        ENDIF
    234 
    235        IF (flag_sols0(iff)<=lev_files(iff)) THEN
    236       CALL histwrite_phy(nid_files(iff),"sols0",itau_w,solsw0)
    237        ENDIF
    238 
    239        IF (flag_soll(iff)<=lev_files(iff)) THEN
    240       CALL histwrite_phy(nid_files(iff),"soll",itau_w,sollw)
    241        ENDIF
    242 
    243        IF (flag_radsol(iff)<=lev_files(iff)) THEN
    244       CALL histwrite_phy(nid_files(iff),"radsol",itau_w,radsol)
    245        ENDIF
    246 
    247        IF (flag_soll0(iff)<=lev_files(iff)) THEN
    248       CALL histwrite_phy(nid_files(iff),"soll0",itau_w,sollw0)
    249        ENDIF
    250 
    251        IF (flag_SWupSFC(iff)<=lev_files(iff)) THEN
     189     $                  o_SWdnTOAclr%name,itau_w,zx_tmp_fi2d)
     190       ENDIF
     191
     192       IF (o_SWup200%flag(iff)<=lev_files(iff)) THEN
     193      CALL histwrite_phy(nid_files(iff),o_SWup200%name,itau_w,SWup200)
     194       ENDIF
     195
     196       IF (o_SWup200clr%flag(iff)<=lev_files(iff)) THEN
     197      CALL histwrite_phy(nid_files(iff),
     198     s                   o_SWup200clr%name,itau_w,SWup200clr)
     199       ENDIF
     200
     201       IF (o_SWdn200%flag(iff)<=lev_files(iff)) THEN
     202      CALL histwrite_phy(nid_files(iff),o_SWdn200%name,itau_w,SWdn200)
     203       ENDIF
     204
     205       IF (o_SWdn200clr%flag(iff)<=lev_files(iff)) THEN
     206      CALL histwrite_phy(nid_files(iff),
     207     s                o_SWdn200clr%name,itau_w,SWdn200clr)
     208       ENDIF
     209
     210       IF (o_LWup200%flag(iff)<=lev_files(iff)) THEN
     211      CALL histwrite_phy(nid_files(iff),o_LWup200%name,itau_w,LWup200)
     212       ENDIF
     213
     214       IF (o_LWup200clr%flag(iff)<=lev_files(iff)) THEN
     215      CALL histwrite_phy(nid_files(iff),
     216     s                   o_LWup200clr%name,itau_w,LWup200clr)
     217       ENDIF
     218
     219       IF (o_LWdn200%flag(iff)<=lev_files(iff)) THEN
     220      CALL histwrite_phy(nid_files(iff),
     221     s                   o_LWdn200%name,itau_w,zx_tmp_fi2d)
     222       ENDIF
     223
     224       IF (o_LWdn200clr%flag(iff)<=lev_files(iff)) THEN
     225      CALL histwrite_phy(nid_files(iff),
     226     s                  o_LWdn200clr%name,itau_w,zx_tmp_fi2d)
     227       ENDIF
     228
     229       IF (o_sols%flag(iff)<=lev_files(iff)) THEN
     230      CALL histwrite_phy(nid_files(iff),o_sols%name,itau_w,solsw)
     231       ENDIF
     232
     233       IF (o_sols0%flag(iff)<=lev_files(iff)) THEN
     234      CALL histwrite_phy(nid_files(iff),o_sols0%name,itau_w,solsw0)
     235       ENDIF
     236
     237       IF (o_soll%flag(iff)<=lev_files(iff)) THEN
     238      CALL histwrite_phy(nid_files(iff),o_soll%name,itau_w,sollw)
     239       ENDIF
     240
     241       IF (o_radsol%flag(iff)<=lev_files(iff)) THEN
     242      CALL histwrite_phy(nid_files(iff),o_radsol%name,itau_w,radsol)
     243       ENDIF
     244
     245       IF (o_soll0%flag(iff)<=lev_files(iff)) THEN
     246      CALL histwrite_phy(nid_files(iff),o_soll0%name,itau_w,sollw0)
     247       ENDIF
     248
     249       IF (o_SWupSFC%flag(iff)<=lev_files(iff)) THEN
    252250      zx_tmp_fi2d(1 : klon) = swup ( 1 : klon, 1 )
    253       CALL histwrite_phy(nid_files(iff), "SWupSFC",itau_w,zx_tmp_fi2d)
    254        ENDIF
    255 
    256        IF (flag_SWupSFCclr(iff)<=lev_files(iff)) THEN
     251      CALL histwrite_phy(nid_files(iff),
     252     s               o_SWupSFC%name,itau_w,zx_tmp_fi2d)
     253       ENDIF
     254
     255       IF (o_SWupSFCclr%flag(iff)<=lev_files(iff)) THEN
    257256      zx_tmp_fi2d(1 : klon) = swup0 ( 1 : klon, 1 )
    258257      CALL histwrite_phy(nid_files(iff),
    259      $                   "SWupSFCclr",itau_w,zx_tmp_fi2d)
    260        ENDIF
    261 
    262        IF (flag_SWdnSFC(iff)<=lev_files(iff)) THEN
     258     $                   o_SWupSFCclr%name,itau_w,zx_tmp_fi2d)
     259       ENDIF
     260
     261       IF (o_SWdnSFC%flag(iff)<=lev_files(iff)) THEN
    263262      zx_tmp_fi2d(1 : klon) = swdn ( 1 : klon, 1 )
    264263      CALL histwrite_phy(nid_files(iff),
    265      $                   "SWdnSFC",itau_w,zx_tmp_fi2d)
    266        ENDIF
    267 
    268        IF (flag_SWdnSFCclr(iff)<=lev_files(iff)) THEN
     264     $                   o_SWdnSFC%name,itau_w,zx_tmp_fi2d)
     265       ENDIF
     266
     267       IF (o_SWdnSFCclr%flag(iff)<=lev_files(iff)) THEN
    269268      zx_tmp_fi2d(1 : klon) = swdn0 ( 1 : klon, 1 )
    270269      CALL histwrite_phy(nid_files(iff),
    271      $                  "SWdnSFCclr",itau_w,zx_tmp_fi2d)
    272        ENDIF
    273 
    274        IF (flag_LWupSFC(iff)<=lev_files(iff)) THEN
     270     $                  o_SWdnSFCclr%name,itau_w,zx_tmp_fi2d)
     271       ENDIF
     272
     273       IF (o_LWupSFC%flag(iff)<=lev_files(iff)) THEN
    275274      zx_tmp_fi2d(1:klon)=sollwdown(1:klon)-sollw(1:klon)
    276275      CALL histwrite_phy(nid_files(iff),
    277      $                    "LWupSFC",itau_w,zx_tmp_fi2d)
    278        ENDIF
    279 
    280        IF (flag_LWdnSFC(iff)<=lev_files(iff)) THEN
    281       CALL histwrite_phy(nid_files(iff),
    282      $                   "LWdnSFC",itau_w,sollwdown)
     276     $                    o_LWupSFC%name,itau_w,zx_tmp_fi2d)
     277       ENDIF
     278
     279       IF (o_LWdnSFC%flag(iff)<=lev_files(iff)) THEN
     280      CALL histwrite_phy(nid_files(iff),
     281     $                   o_LWdnSFC%name,itau_w,sollwdown)
    283282       ENDIF
    284283
    285284       sollwdownclr(1:klon) = -1.*lwdn0(1:klon,1)
    286        IF (flag_LWupSFCclr(iff)<=lev_files(iff)) THEN
     285       IF (o_LWupSFCclr%flag(iff)<=lev_files(iff)) THEN
    287286      zx_tmp_fi2d(1:klon)=sollwdownclr(1:klon)-sollw0(1:klon)
    288287      CALL histwrite_phy(nid_files(iff),
    289      $                   "LWupSFCclr",itau_w,zx_tmp_fi2d)
    290        ENDIF
    291 
    292        IF (flag_LWdnSFCclr(iff)<=lev_files(iff)) THEN
    293       CALL histwrite_phy(nid_files(iff),
    294      $                   "LWdnSFCclr",itau_w,sollwdownclr)
    295        ENDIF
    296 
    297        IF (flag_bils(iff)<=lev_files(iff)) THEN
    298       CALL histwrite_phy(nid_files(iff),"bils",itau_w,bils)
    299        ENDIF
    300 
    301        IF (flag_sens(iff)<=lev_files(iff)) THEN
     288     $                   o_LWupSFCclr%name,itau_w,zx_tmp_fi2d)
     289       ENDIF
     290
     291       IF (o_LWdnSFCclr%flag(iff)<=lev_files(iff)) THEN
     292      CALL histwrite_phy(nid_files(iff),
     293     $                   o_LWdnSFCclr%name,itau_w,sollwdownclr)
     294       ENDIF
     295
     296       IF (o_bils%flag(iff)<=lev_files(iff)) THEN
     297      CALL histwrite_phy(nid_files(iff),o_bils%name,itau_w,bils)
     298       ENDIF
     299
     300       IF (o_sens%flag(iff)<=lev_files(iff)) THEN
    302301      zx_tmp_fi2d(1:klon)=-1*sens(1:klon)
    303       CALL histwrite_phy(nid_files(iff),"sens",itau_w,zx_tmp_fi2d)
    304        ENDIF
    305 
    306        IF (flag_fder(iff)<=lev_files(iff)) THEN
    307       CALL histwrite_phy(nid_files(iff),"fder",itau_w,fder)
    308        ENDIF
    309 
    310        IF (flag_ffonte(iff)<=lev_files(iff)) THEN
    311        CALL histwrite_phy(nid_files(iff),"ffonte",itau_w,zxffonte)
    312        ENDIF
    313 
    314        IF (flag_fqcalving(iff)<=lev_files(iff)) THEN
     302      CALL histwrite_phy(nid_files(iff),o_sens%name,itau_w,zx_tmp_fi2d)
     303       ENDIF
     304
     305       IF (o_fder%flag(iff)<=lev_files(iff)) THEN
     306      CALL histwrite_phy(nid_files(iff),o_fder%name,itau_w,fder)
     307       ENDIF
     308
     309       IF (o_ffonte%flag(iff)<=lev_files(iff)) THEN
     310       CALL histwrite_phy(nid_files(iff),o_ffonte%name,itau_w,zxffonte)
     311       ENDIF
     312
     313       IF (o_fqcalving%flag(iff)<=lev_files(iff)) THEN
    315314       CALL histwrite_phy(nid_files(iff),
    316      $                    "fqcalving",itau_w,zxfqcalving)
    317        ENDIF
    318 
    319        IF (flag_fqfonte(iff)<=lev_files(iff)) THEN
     315     $                    o_fqcalving%name,itau_w,zxfqcalving)
     316       ENDIF
     317
     318       IF (o_fqfonte%flag(iff)<=lev_files(iff)) THEN
    320319       CALL histwrite_phy(nid_files(iff),
    321      $                    "fqfonte",itau_w,zxfqfonte)
     320     $                   o_fqfonte%name,itau_w,zxfqfonte)
    322321       ENDIF
    323322
    324323         DO nsrf = 1, nbsrf
    325            IF(nsrf.GE.2) THEN
    326             IF (flag_pourc_sol(iff)<=lev_files(iff)) THEN
     324!           IF(nsrf.GE.2) THEN
     325            IF (o_pourc_srf(nsrf)%flag(iff)<=lev_files(iff)) THEN
    327326            zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)*100.
    328327            CALL histwrite_phy(nid_files(iff),
    329      $                     "pourc_"//clnsurf(nsrf),itau_w,
     328     $                     o_pourc_srf(nsrf)%name,itau_w,
    330329     $                     zx_tmp_fi2d)
    331330            ENDIF
    332331
    333           IF (flag_fract_sol(iff)<=lev_files(iff)) THEN
     332          IF (o_fract_srf(nsrf)%flag(iff)<=lev_files(iff)) THEN
    334333          zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)
    335334          CALL histwrite_phy(nid_files(iff),
    336      $                    "fract_"//clnsurf(nsrf),itau_w,
     335     $                  o_fract_srf(nsrf)%name,itau_w,
     336     $                  zx_tmp_fi2d)
     337          ENDIF
     338!         ENDIF !nsrf.GT.2
     339
     340        IF (o_taux_srf(nsrf)%flag(iff)<=lev_files(iff)) THEN
     341        zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)
     342        CALL histwrite_phy(nid_files(iff),
     343     $                     o_taux_srf(nsrf)%name,itau_w,
     344     $                     zx_tmp_fi2d)
     345        ENDIF
     346
     347        IF (o_tauy_srf(nsrf)%flag(iff)<=lev_files(iff)) THEN           
     348        zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)
     349        CALL histwrite_phy(nid_files(iff),
     350     $                    o_tauy_srf(nsrf)%name,itau_w,
     351     $                    zx_tmp_fi2d)
     352        ENDIF
     353
     354        IF (o_tsol_srf(nsrf)%flag(iff)<=lev_files(iff)) THEN
     355        zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)
     356        CALL histwrite_phy(nid_files(iff),
     357     $                   o_tsol_srf(nsrf)%name,itau_w,
    337358     $      zx_tmp_fi2d)
    338           ENDIF
    339          ENDIF !nsrf.GT.2
    340 
    341         IF (flag_taux_sol(iff)<=lev_files(iff)) THEN
    342         zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)
    343         CALL histwrite_phy(nid_files(iff),
    344      $                     "taux_"//clnsurf(nsrf),itau_w,
    345      $      zx_tmp_fi2d)
    346         ENDIF
    347 
    348         IF (flag_tauy_sol(iff)<=lev_files(iff)) THEN           
    349         zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)
    350         CALL histwrite_phy(nid_files(iff),
    351      $                    "tauy_"//clnsurf(nsrf),itau_w,
    352      $      zx_tmp_fi2d)
    353         ENDIF
    354 
    355         IF (flag_tsol_sol(iff)<=lev_files(iff)) THEN
    356         zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)
    357         CALL histwrite_phy(nid_files(iff),
    358      $                   "tsol_"//clnsurf(nsrf),itau_w,
    359      $      zx_tmp_fi2d)
    360         ENDIF
    361 
    362       IF (flag_u10m_sol(iff)<=lev_files(iff)) THEN
     359        ENDIF
     360
     361      IF (o_u10m_srf(nsrf)%flag(iff)<=lev_files(iff)) THEN
    363362      zx_tmp_fi2d(1 : klon) = u10m(1 : klon, nsrf)
    364       CALL histwrite_phy(nid_files(iff),"u10m_"//clnsurf(nsrf),
     363      CALL histwrite_phy(nid_files(iff),o_u10m_srf(nsrf)%name,
    365364     $                 itau_w,zx_tmp_fi2d)
    366365      ENDIF
    367366
    368       IF (flag_v10m_sol(iff)<=lev_files(iff)) THEN
     367      IF (o_v10m_srf(nsrf)%flag(iff)<=lev_files(iff)) THEN
    369368      zx_tmp_fi2d(1 : klon) = v10m(1 : klon, nsrf)
    370       CALL histwrite_phy(nid_files(iff),"v10m_"//clnsurf(nsrf),
     369      CALL histwrite_phy(nid_files(iff),o_v10m_srf(nsrf)%name,
    371370     $              itau_w,zx_tmp_fi2d)
    372371      ENDIF
    373372 
    374       IF (flag_t2m_sol(iff)<=lev_files(iff)) THEN
     373      IF (o_t2m_srf(nsrf)%flag(iff)<=lev_files(iff)) THEN
    375374      zx_tmp_fi2d(1 : klon) = t2m(1 : klon, nsrf)
    376       CALL histwrite_phy(nid_files(iff),"t2m_"//clnsurf(nsrf),
     375      CALL histwrite_phy(nid_files(iff),o_t2m_srf(nsrf)%name,
    377376     $           itau_w,zx_tmp_fi2d)
    378377      ENDIF
    379378
    380        IF (flag_sens_sol(iff)<=lev_files(iff)) THEN
     379       IF (o_sens_srf(nsrf)%flag(iff)<=lev_files(iff)) THEN
    381380       zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)
    382381       CALL histwrite_phy(nid_files(iff),
    383      $                     "sens_"//clnsurf(nsrf),itau_w,
     382     $                    o_sens_srf(nsrf)%name,itau_w,
    384383     $      zx_tmp_fi2d)
    385384       ENDIF
    386385
    387         IF (flag_lat_sol(iff)<=lev_files(iff)) THEN
     386        IF (o_lat_srf(nsrf)%flag(iff)<=lev_files(iff)) THEN
    388387        zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)
    389388        CALL histwrite_phy(nid_files(iff),
    390      $                 "lat_"//clnsurf(nsrf),itau_w,
     389     $                 o_lat_srf(nsrf)%name,itau_w,
    391390     $                                   zx_tmp_fi2d)
    392391          ENDIF
    393392
    394         IF (flag_flw_sol(iff)<=lev_files(iff)) THEN
     393        IF (o_flw_srf(nsrf)%flag(iff)<=lev_files(iff)) THEN
    395394        zx_tmp_fi2d(1 : klon) = fsollw( 1 : klon, nsrf)
    396395        CALL histwrite_phy(nid_files(iff),
    397      $                     "flw_"//clnsurf(nsrf),itau_w,
     396     $                     o_flw_srf(nsrf)%name,itau_w,
    398397     $      zx_tmp_fi2d)
    399398        ENDIF
    400399
    401         IF (flag_fsw_sol(iff)<=lev_files(iff)) THEN
     400        IF (o_fsw_srf(nsrf)%flag(iff)<=lev_files(iff)) THEN
    402401        zx_tmp_fi2d(1 : klon) = fsolsw( 1 : klon, nsrf)
    403402        CALL histwrite_phy(nid_files(iff),
    404      $                     "fsw_"//clnsurf(nsrf),itau_w,
     403     $                   o_fsw_srf(nsrf)%name,itau_w,
    405404     $      zx_tmp_fi2d)
    406405        ENDIF
    407406
    408         IF (flag_wbils_sol(iff)<=lev_files(iff)) THEN
     407        IF (o_wbils_srf(nsrf)%flag(iff)<=lev_files(iff)) THEN
    409408        zx_tmp_fi2d(1 : klon) = wfbils( 1 : klon, nsrf)
    410409        CALL histwrite_phy(nid_files(iff),
    411      $                     "wbils_"//clnsurf(nsrf),itau_w,
     410     $                   o_wbils_srf(nsrf)%name,itau_w,
    412411     $      zx_tmp_fi2d)
    413412        ENDIF
    414413
    415         IF (flag_wbilo_sol(iff)<=lev_files(iff)) THEN
     414        IF (o_wbilo_srf(nsrf)%flag(iff)<=lev_files(iff)) THEN
    416415        zx_tmp_fi2d(1 : klon) = wfbilo( 1 : klon, nsrf)
    417416        CALL histwrite_phy(nid_files(iff),
    418      $                    "wbilo_"//clnsurf(nsrf),itau_w,
     417     $                    o_wbilo_srf(nsrf)%name,itau_w,
    419418     $      zx_tmp_fi2d)
    420419        ENDIF
    421420
    422421       if (iflag_pbl>1 .and. lev_histday.gt.10 ) then
    423         IF (flag_tke_sol(iff)<=lev_files(iff)) THEN
    424         CALL histwrite_phy(nid_files(iff),
    425      $                    "tke_"//clnsurf(nsrf),itau_w,
    426      $      pbl_tke(:,1:klev,nsrf))
    427        ENDIF
    428 
    429         IF (flag_tke_max_sol(iff)<=lev_files(iff)) THEN
    430         CALL histwrite_phy(nid_files(iff),
    431      $                    "tke_max_"//clnsurf(nsrf),itau_w,
     422        IF (o_tke_srf(nsrf)%flag(iff)<=lev_files(iff)) THEN
     423        CALL histwrite_phy(nid_files(iff),
     424     $                   o_tke_srf(nsrf)%name,itau_w,
     425     $                    pbl_tke(:,1:klev,nsrf))
     426       ENDIF
     427
     428        IF (o_tke_max_srf(nsrf)%flag(iff)<=lev_files(iff)) THEN
     429        CALL histwrite_phy(nid_files(iff),
     430     $                    o_tke_max_srf(nsrf)%name,itau_w,
    432431     $      pbl_tke(:,1:klev,nsrf))
    433432        ENDIF
    … …  
    435434      ENDDO
    436435
    437         IF (flag_cdrm(iff)<=lev_files(iff)) THEN
    438       CALL histwrite_phy(nid_files(iff),"cdrm",itau_w,cdragm)
    439         ENDIF
    440 
    441         IF (flag_cdrh(iff)<=lev_files(iff)) THEN
    442       CALL histwrite_phy(nid_files(iff),"cdrh",itau_w,cdragh)
    443         ENDIF
    444 
    445         IF (flag_cldl(iff)<=lev_files(iff)) THEN
    446       CALL histwrite_phy(nid_files(iff),"cldl",itau_w,cldl)
    447         ENDIF
    448 
    449         IF (flag_cldm(iff)<=lev_files(iff)) THEN
    450       CALL histwrite_phy(nid_files(iff),"cldm",itau_w,cldm)
    451         ENDIF
    452 
    453         IF (flag_cldh(iff)<=lev_files(iff)) THEN
    454       CALL histwrite_phy(nid_files(iff),"cldh",itau_w,cldh)
    455         ENDIF
    456 
    457         IF (flag_cldt(iff)<=lev_files(iff)) THEN
    458       CALL histwrite_phy(nid_files(iff),"cldt",
     436        IF (o_cdrm%flag(iff)<=lev_files(iff)) THEN
     437      CALL histwrite_phy(nid_files(iff),o_cdrm%name,itau_w,cdragm)
     438        ENDIF
     439
     440        IF (o_cdrh%flag(iff)<=lev_files(iff)) THEN
     441      CALL histwrite_phy(nid_files(iff),o_cdrh%name,itau_w,cdragh)
     442        ENDIF
     443
     444        IF (o_cldl%flag(iff)<=lev_files(iff)) THEN
     445      CALL histwrite_phy(nid_files(iff),o_cldl%name,itau_w,cldl)
     446        ENDIF
     447
     448        IF (o_cldm%flag(iff)<=lev_files(iff)) THEN
     449      CALL histwrite_phy(nid_files(iff),o_cldm%name,itau_w,cldm)
     450        ENDIF
     451
     452        IF (o_cldh%flag(iff)<=lev_files(iff)) THEN
     453      CALL histwrite_phy(nid_files(iff),o_cldh%name,itau_w,cldh)
     454        ENDIF
     455
     456        IF (o_cldt%flag(iff)<=lev_files(iff)) THEN
     457      CALL histwrite_phy(nid_files(iff),o_cldt%name,
    459458     &                   itau_w,cldt*100)
    460459        ENDIF
    461460
    462         IF (flag_cldq(iff)<=lev_files(iff)) THEN
    463       CALL histwrite_phy(nid_files(iff),"cldq",itau_w,cldq)
    464         ENDIF
    465 
    466         IF (flag_lwp(iff)<=lev_files(iff)) THEN
     461        IF (o_cldq%flag(iff)<=lev_files(iff)) THEN
     462      CALL histwrite_phy(nid_files(iff),o_cldq%name,itau_w,cldq)
     463        ENDIF
     464
     465        IF (o_lwp%flag(iff)<=lev_files(iff)) THEN
    467466      zx_tmp_fi2d(1:klon) = flwp(1:klon)
    468       CALL histwrite_phy(nid_files(iff),"lwp",itau_w,zx_tmp_fi2d)
    469         ENDIF
    470 
    471         IF (flag_iwp(iff)<=lev_files(iff)) THEN
     467      CALL histwrite_phy(nid_files(iff),
     468     s                   o_lwp%name,itau_w,zx_tmp_fi2d)
     469        ENDIF
     470
     471        IF (o_iwp%flag(iff)<=lev_files(iff)) THEN
    472472      zx_tmp_fi2d(1:klon) = fiwp(1:klon)
    473       CALL histwrite_phy(nid_files(iff),"iwp",itau_w,zx_tmp_fi2d)
    474         ENDIF
    475 
    476         IF (flag_ue(iff)<=lev_files(iff)) THEN
    477       CALL histwrite_phy(nid_files(iff),"ue",itau_w,ue)
    478         ENDIF
    479 
    480         IF (flag_ve(iff)<=lev_files(iff)) THEN
    481       CALL histwrite_phy(nid_files(iff),"ve",itau_w,ve)
    482         ENDIF
    483 
    484         IF (flag_uq(iff)<=lev_files(iff)) THEN
    485       CALL histwrite_phy(nid_files(iff),"uq",itau_w,uq)
    486         ENDIF
    487 
    488         IF (flag_vq(iff)<=lev_files(iff)) THEN
    489       CALL histwrite_phy(nid_files(iff),"vq",itau_w,vq)
     473      CALL histwrite_phy(nid_files(iff),
     474     s                    o_iwp%name,itau_w,zx_tmp_fi2d)
     475        ENDIF
     476
     477        IF (o_ue%flag(iff)<=lev_files(iff)) THEN
     478      CALL histwrite_phy(nid_files(iff),o_ue%name,itau_w,ue)
     479        ENDIF
     480
     481        IF (o_ve%flag(iff)<=lev_files(iff)) THEN
     482      CALL histwrite_phy(nid_files(iff),o_ve%name,itau_w,ve)
     483        ENDIF
     484
     485        IF (o_uq%flag(iff)<=lev_files(iff)) THEN
     486      CALL histwrite_phy(nid_files(iff),o_uq%name,itau_w,uq)
     487        ENDIF
     488
     489        IF (o_vq%flag(iff)<=lev_files(iff)) THEN
     490      CALL histwrite_phy(nid_files(iff),o_vq%name,itau_w,vq)
    490491        ENDIF
    491492
    492493      IF(iflag_con.GE.3) THEN ! sb
    493         IF (flag_cape(iff)<=lev_files(iff)) THEN
    494       CALL histwrite_phy(nid_files(iff),"cape",itau_w,cape)
    495         ENDIF
    496 
    497         IF (flag_pbase(iff)<=lev_files(iff)) THEN
    498       CALL histwrite_phy(nid_files(iff),"pbase",itau_w,pbase)
    499         ENDIF
    500 
    501         IF (flag_ptop(iff)<=lev_files(iff)) THEN
    502       CALL histwrite_phy(nid_files(iff),"ptop",itau_w,ema_pct)
    503         ENDIF
    504 
    505         IF (flag_fbase(iff)<=lev_files(iff)) THEN
    506       CALL histwrite_phy(nid_files(iff),"fbase",itau_w,ema_cbmf)
    507         ENDIF
    508 
    509         IF (flag_prw(iff)<=lev_files(iff)) THEN
    510       CALL histwrite_phy(nid_files(iff),"prw",itau_w,prw)
    511         ENDIF
    512 !!! IM beg
    513       IF (flag_cape_max(iff)<=lev_files(iff)) THEN
    514        CALL histwrite_phy(nid_files(iff),"cape_max",itau_w,cape)
    515       ENDIF
    516       IF (flag_upwd(iff)<=lev_files(iff)) THEN
    517        CALL histwrite_phy(nid_files(iff),"upwd",itau_w,upwd)
    518       ENDIF
    519       IF (flag_Ma(iff)<=lev_files(iff)) THEN
    520        CALL histwrite_phy(nid_files(iff),"Ma",itau_w,Ma)
    521       ENDIF
    522 
    523       IF (flag_dnwd(iff)<=lev_files(iff)) THEN
    524        CALL histwrite_phy(nid_files(iff),"dnwd",itau_w,dnwd)
    525       ENDIF
    526 
    527       IF (flag_dnwd0(iff)<=lev_files(iff)) THEN
    528        CALL histwrite_phy(nid_files(iff),"dnwd0",itau_w,dnwd0)
    529       ENDIF
    530 !!! IM end
     494        IF (o_cape%flag(iff)<=lev_files(iff)) THEN
     495      CALL histwrite_phy(nid_files(iff),o_cape%name,itau_w,cape)
     496        ENDIF
     497
     498        IF (o_pbase%flag(iff)<=lev_files(iff)) THEN
     499      CALL histwrite_phy(nid_files(iff),o_pbase%name,itau_w,pbase)
     500        ENDIF
     501
     502        IF (o_ptop%flag(iff)<=lev_files(iff)) THEN
     503      CALL histwrite_phy(nid_files(iff),o_ptop%name,itau_w,ema_pct)
     504        ENDIF
     505
     506        IF (o_fbase%flag(iff)<=lev_files(iff)) THEN
     507      CALL histwrite_phy(nid_files(iff),o_fbase%name,itau_w,ema_cbmf)
     508        ENDIF
     509
     510        IF (o_prw%flag(iff)<=lev_files(iff)) THEN
     511      CALL histwrite_phy(nid_files(iff),o_prw%name,itau_w,prw)
     512        ENDIF
     513
     514      IF (o_cape_max%flag(iff)<=lev_files(iff)) THEN
     515      CALL histwrite_phy(nid_files(iff),o_cape_max%name,itau_w,cape)
     516      ENDIF
     517
     518       IF (o_upwd%flag(iff)<=lev_files(iff)) THEN
     519      CALL histwrite_phy(nid_files(iff),o_upwd%name,itau_w,upwd)
     520       ENDIF
     521
     522       IF (o_Ma%flag(iff)<=lev_files(iff)) THEN
     523      CALL histwrite_phy(nid_files(iff),o_Ma%name,itau_w,Ma)
     524       ENDIF
     525
     526       IF (o_dnwd%flag(iff)<=lev_files(iff)) THEN
     527      CALL histwrite_phy(nid_files(iff),o_dnwd%name,itau_w,dnwd)
     528       ENDIF
     529
     530       IF (o_dnwd0%flag(iff)<=lev_files(iff)) THEN
     531      CALL histwrite_phy(nid_files(iff),o_dnwd0%name,itau_w,dnwd0)
     532       ENDIF
     533
    531534      ENDIF !iflag_con .GE. 3
    532535
    533         IF (flag_s_pblh(iff)<=lev_files(iff)) THEN
    534       CALL histwrite_phy(nid_files(iff),"s_pblh",itau_w,s_pblh)
    535         ENDIF
    536 
    537         IF (flag_s_pblt(iff)<=lev_files(iff)) THEN
    538       CALL histwrite_phy(nid_files(iff),"s_pblt",itau_w,s_pblt)
    539         ENDIF
    540 
    541         IF (flag_s_lcl(iff)<=lev_files(iff)) THEN
    542       CALL histwrite_phy(nid_files(iff),"s_lcl",itau_w,s_lcl)
    543         ENDIF
    544 
    545         IF (flag_s_capCL(iff)<=lev_files(iff)) THEN
    546       CALL histwrite_phy(nid_files(iff),"s_capCL",itau_w,s_capCL)
    547         ENDIF
    548 
    549         IF (flag_s_oliqCL(iff)<=lev_files(iff)) THEN
    550       CALL histwrite_phy(nid_files(iff),"s_oliqCL",itau_w,s_oliqCL)
    551         ENDIF
    552 
    553         IF (flag_s_cteiCL(iff)<=lev_files(iff)) THEN
    554       CALL histwrite_phy(nid_files(iff),"s_cteiCL",itau_w,s_cteiCL)
    555         ENDIF
    556 
    557         IF (flag_s_therm(iff)<=lev_files(iff)) THEN
    558       CALL histwrite_phy(nid_files(iff),"s_therm",itau_w,s_therm)
    559         ENDIF
    560 
    561         IF (flag_s_trmb1(iff)<=lev_files(iff)) THEN
    562       CALL histwrite_phy(nid_files(iff),"s_trmb1",itau_w,s_trmb1)
    563         ENDIF
    564 
    565         IF (flag_s_trmb2(iff)<=lev_files(iff)) THEN
    566       CALL histwrite_phy(nid_files(iff),"s_trmb2",itau_w,s_trmb2)
    567         ENDIF
    568 
    569         IF (flag_s_trmb3(iff)<=lev_files(iff)) THEN
    570       CALL histwrite_phy(nid_files(iff),"s_trmb3",itau_w,s_trmb3)
     536        IF (o_s_pblh%flag(iff)<=lev_files(iff)) THEN
     537      CALL histwrite_phy(nid_files(iff),o_s_pblh%name,itau_w,s_pblh)
     538        ENDIF
     539
     540        IF (o_s_pblt%flag(iff)<=lev_files(iff)) THEN
     541      CALL histwrite_phy(nid_files(iff),o_s_pblt%name,itau_w,s_pblt)
     542        ENDIF
     543
     544        IF (o_s_lcl%flag(iff)<=lev_files(iff)) THEN
     545      CALL histwrite_phy(nid_files(iff),o_s_lcl%name,itau_w,s_lcl)
     546        ENDIF
     547
     548        IF (o_s_capCL%flag(iff)<=lev_files(iff)) THEN
     549      CALL histwrite_phy(nid_files(iff),o_s_capCL%name,itau_w,s_capCL)
     550        ENDIF
     551
     552        IF (o_s_oliqCL%flag(iff)<=lev_files(iff)) THEN
     553      CALL histwrite_phy(nid_files(iff),o_s_oliqCL%name,itau_w,s_oliqCL)
     554        ENDIF
     555
     556        IF (o_s_cteiCL%flag(iff)<=lev_files(iff)) THEN
     557      CALL histwrite_phy(nid_files(iff),o_s_cteiCL%name,itau_w,s_cteiCL)
     558        ENDIF
     559
     560        IF (o_s_therm%flag(iff)<=lev_files(iff)) THEN
     561      CALL histwrite_phy(nid_files(iff),o_s_therm%name,itau_w,s_therm)
     562        ENDIF
     563
     564        IF (o_s_trmb1%flag(iff)<=lev_files(iff)) THEN
     565      CALL histwrite_phy(nid_files(iff),o_s_trmb1%name,itau_w,s_trmb1)
     566        ENDIF
     567
     568        IF (o_s_trmb2%flag(iff)<=lev_files(iff)) THEN
     569      CALL histwrite_phy(nid_files(iff),o_s_trmb2%name,itau_w,s_trmb2)
     570        ENDIF
     571
     572        IF (o_s_trmb3%flag(iff)<=lev_files(iff)) THEN
     573      CALL histwrite_phy(nid_files(iff),o_s_trmb3%name,itau_w,s_trmb3)
    571574        ENDIF
    572575
    … …  
    578581!      on ecrit u v t q a 850 700 500 200 au niv 3
    579582
     583        ll=0
    580584        DO k=1, nlevSTD
    581585         IF(k.GE.2.AND.k.LE.12) bb2=clevSTD(k)
    … …  
    585589
    586590! a refaire correctement !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    587        IF (flag_ulevsSTD(iff)<=lev_files(iff)) THEN
    588        CALL histwrite_phy(nid_files(iff),"u"//bb2,
    589      & itau_w,uwriteSTD(:,k,iff))
    590        ENDIF
    591 
    592        IF (flag_vlevsSTD(iff)<=lev_files(iff)) THEN
    593       CALL histwrite_phy(nid_files(iff),"v"//bb2, 
    594      & itau_w,vwriteSTD(:,k,iff))
    595        ENDIF
    596 
    597        IF (flag_wlevsSTD(iff)<=lev_files(iff)) THEN
    598       CALL histwrite_phy(nid_files(iff),"w"//bb2,
    599      & itau_w,wwriteSTD(:,k,iff))
    600        ENDIF
    601 
    602        IF (flag_philevsSTD(iff)<=lev_files(iff)) THEN
    603       CALL histwrite_phy(nid_files(iff),
    604      $                  "phi"//bb2,
     591          ll=ll+1
     592       IF (o_uSTDlevs(ll)%flag(iff)<=lev_files(iff)) THEN
     593       CALL histwrite_phy(nid_files(iff),o_uSTDlevs(ll)%name,
     594     &                    itau_w,uwriteSTD(:,k,iff))
     595       ENDIF
     596
     597       IF (o_vSTDlevs(ll)%flag(iff)<=lev_files(iff)) THEN
     598      CALL histwrite_phy(nid_files(iff),o_vSTDlevs(ll)%name, 
     599     &                   itau_w,vwriteSTD(:,k,iff))
     600       ENDIF
     601
     602       IF (o_wSTDlevs(ll)%flag(iff)<=lev_files(iff)) THEN
     603      CALL histwrite_phy(nid_files(iff),o_wSTDlevs(ll)%name,
     604     &                    itau_w,wwriteSTD(:,k,iff))
     605       ENDIF
     606
     607       IF (o_phiSTDlevs(ll)%flag(iff)<=lev_files(iff)) THEN
     608      CALL histwrite_phy(nid_files(iff),o_phiSTDlevs(ll)%name,
    605609     &               itau_w,phiwriteSTD(:,k,iff))
    606610       ENDIF
    607611
    608        IF (flag_qlevsSTD(iff)<=lev_files(iff)) THEN
    609       CALL histwrite_phy(nid_files(iff),"q"//bb2,
    610      & itau_w, qwriteSTD(:,k,iff))
    611        ENDIF
    612 
    613        IF (flag_tlevsSTD(iff)<=lev_files(iff)) THEN
    614       CALL histwrite_phy(nid_files(iff),"t"//bb2,
    615      & itau_w, twriteSTD(:,k,iff))
     612       IF (o_qSTDlevs(ll)%flag(iff)<=lev_files(iff)) THEN
     613      CALL histwrite_phy(nid_files(iff),o_qSTDlevs(ll)%name,
     614     &                   itau_w, qwriteSTD(:,k,iff))
     615       ENDIF
     616
     617       IF (o_tSTDlevs(ll)%flag(iff)<=lev_files(iff)) THEN
     618      CALL histwrite_phy(nid_files(iff),o_tSTDlevs(ll)%name,
     619     &                   itau_w, twriteSTD(:,k,iff))
    616620       ENDIF
    617621
    … …  
    619623       ENDDO
    620624
    621       IF (flag_t_oce_sic(iff)<=lev_files(iff)) THEN
     625      IF (o_t_oce_sic%flag(iff)<=lev_files(iff)) THEN
    622626      DO i=1, klon
    623627       IF (pctsrf(i,is_oce).GT.epsfra.OR.
    … …  
    630634       ENDIF
    631635      ENDDO
    632       CALL histwrite_phy(nid_files(iff),"t_oce_sic",itau_w,zx_tmp_fi2d)
    633       ENDIF
    634 
    635       IF (type_ocean=='force ') THEN
    636 
     636      CALL histwrite_phy(nid_files(iff),
     637     s                   o_t_oce_sic%name,itau_w,zx_tmp_fi2d)
     638      ENDIF
     639
     640! Couplage convection-couche limite
     641      IF (iflag_con.GE.3) THEN
     642      IF (iflag_coupl.EQ.1) THEN
     643       IF (o_ale_bl%flag(iff)<=lev_files(iff)) THEN
     644       CALL histwrite_phy(nid_files(iff),o_ale_bl%name,itau_w,ale_bl)
     645       ENDIF
     646       IF (o_alp_bl%flag(iff)<=lev_files(iff)) THEN
     647       CALL histwrite_phy(nid_files(iff),o_alp_bl%name,itau_w,alp_bl)
     648       ENDIF
     649      ENDIF !iflag_coupl.EQ.1
     650      ENDIF !(iflag_con.GE.3)
     651
     652! Wakes
    637653      IF (iflag_con.EQ.3) THEN
    638        IF (flag_ale(iff)<=lev_files(iff)) THEN
    639        CALL histwrite_phy(nid_files(iff),"ale",itau_w,ale)
    640        ENDIF
    641        IF (flag_alp(iff)<=lev_files(iff)) THEN
    642        CALL histwrite_phy(nid_files(iff),"alp",itau_w,alp)
    643        ENDIF
    644        IF (flag_cin(iff)<=lev_files(iff)) THEN
    645        CALL histwrite_phy(nid_files(iff),"cin",itau_w,cin)
    646        ENDIF
    647       IF (iflag_coupl.EQ.1) THEN
    648        IF (flag_ale_bl(iff)<=lev_files(iff)) THEN
    649        CALL histwrite_phy(nid_files(iff),"ale_bl",itau_w,ale_bl)
    650        ENDIF
    651        IF (flag_alp_bl(iff)<=lev_files(iff)) THEN
    652        CALL histwrite_phy(nid_files(iff),"alp_bl",itau_w,alp_bl)
    653        ENDIF
    654       ENDIF !iflag_coupl.EQ.1
    655 
    656654      IF (iflag_wake.EQ.1) THEN
    657        IF (flag_ale_wk(iff)<=lev_files(iff)) THEN
    658        CALL histwrite_phy(nid_files(iff),"ale_wk",itau_w,ale_wake)
    659        ENDIF
    660        IF (flag_alp_wk(iff)<=lev_files(iff)) THEN
    661        CALL histwrite_phy(nid_files(iff),"alp_wk",itau_w,alp_wake)
    662        ENDIF
    663 
    664        IF (flag_wape(iff)<=lev_files(iff)) THEN
    665        CALL histwrite_phy(nid_files(iff),"WAPE",itau_w,wake_pe)
    666        ENDIF
    667        IF (flag_wake_h(iff)<=lev_files(iff)) THEN
    668       CALL histwrite_phy(nid_files(iff),"wake_h",itau_w,wake_h)
    669        ENDIF
    670 
    671        IF (flag_wake_s(iff)<=lev_files(iff)) THEN
    672       CALL histwrite_phy(nid_files(iff),"wake_s",itau_w,wake_s)
    673        ENDIF
    674 
    675         IF (flag_wake_deltat(iff)<=lev_files(iff)) THEN
    676        CALL histwrite_phy(nid_files(iff),"wake_deltat",
     655       IF (o_ale_wk%flag(iff)<=lev_files(iff)) THEN
     656       CALL histwrite_phy(nid_files(iff),o_ale_wk%name,itau_w,ale_wake)
     657       ENDIF
     658       IF (o_alp_wk%flag(iff)<=lev_files(iff)) THEN
     659       CALL histwrite_phy(nid_files(iff),o_alp_wk%name,itau_w,alp_wake)
     660       ENDIF
     661
     662       IF (o_ale%flag(iff)<=lev_files(iff)) THEN
     663       CALL histwrite_phy(nid_files(iff),o_ale%name,itau_w,ale)
     664       ENDIF
     665       IF (o_alp%flag(iff)<=lev_files(iff)) THEN
     666       CALL histwrite_phy(nid_files(iff),o_alp%name,itau_w,alp)
     667       ENDIF
     668       IF (o_cin%flag(iff)<=lev_files(iff)) THEN
     669       CALL histwrite_phy(nid_files(iff),o_cin%name,itau_w,cin)
     670       ENDIF
     671       IF (o_wape%flag(iff)<=lev_files(iff)) THEN
     672       CALL histwrite_phy(nid_files(iff),o_WAPE%name,itau_w,wake_pe)
     673       ENDIF
     674       IF (o_wake_h%flag(iff)<=lev_files(iff)) THEN
     675      CALL histwrite_phy(nid_files(iff),o_wake_h%name,itau_w,wake_h)
     676       ENDIF
     677
     678       IF (o_wake_s%flag(iff)<=lev_files(iff)) THEN
     679      CALL histwrite_phy(nid_files(iff),o_wake_s%name,itau_w,wake_s)
     680       ENDIF
     681
     682        IF (o_wake_deltat%flag(iff)<=lev_files(iff)) THEN
     683       CALL histwrite_phy(nid_files(iff),o_wake_deltat%name,
    677684     $                     itau_w,wake_deltat)
    678685        ENDIF
    679686
    680         IF (flag_wake_deltaq(iff)<=lev_files(iff)) THEN
    681        CALL histwrite_phy(nid_files(iff),"wake_deltaq",
     687        IF (o_wake_deltaq%flag(iff)<=lev_files(iff)) THEN
     688       CALL histwrite_phy(nid_files(iff),o_wake_deltaq%name,
    682689     $                    itau_w,wake_deltaq)
    683690        ENDIF
    684691
    685         IF (flag_wake_omg(iff)<=lev_files(iff)) THEN
    686        CALL histwrite_phy(nid_files(iff),"wake_omg",itau_w,wake_omg)
    687         ENDIF
    688 !!!IM beg
    689         IF (flag_dtwak(iff)<=lev_files(iff)) THEN
    690           zx_tmp_fi3d(1:klon,1:klev)=d_t_wake(1:klon,1:klev)
     692        IF (o_wake_omg%flag(iff)<=lev_files(iff)) THEN
     693       CALL histwrite_phy(nid_files(iff),
     694     s                    o_wake_omg%name,itau_w,wake_omg)
     695        ENDIF
     696
     697         IF (o_dtwak%flag(iff)<=lev_files(iff)) THEN
     698           zx_tmp_fi3d(1:klon,1:klev)=d_t_wake(1:klon,1:klev)
    691699     &                                        /pdtphys
    692           CALL histwrite_phy(nid_files(iff),"dtwak",itau_w,zx_tmp_fi3d)
    693         ENDIF
    694 
    695         IF (flag_dqwak(iff)<=lev_files(iff)) THEN
    696          zx_tmp_fi3d(1:klon,1:klev)=d_q_wake(1:klon,1:klev)/pdtphys
    697          CALL histwrite_phy(nid_files(iff),"dqwak",itau_w,zx_tmp_fi3d)
    698         ENDIF
    699 
    700         IF (flag_ftd(iff)<=lev_files(iff)) THEN
    701        CALL histwrite_phy(nid_files(iff),"ftd",itau_w,ftd)
    702         ENDIF
    703 
    704         IF (flag_fqd(iff)<=lev_files(iff)) THEN
    705        CALL histwrite_phy(nid_files(iff),"fqd",itau_w,fqd)
    706         ENDIF
    707 !!!IM end
    708       ENDIF
    709 
    710        IF (flag_Vprecip(iff)<=lev_files(iff)) THEN
    711         CALL histwrite_phy(nid_files(iff),"Vprecip",itau_w,Vprecip)
    712        ENDIF
    713 
     700           CALL histwrite_phy(nid_files(iff),
     701     &                       o_dtwak%name,itau_w,zx_tmp_fi3d)
     702         ENDIF
     703
     704        IF (o_dqwak%flag(iff)<=lev_files(iff)) THEN
     705        zx_tmp_fi3d(1:klon,1:klev)=d_q_wake(1:klon,1:klev)/pdtphys
     706        CALL histwrite_phy(nid_files(iff),
     707     &                     o_dqwak%name,itau_w,zx_tmp_fi3d)
     708        ENDIF
     709      ENDIF ! iflag_wake.EQ.1
     710
     711        IF (o_Vprecip%flag(iff)<=lev_files(iff)) THEN
     712       CALL histwrite_phy(nid_files(iff),o_Vprecip%name,itau_w,Vprecip)
     713        ENDIF
     714
     715        IF (o_ftd%flag(iff)<=lev_files(iff)) THEN
     716       CALL histwrite_phy(nid_files(iff),o_ftd%name,itau_w,ftd)
     717        ENDIF
     718
     719        IF (o_fqd%flag(iff)<=lev_files(iff)) THEN
     720       CALL histwrite_phy(nid_files(iff),o_fqd%name,itau_w,fqd)
     721        ENDIF
    714722      ENDIF !(iflag_con.EQ.3)
    715723 
    716       ELSE IF (type_ocean=='slab  ') THEN
    717 
    718       IF ( flag_slab_bils(iff)<=lev_files(iff))
     724      IF (type_ocean=='slab ') THEN
     725      IF ( o_slab_bils%flag(iff)<=lev_files(iff))
    719726     $     CALL histwrite_phy(
    720      $     nid_files(iff),"slab_wbils_oce",itau_w,slab_wfbils)
     727     $     nid_files(iff),o_slab_bils%name,itau_w,slab_wfbils)
    721728
    722729      ENDIF !type_ocean == force/slab
    723730
    724       IF (flag_weakinv(iff)<=lev_files(iff)) THEN
    725       CALL histwrite_phy(nid_files(iff),"weakinv",itau_w,weak_inversion)
    726       ENDIF
    727 
    728       IF (flag_dthmin(iff)<=lev_files(iff)) THEN
    729       CALL histwrite_phy(nid_files(iff),"dthmin",itau_w,dthmin)
    730       ENDIF
    731 
    732        IF (flag_cldtau(iff)<=lev_files(iff)) THEN
    733        CALL histwrite_phy(nid_files(iff),"cldtau",itau_w,cldtau)
    734        ENDIF
    735 
    736        IF (flag_cldemi(iff)<=lev_files(iff)) THEN
    737        CALL histwrite_phy(nid_files(iff),"cldemi",itau_w,cldemi)
    738        ENDIF
    739 
    740 !      IF (flag_pr_con_l(iff)<=lev_files(iff)) THEN
    741 !      CALL histwrite_phy(nid_files(iff),"pmflxr",itau_w,pmflxr)
     731      IF (o_weakinv%flag(iff)<=lev_files(iff)) THEN
     732      CALL histwrite_phy(nid_files(iff),
     733     s                  o_weakinv%name,itau_w,weak_inversion)
     734      ENDIF
     735
     736      IF (o_dthmin%flag(iff)<=lev_files(iff)) THEN
     737      CALL histwrite_phy(nid_files(iff),o_dthmin%name,itau_w,dthmin)
     738      ENDIF
     739
     740       IF (o_cldtau%flag(iff)<=lev_files(iff)) THEN
     741       CALL histwrite_phy(nid_files(iff),o_cldtau%name,itau_w,cldtau)
     742       ENDIF
     743
     744       IF (o_cldemi%flag(iff)<=lev_files(iff)) THEN
     745       CALL histwrite_phy(nid_files(iff),o_cldemi%name,itau_w,cldemi)
     746       ENDIF
     747
     748!      IF (o_pr_con_l%flag(iff)<=lev_files(iff)) THEN
     749!      CALL histwrite_phy(nid_files(iff),o_pmflxr%name,itau_w,pmflxr)
    742750!      ENDIF
    743751
    744 !      IF (flag_pr_con_i(iff)<=lev_files(iff)) THEN
    745 !      CALL histwrite_phy(nid_files(iff),"pmflxs",itau_w,pmflxs)
     752!      IF (o_pr_con_i%flag(iff)<=lev_files(iff)) THEN
     753!      CALL histwrite_phy(nid_files(iff),o_pmflxs%name,itau_w,pmflxs)
    746754!      ENDIF
    747755
    748 !      IF (flag_pr_lsc_l(iff)<=lev_files(iff)) THEN
    749 !      CALL histwrite_phy(nid_files(iff),"prfl",itau_w,prfl)
     756!      IF (o_pr_lsc_l%flag(iff)<=lev_files(iff)) THEN
     757!      CALL histwrite_phy(nid_files(iff),o_prfl%name,itau_w,prfl)
    750758!      ENDIF
    751759
    752 !      IF (flag_pr_lsc_i(iff)<=lev_files(iff)) THEN
    753 !      CALL histwrite_phy(nid_files(iff),"psfl",itau_w,psfl)
     760!      IF (o_pr_lsc_i%flag(iff)<=lev_files(iff)) THEN
     761!      CALL histwrite_phy(nid_files(iff),o_psfl%name,itau_w,psfl)
    754762!      ENDIF
    755763
    756       IF (flag_rh2m(iff)<=lev_files(iff)) THEN
     764      IF (o_rh2m%flag(iff)<=lev_files(iff)) THEN
    757765      DO i=1, klon
    758766       zx_tmp_fi2d(i)=MIN(100.,rh2m(i)*100.)
    759767      ENDDO
    760       CALL histwrite_phy(nid_files(iff),"rh2m",itau_w,zx_tmp_fi2d)
    761       ENDIF
    762 
    763       IF (flag_qsat2m(iff)<=lev_files(iff)) THEN
    764       CALL histwrite_phy(nid_files(iff),"qsat2m",itau_w,qsat2m)
    765       ENDIF
    766 
    767       IF (flag_tpot(iff)<=lev_files(iff)) THEN
    768       CALL histwrite_phy(nid_files(iff),"tpot",itau_w,tpot)
    769       ENDIF
    770 
    771        IF (flag_tpote(iff)<=lev_files(iff)) THEN
    772       CALL histwrite_phy(nid_files(iff),"tpote",itau_w,tpote)
    773        ENDIF
    774 
    775       IF (flag_SWnetOR(iff)<=lev_files(iff)) THEN
     768      CALL histwrite_phy(nid_files(iff),o_rh2m%name,itau_w,zx_tmp_fi2d)
     769      ENDIF
     770
     771      IF (o_qsat2m%flag(iff)<=lev_files(iff)) THEN
     772      CALL histwrite_phy(nid_files(iff),o_qsat2m%name,itau_w,qsat2m)
     773      ENDIF
     774
     775      IF (o_tpot%flag(iff)<=lev_files(iff)) THEN
     776      CALL histwrite_phy(nid_files(iff),o_tpot%name,itau_w,tpot)
     777      ENDIF
     778
     779       IF (o_tpote%flag(iff)<=lev_files(iff)) THEN
     780      CALL histwrite_phy(nid_files(iff),o_tpote%name,itau_w,tpote)
     781       ENDIF
     782
     783      IF (o_SWnetOR%flag(iff)<=lev_files(iff)) THEN
    776784      zx_tmp_fi2d(1 : klon) = fsolsw( 1 : klon, is_ter)
    777       CALL histwrite_phy(nid_files(iff),"SWnetOR",itau_w, zx_tmp_fi2d)
    778       ENDIF
    779 
    780       IF (flag_SWdownOR(iff)<=lev_files(iff)) THEN
     785      CALL histwrite_phy(nid_files(iff),
     786     s                   o_SWnetOR%name,itau_w, zx_tmp_fi2d)
     787      ENDIF
     788
     789      IF (o_SWdownOR%flag(iff)<=lev_files(iff)) THEN
    781790      zx_tmp_fi2d(1:klon) = solsw(1:klon)/(1.-albsol1(1:klon))
    782       CALL histwrite_phy(nid_files(iff),"SWdownOR",itau_w, zx_tmp_fi2d)
    783       ENDIF
    784 
    785       IF (flag_LWdownOR(iff)<=lev_files(iff)) THEN
    786       CALL histwrite_phy(nid_files(iff),"LWdownOR",itau_w,sollwdown)
    787       ENDIF
    788 
    789       IF (flag_snowl(iff)<=lev_files(iff)) THEN
    790       CALL histwrite_phy(nid_files(iff),"snowl",itau_w,snow_lsc)
    791       ENDIF
    792 
    793       IF (flag_solldown(iff)<=lev_files(iff)) THEN
    794       CALL histwrite_phy(nid_files(iff),"solldown",itau_w,sollwdown)
    795       ENDIF
    796 
    797       IF (flag_dtsvdfo(iff)<=lev_files(iff)) THEN
    798       CALL histwrite_phy(nid_files(iff),"dtsvdfo",itau_w,d_ts(:,is_oce))
    799       ENDIF
    800 
    801       IF (flag_dtsvdft(iff)<=lev_files(iff)) THEN
    802       CALL histwrite_phy(nid_files(iff),"dtsvdft",itau_w,d_ts(:,is_ter))
    803       ENDIF
    804 
    805        IF (flag_dtsvdfg(iff)<=lev_files(iff)) THEN
    806         CALL histwrite_phy(nid_files(iff),
    807      $                     "dtsvdfg",itau_w, d_ts(:,is_lic))
    808        ENDIF
    809 
    810        IF (flag_dtsvdfi(iff)<=lev_files(iff)) THEN
    811       CALL histwrite_phy(nid_files(iff),"dtsvdfi",itau_w,d_ts(:,is_sic))
    812        ENDIF
    813 
    814        IF (flag_rugs(iff)<=lev_files(iff)) THEN
    815       CALL histwrite_phy(nid_files(iff),"rugs",itau_w,zxrugs)
     791      CALL histwrite_phy(nid_files(iff),
     792     s                   o_SWdownOR%name,itau_w, zx_tmp_fi2d)
     793      ENDIF
     794
     795      IF (o_LWdownOR%flag(iff)<=lev_files(iff)) THEN
     796      CALL histwrite_phy(nid_files(iff),
     797     s                  o_LWdownOR%name,itau_w,sollwdown)
     798      ENDIF
     799
     800      IF (o_snowl%flag(iff)<=lev_files(iff)) THEN
     801      CALL histwrite_phy(nid_files(iff),o_snowl%name,itau_w,snow_lsc)
     802      ENDIF
     803
     804      IF (o_solldown%flag(iff)<=lev_files(iff)) THEN
     805      CALL histwrite_phy(nid_files(iff),
     806     s                   o_solldown%name,itau_w,sollwdown)
     807      ENDIF
     808
     809      IF (o_dtsvdfo%flag(iff)<=lev_files(iff)) THEN
     810      CALL histwrite_phy(nid_files(iff),
     811     s                 o_dtsvdfo%name,itau_w,d_ts(:,is_oce))
     812      ENDIF
     813
     814      IF (o_dtsvdft%flag(iff)<=lev_files(iff)) THEN
     815      CALL histwrite_phy(nid_files(iff),
     816     s                   o_dtsvdft%name,itau_w,d_ts(:,is_ter))
     817      ENDIF
     818
     819       IF (o_dtsvdfg%flag(iff)<=lev_files(iff)) THEN
     820        CALL histwrite_phy(nid_files(iff),
     821     $                   o_dtsvdfg%name,itau_w, d_ts(:,is_lic))
     822       ENDIF
     823
     824       IF (o_dtsvdfi%flag(iff)<=lev_files(iff)) THEN
     825      CALL histwrite_phy(nid_files(iff),
     826     s                   o_dtsvdfi%name,itau_w,d_ts(:,is_sic))
     827       ENDIF
     828
     829       IF (o_rugs%flag(iff)<=lev_files(iff)) THEN
     830      CALL histwrite_phy(nid_files(iff),o_rugs%name,itau_w,zxrugs)
     831       ENDIF
     832
     833       IF (ok_ade) THEN
     834        IF (o_topswad%flag(iff)<=lev_files(iff)) THEN
     835      CALL histwrite_phy(nid_files(iff),o_topswad%name,itau_w,topswad)
     836        ENDIF
     837        IF (o_solswad%flag(iff)<=lev_files(iff)) THEN
     838      CALL histwrite_phy(nid_files(iff),o_solswad%name,itau_w,solswad)
     839        ENDIF
     840       ENDIF
     841
     842       IF (ok_aie) THEN
     843        IF (o_topswai%flag(iff)<=lev_files(iff)) THEN
     844      CALL histwrite_phy(nid_files(iff),o_topswai%name,itau_w,topswai)
     845        ENDIF
     846        IF (o_solswai%flag(iff)<=lev_files(iff)) THEN
     847      CALL histwrite_phy(nid_files(iff),o_solswai%name,itau_w,solswai)
     848        ENDIF
    816849       ENDIF
    817850
    818851! Champs 3D:
    819        IF (flag_lwcon(iff)<=lev_files(iff)) THEN
    820       CALL histwrite_phy(nid_files(iff),"lwcon",itau_w,flwc)
    821        ENDIF
    822 
    823        IF (flag_iwcon(iff)<=lev_files(iff)) THEN
    824       CALL histwrite_phy(nid_files(iff),"iwcon",itau_w,fiwc)
    825        ENDIF
    826 
    827        IF (flag_temp(iff)<=lev_files(iff)) THEN
    828       CALL histwrite_phy(nid_files(iff),"temp",itau_w,t_seri)
    829        ENDIF
    830 
    831        IF (flag_theta(iff)<=lev_files(iff)) THEN
    832       CALL histwrite_phy(nid_files(iff),"theta",itau_w,theta)
    833        ENDIF
    834 
    835        IF (flag_ovap(iff)<=lev_files(iff)) THEN
    836       CALL histwrite_phy(nid_files(iff),"ovap",itau_w,qx(:,:,ivap))
    837        ENDIF
    838 
    839        IF (flag_geop(iff)<=lev_files(iff)) THEN
    840       CALL histwrite_phy(nid_files(iff),"geop",itau_w,zphi)
    841        ENDIF
    842 
    843        IF (flag_vitu(iff)<=lev_files(iff)) THEN
    844       CALL histwrite_phy(nid_files(iff),"vitu",itau_w,u_seri)
    845        ENDIF
    846 
    847        IF (flag_vitv(iff)<=lev_files(iff)) THEN
    848       CALL histwrite_phy(nid_files(iff),"vitv",itau_w,v_seri)
    849        ENDIF
    850 
    851        IF (flag_vitw(iff)<=lev_files(iff)) THEN
    852       CALL histwrite_phy(nid_files(iff),"vitw",itau_w,omega)
    853        ENDIF
    854 
    855         IF (flag_pres(iff)<=lev_files(iff)) THEN
    856       CALL histwrite_phy(nid_files(iff),"pres",itau_w,pplay)
    857         ENDIF
    858 
    859        IF (flag_rneb(iff)<=lev_files(iff)) THEN
    860       CALL histwrite_phy(nid_files(iff),"rneb",itau_w,cldfra)
    861        ENDIF
    862 
    863        IF (flag_rnebcon(iff)<=lev_files(iff)) THEN
    864       CALL histwrite_phy(nid_files(iff),"rnebcon",itau_w,rnebcon)
    865        ENDIF
    866 
    867        IF (flag_rhum(iff)<=lev_files(iff)) THEN
    868       CALL histwrite_phy(nid_files(iff),"rhum",itau_w,zx_rh)
    869        ENDIF
    870 
    871       IF (flag_ozone(iff)<=lev_files(iff)) THEN
     852       IF (o_lwcon%flag(iff)<=lev_files(iff)) THEN
     853      CALL histwrite_phy(nid_files(iff),o_lwcon%name,itau_w,flwc)
     854       ENDIF
     855
     856       IF (o_iwcon%flag(iff)<=lev_files(iff)) THEN
     857      CALL histwrite_phy(nid_files(iff),o_iwcon%name,itau_w,fiwc)
     858       ENDIF
     859
     860       IF (o_temp%flag(iff)<=lev_files(iff)) THEN
     861      CALL histwrite_phy(nid_files(iff),o_temp%name,itau_w,t_seri)
     862       ENDIF
     863
     864       IF (o_theta%flag(iff)<=lev_files(iff)) THEN
     865      CALL histwrite_phy(nid_files(iff),o_theta%name,itau_w,theta)
     866       ENDIF
     867
     868       IF (o_ovap%flag(iff)<=lev_files(iff)) THEN
     869      CALL histwrite_phy(nid_files(iff),o_ovap%name,itau_w,qx(:,:,ivap))
     870       ENDIF
     871
     872       IF (o_ovapinit%flag(iff)<=lev_files(iff)) THEN
     873      CALL histwrite_phy(nid_files(iff),
     874     $                   o_ovapinit%name,itau_w,q_seri)
     875       ENDIF
     876
     877       IF (o_geop%flag(iff)<=lev_files(iff)) THEN
     878      CALL histwrite_phy(nid_files(iff),o_geop%name,itau_w,zphi)
     879       ENDIF
     880
     881       IF (o_vitu%flag(iff)<=lev_files(iff)) THEN
     882      CALL histwrite_phy(nid_files(iff),o_vitu%name,itau_w,u_seri)
     883       ENDIF
     884
     885       IF (o_vitv%flag(iff)<=lev_files(iff)) THEN
     886      CALL histwrite_phy(nid_files(iff),o_vitv%name,itau_w,v_seri)
     887       ENDIF
     888
     889       IF (o_vitw%flag(iff)<=lev_files(iff)) THEN
     890      CALL histwrite_phy(nid_files(iff),o_vitw%name,itau_w,omega)
     891       ENDIF
     892
     893        IF (o_pres%flag(iff)<=lev_files(iff)) THEN
     894      CALL histwrite_phy(nid_files(iff),o_pres%name,itau_w,pplay)
     895        ENDIF
     896
     897       IF (o_rneb%flag(iff)<=lev_files(iff)) THEN
     898      CALL histwrite_phy(nid_files(iff),o_rneb%name,itau_w,cldfra)
     899       ENDIF
     900
     901       IF (o_rnebcon%flag(iff)<=lev_files(iff)) THEN
     902      CALL histwrite_phy(nid_files(iff),o_rnebcon%name,itau_w,rnebcon)
     903       ENDIF
     904
     905       IF (o_rhum%flag(iff)<=lev_files(iff)) THEN
     906      CALL histwrite_phy(nid_files(iff),o_rhum%name,itau_w,zx_rh)
     907       ENDIF
     908
     909      IF (o_ozone%flag(iff)<=lev_files(iff)) THEN
    872910      DO k=1, klev
    873911       DO i=1, klon
    … …  
    877915       ENDDO !i
    878916      ENDDO !k
    879       CALL histwrite_phy(nid_files(iff),"ozone",itau_w,zx_tmp_fi3d)
    880       ENDIF
    881 
    882        IF (flag_dtphy(iff)<=lev_files(iff)) THEN
    883       CALL histwrite_phy(nid_files(iff),"dtphy",itau_w,d_t)
    884        ENDIF
    885 
    886        IF (flag_dqphy(iff)<=lev_files(iff)) THEN
    887       CALL histwrite_phy(nid_files(iff),"dqphy",itau_w, d_qx(:,:,ivap))
     917      CALL histwrite_phy(nid_files(iff),o_ozone%name,itau_w,zx_tmp_fi3d)
     918      ENDIF
     919
     920       IF (o_dtphy%flag(iff)<=lev_files(iff)) THEN
     921      CALL histwrite_phy(nid_files(iff),o_dtphy%name,itau_w,d_t)
     922       ENDIF
     923
     924       IF (o_dqphy%flag(iff)<=lev_files(iff)) THEN
     925      CALL histwrite_phy(nid_files(iff),
     926     s                  o_dqphy%name,itau_w, d_qx(:,:,ivap))
    888927       ENDIF
    889928
    890929        DO nsrf=1, nbsrf
    891         IF (flag_albe_sol(iff)<=lev_files(iff)) THEN
     930        IF (o_albe_srf(nsrf)%flag(iff)<=lev_files(iff)) THEN
    892931        zx_tmp_fi2d(1 : klon) = falb1( 1 : klon, nsrf)
    893         CALL histwrite_phy(nid_files(iff),"albe_"//clnsurf(nsrf),itau_w,
     932        CALL histwrite_phy(nid_files(iff),
     933     s                    o_albe_srf(nsrf)%name,itau_w,
     934     $                     zx_tmp_fi2d)
     935        ENDIF
     936
     937        IF (o_rugs_srf(nsrf)%flag(iff)<=lev_files(iff)) THEN 
     938        zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)
     939        CALL histwrite_phy(nid_files(iff),
     940     s                     o_rugs_srf(nsrf)%name,itau_w,
    894941     $      zx_tmp_fi2d)
    895942        ENDIF
    896943
    897         IF (flag_rugs_sol(iff)<=lev_files(iff)) THEN 
    898         zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)
    899         CALL histwrite_phy(nid_files(iff),"rugs_"//clnsurf(nsrf),itau_w,
    900      $      zx_tmp_fi2d)
    901         ENDIF
    902 
    903         IF (flag_ages_sol(iff)<=lev_files(iff)) THEN
     944        IF (o_ages_srf(nsrf)%flag(iff)<=lev_files(iff)) THEN
    904945        zx_tmp_fi2d(1 : klon) = agesno( 1 : klon, nsrf)
    905         CALL histwrite_phy(nid_files(iff),"ages_"//clnsurf(nsrf),itau_w
     946        CALL histwrite_phy(nid_files(iff),
     947     s                     o_ages_srf(nsrf)%name,itau_w
    906948     $    ,zx_tmp_fi2d)
    907949        ENDIF
    908950        ENDDO !nsrf=1, nbsrf
    909951
    910        IF (flag_albs(iff)<=lev_files(iff)) THEN
    911       CALL histwrite_phy(nid_files(iff),"albs",itau_w,albsol1)
    912        ENDIF
    913 
    914        IF (flag_albslw(iff)<=lev_files(iff)) THEN
    915       CALL histwrite_phy(nid_files(iff),"albslw",itau_w,albsol2)
     952       IF (o_albs%flag(iff)<=lev_files(iff)) THEN
     953      CALL histwrite_phy(nid_files(iff),o_albs%name,itau_w,albsol1)
     954       ENDIF
     955
     956       IF (o_albslw%flag(iff)<=lev_files(iff)) THEN
     957      CALL histwrite_phy(nid_files(iff),o_albslw%name,itau_w,albsol2)
    916958       ENDIF
    917959
    … …  
    925967         enddo
    926968      enddo
    927        IF (flag_tke(iff)<=lev_files(iff)) THEN
    928       CALL histwrite_phy(nid_files(iff),"tke",itau_w,zx_tmp_fi3d)
    929        ENDIF
    930 
    931        IF (flag_tke_max(iff)<=lev_files(iff)) THEN
    932       CALL histwrite_phy(nid_files(iff),"tke_max",itau_w,zx_tmp_fi3d)
     969       IF (o_tke%flag(iff)<=lev_files(iff)) THEN
     970      CALL histwrite_phy(nid_files(iff),o_tke%name,itau_w,zx_tmp_fi3d)
     971       ENDIF
     972
     973       IF (o_tke_max%flag(iff)<=lev_files(iff)) THEN
     974      CALL histwrite_phy(nid_files(iff),
     975     s                   o_tke_max%name,itau_w,zx_tmp_fi3d)
    933976       ENDIF
    934977      endif
    935978
    936        IF (flag_kz(iff)<=lev_files(iff)) THEN
    937       ! combinaision de cdrag et le coef melange dans la meme variable
    938       zx_tmp_fi3d(:,1)     = cdragh(:)
    939       zx_tmp_fi3d(:,2:klev)= coefh(:,2:klev)
    940       CALL histwrite_phy(nid_files(iff),"kz",itau_w,zx_tmp_fi3d)
    941        ENDIF
    942 
    943        IF (flag_kz_max(iff)<=lev_files(iff)) THEN
    944       ! combinaision de cdrag et le coef melange dans la meme variable
    945       zx_tmp_fi3d(:,1)     = cdragh(:)
    946       zx_tmp_fi3d(:,2:klev)= coefh(:,2:klev)
    947       CALL histwrite_phy(nid_files(iff),"kz_max",itau_w,zx_tmp_fi3d)
    948        ENDIF
    949 
    950        IF (flag_clwcon(iff)<=lev_files(iff)) THEN
    951       CALL histwrite_phy(nid_files(iff),"clwcon",itau_w,clwcon0)
    952        ENDIF
    953 
    954        IF (flag_dtdyn(iff)<=lev_files(iff)) THEN
    955       CALL histwrite_phy(nid_files(iff),"dtdyn",itau_w,d_t_dyn)
    956        ENDIF
    957 
    958        IF (flag_dqdyn(iff)<=lev_files(iff)) THEN
    959       CALL histwrite_phy(nid_files(iff),"dqdyn",itau_w,d_q_dyn)
    960        ENDIF
    961 
    962        IF (flag_dudyn(iff)<=lev_files(iff)) THEN
    963       CALL histwrite_phy(nid_files(iff),"dudyn",itau_w,d_u_dyn)
     979       IF (o_kz%flag(iff)<=lev_files(iff)) THEN
     980      CALL histwrite_phy(nid_files(iff),o_kz%name,itau_w,coefh)
     981       ENDIF
     982
     983       IF (o_kz_max%flag(iff)<=lev_files(iff)) THEN
     984      CALL histwrite_phy(nid_files(iff),o_kz_max%name,itau_w,coefh)
     985       ENDIF
     986
     987       IF (o_clwcon%flag(iff)<=lev_files(iff)) THEN
     988      CALL histwrite_phy(nid_files(iff),o_clwcon%name,itau_w,clwcon0)
     989       ENDIF
     990
     991       IF (o_dtdyn%flag(iff)<=lev_files(iff)) THEN
     992      CALL histwrite_phy(nid_files(iff),o_dtdyn%name,itau_w,d_t_dyn)
     993       ENDIF
     994
     995       IF (o_dqdyn%flag(iff)<=lev_files(iff)) THEN
     996      CALL histwrite_phy(nid_files(iff),o_dqdyn%name,itau_w,d_q_dyn)
     997       ENDIF
     998
     999       IF (o_dudyn%flag(iff)<=lev_files(iff)) THEN
     1000      CALL histwrite_phy(nid_files(iff),o_dudyn%name,itau_w,d_u_dyn)
    9641001       ENDIF                                                   
    9651002
    966        IF (flag_dvdyn(iff)<=lev_files(iff)) THEN                 
    967       CALL histwrite_phy(nid_files(iff),"dvdyn",itau_w,d_v_dyn) 
     1003       IF (o_dvdyn%flag(iff)<=lev_files(iff)) THEN                 
     1004      CALL histwrite_phy(nid_files(iff),o_dvdyn%name,itau_w,d_v_dyn) 
    9681005       ENDIF                                                     
    9691006
    970        IF (flag_dtcon(iff)<=lev_files(iff)) THEN
     1007       IF (o_dtcon%flag(iff)<=lev_files(iff)) THEN
    9711008      zx_tmp_fi3d(1:klon,1:klev)=d_t_con(1:klon,1:klev)/pdtphys
    972       CALL histwrite_phy(nid_files(iff),"dtcon",itau_w,zx_tmp_fi3d)
    973        ENDIF
    974 
    975        IF (flag_ducon(iff)<=lev_files(iff)) THEN
     1009      CALL histwrite_phy(nid_files(iff),o_dtcon%name,itau_w,zx_tmp_fi3d)
     1010       ENDIF
     1011
     1012       IF (o_ducon%flag(iff)<=lev_files(iff)) THEN
    9761013      zx_tmp_fi3d(1:klon,1:klev)=d_u_con(1:klon,1:klev)/pdtphys
    977       CALL histwrite_phy(nid_files(iff),"ducon",itau_w,zx_tmp_fi3d)
    978        ENDIF
    979 
    980        IF (flag_dqcon(iff)<=lev_files(iff)) THEN
     1014      CALL histwrite_phy(nid_files(iff),o_ducon%name,itau_w,zx_tmp_fi3d)
     1015       ENDIF
     1016
     1017       IF (o_dqcon%flag(iff)<=lev_files(iff)) THEN
    9811018      zx_tmp_fi3d(1:klon,1:klev)=d_q_con(1:klon,1:klev)/pdtphys
    982       CALL histwrite_phy(nid_files(iff),"dqcon",itau_w,zx_tmp_fi3d)
    983        ENDIF
    984 
    985        IF (flag_dtlsc(iff)<=lev_files(iff)) THEN
     1019      CALL histwrite_phy(nid_files(iff),o_dqcon%name,itau_w,zx_tmp_fi3d)
     1020       ENDIF
     1021
     1022       IF (o_dtlsc%flag(iff)<=lev_files(iff)) THEN
    9861023      zx_tmp_fi3d(1:klon,1:klev)=d_t_lsc(1:klon,1:klev)/pdtphys
    987       CALL histwrite_phy(nid_files(iff),"dtlsc",itau_w,zx_tmp_fi3d)
    988        ENDIF
    989 
    990        IF (flag_dtlschr(iff)<=lev_files(iff)) THEN
     1024      CALL histwrite_phy(nid_files(iff),o_dtlsc%name,itau_w,zx_tmp_fi3d)
     1025       ENDIF
     1026
     1027       IF (o_dtlschr%flag(iff)<=lev_files(iff)) THEN
    9911028      zx_tmp_fi3d(1:klon, 1:klev)=(d_t_lsc(1:klon,1:klev)+
    9921029     $                           d_t_eva(1:klon,1:klev))/pdtphys
    993       CALL histwrite_phy(nid_files(iff),"dtlschr",itau_w,zx_tmp_fi3d)
    994        ENDIF
    995 
    996        IF (flag_dqlsc(iff)<=lev_files(iff)) THEN
     1030      CALL histwrite_phy(nid_files(iff),
     1031     s                   o_dtlschr%name,itau_w,zx_tmp_fi3d)
     1032       ENDIF
     1033
     1034       IF (o_dqlsc%flag(iff)<=lev_files(iff)) THEN
    9971035      zx_tmp_fi3d(1:klon,1:klev)=d_q_lsc(1:klon,1:klev)/pdtphys
    998       CALL histwrite_phy(nid_files(iff),"dqlsc",itau_w,zx_tmp_fi3d)
    999        ENDIF
    1000 
    1001        IF (flag_dtvdf(iff)<=lev_files(iff)) THEN
     1036      CALL histwrite_phy(nid_files(iff),o_dqlsc%name,itau_w,zx_tmp_fi3d)
     1037       ENDIF
     1038
     1039       IF (o_dtvdf%flag(iff)<=lev_files(iff)) THEN
    10021040      zx_tmp_fi3d(1:klon,1:klev)=d_t_vdf(1:klon,1:klev)/pdtphys
    1003       CALL histwrite_phy(nid_files(iff),"dtvdf",itau_w,zx_tmp_fi3d)
    1004        ENDIF
    1005 
    1006        IF (flag_dqvdf(iff)<=lev_files(iff)) THEN
     1041      CALL histwrite_phy(nid_files(iff),o_dtvdf%name,itau_w,zx_tmp_fi3d)
     1042       ENDIF
     1043
     1044       IF (o_dqvdf%flag(iff)<=lev_files(iff)) THEN
    10071045      zx_tmp_fi3d(1:klon,1:klev)=d_q_vdf(1:klon,1:klev)/pdtphys
    1008       CALL histwrite_phy(nid_files(iff),"dqvdf",itau_w,zx_tmp_fi3d)
    1009        ENDIF
    1010 
    1011        IF (flag_dteva(iff)<=lev_files(iff)) THEN
     1046      CALL histwrite_phy(nid_files(iff),o_dqvdf%name,itau_w,zx_tmp_fi3d)
     1047       ENDIF
     1048
     1049       IF (o_dteva%flag(iff)<=lev_files(iff)) THEN
    10121050      zx_tmp_fi3d(1:klon,1:klev)=d_t_eva(1:klon,1:klev)/pdtphys
    1013       CALL histwrite_phy(nid_files(iff),"dteva",itau_w,zx_tmp_fi3d)
    1014        ENDIF
    1015 
    1016        IF (flag_dqeva(iff)<=lev_files(iff)) THEN
     1051      CALL histwrite_phy(nid_files(iff),o_dteva%name,itau_w,zx_tmp_fi3d)
     1052       ENDIF
     1053
     1054       IF (o_dqeva%flag(iff)<=lev_files(iff)) THEN
    10171055      zx_tmp_fi3d(1:klon,1:klev)=d_q_eva(1:klon,1:klev)/pdtphys
    1018       CALL histwrite_phy(nid_files(iff),"dqeva",itau_w,zx_tmp_fi3d)
    1019        ENDIF
    1020 
    1021        IF (flag_ptconv(iff)<=lev_files(iff)) THEN
     1056      CALL histwrite_phy(nid_files(iff),o_dqeva%name,itau_w,zx_tmp_fi3d)
     1057       ENDIF
     1058
     1059       IF (o_ptconv%flag(iff)<=lev_files(iff)) THEN
    10221060      zpt_conv = 0.
    10231061      where (ptconv) zpt_conv = 1.
    1024       CALL histwrite_phy(nid_files(iff),"ptconv",itau_w,zpt_conv)
    1025        ENDIF
    1026 
    1027        IF (flag_ratqs(iff)<=lev_files(iff)) THEN
    1028       CALL histwrite_phy(nid_files(iff),"ratqs",itau_w,ratqs)
    1029        ENDIF
    1030 
    1031        IF (flag_dtthe(iff)<=lev_files(iff)) THEN
     1062      CALL histwrite_phy(nid_files(iff),o_ptconv%name,itau_w,zpt_conv)
     1063       ENDIF
     1064
     1065       IF (o_ratqs%flag(iff)<=lev_files(iff)) THEN
     1066      CALL histwrite_phy(nid_files(iff),o_ratqs%name,itau_w,ratqs)
     1067       ENDIF
     1068
     1069       IF (o_dtthe%flag(iff)<=lev_files(iff)) THEN
    10321070      zx_tmp_fi3d(1:klon,1:klev)=d_t_ajs(1:klon,1:klev)/pdtphys
    1033       CALL histwrite_phy(nid_files(iff),"dtthe",itau_w,zx_tmp_fi3d)
     1071      CALL histwrite_phy(nid_files(iff),o_dtthe%name,itau_w,zx_tmp_fi3d)
    10341072       ENDIF
    10351073
    10361074       IF (iflag_thermals.gt.1) THEN
    1037         IF (flag_f_th(iff)<=lev_files(iff)) THEN
    1038         CALL histwrite_phy(nid_files(iff),"f_th",itau_w,fm_therm)
    1039         ENDIF
    1040 
    1041         IF (flag_e_th(iff)<=lev_files(iff)) THEN
    1042         CALL histwrite_phy(nid_files(iff),"e_th",itau_w,entr_therm)
    1043         ENDIF
    1044 
    1045         IF (flag_w_th(iff)<=lev_files(iff)) THEN
    1046         CALL histwrite_phy(nid_files(iff),"w_th",itau_w,zw2)
    1047         ENDIF
    1048 
    1049         IF (flag_q_th(iff)<=lev_files(iff)) THEN
    1050         CALL histwrite_phy(nid_files(iff),"q_th",itau_w,zqasc)
    1051         ENDIF
    1052 
    1053         IF (flag_lambda_th(iff)<=lev_files(iff)) THEN
    1054         CALL histwrite_phy(nid_files(iff),"lambda_th",itau_w,lambda_th)
    1055         ENDIF
    1056 
    1057         IF (flag_a_th(iff)<=lev_files(iff)) THEN
    1058         CALL histwrite_phy(nid_files(iff),"a_th",itau_w,fraca)
    1059         ENDIF
    1060 
    1061        IF (flag_d_th(iff)<=lev_files(iff)) THEN
    1062        CALL histwrite_phy(nid_files(iff),"d_th",itau_w,detr_therm)
     1075        IF (o_f_th%flag(iff)<=lev_files(iff)) THEN
     1076        CALL histwrite_phy(nid_files(iff),o_f_th%name,itau_w,fm_therm)
     1077        ENDIF
     1078
     1079        IF (o_e_th%flag(iff)<=lev_files(iff)) THEN
     1080        CALL histwrite_phy(nid_files(iff),o_e_th%name,itau_w,entr_therm)
     1081        ENDIF
     1082
     1083        IF (o_w_th%flag(iff)<=lev_files(iff)) THEN
     1084        CALL histwrite_phy(nid_files(iff),o_w_th%name,itau_w,zw2)
     1085        ENDIF
     1086
     1087        IF (o_q_th%flag(iff)<=lev_files(iff)) THEN
     1088        CALL histwrite_phy(nid_files(iff),o_q_th%name,itau_w,zqasc)
     1089        ENDIF
     1090
     1091        IF (o_lambda_th%flag(iff)<=lev_files(iff)) THEN
     1092        CALL histwrite_phy(nid_files(iff),
     1093     s                     o_lambda_th%name,itau_w,lambda_th)
     1094        ENDIF
     1095
     1096        IF (o_a_th%flag(iff)<=lev_files(iff)) THEN
     1097        CALL histwrite_phy(nid_files(iff),o_a_th%name,itau_w,fraca)
     1098        ENDIF
     1099
     1100       IF (o_d_th%flag(iff)<=lev_files(iff)) THEN
     1101       CALL histwrite_phy(nid_files(iff),o_d_th%name,itau_w,detr_therm)
    10631102       ENDIF
    10641103
    10651104       ENDIF !iflag_thermals
    10661105
    1067        IF (flag_f0_th(iff)<=lev_files(iff)) THEN
    1068       CALL histwrite_phy(nid_files(iff),"f0_th",itau_w,f0)
    1069        ENDIF
    1070 
    1071        IF (flag_f0_th(iff)<=lev_files(iff)) THEN
    1072       CALL histwrite_phy(nid_files(iff),"zmax_th",itau_w,zmax0)
    1073        ENDIF
    1074 
    1075        IF (flag_dqthe(iff)<=lev_files(iff)) THEN
     1106       IF (o_f0_th%flag(iff)<=lev_files(iff)) THEN
     1107      CALL histwrite_phy(nid_files(iff),o_f0_th%name,itau_w,f0)
     1108       ENDIF
     1109
     1110       IF (o_f0_th%flag(iff)<=lev_files(iff)) THEN
     1111      CALL histwrite_phy(nid_files(iff),o_zmax_th%name,itau_w,zmax0)
     1112       ENDIF
     1113
     1114       IF (o_dqthe%flag(iff)<=lev_files(iff)) THEN
    10761115      zx_tmp_fi3d(1:klon,1:klev)=d_q_ajs(1:klon,1:klev)/pdtphys
    1077       CALL histwrite_phy(nid_files(iff),"dqthe",itau_w,zx_tmp_fi3d)
    1078        ENDIF
    1079 
    1080        IF (flag_dtajs(iff)<=lev_files(iff)) THEN
     1116      CALL histwrite_phy(nid_files(iff),o_dqthe%name,itau_w,zx_tmp_fi3d)
     1117       ENDIF
     1118
     1119       IF (o_dtajs%flag(iff)<=lev_files(iff)) THEN
    10811120      zx_tmp_fi3d(1:klon,1:klev)=d_t_ajsb(1:klon,1:klev)/pdtphys
    1082       CALL histwrite_phy(nid_files(iff),"dtajs",itau_w,zx_tmp_fi3d)
    1083        ENDIF
    1084 
    1085        IF (flag_dqajs(iff)<=lev_files(iff)) THEN
     1121      CALL histwrite_phy(nid_files(iff),o_dtajs%name,itau_w,zx_tmp_fi3d)
     1122       ENDIF
     1123
     1124       IF (o_dqajs%flag(iff)<=lev_files(iff)) THEN
    10861125      zx_tmp_fi3d(1:klon,1:klev)=d_q_ajsb(1:klon,1:klev)/pdtphys
    1087       CALL histwrite_phy(nid_files(iff),"dqajs",itau_w,zx_tmp_fi3d)
    1088        ENDIF
    1089 
    1090        IF (flag_dtswr(iff)<=lev_files(iff)) THEN
     1126      CALL histwrite_phy(nid_files(iff),o_dqajs%name,itau_w,zx_tmp_fi3d)
     1127       ENDIF
     1128
     1129       IF (o_dtswr%flag(iff)<=lev_files(iff)) THEN
    10911130      zx_tmp_fi3d(1:klon,1:klev)=heat(1:klon,1:klev)/RDAY
    1092       CALL histwrite_phy(nid_files(iff),"dtswr",itau_w,zx_tmp_fi3d)
    1093        ENDIF
    1094 
    1095        IF (flag_dtsw0(iff)<=lev_files(iff)) THEN
     1131      CALL histwrite_phy(nid_files(iff),o_dtswr%name,itau_w,zx_tmp_fi3d)
     1132       ENDIF
     1133
     1134       IF (o_dtsw0%flag(iff)<=lev_files(iff)) THEN
    10961135      zx_tmp_fi3d(1:klon,1:klev)=heat0(1:klon,1:klev)/RDAY
    1097       CALL histwrite_phy(nid_files(iff),"dtsw0",itau_w,zx_tmp_fi3d)
    1098        ENDIF
    1099 
    1100        IF (flag_dtlwr(iff)<=lev_files(iff)) THEN
     1136      CALL histwrite_phy(nid_files(iff),o_dtsw0%name,itau_w,zx_tmp_fi3d)
     1137       ENDIF
     1138
     1139       IF (o_dtlwr%flag(iff)<=lev_files(iff)) THEN
    11011140      zx_tmp_fi3d(1:klon,1:klev)=-1.*cool(1:klon,1:klev)/RDAY
    1102       CALL histwrite_phy(nid_files(iff),"dtlwr",itau_w,zx_tmp_fi3d)
    1103        ENDIF
    1104 
    1105        IF (flag_dtlw0(iff)<=lev_files(iff)) THEN
     1141      CALL histwrite_phy(nid_files(iff),o_dtlwr%name,itau_w,zx_tmp_fi3d)
     1142       ENDIF
     1143
     1144       IF (o_dtlw0%flag(iff)<=lev_files(iff)) THEN
    11061145      zx_tmp_fi3d(1:klon,1:klev)=-1.*cool0(1:klon,1:klev)/RDAY
    1107       CALL histwrite_phy(nid_files(iff),"dtlw0",itau_w,zx_tmp_fi3d)
    1108        ENDIF
    1109 
    1110        IF (flag_dtec(iff)<=lev_files(iff)) THEN
     1146      CALL histwrite_phy(nid_files(iff),o_dtlw0%name,itau_w,zx_tmp_fi3d)
     1147       ENDIF
     1148
     1149       IF (o_dtec%flag(iff)<=lev_files(iff)) THEN
    11111150      zx_tmp_fi3d(1:klon,1:klev)=d_t_ec(1:klon,1:klev)
    1112       CALL histwrite_phy(nid_files(iff),"dtec",itau_w,zx_tmp_fi3d)
    1113        ENDIF
    1114 
    1115        IF (flag_duvdf(iff)<=lev_files(iff)) THEN
     1151      CALL histwrite_phy(nid_files(iff),o_dtec%name,itau_w,zx_tmp_fi3d)
     1152       ENDIF
     1153
     1154       IF (o_duvdf%flag(iff)<=lev_files(iff)) THEN
    11161155      zx_tmp_fi3d(1:klon,1:klev)=d_u_vdf(1:klon,1:klev)/pdtphys
    1117       CALL histwrite_phy(nid_files(iff),"duvdf",itau_w,zx_tmp_fi3d)
    1118        ENDIF
    1119 
    1120        IF (flag_dvvdf(iff)<=lev_files(iff)) THEN
     1156      CALL histwrite_phy(nid_files(iff),o_duvdf%name,itau_w,zx_tmp_fi3d)
     1157       ENDIF
     1158
     1159       IF (o_dvvdf%flag(iff)<=lev_files(iff)) THEN
    11211160      zx_tmp_fi3d(1:klon,1:klev)=d_v_vdf(1:klon,1:klev)/pdtphys
    1122       CALL histwrite_phy(nid_files(iff),"dvvdf",itau_w,zx_tmp_fi3d)
     1161      CALL histwrite_phy(nid_files(iff),o_dvvdf%name,itau_w,zx_tmp_fi3d)
    11231162       ENDIF
    11241163
    11251164       IF (ok_orodr) THEN
    1126       IF (flag_duoro(iff)<=lev_files(iff)) THEN
     1165      IF (o_duoro%flag(iff)<=lev_files(iff)) THEN
    11271166      zx_tmp_fi3d(1:klon,1:klev)=d_u_oro(1:klon,1:klev)/pdtphys
    1128       CALL histwrite_phy(nid_files(iff),"duoro",itau_w,zx_tmp_fi3d)
    1129        ENDIF
    1130 
    1131       IF (flag_dvoro(iff)<=lev_files(iff)) THEN
     1167      CALL histwrite_phy(nid_files(iff),o_duoro%name,itau_w,zx_tmp_fi3d)
     1168       ENDIF
     1169
     1170      IF (o_dvoro%flag(iff)<=lev_files(iff)) THEN
    11321171      zx_tmp_fi3d(1:klon,1:klev)=d_v_oro(1:klon,1:klev)/pdtphys
    1133       CALL histwrite_phy(nid_files(iff),"dvoro",itau_w,zx_tmp_fi3d)
     1172      CALL histwrite_phy(nid_files(iff),o_dvoro%name,itau_w,zx_tmp_fi3d)
    11341173      ENDIF
    11351174       ENDIF
    11361175
    11371176        IF (ok_orolf) THEN
    1138        IF (flag_dulif(iff)<=lev_files(iff)) THEN
     1177       IF (o_dulif%flag(iff)<=lev_files(iff)) THEN
    11391178      zx_tmp_fi3d(1:klon,1:klev)=d_u_lif(1:klon,1:klev)/pdtphys
    1140       CALL histwrite_phy(nid_files(iff),"dulif",itau_w,zx_tmp_fi3d)
    1141        ENDIF
    1142 
    1143         IF (flag_dvlif(iff)<=lev_files(iff)) THEN
     1179      CALL histwrite_phy(nid_files(iff),o_dulif%name,itau_w,zx_tmp_fi3d)
     1180       ENDIF
     1181
     1182        IF (o_dvlif%flag(iff)<=lev_files(iff)) THEN
    11441183      zx_tmp_fi3d(1:klon,1:klev)=d_v_lif(1:klon,1:klev)/pdtphys
    1145       CALL histwrite_phy(nid_files(iff),"dvlif",itau_w,zx_tmp_fi3d)
    1146        ENDIF
    1147         ENDIF
    1148 
    1149        IF (flag_trac(iff)<=lev_files(iff)) THEN
    1150          if (nqmax.GE.3) THEN
    1151            DO iq=3,nqmax
    1152          CALL histwrite_phy(nid_files(iff),tnom(iq),itau_w,qx(:,:,iq))
     1184      CALL histwrite_phy(nid_files(iff),o_dvlif%name,itau_w,zx_tmp_fi3d)
     1185       ENDIF
     1186        ENDIF
     1187
     1188!       IF (o_trac%flag(iff)<=lev_files(iff)) THEN
     1189         if (nqtot.GE.3) THEN
     1190!           DO iq=3,nqtot
     1191           DO iq=3,4
     1192       IF (o_trac(iq-2)%flag(iff)<=lev_files(iff)) THEN
     1193         CALL histwrite_phy(nid_files(iff),
     1194     s                  o_trac(iq-2)%name,itau_w,qx(:,:,iq))
     1195       ENDIF
    11531196           ENDDO
    1154           endif
    1155 
    1156        ENDIF
     1197         endif
     1198
    11571199      if (ok_sync) then
    11581200c$OMP MASTER

  • LMDZ4/trunk/libf/phylmd/physiq.F

    r1068 r1146  
    22c#define IO_DEBUG
    33
    4       SUBROUTINE physiq (nlon,nlev,nqmax,
     4      SUBROUTINE physiq (nlon,nlev,
    55     .            debut,lafin,rjourvrai,gmtime,pdtphys,
    66     .            paprs,pplay,pphi,pphis,presnivs,clesphy0,
    … …  
    1515      USE write_field_phy
    1616      USE dimphy
     17      USE infotrac
    1718      USE mod_grid_phy_lmdz
    1819      USE mod_phys_lmdz_para
    … …  
    4142c   CLEFS CPP POUR LES IO
    4243c   =====================
    43 c#define histhf
    44 c#define histday
    45 c#define histmth
    4644c#define histmthNMC
    47 c#define histins
    4845c#define histISCCP
    4946c======================================================================
    … …  
    5451c nlon----input-I-nombre de points horizontaux
    5552c nlev----input-I-nombre de couches verticales
    56 c nqmax---input-I-nombre de traceurs (y compris vapeur d'eau) = 1
    5753c debut---input-L-variable logique indiquant le premier passage
    5854c lafin---input-L-variable logique indiquant le dernier passage
    … …  
    9187#include "clesphys.h"
    9288#include "control.h"
    93 !#include "logic.h"
    9489#include "temps.h"
    95 cym#include "comgeomphy.h"
    96 #include "advtrac.h"
    9790#include "iniprint.h"
    9891#include "thermcell.h"
    … …  
    188181      INTEGER nlon
    189182      INTEGER nlev
    190       INTEGER nqmax
    191183      REAL rjourvrai
    192184      REAL gmtime
    … …  
    204196      REAL v(klon,klev)
    205197      REAL t(klon,klev),theta(klon,klev)
    206       REAL qx(klon,klev,nqmax)
     198      REAL qx(klon,klev,nqtot)
    207199      REAL flxmass_w(klon,klev)
    208200      REAL omega(klon,klev) ! vitesse verticale en Pa/s
    … …  
    210202      REAL d_v(klon,klev)
    211203      REAL d_t(klon,klev)
    212       REAL d_qx(klon,klev,nqmax)
     204      REAL d_qx(klon,klev,nqtot)
    213205      REAL d_ps(klon)
    214206      real da(klon,klev),phi(klon,klev,klev),mp(klon,klev)
    … …  
    527519c  QUESTION : noms de variables ?
    528520
    529 c#ifdef histhf
    530 c      data ok_hf/.true./
    531 c#else
    532 c      data ok_hf/.false./
    533 c#endif
    534521      INTEGER        longcles
    535522      PARAMETER    ( longcles = 20 )
    … …  
    11191106         write(lunout,*) 'DEBUT DE PHYSIQ !!!!!!!!!!!!!!!!!!!!'
    11201107         write(lunout,*)
    1121      s 'nlon,nlev,nqmax,debut,lafin,rjourvrai,gmtime,pdtphys'
     1108     s 'nlon,nlev,nqtot,debut,lafin,rjourvrai,gmtime,pdtphys'
    11221109         write(lunout,*)
    1123      s  nlon,nlev,nqmax,debut,lafin,rjourvrai,gmtime,pdtphys
     1110     s  nlon,nlev,nqtot,debut,lafin,rjourvrai,gmtime,pdtphys
    11241111
    11251112         write(lunout,*) 'papers, play, phi, u, v, t, omega'
    … …  
    11791166      END IF
    11801167      ok_sync=.TRUE.
    1181       IF (nqmax .LT. 2) THEN
    1182          abort_message = 'eaux vapeur et liquide sont indispensables'
    1183          CALL abort_gcm (modname,abort_message,1)
    1184       ENDIF
     1168
    11851169      IF (debut) THEN
    11861170         CALL suphel ! initialiser constantes et parametres phys.
    … …  
    15081492#ifdef CPP_IOIPSL
    15091493
    1510 c Commente par abderrahmane 11 2 08
    1511 c#ifdef histhf
    1512 c#include "ini_histhf.h"
    1513 c#endif
    1514 
    1515 c#ifdef histday
    1516 c#include "ini_histday.h"
    1517 cIM rajout diagnostiques bilan KP pour analyse MJO par Jun-Ichi Yano
    1518 c#include "ini_bilKP_ins.h"
    1519 c#include "ini_bilKP_ave.h"
    1520 c#endif
    1521 
    1522 c#ifdef histmth
    1523 c#include "ini_histmth.h"
    1524 c#endif
    1525 
    1526 c#ifdef histins
    1527 c#include "ini_histins.h"
    1528 c#endif
    1529 
    15301494c$OMP MASTER
    1531        call phys_output_open(jjmp1,nqmax,nlevSTD,clevSTD,nbteta,
     1495       call phys_output_open(jjmp1,nlevSTD,clevSTD,nbteta,
    15321496     &                        ctetaSTD,dtime,presnivs,ok_veget,
    15331497     &                        type_ocean,iflag_pbl,ok_mensuel,ok_journe,
    1534      &                        ok_hf,ok_instan,ok_LES)
     1498     &                        ok_hf,ok_instan,ok_LES,ok_ade,ok_aie)
    15351499c$OMP END MASTER
    15361500c$OMP BARRIER
    … …  
    15831547     $                   calday,
    15841548     $                   klon,
    1585      $                   nqmax,
     1549     $                   nqtot,
    15861550     $                   pdtphys,
    15871551     $                   annee_ref,
    … …  
    16391603      ENDDO
    16401604      ENDDO
    1641       DO iq = 1, nqmax
     1605      DO iq = 1, nqtot
    16421606      DO k = 1, klev
    16431607      DO i = 1, klon
    … …  
    16621626      ENDDO
    16631627      ENDDO
    1664       IF (nqmax.GE.3) THEN
    1665       DO iq = 3, nqmax
     1628      IF (nqtot.GE.3) THEN
     1629      DO iq = 3, nqtot
    16661630      DO  k = 1, klev
    16671631      DO  i = 1, klon
    … …  
    20612025       do i=1,klon
    20622026          if (alp(i)>alp_max) then
    2063              print*,'WARNING SUPER ALP (seuil=',alp_max,
     2027             IF(prt_level>9)WRITE(lunout,*)                             &
     2028     &       'WARNING SUPER ALP (seuil=',alp_max,
    20642029     ,       '): i, alp, alp_wake,ale',i,alp(i),alp_wake(i),ale(i)
    20652030             alp(i)=alp_max
    20662031          endif
    20672032          if (ale(i)>ale_max) then
    2068              print*,'WARNING SUPER ALE (seuil=',ale_max,
     2033             IF(prt_level>9)WRITE(lunout,*)                             &
     2034     &       'WARNING SUPER ALE (seuil=',ale_max,
    20692035     ,       '): i, alp, alp_wake,ale',i,ale(i),ale_wake(i),alp(i)
    20702036             ale(i)=ale_max
    … …  
    20842050          CALL concvl (iflag_con,iflag_clos,
    20852051     .        dtime,paprs,pplay,t_undi,q_undi,
    2086      .        t_wake,q_wake,
     2052     .        t_wake,q_wake,wake_s,
    20872053     .        u_seri,v_seri,tr_seri,nbtr,
    20882054     .        ALE,ALP,
    … …  
    31923158     I                   debut,
    31933159     I                   lafin,
    3194      I                   nqmax-2,
    31953160     I                   nlon,
    31963161     I                   nlev,
    … …  
    34153380      ENDDO
    34163381c
    3417       IF (nqmax.GE.3) THEN
    3418       DO iq = 3, nqmax
     3382      IF (nqtot.GE.3) THEN
     3383      DO iq = 3, nqtot
    34193384      DO  k = 1, klev
    34203385      DO  i = 1, klon
    … …  
    34503415      write(lunout,*) 'FIN DE PHYSIQ !!!!!!!!!!!!!!!!!!!!'
    34513416      write(lunout,*)
    3452      s 'nlon,nlev,nqmax,debut,lafin,rjourvrai,gmtime,pdtphys pct tlos'
     3417     s 'nlon,nlev,nqtot,debut,lafin,rjourvrai,gmtime,pdtphys pct tlos'
    34533418      write(lunout,*)
    3454      s  nlon,nlev,nqmax,debut,lafin,rjourvrai,gmtime,pdtphys,
     3419     s  nlon,nlev,nqtot,debut,lafin,rjourvrai,gmtime,pdtphys,
    34553420     s  pctsrf(igout,is_ter), pctsrf(igout,is_lic),pctsrf(igout,is_oce),
    34563421     s  pctsrf(igout,is_sic)
    … …  
    35063471
    35073472
    3508 c Commente par abderrahmane le 11 2 08
    3509 c#ifdef histhf
    3510 c#include "write_histhf.h"
    3511 c#endif
    3512 
    3513 c#ifdef histday
    3514 c#include "write_histday.h"
    3515 c#endif
    3516 
    3517 c#ifdef histmth
    3518 c#include "write_histmth.h"
    3519 c#endif
    3520 
    3521 c#ifdef histins
    3522 c#include "write_histins.h"
    3523 c#endif
    3524 
    35253473#include "phys_output_write.h"
    35263474

  • LMDZ4/trunk/libf/phylmd/phystokenc.F

    r1067 r1146  
    1111      USE ioipsl
    1212      USE dimphy
     13      USE infotrac, ONLY : nqtot
    1314      USE iophy
    1415      IMPLICIT none
    … …  
    2122c======================================================================
    2223#include "dimensions.h"
    23 cym#include "dimphy.h"
    2424#include "tracstoke.h"
    2525#include "indicesol.h"
    … …  
    160160       
    161161        CALL initphysto('phystoke',
    162      . rlon,rlat,dtime, dtime*istphy,dtime*istphy,nqmx,physid)
     162     . rlon,rlat,dtime, dtime*istphy,dtime*istphy,nqtot,physid)
    163163       
    164164        write(*,*) 'apres initphysto ds phystokenc'

  • LMDZ4/trunk/libf/phylmd/phytrac.F

    r1067 r1146  
    88     I                    debutphy,
    99     I                    lafin,
    10      I                    nqmax,
    1110     I                    nlon,
    1211     I                    nlev,
    … …  
    6766      USE ioipsl
    6867      USE dimphy
     68      USE infotrac
    6969      USE mod_grid_phy_lmdz
    7070      USE mod_phys_lmdz_para
    … …  
    8080cAA Remarques en vrac:
    8181cAA--------------------
    82 cAA 1/ le call phytrac se fait avec nqmax-2 donc nous avons bien
    83 cAA les vrais traceurs (nbtr) dans phytrac (pas la vapeur ni eau liquide)
    8482cAA 2/ Le choix du radon et du pb se fait juste avec un data
    8583cAA    (peu propre). Peut-etre pourrait-on prevoir dans l'avenir
    … …  
    9391#include "paramet.h"
    9492#include "control.h"
    95 #include "advtrac.h"
    9693#include "thermcell.h"
    9794c======================================================================
    … …  
    107104      integer nlon  ! nombre de points horizontaux
    108105      integer nlev  ! nombre de couches verticales
    109       integer nqmax ! nombre de traceurs auxquels on applique la physique
    110106      integer nstep  ! appel physique
    111107      integer julien !jour julien
    … …  
    140136
    141137      REAL flxmass_w(klon,klev)
    142       CHARACTER(len=8) :: solsym(nqmax)
     138      CHARACTER(len=8) :: solsym(nbtr)
    143139      integer la
    144140      REAL              ::    tau_inca(klon,klev,9,2)
    … …  
    209205cAA Pour l'instant seuls les cas du rn et du pb ont ete envisages.
    210206
    211       REAL source(klon,nqmax)       ! a voir lorsque le flux est prescrit
     207      REAL source(klon,nbtr)       ! a voir lorsque le flux est prescrit
    212208cAA
    213209cAA Pour la source de radon et son reservoir de sol
    … …  
    216212      REAL,save,allocatable :: trs(:,:)    ! Conc. radon ds le sol
    217213c$OMP THREADPRIVATE(trs)
    218 cym      SAVE trs
    219214      REAL :: trs_tmp(klon_glo)
    220215     
    … …  
    223218c                           (1 = reservoir) ou (possible => 1 )
    224219c$OMP THREADPRIVATE(masktr)
    225 cym      SAVE masktr
    226220      REAL,save,allocatable :: fshtr(:,:)  ! Flux surfacique dans le reservoir de sol
    227221c$OMP THREADPRIVATE(fshtr)
    228 cym      SAVE fshtr
    229222      REAL,save,allocatable :: hsoltr(:)      ! Epaisseur equivalente du reservoir de sol
    230223c$OMP THREADPRIVATE(hsoltr)
    231 cym      SAVE hsoltr
    232224      REAL,save,allocatable :: tautr(:)       ! Constante de decroissance radioactive
    233225c$OMP THREADPRIVATE(tautr)
    234 cym      SAVE tautr
    235226      REAL,save,allocatable :: vdeptr(:)      ! Vitesse de depot sec dans la couche Brownienne
    236227c$OMP THREADPRIVATE(vdeptr)
    237 cym      SAVE vdeptr
    238228      REAL,save,allocatable :: scavtr(:)      ! Coefficient de lessivage
    239229c$OMP THREADPRIVATE(scavtr)
    240 cym      SAVE scavtr
    241230cAA
    242231      CHARACTER*2 itn
    … …  
    270259      logical,save,allocatable :: radio(:)    ! radio(it)=true => decroisssance radioactive
    271260c$OMP THREADPRIVATE(aerosol,clsol,radio) 
    272 cym      save aerosol,clsol,radio
    273261C
    274262c======================================================================
    … …  
    360348          print*,'dans phytrac ',pdtphys,ecrit_tra
    361349
    362          if(nbtr.lt.nqmax) then
    363 c           print*,'NQMAX=',nqmax
    364 c           print*,'NBTR=',nbtr
    365            abort_message='See above'
    366            call abort_gcm(modname,abort_message,1)
    367          endif
    368 
    369350         inirnpb=rnpb
    370351         PRINT*, 'La frequence de sortie traceurs est  ', ecrit_tra
    … …  
    406387c Initialisation de la nature des traceurs
    407388c
    408          DO it = 1, nqmax
     389         DO it = 1, nbtr
    409390            aerosol(it) = .FALSE.  ! Tous les traceurs sont des gaz par defaut
    410391            radio(it) = .FALSE.    ! Par defaut pas de passage par radiornpb
    … …  
    533514c======================================================================
    534515c     print*,'Avant convection'
    535        do it=1,nqmax
     516       do it=1,nbtr
    536517          WRITE(itn,'(i2)') it
    537518c        call diagtracphy(tr_seri(:,:,it),paprs,'Avant conv'//itn)
    … …  
    541522
    542523c      print*,'Pas de temps dans phytrac : ',pdtphys
    543       DO it=1, nqmax
    544 
    545       IF ( config_inca/='none' .AND. conv_flg(it) == 0 ) CYCLE
     524      DO it=1, nbtr
     525
     526      IF ( config_inca/='none') THEN
     527         IF ( conv_flg(it) == 0 ) CYCLE
     528      END IF
    546529
    547530      if (iflag_con.lt.2) then
    … …  
    574557      endif ! convection
    575558c        print*,'Apres convection'
    576 c      do it=1,nqmax
     559c      do it=1,nbtr
    577560c         WRITE(itn,'(i1)') it
    578561c        call diagtracphy(tr_seri(:,:,it),paprs,'Avant conv'//itn)
    … …  
    591574
    592575c      print*,'masse dans ph ',zmasse
    593       do it=1,nqmax
     576      do it=1,nbtr
    594577         do k=1,klev
    595578            do i=1,klon
    … …  
    604587c        print*,'calcul de leffet des thermiques'
    605588        nsplit=10
    606         DO it=1, nqmax
     589        DO it=1, nbtr
    607590c        WRITE(itn,'(i1)') it
    608591c        CALL minmaxqfi(tr_seri(1,1,it),1.e10,-1.e33,'conv it='//itn)
    … …  
    642625c======================================================================
    643626c       print *,'Avant couchelimite'
    644 c      do it=1,nqmax
     627c      do it=1,nbtr
    645628c         WRITE(itn,'(i1)') it
    646629c        call diagtracphy(tr_seri(:,:,it),paprs,'Avant CL  '//itn)
    … …  
    656639
    657640C maf modif pour tenir compte du cas rnpb + traceur
    658       DO it=1, nqmax
    659 
    660       IF ( config_inca/='none' .AND. pbl_flg(it) == 0 ) CYCLE
     641      DO it=1, nbtr
     642
     643         IF ( config_inca/='none' ) THEN
     644            IF( pbl_flg(it) == 0 ) CYCLE
     645         END IF
    661646
    662647c     print *,'it',it,clsol(it)
    … …  
    686671C         CALL minmaxqfi(tr_seri(1,1,it),0.,1.e33,'cltracrn it='//itn)
    687672      else ! couche limite avec flux prescrit
    688 #ifndef INCA
    689 
     673
     674         IF (config_inca == 'none') THEN
    690675Cmaf provisoire source / traceur a creer
    691         DO i=1, klon
    692           source(i,it) = 0.0 ! pas de source, pour l'instant
    693         ENDDO
    694 C
    695 #endif
     676            DO i=1, klon
     677               source(i,it) = 0.0 ! pas de source, pour l'instant
     678            ENDDO
     679         END IF
     680
    696681          CALL cltrac(pdtphys, coefh,t_seri,
    697682     s               tr_seri(1,1,it), source(:,it),
    … …  
    711696
    712697c      print*,'Apres couchelimite'
    713 c      do it=1,nqmax
     698c      do it=1,nbtr
    714699c         WRITE(itn,'(i1)') it
    715700c        call diagtracphy(tr_seri(:,:,it),paprs,'Avant CL  '//itn)
    … …  
    726711        call radiornpb (tr_seri,pdtphys,tautr,d_tr_dec)
    727712C
    728         DO it=1,nqmax
     713        DO it=1,nbtr
    729714            if(radio(it)) then
    730715            DO k = 1, nlev
    … …  
    755740c tendance des aerosols nuclees et impactes
    756741c
    757        DO it = 1, nqmax
     742       DO it = 1, nbtr
    758743         IF (aerosol(it)) THEN
    759744           DO k = 1, nlev
    … …  
    774759c      call dump2d(iim,jjm-1,frac_nucl(2:klon-1,10),'FRACNUCL')
    775760c      call dump2d(iim,jjm-1,tr_seri(2:klon-1,10,3),'TRACEUR3')
    776        DO it = 1, nqmax
     761       DO it = 1, nbtr
    777762c         print*,'IT=',it,aerosol(it)
    778763         IF (aerosol(it)) THEN
    … …  
    790775c Flux lessivage total
    791776c
    792       DO it = 1, nqmax
     777      DO it = 1, nbtr
    793778           DO k = 1, nlev
    794779            DO i = 1, klon

  • LMDZ4/trunk/libf/phylmd/radiornpb.F

    r776 r1146  
    44      SUBROUTINE radiornpb(tr,dtime,tautr,d_tr)
    55      USE dimphy
     6      USE infotrac, ONLY : nbtr
    67      IMPLICIT none
    78c======================================================================

  • LMDZ4/trunk/libf/phylmd/read_pstoke.F

    r940 r1146  
    1818C******************************************************************************
    1919
     20        use netcdf
    2021       USE dimphy
    2122       IMPLICIT NONE
    … …  
    116117      if (irec .eq. 0) then
    117118
    118             ncidp=NCOPN('phystoke.nc',NCNOWRIT,rcode)
    119 
    120             varidps=NCVID(ncidp,'phis',rcode)
     119            rcode=nf90_open('phystoke.nc',nf90_nowrite,ncidp)
     120
     121            rcode = nf90_inq_varid(ncidp, 'phis', varidps)
    121122            print*,'ncidp,varidps',ncidp,varidps
    122123
    123             varidpl=NCVID(ncidp,'sig_s',rcode)
     124            rcode = nf90_inq_varid(ncidp, 'sig_s', varidpl)
    124125            print*,'ncidp,varidpl',ncidp,varidpl
    125126
    126             varidai=NCVID(ncidp,'aire',rcode)
     127            rcode = nf90_inq_varid(ncidp, 'aire', varidai)
    127128            print*,'ncidp,varidai',ncidp,varidai
    128129
    129130c A FAIRE: Es-il necessaire de stocke t?
    130                 varidt=NCVID(ncidp,'t',rcode)
     131                rcode = nf90_inq_varid(ncidp, 't', varidt)
    131132                print*,'ncidp,varidt',ncidp,varidt
    132133
    133             varidmfu=NCVID(ncidp,'mfu',rcode)
     134            rcode = nf90_inq_varid(ncidp, 'mfu', varidmfu)
    134135            print*,'ncidp,varidmfu',ncidp,varidmfu
    135136
    136             varidmfd=NCVID(ncidp,'mfd',rcode)
     137            rcode = nf90_inq_varid(ncidp, 'mfd', varidmfd)
    137138            print*,'ncidp,varidmfd',ncidp,varidmfd
    138139
    139             varidenu=NCVID(ncidp,'en_u',rcode)
     140            rcode = nf90_inq_varid(ncidp, 'en_u', varidenu)
    140141            print*,'ncidp,varidenu',ncidp,varidenu
    141142
    142             variddeu=NCVID(ncidp,'de_u',rcode)
     143            rcode = nf90_inq_varid(ncidp, 'de_u', variddeu)
    143144            print*,'ncidp,variddeu',ncidp,variddeu
    144145
    145             varidend=NCVID(ncidp,'en_d',rcode)
     146            rcode = nf90_inq_varid(ncidp, 'en_d', varidend)
    146147            print*,'ncidp,varidend',ncidp,varidend
    147148       
    148             varidded=NCVID(ncidp,'de_d',rcode)
     149            rcode = nf90_inq_varid(ncidp, 'de_d', varidded)
    149150            print*,'ncidp,varidded',ncidp,varidded
    150151       
    151             varidch=NCVID(ncidp,'coefh',rcode)
     152            rcode = nf90_inq_varid(ncidp, 'coefh', varidch)
    152153            print*,'ncidp,varidch',ncidp,varidch
    153154       
    154155c abder (pour thermiques)
    155              varidfmth=NCVID(ncidp,'fm_th',rcode)
     156             rcode = nf90_inq_varid(ncidp, 'fm_th', varidfmth)
    156157             print*,'ncidp,varidfmth',ncidp,varidfmth
    157158
    158              varidenth=NCVID(ncidp,'en_th',rcode)
     159             rcode = nf90_inq_varid(ncidp, 'en_th', varidenth)
    159160             print*,'ncidp,varidenth',ncidp,varidenth
    160161
    161             varidfi=NCVID(ncidp,'frac_impa',rcode)
     162            rcode = nf90_inq_varid(ncidp, 'frac_impa', varidfi)
    162163            print*,'ncidp,varidfi',ncidp,varidfi
    163164       
    164             varidfn=NCVID(ncidp,'frac_nucl',rcode)
     165            rcode = nf90_inq_varid(ncidp, 'frac_nucl', varidfn)
    165166            print*,'ncidp,varidfn',ncidp,varidfn
    166167       
    167             varidyu1=NCVID(ncidp,'pyu1',rcode)
     168            rcode = nf90_inq_varid(ncidp, 'pyu1', varidyu1)
    168169            print*,'ncidp,varidyu1',ncidp,varidyu1
    169170       
    170             varidyv1=NCVID(ncidp,'pyv1',rcode)
     171            rcode = nf90_inq_varid(ncidp, 'pyv1', varidyv1)
    171172            print*,'ncidp,varidyv1',ncidp,varidyv1
    172173       
    173             varidfts1=NCVID(ncidp,'ftsol1',rcode)
     174            rcode = nf90_inq_varid(ncidp, 'ftsol1', varidfts1)
    174175            print*,'ncidp,varidfts1',ncidp,varidfts1
    175176       
    176             varidfts2=NCVID(ncidp,'ftsol2',rcode)
     177            rcode = nf90_inq_varid(ncidp, 'ftsol2', varidfts2)
    177178            print*,'ncidp,varidfts2',ncidp,varidfts2
    178179         
    179             varidfts3=NCVID(ncidp,'ftsol3',rcode)
     180            rcode = nf90_inq_varid(ncidp, 'ftsol3', varidfts3)
    180181            print*,'ncidp,varidfts3',ncidp,varidfts3
    181182 
    182             varidfts4=NCVID(ncidp,'ftsol4',rcode)
     183            rcode = nf90_inq_varid(ncidp, 'ftsol4', varidfts4)
    183184            print*,'ncidp,varidfts4',ncidp,varidfts4
    184185       
    185             varidpsr1=NCVID(ncidp,'psrf1',rcode)
     186            rcode = nf90_inq_varid(ncidp, 'psrf1', varidpsr1)
    186187            print*,'ncidp,varidpsr1',ncidp,varidpsr1
    187188       
    188             varidpsr2=NCVID(ncidp,'psrf2',rcode)
     189            rcode = nf90_inq_varid(ncidp, 'psrf2', varidpsr2)
    189190            print*,'ncidp,varidpsr2',ncidp,varidpsr2
    190191       
    191             varidpsr3=NCVID(ncidp,'psrf3',rcode)
     192            rcode = nf90_inq_varid(ncidp, 'psrf3', varidpsr3)
    192193            print*,'ncidp,varidpsr3',ncidp,varidpsr3
    193194
    194             varidpsr4=NCVID(ncidp,'psrf4',rcode)
     195            rcode = nf90_inq_varid(ncidp, 'psrf4', varidpsr4)
    195196            print*,'ncidp,varidpsr4',ncidp,varidpsr4
    196197       

  • LMDZ4/trunk/libf/phylmd/read_pstoke0.F

    r940 r1146  
    1717C******************************************************************************
    1818
    19 
     19        use netcdf
    2020       USE dimphy
    2121       IMPLICIT NONE
    … …  
    121121      if (irec .eq. 0) then
    122122
    123             ncidp=NCOPN('phystoke.nc',NCNOWRIT,rcode)
    124 
    125             varidps=NCVID(ncidp,'phis',rcode)
     123            rcode=nf90_open('phystoke.nc',nf90_nowrite,ncidp)
     124
     125            rcode = nf90_inq_varid(ncidp, 'phis', varidps)
    126126            print*,'ncidp,varidps',ncidp,varidps
    127127
    128             varidpl=NCVID(ncidp,'sig_s',rcode)
     128            rcode = nf90_inq_varid(ncidp, 'sig_s', varidpl)
    129129            print*,'ncidp,varidpl',ncidp,varidpl
    130130
    131             varidai=NCVID(ncidp,'aire',rcode)
     131            rcode = nf90_inq_varid(ncidp, 'aire', varidai)
    132132            print*,'ncidp,varidai',ncidp,varidai
    133133
    134                 varidt=NCVID(ncidp,'t',rcode)
     134                rcode = nf90_inq_varid(ncidp, 't', varidt)
    135135                print*,'ncidp,varidt',ncidp,varidt
    136136
    137             varidmfu=NCVID(ncidp,'mfu',rcode)
     137            rcode = nf90_inq_varid(ncidp, 'mfu', varidmfu)
    138138            print*,'ncidp,varidmfu',ncidp,varidmfu
    139139
    140             varidmfd=NCVID(ncidp,'mfd',rcode)
     140            rcode = nf90_inq_varid(ncidp, 'mfd', varidmfd)
    141141            print*,'ncidp,varidmfd',ncidp,varidmfd
    142142
    143             varidenu=NCVID(ncidp,'en_u',rcode)
     143            rcode = nf90_inq_varid(ncidp, 'en_u', varidenu)
    144144            print*,'ncidp,varidenu',ncidp,varidenu
    145145
    146             variddeu=NCVID(ncidp,'de_u',rcode)
     146            rcode = nf90_inq_varid(ncidp, 'de_u', variddeu)
    147147            print*,'ncidp,variddeu',ncidp,variddeu
    148148
    149             varidend=NCVID(ncidp,'en_d',rcode)
     149            rcode = nf90_inq_varid(ncidp, 'en_d', varidend)
    150150            print*,'ncidp,varidend',ncidp,varidend
    151151       
    152             varidded=NCVID(ncidp,'de_d',rcode)
     152            rcode = nf90_inq_varid(ncidp, 'de_d', varidded)
    153153            print*,'ncidp,varidded',ncidp,varidded
    154154       
    155             varidch=NCVID(ncidp,'coefh',rcode)
     155            rcode = nf90_inq_varid(ncidp, 'coefh', varidch)
    156156            print*,'ncidp,varidch',ncidp,varidch
    157157
    158158c Thermiques
    159             varidfmth=NCVID(ncidp,'fm_th',rcode)
     159            rcode = nf90_inq_varid(ncidp, 'fm_th', varidfmth)
    160160            print*,'ncidp,varidfmth',ncidp,varidfmth
    161161
    162             varidenth=NCVID(ncidp,'en_th',rcode)
     162            rcode = nf90_inq_varid(ncidp, 'en_th', varidenth)
    163163            print*,'ncidp,varidenth',ncidp,varidenth
    164164       
    165             varidfi=NCVID(ncidp,'frac_impa',rcode)
     165            rcode = nf90_inq_varid(ncidp, 'frac_impa', varidfi)
    166166            print*,'ncidp,varidfi',ncidp,varidfi
    167167       
    168             varidfn=NCVID(ncidp,'frac_nucl',rcode)
     168            rcode = nf90_inq_varid(ncidp, 'frac_nucl', varidfn)
    169169            print*,'ncidp,varidfn',ncidp,varidfn
    170170       
    171             varidyu1=NCVID(ncidp,'pyu1',rcode)
     171            rcode = nf90_inq_varid(ncidp, 'pyu1', varidyu1)
    172172            print*,'ncidp,varidyu1',ncidp,varidyu1
    173173       
    174             varidyv1=NCVID(ncidp,'pyv1',rcode)
     174            rcode = nf90_inq_varid(ncidp, 'pyv1', varidyv1)
    175175            print*,'ncidp,varidyv1',ncidp,varidyv1
    176176       
    177             varidfts1=NCVID(ncidp,'ftsol1',rcode)
     177            rcode = nf90_inq_varid(ncidp, 'ftsol1', varidfts1)
    178178            print*,'ncidp,varidfts1',ncidp,varidfts1
    179179       
    180             varidfts2=NCVID(ncidp,'ftsol2',rcode)
     180            rcode = nf90_inq_varid(ncidp, 'ftsol2', varidfts2)
    181181            print*,'ncidp,varidfts2',ncidp,varidfts2
    182182         
    183             varidfts3=NCVID(ncidp,'ftsol3',rcode)
     183            rcode = nf90_inq_varid(ncidp, 'ftsol3', varidfts3)
    184184            print*,'ncidp,varidfts3',ncidp,varidfts3
    185185 
    186             varidfts4=NCVID(ncidp,'ftsol4',rcode)
     186            rcode = nf90_inq_varid(ncidp, 'ftsol4', varidfts4)
    187187            print*,'ncidp,varidfts4',ncidp,varidfts4
    188188       
    189             varidpsr1=NCVID(ncidp,'psrf1',rcode)
     189            rcode = nf90_inq_varid(ncidp, 'psrf1', varidpsr1)
    190190            print*,'ncidp,varidpsr1',ncidp,varidpsr1
    191191       
    192             varidpsr2=NCVID(ncidp,'psrf2',rcode)
     192            rcode = nf90_inq_varid(ncidp, 'psrf2', varidpsr2)
    193193            print*,'ncidp,varidpsr2',ncidp,varidpsr2
    194194       
    195             varidpsr3=NCVID(ncidp,'psrf3',rcode)
     195            rcode = nf90_inq_varid(ncidp, 'psrf3', varidpsr3)
    196196            print*,'ncidp,varidpsr3',ncidp,varidpsr3
    197197
    198             varidpsr4=NCVID(ncidp,'psrf4',rcode)
     198            rcode = nf90_inq_varid(ncidp, 'psrf4', varidpsr4)
    199199            print*,'ncidp,varidpsr4',ncidp,varidpsr4
    200200       

  • LMDZ4/trunk/libf/phylmd/readsulfate.F

    r940 r1146  
    3636#include "chem.h"     
    3737#include "dimensions.h"     
    38 cym#include "dimphy.h"     
    3938#include "temps.h"     
     39#include "clesphys.h"
     40#include "iniprint.h"
    4041c
    4142c Input:
    … …  
    8485
    8586      if (is_mpi_root) then
     87
     88        IF (aer_type /= 'actuel  ' .AND. aer_type /= 'preind  ' .AND.   &
     89     &      aer_type /= 'scenario') THEN
     90          WRITE(lunout,*)' *** Warning ***'
     91          WRITE(lunout,*)'Option aer_type pour les aerosols = ',        &
     92     &        aer_type
     93          WRITE(lunout,*)'Cas non prevu, force a preind'
     94          aer_type = 'preind  '
     95        ENDIF
    8696           
    8797      iday = INT(r_day)
    … …  
    118128
    119129
    120       IF (iyr .lt. 1850) THEN
    121          cyear='.nat'
    122          WRITE(*,*) 'getso4  iyr=', iyr,'   ',cyear
    123          CALL getso4fromfile(cyear, so4_1)
    124       ELSE IF (iyr .ge. 2100) THEN
    125          cyear='2100'
    126          WRITE(*,*) 'getso4  iyr=', iyr,'   ',cyear
    127          CALL getso4fromfile(cyear, so4_1)
     130
     131      IF (aer_type == 'actuel  ') then
     132        cyear='1980'
     133        CALL getso4fromfile(cyear, so4_1)
     134      ELSE IF (aer_type == 'preind  ') THEN
     135        cyear='.nat'
     136        CALL getso4fromfile(cyear, so4_1)
    128137      ELSE
     138        IF (iyr .lt. 1850) THEN
     139           cyear='.nat'
     140           WRITE(*,*) 'getso4  iyr=', iyr,'   ',cyear
     141           CALL getso4fromfile(cyear, so4_1)
     142        ELSE IF (iyr .ge. 2100) THEN
     143           cyear='2100'
     144           WRITE(*,*) 'getso4  iyr=', iyr,'   ',cyear
     145           CALL getso4fromfile(cyear, so4_1)
     146        ELSE
    129147
    130148        ! Read in data:
    131       ! a) from actual 10-yr-period
    132 
    133       IF (iyr.LT.1900) THEN
    134          iyr1 = 1850
    135          iyr2 = 1900
    136       ELSE IF (iyr.ge.1900.and.iyr.lt.1920) THEN
    137          iyr1 = 1900
    138          iyr2 = 1920
    139       ELSE
    140          iyr1 = INT(iyr/10)*10
    141          iyr2 = INT(1+iyr/10)*10
    142       ENDIF
    143       WRITE(cyear,'(I4)') iyr1
    144       WRITE(*,*) 'getso4  iyr=', iyr,'   ',cyear
    145       CALL getso4fromfile(cyear, so4_1)
     149        ! a) from actual 10-yr-period
     150
     151          IF (iyr.LT.1900) THEN
     152             iyr1 = 1850
     153             iyr2 = 1900
     154          ELSE IF (iyr.ge.1900.and.iyr.lt.1920) THEN
     155             iyr1 = 1900
     156             iyr2 = 1920
     157          ELSE
     158             iyr1 = INT(iyr/10)*10
     159             iyr2 = INT(1+iyr/10)*10
     160          ENDIF
     161          WRITE(cyear,'(I4)') iyr1
     162        ENDIF
     163        WRITE(*,*) 'getso4  iyr=', iyr,'   ',cyear
     164        CALL getso4fromfile(cyear, so4_1)
    146165
    147166     
    148167      ! If to read two decades:
    149       IF (.NOT.lonlyone) THEN
     168        IF (.NOT.lonlyone) THEN
    150169         
    151170      ! b) from the next following one
    152       WRITE(cyear,'(I4)') iyr2
    153       WRITE(*,*) 'getso4  iyr=', iyr,'   ',cyear
    154       CALL getso4fromfile(cyear, so4_2)
    155 
    156       ENDIF
     171          WRITE(cyear,'(I4)') iyr2
     172          WRITE(*,*) 'getso4  iyr=', iyr,'   ',cyear
     173          CALL getso4fromfile(cyear, so4_2)
     174
    157175 
    158176      ! Interpolate linarily to the actual year:
    159       DO it=1,12
    160          DO k=1,klev
    161             DO j=1,jjm
    162                DO i=1,iim
    163                   so4_1(i,j,k,it)=so4_1(i,j,k,it)
     177        DO it=1,12
     178           DO k=1,klev
     179              DO j=1,jjm
     180                 DO i=1,iim
     181                    so4_1(i,j,k,it)=so4_1(i,j,k,it)
    164182     .                 - FLOAT(iyr-iyr1)/FLOAT(iyr2-iyr1)
    165183     .                 * (so4_1(i,j,k,it) - so4_2(i,j,k,it))
    166                ENDDO
    167             ENDDO
    168          ENDDO
    169       ENDDO                           
    170      
    171       ENDIF !lonlyone
     184                 ENDDO
     185              ENDDO
     186           ENDDO
     187        ENDDO                           
     188
     189
     190        ENDIF !lonlyone   
     191      ENDIF !aer_type
    172192     
    173193      ! Transform the horizontal 2D-field into the physics-field
    … …  
    537557
    538558      SUBROUTINE getso4fromfile (cyr, so4)
    539       use dimphy
     559      USE dimphy
    540560#include "netcdf.inc"
    541561#include "dimensions.h"     
    542 cccc#include "dimphy.h"
    543562      CHARACTER*15 fname
    544563      CHARACTER*4 cyr

  • LMDZ4/trunk/libf/phylmd/surf_land_bucket_mod.F90

    r1072 r1146  
    153153!
    154154    DO i = 1, knon
    155        z0_new(i) = SQRT(z0_new(i)**2+rugoro(i)**2)
     155       z0_new(i) = MAX(1.5e-05,SQRT(z0_new(i)**2 + rugoro(i)**2))
    156156    END DO
    157157

  • LMDZ4/trunk/libf/phylmd/surf_land_mod.F90

    r1067 r1146  
    1515       AcoefU, AcoefV, BcoefU, BcoefV, &
    1616       pref, u1, v1, rugoro, pctsrf, &
     17       lwdown_m, q2m, t2m, &
    1718       snow, qsol, agesno, tsoil, &
    1819       z0_new, alb1_new, alb2_new, evap, fluxsens, fluxlat, &
    1920       qsurf, tsurf_new, dflux_s, dflux_l, &
    20        flux_u1, flux_v1, &
    21        lwdown_m)
     21       flux_u1, flux_v1 )
    2222
    2323    USE dimphy
    2424    USE surface_data, ONLY    : ok_veget
     25
     26#ifdef ORCHIDEE_NOOPENMP
     27    USE surf_land_orchidee_noopenmp_mod
     28#else
    2529    USE surf_land_orchidee_mod
     30#endif
    2631    USE surf_land_bucket_mod
    2732    USE calcul_fluxs_mod
    … …  
    5358    REAL, DIMENSION(klon), INTENT(IN)       :: rugoro
    5459    REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
    55 
    5660    REAL, DIMENSION(klon), INTENT(IN)       :: lwdown_m  ! downwelling longwave radiation at mean surface
    5761                                                         ! corresponds to previous sollwdown
     62    REAL, DIMENSION(klon), INTENT(IN)       :: q2m, t2m
    5863
    5964! In/Output variables
    … …  
    124129            cdragh, AcoefH, AcoefQ, BcoefH, BcoefQ, &
    125130            precip_rain, precip_snow, lwdown_m, swnet, swdown, &
    126             pref_tmp, &
     131            pref_tmp, q2m, t2m, &
    127132            evap, fluxsens, fluxlat, &             
    128133            tsol_rad, tsurf_new, alb1_new, alb2_new, &
    … …  
    133138! 
    134139       DO i=1,knon
    135           z0_new(i) = SQRT(z0_new(i)**2 + rugoro(i)**2)
     140          z0_new(i) = MAX(1.5e-05,SQRT(z0_new(i)**2 + rugoro(i)**2))
    136141       ENDDO
    137142

  • LMDZ4/trunk/libf/phylmd/surf_land_orchidee_mod.F90

    r1067 r1146  
    11!
    22MODULE surf_land_orchidee_mod
     3#ifndef ORCHIDEE_NOOPENMP
    34!
    45! This module controles the interface towards the model ORCHIDEE
    … …  
    3536       tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
    3637       precip_rain, precip_snow, lwdown, swnet, swdown, &
    37        ps, &
     38       ps, q2m, t2m, &
    3839       evap, fluxsens, fluxlat, &             
    3940       tsol_rad, tsurf_new, alb1_new, alb2_new, &
    … …  
    119120    REAL, DIMENSION(klon), INTENT(IN)         :: precip_rain, precip_snow
    120121    REAL, DIMENSION(klon), INTENT(IN)         :: lwdown, swnet, swdown, ps
    121     REAL, DIMENSION(klon)                     :: swdown_vrai
     122    REAL, DIMENSION(klon), INTENT(IN)         :: q2m, t2m
    122123
    123124! Parametres de sortie
    … …  
    132133    INTEGER                                   :: ij, jj, igrid, ireal, index
    133134    INTEGER                                   :: error
     135    REAL, DIMENSION(klon)                     :: swdown_vrai
    134136    CHARACTER (len = 20)                      :: modname = 'surf_land_orchidee'
    135137    CHARACTER (len = 80)                      :: abort_message
    … …  
    390392               evap, fluxsens, fluxlat, coastalflow, riverflow, &
    391393               tsol_rad, tsurf_new, qsurf, albedo_out, emis_new, z0_new, &
    392                lon_scat, lat_scat)
     394               lon_scat, lat_scat, q2m, t2m)
    393395#endif         
    394396       ENDIF
    … …  
    414416            evap(1:knon), fluxsens(1:knon), fluxlat(1:knon), coastalflow(1:knon), riverflow(1:knon), &
    415417            tsol_rad(1:knon), tsurf_new(1:knon), qsurf(1:knon), albedo_out(1:knon,:), emis_new(1:knon), z0_new(1:knon), &
    416             lon_scat, lat_scat)
     418            lon_scat, lat_scat, q2m, t2m)
    417419#endif       
    418420    ENDIF
    … …  
    632634!****************************************************************************************
    633635!
    634 
     636#endif
    635637END MODULE surf_land_orchidee_mod

  • LMDZ4/trunk/libf/phylmd/surf_landice_mod.F90

    r1067 r1146  
    164164!
    165165!****************************************************************************************
    166     z0_new(:) = rugoro(:)
     166    z0_new(:) = MAX(1.E-3,rugoro(:))
    167167
    168168!****************************************************************************************

  • LMDZ4/trunk/libf/phylmd/surf_ocean_mod.F90

    r1067 r1146  
    7979!****************************************************************************************
    8080    INTEGER               :: i
     81    REAL                  :: tmp
     82    REAL, PARAMETER       :: cepdu2=(0.1)**2
    8183    REAL, DIMENSION(klon) :: alb_eau
    8284    REAL, DIMENSION(klon) :: radsol
    … …  
    153155!
    154156!****************************************************************************************
    155     z0_new = SQRT(rugos**2 + rugoro**2)
    156 
    157     ! The rugosity is recalculated with another method
    158     z0_new(:) = 0.0
    159157    DO i = 1, knon
     158       tmp = MAX(cepdu2,u1(i)**2+v1(i)**2)
    160159       z0_new(i) = 0.018*cdragm(i) * (u1(i)**2+v1(i)**2)/RG  &
    161             +  0.11*14e-6 / SQRT(cdragm(i) * (u1(i)**2+v1(i)**2))
     160            +  0.11*14e-6 / SQRT(cdragm(i) * tmp)
    162161       z0_new(i) = MAX(1.5e-05,z0_new(i))
    163     ENDDO
    164    
     162    ENDDO   
    165163!
    166164!****************************************************************************************

  • LMDZ4/trunk/libf/phylmd/thermcell.h

    r1026 r1146  
    1       integer iflag_thermals,nsplit_thermals
    2       real r_aspect_thermals,l_mix_thermals,tau_thermals
    3       integer w2di_thermals,isplit
    4       integer iflag_coupl,iflag_clos,iflag_wake
    5       integer iflag_thermals_ed,iflag_thermals_optflux
     1      integer            :: iflag_thermals,nsplit_thermals
     2      real,parameter     :: r_aspect_thermals=2.,l_mix_thermals=30.
     3      real               :: tau_thermals
     4      integer,parameter  :: w2di_thermals=1
     5      integer            :: isplit
     6
     7      integer            :: iflag_coupl,iflag_clos,iflag_wake
     8      integer            :: iflag_thermals_ed,iflag_thermals_optflux
    69
    710      common/ctherm1/iflag_thermals,nsplit_thermals
    8       common/ctherm2/r_aspect_thermals,l_mix_thermals,tau_thermals
    9       common/ctherm3/w2di_thermals
     11      common/ctherm2/tau_thermals
    1012      common/ctherm4/iflag_coupl,iflag_clos,iflag_wake
    1113      common/ctherm5/iflag_thermals_ed,iflag_thermals_optflux
    1214
    13 !$OMP THREADPRIVATE(/ctherm1/,/ctherm2/,/ctherm3/,/ctherm4/)
     15!$OMP THREADPRIVATE(/ctherm1/,/ctherm2/,/ctherm4/,/ctherm5/)

  • LMDZ4/trunk/libf/phylmd/thermcell_closure.F90

    r1057 r1146  
    5555!            f(ig)=f(ig)+(f0(ig)-f(ig))*exp((-ptimestep/  &
    5656!    &                     zmax_sec(ig))*wmax_sec(ig))
    57              print*,'closure dry',f(ig),wmax_sec(ig),alim_star_tot(ig),zmax_sec(ig)
     57             if(prt_level.GE.10) write(lunout,*)'closure dry',f(ig),wmax_sec(ig),alim_star_tot(ig),zmax_sec(ig)
    5858             else
    5959             f(ig)=wmax(ig)*alim_star_tot(ig)/zdenom

  • LMDZ4/trunk/libf/phylmd/thermcell_dv2.F90

    r972 r1146  
    5454      enddo
    5555
    56       print*,'WARNING on initialise gamma(1:ngrid,1)=0.'
     56      IF(prt_level>9)WRITE(lunout,*)                                    &
     57     &      'WARNING on initialise gamma(1:ngrid,1)=0.'
    5758      gamma(1:ngrid,1)=0.
    5859      do k=2,nlay

  • LMDZ4/trunk/libf/phylmd/thermcell_flux.F90

    r987 r1146  
    164164! FH Version en cours de test;
    165165! par rapport a thermcell_flux, on fait une grande boucle sur "l"
    166 ! et on modifie le flux avec tous les contrôles appliques d'affilee
     166! et on modifie le flux avec tous les contr�les appliques d'affilee
    167167! pour la meme couche
    168168! Momentanement, on duplique le calcule du flux pour pouvoir comparer
    … …  
    264264            if (entr(ig,l)<0.) then
    265265               print*,'N1 ig,l,entr',ig,l,entr(ig,l)
    266                stop'entr negatif'
     266               stop 'entr negatif'
    267267            endif
    268268            if (detr(ig,l).gt.fm(ig,l)) then
    … …  
    292292               print*,'entr(ig,l)',entr(ig,l)
    293293               print*,'fm(ig,l)',fm(ig,l)
    294                stop'probleme dans thermcell flux'
     294               stop 'probleme dans thermcell flux'
    295295            endif
    296296         enddo
    … …  
    319319               print*,'detr(ig,l)',detr(ig,l)
    320320               print*,'fm(ig,l)',fm(ig,l)
    321                stop'probleme dans thermcell flux'
     321               stop 'probleme dans thermcell flux'
    322322            endif
    323323        enddo
    … …  
    420420                         print*,'fm(ig,l+1)',fm(ig,l+1)
    421421                         print*,'fm(ig,l)',fm(ig,l)
    422                          stop'probleme dans thermcell_flux'
     422                         stop 'probleme dans thermcell_flux'
    423423                      endif
    424424                      entr(ig,l+1)=entr(ig,l+1)-ddd

  • LMDZ4/trunk/libf/phylmd/thermcell_flux2.F90

    r1026 r1146  
    160160! FH Version en cours de test;
    161161! par rapport a thermcell_flux, on fait une grande boucle sur "l"
    162 ! et on modifie le flux avec tous les contrôles appliques d'affilee
     162! et on modifie le flux avec tous les contr�les appliques d'affilee
    163163! pour la meme couche
    164164! Momentanement, on duplique le calcule du flux pour pouvoir comparer
    … …  
    256256            if (entr(ig,l)<0.) then
    257257               print*,'N1 ig,l,entr',ig,l,entr(ig,l)
    258                stop'entr negatif'
     258               stop 'entr negatif'
    259259            endif
    260260            if (detr(ig,l).gt.fm(ig,l)) then
    … …  
    285285               print*,'entr(ig,l)',entr(ig,l)
    286286               print*,'fm(ig,l)',fm(ig,l)
    287                stop'probleme dans thermcell flux'
     287               stop 'probleme dans thermcell flux'
    288288            endif
    289289         enddo
    … …  
    312312               print*,'detr(ig,l)',detr(ig,l)
    313313               print*,'fm(ig,l)',fm(ig,l)
    314                stop'probleme dans thermcell flux'
     314               stop 'probleme dans thermcell flux'
    315315            endif
    316316        enddo
    … …  
    413413                         print*,'fm(ig,l+1)',fm(ig,l+1)
    414414                         print*,'fm(ig,l)',fm(ig,l)
    415                          stop'probleme dans thermcell_flux'
     415                         stop 'probleme dans thermcell_flux'
    416416                      endif
    417417                      entr(ig,l+1)=entr(ig,l+1)-ddd

  • LMDZ4/trunk/libf/phylmd/thermcell_main.F90

    r1026 r1146  
    232232!     enddo
    233233!    ENDIF !(1.eq.0) THEN
    234      print*,'WARNING thermcell_main f0=max(f0,1.e-2)'
     234     if (prt_level.ge.10)write(lunout,*)                                &
     235    &     'WARNING thermcell_main f0=max(f0,1.e-2)'
    235236     do ig=1,klon
    236237      if (prt_level.ge.20) then
    … …  
    295296
    296297!IM
    297       print*,'WARNING thermcell_main rhobarz(:,1)=rho(:,1)'
     298     if (prt_level.ge.10)write(lunout,*)                                &
     299    &    'WARNING thermcell_main rhobarz(:,1)=rho(:,1)'
    298300      rhobarz(:,1)=rho(:,1)
    299301
    … …  
    482484! Test valable seulement en 1D mais pas genant
    483485      if (.not. (f0(1).ge.0.) ) then
    484            stop'Dans thermcell_main'
     486           stop 'Dans thermcell_main'
    485487      endif
    486488
    … …  
    624626      enddo     
    625627      if (prt_level.ge.1) print*,'14d OK convect8'
    626       print*,'WARNING thermcell_main wth2=0. si zw2 > 1.e-10'
     628      if (prt_level.ge.10)write(lunout,*)                                &
     629    &     'WARNING thermcell_main wth2=0. si zw2 > 1.e-10'
    627630      do l=1,nlay
    628631         do ig=1,ngrid

  • LMDZ4/trunk/libf/phylmd/wake.F

    r1059 r1146  
    1212     o                ,Cstar,d_deltat_gw
    1313     o                ,d_deltatw2,d_deltaqw2)
     14
    1415
    1516***************************************************************
    … …  
    157158      REAL alpk
    158159      REAL delta_t_min
    159       REAL Pupper
    160160      INTEGER nsub
    161161      REAL dtimesub
    162162      REAL sigmad, hwmin
     163      REAL :: sigmaw_max
    163164cIM 080208
    164165      LOGICAL, dimension(klon) :: gwake
    … …  
    183184      INTEGER, DIMENSION(klon) :: ktop, kupper
    184185
     186c Sub-timestep tendencies and related variables
     187       REAL d_deltatw(klon,klev),d_deltaqw(klon,klev)
     188       REAL d_te(klon,klev),d_qe(klon,klev)
     189       REAL d_sigmaw(klon),alpha(klon)
     190       REAL q0_min(klon),q1_min(klon)
     191       LOGICAL wk_adv(klon), OK_qx_qw(klon)
     192
    185193c Autres variables internes
    186194      INTEGER isubstep, k, i
    … …  
    202210      REAL, DIMENSION(klon,klev) :: the, thu
    203211
    204       REAL, DIMENSION(klon,klev) :: d_deltatw, d_deltaqw
     212!      REAL, DIMENSION(klon,klev) :: d_deltatw, d_deltaqw
    205213
    206214      REAL, DIMENSION(klon,klev+1) :: omgbw
     215      REAL, DIMENSION(klon) :: pupper
    207216      REAL, DIMENSION(klon) :: omgtop
    208217      REAL, DIMENSION(klon,klev) :: dp_omgbw
    … …  
    279288        dqls(i,k) = 0.
    280289        d_deltat_gw(i,k)=0.
     290        d_te(i,k) = 0.
     291        d_qe(i,k) = 0.
     292        d_deltatw(i,k) = 0.
     293        d_deltaqw(i,k) = 0.
    281294!IM 060508 beg
    282295        d_deltatw2(i,k)=0.
    … …  
    294307      sigmaw(i) = amin1(sigmaw(i),0.99)
    295308      sigmaw0(i) = sigmaw(i)
     309      wape(i) = 0.
     310      wape2(i) = 0.
     311      d_sigmaw(i) = 0.
     312      ktopw(i) = 0
    296313      ENDDO
    297314C
    … …  
    406423c
    407424C       Pupper = 50000.  ! melting level
    408        Pupper = 60000.
     425c       Pupper = 60000.
    409426c       Pupper = 80000.  ! essais pour case_e
     427       DO i = 1,klon
     428ccc       Pupper(i) = 0.6*ph(i,1)
     429        Pupper(i) = 60000.
     430       ENDDO
     431
    410432C
    411433C    Determine Wake top pressure (Ptop) from buoyancy integral
    … …  
    481503      DO i=1,klon
    482504        IF (ph(i,k+1) .lt. ptop(i)) ktop(i)=k
    483         IF (ph(i,k+1) .lt. pupper) kupper(i)=k
     505        IF (ph(i,k+1) .lt. pupper(i)) kupper(i)=k
    484506      ENDDO
    485507      ENDDO
    … …  
    622644      ENDIF
    623645      ENDDO
    624 c
    625 C
     646
     647c
     648c Check qx and qw positivity
     649c --------------------------
     650      DO i = 1,klon
     651       q0_min(i)=min(  (qe(i,1)-sigmaw(i)*deltaqw(i,1)),
     652     $              (qe(i,1)+(1.-sigmaw(i))*deltaqw(i,1))  )
     653      ENDDO
     654      DO k = 2,klev
     655      DO i = 1,klon
     656        q1_min(i)=min(  (qe(i,k)-sigmaw(i)*deltaqw(i,k)),
     657     $              (qe(i,k)+(1.-sigmaw(i))*deltaqw(i,k))  )
     658        IF (q1_min(i).le.q0_min(i)) THEN
     659          q0_min(i)=q1_min(i)
     660        ENDIF
     661      ENDDO
     662      ENDDO
     663c
     664      DO i = 1,klon
     665       OK_qx_qw(i) = q0_min(i) .GE. 0.
     666       alpha(i) = 1.
     667      ENDDO
     668c
    626669CC -----------------------------------------------------------------
    627670C    Sub-time-stepping
    … …  
    634677      DO isubstep = 1,nsub
    635678c------------------------------------------------------------
    636       DO i=1,klon
     679c
     680c wk_adv is the logical flag enabling wake evolution in the time advance loop
     681      DO i = 1,klon
     682       wk_adv(i) = OK_qx_qw(i) .AND. alpha(i) .GE. 1.
     683      ENDDO
     684c
     685      DO i=1,klon
     686        IF (wk_adv(i)) THEN
    637687        gfl(i) = 2.*sqrt(3.14*wdens*sigmaw(i))
    638       ENDDO
    639       DO i=1,klon
    640         sigmaw(i) =sigmaw(i) + gfl(i)*Cstar(i)*dtimesub
    641         sigmaw(i) =amin1(sigmaw(i),0.99)     !!!!!!!!
     688        ENDIF
     689      ENDDO
     690      DO i=1,klon
     691        IF (wk_adv(i)) THEN
     692         d_sigmaw(i) = gfl(i)*Cstar(i)*dtimesub
     693c        sigmaw(i) =sigmaw(i) + gfl(i)*Cstar(i)*dtimesub
     694c        sigmaw(i) =min(sigmaw(i),0.99)     !!!!!!!!
    642695c        wdens = wdens0/(10.*sigmaw)
    643696c        sigmaw =max(sigmaw,sigd_con)
    644697c        sigmaw =max(sigmaw,sigmad)
     698        ENDIF
    645699      ENDDO
    646700C
    … …  
    650704cIM 060208 et omg sur les niveaux de 1 a klev+1, alors que avant l'on definit
    651705cIM 060208 au niveau k=1..?
    652       dp_deltomg(1:klon,1:klev)=0.
     706      DO k= 1,klev
     707      DO i = 1,klon
     708        dp_deltomg(i,k)=0.
     709      ENDDO
     710      ENDDO
    653711      DO k= 1,klev+1
    654712      DO i = 1,klon
    … …  
    658716c
    659717      DO i=1,klon
     718        IF (wk_adv(i)) THEN
    660719        z(i)= 0.
    661720        omg(i,1) = 0.
    662721        dp_deltomg(i,1) = -(gfl(i)*Cstar(i))/(sigmaw(i) * (1-sigmaw(i)))
     722        ENDIF
    663723      ENDDO
    664724c
    665725      DO k= 2,klev
    666726      DO i = 1,klon
    667        IF( k .LE. ktop(i)) THEN
     727       IF( wk_adv(i) .AND. k .LE. ktop(i)) THEN
    668728          dz(i) = -(ph(i,k)-ph(i,k-1))/(rho(i,k-1)*rg)
    669729          z(i) = z(i)+dz(i)
    … …  
    675735c
    676736      DO i = 1,klon
     737        IF (wk_adv(i)) THEN
    677738        dztop(i)=-(ptop(i)-ph(i,ktop(i)))/(rho(i,ktop(i))*rg)
    678739        ztop(i) = z(i)+dztop(i)
    679740        omgtop(i)=dp_deltomg(i,1)*ztop(i)
     741        ENDIF
    680742      ENDDO
    681743c
    … …  
    685747c
    686748       DO i=1,klon
     749        IF (wk_adv(i)) THEN
    687750        omgtop(i) = -rho(i,ktop(i))*rg*omgtop(i)
    688751        dp_deltomg(i,1) = omgtop(i)/(ptop(i)-ph(i,1))
     752        ENDIF
    689753       ENDDO
    690754c
    691755      DO k= 1,klev
    692756      DO i = 1,klon
    693        IF( k .LE. ktop(i)) THEN
     757       IF( wk_adv(i) .AND. k .LE. ktop(i)) THEN
    694758          omg(i,k) = - rho(i,k)*rg*omg(i,k)
    695759          dp_deltomg(i,k) = dp_deltomg(i,1)
    … …  
    701765
    702766      DO i=1,klon
    703       IF (kupper(i) .GT. ktop(i)) THEN
     767      IF ( wk_adv(i) .AND. kupper(i) .GT. ktop(i)) THEN
    704768        omg(i,kupper(i)+1) = - Rg*amdwn(i,kupper(i)+1)/sigmaw(i)
    705769     $                + Rg*amup(i,kupper(i)+1)/(1.-sigmaw(i))
    706770        dp_deltomg(i,kupper(i)) = (omgtop(i)-omg(i,kupper(i)+1))/
    707      $                     (ptop(i)-pupper)
     771     $                     (ptop(i)-pupper(i))
    708772      ENDIF
    709773      ENDDO
    … …  
    711775      DO k= 1,klev
    712776      DO i = 1,klon
    713        IF( k .GT. ktop(i) .AND. k .LE. kupper(i)) THEN
     777       IF( wk_adv(i) .AND. k .GT. ktop(i) .AND. k .LE. kupper(i)) THEN
    714778          dp_deltomg(i,k) = dp_deltomg(i,kupper(i))
    715779          omg(i,k) = omgtop(i)+(ph(i,k)-ptop(i))*dp_deltomg(i,kupper(i))
    … …  
    718782      ENDDO
    719783c
     784c
    720785c--    Compute wake average vertical velocity omgbw
    721786c
    … …  
    723788      DO k = 1,klev+1
    724789      DO i=1,klon
     790        IF ( wk_adv(i)) THEN
    725791        omgbw(i,k) = omgb(i,k)+(1.-sigmaw(i))*omg(i,k)
     792        ENDIF
    726793      ENDDO
    727794      ENDDO
    … …  
    730797      DO k = 1,klev
    731798      DO i=1,klon
     799        IF ( wk_adv(i)) THEN
    732800        dp_omgbw(i,k) = (omgbw(i,k+1)-omgbw(i,k))/(ph(i,k+1)-ph(i,k))
     801        ENDIF
    733802      ENDDO
    734803      ENDDO
    … …  
    739808      DO k = 1,klev
    740809      DO i=1,klon
    741        alpha_up(i,k) = 0.
    742        IF (omgb(i,k) .GT. 0.) alpha_up(i,k) = 1.
     810        IF ( wk_adv(i)) THEN
     811         alpha_up(i,k) = 0.
     812         IF (omgb(i,k) .GT. 0.) alpha_up(i,k) = 1.
     813        ENDIF
    743814      ENDDO
    744815      ENDDO
    … …  
    747818
    748819      DO i=1,klon
    749         RRe1(i) = 1.-sigmaw(i)
    750         RRe2(i) = sigmaw(i)
     820        IF ( wk_adv(i)) THEN
     821         RRe1(i) = 1.-sigmaw(i)
     822         RRe2(i) = sigmaw(i)
     823        ENDIF
    751824      ENDDO
    752825      RRd1 = -1.
    … …  
    757830      DO k= 1,klev
    758831      DO i = 1,klon
    759        IF(k .LE. kupper(i)+1) THEN
     832       IF( wk_adv(i) .AND. k .LE. kupper(i)+1) THEN
    760833        dth(i,k) = deltatw(i,k)/ppi(i,k)
    761834        Th1(i,k) = the(i,k) - sigmaw(i)     *dth(i,k)   ! undisturbed area
    … …  
    778851      DO k= 2,klev
    779852      DO i = 1,klon
    780        IF(k .LE. kupper(i)+1) THEN
     853       IF( wk_adv(i) .AND. k .LE. kupper(i)+1) THEN
    781854        D_Th1(i,k) = Th1(i,k-1)-Th1(i,k)
    782855        D_Th2(i,k) = Th2(i,k-1)-Th2(i,k)
    … …  
    790863
    791864      DO i=1,klon
    792         omgbdth(i,1) = 0.
    793         omgbdq(i,1) = 0.
     865        IF( wk_adv(i)) THEN
     866         omgbdth(i,1) = 0.
     867         omgbdq(i,1) = 0.
     868        ENDIF
    794869      ENDDO
    795870
    796871      DO k= 2,klev
    797872      DO i = 1,klon
    798        IF(k .LE. kupper(i)+1) THEN  !   loop on interfaces
     873       IF( wk_adv(i) .AND. k .LE. kupper(i)+1) THEN  !   loop on interfaces
    799874        omgbdth(i,k) = omgb(i,k)*(    dth(i,k-1) -     dth(i,k))
    800875        omgbdq(i,k)  = omgb(i,k)*(deltaqw(i,k-1) - deltaqw(i,k))
    … …  
    806881      DO k= 1,klev
    807882      DO i = 1,klon
    808        IF(k .LE. kupper(i)-1) THEN
     883       IF( wk_adv(i) .AND. k .LE. kupper(i)-1) THEN
    809884c-----------------------------------------------------------------
    810885c
    … …  
    829904c   and increment large scale tendencies
    830905c
    831          dtls(i,k) = dtls(i,k) +
    832      $               dtimesub*(
     906
     907c
     908C
     909CC -----------------------------------------------------------------
     910         d_te(i,k) =  dtimesub*(
    833911     $        ( RRe1(i)*omg(i,k  )*sigmaw(i)     *D_Th1(i,k)
    834912     $         -RRe2(i)*omg(i,k+1)*(1.-sigmaw(i))*D_Th2(i,k+1) )
    … …  
    836914     $         -sigmaw(i)*(1.-sigmaw(i))*dth(i,k)*dp_deltomg(i,k)
    837915     $                      )*ppi(i,k)
    838 c         print*,'dtls=',dtls(i,k)
    839 c
    840          dqls(i,k) = dqls(i,k) +
    841      $               dtimesub*(
     916c
     917         d_qe(i,k) =  dtimesub*(
    842918     $        ( RRe1(i)*omg(i,k  )*sigmaw(i)     *D_q1(i,k)
    843919     $         -RRe2(i)*omg(i,k+1)*(1.-sigmaw(i))*D_q2(i,k+1) )
    … …  
    845921     $         -sigmaw(i)*(1.-sigmaw(i))*deltaqw(i,k)*dp_deltomg(i,k)
    846922     $                      )
    847 c         print*,'dqls=',dqls(k)
    848        ENDIF
     923       ENDIF
     924
    849925c-------------------------------------------------------------------
    850926      ENDDO
    … …  
    856932      DO k= 1,klev
    857933      DO i = 1,klon
    858        IF(k .LE. kupper(i)-1) THEN
     934       IF( wk_adv(i) .AND. k .LE. kupper(i)-1) THEN
    859935c
    860936c Coefficient de répartition
    … …  
    912988
    913989        IF (dtimesub*Tgw(i,k).lt.1.e-10) THEN
    914           deltatw(i,k) = deltatw(i,k)+dtimesub*
    915      $          (ff(i)+dtKE(i,k)+dtPBL(i,k) 
     990          d_deltatw(i,k) = dtimesub*
     991     $          (ff(i)+dtKE(i,k)+dtPBL(i,k)
    916992     $          - spread(i,k)*deltatw(i,k)-Tgw(i,k)*deltatw(i,k))
    917993        ELSE
    918            deltatw(i,k) = deltatw(i,k)+1/Tgw(i,k)*(1-exp(-dtimesub*
     994           d_deltatw(i,k) = 1/Tgw(i,k)*(1-exp(-dtimesub*
    919995     $          Tgw(i,k)))*
    920996     $          (ff(i)+dtKE(i,k)+dtPBL(i,k)
    921997     $          - spread(i,k)*deltatw(i,k)-Tgw(i,k)*deltatw(i,k))
    922998        ENDIF
    923    
     999
    9241000        dth(i,k) = deltatw(i,k)/ppi(i,k)
    9251001
    9261002        gg(i)=d_deltaqw(i,k)/dtimesub
    9271003
    928        deltaqw(i,k) = deltaqw(i,k) +
    929      $         dtimesub*(gg(i)+ dqKE(i,k)+dqPBL(i,k) - spread(i,k)*
    930      $         deltaqw(i,k))
     1004       d_deltaqw(i,k) = dtimesub*(gg(i)+ dqKE(i,k)+dqPBL(i,k)
     1005     $                            - spread(i,k)*deltaqw(i,k))
    9311006
    9321007       d_deltatw2(i,k)=d_deltatw2(i,k)+d_deltatw(i,k)
    … …  
    9361011      ENDDO
    9371012
    938 C   And update large scale variables
     1013C
     1014C   Scale tendencies so that water vapour remains positive in w and x.
     1015C
     1016      call wake_vec_modulation(klon,klev,wk_adv,qe,d_qe,deltaqw,
     1017     $                d_deltaqw,sigmaw,d_sigmaw,alpha)
     1018c
     1019      DO k = 1,klev
     1020      DO i = 1,klon
     1021       IF( wk_adv(i) .AND. k .LE. kupper(i)) THEN
     1022        d_te(i,k)=alpha(i)*d_te(i,k)
     1023        d_qe(i,k)=alpha(i)*d_qe(i,k)
     1024        d_deltatw(i,k)=alpha(i)*d_deltatw(i,k)
     1025        d_deltaqw(i,k)=alpha(i)*d_deltaqw(i,k)
     1026        d_deltat_gw(i,k)=alpha(i)*d_deltat_gw(i,k)
     1027       ENDIF
     1028      ENDDO
     1029      ENDDO
     1030      DO i = 1,klon
     1031       IF( wk_adv(i)) THEN
     1032        d_sigmaw(i)=alpha(i)*d_sigmaw(i)
     1033       ENDIF
     1034      ENDDO
     1035
     1036C   Update large scale variables and wake variables
    9391037cIM 060208 manque DO i + remplace DO k=1,kupper(i)
    9401038cIM 060208     DO k = 1,kupper(i)
    9411039      DO k= 1,klev
    9421040      DO i = 1,klon
    943        IF(k .LE. kupper(i)) THEN
     1041       IF( wk_adv(i) .AND. k .LE. kupper(i)) THEN
     1042        dtls(i,k)=dtls(i,k)+d_te(i,k)
     1043        dqls(i,k)=dqls(i,k)+d_qe(i,k)
     1044       ENDIF
     1045      ENDDO
     1046      ENDDO
     1047      DO k= 1,klev
     1048      DO i = 1,klon
     1049       IF( wk_adv(i) .AND. k .LE. kupper(i)) THEN
    9441050        te(i,k) = te0(i,k) + dtls(i,k)
    9451051        qe(i,k) = qe0(i,k) + dqls(i,k)
    9461052        the(i,k) = te(i,k)/ppi(i,k)
    947        ENDIF
    948       ENDDO
     1053        deltatw(i,k) = deltatw(i,k)+d_deltatw(i,k)
     1054        deltaqw(i,k) = deltaqw(i,k)+d_deltaqw(i,k)
     1055        dth(i,k) = deltatw(i,k)/ppi(i,k)
     1056       ENDIF
     1057      ENDDO
     1058      ENDDO
     1059      DO i = 1,klon
     1060       IF( wk_adv(i)) THEN
     1061        sigmaw(i) = sigmaw(i)+d_sigmaw(i)
     1062       ENDIF
    9491063      ENDDO
    9501064c
    … …  
    9561070c
    9571071      DO i=1,klon
    958       Ptop_provis(i)=ph(i,1)
     1072       IF ( wk_adv(i)) THEN
     1073        Ptop_provis(i)=ph(i,1)
     1074       ENDIF
    9591075      ENDDO
    9601076c
    9611077      DO k= 2,klev
    9621078      DO i=1,klon
    963         IF (Ptop_provis(i) .EQ. ph(i,1) .AND.
     1079        IF ( wk_adv(i) .AND.
     1080     $       Ptop_provis(i) .EQ. ph(i,1) .AND.
    9641081     $      dth(i,k) .GT. -delta_t_min .and.
    9651082     $      dth(i,k-1).LT. -delta_t_min) THEN
    … …  
    9811098      DO k = 1,klev
    9821099      DO i=1,klon
     1100       IF ( wk_adv(i)) THEN
    9831101        dz(i) = -(amax1(ph(i,k+1),Ptop_provis(i))-Ph(i,k))/(rho(i,k)*rg)
    9841102        IF (dz(i) .gt. 0) THEN
    … …  
    9871105         dthmin(i) = amin1(dthmin(i),dth(i,k))
    9881106        ENDIF
     1107       ENDIF
    9891108      ENDDO
    9901109      ENDDO
    … …  
    9931112
    9941113      DO i=1,klon
    995        hw(i) = 2.*sum_dth(i)/amin1(dthmin(i),-0.5)
    996        hw(i) = amax1(hwmin,hw(i))
     1114       IF ( wk_adv(i)) THEN
     1115         hw(i) = 2.*sum_dth(i)/amin1(dthmin(i),-0.5)
     1116         hw(i) = amax1(hwmin,hw(i))
     1117       ENDIF
    9971118      ENDDO
    9981119c
    … …  
    10061127      DO k = 1,klev
    10071128      DO i=1,klon
     1129       IF ( wk_adv(i)) THEN
    10081130        dz(i) = amin1(-(ph(i,k+1)-Ph(i,k))/(rho(i,k)*rg),hw(i)-z(i))
    10091131        IF (dz(i) .gt. 0) THEN
    … …  
    10121134         ktop(i) = k
    10131135        ENDIF
     1136       ENDIF
    10141137      ENDDO
    10151138      ENDDO
    … …  
    10181141c
    10191142      DO i=1,klon
     1143       IF ( wk_adv(i)) THEN
    10201144        Ptop_new(i)=ptop(i)
     1145       ENDIF
    10211146      ENDDO
    10221147c
    … …  
    10241149      DO i=1,klon
    10251150cIM v3JYG; IF (k .GE. ktop(i)
    1026        IF (k .LE. ktop(i) .AND.
     1151       IF ( wk_adv(i) .AND.
     1152     $      k .LE. ktop(i) .AND.
    10271153     $      ptop_new(i) .EQ. ptop(i) .AND.
    10281154     $      dth(i,k) .GT. -delta_t_min .and.
    … …  
    10371163c
    10381164      DO i=1,klon
    1039       ptop(i) = ptop_new(i)
     1165       IF ( wk_adv(i)) THEN
     1166        ptop(i) = ptop_new(i)
     1167       ENDIF
    10401168      ENDDO
    10411169
    … …  
    10501178      DO k = 1,klev
    10511179      DO i=1,klon
    1052         IF (k .GE. kupper(i)) THEN
     1180        IF ( wk_adv(i) .AND. k .GE. kupper(i)) THEN
    10531181         deltatw(i,k) = 0.
    10541182         deltaqw(i,k) = 0.
    … …  
    10581186c
    10591187C
     1188c-------------Cstar computation---------------------------------
     1189      DO i=1, klon
     1190      sum_thu(i) = 0.
     1191      sum_tu(i) = 0.
     1192      sum_qu(i) = 0.
     1193      sum_thvu(i) = 0.
     1194      sum_dth(i) = 0.
     1195      sum_dq(i) = 0.
     1196      sum_rho(i) = 0.
     1197      sum_dtdwn(i) = 0.
     1198      sum_dqdwn(i) = 0.
     1199
     1200      av_thu(i) = 0.
     1201      av_tu(i) =0.
     1202      av_qu(i) =0.
     1203      av_thvu(i) = 0.
     1204      av_dth(i) = 0.
     1205      av_dq(i) = 0.
     1206      av_rho(i) =0.
     1207      av_dtdwn(i) =0.
     1208      av_dqdwn(i) = 0.
     1209      ENDDO
     1210C
     1211C Integrals (and wake top level number)
     1212C --------------------------------------
     1213C
     1214C Initialize sum_thvu to 1st level virt. pot. temp.
     1215
     1216      DO i=1,klon
     1217      z(i) = 1.
     1218      dz(i) = 1.
     1219      sum_thvu(i) =  thu(i,1)*(1.+eps*qu(i,1))*dz(i)
     1220      sum_dth(i) = 0.
     1221      ENDDO
     1222
     1223      DO k = 1,klev
     1224      DO i=1,klon
     1225        dz(i) = -(max(ph(i,k+1),ptop(i))-ph(i,k))/(rho(i,k)*rg)
     1226        IF (dz(i) .GT. 0) THEN
     1227         z(i) = z(i)+dz(i)
     1228         sum_thu(i) = sum_thu(i) + thu(i,k)*dz(i)
     1229         sum_tu(i) = sum_tu(i) + tu(i,k)*dz(i)
     1230         sum_qu(i) = sum_qu(i) + qu(i,k)*dz(i)
     1231         sum_thvu(i) = sum_thvu(i) + thu(i,k)*(1.+eps*qu(i,k))*dz(i)
     1232         sum_dth(i) = sum_dth(i) + dth(i,k)*dz(i)
     1233         sum_dq(i) = sum_dq(i) + deltaqw(i,k)*dz(i)
     1234         sum_rho(i) = sum_rho(i) + rhow(i,k)*dz(i)
     1235         sum_dtdwn(i) = sum_dtdwn(i) + dtdwn(i,k)*dz(i)
     1236         sum_dqdwn(i) = sum_dqdwn(i) + dqdwn(i,k)*dz(i)
     1237        ENDIF
     1238      ENDDO
     1239      ENDDO
     1240c
     1241      DO i=1,klon
     1242        hw0(i) = z(i)
     1243      ENDDO
     1244c
     1245C
     1246C - WAPE and mean forcing computation
     1247C ---------------------------------------
     1248C
     1249C ---------------------------------------
     1250C
     1251C Means
     1252
     1253      DO i=1,klon
     1254       av_thu(i) = sum_thu(i)/hw0(i)
     1255       av_tu(i) = sum_tu(i)/hw0(i)
     1256       av_qu(i) = sum_qu(i)/hw0(i)
     1257       av_thvu(i) = sum_thvu(i)/hw0(i)
     1258       av_dth(i) = sum_dth(i)/hw0(i)
     1259       av_dq(i) = sum_dq(i)/hw0(i)
     1260       av_rho(i) = sum_rho(i)/hw0(i)
     1261       av_dtdwn(i) = sum_dtdwn(i)/hw0(i)
     1262       av_dqdwn(i) = sum_dqdwn(i)/hw0(i)
     1263c
     1264       wape(i) = - rg*hw0(i)*(av_dth(i)
     1265     $     + eps*(av_thu(i)*av_dq(i)+av_dth(i)*av_qu(i)+av_dth(i)*
     1266     $     av_dq(i) ))/av_thvu(i)
     1267      ENDDO
     1268C
     1269C Filter out bad wakes
     1270
     1271      DO k = 1,klev
     1272       DO i=1,klon
     1273        IF ( wape(i) .LT. 0.) THEN
     1274          deltatw(i,k) = 0.
     1275          deltaqw(i,k) = 0.
     1276          dth(i,k) = 0.
     1277        ENDIF
     1278       ENDDO
     1279      ENDDO
     1280c
     1281      DO i=1,klon
     1282      IF ( wape(i) .LT. 0.) THEN
     1283        wape(i) = 0.
     1284        Cstar(i) = 0.
     1285        hw(i) = hwmin
     1286        sigmaw(i) = max(sigmad,sigd_con(i))
     1287        fip(i) = 0.
     1288        gwake(i) = .FALSE.
     1289      ELSE
     1290        Cstar(i) = stark*sqrt(2.*wape(i))
     1291        gwake(i) = .TRUE.
     1292      ENDIF
     1293      ENDDO
     1294
    10601295       ENDDO      ! end sub-timestep loop
    10611296C
    … …  
    10651300      DO k = 1,klev
    10661301      DO i=1,klon
    1067         IF (k .LE. kupper(i)-1) THEN
     1302        IF ( wk_adv(i) .AND. k .LE. kupper(i)-1) THEN
    10681303         dtls(i,k) = dtls(i,k)/dtime
    10691304         dqls(i,k) = dqls(i,k)/dtime
    … …  
    11111346      DO k =1,klev
    11121347      DO i=1,klon
     1348       IF ( wk_adv(i)) THEN
    11131349        rho(i,k) = p(i,k)/(rd*te(i,k))
    11141350        IF(k .eq. 1) THEN
    … …  
    11251361        rhow(i,k) = p(i,k)/(rd*(te(i,k)+deltatw(i,k)))
    11261362        dth(i,k) = deltatw(i,k)/ppi(i,k)
     1363       ENDIF
    11271364      ENDDO
    11281365      ENDDO
    … …  
    11341371
    11351372      DO i=1,klon
     1373       IF ( wk_adv(i)) THEN
    11361374        z(i) = 1.
    11371375        dz(i) = 1.
    11381376        sum_thvu(i) =  thu(i,1)*(1.+eps*qu(i,1))*dz(i)
    11391377        sum_dth(i) = 0.
     1378      ENDIF
    11401379      ENDDO
    11411380
    11421381      DO k = 1,klev
    11431382      DO i=1,klon
     1383       IF ( wk_adv(i)) THEN
    11441384        dz(i) = -(amax1(ph(i,k+1),ptop(i))-ph(i,k))/(rho(i,k)*rg)
    11451385        IF (dz(i) .GT. 0) THEN
    … …  
    11551395         sum_dqdwn(i) = sum_dqdwn(i) + dqdwn(i,k)*dz(i)
    11561396        ENDIF
    1157       ENDDO
    1158       ENDDO
    1159 c
    1160       DO i=1,klon
     1397       ENDIF
     1398      ENDDO
     1399      ENDDO
     1400c
     1401      DO i=1,klon
     1402       IF ( wk_adv(i)) THEN
    11611403        hw0(i) = z(i)
    1162       ENDDO
    1163 c
    1164 C 2.1 - WAPE and mean forcing computation
     1404       ENDIF
     1405      ENDDO
     1406c
     1407C - WAPE and mean forcing computation
    11651408C-------------------------------------------------------------
    11661409
    … …  
    11681411
    11691412      DO i=1, klon
     1413       IF ( wk_adv(i)) THEN
    11701414        av_thu(i) = sum_thu(i)/hw0(i)
    11711415        av_tu(i) = sum_tu(i)/hw0(i)
    … …  
    11811425     $     + eps*(av_thu(i)*av_dq(i)+av_dth(i)*av_qu(i)+
    11821426     $     av_dth(i)*av_dq(i) ))/av_thvu(i)
    1183       ENDDO
    1184 
    1185 C 2.2 Prognostic variable update
     1427       ENDIF
     1428      ENDDO
     1429
     1430C Prognostic variable update
    11861431C ------------------------------------------------------------
    11871432
    … …  
    11901435      DO k = 1,klev
    11911436      DO i=1,klon
    1192         IF ( wape2(i) .LT. 0.) THEN
     1437        IF ( wk_adv(i) .AND. wape2(i) .LT. 0.) THEN
    11931438          deltatw(i,k) = 0.
    11941439          deltaqw(i,k) = 0.
    … …  
    12001445
    12011446      DO i=1, klon
    1202       IF ( wape2(i) .LT. 0.) THEN
     1447       IF ( wk_adv(i)) THEN
     1448       IF ( wape2(i) .LT. 0.) THEN
    12031449        wape2(i) = 0.
    12041450        Cstar2(i) = 0.
    … …  
    12121458        gwake(i) = .TRUE.
    12131459      ENDIF
     1460      ENDIF
    12141461      ENDDO
    12151462c
    12161463      DO i=1, klon
     1464       IF ( wk_adv(i)) THEN
    12171465        ktopw(i) = ktop(i)
     1466       ENDIF
    12181467      ENDDO
    12191468c
    12201469      DO i=1, klon
    1221       IF (ktopw(i) .gt. 0 .and. gwake(i)) then
     1470       IF ( wk_adv(i)) THEN
     1471       IF (ktopw(i) .gt. 0 .and. gwake(i)) then
    12221472
    12231473Cjyg1     Utilisation d'un h_efficace constant ( ~ feeding layer)
    … …  
    12341484         FIP(i) = 0.
    12351485       ENDIF
     1486       ENDIF
    12361487      ENDDO
    12371488c
    … …  
    12411492C              alors il disparait en se mélangeant à la partie undisturbed
    12421493c
     1494      sigmaw_max = 0.9
    12431495      DO k = 1,klev
    12441496       DO i=1, klon
    1245          IF ((sigmaw(i).GT.0.9).or.
     1497c correction NICOLAS     $     ((wape(i).ge.wape2(i)).and.(wape2(i).le.1.0))) THEN
     1498!         print*,'wape wape2 ktopw OK_qx_qw =',
     1499!     $           wape(i),wape2(i),ktopw(i),OK_qx_qw(i)
     1500         IF ((sigmaw(i).GT.sigmaw_max).or.
    12461501     $     ((wape(i).ge.wape2(i)).and.(wape2(i).le.1.0)).or.
    1247      $      (ktopw(i).le.2)) THEN
     1502     $      (ktopw(i).le.2) .OR.
     1503     $     .not. OK_qx_qw(i)) THEN
    12481504cIM cf NR/JYG 251108  $     ((wape(i).ge.wape2(i)).and.(wape2(i).le.1.0))) THEN
    12491505ccc      IF (sigmaw(i).GT.0.9) THEN
    … …  
    12571513c
    12581514      DO i=1, klon
    1259          IF ((sigmaw(i).GT.0.9).or.
    1260      $     ((wape(i).ge.wape2(i)).and.(wape2(i).le.1.0))) THEN
     1515         IF ( (sigmaw(i).GT.sigmaw_max).or.
     1516     $      ((wape(i).ge.wape2(i)).and.(wape2(i).le.1.0)).or.
     1517     $      (ktopw(i).le.2) .OR.
     1518     $     .not. OK_qx_qw(i)) THEN
     1519! correction NICOLAS     $     ((wape(i).ge.wape2(i)).and.(wape2(i).le.1.0))) THEN
    12611520ccc      IF (sigmaw(i).GT.0.9) THEN
    12621521         wape(i) = 0.
    … …  
    12721531      RETURN
    12731532      END
     1533
     1534      SUBROUTINE wake_vec_modulation(nlon,nl,wk_adv,qe,d_qe,
     1535     $           deltaqw,d_deltaqw,sigmaw,d_sigmaw,alpha)
     1536c------------------------------------------------------
     1537cDtermination du coefficient alpha tel que les tendances
     1538c corriges alpha*d_G, pour toutes les grandeurs G, correspondent
     1539c a une humidite positive dans la zone (x) et dans la zone (w).
     1540c------------------------------------------------------
     1541c
     1542 
     1543c  Input
     1544      REAL qe(nlon,nl),d_qe(nlon,nl)
     1545      REAL deltaqw(nlon,nl),d_deltaqw(nlon,nl)
     1546      REAL sigmaw(nlon),d_sigmaw(nlon)
     1547      LOGICAL wk_adv(nlon)
     1548      INTEGER nl,nlon
     1549c  Output
     1550      REAL alpha(nlon)
     1551c  Internal variables
     1552      REAL alpha1(nlon)
     1553      REAL x,a,b,c,discrim,zeta(nlon)
     1554      REAL epsilon
     1555      DATA epsilon/1.e-15/
     1556c
     1557      DO k=1,nl
     1558      DO i = 1,nlon
     1559       IF (wk_adv(i)) THEN
     1560        IF ((deltaqw(i,k)+d_deltaqw(i,k)).ge.0.) then
     1561         zeta(i)=0.
     1562        ELSE
     1563         zeta(i)=1.
     1564        END IF
     1565       ENDIF
     1566      ENDDO
     1567      DO i = 1,nlon
     1568       IF (wk_adv(i)) THEN
     1569        x = qe(i,k)+(zeta(i)-sigmaw(i))*deltaqw(i,k)
     1570     $   +d_qe(i,k)+(zeta(i)-sigmaw(i))*d_deltaqw(i,k)
     1571     $   -d_sigmaw(i)*(deltaqw(i,k)+d_deltaqw(i,k))
     1572      a=-d_sigmaw(i)*d_deltaqw(i,k)
     1573      b=d_qe(i,k)+(zeta(i)-sigmaw(i))*d_deltaqw(i,k)
     1574     $           -deltaqw(i,k)*d_sigmaw(i)
     1575      c=qe(i,k)+(zeta(i)-sigmaw(i))*deltaqw(i,k)-epsilon
     1576!       c=qe(i,k)+(zeta(i)-sigmaw(i))*deltaqw(i,k)
     1577
     1578      discrim=b*b-4.*a*c
     1579!       print*,'ZETA *********************' 
     1580!       print*,'zeta sigmaw ',zeta(:)
     1581!       print*,'SIGMA *********************'
     1582!       print*,'sigmaw ',sigmaw(:)
     1583
     1584!       print*,' x ************************'
     1585!       print*,'x ',x
     1586!       print*,'  a+b ************************'
     1587!       print*,'a+b ',a+b
     1588
     1589!       print*,'a b c delta zeta ',a,b,c,discrim
     1590        IF (a+b .GE. 0.) THEN
     1591         alpha1(i)=1.
     1592        ELSE
     1593         IF (x .GE. 0.) THEN
     1594            alpha1(i)=1.
     1595         ELSE
     1596!              IF (a .GE. 0.) THEN
     1597              IF (a .GT. 0.) THEN
     1598!       print*,'a b c delta zeta ',a,b,c,discrim,zeta(i)
     1599!       print*,'-b+sqrt(discrim) ',-b+sqrt(discrim)
     1600                 alpha1(i)=0.9*min(   (2.*c)/(-b+sqrt(discrim)),
     1601     $                        (-b+sqrt(discrim))/(2.*a)   )
     1602              ELSE IF (a.eq.0.) THEN
     1603                 alpha1(i)=0.9*(-c/b)
     1604              ELSE
     1605!       print*,'a b c delta zeta ',a,b,c,discrim,zeta(i)
     1606!       print*,'-b+sqrt(discrim) ',-b+sqrt(discrim)
     1607                 alpha1(i)=0.9*max(   (2.*c)/(-b+sqrt(discrim)),
     1608     $                        (-b+sqrt(discrim))/(2.*a)   )
     1609              ENDIF
     1610         ENDIF
     1611        ENDIF
     1612       ENDIF
     1613      ENDDO
     1614      ENDDO
     1615c
     1616      DO i = 1,nlon
     1617       IF (wk_adv(i)) THEN
     1618        alpha(i) = min(alpha(i),alpha1(i))
     1619       ENDIF
     1620      ENDDO
     1621c
     1622      return
     1623      end
     1624
    12741625      Subroutine WAKE_scal (p,ph,ppi,dtime,sigd_con
    12751626     :                ,te0,qe0,omgb
    … …  
    23152666C              alors il disparait en se mélangeant à la partie undisturbed
    23162667
     2668! correction NICOLAS     .     ((wape.ge.wape2).and.(wape2.le.1.0))) THEN
    23172669      IF ((sigmaw.GT.0.9).or.
    23182670     .     ((wape.ge.wape2).and.(wape2.le.1.0)).or.(ktopw.le.2)) THEN

  • LMDZ4/trunk/libf/phylmd/write_histrac.h

    r1030 r1146  
    33!
    44
    5       IF (config_inca == 'none') THEN
     5      IF (ecrit_tra>0. .AND. config_inca == 'none') THEN
    66      ndex = 0
    77      ndex2d = 0
    … …  
    1414      CALL histwrite_phy(nid_tra,"aire",itau_w,airephy)
    1515
    16       DO it=1,nqmax
    17 C champs 2D
     16      DO it=1,nbtr
     17       iiq=niadv(it+2)
    1818
    19 
    20        CALL histwrite_phy(nid_tra,tnom(it+2),itau_w,tr_seri(:,:,it))
     19       CALL histwrite_phy(nid_tra,tname(iiq),itau_w,tr_seri(:,:,it))
    2120       if (lessivage) THEN
    22        CALL histwrite_phy(nid_tra,"fl"//tnom(it+2),itau_w,
     21       CALL histwrite_phy(nid_tra,"fl"//tname(iiq),itau_w,
    2322     .                                   flestottr(:,:,it))
    2423      endif
    2524     
    2625c----Olivia
    27        CALL histwrite_phy(nid_tra,"d_tr_th_"//tnom(it+2),itau_w,
     26       CALL histwrite_phy(nid_tra,"d_tr_th_"//tname(iiq),itau_w,
    2827     .                                           d_tr_th(:,:,it))
    2928
    3029         if(iflag_con.GE.2) then
    31        CALL histwrite_phy(nid_tra,"d_tr_cv_"//tnom(it+2),itau_w,
     30       CALL histwrite_phy(nid_tra,"d_tr_cv_"//tname(iiq),itau_w,
    3231     .                                           d_tr_cv(:,:,it))
    3332         endif !(iflag_con.GE.2) then
    34        CALL histwrite_phy(nid_tra,"d_tr_cl_"//tnom(it+2),itau_w,
     33       CALL histwrite_phy(nid_tra,"d_tr_cl_"//tname(iiq),itau_w,
    3534     .                                           d_tr_cl(:,:,it))
    3635c---fin Olivia     
    … …  
    7978       endif
    8079
    81        END IF
     80       END IF !ecrit_tra>0. .AND. config_inca == 'none'
    8281
    8382
Note: See TracChangeset for help on using the changeset viewer.