source: LMDZ6/trunk/libf/dyn3d_common/writehist.F @ 3085

Last change on this file since 3085 was 2622, checked in by Ehouarn Millour, 8 years ago

Some code tidying: turn ener.h into ener_mod.F90
EM

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.0 KB
Line 
1!
2! $Id: writehist.F 2622 2016-09-04 06:12:02Z jghattas $
3!
4      subroutine writehist(time,vcov,ucov,teta,phi,q,masse,ps,phis)
5
6#ifdef CPP_IOIPSL
7      USE ioipsl
8#endif
9      USE infotrac, ONLY : nqtot, ttext
10      use com_io_dyn_mod, only : histid,histvid,histuid
11      USE temps_mod, ONLY: itau_dyn
12     
13      implicit none
14
15C
16C   Ecriture du fichier histoire au format IOIPSL
17C
18C   Appels succesifs des routines: histwrite
19C
20C   Entree:
21C      time: temps de l'ecriture
22C      vcov: vents v covariants
23C      ucov: vents u covariants
24C      teta: temperature potentielle
25C      phi : geopotentiel instantane
26C      q   : traceurs
27C      masse: masse
28C      ps   :pression au sol
29C      phis : geopotentiel au sol
30C     
31C
32C   L. Fairhead, LMD, 03/99
33C
34C =====================================================================
35C
36C   Declarations
37      include "dimensions.h"
38      include "paramet.h"
39      include "comgeom.h"
40      include "description.h"
41      include "iniprint.h"
42
43C
44C   Arguments
45C
46
47      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm)
48      REAL teta(ip1jmp1,llm),phi(ip1jmp1,llm)                   
49      REAL ps(ip1jmp1),masse(ip1jmp1,llm)                   
50      REAL phis(ip1jmp1)                 
51      REAL q(ip1jmp1,llm,nqtot)
52      integer time
53
54
55#ifdef CPP_IOIPSL
56! This routine needs IOIPSL to work
57C   Variables locales
58C
59      integer iq, ii, ll
60      integer ndexu(ip1jmp1*llm),ndexv(ip1jm*llm),ndex2d(ip1jmp1)
61      logical ok_sync
62      integer itau_w
63      REAL vnat(ip1jm,llm),unat(ip1jmp1,llm)
64
65C
66C  Initialisations
67C
68      ndexu = 0
69      ndexv = 0
70      ndex2d = 0
71      ok_sync =.TRUE.
72      itau_w = itau_dyn + time
73!  Passage aux composantes naturelles du vent
74      call covnat(llm, ucov, vcov, unat, vnat)
75C
76C  Appels a histwrite pour l'ecriture des variables a sauvegarder
77C
78C  Vents U
79C
80      call histwrite(histuid, 'u', itau_w, unat,
81     .               iip1*jjp1*llm, ndexu)
82C
83C  Vents V
84C
85      call histwrite(histvid, 'v', itau_w, vnat,
86     .               iip1*jjm*llm, ndexv)
87
88C
89C  Temperature potentielle
90C
91      call histwrite(histid, 'teta', itau_w, teta,
92     .                iip1*jjp1*llm, ndexu)
93C
94C  Geopotentiel
95C
96      call histwrite(histid, 'phi', itau_w, phi,
97     .                iip1*jjp1*llm, ndexu)
98C
99C  Traceurs
100C
101!        DO iq=1,nqtot
102!          call histwrite(histid, ttext(iq), itau_w, q(:,:,iq),
103!     .                   iip1*jjp1*llm, ndexu)
104!        enddo
105!C
106C  Masse
107C
108      call histwrite(histid,'masse',itau_w, masse,iip1*jjp1*llm,ndexu)
109C
110C  Pression au sol
111C
112      call histwrite(histid, 'ps', itau_w, ps, iip1*jjp1, ndex2d)
113C
114C  Geopotentiel au sol
115C
116!      call histwrite(histid, 'phis', itau_w, phis, iip1*jjp1, ndex2d)
117C
118C  Fin
119C
120      if (ok_sync) then
121        call histsync(histid)
122        call histsync(histvid)
123        call histsync(histuid)
124      endif
125#else
126! tell the user this routine should be run with ioipsl
127      write(lunout,*)"writehist: Warning this routine should not be",
128     &               " used without ioipsl"
129#endif
130! of #ifdef CPP_IOIPSL
131      return
132      end
Note: See TracBrowser for help on using the repository browser.