C234567
      PROGRAM COPA
C
C     World Cup Simulator
C     
C     Developed by:  Roger  
C     Date:  MY/86.
C     Last revision:  MY/94
C     Revision: Ag/97 for 32-team France 98
C
C     Input files:
C          france98.dat (contains player data base)
C
C     Output files:
C          cup.out  (contains final standings and
C                    playoff history)
C          g1.out   (Round 1, Group 1 info)
C          g2.out
C          g3.out
C          g4.out
C          g5.out
C          g6.out
C          g7.out
C          g8.out
C
C234567
      CALL INITIAL
      CALL PORTADA
      CALL ASSIGN2
      CALL ASSIGN
      CALL ROUND1
Crz      CALL THIRDS
      CALL TABLE
      CALL GOLEO(0) 
      CALL ACOMODA
      CALL OCTAVOS
      CALL GOLEO(0)
      CALL CUARTOS
      CALL GOLEO(0)
      CALL SEMIFINAL
      CALL GOLEO(0)
      CALL FINAL
      CALL GOLEO(1)
      CLOSE(1)
      CLOSE(10)
      CLOSE(11)
      CLOSE(12)
      CLOSE(13)
      CLOSE(14)
      CLOSE(15)
      CLOSE(16)
      CLOSE(17)
      CLOSE(18)
      CALL CLEAR
      END

C----------------------------
C     INITIAL:
C----------------------------
C234567
      SUBROUTINE INITIAL
      
      COMMON /ALL/ TEAM(32), LVL(32)
      COMMON /INF/ NJ(32), NG(32), NE(32), NGF(32), NGC(32)
      COMMON /GLS/ A(32,21)
      COMMON /PLY/ PLYR(32,11), ANOT(32,11)

      CHARACTER *13 PLYR
      CHARACTER *12 TEAM
      CHARACTER *26 STR
      INTEGER ANOT, A

      DO I = 1, 32
          NJ(I) = 0
          NG(I) = 0
          NE(I) = 0
          NGF(I) = 0
          NGC(I) = 0
          DO J = 1, 21
              A(I,J) = -1
          ENDDO
          DO J = 1, 11
              ANOT(I,J) = 0
          ENDDO
      ENDDO

      OPEN(UNIT = 1, FILE = 'france98.dat', STATUS = 'OLD')
      
      DO I = 1, 32
          READ(1, 1010) TEAM(I)
          READ(1, 1020) (PLYR(I,J), J = 1, 11)
      ENDDO

      OPEN(UNIT = 10, FILE = 'cup.out', STATUS = 'NEW')
      OPEN(UNIT = 11, FILE = 'g1.out', STATUS = 'NEW')
      OPEN(UNIT = 12, FILE = 'g2.out', STATUS = 'NEW')
      OPEN(UNIT = 13, FILE = 'g3.out', STATUS = 'NEW')
      OPEN(UNIT = 14, FILE = 'g4.out', STATUS = 'NEW')
      OPEN(UNIT = 15, FILE = 'g5.out', STATUS = 'NEW')
      OPEN(UNIT = 16, FILE = 'g6.out', STATUS = 'NEW')
      OPEN(UNIT = 17, FILE = 'g7.out', STATUS = 'NEW')
      OPEN(UNIT = 18, FILE = 'g8.out', STATUS = 'NEW')

c      CALL FDATE_(STR)
      CALL FDATE(STR)
      WRITE(10,*)'/////////////////////////////////////////////////'
      WRITE(10,*)'//                                             //'
      WRITE(10,*)'//             WORLD CUP SIMULATOR             //'
      WRITE(10,*)'//                                             //'
      WRITE(10,*)'//      Copyright  1986, 1990, 1994, 1998      //'
      WRITE(10,*)'//              by  Roger Z. Rios              //'
      WRITE(10,*)'//                                             //'
      WRITE(10,*)'//   http://www.hpc.uh.edu/~roger/Simulator/   //'
      WRITE(10,*)'//                                             //'
      WRITE(10,*)'//                                             //'
      WRITE(10,*)'/////////////////////////////////////////////////'
      WRITE(10,*)' '
      WRITE(10,1040) STR

 1010 FORMAT(A)
 1020 FORMAT(5A)
 1040 FORMAT(6X,A)
      RETURN
      END

C----------------------------
C     PORTADA
C----------------------------
C234567
      SUBROUTINE PORTADA
      COMMON /RAN/ NR

      CHARACTER *50 NAME
      CALL CLEAR
      WRITE(6,*)'     *     *   ***   ****   *      ****'
      WRITE(6,*)'     *     *  *   *  *   *  *      *   *'
      WRITE(6,*)'     *     *  *   *  *   *  *      *   *'
      WRITE(6,*)'     *  *  *  *   *  ****   *      *   *'
      WRITE(6,*)'     *  *  *  *   *  * *    *      *   *'
      WRITE(6,*)'     *  *  *  *   *  *  *   *      *   *'
      WRITE(6,*)'      ** **    ***   *   *  *****  **** '
      WRITE(6,*)' '
      WRITE(6,*)' '
      WRITE(6,*)'              ***   *   *  **** '
      WRITE(6,*)'             *   *  *   *  *   *'
      WRITE(6,*)'             *      *   *  *   *'
      WRITE(6,*)'             *      *   *  **** '
      WRITE(6,*)'             *      *   *  *    '
      WRITE(6,*)'             *   *  *   *  *    '
      WRITE(6,*)'              ***    ***   *    '
      WRITE(6,*)' '
      WRITE(6,*)' '
      WRITE(6,*)' '
C
C   The maximum INTEGER value for the AIX xlf compiler is
C      2 147 483 647
C
      WRITE(6,*)'Enter author name --> '
      READ(5,1010) NAME
      WRITE(6,*)'Enter seed value [1, 2 147 483 647] --> '
      READ(5,*) NR
      WRITE(10,*)'     Data provider: ', NAME
      WRITE(10,*)'     Random seed: ', NR
      WRITE(10,*)' '
      WRITE(10,*)'FIRST PHASE'
      WRITE(10,*)

      RETURN
 1010 FORMAT(A)
      END

C----------------------------
C     ASSIGN2
C----------------------------
C234567
      SUBROUTINE ASSIGN2

      COMMON /ALL/ TEAM(32), LVL(32)
      COMMON /PLY/ PLYR(32,11), ANOT(32,11)

      CHARACTER *12 TEAM
      CHARACTER *13 PLYR

   10 CALL CLEAR

      WRITE(6,*)'          STARTING ROSTERS'
      WRITE(6,*)' '

      DO I = 1, 16
          WRITE(6,1000) I, TEAM(I), I+16, TEAM(I+16)
      ENDDO
 
      WRITE(6,*)' '
      WRITE(6,*)'    [0] Continue'
      WRITE(6,*)' [1-32] Check line-up'
      WRITE(6,*)' '
      WRITE(6,*)'OPTION ->'
      READ(5,*) NTEAM
      
      IF (NTEAM. EQ .0) RETURN

   20 CALL CLEAR

      WRITE(6,1010) TEAM(NTEAM)
      WRITE(6,*)' '
    
      DO J = 1, 11
          WRITE(6,1020) J, PLYR(NTEAM,J)
      ENDDO

      WRITE(6,*)' '
      WRITE(6,*)'    [0] Back'
      WRITE(6,*)' [1-11] Player substitution'
      WRITE(6,*)' '
      WRITE(6,*)'OPTION ->'
      READ(5,*) NPLAYER

      IF (NPLAYER. EQ .0) GOTO 10

      WRITE(6,*)' '
      WRITE(6,1030) PLYR(NTEAM,NPLAYER)
      WRITE(6,1040)
      READ(5,1050) PLYR(NTEAM,NPLAYER)
      GOTO 20

 1000 FORMAT(10X,2(I2,'. ',A12,5X))
 1010 FORMAT(10X,A)
 1020 FORMAT(5X,I3,'. ',A)
 1030 FORMAT(1X,'Who subs ',A,' ?')
 1040 FORMAT(1X,'(13 characters maximum)')
 1050 FORMAT(A13)

      END

C----------------------------
C     ASSIGN
C----------------------------
C234567
      SUBROUTINE ASSIGN

      COMMON /ALL/ TEAM(32), LVL(32)

      CHARACTER *12 TEAM

C
C     Default levels.
C
   10 CONTINUE
      LVL(1) = 5
      LVL(2) = 2
      LVL(3) = 3
      LVL(4) = 4
      LVL(5) = 4
      LVL(6) = 4
      LVL(7) = 3
      LVL(8) = 2
      LVL(9) = 4
      LVL(10) = 2
      LVL(11) = 1
      LVL(12) = 3
      LVL(13) = 4
      LVL(14) = 4
      LVL(15) = 3
      LVL(16) = 4
      LVL(17) = 4
      LVL(18) = 3
      LVL(19) = 3
      LVL(20) = 3
      LVL(21) = 5
      LVL(22) = 2
      LVL(23) = 4
      LVL(24) = 0
      LVL(25) = 4
      LVL(26) = 4
      LVL(27) = 5
      LVL(28) = 2
      LVL(29) = 4
      LVL(30) = 1
      LVL(31) = 2
      LVL(32) = 3

   20 CALL CLEAR

      DO I = 1, 2
          IG = 4 * (I - 1)
          WRITE(6,1000) IG + 1, IG + 2, IG + 3, IG + 4
  
          DO J = 1, 4
              JG = 16 * (I - 1) + J
              WRITE(6,1010) JG, TEAM(JG), LVL(JG),
     *                      JG + 4, TEAM(JG+4), LVL(JG+4),
     *                      JG + 8, TEAM(JG+8), LVL(JG+8),
     *                      JG + 12, TEAM(JG+12), LVL(JG+12)
          ENDDO
 
      ENDDO

      WRITE(6,*)' '
 5    WRITE(6,*)'   Level     (5) Excellent    (2) Regular'
      WRITE(6,*)'             (4) Very good    (1) Bad'
      WRITE(6,*)'             (3) Good         (0) Worst'
      WRITE(6,*)' '
      WRITE(6,*)'    [0] Continue      [33] Change all'
      WRITE(6,*)' [1-32] Individual    [40] Default levels'
      WRITE(6,*)' '
      WRITE(6,*)'OPTION ->'
      READ(5,*) NOPC

      IF (NOPC. EQ .0) GOTO 50
      IF (NOPC. EQ .33) GOTO 30
      IF (NOPC. EQ .40) GOTO 10

      WRITE(6,1050) TEAM(NOPC)
      READ(5,*) LVL(NOPC)
      GOTO 20

   30 CALL CLEAR
      WRITE(6,*)'     [0] Same level' 
      WRITE(6,*)'     [1] Different levels'
      WRITE(6,*)' '
      WRITE(6,*)'OPTION -->'
      READ(5,*) NOPC

      IF (NOPC. EQ .0) THEN
          WRITE(6,*) 'Level --> [0-5]'
          READ(5,*) LEVEL
          DO I = 1, 32
              LVL(I) = LEVEL
          ENDDO
          GOTO 20
      ENDIF

      DO I = 1, 32
          CALL CLEAR
          WRITE(6,*)'            Level'
          WRITE(6,*)' '
          WRITE(6,*)'     [5] Excellent'
          WRITE(6,*)'     [4] Very good'
          WRITE(6,*)'     [3] Good'
          WRITE(6,*)'     [2] Regular'  
          WRITE(6,*)'     [1] Bad'
          WRITE(6,*)'     [0] Worst'
          WRITE(6,*)' '
          WRITE(6,*)' '
          WRITE(6,1050) TEAM(I)
          READ(5,*) LVL(I)
      ENDDO

      GOTO 20

 50   CONTINUE
      DO I = 1, 2
          IG = 4 * (I - 1)
          WRITE(10,1000) IG + 1, IG + 2, IG + 3, IG + 4
  
          DO J = 1, 4
              JG = 16 * (I - 1) + J
              WRITE(10,1010) JG, TEAM(JG), LVL(JG),
     *                      JG + 4, TEAM(JG+4), LVL(JG+4),
     *                      JG + 8, TEAM(JG+8), LVL(JG+8),
     *                      JG + 12, TEAM(JG+12), LVL(JG+12)
          ENDDO
 
      ENDDO

      WRITE(10,*)' '
      WRITE(10,*)'   Level     (5) Excellent    (2) Regular'  
      WRITE(10,*)'             (4) Very good    (1) Bad'    
      WRITE(10,*)'             (3) Good         (0) Worst'
      WRITE(10,*)' '

      RETURN

 1000 FORMAT(/,5X,4('GROUP',I2,4X,'LVL',6X),/)
 1010 FORMAT(1X,4(I2,'. ',A12,I2,2X))
 1050 FORMAT(1X,'New level for  ',A12,' -->')

      END

C----------------------------
C     ROUND1
C----------------------------
C234567
      SUBROUTINE ROUND1

      COMMON /ALL/ TEAM(32), LVL(32)
      CHARACTER *12 TEAM

      DO K = 1, 3
          GOTO (10, 20, 30), K
   
   10     CALL GAMES(K, 1, 2, 3, 4)
          GOTO 40
   
   20     CALL GAMES(K, 1, 3, 4, 2)
          GOTO 40

   30     CALL GAMES(K, 1, 4, 2, 3)
   
   40     CONTINUE

          IF (K. NE .3) CALL GOLEO(0)
      ENDDO

      RETURN
      END

crzrm
C----------------------------
C     THIRDS
C----------------------------
C Not used in France 98
C234567
      SUBROUTINE THIRDS

      COMMON /ALL/ TEAM(32), LVL(32)
      COMMON /INF/ NJ(32), NG(32), NE(32), NGF(32), NGC(32)
      COMMON /TERCER/ K3(8,2), KF(8,2)
      DIMENSION ND(32), NPTS(32), NDIF(32),
     *          NJ2(8), NG2(8), NE2(8), ND2(8),
     *          NGF2(8), NGC2(8), NPTS2(8), NDIF2(8)
      CHARACTER *12 TEAM
      CHARACTER *12 TEAM2(8)
      CHARACTER RET

      CALL CLEAR

      DO J = 1, 8
          I = K3(J,1)
          ND(I) = NJ(I) - (NG(I) + NE(I))
          NDIF(I) = NGF(I) - NGC(I)
          NPTS(I) = 3 * NG(I) + NE(I)
      ENDDO

      L = 0

      DO I = 1, 8
          IPTS = NPTS(K3(1,1))
          IDIF = NDIF(K3(1,1))
          IGF  = NGF(K3(1,1))
          ILVL = LVL(K3(1,1))
          IK = 1
          
          DO J = 2, 8
              IF (IPTS. GT .NPTS(K3(J,1))) GOTO 20
              IF (IPTS. LT .NPTS(K3(J,1))) GOTO 10
              IF (IDIF. GT .NDIF(K3(J,1))) GOTO 20
              IF (IDIF. LT .NDIF(K3(J,1))) GOTO 10
              IF (IGF. GT .NGF(K3(J,1))) GOTO 20
              IF (IGF. LT .NGF(K3(J,1))) GOTO 10
              IF (ILVL. GT .LVL(K3(J,1))) GOTO 20
   10         IPTS = NPTS(K3(J,1))
              IDIF = NDIF(K3(J,1))
              IGF  = NGF(K3(J,1))
              ILVL = LVL(K3(J,1))
              IK = J
   20         CONTINUE
          ENDDO

          L = L + 1
          K3(IK,2) = L
          TEAM2(L) = TEAM(K3(IK,1))
          NJ2(L)   = NJ(K3(IK,1))
          NG2(L)   = NG(K3(IK,1))
          NE2(L)   = NE(K3(IK,1))
          ND2(L)   = ND(K3(IK,1))
          NGF2(L)  = NGF(K3(IK,1))
          NGC2(L)  = NGC(K3(IK,1))
          NPTS2(L) = NPTS(K3(IK,1))
          NDIF2(L) = NDIF(K3(IK,1))
          NPTS(K3(IK,1)) = -1
      ENDDO

      WRITE(6,*)' '
      WRITE(6,1090)
      WRITE(6,*)' '

      DO I = 1, 8
          WRITE(6,1000) TEAM2(I), NJ2(I), NG2(I), NE2(I), ND2(I),
     *                  NGF2(I), NGC2(I), NPTS2(I)
      ENDDO

      WRITE(6,*)' '
      WRITE(6,*)'ADVANCE TO PLAYOFFS'
      WRITE(6,*)' '
crz      DO I = 1, 4
crz          WRITE(6,1030) TEAM2(I)
crz      ENDDO

      WRITE(6,*)' '
      WRITE(6,1040) TEAM2(5), TEAM2(6) 
      write(6,1040) TEAM2(7), TEAM2(8)
      WRITE(6,*)' '
      WRITE(6,*)'[RETURN]'
      READ(5,1010) RET

 1000 FORMAT(5X,A12,4(I2),3(I3))
 1010 FORMAT(A)
 1030 FORMAT(5X,A) 
 1040 FORMAT(5X,'Quedan fuera de la Copa ',A,' y ',A)
 1090 FORMAT(5X,'TERCEROS    JJ G E P GF GC PTS')

      RETURN
      END

C----------------------------
C     TABLE
C----------------------------
C234567
      SUBROUTINE TABLE

      COMMON /TERCER/ K3(8,2), KF(8,2)
      COMMON /SIG/ LBSW

      LBSW = 1

      DO I = 1, 2
          CALL CLEAR
          DO J = 1, 4
              K = 4 * (I - 1) + J
              CALL TABLE_1(K)
          ENDDO
          WRITE(6,*)' '
          WRITE(6,*)' '
          WRITE(6,*)'[RETURN]'
          READ(5,1010) RET
      ENDDO

 1010 FORMAT(A)
 
      RETURN
      END

C----------------------------
C     GOLEO
C----------------------------
C234567
      SUBROUTINE GOLEO(IFLAG)

      COMMON /ALL/ TEAM(32), LVL(32)
      COMMON /PLY/ PLYR(32,11), NOT(32,11)
      DIMENSION NG2(352), NG(32,11)

      CHARACTER *12 TEAM
      CHARACTER *13 PLYR
      CHARACTER *12 TM2(352)
      CHARACTER *13 PL2(352)
      CHARACTER *1 RET
   
      DO I = 1, 32
          DO J = 1, 11
              NG(I,J) = NOT(I,J)
          ENDDO
      ENDDO

      L = 0

      DO J = 1, 352
          IT = 1
          IP = 1
          IG = NG(1,1)
          DO K = 2, 352
              JT = INT((K - 1) / 11) + 1
              JP = K - 11 * (JT - 1)
              IF (IG. GE .NG(JT,JP)) GOTO 20
              IT = JT
              IP = JP
              IG = NG(JT,JP)
   20         CONTINUE
          ENDDO
          L = L + 1
          TM2(L) = TEAM(IT)
          PL2(L) = PLYR(IT,IP)
          NG2(L) = IG
          NG(IT,IP) = -1
      ENDDO

      WRITE(6,*)'          Scoring'
      IF (IFLAG. EQ .1) THEN
          WRITE(10,*)
     *    '--------------------------------------------------'
          WRITE(10,*)' INDIVIDUAL SCORING'
          WRITE(10,*)' '
      ENDIF
      WRITE(6,*)' '

      DO I = 1, 352
          IF (NG2(I). EQ .0) GOTO 60
          WRITE(6,1030) I, PL2(I), TM2(I), NG2(I)
          IF (IFLAG. EQ .1) WRITE(10,1030) I, PL2(I), TM2(I), NG2(I)
          L = 15 * INT(I / 15)
          IF (L. EQ . I) THEN
              WRITE(6,*)' '
              WRITE(6,*)'[RETURN]'
              READ(5,1010) RET
              IF (RET. EQ .'0') GOTO 60
              CALL CLEAR
              WRITE(6,*)'          Individual Scoring'
              WRITE(6,*)' '
          ENDIF
      ENDDO
 60   CONTINUE
      IF (IFLAG. EQ .1) THEN
          WRITE(10,*)
     *    '--------------------------------------------------'
          WRITE(10,*)' '
      ENDIF

cx   70 WRITE(6,*)' '
cx      WRITE(6,*)'[RETURN]'
cx      READ(5,1010) RET

   80 CALL CLEAR
      DO J = 2, 11
          NZ = 0
          DO I = 1, 32
              NZ = NZ + NOT(I,J)
          ENDDO
          WRITE(6,1080) J, NZ
      ENDDO

      READ(5,1010) RET

 1010 FORMAT(A)
 1030 FORMAT(5X,I3,'. ',A13,'(',A12,')',I3)
 1080 FORMAT(5X,'Player  #',I3,5X,'Goals',I3)
 
      RETURN
      END

C----------------------------
C     ACOMODA
C----------------------------
C234567
      SUBROUTINE ACOMODA

      COMMON /TERCER/ K3(8,2), KF(8,2)
      COMMON /FNLS/ FN8(16)
      INTEGER FN8

      FN8(1)  = KF(1,1)
      FN8(2)  = KF(2,2)
      FN8(3)  = KF(4,1)
      FN8(4)  = KF(3,2)
      FN8(5)  = KF(5,1)
      FN8(6)  = KF(6,2)
      FN8(7)  = KF(8,1)
      FN8(8)  = KF(7,2)

      FN8(9)  = KF(2,1)
      FN8(10) = KF(1,2)
      FN8(11) = KF(3,1)
      FN8(12) = KF(4,2)
      FN8(13) = KF(6,1)
      FN8(14) = KF(5,2)
      FN8(15) = KF(7,1)
      FN8(16) = KF(8,2)
   
      RETURN
      END

C----------------------------
C     OCTAVOS
C----------------------------
C234567
      SUBROUTINE OCTAVOS

      COMMON /ALL/ TEAM(32), LVL(32)
      COMMON /FNLS/ FN8(16)
      DIMENSION KK(16)
      CHARACTER *12 TEAM
      CHARACTER RET
      INTEGER FN8

      CALL CLEAR
      WRITE(6,*)'ROUND OF 16'
      WRITE(6,*)' '
      WRITE(10,*)
     *'--------------------------------------------------'
      WRITE(10,*)' '
      WRITE(10,*)'ROUND OF 16'
      WRITE(10,*)' '
      
      DO I = 1, 15, 2
          WRITE(6,1000) (TEAM(FN8(J)), J=I, I+1)
          WRITE(10,1000) (TEAM(FN8(J)), J=I, I+1)
          WRITE(6,*)' '
      ENDDO
      WRITE(10,*)' '
      WRITE(6,*)' '
      WRITE(6,*)'[RETURN]'
      READ(5,1010) RET

      CALL CLEAR

      DO I = 1, 15, 2
          CALL MATCH(2,FN8(I), FN8(I+1), KK(I), KK(I+1), NSWP, NGTR, 10)
          IF (KK(I). LT .KK(I+1)) THEN
              NAUX = FN8(I)
              FN8(I) = FN8(I+1)
              FN8(I+1) = NAUX
          ENDIF
          CALL CLEAR
          WRITE(6,*)'ROUND OF 16'
          WRITE(6,*)' '

          DO J = 1, I, 2
              IF (KK(J). GT .KK(J+1)) THEN
                  WRITE(6,1020) TEAM(FN8(J)), TEAM(FN8(J+1)),
     *                          KK(J), KK(J+1), TEAM(FN8(J))
              ELSE
                  WRITE(6,1020) TEAM(FN8(J+1)), TEAM(FN8(J)),
     *                          KK(J), KK(J+1), TEAM(FN8(J))
              ENDIF
          ENDDO

          IF (I. EQ .15) GOTO 40
          DO J = I+2, 15, 2
              WRITE(6,1000) (TEAM(FN8(K)), K=J, J+1)
          ENDDO
   40     WRITE(6,*)' '
          WRITE(6,*)'[RETURN]'
          READ(5,1010) RET
      ENDDO

 1000 FORMAT(5X,A,' vs ',A)
 1010 FORMAT(A)
 1020 FORMAT(5X,A,' vs ',A,I2,'-',I2,'  --> ',A)

      RETURN
      END

C----------------------------
C     CUARTOS
C----------------------------
C234567
      SUBROUTINE CUARTOS

      COMMON /ALL/ TEAM(32), LVL(32)
      COMMON /FNLS/ FN8(16)
      DIMENSION KK(16)
      CHARACTER *12 TEAM
      CHARACTER RET
      INTEGER FN8

      CALL CLEAR
      WRITE(6,*)'QUARTER-FINALS'
      WRITE(6,*)' '
      WRITE(10,*)
     *'--------------------------------------------------'
      WRITE(10,*)' '
      WRITE(10,*)'QUARTER-FINALS'
      WRITE(10,*)' '
      
      DO I = 1, 13, 4
          WRITE(6,1000) TEAM(FN8(I)), TEAM(FN8(I+2)) 
          WRITE(10,1000) TEAM(FN8(I)), TEAM(FN8(I+2)) 
          WRITE(6,*)' '
      ENDDO
      WRITE(10,*)' '
      WRITE(6,*)' '
      WRITE(6,*)'[RETURN]'
      READ(5,1010) RET

      CALL CLEAR

      DO I = 1, 13, 4
          CALL MATCH(2,FN8(I), FN8(I+2), KK(I), KK(I+2), NSWP, NGTR, 10)
          IF (KK(I). LT .KK(I+2)) THEN
              NAUX = FN8(I)
              FN8(I) = FN8(I+2)
              FN8(I+2) = NAUX
          ENDIF
          CALL CLEAR
          WRITE(6,*)'QUARTER-FINALS'
          WRITE(6,*)' '

          DO J = 1, I, 4
              IF (KK(J). GT .KK(J+2)) THEN
                  WRITE(6,1020) TEAM(FN8(J)), TEAM(FN8(J+2)),
     *                          KK(J), KK(J+2), TEAM(FN8(J))
              ELSE
                  WRITE(6,1020) TEAM(FN8(J+2)), TEAM(FN8(J)),
     *                          KK(J), KK(J+2), TEAM(FN8(J))
              ENDIF
          ENDDO

          IF (I. EQ .13) GOTO 40
          DO J = I+4, 13, 4
              WRITE(6,1000) TEAM(FN8(J)), TEAM(FN8(J+2))
          ENDDO
   40     WRITE(6,*)' '
          WRITE(6,*)'[RETURN]'
          READ(5,1010) RET
      ENDDO

 1000 FORMAT(5X,A,' vs ',A)
 1010 FORMAT(A)
 1020 FORMAT(5X,A,' vs ',A,I2,'-',I2,'  --> ',A)

      RETURN
      END

C----------------------------
C     SEMIFINAL
C----------------------------
C234567
      SUBROUTINE SEMIFINAL

      COMMON /ALL/ TEAM(32), LVL(32)
      COMMON /FNLS/ FN8(16)
      DIMENSION KK(16)
      CHARACTER *12 TEAM
      CHARACTER RET
      INTEGER FN8

      CALL CLEAR
      WRITE(6,*)'SEMI-FINALS'
      WRITE(6,*)' '
      WRITE(10,*)
     *'--------------------------------------------------'
      write(10,*)' '
      WRITE(10,*)'SEMI-FINALS'
      WRITE(10,*)' '
      
      DO I = 1, 9, 8
          WRITE(6,1000) TEAM(FN8(I)), TEAM(FN8(I+4)) 
          WRITE(10,1000) TEAM(FN8(I)), TEAM(FN8(I+4)) 
          WRITE(6,*)' '
      ENDDO
      write(10,*)' '
      WRITE(6,*)' '
      WRITE(6,*)'[RETURN]'
      READ(5,1010) RET

      CALL CLEAR

      DO I = 1, 9, 8
          CALL MATCH(2,FN8(I), FN8(I+4), KK(I), KK(I+4), NSWP, NGTR, 10)
          IF (KK(I). LT .KK(I+4)) THEN
              NAUX = FN8(I)
              FN8(I) = FN8(I+4)
              FN8(I+4) = NAUX
          ENDIF
          CALL CLEAR
          WRITE(6,*)'SEMI-FINALS'
          WRITE(6,*)' '

          DO J = 1, I, 8
              IF (KK(J). GT .KK(J+4)) THEN
                  WRITE(6,1020) TEAM(FN8(J)), TEAM(FN8(J+4)),
     *                          KK(J), KK(J+4), TEAM(FN8(J))
              ELSE
                  WRITE(6,1020) TEAM(FN8(J+4)), TEAM(FN8(J)),
     *                          KK(J), KK(J+4), TEAM(FN8(J))
              ENDIF
          ENDDO

          IF (I. EQ .8) GOTO 40
          DO J = I+8, 9
              WRITE(6,1000) TEAM(FN8(J)), TEAM(FN8(J+4))
          ENDDO
   40     WRITE(6,*)' '
          WRITE(6,*)'[RETURN]'
          READ(5,1010) RET
      ENDDO

 1000 FORMAT(5X,A,' vs ',A)
 1010 FORMAT(A)
 1020 FORMAT(5X,A,' vs ',A,I2,'-',I2,'  --> ',A)

      RETURN
      END
C----------------------------
C     FINAL
C----------------------------
C234567
      SUBROUTINE FINAL

      COMMON /ALL/ TEAM(32), LVL(32)
      COMMON /FNLS/ FN8(16)
      CHARACTER *12 TEAM
      CHARACTER RET
      INTEGER FN8

      CALL CLEAR
      WRITE(6,*)'FINAL MATCHES'
      WRITE(6,*)' '
      WRITE(6,*)' '
      WRITE(6,*)'THIRD PLACE' 
      WRITE(6,*)' '
      WRITE(6,1000) TEAM(FN8(5)), TEAM(FN8(13)) 
      WRITE(6,*)' '
      WRITE(6,*)' '
      WRITE(6,*)'GREAT FINAL'
      WRITE(6,*)' '
      WRITE(6,1000) TEAM(FN8(1)), TEAM(FN8(9)) 
      WRITE(10,*)
     *'--------------------------------------------------'
      WRITE(10,*)' '
      WRITE(10,*)'THIRD PLACE'
      WRITE(10,*)' '
      WRITE(6,*)' '
      WRITE(6,*)'[RETURN]'
      READ(5,1010) RET

      CALL CLEAR

      CALL MATCH(2, FN8(5), FN8(13), K5, K13, NSWP, NGTR, 10)
      IF (K5. LT .K13) THEN
          NAUX = FN8(5)
          FN8(5) = FN8(13)
          FN8(13) = NAUX
      ENDIF
      WRITE(6,1050) TEAM(FN8(5)), TEAM(FN8(13))
      WRITE(6,*)' '
      WRITE(6,*)'[RETURN]'
      READ(5,1010) RET

      CALL CLEAR
      WRITE(6,*)' '
      WRITE(6,*)' '
      WRITE(6,*)'GREAT FINAL'
      WRITE(6,*)' '
      WRITE(6,1000) TEAM(FN8(1)), TEAM(FN8(9)) 
      WRITE(6,*)' '
      WRITE(6,*)' '
      WRITE(10,*)
     *'--------------------------------------------------'
      WRITE(10,*)' '
      WRITE(10,*)'GREAT FINAL'
      WRITE(10,*)' '
      WRITE(10,*)' '
      WRITE(6,*)'[RETURN]'
      READ(5,1010) RET

      CALL CLEAR

      CALL MATCH(2, FN8(1), FN8(9), K1, K9, NSWP, NGTR, 10)
      IF (K1. LT .K9) THEN
          NAUX = FN8(1)
          FN8(1) = FN8(9)
          FN8(9) = NAUX
      ENDIF
      WRITE(10,*)
     *'--------------------------------------------------'
      WRITE(10,*)' '
      WRITE(6,*)' '
      WRITE(6,*)'[RETURN]'
      READ(5,1010) RET

      CALL CLEAR
      WRITE(6,1060) TEAM(FN8(1))
      WRITE(6,*)' '
      WRITE(6,*)'[RETURN]'
      READ(5,1010) RET
      WRITE(10,1070) TEAM(FN8(1)), TEAM(FN8(9)),
     *               TEAM(FN8(5)), TEAM(FN8(13))

 1000 FORMAT(5X,A,' vs ',A)
 1010 FORMAT(A)
 1050 FORMAT(5X,'Third Place:  ',A,/,5X,'Fourth Place: ',A,/)
 1060 FORMAT(10X,'W O R L D   C H A M P I O N',///,25X,A,10(/))
 1070 FORMAT(5X,'Champion:  ',A,/,
     *       5X,'Runner-Up: ',A,/,
     *       5X,'Third::    ',A,/,
     *       5X,'Fourth:    ',A,/)

      RETURN
      END

C----------------------------
C     CLEAR
C----------------------------
C234567
      SUBROUTINE CLEAR

      DO I = 1, 24
          WRITE(6,*)' '
      ENDDO

      RETURN
      END

C----------------------------
C     SELEC
C----------------------------
C234567
      SUBROUTINE SELEC(JD, JB, JA, JC)
C
C J1 = PEOR B,E,F   J3 = MEJOR C,D,E
C J2 = PEOR A,C,D   J4 = MEJOR A,B,F
C

      COMMON /TERCER/ K3(8,2), KF(8,2)
      DIMENSION H(8), N(8)
      INTEGER H

      DO I = 1, 8
          N(I) = K3(I,1)
          IF(K3(I,2). LE .4) THEN
              H(I) = 1
          ELSE 
              H(I) = 0
          ENDIF
      ENDDO

      IF (H(1). EQ .1) THEN
          IF (H(2). EQ .1) THEN
              IF (H(3). EQ .1) THEN
                  JA = N(3)
                  IF (H(4). EQ .1) THEN
                      JB = N(4)
                      JC = N(1)
                      JD = N(2)
                  ELSE
                      JB = N(1)
                      JC = N(2)
                      IF (H(5). EQ .1) THEN
                          JD = N(5)
                      ELSE
                          JD = N(6)
                      ENDIF
                  ENDIF 
              ELSE
                  JB = N(1)
                  JC = N(2)
                  IF (H(4). EQ .1) THEN
                      JA = N(4)
                      IF (H(5). EQ .1) THEN
                          JD = N(5)
                      ELSE
                          JD = N(6)
                      ENDIF
                  ELSE
                      JA = N(5)
                      JD = N(6)
                  ENDIF
              ENDIF
          ELSE
              IF (H(3). EQ .1) THEN
                  JA = N(3)
                  IF (H(4). EQ .1) THEN
                      JB = N(4)
                      JC = N(1)
                      IF (H(5). EQ .1) THEN
                          JD = N(5)
                      ELSE
                          JD = N(6)
                      ENDIF
                  ELSE
                      JB = N(1)
                      JC = N(6)
                      JD = N(5)
                  ENDIF
              ELSE
                  JA = N(4)
                  JB = N(1)
                  JC = N(6)
                  JD = N(5)
              ENDIF 
          ENDIF
      ELSE
          IF (H(2). EQ .1) THEN
              JC = N(2)
              IF (H(3). EQ .1) THEN
                  IF (H(4). EQ .1) THEN
                      JA = N(3)
                      JB = N(4)
                      IF (H(5). EQ .1) THEN
                          JD = N(5)
                      ELSE
                          JD = N(6)
                      ENDIF
                  ELSE
                      JA = N(5)
                      JB = N(3)
                      JD = N(6)
                  ENDIF
              ELSE
                  JA = N(5)
                  JB = N(4)
                  JD = N(6)
              ENDIF
          ELSE
              JA = N(3)
              JB = N(4)
              JC = N(6)
              JD = N(5)
          ENDIF
      ENDIF

      RETURN
      END

C----------------------------
C     GAMES
C----------------------------
C234567
      SUBROUTINE GAMES(K, M1, M2, M3, M4)

      COMMON /ALL/ TEAM(32), LVL(32)
      COMMON /GLS/ A(32,21)
      COMMON /SIG/ LBSW

      CHARACTER *12 TEAM
      CHARACTER RET
      INTEGER A

      LBSW = 0

      CALL CLEAR
      WRITE(6,*)'Week ', K
      
      DO I = 1, 8
          J = 4 * (I - 1)
          WRITE(6,*)' '
          WRITE(6,1000) TEAM(J+M1), TEAM(J+M2)
          WRITE(6,1000) TEAM(J+M3), TEAM(J+M4)
      ENDDO

      WRITE(6,*)' '
      WRITE(6,*)'[RETURN]'
      READ(5,1010) RET

      
      DO I = 1, 8

          CALL CLEAR
          CALL TABLE_1(I)
          J = 4 * (I - 1)
          WRITE(6,*)' '
          WRITE(6,1000) TEAM(J+M1), TEAM(J+M2)
          WRITE(6,1000) TEAM(J+M3), TEAM(J+M4)
          WRITE(6,*)' '
          WRITE(6,*)'[RETURN]'
          READ(5,1010) RET
          WRITE(6,*)' '
          IUN = 10 + I
          CALL MATCH(-1, J+M1, J+M2, NGLS1, NGLS2, NSWP, NGTR, IUN)
          CALL RENEW(K, J+M1, J+M2, NGLS1, NGLS2)
          
          CALL CLEAR
          CALL TABLE_1(I)
          KJ = 3 * K - 1
          WRITE(6,*)' '
          WRITE(6,1020) TEAM(J+M1), TEAM(J+M2), A(J+M1,KJ), A(J+M2,KJ)
          WRITE(6,1000) TEAM(J+M3), TEAM(J+M4)
          WRITE(6,*)' '
          WRITE(6,*)'[RETURN]'
          READ(5,1010) RET
          WRITE(6,*)' '
          CALL MATCH(-1, J+M3, J+M4, NGLS1, NGLS2, NSWP, NGTR, IUN)
          CALL RENEW(K, J+M3, J+M4, NGLS1, NGLS2)
          CALL CLEAR
          CALL TABLE_1(I)
          WRITE(6,*)' '
          WRITE(6,1020) TEAM(J+M1), TEAM(J+M2), A(J+M1,KJ), A(J+M2,KJ)
          WRITE(6,1020) TEAM(J+M3), TEAM(J+M4), A(J+M3,KJ), A(J+M4,KJ)
cx          IF (K. EQ .1) WRITE(IUN,*)
cx     *    '--------------------------------------------------'
          WRITE(IUN,1020) TEAM(J+M1), TEAM(J+M2), A(J+M1,KJ), A(J+M2,KJ)
          WRITE(IUN,1020) TEAM(J+M3), TEAM(J+M4), A(J+M3,KJ), A(J+M4,KJ)
          WRITE(IUN,*)' '
          WRITE(6,*)' '
          WRITE(6,*)'[RETURN]'
          READ(5,1010) RET
      ENDDO

 1000 FORMAT(5X,A,' vs ',A)
 1010 FORMAT(A)
 1020 FORMAT(5X,A,' vs ',A,I2,'-',I2)

      RETURN
      END

C----------------------------
C     TABLE_1
C----------------------------
C234567
      SUBROUTINE TABLE_1(IGR)

      COMMON /ALL/ TEAM(32), LVL(32)
      COMMON /INF/ NJ(32), NG(32), NE(32), NGF(32), NGC(32)
      COMMON /TERCER/ K3(8,2), KF(8,2)
      COMMON /SIG/ LBSW
      DIMENSION ND(32), NPTS(32), NDIF(32)
      DIMENSION NJ2(4), NG2(4), NE2(4), ND2(4)
      DIMENSION NGF2(4), NGC2(4), NPTS2(4), NDIF2(4)
      CHARACTER *12 TEAM
      CHARACTER *12 TEAM2(4)
      CHARACTER *3 LBL(4)

      J = 4 * (IGR - 1)

      DO I2 = J + 1, J + 4
          ND(I2) = NJ(I2) - (NG(I2) + NE(I2))
          NDIF(I2) = NGF(I2) - NGC(I2)
          NPTS(I2) = 3 * NG(I2) + NE(I2)
      ENDDO

      L = 0

      DO J2 = J+1, J+4
          IPTS = NPTS(J+1)
          IDIF = NDIF(J+1)
          IGF = NGF(J+1)
          ILVL = LVL(J+1)
          IK = J + 1

          DO K2 = J+2, J+4
              IF (IPTS. GT .NPTS(K2)) GOTO 20
              IF (IPTS. LT .NPTS(K2)) GOTO 10
              IF (IDIF. GT .NDIF(K2)) GOTO 20
              IF (IDIF. LT .NDIF(K2)) GOTO 10
              IF (IGF. GT .NGF(K2)) GOTO 20
              IF (IGF. LT .NGF(K2)) GOTO 10
              IF (ILVL. GT . LVL(K2)) GOTO 20

   10         IPTS = NPTS(K2)
              IDIF = NDIF(K2)
              IGF = NGF(K2)
              ILVL = LVL(K2)
              IK = K2

   20         CONTINUE
          ENDDO

          L = L + 1

          IF (L. EQ .1) KF(IGR,1) = IK
          IF (L. EQ .2) KF(IGR,2) = IK
          IF (L. EQ .3) K3(IGR,1) = IK
          TEAM2(L) = TEAM(IK)
          NJ2(L)   = NJ(IK)
          NG2(L)   = NG(IK)
          NE2(L)   = NE(IK)
          ND2(L)   = ND(IK)
          NGF2(L)  = NGF(IK)
          NGC2(L)  = NGC(IK)
          NPTS2(L) = NPTS(IK)
          NDIF2(L) = NDIF(IK)
          NPTS(IK) = -1
      ENDDO

      IF (LBSW. EQ .1) THEN
          LBL(1) = ' * '
          LBL(2) = ' * '
crz          IF (K3(IGR,2). LE .4) LBL(3) = ' * '
crz          IF (K3(IGR,2). GE .5) LBL(3) = '(X)'
          LBL(3) = '(X)'
          LBL(4) = '(X)'
      ENDIF

      WRITE(6,*)' '
      WRITE(6,1090) IGR
      WRITE(6,*)' '
      IF(LBSW.EQ.1)THEN
          WRITE(10,*)
     *    '--------------------------------------------------'
          WRITE(10,*)' ' 
          WRITE(10,1090) IGR
          WRITE(10,*)' '
      ENDIF
      
      DO I = 1, 4
          WRITE(6,1000) TEAM2(I), NJ2(I), NG2(I), NE2(I), ND2(I),
     *                  NGF2(I), NGC2(I), NPTS2(I), LBL(I)
          IF (LBSW. EQ .1) 
     *    WRITE(10,1000) TEAM2(I), NJ2(I), NG2(I), NE2(I), ND2(I),
     *                  NGF2(I), NGC2(I), NPTS2(I), LBL(I)
      ENDDO
      WRITE(6,*)' '
      IF(LBSW.EQ.1) WRITE(10,*) ' '

 1000 FORMAT(5X,A12,4(I2),3(I3),3X,A3)
 1090 FORMAT(5X,'GROUP ',I2,'     G W D L GF:GA PTS')

      RETURN
      END

C----------------------------
C     ANT
C----------------------------
C234567
      SUBROUTINE ANT(NT, NAME, NGT)

      COMMON /ALL/ TEAM(32), LVL(32)
      COMMON /PLY/ PLYR(32,11), NOT(32,11)
      COMMON /RAN/ NR
      CHARACTER *12 TEAM
      CHARACTER *13 PLYR, NAME

      RND = RANDOM(NR)
      K = INT(RND * 100.0) + 1
      
      IF (1.LE.K. AND .K.LE.3) NA = 2 
      IF (4.LE.K. AND .K.LE.7) NA = 3 
      IF (8.LE.K. AND .K.LE.12) NA = 4 
      IF (13.LE.K. AND .K.LE.18) NA = 5 
      IF (19.LE.K. AND .K.LE.23) NA = 6 
      IF (24.LE.K. AND .K.LE.32) NA = 7 
      IF (33.LE.K. AND .K.LE.46) NA = 8 
      IF (47.LE.K. AND .K.LE.68) NA = 9 
      IF (69.LE.K. AND .K.LE.85) NA = 10 
      IF (86.LE.K. AND .K.LE.100) NA = 11 

      NAME = PLYR(NT,NA)
      NOT(NT,NA) = NOT(NT,NA) + 1
      NGT = NOT(NT,NA)

      RETURN
      END

C----------------------------
C     MATCH
C----------------------------
C234567
      SUBROUTINE MATCH(NTYPE, I1, I2, M1, M2, SWP, NGTR, IUN)
C
C     NTYPE = 1  First round game.
C           = 2  Playoff game.
C
      COMMON /ALL/ TEAM(32), LVL(32)
      COMMON /PLY/ PLYR(32,11), ANOT(32,11)
      COMMON /RAN/ NR
      DIMENSION TM(2), LV(2)
      CHARACTER *12 TEAM, TM
      CHARACTER *13 PLYR
      CHARACTER RET
      CHARACTER *13 AX4(20)
      CHARACTER *3 AX5(22,2)
      INTEGER GL(2), XG, G90
      INTEGER AX1(20), AX2(20), AX3(20), AX6(20)
      INTEGER ANOT, SWP, SWV
      INTEGER NGOLDEN

C     NGOLDEN = 0 := 30 minute extra time
C             = 1 := 30-minute extra time limit w/golden goal in effect
      NGOLDEN = 1

      SWP = 0
      TM(1) = TEAM(I1)
      TM(2) = TEAM(I2)
      LV(1) = LVL(I1)
      LV(2) = LVL(I2)
      GL(1) = 0
      GL(2) = 0

      IF (LV(1). EQ .LV(2)) THEN
          LV(1) = 4
          LV(2) = 4
      ELSE
          IF (LV(1). GT .LV(2)) THEN 
              LV(2) = LV(2) - LV(1) + 5 
              LV(1) = 5 
          ELSE
              LV(1) = LV(1) - LV(2) + 5
              LV(2) = 5 
          ENDIF
      ENDIF

      CALL CLEAR
      WRITE(6,*)'IPOP SCORE'
      WRITE(6,*)' '

      DO I = 1, 2
          WRITE(6,1020) TM(I), GL(I)
cx          WRITE(IUN,1020) TM(I), GL(I)
      ENDDO

      WRITE(6,*)' '
      WRITE(6,*)'Press info level [0-1] -->'
      READ(5,1010) RET

      SWV = 2
      IF (RET. EQ .'0') SWV = 0
      IF (RET. EQ .'1') SWV = 1

      IF (SWV. GT . 0) THEN
           DO I = 1, 2
               WRITE(IUN,1020) TM(I), GL(I)
           ENDDO
      ENDIF

C
C     PROB:  Numero real positivo inversamente proporcional
C            a la probabilidad de anotar gol.
C     BASE:  Numero real (>= 1) que representa la diferencia
C            entre equipos en funcion de su nivel.  BASE = 1
C            significa que no hay peso, equipos de niveles dis-
C            tintos tienen igual probabilidad de anotar.
C            Mayores valores de BASE hacen que el peso entre
C            equipos de distintos niveles sea mayor. 
C
      PROB = 4.8
      BASE = 1.8

      G90 = 0
      NROW = 0

      DO J = 1, 8
          RND = RANDOM(NR)
          IF (RND. LE .0.5) THEN
              JT = J
          ELSE
              JT = J+1
          ENDIF

          IF (2.0 * FLOAT(JT / 2). EQ .FLOAT(JT)) THEN
              LZ1 = 2
              LZ2 = 1
              LZ3 = -1
          ELSE
              LZ1 = 1
              LZ2 = 2
              LZ3 = 1
          ENDIF

          DO I = LZ1, LZ2, LZ3
   10         CONTINUE
              RND = RANDOM(NR)
                XXG = RND * (PROB * (BASE ** (5 - LV(I))))
cx              XXG = RND * (69.5 - (20.5 - 1.5 * LV(I)) * LV(I))
cx              XXG = RND * (10.0 / FLOAT(LV(I) + 1))
              IF (XXG. LE .1.1) THEN
                  GL(I) = GL(I) + 1
                  RND = RANDOM(NR)
cx                  G90 = G90 + INT(RND * (90 - G90))
                  G90 = 90 - INT((90 - G90) * SQRT(1.0 - RND))
                  NROW = NROW + 1
                  AX1(NROW) = GL(1)
                  AX2(NROW) = GL(2)
                  AX3(NROW) = G90
                  IF (I. EQ .1) IS = I1
                  IF (I. EQ .2) IS = I2
                  CALL ANT(IS,AX4(NROW), AX6(NROW))
                  CALL CLEAR
                  IF (SWV. EQ .0) GOTO 65
                  WRITE(6,*)'IPOP SCORE'
                  WRITE(6,*)' '
                  DO I3 = 1, 2
                      WRITE(6,1020) TM(I3), GL(I3)
                  ENDDO
                  WRITE(6,*)' '
                  IF (SWV. EQ .1) GOTO 55
                  DO I3 = 1, NROW
                      WRITE(6,1030) AX1(I3), AX2(I3), AX3(I3), AX4(I3), 
     *                              AX6(I3)
                  ENDDO
                      WRITE(IUN,1030) AX1(NROW), AX2(NROW), AX3(NROW),
     *                                AX4(NROW), AX6(NROW)
   55             WRITE(6,*)' '
                  READ(5,1010) RET
   65             CONTINUE
              ENDIF
          ENDDO
      ENDDO

      IF (NTYPE. EQ .-1. OR .GL(1). NE .GL(2)) THEN
          M1 = GL(1)
          M2 = GL(2)
          IF (SWV. NE .2) GOTO 69
          WRITE(6,*)'FINAL SCORE'
          WRITE(6,*)' '
          WRITE(6,*)' '
          WRITE(6,*)'[RETURN]'
          WRITE(IUN,*)' '
          READ(5,1010) RET
   69     RETURN
      ENDIF

      G90 = 90

      WRITE(6,*)' '
      WRITE(6,*)'Extra Time'
      WRITE(IUN,*)'Extra Time'
      WRITE(6,*)'Info level [0-1] ->'
      READ(5,1010) RET
      SWV = 2
      IF (RET. EQ .'0') SWV = 0
      IF (RET. EQ .'1') SWV = 1

      PROB = 3.9
      BASE = 1.8
      
      DO J = 1, 2
          RND = RANDOM(NR)
          IF (RND. LE .0.5) THEN
              JT = J
          ELSE
              JT = J+1
          ENDIF

          IF (2.0 * FLOAT(JT / 2). EQ .FLOAT(JT)) THEN
              LZ1 = 2
              LZ2 = 1
              LZ3 = -1
          ELSE
              LZ1 = 1
              LZ2 = 2
              LZ3 = 1
          ENDIF

          DO I = LZ1, LZ2, LZ3
              RND = RANDOM(NR)
              XG = RND * (PROB * (BASE ** (5 - LV(I))))
cx              XG = RND * (25.0 - 4.2 * LV(I))
              IF (XG. LE .2.4) THEN
                  GL(I) = GL(I) + 1
                  RND = RANDOM(NR)
cx                  G90 = G90 + INT(RND * (120 - G90))
                  G90 = 120 - INT((120 - G90) * SQRT(1.0 - RND))
                  NROW = NROW + 1
                  AX1(NROW) = GL(1)
                  AX2(NROW) = GL(2)
                  AX3(NROW) = G90
                  IF (I. EQ .1) IS = I1
                  IF (I. EQ .2) IS = I2
                  CALL ANT(IS,AX4(NROW), AX6(NROW))
                  CALL CLEAR
                  IF (SWV. EQ .0) GOTO 75
                  WRITE(6,*)'SCORE IPOP'
                  WRITE(6,*)'   Extra Time'
                  WRITE(6,*)' '
                  DO I3 = 1, 2
                      WRITE(6,1020) TM(I3), GL(I3)
                  ENDDO
                  WRITE(6,*)' '
                  IF (SWV. EQ .1) GOTO 73
                  DO I3 = 1, NROW
                      WRITE(6,1030) AX1(I3), AX2(I3), AX3(I3), AX4(I3), 
     *                              AX6(I3)
                  ENDDO
                      WRITE(IUN,1030) AX1(NROW), AX2(NROW), AX3(NROW),
     *                                AX4(NROW), AX6(NROW)
   73             WRITE(6,*)' '
                  READ(5,1010) RET
   75             CONTINUE
                  IF (NGOLDEN. EQ .1) GOTO 74
              ENDIF
          ENDDO
      ENDDO

 74   CONTINUE
      IF (GL(1). NE .GL(2)) THEN
          WRITE(6,*)'FINAL SCORE'
          M1 = GL(1)
          M2 = GL(2)
          IF (SWV. NE .2) RETURN
          WRITE(6,*)' '
          WRITE(6,*)' '
          WRITE(6,*)'[RETURN]'
          WRITE(IUN,*)' '
          READ(5,1010) RET
          RETURN
      ENDIF
 
      SWP = 1
      NGTR = GL(1)

      WRITE(6,*)'Penalty Kicks'
      WRITE(IUN,*)'Penalty Kicks'
      WRITE(6,*)'Info [0-1] ->'
      READ(5,1010) RET
      SWV = 2
      IF (RET. EQ .'0') SWV = 0
      IF (RET. EQ .'1') SWV = 1
cx      IF (RET. EQ .'2') SWV = 2

      DO J = 7, 11
      DO I = 1, 2
          AX5(J,I) = '---'
      ENDDO
      ENDDO

      NSWT = 0

      DO J = 1, 5
          DO I = 1, 2
   80         CALL CLEAR
              WRITE(6,*)'SCORE IPOP'
              WRITE(6,*)'   Penalty Kicks'
              WRITE(6,*)' '

              DO I3 = 1, 2
                  WRITE(6,1020) TM(I3), GL(I3)
              ENDDO

              WRITE(6,*)' '
              IF(SWV. EQ .0) GOTO 77
              WRITE(6,1040) TEAM(I1), TEAM(I2)
              WRITE(6,*)' '
              
              DO I3 = 7, 11
cx                  IF (SWV. EQ .0) GOTO 79
                  WRITE(6,1050) PLYR(I1,I3), AX5(I3,1),
     *                          PLYR(I2,I3), AX5(I3,2)
                  IF(NSWT.EQ.1) WRITE(IUN,1050) PLYR(I1,I3), AX5(I3,1),
     *                          PLYR(I2,I3), AX5(I3,2)
              ENDDO

              WRITE(6,*)' '
   77         IF (NSWT. EQ .1) GOTO 70
              IF (I. EQ .1) WRITE(6,1060) PLYR(I1,J+6)
              IF (I. EQ .2) WRITE(6,1060) PLYR(I2,J+6)
   79         READ(5,1010) RET
              RND = RANDOM(NR)
              XG = INT(RND * 10.0)

              IF (XG. NE .5. AND .XG. NE .1) THEN
                  GL(I) = GL(I) +1
                  AX5(J+6,I) = ' *'
                  IF (SWV. EQ .0) GOTO 81
                  WRITE(6,*)'         G O O O A L !!!!'
              ELSE
                  AX5(J+6,I) = ' X'
                  IF (SWV. EQ .0) GOTO 81
                  RND = RANDOM(NR)
                  NF = INT(4.0 * RND)
                  IF (NF. EQ .0) WRITE(6,*)' M I S S E D   I T  !!'
                  IF (NF. EQ .1) WRITE(6,*)' P O S T  !!'
                  IF (NF. EQ .2) WRITE(6,*)' G O A L I E  !!'
                  IF (NF. EQ .3) WRITE(6,*)' O V E R  !!'
              ENDIF
         
              READ(5,1010) RET
   81         IF (J. EQ .5. AND .I. EQ .2) THEN
                  NSWT = 1
                  GOTO 80
              ENDIF

              IF (GL(1) + 5 - J. LT .GL(2). OR 
     *            .GL(1). GT .GL(2) + 7 - I - J) THEN
                  NSWT = 1
                  GOTO 80
              ENDIF

              IF (RET. EQ .'0') THEN
                  NSWT = 1
                  GOTO 80
              ENDIF

          ENDDO
      ENDDO

   70 CONTINUE

      IF (GL(1). NE .GL(2)) THEN
          WRITE(6,*)'FINAL SCORE'
          WRITE(6,*)' '
          WRITE(6,*)' '
          WRITE(6,*)'[RETURN]'
          WRITE(IUN,*)' '
          READ(5,1010) RET
          M1 = GL(1)
          M2 = GL(2)
          RETURN
      ENDIF
 
      WRITE(6,*)'Sudden Death'
      WRITE(IUN,*)'Sudden Death'
      WRITE(6,*)'Info req[0,1]--> '
      READ(5,1010) RET
      SWV = 2
      IF (RET. EQ .'0') SWV = 0
      IF (RET. EQ .'1') SWV = 1

      NSWT = 0

      DO J = 1, 16
          KJ = 7 - J
          IF (J. GE .7) KJ = 16 - J
          DO I = 1, 2
   85         CALL CLEAR
              WRITE(6,*)'SCORE IPOP'
              WRITE(6,*)'  Sudden Death' 
              WRITE(6,*)' '

              DO I3 = 1, 2
                  WRITE(6,1020) TM(I3), GL(I3)
                  IF(NSWT.EQ.1) WRITE(IUN,1020) TM(I3), GL(I3)
              ENDDO

              WRITE(6,*)' '
              IF(NSWT. EQ .1) GOTO 95
cx              WRITE(6,1040) TEAM(I1), TEAM(I2)
cx   77         WRITE(6,*)' '
cx              
cx              DO I3 = 7, 11
cx                  IF (SWV. EQ .0) GOTO 79
cx                  WRITE(6,1050) PLYR(I1,I3), AX5(I3,1),
cx     *                          PLYR(I2,I3), AX5(I3,2)
cx              ENDDO

cx              WRITE(6,*)' '
              IF (SWV. EQ .0) GOTO 86
              IF (I. EQ .1) WRITE(6,1060) PLYR(I1,KJ)
              IF (I. EQ .2) WRITE(6,1060) PLYR(I2,KJ)
              READ(5,1010) RET
   86         RND = RANDOM(NR)
              XG = INT(RND * 10.0)

              IF (XG. NE .5. AND .XG. NE .1) THEN
                  GL(I) = GL(I) +1
                  AX5(J+6,I) = ' *'
                  IF (SWV. EQ .0) GOTO 87
                  WRITE(6,*)'      G O O O A L  !!!!'
              ELSE
                  AX5(J+6,I) = ' X'
                  IF (SWV. EQ .0) GOTO 87
                  RND = RANDOM(NR)
                  NF = INT(4.0 * RND)
                  IF (NF. EQ .0) WRITE(6,*)' M I S S E D   I T  !!'
                  IF (NF. EQ .1) WRITE(6,*)' P O S T  !!'
                  IF (NF. EQ .2) WRITE(6,*)' G O A L I E  !!'
                  IF (NF. EQ .3) WRITE(6,*)' O V E R  !!'
              ENDIF
         
              READ(5,1010) RET
   87         CONTINUE
          IF (I. EQ .2. AND .GL(1). NE .GL(2)) THEN
              NSWT = 1
              GOTO 85
          ENDIF

          ENDDO

      ENDDO

   95 CONTINUE
 
      WRITE(6,*)'FINAL SCORE'
      WRITE(6,*)' '
      WRITE(6,*)' '
      WRITE(6,*)'[RETURN]'
      WRITE(IUN,*)' '
      READ(5,1010) RET
      M1 = GL(1)
      M2 = GL(2)

 1010 FORMAT(A)
 1020 FORMAT(1X,A12,I3)
 1030 FORMAT(1X,I2,'-',I2,' `',I3,1X,A,'(',I2,')')
 1040 FORMAT(1X,2A13)
 1050 FORMAT(1X,2(A13,A3,2X))
 1060 FORMAT(1x,'Next striker: ',A)

      RETURN
      END

C----------------------------
C     RENEW
C----------------------------
C234567
      SUBROUTINE RENEW(K, I1, I2, N1, N2)

      COMMON /ALL/ TEAM(32), LVL(32)
      COMMON /INF/ NJ(32), NG(32), NE(32), NGF(32), NGC(32)
      COMMON /GLS/ A(32,21)
      CHARACTER *12 TEAM
      INTEGER A

      A(I1,3*K-2) = I2
      A(I1,3*K-1) = N1
      A(I1,3*K)   = N2
      A(I2,3*K-2) = I1
      A(I2,3*K-1) = N2
      A(I2,3*K)   = N1
      NJ(I1)      = NJ(I1) + 1
      NJ(I2)      = NJ(I2) + 1
      NGF(I1)     = NGF(I1) + N1
      NGF(I2)     = NGF(I2) + N2
      NGC(I1)     = NGC(I1) + N2
      NGC(I2)     = NGC(I2) + N1

      IF (N1. GT .N2) NG(I1) = NG(I1) + 1
      IF (N1. LT. N2) NG(I2) = NG(I2) + 1
      IF (N1. EQ .N2) THEN
          NE(I1) = NE(I1) + 1
          NE(I2) = NE(I2) + 1
      ENDIF

      RETURN
      END

C----------------------------
C     RANDOM (function)
C----------------------------
C234567
      FUNCTION RANDOM(ISEED)

      JSEED = ISEED / 127773
      JSEED = 16807 * (ISEED - JSEED * 127773) - JSEED * 2836
      IF (JSEED. LT .0) JSEED = JSEED + 2147483647
      ISEED = JSEED
      RANDOM = JSEED * 0.4656613E-09

      RETURN
      END

