Context Navigation

cpl_mod.F90 @ 5300

Last change on this file since 5300 was 5285, checked in by abarral, 5 weeks ago
As discussed internally, remove generic ONLY: ... for new _mod_h modules
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.1 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
411	USE surface_data
412	USE geometry_mod, ONLY : longitude_deg, latitude_deg
413	USE carbon_cycle_mod, ONLY : carbon_cycle_cpl
414	USE indice_sol_mod
415	USE time_phylmdz_mod, ONLY: start_time, itau_phy
416	USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
417	use config_ocean_skin_m, only: activate_ocean_skin
418
419
420
421	! Arguments
422	!************************************************************************************
423	INTEGER, INTENT(IN) :: itime
424	REAL, INTENT(IN) :: dtime
425	REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: pctsrf
426	LOGICAL, INTENT(OUT) :: is_modified
427
428	! Local variables
429	!************************************************************************************
430	INTEGER :: j, i, time_sec
431	INTEGER :: itau_w
432	INTEGER, DIMENSION(nbp_lon*nbp_lat) :: ndexcs
433	CHARACTER(len = 20) :: modname = 'cpl_receive_frac'
434	CHARACTER(len = 80) :: abort_message
435	REAL, DIMENSION(klon) :: read_sic1D
436	REAL, DIMENSION(nbp_lon,jj_nb,maxrecv_phys) :: tab_read_flds
437	REAL, DIMENSION(klon,nbsrf) :: pctsrf_old
438	REAL, DIMENSION(klon_mpi) :: rlon_mpi, rlat_mpi
439	REAL, DIMENSION(nbp_lon,jj_nb) :: tmp_lon, tmp_lat
440	REAL, DIMENSION(nbp_lon,jj_nb) :: tmp_r0
441
442	!*************************************************************************************
443	! Start calculation
444	! Get fields from coupler
445	!
446	!*************************************************************************************
447
448	is_modified=.FALSE.
449
450	! Check if right moment to receive from coupler
451	IF (MOD(itime, nexca) == 1) THEN
452	is_modified=.TRUE.
453
454	time_sec=(itime-1)*dtime
455	#ifdef CPP_COUPLE
456	!$OMP MASTER
457	CALL fromcpl(time_sec, tab_read_flds)
458	!$OMP END MASTER
459	#endif
460
461	! NetCDF output of received fields
462	IF (is_sequential) THEN
463	ndexcs(:) = 0
464	itau_w = itau_phy + itime + start_time * day_step_phy
465	DO i = 1, maxrecv_phys
466	IF (inforecv(i)%action) THEN
467	CALL histwrite(nidcs,inforecv(i)%name,itau_w,tab_read_flds(:,:,i),nbp_lon*(nbp_lat),ndexcs)
468	ENDIF
469	ENDDO
470	ENDIF
471
472
473	! Save each field in a 2D array.
474	!$OMP MASTER
475	read_sst(:,:) = tab_read_flds(:,:,idr_sisutw) ! Sea surface temperature
476	read_sic(:,:) = tab_read_flds(:,:,idr_icecov) ! Sea ice concentration
477	read_alb_sic(:,:) = tab_read_flds(:,:,idr_icealw) ! Albedo at sea ice
478	read_sit(:,:) = tab_read_flds(:,:,idr_icetem) ! Sea ice temperature
479	if (activate_ocean_skin >= 1) read_sss(:,:) = tab_read_flds(:,:,idr_sss)
480	!$OMP END MASTER
481
482	IF (cpl_current) THEN
483
484	! Transform the longitudes and latitudes on 2D arrays
485	CALL gather_omp(longitude_deg,rlon_mpi)
486	CALL gather_omp(latitude_deg,rlat_mpi)
487	!$OMP MASTER
488	CALL Grid1DTo2D_mpi(rlon_mpi,tmp_lon)
489	CALL Grid1DTo2D_mpi(rlat_mpi,tmp_lat)
490
491	! Transform the currents from cartesian to spheric coordinates
492	! tmp_r0 should be zero
493	CALL geo2atm(nbp_lon, jj_nb, tab_read_flds(:,:,idr_curenx), &
494	tab_read_flds(:,:,idr_cureny), tab_read_flds(:,:,idr_curenz), &
495	tmp_lon, tmp_lat, &
496	read_u0(:,:), read_v0(:,:), tmp_r0(:,:))
497	!$OMP END MASTER
498
499	ELSE
500	read_u0(:,:) = 0.
501	read_v0(:,:) = 0.
502	ENDIF
503
504	IF (carbon_cycle_cpl) THEN
505	!$OMP MASTER
506	read_co2(:,:) = tab_read_flds(:,:,idr_oceco2) ! CO2 flux
507	!$OMP END MASTER
508	ENDIF
509
510	!*************************************************************************************
511	! Transform seaice fraction (read_sic : ocean-seaice mask) into global
512	! fraction (pctsrf : ocean-seaice-land-landice mask)
513	!
514	!*************************************************************************************
515	CALL cpl2gath(read_sic, read_sic1D, klon, unity)
516
517	pctsrf_old(:,:) = pctsrf(:,:)
518	DO i = 1, klon
519	! treatment only of points with ocean and/or seaice
520	! old land-ocean mask can not be changed
521	IF (pctsrf_old(i,is_oce) + pctsrf_old(i,is_sic) > 0.) THEN
522	pctsrf(i,is_sic) = (pctsrf_old(i,is_oce) + pctsrf_old(i,is_sic)) &
523	* read_sic1D(i)
524	pctsrf(i,is_oce) = (pctsrf_old(i,is_oce) + pctsrf_old(i,is_sic)) &
525	- pctsrf(i,is_sic)
526	ENDIF
527	ENDDO
528
529	ENDIF ! if time to receive
530
531	END SUBROUTINE cpl_receive_frac
532
533	!
534	!*************************************************************************************
535	!
536
537	SUBROUTINE cpl_receive_ocean_fields(knon, knindex, tsurf_new, u0_new, &
538	v0_new, sss)
539	!
540	! This routine returns the field for the ocean that has been read from the coupler
541	! (done earlier with cpl_receive_frac). The field is the temperature.
542	! The temperature is transformed into 1D array with valid points from index 1 to knon.
543	!
544	USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, fco2_ocn_day
545	USE indice_sol_mod
546	use config_ocean_skin_m, only: activate_ocean_skin
547
548	! Input arguments
549	!*************************************************************************************
550	INTEGER, INTENT(IN) :: knon
551	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
552
553	! Output arguments
554	!*************************************************************************************
555	REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new
556
557	REAL, INTENT(OUT):: sss(:) ! (klon)
558	! bulk salinity of the surface layer of the ocean, in ppt
559
560	REAL, DIMENSION(klon), INTENT(OUT) :: u0_new
561	REAL, DIMENSION(klon), INTENT(OUT) :: v0_new
562
563	! Local variables
564	!*************************************************************************************
565	INTEGER :: i
566	INTEGER, DIMENSION(klon) :: index
567	REAL, DIMENSION(klon) :: sic_new
568
569	!*************************************************************************************
570	! Transform read_sst into compressed 1D variable tsurf_new
571	!
572	!*************************************************************************************
573	CALL cpl2gath(read_sst, tsurf_new, knon, knindex)
574	if (activate_ocean_skin >= 1) CALL cpl2gath(read_sss, sss, knon, knindex)
575	CALL cpl2gath(read_sic, sic_new, knon, knindex)
576	CALL cpl2gath(read_u0, u0_new, knon, knindex)
577	CALL cpl2gath(read_v0, v0_new, knon, knindex)
578
579	!*************************************************************************************
580	! Transform read_co2 into uncompressed 1D variable fco2_ocn_day added directly in
581	! the module carbon_cycle_mod
582	!
583	!*************************************************************************************
584	IF (carbon_cycle_cpl) THEN
585	DO i=1,klon
586	index(i)=i
587	ENDDO
588	CALL cpl2gath(read_co2, fco2_ocn_day, klon, index)
589	ENDIF
590
591	!*************************************************************************************
592	! The fields received from the coupler have to be weighted with the fraction of ocean
593	! in relation to the total sea-ice+ocean
594	!
595	!*************************************************************************************
596	DO i=1, knon
597	tsurf_new(i) = tsurf_new(i)/(1. - sic_new(i))
598	ENDDO
599
600	END SUBROUTINE cpl_receive_ocean_fields
601
602	!
603	!*************************************************************************************
604	!
605
606	SUBROUTINE cpl_receive_seaice_fields(knon, knindex, &
607	tsurf_new, alb_new, u0_new, v0_new)
608	!
609	! This routine returns the fields for the seaice that have been read from the coupler
610	! (done earlier with cpl_receive_frac). These fields are the temperature and
611	! albedo at sea ice surface and fraction of sea ice.
612	! The fields are transformed into 1D arrays with valid points from index 1 to knon.
613	!
614
615	! Input arguments
616	!*************************************************************************************
617	INTEGER, INTENT(IN) :: knon
618	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
619
620	! Output arguments
621	!*************************************************************************************
622	REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new
623	REAL, DIMENSION(klon), INTENT(OUT) :: alb_new
624	REAL, DIMENSION(klon), INTENT(OUT) :: u0_new
625	REAL, DIMENSION(klon), INTENT(OUT) :: v0_new
626
627	! Local variables
628	!*************************************************************************************
629	INTEGER :: i
630	REAL, DIMENSION(klon) :: sic_new
631
632	!*************************************************************************************
633	! Transform fields read from coupler from 2D into compressed 1D variables
634	!
635	!*************************************************************************************
636	CALL cpl2gath(read_sit, tsurf_new, knon, knindex)
637	CALL cpl2gath(read_alb_sic, alb_new, knon, knindex)
638	CALL cpl2gath(read_sic, sic_new, knon, knindex)
639	CALL cpl2gath(read_u0, u0_new, knon, knindex)
640	CALL cpl2gath(read_v0, v0_new, knon, knindex)
641
642	!*************************************************************************************
643	! The fields received from the coupler have to be weighted with the sea-ice
644	! concentration (in relation to the total sea-ice + ocean).
645	!
646	!*************************************************************************************
647	DO i= 1, knon
648	tsurf_new(i) = tsurf_new(i) / sic_new(i)
649	alb_new(i) = alb_new(i) / sic_new(i)
650	ENDDO
651
652	END SUBROUTINE cpl_receive_seaice_fields
653
654	!
655	!*************************************************************************************
656	!
657
658	SUBROUTINE cpl_send_ocean_fields(itime, knon, knindex, &
659	swdown, lwdown, fluxlat, fluxsens, &
660	precip_rain, precip_snow, evap, tsurf, fder, albsol, taux, tauy, windsp,&
661	sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol, delta_sst, &
662	delta_sal, dTer, dSer, dt_ds)
663
664	! This subroutine cumulates some fields for each time-step during
665	! a coupling period. At last time-step in a coupling period the
666	! fields are transformed to the grid accepted by the coupler. No
667	! sending to the coupler will be done from here (it is done in
668	! cpl_send_seaice_fields). Crucial hypothesis is that the surface
669	! fractions do not change between coupling time-steps.
670
671	USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, co2_send
672	USE indice_sol_mod
673	USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
674	use config_ocean_skin_m, only: activate_ocean_skin
675
676	! Input arguments
677	!*************************************************************************************
678	INTEGER, INTENT(IN) :: itime
679	INTEGER, INTENT(IN) :: knon
680	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
681	REAL, DIMENSION(klon), INTENT(IN) :: swdown, lwdown
682	REAL, DIMENSION(klon), INTENT(IN) :: fluxlat, fluxsens
683	REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow
684	REAL, DIMENSION(klon), INTENT(IN) :: evap, tsurf, fder, albsol
685	REAL, DIMENSION(klon), INTENT(IN) :: taux, tauy, windsp
686	REAL, INTENT(IN):: sens_prec_liq(:), sens_prec_sol(:) ! (knon)
687	REAL, DIMENSION(klon), INTENT(IN) :: lat_prec_liq, lat_prec_sol
688
689	REAL, intent(in):: delta_sst(:) ! (knon)
690	! Ocean-air interface temperature minus bulk SST, in
691	! K. Defined only if activate_ocean_skin >= 1.
692
693	real, intent(in):: delta_sal(:) ! (knon)
694	! Ocean-air interface salinity minus bulk salinity, in ppt.
695
696	REAL, intent(in):: dter(:) ! (knon)
697	! Temperature variation in the diffusive microlayer, that is
698	! ocean-air interface temperature minus subskin temperature. In
699	! K.
700
701	REAL, intent(in):: dser(:) ! (knon)
702	! Salinity variation in the diffusive microlayer, that is
703	! ocean-air interface salinity minus subskin salinity. In ppt.
704
705	real, intent(in):: dt_ds(:) ! (knon)
706	! (tks / tkt) * dTer, in K
707
708	! Local variables
709	!*************************************************************************************
710	INTEGER :: cpl_index, ig
711	INTEGER :: error, sum_error
712	CHARACTER(len = 25) :: modname = 'cpl_send_ocean_fields'
713	CHARACTER(len = 80) :: abort_message
714
715	!*************************************************************************************
716	! Start calculation
717	! The ocean points are saved with second array index=1
718	!
719	!*************************************************************************************
720	cpl_index = 1
721
722	!*************************************************************************************
723	! Reset fields to zero in the beginning of a new coupling period
724	!
725	!*************************************************************************************
726	IF (MOD(itime, nexca) == 1) THEN
727	cpl_sols(1:knon,cpl_index) = 0.0
728	cpl_nsol(1:knon,cpl_index) = 0.0
729	cpl_rain(1:knon,cpl_index) = 0.0
730	cpl_snow(1:knon,cpl_index) = 0.0
731	cpl_evap(1:knon,cpl_index) = 0.0
732	cpl_tsol(1:knon,cpl_index) = 0.0
733	cpl_fder(1:knon,cpl_index) = 0.0
734	cpl_albe(1:knon,cpl_index) = 0.0
735	cpl_taux(1:knon,cpl_index) = 0.0
736	cpl_tauy(1:knon,cpl_index) = 0.0
737	cpl_windsp(1:knon,cpl_index) = 0.0
738	cpl_sens_rain(1:knon,cpl_index) = 0.0
739	cpl_sens_snow(1:knon,cpl_index) = 0.0
740	cpl_taumod(1:knon,cpl_index) = 0.0
741	IF (carbon_cycle_cpl) cpl_atm_co2(1:knon,cpl_index) = 0.0
742
743	if (activate_ocean_skin == 2) then
744	cpl_delta_sst = 0.
745	cpl_delta_sal = 0.
746	cpl_dter = 0.
747	cpl_dser = 0.
748	cpl_dt_ds = 0.
749	end if
750	ENDIF
751
752	!*************************************************************************************
753	! Cumulate at each time-step
754	!
755	!*************************************************************************************
756	DO ig = 1, knon
757	cpl_sols(ig,cpl_index) = cpl_sols(ig,cpl_index) + &
758	swdown(ig) / REAL(nexca)
759	cpl_nsol(ig,cpl_index) = cpl_nsol(ig,cpl_index) + &
760	(lwdown(ig) + fluxlat(ig) +fluxsens(ig)) / REAL(nexca)
761	cpl_rain(ig,cpl_index) = cpl_rain(ig,cpl_index) + &
762	precip_rain(ig) / REAL(nexca)
763	cpl_snow(ig,cpl_index) = cpl_snow(ig,cpl_index) + &
764	precip_snow(ig) / REAL(nexca)
765	cpl_evap(ig,cpl_index) = cpl_evap(ig,cpl_index) + &
766	evap(ig) / REAL(nexca)
767	cpl_tsol(ig,cpl_index) = cpl_tsol(ig,cpl_index) + &
768	tsurf(ig) / REAL(nexca)
769	cpl_fder(ig,cpl_index) = cpl_fder(ig,cpl_index) + &
770	fder(ig) / REAL(nexca)
771	cpl_albe(ig,cpl_index) = cpl_albe(ig,cpl_index) + &
772	albsol(ig) / REAL(nexca)
773	cpl_taux(ig,cpl_index) = cpl_taux(ig,cpl_index) + &
774	taux(ig) / REAL(nexca)
775	cpl_tauy(ig,cpl_index) = cpl_tauy(ig,cpl_index) + &
776	tauy(ig) / REAL(nexca)
777	cpl_windsp(ig,cpl_index) = cpl_windsp(ig,cpl_index) + &
778	windsp(ig) / REAL(nexca)
779	cpl_sens_rain(ig,cpl_index) = cpl_sens_rain(ig,cpl_index) + &
780	sens_prec_liq(ig) / REAL(nexca)
781	cpl_sens_snow(ig,cpl_index) = cpl_sens_snow(ig,cpl_index) + &
782	sens_prec_sol(ig) / REAL(nexca)
783	cpl_taumod(ig,cpl_index) = cpl_taumod(ig,cpl_index) + &
784	SQRT ( taux(ig)taux(ig)+tauy(ig)tauy(ig) ) / REAL (nexca)
785
786	IF (carbon_cycle_cpl) THEN
787	cpl_atm_co2(ig,cpl_index) = cpl_atm_co2(ig,cpl_index) + &
788	co2_send(knindex(ig))/ REAL(nexca)
789	!!---OB: this is correct but why knindex ??
790	ENDIF
791
792	if (activate_ocean_skin == 2) then
793	cpl_delta_sst(ig) = cpl_delta_sst(ig) + delta_sst(ig) / REAL(nexca)
794	cpl_delta_sal(ig) = cpl_delta_sal(ig) + delta_sal(ig) / REAL(nexca)
795	cpl_dter(ig) = cpl_dter(ig) + dter(ig) / REAL(nexca)
796	cpl_dser(ig) = cpl_dser(ig) + dser(ig) / REAL(nexca)
797	cpl_dt_ds(ig) = cpl_dt_ds(ig) + dt_ds(ig) / REAL(nexca)
798	end if
799	ENDDO
800
801	!*************************************************************************************
802	! If the time-step corresponds to the end of coupling period the
803	! fields are transformed to the 2D grid.
804	! No sending to the coupler (it is done from cpl_send_seaice_fields).
805	!
806	!*************************************************************************************
807	IF (MOD(itime, nexca) == 0) THEN
808
809	IF (.NOT. ALLOCATED(cpl_sols2D)) THEN
810	sum_error = 0
811	ALLOCATE(cpl_sols2D(nbp_lon,jj_nb,2), stat=error)
812	sum_error = sum_error + error
813	ALLOCATE(cpl_nsol2D(nbp_lon,jj_nb,2), stat=error)
814	sum_error = sum_error + error
815	ALLOCATE(cpl_rain2D(nbp_lon,jj_nb,2), stat=error)
816	sum_error = sum_error + error
817	ALLOCATE(cpl_snow2D(nbp_lon,jj_nb,2), stat=error)
818	sum_error = sum_error + error
819	ALLOCATE(cpl_evap2D(nbp_lon,jj_nb,2), stat=error)
820	sum_error = sum_error + error
821	ALLOCATE(cpl_tsol2D(nbp_lon,jj_nb,2), stat=error)
822	sum_error = sum_error + error
823	ALLOCATE(cpl_fder2D(nbp_lon,jj_nb,2), stat=error)
824	sum_error = sum_error + error
825	ALLOCATE(cpl_albe2D(nbp_lon,jj_nb,2), stat=error)
826	sum_error = sum_error + error
827	ALLOCATE(cpl_taux2D(nbp_lon,jj_nb,2), stat=error)
828	sum_error = sum_error + error
829	ALLOCATE(cpl_tauy2D(nbp_lon,jj_nb,2), stat=error)
830	sum_error = sum_error + error
831	ALLOCATE(cpl_windsp2D(nbp_lon,jj_nb), stat=error)
832	sum_error = sum_error + error
833	ALLOCATE(cpl_sens_rain2D(nbp_lon,jj_nb,2), stat=error)
834	sum_error = sum_error + error
835	ALLOCATE(cpl_sens_snow2D(nbp_lon,jj_nb,2), stat=error)
836	sum_error = sum_error + error
837	ALLOCATE(cpl_taumod2D(nbp_lon,jj_nb,2), stat=error)
838	sum_error = sum_error + error
839
840	IF (carbon_cycle_cpl) THEN
841	ALLOCATE(cpl_atm_co22D(nbp_lon,jj_nb), stat=error)
842	sum_error = sum_error + error
843	ENDIF
844
845	if (activate_ocean_skin == 2) then
846	ALLOCATE(cpl_delta_sst_2D(nbp_lon, jj_nb), &
847	cpl_delta_sal_2D(nbp_lon, jj_nb), &
848	cpl_dter_2D(nbp_lon, jj_nb), cpl_dser_2D(nbp_lon, jj_nb), &
849	cpl_dt_ds_2D(nbp_lon, jj_nb), stat = error)
850	sum_error = sum_error + error
851	end if
852
853	IF (sum_error /= 0) THEN
854	abort_message='Pb allocation variables couplees pour l''ecriture'
855	CALL abort_physic(modname,abort_message,1)
856	ENDIF
857	ENDIF
858
859
860	CALL gath2cpl(cpl_sols(:,cpl_index), cpl_sols2D(:,:,cpl_index), &
861	knon, knindex)
862
863	CALL gath2cpl(cpl_nsol(:,cpl_index), cpl_nsol2D(:,:,cpl_index), &
864	knon, knindex)
865
866	CALL gath2cpl(cpl_rain(:,cpl_index), cpl_rain2D(:,:,cpl_index), &
867	knon, knindex)
868
869	CALL gath2cpl(cpl_snow(:,cpl_index), cpl_snow2D(:,:,cpl_index), &
870	knon, knindex)
871
872	CALL gath2cpl(cpl_evap(:,cpl_index), cpl_evap2D(:,:,cpl_index), &
873	knon, knindex)
874
875	! cpl_tsol2D(:,:,:) not used!
876	CALL gath2cpl(cpl_tsol(:,cpl_index), cpl_tsol2D(:,:, cpl_index), &
877	knon, knindex)
878
879	! cpl_fder2D(:,:,1) not used, only cpl_fder(:,:,2)!
880	CALL gath2cpl(cpl_fder(:,cpl_index), cpl_fder2D(:,:,cpl_index), &
881	knon, knindex)
882
883	! cpl_albe2D(:,:,:) not used!
884	CALL gath2cpl(cpl_albe(:,cpl_index), cpl_albe2D(:,:,cpl_index), &
885	knon, knindex)
886
887	CALL gath2cpl(cpl_taux(:,cpl_index), cpl_taux2D(:,:,cpl_index), &
888	knon, knindex)
889
890	CALL gath2cpl(cpl_tauy(:,cpl_index), cpl_tauy2D(:,:,cpl_index), &
891	knon, knindex)
892
893	CALL gath2cpl(cpl_windsp(:,cpl_index), cpl_windsp2D(:,:), &
894	knon, knindex)
895
896	CALL gath2cpl(cpl_sens_rain(:,cpl_index), cpl_sens_rain2D(:,:,cpl_index), &
897	knon, knindex)
898
899	CALL gath2cpl(cpl_sens_snow(:,cpl_index), cpl_sens_snow2D(:,:,cpl_index), &
900	knon, knindex)
901
902	CALL gath2cpl(cpl_taumod(:,cpl_index), cpl_taumod2D(:,:,cpl_index), &
903	knon, knindex)
904
905	IF (carbon_cycle_cpl) &
906	CALL gath2cpl(cpl_atm_co2(:,cpl_index), cpl_atm_co22D(:,:), knon, knindex)
907	if (activate_ocean_skin == 2) then
908	CALL gath2cpl(cpl_delta_sst, cpl_delta_sst_2D, knon, knindex)
909	CALL gath2cpl(cpl_delta_sal, cpl_delta_sal_2D, knon, knindex)
910	CALL gath2cpl(cpl_dter, cpl_dter_2D, knon, knindex)
911	CALL gath2cpl(cpl_dser, cpl_dser_2D, knon, knindex)
912	CALL gath2cpl(cpl_dt_ds, cpl_dt_ds_2D, knon, knindex)
913	end if
914	ENDIF
915
916	END SUBROUTINE cpl_send_ocean_fields
917
918	!
919	!*************************************************************************************
920	!
921
922	SUBROUTINE cpl_send_seaice_fields(itime, dtime, knon, knindex, &
923	pctsrf, lafin, rlon, rlat, &
924	swdown, lwdown, fluxlat, fluxsens, &
925	precip_rain, precip_snow, evap, tsurf, fder, albsol, taux, tauy,&
926	sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
927	!
928	! This subroutine cumulates some fields for each time-step during a coupling
929	! period. At last time-step in a coupling period the fields are transformed to the
930	! grid accepted by the coupler. All fields for all types of surfaces are sent to
931	! the coupler.
932	!
933	USE carbon_cycle_mod, ONLY : carbon_cycle_cpl
934	USE indice_sol_mod
935	USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
936
937	! Input arguments
938	!*************************************************************************************
939	INTEGER, INTENT(IN) :: itime
940	INTEGER, INTENT(IN) :: knon
941	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
942	REAL, INTENT(IN) :: dtime
943	REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat
944	REAL, DIMENSION(klon), INTENT(IN) :: swdown, lwdown
945	REAL, DIMENSION(klon), INTENT(IN) :: fluxlat, fluxsens
946	REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow
947	REAL, DIMENSION(klon), INTENT(IN) :: evap, tsurf, fder
948	REAL, DIMENSION(klon), INTENT(IN) :: albsol, taux, tauy
949	REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
950	REAL, INTENT(IN):: sens_prec_liq(:), sens_prec_sol(:) ! (knon)
951	REAL, DIMENSION(klon), INTENT(IN) :: lat_prec_liq, lat_prec_sol
952	LOGICAL, INTENT(IN) :: lafin
953
954	! Local variables
955	!*************************************************************************************
956	INTEGER :: cpl_index, ig
957	INTEGER :: error, sum_error
958	CHARACTER(len = 25) :: modname = 'cpl_send_seaice_fields'
959	CHARACTER(len = 80) :: abort_message
960	REAL, DIMENSION(klon) :: cpl_fder_tmp
961
962	!*************************************************************************************
963	! Start calulation
964	! The sea-ice points are saved with second array index=2
965	!
966	!*************************************************************************************
967	cpl_index = 2
968
969	!*************************************************************************************
970	! Reset fields to zero in the beginning of a new coupling period
971	!
972	!*************************************************************************************
973	IF (MOD(itime, nexca) == 1) THEN
974	cpl_sols(1:knon,cpl_index) = 0.0
975	cpl_nsol(1:knon,cpl_index) = 0.0
976	cpl_rain(1:knon,cpl_index) = 0.0
977	cpl_snow(1:knon,cpl_index) = 0.0
978	cpl_evap(1:knon,cpl_index) = 0.0
979	cpl_tsol(1:knon,cpl_index) = 0.0
980	cpl_fder(1:knon,cpl_index) = 0.0
981	cpl_albe(1:knon,cpl_index) = 0.0
982	cpl_taux(1:knon,cpl_index) = 0.0
983	cpl_tauy(1:knon,cpl_index) = 0.0
984	cpl_sens_rain(1:knon,cpl_index) = 0.0
985	cpl_sens_snow(1:knon,cpl_index) = 0.0
986	cpl_taumod(1:knon,cpl_index) = 0.0
987	ENDIF
988
989	!*************************************************************************************
990	! Cumulate at each time-step
991	!
992	!*************************************************************************************
993	DO ig = 1, knon
994	cpl_sols(ig,cpl_index) = cpl_sols(ig,cpl_index) + &
995	swdown(ig) / REAL(nexca)
996	cpl_nsol(ig,cpl_index) = cpl_nsol(ig,cpl_index) + &
997	(lwdown(ig) + fluxlat(ig) +fluxsens(ig)) / REAL(nexca)
998	cpl_rain(ig,cpl_index) = cpl_rain(ig,cpl_index) + &
999	precip_rain(ig) / REAL(nexca)
1000	cpl_snow(ig,cpl_index) = cpl_snow(ig,cpl_index) + &
1001	precip_snow(ig) / REAL(nexca)
1002	cpl_evap(ig,cpl_index) = cpl_evap(ig,cpl_index) + &
1003	evap(ig) / REAL(nexca)
1004	cpl_tsol(ig,cpl_index) = cpl_tsol(ig,cpl_index) + &
1005	tsurf(ig) / REAL(nexca)
1006	cpl_fder(ig,cpl_index) = cpl_fder(ig,cpl_index) + &
1007	fder(ig) / REAL(nexca)
1008	cpl_albe(ig,cpl_index) = cpl_albe(ig,cpl_index) + &
1009	albsol(ig) / REAL(nexca)
1010	cpl_taux(ig,cpl_index) = cpl_taux(ig,cpl_index) + &
1011	taux(ig) / REAL(nexca)
1012	cpl_tauy(ig,cpl_index) = cpl_tauy(ig,cpl_index) + &
1013	tauy(ig) / REAL(nexca)
1014	cpl_sens_rain(ig,cpl_index) = cpl_sens_rain(ig,cpl_index) + &
1015	sens_prec_liq(ig) / REAL(nexca)
1016	cpl_sens_snow(ig,cpl_index) = cpl_sens_snow(ig,cpl_index) + &
1017	sens_prec_sol(ig) / REAL(nexca)
1018	cpl_taumod(ig,cpl_index) = cpl_taumod(ig,cpl_index) + &
1019	SQRT ( taux(ig)taux(ig)+tauy(ig)tauy(ig) ) / REAL(nexca)
1020	ENDDO
1021
1022	!*************************************************************************************
1023	! If the time-step corresponds to the end of coupling period the
1024	! fields are transformed to the 2D grid and all fields are sent to coupler.
1025	!
1026	!*************************************************************************************
1027	IF (MOD(itime, nexca) == 0) THEN
1028	IF (.NOT. ALLOCATED(cpl_sols2D)) THEN
1029	sum_error = 0
1030	ALLOCATE(cpl_sols2D(nbp_lon,jj_nb,2), stat=error)
1031	sum_error = sum_error + error
1032	ALLOCATE(cpl_nsol2D(nbp_lon,jj_nb,2), stat=error)
1033	sum_error = sum_error + error
1034	ALLOCATE(cpl_rain2D(nbp_lon,jj_nb,2), stat=error)
1035	sum_error = sum_error + error
1036	ALLOCATE(cpl_snow2D(nbp_lon,jj_nb,2), stat=error)
1037	sum_error = sum_error + error
1038	ALLOCATE(cpl_evap2D(nbp_lon,jj_nb,2), stat=error)
1039	sum_error = sum_error + error
1040	ALLOCATE(cpl_tsol2D(nbp_lon,jj_nb,2), stat=error)
1041	sum_error = sum_error + error
1042	ALLOCATE(cpl_fder2D(nbp_lon,jj_nb,2), stat=error)
1043	sum_error = sum_error + error
1044	ALLOCATE(cpl_albe2D(nbp_lon,jj_nb,2), stat=error)
1045	sum_error = sum_error + error
1046	ALLOCATE(cpl_taux2D(nbp_lon,jj_nb,2), stat=error)
1047	sum_error = sum_error + error
1048	ALLOCATE(cpl_tauy2D(nbp_lon,jj_nb,2), stat=error)
1049	sum_error = sum_error + error
1050	ALLOCATE(cpl_windsp2D(nbp_lon,jj_nb), stat=error)
1051	sum_error = sum_error + error
1052	ALLOCATE(cpl_sens_rain2D(nbp_lon,jj_nb,2), stat=error)
1053	sum_error = sum_error + error
1054	ALLOCATE(cpl_sens_snow2D(nbp_lon,jj_nb,2), stat=error)
1055	sum_error = sum_error + error
1056	ALLOCATE(cpl_taumod2D(nbp_lon,jj_nb,2), stat=error)
1057	sum_error = sum_error + error
1058
1059	IF (carbon_cycle_cpl) THEN
1060	ALLOCATE(cpl_atm_co22D(nbp_lon,jj_nb), stat=error)
1061	sum_error = sum_error + error
1062	ENDIF
1063
1064	IF (sum_error /= 0) THEN
1065	abort_message='Pb allocation variables couplees pour l''ecriture'
1066	CALL abort_physic(modname,abort_message,1)
1067	ENDIF
1068	ENDIF
1069
1070	CALL gath2cpl(cpl_sols(:,cpl_index), cpl_sols2D(:,:,cpl_index), &
1071	knon, knindex)
1072
1073	CALL gath2cpl(cpl_nsol(:,cpl_index), cpl_nsol2D(:,:,cpl_index), &
1074	knon, knindex)
1075
1076	CALL gath2cpl(cpl_rain(:,cpl_index), cpl_rain2D(:,:,cpl_index), &
1077	knon, knindex)
1078
1079	CALL gath2cpl(cpl_snow(:,cpl_index), cpl_snow2D(:,:,cpl_index), &
1080	knon, knindex)
1081
1082	CALL gath2cpl(cpl_evap(:,cpl_index), cpl_evap2D(:,:,cpl_index), &
1083	knon, knindex)
1084
1085	! cpl_tsol2D(:,:,:) not used!
1086	CALL gath2cpl(cpl_tsol(:,cpl_index), cpl_tsol2D(:,:, cpl_index), &
1087	knon, knindex)
1088
1089	! Set default value and decompress before gath2cpl
1090	cpl_fder_tmp(:) = -20.
1091	DO ig = 1, knon
1092	cpl_fder_tmp(knindex(ig))=cpl_fder(ig,cpl_index)
1093	ENDDO
1094	CALL gath2cpl(cpl_fder_tmp(:), cpl_fder2D(:,:,cpl_index), &
1095	klon, unity)
1096
1097	! cpl_albe2D(:,:,:) not used!
1098	CALL gath2cpl(cpl_albe(:,cpl_index), cpl_albe2D(:,:,cpl_index), &
1099	knon, knindex)
1100
1101	CALL gath2cpl(cpl_taux(:,cpl_index), cpl_taux2D(:,:,cpl_index), &
1102	knon, knindex)
1103
1104	CALL gath2cpl(cpl_tauy(:,cpl_index), cpl_tauy2D(:,:,cpl_index), &
1105	knon, knindex)
1106
1107	CALL gath2cpl(cpl_sens_rain(:,cpl_index), cpl_sens_rain2D(:,:,cpl_index), &
1108	knon, knindex)
1109
1110	CALL gath2cpl(cpl_sens_snow(:,cpl_index), cpl_sens_snow2D(:,:,cpl_index), &
1111	knon, knindex)
1112
1113	CALL gath2cpl(cpl_taumod(:,cpl_index), cpl_taumod2D(:,:,cpl_index), &
1114	knon, knindex)
1115
1116	! Send all fields
1117	CALL cpl_send_all(itime, dtime, pctsrf, lafin, rlon, rlat)
1118	ENDIF
1119
1120	END SUBROUTINE cpl_send_seaice_fields
1121
1122	!
1123	!*************************************************************************************
1124	!
1125
1126	SUBROUTINE cpl_send_land_fields(itime, knon, knindex, rriv_in, rcoa_in)
1127	!
1128	! This subroutine cumulates some fields for each time-step during a coupling
1129	! period. At last time-step in a coupling period the fields are transformed to the
1130	! grid accepted by the coupler. No sending to the coupler will be done from here
1131	! (it is done in cpl_send_seaice_fields).
1132	!
1133	USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
1134
1135	! Input arguments
1136	!*************************************************************************************
1137	INTEGER, INTENT(IN) :: itime
1138	INTEGER, INTENT(IN) :: knon
1139	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
1140	REAL, DIMENSION(klon), INTENT(IN) :: rriv_in
1141	REAL, DIMENSION(klon), INTENT(IN) :: rcoa_in
1142
1143	! Local variables
1144	!*************************************************************************************
1145	REAL, DIMENSION(nbp_lon,jj_nb) :: rriv2D
1146	REAL, DIMENSION(nbp_lon,jj_nb) :: rcoa2D
1147
1148	!*************************************************************************************
1149	! Rearrange fields in 2D variables
1150	! First initialize to zero to avoid unvalid points causing problems
1151	!
1152	!*************************************************************************************
1153	!$OMP MASTER
1154	rriv2D(:,:) = 0.0
1155	rcoa2D(:,:) = 0.0
1156	!$OMP END MASTER
1157	CALL gath2cpl(rriv_in, rriv2D, knon, knindex)
1158	CALL gath2cpl(rcoa_in, rcoa2D, knon, knindex)
1159
1160	!*************************************************************************************
1161	! Reset cumulated fields to zero in the beginning of a new coupling period
1162	!
1163	!*************************************************************************************
1164	IF (MOD(itime, nexca) == 1) THEN
1165	!$OMP MASTER
1166	cpl_rriv2D(:,:) = 0.0
1167	cpl_rcoa2D(:,:) = 0.0
1168	!$OMP END MASTER
1169	ENDIF
1170
1171	!*************************************************************************************
1172	! Cumulate : Following fields should be cumulated at each time-step
1173	!
1174	!*************************************************************************************
1175	!$OMP MASTER
1176	cpl_rriv2D(:,:) = cpl_rriv2D(:,:) + rriv2D(:,:) / REAL(nexca)
1177	cpl_rcoa2D(:,:) = cpl_rcoa2D(:,:) + rcoa2D(:,:) / REAL(nexca)
1178	!$OMP END MASTER
1179
1180	END SUBROUTINE cpl_send_land_fields
1181
1182	!
1183	!*************************************************************************************
1184	!
1185
1186	SUBROUTINE cpl_send_landice_fields(itime, knon, knindex, rlic_in, rlic_in_frac)
1187	! This subroutine cumulates the field for melting ice for each time-step
1188	! during a coupling period. This routine will not send to coupler. Sending
1189	! will be done in cpl_send_seaice_fields.
1190	!
1191
1192	USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
1193
1194	! Input varibales
1195	!*************************************************************************************
1196	INTEGER, INTENT(IN) :: itime
1197	INTEGER, INTENT(IN) :: knon
1198	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
1199	REAL, DIMENSION(klon), INTENT(IN) :: rlic_in
1200	REAL, DIMENSION(klon), INTENT(IN) :: rlic_in_frac ! Fraction for continental ice, can be equal to
1201	! pctsrf(:,is_lic) or not, depending on landice_opt
1202
1203
1204	! Local varibales
1205	!*************************************************************************************
1206	REAL, DIMENSION(nbp_lon,jj_nb) :: rlic2D
1207
1208	!*************************************************************************************
1209	! Rearrange field in a 2D variable
1210	! First initialize to zero to avoid unvalid points causing problems
1211	!
1212	!*************************************************************************************
1213	!$OMP MASTER
1214	rlic2D(:,:) = 0.0
1215	!$OMP END MASTER
1216	CALL gath2cpl(rlic_in, rlic2D, knon, knindex)
1217	CALL gath2cpl(rlic_in_frac(:), rlic_in_frac2D(:,:), knon, knindex)
1218	!*************************************************************************************
1219	! Reset field to zero in the beginning of a new coupling period
1220	!
1221	!*************************************************************************************
1222	IF (MOD(itime, nexca) == 1) THEN
1223	!$OMP MASTER
1224	cpl_rlic2D(:,:) = 0.0
1225	!$OMP END MASTER
1226	ENDIF
1227
1228	!*************************************************************************************
1229	! Cumulate : Melting ice should be cumulated at each time-step
1230	!
1231	!*************************************************************************************
1232	!$OMP MASTER
1233	cpl_rlic2D(:,:) = cpl_rlic2D(:,:) + rlic2D(:,:) / REAL(nexca)
1234	!$OMP END MASTER
1235
1236	END SUBROUTINE cpl_send_landice_fields
1237
1238	!
1239	!*************************************************************************************
1240	!
1241
1242	SUBROUTINE cpl_send_all(itime, dtime, pctsrf, lafin, rlon, rlat)
1243	! This routine will send fields for all different surfaces to the coupler.
1244	! This subroutine should be executed after calculations by the last surface(sea-ice),
1245	! all calculations at the different surfaces have to be done before.
1246	!
1247	USE surface_data
1248	USE carbon_cycle_mod, ONLY : carbon_cycle_cpl
1249	USE indice_sol_mod
1250	USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
1251	USE time_phylmdz_mod, ONLY: start_time, itau_phy
1252	USE config_ocean_skin_m, only: activate_ocean_skin
1253	USE lmdz_mpi
1254
1255	! Some includes
1256	!
1257	! Input arguments
1258	!*************************************************************************************
1259	INTEGER, INTENT(IN) :: itime
1260	REAL, INTENT(IN) :: dtime
1261	REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat
1262	REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
1263	LOGICAL, INTENT(IN) :: lafin
1264
1265	! Local variables
1266	!*************************************************************************************
1267	INTEGER :: error, sum_error, i,j,k
1268	INTEGER :: itau_w
1269	INTEGER :: time_sec
1270	INTEGER, DIMENSION(nbp_lon*(nbp_lat)) :: ndexct
1271	REAL :: Up, Down
1272	REAL, DIMENSION(nbp_lon, jj_nb) :: tmp_lon, tmp_lat
1273	REAL, DIMENSION(nbp_lon, jj_nb, 4) :: pctsrf2D
1274	REAL, DIMENSION(nbp_lon, jj_nb) :: deno
1275	CHARACTER(len = 20) :: modname = 'cpl_send_all'
1276	CHARACTER(len = 80) :: abort_message
1277
1278	! Variables with fields to coupler
1279	REAL, DIMENSION(nbp_lon, jj_nb) :: tmp_taux
1280	REAL, DIMENSION(nbp_lon, jj_nb) :: tmp_tauy
1281	REAL, DIMENSION(nbp_lon, jj_nb) :: tmp_calv
1282	! Table with all fields to send to coupler
1283	REAL, DIMENSION(nbp_lon, jj_nb, maxsend) :: tab_flds
1284	REAL, DIMENSION(klon_mpi) :: rlon_mpi, rlat_mpi
1285	REAL :: calving(nb_zone_calving)
1286	REAL :: calving_glo(nb_zone_calving)
1287
1288	INTEGER, DIMENSION(MPI_STATUS_SIZE) :: status
1289
1290	! End definitions
1291	!*************************************************************************************
1292
1293
1294
1295	!*************************************************************************************
1296	! All fields are stored in a table tab_flds(:,:,:)
1297	! First store the fields which are already on the right format
1298	!
1299	!*************************************************************************************
1300	!$OMP MASTER
1301	tab_flds(:,:,ids_windsp) = cpl_windsp2D(:,:)
1302	tab_flds(:,:,ids_shfice) = cpl_sols2D(:,:,2)
1303	tab_flds(:,:,ids_nsfice) = cpl_nsol2D(:,:,2)
1304	tab_flds(:,:,ids_dflxdt) = cpl_fder2D(:,:,2)
1305	tab_flds(:,:,ids_qraioc) = cpl_sens_rain2D(:,:,1)
1306	tab_flds(:,:,ids_qsnooc) = cpl_sens_snow2D(:,:,1)
1307	tab_flds(:,:,ids_qraiic) = cpl_sens_rain2D(:,:,2)
1308	tab_flds(:,:,ids_qsnoic) = cpl_sens_snow2D(:,:,2)
1309
1310	if (activate_ocean_skin == 2) then
1311	tab_flds(:, :, ids_delta_sst) = cpl_delta_sst_2D
1312	tab_flds(:, :, ids_delta_sal) = cpl_delta_sal_2D
1313	tab_flds(:, :, ids_dter) = cpl_dter_2D
1314	tab_flds(:, :, ids_dser) = cpl_dser_2D
1315	tab_flds(:, :, ids_dt_ds) = cpl_dt_ds_2D
1316	end if
1317
1318	IF (version_ocean=='nemo') THEN
1319	tab_flds(:,:,ids_liqrun) = (cpl_rriv2D(:,:) + cpl_rcoa2D(:,:))
1320	IF (carbon_cycle_cpl) tab_flds(:,:,ids_atmco2)=cpl_atm_co22D(:,:)
1321	ELSE IF (version_ocean=='opa8') THEN
1322	tab_flds(:,:,ids_shfoce) = cpl_sols2D(:,:,1)
1323	tab_flds(:,:,ids_nsfoce) = cpl_nsol2D(:,:,1)
1324	tab_flds(:,:,ids_icevap) = cpl_evap2D(:,:,2)
1325	tab_flds(:,:,ids_ocevap) = cpl_evap2D(:,:,1)
1326	tab_flds(:,:,ids_runcoa) = cpl_rcoa2D(:,:)
1327	tab_flds(:,:,ids_rivflu) = cpl_rriv2D(:,:)
1328	ENDIF
1329
1330	!*************************************************************************************
1331	! Transform the fraction of sub-surfaces from 1D to 2D array
1332	!
1333	!*************************************************************************************
1334	pctsrf2D(:,:,:) = 0.
1335	!$OMP END MASTER
1336	CALL gath2cpl(pctsrf(:,is_oce), pctsrf2D(:,:,is_oce), klon, unity)
1337	CALL gath2cpl(pctsrf(:,is_sic), pctsrf2D(:,:,is_sic), klon, unity)
1338
1339
1340
1341
1342	!*************************************************************************************
1343	! Calculate the average calving per latitude
1344	! Store calving in tab_flds(:,:,19)
1345	!
1346	!*************************************************************************************
1347	IF (is_omp_root) THEN
1348
1349	IF (cpl_old_calving) THEN ! use old calving
1350
1351	DO j = 1, jj_nb
1352	tmp_calv(:,j) = DOT_PRODUCT (cpl_rlic2D(1:nbp_lon,j), &
1353	rlic_in_frac2D(1:nbp_lon,j)) / REAL(nbp_lon)
1354	ENDDO
1355
1356
1357	IF (is_parallel) THEN
1358	IF (.NOT. is_north_pole_dyn) THEN
1359	CALL MPI_RECV(Up,1,MPI_REAL_LMDZ,mpi_rank-1,1234,COMM_LMDZ_PHY,status,error)
1360	CALL MPI_SEND(tmp_calv(1,1),1,MPI_REAL_LMDZ,mpi_rank-1,1234,COMM_LMDZ_PHY,error)
1361	ENDIF
1362
1363	IF (.NOT. is_south_pole_dyn) THEN
1364	CALL MPI_SEND(tmp_calv(1,jj_nb),1,MPI_REAL_LMDZ,mpi_rank+1,1234,COMM_LMDZ_PHY,error)
1365	CALL MPI_RECV(down,1,MPI_REAL_LMDZ,mpi_rank+1,1234,COMM_LMDZ_PHY,status,error)
1366	ENDIF
1367
1368	IF (.NOT. is_north_pole_dyn .AND. ii_begin /=1) THEN
1369	Up=Up+tmp_calv(nbp_lon,1)
1370	tmp_calv(:,1)=Up
1371	ENDIF
1372
1373	IF (.NOT. is_south_pole_dyn .AND. ii_end /= nbp_lon) THEN
1374	Down=Down+tmp_calv(1,jj_nb)
1375	tmp_calv(:,jj_nb)=Down
1376	ENDIF
1377	ENDIF
1378	tab_flds(:,:,ids_calvin) = tmp_calv(:,:)
1379
1380	ELSE
1381	! cpl_old_calving=FALSE
1382	! To be used with new method for calculation of coupling weights
1383	DO k=1,nb_zone_calving
1384	calving(k)=0
1385	DO j = 1, jj_nb
1386	calving(k)= calving(k)+DOT_PRODUCT(cpl_rlic2D(:,j)*area_calving(:,j,k),rlic_in_frac2D(:,j))
1387	ENDDO
1388	ENDDO
1389
1390	CALL MPI_ALLREDUCE(calving, calving_glo, nb_zone_calving, MPI_REAL_LMDZ, MPI_SUM, COMM_LMDZ_PHY, error)
1391
1392	tab_flds(:,:,ids_calvin) = 0
1393	DO k=1,nb_zone_calving
1394	IF (ind_calving(k)>0 ) THEN
1395	j=(ind_calving(k)-1)/nbp_lon + 1
1396	i=MOD(ind_calving(k)-1,nbp_lon)+1
1397	tab_flds(i,j,ids_calvin) = calving_glo(k)
1398	ENDIF
1399	ENDDO
1400
1401	ENDIF
1402
1403	!*************************************************************************************
1404	! Calculate total flux for snow, rain and wind with weighted addition using the
1405	! fractions of ocean and seaice.
1406	!
1407	!*************************************************************************************
1408	! fraction oce+seaice
1409	deno = pctsrf2D(:,:,is_oce) + pctsrf2D(:,:,is_sic)
1410
1411	IF (version_ocean=='nemo') THEN
1412	tab_flds(:,:,ids_shftot) = 0.0
1413	tab_flds(:,:,ids_nsftot) = 0.0
1414	tab_flds(:,:,ids_totrai) = 0.0
1415	tab_flds(:,:,ids_totsno) = 0.0
1416	tab_flds(:,:,ids_toteva) = 0.0
1417	tab_flds(:,:,ids_taumod) = 0.0
1418
1419	tmp_taux(:,:) = 0.0
1420	tmp_tauy(:,:) = 0.0
1421	! For all valid grid cells containing some fraction of ocean or sea-ice
1422	WHERE ( deno(:,:) /= 0 )
1423	tmp_taux = cpl_taux2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + &
1424	cpl_taux2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
1425	tmp_tauy = cpl_tauy2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + &
1426	cpl_tauy2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
1427
1428	tab_flds(:,:,ids_shftot) = cpl_sols2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + &
1429	cpl_sols2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
1430	tab_flds(:,:,ids_nsftot) = cpl_nsol2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + &
1431	cpl_nsol2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
1432	tab_flds(:,:,ids_totrai) = cpl_rain2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + &
1433	cpl_rain2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
1434	tab_flds(:,:,ids_totsno) = cpl_snow2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + &
1435	cpl_snow2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
1436	tab_flds(:,:,ids_toteva) = cpl_evap2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + &
1437	cpl_evap2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
1438	tab_flds(:,:,ids_taumod) = cpl_taumod2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + &
1439	cpl_taumod2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
1440
1441	ENDWHERE
1442
1443	tab_flds(:,:,ids_icevap) = cpl_evap2D(:,:,2)
1444
1445	ELSE IF (version_ocean=='opa8') THEN
1446	! Store fields for rain and snow in tab_flds(:,:,15) and tab_flds(:,:,16)
1447	tab_flds(:,:,ids_totrai) = 0.0
1448	tab_flds(:,:,ids_totsno) = 0.0
1449	tmp_taux(:,:) = 0.0
1450	tmp_tauy(:,:) = 0.0
1451	! For all valid grid cells containing some fraction of ocean or sea-ice
1452	WHERE ( deno(:,:) /= 0 )
1453	tab_flds(:,:,ids_totrai) = cpl_rain2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + &
1454	cpl_rain2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
1455	tab_flds(:,:,ids_totsno) = cpl_snow2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + &
1456	cpl_snow2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
1457
1458	tmp_taux = cpl_taux2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + &
1459	cpl_taux2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
1460	tmp_tauy = cpl_tauy2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + &
1461	cpl_tauy2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
1462	ENDWHERE
1463	ENDIF
1464
1465	ENDIF ! is_omp_root
1466
1467	!*************************************************************************************
1468	! Transform the wind components from local atmospheric 2D coordinates to geocentric
1469	! 3D coordinates.
1470	! Store the resulting wind components in tab_flds(:,:,1:6)
1471	!*************************************************************************************
1472
1473	! Transform the longitudes and latitudes on 2D arrays
1474
1475	CALL gather_omp(rlon,rlon_mpi)
1476	CALL gather_omp(rlat,rlat_mpi)
1477	!$OMP MASTER
1478	CALL Grid1DTo2D_mpi(rlon_mpi,tmp_lon)
1479	CALL Grid1DTo2D_mpi(rlat_mpi,tmp_lat)
1480	!$OMP END MASTER
1481
1482	IF (is_sequential) THEN
1483	IF (is_north_pole_dyn) tmp_lon(:,1) = tmp_lon(:,2)
1484	IF (is_south_pole_dyn) tmp_lon(:,nbp_lat) = tmp_lon(:,nbp_lat-1)
1485	ENDIF
1486
1487	! NetCDF output of the wind before transformation of coordinate system
1488	IF (is_sequential) THEN
1489	ndexct(:) = 0
1490	itau_w = itau_phy + itime + start_time * day_step_phy
1491	CALL histwrite(nidct,'tauxe',itau_w,tmp_taux,nbp_lon*(nbp_lat),ndexct)
1492	CALL histwrite(nidct,'tauyn',itau_w,tmp_tauy,nbp_lon*(nbp_lat),ndexct)
1493	CALL histwrite(nidct,'tmp_lon',itau_w,tmp_lon,nbp_lon*(nbp_lat),ndexct)
1494	CALL histwrite(nidct,'tmp_lat',itau_w,tmp_lat,nbp_lon*(nbp_lat),ndexct)
1495	ENDIF
1496
1497	! Transform the wind from spherical atmospheric 2D coordinates to geocentric
1498	! cartesian 3D coordinates
1499	!$OMP MASTER
1500	CALL atm2geo (nbp_lon, jj_nb, tmp_taux, tmp_tauy, tmp_lon, tmp_lat, &
1501	tab_flds(:,:,ids_tauxxu), tab_flds(:,:,ids_tauyyu), tab_flds(:,:,ids_tauzzu) )
1502
1503	tab_flds(:,:,ids_tauxxv) = tab_flds(:,:,ids_tauxxu)
1504	tab_flds(:,:,ids_tauyyv) = tab_flds(:,:,ids_tauyyu)
1505	tab_flds(:,:,ids_tauzzv) = tab_flds(:,:,ids_tauzzu)
1506	!$OMP END MASTER
1507
1508	!*************************************************************************************
1509	! NetCDF output of all fields just before sending to coupler.
1510	!
1511	!*************************************************************************************
1512	IF (is_sequential) THEN
1513	DO j=1,maxsend
1514	IF (infosend(j)%action) CALL histwrite(nidct,infosend(j)%name, itau_w, &
1515	tab_flds(:,:,j),nbp_lon*(nbp_lat),ndexct)
1516	ENDDO
1517	ENDIF
1518	!*************************************************************************************
1519	! Send the table of all fields
1520	!
1521	!*************************************************************************************
1522	time_sec=(itime-1)*dtime
1523	#ifdef CPP_COUPLE
1524	!$OMP MASTER
1525	CALL intocpl(time_sec, lafin, tab_flds(:,:,:))
1526	!$OMP END MASTER
1527	#endif
1528
1529	!*************************************************************************************
1530	! Finish with some dellocate
1531	!
1532	!*************************************************************************************
1533	sum_error=0
1534	DEALLOCATE(cpl_sols2D, cpl_nsol2D, cpl_rain2D, cpl_snow2D, stat=error )
1535	sum_error = sum_error + error
1536	DEALLOCATE(cpl_evap2D, cpl_tsol2D, cpl_fder2D, cpl_albe2D, stat=error )
1537	sum_error = sum_error + error
1538	DEALLOCATE(cpl_taux2D, cpl_tauy2D, cpl_windsp2D, cpl_taumod2D, stat=error )
1539	sum_error = sum_error + error
1540	DEALLOCATE(cpl_sens_rain2D, cpl_sens_snow2D, stat=error)
1541	sum_error = sum_error + error
1542
1543
1544	IF (carbon_cycle_cpl) THEN
1545	DEALLOCATE(cpl_atm_co22D, stat=error )
1546	sum_error = sum_error + error
1547	ENDIF
1548
1549	if (activate_ocean_skin == 2) deallocate(cpl_delta_sst_2d, &
1550	cpl_delta_sal_2d, cpl_dter_2d, cpl_dser_2d, cpl_dt_ds_2d)
1551
1552	IF (sum_error /= 0) THEN
1553	abort_message='Pb in deallocation of cpl_xxxx2D coupling variables'
1554	CALL abort_physic(modname,abort_message,1)
1555	ENDIF
1556
1557	END SUBROUTINE cpl_send_all
1558	!
1559	!*************************************************************************************
1560	!
1561	SUBROUTINE cpl2gath(champ_in, champ_out, knon, knindex)
1562	USE mod_phys_lmdz_para
1563	! Cette routine transforme un champs de la grille 2D recu du coupleur sur la grille
1564	! 'gathered' (la grille physiq comprime).
1565	!
1566	!
1567	! input:
1568	! champ_in champ sur la grille 2D
1569	! knon nombre de points dans le domaine a traiter
1570	! knindex index des points de la surface a traiter
1571	!
1572	! output:
1573	! champ_out champ sur la grille 'gatherd'
1574	!
1575	USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
1576
1577	! Input
1578	INTEGER, INTENT(IN) :: knon
1579	REAL, DIMENSION(nbp_lon,jj_nb), INTENT(IN) :: champ_in
1580	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
1581
1582	! Output
1583	REAL, DIMENSION(klon_mpi), INTENT(OUT) :: champ_out
1584
1585	! Local
1586	INTEGER :: i, ig
1587	REAL, DIMENSION(klon_mpi) :: temp_mpi
1588	REAL, DIMENSION(klon) :: temp_omp
1589
1590	!*************************************************************************************
1591	!
1592
1593
1594	! Transform from 2 dimensions (nbp_lon,jj_nb) to 1 dimension (klon)
1595	!$OMP MASTER
1596	CALL Grid2Dto1D_mpi(champ_in,temp_mpi)
1597	!$OMP END MASTER
1598
1599	CALL scatter_omp(temp_mpi,temp_omp)
1600
1601	! Compress from klon to knon
1602	DO i = 1, knon
1603	ig = knindex(i)
1604	champ_out(i) = temp_omp(ig)
1605	ENDDO
1606
1607	END SUBROUTINE cpl2gath
1608	!
1609	!*************************************************************************************
1610	!
1611	SUBROUTINE gath2cpl(champ_in, champ_out, knon, knindex)
1612	USE mod_phys_lmdz_para
1613	! Cette routine ecrit un champ 'gathered' sur la grille 2D pour le passer
1614	! au coupleur.
1615	!
1616	! input:
1617	! champ_in champ sur la grille gathere
1618	! knon nombre de points dans le domaine a traiter
1619	! knindex index des points de la surface a traiter
1620	!
1621	! output:
1622	! champ_out champ sur la grille 2D
1623	!
1624	USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
1625
1626	! Input arguments
1627	!*************************************************************************************
1628	INTEGER, INTENT(IN) :: knon
1629	REAL, DIMENSION(klon), INTENT(IN) :: champ_in
1630	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
1631
1632	! Output arguments
1633	!*************************************************************************************
1634	REAL, DIMENSION(nbp_lon,jj_nb), INTENT(OUT) :: champ_out
1635
1636	! Local variables
1637	!*************************************************************************************
1638	INTEGER :: i, ig
1639	REAL, DIMENSION(klon) :: temp_omp
1640	REAL, DIMENSION(klon_mpi) :: temp_mpi
1641	!*************************************************************************************
1642
1643	! Decompress from knon to klon
1644	temp_omp = 0.
1645	DO i = 1, knon
1646	ig = knindex(i)
1647	temp_omp(ig) = champ_in(i)
1648	ENDDO
1649
1650	! Transform from 1 dimension (klon) to 2 dimensions (nbp_lon,jj_nb)
1651	CALL gather_omp(temp_omp,temp_mpi)
1652
1653	!$OMP MASTER
1654	CALL Grid1Dto2D_mpi(temp_mpi,champ_out)
1655
1656	IF (is_north_pole_dyn) champ_out(:,1)=temp_mpi(1)
1657	IF (is_south_pole_dyn) champ_out(:,jj_nb)=temp_mpi(klon)
1658	!$OMP END MASTER
1659
1660	END SUBROUTINE gath2cpl
1661	!
1662	!*************************************************************************************
1663	!
1664	END MODULE cpl_mod
1665

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

Download in other formats:

Original Format