source: trunk/LMDZ.TITAN/libf/phytitan/write_histday.h @ 1461

Last change on this file since 1461 was 1056, checked in by slebonnois, 11 years ago

SL: Titan runs ! see DOC/chantiers/commit_importants.log
File size: 11.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
5
6         zsto = dtime
7         zout = dtime * REAL(ecrit_day)
8         itau_w = itau_phy + itap
9
10c-------------------------------------------------------
11      IF(lev_histday.GE.1) THEN
12
13ccccccccccccc 2D fields, invariables
14
15      call histwrite_phy(nid_day,.false.,"phis",itau_w,pphis)
16      call histwrite_phy(nid_day,.false.,"aire",itau_w,airephy)
17
18ccccccc axe Ls ... Faudrait le reduire a axe temporel seulement...
19c Correction passage de 360 a 0... Sinon probleme avec moyenne
20      if (zls.lt.zlsm1) then
21        do i=1,klon
22          tmpout(i,1) = zls*180./RPI+360.
23        enddo
24        zlsm1 = 2.*RPI
25      else
26        do i=1,klon
27          tmpout(i,1) = zls*180./RPI
28        enddo
29        zlsm1 = zls
30      endif
31      call histwrite_phy(nid_day,.false.,"ls",itau_w,tmpout(:,1))
32
33ccccccccccccc 2D fields, variables
34
35      call histwrite_phy(nid_day,.false.,"tsol",itau_w,ftsol)
36      call histwrite_phy(nid_day,.false.,"psol",itau_w,paprs(:,1))
37
38c     call histwrite_phy(nid_day,.false.,"ue",itau_w,ue)
39c     call histwrite_phy(nid_day,.false.,"ve",itau_w,ve)
40
41      ENDIF !lev_histday.GE.1
42
43c-------------------------------------------------------
44      IF(lev_histday.GE.2) THEN
45
46ccccccccccccc 3D fields, basics
47
48      call histwrite_phy(nid_day,.false.,"temp",itau_w,t_seri)
49      call histwrite_phy(nid_day,.false.,"pres",itau_w,pplay)
50      call histwrite_phy(nid_day,.false.,"geop",itau_w,zphi)
51      call histwrite_phy(nid_day,.false.,"vitu",itau_w,u_seri)
52      call histwrite_phy(nid_day,.false.,"vitv",itau_w,v_seri)
53      call histwrite_phy(nid_day,.false.,"vitw",itau_w,omega)
54      call histwrite_phy(nid_day,.false.,"tops",itau_w,topsw)
55      call histwrite_phy(nid_day,.false.,"duvdf",itau_w,d_u_vdf)
56      call histwrite_phy(nid_day,.false.,"dudyn",itau_w,d_u_dyn)
57
58cccccccccccccccccc  Tracers
59
60         if (iflag_trac.eq.1) THEN
61          if (microfi.ge.1) then
62c          DO iq=1,nmicro
63c      call histwrite_phy(nid_day,.false.,tname(iq),
64c    .                    itau_w,qaer(1:klon,1:klev,iq))
65c          ENDDO
66c    -------   NB AER TOT
67               do i=1,klon
68                 do j=1,klev
69                   tmpout(i,j)= SUM(qaer(i,j,1:nrad))
70                 enddo
71               enddo
72       call histwrite_phy(nid_day,.false.,"qaer",itau_w,tmpout)
73
74             if (clouds.eq.1) then
75c    -------   NB NOY TOT
76               do i=1,klon
77                 do j=1,klev
78                   tmpout(i,j)= SUM(qaer(i,j,nrad+1:2*nrad))
79                 enddo
80               enddo
81       call histwrite_phy(nid_day,.false.,"qnoy",itau_w,tmpout)
82c    -------   V GLA1 TOT
83               do i=1,klon
84                 do j=1,klev
85                   tmpout(i,j)= SUM(qaer(i,j,2*nrad+1:3*nrad))
86                 enddo
87               enddo
88       call histwrite_phy(nid_day,.false.,"qgl1",itau_w,tmpout)
89c    -------   V GLA2 TOT
90               do i=1,klon
91                 do j=1,klev
92                   tmpout(i,j)= SUM(qaer(i,j,3*nrad+1:4*nrad))
93                 enddo
94               enddo
95       call histwrite_phy(nid_day,.false.,"qgl2",itau_w,tmpout)
96c    -------   V GLA3 TOT
97               do i=1,klon
98                 do j=1,klev
99                   tmpout(i,j)= SUM(qaer(i,j,4*nrad+1:5*nrad))
100                 enddo
101               enddo
102       call histwrite_phy(nid_day,.false.,"qgl3",itau_w,tmpout)
103c --------------
104c ----- SATURATION ESP NUAGES
105       call histwrite_phy(nid_day,.false.,"ch4sat",itau_w,satch4)
106       call histwrite_phy(nid_day,.false.,"c2h6sat",itau_w,satc2h6)
107       call histwrite_phy(nid_day,.false.,"c2h2sat",itau_w,satc2h2)
108c --------------
109c ----- RESERVOIR DE SURFACE
110       call histwrite_phy(nid_day,.false.,"reserv",itau_w,reservoir)
111c --------------
112c ----- ECHANGE GAZ SURF/ATM (evaporation)
113       call histwrite_phy(nid_day,.false.,"evapch4",itau_w,evapch4)
114c --------------
115c ----- PRECIPITATIONS
116c       -----  CH4
117       call histwrite_phy(nid_day,.false.,"prech4",
118     .            itau_w,precip(1:klon,1))
119c       -----  C2H6
120       call histwrite_phy(nid_day,.false.,"prec2h6",
121     .            itau_w,precip(1:klon,2))
122c       -----  C2H2
123       call histwrite_phy(nid_day,.false.,"prec2h2",
124     .            itau_w,precip(1:klon,3))
125c       -----  NOY
126       call histwrite_phy(nid_day,.false.,"prenoy",
127     .            itau_w,precip(1:klon,4))
128c       -----  AER
129       call histwrite_phy(nid_day,.false.,"preaer",
130     .            itau_w,precip(1:klon,5))
131c --------------
132c ----- FLUX GLACE
133c       -----  CH4
134       call histwrite_phy(nid_day,.false.,"flxgl1",
135     .            itau_w,flxesp_i(1:klon,1:klev,1))
136c       -----  C2H6
137       call histwrite_phy(nid_day,.false.,"flxgl2",
138     .            itau_w,flxesp_i(1:klon,1:klev,2))
139c       -----  C2H2
140       call histwrite_phy(nid_day,.false.,"flxgl3",
141     .            itau_w,flxesp_i(1:klon,1:klev,3))
142c --------------
143c ----- Source/puits GLACE
144c       -----  CH4
145       call histwrite_phy(nid_day,.false.,"solch4",
146     .            itau_w,solesp(1:klon,1:klev,1))
147c       -----  C2H6
148       call histwrite_phy(nid_day,.false.,"solc2h6",
149     .            itau_w,solesp(1:klon,1:klev,2))
150c       -----  C2H2
151       call histwrite_phy(nid_day,.false.,"solc2h2",
152     .            itau_w,solesp(1:klon,1:klev,3))
153c --------------
154c ----- RAYON MOYEN GOUTTE
155       call histwrite_phy(nid_day,.false.,"rcldbar",itau_w,rmcloud)
156
157             endif
158          endif
159
160c --------------
161c ----- TRACEURS CHIMIQUES
162          if (nmicro.lt.nqmax) then
163           DO iq=nmicro+1,nqmax
164       call histwrite_phy(nid_day,.false.,tname(iq),
165     .                    itau_w,tr_seri(1:klon,1:klev,iq))
166           ENDDO
167          endif
168         endif
169
170      ENDIF !lev_histday.GE.2
171
172c-------------------------------------------------------
173      IF(lev_histday.GE.3) THEN
174
175cccccccccccccccccc  Radiative transfer
176
177c 2D
178
179      call histwrite_phy(nid_day,.false.,"topl",itau_w,toplw)
180      call histwrite_phy(nid_day,.false.,"sols",itau_w,solsw)
181      call histwrite_phy(nid_day,.false.,"soll",itau_w,sollw)
182
183c 3D
184
185      call histwrite_phy(nid_day,.false.,"SWnet",
186     .          itau_w,swnet(1:klon,1:klev))
187      call histwrite_phy(nid_day,.false.,"LWnet",
188     .          itau_w,lwnet(1:klon,1:klev))
189
190c --------------
191c ----- OPACITE BRUME
192       do k=7,NSPECV,10
193         do i=1,klon
194         do l=1,klev
195           t_tauhvd(i,l)=TAUHVD(i,klev-l+1,k)
196         enddo
197         enddo
198         write(str2,'(i2.2)') k
199       call histwrite_phy(nid_day,.false.,"thv"//str2,itau_w,t_tauhvd)
200       enddo      ! fin boucle NSPECV
201
202       do k=8,NSPECI,10
203         do i=1,klon
204         do l=1,klev
205           t_tauhvd(i,l)=TAUHID(i,klev-l+1,k)
206         enddo
207         enddo
208         write(str2,'(i2.2)') k
209       call histwrite_phy(nid_day,.false.,"thi"//str2,itau_w,t_tauhvd)
210       enddo      ! fin boucle NSPECI
211c --------------
212c ----- EXTINCTION BRUME
213       do k=7,NSPECV,10
214         do i=1,klon
215         do l=1,klev
216          if(l.ne.klev)
217     s     t_khvd(i,l)=TAUHVD(i,klev-l+1,k)
218     s                -TAUHVD(i,klev-l+1-1,k)
219          if(l.eq.klev)
220     s     t_khvd(i,l)=TAUHVD(i,klev-l+1,k)
221
222         t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
223         enddo
224         enddo
225         write(str2,'(i2.2)') k
226       call histwrite_phy(nid_day,.false.,"khv"//str2,itau_w,t_khvd)
227       enddo      ! fin boucle NSPECV
228
229       do k=8,NSPECI,10
230         do i=1,klon
231         do l=1,klev
232          if(l.ne.klev)
233     s     t_khvd(i,l)=TAUHID(i,klev-l+1,k)
234     s                -TAUHID(i,klev-l+1-1,k)
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(str2,'(i2.2)') k
242       call histwrite_phy(nid_day,.false.,"khi"//str2,itau_w,t_khvd)
243       enddo      ! fin boucle NSPECI
244c --------------
245c ----- OPACITE GAZ
246       do k=7,NSPECV,10
247         do i=1,klon
248         do l=1,klev
249           t_tauhvd(i,l)=TAUGVD(i,klev-l+1,k)
250         enddo
251         enddo
252         write(str2,'(i2.2)') k
253       call histwrite_phy(nid_day,.false.,"tgv"//str2,itau_w,t_tauhvd)
254       enddo      ! fin boucle NSPECV
255
256       do k=8,NSPECI,10
257         do i=1,klon
258         do l=1,klev
259           t_tauhvd(i,l)=TAUGID(i,klev-l+1,k)
260         enddo
261         enddo
262         write(str2,'(i2.2)') k
263       call histwrite_phy(nid_day,.false.,"tgi"//str2,itau_w,t_tauhvd)
264       enddo      ! fin boucle NSPECI
265c --------------
266c ----- EXTINCTION GAZ
267       do k=7,NSPECV,10
268         do i=1,klon
269         do l=1,klev
270          if(l.ne.klev)
271     s     t_khvd(i,l)=TAUGVD(i,klev-l+1,k)
272     s                -TAUGVD(i,klev-l+1-1,k)
273          if(l.eq.klev)
274     s     t_khvd(i,l)=TAUGVD(i,klev-l+1,k)
275
276         t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
277         enddo
278         enddo
279         write(str2,'(i2.2)') k
280       call histwrite_phy(nid_day,.false.,"kgv"//str2,itau_w,t_khvd)
281       enddo      ! fin boucle NSPECV
282
283       do k=8,NSPECI,10
284         do i=1,klon
285         do l=1,klev
286          if(l.ne.klev)
287     s     t_khvd(i,l)=TAUGID(i,klev-l+1,k)
288     s                -TAUGID(i,klev-l+1-1,k)
289
290          if(l.eq.klev)
291     s     t_khvd(i,l)=TAUGID(i,klev-l+1,k)
292
293         t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
294         enddo
295         enddo
296         write(str2,'(i2.2)') k
297       call histwrite_phy(nid_day,.false.,"kgi"//str2,itau_w,t_khvd)
298       enddo      ! fin boucle NSPECI
299
300c --------------
301         if (clouds.eq.1) then
302c --------------
303c ----- OPACITE NUAGES (ATTENTION PROXY)
304         call histwrite_phy(nid_day,.false.,"tcld",itau_w,occcld)
305c --------------
306c ----- EXTINCTION NUAGES (ATTENTION PROXY)
307           do i=1,klon
308             t_kcld(i,klev)=occcld(i,klev)
309     .       /(zzlev(i,klev+1)-zzlev(i,klev))
310             do j=klev-1,1,-1
311               t_kcld(i,j)=(occcld(i,j)-occcld(i,j+1))
312     .         /(zzlev(i,j+1)-zzlev(i,j))
313             enddo
314           enddo
315         call histwrite_phy(nid_day,.false.,"kcld",itau_w,t_kcld)
316c --------------
317        endif 
318c --------------
319
320      ENDIF !lev_histday.GE.3
321
322c-------------------------------------------------------
323      IF(lev_histday.GE.4) THEN
324
325      call histwrite_phy(nid_day,.false.,"dtdyn",itau_w,d_t_dyn)
326      call histwrite_phy(nid_day,.false.,"dtphy",itau_w,d_t)
327c K/s
328      call histwrite_phy(nid_day,.false.,"dtvdf",itau_w,d_t_vdf)
329c K/s
330      call histwrite_phy(nid_day,.false.,"dtajs",itau_w,d_t_ajs)
331c K/s
332      call histwrite_phy(nid_day,.false.,"dtswr",itau_w,heat)
333c K/s
334      call histwrite_phy(nid_day,.false.,"dtlwr",itau_w,-1.*cool)
335c K/s     
336c      call histwrite_phy(nid_day,.false.,"dtec",itau_w,d_t_ec)
337
338      ENDIF !lev_histday.GE.4
339
340c-------------------------------------------------------
341      IF(lev_histday.GE.5) THEN
342
343c      call histwrite_phy(nid_day,.false.,"taux",itau_w,fluxu)
344c      call histwrite_phy(nid_day,.false.,"tauy",itau_w,fluxv)
345c      call histwrite_phy(nid_day,.false.,"cdrm",itau_w,cdragm)
346c      call histwrite_phy(nid_day,.false.,"cdrh",itau_w,cdragh)
347
348      ENDIF !lev_histday.GE.5
349c-------------------------------------------------------
350
351      if (ok_sync) then
352        call histsync(nid_day)
353      endif
354
355      ENDIF
Note: See TracBrowser for help on using the repository browser.