Context Navigation

cpl_mod.F90 @ 5416

Last change on this file since 5416 was 5394, checked in by evignon, 2 weeks 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