Context Navigation

ocean_cpl_mod.F90 @ 2654

Last change on this file since 2654 was 2545, checked in by Laurent Fairhead, 8 years ago
Rollback for revision r2538: calculation of the fluxes is correct but transmission to coupler is broken LF
Property copyright set to Name of program: LMDZ Creation date: 1984 Version: LMDZ5 License: CeCILL version 2 Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539 See the license file in the root directory Property svn:eol-style set to `native` Property svn:executable set to ``* Property svn:keywords set to `Id`
File size: 14.2 KB

Rev	Line
[782]	1	!
[2538]	2	! $Id: ocean_cpl_mod.F90 2545 2016-06-07 07:46:53Z jyg $
	3	!
[782]	4	MODULE ocean_cpl_mod
	5	!
	6	! This module is used both for the sub-surface ocean and sea-ice for the case of a
	7	! coupled model configuration, ocean=couple.
	8	!
	9
	10	IMPLICIT NONE
	11	PRIVATE
	12
[996]	13	PUBLIC :: ocean_cpl_init, ocean_cpl_noice, ocean_cpl_ice
[782]	14
[2538]	15
[782]	16	!****************************************************************************************
	17	!
	18	CONTAINS
	19	!
	20	!****************************************************************************************
	21	!
	22	SUBROUTINE ocean_cpl_init(dtime, rlon, rlat)
	23	!
	24	! Allocate fields for this module and initailize the module mod_cpl
	25	!
[1067]	26	USE dimphy, ONLY : klon
	27	USE cpl_mod
	28
[782]	29	! Input arguments
	30	!*************************************************************************************
	31	REAL, INTENT(IN) :: dtime
	32	REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat
	33
	34	! Local variables
	35	!*************************************************************************************
	36	INTEGER :: error
	37	CHARACTER (len = 80) :: abort_message
	38	CHARACTER (len = 20) :: modname = 'ocean_cpl_init'
	39
	40	! Initialize module cpl_init
	41	CALL cpl_init(dtime, rlon, rlat)
	42
	43	END SUBROUTINE ocean_cpl_init
	44	!
	45	!****************************************************************************************
	46	!
	47	SUBROUTINE ocean_cpl_noice( &
[888]	48	swnet, lwnet, alb1, &
[1067]	49	windsp, fder_old, &
[782]	50	itime, dtime, knon, knindex, &
[2254]	51	p1lay, cdragh, cdragq, cdragm, precip_rain, precip_snow, temp_air, spechum, &
[1067]	52	AcoefH, AcoefQ, BcoefH, BcoefQ, &
	53	AcoefU, AcoefV, BcoefU, BcoefV, &
[2240]	54	ps, u1, v1, gustiness, &
[888]	55	radsol, snow, agesno, &
[1067]	56	qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
[996]	57	tsurf_new, dflux_s, dflux_l)
[1067]	58
[782]	59	!
	60	! This subroutine treats the "open ocean", all grid points that are not entierly covered
	61	! by ice. The subroutine first receives fields from coupler, then some calculations at
	62	! surface is done and finally it sends some fields to the coupler.
	63	!
[1067]	64	USE dimphy, ONLY : klon
	65	USE cpl_mod
	66	USE calcul_fluxs_mod
[1785]	67	USE indice_sol_mod
[2538]	68	USE phys_output_var_mod, ONLY : sens_prec_liq_o, sens_prec_sol_o, lat_prec_liq_o, lat_prec_sol_o
	69	USE cpl_mod, ONLY : gath2cpl
[1067]	70
[793]	71	INCLUDE "YOMCST.h"
[2254]	72	INCLUDE "clesphys.h"
[782]	73	!
	74	! Input arguments
	75	!****************************************************************************************
	76	INTEGER, INTENT(IN) :: itime, knon
	77	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
	78	REAL, INTENT(IN) :: dtime
[888]	79	REAL, DIMENSION(klon), INTENT(IN) :: swnet
	80	REAL, DIMENSION(klon), INTENT(IN) :: lwnet
	81	REAL, DIMENSION(klon), INTENT(IN) :: alb1 ! albedo in visible SW interval
[782]	82	REAL, DIMENSION(klon), INTENT(IN) :: windsp
	83	REAL, DIMENSION(klon), INTENT(IN) :: fder_old
	84	REAL, DIMENSION(klon), INTENT(IN) :: p1lay
[2254]	85	REAL, DIMENSION(klon), INTENT(IN) :: cdragh, cdragq, cdragm
[782]	86	REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow
	87	REAL, DIMENSION(klon), INTENT(IN) :: temp_air, spechum
[1067]	88	REAL, DIMENSION(klon), INTENT(IN) :: AcoefH, AcoefQ, BcoefH, BcoefQ
	89	REAL, DIMENSION(klon), INTENT(IN) :: AcoefU, AcoefV, BcoefU, BcoefV
[782]	90	REAL, DIMENSION(klon), INTENT(IN) :: ps
[2240]	91	REAL, DIMENSION(klon), INTENT(IN) :: u1, v1, gustiness
[782]	92
	93	! In/Output arguments
	94	!****************************************************************************************
	95	REAL, DIMENSION(klon), INTENT(INOUT) :: radsol
	96	REAL, DIMENSION(klon), INTENT(INOUT) :: snow
	97	REAL, DIMENSION(klon), INTENT(INOUT) :: agesno
	98
	99	! Output arguments
	100	!****************************************************************************************
	101	REAL, DIMENSION(klon), INTENT(OUT) :: qsurf
	102	REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat
[1067]	103	REAL, DIMENSION(klon), INTENT(OUT) :: flux_u1, flux_v1
[782]	104	REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new
	105	REAL, DIMENSION(klon), INTENT(OUT) :: dflux_s, dflux_l
[2538]	106
[782]	107
	108	! Local variables
	109	!****************************************************************************************
[2538]	110	INTEGER :: i, j
[782]	111	INTEGER, DIMENSION(1) :: iloc
	112	REAL, DIMENSION(klon) :: cal, beta, dif_grnd
	113	REAL, DIMENSION(klon) :: fder_new
	114	REAL, DIMENSION(klon) :: tsurf_cpl
[1067]	115	REAL, DIMENSION(klon) :: u0_cpl, v0_cpl
	116	REAL, DIMENSION(klon) :: u1_lay, v1_lay
[782]	117	LOGICAL :: check=.FALSE.
[2538]	118	REAL, DIMENSION(klon) :: sens_prec_liq, sens_prec_sol
	119	REAL, DIMENSION(klon) :: lat_prec_liq, lat_prec_sol
[782]	120
	121	! End definitions
	122	!****************************************************************************************
	123
	124	IF (check) WRITE(,)' Entering ocean_cpl_noice'
	125
	126	!****************************************************************************************
[996]	127	! Receive sea-surface temperature(tsurf_cpl) from coupler
[782]	128	!
	129	!****************************************************************************************
[1067]	130	CALL cpl_receive_ocean_fields(knon, knindex, tsurf_cpl, u0_cpl, v0_cpl)
[782]	131
	132	!****************************************************************************************
	133	! Calculate fluxes at surface
	134	!
	135	!****************************************************************************************
	136	cal = 0.
	137	beta = 1.
	138	dif_grnd = 0.
	139	agesno(:) = 0.
[2538]	140	sens_prec_liq = 0.; sens_prec_sol = 0.; lat_prec_liq = 0.; lat_prec_sol = 0.
	141
[1067]	142
	143	DO i = 1, knon
	144	u1_lay(i) = u1(i) - u0_cpl(i)
	145	v1_lay(i) = v1(i) - v0_cpl(i)
	146	END DO
	147
[782]	148	CALL calcul_fluxs(knon, is_oce, dtime, &
[2254]	149	tsurf_cpl, p1lay, cal, beta, cdragh, cdragq, ps, &
[782]	150	precip_rain, precip_snow, snow, qsurf, &
[2240]	151	radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
[2254]	152	f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
[2538]	153	tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
	154	sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
	155	do j = 1, knon
	156	i = knindex(j)
	157	sens_prec_liq_o(i,1) = sens_prec_liq(j)
	158	sens_prec_sol_o(i,1) = sens_prec_sol(j)
	159	lat_prec_liq_o(i,1) = lat_prec_liq(j)
	160	lat_prec_sol_o(i,1) = lat_prec_sol(j)
	161	enddo
	162
	163
[782]	164
[1067]	165	! - Flux calculation at first modele level for U and V
	166	CALL calcul_flux_wind(knon, dtime, &
[2240]	167	u0_cpl, v0_cpl, u1, v1, gustiness, cdragm, &
[1067]	168	AcoefU, AcoefV, BcoefU, BcoefV, &
	169	p1lay, temp_air, &
	170	flux_u1, flux_v1)
[782]	171
	172	!****************************************************************************************
	173	! Calculate fder : flux derivative (sensible and latente)
	174	!
	175	!****************************************************************************************
	176	fder_new(:) = fder_old(:) + dflux_s(:) + dflux_l(:)
	177
	178	iloc = MAXLOC(fder_new(1:klon))
	179	IF (check .AND. fder_new(iloc(1))> 0.) THEN
	180	WRITE(,)'** Debug fder**'
	181	WRITE(,)'max fder(',iloc(1),') = ',fder_new(iloc(1))
	182	WRITE(,)'fder_old, dflux_s, dflux_l',fder_old(iloc(1)), &
	183	dflux_s(iloc(1)), dflux_l(iloc(1))
	184	ENDIF
	185
	186	!****************************************************************************************
	187	! Send and cumulate fields to the coupler
	188	!
	189	!****************************************************************************************
	190
	191	CALL cpl_send_ocean_fields(itime, knon, knindex, &
[888]	192	swnet, lwnet, fluxlat, fluxsens, &
[2545]	193	precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, flux_u1, flux_v1, windsp&
	194	)
	195	! ,sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
[782]	196
	197
	198	END SUBROUTINE ocean_cpl_noice
	199	!
	200	!****************************************************************************************
	201	!
	202	SUBROUTINE ocean_cpl_ice( &
[888]	203	rlon, rlat, swnet, lwnet, alb1, &
[782]	204	fder_old, &
	205	itime, dtime, knon, knindex, &
	206	lafin, &
[1067]	207	p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
	208	AcoefH, AcoefQ, BcoefH, BcoefQ, &
	209	AcoefU, AcoefV, BcoefU, BcoefV, &
[2240]	210	ps, u1, v1, gustiness, pctsrf, &
[782]	211	radsol, snow, qsurf, &
[1067]	212	alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
[996]	213	tsurf_new, dflux_s, dflux_l)
[782]	214	!
	215	! This subroutine treats the ocean where there is ice. The subroutine first receives
	216	! fields from coupler, then some calculations at surface is done and finally sends
	217	! some fields to the coupler.
	218	!
[1067]	219	USE dimphy, ONLY : klon
	220	USE cpl_mod
	221	USE calcul_fluxs_mod
[1785]	222	USE indice_sol_mod
[2538]	223	USE phys_output_var_mod, ONLY : sens_prec_liq_o, sens_prec_sol_o, lat_prec_liq_o, lat_prec_sol_o
[1067]	224
[793]	225	INCLUDE "YOMCST.h"
[2254]	226	INCLUDE "clesphys.h"
[782]	227
	228	! Input arguments
	229	!****************************************************************************************
	230	INTEGER, INTENT(IN) :: itime, knon
	231	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
	232	LOGICAL, INTENT(IN) :: lafin
	233	REAL, INTENT(IN) :: dtime
	234	REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat
[888]	235	REAL, DIMENSION(klon), INTENT(IN) :: swnet
	236	REAL, DIMENSION(klon), INTENT(IN) :: lwnet
	237	REAL, DIMENSION(klon), INTENT(IN) :: alb1 ! albedo in visible SW interval
[782]	238	REAL, DIMENSION(klon), INTENT(IN) :: fder_old
	239	REAL, DIMENSION(klon), INTENT(IN) :: p1lay
[1067]	240	REAL, DIMENSION(klon), INTENT(IN) :: cdragh, cdragm
[782]	241	REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow
	242	REAL, DIMENSION(klon), INTENT(IN) :: temp_air, spechum
[1067]	243	REAL, DIMENSION(klon), INTENT(IN) :: AcoefH, AcoefQ, BcoefH, BcoefQ
	244	REAL, DIMENSION(klon), INTENT(IN) :: AcoefU, AcoefV, BcoefU, BcoefV
[782]	245	REAL, DIMENSION(klon), INTENT(IN) :: ps
[2240]	246	REAL, DIMENSION(klon), INTENT(IN) :: u1, v1, gustiness
[996]	247	REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
[782]	248
	249	! In/output arguments
	250	!****************************************************************************************
	251	REAL, DIMENSION(klon), INTENT(INOUT) :: radsol
	252	REAL, DIMENSION(klon), INTENT(INOUT) :: snow
	253
	254	! Output arguments
	255	!****************************************************************************************
	256	REAL, DIMENSION(klon), INTENT(OUT) :: qsurf
[888]	257	REAL, DIMENSION(klon), INTENT(OUT) :: alb1_new, alb2_new
[782]	258	REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat
[1067]	259	REAL, DIMENSION(klon), INTENT(OUT) :: flux_u1, flux_v1
[888]	260	REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new
[782]	261	REAL, DIMENSION(klon), INTENT(OUT) :: dflux_s, dflux_l
[2538]	262
[782]	263
	264	! Local variables
	265	!****************************************************************************************
[2538]	266	INTEGER :: i, j
[782]	267	INTEGER, DIMENSION(1) :: iloc
	268	LOGICAL :: check=.FALSE.
	269	REAL, PARAMETER :: t_grnd=271.35
	270	REAL, DIMENSION(klon) :: cal, beta, dif_grnd
	271	REAL, DIMENSION(klon) :: tsurf_cpl, fder_new
[888]	272	REAL, DIMENSION(klon) :: alb_cpl
[1067]	273	REAL, DIMENSION(klon) :: u0, v0
	274	REAL, DIMENSION(klon) :: u1_lay, v1_lay
[2538]	275	REAL, DIMENSION(klon) :: sens_prec_liq, sens_prec_sol
	276	REAL, DIMENSION(klon) :: lat_prec_liq, lat_prec_sol
[782]	277
	278	! End definitions
	279	!****************************************************************************************
	280
	281	IF (check) WRITE(,)'Entering surface_seaice, knon=',knon
	282
[2538]	283	sens_prec_liq = 0.; sens_prec_sol = 0.; lat_prec_liq = 0.; lat_prec_sol = 0.
	284
[782]	285	!****************************************************************************************
[996]	286	! Receive ocean temperature(tsurf_cpl) and albedo(alb_new) from coupler
[782]	287	!
	288	!****************************************************************************************
	289
	290	CALL cpl_receive_seaice_fields(knon, knindex, &
[1146]	291	tsurf_cpl, alb_cpl, u0, v0)
[888]	292
	293	alb1_new(1:knon) = alb_cpl(1:knon)
	294	alb2_new(1:knon) = alb_cpl(1:knon)
	295
[782]	296
	297	!****************************************************************************************
	298	! Calculate fluxes at surface
	299	!
	300	!****************************************************************************************
	301	cal = 0.
	302	dif_grnd = 0.
	303	beta = 1.0
	304
[1146]	305	DO i = 1, knon
	306	u1_lay(i) = u1(i) - u0(i)
	307	v1_lay(i) = v1(i) - v0(i)
	308	END DO
[782]	309
	310	CALL calcul_fluxs(knon, is_sic, dtime, &
[2254]	311	tsurf_cpl, p1lay, cal, beta, cdragh, cdragh, ps, &
[782]	312	precip_rain, precip_snow, snow, qsurf, &
[2240]	313	radsol, dif_grnd, temp_air, spechum, u1_lay, v1_lay, gustiness, &
[2254]	314	f_qsat_oce,AcoefH, AcoefQ, BcoefH, BcoefQ, &
[2538]	315	tsurf_new, evap, fluxlat, fluxsens, dflux_s, dflux_l, &
	316	sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
	317	do j = 1, knon
	318	i = knindex(j)
	319	sens_prec_liq_o(i,2) = sens_prec_liq(j)
	320	sens_prec_sol_o(i,2) = sens_prec_sol(j)
	321	lat_prec_liq_o(i,2) = lat_prec_liq(j)
	322	lat_prec_sol_o(i,2) = lat_prec_sol(j)
	323	enddo
[782]	324
[1067]	325
	326	! - Flux calculation at first modele level for U and V
	327	CALL calcul_flux_wind(knon, dtime, &
[2240]	328	u0, v0, u1, v1, gustiness, cdragm, &
[1067]	329	AcoefU, AcoefV, BcoefU, BcoefV, &
	330	p1lay, temp_air, &
	331	flux_u1, flux_v1)
	332
[782]	333	!****************************************************************************************
	334	! Calculate fder : flux derivative (sensible and latente)
	335	!
	336	!****************************************************************************************
	337	fder_new(:) = fder_old(:) + dflux_s(:) + dflux_l(:)
	338
	339	iloc = MAXLOC(fder_new(1:klon))
	340	IF (check .AND. fder_new(iloc(1))> 0.) THEN
	341	WRITE(,)'** Debug fder **'
	342	WRITE(,)'max fder(',iloc(1),') = ',fder_new(iloc(1))
	343	WRITE(,)'fder_old, dflux_s, dflux_l',fder_old(iloc(1)), &
	344	dflux_s(iloc(1)), dflux_l(iloc(1))
	345	ENDIF
	346
	347	!****************************************************************************************
	348	! Send and cumulate fields to the coupler
	349	!
	350	!****************************************************************************************
	351
	352	CALL cpl_send_seaice_fields(itime, dtime, knon, knindex, &
[996]	353	pctsrf, lafin, rlon, rlat, &
[888]	354	swnet, lwnet, fluxlat, fluxsens, &
[2545]	355	precip_rain, precip_snow, evap, tsurf_new, fder_new, alb1, flux_u1, flux_v1 &
	356	)
	357	! ,sens_prec_liq, sens_prec_sol, lat_prec_liq, lat_prec_sol)
[2538]	358
[782]	359
	360
	361	END SUBROUTINE ocean_cpl_ice
	362	!
	363	!****************************************************************************************
	364	!
	365	END MODULE ocean_cpl_mod

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

Download in other formats:

Original Format