Context Navigation

surf_land_orchidee_mod.F90 @ 993

Last change on this file since 993 was 987, checked in by Laurent Fairhead, 17 years ago
Du nettoyage sur le parallelisme, inclusion de nouvelles interfaces pour OPA9 et ORCHIDEE YM LF
Property svn:eol-style set to `native` Property svn:executable set to ``* Property svn:keywords set to `Author Date Id Revision`
File size: 20.8 KB

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

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

Download in other formats:

Original Format