Context Navigation

surf_land_orchidee_noopenmp_mod.F90 @ 1675

Last change on this file since 1675 was 1548, checked in by jghattas, 13 years ago

Errors detected using compile option "-check bound" at titane.

ACo

File size: 26.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	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	INCLUDE "indicesol.h"
637	INCLUDE "dimensions.h"
638	#ifdef CPP_MPI
639	INCLUDE 'mpif.h'
640	#endif
641
642	! Input arguments
643	!****************************************************************************************
644	INTEGER, INTENT(IN) :: knon
645	INTEGER, DIMENSION(klon), INTENT(IN) :: ktindex
646	REAL, DIMENSION(klon), INTENT(IN) :: pctsrf
647
648	! Output arguments
649	!****************************************************************************************
650	INTEGER, DIMENSION(knon,8), INTENT(OUT) :: neighbours
651
652	! Local variables
653	!****************************************************************************************
654	INTEGER :: knon_g
655	INTEGER :: i, igrid, jj, ij, iglob
656	INTEGER :: ierr, ireal, index
657	INTEGER :: var_tmp
658	INTEGER, DIMENSION(0:mpi_size-1) :: knon_nb
659	INTEGER, DIMENSION(0:mpi_size-1) :: displs
660	INTEGER, DIMENSION(8,3) :: off_ini
661	INTEGER, DIMENSION(8) :: offset
662	INTEGER, DIMENSION(knon) :: ktindex_p
663	INTEGER, DIMENSION(iim,jjm+1) :: correspond
664	INTEGER, ALLOCATABLE, DIMENSION(:) :: ktindex_g
665	INTEGER, ALLOCATABLE, DIMENSION(:,:) :: neighbours_g
666	REAL, DIMENSION(klon_glo) :: pctsrf_g
667
668	!
669	! End definition
670	!****************************************************************************************
671
672	IF (is_sequential) THEN
673	knon_nb(:)=knon
674	ELSE
675
676	#ifdef CPP_MPI
677	CALL MPI_GATHER(knon,1,MPI_INTEGER,knon_nb,1,MPI_INTEGER,0,COMM_LMDZ_PHY,ierr)
678	#endif
679
680	ENDIF
681
682	IF (is_mpi_root) THEN
683	knon_g=SUM(knon_nb(:))
684	ALLOCATE(ktindex_g(knon_g))
685	ALLOCATE(neighbours_g(knon_g,8))
686	neighbours_g(:,:)=-1
687	displs(0)=0
688	DO i=1,mpi_size-1
689	displs(i)=displs(i-1)+knon_nb(i-1)
690	ENDDO
691	ELSE
692	ALLOCATE(neighbours_g(1,8))
693	ENDIF
694
695	ktindex_p(1:knon)=ktindex(1:knon)+klon_mpi_begin-1+iim-1
696
697	IF (is_sequential) THEN
698	ktindex_g(:)=ktindex_p(:)
699	ELSE
700
701	#ifdef CPP_MPI
702	CALL MPI_GATHERV(ktindex_p,knon,MPI_INTEGER,ktindex_g,knon_nb,&
703	displs,MPI_INTEGER,0,COMM_LMDZ_PHY,ierr)
704	#endif
705
706	ENDIF
707
708	CALL Gather(pctsrf,pctsrf_g)
709
710	IF (is_mpi_root) THEN
711	! Initialisation des offset
712	!
713	! offset bord ouest
714	off_ini(1,1) = - iim ; off_ini(2,1) = - iim + 1; off_ini(3,1) = 1
715	off_ini(4,1) = iim + 1; off_ini(5,1) = iim ; off_ini(6,1) = 2 * iim - 1
716	off_ini(7,1) = iim -1 ; off_ini(8,1) = - 1
717	! offset point normal
718	off_ini(1,2) = - iim ; off_ini(2,2) = - iim + 1; off_ini(3,2) = 1
719	off_ini(4,2) = iim + 1; off_ini(5,2) = iim ; off_ini(6,2) = iim - 1
720	off_ini(7,2) = -1 ; off_ini(8,2) = - iim - 1
721	! offset bord est
722	off_ini(1,3) = - iim; off_ini(2,3) = - 2 * iim + 1; off_ini(3,3) = - iim + 1
723	off_ini(4,3) = 1 ; off_ini(5,3) = iim ; off_ini(6,3) = iim - 1
724	off_ini(7,3) = -1 ; off_ini(8,3) = - iim - 1
725	!
726	!
727	! Attention aux poles
728	!
729	DO igrid = 1, knon_g
730	index = ktindex_g(igrid)
731	jj = INT((index - 1)/iim) + 1
732	ij = index - (jj - 1) * iim
733	correspond(ij,jj) = igrid
734	ENDDO
735
736	DO igrid = 1, knon_g
737	iglob = ktindex_g(igrid)
738	IF (MOD(iglob, iim) == 1) THEN
739	offset = off_ini(:,1)
740	ELSE IF(MOD(iglob, iim) == 0) THEN
741	offset = off_ini(:,3)
742	ELSE
743	offset = off_ini(:,2)
744	ENDIF
745	DO i = 1, 8
746	index = iglob + offset(i)
747	ireal = (MIN(MAX(1, index - iim + 1), klon_glo))
748	IF (pctsrf_g(ireal) > EPSFRA) THEN
749	jj = INT((index - 1)/iim) + 1
750	ij = index - (jj - 1) * iim
751	neighbours_g(igrid, i) = correspond(ij, jj)
752	ENDIF
753	ENDDO
754	ENDDO
755
756	ENDIF
757
758	DO i=1,8
759	IF (is_sequential) THEN
760	neighbours(:,i)=neighbours_g(:,i)
761	ELSE
762	#ifdef CPP_MPI
763	IF (knon > 0) THEN
764	! knon>0, scattter global field neighbours_g from master process to local process
765	CALL MPI_SCATTERV(neighbours_g(:,i),knon_nb,displs,MPI_INTEGER,neighbours(:,i),knon,MPI_INTEGER,0,COMM_LMDZ_PHY,ierr)
766	ELSE
767	! knon=0, no need to save the field for this process
768	CALL MPI_SCATTERV(neighbours_g(:,i),knon_nb,displs,MPI_INTEGER,var_tmp,knon,MPI_INTEGER,0,COMM_LMDZ_PHY,ierr)
769	END IF
770	#endif
771	ENDIF
772	ENDDO
773
774	END SUBROUTINE Init_neighbours
775	!
776	!****************************************************************************************
777	!
778
779	#endif
780	END MODULE surf_land_orchidee_noopenmp_mod

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

Download in other formats:

Original Format