Context Navigation

surf_land_orchidee_noopenmp_mod.F90 @ 2347

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