Context Navigation

diaharm.F90 @ 9383

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

Download in other formats: