Context Navigation

read_pstoke0.F @ 1532

Last change on this file since 1532 was 1146, checked in by Laurent Fairhead, 15 years ago
Réintegration dans le tronc des modifications issues de la branche LMDZ-dev comprises entre la révision 1074 et 1145 Validation: une simulation de 1 jour en séquentiel sur PC donne les mêmes résultats entre la trunk et la dev LF
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 15.1 KB

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

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

Download in other formats:

Original Format