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

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

SL : mise a jour de phytitan pour etre conforme aux sources actuelles
utilisees sur gnome.
File size: 12.8 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     z4_tmp_2d=zx_tmp_2d
52c     CALL histwrite(nid_mth,"cdragh",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
53c
54c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
55c     z4_tmp_2d=zx_tmp_2d
56c     CALL histwrite(nid_mth,"cdragm",itau_w,z4_tmp_2d,iim*jjmp1,ndex2d)
57c
58      ENDIF !lev_histmth.GE.1
59c
60c-------------------------------------------------------
61      IF(lev_histmth.GE.2) THEN
62c
63ccccccccccccc 3D fields, basics
64c
65      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
66      CALL histwrite(nid_mth,"temp",itau_w,zx_tmp_3d,
67     .                                   iim*jjmp1*klev,ndex3d)
68c
69      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
70      CALL histwrite(nid_mth,"pres",itau_w,zx_tmp_3d,
71     .                                   iim*jjmp1*klev,ndex3d)
72c
73      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
74      CALL histwrite(nid_mth,"geop",itau_w,zx_tmp_3d,
75     .                                   iim*jjmp1*klev,ndex3d)
76c
77      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
78      CALL histwrite(nid_mth,"vitu",itau_w,zx_tmp_3d,
79     .                                   iim*jjmp1*klev,ndex3d)
80c
81      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
82      CALL histwrite(nid_mth,"vitv",itau_w,zx_tmp_3d,
83     .                                   iim*jjmp1*klev,ndex3d)
84c
85      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, omega, zx_tmp_3d)
86      CALL histwrite(nid_mth,"vitw",itau_w,zx_tmp_3d,
87     .                                   iim*jjmp1*klev,ndex3d)
88c
89c     CALL gr_fi_ecrit(klev,klon,iim,jjmp1, ycoefh, zx_tmp_3d)
90c     z4_tmp_3d=zx_tmp_3d
91c     CALL histwrite(nid_mth,"Kz",itau_w,z4_tmp_3d,
92c    .                                   iim*jjmp1*klev,ndex3d)
93c
94      CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw,zx_tmp_2d)
95      CALL histwrite(nid_mth,"tops",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
96c
97         if (iflag_trac.eq.1) THEN
98c         if (microfi.eq.1) then
99c          DO iq=1,nmicro
100c      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qaer(1,1,iq), zx_tmp_3d)
101c      CALL histwrite(nid_mth,tname(iq),itau_w,zx_tmp_3d,
102c    .                                   iim*jjmp1*klev,ndex3d)
103c          ENDDO
104c         endif
105          if (nmicro.lt.nqmax) then
106           DO iq=nmicro+1,nqmax
107       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,tr_seri(1,1,iq),zx_tmp_3d)
108       CALL histwrite(nid_mth,tname(iq),itau_w,zx_tmp_3d,
109     .                                   iim*jjmp1*klev,ndex3d)
110           ENDDO
111c Condensation:
112c          DO iq=nmicro+1,nqmax
113c      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,d_tr_mph(1,1,iq),zx_tmp_3d)
114c      CALL histwrite(nid_mth,"c_"//tname(iq),itau_w,zx_tmp_3d,
115c    .                                   iim*jjmp1*klev,ndex3d)
116c          ENDDO
117          endif
118         endif
119c
120      ENDIF !lev_histmth.GE.2
121c
122c-------------------------------------------------------
123      IF(lev_histmth.GE.3) THEN
124c
125cccccccccccccccccc  Radiative transfer
126c
127c 2D
128c
129      CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
130      CALL histwrite(nid_mth,"topl",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
131c
132      CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
133      CALL histwrite(nid_mth,"sols",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
134c
135      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
136      CALL histwrite(nid_mth,"soll",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
137c
138c 3D
139c
140      zx_tmp_fi3d(1:klon,1:klev)=swnet(1:klon,1:klev)
141      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
142      CALL histwrite(nid_mth,"SWnet",itau_w,zx_tmp_3d,
143     .                                   iim*jjmp1*klev,ndex3d)
144c
145      zx_tmp_fi3d(1:klon,1:klev)=lwnet(1:klon,1:klev)
146      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
147      CALL histwrite(nid_mth,"LWnet",itau_w,zx_tmp_3d,
148     .                                   iim*jjmp1*klev,ndex3d)
149c
150c 3D adding Tau and k  (31/08/10)
151c
152       do k=7,NSPECV,10
153         do i=1,klon
154         do l=1,klev
155           t_tauhvd(i,l)=TAUHVD(i,klev-l+1,k)
156         enddo
157         enddo
158         write(str1,'(i2.2)') k
159      zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
160      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
161      z4_tmp_3d=zx_tmp_3d
162      CALL histwrite(nid_day,"thv"//str1,itau_w,z4_tmp_3d,
163     .                                   iim*jjmp1*klev,ndex3d)
164       enddo      ! fin boucle NSPECV
165
166       do k=7,NSPECV,10
167         do i=1,klon
168         do l=1,klev
169         if(l.ne.klev)
170     s    t_khvd(i,l)=TAUHVD(i,klev-l+1,k)
171     s    -TAUHVD(i,klev-l+1-1,k)
172
173          if(l.eq.klev)
174     s    t_khvd(i,l)=TAUHVD(i,klev-l+1,k)
175
176         t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
177         enddo
178         enddo
179         write(str1,'(i2.2)') k
180      zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
181      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
182      z4_tmp_3d=zx_tmp_3d
183      CALL histwrite(nid_day,"khv"//str1,itau_w,z4_tmp_3d,
184     .                                   iim*jjmp1*klev,ndex3d)
185       enddo      ! fin boucle NSPECV
186
187       do k=7,NSPECV,10
188         do i=1,klon
189         do l=1,klev
190           t_tauhvd(i,l)=TAUGVD(i,klev-l+1,k)
191         enddo
192         enddo
193         write(str1,'(i2.2)') k
194      zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
195      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
196      z4_tmp_3d=zx_tmp_3d
197      CALL histwrite(nid_day,"tgv"//str1,itau_w,z4_tmp_3d,
198     .                                   iim*jjmp1*klev,ndex3d)
199       enddo      ! fin boucle NSPECV
200
201       do k=7,NSPECV,10
202         do i=1,klon
203         do l=1,klev
204         if(l.ne.klev)
205     s    t_khvd(i,l)=TAUGVD(i,klev-l+1,k)
206     s    -TAUGVD(i,klev-l+1-1,k)
207
208          if(l.eq.klev)
209     s    t_khvd(i,l)=TAUGVD(i,klev-l+1,k)
210
211         t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
212         enddo
213         enddo
214         write(str1,'(i2.2)') k
215      zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
216      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
217      z4_tmp_3d=zx_tmp_3d
218      CALL histwrite(nid_day,"kgv"//str1,itau_w,z4_tmp_3d,
219     .                                   iim*jjmp1*klev,ndex3d)
220       enddo      ! fin boucle NSPECV
221
222       do k=8,NSPECI,10
223         do i=1,klon
224         do l=1,klev
225           t_tauhvd(i,l)=TAUHID(i,klev-l+1,k)
226         enddo
227         enddo
228         write(str1,'(i2.2)') k
229      zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
230      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
231      z4_tmp_3d=zx_tmp_3d
232      CALL histwrite(nid_day,"thi"//str1,itau_w,z4_tmp_3d,
233     .                                   iim*jjmp1*klev,ndex3d)
234       enddo      ! fin boucle NSPECI
235
236       do k=8,NSPECI,10
237         do i=1,klon
238         do l=1,klev
239         if(l.ne.klev)
240     s    t_khvd(i,l)=TAUHID(i,klev-l+1,k)
241     s    -TAUHID(i,klev-l+1-1,k)
242
243          if(l.eq.klev)
244     s    t_khvd(i,l)=TAUHID(i,klev-l+1,k)
245
246         t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
247         enddo
248         enddo
249         write(str1,'(i2.2)') k
250      zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
251      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
252      z4_tmp_3d=zx_tmp_3d
253      CALL histwrite(nid_day,"khi"//str1,itau_w,z4_tmp_3d,
254     .                                   iim*jjmp1*klev,ndex3d)
255       enddo      ! fin boucle NSPECI
256
257       do k=8,NSPECI,10
258         do i=1,klon
259         do l=1,klev
260           t_tauhvd(i,l)=TAUGID(i,klev-l+1,k)
261         enddo
262         enddo
263         write(str1,'(i2.2)') k
264      zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
265      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
266      z4_tmp_3d=zx_tmp_3d
267      CALL histwrite(nid_day,"tgi"//str1,itau_w,z4_tmp_3d,
268     .                                   iim*jjmp1*klev,ndex3d)
269       enddo      ! fin boucle NSPECI
270
271       do k=8,NSPECI,10
272         do i=1,klon
273         do l=1,klev
274         if(l.ne.klev)
275     s    t_khvd(i,l)=TAUGID(i,klev-l+1,k)
276     s    -TAUGID(i,klev-l+1-1,k)
277
278          if(l.eq.klev)
279     s    t_khvd(i,l)=TAUGID(i,klev-l+1,k)
280
281         t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
282         enddo
283         enddo
284         write(str1,'(i2.2)') k
285      zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
286      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
287      z4_tmp_3d=zx_tmp_3d
288      CALL histwrite(nid_day,"kgi"//str1,itau_w,z4_tmp_3d,
289     .                                   iim*jjmp1*klev,ndex3d)
290       enddo      ! fin boucle NSPECI
291
292      ENDIF !lev_histmth.GE.3
293c
294c-------------------------------------------------------
295      IF(lev_histmth.GE.4) THEN
296c
297      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_dyn, zx_tmp_3d)
298      CALL histwrite(nid_mth,"dtdyn",itau_w,zx_tmp_3d,
299     .                                   iim*jjmp1*klev,ndex3d)
300c
301      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t, zx_tmp_3d)
302      CALL histwrite(nid_mth,"dtphy",itau_w,zx_tmp_3d,
303     .                                   iim*jjmp1*klev,ndex3d)
304c K/s
305      zx_tmp_fi3d(1:klon,1:klev)=d_t_vdf(1:klon,1:klev)
306      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
307      CALL histwrite(nid_mth,"dtvdf",itau_w,zx_tmp_3d,
308     .                                   iim*jjmp1*klev,ndex3d)
309c
310c K/s
311      zx_tmp_fi3d(1:klon,1:klev)=d_t_ajs(1:klon,1:klev)
312      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
313      CALL histwrite(nid_mth,"dtajs",itau_w,zx_tmp_3d,
314     .                                   iim*jjmp1*klev,ndex3d)
315c
316c K/s
317      zx_tmp_fi3d(1:klon,1:klev)=heat(1:klon,1:klev)
318      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
319      CALL histwrite(nid_mth,"dtswr",itau_w,zx_tmp_3d,
320     .                                   iim*jjmp1*klev,ndex3d)
321c
322c K/s     
323      zx_tmp_fi3d(1:klon,1:klev)=-1.*cool(1:klon,1:klev)
324      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
325      CALL histwrite(nid_mth,"dtlwr",itau_w,zx_tmp_3d,
326     .                                   iim*jjmp1*klev,ndex3d)
327c K/s     
328c     zx_tmp_fi3d(1:klon,1:klev)=d_t_ec(1:klon,1:klev)
329c     CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
330c     CALL histwrite(nid_mth,"dtec",itau_w,zx_tmp_3d,
331c    .                                   iim*jjmp1*klev,ndex3d)
332c
333      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_vdf, zx_tmp_3d)
334      CALL histwrite(nid_mth,"duvdf",itau_w,zx_tmp_3d,
335     .                                   iim*jjmp1*klev,ndex3d)
336c
337      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_dyn, zx_tmp_3d)
338      CALL histwrite(nid_mth,"dudyn",itau_w,zx_tmp_3d,
339     .                                   iim*jjmp1*klev,ndex3d)
340c
341c     CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_vdf, zx_tmp_3d)
342c     CALL histwrite(nid_mth,"dvvdf",itau_w,zx_tmp_3d,
343c    .                                   iim*jjmp1*klev,ndex3d)
344c
345      ENDIF !lev_histmth.GE.4
346c
347c-------------------------------------------------------
348      IF(lev_histmth.GE.5) THEN
349c
350c
351c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxu , zx_tmp_2d)
352c      CALL histwrite(nid_mth,"taux_",itau_w,
353c    $      zx_tmp_2d,iim*jjmp1,ndex2d) 
354c     
355c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxv , zx_tmp_2d)
356c      CALL histwrite(nid_mth,"tauy_",itau_w,
357c    $      zx_tmp_2d,iim*jjmp1,ndex2d)
358c
359c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
360c     CALL histwrite(nid_mth,"cdrm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
361c
362c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
363c     CALL histwrite(nid_mth,"cdrh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
364c
365      ENDIF !lev_histmth.GE.5
366c-------------------------------------------------------
367c
368      if (ok_sync) then
369        call histsync(nid_mth)
370      endif
371
372      ENDIF
Note: See TracBrowser for help on using the repository browser.