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

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

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