Context Navigation

cpl_mod.F90 @ 4400

Last change on this file since 4400 was 2872, checked in by Laurent Fairhead, 8 years ago
Follow-up to revision 2538: actually sending the heat fluxes associated with solid and liquid precipitations over ocean and seaice to the coupler LF
Property copyright set to Name of program: LMDZ Creation date: 1984 Version: LMDZ5 License: CeCILL version 2 Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539 See the license file in the root directory Property svn:eol-style set to `native` Property svn:executable set to ``* Property svn:keywords set to `Author Date Id Revision`
File size: 58.6 KB

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

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

Download in other formats:

Original Format