Context Navigation

cpl_mod.F90 @ 2400

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

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

Download in other formats:

Original Format