source: LMDZ5/trunk/libf/dyn3d_common/writehist.F @ 2614

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

Cleanup in the dynamics: turn logic.h into module logic_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 2603 2016-07-25 09:31:56Z oboucher $
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 "ener.h"
41      include "description.h"
42      include "iniprint.h"
43
44C
45C   Arguments
46C
47
48      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm)
49      REAL teta(ip1jmp1,llm),phi(ip1jmp1,llm)                   
50      REAL ps(ip1jmp1),masse(ip1jmp1,llm)                   
51      REAL phis(ip1jmp1)                 
52      REAL q(ip1jmp1,llm,nqtot)
53      integer time
54
55
56#ifdef CPP_IOIPSL
57! This routine needs IOIPSL to work
58C   Variables locales
59C
60      integer iq, ii, ll
61      integer ndexu(ip1jmp1*llm),ndexv(ip1jm*llm),ndex2d(ip1jmp1)
62      logical ok_sync
63      integer itau_w
64      REAL vnat(ip1jm,llm),unat(ip1jmp1,llm)
65
66C
67C  Initialisations
68C
69      ndexu = 0
70      ndexv = 0
71      ndex2d = 0
72      ok_sync =.TRUE.
73      itau_w = itau_dyn + time
74!  Passage aux composantes naturelles du vent
75      call covnat(llm, ucov, vcov, unat, vnat)
76C
77C  Appels a histwrite pour l'ecriture des variables a sauvegarder
78C
79C  Vents U
80C
81      call histwrite(histuid, 'u', itau_w, unat,
82     .               iip1*jjp1*llm, ndexu)
83C
84C  Vents V
85C
86      call histwrite(histvid, 'v', itau_w, vnat,
87     .               iip1*jjm*llm, ndexv)
88
89C
90C  Temperature potentielle
91C
92      call histwrite(histid, 'teta', itau_w, teta,
93     .                iip1*jjp1*llm, ndexu)
94C
95C  Geopotentiel
96C
97      call histwrite(histid, 'phi', itau_w, phi,
98     .                iip1*jjp1*llm, ndexu)
99C
100C  Traceurs
101C
102!        DO iq=1,nqtot
103!          call histwrite(histid, ttext(iq), itau_w, q(:,:,iq),
104!     .                   iip1*jjp1*llm, ndexu)
105!        enddo
106!C
107C  Masse
108C
109      call histwrite(histid,'masse',itau_w, masse,iip1*jjp1*llm,ndexu)
110C
111C  Pression au sol
112C
113      call histwrite(histid, 'ps', itau_w, ps, iip1*jjp1, ndex2d)
114C
115C  Geopotentiel au sol
116C
117!      call histwrite(histid, 'phis', itau_w, phis, iip1*jjp1, ndex2d)
118C
119C  Fin
120C
121      if (ok_sync) then
122        call histsync(histid)
123        call histsync(histvid)
124        call histsync(histuid)
125      endif
126#else
127! tell the user this routine should be run with ioipsl
128      write(lunout,*)"writehist: Warning this routine should not be",
129     &               " used without ioipsl"
130#endif
131! of #ifdef CPP_IOIPSL
132      return
133      end
Note: See TracBrowser for help on using the repository browser.