source: LMDZ.3.3/trunk/libf/bibio/writehist.F @ 346

Last change on this file since 346 was 30, checked in by lmdz, 25 years ago

Probleme dans le dimensionnement de ndex

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 2.9 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 iq, ii, ll
62      integer ndexu(ip1jmp1*llm),ndexv(ip1jm*llm),ndex2d(ip1jmp1)
63      character*3 str
64      logical ok_sync
65C
66C  Initialisations
67C
68      str='q  '
69      ndexu = 0
70      ndexv = 0
71      ndex2d = 0
72      ok_sync =.TRUE.
73C
74C  Appels a histwrite pour l'ecriture des variables a sauvegarder
75C
76C  Vents U
77C
78      call histwrite(histid, 'ucov', time, ucov,
79     .               iip1*jjp1*llm, ndexu)
80
81C
82C  Vents V
83C
84      call histwrite(histvid, 'vcov', time, vcov,
85     .               iip1*jjm*llm, ndexv)
86
87C
88C  Temperature potentielle
89C
90      call histwrite(histid, 'teta', time, teta,
91     .                iip1*jjp1*llm, ndexu)
92C
93C  Geopotentiel
94C
95      call histwrite(histid, 'phi', time, phi,
96     .                iip1*jjp1*llm, ndexu)
97C
98C  Traceurs
99C
100      IF(nq.GE.1) THEN
101        DO iq=1,nq
102          IF ( iq.LE.9 ) THEN
103            WRITE(str(2:2),'(i1.1)') iq
104          ELSE
105            WRITE(str(2:3),'(i2.2)') iq
106          ENDIF
107          call histwrite(histid, str, time, q(:,:,iq),
108     .                   iip1*jjp1*llm, ndexu)
109        enddo
110      endif
111C
112C  Masse
113C
114      call histwrite(histid, 'masse', time, masse, iip1*jjp1, ndex2d)
115C
116C  Pression au sol
117C
118      call histwrite(histid, 'ps', time, ps, iip1*jjp1, ndex2d)
119C
120C  Geopotentiel au sol
121C
122      call histwrite(histid, 'phis', time, phis, iip1*jjp1, ndex2d)
123C
124C  Fin
125C
126      if (ok_sync) then
127        call histsync(histid)
128        call histsync(histvid)
129      endif
130      return
131      end
Note: See TracBrowser for help on using the repository browser.