25 USE stel_kinds,
only : rprec
59 INTEGER,
PARAMETER :: vmh_dim = 100000
60 INTEGER :: vmh_index = 0
61 INTEGER :: vmh_save_i1 = - 1
62 INTEGER :: vmh_save_i2 = - 1
64 LOGICAL :: vmh_print_flag = .false.
65 REAL(rprec) :: vmh_time_zero = 0
66 PRIVATE vmh_dim, vmh_index, vmh_save_i1, vmh_save_i2,
81 INTEGER,
DIMENSION(vmh_dim) :: vmh_iterc, vmh_iter2m1, vmh_ns,
91 REAL(rprec),
DIMENSION(vmh_dim) :: vmh_time_step, vmh_fsqr,
107 SUBROUTINE vmec_history_store(time_step)
113 USE vmec_main,
ONLY: iter1, iter2, iterc, fsqr, fsqz, fsql, &
115 USE vmec_dim,
ONLY: ns
116 USE vmec_input,
ONLY: nvacskip
117 USE precon2d,
ONLY: ictrl_prec2d
122 REAL(rprec),
INTENT(in) :: time_step
133 REAL(rprec) :: time_now
138 IF (vmh_index .eq. 0)
THEN
139 CALL second0(vmh_time_zero)
141 vmh_index = vmh_index + 1
142 IF (vmh_index .le. vmh_dim)
THEN
143 vmh_iterc(vmh_index) = iterc
144 vmh_iter2m1(vmh_index) = iter2 - iter1
145 vmh_ns(vmh_index) = ns
146 vmh_nvacskip(vmh_index) = nvacskip
147 vmh_ivac(vmh_index) = ivac
148 vmh_ictrl_prec2d(vmh_index) = ictrl_prec2d
149 vmh_i1(vmh_index) = vmh_save_i1
150 vmh_i2(vmh_index) = vmh_save_i2
151 vmh_time_step(vmh_index) = time_step
152 vmh_fsqr(vmh_index) = fsqr
153 vmh_fsqz(vmh_index) = fsqz
154 vmh_fsql(vmh_index) = fsql
155 vmh_fedge(vmh_index) = fedge
156 CALL second0(time_now)
157 vmh_time(vmh_index) = time_now - vmh_time_zero
160 END SUBROUTINE vmec_history_store
168 SUBROUTINE vmec_history_print
173 USE vmec_input,
ONLY: input_extension
178 INTEGER :: vmh_iou = 73
180 CHARACTER(LEN=120) :: vmh_history_file_name
181 CHARACTER(LEN=80) :: vmh_format2 =
182 &
'(3(i5,1x),i4,1x,i3,1x,i5,1x,3(i3,1x),7(2x,es9.2))'
183 CHARACTER(LEN=150) :: vmh_header
188 IF (.NOT. vmh_print_flag)
RETURN
190 vmh_history_file_name = trim(
'vmec_history.' // input_extension)
191 CALL safe_open(vmh_iou,istat,trim(vmh_history_file_name),
192 &
'replace',
'formatted',delim_in=
'none',record_in=150)
193 IF (istat .ne. 0)
THEN
194 WRITE(*,*)
'In subroutine vmec_history_print: Error from'
195 WRITE(*,*)
'call to safe_open. istat = ', istat
196 stop
' (source file vmec_history.f)'
199 WRITE(vmh_iou,*)
'History arrays are dimensioned ',vmh_dim
200 WRITE(vmh_iou,*)
'Subroutine vmec_history_store was called ',
201 & vmh_index,
' times'
204 vmh_header =
' i iterc 2m1 ns nvac ivac ictrl_ i1 i2' //
205 &
' time_step fsqr fsqz fsql max(fsq)' //
207 WRITE(vmh_iou,*) trim(vmh_header)
208 WRITE(vmh_iou,*)
' skip prec2d'
210 DO i = 1,min(vmh_index,vmh_dim)
211 WRITE(vmh_iou,vmh_format2)
212 & i, vmh_iterc(i), vmh_iter2m1(i), vmh_ns(i),
213 & vmh_nvacskip(i), vmh_ivac(i),
214 & vmh_ictrl_prec2d(i), vmh_i1(i), vmh_i2(i),
215 & vmh_time_step(i), vmh_fsqr(i), vmh_fsqz(i), vmh_fsql(i),
216 & max(vmh_fsqr(i),vmh_fsqz(i),vmh_fsql(i)),
217 & vmh_fedge(i), vmh_time(i)
221 END SUBROUTINE vmec_history_print
229 SUBROUTINE vmec_history_set(i1,i2)
232 INTEGER,
OPTIONAL :: i1, i2
236 IF (
PRESENT(i1)) vmh_save_i1 = i1
237 IF (
PRESENT(i2)) vmh_save_i2 = i2
240 END SUBROUTINE vmec_history_set
248 SUBROUTINE vmec_history_get(i1,i2)
259 END SUBROUTINE vmec_history_get
267 SUBROUTINE vmec_history_print_flag_off
268 vmh_print_flag = .false.
270 END SUBROUTINE vmec_history_print_flag_off
278 SUBROUTINE vmec_history_print_flag_on
279 vmh_print_flag = .true.
281 END SUBROUTINE vmec_history_print_flag_on
283 END MODULE vmec_history