Context Navigation

cpl_mod.F90 @ 1715

Last change on this file since 1715 was 1577, checked in by Laurent Fairhead, 13 years ago

Modifications au code qui permettent de commencer une simulation à n'importe
quelle heure de la journée. On fait toujours un nombre entier de jours de
simulation.
On spécifie cette heure de départ dans la variable starttime du run.def (la
valeur est en jour et elle est à zéro par défaut).
La valeur est sauvegardée dans le fichier restart.nc. Les valeurs lues dans
le fichier start et le run.def sont comparées en début de simulation. La
simulation s'arrête si elles ne sont pas égales sauf si une remise à zéro de
la date a été demandée.
Par ailleurs, la fréquence de lecture des conditions aux limites a été modifiée
pour qu'à chaque changement de jour, celles-ci soient mises à jour (jusqu'à
maintenant elles étaient mises à jour à une fréquence donnée qui, en cas de
départ de simulation à une heure différente de minuit, ne correspondait pas
forcèment à un changement dans la date).
Validation effectuée en traçant le flux solaire descendant au sommet de
l'atmosphère à différentes heures de la journée, après un redémarrage, en
s'assurant que le maximum est bien là où il est sensé être.

Modifications to the code to enable it to be started at any time of the day.
The code still runs for an integer number of days.
The start time is specified using variable starttime in the run.def file (the
value is in days and is zero by default).
The start time is saved in the restart.nc file at the end of the simulation.
The values read in from the start.nc file and the run.def file are compared
at the start of the simulation. If they differ, the simulation is aborted
unless the raz_date variable has been set.
Furthermore, the frequency at which boundary conditions are read in has been
modified so that they are updated everyday at midnight (until now, they were
updated at a certain frequency that, in case of a simulation starting at a time
other than midnight, did not ensure that those conditions would be updated each
day at midnight)
The modifications were validated by plotting the downward solaf flux at TOA at
different times of the day (and after having restarted the simulation) and
ensuring that the maximum of flux was at the right place according to local
time.

Property svn:eol-style set to native
Property svn:executable set to *
Property svn:keywords set to Author Date Id Revision

File size: 55.3 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_mod
27
28
29	! Global attributes
30	!*************************************************************************************
31	IMPLICIT NONE
32	PRIVATE
33
34	! All subroutine are public except cpl_send_all
35	PUBLIC :: cpl_init, cpl_receive_frac, cpl_receive_ocean_fields, cpl_receive_seaice_fields, &
36	cpl_send_ocean_fields, cpl_send_seaice_fields, cpl_send_land_fields, &
37	cpl_send_landice_fields, gath2cpl
38
39
40	! Declaration of module variables
41	!*************************************************************************************
42	! variable for coupling period
43	INTEGER, SAVE :: nexca
44	!$OMP THREADPRIVATE(nexca)
45
46	! variables for cumulating fields during a coupling periode :
47	REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_sols, cpl_nsol, cpl_rain
48	!$OMP THREADPRIVATE(cpl_sols,cpl_nsol,cpl_rain)
49	REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_snow, cpl_evap, cpl_tsol
50	!$OMP THREADPRIVATE(cpl_snow,cpl_evap,cpl_tsol)
51	REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_fder, cpl_albe, cpl_taux, cpl_tauy
52	!$OMP THREADPRIVATE(cpl_fder,cpl_albe,cpl_taux,cpl_tauy)
53	REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_windsp
54	!$OMP THREADPRIVATE(cpl_windsp)
55	REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_taumod
56	!$OMP THREADPRIVATE(cpl_taumod)
57	REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_atm_co2
58	!$OMP THREADPRIVATE(cpl_atm_co2)
59	REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_rriv2D, cpl_rcoa2D, cpl_rlic2D
60	!$OMP THREADPRIVATE(cpl_rriv2D,cpl_rcoa2D,cpl_rlic2D)
61
62	! variables read from coupler :
63	REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: read_sst ! sea surface temperature
64	!$OMP THREADPRIVATE(read_sst)
65	REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: read_sit ! sea ice temperature
66	!$OMP THREADPRIVATE(read_sit)
67	REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: read_sic ! sea ice fraction
68	!$OMP THREADPRIVATE(read_sic)
69	REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: read_alb_sic ! albedo at sea ice
70	!$OMP THREADPRIVATE(read_alb_sic)
71	REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: read_u0, read_v0 ! ocean surface current
72	!$OMP THREADPRIVATE(read_u0,read_v0)
73	REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: read_co2 ! ocean co2 flux
74	!$OMP THREADPRIVATE(read_co2)
75	INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: unity
76	!$OMP THREADPRIVATE(unity)
77	INTEGER, SAVE :: nidct, nidcs
78	!$OMP THREADPRIVATE(nidct,nidcs)
79
80	! variables to be sent to the coupler
81	REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cpl_sols2D, cpl_nsol2D, cpl_rain2D
82	!$OMP THREADPRIVATE(cpl_sols2D, cpl_nsol2D, cpl_rain2D)
83	REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cpl_snow2D, cpl_evap2D, cpl_tsol2D
84	!$OMP THREADPRIVATE(cpl_snow2D, cpl_evap2D, cpl_tsol2D)
85	REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cpl_fder2D, cpl_albe2D
86	!$OMP THREADPRIVATE(cpl_fder2D, cpl_albe2D)
87	REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cpl_taux2D, cpl_tauy2D
88	!$OMP THREADPRIVATE(cpl_taux2D, cpl_tauy2D)
89	REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cpl_taumod2D
90	!$OMP THREADPRIVATE(cpl_taumod2D)
91	REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_windsp2D
92	!$OMP THREADPRIVATE(cpl_windsp2D)
93	REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_atm_co22D
94	!$OMP THREADPRIVATE(cpl_atm_co22D)
95
96	CONTAINS
97	!
98	!************************************************************************************
99	!
100	SUBROUTINE cpl_init(dtime, rlon, rlat)
101	USE carbon_cycle_mod, ONLY : carbon_cycle_cpl, fco2_ocn_day
102	USE surface_data
103
104	INCLUDE "dimensions.h"
105	INCLUDE "indicesol.h"
106	INCLUDE "temps.h"
107	INCLUDE "iniprint.h"
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(iim,jjm+1) :: 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	WRITE(lunout,*)' ##### Ocean couple #####'
136	WRITE(lunout,*)' Valeurs des pas de temps'
137	WRITE(lunout,*)' npas = ', npas
138	WRITE(lunout,*)' nexca = ', nexca
139
140	!*************************************************************************************
141	! Allocate variables
142	!
143	!*************************************************************************************
144	error = 0
145	sum_error = 0
146
147	ALLOCATE(unity(klon), stat = error)
148	sum_error = sum_error + error
149	ALLOCATE(cpl_sols(klon,2), stat = error)
150	sum_error = sum_error + error
151	ALLOCATE(cpl_nsol(klon,2), stat = error)
152	sum_error = sum_error + error
153	ALLOCATE(cpl_rain(klon,2), stat = error)
154	sum_error = sum_error + error
155	ALLOCATE(cpl_snow(klon,2), stat = error)
156	sum_error = sum_error + error
157	ALLOCATE(cpl_evap(klon,2), stat = error)
158	sum_error = sum_error + error
159	ALLOCATE(cpl_tsol(klon,2), stat = error)
160	sum_error = sum_error + error
161	ALLOCATE(cpl_fder(klon,2), stat = error)
162	sum_error = sum_error + error
163	ALLOCATE(cpl_albe(klon,2), stat = error)
164	sum_error = sum_error + error
165	ALLOCATE(cpl_taux(klon,2), stat = error)
166	sum_error = sum_error + error
167	ALLOCATE(cpl_tauy(klon,2), stat = error)
168	sum_error = sum_error + error
169	ALLOCATE(cpl_windsp(klon,2), stat = error)
170	sum_error = sum_error + error
171	ALLOCATE(cpl_taumod(klon,2), stat = error)
172	sum_error = sum_error + error
173	ALLOCATE(cpl_rriv2D(iim,jj_nb), stat=error)
174	sum_error = sum_error + error
175	ALLOCATE(cpl_rcoa2D(iim,jj_nb), stat=error)
176	sum_error = sum_error + error
177	ALLOCATE(cpl_rlic2D(iim,jj_nb), stat=error)
178	sum_error = sum_error + error
179	ALLOCATE(read_sst(iim, jj_nb), stat = error)
180	sum_error = sum_error + error
181	ALLOCATE(read_sic(iim, jj_nb), stat = error)
182	sum_error = sum_error + error
183	ALLOCATE(read_sit(iim, jj_nb), stat = error)
184	sum_error = sum_error + error
185	ALLOCATE(read_alb_sic(iim, jj_nb), stat = error)
186	sum_error = sum_error + error
187	ALLOCATE(read_u0(iim, jj_nb), stat = error)
188	sum_error = sum_error + error
189	ALLOCATE(read_v0(iim, jj_nb), stat = error)
190	sum_error = sum_error + error
191
192	IF (carbon_cycle_cpl) THEN
193	ALLOCATE(read_co2(iim, jj_nb), stat = error)
194	sum_error = sum_error + error
195	ALLOCATE(cpl_atm_co2(klon,2), stat = error)
196	sum_error = sum_error + error
197
198	! Allocate variable in carbon_cycle_mod
199	ALLOCATE(fco2_ocn_day(klon), stat = error)
200	sum_error = sum_error + error
201	END IF
202
203	IF (sum_error /= 0) THEN
204	abort_message='Pb allocation variables couplees'
205	CALL abort_gcm(modname,abort_message,1)
206	ENDIF
207	!*************************************************************************************
208	! Initialize the allocated varaibles
209	!
210	!*************************************************************************************
211	DO ig = 1, klon
212	unity(ig) = ig
213	ENDDO
214
215	!*************************************************************************************
216	! Initialize coupling
217	!
218	!*************************************************************************************
219	idtime = INT(dtime)
220	#ifdef CPP_COUPLE
221	CALL inicma
222	#endif
223
224	!*************************************************************************************
225	! initialize NetCDF output
226	!
227	!*************************************************************************************
228	IF (is_sequential) THEN
229	idayref = day_ini
230	CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian)
231	CALL gr_fi_ecrit(1,klon,iim,jjm+1,rlon,zx_lon)
232	DO i = 1, iim
233	zx_lon(i,1) = rlon(i+1)
234	zx_lon(i,jjm+1) = rlon(i+1)
235	ENDDO
236	CALL gr_fi_ecrit(1,klon,iim,jjm+1,rlat,zx_lat)
237	clintocplnam="cpl_atm_tauflx"
238	CALL histbeg(clintocplnam, iim,zx_lon(:,1),jjm+1,zx_lat(1,:),&
239	1,iim,1,jjm+1, itau_phy,zjulian,dtime,nhoridct,nidct)
240	! no vertical axis
241	CALL histdef(nidct, 'tauxe','tauxe', &
242	"-",iim, jjm+1, nhoridct, 1, 1, 1, -99, 32, "inst", dtime,dtime)
243	CALL histdef(nidct, 'tauyn','tauyn', &
244	"-",iim, jjm+1, nhoridct, 1, 1, 1, -99, 32, "inst", dtime,dtime)
245	CALL histdef(nidct, 'tmp_lon','tmp_lon', &
246	"-",iim, jjm+1, nhoridct, 1, 1, 1, -99, 32, "inst", dtime,dtime)
247	CALL histdef(nidct, 'tmp_lat','tmp_lat', &
248	"-",iim, jjm+1, nhoridct, 1, 1, 1, -99, 32, "inst", dtime,dtime)
249	DO jf=1,maxsend
250	IF (infosend(i)%action) THEN
251	CALL histdef(nidct, infosend(i)%name ,infosend(i)%name , &
252	"-",iim, jjm+1, nhoridct, 1, 1, 1, -99, 32, "inst", dtime,dtime)
253	ENDIF
254	END DO
255	CALL histend(nidct)
256	CALL histsync(nidct)
257
258	clfromcplnam="cpl_atm_sst"
259	CALL histbeg(clfromcplnam, iim,zx_lon(:,1),jjm+1,zx_lat(1,:),1,iim,1,jjm+1, &
260	0,zjulian,dtime,nhoridcs,nidcs)
261	! no vertical axis
262	DO jf=1,maxrecv
263	IF (inforecv(i)%action) THEN
264	CALL histdef(nidcs,inforecv(i)%name ,inforecv(i)%name , &
265	"-",iim, jjm+1, nhoridcs, 1, 1, 1, -99, 32, "inst", dtime,dtime)
266	ENDIF
267	END DO
268	CALL histend(nidcs)
269	CALL histsync(nidcs)
270
271	ENDIF ! is_sequential
272
273
274	!*************************************************************************************
275	! compatibility test
276	!
277	!*************************************************************************************
278	IF (carbon_cycle_cpl .AND. version_ocean=='opa8') THEN
279	abort_message='carbon_cycle_cpl does not work with opa8'
280	CALL abort_gcm(modname,abort_message,1)
281	END IF
282
283	END SUBROUTINE cpl_init
284
285	!
286	!*************************************************************************************
287	!
288
289	SUBROUTINE cpl_receive_frac(itime, dtime, pctsrf, is_modified)
290	! This subroutine receives from coupler for both ocean and seaice
291	! 4 fields : read_sst, read_sic, read_sit and read_alb_sic.
292	! The new sea-ice-land-landice fraction is returned. The others fields
293	! are stored in this module.
294	USE surface_data
295	USE phys_state_var_mod, ONLY : rlon, rlat
296	USE carbon_cycle_mod, ONLY : carbon_cycle_cpl
297
298	INCLUDE "indicesol.h"
299	INCLUDE "temps.h"
300	INCLUDE "iniprint.h"
301	INCLUDE "YOMCST.h"
302	INCLUDE "dimensions.h"
303
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(iim*(jjm+1)) :: ndexcs
316	CHARACTER(len = 20) :: modname = 'cpl_receive_frac'
317	CHARACTER(len = 80) :: abort_message
318	REAL, DIMENSION(klon) :: read_sic1D
319	REAL, DIMENSION(iim,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(iim, jj_nb) :: tmp_lon, tmp_lat
323	REAL, DIMENSION(iim, 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),iim*(jjm+1),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(iim, 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	INCLUDE "indicesol.h"
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	INCLUDE "indicesol.h"
544	INCLUDE "dimensions.h"
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(iim,jj_nb,2), stat=error)
638	sum_error = sum_error + error
639	ALLOCATE(cpl_nsol2D(iim,jj_nb,2), stat=error)
640	sum_error = sum_error + error
641	ALLOCATE(cpl_rain2D(iim,jj_nb,2), stat=error)
642	sum_error = sum_error + error
643	ALLOCATE(cpl_snow2D(iim,jj_nb,2), stat=error)
644	sum_error = sum_error + error
645	ALLOCATE(cpl_evap2D(iim,jj_nb,2), stat=error)
646	sum_error = sum_error + error
647	ALLOCATE(cpl_tsol2D(iim,jj_nb,2), stat=error)
648	sum_error = sum_error + error
649	ALLOCATE(cpl_fder2D(iim,jj_nb,2), stat=error)
650	sum_error = sum_error + error
651	ALLOCATE(cpl_albe2D(iim,jj_nb,2), stat=error)
652	sum_error = sum_error + error
653	ALLOCATE(cpl_taux2D(iim,jj_nb,2), stat=error)
654	sum_error = sum_error + error
655	ALLOCATE(cpl_tauy2D(iim,jj_nb,2), stat=error)
656	sum_error = sum_error + error
657	ALLOCATE(cpl_windsp2D(iim,jj_nb), stat=error)
658	sum_error = sum_error + error
659	ALLOCATE(cpl_taumod2D(iim,jj_nb,2), stat=error)
660	sum_error = sum_error + error
661
662	IF (carbon_cycle_cpl) THEN
663	ALLOCATE(cpl_atm_co22D(iim,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_gcm(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	INCLUDE "indicesol.h"
735	INCLUDE "dimensions.h"
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(iim,jj_nb,2), stat=error)
823	sum_error = sum_error + error
824	ALLOCATE(cpl_nsol2D(iim,jj_nb,2), stat=error)
825	sum_error = sum_error + error
826	ALLOCATE(cpl_rain2D(iim,jj_nb,2), stat=error)
827	sum_error = sum_error + error
828	ALLOCATE(cpl_snow2D(iim,jj_nb,2), stat=error)
829	sum_error = sum_error + error
830	ALLOCATE(cpl_evap2D(iim,jj_nb,2), stat=error)
831	sum_error = sum_error + error
832	ALLOCATE(cpl_tsol2D(iim,jj_nb,2), stat=error)
833	sum_error = sum_error + error
834	ALLOCATE(cpl_fder2D(iim,jj_nb,2), stat=error)
835	sum_error = sum_error + error
836	ALLOCATE(cpl_albe2D(iim,jj_nb,2), stat=error)
837	sum_error = sum_error + error
838	ALLOCATE(cpl_taux2D(iim,jj_nb,2), stat=error)
839	sum_error = sum_error + error
840	ALLOCATE(cpl_tauy2D(iim,jj_nb,2), stat=error)
841	sum_error = sum_error + error
842	ALLOCATE(cpl_windsp2D(iim,jj_nb), stat=error)
843	sum_error = sum_error + error
844	ALLOCATE(cpl_taumod2D(iim,jj_nb,2), stat=error)
845	sum_error = sum_error + error
846
847	IF (carbon_cycle_cpl) THEN
848	ALLOCATE(cpl_atm_co22D(iim,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_gcm(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	INCLUDE "dimensions.h"
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(iim,jj_nb) :: rriv2D
928	REAL, DIMENSION(iim,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	! This subroutine cumulates the field for melting ice for each time-step
970	! during a coupling period. This routine will not send to coupler. Sending
971	! will be done in cpl_send_seaice_fields.
972	!
973
974	INCLUDE "dimensions.h"
975
976	! Input varibales
977	!*************************************************************************************
978	INTEGER, INTENT(IN) :: itime
979	INTEGER, INTENT(IN) :: knon
980	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
981	REAL, DIMENSION(klon), INTENT(IN) :: rlic_in
982
983	! Local varibales
984	!*************************************************************************************
985	REAL, DIMENSION(iim,jj_nb) :: rlic2D
986
987	!*************************************************************************************
988	! Rearrange field in a 2D variable
989	! First initialize to zero to avoid unvalid points causing problems
990	!
991	!*************************************************************************************
992	!$OMP MASTER
993	rlic2D(:,:) = 0.0
994	!$OMP END MASTER
995	CALL gath2cpl(rlic_in, rlic2D, knon, knindex)
996
997	!*************************************************************************************
998	! Reset field to zero in the beginning of a new coupling period
999	!
1000	!*************************************************************************************
1001	IF (MOD(itime, nexca) == 1) THEN
1002	!$OMP MASTER
1003	cpl_rlic2D(:,:) = 0.0
1004	!$OMP END MASTER
1005	ENDIF
1006
1007	!*************************************************************************************
1008	! Cumulate : Melting ice should be cumulated at each time-step
1009	!
1010	!*************************************************************************************
1011	!$OMP MASTER
1012	cpl_rlic2D(:,:) = cpl_rlic2D(:,:) + rlic2D(:,:) / REAL(nexca)
1013	!$OMP END MASTER
1014
1015	END SUBROUTINE cpl_send_landice_fields
1016
1017	!
1018	!*************************************************************************************
1019	!
1020
1021	SUBROUTINE cpl_send_all(itime, dtime, pctsrf, lafin, rlon, rlat)
1022	! This routine will send fields for all different surfaces to the coupler.
1023	! This subroutine should be executed after calculations by the last surface(sea-ice),
1024	! all calculations at the different surfaces have to be done before.
1025	!
1026	USE surface_data
1027	USE carbon_cycle_mod, ONLY : carbon_cycle_cpl
1028	! Some includes
1029	!*************************************************************************************
1030	INCLUDE "indicesol.h"
1031	INCLUDE "temps.h"
1032	INCLUDE "dimensions.h"
1033
1034	! Input arguments
1035	!*************************************************************************************
1036	INTEGER, INTENT(IN) :: itime
1037	REAL, INTENT(IN) :: dtime
1038	REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat
1039	REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
1040	LOGICAL, INTENT(IN) :: lafin
1041
1042	! Local variables
1043	!*************************************************************************************
1044	INTEGER :: error, sum_error, j
1045	INTEGER :: itau_w
1046	INTEGER :: time_sec
1047	INTEGER, DIMENSION(iim*(jjm+1)) :: ndexct
1048	REAL :: Up, Down
1049	REAL, DIMENSION(iim, jj_nb) :: tmp_lon, tmp_lat
1050	REAL, DIMENSION(iim, jj_nb, 4) :: pctsrf2D
1051	REAL, DIMENSION(iim, jj_nb) :: deno
1052	CHARACTER(len = 20) :: modname = 'cpl_send_all'
1053	CHARACTER(len = 80) :: abort_message
1054
1055	! Variables with fields to coupler
1056	REAL, DIMENSION(iim, jj_nb) :: tmp_taux
1057	REAL, DIMENSION(iim, jj_nb) :: tmp_tauy
1058	REAL, DIMENSION(iim, jj_nb) :: tmp_calv
1059	! Table with all fields to send to coupler
1060	REAL, DIMENSION(iim, jj_nb, maxsend) :: tab_flds
1061	REAL, DIMENSION(klon_mpi) :: rlon_mpi, rlat_mpi
1062
1063	#ifdef CPP_MPI
1064	INCLUDE 'mpif.h'
1065	INTEGER, DIMENSION(MPI_STATUS_SIZE) :: status
1066	#endif
1067
1068	! End definitions
1069	!*************************************************************************************
1070
1071
1072
1073	!*************************************************************************************
1074	! All fields are stored in a table tab_flds(:,:,:)
1075	! First store the fields which are already on the right format
1076	!
1077	!*************************************************************************************
1078	!$OMP MASTER
1079	tab_flds(:,:,ids_windsp) = cpl_windsp2D(:,:)
1080	tab_flds(:,:,ids_shfice) = cpl_sols2D(:,:,2)
1081	tab_flds(:,:,ids_nsfice) = cpl_nsol2D(:,:,2)
1082	tab_flds(:,:,ids_dflxdt) = cpl_fder2D(:,:,2)
1083
1084	IF (version_ocean=='nemo') THEN
1085	tab_flds(:,:,ids_liqrun) = cpl_rriv2D(:,:) + cpl_rcoa2D(:,:)
1086	IF (carbon_cycle_cpl) tab_flds(:,:,ids_atmco2)=cpl_atm_co22D(:,:)
1087	ELSE IF (version_ocean=='opa8') THEN
1088	tab_flds(:,:,ids_shfoce) = cpl_sols2D(:,:,1)
1089	tab_flds(:,:,ids_nsfoce) = cpl_nsol2D(:,:,1)
1090	tab_flds(:,:,ids_icevap) = cpl_evap2D(:,:,2)
1091	tab_flds(:,:,ids_ocevap) = cpl_evap2D(:,:,1)
1092	tab_flds(:,:,ids_runcoa) = cpl_rcoa2D(:,:)
1093	tab_flds(:,:,ids_rivflu) = cpl_rriv2D(:,:)
1094	END IF
1095
1096	!*************************************************************************************
1097	! Transform the fraction of sub-surfaces from 1D to 2D array
1098	!
1099	!*************************************************************************************
1100	pctsrf2D(:,:,:) = 0.
1101	!$OMP END MASTER
1102	CALL gath2cpl(pctsrf(:,is_oce), pctsrf2D(:,:,is_oce), klon, unity)
1103	CALL gath2cpl(pctsrf(:,is_sic), pctsrf2D(:,:,is_sic), klon, unity)
1104	CALL gath2cpl(pctsrf(:,is_lic), pctsrf2D(:,:,is_lic), klon, unity)
1105
1106	!*************************************************************************************
1107	! Calculate the average calving per latitude
1108	! Store calving in tab_flds(:,:,19)
1109	!
1110	!*************************************************************************************
1111	IF (is_omp_root) THEN
1112
1113	DO j = 1, jj_nb
1114	tmp_calv(:,j) = DOT_PRODUCT (cpl_rlic2D(1:iim,j), &
1115	pctsrf2D(1:iim,j,is_lic)) / REAL(iim)
1116	ENDDO
1117
1118
1119	IF (is_parallel) THEN
1120	IF (.NOT. is_north_pole) THEN
1121	#ifdef CPP_MPI
1122	CALL MPI_RECV(Up,1,MPI_REAL_LMDZ,mpi_rank-1,1234,COMM_LMDZ_PHY,status,error)
1123	CALL MPI_SEND(tmp_calv(1,1),1,MPI_REAL_LMDZ,mpi_rank-1,1234,COMM_LMDZ_PHY,error)
1124	#endif
1125	ENDIF
1126
1127	IF (.NOT. is_south_pole) THEN
1128	#ifdef CPP_MPI
1129	CALL MPI_SEND(tmp_calv(1,jj_nb),1,MPI_REAL_LMDZ,mpi_rank+1,1234,COMM_LMDZ_PHY,error)
1130	CALL MPI_RECV(down,1,MPI_REAL_LMDZ,mpi_rank+1,1234,COMM_LMDZ_PHY,status,error)
1131	#endif
1132	ENDIF
1133
1134	IF (.NOT. is_north_pole .AND. ii_begin /=1) THEN
1135	Up=Up+tmp_calv(iim,1)
1136	tmp_calv(:,1)=Up
1137	ENDIF
1138
1139	IF (.NOT. is_south_pole .AND. ii_end /= iim) THEN
1140	Down=Down+tmp_calv(1,jj_nb)
1141	tmp_calv(:,jj_nb)=Down
1142	ENDIF
1143	ENDIF
1144
1145	tab_flds(:,:,ids_calvin) = tmp_calv(:,:)
1146
1147	!*************************************************************************************
1148	! Calculate total flux for snow, rain and wind with weighted addition using the
1149	! fractions of ocean and seaice.
1150	!
1151	!*************************************************************************************
1152	! fraction oce+seaice
1153	deno = pctsrf2D(:,:,is_oce) + pctsrf2D(:,:,is_sic)
1154
1155	IF (version_ocean=='nemo') THEN
1156	tab_flds(:,:,ids_shftot) = 0.0
1157	tab_flds(:,:,ids_nsftot) = 0.0
1158	tab_flds(:,:,ids_totrai) = 0.0
1159	tab_flds(:,:,ids_totsno) = 0.0
1160	tab_flds(:,:,ids_toteva) = 0.0
1161	tab_flds(:,:,ids_taumod) = 0.0
1162
1163	tmp_taux(:,:) = 0.0
1164	tmp_tauy(:,:) = 0.0
1165	! For all valid grid cells containing some fraction of ocean or sea-ice
1166	WHERE ( deno(:,:) /= 0 )
1167	tmp_taux = cpl_taux2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + &
1168	cpl_taux2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
1169	tmp_tauy = cpl_tauy2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + &
1170	cpl_tauy2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
1171
1172	tab_flds(:,:,ids_shftot) = cpl_sols2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + &
1173	cpl_sols2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
1174	tab_flds(:,:,ids_nsftot) = cpl_nsol2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + &
1175	cpl_nsol2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
1176	tab_flds(:,:,ids_totrai) = cpl_rain2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + &
1177	cpl_rain2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
1178	tab_flds(:,:,ids_totsno) = cpl_snow2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + &
1179	cpl_snow2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
1180	tab_flds(:,:,ids_toteva) = cpl_evap2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + &
1181	cpl_evap2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
1182	tab_flds(:,:,ids_taumod) = cpl_taumod2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + &
1183	cpl_taumod2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
1184
1185	ENDWHERE
1186
1187	tab_flds(:,:,ids_icevap) = cpl_evap2D(:,:,2)
1188
1189	ELSE IF (version_ocean=='opa8') THEN
1190	! Store fields for rain and snow in tab_flds(:,:,15) and tab_flds(:,:,16)
1191	tab_flds(:,:,ids_totrai) = 0.0
1192	tab_flds(:,:,ids_totsno) = 0.0
1193	tmp_taux(:,:) = 0.0
1194	tmp_tauy(:,:) = 0.0
1195	! For all valid grid cells containing some fraction of ocean or sea-ice
1196	WHERE ( deno(:,:) /= 0 )
1197	tab_flds(:,:,ids_totrai) = cpl_rain2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + &
1198	cpl_rain2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
1199	tab_flds(:,:,ids_totsno) = cpl_snow2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + &
1200	cpl_snow2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
1201
1202	tmp_taux = cpl_taux2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + &
1203	cpl_taux2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
1204	tmp_tauy = cpl_tauy2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + &
1205	cpl_tauy2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
1206	ENDWHERE
1207	END IF
1208
1209	ENDIF ! is_omp_root
1210
1211	!*************************************************************************************
1212	! Transform the wind components from local atmospheric 2D coordinates to geocentric
1213	! 3D coordinates.
1214	! Store the resulting wind components in tab_flds(:,:,1:6)
1215	!*************************************************************************************
1216
1217	! Transform the longitudes and latitudes on 2D arrays
1218
1219	CALL gather_omp(rlon,rlon_mpi)
1220	CALL gather_omp(rlat,rlat_mpi)
1221	!$OMP MASTER
1222	CALL Grid1DTo2D_mpi(rlon_mpi,tmp_lon)
1223	CALL Grid1DTo2D_mpi(rlat_mpi,tmp_lat)
1224	!$OMP END MASTER
1225
1226	IF (is_sequential) THEN
1227	IF (is_north_pole) tmp_lon(:,1) = tmp_lon(:,2)
1228	IF (is_south_pole) tmp_lon(:,jjm+1) = tmp_lon(:,jjm)
1229	ENDIF
1230
1231	! NetCDF output of the wind before transformation of coordinate system
1232	IF (is_sequential) THEN
1233	ndexct(:) = 0
1234	itau_w = itau_phy + itime + start_time * day_step / iphysiq
1235	CALL histwrite(nidct,'tauxe',itau_w,tmp_taux,iim*(jjm+1),ndexct)
1236	CALL histwrite(nidct,'tauyn',itau_w,tmp_tauy,iim*(jjm+1),ndexct)
1237	CALL histwrite(nidct,'tmp_lon',itau_w,tmp_lon,iim*(jjm+1),ndexct)
1238	CALL histwrite(nidct,'tmp_lat',itau_w,tmp_lat,iim*(jjm+1),ndexct)
1239	ENDIF
1240
1241	! Transform the wind from spherical atmospheric 2D coordinates to geocentric
1242	! cartesian 3D coordinates
1243	!$OMP MASTER
1244	CALL atm2geo (iim, jj_nb, tmp_taux, tmp_tauy, tmp_lon, tmp_lat, &
1245	tab_flds(:,:,ids_tauxxu), tab_flds(:,:,ids_tauyyu), tab_flds(:,:,ids_tauzzu) )
1246
1247	tab_flds(:,:,ids_tauxxv) = tab_flds(:,:,ids_tauxxu)
1248	tab_flds(:,:,ids_tauyyv) = tab_flds(:,:,ids_tauyyu)
1249	tab_flds(:,:,ids_tauzzv) = tab_flds(:,:,ids_tauzzu)
1250	!$OMP END MASTER
1251
1252	!*************************************************************************************
1253	! NetCDF output of all fields just before sending to coupler.
1254	!
1255	!*************************************************************************************
1256	IF (is_sequential) THEN
1257	DO j=1,maxsend
1258	IF (infosend(j)%action) CALL histwrite(nidct,infosend(j)%name, itau_w, &
1259	tab_flds(:,:,j),iim*(jjm+1),ndexct)
1260	ENDDO
1261	ENDIF
1262	!*************************************************************************************
1263	! Send the table of all fields
1264	!
1265	!*************************************************************************************
1266	time_sec=(itime-1)*dtime
1267	#ifdef CPP_COUPLE
1268	!$OMP MASTER
1269	CALL intocpl(time_sec, lafin, tab_flds(:,:,:))
1270	!$OMP END MASTER
1271	#endif
1272
1273	!*************************************************************************************
1274	! Finish with some dellocate
1275	!
1276	!*************************************************************************************
1277	sum_error=0
1278	DEALLOCATE(cpl_sols2D, cpl_nsol2D, cpl_rain2D, cpl_snow2D, stat=error )
1279	sum_error = sum_error + error
1280	DEALLOCATE(cpl_evap2D, cpl_tsol2D, cpl_fder2D, cpl_albe2D, stat=error )
1281	sum_error = sum_error + error
1282	DEALLOCATE(cpl_taux2D, cpl_tauy2D, cpl_windsp2D, cpl_taumod2D, stat=error )
1283	sum_error = sum_error + error
1284
1285	IF (carbon_cycle_cpl) THEN
1286	DEALLOCATE(cpl_atm_co22D, stat=error )
1287	sum_error = sum_error + error
1288	END IF
1289
1290	IF (sum_error /= 0) THEN
1291	abort_message='Pb in deallocation of cpl_xxxx2D coupling variables'
1292	CALL abort_gcm(modname,abort_message,1)
1293	ENDIF
1294
1295	END SUBROUTINE cpl_send_all
1296	!
1297	!*************************************************************************************
1298	!
1299	SUBROUTINE cpl2gath(champ_in, champ_out, knon, knindex)
1300	USE mod_phys_lmdz_para
1301	! Cette routine transforme un champs de la grille 2D recu du coupleur sur la grille
1302	! 'gathered' (la grille physiq comprime).
1303	!
1304	!
1305	! input:
1306	! champ_in champ sur la grille 2D
1307	! knon nombre de points dans le domaine a traiter
1308	! knindex index des points de la surface a traiter
1309	!
1310	! output:
1311	! champ_out champ sur la grille 'gatherd'
1312	!
1313	INCLUDE "dimensions.h"
1314
1315	! Input
1316	INTEGER, INTENT(IN) :: knon
1317	REAL, DIMENSION(iim,jj_nb), INTENT(IN) :: champ_in
1318	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
1319
1320	! Output
1321	REAL, DIMENSION(klon_mpi), INTENT(OUT) :: champ_out
1322
1323	! Local
1324	INTEGER :: i, ig
1325	REAL, DIMENSION(klon_mpi) :: temp_mpi
1326	REAL, DIMENSION(klon) :: temp_omp
1327
1328	!*************************************************************************************
1329	!
1330
1331
1332	! Transform from 2 dimensions (iim,jj_nb) to 1 dimension (klon)
1333	!$OMP MASTER
1334	CALL Grid2Dto1D_mpi(champ_in,temp_mpi)
1335	!$OMP END MASTER
1336
1337	CALL scatter_omp(temp_mpi,temp_omp)
1338
1339	! Compress from klon to knon
1340	DO i = 1, knon
1341	ig = knindex(i)
1342	champ_out(i) = temp_omp(ig)
1343	ENDDO
1344
1345	END SUBROUTINE cpl2gath
1346	!
1347	!*************************************************************************************
1348	!
1349	SUBROUTINE gath2cpl(champ_in, champ_out, knon, knindex)
1350	USE mod_phys_lmdz_para
1351	! Cette routine ecrit un champ 'gathered' sur la grille 2D pour le passer
1352	! au coupleur.
1353	!
1354	! input:
1355	! champ_in champ sur la grille gathere
1356	! knon nombre de points dans le domaine a traiter
1357	! knindex index des points de la surface a traiter
1358	!
1359	! output:
1360	! champ_out champ sur la grille 2D
1361	!
1362	INCLUDE "dimensions.h"
1363
1364	! Input arguments
1365	!*************************************************************************************
1366	INTEGER, INTENT(IN) :: knon
1367	REAL, DIMENSION(klon), INTENT(IN) :: champ_in
1368	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
1369
1370	! Output arguments
1371	!*************************************************************************************
1372	REAL, DIMENSION(iim,jj_nb), INTENT(OUT) :: champ_out
1373
1374	! Local variables
1375	!*************************************************************************************
1376	INTEGER :: i, ig
1377	REAL, DIMENSION(klon) :: temp_omp
1378	REAL, DIMENSION(klon_mpi) :: temp_mpi
1379	!*************************************************************************************
1380
1381	! Decompress from knon to klon
1382	temp_omp = 0.
1383	DO i = 1, knon
1384	ig = knindex(i)
1385	temp_omp(ig) = champ_in(i)
1386	ENDDO
1387
1388	! Transform from 1 dimension (klon) to 2 dimensions (iim,jj_nb)
1389	CALL gather_omp(temp_omp,temp_mpi)
1390
1391	!$OMP MASTER
1392	CALL Grid1Dto2D_mpi(temp_mpi,champ_out)
1393
1394	IF (is_north_pole) champ_out(:,1)=temp_mpi(1)
1395	IF (is_south_pole) champ_out(:,jj_nb)=temp_mpi(klon)
1396	!$OMP END MASTER
1397
1398	END SUBROUTINE gath2cpl
1399	!
1400	!*************************************************************************************
1401	!
1402	END MODULE cpl_mod
1403

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

Download in other formats:

Original Format