V3FIT
vmec_input.f
1  MODULE vmec_input
2  USE vparams, ONLY: rprec, dp, mpol1d, ntord, ndatafmax
3  USE vsvd0
4  IMPLICIT NONE
5 !-----------------------------------------------
6 ! L o c a l V a r i a b l e s
7 ! For variable descriptions, see VMEC "readin.f" routine
8 !-----------------------------------------------
9  INTEGER, PARAMETER :: mpol_default = 6
10  INTEGER, PARAMETER :: ntor_default = 0
11  INTEGER, PARAMETER :: ns_default = 31
12  INTEGER :: nfp, ncurr, nsin, niter, nstep, nvacskip, mpol, ntor,
13  1 ntheta, nzeta, mfilter_fbdy, nfilter_fbdy,
14  2 max_main_iterations, omp_num_threads
15  INTEGER, DIMENSION(100) :: ns_array, niter_array
16  INTEGER :: imse, isnodes, itse, ipnodes, iopt_raxis,
17  1 imatch_phiedge, nflxs
18  INTEGER, DIMENSION(nbsetsp) :: nbfld
19  INTEGER, DIMENSION(nfloops) :: indxflx
20  INTEGER, DIMENSION(nbcoilsp,nbsetsp) :: indxbfld
21  REAL(rprec), DIMENSION(-ntord:ntord,0:mpol1d) ::
22  1 rbs, zbc, rbc, zbs
23  REAL(rprec) :: time_slice, curtor, delt, ftol, tcon0,
24  1 gamma, phiedge, phidiam, sigma_current, sigma_delphid, tensi,
25  2 tensp, tensi2, fpolyi, presfac, mseangle_offset, pres_offset,
26  3 mseangle_offsetm, spres_ped, bloat, pres_scale,
27  4 prec2d_threshold
28  REAL(rprec), DIMENSION(0:20) :: am, ai, ac
29  REAL(rprec), DIMENSION(1:20) :: aphi
30  CHARACTER(len=20) :: pcurr_type ! len=12 -> len=20 J Hanson 2010-03-16
31  CHARACTER(len=20) :: piota_type
32  CHARACTER(len=20) :: pmass_type
33  REAL(rprec), DIMENSION(ndatafmax) :: am_aux_s, am_aux_f,
34  1 ai_aux_s, ai_aux_f, ac_aux_s, ac_aux_f
35 
36 ! ANISOTROPIC AMPLITUDES: AH=PHOT/PTHERMAL, AT=TPERP/TPAR
37 ! bcrit: hot particle energy deposition value for |B|
38  REAL(rprec), DIMENSION(0:20) :: ah, at
39  REAL(rprec) :: bcrit
40 
41  REAL(rprec), DIMENSION(0:ntord) :: raxis, zaxis !!Backwards compatibility: Obsolete
42  REAL(rprec), DIMENSION(0:ntord) :: raxis_cc, raxis_cs,
43  1 zaxis_cc, zaxis_cs
44  REAL(rprec), DIMENSION(100) :: ftol_array
45  REAL(rprec), DIMENSION(nigroup), TARGET :: extcur ! V3FIT needs a pointer to this.
46  REAL(rprec), DIMENSION(nmse) :: mseprof
47  REAL(rprec), DIMENSION(ntse) :: rthom, datathom, sigma_thom
48  REAL(rprec), DIMENSION(nmse) :: rstark, datastark,
49  1 sigma_stark
50  REAL(rprec), DIMENSION(nfloops) :: dsiobt, sigma_flux
51  REAL(rprec), DIMENSION(nbcoilsp,nbsetsp) :: bbc, sigma_b
52  REAL(rprec), DIMENSION(ndatafmax) :: psa, pfa, isa, ifa
53  LOGICAL :: lpofr, lmac, lfreeb, lrecon, loldout, ledge_dump,
54  1 lasym, lforbal, lrfp, lmove_axis,
55  2 lwouttxt, ldiagno, ! J.Geiger: for txt- and diagno-output
56  3 lmoreiter, ! J.Geiger: if force residuals are not fulfilled add more iterations.
57  4 lfull3d1out, ! J.Geiger: to force full 3D1-output
58  5 l_v3fit=.false.
59  a , lspectrum_dump, loptim !!Obsolete
60  LOGICAL :: lgiveup ! inserted M.Drevlak
61  REAL(rprec) :: fgiveup ! inserted M.Drevlak, giveup-factor for ftolv
62  LOGICAL :: lbsubs ! J Hanson See jxbforce coding
63 
64  CHARACTER(len=200) :: mgrid_file
65  CHARACTER(len=10) :: precon_type
66  CHARACTER(len=120) :: arg1
67  CHARACTER(len=100) :: input_extension
68 
69  namelist /indata/ mgrid_file, time_slice, nfp, ncurr, nsin,
70  1 niter, nstep, nvacskip, delt, ftol, gamma, am, ai, ac, aphi,
71  1 pcurr_type, pmass_type, piota_type,
72  1 am_aux_s, am_aux_f, ai_aux_s, ai_aux_f, ac_aux_s, ac_aux_f, ! J Hanson 2010-03-16
73  1 ah, at, bcrit, ! WAC (anisotropic pres)
74  2 rbc, zbs, rbs, zbc, spres_ped, pres_scale, raxis_cc, zaxis_cs,
75  3 raxis_cs, zaxis_cc, mpol, ntor, ntheta, nzeta, mfilter_fbdy,
76  3 nfilter_fbdy, niter_array,
77  4 ns_array, ftol_array, tcon0, precon_type, prec2d_threshold,
78  4 curtor, sigma_current, extcur, omp_num_threads,
79  5 phiedge, psa, pfa, isa, ifa, imatch_phiedge, iopt_raxis,
80  6 tensi, tensp, mseangle_offset, mseangle_offsetm, imse,
81  7 isnodes, rstark, datastark, sigma_stark, itse, ipnodes,
82  8 presfac, pres_offset, rthom, datathom, sigma_thom, phidiam,
83  9 sigma_delphid, tensi2, fpolyi, nflxs, indxflx, dsiobt,
84  a sigma_flux, nbfld, indxbfld, bloat, raxis, zaxis,
85  a bbc, sigma_b, lpofr, lforbal, lfreeb, lmove_axis, lrecon, lmac,
86  b lasym, ledge_dump, lspectrum_dump, loptim, lrfp,
87  c loldout, lwouttxt, ldiagno, lfull3d1out, max_main_iterations, ! J Geiger 2010-05-04
88  d lgiveup,fgiveup, ! M.Drevlak 2012-05-10
89  e lbsubs ! 2014-01-12 See jxbforce
90 
91  namelist /mseprofile/ mseprof
92 
93  CONTAINS
94 
95  SUBROUTINE read_indata_namelist (iunit, istat)
96  INTEGER, INTENT(IN) :: iunit
97  INTEGER, INTENT(OUT) :: istat
98 
99 !
100 ! INITIALIZATIONS
101 !
102  omp_num_threads = 8
103  gamma = 0
104  spres_ped = 1
105  mpol = mpol_default
106  ntor = ntor_default
107  ntheta = 0; nzeta = 0
108  ns_array = 0; ns_array(1) = ns_default
109  niter_array = -1;
110  bloat = 1
111  rbc = 0; rbs = 0; zbs = 0; zbc = 0
112  time_slice = 0
113  nfp = 1
114  ncurr = 0
115  nsin = ns_default
116  niter = 100
117  nstep = 10
118  nvacskip = 1
119  delt = 1
120  ftol = 1.e-10_dp
121  ftol_array = 0; ftol_array(1) = ftol
122  am = 0; ai = 0; ac = 0; aphi = 0; aphi(1) = 1
123  pres_scale = 1
124  raxis_cc = 0; zaxis_cs = 0; raxis_cs = 0; zaxis_cc = 0
125  mfilter_fbdy = -1; nfilter_fbdy = -1
126  tcon0 = 1
127  precon_type = 'NONE'; prec2d_threshold = 1.e-30_dp
128  curtor = 0;
129  extcur = 0; phiedge = 1;
130  mgrid_file = 'NONE'
131  lfreeb = .true.
132  lmove_axis = .true.
133  lmac = .false.
134  lforbal = .false. ! SPH: changed 05-14-14
135  lasym = .false.
136  lrfp = .false.
137  loldout = .false. ! J Geiger 2010-05-04 start
138  ldiagno = .false.
139  lgiveup = .false. ! inserted M.Drevlak
140  fgiveup = 3.e+01_dp ! inserted M.Drevlak
141  lbsubs = .false. ! J Hanson. See jxbforce coding
142  lfull3d1out = .true. ! J Geiger & SPH (5-21-15)
143  lmoreiter = .false. ! default value if no max_main_iterations given.
144  max_main_iterations = 1 ! to keep a presumably expected standard behavior.
145 #if defined(NETCDF)
146  lwouttxt = .false. ! to keep functionality as expected with netcdf
147 #else
148  lwouttxt = .true. ! and without netcdf
149 #endif
150  ! J Geiger 2010-05-04 end
151  pcurr_type = 'power_series'
152  piota_type = 'power_series'
153  pmass_type = 'power_series'
154 
155 ! ANISTROPY PARAMETERS
156  bcrit = 1
157  at(0) = 1; at(1:) = 0
158  ah = 0
159 
160 !
161 ! BACKWARDS COMPATIBILITY
162 !
163  raxis = 0; zaxis = 0
164 
165  READ (iunit, nml=indata, iostat=istat)
166 
167  IF (all(niter_array == -1)) niter_array = niter
168 
169 ! Work around a bug in gfortran. When performing an optimized build, the WHERE
170 ! statement would produce incorrect results. Work around this bug by expanding
171 ! the full WHERE statment. This should have no adverse effects on any other
172 ! compiler since these statements are equivalent to the older code statement.
173 !
174 ! WHERE (raxis .ne. 0.0_dp) raxis_cc = raxis
175 ! WHERE (zaxis .ne. 0.0_dp) zaxis_cs = zaxis
176 !
177 ! The effect of this bug optimized to code to effectively ignore the WHERE
178 ! statement and assign all value values of the r/zaxis to the r/zaxis_cc/s
179 ! arrays. Explicitly adding the r/zaxis .eq. 0.0_dp section prevents this. This
180 ! bug is known to exist in gfortran 4.9. It may manifest in other versions.
181  WHERE (raxis .ne. 0.0_dp)
182  raxis_cc = raxis
183  ELSEWHERE
184  raxis_cc = raxis_cc
185  ENDWHERE
186  WHERE (zaxis .ne. 0.0_dp)
187  zaxis_cs = zaxis
188  ELSEWHERE
189  zaxis_cs = zaxis_cs
190  ENDWHERE
191 
192  raxis_cs(0) = 0; zaxis_cs(0) = 0
193 
194  IF(max_main_iterations .GT. 1) lmoreiter=.true. !J Geiger: if more iterations are requested.
195 
196  END SUBROUTINE read_indata_namelist
197 
198  SUBROUTINE read_mse_namelist (iunit, istat)
199  INTEGER :: iunit, istat
200 
201  READ (iunit, nml=mseprofile, iostat=istat)
202 
203  END SUBROUTINE read_mse_namelist
204 
205  END MODULE vmec_input