Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

trc_oce.F90

Last change on this file was 11101, checked in by frrh, 5 years ago

Merge changes from Met Office GMED ticket 450 to reduce unnecessary
text output from NEMO.
This output, which is typically not switchable, is rarely of interest
in normal (non-debugging) runs and simply redunantley consumes extra
file space.
Further, the presence of this text output has been shown to
significantly degrade performance of models which are run during
Met Office HPC RAID (disk) checks.
The new code introduces switches which are configurable via the
changes made in the associated Met Office MOCI ticket 399.

File size: 17.7 KB

Line
1	MODULE trc_oce
2	!!======================================================================
3	!! * MODULE trc_oce *
4	!! Ocean passive tracer : share SMS/Ocean variables
5	!!======================================================================
6	!! History : 1.0 ! 2004-03 (C. Ethe) Original code
7	!!----------------------------------------------------------------------
8
9	!!----------------------------------------------------------------------
10	!! trc_oce_rgb : tabulated attenuation coefficients for RGB light penetration
11	!!----------------------------------------------------------------------
12	USE par_oce
13	USE in_out_manager ! I/O manager
14	USE dom_oce ! ocean space and time domain
15	USE lib_mpp ! MPP library
16
17	IMPLICIT NONE
18	PRIVATE
19
20	PUBLIC trc_oce_rgb ! routine called by traqsr.F90
21	PUBLIC trc_oce_rgb_read ! routine called by traqsr.F90
22	PUBLIC trc_oce_ext_lev ! function called by traqsr.F90 at least
23	PUBLIC trc_oce_alloc ! function called by nemogcm.F90
24
25	INTEGER , PUBLIC :: nn_dttrc !: frequency of step on passive tracers
26	REAL(wp), PUBLIC :: r_si2 !: largest depth of extinction (blue & 0.01 mg.m-3) (RGB)
27	REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: etot3 !: light absortion coefficient
28	REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: facvol !: volume for degraded regions
29
30	#if defined key_top
31	!!----------------------------------------------------------------------
32	!! 'key_top' bio-model
33	!!----------------------------------------------------------------------
34	LOGICAL, PUBLIC, PARAMETER :: lk_top = .TRUE. !: TOP model
35	LOGICAL, PUBLIC, PARAMETER :: lk_qsr_bio = .TRUE. !: bio-model light absorption flag
36	#else
37	!!----------------------------------------------------------------------
38	!! Default option No bio-model light absorption
39	!!----------------------------------------------------------------------
40	LOGICAL, PUBLIC, PARAMETER :: lk_top = .FALSE. !: TOP model
41	LOGICAL, PUBLIC, PARAMETER :: lk_qsr_bio = .FALSE. !: bio-model light absorption flag
42	#endif
43
44	#if defined key_offline
45	!!----------------------------------------------------------------------
46	!! 'key_offline' OFFLINE mode
47	!!----------------------------------------------------------------------
48	LOGICAL, PUBLIC, PARAMETER :: lk_offline = .TRUE. !: offline flag
49	#else
50	!!----------------------------------------------------------------------
51	!! Default option NO OFFLINE mode
52	!!----------------------------------------------------------------------
53	LOGICAL, PUBLIC, PARAMETER :: lk_offline = .FALSE. !: offline flag
54	#endif
55	#if defined key_degrad
56	!!----------------------------------------------------------------------
57	!! 'key_degrad' Degradation mode
58	!!----------------------------------------------------------------------
59	LOGICAL, PUBLIC, PARAMETER :: lk_degrad = .TRUE. !: degradation flag
60	#else
61	!!----------------------------------------------------------------------
62	!! Default option NO Degradation mode
63	!!----------------------------------------------------------------------
64	LOGICAL, PUBLIC, PARAMETER :: lk_degrad = .FALSE. !: degradation flag
65	#endif
66
67	!! * Substitutions
68	# include "domzgr_substitute.h90"
69	!!----------------------------------------------------------------------
70	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
71	!! $Id$
72	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
73	!!----------------------------------------------------------------------
74	CONTAINS
75
76	INTEGER FUNCTION trc_oce_alloc()
77	!!----------------------------------------------------------------------
78	!! * trc_oce_alloc *
79	!!----------------------------------------------------------------------
80	INTEGER :: ierr(2) ! Local variables
81	!!----------------------------------------------------------------------
82	ierr(:) = 0
83	ALLOCATE( etot3 (jpi,jpj,jpk), STAT=ierr(1) )
84	IF( lk_degrad) ALLOCATE( facvol(jpi,jpj,jpk), STAT=ierr(2) )
85	trc_oce_alloc = MAXVAL( ierr )
86	!
87	IF( trc_oce_alloc /= 0 ) CALL ctl_warn('trc_oce_alloc: failed to allocate etot3 array')
88	END FUNCTION trc_oce_alloc
89
90
91	SUBROUTINE trc_oce_rgb( prgb )
92	!!---------------------------------------------------------------------
93	!! * ROUTINE p4z_opt_init *
94	!!
95	!! ** Purpose : Initialization of of the optical scheme
96	!!
97	!! ** Method : Set a look up table for the optical coefficients
98	!! i.e. the attenuation coefficient for R-G-B light
99	!! tabulated in Chlorophyll class (from JM Andre)
100	!!
101	!! ** Action : prgb(3,61) tabulated R-G-B attenuation coef.
102	!!
103	!! Reference : Lengaigne et al. 2007, Clim. Dyn., V28, 5, 503-516.
104	!!----------------------------------------------------------------------
105	REAL(wp), DIMENSION(3,61), INTENT(out) :: prgb ! tabulated attenuation coefficient
106	!!
107	INTEGER :: jc ! dummy loop indice
108	INTEGER :: irgb ! temporary integer
109	REAL(wp) :: zchl ! temporary scalar
110	REAL(wp), DIMENSION(4,61) :: zrgb ! tabulated attenuation coefficient (formerly read in 'kRGB61.txt')
111	!!----------------------------------------------------------------------
112	!
113	IF(lwp) THEN
114	WRITE(numout,*)
115	WRITE(numout,*) 'trc_oce_rgb : Initialisation of the optical look-up table'
116	WRITE(numout,*) '~~~~~~~~~~~ '
117	IF(lflush) CALL flush(numout)
118	ENDIF
119	!
120	! Chlorophyll ! Blue attenuation ! Green attenuation ! Red attenuation !
121	zrgb(1, 1) = 0.010 ; zrgb(2, 1) = 0.01618 ; zrgb(3, 1) = 0.07464 ; zrgb(4, 1) = 0.37807
122	zrgb(1, 2) = 0.011 ; zrgb(2, 2) = 0.01654 ; zrgb(3, 2) = 0.07480 ; zrgb(4, 2) = 0.37823
123	zrgb(1, 3) = 0.013 ; zrgb(2, 3) = 0.01693 ; zrgb(3, 3) = 0.07499 ; zrgb(4, 3) = 0.37840
124	zrgb(1, 4) = 0.014 ; zrgb(2, 4) = 0.01736 ; zrgb(3, 4) = 0.07518 ; zrgb(4, 4) = 0.37859
125	zrgb(1, 5) = 0.016 ; zrgb(2, 5) = 0.01782 ; zrgb(3, 5) = 0.07539 ; zrgb(4, 5) = 0.37879
126	zrgb(1, 6) = 0.018 ; zrgb(2, 6) = 0.01831 ; zrgb(3, 6) = 0.07562 ; zrgb(4, 6) = 0.37900
127	zrgb(1, 7) = 0.020 ; zrgb(2, 7) = 0.01885 ; zrgb(3, 7) = 0.07586 ; zrgb(4, 7) = 0.37923
128	zrgb(1, 8) = 0.022 ; zrgb(2, 8) = 0.01943 ; zrgb(3, 8) = 0.07613 ; zrgb(4, 8) = 0.37948
129	zrgb(1, 9) = 0.025 ; zrgb(2, 9) = 0.02005 ; zrgb(3, 9) = 0.07641 ; zrgb(4, 9) = 0.37976
130	zrgb(1,10) = 0.028 ; zrgb(2,10) = 0.02073 ; zrgb(3,10) = 0.07672 ; zrgb(4,10) = 0.38005
131	zrgb(1,11) = 0.032 ; zrgb(2,11) = 0.02146 ; zrgb(3,11) = 0.07705 ; zrgb(4,11) = 0.38036
132	zrgb(1,12) = 0.035 ; zrgb(2,12) = 0.02224 ; zrgb(3,12) = 0.07741 ; zrgb(4,12) = 0.38070
133	zrgb(1,13) = 0.040 ; zrgb(2,13) = 0.02310 ; zrgb(3,13) = 0.07780 ; zrgb(4,13) = 0.38107
134	zrgb(1,14) = 0.045 ; zrgb(2,14) = 0.02402 ; zrgb(3,14) = 0.07821 ; zrgb(4,14) = 0.38146
135	zrgb(1,15) = 0.050 ; zrgb(2,15) = 0.02501 ; zrgb(3,15) = 0.07866 ; zrgb(4,15) = 0.38189
136	zrgb(1,16) = 0.056 ; zrgb(2,16) = 0.02608 ; zrgb(3,16) = 0.07914 ; zrgb(4,16) = 0.38235
137	zrgb(1,17) = 0.063 ; zrgb(2,17) = 0.02724 ; zrgb(3,17) = 0.07967 ; zrgb(4,17) = 0.38285
138	zrgb(1,18) = 0.071 ; zrgb(2,18) = 0.02849 ; zrgb(3,18) = 0.08023 ; zrgb(4,18) = 0.38338
139	zrgb(1,19) = 0.079 ; zrgb(2,19) = 0.02984 ; zrgb(3,19) = 0.08083 ; zrgb(4,19) = 0.38396
140	zrgb(1,20) = 0.089 ; zrgb(2,20) = 0.03131 ; zrgb(3,20) = 0.08149 ; zrgb(4,20) = 0.38458
141	zrgb(1,21) = 0.100 ; zrgb(2,21) = 0.03288 ; zrgb(3,21) = 0.08219 ; zrgb(4,21) = 0.38526
142	zrgb(1,22) = 0.112 ; zrgb(2,22) = 0.03459 ; zrgb(3,22) = 0.08295 ; zrgb(4,22) = 0.38598
143	zrgb(1,23) = 0.126 ; zrgb(2,23) = 0.03643 ; zrgb(3,23) = 0.08377 ; zrgb(4,23) = 0.38676
144	zrgb(1,24) = 0.141 ; zrgb(2,24) = 0.03842 ; zrgb(3,24) = 0.08466 ; zrgb(4,24) = 0.38761
145	zrgb(1,25) = 0.158 ; zrgb(2,25) = 0.04057 ; zrgb(3,25) = 0.08561 ; zrgb(4,25) = 0.38852
146	zrgb(1,26) = 0.178 ; zrgb(2,26) = 0.04289 ; zrgb(3,26) = 0.08664 ; zrgb(4,26) = 0.38950
147	zrgb(1,27) = 0.200 ; zrgb(2,27) = 0.04540 ; zrgb(3,27) = 0.08775 ; zrgb(4,27) = 0.39056
148	zrgb(1,28) = 0.224 ; zrgb(2,28) = 0.04811 ; zrgb(3,28) = 0.08894 ; zrgb(4,28) = 0.39171
149	zrgb(1,29) = 0.251 ; zrgb(2,29) = 0.05103 ; zrgb(3,29) = 0.09023 ; zrgb(4,29) = 0.39294
150	zrgb(1,30) = 0.282 ; zrgb(2,30) = 0.05420 ; zrgb(3,30) = 0.09162 ; zrgb(4,30) = 0.39428
151	zrgb(1,31) = 0.316 ; zrgb(2,31) = 0.05761 ; zrgb(3,31) = 0.09312 ; zrgb(4,31) = 0.39572
152	zrgb(1,32) = 0.355 ; zrgb(2,32) = 0.06130 ; zrgb(3,32) = 0.09474 ; zrgb(4,32) = 0.39727
153	zrgb(1,33) = 0.398 ; zrgb(2,33) = 0.06529 ; zrgb(3,33) = 0.09649 ; zrgb(4,33) = 0.39894
154	zrgb(1,34) = 0.447 ; zrgb(2,34) = 0.06959 ; zrgb(3,34) = 0.09837 ; zrgb(4,34) = 0.40075
155	zrgb(1,35) = 0.501 ; zrgb(2,35) = 0.07424 ; zrgb(3,35) = 0.10040 ; zrgb(4,35) = 0.40270
156	zrgb(1,36) = 0.562 ; zrgb(2,36) = 0.07927 ; zrgb(3,36) = 0.10259 ; zrgb(4,36) = 0.40480
157	zrgb(1,37) = 0.631 ; zrgb(2,37) = 0.08470 ; zrgb(3,37) = 0.10495 ; zrgb(4,37) = 0.40707
158	zrgb(1,38) = 0.708 ; zrgb(2,38) = 0.09056 ; zrgb(3,38) = 0.10749 ; zrgb(4,38) = 0.40952
159	zrgb(1,39) = 0.794 ; zrgb(2,39) = 0.09690 ; zrgb(3,39) = 0.11024 ; zrgb(4,39) = 0.41216
160	zrgb(1,40) = 0.891 ; zrgb(2,40) = 0.10374 ; zrgb(3,40) = 0.11320 ; zrgb(4,40) = 0.41502
161	zrgb(1,41) = 1.000 ; zrgb(2,41) = 0.11114 ; zrgb(3,41) = 0.11639 ; zrgb(4,41) = 0.41809
162	zrgb(1,42) = 1.122 ; zrgb(2,42) = 0.11912 ; zrgb(3,42) = 0.11984 ; zrgb(4,42) = 0.42142
163	zrgb(1,43) = 1.259 ; zrgb(2,43) = 0.12775 ; zrgb(3,43) = 0.12356 ; zrgb(4,43) = 0.42500
164	zrgb(1,44) = 1.413 ; zrgb(2,44) = 0.13707 ; zrgb(3,44) = 0.12757 ; zrgb(4,44) = 0.42887
165	zrgb(1,45) = 1.585 ; zrgb(2,45) = 0.14715 ; zrgb(3,45) = 0.13189 ; zrgb(4,45) = 0.43304
166	zrgb(1,46) = 1.778 ; zrgb(2,46) = 0.15803 ; zrgb(3,46) = 0.13655 ; zrgb(4,46) = 0.43754
167	zrgb(1,47) = 1.995 ; zrgb(2,47) = 0.16978 ; zrgb(3,47) = 0.14158 ; zrgb(4,47) = 0.44240
168	zrgb(1,48) = 2.239 ; zrgb(2,48) = 0.18248 ; zrgb(3,48) = 0.14701 ; zrgb(4,48) = 0.44765
169	zrgb(1,49) = 2.512 ; zrgb(2,49) = 0.19620 ; zrgb(3,49) = 0.15286 ; zrgb(4,49) = 0.45331
170	zrgb(1,50) = 2.818 ; zrgb(2,50) = 0.21102 ; zrgb(3,50) = 0.15918 ; zrgb(4,50) = 0.45942
171	zrgb(1,51) = 3.162 ; zrgb(2,51) = 0.22703 ; zrgb(3,51) = 0.16599 ; zrgb(4,51) = 0.46601
172	zrgb(1,52) = 3.548 ; zrgb(2,52) = 0.24433 ; zrgb(3,52) = 0.17334 ; zrgb(4,52) = 0.47313
173	zrgb(1,53) = 3.981 ; zrgb(2,53) = 0.26301 ; zrgb(3,53) = 0.18126 ; zrgb(4,53) = 0.48080
174	zrgb(1,54) = 4.467 ; zrgb(2,54) = 0.28320 ; zrgb(3,54) = 0.18981 ; zrgb(4,54) = 0.48909
175	zrgb(1,55) = 5.012 ; zrgb(2,55) = 0.30502 ; zrgb(3,55) = 0.19903 ; zrgb(4,55) = 0.49803
176	zrgb(1,56) = 5.623 ; zrgb(2,56) = 0.32858 ; zrgb(3,56) = 0.20898 ; zrgb(4,56) = 0.50768
177	zrgb(1,57) = 6.310 ; zrgb(2,57) = 0.35404 ; zrgb(3,57) = 0.21971 ; zrgb(4,57) = 0.51810
178	zrgb(1,58) = 7.079 ; zrgb(2,58) = 0.38154 ; zrgb(3,58) = 0.23129 ; zrgb(4,58) = 0.52934
179	zrgb(1,59) = 7.943 ; zrgb(2,59) = 0.41125 ; zrgb(3,59) = 0.24378 ; zrgb(4,59) = 0.54147
180	zrgb(1,60) = 8.912 ; zrgb(2,60) = 0.44336 ; zrgb(3,60) = 0.25725 ; zrgb(4,60) = 0.55457
181	zrgb(1,61) = 10.000 ; zrgb(2,61) = 0.47804 ; zrgb(3,61) = 0.27178 ; zrgb(4,61) = 0.56870
182	!
183	prgb(:,:) = zrgb(2:4,:)
184	!
185	r_si2 = 1.e0 / zrgb(2, 1) ! blue with the smallest chlorophyll concentration)
186	IF(lwp) WRITE(numout,*) ' RGB longest depth of extinction r_si2 = ', r_si2
187	IF(lwp .AND. lflush) CALL flush(numout)
188	!
189	DO jc = 1, 61 ! check
190	zchl = zrgb(1,jc)
191	irgb = NINT( 41 + 20.* LOG10( zchl ) + 1.e-15 )
192	IF(lwp .AND. nprint > 3 ) WRITE(numout,*) ' jc =', jc, ' Chl = ', zchl, ' irgb = ', irgb
193	IF( irgb /= jc ) THEN
194	IF(lwp) WRITE(numout,*) ' jc =', jc, ' Chl = ', zchl, ' Chl class = ', irgb
195	CALL ctl_stop( 'trc_oce_rgb : inconsistency in Chl tabulated attenuation coeff.' )
196	ENDIF
197	END DO
198	!
199	END SUBROUTINE trc_oce_rgb
200
201
202	SUBROUTINE trc_oce_rgb_read( prgb )
203	!!----------------------------------------------------------------------
204	!! * ROUTINE p4z_opt_init *
205	!!
206	!! ** Purpose : Initialization of of the optical scheme
207	!!
208	!! ** Method : read the look up table for the optical coefficients
209	!!
210	!! ** input : xkrgb(61) precomputed array corresponding to the
211	!! attenuation coefficient (from JM Andre)
212	!!----------------------------------------------------------------------
213	REAL(wp), DIMENSION(3,61), INTENT(out) :: prgb ! tabulated attenuation coefficient
214	!!
215	INTEGER :: jc, jb ! dummy loop indice
216	INTEGER :: irgb ! temporary integer
217	REAL(wp) :: zchl ! temporary scalar
218	INTEGER :: numlight
219	!!----------------------------------------------------------------------
220	!
221	IF(lwp) THEN ! control print
222	WRITE(numout,*)
223	WRITE(numout,*) ' trc_oce_rgb_read : optical look-up table read in kRGB61.txt file'
224	WRITE(numout,*) ' ~~~~~~~~~~~~~~~~'
225	WRITE(numout,*)
226	IF(lflush) CALL flush(numout)
227	ENDIF
228	!
229	CALL ctl_opn( numlight, 'kRGB61.txt', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp )
230	DO jc = 1, 61
231	READ(numlight,*) zchl, ( prgb(jb,jc), jb = 1, 3 )
232	irgb = NINT( 41 + 20.* LOG10( zchl ) + 1.e-15 )
233	IF(lwp) WRITE(numout,*) ' jc =', jc, ' Chl = ', zchl, ' irgb = ', irgb
234	IF(lwp .AND. lflush) CALL flush(numout)
235	IF( irgb /= jc ) THEN
236	IF(lwp) WRITE(numout,*) ' jc =', jc, ' Chl = ', zchl, ' Chl class = ', irgb
237	CALL ctl_stop( 'trc_oce_rgb_read : inconsistency in Chl tabulated attenuation coeff.' )
238	ENDIF
239	END DO
240	CLOSE( numlight )
241	!
242	r_si2 = 1.e0 / prgb(1, 1) ! blue with the smallest chlorophyll concentration)
243	IF(lwp) WRITE(numout,*) ' RGB longest depth of extinction r_si2 = ', r_si2
244	IF(lwp .AND. lflush) CALL flush(numout)
245	!
246	END SUBROUTINE trc_oce_rgb_read
247
248
249	FUNCTION trc_oce_ext_lev( prldex, pqsr_frc ) RESULT( pjl )
250	!!----------------------------------------------------------------------
251	!! * ROUTINE trc_oce_ext_lev *
252	!!
253	!! ** Purpose : compute max. level for light penetration
254	!!
255	!! ** Method : the function provides the level at which irradiance
256	!! becomes negligible (i.e. = 1.e-15 W/m2) for 3 or 2 bands light
257	!! penetration: I(z) = pqsr_frc * EXP(hext/prldex) = 1.e-15 W/m2
258	!! # prldex is the longest depth of extinction:
259	!! - prldex = 23 m (2 bands case)
260	!! - prldex = 62 m (3 bands case: blue waveband & 0.01 mg/m2 for the chlorophyll)
261	!! # pqsr_frc is the fraction of solar radiation which penetrates,
262	!! considering Qsr=240 W/m2 and rn_abs = 0.58:
263	!! - pqsr_frc = Qsr * (1-rn_abs) = 1.00e2 W/m2 (2 bands case)
264	!! - pqsr_frc = Qsr * (1-rn_abs)/3 = 0.33e2 W/m2 (3 bands case & equi-partition)
265	!!
266	!!----------------------------------------------------------------------
267	REAL(wp), INTENT(in) :: prldex ! longest depth of extinction
268	REAL(wp), INTENT(in) :: pqsr_frc ! frac. solar radiation which penetrates
269	!!
270	INTEGER :: jk, pjl ! levels
271	REAL(wp) :: zhext ! deepest level till which light penetrates
272	REAL(wp) :: zprec = 15._wp ! precision to reach -LOG10(1.e-15)
273	REAL(wp) :: zem ! temporary scalar
274	!!----------------------------------------------------------------------
275	!
276	! It is not necessary to compute anything below the following depth
277	zhext = prldex * ( LOG(10._wp) * zprec + LOG(pqsr_frc) )
278	!
279	! Level of light extinction
280	pjl = jpkm1
281	DO jk = jpkm1, 1, -1
282	IF(SUM(tmask(:,:,jk)) > 0 ) THEN
283	zem = MAXVAL( fsdepw(:,:,jk+1) * tmask(:,:,jk) )
284	IF( zem >= zhext ) pjl = jk ! last T-level reached by Qsr
285	ELSE
286	pjl = jk ! or regional sea-bed depth
287	ENDIF
288	END DO
289	!
290	END FUNCTION trc_oce_ext_lev
291
292	!!======================================================================
293	END MODULE trc_oce

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

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

Context Navigation

source: branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/trc_oce.F90

Download in other formats: