Context Navigation

cpl_mod.F90 @ 3747

Last change on this file since 3747 was 3744, checked in by lguez, 4 years ago

Store delta_sst instead of sst_nff

Store as a state variable the difference between ocean-air interface
temperature and bulk SST instead of sst_nff, which can be either
interface temperature or bulk SST. This is clearer. Also, it is
analoguous to what we will do with salinity.

So replace the two dummy arguments tsurf_in and sst_nff of
procedure cpl_send_ocean_fields by a single dummy argument
delta_sst. Replace dummy argument sst_nff of procedures
ocean_cpl_noice and surf_ocean by dummy argument
delta_sst. Replace variable sst_nff of module phys_state_var_mod
by variable delta_sst. Rename local variable ysst_nff of procedure
pbl_surface to ydelta_sst. Set variable delta_sst of module
phys_state_var_mod to 0 for an appearing ocean fraction and a
missing startup field. Replace variable o_sst_nff of module
phys_output_ctrlout_mod by variable o_delta_sst.

Rename variables cpl_delta_temp and cpl_delta_temp_2D of module
cpl_mod to cpl_delta_sst and cpl_delta_sst_2D, clearer. Rename
variable ids_delta_temp of module oasis to ids_delta_sst. Change
infosend(ids_delta_temp)%name to "CODELSST".

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

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

Download in other formats:

Original Format