Context Navigation

interfsurf.F @ 87

Last change on this file since 87 was 81, checked in by lmdzadmin, 24 years ago
Creation du module d'interface avec le sol. LF
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 23.4 KB

Line
1
2	MODULE interface_surf
3
4	! Ce module regroupe toutes les routines gerant l'interface entre le modele
5	! atmospherique et les modeles de surface (sols continentaux, oceans, glaces)
6	! Les routines sont les suivantes:
7	!
8	! interfsurf_*: routines d'aiguillage vers les interfaces avec les
9	! differents modeles de surface
10	! interfsol\
11	! > routines d'interface proprement dite
12	! interfoce/
13	!
14	! interfstart: routine d'initialisation et de lecture de l'etat initial
15	! "interface"
16	! interffin : routine d'ecriture de l'etat de redemmarage de l'interface
17	!
18	!
19	! L. Fairhead, LMD, 02/2000
20
21	USE ioipsl
22	USE constantes
23
24	IMPLICIT none
25
26	PRIVATE
27	PUBLIC :: interfsurf
28
29	INTERFACE interfsurf
30	module procedure interfsurf_hq, interfsurf_vent
31	END INTERFACE
32
33	INTERFACE interfoce
34	module procedure interfoce_cpl, interfoce_slab, interfoce_lim
35	END INTERFACE
36
37
38	! run_off ruissellement total
39	real, allocatable, dimension(:),save :: run_off
40
41
42	CONTAINS
43	!
44	!############################################################################
45	!
46	SUBROUTINE interfsurf_hq(itime, dtime, jour, &
47	& klon, nisurf, knon, knindex, rlon, rlat, &
48	& debut, lafin, ok_veget, &
49	& zlev, zlflu, u1_lay, v1_lay, temp_air, spechum, hum_air, ccanopy, &
50	& tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
51	& precip_rain, precip_snow, lwdown, swnet, swdown, ps, &
52	& ocean, &
53	& evap, fluxsens, fluxlat, &
54	& tsol_rad, tsurf_new, alb_new, emis_new, z0_new, pctsrf_new)
55
56	! Cette routine sert d'aiguillage entre l'atmosphere et la surface en general
57	! (sols continentaux, oceans, glaces) pour les fluxs de chaleur et d'humidite.
58	! En pratique l'interface se fait entre la couche limite du modele
59	! atmospherique (clmain.F) et les routines de surface (sechiba, oasis, ...)
60	!
61	!
62	! L.Fairhead 02/2000
63	!
64	! input:
65	! itime numero du pas de temps
66	! klon nombre total de points de grille
67	! dtime pas de temps de la physique (en s)
68	! jour jour dans l'annee en cours
69	! nisurf index de la surface a traiter (1 = sol continental)
70	! knon nombre de points de la surface a traiter
71	! knindex index des points de la surface a traiter
72	! rlon longitudes
73	! rlat latitudes
74	! debut logical: 1er appel a la physique
75	! lafin logical: dernier appel a la physique
76	! ok_veget logical: appel ou non au schema de surface continental
77	! (si false calcul simplifie des fluxs sur les continents)
78	! zlev hauteur de la premiere couche
79	! zlflu epaisseur de la premier couche
80	! u1_lay vitesse u 1ere couche
81	! v1_lay vitesse v 1ere couche
82	! temp_air temperature de l'air 1ere couche
83	! spechum humidite specifique 1ere couche
84	! hum_air humidite de l'air
85	! ccanopy concentration CO2 canopee
86	! tq_cdrag cdrag
87	! petAcoef coeff. A de la resolution de la CL pour t
88	! peqAcoef coeff. A de la resolution de la CL pour q
89	! petBcoef coeff. B de la resolution de la CL pour t
90	! peqBcoef coeff. B de la resolution de la CL pour q
91	! precip_rain precipitation liquide
92	! precip_snow precipitation solide
93	! lwdown flux IR entrant a la surface
94	! swnet flux solaire net
95	! swdown flux solaire entrant a la surface
96	! ps pression au sol
97	! ocean type d'ocean utilise (force, slab, couple)
98	!
99	! output:
100	! evap evaporation totale
101	! fluxsens flux de chaleur sensible
102	! fluxlat flux de chaleur latente
103	! tsol_rad
104	! tsurf_new temperature au sol
105	! alb_new albedo
106	! emis_new emissivite
107	! z0_new surface roughness
108
109	include 'indicesol.h'
110
111	! Parametres d'entree
112	integer, intent(IN) :: itime
113	integer, intent(IN) :: klon
114	integer, intent(IN) :: dtime
115	integer, intent(IN) :: jour
116	integer, intent(IN) :: nisurf
117	integer, intent(IN) :: knon
118	integer, dimension(knon), intent(in) :: knindex
119	logical, intent(IN) :: debut, lafin, ok_veget
120	real, dimension(klon), intent(IN) :: rlon, rlat
121	real, dimension(knon), intent(IN) :: zlev, zlflu
122	real, dimension(knon), intent(IN) :: u1_lay, v1_lay
123	real, dimension(knon), intent(IN) :: temp_air, spechum
124	real, dimension(knon), intent(IN) :: hum_air, ccanopy
125	real, dimension(knon), intent(IN) :: tq_cdrag, petAcoef, peqAcoef
126	real, dimension(knon), intent(IN) :: petBcoef, peqBcoef
127	real, dimension(knon), intent(IN) :: precip_rain, precip_snow
128	real, dimension(knon), intent(IN) :: lwdown, swnet, swdown, ps
129	character (len = 6) :: ocean
130
131	! Parametres de sortie
132	real, dimension(knon), intent(OUT):: evap, fluxsens, fluxlat
133	real, dimension(knon), intent(OUT):: tsol_rad, tsurf_new, alb_new
134	real, dimension(knon), intent(OUT):: emis_new, z0_new
135	real, dimension(klon,nbsrf), intent(OUT) :: pctsrf_new
136
137	! Local
138	character (len = 20) :: modname = 'interfsurf_hq'
139	character (len = 80) :: abort_message
140	logical, save :: first_call = .true.
141	integer :: error
142
143
144	!
145	! On doit commencer par appeler les schemas de surfaces continentales
146	! car l'ocean a besoin du ruissellement qui est y calcule
147	!
148	if (first_call) then
149	if (nisurf /= is_ter) then
150	write(,)' * Warning *'
151	write(,)' nisurf = ',nisurf,' /= is_ter = ',is_ter
152	write(,)'or on doit commencer par les surfaces continentales'
153	abort_message='voir ci-dessus'
154	call abort_gcm(modname,abort_message,1)
155	endif
156	if (ocean /= 'slab ' .and. ocean /= 'force ' .and. ocean /= 'couple') then
157	write(,)' * Warning *'
158	write(,)'Option couplage pour l''ocean = ', ocean
159	abort_message='option pour l''ocean non valable'
160	call abort_gcm(modname,abort_message,1)
161	endif
162	endif
163	first_call = .false.
164	!
165	! Aiguillage vers les differents schemas de surface
166	!
167	if (nisurf == is_ter) then
168	!
169	! Surface "terre" appel a l'interface avec les sols continentaux
170	!
171	! allocation du run-off
172	if (.not. allocated(run_off)) then
173	allocate(run_off(knon), stat = error)
174	if (error /= 0) then
175	abort_message='Pb allocation run_off'
176	call abort_gcm(modname,abort_message,1)
177	endif
178	else if (size(run_off) /= knon) then
179	write(,)'Bizarre, le nombre de points continentaux'
180	write(,)'a change entre deux appels. Je continue ...'
181	deallocate(run_off, stat = error)
182	allocate(run_off(knon), stat = error)
183	if (error /= 0) then
184	abort_message='Pb allocation run_off'
185	call abort_gcm(modname,abort_message,1)
186	endif
187	endif
188	!
189	call interfsol(itime, klon, dtime, nisurf, knon, &
190	& knindex, rlon, rlat, debut, lafin, &
191	& zlev, zlflu, u1_lay, v1_lay, temp_air, spechum, hum_air, ccanopy, &
192	& tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
193	& precip_rain, precip_snow, lwdown, swnet, swdown, ps, &
194	& evap, fluxsens, fluxlat, &
195	& tsol_rad, tsurf_new, alb_new, emis_new, z0_new)
196	!
197	else if (nisurf == is_oce) then
198	!
199	! Surface "ocean" appel a l'interface avec l'ocean
200	!
201	if (ocean == 'couple') then
202	call interfoce(nisurf, ocean)
203	else if (ocean == 'slab ') then
204	call interfoce(nisurf)
205	else ! lecture conditions limites
206	call interfoce(itime, dtime, jour, &
207	& klon, nisurf, knon, knindex, &
208	& debut, &
209	& tsurf_new, alb_new, z0_new, pctsrf_new)
210	endif
211	!
212	else if (nisurf == is_sic) then
213	!
214	! Surface "glace de mer" appel a l'interface avec l'ocean
215	!
216	call interfoce(nisurf, ocean)
217	!
218	else if (nisurf == is_lic) then
219	!
220	! Surface "glacier continentaux" appel a l'interface avec le sol
221	!
222	! call interfsol(nisurf)
223	else
224	write(,)'Index surface = ',nisurf
225	abort_message = 'Index surface non valable'
226	call abort_gcm(modname,abort_message,1)
227	endif
228
229	END SUBROUTINE interfsurf_hq
230
231	!
232	!#########################################################################
233	!
234	SUBROUTINE interfsurf_vent(nisurf, knon &
235	& )
236	!
237	! Cette routine sert d'aiguillage entre l'atmosphere et la surface en general
238	! (sols continentaux, oceans, glaces) pour les tensions de vents.
239	! En pratique l'interface se fait entre la couche limite du modele
240	! atmospherique (clmain.F) et les routines de surface (sechiba, oasis, ...)
241	!
242	!
243	! L.Fairhead 02/2000
244	!
245	! input:
246	! nisurf index de la surface a traiter (1 = sol continental)
247	! knon nombre de points de la surface a traiter
248
249	! Parametres d'entree
250	integer, intent(IN) :: nisurf
251	integer, intent(IN) :: knon
252
253
254	return
255	END SUBROUTINE interfsurf_vent
256	!
257	!#########################################################################
258	!
259	SUBROUTINE interfsol(itime, klon, dtime, nisurf, knon, &
260	& knindex, rlon, rlat, debut, lafin, &
261	& zlev, zlflu, u1_lay, v1_lay, temp_air, spechum, hum_air, ccanopy, &
262	& tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
263	& precip_rain, precip_snow, lwdown, swnet, swdown, ps, &
264	& evap, fluxsens, fluxlat, &
265	& tsol_rad, tsurf_new, alb_new, emis_new, z0_new)
266
267	! Cette routine sert d'interface entre le modele atmospherique et le
268	! modele de sol continental. Appel a sechiba
269	!
270	! L. Fairhead 02/2000
271	!
272	! input:
273	! itime numero du pas de temps
274	! klon nombre total de points de grille
275	! dtime pas de temps de la physique (en s)
276	! nisurf index de la surface a traiter (1 = sol continental)
277	! knon nombre de points de la surface a traiter
278	! knindex index des points de la surface a traiter
279	! rlon longitudes de la grille entiere
280	! rlat latitudes de la grille entiere
281	! debut logical: 1er appel a la physique (lire les restart)
282	! lafin logical: dernier appel a la physique (ecrire les restart)
283	! zlev hauteur de la premiere couche
284	! zlflu
285	! u1_lay vitesse u 1ere couche
286	! v1_lay vitesse v 1ere couche
287	! temp_air temperature de l'air 1ere couche
288	! spechum humidite specifique 1ere couche
289	! hum_air humidite de l'air
290	! ccanopy concentration CO2 canopee
291	! tq_cdrag cdrag
292	! petAcoef coeff. A de la resolution de la CL pour t
293	! peqAcoef coeff. A de la resolution de la CL pour q
294	! petBcoef coeff. B de la resolution de la CL pour t
295	! peqBcoef coeff. B de la resolution de la CL pour q
296	! precip_rain precipitation liquide
297	! precip_snow precipitation solide
298	! lwdown flux IR entrant a la surface
299	! swnet flux solaire net
300	! swdown flux solaire entrant a la surface
301	! ps pression au sol
302	!
303	! input/output
304	! run_off ruissellement total
305	!
306	! output:
307	! evap evaporation totale
308	! fluxsens flux de chaleur sensible
309	! fluxlat flux de chaleur latente
310	! tsol_rad
311	! tsurf_new temperature au sol
312	! alb_new albedo
313	! emis_new emissivite
314	! z0_new surface roughness
315
316	! Parametres d'entree
317	integer, intent(IN) :: itime
318	integer, intent(IN) :: klon
319	integer, intent(IN) :: dtime
320	integer, intent(IN) :: nisurf
321	integer, intent(IN) :: knon
322	integer, dimension(knon), intent(IN) :: knindex
323	logical, intent(IN) :: debut, lafin
324	real, dimension(klon), intent(IN) :: rlon, rlat
325	real, dimension(knon), intent(IN) :: zlev, zlflu
326	real, dimension(knon), intent(IN) :: u1_lay, v1_lay
327	real, dimension(knon), intent(IN) :: temp_air, spechum
328	real, dimension(knon), intent(IN) :: hum_air, ccanopy
329	real, dimension(knon), intent(IN) :: tq_cdrag, petAcoef, peqAcoef
330	real, dimension(knon), intent(IN) :: petBcoef, peqBcoef
331	real, dimension(knon), intent(IN) :: precip_rain, precip_snow
332	real, dimension(knon), intent(IN) :: lwdown, swnet, swdown, ps
333
334	! Parametres de sortie
335	real, dimension(knon), intent(OUT):: evap, fluxsens, fluxlat
336	real, dimension(knon), intent(OUT):: tsol_rad, tsurf_new, alb_new
337	real, dimension(knon), intent(OUT):: emis_new, z0_new
338
339	! Local
340	!
341	integer :: ii
342	integer :: error
343	character (len = 20) :: modname = 'interfsol'
344	character (len = 80) :: abort_message
345	! type de couplage dans sechiba
346	character (len=10) :: coupling = 'implicit'
347	! drapeaux controlant les appels dans SECHIBA
348	type(control_type), save :: control_in
349	! coordonnees geographiques
350	real, allocatable, dimension(:,:), save :: lalo
351	! pts voisins
352	integer,allocatable, dimension(:,:), save :: neighbours
353	! resolution de la grille
354	real, allocatable, dimension (:,:), save :: resolution
355	! Identifieurs des fichiers restart et histoire
356	integer, save :: rest_id, hist_id
357	integer, save :: rest_id_stom, hist_id_stom
358
359
360	! initialisation
361	if (debut) then
362	!
363	! Configuration de parametres specifiques a la SSL
364	!
365	call intsurf_config(control_in)
366	!
367	! Allouer et initialiser le tableau de coordonnees du sol
368	!
369	if (( .not. allocated(lalo))) then
370	allocate(lalo(knon,2), stat = error)
371	if (error /= 0) then
372	abort_message='Pb allocation lalo'
373	call abort_gcm(modname,abort_message,1)
374	endif
375	endif
376	do ii = 1, knon
377	lalo(ii,1) = rlat(knindex(ii))
378	lalo(ii,2) = rlon(knindex(ii))
379	enddo
380	!-
381	!- Compute variable to help describe the grid
382	!- once the points are gathered.
383	!-
384	IF ( (.NOT.ALLOCATED(neighbours))) THEN
385	ALLOCATE(neighbours(knon,4), stat = error)
386	if (error /= 0) then
387	abort_message='Pb allocation neighbours'
388	call abort_gcm(modname,abort_message,1)
389	endif
390	ENDIF
391	IF ( (.NOT.ALLOCATED(resolution))) THEN
392	ALLOCATE(resolution(knon,2), stat = error)
393	if (error /= 0) then
394	abort_message='Pb allocation resolution'
395	call abort_gcm(modname,abort_message,1)
396	endif
397	ENDIF
398
399	! call grid_stuff
400	! call sechiba_restart_init
401	! call sechiba_history_init
402
403	endif ! (fin debut)
404
405	!
406	! Appel a la routine sols continentaux
407	!
408
409	call sechiba_main(itime, klon, knon, knindex, dtime, &
410	& debut, lafin, coupling, control_in, &
411	& lalo, neighbours, resolution,&
412	& zlev, zlflu, u1_lay, v1_lay, spechum, temp_air,hum_air , ccanopy, &
413	& tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
414	& precip_rain, precip_snow, lwdown, swnet, swdown, ps, &
415	& evap, fluxsens, fluxlat, &
416	& tsol_rad, tsurf_new, alb_new, emis_new, z0_new, &
417	& rest_id, hist_id, rest_id_stom, hist_id_stom)
418
419	!
420	! Sauvegarde dans fichiers histoire
421	!
422
423	END SUBROUTINE interfsol
424	!
425	!#########################################################################
426	!
427	SUBROUTINE interfoce_cpl(nisurf, ocean)
428
429	! Cette routine sert d'interface entre le modele atmospherique et un
430	! coupleur avec un modele d'ocean 'complet'
431	!
432	! L. Fairhead 02/2000
433	!
434	! input:
435	! nisurf index de la surface a traiter (1 = sol continental)
436	! ocean type d'ocean
437	!
438	! output:
439	!
440
441	! Parametres d'entree
442	integer, intent(IN) :: nisurf
443	character (len = 6) :: ocean
444
445	! Parametres de sortie
446
447	! Variables locales
448
449
450	! Initialisation
451	! fichier restart et fichiers histoires
452
453	! calcul des fluxs a passer
454
455	END SUBROUTINE interfoce_cpl
456	!
457	!#########################################################################
458	!
459	SUBROUTINE interfoce_slab(nisurf)
460
461	! Cette routine sert d'interface entre le modele atmospherique et un
462	! modele de 'slab' ocean
463	!
464	! L. Fairhead 02/2000
465	!
466	! input:
467	! nisurf index de la surface a traiter (1 = sol continental)
468	!
469	! output:
470	!
471
472	! Parametres d'entree
473	integer, intent(IN) :: nisurf
474
475	END SUBROUTINE interfoce_slab
476	!
477	!#########################################################################
478	!
479	SUBROUTINE interfoce_lim(itime, dtime, jour, &
480	& klon, nisurf, knon, knindex, &
481	& debut, &
482	& lmt_sst, lmt_alb, lmt_rug, pctsrf_new)
483
484	! Cette routine sert d'interface entre le modele atmospherique et un
485	!
486	! L. Fairhead 02/2000
487	!
488	! input:
489	! itime numero du pas de temps courant
490	! dtime pas de temps de la physique (en s)
491	! jour jour a lire dans l'annee
492	! nisurf index de la surface a traiter (1 = sol continental)
493	! knon nombre de points dans le domaine a traiter
494	! knindex index des points de la surface a traiter
495	! klon taille de la grille
496	! debut logical: 1er appel a la physique (initialisation)
497	!
498	! output:
499	! lmt_sst SST lues dans le fichier de CL
500	! lmt_alb Albedo lu
501	! lmt_rug longueur de rugosité lue
502	! pctsrf_new sous-maille fractionnelle
503	!
504
505	#include "indicesol.h"
506
507	! Parametres d'entree
508	integer, intent(IN) :: itime
509	integer, intent(IN) :: dtime
510	integer, intent(IN) :: jour
511	integer, intent(IN) :: nisurf
512	integer, intent(IN) :: knon
513	integer, intent(IN) :: klon
514	integer, dimension(knon), intent(in) :: knindex
515	logical, intent(IN) :: debut
516
517	! Parametres de sortie
518	real, intent(out), dimension(knon) :: lmt_sst
519	real, intent(out), dimension(knon) :: lmt_alb
520	real, intent(out), dimension(knon) :: lmt_rug
521	real, intent(out), dimension(klon,nbsrf) :: pctsrf_new
522
523	! Variables locales
524	integer :: ii
525	integer :: lmt_pas ! frequence de lecture des conditions limites
526	! (en pas de physique)
527	logical,save :: deja_lu ! pour indiquer que le jour a lire a deja
528	! lu pour une surface precedente
529	integer,save :: jour_lu
530	integer :: ierr
531	character (len = 20) :: modname = 'interfoce_lim'
532	character (len = 80) :: abort_message
533	character (len = 20) :: fich ='limit'
534	logical :: newlmt = .false.
535	logical :: check = .true.
536	! Champs lus dans le fichier de CL
537	real, allocatable , save, dimension(:) :: sst_lu, alb_lu, rug_lu, nat_lu
538	real, allocatable , save, dimension(:,:) :: pct_tmp
539	!
540	! quelques variables pour netcdf
541	!
542	#include "netcdf.inc"
543	integer :: nid, nvarid
544	integer, dimension(2) :: start, epais
545	!
546	! Fin déclaration
547	!
548
549	if (debut) then
550	lmt_pas = nint(86400./dtime * 1.0) ! pour une lecture une fois par jour
551	jour_lu = jour - 1
552	allocate(sst_lu(klon))
553	allocate(alb_lu(klon))
554	allocate(rug_lu(klon))
555	allocate(nat_lu(klon))
556	allocate(pct_tmp(klon,nbsrf))
557	endif
558
559	if ((jour - jour_lu) /= 0) deja_lu = .false.
560
561	if (check) write(,)modname,' :: jour_lu, deja_lu', jour_lu, deja_lu
562
563	! Tester d'abord si c'est le moment de lire le fichier
564	if (mod(itime-1, lmt_pas) == 0 .and. .not. deja_lu) then
565	!
566	! Ouverture du fichier
567	!
568	ierr = NF_OPEN (fich, NF_NOWRITE,nid)
569	if (ierr.NE.NF_NOERR) then
570	abort_message = 'Pb d''ouverture du fichier de conditions aux limites'
571	call abort_gcm(modname,abort_message,1)
572	endif
573	!
574	! La tranche de donnees a lire:
575	!
576	start(1) = 1
577	start(2) = jour + 1
578	epais(1) = klon
579	epais(2) = 1
580	!
581	if (newlmt) then
582	!
583	! Fraction "ocean"
584	!
585	ierr = NF_INQ_VARID(nid, 'FOCE', nvarid)
586	if (ierr /= NF_NOERR) then
587	abort_message = 'Le champ <FOCE> est absent'
588	call abort_gcm(modname,abort_message,1)
589	endif
590	#ifdef NC_DOUBLE
591	ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais,pctsrf_new(1,is_oce))
592	#else
593	ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais,pctsrf_new(1,is_oce))
594	#endif
595	if (ierr /= NF_NOERR) then
596	abort_message = 'Lecture echouee pour <FOCE>'
597	call abort_gcm(modname,abort_message,1)
598	endif
599	!
600	! Fraction "glace de mer"
601	!
602	ierr = NF_INQ_VARID(nid, 'FSIC', nvarid)
603	if (ierr /= NF_NOERR) then
604	abort_message = 'Le champ <FSIC> est absent'
605	call abort_gcm(modname,abort_message,1)
606	endif
607	#ifdef NC_DOUBLE
608	ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais,pctsrf_new(1,is_sic))
609	#else
610	ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais,pctsrf_new(1,is_sic))
611	#endif
612	if (ierr /= NF_NOERR) then
613	abort_message = 'Lecture echouee pour <FSIC>'
614	call abort_gcm(modname,abort_message,1)
615	endif
616	!
617	! Fraction "terre"
618	!
619	ierr = NF_INQ_VARID(nid, 'FTER', nvarid)
620	if (ierr /= NF_NOERR) then
621	abort_message = 'Le champ <FTER> est absent'
622	call abort_gcm(modname,abort_message,1)
623	endif
624	#ifdef NC_DOUBLE
625	ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais,pctsrf_new(1,is_ter))
626	#else
627	ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais,pctsrf_new(1,is_ter))
628	#endif
629	if (ierr /= NF_NOERR) then
630	abort_message = 'Lecture echouee pour <FTER>'
631	call abort_gcm(modname,abort_message,1)
632	endif
633	!
634	! Fraction "glacier terre"
635	!
636	ierr = NF_INQ_VARID(nid, 'FLIC', nvarid)
637	if (ierr /= NF_NOERR) then
638	abort_message = 'Le champ <FLIC> est absent'
639	call abort_gcm(modname,abort_message,1)
640	endif
641	#ifdef NC_DOUBLE
642	ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais,pctsrf_new(1,is_lic))
643	#else
644	ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais,pctsrf_new(1,is_lic))
645	#endif
646	if (ierr /= NF_NOERR) then
647	abort_message = 'Lecture echouee pour <FLIC>'
648	call abort_gcm(modname,abort_message,1)
649	endif
650	!
651	else ! on en est toujours a rnatur
652	!
653	ierr = NF_INQ_VARID(nid, 'NAT', nvarid)
654	if (ierr /= NF_NOERR) then
655	abort_message = 'Le champ <NAT> est absent'
656	call abort_gcm(modname,abort_message,1)
657	endif
658	#ifdef NC_DOUBLE
659	ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais, nat_lu)
660	#else
661	ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais, nat_lu)
662	#endif
663	if (ierr /= NF_NOERR) then
664	abort_message = 'Lecture echouee pour <NAT>'
665	call abort_gcm(modname,abort_message,1)
666	endif
667	!
668	! Remplissage des fractions de surface
669	! nat = 0, 1, 2, 3 pour ocean, terre, glacier, seaice
670	!
671	pct_tmp = 0.0
672	do ii = 1, klon
673	pct_tmp(ii,nint(nat_lu(ii)) + 1) = 1.
674	enddo
675
676	!
677	! On se retrouve avec ocean en 1 et terre en 2 alors qu'on veut le contraire
678	!
679	pctsrf_new = pct_tmp
680	pctsrf_new (:,2)= pct_tmp (:,1)
681	pctsrf_new (:,1)= pct_tmp (:,2)
682	pct_tmp = pctsrf_new
683	endif ! fin test sur newlmt
684	!
685	! Lecture SST
686	!
687	ierr = NF_INQ_VARID(nid, 'SST', nvarid)
688	if (ierr /= NF_NOERR) then
689	abort_message = 'Le champ <SST> est absent'
690	call abort_gcm(modname,abort_message,1)
691	endif
692	#ifdef NC_DOUBLE
693	ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais, sst_lu)
694	#else
695	ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais, sst_lu)
696	#endif
697	if (ierr /= NF_NOERR) then
698	abort_message = 'Lecture echouee pour <SST>'
699	call abort_gcm(modname,abort_message,1)
700	endif
701	!
702	! Lecture Albedo
703	!
704	ierr = NF_INQ_VARID(nid, 'ALB', nvarid)
705	if (ierr /= NF_NOERR) then
706	abort_message = 'Le champ <ALB> est absent'
707	call abort_gcm(modname,abort_message,1)
708	endif
709	#ifdef NC_DOUBLE
710	ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais, alb_lu)
711	#else
712	ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais, alb_lu)
713	#endif
714	if (ierr /= NF_NOERR) then
715	abort_message = 'Lecture echouee pour <ALB>'
716	call abort_gcm(modname,abort_message,1)
717	endif
718	!
719	! Lecture rugosité
720	!
721	ierr = NF_INQ_VARID(nid, 'RUG', nvarid)
722	if (ierr /= NF_NOERR) then
723	abort_message = 'Le champ <RUG> est absent'
724	call abort_gcm(modname,abort_message,1)
725	endif
726	#ifdef NC_DOUBLE
727	ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais, rug_lu)
728	#else
729	ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais, rug_lu)
730	#endif
731	if (ierr /= NF_NOERR) then
732	abort_message = 'Lecture echouee pour <RUG>'
733	call abort_gcm(modname,abort_message,1)
734	endif
735
736	!
737	! Fin de lecture
738	!
739	ierr = NF_CLOSE(nid)
740	deja_lu = .true.
741	jour_lu = jour
742	endif
743	!
744	! Recopie des variables dans les champs de sortie
745	!
746	do ii = 1, knon
747	lmt_sst(ii) = sst_lu(knindex(ii))
748	lmt_alb(ii) = alb_lu(knindex(ii))
749	lmt_rug(ii) = rug_lu(knindex(ii))
750	enddo
751	pctsrf_new = pct_tmp
752
753	END SUBROUTINE interfoce_lim
754
755	!
756	!#########################################################################
757	!
758	END MODULE interface_surf

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

Download in other formats:

Original Format