Context Navigation

surf_land_orchidee_mod.F90 @ 2344

Last change on this file since 2344 was 2344, checked in by Ehouarn Millour, 9 years ago
Physics/dynamics separation: get rid of all the 'include "temps.h"' in the physics; variables in module time_phylmdz_mod must be used instead. Also added JD_cur, JH_cur and JD_ref in module phys_cal_mod, in preparation for having physics handle its calendar internally. EM
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 Property svn:eol-style set to `native` Property svn:executable set to ``* Property svn:keywords set to `Author Date Id Revision`
File size: 22.2 KB

Line
1	!
2	MODULE surf_land_orchidee_mod
3	#ifndef ORCHIDEE_NOOPENMP
4	!
5	! This module controles the interface towards the model ORCHIDEE
6	!
7	! Subroutines in this module : surf_land_orchidee
8	! Init_orchidee_index
9	! Get_orchidee_communicator
10	! Init_neighbours
11
12	USE dimphy
13	#ifdef CPP_VEGET
14	USE intersurf ! module d'ORCHIDEE
15	#endif
16	USE cpl_mod, ONLY : cpl_send_land_fields
17	USE surface_data, ONLY : type_ocean
18	USE comgeomphy, ONLY : cuphy, cvphy
19	USE mod_grid_phy_lmdz
20	USE mod_phys_lmdz_para, mpi_root_rank=>mpi_root
21
22	IMPLICIT NONE
23
24	PRIVATE
25	PUBLIC :: surf_land_orchidee
26
27	LOGICAL, ALLOCATABLE, SAVE :: flag_omp(:)
28	CONTAINS
29	!
30	!****************************************************************************************
31	!
32	SUBROUTINE surf_land_orchidee(itime, dtime, date0, knon, &
33	knindex, rlon, rlat, pctsrf, &
34	debut, lafin, &
35	plev, u1_lay, v1_lay, gustiness, temp_air, spechum, epot_air, ccanopy, &
36	tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
37	precip_rain, precip_snow, lwdown, swnet, swdown, &
38	ps, q2m, t2m, &
39	evap, fluxsens, fluxlat, &
40	tsol_rad, tsurf_new, alb1_new, alb2_new, &
41	emis_new, z0_new, qsurf)
42
43	USE mod_surf_para
44	USE mod_synchro_omp
45	USE carbon_cycle_mod, ONLY : carbon_cycle_cpl
46	USE indice_sol_mod
47	USE print_control_mod, ONLY: lunout
48	USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat
49	!
50	! Cette routine sert d'interface entre le modele atmospherique et le
51	! modele de sol continental. Appel a sechiba
52	!
53	! L. Fairhead 02/2000
54	!
55	! input:
56	! itime numero du pas de temps
57	! dtime pas de temps de la physique (en s)
58	! nisurf index de la surface a traiter (1 = sol continental)
59	! knon nombre de points de la surface a traiter
60	! knindex index des points de la surface a traiter
61	! rlon longitudes de la grille entiere
62	! rlat latitudes de la grille entiere
63	! pctsrf tableau des fractions de surface de chaque maille
64	! debut logical: 1er appel a la physique (lire les restart)
65	! lafin logical: dernier appel a la physique (ecrire les restart)
66	! (si false calcul simplifie des fluxs sur les continents)
67	! plev hauteur de la premiere couche (Pa)
68	! u1_lay vitesse u 1ere couche
69	! v1_lay vitesse v 1ere couche
70	! temp_air temperature de l'air 1ere couche
71	! spechum humidite specifique 1ere couche
72	! epot_air temp pot de l'air
73	! ccanopy concentration CO2 canopee, correspond au co2_send de
74	! carbon_cycle_mod ou valeur constant co2_ppm
75	! tq_cdrag cdrag
76	! petAcoef coeff. A de la resolution de la CL pour t
77	! peqAcoef coeff. A de la resolution de la CL pour q
78	! petBcoef coeff. B de la resolution de la CL pour t
79	! peqBcoef coeff. B de la resolution de la CL pour q
80	! precip_rain precipitation liquide
81	! precip_snow precipitation solide
82	! lwdown flux IR descendant a la surface
83	! swnet flux solaire net
84	! swdown flux solaire entrant a la surface
85	! ps pression au sol
86	! radsol rayonnement net aus sol (LW + SW)
87	!
88	!
89	! output:
90	! evap evaporation totale
91	! fluxsens flux de chaleur sensible
92	! fluxlat flux de chaleur latente
93	! tsol_rad
94	! tsurf_new temperature au sol
95	! alb1_new albedo in visible SW interval
96	! alb2_new albedo in near IR interval
97	! emis_new emissivite
98	! z0_new surface roughness
99	! qsurf air moisture at surface
100	!
101	INCLUDE "YOMCST.h"
102
103	!
104	! Parametres d'entree
105	!****************************************************************************************
106	INTEGER, INTENT(IN) :: itime
107	REAL, INTENT(IN) :: dtime
108	REAL, INTENT(IN) :: date0
109	INTEGER, INTENT(IN) :: knon
110	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
111	LOGICAL, INTENT(IN) :: debut, lafin
112	REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
113	REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat
114	REAL, DIMENSION(klon), INTENT(IN) :: plev
115	REAL, DIMENSION(klon), INTENT(IN) :: u1_lay, v1_lay, gustiness
116	REAL, DIMENSION(klon), INTENT(IN) :: temp_air, spechum
117	REAL, DIMENSION(klon), INTENT(IN) :: epot_air, ccanopy
118	REAL, DIMENSION(klon), INTENT(IN) :: tq_cdrag
119	REAL, DIMENSION(klon), INTENT(IN) :: petAcoef, peqAcoef
120	REAL, DIMENSION(klon), INTENT(IN) :: petBcoef, peqBcoef
121	REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow
122	REAL, DIMENSION(klon), INTENT(IN) :: lwdown, swnet, swdown, ps
123	REAL, DIMENSION(klon), INTENT(IN) :: q2m, t2m
124
125	! Parametres de sortie
126	!****************************************************************************************
127	REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat, qsurf
128	REAL, DIMENSION(klon), INTENT(OUT) :: tsol_rad, tsurf_new
129	REAL, DIMENSION(klon), INTENT(OUT) :: alb1_new, alb2_new
130	REAL, DIMENSION(klon), INTENT(OUT) :: emis_new, z0_new
131
132	! Local
133	!****************************************************************************************
134	INTEGER :: ij, jj, igrid, ireal, index
135	INTEGER :: error
136	REAL, DIMENSION(klon) :: swdown_vrai
137	CHARACTER (len = 20) :: modname = 'surf_land_orchidee'
138	CHARACTER (len = 80) :: abort_message
139	LOGICAL,SAVE :: check = .FALSE.
140	!$OMP THREADPRIVATE(check)
141
142	! type de couplage dans sechiba
143	! character (len=10) :: coupling = 'implicit'
144	! drapeaux controlant les appels dans SECHIBA
145	! type(control_type), save :: control_in
146	! Preserved albedo
147	REAL, ALLOCATABLE, DIMENSION(:), SAVE :: albedo_keep, zlev
148	!$OMP THREADPRIVATE(albedo_keep,zlev)
149	! coordonnees geographiques
150	REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: lalo
151	!$OMP THREADPRIVATE(lalo)
152	! pts voisins
153	INTEGER,ALLOCATABLE, DIMENSION(:,:), SAVE :: neighbours
154	!$OMP THREADPRIVATE(neighbours)
155	! fractions continents
156	REAL,ALLOCATABLE, DIMENSION(:), SAVE :: contfrac
157	!$OMP THREADPRIVATE(contfrac)
158	! resolution de la grille
159	REAL, ALLOCATABLE, DIMENSION (:,:), SAVE :: resolution
160	!$OMP THREADPRIVATE(resolution)
161
162	REAL, ALLOCATABLE, DIMENSION (:,:), SAVE :: lon_scat, lat_scat
163	!$OMP THREADPRIVATE(lon_scat,lat_scat)
164
165	LOGICAL, SAVE :: lrestart_read = .TRUE.
166	!$OMP THREADPRIVATE(lrestart_read)
167	LOGICAL, SAVE :: lrestart_write = .FALSE.
168	!$OMP THREADPRIVATE(lrestart_write)
169
170	REAL, DIMENSION(knon,2) :: albedo_out
171
172	! Pb de nomenclature
173	REAL, DIMENSION(klon) :: petA_orc, peqA_orc
174	REAL, DIMENSION(klon) :: petB_orc, peqB_orc
175	! Pb de correspondances de grilles
176	INTEGER, DIMENSION(:), SAVE, ALLOCATABLE :: ig, jg
177	!$OMP THREADPRIVATE(ig,jg)
178	INTEGER :: indi, indj
179	INTEGER, SAVE, ALLOCATABLE,DIMENSION(:) :: ktindex
180	!$OMP THREADPRIVATE(ktindex)
181
182	! Essai cdrag
183	REAL, DIMENSION(klon) :: cdrag
184	INTEGER,SAVE :: offset
185	!$OMP THREADPRIVATE(offset)
186
187	REAL, DIMENSION(klon_glo) :: rlon_g,rlat_g
188	INTEGER, SAVE :: orch_comm
189	!$OMP THREADPRIVATE(orch_comm)
190
191	REAL, ALLOCATABLE, DIMENSION(:), SAVE :: coastalflow
192	!$OMP THREADPRIVATE(coastalflow)
193	REAL, ALLOCATABLE, DIMENSION(:), SAVE :: riverflow
194	!$OMP THREADPRIVATE(riverflow)
195
196	INTEGER :: orch_omp_rank
197	INTEGER :: orch_omp_size
198	!
199	! Fin definition
200	!****************************************************************************************
201
202	IF (check) WRITE(lunout,*)'Entree ', modname
203
204	! Initialisation
205
206	IF (debut) THEN
207	! Test of coherence between variable ok_veget and cpp key CPP_VEGET
208	#ifndef CPP_VEGET
209	abort_message='Pb de coherence: ok_veget = .true. mais CPP_VEGET = .false.'
210	CALL abort_physic(modname,abort_message,1)
211	#endif
212
213	CALL Init_surf_para(knon)
214	ALLOCATE(ktindex(knon))
215	IF ( .NOT. ALLOCATED(albedo_keep)) THEN
216	!ym ALLOCATE(albedo_keep(klon))
217	!ym bizarre que non alloué en knon precedement
218	ALLOCATE(albedo_keep(knon))
219	ALLOCATE(zlev(knon))
220	ENDIF
221	! Pb de correspondances de grilles
222	ALLOCATE(ig(klon))
223	ALLOCATE(jg(klon))
224	ig(1) = 1
225	jg(1) = 1
226	indi = 0
227	indj = 2
228	DO igrid = 2, klon - 1
229	indi = indi + 1
230	IF ( indi > nbp_lon) THEN
231	indi = 1
232	indj = indj + 1
233	ENDIF
234	ig(igrid) = indi
235	jg(igrid) = indj
236	ENDDO
237	ig(klon) = 1
238	jg(klon) = nbp_lat
239
240	IF ((.NOT. ALLOCATED(lalo))) THEN
241	ALLOCATE(lalo(knon,2), stat = error)
242	IF (error /= 0) THEN
243	abort_message='Pb allocation lalo'
244	CALL abort_physic(modname,abort_message,1)
245	ENDIF
246	ENDIF
247	IF ((.NOT. ALLOCATED(lon_scat))) THEN
248	ALLOCATE(lon_scat(nbp_lon,nbp_lat), stat = error)
249	IF (error /= 0) THEN
250	abort_message='Pb allocation lon_scat'
251	CALL abort_physic(modname,abort_message,1)
252	ENDIF
253	ENDIF
254	IF ((.NOT. ALLOCATED(lat_scat))) THEN
255	ALLOCATE(lat_scat(nbp_lon,nbp_lat), stat = error)
256	IF (error /= 0) THEN
257	abort_message='Pb allocation lat_scat'
258	CALL abort_physic(modname,abort_message,1)
259	ENDIF
260	ENDIF
261	lon_scat = 0.
262	lat_scat = 0.
263	DO igrid = 1, knon
264	index = knindex(igrid)
265	lalo(igrid,2) = rlon(index)
266	lalo(igrid,1) = rlat(index)
267	ENDDO
268
269
270
271	CALL Gather(rlon,rlon_g)
272	CALL Gather(rlat,rlat_g)
273
274	IF (is_mpi_root) THEN
275	index = 1
276	DO jj = 2, nbp_lat-1
277	DO ij = 1, nbp_lon
278	index = index + 1
279	lon_scat(ij,jj) = rlon_g(index)
280	lat_scat(ij,jj) = rlat_g(index)
281	ENDDO
282	ENDDO
283	lon_scat(:,1) = lon_scat(:,2)
284	lat_scat(:,1) = rlat_g(1)
285	lon_scat(:,nbp_lat) = lon_scat(:,2)
286	lat_scat(:,nbp_lat) = rlat_g(klon_glo)
287	ENDIF
288
289	CALL bcast(lon_scat)
290	CALL bcast(lat_scat)
291	!
292	! Allouer et initialiser le tableau des voisins et des fraction de continents
293	!
294	IF ( (.NOT.ALLOCATED(neighbours))) THEN
295	ALLOCATE(neighbours(knon,8), stat = error)
296	IF (error /= 0) THEN
297	abort_message='Pb allocation neighbours'
298	CALL abort_physic(modname,abort_message,1)
299	ENDIF
300	ENDIF
301	neighbours = -1.
302	IF (( .NOT. ALLOCATED(contfrac))) THEN
303	ALLOCATE(contfrac(knon), stat = error)
304	IF (error /= 0) THEN
305	abort_message='Pb allocation contfrac'
306	CALL abort_physic(modname,abort_message,1)
307	ENDIF
308	ENDIF
309
310	DO igrid = 1, knon
311	ireal = knindex(igrid)
312	contfrac(igrid) = pctsrf(ireal,is_ter)
313	ENDDO
314
315
316	CALL Init_neighbours(knon,neighbours,knindex,pctsrf(:,is_ter))
317
318	!
319	! Allocation et calcul resolutions
320	IF ( (.NOT.ALLOCATED(resolution))) THEN
321	ALLOCATE(resolution(knon,2), stat = error)
322	IF (error /= 0) THEN
323	abort_message='Pb allocation resolution'
324	CALL abort_physic(modname,abort_message,1)
325	ENDIF
326	ENDIF
327	DO igrid = 1, knon
328	ij = knindex(igrid)
329	resolution(igrid,1) = cuphy(ij)
330	resolution(igrid,2) = cvphy(ij)
331	ENDDO
332
333	ALLOCATE(coastalflow(klon), stat = error)
334	IF (error /= 0) THEN
335	abort_message='Pb allocation coastalflow'
336	CALL abort_physic(modname,abort_message,1)
337	ENDIF
338
339	ALLOCATE(riverflow(klon), stat = error)
340	IF (error /= 0) THEN
341	abort_message='Pb allocation riverflow'
342	CALL abort_physic(modname,abort_message,1)
343	ENDIF
344	!
345	! carbon_cycle_cpl not possible with this interface and version of ORHCHIDEE
346	!
347	IF (carbon_cycle_cpl) THEN
348	abort_message='carbon_cycle_cpl not yet possible with this interface of ORCHIDEE'
349	CALL abort_physic(modname,abort_message,1)
350	END IF
351
352	ENDIF ! (fin debut)
353
354
355	!
356	! Appel a la routine sols continentaux
357	!
358	IF (lafin) lrestart_write = .TRUE.
359	IF (check) WRITE(lunout,*)'lafin ',lafin,lrestart_write
360
361	petA_orc(1:knon) = petBcoef(1:knon) * dtime
362	petB_orc(1:knon) = petAcoef(1:knon)
363	peqA_orc(1:knon) = peqBcoef(1:knon) * dtime
364	peqB_orc(1:knon) = peqAcoef(1:knon)
365
366	cdrag = 0.
367	cdrag(1:knon) = tq_cdrag(1:knon)
368
369	! zlev(1:knon) = (100.plev(1:knon))/((ps(1:knon)/287.05temp_air(1:knon))*9.80665)
370	! zlev(1:knon) = (100.plev(1:knon))/((ps(1:knon)/RDtemp_air(1:knon))*RG)
371	zlev(1:knon) = plev(1:knon)RDtemp_air(1:knon)/((ps(1:knon)100.0)RG)
372
373
374	! PF et PASB
375	! where(cdrag > 0.01)
376	! cdrag = 0.01
377	! endwhere
378	! write(,)'Cdrag = ',minval(cdrag),maxval(cdrag)
379
380
381	IF (debut) THEN
382	CALL Init_orchidee_index(knon,knindex,offset,ktindex)
383	CALL Get_orchidee_communicator(orch_comm,orch_omp_size,orch_omp_rank)
384	CALL Init_synchro_omp
385
386	IF (knon > 0) THEN
387	#ifdef CPP_VEGET
388	CALL Init_intersurf(nbp_lon,nbp_lat,knon,ktindex,offset,orch_omp_size,orch_omp_rank,orch_comm)
389	#endif
390	ENDIF
391
392
393	IF (knon > 0) THEN
394
395	#ifdef CPP_VEGET
396	CALL intersurf_main (itime+itau_phy-1, nbp_lon, nbp_lat, knon, ktindex, dtime, &
397	lrestart_read, lrestart_write, lalo, &
398	contfrac, neighbours, resolution, date0, &
399	zlev, u1_lay, v1_lay, spechum, temp_air, epot_air, ccanopy, &
400	cdrag, petA_orc, peqA_orc, petB_orc, peqB_orc, &
401	precip_rain, precip_snow, lwdown, swnet, swdown, ps, &
402	evap, fluxsens, fluxlat, coastalflow, riverflow, &
403	tsol_rad, tsurf_new, qsurf, albedo_out, emis_new, z0_new, &
404	lon_scat, lat_scat, q2m, t2m)
405	#endif
406	ENDIF
407
408	CALL Synchro_omp
409
410	albedo_keep(1:knon) = (albedo_out(1:knon,1)+albedo_out(1:knon,2))/2.
411
412	ENDIF
413
414
415	! swdown_vrai(1:knon) = swnet(1:knon)/(1. - albedo_keep(1:knon))
416	swdown_vrai(1:knon) = swdown(1:knon)
417
418	IF (knon > 0) THEN
419	#ifdef CPP_VEGET
420	CALL intersurf_main (itime+itau_phy, nbp_lon, nbp_lat, knon, ktindex, dtime, &
421	lrestart_read, lrestart_write, lalo, &
422	contfrac, neighbours, resolution, date0, &
423	zlev, u1_lay(1:knon), v1_lay(1:knon), spechum(1:knon), temp_air(1:knon), epot_air(1:knon), ccanopy(1:knon), &
424	cdrag(1:knon), petA_orc(1:knon), peqA_orc(1:knon), petB_orc(1:knon), peqB_orc(1:knon), &
425	precip_rain(1:knon), precip_snow(1:knon), lwdown(1:knon), swnet(1:knon), swdown_vrai(1:knon), ps(1:knon), &
426	evap(1:knon), fluxsens(1:knon), fluxlat(1:knon), coastalflow(1:knon), riverflow(1:knon), &
427	tsol_rad(1:knon), tsurf_new(1:knon), qsurf(1:knon), albedo_out(1:knon,:), emis_new(1:knon), z0_new(1:knon), &
428	lon_scat, lat_scat, q2m, t2m)
429	#endif
430	ENDIF
431
432	CALL Synchro_omp
433
434	albedo_keep(1:knon) = (albedo_out(1:knon,1)+albedo_out(1:knon,2))/2.
435
436	!* Send to coupler
437	!
438	IF (type_ocean=='couple') THEN
439	CALL cpl_send_land_fields(itime, knon, knindex, &
440	riverflow, coastalflow)
441	ENDIF
442
443	alb1_new(1:knon) = albedo_out(1:knon,1)
444	alb2_new(1:knon) = albedo_out(1:knon,2)
445
446	! Convention orchidee: positif vers le haut
447	fluxsens(1:knon) = -1. * fluxsens(1:knon)
448	fluxlat(1:knon) = -1. * fluxlat(1:knon)
449
450	! evap = -1. * evap
451
452	IF (debut) lrestart_read = .FALSE.
453
454	IF (debut) CALL Finalize_surf_para
455
456
457	END SUBROUTINE surf_land_orchidee
458	!
459	!****************************************************************************************
460	!
461	SUBROUTINE Init_orchidee_index(knon,knindex,offset,ktindex)
462	USE mod_surf_para
463	USE mod_grid_phy_lmdz
464
465	INTEGER,INTENT(IN) :: knon
466	INTEGER,INTENT(IN) :: knindex(klon)
467	INTEGER,INTENT(OUT) :: offset
468	INTEGER,INTENT(OUT) :: ktindex(klon)
469
470	INTEGER :: ktindex_glo(knon_glo)
471	INTEGER :: offset_para(0:omp_size*mpi_size-1)
472	INTEGER :: LastPoint
473	INTEGER :: task
474
475	ktindex(1:knon)=knindex(1:knon)+(klon_mpi_begin-1)+(klon_omp_begin-1)+nbp_lon-1
476
477	CALL gather_surf(ktindex(1:knon),ktindex_glo)
478
479	IF (is_mpi_root .AND. is_omp_root) THEN
480	LastPoint=0
481	DO Task=0,mpi_size*omp_size-1
482	IF (knon_glo_para(Task)>0) THEN
483	offset_para(task)= LastPoint-MOD(LastPoint,nbp_lon)
484	LastPoint=ktindex_glo(knon_glo_end_para(task))
485	ENDIF
486	ENDDO
487	ENDIF
488
489	CALL bcast(offset_para)
490
491	offset=offset_para(omp_size*mpi_rank+omp_rank)
492
493	ktindex(1:knon)=ktindex(1:knon)-offset
494
495	END SUBROUTINE Init_orchidee_index
496
497	!
498	!*********************** *************************************************************
499	!
500
501	SUBROUTINE Get_orchidee_communicator(orch_comm,orch_omp_size,orch_omp_rank)
502	USE mod_surf_para
503
504	#ifdef CPP_MPI
505	INCLUDE 'mpif.h'
506	#endif
507
508	INTEGER,INTENT(OUT) :: orch_comm
509	INTEGER,INTENT(OUT) :: orch_omp_size
510	INTEGER,INTENT(OUT) :: orch_omp_rank
511	INTEGER :: color
512	INTEGER :: i,ierr
513	!
514	! End definition
515	!****************************************************************************************
516
517
518	IF (is_omp_root) THEN
519
520	IF (knon_mpi==0) THEN
521	color = 0
522	ELSE
523	color = 1
524	ENDIF
525
526	#ifdef CPP_MPI
527	CALL MPI_COMM_SPLIT(COMM_LMDZ_PHY,color,mpi_rank,orch_comm,ierr)
528	#endif
529
530	ENDIF
531	CALL bcast_omp(orch_comm)
532
533	IF (knon_mpi /= 0) THEN
534	orch_omp_size=0
535	DO i=0,omp_size-1
536	IF (knon_omp_para(i) /=0) THEN
537	orch_omp_size=orch_omp_size+1
538	IF (i==omp_rank) orch_omp_rank=orch_omp_size-1
539	ENDIF
540	ENDDO
541	ENDIF
542
543
544	END SUBROUTINE Get_orchidee_communicator
545	!
546	!****************************************************************************************
547	!
548
549	SUBROUTINE Init_neighbours(knon,neighbours,knindex,pctsrf)
550	USE mod_grid_phy_lmdz
551	USE mod_surf_para
552	USE indice_sol_mod
553
554	#ifdef CPP_MPI
555	INCLUDE 'mpif.h'
556	#endif
557
558	! Input arguments
559	!****************************************************************************************
560	INTEGER, INTENT(IN) :: knon
561	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
562	REAL, DIMENSION(klon), INTENT(IN) :: pctsrf
563
564	! Output arguments
565	!****************************************************************************************
566	INTEGER, DIMENSION(knon,8), INTENT(OUT) :: neighbours
567
568	! Local variables
569	!****************************************************************************************
570	INTEGER :: i, igrid, jj, ij, iglob
571	INTEGER :: ierr, ireal, index
572	INTEGER, DIMENSION(8,3) :: off_ini
573	INTEGER, DIMENSION(8) :: offset
574	INTEGER, DIMENSION(nbp_lon,nbp_lat) :: correspond
575	INTEGER, DIMENSION(knon_glo) :: ktindex_glo
576	INTEGER, DIMENSION(knon_glo,8) :: neighbours_glo
577	REAL, DIMENSION(klon_glo) :: pctsrf_glo
578	INTEGER :: ktindex(klon)
579	!
580	! End definition
581	!****************************************************************************************
582
583	ktindex(1:knon)=knindex(1:knon)+(klon_mpi_begin-1)+(klon_omp_begin-1)+nbp_lon-1
584
585	CALL gather_surf(ktindex(1:knon),ktindex_glo)
586	CALL gather(pctsrf,pctsrf_glo)
587
588	IF (is_mpi_root .AND. is_omp_root) THEN
589	neighbours_glo(:,:)=-1
590	! Initialisation des offset
591	!
592	! offset bord ouest
593	off_ini(1,1) = - nbp_lon ; off_ini(2,1) = - nbp_lon + 1 ; off_ini(3,1) = 1
594	off_ini(4,1) = nbp_lon + 1 ; off_ini(5,1) = nbp_lon ; off_ini(6,1) = 2 * nbp_lon - 1
595	off_ini(7,1) = nbp_lon -1 ; off_ini(8,1) = - 1
596	! offset point normal
597	off_ini(1,2) = - nbp_lon ; off_ini(2,2) = - nbp_lon + 1 ; off_ini(3,2) = 1
598	off_ini(4,2) = nbp_lon + 1 ; off_ini(5,2) = nbp_lon ; off_ini(6,2) = nbp_lon - 1
599	off_ini(7,2) = -1 ; off_ini(8,2) = - nbp_lon - 1
600	! offset bord est
601	off_ini(1,3) = - nbp_lon ; off_ini(2,3) = - 2 * nbp_lon + 1 ; off_ini(3,3) = - nbp_lon + 1
602	off_ini(4,3) = 1 ; off_ini(5,3) = nbp_lon ; off_ini(6,3) = nbp_lon - 1
603	off_ini(7,3) = -1 ; off_ini(8,3) = - nbp_lon - 1
604	!
605	!
606	! Attention aux poles
607	!
608	DO igrid = 1, knon_glo
609	index = ktindex_glo(igrid)
610	jj = INT((index - 1)/nbp_lon) + 1
611	ij = index - (jj - 1) * nbp_lon
612	correspond(ij,jj) = igrid
613	ENDDO
614	!sonia : Les mailles des voisines doivent etre toutes egales (pour couplage orchidee)
615	IF (knon_glo == 1) THEN
616	igrid = 1
617	DO i = 1,8
618	neighbours_glo(igrid, i) = igrid
619	ENDDO
620	ELSE
621	print*,'sonia : knon_glo,ij,jj', knon_glo, ij,jj
622
623	DO igrid = 1, knon_glo
624	iglob = ktindex_glo(igrid)
625
626	IF (MOD(iglob, nbp_lon) == 1) THEN
627	offset = off_ini(:,1)
628	ELSE IF(MOD(iglob, nbp_lon) == 0) THEN
629	offset = off_ini(:,3)
630	ELSE
631	offset = off_ini(:,2)
632	ENDIF
633
634	DO i = 1, 8
635	index = iglob + offset(i)
636	ireal = (MIN(MAX(1, index - nbp_lon + 1), klon_glo))
637	IF (pctsrf_glo(ireal) > EPSFRA) THEN
638	jj = INT((index - 1)/nbp_lon) + 1
639	ij = index - (jj - 1) * nbp_lon
640	neighbours_glo(igrid, i) = correspond(ij, jj)
641	ENDIF
642	ENDDO
643	ENDDO
644	ENDIF !fin knon_glo == 1
645
646	ENDIF
647
648	DO i = 1, 8
649	CALL scatter_surf(neighbours_glo(:,i),neighbours(1:knon,i))
650	ENDDO
651	END SUBROUTINE Init_neighbours
652
653	!
654	!****************************************************************************************
655	!
656	#endif
657	END MODULE surf_land_orchidee_mod

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

Download in other formats:

Original Format