source: LMDZ4/branches/pre_V3/libf/phylmd/write_histISCCP.h @ 789

Last change on this file since 789 was 684, checked in by lmdzadmin, 19 years ago

Ajout nouveaux flags (ip_ebil_phy, ok_slab_sicOBS) ds physiq.def +
Lecture freq. ecriture en nombre de jours
IM
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 7.5 KB
Line 
1!
2! $Header$
3!
4      IF (ok_isccp) THEN
5c
6       ndex2d = 0
7       ndex3d = 0
8c
9       itau_w = itau_phy + itap
10c
11       IF(type_run.EQ."ENSP".OR.type_run.EQ."CLIM") THEN
12c
13        DO n=1, napisccp
14c
15        DO k=1,kmaxm1
16         zx_tmp_fi3d(1:klon, 1:lmaxm1)=fq_isccp(1:klon,k,1:lmaxm1,n)*100.
17         CALL gr_fi_ecrit(lmaxm1,klon,iim,jjmp1,zx_tmp_fi3d,
18     .                    zx_tmp_3d)
19c
20cIM: champ 3d : (lon,lat,pres) pour un tau fixe
21c
22         CALL histwrite(nid_isccp,"cldISCCP_"//taulev(k)//typinout(n),
23     .                  itau_w,zx_tmp_3d,iim*jjmp1*lmaxm1,ndex3d)
24        ENDDO !k
25c
26        CALL gr_fi_ecrit(1, klon,iim,jjmp1,nbsunlit(1,:,n),zx_tmp_2d)
27        CALL histwrite(nid_isccp,"nsunlit"//typinout(n),itau_w,
28     .                 zx_tmp_2d,iim*jjmp1,ndex2d)
29c
30        ENDDO ! n=1, napisccp
31        ELSE IF(type_run.EQ."AMIP".OR.type_run.EQ."CFMI") THEN
32c
33        DO n=1, napisccp
34c        print*,'n=',n,' write_ISCCP avant fq_isccp'
35         DO k=1, kmaxm1
36          DO l=1, lmaxm1
37c
38         IF(top_height.LE.2) THEN
39          DO i=1, klon
40           IF(nbsunlit(1,i,n).NE.0.) THEN
41            fq_is_true(i,k,l,n)=
42     $      fq_isccp(i,k,l,n)*100./nbsunlit(1,i,n)
43           ELSE
44            fq_is_true(i,k,l,n)=0
45           ENDIF
46          ENDDO
47         ELSE IF(top_height.EQ.3) THEN
48          DO i=1, klon
49           fq_is_true(i,k,l,n) = fq_isccp(i,k,l,n)*100.
50          ENDDO
51         ENDIF
52         CALL gr_fi_ecrit(1,klon,iim,jjmp1,fq_is_true,
53     .                    zx_tmp_2d)
54c
55cIM: champ 2d : (lon,lat) pour un tau et une pc fixes
56c
57         CALL histwrite(nid_isccp,pclev(l)//taulev(k)//typinout(n),
58     .                  itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
59         ENDDO !l
60        ENDDO !k
61c
62c       print*,'n=',n,' write_ISCCP avant nbsunlit'
63        CALL gr_fi_ecrit(1, klon,iim,jjmp1,nbsunlit(1,:,n),zx_tmp_2d)
64        CALL histwrite(nid_isccp,"nsunlit"//typinout(n),
65     .                 itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
66c
67        zx_tmp_fi2d(1:klon)=float(seed(1:klon,n))
68c
69c       print*,'n=',n,' write_ISCCP avant seed'
70        CALL gr_fi_ecrit(1, klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
71        CALL histwrite(nid_isccp,"seed"//verticaxe(n),
72     .                 itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
73c
74c 9types de nuages ISCCP-D2
75c fq_isccp(1:klon,k,l,n)*100. <=> pc_tau(k)_pclev(l)
76        DO i=1, klon
77         zx_tmp_fi2d(i)=
78     $ (fq_is_true(i,1,1,n)+ fq_is_true(i,2,1,n)+ fq_is_true(i,3,1,n) +
79     $  fq_is_true(i,1,2,n)+ fq_is_true(i,2,2,n)+ fq_is_true(i,3,2,n) +
80     $  fq_is_true(i,1,3,n)+ fq_is_true(i,2,3,n)+ fq_is_true(i,3,3,n) )
81        ENDDO
82        CALL gr_fi_ecrit(1, klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
83        CALL histwrite(nid_isccp,"cirr",itau_w,zx_tmp_2d,
84     $  iim*jjmp1,ndex2d)
85c
86        DO i=1, klon
87         zx_tmp_fi2d(i)=
88     $  (fq_is_true(i,4,1,n)+ fq_is_true(i,5,1,n) +
89     $   fq_is_true(i,4,2,n)+ fq_is_true(i,5,2,n) +
90     $   fq_is_true(i,4,3,n)+ fq_is_true(i,5,3,n) )
91        ENDDO
92        CALL gr_fi_ecrit(1, klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
93        CALL histwrite(nid_isccp,"cist",itau_w,zx_tmp_2d,
94     $  iim*jjmp1,ndex2d)
95c
96        DO i=1, klon
97         zx_tmp_fi2d(i)=
98     $  (fq_is_true(i,6,1,n)+ fq_is_true(i,7,1,n) +
99     $   fq_is_true(i,6,2,n)+ fq_is_true(i,7,2,n) +
100     $   fq_is_true(i,6,3,n)+ fq_is_true(i,7,3,n) )
101        ENDDO
102        CALL gr_fi_ecrit(1, klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
103        CALL histwrite(nid_isccp,"deep",itau_w,zx_tmp_2d,
104     $  iim*jjmp1,ndex2d)
105c
106        DO i=1, klon
107         zx_tmp_fi2d(i)=
108     $ (fq_is_true(i,1,4,n)+ fq_is_true(i,2,4,n)+ fq_is_true(i,3,4,n) +
109     $  fq_is_true(i,1,5,n)+ fq_is_true(i,2,5,n)+ fq_is_true(i,3,5,n) )
110        ENDDO
111        CALL gr_fi_ecrit(1, klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
112        CALL histwrite(nid_isccp,"alcu",itau_w,zx_tmp_2d,
113     $  iim*jjmp1,ndex2d)
114c
115        DO i=1, klon
116         zx_tmp_fi2d(i)=
117     $  (fq_is_true(i,4,4,n)+ fq_is_true(i,5,4,n) +
118     $   fq_is_true(i,4,5,n)+ fq_is_true(i,5,5,n) )
119        ENDDO
120        CALL gr_fi_ecrit(1, klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
121        CALL histwrite(nid_isccp,"alst",itau_w,zx_tmp_2d,
122     $  iim*jjmp1,ndex2d)
123c
124        DO i=1, klon
125         zx_tmp_fi2d(i)=
126     $  (fq_is_true(i,6,4,n)+ fq_is_true(i,7,4,n) +
127     $   fq_is_true(i,6,5,n)+ fq_is_true(i,7,5,n) )
128        ENDDO
129        CALL gr_fi_ecrit(1, klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
130        CALL histwrite(nid_isccp,"nist",itau_w,zx_tmp_2d,
131     $  iim*jjmp1,ndex2d)
132c
133        DO i=1, klon
134         zx_tmp_fi2d(i)=
135     $ (fq_is_true(i,1,6,n)+ fq_is_true(i,2,6,n)+ fq_is_true(i,3,6,n) +
136     $  fq_is_true(i,1,7,n)+ fq_is_true(i,2,7,n)+ fq_is_true(i,3,7,n) )
137        ENDDO
138        CALL gr_fi_ecrit(1, klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
139        CALL histwrite(nid_isccp,"cumu",itau_w,zx_tmp_2d,
140     $  iim*jjmp1,ndex2d)
141c
142        DO i=1, klon
143         zx_tmp_fi2d(i)=
144     $  (fq_is_true(i,4,6,n)+ fq_is_true(i,5,6,n) +
145     $   fq_is_true(i,4,7,n)+ fq_is_true(i,5,7,n) )
146        ENDDO
147        CALL gr_fi_ecrit(1, klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
148        CALL histwrite(nid_isccp,"stcu",itau_w,zx_tmp_2d,
149     $  iim*jjmp1,ndex2d)
150c
151        DO i=1, klon
152         zx_tmp_fi2d(i)=
153     $  (fq_is_true(i,6,6,n)+ fq_is_true(i,7,6,n) +
154     $   fq_is_true(i,6,7,n)+ fq_is_true(i,7,7,n) )
155        ENDDO
156        CALL gr_fi_ecrit(1, klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
157        CALL histwrite(nid_isccp,"stra",itau_w,zx_tmp_2d,
158     $  iim*jjmp1,ndex2d)
159c
160c 3_tau_nuages x 3_levels
161c fq_is_true(1:klon,k,l,n)*100. <=> pc_tau(k)_pclev(l)
162        DO i=1, klon
163         cld_fi3d(i,1)= 
164     $ (fq_is_true(i,1,1,n)+ fq_is_true(i,2,1,n)+ fq_is_true(i,3,1,n) +
165     $  fq_is_true(i,1,2,n)+ fq_is_true(i,2,2,n)+ fq_is_true(i,3,2,n) +
166     $  fq_is_true(i,1,3,n)+ fq_is_true(i,2,3,n)+ fq_is_true(i,3,3,n) )
167         cld_fi3d(i,2)=
168     $ (fq_is_true(i,1,4,n)+ fq_is_true(i,2,4,n)+ fq_is_true(i,3,4,n) +
169     $  fq_is_true(i,1,5,n)+ fq_is_true(i,2,5,n)+ fq_is_true(i,3,5,n) )
170         cld_fi3d(i,3)=
171     $ (fq_is_true(i,1,6,n)+ fq_is_true(i,2,6,n)+ fq_is_true(i,3,6,n) +
172     $  fq_is_true(i,1,7,n)+ fq_is_true(i,2,7,n)+ fq_is_true(i,3,7,n) )
173        ENDDO   
174        CALL gr_fi_ecrit(lmax3,klon,iim,jjmp1,cld_fi3d,cld_3d)
175        CALL histwrite(nid_isccp,"thin",itau_w,cld_3d,
176     $  iim*jjmp1*lmax3,ndex3d)
177c
178        DO i=1, klon
179         cld_fi3d(i,1)=
180     $   (fq_is_true(i,4,1,n)+ fq_is_true(i,5,1,n) +
181     $    fq_is_true(i,4,2,n)+ fq_is_true(i,5,2,n) +
182     $    fq_is_true(i,4,3,n)+ fq_is_true(i,5,3,n) )
183         cld_fi3d(i,2)=
184     $   (fq_is_true(i,4,4,n)+ fq_is_true(i,5,4,n) +
185     $    fq_is_true(i,4,5,n)+ fq_is_true(i,5,5,n) )
186         cld_fi3d(i,3)=
187     $   (fq_is_true(i,4,6,n)+ fq_is_true(i,5,6,n) +
188     $    fq_is_true(i,4,7,n)+ fq_is_true(i,5,7,n) )
189        ENDDO   
190        CALL gr_fi_ecrit(lmax3, klon,iim,jjmp1,cld_fi3d,cld_3d)
191        CALL histwrite(nid_isccp,"mid",itau_w,cld_3d,
192     $  iim*jjmp1*lmax3,ndex3d)
193c
194        DO i=1, klon
195         cld_fi3d(i,1)=
196     $   (fq_is_true(i,6,1,n)+ fq_is_true(i,7,1,n) +
197     $    fq_is_true(i,6,2,n)+ fq_is_true(i,7,2,n) +
198     $    fq_is_true(i,6,3,n)+ fq_is_true(i,7,3,n) )
199         cld_fi3d(i,2)=
200     $   (fq_is_true(i,6,4,n)+ fq_is_true(i,7,4,n) +
201     $    fq_is_true(i,6,5,n)+ fq_is_true(i,7,5,n) )
202         cld_fi3d(i,3)=
203     $   (fq_is_true(i,6,6,n)+ fq_is_true(i,7,6,n) +
204     $    fq_is_true(i,6,7,n)+ fq_is_true(i,7,7,n) )
205        ENDDO   
206        CALL gr_fi_ecrit(lmax3, klon,iim,jjmp1,cld_fi3d,cld_3d)
207        CALL histwrite(nid_isccp,"thick",itau_w,cld_3d,
208     $  iim*jjmp1*lmax3,ndex3d)
209c
210        ENDDO ! n=1, napisccp
211c
212       ENDIF
213c
214       if (ok_sync) then
215        call histsync(nid_isccp)
216       endif
217
218      ENDIF !ok_isccp
Note: See TracBrowser for help on using the repository browser.