Context Navigation

source: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/config/ppsrc/dyn/guide_p_mod.f90 @ 224

Last change on this file since 224 was 224, checked in by ymipsl, 10 years ago

File size: 188.6 KB

Line
1	!
2	! $Id$
3	!
4	MODULE guide_p_mod
5
6	!=======================================================================
7	! Auteur: F.Hourdin
8	! F. Codron 01/09
9	!=======================================================================
10
11	USE getparam
12	USE Write_Field_p
13	USE netcdf, ONLY: nf90_nowrite, nf90_open, nf90_inq_varid, nf90_close
14	USE pres2lev_mod
15
16	IMPLICIT NONE
17
18	! ---------------------------------------------
19	! Declarations des cles logiques et parametres
20	! ---------------------------------------------
21	INTEGER, PRIVATE, SAVE :: iguide_read,iguide_int,iguide_sav
22	INTEGER, PRIVATE, SAVE :: nlevnc, guide_plevs
23	LOGICAL, PRIVATE, SAVE :: guide_u,guide_v,guide_T,guide_Q,guide_P
24	LOGICAL, PRIVATE, SAVE :: guide_hr,guide_teta
25	LOGICAL, PRIVATE, SAVE :: guide_BL,guide_reg,guide_add,gamma4,guide_zon
26	LOGICAL, PRIVATE, SAVE :: invert_p,invert_y,ini_anal
27	LOGICAL, PRIVATE, SAVE :: guide_2D,guide_sav,guide_modele
28
29	REAL, PRIVATE, SAVE :: tau_min_u,tau_max_u
30	REAL, PRIVATE, SAVE :: tau_min_v,tau_max_v
31	REAL, PRIVATE, SAVE :: tau_min_T,tau_max_T
32	REAL, PRIVATE, SAVE :: tau_min_Q,tau_max_Q
33	REAL, PRIVATE, SAVE :: tau_min_P,tau_max_P
34
35	REAL, PRIVATE, SAVE :: lat_min_g,lat_max_g
36	REAL, PRIVATE, SAVE :: lon_min_g,lon_max_g
37	REAL, PRIVATE, SAVE :: tau_lon,tau_lat
38
39	REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: alpha_u,alpha_v
40	REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: alpha_T,alpha_Q
41	REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: alpha_P,alpha_pcor
42
43	! ---------------------------------------------
44	! Variables de guidage
45	! ---------------------------------------------
46	! Variables des fichiers de guidage
47	REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE, SAVE :: unat1,unat2
48	REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE, SAVE :: vnat1,vnat2
49	REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE, SAVE :: tnat1,tnat2
50	REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE, SAVE :: qnat1,qnat2
51	REAL, ALLOCATABLE, DIMENSION(:,:,:), PRIVATE, SAVE :: pnat1,pnat2
52	REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE :: psnat1,psnat2
53	REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: apnc,bpnc
54	! Variables aux dimensions du modele
55	REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE :: ugui1,ugui2
56	REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE :: vgui1,vgui2
57	REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE :: tgui1,tgui2
58	REAL, ALLOCATABLE, DIMENSION(:,:), PRIVATE, SAVE :: qgui1,qgui2
59	REAL, ALLOCATABLE, DIMENSION(:), PRIVATE, SAVE :: psgui1,psgui2
60
61	INTEGER,SAVE,PRIVATE :: ijb_u,ijb_v,ije_u,ije_v,ijn_u,ijn_v
62	INTEGER,SAVE,PRIVATE :: jjb_u,jjb_v,jje_u,jje_v,jjn_u,jjn_v
63
64
65	CONTAINS
66	!=======================================================================
67
68	SUBROUTINE guide_init
69
70	USE control_mod
71	IMPLICIT NONE
72
73	INCLUDE "dimensions.h"
74	INCLUDE "paramet.h"
75	INCLUDE "netcdf.inc"
76
77	INTEGER :: error,ncidpl,rid,rcod
78	CHARACTER (len = 80) :: abort_message
79	CHARACTER (len = 20) :: modname = 'guide_init'
80
81	! ---------------------------------------------
82	! Lecture des parametres:
83	! ---------------------------------------------
84	! Variables guidees
85	CALL getpar('guide_u',.true.,guide_u,'guidage de u')
86	CALL getpar('guide_v',.true.,guide_v,'guidage de v')
87	CALL getpar('guide_T',.true.,guide_T,'guidage de T')
88	CALL getpar('guide_P',.true.,guide_P,'guidage de P')
89	CALL getpar('guide_Q',.true.,guide_Q,'guidage de Q')
90	CALL getpar('guide_hr',.true.,guide_hr,'guidage de Q par H.R')
91	CALL getpar('guide_teta',.false.,guide_teta,'guidage de T par Teta')
92
93	CALL getpar('guide_add',.false.,guide_add,'forÃ¯Â¿Âœage constant?')
94	CALL getpar('guide_zon',.false.,guide_zon,'guidage moy zonale')
95
96	! Constantes de rappel. Unite : fraction de jour
97	CALL getpar('tau_min_u',0.02,tau_min_u,'Cste de rappel min, u')
98	CALL getpar('tau_max_u', 10.,tau_max_u,'Cste de rappel max, u')
99	CALL getpar('tau_min_v',0.02,tau_min_v,'Cste de rappel min, v')
100	CALL getpar('tau_max_v', 10.,tau_max_v,'Cste de rappel max, v')
101	CALL getpar('tau_min_T',0.02,tau_min_T,'Cste de rappel min, T')
102	CALL getpar('tau_max_T', 10.,tau_max_T,'Cste de rappel max, T')
103	CALL getpar('tau_min_Q',0.02,tau_min_Q,'Cste de rappel min, Q')
104	CALL getpar('tau_max_Q', 10.,tau_max_Q,'Cste de rappel max, Q')
105	CALL getpar('tau_min_P',0.02,tau_min_P,'Cste de rappel min, P')
106	CALL getpar('tau_max_P', 10.,tau_max_P,'Cste de rappel max, P')
107	CALL getpar('gamma4',.false.,gamma4,'Zone sans rappel elargie')
108	CALL getpar('guide_BL',.true.,guide_BL,'guidage dans C.Lim')
109
110	! Sauvegarde du forÃ¯Â¿Âœage
111	CALL getpar('guide_sav',.false.,guide_sav,'sauvegarde guidage')
112	CALL getpar('iguide_sav',4,iguide_sav,'freq. sauvegarde guidage')
113	! frequences f>0: fx/jour; f<0: tous les f jours; f=0: 1 seule fois.
114	IF (iguide_sav.GT.0) THEN
115	iguide_sav=day_step/iguide_sav
116	ELSE
117	iguide_sav=day_step*iguide_sav
118	ENDIF
119
120	! Guidage regional seulement (sinon constant ou suivant le zoom)
121	CALL getpar('guide_reg',.false.,guide_reg,'guidage regional')
122	CALL getpar('lat_min_g',-90.,lat_min_g,'Latitude mini guidage ')
123	CALL getpar('lat_max_g', 90.,lat_max_g,'Latitude maxi guidage ')
124	CALL getpar('lon_min_g',-180.,lon_min_g,'longitude mini guidage ')
125	CALL getpar('lon_max_g', 180.,lon_max_g,'longitude maxi guidage ')
126	CALL getpar('tau_lat', 5.,tau_lat,'raideur lat guide regional ')
127	CALL getpar('tau_lon', 5.,tau_lon,'raideur lon guide regional ')
128
129	! Parametres pour lecture des fichiers
130	CALL getpar('iguide_read',4,iguide_read,'freq. lecture guidage')
131	CALL getpar('iguide_int',4,iguide_int,'freq. interpolation vert')
132	IF (iguide_int.EQ.0) THEN
133	iguide_int=1
134	ELSEIF (iguide_int.GT.0) THEN
135	iguide_int=day_step/iguide_int
136	ELSE
137	iguide_int=day_step*iguide_int
138	ENDIF
139	CALL getpar('guide_plevs',0,guide_plevs,'niveaux pression fichiers guidage')
140	! Pour compatibilite avec ancienne version avec guide_modele
141	CALL getpar('guide_modele',.false.,guide_modele,'niveaux pression ap+bp*psol')
142	IF (guide_modele) THEN
143	guide_plevs=1
144	ENDIF
145	! Fin raccord
146	CALL getpar('ini_anal',.false.,ini_anal,'Etat initial = analyse')
147	CALL getpar('guide_invertp',.true.,invert_p,'niveaux p inverses')
148	CALL getpar('guide_inverty',.true.,invert_y,'inversion N-S')
149	CALL getpar('guide_2D',.false.,guide_2D,'fichier guidage lat-P')
150
151	! ---------------------------------------------
152	! Determination du nombre de niveaux verticaux
153	! des fichiers guidage
154	! ---------------------------------------------
155	ncidpl=-99
156	if (guide_plevs.EQ.1) then
157	if (ncidpl.eq.-99) then
158	rcod=nf90_open('apbp.nc',Nf90_NOWRITe, ncidpl)
159	if (rcod.NE.NF_NOERR) THEN
160	print *,'Guide: probleme -> pas de fichier apbp.nc'
161	CALL abort_gcm(modname,abort_message,1)
162	endif
163	endif
164	elseif (guide_plevs.EQ.2) then
165	if (ncidpl.EQ.-99) then
166	rcod=nf90_open('P.nc',Nf90_NOWRITe,ncidpl)
167	if (rcod.NE.NF_NOERR) THEN
168	print *,'Guide: probleme -> pas de fichier P.nc'
169	CALL abort_gcm(modname,abort_message,1)
170	endif
171	endif
172	elseif (guide_u) then
173	if (ncidpl.eq.-99) then
174	rcod=nf90_open('u.nc',Nf90_NOWRITe,ncidpl)
175	if (rcod.NE.NF_NOERR) THEN
176	print *,'Guide: probleme -> pas de fichier u.nc'
177	CALL abort_gcm(modname,abort_message,1)
178	endif
179	endif
180	elseif (guide_v) then
181	if (ncidpl.eq.-99) then
182	rcod=nf90_open('v.nc',nf90_nowrite,ncidpl)
183	if (rcod.NE.NF_NOERR) THEN
184	print *,'Guide: probleme -> pas de fichier v.nc'
185	CALL abort_gcm(modname,abort_message,1)
186	endif
187	endif
188	elseif (guide_T) then
189	if (ncidpl.eq.-99) then
190	rcod=nf90_open('T.nc',nf90_nowrite,ncidpl)
191	if (rcod.NE.NF_NOERR) THEN
192	print *,'Guide: probleme -> pas de fichier T.nc'
193	CALL abort_gcm(modname,abort_message,1)
194	endif
195	endif
196	elseif (guide_Q) then
197	if (ncidpl.eq.-99) then
198	rcod=nf90_open('hur.nc',nf90_nowrite, ncidpl)
199	if (rcod.NE.NF_NOERR) THEN
200	print *,'Guide: probleme -> pas de fichier hur.nc'
201	CALL abort_gcm(modname,abort_message,1)
202	endif
203	endif
204	endif
205	error=NF_INQ_DIMID(ncidpl,'LEVEL',rid)
206	IF (error.NE.NF_NOERR) error=NF_INQ_DIMID(ncidpl,'PRESSURE',rid)
207	IF (error.NE.NF_NOERR) THEN
208	print *,'Guide: probleme lecture niveaux pression'
209	CALL abort_gcm(modname,abort_message,1)
210	ENDIF
211	error=NF_INQ_DIMLEN(ncidpl,rid,nlevnc)
212	print *,'Guide: nombre niveaux vert. nlevnc', nlevnc
213	rcod = nf90_close(ncidpl)
214
215	! ---------------------------------------------
216	! Allocation des variables
217	! ---------------------------------------------
218	abort_message='pb in allocation guide'
219
220	ALLOCATE(apnc(nlevnc), stat = error)
221	IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
222	ALLOCATE(bpnc(nlevnc), stat = error)
223	IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
224	apnc=0.;bpnc=0.
225
226	ALLOCATE(alpha_pcor(llm), stat = error)
227	IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
228	ALLOCATE(alpha_u(ip1jmp1), stat = error)
229	IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
230	ALLOCATE(alpha_v(ip1jm), stat = error)
231	IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
232	ALLOCATE(alpha_T(ip1jmp1), stat = error)
233	IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
234	ALLOCATE(alpha_Q(ip1jmp1), stat = error)
235	IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
236	ALLOCATE(alpha_P(ip1jmp1), stat = error)
237	IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
238	alpha_u=0.;alpha_v=0;alpha_T=0;alpha_Q=0;alpha_P=0
239
240	IF (guide_u) THEN
241	ALLOCATE(unat1(iip1,jjp1,nlevnc), stat = error)
242	IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
243	ALLOCATE(ugui1(ip1jmp1,llm), stat = error)
244	IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
245	ALLOCATE(unat2(iip1,jjp1,nlevnc), stat = error)
246	IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
247	ALLOCATE(ugui2(ip1jmp1,llm), stat = error)
248	IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
249	unat1=0.;unat2=0.;ugui1=0.;ugui2=0.
250	ENDIF
251
252	IF (guide_T) THEN
253	ALLOCATE(tnat1(iip1,jjp1,nlevnc), stat = error)
254	IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
255	ALLOCATE(tgui1(ip1jmp1,llm), stat = error)
256	IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
257	ALLOCATE(tnat2(iip1,jjp1,nlevnc), stat = error)
258	IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
259	ALLOCATE(tgui2(ip1jmp1,llm), stat = error)
260	IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
261	tnat1=0.;tnat2=0.;tgui1=0.;tgui2=0.
262	ENDIF
263
264	IF (guide_Q) THEN
265	ALLOCATE(qnat1(iip1,jjp1,nlevnc), stat = error)
266	IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
267	ALLOCATE(qgui1(ip1jmp1,llm), stat = error)
268	IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
269	ALLOCATE(qnat2(iip1,jjp1,nlevnc), stat = error)
270	IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
271	ALLOCATE(qgui2(ip1jmp1,llm), stat = error)
272	IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
273	qnat1=0.;qnat2=0.;qgui1=0.;qgui2=0.
274	ENDIF
275
276	IF (guide_v) THEN
277	ALLOCATE(vnat1(iip1,jjm,nlevnc), stat = error)
278	IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
279	ALLOCATE(vgui1(ip1jm,llm), stat = error)
280	IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
281	ALLOCATE(vnat2(iip1,jjm,nlevnc), stat = error)
282	IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
283	ALLOCATE(vgui2(ip1jm,llm), stat = error)
284	IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
285	vnat1=0.;vnat2=0.;vgui1=0.;vgui2=0.
286	ENDIF
287
288	IF (guide_plevs.EQ.2) THEN
289	ALLOCATE(pnat1(iip1,jjp1,nlevnc), stat = error)
290	IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
291	ALLOCATE(pnat2(iip1,jjp1,nlevnc), stat = error)
292	IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
293	pnat1=0.;pnat2=0.;
294	ENDIF
295
296	IF (guide_P.OR.guide_plevs.EQ.1) THEN
297	ALLOCATE(psnat1(iip1,jjp1), stat = error)
298	IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
299	ALLOCATE(psnat2(iip1,jjp1), stat = error)
300	IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
301	psnat1=0.;psnat2=0.;
302	ENDIF
303	IF (guide_P) THEN
304	ALLOCATE(psgui2(ip1jmp1), stat = error)
305	IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
306	ALLOCATE(psgui1(ip1jmp1), stat = error)
307	IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
308	psgui1=0.;psgui2=0.
309	ENDIF
310
311	! ---------------------------------------------
312	! Lecture du premier etat de guidage.
313	! ---------------------------------------------
314	IF (guide_2D) THEN
315	CALL guide_read2D(1)
316	ELSE
317	CALL guide_read(1)
318	ENDIF
319	IF (guide_v) vnat1=vnat2
320	IF (guide_u) unat1=unat2
321	IF (guide_T) tnat1=tnat2
322	IF (guide_Q) qnat1=qnat2
323	IF (guide_plevs.EQ.2) pnat1=pnat2
324	IF (guide_P.OR.guide_plevs.EQ.1) psnat1=psnat2
325
326	END SUBROUTINE guide_init
327
328	!=======================================================================
329	SUBROUTINE guide_main(itau,ucov,vcov,teta,q,masse,ps)
330	use exner_hyb_p_m, only: exner_hyb_p
331	use exner_milieu_p_m, only: exner_milieu_p
332	USE parallel_lmdz
333	USE control_mod
334
335	IMPLICIT NONE
336
337	INCLUDE "dimensions.h"
338	INCLUDE "paramet.h"
339	INCLUDE "comconst.h"
340	INCLUDE "comvert.h"
341
342	! Variables entree
343	INTEGER, INTENT(IN) :: itau !pas de temps
344	REAL, DIMENSION (ip1jmp1,llm), INTENT(INOUT) :: ucov,teta,q,masse
345	REAL, DIMENSION (ip1jm,llm), INTENT(INOUT) :: vcov
346	REAL, DIMENSION (ip1jmp1), INTENT(INOUT) :: ps
347
348	! Variables locales
349	LOGICAL, SAVE :: first=.TRUE.
350	LOGICAL :: f_out ! sortie guidage
351	REAL, DIMENSION (ip1jmp1,llm) :: f_add ! var aux: champ de guidage
352	! Variables pour fonction Exner (P milieu couche)
353	REAL, DIMENSION (iip1,jjp1,llm) :: pk
354	REAL, DIMENSION (iip1,jjp1) :: pks
355	REAL :: unskap
356	REAL, DIMENSION (ip1jmp1,llmp1) :: p ! besoin si guide_P
357	! Compteurs temps:
358	INTEGER, SAVE :: step_rea,count_no_rea,itau_test ! lecture guidage
359	REAL :: ditau, dday_step
360	REAL :: tau,reste ! position entre 2 etats de guidage
361	REAL, SAVE :: factt ! pas de temps en fraction de jour
362
363	INTEGER :: i,j,l
364
365	ijb_u=ij_begin ; ije_u=ij_end ; ijn_u=ije_u-ijb_u+1
366	jjb_u=jj_begin ; jje_u=jj_end ; jjn_u=jje_u-jjb_u+1
367	ijb_v=ij_begin ; ije_v=ij_end ; ijn_v=ije_v-ijb_v+1
368	jjb_v=jj_begin ; jje_v=jj_end ; jjn_v=jje_v-jjb_v+1
369	IF (pole_sud) THEN
370	ije_v=ij_end-iip1
371	jje_v=jj_end-1
372	ijn_v=ije_v-ijb_v+1
373	jjn_v=jje_v-jjb_v+1
374	ENDIF
375
376	PRINT *,'---> on rentre dans guide_main'
377	! CALL AllGather_Field(ucov,ip1jmp1,llm)
378	! CALL AllGather_Field(vcov,ip1jm,llm)
379	! CALL AllGather_Field(teta,ip1jmp1,llm)
380	! CALL AllGather_Field(ps,ip1jmp1,1)
381	! CALL AllGather_Field(q,ip1jmp1,llm)
382
383	!-----------------------------------------------------------------------
384	! Initialisations au premier passage
385	!-----------------------------------------------------------------------
386
387	IF (first) THEN
388	first=.FALSE.
389	CALL guide_init
390	itau_test=1001
391	step_rea=1
392	count_no_rea=0
393	! Calcul des constantes de rappel
394	factt=dtvr*iperiod/daysec
395	call tau2alpha(3,iip1,jjm ,factt,tau_min_v,tau_max_v,alpha_v)
396	call tau2alpha(2,iip1,jjp1,factt,tau_min_u,tau_max_u,alpha_u)
397	call tau2alpha(1,iip1,jjp1,factt,tau_min_T,tau_max_T,alpha_T)
398	call tau2alpha(1,iip1,jjp1,factt,tau_min_P,tau_max_P,alpha_P)
399	call tau2alpha(1,iip1,jjp1,factt,tau_min_Q,tau_max_Q,alpha_Q)
400	! correction de rappel dans couche limite
401	if (guide_BL) then
402	alpha_pcor(:)=1.
403	else
404	do l=1,llm
405	alpha_pcor(l)=(1.+tanh((0.85-presnivs(l)/preff)/0.05))/2.
406	enddo
407	endif
408	! ini_anal: etat initial egal au guidage
409	IF (ini_anal) THEN
410	CALL guide_interp(ps,teta)
411	IF (guide_u) ucov(ijb_u:ije_u,:)=ugui2(ijb_u:ije_u,:)
412	IF (guide_v) vcov(ijb_v:ije_v,:)=ugui2(ijb_v:ije_v,:)
413	IF (guide_T) teta(ijb_u:ije_u,:)=tgui2(ijb_u:ije_u,:)
414	IF (guide_Q) q(ijb_u:ije_u,:)=qgui2(ijb_u:ije_u,:)
415	IF (guide_P) THEN
416	ps(ijb_u:ije_u)=psgui2(ijb_u:ije_u)
417	CALL pression_p(ip1jmp1,ap,bp,ps,p)
418	CALL massdair_p(p,masse)
419	ENDIF
420	RETURN
421	ENDIF
422	! Verification structure guidage
423	IF (guide_u) THEN
424	CALL writefield_p('unat',unat1)
425	CALL writefield_p('ucov',RESHAPE(ucov,(/iip1,jjp1,llm/)))
426	ENDIF
427	IF (guide_T) THEN
428	CALL writefield_p('tnat',tnat1)
429	CALL writefield_p('teta',RESHAPE(teta,(/iip1,jjp1,llm/)))
430	ENDIF
431
432	ENDIF !first
433
434	!-----------------------------------------------------------------------
435	! Lecture des fichiers de guidage ?
436	!-----------------------------------------------------------------------
437	IF (iguide_read.NE.0) THEN
438	ditau=real(itau)
439	dday_step=real(day_step)
440	IF (iguide_read.LT.0) THEN
441	tau=ditau/dday_step/REAL(iguide_read)
442	ELSE
443	tau=REAL(iguide_read)*ditau/dday_step
444	ENDIF
445	reste=tau-AINT(tau)
446	IF (reste.EQ.0.) THEN
447	IF (itau_test.EQ.itau) THEN
448	write(,)'deuxieme passage de advreel a itau=',itau
449	stop
450	ELSE
451	IF (guide_v) vnat1(:,jjb_v:jje_v,:)=vnat2(:,jjb_v:jje_v,:)
452	IF (guide_u) unat1(:,jjb_u:jje_u,:)=unat2(:,jjb_u:jje_u,:)
453	IF (guide_T) tnat1(:,jjb_u:jje_u,:)=tnat2(:,jjb_u:jje_u,:)
454	IF (guide_Q) qnat1(:,jjb_u:jje_u,:)=qnat2(:,jjb_u:jje_u,:)
455	IF (guide_plevs.EQ.2) pnat1(:,jjb_u:jje_u,:)=pnat2(:,jjb_u:jje_u,:)
456	IF (guide_P.OR.guide_plevs.EQ.1) psnat1(:,jjb_u:jje_u)=psnat2(:,jjb_u:jje_u)
457	step_rea=step_rea+1
458	itau_test=itau
459	print*,'Lecture fichiers guidage, pas ',step_rea, &
460	'apres ',count_no_rea,' non lectures'
461	IF (guide_2D) THEN
462	CALL guide_read2D(step_rea)
463	ELSE
464	CALL guide_read(step_rea)
465	ENDIF
466	count_no_rea=0
467	ENDIF
468	ELSE
469	count_no_rea=count_no_rea+1
470
471	ENDIF
472	ENDIF !iguide_read=0
473
474	!-----------------------------------------------------------------------
475	! Interpolation et conversion des champs de guidage
476	!-----------------------------------------------------------------------
477	IF (MOD(itau,iguide_int).EQ.0) THEN
478	CALL guide_interp(ps,teta)
479	ENDIF
480	! Repartition entre 2 etats de guidage
481	IF (iguide_read.NE.0) THEN
482	tau=reste
483	ELSE
484	tau=1.
485	ENDIF
486
487	!-----------------------------------------------------------------------
488	! Ajout des champs de guidage
489	!-----------------------------------------------------------------------
490	! Sauvegarde du guidage?
491	f_out=((MOD(itau,iguide_sav).EQ.0).AND.guide_sav)
492	IF (f_out) THEN
493	! Calcul niveaux pression milieu de couches
494	CALL pression_p( ip1jmp1, ap, bp, ps, p )
495	if (pressure_exner) then
496	CALL exner_hyb_p(ip1jmp1,ps,p,pks,pk)
497	else
498	CALL exner_milieu_p(ip1jmp1,ps,p,pks,pk)
499	endif
500	unskap=1./kappa
501	DO l = 1, llm
502	DO j=jjb_u,jje_u
503	DO i =1, iip1
504	p(i+(j-1)iip1,l) = preff ( pk(i,j,l)/cpp) ** unskap
505	ENDDO
506	ENDDO
507	ENDDO
508	CALL guide_out("SP",jjp1,llm,p(1:ip1jmp1,1:llm),1.)
509	ENDIF
510
511	if (guide_u) then
512	if (guide_add) then
513	f_add(ijb_u:ije_u,:)=(1.-tau)ugui1(ijb_u:ije_u,:)+tauugui2(ijb_u:ije_u,:)
514	else
515	f_add(ijb_u:ije_u,:)=(1.-tau)ugui1(ijb_u:ije_u,:)+tauugui2(ijb_u:ije_u,:)-ucov(ijb_u:ije_u,:)
516	endif
517
518	if (guide_zon) CALL guide_zonave(1,jjp1,llm,f_add)
519	CALL guide_addfield(ip1jmp1,llm,f_add,alpha_u)
520	IF (f_out) CALL guide_out("u",jjp1,llm,ucov,factt)
521	IF (f_out) CALL guide_out("ua",jjp1,llm,(1.-tau)ugui1(:,:)+tauugui2(:,:),factt)
522	IF (f_out) CALL guide_out("ucov",jjp1,llm,f_add(:,:)/factt,factt)
523	ucov(ijb_u:ije_u,:)=ucov(ijb_u:ije_u,:)+f_add(ijb_u:ije_u,:)
524	endif
525
526	if (guide_T) then
527	if (guide_add) then
528	f_add(ijb_u:ije_u,:)=(1.-tau)tgui1(ijb_u:ije_u,:)+tautgui2(ijb_u:ije_u,:)
529	else
530	f_add(ijb_u:ije_u,:)=(1.-tau)tgui1(ijb_u:ije_u,:)+tautgui2(ijb_u:ije_u,:)-teta(ijb_u:ije_u,:)
531	endif
532	if (guide_zon) CALL guide_zonave(2,jjp1,llm,f_add)
533	CALL guide_addfield(ip1jmp1,llm,f_add,alpha_T)
534	IF (f_out) CALL guide_out("teta",jjp1,llm,f_add(:,:)/factt,factt)
535	teta(ijb_u:ije_u,:)=teta(ijb_u:ije_u,:)+f_add(ijb_u:ije_u,:)
536	endif
537
538	if (guide_P) then
539	if (guide_add) then
540	f_add(ijb_u:ije_u,1)=(1.-tau)psgui1(ijb_u:ije_u)+taupsgui2(ijb_u:ije_u)
541	else
542	f_add(ijb_u:ije_u,1)=(1.-tau)psgui1(ijb_u:ije_u)+taupsgui2(ijb_u:ije_u)-ps(ijb_u:ije_u)
543	endif
544	if (guide_zon) CALL guide_zonave(2,jjp1,1,f_add(1:ip1jmp1,1))
545	CALL guide_addfield(ip1jmp1,1,f_add(1:ip1jmp1,1),alpha_P)
546	IF (f_out) CALL guide_out("ps",jjp1,1,f_add(1:ip1jmp1,1)/factt,factt)
547	ps(ijb_u:ije_u)=ps(ijb_u:ije_u)+f_add(ijb_u:ije_u,1)
548	CALL pression_p(ip1jmp1,ap,bp,ps,p)
549	CALL massdair_p(p,masse)
550	endif
551
552	if (guide_Q) then
553	if (guide_add) then
554	f_add(ijb_u:ije_u,:)=(1.-tau)qgui1(ijb_u:ije_u,:)+tauqgui2(ijb_u:ije_u,:)
555	else
556	f_add(ijb_u:ije_u,:)=(1.-tau)qgui1(ijb_u:ije_u,:)+tauqgui2(ijb_u:ije_u,:)-q(ijb_u:ije_u,:)
557	endif
558	if (guide_zon) CALL guide_zonave(2,jjp1,llm,f_add)
559	CALL guide_addfield(ip1jmp1,llm,f_add,alpha_Q)
560	IF (f_out) CALL guide_out("q",jjp1,llm,f_add(:,:)/factt,factt)
561	q(ijb_u:ije_u,:)=q(ijb_u:ije_u,:)+f_add(ijb_u:ije_u,:)
562	endif
563
564	if (guide_v) then
565	if (guide_add) then
566	f_add(ijb_v:ije_v,:)=(1.-tau)vgui1(ijb_v:ije_v,:)+tauvgui2(ijb_v:ije_v,:)
567	else
568	f_add(ijb_v:ije_v,:)=(1.-tau)vgui1(ijb_v:ije_v,:)+tauvgui2(ijb_v:ije_v,:)-vcov(ijb_v:ije_v,:)
569	endif
570
571	if (guide_zon) CALL guide_zonave(2,jjm,llm,f_add(1:ip1jm,:))
572	CALL guide_addfield(ip1jm,llm,f_add(1:ip1jm,:),alpha_v)
573	IF (f_out) CALL guide_out("v",jjm,llm,vcov(1:ip1jm,:),factt)
574	IF (f_out) CALL guide_out("va",jjm,llm,(1.-tau)vgui1(:,:)+tauvgui2(:,:),factt)
575	IF (f_out) CALL guide_out("vcov",jjm,llm,f_add(1:ip1jm,:)/factt,factt)
576	vcov(ijb_v:ije_v,:)=vcov(ijb_v:ije_v,:)+f_add(ijb_v:ije_v,:)
577	endif
578
579	END SUBROUTINE guide_main
580
581	!=======================================================================
582	SUBROUTINE guide_addfield(hsize,vsize,field,alpha)
583	! field1=afield1+alphafield2
584
585	IMPLICIT NONE
586	INCLUDE "dimensions.h"
587	INCLUDE "paramet.h"
588
589	! input variables
590	INTEGER, INTENT(IN) :: hsize
591	INTEGER, INTENT(IN) :: vsize
592	REAL, DIMENSION(hsize), INTENT(IN) :: alpha
593	REAL, DIMENSION(hsize,vsize), INTENT(INOUT) :: field
594
595	! Local variables
596	INTEGER :: l
597
598	IF (hsize==ip1jm) THEN
599	do l=1,vsize
600	field(ijb_v:ije_v,l)=alpha(ijb_v:ije_v)field(ijb_v:ije_v,l)alpha_pcor(l)
601	enddo
602	ELSE
603	do l=1,vsize
604	field(ijb_u:ije_u,l)=alpha(ijb_u:ije_u)field(ijb_u:ije_u,l)alpha_pcor(l)
605	enddo
606	ENDIF
607
608	END SUBROUTINE guide_addfield
609
610	!=======================================================================
611	SUBROUTINE guide_zonave(typ,hsize,vsize,field)
612
613	IMPLICIT NONE
614
615	INCLUDE "dimensions.h"
616	INCLUDE "paramet.h"
617	INCLUDE "comgeom.h"
618	INCLUDE "comconst.h"
619
620	! input/output variables
621	INTEGER, INTENT(IN) :: typ
622	INTEGER, INTENT(IN) :: vsize
623	INTEGER, INTENT(IN) :: hsize
624	REAL, DIMENSION(hsize*iip1,vsize), INTENT(INOUT) :: field
625
626	! Local variables
627	LOGICAL, SAVE :: first=.TRUE.
628	INTEGER, DIMENSION (2), SAVE :: imin, imax ! averaging domain
629	INTEGER :: i,j,l,ij
630	REAL, DIMENSION (iip1) :: lond ! longitude in Deg.
631	REAL, DIMENSION (hsize,vsize):: fieldm ! zon-averaged field
632
633	IF (first) THEN
634	first=.FALSE.
635	!Compute domain for averaging
636	lond=rlonu*180./pi
637	imin(1)=1;imax(1)=iip1;
638	imin(2)=1;imax(2)=iip1;
639	IF (guide_reg) THEN
640	DO i=1,iim
641	IF (lond(i).LT.lon_min_g) imin(1)=i
642	IF (lond(i).LE.lon_max_g) imax(1)=i
643	ENDDO
644	lond=rlonv*180./pi
645	DO i=1,iim
646	IF (lond(i).LT.lon_min_g) imin(2)=i
647	IF (lond(i).LE.lon_max_g) imax(2)=i
648	ENDDO
649	ENDIF
650	ENDIF
651
652	fieldm=0.
653
654	IF (hsize==jjm) THEN
655	DO l=1,vsize
656	! Compute zonal average
657	DO j=jjb_v,jje_v
658	DO i=imin(typ),imax(typ)
659	ij=(j-1)*iip1+i
660	fieldm(j,l)=fieldm(j,l)+field(ij,l)
661	ENDDO
662	ENDDO
663	fieldm(:,l)=fieldm(:,l)/REAL(imax(typ)-imin(typ)+1)
664	! Compute forcing
665	DO j=jjb_v,jje_v
666	DO i=1,iip1
667	ij=(j-1)*iip1+i
668	field(ij,l)=fieldm(j,l)
669	ENDDO
670	ENDDO
671	ENDDO
672	ELSE
673	DO l=1,vsize
674	! Compute zonal average
675	DO j=jjb_v,jje_v
676	DO i=imin(typ),imax(typ)
677	ij=(j-1)*iip1+i
678	fieldm(j,l)=fieldm(j,l)+field(ij,l)
679	ENDDO
680	ENDDO
681	fieldm(:,l)=fieldm(:,l)/REAL(imax(typ)-imin(typ)+1)
682	! Compute forcing
683	DO j=jjb_u,jje_u
684	DO i=1,iip1
685	ij=(j-1)*iip1+i
686	field(ij,l)=fieldm(j,l)
687	ENDDO
688	ENDDO
689	ENDDO
690	ENDIF
691
692	END SUBROUTINE guide_zonave
693
694	!=======================================================================
695	SUBROUTINE guide_interp(psi,teta)
696	use exner_hyb_p_m, only: exner_hyb_p
697	use exner_milieu_p_m, only: exner_milieu_p
698	USE parallel_lmdz
699	USE mod_hallo
700	USE Bands
701	IMPLICIT NONE
702
703	include "dimensions.h"
704	include "paramet.h"
705	include "comvert.h"
706	include "comgeom2.h"
707	include "comconst.h"
708
709	REAL, DIMENSION (iip1,jjp1), INTENT(IN) :: psi ! Psol gcm
710	REAL, DIMENSION (iip1,jjp1,llm), INTENT(IN) :: teta ! Temp. Pot. gcm
711
712	LOGICAL, SAVE :: first=.TRUE.
713	! Variables pour niveaux pression:
714	REAL, DIMENSION (iip1,jjp1,nlevnc) :: plnc1,plnc2 !niveaux pression guidage
715	REAL, DIMENSION (iip1,jjp1,llm) :: plunc,plsnc !niveaux pression modele
716	REAL, DIMENSION (iip1,jjm,llm) :: plvnc !niveaux pression modele
717	REAL, DIMENSION (iip1,jjp1,llmp1) :: p ! pression intercouches
718	REAL, DIMENSION (iip1,jjp1,llm) :: pls, pext ! var intermediaire
719	REAL, DIMENSION (iip1,jjp1,llm) :: pbarx
720	REAL, DIMENSION (iip1,jjm,llm) :: pbary
721	! Variables pour fonction Exner (P milieu couche)
722	REAL, DIMENSION (iip1,jjp1,llm) :: pk
723	REAL, DIMENSION (iip1,jjp1) :: pks
724	REAL :: unskap
725	! Pression de vapeur saturante
726	REAL, DIMENSION (ip1jmp1,llm) :: qsat
727	!Variables intermediaires interpolation
728	REAL, DIMENSION (iip1,jjp1,llm) :: zu1,zu2
729	REAL, DIMENSION (iip1,jjm,llm) :: zv1,zv2
730
731	INTEGER :: i,j,l,ij
732	TYPE(Request) :: Req
733
734	print *,'Guide: conversion variables guidage'
735	! -----------------------------------------------------------------
736	! Calcul des niveaux de pression champs guidage (pour T et Q)
737	! -----------------------------------------------------------------
738	IF (guide_plevs.EQ.0) THEN
739	DO l=1,nlevnc
740	DO j=jjb_u,jje_u
741	DO i=1,iip1
742	plnc2(i,j,l)=apnc(l)
743	plnc1(i,j,l)=apnc(l)
744	ENDDO
745	ENDDO
746	ENDDO
747	ENDIF
748
749	if (first) then
750	first=.FALSE.
751	print*,'Guide: verification ordre niveaux verticaux'
752	print*,'LMDZ :'
753	do l=1,llm
754	print*,'PL(',l,')=',(ap(l)+ap(l+1))/2. &
755	+psi(1,jje_u)*(bp(l)+bp(l+1))/2.
756	enddo
757	print*,'Fichiers guidage'
758	SELECT CASE (guide_plevs)
759	CASE (0)
760	do l=1,nlevnc
761	print*,'PL(',l,')=',plnc2(1,jjb_u,l)
762	enddo
763	CASE (1)
764	DO l=1,nlevnc
765	print,'PL(',l,')=',apnc(l)+bpnc(l)psnat2(i,jjb_u)
766	ENDDO
767	CASE (2)
768	do l=1,nlevnc
769	print*,'PL(',l,')=',pnat2(1,jjb_u,l)
770	enddo
771	END SELECT
772	print *,'inversion de l''ordre: invert_p=',invert_p
773	if (guide_u) then
774	do l=1,nlevnc
775	print*,'U(',l,')=',unat2(1,jjb_u,l)
776	enddo
777	endif
778	if (guide_T) then
779	do l=1,nlevnc
780	print*,'T(',l,')=',tnat2(1,jjb_u,l)
781	enddo
782	endif
783	endif
784
785	! -----------------------------------------------------------------
786	! Calcul niveaux pression modele
787	! -----------------------------------------------------------------
788
789	! .... Calcul de pls , pression au milieu des couches ,en Pascals
790	IF (guide_plevs.EQ.1) THEN
791	DO l=1,llm
792	DO j=jjb_u,jje_u
793	DO i =1, iip1
794	pls(i,j,l)=(ap(l)+ap(l+1))/2.+psi(i,j)*(bp(l)+bp(l+1))/2.
795	ENDDO
796	ENDDO
797	ENDDO
798	ELSE
799	CALL pression_p( ip1jmp1, ap, bp, psi, p )
800	if (pressure_exner) then
801	CALL exner_hyb_p(ip1jmp1,psi,p,pks,pk)
802	else
803	CALL exner_milieu_p(ip1jmp1,psi,p,pks,pk)
804	endif
805	unskap=1./kappa
806	DO l = 1, llm
807	DO j=jjb_u,jje_u
808	DO i =1, iip1
809	pls(i,j,l) = preff * ( pk(i,j,l)/cpp) ** unskap
810	ENDDO
811	ENDDO
812	ENDDO
813	ENDIF
814
815	! calcul des pressions pour les grilles u et v
816	do l=1,llm
817	do j=jjb_u,jje_u
818	do i=1,iip1
819	pext(i,j,l)=pls(i,j,l)*aire(i,j)
820	enddo
821	enddo
822	enddo
823
824	CALL Register_SwapFieldHallo(pext,pext,ip1jmp1,llm,jj_Nb_caldyn,1,2,Req)
825	CALL SendRequest(Req)
826	CALL WaitRequest(Req)
827
828	call massbar_p(pext, pbarx, pbary )
829	do l=1,llm
830	do j=jjb_u,jje_u
831	do i=1,iip1
832	plunc(i,j,l)=pbarx(i,j,l)/aireu(i,j)
833	plsnc(i,j,l)=pls(i,j,l)
834	enddo
835	enddo
836	enddo
837	do l=1,llm
838	do j=jjb_v,jje_v
839	do i=1,iip1
840	plvnc(i,j,l)=pbary(i,j,l)/airev(i,j)
841	enddo
842	enddo
843	enddo
844
845	! -----------------------------------------------------------------
846	! Interpolation verticale champs guidage sur niveaux modele
847	! Conversion en variables gcm (ucov, vcov...)
848	! -----------------------------------------------------------------
849	if (guide_P) then
850	do j=jjb_u,jje_u
851	do i=1,iim
852	ij=(j-1)*iip1+i
853	psgui1(ij)=psnat1(i,j)
854	psgui2(ij)=psnat2(i,j)
855	enddo
856	psgui1(iip1*j)=psnat1(1,j)
857	psgui2(iip1*j)=psnat2(1,j)
858	enddo
859	endif
860
861	IF (guide_T) THEN
862	! Calcul des nouvelles valeurs des niveaux de pression du guidage
863	IF (guide_plevs.EQ.1) THEN
864	DO l=1,nlevnc
865	DO j=jjb_u,jje_u
866	DO i=1,iip1
867	plnc2(i,j,l)=apnc(l)+bpnc(l)*psnat2(i,j)
868	plnc1(i,j,l)=apnc(l)+bpnc(l)*psnat1(i,j)
869	ENDDO
870	ENDDO
871	ENDDO
872	ELSE IF (guide_plevs.EQ.2) THEN
873	DO l=1,nlevnc
874	DO j=jjb_u,jje_u
875	DO i=1,iip1
876	plnc2(i,j,l)=pnat2(i,j,l)
877	plnc1(i,j,l)=pnat1(i,j,l)
878	ENDDO
879	ENDDO
880	ENDDO
881	ENDIF
882
883	! Interpolation verticale
884	CALL pres2lev(tnat1(:,jjb_u:jje_u,:),zu1(:,jjb_u:jje_u,:),nlevnc,llm, &
885	plnc1(:,jjb_u:jje_u,:),plsnc(:,jjb_u:jje_u,:),iip1,jjn_u,invert_p)
886	CALL pres2lev(tnat2(:,jjb_u:jje_u,:),zu2(:,jjb_u:jje_u,:),nlevnc,llm, &
887	plnc2(:,jjb_u:jje_u,:),plsnc(:,jjb_u:jje_u,:),iip1,jjn_u,invert_p)
888
889	! Conversion en variables GCM
890	do l=1,llm
891	do j=jjb_u,jje_u
892	IF (guide_teta) THEN
893	do i=1,iim
894	ij=(j-1)*iip1+i
895	tgui1(ij,l)=zu1(i,j,l)
896	tgui2(ij,l)=zu2(i,j,l)
897	enddo
898	ELSE
899	do i=1,iim
900	ij=(j-1)*iip1+i
901	tgui1(ij,l)=zu1(i,j,l)*cpp/pk(i,j,l)
902	tgui2(ij,l)=zu2(i,j,l)*cpp/pk(i,j,l)
903	enddo
904	ENDIF
905	tgui1(jiip1,l)=tgui1((j-1)iip1+1,l)
906	tgui2(jiip1,l)=tgui2((j-1)iip1+1,l)
907	enddo
908	do i=1,iip1
909	tgui1(i,l)=tgui1(1,l)
910	tgui1(ip1jm+i,l)=tgui1(ip1jm+1,l)
911	tgui2(i,l)=tgui2(1,l)
912	tgui2(ip1jm+i,l)=tgui2(ip1jm+1,l)
913	enddo
914	enddo
915	ENDIF
916
917	IF (guide_Q) THEN
918	! Calcul des nouvelles valeurs des niveaux de pression du guidage
919	IF (guide_plevs.EQ.1) THEN
920	DO l=1,nlevnc
921	DO j=jjb_u,jje_u
922	DO i=1,iip1
923	plnc2(i,j,l)=apnc(l)+bpnc(l)*psnat2(i,j)
924	plnc1(i,j,l)=apnc(l)+bpnc(l)*psnat1(i,j)
925	ENDDO
926	ENDDO
927	ENDDO
928	ELSE IF (guide_plevs.EQ.2) THEN
929	DO l=1,nlevnc
930	DO j=jjb_u,jje_u
931	DO i=1,iip1
932	plnc2(i,j,l)=pnat2(i,j,l)
933	plnc1(i,j,l)=pnat1(i,j,l)
934	ENDDO
935	ENDDO
936	ENDDO
937	ENDIF
938
939	! Interpolation verticale
940	CALL pres2lev(qnat1(:,jjb_u:jje_u,:),zu1(:,jjb_u:jje_u,:),nlevnc,llm, &
941	plnc1(:,jjb_u:jje_u,:),plsnc(:,jjb_u:jje_u,:),iip1,jjn_u,invert_p)
942	CALL pres2lev(qnat2(:,jjb_u:jje_u,:),zu2(:,jjb_u:jje_u,:),nlevnc,llm, &
943	plnc2(:,jjb_u:jje_u,:),plsnc(:,jjb_u:jje_u,:),iip1,jjn_u,invert_p)
944
945	! Conversion en variables GCM
946	! On suppose qu'on a la bonne variable dans le fichier de guidage:
947	! Hum.Rel si guide_hr, Hum.Spec. sinon.
948	do l=1,llm
949	do j=jjb_u,jje_u
950	do i=1,iim
951	ij=(j-1)*iip1+i
952	qgui1(ij,l)=zu1(i,j,l)
953	qgui2(ij,l)=zu2(i,j,l)
954	enddo
955	qgui1(jiip1,l)=qgui1((j-1)iip1+1,l)
956	qgui2(jiip1,l)=qgui2((j-1)iip1+1,l)
957	enddo
958	do i=1,iip1
959	qgui1(i,l)=qgui1(1,l)
960	qgui1(ip1jm+i,l)=qgui1(ip1jm+1,l)
961	qgui2(i,l)=qgui2(1,l)
962	qgui2(ip1jm+i,l)=qgui2(ip1jm+1,l)
963	enddo
964	enddo
965	IF (guide_hr) THEN
966	CALL q_sat(iip1jjn_ullm,teta(:,jjb_u:jje_u,:)*pk(:,jjb_u:jje_u,:)/cpp, &
967	plsnc(:,jjb_u:jje_u,:),qsat(ijb_u:ije_u,:))
968	qgui1(ijb_u:ije_u,:)=qgui1(ijb_u:ije_u,:)qsat(ijb_u:ije_u,:)0.01 !hum. rel. en %
969	qgui2(ijb_u:ije_u,:)=qgui2(ijb_u:ije_u,:)qsat(ijb_u:ije_u,:)0.01
970	ENDIF
971	ENDIF
972
973	IF (guide_u) THEN
974	! Calcul des nouvelles valeurs des niveaux de pression du guidage
975	IF (guide_plevs.EQ.1) THEN
976	DO l=1,nlevnc
977	DO j=jjb_u,jje_u
978	DO i=1,iim
979	plnc2(i,j,l)=apnc(l)+bpnc(l)(psnat2(i,j)aire(i,j)*alpha1p2(i,j) &
980	& +psnat2(i+1,j)aire(i+1,j)alpha3p4(i+1,j))/aireu(i,j)
981	plnc1(i,j,l)=apnc(l)+bpnc(l)(psnat1(i,j)aire(i,j)*alpha1p2(i,j) &
982	& +psnat1(i+1,j)aire(i+1,j)alpha3p4(i+1,j))/aireu(i,j)
983	ENDDO
984	plnc2(iip1,j,l)=plnc2(1,j,l)
985	plnc1(iip1,j,l)=plnc1(1,j,l)
986	ENDDO
987	ENDDO
988	ELSE IF (guide_plevs.EQ.2) THEN
989	DO l=1,nlevnc
990	DO j=jjb_u,jje_u
991	DO i=1,iim
992	plnc2(i,j,l)=(pnat2(i,j,l)aire(i,j)alpha1p2(i,j) &
993	& +pnat2(i+1,j,l)aire(i,j)alpha3p4(i+1,j))/aireu(i,j)
994	plnc1(i,j,l)=(pnat1(i,j,l)aire(i,j)alpha1p2(i,j) &
995	& +pnat1(i+1,j,l)aire(i,j)alpha3p4(i+1,j))/aireu(i,j)
996	ENDDO
997	plnc2(iip1,j,l)=plnc2(1,j,l)
998	plnc1(iip1,j,l)=plnc1(1,j,l)
999	ENDDO
1000	ENDDO
1001	ENDIF
1002
1003	! Interpolation verticale
1004	CALL pres2lev(unat1(:,jjb_u:jje_u,:),zu1(:,jjb_u:jje_u,:),nlevnc,llm, &
1005	plnc1(:,jjb_u:jje_u,:),plunc(:,jjb_u:jje_u,:),iip1,jjn_u,invert_p)
1006	CALL pres2lev(unat2(:,jjb_u:jje_u,:),zu2(:,jjb_u:jje_u,:),nlevnc,llm, &
1007	plnc2(:,jjb_u:jje_u,:),plunc(:,jjb_u:jje_u,:),iip1,jjn_u,invert_p)
1008
1009	! Conversion en variables GCM
1010	do l=1,llm
1011	do j=jjb_u,jje_u
1012	do i=1,iim
1013	ij=(j-1)*iip1+i
1014	ugui1(ij,l)=zu1(i,j,l)*cu(i,j)
1015	ugui2(ij,l)=zu2(i,j,l)*cu(i,j)
1016	enddo
1017	ugui1(jiip1,l)=ugui1((j-1)iip1+1,l)
1018	ugui2(jiip1,l)=ugui2((j-1)iip1+1,l)
1019	enddo
1020	do i=1,iip1
1021	ugui1(i,l)=0.
1022	ugui1(ip1jm+i,l)=0.
1023	ugui2(i,l)=0.
1024	ugui2(ip1jm+i,l)=0.
1025	enddo
1026	enddo
1027	ENDIF
1028
1029	IF (guide_v) THEN
1030	! Calcul des nouvelles valeurs des niveaux de pression du guidage
1031	IF (guide_plevs.EQ.1) THEN
1032	CALL Register_SwapFieldHallo(psnat1,psnat1,ip1jmp1,1,jj_Nb_caldyn,1,2,Req)
1033	CALL SendRequest(Req)
1034	CALL WaitRequest(Req)
1035	CALL Register_SwapFieldHallo(psnat2,psnat2,ip1jmp1,1,jj_Nb_caldyn,1,2,Req)
1036	CALL SendRequest(Req)
1037	CALL WaitRequest(Req)
1038	DO l=1,nlevnc
1039	DO j=jjb_v,jje_v
1040	DO i=1,iip1
1041	plnc2(i,j,l)=apnc(l)+bpnc(l)(psnat2(i,j)aire(i,j)*alpha2p3(i,j) &
1042	& +psnat2(i,j+1)aire(i,j+1)alpha1p4(i,j+1))/airev(i,j)
1043	plnc1(i,j,l)=apnc(l)+bpnc(l)(psnat1(i,j)aire(i,j)*alpha2p3(i,j) &
1044	& +psnat1(i,j+1)aire(i,j+1)alpha1p4(i,j+1))/airev(i,j)
1045	ENDDO
1046	ENDDO
1047	ENDDO
1048	ELSE IF (guide_plevs.EQ.2) THEN
1049	CALL Register_SwapFieldHallo(pnat1,pnat1,ip1jmp1,llm,jj_Nb_caldyn,1,2,Req)
1050	CALL SendRequest(Req)
1051	CALL WaitRequest(Req)
1052	CALL Register_SwapFieldHallo(pnat2,pnat2,ip1jmp1,llm,jj_Nb_caldyn,1,2,Req)
1053	CALL SendRequest(Req)
1054	CALL WaitRequest(Req)
1055	DO l=1,nlevnc
1056	DO j=jjb_v,jje_v
1057	DO i=1,iip1
1058	plnc2(i,j,l)=(pnat2(i,j,l)aire(i,j)alpha2p3(i,j) &
1059	& +pnat2(i,j+1,l)aire(i,j)alpha1p4(i,j+1))/airev(i,j)
1060	plnc1(i,j,l)=(pnat1(i,j,l)aire(i,j)alpha2p3(i,j) &
1061	& +pnat1(i,j+1,l)aire(i,j)alpha1p4(i,j+1))/airev(i,j)
1062	ENDDO
1063	ENDDO
1064	ENDDO
1065	ENDIF
1066	! Interpolation verticale
1067	CALL pres2lev(vnat1(:,jjb_v:jje_v,:),zv1(:,jjb_v:jje_v,:),nlevnc,llm, &
1068	plnc1(:,jjb_v:jje_v,:),plvnc(:,jjb_v:jje_v,:),iip1,jjn_v,invert_p)
1069	CALL pres2lev(vnat2(:,jjb_v:jje_v,:),zv2(:,jjb_v:jje_v,:),nlevnc,llm, &
1070	plnc2(:,jjb_v:jje_v,:),plvnc(:,jjb_v:jje_v,:),iip1,jjn_v,invert_p)
1071	! Conversion en variables GCM
1072	do l=1,llm
1073	do j=jjb_v,jje_v
1074	do i=1,iim
1075	ij=(j-1)*iip1+i
1076	vgui1(ij,l)=zv1(i,j,l)*cv(i,j)
1077	vgui2(ij,l)=zv2(i,j,l)*cv(i,j)
1078	enddo
1079	vgui1(jiip1,l)=vgui1((j-1)iip1+1,l)
1080	vgui2(jiip1,l)=vgui2((j-1)iip1+1,l)
1081	enddo
1082	enddo
1083	ENDIF
1084
1085
1086	END SUBROUTINE guide_interp
1087
1088	!=======================================================================
1089	SUBROUTINE tau2alpha(typ,pim,pjm,factt,taumin,taumax,alpha)
1090
1091	! Calcul des constantes de rappel alpha (=1/tau)
1092
1093	implicit none
1094
1095	include "dimensions.h"
1096	include "paramet.h"
1097	include "comconst.h"
1098	include "comgeom2.h"
1099	include "serre.h"
1100
1101	! input arguments :
1102	INTEGER, INTENT(IN) :: typ ! u(2),v(3), ou scalaire(1)
1103	INTEGER, INTENT(IN) :: pim,pjm ! dimensions en lat, lon
1104	REAL, INTENT(IN) :: factt ! pas de temps en fraction de jour
1105	REAL, INTENT(IN) :: taumin,taumax
1106	! output arguments:
1107	REAL, DIMENSION(pim,pjm), INTENT(OUT) :: alpha
1108
1109	! local variables:
1110	LOGICAL, SAVE :: first=.TRUE.
1111	REAL, SAVE :: gamma,dxdy_min,dxdy_max
1112	REAL, DIMENSION (iip1,jjp1) :: zdx,zdy
1113	REAL, DIMENSION (iip1,jjp1) :: dxdys,dxdyu
1114	REAL, DIMENSION (iip1,jjm) :: dxdyv
1115	real dxdy_
1116	real zlat,zlon
1117	real alphamin,alphamax,xi
1118	integer i,j,ilon,ilat
1119
1120
1121	alphamin=factt/taumax
1122	alphamax=factt/taumin
1123	IF (guide_reg.OR.guide_add) THEN
1124	alpha=alphamax
1125	!-----------------------------------------------------------------------
1126	! guide_reg: alpha=alpha_min dans region, 0. sinon.
1127	!-----------------------------------------------------------------------
1128	IF (guide_reg) THEN
1129	do j=1,pjm
1130	do i=1,pim
1131	if (typ.eq.2) then
1132	zlat=rlatu(j)*180./pi
1133	zlon=rlonu(i)*180./pi
1134	elseif (typ.eq.1) then
1135	zlat=rlatu(j)*180./pi
1136	zlon=rlonv(i)*180./pi
1137	elseif (typ.eq.3) then
1138	zlat=rlatv(j)*180./pi
1139	zlon=rlonv(i)*180./pi
1140	endif
1141	alpha(i,j)=alphamax/16.* &
1142	(1.+tanh((zlat-lat_min_g)/tau_lat))* &
1143	(1.+tanh((lat_max_g-zlat)/tau_lat))* &
1144	(1.+tanh((zlon-lon_min_g)/tau_lon))* &
1145	(1.+tanh((lon_max_g-zlon)/tau_lon))
1146	enddo
1147	enddo
1148	ENDIF
1149	ELSE
1150	!-----------------------------------------------------------------------
1151	! Sinon, alpha varie entre alpha_min et alpha_max suivant le zoom.
1152	!-----------------------------------------------------------------------
1153	!Calcul de l'aire des mailles
1154	do j=2,jjm
1155	do i=2,iip1
1156	zdx(i,j)=0.5*(cu(i-1,j)+cu(i,j))/cos(rlatu(j))
1157	enddo
1158	zdx(1,j)=zdx(iip1,j)
1159	enddo
1160	do j=2,jjm
1161	do i=1,iip1
1162	zdy(i,j)=0.5*(cv(i,j-1)+cv(i,j))
1163	enddo
1164	enddo
1165	do i=1,iip1
1166	zdx(i,1)=zdx(i,2)
1167	zdx(i,jjp1)=zdx(i,jjm)
1168	zdy(i,1)=zdy(i,2)
1169	zdy(i,jjp1)=zdy(i,jjm)
1170	enddo
1171	do j=1,jjp1
1172	do i=1,iip1
1173	dxdys(i,j)=sqrt(zdx(i,j)zdx(i,j)+zdy(i,j)zdy(i,j))
1174	enddo
1175	enddo
1176	IF (typ.EQ.2) THEN
1177	do j=1,jjp1
1178	do i=1,iim
1179	dxdyu(i,j)=0.5*(dxdys(i,j)+dxdys(i+1,j))
1180	enddo
1181	dxdyu(iip1,j)=dxdyu(1,j)
1182	enddo
1183	ENDIF
1184	IF (typ.EQ.3) THEN
1185	do j=1,jjm
1186	do i=1,iip1
1187	dxdyv(i,j)=0.5*(dxdys(i,j)+dxdys(i,j+1))
1188	enddo
1189	enddo
1190	ENDIF
1191	! Premier appel: calcul des aires min et max et de gamma.
1192	IF (first) THEN
1193	first=.FALSE.
1194	! coordonnees du centre du zoom
1195	CALL coordij(clon,clat,ilon,ilat)
1196	! aire de la maille au centre du zoom
1197	dxdy_min=dxdys(ilon,ilat)
1198	! dxdy maximale de la maille
1199	dxdy_max=0.
1200	do j=1,jjp1
1201	do i=1,iip1
1202	dxdy_max=max(dxdy_max,dxdys(i,j))
1203	enddo
1204	enddo
1205	! Calcul de gamma
1206	if (abs(grossismx-1.).lt.0.1.or.abs(grossismy-1.).lt.0.1) then
1207	print*,'ATTENTION modele peu zoome'
1208	print*,'ATTENTION on prend une constante de guidage cste'
1209	gamma=0.
1210	else
1211	gamma=(dxdy_max-2.*dxdy_min)/(dxdy_max-dxdy_min)
1212	print*,'gamma=',gamma
1213	if (gamma.lt.1.e-5) then
1214	print*,'gamma =',gamma,'<1e-5'
1215	stop
1216	endif
1217	gamma=log(0.5)/log(gamma)
1218	if (gamma4) then
1219	gamma=min(gamma,4.)
1220	endif
1221	print*,'gamma=',gamma
1222	endif
1223	ENDIF !first
1224
1225	do j=1,pjm
1226	do i=1,pim
1227	if (typ.eq.1) then
1228	dxdy_=dxdys(i,j)
1229	zlat=rlatu(j)*180./pi
1230	elseif (typ.eq.2) then
1231	dxdy_=dxdyu(i,j)
1232	zlat=rlatu(j)*180./pi
1233	elseif (typ.eq.3) then
1234	dxdy_=dxdyv(i,j)
1235	zlat=rlatv(j)*180./pi
1236	endif
1237	if (abs(grossismx-1.).lt.0.1.or.abs(grossismy-1.).lt.0.1) then
1238	! pour une grille reguliere, xi=xxx**0=1 -> alpha=alphamin
1239	alpha(i,j)=alphamin
1240	else
1241	xi=((dxdy_max-dxdy_)/(dxdy_max-dxdy_min))**gamma
1242	xi=min(xi,1.)
1243	if(lat_min_g.le.zlat .and. zlat.le.lat_max_g) then
1244	alpha(i,j)=xialphamin+(1.-xi)alphamax
1245	else
1246	alpha(i,j)=0.
1247	endif
1248	endif
1249	enddo
1250	enddo
1251	ENDIF ! guide_reg
1252
1253	END SUBROUTINE tau2alpha
1254
1255	!=======================================================================
1256	SUBROUTINE guide_read(timestep)
1257
1258	IMPLICIT NONE
1259
1260	! NetCDF-3.
1261	!
1262	! netcdf version 3 fortran interface:
1263	!
1264
1265	!
1266	! external netcdf data types:
1267	!
1268	integer nf_byte
1269	integer nf_int1
1270	integer nf_char
1271	integer nf_short
1272	integer nf_int2
1273	integer nf_int
1274	integer nf_float
1275	integer nf_real
1276	integer nf_double
1277
1278	parameter (nf_byte = 1)
1279	parameter (nf_int1 = nf_byte)
1280	parameter (nf_char = 2)
1281	parameter (nf_short = 3)
1282	parameter (nf_int2 = nf_short)
1283	parameter (nf_int = 4)
1284	parameter (nf_float = 5)
1285	parameter (nf_real = nf_float)
1286	parameter (nf_double = 6)
1287
1288	!
1289	! default fill values:
1290	!
1291	integer nf_fill_byte
1292	integer nf_fill_int1
1293	integer nf_fill_char
1294	integer nf_fill_short
1295	integer nf_fill_int2
1296	integer nf_fill_int
1297	real nf_fill_float
1298	real nf_fill_real
1299	doubleprecision nf_fill_double
1300
1301	parameter (nf_fill_byte = -127)
1302	parameter (nf_fill_int1 = nf_fill_byte)
1303	parameter (nf_fill_char = 0)
1304	parameter (nf_fill_short = -32767)
1305	parameter (nf_fill_int2 = nf_fill_short)
1306	parameter (nf_fill_int = -2147483647)
1307	parameter (nf_fill_float = 9.9692099683868690e+36)
1308	parameter (nf_fill_real = nf_fill_float)
1309	parameter (nf_fill_double = 9.9692099683868690d+36)
1310
1311	!
1312	! mode flags for opening and creating a netcdf dataset:
1313	!
1314	integer nf_nowrite
1315	integer nf_write
1316	integer nf_clobber
1317	integer nf_noclobber
1318	integer nf_fill
1319	integer nf_nofill
1320	integer nf_lock
1321	integer nf_share
1322	integer nf_64bit_offset
1323	integer nf_sizehint_default
1324	integer nf_align_chunk
1325	integer nf_format_classic
1326	integer nf_format_64bit
1327
1328	parameter (nf_nowrite = 0)
1329	parameter (nf_write = 1)
1330	parameter (nf_clobber = 0)
1331	parameter (nf_noclobber = 4)
1332	parameter (nf_fill = 0)
1333	parameter (nf_nofill = 256)
1334	parameter (nf_lock = 1024)
1335	parameter (nf_share = 2048)
1336	parameter (nf_64bit_offset = 512)
1337	parameter (nf_sizehint_default = 0)
1338	parameter (nf_align_chunk = -1)
1339	parameter (nf_format_classic = 1)
1340	parameter (nf_format_64bit = 2)
1341
1342	!
1343	! size argument for defining an unlimited dimension:
1344	!
1345	integer nf_unlimited
1346	parameter (nf_unlimited = 0)
1347
1348	!
1349	! global attribute id:
1350	!
1351	integer nf_global
1352	parameter (nf_global = 0)
1353
1354	!
1355	! implementation limits:
1356	!
1357	integer nf_max_dims
1358	integer nf_max_attrs
1359	integer nf_max_vars
1360	integer nf_max_name
1361	integer nf_max_var_dims
1362
1363	parameter (nf_max_dims = 1024)
1364	parameter (nf_max_attrs = 8192)
1365	parameter (nf_max_vars = 8192)
1366	parameter (nf_max_name = 256)
1367	parameter (nf_max_var_dims = nf_max_dims)
1368
1369	!
1370	! error codes:
1371	!
1372	integer nf_noerr
1373	integer nf_ebadid
1374	integer nf_eexist
1375	integer nf_einval
1376	integer nf_eperm
1377	integer nf_enotindefine
1378	integer nf_eindefine
1379	integer nf_einvalcoords
1380	integer nf_emaxdims
1381	integer nf_enameinuse
1382	integer nf_enotatt
1383	integer nf_emaxatts
1384	integer nf_ebadtype
1385	integer nf_ebaddim
1386	integer nf_eunlimpos
1387	integer nf_emaxvars
1388	integer nf_enotvar
1389	integer nf_eglobal
1390	integer nf_enotnc
1391	integer nf_ests
1392	integer nf_emaxname
1393	integer nf_eunlimit
1394	integer nf_enorecvars
1395	integer nf_echar
1396	integer nf_eedge
1397	integer nf_estride
1398	integer nf_ebadname
1399	integer nf_erange
1400	integer nf_enomem
1401	integer nf_evarsize
1402	integer nf_edimsize
1403	integer nf_etrunc
1404
1405	parameter (nf_noerr = 0)
1406	parameter (nf_ebadid = -33)
1407	parameter (nf_eexist = -35)
1408	parameter (nf_einval = -36)
1409	parameter (nf_eperm = -37)
1410	parameter (nf_enotindefine = -38)
1411	parameter (nf_eindefine = -39)
1412	parameter (nf_einvalcoords = -40)
1413	parameter (nf_emaxdims = -41)
1414	parameter (nf_enameinuse = -42)
1415	parameter (nf_enotatt = -43)
1416	parameter (nf_emaxatts = -44)
1417	parameter (nf_ebadtype = -45)
1418	parameter (nf_ebaddim = -46)
1419	parameter (nf_eunlimpos = -47)
1420	parameter (nf_emaxvars = -48)
1421	parameter (nf_enotvar = -49)
1422	parameter (nf_eglobal = -50)
1423	parameter (nf_enotnc = -51)
1424	parameter (nf_ests = -52)
1425	parameter (nf_emaxname = -53)
1426	parameter (nf_eunlimit = -54)
1427	parameter (nf_enorecvars = -55)
1428	parameter (nf_echar = -56)
1429	parameter (nf_eedge = -57)
1430	parameter (nf_estride = -58)
1431	parameter (nf_ebadname = -59)
1432	parameter (nf_erange = -60)
1433	parameter (nf_enomem = -61)
1434	parameter (nf_evarsize = -62)
1435	parameter (nf_edimsize = -63)
1436	parameter (nf_etrunc = -64)
1437	!
1438	! error handling modes:
1439	!
1440	integer nf_fatal
1441	integer nf_verbose
1442
1443	parameter (nf_fatal = 1)
1444	parameter (nf_verbose = 2)
1445
1446	!
1447	! miscellaneous routines:
1448	!
1449	character*80 nf_inq_libvers
1450	external nf_inq_libvers
1451
1452	character*80 nf_strerror
1453	! (integer ncerr)
1454	external nf_strerror
1455
1456	logical nf_issyserr
1457	! (integer ncerr)
1458	external nf_issyserr
1459
1460	!
1461	! control routines:
1462	!
1463	integer nf_inq_base_pe
1464	! (integer ncid,
1465	! integer pe)
1466	external nf_inq_base_pe
1467
1468	integer nf_set_base_pe
1469	! (integer ncid,
1470	! integer pe)
1471	external nf_set_base_pe
1472
1473	integer nf_create
1474	! (character() path,
1475	! integer cmode,
1476	! integer ncid)
1477	external nf_create
1478
1479	integer nf__create
1480	! (character() path,
1481	! integer cmode,
1482	! integer initialsz,
1483	! integer chunksizehint,
1484	! integer ncid)
1485	external nf__create
1486
1487	integer nf__create_mp
1488	! (character() path,
1489	! integer cmode,
1490	! integer initialsz,
1491	! integer basepe,
1492	! integer chunksizehint,
1493	! integer ncid)
1494	external nf__create_mp
1495
1496	integer nf_open
1497	! (character() path,
1498	! integer mode,
1499	! integer ncid)
1500	external nf_open
1501
1502	integer nf__open
1503	! (character() path,
1504	! integer mode,
1505	! integer chunksizehint,
1506	! integer ncid)
1507	external nf__open
1508
1509	integer nf__open_mp
1510	! (character() path,
1511	! integer mode,
1512	! integer basepe,
1513	! integer chunksizehint,
1514	! integer ncid)
1515	external nf__open_mp
1516
1517	integer nf_set_fill
1518	! (integer ncid,
1519	! integer fillmode,
1520	! integer old_mode)
1521	external nf_set_fill
1522
1523	integer nf_set_default_format
1524	! (integer format,
1525	! integer old_format)
1526	external nf_set_default_format
1527
1528	integer nf_redef
1529	! (integer ncid)
1530	external nf_redef
1531
1532	integer nf_enddef
1533	! (integer ncid)
1534	external nf_enddef
1535
1536	integer nf__enddef
1537	! (integer ncid,
1538	! integer h_minfree,
1539	! integer v_align,
1540	! integer v_minfree,
1541	! integer r_align)
1542	external nf__enddef
1543
1544	integer nf_sync
1545	! (integer ncid)
1546	external nf_sync
1547
1548	integer nf_abort
1549	! (integer ncid)
1550	external nf_abort
1551
1552	integer nf_close
1553	! (integer ncid)
1554	external nf_close
1555
1556	integer nf_delete
1557	! (character() ncid)
1558	external nf_delete
1559
1560	!
1561	! general inquiry routines:
1562	!
1563
1564	integer nf_inq
1565	! (integer ncid,
1566	! integer ndims,
1567	! integer nvars,
1568	! integer ngatts,
1569	! integer unlimdimid)
1570	external nf_inq
1571
1572	integer nf_inq_ndims
1573	! (integer ncid,
1574	! integer ndims)
1575	external nf_inq_ndims
1576
1577	integer nf_inq_nvars
1578	! (integer ncid,
1579	! integer nvars)
1580	external nf_inq_nvars
1581
1582	integer nf_inq_natts
1583	! (integer ncid,
1584	! integer ngatts)
1585	external nf_inq_natts
1586
1587	integer nf_inq_unlimdim
1588	! (integer ncid,
1589	! integer unlimdimid)
1590	external nf_inq_unlimdim
1591
1592	integer nf_inq_format
1593	! (integer ncid,
1594	! integer format)
1595	external nf_inq_format
1596
1597	!
1598	! dimension routines:
1599	!
1600
1601	integer nf_def_dim
1602	! (integer ncid,
1603	! character(*) name,
1604	! integer len,
1605	! integer dimid)
1606	external nf_def_dim
1607
1608	integer nf_inq_dimid
1609	! (integer ncid,
1610	! character(*) name,
1611	! integer dimid)
1612	external nf_inq_dimid
1613
1614	integer nf_inq_dim
1615	! (integer ncid,
1616	! integer dimid,
1617	! character(*) name,
1618	! integer len)
1619	external nf_inq_dim
1620
1621	integer nf_inq_dimname
1622	! (integer ncid,
1623	! integer dimid,
1624	! character(*) name)
1625	external nf_inq_dimname
1626
1627	integer nf_inq_dimlen
1628	! (integer ncid,
1629	! integer dimid,
1630	! integer len)
1631	external nf_inq_dimlen
1632
1633	integer nf_rename_dim
1634	! (integer ncid,
1635	! integer dimid,
1636	! character(*) name)
1637	external nf_rename_dim
1638
1639	!
1640	! general attribute routines:
1641	!
1642
1643	integer nf_inq_att
1644	! (integer ncid,
1645	! integer varid,
1646	! character(*) name,
1647	! integer xtype,
1648	! integer len)
1649	external nf_inq_att
1650
1651	integer nf_inq_attid
1652	! (integer ncid,
1653	! integer varid,
1654	! character(*) name,
1655	! integer attnum)
1656	external nf_inq_attid
1657
1658	integer nf_inq_atttype
1659	! (integer ncid,
1660	! integer varid,
1661	! character(*) name,
1662	! integer xtype)
1663	external nf_inq_atttype
1664
1665	integer nf_inq_attlen
1666	! (integer ncid,
1667	! integer varid,
1668	! character(*) name,
1669	! integer len)
1670	external nf_inq_attlen
1671
1672	integer nf_inq_attname
1673	! (integer ncid,
1674	! integer varid,
1675	! integer attnum,
1676	! character(*) name)
1677	external nf_inq_attname
1678
1679	integer nf_copy_att
1680	! (integer ncid_in,
1681	! integer varid_in,
1682	! character(*) name,
1683	! integer ncid_out,
1684	! integer varid_out)
1685	external nf_copy_att
1686
1687	integer nf_rename_att
1688	! (integer ncid,
1689	! integer varid,
1690	! character(*) curname,
1691	! character(*) newname)
1692	external nf_rename_att
1693
1694	integer nf_del_att
1695	! (integer ncid,
1696	! integer varid,
1697	! character(*) name)
1698	external nf_del_att
1699
1700	!
1701	! attribute put/get routines:
1702	!
1703
1704	integer nf_put_att_text
1705	! (integer ncid,
1706	! integer varid,
1707	! character(*) name,
1708	! integer len,
1709	! character(*) text)
1710	external nf_put_att_text
1711
1712	integer nf_get_att_text
1713	! (integer ncid,
1714	! integer varid,
1715	! character(*) name,
1716	! character(*) text)
1717	external nf_get_att_text
1718
1719	integer nf_put_att_int1
1720	! (integer ncid,
1721	! integer varid,
1722	! character(*) name,
1723	! integer xtype,
1724	! integer len,
1725	! nf_int1_t i1vals(1))
1726	external nf_put_att_int1
1727
1728	integer nf_get_att_int1
1729	! (integer ncid,
1730	! integer varid,
1731	! character(*) name,
1732	! nf_int1_t i1vals(1))
1733	external nf_get_att_int1
1734
1735	integer nf_put_att_int2
1736	! (integer ncid,
1737	! integer varid,
1738	! character(*) name,
1739	! integer xtype,
1740	! integer len,
1741	! nf_int2_t i2vals(1))
1742	external nf_put_att_int2
1743
1744	integer nf_get_att_int2
1745	! (integer ncid,
1746	! integer varid,
1747	! character(*) name,
1748	! nf_int2_t i2vals(1))
1749	external nf_get_att_int2
1750
1751	integer nf_put_att_int
1752	! (integer ncid,
1753	! integer varid,
1754	! character(*) name,
1755	! integer xtype,
1756	! integer len,
1757	! integer ivals(1))
1758	external nf_put_att_int
1759
1760	integer nf_get_att_int
1761	! (integer ncid,
1762	! integer varid,
1763	! character(*) name,
1764	! integer ivals(1))
1765	external nf_get_att_int
1766
1767	integer nf_put_att_real
1768	! (integer ncid,
1769	! integer varid,
1770	! character(*) name,
1771	! integer xtype,
1772	! integer len,
1773	! real rvals(1))
1774	external nf_put_att_real
1775
1776	integer nf_get_att_real
1777	! (integer ncid,
1778	! integer varid,
1779	! character(*) name,
1780	! real rvals(1))
1781	external nf_get_att_real
1782
1783	integer nf_put_att_double
1784	! (integer ncid,
1785	! integer varid,
1786	! character(*) name,
1787	! integer xtype,
1788	! integer len,
1789	! double dvals(1))
1790	external nf_put_att_double
1791
1792	integer nf_get_att_double
1793	! (integer ncid,
1794	! integer varid,
1795	! character(*) name,
1796	! double dvals(1))
1797	external nf_get_att_double
1798
1799	!
1800	! general variable routines:
1801	!
1802
1803	integer nf_def_var
1804	! (integer ncid,
1805	! character(*) name,
1806	! integer datatype,
1807	! integer ndims,
1808	! integer dimids(1),
1809	! integer varid)
1810	external nf_def_var
1811
1812	integer nf_inq_var
1813	! (integer ncid,
1814	! integer varid,
1815	! character(*) name,
1816	! integer datatype,
1817	! integer ndims,
1818	! integer dimids(1),
1819	! integer natts)
1820	external nf_inq_var
1821
1822	integer nf_inq_varid
1823	! (integer ncid,
1824	! character(*) name,
1825	! integer varid)
1826	external nf_inq_varid
1827
1828	integer nf_inq_varname
1829	! (integer ncid,
1830	! integer varid,
1831	! character(*) name)
1832	external nf_inq_varname
1833
1834	integer nf_inq_vartype
1835	! (integer ncid,
1836	! integer varid,
1837	! integer xtype)
1838	external nf_inq_vartype
1839
1840	integer nf_inq_varndims
1841	! (integer ncid,
1842	! integer varid,
1843	! integer ndims)
1844	external nf_inq_varndims
1845
1846	integer nf_inq_vardimid
1847	! (integer ncid,
1848	! integer varid,
1849	! integer dimids(1))
1850	external nf_inq_vardimid
1851
1852	integer nf_inq_varnatts
1853	! (integer ncid,
1854	! integer varid,
1855	! integer natts)
1856	external nf_inq_varnatts
1857
1858	integer nf_rename_var
1859	! (integer ncid,
1860	! integer varid,
1861	! character(*) name)
1862	external nf_rename_var
1863
1864	integer nf_copy_var
1865	! (integer ncid_in,
1866	! integer varid,
1867	! integer ncid_out)
1868	external nf_copy_var
1869
1870	!
1871	! entire variable put/get routines:
1872	!
1873
1874	integer nf_put_var_text
1875	! (integer ncid,
1876	! integer varid,
1877	! character(*) text)
1878	external nf_put_var_text
1879
1880	integer nf_get_var_text
1881	! (integer ncid,
1882	! integer varid,
1883	! character(*) text)
1884	external nf_get_var_text
1885
1886	integer nf_put_var_int1
1887	! (integer ncid,
1888	! integer varid,
1889	! nf_int1_t i1vals(1))
1890	external nf_put_var_int1
1891
1892	integer nf_get_var_int1
1893	! (integer ncid,
1894	! integer varid,
1895	! nf_int1_t i1vals(1))
1896	external nf_get_var_int1
1897
1898	integer nf_put_var_int2
1899	! (integer ncid,
1900	! integer varid,
1901	! nf_int2_t i2vals(1))
1902	external nf_put_var_int2
1903
1904	integer nf_get_var_int2
1905	! (integer ncid,
1906	! integer varid,
1907	! nf_int2_t i2vals(1))
1908	external nf_get_var_int2
1909
1910	integer nf_put_var_int
1911	! (integer ncid,
1912	! integer varid,
1913	! integer ivals(1))
1914	external nf_put_var_int
1915
1916	integer nf_get_var_int
1917	! (integer ncid,
1918	! integer varid,
1919	! integer ivals(1))
1920	external nf_get_var_int
1921
1922	integer nf_put_var_real
1923	! (integer ncid,
1924	! integer varid,
1925	! real rvals(1))
1926	external nf_put_var_real
1927
1928	integer nf_get_var_real
1929	! (integer ncid,
1930	! integer varid,
1931	! real rvals(1))
1932	external nf_get_var_real
1933
1934	integer nf_put_var_double
1935	! (integer ncid,
1936	! integer varid,
1937	! doubleprecision dvals(1))
1938	external nf_put_var_double
1939
1940	integer nf_get_var_double
1941	! (integer ncid,
1942	! integer varid,
1943	! doubleprecision dvals(1))
1944	external nf_get_var_double
1945
1946	!
1947	! single variable put/get routines:
1948	!
1949
1950	integer nf_put_var1_text
1951	! (integer ncid,
1952	! integer varid,
1953	! integer index(1),
1954	! character*1 text)
1955	external nf_put_var1_text
1956
1957	integer nf_get_var1_text
1958	! (integer ncid,
1959	! integer varid,
1960	! integer index(1),
1961	! character*1 text)
1962	external nf_get_var1_text
1963
1964	integer nf_put_var1_int1
1965	! (integer ncid,
1966	! integer varid,
1967	! integer index(1),
1968	! nf_int1_t i1val)
1969	external nf_put_var1_int1
1970
1971	integer nf_get_var1_int1
1972	! (integer ncid,
1973	! integer varid,
1974	! integer index(1),
1975	! nf_int1_t i1val)
1976	external nf_get_var1_int1
1977
1978	integer nf_put_var1_int2
1979	! (integer ncid,
1980	! integer varid,
1981	! integer index(1),
1982	! nf_int2_t i2val)
1983	external nf_put_var1_int2
1984
1985	integer nf_get_var1_int2
1986	! (integer ncid,
1987	! integer varid,
1988	! integer index(1),
1989	! nf_int2_t i2val)
1990	external nf_get_var1_int2
1991
1992	integer nf_put_var1_int
1993	! (integer ncid,
1994	! integer varid,
1995	! integer index(1),
1996	! integer ival)
1997	external nf_put_var1_int
1998
1999	integer nf_get_var1_int
2000	! (integer ncid,
2001	! integer varid,
2002	! integer index(1),
2003	! integer ival)
2004	external nf_get_var1_int
2005
2006	integer nf_put_var1_real
2007	! (integer ncid,
2008	! integer varid,
2009	! integer index(1),
2010	! real rval)
2011	external nf_put_var1_real
2012
2013	integer nf_get_var1_real
2014	! (integer ncid,
2015	! integer varid,
2016	! integer index(1),
2017	! real rval)
2018	external nf_get_var1_real
2019
2020	integer nf_put_var1_double
2021	! (integer ncid,
2022	! integer varid,
2023	! integer index(1),
2024	! doubleprecision dval)
2025	external nf_put_var1_double
2026
2027	integer nf_get_var1_double
2028	! (integer ncid,
2029	! integer varid,
2030	! integer index(1),
2031	! doubleprecision dval)
2032	external nf_get_var1_double
2033
2034	!
2035	! variable array put/get routines:
2036	!
2037
2038	integer nf_put_vara_text
2039	! (integer ncid,
2040	! integer varid,
2041	! integer start(1),
2042	! integer count(1),
2043	! character(*) text)
2044	external nf_put_vara_text
2045
2046	integer nf_get_vara_text
2047	! (integer ncid,
2048	! integer varid,
2049	! integer start(1),
2050	! integer count(1),
2051	! character(*) text)
2052	external nf_get_vara_text
2053
2054	integer nf_put_vara_int1
2055	! (integer ncid,
2056	! integer varid,
2057	! integer start(1),
2058	! integer count(1),
2059	! nf_int1_t i1vals(1))
2060	external nf_put_vara_int1
2061
2062	integer nf_get_vara_int1
2063	! (integer ncid,
2064	! integer varid,
2065	! integer start(1),
2066	! integer count(1),
2067	! nf_int1_t i1vals(1))
2068	external nf_get_vara_int1
2069
2070	integer nf_put_vara_int2
2071	! (integer ncid,
2072	! integer varid,
2073	! integer start(1),
2074	! integer count(1),
2075	! nf_int2_t i2vals(1))
2076	external nf_put_vara_int2
2077
2078	integer nf_get_vara_int2
2079	! (integer ncid,
2080	! integer varid,
2081	! integer start(1),
2082	! integer count(1),
2083	! nf_int2_t i2vals(1))
2084	external nf_get_vara_int2
2085
2086	integer nf_put_vara_int
2087	! (integer ncid,
2088	! integer varid,
2089	! integer start(1),
2090	! integer count(1),
2091	! integer ivals(1))
2092	external nf_put_vara_int
2093
2094	integer nf_get_vara_int
2095	! (integer ncid,
2096	! integer varid,
2097	! integer start(1),
2098	! integer count(1),
2099	! integer ivals(1))
2100	external nf_get_vara_int
2101
2102	integer nf_put_vara_real
2103	! (integer ncid,
2104	! integer varid,
2105	! integer start(1),
2106	! integer count(1),
2107	! real rvals(1))
2108	external nf_put_vara_real
2109
2110	integer nf_get_vara_real
2111	! (integer ncid,
2112	! integer varid,
2113	! integer start(1),
2114	! integer count(1),
2115	! real rvals(1))
2116	external nf_get_vara_real
2117
2118	integer nf_put_vara_double
2119	! (integer ncid,
2120	! integer varid,
2121	! integer start(1),
2122	! integer count(1),
2123	! doubleprecision dvals(1))
2124	external nf_put_vara_double
2125
2126	integer nf_get_vara_double
2127	! (integer ncid,
2128	! integer varid,
2129	! integer start(1),
2130	! integer count(1),
2131	! doubleprecision dvals(1))
2132	external nf_get_vara_double
2133
2134	!
2135	! strided variable put/get routines:
2136	!
2137
2138	integer nf_put_vars_text
2139	! (integer ncid,
2140	! integer varid,
2141	! integer start(1),
2142	! integer count(1),
2143	! integer stride(1),
2144	! character(*) text)
2145	external nf_put_vars_text
2146
2147	integer nf_get_vars_text
2148	! (integer ncid,
2149	! integer varid,
2150	! integer start(1),
2151	! integer count(1),
2152	! integer stride(1),
2153	! character(*) text)
2154	external nf_get_vars_text
2155
2156	integer nf_put_vars_int1
2157	! (integer ncid,
2158	! integer varid,
2159	! integer start(1),
2160	! integer count(1),
2161	! integer stride(1),
2162	! nf_int1_t i1vals(1))
2163	external nf_put_vars_int1
2164
2165	integer nf_get_vars_int1
2166	! (integer ncid,
2167	! integer varid,
2168	! integer start(1),
2169	! integer count(1),
2170	! integer stride(1),
2171	! nf_int1_t i1vals(1))
2172	external nf_get_vars_int1
2173
2174	integer nf_put_vars_int2
2175	! (integer ncid,
2176	! integer varid,
2177	! integer start(1),
2178	! integer count(1),
2179	! integer stride(1),
2180	! nf_int2_t i2vals(1))
2181	external nf_put_vars_int2
2182
2183	integer nf_get_vars_int2
2184	! (integer ncid,
2185	! integer varid,
2186	! integer start(1),
2187	! integer count(1),
2188	! integer stride(1),
2189	! nf_int2_t i2vals(1))
2190	external nf_get_vars_int2
2191
2192	integer nf_put_vars_int
2193	! (integer ncid,
2194	! integer varid,
2195	! integer start(1),
2196	! integer count(1),
2197	! integer stride(1),
2198	! integer ivals(1))
2199	external nf_put_vars_int
2200
2201	integer nf_get_vars_int
2202	! (integer ncid,
2203	! integer varid,
2204	! integer start(1),
2205	! integer count(1),
2206	! integer stride(1),
2207	! integer ivals(1))
2208	external nf_get_vars_int
2209
2210	integer nf_put_vars_real
2211	! (integer ncid,
2212	! integer varid,
2213	! integer start(1),
2214	! integer count(1),
2215	! integer stride(1),
2216	! real rvals(1))
2217	external nf_put_vars_real
2218
2219	integer nf_get_vars_real
2220	! (integer ncid,
2221	! integer varid,
2222	! integer start(1),
2223	! integer count(1),
2224	! integer stride(1),
2225	! real rvals(1))
2226	external nf_get_vars_real
2227
2228	integer nf_put_vars_double
2229	! (integer ncid,
2230	! integer varid,
2231	! integer start(1),
2232	! integer count(1),
2233	! integer stride(1),
2234	! doubleprecision dvals(1))
2235	external nf_put_vars_double
2236
2237	integer nf_get_vars_double
2238	! (integer ncid,
2239	! integer varid,
2240	! integer start(1),
2241	! integer count(1),
2242	! integer stride(1),
2243	! doubleprecision dvals(1))
2244	external nf_get_vars_double
2245
2246	!
2247	! mapped variable put/get routines:
2248	!
2249
2250	integer nf_put_varm_text
2251	! (integer ncid,
2252	! integer varid,
2253	! integer start(1),
2254	! integer count(1),
2255	! integer stride(1),
2256	! integer imap(1),
2257	! character(*) text)
2258	external nf_put_varm_text
2259
2260	integer nf_get_varm_text
2261	! (integer ncid,
2262	! integer varid,
2263	! integer start(1),
2264	! integer count(1),
2265	! integer stride(1),
2266	! integer imap(1),
2267	! character(*) text)
2268	external nf_get_varm_text
2269
2270	integer nf_put_varm_int1
2271	! (integer ncid,
2272	! integer varid,
2273	! integer start(1),
2274	! integer count(1),
2275	! integer stride(1),
2276	! integer imap(1),
2277	! nf_int1_t i1vals(1))
2278	external nf_put_varm_int1
2279
2280	integer nf_get_varm_int1
2281	! (integer ncid,
2282	! integer varid,
2283	! integer start(1),
2284	! integer count(1),
2285	! integer stride(1),
2286	! integer imap(1),
2287	! nf_int1_t i1vals(1))
2288	external nf_get_varm_int1
2289
2290	integer nf_put_varm_int2
2291	! (integer ncid,
2292	! integer varid,
2293	! integer start(1),
2294	! integer count(1),
2295	! integer stride(1),
2296	! integer imap(1),
2297	! nf_int2_t i2vals(1))
2298	external nf_put_varm_int2
2299
2300	integer nf_get_varm_int2
2301	! (integer ncid,
2302	! integer varid,
2303	! integer start(1),
2304	! integer count(1),
2305	! integer stride(1),
2306	! integer imap(1),
2307	! nf_int2_t i2vals(1))
2308	external nf_get_varm_int2
2309
2310	integer nf_put_varm_int
2311	! (integer ncid,
2312	! integer varid,
2313	! integer start(1),
2314	! integer count(1),
2315	! integer stride(1),
2316	! integer imap(1),
2317	! integer ivals(1))
2318	external nf_put_varm_int
2319
2320	integer nf_get_varm_int
2321	! (integer ncid,
2322	! integer varid,
2323	! integer start(1),
2324	! integer count(1),
2325	! integer stride(1),
2326	! integer imap(1),
2327	! integer ivals(1))
2328	external nf_get_varm_int
2329
2330	integer nf_put_varm_real
2331	! (integer ncid,
2332	! integer varid,
2333	! integer start(1),
2334	! integer count(1),
2335	! integer stride(1),
2336	! integer imap(1),
2337	! real rvals(1))
2338	external nf_put_varm_real
2339
2340	integer nf_get_varm_real
2341	! (integer ncid,
2342	! integer varid,
2343	! integer start(1),
2344	! integer count(1),
2345	! integer stride(1),
2346	! integer imap(1),
2347	! real rvals(1))
2348	external nf_get_varm_real
2349
2350	integer nf_put_varm_double
2351	! (integer ncid,
2352	! integer varid,
2353	! integer start(1),
2354	! integer count(1),
2355	! integer stride(1),
2356	! integer imap(1),
2357	! doubleprecision dvals(1))
2358	external nf_put_varm_double
2359
2360	integer nf_get_varm_double
2361	! (integer ncid,
2362	! integer varid,
2363	! integer start(1),
2364	! integer count(1),
2365	! integer stride(1),
2366	! integer imap(1),
2367	! doubleprecision dvals(1))
2368	external nf_get_varm_double
2369
2370
2371	! NetCDF-2.
2372	!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
2373	! begin netcdf 2.4 backward compatibility:
2374	!
2375
2376	!
2377	! functions in the fortran interface
2378	!
2379	integer nccre
2380	integer ncopn
2381	integer ncddef
2382	integer ncdid
2383	integer ncvdef
2384	integer ncvid
2385	integer nctlen
2386	integer ncsfil
2387
2388	external nccre
2389	external ncopn
2390	external ncddef
2391	external ncdid
2392	external ncvdef
2393	external ncvid
2394	external nctlen
2395	external ncsfil
2396
2397
2398	integer ncrdwr
2399	integer nccreat
2400	integer ncexcl
2401	integer ncindef
2402	integer ncnsync
2403	integer nchsync
2404	integer ncndirty
2405	integer nchdirty
2406	integer nclink
2407	integer ncnowrit
2408	integer ncwrite
2409	integer ncclob
2410	integer ncnoclob
2411	integer ncglobal
2412	integer ncfill
2413	integer ncnofill
2414	integer maxncop
2415	integer maxncdim
2416	integer maxncatt
2417	integer maxncvar
2418	integer maxncnam
2419	integer maxvdims
2420	integer ncnoerr
2421	integer ncebadid
2422	integer ncenfile
2423	integer nceexist
2424	integer nceinval
2425	integer nceperm
2426	integer ncenotin
2427	integer nceindef
2428	integer ncecoord
2429	integer ncemaxds
2430	integer ncename
2431	integer ncenoatt
2432	integer ncemaxat
2433	integer ncebadty
2434	integer ncebadd
2435	integer ncests
2436	integer nceunlim
2437	integer ncemaxvs
2438	integer ncenotvr
2439	integer nceglob
2440	integer ncenotnc
2441	integer ncfoobar
2442	integer ncsyserr
2443	integer ncfatal
2444	integer ncverbos
2445	integer ncentool
2446
2447
2448	!
2449	! netcdf data types:
2450	!
2451	integer ncbyte
2452	integer ncchar
2453	integer ncshort
2454	integer nclong
2455	integer ncfloat
2456	integer ncdouble
2457
2458	parameter(ncbyte = 1)
2459	parameter(ncchar = 2)
2460	parameter(ncshort = 3)
2461	parameter(nclong = 4)
2462	parameter(ncfloat = 5)
2463	parameter(ncdouble = 6)
2464
2465	!
2466	! masks for the struct nc flag field; passed in as 'mode' arg to
2467	! nccreate and ncopen.
2468	!
2469
2470	! read/write, 0 => readonly
2471	parameter(ncrdwr = 1)
2472	! in create phase, cleared by ncendef
2473	parameter(nccreat = 2)
2474	! on create destroy existing file
2475	parameter(ncexcl = 4)
2476	! in define mode, cleared by ncendef
2477	parameter(ncindef = 8)
2478	! synchronise numrecs on change (x'10')
2479	parameter(ncnsync = 16)
2480	! synchronise whole header on change (x'20')
2481	parameter(nchsync = 32)
2482	! numrecs has changed (x'40')
2483	parameter(ncndirty = 64)
2484	! header info has changed (x'80')
2485	parameter(nchdirty = 128)
2486	! prefill vars on endef and increase of record, the default behavior
2487	parameter(ncfill = 0)
2488	! do not fill vars on endef and increase of record (x'100')
2489	parameter(ncnofill = 256)
2490	! isa link (x'8000')
2491	parameter(nclink = 32768)
2492
2493	!
2494	! 'mode' arguments for nccreate and ncopen
2495	!
2496	parameter(ncnowrit = 0)
2497	parameter(ncwrite = ncrdwr)
2498	parameter(ncclob = nf_clobber)
2499	parameter(ncnoclob = nf_noclobber)
2500
2501	!
2502	! 'size' argument to ncdimdef for an unlimited dimension
2503	!
2504	integer ncunlim
2505	parameter(ncunlim = 0)
2506
2507	!
2508	! attribute id to put/get a global attribute
2509	!
2510	parameter(ncglobal = 0)
2511
2512	!
2513	! advisory maximums:
2514	!
2515	parameter(maxncop = 64)
2516	parameter(maxncdim = 1024)
2517	parameter(maxncatt = 8192)
2518	parameter(maxncvar = 8192)
2519	! not enforced
2520	parameter(maxncnam = 256)
2521	parameter(maxvdims = maxncdim)
2522
2523	!
2524	! global netcdf error status variable
2525	! initialized in error.c
2526	!
2527
2528	! no error
2529	parameter(ncnoerr = nf_noerr)
2530	! not a netcdf id
2531	parameter(ncebadid = nf_ebadid)
2532	! too many netcdfs open
2533	parameter(ncenfile = -31) ! nc_syserr
2534	! netcdf file exists && ncnoclob
2535	parameter(nceexist = nf_eexist)
2536	! invalid argument
2537	parameter(nceinval = nf_einval)
2538	! write to read only
2539	parameter(nceperm = nf_eperm)
2540	! operation not allowed in data mode
2541	parameter(ncenotin = nf_enotindefine )
2542	! operation not allowed in define mode
2543	parameter(nceindef = nf_eindefine)
2544	! coordinates out of domain
2545	parameter(ncecoord = nf_einvalcoords)
2546	! maxncdims exceeded
2547	parameter(ncemaxds = nf_emaxdims)
2548	! string match to name in use
2549	parameter(ncename = nf_enameinuse)
2550	! attribute not found
2551	parameter(ncenoatt = nf_enotatt)
2552	! maxncattrs exceeded
2553	parameter(ncemaxat = nf_emaxatts)
2554	! not a netcdf data type
2555	parameter(ncebadty = nf_ebadtype)
2556	! invalid dimension id
2557	parameter(ncebadd = nf_ebaddim)
2558	! ncunlimited in the wrong index
2559	parameter(nceunlim = nf_eunlimpos)
2560	! maxncvars exceeded
2561	parameter(ncemaxvs = nf_emaxvars)
2562	! variable not found
2563	parameter(ncenotvr = nf_enotvar)
2564	! action prohibited on ncglobal varid
2565	parameter(nceglob = nf_eglobal)
2566	! not a netcdf file
2567	parameter(ncenotnc = nf_enotnc)
2568	parameter(ncests = nf_ests)
2569	parameter (ncentool = nf_emaxname)
2570	parameter(ncfoobar = 32)
2571	parameter(ncsyserr = -31)
2572
2573	!
2574	! global options variable. used to determine behavior of error handler.
2575	! initialized in lerror.c
2576	!
2577	parameter(ncfatal = 1)
2578	parameter(ncverbos = 2)
2579
2580	!
2581	! default fill values. these must be the same as in the c interface.
2582	!
2583	integer filbyte
2584	integer filchar
2585	integer filshort
2586	integer fillong
2587	real filfloat
2588	doubleprecision fildoub
2589
2590	parameter (filbyte = -127)
2591	parameter (filchar = 0)
2592	parameter (filshort = -32767)
2593	parameter (fillong = -2147483647)
2594	parameter (filfloat = 9.9692099683868690e+36)
2595	parameter (fildoub = 9.9692099683868690d+36)
2596
2597	! NetCDF-4.
2598	! This is part of netCDF-4. Copyright 2006, UCAR, See COPYRIGHT
2599	! file for distribution information.
2600
2601	! Netcdf version 4 fortran interface.
2602
2603	! $Id: netcdf4.inc,v 1.28 2010/05/25 13:53:02 ed Exp $
2604
2605	! New netCDF-4 types.
2606	integer nf_ubyte
2607	integer nf_ushort
2608	integer nf_uint
2609	integer nf_int64
2610	integer nf_uint64
2611	integer nf_string
2612	integer nf_vlen
2613	integer nf_opaque
2614	integer nf_enum
2615	integer nf_compound
2616
2617	parameter (nf_ubyte = 7)
2618	parameter (nf_ushort = 8)
2619	parameter (nf_uint = 9)
2620	parameter (nf_int64 = 10)
2621	parameter (nf_uint64 = 11)
2622	parameter (nf_string = 12)
2623	parameter (nf_vlen = 13)
2624	parameter (nf_opaque = 14)
2625	parameter (nf_enum = 15)
2626	parameter (nf_compound = 16)
2627
2628	! New netCDF-4 fill values.
2629	integer nf_fill_ubyte
2630	integer nf_fill_ushort
2631	! real nf_fill_uint
2632	! real nf_fill_int64
2633	! real nf_fill_uint64
2634	parameter (nf_fill_ubyte = 255)
2635	parameter (nf_fill_ushort = 65535)
2636
2637	! New constants.
2638	integer nf_format_netcdf4
2639	parameter (nf_format_netcdf4 = 3)
2640
2641	integer nf_format_netcdf4_classic
2642	parameter (nf_format_netcdf4_classic = 4)
2643
2644	integer nf_netcdf4
2645	parameter (nf_netcdf4 = 4096)
2646
2647	integer nf_classic_model
2648	parameter (nf_classic_model = 256)
2649
2650	integer nf_chunk_seq
2651	parameter (nf_chunk_seq = 0)
2652	integer nf_chunk_sub
2653	parameter (nf_chunk_sub = 1)
2654	integer nf_chunk_sizes
2655	parameter (nf_chunk_sizes = 2)
2656
2657	integer nf_endian_native
2658	parameter (nf_endian_native = 0)
2659	integer nf_endian_little
2660	parameter (nf_endian_little = 1)
2661	integer nf_endian_big
2662	parameter (nf_endian_big = 2)
2663
2664	! For NF_DEF_VAR_CHUNKING
2665	integer nf_chunked
2666	parameter (nf_chunked = 0)
2667	integer nf_contiguous
2668	parameter (nf_contiguous = 1)
2669
2670	! For NF_DEF_VAR_FLETCHER32
2671	integer nf_nochecksum
2672	parameter (nf_nochecksum = 0)
2673	integer nf_fletcher32
2674	parameter (nf_fletcher32 = 1)
2675
2676	! For NF_DEF_VAR_DEFLATE
2677	integer nf_noshuffle
2678	parameter (nf_noshuffle = 0)
2679	integer nf_shuffle
2680	parameter (nf_shuffle = 1)
2681
2682	! For NF_DEF_VAR_SZIP
2683	integer nf_szip_ec_option_mask
2684	parameter (nf_szip_ec_option_mask = 4)
2685	integer nf_szip_nn_option_mask
2686	parameter (nf_szip_nn_option_mask = 32)
2687
2688	! For parallel I/O.
2689	integer nf_mpiio
2690	parameter (nf_mpiio = 8192)
2691	integer nf_mpiposix
2692	parameter (nf_mpiposix = 16384)
2693	integer nf_pnetcdf
2694	parameter (nf_pnetcdf = 32768)
2695
2696	! For NF_VAR_PAR_ACCESS.
2697	integer nf_independent
2698	parameter (nf_independent = 0)
2699	integer nf_collective
2700	parameter (nf_collective = 1)
2701
2702	! New error codes.
2703	integer nf_ehdferr ! Error at HDF5 layer.
2704	parameter (nf_ehdferr = -101)
2705	integer nf_ecantread ! Can't read.
2706	parameter (nf_ecantread = -102)
2707	integer nf_ecantwrite ! Can't write.
2708	parameter (nf_ecantwrite = -103)
2709	integer nf_ecantcreate ! Can't create.
2710	parameter (nf_ecantcreate = -104)
2711	integer nf_efilemeta ! Problem with file metadata.
2712	parameter (nf_efilemeta = -105)
2713	integer nf_edimmeta ! Problem with dimension metadata.
2714	parameter (nf_edimmeta = -106)
2715	integer nf_eattmeta ! Problem with attribute metadata.
2716	parameter (nf_eattmeta = -107)
2717	integer nf_evarmeta ! Problem with variable metadata.
2718	parameter (nf_evarmeta = -108)
2719	integer nf_enocompound ! Not a compound type.
2720	parameter (nf_enocompound = -109)
2721	integer nf_eattexists ! Attribute already exists.
2722	parameter (nf_eattexists = -110)
2723	integer nf_enotnc4 ! Attempting netcdf-4 operation on netcdf-3 file.
2724	parameter (nf_enotnc4 = -111)
2725	integer nf_estrictnc3 ! Attempting netcdf-4 operation on strict nc3 netcdf-4 file.
2726	parameter (nf_estrictnc3 = -112)
2727	integer nf_enotnc3 ! Attempting netcdf-3 operation on netcdf-4 file.
2728	parameter (nf_enotnc3 = -113)
2729	integer nf_enopar ! Parallel operation on file opened for non-parallel access.
2730	parameter (nf_enopar = -114)
2731	integer nf_eparinit ! Error initializing for parallel access.
2732	parameter (nf_eparinit = -115)
2733	integer nf_ebadgrpid ! Bad group ID.
2734	parameter (nf_ebadgrpid = -116)
2735	integer nf_ebadtypid ! Bad type ID.
2736	parameter (nf_ebadtypid = -117)
2737	integer nf_etypdefined ! Type has already been defined and may not be edited.
2738	parameter (nf_etypdefined = -118)
2739	integer nf_ebadfield ! Bad field ID.
2740	parameter (nf_ebadfield = -119)
2741	integer nf_ebadclass ! Bad class.
2742	parameter (nf_ebadclass = -120)
2743	integer nf_emaptype ! Mapped access for atomic types only.
2744	parameter (nf_emaptype = -121)
2745	integer nf_elatefill ! Attempt to define fill value when data already exists.
2746	parameter (nf_elatefill = -122)
2747	integer nf_elatedef ! Attempt to define var properties, like deflate, after enddef.
2748	parameter (nf_elatedef = -123)
2749	integer nf_edimscale ! Probem with HDF5 dimscales.
2750	parameter (nf_edimscale = -124)
2751	integer nf_enogrp ! No group found.
2752	parameter (nf_enogrp = -125)
2753
2754
2755	! New functions.
2756
2757	! Parallel I/O.
2758	integer nf_create_par
2759	external nf_create_par
2760
2761	integer nf_open_par
2762	external nf_open_par
2763
2764	integer nf_var_par_access
2765	external nf_var_par_access
2766
2767	! Functions to handle groups.
2768	integer nf_inq_ncid
2769	external nf_inq_ncid
2770
2771	integer nf_inq_grps
2772	external nf_inq_grps
2773
2774	integer nf_inq_grpname
2775	external nf_inq_grpname
2776
2777	integer nf_inq_grpname_full
2778	external nf_inq_grpname_full
2779
2780	integer nf_inq_grpname_len
2781	external nf_inq_grpname_len
2782
2783	integer nf_inq_grp_parent
2784	external nf_inq_grp_parent
2785
2786	integer nf_inq_grp_ncid
2787	external nf_inq_grp_ncid
2788
2789	integer nf_inq_grp_full_ncid
2790	external nf_inq_grp_full_ncid
2791
2792	integer nf_inq_varids
2793	external nf_inq_varids
2794
2795	integer nf_inq_dimids
2796	external nf_inq_dimids
2797
2798	integer nf_def_grp
2799	external nf_def_grp
2800
2801	! New options for netCDF variables.
2802	integer nf_def_var_deflate
2803	external nf_def_var_deflate
2804
2805	integer nf_inq_var_deflate
2806	external nf_inq_var_deflate
2807
2808	integer nf_def_var_fletcher32
2809	external nf_def_var_fletcher32
2810
2811	integer nf_inq_var_fletcher32
2812	external nf_inq_var_fletcher32
2813
2814	integer nf_def_var_chunking
2815	external nf_def_var_chunking
2816
2817	integer nf_inq_var_chunking
2818	external nf_inq_var_chunking
2819
2820	integer nf_def_var_fill
2821	external nf_def_var_fill
2822
2823	integer nf_inq_var_fill
2824	external nf_inq_var_fill
2825
2826	integer nf_def_var_endian
2827	external nf_def_var_endian
2828
2829	integer nf_inq_var_endian
2830	external nf_inq_var_endian
2831
2832	! User defined types.
2833	integer nf_inq_typeids
2834	external nf_inq_typeids
2835
2836	integer nf_inq_typeid
2837	external nf_inq_typeid
2838
2839	integer nf_inq_type
2840	external nf_inq_type
2841
2842	integer nf_inq_user_type
2843	external nf_inq_user_type
2844
2845	! User defined types - compound types.
2846	integer nf_def_compound
2847	external nf_def_compound
2848
2849	integer nf_insert_compound
2850	external nf_insert_compound
2851
2852	integer nf_insert_array_compound
2853	external nf_insert_array_compound
2854
2855	integer nf_inq_compound
2856	external nf_inq_compound
2857
2858	integer nf_inq_compound_name
2859	external nf_inq_compound_name
2860
2861	integer nf_inq_compound_size
2862	external nf_inq_compound_size
2863
2864	integer nf_inq_compound_nfields
2865	external nf_inq_compound_nfields
2866
2867	integer nf_inq_compound_field
2868	external nf_inq_compound_field
2869
2870	integer nf_inq_compound_fieldname
2871	external nf_inq_compound_fieldname
2872
2873	integer nf_inq_compound_fieldindex
2874	external nf_inq_compound_fieldindex
2875
2876	integer nf_inq_compound_fieldoffset
2877	external nf_inq_compound_fieldoffset
2878
2879	integer nf_inq_compound_fieldtype
2880	external nf_inq_compound_fieldtype
2881
2882	integer nf_inq_compound_fieldndims
2883	external nf_inq_compound_fieldndims
2884
2885	integer nf_inq_compound_fielddim_sizes
2886	external nf_inq_compound_fielddim_sizes
2887
2888	! User defined types - variable length arrays.
2889	integer nf_def_vlen
2890	external nf_def_vlen
2891
2892	integer nf_inq_vlen
2893	external nf_inq_vlen
2894
2895	integer nf_free_vlen
2896	external nf_free_vlen
2897
2898	! User defined types - enums.
2899	integer nf_def_enum
2900	external nf_def_enum
2901
2902	integer nf_insert_enum
2903	external nf_insert_enum
2904
2905	integer nf_inq_enum
2906	external nf_inq_enum
2907
2908	integer nf_inq_enum_member
2909	external nf_inq_enum_member
2910
2911	integer nf_inq_enum_ident
2912	external nf_inq_enum_ident
2913
2914	! User defined types - opaque.
2915	integer nf_def_opaque
2916	external nf_def_opaque
2917
2918	integer nf_inq_opaque
2919	external nf_inq_opaque
2920
2921	! Write and read attributes of any type, including user defined
2922	! types.
2923	integer nf_put_att
2924	external nf_put_att
2925	integer nf_get_att
2926	external nf_get_att
2927
2928	! Write and read variables of any type, including user defined
2929	! types.
2930	integer nf_put_var
2931	external nf_put_var
2932	integer nf_put_var1
2933	external nf_put_var1
2934	integer nf_put_vara
2935	external nf_put_vara
2936	integer nf_put_vars
2937	external nf_put_vars
2938	integer nf_get_var
2939	external nf_get_var
2940	integer nf_get_var1
2941	external nf_get_var1
2942	integer nf_get_vara
2943	external nf_get_vara
2944	integer nf_get_vars
2945	external nf_get_vars
2946
2947	! 64-bit int functions.
2948	integer nf_put_var1_int64
2949	external nf_put_var1_int64
2950	integer nf_put_vara_int64
2951	external nf_put_vara_int64
2952	integer nf_put_vars_int64
2953	external nf_put_vars_int64
2954	integer nf_put_varm_int64
2955	external nf_put_varm_int64
2956	integer nf_put_var_int64
2957	external nf_put_var_int64
2958	integer nf_get_var1_int64
2959	external nf_get_var1_int64
2960	integer nf_get_vara_int64
2961	external nf_get_vara_int64
2962	integer nf_get_vars_int64
2963	external nf_get_vars_int64
2964	integer nf_get_varm_int64
2965	external nf_get_varm_int64
2966	integer nf_get_var_int64
2967	external nf_get_var_int64
2968
2969	! For helping F77 users with VLENs.
2970	integer nf_get_vlen_element
2971	external nf_get_vlen_element
2972	integer nf_put_vlen_element
2973	external nf_put_vlen_element
2974
2975	! For dealing with file level chunk cache.
2976	integer nf_set_chunk_cache
2977	external nf_set_chunk_cache
2978	integer nf_get_chunk_cache
2979	external nf_get_chunk_cache
2980
2981	! For dealing with per variable chunk cache.
2982	integer nf_set_var_chunk_cache
2983	external nf_set_var_chunk_cache
2984	integer nf_get_var_chunk_cache
2985	external nf_get_var_chunk_cache
2986	!-----------------------------------------------------------------------
2987	! INCLUDE 'dimensions.h'
2988	!
2989	! dimensions.h contient les dimensions du modele
2990	! ndm est tel que iim=2**ndm
2991	!-----------------------------------------------------------------------
2992
2993	INTEGER iim,jjm,llm,ndm
2994
2995	PARAMETER (iim= 128,jjm=96,llm=64,ndm=1)
2996
2997	!-----------------------------------------------------------------------
2998	!
2999	! $Header$
3000	!
3001	!
3002	! ATTENTION!!!!: ce fichier include est compatible format fixe/format libre
3003	! veillez n'utiliser que des ! pour les commentaires
3004	! et bien positionner les & des lignes de continuation
3005	! (les placer en colonne 6 et en colonne 73)
3006	!
3007	!
3008	!-----------------------------------------------------------------------
3009	! INCLUDE 'paramet.h'
3010
3011	INTEGER iip1,iip2,iip3,jjp1,llmp1,llmp2,llmm1
3012	INTEGER kftd,ip1jm,ip1jmp1,ip1jmi1,ijp1llm
3013	INTEGER ijmllm,mvar
3014	INTEGER jcfil,jcfllm
3015
3016	PARAMETER( iip1= iim+1,iip2=iim+2,iip3=iim+3 &
3017	& ,jjp1=jjm+1-1/jjm)
3018	PARAMETER( llmp1 = llm+1, llmp2 = llm+2, llmm1 = llm-1 )
3019	PARAMETER( kftd = iim/2 -ndm )
3020	PARAMETER( ip1jm = iip1jjm, ip1jmp1= iip1jjp1 )
3021	PARAMETER( ip1jmi1= ip1jm - iip1 )
3022	PARAMETER( ijp1llm= ip1jmp1 * llm, ijmllm= ip1jm * llm )
3023	PARAMETER( mvar= ip1jmp1( 2llm+1) + ijmllm )
3024	PARAMETER( jcfil=jjm/2+5, jcfllm=jcfil*llm )
3025
3026	!-----------------------------------------------------------------------
3027
3028	INTEGER, INTENT(IN) :: timestep
3029
3030	LOGICAL, SAVE :: first=.TRUE.
3031	! Identification fichiers et variables NetCDF:
3032	INTEGER, SAVE :: ncidu,varidu,ncidv,varidv,ncidp,varidp
3033	INTEGER, SAVE :: ncidQ,varidQ,ncidt,varidt,ncidps,varidps
3034	INTEGER :: ncidpl,varidpl,varidap,varidbp
3035	! Variables auxiliaires NetCDF:
3036	INTEGER, DIMENSION(4) :: start,count
3037	INTEGER :: status,rcode
3038
3039	CHARACTER (len = 80) :: abort_message
3040	CHARACTER (len = 20) :: modname = 'guide_read'
3041	! -----------------------------------------------------------------
3042	! Premier appel: initialisation de la lecture des fichiers
3043	! -----------------------------------------------------------------
3044	if (first) then
3045	ncidpl=-99
3046	print*,'Guide: ouverture des fichiers guidage '
3047	! Ap et Bp si Niveaux de pression hybrides
3048	if (guide_plevs.EQ.1) then
3049	print *,'Lecture du guidage sur niveaux modele'
3050	rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
3051	IF (rcode.NE.NF_NOERR) THEN
3052	print *,'Guide: probleme -> pas de fichier apbp.nc'
3053	CALL abort_gcm(modname,abort_message,1)
3054	ENDIF
3055	rcode = nf90_inq_varid(ncidpl, 'AP', varidap)
3056	IF (rcode.NE.NF_NOERR) THEN
3057	print *,'Guide: probleme -> pas de variable AP, fichier apbp.nc'
3058	CALL abort_gcm(modname,abort_message,1)
3059	ENDIF
3060	rcode = nf90_inq_varid(ncidpl, 'BP', varidbp)
3061	IF (rcode.NE.NF_NOERR) THEN
3062	print *,'Guide: probleme -> pas de variable BP, fichier apbp.nc'
3063	CALL abort_gcm(modname,abort_message,1)
3064	ENDIF
3065	print*,'ncidpl,varidap',ncidpl,varidap
3066	endif
3067	! Pression si guidage sur niveaux P variables
3068	if (guide_plevs.EQ.2) then
3069	rcode = nf90_open('P.nc', nf90_nowrite, ncidp)
3070	IF (rcode.NE.NF_NOERR) THEN
3071	print *,'Guide: probleme -> pas de fichier P.nc'
3072	CALL abort_gcm(modname,abort_message,1)
3073	ENDIF
3074	rcode = nf90_inq_varid(ncidp, 'PRES', varidp)
3075	IF (rcode.NE.NF_NOERR) THEN
3076	print *,'Guide: probleme -> pas de variable PRES, fichier P.nc'
3077	CALL abort_gcm(modname,abort_message,1)
3078	ENDIF
3079	print*,'ncidp,varidp',ncidp,varidp
3080	if (ncidpl.eq.-99) ncidpl=ncidp
3081	endif
3082	! Vent zonal
3083	if (guide_u) then
3084	rcode = nf90_open('u.nc', nf90_nowrite, ncidu)
3085	IF (rcode.NE.NF_NOERR) THEN
3086	print *,'Guide: probleme -> pas de fichier u.nc'
3087	CALL abort_gcm(modname,abort_message,1)
3088	ENDIF
3089	rcode = nf90_inq_varid(ncidu, 'UWND', varidu)
3090	IF (rcode.NE.NF_NOERR) THEN
3091	print *,'Guide: probleme -> pas de variable UWND, fichier u.nc'
3092	CALL abort_gcm(modname,abort_message,1)
3093	ENDIF
3094	print*,'ncidu,varidu',ncidu,varidu
3095	if (ncidpl.eq.-99) ncidpl=ncidu
3096	endif
3097	! Vent meridien
3098	if (guide_v) then
3099	rcode = nf90_open('v.nc', nf90_nowrite, ncidv)
3100	IF (rcode.NE.NF_NOERR) THEN
3101	print *,'Guide: probleme -> pas de fichier v.nc'
3102	CALL abort_gcm(modname,abort_message,1)
3103	ENDIF
3104	rcode = nf90_inq_varid(ncidv, 'VWND', varidv)
3105	IF (rcode.NE.NF_NOERR) THEN
3106	print *,'Guide: probleme -> pas de variable VWND, fichier v.nc'
3107	CALL abort_gcm(modname,abort_message,1)
3108	ENDIF
3109	print*,'ncidv,varidv',ncidv,varidv
3110	if (ncidpl.eq.-99) ncidpl=ncidv
3111	endif
3112	! Temperature
3113	if (guide_T) then
3114	rcode = nf90_open('T.nc', nf90_nowrite, ncidt)
3115	IF (rcode.NE.NF_NOERR) THEN
3116	print *,'Guide: probleme -> pas de fichier T.nc'
3117	CALL abort_gcm(modname,abort_message,1)
3118	ENDIF
3119	rcode = nf90_inq_varid(ncidt, 'AIR', varidt)
3120	IF (rcode.NE.NF_NOERR) THEN
3121	print *,'Guide: probleme -> pas de variable AIR, fichier T.nc'
3122	CALL abort_gcm(modname,abort_message,1)
3123	ENDIF
3124	print*,'ncidT,varidT',ncidt,varidt
3125	if (ncidpl.eq.-99) ncidpl=ncidt
3126	endif
3127	! Humidite
3128	if (guide_Q) then
3129	rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ)
3130	IF (rcode.NE.NF_NOERR) THEN
3131	print *,'Guide: probleme -> pas de fichier hur.nc'
3132	CALL abort_gcm(modname,abort_message,1)
3133	ENDIF
3134	rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)
3135	IF (rcode.NE.NF_NOERR) THEN
3136	print *,'Guide: probleme -> pas de variable RH, fichier hur.nc'
3137	CALL abort_gcm(modname,abort_message,1)
3138	ENDIF
3139	print*,'ncidQ,varidQ',ncidQ,varidQ
3140	if (ncidpl.eq.-99) ncidpl=ncidQ
3141	endif
3142	! Pression de surface
3143	if ((guide_P).OR.(guide_plevs.EQ.1)) then
3144	rcode = nf90_open('ps.nc', nf90_nowrite, ncidps)
3145	IF (rcode.NE.NF_NOERR) THEN
3146	print *,'Guide: probleme -> pas de fichier ps.nc'
3147	CALL abort_gcm(modname,abort_message,1)
3148	ENDIF
3149	rcode = nf90_inq_varid(ncidps, 'SP', varidps)
3150	IF (rcode.NE.NF_NOERR) THEN
3151	print *,'Guide: probleme -> pas de variable SP, fichier ps.nc'
3152	CALL abort_gcm(modname,abort_message,1)
3153	ENDIF
3154	print*,'ncidps,varidps',ncidps,varidps
3155	endif
3156	! Coordonnee verticale
3157	if (guide_plevs.EQ.0) then
3158	rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
3159	IF (rcode.NE.0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
3160	print*,'ncidpl,varidpl',ncidpl,varidpl
3161	endif
3162	! Coefs ap, bp pour calcul de la pression aux differents niveaux
3163	IF (guide_plevs.EQ.1) THEN
3164	status=NF_GET_VARA_DOUBLE(ncidpl,varidap,1,nlevnc,apnc)
3165	status=NF_GET_VARA_DOUBLE(ncidpl,varidbp,1,nlevnc,bpnc)
3166	ELSEIF (guide_plevs.EQ.0) THEN
3167	status=NF_GET_VARA_DOUBLE(ncidpl,varidpl,1,nlevnc,apnc)
3168	apnc=apnc*100.! conversion en Pascals
3169	bpnc(:)=0.
3170	ENDIF
3171	first=.FALSE.
3172	ENDIF ! (first)
3173
3174	! -----------------------------------------------------------------
3175	! lecture des champs u, v, T, Q, ps
3176	! -----------------------------------------------------------------
3177
3178	! dimensions pour les champs scalaires et le vent zonal
3179	start(1)=1
3180	start(2)=1
3181	start(3)=1
3182	start(4)=timestep
3183
3184	count(1)=iip1
3185	count(2)=jjp1
3186	count(3)=nlevnc
3187	count(4)=1
3188
3189	! Pression
3190	if (guide_plevs.EQ.2) then
3191	status=NF_GET_VARA_DOUBLE(ncidp,varidp,start,count,pnat2)
3192	IF (invert_y) THEN
3193	CALL invert_lat(iip1,jjp1,nlevnc,pnat2)
3194	ENDIF
3195	endif
3196
3197	! Vent zonal
3198	if (guide_u) then
3199	status=NF_GET_VARA_DOUBLE(ncidu,varidu,start,count,unat2)
3200	IF (invert_y) THEN
3201	CALL invert_lat(iip1,jjp1,nlevnc,unat2)
3202	ENDIF
3203
3204	endif
3205
3206	! Temperature
3207	if (guide_T) then
3208	status=NF_GET_VARA_DOUBLE(ncidt,varidt,start,count,tnat2)
3209	IF (invert_y) THEN
3210	CALL invert_lat(iip1,jjp1,nlevnc,tnat2)
3211	ENDIF
3212	endif
3213
3214	! Humidite
3215	if (guide_Q) then
3216	status=NF_GET_VARA_DOUBLE(ncidQ,varidQ,start,count,qnat2)
3217	IF (invert_y) THEN
3218	CALL invert_lat(iip1,jjp1,nlevnc,qnat2)
3219	ENDIF
3220
3221	endif
3222
3223	! Vent meridien
3224	if (guide_v) then
3225	count(2)=jjm
3226	status=NF_GET_VARA_DOUBLE(ncidv,varidv,start,count,vnat2)
3227	IF (invert_y) THEN
3228	CALL invert_lat(iip1,jjm,nlevnc,vnat2)
3229	ENDIF
3230	endif
3231
3232	! Pression de surface
3233	if ((guide_P).OR.(guide_plevs.EQ.1)) then
3234	start(3)=timestep
3235	start(4)=0
3236	count(2)=jjp1
3237	count(3)=1
3238	count(4)=0
3239	status=NF_GET_VARA_DOUBLE(ncidps,varidps,start,count,psnat2)
3240	IF (invert_y) THEN
3241	CALL invert_lat(iip1,jjp1,1,psnat2)
3242	ENDIF
3243	endif
3244
3245	END SUBROUTINE guide_read
3246
3247	!=======================================================================
3248	SUBROUTINE guide_read2D(timestep)
3249
3250	IMPLICIT NONE
3251
3252	! NetCDF-3.
3253	!
3254	! netcdf version 3 fortran interface:
3255	!
3256
3257	!
3258	! external netcdf data types:
3259	!
3260	integer nf_byte
3261	integer nf_int1
3262	integer nf_char
3263	integer nf_short
3264	integer nf_int2
3265	integer nf_int
3266	integer nf_float
3267	integer nf_real
3268	integer nf_double
3269
3270	parameter (nf_byte = 1)
3271	parameter (nf_int1 = nf_byte)
3272	parameter (nf_char = 2)
3273	parameter (nf_short = 3)
3274	parameter (nf_int2 = nf_short)
3275	parameter (nf_int = 4)
3276	parameter (nf_float = 5)
3277	parameter (nf_real = nf_float)
3278	parameter (nf_double = 6)
3279
3280	!
3281	! default fill values:
3282	!
3283	integer nf_fill_byte
3284	integer nf_fill_int1
3285	integer nf_fill_char
3286	integer nf_fill_short
3287	integer nf_fill_int2
3288	integer nf_fill_int
3289	real nf_fill_float
3290	real nf_fill_real
3291	doubleprecision nf_fill_double
3292
3293	parameter (nf_fill_byte = -127)
3294	parameter (nf_fill_int1 = nf_fill_byte)
3295	parameter (nf_fill_char = 0)
3296	parameter (nf_fill_short = -32767)
3297	parameter (nf_fill_int2 = nf_fill_short)
3298	parameter (nf_fill_int = -2147483647)
3299	parameter (nf_fill_float = 9.9692099683868690e+36)
3300	parameter (nf_fill_real = nf_fill_float)
3301	parameter (nf_fill_double = 9.9692099683868690d+36)
3302
3303	!
3304	! mode flags for opening and creating a netcdf dataset:
3305	!
3306	integer nf_nowrite
3307	integer nf_write
3308	integer nf_clobber
3309	integer nf_noclobber
3310	integer nf_fill
3311	integer nf_nofill
3312	integer nf_lock
3313	integer nf_share
3314	integer nf_64bit_offset
3315	integer nf_sizehint_default
3316	integer nf_align_chunk
3317	integer nf_format_classic
3318	integer nf_format_64bit
3319
3320	parameter (nf_nowrite = 0)
3321	parameter (nf_write = 1)
3322	parameter (nf_clobber = 0)
3323	parameter (nf_noclobber = 4)
3324	parameter (nf_fill = 0)
3325	parameter (nf_nofill = 256)
3326	parameter (nf_lock = 1024)
3327	parameter (nf_share = 2048)
3328	parameter (nf_64bit_offset = 512)
3329	parameter (nf_sizehint_default = 0)
3330	parameter (nf_align_chunk = -1)
3331	parameter (nf_format_classic = 1)
3332	parameter (nf_format_64bit = 2)
3333
3334	!
3335	! size argument for defining an unlimited dimension:
3336	!
3337	integer nf_unlimited
3338	parameter (nf_unlimited = 0)
3339
3340	!
3341	! global attribute id:
3342	!
3343	integer nf_global
3344	parameter (nf_global = 0)
3345
3346	!
3347	! implementation limits:
3348	!
3349	integer nf_max_dims
3350	integer nf_max_attrs
3351	integer nf_max_vars
3352	integer nf_max_name
3353	integer nf_max_var_dims
3354
3355	parameter (nf_max_dims = 1024)
3356	parameter (nf_max_attrs = 8192)
3357	parameter (nf_max_vars = 8192)
3358	parameter (nf_max_name = 256)
3359	parameter (nf_max_var_dims = nf_max_dims)
3360
3361	!
3362	! error codes:
3363	!
3364	integer nf_noerr
3365	integer nf_ebadid
3366	integer nf_eexist
3367	integer nf_einval
3368	integer nf_eperm
3369	integer nf_enotindefine
3370	integer nf_eindefine
3371	integer nf_einvalcoords
3372	integer nf_emaxdims
3373	integer nf_enameinuse
3374	integer nf_enotatt
3375	integer nf_emaxatts
3376	integer nf_ebadtype
3377	integer nf_ebaddim
3378	integer nf_eunlimpos
3379	integer nf_emaxvars
3380	integer nf_enotvar
3381	integer nf_eglobal
3382	integer nf_enotnc
3383	integer nf_ests
3384	integer nf_emaxname
3385	integer nf_eunlimit
3386	integer nf_enorecvars
3387	integer nf_echar
3388	integer nf_eedge
3389	integer nf_estride
3390	integer nf_ebadname
3391	integer nf_erange
3392	integer nf_enomem
3393	integer nf_evarsize
3394	integer nf_edimsize
3395	integer nf_etrunc
3396
3397	parameter (nf_noerr = 0)
3398	parameter (nf_ebadid = -33)
3399	parameter (nf_eexist = -35)
3400	parameter (nf_einval = -36)
3401	parameter (nf_eperm = -37)
3402	parameter (nf_enotindefine = -38)
3403	parameter (nf_eindefine = -39)
3404	parameter (nf_einvalcoords = -40)
3405	parameter (nf_emaxdims = -41)
3406	parameter (nf_enameinuse = -42)
3407	parameter (nf_enotatt = -43)
3408	parameter (nf_emaxatts = -44)
3409	parameter (nf_ebadtype = -45)
3410	parameter (nf_ebaddim = -46)
3411	parameter (nf_eunlimpos = -47)
3412	parameter (nf_emaxvars = -48)
3413	parameter (nf_enotvar = -49)
3414	parameter (nf_eglobal = -50)
3415	parameter (nf_enotnc = -51)
3416	parameter (nf_ests = -52)
3417	parameter (nf_emaxname = -53)
3418	parameter (nf_eunlimit = -54)
3419	parameter (nf_enorecvars = -55)
3420	parameter (nf_echar = -56)
3421	parameter (nf_eedge = -57)
3422	parameter (nf_estride = -58)
3423	parameter (nf_ebadname = -59)
3424	parameter (nf_erange = -60)
3425	parameter (nf_enomem = -61)
3426	parameter (nf_evarsize = -62)
3427	parameter (nf_edimsize = -63)
3428	parameter (nf_etrunc = -64)
3429	!
3430	! error handling modes:
3431	!
3432	integer nf_fatal
3433	integer nf_verbose
3434
3435	parameter (nf_fatal = 1)
3436	parameter (nf_verbose = 2)
3437
3438	!
3439	! miscellaneous routines:
3440	!
3441	character*80 nf_inq_libvers
3442	external nf_inq_libvers
3443
3444	character*80 nf_strerror
3445	! (integer ncerr)
3446	external nf_strerror
3447
3448	logical nf_issyserr
3449	! (integer ncerr)
3450	external nf_issyserr
3451
3452	!
3453	! control routines:
3454	!
3455	integer nf_inq_base_pe
3456	! (integer ncid,
3457	! integer pe)
3458	external nf_inq_base_pe
3459
3460	integer nf_set_base_pe
3461	! (integer ncid,
3462	! integer pe)
3463	external nf_set_base_pe
3464
3465	integer nf_create
3466	! (character() path,
3467	! integer cmode,
3468	! integer ncid)
3469	external nf_create
3470
3471	integer nf__create
3472	! (character() path,
3473	! integer cmode,
3474	! integer initialsz,
3475	! integer chunksizehint,
3476	! integer ncid)
3477	external nf__create
3478
3479	integer nf__create_mp
3480	! (character() path,
3481	! integer cmode,
3482	! integer initialsz,
3483	! integer basepe,
3484	! integer chunksizehint,
3485	! integer ncid)
3486	external nf__create_mp
3487
3488	integer nf_open
3489	! (character() path,
3490	! integer mode,
3491	! integer ncid)
3492	external nf_open
3493
3494	integer nf__open
3495	! (character() path,
3496	! integer mode,
3497	! integer chunksizehint,
3498	! integer ncid)
3499	external nf__open
3500
3501	integer nf__open_mp
3502	! (character() path,
3503	! integer mode,
3504	! integer basepe,
3505	! integer chunksizehint,
3506	! integer ncid)
3507	external nf__open_mp
3508
3509	integer nf_set_fill
3510	! (integer ncid,
3511	! integer fillmode,
3512	! integer old_mode)
3513	external nf_set_fill
3514
3515	integer nf_set_default_format
3516	! (integer format,
3517	! integer old_format)
3518	external nf_set_default_format
3519
3520	integer nf_redef
3521	! (integer ncid)
3522	external nf_redef
3523
3524	integer nf_enddef
3525	! (integer ncid)
3526	external nf_enddef
3527
3528	integer nf__enddef
3529	! (integer ncid,
3530	! integer h_minfree,
3531	! integer v_align,
3532	! integer v_minfree,
3533	! integer r_align)
3534	external nf__enddef
3535
3536	integer nf_sync
3537	! (integer ncid)
3538	external nf_sync
3539
3540	integer nf_abort
3541	! (integer ncid)
3542	external nf_abort
3543
3544	integer nf_close
3545	! (integer ncid)
3546	external nf_close
3547
3548	integer nf_delete
3549	! (character() ncid)
3550	external nf_delete
3551
3552	!
3553	! general inquiry routines:
3554	!
3555
3556	integer nf_inq
3557	! (integer ncid,
3558	! integer ndims,
3559	! integer nvars,
3560	! integer ngatts,
3561	! integer unlimdimid)
3562	external nf_inq
3563
3564	integer nf_inq_ndims
3565	! (integer ncid,
3566	! integer ndims)
3567	external nf_inq_ndims
3568
3569	integer nf_inq_nvars
3570	! (integer ncid,
3571	! integer nvars)
3572	external nf_inq_nvars
3573
3574	integer nf_inq_natts
3575	! (integer ncid,
3576	! integer ngatts)
3577	external nf_inq_natts
3578
3579	integer nf_inq_unlimdim
3580	! (integer ncid,
3581	! integer unlimdimid)
3582	external nf_inq_unlimdim
3583
3584	integer nf_inq_format
3585	! (integer ncid,
3586	! integer format)
3587	external nf_inq_format
3588
3589	!
3590	! dimension routines:
3591	!
3592
3593	integer nf_def_dim
3594	! (integer ncid,
3595	! character(*) name,
3596	! integer len,
3597	! integer dimid)
3598	external nf_def_dim
3599
3600	integer nf_inq_dimid
3601	! (integer ncid,
3602	! character(*) name,
3603	! integer dimid)
3604	external nf_inq_dimid
3605
3606	integer nf_inq_dim
3607	! (integer ncid,
3608	! integer dimid,
3609	! character(*) name,
3610	! integer len)
3611	external nf_inq_dim
3612
3613	integer nf_inq_dimname
3614	! (integer ncid,
3615	! integer dimid,
3616	! character(*) name)
3617	external nf_inq_dimname
3618
3619	integer nf_inq_dimlen
3620	! (integer ncid,
3621	! integer dimid,
3622	! integer len)
3623	external nf_inq_dimlen
3624
3625	integer nf_rename_dim
3626	! (integer ncid,
3627	! integer dimid,
3628	! character(*) name)
3629	external nf_rename_dim
3630
3631	!
3632	! general attribute routines:
3633	!
3634
3635	integer nf_inq_att
3636	! (integer ncid,
3637	! integer varid,
3638	! character(*) name,
3639	! integer xtype,
3640	! integer len)
3641	external nf_inq_att
3642
3643	integer nf_inq_attid
3644	! (integer ncid,
3645	! integer varid,
3646	! character(*) name,
3647	! integer attnum)
3648	external nf_inq_attid
3649
3650	integer nf_inq_atttype
3651	! (integer ncid,
3652	! integer varid,
3653	! character(*) name,
3654	! integer xtype)
3655	external nf_inq_atttype
3656
3657	integer nf_inq_attlen
3658	! (integer ncid,
3659	! integer varid,
3660	! character(*) name,
3661	! integer len)
3662	external nf_inq_attlen
3663
3664	integer nf_inq_attname
3665	! (integer ncid,
3666	! integer varid,
3667	! integer attnum,
3668	! character(*) name)
3669	external nf_inq_attname
3670
3671	integer nf_copy_att
3672	! (integer ncid_in,
3673	! integer varid_in,
3674	! character(*) name,
3675	! integer ncid_out,
3676	! integer varid_out)
3677	external nf_copy_att
3678
3679	integer nf_rename_att
3680	! (integer ncid,
3681	! integer varid,
3682	! character(*) curname,
3683	! character(*) newname)
3684	external nf_rename_att
3685
3686	integer nf_del_att
3687	! (integer ncid,
3688	! integer varid,
3689	! character(*) name)
3690	external nf_del_att
3691
3692	!
3693	! attribute put/get routines:
3694	!
3695
3696	integer nf_put_att_text
3697	! (integer ncid,
3698	! integer varid,
3699	! character(*) name,
3700	! integer len,
3701	! character(*) text)
3702	external nf_put_att_text
3703
3704	integer nf_get_att_text
3705	! (integer ncid,
3706	! integer varid,
3707	! character(*) name,
3708	! character(*) text)
3709	external nf_get_att_text
3710
3711	integer nf_put_att_int1
3712	! (integer ncid,
3713	! integer varid,
3714	! character(*) name,
3715	! integer xtype,
3716	! integer len,
3717	! nf_int1_t i1vals(1))
3718	external nf_put_att_int1
3719
3720	integer nf_get_att_int1
3721	! (integer ncid,
3722	! integer varid,
3723	! character(*) name,
3724	! nf_int1_t i1vals(1))
3725	external nf_get_att_int1
3726
3727	integer nf_put_att_int2
3728	! (integer ncid,
3729	! integer varid,
3730	! character(*) name,
3731	! integer xtype,
3732	! integer len,
3733	! nf_int2_t i2vals(1))
3734	external nf_put_att_int2
3735
3736	integer nf_get_att_int2
3737	! (integer ncid,
3738	! integer varid,
3739	! character(*) name,
3740	! nf_int2_t i2vals(1))
3741	external nf_get_att_int2
3742
3743	integer nf_put_att_int
3744	! (integer ncid,
3745	! integer varid,
3746	! character(*) name,
3747	! integer xtype,
3748	! integer len,
3749	! integer ivals(1))
3750	external nf_put_att_int
3751
3752	integer nf_get_att_int
3753	! (integer ncid,
3754	! integer varid,
3755	! character(*) name,
3756	! integer ivals(1))
3757	external nf_get_att_int
3758
3759	integer nf_put_att_real
3760	! (integer ncid,
3761	! integer varid,
3762	! character(*) name,
3763	! integer xtype,
3764	! integer len,
3765	! real rvals(1))
3766	external nf_put_att_real
3767
3768	integer nf_get_att_real
3769	! (integer ncid,
3770	! integer varid,
3771	! character(*) name,
3772	! real rvals(1))
3773	external nf_get_att_real
3774
3775	integer nf_put_att_double
3776	! (integer ncid,
3777	! integer varid,
3778	! character(*) name,
3779	! integer xtype,
3780	! integer len,
3781	! double dvals(1))
3782	external nf_put_att_double
3783
3784	integer nf_get_att_double
3785	! (integer ncid,
3786	! integer varid,
3787	! character(*) name,
3788	! double dvals(1))
3789	external nf_get_att_double
3790
3791	!
3792	! general variable routines:
3793	!
3794
3795	integer nf_def_var
3796	! (integer ncid,
3797	! character(*) name,
3798	! integer datatype,
3799	! integer ndims,
3800	! integer dimids(1),
3801	! integer varid)
3802	external nf_def_var
3803
3804	integer nf_inq_var
3805	! (integer ncid,
3806	! integer varid,
3807	! character(*) name,
3808	! integer datatype,
3809	! integer ndims,
3810	! integer dimids(1),
3811	! integer natts)
3812	external nf_inq_var
3813
3814	integer nf_inq_varid
3815	! (integer ncid,
3816	! character(*) name,
3817	! integer varid)
3818	external nf_inq_varid
3819
3820	integer nf_inq_varname
3821	! (integer ncid,
3822	! integer varid,
3823	! character(*) name)
3824	external nf_inq_varname
3825
3826	integer nf_inq_vartype
3827	! (integer ncid,
3828	! integer varid,
3829	! integer xtype)
3830	external nf_inq_vartype
3831
3832	integer nf_inq_varndims
3833	! (integer ncid,
3834	! integer varid,
3835	! integer ndims)
3836	external nf_inq_varndims
3837
3838	integer nf_inq_vardimid
3839	! (integer ncid,
3840	! integer varid,
3841	! integer dimids(1))
3842	external nf_inq_vardimid
3843
3844	integer nf_inq_varnatts
3845	! (integer ncid,
3846	! integer varid,
3847	! integer natts)
3848	external nf_inq_varnatts
3849
3850	integer nf_rename_var
3851	! (integer ncid,
3852	! integer varid,
3853	! character(*) name)
3854	external nf_rename_var
3855
3856	integer nf_copy_var
3857	! (integer ncid_in,
3858	! integer varid,
3859	! integer ncid_out)
3860	external nf_copy_var
3861
3862	!
3863	! entire variable put/get routines:
3864	!
3865
3866	integer nf_put_var_text
3867	! (integer ncid,
3868	! integer varid,
3869	! character(*) text)
3870	external nf_put_var_text
3871
3872	integer nf_get_var_text
3873	! (integer ncid,
3874	! integer varid,
3875	! character(*) text)
3876	external nf_get_var_text
3877
3878	integer nf_put_var_int1
3879	! (integer ncid,
3880	! integer varid,
3881	! nf_int1_t i1vals(1))
3882	external nf_put_var_int1
3883
3884	integer nf_get_var_int1
3885	! (integer ncid,
3886	! integer varid,
3887	! nf_int1_t i1vals(1))
3888	external nf_get_var_int1
3889
3890	integer nf_put_var_int2
3891	! (integer ncid,
3892	! integer varid,
3893	! nf_int2_t i2vals(1))
3894	external nf_put_var_int2
3895
3896	integer nf_get_var_int2
3897	! (integer ncid,
3898	! integer varid,
3899	! nf_int2_t i2vals(1))
3900	external nf_get_var_int2
3901
3902	integer nf_put_var_int
3903	! (integer ncid,
3904	! integer varid,
3905	! integer ivals(1))
3906	external nf_put_var_int
3907
3908	integer nf_get_var_int
3909	! (integer ncid,
3910	! integer varid,
3911	! integer ivals(1))
3912	external nf_get_var_int
3913
3914	integer nf_put_var_real
3915	! (integer ncid,
3916	! integer varid,
3917	! real rvals(1))
3918	external nf_put_var_real
3919
3920	integer nf_get_var_real
3921	! (integer ncid,
3922	! integer varid,
3923	! real rvals(1))
3924	external nf_get_var_real
3925
3926	integer nf_put_var_double
3927	! (integer ncid,
3928	! integer varid,
3929	! doubleprecision dvals(1))
3930	external nf_put_var_double
3931
3932	integer nf_get_var_double
3933	! (integer ncid,
3934	! integer varid,
3935	! doubleprecision dvals(1))
3936	external nf_get_var_double
3937
3938	!
3939	! single variable put/get routines:
3940	!
3941
3942	integer nf_put_var1_text
3943	! (integer ncid,
3944	! integer varid,
3945	! integer index(1),
3946	! character*1 text)
3947	external nf_put_var1_text
3948
3949	integer nf_get_var1_text
3950	! (integer ncid,
3951	! integer varid,
3952	! integer index(1),
3953	! character*1 text)
3954	external nf_get_var1_text
3955
3956	integer nf_put_var1_int1
3957	! (integer ncid,
3958	! integer varid,
3959	! integer index(1),
3960	! nf_int1_t i1val)
3961	external nf_put_var1_int1
3962
3963	integer nf_get_var1_int1
3964	! (integer ncid,
3965	! integer varid,
3966	! integer index(1),
3967	! nf_int1_t i1val)
3968	external nf_get_var1_int1
3969
3970	integer nf_put_var1_int2
3971	! (integer ncid,
3972	! integer varid,
3973	! integer index(1),
3974	! nf_int2_t i2val)
3975	external nf_put_var1_int2
3976
3977	integer nf_get_var1_int2
3978	! (integer ncid,
3979	! integer varid,
3980	! integer index(1),
3981	! nf_int2_t i2val)
3982	external nf_get_var1_int2
3983
3984	integer nf_put_var1_int
3985	! (integer ncid,
3986	! integer varid,
3987	! integer index(1),
3988	! integer ival)
3989	external nf_put_var1_int
3990
3991	integer nf_get_var1_int
3992	! (integer ncid,
3993	! integer varid,
3994	! integer index(1),
3995	! integer ival)
3996	external nf_get_var1_int
3997
3998	integer nf_put_var1_real
3999	! (integer ncid,
4000	! integer varid,
4001	! integer index(1),
4002	! real rval)
4003	external nf_put_var1_real
4004
4005	integer nf_get_var1_real
4006	! (integer ncid,
4007	! integer varid,
4008	! integer index(1),
4009	! real rval)
4010	external nf_get_var1_real
4011
4012	integer nf_put_var1_double
4013	! (integer ncid,
4014	! integer varid,
4015	! integer index(1),
4016	! doubleprecision dval)
4017	external nf_put_var1_double
4018
4019	integer nf_get_var1_double
4020	! (integer ncid,
4021	! integer varid,
4022	! integer index(1),
4023	! doubleprecision dval)
4024	external nf_get_var1_double
4025
4026	!
4027	! variable array put/get routines:
4028	!
4029
4030	integer nf_put_vara_text
4031	! (integer ncid,
4032	! integer varid,
4033	! integer start(1),
4034	! integer count(1),
4035	! character(*) text)
4036	external nf_put_vara_text
4037
4038	integer nf_get_vara_text
4039	! (integer ncid,
4040	! integer varid,
4041	! integer start(1),
4042	! integer count(1),
4043	! character(*) text)
4044	external nf_get_vara_text
4045
4046	integer nf_put_vara_int1
4047	! (integer ncid,
4048	! integer varid,
4049	! integer start(1),
4050	! integer count(1),
4051	! nf_int1_t i1vals(1))
4052	external nf_put_vara_int1
4053
4054	integer nf_get_vara_int1
4055	! (integer ncid,
4056	! integer varid,
4057	! integer start(1),
4058	! integer count(1),
4059	! nf_int1_t i1vals(1))
4060	external nf_get_vara_int1
4061
4062	integer nf_put_vara_int2
4063	! (integer ncid,
4064	! integer varid,
4065	! integer start(1),
4066	! integer count(1),
4067	! nf_int2_t i2vals(1))
4068	external nf_put_vara_int2
4069
4070	integer nf_get_vara_int2
4071	! (integer ncid,
4072	! integer varid,
4073	! integer start(1),
4074	! integer count(1),
4075	! nf_int2_t i2vals(1))
4076	external nf_get_vara_int2
4077
4078	integer nf_put_vara_int
4079	! (integer ncid,
4080	! integer varid,
4081	! integer start(1),
4082	! integer count(1),
4083	! integer ivals(1))
4084	external nf_put_vara_int
4085
4086	integer nf_get_vara_int
4087	! (integer ncid,
4088	! integer varid,
4089	! integer start(1),
4090	! integer count(1),
4091	! integer ivals(1))
4092	external nf_get_vara_int
4093
4094	integer nf_put_vara_real
4095	! (integer ncid,
4096	! integer varid,
4097	! integer start(1),
4098	! integer count(1),
4099	! real rvals(1))
4100	external nf_put_vara_real
4101
4102	integer nf_get_vara_real
4103	! (integer ncid,
4104	! integer varid,
4105	! integer start(1),
4106	! integer count(1),
4107	! real rvals(1))
4108	external nf_get_vara_real
4109
4110	integer nf_put_vara_double
4111	! (integer ncid,
4112	! integer varid,
4113	! integer start(1),
4114	! integer count(1),
4115	! doubleprecision dvals(1))
4116	external nf_put_vara_double
4117
4118	integer nf_get_vara_double
4119	! (integer ncid,
4120	! integer varid,
4121	! integer start(1),
4122	! integer count(1),
4123	! doubleprecision dvals(1))
4124	external nf_get_vara_double
4125
4126	!
4127	! strided variable put/get routines:
4128	!
4129
4130	integer nf_put_vars_text
4131	! (integer ncid,
4132	! integer varid,
4133	! integer start(1),
4134	! integer count(1),
4135	! integer stride(1),
4136	! character(*) text)
4137	external nf_put_vars_text
4138
4139	integer nf_get_vars_text
4140	! (integer ncid,
4141	! integer varid,
4142	! integer start(1),
4143	! integer count(1),
4144	! integer stride(1),
4145	! character(*) text)
4146	external nf_get_vars_text
4147
4148	integer nf_put_vars_int1
4149	! (integer ncid,
4150	! integer varid,
4151	! integer start(1),
4152	! integer count(1),
4153	! integer stride(1),
4154	! nf_int1_t i1vals(1))
4155	external nf_put_vars_int1
4156
4157	integer nf_get_vars_int1
4158	! (integer ncid,
4159	! integer varid,
4160	! integer start(1),
4161	! integer count(1),
4162	! integer stride(1),
4163	! nf_int1_t i1vals(1))
4164	external nf_get_vars_int1
4165
4166	integer nf_put_vars_int2
4167	! (integer ncid,
4168	! integer varid,
4169	! integer start(1),
4170	! integer count(1),
4171	! integer stride(1),
4172	! nf_int2_t i2vals(1))
4173	external nf_put_vars_int2
4174
4175	integer nf_get_vars_int2
4176	! (integer ncid,
4177	! integer varid,
4178	! integer start(1),
4179	! integer count(1),
4180	! integer stride(1),
4181	! nf_int2_t i2vals(1))
4182	external nf_get_vars_int2
4183
4184	integer nf_put_vars_int
4185	! (integer ncid,
4186	! integer varid,
4187	! integer start(1),
4188	! integer count(1),
4189	! integer stride(1),
4190	! integer ivals(1))
4191	external nf_put_vars_int
4192
4193	integer nf_get_vars_int
4194	! (integer ncid,
4195	! integer varid,
4196	! integer start(1),
4197	! integer count(1),
4198	! integer stride(1),
4199	! integer ivals(1))
4200	external nf_get_vars_int
4201
4202	integer nf_put_vars_real
4203	! (integer ncid,
4204	! integer varid,
4205	! integer start(1),
4206	! integer count(1),
4207	! integer stride(1),
4208	! real rvals(1))
4209	external nf_put_vars_real
4210
4211	integer nf_get_vars_real
4212	! (integer ncid,
4213	! integer varid,
4214	! integer start(1),
4215	! integer count(1),
4216	! integer stride(1),
4217	! real rvals(1))
4218	external nf_get_vars_real
4219
4220	integer nf_put_vars_double
4221	! (integer ncid,
4222	! integer varid,
4223	! integer start(1),
4224	! integer count(1),
4225	! integer stride(1),
4226	! doubleprecision dvals(1))
4227	external nf_put_vars_double
4228
4229	integer nf_get_vars_double
4230	! (integer ncid,
4231	! integer varid,
4232	! integer start(1),
4233	! integer count(1),
4234	! integer stride(1),
4235	! doubleprecision dvals(1))
4236	external nf_get_vars_double
4237
4238	!
4239	! mapped variable put/get routines:
4240	!
4241
4242	integer nf_put_varm_text
4243	! (integer ncid,
4244	! integer varid,
4245	! integer start(1),
4246	! integer count(1),
4247	! integer stride(1),
4248	! integer imap(1),
4249	! character(*) text)
4250	external nf_put_varm_text
4251
4252	integer nf_get_varm_text
4253	! (integer ncid,
4254	! integer varid,
4255	! integer start(1),
4256	! integer count(1),
4257	! integer stride(1),
4258	! integer imap(1),
4259	! character(*) text)
4260	external nf_get_varm_text
4261
4262	integer nf_put_varm_int1
4263	! (integer ncid,
4264	! integer varid,
4265	! integer start(1),
4266	! integer count(1),
4267	! integer stride(1),
4268	! integer imap(1),
4269	! nf_int1_t i1vals(1))
4270	external nf_put_varm_int1
4271
4272	integer nf_get_varm_int1
4273	! (integer ncid,
4274	! integer varid,
4275	! integer start(1),
4276	! integer count(1),
4277	! integer stride(1),
4278	! integer imap(1),
4279	! nf_int1_t i1vals(1))
4280	external nf_get_varm_int1
4281
4282	integer nf_put_varm_int2
4283	! (integer ncid,
4284	! integer varid,
4285	! integer start(1),
4286	! integer count(1),
4287	! integer stride(1),
4288	! integer imap(1),
4289	! nf_int2_t i2vals(1))
4290	external nf_put_varm_int2
4291
4292	integer nf_get_varm_int2
4293	! (integer ncid,
4294	! integer varid,
4295	! integer start(1),
4296	! integer count(1),
4297	! integer stride(1),
4298	! integer imap(1),
4299	! nf_int2_t i2vals(1))
4300	external nf_get_varm_int2
4301
4302	integer nf_put_varm_int
4303	! (integer ncid,
4304	! integer varid,
4305	! integer start(1),
4306	! integer count(1),
4307	! integer stride(1),
4308	! integer imap(1),
4309	! integer ivals(1))
4310	external nf_put_varm_int
4311
4312	integer nf_get_varm_int
4313	! (integer ncid,
4314	! integer varid,
4315	! integer start(1),
4316	! integer count(1),
4317	! integer stride(1),
4318	! integer imap(1),
4319	! integer ivals(1))
4320	external nf_get_varm_int
4321
4322	integer nf_put_varm_real
4323	! (integer ncid,
4324	! integer varid,
4325	! integer start(1),
4326	! integer count(1),
4327	! integer stride(1),
4328	! integer imap(1),
4329	! real rvals(1))
4330	external nf_put_varm_real
4331
4332	integer nf_get_varm_real
4333	! (integer ncid,
4334	! integer varid,
4335	! integer start(1),
4336	! integer count(1),
4337	! integer stride(1),
4338	! integer imap(1),
4339	! real rvals(1))
4340	external nf_get_varm_real
4341
4342	integer nf_put_varm_double
4343	! (integer ncid,
4344	! integer varid,
4345	! integer start(1),
4346	! integer count(1),
4347	! integer stride(1),
4348	! integer imap(1),
4349	! doubleprecision dvals(1))
4350	external nf_put_varm_double
4351
4352	integer nf_get_varm_double
4353	! (integer ncid,
4354	! integer varid,
4355	! integer start(1),
4356	! integer count(1),
4357	! integer stride(1),
4358	! integer imap(1),
4359	! doubleprecision dvals(1))
4360	external nf_get_varm_double
4361
4362
4363	! NetCDF-2.
4364	!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
4365	! begin netcdf 2.4 backward compatibility:
4366	!
4367
4368	!
4369	! functions in the fortran interface
4370	!
4371	integer nccre
4372	integer ncopn
4373	integer ncddef
4374	integer ncdid
4375	integer ncvdef
4376	integer ncvid
4377	integer nctlen
4378	integer ncsfil
4379
4380	external nccre
4381	external ncopn
4382	external ncddef
4383	external ncdid
4384	external ncvdef
4385	external ncvid
4386	external nctlen
4387	external ncsfil
4388
4389
4390	integer ncrdwr
4391	integer nccreat
4392	integer ncexcl
4393	integer ncindef
4394	integer ncnsync
4395	integer nchsync
4396	integer ncndirty
4397	integer nchdirty
4398	integer nclink
4399	integer ncnowrit
4400	integer ncwrite
4401	integer ncclob
4402	integer ncnoclob
4403	integer ncglobal
4404	integer ncfill
4405	integer ncnofill
4406	integer maxncop
4407	integer maxncdim
4408	integer maxncatt
4409	integer maxncvar
4410	integer maxncnam
4411	integer maxvdims
4412	integer ncnoerr
4413	integer ncebadid
4414	integer ncenfile
4415	integer nceexist
4416	integer nceinval
4417	integer nceperm
4418	integer ncenotin
4419	integer nceindef
4420	integer ncecoord
4421	integer ncemaxds
4422	integer ncename
4423	integer ncenoatt
4424	integer ncemaxat
4425	integer ncebadty
4426	integer ncebadd
4427	integer ncests
4428	integer nceunlim
4429	integer ncemaxvs
4430	integer ncenotvr
4431	integer nceglob
4432	integer ncenotnc
4433	integer ncfoobar
4434	integer ncsyserr
4435	integer ncfatal
4436	integer ncverbos
4437	integer ncentool
4438
4439
4440	!
4441	! netcdf data types:
4442	!
4443	integer ncbyte
4444	integer ncchar
4445	integer ncshort
4446	integer nclong
4447	integer ncfloat
4448	integer ncdouble
4449
4450	parameter(ncbyte = 1)
4451	parameter(ncchar = 2)
4452	parameter(ncshort = 3)
4453	parameter(nclong = 4)
4454	parameter(ncfloat = 5)
4455	parameter(ncdouble = 6)
4456
4457	!
4458	! masks for the struct nc flag field; passed in as 'mode' arg to
4459	! nccreate and ncopen.
4460	!
4461
4462	! read/write, 0 => readonly
4463	parameter(ncrdwr = 1)
4464	! in create phase, cleared by ncendef
4465	parameter(nccreat = 2)
4466	! on create destroy existing file
4467	parameter(ncexcl = 4)
4468	! in define mode, cleared by ncendef
4469	parameter(ncindef = 8)
4470	! synchronise numrecs on change (x'10')
4471	parameter(ncnsync = 16)
4472	! synchronise whole header on change (x'20')
4473	parameter(nchsync = 32)
4474	! numrecs has changed (x'40')
4475	parameter(ncndirty = 64)
4476	! header info has changed (x'80')
4477	parameter(nchdirty = 128)
4478	! prefill vars on endef and increase of record, the default behavior
4479	parameter(ncfill = 0)
4480	! do not fill vars on endef and increase of record (x'100')
4481	parameter(ncnofill = 256)
4482	! isa link (x'8000')
4483	parameter(nclink = 32768)
4484
4485	!
4486	! 'mode' arguments for nccreate and ncopen
4487	!
4488	parameter(ncnowrit = 0)
4489	parameter(ncwrite = ncrdwr)
4490	parameter(ncclob = nf_clobber)
4491	parameter(ncnoclob = nf_noclobber)
4492
4493	!
4494	! 'size' argument to ncdimdef for an unlimited dimension
4495	!
4496	integer ncunlim
4497	parameter(ncunlim = 0)
4498
4499	!
4500	! attribute id to put/get a global attribute
4501	!
4502	parameter(ncglobal = 0)
4503
4504	!
4505	! advisory maximums:
4506	!
4507	parameter(maxncop = 64)
4508	parameter(maxncdim = 1024)
4509	parameter(maxncatt = 8192)
4510	parameter(maxncvar = 8192)
4511	! not enforced
4512	parameter(maxncnam = 256)
4513	parameter(maxvdims = maxncdim)
4514
4515	!
4516	! global netcdf error status variable
4517	! initialized in error.c
4518	!
4519
4520	! no error
4521	parameter(ncnoerr = nf_noerr)
4522	! not a netcdf id
4523	parameter(ncebadid = nf_ebadid)
4524	! too many netcdfs open
4525	parameter(ncenfile = -31) ! nc_syserr
4526	! netcdf file exists && ncnoclob
4527	parameter(nceexist = nf_eexist)
4528	! invalid argument
4529	parameter(nceinval = nf_einval)
4530	! write to read only
4531	parameter(nceperm = nf_eperm)
4532	! operation not allowed in data mode
4533	parameter(ncenotin = nf_enotindefine )
4534	! operation not allowed in define mode
4535	parameter(nceindef = nf_eindefine)
4536	! coordinates out of domain
4537	parameter(ncecoord = nf_einvalcoords)
4538	! maxncdims exceeded
4539	parameter(ncemaxds = nf_emaxdims)
4540	! string match to name in use
4541	parameter(ncename = nf_enameinuse)
4542	! attribute not found
4543	parameter(ncenoatt = nf_enotatt)
4544	! maxncattrs exceeded
4545	parameter(ncemaxat = nf_emaxatts)
4546	! not a netcdf data type
4547	parameter(ncebadty = nf_ebadtype)
4548	! invalid dimension id
4549	parameter(ncebadd = nf_ebaddim)
4550	! ncunlimited in the wrong index
4551	parameter(nceunlim = nf_eunlimpos)
4552	! maxncvars exceeded
4553	parameter(ncemaxvs = nf_emaxvars)
4554	! variable not found
4555	parameter(ncenotvr = nf_enotvar)
4556	! action prohibited on ncglobal varid
4557	parameter(nceglob = nf_eglobal)
4558	! not a netcdf file
4559	parameter(ncenotnc = nf_enotnc)
4560	parameter(ncests = nf_ests)
4561	parameter (ncentool = nf_emaxname)
4562	parameter(ncfoobar = 32)
4563	parameter(ncsyserr = -31)
4564
4565	!
4566	! global options variable. used to determine behavior of error handler.
4567	! initialized in lerror.c
4568	!
4569	parameter(ncfatal = 1)
4570	parameter(ncverbos = 2)
4571
4572	!
4573	! default fill values. these must be the same as in the c interface.
4574	!
4575	integer filbyte
4576	integer filchar
4577	integer filshort
4578	integer fillong
4579	real filfloat
4580	doubleprecision fildoub
4581
4582	parameter (filbyte = -127)
4583	parameter (filchar = 0)
4584	parameter (filshort = -32767)
4585	parameter (fillong = -2147483647)
4586	parameter (filfloat = 9.9692099683868690e+36)
4587	parameter (fildoub = 9.9692099683868690d+36)
4588
4589	! NetCDF-4.
4590	! This is part of netCDF-4. Copyright 2006, UCAR, See COPYRIGHT
4591	! file for distribution information.
4592
4593	! Netcdf version 4 fortran interface.
4594
4595	! $Id: netcdf4.inc,v 1.28 2010/05/25 13:53:02 ed Exp $
4596
4597	! New netCDF-4 types.
4598	integer nf_ubyte
4599	integer nf_ushort
4600	integer nf_uint
4601	integer nf_int64
4602	integer nf_uint64
4603	integer nf_string
4604	integer nf_vlen
4605	integer nf_opaque
4606	integer nf_enum
4607	integer nf_compound
4608
4609	parameter (nf_ubyte = 7)
4610	parameter (nf_ushort = 8)
4611	parameter (nf_uint = 9)
4612	parameter (nf_int64 = 10)
4613	parameter (nf_uint64 = 11)
4614	parameter (nf_string = 12)
4615	parameter (nf_vlen = 13)
4616	parameter (nf_opaque = 14)
4617	parameter (nf_enum = 15)
4618	parameter (nf_compound = 16)
4619
4620	! New netCDF-4 fill values.
4621	integer nf_fill_ubyte
4622	integer nf_fill_ushort
4623	! real nf_fill_uint
4624	! real nf_fill_int64
4625	! real nf_fill_uint64
4626	parameter (nf_fill_ubyte = 255)
4627	parameter (nf_fill_ushort = 65535)
4628
4629	! New constants.
4630	integer nf_format_netcdf4
4631	parameter (nf_format_netcdf4 = 3)
4632
4633	integer nf_format_netcdf4_classic
4634	parameter (nf_format_netcdf4_classic = 4)
4635
4636	integer nf_netcdf4
4637	parameter (nf_netcdf4 = 4096)
4638
4639	integer nf_classic_model
4640	parameter (nf_classic_model = 256)
4641
4642	integer nf_chunk_seq
4643	parameter (nf_chunk_seq = 0)
4644	integer nf_chunk_sub
4645	parameter (nf_chunk_sub = 1)
4646	integer nf_chunk_sizes
4647	parameter (nf_chunk_sizes = 2)
4648
4649	integer nf_endian_native
4650	parameter (nf_endian_native = 0)
4651	integer nf_endian_little
4652	parameter (nf_endian_little = 1)
4653	integer nf_endian_big
4654	parameter (nf_endian_big = 2)
4655
4656	! For NF_DEF_VAR_CHUNKING
4657	integer nf_chunked
4658	parameter (nf_chunked = 0)
4659	integer nf_contiguous
4660	parameter (nf_contiguous = 1)
4661
4662	! For NF_DEF_VAR_FLETCHER32
4663	integer nf_nochecksum
4664	parameter (nf_nochecksum = 0)
4665	integer nf_fletcher32
4666	parameter (nf_fletcher32 = 1)
4667
4668	! For NF_DEF_VAR_DEFLATE
4669	integer nf_noshuffle
4670	parameter (nf_noshuffle = 0)
4671	integer nf_shuffle
4672	parameter (nf_shuffle = 1)
4673
4674	! For NF_DEF_VAR_SZIP
4675	integer nf_szip_ec_option_mask
4676	parameter (nf_szip_ec_option_mask = 4)
4677	integer nf_szip_nn_option_mask
4678	parameter (nf_szip_nn_option_mask = 32)
4679
4680	! For parallel I/O.
4681	integer nf_mpiio
4682	parameter (nf_mpiio = 8192)
4683	integer nf_mpiposix
4684	parameter (nf_mpiposix = 16384)
4685	integer nf_pnetcdf
4686	parameter (nf_pnetcdf = 32768)
4687
4688	! For NF_VAR_PAR_ACCESS.
4689	integer nf_independent
4690	parameter (nf_independent = 0)
4691	integer nf_collective
4692	parameter (nf_collective = 1)
4693
4694	! New error codes.
4695	integer nf_ehdferr ! Error at HDF5 layer.
4696	parameter (nf_ehdferr = -101)
4697	integer nf_ecantread ! Can't read.
4698	parameter (nf_ecantread = -102)
4699	integer nf_ecantwrite ! Can't write.
4700	parameter (nf_ecantwrite = -103)
4701	integer nf_ecantcreate ! Can't create.
4702	parameter (nf_ecantcreate = -104)
4703	integer nf_efilemeta ! Problem with file metadata.
4704	parameter (nf_efilemeta = -105)
4705	integer nf_edimmeta ! Problem with dimension metadata.
4706	parameter (nf_edimmeta = -106)
4707	integer nf_eattmeta ! Problem with attribute metadata.
4708	parameter (nf_eattmeta = -107)
4709	integer nf_evarmeta ! Problem with variable metadata.
4710	parameter (nf_evarmeta = -108)
4711	integer nf_enocompound ! Not a compound type.
4712	parameter (nf_enocompound = -109)
4713	integer nf_eattexists ! Attribute already exists.
4714	parameter (nf_eattexists = -110)
4715	integer nf_enotnc4 ! Attempting netcdf-4 operation on netcdf-3 file.
4716	parameter (nf_enotnc4 = -111)
4717	integer nf_estrictnc3 ! Attempting netcdf-4 operation on strict nc3 netcdf-4 file.
4718	parameter (nf_estrictnc3 = -112)
4719	integer nf_enotnc3 ! Attempting netcdf-3 operation on netcdf-4 file.
4720	parameter (nf_enotnc3 = -113)
4721	integer nf_enopar ! Parallel operation on file opened for non-parallel access.
4722	parameter (nf_enopar = -114)
4723	integer nf_eparinit ! Error initializing for parallel access.
4724	parameter (nf_eparinit = -115)
4725	integer nf_ebadgrpid ! Bad group ID.
4726	parameter (nf_ebadgrpid = -116)
4727	integer nf_ebadtypid ! Bad type ID.
4728	parameter (nf_ebadtypid = -117)
4729	integer nf_etypdefined ! Type has already been defined and may not be edited.
4730	parameter (nf_etypdefined = -118)
4731	integer nf_ebadfield ! Bad field ID.
4732	parameter (nf_ebadfield = -119)
4733	integer nf_ebadclass ! Bad class.
4734	parameter (nf_ebadclass = -120)
4735	integer nf_emaptype ! Mapped access for atomic types only.
4736	parameter (nf_emaptype = -121)
4737	integer nf_elatefill ! Attempt to define fill value when data already exists.
4738	parameter (nf_elatefill = -122)
4739	integer nf_elatedef ! Attempt to define var properties, like deflate, after enddef.
4740	parameter (nf_elatedef = -123)
4741	integer nf_edimscale ! Probem with HDF5 dimscales.
4742	parameter (nf_edimscale = -124)
4743	integer nf_enogrp ! No group found.
4744	parameter (nf_enogrp = -125)
4745
4746
4747	! New functions.
4748
4749	! Parallel I/O.
4750	integer nf_create_par
4751	external nf_create_par
4752
4753	integer nf_open_par
4754	external nf_open_par
4755
4756	integer nf_var_par_access
4757	external nf_var_par_access
4758
4759	! Functions to handle groups.
4760	integer nf_inq_ncid
4761	external nf_inq_ncid
4762
4763	integer nf_inq_grps
4764	external nf_inq_grps
4765
4766	integer nf_inq_grpname
4767	external nf_inq_grpname
4768
4769	integer nf_inq_grpname_full
4770	external nf_inq_grpname_full
4771
4772	integer nf_inq_grpname_len
4773	external nf_inq_grpname_len
4774
4775	integer nf_inq_grp_parent
4776	external nf_inq_grp_parent
4777
4778	integer nf_inq_grp_ncid
4779	external nf_inq_grp_ncid
4780
4781	integer nf_inq_grp_full_ncid
4782	external nf_inq_grp_full_ncid
4783
4784	integer nf_inq_varids
4785	external nf_inq_varids
4786
4787	integer nf_inq_dimids
4788	external nf_inq_dimids
4789
4790	integer nf_def_grp
4791	external nf_def_grp
4792
4793	! New options for netCDF variables.
4794	integer nf_def_var_deflate
4795	external nf_def_var_deflate
4796
4797	integer nf_inq_var_deflate
4798	external nf_inq_var_deflate
4799
4800	integer nf_def_var_fletcher32
4801	external nf_def_var_fletcher32
4802
4803	integer nf_inq_var_fletcher32
4804	external nf_inq_var_fletcher32
4805
4806	integer nf_def_var_chunking
4807	external nf_def_var_chunking
4808
4809	integer nf_inq_var_chunking
4810	external nf_inq_var_chunking
4811
4812	integer nf_def_var_fill
4813	external nf_def_var_fill
4814
4815	integer nf_inq_var_fill
4816	external nf_inq_var_fill
4817
4818	integer nf_def_var_endian
4819	external nf_def_var_endian
4820
4821	integer nf_inq_var_endian
4822	external nf_inq_var_endian
4823
4824	! User defined types.
4825	integer nf_inq_typeids
4826	external nf_inq_typeids
4827
4828	integer nf_inq_typeid
4829	external nf_inq_typeid
4830
4831	integer nf_inq_type
4832	external nf_inq_type
4833
4834	integer nf_inq_user_type
4835	external nf_inq_user_type
4836
4837	! User defined types - compound types.
4838	integer nf_def_compound
4839	external nf_def_compound
4840
4841	integer nf_insert_compound
4842	external nf_insert_compound
4843
4844	integer nf_insert_array_compound
4845	external nf_insert_array_compound
4846
4847	integer nf_inq_compound
4848	external nf_inq_compound
4849
4850	integer nf_inq_compound_name
4851	external nf_inq_compound_name
4852
4853	integer nf_inq_compound_size
4854	external nf_inq_compound_size
4855
4856	integer nf_inq_compound_nfields
4857	external nf_inq_compound_nfields
4858
4859	integer nf_inq_compound_field
4860	external nf_inq_compound_field
4861
4862	integer nf_inq_compound_fieldname
4863	external nf_inq_compound_fieldname
4864
4865	integer nf_inq_compound_fieldindex
4866	external nf_inq_compound_fieldindex
4867
4868	integer nf_inq_compound_fieldoffset
4869	external nf_inq_compound_fieldoffset
4870
4871	integer nf_inq_compound_fieldtype
4872	external nf_inq_compound_fieldtype
4873
4874	integer nf_inq_compound_fieldndims
4875	external nf_inq_compound_fieldndims
4876
4877	integer nf_inq_compound_fielddim_sizes
4878	external nf_inq_compound_fielddim_sizes
4879
4880	! User defined types - variable length arrays.
4881	integer nf_def_vlen
4882	external nf_def_vlen
4883
4884	integer nf_inq_vlen
4885	external nf_inq_vlen
4886
4887	integer nf_free_vlen
4888	external nf_free_vlen
4889
4890	! User defined types - enums.
4891	integer nf_def_enum
4892	external nf_def_enum
4893
4894	integer nf_insert_enum
4895	external nf_insert_enum
4896
4897	integer nf_inq_enum
4898	external nf_inq_enum
4899
4900	integer nf_inq_enum_member
4901	external nf_inq_enum_member
4902
4903	integer nf_inq_enum_ident
4904	external nf_inq_enum_ident
4905
4906	! User defined types - opaque.
4907	integer nf_def_opaque
4908	external nf_def_opaque
4909
4910	integer nf_inq_opaque
4911	external nf_inq_opaque
4912
4913	! Write and read attributes of any type, including user defined
4914	! types.
4915	integer nf_put_att
4916	external nf_put_att
4917	integer nf_get_att
4918	external nf_get_att
4919
4920	! Write and read variables of any type, including user defined
4921	! types.
4922	integer nf_put_var
4923	external nf_put_var
4924	integer nf_put_var1
4925	external nf_put_var1
4926	integer nf_put_vara
4927	external nf_put_vara
4928	integer nf_put_vars
4929	external nf_put_vars
4930	integer nf_get_var
4931	external nf_get_var
4932	integer nf_get_var1
4933	external nf_get_var1
4934	integer nf_get_vara
4935	external nf_get_vara
4936	integer nf_get_vars
4937	external nf_get_vars
4938
4939	! 64-bit int functions.
4940	integer nf_put_var1_int64
4941	external nf_put_var1_int64
4942	integer nf_put_vara_int64
4943	external nf_put_vara_int64
4944	integer nf_put_vars_int64
4945	external nf_put_vars_int64
4946	integer nf_put_varm_int64
4947	external nf_put_varm_int64
4948	integer nf_put_var_int64
4949	external nf_put_var_int64
4950	integer nf_get_var1_int64
4951	external nf_get_var1_int64
4952	integer nf_get_vara_int64
4953	external nf_get_vara_int64
4954	integer nf_get_vars_int64
4955	external nf_get_vars_int64
4956	integer nf_get_varm_int64
4957	external nf_get_varm_int64
4958	integer nf_get_var_int64
4959	external nf_get_var_int64
4960
4961	! For helping F77 users with VLENs.
4962	integer nf_get_vlen_element
4963	external nf_get_vlen_element
4964	integer nf_put_vlen_element
4965	external nf_put_vlen_element
4966
4967	! For dealing with file level chunk cache.
4968	integer nf_set_chunk_cache
4969	external nf_set_chunk_cache
4970	integer nf_get_chunk_cache
4971	external nf_get_chunk_cache
4972
4973	! For dealing with per variable chunk cache.
4974	integer nf_set_var_chunk_cache
4975	external nf_set_var_chunk_cache
4976	integer nf_get_var_chunk_cache
4977	external nf_get_var_chunk_cache
4978	!-----------------------------------------------------------------------
4979	! INCLUDE 'dimensions.h'
4980	!
4981	! dimensions.h contient les dimensions du modele
4982	! ndm est tel que iim=2**ndm
4983	!-----------------------------------------------------------------------
4984
4985	INTEGER iim,jjm,llm,ndm
4986
4987	PARAMETER (iim= 128,jjm=96,llm=64,ndm=1)
4988
4989	!-----------------------------------------------------------------------
4990	!
4991	! $Header$
4992	!
4993	!
4994	! ATTENTION!!!!: ce fichier include est compatible format fixe/format libre
4995	! veillez n'utiliser que des ! pour les commentaires
4996	! et bien positionner les & des lignes de continuation
4997	! (les placer en colonne 6 et en colonne 73)
4998	!
4999	!
5000	!-----------------------------------------------------------------------
5001	! INCLUDE 'paramet.h'
5002
5003	INTEGER iip1,iip2,iip3,jjp1,llmp1,llmp2,llmm1
5004	INTEGER kftd,ip1jm,ip1jmp1,ip1jmi1,ijp1llm
5005	INTEGER ijmllm,mvar
5006	INTEGER jcfil,jcfllm
5007
5008	PARAMETER( iip1= iim+1,iip2=iim+2,iip3=iim+3 &
5009	& ,jjp1=jjm+1-1/jjm)
5010	PARAMETER( llmp1 = llm+1, llmp2 = llm+2, llmm1 = llm-1 )
5011	PARAMETER( kftd = iim/2 -ndm )
5012	PARAMETER( ip1jm = iip1jjm, ip1jmp1= iip1jjp1 )
5013	PARAMETER( ip1jmi1= ip1jm - iip1 )
5014	PARAMETER( ijp1llm= ip1jmp1 * llm, ijmllm= ip1jm * llm )
5015	PARAMETER( mvar= ip1jmp1( 2llm+1) + ijmllm )
5016	PARAMETER( jcfil=jjm/2+5, jcfllm=jcfil*llm )
5017
5018	!-----------------------------------------------------------------------
5019
5020	INTEGER, INTENT(IN) :: timestep
5021
5022	LOGICAL, SAVE :: first=.TRUE.
5023	! Identification fichiers et variables NetCDF:
5024	INTEGER, SAVE :: ncidu,varidu,ncidv,varidv,ncidp,varidp
5025	INTEGER, SAVE :: ncidQ,varidQ,ncidt,varidt,ncidps,varidps
5026	INTEGER :: ncidpl,varidpl,varidap,varidbp
5027	! Variables auxiliaires NetCDF:
5028	INTEGER, DIMENSION(4) :: start,count
5029	INTEGER :: status,rcode
5030	! Variables for 3D extension:
5031	REAL, DIMENSION (jjp1,llm) :: zu
5032	REAL, DIMENSION (jjm,llm) :: zv
5033	INTEGER :: i
5034
5035	CHARACTER (len = 80) :: abort_message
5036	CHARACTER (len = 20) :: modname = 'guide_read2D'
5037	! -----------------------------------------------------------------
5038	! Premier appel: initialisation de la lecture des fichiers
5039	! -----------------------------------------------------------------
5040	if (first) then
5041	ncidpl=-99
5042	print*,'Guide: ouverture des fichiers guidage '
5043	! Ap et Bp si niveaux de pression hybrides
5044	if (guide_plevs.EQ.1) then
5045	print *,'Lecture du guidage sur niveaux modÃ¯Â¿Âœle'
5046	rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
5047	IF (rcode.NE.NF_NOERR) THEN
5048	print *,'Guide: probleme -> pas de fichier apbp.nc'
5049	CALL abort_gcm(modname,abort_message,1)
5050	ENDIF
5051	rcode = nf90_inq_varid(ncidpl, 'AP', varidap)
5052	IF (rcode.NE.NF_NOERR) THEN
5053	print *,'Guide: probleme -> pas de variable AP, fichier apbp.nc'
5054	CALL abort_gcm(modname,abort_message,1)
5055	ENDIF
5056	rcode = nf90_inq_varid(ncidpl, 'BP', varidbp)
5057	IF (rcode.NE.NF_NOERR) THEN
5058	print *,'Guide: probleme -> pas de variable BP, fichier apbp.nc'
5059	CALL abort_gcm(modname,abort_message,1)
5060	ENDIF
5061	print*,'ncidpl,varidap',ncidpl,varidap
5062	endif
5063	! Pression
5064	if (guide_plevs.EQ.2) then
5065	rcode = nf90_open('P.nc', nf90_nowrite, ncidp)
5066	IF (rcode.NE.NF_NOERR) THEN
5067	print *,'Guide: probleme -> pas de fichier P.nc'
5068	CALL abort_gcm(modname,abort_message,1)
5069	ENDIF
5070	rcode = nf90_inq_varid(ncidp, 'PRES', varidp)
5071	IF (rcode.NE.NF_NOERR) THEN
5072	print *,'Guide: probleme -> pas de variable PRES, fichier P.nc'
5073	CALL abort_gcm(modname,abort_message,1)
5074	ENDIF
5075	print*,'ncidp,varidp',ncidp,varidp
5076	if (ncidpl.eq.-99) ncidpl=ncidp
5077	endif
5078	! Vent zonal
5079	if (guide_u) then
5080	rcode = nf90_open('u.nc', nf90_nowrite, ncidu)
5081	IF (rcode.NE.NF_NOERR) THEN
5082	print *,'Guide: probleme -> pas de fichier u.nc'
5083	CALL abort_gcm(modname,abort_message,1)
5084	ENDIF
5085	rcode = nf90_inq_varid(ncidu, 'UWND', varidu)
5086	IF (rcode.NE.NF_NOERR) THEN
5087	print *,'Guide: probleme -> pas de variable UWND, fichier u.nc'
5088	CALL abort_gcm(modname,abort_message,1)
5089	ENDIF
5090	print*,'ncidu,varidu',ncidu,varidu
5091	if (ncidpl.eq.-99) ncidpl=ncidu
5092	endif
5093	! Vent meridien
5094	if (guide_v) then
5095	rcode = nf90_open('v.nc', nf90_nowrite, ncidv)
5096	IF (rcode.NE.NF_NOERR) THEN
5097	print *,'Guide: probleme -> pas de fichier v.nc'
5098	CALL abort_gcm(modname,abort_message,1)
5099	ENDIF
5100	rcode = nf90_inq_varid(ncidv, 'VWND', varidv)
5101	IF (rcode.NE.NF_NOERR) THEN
5102	print *,'Guide: probleme -> pas de variable VWND, fichier v.nc'
5103	CALL abort_gcm(modname,abort_message,1)
5104	ENDIF
5105	print*,'ncidv,varidv',ncidv,varidv
5106	if (ncidpl.eq.-99) ncidpl=ncidv
5107	endif
5108	! Temperature
5109	if (guide_T) then
5110	rcode = nf90_open('T.nc', nf90_nowrite, ncidt)
5111	IF (rcode.NE.NF_NOERR) THEN
5112	print *,'Guide: probleme -> pas de fichier T.nc'
5113	CALL abort_gcm(modname,abort_message,1)
5114	ENDIF
5115	rcode = nf90_inq_varid(ncidt, 'AIR', varidt)
5116	IF (rcode.NE.NF_NOERR) THEN
5117	print *,'Guide: probleme -> pas de variable AIR, fichier T.nc'
5118	CALL abort_gcm(modname,abort_message,1)
5119	ENDIF
5120	print*,'ncidT,varidT',ncidt,varidt
5121	if (ncidpl.eq.-99) ncidpl=ncidt
5122	endif
5123	! Humidite
5124	if (guide_Q) then
5125	rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ)
5126	IF (rcode.NE.NF_NOERR) THEN
5127	print *,'Guide: probleme -> pas de fichier hur.nc'
5128	CALL abort_gcm(modname,abort_message,1)
5129	ENDIF
5130	rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)
5131	IF (rcode.NE.NF_NOERR) THEN
5132	print *,'Guide: probleme -> pas de variable RH, fichier hur.nc'
5133	CALL abort_gcm(modname,abort_message,1)
5134	ENDIF
5135	print*,'ncidQ,varidQ',ncidQ,varidQ
5136	if (ncidpl.eq.-99) ncidpl=ncidQ
5137	endif
5138	! Pression de surface
5139	if ((guide_P).OR.(guide_plevs.EQ.1)) then
5140	rcode = nf90_open('ps.nc', nf90_nowrite, ncidps)
5141	IF (rcode.NE.NF_NOERR) THEN
5142	print *,'Guide: probleme -> pas de fichier ps.nc'
5143	CALL abort_gcm(modname,abort_message,1)
5144	ENDIF
5145	rcode = nf90_inq_varid(ncidps, 'SP', varidps)
5146	IF (rcode.NE.NF_NOERR) THEN
5147	print *,'Guide: probleme -> pas de variable SP, fichier ps.nc'
5148	CALL abort_gcm(modname,abort_message,1)
5149	ENDIF
5150	print*,'ncidps,varidps',ncidps,varidps
5151	endif
5152	! Coordonnee verticale
5153	if (guide_plevs.EQ.0) then
5154	rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
5155	IF (rcode.NE.0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
5156	print*,'ncidpl,varidpl',ncidpl,varidpl
5157	endif
5158	! Coefs ap, bp pour calcul de la pression aux differents niveaux
5159	if (guide_plevs.EQ.1) then
5160	status=NF_GET_VARA_DOUBLE(ncidpl,varidap,1,nlevnc,apnc)
5161	status=NF_GET_VARA_DOUBLE(ncidpl,varidbp,1,nlevnc,bpnc)
5162	elseif (guide_plevs.EQ.0) THEN
5163	status=NF_GET_VARA_DOUBLE(ncidpl,varidpl,1,nlevnc,apnc)
5164	apnc=apnc*100.! conversion en Pascals
5165	bpnc(:)=0.
5166	endif
5167	first=.FALSE.
5168	endif ! (first)
5169
5170	! -----------------------------------------------------------------
5171	! lecture des champs u, v, T, Q, ps
5172	! -----------------------------------------------------------------
5173
5174	! dimensions pour les champs scalaires et le vent zonal
5175	start(1)=1
5176	start(2)=1
5177	start(3)=1
5178	start(4)=timestep
5179
5180	count(1)=1
5181	count(2)=jjp1
5182	count(3)=nlevnc
5183	count(4)=1
5184
5185	! Pression
5186	if (guide_plevs.EQ.2) then
5187	status=NF_GET_VARA_DOUBLE(ncidp,varidp,start,count,zu)
5188	DO i=1,iip1
5189	pnat2(i,:,:)=zu(:,:)
5190	ENDDO
5191
5192	IF (invert_y) THEN
5193	CALL invert_lat(iip1,jjp1,nlevnc,pnat2)
5194	ENDIF
5195	endif
5196	! Vent zonal
5197	if (guide_u) then
5198	status=NF_GET_VARA_DOUBLE(ncidu,varidu,start,count,zu)
5199	DO i=1,iip1
5200	unat2(i,:,:)=zu(:,:)
5201	ENDDO
5202
5203	IF (invert_y) THEN
5204	CALL invert_lat(iip1,jjp1,nlevnc,unat2)
5205	ENDIF
5206	endif
5207
5208	! Temperature
5209	if (guide_T) then
5210	status=NF_GET_VARA_DOUBLE(ncidt,varidt,start,count,zu)
5211	DO i=1,iip1
5212	tnat2(i,:,:)=zu(:,:)
5213	ENDDO
5214
5215	IF (invert_y) THEN
5216	CALL invert_lat(iip1,jjp1,nlevnc,tnat2)
5217	ENDIF
5218	endif
5219
5220	! Humidite
5221	if (guide_Q) then
5222	status=NF_GET_VARA_DOUBLE(ncidQ,varidQ,start,count,zu)
5223	DO i=1,iip1
5224	qnat2(i,:,:)=zu(:,:)
5225	ENDDO
5226
5227	IF (invert_y) THEN
5228	CALL invert_lat(iip1,jjp1,nlevnc,qnat2)
5229	ENDIF
5230	endif
5231
5232	! Vent meridien
5233	if (guide_v) then
5234	count(2)=jjm
5235	status=NF_GET_VARA_DOUBLE(ncidv,varidv,start,count,zv)
5236	DO i=1,iip1
5237	vnat2(i,:,:)=zv(:,:)
5238	ENDDO
5239
5240	IF (invert_y) THEN
5241	CALL invert_lat(iip1,jjm,nlevnc,vnat2)
5242	ENDIF
5243	endif
5244
5245	! Pression de surface
5246	if ((guide_P).OR.(guide_plevs.EQ.1)) then
5247	start(3)=timestep
5248	start(4)=0
5249	count(2)=jjp1
5250	count(3)=1
5251	count(4)=0
5252	status=NF_GET_VARA_DOUBLE(ncidps,varidps,start,count,zu(:,1))
5253	DO i=1,iip1
5254	psnat2(i,:)=zu(:,1)
5255	ENDDO
5256
5257	IF (invert_y) THEN
5258	CALL invert_lat(iip1,jjp1,1,psnat2)
5259	ENDIF
5260	endif
5261
5262	END SUBROUTINE guide_read2D
5263
5264	!=======================================================================
5265	SUBROUTINE guide_out(varname,hsize,vsize,field,factt)
5266	USE parallel_lmdz
5267	IMPLICIT NONE
5268
5269	INCLUDE "dimensions.h"
5270	INCLUDE "paramet.h"
5271	INCLUDE "netcdf.inc"
5272	INCLUDE "comgeom2.h"
5273	INCLUDE "comconst.h"
5274	INCLUDE "comvert.h"
5275
5276	! Variables entree
5277	CHARACTER(), INTENT(IN) :: varname
5278	INTEGER, INTENT (IN) :: hsize,vsize
5279	REAL, DIMENSION (iip1,hsize,vsize), INTENT(IN) :: field
5280	REAL, INTENT (IN) :: factt
5281
5282	! Variables locales
5283	INTEGER, SAVE :: timestep=0
5284	! Identites fichier netcdf
5285	INTEGER :: nid, id_lonu, id_lonv, id_latu, id_latv, id_tim, id_lev
5286	INTEGER :: vid_lonu,vid_lonv,vid_latu,vid_latv,vid_cu,vid_cv,vid_lev
5287	INTEGER :: vid_au,vid_av
5288	INTEGER :: l
5289	INTEGER, DIMENSION (3) :: dim3
5290	INTEGER, DIMENSION (4) :: dim4,count,start
5291	INTEGER :: ierr, varid
5292	REAL, DIMENSION (iip1,hsize,vsize) :: field2
5293
5294	CALL gather_field(field,iip1*hsize,vsize,0)
5295
5296	IF (mpi_rank /= 0) RETURN
5297
5298	print *,'Guide: output timestep',timestep,'var ',varname
5299	IF (timestep.EQ.0) THEN
5300	! ----------------------------------------------
5301	! initialisation fichier de sortie
5302	! ----------------------------------------------
5303	! Ouverture du fichier
5304	ierr=NF_CREATE("guide_ins.nc",NF_CLOBBER,nid)
5305	! Definition des dimensions
5306	ierr=NF_DEF_DIM(nid,"LONU",iip1,id_lonu)
5307	print*,'id_lonu 1 ',id_lonu
5308	ierr=NF_DEF_DIM(nid,"LONV",iip1,id_lonv)
5309	ierr=NF_DEF_DIM(nid,"LATU",jjp1,id_latu)
5310	ierr=NF_DEF_DIM(nid,"LATV",jjm,id_latv)
5311	ierr=NF_DEF_DIM(nid,"LEVEL",llm,id_lev)
5312	ierr=NF_DEF_DIM(nid,"TIME",NF_UNLIMITED,id_tim)
5313
5314	! Creation des variables dimensions
5315	ierr=NF_DEF_VAR(nid,"LONU",NF_FLOAT,1,id_lonu,vid_lonu)
5316	print*,'id_lonu 2 ',id_lonu
5317	ierr=NF_DEF_VAR(nid,"LONV",NF_FLOAT,1,id_lonv,vid_lonv)
5318	ierr=NF_DEF_VAR(nid,"LATU",NF_FLOAT,1,id_latu,vid_latu)
5319	ierr=NF_DEF_VAR(nid,"LATV",NF_FLOAT,1,id_latv,vid_latv)
5320	ierr=NF_DEF_VAR(nid,"LEVEL",NF_FLOAT,1,id_lev,vid_lev)
5321	ierr=NF_DEF_VAR(nid,"cu",NF_FLOAT,2,(/id_lonu,id_latu/),vid_cu)
5322	ierr=NF_DEF_VAR(nid,"cv",NF_FLOAT,2,(/id_lonv,id_latv/),vid_cv)
5323	ierr=NF_DEF_VAR(nid,"au",NF_FLOAT,2,(/id_lonu,id_latu/),vid_au)
5324	ierr=NF_DEF_VAR(nid,"av",NF_FLOAT,2,(/id_lonv,id_latv/),vid_av)
5325
5326	ierr=NF_ENDDEF(nid)
5327
5328	! Enregistrement des variables dimensions
5329	print,'id_lonu DOUBLE ',id_lonu,rlonu180./pi
5330	ierr = NF_PUT_VAR_DOUBLE(nid,vid_lonu,rlonu*180./pi)
5331	ierr = NF_PUT_VAR_DOUBLE(nid,vid_lonv,rlonv*180./pi)
5332	ierr = NF_PUT_VAR_DOUBLE(nid,vid_latu,rlatu*180./pi)
5333	ierr = NF_PUT_VAR_DOUBLE(nid,vid_latv,rlatv*180./pi)
5334	ierr = NF_PUT_VAR_DOUBLE(nid,vid_lev,presnivs)
5335	ierr = NF_PUT_VAR_DOUBLE(nid,vid_cu,cu)
5336	ierr = NF_PUT_VAR_DOUBLE(nid,vid_cv,cv)
5337	ierr = NF_PUT_VAR_DOUBLE(nid,vid_au,alpha_u)
5338	ierr = NF_PUT_VAR_DOUBLE(nid,vid_av,alpha_v)
5339	! --------------------------------------------------------------------
5340	! CrÃ¯Â¿Âœation des variables sauvegardÃ¯Â¿Âœes
5341	! --------------------------------------------------------------------
5342	ierr = NF_REDEF(nid)
5343	! Pressure (GCM)
5344	dim4=(/id_lonv,id_latu,id_lev,id_tim/)
5345	ierr = NF_DEF_VAR(nid,"SP",NF_FLOAT,4,dim4,varid)
5346	! Surface pressure (guidage)
5347	IF (guide_P) THEN
5348	dim3=(/id_lonv,id_latu,id_tim/)
5349	ierr = NF_DEF_VAR(nid,"ps",NF_FLOAT,3,dim3,varid)
5350	ENDIF
5351	! Zonal wind
5352	IF (guide_u) THEN
5353	print*,'id_lonu 4 ',id_lonu,varname
5354	dim4=(/id_lonu,id_latu,id_lev,id_tim/)
5355	ierr = NF_DEF_VAR(nid,"u",NF_FLOAT,4,dim4,varid)
5356	ierr = NF_DEF_VAR(nid,"ua",NF_FLOAT,4,dim4,varid)
5357	ierr = NF_DEF_VAR(nid,"ucov",NF_FLOAT,4,dim4,varid)
5358	ENDIF
5359	! Merid. wind
5360	IF (guide_v) THEN
5361	dim4=(/id_lonv,id_latv,id_lev,id_tim/)
5362	ierr = NF_DEF_VAR(nid,"v",NF_FLOAT,4,dim4,varid)
5363	ierr = NF_DEF_VAR(nid,"va",NF_FLOAT,4,dim4,varid)
5364	ierr = NF_DEF_VAR(nid,"vcov",NF_FLOAT,4,dim4,varid)
5365	ENDIF
5366	! Pot. Temperature
5367	IF (guide_T) THEN
5368	dim4=(/id_lonv,id_latu,id_lev,id_tim/)
5369	ierr = NF_DEF_VAR(nid,"teta",NF_FLOAT,4,dim4,varid)
5370	ENDIF
5371	! Specific Humidity
5372	IF (guide_Q) THEN
5373	dim4=(/id_lonv,id_latu,id_lev,id_tim/)
5374	ierr = NF_DEF_VAR(nid,"q",NF_FLOAT,4,dim4,varid)
5375	ENDIF
5376
5377	ierr = NF_ENDDEF(nid)
5378	ierr = NF_CLOSE(nid)
5379	ENDIF ! timestep=0
5380
5381	! --------------------------------------------------------------------
5382	! Enregistrement du champ
5383	! --------------------------------------------------------------------
5384
5385	ierr=NF_OPEN("guide_ins.nc",NF_WRITE,nid)
5386
5387	IF (varname=="SP") timestep=timestep+1
5388
5389	IF (varname=="SP") THEN
5390	print*,'varname=SP=',varname
5391	ELSE
5392	print*,'varname diff SP=',varname
5393	ENDIF
5394
5395
5396	ierr = NF_INQ_VARID(nid,varname,varid)
5397	SELECT CASE (varname)
5398	CASE ("SP","ps")
5399	start=(/1,1,1,timestep/)
5400	count=(/iip1,jjp1,llm,1/)
5401	CASE ("v","va","vcov")
5402	start=(/1,1,1,timestep/)
5403	count=(/iip1,jjm,llm,1/)
5404	CASE DEFAULT
5405	start=(/1,1,1,timestep/)
5406	count=(/iip1,jjp1,llm,1/)
5407	END SELECT
5408
5409	SELECT CASE (varname)
5410	CASE("u","ua")
5411	DO l=1,llm ; field2(:,2:jjm,l)=field(:,2:jjm,l)/cu(:,2:jjm) ; ENDDO
5412	field2(:,1,:)=0. ; field2(:,jjp1,:)=0.
5413	CASE("v","va")
5414	DO l=1,llm ; field2(:,:,l)=field(:,:,l)/cv(:,:) ; ENDDO
5415	CASE DEFAULT
5416	field2=field
5417	END SELECT
5418
5419	ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field2)
5420
5421	ierr = NF_CLOSE(nid)
5422
5423	END SUBROUTINE guide_out
5424
5425
5426	!===========================================================================
5427	subroutine correctbid(iim,nl,x)
5428	integer iim,nl
5429	real x(iim+1,nl)
5430	integer i,l
5431	real zz
5432
5433	do l=1,nl
5434	do i=2,iim-1
5435	if(abs(x(i,l)).gt.1.e10) then
5436	zz=0.5*(x(i-1,l)+x(i+1,l))
5437	print*,'correction ',i,l,x(i,l),zz
5438	x(i,l)=zz
5439	endif
5440	enddo
5441	enddo
5442	return
5443	end subroutine correctbid
5444
5445	!===========================================================================
5446	END MODULE guide_p_mod
5447

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

Download in other formats: