KTH framework for Nek5000 toolboxes; testing version  0.0.1
nseb.f
Go to the documentation of this file.
1 
6 !=======================================================================
10  subroutine nseb_register()
11  implicit none
12 
13  include 'SIZE'
14  include 'INPUT'
15  include 'FRAMELP'
16  include 'NSEBD'
17 
18  ! local variables
19  integer lpmid, il, jl
20  real ltim
21  ! initial values for nseb_rfc
22  real rfc(3,ldim)
23  character*1 str1, str2
24 
25  ! functions
26  real dnekclock
27 !-----------------------------------------------------------------------
28  ! timing
29  ltim = dnekclock()
30 
31  ! check if the current module was already registered
32  call mntr_mod_is_name_reg(lpmid,nseb_name)
33  if (lpmid.gt.0) then
34  call mntr_warn(lpmid,
35  $ 'module ['//trim(nseb_name)//'] already registered')
36  return
37  endif
38 
39  ! find parent module
40  call mntr_mod_is_name_reg(lpmid,'FRAME')
41  if (lpmid.le.0) then
42  lpmid = 1
43  call mntr_abort(lpmid,
44  $ 'Parent module ['//'FRAME'//'] not registered')
45  endif
46 
47  ! register module
48  call mntr_mod_reg(nseb_id,lpmid,nseb_name,
49  $ 'Adding white noise in rectangular domain')
50 
51  ! register timer
52  call mntr_tmr_is_name_reg(lpmid,'FRM_TOT')
53  call mntr_tmr_reg(nseb_tmr_id,lpmid,nseb_id,
54  $ 'NSEB_TOT','Noise box total time',.false.)
55 
56  ! register and set active section
57  call rprm_sec_reg(nseb_sec_id,nseb_id,'_'//adjustl(nseb_name),
58  $ 'Runtime paramere section for nseb module')
59  call rprm_sec_set_act(.true.,nseb_sec_id)
60 
61  ! register parameters
62  call rprm_rp_reg(nseb_tim_id,nseb_sec_id,'TIME',
63  $ 'Time to add noise',rpar_real,0,0.0,.false.,' ')
64 
65  call rprm_rp_reg(nseb_amp_id,nseb_sec_id,'AMPLITUDE',
66  $ 'Noise amplitude',rpar_real,0,0.0,.false.,' ')
67 
68  call rprm_rp_reg(nseb_bmin_id(1),nseb_sec_id,'BOXMINX',
69  $ 'Position of lower left box corner; dimension X ',
70  $ rpar_real,0,0.0,.false.,' ')
71 
72  call rprm_rp_reg(nseb_bmin_id(2),nseb_sec_id,'BOXMINY',
73  $ 'Position of lower left box corner; dimension Y ',
74  $ rpar_real,0,0.0,.false.,' ')
75 
76  if (if3d) call rprm_rp_reg(nseb_bmin_id(ndim),nseb_sec_id,
77  $ 'BOXMINZ','Position of lower left box corner; dimension Z ',
78  $ rpar_real,0,0.0,.false.,' ')
79 
80  call rprm_rp_reg(nseb_bmax_id(1),nseb_sec_id,'BOXMAXX',
81  $ 'Position of upper right box corner; dimension X ',
82  $ rpar_real,0,0.0,.false.,' ')
83 
84  call rprm_rp_reg(nseb_bmax_id(2),nseb_sec_id,'BOXMAXY',
85  $ 'Position of upper right box corner; dimension Y ',
86  $ rpar_real,0,0.0,.false.,' ')
87 
88  if (if3d) call rprm_rp_reg(nseb_bmax_id(ndim),nseb_sec_id,
89  $ 'BOXMAXZ','Position of upper right box corner; dimension Z ',
90  $ rpar_real,0,0.0,.false.,' ')
91 
92  ! function coefficients for random number generator
93  ! initial values
94  rfc(1,1) = 3.0e4
95  rfc(2,1) =-1.5e3
96  rfc(3,1) = 0.5e5
97  rfc(1,2) = 2.3e4
98  rfc(2,2) = 2.3e3
99  rfc(3,2) =-2.0e5
100  if (if3d) then
101  rfc(1,ldim) = 2.e4
102  rfc(2,ldim) = 1.e3
103  rfc(3,ldim) = 1.e5
104  end if
105  do il = 1, ldim
106  write(str1,'(I1.1)') il
107  do jl=1, 3
108  write(str2,'(I1.1)') jl
109  call rprm_rp_reg(nseb_rfc_id(jl,il),nseb_sec_id,
110  $ 'FRC'//str2//'_'//str1,
111  $ 'Function coefficient for random number gnerator ',
112  $ rpar_real,0,rfc(jl,il),.false.,' ')
113  end do
114  end do
115 
116  ! timing
117  ltim = dnekclock() - ltim
118  call mntr_tmr_add(nseb_tmr_id,1,ltim)
119 
120  return
121  end subroutine
122 !=======================================================================
127  subroutine nseb_init()
128  implicit none
129 
130  include 'SIZE'
131  include 'INPUT'
132  include 'FRAMELP'
133  include 'NSEBD'
134 
135  ! local variables
136  integer ierr, nhour, nmin, il, jl
137  integer itmp
138  real rtmp, ltim
139  logical ltmp
140  character*20 ctmp
141 
142  ! functions
143  real dnekclock
144 !-----------------------------------------------------------------------
145  ! check if the module was already initialised
146  if (nseb_ifinit) then
147  call mntr_warn(nseb_id,
148  $ 'module ['//trim(nseb_name)//'] already initiaised.')
149  return
150  endif
151 
152  ! timing
153  ltim = dnekclock()
154 
155  ! get runtime parameters
156  call rprm_rp_get(itmp,rtmp,ltmp,ctmp,nseb_tim_id,rpar_real)
157  nseb_tim = rtmp
158 
159  call rprm_rp_get(itmp,rtmp,ltmp,ctmp,nseb_amp_id,rpar_real)
160  nseb_amp = rtmp
161 
162  call rprm_rp_get(itmp,rtmp,ltmp,ctmp,nseb_bmin_id(1),
163  $ rpar_real)
164  nseb_bmin(1) = rtmp
165 
166  call rprm_rp_get(itmp,rtmp,ltmp,ctmp,nseb_bmin_id(2),
167  $ rpar_real)
168  nseb_bmin(2) = rtmp
169 
170  if (if3d) then
171  call rprm_rp_get(itmp,rtmp,ltmp,ctmp,nseb_bmin_id(ndim),
172  $ rpar_real)
173  nseb_bmin(ndim) = rtmp
174  endif
175 
176  call rprm_rp_get(itmp,rtmp,ltmp,ctmp,nseb_bmax_id(1),
177  $ rpar_real)
178  nseb_bmax(1) = rtmp
179 
180  call rprm_rp_get(itmp,rtmp,ltmp,ctmp,nseb_bmax_id(2),
181  $ rpar_real)
182  nseb_bmax(2) = rtmp
183 
184  if (if3d) then
185  call rprm_rp_get(itmp,rtmp,ltmp,ctmp,nseb_bmax_id(ndim),
186  $ rpar_real)
187  nseb_bmax(ndim) = rtmp
188  endif
189 
190  ! function coefficients for random number generator
191  do il = 1, ldim
192  do jl=1, 3
193  call rprm_rp_get(itmp,rtmp,ltmp,ctmp,nseb_rfc_id(jl,il),
194  $ rpar_real)
195  nseb_rfc(jl,il) = rtmp
196  end do
197  end do
198 
199  ! is everything initialised
200  nseb_ifinit=.true.
201 
202  ! timing
203  ltim = dnekclock() - ltim
204  call mntr_tmr_add(nseb_tmr_id,1,ltim)
205 
206  return
207  end subroutine
208 !=======================================================================
212  logical function nseb_is_initialised()
213  implicit none
214 
215  include 'SIZE'
216  include 'NSEBD'
217 !-----------------------------------------------------------------------
218  nseb_is_initialised = nseb_ifinit
219 
220  return
221  end function
222 !=======================================================================
225  subroutine nseb_noise_add()
226  implicit none
227 
228  include 'SIZE' ! NX1, NY1, NZ1, NELV, NID
229  include 'TSTEP' ! TIME, DT
230  include 'PARALLEL' ! LGLEL
231  include 'INPUT' ! IF3D
232  include 'SOLN' ! VX, VY, VZ, VMULT
233  include 'GEOM' ! XM1, YM1, ZM1
234  include 'FRAMELP'
235  include 'NSEBD'
236 
237  ! local variables
238  integer iel, ieg, il, jl, kl, nl
239  real xl(LDIM)
240  logical ifadd
241  real fcoeff(3)
242  real ltim
243 
244  ! functions
245  real dnekclock, math_ran_dst
246 !-----------------------------------------------------------------------
247  ! add noise
248  if (nseb_amp.gt.0.0) then
249  if (nseb_tim.ge.time.and.nseb_tim.le.(time+dt)) then
250 
251  ! timing
252  ltim = dnekclock()
253  call mntr_log(nseb_id,lp_inf,
254  $ "Adding noise to velocity field")
255 
256  do iel=1,nelv
257  do kl=1,nz1
258  do jl=1,ny1
259  do il=1,nx1
260  ieg = lglel(iel)
261  xl(1) = xm1(il,jl,kl,iel)
262  xl(2) = ym1(il,jl,kl,iel)
263  if (if3d) xl(ndim) = zm1(il,jl,kl,iel)
264  ifadd = .true.
265  do nl=1,ndim
266  if (xl(nl).lt.nseb_bmin(nl).or.
267  $ xl(nl).gt.nseb_bmax(nl)) then
268  ifadd = .false.
269  exit
270  endif
271  enddo
272 
273  if (ifadd) then
274  vx(il,jl,kl,iel)=vx(il,jl,kl,iel)+nseb_amp*
275  $ math_ran_dst(il,jl,kl,ieg,xl,nseb_rfc(1,1))
276  vy(il,jl,kl,iel)=vy(il,jl,kl,iel)+nseb_amp*
277  $ math_ran_dst(il,jl,kl,ieg,xl,nseb_rfc(1,2))
278  if (if3d) vz(il,jl,kl,iel)=vz(il,jl,kl,iel)+
279  $ nseb_amp*math_ran_dst(il,jl,kl,ieg,xl,
280  $ nseb_rfc(1,ldim))
281  endif
282 
283  enddo
284  enddo
285  enddo
286  enddo
287 
288  ! face averaging
289  call opdssum(vx,vy,vz)
290  call opcolv (vx,vy,vz,vmult)
291 
292  ! timing
293  ltim = dnekclock() - ltim
294  call mntr_tmr_add(nseb_tmr_id,1,ltim)
295 
296  endif
297  endif
298 
299  return
300  end subroutine
301 !=======================================================================
mntr_tmr_is_name_reg
subroutine mntr_tmr_is_name_reg(mid, mname)
Check if timer name is registered and return its id.
Definition: mntrtmr.f:146
mntr_warn
subroutine mntr_warn(mid, logs)
Write warning message.
Definition: mntrlog.f:803
mntr_tmr_add
subroutine mntr_tmr_add(mid, icount, time)
Check if timer id is registered. This operation is performed locally.
Definition: mntrtmr.f:237
mntr_mod_is_name_reg
subroutine mntr_mod_is_name_reg(mid, mname)
Check if module name is registered and return its id.
Definition: mntrlog.f:459
mntr_abort
subroutine mntr_abort(mid, logs)
Abort simulation.
Definition: mntrlog.f:837
mntr_log
subroutine mntr_log(mid, priority, logs)
Write log message.
Definition: mntrlog.f:600
mntr_mod_reg
subroutine mntr_mod_reg(mid, pmid, mname, mdscr)
Register new module.
Definition: mntrlog.f:346
mntr_tmr_reg
subroutine mntr_tmr_reg(mid, pmid, modid, mname, mdscr, ifsum)
Register new timer.
Definition: mntrtmr.f:16
nseb_is_initialised
logical function nseb_is_initialised()
Check if module was initialised.
Definition: nseb.f:213
nseb_init
subroutine nseb_init()
Initilise noise box module.
Definition: nseb.f:128
nseb_register
subroutine nseb_register()
Register noise box module.
Definition: nseb.f:11
nseb_noise_add
subroutine nseb_noise_add()
Add noise to velocity field in a box.
Definition: nseb.f:226
rprm_rp_get
subroutine rprm_rp_get(ipval, rpval, lpval, cpval, rpid, ptype)
Get runtime parameter form active section. This operation is performed locally.
Definition: rprm.f:883
rprm_rp_reg
subroutine rprm_rp_reg(rpid, mid, pname, pdscr, ptype, ipval, rpval, lpval, cpval)
Register new runtime parameter.
Definition: rprm.f:484
rprm_sec_set_act
subroutine rprm_sec_set_act(ifact, rpid)
Set section's activation flag. Master value is broadcasted.
Definition: rprm.f:422
rprm_sec_reg
subroutine rprm_sec_reg(rpid, mid, pname, pdscr)
Register new parameter section.
Definition: rprm.f:165
opdssum
subroutine opdssum(a, b, c)
Definition: navier1.f:2582
opcolv
subroutine opcolv(a1, a2, a3, c)
Definition: navier1.f:2418