Context Navigation

surf_land_orchidee_noopenmp_mod.F90 @ 1138

Last change on this file since 1138 was 1138, checked in by jghattas, 15 years ago
Correction de bug : lorsque pour un grand nombre de CPU, le processus maitre se retrouve sans points de terre, et est donc exlus de la liste des domaines dans orchidee. Cette correction est deja faite dans surf_land_orchidee_mod.
File size: 24.0 KB

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

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

Download in other formats:

Original Format