Context Navigation

limit_netcdf.F @ 351

Last change on this file since 351 was 327, checked in by lmdzadmin, 23 years ago
Probleme sur la dimension de phy_ice entre la version Levan et la version couplee LF
Property svn:eol-style set to `native` Property svn:executable set to ``* Property svn:keywords set to `Author Date Id Revision`
File size: 34.4 KB

Line
1	C
2	C $Header$
3	C
4	SUBROUTINE limit_netcdf(interbar, extrap, oldice, masque, pctsrf)
5	c
6	IMPLICIT none
7	c
8	c-------------------------------------------------------------
9	C Author : L. Fairhead
10	C Date : 27/01/94
11	C Objet : Construction des fichiers de conditions aux limites
12	C pour le nouveau
13	C modele a partir de fichiers de climatologie. Les deux
14	C grilles doivent etre regulieres
15	c
16	c Modifie par z.x.li (le23mars1994)
17	c Modifie par L. Fairhead (fairhead@lmd.jussieu.fr) septembre 1999
18	c pour lecture netcdf dans LMDZ.3.3
19	c Modifie par P;Le Van , juillet 2001
20	c-------------------------------------------------------------
21	c
22	#include "dimensions.h"
23	#include "paramet.h"
24	#include "control.h"
25	#include "logic.h"
26	#include "netcdf.inc"
27	#include "comvert.h"
28	#include "comgeom2.h"
29	#include "comconst.h"
30	#include "dimphy.h"
31	#include "indicesol.h"
32	c
33	c-----------------------------------------------------------------------
34	LOGICAL interbar, extrap, oldice
35
36	REAL phy_nat(klon,360), phy_nat0(klon)
37	REAL phy_alb(klon,360)
38	REAL phy_sst(klon,360)
39	REAL phy_bil(klon,360)
40	REAL phy_rug(klon,360)
41	REAL phy_ice(klon)
42	c
43	real pctsrf_t(klon,nbsrf,360)
44	real pctsrf(klon,nbsrf)
45	REAL verif
46
47	REAL masque(iip1,jjp1)
48	REAL mask(iim,jjp1)
49	CPB
50	C newlmt indique l'utilisation de la sous-maille fractionnelle
51	C tandis que l'ancien codage utilise l'indicateur du sol (0,1,2,3)
52	LOGICAL newlmt, fracterre
53	PARAMETER(newlmt=.TRUE.)
54	PARAMETER(fracterre = .TRUE.)
55
56	C Declarations pour le champ de depart
57	INTEGER imdep, jmdep,lmdep
58	INTEGER tbid
59	PARAMETER ( tbid = 60 ) ! >52 semaines
60	REAL timecoord(tbid)
61	c
62	REAL , ALLOCATABLE :: dlon_msk(:), dlat_msk(:)
63	REAL , ALLOCATABLE :: lonmsk_ini(:), latmsk_ini(:)
64	REAL , ALLOCATABLE :: dlon(:), dlat(:)
65	REAL , ALLOCATABLE :: dlon_ini(:), dlat_ini(:)
66	REAL , ALLOCATABLE :: champ_msk(:), champ(:)
67	REAL , ALLOCATABLE :: work(:,:)
68
69	CHARACTER*25 title
70
71	C Declarations pour le champ interpole 2D
72	REAL champint(iim,jjp1)
73	real chmin,chmax
74
75	C Declarations pour le champ interpole 3D
76	REAL champtime(iim,jjp1,tbid)
77	REAL timeyear(tbid)
78	REAL champan(iip1,jjp1,366)
79
80	C Declarations pour l'inteprolation verticale
81	REAL ax(tbid), ay(tbid)
82	REAL by
83	REAL yder(tbid)
84
85
86	INTEGER ierr
87	INTEGER dimfirst(3)
88	INTEGER dimlast(3)
89	c
90	INTEGER nid, ndim, ntim
91	INTEGER dims(2), debut(2), epais(2)
92	INTEGER id_tim
93	INTEGER id_NAT, id_SST, id_BILS, id_RUG, id_ALB
94	CPB
95	INTEGER id_FOCE, id_FSIC, id_FTER, id_FLIC
96
97	INTEGER i, j, k, l, ji
98	c declarations pour lecture glace de mer
99	INTEGER :: iml_lic, jml_lic, llm_tmp, ttm_tmp, iret
100	INTEGER :: itaul(1), fid
101	REAL :: lev(1), date, dt
102	REAL, ALLOCATABLE, DIMENSION(:,:) :: lon_lic, lat_lic
103	REAL, ALLOCATABLE, DIMENSION(:) :: dlon_lic, dlat_lic
104	REAL, ALLOCATABLE, DIMENSION (:,:) :: fraclic
105	REAL :: flic_tmp(iip1, jjp1)
106
107	c Diverses variables locales
108	REAL time
109	! pour la lecture du fichier masque ocean
110	integer :: nid_o2a
111	logical :: couple = .false.
112	INTEGER :: iml_omask, jml_omask
113	REAL, ALLOCATABLE, DIMENSION(:,:) :: lon_omask, lat_omask
114	REAL, ALLOCATABLE, DIMENSION(:) :: dlon_omask, dlat_omask
115	REAL, ALLOCATABLE, DIMENSION (:,:) :: ocemask, ocetmp
116	real, dimension(klon) :: ocemask_fi
117
118	INTEGER longcles
119	PARAMETER ( longcles = 20 )
120	REAL clesphy0 ( longcles )
121	#include "serre.h"
122	INTEGER ncid,varid,ndimid(4),dimid
123	character*30 namedim
124	CHARACTER*80 :: varname
125
126	c initialisations:
127	CALL conf_gcm( 99, .TRUE. , clesphy0 )
128
129
130	pi = 4. * ATAN(1.)
131	rad = 6 371 229.
132	omeg = 4.* ASIN(1.)/(24.*3600.)
133	g = 9.8
134	daysec = 86400.
135	kappa = 0.2857143
136	cpp = 1004.70885
137	dtvr = daysec/FLOAT(day_step)
138	CALL inigeom
139	c
140	C Traitement du relief au sol
141	c
142	write(,) 'Traitement du relief au sol pour fabriquer masque'
143	ierr = NF_OPEN('Relief.nc', NF_NOWRITE, ncid)
144
145	if (ierr.ne.0) then
146	print *, NF_STRERROR(ierr)
147	STOP
148	ENDIF
149
150	ierr = NF_INQ_VARID(ncid,'RELIEF',varid)
151	if (ierr.ne.0) then
152	print *, NF_STRERROR(ierr)
153	STOP
154	ENDIF
155	ierr = NF_INQ_VARDIMID (ncid,varid,ndimid)
156	if (ierr.ne.0) then
157	print *, NF_STRERROR(ierr)
158	STOP
159	ENDIF
160	ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep)
161	if (ierr.ne.0) then
162	print *, NF_STRERROR(ierr)
163	STOP
164	ENDIF
165	print*,'variable ', namedim, 'dimension ', imdep
166	ierr = NF_INQ_VARID(ncid,namedim,dimid)
167	if (ierr.ne.0) then
168	print *, NF_STRERROR(ierr)
169	STOP
170	ENDIF
171
172	ALLOCATE( lonmsk_ini(imdep) )
173	ALLOCATE( dlon_msk(imdep) )
174
175	#ifdef NC_DOUBLE
176	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,lonmsk_ini)
177	#else
178	ierr = NF_GET_VAR_REAL(ncid,dimid,lonmsk_ini)
179	#endif
180
181	c
182	if (ierr.ne.0) then
183	print *, NF_STRERROR(ierr)
184	STOP
185	ENDIF
186	ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep)
187	if (ierr.ne.0) then
188	print *, NF_STRERROR(ierr)
189	STOP
190	ENDIF
191	print*,'variable ', namedim, 'dimension ', jmdep
192	ierr = NF_INQ_VARID(ncid,namedim,dimid)
193	if (ierr.ne.0) then
194	print *, NF_STRERROR(ierr)
195	STOP
196	ENDIF
197
198	ALLOCATE( latmsk_ini(jmdep) )
199	ALLOCATE( dlat_msk(jmdep) )
200	ALLOCATE( champ_msk(imdep*jmdep) )
201
202	#ifdef NC_DOUBLE
203	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,latmsk_ini)
204	#else
205	ierr = NF_GET_VAR_REAL(ncid,dimid,latmsk_ini)
206	#endif
207	c
208	if (ierr.ne.0) then
209	print *, NF_STRERROR(ierr)
210	STOP
211	ENDIF
212	#ifdef NC_DOUBLE
213	ierr = NF_GET_VAR_DOUBLE(ncid,varid,champ_msk)
214	#else
215	ierr = NF_GET_VAR_REAL(ncid,varid,champ_msk)
216	#endif
217	c
218	if (ierr.ne.0) then
219	print *, NF_STRERROR(ierr)
220	STOP
221	ENDIF
222	c
223	title='RELIEF'
224
225	CALL conf_dat2d(title,imdep, jmdep, lonmsk_ini, latmsk_ini,
226	. dlon_msk, dlat_msk, champ_msk, interbar )
227
228	CALL mask_c_o(imdep, jmdep, dlon_msk, dlat_msk,champ_msk,
229	. iim, jjp1, rlonv, rlatu, champint)
230	c CALL gr_int_dyn(champint, masque, iim, jjp1)
231	c DO i = 1, iim
232	c masque(i,1) = FLOAT(NINT(masque(i,1)))
233	c masque(i,jjp1) = FLOAT(NINT(masque(i,jjp1)))
234	c ENDDO
235	DO i = 1, iim
236	DO j = 1, jjp1
237	mask(i,j) = champint(i,j)
238	ENDDO
239	ENDDO
240	c CALL gr_dyn_fi(1, iip1, jjp1, klon, masque, phy_nat0)
241	ierr = NF_CLOSE(ncid)
242	c
243	c
244	C Traitement de la rugosite
245	c
246	PRINT*, 'Traitement de la rugosite'
247	ierr = NF_OPEN('Rugos.nc', NF_NOWRITE, ncid)
248	if (ierr.ne.0) then
249	print *, NF_STRERROR(ierr)
250	STOP
251	ENDIF
252
253	ierr = NF_INQ_VARID(ncid,'RUGOS',varid)
254	if (ierr.ne.0) then
255	print *, NF_STRERROR(ierr)
256	STOP
257	ENDIF
258	ierr = NF_INQ_VARDIMID (ncid,varid,ndimid)
259	if (ierr.ne.0) then
260	print *, NF_STRERROR(ierr)
261	STOP
262	ENDIF
263	ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep)
264	if (ierr.ne.0) then
265	print *, NF_STRERROR(ierr)
266	STOP
267	ENDIF
268	print*,'variable ', namedim, 'dimension ', imdep
269	ierr = NF_INQ_VARID(ncid,namedim,dimid)
270	if (ierr.ne.0) then
271	print *, NF_STRERROR(ierr)
272	STOP
273	ENDIF
274
275	ALLOCATE( dlon_ini(imdep) )
276	ALLOCATE( dlon(imdep) )
277
278	#ifdef NC_DOUBLE
279	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlon_ini)
280	#else
281	ierr = NF_GET_VAR_REAL(ncid,dimid,dlon_ini)
282	#endif
283	if (ierr.ne.0) then
284	print *, NF_STRERROR(ierr)
285	STOP
286	ENDIF
287	ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep)
288	if (ierr.ne.0) then
289	print *, NF_STRERROR(ierr)
290	STOP
291	ENDIF
292	print*,'variable ', namedim, 'dimension ', jmdep
293	ierr = NF_INQ_VARID(ncid,namedim,dimid)
294	if (ierr.ne.0) then
295	print *, NF_STRERROR(ierr)
296	STOP
297	ENDIF
298
299	ALLOCATE( dlat_ini(jmdep) )
300	ALLOCATE( dlat(jmdep) )
301
302	#ifdef NC_DOUBLE
303	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlat_ini)
304	#else
305	ierr = NF_GET_VAR_REAL(ncid,dimid,dlat_ini)
306	#endif
307	if (ierr.ne.0) then
308	print *, NF_STRERROR(ierr)
309	STOP
310	ENDIF
311	ierr = NF_INQ_DIM(ncid,ndimid(3), namedim, lmdep)
312	if (ierr.ne.0) then
313	print *, NF_STRERROR(ierr)
314	STOP
315	ENDIF
316	print*,'variable ', namedim, 'dimension ', lmdep
317	ierr = NF_INQ_VARID(ncid,namedim,dimid)
318	if (ierr.ne.0) then
319	print *, NF_STRERROR(ierr)
320	STOP
321	ENDIF
322	#ifdef NC_DOUBLE
323	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,timecoord)
324	#else
325	ierr = NF_GET_VAR_REAL(ncid,dimid,timecoord)
326	#endif
327	if (ierr.ne.0) then
328	print *, NF_STRERROR(ierr)
329	STOP
330	ENDIF
331	c
332	ALLOCATE( champ(imdep*jmdep) )
333
334	DO 200 l = 1, lmdep
335	dimfirst(1) = 1
336	dimfirst(2) = 1
337	dimfirst(3) = l
338	c
339	dimlast(1) = imdep
340	dimlast(2) = jmdep
341	dimlast(3) = 1
342	c
343	PRINT*,'Lecture temporelle et int. horizontale ',l,timecoord(l)
344	print*,dimfirst,dimlast
345	#ifdef NC_DOUBLE
346	ierr = NF_GET_VARA_DOUBLE(ncid,varid,dimfirst,dimlast,champ)
347	#else
348	ierr = NF_GET_VARA_REAL(ncid,varid,dimfirst,dimlast,champ)
349	#endif
350	if (ierr.ne.0) then
351	print *, NF_STRERROR(ierr)
352	STOP
353	ENDIF
354
355	title = 'Rugosite Amip '
356	c
357	CALL conf_dat2d(title,imdep, jmdep, dlon_ini, dlat_ini,
358	. dlon, dlat, champ, interbar )
359
360	IF ( interbar ) THEN
361	DO j = 1, imdep * jmdep
362	champ(j) = LOG(champ(j))
363	ENDDO
364
365	IF( l.EQ.1 ) THEN
366	WRITE(6,*) '-------------------------------------------------',
367	,'------------------------'
368	WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
369	, ' pour la rugosite $$$ '
370	WRITE(6,*) '-------------------------------------------------',
371	,'------------------------'
372	ENDIF
373	CALL inter_barxy ( imdep,jmdep -1,dlon,dlat,champ ,
374	, iim,jjm,rlonu,rlatv, jjp1,champint )
375	DO j=1,jjp1
376	DO i=1,iim
377	champint(i,j)=EXP(champint(i,j))
378	ENDDO
379	ENDDO
380
381	DO j = 1, jjp1
382	DO i = 1, iim
383	IF(NINT(mask(i,j)).NE.1) THEN
384	champint( i,j ) = 0.001
385	ENDIF
386	ENDDO
387	ENDDO
388	ELSE
389	CALL rugosite(imdep, jmdep, dlon, dlat, champ,
390	. iim, jjp1, rlonv, rlatu, champint, mask)
391	ENDIF
392	DO j = 1,jjp1
393	DO i = 1, iim
394	champtime (i,j,l) = champint(i,j)
395	ENDDO
396	ENDDO
397	200 CONTINUE
398	c
399	DO l = 1, lmdep
400	timeyear(l) = timecoord(l)
401	ENDDO
402
403	PRINT 222, timeyear
404	222 FORMAT(2x,' Time year ',10f6.1)
405	c
406
407	PRINT*, 'Interpolation temporelle dans l annee'
408
409	DO j = 1, jjp1
410	DO i = 1, iim
411	DO l = 1, lmdep
412	ax(l) = timeyear(l)
413	ay(l) = champtime (i,j,l)
414	ENDDO
415	CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder)
416	DO k = 1, 360
417	time = FLOAT(k-1)
418	CALL SPLINT(ax,ay,yder,lmdep,time,by)
419	champan(i,j,k) = by
420	ENDDO
421	ENDDO
422	ENDDO
423	DO k = 1, 360
424	DO j = 1, jjp1
425	champan(iip1,j,k) = champan(1,j,k)
426	ENDDO
427	IF ( k.EQ.10 ) THEN
428	DO j = 1, jjp1
429	CALL minmax( iip1,champan(1,j,10),chmin,chmax )
430	PRINT *,' Rugosite au temps 10 ', chmin,chmax,j
431	ENDDO
432	ENDIF
433	ENDDO
434	c
435	DO k = 1, 360
436	CALL gr_dyn_fi(1,iip1,jjp1,klon,champan(1,1,k), phy_rug(1,k))
437	ENDDO
438	c
439	ierr = NF_CLOSE(ncid)
440
441	DEALLOCATE( dlon )
442	DEALLOCATE( dlon_ini )
443	DEALLOCATE( dlat )
444	DEALLOCATE( dlat_ini )
445	DEALLOCATE( champ )
446	c
447	c
448	C Traitement de la glace oceanique
449	c
450	PRINT*, 'Traitement de la glace oceanique'
451	ierr = NF_OPEN('AMIP.nc', NF_NOWRITE, ncid)
452	if (ierr.ne.0) then
453	print *, NF_STRERROR(ierr)
454	STOP
455	ENDIF
456
457	ierr = NF_INQ_VARID(ncid,'SEA_ICE',varid)
458	if (ierr.ne.0) then
459	print *, NF_STRERROR(ierr)
460	STOP
461	ENDIF
462	ierr = NF_INQ_VARDIMID (ncid,varid,ndimid)
463	if (ierr.ne.0) then
464	print *, NF_STRERROR(ierr)
465	STOP
466	ENDIF
467	ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep)
468	if (ierr.ne.0) then
469	print *, NF_STRERROR(ierr)
470	STOP
471	ENDIF
472	print*,'variable ', namedim, 'dimension ', imdep
473	ierr = NF_INQ_VARID(ncid,namedim,dimid)
474	if (ierr.ne.0) then
475	print *, NF_STRERROR(ierr)
476	STOP
477	ENDIF
478
479	ALLOCATE ( dlon_ini(imdep) )
480	ALLOCATE ( dlon(imdep) )
481
482	#ifdef NC_DOUBLE
483	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlon_ini)
484	#else
485	ierr = NF_GET_VAR_REAL(ncid,dimid,dlon_ini)
486	#endif
487	if (ierr.ne.0) then
488	print *, NF_STRERROR(ierr)
489	STOP
490	ENDIF
491	ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep)
492	if (ierr.ne.0) then
493	print *, NF_STRERROR(ierr)
494	STOP
495	ENDIF
496	print*,'variable ', namedim, jmdep
497	ierr = NF_INQ_VARID(ncid,namedim,dimid)
498	if (ierr.ne.0) then
499	print *, NF_STRERROR(ierr)
500	STOP
501	ENDIF
502
503	ALLOCATE ( dlat_ini(jmdep) )
504	ALLOCATE ( dlat(jmdep) )
505
506	#ifdef NC_DOUBLE
507	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlat_ini)
508	#else
509	ierr = NF_GET_VAR_REAL(ncid,dimid,dlat_ini)
510	#endif
511	if (ierr.ne.0) then
512	print *, NF_STRERROR(ierr)
513	STOP
514	ENDIF
515	ierr = NF_INQ_DIM(ncid,ndimid(3), namedim, lmdep)
516	if (ierr.ne.0) then
517	print *, NF_STRERROR(ierr)
518	STOP
519	ENDIF
520	print*,'variable ', namedim, lmdep
521	ierr = NF_INQ_VARID(ncid,namedim,dimid)
522	if (ierr.ne.0) then
523	print *, NF_STRERROR(ierr)
524	STOP
525	ENDIF
526	#ifdef NC_DOUBLE
527	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,timecoord)
528	#else
529	ierr = NF_GET_VAR_REAL(ncid,dimid,timecoord)
530	#endif
531	if (ierr.ne.0) then
532	print *, NF_STRERROR(ierr)
533	STOP
534	ENDIF
535	c
536	ALLOCATE ( champ(imdep*jmdep) )
537
538	DO l = 1, lmdep
539	dimfirst(1) = 1
540	dimfirst(2) = 1
541	dimfirst(3) = l
542	c
543	dimlast(1) = imdep
544	dimlast(2) = jmdep
545	dimlast(3) = 1
546	c
547	PRINT*,'Lecture temporelle et int. horizontale ',l,timecoord(l)
548	#ifdef NC_DOUBLE
549	ierr = NF_GET_VARA_DOUBLE(ncid,varid,dimfirst,dimlast,champ)
550	#else
551	ierr = NF_GET_VARA_REAL(ncid,varid,dimfirst,dimlast,champ)
552	#endif
553	if (ierr.ne.0) then
554	print *, NF_STRERROR(ierr)
555	STOP
556	ENDIF
557
558	title = 'Sea-ice Amip '
559	c
560	CALL conf_dat2d(title,imdep, jmdep, dlon_ini, dlat_ini,
561	. dlon, dlat, champ, interbar )
562	c
563	IF( oldice ) THEN
564	CALL sea_ice(imdep, jmdep, dlon, dlat, champ,
565	. iim, jjp1, rlonv, rlatu, champint )
566	ELSEIF ( interbar ) THEN
567	IF( l.EQ.1 ) THEN
568	WRITE(6,*) '-------------------------------------------------',
569	,'------------------------'
570	WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
571	, ' pour Sea-ice Amip $$$ '
572	WRITE(6,*) '-------------------------------------------------',
573	,'------------------------'
574	ENDIF
575
576	CALL inter_barxy ( imdep,jmdep -1,dlon, dlat ,
577	, champ, iim, jjm, rlonu, rlatv, jjp1, champint )
578	ELSE
579	CALL sea_ice(imdep, jmdep, dlon, dlat, champ,
580	. iim, jjp1, rlonv, rlatu, champint )
581	ENDIF
582	DO j = 1,jjp1
583	DO i = 1, iim
584	champtime (i,j,l) = champint(i,j)
585	ENDDO
586	ENDDO
587	ENDDO
588	c
589	DO l = 1, lmdep
590	timeyear(l) = timecoord(l)
591	ENDDO
592	PRINT 222, timeyear
593	c
594	PRINT*, 'Interpolation temporelle'
595	DO j = 1, jjp1
596	DO i = 1, iim
597	DO l = 1, lmdep
598	ax(l) = timeyear(l)
599	ay(l) = champtime (i,j,l)
600	ENDDO
601	CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder)
602	DO k = 1, 360
603	time = FLOAT(k-1)
604	CALL SPLINT(ax,ay,yder,lmdep,time,by)
605	champan(i,j,k) = by
606	ENDDO
607	ENDDO
608	ENDDO
609	DO k = 1, 360
610	DO j = 1, jjp1
611	champan(iip1, j, k) = champan(1, j, k)
612	ENDDO
613	IF ( k.EQ.10 ) THEN
614	DO j = 1, jjp1
615	CALL minmax( iip1,champan(1,j,10),chmin,chmax )
616	PRINT *,' Sea ice au temps 10 ', chmin,chmax,j
617	ENDDO
618	ENDIF
619	ENDDO
620	c
621
622	DO k = 1, 360
623	CALL gr_dyn_fi(1, iip1, jjp1, klon,
624	. champan(1,1,k), phy_ice)
625	IF ( newlmt) THEN
626
627	CPB en attendant de mettre fraction de terre
628	c
629	WHERE(phy_ice(1:klon) .GE. 1.) phy_ice(1 : klon) = 1.
630	WHERE(phy_ice(1:klon) .LT. EPSFRA) phy_ice(1 : klon) = 0.
631	c
632	IF (fracterre ) THEN
633	c WRITE(,) 'passe dans cas fracterre'
634	pctsrf_t(:,is_ter,k) = pctsrf(:,is_ter)
635	pctsrf_t(:,is_lic,k) = pctsrf(:,is_lic)
636	pctsrf_t(1:klon,is_sic,k) = phy_ice(1:klon)
637	$ - pctsrf_t(1:klon,is_lic,k)
638	c Il y a des cas ou il y a de la glace dans landiceref et pas dans AMIP
639	WHERE (pctsrf_t(1:klon,is_sic,k) .LE. 0)
640	pctsrf_t(1:klon,is_sic,k) = 0.
641	END WHERE
642	WHERE( 1. - zmasq(1:klon) .LT. EPSFRA)
643	pctsrf_t(1:klon,is_sic,k) = 0.
644	pctsrf_t(1:klon,is_oce,k) = 0.
645	END WHERE
646	DO i = 1, klon
647	IF ( 1. - zmasq(i) .GT. EPSFRA) THEN
648	IF ( pctsrf_t(i,is_sic,k) .GE. 1 - zmasq(i)) THEN
649	pctsrf_t(i,is_sic,k) = 1 - zmasq(i)
650	pctsrf_t(i,is_oce,k) = 0.
651	ELSE
652	pctsrf_t(i,is_oce,k) = 1 - zmasq(i)
653	$ - pctsrf_t(i,is_sic,k)
654	IF (pctsrf_t(i,is_oce,k) .LT. EPSFRA) THEN
655	pctsrf_t(i,is_oce,k) = 0.
656	pctsrf_t(i,is_sic,k) = 1 - zmasq(i)
657	ENDIF
658	ENDIF
659	ENDIF
660	if (pctsrf_t(i,is_oce,k) .lt. 0.) then
661	WRITE(,) 'pb sous maille au point : i,k '
662	$ , i,k,pctsrf_t(:,is_oce,k)
663	ENDIF
664	IF ( abs( pctsrf_t(i, is_ter,k) + pctsrf_t(i, is_lic,k) +
665	$ pctsrf_t(i, is_oce,k) + pctsrf_t(i, is_sic,k) - 1.)
666	$ .GT. EPSFRA) THEN
667	WRITE(,) 'physiq : pb sous surface au point ', i,
668	$ pctsrf_t(i, 1 : nbsrf,k), phy_ice(i)
669	ENDIF
670	END DO
671	ELSE
672	DO i = 1, klon
673	pctsrf_t(i,is_ter,k) = pctsrf(i,is_ter)
674	IF (NINT(pctsrf(i,is_ter)).EQ.1 ) THEN
675	pctsrf_t(i,is_sic,k) = 0.
676	pctsrf_t(i,is_oce,k) = 0.
677	IF(phy_ice(i) .GE. 1.e-5) THEN
678	pctsrf_t(i,is_lic,k) = phy_ice(i)
679	pctsrf_t(i,is_ter,k) = pctsrf_t(i,is_ter,k)
680	. - pctsrf_t(i,is_lic,k)
681	ELSE
682	pctsrf_t(i,is_lic,k) = 0.
683	ENDIF
684	ELSE
685	pctsrf_t(i,is_lic,k) = 0.
686	IF(phy_ice(i) .GE. 1.e-5) THEN
687	pctsrf_t(i,is_ter,k) = 0.
688	pctsrf_t(i,is_sic,k) = phy_ice(i)
689	pctsrf_t(i,is_oce,k) = 1. - pctsrf_t(i,is_sic,k)
690	ELSE
691	pctsrf_t(i,is_sic,k) = 0.
692	pctsrf_t(i,is_oce,k) = 1.
693	ENDIF
694	ENDIF
695	verif = pctsrf_t(i,is_ter,k) +
696	. pctsrf_t(i,is_oce,k) +
697	. pctsrf_t(i,is_sic,k) +
698	. pctsrf_t(i,is_lic,k)
699	IF ( verif .LT. 1. - 1.e-5 .OR.
700	$ verif .GT. 1 + 1.e-5) THEN
701	WRITE(,) 'pb sous maille au point : i,k,verif '
702	$ , i,k,verif
703	ENDIF
704	END DO
705	ENDIF
706	ELSE
707	DO i = 1, klon
708	phy_nat(i,k) = phy_nat0(i)
709	IF ( (phy_ice(i) - 0.5).GE.1.e-5 ) THEN
710	IF (NINT(phy_nat0(i)).EQ.0) THEN
711	phy_nat(i,k) = 3.0
712	ELSE
713	phy_nat(i,k) = 2.0
714	ENDIF
715	ENDIF
716	IF( NINT(phy_nat(i,k)).EQ.0 ) THEN
717	IF ( phy_rug(i,k).NE.0.001 ) phy_rug(i,k) = 0.001
718	ENDIF
719	END DO
720	ENDIF
721	ENDDO
722	c
723
724	ierr = NF_CLOSE(ncid)
725	c
726	DEALLOCATE( dlon )
727	DEALLOCATE( dlon_ini )
728	DEALLOCATE( dlat )
729	DEALLOCATE( dlat_ini )
730	DEALLOCATE( champ )
731
732	477 continue
733	c
734	C Traitement de la sst
735	c
736	PRINT*, 'Traitement de la sst'
737	ierr = NF_OPEN('AMIP.nc', NF_NOWRITE, ncid)
738	if (ierr.ne.0) then
739	print *, NF_STRERROR(ierr)
740	STOP
741	ENDIF
742
743	ierr = NF_INQ_VARID(ncid,'SST',varid)
744	if (ierr.ne.0) then
745	print *, NF_STRERROR(ierr)
746	STOP
747	ENDIF
748	ierr = NF_INQ_VARDIMID (ncid,varid,ndimid)
749	if (ierr.ne.0) then
750	print *, NF_STRERROR(ierr)
751	STOP
752	ENDIF
753	ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep)
754	if (ierr.ne.0) then
755	print *, NF_STRERROR(ierr)
756	STOP
757	ENDIF
758	print*,'variable SST ', namedim,'dimension ', imdep
759	ierr = NF_INQ_VARID(ncid,namedim,dimid)
760	if (ierr.ne.0) then
761	print *, NF_STRERROR(ierr)
762	STOP
763	ENDIF
764
765	ALLOCATE( dlon_ini(imdep) )
766	ALLOCATE( dlon(imdep) )
767
768	#ifdef NC_DOUBLE
769	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlon_ini)
770	#else
771	ierr = NF_GET_VAR_REAL(ncid,dimid,dlon_ini)
772	#endif
773
774	if (ierr.ne.0) then
775	print *, NF_STRERROR(ierr)
776	STOP
777	ENDIF
778	ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep)
779	if (ierr.ne.0) then
780	print *, NF_STRERROR(ierr)
781	STOP
782	ENDIF
783	print*,'variable SST ', namedim, 'dimension ', jmdep
784	ierr = NF_INQ_VARID(ncid,namedim,dimid)
785	if (ierr.ne.0) then
786	print *, NF_STRERROR(ierr)
787	STOP
788	ENDIF
789
790	ALLOCATE( dlat_ini(jmdep) )
791	ALLOCATE( dlat(jmdep) )
792
793	#ifdef NC_DOUBLE
794	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlat_ini)
795	#else
796	ierr = NF_GET_VAR_REAL(ncid,dimid,dlat_ini)
797	#endif
798	if (ierr.ne.0) then
799	print *, NF_STRERROR(ierr)
800	STOP
801	ENDIF
802	ierr = NF_INQ_DIM(ncid,ndimid(3), namedim, lmdep)
803	if (ierr.ne.0) then
804	print *, NF_STRERROR(ierr)
805	STOP
806	ENDIF
807	print*,'variable ', namedim, 'dimension ', lmdep
808	ierr = NF_INQ_VARID(ncid,namedim,dimid)
809	if (ierr.ne.0) then
810	print *, NF_STRERROR(ierr)
811	STOP
812	ENDIF
813	#ifdef NC_DOUBLE
814	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,timecoord)
815	#else
816	ierr = NF_GET_VAR_REAL(ncid,dimid,timecoord)
817	#endif
818	if (ierr.ne.0) then
819	print *, NF_STRERROR(ierr)
820	STOP
821	ENDIF
822
823	ALLOCATE( champ(imdep*jmdep) )
824	IF( extrap ) THEN
825	ALLOCATE ( work(imdep,jmdep) )
826	ENDIF
827	c
828	DO l = 1, lmdep
829	dimfirst(1) = 1
830	dimfirst(2) = 1
831	dimfirst(3) = l
832	c
833	dimlast(1) = imdep
834	dimlast(2) = jmdep
835	dimlast(3) = 1
836	c
837	PRINT*,'Lecture temporelle et int. horizontale ',l,timecoord(l)
838	#ifdef NC_DOUBLE
839	ierr = NF_GET_VARA_DOUBLE(ncid,varid,dimfirst,dimlast,champ)
840	#else
841	ierr = NF_GET_VARA_REAL(ncid,varid,dimfirst,dimlast,champ)
842	#endif
843	if (ierr.ne.0) then
844	print *, NF_STRERROR(ierr)
845	STOP
846	ENDIF
847
848	title='Sst Amip'
849	c
850	CALL conf_dat2d(title,imdep, jmdep, dlon_ini, dlat_ini,
851	. dlon, dlat, champ, interbar )
852	IF ( extrap ) THEN
853	CALL extrapol(champ, imdep, jmdep, 999999.,.TRUE.,.TRUE.,2,work)
854	ENDIF
855	c
856
857	IF ( interbar ) THEN
858	IF( l.EQ.1 ) THEN
859	WRITE(6,*) '-------------------------------------------------',
860	,'------------------------'
861	WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
862	, ' pour la Sst Amip $$$ '
863	WRITE(6,*) '-------------------------------------------------',
864	,'------------------------'
865	ENDIF
866	CALL inter_barxy ( imdep,jmdep -1,dlon, dlat ,
867	, champ, iim, jjm, rlonu, rlatv, jjp1, champint )
868	ELSE
869	CALL grille_m(imdep, jmdep, dlon, dlat, champ,
870	. iim, jjp1, rlonv, rlatu, champint )
871	ENDIF
872
873	DO j = 1,jjp1
874	DO i = 1, iim
875	champtime (i,j,l) = champint(i,j)
876	ENDDO
877	ENDDO
878	ENDDO
879	c
880	DO l = 1, lmdep
881	timeyear(l) = timecoord(l)
882	ENDDO
883	print 222, timeyear
884	c
885	C interpolation temporelle
886	DO j = 1, jjp1
887	DO i = 1, iim
888	DO l = 1, lmdep
889	ax(l) = timeyear(l)
890	ay(l) = champtime (i,j,l)
891	ENDDO
892	CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder)
893	DO k = 1, 360
894	time = FLOAT(k-1)
895	CALL SPLINT(ax,ay,yder,lmdep,time,by)
896	champan(i,j,k) = by
897	ENDDO
898	ENDDO
899	ENDDO
900	DO k = 1, 360
901	DO j = 1, jjp1
902	champan(iip1,j,k) = champan(1,j,k)
903	ENDDO
904	IF ( k.EQ.10 ) THEN
905	DO j = 1, jjp1
906	CALL minmax( iip1,champan(1,j,10),chmin,chmax )
907	PRINT *,' SST au temps 10 ', chmin,chmax,j
908	ENDDO
909	ENDIF
910	ENDDO
911	c
912	DO k = 1, 360
913	CALL gr_dyn_fi(1, iip1, jjp1, klon,
914	. champan(1,1,k), phy_sst(1,k))
915	ENDDO
916	c
917	ierr = NF_CLOSE(ncid)
918	c
919	DEALLOCATE( dlon )
920	DEALLOCATE( dlon_ini )
921	DEALLOCATE( dlat )
922	DEALLOCATE( dlat_ini )
923	DEALLOCATE( champ )
924	c
925	C Traitement de l'albedo
926	c
927	PRINT*, 'Traitement de l albedo'
928	ierr = NF_OPEN('Albedo.nc', NF_NOWRITE, ncid)
929	if (ierr.ne.0) then
930	print *, NF_STRERROR(ierr)
931	STOP
932	ENDIF
933	ierr = NF_INQ_VARID(ncid,'ALBEDO',varid)
934	if (ierr.ne.0) then
935	print *, NF_STRERROR(ierr)
936	STOP
937	ENDIF
938	ierr = NF_INQ_VARDIMID (ncid,varid,ndimid)
939	if (ierr.ne.0) then
940	print *, NF_STRERROR(ierr)
941	STOP
942	ENDIF
943	ierr = NF_INQ_DIM(ncid,ndimid(1), namedim, imdep)
944	if (ierr.ne.0) then
945	print *, NF_STRERROR(ierr)
946	STOP
947	ENDIF
948	print*,'variable ', namedim, 'dimension ', imdep
949	ierr = NF_INQ_VARID(ncid,namedim,dimid)
950	if (ierr.ne.0) then
951	print *, NF_STRERROR(ierr)
952	STOP
953	ENDIF
954
955	ALLOCATE ( dlon_ini(imdep) )
956	ALLOCATE ( dlon(imdep) )
957
958	#ifdef NC_DOUBLE
959	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlon_ini)
960	#else
961	ierr = NF_GET_VAR_REAL(ncid,dimid,dlon_ini)
962	#endif
963	if (ierr.ne.0) then
964	print *, NF_STRERROR(ierr)
965	STOP
966	ENDIF
967	ierr = NF_INQ_DIM(ncid,ndimid(2), namedim, jmdep)
968	if (ierr.ne.0) then
969	print *, NF_STRERROR(ierr)
970	STOP
971	ENDIF
972	print*,'variable ', namedim, 'dimension ', jmdep
973	ierr = NF_INQ_VARID(ncid,namedim,dimid)
974	if (ierr.ne.0) then
975	print *, NF_STRERROR(ierr)
976	STOP
977	ENDIF
978
979	ALLOCATE ( dlat_ini(jmdep) )
980	ALLOCATE ( dlat(jmdep) )
981
982	#ifdef NC_DOUBLE
983	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,dlat_ini)
984	#else
985	ierr = NF_GET_VAR_REAL(ncid,dimid,dlat_ini)
986	#endif
987	if (ierr.ne.0) then
988	print *, NF_STRERROR(ierr)
989	STOP
990	ENDIF
991	ierr = NF_INQ_DIM(ncid,ndimid(3), namedim, lmdep)
992	if (ierr.ne.0) then
993	print *, NF_STRERROR(ierr)
994	STOP
995	ENDIF
996	print*,'variable ', namedim, 'dimension ', lmdep
997	ierr = NF_INQ_VARID(ncid,namedim,dimid)
998	if (ierr.ne.0) then
999	print *, NF_STRERROR(ierr)
1000	STOP
1001	ENDIF
1002	#ifdef NC_DOUBLE
1003	ierr = NF_GET_VAR_DOUBLE(ncid,dimid,timecoord)
1004	#else
1005	ierr = NF_GET_VAR_REAL(ncid,dimid,timecoord)
1006	#endif
1007	if (ierr.ne.0) then
1008	print *, NF_STRERROR(ierr)
1009	STOP
1010	ENDIF
1011	c
1012	ALLOCATE ( champ(imdep*jmdep) )
1013
1014	DO l = 1, lmdep
1015	dimfirst(1) = 1
1016	dimfirst(2) = 1
1017	dimfirst(3) = l
1018	c
1019	dimlast(1) = imdep
1020	dimlast(2) = jmdep
1021	dimlast(3) = 1
1022	c
1023	PRINT*,'Lecture temporelle et int. horizontale ',l,timecoord(l)
1024	#ifdef NC_DOUBLE
1025	ierr = NF_GET_VARA_DOUBLE(ncid,varid,dimfirst,dimlast,champ)
1026	#else
1027	ierr = NF_GET_VARA_REAL(ncid,varid,dimfirst,dimlast,champ)
1028	#endif
1029	if (ierr.ne.0) then
1030	print *, NF_STRERROR(ierr)
1031	STOP
1032	ENDIF
1033
1034	title='Albedo Amip'
1035	c
1036	CALL conf_dat2d(title,imdep, jmdep, dlon_ini, dlat_ini,
1037	. dlon, dlat, champ, interbar )
1038	c
1039	c
1040	IF ( interbar ) THEN
1041	IF( l.EQ.1 ) THEN
1042	WRITE(6,*) '-------------------------------------------------',
1043	,'------------------------'
1044	WRITE(6,*) '$$$ Utilisation de l interpolation barycentrique ',
1045	, ' pour l Albedo Amip $$$ '
1046	WRITE(6,*) '-------------------------------------------------',
1047	,'------------------------'
1048	ENDIF
1049
1050	CALL inter_barxy ( imdep,jmdep -1,dlon, dlat ,
1051	, champ, iim, jjm, rlonu, rlatv, jjp1, champint )
1052	ELSE
1053	CALL grille_m(imdep, jmdep, dlon, dlat, champ,
1054	. iim, jjp1, rlonv, rlatu, champint )
1055	ENDIF
1056	c
1057	DO j = 1,jjp1
1058	DO i = 1, iim
1059	champtime (i, j, l) = champint(i, j)
1060	ENDDO
1061	ENDDO
1062	ENDDO
1063	c
1064	DO l = 1, lmdep
1065	timeyear(l) = timecoord(l)
1066	ENDDO
1067	print 222, timeyear
1068	c
1069	C interpolation temporelle
1070	DO j = 1, jjp1
1071	DO i = 1, iim
1072	DO l = 1, lmdep
1073	ax(l) = timeyear(l)
1074	ay(l) = champtime (i, j, l)
1075	ENDDO
1076	CALL SPLINE(ax,ay,lmdep,1.e30,1.e30,yder)
1077	DO k = 1, 360
1078	time = FLOAT(k-1)
1079	CALL SPLINT(ax,ay,yder,lmdep,time,by)
1080	champan(i,j,k) = by
1081	ENDDO
1082	ENDDO
1083	ENDDO
1084	DO k = 1, 360
1085	DO j = 1, jjp1
1086	champan(iip1, j, k) = champan(1, j, k)
1087	ENDDO
1088	IF ( k.EQ.10 ) THEN
1089	DO j = 1, jjp1
1090	CALL minmax( iip1,champan(1,j,10),chmin,chmax )
1091	PRINT *,' Albedo au temps 10 ', chmin,chmax,j
1092	ENDDO
1093	ENDIF
1094	ENDDO
1095	c
1096	DO k = 1, 360
1097	CALL gr_dyn_fi(1, iip1, jjp1, klon,
1098	. champan(1,1,k), phy_alb(1,k))
1099	ENDDO
1100	c
1101	ierr = NF_CLOSE(ncid)
1102	c
1103	c
1104	DO k = 1, 360
1105	DO i = 1, klon
1106	phy_bil(i,k) = 0.0
1107	ENDDO
1108	ENDDO
1109	c
1110	PRINT*, 'Ecriture du fichier limit'
1111	c
1112	ierr = NF_CREATE ("limit.nc", NF_CLOBBER, nid)
1113	c
1114	ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 30,
1115	. "Fichier conditions aux limites")
1116	ierr = NF_DEF_DIM (nid, "points_physiques", klon, ndim)
1117	ierr = NF_DEF_DIM (nid, "time", NF_UNLIMITED, ntim)
1118	c
1119	dims(1) = ndim
1120	dims(2) = ntim
1121	c
1122	ierr = NF_DEF_VAR (nid, "TEMPS", NF_FLOAT, 1,ntim, id_tim)
1123	ierr = NF_PUT_ATT_TEXT (nid, id_tim, "title", 17,
1124	. "Jour dans l annee")
1125	IF (newlmt) THEN
1126	c
1127	ierr = NF_DEF_VAR (nid, "FOCE", NF_FLOAT, 2,dims, id_FOCE)
1128	ierr = NF_PUT_ATT_TEXT (nid, id_FOCE, "title", 14,
1129	. "Fraction ocean")
1130	c
1131	ierr = NF_DEF_VAR (nid, "FSIC", NF_FLOAT, 2,dims, id_FSIC)
1132	ierr = NF_PUT_ATT_TEXT (nid, id_FSIC, "title", 21,
1133	. "Fraction glace de mer")
1134	c
1135	ierr = NF_DEF_VAR (nid, "FTER", NF_FLOAT, 2,dims, id_FTER)
1136	ierr = NF_PUT_ATT_TEXT (nid, id_FTER, "title", 14,
1137	. "Fraction terre")
1138	c
1139	ierr = NF_DEF_VAR (nid, "FLIC", NF_FLOAT, 2,dims, id_FLIC)
1140	ierr = NF_PUT_ATT_TEXT (nid, id_FLIC, "title", 17,
1141	. "Fraction land ice")
1142	c
1143	ELSE
1144	ierr = NF_DEF_VAR (nid, "NAT", NF_FLOAT, 2,dims, id_NAT)
1145	ierr = NF_PUT_ATT_TEXT (nid, id_NAT, "title", 23,
1146	. "Nature du sol (0,1,2,3)")
1147	ENDIF
1148	ierr = NF_DEF_VAR (nid, "SST", NF_FLOAT, 2,dims, id_SST)
1149	ierr = NF_PUT_ATT_TEXT (nid, id_SST, "title", 35,
1150	. "Temperature superficielle de la mer")
1151	ierr = NF_DEF_VAR (nid, "BILS", NF_FLOAT, 2,dims, id_BILS)
1152	ierr = NF_PUT_ATT_TEXT (nid, id_BILS, "title", 32,
1153	. "Reference flux de chaleur au sol")
1154	ierr = NF_DEF_VAR (nid, "ALB", NF_FLOAT, 2,dims, id_ALB)
1155	ierr = NF_PUT_ATT_TEXT (nid, id_ALB, "title", 19,
1156	. "Albedo a la surface")
1157	ierr = NF_DEF_VAR (nid, "RUG", NF_FLOAT, 2,dims, id_RUG)
1158	ierr = NF_PUT_ATT_TEXT (nid, id_RUG, "title", 8,
1159	. "Rugosite")
1160	c
1161	ierr = NF_ENDDEF(nid)
1162	c
1163	DO k = 1, 360
1164	c
1165	debut(1) = 1
1166	debut(2) = k
1167	epais(1) = klon
1168	epais(2) = 1
1169	c
1170	#ifdef NC_DOUBLE
1171	ierr = NF_PUT_VAR1_DOUBLE (nid,id_tim,k,DBLE(k))
1172	c
1173	IF (newlmt ) THEN
1174	ierr = NF_PUT_VARA_DOUBLE (nid,id_FOCE,debut,epais
1175	$ ,pctsrf_t(1,is_oce,k))
1176	ierr = NF_PUT_VARA_DOUBLE (nid,id_FSIC,debut,epais
1177	$ ,pctsrf_t(1,is_sic,k))
1178	ierr = NF_PUT_VARA_DOUBLE (nid,id_FTER,debut,epais
1179	$ ,pctsrf_t(1,is_ter,k))
1180	ierr = NF_PUT_VARA_DOUBLE (nid,id_FLIC,debut,epais
1181	$ ,pctsrf_t(1,is_lic,k))
1182	ELSE
1183	ierr = NF_PUT_VARA_DOUBLE (nid,id_NAT,debut,epais
1184	$ ,phy_nat(1,k))
1185	ENDIF
1186	c
1187	ierr = NF_PUT_VARA_DOUBLE (nid,id_SST,debut,epais,phy_sst(1,k))
1188	ierr = NF_PUT_VARA_DOUBLE (nid,id_BILS,debut,epais,phy_bil(1,k))
1189	ierr = NF_PUT_VARA_DOUBLE (nid,id_ALB,debut,epais,phy_alb(1,k))
1190	ierr = NF_PUT_VARA_DOUBLE (nid,id_RUG,debut,epais,phy_rug(1,k))
1191	#else
1192	ierr = NF_PUT_VAR1_REAL (nid,id_tim,k,FLOAT(k))
1193	IF (newlmt ) THEN
1194	ierr = NF_PUT_VARA_REAL (nid,id_FOCE,debut,epais
1195	$ ,pctsrf_t(1,is_oce,k))
1196	ierr = NF_PUT_VARA_REAL (nid,id_FSIC,debut,epais
1197	$ ,pctsrf_t(1,is_sic,k))
1198	ierr = NF_PUT_VARA_REAL (nid,id_FTER,debut,epais
1199	$ ,pctsrf_t(1,is_ter,k))
1200	ierr = NF_PUT_VARA_REAL (nid,id_FLIC,debut,epais
1201	$ ,pctsrf_t(1,is_lic,k))
1202	ELSE
1203	ierr = NF_PUT_VARA_REAL (nid,id_NAT,debut,epais
1204	$ ,phy_nat(1,k))
1205	ENDIF
1206	ierr = NF_PUT_VARA_REAL (nid,id_SST,debut,epais,phy_sst(1,k))
1207	ierr = NF_PUT_VARA_REAL (nid,id_BILS,debut,epais,phy_bil(1,k))
1208	ierr = NF_PUT_VARA_REAL (nid,id_ALB,debut,epais,phy_alb(1,k))
1209	ierr = NF_PUT_VARA_REAL (nid,id_RUG,debut,epais,phy_rug(1,k))
1210	#endif
1211	c
1212	ENDDO
1213	c
1214	ierr = NF_CLOSE(nid)
1215	c
1216	STOP
1217	END

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

Download in other formats:

Original Format