Context Navigation

surf_land_orchidee_mod.F90 @ 1176

Last change on this file since 1176 was 1144, checked in by jghattas, 15 years ago
Ajoute des variables q2m et t2m comme argument d'entrees dans ORCHIDEE. Pour cela, ajoute de la calcul de ces variables avec stdlevvar avant calcul sur sous-surface.
Property svn:eol-style set to `native` Property svn:executable set to ``* Property svn:keywords set to `Author Date Id Revision`
File size: 21.3 KB

Line
1	!
2	MODULE surf_land_orchidee_mod
3	#ifndef ORCHIDEE_NOOPENMP
4	!
5	! This module controles the interface towards the model ORCHIDEE
6	!
7	! Subroutines in this module : surf_land_orchidee
8	! Init_orchidee_index
9	! Get_orchidee_communicator
10	! Init_neighbours
11
12	USE dimphy
13	#ifdef CPP_VEGET
14	USE intersurf ! module d'ORCHIDEE
15	#endif
16	USE cpl_mod, ONLY : cpl_send_land_fields
17	USE surface_data, ONLY : type_ocean
18	USE comgeomphy, ONLY : cuphy, cvphy
19	USE mod_grid_phy_lmdz
20	USE mod_phys_lmdz_para, mpi_root_rank=>mpi_root
21
22	IMPLICIT NONE
23
24	PRIVATE
25	PUBLIC :: surf_land_orchidee
26
27	LOGICAL, ALLOCATABLE, SAVE :: flag_omp(:)
28	CONTAINS
29	!
30	!****************************************************************************************
31	!
32	SUBROUTINE surf_land_orchidee(itime, dtime, date0, knon, &
33	knindex, rlon, rlat, pctsrf, &
34	debut, lafin, &
35	plev, u1_lay, v1_lay, temp_air, spechum, epot_air, ccanopy, &
36	tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
37	precip_rain, precip_snow, lwdown, swnet, swdown, &
38	ps, q2m, t2m, &
39	evap, fluxsens, fluxlat, &
40	tsol_rad, tsurf_new, alb1_new, alb2_new, &
41	emis_new, z0_new, qsurf)
42	USE mod_surf_para
43	USE mod_synchro_omp
44
45	!
46	! Cette routine sert d'interface entre le modele atmospherique et le
47	! modele de sol continental. Appel a sechiba
48	!
49	! L. Fairhead 02/2000
50	!
51	! input:
52	! itime numero du pas de temps
53	! dtime pas de temps de la physique (en s)
54	! nisurf index de la surface a traiter (1 = sol continental)
55	! knon nombre de points de la surface a traiter
56	! knindex index des points de la surface a traiter
57	! rlon longitudes de la grille entiere
58	! rlat latitudes de la grille entiere
59	! pctsrf tableau des fractions de surface de chaque maille
60	! debut logical: 1er appel a la physique (lire les restart)
61	! lafin logical: dernier appel a la physique (ecrire les restart)
62	! (si false calcul simplifie des fluxs sur les continents)
63	! plev hauteur de la premiere couche (Pa)
64	! u1_lay vitesse u 1ere couche
65	! v1_lay vitesse v 1ere couche
66	! temp_air temperature de l'air 1ere couche
67	! spechum humidite specifique 1ere couche
68	! epot_air temp pot de l'air
69	! ccanopy concentration CO2 canopee
70	! tq_cdrag cdrag
71	! petAcoef coeff. A de la resolution de la CL pour t
72	! peqAcoef coeff. A de la resolution de la CL pour q
73	! petBcoef coeff. B de la resolution de la CL pour t
74	! peqBcoef coeff. B de la resolution de la CL pour q
75	! precip_rain precipitation liquide
76	! precip_snow precipitation solide
77	! lwdown flux IR descendant a la surface
78	! swnet flux solaire net
79	! swdown flux solaire entrant a la surface
80	! ps pression au sol
81	! radsol rayonnement net aus sol (LW + SW)
82	!
83	!
84	! output:
85	! evap evaporation totale
86	! fluxsens flux de chaleur sensible
87	! fluxlat flux de chaleur latente
88	! tsol_rad
89	! tsurf_new temperature au sol
90	! alb1_new albedo in visible SW interval
91	! alb2_new albedo in near IR interval
92	! emis_new emissivite
93	! z0_new surface roughness
94	! qsurf air moisture at surface
95	!
96	INCLUDE "indicesol.h"
97	INCLUDE "temps.h"
98	INCLUDE "YOMCST.h"
99	INCLUDE "iniprint.h"
100	INCLUDE "dimensions.h"
101
102	!
103	! Parametres d'entree
104	!****************************************************************************************
105	INTEGER, INTENT(IN) :: itime
106	REAL, INTENT(IN) :: dtime
107	REAL, INTENT(IN) :: date0
108	INTEGER, INTENT(IN) :: knon
109	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
110	LOGICAL, INTENT(IN) :: debut, lafin
111	REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
112	REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat
113	REAL, DIMENSION(klon), INTENT(IN) :: plev
114	REAL, DIMENSION(klon), INTENT(IN) :: u1_lay, v1_lay
115	REAL, DIMENSION(klon), INTENT(IN) :: temp_air, spechum
116	REAL, DIMENSION(klon), INTENT(IN) :: epot_air, ccanopy
117	REAL, DIMENSION(klon), INTENT(IN) :: tq_cdrag
118	REAL, DIMENSION(klon), INTENT(IN) :: petAcoef, peqAcoef
119	REAL, DIMENSION(klon), INTENT(IN) :: petBcoef, peqBcoef
120	REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow
121	REAL, DIMENSION(klon), INTENT(IN) :: lwdown, swnet, swdown, ps
122	REAL, DIMENSION(klon), INTENT(IN) :: q2m, t2m
123
124	! Parametres de sortie
125	!****************************************************************************************
126	REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat, qsurf
127	REAL, DIMENSION(klon), INTENT(OUT) :: tsol_rad, tsurf_new
128	REAL, DIMENSION(klon), INTENT(OUT) :: alb1_new, alb2_new
129	REAL, DIMENSION(klon), INTENT(OUT) :: emis_new, z0_new
130
131	! Local
132	!****************************************************************************************
133	INTEGER :: ij, jj, igrid, ireal, index
134	INTEGER :: error
135	REAL, DIMENSION(klon) :: swdown_vrai
136	CHARACTER (len = 20) :: modname = 'surf_land_orchidee'
137	CHARACTER (len = 80) :: abort_message
138	LOGICAL,SAVE :: check = .FALSE.
139	!$OMP THREADPRIVATE(check)
140
141	! type de couplage dans sechiba
142	! character (len=10) :: coupling = 'implicit'
143	! drapeaux controlant les appels dans SECHIBA
144	! type(control_type), save :: control_in
145	! Preserved albedo
146	REAL, ALLOCATABLE, DIMENSION(:), SAVE :: albedo_keep, zlev
147	!$OMP THREADPRIVATE(albedo_keep,zlev)
148	! coordonnees geographiques
149	REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: lalo
150	!$OMP THREADPRIVATE(lalo)
151	! pts voisins
152	INTEGER,ALLOCATABLE, DIMENSION(:,:), SAVE :: neighbours
153	!$OMP THREADPRIVATE(neighbours)
154	! fractions continents
155	REAL,ALLOCATABLE, DIMENSION(:), SAVE :: contfrac
156	!$OMP THREADPRIVATE(contfrac)
157	! resolution de la grille
158	REAL, ALLOCATABLE, DIMENSION (:,:), SAVE :: resolution
159	!$OMP THREADPRIVATE(resolution)
160
161	REAL, ALLOCATABLE, DIMENSION (:,:), SAVE :: lon_scat, lat_scat
162	!$OMP THREADPRIVATE(lon_scat,lat_scat)
163
164	LOGICAL, SAVE :: lrestart_read = .TRUE.
165	!$OMP THREADPRIVATE(lrestart_read)
166	LOGICAL, SAVE :: lrestart_write = .FALSE.
167	!$OMP THREADPRIVATE(lrestart_write)
168
169	REAL, DIMENSION(knon,2) :: albedo_out
170
171	! Pb de nomenclature
172	REAL, DIMENSION(klon) :: petA_orc, peqA_orc
173	REAL, DIMENSION(klon) :: petB_orc, peqB_orc
174	! Pb de correspondances de grilles
175	INTEGER, DIMENSION(:), SAVE, ALLOCATABLE :: ig, jg
176	!$OMP THREADPRIVATE(ig,jg)
177	INTEGER :: indi, indj
178	INTEGER, SAVE, ALLOCATABLE,DIMENSION(:) :: ktindex
179	!$OMP THREADPRIVATE(ktindex)
180
181	! Essai cdrag
182	REAL, DIMENSION(klon) :: cdrag
183	INTEGER,SAVE :: offset
184	!$OMP THREADPRIVATE(offset)
185
186	REAL, DIMENSION(klon_glo) :: rlon_g,rlat_g
187	INTEGER, SAVE :: orch_comm
188	!$OMP THREADPRIVATE(orch_comm)
189
190	REAL, ALLOCATABLE, DIMENSION(:), SAVE :: coastalflow
191	!$OMP THREADPRIVATE(coastalflow)
192	REAL, ALLOCATABLE, DIMENSION(:), SAVE :: riverflow
193	!$OMP THREADPRIVATE(riverflow)
194
195	INTEGER :: orch_omp_rank
196	INTEGER :: orch_omp_size
197	!
198	! Fin definition
199	!****************************************************************************************
200
201	IF (check) WRITE(lunout,*)'Entree ', modname
202
203	! Initialisation
204
205	IF (debut) THEN
206	! Test of coherence between variable ok_veget and cpp key CPP_VEGET
207	#ifndef CPP_VEGET
208	abort_message='Pb de coherence: ok_veget = .true. mais CPP_VEGET = .false.'
209	CALL abort_gcm(modname,abort_message,1)
210	#endif
211
212	CALL Init_surf_para(knon)
213	ALLOCATE(ktindex(knon))
214	IF ( .NOT. ALLOCATED(albedo_keep)) THEN
215	!ym ALLOCATE(albedo_keep(klon))
216	!ym bizarre que non alloué en knon precedement
217	ALLOCATE(albedo_keep(knon))
218	ALLOCATE(zlev(knon))
219	ENDIF
220	! Pb de correspondances de grilles
221	ALLOCATE(ig(klon))
222	ALLOCATE(jg(klon))
223	ig(1) = 1
224	jg(1) = 1
225	indi = 0
226	indj = 2
227	DO igrid = 2, klon - 1
228	indi = indi + 1
229	IF ( indi > iim) THEN
230	indi = 1
231	indj = indj + 1
232	ENDIF
233	ig(igrid) = indi
234	jg(igrid) = indj
235	ENDDO
236	ig(klon) = 1
237	jg(klon) = jjm + 1
238
239	IF ((.NOT. ALLOCATED(lalo))) THEN
240	ALLOCATE(lalo(knon,2), stat = error)
241	IF (error /= 0) THEN
242	abort_message='Pb allocation lalo'
243	CALL abort_gcm(modname,abort_message,1)
244	ENDIF
245	ENDIF
246	IF ((.NOT. ALLOCATED(lon_scat))) THEN
247	ALLOCATE(lon_scat(iim,jjm+1), stat = error)
248	IF (error /= 0) THEN
249	abort_message='Pb allocation lon_scat'
250	CALL abort_gcm(modname,abort_message,1)
251	ENDIF
252	ENDIF
253	IF ((.NOT. ALLOCATED(lat_scat))) THEN
254	ALLOCATE(lat_scat(iim,jjm+1), stat = error)
255	IF (error /= 0) THEN
256	abort_message='Pb allocation lat_scat'
257	CALL abort_gcm(modname,abort_message,1)
258	ENDIF
259	ENDIF
260	lon_scat = 0.
261	lat_scat = 0.
262	DO igrid = 1, knon
263	index = knindex(igrid)
264	lalo(igrid,2) = rlon(index)
265	lalo(igrid,1) = rlat(index)
266	ENDDO
267
268
269
270	CALL Gather(rlon,rlon_g)
271	CALL Gather(rlat,rlat_g)
272
273	IF (is_mpi_root) THEN
274	index = 1
275	DO jj = 2, jjm
276	DO ij = 1, iim
277	index = index + 1
278	lon_scat(ij,jj) = rlon_g(index)
279	lat_scat(ij,jj) = rlat_g(index)
280	ENDDO
281	ENDDO
282	lon_scat(:,1) = lon_scat(:,2)
283	lat_scat(:,1) = rlat_g(1)
284	lon_scat(:,jjm+1) = lon_scat(:,2)
285	lat_scat(:,jjm+1) = rlat_g(klon_glo)
286	ENDIF
287
288	CALL bcast(lon_scat)
289	CALL bcast(lat_scat)
290	!
291	! Allouer et initialiser le tableau des voisins et des fraction de continents
292	!
293	IF ( (.NOT.ALLOCATED(neighbours))) THEN
294	ALLOCATE(neighbours(knon,8), stat = error)
295	IF (error /= 0) THEN
296	abort_message='Pb allocation neighbours'
297	CALL abort_gcm(modname,abort_message,1)
298	ENDIF
299	ENDIF
300	neighbours = -1.
301	IF (( .NOT. ALLOCATED(contfrac))) THEN
302	ALLOCATE(contfrac(knon), stat = error)
303	IF (error /= 0) THEN
304	abort_message='Pb allocation contfrac'
305	CALL abort_gcm(modname,abort_message,1)
306	ENDIF
307	ENDIF
308
309	DO igrid = 1, knon
310	ireal = knindex(igrid)
311	contfrac(igrid) = pctsrf(ireal,is_ter)
312	ENDDO
313
314
315	CALL Init_neighbours(knon,neighbours,knindex,pctsrf(:,is_ter))
316
317	!
318	! Allocation et calcul resolutions
319	IF ( (.NOT.ALLOCATED(resolution))) THEN
320	ALLOCATE(resolution(knon,2), stat = error)
321	IF (error /= 0) THEN
322	abort_message='Pb allocation resolution'
323	CALL abort_gcm(modname,abort_message,1)
324	ENDIF
325	ENDIF
326	DO igrid = 1, knon
327	ij = knindex(igrid)
328	resolution(igrid,1) = cuphy(ij)
329	resolution(igrid,2) = cvphy(ij)
330	ENDDO
331
332	ALLOCATE(coastalflow(klon), stat = error)
333	IF (error /= 0) THEN
334	abort_message='Pb allocation coastalflow'
335	CALL abort_gcm(modname,abort_message,1)
336	ENDIF
337
338	ALLOCATE(riverflow(klon), stat = error)
339	IF (error /= 0) THEN
340	abort_message='Pb allocation riverflow'
341	CALL abort_gcm(modname,abort_message,1)
342	ENDIF
343
344	ENDIF ! (fin debut)
345
346	!
347	! Appel a la routine sols continentaux
348	!
349	IF (lafin) lrestart_write = .TRUE.
350	IF (check) WRITE(lunout,*)'lafin ',lafin,lrestart_write
351
352	petA_orc(1:knon) = petBcoef(1:knon) * dtime
353	petB_orc(1:knon) = petAcoef(1:knon)
354	peqA_orc(1:knon) = peqBcoef(1:knon) * dtime
355	peqB_orc(1:knon) = peqAcoef(1:knon)
356
357	cdrag = 0.
358	cdrag(1:knon) = tq_cdrag(1:knon)
359
360	! zlev(1:knon) = (100.plev(1:knon))/((ps(1:knon)/287.05temp_air(1:knon))*9.80665)
361	zlev(1:knon) = (100.plev(1:knon))/((ps(1:knon)/RDtemp_air(1:knon))*RG)
362
363
364	! PF et PASB
365	! where(cdrag > 0.01)
366	! cdrag = 0.01
367	! endwhere
368	! write(,)'Cdrag = ',minval(cdrag),maxval(cdrag)
369
370
371	IF (debut) THEN
372	CALL Init_orchidee_index(knon,knindex,offset,ktindex)
373	CALL Get_orchidee_communicator(orch_comm,orch_omp_size,orch_omp_rank)
374	CALL Init_synchro_omp
375
376	IF (knon > 0) THEN
377	#ifdef CPP_VEGET
378	CALL Init_intersurf(nbp_lon,nbp_lat,knon,ktindex,offset,orch_omp_size,orch_omp_rank,orch_comm)
379	#endif
380	ENDIF
381
382
383	IF (knon > 0) THEN
384
385	#ifdef CPP_VEGET
386	CALL intersurf_main (itime+itau_phy-1, iim, jjm+1, knon, ktindex, dtime, &
387	lrestart_read, lrestart_write, lalo, &
388	contfrac, neighbours, resolution, date0, &
389	zlev, u1_lay, v1_lay, spechum, temp_air, epot_air, ccanopy, &
390	cdrag, petA_orc, peqA_orc, petB_orc, peqB_orc, &
391	precip_rain, precip_snow, lwdown, swnet, swdown, ps, &
392	evap, fluxsens, fluxlat, coastalflow, riverflow, &
393	tsol_rad, tsurf_new, qsurf, albedo_out, emis_new, z0_new, &
394	lon_scat, lat_scat, q2m, t2m)
395	#endif
396	ENDIF
397
398	CALL Synchro_omp
399
400	albedo_keep(1:knon) = (albedo_out(1:knon,1)+albedo_out(1:knon,2))/2.
401
402	ENDIF
403
404
405	! swdown_vrai(1:knon) = swnet(1:knon)/(1. - albedo_keep(1:knon))
406	swdown_vrai(1:knon) = swdown(1:knon)
407
408	IF (knon > 0) THEN
409	#ifdef CPP_VEGET
410	CALL intersurf_main (itime+itau_phy, iim, jjm+1, knon, ktindex, dtime, &
411	lrestart_read, lrestart_write, lalo, &
412	contfrac, neighbours, resolution, date0, &
413	zlev, u1_lay(1:knon), v1_lay(1:knon), spechum(1:knon), temp_air(1:knon), epot_air(1:knon), ccanopy(1:knon), &
414	cdrag(1:knon), petA_orc(1:knon), peqA_orc(1:knon), petB_orc(1:knon), peqB_orc(1:knon), &
415	precip_rain(1:knon), precip_snow(1:knon), lwdown(1:knon), swnet(1:knon), swdown_vrai(1:knon), ps(1:knon), &
416	evap(1:knon), fluxsens(1:knon), fluxlat(1:knon), coastalflow(1:knon), riverflow(1:knon), &
417	tsol_rad(1:knon), tsurf_new(1:knon), qsurf(1:knon), albedo_out(1:knon,:), emis_new(1:knon), z0_new(1:knon), &
418	lon_scat, lat_scat, q2m, t2m)
419	#endif
420	ENDIF
421
422	CALL Synchro_omp
423
424	albedo_keep(1:knon) = (albedo_out(1:knon,1)+albedo_out(1:knon,2))/2.
425
426	!* Send to coupler
427	!
428	IF (type_ocean=='couple') THEN
429	CALL cpl_send_land_fields(itime, knon, knindex, &
430	riverflow, coastalflow)
431	ENDIF
432
433	alb1_new(1:knon) = albedo_out(1:knon,1)
434	alb2_new(1:knon) = albedo_out(1:knon,2)
435
436	! Convention orchidee: positif vers le haut
437	fluxsens(1:knon) = -1. * fluxsens(1:knon)
438	fluxlat(1:knon) = -1. * fluxlat(1:knon)
439
440	! evap = -1. * evap
441
442	IF (debut) lrestart_read = .FALSE.
443
444	IF (debut) CALL Finalize_surf_para
445
446	END SUBROUTINE surf_land_orchidee
447	!
448	!****************************************************************************************
449	!
450	SUBROUTINE Init_orchidee_index(knon,knindex,offset,ktindex)
451	USE mod_surf_para
452	USE mod_grid_phy_lmdz
453
454	INTEGER,INTENT(IN) :: knon
455	INTEGER,INTENT(IN) :: knindex(klon)
456	INTEGER,INTENT(OUT) :: offset
457	INTEGER,INTENT(OUT) :: ktindex(klon)
458
459	INTEGER :: ktindex_glo(knon_glo)
460	INTEGER :: offset_para(0:omp_size*mpi_size-1)
461	INTEGER :: LastPoint
462	INTEGER :: task
463
464	ktindex(1:knon)=knindex(1:knon)+(klon_mpi_begin-1)+(klon_omp_begin-1)+nbp_lon-1
465
466	CALL gather_surf(ktindex(1:knon),ktindex_glo)
467
468	IF (is_mpi_root .AND. is_omp_root) THEN
469	LastPoint=0
470	DO Task=0,mpi_size*omp_size-1
471	IF (knon_glo_para(Task)>0) THEN
472	offset_para(task)= LastPoint-MOD(LastPoint,nbp_lon)
473	LastPoint=ktindex_glo(knon_glo_end_para(task))
474	ENDIF
475	ENDDO
476	ENDIF
477
478	CALL bcast(offset_para)
479
480	offset=offset_para(omp_size*mpi_rank+omp_rank)
481
482	ktindex(1:knon)=ktindex(1:knon)-offset
483
484	END SUBROUTINE Init_orchidee_index
485
486	!
487	!*********************** *************************************************************
488	!
489
490	SUBROUTINE Get_orchidee_communicator(orch_comm,orch_omp_size,orch_omp_rank)
491	USE mod_surf_para
492
493	#ifdef CPP_MPI
494	INCLUDE 'mpif.h'
495	#endif
496
497	INTEGER,INTENT(OUT) :: orch_comm
498	INTEGER,INTENT(OUT) :: orch_omp_size
499	INTEGER,INTENT(OUT) :: orch_omp_rank
500	INTEGER :: color
501	INTEGER :: i,ierr
502	!
503	! End definition
504	!****************************************************************************************
505
506
507	IF (is_omp_root) THEN
508
509	IF (knon_mpi==0) THEN
510	color = 0
511	ELSE
512	color = 1
513	ENDIF
514
515	#ifdef CPP_MPI
516	CALL MPI_COMM_SPLIT(COMM_LMDZ_PHY,color,mpi_rank,orch_comm,ierr)
517	#endif
518
519	ENDIF
520	CALL bcast_omp(orch_comm)
521
522	IF (knon_mpi /= 0) THEN
523	orch_omp_size=0
524	DO i=0,omp_size-1
525	IF (knon_omp_para(i) /=0) THEN
526	orch_omp_size=orch_omp_size+1
527	IF (i==omp_rank) orch_omp_rank=orch_omp_size-1
528	ENDIF
529	ENDDO
530	ENDIF
531
532
533	END SUBROUTINE Get_orchidee_communicator
534	!
535	!****************************************************************************************
536	!
537
538	SUBROUTINE Init_neighbours(knon,neighbours,knindex,pctsrf)
539	USE mod_grid_phy_lmdz
540	USE mod_surf_para
541	INCLUDE "indicesol.h"
542
543	#ifdef CPP_MPI
544	INCLUDE 'mpif.h'
545	#endif
546
547	! Input arguments
548	!****************************************************************************************
549	INTEGER, INTENT(IN) :: knon
550	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
551	REAL, DIMENSION(klon), INTENT(IN) :: pctsrf
552
553	! Output arguments
554	!****************************************************************************************
555	INTEGER, DIMENSION(knon,8), INTENT(OUT) :: neighbours
556
557	! Local variables
558	!****************************************************************************************
559	INTEGER :: i, igrid, jj, ij, iglob
560	INTEGER :: ierr, ireal, index
561	INTEGER, DIMENSION(8,3) :: off_ini
562	INTEGER, DIMENSION(8) :: offset
563	INTEGER, DIMENSION(nbp_lon,nbp_lat) :: correspond
564	INTEGER, DIMENSION(knon_glo) :: ktindex_glo
565	INTEGER, DIMENSION(knon_glo,8) :: neighbours_glo
566	REAL, DIMENSION(klon_glo) :: pctsrf_glo
567	INTEGER :: ktindex(klon)
568	!
569	! End definition
570	!****************************************************************************************
571
572	ktindex(1:knon)=knindex(1:knon)+(klon_mpi_begin-1)+(klon_omp_begin-1)+nbp_lon-1
573
574	CALL gather_surf(ktindex(1:knon),ktindex_glo)
575	CALL gather(pctsrf,pctsrf_glo)
576
577	IF (is_mpi_root .AND. is_omp_root) THEN
578	neighbours_glo(:,:)=-1
579	! Initialisation des offset
580	!
581	! offset bord ouest
582	off_ini(1,1) = - nbp_lon ; off_ini(2,1) = - nbp_lon + 1 ; off_ini(3,1) = 1
583	off_ini(4,1) = nbp_lon + 1 ; off_ini(5,1) = nbp_lon ; off_ini(6,1) = 2 * nbp_lon - 1
584	off_ini(7,1) = nbp_lon -1 ; off_ini(8,1) = - 1
585	! offset point normal
586	off_ini(1,2) = - nbp_lon ; off_ini(2,2) = - nbp_lon + 1 ; off_ini(3,2) = 1
587	off_ini(4,2) = nbp_lon + 1 ; off_ini(5,2) = nbp_lon ; off_ini(6,2) = nbp_lon - 1
588	off_ini(7,2) = -1 ; off_ini(8,2) = - nbp_lon - 1
589	! offset bord est
590	off_ini(1,3) = - nbp_lon ; off_ini(2,3) = - 2 * nbp_lon + 1 ; off_ini(3,3) = - nbp_lon + 1
591	off_ini(4,3) = 1 ; off_ini(5,3) = nbp_lon ; off_ini(6,3) = nbp_lon - 1
592	off_ini(7,3) = -1 ; off_ini(8,3) = - nbp_lon - 1
593	!
594	!
595	! Attention aux poles
596	!
597	DO igrid = 1, knon_glo
598	index = ktindex_glo(igrid)
599	jj = INT((index - 1)/nbp_lon) + 1
600	ij = index - (jj - 1) * nbp_lon
601	correspond(ij,jj) = igrid
602	ENDDO
603
604	DO igrid = 1, knon_glo
605	iglob = ktindex_glo(igrid)
606
607	IF (MOD(iglob, nbp_lon) == 1) THEN
608	offset = off_ini(:,1)
609	ELSE IF(MOD(iglob, nbp_lon) == 0) THEN
610	offset = off_ini(:,3)
611	ELSE
612	offset = off_ini(:,2)
613	ENDIF
614
615	DO i = 1, 8
616	index = iglob + offset(i)
617	ireal = (MIN(MAX(1, index - nbp_lon + 1), klon_glo))
618	IF (pctsrf_glo(ireal) > EPSFRA) THEN
619	jj = INT((index - 1)/nbp_lon) + 1
620	ij = index - (jj - 1) * nbp_lon
621	neighbours_glo(igrid, i) = correspond(ij, jj)
622	ENDIF
623	ENDDO
624	ENDDO
625
626	ENDIF
627
628	DO i = 1, 8
629	CALL scatter_surf(neighbours_glo(:,i),neighbours(1:knon,i))
630	ENDDO
631	END SUBROUTINE Init_neighbours
632
633	!
634	!****************************************************************************************
635	!
636	#endif
637	END MODULE surf_land_orchidee_mod

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

Download in other formats:

Original Format