Context Navigation

cpl_mod.F90 @ 3819

Last change on this file since 3819 was 3819, checked in by ymipsl, 10 years ago

Removed all iim et jjm depedency. Replaced by nbp_lon and nbp_lat.
Supress gr_fi_ecrit, replaced by grid1dTo2d_glo

Property svn:executable set to *

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

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

Download in other formats:

Original Format