source: trunk/libf/phytitan/write_histmth.h @ 102

Last change on this file since 102 was 97, checked in by slebonnois, 14 years ago

Serie de modifs SL pour homogeneisation des phytitan et phyvenus
Ca touche aussi aux liens phy/dyn (surtout a propos de clesphy0),
a verifier avec les autres, donc...
File size: 8.9 KB
RevLine 
[3]1      IF (ok_mensuel) THEN
2c
3      ndex2d = 0
4      ndex3d = 0
5      zx_tmp_2d = 0.
6      zx_tmp_3d = 0.
7      zx_tmp_fi2d=0.
8      zx_tmp_fi3d=0.
9c
10         zsto = dtime
11         zout = dtime * FLOAT(ecrit_mth)
12         itau_w = itau_phy + itap
13c
14c-------------------------------------------------------
15      IF(lev_histmth.GE.1) THEN
16c
17ccccccccccccc 2D fields, invariables
18c
19      CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
[97]20      CALL histwrite(nid_mth,"phis",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]21C
22      CALL gr_fi_ecrit(1,klon,iim,jjmp1,airephy,zx_tmp_2d)
[97]23      CALL histwrite(nid_mth,"aire",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]24c
25ccccccc axe Ls
26      do j=1,jjmp1
27       do i=1,iim
[97]28        zx_tmp_2d(i,j)=zls*180./RPI      ! zls est en radians !!
[3]29       enddo
30      enddo
[97]31      CALL histwrite(nid_mth,"ls",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]32c
33ccccccccccccc 2D fields, variables
34c
35      CALL gr_fi_ecrit(1, klon,iim,jjmp1, ftsol,zx_tmp_2d)
[97]36      CALL histwrite(nid_mth,"tsol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]37c
38      DO i = 1, klon
39         zx_tmp_fi2d(i) = paprs(i,1)
40      ENDDO
41      CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
[97]42      CALL histwrite(nid_mth,"psol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]43c
44c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, ue,zx_tmp_2d)
[97]45c     CALL histwrite(nid_mth,"ue",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]46c
47c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, ve,zx_tmp_2d)
[97]48c     CALL histwrite(nid_mth,"ve",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]49c
50      ENDIF !lev_histmth.GE.1
51c
52c-------------------------------------------------------
53      IF(lev_histmth.GE.2) THEN
54c
55ccccccccccccc 3D fields, basics
56c
57      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
[97]58      CALL histwrite(nid_mth,"temp",itau_w,zx_tmp_3d,
[3]59     .                                   iim*jjmp1*klev,ndex3d)
60c
61      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
[97]62      CALL histwrite(nid_mth,"pres",itau_w,zx_tmp_3d,
[3]63     .                                   iim*jjmp1*klev,ndex3d)
64c
65      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
[97]66      CALL histwrite(nid_mth,"geop",itau_w,zx_tmp_3d,
[3]67     .                                   iim*jjmp1*klev,ndex3d)
68c
69      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
[97]70      CALL histwrite(nid_mth,"vitu",itau_w,zx_tmp_3d,
[3]71     .                                   iim*jjmp1*klev,ndex3d)
72c
73      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
[97]74      CALL histwrite(nid_mth,"vitv",itau_w,zx_tmp_3d,
[3]75     .                                   iim*jjmp1*klev,ndex3d)
76c
77      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, omega, zx_tmp_3d)
[97]78      CALL histwrite(nid_mth,"vitw",itau_w,zx_tmp_3d,
[3]79     .                                   iim*jjmp1*klev,ndex3d)
80c
81      CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw,zx_tmp_2d)
[97]82      CALL histwrite(nid_mth,"tops",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]83c
84         if (iflag_trac.eq.1) THEN
85          if (microfi.eq.1) then
[97]86c          DO iq=1,nmicro
87c      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qaer(1,1,iq), zx_tmp_3d)
88c      CALL histwrite(nid_mth,tname(iq),itau_w,zx_tmp_3d,
89c    .                                   iim*jjmp1*klev,ndex3d)
90c          ENDDO
91c         endif
92          if (nmicro.lt.nqmax) then
[3]93           DO iq=nmicro+1,nqmax
94       CALL gr_fi_ecrit(klev,klon,iim,jjmp1,tr_seri(1,1,iq),zx_tmp_3d)
[97]95       CALL histwrite(nid_mth,tname(iq),itau_w,zx_tmp_3d,
[3]96     .                                   iim*jjmp1*klev,ndex3d)
97           ENDDO
98c Condensation:
99c          DO iq=nmicro+1,nqmax
100c      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,d_tr_mph(1,1,iq),zx_tmp_3d)
[97]101c      CALL histwrite(nid_mth,"c_"//tname(iq),itau_w,zx_tmp_3d,
[3]102c    .                                   iim*jjmp1*klev,ndex3d)
103c          ENDDO
104          endif
105         endif
106c
107      ENDIF !lev_histmth.GE.2
108c
109c-------------------------------------------------------
110      IF(lev_histmth.GE.3) THEN
111c
112cccccccccccccccccc  Radiative transfer
113c
114c 2D
115c
116      CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
[97]117      CALL histwrite(nid_mth,"topl",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]118c
119      CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
[97]120      CALL histwrite(nid_mth,"sols",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]121c
122      CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
[97]123      CALL histwrite(nid_mth,"soll",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]124c
125c 3D
126c
127      zx_tmp_fi3d(1:klon,1:klev)=swnet(1:klon,1:klev)
128      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[97]129      CALL histwrite(nid_mth,"SWnet",itau_w,zx_tmp_3d,
[3]130     .                                   iim*jjmp1*klev,ndex3d)
131c
132      zx_tmp_fi3d(1:klon,1:klev)=lwnet(1:klon,1:klev)
133      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[97]134      CALL histwrite(nid_mth,"LWnet",itau_w,zx_tmp_3d,
[3]135     .                                   iim*jjmp1*klev,ndex3d)
136c
[97]137c 3D adding Tau and k  (31/08/10)
138c
139       do k=3,nspecv,5
140         do i=1,klon
141         do l=1,klev
142           t_tauhvd(i,j)=TAUHVD(i,klev-l+1,k)
143         enddo
144         enddo
145         write(str1,'(i2.2)') k
146      zx_tmp_fi3d(1:klon,1:klev)=t_tauhvd(1:klon,1:klev)
147      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
148      CALL histwrite(nid_mth,"thv"//str1,itau_w,zx_tmp_3d,
149     .                                   iim*jjmp1*klev,ndex3d)
150       enddo      ! fin boucle nspecv
151
152       do k=3,nspecv,5
153         do i=1,klon
154         do l=1,klev
155         if(l.ne.klev)
156     s    t_khvd(i,l)=TAUHVD(i,klev-l+1,k)
157     s    -TAUHVD(i,klev-l+1-1,k)
158
159          if(l.eq.klev)
160     s    t_khvd(i,l)=TAUHVD(i,klev-l+1,k)
161
162         t_khvd(i,l)=t_khvd(i,l)/(zzlev(i,l+1)-zzlev(i,l))
163         enddo
164         enddo
165         write(str1,'(i2.2)') k
166      zx_tmp_fi3d(1:klon,1:klev)=t_khvd(1:klon,1:klev)
167      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
168      CALL histwrite(nid_mth,"khv"//str1,itau_w,zx_tmp_3d,
169     .                                   iim*jjmp1*klev,ndex3d)
170       enddo      ! fin boucle nspecv
171
[3]172      ENDIF !lev_histmth.GE.3
173c
174c-------------------------------------------------------
175      IF(lev_histmth.GE.4) THEN
176c
177      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_dyn, zx_tmp_3d)
[97]178      CALL histwrite(nid_mth,"dtdyn",itau_w,zx_tmp_3d,
[3]179     .                                   iim*jjmp1*klev,ndex3d)
180c
181      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t, zx_tmp_3d)
[97]182      CALL histwrite(nid_mth,"dtphy",itau_w,zx_tmp_3d,
[3]183     .                                   iim*jjmp1*klev,ndex3d)
184c K/s
185      zx_tmp_fi3d(1:klon,1:klev)=d_t_vdf(1:klon,1:klev)
186      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[97]187      CALL histwrite(nid_mth,"dtvdf",itau_w,zx_tmp_3d,
[3]188     .                                   iim*jjmp1*klev,ndex3d)
189c
190c K/s
191      zx_tmp_fi3d(1:klon,1:klev)=d_t_ajs(1:klon,1:klev)
192      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[97]193      CALL histwrite(nid_mth,"dtajs",itau_w,zx_tmp_3d,
[3]194     .                                   iim*jjmp1*klev,ndex3d)
195c
196c K/s
197      zx_tmp_fi3d(1:klon,1:klev)=heat(1:klon,1:klev)
198      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[97]199      CALL histwrite(nid_mth,"dtswr",itau_w,zx_tmp_3d,
[3]200     .                                   iim*jjmp1*klev,ndex3d)
201c
202c K/s     
203      zx_tmp_fi3d(1:klon,1:klev)=-1.*cool(1:klon,1:klev)
204      CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[97]205      CALL histwrite(nid_mth,"dtlwr",itau_w,zx_tmp_3d,
[3]206     .                                   iim*jjmp1*klev,ndex3d)
207c K/s     
208c     zx_tmp_fi3d(1:klon,1:klev)=d_t_ec(1:klon,1:klev)
209c     CALL gr_fi_ecrit(klev,klon,iim,jjmp1,zx_tmp_fi3d,zx_tmp_3d)
[97]210c     CALL histwrite(nid_mth,"dtec",itau_w,zx_tmp_3d,
[3]211c    .                                   iim*jjmp1*klev,ndex3d)
212c
213      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_vdf, zx_tmp_3d)
[97]214      CALL histwrite(nid_mth,"duvdf",itau_w,zx_tmp_3d,
[3]215     .                                   iim*jjmp1*klev,ndex3d)
216c
217      CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_dyn, zx_tmp_3d)
[97]218      CALL histwrite(nid_mth,"dudyn",itau_w,zx_tmp_3d,
[3]219     .                                   iim*jjmp1*klev,ndex3d)
220c
221c     CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_vdf, zx_tmp_3d)
[97]222c     CALL histwrite(nid_mth,"dvvdf",itau_w,zx_tmp_3d,
[3]223c    .                                   iim*jjmp1*klev,ndex3d)
224c
225      ENDIF !lev_histmth.GE.4
226c
227c-------------------------------------------------------
228      IF(lev_histmth.GE.5) THEN
229c
230c
231c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxu , zx_tmp_2d)
232c      CALL histwrite(nid_mth,"taux_",itau_w,
[97]233c    $      zx_tmp_2d,iim*jjmp1,ndex2d) 
[3]234c     
235c      CALL gr_fi_ecrit(1, klon,iim,jjmp1, fluxv , zx_tmp_2d)
236c      CALL histwrite(nid_mth,"tauy_",itau_w,
[97]237c    $      zx_tmp_2d,iim*jjmp1,ndex2d)
[3]238c
239c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
[97]240c     CALL histwrite(nid_mth,"cdrm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]241c
242c     CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
[97]243c     CALL histwrite(nid_mth,"cdrh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
[3]244c
245      ENDIF !lev_histmth.GE.5
246c-------------------------------------------------------
247c
248      if (ok_sync) then
249        call histsync(nid_mth)
250      endif
251
252      ENDIF
Note: See TracBrowser for help on using the repository browser.