source: LMDZ6/trunk/libf/phylmd/read_pstoke0.F90 @ 5087

Last change on this file since 5087 was 5084, checked in by Laurent Fairhead, 12 months ago

Reverting to r4065. Updating fortran standard broke too much stuff. Will do it by smaller chunks
AB, LF
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 17.3 KB
Line 
1
2! $Id: read_pstoke0.F90 5084 2024-07-19 16:40:44Z abarral $
3
4
5
6SUBROUTINE 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
535END SUBROUTINE read_pstoke0
536
Note: See TracBrowser for help on using the repository browser.