Context Navigation

cpl_mod.F90 @ 4283

Last change on this file since 4283 was 4283, checked in by jghattas, 20 months ago

Added landice_opt=2 : Treat continental land ice fractions in ORCHIDEE => pctsrf(:,is_lic) = 0.0 in LMDZ.

For this option, some more variables are needed from ORCHIDEE. Therfor change in the interface LMDZ-ORCHIDEE in surf_land_orchidee_mod is done. Previous interface is moved to surf_land_orchidee_nolic_mod.f90. To compile with previous interface, cpp key ORCHIDEE_NOLIC is added. Previous interface is compiled with argument orchidee2.1 in makelmdz and makelmdz_fcm.

At the same time, when the interface was changed, the variable yrmu0(coszang) was added in the call to intersurf_initialize_gathered. This is needed in ORCHIDEE to better initialize the model.

Modifications done by Etienne Vignon and Josefine Ghattas

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:keywords set to Author Date Id Revision

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

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

Download in other formats:

Original Format