Context Navigation

cpl_mod.F90 @ 4249

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

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

Download in other formats:

Original Format