Context Navigation

cpl_mod.F90 @ 5119

Last change on this file since 5119 was 5117, checked in by abarral, 4 months ago
rename modules properly lmdz_* move some unused files to obsolete/ (lint) uppercase fortran keywords
Property copyright set to Name of program: LMDZ Creation date: 1984 Version: LMDZ5 License: CeCILL version 2 Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539 See the license file in the root directory Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 67.1 KB

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

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

Download in other formats:

Original Format