Context Navigation

cpl_mod.F90 @ 5276

Last change on this file since 5276 was 5274, checked in by abarral, 9 months ago
Replace yomcst.h by existing module
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: 67.8 KB

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

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

Download in other formats:

Original Format