      INCLUDE 'VICMAIN_FOR'
      SUBROUTINE MAIN44
      INCLUDE 'fortport'
C     PROGRAM TO PRODUCE DISCRETE LEVEL NOISE
C
      INTEGER PBUF(2,256)
      REAL*4  THRESH(256),RANNUM
      BYTE OUT(3600),LNOV(256)
      INTEGER LOG,IO
      EQUIVALENCE (NVAL,LOG)
C
      CALL IFMESSAGE('POLYNOIS version 05-SEP-94')
C
      CALL XVEACTION('SA',' ')
      CALL XVPARM('SEEDS',IO,ICNT,IDEF,2)
      IO = 0
      CALL XVPARM('NOISE',PBUF,ICNT,IDEF,512)
      NLEV=ICNT/2
      IF (NLEV * 2 .NE. ICNT) THEN
          CALL XVMESSAGE(
     + '*** ERROR-NOISE PARAMETERS MUST COME IN PAIRS',' ')
          CALL ABEND
      END IF
C     DETERMINE THE NOISE LEVELS AND PROBABILITIES
      VN=0.0
      DO I=1,NLEV
           NVAL=PBUF(1,I)
           IF((NVAL.LT.0).AND.(NVAL.GT.255)) THEN
               CALL XVMESSAGE(
     + '*** INVALID NOISE INTENSITY LEVEL',' ')
               CALL ABEND
           END IF
C     FIX INTEGER OVERFLOW PROBLEM i.e. log=140
C     (USE SUBROUTINE ITLA INSTEAD OF "=")
C          LNOV(I)=LOG
           CALL ITLA(LOG,LNOV(I),1)
C           LNOV(I)=INT2BYTE(LOG)
           THRESH(I)=PBUF(2,I)
           IF(THRESH(I).LE.0.0) THEN
              CALL XVMESSAGE('*** NONPOSITIVE NOISE PROBABILITY',' ')
              CALL ABEND
           END IF
           VN=VN+THRESH(I)
      END DO
C     DETERMINE NOISE PROB. AS RATIO AGAINST TOTAL ACCUMULATIVE PROBS.
      V=0.0
      DO I=1,NLEV
           V=V+THRESH(I)/VN
           THRESH(I)=V
      END DO
      CALL XVPARM('NSO',NSO,ICNT,IDEF,1)
      CALL XVPARM('NLO',NLO,ICNT,IDEF,1)
      IF((NSO.LE.0).OR.(NLO.LE.0)) THEN
          CALL XVMESSAGE('*** INVALID SIZE FIELD PARAMETERS',' ')
          CALL ABEND
      END IF
      CALL XVUNIT(OUTUNIT,'OUT',1,STATUS,' ')
      CALL XVOPEN(OUTUNIT,STATUS,'OP','WRITE','U_NL',NLO,'U_NS',
     +NSO,'O_FORMAT','BYTE','U_FORMAT','BYTE',' ') 
C     FOR THE FIRST PROB. GREATER THAN THE RANDOM NUMBER, THE
C     ASSOCIATED NOISE INTENSITY LEVEL IS GENERATED.
      DO I=1,NLO
         DO 10 J=1,NSO
                 CALL RANGEN(IO,RANNUM)
                 V=RANNUM
                   DO K=1,NLEV
                        IF(V.LT.THRESH(K)) GO TO 10
                   END DO 
                CALL XVMESSAGE('*** NOISE ENCODING ERROR',' ')
                CALL ABEND
   10    OUT(J)=LNOV(K)
         CALL XVWRIT(OUTUNIT,OUT,STATUS,'NSAMPS',NSO,' ')
      END DO
      CALL XVMESSAGE('*** POLYNOIS TASK COMPLETED',' ')
      END
