My Project
 All Classes Files Functions Variables Macros
writedynav_p.F
Go to the documentation of this file.
1 !
2 ! $Id: writedynav_p.F 1279 2009-12-10 09:02:56Z fairhead $
3 !
4  subroutine writedynav_p( histid, time, vcov,
5  , ucov,teta,ppk,phi,q,masse,ps,phis)
6 
7 #ifdef CPP_IOIPSL
8 ! This routine needs IOIPSL
9  USE ioipsl
10 #endif
11  USE parallel
12  USE misc_mod
13  USE infotrac
14  implicit none
15 
16 C
17 C Ecriture du fichier histoire au format IOIPSL
18 C
19 C Appels succesifs des routines: histwrite
20 C
21 C Entree:
22 C histid: ID du fichier histoire
23 C time: temps de l'ecriture
24 C vcov: vents v covariants
25 C ucov: vents u covariants
26 C teta: temperature potentielle
27 C phi : geopotentiel instantane
28 C q : traceurs
29 C masse: masse
30 C ps :pression au sol
31 C phis : geopotentiel au sol
32 C
33 C
34 C Sortie:
35 C fileid: ID du fichier netcdf cree
36 C
37 C L. Fairhead, LMD, 03/99
38 C
39 C =====================================================================
40 C
41 C Declarations
42 #include "dimensions.h"
43 #include "paramet.h"
44 #include "comconst.h"
45 #include "comvert.h"
46 #include "comgeom.h"
47 #include "temps.h"
48 #include "ener.h"
49 #include "logic.h"
50 #include "description.h"
51 #include "serre.h"
52 #include "iniprint.h"
53 
54 C
55 C Arguments
56 C
57 
58  INTEGER histid
59  REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm)
60  REAL teta(ip1jmp1,llm),phi(ip1jmp1,llm),ppk(ip1jmp1,llm)
61  REAL ps(ip1jmp1),masse(ip1jmp1,llm)
62  REAL phis(ip1jmp1)
63  REAL q(ip1jmp1,llm,nqtot)
64  integer time
65 
66 
67 #ifdef CPP_IOIPSL
68 ! This routine needs IOIPSL
69 C Variables locales
70 C
71  integer ndex2d(iip1*jjp1),ndex3d(iip1*jjp1*llm),iq, ii, ll
72  real us(ip1jmp1,llm), vs(ip1jmp1,llm)
73  real tm(ip1jmp1,llm)
74  REAL vnat(ip1jm,llm),unat(ip1jmp1,llm)
75  logical ok_sync
76  integer itau_w
77  integer :: ijb,ije,jjn
78 C
79 C Initialisations
80 C
81  if (adjust) return
82 
83  ndex3d = 0
84  ndex2d = 0
85  ok_sync = .true.
86  us = 999.999
87  vs = 999.999
88  tm = 999.999
89  vnat = 999.999
90  unat = 999.999
91  itau_w = itau_dyn + time
92 
93 C Passage aux composantes naturelles du vent
94  call covnat_p(llm, ucov, vcov, unat, vnat)
95 
96 C
97 C Appels a histwrite pour l'ecriture des variables a sauvegarder
98 C
99 C Vents U scalaire
100 C
101  call gr_u_scal_p(llm, unat, us)
102 
103  ijb=ij_begin
104  ije=ij_end
105  jjn=jj_nb
106 
107  call histwrite(histid, 'u', itau_w, us(ijb:ije,:),
108  . iip1*jjn*llm, ndex3d)
109 C
110 C Vents V scalaire
111 C
112 
113  call gr_v_scal_p(llm, vnat, vs)
114  call histwrite(histid, 'v', itau_w, vs(ijb:ije,:),
115  . iip1*jjn*llm, ndex3d)
116 C
117 C Temperature potentielle moyennee
118 C
119 
120  call histwrite(histid, 'theta', itau_w, teta(ijb:ije,:),
121  . iip1*jjn*llm, ndex3d)
122 C
123 C Temperature moyennee
124 C
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)
133 C
134 C Geopotentiel
135 C
136  call histwrite(histid, 'phi', itau_w, phi(ijb:ije,:),
137  . iip1*jjn*llm, ndex3d)
138 C
139 C Traceurs
140 C
141  DO iq=1,nqtot
142  call histwrite(histid, ttext(iq), itau_w, q(ijb:ije,:,iq),
143  . iip1*jjn*llm, ndex3d)
144  enddo
145 C
146 C Masse
147 C
148  call histwrite(histid, 'masse', itau_w, masse(ijb:ije,1),
149  . iip1*jjn, ndex2d)
150 C
151 C Pression au sol
152 C
153  call histwrite(histid, 'ps', itau_w, ps(ijb:ije),
154  . iip1*jjn, ndex2d)
155 C
156 C Geopotentiel au sol
157 C
158  call histwrite(histid, 'phis', itau_w, phis(ijb:ije),
159  . iip1*jjn, ndex2d)
160 C
161 C Fin
162 C
163  if (ok_sync) call histsync(histid)
164 #else
165  write(lunout,*)'writedynav_p: Needs IOIPSL to function'
166 #endif
167 ! #endif of #ifdef CPP_IOIPSL
168  return
169  end