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

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

Cleanup in the dynamics: turn comvert.h into module comvert_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 2600 2016-07-23 05:45:38Z 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      implicit none
12
13C
14C   Ecriture du fichier histoire au format IOIPSL
15C
16C   Appels succesifs des routines: histwrite
17C
18C   Entree:
19C      time: temps de l'ecriture
20C      vcov: vents v covariants
21C      ucov: vents u covariants
22C      teta: temperature potentielle
23C      phi : geopotentiel instantane
24C      q   : traceurs
25C      masse: masse
26C      ps   :pression au sol
27C      phis : geopotentiel au sol
28C     
29C
30C   L. Fairhead, LMD, 03/99
31C
32C =====================================================================
33C
34C   Declarations
35      include "dimensions.h"
36      include "paramet.h"
37      include "comgeom.h"
38      include "temps.h"
39      include "ener.h"
40      include "logic.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.