89 TYPE(t_region
),
INTENT(INOUT) :: region
92 REAL(RFREAL),
INTENT(IN) :: dt
95 REAL(RFREAL) :: dtn,fac,e0,e1,s0,s1,ts,a0,b0,a1,b1,del
96 REAL(RFREAL),
POINTER :: params(:), bvals(:,:)
102 global => region%global
105 'UpdateTbcStochastic.F90' )
110 dtn = dt/params(tbcdat_timecor)
111 fac = -2.0_rfreal/params(tbcdat_shape)
113 e0 = exp(fac*dtn*dtn)
114 e1 = exp(2.0_rfreal*fac*dtn)
115 s0 =
sqrt(1.0_rfreal - e0*e0)
116 s1 =
sqrt(1.0_rfreal - e1*e1)
117 ts = 0.5_rfreal * params(tbcdat_timecor) *
sqrt(params(tbcdat_shape))
121 a1 = -s0*e1 / (ts*e0)
123 del =
sqrt(12.0_rfreal) * params(tbcdat_amp) * s1 / ts
125 CALL
randuniform(bvals(tbcsto_factor,:),region%randData)
127 bvals(tbcsto_val, :) = a0*bvals(tbcsto_val,:) + b0*bvals(tbcsto_dval,:)
128 bvals(tbcsto_dval,:) = a1*bvals(tbcsto_val,:) + b1*bvals(tbcsto_dval,:) + &
129 del * (bvals(tbcsto_factor,:) - 0.5_rfreal)
130 bvals(tbcsto_factor,:) = exp(bvals(tbcsto_val,:) - &
131 0.5_rfreal * params(tbcdat_amp)**2 )
132 IF (params(tbcdat_mincut) >= 0._rfreal) &
133 bvals(tbcsto_factor,:) =
max(params(tbcdat_mincut),bvals(tbcsto_factor,:))
134 IF (params(tbcdat_maxcut) >= 0._rfreal) &
135 bvals(tbcsto_factor,:) =
min(params(tbcdat_maxcut),bvals(tbcsto_factor,:))
Vector_n max(const Array_n_const &v1, const Array_n_const &v2)
subroutine registerfunction(global, funName, fileName)
subroutine updatetbcstochastic(region, tbc, dt)
subroutine randuniform(a, rdata)
Vector_n min(const Array_n_const &v1, const Array_n_const &v2)
subroutine deregisterfunction(global)