ETS  \$Id: Doxyfile 2162 2020-02-26 14:16:09Z g2dpc $
 All Classes Files Functions Variables Pages
Ev1.f
Go to the documentation of this file.
1 C***************************************************************
2 C
3  SUBROUTINE differ( AOLD, ANEW, N, ERRLOC, ERRVEC,
4  * absmax, absmin, nout, nter )
5 C
6  include 'double.inc'
7 C
8  dimension aold(*), anew(*)
9 C
10  abs(x) = dabs(x)
11  sqrt(x) = dsqrt(x)
12 C
13  errloc = 0.d0
14  absmax = abs( anew(1) )
15  absmin = abs( anew(1) )
16 C
17  DO 1 i=1,n
18  absa = abs( anew(i) )
19  IF( absa.LT.absmin ) absmin = absa
20  IF( absa.GT.absmax ) absmax = absa
21  absd = abs( anew(i) - aold(i) )
22  IF( absa.GT.1.0d-12 ) THEN
23  absr = absd / absa
24  IF( absr.GT.errloc ) errloc = absr
25  END IF
26  1 CONTINUE
27 C
28  s1 = 0.d0
29  s2 = 0.d0
30  DO 2 l=1,n
31  s1 = s1 + ( anew(l) - aold(l) )**2
32  s2 = s2 + anew(l)**2
33  2 CONTINUE
34  s1 = sqrt( s1 )
35  s2 = sqrt( s2 )
36 C
37  IF( s2 .GT. 1.0d-12 ) THEN
38  errvec = s1 / s2
39  ELSE
40  errvec = 0.d0
41  END IF
42 C
43  RETURN
44  END
45 C***************************************************************
46 C
47  SUBROUTINE diftim( AK, AKP1S, AKP1N, N, ERRLOC, ERRVEC,
48  * absmax, absmin, nout, nter )
49 C
50  include 'double.inc'
51 C
52  dimension ak(*), akp1s(*), akp1n(*)
53 C
54  abs(x) = dabs(x)
55  sqrt(x) = dsqrt(x)
56 C
57  errloc = 0.d0
58  absmax = abs( akp1n(1) - ak(1) )
59  absmin = abs( akp1n(1) - ak(1) )
60 C
61  DO 1 i=1,n
62  absa = abs( akp1n(i) - ak(i) )
63  IF( absa.LT.absmin ) absmin = absa
64  IF( absa.GT.absmax ) absmax = absa
65  absd = abs( akp1n(i) - akp1s(i) )
66  IF( absa.GT.1.0d-12 ) THEN
67  absr = absd / absa
68  IF( absr.GT.errloc ) errloc = absr
69  END IF
70  1 CONTINUE
71 C
72  s1 = 0.d0
73  s2 = 0.d0
74  DO 2 l=1,n
75  s1 = s1 + ( akp1n(l) - akp1s(l) )**2
76  s2 = s2 + ( akp1n(l) - ak(l) )**2
77  2 CONTINUE
78 C
79  s1 = sqrt( s1 )
80  s2 = sqrt( s2 )
81 C
82  IF( s2 .GT. 1.0d-12 ) THEN
83  errvec = s1 / s2
84  ELSE
85  errvec = 0.d0
86  END IF
87 C
88  RETURN
89  END
90 C***************************************************************
91 C
92  SUBROUTINE difgeo( RM, ZM, RAXPR, ZAXPR, RMAOLD, ZMAOLD,
93  * delaxa, delaxr, nout, nter )
94 C
95  include 'double.inc'
96 C
97  sqrt(x) = dsqrt(x)
98 C
99  delaxa = sqrt( (rmaold-rm)**2 + (zmaold-zm)**2 )
100  delaxt = sqrt( (raxpr -rm)**2 + (zaxpr -zm)**2 )
101  IF( delaxt.GT.1.0d-12 ) THEN
102  delaxr = delaxa / delaxt
103  ELSE
104  delaxr = 0.d0
105  END IF
106 C
107  RETURN
108  END
109 C***************************************************************
110 C***************************************************************
111 C NTYPE=1 - CONDUCTOR WITH "LINEAR" CROSS-SECTION
112 C NTYPE=2 - CONDUCTOR WITH "RECTANGULAR" CROSS-SECTION
113 C NTYPE=3 - CONDUCTOR WITH "ROUND" CROSS-SECTION
114 C RC - CILINDR. "R" COORDINATE OF CROSS-SECTION CENTRE
115 C VC - VERTICAL (OR RADIUS for NTYPE=3) SIZE OF CROSS-SECTION
116 C HC - HORIZONTAL SIZE OF CROSS-SECTION
117 C
118  REAL*8 FUNCTION selind( NTYPE, RC, VC, HC )
119 C
120  include 'double.inc'
121 C
122  alog(x) = dlog(x)
123  sqrt(x) = dsqrt(x)
124  atan(x) = datan(x)
125 C
126  nout = 17
127  nter = 6
128  pi2 = 2.d0 * 3.14159265399d0
129 C********************************************************************
130 C
131  IF( ntype .EQ. 1 ) THEN
132 
133  vcl=sqrt(hc**2+vc**2)
134 
135 C--- FROM A.KAVIN
136 C
137 C+++ SELIND = RC * (ALOG( 8D0*RC/VCL ) - 0.5D0) / PI2/1.0d0
138 C
139  selind=0.d0
140  do i=-1,1
141  do j=-1,i
142  if(i .eq. j) then
143  selind = selind+ (rc+hc*i/3.d0)
144  > * (alog( 8.d0*(rc+hc*i/3.d0)/(vcl/3.d0) ) - 0.5d0) / pi2
145 c > * (ALOG( 8D0*(RC+HC*i/3.)/(0.2236*(VCL/3.+0.06)) ) - 2D0) / PI2
146  else
147  selind=selind+
148  > greeni( rc+hc*i/3.d0,vc*i/3.d0,rc+hc*j/3.d0,vc*j/3.d0)*2d0
149  > /(pi2/2.d0)
150  endif
151  enddo
152  enddo
153 C
154  selind = selind/9.d0
155 C
156 C--- FROM R.HYRUTDINOV
157 C... SQVC = SQRT(VCL)
158 C... SELIND = RC * (ALOG( 16.D0*RC/SQVC ) - 0.5D0) / PI2
159  END IF
160 C********************************************************************
161 C
162  IF( ntype .EQ. 2 ) THEN
163 C--- FROM A.KAVIN
164  selind = rc*(alog(8.d0*rc/(0.2236d0*(vc+hc)))-2.d0) / pi2
165 C--- FROM R.HYRUTDINOV
166 C... SQVC = SQRT(VC+HC)
167 C... SELIND = RC*( ALOG(16.D0*RC/SQVC) - 0.5D0 *
168 C... * ( (VC/HC)*ATAN(HC/VC) +
169 C... * (HC/VC)*ATAN(VC/HC) ) ) / PI2
170  END IF
171 C********************************************************************
172 C
173  IF( ntype .EQ. 3 ) THEN
174 C--- FROM A.KAVIN
175  selind = rc*(alog(8.d0*rc/vc)-1.75d0) / pi2
176  END IF
177 C********************************************************************
178 C
179  IF((ntype.NE.1).AND.(ntype.NE.2).AND.(ntype.NE.3)) THEN
180  !WRITE(NTER,*) '"NTYPE" DEFINITION IS WRONG : NTYPE =',NTYPE
181  !WRITE(NOUT,*) '"NTYPE" DEFINITION IS WRONG : NTYPE =',NTYPE
182  !WRITE(NTER,*) '!!! PROGRAM WAS INTERRUPTED IN "SELIND" '
183  !WRITE(NOUT,*) '!!! PROGRAM WAS INTERRUPTED IN "SELIND" '
184 C
185  stop
186 C
187  END IF
188 C
189  RETURN
190  END
191 C***************************************************************
192 C NTYPE=1 - CONDUCTOR WITH "LINEAR" CROSS-SECTION
193 C NTYPE=2 - CONDUCTOR WITH "RECTANGULAR" CROSS-SECTION
194 C NTYPE=3 - CONDUCTOR WITH "ROUND" CROSS-SECTION
195 C RC,ZC - CILINDR. "R,Z" COORDINATES OF CROSS-SECTION CENTRE
196 C VC - VERTICAL (OR RADIUS for NTYPE=3) SIZE OF CROSS-SECTION
197 C HC - HORIZONTAL SIZE OF CROSS-SECTION
198 C
199 C INDEX "1" MEANS THE FIRST CONDUCTOR
200 C INDEX "2" MEANS THE SECOND CONDUCTOR
201 C
202  REAL*8 FUNCTION betind( NTYPE1, RC1, ZC1, VC1, HC1,
203  * ntype2, rc2, zc2, vc2, hc2 )
204 C
205  include 'double.inc'
206 C
207  pi = 3.14159265399d0
208 C
209 C*************************************************************
210  IF( ntype1 .EQ. 1 .and. ntype2 .EQ. 1) THEN
211  betind=0.d0
212  do i=-1,1
213  do j=-1,1
214  betind=betind+
215  > greeni( rc1+hc1*i/3.d0,zc1+vc1*i/3.d0,rc2+hc2*j/3.d0,zc2
216  > +vc2*j/3.d0)
217  enddo
218  enddo
219  betind = betind/pi/9.d0
220  ENDIF
221 C
222  IF( ntype1 .EQ. 1 .and. ntype2 .EQ. 2) THEN
223  betind=0.d0
224  do i=-1,1
225  betind=betind+
226  > greeni( rc1+hc1*i/3.d0,zc1+vc1*i/3.d0,rc2,zc2)
227  enddo
228  betind = betind/pi/3.d0
229  ENDIF
230 C
231  IF( ntype1 .EQ. 2 .and. ntype2 .EQ. 1) THEN
232  betind=0.d0
233  do j=-1,1
234  betind=betind+
235  > greeni( rc1,zc1,rc2+hc2*j/3.d0,zc2+vc2*j/3.d0)
236  enddo
237  betind = betind/pi/3.d0
238  ENDIF
239 C
240  IF( ntype1 .EQ. 2 .and. ntype2 .EQ. 2) THEN
241  betind = greeni( rc1, zc1, rc2, zc2 ) / pi
242  ENDIF
243 C
244  IF( ntype1 .EQ. 3 .OR. ntype2 .EQ. 3) THEN
245  betind = greeni( rc1, zc1, rc2, zc2 ) / pi
246  ENDIF
247 C
248  RETURN
249  END
250 C**********************************************************
251 C**********************************************************
252 C
253  SUBROUTINE gavpar( NOUT , NTER , KEYPRI ,
254  * kstep , tstep , timev ,
255  * ncequi , volkp1 ,
256  * k_contr , tau_p , kstep_c , tstep_c ,
257  * v_contr , v0_contr, v_prog , v_full ,
258  * res_comp, res_extr, pfc_ref )
259 C
260  include 'double.inc'
261 C
262  include 'prm.inc'
263  include 'comevl.inc'
264 C---------------------------------------------------------------
265 C
266  dimension volkp1(*)
267 C
268  dimension v_contr(n_volt_m), v_prog(n_volt_m),
269  * v0_contr(n_volt_m), v_full(n_volt_m)
270  dimension res_comp(n_volt_m), res_extr(n_volt_m)
271  dimension pfc_ref(n_volt_m), tau_p(n_volt_m)
272 C
273  dimension tmcur(100), ve1(100), ve8(100)
274 
275  INTEGER kp(100)
276 C
277 C----------------------------------------------------------------------
278 C**********************************************************************
279 C----------------------------------------------------------------------
280 C COMPUTING PFC EQUIV. GROUPS VOLTAGES in [ VOLT ] ON NEW TIME-LEVEL
281 C T(KSTEP) = TIMEV AND THEY TIME DERIVATIVES:
282 C
283  pi = 3.14159265359d0
284  aaa = 1000000.d0 !!! for transfer of currents into [A]
285  bbb = 1.d0 / ( 2.d0*pi )
286  kstepr = kstep - 1
287 C
288 C ----- [ VOLKP1(L) ] = [ VOLT ] * BBB - the PET code dimension
289 C ----- PFVOL2 (as they first appear) are defined in [ VOLT ]
290 C
291 C ------- from previous time-level -------
292 C
293  IF( k_contr .eq. 0 ) THEN
294 C
295  DO l=1,nequi
296  pfvol2(l) = 0.0d0
297  END DO
298 C
299 C +++ VREMYANKA +++ for equilibrium perturbation during VDE evolution
300 C in vertical direction for ITER device
301 C
302  n_pert = 8
303  if( n_pert.ne.0 ) then
304 C
305  k_star = 5
306  k_pert1= 5
307  k_pert2= 5
308  k_rest = 5
309 C
310  dvolt = 300.d0 !!! [Volt}
311 C
312 C
313  kp(1) = k_star
314  do i=2,n_pert
315  kp(i) = kp(i-1) + k_pert1 + k_pert2 + k_rest
316  end do
317 C
318  do i=1,n_pert
319  kk1 = kp(i)+k_pert1
320  kk2 = kp(i)+k_pert1+k_pert2
321  if((kp(i).lt.kstep).and.(kstep.le.kk1))then
322  pfvol2(6) = dvolt
323  pfvol2(11) = -dvolt
324  end if
325  if((kk1.lt.kstep).and.(kstep.le.kk2))then
326  pfvol2(6) = -490.d0
327  pfvol2(11) = 490.d0
328  end if
329  end do
330  end if
331 C
332 C DO 21 L=1,NEQUI
333 C 21 PFVOL2(L) = PFVOL1(L)
334 C
335 C +++ VREMYANKA +++ for initial equilibrium perturbation
336 C in vertical direction for TCV device
337 C
338 C IF(KSTEP.EQ.1) THEN
339 C PFVOL2(3) = 10000.0d0
340 C PFVOL2(10) = -10000.0d0
341 C PFVOL2(3) = 5000.0d0
342 C PFVOL2(10) = -5000.0d0
343 C ELSE
344 C PFVOL2(3) = 0.0d0
345 C PFVOL2(10) = 0.0d0
346 C END IF
347 C +++++++++++++++++
348 C
349  ELSE !!! for IF( k_contr .eq. 0 ) THEN
350 C
351  IF( (kstepr/kstep_c)*kstep_c .EQ. kstepr ) THEN
352 C
353 C+++ coef_p = 0.0d0
354 C+++ coef_p = 0.1d0
355 C+++ coef_p = 0.5d0
356  coef_p = 1.0d0
357 C
358 C+++ c2 = 0.0d0
359  c2 = 1.0d0
360 C----------------------------------------------------------------------
361 C======================================================================
362  c3 = 0.0d0
363 C+++ c3 = 1.0d0
364 C
365  IF( c3 .GT. 0.0001d0 ) THEN
366 C
367  tmcur(1) = 0.449d0
368  tmcur(2) = 0.450d0
369  tmcur(3) = 0.451d0
370  tmcur(4) = 0.452d0
371 C
372  ve1(1) = 0.d0
373  ve1(2) = 75.d0
374  ve1(3) = 75.d0
375  ve1(4) = 0.d0
376 C
377  ve8(1) = 0.d0
378  ve8(2) = -75.d0
379  ve8(3) = -75.d0
380  ve8(4) = 0.d0
381 C
382  IF( timev .LE. tmcur(1) ) THEN
383  v0_contr(3) = ve1(1)
384  v0_contr(10) = ve8(1)
385  END IF
386  IF( timev .GE. tmcur(4) ) THEN
387  v0_contr(3) = ve1(4)
388  v0_contr(10) = ve8(4)
389  END IF
390 C
391  IF( (timev .GT. tmcur(1)) .AND. (timev .LT. tmcur(4)) ) THEN
392  DO i=1,3
393  IF((timev.GE.tmcur(i)).AND.(timev.LT.tmcur(i+1))) THEN
394  v0_contr(3) = ( ve1(i) *(tmcur(i+1) - timev) +
395  * ve1(i+1)*(timev - tmcur(i) ) ) /
396  * (tmcur(i+1) - tmcur(i) )
397  v0_contr(10) = ( ve8(i) *(tmcur(i+1) - timev) +
398  * ve8(i+1)*(timev - tmcur(i) ) ) /
399  * (tmcur(i+1) - tmcur(i) )
400  END IF
401  END DO
402  END IF
403  END IF
404 C----------------------------------------------------------------------
405 C======================================================================
406 C
407  do i=1,nequi
408 C
409  c0 = tau_p(i)/tstep_c
410  c0 = c0*coef_p
411 C
412  c1 = 1.d0 / ( 1.d0 + c0 )
413 C
414  pfvol2(i) = c1*( c0*pfvol1(i) + c2*v_contr(i) + c3*v0_contr(i)
415  * + v_prog(i)
416  * + res_comp(i)*pfceqw(i)*aaa
417  * + res_extr(i)*(pfc_ref(i) - pfceqw(i)*aaa) )
418 C
419 C+++ PFVOL2(i) = v_contr(i)
420 C+++ PFVOL2(i) = v_full(i)
421 C+++ PFVOL2(i) = PFVOL1(i)
422 C
423  end do
424 c
425  END IF !!! for " IF( (KSTEPR/KSTEP_C)*KSTEP_C .EQ. KSTEPR ) "
426  END IF !!! for " if( k_contr .eq. 0 ) then "
427 C
428  !WRITE(NOUT,*) '-----------------------------------------'
429  !write(NOUT,*) 'From "GAVPAR" => PFVOL2(NEQUI) for time =',timev
430  !write(NOUT,*) ' in [Volt] for kstep =',kstep
431  !write(NOUT,*) ' for coef_p =',coef_p
432  !write(NOUT,101) (PFVOL2(k), k=1,NEQUI)
433  !WRITE(NTER,*) '--------------------------------------'
434  !write(NTER,*) 'From "GAVPAR" => PFVOL2(NEQUI) for time =',timev
435  !write(NTER,*) ' in [Volt] for kstep =',kstep
436  !write(NTER,*) ' for coef_p =',coef_p
437  !write(NTER,101) (PFVOL2(k), k=1,NEQUI)
438  !write(NTER,*) ' '
439 C
440  101 FORMAT(2x,5e15.7)
441 C
442 C-----------------------------------------------------------------------
443 C ----- TIME DERIVATIVES COMPUTING [in Volt/sec]
444 C
445  DO 22 l=1,nequi
446  22 dpfvdt(l) = ( pfvol2(l) - pfvol1(l) ) / tstep
447 C----------------------------------------------------------------
448 C----------------------------------------------------------------
449 C ----- PFVOL2 are transformed in the PET code dimension
450 C
451  DO 23 l=1,nequi
452  volkp1(l) = pfvol2(l) * bbb
453  23 CONTINUE
454 C
455 C----------------------------------------------------------------
456 C----------------------------------------------------------------
457 C
458  RETURN
459  END
460 C****************************************************************
461 C****************************************************************
462 C TRANSFORM OF "FULL" MATRIX "P" ( "NC*NC" SIZE ) TO
463 C "EQUIVALENT" MATRIX "P" ( "NCEQUI*NCEQUI" SIZE ).
464 C HERE NCEQUI = NC - NCPFC + NEQUI.
465 C**********************************************************
466 C
467  SUBROUTINE tramat( P, NJLIM, NC, NCPFC, NEQUI,
468  * necon, wecon )
469 C
470  include 'double.inc'
471 C
472  dimension p(njlim,njlim)
473  dimension t(njlim)
474  dimension wecon(*)
475  INTEGER necon(*)
476 C
477 C----------------------------------------------------------
478 C
479  ncequi = nc - ncpfc + nequi
480 C
481 C SUMMING OF COLUMNS !!!
482 C ----------------------
483  DO 1 l=1,nequi
484  DO 2 i=1,nc
485  t(i) = 0.d0
486  2 CONTINUE
487  DO 3 j=1,ncpfc
488  IF( necon(j).EQ.l ) THEN
489  DO 4 i=1,nc
490  t(i) = t(i) + p(i,j)*wecon(j)
491  4 CONTINUE
492  END IF
493  3 CONTINUE
494  DO 5 i=1,nc
495  p(i,l) = t(i)
496  5 CONTINUE
497  1 CONTINUE
498 C
499  DO 6 j=ncpfc+1,nc
500  DO 6 i=1,nc
501  p(i,nequi + j - ncpfc) = p(i,j)
502  6 CONTINUE
503 C
504 C SUMMING OF ROWS !!!
505 C -------------------
506  DO 11 l=1,nequi
507  DO 12 j=1,ncequi
508  t(j) = 0.d0
509  12 CONTINUE
510  DO 13 i=1,ncpfc
511  IF( necon(i).EQ.l ) THEN
512  DO 14 j=1,ncequi
513  t(j) = t(j) + p(i,j)*wecon(i)
514  14 CONTINUE
515  END IF
516  13 CONTINUE
517  DO 15 j=1,ncequi
518  p(l,j) = t(j)
519  15 CONTINUE
520  11 CONTINUE
521 C
522  DO 16 i=ncpfc+1,nc
523  DO 16 j=1,ncequi
524  p(nequi + i - ncpfc,j) = p(i,j)
525  16 CONTINUE
526 C
527  RETURN
528  END
529 C*************************************************************
530 C TRANSFORM OF "FULL" VECTOR "V" ( "NC" SIZE ) TO
531 C "EQUIVALENT" VECTOR "V" ( "NCEQUI" SIZE ).
532 C HERE NCEQUI = NC - NCPFC + NEQUI.
533 C*************************************************************
534 C
535  SUBROUTINE travec (VINP, VOUT, NC, NCPFC, NEQUI, NECON, WECON)
536 C
537  include 'double.inc'
538 C
539  dimension vinp(*), vout(*), wecon(*)
540  INTEGER necon(*)
541 C
542 C----------------------------------------------------------
543 C
544  DO 1 l=1,nequi
545  t = 0.d0
546  DO 2 i=1,ncpfc
547  IF( necon(i).EQ.l ) THEN
548  t = t + vinp(i)*wecon(i)
549  END IF
550  2 CONTINUE
551  vout(l) = t
552  1 CONTINUE
553  DO 3 i=ncpfc+1,nc
554  vout(nequi+i-ncpfc) = vinp(i)
555  3 CONTINUE
556 C
557  RETURN
558  END
559 C
560 C***********************************************************************
561 C TRANSFORM OF EDDY CURRENT VECTOR "PJKP1" ("NCEQUI" SIZE)
562 C TO VECTOR "PC" ("NC" SIZE) FOR EQUILIBRIUM and to vector "PFCEQW"
563 C HERE NCEQUI = NC - NCPFC + NEQUI.
564 C***********************************************************************
565 C
566  SUBROUTINE greta ( PJKP1, NCEQUI, PC )
567 C
568  include 'double.inc'
569 C
570  include 'prm.inc'
571  include 'comevl.inc'
572 C
573  dimension pjkp1(*), pc(*)
574 C----------------------------------------------------------
575 C
576  DO 1 i=1,npfc
577 
578  pfcw2(i) = pjkp1( nepfc(i) )
579  pfcur2(i) = pfcw2(i) * nturn(i)
580  pfcd2(i) = pfcur2(i) / ndiv(i)
581 
582  nn1 = nloc(i-1) + 1
583  nn2 = nloc(i)
584  DO 2 l=nn1,nn2
585  pc(l) = pfcd2(i)
586  2 CONTINUE
587  1 CONTINUE
588  ncpfc = nloc(npfc)
589  DO 3 i=nequi+1,ncequi
590  pc( ncpfc+i-nequi ) = pjkp1(i)
591  3 CONTINUE
592 C
593  DO 4 i=1,nequi
594  pfceqw(i) = pjkp1(i)
595  4 CONTINUE
596 C
597  RETURN
598  END
599 C*********************************************************************
600 C
601 C!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
602  SUBROUTINE printa( NOUT , NTER , KEYPRI, NGAV1 ,
603  * kstep , tstep , timev , knel ,
604  * betpol, zli3 , delbet, delzli,
605  * tokout, psiout, psibou, psidel,
606  * alf0 , alf1 , alf2 , bet0 , bet1 , bet2,
607  * rm , zm , rx0 , zx0 ,
608  * delrma, delzma, delrmb, delzmb,
609  * delrxp, delzxp, delrxb, delzxb,
610  * nctrl , alp , alpnew, numlim,
611  * fwcurr, bpcurr, vvcurr,
612  * pvolum, helout )
613 C
614  include 'double.inc'
615 C
616  include 'param.inc'
617 C
618  common /comus1/ rus1(nbndp2), zus1(nbndp2), nus1
619  common /comus2/ rus2(nbndp2), zus2(nbndp2), nus2
620  common /comlop/ rxb(nbndp2), zxb(nbndp2), nxb
621 C
622  common /equili/ bettot, rmx, zzrmx, rmn, zzrmn,
623  * zmx, rrzmx, zmn, rrzmn,
624  * r0cen, z0cen, radm, aspect,
625  * eupper, elower, delup, dellw, bfvakc
626  common /volpla/ vol_pl
627 C.......................................................................
628 C
629  pvolum = 2.d0*pi*vol_pl
630 C
631  IF( keypri.EQ.1 ) THEN
632  WRITE(nout,*) '.............................................'
633  WRITE(nout,*) ' AFTER "EQ" TIME =',timev
634  WRITE(nout,*) ' KSTEP =',kstep ,' KNEL =',knel
635  WRITE(nout,*) ' NGAV1 =',ngav1 ,' NCTRL =',nctrl
636  WRITE(nout,*) '.............................................'
637 C WRITE(NOUT,*) ' BETTOT =',BETTOT,' B*R0 =',Bfvakc
638  WRITE(nout,*) ' BETPOL =',betpol,' LI3 =',zli3
639  WRITE(nout,*) ' TOKOUT =',tokout,' PSIout =',psiout
640  WRITE(nout,*) ' PSIdel =',psidel,' PSIbou =',psibou
641  WRITE(nout,*) ' HELOUT =',helout
642  WRITE(nout,*) ' NUMLIM =',numlim
643  WRITE(nout,*) ' ALP =',alp ,' ALPNEW =',alpnew
644  WRITE(nout,*) ' ALF0 =',alf0 ,' BET0 =',bet0
645  WRITE(nout,*) ' ALF1 =',alf1 ,' BET1 =',bet1
646  WRITE(nout,*) ' ALF2 =',alf2 ,' BET2 =',bet2
647  WRITE(nout,*) '.............................................'
648  WRITE(nout,*) ' Rax =',rm ,' Zax =',zm
649  WRITE(nout,*) ' Rxp =',rx0 ,' Zxp =',zx0
650  WRITE(nout,*) ' Rmax =',rmx ,' ZRmax =',zzrmx
651  WRITE(nout,*) ' Rmin =',rmn ,' ZRmin =',zzrmn
652  WRITE(nout,*) ' Zmax =',zmx ,' RZmax =',rrzmx
653  WRITE(nout,*) ' Zmin =',zmn ,' RZmin =',rrzmn
654  WRITE(nout,*) ' Aspect =',aspect,' Rminor =',radm
655  WRITE(nout,*) ' Eupper =',eupper,' Elower =',elower
656  WRITE(nout,*) ' Tupper =',delup ,' Tlower =',dellw
657 C
658 C WRITE(NOUT,*) ' '
659 C WRITE(NOUT,*) 'Toroidal plasma current (MA) =',tokout
660 C WRITE(NOUT,*) 'Tor. first wall current (MA) =',fwcurr
661 C WRITE(NOUT,*) 'Tor. back plate current (MA) =',bpcurr
662 C WRITE(NOUT,*) 'Tor. vac. vessel current (MA) =',vvcurr
663 C WRITE(NOUT,*) 'Plasma volume (m**3) =',pvolum
664 C WRITE(NOUT,*) 'Current centroid coord. Z (m ) =',z0cen
665 C WRITE(NOUT,*) 'Helicity =',helout
666 C WRITE(NOUT,*) ' '
667 C WRITE(NOUT,*) '--------------------------------------------'
668 C WRITE(NOUT,*) 'PLASMA BOUNDARY => RXB(L), L=1,NXB : NXB=',NXB
669 C WRITE(NOUT,101) (RXB(L), L=1,NXB)
670 C WRITE(NOUT,*) 'PLASMA BOUNDARY => ZXB(L), L=1,NXB : NXB=',NXB
671 C WRITE(NOUT,101) (ZXB(L), L=1,NXB)
672 C
673 C CALL ARCLE( NXB, RXB, ZXB, ARC, ARCMAX )
674 C
675 C WRITE(NOUT,*) 'PLASMA BOUNDARY => ARC(L), L=1,NXB : NXB=',NXB
676 C WRITE(NOUT,*) ' ARCMAX = ',ARCMAX
677 C... WRITE(NOUT,101) (ARC(L), L=1,NXB)
678 C WRITE(NOUT,*) ' '
679 C WRITE(NOUT,*) '--------------------------------------------'
680 C WRITE(NOUT,*) '(R,Z)-COORDINATES OF THE SEPARATRIX BRANCHS '
681 C WRITE(NOUT,*) ' '
682 C WRITE(NOUT,*) ' RUS1(I), I=1,..,NUS1 = ', NUS1
683 C WRITE(NOUT,101) (RUS1(I), I=1,NUS1)
684 C WRITE(NOUT,*) ' ZUS1(I), I=1,..,NUS1 = ', NUS1
685 C WRITE(NOUT,101) (ZUS1(I), I=1,NUS1)
686 C WRITE(NOUT,*) ' RUS2(I), I=1,..,NUS2 = ', NUS2
687 C WRITE(NOUT,101) (RUS2(I), I=1,NUS2)
688 C WRITE(NOUT,*) ' ZUS2(I), I=1,..,NUS2 = ', NUS2
689 C WRITE(NOUT,101) (ZUS2(I), I=1,NUS2)
690 C WRITE(NOUT,*) ' '
691 C
692 C IF( KSTEP.EQ.0 ) THEN
693 C CALL PR_Q_TAB( NOUT )
694 C ELSE
695 C CALL PR_Q( NOUT )
696 C END IF
697 
698  IF( kstep .NE. 0 ) THEN
699 c WRITE(NOUT,*) 'TIME-STEP SHIFT OF MAG.AXES AND X-POINT'
700 c WRITE(NOUT,*) ' DELRMA =',DELRMA,' DELZMA =',DELZMA
701 c WRITE(NOUT,*) ' DELRXP =',DELRXP,' DELZXP =',DELZXP
702 c WRITE(NOUT,*) 'TIME-STEP CONVERGENCE OF MAG.AXES AND X-POINT'
703 c WRITE(NOUT,*) ' DELRMB =',DELRMB,' DELZMB =',DELZMB
704 c WRITE(NOUT,*) ' DELRXB =',DELRXB,' DELZXB =',DELZXB
705 c WRITE(NOUT,*) 'TIME-STEP CONVERGENCE OF BETAP AND LI3 '
706 c WRITE(NOUT,*) ' DELBET =',DELBET,' DELZLI =',DELZLI
707  END IF
708  END IF
709 C***********************************************************************
710 C
711  !WRITE(NTER,*) '.............................................'
712  !WRITE(NTER,*) ' AFTER "EQ" TIME =',TIMEV
713  !WRITE(NTER,*) ' KSTEP =',KSTEP ,' KNEL =',KNEL
714  !WRITE(NTER,*) ' NGAV1 =',NGAV1 ,' NCTRL =',NCTRL
715  !WRITE(NTER,*) '.............................................'
716  !WRITE(NTER,*) ' BETTOT =',BETTOT,' B*R0 =',Bfvakc
717  !WRITE(NTER,*) ' BETPOL =',BETPOL,' LI3 =',ZLI3
718  !WRITE(NTER,*) ' TOKOUT =',TOKOUT,' PSIout =',PSIOUT
719  !WRITE(NTER,*) ' PSIdel =',PSIDEL,' PSIbou =',PSIBOU
720  !WRITE(NTER,*) ' HELOUT =',HELOUT
721  !WRITE(NTER,*) ' NUMLIM =',NUMLIM
722  !WRITE(NTER,*) ' ALP =',ALP ,' ALPNEW =',ALPNEW
723  !WRITE(NTER,*) ' ALF0 =',ALF0 ,' BET0 =',BET0
724  !WRITE(NTER,*) ' Rax =',RM ,' Zax =',ZM
725  !WRITE(NTER,*) ' Rxp =',RX0 ,' Zxp =',ZX0
726 
727 C IF( KSTEP.EQ.0 ) THEN
728 C CALL PR_Q_TAB( NTER )
729 C ELSE
730 C CALL PR_Q( NTER )
731 C END IF
732 
733 C IF( KSTEP .NE. 0 ) THEN
734 C WRITE(NTER,*) 'TIME-STEP SHIFT OF MAG.AXES AND X-POINT'
735 C WRITE(NTER,*) ' DELRMA =',DELRMA,' DELZMA =',DELZMA
736 C WRITE(NTER,*) ' DELRXP =',DELRXP,' DELZXP =',DELZXP
737 C WRITE(NTER,*) 'TIME-STEP CONVERGENCE OF MAG.AXES AND X-POINT'
738 C WRITE(NTER,*) ' DELRMB =',DELRMB,' DELZMB =',DELZMB
739 C WRITE(NTER,*) ' DELRXB =',DELRXB,' DELZXB =',DELZXB
740 C END IF
741 C-----------------------------------------------------------------------
742 C
743  101 FORMAT(2x,5e14.7)
744 C
745  RETURN
746  END
747 C
748 C!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
749  SUBROUTINE printb(NOUT , NTER , KEYPRI, KSTEP , TSTEP , TIMEV,
750  * ngav1 , nctrl ,
751  * betplx, ftok , psiax ,
752  * alf0 , alf1 , alf2 , bet0 , bet1 , bet2 )
753 C
754  include 'double.inc'
755 C
756  common/comhel/ helinp, helout
757 C.....................................................................
758 C
759  IF( keypri.EQ.1 ) THEN
760  WRITE(nout,*) '.............................................'
761  WRITE(nout,*) ' KSTEP =',kstep
762  WRITE(nout,*) ' TIME =',timev ,' TSTEP =',tstep
763  WRITE(nout,*) '.............................................'
764 C WRITE(NOUT,*) ' NGAV1 =',NGAV1 ,' NCTRL =',NCTRL
765 C WRITE(NOUT,*) ' BETPLX =',BETPLX,' HELINP =',HELINP
766 C WRITE(NOUT,*) ' FTOK =',FTOK ,' PSIAX =',PSIAX
767 C WRITE(NOUT,*) ' ALF0 =',ALF0 ,' BET0 =',BET0
768 C WRITE(NOUT,*) ' ALF1 =',ALF1 ,' BET1 =',BET1
769 C WRITE(NOUT,*) ' ALF2 =',ALF2 ,' BET2 =',BET2
770 C WRITE(NOUT,*) '.............................................'
771  END IF
772 C
773  !WRITE(NTER,*) '.............................................'
774  !WRITE(NTER,*) ' KSTEP =',KSTEP
775  !!WRITE(NTER,*) ' TIME =',TIMEV ,' TSTEP =',TSTEP
776  !WRITE(NTER,*) '.............................................'
777  !WRITE(NTER,*) ' NGAV1 =',NGAV1 ,' NCTRL =',NCTRL
778  !WRITE(NTER,*) ' BETPLX =',BETPLX,' HELINP =',HELINP
779  !WRITE(NTER,*) ' FTOK =',FTOK ,' PSIAX =',PSIAX
780  !WRITE(NTER,*) ' ALF0 =',ALF0 ,' BET0 =',BET0
781  !WRITE(NTER,*) ' ALF1 =',ALF1 ,' BET1 =',BET1
782  !WRITE(NTER,*) ' ALF2 =',ALF2 ,' BET2 =',BET2
783  !WRITE(NTER,*) '.............................................'
784 C---------------------------------------------------------------
785 C
786  RETURN
787  END
788 C-----------------------------------------------------------------------
789 C***********************************************************************
790 C
791  SUBROUTINE eq_par( z0cen_e, alp_e, alpnew_e, qcen_e,
792  * nctrl_e, numlim_e, up_e,
793  * rm_e, zm_e, rx0_e, zx0_e )
794 C
795  include 'double.inc'
796 C
797  include 'param.inc'
798  include 'comblc.inc'
799 C
800  common /equili/ bettot, rmx, zzrmx, rmn, zzrmn,
801  * zmx, rrzmx, zmn, rrzmn,
802  * r0cen, z0cen, radm, aspect,
803  * eupper, elower, delup, dellw, bfvakc
804 C ---------------------------------------------------------------------
805 C
806  z0cen_e = z0cen
807  alp_e = alp
808  alpnew_e = alpnew
809  qcen_e = qcen
810 
811  nctrl_e = nctrl
812  numlim_e = numlim
813  up_e = up
814 
815  rm_e = rm
816  zm_e = zm
817  rx0_e = rx0
818  zx0_e = zx0
819 C
820  RETURN
821  END
822 C***********************************************************************
823 C***********************************************************************
824 C--- INPUT PARAMETERS OF PFC SYSTEM AND PASSIV CONDUCTORS
825 C
826  SUBROUTINE conduc( NC, NCEQUI, NCPFC, NFW, NBP, NVV,
827  * rc,zc, pc, vc,hc, ntype,
828  * rc1,zc1, rc2,zc2, rc3,zc3, rc4,zc4,
829  * res, volk, volkp1,
830  * necon, wecon,
831  * nout, nter, ninfw, ngra1 )
832 C
833  include 'double.inc'
834 C
835  include 'prm.inc'
836  include 'comevl.inc'
837 C
838 C-----------------------------------------------------------------------
839 C
840  dimension rc(*), zc(*), pc(*), vc(nclim), hc(nclim)
841 C
842  dimension rc1(*), zc1(*), rc2(*), zc2(*),
843  * rc3(*), zc3(*), rc4(*), zc4(*)
844 C
845  INTEGER necon(*), ntype(*)
846  dimension wecon(*)
847 C
848  dimension res(*), volk(*), volkp1(*)
849 C.....................................................................
850 C
851  INTEGER kdfw(nplim), kdbp(nplim), kdvv(nplim)
852 C
853  dimension rp1fw(nplim), zp1fw(nplim), rp2fw(nplim), zp2fw(nplim),
854  * rfwseg(nplim), cfwseg(nplim)
855  dimension rp1bp(nplim), zp1bp(nplim), rp2bp(nplim), zp2bp(nplim),
856  * rbpseg(nplim), cbpseg(nplim)
857  dimension rp1vv(nplim), zp1vv(nplim), rp2vv(nplim), zp2vv(nplim),
858  * rvvseg(nplim), cvvseg(nplim)
859 C
860  dimension rfw(nplim), zfw(nplim), dfw(nplim), hfw(nplim),
861  * resfw(nplim), curfw(nplim), ntyfw(nplim)
862  dimension rfw1(nplim), zfw1(nplim), rfw2(nplim), zfw2(nplim)
863 C
864  dimension rbp(nplim), zbp(nplim), dbp(nplim), hbp(nplim),
865  * resbp(nplim), curbp(nplim), ntybp(nplim)
866  dimension rbp1(nplim), zbp1(nplim), rbp2(nplim), zbp2(nplim)
867 C
868  dimension rvv(nplim), zvv(nplim), dvv(nplim), hvv(nplim),
869  * resvv(nplim), curvv(nplim), ntyvv(nplim)
870  dimension rvv1(nplim), zvv1(nplim), rvv2(nplim), zvv2(nplim)
871 C
872 C***********************************************************************
873  pi = 3.14159265359d0
874  bbb = 1.d0 / (2.d0*pi)
875 C***********************************************************************
876 C
877 C--- INPUT OF PFC SYSTEM PARAMETERS
878 C
879  CALL trecur( ncpfc, rc, zc, pc, ntype, necon, wecon,
880  * hc, vc, nout, nter )
881 C
882 
883 
884 
885 ! PAUSE 'PAUSE AFTER "CALL TRECUR" '
886 C
887  DO 1800 l=1,nequi
888  res(l) = pfres(l) * bbb
889  1800 volk(l) = pfvol1(l) * bbb
890 C
891  nc = ncpfc
892  ncequi = nequi
893 C !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
894 C***********************************************************************
895 C--- INPUT OF PASSIVE CONDUCTORS PARAMETERS
896 C
897  CALL trefw( nout, nter, ninfw, nsegfw,
898  * kdfw, rp1fw, zp1fw, rp2fw, zp2fw, rfwseg, cfwseg,
899  * nfw, ntyfw,
900  * rfw, zfw, dfw, hfw, resfw, curfw,
901  * rfw1, zfw1, rfw2, zfw2 )
902 C
903 ! PAUSE 'PAUSE AFTER "CALL TREFW" '
904 C
905 c CALL FW_tcv( NOUT, NTER, NINFW, NSEGFW,
906 c * KDFW, RP1FW, ZP1FW, RP2FW, ZP2FW, RFWSEG, CFWSEG,
907 c * NFW, NTYFW,
908 c * RFW, ZFW, DFW, HFW, RESFW, CURFW,
909 c * RFW1, ZFW1, RFW2, ZFW2 )
910 C
911 ! PAUSE 'PAUSE AFTER "CALL FW_tcv" '
912 C
913  IF( nfw.NE.0 ) THEN
914  DO 136 i=1,nfw
915  rc(nc+i) = rfw(i)
916  zc(nc+i) = zfw(i)
917  pc(nc+i) = curfw(i)
918  ntype(nc+i) = ntyfw(i)
919  vc(nc+i) = dfw(i)
920  hc(nc+i) = hfw(i)
921  rc1(nc+i) = rfw1(i)
922  zc1(nc+i) = zfw1(i)
923  rc2(nc+i) = rfw2(i)
924  zc2(nc+i) = zfw2(i)
925 C
926  res(ncequi+i) = resfw(i) * bbb !!!!!!!!!! * 1.d+10
927  volk(ncequi+i) = 0.00d0 * bbb
928 C+++ VOLK(NCEQUI+I) = RES(NCEQUI+I)*CURFW(I)
929  136 CONTINUE
930 C
931  nc = nc + nfw
932  ncequi = ncequi + nfw
933  END IF
934 C---------------------------------------------------------------
935 C
936  CALL trebp( nout, nter, ninfw, nsegbp,
937  * kdbp, rp1bp, zp1bp, rp2bp, zp2bp, rbpseg, cbpseg,
938  * nbp, ntybp,
939  * rbp, zbp, dbp, hbp, resbp, curbp,
940  * rbp1, zbp1, rbp2, zbp2 )
941 C
942 ! PAUSE 'PAUSE AFTER "CALL TREBP" '
943 C
944  IF( nbp.NE.0 ) THEN
945  DO 137 i=1,nbp
946  rc(nc+i) = rbp(i)
947  zc(nc+i) = zbp(i)
948  pc(nc+i) = curbp(i)
949  ntype(nc+i) = ntybp(i)
950  vc(nc+i) = dbp(i)
951  hc(nc+i) = hbp(i)
952  rc1(nc+i) = rbp1(i)
953  zc1(nc+i) = zbp1(i)
954  rc2(nc+i) = rbp2(i)
955  zc2(nc+i) = zbp2(i)
956 C
957  res(ncequi+i) = resbp(i) * bbb
958  volk(ncequi+i) = 0.00d0 * bbb
959  137 CONTINUE
960 C
961  nc = nc + nbp
962  ncequi = ncequi + nbp
963  END IF
964 C---------------------------------------------------------------
965 C
966  CALL trevv( nout, nter, ninfw, nsegvv,
967  * kdvv, rp1vv, zp1vv, rp2vv, zp2vv, rvvseg, cvvseg,
968  * nvv, ntyvv,
969  * rvv, zvv, dvv, hvv, resvv, curvv,
970  * rvv1, zvv1, rvv2, zvv2 )
971 C
972 ! PAUSE 'PAUSE AFTER "CALL TREVV" '
973 C
974  IF( nvv.NE.0 ) THEN
975  DO 138 i=1,nvv
976  rc(nc+i) = rvv(i)
977  zc(nc+i) = zvv(i)
978  pc(nc+i) = curvv(i)
979  ntype(nc+i) = ntyvv(i)
980  vc(nc+i) = dvv(i)
981  hc(nc+i) = hvv(i)
982  rc1(nc+i) = rvv1(i)
983  zc1(nc+i) = zvv1(i)
984  rc2(nc+i) = rvv2(i)
985  zc2(nc+i) = zvv2(i)
986 C
987  res(ncequi+i) = resvv(i) * bbb
988  volk(ncequi+i) = 0.00d0 * bbb
989  138 CONTINUE
990 C
991  nc = nc + nvv
992  ncequi = ncequi + nvv
993  END IF
994 C----------------------------------------------------------------
995  !WRITE(NOUT,*) ' '
996  !WRITE(NOUT,*) '****************************************'
997  !WRITE(NOUT,*) 'NUMBER OF EXTERNAL TURNS FOR EQUILIBRIUM'
998  !WRITE(NOUT,*) ' NC =', NC
999  !WRITE(NOUT,*) ' NCPFC =', NCPFC
1000  !WRITE(NOUT,*) ' NFW =', NFW
1001  !WRITE(NOUT,*) ' NBP =', NBP
1002  !WRITE(NOUT,*) ' NVV =', NVV
1003  !WRITE(NOUT,*) 'NUMBER OF EXTERNAL TURNS FOR EDDY CURRENTS'
1004  !WRITE(NOUT,*) ' NCEQUI =', NCEQUI
1005  !WRITE(NOUT,*) ' NEQUI =', NEQUI
1006  !WRITE(NOUT,*) ' NPFC =', NPFC
1007  !WRITE(NOUT,*) '----------------------------------------'
1008  !WRITE(NOUT,*) ' '
1009  write(fname,'(a,a)') path(1:kname),'pascon.wr'
1010  open(1,file=fname,form='formatted')
1011  !open(1,file='pascon.wr')
1012  write(1,*) nc, ncpfc, nfw, nbp, nvv
1013  write(1,*) (rc(i), i=1,nc), (zc(i), i=1,nc)
1014  close(1)
1015 C.......................................................................
1016 C
1017  DO i=1,ncequi
1018  volkp1(i) = volk(i)
1019  END DO
1020 C
1021  RETURN
1022  END
1023 C***********************************************************************
1024 C***********************************************************************
1025 
1026 
1027 
1028 
1029 
1030 
1031 
1032 
1033 
1034 
1035 
betind
REAL *8 function betind(NTYPE1, RC1, ZC1, VC1, HC1, NTYPE2, RC2, ZC2, VC2, HC2)
Definition: Ev1.f:202
trevv
subroutine trevv(NOUT, NTER, NINFW, NP,
Definition: Curap.f:428
trefw
subroutine trefw(NOUT, NTER, NINFW, NP,
Definition: Curap.f:7
tramat
subroutine tramat(P, NJLIM, NC, NCPFC, NEQUI, NECON, WECON)
Definition: Ev1.f:467
greeni
REAL *8 function greeni(R, Z, RP, ZP)
Definition: scu.f:484
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
eq_par
subroutine eq_par(z0cen_e, alp_e, alpnew_e, qcen_e, nctrl_e, numlim_e, up_e, rm_e, zm_e, rx0_e, zx0_e)
Definition: Ev1.f:791
trebp
subroutine trebp(NOUT, NTER, NINFW, NP,
Definition: Curap.f:297
selind
REAL *8 function selind(NTYPE, RC, VC, HC)
Definition: Ev1.f:118
travec
subroutine travec(VINP, VOUT, NC, NCPFC, NEQUI, NECON, WECON)
Definition: Ev1.f:535
differ
subroutine differ(AOLD, ANEW, N, ERRLOC, ERRVEC, ABSMAX, ABSMIN, NOUT, NTER)
Definition: Ev1.f:3
printb
subroutine printb(NOUT, NTER, KEYPRI, KSTEP, TSTEP, TIMEV, NGAV1, NCTRL, BETPLX, FTOK, PSIAX, ALF0, ALF1, ALF2, BET0, BET1, BET2)
Definition: Ev1.f:749
diftim
subroutine diftim(AK, AKP1S, AKP1N, N, ERRLOC, ERRVEC, ABSMAX, ABSMIN, NOUT, NTER)
Definition: Ev1.f:47
difgeo
subroutine difgeo(RM, ZM, RAXPR, ZAXPR, RMAOLD, ZMAOLD, DELAXA, DELAXR, NOUT, NTER)
Definition: Ev1.f:92
phys_functions::p
real(r8) function p(a, x, xr, xs, yr, ys, psi, psir, F_dia)
Definition: phys_functions.f90:383
gavpar
subroutine gavpar(NOUT, NTER, KEYPRI, KSTEP, TSTEP, TIMEV, NCEQUI, VOLKP1, k_contr, tau_p, KSTEP_C, TSTEP_C, v_contr, v0_contr, v_prog, v_full, res_comp, res_extr, pfc_ref)
Definition: Ev1.f:253
trecur
subroutine trecur(NCPFC, RI, ZI, PC, NTYPE, NECON, WECON, HORS, VERS, NPRI, NTER)
Definition: Trecur_2.f:56
printa
subroutine printa(NOUT, NTER, KEYPRI, NGAV1, KSTEP, TSTEP, TIMEV, KNEL, BETPOL, ZLI3, DELBET, DELZLI, TOKOUT, PSIOUT, PSIBOU, PSIDEL, ALF0, ALF1, ALF2, BET0, BET1, BET2, RM, ZM, RX0, ZX0, DELRMA, DELZMA, DELRMB, DELZMB, DELRXP, DELZXP, DELRXB, DELZXB, NCTRL, ALP, ALPNEW, NUMLIM, fwcurr, bpcurr, vvcurr, pvolum, helout)
Definition: Ev1.f:602
greta
subroutine greta(PJKP1, NCEQUI, PC)
Definition: Ev1.f:566