Context Navigation

surf_land_orchidee_noopenmp_mod.F90 @ 2311

Last change on this file since 2311 was 2311, checked in by Ehouarn Millour, 9 years ago

Further modifications to enforce physics/dynamics separation:

moved iniprint.h and misc_mod back to dyn3d_common, as these should only be used by dynamics.
created print_control_mod in the physics to store flags prt_level, lunout, debug to be local to physics (should be used rather than iniprint.h)
created abort_physic.F90 , which does the same job as abort_gcm() did, but should be used instead when in physics.
reactivated inifis (turned it into a module, inifis_mod.F90) to initialize physical constants and print_control_mod flags.

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

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

Download in other formats:

Original Format