Context Navigation

source: branches/ORCHIDEE_2_2/ORCHIDEE/src_sechiba/intersurf.f90 @ 7251

Last change on this file since 7251 was 6370, checked in by josefine.ghattas, 5 years ago
Cut line too long for gfortran
Property svn:keywords set to `Revision Date HeadURL Date Author Revision`
File size: 88.5 KB

Rev	Line
[4263]	1	! ================================================================================================================================
	2	! MODULE : intersurf
	3	!
[4470]	4	! CONTACT : orchidee-help _at_ listes.ipsl.fr
[4263]	5	!
	6	! LICENCE : IPSL (2006)
	7	! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
	8	!
	9	!>\BRIEF Subroutines for interfacing between the driver dim2_driver and sechiba and between LMDZ and sechiba
[8]	10	!!
[4263]	11	!!\n DESCRIPTION: This module contains subroutines for the interfacing between ORCHIDEE and LMDZ and between the driver
	12	!! dim2_driver and the reste of ORCHIDEE. Follwoing subroutines exists:
[8]	13	!!
[4263]	14	!! - intersurf_initialize_2d : Intitialization and call to sechiba_initialize, called from dim2_driver
	15	!! before the first call to intersurf_main_2d.
	16	!! - intersurf_main_2d : Main subroutine will call sechiba_main, called from dim2_driver at each time-step
	17	!! - init_intersurf : Initialize grid information when coupling with LMDZ. This subroutine is called
	18	!! from LMDZ before call to intersurf_initialize_gathered
	19	!! - intersurf_initialize_gathered : Intitialization and call to sechiba_initialize, called from LMDZ
	20	!! before the first call to intersurf_main_2d.
	21	!! - intersurf_main_gathered : Main subroutine will call sechiba_main, called from LMDZ at each time-step
	22	!! - intsurf_time : Initialize and update time information, called in the initialization phase
	23	!! and at each time step from the different intersurf subroutines.
[8]	24	!!
[4263]	25	!! RECENT CHANGE(S):
	26	!!
	27	!! REFERENCE(S) : None
	28	!!
	29	!! SVN :
	30	!! $HeadURL$
	31	!! $Date$
	32	!! $Revision$
	33	!! \n
	34	!_ ================================================================================================================================
[8]	35	MODULE intersurf
	36
	37	USE IOIPSL
[1788]	38	USE xios_orchidee
[1392]	39	USE ioipsl_para
[8]	40	USE defprec
	41	USE sechiba
	42	USE constantes
[947]	43	USE constantes_soil
[2547]	44	USE control
[511]	45	USE pft_parameters
[1392]	46	USE mod_orchidee_para
[8]	47	USE solar
	48	USE grid
[4646]	49	USE time, ONLY : one_year, one_day, dt_sechiba, time_initialize, time_nextstep, julian_diff
	50	USE time, ONLY : year_end, month_end, day_end, sec_end
[5364]	51	USE ioipslctrl, ONLY : ioipslctrl_history, ioipslctrl_restini, ioipslctrl_restclo, ok_histsync, max_hist_level, dw
[8]	52
	53	IMPLICIT NONE
	54
	55	PRIVATE
[4646]	56	PUBLIC :: Init_intersurf, intersurf_main, intersurf_main_2d, intersurf_main_gathered
[4287]	57	PUBLIC :: intersurf_initialize_2d, intersurf_initialize_gathered, intersurf_clear
[8]	58
[1078]	59
[4263]	60	! Interface called from LMDZ in older verisons
[8]	61	INTERFACE intersurf_main
[2605]	62	MODULE PROCEDURE intersurf_main_gathered
[8]	63	END INTERFACE
[1078]	64
[3851]	65	LOGICAL, SAVE :: lstep_init_intersurf=.TRUE.!! Initialisation has to be done one time
	66	!$OMP THREADPRIVATE(lstep_init_intersurf)
[2348]	67	INTEGER(i_std), SAVE :: printlev_loc !! Write level to this module
	68	!$OMP THREADPRIVATE(printlev_loc)
[8]	69	INTEGER(i_std), SAVE :: hist_id, rest_id !! IDs for history and restart files
[1078]	70	!$OMP THREADPRIVATE(hist_id, rest_id)
[8]	71	INTEGER(i_std), SAVE :: hist2_id !! ID for the second history files (Hi-frequency ?)
[1078]	72	!$OMP THREADPRIVATE(hist2_id)
[8]	73	INTEGER(i_std), SAVE :: hist_id_stom, hist_id_stom_IPCC, rest_id_stom !! Dito for STOMATE
[1078]	74	!$OMP THREADPRIVATE(hist_id_stom, hist_id_stom_IPCC, rest_id_stom)
[8]	75	INTEGER(i_std), SAVE :: itau_offset !! This offset is used to phase the
[4263]	76	!! calendar of the GCM or the driver.
[1078]	77	!$OMP THREADPRIVATE(itau_offset)
	78	REAL(r_std), SAVE :: date0_shifted
	79	!$OMP THREADPRIVATE(date0_shifted)
[4263]	80	REAL(r_std), SAVE :: julian0 !! first day of this year
[1078]	81	!$OMP THREADPRIVATE(julian0)
[2605]	82	LOGICAL, SAVE :: fatmco2 !! Flag to force the value of atmospheric CO2 for vegetation.
	83	!$OMP THREADPRIVATE(fatmco2)
	84	REAL(r_std), SAVE :: atmco2 !! atmospheric CO2
	85	!$OMP THREADPRIVATE(atmco2)
[4435]	86	REAL(r_std), SAVE :: coeff_rel !! Coefficient for time filter on riverflow and coastalflow
	87	!$OMP THREADPRIVATE(coeff_rel)
	88	REAL(r_std), ALLOCATABLE, DIMENSION(:), SAVE :: riverflow_cpl0 !! Value from previous time step for riverflow
	89	!$OMP THREADPRIVATE(riverflow_cpl0)
	90	REAL(r_std), ALLOCATABLE, DIMENSION(:), SAVE :: coastalflow_cpl0 !! Value from previous time step for coastalflow
	91	!$OMP THREADPRIVATE(coastalflow_cpl0)
[5389]	92	INTEGER(i_std), SAVE :: nbcf_from_LMDZ !! Number of optional coupled fields(fields_out) received from LMDZ, for ESM configuration
	93	!$OMP THREADPRIVATE(nbcf_from_LMDZ)
	94	INTEGER(i_std), SAVE :: nbcf_into_LMDZ !! Number of optional coupled fields(fields_in) sent to LMDZ, for ESM configuration
	95	!$OMP THREADPRIVATE(nbcf_into_LMDZ)
	96	CHARACTER(LEN=30), ALLOCATABLE, DIMENSION(:), SAVE :: field_out_names_loc !! Names of optional fields(fields_out) received from LMDZ, for ESM configuration
	97	!$OMP THREADPRIVATE(field_out_names_loc)
	98	CHARACTER(LEN=30), ALLOCATABLE, DIMENSION(:), SAVE :: field_in_names_loc !! Number of optional fields(fields_in) sent to LMDZ, for ESM configuration
	99	!$OMP THREADPRIVATE(field_in_names_loc)
[2605]	100
[3851]	101	PUBLIC lstep_init_intersurf
[2546]	102
[8]	103	CONTAINS
[1078]	104
[2605]	105	!! =============================================================================================================================
	106	!! SUBROUTINE: intersurf_initialize_2d
	107	!!
	108	!>\BRIEF Initialization and call to sechiba_initialize
	109	!!
	110	!! DESCRIPTION: Initialization of module variables, read options from parameter file, initialize output files and call to
	111	!! sechiba_initialize.
	112	!!
	113	!! This subroutine is called from dim2_driver before the first call to intersurf_main_2d.
	114	!!
	115	!! \n
	116	!_ ==============================================================================================================================
	117
	118	SUBROUTINE intersurf_initialize_2d (kjit, iim, jjm, kjpindex, kindex, xrdt, &
	119	lrestart_read, lrestart_write, lon, lat, zcontfrac, zresolution, date0, &
	120	zlev, u, v, qair, temp_air, epot_air, ccanopy, &
	121	cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
	122	precip_rain, precip_snow, lwdown, swnet, swdown, pb, &
	123	vevapp, fluxsens, fluxlat, coastalflow, riverflow, &
[3524]	124	tsol_rad, temp_sol_new, qsurf, albedo, emis, z0m)
[2605]	125
[8]	126	IMPLICIT NONE
[2605]	127
	128	!! 0. Variable and parameter declaration
	129	!! 0.1 Input variables
[1062]	130	INTEGER(i_std),INTENT (in) :: kjit !! Time step number
	131	INTEGER(i_std),INTENT (in) :: iim, jjm !! Dimension of input fields
	132	INTEGER(i_std),INTENT (in) :: kjpindex !! Number of continental points
	133	REAL(r_std),INTENT (in) :: xrdt !! Time step in seconds
	134	LOGICAL, INTENT (in) :: lrestart_read !! Logical for _restart_ file to read
	135	LOGICAL, INTENT (in) :: lrestart_write !! Logical for _restart_ file to write'
	136	REAL(r_std), INTENT (in) :: date0 !! Date at which kjit = 0
	137	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: kindex !! Index for continental points
[8]	138	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: u !! Lowest level wind speed
	139	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: v !! Lowest level wind speed
	140	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: zlev !! Height of first layer
	141	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: qair !! Lowest level specific humidity
	142	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: precip_rain !! Rain precipitation
	143	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: precip_snow !! Snow precipitation
	144	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: lwdown !! Down-welling long-wave flux
	145	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: swnet !! Net surface short-wave flux
	146	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: swdown !! Downwelling surface short-wave flux
	147	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: temp_air !! Air temperature in Kelvin
	148	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: epot_air !! Air potential energy
	149	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: ccanopy !! CO2 concentration in the canopy
	150	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: petAcoef !! Coeficients A from the PBL resolution
	151	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: peqAcoef !! One for T and another for q
	152	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: petBcoef !! Coeficients B from the PBL resolution
	153	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: peqBcoef !! One for T and another for q
[2183]	154	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: pb !! Surface pressure
[8]	155	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: lon, lat !! Geographical coordinates
[1062]	156	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: zcontfrac !! Fraction of continent in the grid
[8]	157	REAL(r_std),DIMENSION (iim,jjm,2), INTENT(in) :: zresolution !! resolution in x and y dimensions
[2605]	158
	159	!! 0.2 Output variables
[3524]	160	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: z0m !! Surface roughness
[4434]	161	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: coastalflow !! Diffuse flow of water into the ocean (m^3/s)
	162	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: riverflow !! Largest rivers flowing into the ocean (m^3/s)
[8]	163	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: tsol_rad !! Radiative surface temperature
	164	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: vevapp !! Total of evaporation
	165	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: temp_sol_new !! New soil temperature
	166	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: qsurf !! Surface specific humidity
	167	REAL(r_std),DIMENSION (iim,jjm,2), INTENT(out) :: albedo !! Albedo
	168	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: fluxsens !! Sensible chaleur flux
	169	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: fluxlat !! Latent chaleur flux
	170	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: emis !! Emissivity
[2605]	171
	172	!! 0.3 Modified variables
	173	REAL(r_std),DIMENSION (iim,jjm), INTENT(inout) :: cdrag !! Cdrag
	174
	175	!! 0.4 Local variables
[8]	176	REAL(r_std),DIMENSION (kjpindex) :: zu !! Work array to keep u
	177	REAL(r_std),DIMENSION (kjpindex) :: zv !! Work array to keep v
	178	REAL(r_std),DIMENSION (kjpindex) :: zzlev !! Work array to keep zlev
	179	REAL(r_std),DIMENSION (kjpindex) :: zqair !! Work array to keep qair
	180	REAL(r_std),DIMENSION (kjpindex) :: zprecip_rain !! Work array to keep precip_rain
	181	REAL(r_std),DIMENSION (kjpindex) :: zprecip_snow !! Work array to keep precip_snow
	182	REAL(r_std),DIMENSION (kjpindex) :: zlwdown !! Work array to keep lwdown
	183	REAL(r_std),DIMENSION (kjpindex) :: zswnet !! Work array to keep swnet
	184	REAL(r_std),DIMENSION (kjpindex) :: zswdown !! Work array to keep swdown
	185	REAL(r_std),DIMENSION (kjpindex) :: ztemp_air !! Work array to keep temp_air
	186	REAL(r_std),DIMENSION (kjpindex) :: zepot_air !! Work array to keep epot_air
	187	REAL(r_std),DIMENSION (kjpindex) :: zccanopy !! Work array to keep ccanopy
	188	REAL(r_std),DIMENSION (kjpindex) :: zpetAcoef !! Work array to keep petAcoef
	189	REAL(r_std),DIMENSION (kjpindex) :: zpeqAcoef !! Work array to keep peqAcoef
	190	REAL(r_std),DIMENSION (kjpindex) :: zpetBcoef !! Work array to keep petBcoef
	191	REAL(r_std),DIMENSION (kjpindex) :: zpeqBcoef !! Work array to keep peqVcoef
	192	REAL(r_std),DIMENSION (kjpindex) :: zcdrag !! Work array to keep cdrag
	193	REAL(r_std),DIMENSION (kjpindex) :: zpb !! Work array to keep pb
[3524]	194	REAL(r_std),DIMENSION (kjpindex) :: zz0m, zz0h !! Work array to keep zz0m, zz0h
[4434]	195	REAL(r_std),DIMENSION (kjpindex) :: zcoastal !! Work array to keep coastalflow (m^3/dt)
	196	REAL(r_std),DIMENSION (kjpindex) :: zriver !! Work array to keep riverflow (m^3/dt)
[8]	197	REAL(r_std),DIMENSION (kjpindex) :: ztsol_rad !! Work array to keep tsol_rad
	198	REAL(r_std),DIMENSION (kjpindex) :: zvevapp !! Work array to keep vevapp
	199	REAL(r_std),DIMENSION (kjpindex) :: ztemp_sol_new !! Work array to keep temp_sol_new
	200	REAL(r_std),DIMENSION (kjpindex) :: zqsurf !! Work array to keep qsurf
	201	REAL(r_std),DIMENSION (kjpindex,2) :: zalbedo !! Work array to keep albedo
	202	REAL(r_std),DIMENSION (kjpindex) :: zfluxsens !! Work array to keep fluxsens
	203	REAL(r_std),DIMENSION (kjpindex) :: zfluxlat !! Work array to keep fluxlat
	204	REAL(r_std),DIMENSION (kjpindex) :: zemis !! Work array to keep emis
	205	INTEGER(i_std) :: i, j, ik
[2001]	206	INTEGER(i_std) :: ier
[8]	207	INTEGER(i_std) :: itau_sechiba
	208	INTEGER :: old_fileout !! old Logical Int for std IO output
[2293]	209
[2605]	210
[4693]	211	IF (printlev >= 2) WRITE(numout,*) 'Start intersurf_initialize_2d'
[2424]	212	CALL ipslnlf_p(new_number=numout,old_number=old_fileout)
[4689]	213
	214	! Initialize variables in module time
	215	CALL time_initialize(kjit, date0, xrdt, "END")
	216
[2631]	217	! Configuration of SSL specific parameters
[4646]	218	CALL control_initialize
[2293]	219
[2605]	220	! Initialize specific write level
	221	printlev_loc=get_printlev('instersurf')
	222
	223	OFF_LINE_MODE = .TRUE.
	224
	225	DO ik=1,kjpindex
	226
	227	j = ((kindex(ik)-1)/iim) + 1
	228	i = (kindex(ik) - (j-1)*iim)
	229
	230	!- Create the internal coordinate table
	231	!-
	232	lalo(ik,1) = lat(i,j)
	233	lalo(ik,2) = lon(i,j)
[8]	234	!
[2605]	235	!- Store the fraction of the continents only once so that the user
	236	!- does not change them afterwards.
	237	!-
	238	contfrac(ik) = zcontfrac(i,j)
	239	ENDDO
	240	CALL gather(contfrac,contfrac_g)
	241	CALL gather(lalo,lalo_g)
	242	CALL gather2D_mpi(lon,lon_g)
	243	CALL gather2D_mpi(lat,lat_g)
[2631]	244
[2605]	245	CALL ioipslctrl_restini(kjit, date0, xrdt, rest_id, rest_id_stom, itau_offset, date0_shifted)
	246	itau_sechiba = kjit + itau_offset
	247
	248	!!- Initialize module for output with XIOS
	249	!
[4646]	250	CALL xios_orchidee_init( MPI_COMM_ORCH, &
	251	date0, year_end, month_end, day_end, julian_diff, &
[5454]	252	lon, lat, znt )
[5364]	253
	254	CALL sechiba_xios_initialize
	255
	256	CALL xios_orchidee_close_definition
	257	IF (printlev >= 2) WRITE(numout,*) 'After xios_orchidee_close_definition'
	258
[2605]	259	!- Initialize IOIPSL sechiba output files
	260	CALL ioipslctrl_history(iim, jjm, lon, lat, kindex, kjpindex, itau_sechiba, date0_shifted, xrdt, hist_id, &
	261	hist2_id, hist_id_stom, hist_id_stom_IPCC)
[2658]	262
[2605]	263	!
	264	! Shift the time step to phase the two models
	265	!
	266	itau_sechiba = kjit + itau_offset
	267
	268	! Update the calendar in xios by sending the new time step
	269	! Special case : the model is only in initialization phase and the current itau_sechiba is not a real time step.
	270	! Therefor give itau_sechiba+1 to xios to have a correct time axis in output files.
	271	CALL xios_orchidee_update_calendar(itau_sechiba+1)
[4646]	272
[2605]	273	!
	274	! 1. gather input fields from kindex array
	275	! Warning : I'm not sure this interface with one dimension array is the good one
	276	!
	277	DO ik=1, kjpindex
	278
	279	j = ((kindex(ik)-1)/iim) + 1
	280	i = (kindex(ik) - (j-1)*iim)
	281
	282	zu(ik) = u(i,j)
	283	zv(ik) = v(i,j)
	284	zzlev(ik) = zlev(i,j)
	285	zqair(ik) = qair(i,j)
	286	zprecip_rain(ik) = precip_rain(i,j)*xrdt
	287	zprecip_snow(ik) = precip_snow(i,j)*xrdt
	288	zlwdown(ik) = lwdown(i,j)
	289	zswnet(ik) = swnet(i,j)
	290	zswdown(ik) = swdown(i,j)
	291	ztemp_air(ik) = temp_air(i,j)
	292	zepot_air(ik) = epot_air(i,j)
	293	zccanopy(ik) = ccanopy(i,j)
	294	zpetAcoef(ik) = petAcoef(i,j)
	295	zpeqAcoef(ik) = peqAcoef(i,j)
	296	zpetBcoef(ik) = petBcoef(i,j)
	297	zpeqBcoef(ik) = peqBcoef(i,j)
	298	zcdrag(ik) = cdrag(i,j)
	299	zpb(ik) = pb(i,j)
	300
	301	ENDDO
[4648]	302
[2605]	303	!
	304	! 2. save the grid
	305	!
	306	CALL histwrite_p(hist_id, 'LandPoints', itau_sechiba+1, (/ ( REAL(ik), ik=1,kjpindex ) /), kjpindex, kindex)
	307	CALL histwrite_p(hist_id, 'Areas', itau_sechiba+1, area, kjpindex, kindex)
	308	IF ( ok_stomate ) THEN
	309	CALL histwrite_p(hist_id_stom, 'Areas', itau_sechiba+1, area, kjpindex, kindex)
	310	CALL histwrite_p(hist_id_stom_IPCC, 'Areas', itau_sechiba+1, area, kjpindex, kindex)
	311	ENDIF
	312
	313	CALL histwrite_p(hist_id, 'Contfrac', itau_sechiba+1, contfrac, kjpindex, kindex)
	314	IF ( is_omp_root .AND. hist_id > 0 ) THEN
	315	! Always syncronize output after initialization
	316	CALL histsync(hist_id)
	317	END IF
	318
	319	CALL histwrite_p(hist2_id, 'LandPoints', itau_sechiba+1, (/ ( REAL(ik), ik=1,kjpindex ) /), kjpindex, kindex)
	320	CALL histwrite_p(hist2_id, 'Areas', itau_sechiba+1, area, kjpindex, kindex)
	321	CALL histwrite_p(hist2_id, 'Contfrac', itau_sechiba+1, contfrac, kjpindex, kindex)
	322	IF ( is_omp_root .AND. hist2_id > 0 ) THEN
	323	! Always syncronize output after initialization
	324	CALL histsync(hist2_id)
	325	ENDIF
	326
	327	!
	328	! 3. call sechiba for continental points only
	329	!
[4693]	330	IF (printlev_loc >= 3) WRITE(numout,*) 'Before call to sechiba_initialize'
[2605]	331
	332	CALL sechiba_initialize( &
[3998]	333	itau_sechiba, iim*jjm, kjpindex, kindex, &
[2605]	334	lalo, contfrac, neighbours, resolution, zzlev, &
[5573]	335	zu, zv, zqair, ztemp_air, &
[2605]	336	zpetAcoef, zpeqAcoef, zpetBcoef, zpeqBcoef, &
	337	zprecip_rain, zprecip_snow, zlwdown, zswnet, zswdown, &
	338	zpb, rest_id, hist_id, hist2_id, &
	339	rest_id_stom, hist_id_stom, hist_id_stom_IPCC, &
	340	zcoastal, zriver, ztsol_rad, zvevapp, zqsurf, &
[3524]	341	zz0m, zz0h, zalbedo, zfluxsens, zfluxlat, &
[6319]	342	zemis, ztemp_sol_new,zcdrag)
	343
[2605]	344
[4693]	345	IF (printlev_loc >= 3) WRITE(numout,*) 'After call to sechiba_initialize'
[2605]	346	!
	347	! 5. scatter output fields
	348	!
[3524]	349	z0m(:,:) = undef_sechiba
[2605]	350	coastalflow(:,:) = undef_sechiba
	351	riverflow(:,:) = undef_sechiba
	352	tsol_rad(:,:) = undef_sechiba
	353	vevapp(:,:) = undef_sechiba
	354	temp_sol_new(:,:) = undef_sechiba
	355	qsurf(:,:) = undef_sechiba
	356	albedo(:,:,:) = undef_sechiba
	357	fluxsens(:,:) = undef_sechiba
	358	fluxlat(:,:) = undef_sechiba
	359	emis(:,:) = undef_sechiba
	360	cdrag(:,:) = undef_sechiba
	361
	362	DO ik=1, kjpindex
	363	j = ((kindex(ik)-1)/iim) + 1
	364	i = (kindex(ik) - (j-1)*iim)
	365
[3524]	366	z0m(i,j) = zz0m(ik)
[2605]	367	coastalflow(i,j) = zcoastal(ik)
	368	riverflow(i,j) = zriver(ik)
	369	tsol_rad(i,j) = ztsol_rad(ik)
	370	vevapp(i,j) = zvevapp(ik)
	371	temp_sol_new(i,j) = ztemp_sol_new(ik)
	372	qsurf(i,j) = zqsurf(ik)
	373	albedo(i,j,1) = zalbedo(ik,1)
	374	albedo(i,j,2) = zalbedo(ik,2)
	375	fluxsens(i,j) = zfluxsens(ik)
	376	fluxlat(i,j) = zfluxlat(ik)
	377	emis(i,j) = zemis(ik)
	378	cdrag(i,j) = zcdrag(ik)
	379	ENDDO
[8]	380
[2605]	381	!
	382	! 6. Transform the water fluxes into Kg/m^2s and m^3/s
	383	!
	384	DO ik=1, kjpindex
	385
	386	j = ((kindex(ik)-1)/iim) + 1
	387	i = (kindex(ik) - (j-1)*iim)
[1933]	388
[2605]	389	vevapp(i,j) = vevapp(i,j)/xrdt
	390	coastalflow(i,j) = coastalflow(i,j)/xrdt
	391	riverflow(i,j) = riverflow(i,j)/xrdt
[1933]	392
[2605]	393	ENDDO
[1947]	394
[2605]	395	IF (is_root_prc) CALL getin_dump
[1788]	396
[3851]	397	lstep_init_intersurf = .FALSE.
[2605]	398	CALL ipslnlf_p(new_number=old_fileout)
[4693]	399	IF (printlev_loc >= 1) WRITE (numout,*) 'End intersurf_initialize_2d'
	400
[2605]	401	END SUBROUTINE intersurf_initialize_2d
[8]	402
	403
[2605]	404	!! =============================================================================================================================
	405	!! SUBROUTINE: intersurf_main_2d
	406	!!
	407	!>\BRIEF Main subroutine to call ORCHIDEE from dim2_driver using variables on a 2d grid.
	408	!!
	409	!! DESCRIPTION: This subroutine is the main interface for ORCHIDEE when it is called from the offline driver dim2_driver.
	410	!! The variables are all on the 2D grid including ocean points. intersurf_initialize_2d should be called before
	411	!! this subroutine is called. This subroutine is called at each time step.
	412	!!
	413	!! \n
	414	!_ ==============================================================================================================================
	415
	416	SUBROUTINE intersurf_main_2d (kjit, iim, jjm, kjpindex, kindex, xrdt, &
	417	lrestart_read, lrestart_write, lon, lat, zcontfrac, zresolution, date0, &
	418	zlev, u, v, qair, temp_air, epot_air, ccanopy, &
	419	cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
	420	precip_rain, precip_snow, lwdown, swnet, swdown, pb, &
	421	vevapp, fluxsens, fluxlat, coastalflow, riverflow, &
[3524]	422	tsol_rad, temp_sol_new, qsurf, albedo, emis, z0m, &
[2961]	423	coszang)
[2605]	424
	425	IMPLICIT NONE
	426
	427	!! 0. Variable and parameter declaration
	428	!! 0.1 Input variables
	429	INTEGER(i_std),INTENT (in) :: kjit !! Time step number
	430	INTEGER(i_std),INTENT (in) :: iim, jjm !! Dimension of input fields
	431	INTEGER(i_std),INTENT (in) :: kjpindex !! Number of continental points
	432	REAL(r_std),INTENT (in) :: xrdt !! Time step in seconds
	433	LOGICAL, INTENT (in) :: lrestart_read !! Logical for _restart_ file to read
	434	LOGICAL, INTENT (in) :: lrestart_write !! Logical for _restart_ file to write'
	435	REAL(r_std), INTENT (in) :: date0 !! Date at which kjit = 0
	436	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: kindex !! Index for continental points
	437	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: u !! Lowest level wind speed
	438	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: v !! Lowest level wind speed
	439	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: zlev !! Height of first layer
	440	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: qair !! Lowest level specific humidity
	441	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: precip_rain !! Rain precipitation
	442	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: precip_snow !! Snow precipitation
	443	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: lwdown !! Down-welling long-wave flux
	444	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: swnet !! Net surface short-wave flux
	445	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: swdown !! Downwelling surface short-wave flux
[2961]	446	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: coszang !! Cosine of the solar zenith angle (unitless)
[2605]	447	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: temp_air !! Air temperature in Kelvin
	448	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: epot_air !! Air potential energy
	449	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: ccanopy !! CO2 concentration in the canopy
	450	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: petAcoef !! Coeficients A from the PBL resolution
	451	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: peqAcoef !! One for T and another for q
	452	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: petBcoef !! Coeficients B from the PBL resolution
	453	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: peqBcoef !! One for T and another for q
	454	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: pb !! Surface pressure
	455	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: lon, lat !! Geographical coordinates
	456	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: zcontfrac !! Fraction of continent in the grid
	457	REAL(r_std),DIMENSION (iim,jjm,2), INTENT(in) :: zresolution !! resolution in x and y dimensions
	458
	459	!! 0.2 Output variables
[3524]	460	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: z0m !! Surface roughness for momemtum
[4434]	461	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: coastalflow !! Diffuse flow of water into the ocean (m^3/s)
	462	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: riverflow !! Largest rivers flowing into the ocean (m^3/s)
[2605]	463	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: tsol_rad !! Radiative surface temperature
	464	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: vevapp !! Total of evaporation
	465	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: temp_sol_new !! New soil temperature
	466	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: qsurf !! Surface specific humidity
	467	REAL(r_std),DIMENSION (iim,jjm,2), INTENT(out) :: albedo !! Albedo
	468	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: fluxsens !! Sensible chaleur flux
	469	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: fluxlat !! Latent chaleur flux
	470	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: emis !! Emissivity
	471
	472	!! 0.3 Modified variables
	473	REAL(r_std),DIMENSION (iim,jjm), INTENT(inout) :: cdrag !! Cdrag
	474
	475	!! 0.4 Local variables
	476	REAL(r_std),DIMENSION (kjpindex) :: zu !! Work array to keep u
	477	REAL(r_std),DIMENSION (kjpindex) :: zv !! Work array to keep v
	478	REAL(r_std),DIMENSION (kjpindex) :: zzlev !! Work array to keep zlev
	479	REAL(r_std),DIMENSION (kjpindex) :: zqair !! Work array to keep qair
	480	REAL(r_std),DIMENSION (kjpindex) :: zprecip_rain !! Work array to keep precip_rain
	481	REAL(r_std),DIMENSION (kjpindex) :: zprecip_snow !! Work array to keep precip_snow
	482	REAL(r_std),DIMENSION (kjpindex) :: zlwdown !! Work array to keep lwdown
	483	REAL(r_std),DIMENSION (kjpindex) :: zswnet !! Work array to keep swnet
	484	REAL(r_std),DIMENSION (kjpindex) :: zswdown !! Work array to keep swdown
[2961]	485	REAL(r_std),DIMENSION (kjpindex) :: zcoszang !! Work array to keep coszang
[2605]	486	REAL(r_std),DIMENSION (kjpindex) :: ztemp_air !! Work array to keep temp_air
	487	REAL(r_std),DIMENSION (kjpindex) :: zepot_air !! Work array to keep epot_air
	488	REAL(r_std),DIMENSION (kjpindex) :: zccanopy !! Work array to keep ccanopy
	489	REAL(r_std),DIMENSION (kjpindex) :: zpetAcoef !! Work array to keep petAcoef
	490	REAL(r_std),DIMENSION (kjpindex) :: zpeqAcoef !! Work array to keep peqAcoef
	491	REAL(r_std),DIMENSION (kjpindex) :: zpetBcoef !! Work array to keep petBcoef
	492	REAL(r_std),DIMENSION (kjpindex) :: zpeqBcoef !! Work array to keep peqVcoef
	493	REAL(r_std),DIMENSION (kjpindex) :: zcdrag !! Work array to keep cdrag
	494	REAL(r_std),DIMENSION (kjpindex) :: zpb !! Work array to keep pb
[3524]	495	REAL(r_std),DIMENSION (kjpindex) :: zz0m, zz0h !! Work array to keep zz0m, zz0h
[4465]	496	REAL(r_std),DIMENSION (kjpindex,nvm) :: zveget !! Work array to keep veget
	497	REAL(r_std),DIMENSION (kjpindex,nvm) :: zlai !! Work array to keep lai
	498	REAL(r_std),DIMENSION (kjpindex,nvm) :: zheight !! Work array to keep height
[4434]	499	REAL(r_std),DIMENSION (kjpindex) :: zcoastal !! Work array to keep coastalflow (m^3/dt)
	500	REAL(r_std),DIMENSION (kjpindex) :: zriver !! Work array to keep riverflow (m^3/dt)
[6319]	501	REAL(r_std),DIMENSION (kjpindex) :: znetco2 !! Work array to keep netco2flux (gC/m2/one_day)
[6160]	502	REAL(r_std),DIMENSION (kjpindex) :: zcarblu !! Work array to keep fco2_land_use (gC/m2/one_day)
[6319]	503	REAL(r_std),DIMENSION (kjpindex) :: zcarbwh !! Work array to keep fco2_wh (gC/m2/one_day)
	504	REAL(r_std),DIMENSION (kjpindex) :: zcarbha !! Work array to keep fco2_ha (gC/m2/one_day)
[2605]	505	REAL(r_std),DIMENSION (kjpindex) :: ztsol_rad !! Work array to keep tsol_rad
	506	REAL(r_std),DIMENSION (kjpindex) :: zvevapp !! Work array to keep vevapp
	507	REAL(r_std),DIMENSION (kjpindex) :: ztemp_sol_new !! Work array to keep temp_sol_new
	508	REAL(r_std),DIMENSION (kjpindex) :: zqsurf !! Work array to keep qsurf
	509	REAL(r_std),DIMENSION (kjpindex,2) :: zalbedo !! Work array to keep albedo
	510	REAL(r_std),DIMENSION (kjpindex) :: zfluxsens !! Work array to keep fluxsens
	511	REAL(r_std),DIMENSION (kjpindex) :: zfluxlat !! Work array to keep fluxlat
	512	REAL(r_std),DIMENSION (kjpindex) :: zemis !! Work array to keep emis
	513	INTEGER(i_std) :: i, j, ik
	514	INTEGER(i_std) :: ier
	515	INTEGER(i_std) :: itau_sechiba
	516	INTEGER :: old_fileout !! old Logical Int for std IO output
	517
[4693]	518	IF (printlev_loc >= 3) WRITE(numout,*) 'Start intersurf_main_2d'
[2605]	519	CALL ipslnlf_p(new_number=numout,old_number=old_fileout)
	520
[8]	521	!
	522	! Shift the time step to phase the two models
	523	!
	524	itau_sechiba = kjit + itau_offset
	525	!
[1788]	526
	527	! Update the calendar in xios by sending the new time step
[2605]	528	CALL xios_orchidee_update_calendar(itau_sechiba)
[4646]	529
	530	! Update the calendar and all time variables in module time
	531	CALL time_nextstep(itau_sechiba)
[8]	532	!
	533	! 1. gather input fields from kindex array
	534	! Warning : I'm not sure this interface with one dimension array is the good one
	535	!
	536	DO ik=1, kjpindex
	537
	538	j = ((kindex(ik)-1)/iim) + 1
	539	i = (kindex(ik) - (j-1)*iim)
	540
	541	zu(ik) = u(i,j)
	542	zv(ik) = v(i,j)
	543	zzlev(ik) = zlev(i,j)
	544	zqair(ik) = qair(i,j)
	545	zprecip_rain(ik) = precip_rain(i,j)*xrdt
	546	zprecip_snow(ik) = precip_snow(i,j)*xrdt
	547	zlwdown(ik) = lwdown(i,j)
	548	zswnet(ik) = swnet(i,j)
	549	zswdown(ik) = swdown(i,j)
[2961]	550	zcoszang(ik) = coszang(i,j)
[8]	551	ztemp_air(ik) = temp_air(i,j)
	552	zepot_air(ik) = epot_air(i,j)
	553	zccanopy(ik) = ccanopy(i,j)
	554	zpetAcoef(ik) = petAcoef(i,j)
	555	zpeqAcoef(ik) = peqAcoef(i,j)
	556	zpetBcoef(ik) = petBcoef(i,j)
	557	zpeqBcoef(ik) = peqBcoef(i,j)
	558	zcdrag(ik) = cdrag(i,j)
	559	zpb(ik) = pb(i,j)
	560
	561	ENDDO
[1389]	562
[8]	563	!
	564	! 3. call sechiba for continental points only
	565	!
[4693]	566	IF (printlev_loc >= 3) WRITE(numout,*) 'Before call to sechiba_main from intersurf_main_2d'
	567
[3998]	568	CALL sechiba_main (itau_sechiba, iim*jjm, kjpindex, kindex, &
[2605]	569	lrestart_read, lrestart_write, &
	570	lalo, contfrac, neighbours, resolution, &
[5573]	571	zzlev, zu, zv, zqair, ztemp_air, zepot_air, zccanopy, &
[2605]	572	zcdrag, zpetAcoef, zpeqAcoef, zpetBcoef, zpeqBcoef, &
[2961]	573	zprecip_rain ,zprecip_snow, zlwdown, zswnet, zswdown, zcoszang, zpb, &
[6319]	574	zvevapp, zfluxsens, zfluxlat, zcoastal, zriver, &
	575	znetco2, zcarblu, zcarbwh, zcarbha, &
[3524]	576	ztsol_rad, ztemp_sol_new, zqsurf, zalbedo, zemis, zz0m, zz0h,&
[4465]	577	zveget, zlai, zheight, &
[2605]	578	rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC )
[2595]	579
[4693]	580	IF (printlev_loc >= 3) WRITE(numout,*) 'After call to sechiba_main'
[8]	581
	582	!
	583	! 5. scatter output fields
	584	!
[3524]	585	z0m(:,:) = undef_sechiba
[8]	586	coastalflow(:,:) = undef_sechiba
	587	riverflow(:,:) = undef_sechiba
	588	tsol_rad(:,:) = undef_sechiba
	589	vevapp(:,:) = undef_sechiba
	590	temp_sol_new(:,:) = undef_sechiba
	591	qsurf(:,:) = undef_sechiba
	592	albedo(:,:,:) = undef_sechiba
	593	fluxsens(:,:) = undef_sechiba
	594	fluxlat(:,:) = undef_sechiba
	595	emis(:,:) = undef_sechiba
	596	cdrag(:,:) = undef_sechiba
	597	!
	598	DO ik=1, kjpindex
	599
	600
	601	j = ((kindex(ik)-1)/iim) + 1
	602	i = (kindex(ik) - (j-1)*iim)
	603
[3524]	604	z0m(i,j) = zz0m(ik)
[2183]	605	coastalflow(i,j) = zcoastal(ik)
	606	riverflow(i,j) = zriver(ik)
[8]	607	tsol_rad(i,j) = ztsol_rad(ik)
	608	vevapp(i,j) = zvevapp(ik)
	609	temp_sol_new(i,j) = ztemp_sol_new(ik)
	610	qsurf(i,j) = zqsurf(ik)
	611	albedo(i,j,1) = zalbedo(ik,1)
	612	albedo(i,j,2) = zalbedo(ik,2)
	613	fluxsens(i,j) = zfluxsens(ik)
	614	fluxlat(i,j) = zfluxlat(ik)
	615	emis(i,j) = zemis(ik)
	616	cdrag(i,j) = zcdrag(ik)
	617
	618	ENDDO
[1788]	619
[2605]	620	CALL xios_orchidee_send_field("LandPoints" ,(/ ( REAL(ik), ik=1,kjpindex ) /))
[3642]	621	CALL xios_orchidee_send_field("areas", area)
	622	CALL xios_orchidee_send_field("contfrac",contfrac)
	623	CALL xios_orchidee_send_field("temp_air",ztemp_air)
[2605]	624	CALL xios_orchidee_send_field("qair",zqair)
	625	CALL xios_orchidee_send_field("swnet",zswnet)
	626	CALL xios_orchidee_send_field("swdown",zswdown)
[3642]	627	CALL xios_orchidee_send_field("pb",zpb)
[6319]	628	CALL xios_orchidee_send_field("znetco2",znetco2/1.e3/one_day) ! gC/m2/one_day -> kgC/m2/s
	629	CALL xios_orchidee_send_field("zcarblu",zcarblu/1.e3/one_day) ! gC/m2/one_day -> kgC/m2/s
	630	CALL xios_orchidee_send_field("zcarbwh",zcarbwh/1.e3/one_day) ! gC/m2/one_day -> kgC/m2/s
	631	CALL xios_orchidee_send_field("zcarbha",zcarbha/1.e3/one_day) ! gC/m2/one_day -> kgC/m2/s
[6160]	632
[2605]	633
	634	IF ( .NOT. almaoutput ) THEN
[8]	635	!
	636	! scattered during the writing
[1788]	637	!
[2605]	638	CALL histwrite_p (hist_id, 'evap', itau_sechiba, zvevapp, kjpindex, kindex)
	639	CALL histwrite_p (hist_id, 'coastalflow',itau_sechiba, zcoastal, kjpindex, kindex)
	640	CALL histwrite_p (hist_id, 'riverflow',itau_sechiba, zriver, kjpindex, kindex)
	641	CALL histwrite_p (hist_id, 'temp_sol', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
	642	CALL histwrite_p (hist_id, 'tsol_max', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
	643	CALL histwrite_p (hist_id, 'tsol_min', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
	644	CALL histwrite_p (hist_id, 'fluxsens', itau_sechiba, zfluxsens, kjpindex, kindex)
	645	CALL histwrite_p (hist_id, 'fluxlat', itau_sechiba, zfluxlat, kjpindex, kindex)
	646	CALL histwrite_p (hist_id, 'swnet', itau_sechiba, zswnet, kjpindex, kindex)
	647	CALL histwrite_p (hist_id, 'swdown', itau_sechiba, zswdown, kjpindex, kindex)
	648	CALL histwrite_p (hist_id, 'alb_vis', itau_sechiba, zalbedo(:,1), kjpindex, kindex)
	649	CALL histwrite_p (hist_id, 'alb_nir', itau_sechiba, zalbedo(:,2), kjpindex, kindex)
	650	CALL histwrite_p (hist_id, 'tair', itau_sechiba, ztemp_air, kjpindex, kindex)
	651	CALL histwrite_p (hist_id, 'qair', itau_sechiba, zqair, kjpindex, kindex)
	652	CALL histwrite_p (hist2_id, 'evap', itau_sechiba, zvevapp, kjpindex, kindex)
	653	CALL histwrite_p (hist2_id, 'coastalflow',itau_sechiba, zcoastal, kjpindex, kindex)
	654	CALL histwrite_p (hist2_id, 'riverflow',itau_sechiba, zriver, kjpindex, kindex)
	655	CALL histwrite_p (hist2_id, 'temp_sol', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
	656	CALL histwrite_p (hist2_id, 'tsol_max', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
	657	CALL histwrite_p (hist2_id, 'tsol_min', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
	658	CALL histwrite_p (hist2_id, 'fluxsens', itau_sechiba, zfluxsens, kjpindex, kindex)
	659	CALL histwrite_p (hist2_id, 'fluxlat', itau_sechiba, zfluxlat, kjpindex, kindex)
	660	CALL histwrite_p (hist2_id, 'swnet', itau_sechiba, zswnet, kjpindex, kindex)
	661	CALL histwrite_p (hist2_id, 'swdown', itau_sechiba, zswdown, kjpindex, kindex)
	662	CALL histwrite_p (hist2_id, 'alb_vis', itau_sechiba, zalbedo(:,1), kjpindex, kindex)
	663	CALL histwrite_p (hist2_id, 'alb_nir', itau_sechiba, zalbedo(:,2), kjpindex, kindex)
	664	CALL histwrite_p (hist2_id, 'tair', itau_sechiba, ztemp_air, kjpindex, kindex)
	665	CALL histwrite_p (hist2_id, 'qair', itau_sechiba, zqair, kjpindex, kindex)
	666	ELSE
	667	CALL histwrite_p (hist_id, 'Evap', itau_sechiba, zvevapp, kjpindex, kindex)
	668	CALL histwrite_p (hist_id, 'SWnet', itau_sechiba, zswnet, kjpindex, kindex)
	669	CALL histwrite_p (hist_id, 'Qh', itau_sechiba, zfluxsens, kjpindex, kindex)
	670	CALL histwrite_p (hist_id, 'Qle', itau_sechiba, zfluxlat, kjpindex, kindex)
	671	CALL histwrite_p (hist_id, 'AvgSurfT', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
	672	CALL histwrite_p (hist_id, 'RadT', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
	673	CALL histwrite_p (hist_id, 'Tair', itau_sechiba, ztemp_air, kjpindex, kindex)
	674	CALL histwrite_p (hist_id, 'Qair', itau_sechiba, zqair, kjpindex, kindex)
	675	CALL histwrite_p (hist2_id, 'Evap', itau_sechiba, zvevapp, kjpindex, kindex)
	676	CALL histwrite_p (hist2_id, 'SWnet', itau_sechiba, zswnet, kjpindex, kindex)
	677	CALL histwrite_p (hist2_id, 'Qh', itau_sechiba, zfluxsens, kjpindex, kindex)
	678	CALL histwrite_p (hist2_id, 'Qle', itau_sechiba, zfluxlat, kjpindex, kindex)
	679	CALL histwrite_p (hist2_id, 'AvgSurfT', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
	680	CALL histwrite_p (hist2_id, 'RadT', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
	681	ENDIF
	682	!
	683	IF ( is_omp_root ) THEN
	684	IF ( (dw .EQ. xrdt) .AND. hist_id > 0 ) THEN
	685	! Syncronize output but only if flag ok_histsync is set to true
	686	IF (ok_histsync) CALL histsync(hist_id)
[8]	687	ENDIF
[2605]	688	END IF
	689
[8]	690	!
	691	! 6. Transform the water fluxes into Kg/m^2s and m^3/s
	692	!
	693	DO ik=1, kjpindex
[2605]	694
[8]	695	j = ((kindex(ik)-1)/iim) + 1
	696	i = (kindex(ik) - (j-1)*iim)
[2605]	697
[8]	698	vevapp(i,j) = vevapp(i,j)/xrdt
	699	coastalflow(i,j) = coastalflow(i,j)/xrdt
	700	riverflow(i,j) = riverflow(i,j)/xrdt
[2605]	701
[8]	702	ENDDO
[2605]	703
[2424]	704	CALL ipslnlf_p(new_number=old_fileout)
[4693]	705	IF (printlev_loc >= 3) WRITE (numout,*) 'End intersurf_main_2d'
[2605]	706
[8]	707	END SUBROUTINE intersurf_main_2d
[2595]	708
[2605]	709
	710	!! =============================================================================================================================
	711	!! SUBROUTINE: init_intersurf
	712	!!
	713	!>\BRIEF Initialize grid information
	714	!!
	715	!! DESCRIPTION: This subroutine is called from LMDZ before first call to intersurf_main_gathered or
	716	!! intersurf_initialize_gathered
	717	!!
	718	!! \n
	719	!_ ==============================================================================================================================
[1907]	720
[5386]	721	SUBROUTINE init_intersurf(nbp_l_lon,nbp_l_lat,kjpindex,kindex,orch_offset,orch_omp_size,orch_omp_rank,COMM, grid)
[2605]	722
[1078]	723	USE mod_orchidee_para
	724	USE timer
	725	IMPLICIT NONE
[8]	726
[1078]	727	INTEGER,INTENT(IN) :: nbp_l_lon
	728	INTEGER,INTENT(IN) :: nbp_l_lat
	729	INTEGER,INTENT(IN) :: kjpindex
	730	INTEGER,INTENT(IN) :: kindex(:)
	731	INTEGER,INTENT(IN) :: orch_offset
	732	INTEGER,INTENT(IN) :: COMM
	733	INTEGER,INTENT(IN) :: orch_omp_size
	734	INTEGER,INTENT(IN) :: orch_omp_rank
[5386]	735	INTEGER(i_std), INTENT(in), OPTIONAL :: grid !! grid type : regular_lonlat or unstructured (dynamico)
[8]	736
[1078]	737	INTEGER,DIMENSION(kjpindex) :: kindex_offset
[8]	738
[4693]	739	IF (printlev >= 1) WRITE(,) 'Start ORCHIDEE'
	740
[1078]	741	IF (orch_omp_rank==0) THEN
	742	CALL Init_timer
	743	CALL start_timer(timer_mpi)
[3447]	744	CALL grid_set_glo(nbp_l_lon,nbp_l_lat)
[8]	745	ENDIF
[1615]	746	CALL barrier2_omp()
[1078]	747	CALL init_orchidee_data_para(kjpindex,kindex,orch_offset,orch_omp_size,orch_omp_rank,COMM)
	748	CALL Set_stdout_file('out_orchidee')
[4693]	749
	750	IF (printlev >= 1) WRITE(numout,*) 'Start ORCHIDEE intitalization phase'
[8]	751
[6289]	752	IF (PRESENT(grid)) THEN
	753	IF (grid==unstructured) THEN
	754	CALL grid_allocate_glo(6)
[5386]	755	ELSE
	756	CALL grid_allocate_glo(4)
	757	END IF
[6289]	758	ELSE
	759	CALL grid_allocate_glo(4)
	760	END IF
[5386]	761
[1615]	762	CALL barrier2_omp()
[1078]	763	CALL init_ioipsl_para
	764
	765	kindex_offset(:)=kindex(:)+offset
	766	CALL gather(kindex_offset,index_g)
	767	CALL bcast(index_g)
[8]	768
[6289]	769	IF (printlev >= 2) THEN
[4693]	770	WRITE(numout,*) "kjpindex = ",kjpindex
	771	WRITE(numout,*) "offset for OMP = ",offset_omp
	772	WRITE(numout,*) "Index num local for continental points = ",kindex
	773	WRITE(numout,*) "Index num global for continental points = ",kindex_offset
	774	IF (is_omp_root) THEN
	775	WRITE(numout,*) "ROOT OMP, Index global MPI : ",kindex_mpi(:)
	776	ENDIF
	777	IF (is_root_prc) THEN
	778	WRITE(numout,*) "ROOT global, Index global : ",index_g(:)
	779	ENDIF
[6289]	780	WRITE(numout,*) "NbNeighb = ", NbNeighb
[4693]	781	END IF
[3678]	782
[4693]	783
[2605]	784	END SUBROUTINE init_intersurf
[2595]	785
[2605]	786	!! =============================================================================================================================
	787	!! SUBROUTINE: intersurf_initialize_gathered
	788	!!
	789	!>\BRIEF Initialization and call to sechiba_initialize
	790	!!
	791	!! DESCRIPTION: Initialization of module variables, read options from parameter file, initialize output files and call to
	792	!! sechiba_initialize.
	793	!!
	794	!! This subroutine can be called directly from GCM(LMDZ). If it is not called before the first call to
	795	!! intersurf_main_gathered, then it will be done from there. This possibility is done to keep backward
	796	!! compatibility with LMDZ.
	797	!!
	798	!! \n
	799	!_ ==============================================================================================================================
	800
	801	SUBROUTINE intersurf_initialize_gathered (kjit, iim_glo, jjm_glo, kjpindex, kindex, xrdt, &
	802	lrestart_read, lrestart_write, latlon, zcontfrac, zneighbours, zresolution, date0, &
	803	zlev, u, v, qair, temp_air, epot_air, &
	804	cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
	805	precip_rain, precip_snow, lwdown, swnet, swdown, pb, &
[4435]	806	vevapp, fluxsens, fluxlat, coastalflow_cpl, riverflow_cpl, &
[4465]	807	tsol_rad, temp_sol_new, qsurf, albedo, emis, z0m, lon_scat_g, lat_scat_g, &
	808	q2m, t2m, z0h, nvm_out, &
[5389]	809	field_out_names, field_in_names, &
[5364]	810	grid, bounds_latlon, cell_area, ind_cell_glo)
[2605]	811
[1078]	812	USE mod_orchidee_para
[8]	813	IMPLICIT NONE
[1078]	814
[2605]	815	!! 0. Variable and parameter declaration
	816	!! 0.1 Input
	817	INTEGER(i_std),INTENT (in) :: kjit !! Time step number
	818	INTEGER(i_std),INTENT (in) :: iim_glo !! Dimension of global fields
	819	INTEGER(i_std),INTENT (in) :: jjm_glo !! Dimension of global fields
	820	INTEGER(i_std),INTENT (in) :: kjpindex !! Number of continental points
	821	REAL(r_std),INTENT (in) :: xrdt !! Time step in seconds
	822	LOGICAL, INTENT (in) :: lrestart_read !! Logical for _restart_ file to read
	823	LOGICAL, INTENT (in) :: lrestart_write !! Logical for _restart_ file to write'
	824	REAL(r_std), INTENT (in) :: date0 !! Date at which kjit = 0
	825	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: kindex !! Index for continental points
	826	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: u !! Lowest level wind speed
	827	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: v !! Lowest level wind speed
	828	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: zlev !! Height of first layer
	829	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: qair !! Lowest level specific humidity
	830	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: precip_rain !! Rain precipitation
	831	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: precip_snow !! Snow precipitation
	832	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: lwdown !! Down-welling long-wave flux
	833	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: swnet !! Net surface short-wave flux
	834	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: swdown !! Downwelling surface short-wave flux
	835	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: temp_air !! Air temperature in Kelvin
	836	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: epot_air !! Air potential energy
	837	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: petAcoef !! Coeficients A from the PBL resolution
	838	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: peqAcoef !! One for T and another for q
	839	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: petBcoef !! Coeficients B from the PBL resolution
	840	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: peqBcoef !! One for T and another for q
	841	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: pb !! Surface pressure
[5575]	842	REAL(r_std),DIMENSION (:,:), INTENT(in) :: latlon !! Geographical coordinates, this variable has different dimension when using grid unstructured
[2605]	843	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: zcontfrac !! Fraction of continent
[3447]	844	INTEGER(i_std),DIMENSION (kjpindex,NbNeighb), INTENT(in):: zneighbours !! neighbours
[2605]	845	REAL(r_std),DIMENSION (kjpindex,2), INTENT(in) :: zresolution !! size of the grid box
[5389]	846	REAL(r_std),DIMENSION (iim_glo,jjm_glo), INTENT(IN) :: lon_scat_g !! Longitudes on the global 2D grid including ocean
	847	REAL(r_std),DIMENSION (iim_glo,jjm_glo), INTENT(IN) :: lat_scat_g !! Latitudes on the global 2D grid including ocean
[1078]	848
[2605]	849	!! 0.2 Output variables
[4435]	850	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: z0m !! Surface roughness (momentum)
	851	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: coastalflow_cpl!! Diffuse flow of water into the ocean (m^3/s)
	852	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: riverflow_cpl !! Largest rivers flowing into the ocean (m^3/s)
[2605]	853	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: tsol_rad !! Radiative surface temperature
	854	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: vevapp !! Total of evaporation
	855	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: temp_sol_new !! New soil temperature
	856	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: qsurf !! Surface specific humidity
	857	REAL(r_std),DIMENSION (kjpindex,2), INTENT(out) :: albedo !! Albedo
	858	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: fluxsens !! Sensible chaleur flux
	859	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: fluxlat !! Latent chaleur flux
	860	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: emis !! Emissivity
[897]	861
[2605]	862	!! 0.3 Modified variables
	863	REAL(r_std),DIMENSION (kjpindex), INTENT(inout) :: cdrag !! Cdrag
[897]	864
[2605]	865	!! 0.4 Optional input and output variables
[5573]	866	REAL(r_std),DIMENSION (kjpindex), INTENT(in), OPTIONAL :: q2m !! Surface specific humidity, obsolete: this variable is not used any more, kept only for retrocomp with LMDZ
	867	REAL(r_std),DIMENSION (kjpindex), INTENT(in), OPTIONAL :: t2m !! Surface air temperature, obsolete: this variable is not used any more, kept only for retrocomp with LMDZ
[4465]	868	REAL(r_std),DIMENSION (kjpindex), INTENT(out),OPTIONAL :: z0h !! Surface roughness (heat)
	869	INTEGER(i_std), INTENT(out), OPTIONAL :: nvm_out !! Number of vegetation types, PFTs
[5389]	870	CHARACTER(LEN=*),DIMENSION(:), OPTIONAL, INTENT(IN) :: field_out_names!! Name of optional fields sent to LMDZ (fields_out), for ESM configuration
	871	CHARACTER(LEN=*),DIMENSION(:), OPTIONAL, INTENT(IN) :: field_in_names !! Name of optional fields received from LMDZ (fields_in), for ESM configuration
[5364]	872	INTEGER(i_std) , INTENT(in), OPTIONAL :: grid !! grid type : regular_lonlat or unstructured (dynamico)
	873	REAL(r_std),DIMENSION (:,:,:) , INTENT(in), OPTIONAL :: bounds_latlon !! boundaries Geographical coordinates
	874	REAL(r_std),DIMENSION (kjpindex), INTENT(in), OPTIONAL :: cell_area !! cell area
	875	INTEGER(i_std),DIMENSION (:) , INTENT(in), OPTIONAL :: ind_cell_glo !! cell order (for XIOS)
[2605]	876
[5364]	877
[2605]	878	!! 0.5 Local variables
[8]	879	REAL(r_std),DIMENSION (kjpindex) :: zprecip_rain !! Work array to keep precip_rain
	880	REAL(r_std),DIMENSION (kjpindex) :: zprecip_snow !! Work array to keep precip_snow
[3524]	881	REAL(r_std),DIMENSION (kjpindex) :: zz0m !! Work array to keep zz0m
	882	REAL(r_std),DIMENSION (kjpindex) :: zz0h !! Work array to keep zz0h
[8]	883	REAL(r_std),DIMENSION (kjpindex) :: zcdrag !! Work array for surface drag
	884	REAL(r_std),DIMENSION (kjpindex) :: zcoastal !! Work array to keep coastal flow
	885	REAL(r_std),DIMENSION (kjpindex) :: zriver !! Work array to keep river out flow
	886	REAL(r_std),DIMENSION (kjpindex) :: ztsol_rad !! Work array to keep tsol_rad
	887	REAL(r_std),DIMENSION (kjpindex) :: zvevapp !! Work array to keep vevapp
	888	REAL(r_std),DIMENSION (kjpindex) :: ztemp_sol_new !! Work array to keep temp_sol_new
	889	REAL(r_std),DIMENSION (kjpindex) :: zqsurf !! Work array to keep qsurf
	890	REAL(r_std),DIMENSION (kjpindex,2) :: zalbedo !! Work array to keep albedo
	891	REAL(r_std),DIMENSION (kjpindex) :: zfluxsens !! Work array to keep fluxsens
	892	REAL(r_std),DIMENSION (kjpindex) :: zfluxlat !! Work array to keep fluxlat
	893	REAL(r_std),DIMENSION (kjpindex) :: zemis !! Work array to keep emis
	894	INTEGER(i_std) :: i, j, ik
[2001]	895	INTEGER(i_std) :: ier
[8]	896	INTEGER(i_std) :: itau_sechiba
[5364]	897	INTEGER(i_std) :: grid_loc !! Local variable for grid type
[5352]	898	REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: tmp_lon !! Longitudes for local MPI process. Only available on master OMP.
	899	REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: tmp_lat !! Latitudes for local MPI process. Only available on master OMP.
[8]	900	INTEGER :: old_fileout !! old Logical Int for std IO output
[2605]	901	REAL,ALLOCATABLE,DIMENSION(:,:) :: lalo_mpi
	902	REAL(r_std),DIMENSION (kjpindex) :: landpoints !! Land point vector
[4435]	903	REAL(r_std) :: tau_outflow !! Number of days for temoral filter on river- and coastalflow
[5389]	904
	905
[4693]	906	! Initialize specific write level
	907	printlev_loc=get_printlev('instersurf')
[3678]	908
[4693]	909	IF (printlev_loc >= 1) WRITE(numout,*) 'Entering intersurf_initialize_gathered'
	910	IF (printlev_loc >= 2) WRITE(numout,*) 'using printlev_loc for intersurf:', printlev_loc
	911
[3642]	912	OFF_LINE_MODE = .FALSE.
[2605]	913	CALL ipslnlf_p(new_number=numout, old_number=old_fileout)
[4689]	914
	915	! Initialize variables in module time
	916	CALL time_initialize( kjit, date0, xrdt, "END" )
	917
[2631]	918	! Configuration of SSL specific parameters
[4646]	919	CALL control_initialize
[1078]	920
[5364]	921
	922	! Check if variable grid is in the argument list
	923	IF (PRESENT(grid)) THEN
	924	grid_loc=grid
	925	ELSE
	926	grid_loc=regular_lonlat
	927	END IF
	928	IF (printlev >= 2) WRITE(numout,*) 'intersurf_initialize_gathered: grid=', grid_loc
	929
	930	IF (grid_loc==unstructured) THEN
	931	! First check if all variables needed are present in the call from LMDZ
	932	IF (.NOT. PRESENT(bounds_latlon)) CALL ipslerr_p(3,'intersurf_initialize_gathered', &
	933	'Error in call intersurf_initialize_gathered from LMDZ','bounds_latlon was not present','')
	934
	935	IF (.NOT. PRESENT(cell_area)) CALL ipslerr_p(3,'intersurf_initialize_gathered', &
	936	'Error in call intersurf_initialize_gathered from LMDZ','cell_area was not present','')
	937
	938	IF (.NOT. PRESENT(ind_cell_glo)) CALL ipslerr_p(3,'intersurf_initialize_gathered', &
	939	'Error in call intersurf_initialize_gathered from LMDZ','ind_cell_glo was not present','')
	940
	941	! Allocation of grid variables for unstructured grid
	942	IF (printlev_loc >= 3) WRITE(numout,*) 'intersurf_initialize_gathered: call grid_init_unstructured for unstructured grid'
	943	CALL grid_init_unstructured(kjpindex, ij_omp_nb, latlon(:,2), latlon(:,1), &
	944	bounds_latlon(:,:,2), bounds_latlon(:,:,1), cell_area, ind_cell_glo)
	945	ELSE
	946	! Allocation of grid variables for rectilinear lon_lat grid
	947	IF (printlev_loc >= 3) WRITE(numout,*) 'intersurf_initialize_gathered: call grid_init for rectilinear lon_lat grid'
[5559]	948	CALL grid_init ( kjpindex, 4, regular_lonlat, "2DGrid" )
[5364]	949	ENDIF
	950
[5389]	951
[5364]	952	!
[2605]	953	! Create the internal coordinate table
	954	!
	955	lalo(:,:) = latlon(:,:)
	956	CALL gather(lalo,lalo_g)
	957	!
	958	!-
	959	!- Store variable to help describe the grid
	960	!- once the points are gathered.
	961	!-
	962	neighbours(:,:) = zneighbours(:,:)
	963	CALL gather(neighbours,neighbours_g)
	964	!
	965	resolution(:,:) = zresolution(:,:)
	966	CALL gather(resolution,resolution_g)
	967	!
[5364]	968	IF (grid_type==regular_lonlat) area(:) = resolution(:,1)*resolution(:,2)
[2605]	969	CALL gather(area,area_g)
	970	!
	971	!- Store the fraction of the continents only once so that the user
	972	!- does not change them afterwards.
	973	!
	974	contfrac(:) = zcontfrac(:)
	975	CALL gather(contfrac,contfrac_g)
	976	!
	977	!
	978	! Create the internal coordinate table
	979	!
	980	IF ( (.NOT.ALLOCATED(tmp_lon))) THEN
	981	ALLOCATE(tmp_lon(iim_g,jj_nb))
	982	ENDIF
	983	IF ( (.NOT.ALLOCATED(tmp_lat))) THEN
	984	ALLOCATE(tmp_lat(iim_g,jj_nb))
	985	ENDIF
[5352]	986
	987
[2605]	988	IF (is_omp_root) THEN
[5389]	989	! Extract from global variables the longitudes and latitudes
[5352]	990	! for the local MPI process using the indices for the latitude bands(jj_begin, jj_end).
	991	tmp_lon(:,:)=lon_scat_g(:,jj_begin:jj_end)
	992	tmp_lat(:,:)=lat_scat_g(:,jj_begin:jj_end)
[5389]	993
[5352]	994	! Save the global variables only on mpi root, to be used in other modules
[2605]	995	IF (is_mpi_root) THEN
	996	lon_g(:,:) = lon_scat_g(:,:)
	997	lat_g(:,:) = lat_scat_g(:,:)
	998	ENDIF
	999	ENDIF
	1000
	1001	!Config Key = FORCE_CO2_VEG
	1002	!Config Desc = Flag to force the value of atmospheric CO2 for vegetation.
	1003	!Config If = Only in coupled mode
	1004	!Config Def = FALSE
	1005	!Config Help = If this flag is set to true, the ATM_CO2 parameter is used
	1006	!Config to prescribe the atmospheric CO2.
	1007	!Config This Flag is only use in couple mode.
	1008	!Config Units = [FLAG]
	1009	fatmco2=.FALSE.
	1010	CALL getin_p('FORCE_CO2_VEG',fatmco2)
	1011	!
	1012	! Next flag is only use in couple mode with a gcm in intersurf.
	1013	! In forced mode, it has already been read and set in driver.
	1014	IF ( fatmco2 ) THEN
	1015	atmco2=350.
	1016	CALL getin_p('ATM_CO2',atmco2)
	1017	WRITE(numout,*) 'atmco2 ',atmco2
	1018	ENDIF
	1019
	1020	CALL ioipslctrl_restini(kjit, date0, xrdt, rest_id, rest_id_stom, itau_offset, date0_shifted)
	1021	itau_sechiba = kjit + itau_offset
	1022
	1023	!!- Initialize module for output with XIOS
	1024	!
[4565]	1025	CALL xios_orchidee_init( MPI_COMM_ORCH, &
[4646]	1026	date0, year_end, month_end, day_end, julian_diff, &
[5454]	1027	tmp_lon, tmp_lat, znt )
[5364]	1028
	1029	IF (printlev >= 3) WRITE(numout,*) 'intersurf_initialize_gathered: After xios_orchidee_init'
	1030	CALL sechiba_xios_initialize
	1031	IF (printlev >= 3) WRITE(numout,*) 'intersurf_initialize_gathered: After sechiba_xios_initialize'
	1032
	1033	CALL xios_orchidee_close_definition
	1034	IF (printlev >= 2) WRITE(numout,*) 'intersurf_initialize_gathered: After xios_orchidee_close_definition'
	1035
[2605]	1036	!- Initialize IOIPSL sechiba output files
	1037	CALL ioipslctrl_history(iim_g, jj_nb, tmp_lon, tmp_lat, kindex, kjpindex, itau_sechiba, &
	1038	date0_shifted, xrdt, hist_id, hist2_id, hist_id_stom, hist_id_stom_IPCC)
	1039
	1040	CALL bcast_omp(hist_id)
	1041	CALL bcast_omp(hist2_id)
	1042	CALL bcast_omp(hist_id_stom)
	1043	CALL bcast_omp(hist_id_stom_IPCC)
[2293]	1044
[2605]	1045	!
	1046	!! Change to be in the orchidee context for XIOS
	1047	!
	1048	CALL xios_orchidee_change_context("orchidee")
[5389]	1049
[2605]	1050	!
	1051	! Shift the time step to phase the two models
	1052	!
	1053	itau_sechiba = kjit + itau_offset
	1054
	1055	! Update the calendar in xios by sending the new time step
	1056	! Special case : the model is only in initialization phase and the current itau_sechiba is not a real time step.
	1057	! Therefor give itau_sechiba+1 to xios to have a correct time axis in output files.
	1058	CALL xios_orchidee_update_calendar(itau_sechiba+1)
	1059
	1060	!
	1061	! 1. Just change the units of some input fields
	1062	!
	1063	DO ik=1, kjpindex
	1064
	1065	zprecip_rain(ik) = precip_rain(ik)*xrdt
	1066	zprecip_snow(ik) = precip_snow(ik)*xrdt
	1067	zcdrag(ik) = cdrag(ik)
	1068	ENDDO
[1692]	1069
[5389]	1070
[2605]	1071	!
	1072	! 3. save the grid
	1073	!
	1074	landpoints(:)=(/ ( REAL(ik), ik=1,kjpindex ) /)
	1075	CALL histwrite_p(hist_id, 'LandPoints', itau_sechiba+1, landpoints, kjpindex, kindex)
	1076	CALL histwrite_p(hist_id, 'Areas', itau_sechiba+1, area, kjpindex, kindex)
	1077	IF ( ok_stomate ) THEN
	1078	CALL histwrite_p(hist_id_stom, 'Areas', itau_sechiba+1, area, kjpindex, kindex)
	1079	IF ( hist_id_stom_ipcc > 0 ) &
	1080	CALL histwrite_p(hist_id_stom_IPCC, 'Areas', itau_sechiba+1, area, kjpindex, kindex)
	1081	ENDIF
	1082	CALL histwrite_p(hist_id, 'Contfrac', itau_sechiba+1, contfrac, kjpindex, kindex)
	1083
	1084	! Syncronize output but only if flag ok_histsync is set to true
	1085	IF (ok_histsync) THEN
	1086	IF (is_omp_root .AND. hist_id > 0) THEN
	1087	CALL histsync(hist_id)
	1088	END IF
	1089	END IF
	1090
	1091	IF ( hist2_id > 0 ) THEN
	1092	CALL histwrite_p(hist2_id, 'LandPoints', itau_sechiba+1, landpoints, kjpindex, kindex)
	1093	CALL histwrite_p(hist2_id, 'Areas', itau_sechiba+1, area, kjpindex, kindex)
	1094	CALL histwrite_p(hist2_id, 'Contfrac', itau_sechiba+1, contfrac, kjpindex, kindex)
	1095
	1096	! Syncronize output but only if flag ok_histsync is set to true
	1097	IF (ok_histsync .AND. is_omp_root) THEN
	1098	CALL histsync(hist2_id)
[1078]	1099	ENDIF
[2605]	1100	ENDIF
	1101	!
	1102
	1103	!
	1104	! 4. call sechiba for continental points only
	1105	!
[4693]	1106	IF ( printlev_loc>=3 ) WRITE(numout,*) 'Before call to sechiba_initialize'
[1078]	1107
[2605]	1108	CALL sechiba_initialize( &
[3998]	1109	itau_sechiba, iim_g*jj_nb, kjpindex, kindex, &
[2605]	1110	lalo, contfrac, neighbours, resolution, zlev, &
[5573]	1111	u, v, qair, temp_air, &
[2605]	1112	petAcoef, peqAcoef, petBcoef, peqBcoef, &
	1113	zprecip_rain, zprecip_snow, lwdown, swnet, swdown, &
	1114	pb, rest_id, hist_id, hist2_id, &
	1115	rest_id_stom, hist_id_stom, hist_id_stom_IPCC, &
	1116	zcoastal, zriver, ztsol_rad, zvevapp, zqsurf, &
[3524]	1117	zz0m, zz0h, zalbedo, zfluxsens, zfluxlat, zemis, &
[6319]	1118	ztemp_sol_new, zcdrag)
	1119
[2605]	1120
[4693]	1121	IF ( printlev_loc>=3 ) WRITE(numout,*) 'After call to sechiba_initialize'
[1078]	1122
[2605]	1123	!
	1124	! 6. scatter output fields
	1125	!
	1126	DO ik=1, kjpindex
[3524]	1127	z0m(ik) = zz0m(ik)
[2605]	1128	tsol_rad(ik) = ztsol_rad(ik)
[4435]	1129	vevapp(ik) = zvevapp(ik)/xrdt ! Transform into kg/m^2/s
[2605]	1130	temp_sol_new(ik) = ztemp_sol_new(ik)
	1131	qsurf(ik) = zqsurf(ik)
	1132	albedo(ik,1) = zalbedo(ik,1)
	1133	albedo(ik,2) = zalbedo(ik,2)
	1134	fluxsens(ik) = zfluxsens(ik)
	1135	fluxlat(ik) = zfluxlat(ik)
	1136	emis(ik) = zemis(ik)
	1137	cdrag(ik) = zcdrag(ik)
	1138	ENDDO
[5389]	1139
[3524]	1140	! z0h is a optional output variable. Check first if it is present in the call from LMDZ.
	1141	IF ( PRESENT(z0h) ) z0h(:) = zz0h(:)
[8]	1142
[3524]	1143
[5389]	1144	!
	1145	! 7. Count optional fields for the coupling with LMDZ, used in the ESM configuration
	1146	!
	1147	! Treat fields sent to LMDZ
	1148	IF (PRESENT(field_out_names)) THEN
	1149	nbcf_from_LMDZ=SIZE(field_out_names)
	1150	ALLOCATE(field_out_names_loc(nbcf_from_LMDZ), stat=ier)
	1151	IF (ier /= 0) CALL ipslerr_p(3,'intersurf_initialized_gathered', 'Error in allocation of field_out_names_loc','','')
	1152	field_out_names_loc=field_out_names
	1153	ELSE
	1154	nbcf_from_LMDZ=0
	1155	ENDIF
	1156
	1157	! Treat fields received from LMDZ
	1158	IF (PRESENT(field_in_names)) THEN
	1159	nbcf_into_LMDZ=SIZE(field_in_names)
	1160	ALLOCATE(field_in_names_loc(nbcf_into_LMDZ), stat=ier)
	1161	IF (ier /= 0) CALL ipslerr_p(3,'intersurf_initialized_gathered', 'Error in allocation of field_in_names_loc','','')
	1162	field_in_names_loc=field_in_names
	1163
	1164	! Coherence test: veget_update>0 needed for fCO2_fLuc and fCO2_nbp
	1165	DO i = 1, nbcf_into_LMDZ
	1166	IF ((field_in_names_loc(i) == 'fCO2_fLuc') .OR. (field_in_names_loc(i) == 'fCO2_nbp')) THEN
	1167	IF (veget_update .LE. 0) THEN
[5390]	1168	CALL ipslerr_p(3,'intersurf_initialize_gathered', &
	1169	'Error in set up. VEGET_UPDATE must be > 0 when using the field: '//TRIM(field_in_names_loc(i)),'','')
[5389]	1170	END IF
	1171	END IF
	1172	END DO
	1173	ELSE
	1174	nbcf_into_LMDZ=0
	1175	ENDIF
	1176	IF ( printlev_loc>=2 ) THEN
	1177	WRITE(numout,*) 'intersurf_initialized_gathered --- nbcf_from_LMDZ, nbcf_into_LMDZ = ',nbcf_from_LMDZ, nbcf_into_LMDZ
	1178	IF (nbcf_into_LMDZ > 0) THEN
	1179	WRITE(numout,*) 'intersurf_initialized_gathered --- field_in_names_loc = ', field_in_names_loc
	1180	END IF
	1181	IF (nbcf_from_LMDZ > 0) THEN
	1182	WRITE(numout,*) 'intersurf_initialized_gathered --- field_out_names_loc = ', field_out_names_loc
	1183	END IF
	1184	END IF
	1185
	1186	!
	1187	! 8. Distribution of coastal- and riverflow on several time steps
	1188	!
[4435]	1189	!Config Key = TAU_OUTFLOW
	1190	!Config Desc = Number of days over which the coastal- and riverflow will be distributed
	1191	!Config If = Only in coupled mode
	1192	!Config Def = 0
	1193	!Config Help = The default value 0 makes the distribution instanteneous
	1194	!Config Units = [days]
	1195	tau_outflow = 0
	1196	CALL getin_p('TAU_OUTFLOW',tau_outflow)
	1197	IF (tau_outflow <=xrdt/one_day) THEN
	1198	coeff_rel = 1.0
	1199	ELSE
	1200	coeff_rel = (1.0 - exp(-xrdt/(tau_outflow*one_day)))
	1201	END IF
[5389]	1202	IF (printlev_loc >=2) WRITE(numout,*),'tau_outflow, coeff_rel = ', tau_outflow, coeff_rel
[4435]	1203
	1204	! Allocate and read riverflow_cpl0 from restart file. Initialize to 0 if the variable was not found in the restart file.
	1205	ALLOCATE(riverflow_cpl0(kjpindex), stat=ier)
	1206	IF (ier /= 0) CALL ipslerr_p(3,'intersurf_initialize_gathered', 'Error in allocation of riverflow_cpl0','','')
	1207	CALL restget_p (rest_id, 'riverflow_cpl0', nbp_glo, 1, 1, kjit, .TRUE., riverflow_cpl0, "gather", nbp_glo, index_g)
	1208	IF ( ALL(riverflow_cpl0(:) == val_exp) ) riverflow_cpl0(:)=0
	1209
	1210	! Allocate and read coastalflow_cpl0 from restart file. Initialize to 0 if the variable was not found in the restart file.
	1211	ALLOCATE(coastalflow_cpl0(kjpindex), stat=ier)
	1212	IF (ier /= 0) CALL ipslerr_p(3,'intersurf_initialize_gathered', 'Error in allocation of coastalflow_cpl0','','')
	1213	CALL restget_p (rest_id, 'coastalflow_cpl0', nbp_glo, 1, 1, kjit, .TRUE., coastalflow_cpl0, "gather", nbp_glo, index_g)
	1214	IF ( ALL(coastalflow_cpl0(:) == val_exp) ) coastalflow_cpl0(:)=0
	1215
	1216	! Do not applay the filter now in initialization phase.
	1217	! These variables will never be used anyway in the initialization phase.
	1218	! Transform into m^3/s
	1219	riverflow_cpl = zriver/xrdt
	1220	coastalflow_cpl = zcoastal/xrdt
[2605]	1221
[5389]	1222	!
	1223	! 9.
	1224	!
[4465]	1225	! Copy the number of vegetation types to local output variable
	1226	IF (PRESENT(nvm_out)) nvm_out=nvm
	1227
[2605]	1228	IF(is_root_prc) CALL getin_dump
[3851]	1229	lstep_init_intersurf = .FALSE.
[2605]	1230
	1231	CALL ipslnlf_p(new_number=old_fileout)
	1232	!
	1233	!! Change back to be in the LMDZ context for XIOS
	1234	!
	1235	CALL xios_orchidee_change_context("LMDZ")
[1933]	1236
[4693]	1237	IF (printlev_loc >= 2) WRITE (numout,*) 'End intersurf_initialize_gathered'
	1238	IF (printlev_loc >= 1) WRITE (numout,*) 'Initialization phase for ORCHIDEE is finished.'
	1239
[2605]	1240	END SUBROUTINE intersurf_initialize_gathered
[1788]	1241
[8]	1242
[2605]	1243	!! =============================================================================================================================
	1244	!! SUBROUTINE: intersurf_main_gathered
	1245	!!
	1246	!>\BRIEF Main subroutine to call ORCHIDEE from the gcm (LMDZ) using variables on a 1D grid with only land points.
	1247	!!
	1248	!! DESCRIPTION: This subroutine is the main interface for ORCHIDEE when it is called from the gcm (LMDZ).
	1249	!! The variables are all gathered before entering this subroutine on the 1D grid with only landpoints.
	1250	!!
	1251	!! \n
	1252	!_ ==============================================================================================================================
[8]	1253
[2605]	1254	SUBROUTINE intersurf_main_gathered (kjit, iim_glo, jjm_glo, kjpindex, kindex, xrdt, &
	1255	lrestart_read, lrestart_write, latlon, zcontfrac, zneighbours, zresolution, date0, &
	1256	zlev, u, v, qair, temp_air, epot_air, ccanopy, &
	1257	cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
	1258	precip_rain, precip_snow, lwdown, swnet, swdown, pb, &
[4435]	1259	vevapp, fluxsens, fluxlat, coastalflow_cpl, riverflow_cpl, &
[4465]	1260	tsol_rad, temp_sol_new, qsurf, albedo, emis, z0m,lon_scat_g, lat_scat_g, q2m, t2m, z0h, &
	1261	veget, lai, height, &
[5389]	1262	fields_out, fields_in, &
[5364]	1263	coszang)
[2605]	1264
	1265	USE mod_orchidee_para
	1266	IMPLICIT NONE
	1267
	1268	!! 0. Variable and parameter declaration
	1269	!! 0.1 Input variables
	1270	INTEGER(i_std),INTENT (in) :: kjit !! Time step number
	1271	INTEGER(i_std),INTENT (in) :: iim_glo !! Dimension of global fields
	1272	INTEGER(i_std),INTENT (in) :: jjm_glo !! Dimension of global fields
	1273	INTEGER(i_std),INTENT (in) :: kjpindex !! Number of continental points
	1274	REAL(r_std),INTENT (in) :: xrdt !! Time step in seconds
	1275	LOGICAL, INTENT (in) :: lrestart_read !! Logical for _restart_ file to read
	1276	LOGICAL, INTENT (in) :: lrestart_write !! Logical for _restart_ file to write'
	1277	REAL(r_std), INTENT (in) :: date0 !! Date at which kjit = 0
	1278	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: kindex !! Index for continental points
	1279	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: u !! Lowest level wind speed
	1280	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: v !! Lowest level wind speed
	1281	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: zlev !! Height of first layer
	1282	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: qair !! Lowest level specific humidity
	1283	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: precip_rain !! Rain precipitation
	1284	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: precip_snow !! Snow precipitation
	1285	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: lwdown !! Down-welling long-wave flux
	1286	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: swnet !! Net surface short-wave flux
	1287	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: swdown !! Downwelling surface short-wave flux
	1288	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: temp_air !! Air temperature in Kelvin
	1289	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: epot_air !! Air potential energy
	1290	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: ccanopy !! CO2 concentration in the canopy
	1291	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: petAcoef !! Coeficients A from the PBL resolution
	1292	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: peqAcoef !! One for T and another for q
	1293	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: petBcoef !! Coeficients B from the PBL resolution
	1294	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: peqBcoef !! One for T and another for q
	1295	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: pb !! Surface pressure
[5364]	1296	REAL(r_std),DIMENSION (:,:) , INTENT(in) :: latlon !! Geographical coordinates
[2605]	1297	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: zcontfrac !! Fraction of continent
[5364]	1298	INTEGER(i_std),DIMENSION (:,:), INTENT(in) :: zneighbours !! neighbours
[2605]	1299	REAL(r_std),DIMENSION (kjpindex,2), INTENT(in) :: zresolution !! size of the grid box
	1300	REAL(r_std),DIMENSION (iim_glo,jjm_glo), INTENT(IN) :: lon_scat_g !! The scattered values for longitude
	1301	REAL(r_std),DIMENSION (iim_glo,jjm_glo), INTENT(IN) :: lat_scat_g !! The scattered values for latitude
	1302
	1303	!! 0.2 Output variables
[3524]	1304	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: z0m !! Surface roughness for momentum
[4435]	1305	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: coastalflow_cpl !! Diffuse flow of water into the ocean, time filtered (m^3/s)
	1306	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: riverflow_cpl !! Largest rivers flowing into the ocean, time filtered (m^3/s)
[2605]	1307	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: tsol_rad !! Radiative surface temperature
	1308	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: vevapp !! Total of evaporation
	1309	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: temp_sol_new !! New soil temperature
	1310	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: qsurf !! Surface specific humidity
	1311	REAL(r_std),DIMENSION (kjpindex,2), INTENT(out) :: albedo !! Albedo
	1312	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: fluxsens !! Sensible chaleur flux
	1313	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: fluxlat !! Latent chaleur flux
	1314	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: emis !! Emissivity
	1315
	1316	!! 0.3 Modified variables
	1317	REAL(r_std),DIMENSION (kjpindex), INTENT(inout) :: cdrag !! Cdrag
	1318
	1319	!! 0.4 Optional input and output variables
[5573]	1320	REAL(r_std),DIMENSION (kjpindex), INTENT(in), OPTIONAL:: q2m !! Surface specific humidity, obsolete: this variable is not used any more, kept only for retrocomp with LMDZ
	1321	REAL(r_std),DIMENSION (kjpindex), INTENT(in), OPTIONAL:: t2m !! Surface air temperature, obsolete: this variable is not used any more, kept only for retrocomp with LMDZ
[3524]	1322	REAL(r_std),DIMENSION (kjpindex), INTENT(out),OPTIONAL:: z0h !! Surface roughness for heat
[4465]	1323	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(out), OPTIONAL :: veget !! Fraction of vegetation type (unitless, 0-1)
	1324	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(out), OPTIONAL :: lai !! Leaf area index (m^2 m^{-2}
	1325	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(out), OPTIONAL :: height !! Vegetation Height (m)
[2961]	1326	REAL(r_std), DIMENSION(kjpindex), OPTIONAL, INTENT(in):: coszang !! Cosine of the solar zenith angle (unitless)
[5389]	1327	REAL(r_std),DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: fields_in !! Optional fields sent to LMDZ, for ESM configuration
	1328	REAL(r_std),DIMENSION(:,:), OPTIONAL, INTENT(IN) :: fields_out !! Optional fields received from LMDZ, for ESM configuration
[2605]	1329
[5389]	1330
[2605]	1331	!! 0.5 Local variables
	1332	REAL(r_std),DIMENSION (kjpindex) :: zccanopy !! Work array to keep ccanopy
	1333	REAL(r_std),DIMENSION (kjpindex) :: zprecip_rain !! Work array to keep precip_rain
	1334	REAL(r_std),DIMENSION (kjpindex) :: zprecip_snow !! Work array to keep precip_snow
[3524]	1335	REAL(r_std),DIMENSION (kjpindex) :: zz0m, zz0h !! Work array to keep zz0m, zz0h
[2605]	1336	REAL(r_std),DIMENSION (kjpindex) :: zcdrag !! Work array for surface drag
	1337	REAL(r_std),DIMENSION (kjpindex) :: zcoastal !! Work array to keep coastal flow
	1338	REAL(r_std),DIMENSION (kjpindex) :: zriver !! Work array to keep river out flow
[6319]	1339	REAL(r_std),DIMENSION (kjpindex) :: znetco2 !! Work array to keep netco2flux (gC/m2/one_day)
[6160]	1340	REAL(r_std),DIMENSION (kjpindex) :: zcarblu !! Work array to keep fco2_land_use (gC/m2/one_day)
[6319]	1341	REAL(r_std),DIMENSION (kjpindex) :: zcarbwh !! Work array to keep fco2_wh (gC/m2/one_day)
	1342	REAL(r_std),DIMENSION (kjpindex) :: zcarbha !! Work array to keep fco2_ha (gC/m2/one_day)
[2605]	1343	REAL(r_std),DIMENSION (kjpindex) :: ztsol_rad !! Work array to keep tsol_rad
	1344	REAL(r_std),DIMENSION (kjpindex) :: zvevapp !! Work array to keep vevapp
	1345	REAL(r_std),DIMENSION (kjpindex) :: ztemp_sol_new !! Work array to keep temp_sol_new
	1346	REAL(r_std),DIMENSION (kjpindex) :: zqsurf !! Work array to keep qsurf
	1347	REAL(r_std),DIMENSION (kjpindex,2) :: zalbedo !! Work array to keep albedo
	1348	REAL(r_std),DIMENSION (kjpindex) :: zfluxsens !! Work array to keep fluxsens
	1349	REAL(r_std),DIMENSION (kjpindex) :: zfluxlat !! Work array to keep fluxlat
	1350	REAL(r_std),DIMENSION (kjpindex) :: zemis !! Work array to keep emis
[2961]	1351	REAL(r_std),DIMENSION (kjpindex) :: zcoszang !! Work array to keep coszang
[4465]	1352	REAL(r_std),DIMENSION (kjpindex,nvm) :: zveget !! Work array to keep veget
	1353	REAL(r_std),DIMENSION (kjpindex,nvm) :: zlai !! Work array to keep lai
	1354	REAL(r_std),DIMENSION (kjpindex,nvm) :: zheight !! Work array to keep height
[2605]	1355	INTEGER(i_std) :: i, j, ik
	1356	INTEGER(i_std) :: ier
	1357	INTEGER(i_std) :: itau_sechiba
	1358	INTEGER :: old_fileout !! old Logical Int for std IO output
	1359	REAL,ALLOCATABLE,DIMENSION(:,:) :: lalo_mpi
	1360	REAL(r_std),DIMENSION (kjpindex) :: landpoints !! Local landpoints vector
	1361
[4693]	1362	IF (printlev_loc >= 3) WRITE(numout,*) 'Start intersurf_main_gathered'
[2605]	1363	CALL ipslnlf_p(new_number=numout, old_number=old_fileout)
	1364
[3851]	1365	IF (lstep_init_intersurf) THEN
[5364]	1366	! intersurf_initialize_gathered was not yet called. An old version of
	1367	! LMDZ is used. Now prepare and call intersurf_initialize_gathered
	1368
[2605]	1369	CALL intersurf_initialize_gathered (kjit, iim_glo, jjm_glo, kjpindex, kindex, xrdt, &
	1370	lrestart_read, lrestart_write, latlon, zcontfrac, zneighbours, zresolution, date0, &
	1371	zlev, u, v, qair, temp_air, epot_air, &
	1372	cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
	1373	precip_rain, precip_snow, lwdown, swnet, swdown, pb, &
[4435]	1374	vevapp, fluxsens, fluxlat, coastalflow_cpl, riverflow_cpl, &
[4465]	1375	tsol_rad, temp_sol_new, qsurf, albedo, emis, z0m,lon_scat_g, lat_scat_g, &
[5573]	1376	zz0h)
[275]	1377
[3524]	1378	! z0h is a optional output variable. Check first if it is present in the call from LMDZ.
	1379	IF ( PRESENT(z0h) ) z0h(:) = zz0h(:)
[2605]	1380	! Return from subroutine intersurf_main_gathered
	1381	RETURN
	1382	END IF
[1078]	1383
[8]	1384	!
[1907]	1385	!! Change to be in the orchidee context for XIOS
	1386	!
	1387	CALL xios_orchidee_change_context("orchidee")
	1388
	1389	!
[8]	1390	! Shift the time step to phase the two models
	1391	!
	1392	itau_sechiba = kjit + itau_offset
[1788]	1393
	1394	! Update the calendar in xios by sending the new time step
[2605]	1395	CALL xios_orchidee_update_calendar(itau_sechiba)
	1396
[4646]	1397	! Update the calendar and all time variables in module time
	1398	CALL time_nextstep(itau_sechiba)
	1399
[8]	1400	!
	1401	! 1. Just change the units of some input fields
	1402	!
	1403	DO ik=1, kjpindex
	1404
	1405	zprecip_rain(ik) = precip_rain(ik)*xrdt
	1406	zprecip_snow(ik) = precip_snow(ik)*xrdt
	1407	zcdrag(ik) = cdrag(ik)
	1408
	1409	ENDDO
[2605]	1410
	1411	!>> VOC in coupled mode
[2961]	1412	IF ( PRESENT(coszang) ) THEN
	1413	zcoszang(:) = coszang(:)
[2605]	1414	ELSE
[2961]	1415	zcoszang(:) = zero
[2605]	1416	ENDIF
	1417
[5389]	1418	! Optional fields received from LMDZ, for ESM configuration
	1419	! No fields are currently received from LMDZ
	1420	DO i = 1, nbcf_from_LMDZ
	1421	SELECT CASE(TRIM(field_out_names_loc(i)))
	1422	! CASE("...")
	1423	! Things to do for this case...
[5396]	1424	CASE("atmco2")
	1425	IF (printlev_loc > 4) WRITE(numout,*) &
	1426	'Retreive the atmco2 field, in this case equal to fields_out(:,i)=ccanopy(:)'
[275]	1427	CASE DEFAULT
[5389]	1428	CALL ipslerr_p (3,'intersurf_main_gathered', &
	1429	'The selected field received from LMDZ '//TRIM(field_out_names_loc(i))//' is not implemented.','','')
[275]	1430	END SELECT
	1431	ENDDO
[511]	1432
[8]	1433	!
	1434	! 2. modification of co2
	1435	!
	1436	IF ( fatmco2 ) THEN
	1437	zccanopy(:) = atmco2
	1438	WRITE (numout,*) 'Modification of the ccanopy value. CO2 = ',atmco2
	1439	ELSE
	1440	zccanopy(:) = ccanopy(:)
	1441	ENDIF
[2291]	1442
[8]	1443	!
	1444	! 4. call sechiba for continental points only
	1445	!
[4693]	1446	IF ( printlev_loc >= 3 ) WRITE(numout,*) 'Before call to sechiba_main from intersurf_main_gathered'
[2595]	1447
	1448
[3998]	1449	CALL sechiba_main (itau_sechiba, iim_g*jj_nb, kjpindex, kindex, &
[2605]	1450	lrestart_read, lrestart_write, &
	1451	lalo, contfrac, neighbours, resolution, &
[5573]	1452	zlev, u, v, qair, temp_air, epot_air, zccanopy, &
[2605]	1453	zcdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
[2961]	1454	zprecip_rain ,zprecip_snow, lwdown, swnet, swdown, zcoszang, pb, &
[6319]	1455	zvevapp, zfluxsens, zfluxlat, zcoastal, zriver, &
	1456	znetco2, zcarblu, zcarbwh, zcarbha, &
[3524]	1457	ztsol_rad, ztemp_sol_new, zqsurf, zalbedo, zemis, zz0m, zz0h, &
[4465]	1458	zveget, zlai, zheight, &
[2605]	1459	rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC )
[2595]	1460
[4693]	1461	IF ( printlev_loc>=3 ) WRITE(numout,*) 'After call to sechiba_main'
[2605]	1462
[8]	1463	!
	1464	! 6. scatter output fields
	1465	!
	1466	DO ik=1, kjpindex
[3524]	1467	z0m(ik) = zz0m(ik)
[8]	1468	tsol_rad(ik) = ztsol_rad(ik)
	1469	temp_sol_new(ik) = ztemp_sol_new(ik)
	1470	qsurf(ik) = zqsurf(ik)
	1471	albedo(ik,1) = zalbedo(ik,1)
	1472	albedo(ik,2) = zalbedo(ik,2)
	1473	fluxsens(ik) = zfluxsens(ik)
	1474	fluxlat(ik) = zfluxlat(ik)
	1475	emis(ik) = zemis(ik)
	1476	cdrag(ik) = zcdrag(ik)
[4435]	1477	! Transform the water fluxes into Kg/m^2/s
	1478	vevapp(ik) = zvevapp(ik)/xrdt
[8]	1479	ENDDO
[4435]	1480
[4465]	1481	! Copy variables only if the optional variables are present in the call to the subroutine
	1482	IF (PRESENT(veget)) veget(:,:) = zveget(:,:)
	1483	IF (PRESENT(lai)) lai(:,:) = zlai(:,:)
	1484	IF (PRESENT(height)) height(:,:) = zheight(:,:)
	1485
[5389]	1486
	1487	!
	1488	! 7. Set variables to be sent to LMDZ, for ESM configuration
	1489	! field_in_names_loc should be consitent with the names used in coupling_fields.def read by LMDZ
	1490	!
	1491	IF (nbcf_into_LMDZ.GT.0) THEN
	1492	DO ik=1, kjpindex
	1493	DO i = 1, nbcf_into_LMDZ
	1494	SELECT CASE(TRIM(field_in_names_loc(i)))
	1495	CASE("fCO2_nep")
[6319]	1496	! Transform from gC/m2/one_day into kgC/m2/s
	1497	fields_in(ik,i) = znetco2(ik)/1.e3/one_day
[5389]	1498	CASE("fCO2_fLuc")
[6160]	1499	! Transform from gC/m2/one_day into kgC/m2/s
[6319]	1500	fields_in(ik,i) = zcarblu(ik)/1.e3/one_day
	1501	CASE("fCO2_fWoodharvest")
	1502	! Transform from gC/m2/one_day into kgC/m2/s
	1503	fields_in(ik,i) = zcarbwh(ik)/1.e3/one_day
	1504	CASE("fCO2_fHarvest")
	1505	! Transform from gC/m2/one_day into kgC/m2/s
	1506	fields_in(ik,i) = zcarbha(ik)/1.e3/one_day
[5389]	1507	CASE("fCO2_nbp")
[6370]	1508	fields_in(ik,i) = znetco2(ik)/1.e3/one_day + zcarblu(ik)/1.e3/one_day + &
	1509	zcarbwh(ik)/1.e3/one_day + zcarbha(ik)/1.e3/one_day
[5389]	1510	CASE DEFAULT
	1511	CALL ipslerr_p (3,'intersurf_main_gathered', &
	1512	'The selected field to be sent to LMDZ '//TRIM(field_in_names_loc(i))//' is not yet implemented.','','')
	1513	END SELECT
	1514	END DO
	1515	ENDDO
	1516	END IF
	1517
	1518
[4435]	1519	! Applay time filter to distribut the river- and coastalflow over a longer time period.
	1520	! When coeff_rel=1(default case when tau_outflow=0), the distribution is instanteneous.
	1521	! Use TAU_OUTFLOW in run.def to set the number of days of distribution.
	1522	! The water fluxes zriver and zcoastal coming from sechiba are at the same time transfromed
	1523	! from m^3/dt_sechiba into m^3/s by dividing with the sechiba time step (xrdt).
	1524	riverflow_cpl = coeff_relzriver/xrdt + (1.-coeff_rel)riverflow_cpl0
	1525	riverflow_cpl0 = riverflow_cpl
	1526
	1527	coastalflow_cpl = coeff_relzcoastal/xrdt + (1.-coeff_rel)coastalflow_cpl0
	1528	coastalflow_cpl0 = coastalflow_cpl
	1529
	1530
[3524]	1531	! z0h is a optional output variable. Check first if it is present in the call from LMDZ.
	1532	IF ( PRESENT(z0h) ) z0h(:) = zz0h(:)
[1788]	1533
[2605]	1534	CALL xios_orchidee_send_field("LandPoints" ,(/ ( REAL(ik), ik=1,kjpindex ) /))
[3642]	1535	CALL xios_orchidee_send_field("areas", area)
	1536	CALL xios_orchidee_send_field("contfrac",contfrac)
	1537	CALL xios_orchidee_send_field("temp_air",temp_air)
[2605]	1538	CALL xios_orchidee_send_field("qair",qair)
	1539	CALL xios_orchidee_send_field("swnet",swnet)
	1540	CALL xios_orchidee_send_field("swdown",swdown)
[3642]	1541	CALL xios_orchidee_send_field("pb",pb)
[4435]	1542	CALL xios_orchidee_send_field("riverflow_cpl",riverflow_cpl)
	1543	CALL xios_orchidee_send_field("coastalflow_cpl",coastalflow_cpl)
[6319]	1544	CALL xios_orchidee_send_field("znetco2",znetco2/1.e3/one_day) ! gC/m2/one_day -> kgC/m2/s
	1545	CALL xios_orchidee_send_field("zcarblu",zcarblu/1.e3/one_day) ! gC/m2/one_day -> kgC/m2/s
	1546	CALL xios_orchidee_send_field("zcarbwh",zcarbwh/1.e3/one_day) ! gC/m2/one_day -> kgC/m2/s
	1547	CALL xios_orchidee_send_field("zcarbha",zcarbha/1.e3/one_day) ! gC/m2/one_day -> kgC/m2/s
	1548
[2605]	1549
	1550	IF ( .NOT. almaoutput ) THEN
	1551	!
	1552	! scattered during the writing
	1553	!
	1554	CALL histwrite_p (hist_id, 'evap', itau_sechiba, zvevapp, kjpindex, kindex)
	1555	CALL histwrite_p (hist_id, 'coastalflow',itau_sechiba, zcoastal, kjpindex, kindex)
	1556	CALL histwrite_p (hist_id, 'riverflow',itau_sechiba, zriver, kjpindex, kindex)
	1557	CALL histwrite_p (hist_id, 'temp_sol', itau_sechiba, ztemp_sol_new, kjpindex, kindex)
	1558	CALL histwrite_p (hist_id, 'tsol_max', itau_sechiba, ztemp_sol_new, kjpindex, kindex)
	1559	CALL histwrite_p (hist_id, 'tsol_min', itau_sechiba, ztemp_sol_new, kjpindex, kindex)
	1560	CALL histwrite_p (hist_id, 'fluxsens', itau_sechiba, zfluxsens, kjpindex, kindex)
	1561	CALL histwrite_p (hist_id, 'fluxlat', itau_sechiba, zfluxlat, kjpindex, kindex)
	1562	CALL histwrite_p (hist_id, 'swnet', itau_sechiba, swnet, kjpindex, kindex)
	1563	CALL histwrite_p (hist_id, 'swdown', itau_sechiba, swdown, kjpindex, kindex)
	1564	CALL histwrite_p (hist_id, 'alb_vis', itau_sechiba, zalbedo(:,1), kjpindex, kindex)
	1565	CALL histwrite_p (hist_id, 'alb_nir', itau_sechiba, zalbedo(:,2), kjpindex, kindex)
	1566	CALL histwrite_p (hist_id, 'tair', itau_sechiba, temp_air, kjpindex, kindex)
	1567	CALL histwrite_p (hist_id, 'qair', itau_sechiba, qair, kjpindex, kindex)
[5573]	1568
[2605]	1569	IF ( hist2_id > 0 ) THEN
	1570	CALL histwrite_p (hist2_id, 'evap', itau_sechiba, zvevapp, kjpindex, kindex)
	1571	CALL histwrite_p (hist2_id, 'coastalflow',itau_sechiba, zcoastal, kjpindex, kindex)
	1572	CALL histwrite_p (hist2_id, 'riverflow',itau_sechiba, zriver, kjpindex, kindex)
	1573	CALL histwrite_p (hist2_id, 'temp_sol', itau_sechiba, temp_sol_new, kjpindex, kindex)
	1574	CALL histwrite_p (hist2_id, 'tsol_max', itau_sechiba, temp_sol_new, kjpindex, kindex)
	1575	CALL histwrite_p (hist2_id, 'tsol_min', itau_sechiba, temp_sol_new, kjpindex, kindex)
	1576	CALL histwrite_p (hist2_id, 'fluxsens', itau_sechiba, zfluxsens, kjpindex, kindex)
	1577	CALL histwrite_p (hist2_id, 'fluxlat', itau_sechiba, zfluxlat, kjpindex, kindex)
	1578	CALL histwrite_p (hist2_id, 'swnet', itau_sechiba, swnet, kjpindex, kindex)
	1579	CALL histwrite_p (hist2_id, 'swdown', itau_sechiba, swdown, kjpindex, kindex)
	1580	CALL histwrite_p (hist2_id, 'alb_vis', itau_sechiba, zalbedo(:,1), kjpindex, kindex)
	1581	CALL histwrite_p (hist2_id, 'alb_nir', itau_sechiba, zalbedo(:,2), kjpindex, kindex)
	1582	CALL histwrite_p (hist2_id, 'tair', itau_sechiba, temp_air, kjpindex, kindex)
	1583	CALL histwrite_p (hist2_id, 'qair', itau_sechiba, qair, kjpindex, kindex)
[8]	1584	ENDIF
[2605]	1585	ELSE
	1586	CALL histwrite_p (hist_id, 'Evap', itau_sechiba, zvevapp, kjpindex, kindex)
	1587	CALL histwrite_p (hist_id, 'SWnet', itau_sechiba, swnet, kjpindex, kindex)
	1588	CALL histwrite_p (hist_id, 'Qh', itau_sechiba, zfluxsens, kjpindex, kindex)
	1589	CALL histwrite_p (hist_id, 'Qle', itau_sechiba, zfluxlat, kjpindex, kindex)
	1590	CALL histwrite_p (hist_id, 'AvgSurfT', itau_sechiba, ztemp_sol_new, kjpindex, kindex)
	1591	CALL histwrite_p (hist_id, 'RadT', itau_sechiba, ztemp_sol_new, kjpindex, kindex)
	1592	IF ( hist2_id > 0 ) THEN
	1593	CALL histwrite_p (hist2_id, 'Evap', itau_sechiba, zvevapp, kjpindex, kindex)
	1594	CALL histwrite_p (hist2_id, 'SWnet', itau_sechiba, swnet, kjpindex, kindex)
	1595	CALL histwrite_p (hist2_id, 'Qh', itau_sechiba, zfluxsens, kjpindex, kindex)
	1596	CALL histwrite_p (hist2_id, 'Qle', itau_sechiba, zfluxlat, kjpindex, kindex)
	1597	CALL histwrite_p (hist2_id, 'AvgSurfT', itau_sechiba, ztemp_sol_new, kjpindex, kindex)
	1598	CALL histwrite_p (hist2_id, 'RadT', itau_sechiba, ztemp_sol_new, kjpindex, kindex)
[8]	1599	ENDIF
	1600	ENDIF
[2605]	1601
	1602	! Syncronize output but only if flag ok_histsync is set to true
	1603	IF (ok_histsync .AND. is_omp_root) THEN
	1604	IF ( (dw .EQ. xrdt) .AND. hist_id > 0 ) THEN
	1605	CALL histsync(hist_id)
	1606	ENDIF
	1607	ENDIF
	1608
[4435]	1609
[2605]	1610
[4435]	1611	! Write variables to restart file
	1612	IF (lrestart_write) THEN
	1613	CALL restput_p (rest_id, 'riverflow_cpl0', nbp_glo, 1, 1, kjit, riverflow_cpl0, 'scatter', nbp_glo, index_g)
	1614	CALL restput_p (rest_id, 'coastalflow_cpl0', nbp_glo, 1, 1, kjit, coastalflow_cpl0, 'scatter', nbp_glo, index_g)
	1615	END IF
	1616
[8]	1617	!
[1078]	1618	CALL ipslnlf_p(new_number=old_fileout)
[8]	1619	!
[1907]	1620
	1621	!
[1919]	1622	!! Finalize the XIOS orchidee context if it is the last call
	1623	!
	1624	IF (lrestart_write) THEN
[5364]	1625	CALL ioipslctrl_restclo
[1919]	1626	CALL xios_orchidee_context_finalize
	1627	END IF
	1628	!
[1907]	1629	!! Change back to be in the LMDZ context for XIOS
	1630	!
	1631	CALL xios_orchidee_change_context("LMDZ")
	1632
[4693]	1633	IF (printlev_loc >= 3) WRITE (numout,*) 'End intersurf_main_gathered'
	1634
[2605]	1635	END SUBROUTINE intersurf_main_gathered
[1078]	1636
[4287]	1637	!! ================================================================================================================================
	1638	!! SUBROUTINE : intersurf_clear
	1639	!!
	1640	!>\BRIEF Clear intersurf module and underlaying modules
	1641	!!
	1642	!! DESCRIPTION : Deallocate memory and reset initialization variables to there original values.
	1643	!! Call the clearing for sechiba module.
	1644	!!
	1645	!_ ================================================================================================================================
	1646	SUBROUTINE intersurf_clear
	1647	CALL sechiba_clear
	1648	END SUBROUTINE intersurf_clear
	1649
[8]	1650	END MODULE intersurf

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

Download in other formats: