Context Navigation

cpl_mod.F90 @ 3628

Last change on this file since 3628 was 3628, checked in by lguez, 5 years ago
If the ocean skin parameterization is working actively (`activate_ocean_skin == 2`) and we are coupled to the ocean then send ocean-air interface salinity to the ocean. New dummy argument `s_int` of procedures `ocean_cpl_noice` and `cpl_send_ocean_fields`. We can only send interface salinity from the previous time-step since communication with the ocean is before the call to bulk_flux. So make `s_int` a state variable: move `s_int` from `phys_output_var_mod` to `phys_state_var_mod`. Still, we only read `s_int` from startphy, define it before the call to `surf_ocean` and write it to restartphy if `activate_ocean_skin == 2` and `type_ocean == 'couple'`. In procedure `pbl_surface`, for clarity, move the definition of output variables `t_int`, dter, dser, tkt, tks, rf, taur to `missing_val` to after the call to `surf_ocean`, with the definition of `s_int`, `ds_ns`, `dt_ns` to `missing_val`. This does not change anything for `t_int`, dter, dser, tkt, tks, rf, taur. In `pbl_surface_newfrac`, we choose to set `s_int` to 35 for an appearing ocean point, this is questionable. In `surf_ocean`, change the intent of `s_int` from out to inout.
Property copyright set to Name of program: LMDZ Creation date: 1984 Version: LMDZ5 License: CeCILL version 2 Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539 See the license file in the root directory Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 64.5 KB

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

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

Download in other formats:

Original Format