Context Navigation

surf_seaice_mod.F90 @ 5428

Last change on this file since 5428 was 3815, checked in by lguez, 4 years ago
Merge Ocean_skin branch back into trunk
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 `Author Date Id Revision`
File size: 7.2 KB

Line
1	!
2	! $Id: surf_seaice_mod.F90 3815 2021-02-01 14:30:57Z fhourdin $
3	!
4	MODULE surf_seaice_mod
5
6	IMPLICIT NONE
7
8	CONTAINS
9	!
10	!****************************************************************************************
11	!
12	SUBROUTINE surf_seaice( &
13	rlon, rlat, swnet, lwnet, alb1, fder, &
14	itime, dtime, jour, knon, knindex, &
15	lafin, &
16	tsurf, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
17	AcoefH, AcoefQ, BcoefH, BcoefQ, &
18	AcoefU, AcoefV, BcoefU, BcoefV, &
19	ps, u1, v1, gustiness, pctsrf, &
20	snow, qsurf, qsol, agesno, tsoil, &
21	z0m, z0h, SFRWL, alb_dir_new, alb_dif_new, evap, fluxsens, fluxlat, &
22	tsurf_new, dflux_s, dflux_l, &
23	flux_u1, flux_v1)
24
25	USE dimphy
26	USE surface_data
27	USE ocean_forced_mod, ONLY : ocean_forced_ice
28	USE ocean_cpl_mod, ONLY : ocean_cpl_ice
29	USE ocean_slab_mod, ONLY : ocean_slab_ice
30	USE indice_sol_mod
31
32	!
33	! This subroutine will make a call to ocean_XXX_ice according to the ocean mode (force,
34	! slab or couple). The calculation of rugosity for the sea-ice surface is also done
35	! in here because it is the same calculation for the different modes of ocean.
36	!
37	INCLUDE "dimsoil.h"
38	INCLUDE "clesphys.h"
39
40	INCLUDE "YOMCST.h"
41	! for rd and retv
42
43	! Input arguments
44	!****************************************************************************************
45	INTEGER, INTENT(IN) :: itime, jour, knon
46	INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
47	LOGICAL, INTENT(IN) :: lafin
48	REAL, INTENT(IN) :: dtime
49	REAL, DIMENSION(klon), INTENT(IN) :: rlon, rlat
50	REAL, DIMENSION(klon), INTENT(IN) :: swnet ! net shortwave radiation at surface
51	REAL, DIMENSION(klon), INTENT(IN) :: lwnet ! net longwave radiation at surface
52	REAL, DIMENSION(klon), INTENT(IN) :: alb1 ! albedo in visible SW interval
53	REAL, DIMENSION(klon), INTENT(IN) :: fder
54	REAL, DIMENSION(klon), INTENT(IN) :: tsurf
55	REAL, DIMENSION(klon), INTENT(IN) :: p1lay
56	REAL, DIMENSION(klon), INTENT(IN) :: cdragh, cdragm
57	REAL, DIMENSION(klon), INTENT(IN) :: precip_rain, precip_snow
58	REAL, DIMENSION(klon), INTENT(IN) :: temp_air, spechum
59	REAL, DIMENSION(klon), INTENT(IN) :: AcoefH, AcoefQ, BcoefH, BcoefQ
60	REAL, DIMENSION(klon), INTENT(IN) :: AcoefU, AcoefV, BcoefU, BcoefV
61	REAL, DIMENSION(klon), INTENT(IN) :: ps
62	REAL, DIMENSION(klon), INTENT(IN) :: u1, v1, gustiness
63	REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
64
65	! In/Output arguments
66	!****************************************************************************************
67	REAL, DIMENSION(klon), INTENT(INOUT) :: snow, qsurf, qsol
68	REAL, DIMENSION(klon), INTENT(INOUT) :: agesno
69	REAL, DIMENSION(klon, nsoilmx), INTENT(INOUT) :: tsoil
70
71	! Output arguments
72	!****************************************************************************************
73	REAL, DIMENSION(klon), INTENT(OUT) :: z0m, z0h
74	!albedo SB >>>
75	! REAL, DIMENSION(klon), INTENT(OUT) :: alb1_new ! new albedo in visible SW interval
76	! REAL, DIMENSION(klon), INTENT(OUT) :: alb2_new ! new albedo in near IR interval
77	REAL, DIMENSION(6), INTENT(IN) :: SFRWL
78	REAL, DIMENSION(klon,nsw), INTENT(OUT) :: alb_dir_new,alb_dif_new
79	!albedo SB <<<
80	REAL, DIMENSION(klon), INTENT(OUT) :: evap, fluxsens, fluxlat
81	REAL, DIMENSION(klon), INTENT(OUT) :: tsurf_new
82	REAL, DIMENSION(klon), INTENT(OUT) :: dflux_s, dflux_l
83	REAL, DIMENSION(klon), INTENT(OUT) :: flux_u1, flux_v1
84
85	! Local arguments
86	!****************************************************************************************
87	REAL, DIMENSION(klon) :: radsol
88
89	!albedo SB >>>
90	REAL, DIMENSION(klon) :: alb1_new,alb2_new
91	!albedo SB <<<
92
93	real rhoa(knon) ! density of moist air (kg / m3)
94
95	! End definitions
96	!****************************************************************************************
97
98
99	!****************************************************************************************
100	! Calculate total net radiance at surface
101	!
102	!****************************************************************************************
103	radsol(:) = 0.0
104	radsol(1:knon) = swnet(1:knon) + lwnet(1:knon)
105
106	rhoa = PS(:KNON) / (Rd * temp_air(:knon) * (1. + retv * spechum(:knon)))
107
108	!****************************************************************************************
109	! Switch according to type of ocean (couple, slab or forced)
110	!
111	!****************************************************************************************
112	IF (type_ocean == 'couple') THEN
113
114	CALL ocean_cpl_ice( &
115	rlon, rlat, swnet, lwnet, alb1, &
116	fder, &
117	itime, dtime, knon, knindex, &
118	lafin,&
119	p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum,&
120	AcoefH, AcoefQ, BcoefH, BcoefQ, &
121	AcoefU, AcoefV, BcoefU, BcoefV, &
122	ps, u1, v1, gustiness, pctsrf, &
123	radsol, snow, qsurf, &
124	alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
125	tsurf_new, dflux_s, dflux_l, rhoa)
126
127	ELSE IF (type_ocean == 'slab'.AND.version_ocean=='sicINT') THEN
128	CALL ocean_slab_ice( &
129	itime, dtime, jour, knon, knindex, &
130	tsurf, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum,&
131	AcoefH, AcoefQ, BcoefH, BcoefQ, &
132	AcoefU, AcoefV, BcoefU, BcoefV, &
133	ps, u1, v1, gustiness, &
134	radsol, snow, qsurf, qsol, agesno, &
135	alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
136	tsurf_new, dflux_s, dflux_l, swnet)
137
138	ELSE ! type_ocean=force or slab +sicOBS or sicNO
139	CALL ocean_forced_ice( &
140	itime, dtime, jour, knon, knindex, &
141	tsurf, p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum,&
142	AcoefH, AcoefQ, BcoefH, BcoefQ, &
143	AcoefU, AcoefV, BcoefU, BcoefV, &
144	ps, u1, v1, gustiness, &
145	radsol, snow, qsol, agesno, tsoil, &
146	qsurf, alb1_new, alb2_new, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
147	tsurf_new, dflux_s, dflux_l, rhoa)
148
149	END IF
150
151	!****************************************************************************************
152	! Calculate rugosity
153	!
154	!****************************************************************************************
155
156	z0m=z0m_seaice
157	z0h = z0h_seaice
158
159	!albedo SB >>>
160	select case(NSW)
161	case(2)
162	alb_dir_new(1:knon,1)=alb1_new(1:knon)
163	alb_dir_new(1:knon,2)=alb2_new(1:knon)
164	case(4)
165	alb_dir_new(1:knon,1)=alb1_new(1:knon)
166	alb_dir_new(1:knon,2)=alb2_new(1:knon)
167	alb_dir_new(1:knon,3)=alb2_new(1:knon)
168	alb_dir_new(1:knon,4)=alb2_new(1:knon)
169	case(6)
170	alb_dir_new(1:knon,1)=alb1_new(1:knon)
171	alb_dir_new(1:knon,2)=alb1_new(1:knon)
172	alb_dir_new(1:knon,3)=alb1_new(1:knon)
173	alb_dir_new(1:knon,4)=alb2_new(1:knon)
174	alb_dir_new(1:knon,5)=alb2_new(1:knon)
175	alb_dir_new(1:knon,6)=alb2_new(1:knon)
176	end select
177	alb_dif_new=alb_dir_new
178	!albedo SB <<<
179
180
181
182
183	END SUBROUTINE surf_seaice
184	!
185	!****************************************************************************************
186	!
187	END MODULE surf_seaice_mod
188

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

Download in other formats:

Original Format