Context Navigation

surf_land_orchidee_mod.F90 @ 1001

Last change on this file since 1001 was 1001, checked in by Laurent Fairhead, 16 years ago

Modifs sur le parallelisme: masquage dans la physique
Inclusion strato
mise en coherence etat0
le mode offline fonctionne maintenant en parallele,
les fichiers de la dynamiques sont correctement sortis et peuvent etre reconstruit avec rebuild
la version parallele de la dynamique peut s'executer sans MPI (sur 1 proc)
L'OPENMP fonctionne maintenant sans la parallelisation MPI.

YM
LF

Property svn:eol-style set to native
Property svn:executable set to *
Property svn:keywords set to Author Date Id Revision

File size: 20.8 KB

Line
1	!
2	! $Header$
3	!
4	MODULE surf_land_orchidee_mod
5	!
6	! This module controles the interface towards the model ORCHIDEE
7	!
8	! Subroutines in this module : surf_land_orchidee
9	! Init_orchidee_index
10	! Get_orchidee_communicator
11	! Init_neighbours
12	#ifdef CPP_VEGET
13
14	USE dimphy
15	USE intersurf ! module d'ORCHIDEE
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, &
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) :: swdown_vrai
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	CHARACTER (len = 20) :: modname = 'surf_land_orchidee'
136	CHARACTER (len = 80) :: abort_message
137	LOGICAL,SAVE :: check = .FALSE.
138	!$OMP THREADPRIVATE(check)
139
140	! type de couplage dans sechiba
141	! character (len=10) :: coupling = 'implicit'
142	! drapeaux controlant les appels dans SECHIBA
143	! type(control_type), save :: control_in
144	! Preserved albedo
145	REAL, ALLOCATABLE, DIMENSION(:), SAVE :: albedo_keep, zlev
146	!$OMP THREADPRIVATE(albedo_keep,zlev)
147	! coordonnees geographiques
148	REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: lalo
149	!$OMP THREADPRIVATE(lalo)
150	! pts voisins
151	INTEGER,ALLOCATABLE, DIMENSION(:,:), SAVE :: neighbours
152	!$OMP THREADPRIVATE(neighbours)
153	! fractions continents
154	REAL,ALLOCATABLE, DIMENSION(:), SAVE :: contfrac
155	!$OMP THREADPRIVATE(contfrac)
156	! resolution de la grille
157	REAL, ALLOCATABLE, DIMENSION (:,:), SAVE :: resolution
158	!$OMP THREADPRIVATE(resolution)
159
160	REAL, ALLOCATABLE, DIMENSION (:,:), SAVE :: lon_scat, lat_scat
161	!$OMP THREADPRIVATE(lon_scat,lat_scat)
162
163	LOGICAL, SAVE :: lrestart_read = .TRUE.
164	!$OMP THREADPRIVATE(lrestart_read)
165	LOGICAL, SAVE :: lrestart_write = .FALSE.
166	!$OMP THREADPRIVATE(lrestart_write)
167
168	REAL, DIMENSION(knon,2) :: albedo_out
169
170	! Pb de nomenclature
171	REAL, DIMENSION(klon) :: petA_orc, peqA_orc
172	REAL, DIMENSION(klon) :: petB_orc, peqB_orc
173	! Pb de correspondances de grilles
174	INTEGER, DIMENSION(:), SAVE, ALLOCATABLE :: ig, jg
175	!$OMP THREADPRIVATE(ig,jg)
176	INTEGER :: indi, indj
177	INTEGER, SAVE, ALLOCATABLE,DIMENSION(:) :: ktindex
178	!$OMP THREADPRIVATE(ktindex)
179
180	! Essai cdrag
181	REAL, DIMENSION(klon) :: cdrag
182	INTEGER,SAVE :: offset
183	!$OMP THREADPRIVATE(offset)
184
185	REAL, DIMENSION(klon_glo) :: rlon_g,rlat_g
186	INTEGER, SAVE :: orch_comm
187	!$OMP THREADPRIVATE(orch_comm)
188
189	REAL, ALLOCATABLE, DIMENSION(:), SAVE :: coastalflow
190	!$OMP THREADPRIVATE(coastalflow)
191	REAL, ALLOCATABLE, DIMENSION(:), SAVE :: riverflow
192	!$OMP THREADPRIVATE(riverflow)
193
194	INTEGER :: orch_omp_rank
195	INTEGER :: orch_omp_size
196	!
197	! Fin definition
198	!****************************************************************************************
199
200	IF (check) WRITE(lunout,*)'Entree ', modname
201
202	! Initialisation
203
204	IF (debut) THEN
205	CALL Init_surf_para(knon)
206	ALLOCATE(ktindex(knon))
207	IF ( .NOT. ALLOCATED(albedo_keep)) THEN
208	!ym ALLOCATE(albedo_keep(klon))
209	!ym bizarre que non alloué en knon precedement
210	ALLOCATE(albedo_keep(knon))
211	ALLOCATE(zlev(knon))
212	ENDIF
213	! Pb de correspondances de grilles
214	ALLOCATE(ig(klon))
215	ALLOCATE(jg(klon))
216	ig(1) = 1
217	jg(1) = 1
218	indi = 0
219	indj = 2
220	DO igrid = 2, klon - 1
221	indi = indi + 1
222	IF ( indi > iim) THEN
223	indi = 1
224	indj = indj + 1
225	ENDIF
226	ig(igrid) = indi
227	jg(igrid) = indj
228	ENDDO
229	ig(klon) = 1
230	jg(klon) = jjm + 1
231
232	IF ((.NOT. ALLOCATED(lalo))) THEN
233	ALLOCATE(lalo(knon,2), stat = error)
234	IF (error /= 0) THEN
235	abort_message='Pb allocation lalo'
236	CALL abort_gcm(modname,abort_message,1)
237	ENDIF
238	ENDIF
239	IF ((.NOT. ALLOCATED(lon_scat))) THEN
240	ALLOCATE(lon_scat(iim,jjm+1), stat = error)
241	IF (error /= 0) THEN
242	abort_message='Pb allocation lon_scat'
243	CALL abort_gcm(modname,abort_message,1)
244	ENDIF
245	ENDIF
246	IF ((.NOT. ALLOCATED(lat_scat))) THEN
247	ALLOCATE(lat_scat(iim,jjm+1), stat = error)
248	IF (error /= 0) THEN
249	abort_message='Pb allocation lat_scat'
250	CALL abort_gcm(modname,abort_message,1)
251	ENDIF
252	ENDIF
253	lon_scat = 0.
254	lat_scat = 0.
255	DO igrid = 1, knon
256	index = knindex(igrid)
257	lalo(igrid,2) = rlon(index)
258	lalo(igrid,1) = rlat(index)
259	ENDDO
260
261
262
263	CALL Gather(rlon,rlon_g)
264	CALL Gather(rlat,rlat_g)
265
266	IF (is_mpi_root) THEN
267	index = 1
268	DO jj = 2, jjm
269	DO ij = 1, iim
270	index = index + 1
271	lon_scat(ij,jj) = rlon_g(index)
272	lat_scat(ij,jj) = rlat_g(index)
273	ENDDO
274	ENDDO
275	lon_scat(:,1) = lon_scat(:,2)
276	lat_scat(:,1) = rlat_g(1)
277	lon_scat(:,jjm+1) = lon_scat(:,2)
278	lat_scat(:,jjm+1) = rlat_g(klon_glo)
279	ENDIF
280
281
282	!
283	! Allouer et initialiser le tableau des voisins et des fraction de continents
284	!
285	IF ( (.NOT.ALLOCATED(neighbours))) THEN
286	ALLOCATE(neighbours(knon,8), stat = error)
287	IF (error /= 0) THEN
288	abort_message='Pb allocation neighbours'
289	CALL abort_gcm(modname,abort_message,1)
290	ENDIF
291	ENDIF
292	neighbours = -1.
293	IF (( .NOT. ALLOCATED(contfrac))) THEN
294	ALLOCATE(contfrac(knon), stat = error)
295	IF (error /= 0) THEN
296	abort_message='Pb allocation contfrac'
297	CALL abort_gcm(modname,abort_message,1)
298	ENDIF
299	ENDIF
300
301	DO igrid = 1, knon
302	ireal = knindex(igrid)
303	contfrac(igrid) = pctsrf(ireal,is_ter)
304	ENDDO
305
306
307	CALL Init_neighbours(knon,neighbours,knindex,pctsrf(:,is_ter))
308
309	!
310	! Allocation et calcul resolutions
311	IF ( (.NOT.ALLOCATED(resolution))) THEN
312	ALLOCATE(resolution(knon,2), stat = error)
313	IF (error /= 0) THEN
314	abort_message='Pb allocation resolution'
315	CALL abort_gcm(modname,abort_message,1)
316	ENDIF
317	ENDIF
318	DO igrid = 1, knon
319	ij = knindex(igrid)
320	resolution(igrid,1) = cuphy(ij)
321	resolution(igrid,2) = cvphy(ij)
322	ENDDO
323
324	ALLOCATE(coastalflow(klon), stat = error)
325	IF (error /= 0) THEN
326	abort_message='Pb allocation coastalflow'
327	CALL abort_gcm(modname,abort_message,1)
328	ENDIF
329
330	ALLOCATE(riverflow(klon), stat = error)
331	IF (error /= 0) THEN
332	abort_message='Pb allocation riverflow'
333	CALL abort_gcm(modname,abort_message,1)
334	ENDIF
335
336	ENDIF ! (fin debut)
337
338	!
339	! Appel a la routine sols continentaux
340	!
341	IF (lafin) lrestart_write = .TRUE.
342	IF (check) WRITE(lunout,*)'lafin ',lafin,lrestart_write
343
344	petA_orc(1:knon) = petBcoef(1:knon) * dtime
345	petB_orc(1:knon) = petAcoef(1:knon)
346	peqA_orc(1:knon) = peqBcoef(1:knon) * dtime
347	peqB_orc(1:knon) = peqAcoef(1:knon)
348
349	cdrag = 0.
350	cdrag(1:knon) = tq_cdrag(1:knon)
351
352	! zlev(1:knon) = (100.plev(1:knon))/((ps(1:knon)/287.05temp_air(1:knon))*9.80665)
353	zlev(1:knon) = (100.plev(1:knon))/((ps(1:knon)/RDtemp_air(1:knon))*RG)
354
355
356	! PF et PASB
357	! where(cdrag > 0.01)
358	! cdrag = 0.01
359	! endwhere
360	! write(,)'Cdrag = ',minval(cdrag),maxval(cdrag)
361
362
363	IF (debut) THEN
364	CALL Init_orchidee_index(knon,knindex,offset,ktindex)
365	CALL Get_orchidee_communicator(orch_comm,orch_omp_size,orch_omp_rank)
366	CALL Init_synchro_omp
367
368	IF (knon_mpi > 0) THEN
369	CALL Init_intersurf(nbp_lon,nbp_lat,knon,ktindex,offset,orch_omp_size,orch_omp_rank,orch_comm)
370	ENDIF
371
372
373	IF (knon > 0) THEN
374
375	CALL intersurf_main (itime+itau_phy-1, iim, jjm+1, knon, ktindex, dtime, &
376	lrestart_read, lrestart_write, lalo, &
377	contfrac, neighbours, resolution, date0, &
378	zlev, u1_lay, v1_lay, spechum, temp_air, epot_air, ccanopy, &
379	cdrag, petA_orc, peqA_orc, petB_orc, peqB_orc, &
380	precip_rain, precip_snow, lwdown, swnet, swdown, ps, &
381	evap, fluxsens, fluxlat, coastalflow, riverflow, &
382	tsol_rad, tsurf_new, qsurf, albedo_out, emis_new, z0_new, &
383	lon_scat, lat_scat)
384
385	ENDIF
386
387	CALL Synchro_omp
388
389	albedo_keep(1:knon) = (albedo_out(1:knon,1)+albedo_out(1:knon,2))/2.
390
391	ENDIF
392
393
394	! swdown_vrai(1:knon) = swnet(1:knon)/(1. - albedo_keep(1:knon))
395	swdown_vrai(1:knon) = swdown(1:knon)
396
397	IF (knon > 0) THEN
398
399	CALL intersurf_main (itime+itau_phy, iim, jjm+1, knon, ktindex, dtime, &
400	lrestart_read, lrestart_write, lalo, &
401	contfrac, neighbours, resolution, date0, &
402	zlev, u1_lay(1:knon), v1_lay(1:knon), spechum(1:knon), temp_air(1:knon), epot_air(1:knon), ccanopy(1:knon), &
403	cdrag(1:knon), petA_orc(1:knon), peqA_orc(1:knon), petB_orc(1:knon), peqB_orc(1:knon), &
404	precip_rain(1:knon), precip_snow(1:knon), lwdown(1:knon), swnet(1:knon), swdown_vrai(1:knon), ps(1:knon), &
405	evap(1:knon), fluxsens(1:knon), fluxlat(1:knon), coastalflow(1:knon), riverflow(1:knon), &
406	tsol_rad(1:knon), tsurf_new(1:knon), qsurf(1:knon), albedo_out(1:knon,:), emis_new(1:knon), z0_new(1:knon), &
407	lon_scat, lat_scat)
408
409	ENDIF
410
411	CALL Synchro_omp
412
413	albedo_keep(1:knon) = (albedo_out(1:knon,1)+albedo_out(1:knon,2))/2.
414
415	!* Send to coupler
416	!
417	IF (type_ocean=='couple') THEN
418	CALL cpl_send_land_fields(itime, knon, knindex, &
419	riverflow, coastalflow)
420	ENDIF
421
422	alb1_new(1:knon) = albedo_out(1:knon,1)
423	alb2_new(1:knon) = albedo_out(1:knon,2)
424
425	! Convention orchidee: positif vers le haut
426	fluxsens(1:knon) = -1. * fluxsens(1:knon)
427	fluxlat(1:knon) = -1. * fluxlat(1:knon)
428
429	! evap = -1. * evap
430
431	IF (debut) lrestart_read = .FALSE.
432
433	IF (debut) CALL Finalize_surf_para
434
435	END SUBROUTINE surf_land_orchidee
436	!
437	!****************************************************************************************
438	!
439	SUBROUTINE Init_orchidee_index(knon,knindex,offset,ktindex)
440	USE mod_surf_para
441	USE mod_grid_phy_lmdz
442
443	INTEGER,INTENT(IN) :: knon
444	INTEGER,INTENT(IN) :: knindex(klon)
445	INTEGER,INTENT(OUT) :: offset
446	INTEGER,INTENT(OUT) :: ktindex(klon)
447
448	INTEGER :: ktindex_glo(knon_glo)
449	INTEGER :: offset_para(0:omp_size*mpi_size-1)
450	INTEGER :: LastPoint
451	INTEGER :: task
452
453	ktindex(1:knon)=knindex(1:knon)+(klon_mpi_begin-1)+(klon_omp_begin-1)+nbp_lon-1
454
455	CALL gather_surf(ktindex(1:knon),ktindex_glo)
456
457	IF (is_mpi_root .AND. is_omp_root) THEN
458	LastPoint=0
459	DO Task=0,mpi_size*omp_size-1
460	IF (knon_glo_para(Task)>0) THEN
461	offset_para(task)= LastPoint-MOD(LastPoint,nbp_lon)
462	LastPoint=ktindex_glo(knon_glo_end_para(task))
463	ENDIF
464	ENDDO
465	ENDIF
466
467	CALL bcast(offset_para)
468
469	offset=offset_para(omp_size*mpi_rank+omp_rank)
470
471	ktindex(1:knon)=ktindex(1:knon)-offset
472
473	END SUBROUTINE Init_orchidee_index
474
475	!
476	!*********************** *************************************************************
477	!
478
479	SUBROUTINE Get_orchidee_communicator(orch_comm,orch_omp_size,orch_omp_rank)
480	USE mod_surf_para
481
482	#ifdef CPP_MPI
483	INCLUDE 'mpif.h'
484	#endif
485
486	INTEGER,INTENT(OUT) :: orch_comm
487	INTEGER,INTENT(OUT) :: orch_omp_size
488	INTEGER,INTENT(OUT) :: orch_omp_rank
489	INTEGER :: color
490	INTEGER :: i,ierr
491	!
492	! End definition
493	!****************************************************************************************
494
495
496	IF (is_omp_root) THEN
497
498	IF (knon_mpi==0) THEN
499	color = 0
500	ELSE
501	color = 1
502	ENDIF
503
504	#ifdef CPP_MPI
505	CALL MPI_COMM_SPLIT(COMM_LMDZ_PHY,color,mpi_rank,orch_comm,ierr)
506	#endif
507
508	ENDIF
509
510	IF (knon_mpi /= 0) THEN
511	orch_omp_size=0
512	DO i=0,omp_size-1
513	IF (knon_omp_para(i) /=0) THEN
514	orch_omp_size=orch_omp_size+1
515	IF (i==omp_rank) orch_omp_rank=orch_omp_size-1
516	ENDIF
517	ENDDO
518	ENDIF
519
520
521	END SUBROUTINE Get_orchidee_communicator
522	!
523	!****************************************************************************************
524	!
525
526	SUBROUTINE Init_neighbours(knon,neighbours,knindex,pctsrf)
527	USE mod_grid_phy_lmdz
528	USE mod_surf_para
529	INCLUDE "indicesol.h"
530
531	#ifdef CPP_MPI
532	INCLUDE 'mpif.h'
533	#endif
534
535	! Input arguments
536	!****************************************************************************************
537	INTEGER, INTENT(IN) :: knon
538	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
539	REAL, DIMENSION(klon), INTENT(IN) :: pctsrf
540
541	! Output arguments
542	!****************************************************************************************
543	INTEGER, DIMENSION(knon,8), INTENT(OUT) :: neighbours
544
545	! Local variables
546	!****************************************************************************************
547	INTEGER :: i, igrid, jj, ij, iglob
548	INTEGER :: ierr, ireal, index
549	INTEGER, DIMENSION(8,3) :: off_ini
550	INTEGER, DIMENSION(8) :: offset
551	INTEGER, DIMENSION(nbp_lon,nbp_lat) :: correspond
552	INTEGER, DIMENSION(knon_glo) :: ktindex_glo
553	INTEGER, DIMENSION(knon_glo,8) :: neighbours_glo
554	REAL, DIMENSION(klon_glo) :: pctsrf_glo
555	INTEGER :: ktindex(klon)
556	!
557	! End definition
558	!****************************************************************************************
559
560	ktindex(1:knon)=knindex(1:knon)+(klon_mpi_begin-1)+(klon_omp_begin-1)+nbp_lon-1
561
562	CALL gather_surf(ktindex(1:knon),ktindex_glo)
563	CALL gather(pctsrf,pctsrf_glo)
564
565	IF (is_mpi_root .AND. is_omp_root) THEN
566	neighbours_glo(:,:)=-1
567	! Initialisation des offset
568	!
569	! offset bord ouest
570	off_ini(1,1) = - nbp_lon ; off_ini(2,1) = - nbp_lon + 1 ; off_ini(3,1) = 1
571	off_ini(4,1) = nbp_lon + 1 ; off_ini(5,1) = nbp_lon ; off_ini(6,1) = 2 * nbp_lon - 1
572	off_ini(7,1) = nbp_lon -1 ; off_ini(8,1) = - 1
573	! offset point normal
574	off_ini(1,2) = - nbp_lon ; off_ini(2,2) = - nbp_lon + 1 ; off_ini(3,2) = 1
575	off_ini(4,2) = nbp_lon + 1 ; off_ini(5,2) = nbp_lon ; off_ini(6,2) = nbp_lon - 1
576	off_ini(7,2) = -1 ; off_ini(8,2) = - nbp_lon - 1
577	! offset bord est
578	off_ini(1,3) = - nbp_lon ; off_ini(2,3) = - 2 * nbp_lon + 1 ; off_ini(3,3) = - nbp_lon + 1
579	off_ini(4,3) = 1 ; off_ini(5,3) = nbp_lon ; off_ini(6,3) = nbp_lon - 1
580	off_ini(7,3) = -1 ; off_ini(8,3) = - nbp_lon - 1
581	!
582	!
583	! Attention aux poles
584	!
585	DO igrid = 1, knon_glo
586	index = ktindex_glo(igrid)
587	jj = INT((index - 1)/nbp_lon) + 1
588	ij = index - (jj - 1) * nbp_lon
589	correspond(ij,jj) = igrid
590	ENDDO
591
592	DO igrid = 1, knon_glo
593	iglob = ktindex_glo(igrid)
594
595	IF (MOD(iglob, nbp_lon) == 1) THEN
596	offset = off_ini(:,1)
597	ELSE IF(MOD(iglob, nbp_lon) == 0) THEN
598	offset = off_ini(:,3)
599	ELSE
600	offset = off_ini(:,2)
601	ENDIF
602
603	DO i = 1, 8
604	index = iglob + offset(i)
605	ireal = (MIN(MAX(1, index - nbp_lon + 1), klon_glo))
606	IF (pctsrf_glo(ireal) > EPSFRA) THEN
607	jj = INT((index - 1)/nbp_lon) + 1
608	ij = index - (jj - 1) * nbp_lon
609	neighbours_glo(igrid, i) = correspond(ij, jj)
610	ENDIF
611	ENDDO
612	ENDDO
613
614	ENDIF
615
616	DO i = 1, 8
617	CALL scatter_surf(neighbours_glo(:,i),neighbours(1:knon,i))
618	ENDDO
619	END SUBROUTINE Init_neighbours
620
621	!
622	!****************************************************************************************
623	!
624
625	#endif
626
627	END MODULE surf_land_orchidee_mod

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

Download in other formats:

Original Format