source: LMDZ4/branches/unlabeled-1.1.1/libf/bibio/writedynav.F @ 5192

Last change on this file since 5192 was 524, checked in by lmdzadmin, 21 years ago

Initial revision

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