1 |
|
|
! |
2 |
|
|
! $Id: $ |
3 |
|
|
! |
4 |
|
|
! This subroutine creates the grilles_gcm.nc file, containing: |
5 |
|
|
! -> longitudes and latitudes in degrees for dynamical grids u, v and scalaire, |
6 |
|
|
! and the following variables added for INCA (informative anyway) |
7 |
|
|
! -> vertical levels "presnivs" |
8 |
|
|
! -> mask (land/sea), area (grid), phis=surface geopotential height = phis/g |
9 |
|
|
! |
10 |
|
|
! The subroutine is called in dynphy_lonlat/phylmd/ce0l.F90. |
11 |
|
|
|
12 |
|
|
SUBROUTINE grilles_gcm_netcdf_sub(masque,phis) |
13 |
|
|
|
14 |
|
|
USE comconst_mod, ONLY: cpp, kappa, g, omeg, daysec, rad, pi |
15 |
|
|
USE comvert_mod, ONLY: presnivs, preff, pa |
16 |
|
|
use netcdf, only: nf90_def_var, nf90_int, nf90_float, nf90_put_var |
17 |
|
|
|
18 |
|
|
IMPLICIT NONE |
19 |
|
|
|
20 |
|
|
INCLUDE "dimensions.h" |
21 |
|
|
INCLUDE "paramet.h" |
22 |
|
|
INCLUDE "comgeom.h" |
23 |
|
|
INCLUDE "netcdf.inc" |
24 |
|
|
|
25 |
|
|
!======================== |
26 |
|
|
REAL,DIMENSION(iip1,jjp1),INTENT(IN) :: masque ! masque terre/mer |
27 |
|
|
REAL,DIMENSION(iip1,jjp1),INTENT(IN) :: phis ! geopotentiel au sol |
28 |
|
|
|
29 |
|
|
INTEGER status,i,j |
30 |
|
|
|
31 |
|
|
! Attributs netcdf output |
32 |
|
|
INTEGER ncid_out,rcode_out |
33 |
|
|
|
34 |
|
|
INTEGER out_lonuid,out_lonvid,out_latuid,out_latvid |
35 |
|
|
INTEGER out_uid,out_vid,out_tempid |
36 |
|
|
INTEGER out_lonudim,out_lonvdim |
37 |
|
|
INTEGER out_latudim,out_latvdim,out_dim(2) |
38 |
|
|
INTEGER out_levdim |
39 |
|
|
! |
40 |
|
|
INTEGER :: presnivs_id |
41 |
|
|
INTEGER :: mask_id,area_id,phis_id |
42 |
|
|
! |
43 |
|
|
INTEGER start(2),COUNT(2) |
44 |
|
|
|
45 |
|
|
! Variables |
46 |
|
|
REAL rlatudeg(jjp1),rlatvdeg(jjm),rlev(llm) |
47 |
|
|
REAL rlonudeg(iip1),rlonvdeg(iip1) |
48 |
|
|
REAL uwnd(iip1,jjp1),vwnd(iip1,jjm),temp(iip1,jjp1) |
49 |
|
|
! |
50 |
|
|
INTEGER masque_int(iip1,jjp1) |
51 |
|
|
REAL :: phis_loc(iip1,jjp1) |
52 |
|
|
|
53 |
|
|
!======================== |
54 |
|
|
! CALCULATION of latu, latv, lonu, lonv in deg. |
55 |
|
|
! --------------------------------------------------- |
56 |
|
|
rad = 6400000 |
57 |
|
|
omeg = 7.272205e-05 |
58 |
|
|
g = 9.8 |
59 |
|
|
kappa = 0.285716 |
60 |
|
|
daysec = 86400 |
61 |
|
|
cpp = 1004.70885 |
62 |
|
|
|
63 |
|
|
preff = 101325. |
64 |
|
|
pa= 50000. |
65 |
|
|
|
66 |
|
|
CALL conf_gcm( 99, .TRUE. ) |
67 |
|
|
CALL iniconst |
68 |
|
|
CALL inigeom |
69 |
|
|
|
70 |
|
|
DO j=1,jjp1 |
71 |
|
|
rlatudeg(j)=rlatu(j)*180./pi |
72 |
|
|
ENDDO |
73 |
|
|
|
74 |
|
|
DO j=1,jjm |
75 |
|
|
rlatvdeg(j)=rlatv(j)*180./pi |
76 |
|
|
ENDDO |
77 |
|
|
|
78 |
|
|
DO i=1,iip1 |
79 |
|
|
rlonudeg(i)=rlonu(i)*180./pi + 360. |
80 |
|
|
rlonvdeg(i)=rlonv(i)*180./pi + 360. |
81 |
|
|
ENDDO |
82 |
|
|
|
83 |
|
|
! CALCULATION of "false" variables on u, v, s grids |
84 |
|
|
! --------------------------------------------------- |
85 |
|
|
DO i=1,iip1 |
86 |
|
|
DO j=1,jjp1 |
87 |
|
|
uwnd(i,j)=MOD(i,2)+MOD(j,2) |
88 |
|
|
temp(i,j)=MOD(i,2)+MOD(j,2) |
89 |
|
|
ENDDO |
90 |
|
|
DO j=1,jjm |
91 |
|
|
vwnd(i,j)=MOD(i,2)+MOD(j,2) |
92 |
|
|
END DO |
93 |
|
|
ENDDO |
94 |
|
|
|
95 |
|
|
! CALCULATION of local vars for presnivs, mask, sfc. geopot. height |
96 |
|
|
! --------------------------------------------------- |
97 |
|
|
rlev(:) = presnivs(:) |
98 |
|
|
phis_loc(:,:) = phis(:,:)/g |
99 |
|
|
masque_int(:,:) = nINT(masque(:,:)) |
100 |
|
|
|
101 |
|
|
|
102 |
|
|
! OPEN output netcdf file |
103 |
|
|
!------------------------- |
104 |
|
|
status=NF_CREATE('grilles_gcm.nc',IOR(NF_CLOBBER,NF_64BIT_OFFSET),ncid_out) |
105 |
|
|
CALL handle_err(status) |
106 |
|
|
|
107 |
|
|
! DEFINE output dimensions |
108 |
|
|
!------------------------- |
109 |
|
|
status=NF_DEF_DIM(ncid_out,'lonu',iim+1,out_lonudim) |
110 |
|
|
CALL handle_err(status) |
111 |
|
|
status=NF_DEF_DIM(ncid_out,'lonv',iim+1,out_lonvdim) |
112 |
|
|
CALL handle_err(status) |
113 |
|
|
status=NF_DEF_DIM(ncid_out,'latu',jjm+1,out_latudim) |
114 |
|
|
CALL handle_err(status) |
115 |
|
|
status=NF_DEF_DIM(ncid_out,'latv',jjm,out_latvdim) |
116 |
|
|
CALL handle_err(status) |
117 |
|
|
! |
118 |
|
|
status=NF_DEF_DIM(ncid_out,'lev',llm,out_levdim) |
119 |
|
|
CALL handle_err(status) |
120 |
|
|
|
121 |
|
|
! DEFINE output variables |
122 |
|
|
!------------------------- |
123 |
|
|
! Longitudes on "u" dynamical grid |
124 |
|
|
status=NF90_DEF_VAR(ncid_out,'lonu',NF90_FLOAT,out_lonudim, out_lonuid) |
125 |
|
|
CALL handle_err(status) |
126 |
|
|
status=NF_PUT_ATT_TEXT(ncid_out,out_lonuid,'units', 12,'degrees_east') |
127 |
|
|
status=NF_PUT_ATT_TEXT(ncid_out,out_lonuid,'long_name',19,'Longitude on u grid') |
128 |
|
|
! Longitudes on "v" dynamical grid |
129 |
|
|
status=NF90_DEF_VAR(ncid_out,'lonv',NF90_FLOAT,out_lonvdim, out_lonvid) |
130 |
|
|
CALL handle_err(status) |
131 |
|
|
status=NF_PUT_ATT_TEXT(ncid_out,out_lonvid,'units', 12,'degrees_east') |
132 |
|
|
status=NF_PUT_ATT_TEXT(ncid_out,out_lonvid,'long_name', 19,'Longitude on v grid') |
133 |
|
|
! Latitudes on "u" dynamical grid |
134 |
|
|
status=NF90_DEF_VAR(ncid_out,'latu',NF90_FLOAT,out_latudim, out_latuid) |
135 |
|
|
CALL handle_err(status) |
136 |
|
|
status=NF_PUT_ATT_TEXT(ncid_out,out_latuid,'units', 13,'degrees_north') |
137 |
|
|
status=NF_PUT_ATT_TEXT(ncid_out,out_latuid,'long_name', 18,'Latitude on u grid') |
138 |
|
|
! Latitudes on "v" dynamical grid |
139 |
|
|
status=NF90_DEF_VAR(ncid_out,'latv',NF90_FLOAT,out_latvdim, out_latvid) |
140 |
|
|
CALL handle_err(status) |
141 |
|
|
status=NF_PUT_ATT_TEXT(ncid_out,out_latvid,'units', 13,'degrees_north') |
142 |
|
|
status=NF_PUT_ATT_TEXT(ncid_out,out_latvid,'long_name', 18,'Latitude on v grid') |
143 |
|
|
! "u" lat/lon dynamical grid |
144 |
|
|
out_dim(1)=out_lonudim |
145 |
|
|
out_dim(2)=out_latudim |
146 |
|
|
status=NF90_DEF_VAR(ncid_out,'grille_u',NF90_FLOAT,out_dim, out_uid) |
147 |
|
|
CALL handle_err(status) |
148 |
|
|
status=NF_PUT_ATT_TEXT(ncid_out,out_uid,'units', 3,'m/s') |
149 |
|
|
status=NF_PUT_ATT_TEXT(ncid_out,out_uid,'long_name', 21,'u-wind dynamical grid') |
150 |
|
|
! "v" lat/lon dynamical grid |
151 |
|
|
out_dim(1)=out_lonvdim |
152 |
|
|
out_dim(2)=out_latvdim |
153 |
|
|
status=NF90_DEF_VAR(ncid_out,'grille_v',NF90_FLOAT,out_dim, out_vid) |
154 |
|
|
CALL handle_err(status) |
155 |
|
|
status=NF_PUT_ATT_TEXT(ncid_out,out_vid,'units', 3,'m/s') |
156 |
|
|
status=NF_PUT_ATT_TEXT(ncid_out,out_vid,'long_name', 21,'v-wind dynamical grid') |
157 |
|
|
! "s" (scalar) lat/lon dynamical grid |
158 |
|
|
out_dim(1)=out_lonvdim |
159 |
|
|
out_dim(2)=out_latudim |
160 |
|
|
status=NF90_DEF_VAR(ncid_out,'grille_s',NF90_FLOAT,out_dim, out_tempid) |
161 |
|
|
CALL handle_err(status) |
162 |
|
|
status=NF_PUT_ATT_TEXT(ncid_out,out_tempid,'units', 6,'Kelvin') |
163 |
|
|
status=NF_PUT_ATT_TEXT(ncid_out,out_tempid,'long_name',21,'scalar dynamical grid') |
164 |
|
|
! |
165 |
|
|
! for INCA : |
166 |
|
|
! vertical levels "presnivs" |
167 |
|
|
status=NF90_DEF_VAR(ncid_out,'presnivs',NF90_FLOAT,out_levdim, presnivs_id) |
168 |
|
|
CALL handle_err(status) |
169 |
|
|
status=NF_PUT_ATT_TEXT(ncid_out,presnivs_id,'units', 2,'Pa') |
170 |
|
|
status=NF_PUT_ATT_TEXT(ncid_out,presnivs_id,'long_name',15,'Vertical levels') |
171 |
|
|
! surface geopotential height: named "phis" as the sfc geopotential, is actually phis/g |
172 |
|
|
out_dim(1)=out_lonvdim |
173 |
|
|
out_dim(2)=out_latudim |
174 |
|
|
status = nf90_def_var(ncid_out,'phis',NF90_FLOAT,out_dim,phis_id) |
175 |
|
|
CALL handle_err(status) |
176 |
|
|
status=NF_PUT_ATT_TEXT(ncid_out,phis_id,'units', 1,'m') |
177 |
|
|
status=NF_PUT_ATT_TEXT(ncid_out,phis_id,'long_name',27,'surface geopotential height') |
178 |
|
|
! gridcell area |
179 |
|
|
status = nf90_def_var(ncid_out,'aire',NF90_FLOAT,out_dim,area_id) |
180 |
|
|
CALL handle_err(status) |
181 |
|
|
status=NF_PUT_ATT_TEXT(ncid_out,area_id,'units', 2,'m2') |
182 |
|
|
status=NF_PUT_ATT_TEXT(ncid_out,area_id,'long_name',13,'gridcell area') |
183 |
|
|
! land-sea mask (nearest integer approx) |
184 |
|
|
status = nf90_def_var(ncid_out,'mask',NF90_INT,out_dim,mask_id) |
185 |
|
|
CALL handle_err(status) |
186 |
|
|
status=NF_PUT_ATT_TEXT(ncid_out,mask_id,'long_name',27,'land-sea mask (nINT approx)') |
187 |
|
|
|
188 |
|
|
! END the 'define' mode in netCDF file |
189 |
|
|
status=NF_ENDDEF(ncid_out) |
190 |
|
|
CALL handle_err(status) |
191 |
|
|
|
192 |
|
|
! WRITE the variables |
193 |
|
|
!------------------------- |
194 |
|
|
! 1D : lonu, lonv,latu,latv ; INCA : presnivs |
195 |
|
|
status=NF90_PUT_VAR(ncid_out,out_lonuid,rlonudeg,[1],[iip1]) |
196 |
|
|
CALL handle_err(status) |
197 |
|
|
status=NF90_PUT_VAR(ncid_out,out_lonvid,rlonvdeg,[1],[iip1]) |
198 |
|
|
CALL handle_err(status) |
199 |
|
|
status=NF90_PUT_VAR(ncid_out,out_latuid,rlatudeg,[1],[jjp1]) |
200 |
|
|
CALL handle_err(status) |
201 |
|
|
status=NF90_PUT_VAR(ncid_out,out_latvid,rlatvdeg,[1],[jjm]) |
202 |
|
|
CALL handle_err(status) |
203 |
|
|
status=NF90_PUT_VAR(ncid_out,presnivs_id,rlev,[1],[llm]) |
204 |
|
|
CALL handle_err(status) |
205 |
|
|
|
206 |
|
|
! 2D : grille_u,grille_v,grille_s ; INCA: phis,aire,mask |
207 |
|
|
start(:)=1 |
208 |
|
|
COUNT(1)=iip1 |
209 |
|
|
|
210 |
|
|
COUNT(2)=jjp1 ! for "u" and "s" grids |
211 |
|
|
status=NF90_PUT_VAR(ncid_out,out_uid,uwnd,start, count) |
212 |
|
|
CALL handle_err(status) |
213 |
|
|
COUNT(2)=jjm ! for "v" grid |
214 |
|
|
status=NF90_PUT_VAR(ncid_out,out_vid,vwnd,start, count) |
215 |
|
|
CALL handle_err(status) |
216 |
|
|
COUNT(2)=jjp1 ! as "s" grid, for all the following vars |
217 |
|
|
status=NF90_PUT_VAR(ncid_out,out_tempid,temp,start, count) |
218 |
|
|
CALL handle_err(status) |
219 |
|
|
status = nf90_put_var(ncid_out, phis_id, phis_loc,start,count) |
220 |
|
|
CALL handle_err(status) |
221 |
|
|
status = nf90_put_var(ncid_out, area_id, aire,start,count) |
222 |
|
|
CALL handle_err(status) |
223 |
|
|
status = nf90_put_var(ncid_out, mask_id,masque_int,start,count) |
224 |
|
|
CALL handle_err(status) |
225 |
|
|
|
226 |
|
|
! CLOSE netcdf file |
227 |
|
|
CALL ncclos(ncid_out,rcode_out) |
228 |
|
|
write(*,*) "END grilles_gcm_netcdf_sub OK" |
229 |
|
|
|
230 |
|
|
END SUBROUTINE grilles_gcm_netcdf_sub |
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 |
|
|
|