New URL for NEMO forge! http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.

traqsr.F90 in trunk/NEMO/OPA_SRC/TRA – NEMO

Context Navigation

source: trunk/NEMO/OPA_SRC/TRA/traqsr.F90 @ 193

Last change on this file since 193 was 187, checked in by opalod, 20 years ago
CL + CE : UPDATE129 : for use of tracer component
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 14.8 KB

Line
1	MODULE traqsr
2	!!======================================================================
3	!! * MODULE traqsr *
4	!! Ocean physics: solar radiation penetration in the top ocean levels
5	!!======================================================================
6
7	!!----------------------------------------------------------------------
8	!! tra_qsr : trend due to the solar radiation penetration
9	!! tra_qsr_init : solar radiation penetration initialization
10	!!----------------------------------------------------------------------
11	!! * Modules used
12	USE oce ! ocean dynamics and active tracers
13	USE dom_oce ! ocean space and time domain
14	USE trdtra_oce ! ocean active tracer trends
15	USE in_out_manager ! I/O manager
16
17	USE trc_oce ! share SMS/Ocean variables
18
19	USE ocesbc ! thermohaline fluxes
20	USE phycst ! physical constants
21
22	IMPLICIT NONE
23	PRIVATE
24
25	!! * Routine accessibility
26	PUBLIC tra_qsr ! routine called by step.F90 (ln_traqsr=T)
27	PUBLIC tra_qsr_init ! routine called by opa.F90
28
29	!! * Shared module variables
30	LOGICAL, PUBLIC :: ln_traqsr = .TRUE. !: qsr flag (Default=T)
31
32	!! * Module variables
33	REAL(wp), PUBLIC :: & !!! * penetrative solar radiation namelist *
34	rabs = 0.58_wp, & ! fraction associated with xsi1
35	xsi1 = 0.35_wp, & ! first depth of extinction
36	xsi2 = 23.0_wp ! second depth of extinction
37	! ! (default values: water type Ib)
38	LOGICAL :: &
39	ln_qsr_sms = .false. ! flag to use or not the biological
40	! ! fluxes for light
41
42	INTEGER :: &
43	nksr ! number of levels
44	REAL(wp), DIMENSION(jpk) :: &
45	gdsr ! profile of the solar flux penetration
46
47	!! * Substitutions
48	# include "domzgr_substitute.h90"
49	# include "vectopt_loop_substitute.h90"
50	!!----------------------------------------------------------------------
51	!! OPA 9.0 , LODYC-IPSL (2003)
52	!!----------------------------------------------------------------------
53
54	CONTAINS
55
56	SUBROUTINE tra_qsr( kt )
57	!!----------------------------------------------------------------------
58	!! * ROUTINE tra_qsr *
59	!!
60	!! ** Purpose : Compute the temperature trend due to the solar radiation
61	!! penetration and add it to the general temperature trend.
62	!!
63	!! ** Method : The profile of the solar radiation within the ocean is
64	!! defined through two penetration length scale (xsr1,xsr2) and a
65	!! ratio (rabs) as :
66	!! I(k) = Qsr( rabsEXP(z(k)/xsr1) + (1.-rabs)*EXP(z(k)/xsr2) )
67	!! The temperature trend associated with the solar radiation
68	!! penetration is given by :
69	!! zta = 1/e3t dk[ I ] / (rau0*Cp)
70	!! At the bottom, boudary condition for the radiation is no flux :
71	!! all heat which has not been absorbed in the above levels is put
72	!! in the last ocean level.
73	!! In z-coordinate case, the computation is only done down to the
74	!! level where I(k) < 1.e-15 W/m2. In addition, the coefficients
75	!! used for the computation are calculated one for once as they
76	!! depends on k only.
77	!!
78	!! ** Action : - update ta with the penetrative solar radiation trend
79	!! - save the trend in ttrd ('key_trdtra')
80	!!
81	!! History :
82	!! 6.0 ! 90-10 (B. Blanke) Original code
83	!! 7.0 ! 91-11 (G. Madec)
84	!! ! 96-01 (G. Madec) s-coordinates
85	!! 8.5 ! 02-06 (G. Madec) F90: Free form and module
86	!!----------------------------------------------------------------------
87	!! * Arguments
88	INTEGER, INTENT( in ) :: kt ! ocean time-step
89
90	!! * Local declarations
91	INTEGER :: ji, jj, jk ! dummy loop indexes
92	REAL(wp) :: zc0, zta ! temporary scalars
93	REAL(wp) :: zc1 , zc2 , & ! temporary scalars
94	zdp1, zdp2 !
95	!!----------------------------------------------------------------------
96
97	IF( kt == nit000 ) THEN
98	IF ( lwp ) WRITE(numout,*)
99	IF ( lwp ) WRITE(numout,*) 'tra_qsr : penetration of the surface solar radiation'
100	IF ( lwp ) WRITE(numout,*) '~~~~~~~'
101	ENDIF
102
103	IF( lk_qsr_sms .AND. ln_qsr_sms ) THEN ! Biological fluxes !
104	! ! =================== !
105	!
106	! ! ===============
107	DO jk = 1, jpkm1 ! Horizontal slab
108	! ! ===============
109	DO jj = 2, jpjm1
110	DO ji = fs_2, fs_jpim1 ! vector opt.
111
112	zc0 = ro0cpr / fse3t(ji,jj,jk) ! compute the qsr trend
113	zta = zc0 * ( etot3(ji,jj,jk ) * tmask(ji,jj,jk) &
114	& - etot3(ji,jj,jk+1) * tmask(ji,jj,jk+1) )
115
116	ta(ji,jj,jk) = ta(ji,jj,jk) + zta ! add qsr trend to the temperature trend
117
118	# if defined key_trdtra \|\| defined key_trdmld
119	ttrd(ji,jj,jk,7) = zta ! save the qsr trend
120	# endif
121	END DO
122	END DO
123	! ! ===============
124	END DO ! End of slab
125	! ! ===============
126	ELSE
127	! ! =================== !
128	IF( lk_sco ) THEN ! s-coordinate !
129	! ! =================== !
130	!
131	! ! ===============
132	DO jk = 1, jpkm1 ! Horizontal slab
133	! ! ===============
134	DO jj = 2, jpjm1
135	DO ji = fs_2, fs_jpim1 ! vector opt.
136
137	zdp1 = -fsdepw(ji,jj,jk ) ! compute the qsr trend
138	zdp2 = -fsdepw(ji,jj,jk+1)
139	zc0 = qsr(ji,jj) * ro0cpr / fse3t(ji,jj,jk)
140	zc1 = ( rabs * EXP(zdp1/xsi1) + (1.-rabs) * EXP(zdp1/xsi2) )
141	zc2 = - ( rabs * EXP(zdp2/xsi1) + (1.-rabs) * EXP(zdp2/xsi2) )
142	zta = zc0 * ( zc1 * tmask(ji,jj,jk) + zc2 * tmask(ji,jj,jk+1) )
143
144	ta(ji,jj,jk) = ta(ji,jj,jk) + zta ! add qsr trend to the temperature trend
145
146	# if defined key_trdtra \|\| defined key_trdmld
147	ttrd(ji,jj,jk,7) = zta ! save the qsr trend
148	# endif
149	END DO
150	END DO
151	! ! ===============
152	END DO ! End of slab
153	! ! ===============
154	ENDIF
155	! ! =================== !
156	IF( lk_zps ) THEN ! partial steps !
157	! ! =================== !
158	!
159	! ! ===============
160	DO jk = 1, nksr ! Horizontal slab
161	! ! ===============
162	DO jj = 2, jpjm1
163	DO ji = fs_2, fs_jpim1 ! vector opt.
164
165	zc0 = qsr(ji,jj) / fse3t(ji,jj,jk) ! compute the qsr trend
166	zta = zc0 * ( gdsr(jk) * tmask(ji,jj,jk) - gdsr(jk+1) * tmask(ji,jj,jk+1) )
167
168	ta(ji,jj,jk) = ta(ji,jj,jk) + zta ! add qsr trend to the temperature trend
169
170	# if defined key_trdtra \|\| defined key_trdmld
171	ttrd(ji,jj,jk,7) = zta ! save the qsr trend
172	# endif
173	END DO
174	END DO
175	! ! ===============
176	END DO ! End of slab
177	! ! ===============
178	ENDIF
179	! ! =================== !
180	IF( lk_zco ) THEN ! z-coordinate !
181	! ! =================== !
182	!
183	! ! ===============
184	DO jk = 1, nksr ! Horizontal slab
185	! ! ===============
186	zc0 = 1. / fse3t(1,1,jk)
187	DO jj = 2, jpjm1
188	DO ji = fs_2, fs_jpim1 ! vector opt.
189	! ! compute qsr forcing trend
190	zta = qsr(ji,jj) * zc0 * ( gdsr(jk)tmask(ji,jj,jk) - gdsr(jk+1)tmask(ji,jj,jk+1) )
191
192	ta(ji,jj,jk) = ta(ji,jj,jk) + zta ! add qsr trend to the temperature trend
193
194	# if defined key_trdtra \|\| defined key_trdmld
195	ttrd(ji,jj,jk,7) = zta ! save the qsr forcing trend
196	# endif
197	END DO
198	END DO
199	! ! ===============
200	END DO ! End of slab
201	! ! ===============
202	ENDIF
203	!
204	ENDIF
205
206
207	IF( l_ctl .AND. lwp ) THEN ! print mean trends (used for debugging)
208	! zta = SUM( ta(2:jpim1,2:jpjm1,1:jpkm1) * tmask(2:jpim1,2:jpjm1,1:jpkm1) )
209	! zta = SUM( ta * tmask )
210	zta = SUM( ta(2:nictl,2:njctl,1:jpkm1) * tmask(2:nictl,2:njctl,1:jpkm1) )
211	WRITE(numout,*) ' qsr - Ta: ', zta-t_ctl
212	t_ctl = zta
213	ENDIF
214
215
216	! 2. Substract qsr from the total heat flux q
217	! -------------------------------------------
218	DO jj = 2, jpjm1
219	DO ji = fs_2, fs_jpim1 ! vector opt.
220	q(ji,jj) = qt(ji,jj) - qsr(ji,jj)
221	END DO
222	END DO
223
224	END SUBROUTINE tra_qsr
225
226
227	SUBROUTINE tra_qsr_init
228	!!----------------------------------------------------------------------
229	!! * ROUTINE tra_qsr_init *
230	!!
231	!! ** Purpose : Initialization for the penetrative solar radiation
232	!!
233	!! ** Method : The profile of solar radiation within the ocean is set
234	!! from two length scale of penetration (xsr1,xsr2) and a ratio
235	!! (rabs). These parameters are read in the namqsr namelist. The
236	!! default values correspond to clear water (type I in Jerlov'
237	!! (1968) classification.
238	!! called by tra_qsr at the first timestep (nit000)
239	!!
240	!! ** Action : - initialize xsr1, xsr2 and rabs
241	!!
242	!! Reference :
243	!! Jerlov, N. G., 1968 Optical Oceanography, Elsevier, 194pp.
244	!!
245	!! History :
246	!! 8.5 ! 02-06 (G. Madec) Original code
247	!!----------------------------------------------------------------------
248	!! * Local declarations
249	INTEGER :: ji,jj,jk, & ! dummy loop index
250	indic ! temporary integer
251	REAL(wp) :: zdp1 ! temporary scalar
252
253	NAMELIST/namqsr/ ln_traqsr, rabs, xsi1, xsi2, ln_qsr_sms
254	!!----------------------------------------------------------------------
255
256	! Read Namelist namqsr : ratio and length of penetration
257	! --------------------
258	REWIND ( numnam )
259	READ ( numnam, namqsr )
260
261	! Parameter control and print
262	! ---------------------------
263	IF( ln_traqsr ) THEN
264	IF ( lwp ) THEN
265	WRITE(numout,*)
266	WRITE(numout,*) 'tra_qsr_init : penetration of the surface solar radiation'
267	WRITE(numout,*) '~~~~~~~~~~~~'
268	WRITE(numout,*) ' Namelist namqsr : set the parameter of penetration'
269	WRITE(numout,*) ' fraction associated with xsi rabs = ',rabs
270	WRITE(numout,*) ' first depth of extinction xsi1 = ',xsi1
271	WRITE(numout,*) ' second depth of extinction xsi2 = ',xsi2
272	IF( lk_qsr_sms ) THEN
273	WRITE(numout,*) ' Biological fluxes for light(Y/N) ln_qsr_sms = ',ln_qsr_sms
274	ENDIF
275	WRITE(numout,*) ' '
276	END IF
277	ELSE
278	IF ( lwp ) THEN
279	WRITE(numout,*)
280	WRITE(numout,*) 'tra_qsr_init : NO solar flux penetration'
281	WRITE(numout,*) '~~~~~~~~~~~~'
282	END IF
283	ENDIF
284
285	IF( rabs > 1.e0 .OR. rabs < 0.e0 .OR. xsi1 < 0.e0 .OR. xsi2 < 0.e0 ) THEN
286	IF(lwp) WRITE(numout,cform_err)
287	IF(lwp) WRITE(numout,*) ' 0<rabs<1, 0<xsi1, or 0<xsi2 not satisfied'
288	nstop = nstop + 1
289	ENDIF
290
291
292	! Initialization
293	! --------------
294	IF( .NOT. lk_sco ) THEN
295	! z-coordinate with or without partial step : same before last ocean w-level everywhere
296	DO jk = 1, jpk
297	zdp1 = -fsdepw(1,1,jk)
298	gdsr(jk) = ro0cpr * ( rabs * EXP( zdp1/xsi1 ) + (1.-rabs) * EXP( zdp1/xsi2 ) )
299	END DO
300	indic = 0
301	DO jk = 1, jpk
302	IF( gdsr(jk) <= 1.e-15 .AND. indic == 0 ) THEN
303	gdsr(jk) = 0.e0
304	nksr = jk
305	!!bug Edmee chg res nksr = jk - 1
306	indic = 1
307	ENDIF
308	END DO
309	nksr = MIN( nksr, jpkm1 )
310	IF(lwp) THEN
311	WRITE(numout,*)
312	WRITE(numout,*) ' - z-coordinate, level max of computation =', nksr
313	WRITE(numout,*) ' profile of coef. of penetration:'
314	WRITE(numout,"(' ',7e11.2)") ( gdsr(jk), jk = 1, nksr )
315	WRITE(numout,*)
316	ENDIF
317	! Initialisation of Biological fluxes for light here because
318	! the optical biological model is call after the dynamical one
319	IF( lk_qsr_sms .AND. ln_qsr_sms ) THEN
320	DO jk = 1, jpkm1
321	DO jj = 1, jpj
322	DO ji = 1, jpi
323	etot3(ji,jj,jk) = qsr(ji,jj) * gdsr(jk) * tmask(ji,jj,jk) / ro0cpr
324	END DO
325	END DO
326	END DO
327	ENDIF
328
329	ENDIF
330
331	END SUBROUTINE tra_qsr_init
332
333	!!======================================================================
334	END MODULE traqsr

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

Download in other formats: