home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol266 / filem.for < prev    next >
Encoding:
Text File  |  1986-05-19  |  1.7 KB  |  46 lines
  1.         SUBROUTINE      FILEM(JQ,NSET)
  2. C////////////////////////////////////////////////////////////////
  3. C/                                                              /
  4. C/      Program-id.     FILEM                                   /
  5. C/      Date-written.   Jan. 16th 1984                          /
  6. C/      File-name.      FILEM.FOR                               /
  7. C/      Remarks.        Subroutine FILEM.FOR page 68.           /
  8. C/                      FILEM is called to file an entry in     /
  9. C/                      file JQ of the array NSET.              /
  10. C/                                                              /
  11. C////////////////////////////////////////////////////////////////
  12. C       
  13.         INTEGER*4       NSET(6,1)
  14. C
  15.       COMMON /C1/ID,IM,INIT,JEVNT,JMNIT,MFA,MSTOP,MX,MXC,NCLCT,NHIST,
  16.      1           NOQ,NORPT,NOT,NPRMS,NRUN,NRUNS,NSTAT,OUT,SCALE,ISEED,
  17.      2           TNOW,TBEG,TFIN,MXX,NPRNT,NCRDR,NEP,VNQ(4)
  18. C
  19.       COMMON /C2/ATRIB(4),ENQ(4),INN(4),JCELS(5,22),KRANK(4),MAXNQ(4),
  20.      1           MFE(4),MLC(4),MLE(4),NCELS(5),NQ(4),PARAM(20,4),
  21.      2           QTIME(4),SSUMA(10,5),SUMA(10,5),NAME(6),NPROJ,MON,
  22.      3         NDAY,NYR,JCLR
  23. C
  24. C
  25. C       --- Test to see if there is an avilable column for storage.
  26. C
  27.         IF (MFA .GT. ID) GO TO 10
  28.         WRITE(NPRNT,100)
  29.   100     FORMAT(//24H Overlap Set Given Below/)
  30.         CALL    ERROR(87,NSET)
  31. C
  32. C       --- Put attribute value in file
  33. C
  34.    10 DO 1 I=1,IM
  35.         DEL = 0.000001
  36.         IF (ATRIB(I).GE.0) GO TO 20
  37.         DEL = -0.000001
  38.    20   NSET(I,MFA) = SCALE * (ATRIB(I) + DEL)
  39.    30 CONTINUE
  40. C
  41. C       --- Call SET to put new entry in proper place in NSET
  42. C
  43.         CALL SET (JQ,NSET)
  44.         RETURN
  45.         END
  46.