Changeset 1357


Ignore:
Timestamp:
Apr 14, 2010, 4:03:19 PM (15 years ago)
Author:
Ehouarn Millour
Message:

Some cleanup and fixing the possibility to output fields in the dynamics, on the dynamical grids.

CLEANUPS:

  • arch-PW6_VARGAS.fcm : add potentially benefic compiling options
  • removed obsolete "control.h" in dyn3d/dyn3dpar (module control_mod.F90 is used instead)

OUTPUTS in the dynamics (3 sets of files, one for each grid: scalar, u, v):

  • removed "com_io_dyn.h" common; use module "com_io_dyn_mod.F90" instead
  • updated "initdynav.F","inithist.F","writehist.F" and "writedynav.F" in bibio: which field will be written is hard coded there.
  • flags "ok_dyn_ins" and "ok_dyn_ave" (loaded via conf_gcm.F) trigger output of fields in the dynamics: if ok_dyn_ins is true, then files "dyn_hist.nc", "dyn_histu.nc" and "dyn_histv.nc" are written (the frequency of the outputs is given by 'iecri' in run.def; values are written every 'iecri' dynamical step). if ok_dyn_ave is true then files "dyn_hist_ave.nc", "dyn_histu_ave.nc" and "dyn_histv_ave.nc" are written (the rate at which averages and made/written, in days, is given by 'periodav' in run.def).

EM

Location:
LMDZ4/branches/LMDZ4V5.0-dev
Files:
3 added
4 deleted
12 edited

Legend:

Unmodified
Added
Removed

  • LMDZ4/branches/LMDZ4V5.0-dev/arch/arch-PW6_VARGAS.fcm

    r1279 r1357  
    55%FPP_FLAGS           -P
    66%FPP_DEF             NC_DOUBLE BLAS SGEMV=DGEMV SGEMM=DGEMM
    7 %BASE_FFLAGS         -qautodbl=dbl4 -qxlf90=autodealloc
     7%BASE_FFLAGS         -qautodbl=dbl4 -qxlf90=autodealloc -qmaxmem=-1 -qzerosize
    88%PROD_FFLAGS         -O5
    99%DEV_FFLAGS          -O2 -qfullpath -qinitauto=7FBFFFFF -qfloat=nans -qflttrap=overflow:zerodivide:invalid:enable -qsigtrap

  • LMDZ4/branches/LMDZ4V5.0-dev/libf/bibio/initdynav.F

    r1279 r1357  
    22! $Id$
    33!
    4       subroutine initdynav(infile,day0,anne0,tstep,t_ops,t_wrt
    5      .                     ,fileid)
     4      subroutine initdynav(day0,anne0,tstep,t_ops,t_wrt)
    65
    76#ifdef CPP_IOIPSL
    … …  
    98#endif
    109       USE infotrac, ONLY : nqtot, ttext
    11 
     10      use com_io_dyn_mod, only : histaveid,histvaveid,histuaveid,       &
     11     &        dynhistave_file,dynhistvave_file,dynhistuave_file
    1212      implicit none
    1313
    … …  
    3030C      t_wrt: frequence d'ecriture sur le fichier
    3131C
    32 C   Sortie:
    33 C      fileid: ID du fichier netcdf cree
    3432C
    3533C   L. Fairhead, LMD, 03/99
    … …  
    5250C   Arguments
    5351C
    54       character*(*) infile
    5552      integer day0, anne0
    5653      real tstep, t_ops, t_wrt
    57       integer fileid
    5854
    5955#ifdef CPP_IOIPSL
    … …  
    6157C   Variables locales
    6258C
    63       integer thoriid, zvertiid
    6459      integer tau0
    6560      real zjulian
    6661      integer iq
    6762      real rlong(iip1,jjp1), rlat(iip1,jjp1)
     63      integer uhoriid, vhoriid, thoriid, zvertiid
    6864      integer ii,jj
    6965      integer zan, dayref
    … …  
    8884      enddo
    8985       
    90       call histbeg(infile, iip1, rlong(:,1), jjp1, rlat(1,:),
     86! Creation de 3 fichiers pour les differentes grilles horizontales
     87! Restriction de IOIPSL: seulement 2 coordonnees dans le meme fichier
     88! Grille Scalaire       
     89      call histbeg(dynhistave_file, iip1, rlong(:,1), jjp1, rlat(1,:),
    9190     .             1, iip1, 1, jjp1,
    92      .             tau0, zjulian, tstep, thoriid, fileid)
    93 
     91     .             tau0, zjulian, tstep, thoriid,histaveid)
     92
     93C  Creation du fichier histoire pour les grilles en V et U (oblige pour l'instant,
     94C  IOIPSL ne permet pas de grilles avec des nombres de point differents dans
     95C  un meme fichier)
     96! Grille V
     97      do jj = 1, jjm
     98        do ii = 1, iip1
     99          rlong(ii,jj) = rlonv(ii) * 180. / pi
     100          rlat(ii,jj) = rlatv(jj) * 180. / pi
     101        enddo
     102      enddo
     103
     104      call histbeg(dynhistvave_file, iip1, rlong(:,1), jjm, rlat(1,:),
     105     .             1, iip1, 1, jjm,
     106     .             tau0, zjulian, tstep, vhoriid,histvaveid)
     107! Grille U
     108      do jj = 1, jjp1
     109        do ii = 1, iip1
     110          rlong(ii,jj) = rlonu(ii) * 180. / pi
     111          rlat(ii,jj) = rlatu(jj) * 180. / pi
     112        enddo
     113      enddo
     114
     115      call histbeg(dynhistuave_file, iip1, rlong(:,1),jjp1, rlat(1,:),
     116     .             1, iip1, 1, jjp1,
     117     .             tau0, zjulian, tstep, uhoriid,histuaveid)
    94118C
    95119C  Appel a histvert pour la grille verticale
    96120C
    97       call histvert(fileid, 'sigss', 'Niveaux sigma','Pa',
    98      .              llm, nivsigs, zvertiid)
     121      call histvert(histaveid,'presnivs','Niveaux Pression
     122     &     approximatifs','mb',llm, presnivs/100., zvertiid,'down')
     123      call histvert(histuaveid,'presnivs','Niveaux Pression
     124     &     approximatifs','mb',llm, presnivs/100., zvertiid,'down')
     125      call histvert(histvaveid,'presnivs','Niveaux Pression
     126     &     approximatifs','mb',llm, presnivs/100., zvertiid,'down')
    99127C
    100128C  Appels a histdef pour la definition des variables a sauvegarder
    … …  
    102130C  Vents U
    103131C
    104       write(6,*)'inithistave',tstep
    105       call histdef(fileid, 'u', 'vents u scalaires moyennes',
    106      .             'm/s', iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
    107      .             32, 'ave(X)', t_ops, t_wrt)
    108 
    109 C
     132!      write(6,*)'inithistave',tstep
     133      call histdef(histuaveid, 'u', 'vent u moyen ',
     134     .             'm/s', iip1, jjp1, uhoriid, llm, 1, llm, zvertiid,
     135     .             32, 'ave(X)', t_ops, t_wrt)
     136
    110137C  Vents V
    111138C
    112       call histdef(fileid, 'v', 'vents v scalaires moyennes',
    113      .             'm/s', iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
     139      call histdef(histvaveid, 'v', 'vent v moyen',
     140     .             'm/s', iip1, jjm, vhoriid, llm, 1, llm, zvertiid,
    114141     .             32, 'ave(X)', t_ops, t_wrt)
    115142
    … …  
    117144C  Temperature
    118145C
    119       call histdef(fileid, 'temp', 'temperature moyennee', 'K',
     146      call histdef(histaveid, 'temp', 'temperature moyenne', 'K',
    120147     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
    121148     .             32, 'ave(X)', t_ops, t_wrt)
    … …  
    123150C  Temperature potentielle
    124151C
    125       call histdef(fileid, 'theta', 'temperature potentielle', 'K',
    126      .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
    127      .             32, 'ave(X)', t_ops, t_wrt)
    128 
    129 
     152      call histdef(histaveid, 'theta', 'temperature potentielle', 'K',
     153     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
     154     .             32, 'ave(X)', t_ops, t_wrt)
    130155C
    131156C  Geopotentiel
    132157C
    133       call histdef(fileid, 'phi', 'geopotentiel moyenne', '-',
     158      call histdef(histaveid, 'phi', 'geopotentiel moyen', '-',
    134159     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
    135160     .             32, 'ave(X)', t_ops, t_wrt)
    … …  
    137162C  Traceurs
    138163C
    139         DO iq=1,nqtot
    140           call histdef(fileid, ttext(iq), ttext(iq), '-',
    141      .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
    142      .             32, 'ave(X)', t_ops, t_wrt)
    143         enddo
     164!        DO iq=1,nqtot
     165!          call histdef(histaveid, ttext(iq), ttext(iq), '-',
     166!     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
     167!     .             32, 'ave(X)', t_ops, t_wrt)
     168!        enddo
    144169C
    145170C  Masse
    146171C
    147       call histdef(fileid, 'masse', 'masse', 'kg',
     172      call histdef(histaveid, 'masse', 'masse', 'kg',
     173     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
     174     .             32, 'ave(X)', t_ops, t_wrt)
     175C
     176C  Pression au sol
     177C
     178      call histdef(histaveid, 'ps', 'pression naturelle au sol', 'Pa',
    148179     .             iip1, jjp1, thoriid, 1, 1, 1, -99,
    149180     .             32, 'ave(X)', t_ops, t_wrt)
    150181C
    151 C  Pression au sol
    152 C
    153       call histdef(fileid, 'ps', 'pression naturelle au sol', 'Pa',
    154      .             iip1, jjp1, thoriid, 1, 1, 1, -99,
    155      .             32, 'ave(X)', t_ops, t_wrt)
    156 C
    157 C  Pression au sol
    158 C
    159       call histdef(fileid, 'phis', 'geopotentiel au sol', '-',
    160      .             iip1, jjp1, thoriid, 1, 1, 1, -99,
    161      .             32, 'ave(X)', t_ops, t_wrt)
    162 C
     182C  Geopotentiel au sol
     183C
     184!      call histdef(histaveid, 'phis', 'geopotentiel au sol', '-',
     185!     .             iip1, jjp1, thoriid, 1, 1, 1, -99,
     186!     .             32, 'ave(X)', t_ops, t_wrt)
     187!C
    163188C  Fin
    164189C
    165       call histend(fileid)
     190      call histend(histaveid)
     191      call histend(histuaveid)
     192      call histend(histvaveid)
    166193#else
    167194! tell the user this routine should be run with ioipsl

  • LMDZ4/branches/LMDZ4V5.0-dev/libf/bibio/inithist.F

    r1279 r1357  
    22! $Id$
    33!
    4       subroutine inithist(infile,day0,anne0,tstep,t_ops,t_wrt,fileid,
    5      .                    filevid)
     4      subroutine inithist(day0,anne0,tstep,t_ops,t_wrt)
    65
    76#ifdef CPP_IOIPSL
    … …  
    98#endif
    109       USE infotrac, ONLY : nqtot, ttext
     10       use com_io_dyn_mod, only : histid,histvid,histuid,               &
     11     &                        dynhist_file,dynhistv_file,dynhistu_file
    1112
    1213      implicit none
    … …  
    3132C      nq: nombre de traceurs
    3233C
    33 C   Sortie:
    34 C      fileid: ID du fichier netcdf cree
    35 C      filevid:ID du fichier netcdf pour la grille v
    3634C
    3735C   L. Fairhead, LMD, 03/99
    … …  
    5452C   Arguments
    5553C
    56       character*(*) infile
    5754      integer day0, anne0
    5855      real tstep, t_ops, t_wrt
    59       integer fileid, filevid
    6056
    6157#ifdef CPP_IOIPSL
    … …  
    8379      tau0 = itau_dyn
    8480     
     81! -------------------------------------------------------------
     82! Creation des 3 fichiers pour les grilles horizontales U,V,Scal
     83! -------------------------------------------------------------
     84!Grille U     
    8585      do jj = 1, jjp1
    8686        do ii = 1, iip1
    … …  
    9090      enddo
    9191       
    92       call histbeg(infile, iip1, rlong(:,1), jjp1, rlat(1,:),
     92      call histbeg(dynhistu_file, iip1, rlong(:,1), jjp1, rlat(1,:),
    9393     .             1, iip1, 1, jjp1,
    94      .             tau0, zjulian, tstep, uhoriid, fileid)
    95 C
    96 C  Creation du fichier histoire pour la grille en V (oblige pour l'instant,
    97 C  IOIPSL ne permet pas de grilles avec des nombres de point differents dans
    98 C  un meme fichier)
     94     .             tau0, zjulian, tstep, uhoriid, histuid)
    9995
     96! Grille V
    10097      do jj = 1, jjm
    10198        do ii = 1, iip1
    … …  
    105102      enddo
    106103
    107       call histbeg('dyn_histv.nc', iip1, rlong(:,1), jjm, rlat(1,:),
     104      call histbeg(dynhistv_file, iip1, rlong(:,1), jjm, rlat(1,:),
    108105     .             1, iip1, 1, jjm,
    109      .             tau0, zjulian, tstep, vhoriid, filevid)
    110 C
    111 C  Appel a histhori pour rajouter les autres grilles horizontales
    112 C
     106     .             tau0, zjulian, tstep, vhoriid, histvid)
     107
     108!Grille Scalaire
    113109      do jj = 1, jjp1
    114110        do ii = 1, iip1
    … …  
    118114      enddo
    119115
    120       call histhori(fileid, iip1, rlong, jjp1, rlat, 'scalar',
    121      .              'Grille points scalaires', thoriid)
     116      call histbeg(dynhist_file, iip1, rlong(:,1), jjp1, rlat(1,:),
     117     .             1, iip1, 1, jjp1,
     118     .             tau0, zjulian, tstep, thoriid, histid)
     119! -------------------------------------------------------------
     120C  Appel a histvert pour la grille verticale
     121! -------------------------------------------------------------
     122      call histvert(histid, 'presnivs', 'Niveaux pression','mb',
     123     .              llm, presnivs/100., zvertiid,'down')
     124      call histvert(histvid, 'presnivs', 'Niveaux pression','mb',
     125     .              llm, presnivs/100., zvertiid,'down')
     126      call histvert(histuid, 'presnivs', 'Niveaux pression','mb',
     127     .              llm, presnivs/100., zvertiid,'down')
    122128C
    123 C  Appel a histvert pour la grille verticale
    124 C
    125       call histvert(fileid, 'sig_s', 'Niveaux sigma','-',
    126      .              llm, nivsigs, zvertiid)
    127 C Pour le fichier V
    128       call histvert(filevid, 'sig_s', 'Niveaux sigma','-',
    129      .              llm, nivsigs, zvertiid)
    130 C
     129! -------------------------------------------------------------
    131130C  Appels a histdef pour la definition des variables a sauvegarder
     131! -------------------------------------------------------------
    132132C
    133133C  Vents U
    134134C
    135       call histdef(fileid, 'ucov', 'vents u covariants', 'm/s',
     135      call histdef(histuid, 'u', 'vent u', 'm/s',
    136136     .             iip1, jjp1, uhoriid, llm, 1, llm, zvertiid,
    137137     .             32, 'inst(X)', t_ops, t_wrt)
    … …  
    139139C  Vents V
    140140C
    141       call histdef(filevid, 'vcov', 'vents v covariants', 'm/s',
     141      call histdef(histvid, 'v', 'vent v', 'm/s',
    142142     .             iip1, jjm, vhoriid, llm, 1, llm, zvertiid,
    143143     .             32, 'inst(X)', t_ops, t_wrt)
    … …  
    146146C  Temperature potentielle
    147147C
    148       call histdef(fileid, 'teta', 'temperature potentielle', '-',
     148      call histdef(histid, 'teta', 'temperature potentielle', '-',
    149149     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
    150150     .             32, 'inst(X)', t_ops, t_wrt)
    … …  
    152152C  Geopotentiel
    153153C
    154       call histdef(fileid, 'phi', 'geopotentiel instantane', '-',
     154      call histdef(histid, 'phi', 'geopotentiel', '-',
    155155     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
    156156     .             32, 'inst(X)', t_ops, t_wrt)
    … …  
    158158C  Traceurs
    159159C
    160         DO iq=1,nqtot
    161           call histdef(fileid, ttext(iq),  ttext(iq), '-',
    162      .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
    163      .             32, 'inst(X)', t_ops, t_wrt)
    164         enddo
    165 C
     160!
     161!        DO iq=1,nqtot
     162!          call histdef(histid, ttext(iq),  ttext(iq), '-',
     163!     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
     164!     .             32, 'inst(X)', t_ops, t_wrt)
     165!        enddo
     166!C
    166167C  Masse
    167168C
    168       call histdef(fileid, 'masse', 'masse', 'kg',
    169      .             iip1, jjp1, thoriid, 1, 1, 1, -99,
     169      call histdef(histid, 'masse', 'masse', 'kg',
     170     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
    170171     .             32, 'inst(X)', t_ops, t_wrt)
    171172C
    172173C  Pression au sol
    173174C
    174       call histdef(fileid, 'ps', 'pression naturelle au sol', 'Pa',
     175      call histdef(histid, 'ps', 'pression naturelle au sol', 'Pa',
    175176     .             iip1, jjp1, thoriid, 1, 1, 1, -99,
    176177     .             32, 'inst(X)', t_ops, t_wrt)
    177178C
    178 C  Pression au sol
    179 C
    180       call histdef(fileid, 'phis', 'geopotentiel au sol', '-',
    181      .             iip1, jjp1, thoriid, 1, 1, 1, -99,
    182      .             32, 'inst(X)', t_ops, t_wrt)
    183 C
     179C  Geopotentiel au sol
     180!C
     181!      call histdef(histid, 'phis', 'geopotentiel au sol', '-',
     182!     .             iip1, jjp1, thoriid, 1, 1, 1, -99,
     183!     .             32, 'inst(X)', t_ops, t_wrt)
     184!C
    184185C  Fin
    185186C
    186       call histend(fileid)
    187       call histend(filevid)
     187      call histend(histid)
     188      call histend(histuid)
     189      call histend(histvid)
    188190#else
    189191! tell the user this routine should be run with ioipsl

  • LMDZ4/branches/LMDZ4V5.0-dev/libf/bibio/writedynav.F

    r1279 r1357  
    22! $Id$
    33!
    4       subroutine writedynav( histid, time, vcov,
    5      ,                          ucov,teta,ppk,phi,q,masse,ps,phis)
     4      subroutine writedynav(time, vcov,
     5     ,                ucov,teta,ppk,phi,q,masse,ps,phis)
    66
    77#ifdef CPP_IOIPSL
    … …  
    99#endif
    1010      USE infotrac, ONLY : nqtot, ttext
     11      use com_io_dyn_mod, only : histaveid,histvaveid,histuaveid
    1112      implicit none
    1213
    … …  
    1718C
    1819C   Entree:
    19 C      histid: ID du fichier histoire
    2020C      time: temps de l'ecriture
    2121C      vcov: vents v covariants
    … …  
    2929C     
    3030C
    31 C   Sortie:
    32 C      fileid: ID du fichier netcdf cree
    3331C
    3432C   L. Fairhead, LMD, 03/99
    … …  
    5351C
    5452
    55       INTEGER histid
    5653      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm)
    57       REAL teta(ip1jmp1*llm),phi(ip1jmp1,llm),ppk(ip1jmp1*llm)                  
     54      REAL teta(ip1jmp1*llm),phi(ip1jmp1,llm),ppk(ip1jmp1*llm)     
    5855      REAL ps(ip1jmp1),masse(ip1jmp1,llm)                   
    5956      REAL phis(ip1jmp1)                 
    … …  
    6663C   Variables locales
    6764C
    68       integer ndex2d(iip1*jjp1),ndex3d(iip1*jjp1*llm),iq, ii, ll
    69       real us(ip1jmp1*llm), vs(ip1jmp1*llm)
     65      integer ndex2d(ip1jmp1),ndexu(ip1jmp1*llm),ndexv(ip1jm*llm)
     66      INTEGER iq, ii, ll
    7067      real tm(ip1jmp1*llm)
    7168      REAL vnat(ip1jm,llm),unat(ip1jmp1,llm)
    … …  
    7572C  Initialisations
    7673C
    77       ndex3d = 0
     74      ndexu = 0
     75      ndexv = 0
    7876      ndex2d = 0
    7977      ok_sync = .TRUE.
    80       us = 999.999
    81       vs = 999.999
    8278      tm = 999.999
    8379      vnat = 999.999
    … …  
    9187C  Appels a histwrite pour l'ecriture des variables a sauvegarder
    9288C
    93 C  Vents U scalaire
     89C  Vents U
    9490C
    95       call gr_u_scal(llm, unat, us)
    96       call histwrite(histid, 'u', itau_w, us,
    97      .               iip1*jjp1*llm, ndex3d)
     91      call histwrite(histuaveid, 'u', itau_w, unat,
     92     .               iip1*jjp1*llm, ndexu)
    9893C
    99 C  Vents V scalaire
     94C  Vents V
    10095C
    101       call gr_v_scal(llm, vnat, vs)
    102       call histwrite(histid, 'v', itau_w, vs,
    103      .               iip1*jjp1*llm, ndex3d)
     96      call histwrite(histvaveid, 'v', itau_w, vnat,
     97     .               iip1*jjm*llm, ndexv)
    10498C
    10599C  Temperature potentielle moyennee
    106100C
    107       call histwrite(histid, 'theta', itau_w, teta,
    108      .                iip1*jjp1*llm, ndex3d)
     101      call histwrite(histaveid, 'theta', itau_w, teta,
     102     .                iip1*jjp1*llm, ndexu)
    109103C
    110104C  Temperature moyennee
    … …  
    113107        tm(ii) = teta(ii) * ppk(ii)/cpp
    114108      enddo
    115       call histwrite(histid, 'temp', itau_w, tm,
    116      .                iip1*jjp1*llm, ndex3d)
     109      call histwrite(histaveid, 'temp', itau_w, tm,
     110     .                iip1*jjp1*llm, ndexu)
    117111C
    118112C  Geopotentiel
    119113C
    120       call histwrite(histid, 'phi', itau_w, phi,
    121      .                iip1*jjp1*llm, ndex3d)
     114      call histwrite(histaveid, 'phi', itau_w, phi,
     115     .                iip1*jjp1*llm, ndexu)
    122116C
    123117C  Traceurs
    124118C
    125         DO iq=1,nqtot
    126           call histwrite(histid, ttext(iq), itau_w, q(:,:,iq),
    127      .                   iip1*jjp1*llm, ndex3d)
    128         enddo
     119!        DO iq=1,nqtot
     120!          call histwrite(histaveid, ttext(iq), itau_w, q(:,:,iq),
     121!     .                   iip1*jjp1*llm, ndexu)
     122!        enddo
    129123C
    130124C  Masse
    131125C
    132        call histwrite(histid, 'masse', itau_w, masse, iip1*jjp1, ndex2d)
     126       call histwrite(histaveid, 'masse', itau_w, masse,
     127     $                   iip1*jjp1*llm, ndexu)
    133128C
    134129C  Pression au sol
    135130C
    136        call histwrite(histid, 'ps', itau_w, ps, iip1*jjp1, ndex2d)
     131       call histwrite(histaveid, 'ps', itau_w, ps, iip1*jjp1, ndex2d)
    137132C
    138133C  Geopotentiel au sol
    139134C
    140        call histwrite(histid, 'phis', itau_w, phis, iip1*jjp1, ndex2d)
     135!       call histwrite(histaveid,'phis',itau_w, phis,iip1*jjp1, ndex2d)
    141136C
    142137C  Fin
    143138C
    144       if (ok_sync) call histsync(histid)
     139      if (ok_sync) then
     140          call histsync(histaveid)
     141          call histsync(histvaveid)
     142          call histsync(histuaveid)
     143      ENDIF
    145144
    146145#else

  • LMDZ4/branches/LMDZ4V5.0-dev/libf/bibio/writehist.F

    r1279 r1357  
    22! $Id$
    33!
    4       subroutine writehist( histid, histvid, time, vcov,
    5      ,                          ucov,teta,phi,q,masse,ps,phis)
     4      subroutine writehist(time,vcov,ucov,teta,phi,q,masse,ps,phis)
    65
    76#ifdef CPP_IOIPSL
    … …  
    98#endif
    109      USE infotrac, ONLY : nqtot, ttext
     10      use com_io_dyn_mod, only : histid,histvid,histuid
    1111      implicit none
    1212
    … …  
    1717C
    1818C   Entree:
    19 C      histid: ID du fichier histoire
    20 C      histvid:ID du fichier histoire pour les vents V (appele a disparaitre)
    2119C      time: temps de l'ecriture
    2220C      vcov: vents v covariants
    … …  
    2927C      phis : geopotentiel au sol
    3028C     
    31 C
    32 C   Sortie:
    33 C      fileid: ID du fichier netcdf cree
    3429C
    3530C   L. Fairhead, LMD, 03/99
    … …  
    5449C
    5550
    56       INTEGER histid, histvid
    5751      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm)
    5852      REAL teta(ip1jmp1,llm),phi(ip1jmp1,llm)                   
    … …  
    7165      logical ok_sync
    7266      integer itau_w
     67      REAL vnat(ip1jm,llm),unat(ip1jmp1,llm)
     68
    7369C
    7470C  Initialisations
    … …  
    7975      ok_sync =.TRUE.
    8076      itau_w = itau_dyn + time
     77!  Passage aux composantes naturelles du vent
     78      call covnat(llm, ucov, vcov, unat, vnat)
    8179C
    8280C  Appels a histwrite pour l'ecriture des variables a sauvegarder
    … …  
    8482C  Vents U
    8583C
    86       call histwrite(histid, 'ucov', itau_w, ucov,
     84      call histwrite(histuid, 'u', itau_w, unat,
    8785     .               iip1*jjp1*llm, ndexu)
    88 
    8986C
    9087C  Vents V
    9188C
    92       call histwrite(histvid, 'vcov', itau_w, vcov,
     89      call histwrite(histvid, 'v', itau_w, vnat,
    9390     .               iip1*jjm*llm, ndexv)
    9491
    … …  
    106103C  Traceurs
    107104C
    108         DO iq=1,nqtot
    109           call histwrite(histid, ttext(iq), itau_w, q(:,:,iq),
    110      .                   iip1*jjp1*llm, ndexu)
    111         enddo
    112 C
     105!        DO iq=1,nqtot
     106!          call histwrite(histid, ttext(iq), itau_w, q(:,:,iq),
     107!     .                   iip1*jjp1*llm, ndexu)
     108!        enddo
     109!C
    113110C  Masse
    114111C
    115       call histwrite(histid, 'masse', itau_w, masse, iip1*jjp1, ndex2d)
     112      call histwrite(histid,'masse',itau_w, masse,iip1*jjp1*llm,ndexu)
    116113C
    117114C  Pression au sol
    … …  
    121118C  Geopotentiel au sol
    122119C
    123       call histwrite(histid, 'phis', itau_w, phis, iip1*jjp1, ndex2d)
     120!      call histwrite(histid, 'phis', itau_w, phis, iip1*jjp1, ndex2d)
    124121C
    125122C  Fin
    … …  
    128125        call histsync(histid)
    129126        call histsync(histvid)
     127        call histsync(histuid)
    130128      endif
    131129#else

  • LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3d/control_mod.F90

    r1320 r1357  
    11!
    2 ! $Id$
     2! $Id $
    33!
    44
    … …  
    1414  INTEGER :: iconser,iecri,idissip,iphysiq,iecrimoy
    1515  INTEGER :: dayref,anneeref, raz_date, ip_ebil_dyn
    16   LOGICAL :: offline, output_grads_dyn, ok_dynzon
     16  LOGICAL :: offline
    1717  CHARACTER (len=4)  :: config_inca
    18   CHARACTER (len=10) :: planet_type
     18  CHARACTER (len=10) :: planet_type ! planet type ('earth','mars',...)
     19  LOGICAL output_grads_dyn ! output dynamics diagnostics in
     20                           ! binary grads file 'dyn.dat' (y/n)
     21  LOGICAL ok_dynzon  ! output zonal transports in dynzon.nc file
     22  LOGICAL ok_dyn_ins ! output instantaneous values of fields
     23                     ! in the dynamics in NetCDF files dyn_hist*nc
     24  LOGICAL ok_dyn_ave ! output averaged values of fields in the dynamics
     25                     ! in NetCDF files dyn_hist*ave.nc
    1926
    2027END MODULE

  • LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3d/gcm.F

    r1333 r1357  
    7373#include "description.h"
    7474#include "serre.h"
    75 #include "com_io_dyn.h"
     75!#include "com_io_dyn.h"
    7676#include "iniprint.h"
    7777#include "tracstoke.h"
     78#ifdef INCA
     79! Only INCA needs these informations (from the Earth's physics)
    7880#include "indicesol.h"
    79 
     81#endif
    8082      INTEGER         longcles
    8183      PARAMETER     ( longcles = 20 )
    … …  
    319321     .  ' restart ne correspondent pas a celles lues dans '
    320322        write(lunout,*)' gcm.def'
    321         write(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref
    322         write(lunout,*)' day_ref=',day_ref," dayref=",dayref
    323         write(lunout,*)' Pas de remise a zero'
     323        write(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref
     324        write(lunout,*)' day_ref=',day_ref," dayref=",dayref
     325        write(lunout,*)' Pas de remise a zero'
    324326      ENDIF
    325327
    326 c$$$      if (annee_ref .ne. anneeref .or. day_ref .ne. dayref) then
    327 c$$$        write(lunout,*)
    328 c$$$     .  'GCM: Attention les dates initiales lues dans le fichier'
    329 c$$$        write(lunout,*)
    330 c$$$     .  ' restart ne correspondent pas a celles lues dans '
    331 c$$$        write(lunout,*)' gcm.def'
    332 c$$$    write(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref
    333 c$$$    write(lunout,*)' day_ref=',day_ref," dayref=",dayref
    334 c$$$        if (raz_date .ne. 1) then
    335 c$$$          write(lunout,*)
    336 c$$$     .    'GCM: On garde les dates du fichier restart'
    337 c$$$        else
    338 c$$$          annee_ref = anneeref
    339 c$$$          day_ref = dayref
    340 c$$$          day_ini = dayref
    341 c$$$          itau_dyn = 0
    342 c$$$          itau_phy = 0
    343 c$$$          time_0 = 0.
    344 c$$$          write(lunout,*)
    345 c$$$     .   'GCM: On reinitialise a la date lue dans gcm.def'
    346 c$$$        endif
    347 c$$$      ELSE
    348 c$$$        raz_date = 0
    349 c$$$      endif
     328c      if (annee_ref .ne. anneeref .or. day_ref .ne. dayref) then
     329c        write(lunout,*)
     330c     .  'GCM: Attention les dates initiales lues dans le fichier'
     331c        write(lunout,*)
     332c     .  ' restart ne correspondent pas a celles lues dans '
     333c        write(lunout,*)' gcm.def'
     334c        write(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref
     335c        write(lunout,*)' day_ref=',day_ref," dayref=",dayref
     336c        if (raz_date .ne. 1) then
     337c          write(lunout,*)
     338c     .    'GCM: On garde les dates du fichier restart'
     339c        else
     340c          annee_ref = anneeref
     341c          day_ref = dayref
     342c          day_ini = dayref
     343c          itau_dyn = 0
     344c          itau_phy = 0
     345c          time_0 = 0.
     346c          write(lunout,*)
     347c     .   'GCM: On reinitialise a la date lue dans gcm.def'
     348c        endif
     349c      ELSE
     350c        raz_date = 0
     351c      endif
    350352
    351353#ifdef CPP_IOIPSL
    … …  
    461463
    462464#ifdef CPP_IOIPSL
    463       if ( 1.eq.1) then
    464465      time_step = zdtvr
    465       t_ops = iecri * daysec
    466       t_wrt = iecri * daysec
    467 !      CALL inithist(dynhist_file,day_ref,annee_ref,time_step,
    468 !    .              t_ops, t_wrt, histid, histvid)
    469 
    470 !     IF (ok_dynzon) THEN
    471 !        t_ops = iperiod * time_step
    472 !        t_wrt = periodav * daysec
    473 !        CALL initdynav(dynhistave_file,day_ref,annee_ref,time_step,
    474 !    .        t_ops, t_wrt, histaveid)
    475 !     END IF
     466      if (ok_dyn_ins) then
     467        ! initialize output file for instantaneous outputs
     468        ! t_ops = iecri * daysec ! do operations every t_ops
     469        t_ops =((1.0*iecri)/day_step) * daysec 
     470        t_wrt = daysec ! iecri * daysec ! write output every t_wrt
     471        CALL inithist(day_ref,annee_ref,time_step,
     472     &              t_ops,t_wrt)
     473      endif
     474
     475      IF (ok_dyn_ave) THEN
     476        ! initialize output file for averaged outputs
     477        t_ops = iperiod * time_step ! do operations every t_ops
     478        t_wrt = periodav * daysec   ! write output every t_wrt
     479        CALL initdynav(day_ref,annee_ref,time_step,
     480     &       t_ops,t_wrt)
     481      END IF
    476482      dtav = iperiod*dtvr/daysec
    477       endif
    478 
    479 
    480483#endif
    481484! #endif of #ifdef CPP_IOIPSL

  • LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3d/leapfrog.F

    r1299 r1357  
    6060#include "description.h"
    6161#include "serre.h"
    62 #include "com_io_dyn.h"
     62!#include "com_io_dyn.h"
    6363#include "iniprint.h"
    6464#include "academic.h"
    … …  
    197197
    198198      itau = 0
    199 c$$$      iday = day_ini+itau/day_step
    200 c$$$      time = REAL(itau-(iday-day_ini)*day_step)/day_step+time_0
    201 c$$$         IF(time.GT.1.) THEN
    202 c$$$          time = time-1.
    203 c$$$          iday = iday+1
    204 c$$$         ENDIF
     199c      iday = day_ini+itau/day_step
     200c      time = REAL(itau-(iday-day_ini)*day_step)/day_step+time_0
     201c         IF(time.GT.1.) THEN
     202c          time = time-1.
     203c          iday = iday+1
     204c         ENDIF
    205205
    206206
    … …  
    276276
    277277      IF( purmats ) THEN
     278      ! Purely Matsuno time stepping
    278279         IF( MOD(itau,iconser) .EQ.0.AND.  forward    ) conser = .TRUE.
    279280         IF( MOD(itau,idissip ).EQ.0.AND..NOT.forward ) apdiss = .TRUE.
    … …  
    281282     s          .and. iflag_phys.EQ.1                 ) apphys = .TRUE.
    282283      ELSE
     284      ! Leapfrog/Matsuno time stepping
    283285         IF( MOD(itau   ,iconser) .EQ. 0              ) conser = .TRUE.
    284286         IF( MOD(itau+1,idissip)  .EQ. 0              ) apdiss = .TRUE.
    285287         IF( MOD(itau+1,iphysiq).EQ.0.AND.iflag_phys.EQ.1) apphys=.TRUE.
    286288      END IF
     289
     290! Ehouarn: for Shallow Water case (ie: 1 vertical layer),
     291!          supress dissipation step
     292      if (llm.eq.1) then
     293        apdiss=.false.
     294      endif
    287295
    288296c-----------------------------------------------------------------------
    … …  
    522530            IF(forward. OR. leapf) THEN
    523531              itau= itau + 1
    524 c$$$              iday= day_ini+itau/day_step
    525 c$$$              time= REAL(itau-(iday-day_ini)*day_step)/day_step+time_0
    526 c$$$                IF(time.GT.1.) THEN
    527 c$$$                  time = time-1.
    528 c$$$                  iday = iday+1
    529 c$$$                ENDIF
     532c              iday= day_ini+itau/day_step
     533c              time= REAL(itau-(iday-day_ini)*day_step)/day_step+time_0
     534c                IF(time.GT.1.) THEN
     535c                  time = time-1.
     536c                  iday = iday+1
     537c                ENDIF
    530538            ENDIF
    531539
    … …  
    559567               IF (ok_dynzon) THEN
    560568#ifdef CPP_IOIPSL
    561 !                  CALL writedynav(histaveid, itau,vcov ,
    562 !     ,                 ucov,teta,pk,phi,q,masse,ps,phis)
    563                   CALL bilan_dyn (2,dtvr*iperiod,dtvr*day_step*periodav,
    564      ,                 ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q)
     569                 CALL bilan_dyn(2,dtvr*iperiod,dtvr*day_step*periodav,
     570     &                 ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q)
    565571#endif
    566572               END IF
    567 
    568             ENDIF
     573               IF (ok_dyn_ave) THEN
     574#ifdef CPP_IOIPSL
     575                 CALL writedynav(itau,vcov,
     576     &                 ucov,teta,pk,phi,q,masse,ps,phis)
     577#endif
     578               ENDIF
     579
     580            ENDIF ! of IF((MOD(itau,iperiod).EQ.0).OR.(itau.EQ.itaufin))
    569581
    570582c-----------------------------------------------------------------------
    … …  
    572584c   ------------------------------
    573585
    574             IF( MOD(itau,iecri         ).EQ.0) THEN
    575 c           IF( MOD(itau,iecri*day_step).EQ.0) THEN
    576 
     586            IF( MOD(itau,iecri).EQ.0) THEN
     587             ! Ehouarn: output only during LF or Backward Matsuno
     588             if (leapf.or.(.not.leapf.and.(.not.forward))) then
    577589              nbetat = nbetatdem
    578590              CALL geopot(ip1jmp1,teta,pk,pks,phis,phi)
    … …  
    583595              enddo
    584596#ifdef CPP_IOIPSL
    585 c             CALL writehist(histid,histvid,itau,vcov,
    586 c     &                      ucov,teta,phi,q,masse,ps,phis)
     597              if (ok_dyn_ins) then
     598!               write(lunout,*) "leapfrog: call writehist, itau=",itau
     599               CALL writehist(itau,vcov,ucov,teta,phi,q,masse,ps,phis)
     600!               call WriteField('ucov',reshape(ucov,(/iip1,jmp1,llm/)))
     601!               call WriteField('vcov',reshape(vcov,(/iip1,jjm,llm/)))
     602!              call WriteField('teta',reshape(teta,(/iip1,jmp1,llm/)))
     603!               call WriteField('ps',reshape(ps,(/iip1,jmp1/)))
     604!               call WriteField('masse',reshape(masse,(/iip1,jmp1,llm/)))
     605              endif ! of if (ok_dyn_ins)
    587606#endif
    588607! For some Grads outputs of fields
    589              if (output_grads_dyn) then
     608              if (output_grads_dyn) then
    590609#include "write_grads_dyn.h"
    591              endif
    592 
     610              endif
     611             endif ! of if (leapf.or.(.not.leapf.and.(.not.forward)))
    593612            ENDIF ! of IF(MOD(itau,iecri).EQ.0)
    594613
    … …  
    645664
    646665             itau =  itau + 1
    647 c$$$             iday = day_ini+itau/day_step
    648 c$$$             time = REAL(itau-(iday-day_ini)*day_step)/day_step+time_0
    649 c$$$
    650 c$$$                  IF(time.GT.1.) THEN
    651 c$$$                   time = time-1.
    652 c$$$                   iday = iday+1
    653 c$$$                  ENDIF
     666c             iday = day_ini+itau/day_step
     667c             time = REAL(itau-(iday-day_ini)*day_step)/day_step+time_0
     668c
     669c                  IF(time.GT.1.) THEN
     670c                   time = time-1.
     671c                   iday = iday+1
     672c                  ENDIF
    654673
    655674               forward =  .FALSE.
    … …  
    660679               GO TO 2
    661680
    662             ELSE ! of IF(forward)
     681            ELSE ! of IF(forward) i.e. backward step
    663682
    664683              IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin) THEN
    … …  
    671690               IF (ok_dynzon) THEN
    672691#ifdef CPP_IOIPSL
    673 !                  CALL writedynav(histaveid, itau,vcov ,
    674 !     ,                 ucov,teta,pk,phi,q,masse,ps,phis)
    675                   CALL bilan_dyn (2,dtvr*iperiod,dtvr*day_step*periodav,
    676      ,                 ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q)
    677 #endif
    678                END IF
     692                 CALL bilan_dyn(2,dtvr*iperiod,dtvr*day_step*periodav,
     693     &                 ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q)
     694#endif
     695               ENDIF
     696               IF (ok_dyn_ave) THEN
     697#ifdef CPP_IOIPSL
     698                 CALL writedynav(itau,vcov,
     699     &                 ucov,teta,pk,phi,q,masse,ps,phis)
     700#endif
     701               ENDIF
    679702
    680703              ENDIF ! of IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin)
    … …  
    690713                enddo
    691714#ifdef CPP_IOIPSL
    692 c               CALL writehist( histid, histvid, itau,vcov ,
    693 c    &                           ucov,teta,phi,q,masse,ps,phis)
     715              if (ok_dyn_ins) then
     716!                write(lunout,*) "leapfrog: call writehist (b)",
     717!     &                        itau,iecri
     718                CALL writehist(itau,vcov,ucov,teta,phi,q,masse,ps,phis)
     719              endif ! of if (ok_dyn_ins)
    694720#endif
    695721! For some Grads outputs

  • LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3dpar/conf_gcm.F

    r1325 r1357  
    601601      CALL getin('ok_dynzon',ok_dynzon)
    602602
     603!Config  Key  = ok_dyn_ins
     604!Config  Desc = sorties instantanees dans la dynamique
     605!Config  Def  = n
     606!Config  Help =
     607!Config         
     608      ok_dyn_ins = .FALSE.
     609      CALL getin('ok_dyn_ins',ok_dyn_ins)
     610
     611!Config  Key  = ok_dyn_ave
     612!Config  Desc = sorties moyennes dans la dynamique
     613!Config  Def  = n
     614!Config  Help =
     615!Config         
     616      ok_dyn_ave = .FALSE.
     617      CALL getin('ok_dyn_ave',ok_dyn_ave)
    603618
    604619      write(lunout,*)' #########################################'
    … …  
    641656      write(lunout,*)' config_inca = ', config_inca
    642657      write(lunout,*)' ok_dynzon = ', ok_dynzon
     658      write(lunout,*)' ok_dyn_ins = ', ok_dyn_ins
     659      write(lunout,*)' ok_dyn_ave = ', ok_dyn_ave
    643660
    644661      RETURN
    … …  
    773790      ok_dynzon = .FALSE.
    774791      CALL getin('ok_dynzon',ok_dynzon)
     792
     793!Config  Key  = ok_dyn_ins
     794!Config  Desc = sorties instantanees dans la dynamique
     795!Config  Def  = n
     796!Config  Help =
     797!Config         
     798      ok_dyn_ins = .FALSE.
     799      CALL getin('ok_dyn_ins',ok_dyn_ins)
     800
     801!Config  Key  = ok_dyn_ave
     802!Config  Desc = sorties moyennes dans la dynamique
     803!Config  Def  = n
     804!Config  Help =
     805!Config         
     806      ok_dyn_ave = .FALSE.
     807      CALL getin('ok_dyn_ave',ok_dyn_ave)
    775808
    776809!Config  Key  = use_filtre_fft
    … …  
    866899      write(lunout,*)' config_inca = ', config_inca
    867900      write(lunout,*)' ok_dynzon = ', ok_dynzon
     901      write(lunout,*)' ok_dyn_ins = ', ok_dyn_ins
     902      write(lunout,*)' ok_dyn_ave = ', ok_dyn_ave
    868903      write(lunout,*)' use_filtre_fft = ', use_filtre_fft
    869904      write(lunout,*)' use_mpi_alloc = ', use_mpi_alloc

  • LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3dpar/control_mod.F90

    r1325 r1357  
    11!
    2 ! $Id$
     2! $Id $
    33!
    44
    … …  
    1414  INTEGER :: iconser,iecri,idissip,iphysiq,iecrimoy
    1515  INTEGER :: dayref,anneeref, raz_date, ip_ebil_dyn
    16   LOGICAL :: offline, output_grads_dyn, ok_dynzon
     16  LOGICAL :: offline
    1717  CHARACTER (len=4)  :: config_inca
    18   CHARACTER (len=10) :: planet_type
     18  CHARACTER (len=10) :: planet_type ! planet type ('earth','mars',...)
     19  LOGICAL output_grads_dyn ! output dynamics diagnostics in
     20                           ! binary grads file 'dyn.dat' (y/n)
     21  LOGICAL ok_dynzon  ! output zonal transports in dynzon.nc file
     22  LOGICAL ok_dyn_ins ! output instantaneous values of fields
     23                     ! in the dynamics in NetCDF files dyn_hist*nc
     24  LOGICAL ok_dyn_ave ! output averaged values of fields in the dynamics
     25                     ! in NetCDF files dyn_hist*ave.nc
    1926
    2027END MODULE

  • LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3dpar/gcm.F

    r1333 r1357  
    7070#include "description.h"
    7171#include "serre.h"
    72 #include "com_io_dyn.h"
     72!#include "com_io_dyn.h"
    7373#include "iniprint.h"
    7474#include "tracstoke.h"
     75#ifdef INCA
     76! Only INCA needs these informations (from the Earth's physics)
    7577#include "indicesol.h"
     78#endif
    7679
    7780      INTEGER         longcles
    … …  
    335338     .  ' restart ne correspondent pas a celles lues dans '
    336339        write(lunout,*)' gcm.def'
    337         write(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref
    338         write(lunout,*)' day_ref=',day_ref," dayref=",dayref
    339         write(lunout,*)' Pas de remise a zero'
     340        write(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref
     341        write(lunout,*)' day_ref=',day_ref," dayref=",dayref
     342        write(lunout,*)' Pas de remise a zero'
    340343      ENDIF
    341 c$$$      if (annee_ref .ne. anneeref .or. day_ref .ne. dayref) then
    342 c$$$        write(lunout,*)
    343 c$$$     .  'GCM: Attention les dates initiales lues dans le fichier'
    344 c$$$        write(lunout,*)
    345 c$$$     .  ' restart ne correspondent pas a celles lues dans '
    346 c$$$        write(lunout,*)' gcm.def'
    347 c$$$    write(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref
    348 c$$$    write(lunout,*)' day_ref=',day_ref," dayref=",dayref
    349 c$$$        if (raz_date .ne. 1) then
    350 c$$$          write(lunout,*)
    351 c$$$     .    'GCM: On garde les dates du fichier restart'
    352 c$$$        else
    353 c$$$          annee_ref = anneeref
    354 c$$$          day_ref = dayref
    355 c$$$          day_ini = dayref
    356 c$$$          itau_dyn = 0
    357 c$$$          itau_phy = 0
    358 c$$$          time_0 = 0.
    359 c$$$          write(lunout,*)
    360 c$$$     .   'GCM: On reinitialise a la date lue dans gcm.def'
    361 c$$$        endif
    362 c$$$      ELSE
    363 c$$$        raz_date = 0
    364 c$$$      endif
     344c      if (annee_ref .ne. anneeref .or. day_ref .ne. dayref) then
     345c        write(lunout,*)
     346c     .  'GCM: Attention les dates initiales lues dans le fichier'
     347c        write(lunout,*)
     348c     .  ' restart ne correspondent pas a celles lues dans '
     349c        write(lunout,*)' gcm.def'
     350c        write(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref
     351c        write(lunout,*)' day_ref=',day_ref," dayref=",dayref
     352c        if (raz_date .ne. 1) then
     353c          write(lunout,*)
     354c     .    'GCM: On garde les dates du fichier restart'
     355c        else
     356c          annee_ref = anneeref
     357c          day_ref = dayref
     358c          day_ini = dayref
     359c          itau_dyn = 0
     360c          itau_phy = 0
     361c          time_0 = 0.
     362c          write(lunout,*)
     363c     .   'GCM: On reinitialise a la date lue dans gcm.def'
     364c        endif
     365c      ELSE
     366c        raz_date = 0
     367c      endif
    365368
    366369#ifdef CPP_IOIPSL
    … …  
    486489
    487490#ifdef CPP_IOIPSL
    488       if ( 1.eq.1) then
    489491      time_step = zdtvr
    490       t_ops = iecri * daysec
    491       t_wrt = iecri * daysec
     492      if (ok_dyn_ins) then
     493        ! initialize output file for instantaneous outputs
     494        ! t_ops = iecri * daysec ! do operations every t_ops
     495        t_ops =((1.0*iecri)/day_step) * daysec 
     496        t_wrt = daysec ! iecri * daysec ! write output every t_wrt
     497        t_wrt = daysec ! iecri * daysec ! write output every t_wrt
     498        CALL inithist(day_ref,annee_ref,time_step,
     499     &              t_ops,t_wrt)
    492500!      CALL inithist_p(dynhist_file,day_ref,annee_ref,time_step,
    493501!     .              t_ops, t_wrt, histid, histvid)
    494 
    495       IF (ok_dynzon) THEN
    496          t_ops = iperiod * time_step
    497          t_wrt = periodav * daysec
     502      endif
     503
     504      IF (ok_dyn_ave) THEN
     505        ! initialize output file for averaged outputs
     506        t_ops = iperiod * time_step ! do operations every t_ops
     507        t_wrt = periodav * daysec   ! write output every t_wrt
     508        CALL initdynav(day_ref,annee_ref,time_step,
     509     &       t_ops,t_wrt)
    498510!         CALL initdynav_p(dynhistave_file,day_ref,annee_ref,time_step,
    499511!     .        t_ops, t_wrt, histaveid)
    500512      END IF
    501513      dtav = iperiod*dtvr/daysec
    502       endif
    503 
    504 
    505514#endif
    506515! #endif of #ifdef CPP_IOIPSL

  • LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3dpar/leapfrog_p.F

    r1322 r1357  
    6666#include "description.h"
    6767#include "serre.h"
    68 #include "com_io_dyn.h"
     68!#include "com_io_dyn.h"
    6969#include "iniprint.h"
    7070#include "academic.h"
    … …  
    352352c      idissip=1
    353353      IF( purmats ) THEN
     354      ! Purely Matsuno time stepping
    354355         IF( MOD(itau,iconser) .EQ.0.AND.  forward    ) conser = .TRUE.
    355356         IF( MOD(itau,idissip ).EQ.0.AND..NOT.forward ) apdiss = .TRUE.
    … …  
    357358     s          .and. iflag_phys.EQ.1                 ) apphys = .TRUE.
    358359      ELSE
     360      ! Leapfrog/Matsuno time stepping
    359361         IF( MOD(itau   ,iconser) .EQ. 0              ) conser = .TRUE.
    360362         IF( MOD(itau+1,idissip)  .EQ. 0              ) apdiss = .TRUE.
    … …  
    362364      END IF
    363365
     366! Ehouarn: for Shallow Water case (ie: 1 vertical layer),
     367!          supress dissipation step
     368      if (llm.eq.1) then
     369        apdiss=.false.
     370      endif
     371
    364372cym    ---> Pour le moment     
    365373cym      apphys = .FALSE.
    366374      statcl = .FALSE.
    367       conser = .FALSE.
     375      conser = .FALSE. ! ie: no output of control variables to stdout in //
    368376     
    369377      if (firstCaldyn) then
    … …  
    974982c$OMP BARRIER
    975983       call WaitRequest(Request_Physic)     
    976 
     984c$OMP BARRIER
    977985       call friction_p(ucov,vcov,iphysiq*dtvr)
    978986      ENDIF ! of IF(iflag_phys.EQ.2)
    … …  
    10911099            enddo
    10921100c$OMP END DO NOWAIT           
    1093        endif
     1101       endif ! of if (dissip_conservative)
    10941102
    10951103       ijb=ij_begin
    … …  
    12001208c$OMP END MASTER
    12011209c$OMP BARRIER
    1202       END IF
     1210      END IF ! of IF(apdiss)
    12031211
    12041212cc$OMP END PARALLEL
    … …  
    13391347              ENDIF !ok_dynzon
    13401348#endif
    1341             ENDIF
     1349               IF (ok_dyn_ave) THEN
     1350!$OMP MASTER
     1351#ifdef CPP_IOIPSL
     1352! Ehouarn: Gather fields and make master send to output
     1353                call Gather_Field(vcov,ip1jm,llm,0)
     1354                call Gather_Field(ucov,ip1jmp1,llm,0)
     1355                call Gather_Field(teta,ip1jmp1,llm,0)
     1356                call Gather_Field(phi,ip1jmp1,llm,0)
     1357                do iq=1,nqtot
     1358                  call Gather_Field(q(1,1,iq),ip1jmp1,llm,0)
     1359                enddo
     1360                call Gather_Field(masse,ip1jmp1,llm,0)
     1361                call Gather_Field(ps,ip1jmp1,1,0)
     1362                call Gather_Field(phis,ip1jmp1,1,0)
     1363                if (mpi_rank==0) then
     1364                 CALL writedynav(itau,vcov,
     1365     &                 ucov,teta,pk,phi,q,masse,ps,phis)
     1366                endif
     1367#endif
     1368!$OMP END MASTER
     1369               ENDIF ! of IF (ok_dyn_ave)
     1370            ENDIF ! of IF((MOD(itau,iperiod).EQ.0).OR.(itau.EQ.itaufin))
    13421371
    13431372c-----------------------------------------------------------------------
    … …  
    13451374c   ------------------------------
    13461375
    1347 c      IF( MOD(itau,iecri         ).EQ.0) THEN
    1348 
    1349             IF( MOD(itau,iecri*day_step).EQ.0) THEN
     1376            IF( MOD(itau,iecri).EQ.0) THEN
     1377             ! Ehouarn: output only during LF or Backward Matsuno
     1378             if (leapf.or.(.not.leapf.and.(.not.forward))) then
    13501379c$OMP BARRIER
    13511380c$OMP MASTER
    … …  
    13811410       
    13821411#ifdef CPP_IOIPSL
    1383  
     1412              if (ok_dyn_ins) then
     1413! Ehouarn: Gather fields and make master write to output
     1414                call Gather_Field(vcov,ip1jm,llm,0)
     1415                call Gather_Field(ucov,ip1jmp1,llm,0)
     1416                call Gather_Field(teta,ip1jmp1,llm,0)
     1417                call Gather_Field(phi,ip1jmp1,llm,0)
     1418                do iq=1,nqtot
     1419                  call Gather_Field(q(1,1,iq),ip1jmp1,llm,0)
     1420                enddo
     1421                call Gather_Field(masse,ip1jmp1,llm,0)
     1422                call Gather_Field(ps,ip1jmp1,1,0)
     1423                call Gather_Field(phis,ip1jmp1,1,0)
     1424                if (mpi_rank==0) then
     1425                 CALL writehist(itau,vcov,ucov,teta,phi,q,masse,ps,phis)
     1426                endif
    13841427!              CALL writehist_p(histid,histvid, itau,vcov,
    13851428!     &                         ucov,teta,phi,q,masse,ps,phis)
    1386 
     1429! or use writefield_p
     1430!      call WriteField_p('ucov',reshape(ucov,(/iip1,jmp1,llm/)))
     1431!      call WriteField_p('vcov',reshape(vcov,(/iip1,jjm,llm/)))
     1432!      call WriteField_p('teta',reshape(teta,(/iip1,jmp1,llm/)))
     1433!      call WriteField_p('ps',reshape(ps,(/iip1,jmp1/)))
     1434              endif ! of if (ok_dyn_ins)
    13871435#endif
    13881436! For some Grads outputs of fields
    … …  
    14011449              endif ! of if (output_grads_dyn)
    14021450c$OMP END MASTER
     1451             endif ! of if (leapf.or.(.not.leapf.and.(.not.forward)))
    14031452            ENDIF ! of IF(MOD(itau,iecri).EQ.0)
    14041453
    … …  
    14791528               GO TO 2
    14801529
    1481             ELSE ! of IF(forward)
     1530            ELSE ! of IF(forward) i.e. backward step
    14821531
    14831532              IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin) THEN
    … …  
    14901539               IF (ok_dynzon) THEN
    14911540c$OMP BARRIER
    1492 
    14931541               call Register_Hallo(vcov,ip1jm,llm,1,0,0,1,TestRequest)
    14941542               call SendRequest(TestRequest)
    14951543c$OMP BARRIER
    14961544               call WaitRequest(TestRequest)
    1497 
    14981545c$OMP BARRIER
    14991546c$OMP MASTER
    … …  
    15051552               END IF !ok_dynzon
    15061553#endif
     1554               IF (ok_dyn_ave) THEN
     1555!$OMP MASTER
     1556#ifdef CPP_IOIPSL
     1557! Ehouarn: Gather fields and make master send to output
     1558                call Gather_Field(vcov,ip1jm,llm,0)
     1559                call Gather_Field(ucov,ip1jmp1,llm,0)
     1560                call Gather_Field(teta,ip1jmp1,llm,0)
     1561                call Gather_Field(phi,ip1jmp1,llm,0)
     1562                do iq=1,nqtot
     1563                  call Gather_Field(q(1,1,iq),ip1jmp1,llm,0)
     1564                enddo
     1565                call Gather_Field(masse,ip1jmp1,llm,0)
     1566                call Gather_Field(ps,ip1jmp1,1,0)
     1567                call Gather_Field(phis,ip1jmp1,1,0)
     1568                if (mpi_rank==0) then
     1569                 CALL writedynav(itau,vcov,
     1570     &                 ucov,teta,pk,phi,q,masse,ps,phis)
     1571                endif
     1572#endif
     1573!$OMP END MASTER
     1574               ENDIF ! of IF (ok_dyn_ave)
     1575
    15071576              ENDIF ! of IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin)
    15081577
    15091578
    1510 c               IF(MOD(itau,iecri         ).EQ.0) THEN
    1511               IF(MOD(itau,iecri*day_step).EQ.0) THEN
     1579               IF(MOD(itau,iecri         ).EQ.0) THEN
     1580c              IF(MOD(itau,iecri*day_step).EQ.0) THEN
    15121581c$OMP BARRIER
    15131582c$OMP MASTER
    … …  
    15421611
    15431612#ifdef CPP_IOIPSL
    1544 
     1613              if (ok_dyn_ins) then
     1614! Ehouarn: Gather fields and make master send to output
     1615                call Gather_Field(vcov,ip1jm,llm,0)
     1616                call Gather_Field(ucov,ip1jmp1,llm,0)
     1617                call Gather_Field(teta,ip1jmp1,llm,0)
     1618                call Gather_Field(phi,ip1jmp1,llm,0)
     1619                do iq=1,nqtot
     1620                  call Gather_Field(q(1,1,iq),ip1jmp1,llm,0)
     1621                enddo
     1622                call Gather_Field(masse,ip1jmp1,llm,0)
     1623                call Gather_Field(ps,ip1jmp1,1,0)
     1624                call Gather_Field(phis,ip1jmp1,1,0)
     1625                if (mpi_rank==0) then
     1626                 CALL writehist(itau,vcov,ucov,teta,phi,q,masse,ps,phis)
     1627                endif
    15451628!                CALL writehist_p(histid, histvid, itau,vcov ,
    15461629!     &                           ucov,teta,phi,q,masse,ps,phis)
     1630              endif ! of if (ok_dyn_ins)
    15471631#endif
    15481632! For some Grads output (but does it work?)
    … …  
    15621646
    15631647c$OMP END MASTER
    1564               ENDIF ! of IF(MOD(itau,iecri*day_step).EQ.0)
     1648              ENDIF ! of IF(MOD(itau,iecri).EQ.0)
    15651649
    15661650              IF(itau.EQ.itaufin) THEN
Note: See TracChangeset for help on using the changeset viewer.