source: trunk/LMDZ.TITAN/libf/phytitan/write_histins.h @ 881

Last change on this file since 881 was 808, checked in by slebonnois, 12 years ago

SL: Many changes for VENUS (related to newstart) and TITAN (related to clouds). Please read DOC/chantiers/commit_importants.log (cf v808).
File size: 12.2 KB
Line 
1!
2! $Header: /home/cvsroot/LMDZ4/libf/phylmd/write_histins.h,v 1.1.1.1 2004/05/19 12:53:09 lmdzadmin Exp $
3!
4      IF (ok_instan) 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 * FLOAT(ecrit_ins)
14          zout = dtime * FLOAT(ecrit_ins)
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_ins,"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_ins,"aire",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
28c
29ccccccc axe Ls ... Faudrait le reduire a axe temporel seulement...
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_ins,"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_ins,"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_ins,"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_ins,"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_ins,"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_ins,"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_ins,"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_ins,"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_ins,"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_ins,"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_ins,"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_ins,"tops",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
87c
88c     CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_vdf, zx_tmp_3d)
89c     CALL histwrite(nid_ins,"duvdf",itau_w,zx_tmp_3d,
90c    .                                   iim*jjmp1*klev,ndex3d)
91c
92c     CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_dyn, zx_tmp_3d)
93c     CALL histwrite(nid_ins,"dudyn",itau_w,zx_tmp_3d,
94c    .                                   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       CALL histwrite(nid_ins,tname(iq),itau_w,zx_tmp_3d,
108     .                                   iim*jjmp1*klev,ndex3d)
109           ENDDO
110          endif
111          if (nmicro.lt.nqmax) then
112           DO iq=nmicro+1,nqmax
113       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,tr_seri(1,1,iq),zx_tmp_3d)
114       CALL histwrite(nid_ins,tname(iq),itau_w,zx_tmp_3d,
115     .                                   iim*jjmp1*klev,ndex3d)
116           ENDDO
117          endif
118         endif
119c
120cccccccccccccccccc  Radiative transfer
121c
122c 2D
123c
124      CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
125      CALL histwrite(nid_ins,"topl",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
126c
127      CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
128      CALL histwrite(nid_ins,"sols",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
129c
130      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
131      CALL histwrite(nid_ins,"soll",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
132c
133c 3D
134c
135      zx_tmp_fi3d(1:klon,1:klev)=swnet(1:klon,1:klev)
136      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
137      CALL histwrite(nid_ins,"SWnet",itau_w,zx_tmp_3d,
138     .                                   iim*jjmp1*klev,ndex3d)
139c
140      zx_tmp_fi3d(1:klon,1:klev)=lwnet(1:klon,1:klev)
141      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
142      CALL histwrite(nid_ins,"LWnet",itau_w,zx_tmp_3d,
143     .                                   iim*jjmp1*klev,ndex3d)
144c
145c --------------
146c ----- OPACITE BRUME
147       do k=7,NSPECV,10
148         do i=1,klon
149         do l=1,klev
150           t_tauhvd(i,l)=TAUHVD(i,klev-l+1,k)
151         enddo
152         enddo
153         write(str1,'(i2.2)') k
154      zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
155      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
156      CALL histwrite(nid_ins,"thv"//str1,itau_w,zx_tmp_3d,
157     .                                   iim*jjmp1*klev,ndex3d)
158       enddo      ! fin boucle NSPECV
159
160       do k=8,NSPECI,10
161         do i=1,klon
162         do l=1,klev
163           t_tauhvd(i,l)=TAUHID(i,klev-l+1,k)
164         enddo
165         enddo
166         write(str1,'(i2.2)') k
167      zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
168      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
169      CALL histwrite(nid_ins,"thi"//str1,itau_w,zx_tmp_3d,
170     .                                   iim*jjmp1*klev,ndex3d)
171       enddo      ! fin boucle NSPECI
172c --------------
173c ----- EXTINCTION BRUME
174       do k=7,NSPECV,10
175         do i=1,klon
176         do l=1,klev
177          if(l.ne.klev)
178     s     t_khvd(i,l)=TAUHVD(i,klev-l+1,k)
179     s                -TAUHVD(i,klev-l+1-1,k)
180
181          if(l.eq.klev)
182     s     t_khvd(i,l)=TAUHVD(i,klev-l+1,k)
183
184         t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
185         enddo
186         enddo
187         write(str1,'(i2.2)') k
188      zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
189      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
190      CALL histwrite(nid_ins,"khv"//str1,itau_w,zx_tmp_3d,
191     .                                   iim*jjmp1*klev,ndex3d)
192       enddo      ! fin boucle NSPECV
193
194       do k=8,NSPECI,10
195         do i=1,klon
196         do l=1,klev
197          if(l.ne.klev)
198     s     t_khvd(i,l)=TAUHID(i,klev-l+1,k)
199     s                -TAUHID(i,klev-l+1-1,k)
200
201          if(l.eq.klev)
202     s     t_khvd(i,l)=TAUHID(i,klev-l+1,k)
203
204         t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
205         enddo
206         enddo
207         write(str1,'(i2.2)') k
208      zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
209      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
210      CALL histwrite(nid_ins,"khi"//str1,itau_w,zx_tmp_3d,
211     .                                   iim*jjmp1*klev,ndex3d)
212       enddo      ! fin boucle NSPECI
213c --------------
214c ----- OPACITE GAZ
215       do k=7,NSPECV,10
216         do i=1,klon
217         do l=1,klev
218           t_tauhvd(i,l)=TAUGVD(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_ins,"tgv"//str1,itau_w,zx_tmp_3d,
225     .                                   iim*jjmp1*klev,ndex3d)
226       enddo      ! fin boucle NSPECV
227
228       do k=8,NSPECI,10
229         do i=1,klon
230         do l=1,klev
231           t_tauhvd(i,l)=TAUGID(i,klev-l+1,k)
232         enddo
233         enddo
234         write(str1,'(i2.2)') k
235      zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
236      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
237      CALL histwrite(nid_ins,"tgi"//str1,itau_w,zx_tmp_3d,
238     .                                   iim*jjmp1*klev,ndex3d)
239       enddo      ! fin boucle NSPECI
240c --------------
241c ----- EXTINCTION GAZ
242       do k=7,NSPECV,10
243         do i=1,klon
244         do l=1,klev
245          if(l.ne.klev)
246     s     t_khvd(i,l)=TAUGVD(i,klev-l+1,k)
247     s                -TAUGVD(i,klev-l+1-1,k)
248
249          if(l.eq.klev)
250     s     t_khvd(i,l)=TAUGVD(i,klev-l+1,k)
251
252         t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
253         enddo
254         enddo
255         write(str1,'(i2.2)') k
256      zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
257      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
258      CALL histwrite(nid_ins,"kgv"//str1,itau_w,zx_tmp_3d,
259     .                                   iim*jjmp1*klev,ndex3d)
260       enddo      ! fin boucle NSPECV
261
262       do k=8,NSPECI,10
263         do i=1,klon
264         do l=1,klev
265          if(l.ne.klev)
266     s     t_khvd(i,l)=TAUGID(i,klev-l+1,k)
267     s                -TAUGID(i,klev-l+1-1,k)
268
269          if(l.eq.klev)
270     s     t_khvd(i,l)=TAUGID(i,klev-l+1,k)
271
272         t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
273         enddo
274         enddo
275         write(str1,'(i2.2)') k
276      zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
277      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
278      CALL histwrite(nid_ins,"kgi"//str1,itau_w,zx_tmp_3d,
279     .                                   iim*jjmp1*klev,ndex3d)
280       enddo      ! fin boucle NSPECI
281
282      ENDIF !lev_histday.GE.3
283c
284c-------------------------------------------------------
285      IF(lev_histday.GE.4) THEN
286c
287      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_dyn, zx_tmp_3d)
288      CALL histwrite(nid_ins,"dtdyn",itau_w,zx_tmp_3d,
289     .                                   iim*jjmp1*klev,ndex3d)
290c
291      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t, zx_tmp_3d)
292      CALL histwrite(nid_ins,"dtphy",itau_w,zx_tmp_3d,
293     .                                   iim*jjmp1*klev,ndex3d)
294c K/s
295      zx_tmp_fi3d(1:klon,1:klev)=d_t_vdf(1:klon,1:klev)
296      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
297      CALL histwrite(nid_ins,"dtvdf",itau_w,zx_tmp_3d,
298     .                                   iim*jjmp1*klev,ndex3d)
299c
300c K/s
301      zx_tmp_fi3d(1:klon,1:klev)=d_t_ajs(1:klon,1:klev)
302      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
303      CALL histwrite(nid_ins,"dtajs",itau_w,zx_tmp_3d,
304     .                                   iim*jjmp1*klev,ndex3d)
305c
306c K/s
307      zx_tmp_fi3d(1:klon,1:klev)=heat(1:klon,1:klev)
308      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
309      CALL histwrite(nid_ins,"dtswr",itau_w,zx_tmp_3d,
310     .                                   iim*jjmp1*klev,ndex3d)
311c
312c K/s     
313      zx_tmp_fi3d(1:klon,1:klev)=-1.*cool(1:klon,1:klev)
314      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
315      CALL histwrite(nid_ins,"dtlwr",itau_w,zx_tmp_3d,
316     .                                   iim*jjmp1*klev,ndex3d)
317c K/s     
318c     zx_tmp_fi3d(1:klon,1:klev)=d_t_ec(1:klon,1:klev)
319c     CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
320c     CALL histwrite(nid_ins,"dtec",itau_w,zx_tmp_3d,
321c    .                                   iim*jjmp1*klev,ndex3d)
322c
323c     CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_vdf, zx_tmp_3d)
324c     CALL histwrite(nid_ins,"dvvdf",itau_w,zx_tmp_3d,
325c    .                                   iim*jjmp1*klev,ndex3d)
326c
327      ENDIF !lev_histday.GE.4
328c
329c-------------------------------------------------------
330      IF(lev_histday.GE.5) THEN
331c
332c
333c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxu , zx_tmp_2d)
334c      CALL histwrite(nid_ins,"taux_",itau_w,
335c    $      zx_tmp_2d,iim*jjmp1,ndex2d) 
336c     
337c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxv , zx_tmp_2d)
338c      CALL histwrite(nid_ins,"tauy_",itau_w,
339c    $      zx_tmp_2d,iim*jjmp1,ndex2d)
340c
341c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
342c     CALL histwrite(nid_ins,"cdrm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
343c
344c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
345c     CALL histwrite(nid_ins,"cdrh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
346c
347      ENDIF !lev_histday.GE.5
348c-------------------------------------------------------
349c
350      if (ok_sync) then
351        call histsync(nid_ins)
352      endif
353      ENDIF
Note: See TracBrowser for help on using the repository browser.