V3FIT
convert_boundary.f
1  SUBROUTINE convert_boundary(rbc, zbs, rhobc, mpol, ntor)
2  USE stel_kinds
3  IMPLICIT NONE
4 !-----------------------------------------------
5 ! D u m m y A r g u m e n t s
6 !-----------------------------------------------
7  INTEGER, INTENT(in) :: mpol, ntor
8  REAL(rprec), DIMENSION(-ntor:ntor,0:mpol), INTENT(in) ::
9  1 rbc, zbs
10  REAL(rprec), DIMENSION(-ntor:ntor,0:mpol), INTENT(out) ::
11  1 rhobc
12 !-----------------------------------------------
13 ! L o c a l P a r a m e t e r s
14 !-----------------------------------------------
15  INTEGER, PARAMETER :: pexp = 4
16  REAL(rprec), PARAMETER :: p25 = 0.25_dp, p50 = 0.50_dp,
17  1 zero = 0, one = 1
18 !-----------------------------------------------
19 ! L o c a l V a r i a b l e s
20 !-----------------------------------------------
21  INTEGER :: mcount, ncount, m_bdy, n_bdy
22  REAL(rprec), DIMENSION(0:mpol) :: t1, t2
23 !-----------------------------------------------
24 !
25 ! GIVEN A BOUNDARY REPRESENTATION OF THE FORM
26 !
27 ! R = RBC(n,m)*COS(mu-nv)
28 ! Z = ZBS(n,m)*SIN(mu-nv)
29 !
30 ! CONVERTS (APPROXIMATELY) TO FIND POLAR RADIUS ARRAY RHOBC
31 ! REPRESENTATION (FOR M>0 MODES) USING HIRSHMAN/BRESLAU
32 ! PRESCRIPTION WITH EXPONENT = PEXP
33 !
34 ! THIS WOULD MAKE A GOOD INITIAL GUESS FOR DESCUR CODE
35 ! CHECKED THAT IF THE BOUNDARY IS IN THE DESIRED FORM, IT
36 ! WILL NOT BE CHANGED BY A CALL TO THIS CODE!
37 !
38 
39 ! First determine maximum m-number in boundary representation
40 ! DO NOT exceed this mmax-1 in rhobc
41 !
42  m_bdy = 0
43  n_bdy = 0
44  DO mcount = 1, mpol
45  DO ncount = -ntor, ntor
46  IF (rbc(ncount,mcount).ne.zero .or.
47  1 zbs(ncount,mcount).ne.zero) THEN
48  m_bdy = max(m_bdy,mcount)
49  n_bdy = max(n_bdy,abs(ncount))
50  END IF
51  END DO
52  END DO
53 
54  rhobc = zero
55 
56  DO mcount = 1, mpol
57  t1(mcount) = ( real(mcount-1,rprec)
58  1 /real(mcount,rprec) )**pexp
59  t2(mcount) = ( real(mcount+1,rprec)
60  1 /real(mcount,rprec) )**pexp
61  END DO
62  t1(1) = one
63 
64 !
65 ! NOTE: Rhobc(n,m=0) is different for n>0 and n<0, since
66 ! it is a linear combination of k|n| +- rho(0,|n|)
67 !
68 
69  DO ncount = -n_bdy, n_bdy
70  DO mcount = 0,1
71  rhobc(ncount,mcount) = p50*(rbc(ncount,mcount+1) +
72  1 zbs(ncount,mcount+1))/t1(mcount+1)
73  END DO
74 
75  DO mcount = 2,m_bdy-1
76  rhobc(ncount,mcount) = p25*(
77  1 (rbc(ncount,mcount+1) + zbs(ncount,mcount+1))/t1(mcount+1)
78  2 + (rbc(ncount,mcount-1) - zbs(ncount,mcount-1))/t2(mcount-1))
79  END DO
80  END DO
81 
82  END SUBROUTINE convert_boundary