Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

surf_land_orchidee_noopenmp_mod.F90 @ 3363

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

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

Download in other formats:

Original Format