source: LMDZ.3.3/trunk/libf/bibio/writedynav.F @ 2793

Last change on this file since 2793 was 29, checked in by lmdz, 25 years ago

Le tableau ndex, qui permet de "flagger" les valeurs a sortir dans IOIPSL, est
dimmensionne maniere correcte, sinon sur Nec les champs 3D physique ne sont
pas correctement rempli. (probleme non visible avec les champs dynamiques mais
pour faire propre ...) LF

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