Context Navigation

surf_land_orchidee_noopenmp_mod.F90 @ 1563

Last change on this file since 1563 was 1279, checked in by Laurent Fairhead, 15 years ago
Merged LMDZ4-dev branch changes r1241:1278 into the trunk Running trunk and LMDZ4-dev in LMDZOR configuration on local machine (sequential) and SX8 (4-proc) yields identical results (restart and restartphy are identical binarily) Log history from r1241 to r1278 is available by switching to source:LMDZ4/branches/LMDZ4-dev-20091210
File size: 25.5 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, correspond au co2_send de
71	! carbon_cycle_mod ou valeur constant co2_ppm
72	! tq_cdrag cdrag
73	! petAcoef coeff. A de la resolution de la CL pour t
74	! peqAcoef coeff. A de la resolution de la CL pour q
75	! petBcoef coeff. B de la resolution de la CL pour t
76	! peqBcoef coeff. B de la resolution de la CL pour q
77	! precip_rain precipitation liquide
78	! precip_snow precipitation solide
79	! lwdown flux IR descendant a la surface
80	! swnet flux solaire net
81	! swdown flux solaire entrant a la surface
82	! ps pression au sol
83	! radsol rayonnement net aus sol (LW + SW)
84	!
85	!
86	! output:
87	! evap evaporation totale
88	! fluxsens flux de chaleur sensible
89	! fluxlat flux de chaleur latente
90	! tsol_rad
91	! tsurf_new temperature au sol
92	! alb1_new albedo in visible SW interval
93	! alb2_new albedo in near IR interval
94	! emis_new emissivite
95	! z0_new surface roughness
96	! qsurf air moisture at surface
97	!
98	USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, fco2_land_inst, fco2_lu_inst
99	IMPLICIT NONE
100
101	INCLUDE "indicesol.h"
102	INCLUDE "temps.h"
103	INCLUDE "YOMCST.h"
104	INCLUDE "iniprint.h"
105	INCLUDE "dimensions.h"
106
107	!
108	! Parametres d'entree
109	!****************************************************************************************
110	INTEGER, INTENT(IN) :: itime
111	REAL, INTENT(IN) :: dtime
112	REAL, INTENT(IN) :: date0
113	INTEGER, INTENT(IN) :: knon
114	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
115	LOGICAL, INTENT(IN) :: debut, lafin
116	REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
117	REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat
118	REAL, DIMENSION(klon), INTENT(IN) :: plev
119	REAL, DIMENSION(klon), INTENT(IN) :: u1_lay, v1_lay
120	REAL, DIMENSION(klon), INTENT(IN) :: temp_air, spechum
121	REAL, DIMENSION(klon), INTENT(IN) :: epot_air, ccanopy
122	REAL, DIMENSION(klon), INTENT(IN) :: tq_cdrag
123	REAL, DIMENSION(klon), INTENT(IN) :: petAcoef, peqAcoef
124	REAL, DIMENSION(klon), INTENT(IN) :: petBcoef, peqBcoef
125	REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow
126	REAL, DIMENSION(klon), INTENT(IN) :: lwdown, swnet, swdown, ps
127	REAL, DIMENSION(klon), INTENT(IN) :: q2m, t2m
128
129	! Parametres de sortie
130	!****************************************************************************************
131	REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat, qsurf
132	REAL, DIMENSION(klon), INTENT(OUT) :: tsol_rad, tsurf_new
133	REAL, DIMENSION(klon), INTENT(OUT) :: alb1_new, alb2_new
134	REAL, DIMENSION(klon), INTENT(OUT) :: emis_new, z0_new
135
136	! Local
137	!****************************************************************************************
138	INTEGER :: ij, jj, igrid, ireal, index
139	INTEGER :: error
140	REAL, DIMENSION(klon) :: swdown_vrai
141	REAL, DIMENSION(klon) :: fco2_land_comp ! sur grille compresse
142	REAL, DIMENSION(klon) :: fco2_lu_comp ! sur grille compresse
143	CHARACTER (len = 20) :: modname = 'surf_land_orchidee'
144	CHARACTER (len = 80) :: abort_message
145	LOGICAL,SAVE :: check = .FALSE.
146	!$OMP THREADPRIVATE(check)
147
148	! type de couplage dans sechiba
149	! character (len=10) :: coupling = 'implicit'
150	! drapeaux controlant les appels dans SECHIBA
151	! type(control_type), save :: control_in
152	! Preserved albedo
153	REAL, ALLOCATABLE, DIMENSION(:), SAVE :: albedo_keep, zlev
154	!$OMP THREADPRIVATE(albedo_keep,zlev)
155	! coordonnees geographiques
156	REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: lalo
157	!$OMP THREADPRIVATE(lalo)
158	! pts voisins
159	INTEGER,ALLOCATABLE, DIMENSION(:,:), SAVE :: neighbours
160	!$OMP THREADPRIVATE(neighbours)
161	! fractions continents
162	REAL,ALLOCATABLE, DIMENSION(:), SAVE :: contfrac
163	!$OMP THREADPRIVATE(contfrac)
164	! resolution de la grille
165	REAL, ALLOCATABLE, DIMENSION (:,:), SAVE :: resolution
166	!$OMP THREADPRIVATE(resolution)
167
168	REAL, ALLOCATABLE, DIMENSION (:,:), SAVE :: lon_scat, lat_scat
169	!$OMP THREADPRIVATE(lon_scat,lat_scat)
170
171	LOGICAL, SAVE :: lrestart_read = .TRUE.
172	!$OMP THREADPRIVATE(lrestart_read)
173	LOGICAL, SAVE :: lrestart_write = .FALSE.
174	!$OMP THREADPRIVATE(lrestart_write)
175
176	REAL, DIMENSION(knon,2) :: albedo_out
177	!$OMP THREADPRIVATE(albedo_out)
178
179	! Pb de nomenclature
180	REAL, DIMENSION(klon) :: petA_orc, peqA_orc
181	REAL, DIMENSION(klon) :: petB_orc, peqB_orc
182	! Pb de correspondances de grilles
183	INTEGER, DIMENSION(:), SAVE, ALLOCATABLE :: ig, jg
184	!$OMP THREADPRIVATE(ig,jg)
185	INTEGER :: indi, indj
186	INTEGER, SAVE, ALLOCATABLE,DIMENSION(:) :: ktindex
187	!$OMP THREADPRIVATE(ktindex)
188
189	! Essai cdrag
190	REAL, DIMENSION(klon) :: cdrag
191	INTEGER,SAVE :: offset
192	!$OMP THREADPRIVATE(offset)
193
194	REAL, DIMENSION(klon_glo) :: rlon_g,rlat_g
195	INTEGER, SAVE :: orch_comm
196	!$OMP THREADPRIVATE(orch_comm)
197
198	REAL, ALLOCATABLE, DIMENSION(:), SAVE :: coastalflow
199	!$OMP THREADPRIVATE(coastalflow)
200	REAL, ALLOCATABLE, DIMENSION(:), SAVE :: riverflow
201	!$OMP THREADPRIVATE(riverflow)
202	!
203	! Fin definition
204	!****************************************************************************************
205	#ifdef CPP_VEGET
206
207	IF (check) WRITE(lunout,*)'Entree ', modname
208
209	! Initialisation
210
211	IF (debut) THEN
212	ALLOCATE(ktindex(knon))
213	IF ( .NOT. ALLOCATED(albedo_keep)) THEN
214	ALLOCATE(albedo_keep(klon))
215	ALLOCATE(zlev(knon))
216	ENDIF
217	! Pb de correspondances de grilles
218	ALLOCATE(ig(klon))
219	ALLOCATE(jg(klon))
220	ig(1) = 1
221	jg(1) = 1
222	indi = 0
223	indj = 2
224	DO igrid = 2, klon - 1
225	indi = indi + 1
226	IF ( indi > iim) THEN
227	indi = 1
228	indj = indj + 1
229	ENDIF
230	ig(igrid) = indi
231	jg(igrid) = indj
232	ENDDO
233	ig(klon) = 1
234	jg(klon) = jjm + 1
235
236	IF ((.NOT. ALLOCATED(lalo))) THEN
237	ALLOCATE(lalo(knon,2), stat = error)
238	IF (error /= 0) THEN
239	abort_message='Pb allocation lalo'
240	CALL abort_gcm(modname,abort_message,1)
241	ENDIF
242	ENDIF
243	IF ((.NOT. ALLOCATED(lon_scat))) THEN
244	ALLOCATE(lon_scat(iim,jjm+1), stat = error)
245	IF (error /= 0) THEN
246	abort_message='Pb allocation lon_scat'
247	CALL abort_gcm(modname,abort_message,1)
248	ENDIF
249	ENDIF
250	IF ((.NOT. ALLOCATED(lat_scat))) THEN
251	ALLOCATE(lat_scat(iim,jjm+1), stat = error)
252	IF (error /= 0) THEN
253	abort_message='Pb allocation lat_scat'
254	CALL abort_gcm(modname,abort_message,1)
255	ENDIF
256	ENDIF
257	lon_scat = 0.
258	lat_scat = 0.
259	DO igrid = 1, knon
260	index = knindex(igrid)
261	lalo(igrid,2) = rlon(index)
262	lalo(igrid,1) = rlat(index)
263	ENDDO
264
265
266
267	CALL Gather(rlon,rlon_g)
268	CALL Gather(rlat,rlat_g)
269
270	IF (is_mpi_root) THEN
271	index = 1
272	DO jj = 2, jjm
273	DO ij = 1, iim
274	index = index + 1
275	lon_scat(ij,jj) = rlon_g(index)
276	lat_scat(ij,jj) = rlat_g(index)
277	ENDDO
278	ENDDO
279	lon_scat(:,1) = lon_scat(:,2)
280	lat_scat(:,1) = rlat_g(1)
281	lon_scat(:,jjm+1) = lon_scat(:,2)
282	lat_scat(:,jjm+1) = rlat_g(klon_glo)
283	ENDIF
284
285	CALL bcast(lon_scat)
286	CALL bcast(lat_scat)
287
288	!
289	! Allouer et initialiser le tableau des voisins et des fraction de continents
290	!
291	IF ( (.NOT.ALLOCATED(neighbours))) THEN
292	ALLOCATE(neighbours(knon,8), stat = error)
293	IF (error /= 0) THEN
294	abort_message='Pb allocation neighbours'
295	CALL abort_gcm(modname,abort_message,1)
296	ENDIF
297	ENDIF
298	neighbours = -1.
299	IF (( .NOT. ALLOCATED(contfrac))) THEN
300	ALLOCATE(contfrac(knon), stat = error)
301	IF (error /= 0) THEN
302	abort_message='Pb allocation contfrac'
303	CALL abort_gcm(modname,abort_message,1)
304	ENDIF
305	ENDIF
306
307	DO igrid = 1, knon
308	ireal = knindex(igrid)
309	contfrac(igrid) = pctsrf(ireal,is_ter)
310	ENDDO
311
312
313	CALL Init_neighbours(knon,neighbours,knindex,pctsrf(:,is_ter))
314
315	!
316	! Allocation et calcul resolutions
317	IF ( (.NOT.ALLOCATED(resolution))) THEN
318	ALLOCATE(resolution(knon,2), stat = error)
319	IF (error /= 0) THEN
320	abort_message='Pb allocation resolution'
321	CALL abort_gcm(modname,abort_message,1)
322	ENDIF
323	ENDIF
324	DO igrid = 1, knon
325	ij = knindex(igrid)
326	resolution(igrid,1) = cuphy(ij)
327	resolution(igrid,2) = cvphy(ij)
328	ENDDO
329
330	ALLOCATE(coastalflow(klon), stat = error)
331	IF (error /= 0) THEN
332	abort_message='Pb allocation coastalflow'
333	CALL abort_gcm(modname,abort_message,1)
334	ENDIF
335
336	ALLOCATE(riverflow(klon), stat = error)
337	IF (error /= 0) THEN
338	abort_message='Pb allocation riverflow'
339	CALL abort_gcm(modname,abort_message,1)
340	ENDIF
341
342	!
343	! Allocate variables needed for carbon_cycle_mod
344	!
345	IF (carbon_cycle_cpl) THEN
346	IF (.NOT. ALLOCATED(fco2_land_inst)) THEN
347	ALLOCATE(fco2_land_inst(klon),stat=error)
348	IF (error /= 0) CALL abort_gcm(modname,'Pb in allocation fco2_land_inst',1)
349
350	ALLOCATE(fco2_lu_inst(klon),stat=error)
351	IF(error /=0) CALL abort_gcm(modname,'Pb in allocation fco2_lu_inst',1)
352	END IF
353	END IF
354
355	ENDIF ! (fin debut)
356
357	!
358	! Appel a la routine sols continentaux
359	!
360	IF (lafin) lrestart_write = .TRUE.
361	IF (check) WRITE(lunout,*)'lafin ',lafin,lrestart_write
362
363	petA_orc(1:knon) = petBcoef(1:knon) * dtime
364	petB_orc(1:knon) = petAcoef(1:knon)
365	peqA_orc(1:knon) = peqBcoef(1:knon) * dtime
366	peqB_orc(1:knon) = peqAcoef(1:knon)
367
368	cdrag = 0.
369	cdrag(1:knon) = tq_cdrag(1:knon)
370
371	! zlev(1:knon) = (100.plev(1:knon))/((ps(1:knon)/287.05temp_air(1:knon))*9.80665)
372	zlev(1:knon) = (100.plev(1:knon))/((ps(1:knon)/RDtemp_air(1:knon))*RG)
373
374
375	! PF et PASB
376	! where(cdrag > 0.01)
377	! cdrag = 0.01
378	! endwhere
379	! write(,)'Cdrag = ',minval(cdrag),maxval(cdrag)
380
381	!
382	! Init Orchidee
383	!
384	! if (pole_nord) then
385	! offset=0
386	! ktindex(:)=ktindex(:)+iim-1
387	! else
388	! offset = klon_mpi_begin-1+iim-1
389	! ktindex(:)=ktindex(:)+MOD(offset,iim)
390	! offset=offset-MOD(offset,iim)
391	! endif
392
393	IF (debut) THEN
394	CALL Get_orchidee_communicator(knon,orch_comm)
395	IF (knon /=0) THEN
396	CALL Init_orchidee_index(knon,orch_comm,knindex,offset,ktindex)
397
398	#ifndef CPP_MPI
399	! Interface for ORCHIDEE compiled in sequential mode(without preprocessing flag CPP_MPI)
400	CALL intersurf_main (itime+itau_phy-1, iim, jjm+1, knon, ktindex, dtime, &
401	lrestart_read, lrestart_write, lalo, &
402	contfrac, neighbours, resolution, date0, &
403	zlev, u1_lay, v1_lay, spechum, temp_air, epot_air, ccanopy, &
404	cdrag, petA_orc, peqA_orc, petB_orc, peqB_orc, &
405	precip_rain, precip_snow, lwdown, swnet, swdown, ps, &
406	evap, fluxsens, fluxlat, coastalflow, riverflow, &
407	tsol_rad, tsurf_new, qsurf, albedo_out, emis_new, z0_new, &
408	lon_scat, lat_scat, q2m, t2m)
409
410	#else
411	! Interface for ORCHIDEE version 1.9 or later(1.9.2, 1.9.3, 1.9.4) compiled in parallel mode(with preprocessing flag CPP_MPI)
412	CALL intersurf_main (itime+itau_phy-1, iim, jjm+1, offset, knon, ktindex, &
413	orch_comm, dtime, lrestart_read, lrestart_write, lalo, &
414	contfrac, neighbours, resolution, date0, &
415	zlev, u1_lay(1:knon), v1_lay(1:knon), spechum(1:knon), temp_air(1:knon), epot_air(1:knon), ccanopy(1:knon), &
416	cdrag(1:knon), petA_orc(1:knon), peqA_orc(1:knon), petB_orc(1:knon), peqB_orc(1:knon), &
417	precip_rain(1:knon), precip_snow(1:knon), lwdown(1:knon), swnet(1:knon), swdown(1:knon), ps(1:knon), &
418	evap(1:knon), fluxsens(1:knon), fluxlat(1:knon), coastalflow(1:knon), riverflow(1:knon), &
419	tsol_rad(1:knon), tsurf_new(1:knon), qsurf(1:knon), albedo_out(1:knon,:), emis_new(1:knon), z0_new(1:knon), &
420	lon_scat, lat_scat, q2m, t2m)
421	#endif
422
423	ENDIF
424
425	albedo_keep(1:knon) = (albedo_out(1:knon,1)+albedo_out(1:knon,2))/2.
426
427	ENDIF
428
429	! swdown_vrai(1:knon) = swnet(1:knon)/(1. - albedo_keep(1:knon))
430	swdown_vrai(1:knon) = swdown(1:knon)
431
432	IF (knon /=0) THEN
433
434	#ifndef CPP_MPI
435	! Interface for ORCHIDEE compiled in sequential mode(without preprocessing flag CPP_MPI)
436	CALL intersurf_main (itime+itau_phy, iim, jjm+1, knon, ktindex, dtime, &
437	lrestart_read, lrestart_write, lalo, &
438	contfrac, neighbours, resolution, date0, &
439	zlev, u1_lay, v1_lay, spechum, temp_air, epot_air, ccanopy, &
440	cdrag, petA_orc, peqA_orc, petB_orc, peqB_orc, &
441	precip_rain, precip_snow, lwdown, swnet, swdown_vrai, ps, &
442	evap, fluxsens, fluxlat, coastalflow, riverflow, &
443	tsol_rad, tsurf_new, qsurf, albedo_out, emis_new, z0_new, &
444	lon_scat, lat_scat, q2m, t2m)
445
446	#else
447	! Interface for ORCHIDEE version 1.9 or later compiled in parallel mode(with preprocessing flag CPP_MPI)
448	CALL intersurf_main (itime+itau_phy, iim, jjm+1,offset, knon, ktindex, &
449	orch_comm,dtime, lrestart_read, lrestart_write, lalo, &
450	contfrac, neighbours, resolution, date0, &
451	zlev, u1_lay(1:knon), v1_lay(1:knon), spechum(1:knon), temp_air(1:knon), epot_air(1:knon), ccanopy(1:knon), &
452	cdrag(1:knon), petA_orc(1:knon), peqA_orc(1:knon), petB_orc(1:knon), peqB_orc(1:knon), &
453	precip_rain(1:knon), precip_snow(1:knon), lwdown(1:knon), swnet(1:knon), swdown_vrai(1:knon), ps(1:knon), &
454	evap(1:knon), fluxsens(1:knon), fluxlat(1:knon), coastalflow(1:knon), riverflow(1:knon), &
455	tsol_rad(1:knon), tsurf_new(1:knon), qsurf(1:knon), albedo_out(1:knon,:), emis_new(1:knon), z0_new(1:knon), &
456	lon_scat, lat_scat, q2m, t2m)
457	#endif
458
459	ENDIF
460
461	albedo_keep(1:knon) = (albedo_out(1:knon,1)+albedo_out(1:knon,2))/2.
462
463	!* Send to coupler
464	!
465	IF (type_ocean=='couple') THEN
466	CALL cpl_send_land_fields(itime, knon, knindex, &
467	riverflow, coastalflow)
468	ENDIF
469
470	alb1_new(1:knon) = albedo_out(1:knon,1)
471	alb2_new(1:knon) = albedo_out(1:knon,2)
472
473	! Convention orchidee: positif vers le haut
474	fluxsens(1:knon) = -1. * fluxsens(1:knon)
475	fluxlat(1:knon) = -1. * fluxlat(1:knon)
476
477	! evap = -1. * evap
478
479	IF (debut) lrestart_read = .FALSE.
480
481
482	! JG : TEMPORAIRE!!!! Les variables fco2_land_comp et fco2_lu_comp seront plus tard en sortie d'ORCHIDEE
483	! ici mis a valeur quelquonque pour test. Ces variables sont sur la grille compresse avec uniquement des points de terres
484
485	fco2_land_comp(:) = 1.
486	fco2_lu_comp(:) = 10.
487
488	! Decompress variables for the module carbon_cycle_mod
489	IF (carbon_cycle_cpl) THEN
490	fco2_land_inst(:)=0.
491	fco2_lu_inst(:)=0.
492
493	DO igrid = 1, knon
494	ireal = knindex(igrid)
495	fco2_land_inst(ireal) = fco2_land_comp(igrid)
496	fco2_lu_inst(ireal) = fco2_lu_comp(igrid)
497	END DO
498	END IF
499
500	#endif
501	END SUBROUTINE surf_land_orchidee
502	!
503	!****************************************************************************************
504	!
505	SUBROUTINE Init_orchidee_index(knon,orch_comm,knindex,offset,ktindex)
506
507	INCLUDE "dimensions.h"
508
509	#ifdef CPP_MPI
510	INCLUDE 'mpif.h'
511	#endif
512
513
514	! Input arguments
515	!****************************************************************************************
516	INTEGER, INTENT(IN) :: knon
517	INTEGER, INTENT(IN) :: orch_comm
518	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
519
520	! Output arguments
521	!****************************************************************************************
522	INTEGER, INTENT(OUT) :: offset
523	INTEGER, DIMENSION(knon), INTENT(OUT) :: ktindex
524
525	! Local varables
526	!****************************************************************************************
527	#ifdef CPP_MPI
528	INTEGER, DIMENSION(MPI_STATUS_SIZE) :: status
529	#endif
530
531	INTEGER :: MyLastPoint
532	INTEGER :: LastPoint
533	INTEGER :: mpi_rank_orch
534	INTEGER :: mpi_size_orch
535	INTEGER :: ierr
536	!
537	! End definition
538	!****************************************************************************************
539
540	MyLastPoint=klon_mpi_begin-1+knindex(knon)+iim-1
541
542	IF (is_parallel) THEN
543	#ifdef CPP_MPI
544	CALL MPI_COMM_SIZE(orch_comm,mpi_size_orch,ierr)
545	CALL MPI_COMM_RANK(orch_comm,mpi_rank_orch,ierr)
546	#endif
547	ELSE
548	mpi_rank_orch=0
549	mpi_size_orch=1
550	ENDIF
551
552	IF (is_parallel) THEN
553	IF (mpi_rank_orch /= 0) THEN
554	#ifdef CPP_MPI
555	CALL MPI_RECV(LastPoint,1,MPI_INTEGER,mpi_rank_orch-1,1234,orch_comm,status,ierr)
556	#endif
557	ENDIF
558
559	IF (mpi_rank_orch /= mpi_size_orch-1) THEN
560	#ifdef CPP_MPI
561	CALL MPI_SEND(MyLastPoint,1,MPI_INTEGER,mpi_rank_orch+1,1234,orch_comm,ierr)
562	#endif
563	ENDIF
564	ENDIF
565
566	IF (mpi_rank_orch == 0) THEN
567	offset=0
568	ELSE
569	offset=LastPoint-MOD(LastPoint,iim)
570	ENDIF
571
572	ktindex(1:knon)=knindex(1:knon)+(klon_mpi_begin+iim-1)-offset-1
573
574
575	END SUBROUTINE Init_orchidee_index
576	!
577	!****************************************************************************************
578	!
579	SUBROUTINE Get_orchidee_communicator(knon,orch_comm)
580
581	#ifdef CPP_MPI
582	INCLUDE 'mpif.h'
583	#endif
584
585
586	INTEGER,INTENT(IN) :: knon
587	INTEGER,INTENT(OUT) :: orch_comm
588
589	INTEGER :: color
590	INTEGER :: ierr
591	!
592	! End definition
593	!****************************************************************************************
594
595	IF (knon==0) THEN
596	color = 0
597	ELSE
598	color = 1
599	ENDIF
600
601	#ifdef CPP_MPI
602	CALL MPI_COMM_SPLIT(COMM_LMDZ_PHY,color,mpi_rank,orch_comm,ierr)
603	#endif
604
605	END SUBROUTINE Get_orchidee_communicator
606	!
607	!****************************************************************************************
608	!
609	SUBROUTINE Init_neighbours(knon,neighbours,ktindex,pctsrf)
610
611	INCLUDE "indicesol.h"
612	INCLUDE "dimensions.h"
613	#ifdef CPP_MPI
614	INCLUDE 'mpif.h'
615	#endif
616
617	! Input arguments
618	!****************************************************************************************
619	INTEGER, INTENT(IN) :: knon
620	INTEGER, DIMENSION(klon), INTENT(IN) :: ktindex
621	REAL, DIMENSION(klon), INTENT(IN) :: pctsrf
622
623	! Output arguments
624	!****************************************************************************************
625	INTEGER, DIMENSION(knon,8), INTENT(OUT) :: neighbours
626
627	! Local variables
628	!****************************************************************************************
629	INTEGER :: knon_g
630	INTEGER :: i, igrid, jj, ij, iglob
631	INTEGER :: ierr, ireal, index
632	INTEGER, DIMENSION(0:mpi_size-1) :: knon_nb
633	INTEGER, DIMENSION(0:mpi_size-1) :: displs
634	INTEGER, DIMENSION(8,3) :: off_ini
635	INTEGER, DIMENSION(8) :: offset
636	INTEGER, DIMENSION(knon) :: ktindex_p
637	INTEGER, DIMENSION(iim,jjm+1) :: correspond
638	INTEGER, ALLOCATABLE, DIMENSION(:) :: ktindex_g
639	INTEGER, ALLOCATABLE, DIMENSION(:,:) :: neighbours_g
640	REAL, DIMENSION(klon_glo) :: pctsrf_g
641
642	!
643	! End definition
644	!****************************************************************************************
645
646	IF (is_sequential) THEN
647	knon_nb(:)=knon
648	ELSE
649
650	#ifdef CPP_MPI
651	CALL MPI_GATHER(knon,1,MPI_INTEGER,knon_nb,1,MPI_INTEGER,0,COMM_LMDZ_PHY,ierr)
652	#endif
653
654	ENDIF
655
656	IF (is_mpi_root) THEN
657	knon_g=SUM(knon_nb(:))
658	ALLOCATE(ktindex_g(knon_g))
659	ALLOCATE(neighbours_g(knon_g,8))
660	neighbours_g(:,:)=-1
661	displs(0)=0
662	DO i=1,mpi_size-1
663	displs(i)=displs(i-1)+knon_nb(i-1)
664	ENDDO
665	ELSE
666	ALLOCATE(neighbours_g(1,8))
667	ENDIF
668
669	ktindex_p(1:knon)=ktindex(1:knon)+klon_mpi_begin-1+iim-1
670
671	IF (is_sequential) THEN
672	ktindex_g(:)=ktindex_p(:)
673	ELSE
674
675	#ifdef CPP_MPI
676	CALL MPI_GATHERV(ktindex_p,knon,MPI_INTEGER,ktindex_g,knon_nb,&
677	displs,MPI_INTEGER,0,COMM_LMDZ_PHY,ierr)
678	#endif
679
680	ENDIF
681
682	CALL Gather(pctsrf,pctsrf_g)
683
684	IF (is_mpi_root) THEN
685	! Initialisation des offset
686	!
687	! offset bord ouest
688	off_ini(1,1) = - iim ; off_ini(2,1) = - iim + 1; off_ini(3,1) = 1
689	off_ini(4,1) = iim + 1; off_ini(5,1) = iim ; off_ini(6,1) = 2 * iim - 1
690	off_ini(7,1) = iim -1 ; off_ini(8,1) = - 1
691	! offset point normal
692	off_ini(1,2) = - iim ; off_ini(2,2) = - iim + 1; off_ini(3,2) = 1
693	off_ini(4,2) = iim + 1; off_ini(5,2) = iim ; off_ini(6,2) = iim - 1
694	off_ini(7,2) = -1 ; off_ini(8,2) = - iim - 1
695	! offset bord est
696	off_ini(1,3) = - iim; off_ini(2,3) = - 2 * iim + 1; off_ini(3,3) = - iim + 1
697	off_ini(4,3) = 1 ; off_ini(5,3) = iim ; off_ini(6,3) = iim - 1
698	off_ini(7,3) = -1 ; off_ini(8,3) = - iim - 1
699	!
700	!
701	! Attention aux poles
702	!
703	DO igrid = 1, knon_g
704	index = ktindex_g(igrid)
705	jj = INT((index - 1)/iim) + 1
706	ij = index - (jj - 1) * iim
707	correspond(ij,jj) = igrid
708	ENDDO
709
710	DO igrid = 1, knon_g
711	iglob = ktindex_g(igrid)
712	IF (MOD(iglob, iim) == 1) THEN
713	offset = off_ini(:,1)
714	ELSE IF(MOD(iglob, iim) == 0) THEN
715	offset = off_ini(:,3)
716	ELSE
717	offset = off_ini(:,2)
718	ENDIF
719	DO i = 1, 8
720	index = iglob + offset(i)
721	ireal = (MIN(MAX(1, index - iim + 1), klon_glo))
722	IF (pctsrf_g(ireal) > EPSFRA) THEN
723	jj = INT((index - 1)/iim) + 1
724	ij = index - (jj - 1) * iim
725	neighbours_g(igrid, i) = correspond(ij, jj)
726	ENDIF
727	ENDDO
728	ENDDO
729
730	ENDIF
731
732	DO i=1,8
733	IF (is_sequential) THEN
734	neighbours(:,i)=neighbours_g(:,i)
735	ELSE
736	#ifdef CPP_MPI
737	CALL MPI_SCATTERV(neighbours_g(:,i),knon_nb,displs,MPI_INTEGER,neighbours(:,i),knon,MPI_INTEGER,0,COMM_LMDZ_PHY,ierr)
738	#endif
739	ENDIF
740	ENDDO
741
742	END SUBROUTINE Init_neighbours
743	!
744	!****************************************************************************************
745	!
746
747	#endif
748	END MODULE surf_land_orchidee_noopenmp_mod

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

Download in other formats:

Original Format