Context Navigation

ocean_cpl_mod.f90 @ 5421

Last change on this file since 5421 was 5285, checked in by abarral, 8 weeks ago
As discussed internally, remove generic ONLY: ... for new _mod_h modules
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:keywords set to `Id`
File size: 15.5 KB

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

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

Download in other formats:

Original Format