Context Navigation

cpl_mod.F90 @ 4058

Last change on this file since 4058 was 3790, checked in by oboucher, 4 years ago
correct cell_area2D in the case of a rectangulat lat-lon grid for singularity at south and north poles without this correction the calving flux sent to the coupler is not correct
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.6 KB

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

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

Download in other formats:

Original Format