source: LMDZ.3.3/branches/LF/libf/bibio/writedynav.F @ 467

Last change on this file since 467 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: 3.0 KB
Line 
1      subroutine writedynav( histid, nq, time, vcov,
2     ,                          ucov,teta,ppk,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      nqmx: nombre maxi de traceurs
15C      time: temps de l'ecriture
16C      vcov: vents v covariants
17C      ucov: vents u covariants
18C      teta: temperature potentielle
19C      phi : geopotentiel instantane
20C      q   : traceurs
21C      masse: masse
22C      ps   :pression au sol
23C      phis : geopotentiel au sol
24C     
25C
26C   Sortie:
27C      fileid: ID du fichier netcdf cree
28C
29C   L. Fairhead, LMD, 03/99
30C
31C =====================================================================
32C
33C   Declarations
34#include "dimensions.h"
35#include "paramet.h"
36#include "comconst.h"
37#include "comvert.h"
38#include "comgeom.h"
39#include "temps.h"
40#include "ener.h"
41#include "logic.h"
42#include "description.h"
43#include "serre.h"
44
45C
46C   Arguments
47C
48
49      INTEGER histid, nq
50      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm)
51      REAL teta(ip1jmp1*llm),phi(ip1jmp1,llm),ppk(ip1jmp1*llm)                 
52      REAL ps(ip1jmp1),masse(ip1jmp1,llm)                   
53      REAL phis(ip1jmp1)                 
54      REAL q(ip1jmp1,llm,nq)
55      integer time
56
57
58C   Variables locales
59C
60      integer ndex(1),iq, ii, ll
61      character*3 str
62      real us(ip1jmp1*llm), vs(ip1jmp1*llm)
63      real tm(ip1jmp1*llm)
64      REAL vnat(ip1jm,llm),unat(ip1jmp1,llm)
65      logical ok_sync
66C
67C  Initialisations
68C
69      str='q  '
70      ndex(1) = 0
71      ok_sync = .TRUE.
72
73C Passage aux composantes naturelles du vent
74      call covnat(llm, ucov, vcov, unat, vnat)
75
76C
77C  Appels a histwrite pour l'ecriture des variables a sauvegarder
78C
79C  Vents U scalaire
80C
81      call gr_u_scal(llm, unat, us)
82      call histwrite(histid, 'u', time, us,
83     .               iip1*jjp1*llm, ndex)
84C
85C  Vents V scalaire
86C
87      call gr_v_scal(llm, vnat, vs)
88      call histwrite(histid, 'v', time, vs,
89     .               iip1*jjp1*llm, ndex)
90C
91C  Temperature moyennee
92C
93      do ii = 1, ijp1llm
94        tm(ii) = teta(ii) * ppk(ii)/cpp
95      enddo
96      call histwrite(histid, 'temp', time, tm,
97     .                iip1*jjp1*llm, ndex)
98C
99C  Geopotentiel
100C
101      call histwrite(histid, 'phi', time, phi,
102     .                iip1*jjp1*llm, ndex)
103C
104C  Traceurs
105C
106      IF(nq.GE.1) THEN
107        DO iq=1,nq
108          IF ( iq.LE.9 ) THEN
109            WRITE(str(2:2),'(i1.1)') iq
110          ELSE
111            WRITE(str(2:3),'(i2.2)') iq
112          ENDIF
113          call histwrite(histid, str, time, q(:,:,iq),
114     .                   iip1*jjp1*llm, ndex)
115        enddo
116      endif
117C
118C  Masse
119C
120       call histwrite(histid, 'masse', time, masse, iip1*jjp1, ndex)
121C
122C  Pression au sol
123C
124       call histwrite(histid, 'ps', time, ps, iip1*jjp1, ndex)
125C
126C  Geopotentiel au sol
127C
128       call histwrite(histid, 'phis', time, phis, iip1*jjp1, ndex)
129C
130C  Fin
131C
132      if (ok_sync) call histsync
133      return
134      end
Note: See TracBrowser for help on using the repository browser.