My Project
 All Classes Files Functions Variables Macros
write_histISCCP.h
Go to the documentation of this file.
1 !
2 ! $Id: write_histISCCP.h 1577 2011-10-20 15:06:47Z fairhead $
3 !
4  IF (ok_isccp) THEN
5 c
6  IF (MOD(itap,NINT(freq_ISCCP/dtime)).EQ.0) THEN
7 c
8  ndex2d = 0
9  ndex3d = 0
10 c
11  itau_w = itau_phy + itap + start_time * day_step / iphysiq
12 c
13  IF(type_run.EQ."ENSP".OR.type_run.EQ."CLIM") THEN
14 c
15  DO n=1, napisccp
16 c
17  DO k=1,kmaxm1
18  zx_tmp_fi3d(1:klon, 1:lmaxm1)=fq_isccp(1:klon,k,1:lmaxm1,n)*100.
19 cym CALL gr_fi_ecrit(lmaxm1,klon,iim,jjmp1,zx_tmp_fi3d,
20 cym . zx_tmp_3d)
21 c
22 cIM: champ 3d : (lon,lat,pres) pour un tau fixe
23 c
24  CALL histwrite_phy(nid_isccp,"cldISCCP_"//taulev(k)//verticaxe(n),
25  . itau_w,zx_tmp_fi3d)
26  ENDDO !k
27 c
28 cym CALL gr_fi_ecrit(1, klon,iim,jjmp1,nbsunlit(1,:,n),zx_tmp_2d)
29  CALL histwrite_phy(nid_isccp,"nsunlit"//verticaxe(n),itau_w,
30  . nbsunlit(1,:,n))
31 c
32  CALL histwrite_phy(nid_isccp,"meantaucld"//verticaxe(n),itau_w,
33  . meantaucld(:,n))
34 c
35  ENDDO ! n=1, napisccp
36  ELSE IF(type_run.EQ."AMIP".OR.type_run.EQ."CFMI") THEN
37 c
38  DO n=1, napisccp
39 c print*,'n=',n,' write_ISCCP avant fq_isccp'
40  DO k=1, kmaxm1
41  DO l=1, lmaxm1
42 c
43  IF(top_height.LE.2) THEN
44  DO i=1, klon
45 c281008 beg
46 c print*,'write_ISCCP i n nbsunlit',i,n,nbsunlit(1,i,n)
47 c281008 end
48 c
49  IF(nbsunlit(1,i,n).NE.0.) THEN
50  fq_is_true(i,k,l,n)=
51  $ fq_isccp(i,k,l,n)*100./nbsunlit(1,i,n)
52  ELSE
53  fq_is_true(i,k,l,n)=0
54  ENDIF
55  ENDDO
56  ELSE IF(top_height.EQ.3) THEN
57  DO i=1, klon
58  fq_is_true(i,k,l,n) = fq_isccp(i,k,l,n)*100.
59  ENDDO
60  ENDIF
61 cym CALL gr_fi_ecrit(1,klon,iim,jjmp1,fq_is_true,
62 cym . zx_tmp_2d)
63 c
64 cIM: champ 2d : (lon,lat) pour un tau et une pc fixes
65 c
66  CALL histwrite_phy(nid_isccp,pclev(l)//taulev(k)//verticaxe(n),
67  . itau_w,fq_is_true(:,k,l,n))
68  ENDDO !l
69  ENDDO !k
70 c
71 c print*,'n=',n,' write_ISCCP avant nbsunlit'
72 cym CALL gr_fi_ecrit(1, klon,iim,jjmp1,nbsunlit(1,:,n),zx_tmp_2d)
73  CALL histwrite_phy(nid_isccp,"nsunlit"//verticaxe(n),
74  . itau_w,nbsunlit(1,:,n))
75 c
76  CALL histwrite_phy(nid_isccp,"meantaucld"//verticaxe(n),itau_w,
77  . meantaucld(:,n))
78 c
79  zx_tmp_fi2d(1:klon)=REAL(seed(1:klon,n))
80 c
81 c print*,'n=',n,' write_ISCCP avant seed'
82 cym CALL gr_fi_ecrit(1, klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
83  CALL histwrite_phy(nid_isccp,"seed"//verticaxe(n),
84  . itau_w,zx_tmp_fi2d)
85 c
86 c 9types de nuages ISCCP-D2
87 c fq_isccp(1:klon,k,l,n)*100. <=> pc_tau(k)_pclev(l)
88  DO i=1, klon
89  zx_tmp_fi2d(i)=
90  $ (fq_is_true(i,1,1,n)+ fq_is_true(i,2,1,n)+ fq_is_true(i,3,1,n) +
91  $ fq_is_true(i,1,2,n)+ fq_is_true(i,2,2,n)+ fq_is_true(i,3,2,n) +
92  $ fq_is_true(i,1,3,n)+ fq_is_true(i,2,3,n)+ fq_is_true(i,3,3,n) )
93  ENDDO
94 cym CALL gr_fi_ecrit(1, klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
95  CALL histwrite_phy(nid_isccp,"cirr",itau_w,zx_tmp_fi2d)
96 c
97  DO i=1, klon
98  zx_tmp_fi2d(i)=
99  $ (fq_is_true(i,4,1,n)+ fq_is_true(i,5,1,n) +
100  $ fq_is_true(i,4,2,n)+ fq_is_true(i,5,2,n) +
101  $ fq_is_true(i,4,3,n)+ fq_is_true(i,5,3,n) )
102  ENDDO
103 cym CALL gr_fi_ecrit(1, klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
104  CALL histwrite_phy(nid_isccp,"cist",itau_w,zx_tmp_fi2d)
105 c
106  DO i=1, klon
107  zx_tmp_fi2d(i)=
108  $ (fq_is_true(i,6,1,n)+ fq_is_true(i,7,1,n) +
109  $ fq_is_true(i,6,2,n)+ fq_is_true(i,7,2,n) +
110  $ fq_is_true(i,6,3,n)+ fq_is_true(i,7,3,n) )
111  ENDDO
112 cym CALL gr_fi_ecrit(1, klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
113  CALL histwrite_phy(nid_isccp,"deep",itau_w,zx_tmp_fi2d)
114 c
115  DO i=1, klon
116  zx_tmp_fi2d(i)=
117  $ (fq_is_true(i,1,4,n)+ fq_is_true(i,2,4,n)+ fq_is_true(i,3,4,n) +
118  $ fq_is_true(i,1,5,n)+ fq_is_true(i,2,5,n)+ fq_is_true(i,3,5,n) )
119  ENDDO
120 cym CALL gr_fi_ecrit(1, klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
121  CALL histwrite_phy(nid_isccp,"alcu",itau_w,zx_tmp_fi2d)
122 c
123  DO i=1, klon
124  zx_tmp_fi2d(i)=
125  $ (fq_is_true(i,4,4,n)+ fq_is_true(i,5,4,n) +
126  $ fq_is_true(i,4,5,n)+ fq_is_true(i,5,5,n) )
127  ENDDO
128 cym CALL gr_fi_ecrit(1, klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
129  CALL histwrite_phy(nid_isccp,"alst",itau_w,zx_tmp_fi2d)
130 c
131  DO i=1, klon
132  zx_tmp_fi2d(i)=
133  $ (fq_is_true(i,6,4,n)+ fq_is_true(i,7,4,n) +
134  $ fq_is_true(i,6,5,n)+ fq_is_true(i,7,5,n) )
135  ENDDO
136 cym CALL gr_fi_ecrit(1, klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
137  CALL histwrite_phy(nid_isccp,"nist",itau_w,zx_tmp_fi2d)
138 c
139  DO i=1, klon
140  zx_tmp_fi2d(i)=
141  $ (fq_is_true(i,1,6,n)+ fq_is_true(i,2,6,n)+ fq_is_true(i,3,6,n) +
142  $ fq_is_true(i,1,7,n)+ fq_is_true(i,2,7,n)+ fq_is_true(i,3,7,n) )
143  ENDDO
144 cym CALL gr_fi_ecrit(1, klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
145  CALL histwrite_phy(nid_isccp,"cumu",itau_w,zx_tmp_fi2d)
146 c
147  DO i=1, klon
148  zx_tmp_fi2d(i)=
149  $ (fq_is_true(i,4,6,n)+ fq_is_true(i,5,6,n) +
150  $ fq_is_true(i,4,7,n)+ fq_is_true(i,5,7,n) )
151  ENDDO
152 cym CALL gr_fi_ecrit(1, klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
153  CALL histwrite_phy(nid_isccp,"stcu",itau_w,zx_tmp_fi2d)
154 c
155  DO i=1, klon
156  zx_tmp_fi2d(i)=
157  $ (fq_is_true(i,6,6,n)+ fq_is_true(i,7,6,n) +
158  $ fq_is_true(i,6,7,n)+ fq_is_true(i,7,7,n) )
159  ENDDO
160 cym CALL gr_fi_ecrit(1, klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
161  CALL histwrite_phy(nid_isccp,"stra",itau_w,zx_tmp_fi2d)
162 c
163 c 3_tau_nuages x 3_levels
164 c fq_is_true(1:klon,k,l,n)*100. <=> pc_tau(k)_pclev(l)
165  DO i=1, klon
166  cld_fi3d(i,1)=
167  $ (fq_is_true(i,1,1,n)+ fq_is_true(i,2,1,n)+ fq_is_true(i,3,1,n) +
168  $ fq_is_true(i,1,2,n)+ fq_is_true(i,2,2,n)+ fq_is_true(i,3,2,n) +
169  $ fq_is_true(i,1,3,n)+ fq_is_true(i,2,3,n)+ fq_is_true(i,3,3,n) )
170  cld_fi3d(i,2)=
171  $ (fq_is_true(i,1,4,n)+ fq_is_true(i,2,4,n)+ fq_is_true(i,3,4,n) +
172  $ fq_is_true(i,1,5,n)+ fq_is_true(i,2,5,n)+ fq_is_true(i,3,5,n) )
173  cld_fi3d(i,3)=
174  $ (fq_is_true(i,1,6,n)+ fq_is_true(i,2,6,n)+ fq_is_true(i,3,6,n) +
175  $ fq_is_true(i,1,7,n)+ fq_is_true(i,2,7,n)+ fq_is_true(i,3,7,n) )
176  ENDDO
177 cym CALL gr_fi_ecrit(lmax3,klon,iim,jjmp1,cld_fi3d,cld_3d)
178  CALL histwrite_phy(nid_isccp,"thin",itau_w,cld_fi3d)
179 c
180  DO i=1, klon
181  cld_fi3d(i,1)=
182  $ (fq_is_true(i,4,1,n)+ fq_is_true(i,5,1,n) +
183  $ fq_is_true(i,4,2,n)+ fq_is_true(i,5,2,n) +
184  $ fq_is_true(i,4,3,n)+ fq_is_true(i,5,3,n) )
185  cld_fi3d(i,2)=
186  $ (fq_is_true(i,4,4,n)+ fq_is_true(i,5,4,n) +
187  $ fq_is_true(i,4,5,n)+ fq_is_true(i,5,5,n) )
188  cld_fi3d(i,3)=
189  $ (fq_is_true(i,4,6,n)+ fq_is_true(i,5,6,n) +
190  $ fq_is_true(i,4,7,n)+ fq_is_true(i,5,7,n) )
191  ENDDO
192 cym CALL gr_fi_ecrit(lmax3, klon,iim,jjmp1,cld_fi3d,cld_3d)
193  CALL histwrite_phy(nid_isccp,"mid",itau_w,cld_fi3d)
194 c
195  DO i=1, klon
196  cld_fi3d(i,1)=
197  $ (fq_is_true(i,6,1,n)+ fq_is_true(i,7,1,n) +
198  $ fq_is_true(i,6,2,n)+ fq_is_true(i,7,2,n) +
199  $ fq_is_true(i,6,3,n)+ fq_is_true(i,7,3,n) )
200  cld_fi3d(i,2)=
201  $ (fq_is_true(i,6,4,n)+ fq_is_true(i,7,4,n) +
202  $ fq_is_true(i,6,5,n)+ fq_is_true(i,7,5,n) )
203  cld_fi3d(i,3)=
204  $ (fq_is_true(i,6,6,n)+ fq_is_true(i,7,6,n) +
205  $ fq_is_true(i,6,7,n)+ fq_is_true(i,7,7,n) )
206  ENDDO
207 cym CALL gr_fi_ecrit(lmax3, klon,iim,jjmp1,cld_fi3d,cld_3d)
208  CALL histwrite_phy(nid_isccp,"thick",itau_w,cld_fi3d)
209 c
210  ENDDO ! n=1, napisccp
211 c
212  ENDIF
213 c
214  if (ok_sync) then
215 c$OMP MASTER
216  call histsync(nid_isccp)
217 c$OMP END MASTER
218  endif
219 
220  ENDIF !(MOD(itap,NINT(freq_ISCCP/dtime)).EQ.0) THEN
221 
222  ENDIF !ok_isccp