Context Navigation

cpl_mod.F90 @ 5374

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

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

Download in other formats:

Original Format