1 SUBROUTINE tok_fraction(ft_tok)
20 REAL(rprec),
PARAMETER :: one = 1
25 REAL(rprec) fub, flb, bavg, b2av, sum_gsqrt_tok
29 REAL(rprec),
DIMENSION(:),
ALLOCATABLE ::
30 1 bfield_tok, gsqrt_tok, b2obm_tok, one_b2
31 ALLOCATE(bfield_tok(nthetah), gsqrt_tok(nthetah),
32 1 b2obm_tok(nthetah), one_b2(nthetah), stat = i)
33 IF(i .ne. 0) stop
'allocation error of tokamak fields'
40 bfield_tok(i) = sum(bfield(i,:nzetah))/nzetah
45 bmax = maxval(bfield_tok)
46 bfield_tok = bfield_tok/bmax
47 WHERE(bfield_tok .gt. one) bfield_tok = one
51 one_b2 = one/bfield_tok**2
52 b2obm_tok = bfield_tok**2
56 sum_gsqrt_tok= sum(one_b2)
61 bavg = sum(bfield_tok*one_b2)/sum_gsqrt_tok
62 b2av = sum(b2obm_tok*one_b2)/sum_gsqrt_tok
66 fub = one-(one-sqrt(one-bavg)*(one+0.5_dp*bavg))*b2av/bavg**2
73 flb = - sum(one/b2obm_tok**2)/sum_gsqrt_tok
77 flb = flb + sum(sqrt(one-bfield_tok)
78 1 /b2obm_tok**2)/sum_gsqrt_tok
82 flb = flb + 0.5_dp*sum(sqrt(one-bfield_tok)
83 1 /bfield_tok/b2obm_tok)/sum_gsqrt_tok
91 ft_tok = 0.25_dp*flb + 0.75_dp*fub
93 DEALLOCATE(bfield_tok, gsqrt_tok, b2obm_tok, one_b2)
96 END SUBROUTINE tok_fraction