Line |
Branch |
Exec |
Source |
1 |
|
|
! |
2 |
|
|
! $Id: $ |
3 |
|
|
! |
4 |
|
|
! This subroutine creates the file grilles_gcm.nc containg longitudes and |
5 |
|
|
! latitudes in degrees for grid u and v. This subroutine is called from |
6 |
|
|
! ce0l. This subroutine corresponds to the first |
7 |
|
|
! part in the program create_fausse_var. |
8 |
|
|
! |
9 |
|
✗ |
SUBROUTINE grilles_gcm_netcdf_sub(masque,phis) |
10 |
|
|
|
11 |
|
|
USE comconst_mod, ONLY: cpp, kappa, g, omeg, daysec, rad, pi |
12 |
|
|
USE comvert_mod, ONLY: presnivs, preff, pa |
13 |
|
|
|
14 |
|
|
IMPLICIT NONE |
15 |
|
|
|
16 |
|
|
INCLUDE "dimensions.h" |
17 |
|
|
INCLUDE "paramet.h" |
18 |
|
|
INCLUDE "comgeom.h" |
19 |
|
|
INCLUDE "netcdf.inc" |
20 |
|
|
|
21 |
|
|
|
22 |
|
|
REAL,DIMENSION(iip1,jjp1),INTENT(IN) :: masque ! masque terre/mer |
23 |
|
|
REAL,DIMENSION(iip1,jjp1),INTENT(IN) :: phis ! geopotentiel au sol |
24 |
|
|
|
25 |
|
|
REAL temp(iim+1,jjm+1) |
26 |
|
|
! Attributs netcdf sortie |
27 |
|
|
INTEGER ncid_out,rcode_out |
28 |
|
|
INTEGER out_lonuid,out_lonvid,out_latuid,out_latvid,out_levid |
29 |
|
|
INTEGER out_varid |
30 |
|
|
INTEGER out_lonudim,out_lonvdim |
31 |
|
|
INTEGER out_latudim,out_latvdim,out_dim(3) |
32 |
|
|
INTEGER out_levdim |
33 |
|
|
|
34 |
|
|
INTEGER start(4),COUNT(4) |
35 |
|
|
|
36 |
|
|
INTEGER status,i,j |
37 |
|
|
REAL rlatudeg(jjp1),rlatvdeg(jjm),rlevdeg(llm) |
38 |
|
|
REAL rlonudeg(iip1),rlonvdeg(iip1) |
39 |
|
|
|
40 |
|
|
REAL dlon1(iip1),dlon2(iip1),dlat1(jjp1),dlat2(jjp1) |
41 |
|
|
REAL acoslat,dxkm,dykm,resol(iip1,jjp1) |
42 |
|
|
REAL,DIMENSION(iip1,jjp1) :: phis_loc |
43 |
|
|
INTEGER masque_int(iip1,jjp1) |
44 |
|
|
INTEGER :: phis_id |
45 |
|
|
INTEGER :: area_id |
46 |
|
|
INTEGER :: mask_id |
47 |
|
|
INTEGER :: presnivs_id |
48 |
|
|
|
49 |
|
✗ |
rad = 6400000 |
50 |
|
✗ |
omeg = 7.272205e-05 |
51 |
|
✗ |
g = 9.8 |
52 |
|
✗ |
kappa = 0.285716 |
53 |
|
✗ |
daysec = 86400 |
54 |
|
✗ |
cpp = 1004.70885 |
55 |
|
|
|
56 |
|
✗ |
preff = 101325. |
57 |
|
✗ |
pa= 50000. |
58 |
|
|
|
59 |
|
✗ |
CALL conf_gcm( 99, .TRUE. ) |
60 |
|
✗ |
CALL iniconst |
61 |
|
✗ |
CALL inigeom |
62 |
|
|
|
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 + 360. |
72 |
|
✗ |
rlonvdeg(i)=rlonv(i)*180./pi + 360. |
73 |
|
|
ENDDO |
74 |
|
|
|
75 |
|
|
|
76 |
|
|
! 2 ----- OUVERTURE DE LA SORTIE NETCDF |
77 |
|
|
! --------------------------------------------------- |
78 |
|
|
! CREATION OUTPUT |
79 |
|
|
! ouverture fichier netcdf de sortie out |
80 |
|
✗ |
status=NF_CREATE('grilles_gcm.nc',IOR(NF_CLOBBER,NF_64BIT_OFFSET),ncid_out) |
81 |
|
✗ |
CALL handle_err(status) |
82 |
|
✗ |
status=NF_DEF_DIM(ncid_out,'lonu',iim+1,out_lonudim) |
83 |
|
✗ |
CALL handle_err(status) |
84 |
|
✗ |
status=NF_DEF_DIM(ncid_out,'lonv',iim+1,out_lonvdim) |
85 |
|
✗ |
CALL handle_err(status) |
86 |
|
✗ |
status=NF_DEF_DIM(ncid_out,'latu',jjm+1,out_latudim) |
87 |
|
✗ |
CALL handle_err(status) |
88 |
|
✗ |
status=NF_DEF_DIM(ncid_out,'latv',jjm,out_latvdim) |
89 |
|
✗ |
CALL handle_err(status) |
90 |
|
|
|
91 |
|
|
|
92 |
|
|
! Longitudes en u |
93 |
|
✗ |
status=NF_DEF_VAR(ncid_out,'lonu',NF_FLOAT,1,out_lonudim, out_lonuid) |
94 |
|
✗ |
CALL handle_err(status) |
95 |
|
✗ |
status=NF_PUT_ATT_TEXT(ncid_out,out_lonuid,'units', 12,'degrees_east') |
96 |
|
✗ |
status=NF_PUT_ATT_TEXT(ncid_out,out_lonuid,'long_name',9,'Longitude en u') |
97 |
|
|
|
98 |
|
|
! Longitudes en v |
99 |
|
✗ |
status=NF_DEF_VAR(ncid_out,'lonv',NF_FLOAT,1,out_lonvdim, out_lonvid) |
100 |
|
✗ |
CALL handle_err(status) |
101 |
|
✗ |
status=NF_PUT_ATT_TEXT(ncid_out,out_lonvid,'units', 12,'degrees_east') |
102 |
|
✗ |
status=NF_PUT_ATT_TEXT(ncid_out,out_lonvid,'long_name', 9,'Longitude en v') |
103 |
|
|
|
104 |
|
|
! Latitude en u |
105 |
|
✗ |
status=NF_DEF_VAR(ncid_out,'latu',NF_FLOAT,1,out_latudim, out_latuid) |
106 |
|
✗ |
CALL handle_err(status) |
107 |
|
✗ |
status=NF_PUT_ATT_TEXT(ncid_out,out_latuid,'units', 13,'degrees_north') |
108 |
|
✗ |
status=NF_PUT_ATT_TEXT(ncid_out,out_latuid,'long_name', 8,'Latitude en u') |
109 |
|
|
|
110 |
|
|
! Latitude en v |
111 |
|
✗ |
status=NF_DEF_VAR(ncid_out,'latv',NF_FLOAT,1,out_latvdim, out_latvid) |
112 |
|
✗ |
CALL handle_err(status) |
113 |
|
✗ |
status=NF_PUT_ATT_TEXT(ncid_out,out_latvid,'units', 13,'degrees_north') |
114 |
|
✗ |
status=NF_PUT_ATT_TEXT(ncid_out,out_latvid,'long_name', 8,'Latitude en v') |
115 |
|
|
|
116 |
|
|
! ecriture de la grille u |
117 |
|
✗ |
out_dim(1)=out_lonudim |
118 |
|
✗ |
out_dim(2)=out_latudim |
119 |
|
✗ |
status=NF_DEF_VAR(ncid_out,'grille_u',NF_FLOAT,2,out_dim, out_varid) |
120 |
|
✗ |
CALL handle_err(status) |
121 |
|
✗ |
status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'units', 6,'Kelvin') |
122 |
|
✗ |
status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'long_name', 16,'Grille aux point u') |
123 |
|
|
|
124 |
|
|
! ecriture de la grille v |
125 |
|
✗ |
out_dim(1)=out_lonvdim |
126 |
|
✗ |
out_dim(2)=out_latvdim |
127 |
|
✗ |
status=NF_DEF_VAR(ncid_out,'grille_v',NF_FLOAT,2,out_dim, out_varid) |
128 |
|
✗ |
CALL handle_err(status) |
129 |
|
✗ |
status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'units', 6,'Kelvin') |
130 |
|
✗ |
status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'long_name', 16,'Grille aux point v') |
131 |
|
|
|
132 |
|
|
! ecriture de la grille u |
133 |
|
✗ |
out_dim(1)=out_lonvdim |
134 |
|
✗ |
out_dim(2)=out_latudim |
135 |
|
✗ |
status=NF_DEF_VAR(ncid_out,'grille_s',NF_FLOAT,2,out_dim, out_varid) |
136 |
|
✗ |
CALL handle_err(status) |
137 |
|
✗ |
status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'units', 6,'Kelvin') |
138 |
|
✗ |
status=NF_PUT_ATT_TEXT(ncid_out,out_varid,'long_name',16,'Grille aux point u') |
139 |
|
|
|
140 |
|
✗ |
status=NF_ENDDEF(ncid_out) |
141 |
|
✗ |
write(*,*) "COUCOU 6" |
142 |
|
✗ |
CALL handle_err(status) |
143 |
|
|
! 5) ----- FERMETURE DES FICHIERS NETCDF------------------ |
144 |
|
|
! -------------------------------------------------------- |
145 |
|
|
! 3-b- Ecriture de la grille pour la sortie |
146 |
|
|
! rajoute l'ecriture de la grille |
147 |
|
|
|
148 |
|
✗ |
status=NF_PUT_VARA_DOUBLE(ncid_out,out_lonuid,1,iim+1,rlonudeg) |
149 |
|
✗ |
CALL handle_err(status) |
150 |
|
✗ |
status=NF_PUT_VARA_DOUBLE(ncid_out,out_lonvid,1,iim+1,rlonvdeg) |
151 |
|
✗ |
CALL handle_err(status) |
152 |
|
✗ |
status=NF_PUT_VARA_DOUBLE(ncid_out,out_latuid,1,jjm+1,rlatudeg) |
153 |
|
✗ |
CALL handle_err(status) |
154 |
|
✗ |
status=NF_PUT_VARA_DOUBLE(ncid_out,out_latvid,1,jjm,rlatvdeg) |
155 |
|
✗ |
CALL handle_err(status) |
156 |
|
|
|
157 |
|
✗ |
start(1)=1 |
158 |
|
✗ |
start(2)=1 |
159 |
|
✗ |
start(3)=1 |
160 |
|
✗ |
start(4)=1 |
161 |
|
|
|
162 |
|
✗ |
COUNT(1)=iim+1 |
163 |
|
✗ |
COUNT(2)=jjm+1 |
164 |
|
✗ |
COUNT(3)=1 |
165 |
|
✗ |
COUNT(4)=1 |
166 |
|
|
|
167 |
|
✗ |
DO j=1,jjm+1 |
168 |
|
✗ |
DO i=1,iim+1 |
169 |
|
✗ |
temp(i,j)=MOD(i,2)+MOD(j,2) |
170 |
|
|
ENDDO |
171 |
|
|
ENDDO |
172 |
|
|
|
173 |
|
✗ |
status=NF_PUT_VARA_DOUBLE(ncid_out,out_varid,start, count,temp) |
174 |
|
✗ |
CALL handle_err(status) |
175 |
|
|
|
176 |
|
|
! On re-ouvre le fichier pour rajouter 4 nouvelles variables necessaire pour INCA |
177 |
|
|
! lev - phis - aire - mask |
178 |
|
|
! rlevdeg(:) = presnivs |
179 |
|
✗ |
rlevdeg(:) = presnivs(:) |
180 |
|
✗ |
phis_loc(:,:) = phis(:,:)/g |
181 |
|
|
|
182 |
|
|
! niveaux de pression verticaux |
183 |
|
✗ |
status = NF_REDEF (ncid_out) |
184 |
|
✗ |
CALL handle_err(status) |
185 |
|
✗ |
status=NF_DEF_DIM(ncid_out,'lev',llm,out_levdim) |
186 |
|
✗ |
CALL handle_err(status) |
187 |
|
|
status=NF_DEF_VAR(ncid_out,'presnivs',NF_FLOAT,1,out_levdim,& |
188 |
|
✗ |
presnivs_id) |
189 |
|
✗ |
CALL handle_err(status) |
190 |
|
|
|
191 |
|
|
! fields |
192 |
|
✗ |
out_dim(1)=out_lonvdim |
193 |
|
✗ |
out_dim(2)=out_latudim |
194 |
|
|
|
195 |
|
✗ |
status = nf_def_var(ncid_out,'phis',NF_FLOAT,2,out_dim,phis_id) |
196 |
|
✗ |
CALL handle_err(status) |
197 |
|
✗ |
status = nf_def_var(ncid_out,'aire',NF_FLOAT,2,out_dim,area_id) |
198 |
|
✗ |
CALL handle_err(status) |
199 |
|
✗ |
status = nf_def_var(ncid_out,'mask',NF_INT ,2,out_dim,mask_id) |
200 |
|
✗ |
CALL handle_err(status) |
201 |
|
|
|
202 |
|
✗ |
status=NF_ENDDEF(ncid_out) |
203 |
|
✗ |
CALL handle_err(status) |
204 |
|
|
|
205 |
|
|
! ecriture des variables |
206 |
|
✗ |
status=NF_PUT_VARA_DOUBLE(ncid_out,presnivs_id,1,llm,rlevdeg) |
207 |
|
✗ |
CALL handle_err(status) |
208 |
|
|
|
209 |
|
✗ |
start(1)=1 |
210 |
|
✗ |
start(2)=1 |
211 |
|
✗ |
start(3)=1 |
212 |
|
✗ |
start(4)=0 |
213 |
|
✗ |
COUNT(1)=iip1 |
214 |
|
✗ |
COUNT(2)=jjp1 |
215 |
|
✗ |
COUNT(3)=1 |
216 |
|
✗ |
COUNT(4)=0 |
217 |
|
|
|
218 |
|
✗ |
status = nf_put_vara_double(ncid_out, phis_id,start,count, phis_loc) |
219 |
|
✗ |
CALL handle_err(status) |
220 |
|
✗ |
status = nf_put_vara_double(ncid_out, area_id,start,count, aire) |
221 |
|
✗ |
CALL handle_err(status) |
222 |
|
✗ |
masque_int(:,:) = nINT(masque(:,:)) |
223 |
|
✗ |
status = nf_put_vara_int(ncid_out, mask_id,start,count,masque_int) |
224 |
|
✗ |
CALL handle_err(status) |
225 |
|
|
|
226 |
|
|
! fermeture du fichier netcdf |
227 |
|
✗ |
CALL ncclos(ncid_out,rcode_out) |
228 |
|
|
|
229 |
|
✗ |
END SUBROUTINE grilles_gcm_netcdf_sub |
230 |
|
|
|
231 |
|
|
|
232 |
|
|
|
233 |
|
✗ |
SUBROUTINE handle_err(status) |
234 |
|
|
INCLUDE "netcdf.inc" |
235 |
|
|
|
236 |
|
|
INTEGER status |
237 |
|
✗ |
IF (status.NE.nf_noerr) THEN |
238 |
|
✗ |
PRINT *,NF_STRERROR(status) |
239 |
|
✗ |
CALL abort_gcm('grilles_gcm_netcdf','netcdf error',1) |
240 |
|
|
ENDIF |
241 |
|
✗ |
END SUBROUTINE handle_err |
242 |
|
|
|
243 |
|
|
|