Context Navigation

cpl_mod.F90 @ 3999

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

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

Download in other formats:

Original Format