source: LMDZ.3.3/branches/LF/libf/bibio/writehist.F @ 5081

Last change on this file since 5081 was 2, checked in by lmdz, 25 years ago

Initial revision

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 2.7 KB
Line 
1      subroutine writehist( histid, histvid, nq, time, vcov,
2     ,                          ucov,teta,phi,q,masse,ps,phis)
3
4      USE ioipsl
5      implicit none
6
7C
8C   Ecriture du fichier histoire au format IOIPSL
9C
10C   Appels succesifs des routines: histwrite
11C
12C   Entree:
13C      histid: ID du fichier histoire
14C      histvid:ID du fichier histoire pour les vents V (appele a disparaitre)
15C      nqmx: nombre maxi de traceurs
16C      time: temps de l'ecriture
17C      vcov: vents v covariants
18C      ucov: vents u covariants
19C      teta: temperature potentielle
20C      phi : geopotentiel instantane
21C      q   : traceurs
22C      masse: masse
23C      ps   :pression au sol
24C      phis : geopotentiel au sol
25C     
26C
27C   Sortie:
28C      fileid: ID du fichier netcdf cree
29C
30C   L. Fairhead, LMD, 03/99
31C
32C =====================================================================
33C
34C   Declarations
35#include "dimensions.h"
36#include "paramet.h"
37#include "comconst.h"
38#include "comvert.h"
39#include "comgeom.h"
40#include "temps.h"
41#include "ener.h"
42#include "logic.h"
43#include "description.h"
44#include "serre.h"
45
46C
47C   Arguments
48C
49
50      INTEGER histid, nq, histvid
51      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm)
52      REAL teta(ip1jmp1,llm),phi(ip1jmp1,llm)                   
53      REAL ps(ip1jmp1),masse(ip1jmp1,llm)                   
54      REAL phis(ip1jmp1)                 
55      REAL q(ip1jmp1,llm,nq)
56      integer time
57
58
59C   Variables locales
60C
61      integer ndex(1),iq, ii, ll
62      character*3 str
63      logical ok_sync
64C
65C  Initialisations
66C
67      str='q  '
68      ndex(1) = 0
69      ok_sync =.TRUE.
70C
71C  Appels a histwrite pour l'ecriture des variables a sauvegarder
72C
73C  Vents U
74C
75      call histwrite(histid, 'ucov', time, ucov,
76     .               iip1*jjp1*llm, ndex)
77
78C
79C  Vents V
80C
81      call histwrite(histvid, 'vcov', time, vcov,
82     .               iip1*jjm*llm, ndex)
83
84C
85C  Temperature potentielle
86C
87      call histwrite(histid, 'teta', time, teta,
88     .                iip1*jjp1*llm, ndex)
89C
90C  Geopotentiel
91C
92      call histwrite(histid, 'phi', time, phi,
93     .                iip1*jjp1*llm, ndex)
94C
95C  Traceurs
96C
97      IF(nq.GE.1) THEN
98        DO iq=1,nq
99          IF ( iq.LE.9 ) THEN
100            WRITE(str(2:2),'(i1.1)') iq
101          ELSE
102            WRITE(str(2:3),'(i2.2)') iq
103          ENDIF
104          call histwrite(histid, str, time, q(:,:,iq),
105     .                   iip1*jjp1*llm, ndex)
106        enddo
107      endif
108C
109C  Masse
110C
111      call histwrite(histid, 'masse', time, masse, iip1*jjp1, ndex)
112C
113C  Pression au sol
114C
115      call histwrite(histid, 'ps', time, ps, iip1*jjp1, ndex)
116C
117C  Geopotentiel au sol
118C
119      call histwrite(histid, 'phis', time, phis, iip1*jjp1, ndex)
120C
121C  Fin
122C
123      if (ok_sync) call histsync
124      return
125      end
Note: See TracBrowser for help on using the repository browser.