Context Navigation

cpl_mod.F90 @ 5425

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

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

Download in other formats:

Original Format