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

Last change on this file since 2602 was 2601, checked in by Ehouarn Millour, 9 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
RevLine 
[524]1!
[1279]2! $Id: writehist.F 2601 2016-07-24 09:51:55Z emillour $
[524]3!
[1403]4      subroutine writehist(time,vcov,ucov,teta,phi,q,masse,ps,phis)
[524]5
[1279]6#ifdef CPP_IOIPSL
[524]7      USE ioipsl
[1279]8#endif
[1146]9      USE infotrac, ONLY : nqtot, ttext
[1403]10      use com_io_dyn_mod, only : histid,histvid,histuid
[2601]11      USE temps_mod, ONLY: itau_dyn
12     
[524]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
[2597]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"
[524]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)                 
[1146]53      REAL q(ip1jmp1,llm,nqtot)
[524]54      integer time
55
56
[1279]57#ifdef CPP_IOIPSL
58! This routine needs IOIPSL to work
[524]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
[1403]65      REAL vnat(ip1jm,llm),unat(ip1jmp1,llm)
66
[524]67C
68C  Initialisations
69C
70      ndexu = 0
71      ndexv = 0
72      ndex2d = 0
73      ok_sync =.TRUE.
74      itau_w = itau_dyn + time
[1403]75!  Passage aux composantes naturelles du vent
76      call covnat(llm, ucov, vcov, unat, vnat)
[524]77C
78C  Appels a histwrite pour l'ecriture des variables a sauvegarder
79C
80C  Vents U
81C
[1403]82      call histwrite(histuid, 'u', itau_w, unat,
[524]83     .               iip1*jjp1*llm, ndexu)
84C
85C  Vents V
86C
[1403]87      call histwrite(histvid, 'v', itau_w, vnat,
[524]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
[1403]103!        DO iq=1,nqtot
104!          call histwrite(histid, ttext(iq), itau_w, q(:,:,iq),
105!     .                   iip1*jjp1*llm, ndexu)
106!        enddo
107!C
[524]108C  Masse
109C
[1403]110      call histwrite(histid,'masse',itau_w, masse,iip1*jjp1*llm,ndexu)
[524]111C
112C  Pression au sol
113C
114      call histwrite(histid, 'ps', itau_w, ps, iip1*jjp1, ndex2d)
115C
116C  Geopotentiel au sol
117C
[1403]118!      call histwrite(histid, 'phis', itau_w, phis, iip1*jjp1, ndex2d)
[524]119C
120C  Fin
121C
122      if (ok_sync) then
123        call histsync(histid)
124        call histsync(histvid)
[1403]125        call histsync(histuid)
[524]126      endif
[1279]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
[524]133      return
134      end
Note: See TracBrowser for help on using the repository browser.