ETS  \$Id: Doxyfile 2162 2020-02-26 14:16:09Z g2dpc $
 All Classes Files Functions Variables Pages
Ev3.f
Go to the documentation of this file.
1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2 c
3  SUBROUTINE durs_dat( NOUT, NTER, NINEV,
4  * nurs,
5  * betap0, ftok0, psiax0, helin0,
6  * alf00, alf11, alf22,
7  * bet00, bet11, bet22,
8  * ngav0 )
9 c
10  include 'double.inc'
11 c
12 c....................................................................
13  write(fname,'(a,a)') path(1:kname),'durs.dat'
14  open(1,file=fname,form='formatted')
15  !OPEN(NINEV, FILE='durs.dat')
16 c
17  read(1,*) nurs
18  read(1,*) betap0
19  read(1,*) ftok0
20  read(1,*) psiax0
21  read(1,*) helin0
22  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
23  read(1,*) alf00 !!
24  read(1,*) alf11 !! P'=alf0*(1-(1-psi)**alf1)**alf2
25  read(1,*) alf22 !!
26  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
27  read(1,*) bet00 !!
28  read(1,*) bet11 !! FF'=bet0*(1-(1-psi)**bet1)**bet2
29  read(1,*) bet22 !!
30  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
31  read(1,*) ngav0
32 c
33  CLOSE(1)
34 c---------------------------------------------------------------
35  !WRITE(NOUT,*) '.........................................'
36  !WRITE(NOUT,*) 'FROM FILE "durs.dat" BASIC EQUILIBR. DATA'
37  !WRITE(NOUT,*) '............................ '
38  !WRITE(NOUT,*) ' NURS =', NURS
39  !WRITE(NOUT,*) '............................ '
40  !WRITE(NOUT,*) ' FTOK0 =', FTOK0
41  !WRITE(NOUT,*) ' BETAP0 =', BETAP0
42  !WRITE(NOUT,*) ' PSIAX0 =', PSIAX0
43  !WRITE(NOUT,*) ' HELIN0 =', HELIN0
44  !WRITE(NOUT,*) '............................ '
45  !WRITE(NOUT,*) ' ALF00 =', ALF00
46  !WRITE(NOUT,*) ' ALF11 =', ALF11
47  !WRITE(NOUT,*) ' ALF22 =', ALF22
48  !WRITE(NOUT,*) ' BET00 =', BET00
49  !WRITE(NOUT,*) ' BET11 =', BET11
50  !WRITE(NOUT,*) ' BET22 =', BET22
51  !WRITE(NOUT,*) '............................ '
52  !WRITE(NOUT,*) ' NGAV0 =', NGAV0
53  !WRITE(NOUT,*) '....................................... '
54 c---------------------------------------------------------------
55  RETURN
56  END
57 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
58 c****************************************************************
59 c--- definition mutuals induct. and selfinduct. matrix
60 c--- for "EDDY" conductors: ppind
61 c *******
62 c---
63  SUBROUTINE l_matr( NOUT, NTER, NC, NCPFC,
64  * ntype, rc, zc, vc, hc,
65  * necon, wecon )
66 c
67  include 'double.inc'
68 c
69  include 'prm.inc'
70  include 'comevl.inc'
71 c
72  INTEGER ntype(nclim)
73  dimension rc(nclim), zc(nclim), vc(nclim), hc(nclim)
74  INTEGER necon(nilim)
75  dimension wecon(nilim)
76 c....................................................................
77 c--------------------------------------------------------------------
78  pi=3.14159265359d0
79  amu0=0.4d0*pi
80  DO 11 j1=1,nc
81  DO 12 j2=1,nc
82  IF( j2.LT.j1 ) THEN
83  ppind(j1,j2) = ppind(j2,j1)
84  END IF
85  IF( j2.EQ.j1 ) THEN
86  ppind(j1,j2) = selind( ntype(j1),rc(j1),vc(j1),hc(j1) )
87  END IF
88  IF( j2.GT.j1 ) THEN
89  ppind(j1,j2) = betind( ntype(j1),
90  * rc(j1), zc(j1), vc(j1), hc(j1),
91  * ntype(j2),
92  * rc(j2), zc(j2), vc(j2), hc(j2) )
93  END IF
94  12 CONTINUE
95 c -----
96 c WRITE(nout,*) '**** J1 = ',j1,' ****'
97 c WRITE(nout,*) 'PPIND(J1,J2) : J2=1,NC,10'
98 c WRITE(nout,101) (ppind(j1,j2),j2=1,nc,10)
99 c -----
100  11 CONTINUE
101 
102 
103  do j1=1,nc
104  do j2=1,nc
105  ppind(j1,j2) = ppind(j1,j2)*amu0
106  enddo
107  enddo
108 
109 
110 c -----
111 c WRITE(nout,*) '** SELFINDUCT. OF "EDDY" CONDUCTORS **'
112 c WRITE(nout,*) ' PPIND(L,L), L=1,NC : NC =', nc
113 c WRITE(nout,101) (ppind(l,l), l=1,nc)
114 c WRITE(nter,*) '** SELFINDUCT. OF "EDDY" CONDUCTORS **'
115 c WRITE(nter,*) ' PPIND(L,L), L=1,NC : NC =', nc
116 c WRITE(nter,101) (ppind(l,l), l=1,nc)
117 c
118 c********************************************************************
119 c transform of "FULL" matrix "P" ( "NC*NC" SIZE ) to
120 c "EQUIVALENT" matrix "P" ( "NCEQUI*NCEQUI" SIZE ).
121 c here ncequi = nc - ncpfc + nequi.
122 c
123  CALL tramat( ppind, njlim, nc, ncpfc, nequi,
124  * necon, wecon )
125 c
126 c [ ppind(i,j) pet units ] = [micro*h] * bbb
127 c bbb = 10.d0 / (4.d0*pi) / (2.d0*pi) = 0.12665148...
128 c
129 c ppind(19,19) = 12.2d0 !!! iz bazy dannyh TCV (v edinizah PET)
130 c ppind(19,19) = 27.46153d0 !!! iz nashei analit. formuly
131 c ppind(19,19) = 110.0d0*0.12665148d0
132 c
133  ncequi = nc - ncpfc + nequi
134 c -----
135 c WRITE(nter,*) '** SELFINDUCT. OF "EDDY" CONDUCTORS **'
136  !WRITE(NOUT,*) '** SELFINDUCT. OF "EDDY" CONDUCTORS **'
137  !WRITE(NOUT,*) ' PPIND(L,L), L=1,NCEQUI : NCEQUI =', NCEQUI
138  !WRITE(NOUT,101) (PPIND(L,L), L=1,NCEQUI)
139 c WRITE(nter,*) ' PPIND(L,L), L=1,NCEQUI : NCEQUI =', ncequi
140 c WRITE(nter,101) (ppind(l,l), l=1,ncequi)
141 c
142 c WRITE(nter,*) '** MUTUALS INDUCT. OF "EDDY" CONDUCTORS **'
143  !WRITE(NOUT,*) '** MUTUALS INDUCT. OF "EDDY" CONDUCTORS **'
144  !DO L=1,NCEQUI
145  !WRITE(NOUT,*) ' PPIND(L,J), L =',L,' J=1,NCEQUI =', NCEQUI
146  !WRITE(NOUT,101) (PPIND(L,J), J=1,NCEQUI)
147 c WRITE(nter,*) ' PPIND(L,J), L =',l,' J=1,NCEQUI =', ncequi
148 c WRITE(nter,101) (ppind(l,j), j=1,ncequi)
149  !END DO
150 c
151 c--------------------------------------------------------------------
152  !ngra1 = 14
153  write(fname,'(a,a)') path(1:kname),'ppind_mat.wr'
154  open(1,file=fname,form='formatted')
155  !open(ngra1,file='ppind_mat.wr')
156  write(1,*) ncequi
157  write(1,*) ((ppind(i,j),i=1,ncequi), j=1,ncequi)
158  close(1)
159 c--------------------------------------------------------------------
160  101 FORMAT(2x,5e14.7)
161 c
162 c--------------------------------------------------------------------
163  RETURN
164  END
165 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
166  SUBROUTINE rd_ppind
167 c
168  include 'double.inc'
169 c
170  include 'prm.inc'
171  include 'comevl.inc'
172  common/comeqg/ ncequi
173 c
174  !ngra1 = 14
175  write(fname,'(a,a)') path(1:kname),'ppind_mat.wr'
176  open(1,file=fname,form='formatted')
177  !open(1,file='ppind_mat.wr')
178  read(1,*) ncequi
179  read(1,*) ((ppind(i,j),i=1,ncequi), j=1,ncequi)
180  close(1)
181 c
182  return
183  end
184 c***********************************************************************
185 c--- input of positions of "PF_PROBE" points:
186 c
187  SUBROUTINE propnt( NOUT, NTER, NINFW, NGRA1,
188  * npro, rpro, zpro, fipro )
189 c
190  include 'double.inc'
191 c
192  dimension rpro(*), zpro(*), fipro(*)
193 c
194  write(fname,'(a,a)') path(1:kname),'pf_probe.dat'
195  open(1,file=fname,form='formatted')
196  !OPEN (NINFW, FILE='pf_probe.dat')
197 c
198  READ(1,*) npro
199  !WRITE(NOUT,*) '--------------------------------------'
200  !WRITE(NOUT,*) 'NUMBER OF "PROBE" POINTS NPRO =', NPRO
201  !WRITE(NOUT,*) ' '
202  ! WRITE(NTER,*) '--------------------------------------'
203  ! WRITE(NTER,*) 'NUMBER OF "PROBE" POINTS NPRO =', NPRO
204  ! WRITE(NTER,*) ' '
205 c
206  IF( npro.NE.0 ) THEN
207 c
208  !WRITE(NOUT,*) 'THEIR NUMBER (i), POSITION "RPRO(i), ZPRO(i)"'
209  !WRITE(NOUT,*) ' AND ORIENTATION ANGLE "FIPRO(i)" : '
210  DO 397 l=1,npro
211  READ(1,*) rpro(l), zpro(l), fipro(l)
212 c WRITE(nout,*) l, rpro(l), zpro(l), fipro(l)
213  397 CONTINUE
214 c--------------------------------------------------------------------
215 c--------------------------------------------------------------------
216  END IF
217 c
218  CLOSE (1)
219 c--------------------------------------------------------------------
220  write(fname,'(a,a)') path(1:kname),'propoi.wr'
221  open(1,file=fname,form='formatted')
222  !open(ngra1,file='propoi.wr')
223  write(1,*) npro
224  write(1,*) ( rpro(i), i=1,npro)
225  write(1,*) ( zpro(i), i=1,npro)
226  write(1,*) (fipro(i), i=1,npro)
227  close(1)
228  RETURN
229  END
230 c***********************************************************************
231 c--- reading of positions of "PF_PROBE" points:
232 c
233  SUBROUTINE rd_prob( NPRO, RPRO, ZPRO, FIPRO )
234 c
235  include 'double.inc'
236 c
237  dimension rpro(*), zpro(*), fipro(*)
238 c
239  !ngra1 = 14
240  write(fname,'(a,a)') path(1:kname),'propoi.wr'
241  open(1,file=fname,form='formatted')
242  !open(1,file='propoi.wr')
243  read(1,*) npro
244  read(1,*) ( rpro(i), i=1,npro)
245  read(1,*) ( zpro(i), i=1,npro)
246  read(1,*) (fipro(i), i=1,npro)
247  close(1)
248 c
249  RETURN
250  END
251 c***********************************************************************
252 c--- input of positions of "FL_LOOP" points:
253 c
254  SUBROUTINE loopnt( NOUT, NTER, NINFW, NGRA1,
255  * nloo, rloo, zloo )
256 c
257  include 'double.inc'
258 c
259  dimension rloo(*), zloo(*)
260 
261  ninfw=1
262  ngra1=1
263 
264  write(fname,'(a,a)') path(1:kname),'fl_loop.dat'
265  open(ninfw,file=fname,form='formatted')
266  !OPEN(NINFW, FILE='fl_loop.dat')
267 c
268  READ(ninfw,*) nloo
269  !WRITE(NOUT,*) '--------------------------------------'
270  !WRITE(NOUT,*) 'NUMBER OF "LOOP" POINTS NLOO =', NLOO
271  !WRITE(NOUT,*) ' '
272  ! WRITE(NTER,*) '--------------------------------------'
273  ! WRITE(NTER,*) 'NUMBER OF "LOOP" POINTS NLOO =', NLOO
274  ! WRITE(NTER,*) ' '
275 c
276  IF( nloo.NE.0 ) THEN
277 c
278  !WRITE(NOUT,*) 'THEIR NUMBER (i), POSITION "RLOO(i), ZLOO(i)"'
279 c
280  DO 397 l=1,nloo
281  READ(ninfw,*) rloo(l), zloo(l)
282 c WRITE(nout,*) l, rloo(l), zloo(l)
283  397 CONTINUE
284 c--------------------------------------------------------------------
285 c--------------------------------------------------------------------
286  END IF
287 c
288  CLOSE (ninfw)
289  write(fname,'(a,a)') path(1:kname),'loopoi.wr'
290  open(ngra1,file=fname,form='formatted')
291  !open(ngra1,file='loopoi.wr')
292  write(ngra1,*) nloo
293  write(ngra1,*) (rloo(i), i=1,nloo)
294  write(ngra1,*) (zloo(i), i=1,nloo)
295  close(ngra1)
296 c--------------------------------------------------------------------
297  RETURN
298  END
299 c***********************************************************************
300 c--- input of positions of "FL_LOOP" points:
301 c
302  SUBROUTINE rd_loop( NLOO, RLOO, ZLOO )
303 
304  include 'double.inc'
305  dimension rloo(*), zloo(*)
306 c
307  ngra1 = 1
308  write(fname,'(a,a)') path(1:kname),'loopoi.wr'
309  open(1,file=fname,form='formatted')
310  !open(ngra1,file='loopoi.wr')
311  read(ngra1,*) nloo
312  read(ngra1,*) (rloo(i), i=1,nloo)
313  read(ngra1,*) (zloo(i), i=1,nloo)
314  close(ngra1)
315 c
316  RETURN
317  END
318 c***********************************************************************
319 c
320 c..... toroidal currents of passive conductor structures
321 c
322  SUBROUTINE pascur( NOUT, NTER, NEQUI, NFW, NBP, NVV,
323  * pjk, fwcurr, bpcurr, vvcurr )
324 c
325  include 'double.inc'
326 c
327  dimension pjk(*)
328 c
329  fwcurr = 0.d0
330  IF( nfw .NE. 0 ) THEN
331  DO i=1,nfw
332  fwcurr = fwcurr + pjk(nequi+i)
333  enddo
334  END IF
335  bpcurr = 0.d0
336  IF( nbp .NE. 0 ) THEN
337  DO i=1,nbp
338  bpcurr = bpcurr + pjk(nequi+nfw+i)
339  enddo
340  END IF
341  vvcurr = 0.d0
342  IF( nvv .NE. 0 ) THEN
343  DO i=1,nvv
344  vvcurr = vvcurr + pjk(nequi+nfw+nbp+i)
345  enddo
346  END IF
347 c
348 c--------------------------------------------------------------------
349  RETURN
350  END
351 c***********************************************************************
352 c--- printing and writing of numbers and positions of limiter points:
353 c
354  SUBROUTINE prtlim( NOUT, NTER, NGRA1 )
355 c
356  include 'double.inc'
357 c
358  include 'param.inc'
359  include 'comblc.inc'
360 c
361  IF( nctrl .NE. 0 ) THEN
362  !WRITE(NOUT,*) '-----------------------------------------'
363  ! WRITE(NTER,*) '-----------------------------------------'
364  !WRITE(NOUT,*) 'LIMITER POINTS REGIME: NCTRL =', NCTRL
365  ! WRITE(NTER,*) 'LIMITER POINTS REGIME: NCTRL =', NCTRL
366  !WRITE(NOUT,*) 'TOTAL NUMBER OF LIMITER POINTS =', NBLM
367  ! WRITE(NTER,*) 'TOTAL NUMBER OF LIMITER POINTS =', NBLM
368  !WRITE(NOUT,*) ' '
369 c
370  IF( nblm .NE. 0 ) THEN
371  !WRITE(NOUT,*) 'THEIR NUMBER AND POSITION :'
372  DO 603 l=1,nblm
373 c WRITE(nout,*) l, rblm(l), zblm(l)
374  603 CONTINUE
375  !WRITE(NOUT,*) '-----------------------------------------'
376  !WRITE(NOUT,*) ' '
377 c
378  write(fname,'(a,a)') path(1:kname),'limpoi.wr'
379  open(ngra1,file=fname,form='formatted')
380  !open(ngra1,file='limpoi.wr')
381  write(ngra1,*) nblm
382  write(ngra1,*) (rblm(i), i=1,nblm), (zblm(i), i=1,nblm)
383  close(ngra1)
384 c
385  END IF
386  END IF
387 c
388 c-----------------------------------------------------------------------
389  RETURN
390  END
391 c***********************************************************************
392 c--------------------- writing in disk files ---------------------------
393 c
394  SUBROUTINE wrtd1( NOUT, NTER, NFRWR1, NVAR, NGAV1,
395  * ngra1, ngra2, nboun, nbran, nprob, nloop,
396  * kstep, knel, tstep, timev,
397  * rm, zm, rx0, zx0,
398  * erps , errcu2, delps2, delaxr,
399  * tokout, psiout, psibou, psidel,
400  * betpol, zli3, alpnew, numlim,
401  * pvolum, fwcurr, bpcurr, vvcurr,
402  * npfc, ncop, nequi, nc, ncpfc, ncequi,
403  * nfw, nbp, nvv, nsegfw, cfwseg,
404  * npro, brpro , bzpro , bpcom , bp_exp,
405  * nloo, psloo , ps_exp,
406  * n_volt, pfvol1, v_full,
407  * n_cp, cp_com, cp_exp)
408 c
409  include 'double.inc'
410 c
411  include 'param.inc'
412 c
413  common /comus1/ rus1(nbndp2), zus1(nbndp2), nus1
414  common /comus2/ rus2(nbndp2), zus2(nbndp2), nus2
415  common /comlop/ rxb(nbndp2), zxb(nbndp2), nxb
416 c
417  common /equili/ bettot, rmx, zzrmx, rmn, zzrmn,
418  * zmx, rrzmx, zmn, rrzmn,
419  * r0cen, z0cen, radm, aspect,
420  * eupper, elower, delup, dellw, bfvakc
421  common /volpla/ vol_pl
422 c
423  dimension cfwseg(*)
424  dimension brpro(*), bzpro(*), bpcom(*), psloo(*)
425  dimension bp_exp(*), ps_exp(*)
426  dimension cp_com(*), cp_exp(*)
427  dimension pfvol1(*), v_full(*)
428 c.......................................................................
429 c
430  pvolum = 2.d0*pi*vol_pl
431 c
432 c----------
433  open(ngra1,file='nsteps.wr')
434  kstep1 = kstep + 1
435  write(ngra1,*) nvar, kstep1
436  close(ngra1)
437 c----------
438  open(ngra2,file='tvalues.wr')
439  write(ngra2,*) kstep , timev , tstep , knel , ngav1,
440  * erps , errcu2, delps2, delaxr,
441  * rm , zm , rx0 , zx0 ,
442  * tokout, psiout, betpol, zli3 ,
443  * alpnew, numlim, psibou, psidel,
444  * pvolum, fwcurr, bpcurr, vvcurr
445  close(ngra2)
446 c----------
447  open(ngra2,file='bou_geom_t.wr')
448  write(ngra2,*) kstep , timev,
449  * bettot, rmx, zzrmx, rmn, zzrmn,
450  * zmx, rrzmx, zmn, rrzmn,
451  * r0cen, z0cen, radm, aspect,
452  * eupper, elower, delup, dellw
453  close(ngra2)
454 c----------
455  open(ngra2,file='z_axis_t.wr')
456  write(ngra2,*) timev , zm
457  close(ngra2)
458 c----------
459  open(ngra1,file='ncurrs.wr')
460  write(ngra1,*) npfc, ncop, nequi, nc, ncpfc, ncequi,
461  * nfw, nbp, nvv
462  close(ngra1)
463 c---------------------------------------------------------------
464  IF( nfrwr1.NE.0 ) THEN
465  label1 = 1
466 c.........
467  open(ngra1,file='n_voltage.wr')
468  write(ngra1,*) nvar, n_volt, label1
469  close(ngra1)
470  open(ngra2,file='voltage.wr')
471  write(ngra2,*) kstep, timev, tstep
472  write(ngra2,*) (pfvol1(i), i=1,n_volt)
473  write(ngra2,*) (v_full(i), i=1,n_volt)
474  close(ngra2)
475 c.........
476  open(ngra1,file='n_cp.wr')
477  write(ngra1,*) nvar, n_cp, label1
478  close(ngra1)
479  open(ngra2,file='cp_com.wr')
480  write(ngra2,*) kstep, timev, tstep
481  write(ngra2,*) (cp_com(i), i=1,n_cp)
482  write(ngra2,*) (cp_exp(i), i=1,n_cp)
483  close(ngra2)
484 c...........
485  open(ngra1,file='ncurse.wr')
486  write(ngra1,*) nvar, nsegfw, label1
487  close(ngra1)
488  open(ngra2,file='tcurse.wr')
489  write(ngra2,*) kstep, timev, tstep
490  write(ngra2,*) (cfwseg(i), i=1,nsegfw)
491  close(ngra2)
492 c.........
493  if( npro.ne.0 ) then
494  open(ngra1,file='n_probf.wr')
495  write(ngra1,*) nvar, npro, label1
496  close(ngra1)
497  open(nprob,file='probf.wr')
498  write(nprob,*) kstep, timev, tstep
499  write(nprob,*) (brpro(i), i=1,npro)
500  write(nprob,*) (bzpro(i), i=1,npro)
501  write(nprob,*) (bpcom(i), i=1,npro)
502  write(nprob,*) (bp_exp(i),i=1,npro)
503  close(nprob)
504  end if
505 c.........
506  if( nloo.ne.0 ) then
507  open(ngra1,file='n_loopf.wr')
508  write(ngra1,*) nvar, nloo, label1
509  close(ngra1)
510  open(nloop,file='loopf.wr')
511  write(nloop,*) kstep, timev, tstep
512  write(nloop,*) (psloo(i), i=1,nloo)
513  write(nloop,*) (psloo(i), i=1,nloo)
514  write(nloop,*) (ps_exp(i),i=1,nloo)
515  close(nloop)
516  end if
517 c.........
518  open(nboun,file='plbound.wr')
519  write(nboun,*) nxb, kstep, timev
520  write(nboun,*) rx0, zx0
521  do i=1,nxb
522  write(nboun,*) rxb(i), zxb(i)
523  enddo
524 c write(nboun,*) (rxb(i),i=1,nxb)
525 c write(nboun,*) (zxb(i),i=1,nxb)
526  close(nboun)
527 c.........
528 c open(nbran,file='branchs.wr')
529 c write(nbran,*) nus1, nus2, kstep, timev
530 c write(nbran,*) (rus1(i),i=1,nus1)
531 c write(nbran,*) (zus1(i),i=1,nus1)
532 c write(nbran,*) (rus2(i),i=1,nus2)
533 c write(nbran,*) (zus2(i),i=1,nus2)
534 c.........
535  END IF
536 c
537 c-----------------------------------------------------------------------
538  RETURN
539  END
540 c***********************************************************************
541 c--------------------- writing in disk files ---------------------------
542 c
543  SUBROUTINE wrtd2( NOUT, NTER, NFRWR1, NVAR, NGAV1,
544  * ngra1, ngra2, nboun, nbran, nprob, nloop,
545  * kstep, knel, tstep, timev,
546  * rm, zm, rx0, zx0,
547  * erps , errcu2, delps2, delaxr,
548  * tokout, psiout, psibou, psidel,
549  * betpol, zli3, alpnew, numlim,
550  * pvolum, fwcurr, bpcurr, vvcurr,
551  * npfc, ncop, nequi, nc, ncpfc, ncequi,
552  * nfw, nbp, nvv, nsegfw, cfwseg,
553  * npro, brpro , bzpro , bpcom , bp_exp,
554  * nloo, psloo , ps_exp,
555  * n_volt, pfvol2, v_full,
556  * n_cp, cp_com, cp_exp )
557 c
558  include 'double.inc'
559 c
560  include 'param.inc'
561 c
562  common /comus1/ rus1(nbndp2), zus1(nbndp2), nus1
563  common /comus2/ rus2(nbndp2), zus2(nbndp2), nus2
564  common /comlop/ rxb(nbndp2), zxb(nbndp2), nxb
565 c
566  common /equili/ bettot, rmx, zzrmx, rmn, zzrmn,
567  * zmx, rrzmx, zmn, rrzmn,
568  * r0cen, z0cen, radm, aspect,
569  * eupper, elower, delup, dellw, bfvakc
570  common /volpla/ vol_pl
571 c
572  dimension cfwseg(*)
573  dimension brpro(*), bzpro(*), bpcom(*), psloo(*)
574  dimension bp_exp(*), ps_exp(*)
575  dimension cp_com(*), cp_exp(*)
576  dimension pfvol2(*), v_full(*)
577 c.......................................................................
578 c
579  pvolum = 2.d0*pi*vol_pl
580 c
581 c=======================================================================
582 c----------
583  open(ngra1,file='nsteps.wr')
584  kstep1 = kstep + 1
585  write(ngra1,*) nvar, kstep1
586  close(ngra1)
587 c.....
588  open(ngra2,file='tvalues.wr')
589  call endfl(ngra2)
590  write(ngra2,*) kstep , timev , tstep , knel , ngav1,
591  * erps , errcu2, delps2, delaxr,
592  * rm , zm , rx0 , zx0 ,
593  * tokout, psiout, betpol, zli3 ,
594  * alpnew, numlim, psibou, psidel,
595  * pvolum, fwcurr, bpcurr, vvcurr
596  close(ngra2)
597 c......
598  open(ngra2,file='bou_geom_t.wr')
599  call endfl(ngra2)
600  write(ngra2,*) kstep , timev,
601  * bettot, rmx, zzrmx, rmn, zzrmn,
602  * zmx, rrzmx, zmn, rrzmn,
603  * r0cen, z0cen, radm, aspect,
604  * eupper, elower, delup, dellw
605  close(ngra2)
606 c......
607  open(ngra2,file='z_axis_t.wr')
608  call endfl(ngra2)
609  write(ngra2,*) timev , zm
610  close(ngra2)
611 c-----------------------------------------------------------------------
612  IF( nfrwr1 .NE. 0 ) THEN
613  IF( (kstep/nfrwr1)*nfrwr1 .EQ. kstep ) THEN
614 c
615  label = kstep/nfrwr1
616  label1 = label + 1
617 c...........
618  open(ngra1,file='n_voltage.wr')
619  write(ngra1,*) nvar, n_volt, label1
620  close(ngra1)
621  open(ngra2,file='voltage.wr')
622  call endfl(ngra2)
623  write(ngra2,*) kstep, timev, tstep
624  write(ngra2,*) (pfvol2(i), i=1,n_volt)
625  write(ngra2,*) (v_full(i), i=1,n_volt)
626  close(ngra2)
627 c.........
628  open(ngra1,file='n_cp.wr')
629  write(ngra1,*) nvar, n_cp, label1
630  close(ngra1)
631  open(ngra2,file='cp_com.wr')
632  call endfl(ngra2)
633  write(ngra2,*) kstep, timev, tstep
634  write(ngra2,*) (cp_com(i), i=1,n_cp)
635  write(ngra2,*) (cp_exp(i), i=1,n_cp)
636  close(ngra2)
637 c...........
638  open(ngra1,file='ncurse.wr')
639  write(ngra1,*) nvar, nsegfw, label1
640  close(ngra1)
641  open(ngra2,file='tcurse.wr')
642  call endfl(ngra2)
643  write(ngra2,*) kstep, timev, tstep
644  write(ngra2,*) (cfwseg(i), i=1,nsegfw)
645  close(ngra2)
646 c.........
647  if( npro.ne.0 ) then
648  open(ngra1,file='n_probf.wr')
649  write(ngra1,*) nvar, npro, label1
650  close(ngra1)
651  open(nprob,file='probf.wr')
652  call endfl(nprob)
653  write(nprob,*) kstep, timev, tstep
654  write(nprob,*) (brpro(i), i=1,npro)
655  write(nprob,*) (bzpro(i), i=1,npro)
656  write(nprob,*) (bpcom(i), i=1,npro)
657  write(nprob,*) (bp_exp(i),i=1,npro)
658  close(nprob)
659  end if
660 c.........
661  if( nloo.ne.0 ) then
662  open(ngra1,file='n_loopf.wr')
663  write(ngra1,*) nvar, nloo, label1
664  close(ngra1)
665  open(nloop,file='loopf.wr')
666  call endfl(nloop)
667  write(nloop,*) kstep, timev, tstep
668  write(nloop,*) (psloo(i), i=1,nloo)
669  write(nloop,*) (psloo(i), i=1,nloo)
670  write(nloop,*) (ps_exp(i),i=1,nloo)
671  close(nloop)
672  end if
673 c...........
674 c writing in file = 'plbound.wr'
675 c
676 c open(nboun,file='plbound.wr')
677 c call endfl(nboun)
678 c write(nboun,*) nxb, kstep, timev
679 c write(nboun,*) (rxb(i),i=1,nxb)
680 c write(nboun,*) (zxb(i),i=1,nxb)
681 c close(nboun)
682 c...........
683 c writing in file = 'branchs.wr'
684 c
685 c write(nbran,*) nus1, nus2, kstep, timev
686 c write(nbran,*) (rus1(i),i=1,nus1)
687 c write(nbran,*) (zus1(i),i=1,nus1)
688 c write(nbran,*) (rus2(i),i=1,nus2)
689 c write(nbran,*) (zus2(i),i=1,nus2)
690 c.........
691 c.........
692  END IF
693  END IF
694 c-----------------------------------------------------------------------
695  RETURN
696  END
697 c***********************************************************************
698 c--------------------- writing in disk files ---------------------------
699 c
700  SUBROUTINE wrtd11( NOUT, NTER, NFRWR1, NVAR,
701  * ngra1, ngra2,
702  * kstep, tstep, timev,
703  * n_volt, pfc_exp, pfc_ref )
704 c
705  include 'double.inc'
706 c
707  include 'prm.inc'
708  include 'comevl.inc'
709 c-----------------------------------------------------------------------
710 c
711  dimension pfc_exp(n_volt_m), pfc_ref(n_volt_m)
712  dimension pfc_ex1(n_volt_m), pfc_re1(n_volt_m)
713 c-----------------------------------------------------------------------
714  IF( nfrwr1.NE.0 ) THEN
715  label1 = 1
716 c.........
717  open(ngra1,file='ntcurr.wr')
718  write(ngra1,*) nvar, npfc, label1
719  close(ngra1)
720  open(ngra2,file='tcurrs.wr')
721  write(ngra2,*) kstep, timev, tstep
722  write(ngra2,*) (pfcur1(i), i=1,npfc)
723  close(ngra2)
724 c.........
725  do i=1,n_volt
726  pfc_ex1(i)=pfc_exp(i)*0.000001d0
727  pfc_re1(i)=pfc_ref(i)*0.000001d0
728  end do
729 c
730  open(ngra1,file='n_pfceqw.wr')
731  write(ngra1,*) nvar, n_volt, label1
732  close(ngra1)
733  open(ngra2,file='pfceqw.wr')
734  write(ngra2,*) kstep, timev, tstep
735  write(ngra2,*) (pfceqw(i), i=1,n_volt)
736  write(ngra2,*) (pfc_ex1(i), i=1,n_volt)
737  write(ngra2,*) (pfc_re1(i), i=1,n_volt)
738  close(ngra2)
739  END IF
740 c
741  RETURN
742  END
743 
744 c***********************************************************************
745 c--------------------- writing in disk files ---------------------------
746 c
747  SUBROUTINE wrtd22( NOUT, NTER, NFRWR1, NVAR,
748  * ngra1, ngra2,
749  * kstep, tstep, timev,
750  * n_volt, pfc_exp, pfc_ref )
751 c
752  include 'double.inc'
753 c
754  include 'prm.inc'
755  include 'comevl.inc'
756 c-----------------------------------------------------------------------
757 c
758  dimension pfc_exp(n_volt_m), pfc_ref(n_volt_m)
759  dimension pfc_ex1(n_volt_m), pfc_re1(n_volt_m)
760 c-----------------------------------------------------------------------
761  IF( nfrwr1 .NE. 0 ) THEN
762  IF( (kstep/nfrwr1)*nfrwr1 .EQ. kstep ) THEN
763 c
764  label = kstep/nfrwr1
765  label1 = label + 1
766 c...........
767  open(ngra1,file='ntcurr.wr')
768  write(ngra1,*) nvar, npfc, label1
769  close(ngra1)
770  open(ngra2,file='tcurrs.wr')
771  call endfl(ngra2)
772  write(ngra2,*) kstep, timev, tstep
773  write(ngra2,*) (pfcur2(i), i=1,npfc)
774  close(ngra2)
775 c.........
776  do i=1,n_volt
777  pfc_ex1(i)=pfc_exp(i)*0.000001d0
778  pfc_re1(i)=pfc_ref(i)*0.000001d0
779  end do
780 c
781  open(ngra1,file='n_pfceqw.wr')
782  write(ngra1,*) nvar, n_volt, label1
783  close(ngra1)
784  open(ngra2,file='pfceqw.wr')
785  call endfl(ngra2)
786  write(ngra2,*) kstep, timev, tstep
787  write(ngra2,*) (pfceqw(i), i=1,n_volt)
788  write(ngra2,*) (pfc_ex1(i), i=1,n_volt)
789  write(ngra2,*) (pfc_re1(i), i=1,n_volt)
790  close(ngra2)
791 c.........
792  END IF
793  END IF
794 c
795  RETURN
796  END
797 
798 
799 
800 
801 
802 
803 
804 
805 
806 
807 
betind
REAL *8 function betind(NTYPE1, RC1, ZC1, VC1, HC1, NTYPE2, RC2, ZC2, VC2, HC2)
Definition: Ev1.f:202
wrtd1
subroutine wrtd1(NOUT,NTER,NFRWR1, NVAR,NGAV1,
Definition: Ev3.f:394
tramat
subroutine tramat(P, NJLIM, NC, NCPFC, NEQUI, NECON, WECON)
Definition: Ev1.f:467
selind
REAL *8 function selind(NTYPE, RC, VC, HC)
Definition: Ev1.f:118
prtlim
subroutine prtlim(NOUT, NTER, NGRA1)
Definition: Ev3.f:354
loopnt
subroutine loopnt(NOUT, NTER, NINFW, NGRA1,
Definition: Ev3.f:254
rd_ppind
subroutine rd_ppind
Definition: Ev3.f:166
rd_loop
subroutine rd_loop(NLOO, RLOO, ZLOO)
Definition: Ev3.f:302
l_matr
subroutine l_matr(NOUT,NTER, NC, NCPFC,
Definition: Ev3.f:63
wrtd2
subroutine wrtd2(NOUT,NTER,NFRWR1, NVAR,NGAV1,
Definition: Ev3.f:543
pascur
subroutine pascur(NOUT, NTER, NEQUI, NFW, NBP, NVV,
Definition: Ev3.f:322
wrtd22
subroutine wrtd22(NOUT,NTER,NFRWR1, NVAR,
Definition: Ev3.f:747
durs_dat
subroutine durs_dat(NOUT,NTER,NINEV,
Definition: Ev3.f:3
endfl
subroutine endfl(I)
Definition: ENDFL.f:1
propnt
subroutine propnt(NOUT, NTER, NINFW, NGRA1,
Definition: Ev3.f:187
rd_prob
subroutine rd_prob(NPRO, RPRO, ZPRO, FIPRO)
Definition: Ev3.f:233
wrtd11
subroutine wrtd11(NOUT,NTER,NFRWR1, NVAR,
Definition: Ev3.f:700
matrix
subroutine matrix
Definition: Matrix.f:2