@HDG,P GOFM @FOR,IS GOFM SUBROUTINE GOFM (COMPAR,IO,MORD,LIST,OUTFIL) C C GENERAL ORDER FILE MERGE. C 18 MAY 1972 VERSION. C C COMPAR IS THE COMPARE ROUTINE USED BY SORT AND FSORT(X). C C IO IS THE I/O ROUTINE USED BY FSORT(X). C IO OPERATIONS 2 3 AND 4 ARE THE ONLY OPERATIONS USED. C C MORD IS THE MERGE ORDER (NUMBER OF FILES TO MERGE). C C LIST IS THE LIST NEEDED BY SORT, BUT MUST BE 2*MORD WORDS LONG. C C OUTFIL IS THE OUTPUT FILE NUMBER. BEWARE?? IF OUTFIL IS BETWEEN C 1 AND MORD, IT MAY CONFLICT WITH AN INPUT FILE. C IMPLICIT INTEGER (A-Z) INTEGER LIST (1) EXTERNAL COMPAR, IO C C READ ONE RECORD FROM EACH FILE. COMPENSATE FOR VOID FILES. C M=1 DO 10 I=1,MORD K=IO(4,I,M) IF (K.NE.0) GO TO 10 @ COMPENSATE FOR VOID FILES. LIST(M+MORD)=I @ KEEP TRACK OF FILE - AREA ASSOCIATION. M=M+1 10 CONTINUE IF (K.NE.0) M=M-1 IF (M.EQ.0) GO TO 30 C C SORT THE FIRST RECORD FROM EACH FILE. C M=SORT(LIST,M,COMPAR) C C WRITE THE HEAD OF CHAIN. C 20 K=IO(2,OUTFIL,M) K=IO(4,LIST(MORD+M),M) @ READ FROM FILE CORRESPONDING TO HEAD C C MERGE THE NEW RECORD FROM THE FILE WITH THE CHAIN. C I=LIST(M) IF (K.EQ.0) GO TO 40 @ HAS FILE M ENDED IF (I.EQ.0) GO TO 30 M=I GO TO 20 C C ALL DONE. C 30 K=IO(3,OUTFIL,0) RETURN C C FILE M HAS NOT ENDED. MERGE IT'S NEXT RECORD WITH THE CHAIN. C 40 IF (I.EQ.0) GO TO 20 @ M IS ONLY REMAINING FILE. IF (COMPAR(M,I)) 20,20 K=M M=I 50 J=LIST(I) IF (J.NE.0) GO TO 70 60 LIST(I)=K LIST(K)=J @ UPDATE THE CHAIN GO TO 20 70 IF (COMPAR(K,J)) 60,60 I=J GO TO 50 END