Context Navigation

cpl_mod.F90 @ 1006

Last change on this file since 1006 was 1001, checked in by Laurent Fairhead, 16 years ago

Modifs sur le parallelisme: masquage dans la physique
Inclusion strato
mise en coherence etat0
le mode offline fonctionne maintenant en parallele,
les fichiers de la dynamiques sont correctement sortis et peuvent etre reconstruit avec rebuild
la version parallele de la dynamique peut s'executer sans MPI (sur 1 proc)
L'OPENMP fonctionne maintenant sans la parallelisation MPI.

YM
LF

Property svn:eol-style set to native
Property svn:executable set to *
Property svn:keywords set to Author Date Id Revision

File size: 51.3 KB

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

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

Download in other formats:

Original Format