Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

cpl_mod.F90

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

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

Download in other formats:

Original Format