CTITLE SARDSVA -- DATUM AND SURFACE VELOCITY CARD DECODING C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA CA DESIGNER J. V. S. HARVEY CA LANGUAGE VS FORTRAN (77) CA WRITTEN 29 MAR 1988 CA CA CA THIS SUBROUTINE DECODES THE DSV CARD FOR SURFACE PARAMETERS TO CA BE USED IN REFRACTION INVERSION CA CA CA CALL SARDSVA( IPR, CARD, DATUMF, CA NSHOT, SHOTNO, CA NVPICK, VLOCAT, VELOC1, CA NDATUM, DLOCAT, UDATUM, ERR1 ) CA CA CA IN/OUT ARGUMENT TYPE DESCRIPTION CA CA IN IPR I4 PRINT UNIT NUMBER CA CA IN CARD CH80 INPUT FBN CARD CA CA IN DATUMF CH4 PROCESS DATUM OPTION FLAG CA 'USER' = USER-DEFINED DATUM CA IN NSHOT I4 NUMBER OF SHOTPOINTS (PICKED) CA IN SHOTNO I2 PICKED SHOTPOINT NUMBER LIST CA ( 1-D ARRAY DIMENSIONED: NSHOT ) CA CA UPDATE NVPICK I4 NUMBER OF CURRENT VELOCITY PICKS CA UPDATE VLOCAT I2 LOCATION INDICES OF VELOCITY PICKS CA ( 1-D ARRAY DIMENSIONED: 24 ) CA UPDATE VELOC1 R4 SURFACE VELOCITY (V1) FUNCTION CA ( 1-D ARRAY DIMENSIONED: 24 ) CA CA UPDATE NDATUM I4 NUMBER OF CURRENT DATUM PICKS CA UPDATE DLOCAT I2 LOCATION INDICES OF DATUM PICKS CA ( 1-D ARRAY DIMENSIONED: 24 ) CA UPDATE UDATUM R4 USER-DEFINED DATUM FUNCTION CA ( 1-D ARRAY DIMENSIONED: 24 ) CA CA OUT ERR1 I4 ERROR FLAG CA 0 FOR NO ERRORS CA 1 INVALID LOCATION INDEX CA 2 INVALID VELOCITY CA 3 MORE THAN 24 VELOCITY PICKS CA 4 INVALID DATUM ELEVATION CA 5 MORE THAN 24 DATUM PICKS CA 6 EMPTY DSV CARD CA C*********************************************************************** C C SUBROUTINES CALLED: (NONE) C C*********************************************************************** C SUBROUTINE SARDSVA( IPR, CARD, DATUMF, * NSHOT, SHOTNO, * NVPICK, VLOCAT, VELOC1, * NDATUM, DLOCAT, UDATUM, ERR1 ) IMPLICIT INTEGER (A-Z) C CHARACTER*80 CARD INTEGER*2 SHOTNO(NSHOT) CHARACTER*4 DATUMF INTEGER*2 VLOCAT(24) REAL VELOC1(24) INTEGER*2 DLOCAT(24) REAL UDATUM(24) C REAL V REAL Z C C*********************************************************************** C*** **** C*** DSV CARD DECODING **** C*** **** C*********************************************************************** C ERR1 = 6 C DO 150 I = 11, 56, 15 J = I + 4 C---------------------------------------------------------------------- C C LOCATION INDEX C IF( CARD(I:J) .NE. ' ' ) THEN ERR1 = 1 READ( CARD(I:J), 7000, ERR=999 ) LOCAT C C CONVERT SHOTPOINT LABELS INTO SHOT INDICES C IF( LOCAT .GT. 0 ) THEN SHOT = 0 DO 125 SHOTX = 1, NSHOT SHOTL = SHOTNO(SHOTX) IF( SHOTL .EQ. LOCAT ) SHOT = SHOTX 125 CONTINUE LOCAT = SHOT ENDIF C---------------------------------------------------------------------- C C SURFACE PARAMETERS C IF( LOCAT .NE. 0 ) THEN K = I + 5 L = K + 4 C IOFLAG = 0 C C SURFACE VELOCITY (V1) PICK C IF( CARD(K:L) .NE. ' ' ) THEN ERR1 = 2 READ( CARD(K:L), 7005, ERR=999 ) V C NVPICK = NVPICK + 1 ERR1 = 3 C IF( NVPICK .LE. 24 ) THEN VLOCAT(NVPICK) = LOCAT VELOC1(NVPICK) = V ERR1 = 0 IOFLAG = 1 ENDIF ENDIF C C DATUM PICK C IF( DATUMF .EQ. 'USER' ) THEN K = K + 5 L = K + 4 C IF( CARD(K:L) .NE. ' ' ) THEN ERR1 = 4 READ( CARD(K:L), 7005, ERR=999 ) Z C NDATUM = NDATUM + 1 ERR1 = 5 C IF( NDATUM .LE. 24 ) THEN DLOCAT(NDATUM) = LOCAT UDATUM(NDATUM) = Z ERR1 = 0 IOFLAG = IOFLAG + 2 ENDIF ENDIF ENDIF C---------------------------------------------------------------------- C C OUTPUT C IF( IOFLAG .EQ. 1 ) THEN IF( LOCAT .GT. 0 ) THEN WRITE( IPR, 8110 ) SHOTNO(LOCAT), V ELSE LOCAT = 0 - LOCAT WRITE( IPR, 8115 ) LOCAT, V ENDIF C ELSE IF( IOFLAG .EQ. 2 ) THEN IF( LOCAT .GT. 0 ) THEN WRITE( IPR, 8120 ) SHOTNO(LOCAT), Z ELSE LOCAT = 0 - LOCAT WRITE( IPR, 8125 ) LOCAT, Z ENDIF C ELSE IF( IOFLAG .EQ. 3 ) THEN IF( LOCAT .GT. 0 ) THEN WRITE( IPR, 8110 ) SHOTNO(LOCAT), V, Z ELSE LOCAT = 0 - LOCAT WRITE( IPR, 8115 ) LOCAT, V, Z ENDIF ENDIF ENDIF ENDIF 150 CONTINUE 999 RETURN C C*********************************************************************** C*** **** C*** FORMAT STATEMENTS **** C*** **** C*********************************************************************** C 7000 FORMAT(I5) 7005 FORMAT(F5.0) C 8110 FORMAT(10X,'SHOT ',I5,2(5X,F10.1)) 8115 FORMAT(10X,'RECV ',I5,2(5X,F10.1)) C 8120 FORMAT(10X,'SHOT ',I5,20X,F10.1) 8125 FORMAT(10X,'RECV ',I5,20X,F10.1) END