Context Navigation

surf_land_orchidee_noopenmp_mod.F90 @ 5158

Last change on this file since 5158 was 5158, checked in by abarral, 7 weeks ago
Add missing klon on strataer_emiss_mod.F90 Correct various missing explicit declarations Replace tabs by spaces (tabs are not part of the fortran charset) Continue cleaning modules Removed unused arguments and variables
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.4 KB

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

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

Download in other formats:

Original Format