Context Navigation

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

Last change on this file since 6160 was 6160, checked in by josefine.ghattas, 5 years ago

Corrected errors on variables zcarblu and znetco2. These variables are only used for the specific case when coupling carbon variables to LMDZ. zcarblu was only available at time step do_slow, at other timesteps, the variable was not initialized. It is now saved in stomate. Units are now kgC/m2/s when sending these variables to LMDZ.

P Cadule, J Ghattas

Property svn:keywords set to Revision Date HeadURL Date Author Revision

File size: 87.8 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 ioipslctrl, ONLY : ioipslctrl_history, ioipslctrl_restini, ioipslctrl_restclo, ok_histsync, max_hist_level, dw
52
53	IMPLICIT NONE
54
55	PRIVATE
56	PUBLIC :: Init_intersurf, intersurf_main, intersurf_main_2d, intersurf_main_gathered
57	PUBLIC :: intersurf_initialize_2d, intersurf_initialize_gathered, intersurf_clear
58
59
60	! Interface called from LMDZ in older verisons
61	INTERFACE intersurf_main
62	MODULE PROCEDURE intersurf_main_gathered
63	END INTERFACE
64
65	LOGICAL, SAVE :: lstep_init_intersurf=.TRUE.!! Initialisation has to be done one time
66	!$OMP THREADPRIVATE(lstep_init_intersurf)
67	INTEGER(i_std), SAVE :: printlev_loc !! Write level to this module
68	!$OMP THREADPRIVATE(printlev_loc)
69	INTEGER(i_std), SAVE :: hist_id, rest_id !! IDs for history and restart files
70	!$OMP THREADPRIVATE(hist_id, rest_id)
71	INTEGER(i_std), SAVE :: hist2_id !! ID for the second history files (Hi-frequency ?)
72	!$OMP THREADPRIVATE(hist2_id)
73	INTEGER(i_std), SAVE :: hist_id_stom, hist_id_stom_IPCC, rest_id_stom !! Dito for STOMATE
74	!$OMP THREADPRIVATE(hist_id_stom, hist_id_stom_IPCC, rest_id_stom)
75	INTEGER(i_std), SAVE :: itau_offset !! This offset is used to phase the
76	!! calendar of the GCM or the driver.
77	!$OMP THREADPRIVATE(itau_offset)
78	REAL(r_std), SAVE :: date0_shifted
79	!$OMP THREADPRIVATE(date0_shifted)
80	REAL(r_std), SAVE :: julian0 !! first day of this year
81	!$OMP THREADPRIVATE(julian0)
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)
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)
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)
100
101	PUBLIC lstep_init_intersurf
102
103	CONTAINS
104
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, &
124	tsol_rad, temp_sol_new, qsurf, albedo, emis, z0m)
125
126	IMPLICIT NONE
127
128	!! 0. Variable and parameter declaration
129	!! 0.1 Input variables
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
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
154	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: pb !! Surface pressure
155	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: lon, lat !! Geographical coordinates
156	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: zcontfrac !! Fraction of continent in the grid
157	REAL(r_std),DIMENSION (iim,jjm,2), INTENT(in) :: zresolution !! resolution in x and y dimensions
158
159	!! 0.2 Output variables
160	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: z0m !! Surface roughness
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)
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
171
172	!! 0.3 Modified variables
173	REAL(r_std),DIMENSION (iim,jjm), INTENT(inout) :: cdrag !! Cdrag
174
175	!! 0.4 Local variables
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
194	REAL(r_std),DIMENSION (kjpindex) :: zz0m, zz0h !! Work array to keep zz0m, zz0h
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)
197	REAL(r_std),DIMENSION (kjpindex) :: znetco2 !! Work array to keep netco2flux (gC/m2/dt_sechiba)
198	REAL(r_std),DIMENSION (kjpindex) :: zcarblu !! Work array to keep fco2_land_use (gC/m2/one_day)
199	REAL(r_std),DIMENSION (kjpindex) :: ztsol_rad !! Work array to keep tsol_rad
200	REAL(r_std),DIMENSION (kjpindex) :: zvevapp !! Work array to keep vevapp
201	REAL(r_std),DIMENSION (kjpindex) :: ztemp_sol_new !! Work array to keep temp_sol_new
202	REAL(r_std),DIMENSION (kjpindex) :: zqsurf !! Work array to keep qsurf
203	REAL(r_std),DIMENSION (kjpindex,2) :: zalbedo !! Work array to keep albedo
204	REAL(r_std),DIMENSION (kjpindex) :: zfluxsens !! Work array to keep fluxsens
205	REAL(r_std),DIMENSION (kjpindex) :: zfluxlat !! Work array to keep fluxlat
206	REAL(r_std),DIMENSION (kjpindex) :: zemis !! Work array to keep emis
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 ioipslctrl_restini(kjit, date0, xrdt, rest_id, rest_id_stom, itau_offset, date0_shifted)
248	itau_sechiba = kjit + itau_offset
249
250	!!- Initialize module for output with XIOS
251	!
252	CALL xios_orchidee_init( MPI_COMM_ORCH, &
253	date0, year_end, month_end, day_end, julian_diff, &
254	lon, lat, znt )
255
256	CALL sechiba_xios_initialize
257
258	CALL xios_orchidee_close_definition
259	IF (printlev >= 2) WRITE(numout,*) 'After xios_orchidee_close_definition'
260
261	!- Initialize IOIPSL sechiba output files
262	CALL ioipslctrl_history(iim, jjm, lon, lat, kindex, kjpindex, itau_sechiba, date0_shifted, xrdt, hist_id, &
263	hist2_id, hist_id_stom, hist_id_stom_IPCC)
264
265	!
266	! Shift the time step to phase the two models
267	!
268	itau_sechiba = kjit + itau_offset
269
270	! Update the calendar in xios by sending the new time step
271	! Special case : the model is only in initialization phase and the current itau_sechiba is not a real time step.
272	! Therefor give itau_sechiba+1 to xios to have a correct time axis in output files.
273	CALL xios_orchidee_update_calendar(itau_sechiba+1)
274
275	!
276	! 1. gather input fields from kindex array
277	! Warning : I'm not sure this interface with one dimension array is the good one
278	!
279	DO ik=1, kjpindex
280
281	j = ((kindex(ik)-1)/iim) + 1
282	i = (kindex(ik) - (j-1)*iim)
283
284	zu(ik) = u(i,j)
285	zv(ik) = v(i,j)
286	zzlev(ik) = zlev(i,j)
287	zqair(ik) = qair(i,j)
288	zprecip_rain(ik) = precip_rain(i,j)*xrdt
289	zprecip_snow(ik) = precip_snow(i,j)*xrdt
290	zlwdown(ik) = lwdown(i,j)
291	zswnet(ik) = swnet(i,j)
292	zswdown(ik) = swdown(i,j)
293	ztemp_air(ik) = temp_air(i,j)
294	zepot_air(ik) = epot_air(i,j)
295	zccanopy(ik) = ccanopy(i,j)
296	zpetAcoef(ik) = petAcoef(i,j)
297	zpeqAcoef(ik) = peqAcoef(i,j)
298	zpetBcoef(ik) = petBcoef(i,j)
299	zpeqBcoef(ik) = peqBcoef(i,j)
300	zcdrag(ik) = cdrag(i,j)
301	zpb(ik) = pb(i,j)
302
303	ENDDO
304
305	!
306	! 2. save the grid
307	!
308	CALL histwrite_p(hist_id, 'LandPoints', itau_sechiba+1, (/ ( REAL(ik), ik=1,kjpindex ) /), kjpindex, kindex)
309	CALL histwrite_p(hist_id, 'Areas', itau_sechiba+1, area, kjpindex, kindex)
310	IF ( ok_stomate ) THEN
311	CALL histwrite_p(hist_id_stom, 'Areas', itau_sechiba+1, area, kjpindex, kindex)
312	CALL histwrite_p(hist_id_stom_IPCC, 'Areas', itau_sechiba+1, area, kjpindex, kindex)
313	ENDIF
314
315	CALL histwrite_p(hist_id, 'Contfrac', itau_sechiba+1, contfrac, kjpindex, kindex)
316	IF ( is_omp_root .AND. hist_id > 0 ) THEN
317	! Always syncronize output after initialization
318	CALL histsync(hist_id)
319	END IF
320
321	CALL histwrite_p(hist2_id, 'LandPoints', itau_sechiba+1, (/ ( REAL(ik), ik=1,kjpindex ) /), kjpindex, kindex)
322	CALL histwrite_p(hist2_id, 'Areas', itau_sechiba+1, area, kjpindex, kindex)
323	CALL histwrite_p(hist2_id, 'Contfrac', itau_sechiba+1, contfrac, kjpindex, kindex)
324	IF ( is_omp_root .AND. hist2_id > 0 ) THEN
325	! Always syncronize output after initialization
326	CALL histsync(hist2_id)
327	ENDIF
328
329	!
330	! 3. call sechiba for continental points only
331	!
332	IF (printlev_loc >= 3) WRITE(numout,*) 'Before call to sechiba_initialize'
333
334	CALL sechiba_initialize( &
335	itau_sechiba, iim*jjm, kjpindex, kindex, &
336	lalo, contfrac, neighbours, resolution, zzlev, &
337	zu, zv, zqair, ztemp_air, &
338	zpetAcoef, zpeqAcoef, zpetBcoef, zpeqBcoef, &
339	zprecip_rain, zprecip_snow, zlwdown, zswnet, zswdown, &
340	zpb, rest_id, hist_id, hist2_id, &
341	rest_id_stom, hist_id_stom, hist_id_stom_IPCC, &
342	zcoastal, zriver, ztsol_rad, zvevapp, zqsurf, &
343	zz0m, zz0h, zalbedo, zfluxsens, zfluxlat, &
344	zemis, znetco2, zcarblu, ztemp_sol_new, zcdrag)
345
346	IF (printlev_loc >= 3) WRITE(numout,*) 'After call to sechiba_initialize'
347	!
348	! 5. scatter output fields
349	!
350	z0m(:,:) = undef_sechiba
351	coastalflow(:,:) = undef_sechiba
352	riverflow(:,:) = undef_sechiba
353	tsol_rad(:,:) = undef_sechiba
354	vevapp(:,:) = undef_sechiba
355	temp_sol_new(:,:) = undef_sechiba
356	qsurf(:,:) = undef_sechiba
357	albedo(:,:,:) = undef_sechiba
358	fluxsens(:,:) = undef_sechiba
359	fluxlat(:,:) = undef_sechiba
360	emis(:,:) = undef_sechiba
361	cdrag(:,:) = undef_sechiba
362
363	DO ik=1, kjpindex
364	j = ((kindex(ik)-1)/iim) + 1
365	i = (kindex(ik) - (j-1)*iim)
366
367	z0m(i,j) = zz0m(ik)
368	coastalflow(i,j) = zcoastal(ik)
369	riverflow(i,j) = zriver(ik)
370	tsol_rad(i,j) = ztsol_rad(ik)
371	vevapp(i,j) = zvevapp(ik)
372	temp_sol_new(i,j) = ztemp_sol_new(ik)
373	qsurf(i,j) = zqsurf(ik)
374	albedo(i,j,1) = zalbedo(ik,1)
375	albedo(i,j,2) = zalbedo(ik,2)
376	fluxsens(i,j) = zfluxsens(ik)
377	fluxlat(i,j) = zfluxlat(ik)
378	emis(i,j) = zemis(ik)
379	cdrag(i,j) = zcdrag(ik)
380	ENDDO
381
382	!
383	! 6. Transform the water fluxes into Kg/m^2s and m^3/s
384	!
385	DO ik=1, kjpindex
386
387	j = ((kindex(ik)-1)/iim) + 1
388	i = (kindex(ik) - (j-1)*iim)
389
390	vevapp(i,j) = vevapp(i,j)/xrdt
391	coastalflow(i,j) = coastalflow(i,j)/xrdt
392	riverflow(i,j) = riverflow(i,j)/xrdt
393
394	ENDDO
395
396	IF (is_root_prc) CALL getin_dump
397
398	lstep_init_intersurf = .FALSE.
399	CALL ipslnlf_p(new_number=old_fileout)
400	IF (printlev_loc >= 1) WRITE (numout,*) 'End intersurf_initialize_2d'
401
402	END SUBROUTINE intersurf_initialize_2d
403
404
405	!! =============================================================================================================================
406	!! SUBROUTINE: intersurf_main_2d
407	!!
408	!>\BRIEF Main subroutine to call ORCHIDEE from dim2_driver using variables on a 2d grid.
409	!!
410	!! DESCRIPTION: This subroutine is the main interface for ORCHIDEE when it is called from the offline driver dim2_driver.
411	!! The variables are all on the 2D grid including ocean points. intersurf_initialize_2d should be called before
412	!! this subroutine is called. This subroutine is called at each time step.
413	!!
414	!! \n
415	!_ ==============================================================================================================================
416
417	SUBROUTINE intersurf_main_2d (kjit, iim, jjm, kjpindex, kindex, xrdt, &
418	lrestart_read, lrestart_write, lon, lat, zcontfrac, zresolution, date0, &
419	zlev, u, v, qair, temp_air, epot_air, ccanopy, &
420	cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
421	precip_rain, precip_snow, lwdown, swnet, swdown, pb, &
422	vevapp, fluxsens, fluxlat, coastalflow, riverflow, &
423	tsol_rad, temp_sol_new, qsurf, albedo, emis, z0m, &
424	coszang)
425
426	IMPLICIT NONE
427
428	!! 0. Variable and parameter declaration
429	!! 0.1 Input variables
430	INTEGER(i_std),INTENT (in) :: kjit !! Time step number
431	INTEGER(i_std),INTENT (in) :: iim, jjm !! Dimension of input fields
432	INTEGER(i_std),INTENT (in) :: kjpindex !! Number of continental points
433	REAL(r_std),INTENT (in) :: xrdt !! Time step in seconds
434	LOGICAL, INTENT (in) :: lrestart_read !! Logical for _restart_ file to read
435	LOGICAL, INTENT (in) :: lrestart_write !! Logical for _restart_ file to write'
436	REAL(r_std), INTENT (in) :: date0 !! Date at which kjit = 0
437	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: kindex !! Index for continental points
438	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: u !! Lowest level wind speed
439	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: v !! Lowest level wind speed
440	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: zlev !! Height of first layer
441	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: qair !! Lowest level specific humidity
442	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: precip_rain !! Rain precipitation
443	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: precip_snow !! Snow precipitation
444	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: lwdown !! Down-welling long-wave flux
445	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: swnet !! Net surface short-wave flux
446	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: swdown !! Downwelling surface short-wave flux
447	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: coszang !! Cosine of the solar zenith angle (unitless)
448	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: temp_air !! Air temperature in Kelvin
449	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: epot_air !! Air potential energy
450	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: ccanopy !! CO2 concentration in the canopy
451	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: petAcoef !! Coeficients A from the PBL resolution
452	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: peqAcoef !! One for T and another for q
453	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: petBcoef !! Coeficients B from the PBL resolution
454	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: peqBcoef !! One for T and another for q
455	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: pb !! Surface pressure
456	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: lon, lat !! Geographical coordinates
457	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: zcontfrac !! Fraction of continent in the grid
458	REAL(r_std),DIMENSION (iim,jjm,2), INTENT(in) :: zresolution !! resolution in x and y dimensions
459
460	!! 0.2 Output variables
461	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: z0m !! Surface roughness for momemtum
462	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: coastalflow !! Diffuse flow of water into the ocean (m^3/s)
463	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: riverflow !! Largest rivers flowing into the ocean (m^3/s)
464	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: tsol_rad !! Radiative surface temperature
465	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: vevapp !! Total of evaporation
466	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: temp_sol_new !! New soil temperature
467	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: qsurf !! Surface specific humidity
468	REAL(r_std),DIMENSION (iim,jjm,2), INTENT(out) :: albedo !! Albedo
469	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: fluxsens !! Sensible chaleur flux
470	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: fluxlat !! Latent chaleur flux
471	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: emis !! Emissivity
472
473	!! 0.3 Modified variables
474	REAL(r_std),DIMENSION (iim,jjm), INTENT(inout) :: cdrag !! Cdrag
475
476	!! 0.4 Local variables
477	REAL(r_std),DIMENSION (kjpindex) :: zu !! Work array to keep u
478	REAL(r_std),DIMENSION (kjpindex) :: zv !! Work array to keep v
479	REAL(r_std),DIMENSION (kjpindex) :: zzlev !! Work array to keep zlev
480	REAL(r_std),DIMENSION (kjpindex) :: zqair !! Work array to keep qair
481	REAL(r_std),DIMENSION (kjpindex) :: zprecip_rain !! Work array to keep precip_rain
482	REAL(r_std),DIMENSION (kjpindex) :: zprecip_snow !! Work array to keep precip_snow
483	REAL(r_std),DIMENSION (kjpindex) :: zlwdown !! Work array to keep lwdown
484	REAL(r_std),DIMENSION (kjpindex) :: zswnet !! Work array to keep swnet
485	REAL(r_std),DIMENSION (kjpindex) :: zswdown !! Work array to keep swdown
486	REAL(r_std),DIMENSION (kjpindex) :: zcoszang !! Work array to keep coszang
487	REAL(r_std),DIMENSION (kjpindex) :: ztemp_air !! Work array to keep temp_air
488	REAL(r_std),DIMENSION (kjpindex) :: zepot_air !! Work array to keep epot_air
489	REAL(r_std),DIMENSION (kjpindex) :: zccanopy !! Work array to keep ccanopy
490	REAL(r_std),DIMENSION (kjpindex) :: zpetAcoef !! Work array to keep petAcoef
491	REAL(r_std),DIMENSION (kjpindex) :: zpeqAcoef !! Work array to keep peqAcoef
492	REAL(r_std),DIMENSION (kjpindex) :: zpetBcoef !! Work array to keep petBcoef
493	REAL(r_std),DIMENSION (kjpindex) :: zpeqBcoef !! Work array to keep peqVcoef
494	REAL(r_std),DIMENSION (kjpindex) :: zcdrag !! Work array to keep cdrag
495	REAL(r_std),DIMENSION (kjpindex) :: zpb !! Work array to keep pb
496	REAL(r_std),DIMENSION (kjpindex) :: zz0m, zz0h !! Work array to keep zz0m, zz0h
497	REAL(r_std),DIMENSION (kjpindex,nvm) :: zveget !! Work array to keep veget
498	REAL(r_std),DIMENSION (kjpindex,nvm) :: zlai !! Work array to keep lai
499	REAL(r_std),DIMENSION (kjpindex,nvm) :: zheight !! Work array to keep height
500	REAL(r_std),DIMENSION (kjpindex) :: zcoastal !! Work array to keep coastalflow (m^3/dt)
501	REAL(r_std),DIMENSION (kjpindex) :: zriver !! Work array to keep riverflow (m^3/dt)
502	REAL(r_std),DIMENSION (kjpindex) :: znetco2 !! Work array to keep netco2flux (gC/m2/dt_sechiba)
503	REAL(r_std),DIMENSION (kjpindex) :: zcarblu !! Work array to keep fco2_land_use (gC/m2/one_day)
504	REAL(r_std),DIMENSION (kjpindex) :: ztsol_rad !! Work array to keep tsol_rad
505	REAL(r_std),DIMENSION (kjpindex) :: zvevapp !! Work array to keep vevapp
506	REAL(r_std),DIMENSION (kjpindex) :: ztemp_sol_new !! Work array to keep temp_sol_new
507	REAL(r_std),DIMENSION (kjpindex) :: zqsurf !! Work array to keep qsurf
508	REAL(r_std),DIMENSION (kjpindex,2) :: zalbedo !! Work array to keep albedo
509	REAL(r_std),DIMENSION (kjpindex) :: zfluxsens !! Work array to keep fluxsens
510	REAL(r_std),DIMENSION (kjpindex) :: zfluxlat !! Work array to keep fluxlat
511	REAL(r_std),DIMENSION (kjpindex) :: zemis !! Work array to keep emis
512	INTEGER(i_std) :: i, j, ik
513	INTEGER(i_std) :: ier
514	INTEGER(i_std) :: itau_sechiba
515	INTEGER :: old_fileout !! old Logical Int for std IO output
516
517	IF (printlev_loc >= 3) WRITE(numout,*) 'Start intersurf_main_2d'
518	CALL ipslnlf_p(new_number=numout,old_number=old_fileout)
519
520	!
521	! Shift the time step to phase the two models
522	!
523	itau_sechiba = kjit + itau_offset
524	!
525
526	! Update the calendar in xios by sending the new time step
527	CALL xios_orchidee_update_calendar(itau_sechiba)
528
529	! Update the calendar and all time variables in module time
530	CALL time_nextstep(itau_sechiba)
531	!
532	! 1. gather input fields from kindex array
533	! Warning : I'm not sure this interface with one dimension array is the good one
534	!
535	DO ik=1, kjpindex
536
537	j = ((kindex(ik)-1)/iim) + 1
538	i = (kindex(ik) - (j-1)*iim)
539
540	zu(ik) = u(i,j)
541	zv(ik) = v(i,j)
542	zzlev(ik) = zlev(i,j)
543	zqair(ik) = qair(i,j)
544	zprecip_rain(ik) = precip_rain(i,j)*xrdt
545	zprecip_snow(ik) = precip_snow(i,j)*xrdt
546	zlwdown(ik) = lwdown(i,j)
547	zswnet(ik) = swnet(i,j)
548	zswdown(ik) = swdown(i,j)
549	zcoszang(ik) = coszang(i,j)
550	ztemp_air(ik) = temp_air(i,j)
551	zepot_air(ik) = epot_air(i,j)
552	zccanopy(ik) = ccanopy(i,j)
553	zpetAcoef(ik) = petAcoef(i,j)
554	zpeqAcoef(ik) = peqAcoef(i,j)
555	zpetBcoef(ik) = petBcoef(i,j)
556	zpeqBcoef(ik) = peqBcoef(i,j)
557	zcdrag(ik) = cdrag(i,j)
558	zpb(ik) = pb(i,j)
559
560	ENDDO
561
562	!
563	! 3. call sechiba for continental points only
564	!
565	IF (printlev_loc >= 3) WRITE(numout,*) 'Before call to sechiba_main from intersurf_main_2d'
566
567	CALL sechiba_main (itau_sechiba, iim*jjm, kjpindex, kindex, &
568	lrestart_read, lrestart_write, &
569	lalo, contfrac, neighbours, resolution, &
570	zzlev, zu, zv, zqair, ztemp_air, zepot_air, zccanopy, &
571	zcdrag, zpetAcoef, zpeqAcoef, zpetBcoef, zpeqBcoef, &
572	zprecip_rain ,zprecip_snow, zlwdown, zswnet, zswdown, zcoszang, zpb, &
573	zvevapp, zfluxsens, zfluxlat, zcoastal, zriver, znetco2, zcarblu, &
574	ztsol_rad, ztemp_sol_new, zqsurf, zalbedo, zemis, zz0m, zz0h,&
575	zveget, zlai, zheight, &
576	rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC )
577
578	IF (printlev_loc >= 3) WRITE(numout,*) 'After call to sechiba_main'
579
580	!
581	! 5. scatter output fields
582	!
583	z0m(:,:) = undef_sechiba
584	coastalflow(:,:) = undef_sechiba
585	riverflow(:,:) = undef_sechiba
586	tsol_rad(:,:) = undef_sechiba
587	vevapp(:,:) = undef_sechiba
588	temp_sol_new(:,:) = undef_sechiba
589	qsurf(:,:) = undef_sechiba
590	albedo(:,:,:) = undef_sechiba
591	fluxsens(:,:) = undef_sechiba
592	fluxlat(:,:) = undef_sechiba
593	emis(:,:) = undef_sechiba
594	cdrag(:,:) = undef_sechiba
595	!
596	DO ik=1, kjpindex
597
598
599	j = ((kindex(ik)-1)/iim) + 1
600	i = (kindex(ik) - (j-1)*iim)
601
602	z0m(i,j) = zz0m(ik)
603	coastalflow(i,j) = zcoastal(ik)
604	riverflow(i,j) = zriver(ik)
605	tsol_rad(i,j) = ztsol_rad(ik)
606	vevapp(i,j) = zvevapp(ik)
607	temp_sol_new(i,j) = ztemp_sol_new(ik)
608	qsurf(i,j) = zqsurf(ik)
609	albedo(i,j,1) = zalbedo(ik,1)
610	albedo(i,j,2) = zalbedo(ik,2)
611	fluxsens(i,j) = zfluxsens(ik)
612	fluxlat(i,j) = zfluxlat(ik)
613	emis(i,j) = zemis(ik)
614	cdrag(i,j) = zcdrag(ik)
615
616	ENDDO
617
618	CALL xios_orchidee_send_field("LandPoints" ,(/ ( REAL(ik), ik=1,kjpindex ) /))
619	CALL xios_orchidee_send_field("areas", area)
620	CALL xios_orchidee_send_field("contfrac",contfrac)
621	CALL xios_orchidee_send_field("temp_air",ztemp_air)
622	CALL xios_orchidee_send_field("qair",zqair)
623	CALL xios_orchidee_send_field("swnet",zswnet)
624	CALL xios_orchidee_send_field("swdown",zswdown)
625	CALL xios_orchidee_send_field("pb",zpb)
626	CALL xios_orchidee_send_field("zcarblu",zcarblu/1e3/one_day) ! gC/m2/one_day -> kgC/m2/s
627	CALL xios_orchidee_send_field("znetco2",znetco2/1e3/dt_sechiba) ! gC/m2/dt_sechiba -> kgC/m2/s
628
629
630	IF ( .NOT. almaoutput ) THEN
631	!
632	! scattered during the writing
633	!
634	CALL histwrite_p (hist_id, 'evap', itau_sechiba, zvevapp, kjpindex, kindex)
635	CALL histwrite_p (hist_id, 'coastalflow',itau_sechiba, zcoastal, kjpindex, kindex)
636	CALL histwrite_p (hist_id, 'riverflow',itau_sechiba, zriver, kjpindex, kindex)
637	CALL histwrite_p (hist_id, 'temp_sol', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
638	CALL histwrite_p (hist_id, 'tsol_max', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
639	CALL histwrite_p (hist_id, 'tsol_min', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
640	CALL histwrite_p (hist_id, 'fluxsens', itau_sechiba, zfluxsens, kjpindex, kindex)
641	CALL histwrite_p (hist_id, 'fluxlat', itau_sechiba, zfluxlat, kjpindex, kindex)
642	CALL histwrite_p (hist_id, 'swnet', itau_sechiba, zswnet, kjpindex, kindex)
643	CALL histwrite_p (hist_id, 'swdown', itau_sechiba, zswdown, kjpindex, kindex)
644	CALL histwrite_p (hist_id, 'alb_vis', itau_sechiba, zalbedo(:,1), kjpindex, kindex)
645	CALL histwrite_p (hist_id, 'alb_nir', itau_sechiba, zalbedo(:,2), kjpindex, kindex)
646	CALL histwrite_p (hist_id, 'tair', itau_sechiba, ztemp_air, kjpindex, kindex)
647	CALL histwrite_p (hist_id, 'qair', itau_sechiba, zqair, kjpindex, kindex)
648	CALL histwrite_p (hist2_id, 'evap', itau_sechiba, zvevapp, kjpindex, kindex)
649	CALL histwrite_p (hist2_id, 'coastalflow',itau_sechiba, zcoastal, kjpindex, kindex)
650	CALL histwrite_p (hist2_id, 'riverflow',itau_sechiba, zriver, kjpindex, kindex)
651	CALL histwrite_p (hist2_id, 'temp_sol', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
652	CALL histwrite_p (hist2_id, 'tsol_max', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
653	CALL histwrite_p (hist2_id, 'tsol_min', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
654	CALL histwrite_p (hist2_id, 'fluxsens', itau_sechiba, zfluxsens, kjpindex, kindex)
655	CALL histwrite_p (hist2_id, 'fluxlat', itau_sechiba, zfluxlat, kjpindex, kindex)
656	CALL histwrite_p (hist2_id, 'swnet', itau_sechiba, zswnet, kjpindex, kindex)
657	CALL histwrite_p (hist2_id, 'swdown', itau_sechiba, zswdown, kjpindex, kindex)
658	CALL histwrite_p (hist2_id, 'alb_vis', itau_sechiba, zalbedo(:,1), kjpindex, kindex)
659	CALL histwrite_p (hist2_id, 'alb_nir', itau_sechiba, zalbedo(:,2), kjpindex, kindex)
660	CALL histwrite_p (hist2_id, 'tair', itau_sechiba, ztemp_air, kjpindex, kindex)
661	CALL histwrite_p (hist2_id, 'qair', itau_sechiba, zqair, kjpindex, kindex)
662	ELSE
663	CALL histwrite_p (hist_id, 'Evap', itau_sechiba, zvevapp, kjpindex, kindex)
664	CALL histwrite_p (hist_id, 'SWnet', itau_sechiba, zswnet, kjpindex, kindex)
665	CALL histwrite_p (hist_id, 'Qh', itau_sechiba, zfluxsens, kjpindex, kindex)
666	CALL histwrite_p (hist_id, 'Qle', itau_sechiba, zfluxlat, kjpindex, kindex)
667	CALL histwrite_p (hist_id, 'AvgSurfT', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
668	CALL histwrite_p (hist_id, 'RadT', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
669	CALL histwrite_p (hist_id, 'Tair', itau_sechiba, ztemp_air, kjpindex, kindex)
670	CALL histwrite_p (hist_id, 'Qair', itau_sechiba, zqair, kjpindex, kindex)
671	CALL histwrite_p (hist2_id, 'Evap', itau_sechiba, zvevapp, kjpindex, kindex)
672	CALL histwrite_p (hist2_id, 'SWnet', itau_sechiba, zswnet, kjpindex, kindex)
673	CALL histwrite_p (hist2_id, 'Qh', itau_sechiba, zfluxsens, kjpindex, kindex)
674	CALL histwrite_p (hist2_id, 'Qle', itau_sechiba, zfluxlat, kjpindex, kindex)
675	CALL histwrite_p (hist2_id, 'AvgSurfT', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
676	CALL histwrite_p (hist2_id, 'RadT', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
677	ENDIF
678	!
679	IF ( is_omp_root ) THEN
680	IF ( (dw .EQ. xrdt) .AND. hist_id > 0 ) THEN
681	! Syncronize output but only if flag ok_histsync is set to true
682	IF (ok_histsync) CALL histsync(hist_id)
683	ENDIF
684	END IF
685
686	!
687	! 6. Transform the water fluxes into Kg/m^2s and m^3/s
688	!
689	DO ik=1, kjpindex
690
691	j = ((kindex(ik)-1)/iim) + 1
692	i = (kindex(ik) - (j-1)*iim)
693
694	vevapp(i,j) = vevapp(i,j)/xrdt
695	coastalflow(i,j) = coastalflow(i,j)/xrdt
696	riverflow(i,j) = riverflow(i,j)/xrdt
697
698	ENDDO
699
700	CALL ipslnlf_p(new_number=old_fileout)
701	IF (printlev_loc >= 3) WRITE (numout,*) 'End intersurf_main_2d'
702
703	END SUBROUTINE intersurf_main_2d
704
705
706	!! =============================================================================================================================
707	!! SUBROUTINE: init_intersurf
708	!!
709	!>\BRIEF Initialize grid information
710	!!
711	!! DESCRIPTION: This subroutine is called from LMDZ before first call to intersurf_main_gathered or
712	!! intersurf_initialize_gathered
713	!!
714	!! \n
715	!_ ==============================================================================================================================
716
717	SUBROUTINE init_intersurf(nbp_l_lon,nbp_l_lat,kjpindex,kindex,orch_offset,orch_omp_size,orch_omp_rank,COMM, grid)
718
719	USE mod_orchidee_para
720	USE timer
721	IMPLICIT NONE
722
723	INTEGER,INTENT(IN) :: nbp_l_lon
724	INTEGER,INTENT(IN) :: nbp_l_lat
725	INTEGER,INTENT(IN) :: kjpindex
726	INTEGER,INTENT(IN) :: kindex(:)
727	INTEGER,INTENT(IN) :: orch_offset
728	INTEGER,INTENT(IN) :: COMM
729	INTEGER,INTENT(IN) :: orch_omp_size
730	INTEGER,INTENT(IN) :: orch_omp_rank
731	INTEGER(i_std), INTENT(in), OPTIONAL :: grid !! grid type : regular_lonlat or unstructured (dynamico)
732
733	INTEGER,DIMENSION(kjpindex) :: kindex_offset
734
735	IF (printlev >= 1) WRITE(,) 'Start ORCHIDEE'
736
737	IF (orch_omp_rank==0) THEN
738	CALL Init_timer
739	CALL start_timer(timer_mpi)
740	CALL grid_set_glo(nbp_l_lon,nbp_l_lat)
741	ENDIF
742	CALL barrier2_omp()
743	CALL init_orchidee_data_para(kjpindex,kindex,orch_offset,orch_omp_size,orch_omp_rank,COMM)
744	CALL Set_stdout_file('out_orchidee')
745
746	IF (printlev >= 1) WRITE(numout,*) 'Start ORCHIDEE intitalization phase'
747
748	IF (is_omp_root) THEN
749	IF (PRESENT(grid)) THEN
750	IF (grid==unstructured) THEN
751	CALL grid_allocate_glo(6)
752	ELSE
753	CALL grid_allocate_glo(4)
754	END IF
755	ELSE
756	CALL grid_allocate_glo(4)
757	END IF
758	ENDIF
759
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
781
782	END SUBROUTINE init_intersurf
783
784	!! =============================================================================================================================
785	!! SUBROUTINE: intersurf_initialize_gathered
786	!!
787	!>\BRIEF Initialization and call to sechiba_initialize
788	!!
789	!! DESCRIPTION: Initialization of module variables, read options from parameter file, initialize output files and call to
790	!! sechiba_initialize.
791	!!
792	!! This subroutine can be called directly from GCM(LMDZ). If it is not called before the first call to
793	!! intersurf_main_gathered, then it will be done from there. This possibility is done to keep backward
794	!! compatibility with LMDZ.
795	!!
796	!! \n
797	!_ ==============================================================================================================================
798
799	SUBROUTINE intersurf_initialize_gathered (kjit, iim_glo, jjm_glo, kjpindex, kindex, xrdt, &
800	lrestart_read, lrestart_write, latlon, zcontfrac, zneighbours, zresolution, date0, &
801	zlev, u, v, qair, temp_air, epot_air, &
802	cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
803	precip_rain, precip_snow, lwdown, swnet, swdown, pb, &
804	vevapp, fluxsens, fluxlat, coastalflow_cpl, riverflow_cpl, &
805	tsol_rad, temp_sol_new, qsurf, albedo, emis, z0m, lon_scat_g, lat_scat_g, &
806	q2m, t2m, z0h, nvm_out, &
807	field_out_names, field_in_names, &
808	grid, bounds_latlon, cell_area, ind_cell_glo)
809
810	USE mod_orchidee_para
811	IMPLICIT NONE
812
813	!! 0. Variable and parameter declaration
814	!! 0.1 Input
815	INTEGER(i_std),INTENT (in) :: kjit !! Time step number
816	INTEGER(i_std),INTENT (in) :: iim_glo !! Dimension of global fields
817	INTEGER(i_std),INTENT (in) :: jjm_glo !! Dimension of global fields
818	INTEGER(i_std),INTENT (in) :: kjpindex !! Number of continental points
819	REAL(r_std),INTENT (in) :: xrdt !! Time step in seconds
820	LOGICAL, INTENT (in) :: lrestart_read !! Logical for _restart_ file to read
821	LOGICAL, INTENT (in) :: lrestart_write !! Logical for _restart_ file to write'
822	REAL(r_std), INTENT (in) :: date0 !! Date at which kjit = 0
823	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: kindex !! Index for continental points
824	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: u !! Lowest level wind speed
825	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: v !! Lowest level wind speed
826	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: zlev !! Height of first layer
827	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: qair !! Lowest level specific humidity
828	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: precip_rain !! Rain precipitation
829	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: precip_snow !! Snow precipitation
830	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: lwdown !! Down-welling long-wave flux
831	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: swnet !! Net surface short-wave flux
832	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: swdown !! Downwelling surface short-wave flux
833	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: temp_air !! Air temperature in Kelvin
834	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: epot_air !! Air potential energy
835	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: petAcoef !! Coeficients A from the PBL resolution
836	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: peqAcoef !! One for T and another for q
837	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: petBcoef !! Coeficients B from the PBL resolution
838	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: peqBcoef !! One for T and another for q
839	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: pb !! Surface pressure
840	REAL(r_std),DIMENSION (:,:), INTENT(in) :: latlon !! Geographical coordinates, this variable has different dimension when using grid unstructured
841	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: zcontfrac !! Fraction of continent
842	INTEGER(i_std),DIMENSION (kjpindex,NbNeighb), INTENT(in):: zneighbours !! neighbours
843	REAL(r_std),DIMENSION (kjpindex,2), INTENT(in) :: zresolution !! size of the grid box
844	REAL(r_std),DIMENSION (iim_glo,jjm_glo), INTENT(IN) :: lon_scat_g !! Longitudes on the global 2D grid including ocean
845	REAL(r_std),DIMENSION (iim_glo,jjm_glo), INTENT(IN) :: lat_scat_g !! Latitudes on the global 2D grid including ocean
846
847	!! 0.2 Output variables
848	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: z0m !! Surface roughness (momentum)
849	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: coastalflow_cpl!! Diffuse flow of water into the ocean (m^3/s)
850	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: riverflow_cpl !! Largest rivers flowing into the ocean (m^3/s)
851	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: tsol_rad !! Radiative surface temperature
852	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: vevapp !! Total of evaporation
853	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: temp_sol_new !! New soil temperature
854	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: qsurf !! Surface specific humidity
855	REAL(r_std),DIMENSION (kjpindex,2), INTENT(out) :: albedo !! Albedo
856	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: fluxsens !! Sensible chaleur flux
857	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: fluxlat !! Latent chaleur flux
858	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: emis !! Emissivity
859
860	!! 0.3 Modified variables
861	REAL(r_std),DIMENSION (kjpindex), INTENT(inout) :: cdrag !! Cdrag
862
863	!! 0.4 Optional input and output variables
864	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
865	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
866	REAL(r_std),DIMENSION (kjpindex), INTENT(out),OPTIONAL :: z0h !! Surface roughness (heat)
867	INTEGER(i_std), INTENT(out), OPTIONAL :: nvm_out !! Number of vegetation types, PFTs
868	CHARACTER(LEN=*),DIMENSION(:), OPTIONAL, INTENT(IN) :: field_out_names!! Name of optional fields sent to LMDZ (fields_out), for ESM configuration
869	CHARACTER(LEN=*),DIMENSION(:), OPTIONAL, INTENT(IN) :: field_in_names !! Name of optional fields received from LMDZ (fields_in), for ESM configuration
870	INTEGER(i_std) , INTENT(in), OPTIONAL :: grid !! grid type : regular_lonlat or unstructured (dynamico)
871	REAL(r_std),DIMENSION (:,:,:) , INTENT(in), OPTIONAL :: bounds_latlon !! boundaries Geographical coordinates
872	REAL(r_std),DIMENSION (kjpindex), INTENT(in), OPTIONAL :: cell_area !! cell area
873	INTEGER(i_std),DIMENSION (:) , INTENT(in), OPTIONAL :: ind_cell_glo !! cell order (for XIOS)
874
875
876	!! 0.5 Local variables
877	REAL(r_std),DIMENSION (kjpindex) :: zprecip_rain !! Work array to keep precip_rain
878	REAL(r_std),DIMENSION (kjpindex) :: zprecip_snow !! Work array to keep precip_snow
879	REAL(r_std),DIMENSION (kjpindex) :: zz0m !! Work array to keep zz0m
880	REAL(r_std),DIMENSION (kjpindex) :: zz0h !! Work array to keep zz0h
881	REAL(r_std),DIMENSION (kjpindex) :: zcdrag !! Work array for surface drag
882	REAL(r_std),DIMENSION (kjpindex) :: zcoastal !! Work array to keep coastal flow
883	REAL(r_std),DIMENSION (kjpindex) :: zriver !! Work array to keep river out flow
884	REAL(r_std),DIMENSION (kjpindex) :: znetco2 !! Work array to keep netco2flux (gC/m2/dt_sechiba)
885	REAL(r_std),DIMENSION (kjpindex) :: zcarblu !! Work array to keep fco2_land_use (gC/m2/one_day)
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
895	INTEGER(i_std) :: ier
896	INTEGER(i_std) :: itau_sechiba
897	INTEGER(i_std) :: grid_loc !! Local variable for grid type
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.
900	INTEGER :: old_fileout !! old Logical Int for std IO output
901	REAL,ALLOCATABLE,DIMENSION(:,:) :: lalo_mpi
902	REAL(r_std),DIMENSION (kjpindex) :: landpoints !! Land point vector
903	REAL(r_std) :: tau_outflow !! Number of days for temoral filter on river- and coastalflow
904
905
906	! Initialize specific write level
907	printlev_loc=get_printlev('instersurf')
908
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
912	OFF_LINE_MODE = .FALSE.
913	CALL ipslnlf_p(new_number=numout, old_number=old_fileout)
914
915	! Initialize variables in module time
916	CALL time_initialize( kjit, date0, xrdt, "END" )
917
918	! Configuration of SSL specific parameters
919	CALL control_initialize
920
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'
948	CALL grid_init ( kjpindex, 4, regular_lonlat, "2DGrid" )
949	ENDIF
950
951
952	!
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	!
968	IF (grid_type==regular_lonlat) area(:) = resolution(:,1)*resolution(:,2)
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
986
987
988	IF (is_omp_root) THEN
989	! Extract from global variables the longitudes and latitudes
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)
993
994	! Save the global variables only on mpi root, to be used in other modules
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	!
1025	CALL xios_orchidee_init( MPI_COMM_ORCH, &
1026	date0, year_end, month_end, day_end, julian_diff, &
1027	tmp_lon, tmp_lat, znt )
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
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)
1044
1045	!
1046	!! Change to be in the orchidee context for XIOS
1047	!
1048	CALL xios_orchidee_change_context("orchidee")
1049
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
1069
1070
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)
1099	ENDIF
1100	ENDIF
1101	!
1102
1103	!
1104	! 4. call sechiba for continental points only
1105	!
1106	IF ( printlev_loc>=3 ) WRITE(numout,*) 'Before call to sechiba_initialize'
1107
1108	CALL sechiba_initialize( &
1109	itau_sechiba, iim_g*jj_nb, kjpindex, kindex, &
1110	lalo, contfrac, neighbours, resolution, zlev, &
1111	u, v, qair, temp_air, &
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, &
1117	zz0m, zz0h, zalbedo, zfluxsens, zfluxlat, zemis, &
1118	znetco2, zcarblu, ztemp_sol_new, zcdrag)
1119
1120	IF ( printlev_loc>=3 ) WRITE(numout,*) 'After call to sechiba_initialize'
1121
1122	!
1123	! 6. scatter output fields
1124	!
1125	DO ik=1, kjpindex
1126	z0m(ik) = zz0m(ik)
1127	tsol_rad(ik) = ztsol_rad(ik)
1128	vevapp(ik) = zvevapp(ik)/xrdt ! Transform into kg/m^2/s
1129	temp_sol_new(ik) = ztemp_sol_new(ik)
1130	qsurf(ik) = zqsurf(ik)
1131	albedo(ik,1) = zalbedo(ik,1)
1132	albedo(ik,2) = zalbedo(ik,2)
1133	fluxsens(ik) = zfluxsens(ik)
1134	fluxlat(ik) = zfluxlat(ik)
1135	emis(ik) = zemis(ik)
1136	cdrag(ik) = zcdrag(ik)
1137	ENDDO
1138
1139	! z0h is a optional output variable. Check first if it is present in the call from LMDZ.
1140	IF ( PRESENT(z0h) ) z0h(:) = zz0h(:)
1141
1142
1143	!
1144	! 7. Count optional fields for the coupling with LMDZ, used in the ESM configuration
1145	!
1146	! Treat fields sent to LMDZ
1147	IF (PRESENT(field_out_names)) THEN
1148	nbcf_from_LMDZ=SIZE(field_out_names)
1149	ALLOCATE(field_out_names_loc(nbcf_from_LMDZ), stat=ier)
1150	IF (ier /= 0) CALL ipslerr_p(3,'intersurf_initialized_gathered', 'Error in allocation of field_out_names_loc','','')
1151	field_out_names_loc=field_out_names
1152	ELSE
1153	nbcf_from_LMDZ=0
1154	ENDIF
1155
1156	! Treat fields received from LMDZ
1157	IF (PRESENT(field_in_names)) THEN
1158	nbcf_into_LMDZ=SIZE(field_in_names)
1159	ALLOCATE(field_in_names_loc(nbcf_into_LMDZ), stat=ier)
1160	IF (ier /= 0) CALL ipslerr_p(3,'intersurf_initialized_gathered', 'Error in allocation of field_in_names_loc','','')
1161	field_in_names_loc=field_in_names
1162
1163	! Coherence test: veget_update>0 needed for fCO2_fLuc and fCO2_nbp
1164	DO i = 1, nbcf_into_LMDZ
1165	IF ((field_in_names_loc(i) == 'fCO2_fLuc') .OR. (field_in_names_loc(i) == 'fCO2_nbp')) THEN
1166	IF (veget_update .LE. 0) THEN
1167	CALL ipslerr_p(3,'intersurf_initialize_gathered', &
1168	'Error in set up. VEGET_UPDATE must be > 0 when using the field: '//TRIM(field_in_names_loc(i)),'','')
1169	END IF
1170	END IF
1171	END DO
1172	ELSE
1173	nbcf_into_LMDZ=0
1174	ENDIF
1175	IF ( printlev_loc>=2 ) THEN
1176	WRITE(numout,*) 'intersurf_initialized_gathered --- nbcf_from_LMDZ, nbcf_into_LMDZ = ',nbcf_from_LMDZ, nbcf_into_LMDZ
1177	IF (nbcf_into_LMDZ > 0) THEN
1178	WRITE(numout,*) 'intersurf_initialized_gathered --- field_in_names_loc = ', field_in_names_loc
1179	END IF
1180	IF (nbcf_from_LMDZ > 0) THEN
1181	WRITE(numout,*) 'intersurf_initialized_gathered --- field_out_names_loc = ', field_out_names_loc
1182	END IF
1183	END IF
1184
1185	!
1186	! 8. Distribution of coastal- and riverflow on several time steps
1187	!
1188	!Config Key = TAU_OUTFLOW
1189	!Config Desc = Number of days over which the coastal- and riverflow will be distributed
1190	!Config If = Only in coupled mode
1191	!Config Def = 0
1192	!Config Help = The default value 0 makes the distribution instanteneous
1193	!Config Units = [days]
1194	tau_outflow = 0
1195	CALL getin_p('TAU_OUTFLOW',tau_outflow)
1196	IF (tau_outflow <=xrdt/one_day) THEN
1197	coeff_rel = 1.0
1198	ELSE
1199	coeff_rel = (1.0 - exp(-xrdt/(tau_outflow*one_day)))
1200	END IF
1201	IF (printlev_loc >=2) WRITE(numout,*),'tau_outflow, coeff_rel = ', tau_outflow, coeff_rel
1202
1203	! Allocate and read riverflow_cpl0 from restart file. Initialize to 0 if the variable was not found in the restart file.
1204	ALLOCATE(riverflow_cpl0(kjpindex), stat=ier)
1205	IF (ier /= 0) CALL ipslerr_p(3,'intersurf_initialize_gathered', 'Error in allocation of riverflow_cpl0','','')
1206	CALL restget_p (rest_id, 'riverflow_cpl0', nbp_glo, 1, 1, kjit, .TRUE., riverflow_cpl0, "gather", nbp_glo, index_g)
1207	IF ( ALL(riverflow_cpl0(:) == val_exp) ) riverflow_cpl0(:)=0
1208
1209	! Allocate and read coastalflow_cpl0 from restart file. Initialize to 0 if the variable was not found in the restart file.
1210	ALLOCATE(coastalflow_cpl0(kjpindex), stat=ier)
1211	IF (ier /= 0) CALL ipslerr_p(3,'intersurf_initialize_gathered', 'Error in allocation of coastalflow_cpl0','','')
1212	CALL restget_p (rest_id, 'coastalflow_cpl0', nbp_glo, 1, 1, kjit, .TRUE., coastalflow_cpl0, "gather", nbp_glo, index_g)
1213	IF ( ALL(coastalflow_cpl0(:) == val_exp) ) coastalflow_cpl0(:)=0
1214
1215	! Do not applay the filter now in initialization phase.
1216	! These variables will never be used anyway in the initialization phase.
1217	! Transform into m^3/s
1218	riverflow_cpl = zriver/xrdt
1219	coastalflow_cpl = zcoastal/xrdt
1220
1221	!
1222	! 9.
1223	!
1224	! Copy the number of vegetation types to local output variable
1225	IF (PRESENT(nvm_out)) nvm_out=nvm
1226
1227	IF(is_root_prc) CALL getin_dump
1228	lstep_init_intersurf = .FALSE.
1229
1230	CALL ipslnlf_p(new_number=old_fileout)
1231	!
1232	!! Change back to be in the LMDZ context for XIOS
1233	!
1234	CALL xios_orchidee_change_context("LMDZ")
1235
1236	IF (printlev_loc >= 2) WRITE (numout,*) 'End intersurf_initialize_gathered'
1237	IF (printlev_loc >= 1) WRITE (numout,*) 'Initialization phase for ORCHIDEE is finished.'
1238
1239	END SUBROUTINE intersurf_initialize_gathered
1240
1241
1242	!! =============================================================================================================================
1243	!! SUBROUTINE: intersurf_main_gathered
1244	!!
1245	!>\BRIEF Main subroutine to call ORCHIDEE from the gcm (LMDZ) using variables on a 1D grid with only land points.
1246	!!
1247	!! DESCRIPTION: This subroutine is the main interface for ORCHIDEE when it is called from the gcm (LMDZ).
1248	!! The variables are all gathered before entering this subroutine on the 1D grid with only landpoints.
1249	!!
1250	!! \n
1251	!_ ==============================================================================================================================
1252
1253	SUBROUTINE intersurf_main_gathered (kjit, iim_glo, jjm_glo, kjpindex, kindex, xrdt, &
1254	lrestart_read, lrestart_write, latlon, zcontfrac, zneighbours, zresolution, date0, &
1255	zlev, u, v, qair, temp_air, epot_air, ccanopy, &
1256	cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
1257	precip_rain, precip_snow, lwdown, swnet, swdown, pb, &
1258	vevapp, fluxsens, fluxlat, coastalflow_cpl, riverflow_cpl, &
1259	tsol_rad, temp_sol_new, qsurf, albedo, emis, z0m,lon_scat_g, lat_scat_g, q2m, t2m, z0h, &
1260	veget, lai, height, &
1261	fields_out, fields_in, &
1262	coszang)
1263
1264	USE mod_orchidee_para
1265	IMPLICIT NONE
1266
1267	!! 0. Variable and parameter declaration
1268	!! 0.1 Input variables
1269	INTEGER(i_std),INTENT (in) :: kjit !! Time step number
1270	INTEGER(i_std),INTENT (in) :: iim_glo !! Dimension of global fields
1271	INTEGER(i_std),INTENT (in) :: jjm_glo !! Dimension of global fields
1272	INTEGER(i_std),INTENT (in) :: kjpindex !! Number of continental points
1273	REAL(r_std),INTENT (in) :: xrdt !! Time step in seconds
1274	LOGICAL, INTENT (in) :: lrestart_read !! Logical for _restart_ file to read
1275	LOGICAL, INTENT (in) :: lrestart_write !! Logical for _restart_ file to write'
1276	REAL(r_std), INTENT (in) :: date0 !! Date at which kjit = 0
1277	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: kindex !! Index for continental points
1278	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: u !! Lowest level wind speed
1279	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: v !! Lowest level wind speed
1280	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: zlev !! Height of first layer
1281	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: qair !! Lowest level specific humidity
1282	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: precip_rain !! Rain precipitation
1283	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: precip_snow !! Snow precipitation
1284	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: lwdown !! Down-welling long-wave flux
1285	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: swnet !! Net surface short-wave flux
1286	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: swdown !! Downwelling surface short-wave flux
1287	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: temp_air !! Air temperature in Kelvin
1288	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: epot_air !! Air potential energy
1289	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: ccanopy !! CO2 concentration in the canopy
1290	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: petAcoef !! Coeficients A from the PBL resolution
1291	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: peqAcoef !! One for T and another for q
1292	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: petBcoef !! Coeficients B from the PBL resolution
1293	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: peqBcoef !! One for T and another for q
1294	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: pb !! Surface pressure
1295	REAL(r_std),DIMENSION (:,:) , INTENT(in) :: latlon !! Geographical coordinates
1296	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: zcontfrac !! Fraction of continent
1297	INTEGER(i_std),DIMENSION (:,:), INTENT(in) :: zneighbours !! neighbours
1298	REAL(r_std),DIMENSION (kjpindex,2), INTENT(in) :: zresolution !! size of the grid box
1299	REAL(r_std),DIMENSION (iim_glo,jjm_glo), INTENT(IN) :: lon_scat_g !! The scattered values for longitude
1300	REAL(r_std),DIMENSION (iim_glo,jjm_glo), INTENT(IN) :: lat_scat_g !! The scattered values for latitude
1301
1302	!! 0.2 Output variables
1303	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: z0m !! Surface roughness for momentum
1304	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: coastalflow_cpl !! Diffuse flow of water into the ocean, time filtered (m^3/s)
1305	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: riverflow_cpl !! Largest rivers flowing into the ocean, time filtered (m^3/s)
1306	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: tsol_rad !! Radiative surface temperature
1307	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: vevapp !! Total of evaporation
1308	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: temp_sol_new !! New soil temperature
1309	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: qsurf !! Surface specific humidity
1310	REAL(r_std),DIMENSION (kjpindex,2), INTENT(out) :: albedo !! Albedo
1311	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: fluxsens !! Sensible chaleur flux
1312	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: fluxlat !! Latent chaleur flux
1313	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: emis !! Emissivity
1314
1315	!! 0.3 Modified variables
1316	REAL(r_std),DIMENSION (kjpindex), INTENT(inout) :: cdrag !! Cdrag
1317
1318	!! 0.4 Optional input and output variables
1319	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
1320	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
1321	REAL(r_std),DIMENSION (kjpindex), INTENT(out),OPTIONAL:: z0h !! Surface roughness for heat
1322	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(out), OPTIONAL :: veget !! Fraction of vegetation type (unitless, 0-1)
1323	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(out), OPTIONAL :: lai !! Leaf area index (m^2 m^{-2}
1324	REAL(r_std),DIMENSION (kjpindex,nvm), INTENT(out), OPTIONAL :: height !! Vegetation Height (m)
1325	REAL(r_std), DIMENSION(kjpindex), OPTIONAL, INTENT(in):: coszang !! Cosine of the solar zenith angle (unitless)
1326	REAL(r_std),DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: fields_in !! Optional fields sent to LMDZ, for ESM configuration
1327	REAL(r_std),DIMENSION(:,:), OPTIONAL, INTENT(IN) :: fields_out !! Optional fields received from LMDZ, for ESM configuration
1328
1329
1330	!! 0.5 Local variables
1331	REAL(r_std),DIMENSION (kjpindex) :: zccanopy !! Work array to keep ccanopy
1332	REAL(r_std),DIMENSION (kjpindex) :: zprecip_rain !! Work array to keep precip_rain
1333	REAL(r_std),DIMENSION (kjpindex) :: zprecip_snow !! Work array to keep precip_snow
1334	REAL(r_std),DIMENSION (kjpindex) :: zz0m, zz0h !! Work array to keep zz0m, zz0h
1335	REAL(r_std),DIMENSION (kjpindex) :: zcdrag !! Work array for surface drag
1336	REAL(r_std),DIMENSION (kjpindex) :: zcoastal !! Work array to keep coastal flow
1337	REAL(r_std),DIMENSION (kjpindex) :: zriver !! Work array to keep river out flow
1338	REAL(r_std),DIMENSION (kjpindex) :: znetco2 !! Work array to keep netco2flux (gC/m2/dt_sechiba)
1339	REAL(r_std),DIMENSION (kjpindex) :: zcarblu !! Work array to keep fco2_land_use (gC/m2/one_day)
1340	REAL(r_std),DIMENSION (kjpindex) :: ztsol_rad !! Work array to keep tsol_rad
1341	REAL(r_std),DIMENSION (kjpindex) :: zvevapp !! Work array to keep vevapp
1342	REAL(r_std),DIMENSION (kjpindex) :: ztemp_sol_new !! Work array to keep temp_sol_new
1343	REAL(r_std),DIMENSION (kjpindex) :: zqsurf !! Work array to keep qsurf
1344	REAL(r_std),DIMENSION (kjpindex,2) :: zalbedo !! Work array to keep albedo
1345	REAL(r_std),DIMENSION (kjpindex) :: zfluxsens !! Work array to keep fluxsens
1346	REAL(r_std),DIMENSION (kjpindex) :: zfluxlat !! Work array to keep fluxlat
1347	REAL(r_std),DIMENSION (kjpindex) :: zemis !! Work array to keep emis
1348	REAL(r_std),DIMENSION (kjpindex) :: zcoszang !! Work array to keep coszang
1349	REAL(r_std),DIMENSION (kjpindex,nvm) :: zveget !! Work array to keep veget
1350	REAL(r_std),DIMENSION (kjpindex,nvm) :: zlai !! Work array to keep lai
1351	REAL(r_std),DIMENSION (kjpindex,nvm) :: zheight !! Work array to keep height
1352	INTEGER(i_std) :: i, j, ik
1353	INTEGER(i_std) :: ier
1354	INTEGER(i_std) :: itau_sechiba
1355	INTEGER :: old_fileout !! old Logical Int for std IO output
1356	REAL,ALLOCATABLE,DIMENSION(:,:) :: lalo_mpi
1357	REAL(r_std),DIMENSION (kjpindex) :: landpoints !! Local landpoints vector
1358
1359	IF (printlev_loc >= 3) WRITE(numout,*) 'Start intersurf_main_gathered'
1360	CALL ipslnlf_p(new_number=numout, old_number=old_fileout)
1361
1362	IF (lstep_init_intersurf) THEN
1363	! intersurf_initialize_gathered was not yet called. An old version of
1364	! LMDZ is used. Now prepare and call intersurf_initialize_gathered
1365
1366	CALL intersurf_initialize_gathered (kjit, iim_glo, jjm_glo, kjpindex, kindex, xrdt, &
1367	lrestart_read, lrestart_write, latlon, zcontfrac, zneighbours, zresolution, date0, &
1368	zlev, u, v, qair, temp_air, epot_air, &
1369	cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
1370	precip_rain, precip_snow, lwdown, swnet, swdown, pb, &
1371	vevapp, fluxsens, fluxlat, coastalflow_cpl, riverflow_cpl, &
1372	tsol_rad, temp_sol_new, qsurf, albedo, emis, z0m,lon_scat_g, lat_scat_g, &
1373	zz0h)
1374
1375	! z0h is a optional output variable. Check first if it is present in the call from LMDZ.
1376	IF ( PRESENT(z0h) ) z0h(:) = zz0h(:)
1377	! Return from subroutine intersurf_main_gathered
1378	RETURN
1379	END IF
1380
1381	!
1382	!! Change to be in the orchidee context for XIOS
1383	!
1384	CALL xios_orchidee_change_context("orchidee")
1385
1386	!
1387	! Shift the time step to phase the two models
1388	!
1389	itau_sechiba = kjit + itau_offset
1390
1391	! Update the calendar in xios by sending the new time step
1392	CALL xios_orchidee_update_calendar(itau_sechiba)
1393
1394	! Update the calendar and all time variables in module time
1395	CALL time_nextstep(itau_sechiba)
1396
1397	!
1398	! 1. Just change the units of some input fields
1399	!
1400	DO ik=1, kjpindex
1401
1402	zprecip_rain(ik) = precip_rain(ik)*xrdt
1403	zprecip_snow(ik) = precip_snow(ik)*xrdt
1404	zcdrag(ik) = cdrag(ik)
1405
1406	ENDDO
1407
1408	!>> VOC in coupled mode
1409	IF ( PRESENT(coszang) ) THEN
1410	zcoszang(:) = coszang(:)
1411	ELSE
1412	zcoszang(:) = zero
1413	ENDIF
1414
1415	! Optional fields received from LMDZ, for ESM configuration
1416	! No fields are currently received from LMDZ
1417	DO i = 1, nbcf_from_LMDZ
1418	SELECT CASE(TRIM(field_out_names_loc(i)))
1419	! CASE("...")
1420	! Things to do for this case...
1421	CASE("atmco2")
1422	IF (printlev_loc > 4) WRITE(numout,*) &
1423	'Retreive the atmco2 field, in this case equal to fields_out(:,i)=ccanopy(:)'
1424	CASE DEFAULT
1425	CALL ipslerr_p (3,'intersurf_main_gathered', &
1426	'The selected field received from LMDZ '//TRIM(field_out_names_loc(i))//' is not implemented.','','')
1427	END SELECT
1428	ENDDO
1429
1430	!
1431	! 2. modification of co2
1432	!
1433	IF ( fatmco2 ) THEN
1434	zccanopy(:) = atmco2
1435	WRITE (numout,*) 'Modification of the ccanopy value. CO2 = ',atmco2
1436	ELSE
1437	zccanopy(:) = ccanopy(:)
1438	ENDIF
1439
1440	!
1441	! 4. call sechiba for continental points only
1442	!
1443	IF ( printlev_loc >= 3 ) WRITE(numout,*) 'Before call to sechiba_main from intersurf_main_gathered'
1444
1445
1446	CALL sechiba_main (itau_sechiba, iim_g*jj_nb, kjpindex, kindex, &
1447	lrestart_read, lrestart_write, &
1448	lalo, contfrac, neighbours, resolution, &
1449	zlev, u, v, qair, temp_air, epot_air, zccanopy, &
1450	zcdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
1451	zprecip_rain ,zprecip_snow, lwdown, swnet, swdown, zcoszang, pb, &
1452	zvevapp, zfluxsens, zfluxlat, zcoastal, zriver, znetco2, zcarblu, &
1453	ztsol_rad, ztemp_sol_new, zqsurf, zalbedo, zemis, zz0m, zz0h, &
1454	zveget, zlai, zheight, &
1455	rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC )
1456
1457	IF ( printlev_loc>=3 ) WRITE(numout,*) 'After call to sechiba_main'
1458
1459	!
1460	! 6. scatter output fields
1461	!
1462	DO ik=1, kjpindex
1463	z0m(ik) = zz0m(ik)
1464	tsol_rad(ik) = ztsol_rad(ik)
1465	temp_sol_new(ik) = ztemp_sol_new(ik)
1466	qsurf(ik) = zqsurf(ik)
1467	albedo(ik,1) = zalbedo(ik,1)
1468	albedo(ik,2) = zalbedo(ik,2)
1469	fluxsens(ik) = zfluxsens(ik)
1470	fluxlat(ik) = zfluxlat(ik)
1471	emis(ik) = zemis(ik)
1472	cdrag(ik) = zcdrag(ik)
1473	! Transform the water fluxes into Kg/m^2/s
1474	vevapp(ik) = zvevapp(ik)/xrdt
1475	ENDDO
1476
1477	! Copy variables only if the optional variables are present in the call to the subroutine
1478	IF (PRESENT(veget)) veget(:,:) = zveget(:,:)
1479	IF (PRESENT(lai)) lai(:,:) = zlai(:,:)
1480	IF (PRESENT(height)) height(:,:) = zheight(:,:)
1481
1482
1483	!
1484	! 7. Set variables to be sent to LMDZ, for ESM configuration
1485	! field_in_names_loc should be consitent with the names used in coupling_fields.def read by LMDZ
1486	!
1487	IF (nbcf_into_LMDZ.GT.0) THEN
1488	DO ik=1, kjpindex
1489	DO i = 1, nbcf_into_LMDZ
1490	SELECT CASE(TRIM(field_in_names_loc(i)))
1491	CASE("fCO2_nep")
1492	! Transform from gC/m2/dt_sechiba into kgC/m2/s
1493	fields_in(ik,i) = znetco2(ik)/1e3/dt_sechiba
1494	CASE("fCO2_fLuc")
1495	! Transform from gC/m2/one_day into kgC/m2/s
1496	fields_in(ik,i) = zcarblu(ik)/1e3/one_day
1497	CASE("fCO2_nbp")
1498	fields_in(ik,i) = znetco2(ik)/1e3/dt_sechiba + zcarblu(ik)/1e3/one_day
1499	CASE DEFAULT
1500	CALL ipslerr_p (3,'intersurf_main_gathered', &
1501	'The selected field to be sent to LMDZ '//TRIM(field_in_names_loc(i))//' is not yet implemented.','','')
1502	END SELECT
1503	END DO
1504	ENDDO
1505	END IF
1506
1507
1508	! Applay time filter to distribut the river- and coastalflow over a longer time period.
1509	! When coeff_rel=1(default case when tau_outflow=0), the distribution is instanteneous.
1510	! Use TAU_OUTFLOW in run.def to set the number of days of distribution.
1511	! The water fluxes zriver and zcoastal coming from sechiba are at the same time transfromed
1512	! from m^3/dt_sechiba into m^3/s by dividing with the sechiba time step (xrdt).
1513	riverflow_cpl = coeff_relzriver/xrdt + (1.-coeff_rel)riverflow_cpl0
1514	riverflow_cpl0 = riverflow_cpl
1515
1516	coastalflow_cpl = coeff_relzcoastal/xrdt + (1.-coeff_rel)coastalflow_cpl0
1517	coastalflow_cpl0 = coastalflow_cpl
1518
1519
1520	! z0h is a optional output variable. Check first if it is present in the call from LMDZ.
1521	IF ( PRESENT(z0h) ) z0h(:) = zz0h(:)
1522
1523	CALL xios_orchidee_send_field("LandPoints" ,(/ ( REAL(ik), ik=1,kjpindex ) /))
1524	CALL xios_orchidee_send_field("areas", area)
1525	CALL xios_orchidee_send_field("contfrac",contfrac)
1526	CALL xios_orchidee_send_field("temp_air",temp_air)
1527	CALL xios_orchidee_send_field("qair",qair)
1528	CALL xios_orchidee_send_field("swnet",swnet)
1529	CALL xios_orchidee_send_field("swdown",swdown)
1530	CALL xios_orchidee_send_field("pb",pb)
1531	CALL xios_orchidee_send_field("riverflow_cpl",riverflow_cpl)
1532	CALL xios_orchidee_send_field("coastalflow_cpl",coastalflow_cpl)
1533	CALL xios_orchidee_send_field("zcarblu",zcarblu/1e3/one_day) ! gC/m2/one_day -> kgC/m2/s
1534	CALL xios_orchidee_send_field("znetco2",znetco2/1e3/dt_sechiba) ! gC/m2/dt_sechiba -> kgC/m2/s
1535
1536	IF ( .NOT. almaoutput ) THEN
1537	!
1538	! scattered during the writing
1539	!
1540	CALL histwrite_p (hist_id, 'evap', itau_sechiba, zvevapp, kjpindex, kindex)
1541	CALL histwrite_p (hist_id, 'coastalflow',itau_sechiba, zcoastal, kjpindex, kindex)
1542	CALL histwrite_p (hist_id, 'riverflow',itau_sechiba, zriver, kjpindex, kindex)
1543	CALL histwrite_p (hist_id, 'temp_sol', itau_sechiba, ztemp_sol_new, kjpindex, kindex)
1544	CALL histwrite_p (hist_id, 'tsol_max', itau_sechiba, ztemp_sol_new, kjpindex, kindex)
1545	CALL histwrite_p (hist_id, 'tsol_min', itau_sechiba, ztemp_sol_new, kjpindex, kindex)
1546	CALL histwrite_p (hist_id, 'fluxsens', itau_sechiba, zfluxsens, kjpindex, kindex)
1547	CALL histwrite_p (hist_id, 'fluxlat', itau_sechiba, zfluxlat, kjpindex, kindex)
1548	CALL histwrite_p (hist_id, 'swnet', itau_sechiba, swnet, kjpindex, kindex)
1549	CALL histwrite_p (hist_id, 'swdown', itau_sechiba, swdown, kjpindex, kindex)
1550	CALL histwrite_p (hist_id, 'alb_vis', itau_sechiba, zalbedo(:,1), kjpindex, kindex)
1551	CALL histwrite_p (hist_id, 'alb_nir', itau_sechiba, zalbedo(:,2), kjpindex, kindex)
1552	CALL histwrite_p (hist_id, 'tair', itau_sechiba, temp_air, kjpindex, kindex)
1553	CALL histwrite_p (hist_id, 'qair', itau_sechiba, qair, kjpindex, kindex)
1554
1555	IF ( hist2_id > 0 ) THEN
1556	CALL histwrite_p (hist2_id, 'evap', itau_sechiba, zvevapp, kjpindex, kindex)
1557	CALL histwrite_p (hist2_id, 'coastalflow',itau_sechiba, zcoastal, kjpindex, kindex)
1558	CALL histwrite_p (hist2_id, 'riverflow',itau_sechiba, zriver, kjpindex, kindex)
1559	CALL histwrite_p (hist2_id, 'temp_sol', itau_sechiba, temp_sol_new, kjpindex, kindex)
1560	CALL histwrite_p (hist2_id, 'tsol_max', itau_sechiba, temp_sol_new, kjpindex, kindex)
1561	CALL histwrite_p (hist2_id, 'tsol_min', itau_sechiba, temp_sol_new, kjpindex, kindex)
1562	CALL histwrite_p (hist2_id, 'fluxsens', itau_sechiba, zfluxsens, kjpindex, kindex)
1563	CALL histwrite_p (hist2_id, 'fluxlat', itau_sechiba, zfluxlat, kjpindex, kindex)
1564	CALL histwrite_p (hist2_id, 'swnet', itau_sechiba, swnet, kjpindex, kindex)
1565	CALL histwrite_p (hist2_id, 'swdown', itau_sechiba, swdown, kjpindex, kindex)
1566	CALL histwrite_p (hist2_id, 'alb_vis', itau_sechiba, zalbedo(:,1), kjpindex, kindex)
1567	CALL histwrite_p (hist2_id, 'alb_nir', itau_sechiba, zalbedo(:,2), kjpindex, kindex)
1568	CALL histwrite_p (hist2_id, 'tair', itau_sechiba, temp_air, kjpindex, kindex)
1569	CALL histwrite_p (hist2_id, 'qair', itau_sechiba, qair, kjpindex, kindex)
1570	ENDIF
1571	ELSE
1572	CALL histwrite_p (hist_id, 'Evap', itau_sechiba, zvevapp, kjpindex, kindex)
1573	CALL histwrite_p (hist_id, 'SWnet', itau_sechiba, swnet, kjpindex, kindex)
1574	CALL histwrite_p (hist_id, 'Qh', itau_sechiba, zfluxsens, kjpindex, kindex)
1575	CALL histwrite_p (hist_id, 'Qle', itau_sechiba, zfluxlat, kjpindex, kindex)
1576	CALL histwrite_p (hist_id, 'AvgSurfT', itau_sechiba, ztemp_sol_new, kjpindex, kindex)
1577	CALL histwrite_p (hist_id, 'RadT', itau_sechiba, ztemp_sol_new, kjpindex, kindex)
1578	IF ( hist2_id > 0 ) THEN
1579	CALL histwrite_p (hist2_id, 'Evap', itau_sechiba, zvevapp, kjpindex, kindex)
1580	CALL histwrite_p (hist2_id, 'SWnet', itau_sechiba, swnet, kjpindex, kindex)
1581	CALL histwrite_p (hist2_id, 'Qh', itau_sechiba, zfluxsens, kjpindex, kindex)
1582	CALL histwrite_p (hist2_id, 'Qle', itau_sechiba, zfluxlat, kjpindex, kindex)
1583	CALL histwrite_p (hist2_id, 'AvgSurfT', itau_sechiba, ztemp_sol_new, kjpindex, kindex)
1584	CALL histwrite_p (hist2_id, 'RadT', itau_sechiba, ztemp_sol_new, kjpindex, kindex)
1585	ENDIF
1586	ENDIF
1587
1588	! Syncronize output but only if flag ok_histsync is set to true
1589	IF (ok_histsync .AND. is_omp_root) THEN
1590	IF ( (dw .EQ. xrdt) .AND. hist_id > 0 ) THEN
1591	CALL histsync(hist_id)
1592	ENDIF
1593	ENDIF
1594
1595
1596
1597	! Write variables to restart file
1598	IF (lrestart_write) THEN
1599	CALL restput_p (rest_id, 'riverflow_cpl0', nbp_glo, 1, 1, kjit, riverflow_cpl0, 'scatter', nbp_glo, index_g)
1600	CALL restput_p (rest_id, 'coastalflow_cpl0', nbp_glo, 1, 1, kjit, coastalflow_cpl0, 'scatter', nbp_glo, index_g)
1601	END IF
1602
1603	!
1604	CALL ipslnlf_p(new_number=old_fileout)
1605	!
1606
1607	!
1608	!! Finalize the XIOS orchidee context if it is the last call
1609	!
1610	IF (lrestart_write) THEN
1611	CALL ioipslctrl_restclo
1612	CALL xios_orchidee_context_finalize
1613	END IF
1614	!
1615	!! Change back to be in the LMDZ context for XIOS
1616	!
1617	CALL xios_orchidee_change_context("LMDZ")
1618
1619	IF (printlev_loc >= 3) WRITE (numout,*) 'End intersurf_main_gathered'
1620
1621	END SUBROUTINE intersurf_main_gathered
1622
1623	!! ================================================================================================================================
1624	!! SUBROUTINE : intersurf_clear
1625	!!
1626	!>\BRIEF Clear intersurf module and underlaying modules
1627	!!
1628	!! DESCRIPTION : Deallocate memory and reset initialization variables to there original values.
1629	!! Call the clearing for sechiba module.
1630	!!
1631	!_ ================================================================================================================================
1632	SUBROUTINE intersurf_clear
1633	CALL sechiba_clear
1634	END SUBROUTINE intersurf_clear
1635
1636	END MODULE intersurf

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

Download in other formats: