Context Navigation

cpl_mod.F90 @ 4096

Last change on this file since 4096 was 4020, checked in by lguez, 3 years ago

Send 3 more fields to the ocean

Send 3 more fields to the ocean to compute CO2 flux at
ocean-atmosphere interface. The three fields are dter and dser, which
already existed, and a newly created field: dt_ds. So dter and dser
have to become state variables. The variable dt_ds of module
phys_state_var_mod is only allocated and defined if
activate_ocean_skin == 2 and type_ocean == "couple".

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

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

Download in other formats:

Original Format