Context Navigation

surf_land_orchidee_noopenmp_mod.F90 @ 2925

Last change on this file since 2925 was 2925, checked in by fcheruy, 7 years ago
Update tree branch to trunk version
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: 27.3 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
8	! (not MPI-OpenMP mixte) until revision 1077 in the ORCHIDEE trunk.
9
10	#ifdef ORCHIDEE_NOOPENMP
11	!
12	! This module controles the interface towards the model ORCHIDEE
13	!
14	! Subroutines in this module : surf_land_orchidee
15	! Init_orchidee_index
16	! Get_orchidee_communicator
17	! Init_neighbours
18	USE dimphy
19	#ifdef CPP_VEGET
20	USE intersurf ! module d'ORCHIDEE
21	#endif
22	USE cpl_mod, ONLY : cpl_send_land_fields
23	USE surface_data, ONLY : type_ocean
24	USE geometry_mod, ONLY : dx, dy
25	USE mod_grid_phy_lmdz
26	USE mod_phys_lmdz_para
27
28	IMPLICIT NONE
29
30	PRIVATE
31	PUBLIC :: surf_land_orchidee
32
33	CONTAINS
34	!
35	!****************************************************************************************
36	!
37	SUBROUTINE surf_land_orchidee(itime, dtime, date0, knon, &
38	knindex, rlon, rlat, yrmu0, pctsrf, &
39	debut, lafin, &
40	plev, u1_lay, v1_lay, gustiness, temp_air, spechum, epot_air, ccanopy, &
41	tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
42	precip_rain, precip_snow, lwdown, swnet, swdown, &
43	ps, q2m, t2m, &
44	evap, fluxsens, fluxlat, &
45	tsol_rad, tsurf_new, alb1_new, alb2_new, &
46	emis_new, z0_new, z0h_new, qsurf)
47	!
48	! Cette routine sert d'interface entre le modele atmospherique et le
49	! modele de sol continental. Appel a sechiba
50	!
51	! L. Fairhead 02/2000
52	!
53	! input:
54	! itime numero du pas de temps
55	! dtime pas de temps de la physique (en s)
56	! nisurf index de la surface a traiter (1 = sol continental)
57	! knon nombre de points de la surface a traiter
58	! knindex index des points de la surface a traiter
59	! rlon longitudes de la grille entiere
60	! rlat latitudes de la grille entiere
61	! pctsrf tableau des fractions de surface de chaque maille
62	! debut logical: 1er appel a la physique (lire les restart)
63	! lafin logical: dernier appel a la physique (ecrire les restart)
64	! (si false calcul simplifie des fluxs sur les continents)
65	! plev hauteur de la premiere couche (Pa)
66	! u1_lay vitesse u 1ere couche
67	! v1_lay vitesse v 1ere couche
68	! temp_air temperature de l'air 1ere couche
69	! spechum humidite specifique 1ere couche
70	! epot_air temp pot de l'air
71	! ccanopy concentration CO2 canopee, correspond au co2_send de
72	! carbon_cycle_mod ou valeur constant co2_ppm
73	! tq_cdrag cdrag
74	! petAcoef coeff. A de la resolution de la CL pour t
75	! peqAcoef coeff. A de la resolution de la CL pour q
76	! petBcoef coeff. B de la resolution de la CL pour t
77	! peqBcoef coeff. B de la resolution de la CL pour q
78	! precip_rain precipitation liquide
79	! precip_snow precipitation solide
80	! lwdown flux IR descendant a la surface
81	! swnet flux solaire net
82	! swdown flux solaire entrant a la surface
83	! ps pression au sol
84	! radsol rayonnement net aus sol (LW + SW)
85	!
86	!
87	! output:
88	! evap evaporation totale
89	! fluxsens flux de chaleur sensible
90	! fluxlat flux de chaleur latente
91	! tsol_rad
92	! tsurf_new temperature au sol
93	! alb1_new albedo in visible SW interval
94	! alb2_new albedo in near IR interval
95	! emis_new emissivite
96	! z0_new surface roughness
97	! z0h_new surface roughness, it is the same as z0_new
98	! qsurf air moisture at surface
99	!
100	USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, fco2_land_inst, fco2_lu_inst
101	USE indice_sol_mod
102	USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat
103	USE print_control_mod, ONLY: lunout
104	#ifdef CPP_VEGET
105	USE time_phylmdz_mod, ONLY: itau_phy
106	#endif
107	IMPLICIT NONE
108
109	INCLUDE "YOMCST.h"
110
111	!
112	! Parametres d'entree
113	!****************************************************************************************
114	INTEGER, INTENT(IN) :: itime
115	REAL, INTENT(IN) :: dtime
116	REAL, INTENT(IN) :: date0
117	INTEGER, INTENT(IN) :: knon
118	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
119	LOGICAL, INTENT(IN) :: debut, lafin
120	REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
121	REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat
122	REAL, DIMENSION(klon), INTENT(IN) :: yrmu0
123	REAL, DIMENSION(klon), INTENT(IN) :: plev
124	REAL, DIMENSION(klon), INTENT(IN) :: u1_lay, v1_lay, gustiness
125	REAL, DIMENSION(klon), INTENT(IN) :: temp_air, spechum
126	REAL, DIMENSION(klon), INTENT(IN) :: epot_air, ccanopy
127	REAL, DIMENSION(klon), INTENT(IN) :: tq_cdrag
128	REAL, DIMENSION(klon), INTENT(IN) :: petAcoef, peqAcoef
129	REAL, DIMENSION(klon), INTENT(IN) :: petBcoef, peqBcoef
130	REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow
131	REAL, DIMENSION(klon), INTENT(IN) :: lwdown, swnet, swdown, ps
132	REAL, DIMENSION(klon), INTENT(IN) :: q2m, t2m
133
134	! Parametres de sortie
135	!****************************************************************************************
136	REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat, qsurf
137	REAL, DIMENSION(klon), INTENT(OUT) :: tsol_rad, tsurf_new
138	REAL, DIMENSION(klon), INTENT(OUT) :: alb1_new, alb2_new
139	REAL, DIMENSION(klon), INTENT(OUT) :: emis_new, z0_new, z0h_new
140
141	! Local
142	!****************************************************************************************
143	INTEGER :: ij, jj, igrid, ireal, index
144	INTEGER :: error
145	INTEGER, SAVE :: nb_fields_cpl ! number of fields for the climate-carbon coupling (between ATM and ORCHIDEE).
146	!$OMP THREADPRIVATE(nb_fields_cpl)
147	REAL, SAVE, ALLOCATABLE, DIMENSION(:,:) :: fields_cpl ! Fluxes for the climate-carbon coupling
148	!$OMP THREADPRIVATE(fields_cpl)
149	REAL, DIMENSION(klon) :: swdown_vrai
150	CHARACTER (len = 20) :: modname = 'surf_land_orchidee'
151	CHARACTER (len = 80) :: abort_message
152	LOGICAL,SAVE :: check = .FALSE.
153	!$OMP THREADPRIVATE(check)
154
155	! type de couplage dans sechiba
156	! character (len=10) :: coupling = 'implicit'
157	! drapeaux controlant les appels dans SECHIBA
158	! type(control_type), save :: control_in
159	! Preserved albedo
160	REAL, ALLOCATABLE, DIMENSION(:), SAVE :: albedo_keep, zlev
161	!$OMP THREADPRIVATE(albedo_keep,zlev)
162	! coordonnees geographiques
163	REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: lalo
164	!$OMP THREADPRIVATE(lalo)
165	! pts voisins
166	INTEGER,ALLOCATABLE, DIMENSION(:,:), SAVE :: neighbours
167	!$OMP THREADPRIVATE(neighbours)
168	! fractions continents
169	REAL,ALLOCATABLE, DIMENSION(:), SAVE :: contfrac
170	!$OMP THREADPRIVATE(contfrac)
171	! resolution de la grille
172	REAL, ALLOCATABLE, DIMENSION (:,:), SAVE :: resolution
173	!$OMP THREADPRIVATE(resolution)
174
175	REAL, ALLOCATABLE, DIMENSION (:,:), SAVE :: lon_scat, lat_scat
176	!$OMP THREADPRIVATE(lon_scat,lat_scat)
177
178	LOGICAL, SAVE :: lrestart_read = .TRUE.
179	!$OMP THREADPRIVATE(lrestart_read)
180	LOGICAL, SAVE :: lrestart_write = .FALSE.
181	!$OMP THREADPRIVATE(lrestart_write)
182
183	REAL, DIMENSION(knon,2) :: albedo_out
184	!$OMP THREADPRIVATE(albedo_out)
185
186	! Pb de nomenclature
187	REAL, DIMENSION(klon) :: petA_orc, peqA_orc
188	REAL, DIMENSION(klon) :: petB_orc, peqB_orc
189	! Pb de correspondances de grilles
190	INTEGER, DIMENSION(:), SAVE, ALLOCATABLE :: ig, jg
191	!$OMP THREADPRIVATE(ig,jg)
192	INTEGER :: indi, indj
193	INTEGER, SAVE, ALLOCATABLE,DIMENSION(:) :: ktindex
194	!$OMP THREADPRIVATE(ktindex)
195
196	! Essai cdrag
197	REAL, DIMENSION(klon) :: cdrag
198	INTEGER,SAVE :: offset
199	!$OMP THREADPRIVATE(offset)
200
201	REAL, DIMENSION(klon_glo) :: rlon_g,rlat_g
202	INTEGER, SAVE :: orch_comm
203	!$OMP THREADPRIVATE(orch_comm)
204
205	REAL, ALLOCATABLE, DIMENSION(:), SAVE :: coastalflow
206	!$OMP THREADPRIVATE(coastalflow)
207	REAL, ALLOCATABLE, DIMENSION(:), SAVE :: riverflow
208	!$OMP THREADPRIVATE(riverflow)
209	!
210	! Fin definition
211	!****************************************************************************************
212	#ifdef CPP_VEGET
213
214	IF (check) WRITE(lunout,*)'Entree ', modname
215
216	! Initialisation
217
218	IF (debut) THEN
219	! Test de coherence
220	#ifndef ORCH_NEW
221	! Compilation avec orchidee nouvelle version necessaire avec carbon_cycle_cpl=y
222	IF (carbon_cycle_cpl) THEN
223	abort_message='You must define preprossing key ORCH_NEW when running carbon_cycle_cpl=y'
224	CALL abort_physic(modname,abort_message,1)
225	END IF
226	#endif
227	ALLOCATE(ktindex(knon))
228	IF ( .NOT. ALLOCATED(albedo_keep)) THEN
229	ALLOCATE(albedo_keep(klon))
230	ALLOCATE(zlev(knon))
231	ENDIF
232	! Pb de correspondances de grilles
233	ALLOCATE(ig(klon))
234	ALLOCATE(jg(klon))
235	ig(1) = 1
236	jg(1) = 1
237	indi = 0
238	indj = 2
239	DO igrid = 2, klon - 1
240	indi = indi + 1
241	IF ( indi > nbp_lon) THEN
242	indi = 1
243	indj = indj + 1
244	ENDIF
245	ig(igrid) = indi
246	jg(igrid) = indj
247	ENDDO
248	ig(klon) = 1
249	jg(klon) = nbp_lat
250
251	IF ((.NOT. ALLOCATED(lalo))) THEN
252	ALLOCATE(lalo(knon,2), stat = error)
253	IF (error /= 0) THEN
254	abort_message='Pb allocation lalo'
255	CALL abort_physic(modname,abort_message,1)
256	ENDIF
257	ENDIF
258	IF ((.NOT. ALLOCATED(lon_scat))) THEN
259	ALLOCATE(lon_scat(nbp_lon,nbp_lat), stat = error)
260	IF (error /= 0) THEN
261	abort_message='Pb allocation lon_scat'
262	CALL abort_physic(modname,abort_message,1)
263	ENDIF
264	ENDIF
265	IF ((.NOT. ALLOCATED(lat_scat))) THEN
266	ALLOCATE(lat_scat(nbp_lon,nbp_lat), stat = error)
267	IF (error /= 0) THEN
268	abort_message='Pb allocation lat_scat'
269	CALL abort_physic(modname,abort_message,1)
270	ENDIF
271	ENDIF
272	lon_scat = 0.
273	lat_scat = 0.
274	DO igrid = 1, knon
275	index = knindex(igrid)
276	lalo(igrid,2) = rlon(index)
277	lalo(igrid,1) = rlat(index)
278	ENDDO
279
280
281
282	CALL Gather(rlon,rlon_g)
283	CALL Gather(rlat,rlat_g)
284
285	IF (is_mpi_root) THEN
286	index = 1
287	DO jj = 2, nbp_lat-1
288	DO ij = 1, nbp_lon
289	index = index + 1
290	lon_scat(ij,jj) = rlon_g(index)
291	lat_scat(ij,jj) = rlat_g(index)
292	ENDDO
293	ENDDO
294	lon_scat(:,1) = lon_scat(:,2)
295	lat_scat(:,1) = rlat_g(1)
296	lon_scat(:,nbp_lat) = lon_scat(:,2)
297	lat_scat(:,nbp_lat) = rlat_g(klon_glo)
298	ENDIF
299
300	CALL bcast(lon_scat)
301	CALL bcast(lat_scat)
302
303	!
304	! Allouer et initialiser le tableau des voisins et des fraction de continents
305	!
306	IF ( (.NOT.ALLOCATED(neighbours))) THEN
307	ALLOCATE(neighbours(knon,8), stat = error)
308	IF (error /= 0) THEN
309	abort_message='Pb allocation neighbours'
310	CALL abort_physic(modname,abort_message,1)
311	ENDIF
312	ENDIF
313	neighbours = -1.
314	IF (( .NOT. ALLOCATED(contfrac))) THEN
315	ALLOCATE(contfrac(knon), stat = error)
316	IF (error /= 0) THEN
317	abort_message='Pb allocation contfrac'
318	CALL abort_physic(modname,abort_message,1)
319	ENDIF
320	ENDIF
321
322	DO igrid = 1, knon
323	ireal = knindex(igrid)
324	contfrac(igrid) = pctsrf(ireal,is_ter)
325	ENDDO
326
327
328	CALL Init_neighbours(knon,neighbours,knindex,pctsrf(:,is_ter))
329
330	!
331	! Allocation et calcul resolutions
332	IF ( (.NOT.ALLOCATED(resolution))) THEN
333	ALLOCATE(resolution(knon,2), stat = error)
334	IF (error /= 0) THEN
335	abort_message='Pb allocation resolution'
336	CALL abort_physic(modname,abort_message,1)
337	ENDIF
338	ENDIF
339	DO igrid = 1, knon
340	ij = knindex(igrid)
341	resolution(igrid,1) = dx(ij)
342	resolution(igrid,2) = dy(ij)
343	ENDDO
344
345	ALLOCATE(coastalflow(klon), stat = error)
346	IF (error /= 0) THEN
347	abort_message='Pb allocation coastalflow'
348	CALL abort_physic(modname,abort_message,1)
349	ENDIF
350
351	ALLOCATE(riverflow(klon), stat = error)
352	IF (error /= 0) THEN
353	abort_message='Pb allocation riverflow'
354	CALL abort_physic(modname,abort_message,1)
355	ENDIF
356
357	!
358	! Allocate variables needed for carbon_cycle_mod
359	IF ( carbon_cycle_cpl ) THEN
360	nb_fields_cpl=2
361	ELSE
362	nb_fields_cpl=1
363	END IF
364
365
366	IF (carbon_cycle_cpl) THEN
367	ALLOCATE(fco2_land_inst(klon),stat=error)
368	IF (error /= 0) CALL abort_physic(modname,'Pb in allocation fco2_land_inst',1)
369
370	ALLOCATE(fco2_lu_inst(klon),stat=error)
371	IF(error /=0) CALL abort_physic(modname,'Pb in allocation fco2_lu_inst',1)
372	END IF
373
374	ALLOCATE(fields_cpl(klon,nb_fields_cpl), stat = error)
375	IF (error /= 0) CALL abort_physic(modname,'Pb in allocation fields_cpl',1)
376
377	ENDIF ! (fin debut)
378
379	!
380	! Appel a la routine sols continentaux
381	!
382	IF (lafin) lrestart_write = .TRUE.
383	IF (check) WRITE(lunout,*)'lafin ',lafin,lrestart_write
384
385	petA_orc(1:knon) = petBcoef(1:knon) * dtime
386	petB_orc(1:knon) = petAcoef(1:knon)
387	peqA_orc(1:knon) = peqBcoef(1:knon) * dtime
388	peqB_orc(1:knon) = peqAcoef(1:knon)
389
390	cdrag = 0.
391	cdrag(1:knon) = tq_cdrag(1:knon)
392
393	! zlev(1:knon) = (100.plev(1:knon))/((ps(1:knon)/287.05temp_air(1:knon))*9.80665)
394	zlev(1:knon) = (100.plev(1:knon))/((ps(1:knon)/RDtemp_air(1:knon))*RG)
395
396
397	! PF et PASB
398	! where(cdrag > 0.01)
399	! cdrag = 0.01
400	! endwhere
401	! write(,)'Cdrag = ',minval(cdrag),maxval(cdrag)
402
403	!
404	! Init Orchidee
405	!
406	! if (pole_nord) then
407	! offset=0
408	! ktindex(:)=ktindex(:)+nbp_lon-1
409	! else
410	! offset = klon_mpi_begin-1+nbp_lon-1
411	! ktindex(:)=ktindex(:)+MOD(offset,nbp_lon)
412	! offset=offset-MOD(offset,nbp_lon)
413	! endif
414
415	IF (debut) THEN
416	CALL Get_orchidee_communicator(knon,orch_comm)
417	IF (knon /=0) THEN
418	CALL Init_orchidee_index(knon,orch_comm,knindex,offset,ktindex)
419
420	#ifndef CPP_MPI
421	! Interface for ORCHIDEE compiled in sequential mode(without preprocessing flag CPP_MPI)
422	CALL intersurf_main (itime+itau_phy-1, nbp_lon, nbp_lat, knon, ktindex, dtime, &
423	lrestart_read, lrestart_write, lalo, &
424	contfrac, neighbours, resolution, date0, &
425	zlev, u1_lay, v1_lay, spechum, temp_air, epot_air, ccanopy, &
426	cdrag, petA_orc, peqA_orc, petB_orc, peqB_orc, &
427	precip_rain, precip_snow, lwdown, swnet, swdown, ps, &
428	evap, fluxsens, fluxlat, coastalflow, riverflow, &
429	tsol_rad, tsurf_new, qsurf, albedo_out, emis_new, z0_new, &
430	lon_scat, lat_scat, q2m, t2m &
431	#ifdef ORCH_NEW
432	, nb_fields_cpl, fields_cpl)
433	#else
434	)
435	#endif
436
437	#else
438	! 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)
439	CALL intersurf_main (itime+itau_phy-1, nbp_lon, nbp_lat, offset, knon, ktindex, &
440	orch_comm, dtime, lrestart_read, lrestart_write, lalo, &
441	contfrac, neighbours, resolution, date0, &
442	zlev, u1_lay(1:knon), v1_lay(1:knon), spechum(1:knon), temp_air(1:knon), epot_air(1:knon), ccanopy(1:knon), &
443	cdrag(1:knon), petA_orc(1:knon), peqA_orc(1:knon), petB_orc(1:knon), peqB_orc(1:knon), &
444	precip_rain(1:knon), precip_snow(1:knon), lwdown(1:knon), swnet(1:knon), swdown(1:knon), ps(1:knon), &
445	evap(1:knon), fluxsens(1:knon), fluxlat(1:knon), coastalflow(1:knon), riverflow(1:knon), &
446	tsol_rad(1:knon), tsurf_new(1:knon), qsurf(1:knon), albedo_out(1:knon,:), emis_new(1:knon), z0_new(1:knon), &
447	lon_scat, lat_scat, q2m, t2m &
448	#ifdef ORCH_NEW
449	, nb_fields_cpl, fields_cpl(1:knon,:))
450	#else
451	)
452	#endif
453	#endif
454
455	ENDIF
456
457	albedo_keep(1:knon) = (albedo_out(1:knon,1)+albedo_out(1:knon,2))/2.
458
459	ENDIF
460
461	! swdown_vrai(1:knon) = swnet(1:knon)/(1. - albedo_keep(1:knon))
462	swdown_vrai(1:knon) = swdown(1:knon)
463
464	IF (knon /=0) THEN
465	#ifndef CPP_MPI
466	! Interface for ORCHIDEE compiled in sequential mode(without preprocessing flag CPP_MPI)
467	CALL intersurf_main (itime+itau_phy, nbp_lon, nbp_lat, knon, ktindex, dtime, &
468	lrestart_read, lrestart_write, lalo, &
469	contfrac, neighbours, resolution, date0, &
470	zlev, u1_lay, v1_lay, spechum, temp_air, epot_air, ccanopy, &
471	cdrag, petA_orc, peqA_orc, petB_orc, peqB_orc, &
472	precip_rain, precip_snow, lwdown, swnet, swdown_vrai, ps, &
473	evap, fluxsens, fluxlat, coastalflow, riverflow, &
474	tsol_rad, tsurf_new, qsurf, albedo_out, emis_new, z0_new, &
475	lon_scat, lat_scat, q2m, t2m &
476	#ifdef ORCH_NEW
477	, nb_fields_cpl, fields_cpl)
478	#else
479	)
480	#endif
481	#else
482	! Interface for ORCHIDEE version 1.9 or later compiled in parallel mode(with preprocessing flag CPP_MPI)
483	CALL intersurf_main (itime+itau_phy, nbp_lon, nbp_lat,offset, knon, ktindex, &
484	orch_comm,dtime, lrestart_read, lrestart_write, lalo, &
485	contfrac, neighbours, resolution, date0, &
486	zlev, u1_lay(1:knon), v1_lay(1:knon), spechum(1:knon), temp_air(1:knon), epot_air(1:knon), ccanopy(1:knon), &
487	cdrag(1:knon), petA_orc(1:knon), peqA_orc(1:knon), petB_orc(1:knon), peqB_orc(1:knon), &
488	precip_rain(1:knon), precip_snow(1:knon), lwdown(1:knon), swnet(1:knon), swdown_vrai(1:knon), ps(1:knon), &
489	evap(1:knon), fluxsens(1:knon), fluxlat(1:knon), coastalflow(1:knon), riverflow(1:knon), &
490	tsol_rad(1:knon), tsurf_new(1:knon), qsurf(1:knon), albedo_out(1:knon,:), emis_new(1:knon), z0_new(1:knon), &
491	lon_scat, lat_scat, q2m, t2m &
492	#ifdef ORCH_NEW
493	, nb_fields_cpl, fields_cpl(1:knon,:))
494	#else
495	)
496	#endif
497	#endif
498	ENDIF
499
500	albedo_keep(1:knon) = (albedo_out(1:knon,1)+albedo_out(1:knon,2))/2.
501
502	! ORCHIDEE only gives one value for z0_new. Copy it into z0h_new.
503	z0h_new(:)=z0_new(:)
504
505	!* Send to coupler
506	!
507	IF (type_ocean=='couple') THEN
508	CALL cpl_send_land_fields(itime, knon, knindex, &
509	riverflow, coastalflow)
510	ENDIF
511
512	alb1_new(1:knon) = albedo_out(1:knon,1)
513	alb2_new(1:knon) = albedo_out(1:knon,2)
514
515	! Convention orchidee: positif vers le haut
516	fluxsens(1:knon) = -1. * fluxsens(1:knon)
517	fluxlat(1:knon) = -1. * fluxlat(1:knon)
518
519	! evap = -1. * evap
520
521	IF (debut) lrestart_read = .FALSE.
522
523	! Decompress variables for the module carbon_cycle_mod
524	IF (carbon_cycle_cpl) THEN
525	fco2_land_inst(:)=0.
526	fco2_lu_inst(:)=0.
527
528	DO igrid = 1, knon
529	ireal = knindex(igrid)
530	fco2_land_inst(ireal) = fields_cpl(igrid,1)
531	fco2_lu_inst(ireal) = fields_cpl(igrid,2)
532	END DO
533	END IF
534
535	#endif
536	END SUBROUTINE surf_land_orchidee
537	!
538	!****************************************************************************************
539	!
540	SUBROUTINE Init_orchidee_index(knon,orch_comm,knindex,offset,ktindex)
541
542	USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat
543
544	#ifdef CPP_MPI
545	INCLUDE 'mpif.h'
546	#endif
547
548
549	! Input arguments
550	!****************************************************************************************
551	INTEGER, INTENT(IN) :: knon
552	INTEGER, INTENT(IN) :: orch_comm
553	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
554
555	! Output arguments
556	!****************************************************************************************
557	INTEGER, INTENT(OUT) :: offset
558	INTEGER, DIMENSION(knon), INTENT(OUT) :: ktindex
559
560	! Local varables
561	!****************************************************************************************
562	#ifdef CPP_MPI
563	INTEGER, DIMENSION(MPI_STATUS_SIZE) :: status
564	#endif
565
566	INTEGER :: MyLastPoint
567	INTEGER :: LastPoint
568	INTEGER :: mpi_rank_orch
569	INTEGER :: mpi_size_orch
570	INTEGER :: ierr
571	!
572	! End definition
573	!****************************************************************************************
574
575	MyLastPoint=klon_mpi_begin-1+knindex(knon)+nbp_lon-1
576
577	IF (is_parallel) THEN
578	#ifdef CPP_MPI
579	CALL MPI_COMM_SIZE(orch_comm,mpi_size_orch,ierr)
580	CALL MPI_COMM_RANK(orch_comm,mpi_rank_orch,ierr)
581	#endif
582	ELSE
583	mpi_rank_orch=0
584	mpi_size_orch=1
585	ENDIF
586
587	IF (is_parallel) THEN
588	IF (mpi_rank_orch /= 0) THEN
589	#ifdef CPP_MPI
590	CALL MPI_RECV(LastPoint,1,MPI_INTEGER,mpi_rank_orch-1,1234,orch_comm,status,ierr)
591	#endif
592	ENDIF
593
594	IF (mpi_rank_orch /= mpi_size_orch-1) THEN
595	#ifdef CPP_MPI
596	CALL MPI_SEND(MyLastPoint,1,MPI_INTEGER,mpi_rank_orch+1,1234,orch_comm,ierr)
597	#endif
598	ENDIF
599	ENDIF
600
601	IF (mpi_rank_orch == 0) THEN
602	offset=0
603	ELSE
604	offset=LastPoint-MOD(LastPoint,nbp_lon)
605	ENDIF
606
607	ktindex(1:knon)=knindex(1:knon)+(klon_mpi_begin+nbp_lon-1)-offset-1
608
609
610	END SUBROUTINE Init_orchidee_index
611	!
612	!****************************************************************************************
613	!
614	SUBROUTINE Get_orchidee_communicator(knon,orch_comm)
615
616	#ifdef CPP_MPI
617	INCLUDE 'mpif.h'
618	#endif
619
620
621	INTEGER,INTENT(IN) :: knon
622	INTEGER,INTENT(OUT) :: orch_comm
623
624	INTEGER :: color
625	INTEGER :: ierr
626	!
627	! End definition
628	!****************************************************************************************
629
630	IF (knon==0) THEN
631	color = 0
632	ELSE
633	color = 1
634	ENDIF
635
636	#ifdef CPP_MPI
637	CALL MPI_COMM_SPLIT(COMM_LMDZ_PHY,color,mpi_rank,orch_comm,ierr)
638	#endif
639
640	END SUBROUTINE Get_orchidee_communicator
641	!
642	!****************************************************************************************
643	!
644	SUBROUTINE Init_neighbours(knon,neighbours,ktindex,pctsrf)
645
646	USE indice_sol_mod
647	USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat
648
649	#ifdef CPP_MPI
650	INCLUDE 'mpif.h'
651	#endif
652
653	! Input arguments
654	!****************************************************************************************
655	INTEGER, INTENT(IN) :: knon
656	INTEGER, DIMENSION(klon), INTENT(IN) :: ktindex
657	REAL, DIMENSION(klon), INTENT(IN) :: pctsrf
658
659	! Output arguments
660	!****************************************************************************************
661	INTEGER, DIMENSION(knon,8), INTENT(OUT) :: neighbours
662
663	! Local variables
664	!****************************************************************************************
665	INTEGER :: knon_g
666	INTEGER :: i, igrid, jj, ij, iglob
667	INTEGER :: ierr, ireal, index
668	INTEGER :: var_tmp
669	INTEGER, DIMENSION(0:mpi_size-1) :: knon_nb
670	INTEGER, DIMENSION(0:mpi_size-1) :: displs
671	INTEGER, DIMENSION(8,3) :: off_ini
672	INTEGER, DIMENSION(8) :: offset
673	INTEGER, DIMENSION(knon) :: ktindex_p
674	INTEGER, DIMENSION(nbp_lon,nbp_lat) :: correspond
675	INTEGER, ALLOCATABLE, DIMENSION(:) :: ktindex_g
676	INTEGER, ALLOCATABLE, DIMENSION(:,:) :: neighbours_g
677	REAL, DIMENSION(klon_glo) :: pctsrf_g
678
679	!
680	! End definition
681	!****************************************************************************************
682
683	IF (is_sequential) THEN
684	knon_nb(:)=knon
685	ELSE
686
687	#ifdef CPP_MPI
688	CALL MPI_GATHER(knon,1,MPI_INTEGER,knon_nb,1,MPI_INTEGER,0,COMM_LMDZ_PHY,ierr)
689	#endif
690
691	ENDIF
692
693	IF (is_mpi_root) THEN
694	knon_g=SUM(knon_nb(:))
695	ALLOCATE(ktindex_g(knon_g))
696	ALLOCATE(neighbours_g(knon_g,8))
697	neighbours_g(:,:)=-1
698	displs(0)=0
699	DO i=1,mpi_size-1
700	displs(i)=displs(i-1)+knon_nb(i-1)
701	ENDDO
702	ELSE
703	ALLOCATE(ktindex_g(1))
704	ALLOCATE(neighbours_g(1,8))
705	ENDIF
706
707	ktindex_p(1:knon)=ktindex(1:knon)+klon_mpi_begin-1+nbp_lon-1
708
709	IF (is_sequential) THEN
710	ktindex_g(:)=ktindex_p(:)
711	ELSE
712
713	#ifdef CPP_MPI
714	CALL MPI_GATHERV(ktindex_p,knon,MPI_INTEGER,ktindex_g,knon_nb,&
715	displs,MPI_INTEGER,0,COMM_LMDZ_PHY,ierr)
716	#endif
717
718	ENDIF
719
720	CALL Gather(pctsrf,pctsrf_g)
721
722	IF (is_mpi_root) THEN
723	! Initialisation des offset
724	!
725	! offset bord ouest
726	off_ini(1,1) = - nbp_lon ; off_ini(2,1) = - nbp_lon + 1; off_ini(3,1) = 1
727	off_ini(4,1) = nbp_lon + 1; off_ini(5,1) = nbp_lon ; off_ini(6,1) = 2 * nbp_lon - 1
728	off_ini(7,1) = nbp_lon -1 ; off_ini(8,1) = - 1
729	! offset point normal
730	off_ini(1,2) = - nbp_lon ; off_ini(2,2) = - nbp_lon + 1; off_ini(3,2) = 1
731	off_ini(4,2) = nbp_lon + 1; off_ini(5,2) = nbp_lon ; off_ini(6,2) = nbp_lon - 1
732	off_ini(7,2) = -1 ; off_ini(8,2) = - nbp_lon - 1
733	! offset bord est
734	off_ini(1,3) = - nbp_lon; off_ini(2,3) = - 2 * nbp_lon + 1; off_ini(3,3) = - nbp_lon + 1
735	off_ini(4,3) = 1 ; off_ini(5,3) = nbp_lon ; off_ini(6,3) = nbp_lon - 1
736	off_ini(7,3) = -1 ; off_ini(8,3) = - nbp_lon - 1
737	!
738	!
739	! Attention aux poles
740	!
741	DO igrid = 1, knon_g
742	index = ktindex_g(igrid)
743	jj = INT((index - 1)/nbp_lon) + 1
744	ij = index - (jj - 1) * nbp_lon
745	correspond(ij,jj) = igrid
746	ENDDO
747
748	DO igrid = 1, knon_g
749	iglob = ktindex_g(igrid)
750	IF (MOD(iglob, nbp_lon) == 1) THEN
751	offset = off_ini(:,1)
752	ELSE IF(MOD(iglob, nbp_lon) == 0) THEN
753	offset = off_ini(:,3)
754	ELSE
755	offset = off_ini(:,2)
756	ENDIF
757	DO i = 1, 8
758	index = iglob + offset(i)
759	ireal = (MIN(MAX(1, index - nbp_lon + 1), klon_glo))
760	IF (pctsrf_g(ireal) > EPSFRA) THEN
761	jj = INT((index - 1)/nbp_lon) + 1
762	ij = index - (jj - 1) * nbp_lon
763	neighbours_g(igrid, i) = correspond(ij, jj)
764	ENDIF
765	ENDDO
766	ENDDO
767
768	ENDIF
769
770	DO i=1,8
771	IF (is_sequential) THEN
772	neighbours(:,i)=neighbours_g(:,i)
773	ELSE
774	#ifdef CPP_MPI
775	IF (knon > 0) THEN
776	! knon>0, scattter global field neighbours_g from master process to local process
777	CALL MPI_SCATTERV(neighbours_g(:,i),knon_nb,displs,MPI_INTEGER,neighbours(:,i),knon,MPI_INTEGER,0,COMM_LMDZ_PHY,ierr)
778	ELSE
779	! knon=0, no need to save the field for this process
780	CALL MPI_SCATTERV(neighbours_g(:,i),knon_nb,displs,MPI_INTEGER,var_tmp,knon,MPI_INTEGER,0,COMM_LMDZ_PHY,ierr)
781	END IF
782	#endif
783	ENDIF
784	ENDDO
785
786	END SUBROUTINE Init_neighbours
787	!
788	!****************************************************************************************
789	!
790
791	#endif
792	END MODULE surf_land_orchidee_noopenmp_mod

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

Download in other formats:

Original Format