V3FIT
amplitud.f
1  SUBROUTINE amplitud(rcenter, zcenter, angin, r0c, z0c, rhoc, rhos,
2  1 xpts, xin, yin)
3 C-----------------------------------------------
4 C M o d u l e s
5 C-----------------------------------------------
6  USE vname0
7  USE vname1
8  IMPLICIT NONE
9 C-----------------------------------------------
10 C D u m m y A r g u m e n t s
11 C-----------------------------------------------
12  REAL(rprec) rcenter, zcenter, r0c, z0c
13  REAL(rprec), DIMENSION(ntheta) :: angin, xpts, xin, yin
14  REAL(rprec), DIMENSION(0:mrho-1) :: rhoc, rhos
15 C-----------------------------------------------
16 C L o c a l V a r i a b l e s
17 C-----------------------------------------------
18  INTEGER :: mrz
19  INTEGER :: m, j
20  REAL(rprec) :: xmult, arg, xi, yi, t1, t2,
21  1 r1c(mu), r1s(mu), z1c(mu), z1s(mu), tnorm
22 C-----------------------------------------------
23 c*****************************************************************
24 c This SUBROUTINE assigns initial guesses for angles and
25 c Fourier mode amplitudes to the appropriate components of
26 c the xvec array
27 c*****************************************************************
28  r0c = rcenter
29  z0c = zcenter
30  xpts(:ntheta) = angin(:ntheta)
31 
32  mrz = mpol-1
33  xmult = 2._dp/ntheta
34 
35  r1c = zero
36  r1s = zero
37  z1c = zero
38  z1s = zero
39  rhoc = zero
40  rhos = zero
41 
42  DO m = 1, mrz
43  DO j = 1, ntheta
44  arg = angin(j)
45  xi = xmult*(xin(j)-rcenter)
46  yi = xmult*(yin(j)-zcenter)
47  r1c(m) = r1c(m) + cos(m*arg)*xi
48  r1s(m) = r1s(m) + sin(m*arg)*xi
49  z1c(m) = z1c(m) + cos(m*arg)*yi
50  z1s(m) = z1s(m) + sin(m*arg)*yi
51  END DO
52  END DO
53 
54  r10 = sqrt( r1c(1)**2 + r1s(1)**2 + z1c(1)**2 + z1s(1)**2 )
55  WRITE(3,'(/,3(a,1pe10.3))')
56  1 ' RAXIS = ', rcenter,' ZAXIS = ', zcenter,' R10 = ',r10
57  WRITE(*,'(/,3(a,1pe10.3))')
58  1 ' RAXIS = ', rcenter,' ZAXIS = ', zcenter,' R10 = ',r10
59 
60 *
61 * INITIALIZE POLAR RHOs for m = 0 thru mrz-1
62 *
63  DO m = 0, mrz-1
64  IF( m.le.1 )then
65  t1 = t1m(m+1)
66  IF (t1 .EQ. 0) cycle
67  rhoc(m) = 0.5_dp*(r1c(m+1) + z1s(m+1))/t1
68  rhos(m) = 0.5_dp*(r1s(m+1) - z1c(m+1))/t1
69  ELSE
70  t1 = t1m(m+1)
71  t2 = t2m(m-1)
72  tnorm = t1**2 + t2**2
73  IF (tnorm .EQ. 0) cycle
74  tnorm = 0.5/tnorm
75  rhoc(m) = tnorm*( (r1c(m+1) + z1s(m+1))*t1
76  1 + (r1c(m-1) - z1s(m-1))*t2 )
77  rhos(m) = tnorm*( (r1s(m+1) - z1c(m+1))*t1
78  1 + (r1s(m-1) + z1c(m-1))*t2 )
79  END IF
80  END DO
81 
82  END SUBROUTINE amplitud