Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

dia25h.F90

Last change on this file was 15249, checked in by hadcv, 3 years ago
#2721: Fix SETTE debug failures
Property svn:keywords set to `Id`
File size: 13.8 KB

Line
1	MODULE dia25h
2	!!======================================================================
3	!! * MODULE diaharm *
4	!! Harmonic analysis of tidal constituents
5	!!======================================================================
6	!! History : 3.6 ! 2014 (E O'Dea) Original code
7	!!----------------------------------------------------------------------
8	USE oce ! ocean dynamics and tracers variables
9	USE dom_oce ! ocean space and time domain
10	USE zdf_oce ! ocean vertical physics
11	USE zdfgls , ONLY : hmxl_n
12	!
13	USE in_out_manager ! I/O units
14	USE iom ! I/0 library
15	USE wet_dry
16
17	IMPLICIT NONE
18	PRIVATE
19
20	PUBLIC dia_25h_init ! routine called by nemogcm.F90
21	PUBLIC dia_25h ! routine called by diawri.F90
22
23	LOGICAL, PUBLIC :: ln_dia25h !: 25h mean output
24
25	! variables for calculating 25-hourly means
26	INTEGER , SAVE :: cnt_25h ! Counter for 25 hour means
27	REAL(wp), SAVE :: r1_25 = 0.04_wp ! =1/25
28	REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: tn_25h , sn_25h
29	REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: sshn_25h
30	REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: un_25h , vn_25h , wn_25h
31	REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: avt_25h , avm_25h
32	REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: en_25h , rmxln_25h
33
34	!! * Substitutions
35	# include "do_loop_substitute.h90"
36	!!----------------------------------------------------------------------
37	!! NEMO/OCE 4.0 , NEMO Consortium (2018)
38	!! $Id$
39	!! Software governed by the CeCILL license (see ./LICENSE)
40	!!----------------------------------------------------------------------
41	CONTAINS
42
43	SUBROUTINE dia_25h_init( Kbb )
44	!!---------------------------------------------------------------------------
45	!! * ROUTINE dia_25h_init *
46	!!
47	!! ** Purpose: Initialization of 25h mean namelist
48	!!
49	!! ** Method : Read namelist
50	!!---------------------------------------------------------------------------
51	INTEGER, INTENT(in) :: Kbb ! Time level index
52	!
53	INTEGER :: ios ! Local integer output status for namelist read
54	INTEGER :: ierror ! Local integer for memory allocation
55	INTEGER :: ji, jj, jk
56	!
57	NAMELIST/nam_dia25h/ ln_dia25h
58	!!----------------------------------------------------------------------
59	!
60	READ ( numnam_ref, nam_dia25h, IOSTAT=ios, ERR= 901 )
61	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_dia25h in reference namelist' )
62	READ ( numnam_cfg, nam_dia25h, IOSTAT = ios, ERR = 902 )
63	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nam_dia25h in configuration namelist' )
64	IF(lwm) WRITE ( numond, nam_dia25h )
65
66	IF(lwp) THEN ! Control print
67	WRITE(numout,*)
68	WRITE(numout,*) 'dia_25h_init : Output 25 hour mean diagnostics'
69	WRITE(numout,*) '~~~~~~~~~~~~'
70	WRITE(numout,*) ' Namelist nam_dia25h : set 25h outputs '
71	WRITE(numout,*) ' Switch for 25h diagnostics (T) or not (F) ln_dia25h = ', ln_dia25h
72	ENDIF
73	IF( .NOT. ln_dia25h ) RETURN
74	! ------------------- !
75	! 1 - Allocate memory !
76	! ------------------- !
77	! ! ocean arrays
78	ALLOCATE( tn_25h (A2D(0),jpk), sn_25h (A2D(0),jpk), sshn_25h(A2D(0)) , &
79	& un_25h (A2D(0),jpk), vn_25h (A2D(0),jpk), wn_25h(A2D(0),jpk), &
80	& avt_25h(A2D(0),jpk), avm_25h(A2D(0),jpk), STAT=ierror )
81	IF( ierror > 0 ) THEN
82	CALL ctl_stop( 'dia_25h: unable to allocate ocean arrays' ) ; RETURN
83	ENDIF
84	IF( ln_zdftke ) THEN ! TKE physics
85	ALLOCATE( en_25h(A2D(0),jpk), STAT=ierror )
86	IF( ierror > 0 ) THEN
87	CALL ctl_stop( 'dia_25h: unable to allocate en_25h' ) ; RETURN
88	ENDIF
89	ENDIF
90	IF( ln_zdfgls ) THEN ! GLS physics
91	ALLOCATE( en_25h(A2D(0),jpk), rmxln_25h(A2D(0),jpk), STAT=ierror )
92	IF( ierror > 0 ) THEN
93	CALL ctl_stop( 'dia_25h: unable to allocate en_25h and rmxln_25h' ) ; RETURN
94	ENDIF
95	ENDIF
96	! ------------------------- !
97	! 2 - Assign Initial Values !
98	! ------------------------- !
99	cnt_25h = 1 ! sets the first value of sum at timestep 1 (note - should strictly be at timestep zero so before values used where possible)
100	DO_3D( 0, 0, 0, 0, 1, jpk )
101	tn_25h (ji,jj,jk) = ts (ji,jj,jk,jp_tem,Kbb)
102	sn_25h (ji,jj,jk) = ts (ji,jj,jk,jp_sal,Kbb)
103	un_25h (ji,jj,jk) = uu (ji,jj,jk,Kbb)
104	vn_25h (ji,jj,jk) = vv (ji,jj,jk,Kbb)
105	avt_25h(ji,jj,jk) = avt(ji,jj,jk)
106	avm_25h(ji,jj,jk) = avm(ji,jj,jk)
107	END_3D
108	DO_2D( 0, 0, 0, 0 )
109	sshn_25h(ji,jj) = ssh(ji,jj,Kbb)
110	END_2D
111	IF( ln_zdftke ) THEN
112	DO_3D( 0, 0, 0, 0, 1, jpk )
113	en_25h(ji,jj,jk) = en(ji,jj,jk)
114	END_3D
115	ENDIF
116	IF( ln_zdfgls ) THEN
117	DO_3D( 0, 0, 0, 0, 1, jpk )
118	en_25h (ji,jj,jk) = en (ji,jj,jk)
119	rmxln_25h(ji,jj,jk) = hmxl_n(ji,jj,jk)
120	END_3D
121	ENDIF
122	#if defined key_si3
123	CALL ctl_stop('STOP', 'dia_25h not setup yet to do tidemean ice')
124	#endif
125	!
126	END SUBROUTINE dia_25h_init
127
128
129	SUBROUTINE dia_25h( kt, Kmm )
130	!!----------------------------------------------------------------------
131	!! * ROUTINE dia_25h *
132	!!
133	!! ** Purpose : Write diagnostics with M2/S2 tide removed
134	!!
135	!! ** Method : 25hr mean outputs for shelf seas
136	!!----------------------------------------------------------------------
137	INTEGER, INTENT(in) :: kt ! ocean time-step index
138	INTEGER, INTENT(in) :: Kmm ! ocean time level index
139	!!
140	INTEGER :: ji, jj, jk
141	INTEGER :: iyear0, nimonth0,iday0 ! start year,imonth,day
142	LOGICAL :: ll_print = .FALSE. ! =T print and flush numout
143	REAL(wp) :: zsto, zout, zmax, zjulian, zmdi ! local scalars
144	INTEGER :: i_steps ! no of timesteps per hour
145	REAL(wp), DIMENSION(A2D(0) ) :: zw2d, un_dm, vn_dm ! workspace
146	REAL(wp), DIMENSION(A2D(0),jpk) :: zw3d ! workspace
147	REAL(wp), DIMENSION(A2D(0),3) :: zwtmb ! workspace
148	!!----------------------------------------------------------------------
149
150	! 0. Initialisation
151	! -----------------
152	! Define frequency of summing to create 25 h mean
153	IF( MOD( 3600,NINT(rn_Dt) ) == 0 ) THEN
154	i_steps = 3600/NINT(rn_Dt)
155	ELSE
156	CALL ctl_stop('STOP', 'dia_wri_tide: timestep must give MOD(3600,rn_Dt) = 0 otherwise no hourly values are possible')
157	ENDIF
158
159	! local variable for debugging
160	ll_print = ll_print .AND. lwp
161
162	! wn_25h could not be initialised in dia_25h_init, so we do it here instead
163	IF( kt == nn_it000 ) THEN
164	DO_3D( 0, 0, 0, 0, 1, jpk )
165	wn_25h(ji,jj,jk) = ww(ji,jj,jk)
166	END_3D
167	ENDIF
168
169	! Sum of 25 hourly instantaneous values to give a 25h mean from 24hours every day
170	IF( MOD( kt, i_steps ) == 0 .AND. kt /= nn_it000 ) THEN
171
172	IF (lwp) THEN
173	WRITE(numout,*) 'dia_wri_tide : Summing instantaneous hourly diagnostics at timestep ',kt
174	WRITE(numout,*) '~~~~~~~~~~~~ '
175	ENDIF
176
177	DO_3D( 0, 0, 0, 0, 1, jpk )
178	tn_25h (ji,jj,jk) = tn_25h (ji,jj,jk) + ts (ji,jj,jk,jp_tem,Kmm)
179	sn_25h (ji,jj,jk) = sn_25h (ji,jj,jk) + ts (ji,jj,jk,jp_sal,Kmm)
180	un_25h (ji,jj,jk) = un_25h (ji,jj,jk) + uu (ji,jj,jk,Kmm)
181	vn_25h (ji,jj,jk) = vn_25h (ji,jj,jk) + vv (ji,jj,jk,Kmm)
182	wn_25h (ji,jj,jk) = wn_25h (ji,jj,jk) + ww (ji,jj,jk)
183	avt_25h (ji,jj,jk) = avt_25h (ji,jj,jk) + avt(ji,jj,jk)
184	avm_25h (ji,jj,jk) = avm_25h (ji,jj,jk) + avm(ji,jj,jk)
185	END_3D
186	DO_2D( 0, 0, 0, 0 )
187	sshn_25h(ji,jj) = sshn_25h(ji,jj) + ssh(ji,jj,Kmm)
188	END_2D
189	IF( ln_zdftke ) THEN
190	DO_3D( 0, 0, 0, 0, 1, jpk )
191	en_25h(ji,jj,jk) = en_25h(ji,jj,jk) + en(ji,jj,jk)
192	END_3D
193	ENDIF
194	IF( ln_zdfgls ) THEN
195	DO_3D( 0, 0, 0, 0, 1, jpk )
196	en_25h (ji,jj,jk) = en_25h (ji,jj,jk) + en (ji,jj,jk)
197	rmxln_25h(ji,jj,jk) = rmxln_25h(ji,jj,jk) + hmxl_n(ji,jj,jk)
198	END_3D
199	ENDIF
200	cnt_25h = cnt_25h + 1
201	!
202	IF (lwp) THEN
203	WRITE(numout,*) 'dia_tide : Summed the following number of hourly values so far',cnt_25h
204	ENDIF
205	!
206	ENDIF ! MOD( kt, i_steps ) == 0
207
208	! Write data for 25 hour mean output streams
209	IF( cnt_25h == 25 .AND. MOD( kt, i_steps*24) == 0 .AND. kt /= nn_it000 ) THEN
210	!
211	IF(lwp) THEN
212	WRITE(numout,*) 'dia_wri_tide : Writing 25 hour mean tide diagnostics at timestep', kt
213	WRITE(numout,*) '~~~~~~~~~~~~ '
214	ENDIF
215	!
216	tn_25h (:,:,:) = tn_25h (:,:,:) * r1_25
217	sn_25h (:,:,:) = sn_25h (:,:,:) * r1_25
218	sshn_25h(:,:) = sshn_25h(:,:) * r1_25
219	un_25h (:,:,:) = un_25h (:,:,:) * r1_25
220	vn_25h (:,:,:) = vn_25h (:,:,:) * r1_25
221	wn_25h (:,:,:) = wn_25h (:,:,:) * r1_25
222	avt_25h (:,:,:) = avt_25h (:,:,:) * r1_25
223	avm_25h (:,:,:) = avm_25h (:,:,:) * r1_25
224	IF( ln_zdftke ) THEN
225	en_25h(:,:,:) = en_25h(:,:,:) * r1_25
226	ENDIF
227	IF( ln_zdfgls ) THEN
228	en_25h (:,:,:) = en_25h (:,:,:) * r1_25
229	rmxln_25h(:,:,:) = rmxln_25h(:,:,:) * r1_25
230	ENDIF
231	!
232	IF(lwp) WRITE(numout,*) 'dia_wri_tide : Mean calculated by dividing 25 hour sums and writing output'
233	zmdi=1.e+20 !missing data indicator for masking
234	! write tracers (instantaneous)
235	DO_3D( 0, 0, 0, 0, 1, jpk )
236	zw3d(ji,jj,jk) = tn_25h(ji,jj,jk)tmask(ji,jj,jk) + zmdi(1.0-tmask(ji,jj,jk))
237	END_3D
238	CALL iom_put("temper25h", zw3d) ! potential temperature
239	DO_3D( 0, 0, 0, 0, 1, jpk )
240	zw3d(ji,jj,jk) = sn_25h(ji,jj,jk)tmask(ji,jj,jk) + zmdi(1.0-tmask(ji,jj,jk))
241	END_3D
242	CALL iom_put( "salin25h", zw3d ) ! salinity
243	DO_2D( 0, 0, 0, 0 )
244	zw2d(ji,jj) = sshn_25h(ji,jj)tmask(ji,jj,1) + zmdi(1.0-tmask(ji,jj,1))
245	END_2D
246	IF( ll_wd ) THEN
247	CALL iom_put( "ssh25h", zw2d+ssh_ref ) ! sea surface
248	ELSE
249	CALL iom_put( "ssh25h", zw2d ) ! sea surface
250	ENDIF
251	! Write velocities (instantaneous)
252	DO_3D( 0, 0, 0, 0, 1, jpk )
253	zw3d(ji,jj,jk) = un_25h(ji,jj,jk)umask(ji,jj,jk) + zmdi(1.0-umask(ji,jj,jk))
254	END_3D
255	CALL iom_put("vozocrtx25h", zw3d) ! i-current
256	DO_3D( 0, 0, 0, 0, 1, jpk )
257	zw3d(ji,jj,jk) = vn_25h(ji,jj,jk)vmask(ji,jj,jk) + zmdi(1.0-vmask(ji,jj,jk))
258	END_3D
259	CALL iom_put("vomecrty25h", zw3d ) ! j-current
260	DO_3D( 0, 0, 0, 0, 1, jpk )
261	zw3d(ji,jj,jk) = wn_25h(ji,jj,jk)wmask(ji,jj,jk) + zmdi(1.0-tmask(ji,jj,jk))
262	END_3D
263	CALL iom_put("vovecrtz25h", zw3d ) ! k-current
264	! Write vertical physics
265	DO_3D( 0, 0, 0, 0, 1, jpk )
266	zw3d(ji,jj,jk) = avt_25h(ji,jj,jk)wmask(ji,jj,jk) + zmdi(1.0-tmask(ji,jj,jk))
267	END_3D
268	CALL iom_put("avt25h", zw3d ) ! diffusivity
269	DO_3D( 0, 0, 0, 0, 1, jpk )
270	zw3d(ji,jj,jk) = avm_25h(ji,jj,jk)wmask(ji,jj,jk) + zmdi(1.0-tmask(ji,jj,jk))
271	END_3D
272	CALL iom_put("avm25h", zw3d) ! viscosity
273	IF( ln_zdftke ) THEN
274	DO_3D( 0, 0, 0, 0, 1, jpk )
275	zw3d(ji,jj,jk) = en_25h(ji,jj,jk)wmask(ji,jj,jk) + zmdi(1.0-tmask(ji,jj,jk))
276	END_3D
277	CALL iom_put("tke25h", zw3d) ! tke
278	ENDIF
279	IF( ln_zdfgls ) THEN
280	DO_3D( 0, 0, 0, 0, 1, jpk )
281	zw3d(ji,jj,jk) = en_25h(ji,jj,jk)wmask(ji,jj,jk) + zmdi(1.0-tmask(ji,jj,jk))
282	END_3D
283	CALL iom_put("tke25h", zw3d) ! tke
284	DO_3D( 0, 0, 0, 0, 1, jpk )
285	zw3d(ji,jj,jk) = rmxln_25h(ji,jj,jk)wmask(ji,jj,jk) + zmdi(1.0-tmask(ji,jj,jk))
286	END_3D
287	CALL iom_put( "mxln25h",zw3d)
288	ENDIF
289	!
290	! After the write reset the values to cnt=1 and sum values equal current value
291	DO_3D( 0, 0, 0, 0, 1, jpk )
292	tn_25h (ji,jj,jk) = ts (ji,jj,jk,jp_tem,Kmm)
293	sn_25h (ji,jj,jk) = ts (ji,jj,jk,jp_sal,Kmm)
294	un_25h (ji,jj,jk) = uu (ji,jj,jk,Kmm)
295	vn_25h (ji,jj,jk) = vv (ji,jj,jk,Kmm)
296	wn_25h (ji,jj,jk) = ww (ji,jj,jk)
297	avt_25h (ji,jj,jk) = avt(ji,jj,jk)
298	avm_25h (ji,jj,jk) = avm(ji,jj,jk)
299	END_3D
300	DO_2D( 0, 0, 0, 0 )
301	sshn_25h(ji,jj) = ssh(ji,jj,Kmm)
302	END_2D
303	IF( ln_zdftke ) THEN
304	DO_3D( 0, 0, 0, 0, 1, jpk )
305	en_25h(ji,jj,jk) = en(ji,jj,jk)
306	END_3D
307	ENDIF
308	IF( ln_zdfgls ) THEN
309	DO_3D( 0, 0, 0, 0, 1, jpk )
310	en_25h (ji,jj,jk) = en (ji,jj,jk)
311	rmxln_25h(ji,jj,jk) = hmxl_n(ji,jj,jk)
312	END_3D
313	ENDIF
314	cnt_25h = 1
315	IF(lwp) WRITE(numout,*) 'dia_wri_tide : &
316	& After 25hr mean write, reset sum to current value and cnt_25h to one for overlapping average', cnt_25h
317	ENDIF ! cnt_25h .EQ. 25 .AND. MOD( kt, i_steps * 24) == 0 .AND. kt .NE. nn_it000
318	!
319	END SUBROUTINE dia_25h
320
321	!!======================================================================
322	END MODULE dia25h

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

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

Context Navigation

source: NEMO/trunk/src/OCE/DIA/dia25h.F90

Download in other formats: