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

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

SL: corrections de bugs suite a compilations venus et titan de la version 109.
File size: 12.0 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
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 3D adding Tau and k  (31/08/10)
146c
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=7,NSPECV,10
161         do i=1,klon
162         do l=1,klev
163         if(l.ne.klev)
164     s    t_khvd(i,l)=TAUHVD(i,klev-l+1,k)
165     s    -TAUHVD(i,klev-l+1-1,k)
166
167          if(l.eq.klev)
168     s    t_khvd(i,l)=TAUHVD(i,klev-l+1,k)
169
170         t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
171         enddo
172         enddo
173         write(str1,'(i2.2)') k
174      zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
175      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
176      CALL histwrite(nid_ins,"khv"//str1,itau_w,zx_tmp_3d,
177     .                                   iim*jjmp1*klev,ndex3d)
178       enddo      ! fin boucle NSPECV
179
180       do k=7,NSPECV,10
181         do i=1,klon
182         do l=1,klev
183           t_tauhvd(i,l)=TAUGVD(i,klev-l+1,k)
184         enddo
185         enddo
186         write(str1,'(i2.2)') k
187      zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
188      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
189      CALL histwrite(nid_ins,"tgv"//str1,itau_w,zx_tmp_3d,
190     .                                   iim*jjmp1*klev,ndex3d)
191       enddo      ! fin boucle NSPECV
192
193       do k=7,NSPECV,10
194         do i=1,klon
195         do l=1,klev
196         if(l.ne.klev)
197     s    t_khvd(i,l)=TAUGVD(i,klev-l+1,k)
198     s    -TAUGVD(i,klev-l+1-1,k)
199
200          if(l.eq.klev)
201     s    t_khvd(i,l)=TAUGVD(i,klev-l+1,k)
202
203         t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
204         enddo
205         enddo
206         write(str1,'(i2.2)') k
207      zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
208      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
209      CALL histwrite(nid_ins,"kgv"//str1,itau_w,zx_tmp_3d,
210     .                                   iim*jjmp1*klev,ndex3d)
211       enddo      ! fin boucle NSPECV
212
213       do k=8,NSPECI,10
214         do i=1,klon
215         do l=1,klev
216           t_tauhvd(i,l)=TAUHID(i,klev-l+1,k)
217         enddo
218         enddo
219         write(str1,'(i2.2)') k
220      zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
221      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
222      CALL histwrite(nid_ins,"thi"//str1,itau_w,zx_tmp_3d,
223     .                                   iim*jjmp1*klev,ndex3d)
224       enddo      ! fin boucle NSPECI
225
226       do k=8,NSPECI,10
227         do i=1,klon
228         do l=1,klev
229         if(l.ne.klev)
230     s    t_khvd(i,l)=TAUHID(i,klev-l+1,k)
231     s    -TAUHID(i,klev-l+1-1,k)
232
233          if(l.eq.klev)
234     s    t_khvd(i,l)=TAUHID(i,klev-l+1,k)
235
236         t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
237         enddo
238         enddo
239         write(str1,'(i2.2)') k
240      zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
241      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
242      CALL histwrite(nid_ins,"khi"//str1,itau_w,zx_tmp_3d,
243     .                                   iim*jjmp1*klev,ndex3d)
244       enddo      ! fin boucle NSPECI
245
246       do k=8,NSPECI,10
247         do i=1,klon
248         do l=1,klev
249           t_tauhvd(i,l)=TAUGID(i,klev-l+1,k)
250         enddo
251         enddo
252         write(str1,'(i2.2)') k
253      zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
254      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
255      CALL histwrite(nid_ins,"tgi"//str1,itau_w,zx_tmp_3d,
256     .                                   iim*jjmp1*klev,ndex3d)
257       enddo      ! fin boucle NSPECI
258
259       do k=8,NSPECI,10
260         do i=1,klon
261         do l=1,klev
262         if(l.ne.klev)
263     s    t_khvd(i,l)=TAUGID(i,klev-l+1,k)
264     s    -TAUGID(i,klev-l+1-1,k)
265
266          if(l.eq.klev)
267     s    t_khvd(i,l)=TAUGID(i,klev-l+1,k)
268
269         t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
270         enddo
271         enddo
272         write(str1,'(i2.2)') k
273      zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
274      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
275      CALL histwrite(nid_ins,"kgi"//str1,itau_w,zx_tmp_3d,
276     .                                   iim*jjmp1*klev,ndex3d)
277       enddo      ! fin boucle NSPECI
278
279      ENDIF !lev_histday.GE.3
280c
281c-------------------------------------------------------
282      IF(lev_histday.GE.4) THEN
283c
284      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_dyn, zx_tmp_3d)
285      CALL histwrite(nid_ins,"dtdyn",itau_w,zx_tmp_3d,
286     .                                   iim*jjmp1*klev,ndex3d)
287c
288      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t, zx_tmp_3d)
289      CALL histwrite(nid_ins,"dtphy",itau_w,zx_tmp_3d,
290     .                                   iim*jjmp1*klev,ndex3d)
291c K/s
292      zx_tmp_fi3d(1:klon,1:klev)=d_t_vdf(1:klon,1:klev)
293      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
294      CALL histwrite(nid_ins,"dtvdf",itau_w,zx_tmp_3d,
295     .                                   iim*jjmp1*klev,ndex3d)
296c
297c K/s
298      zx_tmp_fi3d(1:klon,1:klev)=d_t_ajs(1:klon,1:klev)
299      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
300      CALL histwrite(nid_ins,"dtajs",itau_w,zx_tmp_3d,
301     .                                   iim*jjmp1*klev,ndex3d)
302c
303c K/s
304      zx_tmp_fi3d(1:klon,1:klev)=heat(1:klon,1:klev)
305      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
306      CALL histwrite(nid_ins,"dtswr",itau_w,zx_tmp_3d,
307     .                                   iim*jjmp1*klev,ndex3d)
308c
309c K/s     
310      zx_tmp_fi3d(1:klon,1:klev)=-1.*cool(1:klon,1:klev)
311      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
312      CALL histwrite(nid_ins,"dtlwr",itau_w,zx_tmp_3d,
313     .                                   iim*jjmp1*klev,ndex3d)
314c K/s     
315c     zx_tmp_fi3d(1:klon,1:klev)=d_t_ec(1:klon,1:klev)
316c     CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
317c     CALL histwrite(nid_ins,"dtec",itau_w,zx_tmp_3d,
318c    .                                   iim*jjmp1*klev,ndex3d)
319c
320c     CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_vdf, zx_tmp_3d)
321c     CALL histwrite(nid_ins,"dvvdf",itau_w,zx_tmp_3d,
322c    .                                   iim*jjmp1*klev,ndex3d)
323c
324      ENDIF !lev_histday.GE.4
325c
326c-------------------------------------------------------
327      IF(lev_histday.GE.5) THEN
328c
329c
330c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxu , zx_tmp_2d)
331c      CALL histwrite(nid_ins,"taux_",itau_w,
332c    $      zx_tmp_2d,iim*jjmp1,ndex2d) 
333c     
334c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxv , zx_tmp_2d)
335c      CALL histwrite(nid_ins,"tauy_",itau_w,
336c    $      zx_tmp_2d,iim*jjmp1,ndex2d)
337c
338c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
339c     CALL histwrite(nid_ins,"cdrm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
340c
341c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
342c     CALL histwrite(nid_ins,"cdrh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
343c
344      ENDIF !lev_histday.GE.5
345c-------------------------------------------------------
346c
347      if (ok_sync) then
348        call histsync(nid_ins)
349      endif
350      ENDIF
Note: See TracBrowser for help on using the repository browser.