Context Navigation

cpl_mod.F90 @ 1152

Last change on this file since 1152 was 1152, checked in by jghattas, 15 years ago
Amelioration dans l'interface de couplage pour faciliter des champs de couplages optionels. Ajout de couplage de flux co2 : uniquement dans l'interface de couplage, pas encore de transport.
Property svn:eol-style set to `native` Property svn:executable set to ``* Property svn:keywords set to `Author Date Id Revision`
File size: 53.1 KB

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

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

Download in other formats:

Original Format