source: LMDZ4/branches/LMDZ4_V3_patches/libf/phylmd/write_histISCCP.h @ 5086

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