Context Navigation

surf_land_orchidee_mod.F90 @ 785

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

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

Download in other formats:

Original Format