1 SUBROUTINE funct(r0c, z0c, rhoc, rhos, xpts, gr0c, gz0c, grhoc,
2 1 grhos, gpts, fsq, xin, yin, mrho_in)
13 REAL(rprec) fsq, r0c, z0c, gr0c, gz0c
14 REAL(rprec),
DIMENSION(ntheta) :: xpts, gpts, xin, yin
15 REAL(rprec),
DIMENSION(0:mrho_in-1) ::
16 1 rhoc, rhos, grhoc, grhos
21 REAL(rprec),
DIMENSION(ntheta) ::
22 1 gcon, gtt, r1, z1, rt1, zt1
23 REAL(rprec),
DIMENSION(ntheta,0:mrho_in) :: cosa, sina
24 REAL(rprec) :: denom, rmc_p, zms_p, rms_p, zmc_p,
39 r1(:ntheta) = -xin(:ntheta)
40 z1(:ntheta) = -yin(:ntheta)
53 cosa(:,m) = cosa(:,m-1)*cosa(:,1) - sina(:,m-1)*sina(:,1)
54 sina(:,m) = sina(:,m-1)*cosa(:,1) + cosa(:,m-1)*sina(:,1)
58 CALL getrz(rmc_p,rms_p,zmc_p,zms_p,r0c,z0c,rhoc,rhos,
63 t2 = rmc_p*rmc_p + zmc_p*zmc_p + rms_p*rms_p + zms_p*zms_p
64 denom = denom + t2*xmpq(m,2)
65 specw = specw + xmpq(m,1)*t2
67 gtt(:ntheta) = rmc_p*cosa(:ntheta,m) + rms_p*sina(:ntheta,m)
68 gcon(:ntheta) = zmc_p*cosa(:ntheta,m) + zms_p*sina(:ntheta,m)
69 r1(:ntheta) = r1(:ntheta) + gtt(:ntheta)
70 z1(:ntheta) = z1(:ntheta) + gcon(:ntheta)
71 rt1(:ntheta) = rt1(:ntheta) + dm1(m)*(rms_p*cosa(:ntheta,m)-
72 1 rmc_p*sina(:ntheta,m))
73 zt1(:ntheta) = zt1(:ntheta) + dm1(m)*(zms_p*cosa(:ntheta,m)-
74 1 zmc_p*sina(:ntheta,m))
79 gtt(:ntheta) = rt1(:ntheta)**2 + zt1(:ntheta)**2
80 gpts(:ntheta) = r1(:ntheta)*rt1(:ntheta)+z1(:ntheta)*zt1(:ntheta)
87 gpts(:ntheta) = 0.5_dp*gpts(:ntheta)/gtt(:ntheta)
88 t1 = maxval(abs(gpts(:ntheta)))
93 gpts(:ntheta) = t1 * gpts(:ntheta)
95 fsq = 0.5_dp*dnorm*sum(r1(:ntheta)**2 + z1(:ntheta)**2)
104 gr0c = dnorm*sum(cosa(:ntheta,m)*r1(:ntheta))
105 gz0c = dnorm*sum(cosa(:ntheta,m)*z1(:ntheta))
113 t1 = dnorm/max(t1m(m+1),0.1_dp)
114 grhoc(m) = t1*sum(cosa(:ntheta,m+1)*r1(:ntheta) +
115 1 sina(:ntheta,m+1)*z1(:ntheta))
116 grhos(m) = t1*sum(sina(:ntheta,m+1)*r1(:ntheta) -
117 1 cosa(:ntheta,m+1)*z1(:ntheta))
121 IF (t1.EQ.0 .AND. t2.EQ.0) cycle
122 tnorm = dnorm/(t1*t1 + t2*t2)
125 grhoc(m) = sum((cosa(:ntheta,m+1)*r1(:ntheta) +
126 1 sina(:ntheta,m+1)*z1(:ntheta))*t1 +
127 2 (cosa(:ntheta,m-1)*r1(:ntheta) -
128 3 sina(:ntheta,m-1)*z1(:ntheta))*t2)
129 grhos(m) = sum((sina(:ntheta,m+1)*r1(:ntheta) -
130 1 cosa(:ntheta,m+1)*z1(:ntheta))*t1 +
131 2 (sina(:ntheta,m-1)*r1(:ntheta) +
132 3 cosa(:ntheta,m-1)*z1(:ntheta))*t2)
138 gnorm = sum(grhoc(0:mrho1)*grhoc(0:mrho1) +
139 1 grhos(0:mrho1)*grhos(0:mrho1)) +
143 gnorm = gnorm + dnorm*sum(gpts(:ntheta)*gpts(:ntheta))