C-----------------------------------------------------------------------------
      SUBROUTINE CTANH
C-----------------------------------------------------------------------------
C     SPEED PROFILE REPRESENTED BY A SEQUENCE OF LINEAR SEGMENTS   
C     SMOOTHLY JOINED BY HYPERBOLIC FUNCTIONS. PARAMETERS ARE INPUT
C     AS TABULAR DATA WITH SLOPES COMPUTED FROM SPEED DATA.        
C     REFERENCE SPEED C0 IS READ FROM TABULAR DATA.                
      implicit double precision (a-h,o-z)
      COMMON//R,TH,PH,KR,KTH,KPH,RKVARS(14),TPULSE,CSTEP,DRDT(20)
C     COMMON DECK "CC" INSERTED HERE
      DOUBLE PRECISION MODC
      INTEGER CPX,CQTBL(10),CLTBL(10),CIRMTBL(10)  
      COMMON/CC/MODC(4),CS,PCST,PCSR,PCSTH,PCSPH    
      COMMON/WW/ dum(10), MAXW,W(1000)
C     SOUND SPEED 150-174 
      EQUIVALENCE (W(153),REFC),(earthr,w(1))                                         CWW30120
      INTEGER CMX,CNTBL,CITBL,CFRMTBL,IDSC(20) 
      COMMON/B3/CMX,CNTBL(10),CITBL(10),CFRMTBL(10),CGP(512)
      EQUIVALENCE (CGP,IDSC),(ANC,CGP(11))
C.......The changes from the Cyber version indicated in lower case 
C.......below enlarge the data arrays to accommodate 100 profile points.
      DOUBLE PRECISION co(100), tm(99), z(99), dl(99)
      EQUIVALENCE (Z0,CGP(12)),(CO,cgp(112))
      EQUIVALENCE (Z,CGP(13)),(TM,cgp(113)),(DL,cgp(213))
      data cqtbl/1,11,312,7*0/
      data cltbl/1,100,8*0/   
      DATA CIRMTBL/1,2,8*0/  
      DATA N/0/
      DATA AQC/0.0/ 
      DATA CPX/2/   
C%      COSH (X) = (dEXP (X) + 1.d0 / (dEXP (X))) / 2.d0 ! not needed
C
      ENTRY SETSPD  
      ANC=AQC       
      CMX=CPX       
      CALL IMOVE(CNTBL,CQTBL,10)  
      CALL IMOVE(CITBL,CLTBL,10) 
      CALL IMOVE(CFRMTBL,CIRMTBL,10)
      CALL SETPSP
      RETURN     
C
      ENTRY ISPEED
C     IF HAD PREVIOUS CALL BUT NOTHING THIS TIME, EXIT NOW
C     RETAINING PREVIOUS TABULAR DATA COUNT
      CALL IPSPEED 
      IF(N.GT.0 .AND. ANC.EQ.0.d0) RETURN 
      IF(W(150) .NE. 7.) THEN
           PRINT*,' Model check number mismatch: '
           STOP ' W(150) should be 7 if you are using model CTANH.'
      ENDIF

      MODC(1)=8HCTANH   
      MODC(2)= w(152)
      N=(ANC+1)/3 - 2
      avl=float(n)   
      IF(N.LE.0) then
           PRINT*,' ERROR in CTANH.  Invalid number of points = ',N+2
           STOP   ' at entry ISPEED.'
      endif
      ANC=0.d0
C     CONVERT 'CGP' ARRAY INPUT(OVERLAYS 'C' ARRAY) TO 'C' ARRAY 
      C0=CO(1) 
      TIM1=C0  
      ZIM1=Z0  
      NP1=N+1  
      DO 10 I=1,NP1
         TI=TM(I)  
         ZI=Z(I)   
         CO(I)=(TI-TIM1)/(ZI-ZIM1)  
         TIM1=TI 
10       ZIM1=ZI 
      RETURN 
C 
      ENTRY SPEED 
      H = R - EARTHR
      SUM = 0.d0
C     LOOP TO SUM OVER ALL COEFFICIENTS 
C     USE SPECIAL FUNCTION 'ALCOSH' WHICH ALLOWS FOR LARGE ARGUMENTS.
      DO 1 I = 1, N
   1  SUM = SUM + DL(I) * (CO(I + 1) - CO(I)) / 2.d0 *(ALCOSH((H - Z
     1(I)) / DL(I)) - ALCOSH((Z(I)-Z0) / DL(I)))
      C = C0 + SUM + (CO(1) + CO(N + 1)) * (H - Z0) * 0.5d0
      SUM = 0.d0
      DO 2 I = 1, N
   2  SUM = SUM + (CO(I + 1) - CO(I)) / 2.d0*(1.d0+dTANH((H - Z(I)) /DL
     1 (I)))
      CS=C*C
      PCST=0.d0
      PCSR = 2.d0*C*(CO(1) + SUM)    
      PCSTH=0.d0 
      PCSPH=0.d0 
      CALL PSPEED
      RETURN 
      END 
                                                                                
 
