Context Navigation

cpl_mod.F90 @ 2545

Last change on this file since 2545 was 2545, checked in by Laurent Fairhead, 8 years ago
Rollback for revision r2538: calculation of the fluxes is correct but transmission to coupler is broken LF
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
[2545]	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, &
[2545]	533	precip_rain, precip_snow, evap, tsurf, fder, albsol, taux, tauy, windsp)
[782]	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, &
[2545]	724	precip_rain, precip_snow, evap, tsurf, fder, albsol, taux, tauy)
[782]	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
[2429]	1117	IF (.NOT. is_north_pole_dyn) 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
[2429]	1124	IF (.NOT. is_south_pole_dyn) 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
[2429]	1131	IF (.NOT. is_north_pole_dyn .AND. ii_begin /=1) THEN
[2344]	1132	Up=Up+tmp_calv(nbp_lon,1)
[987]	1133	tmp_calv(:,1)=Up
	1134	ENDIF
[996]	1135
[2429]	1136	IF (.NOT. is_south_pole_dyn .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
[2429]	1224	IF (is_north_pole_dyn) tmp_lon(:,1) = tmp_lon(:,2)
	1225	IF (is_south_pole_dyn) 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
[2429]	1391	IF (is_north_pole_dyn) champ_out(:,1)=temp_mpi(1)
	1392	IF (is_south_pole_dyn) champ_out(:,jj_nb)=temp_mpi(klon)
[987]	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