
                               					27-Sep-1990 12:17:05	VAX FORTRAN V4.7-271                Page   1
								27-Jan-1989 07:48:20	DRA0:[APP.DSFC.SRC]DSFCVAX.SRC;1            

0001          PROGRAM DSFC
0002    C           ---------  G E N E R A L   D E S C R I P T I O N  -----
0003    C    THE DINKEY SEARCHING FILE COMPARE IS DESIGNED TO ENHANCE QUALITY
0004    C    ASSURANCE FUNCTIONS ON SOFTWARE.  SPECIFICALLY, THE PROGRAM
0005    C    CAUSES TWO FILES TO BE COMPARED TO BE READ INTO RESPECTIVE
0006    C    ARRAYS;  MATCHES ARE THEN FOUND (OR NOT FOUND) AND THE
0007    C    RESULTING DIFFERENCES ARE THEN PRINTED IN THE STANDARD
0008    C    ENGINEERING 'IS/WAS' FORMAT FOR VISUAL VERIFICATION.
0009    C
0010    C
0011    C
0012    C    THE KEY TO THE PROGRAM COMPARISON IS THAT THE PROGRAM DOES
0013    C    NOT MERELY COMPARE, BUT ALSO ACCOUNTS FOR MISSING OR INSERTED
0014    C    RECORDS. OUTPUT IS IN 'IS/WAS' FORMAT FOR ECO REQUIREMENTS.
0015    C
0016    C  NOTE ---- PROGRAM MAY BE TERMINATED BY 'CTRL-C'
0017    C
0018    C     ----------   UPDATING INFORMATION   -------------
0019    C     INITIALS   DATE             ITEM
0020    C       JVD      11/10/78    INPUT PARAMETERS ON 'TIME STAMP' LINE
0021    C        "           "       REMOVE BIAS FROM COMPARE
0022    C        "           "       GIVE RECORD NUMBER ON EACH LINE
0023    C       JVD       12/7/78    FIX E-O-F ROUTINES
0024    C        "        12/13/78   SCREEN PROMPTS WHILE RUNNING
0025    C        "            "      WRAP 'FILES USED' MESSAGE
0026    C       JVD       08/8/80    ADJUST TO 132 CHARACTER INPUT (WAS 80)
0027    C        "            "      ALLOW FOR LESS THAN AN ARRAY OF DATA
0028    C        "            "      ELIMINATE CRT PROMPTS FOR IBM
0029    C       JVD       09/28/82   CORRECT NUMBERING WITHIN ARRAY WITH EOF
0030    C        "            "      CORR NON-COMPARE ON LAST ENTRY EVEN FILES
0031    C       JVD       11/17/82   MULTIPLE ITERATIVE PROGRAMMER SEQUENCES
0032    C                   8/86     MOVED TO VAX SYSTEM
0033    C       ADH       01/16/89   MODIFIED IBM FORTRAN G TO VAX FORTRAN 77
0034    C        "            "      ADDED CTRL-C TRAP AND COMMAND LINE DECODE
0035    C        "            "      ADDED CODE TO VERIFY EXISTANCE OF IS/WAS
0036    C                            FILES
0037    C
0038    C
0039    C           ---- P R O G R A M M E R   I N F O R M A T I O N ---------
0040    C
0041    C    THE ARRAY SIZES CAN BE CHANGED BY SETTING THE VARIABLES 'C' & 'Y'
0042    C         TO SOME VALUE 20 OR MORE.  AT THE SAME TIME, THE ARRAYS
0043    C         ARRAYA & ARRAYZ MUST BE SET TO (66*C) IN SIZE E.G. 66 X 20
0044    C         WORDS LONG EACH IF ARRAY IS 20 LONG.
0045    C         THE ARRAYS MUST BE THE SAME SIZE.
0046    C
0047    C           ------   V A R I A B L E S   -------
0048    C
0049    C    VALUES ARE USUALLY INTEGERS REPRESENTING LINE NUMBERS.
0050    C    VARIABLES MUST USUALLY BE MULTIPLIED BY LINE LENGTH TO
0051    C        COMPUTE ARRAY ADDRESS.
0052    C
0053    C  EOFA      END-OF-FILE SWITCH FOR FILEA
0054    C  EOFZ        "    "     "      "  FILEZ
0055    C  B         FLOATING POINTER RUNNING IN ARRAYA
0056    C  X            "        "      "     "  ARRAYZ
0057    C  C         END POINTER OF ARRAYA

                               					27-Sep-1990 12:17:05	VAX FORTRAN V4.7-271                Page   2
								27-Jan-1989 07:48:20	DRA0:[APP.DSFC.SRC]DSFCVAX.SRC;1            

0058    C  Y          "      "   "  ARRAYZ
0059    C  LA,LZ     LENGTH OF EACH ARRAY
0060    C  IA        CURRENT POINTER INTO ARRAYA
0061    C  IZ          "       "      "   ARRAYZ
0062    C  OUT_FILE  OUTPUT FILE (FROM RMPAR)
0063    C  NBEGA     POINTER TO FIRST POSITION OF SPECIFIC ARRAY LINE
0064    C  NBEGZ       "     "   "        "    "     "       "    "
0065    C  NENDA       "     "  LAST      "    "     "       "    "
0066    C  NENDZ       "     "   "        "    "     "       "    "
0067    C  I,J,K,L,M,N  ARE ALL AVAILABLE AT ALL TIMES FOR LOCAL MANIPULATION
0068    C  IGOOD     GOOD COMPARE POSITIONS IN A LINE.
0069    C  IRET      DEBUGGING RETURN FROM ARRAY PRINTER
0070    C  NRECA     RECORD COUNT OF 'A' FILE
0071    C  NRECZ       "      "   "  'Z' FILE
0072    C
0073    C                 --------   S T O P S      -------
0074    C  0000      END OF PROGRAM  NORMAL TERMINATION
0075    C  1234      LESS THAN 20 RECORDS ON AN INPUT FILE.
0076    C  2222      NO RETURN PROVIDED IN ARRAY PRINTOUT.
0077    C   713      BUG - ATTEMPTING TO WRITE OUT MORE THAN A LINE
0078    C   770      SECOND ATTEMPT TO READ E-O-F
0079    C   772      READ ERROR
0080    C   773      OPEN FAILURE ON FILES
0081    C   774      LENGTH OF INPUT RECORD GREATER THAN ALLOWED
0082    C  9999      CTRL_C PRESSED
0083    C
0084    C	INCLUDE SYSTEM SERVER DEFINITIONS FOR TRAPPINC CTRL_C
0085    C
0086          INCLUDE '($SYSSRVNAM)'
2767    C
2768    C	SETUP CTRL_C VARIABLES
2769    C
2770          INTEGER*4 TT_CHAN
2771          CHARACTER*40 TRAP_LINE
2772    C
2773          DIMENSION ARRAYA(4620),ARRAYZ(4620)
2774          DIMENSION BUFA(133),BUFZ(133)
2775          DIMENSION ITIME(5),IYEAR(1)
2776          INTEGER LENGTH
2777          INTEGER*2 ARRAYA,ARRAYZ,BUFA,BUFZ
2778          INTEGER*2 A,B,C,X,Y,Z,OUT_FILE, LEN
2779          INTEGER*2 EOFA,EOFZ
2780          INTEGER*2 FILEA,FILEZ
2781          INTEGER*2 IDCBA
2782          INTEGER*2 IDCBZ
2783          INTEGER*2 NRECA
2784          INTEGER*2 NRECZ
2785          INTEGER*2 KNT
2786          INTEGER*2 IBM
2787          LOGICAL CB,OK,GOT_FILEA,GOT_FILEZ
2788          CHARACTER*8  TIME_string
2789          CHARACTER*9  DATE_string
2790          CHARACTER*48 FILENAMEA,FILENAMEZ
2791          CHARACTER*48 IN_NAME
2792    C
2793          COMMON /FNAMES/FILENAMEA,FILENAMEZ,OK,GOT_FILEA,GOT_FILEZ
2794          COMMON /CTRLC/TT_CHAN,OUT_FILE,IDCBA,IDCBZ

DSFC                           					27-Sep-1990 12:17:05	VAX FORTRAN V4.7-271                Page   3
								27-Jan-1989 07:48:20	DRA0:[APP.DSFC.SRC]DSFCVAX.SRC;1            

2795    C
2796          DATA COMMA /2H, /
2797          DATA COLON /2H: /
2798          CALL DATE (DATE_string)
2799          CALL TIME (TIME_string)
2800          IDCBA=14
2801          IDCBZ=15
2802    C     unit 16 used for output file
2803          OUT_FILE=16
2804          TYPE 10,DATE_string,TIME_string
2805       10 FORMAT (' DINKEY SEARCHING FILE COMPARE - 2/22/89'//
2806         - ,5X,'DATE/TIME OF RUN:  ',5X,A9,5X,A8,///)
2807          IA=1
2808          IB=0
2809          C=70
2810          Y=70
2811          LEN=66
2812          KNT=70
2813          IZ=1
2814    C
2815    C
2816    C      WRITE (5,'(''$Enter File A/Was'',T30,''* '')')
2817    C      READ (6,19) FILENAMEA
2818    C      WRITE (5,'(''$Enter File Z/Is '',T30,''* '')')
2819    C      READ (6,19) FILENAMEZ
2820    C
2821          CALL GET_FILE_NAMES
2822    C
2823       13 CONTINUE
2824          IDCB = IDCBA
2825          OPEN (UNIT=IDCB,NAME=FILENAMEA,STATUS = 'OLD',ERR=15,IOSTAT=IERR)
2826          IDCB = IDCBZ
2827          OPEN (UNIT=IDCB,NAME=FILENAMEZ,STATUS = 'OLD',ERR=15,IOSTAT=IERR)
2828          IDCB = OUT_FILE
2829          OPEN (UNIT=IDCB,NAME='DSFC.RESULTS',STATUS='UNKNOWN')
2830    C
2831          TYPE *,' FILES HAVE BEEN OPENED'
2832          I = LENGTH(FILENAMEA)
2833          WRITE (OUT_FILE,23)FILENAMEA(1:I)
2834          I = LENGTH(FILENAMEZ)
2835          WRITE (OUT_FILE,24)FILENAMEZ(1:I),DATE_string,TIME_string
2836    C
2837    C	ENABLE CTRL_C TRAPPING
2838    C
2839          ISTAT = SYS$ASSIGN('TT',TT_CHAN,,)       ! FETCH SYSTEM LUN FOR TT
2840          IF(.NOT.ISTAT)CALL LIB$STOP(%VAL(ISTAT)) ! STOP IF NOT ASSIGNED
2841          CALL ENABLE_CTRLC                        ! ENABLE TRAPPING
2842    C
2843    C	NOW CONTINUE WITH DSFC
2844    C
2845          GOTO 20
2846       23 FORMAT(1H1,3X,'COMPARE SOURCE FILE (WAS): ',A,/)
2847       24 FORMAT(1H ,3X,'             AGAINST (IS): ',A,//
2848         - ,2X,'DATE AND TIME OF COMPARISON:  ',2(5X,A),///)
2849       15 TYPE 16,IERR,IDCB
2850       16 FORMAT (/,' 16 (DSFC): OPEN FAILURE ON FILE',I6)
2851          TYPE *,'STOP 773'

DSFC                           					27-Sep-1990 12:17:05	VAX FORTRAN V4.7-271                Page   4
								27-Jan-1989 07:48:20	DRA0:[APP.DSFC.SRC]DSFCVAX.SRC;1            

2852          CALL LIB$STOP(%VAL(IERR))
2853    C
2854    C----------------------------------------------------------
2855    C  FILL AND PRINT INITIAL ARRAY VALUES FOR IDENTIFICATION PURPOSES.
2856    C                'WAS' FILE IDENTIFICATION
2857    C
2858       20 CONTINUE
2859          IF (EOFA.GT.0) GOTO 38
2860          CALL READ (BUFA,EOFA,IDCBA,OUT_FILE,LEN)
2861    *****
2862    *  22 TYPE *,' READ RETURNED @ 22 - '
2863    *****
2864          IF (EOFA.EQ.1) GOTO 21
2865          L=((IA*LEN)-LEN)
2866          DO 25 M = 1,LEN
2867          ARRAYA(L+M) = BUFA(M)
2868       25 CONTINUE
2869          IA=IA+1
2870          IF (IA.GT.C) GOTO 30
2871          IF (IA.EQ.22) GOTO 26
2872          IF (IA.GT.22) GOTO 20
2873          IB=IA-1
2874          CALL PRINT (ARRAYA,IB,OUT_FILE,LEN)
2875          GOTO 20
2876       26 TYPE 29
2877          WRITE (OUT_FILE,29)
2878       29 FORMAT (//,' ^^^^^^^^^^ 20 RECORDS FROM "WAS" FILE ^^^^^^^^^^',/)
2879          GOTO 20
2880    C
2881    C   ALLOW SHORT FILES IF GREATER THAN 20
2882    C
2883       21 IF (IA.LT.22) GOTO 40
2884          C=(IA-1)
2885          GOTO 30
2886    C
2887    C   'IS' FILE IDENTIFICATION
2888    C
2889       30 CONTINUE
2890       33 IF (EOFZ.GT.0) GOTO 38
2891          CALL READ (BUFZ,EOFZ,IDCBZ,OUT_FILE,LEN)
2892          IF (EOFZ.EQ.1) GOTO 31
2893          L = ((IZ*LEN)-LEN)
2894          DO 35 M= 1,LEN
2895          ARRAYZ(L+M) = BUFZ(M)
2896       35 CONTINUE
2897    *****
2898    *     TYPE *,' 35 (DSFC): CALL PRINT ARRAYZ'
2899    *****
2900          IZ=IZ+1
2901          IF (IZ.GT.Y) GOTO 50
2902          IF (IZ.EQ.22) GOTO 34
2903          IF (IZ.GT.22) GOTO 33
2904          IY=IZ-1
2905          CALL PRINT (ARRAYZ,IY,OUT_FILE,LEN)
2906          GOTO 33
2907       34 TYPE 36
2908          WRITE (OUT_FILE,36)

DSFC                           					27-Sep-1990 12:17:05	VAX FORTRAN V4.7-271                Page   5
								27-Jan-1989 07:48:20	DRA0:[APP.DSFC.SRC]DSFCVAX.SRC;1            

2909       36 FORMAT (//,' ^^^^^^^^^^ 20 RECORDS FROM  "IS" FILE ^^^^^^^^^^',/)
2910          WRITE (OUT_FILE,37)
2911       37 FORMAT('1')
2912          NRECA=1
2913          NRECZ=1
2914          GOTO 33
2915       38 TYPE 39
2916          WRITE(OUT_FILE,39)
2917       39 FORMAT(1X,'  39 (DSFC): ATTEMPTING 2ND E-O-F ON FILE')
2918          GOTO 9000
2919    C
2920    C   SET UP FOR LESS THAN AN ARRAY BUT MORE THAN 20
2921    C
2922       31 IF (IZ.LT.22) GOTO 40
2923          Y=(IZ-1)
2924          GOTO 50
2925    C
2926    C   THERE IS LESS THAN ONE "ARRAY-FULL" OF RECORDS - TERMINATE RUN
2927    C
2928       40 TYPE 45
2929          WRITE(OUT_FILE,45)
2930       45 FORMAT (/,' LESS THAN 20 RECORDS BEFORE EOF - RUN ABORTED',/,
2931         + ' STOP 1234')
2932          IRET = 9020
2933          GOTO 9500
2934    C
2935    C   SEE IF THE FIRST REC IN EACH ARRAY IS EQUAL
2936    C      (WILL BE MOST OF THE TIME)
2937    C
2938       50 CONTINUE
2939    *****
2940    *     TYPE *,' 115
2941    *     WRITE(OUT_FILE,115)
2942      115 FORMAT(1X,' 115 (DSFC): (1) TO (1) COMPARE')
2943    *****
2944      117 IRET=116
2945    *****
2946    *     GOTO 9500
2947    *****
2948      116 CONTINUE
2949    C
2950    C   	
2951    C  FUNCTION CB IS AN ASSEMBLY CODE ROUTINE ON THE HP, IBM AND VAX
2952          IF (.NOT. CB (ARRAYA,ARRAYZ,LEN)) GOTO 200
2953    C
2954    C   COMPARISON OF (1) TO (1) IS EQUAL.
2955    C   MOVE CONTENTS OF EACH ARRAY DOWN 1 LINE FOR (C-1)
2956    C      LINES.  TERMINATE IF THESE WERE LAST RECORDS.
2957    C
2958    *****
2959    *     TYPE 125
2960    *     WRITE(OUT_FILE,125)
2961      125 FORMAT(' 125 (DSFC): (1) TO (1) EQUAL - MOVE DOWN')
2962    *****
2963          IF ((C+Y).EQ.2) GOTO 9000
2964    C  SUBROUTINE MB IS AN ASSEMBLY CODE ROUTINE ON THE HP, IBM AND VAX
2965          CALL MB (ARRAYA(LEN+1),ARRAYA(1),(C-1)*LEN)

DSFC                           					27-Sep-1990 12:17:05	VAX FORTRAN V4.7-271                Page   6
								27-Jan-1989 07:48:20	DRA0:[APP.DSFC.SRC]DSFCVAX.SRC;1            

2966          CALL MB (ARRAYZ(LEN+1),ARRAYZ(1),(Y-1)*LEN)
2967          NRECA=NRECA+1
2968          NRECZ=NRECZ+1
2969    C
2970    C    NOW FILL IN THE LAST POSITION IN EACH ARRAY IF NOT E-O-F.
2971    C
2972    *****
2973    *     TYPE 135
2974    *     WRITE(OUT_FILE,135)
2975      135 FORMAT(' 135 (DSFC): FILL IN LAST POSITION OF EACH ARRAY')
2976    *****
2977    C
2978          IRET=136
2979    C
2980    *****
2981    *     GOTO 9500
2982    *****
2983    C
2984      136 CONTINUE
2985          IF (EOFA.GT.0) GOTO 150
2986          CALL READ (BUFA,EOFA,IDCBA,OUT_FILE,LEN)
2987    C   PRINT SCREEN MESSAGE TO KEEP USER INFORMED
2988          KNT = KNT+1
2989          IF (KNT.NE.100*(KNT/100))GOTO 119
2990          TYPE 118,KNT
2991    *     WRITE (OUT_FILE,118)KNT
2992      118 FORMAT (' WORKING ON REC: ',I5)
2993      119 CONTINUE
2994     
2995          IF (EOFA.GT.0) GOTO 150
2996          CALL MB (BUFA(1),ARRAYA((C*LEN)-(LEN-1)),LEN)
2997          GOTO 160
2998      150 C = C-1
2999          IF (C.LT.1) GOTO 1000
3000      160 IF (EOFZ.GT.0) GOTO 180
3001          CALL READ (BUFZ,EOFZ,IDCBZ,OUT_FILE,LEN)
3002          IF (EOFZ.GT.0) GOTO 180
3003          CALL MB (BUFZ(1),ARRAYZ((Y*LEN)-(LEN-1)),LEN)
3004          GOTO 50
3005      180 Y=Y-1
3006          IF (Y.LT.1) GOTO 2000
3007          GOTO 50
3008    C
3009    C   COMPARISON FAILURE IN (1) VS (1).
3010    C
3011    C   SEARCH EACH ARRAY EVENLY FOR A PARALLEL MATCH AND, IF FOUND
3012    C     SAVE FOR LATER RESOLUTION OF BEST FIT VS. 'BIASED' SEARCHES.
3013    C
3014    C       SEARCH EACH ARRAY FOR A MATCH IN EACH DIRECTION TO
3015    C          AVOID MAKING A "BIAS" TOWARDS EITHER ARRAY.  THEN
3016    C          RESOLVE THE DIFFERENCE TOWARDS THE PAIR CLOSEST TO
3017    C          THE TOP OF THE ARRAY.
3018    C
3019    C   DO NOT SEARCH IF THE ARRAY LENGTH IS 1 AND 1, BUT TERMINATE
3020    C        AFTER WRITING OUT LAST TWO RECORDS.
3021    C
3022      200 IF ((C.EQ.1).AND.(Y.EQ.1)) GO TO 8000

DSFC                           					27-Sep-1990 12:17:05	VAX FORTRAN V4.7-271                Page   7
								27-Jan-1989 07:48:20	DRA0:[APP.DSFC.SRC]DSFCVAX.SRC;1            

3023    C
3024          DO 670 I= 1,C
3025          NBEGA = ((I*LEN)-(LEN-1))
3026          NENDA = (NBEGA + (LEN-1))
3027          IF (CB(ARRAYA(NBEGA),ARRAYZ(NBEGA),LEN)) GOTO 680
3028      670 CONTINUE
3029    C
3030          I = 71
3031      680 CONTINUE
3032    C
3033          DO 240 J = 1,C
3034          DO 230 K = 1,Y
3035          NBEGA = ((J*LEN)-(LEN-1))
3036          NENDA = (NBEGA +(LEN-1))
3037          NBEGZ = ((K*LEN) -(LEN-1))
3038          NENDZ = (NBEGZ +(LEN-1))
3039          IF (CB(ARRAYA(NBEGA),ARRAYZ(NBEGZ),LEN)) GOTO 700
3040      230 CONTINUE
3041      240 CONTINUE
3042          GOTO 244
3043      700 DO 740 N=1,Y
3044          DO 730 M=1,C
3045          NBEGA = ((M*LEN)-(LEN-1))
3046          NENDA = (NBEGA +(LEN-1))
3047          NBEGZ = ((N*LEN) -(LEN-1))
3048          NENDZ = (NBEGZ +(LEN-1))
3049          IGOOD=0
3050          IF (CB(ARRAYA(NBEGA),ARRAYZ(NBEGZ),LEN)) GOTO 750
3051      730 CONTINUE
3052      740 CONTINUE
3053          STOP 22
3054      750 IF ((IABS(J-K)).GT.(IABS(M-N))) GOTO 770
3055          GOTO 250
3056      770 J=M
3057          K=N
3058          GOTO 250
3059      244 IRET=245
3060    C
3061    *****
3062    *     GOTO 9500
3063    *****
3064    C
3065    *****
3066      245 CONTINUE
3067          GOTO 249 ! COMMENT THIS LINE TO ENABLE DEBUG PRINT ===============
3068      246 TYPE 248
3069          WRITE(OUT_FILE,248)
3070      248 FORMAT(' 248 (DSFC): COMPLETE COMPARISON FAILURE')
3071      249 CONTINUE
3072    *****
3073    C
3074          IF ((C-1).LT.1) GOTO 1000
3075          IF ((Y-1).LT.1) GOTO 2000
3076          GOTO 250
3077    C
3078    C   COMPARISON HAS BEEN FOUND (AT J,K)  - ARE INCREMENTS IDENTICAL?
3079    C

DSFC                           					27-Sep-1990 12:17:05	VAX FORTRAN V4.7-271                Page   8
								27-Jan-1989 07:48:20	DRA0:[APP.DSFC.SRC]DSFCVAX.SRC;1            

3080      250 IRET=251
3081    *****
3082    *     GOTO 9500
3083    *****
3084      251 CONTINUE
3085    C
3086          IF (I.GE.IABS(J-K)) GOTO 253
3087          J = I
3088          K = I
3089    C
3090      253 IF (J.NE.K) GOTO 300
3091    C
3092    C  EVEN COMPARISON MATCH (BUT KNOWN BY PREVIOUS TEST
3093    C    NOT TO BE (1) VS (1)).  OUTPUT EVEN RECORDS UNTIL THE
3094    C    COMPARISONS ARE REACHED, MOVE DOWN AND REFILL THE ARRAYS.
3095    C       (J HAS LINE NUMBER OF MATCHED COMPARISON IN IT.)
3096    C
3097    *****
3098    *     TYPE 255
3099    *     WRITE(OUT_FILE,255)
3100      255 FORMAT(' 255 (DSFC): ENTERED EVEN COMPARISON')
3101    *****
3102          IBM = J-1
3103          DO 280 I=1,IBM
3104          NBEGA=((I*LEN)-(LEN-1))
3105          NENDA=NBEGA +(LEN-11)
3106          IF ((NENDA-NBEGA).NE.(LEN-11)) GOTO 295
3107          TYPE 260,NRECA,(ARRAYA(L),L=NBEGA,NENDA)
3108          TYPE 270,NRECZ,(ARRAYZ(L),L=NBEGA,NENDA)
3109          WRITE (OUT_FILE,260) NRECA,(ARRAYA(L),L=NBEGA,NENDA)
3110          WRITE (OUT_FILE,270) NRECZ,(ARRAYZ(L),L=NBEGA,NENDA)
3111      260 FORMAT (1X,I5,'  W A S ===   ',56A2)
3112      270 FORMAT (1X,I5,'    I S ===   ',56A2,//)
3113          NRECA = NRECA +1
3114          NRECZ = NRECZ +1
3115      280 CONTINUE
3116    C
3117    *****
3118    *     TYPE 290
3119    *     WRITE(OUT_FILE,290)
3120      290 FORMAT(' 290 (DSFC): LEAVING EVEN COMPARISON FOR REFILL')
3121    *****
3122    C
3123          GOTO 400
3124      295 CONTINUE
3125          TYPE *,' STOP 713'
3126          WRITE(OUT_FILE,*) ' STOP 713'
3127          IRET = 9020
3128          GOTO 9500
3129    C
3130    C   UNEVEN COMPARISON.
3131    C      EMPTY BUFFERS IN PARALLEL UNTIL NO CORRESPONDING RECORD
3132    C      AT WHICH TIME START GENERATING "NO CORRESPONDING RECORD"
3133    C      MESSAGES UNTIL SATISFIED. (J= ARRAYA, K=ARRAYZ COMPARISON POINTERS)
3134    C
3135    *****
3136      300 CONTINUE

DSFC                           					27-Sep-1990 12:17:05	VAX FORTRAN V4.7-271                Page   9
								27-Jan-1989 07:48:20	DRA0:[APP.DSFC.SRC]DSFCVAX.SRC;1            

3137    * 300 TYPE 310
3138    *     WRITE(OUT_FILE,310)
3139      310 FORMAT(' 300 (DSFC): ENTERING UNEVEN COMPARISON')
3140    *****
3141    C
3142    C    I= HIGHER COUNT OF J & K (-1 FOR LAST UNEQUAL)
3143    C
3144          IRET=314
3145    C
3146    *****
3147    *     GOTO 9500
3148    *****
3149    C
3150      314 CONTINUE
3151          I=J
3152          IF (K.GT.J) I=K
3153          M=I-1
3154          DO 390 L=1,M
3155          IF (L.LE.(J-1)) GOTO 320
3156    CCCCC
3157    C	FORMAT 1020 IS "WAS NO CORRESPONDING RECORD"
3158    CCCCC
3159          TYPE 1020,NRECA
3160          WRITE (OUT_FILE,1020) NRECA
3161          GOTO 350
3162      320 NBEGA = ((L*LEN)-(LEN-1))
3163          NENDA = NBEGA+(LEN-11)
3164          TYPE 340,NRECA,(ARRAYA(N),N=NBEGA,NENDA)
3165          WRITE (OUT_FILE,340) NRECA,(ARRAYA(N),N=NBEGA,NENDA)
3166      340 FORMAT (1X,I5,'  W A S ===   ',56A2)
3167          NRECA = NRECA +1
3168      350 IF (L.LE.(K-1)) GOTO 360
3169    CCCCC
3170    C       FORMAT 2020 IS "IS  NO CORRESPONDING RECORD"
3171    CCCCC
3172          TYPE 2020,NRECZ
3173          WRITE (OUT_FILE,2020) NRECZ
3174          GOTO 390
3175      360 NBEGZ = ((L*LEN)-(LEN-1))
3176          NENDZ = NBEGZ+(LEN-11)
3177          TYPE 380,NRECZ,(ARRAYZ(N),N=NBEGZ,NENDZ)
3178          WRITE (OUT_FILE,380) NRECZ,(ARRAYZ(N),N=NBEGZ,NENDZ)
3179      380 FORMAT (1X,I5,'    I S ===   ',56A2,//)
3180          NRECZ = NRECZ +1
3181      390 CONTINUE
3182    C
3183    C   THE UNEVEN COMPARISONS HAVE BEEN WRITTEN OUT. NOW
3184    C      THE EXISTING BUFFERS MUST BE MOVED DOWN AND
3185    C      THE BALANCE OF THE ARRAYS REFILLED.
3186    C           (J & K ARE ARRAY CURRENT EQUAL LINE POINTERS)
3187    C
3188    *****
3189      400 CONTINUE
3190          GOTO 403 ! COMMENT THIS LINE TO ENABLE DEBUG PRINT ==============
3191      401 TYPE 402
3192          WRITE(OUT_FILE,402)
3193      402 FORMAT(' 402 (DSFC): UNEVEN COMPARISON PUSH-DOWN.')

DSFC                           					27-Sep-1990 12:17:05	VAX FORTRAN V4.7-271                Page  10
								27-Jan-1989 07:48:20	DRA0:[APP.DSFC.SRC]DSFCVAX.SRC;1            

3194      403 CONTINUE
3195    *****
3196    C
3197          IRET=410
3198    C
3199    *****
3200    *     GOTO 9500
3201    *****
3202    C
3203      410 CONTINUE
3204          IF ((J-1).EQ.0) GOTO 430
3205          IF (J.NE.1) CALL MB (ARRAYA(LEN*J-(LEN-1)),ARRAYA(1),(C-J+1)*LEN)
3206      430 IF ((K-1).EQ.0) GOTO 480
3207          IF (K.NE.1) CALL MB (ARRAYZ(LEN*K-(LEN-1)),ARRAYZ(1),(Y-K+1)*LEN)
3208      480 CONTINUE
3209          IRET=505
3210    *****
3211    *     GOTO 9500
3212    *****
3213      505 CONTINUE
3214    C
3215    C    FILL IN THE HOLES (UNEVEN) AT THE TOP OF THE ARRAY IN
3216    C         EACH CASE.  J & K ARE STILL OLD COMPARE POSITIONS.
3217    C
3218    *****
3219    *     TYPE 500
3220    *     WRITE(OUT_FILE,500)
3221      500 FORMAT(' 500 (DSFC): BEGIN TO FILL IN UNEVEN HOLES')
3222    *****
3223    C
3224          IRET=508
3225    C
3226    *****
3227    *     GOTO 9500
3228    *****
3229    C
3230      508 CONTINUE
3231          IF ((J-1).EQ.0) GOTO 530
3232          IBM = J-1
3233          DO 520  I=1, IBM
3234          IF (EOFA.GT.0) C=C-1
3235          IF (EOFA.GT.0) GOTO 520
3236          CALL READ (BUFA,EOFA,IDCBA,OUT_FILE,LEN)
3237          IF (EOFA.NE.0) C= C-1
3238          IF (EOFA.NE.0) GOTO 520
3239          CALL MB (BUFA(1),ARRAYA(((C-J+I+1)*LEN)-(LEN-1)),LEN)
3240      520 CONTINUE
3241      530 CONTINUE
3242      550 IF ((K-1).EQ.0) GOTO 580
3243          IBM = K-1
3244          DO 570 I= 1, IBM
3245          IF (EOFZ.GT.0) Y=Y-1
3246          IF (EOFZ.GT.0) GOTO 570
3247          CALL READ (BUFZ,EOFZ,IDCBZ,OUT_FILE,LEN)
3248          IF (EOFZ.NE.0) Y= Y-1
3249          IF (EOFZ.NE.0) GOTO 570
3250          CALL MB (BUFZ(1),ARRAYZ(((Y-K+I+1)*LEN)-(LEN-1)),LEN)

DSFC                           					27-Sep-1990 12:17:05	VAX FORTRAN V4.7-271                Page  11
								27-Jan-1989 07:48:20	DRA0:[APP.DSFC.SRC]DSFCVAX.SRC;1            

3251      570 CONTINUE
3252      580 CONTINUE
3253          IF(C.LT.1) GOTO 1000
3254          IF(Y.LT.1) GOTO 2000
3255          IRET=595
3256    *****
3257    *     GOTO 9500
3258    *****
3259      595 CONTINUE
3260          GOTO 50
3261    C
3262    C    END OF FILE ON FILEA
3263    C         (POSSIBLE EOF ON FILEZ ALSO)
3264    C
3265     1000 CONTINUE
3266          TYPE 1002
3267          WRITE(OUT_FILE,1002)
3268     1002 FORMAT(' 1002 (DSFC):  EOF ON FILEA')
3269          IRET=1004
3270    C
3271    *****
3272    *      GOTO 9500
3273    *****
3274    C
3275     1004 CONTINUE
3276    C
3277    C   CHECK THAT OTHER FILE IS EOF, IF SO END PROGRAM
3278    C
3279          IF (Y.LT.1) GOTO 9000
3280    C
3281    C   WRITE OUT CONTENTS OF ARRAYZ (WITH NO "CORRES" MESSAGE)
3282    C      FOLLOWED BY THE BALANCE OF THE FILEZ RECORDS THAT HAVE
3283    C      NOT YET BEEN READ IN.
3284    C   TERMINATE PROGRAM AT END OF EITHER THE ARRAY DUMPING (IF NO
3285    C      MORE RECORDS) OR WHEN EOF IS ENCOUNTERED ON FILEZ.
3286    C
3287          DO 1040 I=1,Y
3288          NBEGZ = ((I*LEN)-(LEN-1))
3289          NENDZ = NBEGZ +(LEN-20)
3290          TYPE 1020,NRECA
3291          TYPE 1030,NRECZ,(ARRAYZ(K), K=NBEGZ,NENDZ)
3292          WRITE (OUT_FILE,1020) NRECA
3293          WRITE (OUT_FILE,1030) NRECZ,(ARRAYZ(K), K=NBEGZ,NENDZ)
3294     1020 FORMAT (1X,I5,'  W A S ===   N O   C O R R E S P O N D I N G ',
3295         1  '  R E C O R D ')
3296     1030 FORMAT (1X,I5,'    I S ===   ',56A2,//)
3297          NRECZ = NRECZ +1
3298     1040 CONTINUE
3299    C     END THE TAPE
3300          TYPE 1070
3301          WRITE (OUT_FILE,1070)
3302     1070 FORMAT(1X,//,' ----- THE FOLLOWING EXCEEDS THE LENGTH OF THE',
3303         1 ' "WAS" FILE ----- ',//)
3304          NENDZ= LEN-20
3305     1050 IF (EOFZ.GT.0) GOTO 9000
3306          CALL READ (BUFZ,EOFZ,IDCBZ,OUT_FILE,LEN)
3307          IF (EOFZ.GT.0) GOTO 9000

DSFC                           					27-Sep-1990 12:17:05	VAX FORTRAN V4.7-271                Page  12
								27-Jan-1989 07:48:20	DRA0:[APP.DSFC.SRC]DSFCVAX.SRC;1            

3308          TYPE 1060,NRECZ,(BUFZ(K),K=1,NENDZ)
3309          WRITE (OUT_FILE,1060)NRECZ,(BUFZ(K),K=1,NENDZ)
3310     1060 FORMAT (1X,I5,'    I S ===   ',56A2)
3311          NRECZ = NRECZ +1
3312          GOTO 1050
3313    C
3314    C    END OF FILE ON FILEZ
3315    C       (POSSIBLE  EOF ON FILEA ALSO)
3316    C
3317     2000 CONTINUE
3318          TYPE 2002
3319          WRITE(OUT_FILE,2002)
3320     2002 FORMAT(' 2002 (DSFC): EOF ON FILEZ')
3321          IRET=2004
3322    C
3323    *****
3324    *      GOTO 9500
3325    *****
3326    C
3327     2004 CONTINUE
3328    C
3329    C    CHECK THAT FILE IS NOT ALSO EOF  IF SO END PROGRAM
3330    C
3331          IF (C.LT.1) GOTO 9000
3332    C
3333    C   WRITE OUT CONTENTS OF ARRAYA (WITH NO CORRES MESSAGE)
3334    C     FOLLOWED BY THE BALANCE OF THE FILEA RECORDS THAT HAVE
3335    C     NOT YET BEEN READ IN.  TERMINATE PROGRAM AT END OF EITHER
3336    C     THE ARRAY DUMPING (IF NO MORE RECORDS) OR WHEN EOF
3337    C     IS ENCOUNTERED ON FILEA.
3338    C
3339          DO 2040 I=1,C
3340          NBEGA = ((I*LEN)-(LEN-1))
3341          NENDA = NBEGA + (LEN-20)
3342          TYPE 2030,NRECA,(ARRAYA(K),K=NBEGA,NENDA)
3343          TYPE 2020,NRECZ
3344          WRITE (OUT_FILE,2030) NRECA,(ARRAYA(K),K=NBEGA,NENDA)
3345          WRITE (OUT_FILE,2020) NRECZ
3346     2020 FORMAT (1X,I5,'    I S ===   N O   C O R R E S P O N D I N G ',
3347         - '  R E C O R D '//)
3348     2030 FORMAT (1X,I5,'  W A S ===   ',56A2)
3349          NRECA = NRECA +1
3350     2040 CONTINUE
3351    C   END THE TAPE
3352          TYPE 2070
3353          WRITE (OUT_FILE,2070)
3354     2070 FORMAT (1X,//,' ----- THE FOLLOWING EXCEEDS THE LENGTH OF THE
3355         1 "IS" FILE ----- ',//)
3356          NENDA = LEN-20
3357     2050 IF (EOFA.GT.0) GOTO 9000
3358          CALL READ (BUFA,EOFA,IDCBA,OUT_FILE,LEN)
3359          IF (EOFA.GT.0) GOTO 9000
3360          TYPE 2030,NRECA,(BUFA(K),K=1,NENDA)
3361          WRITE (OUT_FILE,2030)NRECA,(BUFA(K),K=1,NENDA)
3362          NRECA = NRECA +1
3363          GOTO 2050
3364    C

DSFC                           					27-Sep-1990 12:17:05	VAX FORTRAN V4.7-271                Page  13
								27-Jan-1989 07:48:20	DRA0:[APP.DSFC.SRC]DSFCVAX.SRC;1            

3365    C    THE LAST RECORD OF THE FILE HAS FAILED COMPARISON AND THERE
3366    C       IS NOTHING MORE TO SEARCH OR SCAN.  PRINT THEM OUT AND
3367    C       TERMINATE JOB.
3368     8000 CONTINUE
3369    *****
3370    *     TYPE 8010
3371    *     WRITE(OUT_FILE,8010)
3372     8010 FORMAT (' 8010(DSFC): LAST RECORD NOT EQUAL - PRINT & TERM')
3373    *****
3374    C
3375          IRET=8020
3376    C
3377    *****
3378    *     GO TO 9500
3379    *****
3380    C
3381     8020 CONTINUE
3382          NBEGA = 1
3383          NENDA = LEN -10
3384          TYPE 8040,NRECZ,(ARRAYZ(K),K=NBEGA,NENDA)
3385          TYPE 8030,NRECA,(ARRAYA(K),K=NBEGA,NENDA)
3386          WRITE (OUT_FILE,8040) NRECZ,(ARRAYZ(K),K=NBEGA,NENDA)
3387          WRITE (OUT_FILE,8030) NRECA,(ARRAYA(K),K=NBEGA,NENDA)
3388     8030 FORMAT (1X,I5,'  W A S ===   ',56A2)
3389     8040 FORMAT (1X,I5,'    I S ===   ',56A2,//)
3390          GOTO 9000
3391    C
3392    C                 END THE PROGRAM
3393    C
3394     9000 CONTINUE
3395          TYPE 9001
3396          WRITE(OUT_FILE,9001)
3397     9001 FORMAT(' 0000(DSFC):  - - -  E N D    O F   P R O G R A M - - -')
3398          TYPE *,'RESULTS STORED IN DSFC.RESULTS '
3399          IRET=9020
3400    C
3401    *****
3402    *      GOTO 9500
3403    *****
3404    C
3405    C     CLOSE THE IS, WAS, AND RESULTS FILES
3406    C
3407    C     ==============================****=============================
3408    C
3409    C     THIS IS THE NORMAL EXIT LOCATION FOR DSFC, EVEN IF ERRORS OCCUR
3410    C
3411     9020 CONTINUE
3412          CLOSE (UNIT=OUT_FILE,STATUS='KEEP',ERR=9025,IOSTAT=IERR)
3413          CLOSE (UNIT=IDCBA,STATUS='KEEP',ERR=9025,IOSTAT=IERR)
3414          CLOSE (UNIT=IDCBZ,STATUS='KEEP',ERR=9025,IOSTAT=IERR)
3415          CALL EXIT
3416     9025 CONTINUE
3417          TYPE *,'ERROR ',IERR,' CLOSING FILES'
3418          call errsns(ierr,ists,istv,iunit,icond)
3419          CALL LIB$STOP(%VAL(Icond))
3420    C
3421    C  ARRAY DUMP ROUTINE FOR DEBUGGING

DSFC                           					27-Sep-1990 12:17:05	VAX FORTRAN V4.7-271                Page  14
								27-Jan-1989 07:48:20	DRA0:[APP.DSFC.SRC]DSFCVAX.SRC;1            

3422    C
3423    *****
3424     9500 GOTO 9560
3425    *9500 CONTINUE
3426    *****
3427     9502 WRITE (OUT_FILE,9542)
3428          WRITE (OUT_FILE,9510) I,J,K,L,M,N
3429     9510 FORMAT (//,' I=',I4,' J=',I4,' K=',I4,' L=',I4,' M=',I4,
3430         1' N=',I4)
3431     9514 WRITE (OUT_FILE,9516) X,Y,Z
3432     9516 FORMAT (' X=',I3,' Y=',I3,' Z=',I3)
3433          WRITE (OUT_FILE,9520) NBEGA,NENDA,ICNTA,IA,EOFA
3434     9520 FORMAT (' NBEGA=',I4,' NENDA=',I4,' ICNTA=',I4,' IA=',I4,
3435         1' EOFA=',I3)
3436          WRITE (OUT_FILE,9522) NBEGZ,NENDZ,ICNTZ,IZ,EOFZ
3437     9522 FORMAT (' NBEGZ=',I4,' NENDZ=',I4,' ICNTZ=',I4,' IZ=',I4,
3438         1' EOFZ=',I3)
3439          WRITE (OUT_FILE,9524) ICOUNT,C,IRET,NRECA,NRECZ
3440     9524 FORMAT (' ICOUNT=',I3,' C=',I3,' IRET=',I4,'  NRECA=',I6,
3441         1'  NRECZ=',I6)
3442          WRITE (OUT_FILE,9530)
3443     9530 FORMAT ('0 =======    ARRAY A  ==================
3444         1    ARRAY Z ==',//)
3445          NM=C
3446          IF (NM.LT.Y) NM=Y
3447          DO 9550 NI=1,NM
3448          NJ=(NI*LEN) -(LEN-1)
3449          NL=NJ+19
3450          WRITE (OUT_FILE,9540) NI, (ARRAYA(NK),NK=NJ,NL),(ARRAYZ(NK),
3451         1NK=NJ,NL)
3452     9540 FORMAT (1X,I2,5X,20A2,5X,20A2)
3453     9550 CONTINUE
3454          WRITE (OUT_FILE,9542)
3455     9542 FORMAT (//,' ============================================',//)
3456     9560 IF (IRET.EQ. 116) GOTO 116
3457          IF (IRET.EQ.9020) GOTO 9020
3458          IF (IRET.EQ. 136) GOTO  136
3459          IF (IRET.EQ. 245) GOTO  245
3460          IF (IRET.EQ. 251) GOTO  251
3461          IF (IRET.EQ. 314) GOTO  314
3462          IF (IRET.EQ. 410) GOTO  410
3463          IF (IRET.EQ. 505) GOTO  505
3464          IF (IRET.EQ. 508) GOTO  508
3465          IF (IRET.EQ. 595) GOTO  595
3466          IF (IRET.EQ.1004) GOTO 1004
3467          IF (IRET.EQ.2004) GOTO 2004
3468          IF (IRET.EQ.8020) GOTO 8020
3469          TYPE 9570,IRET
3470          WRITE(OUT_FILE,9570)IRET
3471     9570 FORMAT(//,' 2222(DSFC): ILLEGAL RETURN LABEL: ',I5)
3472          WRITE (OUT_FILE,*) ' STOP 2222'
3473          TYPE *,' STOP 2222'
3474    C
3475    C     NOW GO CLOSE THE FILES
3476    C
3477          GOTO 9020
3478          END

DSFC                           					27-Sep-1990 12:17:05	VAX FORTRAN V4.7-271                Page  15
								27-Jan-1989 07:48:20	DRA0:[APP.DSFC.SRC]DSFCVAX.SRC;1            

PROGRAM SECTIONS

    Name				 Bytes   Attributes

  0 $CODE                                 4878   PIC CON REL LCL   SHR   EXE   RD NOWRT LONG
  1 $PDATA                                1720   PIC CON REL LCL   SHR NOEXE   RD NOWRT LONG
  2 $LOCAL                               19816   PIC CON REL LCL NOSHR NOEXE   RD   WRT LONG
  3 FNAMES                                 108   PIC OVR REL GBL   SHR NOEXE   RD   WRT LONG
  4 CTRLC                                   10   PIC OVR REL GBL   SHR NOEXE   RD   WRT LONG

    Total Space Allocated                26532


ENTRY POINTS

    Address  Type  Name          

  0-00000000       DSFC          


VARIABLES

    Address  Type  Name              Address  Type  Name              Address  Type  Name              Address  Type  Name          

      **      I*2  A                   **      I*2  B               2-00004A6E  I*2  C                   **      R*4  COLON         
      **      R*4  COMMA           2-00004A64  CHAR DATE_STRING     2-00004A74  I*2  EOFA            2-00004A76  I*2  EOFZ          
      **      I*2  FILEA           3-00000000  CHAR FILENAMEA       3-00000030  CHAR FILENAMEZ           **      I*2  FILEZ         
  3-00000064  L*4  GOT_FILEA       3-00000068  L*4  GOT_FILEZ       2-00004A8C  I*4  I                   **      I*4  IA            
  2-00004A80  I*4  IB                  **      I*2  IBM                 **      I*4  ICNTA               **      I*4  ICNTZ         
  2-00004B10  I*4  ICOND               **      I*4  ICOUNT          2-00004A84  I*4  IDCB            4-00000006  I*2  IDCBA         
  4-00000008  I*2  IDCBZ           2-00004A88  I*4  IERR                **      I*4  IGOOD               **      CHAR IN_NAME       
  2-00004A94  I*4  IRET                **      I*4  ISTAT           2-00004B04  I*4  ISTS            2-00004B08  I*4  ISTV          
  2-00004B0C  I*4  IUNIT           2-00004A90  I*4  IY                  **      I*4  IZ              2-00004A9C  I*4  J             
  2-00004AA4  I*4  K               2-00004A7C  I*2  KNT                 **      I*4  L               2-00004A72  I*2  LEN           
      **      I*4  M                   **      I*4  N                   **      I*4  NBEGA               **      I*4  NBEGZ         
      **      I*4  NENDA               **      I*4  NENDZ               **      I*4  NI                  **      I*4  NJ            
      **      I*4  NK                  **      I*4  NL                  **      I*4  NM              2-00004A78  I*2  NRECA         
  2-00004A7A  I*2  NRECZ           3-00000060  L*4  OK              4-00000004  I*2  OUT_FILE        2-00004A5C  CHAR TIME_STRING   
      **      CHAR TRAP_LINE       4-00000000  I*4  TT_CHAN             **      I*2  X               2-00004A70  I*2  Y             
      **      I*2  Z             


ARRAYS

    Address  Type  Name                Bytes  Dimensions

  2-00000018  I*2  ARRAYA               9240  (4620)
  2-00002430  I*2  ARRAYZ               9240  (4620)
  2-00004848  I*2  BUFA                  266  (133)
  2-00004952  I*2  BUFZ                  266  (133)
  2-00000000  I*4  ITIME                  20  (5)
  2-00000014  I*4  IYEAR                   4  (1)

DSFC                           					27-Sep-1990 12:17:05	VAX FORTRAN V4.7-271                Page  16
								27-Jan-1989 07:48:20	DRA0:[APP.DSFC.SRC]DSFCVAX.SRC;1            

LABELS

    Address   Label       Address   Label       Address   Label       Address   Label       Address   Label       Address   Label   

  1-00000077  10'           **      13        0-00000194  15        1-0000013E  16'       0-000001EA  20        0-00000290  21      
  1-000000C6  23'       1-000000EB  24'           **      25        0-00000258  26        1-00000164  29'       0-0000029E  30      
  0-00000368  31        0-000002A0  33        0-00000310  34            **      35        1-0000019B  36'       1-000001D2  37'     
  0-000003B4  38        1-000001D6  39'       0-00000378  40        1-00000204  45'       0-00000534  50            **      115'    
  0-00000534  116           **      117       1-00000243  118'      0-000005E6  119           **      125'          **      135'    
  0-000005A1  136       0-00000610  150       0-00000618  160       0-00000650  180       0-0000065C  200           **      230     
      **      240           **      244       0-000007B7  245           **      246       1-00000259  248'          **      249     
  0-000007CB  250       0-000007CB  251       0-000007E9  253           **      255'      1-00000284  260'      1-0000029D  270'    
      **      280           **      290'      0-0000094C  295       0-00000990  300           **      310'      0-00000990  314     
  0-00000A10  320       1-000002B8  340'      0-00000AAF  350       0-00000AFC  360       1-000002D1  380'      0-00000B9B  390     
  0-00000BA1  400           **      401       1-000002EC  402'          **      403       0-00000BA1  410       0-00000BE4  430     
  0-00000C2B  480           **      500'      0-00000C2B  505       0-00000C2B  508       0-00000C98  520       0-00000C9D  530     
      **      550       0-00000D0C  570       0-00000D11  580       0-00000534  595           **      670       0-000006B5  680     
  0-00000718  700           **      730           **      740       0-00000770  750       0-00000794  770       0-00000D58  1000    
  1-00000318  1002'     0-00000D9D  1004      1-00000336  1020'     1-0000037B  1030'         **      1040      0-00000EDC  1050    
  1-000003E1  1060'     1-00000396  1070'     0-00000D20  2000      1-000003FA  2002'     0-00000F8D  2004      1-00000417  2020'   
  1-0000045E  2030'         **      2040      0-000010D0  2050      1-00000477  2070'     0-00000D8C  8000          **      8010'   
  0-0000117D  8020      1-000004BF  8030'     1-000004D8  8040'     0-000003E8  9000      1-000004F3  9001'     0-0000043C  9020    
  0-00000468  9025      0-000004B4  9500          **      9502      1-0000052D  9510'         **      9514      1-0000055A  9516'   
  1-00000570  9520'     1-000005A4  9522'     1-000005D8  9524'     1-0000060E  9530'     1-00000649  9540'     1-0000065A  9542'   
      **      9550          **      9560      1-0000068E  9570'   


FUNCTIONS AND SUBROUTINES REFERENCED

  Type  Name                              Type  Name                              Type  Name                            

   L*4  CB                                      ENABLE_CTRLC                            FOR$CLOSE                       
        FOR$DATE_T_DS                           FOR$ERRSNS                              FOR$EXIT                        
        FOR$OPEN                                FOR$TIME_T_DS                           GET_FILE_NAMES                  
   I*4  LENGTH                                  LIB$STOP                                MB                              
        PRINT                                   READ                               I*4  SYS$ASSIGN                      

                               					27-Sep-1990 12:17:05	VAX FORTRAN V4.7-271                Page  17
								27-Jan-1989 07:48:20	DRA0:[APP.DSFC.SRC]DSFCVAX.SRC;1            

0001    C
0002    C----------------------------------------------------------
0003    C    SUBROUTINE READ BUFFER
0004    C----------------------------------------------------------
0005    C
0006    C    READS A FILE AND MAKES THE "EOF" = 1 IF EOF HAS BEEN ENCOUNTERED.
0007    C        PROHIBITS A SECOND READ REQUEST FROM READING AFTER "EOF".
0008    C
0009          SUBROUTINE READ (BUF,EOF,IDCB,OUT_FILE,LEN)
0010          DIMENSION BUF (133)
0011          INTEGER*2 BUF, BUF1 (133)
0012          INTEGER*2 EOF,OUT_FILE,BLANK,LEN
0013          INTEGER*2 IDCB
0014          CHARACTER*266 BUFFER
0015          EQUIVALENCE (BUFFER, BUF1)
0016    C       
0017          DATA BLANK /2H--/
0018    C     WRITE (OUT_FILE,2) EOF
0019        2 FORMAT ('  2 (READ): READ ENTRY "EOF" : ',I6)
0020          IF (EOF.EQ.0) GOTO 10
0021          WRITE (OUT_FILE,5)
0022        5 FORMAT (' SECOND ATTEMPT AT EOF')
0023          STOP 'STOP 770'
0024       10 DO 11 K = 1,LEN
0025          BUF (K) = BLANK
0026       11 CONTINUE
0027          READ (IDCB,40,ERR=100,END=200) (BUF(J),J=1,LEN)
0028       40 FORMAT (66(A2))
0029          DO K = 1, LEN
0030            BUF1 (K) = BUF (K)
0031          END DO
0032    C     WRITE (OUT_FILE,*)  BUFFER
0033    * 50   FORMAT (1X,'THE BUFFER IS:',/,
0034    *     1     1X, A266)
0035    * 50   FORMAT (1X,132A2,I6)
0036    C   50 FORMAT ('  50 (READ):', 66A2,I6)
0037          RETURN
0038      100 CONTINUE
0039          WRITE (6, '(1X,''100'',/,1X,A132)') (BUF (J), J=1,LEN)
0040          WRITE (OUT_FILE,101) IERR
0041      101 FORMAT (/,' READ ERROR #',I4)
0042          STOP 'STOP 772'
0043      200 CONTINUE
0044    c     WRITE (6, '(1X,''200'',/,1X,A132)') (BUF (J), J=1,LEN)
0045    C     WRITE (OUT_FILE,*)   (BUF(J), J=1,LEN),IDCB
0046    C 225 FORMAT (' 225 (READ):', 66A2,I6)
0047          EOF = 1
0048    C     WRITE (OUT_FILE,250) IDCB
0049      250 FORMAT (/,' READ (DSFC): EOF SET TO -1-  IDCB= ',I6)
0050          RETURN
0051          END

READ                           					27-Sep-1990 12:17:05	VAX FORTRAN V4.7-271                Page  18
								27-Jan-1989 07:48:20	DRA0:[APP.DSFC.SRC]DSFCVAX.SRC;1            

PROGRAM SECTIONS

    Name				 Bytes   Attributes

  0 $CODE                                  293   PIC CON REL LCL   SHR   EXE   RD NOWRT LONG
  1 $PDATA                                  83   PIC CON REL LCL   SHR NOEXE   RD NOWRT LONG
  2 $LOCAL                                 328   PIC CON REL LCL NOSHR NOEXE   RD   WRT LONG

    Total Space Allocated                  704


ENTRY POINTS

    Address  Type  Name          

  0-00000000       READ          


VARIABLES

    Address  Type  Name              Address  Type  Name              Address  Type  Name              Address  Type  Name          

  2-0000010A  I*2  BLANK           2-00000000  CHAR BUFFER         AP-00000008@ I*2  EOF            AP-0000000C@ I*2  IDCB          
  2-00000110  I*4  IERR            2-0000010C  I*4  J                   **      I*4  K              AP-00000014@ I*2  LEN           
 AP-00000010@ I*2  OUT_FILE      


ARRAYS

    Address  Type  Name                Bytes  Dimensions

 AP-00000004@ I*2  BUF                   266  (133)
  2-00000000  I*2  BUF1                  266  (133)


LABELS

    Address   Label       Address   Label       Address   Label       Address   Label       Address   Label       Address   Label   

      **      2'        1-00000010  5'        0-0000003C  10            **      11        1-00000029  40'       0-000000C4  100     
  1-00000040  101'      0-00000120  200           **      250'    

                               					27-Sep-1990 12:17:05	VAX FORTRAN V4.7-271                Page  19
								27-Jan-1989 07:48:20	DRA0:[APP.DSFC.SRC]DSFCVAX.SRC;1            

0001    C
0002    C---------------------------------------------------------
0003    C     SUBROUTINE PRINT ARRAY
0004    C---------------------------------------------------------
0005    C
0006    C     PRINT THE ARRAY ELEMENT NAMED FROM ARRAY
0007    C
0008          SUBROUTINE PRINT (ARRAYA,IA,OUT_FILE,LEN)
0009          DIMENSION ARRAYA (1)
0010          INTEGER*2 ARRAYA
0011          INTEGER*2 OUT_FILE,LEN
0012    C
0013    *****
0014    *     TYPE 10,IA,OUT_FILE,LEN
0015    *     WRITE(OUT_FILE,10)
0016       10 FORMAT(' 10(PRINT): IA =',I6,', OUT_FILE =',I3,',LEN = ',I2)
0017    *****
0018    C
0019          IF (IA.LE.0) STOP 'STOP 776'
0020          IF (LEN.GT.66) STOP 'STOP 777'
0021          IB= ((IA*LEN)-(LEN-1))
0022          IBB = IB+(LEN-1)
0023          TYPE 20,(ARRAYA(I),I=IB,IBB)
0024          WRITE (OUT_FILE,20) (ARRAYA(I),I=IB,IBB)
0025       20 FORMAT (' ',66A2)
0026    *****
0027    *     TYPE 30
0028    *     WRITE(OUT_FILE,30)
0029       30 FORMAT(' 30 (PRINT): EXITING "PRINT"')
0030    *****
0031          RETURN
0032          END 

PRINT                          					27-Sep-1990 12:17:05	VAX FORTRAN V4.7-271                Page  20
								27-Jan-1989 07:48:20	DRA0:[APP.DSFC.SRC]DSFCVAX.SRC;1            

PROGRAM SECTIONS

    Name				 Bytes   Attributes

  0 $CODE                                  185   PIC CON REL LCL   SHR   EXE   RD NOWRT LONG
  1 $PDATA                                  24   PIC CON REL LCL   SHR NOEXE   RD NOWRT LONG
  2 $LOCAL                                  44   PIC CON REL LCL NOSHR NOEXE   RD   WRT LONG

    Total Space Allocated                  253


ENTRY POINTS

    Address  Type  Name          

  0-00000000       PRINT         


VARIABLES

    Address  Type  Name              Address  Type  Name              Address  Type  Name              Address  Type  Name          

      **      I*4  I              AP-00000008@ I*4  IA                  **      I*4  IB                  **      I*4  IBB           
 AP-00000010@ I*2  LEN            AP-0000000C@ I*2  OUT_FILE      


ARRAYS

    Address  Type  Name                Bytes  Dimensions

 AP-00000004@ I*2  ARRAYA                  2  (1)


LABELS

    Address   Label       Address   Label       Address   Label   

      **      10'       1-00000010  20'           **      30'     

                               					27-Sep-1990 12:17:05	VAX FORTRAN V4.7-271                Page  21
								27-Jan-1989 07:48:20	DRA0:[APP.DSFC.SRC]DSFCVAX.SRC;1            

0001    C
0002    C------------------------------------------------------------
0003    C     SUBROUTINE MOVE BUFFER
0004    C------------------------------------------------------------
0005    C     
0006    C     MOVE Z INTEGER*2 WORDS (2Z bytes) OF BUFFER X TO BUFFER Y
0007    C
0008    C     NOTE:
0009    C     IF THIS ROUTINE IS WRITTEN IN MACHINE CODE (ASSEMBLY LANGUAGE)
0010    C     A MACHINE DEPENDENT SPEEDUP OF ABOUT 7X WILL BE REALIZED.
0011    C
0012    C      SUBROUTINE MB (X,Y,Z)
0013    C      INTEGER*2 X(1),Y(1),Z,COUNT						
0014    C      DO COUNT = 1,Z
0015    C      Y(COUNT) = X(COUNT)
0016    C      END DO
0017    C      RETURN
0018    C      END
0019    C
0020    C-------------------------------------------------------------
0021    C    FUNCTION COMPARE BUFFERS
0022    C-------------------------------------------------------------
0023    C
0024    C     COMPARES WCNT INTEGER*2 WORDS OF BUFFER J AGAINST BUFFER K
0025    C     AND RETURNS .TRUE. IF ALL WORDS COMPARE ON A ONE FOR ONE BASIS
0026    C     OTHERWISE .FALSE. IS RETURNED
0027    C
0028    C     NOTE:
0029    C     IF THIS ROUTINE IS WRITTEN IN MACHINE CODE (ASSEMBLY LANGUAGE)
0030    C     A MACHINE DEPENDENT SPEEDUP OF ABOUT 7X WILL BE REALIZED.
0031    C
0032    C     LOGICAL FUNCTION CB (J,K,WCNT)
0033    C     INTEGER*2 J(1),K(1),WCNT,COUNT
0034    C     DO COUNT = 1,WCNT
0035    C     IF (J(COUNT).NE.K(COUNT)) THEN
0036    C           CB = .FALSE.
0037    C           RETURN
0038    C           END IF                      ! J.....K
0039    C     END DO                            ! COUNT
0040    C     CB = .TRUE.
0041    C     RETURN
0042    C     END
0043    C
0044    C-------------------------------------------------------------
0045    C	FUNCTION CHARACTER STRING LENGTH
0046    C-------------------------------------------------------------
0047    C
0048    C	THIS FUNCTION RETURNS THE ACTUAL LENGTH OF A CHARACTER 
0049    C	STRING, I.E., THE LENGTH UP TO THE POINT WHERE ALL OTHER
0050    C	CHARACTERS IN THE STRING ARE SPACES, INSTEAD OF THE 
0051    C	DECLARED LENGTH AS THE FORTRAN FUNCTION LEN DOES
0052    C
0053    	INTEGER FUNCTION LENGTH(S)
0054    	CHARACTER*(*) S
0055    C
0056    C	GET THE DECLARED LENGTH
0057    C

LENGTH                         					27-Sep-1990 12:17:05	VAX FORTRAN V4.7-271                Page  22
								27-Jan-1989 07:48:20	DRA0:[APP.DSFC.SRC]DSFCVAX.SRC;1            

0058    	J = LEN(S)
0059    	IF(J.EQ.0) THEN
0060    	  LENGTH = 0
0061    	  RETURN
0062    	END IF
0063    C
0064    C	STARTING AT THE LAST CHARACTER POSITION, SCAN TOWARDS THE
0065    C	START OF THE STRING LOOKING FOR A PRINTABLE CHARACTER
0066    C
0067    	DO I=J,1,-1
0068    C
0069    C	IF A PRINTABLE CHARACTER IS FOUND WITHIN THE LOOP, THE LENGTH
0070    C	OF THE STRING HAS BEEN FOUND
0071    C
0072    	  IF(S(I:I).GT.' ') THEN
0073    	    LENGTH = I
0074    	    RETURN
0075    	  END IF
0076    	END DO
0077    C
0078    C	OTHERWISE, THE ENTIRE STRING WAS SPACES - RETURN A ZERO
0079    C
0080    	LENGTH = 0
0081    	RETURN
0082    	END




PROGRAM SECTIONS

    Name				 Bytes   Attributes

  0 $CODE                                   58   PIC CON REL LCL   SHR   EXE   RD NOWRT LONG
  2 $LOCAL                                  12   PIC CON REL LCL NOSHR NOEXE   RD   WRT LONG

    Total Space Allocated                   70


ENTRY POINTS

    Address  Type  Name          

  0-00000000  I*4  LENGTH        


VARIABLES

    Address  Type  Name              Address  Type  Name              Address  Type  Name          

      **      I*4  I                   **      I*4  J              AP-00000004@ CHAR S             

                               					27-Sep-1990 12:17:05	VAX FORTRAN V4.7-271                Page  23
								27-Jan-1989 07:48:20	DRA0:[APP.DSFC.SRC]DSFCVAX.SRC;1            

0001    C
0002    C-------------------------------------------------------------
0003    C	SUBROUTINE ENABLE CTRL-C TRAPPING
0004    C-------------------------------------------------------------
0005    C
0006    C	THIS SUBROUTINE CALLS SYS$QIOW TO ENABLE CTRL-C TRAPPING
0007    C
0008    	SUBROUTINE ENABLE_CTRLC
0009    	INTEGER*2 OUT_FILE,IDCBA,IDCBZ
0010    	INTEGER*4 TT_CHAN,ISTAT
0011    	COMMON /CTRLC/TT_CHAN,OUT_FILE,IDCBA,IDCBZ
0012    	EXTERNAL CTRLC_TRAP
0013    C
0014    C	INCLUDE I/O AND SYSTEM SERVICES SYMBOLS
0015    C
0016    	INCLUDE '($IODEF)'
0608    	INCLUDE '($SYSSRVNAM)'
3289    C
3290    C	ENABLE CTRL_C TRAPPING AND SPECIFY CTRLC_TRAP
3291    C	AS ROUTINE TO BE CALLED WHEN CTRL_C IS PRESSED
3292    C
3293    	ISTAT = SYS$QIOW(,%VAL(TT_CHAN),
3294         +		%VAL(IO$_SETMODE .OR. IO$M_CTRLCAST),,,,
3295         +		CTRLC_TRAP,,%VAL(3),,,)
3296    C
3297    C	TEST ISTAT AND CALL LIB$STOP IF VALUE IS .FALSE.
3298    C
3299    	IF(.NOT.ISTAT)CALL LIB$STOP(%VAL(ISTAT))
3300    C
3301    C	OTHERWISE - RETURN
3302    C
3303    	RETURN 
3304    	END

ENABLE_CTRLC                   					27-Sep-1990 12:17:05	VAX FORTRAN V4.7-271                Page  24
								27-Jan-1989 07:48:20	DRA0:[APP.DSFC.SRC]DSFCVAX.SRC;1            

PROGRAM SECTIONS

    Name				 Bytes   Attributes

  0 $CODE                                   40   PIC CON REL LCL   SHR   EXE   RD NOWRT LONG
  2 $LOCAL                                  60   PIC CON REL LCL NOSHR NOEXE   RD   WRT LONG
  3 CTRLC                                   10   PIC OVR REL GBL   SHR NOEXE   RD   WRT LONG

    Total Space Allocated                  110


ENTRY POINTS

    Address  Type  Name          

  0-00000000       ENABLE_CTRLC  


VARIABLES

    Address  Type  Name              Address  Type  Name              Address  Type  Name              Address  Type  Name          

  3-00000006  I*2  IDCBA           3-00000008  I*2  IDCBZ               **      I*4  ISTAT           3-00000004  I*2  OUT_FILE      
  3-00000000  I*4  TT_CHAN       


FUNCTIONS AND SUBROUTINES REFERENCED

  Type  Name            Type  Name            Type  Name          

        CTRLC_TRAP            LIB$STOP         I*4  SYS$QIOW      

                               					27-Sep-1990 12:17:05	VAX FORTRAN V4.7-271                Page  25
								27-Jan-1989 07:48:20	DRA0:[APP.DSFC.SRC]DSFCVAX.SRC;1            

0001    C
0002    C-------------------------------------------------------------
0003    C	AST SUBROUTINE CTRL-C TRAP
0004    C-------------------------------------------------------------
0005    C
0006    C	THIS SUBROUTINE IS THE CTRL-C ASYNCHRONOUS TRAP (AST)
0007    C	AND, AFTER ENABLE_CTRLC IS EXECUTED, WILL BE EXECUTED
0008    C	WHENEVER CTRL-C IS PRESSED.  IF MULTIPLE CTRL-C PRESSES
0009    C	ARE ALLOWED, THIS ROUTINE MUST CALL ENABLE_CTRLC JUST
0010    C	PRIOR TO EXITING.
0011    C
0012    	SUBROUTINE CTRLC_TRAP
0013    	INTEGER*2 OUT_FILE,IDCB,IDCBA,IDCBZ
0014    	INTEGER*4 TT_CHAN
0015    	COMMON /CTRLC/TT_CHAN,OUT_FILE,IDCBA,IDCBZ
0016    C
0017    C	CTRL-C HAS BEEN PRESSED - INFORM THE USER, THEN PERFORM AN
0018    C	ORDERLY, CLEAN EXIT FROM THE PROGRAM
0019    C
0020    	IDCB = IDCBA
0021    	CLOSE (UNIT=IDCB,STATUS='KEEP',ERR=10,IOSTAT=IERR)
0022    	IDCB = IDCBZ
0023    	CLOSE (UNIT=IDCB,STATUS='KEEP',ERR=10,IOSTAT=IERR)
0024    	TYPE 20
0025    	WRITE(OUT_FILE,20)
0026     	TYPE 30
0027     	WRITE(OUT_FILE,30)
0028    	IDCB = OUT_FILE
0029    	CLOSE (UNIT=IDCB,STATUS='KEEP',ERR=10,IOSTAT=IERR)
0030    	TYPE *,'RESULTS STORED IN DSFC.RESULTS '
0031    	STOP 'STOP 9999'
0032    C
0033    C	IF AN ERROR OCCURED WHILE CLOSING THE FILES, COME HERE
0034    C	AND LET THE USER KNOW ABOUT THE PROBLEM, THEN CALL
0035    C	LIB$STOP TO FORCE AN EXIT WITH A DCL ERROR MESSAGE
0036    C	OTHERWISE - USE THE 'STOP 9999' EXIT
0037    C
0038       10	CONTINUE
0039    	TYPE *,'ERROR ',IERR,' CLOSING FILE ',IDCB
0040    	CALL ERRSNS(Ierr,Ists,Istv,Iunit,Icond)
0041    	CALL LIB$STOP(%VAL(Icond))
0042    C
0043       20	FORMAT(/,' 9999(TRAP) ===  CTRL_C RECEIVED, RUN ABORTED ABNORMALLY
0044         +		 ===:',//)
0045       30	FORMAT(' 9999(DSFC):  - - -  E N D    O F   P R O G R A M - - -')
0046    	END

CTRLC_TRAP                     					27-Sep-1990 12:17:05	VAX FORTRAN V4.7-271                Page  26
								27-Jan-1989 07:48:20	DRA0:[APP.DSFC.SRC]DSFCVAX.SRC;1            

PROGRAM SECTIONS

    Name				 Bytes   Attributes

  0 $CODE                                  287   PIC CON REL LCL   SHR   EXE   RD NOWRT LONG
  1 $PDATA                                 187   PIC CON REL LCL   SHR NOEXE   RD NOWRT LONG
  2 $LOCAL                                 116   PIC CON REL LCL NOSHR NOEXE   RD   WRT LONG
  3 CTRLC                                   10   PIC OVR REL GBL   SHR NOEXE   RD   WRT LONG

    Total Space Allocated                  600


ENTRY POINTS

    Address  Type  Name          

  0-00000000       CTRLC_TRAP    


VARIABLES

    Address  Type  Name              Address  Type  Name              Address  Type  Name              Address  Type  Name          

  2-00000014  I*4  ICOND           2-00000000  I*2  IDCB            3-00000006  I*2  IDCBA           3-00000008  I*2  IDCBZ         
  2-00000004  I*4  IERR            2-00000008  I*4  ISTS            2-0000000C  I*4  ISTV            2-00000010  I*4  IUNIT         
  3-00000004  I*2  OUT_FILE        3-00000000  I*4  TT_CHAN       


LABELS

    Address   Label       Address   Label       Address   Label   

  0-000000D0  10        1-0000003C  20'       1-00000081  30'     


FUNCTIONS AND SUBROUTINES REFERENCED

  Type  Name            Type  Name            Type  Name          

        FOR$CLOSE             FOR$ERRSNS            LIB$STOP      

                               					27-Sep-1990 12:17:05	VAX FORTRAN V4.7-271                Page  27
								27-Jan-1989 07:48:20	DRA0:[APP.DSFC.SRC]DSFCVAX.SRC;1            

0001    C
0002    C-------------------------------------------------------------
0003    C	SUBROUTINE GET FILE NAMES
0004    C-------------------------------------------------------------
0005    C
0006    C	THIS ROUTINE MAKES CLI (COMMAND LINE INTERPERTER) CALLS 
0007    C	TO DECODE THE FILE NAMES ENTERED ON THE DSFC COMMAND LINE
0008    C
0009    	SUBROUTINE GET_FILE_NAMES
0010    	INTEGER*4 CLI$PRESENT,CLI$GET_VALUE,ISTAT
0011    	CHARACTER*48 FILENAMEA,FILENAMEZ,TEST_NAME,namea,namez
0012    	LOGICAL OK,GOT_FILEA,GOT_FILEZ
0013    	COMMON /FNAMES/FILENAMEA,FILENAMEZ,OK,GOT_FILEA,GOT_FILEZ
0014    	OK = .FALSE.
0015    	GOT_FILEA = .FALSE.
0016    	ISTAT = CLI$PRESENT('FILEA')
0017    	IF(ISTAT)OK = .TRUE.
0018    	IF(OK) THEN
0019    	  ISTAT = CLI$GET_VALUE('FILEA',NAMEA)
0020    	  IF(ISTAT) THEN
0021    	    INQUIRE(FILE=NAMEA,EXIST=GOT_FILEA,NAME=FILENAMEA)
0022    	  ENDIF
0023    	ENDIF
0024    	OK = .FALSE.
0025    	GOT_FILEZ = .FALSE.
0026    	ISTAT = CLI$PRESENT('FILEZ')
0027    	IF(ISTAT) OK = .TRUE.
0028    	IF(OK) THEN
0029    	  ISTAT = CLI$GET_VALUE('FILEZ',NAMEZ)
0030    	  IF(ISTAT) THEN
0031    	    INQUIRE(FILE=NAMEZ,EXIST=GOT_FILEZ,NAME=FILENAMEZ)
0032    	  ENDIF
0033    	ENDIF
0034    	IF(GOT_FILEA .AND. GOT_FILEZ) RETURN
0035    	IF(.NOT.GOT_FILEA)THEN
0036    	  i = length(namea)
0037    	  type *,'WAS file: ',namea(1:i),', not good file name'
0038       10	  TYPE 30
0039    	  ACCEPT 50,TEST_NAME
0040    	  INQUIRE(FILE=TEST_NAME,EXIST=GOT_FILEA,NAME=FILENAMEA)
0041    	  IF(.NOT.GOT_FILEA)THEN
0042    	    I = LENGTH(TEST_NAME)
0043    	    TYPE *,' FILE ',TEST_NAME(1:I),' NOT FOUND'
0044    	    GOTO 10
0045    	  ENDIF
0046    	ENDIF
0047       20	IF(.NOT.GOT_FILEZ)THEN
0048    	  i = length(namez)
0049    	  type *,'IS file: ',namez(1:i),', not good file name'
0050    	  TYPE 40
0051    	  ACCEPT 50,TEST_NAME
0052    	  INQUIRE(FILE=TEST_NAME,EXIST=GOT_FILEZ,NAME=FILENAMEZ)
0053    	  IF(.NOT.GOT_FILEZ)THEN
0054    	    I = LENGTH(TEST_NAME)
0055    	    TYPE *,' FILE ',TEST_NAME(1:I),' NOT FOUND'
0056    	    GOTO 20
0057    	  ENDIF

GET_FILE_NAMES                 					27-Sep-1990 12:17:05	VAX FORTRAN V4.7-271                Page  28
								27-Jan-1989 07:48:20	DRA0:[APP.DSFC.SRC]DSFCVAX.SRC;1            

0058    	ENDIF
0059    	RETURN
0060       30 FORMAT(' Enter Was File: ',$)
0061       40 FORMAT(' Enter Is  File: ',$)
0062       50 FORMAT (A)
0063    	END




PROGRAM SECTIONS

    Name				 Bytes   Attributes

  0 $CODE                                  573   PIC CON REL LCL   SHR   EXE   RD NOWRT LONG
  1 $PDATA                                 111   PIC CON REL LCL   SHR NOEXE   RD NOWRT LONG
  2 $LOCAL                                 424   PIC CON REL LCL NOSHR NOEXE   RD   WRT LONG
  3 FNAMES                                 108   PIC OVR REL GBL   SHR NOEXE   RD   WRT LONG

    Total Space Allocated                 1216


ENTRY POINTS

    Address  Type  Name                            

  0-00000000       GET_FILE_NAMES                  


VARIABLES

    Address  Type  Name              Address  Type  Name              Address  Type  Name              Address  Type  Name          

  3-00000000  CHAR FILENAMEA       3-00000030  CHAR FILENAMEZ       3-00000064  L*4  GOT_FILEA       3-00000068  L*4  GOT_FILEZ     
      **      I*4  I                   **      I*4  ISTAT           2-00000030  CHAR NAMEA           2-00000060  CHAR NAMEZ         
  3-00000060  L*4  OK              2-00000000  CHAR TEST_NAME     


LABELS

    Address   Label       Address   Label       Address   Label       Address   Label       Address   Label   

  0-000000C4  10        0-00000158  20        1-00000043  30'       1-00000058  40'       1-0000006D  50'     


FUNCTIONS AND SUBROUTINES REFERENCED

  Type  Name            Type  Name            Type  Name            Type  Name          

   I*4  CLI$GET_VALUE    I*4  CLI$PRESENT           FOR$INQUIRE      I*4  LENGTH        

GET_FILE_NAMES                 					27-Sep-1990 12:17:05	VAX FORTRAN V4.7-271                Page  29
								27-Jan-1989 07:48:20	DRA0:[APP.DSFC.SRC]DSFCVAX.SRC;1            

COMMAND QUALIFIERS

  FORT/LIST=A.A DSFCVAX.SRC

  /CHECK=(NOBOUNDS,OVERFLOW,NOUNDERFLOW)
  /DEBUG=(NOSYMBOLS,TRACEBACK)
  /STANDARD=(NOSYNTAX,NOSOURCE_FORM)
  /SHOW=(NOPREPROCESSOR,NOINCLUDE,MAP,NODICTIONARY,SINGLE)
  /WARNINGS=(GENERAL,NODECLARATIONS,NOULTRIX)
  /CONTINUATIONS=19  /NOCROSS_REFERENCE  /NOD_LINES  /NOEXTEND_SOURCE  /F77
  /NOG_FLOATING  /I4  /NOMACHINE_CODE  /OPTIMIZE  /NOANALYSIS


COMPILATION STATISTICS

  Run Time:           29.28 seconds
  Elapsed Time:       35.10 seconds
  Page Faults:        1265
  Dynamic Memory:     1212 pages
