source: LMDZ4/branches/LMDZ4_V3_patches/libf/phylmd/ini_histISCCP.h @ 5147

Last change on this file since 5147 was 918, checked in by Laurent Fairhead, 17 years ago
  • correction du bug ISCCP (n'ecrire ptop que quand ISCCP est appelé)
  • petite inversion de boucle dans isccp_cloud_types.F pour aller + vite
  • "CFisation" d'un certain nombre d'unités pour les hist*
  • les suggestions de JL pour rugoro

SD
LF
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 10.2 KB
Line 
1!
2! $Header$
3!
4      IF (ok_isccp) THEN
5c
6c$OMP MASTER
7      ndex2d = 0
8      ndex3d = 0
9c
10c pour les champs instantannes, il faut mettre la meme valeur pour
11c zout et zsto.
12c dtime est passe par ailleurs a histbeg
13c zstophy = frequence de stockage des champs tous les pdt physiques
14c zout = frequence d'ecriture des champs
15cIM 300505     zstophy = dtime
16c appel du simulateur toutes les 3heures
17!IM on lit la frequence d'appel dans physiq.def
18!         zcals(1) = dtime *6.  !toutes les 3h (en s)
19          zcals(1) = freq_ISCCP !toutes les freq_ISCCP secondes
20        DO n=1, napisccp
21          zcalh(n) = zcals(n)/3600. !stoutes les Xh (en heures)
22        ENDDO !n
23c
24c ecriture 8 fois par jour
25c       zout = dtime * REAL(NINT(86400./dtime*ecrit_isccp))
26c ecriture toutes les 2h (12 fois par jour)
27c       zout = dtime * 4.
28c ecriture toutes les 1/2 h (48 fois par jour)
29c       zout = dtime
30c
31c       IF(freqout_isccp.EQ.1.) THEN
32c ecriture jounaliere
33!IM on ecrit les resultats du simulateur ISCCP toutes les
34! ecrit_ISCCP secondes      zout_isccp(1) = ecrit_day !(en s)
35          zout_isccp(1) = ecrit_ISCCP !(en s)
36c ecriture mensuelle
37c         zout = dtime * ecrit_mth !(en s)
38        DO n=1, napisccp
39          zoutj(n)=zout_isccp(n)/86400. !(en jours)
40c
41c le nombre de sous-colonnes ncol : ncol=(100.*zcalh)/zoutd
42          ncol(n)=NINT((100.*zcalh(n))/zoutj(n))
43          IF(ncol(n).GT.ncolmx) THEN
44           PRINT*,'Warning: Augmenter le nombre colonnes du simulateur'
45           PRINT*,'         ISCCP ncol=', ncol,' ncolmx=',ncolmx
46c          PRINT*,'n ncol',n,ncol(n)
47           CALL abort
48          ENDIF
49c
50        DO l=1, ncol(n)
51          vertlev(l,n)=float(l)
52        ENDDO !ncol
53c
54        ENDDO !n
55
56c       PRINT*, 'La frequence de sortie ISCCP est de ', ecrit_isccp
57c
58        idayref = day_ref
59        CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian)
60c       write(*,*)'ISCCP ', itau_phy, zjulian
61c
62c
63c definition coordonnees lon,lat en globale
64c
65cym        CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlon,zx_lon)
66cym        DO i = 1, iim
67cym          zx_lon(i,1) = rlon(i+1)
68cym          zx_lon(i,jjmp1) = rlon(i+1)
69cym        ENDDO
70
71cym        CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat)
72c
73cIM BEG region
74cym Desole dans un premier temps le mode region ne marchera pas
75cym Il faudra voir dans un second temps pour l'implementer
76cym Mais cela posera des problemes au niveau de la reconstruction
77
78          imin_ins=1
79          imax_ins=iim
80          jmin_ins=1
81          jmax_ins=jjmp1
82cym          do i=1,iim-1
83cym             if(zx_lon(i,1).lt.lonmin_ins) imin_ins=i
84cym             if(zx_lon(i,1).le.lonmax_ins) imax_ins=i+1
85cym          enddo
86cym          do j=1,jjmp1
87cym             if(zx_lat(1,j).ge.latmin_ins) jmax_ins=j
88cym             if(zx_lat(1,j).gt.latmax_ins) jmin_ins=j
89cym          enddo
90c
91          print*,'On stoke le fichier histISCCP sur ',
92     s   imin_ins,imax_ins,jmin_ins,jmax_ins
93cym          print*,'On stoke le fichier histISCCP instantanne sur ',
94cym     s   zx_lon(imin_ins,1),zx_lon(imax_ins,1),
95cym     s   zx_lat(1,jmin_ins),zx_lat(1,jmax_ins)
96cIM END region
97c
98        IF(1.EQ.0) THEN
99cym         CALL histbeg("histISCCP.nc", iim,zx_lon(:,1),jjmp1,zx_lat(1,:),
100cym     .                 1, iim, 1, jjmp1,
101cym     .                 itau_phy, zjulian, dtime,
102cym     .                 nhori, nid_isccp)
103         CALL histbeg_phy("histISCCP.nc", itau_phy, zjulian, dtime,
104     .                 nhori, nid_isccp)
105        ENDIF !(1.EQ.0) THEN
106c
107cym         CALL histbeg("histISCCP.nc", iim,zx_lon(:,1),
108cym     .                 jjmp1,zx_lat(1,:),
109cym     .                 imin_ins,imax_ins-imin_ins+1,
110cym     .                 jmin_ins,jmax_ins-jmin_ins+1,
111cym     .                 itau_phy, zjulian, dtime,
112cym     .                 nhori, nid_isccp)
113
114         CALL histbeg_phy("histISCCP.nc", itau_phy, zjulian, dtime,
115     .                 nhori, nid_isccp)
116c
117        IF(type_run.EQ."ENSP".OR.type_run.EQ."CLIM") THEN
118         CALL histvert(nid_isccp, "cldtopres","Cloud Top Pressure","mb",
119     .                 lmaxm1, cldtopres, nvert,'down')
120        ELSE IF(type_run.EQ."AMIP".OR.type_run.EQ."CFMI") THEN
121         CALL histvert(nid_isccp,"cldtopres3","Cloud Top Pressure","mb",
122     .                 lmax3, cldtopres3, nvert3,'down')
123        ENDIF
124        DO n=1, napisccp
125         CALL histvert(nid_isccp, "Nbcol"//verticaxe(n),
126     .        "Nb of Column"//verticaxe(n),"1",
127     .        ncol(n), vertlev(:,n), nvlev(n),'up')
128        ENDDO
129c
130        IF(type_run.EQ."ENSP".OR.type_run.EQ."CLIM") THEN
131c
132c variables a ecrire
133c
134         DO n=1, napisccp
135c
136         DO k=1, kmaxm1
137          CALL histdef(nid_isccp, "cldISCCP_"//taulev(k)//verticaxe(n),
138     .                "LMDZ ISCCP cld", "%",
139     .                iim, jj_nb,nhori,lmaxm1,1,lmaxm1,nvert,32,
140     .                "ave(X)", zcals(n),zout_isccp(n))
141         ENDDO
142c
143         CALL histdef(nid_isccp, "nsunlit"//verticaxe(n),
144     .                "Nb of calls with sunlit ", "%",
145     .                iim, jj_nb,nhori,1,1,1,-99,32,
146     .                "ave(X)", zcals(n),zout_isccp(n))
147c
148         CALL histdef(nid_isccp, "ptop",
149     .                "Cld top pressure (cf ISCCP simulator)","Pa",
150     .                iim,jj_nb,nhori, 1,1,1,-99,32,
151     .                "ave(X)", zcals(n),zout_isccp(n))
152c
153         CALL histdef(nid_isccp,"meantaucld",
154     .                "ISCCP mean cloud optical thickness","1",
155     .                iim,jj_nb,nhori, 1,1,1, -99, 32,
156     .                "ave(X)", zcals(n),zout_isccp(n))
157         ENDDO
158c
159        ELSE IF(type_run.EQ."AMIP".OR.type_run.EQ."CFMI") THEN
160c
161         DO n=1, napisccp
162c
163c         print*,'n=',n,' avant histdef(..LMDZ ISCCP cld'
164c
165          DO k=1, kmaxm1
166           DO l=1, lmaxm1
167c
168           CALL histdef(nid_isccp, pclev(l)//taulev(k)//verticaxe(n),
169     .                "LMDZ ISCCP cld "//cnameisccp(l,k), "%",
170     .                iim, jj_nb,nhori,1,1,1,-99,32,
171     .                "ave(X)", zcals(n),zout_isccp(n))
172c
173           ENDDO
174          ENDDO
175c
176c         print*,'n=',n,' avant histdef(..Nb of calls sunlit'
177          CALL histdef(nid_isccp, "nsunlit"//verticaxe(n),
178     .                "Nb of calls with sunlit ", "%",
179     .                iim, jj_nb,nhori,1,1,1,-99,32,
180     .                "ave(X)", zcals(n),zout_isccp(n))
181c
182          CALL histdef(nid_isccp, "ptop",
183     .                "Cld top pressure (cf ISCCP simulator)","Pa",
184     .                iim,jj_nb,nhori, 1,1,1,-99,32,
185     .                "ave(X)", zcals(n),zout_isccp(n))
186c
187          CALL histdef(nid_isccp,"meantaucld",
188     .                "ISCCP mean cloud optical thickness","1",
189     .                iim,jj_nb,nhori, 1,1,1, -99, 32,
190     .                "ave(X)", zcals(n),zout_isccp(n))
191c
192c 9types de nuages ISCCP-D2
193          CALL histdef(nid_isccp, "cirr",
194     .                "Cirrus lk ISCCP-D2", "%",
195     .                iim, jj_nb,nhori,1,1,1,-99,32,
196     .                "ave(X)", zcals(n),zout_isccp(n))
197c
198          CALL histdef(nid_isccp, "cist",
199     .                "CiSt lk ISCCP-D2", "%",
200     .                iim, jj_nb,nhori,1,1,1,-99,32,
201     .                "ave(X)", zcals(n),zout_isccp(n))
202c
203          CALL histdef(nid_isccp, "deep",
204     .                "Deep lk ISCCP-D2", "%",
205     .                iim, jj_nb,nhori,1,1,1,-99,32,
206     .                "ave(X)", zcals(n),zout_isccp(n))
207c
208          CALL histdef(nid_isccp, "alcu",
209     .                "AlCu lk ISCCP-D2", "%",
210     .                iim, jj_nb,nhori,1,1,1,-99,32,
211     .                "ave(X)", zcals(n),zout_isccp(n))
212c
213          CALL histdef(nid_isccp, "alst",
214     .                "AlSt lk ISCCP-D2", "%",
215     .                iim, jj_nb,nhori,1,1,1,-99,32,
216     .                "ave(X)", zcals(n),zout_isccp(n))
217c
218          CALL histdef(nid_isccp, "nist",
219     .                "NiSt lk ISCCP-D2", "%",
220     .                iim, jj_nb,nhori,1,1,1,-99,32,
221     .                "ave(X)", zcals(n),zout_isccp(n))
222c
223          CALL histdef(nid_isccp, "cumu",
224     .                "Cumu lk ISCCP-D2", "%",
225     .                iim, jj_nb,nhori,1,1,1,-99,32,
226     .                "ave(X)", zcals(n),zout_isccp(n))
227c
228          CALL histdef(nid_isccp, "stcu",
229     .                "StCu lk ISCCP-D2", "%",
230     .                iim, jj_nb,nhori,1,1,1,-99,32,
231     .                "ave(X)", zcals(n),zout_isccp(n))
232c
233          CALL histdef(nid_isccp, "stra",
234     .                "Stra lk ISCCP-D2", "%",
235     .                iim, jj_nb,nhori,1,1,1,-99,32,
236     .                "ave(X)", zcals(n),zout_isccp(n))
237c
238c 3_epaisseurs_optiques x3_pressions_au_sommet_des_nuages  types de nuages
239          CALL histdef(nid_isccp, "thin",
240     .                "Opt. thin ISCCP-D2 like clouds", "%",
241     .                iim, jj_nb,nhori,lmax3,1,lmax3,nvert3,32,
242     .                "ave(X)", zcals(n),zout_isccp(n))
243c
244          CALL histdef(nid_isccp, "mid",
245     .                "Opt. intermediate ISCCP-D2 like clouds", "%",
246     .                iim, jj_nb,nhori,lmax3,1,lmax3,nvert3,32,
247     .                "ave(X)", zcals(n),zout_isccp(n))
248c
249          CALL histdef(nid_isccp, "thick",
250     .                "Opt. thick ISCCP-D2 like clouds", "%",
251     .                iim, jj_nb,nhori,lmax3,1,lmax3,nvert3,32,
252     .                "ave(X)", zcals(n),zout_isccp(n))
253c
254c        IF(1.EQ.0) THEN
255c        IF(n.EQ.3) THEN
256c        IF(n.EQ.1) THEN
257c
258cIM 070905 BEG
259         IF(1.EQ.0) THEN
260          print*,'n=',n,' avant histdef(..boxptop axe'
261cIM verif boxptop
262          CALL histdef(nid_isccp,"boxptop"//verticaxe(n),
263     .                "Boxptop axe"//verticaxe(n), "mb",
264     .                iim, jj_nb,nhori,
265     .                ncol(n),1,ncol(n),nvlev(n),32,
266cIM  .                ncolmx,1,ncolmx,nvlev,32,
267cIM  .                "inst(X)",dtime,dtime)
268     .                "ave(X)",zcals(n),zout_isccp(n))
269         ENDIF !(1.EQ.0) THEN
270cIM 070905 END
271c        ENDIF !(n.EQ.3) THEN
272c       ENDIF !(1.EQ.0) THEN
273c
274c         print*,'n=',n,' avant histdef(..seed axe'
275          CALL histdef(nid_isccp, "seed"//verticaxe(n),
276     .                "seed axe"//verticaxe(n), "-",
277     .                iim, jj_nb,nhori,1,1,1,-99,32,
278cIM  .                "inst(X)", dtime,dtime)
279     .                "ave(X)", zcals(n),zout_isccp(n))
280c
281         ENDDO !n
282        ENDIF
283        CALL histend(nid_isccp)
284c
285c$OMP END MASTER
286      ENDIF ! ok_isccp
Note: See TracBrowser for help on using the repository browser.