Context Navigation

cpl_mod.F90 @ 3744

Last change on this file since 3744 was 3744, checked in by lguez, 4 years ago

Store delta_sst instead of sst_nff

Store as a state variable the difference between ocean-air interface
temperature and bulk SST instead of sst_nff, which can be either
interface temperature or bulk SST. This is clearer. Also, it is
analoguous to what we will do with salinity.

So replace the two dummy arguments tsurf_in and sst_nff of
procedure cpl_send_ocean_fields by a single dummy argument
delta_sst. Replace dummy argument sst_nff of procedures
ocean_cpl_noice and surf_ocean by dummy argument
delta_sst. Replace variable sst_nff of module phys_state_var_mod
by variable delta_sst. Rename local variable ysst_nff of procedure
pbl_surface to ydelta_sst. Set variable delta_sst of module
phys_state_var_mod to 0 for an appearing ocean fraction and a
missing startup field. Replace variable o_sst_nff of module
phys_output_ctrlout_mod by variable o_delta_sst.

Rename variables cpl_delta_temp and cpl_delta_temp_2D of module
cpl_mod to cpl_delta_sst and cpl_delta_sst_2D, clearer. Rename
variable ids_delta_temp of module oasis to ids_delta_sst. Change
infosend(ids_delta_temp)%name to "CODELSST".

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

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

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

Download in other formats:

Original Format