Context Navigation

surf_land_orchidee_noopenmp_mod.F90 @ 2518

Last change on this file since 2518 was 2410, checked in by jghattas, 9 years ago

Added the variable yrmu0(cosine of the solar zenith angle) into ORCHIDEE:

Current version of LMDZ can now be used with ORCHIDEE trunk revisions from rev 2961 and newer. For revision 1078-2960 on ORCHIDEE trunk, a small modification (change coszang into sinang) in surf_land_orchidee_mod.f90 is needed. For older versions than ORCHIDEE trunk revision 1078, the interface in surf_land_orchidee_noopenmp_mod.f90 should be used (add cpp key ORCHIDEE_NOOPENMP).

For details see ticket https://forge.ipsl.jussieu.fr/orchidee/ticket/217

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

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

Download in other formats:

Original Format