Context Navigation

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

Last change on this file since 7346 was 5656, checked in by sebastiaan.luyssaert, 6 years ago
DEV: tested for a single pixel with 5 different configurations to start and 5 different configurations to restart the model. Passed all basic tests for impose_cn = y. These changes contribute to ticket #286 and contain major cleaning and restructuring of slowproc.f90
Property svn:keywords set to `Revision Date HeadURL Date Author Revision`
File size: 102.9 KB

Line
1	! ================================================================================================================================
2	! MODULE : intersurf
3	!
4	! CONTACT : orchidee-help _at_ ipsl.jussieu.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 Orch_Write_field_p
50	USE ioipslctrl, ONLY : ioipslctrl_history, ioipslctrl_restini, ok_histsync, max_hist_level, dw
51
52	IMPLICIT NONE
53
54	PRIVATE
55	PUBLIC :: Init_intersurf, intersurf_main, intersurf_main_2d, intersurf_main_gathered, intsurf_time
56	PUBLIC :: intersurf_initialize_2d, intersurf_initialize_gathered, intersurf_clear
57
58
59	! Interface called from LMDZ in older verisons
60	INTERFACE intersurf_main
61	MODULE PROCEDURE intersurf_main_gathered
62	END INTERFACE
63
64	LOGICAL, SAVE :: lstep_init_intersurf=.TRUE.!! Initialisation has to be done one time
65	!$OMP THREADPRIVATE(lstep_init_intersurf)
66	! INTEGER(i_std), SAVE :: printlev_loc !! Write level to this module
67	!!$OMP THREADPRIVATE(printlev_loc)
68	INTEGER(i_std), SAVE :: hist_id, rest_id !! IDs for history and restart files
69	!$OMP THREADPRIVATE(hist_id, rest_id)
70	INTEGER(i_std), SAVE :: hist2_id !! ID for the second history files (Hi-frequency ?)
71	!$OMP THREADPRIVATE(hist2_id)
72	INTEGER(i_std), SAVE :: hist_id_stom, hist_id_stom_IPCC, rest_id_stom !! Dito for STOMATE
73	!$OMP THREADPRIVATE(hist_id_stom, hist_id_stom_IPCC, rest_id_stom)
74	INTEGER(i_std), SAVE :: itau_offset !! This offset is used to phase the
75	!! calendar of the GCM or the driver.
76	!$OMP THREADPRIVATE(itau_offset)
77	REAL(r_std), SAVE :: date0_shifted
78	!$OMP THREADPRIVATE(date0_shifted)
79	REAL(r_std), SAVE :: julian0 !! first day of this year
80	!$OMP THREADPRIVATE(julian0)
81	LOGICAL, PARAMETER :: check_INPUTS = .false. !! (very) long print of INPUTs in intersurf
82	LOGICAL, SAVE :: ok_q2m_t2m=.TRUE. !! Flag ok if the variables are present in the call in gcm.
83	!$OMP THREADPRIVATE(ok_q2m_t2m)
84	LOGICAL, SAVE :: fatmco2 !! Flag to force the value of atmospheric CO2 for vegetation.
85	!$OMP THREADPRIVATE(fatmco2)
86	REAL(r_std), SAVE :: atmco2 !! atmospheric CO2
87	!$OMP THREADPRIVATE(atmco2)
88	REAL(r_std), SAVE :: coeff_rel !!Coefficient for time filter on riverflow and coastalflow
89	!$OMP THREADPRIVATE(coeff_rel)
90	REAL(r_std), ALLOCATABLE, DIMENSION(:), SAVE :: riverflow_cpl0 !!Value from previous time step for riverflow
91	!$OMP THREADPRIVATE(riverflow_cpl0)
92	REAL(r_std), ALLOCATABLE, DIMENSION(:), SAVE :: coastalflow_cpl0 !!Value from previous time step for coastalflow
93	!$OMP THREADPRIVATE(coastalflow_cpl0)
94	INTEGER(i_std), SAVE :: nb_fields_in=-1 !! Number of fields to give to the GCM
95	!$OMP THREADPRIVATE(nb_fields_in)
96	INTEGER(i_std), SAVE :: nb_fields_out=-1 !! Number of fields to get from the GCM
97	!$OMP THREADPRIVATE(nb_fields_out)
98
99	PUBLIC lstep_init_intersurf
100
101	CONTAINS
102
103	!! =============================================================================================================================
104	!! SUBROUTINE: intersurf_initialize_2d
105	!!
106	!>\BRIEF Initialization and call to sechiba_initialize
107	!!
108	!! DESCRIPTION: Initialization of module variables, read options from parameter file, initialize output files and call to
109	!! sechiba_initialize.
110	!!
111	!! This subroutine is called from dim2_driver before the first call to intersurf_main_2d.
112	!!
113	!! \n
114	!_ ==============================================================================================================================
115
116	SUBROUTINE intersurf_initialize_2d (kjit, iim, jjm, kjpindex, kindex, xrdt, &
117	lrestart_read, lrestart_write, lon, lat, zcontfrac, zresolution, date0, &
118	zlev, u, v, qair, temp_air, epot_air, ccanopy, &
119	cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
120	precip_rain, precip_snow, lwdown, swnet, swdown, pb, &
121	vevapp, fluxsens, fluxlat, coastalflow, riverflow, &
122	tsol_rad, temp_sol_new, qsurf, albedo, emis, z0m, coszang)
123
124	IMPLICIT NONE
125
126	!! 0. Variable and parameter declaration
127	!! 0.1 Input variables
128	INTEGER(i_std),INTENT (in) :: kjit !! Time step number
129	INTEGER(i_std),INTENT (in) :: iim, jjm !! Dimension of input fields
130	INTEGER(i_std),INTENT (in) :: kjpindex !! Number of continental points
131	REAL(r_std),INTENT (in) :: xrdt !! Time step in seconds
132	LOGICAL, INTENT (in) :: lrestart_read !! Logical for _restart_ file to read
133	LOGICAL, INTENT (in) :: lrestart_write !! Logical for _restart_ file to write'
134	REAL(r_std), INTENT (in) :: date0 !! Date at which kjit = 0
135	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: kindex !! Index for continental points
136	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: u !! Lowest level wind speed
137	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: v !! Lowest level wind speed
138	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: zlev !! Height of first layer
139	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: qair !! Lowest level specific humidity
140	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: precip_rain !! Rain precipitation
141	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: precip_snow !! Snow precipitation
142	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: lwdown !! Down-welling long-wave flux
143	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: swnet !! Net surface short-wave flux
144	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: swdown !! Downwelling surface short-wave flux
145	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: temp_air !! Air temperature in Kelvin
146	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: epot_air !! Air potential energy
147	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: ccanopy !! CO2 concentration in the canopy
148	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: petAcoef !! Coeficients A from the PBL resolution
149	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: peqAcoef !! One for T and another for q
150	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: petBcoef !! Coeficients B from the PBL resolution
151	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: peqBcoef !! One for T and another for q
152	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: pb !! Surface pressure
153	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: lon, lat !! Geographical coordinates
154	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: zcontfrac !! Fraction of continent in the grid
155	REAL(r_std),DIMENSION (iim,jjm,2), INTENT(in) :: zresolution !! resolution in x and y dimensions
156	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: coszang !! Cosine of the solar zenith angle (unitless)
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	INTEGER(i_std) :: i, j, ik
207	INTEGER(i_std) :: ier
208	INTEGER(i_std) :: itau_sechiba
209	REAL(r_std) :: zlev_mean
210	INTEGER :: old_fileout !! old Logical Int for std IO output
211
212
213	CALL ipslnlf_p(new_number=numout,old_number=old_fileout)
214	!
215	! Configuration of SSL specific parameters
216	!
217	CALL control_initialize(xrdt)
218
219	CALL intsurf_time( kjit, date0)
220
221	! Initialize specific write level
222	!printlev_loc=get_printlev('instersurf')
223
224	IF ( printlev_loc >=3 ) WRITE(numout,*) 'Initialisation of intersurf_main_2d'
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	CALL gather2D_mpi(zlev,zlev_g)
247
248	CALL ioipslctrl_restini(kjit, date0, xrdt, rest_id, rest_id_stom, itau_offset, date0_shifted)
249
250	itau_sechiba = kjit + itau_offset
251
252	!!- Initialize module for output with XIOS
253	!
254	CALL xios_orchidee_init( MPI_COMM_ORCH, &
255	date0, year, month, day, &
256	lon, lat, znt )
257
258	!- Initialize IOIPSL sechiba output files
259	CALL ioipslctrl_history(iim, jjm, lon, lat, kindex, kjpindex, itau_sechiba, date0_shifted, xrdt, hist_id, &
260	hist2_id, hist_id_stom, hist_id_stom_IPCC)
261
262	IF ( printlev_loc>=3 ) WRITE(numout,*) 'End of Initialisation of intersurf'
263	!
264	! Shift the time step to phase the two models
265	!
266	itau_sechiba = kjit + itau_offset
267
268	! Update the calendar in xios by sending the new time step
269	! Special case : the model is only in initialization phase and the current itau_sechiba is not a real time step.
270	! Therefor give itau_sechiba+1 to xios to have a correct time axis in output files.
271	CALL xios_orchidee_update_calendar(itau_sechiba+1)
272
273	CALL intsurf_time( itau_sechiba, date0_shifted )
274	!
275	! 1. gather input fields from kindex array
276	! Warning : I'm not sure this interface with one dimension array is the good one
277	!
278	DO ik=1, kjpindex
279
280	j = ((kindex(ik)-1)/iim) + 1
281	i = (kindex(ik) - (j-1)*iim)
282
283	zu(ik) = u(i,j)
284	zv(ik) = v(i,j)
285	zzlev(ik) = zlev(i,j)
286	zqair(ik) = qair(i,j)
287	zprecip_rain(ik) = precip_rain(i,j)*xrdt
288	zprecip_snow(ik) = precip_snow(i,j)*xrdt
289	zlwdown(ik) = lwdown(i,j)
290	zswnet(ik) = swnet(i,j)
291	zswdown(ik) = swdown(i,j)
292	ztemp_air(ik) = temp_air(i,j)
293	zepot_air(ik) = epot_air(i,j)
294	zccanopy(ik) = ccanopy(i,j)
295	zpetAcoef(ik) = petAcoef(i,j)
296	zpeqAcoef(ik) = peqAcoef(i,j)
297	zpetBcoef(ik) = petBcoef(i,j)
298	zpeqBcoef(ik) = peqBcoef(i,j)
299	zcdrag(ik) = cdrag(i,j)
300	zpb(ik) = pb(i,j)
301
302	ENDDO
303	!
304	IF (check_INPUTS) THEN
305	WRITE(numout,*) "Intersurf_initialize_2D :"
306	WRITE(numout,*) "Time step number = ",kjit
307	WRITE(numout,*) "Dimension of input fields = ",iim, jjm
308	WRITE(numout,*) "Number of continental points = ",kjpindex
309	WRITE(numout,*) "Time step in seconds = ",xrdt
310	WRITE(numout,*) "Logical for _restart_ file to read, write = ",lrestart_read,lrestart_write
311	WRITE(numout,*) "Date at which kjit = 0 = ",date0
312	WRITE(numout,*) "Index for continental points = ",kindex
313	WRITE(numout,*) "Lowest level wind speed North = ",zu
314	WRITE(numout,*) "Lowest level wind speed East = ",zv
315	WRITE(numout,*) "Height of first layer = ",zzlev
316	WRITE(numout,*) "Lowest level specific humidity = ",zqair
317	WRITE(numout,*) "Rain precipitation = ",zprecip_rain
318	WRITE(numout,*) "Snow precipitation = ",zprecip_snow
319	WRITE(numout,*) "Down-welling long-wave flux = ",zlwdown
320	WRITE(numout,*) "Net surface short-wave flux = ",zswnet
321	WRITE(numout,*) "Downwelling surface short-wave flux = ",zswdown
322	WRITE(numout,*) "Air temperature in Kelvin = ",ztemp_air
323	WRITE(numout,*) "Air potential energy = ",zepot_air
324	WRITE(numout,*) "CO2 concentration in the canopy = ",zccanopy
325	WRITE(numout,*) "Coeficients A from the PBL resolution = ",zpetAcoef
326	WRITE(numout,*) "One for T and another for q = ",zpeqAcoef
327	WRITE(numout,*) "Coeficients B from the PBL resolution = ",zpetBcoef
328	WRITE(numout,*) "One for T and another for q = ",zpeqBcoef
329	WRITE(numout,*) "Cdrag = ",zcdrag
330	WRITE(numout,*) "Surface pressure = ",zpb
331	WRITE(numout,*) "Geographical coordinates lon = ", (/ ( lon(ilandindex(ik), jlandindex(ik)), ik=1,kjpindex ) /)
332	WRITE(numout,*) "Geographical coordinates lat = ", (/ ( lat(ilandindex(ik), jlandindex(ik)), ik=1,kjpindex ) /)
333	WRITE(numout,*) "Fraction of continent in the grid = ",contfrac
334	ENDIF
335	!
336	! 2. save the grid
337	!
338	IF ( printlev_loc>=3 ) WRITE(numout,*) 'Save the grid'
339	CALL histwrite_p(hist_id, 'LandPoints', itau_sechiba+1, (/ ( REAL(ik), ik=1,kjpindex ) /), kjpindex, kindex)
340	CALL histwrite_p(hist_id, 'Areas', itau_sechiba+1, area, kjpindex, kindex)
341	IF ( ok_stomate ) THEN
342	CALL histwrite_p(hist_id_stom, 'Areas', itau_sechiba+1, area, kjpindex, kindex)
343	CALL histwrite_p(hist_id_stom_IPCC, 'Areas', itau_sechiba+1, area, kjpindex, kindex)
344	ENDIF
345
346	CALL histwrite_p(hist_id, 'Contfrac', itau_sechiba+1, contfrac, kjpindex, kindex)
347	IF ( is_omp_root .AND. hist_id > 0 ) THEN
348	! Always syncronize output after initialization
349	CALL histsync(hist_id)
350	END IF
351
352	CALL histwrite_p(hist2_id, 'LandPoints', itau_sechiba+1, (/ ( REAL(ik), ik=1,kjpindex ) /), kjpindex, kindex)
353	CALL histwrite_p(hist2_id, 'Areas', itau_sechiba+1, area, kjpindex, kindex)
354	CALL histwrite_p(hist2_id, 'Contfrac', itau_sechiba+1, contfrac, kjpindex, kindex)
355	IF ( is_omp_root .AND. hist2_id > 0 ) THEN
356	! Always syncronize output after initialization
357	CALL histsync(hist2_id)
358	ENDIF
359
360	!
361	! 3. call sechiba for continental points only
362	!
363	IF ( printlev_loc >= 3 ) WRITE(numout,*) 'Calling sechiba_initialize'
364
365	CALL sechiba_initialize( &
366	itau_sechiba, iim*jjm, kjpindex, kindex, &
367	lalo, contfrac, neighbours, resolution, zzlev, &
368	zu, zv, zqair, ztemp_air, ztemp_air, &
369	zpetAcoef, zpeqAcoef, zpetBcoef, zpeqBcoef, &
370	zprecip_rain, zprecip_snow, zlwdown, zswnet, zswdown, &
371	zpb, rest_id, hist_id, hist2_id, &
372	rest_id_stom, hist_id_stom, hist_id_stom_IPCC, &
373	zcoastal, zriver, ztsol_rad, zvevapp, zqsurf, &
374	zz0m, zz0h, zalbedo, zfluxsens, zfluxlat, &
375	zemis, znetco2, zcarblu, ztemp_sol_new, zcdrag, &
376	coszang )
377
378	IF ( printlev_loc >= 3 ) WRITE(numout,*) 'out of sechiba_initialize'
379	!
380	! 5. scatter output fields
381	!
382	z0m(:,:) = undef_sechiba
383	coastalflow(:,:) = undef_sechiba
384	riverflow(:,:) = undef_sechiba
385	tsol_rad(:,:) = undef_sechiba
386	vevapp(:,:) = undef_sechiba
387	temp_sol_new(:,:) = undef_sechiba
388	qsurf(:,:) = undef_sechiba
389	albedo(:,:,:) = undef_sechiba
390	fluxsens(:,:) = undef_sechiba
391	fluxlat(:,:) = undef_sechiba
392	emis(:,:) = undef_sechiba
393	cdrag(:,:) = undef_sechiba
394
395	DO ik=1, kjpindex
396	j = ((kindex(ik)-1)/iim) + 1
397	i = (kindex(ik) - (j-1)*iim)
398
399	z0m(i,j) = zz0m(ik)
400	coastalflow(i,j) = zcoastal(ik)
401	riverflow(i,j) = zriver(ik)
402	tsol_rad(i,j) = ztsol_rad(ik)
403	vevapp(i,j) = zvevapp(ik)
404	temp_sol_new(i,j) = ztemp_sol_new(ik)
405	qsurf(i,j) = zqsurf(ik)
406	albedo(i,j,1) = zalbedo(ik,1)
407	albedo(i,j,2) = zalbedo(ik,2)
408	fluxsens(i,j) = zfluxsens(ik)
409	fluxlat(i,j) = zfluxlat(ik)
410	emis(i,j) = zemis(ik)
411	cdrag(i,j) = zcdrag(ik)
412
413	ENDDO
414
415	!
416	! 6. Transform the water fluxes into Kg/m^2s and m^3/s
417	!
418	DO ik=1, kjpindex
419
420	j = ((kindex(ik)-1)/iim) + 1
421	i = (kindex(ik) - (j-1)*iim)
422
423	vevapp(i,j) = vevapp(i,j)/xrdt
424	coastalflow(i,j) = coastalflow(i,j)/xrdt
425	riverflow(i,j) = riverflow(i,j)/xrdt
426
427	ENDDO
428
429	IF (is_root_prc) CALL getin_dump
430
431	lstep_init_intersurf = .FALSE.
432	IF (printlev_loc >=3) WRITE (numout,*) ' intersurf_main done '
433	CALL ipslnlf_p(new_number=old_fileout)
434	END SUBROUTINE intersurf_initialize_2d
435
436
437	!! =============================================================================================================================
438	!! SUBROUTINE: intersurf_main_2d
439	!!
440	!>\BRIEF Main subroutine to call ORCHIDEE from dim2_driver using variables on a 2d grid.
441	!!
442	!! DESCRIPTION: This subroutine is the main interface for ORCHIDEE when it is called from the offline driver dim2_driver.
443	!! The variables are all on the 2D grid including ocean points. intersurf_initialize_2d should be called before
444	!! this subroutine is called. This subroutine is called at each time step.
445	!!
446	!! \n
447	!_ ==============================================================================================================================
448
449	SUBROUTINE intersurf_main_2d (kjit, iim, jjm, kjpindex, kindex, xrdt, &
450	lrestart_read, lrestart_write, lon, lat, zcontfrac, zresolution, date0, &
451	zlev, u, v, qair, temp_air, epot_air, ccanopy, &
452	cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
453	precip_rain, precip_snow, lwdown, swnet, swdown, pb, &
454	vevapp, fluxsens, fluxlat, coastalflow, riverflow, &
455	tsol_rad, temp_sol_new, qsurf, albedo, emis, z0m, &
456	coszang)
457
458	IMPLICIT NONE
459
460	!! 0. Variable and parameter declaration
461	!! 0.1 Input variables
462	INTEGER(i_std),INTENT (in) :: kjit !! Time step number
463	INTEGER(i_std),INTENT (in) :: iim, jjm !! Dimension of input fields
464	INTEGER(i_std),INTENT (in) :: kjpindex !! Number of continental points
465	REAL(r_std),INTENT (in) :: xrdt !! Time step in seconds
466	LOGICAL, INTENT (in) :: lrestart_read !! Logical for _restart_ file to read
467	LOGICAL, INTENT (in) :: lrestart_write !! Logical for _restart_ file to write'
468	REAL(r_std), INTENT (in) :: date0 !! Date at which kjit = 0
469	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: kindex !! Index for continental points
470	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: u !! Lowest level wind speed
471	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: v !! Lowest level wind speed
472	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: zlev !! Height of first layer
473	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: qair !! Lowest level specific humidity
474	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: precip_rain !! Rain precipitation
475	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: precip_snow !! Snow precipitation
476	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: lwdown !! Down-welling long-wave flux
477	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: swnet !! Net surface short-wave flux
478	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: swdown !! Downwelling surface short-wave flux
479	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: coszang !! Cosine of the solar zenith angle (unitless)
480	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: temp_air !! Air temperature in Kelvin
481	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: epot_air !! Air potential energy
482	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: ccanopy !! CO2 concentration in the canopy
483	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: petAcoef !! Coeficients A from the PBL resolution
484	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: peqAcoef !! One for T and another for q
485	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: petBcoef !! Coeficients B from the PBL resolution
486	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: peqBcoef !! One for T and another for q
487	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: pb !! Surface pressure
488	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: lon, lat !! Geographical coordinates
489	REAL(r_std),DIMENSION (iim,jjm), INTENT(in) :: zcontfrac !! Fraction of continent in the grid
490	REAL(r_std),DIMENSION (iim,jjm,2), INTENT(in) :: zresolution !! resolution in x and y dimensions
491
492	!! 0.2 Output variables
493	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: z0m !! Surface roughness for momemtum
494	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: coastalflow !! Diffuse flow of water into the ocean (m^3/s)
495	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: riverflow !! Largest rivers flowing into the ocean (m^3/s)
496	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: tsol_rad !! Radiative surface temperature
497	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: vevapp !! Total of evaporation
498	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: temp_sol_new !! New soil temperature
499	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: qsurf !! Surface specific humidity
500	REAL(r_std),DIMENSION (iim,jjm,2), INTENT(out) :: albedo !! Albedo
501	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: fluxsens !! Sensible chaleur flux
502	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: fluxlat !! Latent chaleur flux
503	REAL(r_std),DIMENSION (iim,jjm), INTENT(out) :: emis !! Emissivity
504
505	!! 0.3 Modified variables
506	REAL(r_std),DIMENSION (iim,jjm), INTENT(inout) :: cdrag !! Cdrag
507
508	!! 0.4 Local variables
509	REAL(r_std),DIMENSION (kjpindex) :: zu !! Work array to keep u
510	REAL(r_std),DIMENSION (kjpindex) :: zv !! Work array to keep v
511	REAL(r_std),DIMENSION (kjpindex) :: zzlev !! Work array to keep zlev
512	REAL(r_std),DIMENSION (kjpindex) :: zqair !! Work array to keep qair
513	REAL(r_std),DIMENSION (kjpindex) :: zprecip_rain !! Work array to keep precip_rain
514	REAL(r_std),DIMENSION (kjpindex) :: zprecip_snow !! Work array to keep precip_snow
515	REAL(r_std),DIMENSION (kjpindex) :: zlwdown !! Work array to keep lwdown
516	REAL(r_std),DIMENSION (kjpindex) :: zswnet !! Work array to keep swnet
517	REAL(r_std),DIMENSION (kjpindex) :: zswdown !! Work array to keep swdown
518	REAL(r_std),DIMENSION (kjpindex) :: zcoszang !! Work array to keep coszang
519	REAL(r_std),DIMENSION (kjpindex) :: ztemp_air !! Work array to keep temp_air
520	REAL(r_std),DIMENSION (kjpindex) :: zepot_air !! Work array to keep epot_air
521	REAL(r_std),DIMENSION (kjpindex) :: zccanopy !! Work array to keep ccanopy
522	REAL(r_std),DIMENSION (kjpindex) :: zpetAcoef !! Work array to keep petAcoef
523	REAL(r_std),DIMENSION (kjpindex) :: zpeqAcoef !! Work array to keep peqAcoef
524	REAL(r_std),DIMENSION (kjpindex) :: zpetBcoef !! Work array to keep petBcoef
525	REAL(r_std),DIMENSION (kjpindex) :: zpeqBcoef !! Work array to keep peqVcoef
526	REAL(r_std),DIMENSION (kjpindex) :: zcdrag !! Work array to keep cdrag
527	REAL(r_std),DIMENSION (kjpindex) :: zpb !! Work array to keep pb
528	REAL(r_std),DIMENSION (kjpindex) :: zz0m, zz0h !! Work array to keep zz0m, zz0h
529	REAL(r_std),DIMENSION (kjpindex) :: zcoastal !! Work array to keep coastalflow (m^3/dt)
530	REAL(r_std),DIMENSION (kjpindex) :: zriver !! Work array to keep riverflow (m^3/dt)
531	REAL(r_std),DIMENSION (kjpindex) :: znetco2 !! Work array to keep netco2flux
532	REAL(r_std),DIMENSION (kjpindex) :: zcarblu !! Work array to keep fco2_land_use
533	REAL(r_std),DIMENSION (kjpindex) :: ztsol_rad !! Work array to keep tsol_rad
534	REAL(r_std),DIMENSION (kjpindex) :: zvevapp !! Work array to keep vevapp
535	REAL(r_std),DIMENSION (kjpindex) :: ztemp_sol_new !! Work array to keep temp_sol_new
536	REAL(r_std),DIMENSION (kjpindex) :: zqsurf !! Work array to keep qsurf
537	REAL(r_std),DIMENSION (kjpindex,2) :: zalbedo !! Work array to keep albedo
538	REAL(r_std),DIMENSION (kjpindex) :: zfluxsens !! Work array to keep fluxsens
539	REAL(r_std),DIMENSION (kjpindex) :: zfluxlat !! Work array to keep fluxlat
540	REAL(r_std),DIMENSION (kjpindex) :: zemis !! Work array to keep emis
541	INTEGER(i_std) :: i, j, ik
542	INTEGER(i_std) :: ier
543	INTEGER(i_std) :: itau_sechiba
544	REAL(r_std) :: zlev_mean
545	INTEGER :: old_fileout !! old Logical Int for std IO output
546
547	CALL ipslnlf_p(new_number=numout,old_number=old_fileout)
548
549	!
550	! Shift the time step to phase the two models
551	!
552	itau_sechiba = kjit + itau_offset
553	!
554
555	! Update the calendar in xios by sending the new time step
556	CALL xios_orchidee_update_calendar(itau_sechiba)
557
558	CALL intsurf_time( itau_sechiba, date0_shifted )
559	!
560	! 1. gather input fields from kindex array
561	! Warning : I'm not sure this interface with one dimension array is the good one
562	!
563	DO ik=1, kjpindex
564
565	j = ((kindex(ik)-1)/iim) + 1
566	i = (kindex(ik) - (j-1)*iim)
567
568	zu(ik) = u(i,j)
569	zv(ik) = v(i,j)
570	zzlev(ik) = zlev(i,j)
571	zqair(ik) = qair(i,j)
572	zprecip_rain(ik) = precip_rain(i,j)*xrdt
573	zprecip_snow(ik) = precip_snow(i,j)*xrdt
574	zlwdown(ik) = lwdown(i,j)
575	zswnet(ik) = swnet(i,j)
576	zswdown(ik) = swdown(i,j)
577	zcoszang(ik) = coszang(i,j)
578	ztemp_air(ik) = temp_air(i,j)
579	zepot_air(ik) = epot_air(i,j)
580	zccanopy(ik) = ccanopy(i,j)
581	zpetAcoef(ik) = petAcoef(i,j)
582	zpeqAcoef(ik) = peqAcoef(i,j)
583	zpetBcoef(ik) = petBcoef(i,j)
584	zpeqBcoef(ik) = peqBcoef(i,j)
585	zcdrag(ik) = cdrag(i,j)
586	zpb(ik) = pb(i,j)
587
588	ENDDO
589	!
590	IF (check_INPUTS) THEN
591	WRITE(numout,*) "Intersurf_main_2D :"
592	WRITE(numout,*) "Time step number = ",kjit
593	WRITE(numout,*) "Dimension of input fields = ",iim, jjm
594	WRITE(numout,*) "Number of continental points = ",kjpindex
595	WRITE(numout,*) "Time step in seconds = ",xrdt
596	WRITE(numout,*) "Logical for _restart_ file to read, write = ",lrestart_read,lrestart_write
597	WRITE(numout,*) "Date at which kjit = 0 = ",date0
598	WRITE(numout,*) "Index for continental points = ",kindex
599	WRITE(numout,*) "Lowest level wind speed North = ",zu
600	WRITE(numout,*) "Lowest level wind speed East = ",zv
601	WRITE(numout,*) "Height of first layer = ",zzlev
602	WRITE(numout,*) "Lowest level specific humidity = ",zqair
603	WRITE(numout,*) "Rain precipitation = ",zprecip_rain
604	WRITE(numout,*) "Snow precipitation = ",zprecip_snow
605	WRITE(numout,*) "Down-welling long-wave flux = ",zlwdown
606	WRITE(numout,*) "Net surface short-wave flux = ",zswnet
607	WRITE(numout,*) "Downwelling surface short-wave flux = ",zswdown
608	WRITE(numout,*) "Air temperature in Kelvin = ",ztemp_air
609	WRITE(numout,*) "Air potential energy = ",zepot_air
610	WRITE(numout,*) "CO2 concentration in the canopy = ",zccanopy
611	WRITE(numout,*) "Coeficients A from the PBL resolution = ",zpetAcoef
612	WRITE(numout,*) "One for T and another for q = ",zpeqAcoef
613	WRITE(numout,*) "Coeficients B from the PBL resolution = ",zpetBcoef
614	WRITE(numout,*) "One for T and another for q = ",zpeqBcoef
615	WRITE(numout,*) "Cdrag = ",zcdrag
616	WRITE(numout,*) "Surface pressure = ",zpb
617	WRITE(numout,*) "Geographical coordinates lon = ", (/ ( lon(ilandindex(ik), jlandindex(ik)), ik=1,kjpindex ) /)
618	WRITE(numout,*) "Geographical coordinates lat = ", (/ ( lat(ilandindex(ik), jlandindex(ik)), ik=1,kjpindex ) /)
619	WRITE(numout,*) "Fraction of continent in the grid = ",contfrac
620	ENDIF
621
622	!
623	! 3. call sechiba for continental points only
624	!
625	IF ( printlev_loc >= 3 ) WRITE(numout,*) 'Calling sechiba_main'
626
627	CALL sechiba_main (itau_sechiba, iim*jjm, kjpindex, kindex, &
628	lrestart_read, lrestart_write, &
629	lalo, contfrac, neighbours, resolution, &
630	zzlev, zu, zv, zqair, zqair, ztemp_air, ztemp_air, zepot_air, zccanopy, &
631	zcdrag, zpetAcoef, zpeqAcoef, zpetBcoef, zpeqBcoef, &
632	zprecip_rain ,zprecip_snow, zlwdown, zswnet, zswdown, zcoszang, zpb, &
633	zvevapp, zfluxsens, zfluxlat, zcoastal, zriver, znetco2, zcarblu, &
634	ztsol_rad, ztemp_sol_new, zqsurf, zalbedo, zemis, zz0m, zz0h,&
635	rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC )
636
637	IF ( printlev_loc >= 3 ) WRITE(numout,*) 'out of sechiba_main'
638
639	!
640	! 5. scatter output fields
641	!
642	z0m(:,:) = undef_sechiba
643	coastalflow(:,:) = undef_sechiba
644	riverflow(:,:) = undef_sechiba
645	tsol_rad(:,:) = undef_sechiba
646	vevapp(:,:) = undef_sechiba
647	temp_sol_new(:,:) = undef_sechiba
648	qsurf(:,:) = undef_sechiba
649	albedo(:,:,:) = undef_sechiba
650	fluxsens(:,:) = undef_sechiba
651	fluxlat(:,:) = undef_sechiba
652	emis(:,:) = undef_sechiba
653	cdrag(:,:) = undef_sechiba
654	!
655	DO ik=1, kjpindex
656
657
658	j = ((kindex(ik)-1)/iim) + 1
659	i = (kindex(ik) - (j-1)*iim)
660
661	z0m(i,j) = zz0m(ik)
662	coastalflow(i,j) = zcoastal(ik)
663	riverflow(i,j) = zriver(ik)
664	tsol_rad(i,j) = ztsol_rad(ik)
665	vevapp(i,j) = zvevapp(ik)
666	temp_sol_new(i,j) = ztemp_sol_new(ik)
667	qsurf(i,j) = zqsurf(ik)
668	albedo(i,j,1) = zalbedo(ik,1)
669	albedo(i,j,2) = zalbedo(ik,2)
670	fluxsens(i,j) = zfluxsens(ik)
671	fluxlat(i,j) = zfluxlat(ik)
672	emis(i,j) = zemis(ik)
673	cdrag(i,j) = zcdrag(ik)
674
675	ENDDO
676
677	CALL xios_orchidee_send_field("LandPoints" ,(/ ( REAL(ik), ik=1,kjpindex ) /))
678	CALL xios_orchidee_send_field("Areas", area)
679	CALL xios_orchidee_send_field("Contfrac",contfrac)
680	CALL xios_orchidee_send_field("evap",zvevapp*one_day/dt_sechiba)
681	CALL xios_orchidee_send_field("coastalflow",zcoastal/dt_sechiba)
682	CALL xios_orchidee_send_field("riverflow",zriver/dt_sechiba)
683	CALL xios_orchidee_send_field("temp_sol_C",ztemp_sol_new-ZeroCelsius)
684	CALL xios_orchidee_send_field("temp_sol_K",ztemp_sol_new)
685	CALL xios_orchidee_send_field("fluxsens",zfluxsens)
686	CALL xios_orchidee_send_field("fluxlat",zfluxlat)
687	CALL xios_orchidee_send_field("tair",ztemp_air)
688	CALL xios_orchidee_send_field("qair",zqair)
689	CALL xios_orchidee_send_field("swnet",zswnet)
690	CALL xios_orchidee_send_field("swdown",zswdown)
691	! zpb in hPa, output in Pa
692	CALL xios_orchidee_send_field("Psurf",zpb*100.)
693
694	IF ( .NOT. almaoutput ) THEN
695	!
696	! scattered during the writing
697	!
698	CALL histwrite_p (hist_id, 'evap', itau_sechiba, zvevapp, kjpindex, kindex)
699	CALL histwrite_p (hist_id, 'coastalflow',itau_sechiba, zcoastal, kjpindex, kindex)
700	CALL histwrite_p (hist_id, 'riverflow',itau_sechiba, zriver, kjpindex, kindex)
701	CALL histwrite_p (hist_id, 'temp_sol', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
702	CALL histwrite_p (hist_id, 'tsol_max', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
703	CALL histwrite_p (hist_id, 'tsol_min', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
704	CALL histwrite_p (hist_id, 'fluxsens', itau_sechiba, zfluxsens, kjpindex, kindex)
705	CALL histwrite_p (hist_id, 'fluxlat', itau_sechiba, zfluxlat, kjpindex, kindex)
706	CALL histwrite_p (hist_id, 'swnet', itau_sechiba, zswnet, kjpindex, kindex)
707	CALL histwrite_p (hist_id, 'swdown', itau_sechiba, zswdown, kjpindex, kindex)
708	CALL histwrite_p (hist_id, 'alb_vis', itau_sechiba, zalbedo(:,1), kjpindex, kindex)
709	CALL histwrite_p (hist_id, 'alb_nir', itau_sechiba, zalbedo(:,2), kjpindex, kindex)
710	CALL histwrite_p (hist_id, 'tair', itau_sechiba, ztemp_air, kjpindex, kindex)
711	CALL histwrite_p (hist_id, 'qair', itau_sechiba, zqair, kjpindex, kindex)
712	CALL histwrite_p (hist_id, 'q2m', itau_sechiba, zqair, kjpindex, kindex)
713	CALL histwrite_p (hist_id, 't2m', itau_sechiba, ztemp_air, kjpindex, kindex)
714	CALL histwrite_p (hist2_id, 'evap', itau_sechiba, zvevapp, kjpindex, kindex)
715	CALL histwrite_p (hist2_id, 'coastalflow',itau_sechiba, zcoastal, kjpindex, kindex)
716	CALL histwrite_p (hist2_id, 'riverflow',itau_sechiba, zriver, kjpindex, kindex)
717	CALL histwrite_p (hist2_id, 'temp_sol', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
718	CALL histwrite_p (hist2_id, 'tsol_max', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
719	CALL histwrite_p (hist2_id, 'tsol_min', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
720	CALL histwrite_p (hist2_id, 'fluxsens', itau_sechiba, zfluxsens, kjpindex, kindex)
721	CALL histwrite_p (hist2_id, 'fluxlat', itau_sechiba, zfluxlat, kjpindex, kindex)
722	CALL histwrite_p (hist2_id, 'swnet', itau_sechiba, zswnet, kjpindex, kindex)
723	CALL histwrite_p (hist2_id, 'swdown', itau_sechiba, zswdown, kjpindex, kindex)
724	CALL histwrite_p (hist2_id, 'alb_vis', itau_sechiba, zalbedo(:,1), kjpindex, kindex)
725	CALL histwrite_p (hist2_id, 'alb_nir', itau_sechiba, zalbedo(:,2), kjpindex, kindex)
726	CALL histwrite_p (hist2_id, 'tair', itau_sechiba, ztemp_air, kjpindex, kindex)
727	CALL histwrite_p (hist2_id, 'qair', itau_sechiba, zqair, kjpindex, kindex)
728	CALL histwrite_p (hist2_id, 'q2m', itau_sechiba, zqair, kjpindex, kindex)
729	CALL histwrite_p (hist2_id, 't2m', itau_sechiba, ztemp_air, kjpindex, kindex)
730	ELSE
731	CALL histwrite_p (hist_id, 'Evap', itau_sechiba, zvevapp, kjpindex, kindex)
732	CALL histwrite_p (hist_id, 'SWnet', itau_sechiba, zswnet, kjpindex, kindex)
733	CALL histwrite_p (hist_id, 'Qh', itau_sechiba, zfluxsens, kjpindex, kindex)
734	CALL histwrite_p (hist_id, 'Qle', itau_sechiba, zfluxlat, kjpindex, kindex)
735	CALL histwrite_p (hist_id, 'AvgSurfT', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
736	CALL histwrite_p (hist_id, 'RadT', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
737	CALL histwrite_p (hist_id, 'Tair', itau_sechiba, ztemp_air, kjpindex, kindex)
738	CALL histwrite_p (hist_id, 'Qair', itau_sechiba, zqair, kjpindex, kindex)
739	CALL histwrite_p (hist2_id, 'Evap', itau_sechiba, zvevapp, kjpindex, kindex)
740	CALL histwrite_p (hist2_id, 'SWnet', itau_sechiba, zswnet, kjpindex, kindex)
741	CALL histwrite_p (hist2_id, 'Qh', itau_sechiba, zfluxsens, kjpindex, kindex)
742	CALL histwrite_p (hist2_id, 'Qle', itau_sechiba, zfluxlat, kjpindex, kindex)
743	CALL histwrite_p (hist2_id, 'AvgSurfT', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
744	CALL histwrite_p (hist2_id, 'RadT', itau_sechiba, ztemp_sol_NEW, kjpindex, kindex)
745	ENDIF
746	!
747	IF ( is_omp_root ) THEN
748	IF ( (dw .EQ. xrdt) .AND. hist_id > 0 ) THEN
749	! Syncronize output but only if flag ok_histsync is set to true
750	IF (ok_histsync) CALL histsync(hist_id)
751	ENDIF
752	END IF
753
754	!
755	! 6. Transform the water fluxes into Kg/m^2s and m^3/s
756	!
757	DO ik=1, kjpindex
758
759	j = ((kindex(ik)-1)/iim) + 1
760	i = (kindex(ik) - (j-1)*iim)
761
762	vevapp(i,j) = vevapp(i,j)/xrdt
763	coastalflow(i,j) = coastalflow(i,j)/xrdt
764	riverflow(i,j) = riverflow(i,j)/xrdt
765
766	ENDDO
767
768	IF (printlev_loc >=3) WRITE (numout,*) ' intersurf_main done '
769
770	CALL ipslnlf_p(new_number=old_fileout)
771
772	END SUBROUTINE intersurf_main_2d
773
774
775	!! =============================================================================================================================
776	!! SUBROUTINE: init_intersurf
777	!!
778	!>\BRIEF Initialize grid information
779	!!
780	!! DESCRIPTION: This subroutine is called from LMDZ before first call to intersurf_main_gathered or
781	!! intersurf_initialize_gathered
782	!!
783	!! \n
784	!_ ==============================================================================================================================
785
786	SUBROUTINE init_intersurf(nbp_l_lon,nbp_l_lat,kjpindex,kindex,orch_offset,orch_omp_size,orch_omp_rank,COMM)
787
788	USE mod_orchidee_para
789	USE timer
790	IMPLICIT NONE
791
792	INTEGER,INTENT(IN) :: nbp_l_lon
793	INTEGER,INTENT(IN) :: nbp_l_lat
794	INTEGER,INTENT(IN) :: kjpindex
795	INTEGER,INTENT(IN) :: kindex(:)
796	INTEGER,INTENT(IN) :: orch_offset
797	INTEGER,INTENT(IN) :: COMM
798	INTEGER,INTENT(IN) :: orch_omp_size
799	INTEGER,INTENT(IN) :: orch_omp_rank
800
801	INTEGER,DIMENSION(kjpindex) :: kindex_offset
802
803	IF (orch_omp_rank==0) THEN
804	CALL Init_timer
805	CALL start_timer(timer_mpi)
806	CALL grid_set_glo(nbp_l_lon,nbp_l_lat)
807	ENDIF
808	CALL barrier2_omp()
809	CALL init_orchidee_data_para(kjpindex,kindex,orch_offset,orch_omp_size,orch_omp_rank,COMM)
810	CALL Set_stdout_file('out_orchidee')
811
812	IF (is_omp_root) CALL grid_allocate_glo(4)
813	CALL barrier2_omp()
814	CALL init_ioipsl_para
815
816	kindex_offset(:)=kindex(:)+offset
817	CALL gather(kindex_offset,index_g)
818	CALL bcast(index_g)
819
820	WRITE(numout,*) "kjpindex = ",kjpindex
821	WRITE(numout,*) "offset for OMP = ",offset_omp
822	WRITE(numout,*) "Index num local for continental points = ",kindex
823	WRITE(numout,*) "Index num global for continental points = ",kindex_offset
824	IF (is_omp_root) THEN
825	WRITE(numout,*) "ROOT OMP, Index global MPI : ",kindex_mpi(:)
826	ENDIF
827	IF (is_root_prc) THEN
828	WRITE(numout,*) "ROOT global, Index global : ",index_g(:)
829	ENDIF
830
831	! Allocation of grid variables
832	CALL grid_init ( kjpindex, 4, "RegLonLat", "2DGrid" )
833
834
835	END SUBROUTINE init_intersurf
836
837	!! =============================================================================================================================
838	!! SUBROUTINE: intersurf_initialize_gathered
839	!!
840	!>\BRIEF Initialization and call to sechiba_initialize
841	!!
842	!! DESCRIPTION: Initialization of module variables, read options from parameter file, initialize output files and call to
843	!! sechiba_initialize.
844	!!
845	!! This subroutine can be called directly from GCM(LMDZ). If it is not called before the first call to
846	!! intersurf_main_gathered, then it will be done from there. This possibility is done to keep backward
847	!! compatibility with LMDZ.
848	!!
849	!! \n
850	!_ ==============================================================================================================================
851
852	SUBROUTINE intersurf_initialize_gathered (kjit, iim_glo, jjm_glo, kjpindex, kindex, xrdt, &
853	lrestart_read, lrestart_write, latlon, zcontfrac, zneighbours, zresolution, date0, &
854	zlev, u, v, qair, temp_air, epot_air, &
855	cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
856	precip_rain, precip_snow, lwdown, swnet, swdown, pb, &
857	vevapp, fluxsens, fluxlat, coastalflow_cpl, riverflow_cpl, &
858	tsol_rad, temp_sol_new, qsurf, albedo, emis, z0m, lon_scat_g, lat_scat_g, q2m, t2m, z0h, &
859	field_out_names, fields_out, field_in_names, fields_in)
860
861	USE mod_orchidee_para
862	IMPLICIT NONE
863
864	!! 0. Variable and parameter declaration
865	!! 0.1 Input
866	INTEGER(i_std),INTENT (in) :: kjit !! Time step number
867	INTEGER(i_std),INTENT (in) :: iim_glo !! Dimension of global fields
868	INTEGER(i_std),INTENT (in) :: jjm_glo !! Dimension of global fields
869	INTEGER(i_std),INTENT (in) :: kjpindex !! Number of continental points
870	REAL(r_std),INTENT (in) :: xrdt !! Time step in seconds
871	LOGICAL, INTENT (in) :: lrestart_read !! Logical for _restart_ file to read
872	LOGICAL, INTENT (in) :: lrestart_write !! Logical for _restart_ file to write'
873	REAL(r_std), INTENT (in) :: date0 !! Date at which kjit = 0
874	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: kindex !! Index for continental points
875	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: u !! Lowest level wind speed
876	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: v !! Lowest level wind speed
877	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: zlev !! Height of first layer
878	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: qair !! Lowest level specific humidity
879	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: precip_rain !! Rain precipitation
880	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: precip_snow !! Snow precipitation
881	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: lwdown !! Down-welling long-wave flux
882	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: swnet !! Net surface short-wave flux
883	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: swdown !! Downwelling surface short-wave flux
884	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: temp_air !! Air temperature in Kelvin
885	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: epot_air !! Air potential energy
886	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: petAcoef !! Coeficients A from the PBL resolution
887	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: peqAcoef !! One for T and another for q
888	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: petBcoef !! Coeficients B from the PBL resolution
889	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: peqBcoef !! One for T and another for q
890	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: pb !! Surface pressure
891	REAL(r_std),DIMENSION (kjpindex,2), INTENT(in) :: latlon !! Geographical coordinates
892	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: zcontfrac !! Fraction of continent
893	INTEGER(i_std),DIMENSION (kjpindex,NbNeighb), INTENT(in):: zneighbours !! neighbours
894	REAL(r_std),DIMENSION (kjpindex,2), INTENT(in) :: zresolution !! size of the grid box
895	REAL(r_std),DIMENSION (iim_glo,jjm_glo), INTENT(IN) :: lon_scat_g !! The scattered values for longitude
896	REAL(r_std),DIMENSION (iim_glo,jjm_glo), INTENT(IN) :: lat_scat_g !! The scattered values for latitudes
897
898	!! 0.2 Output variables
899	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: z0m !! Surface roughness (momentum)
900	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: coastalflow_cpl!! Diffuse flow of water into the ocean (m^3/s)
901	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: riverflow_cpl !! Largest rivers flowing into the ocean (m^3/s)
902	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: tsol_rad !! Radiative surface temperature
903	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: vevapp !! Total of evaporation
904	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: temp_sol_new !! New soil temperature
905	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: qsurf !! Surface specific humidity
906	REAL(r_std),DIMENSION (kjpindex,2), INTENT(out) :: albedo !! Albedo
907	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: fluxsens !! Sensible chaleur flux
908	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: fluxlat !! Latent chaleur flux
909	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: emis !! Emissivity
910
911	!! 0.3 Modified variables
912	REAL(r_std),DIMENSION (kjpindex), INTENT(inout) :: cdrag !! Cdrag
913
914	!! 0.4 Optional input and output variables
915	REAL(r_std),DIMENSION (kjpindex), INTENT(in), OPTIONAL :: q2m !! Surface specific humidity
916	REAL(r_std),DIMENSION (kjpindex), INTENT(in), OPTIONAL :: t2m !! Surface air temperature
917	REAL(r_std),DIMENSION (kjpindex), INTENT(out),OPTIONAL :: z0h !! Surface roughness (heat)
918	CHARACTER(LEN=*),DIMENSION(:), OPTIONAL, INTENT(IN) :: field_in_names !! Names for deposit variables to be transported
919	!! from chemistry model by GCM to ORCHIDEE
920	REAL(r_std),DIMENSION(:,:), OPTIONAL, INTENT(IN) :: fields_in !! Fields for deposit variables to be transported
921	!! from chemistry model by GCM to ORCHIDEE
922	CHARACTER(LEN=*),DIMENSION(:), OPTIONAL, INTENT(IN) :: field_out_names!! Names for emission variables to be transported
923	!! to chemistry model by GCM from ORCHIDEE
924	REAL(r_std),DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: fields_out !! Fields for emission variables to be transported
925	!! to chemistry model by GCM from ORCHIDEE
926
927
928	!! 0.5 Local variables
929	REAL(r_std),DIMENSION (kjpindex) :: zprecip_rain !! Work array to keep precip_rain
930	REAL(r_std),DIMENSION (kjpindex) :: zprecip_snow !! Work array to keep precip_snow
931	REAL(r_std),DIMENSION (kjpindex) :: zz0m !! Work array to keep zz0m
932	REAL(r_std),DIMENSION (kjpindex) :: zz0h !! Work array to keep zz0h
933	REAL(r_std),DIMENSION (kjpindex) :: zcdrag !! Work array for surface drag
934	REAL(r_std),DIMENSION (kjpindex) :: zcoastal !! Work array to keep coastal flow (m^3/dt)
935	REAL(r_std),DIMENSION (kjpindex) :: zriver !! Work array to keep river out flow (m^3/dt)
936	REAL(r_std),DIMENSION (kjpindex) :: znetco2 !! Work array to keep netco2flux
937	REAL(r_std),DIMENSION (kjpindex) :: zcarblu !! Work array to keep fco2_land_use
938	REAL(r_std),DIMENSION (kjpindex) :: ztsol_rad !! Work array to keep tsol_rad
939	REAL(r_std),DIMENSION (kjpindex) :: zvevapp !! Work array to keep vevapp
940	REAL(r_std),DIMENSION (kjpindex) :: ztemp_sol_new !! Work array to keep temp_sol_new
941	REAL(r_std),DIMENSION (kjpindex) :: zqsurf !! Work array to keep qsurf
942	REAL(r_std),DIMENSION (kjpindex,2) :: zalbedo !! Work array to keep albedo
943	REAL(r_std),DIMENSION (kjpindex) :: zfluxsens !! Work array to keep fluxsens
944	REAL(r_std),DIMENSION (kjpindex) :: zfluxlat !! Work array to keep fluxlat
945	REAL(r_std),DIMENSION (kjpindex) :: zemis !! Work array to keep emis
946	REAL(r_std),DIMENSION (kjpindex) :: zcoszang !! Work array to keep coszang
947	REAL(r_std),DIMENSION (kjpindex) :: q2m_loc !! Work array for q2m or qair
948	REAL(r_std),DIMENSION (kjpindex) :: t2m_loc !! Work array for t2m or temp_air
949	REAL(r_std),DIMENSION (:,:),ALLOCATABLE :: lon_scat !! The scattered values for longitude
950	REAL(r_std),DIMENSION (:,:),ALLOCATABLE :: lat_scat !! The scattered values for latitude
951	INTEGER(i_std) :: i, j, ik
952	INTEGER(i_std) :: ier
953	INTEGER(i_std) :: itau_sechiba
954	REAL(r_std) :: mx, zlev_mean
955	REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: tmp_lon, tmp_lat, tmp_lev
956	INTEGER :: old_fileout !! old Logical Int for std IO output
957	REAL,ALLOCATABLE,DIMENSION(:,:) :: lalo_mpi
958	REAL,ALLOCATABLE,DIMENSION(:) :: zlev_glo1D
959	REAL(r_std),DIMENSION (kjpindex) :: landpoints !! Land point vector
960	REAL(r_std) :: tau_outflow !! Number of days for temoral filter on river- and coastalflow
961
962
963
964	CALL ipslnlf_p(new_number=numout, old_number=old_fileout)
965	!
966	! Configuration of SSL specific parameters
967	!
968	CALL control_initialize(xrdt)
969
970	! Initialize specific write level
971	!printlev_loc=get_printlev('instersurf')
972
973	IF ( printlev_loc>=1 ) WRITE(numout,*) 'Entering intersurf_initialize_gathered'
974
975	! Set the variable ok_q2m_t2m=true if q2m and t2m are present in the call from the gcm.
976	! If one of the variables are not present in this subroutine, set ok_q2m_t2m=.FALSE.
977	! Otherwise do not change the current value. Note that the current value for ok_q2m_t2m comes
978	! either from default initialization (true) or from intersurf_main_gathered.
979	IF (.NOT. PRESENT(q2m) .OR. .NOT. PRESENT(t2m)) THEN
980	ok_q2m_t2m=.FALSE.
981	END IF
982
983	IF (ok_q2m_t2m) THEN
984	t2m_loc=t2m
985	q2m_loc=q2m
986	ELSE
987	t2m_loc=temp_air
988	q2m_loc=qair
989	END IF
990
991	CALL intsurf_time( kjit, date0 )
992
993
994	CALL ioget_calendar (one_year, one_day)
995
996	IF (is_omp_root) THEN
997	ALLOCATE(lon_scat(iim_g,jj_nb))
998	ALLOCATE(lat_scat(iim_g,jj_nb))
999	ELSE
1000	ALLOCATE(lon_scat(1,1))
1001	ALLOCATE(lat_scat(1,1))
1002	ENDIF
1003
1004	CALL init_WriteField_p
1005
1006	!
1007	! Create the internal coordinate table
1008	!
1009	lalo(:,:) = latlon(:,:)
1010	CALL gather(lalo,lalo_g)
1011	!
1012	!-
1013	!- Store variable to help describe the grid
1014	!- once the points are gathered.
1015	!-
1016	neighbours(:,:) = zneighbours(:,:)
1017	CALL gather(neighbours,neighbours_g)
1018	!
1019	resolution(:,:) = zresolution(:,:)
1020	CALL gather(resolution,resolution_g)
1021	!
1022	area(:) = resolution(:,1)*resolution(:,2)
1023	CALL gather(area,area_g)
1024	!
1025	!- Store the fraction of the continents only once so that the user
1026	!- does not change them afterwards.
1027	!
1028	contfrac(:) = zcontfrac(:)
1029	CALL gather(contfrac,contfrac_g)
1030	!
1031	!
1032	! Create the internal coordinate table
1033	!
1034	IF ( (.NOT.ALLOCATED(tmp_lon))) THEN
1035	ALLOCATE(tmp_lon(iim_g,jj_nb))
1036	ENDIF
1037	IF ( (.NOT.ALLOCATED(tmp_lat))) THEN
1038	ALLOCATE(tmp_lat(iim_g,jj_nb))
1039	ENDIF
1040	IF ( (.NOT.ALLOCATED(tmp_lev))) THEN
1041	ALLOCATE(tmp_lev(iim_g,jj_nb))
1042	ENDIF
1043	!
1044	! Either we have the scattered coordinates as arguments or
1045	! we have to do the work here.
1046	!
1047	IF (is_omp_root) THEN
1048	lon_scat(:,:)=zero
1049	lat_scat(:,:)=zero
1050	CALL scatter2D_mpi(lon_scat_g,lon_scat)
1051	CALL scatter2D_mpi(lat_scat_g,lat_scat)
1052	lon_scat(:,1)=lon_scat(:,2)
1053	lon_scat(:,jj_nb)=lon_scat(:,2)
1054	lat_scat(:,1)=lat_scat(iim_g,1)
1055	lat_scat(:,jj_nb)=lat_scat(1,jj_nb)
1056
1057	tmp_lon(:,:) = lon_scat(:,:)
1058	tmp_lat(:,:) = lat_scat(:,:)
1059
1060	IF (is_mpi_root) THEN
1061	lon_g(:,:) = lon_scat_g(:,:)
1062	lat_g(:,:) = lat_scat_g(:,:)
1063	ENDIF
1064	ENDIF
1065	!
1066
1067	!ANNE ici possibilite de calculer la grille du modele ? (lignes 965 ??
1068
1069
1070	!ANNE calcul zlev, conserve la version de Martial
1071	IF (is_root_prc) ALLOCATE(zlev_glo1D(nbp_glo))
1072	CALL gather(zlev,zlev_glo1D)
1073
1074	IF (is_root_prc) THEN
1075	DO ik=1, nbp_glo
1076	j = INT( (index_g(ik)-1) / iim_g ) + 1
1077	i = index_g(ik) - (j-1) * iim_g
1078	zlev_g(i,j) = zlev_glo1D(ik)
1079	ENDDO
1080	ENDIF
1081
1082	!Config Key = FORCE_CO2_VEG
1083	!Config Desc = Flag to force the value of atmospheric CO2 for vegetation.
1084	!Config If = Only in coupled mode
1085	!Config Def = FALSE
1086	!Config Help = If this flag is set to true, the ATM_CO2 parameter is used
1087	!Config to prescribe the atmospheric CO2.
1088	!Config This Flag is only use in couple mode.
1089	!Config Units = [FLAG]
1090	fatmco2=.FALSE.
1091	CALL getin_p('FORCE_CO2_VEG',fatmco2)
1092	!
1093	! Next flag is only use in couple mode with a gcm in intersurf.
1094	! In forced mode, it has already been read and set in driver.
1095	IF ( fatmco2 ) THEN
1096	!Config Key = ATM_CO2
1097	!Config IF = FORCE_CO2_VEG (only in coupled mode)
1098	!Config Desc = Value for atm CO2
1099	!Config Def = 350.
1100	!Config Help = Value to prescribe the atm CO2.
1101	!Config For pre-industrial simulations, the value is 286.2 .
1102	!Config 348. for 1990 year.
1103	!Config Units = [ppm]
1104	atmco2=350.
1105	CALL getin_p('ATM_CO2',atmco2)
1106	WRITE(numout,*) 'atmco2 ',atmco2
1107	ENDIF
1108
1109	CALL ioipslctrl_restini(kjit, date0, xrdt, rest_id, rest_id_stom, itau_offset, date0_shifted)
1110	itau_sechiba = kjit + itau_offset
1111
1112	!!- Initialize module for output with XIOS
1113	!
1114	CALL xios_orchidee_init( MPI_COMM_ORCH, &
1115	date0, year, month, day, &
1116	tmp_lon, tmp_lat, znt )
1117
1118	!- Initialize IOIPSL sechiba output files
1119	CALL ioipslctrl_history(iim_g, jj_nb, tmp_lon, tmp_lat, kindex, kjpindex, itau_sechiba, &
1120	date0_shifted, xrdt, hist_id, hist2_id, hist_id_stom, hist_id_stom_IPCC)
1121
1122	CALL bcast_omp(hist_id)
1123	CALL bcast_omp(hist2_id)
1124	CALL bcast_omp(hist_id_stom)
1125	CALL bcast_omp(hist_id_stom_IPCC)
1126
1127	! Count number of extra output fields to the GCM if it is not already done.
1128	IF (nb_fields_out == -1) THEN
1129	! nb_fields_out is not yet calculated. Do it now.
1130	! This means that the call is done directly from GCM.
1131	IF (PRESENT(field_out_names)) THEN
1132	nb_fields_out=SIZE(field_out_names)
1133	ELSE
1134	nb_fields_out=0
1135	ENDIF
1136	END IF
1137
1138	! Count number of extra input fields to the GCM if it is not already done.
1139	IF (nb_fields_in == -1) THEN
1140	! nb_fields_in is not yet calculated. Do it now.
1141	! This means that the call is done directly from GCM.
1142	IF (PRESENT(field_in_names)) THEN
1143	nb_fields_in=SIZE(field_in_names)
1144	ELSE
1145	nb_fields_in=0
1146	ENDIF
1147	END IF
1148
1149
1150	!
1151	!! Change to be in the orchidee context for XIOS
1152	!
1153	CALL xios_orchidee_change_context("orchidee")
1154
1155	!
1156	! Shift the time step to phase the two models
1157	!
1158	itau_sechiba = kjit + itau_offset
1159
1160	! Update the calendar in xios by sending the new time step
1161	! Special case : the model is only in initialization phase and the current itau_sechiba is not a real time step.
1162	! Therefor give itau_sechiba+1 to xios to have a correct time axis in output files.
1163	CALL xios_orchidee_update_calendar(itau_sechiba+1)
1164
1165	CALL intsurf_time( itau_sechiba, date0_shifted )
1166
1167	!
1168	! 1. Just change the units of some input fields
1169	!
1170	DO ik=1, kjpindex
1171
1172	zprecip_rain(ik) = precip_rain(ik)*xrdt
1173	zprecip_snow(ik) = precip_snow(ik)*xrdt
1174	zcdrag(ik) = cdrag(ik)
1175
1176	ENDDO
1177
1178	! Fields for deposit variables : to be transport from chemistry model by GCM to ORCHIDEE.
1179	! There are currently no fields to be transported into ORCHIDEE in this way
1180	DO i = 1, nb_fields_in
1181	WRITE(numout,*) i," Champ = ",TRIM(field_in_names(i))
1182	SELECT CASE(TRIM(field_in_names(i)))
1183	CASE DEFAULT
1184	CALL ipslerr_p (3,'intsurf_gathered', &
1185	'You ask in GCM an unknown field '//TRIM(field_in_names(i))//&
1186	' to give to ORCHIDEE for this specific version.',&
1187	'This model won''t be able to continue.', &
1188	'(check your tracer parameters in GCM)')
1189	END SELECT
1190	ENDDO
1191
1192	!
1193	! 3. save the grid
1194	!
1195	landpoints(:)=(/ ( REAL(ik), ik=1,kjpindex ) /)
1196	CALL histwrite_p(hist_id, 'LandPoints', itau_sechiba+1, landpoints, kjpindex, kindex)
1197	CALL histwrite_p(hist_id, 'Areas', itau_sechiba+1, area, kjpindex, kindex)
1198	IF ( ok_stomate ) THEN
1199	CALL histwrite_p(hist_id_stom, 'Areas', itau_sechiba+1, area, kjpindex, kindex)
1200	IF ( hist_id_stom_ipcc > 0 ) &
1201	CALL histwrite_p(hist_id_stom_IPCC, 'Areas', itau_sechiba+1, area, kjpindex, kindex)
1202	ENDIF
1203	CALL histwrite_p(hist_id, 'Contfrac', itau_sechiba+1, contfrac, kjpindex, kindex)
1204
1205	! Syncronize output but only if flag ok_histsync is set to true
1206	IF (ok_histsync) THEN
1207	IF (is_omp_root .AND. hist_id > 0) THEN
1208	CALL histsync(hist_id)
1209	END IF
1210	END IF
1211
1212	IF ( hist2_id > 0 ) THEN
1213	CALL histwrite_p(hist2_id, 'LandPoints', itau_sechiba+1, landpoints, kjpindex, kindex)
1214	CALL histwrite_p(hist2_id, 'Areas', itau_sechiba+1, area, kjpindex, kindex)
1215	CALL histwrite_p(hist2_id, 'Contfrac', itau_sechiba+1, contfrac, kjpindex, kindex)
1216
1217	! Syncronize output but only if flag ok_histsync is set to true
1218	IF (ok_histsync .AND. is_omp_root) THEN
1219	CALL histsync(hist2_id)
1220	ENDIF
1221	ENDIF
1222	!
1223
1224	!
1225	! 4. call sechiba for continental points only
1226	!
1227	IF ( printlev_loc>=3 ) WRITE(numout,*) 'Calling sechiba_initialize'
1228
1229	CALL sechiba_initialize( &
1230	itau_sechiba, iim_g*jj_nb, kjpindex, kindex, &
1231	lalo, contfrac, neighbours, resolution, zlev, &
1232	u, v, qair, t2m_loc, temp_air, &
1233	petAcoef, peqAcoef, petBcoef, peqBcoef, &
1234	zprecip_rain, zprecip_snow, lwdown, swnet, swdown, &
1235	pb, rest_id, hist_id, hist2_id, &
1236	rest_id_stom, hist_id_stom, hist_id_stom_IPCC, &
1237	zcoastal, zriver, ztsol_rad, zvevapp, zqsurf, &
1238	zz0m, zz0h, zalbedo, zfluxsens, zfluxlat, zemis, &
1239	znetco2, zcarblu, ztemp_sol_new, zcdrag, zcoszang)
1240
1241	IF ( printlev_loc>=3 ) WRITE(numout,*) 'Out of sechiba_initialize'
1242
1243	!
1244	! 6. scatter output fields
1245	!
1246	DO ik=1, kjpindex
1247	z0m(ik) = zz0m(ik)
1248	tsol_rad(ik) = ztsol_rad(ik)
1249	vevapp(ik) = zvevapp(ik)/xrdt ! Transform into kg/m^2/s
1250	temp_sol_new(ik) = ztemp_sol_new(ik)
1251	qsurf(ik) = zqsurf(ik)
1252	albedo(ik,1) = zalbedo(ik,1)
1253	albedo(ik,2) = zalbedo(ik,2)
1254	fluxsens(ik) = zfluxsens(ik)
1255	fluxlat(ik) = zfluxlat(ik)
1256	emis(ik) = zemis(ik)
1257	cdrag(ik) = zcdrag(ik)
1258	ENDDO
1259	! z0h is a optional output variable. Check first if it is present in the call from LMDZ.
1260	IF ( PRESENT(z0h) ) z0h(:) = zz0h(:)
1261
1262	!Config Key = TAU_OUTFLOW
1263	!Config Desc = Number of days over which the coastal- and riverflow will be
1264	!distributed
1265	!Config If = Only in coupled mode
1266	!Config Def = 0
1267	!Config Help = The default value 0 makes the distribution instanteneous
1268	!Config Units = [days]
1269	tau_outflow = 0
1270	CALL getin_p('TAU_OUTFLOW',tau_outflow)
1271	IF (tau_outflow <=xrdt/one_day) THEN
1272	coeff_rel = 1.0
1273	ELSE
1274	coeff_rel = (1.0 - exp(-xrdt/(tau_outflow*one_day)))
1275	END IF
1276	IF (printlev_loc >=2) WRITE(numout,*),'tau_outflow, coeff_rel = ', tau_outflow, coeff_rel
1277
1278	! Allocate and read riverflow_cpl0 from restart file. Initialize to 0 if the
1279	! variable was not found in the restart file.
1280	ALLOCATE(riverflow_cpl0(kjpindex), stat=ier)
1281	IF (ier /= 0) CALL ipslerr_p(3,'intersurf_initialize_gathered', 'Error in allocation of riverflow_cpl0','','')
1282	CALL restget_p (rest_id, 'riverflow_cpl0', nbp_glo, 1, 1, kjit, .TRUE., riverflow_cpl0, "gather", nbp_glo, index_g)
1283	IF ( ALL(riverflow_cpl0(:) == val_exp) ) riverflow_cpl0(:)=0
1284
1285	! Allocate and read coastalflow_cpl0 from restart file. Initialize to 0 if
1286	! the variable was not found in the restart file.
1287	ALLOCATE(coastalflow_cpl0(kjpindex), stat=ier)
1288	IF (ier /= 0) CALL ipslerr_p(3,'intersurf_initialize_gathered', 'Error inallocation of coastalflow_cpl0','','')
1289	CALL restget_p (rest_id, 'coastalflow_cpl0', nbp_glo, 1, 1, kjit, .TRUE., coastalflow_cpl0, "gather", nbp_glo, index_g)
1290	IF ( ALL(coastalflow_cpl0(:) == val_exp) ) coastalflow_cpl0(:)=0
1291
1292	! Do not applay the filter now in initialization phase.
1293	! These variables will never be used anyway in the initialization phase.
1294	! Transform into m^3/s
1295	riverflow_cpl = zriver/xrdt
1296	coastalflow_cpl = zcoastal/xrdt
1297
1298
1299	! Fields for emission variables : to be transport by GCM to chemistry model.
1300	DO i = 1, nb_fields_out
1301	SELECT CASE(TRIM(field_out_names(i)))
1302	CASE("fCO2_land")
1303	fields_out(:,i)=znetco2(:)
1304	CASE("fCO2_land_use")
1305	fields_out(:,i)=zcarblu(:)
1306	CASE DEFAULT
1307	CALL ipslerr_p (3,'intsurf_gathered', &
1308	'You ask from GCM an unknown field '//TRIM(field_out_names(i))//&
1309	' to ORCHIDEE for this specific version.',&
1310	'This model won''t be able to continue.', &
1311	'(check your tracer parameters in GCM)')
1312	END SELECT
1313	END DO
1314
1315	IF(is_root_prc) CALL getin_dump
1316	lstep_init_intersurf = .FALSE.
1317
1318	CALL ipslnlf_p(new_number=old_fileout)
1319	!
1320	!! Change back to be in the LMDZ context for XIOS
1321	!
1322	CALL xios_orchidee_change_context("LMDZ")
1323
1324	END SUBROUTINE intersurf_initialize_gathered
1325
1326
1327	!! =============================================================================================================================
1328	!! SUBROUTINE: intersurf_main_gathered
1329	!!
1330	!>\BRIEF Main subroutine to call ORCHIDEE from the gcm (LMDZ) using variables on a 1D grid with only land points.
1331	!!
1332	!! DESCRIPTION: This subroutine is the main interface for ORCHIDEE when it is called from the gcm (LMDZ).
1333	!! The variables are all gathered before entering this subroutine on the 1D grid with only landpoints.
1334	!!
1335	!! \n
1336	!_ ==============================================================================================================================
1337
1338	SUBROUTINE intersurf_main_gathered (kjit, iim_glo, jjm_glo, kjpindex, kindex, xrdt, &
1339	lrestart_read, lrestart_write, latlon, zcontfrac, zneighbours, zresolution, date0, &
1340	zlev, u, v, qair, temp_air, epot_air, ccanopy, &
1341	cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
1342	precip_rain, precip_snow, lwdown, swnet, swdown, pb, &
1343	vevapp, fluxsens, fluxlat, coastalflow_cpl, riverflow_cpl, &
1344	tsol_rad, temp_sol_new, qsurf, albedo, emis, z0m,lon_scat_g, lat_scat_g, q2m, t2m, z0h,&
1345	field_out_names, fields_out, field_in_names, fields_in, &
1346	coszang)
1347
1348	USE mod_orchidee_para
1349	IMPLICIT NONE
1350
1351	!! 0. Variable and parameter declaratiot/
1352	!! 0.1 Input variables
1353	INTEGER(i_std),INTENT (in) :: kjit !! Time step number
1354	INTEGER(i_std),INTENT (in) :: iim_glo !! Dimension of global fields
1355	INTEGER(i_std),INTENT (in) :: jjm_glo !! Dimension of global fields
1356	INTEGER(i_std),INTENT (in) :: kjpindex !! Number of continental points
1357	REAL(r_std),INTENT (in) :: xrdt !! Time step in seconds
1358	LOGICAL, INTENT (in) :: lrestart_read !! Logical for _restart_ file to read
1359	LOGICAL, INTENT (in) :: lrestart_write !! Logical for _restart_ file to write'
1360	REAL(r_std), INTENT (in) :: date0 !! Date at which kjit = 0
1361	INTEGER(i_std),DIMENSION (kjpindex), INTENT (in) :: kindex !! Index for continental points
1362	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: u !! Lowest level wind speed
1363	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: v !! Lowest level wind speed
1364	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: zlev !! Height of first layer
1365	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: qair !! Lowest level specific humidity
1366	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: precip_rain !! Rain precipitation
1367	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: precip_snow !! Snow precipitation
1368	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: lwdown !! Down-welling long-wave flux
1369	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: swnet !! Net surface short-wave flux
1370	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: swdown !! Downwelling surface short-wave flux
1371	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: temp_air !! Air temperature in Kelvin
1372	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: epot_air !! Air potential energy
1373	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: ccanopy !! CO2 concentration in the canopy
1374	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: petAcoef !! Coeficients A from the PBL resolution
1375	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: peqAcoef !! One for T and another for q
1376	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: petBcoef !! Coeficients B from the PBL resolution
1377	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: peqBcoef !! One for T and another for q
1378	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: pb !! Surface pressure
1379	REAL(r_std),DIMENSION (kjpindex,2), INTENT(in) :: latlon !! Geographical coordinates
1380	REAL(r_std),DIMENSION (kjpindex), INTENT(in) :: zcontfrac !! Fraction of continent
1381	INTEGER(i_std),DIMENSION (kjpindex,NbNeighb), INTENT(in):: zneighbours !! neighbours
1382	REAL(r_std),DIMENSION (kjpindex,2), INTENT(in) :: zresolution !! size of the grid box
1383	REAL(r_std),DIMENSION (iim_glo,jjm_glo), INTENT(IN) :: lon_scat_g !! The scattered values for longitude
1384	REAL(r_std),DIMENSION (iim_glo,jjm_glo), INTENT(IN) :: lat_scat_g !! The scattered values for latitude
1385
1386	!! 0.2 Output variables
1387	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: z0m !! Surface roughness for momentum
1388	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: coastalflow_cpl !! Diffuse flow of water into the ocean (m^3/s)
1389	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: riverflow_cpl !! Largest rivers flowing into the ocean (m^3/s)
1390	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: tsol_rad !! Radiative surface temperature
1391	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: vevapp !! Total of evaporation
1392	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: temp_sol_new !! New soil temperature
1393	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: qsurf !! Surface specific humidity
1394	REAL(r_std),DIMENSION (kjpindex,2), INTENT(out) :: albedo !! Albedo
1395	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: fluxsens !! Sensible chaleur flux
1396	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: fluxlat !! Latent chaleur flux
1397	REAL(r_std),DIMENSION (kjpindex), INTENT(out) :: emis !! Emissivity
1398
1399	!! 0.3 Modified variables
1400	REAL(r_std),DIMENSION (kjpindex), INTENT(inout) :: cdrag !! Cdrag
1401
1402	!! 0.4 Optional input and output variables
1403	REAL(r_std),DIMENSION (kjpindex), INTENT(in), OPTIONAL:: q2m !! Surface specific humidity
1404	REAL(r_std),DIMENSION (kjpindex), INTENT(in), OPTIONAL:: t2m !! Surface air temperature
1405	REAL(r_std),DIMENSION (kjpindex), INTENT(out),OPTIONAL:: z0h !! Surface roughness for heat
1406	REAL(r_std), DIMENSION(kjpindex), OPTIONAL, INTENT(in):: coszang !! Cosine of the solar zenith angle (unitless)
1407	CHARACTER(LEN=*),DIMENSION(:), OPTIONAL, INTENT(IN) :: field_in_names !! Names for deposit variables to be transported
1408	!! from chemistry model by GCM to ORCHIDEE
1409	REAL(r_std),DIMENSION(:,:), OPTIONAL, INTENT(IN) :: fields_in !! Fields for deposit variables to be transported
1410	!! from chemistry model by GCM to ORCHIDEE
1411	CHARACTER(LEN=*),DIMENSION(:), OPTIONAL, INTENT(IN) :: field_out_names !! Names for emission variables to be transported
1412	!! to chemistry model by GCM from ORCHIDEE
1413	REAL(r_std),DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: fields_out !! Fields for emission variables to be transported
1414	!! to chemistry model by GCM from ORCHIDEE
1415
1416	!! 0.5 Local variables
1417	REAL(r_std),DIMENSION (kjpindex) :: zccanopy !! Work array to keep ccanopy
1418	REAL(r_std),DIMENSION (kjpindex) :: zprecip_rain !! Work array to keep precip_rain
1419	REAL(r_std),DIMENSION (kjpindex) :: zprecip_snow !! Work array to keep precip_snow
1420	REAL(r_std),DIMENSION (kjpindex) :: zz0m, zz0h !! Work array to keep zz0m, zz0h
1421	REAL(r_std),DIMENSION (kjpindex) :: zcdrag !! Work array for surface drag
1422	REAL(r_std),DIMENSION (kjpindex) :: zcoastal !! Work array to keep coastal flow (m^3/dt)
1423	REAL(r_std),DIMENSION (kjpindex) :: zriver !! Work array to keep river out flow (m^3/dt)
1424	REAL(r_std),DIMENSION (kjpindex) :: znetco2 !! Work array to keep netco2flux
1425	REAL(r_std),DIMENSION (kjpindex) :: zcarblu !! Work array to keep fco2_land_use
1426	REAL(r_std),DIMENSION (kjpindex) :: ztsol_rad !! Work array to keep tsol_rad
1427	REAL(r_std),DIMENSION (kjpindex) :: zvevapp !! Work array to keep vevapp
1428	REAL(r_std),DIMENSION (kjpindex) :: ztemp_sol_new !! Work array to keep temp_sol_new
1429	REAL(r_std),DIMENSION (kjpindex) :: zqsurf !! Work array to keep qsurf
1430	REAL(r_std),DIMENSION (kjpindex,2) :: zalbedo !! Work array to keep albedo
1431	REAL(r_std),DIMENSION (kjpindex) :: zfluxsens !! Work array to keep fluxsens
1432	REAL(r_std),DIMENSION (kjpindex) :: zfluxlat !! Work array to keep fluxlat
1433	REAL(r_std),DIMENSION (kjpindex) :: zemis !! Work array to keep emis
1434	REAL(r_std),DIMENSION (kjpindex) :: zcoszang !! Work array to keep coszang
1435	REAL(r_std),DIMENSION (kjpindex) :: q2m_loc !! Work array for q2m or qair
1436	REAL(r_std),DIMENSION (kjpindex) :: t2m_loc !! Work array for t2m or temp_air
1437	REAL(r_std),DIMENSION (:,:),ALLOCATABLE :: lon_scat !! The scattered values for longitude
1438	REAL(r_std),DIMENSION (:,:),ALLOCATABLE :: lat_scat !! The scattered values for latitude
1439	INTEGER(i_std) :: i, j, ik
1440	INTEGER(i_std) :: ier
1441	INTEGER(i_std) :: itau_sechiba
1442	REAL(r_std) :: mx, zlev_mean
1443	REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: tmp_lon, tmp_lat, tmp_lev
1444	INTEGER :: old_fileout !! old Logical Int for std IO output
1445	REAL,ALLOCATABLE,DIMENSION(:,:) :: lalo_mpi
1446	REAL,ALLOCATABLE,DIMENSION(:) :: zlev_glo1D
1447	REAL(r_std),DIMENSION (kjpindex) :: landpoints !! Local landpoints vector
1448
1449
1450	CALL ipslnlf_p(new_number=numout, old_number=old_fileout)
1451
1452	IF (lstep_init_intersurf) THEN
1453	! Test if q2m and t2m are present
1454	IF (PRESENT(q2m) .AND. PRESENT(t2m)) THEN
1455	ok_q2m_t2m=.TRUE.
1456	ELSE
1457	ok_q2m_t2m=.FALSE.
1458	ENDIF
1459
1460	! Test if field_out_names and field_in_names are present and if so, count
1461	! the number of extra fields to exchange.
1462	IF (PRESENT(field_out_names)) THEN
1463	nb_fields_out=SIZE(field_out_names)
1464	ELSE
1465	nb_fields_out=0
1466	ENDIF
1467
1468	IF (PRESENT(field_in_names)) THEN
1469	nb_fields_in=SIZE(field_in_names)
1470	ELSE
1471	nb_fields_in=0
1472	ENDIF
1473
1474	CALL intersurf_initialize_gathered (kjit, iim_glo, jjm_glo, kjpindex, kindex, xrdt, &
1475	lrestart_read, lrestart_write, latlon, zcontfrac, zneighbours, zresolution, date0, &
1476	zlev, u, v, qair, temp_air, epot_air, &
1477	cdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
1478	precip_rain, precip_snow, lwdown, swnet, swdown, pb, &
1479	vevapp, fluxsens, fluxlat, coastalflow_cpl, riverflow_cpl, &
1480	tsol_rad, temp_sol_new, qsurf, albedo, emis, z0m,lon_scat_g, lat_scat_g, q2m, t2m, zz0h,&
1481	field_out_names, fields_out, field_in_names, fields_in )
1482
1483	! z0h is a optional output variable. Check first if it is present in the call from LMDZ.
1484	IF ( PRESENT(z0h) ) z0h(:) = zz0h(:)
1485	! Return from subroutine intersurf_main_gathered
1486	RETURN
1487	END IF
1488
1489	!
1490	!! Change to be in the orchidee context for XIOS
1491	!
1492	CALL xios_orchidee_change_context("orchidee")
1493
1494	!
1495	! Shift the time step to phase the two models
1496	!
1497	itau_sechiba = kjit + itau_offset
1498
1499	! Update the calendar in xios by sending the new time step
1500	CALL xios_orchidee_update_calendar(itau_sechiba)
1501
1502	CALL intsurf_time( itau_sechiba, date0_shifted )
1503
1504	! Test LMDz inputs
1505	IF (check_INPUTS) THEN
1506	IF ( sec <= 7200 ) THEN
1507	WRITE(numout,*) "sec = ",sec
1508	CALL WriteFieldI_p("Wu",u)
1509	WRITE(numout,*) "Lowest level wind speed :",u
1510	CALL WriteFieldI_p("Wv",v)
1511	WRITE(numout,*) "Lowest level wind speed :",v
1512	CALL WriteFieldI_p("Wzlev",zlev)
1513	WRITE(numout,*) "Height of first layer :",zlev
1514	CALL WriteFieldI_p("Wqair",qair)
1515	WRITE(numout,*) "Lowest level specific humidity :",qair
1516	CALL WriteFieldI_p("Wprecip_rain",precip_rain)
1517	WRITE(numout,*) "Rain precipitation :",precip_rain
1518	CALL WriteFieldI_p("Wprecip_snow",precip_snow)
1519	WRITE(numout,*) "Snow precipitation :",precip_snow
1520	CALL WriteFieldI_p("Wlwdown",lwdown)
1521	WRITE(numout,*) "Down-welling long-wave flux :",lwdown
1522	CALL WriteFieldI_p("Wswnet",swnet)
1523	WRITE(numout,*) "Net surface short-wave flux :",swnet
1524	CALL WriteFieldI_p("Wswdown",swdown)
1525	WRITE(numout,*) "Downwelling surface short-wave flux :",swdown
1526	CALL WriteFieldI_p("Wtemp_air",temp_air)
1527	WRITE(numout,*) "Air temperature in Kelvin :",temp_air
1528	CALL WriteFieldI_p("Wepot_air",epot_air)
1529	WRITE(numout,*) "Air potential energy :",epot_air
1530	CALL WriteFieldI_p("Wccanopy",ccanopy)
1531	WRITE(numout,*) "CO2 concentration in the canopy :",ccanopy
1532	CALL WriteFieldI_p("WpetAcoef",petAcoef)
1533	WRITE(numout,*) "Coeficients A from the PBL resolution :",petAcoef
1534	CALL WriteFieldI_p("WpeqAcoef",peqAcoef)
1535	WRITE(numout,*) "One for T and another for q :",peqAcoef
1536	CALL WriteFieldI_p("WpetBcoef",petBcoef)
1537	WRITE(numout,*) "Coeficients B from the PBL resolution :",petBcoef
1538	CALL WriteFieldI_p("WpeqBcoef",peqBcoef)
1539	WRITE(numout,*) "One for T and another for q :",peqBcoef
1540	CALL WriteFieldI_p("Wcdrag",cdrag)
1541	WRITE(numout,*) "Cdrag :",cdrag
1542	CALL WriteFieldI_p("Wpb",pb)
1543	WRITE(numout,*) "Surface pressure :",pb
1544	CALL WriteFieldI_p("Wzcontfrac",zcontfrac)
1545	WRITE(numout,*) "Fraction of continent :",zcontfrac
1546	IF ( ok_q2m_t2m) THEN
1547	CALL WriteFieldI_p("Wq2m",q2m)
1548	WRITE(numout,*) "Surface specific humidity :",q2m
1549	CALL WriteFieldI_p("Wt2m",t2m)
1550	WRITE(numout,*) "Surface air temperature :",t2m
1551	ENDIF
1552	ENDIF
1553	ENDIF
1554
1555	!
1556	! 1. Just change the units of some input fields
1557	!
1558	DO ik=1, kjpindex
1559
1560	zprecip_rain(ik) = precip_rain(ik)*xrdt
1561	zprecip_snow(ik) = precip_snow(ik)*xrdt
1562	zcdrag(ik) = cdrag(ik)
1563
1564	ENDDO
1565
1566	!>> VOC in coupled mode
1567	IF ( PRESENT(coszang) ) THEN
1568	zcoszang(:) = coszang(:)
1569	ELSE
1570	zcoszang(:) = zero
1571	ENDIF
1572
1573	IF (check_INPUTS) THEN
1574	WRITE(numout,*) "Intersurf_main_gathered :"
1575	WRITE(numout,*) "Time step number = ",kjit
1576	WRITE(numout,*) "Dimension of input fields for local mpi process = ",iim_g, jj_nb
1577	WRITE(numout,*) "Number of continental points = ",kjpindex
1578	WRITE(numout,*) "Time step in seconds = ",xrdt
1579	WRITE(numout,*) "Logical for _restart_ file to read, write = ",lrestart_read,lrestart_write
1580	WRITE(numout,*) "Date at which kjit = 0 = ",date0
1581	WRITE(numout,*) "offset for OMP = ",offset_omp
1582	WRITE(numout,*) "Index for continental points = ",kindex
1583	IF (is_omp_root) THEN
1584	WRITE(numout,*) "ROOT OMP, Index global MPI : ",kindex_mpi(:)
1585	ENDIF
1586	IF (is_root_prc) THEN
1587	WRITE(numout,*) "ROOT global, Index global : ",index_g(:)
1588	ENDIF
1589	WRITE(numout,*) "Lowest level wind speed North = ",u
1590	WRITE(numout,*) "Lowest level wind speed East = ",v
1591	WRITE(numout,*) "Height of first layer = ",zlev
1592	WRITE(numout,*) "Lowest level specific humidity = ",qair
1593	WRITE(numout,*) "Rain precipitation = ",zprecip_rain
1594	WRITE(numout,*) "Snow precipitation = ",zprecip_snow
1595	WRITE(numout,*) "Down-welling long-wave flux = ",lwdown
1596	WRITE(numout,*) "Net surface short-wave flux = ",swnet
1597	WRITE(numout,*) "Downwelling surface short-wave flux = ",swdown
1598	WRITE(numout,*) "Air temperature in Kelvin = ",temp_air
1599	WRITE(numout,*) "Air potential energy = ",epot_air
1600	WRITE(numout,*) "CO2 concentration in the canopy = ",ccanopy
1601	WRITE(numout,*) "Coeficients A from the PBL resolution = ",petAcoef
1602	WRITE(numout,*) "One for T and another for q = ",peqAcoef
1603	WRITE(numout,*) "Coeficients B from the PBL resolution = ",petBcoef
1604	WRITE(numout,*) "One for T and another for q = ",peqBcoef
1605	WRITE(numout,*) "Cdrag = ",zcdrag
1606	WRITE(numout,*) "Surface pressure = ",pb
1607	WRITE(numout,*) "Geographical land coordinates lon = ", lalo(:,2)
1608	WRITE(numout,*) "Geographical land coordinates lat = ", lalo(:,1)
1609	WRITE(numout,*) "Fraction of continent in the grid = ",zcontfrac
1610	ENDIF
1611
1612
1613	! Fields for deposit variables : to be transport from chemistry model by GCM to ORCHIDEE.
1614	DO i = 1, nb_fields_in
1615	WRITE(numout,*) i," Champ = ",TRIM(field_in_names(i))
1616	SELECT CASE(TRIM(field_in_names(i)))
1617	CASE DEFAULT
1618	CALL ipslerr_p (3,'intsurf_gathered', &
1619	'You ask in GCM an unknown field '//TRIM(field_in_names(i))//&
1620	' to give to ORCHIDEE for this specific version.',&
1621	'This model won''t be able to continue.', &
1622	'(check your tracer parameters in GCM)')
1623	END SELECT
1624	ENDDO
1625
1626	!
1627	! 2. modification of co2
1628	!
1629	IF ( fatmco2 ) THEN
1630	zccanopy(:) = atmco2
1631	WRITE (numout,*) 'Modification of the ccanopy value. CO2 = ',atmco2
1632	ELSE
1633	zccanopy(:) = ccanopy(:)
1634	ENDIF
1635
1636	!
1637	! 4. call sechiba for continental points only
1638	!
1639	IF ( printlev_loc>=3 ) WRITE(numout,*) 'Calling sechiba'
1640
1641
1642	IF (ok_q2m_t2m) THEN
1643	t2m_loc=t2m
1644	q2m_loc=q2m
1645	ELSE
1646	t2m_loc=temp_air
1647	q2m_loc=qair
1648	END IF
1649
1650	CALL sechiba_main (itau_sechiba, iim_g*jj_nb, kjpindex, kindex, &
1651	lrestart_read, lrestart_write, &
1652	lalo, contfrac, neighbours, resolution, &
1653	zlev, u, v, qair, q2m_loc, t2m_loc, temp_air, epot_air, zccanopy, &
1654	zcdrag, petAcoef, peqAcoef, petBcoef, peqBcoef, &
1655	zprecip_rain ,zprecip_snow, lwdown, swnet, swdown, zcoszang, pb, &
1656	zvevapp, zfluxsens, zfluxlat, zcoastal, zriver, znetco2, zcarblu, &
1657	ztsol_rad, ztemp_sol_new, zqsurf, zalbedo, zemis, zz0m, zz0h, &
1658	rest_id, hist_id, hist2_id, rest_id_stom, hist_id_stom, hist_id_stom_IPCC )
1659
1660	IF ( printlev_loc>=3 ) WRITE(numout,*) 'out of SECHIBA'
1661
1662	!
1663	! 6. scatter output fields
1664	!
1665	DO ik=1, kjpindex
1666	z0m(ik) = zz0m(ik)
1667	tsol_rad(ik) = ztsol_rad(ik)
1668	temp_sol_new(ik) = ztemp_sol_new(ik)
1669	qsurf(ik) = zqsurf(ik)
1670	albedo(ik,1) = zalbedo(ik,1)
1671	albedo(ik,2) = zalbedo(ik,2)
1672	fluxsens(ik) = zfluxsens(ik)
1673	fluxlat(ik) = zfluxlat(ik)
1674	emis(ik) = zemis(ik)
1675	cdrag(ik) = zcdrag(ik)
1676
1677	! Transform the water fluxes into Kg/m^2/s
1678	vevapp(ik) = zvevapp(ik)/xrdt
1679
1680	ENDDO
1681
1682	! Applay time filter to distribut the river- and coastalflow over a longer time period.
1683	! When coeff_rel=1(default case when tau_outflow=0), the distribution is instanteneous.
1684	! Use TAU_OUTFLOW in run.def to set the number of days of distribution.
1685	! The water fluxes zriver and zcoastal coming from sechiba are at the same
1686	! time transfromed from m^3/dt_sechiba into m^3/s by dividing with the sechiba time step
1687	! (xrdt).
1688	riverflow_cpl = coeff_relzriver/xrdt + (1.-coeff_rel)riverflow_cpl0
1689	riverflow_cpl0 = riverflow_cpl
1690
1691	coastalflow_cpl = coeff_relzcoastal/xrdt + (1.-coeff_rel)coastalflow_cpl0
1692	coastalflow_cpl0 = coastalflow_cpl
1693
1694
1695	! z0h is a optional output variable. Check first if it is present in the call from LMDZ.
1696	IF ( PRESENT(z0h) ) z0h(:) = zz0h(:)
1697
1698	CALL xios_orchidee_send_field("LandPoints" ,(/ ( REAL(ik), ik=1,kjpindex ) /))
1699	CALL xios_orchidee_send_field("Areas", area)
1700	CALL xios_orchidee_send_field("Contfrac",contfrac)
1701	CALL xios_orchidee_send_field("evap",zvevapp*one_day/dt_sechiba)
1702	CALL xios_orchidee_send_field("coastalflow_cpl",coastalflow_cpl)
1703	CALL xios_orchidee_send_field("riverflow_cpl",riverflow_cpl)
1704	CALL xios_orchidee_send_field("temp_sol_C",ztemp_sol_new-ZeroCelsius)
1705	CALL xios_orchidee_send_field("temp_sol_K",ztemp_sol_new)
1706	CALL xios_orchidee_send_field("fluxsens",zfluxsens)
1707	CALL xios_orchidee_send_field("fluxlat",zfluxlat)
1708	CALL xios_orchidee_send_field("tair",temp_air)
1709	CALL xios_orchidee_send_field("qair",qair)
1710	CALL xios_orchidee_send_field("swnet",swnet)
1711	CALL xios_orchidee_send_field("swdown",swdown)
1712	! pb in hPa, output in Pa
1713	CALL xios_orchidee_send_field("Psurf",pb*100.)
1714
1715
1716	IF (ok_q2m_t2m) THEN
1717	CALL xios_orchidee_send_field("t2m",t2m)
1718	CALL xios_orchidee_send_field("q2m",q2m)
1719	ELSE
1720	CALL xios_orchidee_send_field("t2m",temp_air)
1721	CALL xios_orchidee_send_field("q2m",qair)
1722	ENDIF
1723
1724	IF ( .NOT. almaoutput ) THEN
1725	!
1726	! scattered during the writing
1727	!
1728	CALL histwrite_p (hist_id, 'evap', itau_sechiba, zvevapp, kjpindex, kindex)
1729	CALL histwrite_p (hist_id, 'coastalflow',itau_sechiba, zcoastal, kjpindex, kindex)
1730	CALL histwrite_p (hist_id, 'riverflow',itau_sechiba, zriver, kjpindex, kindex)
1731	!
1732	CALL histwrite_p (hist_id, 'temp_sol', itau_sechiba, ztemp_sol_new, kjpindex, kindex)
1733
1734	CALL histwrite_p (hist_id, 'tsol_max', itau_sechiba, ztemp_sol_new, kjpindex, kindex)
1735	CALL histwrite_p (hist_id, 'tsol_min', itau_sechiba, ztemp_sol_new, kjpindex, kindex)
1736	CALL histwrite_p (hist_id, 'fluxsens', itau_sechiba, zfluxsens, kjpindex, kindex)
1737	CALL histwrite_p (hist_id, 'fluxlat', itau_sechiba, zfluxlat, kjpindex, kindex)
1738	CALL histwrite_p (hist_id, 'swnet', itau_sechiba, swnet, kjpindex, kindex)
1739	CALL histwrite_p (hist_id, 'swdown', itau_sechiba, swdown, kjpindex, kindex)
1740	CALL histwrite_p (hist_id, 'alb_vis', itau_sechiba, zalbedo(:,1), kjpindex, kindex)
1741	CALL histwrite_p (hist_id, 'alb_nir', itau_sechiba, zalbedo(:,2), kjpindex, kindex)
1742	CALL histwrite_p (hist_id, 'tair', itau_sechiba, temp_air, kjpindex, kindex)
1743	CALL histwrite_p (hist_id, 'qair', itau_sechiba, qair, kjpindex, kindex)
1744	IF (ok_q2m_t2m) THEN
1745	CALL histwrite_p (hist_id, 't2m', itau_sechiba, t2m, kjpindex, kindex)
1746	CALL histwrite_p (hist_id, 'q2m', itau_sechiba, q2m, kjpindex, kindex)
1747	ELSE
1748	CALL histwrite_p (hist_id, 't2m', itau_sechiba, temp_air, kjpindex, kindex)
1749	CALL histwrite_p (hist_id, 'q2m', itau_sechiba, qair, kjpindex, kindex)
1750	ENDIF
1751	!
1752	IF ( hist2_id > 0 ) THEN
1753	CALL histwrite_p (hist2_id, 'evap', itau_sechiba, zvevapp, kjpindex, kindex)
1754	CALL histwrite_p (hist2_id, 'coastalflow',itau_sechiba, zcoastal, kjpindex, kindex)
1755	CALL histwrite_p (hist2_id, 'riverflow',itau_sechiba, zriver, kjpindex, kindex)
1756	!
1757	CALL histwrite_p (hist2_id, 'temp_sol', itau_sechiba, temp_sol_new, kjpindex, kindex)
1758	CALL histwrite_p (hist2_id, 'tsol_max', itau_sechiba, temp_sol_new, kjpindex, kindex)
1759	CALL histwrite_p (hist2_id, 'tsol_min', itau_sechiba, temp_sol_new, kjpindex, kindex)
1760	CALL histwrite_p (hist2_id, 'fluxsens', itau_sechiba, zfluxsens, kjpindex, kindex)
1761	CALL histwrite_p (hist2_id, 'fluxlat', itau_sechiba, zfluxlat, kjpindex, kindex)
1762	CALL histwrite_p (hist2_id, 'swnet', itau_sechiba, swnet, kjpindex, kindex)
1763	CALL histwrite_p (hist2_id, 'swdown', itau_sechiba, swdown, kjpindex, kindex)
1764	CALL histwrite_p (hist2_id, 'alb_vis', itau_sechiba, zalbedo(:,1), kjpindex, kindex)
1765	CALL histwrite_p (hist2_id, 'alb_nir', itau_sechiba, zalbedo(:,2), kjpindex, kindex)
1766	CALL histwrite_p (hist2_id, 'tair', itau_sechiba, temp_air, kjpindex, kindex)
1767	CALL histwrite_p (hist2_id, 'qair', itau_sechiba, qair, kjpindex, kindex)
1768	IF (ok_q2m_t2m) THEN
1769	CALL histwrite_p (hist2_id, 't2m', itau_sechiba, t2m, kjpindex, kindex)
1770	CALL histwrite_p (hist2_id, 'q2m', itau_sechiba, q2m, kjpindex, kindex)
1771	ELSE
1772	CALL histwrite_p (hist2_id, 't2m', itau_sechiba, temp_air, kjpindex, kindex)
1773	CALL histwrite_p (hist2_id, 'q2m', itau_sechiba, qair, kjpindex, kindex)
1774	ENDIF
1775	ENDIF
1776	ELSE
1777	CALL histwrite_p (hist_id, 'Evap', itau_sechiba, zvevapp, kjpindex, kindex)
1778	CALL histwrite_p (hist_id, 'SWnet', itau_sechiba, swnet, kjpindex, kindex)
1779	CALL histwrite_p (hist_id, 'Qh', itau_sechiba, zfluxsens, kjpindex, kindex)
1780	CALL histwrite_p (hist_id, 'Qle', itau_sechiba, zfluxlat, kjpindex, kindex)
1781	CALL histwrite_p (hist_id, 'AvgSurfT', itau_sechiba, ztemp_sol_new, kjpindex, kindex)
1782	CALL histwrite_p (hist_id, 'RadT', itau_sechiba, ztemp_sol_new, kjpindex, kindex)
1783	!
1784	IF ( hist2_id > 0 ) THEN
1785	CALL histwrite_p (hist2_id, 'Evap', itau_sechiba, zvevapp, kjpindex, kindex)
1786	CALL histwrite_p (hist2_id, 'SWnet', itau_sechiba, swnet, kjpindex, kindex)
1787	CALL histwrite_p (hist2_id, 'Qh', itau_sechiba, zfluxsens, kjpindex, kindex)
1788	CALL histwrite_p (hist2_id, 'Qle', itau_sechiba, zfluxlat, kjpindex, kindex)
1789	CALL histwrite_p (hist2_id, 'AvgSurfT', itau_sechiba, ztemp_sol_new, kjpindex, kindex)
1790	CALL histwrite_p (hist2_id, 'RadT', itau_sechiba, ztemp_sol_new, kjpindex, kindex)
1791	ENDIF
1792	ENDIF
1793
1794	! Syncronize output but only if flag ok_histsync is set to true
1795	IF (ok_histsync .AND. is_omp_root) THEN
1796	IF ( (dw .EQ. xrdt) .AND. hist_id > 0 ) THEN
1797	CALL histsync(hist_id)
1798	ENDIF
1799	ENDIF
1800
1801	! Fields for emission variables : to be transport by GCM to chemistry model.
1802	DO i = 1, nb_fields_out
1803	SELECT CASE(TRIM(field_out_names(i)))
1804	CASE("fCO2_land")
1805	fields_out(:,i)=znetco2(:)
1806	CASE("fCO2_land_use")
1807	fields_out(:,i)=zcarblu(:)
1808	CASE DEFAULT
1809	CALL ipslerr_p (3,'intsurf_gathered', &
1810	& 'You ask from GCM an unknown field '//TRIM(field_out_names(i))//&
1811	& ' to ORCHIDEE for this specific version.',&
1812	& 'This model won''t be able to continue.', &
1813	& '(check your tracer parameters in GCM)')
1814	END SELECT
1815	ENDDO
1816
1817	IF (printlev_loc >=3) WRITE (numout,*) ' intersurf_main done '
1818
1819	!Test ORCHIDEE Outputs
1820	IF (check_INPUTS) THEN
1821	IF ( sec <= 7200 ) THEN
1822	CALL WriteFieldI_p("Wcdrag",cdrag)
1823	WRITE(numout,*) "Cdrag :",cdrag
1824	CALL WriteFieldI_p("Wz0m",z0m)
1825	WRITE(numout,*) "Surface roughness :",z0m
1826	CALL WriteFieldI_p("Wcoastalflow",coastalflow_cpl)
1827	WRITE(numout,*) "Diffuse flow of water into the ocean (m^3/s) :",coastalflow_cpl
1828	CALL WriteFieldI_p("Wriverflow",riverflow_cpl)
1829	WRITE(numout,*) "Largest rivers flowing into the ocean (m^3/s) :",riverflow_cpl
1830	CALL WriteFieldI_p("Wtsol_rad",tsol_rad)
1831	WRITE(numout,*) "Radiative surface temperature :",tsol_rad
1832	CALL WriteFieldI_p("Wvevapp",vevapp)
1833	WRITE(numout,*) "Total of evaporation :",vevapp
1834	CALL WriteFieldI_p("Wtemp_sol_new",temp_sol_new)
1835	WRITE(numout,*) "New soil temperature :",temp_sol_new
1836	CALL WriteFieldI_p("Wqsurf",qsurf)
1837	WRITE(numout,*) "Surface specific humidity :",qsurf
1838	CALL WriteFieldI_p("Walbedo_nir",albedo(:,1))
1839	WRITE(numout,*) "Albedo nir:",albedo(:,1)
1840	CALL WriteFieldI_p("Walbedo_vis",albedo(:,2))
1841	WRITE(numout,*) "Albedo vir :",albedo(:,2)
1842	CALL WriteFieldI_p("Wfluxsens",fluxsens)
1843	WRITE(numout,*) "Sensible chaleur flux :",fluxsens
1844	CALL WriteFieldI_p("Wfluxlat",fluxlat)
1845	WRITE(numout,*) "Latent chaleur flux :",fluxlat
1846	CALL WriteFieldI_p("Wemis",emis)
1847	WRITE(numout,*) "Emissivity :",emis
1848	ENDIF
1849	ENDIF
1850
1851	! Write variables to restart file
1852	IF (lrestart_write) THEN
1853	CALL restput_p (rest_id, 'riverflow_cpl0', nbp_glo, 1, 1, kjit, riverflow_cpl0, 'scatter', nbp_glo, index_g)
1854	CALL restput_p (rest_id, 'coastalflow_cpl0', nbp_glo, 1, 1, kjit, coastalflow_cpl0, 'scatter', nbp_glo, index_g)
1855	END IF
1856
1857	!
1858	CALL ipslnlf_p(new_number=old_fileout)
1859	!
1860
1861	!
1862	!! Finalize the XIOS orchidee context if it is the last call
1863	!
1864	IF (lrestart_write) THEN
1865	CALL xios_orchidee_context_finalize
1866	END IF
1867	!
1868	!! Change back to be in the LMDZ context for XIOS
1869	!
1870	CALL xios_orchidee_change_context("LMDZ")
1871
1872
1873	END SUBROUTINE intersurf_main_gathered
1874
1875
1876
1877	!! =============================================================================================================================
1878	!! SUBROUTINE: intsurf_time
1879	!!
1880	!>\BRIEF Initalize and update time information
1881	!!
1882	!! DESCRIPTION: Initialize and update time information. This subroutine is called in the initialization phase and at each
1883	!! time step from the different intersurf subroutines.
1884	!!
1885	!! \n
1886	!_ ==============================================================================================================================
1887
1888	SUBROUTINE intsurf_time(istp, date0)
1889
1890	IMPLICIT NONE
1891
1892	INTEGER(i_std), INTENT(in) :: istp !! Time step of the restart file
1893	REAL(r_std), INTENT(in) :: date0 !! The date at which itau = 0
1894
1895	IF (lstep_init_intersurf) THEN
1896	CALL ioget_calendar(calendar_str)
1897	CALL ioget_calendar(one_year, one_day)
1898	CALL tlen2itau('1Y',dt_sechiba,date0,year_length)
1899	IF ( TRIM(calendar_str) .EQ. 'gregorian' ) THEN
1900	year_spread=un
1901	ELSE
1902	year_spread = one_year/365.2425
1903	ENDIF
1904
1905	IF (printlev_loc >=3) THEN
1906	write(numout,*) "calendar_str =",calendar_str
1907	write(numout,*) "one_year=",one_year,", one_day=",one_day
1908	write(numout,*) "dt_sechiba=",dt_sechiba,", date0=",date0,", year_length=",year_length,", year_spread=",year_spread
1909	ENDIF
1910	ENDIF
1911
1912	IF ( printlev_loc >=4 ) WRITE(numout,*) "---"
1913	! Dans diffuco (ie date0 == date0_shift !!)
1914
1915	IF ( TRIM(calendar_str) .EQ. 'gregorian' ) THEN
1916	!
1917	! Get Julian date
1918	in_julian = itau2date(istp, date0, dt_sechiba)
1919
1920	! Real date
1921	CALL ju2ymds (in_julian, year, month, day, sec)
1922	!!$ jur=zero
1923	!!$ julian_diff = in_julian
1924	!!$ month_len = ioget_mon_len (year,month)
1925	!!$ IF ( printlev_loc >=4 ) THEN
1926	!!$ write(numout,*) "in_julian, jur, julian_diff=",in_julian, jur, julian_diff
1927	!!$ write(numout,*) 'DATE ymds', year, month,'(',month_len,'d)', day, sec, '-- stp --', istp
1928	!!$ ENDIF
1929
1930	! julian number for january, the first.
1931	CALL ymds2ju (year,1,1,zero, julian0)
1932	julian_diff = in_julian-julian0
1933	! real number of seconds
1934	! sec = (julian_diff-REAL(INT(julian_diff)))*one_day
1935	sec = NINT((julian_diff-REAL(INT(julian_diff)))*one_day)
1936	month_len = ioget_mon_len (year,month)
1937	IF ( printlev_loc >=4 ) THEN
1938	write(numout,*) "2 in_julian, julian0, julian_diff=",in_julian, julian0, julian_diff
1939	write(numout,*) '2 DATE ymds', year, month,'(',month_len,'d)', day, sec, '-- stp --', istp
1940	ENDIF
1941	ELSE
1942	!!$ in_julian = itau2date(istp-1, zero, dt)
1943	!!$ CALL ju2ymds (in_julian, year, month, day, sec)
1944	!!$ jur=zero
1945	!!$ julian_diff = in_julian
1946	!!$ month_len = ioget_mon_len (year,month)
1947	!!$ IF (printlev_loc >=4) THEN
1948	!!$ write(numout,*) "in_julian=",in_julian, jur, julian_diff
1949	!!$ write(numout,*) 'DATE ymds', year, month,'(',month_len,'d)', day, sec, '-- stp --', istp
1950	!!$ ENDIF
1951	!!$
1952	!!$
1953	!!$ CALL ymds2ju (year,1,1,zero, jur)
1954	!!$ julian_diff = in_julian-jur
1955	!!$ CALL ju2ymds (julian_diff, year, month, day, sec)
1956	!!$! sec = (julian_diff-REAL(INT(julian_diff)))*one_day
1957	!!$ sec = NINT((julian_diff-REAL(INT(julian_diff)))*one_day)
1958	!!$ month_len = ioget_mon_len (year,month)
1959	!!$ IF (printlev_loc >=4) THEN
1960	!!$ write(numout,*) "2 in_julian, jur, julian_diff=",in_julian, jur, julian_diff
1961	!!$ write(numout,*) '2 DATE ymds', year, month,'(',month_len,'d)', day, sec, '-- stp --', istp
1962	!!$ ENDIF
1963
1964	!MM
1965	!PB date0 = celui de Soenke (Ã tester avec un autre date0)
1966	! in_julian = itau2date(istp, 153116., dt)
1967	in_julian = itau2date(istp, date0, dt_sechiba)
1968	CALL itau2ymds(istp, dt_sechiba, year, month, day, sec)
1969	CALL ymds2ju (year,1,1,zero, julian0)
1970	julian_diff = in_julian - julian0
1971	month_len = ioget_mon_len (year,month)
1972	IF (printlev_loc >=4) THEN
1973	write(numout,*) "in_julian=",in_julian, julian0, julian_diff
1974	write(numout,*) 'DATE ymds', year, month,'(',month_len,'d)', day, sec, '-- stp --', istp
1975	ENDIF
1976	ENDIF
1977
1978	END SUBROUTINE intsurf_time
1979
1980	!! ================================================================================================================================
1981	!! SUBROUTINE : intersurf_clear
1982	!!
1983	!>\BRIEF Clear intersurf module and underlaying modules
1984	!!
1985	!! DESCRIPTION : Deallocate memory and reset initialization variables to there original values.
1986	!! Call the clearing for sechiba module.
1987	!!
1988	!_ ================================================================================================================================
1989	SUBROUTINE intersurf_clear
1990	CALL sechiba_clear
1991	END SUBROUTINE intersurf_clear
1992
1993	END MODULE intersurf

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

Download in other formats: