1 SUBROUTINE add_fluxes_par(overg, bsupu, bsupv, lcurrent)
3 USE realspace,
ONLY: pwint, pguu, pguv, pchip, pphip
4 USE vmec_input,
ONLY: nzeta
5 USE vmec_dim,
ONLY: ntheta3
6 USE parallel_include_module
11 REAL(rprec),
DIMENSION(nznt,ns),
INTENT(in) :: overg
12 REAL(rprec),
DIMENSION(nznt,ns),
INTENT(inout) :: bsupu, bsupv
13 LOGICAL,
INTENT(in) :: lcurrent
17 REAL(rprec),
PARAMETER :: p5=0.5_dp, c1p5=1.5_dp
18 REAL(rprec),
PARAMETER :: iotaped = 0.10
23 REAL(rprec) :: top, bot
25 INTEGER :: i, j, k, nsmin, nsmax, lnsnum, istat
33 IF (.NOT.lcurrent .OR. ncurr.EQ.0)
GOTO 100
35 nsmin=max(2,t1lglob); nsmax=t1rglob
40 top = top - pwint(j,js)*(pguu(j,js)*bsupu(j,js) &
41 + pguv(j,js)*bsupv(j,js))
42 bot = bot + pwint(j,js)*overg(j,js)*pguu(j,js)
44 IF (bot.ne.zero) chips(js) = top/bot
45 IF (phips(js).ne.zero) iotas(js) = chips(js)/phips(js)
50 nsmin=max(2,t1lglob); nsmax=t1rglob
52 IF (ncurr .EQ. 0)
THEN
53 chips(nsmin:nsmax) = iotas(nsmin:nsmax)*phips(nsmin:nsmax)
54 ELSE IF (.NOT.lcurrent)
THEN
55 WHERE (phips(nsmin:nsmax) .NE. zero) &
56 iotas(nsmin:nsmax) = chips(nsmin:nsmax)/phips(nsmin:nsmax)
60 pchip(:,js) = chips(js)
63 nsmin=max(2,t1lglob); nsmax=min(ns-1,trglob)
64 IF (t1lglob .eq. 1 .and. trglob .gt. 2)
THEN
65 chipf(1) = c1p5*chips(2) - p5*chips(3)
66 ELSE IF (t1lglob .eq. 1)
THEN
69 chipf(nsmin:nsmax) = (chips(nsmin:nsmax) + chips(nsmin+1:nsmax+1))
70 IF (nsmax.EQ.ns) chipf(ns) = c1p5*chips(ns)- p5*chips(ns-1)
73 IF(trglob_arr(1).LE.2)
THEN
75 CALL mpi_bcast(iotas(3),1,mpi_real8,1,ns_comm,mpi_err)
79 IF (nsmin.EQ.1) iotaf(1) = one/(c1p5/iotas(2) - p5/iotas(3))
80 IF (nsmax.EQ.ns) iotaf(ns)=one/(c1p5/iotas(ns)-p5/iotas(ns-1))
81 DO js = max(2,t1lglob), min(ns-1,t1rglob)
82 iotaf(js) = 2.0_dp/(one/iotas(js) + one/iotas(js+1))
85 IF (nsmin.EQ.1) iotaf(1) = c1p5*iotas(2) - p5*iotas(3)
86 IF (nsmax.EQ.ns) iotaf(ns)=c1p5*iotas(ns) - p5*iotas(ns-1)
87 DO js = max(2,t1lglob), min(ns-1,trglob)
88 iotaf(js) = p5*(iotas(js) + iotas(js+1))
92 nsmin=max(1,t1lglob); nsmax=min(ns,t1rglob)
93 bsupu(:,nsmin:nsmax) = bsupu(:,nsmin:nsmax)+pchip(:,nsmin:nsmax)*overg
95 END SUBROUTINE add_fluxes_par
97 SUBROUTINE add_fluxes(overg, bsupu, bsupv, lcurrent)
99 USE realspace,
ONLY: wint, guu, guv, chip, phip
105 REAL(rprec),
DIMENSION(nrzt),
INTENT(in) :: overg
106 REAL(rprec),
DIMENSION(nrzt),
INTENT(inout) :: bsupu, bsupv
107 LOGICAL,
INTENT(in) :: lcurrent
111 REAL(rprec),
PARAMETER :: p5=0.5_dp, c1p5=1.5_dp
112 REAL(rprec),
PARAMETER :: iotaped = 0.10_dp
117 REAL(rprec) :: top, bot
125 IF (.not.lcurrent .or. ncurr.eq.0)
GOTO 100
133 top = top - wint(l)*(guu(l)*bsupu(l) + guv(l)*bsupv(l))
134 bot = bot + wint(l)*overg(l)*guu(l)
136 IF (bot .ne. zero) chips(js) = top/bot
137 IF (phips(js) .ne. zero) iotas(js) = chips(js)/phips(js)
143 IF (ncurr .eq. 0)
THEN
145 ELSE IF (.not.lcurrent)
THEN
146 WHERE (phips .ne. zero) iotas = chips/phips
150 chip(js:nrzt:ns) = chips(js)
153 chipf(1) = c1p5*chips(2) - p5*chips(3)
154 chipf(2:ns1) = (chips(2:ns1) + chips(3:ns1+1))/2
155 chipf(ns) = c1p5*chips(ns)- p5*chips(ns1)
159 iotaf(1) = one/(c1p5/iotas(2) - p5/iotas(3))
160 iotaf(ns) = one/(c1p5/iotas(ns) - p5/iotas(ns1))
162 iotaf(js) = 2.0_dp/(one/iotas(js) + one/iotas(js+1))
166 iotaf(1) = c1p5*iotas(2) - p5*iotas(3)
167 iotaf(ns) = c1p5*iotas(ns) - p5*iotas(ns-1)
169 iotaf(js) = p5*(iotas(js) + iotas(js+1))
173 bsupu(:nrzt) = bsupu(:nrzt)+chip(:nrzt)*overg(:nrzt)
175 END SUBROUTINE add_fluxes