Context Navigation

surf_land_orchidee_mod.F90 @ 3863

Last change on this file since 3863 was 3413, checked in by Laurent Fairhead, 6 years ago
Inclusion of Yann's latest (summer/fall 2018) modifications for convergence of DYNAMICO/LMDZ physics YM/LF
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: 28.4 KB

Rev	Line
[781]	1	!
	2	MODULE surf_land_orchidee_mod
[1146]	3	#ifndef ORCHIDEE_NOOPENMP
[2571]	4	#ifndef ORCHIDEE_NOZ0H
[2952]	5	#ifndef ORCHIDEE_NOFREIN
[3413]	6	#ifndef ORCHIDEE_NOUNSTRUCT
[781]	7	!
[2410]	8	! This module controles the interface towards the model ORCHIDEE.
[781]	9	!
[2410]	10	! Compatibility with ORCHIDIEE :
[2952]	11	! The current version can be used with ORCHIDEE/trunk from revision 4465.
	12	! This interface is used if none of the cpp keys ORCHIDEE_NOOPENMP,
	13	! ORCHIDEE_NOZ0H or ORCHIDEE_NOFREIN is set.
[2410]	14	!
[781]	15	! Subroutines in this module : surf_land_orchidee
	16	! Init_orchidee_index
	17	! Get_orchidee_communicator
	18	! Init_neighbours
	19
	20	USE dimphy
[1067]	21	#ifdef CPP_VEGET
[781]	22	USE intersurf ! module d'ORCHIDEE
[1067]	23	#endif
[781]	24	USE cpl_mod, ONLY : cpl_send_land_fields
[996]	25	USE surface_data, ONLY : type_ocean
[3413]	26	USE geometry_mod, ONLY : dx, dy, boundslon, boundslat,longitude, latitude, cell_area, ind_cell_glo
[781]	27	USE mod_grid_phy_lmdz
[2351]	28	USE mod_phys_lmdz_para, mpi_root_rank=>mpi_master
[3413]	29	USE nrtype, ONLY : PI
	30
[781]	31	IMPLICIT NONE
	32
	33	PRIVATE
	34	PUBLIC :: surf_land_orchidee
	35
	36	CONTAINS
	37	!
	38	!****************************************************************************************
	39	!
	40	SUBROUTINE surf_land_orchidee(itime, dtime, date0, knon, &
[2410]	41	knindex, rlon, rlat, yrmu0, pctsrf, &
[781]	42	debut, lafin, &
[2240]	43	plev, u1_lay, v1_lay, gustiness, temp_air, spechum, epot_air, ccanopy, &
[781]	44	tq_cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
	45	precip_rain, precip_snow, lwdown, swnet, swdown, &
[1146]	46	ps, q2m, t2m, &
[781]	47	evap, fluxsens, fluxlat, &
[888]	48	tsol_rad, tsurf_new, alb1_new, alb2_new, &
[2952]	49	emis_new, z0m_new, z0h_new, qsurf, &
	50	veget, lai, height )
[1279]	51
[2952]	52
[1279]	53	USE mod_surf_para
	54	USE mod_synchro_omp
[1454]	55	USE carbon_cycle_mod, ONLY : carbon_cycle_cpl
[1785]	56	USE indice_sol_mod
[2311]	57	USE print_control_mod, ONLY: lunout
[2344]	58	USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat
[2348]	59	#ifdef CPP_VEGET
	60	USE time_phylmdz_mod, ONLY: itau_phy
	61	#endif
[781]	62	!
	63	! Cette routine sert d'interface entre le modele atmospherique et le
	64	! modele de sol continental. Appel a sechiba
	65	!
	66	! L. Fairhead 02/2000
	67	!
	68	! input:
	69	! itime numero du pas de temps
	70	! dtime pas de temps de la physique (en s)
	71	! nisurf index de la surface a traiter (1 = sol continental)
	72	! knon nombre de points de la surface a traiter
	73	! knindex index des points de la surface a traiter
	74	! rlon longitudes de la grille entiere
	75	! rlat latitudes de la grille entiere
	76	! pctsrf tableau des fractions de surface de chaque maille
	77	! debut logical: 1er appel a la physique (lire les restart)
	78	! lafin logical: dernier appel a la physique (ecrire les restart)
	79	! (si false calcul simplifie des fluxs sur les continents)
	80	! plev hauteur de la premiere couche (Pa)
	81	! u1_lay vitesse u 1ere couche
	82	! v1_lay vitesse v 1ere couche
	83	! temp_air temperature de l'air 1ere couche
	84	! spechum humidite specifique 1ere couche
	85	! epot_air temp pot de l'air
[1279]	86	! ccanopy concentration CO2 canopee, correspond au co2_send de
	87	! carbon_cycle_mod ou valeur constant co2_ppm
[781]	88	! tq_cdrag cdrag
	89	! petAcoef coeff. A de la resolution de la CL pour t
	90	! peqAcoef coeff. A de la resolution de la CL pour q
	91	! petBcoef coeff. B de la resolution de la CL pour t
	92	! peqBcoef coeff. B de la resolution de la CL pour q
	93	! precip_rain precipitation liquide
	94	! precip_snow precipitation solide
	95	! lwdown flux IR descendant a la surface
	96	! swnet flux solaire net
	97	! swdown flux solaire entrant a la surface
	98	! ps pression au sol
	99	! radsol rayonnement net aus sol (LW + SW)
	100	!
	101	!
	102	! output:
	103	! evap evaporation totale
	104	! fluxsens flux de chaleur sensible
	105	! fluxlat flux de chaleur latente
	106	! tsol_rad
	107	! tsurf_new temperature au sol
[888]	108	! alb1_new albedo in visible SW interval
	109	! alb2_new albedo in near IR interval
[781]	110	! emis_new emissivite
[2571]	111	! z0m_new surface roughness for momentum
	112	! z0h_new surface roughness for heat
[781]	113	! qsurf air moisture at surface
	114	!
[793]	115	INCLUDE "YOMCST.h"
[2952]	116	INCLUDE "dimpft.h"
	117
	118
[781]	119
	120	!
	121	! Parametres d'entree
	122	!****************************************************************************************
	123	INTEGER, INTENT(IN) :: itime
	124	REAL, INTENT(IN) :: dtime
	125	REAL, INTENT(IN) :: date0
	126	INTEGER, INTENT(IN) :: knon
	127	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
	128	LOGICAL, INTENT(IN) :: debut, lafin
	129	REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
	130	REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat
[2410]	131	REAL, DIMENSION(klon), INTENT(IN) :: yrmu0 ! cosine of solar zenith angle
[781]	132	REAL, DIMENSION(klon), INTENT(IN) :: plev
[2240]	133	REAL, DIMENSION(klon), INTENT(IN) :: u1_lay, v1_lay, gustiness
[781]	134	REAL, DIMENSION(klon), INTENT(IN) :: temp_air, spechum
	135	REAL, DIMENSION(klon), INTENT(IN) :: epot_air, ccanopy
	136	REAL, DIMENSION(klon), INTENT(IN) :: tq_cdrag
	137	REAL, DIMENSION(klon), INTENT(IN) :: petAcoef, peqAcoef
	138	REAL, DIMENSION(klon), INTENT(IN) :: petBcoef, peqBcoef
	139	REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow
	140	REAL, DIMENSION(klon), INTENT(IN) :: lwdown, swnet, swdown, ps
[1146]	141	REAL, DIMENSION(klon), INTENT(IN) :: q2m, t2m
[781]	142
	143	! Parametres de sortie
	144	!****************************************************************************************
	145	REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat, qsurf
[888]	146	REAL, DIMENSION(klon), INTENT(OUT) :: tsol_rad, tsurf_new
	147	REAL, DIMENSION(klon), INTENT(OUT) :: alb1_new, alb2_new
[2571]	148	REAL, DIMENSION(klon), INTENT(OUT) :: emis_new, z0m_new, z0h_new
[2952]	149	REAL, DIMENSION(klon,nvm_lmdz), INTENT(OUT) :: veget
	150	REAL, DIMENSION(klon,nvm_lmdz), INTENT(OUT) :: lai
	151	REAL, DIMENSION(klon,nvm_lmdz), INTENT(OUT) :: height
[781]	152
[2952]	153
[781]	154	! Local
	155	!****************************************************************************************
	156	INTEGER :: ij, jj, igrid, ireal, index
	157	INTEGER :: error
[1146]	158	REAL, DIMENSION(klon) :: swdown_vrai
[781]	159	CHARACTER (len = 20) :: modname = 'surf_land_orchidee'
	160	CHARACTER (len = 80) :: abort_message
	161	LOGICAL,SAVE :: check = .FALSE.
	162	!$OMP THREADPRIVATE(check)
	163
	164	! type de couplage dans sechiba
	165	! character (len=10) :: coupling = 'implicit'
	166	! drapeaux controlant les appels dans SECHIBA
	167	! type(control_type), save :: control_in
	168	! Preserved albedo
	169	REAL, ALLOCATABLE, DIMENSION(:), SAVE :: albedo_keep, zlev
	170	!$OMP THREADPRIVATE(albedo_keep,zlev)
	171	! coordonnees geographiques
	172	REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: lalo
	173	!$OMP THREADPRIVATE(lalo)
[3413]	174	! boundaries of cells
	175	REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: bounds_lalo
	176	!$OMP THREADPRIVATE(bounds_lalo)
[781]	177	! pts voisins
	178	INTEGER,ALLOCATABLE, DIMENSION(:,:), SAVE :: neighbours
	179	!$OMP THREADPRIVATE(neighbours)
	180	! fractions continents
	181	REAL,ALLOCATABLE, DIMENSION(:), SAVE :: contfrac
	182	!$OMP THREADPRIVATE(contfrac)
	183	! resolution de la grille
	184	REAL, ALLOCATABLE, DIMENSION (:,:), SAVE :: resolution
	185	!$OMP THREADPRIVATE(resolution)
	186
	187	REAL, ALLOCATABLE, DIMENSION (:,:), SAVE :: lon_scat, lat_scat
	188	!$OMP THREADPRIVATE(lon_scat,lat_scat)
	189
[3413]	190	! area of cells
	191	REAL, ALLOCATABLE, DIMENSION (:), SAVE :: area
	192	!$OMP THREADPRIVATE(area)
	193
[781]	194	LOGICAL, SAVE :: lrestart_read = .TRUE.
	195	!$OMP THREADPRIVATE(lrestart_read)
	196	LOGICAL, SAVE :: lrestart_write = .FALSE.
	197	!$OMP THREADPRIVATE(lrestart_write)
	198
	199	REAL, DIMENSION(knon,2) :: albedo_out
	200
	201	! Pb de nomenclature
	202	REAL, DIMENSION(klon) :: petA_orc, peqA_orc
	203	REAL, DIMENSION(klon) :: petB_orc, peqB_orc
	204	! Pb de correspondances de grilles
	205	INTEGER, DIMENSION(:), SAVE, ALLOCATABLE :: ig, jg
	206	!$OMP THREADPRIVATE(ig,jg)
	207	INTEGER :: indi, indj
	208	INTEGER, SAVE, ALLOCATABLE,DIMENSION(:) :: ktindex
	209	!$OMP THREADPRIVATE(ktindex)
	210
	211	! Essai cdrag
	212	REAL, DIMENSION(klon) :: cdrag
	213	INTEGER,SAVE :: offset
	214	!$OMP THREADPRIVATE(offset)
	215
	216	REAL, DIMENSION(klon_glo) :: rlon_g,rlat_g
	217	INTEGER, SAVE :: orch_comm
	218	!$OMP THREADPRIVATE(orch_comm)
	219
	220	REAL, ALLOCATABLE, DIMENSION(:), SAVE :: coastalflow
	221	!$OMP THREADPRIVATE(coastalflow)
	222	REAL, ALLOCATABLE, DIMENSION(:), SAVE :: riverflow
	223	!$OMP THREADPRIVATE(riverflow)
[987]	224
[3413]	225	INTEGER :: orch_mpi_rank
	226	INTEGER :: orch_mpi_size
[987]	227	INTEGER :: orch_omp_rank
	228	INTEGER :: orch_omp_size
[3413]	229
	230	REAL, ALLOCATABLE, DIMENSION(:) :: longitude_glo
	231	REAL, ALLOCATABLE, DIMENSION(:) :: latitude_glo
	232	REAL, ALLOCATABLE, DIMENSION(:,:) :: boundslon_glo
	233	REAL, ALLOCATABLE, DIMENSION(:,:) :: boundslat_glo
	234	INTEGER, ALLOCATABLE, DIMENSION(:) :: ind_cell_glo_glo
	235	INTEGER, ALLOCATABLE, SAVE,DIMENSION(:) :: ind_cell
	236	!$OMP THREADPRIVATE(ind_cell)
	237	INTEGER :: begin, end
[781]	238	!
	239	! Fin definition
	240	!****************************************************************************************
	241
	242	IF (check) WRITE(lunout,*)'Entree ', modname
	243
	244	! Initialisation
	245
	246	IF (debut) THEN
[1067]	247	! Test of coherence between variable ok_veget and cpp key CPP_VEGET
	248	#ifndef CPP_VEGET
	249	abort_message='Pb de coherence: ok_veget = .true. mais CPP_VEGET = .false.'
[2311]	250	CALL abort_physic(modname,abort_message,1)
[1067]	251	#endif
	252
[987]	253	CALL Init_surf_para(knon)
[781]	254	ALLOCATE(ktindex(knon))
	255	IF ( .NOT. ALLOCATED(albedo_keep)) THEN
[987]	256	!ym ALLOCATE(albedo_keep(klon))
	257	!ym bizarre que non alloué en knon precedement
	258	ALLOCATE(albedo_keep(knon))
[781]	259	ALLOCATE(zlev(knon))
	260	ENDIF
	261	! Pb de correspondances de grilles
	262	ALLOCATE(ig(klon))
	263	ALLOCATE(jg(klon))
	264	ig(1) = 1
	265	jg(1) = 1
	266	indi = 0
	267	indj = 2
	268	DO igrid = 2, klon - 1
	269	indi = indi + 1
[2344]	270	IF ( indi > nbp_lon) THEN
[781]	271	indi = 1
	272	indj = indj + 1
	273	ENDIF
	274	ig(igrid) = indi
	275	jg(igrid) = indj
	276	ENDDO
	277	ig(klon) = 1
[2344]	278	jg(klon) = nbp_lat
[781]	279
[3413]	280	IF ((.NOT. ALLOCATED(area))) THEN
	281	ALLOCATE(area(knon), stat = error)
[781]	282	IF (error /= 0) THEN
[3413]	283	abort_message='Pb allocation area'
[2311]	284	CALL abort_physic(modname,abort_message,1)
[781]	285	ENDIF
	286	ENDIF
	287	DO igrid = 1, knon
[3413]	288	area(igrid) = cell_area(knindex(igrid))
[781]	289	ENDDO
[3413]	290
	291	IF (grid_type==unstructured) THEN
[781]	292
[3413]	293
	294	IF ((.NOT. ALLOCATED(lon_scat))) THEN
	295	ALLOCATE(lon_scat(nbp_lon,nbp_lat), stat = error)
	296	IF (error /= 0) THEN
	297	abort_message='Pb allocation lon_scat'
	298	CALL abort_physic(modname,abort_message,1)
	299	ENDIF
	300	ENDIF
	301
	302	IF ((.NOT. ALLOCATED(lat_scat))) THEN
	303	ALLOCATE(lat_scat(nbp_lon,nbp_lat), stat = error)
	304	IF (error /= 0) THEN
	305	abort_message='Pb allocation lat_scat'
	306	CALL abort_physic(modname,abort_message,1)
	307	ENDIF
	308	ENDIF
	309	CALL Gather(rlon,rlon_g)
	310	CALL Gather(rlat,rlat_g)
	311
	312	IF (is_mpi_root) THEN
	313	index = 1
	314	DO jj = 2, nbp_lat-1
	315	DO ij = 1, nbp_lon
	316	index = index + 1
	317	lon_scat(ij,jj) = rlon_g(index)
	318	lat_scat(ij,jj) = rlat_g(index)
	319	ENDDO
	320	ENDDO
	321	lon_scat(:,1) = lon_scat(:,2)
	322	lat_scat(:,1) = rlat_g(1)
	323	lon_scat(:,nbp_lat) = lon_scat(:,2)
	324	lat_scat(:,nbp_lat) = rlat_g(klon_glo)
	325	ENDIF
	326
	327	CALL bcast(lon_scat)
	328	CALL bcast(lat_scat)
	329
	330	ELSE IF (grid_type==regular_lonlat) THEN
	331
	332	IF ((.NOT. ALLOCATED(lalo))) THEN
	333	ALLOCATE(lalo(knon,2), stat = error)
	334	IF (error /= 0) THEN
	335	abort_message='Pb allocation lalo'
	336	CALL abort_physic(modname,abort_message,1)
	337	ENDIF
	338	ENDIF
[781]	339
[3413]	340	IF ((.NOT. ALLOCATED(bounds_lalo))) THEN
	341	ALLOCATE(bounds_lalo(knon,nvertex,2), stat = error)
	342	IF (error /= 0) THEN
	343	abort_message='Pb allocation lalo'
	344	CALL abort_physic(modname,abort_message,1)
	345	ENDIF
	346	ENDIF
[781]	347
[3413]	348	IF ((.NOT. ALLOCATED(lon_scat))) THEN
	349	ALLOCATE(lon_scat(nbp_lon,nbp_lat), stat = error)
	350	IF (error /= 0) THEN
	351	abort_message='Pb allocation lon_scat'
	352	CALL abort_physic(modname,abort_message,1)
	353	ENDIF
	354	ENDIF
	355	IF ((.NOT. ALLOCATED(lat_scat))) THEN
	356	ALLOCATE(lat_scat(nbp_lon,nbp_lat), stat = error)
	357	IF (error /= 0) THEN
	358	abort_message='Pb allocation lat_scat'
	359	CALL abort_physic(modname,abort_message,1)
	360	ENDIF
	361	ENDIF
	362	lon_scat = 0.
	363	lat_scat = 0.
	364	DO igrid = 1, knon
	365	index = knindex(igrid)
	366	lalo(igrid,2) = rlon(index)
	367	lalo(igrid,1) = rlat(index)
	368	bounds_lalo(igrid,:,2)=boundslon(index,:)*180./PI
	369	bounds_lalo(igrid,:,1)=boundslat(index,:)*180./PI
	370	ENDDO
[781]	371
[3413]	372
	373
	374	CALL Gather(rlon,rlon_g)
	375	CALL Gather(rlat,rlat_g)
	376
	377	IF (is_mpi_root) THEN
	378	index = 1
	379	DO jj = 2, nbp_lat-1
	380	DO ij = 1, nbp_lon
	381	index = index + 1
	382	lon_scat(ij,jj) = rlon_g(index)
	383	lat_scat(ij,jj) = rlat_g(index)
	384	ENDDO
	385	ENDDO
	386	lon_scat(:,1) = lon_scat(:,2)
	387	lat_scat(:,1) = rlat_g(1)
	388	lon_scat(:,nbp_lat) = lon_scat(:,2)
	389	lat_scat(:,nbp_lat) = rlat_g(klon_glo)
	390	ENDIF
	391
	392	CALL bcast(lon_scat)
	393	CALL bcast(lat_scat)
	394
[781]	395	ENDIF
	396	!
	397	! Allouer et initialiser le tableau des voisins et des fraction de continents
	398	!
	399	IF (( .NOT. ALLOCATED(contfrac))) THEN
	400	ALLOCATE(contfrac(knon), stat = error)
	401	IF (error /= 0) THEN
	402	abort_message='Pb allocation contfrac'
[2311]	403	CALL abort_physic(modname,abort_message,1)
[781]	404	ENDIF
	405	ENDIF
	406
	407	DO igrid = 1, knon
	408	ireal = knindex(igrid)
	409	contfrac(igrid) = pctsrf(ireal,is_ter)
	410	ENDDO
	411
	412
[3413]	413	IF (grid_type==regular_lonlat) THEN
	414
	415	IF ( (.NOT.ALLOCATED(neighbours))) THEN
	416	ALLOCATE(neighbours(knon,8), stat = error)
	417	IF (error /= 0) THEN
	418	abort_message='Pb allocation neighbours'
	419	CALL abort_physic(modname,abort_message,1)
	420	ENDIF
	421	ENDIF
	422	neighbours = -1.
	423	CALL Init_neighbours(knon,neighbours,knindex,pctsrf(:,is_ter))
[781]	424
[3413]	425	ELSE IF (grid_type==unstructured) THEN
	426
	427	IF ( (.NOT.ALLOCATED(neighbours))) THEN
	428	ALLOCATE(neighbours(knon,12), stat = error)
	429	IF (error /= 0) THEN
	430	abort_message='Pb allocation neighbours'
	431	CALL abort_physic(modname,abort_message,1)
	432	ENDIF
	433	ENDIF
	434	neighbours = -1.
	435
	436	ENDIF
	437
	438
[781]	439	!
	440	! Allocation et calcul resolutions
	441	IF ( (.NOT.ALLOCATED(resolution))) THEN
	442	ALLOCATE(resolution(knon,2), stat = error)
	443	IF (error /= 0) THEN
	444	abort_message='Pb allocation resolution'
[2311]	445	CALL abort_physic(modname,abort_message,1)
[781]	446	ENDIF
	447	ENDIF
[3413]	448
	449	IF (grid_type==regular_lonlat) THEN
	450	DO igrid = 1, knon
	451	ij = knindex(igrid)
	452	resolution(igrid,1) = dx(ij)
	453	resolution(igrid,2) = dy(ij)
	454	ENDDO
	455	ENDIF
	456
[781]	457	ALLOCATE(coastalflow(klon), stat = error)
	458	IF (error /= 0) THEN
	459	abort_message='Pb allocation coastalflow'
[2311]	460	CALL abort_physic(modname,abort_message,1)
[781]	461	ENDIF
	462
	463	ALLOCATE(riverflow(klon), stat = error)
	464	IF (error /= 0) THEN
	465	abort_message='Pb allocation riverflow'
[2311]	466	CALL abort_physic(modname,abort_message,1)
[781]	467	ENDIF
[1279]	468	!
[1454]	469	! carbon_cycle_cpl not possible with this interface and version of ORHCHIDEE
[1279]	470	!
	471	IF (carbon_cycle_cpl) THEN
[1454]	472	abort_message='carbon_cycle_cpl not yet possible with this interface of ORCHIDEE'
[2311]	473	CALL abort_physic(modname,abort_message,1)
[1279]	474	END IF
	475
[781]	476	ENDIF ! (fin debut)
[1279]	477
[781]	478
	479	!
	480	! Appel a la routine sols continentaux
	481	!
	482	IF (lafin) lrestart_write = .TRUE.
	483	IF (check) WRITE(lunout,*)'lafin ',lafin,lrestart_write
[987]	484
[781]	485	petA_orc(1:knon) = petBcoef(1:knon) * dtime
	486	petB_orc(1:knon) = petAcoef(1:knon)
	487	peqA_orc(1:knon) = peqBcoef(1:knon) * dtime
	488	peqB_orc(1:knon) = peqAcoef(1:knon)
	489
	490	cdrag = 0.
	491	cdrag(1:knon) = tq_cdrag(1:knon)
	492
	493	! zlev(1:knon) = (100.plev(1:knon))/((ps(1:knon)/287.05temp_air(1:knon))*9.80665)
[2011]	494	! zlev(1:knon) = (100.plev(1:knon))/((ps(1:knon)/RDtemp_air(1:knon))*RG)
	495	zlev(1:knon) = plev(1:knon)RDtemp_air(1:knon)/((ps(1:knon)100.0)RG)
[781]	496
	497
	498	! PF et PASB
	499	! where(cdrag > 0.01)
	500	! cdrag = 0.01
	501	! endwhere
	502	! write(,)'Cdrag = ',minval(cdrag),maxval(cdrag)
	503
	504
	505	IF (debut) THEN
[987]	506	CALL Init_orchidee_index(knon,knindex,offset,ktindex)
[3413]	507	CALL Get_orchidee_communicator(orch_comm,orch_mpi_size,orch_mpi_rank, orch_omp_size,orch_omp_rank)
	508
	509	IF (grid_type==unstructured) THEN
	510	IF (knon==0) THEN
	511	begin=1
	512	end=0
	513	ELSE
	514	begin=offset+1
	515	end=offset+ktindex(knon)
	516	ENDIF
	517
	518	IF (orch_mpi_rank==orch_mpi_size-1 .AND. orch_omp_rank==orch_omp_size-1) end=nbp_lon*nbp_lat
	519
	520	ALLOCATE(lalo(end-begin+1,2))
	521	ALLOCATE(bounds_lalo(end-begin+1,nvertex,2))
	522	ALLOCATE(ind_cell(end-begin+1))
	523
	524	ALLOCATE(longitude_glo(klon_glo))
	525	CALL gather(longitude,longitude_glo)
	526	CALL bcast(longitude_glo)
	527	lalo(:,2)=longitude_glo(begin:end)*180./PI
	528
	529	ALLOCATE(latitude_glo(klon_glo))
	530	CALL gather(latitude,latitude_glo)
	531	CALL bcast(latitude_glo)
	532	lalo(:,1)=latitude_glo(begin:end)*180./PI
	533
	534	ALLOCATE(boundslon_glo(klon_glo,nvertex))
	535	CALL gather(boundslon,boundslon_glo)
	536	CALL bcast(boundslon_glo)
	537	bounds_lalo(:,:,2)=boundslon_glo(begin:end,:)*180./PI
	538
	539	ALLOCATE(boundslat_glo(klon_glo,nvertex))
	540	CALL gather(boundslat,boundslat_glo)
	541	CALL bcast(boundslat_glo)
	542	bounds_lalo(:,:,1)=boundslat_glo(begin:end,:)*180./PI
	543
	544	ALLOCATE(ind_cell_glo_glo(klon_glo))
	545	CALL gather(ind_cell_glo,ind_cell_glo_glo)
	546	CALL bcast(ind_cell_glo_glo)
	547	ind_cell(:)=ind_cell_glo_glo(begin:end)
	548
	549	ENDIF
[987]	550	CALL Init_synchro_omp
	551
[1023]	552	IF (knon > 0) THEN
[1067]	553	#ifdef CPP_VEGET
[3413]	554	CALL Init_intersurf(nbp_lon,nbp_lat,knon,ktindex,offset,orch_omp_size,orch_omp_rank,orch_comm,grid=grid_type)
[1067]	555	#endif
[987]	556	ENDIF
[802]	557
[987]	558
[3413]	559	IF (knon > 0) THEN
[987]	560
[1067]	561	#ifdef CPP_VEGET
[3413]	562
[2571]	563	CALL intersurf_initialize_gathered (itime+itau_phy-1, nbp_lon, nbp_lat, knon, ktindex, dtime, &
	564	lrestart_read, lrestart_write, lalo, contfrac, neighbours, resolution, date0, &
	565	zlev, u1_lay, v1_lay, spechum, temp_air, epot_air, &
[802]	566	cdrag, petA_orc, peqA_orc, petB_orc, peqB_orc, &
	567	precip_rain, precip_snow, lwdown, swnet, swdown, ps, &
	568	evap, fluxsens, fluxlat, coastalflow, riverflow, &
[2952]	569	tsol_rad, tsurf_new, qsurf, albedo_out, emis_new, z0m_new, &
[3413]	570	lon_scat, lat_scat, q2m(1:knon), t2m(1:knon), z0h_new(1:knon), nvm_orch, &
	571	grid=grid_type, bounds_latlon=bounds_lalo, cell_area=area, ind_cell_glo=ind_cell)
[1067]	572	#endif
[781]	573	ENDIF
	574
[987]	575	CALL Synchro_omp
	576
[781]	577	albedo_keep(1:knon) = (albedo_out(1:knon,1)+albedo_out(1:knon,2))/2.
	578
	579	ENDIF
	580
[987]	581
[781]	582	! swdown_vrai(1:knon) = swnet(1:knon)/(1. - albedo_keep(1:knon))
	583	swdown_vrai(1:knon) = swdown(1:knon)
	584
[987]	585	IF (knon > 0) THEN
[1067]	586	#ifdef CPP_VEGET
[2952]	587	IF (nvm_orch .NE. nvm_lmdz ) THEN
	588	abort_message='Pb de dimensiosn PFT: nvm_orch et nvm_lmdz differents.'
	589	CALL abort_physic(modname,abort_message,1)
	590	ENDIF
	591
[2571]	592	CALL intersurf_main_gathered (itime+itau_phy, nbp_lon, nbp_lat, knon, ktindex, dtime, &
[802]	593	lrestart_read, lrestart_write, lalo, &
	594	contfrac, neighbours, resolution, date0, &
[781]	595	zlev, u1_lay(1:knon), v1_lay(1:knon), spechum(1:knon), temp_air(1:knon), epot_air(1:knon), ccanopy(1:knon), &
	596	cdrag(1:knon), petA_orc(1:knon), peqA_orc(1:knon), petB_orc(1:knon), peqB_orc(1:knon), &
	597	precip_rain(1:knon), precip_snow(1:knon), lwdown(1:knon), swnet(1:knon), swdown_vrai(1:knon), ps(1:knon), &
	598	evap(1:knon), fluxsens(1:knon), fluxlat(1:knon), coastalflow(1:knon), riverflow(1:knon), &
[2571]	599	tsol_rad(1:knon), tsurf_new(1:knon), qsurf(1:knon), albedo_out(1:knon,:), emis_new(1:knon), z0m_new(1:knon), &
[3413]	600	lon_scat, lat_scat, q2m(1:knon), t2m(1:knon), z0h_new(1:knon),&
[2952]	601	veget(1:knon,:),lai(1:knon,:),height(1:knon,:),&
	602	coszang=yrmu0(1:knon))
[1067]	603	#endif
[781]	604	ENDIF
	605
[987]	606	CALL Synchro_omp
	607
[781]	608	albedo_keep(1:knon) = (albedo_out(1:knon,1)+albedo_out(1:knon,2))/2.
	609
	610	!* Send to coupler
	611	!
[996]	612	IF (type_ocean=='couple') THEN
[781]	613	CALL cpl_send_land_fields(itime, knon, knindex, &
	614	riverflow, coastalflow)
	615	ENDIF
	616
[888]	617	alb1_new(1:knon) = albedo_out(1:knon,1)
	618	alb2_new(1:knon) = albedo_out(1:knon,2)
[781]	619
	620	! Convention orchidee: positif vers le haut
	621	fluxsens(1:knon) = -1. * fluxsens(1:knon)
	622	fluxlat(1:knon) = -1. * fluxlat(1:knon)
	623
	624	! evap = -1. * evap
	625
	626	IF (debut) lrestart_read = .FALSE.
	627
[987]	628	IF (debut) CALL Finalize_surf_para
[1279]	629
[987]	630
[781]	631	END SUBROUTINE surf_land_orchidee
	632	!
	633	!****************************************************************************************
	634	!
[987]	635	SUBROUTINE Init_orchidee_index(knon,knindex,offset,ktindex)
	636	USE mod_surf_para
	637	USE mod_grid_phy_lmdz
	638
	639	INTEGER,INTENT(IN) :: knon
	640	INTEGER,INTENT(IN) :: knindex(klon)
	641	INTEGER,INTENT(OUT) :: offset
	642	INTEGER,INTENT(OUT) :: ktindex(klon)
[781]	643
[987]	644	INTEGER :: ktindex_glo(knon_glo)
	645	INTEGER :: offset_para(0:omp_size*mpi_size-1)
	646	INTEGER :: LastPoint
	647	INTEGER :: task
[781]	648
[987]	649	ktindex(1:knon)=knindex(1:knon)+(klon_mpi_begin-1)+(klon_omp_begin-1)+nbp_lon-1
[781]	650
[987]	651	CALL gather_surf(ktindex(1:knon),ktindex_glo)
	652
	653	IF (is_mpi_root .AND. is_omp_root) THEN
	654	LastPoint=0
	655	DO Task=0,mpi_size*omp_size-1
	656	IF (knon_glo_para(Task)>0) THEN
	657	offset_para(task)= LastPoint-MOD(LastPoint,nbp_lon)
	658	LastPoint=ktindex_glo(knon_glo_end_para(task))
	659	ENDIF
	660	ENDDO
[781]	661	ENDIF
	662
[987]	663	CALL bcast(offset_para)
[781]	664
[987]	665	offset=offset_para(omp_size*mpi_rank+omp_rank)
	666
	667	ktindex(1:knon)=ktindex(1:knon)-offset
[781]	668
[987]	669	END SUBROUTINE Init_orchidee_index
	670
[781]	671	!
[987]	672	!*********************** *************************************************************
[781]	673	!
[987]	674
[3413]	675	SUBROUTINE Get_orchidee_communicator(orch_comm, orch_mpi_size, orch_mpi_rank, orch_omp_size,orch_omp_rank)
[987]	676	USE mod_surf_para
	677
[1001]	678	#ifdef CPP_MPI
[781]	679	INCLUDE 'mpif.h'
	680	#endif
	681
	682	INTEGER,INTENT(OUT) :: orch_comm
[3413]	683	INTEGER,INTENT(OUT) :: orch_mpi_size
	684	INTEGER,INTENT(OUT) :: orch_mpi_rank
[987]	685	INTEGER,INTENT(OUT) :: orch_omp_size
	686	INTEGER,INTENT(OUT) :: orch_omp_rank
[781]	687	INTEGER :: color
[987]	688	INTEGER :: i,ierr
[802]	689	!
	690	! End definition
	691	!****************************************************************************************
[781]	692
[987]	693
	694	IF (is_omp_root) THEN
	695
	696	IF (knon_mpi==0) THEN
	697	color = 0
	698	ELSE
	699	color = 1
	700	ENDIF
	701
[1001]	702	#ifdef CPP_MPI
[987]	703	CALL MPI_COMM_SPLIT(COMM_LMDZ_PHY,color,mpi_rank,orch_comm,ierr)
[3413]	704	CALL MPI_COMM_SIZE(orch_comm,orch_mpi_size,ierr)
	705	CALL MPI_COMM_RANK(orch_comm,orch_mpi_rank,ierr)
[781]	706	#endif
[1023]	707
	708	ENDIF
	709	CALL bcast_omp(orch_comm)
	710
	711	IF (knon_mpi /= 0) THEN
	712	orch_omp_size=0
	713	DO i=0,omp_size-1
	714	IF (knon_omp_para(i) /=0) THEN
	715	orch_omp_size=orch_omp_size+1
	716	IF (i==omp_rank) orch_omp_rank=orch_omp_size-1
	717	ENDIF
	718	ENDDO
	719	ENDIF
[987]	720
[781]	721
	722	END SUBROUTINE Get_orchidee_communicator
	723	!
	724	!****************************************************************************************
	725	!
[987]	726
	727	SUBROUTINE Init_neighbours(knon,neighbours,knindex,pctsrf)
	728	USE mod_grid_phy_lmdz
	729	USE mod_surf_para
[1785]	730	USE indice_sol_mod
[987]	731
[1001]	732	#ifdef CPP_MPI
[781]	733	INCLUDE 'mpif.h'
	734	#endif
	735
[802]	736	! Input arguments
	737	!****************************************************************************************
[781]	738	INTEGER, INTENT(IN) :: knon
[987]	739	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
[781]	740	REAL, DIMENSION(klon), INTENT(IN) :: pctsrf
	741
[802]	742	! Output arguments
	743	!****************************************************************************************
	744	INTEGER, DIMENSION(knon,8), INTENT(OUT) :: neighbours
	745
	746	! Local variables
	747	!****************************************************************************************
	748	INTEGER :: i, igrid, jj, ij, iglob
	749	INTEGER :: ierr, ireal, index
	750	INTEGER, DIMENSION(8,3) :: off_ini
	751	INTEGER, DIMENSION(8) :: offset
[987]	752	INTEGER, DIMENSION(nbp_lon,nbp_lat) :: correspond
	753	INTEGER, DIMENSION(knon_glo) :: ktindex_glo
	754	INTEGER, DIMENSION(knon_glo,8) :: neighbours_glo
	755	REAL, DIMENSION(klon_glo) :: pctsrf_glo
	756	INTEGER :: ktindex(klon)
[802]	757	!
	758	! End definition
	759	!****************************************************************************************
	760
[987]	761	ktindex(1:knon)=knindex(1:knon)+(klon_mpi_begin-1)+(klon_omp_begin-1)+nbp_lon-1
[781]	762
[987]	763	CALL gather_surf(ktindex(1:knon),ktindex_glo)
	764	CALL gather(pctsrf,pctsrf_glo)
[781]	765
[987]	766	IF (is_mpi_root .AND. is_omp_root) THEN
	767	neighbours_glo(:,:)=-1
[781]	768	! Initialisation des offset
	769	!
	770	! offset bord ouest
[987]	771	off_ini(1,1) = - nbp_lon ; off_ini(2,1) = - nbp_lon + 1 ; off_ini(3,1) = 1
	772	off_ini(4,1) = nbp_lon + 1 ; off_ini(5,1) = nbp_lon ; off_ini(6,1) = 2 * nbp_lon - 1
	773	off_ini(7,1) = nbp_lon -1 ; off_ini(8,1) = - 1
[781]	774	! offset point normal
[987]	775	off_ini(1,2) = - nbp_lon ; off_ini(2,2) = - nbp_lon + 1 ; off_ini(3,2) = 1
	776	off_ini(4,2) = nbp_lon + 1 ; off_ini(5,2) = nbp_lon ; off_ini(6,2) = nbp_lon - 1
	777	off_ini(7,2) = -1 ; off_ini(8,2) = - nbp_lon - 1
[781]	778	! offset bord est
[987]	779	off_ini(1,3) = - nbp_lon ; off_ini(2,3) = - 2 * nbp_lon + 1 ; off_ini(3,3) = - nbp_lon + 1
	780	off_ini(4,3) = 1 ; off_ini(5,3) = nbp_lon ; off_ini(6,3) = nbp_lon - 1
	781	off_ini(7,3) = -1 ; off_ini(8,3) = - nbp_lon - 1
[781]	782	!
	783	!
	784	! Attention aux poles
	785	!
[987]	786	DO igrid = 1, knon_glo
	787	index = ktindex_glo(igrid)
	788	jj = INT((index - 1)/nbp_lon) + 1
	789	ij = index - (jj - 1) * nbp_lon
[781]	790	correspond(ij,jj) = igrid
	791	ENDDO
[2126]	792	!sonia : Les mailles des voisines doivent etre toutes egales (pour couplage orchidee)
	793	IF (knon_glo == 1) THEN
	794	igrid = 1
	795	DO i = 1,8
	796	neighbours_glo(igrid, i) = igrid
	797	ENDDO
	798	ELSE
	799	print*,'sonia : knon_glo,ij,jj', knon_glo, ij,jj
[781]	800
[987]	801	DO igrid = 1, knon_glo
	802	iglob = ktindex_glo(igrid)
	803
	804	IF (MOD(iglob, nbp_lon) == 1) THEN
[781]	805	offset = off_ini(:,1)
[987]	806	ELSE IF(MOD(iglob, nbp_lon) == 0) THEN
[781]	807	offset = off_ini(:,3)
	808	ELSE
	809	offset = off_ini(:,2)
	810	ENDIF
[987]	811
[781]	812	DO i = 1, 8
	813	index = iglob + offset(i)
[987]	814	ireal = (MIN(MAX(1, index - nbp_lon + 1), klon_glo))
	815	IF (pctsrf_glo(ireal) > EPSFRA) THEN
	816	jj = INT((index - 1)/nbp_lon) + 1
	817	ij = index - (jj - 1) * nbp_lon
	818	neighbours_glo(igrid, i) = correspond(ij, jj)
[781]	819	ENDIF
	820	ENDDO
	821	ENDDO
[2126]	822	ENDIF !fin knon_glo == 1
[781]	823
	824	ENDIF
	825
[987]	826	DO i = 1, 8
	827	CALL scatter_surf(neighbours_glo(:,i),neighbours(1:knon,i))
[781]	828	ENDDO
	829	END SUBROUTINE Init_neighbours
[987]	830
[781]	831	!
	832	!****************************************************************************************
	833	!
[1146]	834	#endif
[2571]	835	#endif
[2952]	836	#endif
[3413]	837	#endif
[781]	838	END MODULE surf_land_orchidee_mod

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

Download in other formats:

Original Format