CAINDMFOVF3D -- VF3DPARM OPERATIONS, SUMMARY 00000400 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** C AUTHOR RALPH E. MCMILLAN 00000500 C DESIGNER RALPH E. MCMILLAN 00000600 C LANGUAGE VSFORTRAN 00000700 C SYSTEM IBM AND CRAY. 00000800 C WRITTEN 11-10-82 00000900 C REVISED COPIED FROM FOPARM. 00001000 C REVISED 07-11-83 PKC. TRANSFERRED CODE FROM FOSCDK TO HANDLE 00001010 C DIRECT USE OF MORE THAN 65536 BLOCKS. 00001020 C MARKED BY D68 AND D69 IN COLS. 69-71. 00001030 C REVISED 12-13-83 COPIED FROM FOGM3D. 00001040 C REVISED 04-24-85 JMP. VS FORTRAN VERSION WITH CAPABILITY OF 00001050 C HANDLING PARAMETER RECORDS, INLINE VELOCITY 00001060 C FIELD, AND CROSSLINE VELOCITY FIELD. ADD 00001070 C ENTRY FOVFCK FOR CHECKING VALIDITY OF CODES.00001080 C 00001100 C CALL FOVFOS (*STMT) 00001200 C *STMT= ERROR RETURN. 00001300 C OPEN BSAM DCB FOR SEQUENTIAL WRITE TO BUILD VF3DPARM FILE. 00001400 C 00001500 C CALL FOVFWS (DATA, *STMT) 00001600 C INPUT DATA = 104-WORD RECORD TO BE WRITTEN. ANY 00001700 C *STMT= ERROR RETURN. 00001800 C WRITE SEQUENTIALLY TO BUILD THE VF3DPARM FILE. 00001900 C 00002000 C CALL FOVFCS 00002100 C CLOSE THE BSAM DCB OF THE VF3DPARM FILE. 00002200 C 00002300 C CALL FOVFOD (*STMT) 00002400 C *STMT= ERROR RETURN. 00002500 C OPEN THE BDAM DCB FOR DIRECT READ AND WRITE, VF3DPARM FILE. 00002600 C 00002700 C CALL FOVFRD (DATA, CODE, DA, *STMT) 00002800 C OUTPUT DATA = 104-WORD AREA TO READ RECORD INTO. ANY 00002900 C INPUT CODE = CODE DESCRIBING WHAT TYPE OF RECORD TO 00002910 C RETURN (P, I, OR C). A1 00002920 C INPUT DA = RELATIVE RECORD NUMBER. I4 00003000 C *STMT= ERROR RETURN. 00003100 C READ INTO DATA THE RECORD WITH RELATIVE RECORD NUMBER DA ON 00003200 C THE VF3DPARM FILE. 00003300 C 00003400 C CALL FOVFWD (DATA, CODE, DA, *STMT) 00003500 C INPUT DATA = 104-WORD RECORD TO BE WRITTEN. ANY 00003600 C INPUT CODE = CODE DESCRIBING WHAT TYPE OF RECORD TO 00003610 C WRITE (P, I, OR C). A1 00003620 C INPUT DA = RELATIVE RECORD NUMBER. I4 00003700 C *STMT= ERROR RETURN. 00003800 C WRITE DIRECT FROM DATA TO RELATIVE RECORD DA ON THE VF3DPARM 00003900 C FILE. 00004000 C 00004100 C CALL FOVFCD 00004200 C CLOSE THE BDAM DCB OF THE VF3DPARM FILE. 00004300 C 00004400 C CALL FOVFCK(CODE, ISCODE) 00004410 C INPUT CODE = CODE FOR DIRECTION OF VELOCITY FIELD. A1 00004420 C OUTPUT ISCODE = RETURN ARG.(=.TRUE. IF CODE IS VALID, 00004430 C =.FALSE. OTHERWISE.) L1 00004440 C 00004450 C ALL RECORDS MUST BE WRITTEN USING THE FOVFWS ENTRY BEFORE BEING 00004500 C READ WITH FOVFRD OR REWRITTEN WITH FOVFWD. THE BSAM DCB SHOULD 00004600 C NOT BE OPEN AT THE SAME TIME OR AFTER THE BDAM DCB IS OPENED. 00004700 C A DIRECT READ OR WRITE ON A RECORD WHICH WAS NOT WRITTEN 00004800 C SEQUENTIALLY WILL RESULT IN AN ABEND WITH A SYSTEM COMPLETION 00004900 C CODE OF 001. 00005000 C 00005100 C RECORDS ARE BLOCKED BY THIS PROGRAM AND ARE ADDRESSED BY A 00005200 C RELATIVE RECORD NUMBER WHICH IS CONVERTED INTO A BLOCK NUMBER 00005300 C (RELATIVE DISK ADDRESS) AND RECORD NUMBER WHEN READING OR 00005400 C WRITING. 00005500 C 00005600 C 00005700 C DD-CARD FOR PREPARATION STEP: 00005800 C 00005900 C //VF3DPARM DD DSN=&&VF3DPARM,UNIT=SYSDA,DCB=DSORG=DA, 00006000 C // SPACE=(TRK,(10),CONTIG),DISP=(NEW,PASS) 00006100 C 00006200 C DD-CARD FOR PROCESSING STEP: 00006300 C 00006400 C //VF3DPARM DD DSN=&&VF3DPARM,DISP=(MOD,DELETE) 00006500 C 00006600 C USER ABEND CODES: 335 - BDAM I/O ERROR. SYNADF MESSAGE. 00006700 C 00006800 C STATEMENTS BEGINNING WITH "**D" WERE USED FOR DEBUGGING. 00006900 C 00007000 C 00007100 C END 00007200 C EJECT 00007300 CTITLE FOVFOS -- VF3DPARM OPEN FOR SEQ. WRITE TO BUILD FILE 00007400 CA AUTHOR RALPH E. MCMILLAN 00007500 CA DESIGNER RALPH E. MCMILLAN 00007600 CA LANGUAGE VS FORTRAN 00007700 CA SYSTEM IBM AND CRAY. 00007800 CA WRITTEN 11-10-82 00007900 CA REVISED 11-29-82 REM. REPLACE ABEND WITH ERROR JUMP FOR 00008000 CA DD MISSING. 00008100 CA 00008200 CA 00008300 CA CALL FOVFOS (*STMT) 00008400 CA 00008500 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00008600 CA 00008700 CA *STMT ERROR RETURN STATEMENT NUMBER. 00008800 CA 00008900 CA OPEN BSAM DCB FOR SEQUENTIAL WRITE TO BUILD VF3DPARM FILE. 00009000 CA 00009100 CA ALL RECORDS MUST BE WRITTEN USING THE FOVFWS ENTRY BEFORE BEING 00009200 CA READ WITH FOVFRD OR REWRITTEN WITH FOVFWD. THE BSAM DCB SHOULD 00009300 CA NOT BE OPEN AT THE SAME TIME OR AFTER THE BDAM DCB IS OPENED. 00009400 CA A DIRECT READ OR WRITE ON A RECORD WHICH WAS NOT WRITTEN 00009500 CA SEQUENTIALLY WILL RESULT IN AN ABEND WITH A SYSTEM COMPLETION 00009600 CA CODE OF 001. 00009700 CA 00009800 CA DD-CARD FOR PREPARATION STEP: 00009900 CA 00010000 CA //VF3DPARM DD DSN=&&VF3DPARM,UNIT=SYSDA,DCB=DSORG=DA, 00010100 CA // SPACE=(TRK,(10),CONTIG),DISP=(NEW,PASS) 00010200 CA 00010300 CA DD-CARD FOR PROCESSING STEP: 00010400 CA 00010500 CA //VF3DPARM DD DSN=&&VF3DPARM,DISP=(MOD,DELETE) 00010600 CA 00010700 CAEND 00010800 C EJECT 00010900 CTITLE FOVFWS -- VF3DPARM WRITE SEQUENTIALLY TO BUILD FILE 00011000 CA AUTHOR RALPH E. MCMILLAN 00011100 CA DESIGNER RALPH E. MCMILLAN 00011200 CA LANGUAGE VS FORTRAN 00011300 CA SYSTEM IBM AND CRAY. 00011400 CA WRITTEN 11-10-82 00011500 CA REVISED 11-29-82 SAS. REPLACED ABEND WITH ERROR JUMP FOR 00011600 CA DD MISSING. 00011700 CA 00011800 CA 00011900 CA CALL FOVFWS (DATA, *STMT) 00012000 CA 00012100 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00012200 CA 00012300 CA OUT DATA 104-WORD RECORD TO BE WRITTEN. ANY 00012400 CA *STMT ERROR RETURN STATEMENT NUMBER. 00012500 CA TYPE 00012600 CA 00012700 CA WRITE SEQUENTIALLY TO BUILD THE VF3DPARM FILE. 00012800 CA 00012900 CA ALL RECORDS MUST BE WRITTEN USING THE FOVFWS ENTRY BEFORE BEING 00013000 CA READ WITH FOVFRD OR REWRITTEN WITH FOVFWD. THE BSAM DCB SHOULD 00013100 CA NOT BE OPEN AT THE SAME TIME OR AFTER THE BDAM DCB IS OPENED. 00013200 CA A DIRECT READ OR WRITE ON A RECORD WHICH WAS NOT WRITTEN 00013300 CA SEQUENTIALLY WILL RESULT IN AN ABEND WITH A SYSTEM COMPLETION 00013400 CA CODE OF 001. 00013500 CA 00013600 CA AN INTERNAL SEQUENTIAL COUNTER IS USED FOR SEQUENTIAL WRITES IN 00013700 CA ORDER TO DETERMINE BLOCK AND RECORD NUMBERS. 00013800 CA 00013900 CA DD-CARD FOR PREPARATION STEP: 00014000 CA 00014100 CA //VF3DPARM DD DSN=&&VF3DPARM,UNIT=SYSDA,DCB=DSORG=DA, 00014200 CA // SPACE=(TRK,(10),CONTIG),DISP=(NEW,PASS) 00014300 CA 00014400 CA DD-CARD FOR PROCESSING STEP: 00014500 CA 00014600 CA //VF3DPARM DD DSN=&&VF3DPARM,DISP=(MOD,DELETE) 00014700 CA 00014800 CA 00014900 CAEND 00015000 C EJECT 00015100 CTITLE FOVFCS -- VF3DPARM CLOSE SEQUENTIAL 00015200 CA AUTHOR RALPH E. MCMILLAN 00015300 CA DESIGNER RALPH E. MCMILLAN 00015400 CA LANGUAGE VS FORTRAN 00015500 CA SYSTEM IBM AND CRAY. 00015600 CA WRITTEN 11-10-82 00015700 CA 00015800 CA 00015900 CA CALL FOVFCS 00016000 CA 00016100 CA 00016200 CA WRITE THE CURRENT BUFFER IF NECESSARY AND CLOSE THE BSAM DCB OF 00016300 CA THE VF3DPARM FILE. 00016400 CAEND 00016500 C EJECT 00016600 CTITLE FOVFOD -- VF3DPARM OPEN FOR DIRECT READ AND WRITE 00016700 CA AUTHOR RALPH E. MCMILLAN 00016800 CA DESIGNER RALPH E. MCMILLAN 00016900 CA LANGUAGE VS FORTRAN 00017000 CA SYSTEM IBM AND CRAY. 00017100 CA WRITTEN 11-10-82 00017200 CA 00017300 CA 00017400 CA CALL FOVFOD (*STMT) 00017500 CA 00017600 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00017700 CA 00017800 CA *STMT ERROR RETURN STATEMENT NUMBER. 00017900 CA 00018000 CA 00018100 CA 00018200 CA OPEN THE BDAM DCB FOR DIRECT READ AND WRITE, VF3DPARM FILE. 00018300 CA IF THIS IS THE PREPARATION STEP (MAXBLK NOT = 0), THEN STORE THE 00018400 CA MAXIMUM BLOCK AND RECORD NUMBERS IN THE FIRST RECORD ON THE FILE. 00018500 CA IF THIS IS THE PROCESS STEP (MAXBLK = 0), THEN RETRIEVE THE 00018600 CA MAXIMUM BLOCK AND RECORD NUMBERS FROM THE FIRST RECORD ON THE 00018700 CA FILE. 00018800 CA 00018900 CA ALL RECORDS MUST BE WRITTEN USING THE FOVFWS ENTRY BEFORE BEING 00019000 CA READ WITH FOVFRD OR REWRITTEN WITH FOVFWD. THE BSAM DCB SHOULD 00019100 CA NOT BE OPEN AT THE SAME TIME OR AFTER THE BDAM DCB IS OPENED. 00019200 CA A DIRECT READ OR WRITE ON A RECORD WHICH WAS NOT WRITTEN 00019300 CA SEQUENTIALLY WILL RESULT IN AN ABEND WITH A SYSTEM COMPLETION 00019400 CA CODE OF 001. 00019500 CA 00019600 CA DD-CARD FOR PREPARATION STEP: 00019700 CA 00019800 CA //VF3DPARM DD DSN=&&VF3DPARM,UNIT=SYSDA,DCB=DSORG=DA, 00019900 CA // SPACE=(TRK,(10),CONTIG),DISP=(NEW,PASS) 00020000 CA 00020100 CA DD-CARD FOR PROCESSING STEP: 00020200 CA 00020300 CA //VF3DPARM DD DSN=&&VF3DPARM,DISP=(MOD,DELETE) 00020400 CA 00020500 CA 00020600 CAEND 00020700 C EJECT 00020800 CTITLE FOVFRD -- VF3DPARM READ TRACE HEADER DIRECT 00020900 CA AUTHOR RALPH E. MCMILLAN 00021000 CA DESIGNER RALPH E. MCMILLAN 00021100 CA LANGUAGE VS FORTRAN 00021200 CA LANGUAGE IBM AND CRAY. 00021300 CA WRITTEN 11-10-82 00021400 CA 00021500 CA 00021600 CA CALL FOVFRD (DATA, CODE, DA, *STMT) 00021700 CA 00021800 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00021900 CA 00022000 CA OUT DATA ANY 104-WORD AREA TO READ RECORD INTO. 00022100 CA IN CODE A1 CODE DESCRIBING THE TYPE OF RECORD TO BE 00022110 CA RETURNED. (P, I, OR C). 00022120 CA IN/OUT DA I4 RELATIVE RECORD NUMBER. RETURNED AS 00022200 CA DA + 1. 00022300 CA *STMT ERROR RETURN STATEMENT NUMBER. 00022400 CA 00022500 CA 00022600 CA THE RELATIVE RECORD NUMBER IS CONVERTED TO A BLOCK AND RECORD 00022700 CA NUMBER. THE BLOCK IS READ INTO THE CURRENT BUFFER AND THE 00022800 CA APPROPRIATE RECORD IS RETURNED IN DATA. THE NEXT RELATIVE RECORD 00022900 CA NUMBER IS RETURNED IN DA. THE CODE TELLS FOVFRD WHICH SECTION ON 00023000 CA THE VF3DPARM FILE TO RETRIEVE THE RECORD FROM. ('P' = PARAMETER 00023010 CA RECORDS, 'I' = INLINE VELOCITY FIELD, 'C' = CROSSLINE VELOCITY 00023020 CA FIELD.) 00023030 CA 00023100 CA ALL RECORDS MUST BE WRITTEN USING THE FOVFWS ENTRY BEFORE BEING 00023200 CA READ WITH FOVFRD OR REWRITTEN WITH FOVFWD. THE BSAM DCB SHOULD 00023300 CA NOT BE OPEN AT THE SAME TIME OR AFTER THE BDAM DCB IS OPENED. 00023400 CA A DIRECT READ OR WRITE ON A RECORD WHICH WAS NOT WRITTEN 00023500 CA SEQUENTIALLY WILL RESULT IN AN ABEND WITH A SYSTEM COMPLETION 00023600 CA CODE OF 001. 00023700 CA 00023800 CA DD-CARD FOR PREPARATION STEP: 00023900 CA 00024000 CA //VF3DPARM DD DSN=&&VF3DPARM,UNIT=SYSDA,DCB=DSORG=DA, 00024100 CA // SPACE=(TRK,(10),CONTIG),DISP=(NEW,PASS) 00024200 CA 00024300 CA DD-CARD FOR PROCESSING STEP: 00024400 CA 00024500 CA //VF3DPARM DD DSN=&&VF3DPARM,DISP=(MOD,DELETE) 00024600 CA 00024700 CA 00024800 CA USER ABEND CODES: 333 - BSAM DCB OPEN NOT COMPLETED. DD MISSING. 00024900 CA 334 - BDAM DCB OPEN NOT COMPLETED. DD MISSING. 00025000 CA 334 - BDAM DCB OPEN NOT COMPLETED. DD MISSING. 00025100 CAEND 00025200 C EJECT 00025300 CTITLE FOVFWD -- VF3DPARM WRITE TRACE HEADER DIRECT 00025400 CA AUTHOR RALPH E. MCMILLAN 00025500 CA DESIGNER RALPH E. MCMILLAN 00025600 CA LANGUAGE VS FORTRAN 00025700 CA LANGUAGE IBM AND CRAY. 00025800 CA WRITTEN 11-10-82 00025900 CA 00026000 CA 00026100 CA CALL FOVFWD (DATA, CODE, DA, *STMT) 00026200 CA 00026300 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00026400 CA 00026500 CA OUT DATA ANY 104-WORD AREA TO BE WRITTEN. 00026600 CA IN CODE A1 CODE DESCRIBING THE TYPE OF RECORD TO BE 00026610 CA WRITTEN. (P, I, OR C). 00026620 CA IN/OUT DA I4 RELATIVE RECORD NUMBER. RETURNED AS 00026700 CA DA + 1. 00026800 CA *STMT ERROR RETURN STATEMENT NUMBER. 00026900 CA 00027000 CA 00027100 CA THE RELATIVE RECORD NUMBER IS CONVERTED TO A BLOCK AND RECORD 00027200 CA NUMBER. IF THE BLOCK NUMBER DOES NOT AGREE WITH THE CURRENT 00027300 CA BLOCK IN THE WRITE BUFFER, THE CORRECT BLOCK IS READ DIRECT 00027400 CA FROM THE DISK. THE RECORD IS THEN MOVED INTO ITS APPROPRIATE 00027500 CA PLACE. THE NEXT SEQUENTIAL RECORD NUMBER IS RETURNED IN DA. 00027600 CA THE CODE TELLS WHICH SECTION OF THE VF3DPARM FILE TO PUT THE 00027610 CA RECORD ('P' = PARAMETER RECORDS, 'I' = INLINE VELOCITY FIELD, 00027620 CA 'C' = CROSSLINE VELOCITY FIELD.) 00027630 CA 00027700 CA ALL RECORDS MUST BE WRITTEN USING THE FOVFWS ENTRY BEFORE BEING 00027800 CA READ WITH FOVFRD OR REWRITTEN WITH FOVFWD. THE BSAM DCB SHOULD 00027900 CA NOT BE OPEN AT THE SAME TIME OR AFTER THE BDAM DCB IS OPENED. 00028000 CA A DIRECT READ OR WRITE ON A RECORD WHICH WAS NOT WRITTEN 00028100 CA SEQUENTIALLY WILL RESULT IN AN ABEND WITH A SYSTEM COMPLETION 00028200 CA CODE OF 001. 00028300 CA 00028400 CA DD-CARD FOR PREPARATION STEP: 00028500 CA 00028600 CA //VF3DPARM DD DSN=&&VF3DPARM,UNIT=SYSDA,DCB=DSORG=DA, 00028700 CA // SPACE=(TRK,(10),CONTIG),DISP=(NEW,PASS) 00028800 CA 00028900 CA DD-CARD FOR PROCESSING STEP: 00029000 CA 00029100 CA //VF3DPARM DD DSN=&&VF3DPARM,DISP=(MOD,DELETE) 00029200 CA 00029300 CA 00029400 CA USER ABEND CODES: 333 - BSAM DCB OPEN NOT COMPLETED. DD MISSING. 00029500 CA 334 - BDAM DCB OPEN NOT COMPLETED. DD MISSING. 00029600 CA 334 - BDAM DCB OPEN NOT COMPLETED. DD MISSING. 00029700 CAEND 00029800 C EJECT 00029900 CTITLE FOVFCD -- VF3DPARM CLOSE DIRECT ACCESS 00030000 CA AUTHOR RALPH E. MCMILLAN 00030100 CA DESIGNER RALPH E. MCMILLAN 00030200 CA LANGUAGE VS FORTRAN 00030300 CA LANGUAGE IBM AND CRAY. 00030400 CA WRITTEN 11-10-82 00030500 CA 00030600 CA 00030700 CA CALL FOVFCD 00030800 CA 00030900 CA 00031000 CA WRITE THE CURRENT BUFFER IF NECESSARY AND CLOSE THE BDAM DCB OF 00031100 CA THE VF3DPARM FILE. 00031200 CAEND 00031300 C 00031400 CTITLE FOVFCK -- CHECK CODE FOR VELOCITY ACCESS 00031410 CA AUTHOR J. M. PONTON 00031420 CA DESIGNER J. M. PONTON 00031430 CA LANGUAGE VS FORTRAN 00031440 CA LANGUAGE IBM AND CRAY. 00031450 CA WRITTEN 06-20-85 00031460 CA 00031470 CA 00031480 CA CALL FOVFCK(CODE, ISCODE) 00031490 CA 00031491 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00031492 CA 00031493 CA IN CODE A1 CODE FOR DIRECTION OF VELOCITY ACCESS. 00031494 CA ('C' = CROSSLINE VELS. 00031495 CA 'I' = INLINE VELS. 00031496 CA 'P' = VF3D PARAMETER RECORDS.) 00031497 CA 00031498 CA OUT ISCODE L1 =.TRUE. IF 'CODE' IS PRESENT ON VF3D FILE,00031499 CA =.FALSE. OTHERWISE. 00031500 CA 00031501 CA 00031502 CA CHECK FOR PRESENCE OF 'CODE' TYPE RECORDS ON VF3DPARM FILE. 00031503 CAEND 00031505 C 00031506 SUBROUTINE FOVF3D 00031510 C 00031600 IMPLICIT INTEGER (A-Z) 00031700 C 00031800 REAL X 00031900 DIMENSION NRECS(3) 00032000 DIMENSION INDREC(3) 00032100 DIMENSION REC(104) 00032110 C 00032200 CHARACTER*(*) CODE 00032300 CHARACTER*1 CODTAB(3) 00032400 CHARACTER*20 DIRCHK 00032500 C 00032600 LOGICAL ISCODE 00032610 LOGICAL OPEN 00032620 LOGICAL MYOPEN 00032630 C 00032700 DATA DIRCHK/'VF3DPARM DIRECTORY'/ 00032800 DATA CODTAB/'P', 'I', 'C'/ 00032900 DATA NCODE/3/ 00032910 DATA OPEN /.FALSE./ 00032911 C 00032920 C DUMMY CALL TO FOXX3D TO INSURE THAT IT WILL BE LOADED. 00032930 C 00032940 IF (1 .EQ. 2) CALL FOXX3D 00032950 C 00033000 C ************************ 00033010 C *** *** 00033020 C *** ENTRY FOVFOS *** 00033030 C *** *** 00033040 C ************************ 00033050 C 00033060 ENTRY FOVFOS(*) 00033100 C 00033200 CALL FOXXOS(*1000) 00033300 RETURN 00033400 C 00033500 C ************************ 00033600 C *** *** 00033700 C *** ENTRY FOVFOS *** 00033800 C *** *** 00033900 C ************************ 00034000 C 00034100 ENTRY FOVFWS(DATA, *) 00034200 C 00034300 CALL FOXXWS(DATA, *1000) 00034400 RETURN 00034500 C 00034600 C ************************ 00034700 C *** *** 00034800 C *** ENTRY FOVFCS *** 00034900 C *** *** 00035000 C ************************ 00035100 C 00035200 ENTRY FOVFCS 00035210 C 00035220 CALL FOXXCS 00035300 RETURN 00035400 C 00035500 C ************************ 00035600 C *** *** 00035700 C *** ENTRY FOVFOD *** 00035800 C *** *** 00035900 C ************************ 00036000 C 00036100 ENTRY FOVFOD(*) 00036200 C 00036300 MYOPEN = .FALSE. 00036301 IF (OPEN) RETURN 00036310 CALL FOXXOD(*1000) 00036400 OPEN = .TRUE. 00036401 MYOPEN = .TRUE. 00036402 LDIR = 0 00036410 C 00036500 C READ FIRST RECORD (IT MAY BE A DIRECTORY RECORD). 00036600 C 00036700 RECNO = 1 00036710 CALL FOXXRD(REC, RECNO, *1000) 00036800 C 00036810 C USVFUS SETS THE USER PROCNAME AND NUMBER IN ITS OWN LIST. 00036820 C 00036830 CALL USVFUS 00036840 C 00036900 C SET RECORD INDICES. 00037000 C 00037100 INDREC(1) = 1 00037110 INDREC(2) = 1 00037200 INDREC(3) = 0 00037300 C 00037410 DO 15 I = 1, 3 00037420 NRECS(I) = 0 00037430 15 CONTINUE 00037440 NRECS(2) = 999999 00037450 C 00037500 C CHECK FOR DIRECTORY RECORD INDICATOR. 00037600 C 00037700 IF (S1CPCH(REC, 1, DIRCHK, 1, 20) .NE. 0) GO TO 40 00037800 C 00037900 C PICK UP FIELDS OFF DIRECTORY RECORD. 00038000 C 00038100 LDIR = REC(6) 00038300 IF (LDIR .EQ. 0) GO TO 40 00038310 C 00038400 C GET REMAINDER OF DIRECTORY. 00038500 C 00038600 DO 20 I = 1, LDIR 00038700 INDX = 6 + I 00038900 NRECS(I) = REC(INDX) 00039000 20 CONTINUE 00039100 C 00039200 C SET UP RECORD INDICES. 00039300 C 00039400 DO 30 I = 2, LDIR 00039600 INDREC(I) = INDREC(I - 1) + NRECS(I - 1) 00039700 30 CONTINUE 00039800 C 00039900 40 CONTINUE 00040000 C 00040100 RETURN 00040200 C 00040300 C ************************ 00040500 C *** *** 00040600 C *** ENTRY FOVFRD *** 00040700 C *** *** 00040800 C ************************ 00040900 C 00041000 ENTRY FOVFRD(DATA, CODE, DA, *) 00041100 C 00041200 C CHECK CODTAB FOR VALID CODE. 00041300 C 00041400 DO 50 I = 1, NCODE 00041500 IF (CODE(1:1) .EQ. CODTAB(I)) THEN 00041600 MYREC = DA + INDREC(I) 00041700 MAXREC = NRECS(I) 00041710 GO TO 70 00041800 ENDIF 00041900 50 CONTINUE 00042000 C 00042100 C INVALID CODE. BOMB IT OFF. 00042200 C 00042300 WRITE (6, 60) CODE(1:1) 00042400 60 FORMAT(' *** ERROR *** FOVFRD: UNKNOWN CODE...',A1) 00042500 CALL XDUMPX 00042600 C 00042700 70 CONTINUE 00042800 IF (DA .GT. MAXREC) GO TO 1000 00042810 C 00042900 C READ RECORD FROM VF3DPARM. 00043000 C 00043100 CALL FOXXRD(DATA, MYREC, *1000) 00043200 DA = MYREC - INDREC(I) 00043300 C 00043400 RETURN 00043500 C 00043600 C ************************ 00043700 C *** *** 00043800 C *** ENTRY FOVFWD *** 00043900 C *** *** 00044000 C ************************ 00044100 C 00044200 ENTRY FOVFWD(DATA, CODE, DA, *) 00044300 C 00044400 C CHECK CODTAB FOR VALID CODE. 00044500 C 00044600 DO 80 I = 1, NCODE 00044700 IF (CODE(1:1) .EQ. CODTAB(I)) THEN 00044800 MYREC = DA + INDREC(I) 00044900 GO TO 100 00045000 ENDIF 00045100 80 CONTINUE 00045200 C 00045300 C INVALID CODE. BOMB IT OFF. 00045400 C 00045500 WRITE (6, 90) CODE(1:1) 00045600 90 FORMAT(' *** ERROR *** FOVFWD: UNKNOWN CODE...',A1) 00045700 CALL XDUMPX 00045800 C 00045900 100 CONTINUE 00046000 C 00046100 C WRITE RECORD TO VF3DPARM. 00046200 C 00046300 CALL FOXXWD(DATA, MYREC, *1000) 00046400 DA = MYREC - INDREC(I) 00046500 C 00046600 RETURN 00046700 C 00046800 C ************************ 00046900 C *** *** 00047000 C *** ENTRY FOVFCD *** 00047100 C *** *** 00047200 C ************************ 00047300 C 00047400 ENTRY FOVFCD 00047500 C 00047600 CALL FOXXCD 00047700 OPEN = .FALSE. 00047710 MYOPEN = .FALSE. 00047720 RETURN 00047800 C 00047900 C 00047910 C ************************ 00047920 C *** *** 00047930 C *** ENTRY FOVFCK *** 00047940 C *** *** 00047950 C ************************ 00047960 C 00047970 ENTRY FOVFCK(CODE, ISCODE) 00047980 C 00047990 ISCODE = .FALSE. 00047991 C 00047992 IF (LDIR .EQ. 0) GO TO 130 00047993 C 00047994 DO 120 I = 1, LDIR 00047995 IF (CODE .NE. CODTAB(I)) GO TO 120 00047996 ISCODE = .TRUE. 00047997 GO TO 130 00047998 120 CONTINUE 00047999 C 00048000 130 CONTINUE 00048001 C 00048002 RETURN 00048003 C 00048004 C 00048005 C ************************ 00048006 C *** *** 00048007 C *** ENTRY FOVFQT *** 00048008 C *** *** 00048009 C ************************ 00048010 C 00048011 ENTRY FOVFQT 00048012 C 00048013 IF (OPEN .AND. MYOPEN) THEN 00048014 CALL FOXXCD 00048015 OPEN = .FALSE. 00048016 MYOPEN = .FALSE. 00048017 ENDIF 00048018 C 00048019 RETURN 00048020 C 00048021 1000 CONTINUE 00048030 C 00048100 C TAKE ERROR EXIT. 00048200 C 00048300 RETURN 1 00048400 END 00048500