source: LMDZ4/trunk/libf/dyn3dpar/writedynav_p.F @ 894

Last change on this file since 894 was 774, checked in by Laurent Fairhead, 18 years ago

Suite du merge entre la version et la HEAD: quelques modifications de
Yann sur le

LF

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