source: trunk/LMDZ.TITAN/libf/phytitan/write_histmth.h @ 1056

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

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