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

Last change on this file since 3643 was 1572, checked in by emillour, 9 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: 7.2 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
5
6         zsto = dtime * REAL(ecrit_ins)
7         zout = dtime * REAL(ecrit_ins)
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_ins,.false.,"phis",itau_w,pphis)
16c      call histwrite_phy(nid_ins,.false.,"aire",itau_w,cell_area)
17      cell_area_out(:)=cell_area(:)
18      if (is_north_pole_phy) cell_area_out(1)=cell_area(1)/nbp_lon
19      if (is_south_pole_phy) cell_area_out(klon)=cell_area(klon)/nbp_lon
20      call histwrite_phy(nid_ins,.false.,"aire",itau_w,cell_area_out)
21
22ccccccc axe Ls ... Faudrait le reduire a axe temporel seulement...
23      do i=1,klon
24        tmpout(i,1) = zls*180./RPI
25      enddo
26      call histwrite_phy(nid_ins,.false.,"ls",itau_w,tmpout(:,1))
27
28ccccccccccccc 2D fields, variables
29
30      call histwrite_phy(nid_ins,.false.,"tsol",itau_w,ftsol)
31      call histwrite_phy(nid_ins,.false.,"psol",itau_w,paprs(:,1))
32
33c     call histwrite_phy(nid_ins,.false.,"ue",itau_w,ue)
34c     call histwrite_phy(nid_ins,.false.,"ve",itau_w,ve)
35
36      ENDIF !lev_histday.GE.1
37
38c-------------------------------------------------------
39      IF(lev_histday.GE.2) THEN
40
41ccccccccccccc 3D fields, basics
42
43      call histwrite_phy(nid_ins,.false.,"temp",itau_w,t_seri)
44      call histwrite_phy(nid_ins,.false.,"pres",itau_w,pplay)
45      call histwrite_phy(nid_ins,.false.,"geop",itau_w,zphi)
46      call histwrite_phy(nid_ins,.false.,"vitu",itau_w,u_seri)
47      call histwrite_phy(nid_ins,.false.,"vitv",itau_w,v_seri)
48      call histwrite_phy(nid_ins,.false.,"vitw",itau_w,omega)
49      call histwrite_phy(nid_ins,.false.,"tops",itau_w,topsw)
50c      call histwrite_phy(nid_ins,.false.,"duvdf",itau_w,d_u_vdf)
51c      call histwrite_phy(nid_ins,.false.,"dudyn",itau_w,d_u_dyn)
52
53      ENDIF !lev_histday.GE.2
54
55c-------------------------------------------------------
56      IF(lev_histday.GE.3) THEN
57
58cccccccccccccccccc  Tracers
59
60         if (iflag_trac.eq.1) THEN
61          if (microfi.eq.1) then
62           DO iq=1,nmicro
63       call histwrite_phy(nid_ins,.false.,tname(iq),
64     .                    itau_w,qaer(1:klon,1:klev,iq))
65           ENDDO
66          endif
67          if (nmicro.lt.nqmax) then
68           DO iq=nmicro+1,nqmax
69       call histwrite_phy(nid_ins,.false.,tname(iq),
70     .                    itau_w,tr_seri(1:klon,1:klev,iq))
71           ENDDO
72          endif
73         endif
74
75cccccccccccccccccc  Radiative transfer
76
77c 2D
78
79      call histwrite_phy(nid_ins,.false.,"topl",itau_w,toplw)
80      call histwrite_phy(nid_ins,.false.,"sols",itau_w,solsw)
81      call histwrite_phy(nid_ins,.false.,"soll",itau_w,sollw)
82
83c 3D
84
85      call histwrite_phy(nid_ins,.false.,"SWnet",
86     .          itau_w,swnet(1:klon,1:klev))
87      call histwrite_phy(nid_ins,.false.,"LWnet",
88     .          itau_w,lwnet(1:klon,1:klev))
89
90c --------------
91c ----- OPACITE BRUME
92       do k=7,NSPECV,10
93         do i=1,klon
94         do l=1,klev
95           t_tauhvd(i,l)=TAUHVD(i,klev-l+1,k)
96         enddo
97         enddo
98         write(str2,'(i2.2)') k
99       call histwrite_phy(nid_ins,.false.,"thv"//str2,itau_w,t_tauhvd)
100       enddo      ! fin boucle NSPECV
101
102       do k=8,NSPECI,10
103         do i=1,klon
104         do l=1,klev
105           t_tauhvd(i,l)=TAUHID(i,klev-l+1,k)
106         enddo
107         enddo
108         write(str2,'(i2.2)') k
109       call histwrite_phy(nid_ins,.false.,"thi"//str2,itau_w,t_tauhvd)
110       enddo      ! fin boucle NSPECI
111c --------------
112c ----- EXTINCTION BRUME
113       do k=7,NSPECV,10
114         do i=1,klon
115         do l=1,klev
116          if(l.ne.klev)
117     s     t_khvd(i,l)=TAUHVD(i,klev-l+1,k)
118     s                -TAUHVD(i,klev-l+1-1,k)
119          if(l.eq.klev)
120     s     t_khvd(i,l)=TAUHVD(i,klev-l+1,k)
121
122         t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
123         enddo
124         enddo
125         write(str2,'(i2.2)') k
126       call histwrite_phy(nid_ins,.false.,"khv"//str2,itau_w,t_khvd)
127       enddo      ! fin boucle NSPECV
128
129       do k=8,NSPECI,10
130         do i=1,klon
131         do l=1,klev
132          if(l.ne.klev)
133     s     t_khvd(i,l)=TAUHID(i,klev-l+1,k)
134     s                -TAUHID(i,klev-l+1-1,k)
135          if(l.eq.klev)
136     s     t_khvd(i,l)=TAUHID(i,klev-l+1,k)
137
138         t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
139         enddo
140         enddo
141         write(str2,'(i2.2)') k
142       call histwrite_phy(nid_ins,.false.,"khi"//str2,itau_w,t_khvd)
143       enddo      ! fin boucle NSPECI
144c --------------
145c ----- OPACITE GAZ
146       do k=7,NSPECV,10
147         do i=1,klon
148         do l=1,klev
149           t_tauhvd(i,l)=TAUGVD(i,klev-l+1,k)
150         enddo
151         enddo
152         write(str2,'(i2.2)') k
153       call histwrite_phy(nid_ins,.false.,"tgv"//str2,itau_w,t_tauhvd)
154       enddo      ! fin boucle NSPECV
155
156       do k=8,NSPECI,10
157         do i=1,klon
158         do l=1,klev
159           t_tauhvd(i,l)=TAUGID(i,klev-l+1,k)
160         enddo
161         enddo
162         write(str2,'(i2.2)') k
163       call histwrite_phy(nid_ins,.false.,"tgi"//str2,itau_w,t_tauhvd)
164       enddo      ! fin boucle NSPECI
165c --------------
166c ----- EXTINCTION GAZ
167       do k=7,NSPECV,10
168         do i=1,klon
169         do l=1,klev
170          if(l.ne.klev)
171     s     t_khvd(i,l)=TAUGVD(i,klev-l+1,k)
172     s                -TAUGVD(i,klev-l+1-1,k)
173          if(l.eq.klev)
174     s     t_khvd(i,l)=TAUGVD(i,klev-l+1,k)
175
176         t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
177         enddo
178         enddo
179         write(str2,'(i2.2)') k
180       call histwrite_phy(nid_ins,.false.,"kgv"//str2,itau_w,t_khvd)
181       enddo      ! fin boucle NSPECV
182
183       do k=8,NSPECI,10
184         do i=1,klon
185         do l=1,klev
186          if(l.ne.klev)
187     s     t_khvd(i,l)=TAUGID(i,klev-l+1,k)
188     s                -TAUGID(i,klev-l+1-1,k)
189
190          if(l.eq.klev)
191     s     t_khvd(i,l)=TAUGID(i,klev-l+1,k)
192
193         t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
194         enddo
195         enddo
196         write(str2,'(i2.2)') k
197       call histwrite_phy(nid_ins,.false.,"kgi"//str2,itau_w,t_khvd)
198       enddo      ! fin boucle NSPECI
199
200      ENDIF !lev_histday.GE.3
201
202c-------------------------------------------------------
203      IF(lev_histday.GE.4) THEN
204
205      call histwrite_phy(nid_ins,.false.,"dtdyn",itau_w,d_t_dyn)
206      call histwrite_phy(nid_ins,.false.,"dtphy",itau_w,d_t)
207c K/s
208      call histwrite_phy(nid_ins,.false.,"dtvdf",itau_w,d_t_vdf)
209c K/s
210      call histwrite_phy(nid_ins,.false.,"dtajs",itau_w,d_t_ajs)
211c K/s
212      call histwrite_phy(nid_ins,.false.,"dtswr",itau_w,heat)
213c K/s
214      call histwrite_phy(nid_ins,.false.,"dtlwr",itau_w,-1.*cool)
215c K/s     
216c      call histwrite_phy(nid_ins,.false.,"dtec",itau_w,d_t_ec)
217c      call histwrite_phy(nid_ins,.false.,"dvvdf",itau_w,d_v_vdf)
218
219      ENDIF !lev_histday.GE.4
220
221c-------------------------------------------------------
222      IF(lev_histday.GE.5) THEN
223
224c      call histwrite_phy(nid_ins,.false.,"taux",itau_w,fluxu)
225c      call histwrite_phy(nid_ins,.false.,"tauy",itau_w,fluxv)
226c      call histwrite_phy(nid_ins,.false.,"cdrm",itau_w,cdragm)
227c      call histwrite_phy(nid_ins,.false.,"cdrh",itau_w,cdragh)
228
229      ENDIF !lev_histday.GE.5
230c-------------------------------------------------------
231
232      if (ok_sync) then
233        call histsync(nid_ins)
234      endif
235      ENDIF
Note: See TracBrowser for help on using the repository browser.