Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

read_pstoke0.F90

Last change on this file was 2345, checked in by Ehouarn Millour, 9 years ago

Physics/dynamics separation:

move test_disvert_m to dynlonlat_phylonlat/phylmd since it is only used by ce0l and relies on dynamics.
put "config_inca" in tracinca_mod so physics routines can get the info from there rather than from control_mod.
get rid of references to "control_mod" from within the physics.

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 2345 2015-08-21 09:57:36Z abarral $
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

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format