Context Navigation

cpl_mod.F90 @ 2069

Last change on this file since 2069 was 1907, checked in by lguez, 11 years ago

Added a copyright property to every file of the distribution, except
for the fcm files (which have their own copyright). Use svn propget on
a file to see the copyright. For instance:

$ svn propget copyright libf/phylmd/physiq.F90
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

Also added the files defining the CeCILL version 2 license, in French
and English, at the top of the LMDZ tree.

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

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

Download in other formats:

Original Format