Context Navigation

surf_land_orchidee_noopenmp_mod.F90 @ 1266

Last change on this file since 1266 was 1146, checked in by Laurent Fairhead, 15 years ago
Réintegration dans le tronc des modifications issues de la branche LMDZ-dev comprises entre la révision 1074 et 1145 Validation: une simulation de 1 jour en séquentiel sur PC donne les mêmes résultats entre la trunk et la dev LF
File size: 24.1 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, q2m, t2m, &
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), INTENT(IN) :: q2m, t2m
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	REAL, DIMENSION(klon) :: swdown_vrai
137	CHARACTER (len = 20) :: modname = 'surf_land_orchidee'
138	CHARACTER (len = 80) :: abort_message
139	LOGICAL,SAVE :: check = .FALSE.
140	!$OMP THREADPRIVATE(check)
141
142	! type de couplage dans sechiba
143	! character (len=10) :: coupling = 'implicit'
144	! drapeaux controlant les appels dans SECHIBA
145	! type(control_type), save :: control_in
146	! Preserved albedo
147	REAL, ALLOCATABLE, DIMENSION(:), SAVE :: albedo_keep, zlev
148	!$OMP THREADPRIVATE(albedo_keep,zlev)
149	! coordonnees geographiques
150	REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: lalo
151	!$OMP THREADPRIVATE(lalo)
152	! pts voisins
153	INTEGER,ALLOCATABLE, DIMENSION(:,:), SAVE :: neighbours
154	!$OMP THREADPRIVATE(neighbours)
155	! fractions continents
156	REAL,ALLOCATABLE, DIMENSION(:), SAVE :: contfrac
157	!$OMP THREADPRIVATE(contfrac)
158	! resolution de la grille
159	REAL, ALLOCATABLE, DIMENSION (:,:), SAVE :: resolution
160	!$OMP THREADPRIVATE(resolution)
161
162	REAL, ALLOCATABLE, DIMENSION (:,:), SAVE :: lon_scat, lat_scat
163	!$OMP THREADPRIVATE(lon_scat,lat_scat)
164
165	LOGICAL, SAVE :: lrestart_read = .TRUE.
166	!$OMP THREADPRIVATE(lrestart_read)
167	LOGICAL, SAVE :: lrestart_write = .FALSE.
168	!$OMP THREADPRIVATE(lrestart_write)
169
170	REAL, DIMENSION(knon,2) :: albedo_out
171	!$OMP THREADPRIVATE(albedo_out)
172
173	! Pb de nomenclature
174	REAL, DIMENSION(klon) :: petA_orc, peqA_orc
175	REAL, DIMENSION(klon) :: petB_orc, peqB_orc
176	! Pb de correspondances de grilles
177	INTEGER, DIMENSION(:), SAVE, ALLOCATABLE :: ig, jg
178	!$OMP THREADPRIVATE(ig,jg)
179	INTEGER :: indi, indj
180	INTEGER, SAVE, ALLOCATABLE,DIMENSION(:) :: ktindex
181	!$OMP THREADPRIVATE(ktindex)
182
183	! Essai cdrag
184	REAL, DIMENSION(klon) :: cdrag
185	INTEGER,SAVE :: offset
186	!$OMP THREADPRIVATE(offset)
187
188	REAL, DIMENSION(klon_glo) :: rlon_g,rlat_g
189	INTEGER, SAVE :: orch_comm
190	!$OMP THREADPRIVATE(orch_comm)
191
192	REAL, ALLOCATABLE, DIMENSION(:), SAVE :: coastalflow
193	!$OMP THREADPRIVATE(coastalflow)
194	REAL, ALLOCATABLE, DIMENSION(:), SAVE :: riverflow
195	!$OMP THREADPRIVATE(riverflow)
196	!
197	! Fin definition
198	!****************************************************************************************
199	#ifdef CPP_VEGET
200
201	IF (check) WRITE(lunout,*)'Entree ', modname
202
203	! Initialisation
204
205	IF (debut) THEN
206	ALLOCATE(ktindex(knon))
207	IF ( .NOT. ALLOCATED(albedo_keep)) THEN
208	ALLOCATE(albedo_keep(klon))
209	ALLOCATE(zlev(knon))
210	ENDIF
211	! Pb de correspondances de grilles
212	ALLOCATE(ig(klon))
213	ALLOCATE(jg(klon))
214	ig(1) = 1
215	jg(1) = 1
216	indi = 0
217	indj = 2
218	DO igrid = 2, klon - 1
219	indi = indi + 1
220	IF ( indi > iim) THEN
221	indi = 1
222	indj = indj + 1
223	ENDIF
224	ig(igrid) = indi
225	jg(igrid) = indj
226	ENDDO
227	ig(klon) = 1
228	jg(klon) = jjm + 1
229
230	IF ((.NOT. ALLOCATED(lalo))) THEN
231	ALLOCATE(lalo(knon,2), stat = error)
232	IF (error /= 0) THEN
233	abort_message='Pb allocation lalo'
234	CALL abort_gcm(modname,abort_message,1)
235	ENDIF
236	ENDIF
237	IF ((.NOT. ALLOCATED(lon_scat))) THEN
238	ALLOCATE(lon_scat(iim,jjm+1), stat = error)
239	IF (error /= 0) THEN
240	abort_message='Pb allocation lon_scat'
241	CALL abort_gcm(modname,abort_message,1)
242	ENDIF
243	ENDIF
244	IF ((.NOT. ALLOCATED(lat_scat))) THEN
245	ALLOCATE(lat_scat(iim,jjm+1), stat = error)
246	IF (error /= 0) THEN
247	abort_message='Pb allocation lat_scat'
248	CALL abort_gcm(modname,abort_message,1)
249	ENDIF
250	ENDIF
251	lon_scat = 0.
252	lat_scat = 0.
253	DO igrid = 1, knon
254	index = knindex(igrid)
255	lalo(igrid,2) = rlon(index)
256	lalo(igrid,1) = rlat(index)
257	ENDDO
258
259
260
261	CALL Gather(rlon,rlon_g)
262	CALL Gather(rlat,rlat_g)
263
264	IF (is_mpi_root) THEN
265	index = 1
266	DO jj = 2, jjm
267	DO ij = 1, iim
268	index = index + 1
269	lon_scat(ij,jj) = rlon_g(index)
270	lat_scat(ij,jj) = rlat_g(index)
271	ENDDO
272	ENDDO
273	lon_scat(:,1) = lon_scat(:,2)
274	lat_scat(:,1) = rlat_g(1)
275	lon_scat(:,jjm+1) = lon_scat(:,2)
276	lat_scat(:,jjm+1) = rlat_g(klon_glo)
277	ENDIF
278
279	CALL bcast(lon_scat)
280	CALL bcast(lat_scat)
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	! Init Orchidee
364	!
365	! if (pole_nord) then
366	! offset=0
367	! ktindex(:)=ktindex(:)+iim-1
368	! else
369	! offset = klon_mpi_begin-1+iim-1
370	! ktindex(:)=ktindex(:)+MOD(offset,iim)
371	! offset=offset-MOD(offset,iim)
372	! endif
373
374	IF (debut) THEN
375	CALL Get_orchidee_communicator(knon,orch_comm)
376	IF (knon /=0) THEN
377	CALL Init_orchidee_index(knon,orch_comm,knindex,offset,ktindex)
378
379	#ifndef CPP_MPI
380	#define ORC_PREPAR
381	#endif
382
383	#ifdef ORC_PREPAR
384	! Interface for ORCHIDEE compiled in sequential mode(without preprocessing flag CPP_MPI)
385	CALL intersurf_main (itime+itau_phy-1, iim, jjm+1, knon, ktindex, dtime, &
386	lrestart_read, lrestart_write, lalo, &
387	contfrac, neighbours, resolution, date0, &
388	zlev, u1_lay, v1_lay, spechum, temp_air, epot_air, ccanopy, &
389	cdrag, petA_orc, peqA_orc, petB_orc, peqB_orc, &
390	precip_rain, precip_snow, lwdown, swnet, swdown, ps, &
391	evap, fluxsens, fluxlat, coastalflow, riverflow, &
392	tsol_rad, tsurf_new, qsurf, albedo_out, emis_new, z0_new, &
393	lon_scat, lat_scat, q2m, t2m)
394
395	#else
396	! Interface for ORCHIDEE version 1.9 or later compiled in parallel mode(with preprocessing flag CPP_MPI)
397	CALL intersurf_main (itime+itau_phy-1, iim, jjm+1, offset, knon, ktindex, &
398	orch_comm, dtime, lrestart_read, lrestart_write, lalo, &
399	contfrac, neighbours, resolution, date0, &
400	zlev, u1_lay(1:knon), v1_lay(1:knon), spechum(1:knon), temp_air(1:knon), epot_air(1:knon), ccanopy(1:knon), &
401	cdrag(1:knon), petA_orc(1:knon), peqA_orc(1:knon), petB_orc(1:knon), peqB_orc(1:knon), &
402	precip_rain(1:knon), precip_snow(1:knon), lwdown(1:knon), swnet(1:knon), swdown(1:knon), ps(1:knon), &
403	evap(1:knon), fluxsens(1:knon), fluxlat(1:knon), coastalflow(1:knon), riverflow(1:knon), &
404	tsol_rad(1:knon), tsurf_new(1:knon), qsurf(1:knon), albedo_out(1:knon,:), emis_new(1:knon), z0_new(1:knon), &
405	lon_scat, lat_scat, q2m, t2m)
406	#endif
407
408	ENDIF
409
410	albedo_keep(1:knon) = (albedo_out(1:knon,1)+albedo_out(1:knon,2))/2.
411
412	ENDIF
413
414	! swdown_vrai(1:knon) = swnet(1:knon)/(1. - albedo_keep(1:knon))
415	swdown_vrai(1:knon) = swdown(1:knon)
416
417	IF (knon /=0) THEN
418
419	#ifdef ORC_PREPAR
420	! Interface for ORCHIDEE compiled in sequential mode(without preprocessing flag CPP_MPI)
421	CALL intersurf_main (itime+itau_phy, iim, jjm+1, knon, ktindex, dtime, &
422	lrestart_read, lrestart_write, lalo, &
423	contfrac, neighbours, resolution, date0, &
424	zlev, u1_lay, v1_lay, spechum, temp_air, epot_air, ccanopy, &
425	cdrag, petA_orc, peqA_orc, petB_orc, peqB_orc, &
426	precip_rain, precip_snow, lwdown, swnet, swdown_vrai, ps, &
427	evap, fluxsens, fluxlat, coastalflow, riverflow, &
428	tsol_rad, tsurf_new, qsurf, albedo_out, emis_new, z0_new, &
429	lon_scat, lat_scat, q2m, t2m)
430
431	#else
432	! Interface for ORCHIDEE version 1.9 or later compiled in parallel mode(with preprocessing flag CPP_MPI)
433	CALL intersurf_main (itime+itau_phy, iim, jjm+1,offset, knon, ktindex, &
434	orch_comm,dtime, lrestart_read, lrestart_write, lalo, &
435	contfrac, neighbours, resolution, date0, &
436	zlev, u1_lay(1:knon), v1_lay(1:knon), spechum(1:knon), temp_air(1:knon), epot_air(1:knon), ccanopy(1:knon), &
437	cdrag(1:knon), petA_orc(1:knon), peqA_orc(1:knon), petB_orc(1:knon), peqB_orc(1:knon), &
438	precip_rain(1:knon), precip_snow(1:knon), lwdown(1:knon), swnet(1:knon), swdown_vrai(1:knon), ps(1:knon), &
439	evap(1:knon), fluxsens(1:knon), fluxlat(1:knon), coastalflow(1:knon), riverflow(1:knon), &
440	tsol_rad(1:knon), tsurf_new(1:knon), qsurf(1:knon), albedo_out(1:knon,:), emis_new(1:knon), z0_new(1:knon), &
441	lon_scat, lat_scat, q2m, t2m)
442	#endif
443
444	ENDIF
445
446	albedo_keep(1:knon) = (albedo_out(1:knon,1)+albedo_out(1:knon,2))/2.
447
448	!* Send to coupler
449	!
450	IF (type_ocean=='couple') THEN
451	CALL cpl_send_land_fields(itime, knon, knindex, &
452	riverflow, coastalflow)
453	ENDIF
454
455	alb1_new(1:knon) = albedo_out(1:knon,1)
456	alb2_new(1:knon) = albedo_out(1:knon,2)
457
458	! Convention orchidee: positif vers le haut
459	fluxsens(1:knon) = -1. * fluxsens(1:knon)
460	fluxlat(1:knon) = -1. * fluxlat(1:knon)
461
462	! evap = -1. * evap
463
464	IF (debut) lrestart_read = .FALSE.
465	#endif
466	END SUBROUTINE surf_land_orchidee
467	!
468	!****************************************************************************************
469	!
470	SUBROUTINE Init_orchidee_index(knon,orch_comm,knindex,offset,ktindex)
471
472	INCLUDE "dimensions.h"
473
474	#ifdef CPP_MPI
475	INCLUDE 'mpif.h'
476	#endif
477
478
479	! Input arguments
480	!****************************************************************************************
481	INTEGER, INTENT(IN) :: knon
482	INTEGER, INTENT(IN) :: orch_comm
483	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
484
485	! Output arguments
486	!****************************************************************************************
487	INTEGER, INTENT(OUT) :: offset
488	INTEGER, DIMENSION(knon), INTENT(OUT) :: ktindex
489
490	! Local varables
491	!****************************************************************************************
492	#ifdef CPP_MPI
493	INTEGER, DIMENSION(MPI_STATUS_SIZE) :: status
494	#endif
495
496	INTEGER :: MyLastPoint
497	INTEGER :: LastPoint
498	INTEGER :: mpi_rank_orch
499	INTEGER :: mpi_size_orch
500	INTEGER :: ierr
501	!
502	! End definition
503	!****************************************************************************************
504
505	MyLastPoint=klon_mpi_begin-1+knindex(knon)+iim-1
506
507	IF (is_parallel) THEN
508	#ifdef CPP_MPI
509	CALL MPI_COMM_SIZE(orch_comm,mpi_size_orch,ierr)
510	CALL MPI_COMM_RANK(orch_comm,mpi_rank_orch,ierr)
511	#endif
512	ELSE
513	mpi_rank_orch=0
514	mpi_size_orch=1
515	ENDIF
516
517	IF (is_parallel) THEN
518	IF (mpi_rank_orch /= 0) THEN
519	#ifdef CPP_MPI
520	CALL MPI_RECV(LastPoint,1,MPI_INTEGER,mpi_rank_orch-1,1234,orch_comm,status,ierr)
521	#endif
522	ENDIF
523
524	IF (mpi_rank_orch /= mpi_size_orch-1) THEN
525	#ifdef CPP_MPI
526	CALL MPI_SEND(MyLastPoint,1,MPI_INTEGER,mpi_rank_orch+1,1234,orch_comm,ierr)
527	#endif
528	ENDIF
529	ENDIF
530
531	IF (mpi_rank_orch == 0) THEN
532	offset=0
533	ELSE
534	offset=LastPoint-MOD(LastPoint,iim)
535	ENDIF
536
537	ktindex(1:knon)=knindex(1:knon)+(klon_mpi_begin+iim-1)-offset-1
538
539
540	END SUBROUTINE Init_orchidee_index
541	!
542	!****************************************************************************************
543	!
544	SUBROUTINE Get_orchidee_communicator(knon,orch_comm)
545
546	#ifdef CPP_MPI
547	INCLUDE 'mpif.h'
548	#endif
549
550
551	INTEGER,INTENT(IN) :: knon
552	INTEGER,INTENT(OUT) :: orch_comm
553
554	INTEGER :: color
555	INTEGER :: ierr
556	!
557	! End definition
558	!****************************************************************************************
559
560	IF (knon==0) THEN
561	color = 0
562	ELSE
563	color = 1
564	ENDIF
565
566	#ifdef CPP_MPI
567	CALL MPI_COMM_SPLIT(COMM_LMDZ_PHY,color,mpi_rank,orch_comm,ierr)
568	#endif
569
570	END SUBROUTINE Get_orchidee_communicator
571	!
572	!****************************************************************************************
573	!
574	SUBROUTINE Init_neighbours(knon,neighbours,ktindex,pctsrf)
575
576	INCLUDE "indicesol.h"
577	INCLUDE "dimensions.h"
578	#ifdef CPP_MPI
579	INCLUDE 'mpif.h'
580	#endif
581
582	! Input arguments
583	!****************************************************************************************
584	INTEGER, INTENT(IN) :: knon
585	INTEGER, DIMENSION(klon), INTENT(IN) :: ktindex
586	REAL, DIMENSION(klon), INTENT(IN) :: pctsrf
587
588	! Output arguments
589	!****************************************************************************************
590	INTEGER, DIMENSION(knon,8), INTENT(OUT) :: neighbours
591
592	! Local variables
593	!****************************************************************************************
594	INTEGER :: knon_g
595	INTEGER :: i, igrid, jj, ij, iglob
596	INTEGER :: ierr, ireal, index
597	INTEGER, DIMENSION(0:mpi_size-1) :: knon_nb
598	INTEGER, DIMENSION(0:mpi_size-1) :: displs
599	INTEGER, DIMENSION(8,3) :: off_ini
600	INTEGER, DIMENSION(8) :: offset
601	INTEGER, DIMENSION(knon) :: ktindex_p
602	INTEGER, DIMENSION(iim,jjm+1) :: correspond
603	INTEGER, ALLOCATABLE, DIMENSION(:) :: ktindex_g
604	INTEGER, ALLOCATABLE, DIMENSION(:,:) :: neighbours_g
605	REAL, DIMENSION(klon_glo) :: pctsrf_g
606
607	!
608	! End definition
609	!****************************************************************************************
610
611	IF (is_sequential) THEN
612	knon_nb(:)=knon
613	ELSE
614
615	#ifdef CPP_MPI
616	CALL MPI_GATHER(knon,1,MPI_INTEGER,knon_nb,1,MPI_INTEGER,0,COMM_LMDZ_PHY,ierr)
617	#endif
618
619	ENDIF
620
621	IF (is_mpi_root) THEN
622	knon_g=SUM(knon_nb(:))
623	ALLOCATE(ktindex_g(knon_g))
624	ALLOCATE(neighbours_g(knon_g,8))
625	neighbours_g(:,:)=-1
626	displs(0)=0
627	DO i=1,mpi_size-1
628	displs(i)=displs(i-1)+knon_nb(i-1)
629	ENDDO
630	ENDIF
631
632	ktindex_p(1:knon)=ktindex(1:knon)+klon_mpi_begin-1+iim-1
633
634	IF (is_sequential) THEN
635	ktindex_g(:)=ktindex_p(:)
636	ELSE
637
638	#ifdef CPP_MPI
639	CALL MPI_GATHERV(ktindex_p,knon,MPI_INTEGER,ktindex_g,knon_nb,&
640	displs,MPI_INTEGER,0,COMM_LMDZ_PHY,ierr)
641	#endif
642
643	ENDIF
644
645	CALL Gather(pctsrf,pctsrf_g)
646
647	IF (is_mpi_root) THEN
648	! Initialisation des offset
649	!
650	! offset bord ouest
651	off_ini(1,1) = - iim ; off_ini(2,1) = - iim + 1; off_ini(3,1) = 1
652	off_ini(4,1) = iim + 1; off_ini(5,1) = iim ; off_ini(6,1) = 2 * iim - 1
653	off_ini(7,1) = iim -1 ; off_ini(8,1) = - 1
654	! offset point normal
655	off_ini(1,2) = - iim ; off_ini(2,2) = - iim + 1; off_ini(3,2) = 1
656	off_ini(4,2) = iim + 1; off_ini(5,2) = iim ; off_ini(6,2) = iim - 1
657	off_ini(7,2) = -1 ; off_ini(8,2) = - iim - 1
658	! offset bord est
659	off_ini(1,3) = - iim; off_ini(2,3) = - 2 * iim + 1; off_ini(3,3) = - iim + 1
660	off_ini(4,3) = 1 ; off_ini(5,3) = iim ; off_ini(6,3) = iim - 1
661	off_ini(7,3) = -1 ; off_ini(8,3) = - iim - 1
662	!
663	!
664	! Attention aux poles
665	!
666	DO igrid = 1, knon_g
667	index = ktindex_g(igrid)
668	jj = INT((index - 1)/iim) + 1
669	ij = index - (jj - 1) * iim
670	correspond(ij,jj) = igrid
671	ENDDO
672
673	DO igrid = 1, knon_g
674	iglob = ktindex_g(igrid)
675	IF (MOD(iglob, iim) == 1) THEN
676	offset = off_ini(:,1)
677	ELSE IF(MOD(iglob, iim) == 0) THEN
678	offset = off_ini(:,3)
679	ELSE
680	offset = off_ini(:,2)
681	ENDIF
682	DO i = 1, 8
683	index = iglob + offset(i)
684	ireal = (MIN(MAX(1, index - iim + 1), klon_glo))
685	IF (pctsrf_g(ireal) > EPSFRA) THEN
686	jj = INT((index - 1)/iim) + 1
687	ij = index - (jj - 1) * iim
688	neighbours_g(igrid, i) = correspond(ij, jj)
689	ENDIF
690	ENDDO
691	ENDDO
692
693	ENDIF
694
695	DO i=1,8
696	IF (is_sequential) THEN
697	neighbours(:,i)=neighbours_g(:,i)
698	ELSE
699	#ifdef CPP_MPI
700	CALL MPI_SCATTERV(neighbours_g(:,i),knon_nb,displs,MPI_INTEGER,neighbours(:,i),knon,MPI_INTEGER,0,COMM_LMDZ_PHY,ierr)
701	#endif
702	ENDIF
703	ENDDO
704
705	END SUBROUTINE Init_neighbours
706	!
707	!****************************************************************************************
708	!
709
710	#endif
711	END MODULE surf_land_orchidee_noopenmp_mod

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

Download in other formats:

Original Format