ETS  \$Id: Doxyfile 2162 2020-02-26 14:16:09Z g2dpc $
 All Classes Files Functions Variables Pages
sstepon_r.f
Go to the documentation of this file.
1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2 
3  SUBROUTINE b_stepon( KLUCH, k_auto, nstep, dt, time,
4  * r_ax,z_ax ,key_dmf,dpsdt)
5 
6  use durs_d_modul
7 
8 c---------------------------------------------------------------
9  include 'double.inc'
10  include 'comtim.inc'
11 c-----------------------------------------------------------------------
12 c
13  common /nostep/ kstep
14 ! save epsro,platok,psex_bnd,
15 ! * eqdfn,betplx,tokf,psax,b0,r0,
16 ! * alf0,alf1,alf2,bet0,bet1,bet2,rax,zax,
17 ! * nurs,igdf,n_psi,n_tht,i_bsh,keyctr,i_betp,i_eqdsk
18 
19 ! save platok,psex_bnd,eqdfn,i_bsh
20  real*8 platok,psex_bnd
21  integer i_bsh
22 
23  common /c_kpr/ kpr
24  common/com_flag/kastr
25 
26  common/psi_test/ psi_ext_bon(300)
27 
28  character*40 eqdfn
29 ! save numwr
30  integer numwr
31 
32  kstep = nstep
33 
34  IF( kluch .NE. 0 ) go to 1111
35 
36  1149 format(a40)
37  numwr = 0
38 
39  if(k_auto.eq.0) go to 2005
40 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
41  if(kastr.eq.1) go to 1150
42 
43  write(fname,'(a,a)') path(1:kname),'durs.dat'
44  open(1,file=fname)
45  !open(1,file='durs.dat')
46 
47  read(1,*) n_tht
48  read(1,*) n_psi
49  read(1,*) igdf
50  read(1,*) epsro
51 
52  read(1,*) nurs
53  read(1,*) keyctr
54 
55  read(1,*) i_eqdsk
56  read(1,1149) eqdfn
57 
58  read(1,*) i_betp
59  read(1,*) betplx
60  read(1,*) tokf
61  read(1,*) psax
62  read(1,*) b0,r0
63  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
64  read(1,*) alf0 !!
65  read(1,*) alf1 !! P'=alf0*(1-(1-psi)**alf1)**alf2
66  read(1,*) alf2 !!
67  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
68  read(1,*) bet0 !!
69  read(1,*) bet1 !! FF'=bet0*(1-(1-psi)**bet1)**bet2
70  read(1,*) bet2 !!
71  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
72  read(1,*) alw0 !!
73  read(1,*) alw1 !! (ro*w**2)'=alw0*(1-(1-psi)**alw1)**alw2
74  read(1,*) alw2 !!
75  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
76  read(1,*) rax
77  read(1,*) zax
78 
79  close(1)
80 
81  if(i_eqdsk.eq.1) then
82 
83  call tab_efit(tokf,psax,eqdfn,rax,zax,b0,r0)
84 
85  nurs = -3999
86  i_betp = 0
87 
88  endif
89 
90 ! write(fname,'(a,a)') path(1:kname),'durs_d.dat'
91 ! open(1,file=fname,form='formatted')
92 ! !open(1,file='durs_d.dat')
93 ! write(1,*) n_tht,n_psi,igdf,nurs,keyctr,i_eqdsk,i_betp
94 ! write(1,*) epsro,betplx,tokf,psax,b0,r0,rax,zax
95 ! write(1,*) alf0,alf1,alf2,bet0,bet1,bet2
96 ! close(1)
97 
98  call put_ipl(tokf)
99 
100 
101  1150 continue
102 
103 
104 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
105  2005 continue
106 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
107 
108  if(kastr.eq.0) then
109  write(fname,'(a,a)') path(1:kname),'inpol.dat'
110  open(1,file=fname,form='formatted')
111  !open(1,file='inpol.dat')
112  read(1,*) i_bsh
113  close(1)
114  else
115  i_bsh=1
116  endif
117 
118 
119 ! write(fname,'(a,a)') path(1:kname),'durs_d.dat'
120 ! open(1,file=fname,form='formatted')
121 ! !open(1,file='durs_d.dat')
122 ! read(1,*) n_tht,n_psi,igdf,nurs,keyctr,i_eqdsk,i_betp
123 ! read(1,*) epsro,betplx,tokf,psax,b0,r0,rax,zax
124 ! read(1,*) alf0,alf1,alf2,bet0,bet1,bet2
125 ! close(1)
126 
127  call eqb( alf0,alf1,alf2, bet0,bet1,bet2, alw0,alw1,alw2,
128  * betplx, i_betp,
129  * keyctr, nstep, tokf, rax,zax, b0,r0, psax, igdf,
130  * n_tht, n_psi, epsro, nurs, i_eqdsk,i_bsh,
131  * psi_bnd,psi0_bnd)
132 
133  platok = tokf
134  call bongri
135  call psib_pla(pspl_av)
136  psex_bnd=-pspl_av
137 
138  return
139 
140 1111 CONTINUE
141 
142  keyctr=key_dmf
143  call get_ipl(platok)
144  call bongri
145  call psib_pla(pspl_av)
146  call get_flfi(flfi_m)
147  !call cur_avg
148  !psex_bnd=-pspl_av
149  psi0_bnd=psex_bnd+pspl_av
150  psex_bnd=psex_bnd+dpsdt*dt
151  !psex_bnd=psi_ext_bon(nstep)
152  psi_bnd=psex_bnd
153 
154 ! call put_psib0(psi0_bnd) !?
155 ! psi_eav=psex_av
156 
157  call eqb( alf0,alf1,alf2, bet0,bet1,bet2, alw0,alw1,alw2,
158  * betplx, i_betp,
159  * keyctr, nstep, platok, rax,zax, b0,r0, psax, igdf,
160  * n_tht, n_psi, epsro, nurs, i_eqdsk,i_bsh,
161  * psi_bnd,psi0_bnd)
162 
163 
164 
165  return
166  end
167 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
168 !
169  SUBROUTINE f_stepon( KLUCH, k_auto, nstep, dt, time,
170  * voltpf, d_pf_mat,d_tcam_mat,r_ax,z_ax ,key_dmf)
171 
172  use durs_d_modul
173 
174 c---------------------------------------------------------------
175  include 'Descript.inc'
176 c ----------
177 c
178  include 'double.inc'
179 c
180  include 'prm.inc'
181  include 'comevl.inc'
182  !INCLUDE 'contro.inc'
183  include 'comtim.inc'
184 c-----------------------------------------------------------------------
185 c
186  common/comeqg/ ncequi
187  common /nostep/ kstep
188 
189 ! common /comsta/ epsro,platok,
190 ! * eqdfn,betplx,tokf,psax,b0,r0,
191 ! * alf0,alf1,alf2,bet0,bet1,bet2,rax,zax,
192 ! * nurs,igdf,n_psi,n_tht,i_bsh,keyctr,i_betp,i_eqdsk
193 
194  common /comsta/ platok,eqdfn,i_bsh
195 c-----------------------------------------------------------------------
196 c
197  dimension rc(nclim), zc(nclim), pc(nclim), psip(nclim),
198  * vc(nclim), hc(nclim)
199 c
200  dimension rc1(nclim), zc1(nclim), rc2(nclim), zc2(nclim),
201  * rc3(nclim), zc3(nclim), rc4(nclim), zc4(nclim)
202 c
203  INTEGER necon(nilim), ntype(nclim)
204  dimension wecon(nilim)
205 c
206  common/comst0/ res(njlim), volk(njlim), volkp1(njlim)
207 c
208  common/comst1/ pjk(njlim),pjkp1(njlim),pjkp(njlim),pjkd(njlim)
209  common/comst2/ psk(njlim), pskp1(njlim),pskp(njlim),pskm1(njlim)
210  include 'parloo.inc'
211  common/comloo/ rloop(nloopp),zloop(nloopp),
212  & rprob(nprobp),zprob(nprobp),fiprob(nprobp),nloop,nprob
213 
214  !DIMENSION cp_com_0(n_cp_m)
215 c***********************************************************************
216 
217 ! DIMENSION psiplb(nstep_p),psiexb(nstep_p),
218 ! * flu_tor(nstep_p)
219  real*8 errarr(10)
220 
221 c***********************************************************************
222 
223  real*8 voltpf(*)
224  real*8 d_pf_mat(*)
225  real*8 d_tcam_mat(*)
226 
227 c***********************************************************************
228  common /key_for_pet/ key_fixbon
229 
230  common /c_kpr/ kpr
231 
232  real*4 a_print(200)
233  character*30 apr
234  character*40 eqdfn
235 ! save numwr
236 ! save psi_eav_n
237  integer numwr
238  real*8 psi_eav_n
239 
240  kstep = nstep
241  timev = time
242  tstep = dt
243 
244 
245  !n_pr = 3
246  !a_print(1) = nstep
247  !a_print(2) = time
248  !a_print(3) = dt
249  !num = 30
250  !apr = 'STEPON ENTER nstep time dt ='
251  !call out42(n_pr,a_print,num,apr)
252 
253 !((((((((((((((((((((((
254 ! i_diag=1
255 !))))))))))))))))))))))
256 
257  pi = 3.14159265359d0
258  bbb = 1.d0 / (2.d0*pi)
259 
260  nout = 17
261  nter = 6
262  ninfw = 7
263  ninev = 10
264  ngra1 = 14
265  ngra2 = 15
266 
267  sigm = 1.0d0 !0.d0
268 
269  tstepr = tstep
270  tstart = 0.00d0
271 
272  tstop = 20.0d0
273  kstop = 1000
274 
275  enels = 5.0d-6
276  knels = 150
277 
278  nfrpr1 = 5
279  nfrwr1 = 0
280 c=============================================
281 
282  kstepr = kstep
283  keypri = 1
284 
285  IF( kluch .NE. 0 ) go to 1111
286 
287  1149 format(a40)
288 c
289 c
290  !OPEN( NOUT, FILE='EVOL0.PRT', FORM='FORMATTED' )
291 ! write(nout,*) '***********************************************'
292 ! write(nout,*) '! OUTPUT FILE !'
293 ! write(nout,*) '! OF !'
294 ! write(nout,*) '! the PET code (Plasma Evolution in Tokamak) !'
295 ! write(nout,*) '! ------------------------------------------- !'
296 ! write(nout,*) '! free boundary tokamak equilibrium problem !'
297 ! write(nout,*) '! and !'
298 ! write(nout,*) '! circuit equations !'
299 ! write(nout,*) '***********************************************'
300 c
301  numwr = 0
302 c--------------------------------------------------------------------
303 c
304 c======iter, sof
305 c
306 
307 c-----------------------------------------------------------------
308 c --- input of "BASIC" equlibrium parameters from file "durs.dat"
309 c
310 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
311 
312  if(k_auto.eq.0) go to 2005
313 
314 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
315 
316  write(fname,'(a,a)') path(1:kname),'durs.dat'
317  open(1,file=fname,form='formatted')
318  !open(1,file='durs.dat')
319 
320  read(1,*) n_tht
321  read(1,*) n_psi
322  read(1,*) igdf
323  read(1,*) epsro
324 
325  read(1,*) nurs
326  read(1,*) keyctr
327 
328  read(1,*) i_eqdsk
329  read(1,1149) eqdfn
330 
331  read(1,*) i_betp
332  read(1,*) betplx
333  read(1,*) tokf
334  read(1,*) psax
335  read(1,*) b0,r0
336  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
337  read(1,*) alf0 !!
338  read(1,*) alf1 !! P'=alf0*(1-(1-psi)**alf1)**alf2
339  read(1,*) alf2 !!
340  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
341  read(1,*) bet0 !!
342  read(1,*) bet1 !! FF'=bet0*(1-(1-psi)**bet1)**bet2
343  read(1,*) bet2 !!
344  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
345  read(1,*) alw0 !!
346  read(1,*) alw1 !! (ro*w**2)'=alw0*(1-(1-psi)**alw1)**alw2
347  read(1,*) alw2 !!
348  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
349  read(1,*) rax
350  read(1,*) zax
351 
352  close(1)
353 
354 ! write(fname,'(a,a)') path(1:kname),'durs_d.dat'
355 ! open(1,file=fname,form='formatted')
356 ! !open(1,file='durs_d.dat')
357 ! write(1,*) n_tht,n_psi,igdf,nurs,keyctr,i_eqdsk,i_betp
358 ! write(1,*) epsro,betplx,tokf,psax,b0,r0,rax,zax
359 ! write(1,*) alf0,alf1,alf2,bet0,bet1,bet2
360 ! close(1)
361 
362 
363 
364 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
365 
366 c***********************************************************************
367 c--- input of positions of "PF_PROBE" points:
368 c
369  CALL propnt( nout, nter, ninfw, ngra1,
370  * nprob, rprob, zprob, fiprob )
371 c***********************************************************************
372 c--- input of positions of "FL_LOOP" points:
373 c
374  CALL loopnt( nout, nter, ninfw, ngra1,
375  * nloop, rloop, zloop )
376 c***********************************************************************
377 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
378 
379 c***********************************************************************
380 c--- input parameters of pfc system and passiv conductors
381 c
382  CALL conduc( nc, ncequi, ncpfc, nfw, nbp, nvv,
383  * rc,zc, pc, vc,hc, ntype,
384  * rc1,zc1, rc2,zc2, rc3,zc3, rc4,zc4,
385  * res, volk, volkp1,
386  * necon, wecon,
387  * nout, nter, ninfw, ngra1 )
388 c
389 c***********************************************************************
390 c--- definition induct. and selfinduct. matrix
391 c--- for "EDDY" conductors: "PPIND" from COMMON /ppidps/
392 c *******
393 c
394  CALL l_matr( nout, nter, nc, ncpfc,
395  * ntype, rc, zc, vc, hc,
396  * necon,wecon )
397 c
398 c-----------------------------------------------------------------------
399 c --- initial condition(currents) for circuit equations
400 c
401 
402  DO 17 l=1,ncequi
403  IF( l.LE.nequi ) THEN
404  pjk(l) = pfceqw(l)
405  pjkp(l) = pjk(l)
406  ELSE
407  pjk(l) = pc(ncpfc+l-nequi)
408  pjkp(l) = pjk(l)
409  END IF
410  17 CONTINUE
411 
412  write(fname,'(a,a)') path(1:kname),'currents.wr'
413  open(1,file=fname,form='formatted')
414  !open(1,file='currents.wr',form='formatted')
415  write(1,*) nequi,ncequi
416  write(1,*)(pjk(j),j=1,ncequi)
417  close(1)
418 
419  write(fname,'(a,a)') path(1:kname),'res_mat.wr'
420  open(1,file=fname,form='formatted')
421  !open(1,file='res_mat.wr')
422  write(1,*) (res(j),j=1,ncequi)
423  close(1)
424 
425  call wrcoil(nc,ncpfc,rc,zc,pc,necon,wecon)
426 
427 c
428 c..... toroidal currents of passive conductor structures
429 c
430 ! CALL PASCUR( NOUT, NTER, NEQUI, NFW, NBP, NVV,
431 ! * PJK, fwcurr, bpcurr, vvcurr )
432 c
433 c********************************************************************
434 
435 
436 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
437  2005 continue
438 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
439 
440 ! write(fname,'(a,a)') path(1:kname),'durs_d.dat'
441 ! open(1,file=fname,form='formatted')
442 ! !open(1,file='durs_d.dat')
443 ! read(1,*) n_tht,n_psi,igdf,nurs,keyctr,i_eqdsk,i_betp
444 ! read(1,*) epsro,betplx,tokf,psax,b0,r0,rax,zax
445 ! read(1,*) alf0,alf1,alf2,bet0,bet1,bet2
446 ! close(1)
447 
448  call rd_ppind
449 
450  call rd_prob( nprob, rprob, zprob, fiprob )
451 
452  call rd_loop( nloop, rloop, zloop )
453 
454  write(fname,'(a,a)') path(1:kname),'currents.wr'
455  open(1,file=fname,form='formatted')
456  !open(1,file='currents.wr',form='formatted')
457  read(1,*) nequi,ncequi
458  read(1,*)(pjk(j),j=1,ncequi)
459  close(1)
460 
461  write(fname,'(a,a)') path(1:kname),'res_mat.wr'
462  open(1,file=fname,form='formatted')
463  !open(1,file='res_mat.wr')
464  read(1,*) (res(j),j=1,ncequi)
465  close(1)
466 
467  call rdcoil(nc,ncpfc,rc,zc,pc,necon,wecon)
468 
469  !fr_cam=0.d0
470  !do j=nequi+1,ncequi
471  ! fr_cam=fr_cam+1.d0/res(j)
472  !enddo
473  ! fr_cam=1.d0/fr_cam
474 
475  do l=1,ncequi
476  pjkp(l) = pjk(l)
477  enddo
478 
479 !(((((((((((((((((((((((((((((((((((((((((((
480 ! if(i_diag.eq.1)then
481 ! call diag_params()
482 ! call read_diag()
483 ! call curr_to_dina(ncequi,pjk,tokf)
484 ! end if
485 !)))))))))))))))))))))))))))))))))))))))))))
486 
487 cccc voltage for zero time-level
488 
489  DO i=1,nequi
490  volk(i) = voltpf(i)*bbb
491  END DO
492  DO i=nequi+1,ncequi
493  volk(i) = 0.0d0
494  END DO
495 
496 
497  kstep = 0
498  nursb=nurs
499  platok=tokf
500 
501  i_eqdsk=0
502  i_bsh=-1
503 
504  call eqb( alf0,alf1,alf2, bet0,bet1,bet2, alw0,alw1,alw2,
505  * betplx, i_betp,
506  * keyctr, nstep, platok, rax,zax, b0,r0, psax, igdf,
507  * n_tht, n_psi, epsro, nurs, i_eqdsk,i_bsh,
508  * psi_bnd,psi0_bnd )
509 
510 
511 
512 
513  call eqa_in(alf0,alf1,alf2,bet0,bet1,bet2,nursb,
514  * keyctr,igdf,kstep,platok,
515  * pjk,ncequi, b0,r0,
516  * rloop,zloop,nloop, rprob,zprob,nprob,
517  * necon,wecon,ntype )
518 
519 
520 
521 ! WRITE(NOUT,*) '********************************************'
522 ! WRITE(NOUT,*) ' NUMBER TIME-LEVEL KSTEP =', KSTEP
523 ! WRITE(NOUT,*) '********************************************'
524 
525 
526  if(kpr.eq.1) then
527  WRITE(*,*) 'START OF BASIC FREE BOUNDARY EQUILIBRIUM'
528  endif
529  call eqa(
530  * keyctr,igdf,kstep,platok, psax,i_betp,betplx,
531  * rax,zax, rxpnt,zxpnt, psbo, psdel,
532  * rc,zc,nc, pjk,ncequi, psip,
533  * rloop,zloop,nloop, rprob,zprob,nprob,
534  * zli3,betpol,betful,
535  * necon,wecon,ntype , nflag, errarr)
536  call f_wrd
537  !pause 'pause '
538 
539  call renet
540  call f_bndmat(rc,zc,nc,rloop,zloop,nloop,rprob,zprob,nprob)
541  call f_wrd
542 
543  call eqa(
544  * keyctr,igdf,kstep,platok, psax,i_betp,betplx,
545  * rax,zax, rxpnt,zxpnt, psbo, psdel,
546  * rc,zc,nc, pjk,ncequi, psip,
547  * rloop,zloop,nloop, rprob,zprob,nprob,
548  * zli3,betpol,betful,
549  * necon,wecon,ntype , nflag, errarr)
550 
551  !pause 'pause '
552 
553 
554 c------------------------------------------------------------------
555 ! CALL TRAVEC (PSIP, PSK, NC, NCPFC, NEQUI, NECON, WECON)
556  do k=1,ncequi
557  psk(k)=psip(k)
558  enddo
559 c------------------------------------------------------------------
560 !!test psip
561 ! call flux_g(psip,rc,zc,nc)
562 ! CALL TRAVEC (PSIP, PSK, NC, NCPFC, NEQUI, NECON, WECON)
563 !!test psip
564 
565 
566 !((((((((((((((((((((((((((((((((((((((((((
567 ! if(i_diag.eq.1)then
568 !
569 !! call psi_diag()
570 !
571 ! call ext_diag
572 !
573 ! call curr_to_dina(ncequi,pjk,tokf)
574 ! call loopflux()
575 ! call probefield()
576 ! end if
577 !))))))))))))))))))))))))))))))))))))))))))
578 
579  istep=nstep
580  call bongri
581  call f_psib_pla(pspl_av)
582  call f_psib_ext(psex_av)
583 
584  psi0_bnd=pspl_av+psex_av
585  call put_psib0(psi0_bnd)
586  call wr_step(numwr,time,istep)
587 
588 ! return
589  go to 757
590 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
591 !$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
592 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
593 
594 
595 1111 CONTINUE
596 
597  keyctr=key_dmf
598  !keyctr=0
599  call bongri
600  call f_psib_pla(pspl_av)
601  call f_psib_ext(psex_av)
602 
603  psi0_bnd=pspl_av+psex_av
604  call put_psib0(psi0_bnd)
605  psi_eav=psex_av
606  dpsdt=(psi_eav-psi_eav_n)/dt
607  psi_eav_n=psi_eav
608 c***********************************************************************
609 c computing of "VOLKP1" voltage for circuit equation
610 c for new time level kstep
611 c
612  DO i=1,nequi
613  volkp1(i) = voltpf(i)*bbb
614  END DO
615  DO i=nequi+1,ncequi
616  volkp1(i) = 0.0d0
617  END DO
618 c-----------------------------------------------------------------------
619 
620 !!!!!!! preparations for currrents - equilibrium iteration loop
621 
622  !n_pr = 3
623  !a_print(1) = time
624  !a_print(2) = dt
625  !a_print(3) = keypri
626  !num = 30
627  !apr = '-time dt keypri='
628  !call out42(n_pr,a_print,num,apr)
629 
630  !write(17,*) 'before kstep.eq.1'
631 
632  IF( kstep.EQ.1 ) THEN
633 
634  do l=1,ncequi
635  pskp1(l) = psk(l)
636  enddo
637 
638  nreg = 0
639  nles = 0
640 
641  CALL evslv( nles, nreg, tstep, tstep, sigm,
642  * ncequi, volk, volkp1, res,
643  * psk, pskp1, pjk, pjkp1, pjkp,
644  * nout, nter, keypri, ereve )
645 
646  END IF !!! ===> FOR IF( KSTEP.EQ.1 )
647 c***********************************************************************
648  IF(kstep.NE.1) THEN
649 
650 c----------------------------------------------------------------
651 c the initial approximation for the case of closed-loop evolution
652 c
653  do l=1,ncequi
654  pjkp(l) = pjk(l)
655  enddo
656 c----------------------------------------------------------------
657 c
658  nreg = 0
659  nles = 1
660 
661  CALL evslv( nles, nreg, tstepr, tstep, sigm,
662  * ncequi, volk, volkp1, res,
663 ! * PSK, PSK, PJK, PJKP1, PJKP,
664  * pskm1, psk, pjk, pjkp1, pjkp,
665  * nout, nter, keypri, ereve )
666 
667  END IF !!! ===> FOR IF( KSTEP.NE.1 )
668 c***********************************************************************
669 
670  call eqa_ax( dt,time,
671  * keyctr,igdf,nstep,platok, psax,i_betp,betplx,
672  * rax,zax, rxpnt,zxpnt, psbo, psdel,
673  * rc,zc,nc, pjkp1,ncequi, psip,
674  * rloop,zloop,nloop, rprob,zprob,nprob,
675  * zli3,betpol,betful,
676  * necon,wecon,ntype , nflag, errarr)
677  !call f_wrd
678 
679 c------------------------------------------------------------------
680  !CALL TRAVEC (PSIP, PSKP1, NC, NCPFC, NEQUI, NECON, WECON)
681  do k=1,ncequi
682  pskp1(k)=psip(k)
683  enddo
684 
685 !((((((((((((((((((((((((((((((((((((((((((((((
686 ! if(i_diag.eq.1)then
687 !! call psi_diag()
688 ! call ext_diag
689 ! call curr_to_dina(ncequi,pjkp1,ftok)
690 ! call loopflux()
691 ! call probefield()
692 ! end if
693 !)))))))))))))))))))))))))))))))))))))))))))))))
694 
695 c------------------------------------------------------------------
696 
697 !!!!!!! currrents - equilibrium iteration loop begining
698 
699  knel = 0
700  1000 knel = knel + 1
701 
702  DO l=1,ncequi
703  pskp(l) = pskp1(l)
704  pjkp(l) = pjkp1(l)
705  ENDDO
706 
707  nreg = 0
708  nles = 2
709 
710  CALL evslv( nles, nreg, tstep, tstep, sigm,
711  * ncequi, volk, volkp1, res,
712  * psk, pskp1, pjk, pjkp1, pjkp,
713  * nout, nter, keypri, ereve )
714 
715 ! CALL DIFFER( PJKP, PJKP1, NCEQUI, ERRCU1, ERRCU2,
716 ! * CURMAX, CURMIN, NOUT, NTER )
717 
718  !SGMCUR = 1.00D0
719  !SGMCUR = 0.75D0
720  sgmcur = 0.5d0
721 
722  DO l=1,ncequi
723  pjkp1(l) = sgmcur*pjkp1(l) + (1.0d0 - sgmcur)*pjkp(l)
724  END DO
725 c-----------------------------------------------------------------------
726 
727  call eqa_ax( dt,time,
728  * keyctr,igdf,nstep,platok, psax,i_betp,betplx,
729  * rax,zax, rxpnt,zxpnt, psbo, psdel,
730  * rc,zc,nc, pjkp1,ncequi, psip,
731  * rloop,zloop,nloop, rprob,zprob,nprob,
732  * zli3,betpol,betful,
733  * necon,wecon,ntype , nflag, errarr)
734 
735  !call f_wrd
736 
737  !write(17,*) 'after eqa_ax'
738 c------------------------------------------------------------------
739  !CALL TRAVEC (PSIP, PSKP1, NC, NCPFC, NEQUI, NECON, WECON)
740  do k=1,ncequi
741  pskp1(k)=psip(k)
742  !pskp1(k)=0.5d0*(psip(k)+pskp1(k))
743  enddo
744 c------------------------------------------------------------------
745 
746 !((((((((((((((((((((((((((((((((((((((((((((
747 ! if(i_diag.eq.1)then
748 !! call psi_diag()
749 ! call ext_diag
750 ! call curr_to_dina(ncequi,pjkp1,ftok)
751 ! call loopflux()
752 ! call probefield()
753 ! end if
754 !)))))))))))))))))))))))))))))))))))))))))))))
755 
756  erro=errarr(1)
757 
758  if(kpr.eq.1) then
759  write(*,*) ' '
760  write(*,*) ' '
761  write(*,*) 'stepon:erro',erro
762  write(*,*) ' '
763  write(*,*) ' '
764  endif
765  !write(17,*) ' '
766  !write(17,*) ' '
767  !write(17,*) 'stepon:erro',erro
768  !write(17,*) ' '
769  !write(17,*) ' '
770  IF( erro .LT. enels ) THEN
771  go to 200
772  END IF
773 
774  IF( knel .GE. knels ) THEN
775 
776  if(kpr.eq.1) then
777  write(*,*) ' '
778  write(*,*) 'stepon:limit of iterations is exceded'
779  write(*,*) 'knel=',knel
780  write(*,*) ' '
781  endif
782  !write(17,*) ' '
783  !write(17,*) 'stepon:limit of iterations is exceded'
784  !write(17,*) 'knel=',knel
785  !write(17,*) ' '
786 
787  go to 200
788  END IF
789 
790 !!!!!!! currrents - equilibrium iteration loop finish
791 
792  go to 1000
793 
794 c 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000 1000
795 
796  200 CONTINUE
797  call f_wrd
798 
799  do i=1,nequi
800  d_pf_mat(i) = pjkp1(i)*1.0d6 !!! in [A]
801  end do
802 
803  do i=nequi+1,ncequi
804  d_tcam_mat(i-nequi) = pjkp1(i)*1.0d6 !!! in [A]
805  end do
806 
807  do l=1,ncequi
808  pjk(l) = pjkp1(l)
809  volk(l) = volkp1(l)
810  pskm1(l) = psk(l)
811  psk(l) = pskp1(l)
812  enddo
813 
814  numwr=numwr+1
815  call wr_step(numwr,time,kstep)
816 
817 
818 !!!!!!!!!!time dependent arrays initialization
819  757 continue
820 
821  i_tim=kstep+1
822 
823  time_t(i_tim)=time
824  torcur(i_tim)=platok
825  rm_t(i_tim)=rax
826  zm_t(i_tim)=zax
827  rxp_t(i_tim)=rxpnt
828  zxp_t(i_tim)=zxpnt
829  betpol_t(i_tim)=betpol
830  bettor_t(i_tim)=betful
831  psim_t(i_tim)=psax
832  psib_t(i_tim)=psbo
833 
834 !!!!!!!!!!time dependent arrays initialization
835 
836 
837 
838 
839 
840  RETURN
841  END
842 
843 
844 
845 
846 
847 
848 
849 
850 
eqa_ax
subroutine eqa_ax(dt, time,
Definition: _eqa_m_r.f:612
put_ipl
subroutine put_ipl(placur)
Definition: Spider_call.f:243
tab_efit
subroutine tab_efit(tokf, psax, eqdfn, rax, zax, b0, r0)
Definition: B_wrd.f:447
zero
subroutine zero(x1, y1, x2, y2, func, err, x, y, izero, ll)
Definition: zero.f90:1
b_stepon
subroutine b_stepon(KLUCH, k_auto, nstep, dt, time,
Definition: sstepon_r.f:3
renet
subroutine renet
Definition: _mesh.f:6
conduc
subroutine conduc(NC, NCEQUI, NCPFC, NFW, NBP, NVV, RC, ZC, PC, VC, HC, NTYPE, RC1, ZC1, RC2, ZC2, RC3, ZC3, RC4, ZC4, RES, VOLK, VOLKP1, NECON, WECON, NOUT, NTER, NINFW, ngra1)
Definition: Ev1.f:826
f_wrd
subroutine f_wrd
Definition: _wrd.f:107
get_ipl
subroutine get_ipl(placur)
Definition: Spider_call.f:253
eqa_in
subroutine eqa_in(alf0, alf1, alf2, bet0, bet1, bet2, nursb,
Definition: _eqain.f:2
loopnt
subroutine loopnt(NOUT, NTER, NINFW, NGRA1,
Definition: Ev3.f:254
rd_ppind
subroutine rd_ppind
Definition: Ev3.f:166
rdcoil
subroutine rdcoil(nk, nkcoil, rk, zk, tk, necon, wecon)
Definition: wrc.f:23
eqb
subroutine eqb(alf0, alf1, alf2, bet0, bet1, bet2, alw0, alw1, alw2,
Definition: B_eqb.f:3
rd_loop
subroutine rd_loop(NLOO, RLOO, ZLOO)
Definition: Ev3.f:302
get_flfi
subroutine get_flfi(flfi_m)
Definition: com_sub.f:394
l_matr
subroutine l_matr(NOUT,NTER, NC, NCPFC,
Definition: Ev3.f:63
wr_step
subroutine wr_step(numwr, time, istep)
Definition: _wrd.f:587
f_psib_ext
subroutine f_psib_ext(psex_av)
Definition: _rig.f:676
bongri
subroutine bongri
Definition: com_sub.f:242
wrcoil
subroutine wrcoil(nk, nkcoil, rk, zk, tk, necon, wecon)
Definition: wrc.f:1
loop
subroutine loop
Definition: Eq2_m.f:231
psib_pla
subroutine psib_pla(pspl_av)
Definition: B_rig.f:499
evslv
subroutine evslv(NLES, NREG, TSTEP0, TSTEP, SIGM, NJ, VOLK, VOLKP1, RES, PSPK, PSPKP1, CRPK, CRPKP1, CRPKP, NOUT, NTER, KEYPRI, EREVE)
Definition: solc.f:22
put_psib0
subroutine put_psib0(psi0_bnd)
Definition: _rig.f:779
eqa
subroutine eqa(
Definition: _eqa_m_r.f:2
f_bndmat
subroutine f_bndmat(rk, zk, nk, rlop, zlop, nlop, rprob, zprob, nprob)
Definition: _bnd.f:1
evolution
subroutine evolution(T, R_in, R_out, El, Tr_l, Tr_U, Ip)
Definition: ets_workflow.F90:1871
propnt
subroutine propnt(NOUT, NTER, NINFW, NGRA1,
Definition: Ev3.f:187
rd_prob
subroutine rd_prob(NPRO, RPRO, ZPRO, FIPRO)
Definition: Ev3.f:233
f_stepon
subroutine f_stepon(KLUCH, k_auto, nstep, dt, time,
Definition: sstepon_r.f:169
f_psib_pla
subroutine f_psib_pla(pspl_av)
Definition: _rig.f:708
matrix
subroutine matrix
Definition: Matrix.f:2