Context Navigation

cpl_mod.F90 @ 3605

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

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

Download in other formats:

Original Format