GCC Code Coverage Report


Directory: ./
File: phys/read_pstoke0.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 0 192 0.0%
Branches: 0 288 0.0%

Line Branch Exec Source
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 ✗ status = nf_get_vara_double(ncidp, varidps, start, count, phisfi2)
273 ✗ CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, phisfi2, phisfi)
274
275 ! **** Aires des mails aux sol ************************************
276 ! aire
277 ✗ status = nf_get_vara_double(ncidp, varidai, start, count, airefi2)
278 ✗ CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, airefi2, airefi)
279 ELSE
280
281 ✗ PRINT *, 'ok1'
282
283 ! ---------------------
284 ! lecture des champs
285 ! ---------------------
286
287 ✗ PRINT *, 'WARNING!!! Il n y a pas de test de coherence'
288 ✗ PRINT *, 'sur le nombre de niveaux verticaux dans le fichier nc'
289
290 ✗ start(1) = 1
291 ✗ start(2) = 1
292 ✗ start(3) = 1
293 ✗ start(4) = irec
294
295 ✗ count(1) = zim
296 ✗ count(2) = zjm
297 ✗ count(3) = kev
298 ✗ count(4) = 1
299
300 ! **** Temperature ********************************************
301 ! A FAIRE : Es-ce necessaire ?
302
303 ! abder t
304 ✗ status = nf_get_vara_double(ncidp, varidt, start, count, t2)
305 ✗ CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, t2, t)
306
307 ! **** Flux pour la convection (Tiedtk)
308 ! ********************************************
309 ! mfu
310 ✗ status = nf_get_vara_double(ncidp, varidmfu, start, count, mfu2)
311 ✗ CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, mfu2, mfu)
312
313 ! mfd
314 ✗ status = nf_get_vara_double(ncidp, varidmfd, start, count, mfd2)
315 ✗ CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, mfd2, mfd)
316
317 ! en_u
318 ✗ status = nf_get_vara_double(ncidp, varidenu, start, count, en_u2)
319 ✗ CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, en_u2, en_u)
320
321 ! de_u
322 ✗ status = nf_get_vara_double(ncidp, variddeu, start, count, de_u2)
323 ✗ CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, de_u2, de_u)
324
325 ! en_d
326 ✗ status = nf_get_vara_double(ncidp, varidend, start, count, en_d2)
327 ✗ CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, en_d2, en_d)
328
329 ! de_d
330 ✗ status = nf_get_vara_double(ncidp, varidded, start, count, de_d2)
331 ✗ CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, de_d2, de_d)
332
333 ! **** Coefficient de mellange turbulent
334 ! *******************************************
335 ! coefh
336 ✗ PRINT *, 'LECTURE de coefh a irec =', irec
337 ✗ status = nf_get_vara_double(ncidp, varidch, start, count, coefh2)
338 ✗ CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, coefh2, coefh)
339 ! call dump2d(iip1,jjp1,coefh2(1,2),'COEFH2READ ')
340 ! call dump2d(iim ,jjm ,coefh (2,2),'COEFH2READ ')
341
342 ! **** Flux ascendants et entrant dans le thermique
343 ! **********************************
344 ! Thermiques
345 ✗ PRINT *, 'LECTURE de fm_therm a irec =', irec
346 ✗ status = nf_get_vara_double(ncidp, varidfmth, start, count, fm_therm2)
347 ✗ CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, fm_therm2, fm_therm)
348 ✗ PRINT *, 'LECTURE de en_therm a irec =', irec
349 ✗ status = nf_get_vara_double(ncidp, varidenth, start, count, en_therm2)
350 ✗ CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, en_therm2, en_therm)
351
352 ! **** Coefficients de lessivage
353 ! *******************************************
354 ! frac_impa
355 ✗ status = nf_get_vara_double(ncidp, varidfi, start, count, frac_impa2)
356 ✗ CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, frac_impa2, frac_impa)
357
358 ! frac_nucl
359
360 ✗ status = nf_get_vara_double(ncidp, varidfn, start, count, frac_nucl2)
361 ✗ CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, frac_nucl2, frac_nucl)
362
363 ! **** Vents aux sol ********************************************
364
365 ✗ start(3) = irec
366 ✗ start(4) = 0
367 ✗ count(3) = 1
368 ✗ count(4) = 0
369
370 ! pyu1
371 ✗ PRINT *, 'LECTURE de yu1 a irec =', irec
372 ✗ status = nf_get_vara_double(ncidp, varidyu1, start, count, pyu12)
373 ✗ CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, pyu12, pyu1)
374
375 ! pyv1
376 ✗ PRINT *, 'LECTURE de yv1 a irec =', irec
377 ✗ status = nf_get_vara_double(ncidp, varidyv1, start, count, pyv12)
378 ✗ CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, pyv12, pyv1)
379
380 ! **** Temerature au sol ********************************************
381 ! ftsol1
382 ✗ PRINT *, 'LECTURE de ftsol1 a irec =', irec
383 ✗ status = nf_get_vara_double(ncidp, varidfts1, start, count, ftsol12)
384 ✗ CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, ftsol12, ftsol1)
385
386 ! ftsol2
387 ✗ PRINT *, 'LECTURE de ftsol2 a irec =', irec
388 ✗ status = nf_get_vara_double(ncidp, varidfts2, start, count, ftsol22)
389 ✗ CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, ftsol22, ftsol2)
390
391 ! ftsol3
392 ✗ PRINT *, 'LECTURE de ftsol3 a irec =', irec
393 ✗ status = nf_get_vara_double(ncidp, varidfts3, start, count, ftsol32)
394 ✗ CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, ftsol32, ftsol3)
395
396 ! ftsol4
397 ✗ status = nf_get_vara_double(ncidp, varidfts4, start, count, ftsol42)
398 ✗ CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, ftsol42, ftsol4)
399
400 ! **** Nature sol ********************************************
401 ! psrf1
402 ✗ status = nf_get_vara_double(ncidp, varidpsr1, start, count, psrf12)
403 ! call dump2d(iip1-1,jjm+1,psrf12,'PSRF1NC')
404 ✗ CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, psrf12, psrf1)
405
406 ! psrf2
407 ✗ status = nf_get_vara_double(ncidp, varidpsr2, start, count, psrf22)
408 ! call dump2d(iip1-1,jjm+1,psrf22,'PSRF2NC')
409 ✗ CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, psrf22, psrf2)
410
411 ! psrf3
412 ✗ status = nf_get_vara_double(ncidp, varidpsr3, start, count, psrf32)
413 ✗ CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, psrf32, psrf3)
414
415 ! psrf4
416 ✗ status = nf_get_vara_double(ncidp, varidpsr4, start, count, psrf42)
417 ✗ CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, psrf42, psrf4)
418
419 ✗ DO i = 1, kon
420
421 ✗ psrf(i, 1) = psrf1(i)
422 ✗ psrf(i, 2) = psrf2(i)
423 ✗ psrf(i, 3) = psrf3(i)
424 ! test abderr
425 ! print*,'Dans read_pstoke psrf3 =',psrf3(i),i
426 ✗ psrf(i, 4) = psrf4(i)
427
428 ✗ ftsol(i, 1) = ftsol1(i)
429 ✗ ftsol(i, 2) = ftsol2(i)
430 ✗ ftsol(i, 3) = ftsol3(i)
431 ✗ ftsol(i, 4) = ftsol4(i)
432
433 END DO
434
435 END IF
436
437 ✗ RETURN
438
439 ✗ END SUBROUTINE read_pstoke0
440
441