Context Navigation

surf_land_orchidee_noopenmp_mod.F90 @ 2027

Last change on this file since 2027 was 1958, checked in by Laurent Fairhead, 11 years ago

Empêche l'exécution en mode debug

Crashes in debugging mode

Property copyright set to
Name of program: LMDZ
Creation date: 1984
Version: LMDZ5
License: CeCILL version 2
Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
See the license file in the root directory

File size: 26.6 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	USE indice_sol_mod
100	IMPLICIT NONE
101
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	INTEGER, SAVE :: nb_fields_cpl ! number of fields for the climate-carbon coupling (between ATM and ORCHIDEE).
141	REAL, SAVE, ALLOCATABLE, DIMENSION(:,:) :: fields_cpl ! Fluxes for the climate-carbon coupling
142	REAL, DIMENSION(klon) :: swdown_vrai
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	! Test de coherence
213	#ifndef ORCH_NEW
214	! Compilation avec orchidee nouvelle version necessaire avec carbon_cycle_cpl=y
215	IF (carbon_cycle_cpl) THEN
216	abort_message='You must define preprossing key ORCH_NEW when running carbon_cycle_cpl=y'
217	CALL abort_gcm(modname,abort_message,1)
218	END IF
219	#endif
220	ALLOCATE(ktindex(knon))
221	IF ( .NOT. ALLOCATED(albedo_keep)) THEN
222	ALLOCATE(albedo_keep(klon))
223	ALLOCATE(zlev(knon))
224	ENDIF
225	! Pb de correspondances de grilles
226	ALLOCATE(ig(klon))
227	ALLOCATE(jg(klon))
228	ig(1) = 1
229	jg(1) = 1
230	indi = 0
231	indj = 2
232	DO igrid = 2, klon - 1
233	indi = indi + 1
234	IF ( indi > iim) THEN
235	indi = 1
236	indj = indj + 1
237	ENDIF
238	ig(igrid) = indi
239	jg(igrid) = indj
240	ENDDO
241	ig(klon) = 1
242	jg(klon) = jjm + 1
243
244	IF ((.NOT. ALLOCATED(lalo))) THEN
245	ALLOCATE(lalo(knon,2), stat = error)
246	IF (error /= 0) THEN
247	abort_message='Pb allocation lalo'
248	CALL abort_gcm(modname,abort_message,1)
249	ENDIF
250	ENDIF
251	IF ((.NOT. ALLOCATED(lon_scat))) THEN
252	ALLOCATE(lon_scat(iim,jjm+1), stat = error)
253	IF (error /= 0) THEN
254	abort_message='Pb allocation lon_scat'
255	CALL abort_gcm(modname,abort_message,1)
256	ENDIF
257	ENDIF
258	IF ((.NOT. ALLOCATED(lat_scat))) THEN
259	ALLOCATE(lat_scat(iim,jjm+1), stat = error)
260	IF (error /= 0) THEN
261	abort_message='Pb allocation lat_scat'
262	CALL abort_gcm(modname,abort_message,1)
263	ENDIF
264	ENDIF
265	lon_scat = 0.
266	lat_scat = 0.
267	DO igrid = 1, knon
268	index = knindex(igrid)
269	lalo(igrid,2) = rlon(index)
270	lalo(igrid,1) = rlat(index)
271	ENDDO
272
273
274
275	CALL Gather(rlon,rlon_g)
276	CALL Gather(rlat,rlat_g)
277
278	IF (is_mpi_root) THEN
279	index = 1
280	DO jj = 2, jjm
281	DO ij = 1, iim
282	index = index + 1
283	lon_scat(ij,jj) = rlon_g(index)
284	lat_scat(ij,jj) = rlat_g(index)
285	ENDDO
286	ENDDO
287	lon_scat(:,1) = lon_scat(:,2)
288	lat_scat(:,1) = rlat_g(1)
289	lon_scat(:,jjm+1) = lon_scat(:,2)
290	lat_scat(:,jjm+1) = rlat_g(klon_glo)
291	ENDIF
292
293	CALL bcast(lon_scat)
294	CALL bcast(lat_scat)
295
296	!
297	! Allouer et initialiser le tableau des voisins et des fraction de continents
298	!
299	IF ( (.NOT.ALLOCATED(neighbours))) THEN
300	ALLOCATE(neighbours(knon,8), stat = error)
301	IF (error /= 0) THEN
302	abort_message='Pb allocation neighbours'
303	CALL abort_gcm(modname,abort_message,1)
304	ENDIF
305	ENDIF
306	neighbours = -1.
307	IF (( .NOT. ALLOCATED(contfrac))) THEN
308	ALLOCATE(contfrac(knon), stat = error)
309	IF (error /= 0) THEN
310	abort_message='Pb allocation contfrac'
311	CALL abort_gcm(modname,abort_message,1)
312	ENDIF
313	ENDIF
314
315	DO igrid = 1, knon
316	ireal = knindex(igrid)
317	contfrac(igrid) = pctsrf(ireal,is_ter)
318	ENDDO
319
320
321	CALL Init_neighbours(knon,neighbours,knindex,pctsrf(:,is_ter))
322
323	!
324	! Allocation et calcul resolutions
325	IF ( (.NOT.ALLOCATED(resolution))) THEN
326	ALLOCATE(resolution(knon,2), stat = error)
327	IF (error /= 0) THEN
328	abort_message='Pb allocation resolution'
329	CALL abort_gcm(modname,abort_message,1)
330	ENDIF
331	ENDIF
332	DO igrid = 1, knon
333	ij = knindex(igrid)
334	resolution(igrid,1) = cuphy(ij)
335	resolution(igrid,2) = cvphy(ij)
336	ENDDO
337
338	ALLOCATE(coastalflow(klon), stat = error)
339	IF (error /= 0) THEN
340	abort_message='Pb allocation coastalflow'
341	CALL abort_gcm(modname,abort_message,1)
342	ENDIF
343
344	ALLOCATE(riverflow(klon), stat = error)
345	IF (error /= 0) THEN
346	abort_message='Pb allocation riverflow'
347	CALL abort_gcm(modname,abort_message,1)
348	ENDIF
349
350	!
351	! Allocate variables needed for carbon_cycle_mod
352	IF ( carbon_cycle_cpl ) THEN
353	nb_fields_cpl=2
354	ELSE
355	nb_fields_cpl=1
356	END IF
357
358
359	IF (carbon_cycle_cpl) THEN
360	ALLOCATE(fco2_land_inst(klon),stat=error)
361	IF (error /= 0) CALL abort_gcm(modname,'Pb in allocation fco2_land_inst',1)
362
363	ALLOCATE(fco2_lu_inst(klon),stat=error)
364	IF(error /=0) CALL abort_gcm(modname,'Pb in allocation fco2_lu_inst',1)
365	END IF
366
367	ALLOCATE(fields_cpl(klon,nb_fields_cpl), stat = error)
368	IF (error /= 0) CALL abort_gcm(modname,'Pb in allocation fields_cpl',1)
369
370	ENDIF ! (fin debut)
371
372	!
373	! Appel a la routine sols continentaux
374	!
375	IF (lafin) lrestart_write = .TRUE.
376	IF (check) WRITE(lunout,*)'lafin ',lafin,lrestart_write
377
378	petA_orc(1:knon) = petBcoef(1:knon) * dtime
379	petB_orc(1:knon) = petAcoef(1:knon)
380	peqA_orc(1:knon) = peqBcoef(1:knon) * dtime
381	peqB_orc(1:knon) = peqAcoef(1:knon)
382
383	cdrag = 0.
384	cdrag(1:knon) = tq_cdrag(1:knon)
385
386	! zlev(1:knon) = (100.plev(1:knon))/((ps(1:knon)/287.05temp_air(1:knon))*9.80665)
387	zlev(1:knon) = (100.plev(1:knon))/((ps(1:knon)/RDtemp_air(1:knon))*RG)
388
389
390	! PF et PASB
391	! where(cdrag > 0.01)
392	! cdrag = 0.01
393	! endwhere
394	! write(,)'Cdrag = ',minval(cdrag),maxval(cdrag)
395
396	!
397	! Init Orchidee
398	!
399	! if (pole_nord) then
400	! offset=0
401	! ktindex(:)=ktindex(:)+iim-1
402	! else
403	! offset = klon_mpi_begin-1+iim-1
404	! ktindex(:)=ktindex(:)+MOD(offset,iim)
405	! offset=offset-MOD(offset,iim)
406	! endif
407
408	IF (debut) THEN
409	CALL Get_orchidee_communicator(knon,orch_comm)
410	IF (knon /=0) THEN
411	CALL Init_orchidee_index(knon,orch_comm,knindex,offset,ktindex)
412
413	#ifndef CPP_MPI
414	! Interface for ORCHIDEE compiled in sequential mode(without preprocessing flag CPP_MPI)
415	CALL intersurf_main (itime+itau_phy-1, iim, jjm+1, knon, ktindex, dtime, &
416	lrestart_read, lrestart_write, lalo, &
417	contfrac, neighbours, resolution, date0, &
418	zlev, u1_lay, v1_lay, spechum, temp_air, epot_air, ccanopy, &
419	cdrag, petA_orc, peqA_orc, petB_orc, peqB_orc, &
420	precip_rain, precip_snow, lwdown, swnet, swdown, ps, &
421	evap, fluxsens, fluxlat, coastalflow, riverflow, &
422	tsol_rad, tsurf_new, qsurf, albedo_out, emis_new, z0_new, &
423	lon_scat, lat_scat, q2m, t2m &
424	#ifdef ORCH_NEW
425	, nb_fields_cpl, fields_cpl)
426	#else
427	)
428	#endif
429
430	#else
431	! Interface for ORCHIDEE version 1.9 or later(1.9.2, 1.9.3, 1.9.4, 1.9.5) compiled in parallel mode(with preprocessing flag CPP_MPI)
432	CALL intersurf_main (itime+itau_phy-1, 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(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, q2m, t2m &
441	#ifdef ORCH_NEW
442	, nb_fields_cpl, fields_cpl(1:knon,:))
443	#else
444	)
445	#endif
446	#endif
447
448	ENDIF
449
450	albedo_keep(1:knon) = (albedo_out(1:knon,1)+albedo_out(1:knon,2))/2.
451
452	ENDIF
453
454	! swdown_vrai(1:knon) = swnet(1:knon)/(1. - albedo_keep(1:knon))
455	swdown_vrai(1:knon) = swdown(1:knon)
456
457	IF (knon /=0) THEN
458	#ifndef CPP_MPI
459	! Interface for ORCHIDEE compiled in sequential mode(without preprocessing flag CPP_MPI)
460	CALL intersurf_main (itime+itau_phy, iim, jjm+1, knon, ktindex, dtime, &
461	lrestart_read, lrestart_write, lalo, &
462	contfrac, neighbours, resolution, date0, &
463	zlev, u1_lay, v1_lay, spechum, temp_air, epot_air, ccanopy, &
464	cdrag, petA_orc, peqA_orc, petB_orc, peqB_orc, &
465	precip_rain, precip_snow, lwdown, swnet, swdown_vrai, ps, &
466	evap, fluxsens, fluxlat, coastalflow, riverflow, &
467	tsol_rad, tsurf_new, qsurf, albedo_out, emis_new, z0_new, &
468	lon_scat, lat_scat, q2m, t2m &
469	#ifdef ORCH_NEW
470	, nb_fields_cpl, fields_cpl)
471	#else
472	)
473	#endif
474	#else
475	! Interface for ORCHIDEE version 1.9 or later compiled in parallel mode(with preprocessing flag CPP_MPI)
476	CALL intersurf_main (itime+itau_phy, iim, jjm+1,offset, knon, ktindex, &
477	orch_comm,dtime, lrestart_read, lrestart_write, lalo, &
478	contfrac, neighbours, resolution, date0, &
479	zlev, u1_lay(1:knon), v1_lay(1:knon), spechum(1:knon), temp_air(1:knon), epot_air(1:knon), ccanopy(1:knon), &
480	cdrag(1:knon), petA_orc(1:knon), peqA_orc(1:knon), petB_orc(1:knon), peqB_orc(1:knon), &
481	precip_rain(1:knon), precip_snow(1:knon), lwdown(1:knon), swnet(1:knon), swdown_vrai(1:knon), ps(1:knon), &
482	evap(1:knon), fluxsens(1:knon), fluxlat(1:knon), coastalflow(1:knon), riverflow(1:knon), &
483	tsol_rad(1:knon), tsurf_new(1:knon), qsurf(1:knon), albedo_out(1:knon,:), emis_new(1:knon), z0_new(1:knon), &
484	lon_scat, lat_scat, q2m, t2m &
485	#ifdef ORCH_NEW
486	, nb_fields_cpl, fields_cpl(1:knon,:))
487	#else
488	)
489	#endif
490	#endif
491	ENDIF
492
493	albedo_keep(1:knon) = (albedo_out(1:knon,1)+albedo_out(1:knon,2))/2.
494
495	!* Send to coupler
496	!
497	IF (type_ocean=='couple') THEN
498	CALL cpl_send_land_fields(itime, knon, knindex, &
499	riverflow, coastalflow)
500	ENDIF
501
502	alb1_new(1:knon) = albedo_out(1:knon,1)
503	alb2_new(1:knon) = albedo_out(1:knon,2)
504
505	! Convention orchidee: positif vers le haut
506	fluxsens(1:knon) = -1. * fluxsens(1:knon)
507	fluxlat(1:knon) = -1. * fluxlat(1:knon)
508
509	! evap = -1. * evap
510
511	IF (debut) lrestart_read = .FALSE.
512
513	! Decompress variables for the module carbon_cycle_mod
514	IF (carbon_cycle_cpl) THEN
515	fco2_land_inst(:)=0.
516	fco2_lu_inst(:)=0.
517
518	DO igrid = 1, knon
519	ireal = knindex(igrid)
520	fco2_land_inst(ireal) = fields_cpl(igrid,1)
521	fco2_lu_inst(ireal) = fields_cpl(igrid,2)
522	END DO
523	END IF
524
525	#endif
526	END SUBROUTINE surf_land_orchidee
527	!
528	!****************************************************************************************
529	!
530	SUBROUTINE Init_orchidee_index(knon,orch_comm,knindex,offset,ktindex)
531
532	INCLUDE "dimensions.h"
533
534	#ifdef CPP_MPI
535	INCLUDE 'mpif.h'
536	#endif
537
538
539	! Input arguments
540	!****************************************************************************************
541	INTEGER, INTENT(IN) :: knon
542	INTEGER, INTENT(IN) :: orch_comm
543	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
544
545	! Output arguments
546	!****************************************************************************************
547	INTEGER, INTENT(OUT) :: offset
548	INTEGER, DIMENSION(knon), INTENT(OUT) :: ktindex
549
550	! Local varables
551	!****************************************************************************************
552	#ifdef CPP_MPI
553	INTEGER, DIMENSION(MPI_STATUS_SIZE) :: status
554	#endif
555
556	INTEGER :: MyLastPoint
557	INTEGER :: LastPoint
558	INTEGER :: mpi_rank_orch
559	INTEGER :: mpi_size_orch
560	INTEGER :: ierr
561	!
562	! End definition
563	!****************************************************************************************
564
565	MyLastPoint=klon_mpi_begin-1+knindex(knon)+iim-1
566
567	IF (is_parallel) THEN
568	#ifdef CPP_MPI
569	CALL MPI_COMM_SIZE(orch_comm,mpi_size_orch,ierr)
570	CALL MPI_COMM_RANK(orch_comm,mpi_rank_orch,ierr)
571	#endif
572	ELSE
573	mpi_rank_orch=0
574	mpi_size_orch=1
575	ENDIF
576
577	IF (is_parallel) THEN
578	IF (mpi_rank_orch /= 0) THEN
579	#ifdef CPP_MPI
580	CALL MPI_RECV(LastPoint,1,MPI_INTEGER,mpi_rank_orch-1,1234,orch_comm,status,ierr)
581	#endif
582	ENDIF
583
584	IF (mpi_rank_orch /= mpi_size_orch-1) THEN
585	#ifdef CPP_MPI
586	CALL MPI_SEND(MyLastPoint,1,MPI_INTEGER,mpi_rank_orch+1,1234,orch_comm,ierr)
587	#endif
588	ENDIF
589	ENDIF
590
591	IF (mpi_rank_orch == 0) THEN
592	offset=0
593	ELSE
594	offset=LastPoint-MOD(LastPoint,iim)
595	ENDIF
596
597	ktindex(1:knon)=knindex(1:knon)+(klon_mpi_begin+iim-1)-offset-1
598
599
600	END SUBROUTINE Init_orchidee_index
601	!
602	!****************************************************************************************
603	!
604	SUBROUTINE Get_orchidee_communicator(knon,orch_comm)
605
606	#ifdef CPP_MPI
607	INCLUDE 'mpif.h'
608	#endif
609
610
611	INTEGER,INTENT(IN) :: knon
612	INTEGER,INTENT(OUT) :: orch_comm
613
614	INTEGER :: color
615	INTEGER :: ierr
616	!
617	! End definition
618	!****************************************************************************************
619
620	IF (knon==0) THEN
621	color = 0
622	ELSE
623	color = 1
624	ENDIF
625
626	#ifdef CPP_MPI
627	CALL MPI_COMM_SPLIT(COMM_LMDZ_PHY,color,mpi_rank,orch_comm,ierr)
628	#endif
629
630	END SUBROUTINE Get_orchidee_communicator
631	!
632	!****************************************************************************************
633	!
634	SUBROUTINE Init_neighbours(knon,neighbours,ktindex,pctsrf)
635
636	USE indice_sol_mod
637
638	INCLUDE "dimensions.h"
639	#ifdef CPP_MPI
640	INCLUDE 'mpif.h'
641	#endif
642
643	! Input arguments
644	!****************************************************************************************
645	INTEGER, INTENT(IN) :: knon
646	INTEGER, DIMENSION(klon), INTENT(IN) :: ktindex
647	REAL, DIMENSION(klon), INTENT(IN) :: pctsrf
648
649	! Output arguments
650	!****************************************************************************************
651	INTEGER, DIMENSION(knon,8), INTENT(OUT) :: neighbours
652
653	! Local variables
654	!****************************************************************************************
655	INTEGER :: knon_g
656	INTEGER :: i, igrid, jj, ij, iglob
657	INTEGER :: ierr, ireal, index
658	INTEGER :: var_tmp
659	INTEGER, DIMENSION(0:mpi_size-1) :: knon_nb
660	INTEGER, DIMENSION(0:mpi_size-1) :: displs
661	INTEGER, DIMENSION(8,3) :: off_ini
662	INTEGER, DIMENSION(8) :: offset
663	INTEGER, DIMENSION(knon) :: ktindex_p
664	INTEGER, DIMENSION(iim,jjm+1) :: correspond
665	INTEGER, ALLOCATABLE, DIMENSION(:) :: ktindex_g
666	INTEGER, ALLOCATABLE, DIMENSION(:,:) :: neighbours_g
667	REAL, DIMENSION(klon_glo) :: pctsrf_g
668
669	!
670	! End definition
671	!****************************************************************************************
672
673	IF (is_sequential) THEN
674	knon_nb(:)=knon
675	ELSE
676
677	#ifdef CPP_MPI
678	CALL MPI_GATHER(knon,1,MPI_INTEGER,knon_nb,1,MPI_INTEGER,0,COMM_LMDZ_PHY,ierr)
679	#endif
680
681	ENDIF
682
683	IF (is_mpi_root) THEN
684	knon_g=SUM(knon_nb(:))
685	ALLOCATE(ktindex_g(knon_g))
686	ALLOCATE(neighbours_g(knon_g,8))
687	neighbours_g(:,:)=-1
688	displs(0)=0
689	DO i=1,mpi_size-1
690	displs(i)=displs(i-1)+knon_nb(i-1)
691	ENDDO
692	ELSE
693	ALLOCATE(ktindex_g(1))
694	ALLOCATE(neighbours_g(1,8))
695	ENDIF
696
697	ktindex_p(1:knon)=ktindex(1:knon)+klon_mpi_begin-1+iim-1
698
699	IF (is_sequential) THEN
700	ktindex_g(:)=ktindex_p(:)
701	ELSE
702
703	#ifdef CPP_MPI
704	CALL MPI_GATHERV(ktindex_p,knon,MPI_INTEGER,ktindex_g,knon_nb,&
705	displs,MPI_INTEGER,0,COMM_LMDZ_PHY,ierr)
706	#endif
707
708	ENDIF
709
710	CALL Gather(pctsrf,pctsrf_g)
711
712	IF (is_mpi_root) THEN
713	! Initialisation des offset
714	!
715	! offset bord ouest
716	off_ini(1,1) = - iim ; off_ini(2,1) = - iim + 1; off_ini(3,1) = 1
717	off_ini(4,1) = iim + 1; off_ini(5,1) = iim ; off_ini(6,1) = 2 * iim - 1
718	off_ini(7,1) = iim -1 ; off_ini(8,1) = - 1
719	! offset point normal
720	off_ini(1,2) = - iim ; off_ini(2,2) = - iim + 1; off_ini(3,2) = 1
721	off_ini(4,2) = iim + 1; off_ini(5,2) = iim ; off_ini(6,2) = iim - 1
722	off_ini(7,2) = -1 ; off_ini(8,2) = - iim - 1
723	! offset bord est
724	off_ini(1,3) = - iim; off_ini(2,3) = - 2 * iim + 1; off_ini(3,3) = - iim + 1
725	off_ini(4,3) = 1 ; off_ini(5,3) = iim ; off_ini(6,3) = iim - 1
726	off_ini(7,3) = -1 ; off_ini(8,3) = - iim - 1
727	!
728	!
729	! Attention aux poles
730	!
731	DO igrid = 1, knon_g
732	index = ktindex_g(igrid)
733	jj = INT((index - 1)/iim) + 1
734	ij = index - (jj - 1) * iim
735	correspond(ij,jj) = igrid
736	ENDDO
737
738	DO igrid = 1, knon_g
739	iglob = ktindex_g(igrid)
740	IF (MOD(iglob, iim) == 1) THEN
741	offset = off_ini(:,1)
742	ELSE IF(MOD(iglob, iim) == 0) THEN
743	offset = off_ini(:,3)
744	ELSE
745	offset = off_ini(:,2)
746	ENDIF
747	DO i = 1, 8
748	index = iglob + offset(i)
749	ireal = (MIN(MAX(1, index - iim + 1), klon_glo))
750	IF (pctsrf_g(ireal) > EPSFRA) THEN
751	jj = INT((index - 1)/iim) + 1
752	ij = index - (jj - 1) * iim
753	neighbours_g(igrid, i) = correspond(ij, jj)
754	ENDIF
755	ENDDO
756	ENDDO
757
758	ENDIF
759
760	DO i=1,8
761	IF (is_sequential) THEN
762	neighbours(:,i)=neighbours_g(:,i)
763	ELSE
764	#ifdef CPP_MPI
765	IF (knon > 0) THEN
766	! knon>0, scattter global field neighbours_g from master process to local process
767	CALL MPI_SCATTERV(neighbours_g(:,i),knon_nb,displs,MPI_INTEGER,neighbours(:,i),knon,MPI_INTEGER,0,COMM_LMDZ_PHY,ierr)
768	ELSE
769	! knon=0, no need to save the field for this process
770	CALL MPI_SCATTERV(neighbours_g(:,i),knon_nb,displs,MPI_INTEGER,var_tmp,knon,MPI_INTEGER,0,COMM_LMDZ_PHY,ierr)
771	END IF
772	#endif
773	ENDIF
774	ENDDO
775
776	END SUBROUTINE Init_neighbours
777	!
778	!****************************************************************************************
779	!
780
781	#endif
782	END MODULE surf_land_orchidee_noopenmp_mod

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

Download in other formats:

Original Format