Context Navigation

surf_land_orchidee_noopenmp_mod.F90 @ 5274

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

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

Download in other formats:

Original Format