Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

diaharm.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: 20.2 KB

Line
1	MODULE diaharm
2	!!======================================================================
3	!! * MODULE diaharm *
4	!! Harmonic analysis of tidal constituents
5	!!======================================================================
6	!! History : 3.1 ! 2007 (O. Le Galloudec, J. Chanut) Original code
7	!!----------------------------------------------------------------------
8	#if defined key_diaharm && defined key_tide
9	!!----------------------------------------------------------------------
10	!! 'key_diaharm'
11	!! 'key_tide'
12	!!----------------------------------------------------------------------
13	USE oce ! ocean dynamics and tracers variables
14	USE dom_oce ! ocean space and time domain
15	USE phycst
16	USE dynspg_oce
17	USE dynspg_ts
18	USE daymod
19	USE tide_mod
20	!
21	USE in_out_manager ! I/O units
22	USE iom ! I/0 library
23	USE ioipsl ! NetCDF IPSL library
24	USE lbclnk ! ocean lateral boundary conditions (or mpp link)
25	USE diadimg ! To write dimg
26	USE timing ! preformance summary
27	USE wrk_nemo ! working arrays
28
29	IMPLICIT NONE
30	PRIVATE
31
32	LOGICAL, PUBLIC, PARAMETER :: lk_diaharm = .TRUE.
33
34	INTEGER, PARAMETER :: jpincomax = 2.*jpmax_harmo
35	INTEGER, PARAMETER :: jpdimsparse = jpincomax30024
36
37	! !! namelist variables
38	INTEGER :: nit000_han ! First time step used for harmonic analysis
39	INTEGER :: nitend_han ! Last time step used for harmonic analysis
40	INTEGER :: nstep_han ! Time step frequency for harmonic analysis
41	INTEGER :: nb_ana ! Number of harmonics to analyse
42
43	INTEGER , ALLOCATABLE, DIMENSION(:) :: name
44	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ana_temp
45	REAL(wp), ALLOCATABLE, DIMENSION(:) :: ana_freq, ut , vt , ft
46	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: out_eta , out_u, out_v
47
48	INTEGER :: ninco, nsparse
49	INTEGER , DIMENSION(jpdimsparse) :: njsparse, nisparse
50	INTEGER , SAVE, DIMENSION(jpincomax) :: ipos1
51	REAL(wp), DIMENSION(jpdimsparse) :: valuesparse
52	REAL(wp), DIMENSION(jpincomax) :: ztmp4 , ztmp7
53	REAL(wp), SAVE, DIMENSION(jpincomax,jpincomax) :: ztmp3 , zpilier
54	REAL(wp), SAVE, DIMENSION(jpincomax) :: zpivot
55
56	CHARACTER (LEN=4), DIMENSION(jpmax_harmo) :: tname ! Names of tidal constituents ('M2', 'K1',...)
57
58	PUBLIC dia_harm ! routine called by step.F90
59
60	!!----------------------------------------------------------------------
61	!! NEMO/OPA 3.5 , NEMO Consortium (2013)
62	!! $Id$
63	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
64	!!----------------------------------------------------------------------
65	CONTAINS
66
67	SUBROUTINE dia_harm_init
68	!!----------------------------------------------------------------------
69	!! * ROUTINE dia_harm_init *
70	!!
71	!! ** Purpose : Initialization of tidal harmonic analysis
72	!!
73	!! ** Method : Initialize frequency array and nodal factor for nit000_han
74	!!
75	!!--------------------------------------------------------------------
76	INTEGER :: jh, nhan, jk, ji
77	INTEGER :: ios ! Local integer output status for namelist read
78
79	NAMELIST/nam_diaharm/ nit000_han, nitend_han, nstep_han, tname
80	!!----------------------------------------------------------------------
81
82	IF(lwp) THEN
83	WRITE(numout,*)
84	WRITE(numout,*) 'dia_harm_init: Tidal harmonic analysis initialization'
85	WRITE(numout,*) '~~~~~~~ '
86	ENDIF
87	!
88	CALL tide_init_Wave
89	!
90	REWIND( numnam_ref ) ! Namelist nam_diaharm in reference namelist : Tidal harmonic analysis
91	READ ( numnam_ref, nam_diaharm, IOSTAT = ios, ERR = 901)
92	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diaharm in reference namelist', lwp )
93
94	REWIND( numnam_cfg ) ! Namelist nam_diaharm in configuration namelist : Tidal harmonic analysis
95	READ ( numnam_cfg, nam_diaharm, IOSTAT = ios, ERR = 902 )
96	902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diaharm in configuration namelist', lwp )
97	IF(lwm .AND. nprint > 2) WRITE ( numond, nam_diaharm )
98	!
99	IF(lwp) THEN
100	WRITE(numout,*) 'First time step used for analysis: nit000_han= ', nit000_han
101	WRITE(numout,*) 'Last time step used for analysis: nitend_han= ', nitend_han
102	WRITE(numout,*) 'Time step frequency for harmonic analysis: nstep_han= ', nstep_han
103	ENDIF
104
105	! Basic checks on harmonic analysis time window:
106	! ----------------------------------------------
107	IF( nit000 > nit000_han ) CALL ctl_stop( 'dia_harm_init : nit000_han must be greater than nit000', &
108	& ' restart capability not implemented' )
109	IF( nitend < nitend_han ) CALL ctl_stop( 'dia_harm_init : nitend_han must be lower than nitend', &
110	& 'restart capability not implemented' )
111
112	IF( MOD( nitend_han-nit000_han+1 , nstep_han ) /= 0 ) &
113	& CALL ctl_stop( 'dia_harm_init : analysis time span must be a multiple of nstep_han' )
114
115	nb_ana = 0
116	DO jk=1,jpmax_harmo
117	DO ji=1,jpmax_harmo
118	IF(TRIM(tname(jk)) == Wave(ji)%cname_tide) THEN
119	nb_ana=nb_ana+1
120	ENDIF
121	END DO
122	END DO
123	!
124	IF(lwp) THEN
125	WRITE(numout,*) ' Namelist nam_diaharm'
126	WRITE(numout,*) ' nb_ana = ', nb_ana
127	CALL flush(numout)
128	ENDIF
129	!
130	IF (nb_ana > jpmax_harmo) THEN
131	IF(lwp) WRITE(numout,*) ' E R R O R dia_harm_init : nb_ana must be lower than jpmax_harmo, stop'
132	IF(lwp) WRITE(numout,*) ' jpmax_harmo= ', jpmax_harmo
133	nstop = nstop + 1
134	ENDIF
135
136	ALLOCATE(name (nb_ana))
137	DO jk=1,nb_ana
138	DO ji=1,jpmax_harmo
139	IF (TRIM(tname(jk)) .eq. Wave(ji)%cname_tide) THEN
140	name(jk) = ji
141	EXIT
142	END IF
143	END DO
144	END DO
145
146	! Initialize frequency array:
147	! ---------------------------
148	ALLOCATE( ana_freq(nb_ana), ut(nb_ana), vt(nb_ana), ft(nb_ana) )
149
150	CALL tide_harmo( ana_freq, vt, ut, ft, name, nb_ana )
151
152	IF(lwp) WRITE(numout,*) 'Analysed frequency : ',nb_ana ,'Frequency '
153
154	DO jh = 1, nb_ana
155	IF(lwp) WRITE(numout,*) ' : ',tname(jh),' ',ana_freq(jh)
156	END DO
157
158	! Initialize temporary arrays:
159	! ----------------------------
160	ALLOCATE( ana_temp(jpi,jpj,2*nb_ana,3) )
161	ana_temp(:,:,:,:) = 0._wp
162
163	IF(lwp .AND. lflush) CALL flush(numout)
164
165	END SUBROUTINE dia_harm_init
166
167
168	SUBROUTINE dia_harm ( kt )
169	!!----------------------------------------------------------------------
170	!! * ROUTINE dia_harm *
171	!!
172	!! ** Purpose : Tidal harmonic analysis main routine
173	!!
174	!! ** Action : Sums ssh/u/v over time analysis [nit000_han,nitend_han]
175	!!
176	!!--------------------------------------------------------------------
177	INTEGER, INTENT( IN ) :: kt
178	!
179	INTEGER :: ji, jj, jh, jc, nhc
180	REAL(wp) :: ztime, ztemp
181	!!--------------------------------------------------------------------
182	IF( nn_timing == 1 ) CALL timing_start('dia_harm')
183
184	IF( kt == nit000 ) CALL dia_harm_init
185
186	IF( kt >= nit000_han .AND. kt <= nitend_han .AND. MOD(kt,nstep_han) == 0 ) THEN
187
188	ztime = (kt-nit000+1) * rdt
189
190	nhc = 0
191	DO jh = 1, nb_ana
192	DO jc = 1, 2
193	nhc = nhc+1
194	ztemp =( MOD(jc,2) * ft(jh) COS(ana_freq(jh)ztime + vt(jh) + ut(jh)) &
195	& +(1.-MOD(jc,2))* ft(jh) SIN(ana_freq(jh)ztime + vt(jh) + ut(jh)))
196
197	DO jj = 1,jpj
198	DO ji = 1,jpi
199	! Elevation
200	ana_temp(ji,jj,nhc,1) = ana_temp(ji,jj,nhc,1) + ztempsshn(ji,jj)tmask_i(ji,jj)
201	ana_temp(ji,jj,nhc,2) = ana_temp(ji,jj,nhc,2) + ztempun_b(ji,jj)umask_i(ji,jj)
202	ana_temp(ji,jj,nhc,3) = ana_temp(ji,jj,nhc,3) + ztempvn_b(ji,jj)vmask_i(ji,jj)
203	END DO
204	END DO
205	!
206	END DO
207	END DO
208	!
209	END IF
210
211	IF ( kt == nitend_han ) CALL dia_harm_end
212
213	IF( nn_timing == 1 ) CALL timing_stop('dia_harm')
214
215	END SUBROUTINE dia_harm
216
217
218	SUBROUTINE dia_harm_end
219	!!----------------------------------------------------------------------
220	!! * ROUTINE diaharm_end *
221	!!
222	!! ** Purpose : Compute the Real and Imaginary part of tidal constituents
223	!!
224	!! ** Action : Decompose the signal on the harmonic constituents
225	!!
226	!!--------------------------------------------------------------------
227	INTEGER :: ji, jj, jh, jc, jn, nhan, jl
228	INTEGER :: ksp, kun, keq
229	REAL(wp) :: ztime, ztime_ini, ztime_end
230	REAL(wp) :: X1,X2
231	REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ana_amp
232	!!--------------------------------------------------------------------
233	CALL wrk_alloc( jpi , jpj , jpmax_harmo , 2 , ana_amp )
234
235	IF(lwp) THEN
236	WRITE(numout,*)
237	WRITE(numout,*) 'anharmo_end: kt=nitend_han: Perform harmonic analysis'
238	WRITE(numout,*) '~~~~~~~~~~~~'
239	IF(lflush) CALL flush(numout)
240	ENDIF
241
242	ztime_ini = nit000_han*rdt ! Initial time in seconds at the beginning of analysis
243	ztime_end = nitend_han*rdt ! Final time in seconds at the end of analysis
244	nhan = (nitend_han-nit000_han+1)/nstep_han ! Number of dumps used for analysis
245
246	ninco = 2*nb_ana
247
248	ksp = 0
249	keq = 0
250	DO jn = 1, nhan
251	ztime=( (nhan-jn)ztime_ini + (jn-1)ztime_end )/FLOAT(nhan-1)
252	keq = keq + 1
253	kun = 0
254	DO jh = 1, nb_ana
255	DO jc = 1, 2
256	kun = kun + 1
257	ksp = ksp + 1
258	nisparse(ksp) = keq
259	njsparse(ksp) = kun
260	valuesparse(ksp) = ( MOD(jc,2) * ft(jh) * COS(ana_freq(jh)*ztime + vt(jh) + ut(jh)) &
261	& + (1.-MOD(jc,2))* ft(jh) * SIN(ana_freq(jh)*ztime + vt(jh) + ut(jh)) )
262	END DO
263	END DO
264	END DO
265
266	nsparse = ksp
267
268	! Elevation:
269	DO jj = 1, jpj
270	DO ji = 1, jpi
271	! Fill input array
272	kun = 0
273	DO jh = 1, nb_ana
274	DO jc = 1, 2
275	kun = kun + 1
276	ztmp4(kun)=ana_temp(ji,jj,kun,1)
277	END DO
278	END DO
279
280	CALL SUR_DETERMINE(jj)
281
282	! Fill output array
283	DO jh = 1, nb_ana
284	ana_amp(ji,jj,jh,1)=ztmp7((jh-1)*2+1)
285	ana_amp(ji,jj,jh,2)=ztmp7((jh-1)*2+2)
286	END DO
287	END DO
288	END DO
289
290	ALLOCATE( out_eta(jpi,jpj,2*nb_ana), &
291	& out_u (jpi,jpj,2*nb_ana), &
292	& out_v (jpi,jpj,2*nb_ana) )
293
294	DO jj = 1, jpj
295	DO ji = 1, jpi
296	DO jh = 1, nb_ana
297	X1 = ana_amp(ji,jj,jh,1)
298	X2 =-ana_amp(ji,jj,jh,2)
299	out_eta(ji,jj,jh ) = X1 * tmask_i(ji,jj)
300	out_eta(ji,jj,jh+nb_ana) = X2 * tmask_i(ji,jj)
301	END DO
302	END DO
303	END DO
304
305	! ubar:
306	DO jj = 1, jpj
307	DO ji = 1, jpi
308	! Fill input array
309	kun=0
310	DO jh = 1,nb_ana
311	DO jc = 1,2
312	kun = kun + 1
313	ztmp4(kun)=ana_temp(ji,jj,kun,2)
314	END DO
315	END DO
316
317	CALL SUR_DETERMINE(jj+1)
318
319	! Fill output array
320	DO jh = 1, nb_ana
321	ana_amp(ji,jj,jh,1) = ztmp7((jh-1)*2+1)
322	ana_amp(ji,jj,jh,2) = ztmp7((jh-1)*2+2)
323	END DO
324
325	END DO
326	END DO
327
328	DO jj = 1, jpj
329	DO ji = 1, jpi
330	DO jh = 1, nb_ana
331	X1= ana_amp(ji,jj,jh,1)
332	X2=-ana_amp(ji,jj,jh,2)
333	out_u(ji,jj, jh) = X1 * umask_i(ji,jj)
334	out_u(ji,jj,nb_ana+jh) = X2 * umask_i(ji,jj)
335	ENDDO
336	ENDDO
337	ENDDO
338
339	! vbar:
340	DO jj = 1, jpj
341	DO ji = 1, jpi
342	! Fill input array
343	kun=0
344	DO jh = 1,nb_ana
345	DO jc = 1,2
346	kun = kun + 1
347	ztmp4(kun)=ana_temp(ji,jj,kun,3)
348	END DO
349	END DO
350
351	CALL SUR_DETERMINE(jj+1)
352
353	! Fill output array
354	DO jh = 1, nb_ana
355	ana_amp(ji,jj,jh,1)=ztmp7((jh-1)*2+1)
356	ana_amp(ji,jj,jh,2)=ztmp7((jh-1)*2+2)
357	END DO
358
359	END DO
360	END DO
361
362	DO jj = 1, jpj
363	DO ji = 1, jpi
364	DO jh = 1, nb_ana
365	X1=ana_amp(ji,jj,jh,1)
366	X2=-ana_amp(ji,jj,jh,2)
367	out_v(ji,jj, jh)=X1 * vmask_i(ji,jj)
368	out_v(ji,jj,nb_ana+jh)=X2 * vmask_i(ji,jj)
369	END DO
370	END DO
371	END DO
372
373	CALL dia_wri_harm ! Write results in files
374	CALL wrk_dealloc( jpi , jpj , jpmax_harmo , 2 , ana_amp )
375	!
376	END SUBROUTINE dia_harm_end
377
378
379	SUBROUTINE dia_wri_harm
380	!!--------------------------------------------------------------------
381	!! * ROUTINE dia_wri_harm *
382	!!
383	!! ** Purpose : Write tidal harmonic analysis results in a netcdf file
384	!!--------------------------------------------------------------------
385	CHARACTER(LEN=lc) :: cltext
386	CHARACTER(LEN=lc) :: &
387	cdfile_name_T , & ! name of the file created (T-points)
388	cdfile_name_U , & ! name of the file created (U-points)
389	cdfile_name_V ! name of the file created (V-points)
390	INTEGER :: jh
391	!!----------------------------------------------------------------------
392
393	#if defined key_dimgout
394	cdfile_name_T = TRIM(cexper)//'_Tidal_harmonics_gridT.dimgproc'
395	cdfile_name_U = TRIM(cexper)//'_Tidal_harmonics_gridU.dimgproc'
396	cdfile_name_V = TRIM(cexper)//'_Tidal_harmonics_gridV.dimgproc'
397	#endif
398
399	IF(lwp) WRITE(numout,*) ' '
400	IF(lwp) WRITE(numout,*) 'dia_wri_harm : Write harmonic analysis results'
401	#if defined key_dimgout
402	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~ Output files: ', TRIM(cdfile_name_T)
403	IF(lwp) WRITE(numout,*) ' ', TRIM(cdfile_name_U)
404	IF(lwp) WRITE(numout,*) ' ', TRIM(cdfile_name_V)
405	#endif
406	IF(lwp) WRITE(numout,*) ' '
407	IF(lwp .AND. lflush) CALL flush(numout)
408
409	! A) Elevation
410	!/////////////
411	!
412	#if defined key_dimgout
413	cltext='Elevation amplitude and phase'
414	CALL dia_wri_dimg(TRIM(cdfile_name_T), TRIM(cltext), out_eta, 2*nb_ana, '2')
415	#else
416	DO jh = 1, nb_ana
417	CALL iom_put( TRIM(tname(jh))//'x', out_eta(:,:,jh) )
418	CALL iom_put( TRIM(tname(jh))//'y', out_eta(:,:,nb_ana+jh) )
419	END DO
420	#endif
421
422	! B) ubar
423	!/////////
424	!
425	#if defined key_dimgout
426	cltext='ubar amplitude and phase'
427	CALL dia_wri_dimg(TRIM(cdfile_name_U), TRIM(cltext), out_u, 2*nb_ana, '2')
428	#else
429	DO jh = 1, nb_ana
430	CALL iom_put( TRIM(tname(jh))//'x_u', out_u(:,:,jh) )
431	CALL iom_put( TRIM(tname(jh))//'y_u', out_u(:,:,nb_ana+jh) )
432	END DO
433	#endif
434
435	! C) vbar
436	!/////////
437	!
438	#if defined key_dimgout
439	cltext='vbar amplitude and phase'
440	CALL dia_wri_dimg(TRIM(cdfile_name_V), TRIM(cltext), out_v, 2*nb_ana, '2')
441	#else
442	DO jh = 1, nb_ana
443	CALL iom_put( TRIM(tname(jh))//'x_v', out_v(:,:,jh ) )
444	CALL iom_put( TRIM(tname(jh))//'y_v', out_v(:,:,jh+nb_ana) )
445	END DO
446	#endif
447	!
448	END SUBROUTINE dia_wri_harm
449
450
451	SUBROUTINE SUR_DETERMINE(init)
452	!!---------------------------------------------------------------------------------
453	!! * ROUTINE SUR_DETERMINE *
454	!!
455	!!
456	!!
457	!!---------------------------------------------------------------------------------
458	INTEGER, INTENT(in) :: init
459	!
460	INTEGER :: ji_sd, jj_sd, ji1_sd, ji2_sd, jk1_sd, jk2_sd
461	REAL(wp) :: zval1, zval2, zx1
462	REAL(wp), POINTER, DIMENSION(:) :: ztmpx, zcol1, zcol2
463	INTEGER , POINTER, DIMENSION(:) :: ipos2, ipivot
464	!---------------------------------------------------------------------------------
465	CALL wrk_alloc( jpincomax , ztmpx , zcol1 , zcol2 )
466	CALL wrk_alloc( jpincomax , ipos2 , ipivot )
467
468	IF( init == 1 ) THEN
469	IF( nsparse > jpdimsparse ) CALL ctl_stop( 'STOP', 'SUR_DETERMINE : nsparse .GT. jpdimsparse')
470	IF( ninco > jpincomax ) CALL ctl_stop( 'STOP', 'SUR_DETERMINE : ninco .GT. jpincomax')
471	!
472	ztmp3(:,:) = 0._wp
473	!
474	DO jk1_sd = 1, nsparse
475	DO jk2_sd = 1, nsparse
476	nisparse(jk2_sd) = nisparse(jk2_sd)
477	njsparse(jk2_sd) = njsparse(jk2_sd)
478	IF( nisparse(jk2_sd) == nisparse(jk1_sd) ) THEN
479	ztmp3(njsparse(jk1_sd),njsparse(jk2_sd)) = ztmp3(njsparse(jk1_sd),njsparse(jk2_sd)) &
480	& + valuesparse(jk1_sd)*valuesparse(jk2_sd)
481	ENDIF
482	END DO
483	END DO
484	!
485	DO jj_sd = 1 ,ninco
486	ipos1(jj_sd) = jj_sd
487	ipos2(jj_sd) = jj_sd
488	END DO
489	!
490	DO ji_sd = 1 , ninco
491	!
492	!find greatest non-zero pivot:
493	zval1 = ABS(ztmp3(ji_sd,ji_sd))
494	!
495	ipivot(ji_sd) = ji_sd
496	DO jj_sd = ji_sd, ninco
497	zval2 = ABS(ztmp3(ji_sd,jj_sd))
498	IF( zval2.GE.zval1 )THEN
499	ipivot(ji_sd) = jj_sd
500	zval1 = zval2
501	ENDIF
502	END DO
503	!
504	DO ji1_sd = 1, ninco
505	zcol1(ji1_sd) = ztmp3(ji1_sd,ji_sd)
506	zcol2(ji1_sd) = ztmp3(ji1_sd,ipivot(ji_sd))
507	ztmp3(ji1_sd,ji_sd) = zcol2(ji1_sd)
508	ztmp3(ji1_sd,ipivot(ji_sd)) = zcol1(ji1_sd)
509	END DO
510	!
511	ipos2(ji_sd) = ipos1(ipivot(ji_sd))
512	ipos2(ipivot(ji_sd)) = ipos1(ji_sd)
513	ipos1(ji_sd) = ipos2(ji_sd)
514	ipos1(ipivot(ji_sd)) = ipos2(ipivot(ji_sd))
515	zpivot(ji_sd) = ztmp3(ji_sd,ji_sd)
516	DO jj_sd = 1, ninco
517	ztmp3(ji_sd,jj_sd) = ztmp3(ji_sd,jj_sd) / zpivot(ji_sd)
518	END DO
519	!
520	DO ji2_sd = ji_sd+1, ninco
521	zpilier(ji2_sd,ji_sd)=ztmp3(ji2_sd,ji_sd)
522	DO jj_sd=1,ninco
523	ztmp3(ji2_sd,jj_sd)= ztmp3(ji2_sd,jj_sd) - ztmp3(ji_sd,jj_sd) * zpilier(ji2_sd,ji_sd)
524	END DO
525	END DO
526	!
527	END DO
528	!
529	ENDIF ! End init==1
530
531	DO ji_sd = 1, ninco
532	ztmp4(ji_sd) = ztmp4(ji_sd) / zpivot(ji_sd)
533	DO ji2_sd = ji_sd+1, ninco
534	ztmp4(ji2_sd) = ztmp4(ji2_sd) - ztmp4(ji_sd) * zpilier(ji2_sd,ji_sd)
535	END DO
536	END DO
537
538	!system solving:
539	ztmpx(ninco) = ztmp4(ninco) / ztmp3(ninco,ninco)
540	ji_sd = ninco
541	DO ji_sd = ninco-1, 1, -1
542	zx1 = 0._wp
543	DO jj_sd = ji_sd+1, ninco
544	zx1 = zx1 + ztmpx(jj_sd) * ztmp3(ji_sd,jj_sd)
545	END DO
546	ztmpx(ji_sd) = ztmp4(ji_sd)-zx1
547	END DO
548
549	DO jj_sd =1, ninco
550	ztmp7(ipos1(jj_sd))=ztmpx(jj_sd)
551	END DO
552
553	CALL wrk_dealloc( jpincomax , ztmpx , zcol1 , zcol2 )
554	CALL wrk_dealloc( jpincomax , ipos2 , ipivot )
555	!
556	END SUBROUTINE SUR_DETERMINE
557
558	#else
559	!!----------------------------------------------------------------------
560	!! Default case : Empty module
561	!!----------------------------------------------------------------------
562	LOGICAL, PUBLIC, PARAMETER :: lk_diaharm = .FALSE.
563	CONTAINS
564	SUBROUTINE dia_harm ( kt ) ! Empty routine
565	INTEGER, INTENT( IN ) :: kt
566	WRITE(,) 'dia_harm: you should not have seen this print'
567	END SUBROUTINE dia_harm
568	#endif
569
570	!!======================================================================
571	END MODULE diaharm

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/DIA/diaharm.F90

Download in other formats: