Trailing-Edge
-
PDP-10 Archives
-
decuslib10-01
-
43,50212/insrtr.f4
There are no other files named insrtr.f4 in the archive.
C SUBROUTINE INSRTR. PURPOSE-TO INSERT ONE RECORD IN A FILE
C IN ID ORDER
C PARAMETERS-IB,IHOW. IB IS TEMPORARY STORAGE FOR EACH RECORD AS IT
C IS COPIED. IHOW INDICATES WHETHER FILE IS IN ASCENDING (1) OR
C DESCENDING ORDER(-1), RANDOM ORDER(0).
C OUTPUTS-IHOW=+1
SUBROUTINE INSRTR(IB,IHOW)
DIMENSION IB(1),IPAR(10),IR(260)
COMMON IDF,LFR,NAVR,MAXR,NSPR,LSR,LFMT,NCPR,C1,C2
EQUIVALENCE (IPAR(1),IDF)
IF(IPAR(3)-IPAR(4))6,6,7
7 TYPE 100
100 FORMAT(9HFILE FULL)
CALL DMPPAR
CALL EXIT
C SAVE COPY OF RECORD TO BE INSERTED
6 IF(10*NSPR.GT.260)GO TO 1
CALL COPYR(IB,IR,10*NSPR)
ID=IB(1)
C START AT END OF FILE
LSR=NAVR-NSPR
NR=(NAVR-LFR)/NSPR
IF(NR.EQ.0.OR.IHOW.EQ.0)GO TO 14
2 DO 10 I=1,NR
CALL DIO(LSR,1,IB,NSPR)
IF(IB(1)-ID)11,11,12
13 CALL DIO(LSR+NSPR,0,IB,NSPR)
10 LSR=LSR-NSPR
GO TO 14
11 IF(IHOW)13,13,14
14 CALL COPYR(IR,IB,10*NSPR)
CALL DIO(LSR +NSPR,0,IB,NSPR)
LSR=LSR+NSPR
NAVR=NAVR+NSPR
RETURN
12 IF(IHOW)14,13,13
1 TYPE 101
101 FORMAT(1X,'RECORD BUFFER IN INSRTR TOO SMALL'/)
CALL EXIT
END