C ----------------------------------------------------------------------!-------
      SUBROUTINE GTANH
C ----------------------------------------------------------------------!-------
! 17 Aug 2011 - Correction
! 15 Aug 2011 - Converted from Microsoft FORTRAN to FORTRAN 90
C ----------------------------------------------------------------------!-------
C     TERRAIN 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 TERRAIN DATA.      
C ----------------------------------------------------------------------!-------
C     COMMON DECK "CONST" INSERTED HERE                            
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      COMMON/PCONST/CREF,RGAS,GAMMA      
      COMMON/MCONST/PI,PIT2,PID2,DEGS,RAD,ALN10
      DOUBLE PRECISION C(49), LAM0,LMI,LMIM1,LM(49), DL(49),ALC(50)

C     COMMON DECK "RKAM" INSERTED HERE                   
      DOUBLE PRECISION KR,KTH,KPH
      COMMON//R,TH,PH,KR,KTH,KPH,RKVARS(14),TPULSE,CSTEP,DRDT(20)

C     COMMON DECK "GG" INSERTED HERE 
      DOUBLE PRECISION MODG
      COMMON/GG/MODG(4)             
      COMMON/GG/G,PGR,PGRR,PGRTH,PGRPH
      COMMON/GG/PGTH,PGPH,PGTHTH,PGPHPH,PGTHPH,GSELECT,GTIME

C     COMMON DECK "B9" INSERTED HERE                        
      INTEGER GMX,GNTBL,GITBL,GFRMTBL,IDSG(10)              
      COMMON/B9/GMX,GNTBL(10),GITBL(10),GFRMTBL(10),GGP(113)
      EQUIVALENCE (GGP,IDSG),(ANG,GGP(11))                  

      COMMON/WW/ dum(10), MAXW,W(1000)
      EQUIVALENCE (EARTHR,W(1))
C     TOPOGRAPHY   300-324     

      EQUIVALENCE (LAM0,GGP(12)),(Z0,GGP(62)),(DL0,GGP(112)) 
      EQUIVALENCE (LM,GGP(13)),(C,GGP(63)),(DL,GGP(113))     
      INTEGER GPX    ,GQTBL(10),GLTBL(10),GIRMTBL(10)        
      DATA AQG/0.0/        
      DATA GPX/2/          
      DATA GQTBL/1,11,162,7*0/
      DATA GLTBL/1,50,8*0/    
      DATA GIRMTBL/1,2,8*0/   
C
C ----------------------------------------------------------------------!-------
      ENTRY SETTOP 
C ----------------------------------------------------------------------!-------
      ANG=AQG      
      GMX=GPX      
      CALL IMOVE(GNTBL,GQTBL,10) 
      CALL IMOVE(GITBL,GLTBL,10) 
      CALL IMOVE(GFRMTBL,GIRMTBL,10)
      CALL SETPTP                   
      RETURN
C
C ----------------------------------------------------------------------!-------
      ENTRY ITOPOG  
C ----------------------------------------------------------------------!-------
      CALL IPTOPOG  
C     IF HAD PREVIOUS CALL BUT NOTHING THIS TIME, EXIT NOW
C     RETAINING PREVIOUS TABULAR DATA COUNT               
      IF(N.GT.0 .AND. ANG.EQ.0.d0) RETURN                 
      IF(W(300) .NE. 3.) THEN
           PRINT*,' Model check number mismatch: '
           STOP ' W(300) should be 3 if you are using model GTANH.'
      ENDIF

      MODG(1)='GTANH'                                              ! 15 Aug 2011
      MODG(2)= w(302)
! 17 Aug 2011      N=ANG/3          
! 17 Aug 2011      IF(ANG.NE.3*N.OR.N.LE.0) then
      N = (ANG+1)/3 - 2                                            ! 17 Aug 2011
      IF(N.LT.0) then                                              ! 17 Aug 2011
           PRINT*,' ERROR in GTANH.  Invalid number of points = ',N
           STOP   ' at entry ITOPOG.'
      endif
! 17 Aug 2011      N=N-2      
      ANG=0.d0   
C
C
C     CONVERT 'Z' ARRAY INPUT(OVERLAYS 'C' ARRAY) TO 'C' ARRAY 
      ZM1=Z0   
      LAM0=PID2-LAM0  
      LMIM1=LAM0      
      NP1=N+1         
      DO 10 I=1,NP1   
         Z=C(I)       
         LMI=PID2-LM(I) 
         LM(I)=LMI      
         ALC(I)=ALCOSH((LMI-LAM0) / DL(I))
         C(I)=(Z-ZM1)/(LMI-LMIM1)  
         ZM1=Z    
10       LMIM1=LMI
      RETURN
C
C ----------------------------------------------------------------------!-------
      ENTRY TOPOG 
C ----------------------------------------------------------------------!-------
      anc=n
      IF(N.LE.0) then
           PRINT*,' ERROR in GTANH.  Invalid number of points = ',n
           STOP   ' at entry TOPOG.'
      endif
      SUM = 0.d0 
      DO 1 I = 1, N
   1  SUM = SUM + DL(I) * (C(I + 1) - C(I)) / 2.d0 *(ALCOSH(((TH-LM
     1(I)) / DL(I))) - ALC(I))
      Z = Z0 - SUM + (C(1) + C(N + 1)) * (TH-LAM0) / 2.d0 
      G=R-EARTHR-Z
      PGR=1.d0    
      PGTH = C(1) 
      DO 2 I = 1, N
   2  PGTH= PGTH+(C(I + 1) - C(I)) / 2.d0*(1.d0+dTANH ((LM(I)- TH) /DL
     1 (I)))      
      PGTH=-PGTH  
      PGTHTH=0.d0 
      DO 3 I=1,N  
3     PGTHTH=PGTHTH+
     1    (C(I+1)-C(I))/2.d0*(1.d0-dTANH((LM(I)-TH)/DL(I))**2)/DL(I)  
      CALL PTOPOG
      RETURN     
C ----------------------------------------------------------------------!-------
      END SUBROUTINE GTANH       
C ----------------------------------------------------------------------!-------