source: LMDZ.3.3/branches/rel-LF/libf/bibio/writedynav.F @ 345

Last change on this file since 345 was 295, checked in by lmdzadmin, 23 years ago

Tag version 0 qui marche en couple/force
LF

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.3 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 ndex2d(iip1*jjp1),ndex3d(iip1*jjp1*llm),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      ndex3d = 0
71      ndex2d = 0
72      ok_sync = .TRUE.
73      us = 999.999
74      vs = 999.999
75      tm = 999.999
76      vnat = 999.999
77      unat = 999.999
78
79C Passage aux composantes naturelles du vent
80      call covnat(llm, ucov, vcov, unat, vnat)
81
82C
83C  Appels a histwrite pour l'ecriture des variables a sauvegarder
84C
85C  Vents U scalaire
86C
87      call gr_u_scal(llm, unat, us)
88      call histwrite(histid, 'u', time, us,
89     .               iip1*jjp1*llm, ndex3d)
90C
91C  Vents V scalaire
92C
93      call gr_v_scal(llm, vnat, vs)
94      call histwrite(histid, 'v', time, vs,
95     .               iip1*jjp1*llm, ndex3d)
96C
97C  Temperature potentielle moyennee
98C
99      call histwrite(histid, 'theta', time, teta,
100     .                iip1*jjp1*llm, ndex3d)
101C
102C  Temperature moyennee
103C
104      do ii = 1, ijp1llm
105        tm(ii) = teta(ii) * ppk(ii)/cpp
106      enddo
107      call histwrite(histid, 'temp', time, tm,
108     .                iip1*jjp1*llm, ndex3d)
109C
110C  Geopotentiel
111C
112      call histwrite(histid, 'phi', time, phi,
113     .                iip1*jjp1*llm, ndex3d)
114C
115C  Traceurs
116C
117      IF(nq.GE.1) THEN
118        DO iq=1,nq
119          IF ( iq.LE.9 ) THEN
120            WRITE(str(2:2),'(i1.1)') iq
121          ELSE
122            WRITE(str(2:3),'(i2.2)') iq
123          ENDIF
124          call histwrite(histid, str, time, q(:,:,iq),
125     .                   iip1*jjp1*llm, ndex3d)
126        enddo
127      endif
128C
129C  Masse
130C
131       call histwrite(histid, 'masse', time, masse, iip1*jjp1, ndex2d)
132C
133C  Pression au sol
134C
135       call histwrite(histid, 'ps', time, ps, iip1*jjp1, ndex2d)
136C
137C  Geopotentiel au sol
138C
139       call histwrite(histid, 'phis', time, phis, iip1*jjp1, ndex2d)
140C
141C  Fin
142C
143      if (ok_sync) call histsync(histid)
144      return
145      end
Note: See TracBrowser for help on using the repository browser.