Context Navigation

source: tags/ORCHIDEE_2_0/ORCHIDEE/src_sechiba/intersurf.f90 @ 5164

Last change on this file since 5164 was 4981, checked in by josefine.ghattas, 6 years ago
Changes in comments to avoid ATM_CO2 be written twice in orchidee.default
Property svn:keywords set to `Revision Date HeadURL Date Author Revision`
File size: 89.8 KB

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

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

Download in other formats: