home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol266 / rmove.for < prev    next >
Encoding:
Text File  |  1986-05-19  |  1.6 KB  |  44 lines
  1.         SUBROUTINE      RMOVE(KCOL,JQ,NSET)
  2. C////////////////////////////////////////////////////////////////
  3. C/                                                              /
  4. C/      Program-id.     RMOVE                                   /
  5. C/      Date-written.   Jan. 16th 1984                          /
  6. C/      File-name.      RMOVE.FOR                               /
  7. C/      Remarks.        Subroutine RMOVE.FOR page 69.           /
  8. C/                      Subroutine RMOVE is called to remove    /
  9. C/                      an entry from file JQ of the array      /
  10. C/                      NSET.                                   /
  11. C/                                                              /
  12. C////////////////////////////////////////////////////////////////
  13. C
  14. C    * Default size of INTEGER = 2 bytes
  15. C       
  16.         INTEGER*4       NSET(6,1)
  17. C
  18.       COMMON /C1/ ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
  19.      1            NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED,
  20.      2            TNOW,TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4)
  21. C
  22.       COMMON /C2/ ATRIB(4),ENQ(4),INN(4),JCELS(5,22),KRANK(4),MAXNQ(4),
  23.      1            MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
  24.      2            QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,
  25.      3          NDAY,NYR,JCLR
  26. C
  27.         IF (KCOL) 16,16,2
  28.    16   CALL    ERROR(97,NSET)
  29.     2   MLC(JQ) = KCOL
  30. C
  31. C       --- Put values of KCOL in attrib
  32. C
  33.       DO 3 I=1,IM
  34.         ATRIB(I) = NSET(I,KCOL)
  35.         ATRIB(I) = ATRIB(I)/SCALE
  36.     3 CONTINUE
  37. C
  38. C       --- Set OUT=1 and call set to remove entry from NSET
  39. C
  40.         OUT = 1.0
  41.         CALL    SET(JQ,NSET)
  42.         RETURN
  43.         END
  44.