V3FIT
freeb_data.f
1  SUBROUTINE freeb_data (rmnc, zmns, rmns, zmnc, bmodmn, bmodmn1)
2  USE vmec_main
3  USE vacmod
4  USE realspace, ONLY: r1, z1
5  IMPLICIT NONE
6 C-----------------------------------------------
7 C D u m m y A r g u m e n t s
8 C-----------------------------------------------
9  REAL(rprec), DIMENSION(mnmax) :: rmnc, zmns, rmns, zmnc,
10  1 bmodmn, bmodmn1
11 C-----------------------------------------------
12 C L o c a l V a r i a b l e s
13 C-----------------------------------------------
14  INTEGER :: iprint, nzskip, i, l, k, lk, mn,
15  1 mn0, n, nedge, nedge0 = 99, iu, iv, nl, lkr
16  REAL(rprec) :: zeta, potsin, potcos
17  REAL(rprec), ALLOCATABLE, DIMENSION(:) :: rb, phib, zb
18 C-----------------------------------------------
19 !
20 ! WRITE OUT EDGE VALUES OF FIELDS TO FORT.NEDGE0 (INCLUDE REFLECTED POINT)
21 !
22 ! NOTE: BR, BPHI, BZ WERE COMPUTED IN BSS, CALLED FROM EQFOR
23 !
24  IF (ivac.le.0 .or. (.not.lfreeb .and. .not.ledge_dump)) RETURN
25 
26  ALLOCATE (rb(2*nznt), phib(2*nznt), zb(2*nznt), stat=l)
27  IF (l .ne. 0) stop 'allocation error in freeb_data'
28 
29  nedge = 0
30  lkr = nznt
31  DO iv = 1,nzeta
32  zeta = (twopi*(iv-1))/(nzeta*nfp)
33  DO iu = 1,ntheta3
34  lk = iv + nzeta*(iu-1)
35  nl = ns*lk
36  nedge = nedge+1
37  rb(lk) = r1(nl,0) + r1(nl,1)
38  phib(lk) = zeta
39  zb(lk) = z1(nl,0) + z1(nl,1)
40 !
41 ! INCLUDE -u,-v POINTS HERE BY STELLARATOR SYMMETRY
42 !
43  IF (.not.lasym .and. (iu.ne.1 .and. iu.ne.ntheta2)) THEN
44  lkr = lkr + 1
45  nedge = nedge+1
46  rb(lkr) = rb(lk)
47  phib(lkr) =-phib(lk)
48  zb(lkr) =-zb(lk)
49  bredge(lkr) = -bredge(lk)
50  bpedge(lkr) = bpedge(lk)
51  bzedge(lkr) = bzedge(lk)
52  ENDIF
53  END DO
54  END DO
55 
56  IF (ledge_dump) THEN
57  WRITE(nedge0,*) 'INPUT FILE = ',arg1
58  WRITE(nedge0,*) 'NEDGE = ',nedge
59  WRITE(nedge0,*) 'RB = ', (rb(i), i=1,nedge)
60  WRITE(nedge0,*) 'PHIB = ',(phib(i), i=1,nedge)
61  WRITE(nedge0,*) 'ZB = ', (zb(i), i=1,nedge)
62  WRITE(nedge0,*) 'BREDGE = ', (bredge(i), i=1,nedge)
63  WRITE(nedge0,*) 'BPEDGE = ', (bpedge(i), i=1,nedge)
64  WRITE(nedge0,*) 'BZEDGE = ', (bzedge(i), i=1,nedge)
65  END IF
66 
67 !
68 ! WRITE OUT (TO THREED1 FILE) VACUUM INFORMATION
69 !
70 
71  IF (.not.lfreeb) THEN
72  DEALLOCATE (rb, phib, zb, stat=l)
73  RETURN
74  END IF
75 
76  DO iprint = 1, 2
77  IF (iprint .eq. 1) WRITE (nthreed, 750)
78  IF (iprint .eq. 2) WRITE (nthreed, 760)
79  nzskip = 1 + nzeta/6
80  DO l = 1, nzeta, nzskip
81  zeta = (360.0_dp*(l - 1))/nzeta
82  IF (iprint .eq. 1) THEN
83  DO k = 1, ntheta2
84  lk = l + nzeta*(k - 1)
85  WRITE (nthreed, 770) zeta, rb(lk),
86  1 zb(lk), (bsqsav(lk,n),n=1,3), bsqvac(lk)
87  END DO
88  ELSE
89  DO k = 1, ntheta2
90  lk = l + nzeta*(k - 1)
91  WRITE (nthreed, 780) zeta, rb(lk), zb(lk),
92  1 bredge(lk), bpedge(lk), bzedge(lk),
93  2 brv(lk), bphiv(lk), bzv(lk)
94  END DO
95  ENDIF
96  END DO
97  END DO
98 
99  DEALLOCATE (rb, phib, zb, bredge, bpedge, bzedge, stat=l)
100 
101  IF (lasym) THEN
102  WRITE (nthreed, 900)
103  DO mn = 1, mnmax
104  potsin = 0; potcos = 0
105  DO mn0 = 1, mnpd
106  IF ( (nint(xnpot(mn0)).eq.nint(xn(mn))) .and.
107  1 (nint(xmpot(mn0)).eq.nint(xm(mn))) ) THEN
108  potsin = potvac(mn0)
109  potcos = potvac(mn0+mnpd)
110  EXIT
111  END IF
112  END DO
113  WRITE (nthreed, 910) nint(xn(mn)/nfp), nint(xm(mn)), rmnc(mn),
114  1 zmns(mn), rmns(mn), zmnc(mn), potsin, potcos,
115  2 bmodmn(mn), bmodmn1(mn)
116  END DO
117 
118  ELSE
119  WRITE (nthreed, 800)
120  DO mn = 1, mnmax
121  potsin = 0
122  DO mn0 = 1, mnpd
123  IF ( (nint(xnpot(mn0)).eq.nint(xn(mn))) .and.
124  1 (nint(xmpot(mn0)).eq.nint(xm(mn))) ) THEN
125  potsin = potvac(mn0)
126  EXIT
127  END IF
128  END DO
129  WRITE (nthreed, 810) nint(xn(mn)/nfp), nint(xm(mn)),
130  1 rmnc(mn), zmns(mn), potsin, bmodmn(mn), bmodmn1(mn)
131  END DO
132  END IF
133 
134  WRITE (nthreed, *)
135 
136  750 FORMAT(/,3x,'NF*PHI',7x,' Rb ',8x,' Zb ',6x,'BSQMHDI',5x,'BSQVACI'
137  1 ,5x,'BSQMHDF',5x,'BSQVACF',/)
138  760 FORMAT(/,3x,'NF*PHI',7x,' Rb ',8x,' Zb ',6x,'BR',8x,'BPHI',6x,'BZ'
139  1 ,8x,'BRv',7x,'BPHIv',5x,'BZv',/)
140  770 FORMAT(1p,e10.2,6e12.4)
141  780 FORMAT(1p,e10.2,2e12.4,6e10.2)
142  790 FORMAT(i5,/,(1p,3e12.4))
143  800 FORMAT(//,3x,'nb',2x,'mb',6x,'rbc',9x,'zbs',6x,'vacpot_s',
144  1 2x, '|B|_c(s=.5)',1x,'|B|_c(s=1.)'/)
145  810 FORMAT(i5,i4,1p,7e12.4)
146  900 FORMAT(//,3x,'nb',2x,'mb',6x,'rbc',9x,'zbs',9x,'rbs',9x,'zbc',
147  1 6x,'vacpot_s',4x,'vacpot_c',2x,'|B|_c(s=.5)',
148  2 1x,'|B|_c(s=1.)'/)
149  910 FORMAT(i5,i4,1p,10e12.4)
150 
151  END SUBROUTINE freeb_data