Trecur_2.f

Go to the documentation of this file.

C***********************************************************************
C    SUBROUTINE  FOR  READING  AND  TREATMENT
C    PFC  PARAMETERS  ( THEIR POSITIONS, CURRENTS, RESISTANCE,
C                       NUMBER OF TURNS, NUMBER OF DIVIDING,
C                       EQUIVALENT SIGNS )
C***********************************************************************
C  OUTPUT DATE:
C  ----------
C   NPFC      - NUMBER OF PF-COILS
C
C   PFCUR1(L) - VALUES OF TOTAL CURRENT OF PFC CROSS-SECTION (in MA)
C               L = 1,2,...,NPFC
C   NEPFC(L)  - EQUIVALENT "SIGNS"  OF PF-COILS
C               L = 1,2,...,NPFC
C   WEPFC(L)  - EQUIVALENT "WEIGHTS" OF PF-COILS
C               L = 1,2,...,NPFC
C   NTURN(L)  - NUMBER OF REAL TURNS  OF PF-COILS
C               L = 1,2,...,NPFC
C   NDIV(L)   - NUMBER OF DIVIDING TURNS OF PF-COILS
C               L = 1,2,...,NPFC
C   NLOC(L)   - LOCATION ARRAY OF DIVIDING TURNS OF PF-COILS
C
C               !!! L = 0,1,2,...,NPFC !!! :
C               NLOC(0) = 0, NLOC(1) = NDIV(1),
C               NLOC(2) = NDIV(1) + NDIV(2),...,
C               NLOC(NPFC) = NDIV(1) + NDIV(2) +...+ NDIV(NPFC) = NCPFC
C  ---------------------------------------------------------------------
C   NEQUI     - NUMBER OF EQUIVALENT PF-COIL GROUPS ( NEQUI .LE. NPFC )
C
C   PFRES(L)  - RESISTANCE OF EQUIVALENT PF-COIL GROUPS; in [micro*Ohm]
C               L = 1,2,...,NEQUI
C   PFVOL1(L) - VOLTAGE    OF EQUIVALENT PF-COIL GROUPS; in [V]
C               L = 1,2,...,NEQUI
C   PFCEQW(L) - CURRENT    OF EQUIVALENT PF-COIL GROUPS; in [MA]
C               L = 1,2,...,NEQUI
C  ---------------------------------------------------------------------
C   NCPFC    - NUMBER OF PFC-CURRENTS (AFTER DIVIDING)
C
C   PC(L)    - VALUES (IN MA) OF PFC-CURRENTS (AFTER DIVIDING)
C              L=1,...,NCPFC.
C   RI(L),ZI(L) - CILINDER COORDINATES (IN M) OF PFC-CURRENTS
C                 (AFTER DIVIDING)  L = 1,2,...,NCPFC
C   NTYPE(L) - NUMBER OF TYPE OF PFC-CURRENT CROSS-SECTIONS
C              (AFTER DIVIDING)  L = 1,2,...,NCPFC
C   VERS(L)  - VERTICAL   SIZE OF PFC-CURRENT CROSS-SECTIONS
C              (AFTER DIVIDING)  L = 1,2,...,NCPFC
C   HORS(L)  - HORIZONTAL SIZE OF PFC-CURRENT CROSS-SECTIONS
C              (AFTER DIVIDING)  L = 1,2,...,NCPFC
C   NECON(L) - EQUIVALENT "SIGNS"  OF PF-CURRENTS
C              (AFTER DIVIDING)  L = 1,2,...,NCPFC
C   WECON(L) - EQUIVALENT "WEIGHTS" OF PF-CURRENTS
C              (AFTER DIVIDING)  L = 1,2,...,NCPFC
C
C***********************************************************************
C
      SUBROUTINE trecur( NCPFC, RI, ZI, PC, NTYPE, NECON, WECON,
     *                   hors, vers, npri, nter )
C
       include 'double.inc'
C
         include 'prm.inc'
         include 'comevl.inc'
C
      dimension  ri(*), zi(*), pc(*), hors(*), vers(*), wecon(*)
      INTEGER    ntype(*), necon(*)
C
C WORK ARRAYS
      dimension  rs(700),  zs(700), delz(300), delr(300)
      INTEGER    ndw(300), ndh(300)
C
C***********************************************************************
C
      ninp  = 1
C
      !WRITE(NPRI,*) '                                      '
      !WRITE(NPRI,*) '**************************************'
      !WRITE(NPRI,*) '*** ENTRANCE OF SUBROUT. TRECUR ***'
C-------------------------------------
        write(fname,'(a,a)') path(1:kname),'coilres.dat'
        open(ninp,file=fname,form='formatted')
      !open(ninp, file='coilres.dat')
C
         READ(ninp,*)  nequi
C
         !WRITE(NPRI,*) '**************************************'
         !WRITE(NPRI,*) '  NUMBER OF EQUIV. COIL GROUPS NEQUI =', NEQUI
         !WRITE(NPRI,*) '**************************************'
C
         DO 288 i=1,nequi
            READ(ninp,*)       l
            READ(ninp,*) pfres(l)
C+++                     PFVOL1(L) = 0.d0   now it's located below
  288    CONTINUE
C
      close(ninp)
C-------------------------------------
        write(fname,'(a,a)') path(1:kname),'coil.dat'
        open(1,file=fname,form='formatted')
      !open(1, file='coil.dat')
      !open(ninp, file='coil.dat')
C
        ! READ(NINP,*)  NPFC, KEYCUR
         READ(1,*)  npfc, keycur


c       print *,' npfc ==',npfc
c       read (*,*)

C
         !WRITE(NPRI,*) '**************************************'
         !WRITE(NPRI,*) '  NUMBER OF PF-COILS            NPFC =', NPFC
         !WRITE(NPRI,*) '  KEY OF CURRENT DEFINITION   KEYCUR =', KEYCUR
         !WRITE(NPRI,*) '**************************************'
C
   11  FORMAT(/,2x,i3,2x,5e14.7)
   16  FORMAT(7x,i3,11x,2e14.7,e12.4,2x,i7)
   10  FORMAT(/,3x,'NUM.',2x,'RC (M)',8x,'ZC (M)',8x,'WC (M)',
     *          8x,'HC (M)', 8x,'CURRENT (MA)')
   15  FORMAT(  9x,'NDI ',10x,'AWC',11x,'AHC',11x,'NTURN  ',
     *          7x,' PF-COIL SIGN ')
C
      !WRITE(NPRI,*) '**************************************'
      !WRITE(NPRI,*) '*** PFC INPUT INFORMATION ***'
      !WRITE(NPRI,10)
      !WRITE(NPRI,15)
C
C*****************************************************
C
       ncpfc   = 0
       nloc(0) = 0
C
       DO 2 i=1,npfc
C
       !READ(NINP,*) NDI
       READ(1,*) ndi
       !READ(NINP,*) RC,ZC, WC,HC, AWC,AHC, PFCUR1(I), NTURN(I), NEPFC(I)
       READ(1,*) rc,zc, wc,hc, awc,ahc, pfcur1(i), nturn(i), nepfc(i)
                      ntipe = 2
C------------------------------------------------------
C EXPERIMENT FOR TCV PF FAST COILS (numbers 24,...,29)
C+++   IF( I.GE.24 )  NTIPE = 3
C------------------------------------------------------
C
       IF( keycur .EQ. 1 )  pfcur1(i) = pfcur1(i) * nturn(i)
C
          !WRITE(NPRI,11) I, RC, ZC, WC, HC, PFCUR1(I)
          !WRITE(NPRI,16) NDI, AWC, AHC, NTURN(I), NEPFC(I)
C
          CALL divpar( rc, zc, wc, hc, awc, ahc, pfcur1(i), ndi,
     *                 ndivre, ndivw, ndivh, rs, zs, ps, verc, horc )
C
          ndiv(i)   = ndivre
          wepfc(i)  = nturn(i)  / ndiv(i)
C
          pfcur2(i) = pfcur1(i) 
          pfcw1(i)  = pfcur1(i) / nturn(i)
          pfcd1(i)  = pfcur1(i) / ndiv(i)
C
          DO 3 j=1,ndivre
                   l  = ncpfc + j
                ri(l) = rs(j)
                zi(l) = zs(j)
                pc(l) = pfcd1(i)
              hors(l) = horc
              vers(l) = verc
             ntype(l) = ntipe
             necon(l) = nepfc(i)
             wecon(l) = wepfc(i)
    3     CONTINUE
C
          ncpfc     = ncpfc + ndivre
          nloc(i)   = ncpfc
C
          ndw(i)    = ndivw
          ndh(i)    = ndivh
          delz(i)   = verc
          delr(i)   = horc
C
    2  CONTINUE
    
!      open(1,file='pfc_nturn.wr',form='formatted')
!       do i=1,NPFC
!        write(1,'(e13.5)' ) PFCUR2(I) 
!       enddo
!       pause 'pfc_nturn.wr'
    
C
       !close(ninp)
       close(1)
C
       DO 4 i=1,nequi

          DO 5 j=1,npfc
C
             IF( nepfc(j) .EQ. i )  THEN
                 pfceqw(i) = pfcw1(j)
                 go to 5
              END IF
C
    5     CONTINUE
C
C            [Volt] = [micro*Ohm]*[mega*Amper]
C
C+++      PFVOL1(I) = 0.d0
          pfvol1(i) = pfres(i)*pfceqw(i)

    4  CONTINUE
C
C*****************************************************
C
        !WRITE(NPRI,*) '**************************************'
        !WRITE(NPRI,*) 'EQ.SIGN NUM. =>   PFRES(L),  PFVOL1(L),  PFCEQW(L)'
 4444 FORMAT(2x,i8,4x,e13.6,5x,e13.6,5x,e13.6)
C
          !DO 1937 L=1,NEQUI
        !WRITE(NPRI,4444) L, PFRES(L), PFVOL1(L), PFCEQW(L)
 !1937     CONTINUE
C---------------------------------------------------------------------
C
   42  FORMAT(/,2x,'PFC NUM.',4x,'PFC SIGN',6x,'PFC WEIGHT  ',
     *          5x,'TURN CURRENT' )
   44  FORMAT(2x,i8,4x,i8,5x,e13.6,5x,e13.6)
C
      !WRITE(NPRI,*) '**************************************'
      !WRITE(NPRI,*) '*** PFC TURN CURRENT INFORMATION ***'
      !WRITE(NPRI,42)
C
      !DO 41 I=1,NPFC
         !WRITE(NPRI,44) I, NEPFC(I), WEPFC(I), PFCW1(I)
   !41 CONTINUE
C*****************************************************
C
   12  FORMAT(/,2x,'NUM.',2x,'NDIVRE',2x,'NDIVW',2x,'NDIVH',2x,
     *          'CELL CURRENT',4x,'CELL Z-SIZE',4x,'CELL R-SIZE')
   14  FORMAT(2x,i3,2x,i6,2x,i5,2x,i5,2x,e13.5,2x,e13.5,2x,e13.5)
C
      !WRITE(NPRI,*) '**********************************************'
      !WRITE(NPRI,*) '*** DIVIDING PROCEDURE RESULTS INFORMATION ***'
      !WRITE(NPRI,12)
      !WRITE(NTER,*) '**********************************************'
      !WRITE(NTER,*) '*** DIVIDING PROCEDURE RESULTS INFORMATION ***'
      !WRITE(NTER,12)
C
!      DO 444 I=1,NPFC
!         WRITE(NPRI,14) I, NDIV(I), NDW(I), NDH(I), PFCD1(I),
!     *                     DELZ(I), DELR(I)
!         WRITE(NTER,14) I, NDIV(I), NDW(I), NDH(I), PFCD1(I),
!     *                     DELZ(I), DELR(I)
!  444 CONTINUE
C
      !WRITE(NTER,*) '**************************************'
      !WRITE(NTER,*) '*** NUMBER OF MAT. PFC-CURR. NCPFC =', NCPFC
      !WRITE(NTER,*) '                                      '
      !WRITE(NPRI,*) '**************************************'
      !WRITE(NPRI,*) '*** NUMBER OF MAT. PFC-CURR. NCPFC =', NCPFC
      !WRITE(NPRI,*) '                                      '
C
  111  FORMAT( 2x, 10i5 )
  222  FORMAT( 2x, 7e11.4 )
       !WRITE(NPRI,*) '***** NECON(I), I=1,NCPFC =', NCPFC,'*****'
C+++   WRITE(NPRI,111) ( NECON(I), I=1,NCPFC )
       !WRITE(NPRI,*) '***** WECON(I), I=1,NCPFC =', NCPFC,'*****'
C+++   WRITE(NPRI,222) ( WECON(I), I=1,NCPFC )
C*****************************************************
C
      !WRITE(NPRI,*) '**************************************'
      !WRITE(NPRI,*) '*** EXIT FROM SUBROUT. TRECUR ***'
      !WRITE(NPRI,*) '**************************************'
      !WRITE(NPRI,*) '                                      '
C
      RETURN
      END
C**************************************************************
C        SUBROUTINE FOR DIVIDING OF PARALLELOGRAM
C                ( FOR PFC CROSS-SECTION )
C**************************************************************
C  INPUT DATE:
C  ----------
C   RC,ZC - CILINDER COORDINATES OF CENTER OF PARALLELOGRAM
C   WC    - PROJECTION OF THE FIRST SIDE OF PARALLELOGRAM
C           ON AXIS "R" (IN METER)
C   HC    - PROJECTION OF THE SECOND SIDE OF PARALLELOGRAM
C           ON AXIS "Z" (IN METER)
C   AWC   - ANGLE BETWEEN THE FIRST SIDE OF PARAL. AND
C           AXIS "R" (IN DEGREES, IT MUST NOT BE EQUAL 90 ,
C                                 IT MUST BE :  -90 < AWC < 90 )
C   AHC   - ANGLE BETWEEN THE SECOND SIDE OF PARAL. AND
C           AXIS "R" (IN DEGREES, IT MUST NOT BE EQUAL 0 ,
C                                 IT MUST BE :  0 < AHC < 180 )
C   CURC  - CURRENT OF PARALLELOGRAM (IN MA)
C   NDIV  - APPROXIMATE NUMBER OF CELLS OF DIVIDING:
C           NDIV=0 - A SPECIAL CASE: AUTOMATICALLY NDIVRE=1,
C                    RS(1)=RC, ZS(1)=ZC, PS=CURC
C           IF NDIV > 0 THEN WE HAVE THE MOST TOTAL ALGORITHM OF
C                            DIVIDING
C           IF NDIV < 0 THEN NDIVW AND NDIVH ARE CUT OFF BY ABS(NDIV)
C
C  OUTPUT DATE:
C  ----------
C   NDIVRE      - REAL NUMBER OF CELLS OF DIVIDING ( = NDIVW*NDIVH )
C   NDIVW       - NUMBER OF DIVIDING OF THE FIRST  SIDE OF PARAL.
C   NDIVH       - NUMBER OF DIVIDING OF THE SECOND SIDE OF PARAL.
C   RS(L),ZS(L) - CILINDER COORDINATES OF CENTERS OF CELLS OF DIVIDING
C                 L = 1,2,...,NDIVRE ! (IN METER)
C   PS          - CURRENT OF EVERY CELL OF DIVIDING  (IN MA)
C   VERS - VERTICAL (OR LINEAR, OR RADIUS) SIZE OF CELL CROSS-S.
C   HORS - HORIZONTAL SIZE OF CELL CROSS-SECTION
C
C**************************************************************
C
        SUBROUTINE divpar( RC, ZC, WC, HC, AWC, AHC, CURC, NDIV,
     *                     ndivre, ndivw, ndivh, rs, zs, ps,
     *                     vers, hors )
C
C
       include 'double.inc'
C
        dimension  rs(1), zs(1)
C
C**************************************************************
                sin(x) = dsin(x)
                cos(x) = dcos(x)
               atan(x) = datan(x)
               sqrt(x) = dsqrt(x)
C**************************************************************
C
       IF(ndiv.EQ.0) THEN
          ndivw  = 1
          ndivh  = 1
          ndivre = 1
          rs(1)  = rc
          zs(1)  = zc
          ps     = curc
          vers   = hc
          hors   = wc
          RETURN
       END IF
C***************************************
C
       IF(ahc.LT.0) ahc = ahc + 180.
C
       IF(ndiv.GE.0) THEN
          ndiva =  ndiv
       ELSE
          ndiva = -ndiv
       END IF
C***************************************
C   PARAMETERS OF PARALLELOGRAM
C
       xx    = 1.
       pi    = 4.*atan(xx)
C
       awcr  = awc * pi /180.
       ahcr  = ahc * pi /180.
C
       r0    = rc - 0.5*( wc + hc * cos(ahcr)/sin(ahcr) )
       z0    = zc - 0.5*( hc + wc * sin(awcr)/cos(awcr) )
C
       wsize = wc / cos(awcr)
       hsize = hc / sin(ahcr)
C
       wr    = wc
       wz    = wc * sin(awcr) / cos(awcr)
       hr    = hc * cos(ahcr) / sin(ahcr)
       hz    = hc
C***************************************
C   CALCULATION  NDIVW, NDIVH, NDIVRE, PS
C
       sw    = sqrt( ndiva*wsize/hsize )
       sh    = sqrt( ndiva*hsize/wsize )
       sw    = sw + 0.5
       sh    = sh + 0.5
C
       ndivw = idint(sw)
       ndivh = idint(sh)
C
       IF(ndivw.EQ.0)  ndivw = 1
       IF(ndivh.EQ.0)  ndivh = 1
C
       IF((ndiv.LT.0).AND.(ndivw.GT.ndiva)) ndivw = ndiva
       IF((ndiv.LT.0).AND.(ndivh.GT.ndiva)) ndivh = ndiva
C
       ndivre = ndivw * ndivh
       ps     = curc / ndivre
C***************************************
C   CALCULATION  RS(L), ZS(L) : L = 1,2,...,NDIVRE
C
       wr  = wr / ndivw
       wz  = wz / ndivw
       hr  = hr / ndivh
       hz  = hz / ndivh
C
       hors = wr
       vers = hz
C
       rs(1) = r0 + 0.5*(wr + hr)
       zs(1) = z0 + 0.5*(wz + hz)
C
      DO 1 i=1,ndivw
      DO 1 j=1,ndivh
         l     = (i-1)*ndivh + j
         rs(l) = rs(1) + (i-1)*wr + (j-1)*hr
         zs(l) = zs(1) + (i-1)*wz + (j-1)*hz
    1 CONTINUE
C***************************************
C
        RETURN
        END