Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

trcldf.F90 @ 11738

Last change on this file since 11738 was 11738, checked in by marc, 5 years ago
The Dr Hook changes from my perl code.
File size: 15.0 KB

Line
1	MODULE trcldf
2	!!======================================================================
3	!! * MODULE trcldf *
4	!! Ocean Passive tracers : lateral diffusive trends
5	!!=====================================================================
6	!! History : 9.0 ! 2005-11 (G. Madec) Original code
7	!! NEMO 3.0 ! 2008-01 (C. Ethe, G. Madec) merge TRC-TRA
8	!!----------------------------------------------------------------------
9	#if defined key_top
10	!!----------------------------------------------------------------------
11	!! 'key_top' TOP models
12	!!----------------------------------------------------------------------
13	!!----------------------------------------------------------------------
14	!! trc_ldf : update the tracer trend with the lateral diffusion
15	!! ldf_ctl : initialization, namelist read, and parameters control
16	!!----------------------------------------------------------------------
17	USE oce_trc ! ocean dynamics and active tracers
18	USE trc ! ocean passive tracers variables
19	USE trcnam_trp ! passive tracers transport namelist variables
20	USE ldftra_oce ! lateral diffusion coefficient on tracers
21	USE ldfslp ! ???
22	USE traldf_bilapg ! lateral mixing (tra_ldf_bilapg routine)
23	USE traldf_bilap ! lateral mixing (tra_ldf_bilap routine)
24	USE traldf_iso ! lateral mixing (tra_ldf_iso routine)
25	USE traldf_iso_grif ! lateral mixing (tra_ldf_iso_grif routine)
26	USE traldf_lap ! lateral mixing (tra_ldf_lap routine)
27	USE trd_oce
28	USE trdtra
29	USE prtctl_trc ! Print control
30
31	USE yomhook, ONLY: lhook, dr_hook
32	USE parkind1, ONLY: jprb, jpim
33
34	IMPLICIT NONE
35	PRIVATE
36
37	PUBLIC trc_ldf ! called by step.F90
38	! !!: lateral mixing namelist (nam_trcldf)
39	REAL(wp) :: rldf_rat ! ratio between active and passive tracers diffusive coefficient
40	INTEGER :: nldf = 0 ! type of lateral diffusion used defined from ln_trcldf_... namlist logicals)
41	!! * Substitutions
42	# include "domzgr_substitute.h90"
43	# include "vectopt_loop_substitute.h90"
44	!!----------------------------------------------------------------------
45	!! NEMO/TOP 3.3 , NEMO Consortium (2010)
46	!! $Id$
47	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
48	!!----------------------------------------------------------------------
49
50	CONTAINS
51
52	SUBROUTINE trc_ldf( kt )
53	!!----------------------------------------------------------------------
54	!! * ROUTINE tra_ldf *
55	!!
56	!! ** Purpose : compute the lateral ocean tracer physics.
57	!!
58	!!----------------------------------------------------------------------
59	INTEGER, INTENT( in ) :: kt ! ocean time-step index
60	!!
61	INTEGER :: ji, jj, jk, jn
62	REAL(wp) :: zdep
63	CHARACTER (len=22) :: charout
64	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztrtrd
65	INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
66	INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
67	REAL(KIND=jprb) :: zhook_handle
68
69	CHARACTER(LEN=*), PARAMETER :: RoutineName='TRC_LDF'
70
71	IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
72
73	!!----------------------------------------------------------------------
74	!
75	IF( nn_timing == 1 ) CALL timing_start('trc_ldf')
76	!
77	IF( kt == nittrc000 ) CALL ldf_ctl ! initialisation & control of options
78
79	rldf = rldf_rat
80	!
81	r_fact_lap(:,:,:) = 1.
82	DO jk= 1, jpk
83	DO jj = 1, jpj
84	DO ji = 1, jpi
85	IF( fsdept(ji,jj,jk) > 200. .AND. gphit(ji,jj) < 5. .AND. gphit(ji,jj) > -5. ) THEN
86	zdep = MAX( fsdept(ji,jj,jk) - 1000., 0. ) / 1000.
87	r_fact_lap(ji,jj,jk) = MAX( 1., rn_fact_lap * EXP( -zdep ) )
88	ENDIF
89	END DO
90	END DO
91	END DO
92	!
93	IF( l_trdtrc ) THEN
94	ALLOCATE( ztrtrd ( 1:jpi, 1:jpj, 1:jpk, 1:jptra) )
95	ztrtrd(:,:,:,:) = tra(:,:,:,:)
96	ENDIF
97
98	SELECT CASE ( nldf ) ! compute lateral mixing trend and add it to the general trend
99	CASE ( 0 ) ; CALL tra_ldf_lap ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra ) ! iso-level laplacian
100	CASE ( 1 ) ! rotated laplacian
101	IF( ln_traldf_grif ) THEN
102	CALL tra_ldf_iso_grif( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 )
103	ELSE
104	CALL tra_ldf_iso ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra, rn_ahtb_0 )
105	ENDIF
106	CASE ( 2 ) ; CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra ) ! iso-level bilaplacian
107	CASE ( 3 ) ; CALL tra_ldf_bilapg( kt, nittrc000, 'TRC', trb, tra, jptra ) ! s-coord. horizontal bilaplacian
108	!
109	CASE ( -1 ) ! esopa: test all possibility with control print
110	CALL tra_ldf_lap ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra )
111	WRITE(charout, FMT="('ldf0 ')") ; CALL prt_ctl_trc_info(charout)
112	CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
113	IF( ln_traldf_grif ) THEN
114	CALL tra_ldf_iso_grif( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 )
115	ELSE
116	CALL tra_ldf_iso ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra, rn_ahtb_0 )
117	ENDIF
118	WRITE(charout, FMT="('ldf1 ')") ; CALL prt_ctl_trc_info(charout)
119	CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
120	CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra )
121	WRITE(charout, FMT="('ldf2 ')") ; CALL prt_ctl_trc_info(charout)
122	CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
123	CALL tra_ldf_bilapg( kt, nittrc000, 'TRC', trb, tra, jptra )
124	WRITE(charout, FMT="('ldf3 ')") ; CALL prt_ctl_trc_info(charout)
125	CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
126	END SELECT
127	!
128	IF( l_trdtrc ) THEN ! save the horizontal diffusive trends for further diagnostics
129	DO jn = 1, jptra
130	ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn)
131	CALL trd_tra( kt, 'TRC', jn, jptra_ldf, ztrtrd(:,:,:,jn) )
132	END DO
133	DEALLOCATE( ztrtrd )
134	ENDIF
135	! ! print mean trends (used for debugging)
136	IF( ln_ctl ) THEN
137	WRITE(charout, FMT="('ldf ')") ; CALL prt_ctl_trc_info(charout)
138	CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' )
139	ENDIF
140	!
141	IF( nn_timing == 1 ) CALL timing_stop('trc_ldf')
142	!
143	IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
144	END SUBROUTINE trc_ldf
145
146
147	SUBROUTINE ldf_ctl
148	!!----------------------------------------------------------------------
149	!! * ROUTINE ldf_ctl *
150	!!
151	!! ** Purpose : Choice of the operator for the lateral tracer diffusion
152	!!
153	!! ** Method : set nldf from the namtra_ldf logicals
154	!! nldf == -2 No lateral diffusion
155	!! nldf == -1 ESOPA test: ALL operators are used
156	!! nldf == 0 laplacian operator
157	!! nldf == 1 Rotated laplacian operator
158	!! nldf == 2 bilaplacian operator
159	!! nldf == 3 Rotated bilaplacian
160	!!----------------------------------------------------------------------
161	INTEGER :: ioptio, ierr ! temporary integers
162	INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
163	INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
164	REAL(KIND=jprb) :: zhook_handle
165
166	CHARACTER(LEN=*), PARAMETER :: RoutineName='LDF_CTL'
167
168	IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
169
170	!!----------------------------------------------------------------------
171
172	IF (ABS(rn_aht_0) < 2._wp*TINY(1.e0)) THEN
173	IF (ABS(rn_ahtrc_0) < 2._wp*TINY(1.e0)) THEN
174	rldf_rat = 1.0_wp
175	ELSE
176	CALL ctl_stop( 'STOP', 'ldf_ctl : cannot define rldf_rat, rn_aht_0==0, rn_ahtrc_0 /=0' )
177	END IF
178	ELSE
179	rldf_rat = rn_ahtrc_0 / rn_aht_0
180	END IF
181	! Define the lateral mixing oparator for tracers
182	! ===============================================
183
184	! ! control the input
185	ioptio = 0
186	IF( ln_trcldf_lap ) ioptio = ioptio + 1
187	IF( ln_trcldf_bilap ) ioptio = ioptio + 1
188	IF( ioptio > 1 ) CALL ctl_stop( ' use ONE or NONE of the 2 lap/bilap operator type on tracer' )
189	IF( ioptio == 0 ) nldf = -2 ! No lateral diffusion
190	ioptio = 0
191	IF( ln_trcldf_level ) ioptio = ioptio + 1
192	IF( ln_trcldf_hor ) ioptio = ioptio + 1
193	IF( ln_trcldf_iso ) ioptio = ioptio + 1
194	IF( ioptio /= 1 ) CALL ctl_stop( ' use only ONE direction (level/hor/iso)' )
195
196	! defined the type of lateral diffusion from ln_trcldf_... logicals
197	! CAUTION : nldf = 1 is used in trazdf_imp, change it carefully
198	ierr = 0
199	IF( ln_trcldf_lap ) THEN ! laplacian operator
200	IF ( ln_zco ) THEN ! z-coordinate
201	IF ( ln_trcldf_level ) nldf = 0 ! iso-level (no rotation)
202	IF ( ln_trcldf_hor ) nldf = 0 ! horizontal (no rotation)
203	IF ( ln_trcldf_iso ) nldf = 1 ! isoneutral ( rotation)
204	ENDIF
205	IF ( ln_zps ) THEN ! z-coordinate
206	IF ( ln_trcldf_level ) ierr = 1 ! iso-level not allowed
207	IF ( ln_trcldf_hor ) nldf = 0 ! horizontal (no rotation)
208	IF ( ln_trcldf_iso ) nldf = 1 ! isoneutral ( rotation)
209	ENDIF
210	IF ( ln_sco ) THEN ! z-coordinate
211	IF ( ln_trcldf_level ) nldf = 0 ! iso-level (no rotation)
212	IF ( ln_trcldf_hor ) nldf = 1 ! horizontal ( rotation)
213	IF ( ln_trcldf_iso ) nldf = 1 ! isoneutral ( rotation)
214	ENDIF
215	ENDIF
216
217	IF( ln_trcldf_bilap ) THEN ! bilaplacian operator
218	IF ( ln_zco ) THEN ! z-coordinate
219	IF ( ln_trcldf_level ) nldf = 2 ! iso-level (no rotation)
220	IF ( ln_trcldf_hor ) nldf = 2 ! horizontal (no rotation)
221	IF ( ln_trcldf_iso ) ierr = 2 ! isoneutral ( rotation)
222	ENDIF
223	IF ( ln_zps ) THEN ! z-coordinate
224	IF ( ln_trcldf_level ) ierr = 1 ! iso-level not allowed
225	IF ( ln_trcldf_hor ) nldf = 2 ! horizontal (no rotation)
226	IF ( ln_trcldf_iso ) ierr = 2 ! isoneutral ( rotation)
227	ENDIF
228	IF ( ln_sco ) THEN ! z-coordinate
229	IF ( ln_trcldf_level ) nldf = 2 ! iso-level (no rotation)
230	IF ( ln_trcldf_hor ) nldf = 3 ! horizontal ( rotation)
231	IF ( ln_trcldf_iso ) ierr = 2 ! isoneutral ( rotation)
232	ENDIF
233	ENDIF
234
235	IF( ierr == 1 ) CALL ctl_stop( ' iso-level in z-coordinate - partial step, not allowed' )
236	IF( ierr == 2 ) CALL ctl_stop( ' isoneutral bilaplacian operator does not exist' )
237	IF( lk_traldf_eiv .AND. .NOT.ln_trcldf_iso ) &
238	CALL ctl_stop( ' eddy induced velocity on tracers', &
239	& ' the eddy induced velocity on tracers requires isopycnal laplacian diffusion' )
240	IF( nldf == 1 .OR. nldf == 3 ) THEN ! rotation
241	IF( .NOT.lk_ldfslp ) CALL ctl_stop( ' the rotation of the diffusive tensor require key_ldfslp' )
242	#if defined key_offline
243	l_traldf_rot = .TRUE. ! needed for trazdf_imp
244	#endif
245	ENDIF
246
247	IF( lk_esopa ) THEN
248	IF(lwp) WRITE(numout,*) ' esopa control: use all lateral physics options'
249	nldf = -1
250	ENDIF
251
252	IF(lwp) THEN
253	WRITE(numout,*)
254	IF( nldf == -2 ) WRITE(numout,*) ' NO lateral diffusion'
255	IF( nldf == -1 ) WRITE(numout,*) ' ESOPA test All scheme used'
256	IF( nldf == 0 ) WRITE(numout,*) ' laplacian operator'
257	IF( nldf == 1 ) WRITE(numout,*) ' Rotated laplacian operator'
258	IF( nldf == 2 ) WRITE(numout,*) ' bilaplacian operator'
259	IF( nldf == 3 ) WRITE(numout,*) ' Rotated bilaplacian'
260	ENDIF
261
262	IF( ln_trcldf_bilap ) THEN
263	IF(lwp) WRITE(numout,*) ' biharmonic tracer diffusion'
264	IF( rn_ahtrc_0 > 0 .AND. .NOT. lk_esopa ) CALL ctl_stop( 'The horizontal diffusivity coef. rn_ahtrc_0 must be negative' )
265	ELSE
266	IF(lwp) WRITE(numout,*) ' harmonic tracer diffusion (default)'
267	IF( rn_ahtrc_0 < 0 .AND. .NOT. lk_esopa ) CALL ctl_stop('The horizontal diffusivity coef. rn_ahtrc_0 must be positive' )
268	ENDIF
269
270	! ratio between active and passive tracers diffusive coef.
271	IF (ABS(rn_aht_0) < 2._wp*TINY(1.e0)) THEN
272	IF (ABS(rn_ahtrc_0) < 2._wp*TINY(1.e0)) THEN
273	rldf_rat = 1.0_wp
274	ELSE
275	CALL ctl_stop( 'STOP', 'ldf_ctl : cannot define rldf_rat, rn_aht_0==0, rn_ahtrc_0 /=0' )
276	END IF
277	ELSE
278	rldf_rat = rn_ahtrc_0 / rn_aht_0
279	END IF
280	IF( rldf_rat < 0 ) THEN
281	IF( .NOT.lk_offline ) THEN
282	CALL ctl_stop( 'Choose the same type of diffusive scheme both for active & passive tracers' )
283	ELSE
284	CALL ctl_stop( 'Change the sign of rn_aht_0 in namelist to -/+1' )
285	ENDIF
286	ENDIF
287	!
288	IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
289	END SUBROUTINE ldf_ctl
290	#else
291	!!----------------------------------------------------------------------
292	!! Default option Empty module
293	!!----------------------------------------------------------------------
294	CONTAINS
295	SUBROUTINE trc_ldf( kt )
296	INTEGER, INTENT(in) :: kt
297	INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
298	INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
299	REAL(KIND=jprb) :: zhook_handle
300
301	CHARACTER(LEN=*), PARAMETER :: RoutineName='TRC_LDF'
302
303	IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
304
305	WRITE(,) 'trc_ldf: You should not have seen this print! error?', kt
306	IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
307	END SUBROUTINE trc_ldf
308	#endif
309	!!======================================================================
310	END MODULE trcldf

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_under_ice_relax_dr_hook/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90 @ 11738

Download in other formats: