V3FIT
unique_boundary.f
1  SUBROUTINE unique_boundary(rbc, zbs, rhobc, mmax, nmax,
2  1 mpol, ntor, mrho)
3  USE stel_kinds
4  IMPLICIT NONE
5 !-----------------------------------------------
6 C D u m m y A r g u m e n t s
7 !-----------------------------------------------
8  INTEGER, INTENT(in) :: nmax, mmax, mpol, ntor, mrho
9  REAL(rprec), DIMENSION(-nmax:nmax,0:mmax), INTENT(inout) ::
10  1 rhobc
11  REAL(rprec), DIMENSION(-nmax:nmax,0:mmax), INTENT(inout) ::
12  1 rbc, zbs
13 !-----------------------------------------------
14 ! L o c a l P a r a m e t e r s
15 !-----------------------------------------------
16  INTEGER, PARAMETER :: pexp = 4
17  REAL(rprec), PARAMETER :: 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, mpol_max
22  REAL(rprec), DIMENSION(1:mpol) :: t1, t2
23 !-----------------------------------------------
24 !
25 ! GIVEN A RADIUS ARRAY RHOBC, COMPUTES A UNIQUE BOUNDARY
26 ! REPRESENTATION (FOR M>0 MODES) USING HIRSHMAN/BRESLAU
27 ! PRESCRIPTION
28 !
29 ! MPOL: ACTUAL MAXIMUM POLOIDAL MODE NO. OF RBC, ZBS
30 ! MRHO: ACTUAL MAXIMUM POLOIDAL MODE NO. OF RHOBC
31 ! NTOR: ACTUAL MAXIMUM TOROIDAL MODE NO. OF RBC, ZBC, RHOBC
32 !
33  IF (mpol .gt. mmax) stop 'MPOL > MMAX in UNIQUE_BOUNDARY'
34  IF (ntor .gt. nmax) stop 'NTOR > NMAX in UNIQUE_BOUNDARY'
35 
36  DO mcount = 1, mpol
37  t1(mcount) = ( real(mcount-1,rprec)/
38  1 real(mcount,rprec) )**pexp
39  t2(mcount) = ( real(mcount+1,rprec)/
40  1 real(mcount,rprec) )**pexp
41  END DO
42  t1(1) = one
43 
44  rbc(:,1:mmax) = zero
45  zbs(:,1:mmax) = zero
46 
47 !
48 ! NOTE: RHOBC(n,0) includes both signs of n, since
49 ! it is a linear combination of k(n) and rho(|n|,0) [REF. H/B paper]
50 ! We need to impose the constraint rbc(n,1) - rbc(-n,1) = -(zbs(n,1) - zbs(-n,1))
51 ! corresponding to rhobs(n,0) = 0. In terms of rhobc, this becomes
52 ! rhobc(0,n) = rhobc(0,-n)
53 !
54  DO ncount = -ntor,-1
55  rhobc(ncount,0) = rhobc(-ncount,0) !m=1 rbc,zbs constraint
56  END DO
57 
58 !
59 ! ALLOW FOR STANDARD OR ADVANCED H/B TRUNCATION HERE
60 ! STANDARD H/B TRUNCTION CORRESPONDS TO MRHO = MPOL-1
61 ! ADVANCED TRUNCATION HAS MRHO = MPOL+1 (SECOND MCOUNT LOOP INACTIVE)
62 !
63  mpol_max = mrho-1
64 
65  DO ncount = -ntor, ntor
66  DO mcount = 1, mpol_max
67  rbc(ncount,mcount) = t1(mcount)*rhobc(ncount,mcount-1)
68  1 + t2(mcount)*rhobc(ncount,mcount+1)
69  zbs(ncount,mcount) = t1(mcount)*rhobc(ncount,mcount-1)
70  1 - t2(mcount)*rhobc(ncount,mcount+1)
71  END DO
72 
73  DO mcount = mrho, mpol
74  rbc(ncount,mcount) = t1(mcount)*rhobc(ncount,mcount-1)
75  zbs(ncount,mcount) = rbc(ncount,mcount)
76  END DO
77  END DO
78 
79  END SUBROUTINE unique_boundary