Context Navigation

surf_land_orchidee_mod.F90 @ 2295

Last change on this file since 2295 was 2240, checked in by fhourdin, 9 years ago

Revisite de la formule des flux de surface
(en priorité sur l'océan) en tenant compte des bourrasques de
vent et de la différence entre les hauteurs de rugosités pour
la quantité de mouvement, l'enthalpie et éventuellement l'humidité.

Etape 1 :
Introduction d'un calcul de gustiness dans la physique
gustiness(:)=f_gust_bl * ale_bl + f_gust_wk * ame_wk
Cette variable est passée ensuite jusqu'au fin fond de la couche limite.
L'étape 1 est prête à commettre, ne nécessite pas de nouvelles
variables dans les startphy et assure la convergence numérique.

Introduction of gustiness in the surface flux computation.
Gustiness is computed from as
gustiness(:)=f_gust_bl * ale_bl + f_gust_wk * ame_wk
and pass through pbl_surface down to the routines that compute
surface fluxes.

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.1 KB

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

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

Download in other formats:

Original Format