Context Navigation

cpl_mod.F90 @ 1290

Last change on this file since 1290 was 1279, checked in by Laurent Fairhead, 15 years ago
Merged LMDZ4-dev branch changes r1241:1278 into the trunk Running trunk and LMDZ4-dev in LMDZOR configuration on local machine (sequential) and SX8 (4-proc) yields identical results (restart and restartphy are identical binarily) Log history from r1241 to r1278 is available by switching to source:LMDZ4/branches/LMDZ4-dev-20091210
Property svn:eol-style set to `native` Property svn:executable set to ``* Property svn:keywords set to `Author Date Id Revision`
File size: 54.8 KB

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

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

Download in other formats:

Original Format