Context Navigation

cpl_mod.F90 @ 4380

Last change on this file since 4380 was 3907, checked in by Sebastien Nguyen, 3 years ago
added #ifdef CPP_MPI for sequential compilation
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:executable set to ``* Property svn:keywords set to `Author Date Id Revision`
File size: 59.7 KB

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

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

Download in other formats:

Original Format