source: LMDZ4/branches/V3_test/libf/bibio/writehist.F @ 3733

Last change on this file since 3733 was 524, checked in by lmdzadmin, 20 years ago

Initial revision

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