Context Navigation

cpl_mod.F90 @ 4350

Last change on this file since 4350 was 4283, checked in by jghattas, 2 years ago

Added landice_opt=2 : Treat continental land ice fractions in ORCHIDEE => pctsrf(:,is_lic) = 0.0 in LMDZ.

For this option, some more variables are needed from ORCHIDEE. Therfor change in the interface LMDZ-ORCHIDEE in surf_land_orchidee_mod is done. Previous interface is moved to surf_land_orchidee_nolic_mod.f90. To compile with previous interface, cpp key ORCHIDEE_NOLIC is added. Previous interface is compiled with argument orchidee2.1 in makelmdz and makelmdz_fcm.

At the same time, when the interface was changed, the variable yrmu0(coszang) was added in the call to intersurf_initialize_gathered. This is needed in ORCHIDEE to better initialize the model.

Modifications done by Etienne Vignon and Josefine Ghattas

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

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

Download in other formats:

Original Format