Context Navigation

source: CONFIG_DEVT/IPSLCM6.5_work_ENSEMBLES/modeles/ORCHIDEE/src_sechiba/intersurf.f90 @ 5501

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

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

Download in other formats: