Context Navigation

cpl_mod.F90 @ 1600

Last change on this file since 1600 was 1577, checked in by Laurent Fairhead, 13 years ago

Modifications au code qui permettent de commencer une simulation à n'importe
quelle heure de la journée. On fait toujours un nombre entier de jours de
simulation.
On spécifie cette heure de départ dans la variable starttime du run.def (la
valeur est en jour et elle est à zéro par défaut).
La valeur est sauvegardée dans le fichier restart.nc. Les valeurs lues dans
le fichier start et le run.def sont comparées en début de simulation. La
simulation s'arrête si elles ne sont pas égales sauf si une remise à zéro de
la date a été demandée.
Par ailleurs, la fréquence de lecture des conditions aux limites a été modifiée
pour qu'à chaque changement de jour, celles-ci soient mises à jour (jusqu'à
maintenant elles étaient mises à jour à une fréquence donnée qui, en cas de
départ de simulation à une heure différente de minuit, ne correspondait pas
forcèment à un changement dans la date).
Validation effectuée en traçant le flux solaire descendant au sommet de
l'atmosphère à différentes heures de la journée, après un redémarrage, en
s'assurant que le maximum est bien là où il est sensé être.

Modifications to the code to enable it to be started at any time of the day.
The code still runs for an integer number of days.
The start time is specified using variable starttime in the run.def file (the
value is in days and is zero by default).
The start time is saved in the restart.nc file at the end of the simulation.
The values read in from the start.nc file and the run.def file are compared
at the start of the simulation. If they differ, the simulation is aborted
unless the raz_date variable has been set.
Furthermore, the frequency at which boundary conditions are read in has been
modified so that they are updated everyday at midnight (until now, they were
updated at a certain frequency that, in case of a simulation starting at a time
other than midnight, did not ensure that those conditions would be updated each
day at midnight)
The modifications were validated by plotting the downward solaf flux at TOA at
different times of the day (and after having restarted the simulation) and
ensuring that the maximum of flux was at the right place according to local
time.

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

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

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

Download in other formats:

Original Format