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

Last change on this file since 2935 was 1572, checked in by emillour, 10 years ago

All GCMs:
Further adaptations to keep up with changes in LMDZ5 concerning
physics/dynamics separation (up to rev r2500 of LMDZ5)

  • arch:
  • remove ifort debug option '-check all', replace it with '-check bounds,format,output_conversion,pointers,uninit' (i.e. get it to stop complaining about copying into temporary arrays)
  • dyn3d_common:
  • comconst_mod.F90 : add ngroup
  • dyn3d:
  • gcm.F90 : minor bug fix (arguments to a call_abort())
  • leapfrog.F90 : recompute geopotential for bilan_dyn outputs
  • conf_gcm.F90 : read "ngroup" from run.def
  • groupe.F , groupeun.F : ngroup no longer a local parameter
  • dyn3d_par:
  • conf_gcm.F90 : read "ngroup" from run.def
  • groupe_p.F , groupeun_p.F : ngroup no longer a local parameter
  • misc:
  • regr1_step_av_m.F90 : removed (not used)
  • phy_common:
  • mod_phys_lmdz_mpi_transfert.F90 , mod_phys_lmdz_mpi_data.F90 : change is_north_pole and is_south_pole to is_north_pole_dyn and is_south_pole_dyn
  • mod_phys_lmdz_omp_data.F90 : introduce is_nort_pole_phy and is_south_pole_phy
  • dynphy_lonlat:
  • mod_interface_dyn_phys.F90 : use is_north_pole_dyn and is_south_pole_dyn
  • calfis_p.F : use is_north_pole_dyn and is_south_pole_dyn
  • phyvenus:
  • physiq_mod , write_hist*.h : use is_north_pole_phy and is_south_pole_phy to correctly compute mesh area at poles to send to hist*nc files.
  • phytitan:
  • physiq_mod , write_hist*.h : use is_north_pole_phy and is_south_pole_phy to correctly compute mesh area at poles to send to hist*nc files.

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