source: lmdz_wrf/branches/LMDZ_WRFmeas/WRFV3/lmdz/write_histISCCP.h @ 94

Last change on this file since 94 was 1, checked in by lfita, 11 years ago
  • -- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 9.8 KB
Line 
1!
2! $Id: write_histISCCP.h 1665 2012-10-09 13:35:26Z 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!IM: 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!IM: 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!$OMP MASTER
216        call histsync(nid_isccp)
217!$OMP END MASTER       
218       endif
219
220       ENDIF !(MOD(itap,NINT(freq_ISCCP/dtime)).EQ.0) THEN
221
222      ENDIF !ok_isccp
Note: See TracBrowser for help on using the repository browser.