CTITLESANGPT -- PRINT THE ANGLE VALUES FOR THE LITH PROGRAM 00010001 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** C 00020000 CA AUTHOR ARCO 00030000 CA DESIGNER ARCO 00040000 CA LANGUAGE FORTRAN H 00050000 CA WRITTEN 09-01-84 00060000 C REVISED MO-DA-YR BY PROGRAMMER 00070000 C REVISED 04-02-87 JMP - PUT IN PRODUCTION SPARC. 00080001 C 00090000 CA CALLING SEQUENCE: 00100000 CA CALL SANGPT (OUTDDN, RANGLE, SRDI, GROUPI, NOFFST, PVEL,DEPTH, 00110001 CA * NLAYER, KPNA, KPRNO, DA, DENTRY, KPRTF) 00111001 CA 00120000 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00130000 CA 00140000 CA IN OUTDDN I4 OUTDDN OF THE OUTPUT DEVICE 00150000 CA IN RANGLE R4 REFLECTION ANGLE ARRAY FROM REFANG ROUTINE 00151000 CA IN SRDI R4 NEAR TRACE OFFSET 00152000 CA IN GROUPI R4 GROUP INTERVAL 00153000 CA IN NOFFST I4 NUMBER OF OFFSETS 00155000 CA IN PVEL R4 ARRAY OF VELOCITIES 00156001 CA IN DEPTH R4 ARRAY OF DEPTHS 00157001 CA IN NLAYER R4 NUMBER OF LAYERS. 00158001 CA IN KPNA A4 PROCESS NAME 00159001 CA IN KPRNO I4 PROCESS NUMBER 00159101 CA IN/OUT DA I4 DISK ADDRESS TO WRITE PARAMETER RECORDS. 00159201 CA OUT DENTRY I4 104-WORD ARRAY USED IN WRITING FORMATTED 00159301 CA SPARC PARAMETER CARDS. 00159401 CA OUT KPRTF I4 RETURN FLAG 00159501 CA 00160000 CA PURPOSE OF PROGRAM: 00170000 CA THIS SUBROUTINE IS USED TO GENERATE A PRINTOUT OF THE MODEL 00180000 CA ANGLES FOR THE LITHO PLOT PROGRAM IN SPARC FORMATTED CARDS. 00190000 CA 00200000 CA 00210000 C--------------------------------------------------------------------- 00220000 SUBROUTINE SANGPT ( OUTDDN, RANGLE, SRDI, GROUPI, NOFFST, 00230001 * PVEL, DEPTH, NLAYER, KPNA, KPRNO, DA, 00231001 * DENTRY, KPRTF) 00232001 C 00240001 C____________________________________________________________ 00250001 C 00260001 REAL PVEL ( 1) 00730501 3 , DEPTH ( 1) 00730801 INTEGER NLAYER 00731101 INTEGER DENTRY ( 104) 00731201 C 00791100 REAL RANGLE ( 50,240) 00870001 1 , SRDI 00880000 2 , GROUPI 00881000 C 00890000 INTEGER OUTDDN 00960001 1 , NOFFST 00962001 2 , OFFST ( 240) 00963001 3 , ITIME ( 50) 00964001 C 00970000 C**************************************************** 00980000 C 00990000 C OUTPUT THE ANGLES 01000000 C 01010000 C**************************************************** 01020000 C 01030000 C 01041000 C**************************************************** 01042000 C 01043000 C FIRST CALCULATE THE TWO WAY TRAVEL TIME 01044000 C 01045000 C**************************************************** 01046000 C 01047000 ITIME(1) = IFIX (2000.0 * (DEPTH(1) / PVEL(1))) 01047101 DO 100 I = 2, NLAYER 01048001 ITIME(I) = ITIME(I-1) + IFIX (2000.0 * (DEPTH(I) / PVEL(I))) 01050001 100 CONTINUE 01050100 C 01051000 C**************************************************** 01052000 C 01053000 C NOW CREATE THE TABLE OF OFFSETS 01054000 C 01055000 C**************************************************** 01056000 C 01057000 DO 200 I = 1, NOFFST 01058000 OFFST(I) = IFIX (SRDI + ((I - 1) * GROUPI)) 01059000 200 CONTINUE 01059100 C 01059200 C**************************************************** 01059300 C 01059400 C NOW OUTPUT THE ANGLES 01059500 C 01059600 C**************************************************** 01059700 C 01059800 DENTRY(1) = KPNA 01060001 DENTRY(2) = KPRNO 01061001 CALL S1MVCH('TIM ', 1, DENTRY(3), 1, 4) 01062001 WRITE (OUTDDN, 9010) 01063001 C 01070001 DO 2000 I = 1, NLAYER 01120000 WRITE (OUTDDN, 9000) ITIME(I), 01140001 1 (OFFST(JJJ),RANGLE(I,JJJ),JJJ=1,6) 01141001 CALL S1MVCH('TIM ', 1, DENTRY(9), 1, 4) 01141101 DENTRY(10) = ITIME(I) 01141201 N = MIN0(NOFFST, 6) 01141301 DENTRY(6) = 2 + 2 * N 01141401 C 01141501 DO 1150 K = 1, 2 * N, 2 01141601 L = (K + 1) / 2 01141701 DENTRY(10 + K) = OFFST(L) 01141801 CALL S1MVCH(RANGLE(I, L), 1, DENTRY(11+K), 1, 4) 01142101 1150 CONTINUE 01142201 C 01142301 CALL FOWP(KPNA, KPRNO, DA, 104, DENTRY, *2100) 01142701 C 01142801 CALL S1MVCH(' ', 1, DENTRY(9), 1, 4) 01143001 C 01144001 DO 1000 J = 7, NOFFST, 6 01150001 JJ = J + 5 01160000 WRITE (OUTDDN, 9001) ITIME(I), 01161001 1 (OFFST(JJJ),RANGLE(I,JJJ),JJJ=J,JJ) 01170000 N = MIN0(NOFFST - J + 1, 6) 01170101 DENTRY(6) = 2 + 2 * N 01170201 C 01170301 DO 1160 K = 1, 2 * N, 2 01170401 L = (K + 1) / 2 01170501 DENTRY(10 + K) = OFFST(J + L - 1) 01170601 CALL S1MVCH(RANGLE(I, J+L-1), 1, DENTRY(11+K), 1, 4) 01170901 1160 CONTINUE 01171001 C 01171101 CALL FOWP(KPNA, KPRNO, DA, 104, DENTRY, *2100) 01172001 1000 CONTINUE 01180000 C 01180101 2000 CONTINUE 01181000 C 01181101 GO TO 2200 01182001 C 01182101 2100 CONTINUE 01183001 C 01183101 WRITE (OUTDDN, 9020) 01184001 KPRTF = -1 01185001 C 01186001 2200 CONTINUE 01187001 C 01188001 RETURN 01190000 C 01191000 C**************************************************** 01192000 C 01193000 C FORMAT STATEMENTS 01194000 C 01195000 C**************************************************** 01196000 C 01197000 9000 FORMAT (' TIM',I5,(6(I5,F5.2))) 01198001 9001 FORMAT (' ',I5,(6(I5,F5.2))) 01199001 9010 FORMAT(/,/,' LITH PARAMETERS CALCULATED FROM VELOCITY MODEL:', 01199101 * /) 01199201 9020 FORMAT (' *** ERROR *** WRITE ERROR IN FOWP ***') 01199301 C 01199401 END 01200000