1 | c |
---|
2 | c $Header$ |
---|
3 | c |
---|
4 | |
---|
5 | PROGRAM create_fausse_var |
---|
6 | C |
---|
7 | IMPLICIT NONE |
---|
8 | C |
---|
9 | C |
---|
10 | #include "dimensions.h" |
---|
11 | #include "paramet.h" |
---|
12 | #include "comconst.h" |
---|
13 | #include "comgeom.h" |
---|
14 | #include "comvert.h" |
---|
15 | |
---|
16 | real temp(iim+1,jjm+1) |
---|
17 | #include "netcdf.inc" |
---|
18 | |
---|
19 | c Attributs netcdf sortie |
---|
20 | character*64 fich_out |
---|
21 | integer*4 ncid_out,rcode_out |
---|
22 | integer*4 out_lonuid,out_lonvid,out_latuid,out_latvid |
---|
23 | integer*4 out_varid |
---|
24 | integer*4 out_lonudim,out_lonvdim |
---|
25 | integer*4 out_latudim,out_latvdim,out_dim(3) |
---|
26 | |
---|
27 | INTEGER longcles |
---|
28 | PARAMETER ( longcles = 20 ) |
---|
29 | REAL clesphy0( longcles ) |
---|
30 | |
---|
31 | integer start(4),count(4) |
---|
32 | |
---|
33 | integer status,i,j |
---|
34 | real rlatudeg(jjp1),rlatvdeg(jjm) |
---|
35 | real rlonudeg(iip1),rlonvdeg(iip1) |
---|
36 | |
---|
37 | real dlon1(iip1),dlon2(iip1),dlat1(jjp1),dlat2(jjp1) |
---|
38 | real acoslat,dxkm,dykm,resol(iip1,jjp1) |
---|
39 | |
---|
40 | #include "serre.h" |
---|
41 | #include "fxyprim.h" |
---|
42 | |
---|
43 | print*,'OK0' |
---|
44 | |
---|
45 | rad = 6400000 |
---|
46 | omeg = 7.272205e-05 |
---|
47 | g = 9.8 |
---|
48 | kappa = 0.285716 |
---|
49 | daysec = 86400 |
---|
50 | cpp = 1004.70885 |
---|
51 | |
---|
52 | preff = 101325. |
---|
53 | pa= 50000. |
---|
54 | |
---|
55 | open(99,file='run.def',status='old',form='formatted') |
---|
56 | CALL defrun_new( 99, .TRUE.,clesphy0 ) |
---|
57 | close(99) |
---|
58 | CALL iniconst |
---|
59 | CALL inigeom |
---|
60 | |
---|
61 | |
---|
62 | print*,'OK1' |
---|
63 | do j=1,jjp1 |
---|
64 | rlatudeg(j)=rlatu(j)*180./pi |
---|
65 | enddo |
---|
66 | do j=1,jjm |
---|
67 | rlatvdeg(j)=rlatv(j)*180./pi |
---|
68 | enddo |
---|
69 | |
---|
70 | do i=1,iip1 |
---|
71 | rlonudeg(i)=rlonu(i)*180./pi |
---|
72 | rlonvdeg(i)=rlonv(i)*180./pi |
---|
73 | enddo |
---|
74 | |
---|
75 | |
---|
76 | print*,'OK2' |
---|
77 | c 2 ----- OUVERTURE DE LA SORTIE NETCDF |
---|
78 | c --------------------------------------------------- |
---|
79 | c CREATION OUTPUT |
---|
80 | c ouverture fichier netcdf de sortie out |
---|
81 | fich_out='grilles_gcm.nc' |
---|
82 | |
---|
83 | status=NF_CREATE(fich_out,NF_NOCLOBBER,ncid_out) |
---|
84 | status=NF_DEF_DIM(ncid_out,'lonu',iim+1,out_lonudim) |
---|
85 | status=NF_DEF_DIM(ncid_out,'lonv',iim+1,out_lonvdim) |
---|
86 | status=NF_DEF_DIM(ncid_out,'latu',jjm+1,out_latudim) |
---|
87 | status=NF_DEF_DIM(ncid_out,'latv',jjm,out_latvdim) |
---|
88 | |
---|
89 | |
---|
90 | print*,'OK3' |
---|
91 | c Longitudes en u |
---|
92 | print *,'OUTID: ',ncid_out |
---|
93 | status=NF_DEF_VAR(ncid_out,'lonu',NF_FLOAT,1,out_lonudim, |
---|
94 | % out_lonuid) |
---|
95 | call handle_err(status) |
---|
96 | status=NF_PUT_ATT_TEXT(ncid_out,out_lonuid,'units', |
---|
97 | % 12,'degrees_east') |
---|
98 | status=NF_PUT_ATT_TEXT(ncid_out,out_lonuid,'long_name', |
---|
99 | % 9,'Longitude en u') |
---|
100 | |
---|
101 | c Longitudes en v |
---|
102 | print *,'OUTID: ',ncid_out |
---|
103 | status=NF_DEF_VAR(ncid_out,'lonv',NF_FLOAT,1,out_lonvdim, |
---|
104 | % out_lonvid) |
---|
105 | call handle_err(status) |
---|
106 | status=NF_PUT_ATT_TEXT(ncid_out,out_lonvid,'units', |
---|
107 | % 12,'degrees_east') |
---|
108 | status=NF_PUT_ATT_TEXT(ncid_out,out_lonvid,'long_name', |
---|
109 | % 9,'Longitude en v') |
---|
110 | |
---|
111 | c Latitude en u |
---|
112 | status=NF_DEF_VAR(ncid_out,'latu',NF_FLOAT,1,out_latudim, |
---|
113 | % out_latuid) |
---|
114 | call handle_err(status) |
---|
115 | status=NF_PUT_ATT_TEXT(ncid_out,out_latuid,'units', |
---|
116 | % 13,'degrees_north') |
---|
117 | status=NF_PUT_ATT_TEXT(ncid_out,out_latuid,'long_name', |
---|
118 | % 8,'Latitude en u') |
---|
119 | |
---|
120 | c Latitude en v |
---|
121 | status=NF_DEF_VAR(ncid_out,'latv',NF_FLOAT,1,out_latvdim, |
---|
122 | % out_latvid) |
---|
123 | call handle_err(status) |
---|
124 | status=NF_PUT_ATT_TEXT(ncid_out,out_latvid,'units', |
---|
125 | % 13,'degrees_north') |
---|
126 | status=NF_PUT_ATT_TEXT(ncid_out,out_latvid,'long_name', |
---|
127 | % 8,'Latitude en v') |
---|
128 | |
---|
129 | c ecriture de la grille u |
---|
130 | out_dim(1)=out_lonudim |
---|
131 | out_dim(2)=out_latudim |
---|
132 | status=NF_DEF_VAR(ncid_out,'grille_u',NF_FLOAT,2,out_dim, |
---|
133 | % out_varid) |
---|
134 | call handle_err(status) |
---|
135 | status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'units', |
---|
136 | % 6,'Kelvin') |
---|
137 | status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'long_name', |
---|
138 | % 16,'Grille aux point u') |
---|
139 | |
---|
140 | c ecriture de la grille v |
---|
141 | out_dim(1)=out_lonvdim |
---|
142 | out_dim(2)=out_latvdim |
---|
143 | status=NF_DEF_VAR(ncid_out,'grille_v',NF_FLOAT,2,out_dim, |
---|
144 | % out_varid) |
---|
145 | call handle_err(status) |
---|
146 | status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'units', |
---|
147 | % 6,'Kelvin') |
---|
148 | status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'long_name', |
---|
149 | % 16,'Grille aux point v') |
---|
150 | |
---|
151 | c ecriture de la grille u |
---|
152 | out_dim(1)=out_lonvdim |
---|
153 | out_dim(2)=out_latudim |
---|
154 | status=NF_DEF_VAR(ncid_out,'grille_s',NF_FLOAT,2,out_dim, |
---|
155 | % out_varid) |
---|
156 | call handle_err(status) |
---|
157 | status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'units', |
---|
158 | % 6,'Kelvin') |
---|
159 | status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'long_name', |
---|
160 | % 16,'Grille aux point u') |
---|
161 | |
---|
162 | |
---|
163 | print*,'OK4' |
---|
164 | status=NF_ENDDEF(ncid_out) |
---|
165 | c 5) ----- FERMETURE DES FICHIERS NETCDF------------------ |
---|
166 | c -------------------------------------------------------- |
---|
167 | c 3-b- Ecriture de la grille pour la sortie |
---|
168 | c rajoute l'ecriture de la grille |
---|
169 | |
---|
170 | status=NF_PUT_VARA_REAL(ncid_out,out_lonuid,1,iim+1,rlonudeg) |
---|
171 | status=NF_PUT_VARA_REAL(ncid_out,out_lonvid,1,iim+1,rlonvdeg) |
---|
172 | status=NF_PUT_VARA_REAL(ncid_out,out_latuid,1,jjm+1,rlatudeg) |
---|
173 | status=NF_PUT_VARA_REAL(ncid_out,out_latvid,1,jjm,rlatvdeg) |
---|
174 | |
---|
175 | start(1)=1 |
---|
176 | start(2)=1 |
---|
177 | start(3)=1 |
---|
178 | start(4)=1 |
---|
179 | |
---|
180 | count(1)=iim+1 |
---|
181 | count(2)=jjm+1 |
---|
182 | count(3)=1 |
---|
183 | count(4)=1 |
---|
184 | |
---|
185 | do j=1,jjm+1 |
---|
186 | do i=1,iim+1 |
---|
187 | temp(i,j)=mod(i,2)+mod(j,2) |
---|
188 | enddo |
---|
189 | enddo |
---|
190 | |
---|
191 | status=NF_PUT_VARA_REAL(ncid_out,out_varid,start, |
---|
192 | s count,temp) |
---|
193 | |
---|
194 | c fermeture du fichier netcdf |
---|
195 | call ncclos(ncid_out,rcode_out) |
---|
196 | write(*,*) 'Fermeture: ',fich_out |
---|
197 | |
---|
198 | |
---|
199 | print*,'OK5' |
---|
200 | c Ecriture grads |
---|
201 | open (20,file='grille.dat',form='unformatted',access='direct' |
---|
202 | s ,recl=4*ip1jmp1) |
---|
203 | write(20,rec=1) ((float(mod(i,2)+mod(j,2)),i=1,iip1),j=1,jjp1) |
---|
204 | write(20,rec=2) ((float(mod(i,2)*mod(j,2)),i=1,iip1),j=1,jjp1) |
---|
205 | do j=2,jjm |
---|
206 | dlat1(j)=180.*(rlatv(j)-rlatv(j-1))/pi |
---|
207 | c dlat2(j)=180.*fyprim(float(j))/pi |
---|
208 | enddo |
---|
209 | do i=2,iip1 |
---|
210 | dlon1(i)=180.*(rlonu(i)-rlonu(i-1))/pi |
---|
211 | c dlon2(i)=180.*fxprim(float(i))/pi |
---|
212 | enddo |
---|
213 | do j=2,jjm |
---|
214 | dykm=(rlatv(j)-rlatv(j-1))*6400. |
---|
215 | acoslat=6400.*cos(rlatu(j)) |
---|
216 | do i=2,iip1 |
---|
217 | dxkm=acoslat*(rlonu(i)-rlonu(i-1)) |
---|
218 | resol(i,j)=sqrt(dykm*dykm+dxkm*dxkm) |
---|
219 | enddo |
---|
220 | resol(1,j)=resol(iip1,j) |
---|
221 | enddo |
---|
222 | write(20,rec=3) resol |
---|
223 | dlon1(1)=dlon1(iip1) |
---|
224 | dlon2(1)=dlon2(iip1) |
---|
225 | write(20,rec=4) ((dlon1(i),i=1,iip1),j=1,jjp1) |
---|
226 | write(20,rec=5) ((dlon2(i),i=1,iip1),j=1,jjp1) |
---|
227 | write(20,rec=6) ((dlat1(j),i=1,iip1),j=1,jjp1) |
---|
228 | write(20,rec=7) ((dlat2(j),i=1,iip1),j=1,jjp1) |
---|
229 | |
---|
230 | open (21,file='grille.ctl',form='formatted') |
---|
231 | |
---|
232 | c WARNING! on reecrase le fichier .ctl a chaque ecriture |
---|
233 | write(21,'(a5,1x,a40)') |
---|
234 | & 'DSET ','^grille.dat' |
---|
235 | |
---|
236 | write(21,'(a12)') 'UNDEF 1.0E30' |
---|
237 | write(21,'(a5,1x,a40)') 'TITLE ','grille' |
---|
238 | call formcoord(21,iip1,rlonv,180./pi,.false.,'XDEF') |
---|
239 | call formcoord(21,jjp1,rlatu,180./pi,.true.,'YDEF') |
---|
240 | call formcoord(21,1,0.,1.,.false.,'ZDEF') |
---|
241 | write(21,'(a4,i10,a30)') |
---|
242 | & 'TDEF ',1,' LINEAR 23OCT1994 3hr ' |
---|
243 | write(21,'(a4,2x,i5)') 'VARS',7 |
---|
244 | write(21,'(a18)') 'grille 0 99 grille' |
---|
245 | write(21,'(a18)') 'gril 0 99 gril ' |
---|
246 | write(21,'(a29)') 'resol 0 99 resolution (km) ' |
---|
247 | write(21,'(a18)') 'dlon1 0 99 dlon1 ' |
---|
248 | write(21,'(a18)') 'dlon2 0 99 dlon2 ' |
---|
249 | write(21,'(a18)') 'dlat1 0 99 dlat1 ' |
---|
250 | write(21,'(a18)') 'dlat2 0 99 dlat2 ' |
---|
251 | write(21,'(a7)') 'ENDVARS' |
---|
252 | |
---|
253 | |
---|
254 | |
---|
255 | |
---|
256 | |
---|
257 | print*,'OK6' |
---|
258 | end |
---|
259 | |
---|
260 | |
---|
261 | |
---|
262 | subroutine handle_err(status) |
---|
263 | #include "netcdf.inc" |
---|
264 | |
---|
265 | |
---|
266 | integer status |
---|
267 | print *,'handle code err: ',NF_NOERR |
---|
268 | IF (status.NE.nf_noerr) THEN |
---|
269 | print *,NF_STRERROR(status) |
---|
270 | stop 'stopped' |
---|
271 | ENDIF |
---|
272 | END |
---|
273 | |
---|