source: LMDZ4/branches/LMDZ4V5.0-LF/libf/phylmd/write_histISCCP.h @ 5427

Last change on this file since 5427 was 1299, checked in by Laurent Fairhead, 15 years ago

Nettoyage general pour se rapprocher des normes et éviter des erreurs a la
compilation:

  • tous les FLOAT() sont remplacés par des REAL()
  • tous les STOP dans phylmd sont remplacés par des appels à abort_gcm
  • le common control défini dans le fichier control.h est remplacé par le module control_mod pour éviter des messages sur l'alignement des variables dans les déclarations
  • des $Header$ remplacés par des $Id$ pour svn

Quelques remplacements à faire ont pu m'échapper

General cleanup of the code to try and adhere to norms and to prevent some
compilation errors:

  • all FLOAT() instructions have been replaced by REAL() instructions
  • all STOP instructions in phylmd have been replaced by calls to abort_gcm
  • the common block control defined in the control.h file has been replaced by the control_mod to prevent compilation warnings on the alignement of declared variables
  • $Header$ replaced by $Id$ for svn

Some changes which should have been made might have escaped me
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 7.7 KB
Line 
1!
2! $Id: write_histISCCP.h 1299 2010-01-20 14:27:21Z fhourdin $
3!
4      IF (ok_isccp) THEN
5c
6       IF (MOD(itap,NINT(freq_ISCCP/dtime)).EQ.0) THEN
7c
8       ndex2d = 0
9       ndex3d = 0
10c
11       itau_w = itau_phy + itap
12c
13       IF(type_run.EQ."ENSP".OR.type_run.EQ."CLIM") THEN
14c
15        DO n=1, napisccp
16c
17        DO k=1,kmaxm1
18         zx_tmp_fi3d(1:klon, 1:lmaxm1)=fq_isccp(1:klon,k,1:lmaxm1,n)*100.
19cym         CALL gr_fi_ecrit(lmaxm1,klon,iim,jjmp1,zx_tmp_fi3d,
20cym     .                    zx_tmp_3d)
21c
22cIM: champ 3d : (lon,lat,pres) pour un tau fixe
23c
24      CALL histwrite_phy(nid_isccp,"cldISCCP_"//taulev(k)//verticaxe(n),
25     .                  itau_w,zx_tmp_fi3d)
26        ENDDO !k
27c
28cym        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))
31c
32       CALL histwrite_phy(nid_isccp,"meantaucld"//verticaxe(n),itau_w,
33     .                 meantaucld(:,n))
34c
35        ENDDO ! n=1, napisccp
36        ELSE IF(type_run.EQ."AMIP".OR.type_run.EQ."CFMI") THEN
37c
38        DO n=1, napisccp
39c        print*,'n=',n,' write_ISCCP avant fq_isccp'
40         DO k=1, kmaxm1
41          DO l=1, lmaxm1
42c
43         IF(top_height.LE.2) THEN
44          DO i=1, klon
45c281008 beg
46c          print*,'write_ISCCP i n nbsunlit',i,n,nbsunlit(1,i,n)
47c281008 end
48c
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
61cym         CALL gr_fi_ecrit(1,klon,iim,jjmp1,fq_is_true,
62cym     .                    zx_tmp_2d)
63c
64cIM: champ 2d : (lon,lat) pour un tau et une pc fixes
65c
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
70c
71c       print*,'n=',n,' write_ISCCP avant nbsunlit'
72cym        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))
75c
76       CALL histwrite_phy(nid_isccp,"meantaucld"//verticaxe(n),itau_w,
77     .                 meantaucld(:,n))
78c
79        zx_tmp_fi2d(1:klon)=REAL(seed(1:klon,n))
80c
81c       print*,'n=',n,' write_ISCCP avant seed'
82cym        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)
85c
86c 9types de nuages ISCCP-D2
87c 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
94cym       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)
96c
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
103cym     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)
105c
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
112cym     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)
114c
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
120cym     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)
122c
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
128cym     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)
130c
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
136cym     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)
138c
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
144cym     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)
146c
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
152cym     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)
154c
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
160cym     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)
162c
163c 3_tau_nuages x 3_levels
164c 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   
177cym        CALL gr_fi_ecrit(lmax3,klon,iim,jjmp1,cld_fi3d,cld_3d)
178        CALL histwrite_phy(nid_isccp,"thin",itau_w,cld_fi3d)
179c
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   
192cym       CALL gr_fi_ecrit(lmax3, klon,iim,jjmp1,cld_fi3d,cld_3d)
193        CALL histwrite_phy(nid_isccp,"mid",itau_w,cld_fi3d)
194c
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   
207cym       CALL gr_fi_ecrit(lmax3, klon,iim,jjmp1,cld_fi3d,cld_3d)
208        CALL histwrite_phy(nid_isccp,"thick",itau_w,cld_fi3d)
209c
210        ENDDO ! n=1, napisccp
211c
212       ENDIF
213c
214       if (ok_sync) then
215c$OMP MASTER
216        call histsync(nid_isccp)
217c$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.