Context Navigation

cpl_mod.F90

Last change on this file was 3331, checked in by acozic, 7 years ago
Add modification for isotopes
Property svn:executable set to ``*
File size: 55.9 KB

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

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

Download in other formats:

Original Format