CTITLESAMODL -- CALCULATE LITH ANGLES FROM VELOCITY MODEL 00010002 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** C 00020000 CA AUTHOR J. M. PONTON 00030001 CA DESIGNER J. M. PONTON 00040001 CA LANGUAGE VS FORTRAN 00050001 CA SYSTEM IBM 00060001 CA WRITTEN 04-02-87 00070001 C REVISED MO-DA-YR BY PROGRAMMER 00080000 C 00090000 CA CALL SAMODL(KPNA, KPRNO, IPR, KPRTF, DAP, DENTRY) 00100001 CA 00110000 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00120001 CA ------ -------- ---- ----------- 00130001 CA IN KPNA A4 PROCESS NAME 00140001 CA IN KPRNO I4 PROCESS NUMBER 00150001 CA IN IPR I4 PRINT UNIT 00160001 CA OUT KPRTF I4 RETURN STATUS ( -1 = ERROR) 00180001 CA IN/OUT DAP I4 DISK ADDRESS TO WRITE CARDS TO. 00180101 CA OUT DENTRY I4 104-WORD DENTRY ARRAY. 00181001 CA 00190000 CA PURPOSE OF PROGRAM: 00200000 CA THIS PROGRAM IS USED TO CALCULATE THE ANGLES USED IN THE LITH 00210001 CA PROCESS. IT IS CALLED BY THE LITH PREP, AND OUTPUTS A SET OF 00220001 CA LITH PARAMETER CARDS, USED AS INPUT BY LITH'S PROC. 00230001 CA 00240000 SUBROUTINE SAMODL(KPNA, KPRNO, IPR, KPRTF, DAP, DENTRY) 00250001 C 00260001 REAL *4 PVEL ( 50) 00530001 1 , SVEL ( 50) 00540001 2 , RHOB ( 50) 00550001 3 , DEPTH ( 50) 00560001 INTEGER NLAYER 00590001 INTEGER DENTRY(104) 00600001 C 00610000 DOUBLE PRECISION ALPHA ( 50) 00780001 * , ANGLE ( 50) 00790001 * , RADIAN 00810001 C 00820000 C____________________________________________________________ 01070000 C 01080000 C 01090000 C THIS PROGRAM WILL READ THE INPUT OF A NUMBER OF LAYERS,THE 01110000 C DISTANCE BETWEEN THE SHOT AND THE FIRST RECEIVER, THE DIST- 01120000 C ANCE BETWEEN RECEIVERS, AND THE NUMBER OF RECEIVERS. THEN 01130000 C IT WILL READ THE P AND S WAVE VELOCITIES, THICKNESS, AND 01140000 C DENSITY OF EACH LAYER. 01150000 C A NEWTON-RAPHSHON APPROXIMATION WILL BE MADE FOR 01190001 C THETA-1, THE INCIDENT ANGLE FROM THE SHOT/SOURCE. WITH 01200001 C VELOCITIES OF EACH LAYER, AND THETA-1, THE INCIDENT ANGLES 01210001 C AT EACH LAYER CAN BE CALCULATED. 01220001 C THESE ANGLES ARE FORMATTED INTO PARAMETER CARDS FOR THE 01230001 C SPARC PROCESS 'LITH'. 01240001 C 01390000 C**************************************************** 01430000 C 01440000 C LOCAL VARIABLES 01450000 C 01460000 C**************************************************** 01470000 C 01480000 INTEGER *4 NSR 01490000 * , NMAXL / 50/ 01500001 * , NMAXOF / 240/ 01501001 REAL RANGLE ( 50, 240) 01510001 DOUBLE PRECISION D 01520001 INTEGER DA 01530001 CHARACTER*80 CARD 01550001 C 01560000 C ********************************************************** 01570001 C VARIABLE LIST IN ALPHABETIC ORDER: 01580001 C 01590001 C 01600001 C ALPHA: ALPHA(I)=PVEL(I)/PVEL(1): AN ARRAY 01850000 C OUTPUTTING PURPOSES. 01860000 C ANGLE: STORAGE OF THETA-1'S FOR EACH RAY REFLECTING OFF LAYER 01870000 C BOTTOMS: AN ARRAY 01880000 C DEPTH: AN ARRAY HOLDING THE THICKNESSES OF EACH LAYER. 01890001 C IK: AN INTEGER ITERATOR FOR THE MAJOR DO LOOP THAT CHANGES 01940000 C THE VALUE OF THE SHOT TO RECEIVER DISTANCE. 01950000 C NLAYER: NUMBER OF LAYERS 01960001 C NMAXL: MAXIMUM NUMBER OF LAYERS. 01970000 C NSR: NUMBER OF RECEIVERS. 01980000 C PVEL: P WAVE VELOCITIES FOR EACH LAYER: AN ARRAY. 01990000 C RHOB: DENSITIES FOR EACH LAYER: AN ARRAY 02000000 C SVEL: SHEAR WAVE VELOCITIES FOR EACH LAYER: AN ARRAY 02010000 C SRD: ASSUMES THE VALUE OF THE SHOT-RECEIVER DISTANCE. 02030000 C SRDI: THE INITIAL SHOT-RECEIVER DISTANCE. 02040000 C SRINC: THE DISTANCE BETWEEN RECEIVERS.(I.E. SHOT-RECEIVER 02050000 C INCREMENT). 02060000 C ************************************************************** 02070000 C 02080000 KPRTF = 0 02100001 RADIAN = 180.0 / (4.0 * ATAN(1.0)) 02120001 C 02130000 C INPUT THE INITIAL SHOT TO RECEIVER DISTANCE, 02140001 C THE DISTANCE BETWEEN RECEIVERS, AND THE NUMBER OF RECEIVERS. 02150001 C 02180000 DA = 1 02190001 C 02200001 C READ 'INP' PARAMETER CARDS. 02210001 C 02220001 1010 CONTINUE 02230001 CALL FORC(KPNA, KPRNO, DA, CARD, *1020) 02240001 IF (CARD(8:10) .NE. 'INP') GO TO 1010 02250001 READ (CARD(16:20), 9000) ISRDI 02260001 SRDI = ISRDI 02270001 READ (CARD(21:25), 9000) ISRINC 02280001 SRINC = ISRINC 02290001 READ (CARD(26:30), 9000) NSR 02300001 C 02320001 C PRINT OUT INP PARAMETERS 02390001 C 02400001 WRITE (IPR, 9020) ISRDI,ISRINC,NSR 02410001 C 02411001 C CHECK NUMBER OF RECEIVERS. 02412001 C 02413001 IF (NSR .GT. NMAXOF) THEN 02414001 WRITE (IPR, 9060) NMAXOF 02415001 KPRTF = -1 02416001 ENDIF 02417001 C 02418001 1020 CONTINUE 02420001 C 02430001 DA = 1 02500001 NLAYER = 0 02510001 C 02520001 C READ 'MOD' PARAMETER CARDS. 02530001 C 02540001 1100 CONTINUE 02550001 CALL FORC(KPNA, KPRNO, DA, CARD, *1120) 02560001 IF (CARD(8:10) .NE. 'MOD') GO TO 1100 02570001 C 02580001 C INPUT THE THICKNESS,P AND SHEAR WAVE VELOCITIES,AND DENSITY 02590001 C FOR EACH LAYER. 02600001 C 02610001 NLAYER = NLAYER + 1 02620001 IF (NLAYER .GT. NMAXL) THEN 02630001 WRITE (IPR, 9050) NMAXL 02640001 KPRTF = -1 02650001 GO TO 1120 02660001 ENDIF 02670001 C 02680001 READ (CARD(11:15), 9000) IDUM 02690001 DEPTH(NLAYER) = IDUM 02700001 READ (CARD(16:20), 9000) IDUM 02710001 PVEL(NLAYER) = IDUM 02720001 READ (CARD(21:25), 9000) IDUM 02730001 SVEL(NLAYER) = IDUM 02740001 READ (CARD(26:30), 9010) RHOB(NLAYER) 02750001 C 02760001 GO TO 1100 02770001 1120 CONTINUE 02780001 C 02790001 C WRITE OUT MODEL DEPTHS, VELOCITIES AND DENSITIES. 02800001 C 02810001 DEEP = 0 02820001 WRITE (IPR, 9030) 02830001 DO 1130 I = 1, NLAYER 02840001 DEEP = DEEP + DEPTH(I) 02850001 WRITE (IPR, 9040) I,DEPTH(I), PVEL(I), SVEL(I), RHOB(I), 02860001 * DEEP 02870001 1130 CONTINUE 02880001 C 02960001 C CALCULATE THE REFRACTION COEFFICIENT 02970001 C 02980001 DO 1140 I = 1, NLAYER 03010001 ALPHA(I) = PVEL(I) / PVEL(1) 03020001 1140 CONTINUE 03030001 C 03040001 C MAIN LOOP TO CALCULATE ANGLES. 03050001 C 03060001 DO 160 IK=1,NSR 03260000 C 03270000 C CALCULATE THE SHOT RECEIVER DISTANCE. 03280000 C 03290000 SRD=SRDI+(IK-1)*SRINC 03300000 C 03310000 C MAKE THE NEWTON-RAPHSON APPROXIMATION OF THETA 03340001 C INITIALIZE THE DEPTH TO THE ITH LAYER TO ZERO 03350001 C 03360001 D = 0.0 03390001 DO 1500 I = 1, NLAYER 03470001 CALL SANRAP (SRD, I, D, DEPTH, ALPHA, ANGLE) 03480001 1500 CONTINUE 03490001 C 03500001 DO 150 I = 1, NLAYER 03530001 RANGLE(I, IK) = DASIN(ALPHA(I) * DSIN(ANGLE(I))) * RADIAN 03540001 150 CONTINUE 03550001 C 03560001 160 CONTINUE 03600000 C 03610001 C PRINT THE LITH CARDS 03620001 C 03630001 CALL SANGPT (IPR, RANGLE, SRDI, SRINC, NSR, PVEL, DEPTH, 03640001 * NLAYER, KPNA, KPRNO, DAP, DENTRY, KPRTF) 03641001 C 03650000 RETURN 03660001 C 03670001 9000 FORMAT(I5) 03680001 C 03690001 9010 FORMAT(F5.2) 03700001 C 03710001 9020 FORMAT(40X,'*** PARAMETERS FROM INP CARD ***',/,/, 03720001 * 25X,'INITIAL S-R DISTANCE .......',I6,/, 03730001 * 25X,'S-R INCREMENT ..............',I6,/, 03740001 * 25X,'NUMBER OF S-R LOCATIONS ....',I6,/) 03750001 C 03760001 9030 FORMAT(T10,'LAYER',T20,'THICKNESS',T30,'PVEL',T40,'SVEL',T50, 03770001 * 'DENSITY',T60,'DEPTH') 03780001 C 03790001 9040 FORMAT(T10,I6,T20,F6.0,T30,F6.0,T40,F6.0,T50,F6.2,T60,F7.0) 03800001 C 03810001 9050 FORMAT(' *** ERROR *** MAX. NUMBER OF LAYERS IS ',I6) 03820001 C 03830001 9060 FORMAT(' *** ERROR *** MAX. NUMBER OF RECEIVERS IS ',I6) 03831001 C 03832001 END 03840000