Context Navigation

surf_land_orchidee_noopenmp_mod.F90 @ 1132

Last change on this file since 1132 was 1132, checked in by jghattas, 15 years ago

Ajout du module surf_land_orchidee_noooenmp_mod qui contient l'ancien interface d'ORCHIDEE. Pour utiliser cette module il faut compiler avec le cle cpp ORCHIDEE_NOOPENMP. Par default on continue a utiliser le module surf_land_orchidee_mod qui contient l'interface mixte MPI/OpenMP pour ORCHIDEE.

Ajout d'option -cpp dans makegcm_fcm qui permet d'ajouter un cle cpp dans la ligne de compilation.

File size: 23.9 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
279	!
280	! Allouer et initialiser le tableau des voisins et des fraction de continents
281	!
282	IF ( (.NOT.ALLOCATED(neighbours))) THEN
283	ALLOCATE(neighbours(knon,8), stat = error)
284	IF (error /= 0) THEN
285	abort_message='Pb allocation neighbours'
286	CALL abort_gcm(modname,abort_message,1)
287	ENDIF
288	ENDIF
289	neighbours = -1.
290	IF (( .NOT. ALLOCATED(contfrac))) THEN
291	ALLOCATE(contfrac(knon), stat = error)
292	IF (error /= 0) THEN
293	abort_message='Pb allocation contfrac'
294	CALL abort_gcm(modname,abort_message,1)
295	ENDIF
296	ENDIF
297
298	DO igrid = 1, knon
299	ireal = knindex(igrid)
300	contfrac(igrid) = pctsrf(ireal,is_ter)
301	ENDDO
302
303
304	CALL Init_neighbours(knon,neighbours,knindex,pctsrf(:,is_ter))
305
306	!
307	! Allocation et calcul resolutions
308	IF ( (.NOT.ALLOCATED(resolution))) THEN
309	ALLOCATE(resolution(knon,2), stat = error)
310	IF (error /= 0) THEN
311	abort_message='Pb allocation resolution'
312	CALL abort_gcm(modname,abort_message,1)
313	ENDIF
314	ENDIF
315	DO igrid = 1, knon
316	ij = knindex(igrid)
317	resolution(igrid,1) = cuphy(ij)
318	resolution(igrid,2) = cvphy(ij)
319	ENDDO
320
321	ALLOCATE(coastalflow(klon), stat = error)
322	IF (error /= 0) THEN
323	abort_message='Pb allocation coastalflow'
324	CALL abort_gcm(modname,abort_message,1)
325	ENDIF
326
327	ALLOCATE(riverflow(klon), stat = error)
328	IF (error /= 0) THEN
329	abort_message='Pb allocation riverflow'
330	CALL abort_gcm(modname,abort_message,1)
331	ENDIF
332
333	ENDIF ! (fin debut)
334
335	!
336	! Appel a la routine sols continentaux
337	!
338	IF (lafin) lrestart_write = .TRUE.
339	IF (check) WRITE(lunout,*)'lafin ',lafin,lrestart_write
340
341	petA_orc(1:knon) = petBcoef(1:knon) * dtime
342	petB_orc(1:knon) = petAcoef(1:knon)
343	peqA_orc(1:knon) = peqBcoef(1:knon) * dtime
344	peqB_orc(1:knon) = peqAcoef(1:knon)
345
346	cdrag = 0.
347	cdrag(1:knon) = tq_cdrag(1:knon)
348
349	! zlev(1:knon) = (100.plev(1:knon))/((ps(1:knon)/287.05temp_air(1:knon))*9.80665)
350	zlev(1:knon) = (100.plev(1:knon))/((ps(1:knon)/RDtemp_air(1:knon))*RG)
351
352
353	! PF et PASB
354	! where(cdrag > 0.01)
355	! cdrag = 0.01
356	! endwhere
357	! write(,)'Cdrag = ',minval(cdrag),maxval(cdrag)
358
359	!
360	! Init Orchidee
361	!
362	! if (pole_nord) then
363	! offset=0
364	! ktindex(:)=ktindex(:)+iim-1
365	! else
366	! offset = klon_mpi_begin-1+iim-1
367	! ktindex(:)=ktindex(:)+MOD(offset,iim)
368	! offset=offset-MOD(offset,iim)
369	! endif
370
371	IF (debut) THEN
372	CALL Get_orchidee_communicator(knon,orch_comm)
373	IF (knon /=0) THEN
374	CALL Init_orchidee_index(knon,orch_comm,knindex,offset,ktindex)
375
376	#ifndef CPP_MPI
377	#define ORC_PREPAR
378	#endif
379
380	#ifdef ORC_PREPAR
381	! Interface for ORCHIDEE compiled in sequential mode(without preprocessing flag CPP_MPI)
382	CALL intersurf_main (itime+itau_phy-1, iim, jjm+1, knon, ktindex, dtime, &
383	lrestart_read, lrestart_write, lalo, &
384	contfrac, neighbours, resolution, date0, &
385	zlev, u1_lay, v1_lay, spechum, temp_air, epot_air, ccanopy, &
386	cdrag, petA_orc, peqA_orc, petB_orc, peqB_orc, &
387	precip_rain, precip_snow, lwdown, swnet, swdown, ps, &
388	evap, fluxsens, fluxlat, coastalflow, riverflow, &
389	tsol_rad, tsurf_new, qsurf, albedo_out, emis_new, z0_new, &
390	lon_scat, lat_scat)
391
392	#else
393	! Interface for ORCHIDEE version 1.9 or later compiled in parallel mode(with preprocessing flag CPP_MPI)
394	CALL intersurf_main (itime+itau_phy-1, iim, jjm+1, offset, knon, ktindex, &
395	orch_comm, dtime, lrestart_read, lrestart_write, lalo, &
396	contfrac, neighbours, resolution, date0, &
397	zlev, u1_lay(1:knon), v1_lay(1:knon), spechum(1:knon), temp_air(1:knon), epot_air(1:knon), ccanopy(1:knon), &
398	cdrag(1:knon), petA_orc(1:knon), peqA_orc(1:knon), petB_orc(1:knon), peqB_orc(1:knon), &
399	precip_rain(1:knon), precip_snow(1:knon), lwdown(1:knon), swnet(1:knon), swdown(1:knon), ps(1:knon), &
400	evap(1:knon), fluxsens(1:knon), fluxlat(1:knon), coastalflow(1:knon), riverflow(1:knon), &
401	tsol_rad(1:knon), tsurf_new(1:knon), qsurf(1:knon), albedo_out(1:knon,:), emis_new(1:knon), z0_new(1:knon), &
402	lon_scat, lat_scat)
403	#endif
404
405	ENDIF
406
407	albedo_keep(1:knon) = (albedo_out(1:knon,1)+albedo_out(1:knon,2))/2.
408
409	ENDIF
410
411	! swdown_vrai(1:knon) = swnet(1:knon)/(1. - albedo_keep(1:knon))
412	swdown_vrai(1:knon) = swdown(1:knon)
413
414	IF (knon /=0) THEN
415
416	#ifdef ORC_PREPAR
417	! Interface for ORCHIDEE compiled in sequential mode(without preprocessing flag CPP_MPI)
418	CALL intersurf_main (itime+itau_phy, iim, jjm+1, knon, ktindex, dtime, &
419	lrestart_read, lrestart_write, lalo, &
420	contfrac, neighbours, resolution, date0, &
421	zlev, u1_lay, v1_lay, spechum, temp_air, epot_air, ccanopy, &
422	cdrag, petA_orc, peqA_orc, petB_orc, peqB_orc, &
423	precip_rain, precip_snow, lwdown, swnet, swdown_vrai, ps, &
424	evap, fluxsens, fluxlat, coastalflow, riverflow, &
425	tsol_rad, tsurf_new, qsurf, albedo_out, emis_new, z0_new, &
426	lon_scat, lat_scat)
427
428	#else
429	! Interface for ORCHIDEE version 1.9 or later compiled in parallel mode(with preprocessing flag CPP_MPI)
430	CALL intersurf_main (itime+itau_phy, iim, jjm+1,offset, knon, ktindex, &
431	orch_comm,dtime, lrestart_read, lrestart_write, lalo, &
432	contfrac, neighbours, resolution, date0, &
433	zlev, u1_lay(1:knon), v1_lay(1:knon), spechum(1:knon), temp_air(1:knon), epot_air(1:knon), ccanopy(1:knon), &
434	cdrag(1:knon), petA_orc(1:knon), peqA_orc(1:knon), petB_orc(1:knon), peqB_orc(1:knon), &
435	precip_rain(1:knon), precip_snow(1:knon), lwdown(1:knon), swnet(1:knon), swdown_vrai(1:knon), ps(1:knon), &
436	evap(1:knon), fluxsens(1:knon), fluxlat(1:knon), coastalflow(1:knon), riverflow(1:knon), &
437	tsol_rad(1:knon), tsurf_new(1:knon), qsurf(1:knon), albedo_out(1:knon,:), emis_new(1:knon), z0_new(1:knon), &
438	lon_scat, lat_scat)
439	#endif
440
441	ENDIF
442
443	albedo_keep(1:knon) = (albedo_out(1:knon,1)+albedo_out(1:knon,2))/2.
444
445	!* Send to coupler
446	!
447	IF (type_ocean=='couple') THEN
448	CALL cpl_send_land_fields(itime, knon, knindex, &
449	riverflow, coastalflow)
450	ENDIF
451
452	alb1_new(1:knon) = albedo_out(1:knon,1)
453	alb2_new(1:knon) = albedo_out(1:knon,2)
454
455	! Convention orchidee: positif vers le haut
456	fluxsens(1:knon) = -1. * fluxsens(1:knon)
457	fluxlat(1:knon) = -1. * fluxlat(1:knon)
458
459	! evap = -1. * evap
460
461	IF (debut) lrestart_read = .FALSE.
462	#endif
463	END SUBROUTINE surf_land_orchidee
464	!
465	!****************************************************************************************
466	!
467	SUBROUTINE Init_orchidee_index(knon,orch_comm,knindex,offset,ktindex)
468
469	INCLUDE "dimensions.h"
470
471	#ifdef CPP_MPI
472	INCLUDE 'mpif.h'
473	#endif
474
475
476	! Input arguments
477	!****************************************************************************************
478	INTEGER, INTENT(IN) :: knon
479	INTEGER, INTENT(IN) :: orch_comm
480	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
481
482	! Output arguments
483	!****************************************************************************************
484	INTEGER, INTENT(OUT) :: offset
485	INTEGER, DIMENSION(knon), INTENT(OUT) :: ktindex
486
487	! Local varables
488	!****************************************************************************************
489	#ifdef CPP_MPI
490	INTEGER, DIMENSION(MPI_STATUS_SIZE) :: status
491	#endif
492
493	INTEGER :: MyLastPoint
494	INTEGER :: LastPoint
495	INTEGER :: mpi_rank_orch
496	INTEGER :: mpi_size_orch
497	INTEGER :: ierr
498	!
499	! End definition
500	!****************************************************************************************
501
502	MyLastPoint=klon_mpi_begin-1+knindex(knon)+iim-1
503
504	IF (is_parallel) THEN
505	#ifdef CPP_MPI
506	CALL MPI_COMM_SIZE(orch_comm,mpi_size_orch,ierr)
507	CALL MPI_COMM_RANK(orch_comm,mpi_rank_orch,ierr)
508	#endif
509	ELSE
510	mpi_rank_orch=0
511	mpi_size_orch=1
512	ENDIF
513
514	IF (is_parallel) THEN
515	IF (mpi_rank_orch /= 0) THEN
516	#ifdef CPP_MPI
517	CALL MPI_RECV(LastPoint,1,MPI_INTEGER,mpi_rank_orch-1,1234,orch_comm,status,ierr)
518	#endif
519	ENDIF
520
521	IF (mpi_rank_orch /= mpi_size_orch-1) THEN
522	#ifdef CPP_MPI
523	CALL MPI_SEND(MyLastPoint,1,MPI_INTEGER,mpi_rank_orch+1,1234,orch_comm,ierr)
524	#endif
525	ENDIF
526	ENDIF
527
528	IF (mpi_rank_orch == 0) THEN
529	offset=0
530	ELSE
531	offset=LastPoint-MOD(LastPoint,iim)
532	ENDIF
533
534	ktindex(1:knon)=knindex(1:knon)+(klon_mpi_begin+iim-1)-offset-1
535
536
537	END SUBROUTINE Init_orchidee_index
538	!
539	!****************************************************************************************
540	!
541	SUBROUTINE Get_orchidee_communicator(knon,orch_comm)
542
543	#ifdef CPP_MPI
544	INCLUDE 'mpif.h'
545	#endif
546
547
548	INTEGER,INTENT(IN) :: knon
549	INTEGER,INTENT(OUT) :: orch_comm
550
551	INTEGER :: color
552	INTEGER :: ierr
553	!
554	! End definition
555	!****************************************************************************************
556
557	IF (knon==0) THEN
558	color = 0
559	ELSE
560	color = 1
561	ENDIF
562
563	#ifdef CPP_MPI
564	CALL MPI_COMM_SPLIT(COMM_LMDZ_PHY,color,mpi_rank,orch_comm,ierr)
565	#endif
566
567	END SUBROUTINE Get_orchidee_communicator
568	!
569	!****************************************************************************************
570	!
571	SUBROUTINE Init_neighbours(knon,neighbours,ktindex,pctsrf)
572
573	INCLUDE "indicesol.h"
574	INCLUDE "dimensions.h"
575	#ifdef CPP_MPI
576	INCLUDE 'mpif.h'
577	#endif
578
579	! Input arguments
580	!****************************************************************************************
581	INTEGER, INTENT(IN) :: knon
582	INTEGER, DIMENSION(klon), INTENT(IN) :: ktindex
583	REAL, DIMENSION(klon), INTENT(IN) :: pctsrf
584
585	! Output arguments
586	!****************************************************************************************
587	INTEGER, DIMENSION(knon,8), INTENT(OUT) :: neighbours
588
589	! Local variables
590	!****************************************************************************************
591	INTEGER :: knon_g
592	INTEGER :: i, igrid, jj, ij, iglob
593	INTEGER :: ierr, ireal, index
594	INTEGER, DIMENSION(0:mpi_size-1) :: knon_nb
595	INTEGER, DIMENSION(0:mpi_size-1) :: displs
596	INTEGER, DIMENSION(8,3) :: off_ini
597	INTEGER, DIMENSION(8) :: offset
598	INTEGER, DIMENSION(knon) :: ktindex_p
599	INTEGER, DIMENSION(iim,jjm+1) :: correspond
600	INTEGER, ALLOCATABLE, DIMENSION(:) :: ktindex_g
601	INTEGER, ALLOCATABLE, DIMENSION(:,:) :: neighbours_g
602	REAL, DIMENSION(klon_glo) :: pctsrf_g
603
604	!
605	! End definition
606	!****************************************************************************************
607
608	IF (is_sequential) THEN
609	knon_nb(:)=knon
610	ELSE
611
612	#ifdef CPP_MPI
613	CALL MPI_GATHER(knon,1,MPI_INTEGER,knon_nb,1,MPI_INTEGER,0,COMM_LMDZ_PHY,ierr)
614	#endif
615
616	ENDIF
617
618	IF (is_mpi_root) THEN
619	knon_g=SUM(knon_nb(:))
620	ALLOCATE(ktindex_g(knon_g))
621	ALLOCATE(neighbours_g(knon_g,8))
622	neighbours_g(:,:)=-1
623	displs(0)=0
624	DO i=1,mpi_size-1
625	displs(i)=displs(i-1)+knon_nb(i-1)
626	ENDDO
627	ENDIF
628
629	ktindex_p(1:knon)=ktindex(1:knon)+klon_mpi_begin-1+iim-1
630
631	IF (is_sequential) THEN
632	ktindex_g(:)=ktindex_p(:)
633	ELSE
634
635	#ifdef CPP_MPI
636	CALL MPI_GATHERV(ktindex_p,knon,MPI_INTEGER,ktindex_g,knon_nb,&
637	displs,MPI_INTEGER,0,COMM_LMDZ_PHY,ierr)
638	#endif
639
640	ENDIF
641
642	CALL Gather(pctsrf,pctsrf_g)
643
644	IF (is_mpi_root) THEN
645	! Initialisation des offset
646	!
647	! offset bord ouest
648	off_ini(1,1) = - iim ; off_ini(2,1) = - iim + 1; off_ini(3,1) = 1
649	off_ini(4,1) = iim + 1; off_ini(5,1) = iim ; off_ini(6,1) = 2 * iim - 1
650	off_ini(7,1) = iim -1 ; off_ini(8,1) = - 1
651	! offset point normal
652	off_ini(1,2) = - iim ; off_ini(2,2) = - iim + 1; off_ini(3,2) = 1
653	off_ini(4,2) = iim + 1; off_ini(5,2) = iim ; off_ini(6,2) = iim - 1
654	off_ini(7,2) = -1 ; off_ini(8,2) = - iim - 1
655	! offset bord est
656	off_ini(1,3) = - iim; off_ini(2,3) = - 2 * iim + 1; off_ini(3,3) = - iim + 1
657	off_ini(4,3) = 1 ; off_ini(5,3) = iim ; off_ini(6,3) = iim - 1
658	off_ini(7,3) = -1 ; off_ini(8,3) = - iim - 1
659	!
660	!
661	! Attention aux poles
662	!
663	DO igrid = 1, knon_g
664	index = ktindex_g(igrid)
665	jj = INT((index - 1)/iim) + 1
666	ij = index - (jj - 1) * iim
667	correspond(ij,jj) = igrid
668	ENDDO
669
670	DO igrid = 1, knon_g
671	iglob = ktindex_g(igrid)
672	IF (MOD(iglob, iim) == 1) THEN
673	offset = off_ini(:,1)
674	ELSE IF(MOD(iglob, iim) == 0) THEN
675	offset = off_ini(:,3)
676	ELSE
677	offset = off_ini(:,2)
678	ENDIF
679	DO i = 1, 8
680	index = iglob + offset(i)
681	ireal = (MIN(MAX(1, index - iim + 1), klon_glo))
682	IF (pctsrf_g(ireal) > EPSFRA) THEN
683	jj = INT((index - 1)/iim) + 1
684	ij = index - (jj - 1) * iim
685	neighbours_g(igrid, i) = correspond(ij, jj)
686	ENDIF
687	ENDDO
688	ENDDO
689
690	ENDIF
691
692	DO i=1,8
693	IF (is_sequential) THEN
694	neighbours(:,i)=neighbours_g(:,i)
695	ELSE
696	#ifdef CPP_MPI
697	CALL MPI_SCATTERV(neighbours_g(:,i),knon_nb,displs,MPI_INTEGER,neighbours(:,i),knon,MPI_INTEGER,0,COMM_LMDZ_PHY,ierr)
698	#endif
699	ENDIF
700	ENDDO
701
702	END SUBROUTINE Init_neighbours
703	!
704	!****************************************************************************************
705	!
706
707	#endif
708	END MODULE surf_land_orchidee_noopenmp_mod

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

Download in other formats:

Original Format