Context Navigation

source: branches/publications/ORCHIDEE_GLUC_r6545/src_sechiba/intersurf.f90 @ 7346

Last change on this file since 7346 was 5114, checked in by albert.jornet, 6 years ago
Fix: landpoint_idx calculation was missed for interpolation checks New: enable parallel interpolation for OpenMP in coupled mode
Property svn:keywords set to `Revision Date HeadURL Date Author Revision`
File size: 90.4 KB

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

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

Download in other formats: