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

Last change on this file since 1543 was 1543, checked in by emillour, 9 years ago

All models: Further adaptations to keep up with changes in LMDZ5 concerning
physics/dynamics separation:

  • dyn3d:
  • adapted gcm.F so that all physics initializations are now done in iniphysiq.
  • dyn3dpar:
  • adapted gcm.F so that all physics initializations are now done in iniphysiq.
  • updated calfis_p.F to follow up with changes.
  • copied over updated "bands.F90" from LMDZ5.
  • dynphy_lonlat:
  • calfis_p.F90, mod_interface_dyn_phys.F90, follow up of changes in phy_common/mod_* routines
  • phy_common:
  • added "geometry_mod.F90" to store information about the grid (replaces phy*/comgeomphy.F90) and give variables friendlier names: rlond => longitude , rlatd => latitude, airephy => cell_area, cuphy => dx , cvphy => dy
  • added "physics_distribution_mod.F90"
  • updated "mod_grid_phy_lmdz.F90", "mod_phys_lmdz_mpi_data.F90", "mod_phys_lmdz_para.F90", "mod_phys_lmdz_mpi_transfert.F90", "mod_grid_phy_lmdz.F90", "mod_phys_lmdz_omp_data.F90", "mod_phys_lmdz_omp_transfert.F90", "write_field_phy.F90" and "ioipsl_getin_p_mod.F90" to LMDZ5 versions.
  • phy[venus/titan/mars/std]:
  • removed "init_phys_lmdz.F90", "comgeomphy.F90"; adapted routines to use geometry_mod (longitude, latitude, cell_area, etc.)

EM
File size: 12.1 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,cell_area)
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))
190c     call histwrite_phy(nid_mth,.false.,"SWup",
191c    .          itau_w,swup(1:klon,1:klev))
192c     call histwrite_phy(nid_mth,.false.,"SWdn",
193c    .          itau_w,swdn(1:klon,1:klev))
194      call histwrite_phy(nid_mth,.false.,"LWnet",
195     .          itau_w,lwnet(1:klon,1:klev))
196c     call histwrite_phy(nid_mth,.false.,"LWup",
197c    .          itau_w,lwup(1:klon,1:klev))
198c     call histwrite_phy(nid_mth,.false.,"LWdn",
199c    .          itau_w,lwdn(1:klon,1:klev))
200      call histwrite_phy(nid_mth,.false.,"fluxvdf",itau_w,fluxt)
201      call histwrite_phy(nid_mth,.false.,"fluxdyn",itau_w,flux_dyn)
202      call histwrite_phy(nid_mth,.false.,"fluxajs",itau_w,flux_ajs)
203c     call histwrite_phy(nid_mth,.false.,"fluxec",itau_w,flux_ec)
204
205c --------------
206c ----- OPACITE BRUME
207       do k=7,NSPECV,10
208         do i=1,klon
209         do l=1,klev
210           t_tauhvd(i,l)=TAUHVD(i,klev-l+1,k)
211         enddo
212         enddo
213         write(str2,'(i2.2)') k
214       call histwrite_phy(nid_mth,.false.,"thv"//str2,itau_w,t_tauhvd)
215       enddo      ! fin boucle NSPECV
216
217       do k=8,NSPECI,10
218         do i=1,klon
219         do l=1,klev
220           t_tauhvd(i,l)=TAUHID(i,klev-l+1,k)
221         enddo
222         enddo
223         write(str2,'(i2.2)') k
224       call histwrite_phy(nid_mth,.false.,"thi"//str2,itau_w,t_tauhvd)
225       enddo      ! fin boucle NSPECI
226c --------------
227c ----- EXTINCTION BRUME
228       do k=7,NSPECV,10
229         do i=1,klon
230         do l=1,klev
231          if(l.ne.klev)
232     s     t_khvd(i,l)=TAUHVD(i,klev-l+1,k)
233     s                -TAUHVD(i,klev-l+1-1,k)
234          if(l.eq.klev)
235     s     t_khvd(i,l)=TAUHVD(i,klev-l+1,k)
236
237         t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
238         enddo
239         enddo
240         write(str2,'(i2.2)') k
241       call histwrite_phy(nid_mth,.false.,"khv"//str2,itau_w,t_khvd)
242       enddo      ! fin boucle NSPECV
243
244       do k=8,NSPECI,10
245         do i=1,klon
246         do l=1,klev
247          if(l.ne.klev)
248     s     t_khvd(i,l)=TAUHID(i,klev-l+1,k)
249     s                -TAUHID(i,klev-l+1-1,k)
250          if(l.eq.klev)
251     s     t_khvd(i,l)=TAUHID(i,klev-l+1,k)
252
253         t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
254         enddo
255         enddo
256         write(str2,'(i2.2)') k
257       call histwrite_phy(nid_mth,.false.,"khi"//str2,itau_w,t_khvd)
258       enddo      ! fin boucle NSPECI
259c --------------
260c ----- OPACITE GAZ
261       do k=7,NSPECV,10
262         do i=1,klon
263         do l=1,klev
264           t_tauhvd(i,l)=TAUGVD(i,klev-l+1,k)
265         enddo
266         enddo
267         write(str2,'(i2.2)') k
268       call histwrite_phy(nid_mth,.false.,"tgv"//str2,itau_w,t_tauhvd)
269       enddo      ! fin boucle NSPECV
270
271       do k=8,NSPECI,10
272         do i=1,klon
273         do l=1,klev
274           t_tauhvd(i,l)=TAUGID(i,klev-l+1,k)
275         enddo
276         enddo
277         write(str2,'(i2.2)') k
278       call histwrite_phy(nid_mth,.false.,"tgi"//str2,itau_w,t_tauhvd)
279       enddo      ! fin boucle NSPECI
280c --------------
281c ----- EXTINCTION GAZ
282       do k=7,NSPECV,10
283         do i=1,klon
284         do l=1,klev
285          if(l.ne.klev)
286     s     t_khvd(i,l)=TAUGVD(i,klev-l+1,k)
287     s                -TAUGVD(i,klev-l+1-1,k)
288          if(l.eq.klev)
289     s     t_khvd(i,l)=TAUGVD(i,klev-l+1,k)
290
291         t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
292         enddo
293         enddo
294         write(str2,'(i2.2)') k
295       call histwrite_phy(nid_mth,.false.,"kgv"//str2,itau_w,t_khvd)
296       enddo      ! fin boucle NSPECV
297
298       do k=8,NSPECI,10
299         do i=1,klon
300         do l=1,klev
301          if(l.ne.klev)
302     s     t_khvd(i,l)=TAUGID(i,klev-l+1,k)
303     s                -TAUGID(i,klev-l+1-1,k)
304
305          if(l.eq.klev)
306     s     t_khvd(i,l)=TAUGID(i,klev-l+1,k)
307
308         t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
309         enddo
310         enddo
311         write(str2,'(i2.2)') k
312       call histwrite_phy(nid_mth,.false.,"kgi"//str2,itau_w,t_khvd)
313       enddo      ! fin boucle NSPECI
314
315c --------------
316         if (clouds.eq.1) then
317c --------------
318c ----- OPACITE NUAGES (ATTENTION PROXY)
319         call histwrite_phy(nid_mth,.false.,"tcld",itau_w,occcld)
320c --------------
321c ----- EXTINCTION NUAGES (ATTENTION PROXY)
322           do i=1,klon
323             t_kcld(i,klev)=occcld(i,klev)
324     .       /(zzlev(i,klev+1)-zzlev(i,klev))
325             do j=klev-1,1,-1
326               t_kcld(i,j)=(occcld(i,j)-occcld(i,j+1))
327     .         /(zzlev(i,j+1)-zzlev(i,j))
328             enddo
329           enddo
330         call histwrite_phy(nid_mth,.false.,"kcld",itau_w,t_kcld)
331c --------------
332c ----- OCCURENCE NUAGES
333           do k=1,12
334             write(str2,'(i2.2)') k
335        call histwrite_phy(nid_mth,.false.,"occcld"//str2,
336     .          itau_w,occcld_m(1:klon,1:klev,k))
337           enddo
338c --------------
339        endif 
340c --------------
341
342      ENDIF !lev_histmth.GE.3
343
344c-------------------------------------------------------
345      IF(lev_histmth.GE.4) THEN
346
347      call histwrite_phy(nid_mth,.false.,"dtdyn",itau_w,d_t_dyn)
348      call histwrite_phy(nid_mth,.false.,"dtphy",itau_w,d_t)
349c K/s
350      call histwrite_phy(nid_mth,.false.,"dtvdf",itau_w,d_t_vdf)
351c K/s
352      call histwrite_phy(nid_mth,.false.,"dtajs",itau_w,d_t_ajs)
353c K/s
354      call histwrite_phy(nid_mth,.false.,"dtswr",itau_w,heat)
355c K/s
356      call histwrite_phy(nid_mth,.false.,"dtlwr",itau_w,-1.*cool)
357c K/s     
358c      call histwrite_phy(nid_mth,.false.,"dtec",itau_w,d_t_ec)
359c      call histwrite_phy(nid_mth,.false.,"dvvdf",itau_w,d_v_vdf)
360
361      ENDIF !lev_histmth.GE.4
362c
363c-------------------------------------------------------
364      IF(lev_histmth.GE.5) THEN
365
366c      call histwrite_phy(nid_mth,.false.,"taux",itau_w,fluxu)
367c      call histwrite_phy(nid_mth,.false.,"tauy",itau_w,fluxv)
368c      call histwrite_phy(nid_mth,.false.,"cdrm",itau_w,cdragm)
369c      call histwrite_phy(nid_mth,.false.,"cdrh",itau_w,cdragh)
370
371      ENDIF !lev_histmth.GE.5
372c-------------------------------------------------------
373
374      if (ok_sync) then
375        call histsync(nid_mth)
376      endif
377
378      ENDIF
Note: See TracBrowser for help on using the repository browser.