Context Navigation

surf_land_orchidee_mod.F90 @ 1098

Last change on this file since 1098 was 1067, checked in by Laurent Fairhead, 16 years ago

Modifications lie au premier niveau du modele pour la diffusion turbulent

du vent.

Preparation pour un couplage des courrant oceaniques.

Property svn:eol-style set to native
Property svn:executable set to *
Property svn:keywords set to Author Date Id Revision

File size: 21.1 KB

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

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

Download in other formats:

Original Format