source: trunk/libf/phytitan/write_histday.h @ 107

Last change on this file since 107 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.1 KB
Line 
1!
2! $Header: /home/cvsroot/LMDZ4/libf/phylmd/write_histday.h,v 1.2 2004/06/01 09:27:10 lmdzadmin Exp $
3!
4      IF (ok_journe) THEN
5c
6      ndex2d = 0
7      ndex3d = 0
8      zx_tmp_2d = 0.
9      zx_tmp_3d = 0.
10      zx_tmp_fi2d=0.
11      zx_tmp_fi3d=0.
12c
13         zsto = dtime
14         zout = dtime * FLOAT(ecrit_day)
15         itau_w = itau_phy + itap
16
17c
18c-------------------------------------------------------
19      IF(lev_histday.GE.1) THEN
20c
21ccccccccccccc 2D fields, invariables
22c
23      CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
24      CALL histwrite(nid_day,"phis",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
25C
26      CALL gr_fi_ecrit(1,klon,iim,jjmp1,airephy,zx_tmp_2d)
27      CALL histwrite(nid_day,"aire",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
28c
29ccccccc axe Ls
30      do j=1,jjmp1
31       do i=1,iim
32        zx_tmp_2d(i,j)=zls*180./RPI      ! zls est en radians !!
33       enddo
34      enddo
35      CALL histwrite(nid_day,"ls",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
36c
37ccccccccccccc 2D fields, variables
38c
39      CALL gr_fi_ecrit(1, klon,iim,jjmp1, ftsol,zx_tmp_2d)
40      CALL histwrite(nid_day,"tsol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
41c
42      DO i = 1, klon
43         zx_tmp_fi2d(i) = paprs(i,1)
44      ENDDO
45      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
46      CALL histwrite(nid_day,"psol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
47c
48c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, ue,zx_tmp_2d)
49c     CALL histwrite(nid_day,"ue",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
50c
51c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, ve,zx_tmp_2d)
52c     CALL histwrite(nid_day,"ve",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
53c
54      ENDIF !lev_histday.GE.1
55c
56c-------------------------------------------------------
57      IF(lev_histday.GE.2) THEN
58c
59ccccccccccccc 3D fields, basics
60c
61      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
62      CALL histwrite(nid_day,"temp",itau_w,zx_tmp_3d,
63     .                                   iim*jjmp1*klev,ndex3d)
64c
65      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
66      CALL histwrite(nid_day,"pres",itau_w,zx_tmp_3d,
67     .                                   iim*jjmp1*klev,ndex3d)
68c
69      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
70      CALL histwrite(nid_day,"geop",itau_w,zx_tmp_3d,
71     .                                   iim*jjmp1*klev,ndex3d)
72c
73      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
74      CALL histwrite(nid_day,"vitu",itau_w,zx_tmp_3d,
75     .                                   iim*jjmp1*klev,ndex3d)
76c
77      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
78      CALL histwrite(nid_day,"vitv",itau_w,zx_tmp_3d,
79     .                                   iim*jjmp1*klev,ndex3d)
80c
81      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, omega, zx_tmp_3d)
82      CALL histwrite(nid_day,"vitw",itau_w,zx_tmp_3d,
83     .                                   iim*jjmp1*klev,ndex3d)
84c
85      CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw,zx_tmp_2d)
86      CALL histwrite(nid_day,"tops",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
87c
88      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_dyn, zx_tmp_3d)
89      CALL histwrite(nid_day,"dudyn",itau_w,zx_tmp_3d,
90     .                                   iim*jjmp1*klev,ndex3d)
91c
92      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_vdf, zx_tmp_3d)
93      CALL histwrite(nid_day,"duvdf",itau_w,zx_tmp_3d,
94     .                                   iim*jjmp1*klev,ndex3d)
95c
96      ENDIF !lev_histday.GE.2
97c
98c-------------------------------------------------------
99      IF(lev_histday.GE.3) THEN
100c
101cccccccccccccccccc  Tracers
102c
103         if (iflag_trac.eq.1) THEN
104          if (microfi.eq.1) then
105           DO iq=1,nmicro
106       CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qaer(1,1,iq), zx_tmp_3d)
107       z4_tmp_3d=zx_tmp_3d
108       CALL histwrite(nid_day,tname(iq),itau_w,z4_tmp_3d,
109     .                                   iim*jjmp1*klev,ndex3d)
110           ENDDO
111          endif
112          if (nmicro.lt.nqmax) then
113           DO iq=nmicro+1,nqmax
114       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,tr_seri(1,1,iq),zx_tmp_3d)
115       z4_tmp_3d=zx_tmp_3d
116       CALL histwrite(nid_day,tname(iq),itau_w,z4_tmp_3d,
117     .                                   iim*jjmp1*klev,ndex3d)
118           ENDDO
119          endif
120         endif
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_day,"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_day,"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_day,"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_day,"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_day,"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      z4_tmp_3d=zx_tmp_3d
159      CALL histwrite(nid_day,"thv"//str1,itau_w,z4_tmp_3d,
160     .                                   iim*jjmp1*klev,ndex3d)
161       enddo      ! fin boucle NSPECV
162
163       do k=7,NSPECV,10
164         do i=1,klon
165         do l=1,klev
166         if(l.ne.klev)
167     s    t_khvd(i,l)=TAUHVD(i,klev-l+1,k)
168     s    -TAUHVD(i,klev-l+1-1,k)
169
170          if(l.eq.klev)
171     s    t_khvd(i,l)=TAUHVD(i,klev-l+1,k)
172
173         t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
174         enddo
175         enddo
176         write(str1,'(i2.2)') k
177      zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
178      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
179      z4_tmp_3d=zx_tmp_3d
180      CALL histwrite(nid_day,"khv"//str1,itau_w,z4_tmp_3d,
181     .                                   iim*jjmp1*klev,ndex3d)
182       enddo      ! fin boucle NSPECV
183
184       do k=7,NSPECV,10
185         do i=1,klon
186         do l=1,klev
187           t_tauhvd(i,l)=TAUGVD(i,klev-l+1,k)
188         enddo
189         enddo
190         write(str1,'(i2.2)') k
191      zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
192      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
193      z4_tmp_3d=zx_tmp_3d
194      CALL histwrite(nid_day,"tgv"//str1,itau_w,z4_tmp_3d,
195     .                                   iim*jjmp1*klev,ndex3d)
196       enddo      ! fin boucle NSPECV
197
198       do k=7,NSPECV,10
199         do i=1,klon
200         do l=1,klev
201         if(l.ne.klev)
202     s    t_khvd(i,l)=TAUGVD(i,klev-l+1,k)
203     s    -TAUGVD(i,klev-l+1-1,k)
204
205          if(l.eq.klev)
206     s    t_khvd(i,l)=TAUGVD(i,klev-l+1,k)
207
208         t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
209         enddo
210         enddo
211         write(str1,'(i2.2)') k
212      zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
213      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
214      z4_tmp_3d=zx_tmp_3d
215      CALL histwrite(nid_day,"kgv"//str1,itau_w,z4_tmp_3d,
216     .                                   iim*jjmp1*klev,ndex3d)
217       enddo      ! fin boucle NSPECV
218
219       do k=8,NSPECI,10
220         do i=1,klon
221         do l=1,klev
222           t_tauhvd(i,l)=TAUHID(i,klev-l+1,k)
223         enddo
224         enddo
225         write(str1,'(i2.2)') k
226      zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
227      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
228      z4_tmp_3d=zx_tmp_3d
229      CALL histwrite(nid_day,"thi"//str1,itau_w,z4_tmp_3d,
230     .                                   iim*jjmp1*klev,ndex3d)
231       enddo      ! fin boucle NSPECI
232
233       do k=8,NSPECI,10
234         do i=1,klon
235         do l=1,klev
236         if(l.ne.klev)
237     s    t_khvd(i,l)=TAUHID(i,klev-l+1,k)
238     s    -TAUHID(i,klev-l+1-1,k)
239
240          if(l.eq.klev)
241     s    t_khvd(i,l)=TAUHID(i,klev-l+1,k)
242
243         t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
244         enddo
245         enddo
246         write(str1,'(i2.2)') k
247      zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
248      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
249      z4_tmp_3d=zx_tmp_3d
250      CALL histwrite(nid_day,"khi"//str1,itau_w,z4_tmp_3d,
251     .                                   iim*jjmp1*klev,ndex3d)
252       enddo      ! fin boucle NSPECI
253
254       do k=8,NSPECI,10
255         do i=1,klon
256         do l=1,klev
257           t_tauhvd(i,l)=TAUGID(i,klev-l+1,k)
258         enddo
259         enddo
260         write(str1,'(i2.2)') k
261      zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
262      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
263      z4_tmp_3d=zx_tmp_3d
264      CALL histwrite(nid_day,"tgi"//str1,itau_w,z4_tmp_3d,
265     .                                   iim*jjmp1*klev,ndex3d)
266       enddo      ! fin boucle NSPECI
267
268       do k=8,NSPECI,10
269         do i=1,klon
270         do l=1,klev
271         if(l.ne.klev)
272     s    t_khvd(i,l)=TAUGID(i,klev-l+1,k)
273     s    -TAUGID(i,klev-l+1-1,k)
274
275          if(l.eq.klev)
276     s    t_khvd(i,l)=TAUGID(i,klev-l+1,k)
277
278         t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
279         enddo
280         enddo
281         write(str1,'(i2.2)') k
282      zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
283      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
284      z4_tmp_3d=zx_tmp_3d
285      CALL histwrite(nid_day,"kgi"//str1,itau_w,z4_tmp_3d,
286     .                                   iim*jjmp1*klev,ndex3d)
287       enddo      ! fin boucle NSPECI
288
289      ENDIF !lev_histday.GE.3
290c
291c-------------------------------------------------------
292      IF(lev_histday.GE.4) THEN
293c
294      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_dyn, zx_tmp_3d)
295      CALL histwrite(nid_day,"dtdyn",itau_w,zx_tmp_3d,
296     .                                   iim*jjmp1*klev,ndex3d)
297c
298      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t, zx_tmp_3d)
299      CALL histwrite(nid_day,"dtphy",itau_w,zx_tmp_3d,
300     .                                   iim*jjmp1*klev,ndex3d)
301c K/s
302      zx_tmp_fi3d(1:klon,1:klev)=d_t_vdf(1:klon,1:klev)
303      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
304      CALL histwrite(nid_day,"dtvdf",itau_w,zx_tmp_3d,
305     .                                   iim*jjmp1*klev,ndex3d)
306c
307c K/s
308      zx_tmp_fi3d(1:klon,1:klev)=d_t_ajs(1:klon,1:klev)
309      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
310      CALL histwrite(nid_day,"dtajs",itau_w,zx_tmp_3d,
311     .                                   iim*jjmp1*klev,ndex3d)
312c
313c K/s
314      zx_tmp_fi3d(1:klon,1:klev)=heat(1:klon,1:klev)
315      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
316      CALL histwrite(nid_day,"dtswr",itau_w,zx_tmp_3d,
317     .                                   iim*jjmp1*klev,ndex3d)
318c
319c K/s     
320      zx_tmp_fi3d(1:klon,1:klev)=-1.*cool(1:klon,1:klev)
321      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
322      CALL histwrite(nid_day,"dtlwr",itau_w,zx_tmp_3d,
323     .                                   iim*jjmp1*klev,ndex3d)
324c K/s     
325c     zx_tmp_fi3d(1:klon,1:klev)=d_t_ec(1:klon,1:klev)
326c     CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
327c     CALL histwrite(nid_day,"dtec",itau_w,zx_tmp_3d,
328c    .                                   iim*jjmp1*klev,ndex3d)
329c
330      ENDIF !lev_histday.GE.4
331c
332c-------------------------------------------------------
333      IF(lev_histday.GE.5) THEN
334c
335c
336c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxu , zx_tmp_2d)
337c      CALL histwrite(nid_day,"taux_",itau_w,
338c    $      zx_tmp_2d,iim*jjmp1,ndex2d) 
339c     
340c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxv , zx_tmp_2d)
341c      CALL histwrite(nid_day,"tauy_",itau_w,
342c    $      zx_tmp_2d,iim*jjmp1,ndex2d)
343c
344c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
345c     CALL histwrite(nid_day,"cdrm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
346c
347c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
348c     CALL histwrite(nid_day,"cdrh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
349c
350      ENDIF !lev_histday.GE.5
351c-------------------------------------------------------
352c
353      if (ok_sync) then
354        call histsync(nid_day)
355      endif
356
357      ENDIF
Note: See TracBrowser for help on using the repository browser.