1 SUBROUTINE woflam(trigsu, trigsv, ifaxu, ifaxv, irho)
19 INTEGER,
DIMENSION(13) :: ifaxu, ifaxv
20 REAL(rprec),
DIMENSION(3*nthetah/2 + 1) :: trigsu
21 REAL(rprec),
DIMENSION(2*nzetah) :: trigsv
25 REAL(rprec),
PARAMETER :: zero = 0, one = 1,
26 1 d18 = 1.0e-18_dp, xlam = 0.96_dp
27 INTEGER,
PARAMETER :: n_lam_coarse = 97, n_lam = 137
35 REAL(rprec),
DIMENSION(:,:),
ALLOCATABLE :: a11
36 complex(rprec),
DIMENSION(:,:),
ALLOCATABLE ::
38 REAL(rprec) :: qn, numer, avg_vpov, denom
39 REAL(rprec),
DIMENSION(n_lam) :: xlam_f
40 REAL(rprec),
DIMENSION(n_lam-1) :: xlam_h
44 REAL(rprec) ,
EXTERNAL :: sumit
48 ALLOCATE (a11(nthetah+2,nzetah),
49 5 alphamn(-mbuse:mbuse,0:nbuse),
50 8 vmn(-mbuse:mbuse,0:nbuse), stat=l)
52 IF (l .ne. 0) stop
'allocation error in woflam'
72 IF (isymm0 .ne. 0)
THEN
83 DO l = 2, n_lam_coarse-1
84 xlam_f(l) = xlam_f(l-1) + 0.01_dp
85 xlam_h(l) = xlam_h(l-1) + 0.01_dp
88 xlam_f(n_lam_coarse) = 0.96_dp
89 xlam_h(n_lam_coarse) = 0.9605_dp
91 DO l = n_lam_coarse+1, n_lam-1
92 xlam_f(l) = xlam_f(l-1) + 0.001_dp
93 xlam_h(l) = xlam_h(l-1) + 0.001_dp
107 a11(:nthetah,:nzetah) =
108 2 sqrt(abs(one - xlam_f(l)*bfield(:nthetah,:nzetah))+d18)
109 3 *b2avg(irho)/bmax1(irho)**2/bfield(:nthetah,:nzetah)
110 a11(nthetah+1,:nzetah) = zero
111 a11(nthetah+2,:nzetah) = zero
112 CALL do_fft (a11, fmn, trigsu, trigsv, ifaxu, ifaxv, nthetah,
113 1 nzetah, mbuse, nbuse)
122 IF(l .eq. n_lam) alpha1mn = fmn
135 a11(:nthetah,:nzetah) =
136 1 sqrt(abs(one - xlam_h(l-1)*bfield(:nthetah,:nzetah)) + d18)
137 2 *(b2avg(irho)/bfield(:nthetah,:nzetah)*bmax1(irho))**2
139 a11(nthetah+1,:nzetah) = zero
140 a11(nthetah+2,:nzetah) = zero
142 CALL do_fft (a11, vmn, trigsu, trigsv, ifaxu, ifaxv, nthetah,
143 1 nzetah, mbuse, nbuse)
147 avg_vpov = real(vmn(0,0))
152 qn = periods*qsafety(irho)*zetasign
158 IF (n.ne.0 .or. m.ne.0)
THEN
160 numer = denom/(denom**2 + (damp_bs*m)**2)
162 rfmn(m,n) = (m*capr(irho) + n*periods*caps(irho))*
163 1 real(fmn(m,n)*vmn(m,n))*(-2*numer)
175 w1(l-1) = xlam_h(l-1)*sumit(rfmn,mbuse,nbuse)/avg_vpov
182 aiterm1(irho) = sum(w1)
183 aiterm1(irho) = -0.75_dp*aiterm1(irho)*qsafety(irho)
184 1 /ftrapped(irho) * (one + aiogar(irho)/qsafety(irho))
186 DEALLOCATE (a11, alphamn, vmn, stat=l)
188 END SUBROUTINE woflam