source: trunk/libf/phytitan/write_histmth.h @ 121

Last change on this file since 121 was 119, checked in by slebonnois, 14 years ago

Sebastien Lebonnois: apres validation des versions Venus et Titan,
correction d'un certain nombre de bugs.
File size: 12.6 KB
Line 
1      IF (ok_mensuel) THEN
2c
3      ndex2d = 0
4      ndex3d = 0
5      zx_tmp_2d = 0.
6      zx_tmp_3d = 0.
7      zx_tmp_fi2d=0.
8      zx_tmp_fi3d=0.
9c
10         zsto = dtime
11         zout = dtime * FLOAT(ecrit_mth)
12         itau_w = itau_phy + itap
13c
14c-------------------------------------------------------
15      IF(lev_histmth.GE.1) THEN
16c
17ccccccccccccc 2D fields, invariables
18c
19      CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
20      CALL histwrite(nid_mth,"phis",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
21C
22      CALL gr_fi_ecrit(1,klon,iim,jjmp1,airephy,zx_tmp_2d)
23      CALL histwrite(nid_mth,"aire",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
24c
25ccccccc axe Ls
26      do j=1,jjmp1
27       do i=1,iim
28        zx_tmp_2d(i,j)=zls*180./RPI      ! zls est en radians !!
29       enddo
30      enddo
31      CALL histwrite(nid_mth,"ls",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
32c
33ccccccccccccc 2D fields, variables
34c
35      CALL gr_fi_ecrit(1, klon,iim,jjmp1, ftsol,zx_tmp_2d)
36      CALL histwrite(nid_mth,"tsol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
37c
38      DO i = 1, klon
39         zx_tmp_fi2d(i) = paprs(i,1)
40      ENDDO
41      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
42      CALL histwrite(nid_mth,"psol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
43c
44c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, ue,zx_tmp_2d)
45c     CALL histwrite(nid_mth,"ue",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
46c
47c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, ve,zx_tmp_2d)
48c     CALL histwrite(nid_mth,"ve",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
49c
50c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
51c     CALL histwrite(nid_mth,"cdragh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
52c
53c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
54c     CALL histwrite(nid_mth,"cdragm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
55c
56      ENDIF !lev_histmth.GE.1
57c
58c-------------------------------------------------------
59      IF(lev_histmth.GE.2) THEN
60c
61ccccccccccccc 3D fields, basics
62c
63      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
64      CALL histwrite(nid_mth,"temp",itau_w,zx_tmp_3d,
65     .                                   iim*jjmp1*klev,ndex3d)
66c
67      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
68      CALL histwrite(nid_mth,"pres",itau_w,zx_tmp_3d,
69     .                                   iim*jjmp1*klev,ndex3d)
70c
71      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
72      CALL histwrite(nid_mth,"geop",itau_w,zx_tmp_3d,
73     .                                   iim*jjmp1*klev,ndex3d)
74c
75      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
76      CALL histwrite(nid_mth,"vitu",itau_w,zx_tmp_3d,
77     .                                   iim*jjmp1*klev,ndex3d)
78c
79      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
80      CALL histwrite(nid_mth,"vitv",itau_w,zx_tmp_3d,
81     .                                   iim*jjmp1*klev,ndex3d)
82c
83      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, omega, zx_tmp_3d)
84      CALL histwrite(nid_mth,"vitw",itau_w,zx_tmp_3d,
85     .                                   iim*jjmp1*klev,ndex3d)
86c
87c     CALL gr_fi_ecrit(klev,klon,iim,jjmp1, ycoefh, zx_tmp_3d)
88c     CALL histwrite(nid_mth,"Kz",itau_w,zx_tmp_3d,
89c    .                                   iim*jjmp1*klev,ndex3d)
90c
91      CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw,zx_tmp_2d)
92      CALL histwrite(nid_mth,"tops",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
93c
94         if (iflag_trac.eq.1) THEN
95c         if (microfi.eq.1) then
96c          DO iq=1,nmicro
97c      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qaer(1,1,iq), zx_tmp_3d)
98c      CALL histwrite(nid_mth,tname(iq),itau_w,zx_tmp_3d,
99c    .                                   iim*jjmp1*klev,ndex3d)
100c          ENDDO
101c         endif
102          if (nmicro.lt.nqmax) then
103           DO iq=nmicro+1,nqmax
104       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,tr_seri(1,1,iq),zx_tmp_3d)
105       CALL histwrite(nid_mth,tname(iq),itau_w,zx_tmp_3d,
106     .                                   iim*jjmp1*klev,ndex3d)
107           ENDDO
108c Condensation:
109c          DO iq=nmicro+1,nqmax
110c      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,d_tr_mph(1,1,iq),zx_tmp_3d)
111c      CALL histwrite(nid_mth,"c_"//tname(iq),itau_w,zx_tmp_3d,
112c    .                                   iim*jjmp1*klev,ndex3d)
113c          ENDDO
114          endif
115         endif
116c
117      ENDIF !lev_histmth.GE.2
118c
119c-------------------------------------------------------
120      IF(lev_histmth.GE.3) THEN
121c
122cccccccccccccccccc  Radiative transfer
123c
124c 2D
125c
126      CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
127      CALL histwrite(nid_mth,"topl",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
128c
129      CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
130      CALL histwrite(nid_mth,"sols",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
131c
132      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
133      CALL histwrite(nid_mth,"soll",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
134c
135c 3D
136c
137      zx_tmp_fi3d(1:klon,1:klev)=swnet(1:klon,1:klev)
138      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
139      CALL histwrite(nid_mth,"SWnet",itau_w,zx_tmp_3d,
140     .                                   iim*jjmp1*klev,ndex3d)
141c
142      zx_tmp_fi3d(1:klon,1:klev)=lwnet(1:klon,1:klev)
143      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
144      CALL histwrite(nid_mth,"LWnet",itau_w,zx_tmp_3d,
145     .                                   iim*jjmp1*klev,ndex3d)
146c
147c 3D adding Tau and k  (31/08/10)
148c
149       do k=7,NSPECV,10
150         do i=1,klon
151         do l=1,klev
152           t_tauhvd(i,l)=TAUHVD(i,klev-l+1,k)
153         enddo
154         enddo
155         write(str1,'(i2.2)') k
156      zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
157      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
158      CALL histwrite(nid_mth,"thv"//str1,itau_w,zx_tmp_3d,
159     .                                   iim*jjmp1*klev,ndex3d)
160       enddo      ! fin boucle NSPECV
161
162       do k=7,NSPECV,10
163         do i=1,klon
164         do l=1,klev
165         if(l.ne.klev)
166     s    t_khvd(i,l)=TAUHVD(i,klev-l+1,k)
167     s    -TAUHVD(i,klev-l+1-1,k)
168
169          if(l.eq.klev)
170     s    t_khvd(i,l)=TAUHVD(i,klev-l+1,k)
171
172         t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
173         enddo
174         enddo
175         write(str1,'(i2.2)') k
176      zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
177      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
178      CALL histwrite(nid_mth,"khv"//str1,itau_w,zx_tmp_3d,
179     .                                   iim*jjmp1*klev,ndex3d)
180       enddo      ! fin boucle NSPECV
181
182       do k=7,NSPECV,10
183         do i=1,klon
184         do l=1,klev
185           t_tauhvd(i,l)=TAUGVD(i,klev-l+1,k)
186         enddo
187         enddo
188         write(str1,'(i2.2)') k
189      zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
190      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
191      CALL histwrite(nid_mth,"tgv"//str1,itau_w,zx_tmp_3d,
192     .                                   iim*jjmp1*klev,ndex3d)
193       enddo      ! fin boucle NSPECV
194
195       do k=7,NSPECV,10
196         do i=1,klon
197         do l=1,klev
198         if(l.ne.klev)
199     s    t_khvd(i,l)=TAUGVD(i,klev-l+1,k)
200     s    -TAUGVD(i,klev-l+1-1,k)
201
202          if(l.eq.klev)
203     s    t_khvd(i,l)=TAUGVD(i,klev-l+1,k)
204
205         t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
206         enddo
207         enddo
208         write(str1,'(i2.2)') k
209      zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
210      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
211      CALL histwrite(nid_mth,"kgv"//str1,itau_w,zx_tmp_3d,
212     .                                   iim*jjmp1*klev,ndex3d)
213       enddo      ! fin boucle NSPECV
214
215       do k=8,NSPECI,10
216         do i=1,klon
217         do l=1,klev
218           t_tauhvd(i,l)=TAUHID(i,klev-l+1,k)
219         enddo
220         enddo
221         write(str1,'(i2.2)') k
222      zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
223      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
224      CALL histwrite(nid_mth,"thi"//str1,itau_w,zx_tmp_3d,
225     .                                   iim*jjmp1*klev,ndex3d)
226       enddo      ! fin boucle NSPECI
227
228       do k=8,NSPECI,10
229         do i=1,klon
230         do l=1,klev
231         if(l.ne.klev)
232     s    t_khvd(i,l)=TAUHID(i,klev-l+1,k)
233     s    -TAUHID(i,klev-l+1-1,k)
234
235          if(l.eq.klev)
236     s    t_khvd(i,l)=TAUHID(i,klev-l+1,k)
237
238         t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
239         enddo
240         enddo
241         write(str1,'(i2.2)') k
242      zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
243      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
244      CALL histwrite(nid_mth,"khi"//str1,itau_w,zx_tmp_3d,
245     .                                   iim*jjmp1*klev,ndex3d)
246       enddo      ! fin boucle NSPECI
247
248       do k=8,NSPECI,10
249         do i=1,klon
250         do l=1,klev
251           t_tauhvd(i,l)=TAUGID(i,klev-l+1,k)
252         enddo
253         enddo
254         write(str1,'(i2.2)') k
255      zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
256      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
257      CALL histwrite(nid_mth,"tgi"//str1,itau_w,zx_tmp_3d,
258     .                                   iim*jjmp1*klev,ndex3d)
259       enddo      ! fin boucle NSPECI
260
261       do k=8,NSPECI,10
262         do i=1,klon
263         do l=1,klev
264         if(l.ne.klev)
265     s    t_khvd(i,l)=TAUGID(i,klev-l+1,k)
266     s    -TAUGID(i,klev-l+1-1,k)
267
268          if(l.eq.klev)
269     s    t_khvd(i,l)=TAUGID(i,klev-l+1,k)
270
271         t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
272         enddo
273         enddo
274         write(str1,'(i2.2)') k
275      zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
276      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
277      CALL histwrite(nid_mth,"kgi"//str1,itau_w,zx_tmp_3d,
278     .                                   iim*jjmp1*klev,ndex3d)
279       enddo      ! fin boucle NSPECI
280
281      ENDIF !lev_histmth.GE.3
282c
283c-------------------------------------------------------
284      IF(lev_histmth.GE.4) THEN
285c
286      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_dyn, zx_tmp_3d)
287      CALL histwrite(nid_mth,"dtdyn",itau_w,zx_tmp_3d,
288     .                                   iim*jjmp1*klev,ndex3d)
289c
290      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t, zx_tmp_3d)
291      CALL histwrite(nid_mth,"dtphy",itau_w,zx_tmp_3d,
292     .                                   iim*jjmp1*klev,ndex3d)
293c K/s
294      zx_tmp_fi3d(1:klon,1:klev)=d_t_vdf(1:klon,1:klev)
295      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
296      CALL histwrite(nid_mth,"dtvdf",itau_w,zx_tmp_3d,
297     .                                   iim*jjmp1*klev,ndex3d)
298c
299c K/s
300      zx_tmp_fi3d(1:klon,1:klev)=d_t_ajs(1:klon,1:klev)
301      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
302      CALL histwrite(nid_mth,"dtajs",itau_w,zx_tmp_3d,
303     .                                   iim*jjmp1*klev,ndex3d)
304c
305c K/s
306      zx_tmp_fi3d(1:klon,1:klev)=heat(1:klon,1:klev)
307      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
308      CALL histwrite(nid_mth,"dtswr",itau_w,zx_tmp_3d,
309     .                                   iim*jjmp1*klev,ndex3d)
310c
311c K/s     
312      zx_tmp_fi3d(1:klon,1:klev)=-1.*cool(1:klon,1:klev)
313      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
314      CALL histwrite(nid_mth,"dtlwr",itau_w,zx_tmp_3d,
315     .                                   iim*jjmp1*klev,ndex3d)
316c K/s     
317c     zx_tmp_fi3d(1:klon,1:klev)=d_t_ec(1:klon,1:klev)
318c     CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
319c     CALL histwrite(nid_mth,"dtec",itau_w,zx_tmp_3d,
320c    .                                   iim*jjmp1*klev,ndex3d)
321c
322      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_vdf, zx_tmp_3d)
323      CALL histwrite(nid_mth,"duvdf",itau_w,zx_tmp_3d,
324     .                                   iim*jjmp1*klev,ndex3d)
325c
326      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_dyn, zx_tmp_3d)
327      CALL histwrite(nid_mth,"dudyn",itau_w,zx_tmp_3d,
328     .                                   iim*jjmp1*klev,ndex3d)
329c
330c     CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_vdf, zx_tmp_3d)
331c     CALL histwrite(nid_mth,"dvvdf",itau_w,zx_tmp_3d,
332c    .                                   iim*jjmp1*klev,ndex3d)
333c
334      ENDIF !lev_histmth.GE.4
335c
336c-------------------------------------------------------
337      IF(lev_histmth.GE.5) THEN
338c
339c
340c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxu , zx_tmp_2d)
341c      CALL histwrite(nid_mth,"taux_",itau_w,
342c    $      zx_tmp_2d,iim*jjmp1,ndex2d) 
343c     
344c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxv , zx_tmp_2d)
345c      CALL histwrite(nid_mth,"tauy_",itau_w,
346c    $      zx_tmp_2d,iim*jjmp1,ndex2d)
347c
348c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
349c     CALL histwrite(nid_mth,"cdrm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
350c
351c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
352c     CALL histwrite(nid_mth,"cdrh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
353c
354      ENDIF !lev_histmth.GE.5
355c-------------------------------------------------------
356c
357      if (ok_sync) then
358        call histsync(nid_mth)
359      endif
360
361      ENDIF
Note: See TracBrowser for help on using the repository browser.