Context Navigation

cpl_mod.F90 @ 5524

Last change on this file since 5524 was 5144, checked in by abarral, 6 months ago
Put YOMCST.h into modules
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: 67.1 KB

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

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

Download in other formats:

Original Format