1 |
|
|
|
2 |
|
|
! $Id: read_pstoke0.F90 2345 2015-08-21 09:57:36Z emillour $ |
3 |
|
|
|
4 |
|
|
|
5 |
|
|
|
6 |
|
|
SUBROUTINE read_pstoke0(irec, zrec, zkon, zkev, airefi, phisfi, t, mfu, mfd, & |
7 |
|
|
en_u, de_u, en_d, de_d, coefh, fm_therm, en_therm, frac_impa, frac_nucl, & |
8 |
|
|
pyu1, pyv1, ftsol, psrf) |
9 |
|
|
|
10 |
|
|
! ****************************************************************************** |
11 |
|
|
! Frederic HOURDIN, Abderrahmane IDELKADI |
12 |
|
|
! Lecture des parametres physique stockes online necessaires pour |
13 |
|
|
! recalculer offline le transport des traceurs sur la meme grille que |
14 |
|
|
! online |
15 |
|
|
! A FAIRE : une seule routine au lieu de 2 (lectflux, redecoupe)! |
16 |
|
|
! ****************************************************************************** |
17 |
|
|
|
18 |
|
|
USE netcdf |
19 |
|
|
USE dimphy |
20 |
|
|
USE indice_sol_mod |
21 |
|
|
USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, nbp_lev |
22 |
|
|
|
23 |
|
|
IMPLICIT NONE |
24 |
|
|
|
25 |
|
|
include "netcdf.inc" |
26 |
|
|
|
27 |
|
|
INTEGER kon, kev, zkon, zkev |
28 |
|
|
! PARAMETER (kon=iim*(jjm-1)+2, kev=llm) |
29 |
|
|
REAL :: phisfi(nbp_lon*(nbp_lat-2)+2) !phisfi(kon) |
30 |
|
|
REAL,ALLOCATABLE :: phisfi2(:,:) !phisfi2(nbp_lon, nbp_lat) |
31 |
|
|
REAL,ALLOCATABLE :: airefi2(:,:) !airefi2(nbp_lon, nbp_lat) |
32 |
|
|
|
33 |
|
|
REAL :: mfu(nbp_lon*(nbp_lat-2)+2,nbp_lev) !mfu(kon, kev) |
34 |
|
|
REAL :: mfd(nbp_lon*(nbp_lat-2)+2,nbp_lev) !mfd(kon, kev) |
35 |
|
|
REAL :: en_u(nbp_lon*(nbp_lat-2)+2,nbp_lev) !en_u(kon, kev) |
36 |
|
|
REAL :: de_u(nbp_lon*(nbp_lat-2)+2,nbp_lev) !de_u(kon, kev) |
37 |
|
|
REAL :: en_d(nbp_lon*(nbp_lat-2)+2,nbp_lev) !en_d(kon, kev) |
38 |
|
|
REAL :: de_d(nbp_lon*(nbp_lat-2)+2,nbp_lev) !de_d(kon, kev) |
39 |
|
|
REAL :: coefh(nbp_lon*(nbp_lat-2)+2,nbp_lev) !coefh(kon, kev) |
40 |
|
|
|
41 |
|
|
! abd 25 11 02 |
42 |
|
|
! Thermiques |
43 |
|
|
REAL :: fm_therm(nbp_lon*(nbp_lat-2)+2,nbp_lev) !fm_therm(kon, kev) |
44 |
|
|
REAL :: en_therm(nbp_lon*(nbp_lat-2)+2,nbp_lev) !en_therm(kon, kev) |
45 |
|
|
REAL :: t(nbp_lon*(nbp_lat-2)+2,nbp_lev) !t(kon, kev) |
46 |
|
|
|
47 |
|
|
REAL,ALLOCATABLE :: mfu2(:,:,:) !mfu2(nbp_lon, nbp_lat, kev) |
48 |
|
|
REAL,ALLOCATABLE :: mfd2(:,:,:) !mfd2(nbp_lon, nbp_lat, kev) |
49 |
|
|
REAL,ALLOCATABLE :: en_u2(:,:,:) !en_u2(nbp_lon, nbp_lat, kev) |
50 |
|
|
REAL,ALLOCATABLE :: de_u2(:,:,:) !de_u2(nbp_lon, nbp_lat, kev) |
51 |
|
|
REAL,ALLOCATABLE :: en_d2(:,:,:) !en_d2(nbp_lon, nbp_lat, kev) |
52 |
|
|
REAL,ALLOCATABLE :: de_d2(:,:,:) !de_d2(nbp_lon, nbp_lat, kev) |
53 |
|
|
REAL,ALLOCATABLE :: coefh2(:,:,:) !coefh2(nbp_lon, nbp_lat, kev) |
54 |
|
|
REAL,ALLOCATABLE :: t2(:,:,:) !t2(nbp_lon, nbp_lat, kev) |
55 |
|
|
! Thermiques |
56 |
|
|
REAL,ALLOCATABLE :: fm_therm2(:,:,:) !fm_therm2(nbp_lon, nbp_lat, kev) |
57 |
|
|
REAL,ALLOCATABLE :: en_therm2(:,:,:) !en_therm2(nbp_lon, nbp_lat, kev) |
58 |
|
|
|
59 |
|
|
REAL,ALLOCATABLE :: pl(:) !pl(kev) |
60 |
|
|
INTEGER irec |
61 |
|
|
INTEGER xid, yid, zid, tid |
62 |
|
|
INTEGER zrec, zim, zjm |
63 |
|
|
INTEGER ncrec, nckon, nckev, ncim, ncjm |
64 |
|
|
|
65 |
|
|
REAL :: airefi(nbp_lon*(nbp_lat-2)+2) !airefi(kon) |
66 |
|
|
CHARACTER *20 namedim |
67 |
|
|
|
68 |
|
|
! !! attention !! |
69 |
|
|
! attention il y a aussi le pb de def kon |
70 |
|
|
! dim de phis?? |
71 |
|
|
|
72 |
|
|
REAL :: frac_impa(nbp_lon*(nbp_lat-2)+2,nbp_lev) !frac_impa(kon, kev) |
73 |
|
|
REAL :: frac_nucl(nbp_lon*(nbp_lat-2)+2,nbp_lev) !frac_nucl(kon, kev) |
74 |
|
|
REAL,ALLOCATABLE :: frac_impa2(:,:,:) !frac_impa2(nbp_lon, nbp_lat, kev) |
75 |
|
|
REAL,ALLOCATABLE :: frac_nucl2(:,:,:) !frac_nucl2(nbp_lon, nbp_lat, kev) |
76 |
|
|
REAL :: pyu1(nbp_lon*(nbp_lat-2)+2) !pyu1(kon) |
77 |
|
|
REAL :: pyv1(nbp_lon*(nbp_lat-2)+2) !pyv1(kon) |
78 |
|
|
REAL,ALLOCATABLE :: pyu12(:,:), pyv12(:,:) !pyu12(nbp_lon, nbp_lat), pyv12(nbp_lon, nbp_lat) |
79 |
|
|
REAL :: ftsol(nbp_lon*(nbp_lat-2)+2,nbp_lev) !ftsol(kon, nbsrf) |
80 |
|
|
REAL :: psrf(nbp_lon*(nbp_lat-2)+2,nbp_lev) !psrf(kon, nbsrf) |
81 |
|
|
REAL,ALLOCATABLE :: ftsol1(:),ftsol2(:) !ftsol1(kon), ftsol2(kon) |
82 |
|
|
REAL,ALLOCATABLE :: ftsol3(:),ftsol4(:) !ftsol3(kon), ftsol4(kon) |
83 |
|
|
REAL,ALLOCATABLE :: psrf1(:), psrf2(:) !psrf1(kon), psrf2(kon) |
84 |
|
|
REAL,ALLOCATABLE :: psrf3(:), psrf4(:) !psrf3(kon), psrf4(kon) |
85 |
|
|
REAL,ALLOCATABLE :: ftsol12(:,:) !ftsol12(nbp_lon, nbp_lat) |
86 |
|
|
REAL,ALLOCATABLE :: ftsol22(:,:) !ftsol22(nbp_lon, nbp_lat) |
87 |
|
|
REAL,ALLOCATABLE :: ftsol32(:,:) !ftsol32(nbp_lon, nbp_lat) |
88 |
|
|
REAL,ALLOCATABLE :: ftsol42(:,:) !ftsol42(nbp_lon, nbp_lat) |
89 |
|
|
REAL,ALLOCATABLE :: psrf12(:,:) !psrf12(nbp_lon, nbp_lat) |
90 |
|
|
REAL,ALLOCATABLE :: psrf22(:,:) !psrf22(nbp_lon, nbp_lat) |
91 |
|
|
REAL,ALLOCATABLE :: psrf32(:,:) !psrf32(nbp_lon, nbp_lat) |
92 |
|
|
REAL,ALLOCATABLE :: psrf42(:,:) !psrf42(nbp_lon, nbp_lat) |
93 |
|
|
|
94 |
|
|
INTEGER,SAVE :: ncidp |
95 |
|
|
INTEGER,SAVE :: varidmfu, varidmfd, varidps, varidenu, variddeu |
96 |
|
|
INTEGER,SAVE :: varidt |
97 |
|
|
INTEGER,SAVE :: varidend, varidded, varidch, varidfi, varidfn |
98 |
|
|
! therm |
99 |
|
|
INTEGER,SAVE :: varidfmth, varidenth |
100 |
|
|
INTEGER,SAVE :: varidyu1, varidyv1, varidpl, varidai, varididvt |
101 |
|
|
INTEGER,SAVE :: varidfts1, varidfts2, varidfts3, varidfts4 |
102 |
|
|
INTEGER,SAVE :: varidpsr1, varidpsr2, varidpsr3, varidpsr4 |
103 |
|
|
|
104 |
|
|
INTEGER l, i |
105 |
|
|
INTEGER start(4), count(4), status |
106 |
|
|
REAL rcode |
107 |
|
|
LOGICAL,SAVE :: first=.TRUE. |
108 |
|
|
|
109 |
|
|
! Allocate arrays |
110 |
|
|
kon=nbp_lon*(nbp_lat-2)+2 |
111 |
|
|
kev=nbp_lev |
112 |
|
|
|
113 |
|
|
ALLOCATE(phisfi2(nbp_lon, nbp_lat)) |
114 |
|
|
ALLOCATE(airefi2(nbp_lon, nbp_lat)) |
115 |
|
|
ALLOCATE(mfu2(nbp_lon, nbp_lat, kev)) |
116 |
|
|
ALLOCATE(mfd2(nbp_lon, nbp_lat, kev)) |
117 |
|
|
ALLOCATE(en_u2(nbp_lon, nbp_lat, kev)) |
118 |
|
|
ALLOCATE(de_u2(nbp_lon, nbp_lat, kev)) |
119 |
|
|
ALLOCATE(en_d2(nbp_lon, nbp_lat, kev)) |
120 |
|
|
ALLOCATE(de_d2(nbp_lon, nbp_lat, kev)) |
121 |
|
|
ALLOCATE(coefh2(nbp_lon, nbp_lat, kev)) |
122 |
|
|
ALLOCATE(t2(nbp_lon, nbp_lat, kev)) |
123 |
|
|
ALLOCATE(fm_therm2(nbp_lon, nbp_lat, kev)) |
124 |
|
|
ALLOCATE(en_therm2(nbp_lon, nbp_lat, kev)) |
125 |
|
|
ALLOCATE(pl(kev)) |
126 |
|
|
ALLOCATE(frac_impa2(nbp_lon, nbp_lat, kev)) |
127 |
|
|
ALLOCATE(frac_nucl2(nbp_lon, nbp_lat, kev)) |
128 |
|
|
ALLOCATE(pyu12(nbp_lon, nbp_lat), pyv12(nbp_lon, nbp_lat)) |
129 |
|
|
ALLOCATE(ftsol1(kon), ftsol2(kon)) |
130 |
|
|
ALLOCATE(ftsol3(kon), ftsol4(kon)) |
131 |
|
|
ALLOCATE(psrf1(kon), psrf2(kon)) |
132 |
|
|
ALLOCATE(psrf3(kon), psrf4(kon)) |
133 |
|
|
ALLOCATE(ftsol12(nbp_lon, nbp_lat)) |
134 |
|
|
ALLOCATE(ftsol22(nbp_lon, nbp_lat)) |
135 |
|
|
ALLOCATE(ftsol32(nbp_lon, nbp_lat)) |
136 |
|
|
ALLOCATE(ftsol42(nbp_lon, nbp_lat)) |
137 |
|
|
ALLOCATE(psrf12(nbp_lon, nbp_lat)) |
138 |
|
|
ALLOCATE(psrf22(nbp_lon, nbp_lat)) |
139 |
|
|
ALLOCATE(psrf32(nbp_lon, nbp_lat)) |
140 |
|
|
ALLOCATE(psrf42(nbp_lon, nbp_lat)) |
141 |
|
|
|
142 |
|
|
! --------------------------------------------- |
143 |
|
|
! Initialisation de la lecture des fichiers |
144 |
|
|
! --------------------------------------------- |
145 |
|
|
|
146 |
|
|
IF (irec==0) THEN |
147 |
|
|
|
148 |
|
|
rcode = nf90_open('phystoke.nc', nf90_nowrite, ncidp) |
149 |
|
|
|
150 |
|
|
rcode = nf90_inq_varid(ncidp, 'phis', varidps) |
151 |
|
|
PRINT *, 'ncidp,varidps', ncidp, varidps |
152 |
|
|
|
153 |
|
|
rcode = nf90_inq_varid(ncidp, 'sig_s', varidpl) |
154 |
|
|
PRINT *, 'ncidp,varidpl', ncidp, varidpl |
155 |
|
|
|
156 |
|
|
rcode = nf90_inq_varid(ncidp, 'aire', varidai) |
157 |
|
|
PRINT *, 'ncidp,varidai', ncidp, varidai |
158 |
|
|
|
159 |
|
|
rcode = nf90_inq_varid(ncidp, 't', varidt) |
160 |
|
|
PRINT *, 'ncidp,varidt', ncidp, varidt |
161 |
|
|
|
162 |
|
|
rcode = nf90_inq_varid(ncidp, 'mfu', varidmfu) |
163 |
|
|
PRINT *, 'ncidp,varidmfu', ncidp, varidmfu |
164 |
|
|
|
165 |
|
|
rcode = nf90_inq_varid(ncidp, 'mfd', varidmfd) |
166 |
|
|
PRINT *, 'ncidp,varidmfd', ncidp, varidmfd |
167 |
|
|
|
168 |
|
|
rcode = nf90_inq_varid(ncidp, 'en_u', varidenu) |
169 |
|
|
PRINT *, 'ncidp,varidenu', ncidp, varidenu |
170 |
|
|
|
171 |
|
|
rcode = nf90_inq_varid(ncidp, 'de_u', variddeu) |
172 |
|
|
PRINT *, 'ncidp,variddeu', ncidp, variddeu |
173 |
|
|
|
174 |
|
|
rcode = nf90_inq_varid(ncidp, 'en_d', varidend) |
175 |
|
|
PRINT *, 'ncidp,varidend', ncidp, varidend |
176 |
|
|
|
177 |
|
|
rcode = nf90_inq_varid(ncidp, 'de_d', varidded) |
178 |
|
|
PRINT *, 'ncidp,varidded', ncidp, varidded |
179 |
|
|
|
180 |
|
|
rcode = nf90_inq_varid(ncidp, 'coefh', varidch) |
181 |
|
|
PRINT *, 'ncidp,varidch', ncidp, varidch |
182 |
|
|
|
183 |
|
|
! Thermiques |
184 |
|
|
rcode = nf90_inq_varid(ncidp, 'fm_th', varidfmth) |
185 |
|
|
PRINT *, 'ncidp,varidfmth', ncidp, varidfmth |
186 |
|
|
|
187 |
|
|
rcode = nf90_inq_varid(ncidp, 'en_th', varidenth) |
188 |
|
|
PRINT *, 'ncidp,varidenth', ncidp, varidenth |
189 |
|
|
|
190 |
|
|
rcode = nf90_inq_varid(ncidp, 'frac_impa', varidfi) |
191 |
|
|
PRINT *, 'ncidp,varidfi', ncidp, varidfi |
192 |
|
|
|
193 |
|
|
rcode = nf90_inq_varid(ncidp, 'frac_nucl', varidfn) |
194 |
|
|
PRINT *, 'ncidp,varidfn', ncidp, varidfn |
195 |
|
|
|
196 |
|
|
rcode = nf90_inq_varid(ncidp, 'pyu1', varidyu1) |
197 |
|
|
PRINT *, 'ncidp,varidyu1', ncidp, varidyu1 |
198 |
|
|
|
199 |
|
|
rcode = nf90_inq_varid(ncidp, 'pyv1', varidyv1) |
200 |
|
|
PRINT *, 'ncidp,varidyv1', ncidp, varidyv1 |
201 |
|
|
|
202 |
|
|
rcode = nf90_inq_varid(ncidp, 'ftsol1', varidfts1) |
203 |
|
|
PRINT *, 'ncidp,varidfts1', ncidp, varidfts1 |
204 |
|
|
|
205 |
|
|
rcode = nf90_inq_varid(ncidp, 'ftsol2', varidfts2) |
206 |
|
|
PRINT *, 'ncidp,varidfts2', ncidp, varidfts2 |
207 |
|
|
|
208 |
|
|
rcode = nf90_inq_varid(ncidp, 'ftsol3', varidfts3) |
209 |
|
|
PRINT *, 'ncidp,varidfts3', ncidp, varidfts3 |
210 |
|
|
|
211 |
|
|
rcode = nf90_inq_varid(ncidp, 'ftsol4', varidfts4) |
212 |
|
|
PRINT *, 'ncidp,varidfts4', ncidp, varidfts4 |
213 |
|
|
|
214 |
|
|
rcode = nf90_inq_varid(ncidp, 'psrf1', varidpsr1) |
215 |
|
|
PRINT *, 'ncidp,varidpsr1', ncidp, varidpsr1 |
216 |
|
|
|
217 |
|
|
rcode = nf90_inq_varid(ncidp, 'psrf2', varidpsr2) |
218 |
|
|
PRINT *, 'ncidp,varidpsr2', ncidp, varidpsr2 |
219 |
|
|
|
220 |
|
|
rcode = nf90_inq_varid(ncidp, 'psrf3', varidpsr3) |
221 |
|
|
PRINT *, 'ncidp,varidpsr3', ncidp, varidpsr3 |
222 |
|
|
|
223 |
|
|
rcode = nf90_inq_varid(ncidp, 'psrf4', varidpsr4) |
224 |
|
|
PRINT *, 'ncidp,varidpsr4', ncidp, varidpsr4 |
225 |
|
|
|
226 |
|
|
! ID pour les dimensions |
227 |
|
|
|
228 |
|
|
status = nf_inq_dimid(ncidp, 'y', yid) |
229 |
|
|
status = nf_inq_dimid(ncidp, 'x', xid) |
230 |
|
|
status = nf_inq_dimid(ncidp, 'sig_s', zid) |
231 |
|
|
status = nf_inq_dimid(ncidp, 'time_counter', tid) |
232 |
|
|
|
233 |
|
|
! lecture des dimensions |
234 |
|
|
|
235 |
|
|
status = nf_inq_dim(ncidp, yid, namedim, ncjm) |
236 |
|
|
status = nf_inq_dim(ncidp, xid, namedim, ncim) |
237 |
|
|
status = nf_inq_dim(ncidp, zid, namedim, nckev) |
238 |
|
|
status = nf_inq_dim(ncidp, tid, namedim, ncrec) |
239 |
|
|
|
240 |
|
|
zrec = ncrec |
241 |
|
|
zkev = nckev |
242 |
|
|
zim = ncim |
243 |
|
|
zjm = ncjm |
244 |
|
|
|
245 |
|
|
zkon = zim*(zjm-2) + 2 |
246 |
|
|
|
247 |
|
|
WRITE (*, *) 'read_pstoke : zrec = ', zrec |
248 |
|
|
WRITE (*, *) 'read_pstoke : kev = ', zkev |
249 |
|
|
WRITE (*, *) 'read_pstoke : zim = ', zim |
250 |
|
|
WRITE (*, *) 'read_pstoke : zjm = ', zjm |
251 |
|
|
WRITE (*, *) 'read_pstoke : kon = ', zkon |
252 |
|
|
|
253 |
|
|
! niveaux de pression |
254 |
|
|
|
255 |
|
|
status = nf_get_vara_real(ncidp, varidpl, 1, kev, pl) |
256 |
|
|
|
257 |
|
|
! lecture de aire et phis |
258 |
|
|
|
259 |
|
|
start(1) = 1 |
260 |
|
|
start(2) = 1 |
261 |
|
|
start(3) = 1 |
262 |
|
|
start(4) = 0 |
263 |
|
|
|
264 |
|
|
count(1) = zim |
265 |
|
|
count(2) = zjm |
266 |
|
|
count(3) = 1 |
267 |
|
|
count(4) = 0 |
268 |
|
|
|
269 |
|
|
|
270 |
|
|
! **** Geopotentiel au sol *************************************** |
271 |
|
|
! phis |
272 |
|
|
#ifdef NC_DOUBLE |
273 |
|
|
status = nf_get_vara_double(ncidp, varidps, start, count, phisfi2) |
274 |
|
|
#else |
275 |
|
|
status = nf_get_vara_real(ncidp, varidps, start, count, phisfi2) |
276 |
|
|
#endif |
277 |
|
|
CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, phisfi2, phisfi) |
278 |
|
|
|
279 |
|
|
! **** Aires des mails aux sol ************************************ |
280 |
|
|
! aire |
281 |
|
|
#ifdef NC_DOUBLE |
282 |
|
|
status = nf_get_vara_double(ncidp, varidai, start, count, airefi2) |
283 |
|
|
#else |
284 |
|
|
status = nf_get_vara_real(ncidp, varidai, start, count, airefi2) |
285 |
|
|
#endif |
286 |
|
|
CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, airefi2, airefi) |
287 |
|
|
ELSE |
288 |
|
|
|
289 |
|
|
PRINT *, 'ok1' |
290 |
|
|
|
291 |
|
|
! --------------------- |
292 |
|
|
! lecture des champs |
293 |
|
|
! --------------------- |
294 |
|
|
|
295 |
|
|
PRINT *, 'WARNING!!! Il n y a pas de test de coherence' |
296 |
|
|
PRINT *, 'sur le nombre de niveaux verticaux dans le fichier nc' |
297 |
|
|
|
298 |
|
|
start(1) = 1 |
299 |
|
|
start(2) = 1 |
300 |
|
|
start(3) = 1 |
301 |
|
|
start(4) = irec |
302 |
|
|
|
303 |
|
|
count(1) = zim |
304 |
|
|
count(2) = zjm |
305 |
|
|
count(3) = kev |
306 |
|
|
count(4) = 1 |
307 |
|
|
|
308 |
|
|
! **** Temperature ******************************************** |
309 |
|
|
! A FAIRE : Es-ce necessaire ? |
310 |
|
|
|
311 |
|
|
! abder t |
312 |
|
|
#ifdef NC_DOUBLE |
313 |
|
|
status = nf_get_vara_double(ncidp, varidt, start, count, t2) |
314 |
|
|
#else |
315 |
|
|
status = nf_get_vara_real(ncidp, varidt, start, count, t2) |
316 |
|
|
#endif |
317 |
|
|
CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, t2, t) |
318 |
|
|
|
319 |
|
|
! **** Flux pour la convection (Tiedtk) |
320 |
|
|
! ******************************************** |
321 |
|
|
! mfu |
322 |
|
|
#ifdef NC_DOUBLE |
323 |
|
|
status = nf_get_vara_double(ncidp, varidmfu, start, count, mfu2) |
324 |
|
|
#else |
325 |
|
|
status = nf_get_vara_real(ncidp, varidmfu, start, count, mfu2) |
326 |
|
|
#endif |
327 |
|
|
CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, mfu2, mfu) |
328 |
|
|
|
329 |
|
|
! mfd |
330 |
|
|
#ifdef NC_DOUBLE |
331 |
|
|
status = nf_get_vara_double(ncidp, varidmfd, start, count, mfd2) |
332 |
|
|
#else |
333 |
|
|
status = nf_get_vara_real(ncidp, varidmfd, start, count, mfd2) |
334 |
|
|
#endif |
335 |
|
|
CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, mfd2, mfd) |
336 |
|
|
|
337 |
|
|
! en_u |
338 |
|
|
#ifdef NC_DOUBLE |
339 |
|
|
status = nf_get_vara_double(ncidp, varidenu, start, count, en_u2) |
340 |
|
|
#else |
341 |
|
|
status = nf_get_vara_real(ncidp, varidenu, start, count, en_u2) |
342 |
|
|
#endif |
343 |
|
|
CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, en_u2, en_u) |
344 |
|
|
|
345 |
|
|
! de_u |
346 |
|
|
#ifdef NC_DOUBLE |
347 |
|
|
status = nf_get_vara_double(ncidp, variddeu, start, count, de_u2) |
348 |
|
|
#else |
349 |
|
|
status = nf_get_vara_real(ncidp, variddeu, start, count, de_u2) |
350 |
|
|
#endif |
351 |
|
|
CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, de_u2, de_u) |
352 |
|
|
|
353 |
|
|
! en_d |
354 |
|
|
#ifdef NC_DOUBLE |
355 |
|
|
status = nf_get_vara_double(ncidp, varidend, start, count, en_d2) |
356 |
|
|
#else |
357 |
|
|
status = nf_get_vara_real(ncidp, varidend, start, count, en_d2) |
358 |
|
|
#endif |
359 |
|
|
CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, en_d2, en_d) |
360 |
|
|
|
361 |
|
|
! de_d |
362 |
|
|
#ifdef NC_DOUBLE |
363 |
|
|
status = nf_get_vara_double(ncidp, varidded, start, count, de_d2) |
364 |
|
|
#else |
365 |
|
|
status = nf_get_vara_real(ncidp, varidded, start, count, de_d2) |
366 |
|
|
#endif |
367 |
|
|
CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, de_d2, de_d) |
368 |
|
|
|
369 |
|
|
! **** Coefficient de mellange turbulent |
370 |
|
|
! ******************************************* |
371 |
|
|
! coefh |
372 |
|
|
PRINT *, 'LECTURE de coefh a irec =', irec |
373 |
|
|
#ifdef NC_DOUBLE |
374 |
|
|
status = nf_get_vara_double(ncidp, varidch, start, count, coefh2) |
375 |
|
|
#else |
376 |
|
|
status = nf_get_vara_real(ncidp, varidch, start, count, coefh2) |
377 |
|
|
#endif |
378 |
|
|
CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, coefh2, coefh) |
379 |
|
|
! call dump2d(iip1,jjp1,coefh2(1,2),'COEFH2READ ') |
380 |
|
|
! call dump2d(iim ,jjm ,coefh (2,2),'COEFH2READ ') |
381 |
|
|
|
382 |
|
|
! **** Flux ascendants et entrant dans le thermique |
383 |
|
|
! ********************************** |
384 |
|
|
! Thermiques |
385 |
|
|
PRINT *, 'LECTURE de fm_therm a irec =', irec |
386 |
|
|
#ifdef NC_DOUBLE |
387 |
|
|
status = nf_get_vara_double(ncidp, varidfmth, start, count, fm_therm2) |
388 |
|
|
#else |
389 |
|
|
status = nf_get_vara_real(ncidp, varidfmth, start, count, fm_therm2) |
390 |
|
|
#endif |
391 |
|
|
CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, fm_therm2, fm_therm) |
392 |
|
|
PRINT *, 'LECTURE de en_therm a irec =', irec |
393 |
|
|
#ifdef NC_DOUBLE |
394 |
|
|
status = nf_get_vara_double(ncidp, varidenth, start, count, en_therm2) |
395 |
|
|
#else |
396 |
|
|
status = nf_get_vara_real(ncidp, varidenth, start, count, en_therm2) |
397 |
|
|
#endif |
398 |
|
|
CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, en_therm2, en_therm) |
399 |
|
|
|
400 |
|
|
! **** Coefficients de lessivage |
401 |
|
|
! ******************************************* |
402 |
|
|
! frac_impa |
403 |
|
|
#ifdef NC_DOUBLE |
404 |
|
|
status = nf_get_vara_double(ncidp, varidfi, start, count, frac_impa2) |
405 |
|
|
#else |
406 |
|
|
status = nf_get_vara_real(ncidp, varidfi, start, count, frac_impa2) |
407 |
|
|
#endif |
408 |
|
|
CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, frac_impa2, frac_impa) |
409 |
|
|
|
410 |
|
|
! frac_nucl |
411 |
|
|
|
412 |
|
|
#ifdef NC_DOUBLE |
413 |
|
|
status = nf_get_vara_double(ncidp, varidfn, start, count, frac_nucl2) |
414 |
|
|
#else |
415 |
|
|
status = nf_get_vara_real(ncidp, varidfn, start, count, frac_nucl2) |
416 |
|
|
#endif |
417 |
|
|
CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, frac_nucl2, frac_nucl) |
418 |
|
|
|
419 |
|
|
! **** Vents aux sol ******************************************** |
420 |
|
|
|
421 |
|
|
start(3) = irec |
422 |
|
|
start(4) = 0 |
423 |
|
|
count(3) = 1 |
424 |
|
|
count(4) = 0 |
425 |
|
|
|
426 |
|
|
! pyu1 |
427 |
|
|
PRINT *, 'LECTURE de yu1 a irec =', irec |
428 |
|
|
#ifdef NC_DOUBLE |
429 |
|
|
status = nf_get_vara_double(ncidp, varidyu1, start, count, pyu12) |
430 |
|
|
#else |
431 |
|
|
status = nf_get_vara_real(ncidp, varidyu1, start, count, pyu12) |
432 |
|
|
#endif |
433 |
|
|
CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, pyu12, pyu1) |
434 |
|
|
|
435 |
|
|
! pyv1 |
436 |
|
|
PRINT *, 'LECTURE de yv1 a irec =', irec |
437 |
|
|
#ifdef NC_DOUBLE |
438 |
|
|
status = nf_get_vara_double(ncidp, varidyv1, start, count, pyv12) |
439 |
|
|
#else |
440 |
|
|
status = nf_get_vara_real(ncidp, varidyv1, start, count, pyv12) |
441 |
|
|
#endif |
442 |
|
|
CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, pyv12, pyv1) |
443 |
|
|
|
444 |
|
|
! **** Temerature au sol ******************************************** |
445 |
|
|
! ftsol1 |
446 |
|
|
PRINT *, 'LECTURE de ftsol1 a irec =', irec |
447 |
|
|
#ifdef NC_DOUBLE |
448 |
|
|
status = nf_get_vara_double(ncidp, varidfts1, start, count, ftsol12) |
449 |
|
|
#else |
450 |
|
|
status = nf_get_vara_real(ncidp, varidfts1, start, count, ftsol12) |
451 |
|
|
#endif |
452 |
|
|
CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, ftsol12, ftsol1) |
453 |
|
|
|
454 |
|
|
! ftsol2 |
455 |
|
|
PRINT *, 'LECTURE de ftsol2 a irec =', irec |
456 |
|
|
#ifdef NC_DOUBLE |
457 |
|
|
status = nf_get_vara_double(ncidp, varidfts2, start, count, ftsol22) |
458 |
|
|
#else |
459 |
|
|
status = nf_get_vara_real(ncidp, varidfts2, start, count, ftsol22) |
460 |
|
|
#endif |
461 |
|
|
CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, ftsol22, ftsol2) |
462 |
|
|
|
463 |
|
|
! ftsol3 |
464 |
|
|
PRINT *, 'LECTURE de ftsol3 a irec =', irec |
465 |
|
|
#ifdef NC_DOUBLE |
466 |
|
|
status = nf_get_vara_double(ncidp, varidfts3, start, count, ftsol32) |
467 |
|
|
#else |
468 |
|
|
status = nf_get_vara_real(ncidp, varidfts3, start, count, ftsol32) |
469 |
|
|
#endif |
470 |
|
|
CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, ftsol32, ftsol3) |
471 |
|
|
|
472 |
|
|
! ftsol4 |
473 |
|
|
#ifdef NC_DOUBLE |
474 |
|
|
status = nf_get_vara_double(ncidp, varidfts4, start, count, ftsol42) |
475 |
|
|
#else |
476 |
|
|
status = nf_get_vara_real(ncidp, varidfts4, start, count, ftsol42) |
477 |
|
|
#endif |
478 |
|
|
CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, ftsol42, ftsol4) |
479 |
|
|
|
480 |
|
|
! **** Nature sol ******************************************** |
481 |
|
|
! psrf1 |
482 |
|
|
#ifdef NC_DOUBLE |
483 |
|
|
status = nf_get_vara_double(ncidp, varidpsr1, start, count, psrf12) |
484 |
|
|
#else |
485 |
|
|
status = nf_get_vara_real(ncidp, varidpsr1, start, count, psrf12) |
486 |
|
|
#endif |
487 |
|
|
! call dump2d(iip1-1,jjm+1,psrf12,'PSRF1NC') |
488 |
|
|
CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, psrf12, psrf1) |
489 |
|
|
|
490 |
|
|
! psrf2 |
491 |
|
|
#ifdef NC_DOUBLE |
492 |
|
|
status = nf_get_vara_double(ncidp, varidpsr2, start, count, psrf22) |
493 |
|
|
#else |
494 |
|
|
status = nf_get_vara_real(ncidp, varidpsr2, start, count, psrf22) |
495 |
|
|
#endif |
496 |
|
|
! call dump2d(iip1-1,jjm+1,psrf22,'PSRF2NC') |
497 |
|
|
CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, psrf22, psrf2) |
498 |
|
|
|
499 |
|
|
! psrf3 |
500 |
|
|
#ifdef NC_DOUBLE |
501 |
|
|
status = nf_get_vara_double(ncidp, varidpsr3, start, count, psrf32) |
502 |
|
|
#else |
503 |
|
|
status = nf_get_vara_real(ncidp, varidpsr3, start, count, psrf32) |
504 |
|
|
#endif |
505 |
|
|
CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, psrf32, psrf3) |
506 |
|
|
|
507 |
|
|
! psrf4 |
508 |
|
|
#ifdef NC_DOUBLE |
509 |
|
|
status = nf_get_vara_double(ncidp, varidpsr4, start, count, psrf42) |
510 |
|
|
#else |
511 |
|
|
status = nf_get_vara_real(ncidp, varidpsr4, start, count, psrf42) |
512 |
|
|
#endif |
513 |
|
|
CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, psrf42, psrf4) |
514 |
|
|
|
515 |
|
|
DO i = 1, kon |
516 |
|
|
|
517 |
|
|
psrf(i, 1) = psrf1(i) |
518 |
|
|
psrf(i, 2) = psrf2(i) |
519 |
|
|
psrf(i, 3) = psrf3(i) |
520 |
|
|
! test abderr |
521 |
|
|
! print*,'Dans read_pstoke psrf3 =',psrf3(i),i |
522 |
|
|
psrf(i, 4) = psrf4(i) |
523 |
|
|
|
524 |
|
|
ftsol(i, 1) = ftsol1(i) |
525 |
|
|
ftsol(i, 2) = ftsol2(i) |
526 |
|
|
ftsol(i, 3) = ftsol3(i) |
527 |
|
|
ftsol(i, 4) = ftsol4(i) |
528 |
|
|
|
529 |
|
|
END DO |
530 |
|
|
|
531 |
|
|
END IF |
532 |
|
|
|
533 |
|
|
RETURN |
534 |
|
|
|
535 |
|
|
END SUBROUTINE read_pstoke0 |
536 |
|
|
|