Context Navigation

cpl_mod.F90 @ 3740

Last change on this file since 3740 was 3740, checked in by lguez, 5 years ago

Send delta temperature to the ocean

The grid of Nemo is finer than the grid of LMDZ. So LMDZ receives from
Oasis a spatial average of bulk SST. If we send to Nemo the interface
temperature computed by LMDZ, it is regridded as a step function
by Oasis and, in Nemo, the difference between bulk SST and interface
temperature has spatial oscillations. To avoid this, we send to Nemo
the difference between bulk SST and interface temperature computed by
LMDZ, instead of the interface temperature.

So, in module cpl_mod, rename cpl_t_int to cpl_delta_temp,
cpl_t_int_2D to cpl_delta_temp_2D. In module oasis, rename
ids_t_int to ids_delta_temp. Change
infosend(ids_delta_temp)%name to "CODTEMP".

In procedure cpl_send_ocean_fields, rename dummy argument
t_int to tsurf_in just for clarity, because this argument is
passed also when activate_ocean_skin /= 2. Add dummy argument
sst_nff. We cannot just replace dummy argument t_int by a dummy
argument that would receive tsurf_in - sst_nff because sst_nff is
not defined when activate_ocean_skin == 0.

In procedure ocean_cpl_noice, add dummy argument sst_nff.

As for interface salinity, we have to send delta temperature from the
previous time step. So we have to transform sst_nff into a state
variable. So move sst_nff from module phys_output_var_mod to
module phys_state_var_mod. Define ysst_nff in procedure
pbl_surface before the call to surf_ocean. Choose a value of
sst_nff for an appearing ocean fraction. Read sst_nff in procedure
phyetat0, write it in procedure phyredem. Change the intent of dummy argument
sst_nff in procedure surf_ocean to inout.

Property copyright set to
Name of program: LMDZ
Creation date: 1984
Version: LMDZ5
License: CeCILL version 2
Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
See the license file in the root directory
Property svn:eol-style set to native
Property svn:keywords set to Author Date Id Revision

File size: 64.8 KB

Line
1	!
2	MODULE cpl_mod
3	!
4	! This module excahanges and transforms all fields that should be recieved or sent to
5	! coupler. The transformation of the fields are done from the grid 1D-array in phylmd
6	! to the regular 2D grid accepted by the coupler. Cumulation of the fields for each
7	! timestep is done in here.
8	!
9	! Each type of surface that recevie fields from the coupler have a subroutine named
10	! cpl_receive_XXX_fields and each surface that have fields to be sent to the coupler
11	! have a subroutine named cpl_send_XXX_fields.
12	!
13	!*************************************************************************************
14
15	! Use statements
16	!*************************************************************************************
17	USE dimphy, ONLY : klon
18	USE mod_phys_lmdz_para
19	USE ioipsl
20	USE iophy
21
22	! The module oasis is always used. Without the cpp key CPP_COUPLE only the parameters
23	! in the module are compiled and not the subroutines.
24	USE oasis
25	USE write_field_phy
26	USE time_phylmdz_mod, ONLY: day_step_phy
27
28	! Global attributes
29	!*************************************************************************************
30	IMPLICIT NONE
31	PRIVATE
32
33	! All subroutine are public except cpl_send_all
34	PUBLIC :: cpl_init, cpl_receive_frac, cpl_receive_ocean_fields, cpl_receive_seaice_fields, &
35	cpl_send_ocean_fields, cpl_send_seaice_fields, cpl_send_land_fields, &
36	cpl_send_landice_fields, gath2cpl
37
38
39	! Declaration of module variables
40	!*************************************************************************************
41	! variable for coupling period
42	INTEGER, SAVE :: nexca
43	!$OMP THREADPRIVATE(nexca)
44
45	! variables for cumulating fields during a coupling periode :
46	REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_sols, cpl_nsol, cpl_rain
47	!$OMP THREADPRIVATE(cpl_sols,cpl_nsol,cpl_rain)
48	REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_snow, cpl_evap, cpl_tsol
49	!$OMP THREADPRIVATE(cpl_snow,cpl_evap,cpl_tsol)
50
51	REAL, ALLOCATABLE, SAVE:: cpl_delta_temp(:), cpl_s_int(:)
52	!$OMP THREADPRIVATE(cpl_delta_temp, cpl_s_int)
53
54	REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_fder, cpl_albe, cpl_taux, cpl_tauy
55	!$OMP THREADPRIVATE(cpl_fder,cpl_albe,cpl_taux,cpl_tauy)
56	REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_windsp
57	!$OMP THREADPRIVATE(cpl_windsp)
58	REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_sens_rain, cpl_sens_snow
59	!$OMP THREADPRIVATE(cpl_sens_rain, cpl_sens_snow)
60	REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_taumod
61	!$OMP THREADPRIVATE(cpl_taumod)
62	REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_atm_co2
63	!$OMP THREADPRIVATE(cpl_atm_co2)
64	REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_rriv2D, cpl_rcoa2D, cpl_rlic2D
65	!$OMP THREADPRIVATE(cpl_rriv2D,cpl_rcoa2D,cpl_rlic2D)
66
67	! variables read from coupler :
68	REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: read_sst ! sea surface temperature
69	!$OMP THREADPRIVATE(read_sst)
70	REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: read_sit ! sea ice temperature
71	!$OMP THREADPRIVATE(read_sit)
72
73	REAL, ALLOCATABLE, SAVE:: read_sss(:, :)
74	! bulk salinity of the surface layer of the ocean, in ppt
75	!$OMP THREADPRIVATE(read_sss)
76
77	REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: read_sic ! sea ice fraction
78	!$OMP THREADPRIVATE(read_sic)
79	REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: read_alb_sic ! albedo at sea ice
80	!$OMP THREADPRIVATE(read_alb_sic)
81	REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: read_u0, read_v0 ! ocean surface current
82	!$OMP THREADPRIVATE(read_u0,read_v0)
83	REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: read_co2 ! ocean co2 flux
84	!$OMP THREADPRIVATE(read_co2)
85	INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: unity
86	!$OMP THREADPRIVATE(unity)
87	INTEGER, SAVE :: nidct, nidcs
88	!$OMP THREADPRIVATE(nidct,nidcs)
89
90	! variables to be sent to the coupler
91	REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cpl_sols2D, cpl_nsol2D, cpl_rain2D
92	!$OMP THREADPRIVATE(cpl_sols2D, cpl_nsol2D, cpl_rain2D)
93	REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cpl_snow2D, cpl_evap2D, cpl_tsol2D
94	!$OMP THREADPRIVATE(cpl_snow2D, cpl_evap2D, cpl_tsol2D)
95
96	REAL, ALLOCATABLE, SAVE:: cpl_delta_temp_2D(:,:), cpl_s_int_2D(:,:)
97	!$OMP THREADPRIVATE(cpl_delta_temp_2D, cpl_s_int_2D)
98
99	REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cpl_fder2D, cpl_albe2D
100	!$OMP THREADPRIVATE(cpl_fder2D, cpl_albe2D)
101	REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cpl_taux2D, cpl_tauy2D
102	!$OMP THREADPRIVATE(cpl_taux2D, cpl_tauy2D)
103	REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cpl_taumod2D
104	!$OMP THREADPRIVATE(cpl_taumod2D)
105	REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_windsp2D
106	!$OMP THREADPRIVATE(cpl_windsp2D)
107	REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cpl_sens_rain2D, cpl_sens_snow2D
108	!$OMP THREADPRIVATE(cpl_sens_rain2D, cpl_sens_snow2D)
109	REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_atm_co22D
110	!$OMP THREADPRIVATE(cpl_atm_co22D)
111
112	!!!!!!!!!! variable for calving
113	INTEGER, PARAMETER :: nb_zone_calving = 3
114	REAL,ALLOCATABLE, DIMENSION(:,:,:),SAVE :: area_calving
115	!$OMP THREADPRIVATE(area_calving)
116	REAL,ALLOCATABLE, DIMENSION(:,:),SAVE :: cell_area2D
117	!$OMP THREADPRIVATE(cell_area2D)
118	INTEGER, SAVE :: ind_calving(nb_zone_calving)
119	!$OMP THREADPRIVATE(ind_calving)
120
121	LOGICAL,SAVE :: cpl_old_calving
122	!$OMP THREADPRIVATE(cpl_old_calving)
123
124	CONTAINS
125	!
126	!************************************************************************************
127	!
128	SUBROUTINE cpl_init(dtime, rlon, rlat)
129	USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, fco2_ocn_day
130	USE surface_data
131	USE indice_sol_mod
132	USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid1dTo2d_glo, klon_glo, grid_type, unstructured, regular_lonlat
133	USE time_phylmdz_mod, ONLY: annee_ref, day_ini, itau_phy, itaufin_phy
134	USE print_control_mod, ONLY: lunout
135	USE geometry_mod, ONLY : longitude_deg, latitude_deg, ind_cell_glo, cell_area
136	USE ioipsl_getin_p_mod, ONLY: getin_p
137	use config_ocean_skin_m, only: activate_ocean_skin
138
139	! Input arguments
140	!*************************************************************************************
141	REAL, INTENT(IN) :: dtime
142	REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat
143
144	! Local variables
145	!*************************************************************************************
146	INTEGER :: error, sum_error, ig, i
147	INTEGER :: jf, nhoridct
148	INTEGER :: nhoridcs
149	INTEGER :: idtime
150	INTEGER :: idayref
151	INTEGER :: npas ! only for OASIS2
152	REAL :: zjulian
153	REAL, DIMENSION(nbp_lon,nbp_lat) :: zx_lon, zx_lat
154	CHARACTER(len = 20) :: modname = 'cpl_init'
155	CHARACTER(len = 80) :: abort_message
156	CHARACTER(len=80) :: clintocplnam, clfromcplnam
157	REAL, DIMENSION(klon_mpi) :: rlon_mpi, rlat_mpi, cell_area_mpi
158	INTEGER, DIMENSION(klon_mpi) :: ind_cell_glo_mpi
159	REAL, DIMENSION(nbp_lon,jj_nb) :: lon2D, lat2D
160	INTEGER :: mask_calving(nbp_lon,jj_nb,nb_zone_calving)
161	REAL :: pos
162
163	!***************************************
164	! Use old calving or not (default new calving method)
165	! New calving method should be used with DYNAMICO and when using new coupling
166	! weights.
167	cpl_old_calving=.FALSE.
168	CALL getin_p("cpl_old_calving",cpl_old_calving)
169
170
171	!*************************************************************************************
172	! Calculate coupling period
173	!
174	!*************************************************************************************
175
176	npas = itaufin_phy
177	! nexca = 86400 / dtime
178	nexca = t_coupl / dtime
179	WRITE(lunout,*)' ##### Ocean couple #####'
180	WRITE(lunout,*)' Valeurs des pas de temps'
181	WRITE(lunout,*)' npas = ', npas
182	WRITE(lunout,*)' nexca = ', nexca
183
184	!*************************************************************************************
185	! Allocate variables
186	!
187	!*************************************************************************************
188	error = 0
189	sum_error = 0
190
191	ALLOCATE(unity(klon), stat = error)
192	sum_error = sum_error + error
193	ALLOCATE(cpl_sols(klon,2), stat = error)
194	sum_error = sum_error + error
195	ALLOCATE(cpl_nsol(klon,2), stat = error)
196	sum_error = sum_error + error
197	ALLOCATE(cpl_rain(klon,2), stat = error)
198	sum_error = sum_error + error
199	ALLOCATE(cpl_snow(klon,2), stat = error)
200	sum_error = sum_error + error
201	ALLOCATE(cpl_evap(klon,2), stat = error)
202	sum_error = sum_error + error
203	ALLOCATE(cpl_tsol(klon,2), stat = error)
204	sum_error = sum_error + error
205	ALLOCATE(cpl_fder(klon,2), stat = error)
206	sum_error = sum_error + error
207	ALLOCATE(cpl_albe(klon,2), stat = error)
208	sum_error = sum_error + error
209	ALLOCATE(cpl_taux(klon,2), stat = error)
210	sum_error = sum_error + error
211	ALLOCATE(cpl_tauy(klon,2), stat = error)
212	sum_error = sum_error + error
213	ALLOCATE(cpl_windsp(klon,2), stat = error)
214	sum_error = sum_error + error
215	ALLOCATE(cpl_taumod(klon,2), stat = error)
216	sum_error = sum_error + error
217	ALLOCATE(cpl_sens_rain(klon,2), stat = error)
218	sum_error = sum_error + error
219	ALLOCATE(cpl_sens_snow(klon,2), stat = error)
220	sum_error = sum_error + error
221	ALLOCATE(cpl_rriv2D(nbp_lon,jj_nb), stat=error)
222	sum_error = sum_error + error
223	ALLOCATE(cpl_rcoa2D(nbp_lon,jj_nb), stat=error)
224	sum_error = sum_error + error
225	ALLOCATE(cpl_rlic2D(nbp_lon,jj_nb), stat=error)
226	sum_error = sum_error + error
227	ALLOCATE(read_sst(nbp_lon, jj_nb), stat = error)
228	sum_error = sum_error + error
229	ALLOCATE(read_sic(nbp_lon, jj_nb), stat = error)
230	sum_error = sum_error + error
231	ALLOCATE(read_sit(nbp_lon, jj_nb), stat = error)
232	sum_error = sum_error + error
233
234	if (activate_ocean_skin >= 1) then
235	ALLOCATE(read_sss(nbp_lon, jj_nb), stat = error)
236	sum_error = sum_error + error
237
238	if (activate_ocean_skin == 2) then
239	ALLOCATE(cpl_delta_temp(klon), cpl_s_int(klon), stat = error)
240	sum_error = sum_error + error
241	end if
242	end if
243
244	ALLOCATE(read_alb_sic(nbp_lon, jj_nb), stat = error)
245	sum_error = sum_error + error
246	ALLOCATE(read_u0(nbp_lon, jj_nb), stat = error)
247	sum_error = sum_error + error
248	ALLOCATE(read_v0(nbp_lon, jj_nb), stat = error)
249	sum_error = sum_error + error
250
251	IF (carbon_cycle_cpl) THEN
252	ALLOCATE(read_co2(nbp_lon, jj_nb), stat = error)
253	sum_error = sum_error + error
254	ALLOCATE(cpl_atm_co2(klon,2), stat = error)
255	sum_error = sum_error + error
256
257	! Allocate variable in carbon_cycle_mod
258	IF (.NOT.ALLOCATED(fco2_ocn_day)) ALLOCATE(fco2_ocn_day(klon), stat = error)
259	sum_error = sum_error + error
260	ENDIF
261
262	! calving initialization
263	ALLOCATE(area_calving(nbp_lon, jj_nb, nb_zone_calving), stat = error)
264	sum_error = sum_error + error
265	ALLOCATE(cell_area2D(nbp_lon, jj_nb), stat = error)
266	sum_error = sum_error + error
267
268
269	CALL gather_omp(longitude_deg,rlon_mpi)
270	CALL gather_omp(latitude_deg,rlat_mpi)
271	CALL gather_omp(ind_cell_glo,ind_cell_glo_mpi)
272	CALL gather_omp(cell_area,cell_area_mpi)
273
274	IF (is_omp_master) THEN
275	CALL Grid1DTo2D_mpi(rlon_mpi,lon2D)
276	CALL Grid1DTo2D_mpi(rlat_mpi,lat2D)
277	CALL Grid1DTo2D_mpi(cell_area_mpi,cell_area2D)
278	mask_calving(:,:,:) = 0
279	WHERE ( lat2D >= 40) mask_calving(:,:,1) = 1
280	WHERE ( lat2D < 40 .AND. lat2D > -50) mask_calving(:,:,2) = 1
281	WHERE ( lat2D <= -50) mask_calving(:,:,3) = 1
282
283
284	DO i=1,nb_zone_calving
285	area_calving(:,:,i)=mask_calving(:,:,i)*cell_area2D(:,:)
286	pos=1
287	IF (i>1) pos = 1 + ((nbp_lonnbp_lat-1)(i-1))/(nb_zone_calving-1)
288
289	ind_calving(i)=0
290	IF (grid_type==unstructured) THEN
291
292	DO ig=1,klon_mpi
293	IF (ind_cell_glo_mpi(ig)==pos) ind_calving(i)=ig
294	ENDDO
295
296	ELSE IF (grid_type==regular_lonlat) THEN
297	IF ((ij_begin<=pos .AND. ij_end>=pos) .OR. (ij_begin<=pos .AND. is_south_pole_dyn )) THEN
298	ind_calving(i)=pos-(jj_begin-1)*nbp_lon
299	ENDIF
300	ENDIF
301
302	ENDDO
303	ENDIF
304
305
306	IF (sum_error /= 0) THEN
307	abort_message='Pb allocation variables couplees'
308	CALL abort_physic(modname,abort_message,1)
309	ENDIF
310	!*************************************************************************************
311	! Initialize the allocated varaibles
312	!
313	!*************************************************************************************
314	DO ig = 1, klon
315	unity(ig) = ig
316	ENDDO
317
318	!*************************************************************************************
319	! Initialize coupling
320	!
321	!*************************************************************************************
322	idtime = INT(dtime)
323	#ifdef CPP_COUPLE
324	CALL inicma
325	#endif
326
327	!*************************************************************************************
328	! initialize NetCDF output
329	!
330	!*************************************************************************************
331	IF (is_sequential) THEN
332	idayref = day_ini
333	CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian)
334	CALL grid1dTo2d_glo(rlon,zx_lon)
335	DO i = 1, nbp_lon
336	zx_lon(i,1) = rlon(i+1)
337	zx_lon(i,nbp_lat) = rlon(i+1)
338	ENDDO
339	CALL grid1dTo2d_glo(rlat,zx_lat)
340	clintocplnam="cpl_atm_tauflx"
341	CALL histbeg(clintocplnam,nbp_lon,zx_lon(:,1),nbp_lat,zx_lat(1,:),&
342	1,nbp_lon,1,nbp_lat, itau_phy,zjulian,dtime,nhoridct,nidct)
343	! no vertical axis
344	CALL histdef(nidct, 'tauxe','tauxe', &
345	"-",nbp_lon,nbp_lat, nhoridct, 1, 1, 1, -99, 32, "inst", dtime,dtime)
346	CALL histdef(nidct, 'tauyn','tauyn', &
347	"-",nbp_lon,nbp_lat, nhoridct, 1, 1, 1, -99, 32, "inst", dtime,dtime)
348	CALL histdef(nidct, 'tmp_lon','tmp_lon', &
349	"-",nbp_lon,nbp_lat, nhoridct, 1, 1, 1, -99, 32, "inst", dtime,dtime)
350	CALL histdef(nidct, 'tmp_lat','tmp_lat', &
351	"-",nbp_lon,nbp_lat, nhoridct, 1, 1, 1, -99, 32, "inst", dtime,dtime)
352	DO jf=1,maxsend
353	IF (infosend(i)%action) THEN
354	CALL histdef(nidct, infosend(i)%name ,infosend(i)%name , &
355	"-",nbp_lon,nbp_lat,nhoridct,1,1,1,-99,32,"inst",dtime,dtime)
356	ENDIF
357	ENDDO
358	CALL histend(nidct)
359	CALL histsync(nidct)
360
361	clfromcplnam="cpl_atm_sst"
362	CALL histbeg(clfromcplnam,nbp_lon,zx_lon(:,1),nbp_lat,zx_lat(1,:),1,nbp_lon,1,nbp_lat, &
363	0,zjulian,dtime,nhoridcs,nidcs)
364	! no vertical axis
365	DO jf=1,maxrecv
366	IF (inforecv(i)%action) THEN
367	CALL histdef(nidcs,inforecv(i)%name ,inforecv(i)%name , &
368	"-",nbp_lon,nbp_lat,nhoridcs,1,1,1,-99,32,"inst",dtime,dtime)
369	ENDIF
370	ENDDO
371	CALL histend(nidcs)
372	CALL histsync(nidcs)
373
374	ENDIF ! is_sequential
375
376
377	!*************************************************************************************
378	! compatibility test
379	!
380	!*************************************************************************************
381	IF (carbon_cycle_cpl .AND. version_ocean=='opa8') THEN
382	abort_message='carbon_cycle_cpl does not work with opa8'
383	CALL abort_physic(modname,abort_message,1)
384	ENDIF
385
386	END SUBROUTINE cpl_init
387
388	!
389	!*************************************************************************************
390	!
391
392	SUBROUTINE cpl_receive_frac(itime, dtime, pctsrf, is_modified)
393	! This subroutine receives from coupler for both ocean and seaice
394	! 4 fields : read_sst, read_sic, read_sit and read_alb_sic.
395	! The new sea-ice-land-landice fraction is returned. The others fields
396	! are stored in this module.
397	USE surface_data
398	USE geometry_mod, ONLY : longitude_deg, latitude_deg
399	USE carbon_cycle_mod, ONLY : carbon_cycle_cpl
400	USE indice_sol_mod
401	USE time_phylmdz_mod, ONLY: start_time, itau_phy
402	USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
403	use config_ocean_skin_m, only: activate_ocean_skin
404
405	INCLUDE "YOMCST.h"
406
407	! Arguments
408	!************************************************************************************
409	INTEGER, INTENT(IN) :: itime
410	REAL, INTENT(IN) :: dtime
411	REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: pctsrf
412	LOGICAL, INTENT(OUT) :: is_modified
413
414	! Local variables
415	!************************************************************************************
416	INTEGER :: j, i, time_sec
417	INTEGER :: itau_w
418	INTEGER, DIMENSION(nbp_lon*nbp_lat) :: ndexcs
419	CHARACTER(len = 20) :: modname = 'cpl_receive_frac'
420	CHARACTER(len = 80) :: abort_message
421	REAL, DIMENSION(klon) :: read_sic1D
422	REAL, DIMENSION(nbp_lon,jj_nb,maxrecv) :: tab_read_flds
423	REAL, DIMENSION(klon,nbsrf) :: pctsrf_old
424	REAL, DIMENSION(klon_mpi) :: rlon_mpi, rlat_mpi
425	REAL, DIMENSION(nbp_lon,jj_nb) :: tmp_lon, tmp_lat
426	REAL, DIMENSION(nbp_lon,jj_nb) :: tmp_r0
427
428	!*************************************************************************************
429	! Start calculation
430	! Get fields from coupler
431	!
432	!*************************************************************************************
433
434	is_modified=.FALSE.
435
436	! Check if right moment to receive from coupler
437	IF (MOD(itime, nexca) == 1) THEN
438	is_modified=.TRUE.
439
440	time_sec=(itime-1)*dtime
441	#ifdef CPP_COUPLE
442	!$OMP MASTER
443	CALL fromcpl(time_sec, tab_read_flds)
444	!$OMP END MASTER
445	#endif
446
447	! NetCDF output of received fields
448	IF (is_sequential) THEN
449	ndexcs(:) = 0
450	itau_w = itau_phy + itime + start_time * day_step_phy
451	DO i = 1, maxrecv
452	IF (inforecv(i)%action) THEN
453	CALL histwrite(nidcs,inforecv(i)%name,itau_w,tab_read_flds(:,:,i),nbp_lon*(nbp_lat),ndexcs)
454	ENDIF
455	ENDDO
456	ENDIF
457
458
459	! Save each field in a 2D array.
460	!$OMP MASTER
461	read_sst(:,:) = tab_read_flds(:,:,idr_sisutw) ! Sea surface temperature
462	read_sic(:,:) = tab_read_flds(:,:,idr_icecov) ! Sea ice concentration
463	read_alb_sic(:,:) = tab_read_flds(:,:,idr_icealw) ! Albedo at sea ice
464	read_sit(:,:) = tab_read_flds(:,:,idr_icetem) ! Sea ice temperature
465	if (activate_ocean_skin >= 1) read_sss(:,:) = tab_read_flds(:,:,idr_sss)
466	!$OMP END MASTER
467
468	IF (cpl_current) THEN
469
470	! Transform the longitudes and latitudes on 2D arrays
471	CALL gather_omp(longitude_deg,rlon_mpi)
472	CALL gather_omp(latitude_deg,rlat_mpi)
473	!$OMP MASTER
474	CALL Grid1DTo2D_mpi(rlon_mpi,tmp_lon)
475	CALL Grid1DTo2D_mpi(rlat_mpi,tmp_lat)
476
477	! Transform the currents from cartesian to spheric coordinates
478	! tmp_r0 should be zero
479	CALL geo2atm(nbp_lon, jj_nb, tab_read_flds(:,:,idr_curenx), &
480	tab_read_flds(:,:,idr_cureny), tab_read_flds(:,:,idr_curenz), &
481	tmp_lon, tmp_lat, &
482	read_u0(:,:), read_v0(:,:), tmp_r0(:,:))
483	!$OMP END MASTER
484
485	ELSE
486	read_u0(:,:) = 0.
487	read_v0(:,:) = 0.
488	ENDIF
489
490	IF (carbon_cycle_cpl) THEN
491	!$OMP MASTER
492	read_co2(:,:) = tab_read_flds(:,:,idr_oceco2) ! CO2 flux
493	!$OMP END MASTER
494	ENDIF
495
496	!*************************************************************************************
497	! Transform seaice fraction (read_sic : ocean-seaice mask) into global
498	! fraction (pctsrf : ocean-seaice-land-landice mask)
499	!
500	!*************************************************************************************
501	CALL cpl2gath(read_sic, read_sic1D, klon, unity)
502
503	pctsrf_old(:,:) = pctsrf(:,:)
504	DO i = 1, klon
505	! treatment only of points with ocean and/or seaice
506	! old land-ocean mask can not be changed
507	IF (pctsrf_old(i,is_oce) + pctsrf_old(i,is_sic) > 0.) THEN
508	pctsrf(i,is_sic) = (pctsrf_old(i,is_oce) + pctsrf_old(i,is_sic)) &
509	* read_sic1D(i)
510	pctsrf(i,is_oce) = (pctsrf_old(i,is_oce) + pctsrf_old(i,is_sic)) &
511	- pctsrf(i,is_sic)
512	ENDIF
513	ENDDO
514
515	ENDIF ! if time to receive
516
517	END SUBROUTINE cpl_receive_frac
518
519	!
520	!*************************************************************************************
521	!
522
523	SUBROUTINE cpl_receive_ocean_fields(knon, knindex, tsurf_new, u0_new, &
524	v0_new, sss)
525	!
526	! This routine returns the field for the ocean that has been read from the coupler
527	! (done earlier with cpl_receive_frac). The field is the temperature.
528	! The temperature is transformed into 1D array with valid points from index 1 to knon.
529	!
530	USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, fco2_ocn_day
531	USE indice_sol_mod
532	use config_ocean_skin_m, only: activate_ocean_skin
533
534	! Input arguments
535	!*************************************************************************************
536	INTEGER, INTENT(IN) :: knon
537	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
538
539	! Output arguments
540	!*************************************************************************************
541	REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new
542
543	REAL, INTENT(OUT):: sss(:) ! (klon)
544	! bulk salinity of the surface layer of the ocean, in ppt
545
546	REAL, DIMENSION(klon), INTENT(OUT) :: u0_new
547	REAL, DIMENSION(klon), INTENT(OUT) :: v0_new
548
549	! Local variables
550	!*************************************************************************************
551	INTEGER :: i
552	INTEGER, DIMENSION(klon) :: index
553	REAL, DIMENSION(klon) :: sic_new
554
555	!*************************************************************************************
556	! Transform read_sst into compressed 1D variable tsurf_new
557	!
558	!*************************************************************************************
559	CALL cpl2gath(read_sst, tsurf_new, knon, knindex)
560	if (activate_ocean_skin >= 1) CALL cpl2gath(read_sss, sss, knon, knindex)
561	CALL cpl2gath(read_sic, sic_new, knon, knindex)
562	CALL cpl2gath(read_u0, u0_new, knon, knindex)
563	CALL cpl2gath(read_v0, v0_new, knon, knindex)
564
565	!*************************************************************************************
566	! Transform read_co2 into uncompressed 1D variable fco2_ocn_day added directly in
567	! the module carbon_cycle_mod
568	!
569	!*************************************************************************************
570	IF (carbon_cycle_cpl) THEN
571	DO i=1,klon
572	index(i)=i
573	ENDDO
574	CALL cpl2gath(read_co2, fco2_ocn_day, klon, index)
575	ENDIF
576
577	!*************************************************************************************
578	! The fields received from the coupler have to be weighted with the fraction of ocean
579	! in relation to the total sea-ice+ocean
580	!
581	!*************************************************************************************
582	DO i=1, knon
583	tsurf_new(i) = tsurf_new(i)/(1. - sic_new(i))
584	ENDDO
585
586	END SUBROUTINE cpl_receive_ocean_fields
587
588	!
589	!*************************************************************************************
590	!
591
592	SUBROUTINE cpl_receive_seaice_fields(knon, knindex, &
593	tsurf_new, alb_new, u0_new, v0_new)
594	!
595	! This routine returns the fields for the seaice that have been read from the coupler
596	! (done earlier with cpl_receive_frac). These fields are the temperature and
597	! albedo at sea ice surface and fraction of sea ice.
598	! The fields are transformed into 1D arrays with valid points from index 1 to knon.
599	!
600
601	! Input arguments
602	!*************************************************************************************
603	INTEGER, INTENT(IN) :: knon
604	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
605
606	! Output arguments
607	!*************************************************************************************
608	REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new
609	REAL, DIMENSION(klon), INTENT(OUT) :: alb_new
610	REAL, DIMENSION(klon), INTENT(OUT) :: u0_new
611	REAL, DIMENSION(klon), INTENT(OUT) :: v0_new
612
613	! Local variables
614	!*************************************************************************************
615	INTEGER :: i
616	REAL, DIMENSION(klon) :: sic_new
617
618	!*************************************************************************************
619	! Transform fields read from coupler from 2D into compressed 1D variables
620	!
621	!*************************************************************************************
622	CALL cpl2gath(read_sit, tsurf_new, knon, knindex)
623	CALL cpl2gath(read_alb_sic, alb_new, knon, knindex)
624	CALL cpl2gath(read_sic, sic_new, knon, knindex)
625	CALL cpl2gath(read_u0, u0_new, knon, knindex)
626	CALL cpl2gath(read_v0, v0_new, knon, knindex)
627
628	!*************************************************************************************
629	! The fields received from the coupler have to be weighted with the sea-ice
630	! concentration (in relation to the total sea-ice + ocean).
631	!
632	!*************************************************************************************
633	DO i= 1, knon
634	tsurf_new(i) = tsurf_new(i) / sic_new(i)
635	alb_new(i) = alb_new(i) / sic_new(i)
636	ENDDO
637
638	END SUBROUTINE cpl_receive_seaice_fields
639
640	!
641	!*************************************************************************************
642	!
643
644	SUBROUTINE cpl_send_ocean_fields(itime, knon, knindex, &
645	swdown, lwdown, fluxlat, fluxsens, &
646	precip_rain, precip_snow, evap, tsurf, fder, albsol, taux, tauy, windsp,&
647	sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol, tsurf_in, &
648	sst_nff, s_int)
649
650	! This subroutine cumulates some fields for each time-step during
651	! a coupling period. At last time-step in a coupling period the
652	! fields are transformed to the grid accepted by the coupler. No
653	! sending to the coupler will be done from here (it is done in
654	! cpl_send_seaice_fields). Crucial hypothesis is that the surface
655	! fractions do not change between coupling time-steps.
656
657	USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, co2_send
658	USE indice_sol_mod
659	USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
660	use config_ocean_skin_m, only: activate_ocean_skin
661
662	! Input arguments
663	!*************************************************************************************
664	INTEGER, INTENT(IN) :: itime
665	INTEGER, INTENT(IN) :: knon
666	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
667	REAL, DIMENSION(klon), INTENT(IN) :: swdown, lwdown
668	REAL, DIMENSION(klon), INTENT(IN) :: fluxlat, fluxsens
669	REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow
670	REAL, DIMENSION(klon), INTENT(IN) :: evap, tsurf, fder, albsol
671	REAL, DIMENSION(klon), INTENT(IN) :: taux, tauy, windsp
672	REAL, INTENT(IN):: sens_prec_liq(:), sens_prec_sol(:) ! (knon)
673	REAL, DIMENSION(klon), INTENT(IN) :: lat_prec_liq, lat_prec_sol
674	real, intent(in):: tsurf_in(:) ! (klon)
675
676	REAL, intent(in):: sst_nff(:) ! (knon)
677	! SST not used to compute surface fluxes, in K. If
678	! activate_ocean_skin == 0 then it is not defined; if
679	! activate_ocean_skin == 1 then it is the ocean-air interface
680	! temperature; if activate_ocean_skin == 2 then it is the bulk SST.
681
682	real, intent(in):: s_int(:) ! (knon) ocean-air interface salinity, in ppt
683
684	! Local variables
685	!*************************************************************************************
686	INTEGER :: cpl_index, ig
687	INTEGER :: error, sum_error
688	CHARACTER(len = 25) :: modname = 'cpl_send_ocean_fields'
689	CHARACTER(len = 80) :: abort_message
690
691	!*************************************************************************************
692	! Start calculation
693	! The ocean points are saved with second array index=1
694	!
695	!*************************************************************************************
696	cpl_index = 1
697
698	!*************************************************************************************
699	! Reset fields to zero in the beginning of a new coupling period
700	!
701	!*************************************************************************************
702	IF (MOD(itime, nexca) == 1) THEN
703	cpl_sols(1:knon,cpl_index) = 0.0
704	cpl_nsol(1:knon,cpl_index) = 0.0
705	cpl_rain(1:knon,cpl_index) = 0.0
706	cpl_snow(1:knon,cpl_index) = 0.0
707	cpl_evap(1:knon,cpl_index) = 0.0
708	cpl_tsol(1:knon,cpl_index) = 0.0
709	cpl_fder(1:knon,cpl_index) = 0.0
710	cpl_albe(1:knon,cpl_index) = 0.0
711	cpl_taux(1:knon,cpl_index) = 0.0
712	cpl_tauy(1:knon,cpl_index) = 0.0
713	cpl_windsp(1:knon,cpl_index) = 0.0
714	cpl_sens_rain(1:knon,cpl_index) = 0.0
715	cpl_sens_snow(1:knon,cpl_index) = 0.0
716	cpl_taumod(1:knon,cpl_index) = 0.0
717	IF (carbon_cycle_cpl) cpl_atm_co2(1:knon,cpl_index) = 0.0
718
719	if (activate_ocean_skin == 2) then
720	cpl_delta_temp(:knon) = 0.
721	cpl_s_int = 0.
722	end if
723	ENDIF
724
725	!*************************************************************************************
726	! Cumulate at each time-step
727	!
728	!*************************************************************************************
729	DO ig = 1, knon
730	cpl_sols(ig,cpl_index) = cpl_sols(ig,cpl_index) + &
731	swdown(ig) / REAL(nexca)
732	cpl_nsol(ig,cpl_index) = cpl_nsol(ig,cpl_index) + &
733	(lwdown(ig) + fluxlat(ig) +fluxsens(ig)) / REAL(nexca)
734	cpl_rain(ig,cpl_index) = cpl_rain(ig,cpl_index) + &
735	precip_rain(ig) / REAL(nexca)
736	cpl_snow(ig,cpl_index) = cpl_snow(ig,cpl_index) + &
737	precip_snow(ig) / REAL(nexca)
738	cpl_evap(ig,cpl_index) = cpl_evap(ig,cpl_index) + &
739	evap(ig) / REAL(nexca)
740	cpl_tsol(ig,cpl_index) = cpl_tsol(ig,cpl_index) + &
741	tsurf(ig) / REAL(nexca)
742	cpl_fder(ig,cpl_index) = cpl_fder(ig,cpl_index) + &
743	fder(ig) / REAL(nexca)
744	cpl_albe(ig,cpl_index) = cpl_albe(ig,cpl_index) + &
745	albsol(ig) / REAL(nexca)
746	cpl_taux(ig,cpl_index) = cpl_taux(ig,cpl_index) + &
747	taux(ig) / REAL(nexca)
748	cpl_tauy(ig,cpl_index) = cpl_tauy(ig,cpl_index) + &
749	tauy(ig) / REAL(nexca)
750	cpl_windsp(ig,cpl_index) = cpl_windsp(ig,cpl_index) + &
751	windsp(ig) / REAL(nexca)
752	cpl_sens_rain(ig,cpl_index) = cpl_sens_rain(ig,cpl_index) + &
753	sens_prec_liq(ig) / REAL(nexca)
754	cpl_sens_snow(ig,cpl_index) = cpl_sens_snow(ig,cpl_index) + &
755	sens_prec_sol(ig) / REAL(nexca)
756	cpl_taumod(ig,cpl_index) = cpl_taumod(ig,cpl_index) + &
757	SQRT ( taux(ig)taux(ig)+tauy(ig)tauy(ig) ) / REAL (nexca)
758
759	IF (carbon_cycle_cpl) THEN
760	cpl_atm_co2(ig,cpl_index) = cpl_atm_co2(ig,cpl_index) + &
761	co2_send(knindex(ig))/ REAL(nexca)
762	!!---OB: this is correct but why knindex ??
763	ENDIF
764
765	if (activate_ocean_skin == 2) then
766	cpl_delta_temp(ig) = cpl_delta_temp(ig) &
767	+ (tsurf_in(ig) - sst_nff(ig)) / REAL(nexca)
768	cpl_s_int(ig) = cpl_s_int(ig) + s_int(ig) / REAL(nexca)
769	end if
770	ENDDO
771
772	!*************************************************************************************
773	! If the time-step corresponds to the end of coupling period the
774	! fields are transformed to the 2D grid.
775	! No sending to the coupler (it is done from cpl_send_seaice_fields).
776	!
777	!*************************************************************************************
778	IF (MOD(itime, nexca) == 0) THEN
779
780	IF (.NOT. ALLOCATED(cpl_sols2D)) THEN
781	sum_error = 0
782	ALLOCATE(cpl_sols2D(nbp_lon,jj_nb,2), stat=error)
783	sum_error = sum_error + error
784	ALLOCATE(cpl_nsol2D(nbp_lon,jj_nb,2), stat=error)
785	sum_error = sum_error + error
786	ALLOCATE(cpl_rain2D(nbp_lon,jj_nb,2), stat=error)
787	sum_error = sum_error + error
788	ALLOCATE(cpl_snow2D(nbp_lon,jj_nb,2), stat=error)
789	sum_error = sum_error + error
790	ALLOCATE(cpl_evap2D(nbp_lon,jj_nb,2), stat=error)
791	sum_error = sum_error + error
792	ALLOCATE(cpl_tsol2D(nbp_lon,jj_nb,2), stat=error)
793	sum_error = sum_error + error
794	ALLOCATE(cpl_fder2D(nbp_lon,jj_nb,2), stat=error)
795	sum_error = sum_error + error
796	ALLOCATE(cpl_albe2D(nbp_lon,jj_nb,2), stat=error)
797	sum_error = sum_error + error
798	ALLOCATE(cpl_taux2D(nbp_lon,jj_nb,2), stat=error)
799	sum_error = sum_error + error
800	ALLOCATE(cpl_tauy2D(nbp_lon,jj_nb,2), stat=error)
801	sum_error = sum_error + error
802	ALLOCATE(cpl_windsp2D(nbp_lon,jj_nb), stat=error)
803	sum_error = sum_error + error
804	ALLOCATE(cpl_sens_rain2D(nbp_lon,jj_nb,2), stat=error)
805	sum_error = sum_error + error
806	ALLOCATE(cpl_sens_snow2D(nbp_lon,jj_nb,2), stat=error)
807	sum_error = sum_error + error
808	ALLOCATE(cpl_taumod2D(nbp_lon,jj_nb,2), stat=error)
809	sum_error = sum_error + error
810
811	IF (carbon_cycle_cpl) THEN
812	ALLOCATE(cpl_atm_co22D(nbp_lon,jj_nb), stat=error)
813	sum_error = sum_error + error
814	ENDIF
815
816	if (activate_ocean_skin == 2) then
817	ALLOCATE(cpl_delta_temp_2D(nbp_lon, jj_nb), &
818	cpl_s_int_2D(nbp_lon, jj_nb), stat = error)
819	sum_error = sum_error + error
820	end if
821
822	IF (sum_error /= 0) THEN
823	abort_message='Pb allocation variables couplees pour l''ecriture'
824	CALL abort_physic(modname,abort_message,1)
825	ENDIF
826	ENDIF
827
828
829	CALL gath2cpl(cpl_sols(:,cpl_index), cpl_sols2D(:,:,cpl_index), &
830	knon, knindex)
831
832	CALL gath2cpl(cpl_nsol(:,cpl_index), cpl_nsol2D(:,:,cpl_index), &
833	knon, knindex)
834
835	CALL gath2cpl(cpl_rain(:,cpl_index), cpl_rain2D(:,:,cpl_index), &
836	knon, knindex)
837
838	CALL gath2cpl(cpl_snow(:,cpl_index), cpl_snow2D(:,:,cpl_index), &
839	knon, knindex)
840
841	CALL gath2cpl(cpl_evap(:,cpl_index), cpl_evap2D(:,:,cpl_index), &
842	knon, knindex)
843
844	! cpl_tsol2D(:,:,:) not used!
845	CALL gath2cpl(cpl_tsol(:,cpl_index), cpl_tsol2D(:,:, cpl_index), &
846	knon, knindex)
847
848	! cpl_fder2D(:,:,1) not used, only cpl_fder(:,:,2)!
849	CALL gath2cpl(cpl_fder(:,cpl_index), cpl_fder2D(:,:,cpl_index), &
850	knon, knindex)
851
852	! cpl_albe2D(:,:,:) not used!
853	CALL gath2cpl(cpl_albe(:,cpl_index), cpl_albe2D(:,:,cpl_index), &
854	knon, knindex)
855
856	CALL gath2cpl(cpl_taux(:,cpl_index), cpl_taux2D(:,:,cpl_index), &
857	knon, knindex)
858
859	CALL gath2cpl(cpl_tauy(:,cpl_index), cpl_tauy2D(:,:,cpl_index), &
860	knon, knindex)
861
862	CALL gath2cpl(cpl_windsp(:,cpl_index), cpl_windsp2D(:,:), &
863	knon, knindex)
864
865	CALL gath2cpl(cpl_sens_rain(:,cpl_index), cpl_sens_rain2D(:,:,cpl_index), &
866	knon, knindex)
867
868	CALL gath2cpl(cpl_sens_snow(:,cpl_index), cpl_sens_snow2D(:,:,cpl_index), &
869	knon, knindex)
870
871	CALL gath2cpl(cpl_taumod(:,cpl_index), cpl_taumod2D(:,:,cpl_index), &
872	knon, knindex)
873
874	IF (carbon_cycle_cpl) &
875	CALL gath2cpl(cpl_atm_co2(:,cpl_index), cpl_atm_co22D(:,:), knon, knindex)
876	if (activate_ocean_skin == 2) then
877	CALL gath2cpl(cpl_delta_temp, cpl_delta_temp_2D, knon, knindex)
878	CALL gath2cpl(cpl_s_int, cpl_s_int_2D, knon, knindex)
879	end if
880	ENDIF
881
882	END SUBROUTINE cpl_send_ocean_fields
883
884	!
885	!*************************************************************************************
886	!
887
888	SUBROUTINE cpl_send_seaice_fields(itime, dtime, knon, knindex, &
889	pctsrf, lafin, rlon, rlat, &
890	swdown, lwdown, fluxlat, fluxsens, &
891	precip_rain, precip_snow, evap, tsurf, fder, albsol, taux, tauy,&
892	sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
893	!
894	! This subroutine cumulates some fields for each time-step during a coupling
895	! period. At last time-step in a coupling period the fields are transformed to the
896	! grid accepted by the coupler. All fields for all types of surfaces are sent to
897	! the coupler.
898	!
899	USE carbon_cycle_mod, ONLY : carbon_cycle_cpl
900	USE indice_sol_mod
901	USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
902
903	! Input arguments
904	!*************************************************************************************
905	INTEGER, INTENT(IN) :: itime
906	INTEGER, INTENT(IN) :: knon
907	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
908	REAL, INTENT(IN) :: dtime
909	REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat
910	REAL, DIMENSION(klon), INTENT(IN) :: swdown, lwdown
911	REAL, DIMENSION(klon), INTENT(IN) :: fluxlat, fluxsens
912	REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow
913	REAL, DIMENSION(klon), INTENT(IN) :: evap, tsurf, fder
914	REAL, DIMENSION(klon), INTENT(IN) :: albsol, taux, tauy
915	REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
916	REAL, INTENT(IN):: sens_prec_liq(:), sens_prec_sol(:) ! (knon)
917	REAL, DIMENSION(klon), INTENT(IN) :: lat_prec_liq, lat_prec_sol
918	LOGICAL, INTENT(IN) :: lafin
919
920	! Local variables
921	!*************************************************************************************
922	INTEGER :: cpl_index, ig
923	INTEGER :: error, sum_error
924	CHARACTER(len = 25) :: modname = 'cpl_send_seaice_fields'
925	CHARACTER(len = 80) :: abort_message
926	REAL, DIMENSION(klon) :: cpl_fder_tmp
927
928	!*************************************************************************************
929	! Start calulation
930	! The sea-ice points are saved with second array index=2
931	!
932	!*************************************************************************************
933	cpl_index = 2
934
935	!*************************************************************************************
936	! Reset fields to zero in the beginning of a new coupling period
937	!
938	!*************************************************************************************
939	IF (MOD(itime, nexca) == 1) THEN
940	cpl_sols(1:knon,cpl_index) = 0.0
941	cpl_nsol(1:knon,cpl_index) = 0.0
942	cpl_rain(1:knon,cpl_index) = 0.0
943	cpl_snow(1:knon,cpl_index) = 0.0
944	cpl_evap(1:knon,cpl_index) = 0.0
945	cpl_tsol(1:knon,cpl_index) = 0.0
946	cpl_fder(1:knon,cpl_index) = 0.0
947	cpl_albe(1:knon,cpl_index) = 0.0
948	cpl_taux(1:knon,cpl_index) = 0.0
949	cpl_tauy(1:knon,cpl_index) = 0.0
950	cpl_sens_rain(1:knon,cpl_index) = 0.0
951	cpl_sens_snow(1:knon,cpl_index) = 0.0
952	cpl_taumod(1:knon,cpl_index) = 0.0
953	ENDIF
954
955	!*************************************************************************************
956	! Cumulate at each time-step
957	!
958	!*************************************************************************************
959	DO ig = 1, knon
960	cpl_sols(ig,cpl_index) = cpl_sols(ig,cpl_index) + &
961	swdown(ig) / REAL(nexca)
962	cpl_nsol(ig,cpl_index) = cpl_nsol(ig,cpl_index) + &
963	(lwdown(ig) + fluxlat(ig) +fluxsens(ig)) / REAL(nexca)
964	cpl_rain(ig,cpl_index) = cpl_rain(ig,cpl_index) + &
965	precip_rain(ig) / REAL(nexca)
966	cpl_snow(ig,cpl_index) = cpl_snow(ig,cpl_index) + &
967	precip_snow(ig) / REAL(nexca)
968	cpl_evap(ig,cpl_index) = cpl_evap(ig,cpl_index) + &
969	evap(ig) / REAL(nexca)
970	cpl_tsol(ig,cpl_index) = cpl_tsol(ig,cpl_index) + &
971	tsurf(ig) / REAL(nexca)
972	cpl_fder(ig,cpl_index) = cpl_fder(ig,cpl_index) + &
973	fder(ig) / REAL(nexca)
974	cpl_albe(ig,cpl_index) = cpl_albe(ig,cpl_index) + &
975	albsol(ig) / REAL(nexca)
976	cpl_taux(ig,cpl_index) = cpl_taux(ig,cpl_index) + &
977	taux(ig) / REAL(nexca)
978	cpl_tauy(ig,cpl_index) = cpl_tauy(ig,cpl_index) + &
979	tauy(ig) / REAL(nexca)
980	cpl_sens_rain(ig,cpl_index) = cpl_sens_rain(ig,cpl_index) + &
981	sens_prec_liq(ig) / REAL(nexca)
982	cpl_sens_snow(ig,cpl_index) = cpl_sens_snow(ig,cpl_index) + &
983	sens_prec_sol(ig) / REAL(nexca)
984	cpl_taumod(ig,cpl_index) = cpl_taumod(ig,cpl_index) + &
985	SQRT ( taux(ig)taux(ig)+tauy(ig)tauy(ig) ) / REAL(nexca)
986	ENDDO
987
988	!*************************************************************************************
989	! If the time-step corresponds to the end of coupling period the
990	! fields are transformed to the 2D grid and all fields are sent to coupler.
991	!
992	!*************************************************************************************
993	IF (MOD(itime, nexca) == 0) THEN
994	IF (.NOT. ALLOCATED(cpl_sols2D)) THEN
995	sum_error = 0
996	ALLOCATE(cpl_sols2D(nbp_lon,jj_nb,2), stat=error)
997	sum_error = sum_error + error
998	ALLOCATE(cpl_nsol2D(nbp_lon,jj_nb,2), stat=error)
999	sum_error = sum_error + error
1000	ALLOCATE(cpl_rain2D(nbp_lon,jj_nb,2), stat=error)
1001	sum_error = sum_error + error
1002	ALLOCATE(cpl_snow2D(nbp_lon,jj_nb,2), stat=error)
1003	sum_error = sum_error + error
1004	ALLOCATE(cpl_evap2D(nbp_lon,jj_nb,2), stat=error)
1005	sum_error = sum_error + error
1006	ALLOCATE(cpl_tsol2D(nbp_lon,jj_nb,2), stat=error)
1007	sum_error = sum_error + error
1008	ALLOCATE(cpl_fder2D(nbp_lon,jj_nb,2), stat=error)
1009	sum_error = sum_error + error
1010	ALLOCATE(cpl_albe2D(nbp_lon,jj_nb,2), stat=error)
1011	sum_error = sum_error + error
1012	ALLOCATE(cpl_taux2D(nbp_lon,jj_nb,2), stat=error)
1013	sum_error = sum_error + error
1014	ALLOCATE(cpl_tauy2D(nbp_lon,jj_nb,2), stat=error)
1015	sum_error = sum_error + error
1016	ALLOCATE(cpl_windsp2D(nbp_lon,jj_nb), stat=error)
1017	sum_error = sum_error + error
1018	ALLOCATE(cpl_sens_rain2D(nbp_lon,jj_nb,2), stat=error)
1019	sum_error = sum_error + error
1020	ALLOCATE(cpl_sens_snow2D(nbp_lon,jj_nb,2), stat=error)
1021	sum_error = sum_error + error
1022	ALLOCATE(cpl_taumod2D(nbp_lon,jj_nb,2), stat=error)
1023	sum_error = sum_error + error
1024
1025	IF (carbon_cycle_cpl) THEN
1026	ALLOCATE(cpl_atm_co22D(nbp_lon,jj_nb), stat=error)
1027	sum_error = sum_error + error
1028	ENDIF
1029
1030	IF (sum_error /= 0) THEN
1031	abort_message='Pb allocation variables couplees pour l''ecriture'
1032	CALL abort_physic(modname,abort_message,1)
1033	ENDIF
1034	ENDIF
1035
1036	CALL gath2cpl(cpl_sols(:,cpl_index), cpl_sols2D(:,:,cpl_index), &
1037	knon, knindex)
1038
1039	CALL gath2cpl(cpl_nsol(:,cpl_index), cpl_nsol2D(:,:,cpl_index), &
1040	knon, knindex)
1041
1042	CALL gath2cpl(cpl_rain(:,cpl_index), cpl_rain2D(:,:,cpl_index), &
1043	knon, knindex)
1044
1045	CALL gath2cpl(cpl_snow(:,cpl_index), cpl_snow2D(:,:,cpl_index), &
1046	knon, knindex)
1047
1048	CALL gath2cpl(cpl_evap(:,cpl_index), cpl_evap2D(:,:,cpl_index), &
1049	knon, knindex)
1050
1051	! cpl_tsol2D(:,:,:) not used!
1052	CALL gath2cpl(cpl_tsol(:,cpl_index), cpl_tsol2D(:,:, cpl_index), &
1053	knon, knindex)
1054
1055	! Set default value and decompress before gath2cpl
1056	cpl_fder_tmp(:) = -20.
1057	DO ig = 1, knon
1058	cpl_fder_tmp(knindex(ig))=cpl_fder(ig,cpl_index)
1059	ENDDO
1060	CALL gath2cpl(cpl_fder_tmp(:), cpl_fder2D(:,:,cpl_index), &
1061	klon, unity)
1062
1063	! cpl_albe2D(:,:,:) not used!
1064	CALL gath2cpl(cpl_albe(:,cpl_index), cpl_albe2D(:,:,cpl_index), &
1065	knon, knindex)
1066
1067	CALL gath2cpl(cpl_taux(:,cpl_index), cpl_taux2D(:,:,cpl_index), &
1068	knon, knindex)
1069
1070	CALL gath2cpl(cpl_tauy(:,cpl_index), cpl_tauy2D(:,:,cpl_index), &
1071	knon, knindex)
1072
1073	CALL gath2cpl(cpl_sens_rain(:,cpl_index), cpl_sens_rain2D(:,:,cpl_index), &
1074	knon, knindex)
1075
1076	CALL gath2cpl(cpl_sens_snow(:,cpl_index), cpl_sens_snow2D(:,:,cpl_index), &
1077	knon, knindex)
1078
1079	CALL gath2cpl(cpl_taumod(:,cpl_index), cpl_taumod2D(:,:,cpl_index), &
1080	knon, knindex)
1081
1082	! Send all fields
1083	CALL cpl_send_all(itime, dtime, pctsrf, lafin, rlon, rlat)
1084	ENDIF
1085
1086	END SUBROUTINE cpl_send_seaice_fields
1087
1088	!
1089	!*************************************************************************************
1090	!
1091
1092	SUBROUTINE cpl_send_land_fields(itime, knon, knindex, rriv_in, rcoa_in)
1093	!
1094	! This subroutine cumulates some fields for each time-step during a coupling
1095	! period. At last time-step in a coupling period the fields are transformed to the
1096	! grid accepted by the coupler. No sending to the coupler will be done from here
1097	! (it is done in cpl_send_seaice_fields).
1098	!
1099	USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
1100
1101	! Input arguments
1102	!*************************************************************************************
1103	INTEGER, INTENT(IN) :: itime
1104	INTEGER, INTENT(IN) :: knon
1105	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
1106	REAL, DIMENSION(klon), INTENT(IN) :: rriv_in
1107	REAL, DIMENSION(klon), INTENT(IN) :: rcoa_in
1108
1109	! Local variables
1110	!*************************************************************************************
1111	REAL, DIMENSION(nbp_lon,jj_nb) :: rriv2D
1112	REAL, DIMENSION(nbp_lon,jj_nb) :: rcoa2D
1113
1114	!*************************************************************************************
1115	! Rearrange fields in 2D variables
1116	! First initialize to zero to avoid unvalid points causing problems
1117	!
1118	!*************************************************************************************
1119	!$OMP MASTER
1120	rriv2D(:,:) = 0.0
1121	rcoa2D(:,:) = 0.0
1122	!$OMP END MASTER
1123	CALL gath2cpl(rriv_in, rriv2D, knon, knindex)
1124	CALL gath2cpl(rcoa_in, rcoa2D, knon, knindex)
1125
1126	!*************************************************************************************
1127	! Reset cumulated fields to zero in the beginning of a new coupling period
1128	!
1129	!*************************************************************************************
1130	IF (MOD(itime, nexca) == 1) THEN
1131	!$OMP MASTER
1132	cpl_rriv2D(:,:) = 0.0
1133	cpl_rcoa2D(:,:) = 0.0
1134	!$OMP END MASTER
1135	ENDIF
1136
1137	!*************************************************************************************
1138	! Cumulate : Following fields should be cumulated at each time-step
1139	!
1140	!*************************************************************************************
1141	!$OMP MASTER
1142	cpl_rriv2D(:,:) = cpl_rriv2D(:,:) + rriv2D(:,:) / REAL(nexca)
1143	cpl_rcoa2D(:,:) = cpl_rcoa2D(:,:) + rcoa2D(:,:) / REAL(nexca)
1144	!$OMP END MASTER
1145
1146	END SUBROUTINE cpl_send_land_fields
1147
1148	!
1149	!*************************************************************************************
1150	!
1151
1152	SUBROUTINE cpl_send_landice_fields(itime, knon, knindex, rlic_in)
1153	! This subroutine cumulates the field for melting ice for each time-step
1154	! during a coupling period. This routine will not send to coupler. Sending
1155	! will be done in cpl_send_seaice_fields.
1156	!
1157
1158	USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
1159
1160	! Input varibales
1161	!*************************************************************************************
1162	INTEGER, INTENT(IN) :: itime
1163	INTEGER, INTENT(IN) :: knon
1164	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
1165	REAL, DIMENSION(klon), INTENT(IN) :: rlic_in
1166
1167	! Local varibales
1168	!*************************************************************************************
1169	REAL, DIMENSION(nbp_lon,jj_nb) :: rlic2D
1170
1171	!*************************************************************************************
1172	! Rearrange field in a 2D variable
1173	! First initialize to zero to avoid unvalid points causing problems
1174	!
1175	!*************************************************************************************
1176	!$OMP MASTER
1177	rlic2D(:,:) = 0.0
1178	!$OMP END MASTER
1179	CALL gath2cpl(rlic_in, rlic2D, knon, knindex)
1180
1181	!*************************************************************************************
1182	! Reset field to zero in the beginning of a new coupling period
1183	!
1184	!*************************************************************************************
1185	IF (MOD(itime, nexca) == 1) THEN
1186	!$OMP MASTER
1187	cpl_rlic2D(:,:) = 0.0
1188	!$OMP END MASTER
1189	ENDIF
1190
1191	!*************************************************************************************
1192	! Cumulate : Melting ice should be cumulated at each time-step
1193	!
1194	!*************************************************************************************
1195	!$OMP MASTER
1196	cpl_rlic2D(:,:) = cpl_rlic2D(:,:) + rlic2D(:,:) / REAL(nexca)
1197	!$OMP END MASTER
1198
1199	END SUBROUTINE cpl_send_landice_fields
1200
1201	!
1202	!*************************************************************************************
1203	!
1204
1205	SUBROUTINE cpl_send_all(itime, dtime, pctsrf, lafin, rlon, rlat)
1206	! This routine will send fields for all different surfaces to the coupler.
1207	! This subroutine should be executed after calculations by the last surface(sea-ice),
1208	! all calculations at the different surfaces have to be done before.
1209	!
1210	USE surface_data
1211	USE carbon_cycle_mod, ONLY : carbon_cycle_cpl
1212	USE indice_sol_mod
1213	USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
1214	USE time_phylmdz_mod, ONLY: start_time, itau_phy
1215	use config_ocean_skin_m, only: activate_ocean_skin
1216	! Some includes
1217	!
1218	! Input arguments
1219	!*************************************************************************************
1220	INTEGER, INTENT(IN) :: itime
1221	REAL, INTENT(IN) :: dtime
1222	REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat
1223	REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
1224	LOGICAL, INTENT(IN) :: lafin
1225
1226	! Local variables
1227	!*************************************************************************************
1228	INTEGER :: error, sum_error, i,j,k
1229	INTEGER :: itau_w
1230	INTEGER :: time_sec
1231	INTEGER, DIMENSION(nbp_lon*(nbp_lat)) :: ndexct
1232	REAL :: Up, Down
1233	REAL, DIMENSION(nbp_lon, jj_nb) :: tmp_lon, tmp_lat
1234	REAL, DIMENSION(nbp_lon, jj_nb, 4) :: pctsrf2D
1235	REAL, DIMENSION(nbp_lon, jj_nb) :: deno
1236	CHARACTER(len = 20) :: modname = 'cpl_send_all'
1237	CHARACTER(len = 80) :: abort_message
1238
1239	! Variables with fields to coupler
1240	REAL, DIMENSION(nbp_lon, jj_nb) :: tmp_taux
1241	REAL, DIMENSION(nbp_lon, jj_nb) :: tmp_tauy
1242	REAL, DIMENSION(nbp_lon, jj_nb) :: tmp_calv
1243	! Table with all fields to send to coupler
1244	REAL, DIMENSION(nbp_lon, jj_nb, maxsend) :: tab_flds
1245	REAL, DIMENSION(klon_mpi) :: rlon_mpi, rlat_mpi
1246	REAL :: calving(nb_zone_calving)
1247	REAL :: calving_glo(nb_zone_calving)
1248
1249	#ifdef CPP_MPI
1250	INCLUDE 'mpif.h'
1251	INTEGER, DIMENSION(MPI_STATUS_SIZE) :: status
1252	#endif
1253
1254	! End definitions
1255	!*************************************************************************************
1256
1257
1258
1259	!*************************************************************************************
1260	! All fields are stored in a table tab_flds(:,:,:)
1261	! First store the fields which are already on the right format
1262	!
1263	!*************************************************************************************
1264	!$OMP MASTER
1265	tab_flds(:,:,ids_windsp) = cpl_windsp2D(:,:)
1266	tab_flds(:,:,ids_shfice) = cpl_sols2D(:,:,2)
1267	tab_flds(:,:,ids_nsfice) = cpl_nsol2D(:,:,2)
1268	tab_flds(:,:,ids_dflxdt) = cpl_fder2D(:,:,2)
1269	tab_flds(:,:,ids_qraioc) = cpl_sens_rain2D(:,:,1)
1270	tab_flds(:,:,ids_qsnooc) = cpl_sens_snow2D(:,:,1)
1271	tab_flds(:,:,ids_qraiic) = cpl_sens_rain2D(:,:,2)
1272	tab_flds(:,:,ids_qsnoic) = cpl_sens_snow2D(:,:,2)
1273
1274	if (activate_ocean_skin == 2) then
1275	tab_flds(:, :, ids_delta_temp) = cpl_delta_temp_2D
1276	tab_flds(:, :, ids_s_int) = cpl_s_int_2D
1277	end if
1278
1279	IF (version_ocean=='nemo') THEN
1280	tab_flds(:,:,ids_liqrun) = (cpl_rriv2D(:,:) + cpl_rcoa2D(:,:))
1281	IF (carbon_cycle_cpl) tab_flds(:,:,ids_atmco2)=cpl_atm_co22D(:,:)
1282	ELSE IF (version_ocean=='opa8') THEN
1283	tab_flds(:,:,ids_shfoce) = cpl_sols2D(:,:,1)
1284	tab_flds(:,:,ids_nsfoce) = cpl_nsol2D(:,:,1)
1285	tab_flds(:,:,ids_icevap) = cpl_evap2D(:,:,2)
1286	tab_flds(:,:,ids_ocevap) = cpl_evap2D(:,:,1)
1287	tab_flds(:,:,ids_runcoa) = cpl_rcoa2D(:,:)
1288	tab_flds(:,:,ids_rivflu) = cpl_rriv2D(:,:)
1289	ENDIF
1290
1291	!*************************************************************************************
1292	! Transform the fraction of sub-surfaces from 1D to 2D array
1293	!
1294	!*************************************************************************************
1295	pctsrf2D(:,:,:) = 0.
1296	!$OMP END MASTER
1297	CALL gath2cpl(pctsrf(:,is_oce), pctsrf2D(:,:,is_oce), klon, unity)
1298	CALL gath2cpl(pctsrf(:,is_sic), pctsrf2D(:,:,is_sic), klon, unity)
1299	CALL gath2cpl(pctsrf(:,is_lic), pctsrf2D(:,:,is_lic), klon, unity)
1300
1301	!*************************************************************************************
1302	! Calculate the average calving per latitude
1303	! Store calving in tab_flds(:,:,19)
1304	!
1305	!*************************************************************************************
1306	IF (is_omp_root) THEN
1307
1308	IF (cpl_old_calving) THEN ! use old calving
1309
1310	DO j = 1, jj_nb
1311	tmp_calv(:,j) = DOT_PRODUCT (cpl_rlic2D(1:nbp_lon,j), &
1312	pctsrf2D(1:nbp_lon,j,is_lic)) / REAL(nbp_lon)
1313	ENDDO
1314
1315
1316	IF (is_parallel) THEN
1317	IF (.NOT. is_north_pole_dyn) THEN
1318	#ifdef CPP_MPI
1319	CALL MPI_RECV(Up,1,MPI_REAL_LMDZ,mpi_rank-1,1234,COMM_LMDZ_PHY,status,error)
1320	CALL MPI_SEND(tmp_calv(1,1),1,MPI_REAL_LMDZ,mpi_rank-1,1234,COMM_LMDZ_PHY,error)
1321	#endif
1322	ENDIF
1323
1324	IF (.NOT. is_south_pole_dyn) THEN
1325	#ifdef CPP_MPI
1326	CALL MPI_SEND(tmp_calv(1,jj_nb),1,MPI_REAL_LMDZ,mpi_rank+1,1234,COMM_LMDZ_PHY,error)
1327	CALL MPI_RECV(down,1,MPI_REAL_LMDZ,mpi_rank+1,1234,COMM_LMDZ_PHY,status,error)
1328	#endif
1329	ENDIF
1330
1331	IF (.NOT. is_north_pole_dyn .AND. ii_begin /=1) THEN
1332	Up=Up+tmp_calv(nbp_lon,1)
1333	tmp_calv(:,1)=Up
1334	ENDIF
1335
1336	IF (.NOT. is_south_pole_dyn .AND. ii_end /= nbp_lon) THEN
1337	Down=Down+tmp_calv(1,jj_nb)
1338	tmp_calv(:,jj_nb)=Down
1339	ENDIF
1340	ENDIF
1341	tab_flds(:,:,ids_calvin) = tmp_calv(:,:)
1342
1343	ELSE
1344	! cpl_old_calving=FALSE
1345	! To be used with new method for calculation of coupling weights
1346	DO k=1,nb_zone_calving
1347	calving(k)=0
1348	DO j = 1, jj_nb
1349	calving(k)= calving(k)+DOT_PRODUCT(cpl_rlic2D(:,j)*area_calving(:,j,k),pctsrf2D(:,j,is_lic))
1350	ENDDO
1351	ENDDO
1352
1353	#ifdef CPP_MPI
1354	CALL MPI_ALLREDUCE(calving, calving_glo, nb_zone_calving, MPI_REAL_LMDZ, MPI_SUM, COMM_LMDZ_PHY, error)
1355	#endif
1356
1357	tab_flds(:,:,ids_calvin) = 0
1358	DO k=1,nb_zone_calving
1359	IF (ind_calving(k)>0 ) THEN
1360	j=(ind_calving(k)-1)/nbp_lon + 1
1361	i=MOD(ind_calving(k)-1,nbp_lon)+1
1362	tab_flds(i,j,ids_calvin) = calving_glo(k)
1363	ENDIF
1364	ENDDO
1365
1366	ENDIF
1367
1368	!*************************************************************************************
1369	! Calculate total flux for snow, rain and wind with weighted addition using the
1370	! fractions of ocean and seaice.
1371	!
1372	!*************************************************************************************
1373	! fraction oce+seaice
1374	deno = pctsrf2D(:,:,is_oce) + pctsrf2D(:,:,is_sic)
1375
1376	IF (version_ocean=='nemo') THEN
1377	tab_flds(:,:,ids_shftot) = 0.0
1378	tab_flds(:,:,ids_nsftot) = 0.0
1379	tab_flds(:,:,ids_totrai) = 0.0
1380	tab_flds(:,:,ids_totsno) = 0.0
1381	tab_flds(:,:,ids_toteva) = 0.0
1382	tab_flds(:,:,ids_taumod) = 0.0
1383
1384	tmp_taux(:,:) = 0.0
1385	tmp_tauy(:,:) = 0.0
1386	! For all valid grid cells containing some fraction of ocean or sea-ice
1387	WHERE ( deno(:,:) /= 0 )
1388	tmp_taux = cpl_taux2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + &
1389	cpl_taux2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
1390	tmp_tauy = cpl_tauy2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + &
1391	cpl_tauy2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
1392
1393	tab_flds(:,:,ids_shftot) = cpl_sols2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + &
1394	cpl_sols2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
1395	tab_flds(:,:,ids_nsftot) = cpl_nsol2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + &
1396	cpl_nsol2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
1397	tab_flds(:,:,ids_totrai) = cpl_rain2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + &
1398	cpl_rain2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
1399	tab_flds(:,:,ids_totsno) = cpl_snow2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + &
1400	cpl_snow2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
1401	tab_flds(:,:,ids_toteva) = cpl_evap2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + &
1402	cpl_evap2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
1403	tab_flds(:,:,ids_taumod) = cpl_taumod2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + &
1404	cpl_taumod2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
1405
1406	ENDWHERE
1407
1408	tab_flds(:,:,ids_icevap) = cpl_evap2D(:,:,2)
1409
1410	ELSE IF (version_ocean=='opa8') THEN
1411	! Store fields for rain and snow in tab_flds(:,:,15) and tab_flds(:,:,16)
1412	tab_flds(:,:,ids_totrai) = 0.0
1413	tab_flds(:,:,ids_totsno) = 0.0
1414	tmp_taux(:,:) = 0.0
1415	tmp_tauy(:,:) = 0.0
1416	! For all valid grid cells containing some fraction of ocean or sea-ice
1417	WHERE ( deno(:,:) /= 0 )
1418	tab_flds(:,:,ids_totrai) = cpl_rain2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + &
1419	cpl_rain2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
1420	tab_flds(:,:,ids_totsno) = cpl_snow2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + &
1421	cpl_snow2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
1422
1423	tmp_taux = cpl_taux2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + &
1424	cpl_taux2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
1425	tmp_tauy = cpl_tauy2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + &
1426	cpl_tauy2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
1427	ENDWHERE
1428	ENDIF
1429
1430	ENDIF ! is_omp_root
1431
1432	!*************************************************************************************
1433	! Transform the wind components from local atmospheric 2D coordinates to geocentric
1434	! 3D coordinates.
1435	! Store the resulting wind components in tab_flds(:,:,1:6)
1436	!*************************************************************************************
1437
1438	! Transform the longitudes and latitudes on 2D arrays
1439
1440	CALL gather_omp(rlon,rlon_mpi)
1441	CALL gather_omp(rlat,rlat_mpi)
1442	!$OMP MASTER
1443	CALL Grid1DTo2D_mpi(rlon_mpi,tmp_lon)
1444	CALL Grid1DTo2D_mpi(rlat_mpi,tmp_lat)
1445	!$OMP END MASTER
1446
1447	IF (is_sequential) THEN
1448	IF (is_north_pole_dyn) tmp_lon(:,1) = tmp_lon(:,2)
1449	IF (is_south_pole_dyn) tmp_lon(:,nbp_lat) = tmp_lon(:,nbp_lat-1)
1450	ENDIF
1451
1452	! NetCDF output of the wind before transformation of coordinate system
1453	IF (is_sequential) THEN
1454	ndexct(:) = 0
1455	itau_w = itau_phy + itime + start_time * day_step_phy
1456	CALL histwrite(nidct,'tauxe',itau_w,tmp_taux,nbp_lon*(nbp_lat),ndexct)
1457	CALL histwrite(nidct,'tauyn',itau_w,tmp_tauy,nbp_lon*(nbp_lat),ndexct)
1458	CALL histwrite(nidct,'tmp_lon',itau_w,tmp_lon,nbp_lon*(nbp_lat),ndexct)
1459	CALL histwrite(nidct,'tmp_lat',itau_w,tmp_lat,nbp_lon*(nbp_lat),ndexct)
1460	ENDIF
1461
1462	! Transform the wind from spherical atmospheric 2D coordinates to geocentric
1463	! cartesian 3D coordinates
1464	!$OMP MASTER
1465	CALL atm2geo (nbp_lon, jj_nb, tmp_taux, tmp_tauy, tmp_lon, tmp_lat, &
1466	tab_flds(:,:,ids_tauxxu), tab_flds(:,:,ids_tauyyu), tab_flds(:,:,ids_tauzzu) )
1467
1468	tab_flds(:,:,ids_tauxxv) = tab_flds(:,:,ids_tauxxu)
1469	tab_flds(:,:,ids_tauyyv) = tab_flds(:,:,ids_tauyyu)
1470	tab_flds(:,:,ids_tauzzv) = tab_flds(:,:,ids_tauzzu)
1471	!$OMP END MASTER
1472
1473	!*************************************************************************************
1474	! NetCDF output of all fields just before sending to coupler.
1475	!
1476	!*************************************************************************************
1477	IF (is_sequential) THEN
1478	DO j=1,maxsend
1479	IF (infosend(j)%action) CALL histwrite(nidct,infosend(j)%name, itau_w, &
1480	tab_flds(:,:,j),nbp_lon*(nbp_lat),ndexct)
1481	ENDDO
1482	ENDIF
1483	!*************************************************************************************
1484	! Send the table of all fields
1485	!
1486	!*************************************************************************************
1487	time_sec=(itime-1)*dtime
1488	#ifdef CPP_COUPLE
1489	!$OMP MASTER
1490	CALL intocpl(time_sec, lafin, tab_flds(:,:,:))
1491	!$OMP END MASTER
1492	#endif
1493
1494	!*************************************************************************************
1495	! Finish with some dellocate
1496	!
1497	!*************************************************************************************
1498	sum_error=0
1499	DEALLOCATE(cpl_sols2D, cpl_nsol2D, cpl_rain2D, cpl_snow2D, stat=error )
1500	sum_error = sum_error + error
1501	DEALLOCATE(cpl_evap2D, cpl_tsol2D, cpl_fder2D, cpl_albe2D, stat=error )
1502	sum_error = sum_error + error
1503	DEALLOCATE(cpl_taux2D, cpl_tauy2D, cpl_windsp2D, cpl_taumod2D, stat=error )
1504	sum_error = sum_error + error
1505	DEALLOCATE(cpl_sens_rain2D, cpl_sens_snow2D, stat=error)
1506	sum_error = sum_error + error
1507
1508
1509	IF (carbon_cycle_cpl) THEN
1510	DEALLOCATE(cpl_atm_co22D, stat=error )
1511	sum_error = sum_error + error
1512	ENDIF
1513
1514	if (activate_ocean_skin == 2) deallocate(cpl_delta_temp_2d, cpl_s_int_2d)
1515
1516	IF (sum_error /= 0) THEN
1517	abort_message='Pb in deallocation of cpl_xxxx2D coupling variables'
1518	CALL abort_physic(modname,abort_message,1)
1519	ENDIF
1520
1521	END SUBROUTINE cpl_send_all
1522	!
1523	!*************************************************************************************
1524	!
1525	SUBROUTINE cpl2gath(champ_in, champ_out, knon, knindex)
1526	USE mod_phys_lmdz_para
1527	! Cette routine transforme un champs de la grille 2D recu du coupleur sur la grille
1528	! 'gathered' (la grille physiq comprime).
1529	!
1530	!
1531	! input:
1532	! champ_in champ sur la grille 2D
1533	! knon nombre de points dans le domaine a traiter
1534	! knindex index des points de la surface a traiter
1535	!
1536	! output:
1537	! champ_out champ sur la grille 'gatherd'
1538	!
1539	USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
1540
1541	! Input
1542	INTEGER, INTENT(IN) :: knon
1543	REAL, DIMENSION(nbp_lon,jj_nb), INTENT(IN) :: champ_in
1544	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
1545
1546	! Output
1547	REAL, DIMENSION(klon_mpi), INTENT(OUT) :: champ_out
1548
1549	! Local
1550	INTEGER :: i, ig
1551	REAL, DIMENSION(klon_mpi) :: temp_mpi
1552	REAL, DIMENSION(klon) :: temp_omp
1553
1554	!*************************************************************************************
1555	!
1556
1557
1558	! Transform from 2 dimensions (nbp_lon,jj_nb) to 1 dimension (klon)
1559	!$OMP MASTER
1560	CALL Grid2Dto1D_mpi(champ_in,temp_mpi)
1561	!$OMP END MASTER
1562
1563	CALL scatter_omp(temp_mpi,temp_omp)
1564
1565	! Compress from klon to knon
1566	DO i = 1, knon
1567	ig = knindex(i)
1568	champ_out(i) = temp_omp(ig)
1569	ENDDO
1570
1571	END SUBROUTINE cpl2gath
1572	!
1573	!*************************************************************************************
1574	!
1575	SUBROUTINE gath2cpl(champ_in, champ_out, knon, knindex)
1576	USE mod_phys_lmdz_para
1577	! Cette routine ecrit un champ 'gathered' sur la grille 2D pour le passer
1578	! au coupleur.
1579	!
1580	! input:
1581	! champ_in champ sur la grille gathere
1582	! knon nombre de points dans le domaine a traiter
1583	! knindex index des points de la surface a traiter
1584	!
1585	! output:
1586	! champ_out champ sur la grille 2D
1587	!
1588	USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
1589
1590	! Input arguments
1591	!*************************************************************************************
1592	INTEGER, INTENT(IN) :: knon
1593	REAL, DIMENSION(klon), INTENT(IN) :: champ_in
1594	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
1595
1596	! Output arguments
1597	!*************************************************************************************
1598	REAL, DIMENSION(nbp_lon,jj_nb), INTENT(OUT) :: champ_out
1599
1600	! Local variables
1601	!*************************************************************************************
1602	INTEGER :: i, ig
1603	REAL, DIMENSION(klon) :: temp_omp
1604	REAL, DIMENSION(klon_mpi) :: temp_mpi
1605	!*************************************************************************************
1606
1607	! Decompress from knon to klon
1608	temp_omp = 0.
1609	DO i = 1, knon
1610	ig = knindex(i)
1611	temp_omp(ig) = champ_in(i)
1612	ENDDO
1613
1614	! Transform from 1 dimension (klon) to 2 dimensions (nbp_lon,jj_nb)
1615	CALL gather_omp(temp_omp,temp_mpi)
1616
1617	!$OMP MASTER
1618	CALL Grid1Dto2D_mpi(temp_mpi,champ_out)
1619
1620	IF (is_north_pole_dyn) champ_out(:,1)=temp_mpi(1)
1621	IF (is_south_pole_dyn) champ_out(:,jj_nb)=temp_mpi(klon)
1622	!$OMP END MASTER
1623
1624	END SUBROUTINE gath2cpl
1625	!
1626	!*************************************************************************************
1627	!
1628	END MODULE cpl_mod
1629

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

Download in other formats:

Original Format