Context Navigation

surf_land_orchidee_mod.F90 @ 907

Last change on this file since 907 was 888, checked in by Laurent Fairhead, 16 years ago
Modifications sur l'albedo JG LF
Property svn:eol-style set to `native` Property svn:executable set to ``* Property svn:keywords set to `Author Date Id Revision`
File size: 23.8 KB

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

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

Download in other formats:

Original Format