Context Navigation

cpl_mod.F90 @ 5448

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

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

Download in other formats:

Original Format