CTITLESAONESG -- INTERPOLATE SEGMENT DEPTH C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA CA DESIGNER JAMES SUN CA AUTHOR JAMES SUN CA LANGUAGE CRAY FORTRAN CA SYSTEM IBM AND CRAY CA WRITTEN 02/08/89 CA C REVISED 03/31/89 JCS - REAPPLY MUTE TO THE DEPTH SECTION C REVISED 07/08/89 JJC - MODIFIED TO MEET EDP STANDARDS. C REVISED 02/05/90 JJC - RENAMED ONESEG TO SAONESG. C RENAMED LINTRP TO SALINTP. C RENAMED VSPCOFF TO SASPCOE. C RENAMED VSPLINE TO SAVSPLN. C REVISED 05/24/90 JCS - USED NINT FOR IND IN LINE 94. C REVISED 07/23/90 CLJ - ALLOW PREP TO RUN ON THE IBM C CA CA CALLING PROCEDURE: CA SUBROUTINE SAONESG (W1,W2,NSEG,JXRNG,S,INDEX,NPT,KSEG,RHO, CA 1 TAU,DX,DZ,XNOT,NX,ZNOT,IABORT,KINTP,IPR) CA C CALLING ARGUMENTS CA CA INPUT W1 INPUT X COORDINATE R4 CA INPUT W2 INPUT DEPTH R4 CA OUTPUT NSEG SEGMENT BEGINNING / ENDING INDEX I4 CA NSEG(1,KSEG) SEGMENT BEGINNING INDEX CA NSEG(2,KSEG) SEGMENT ENDING INDEX CA OUTPUT JXRNG DEPTH INDEX ARRAY I4 CA OUTPUT S INTERPOLATION WORKING ARRAY R4 CA OUTPUT INDEX INTERPOLATION WORKING ARRAY I4 CA INPUT NPT NUMBER OF INPUT POINTS I4 CA INPUT KSEG SEGMENT NUMBER I4 CA OUTPUT RHO INTERPOLATION WORKING ARRAY R4 CA OUTPUT TAU INTERPOLATION WORKING ARRAY R4 CA INPUT DX X SPACING R4 CA INPUT DZ DEPTH STEP SIZE R4 CA INPUT XNOT BEGINNING X COORDINATE R4 CA INPUT NX NO. OF X GRIDS I4 CA INPUT ZNOT SMALLEST Z R4 CA OUTPUT IABORT ABORT FLAG I4 CA INPUT KINTP INTERPOLATION FLAG (LINEAR OR SPLINE) I4 CA 0 = LINEAR INTERPOLATION CA 1 = CUBIC SPLINE INTERPOLATION CA INPUT IPR PRINT UNIT I4 C CA THIS SUBROUTINE INTERPOLATE THE DEPTH FOR EACH SEGMENT. C C SUBROUTINE SAONESG (W1,W2,NSEG,JXRNG,S,INDEX,NPT,KSEG,RHO, 03330000 1 TAU,DX,DZ,XNOT,NX,ZNOT,IABORT,KINTP,IPR) 03340000 C 03350000 IMPLICIT INTEGER(A-Z) C REAL DX REAL DZ REAL RHO REAL S REAL SLOPE REAL TAU REAL SAVSPLN REAL W1 REAL W2 REAL XA REAL XNOT REAL XRDX REAL Z REAL ZNOT REAL ZRDZ C DIMENSION W1(1),W2(1),NSEG(2,1),JXRNG(1),S(1),INDEX(1) 03360000 DIMENSION RHO(1),TAU(1) 03370000 C 03380000 C IF(NPT .LE. 1) THEN 03390000 IABORT=1000 03400000 RETURN 03410000 ENDIF 03420000 C 03430000 C XRDX=(W1(1)-XNOT)/DX 03440000 IST=XRDX+1.5 03450000 IF(IST.EQ.0) IST=1 C C IF(W1(1) .LT. XNOT) THEN 03460000 C IF(IST .LT. 1) THEN 03470000 IABORT=3000 03480000 RETURN 03490000 ENDIF 03500000 C 03510000 C XRDX=(W1(NPT)-XNOT)/DX 03520000 CJCS IND=XRDX+1.50001 03530000 IND=NINT(XRDX+1.0) C C IF(W1(NPT) .GT. XL) THEN 03540000 C IF(IND .GT. NX) THEN 03550000 IABORT=4000 03560000 RETURN 03570000 ENDIF 03580000 C 03590000 C IVERTI=0 03600000 C CJCS XRDX=(W1(1)-XNOT)/DX 03610000 CJCS IST=XRDX+1.5 03620000 CJCS XRDX=(W1(NPT)-XNOT)/DX 03630000 CJCS IND=XRDX+1.5 03640000 C WRITE(IPR,7091) XNOT,W1(1),W1(NPT),IST,IND C7091 FORMAT(' XNOT,W1(1),W1(NPT),IST,IND =',3E12.5,2I5) C NSEG(1,KSEG)=IST 03650000 NSEG(2,KSEG)=IND 03660000 IF((IND-IST) .LE. 1) IVERTI=1 03670000 C 03680000 CDIR$ IVDEP 03690000 C DO 100 K=2,NPT 03700000 IF((W1(K)-W1(K-1)) .LT. 0.) THEN 03710000 IABORT=2000 03720000 ENDIF 03730000 100 CONTINUE 03740000 C 03750000 C IF(IABORT.EQ.2000) GO TO 220 03760000 C 03770000 C 120 CONTINUE 03780000 ZRDZ=(W2(1)-ZNOT)/DZ 03790000 J=ZRDZ+1.5 03800000 JXRNG(IST)=J 03810000 ZRDZ=(W2(NPT)-ZNOT)/DZ 03820000 J=ZRDZ+1.5 03830000 JXRNG(IND)=J 03840000 IF(IVERTI .EQ. 1) GO TO 220 03850000 C 03860000 C ITBEG=IST+1 03870000 ITEND=IND-1 03880000 IF(KINTP.EQ.1) THEN 03890000 C 03900000 C IF(NPT .EQ. 2) GO TO 160 03910000 C 03920000 C CALL SASPCOE(NPT,W1,W2,S,INDEX,RHO,TAU) 03930000 C 03940000 CDIR$ IVDEP 03950000 C DO 140 I=ITBEG,ITEND 03960000 XA=(I-1)*DX+XNOT 03970000 Z=SAVSPLN(NPT,W1,W2,S,INDEX,XA) 03980000 ZRDZ=(Z-ZNOT)/DZ 03990000 J=ZRDZ+1.5 04000000 JXRNG(I)=J 04010000 140 CONTINUE 04020000 GO TO 220 04030000 C 04040000 C 160 CONTINUE 04050000 SLOPE=(W2(NPT)-W2(1))/(W1(NPT)-W1(1)) 04060000 C 04070000 CDIR$ IVDEP 04080000 C DO 180 I=ITBEG,ITEND 04090000 Z=W2(1)+SLOPE*(I-IST)*DX 04100000 ZRDZ=(Z-ZNOT)/DZ 04110000 J=ZRDZ+1.5 04120000 JXRNG(I)=J 04130000 180 CONTINUE 04140000 GO TO 220 04150000 ELSE 04160000 XA=(ITBEG-1)*DX+XNOT 04170000 LPT=ITEND-ITBEG+1 04180000 CALL SALINTP(W1,W2,NPT,XA,DX,LPT,S(ITBEG)) 04190000 DO 200 I=ITBEG,ITEND 04200000 ZRDZ=(S(I)-ZNOT)/DZ 04210000 J=ZRDZ+1.5 04220000 JXRNG(I)=J 04230000 200 CONTINUE 04240000 ENDIF 04250000 C 04260000 C 220 CONTINUE 04270000 RETURN 04280000 END 04290000