source: LMDZ4/branches/LMDZ4-dev/libf/dyn3dpar/writedynav_p.F @ 1118

Last change on this file since 1118 was 1118, checked in by yann meurdesoif, 15 years ago

Correction parallélisme : en parallèle la variable "V" dans le fichier dyn_hist_ave.nc n'était pas correcte.
YM

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 3.5 KB
Line 
1!
2! $Header$
3!
4      subroutine writedynav_p( histid, time, vcov,
5     ,                          ucov,teta,ppk,phi,q,masse,ps,phis)
6
7      USE ioipsl
8      USE parallel
9      USE misc_mod
10      USE infotrac
11      implicit none
12
13C
14C   Ecriture du fichier histoire au format IOIPSL
15C
16C   Appels succesifs des routines: histwrite
17C
18C   Entree:
19C      histid: ID du fichier histoire
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
50C
51C   Arguments
52C
53
54      INTEGER histid
55      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm)
56      REAL teta(ip1jmp1,llm),phi(ip1jmp1,llm),ppk(ip1jmp1,llm)                 
57      REAL ps(ip1jmp1),masse(ip1jmp1,llm)                   
58      REAL phis(ip1jmp1)                 
59      REAL q(ip1jmp1,llm,nqtot)
60      integer time
61
62
63C   Variables locales
64C
65      integer ndex2d(iip1*jjp1),ndex3d(iip1*jjp1*llm),iq, ii, ll
66      real us(ip1jmp1,llm), vs(ip1jmp1,llm)
67      real tm(ip1jmp1,llm)
68      REAL vnat(ip1jm,llm),unat(ip1jmp1,llm)
69      logical ok_sync
70      integer itau_w
71      integer :: ijb,ije,jjn
72C
73C  Initialisations
74C
75      if (adjust) return
76     
77      ndex3d = 0
78      ndex2d = 0
79      ok_sync = .TRUE.
80      us = 999.999
81      vs = 999.999
82      tm = 999.999
83      vnat = 999.999
84      unat = 999.999
85      itau_w = itau_dyn + time
86
87C Passage aux composantes naturelles du vent
88      call covnat_p(llm, ucov, vcov, unat, vnat)
89
90C
91C  Appels a histwrite pour l'ecriture des variables a sauvegarder
92C
93C  Vents U scalaire
94C
95      call gr_u_scal_p(llm, unat, us)
96     
97      ijb=ij_begin
98      ije=ij_end
99      jjn=jj_nb
100     
101      call histwrite(histid, 'u', itau_w, us(ijb:ije,:),
102     .               iip1*jjn*llm, ndex3d)
103C
104C  Vents V scalaire
105C
106     
107      call gr_v_scal_p(llm, vnat, vs)
108      call histwrite(histid, 'v', itau_w, vs(ijb:ije,:),
109     .               iip1*jjn*llm, ndex3d)
110C
111C  Temperature potentielle moyennee
112C
113     
114      call histwrite(histid, 'theta', itau_w, teta(ijb:ije,:),
115     .                iip1*jjn*llm, ndex3d)
116C
117C  Temperature moyennee
118C
119      do ll=1,llm
120        do ii = ijb, ije
121          tm(ii,ll) = teta(ii,ll) * ppk(ii,ll)/cpp
122        enddo
123      enddo
124     
125      call histwrite(histid, 'temp', itau_w, tm(ijb:ije,:),
126     .                iip1*jjn*llm, ndex3d)
127C
128C  Geopotentiel
129C
130      call histwrite(histid, 'phi', itau_w, phi(ijb:ije,:),
131     .                iip1*jjn*llm, ndex3d)
132C
133C  Traceurs
134C
135        DO iq=1,nqtot
136          call histwrite(histid, ttext(iq), itau_w, q(ijb:ije,:,iq),
137     .                   iip1*jjn*llm, ndex3d)
138        enddo
139C
140C  Masse
141C
142       call histwrite(histid, 'masse', itau_w, masse(ijb:ije,1),
143     .                iip1*jjn, ndex2d)
144C
145C  Pression au sol
146C
147       call histwrite(histid, 'ps', itau_w, ps(ijb:ije),
148     .                 iip1*jjn, ndex2d)
149C
150C  Geopotentiel au sol
151C
152       call histwrite(histid, 'phis', itau_w, phis(ijb:ije),
153     .                 iip1*jjn, ndex2d)
154C
155C  Fin
156C
157      if (ok_sync) call histsync(histid)
158      return
159      end
Note: See TracBrowser for help on using the repository browser.