C ----------------------------------------------------------------------!-------
      SUBROUTINE GTANH2
C ----------------------------------------------------------------------!-------
! 17 Aug 2011 - C array no longer overlays Z array
! 16 Aug 2011 - Uses FTANH2 and ITANH2 subroutines
! 15 Aug 2011 - Maximum number of points in the profile  is now a PARAMETER Nmax
! 15 Aug 2011 - Copied from GTANH.FOR
! 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 ----------------------------------------------------------------------!-------
      parameter (Nmax=50)                                          ! 15 Aug 2011
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

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

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

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                        
      COMMON/B9/GMX,GNTBL(10),GITBL(10),GFRMTBL(10),GGP(3*Nmax+11)
      INTEGER GMX,GNTBL,GITBL,GFRMTBL,IDSG(10)              
C ----------------------------------------------------------------------!-------
      DOUBLE PRECISION C(Nmax-1),ALC(Nmax),DLC(Nmax),DC(Nmax)      ! 15 Aug 2011
      DOUBLE PRECISION LAM0,LM(Nmax-1), DL(Nmax-1)                 ! 15 Aug 2011
      DOUBLE PRECISION LAMBDA                                      ! 16 Aug 2011
      DOUBLE PRECISION ZM(Nmax-1)                                  ! 17 Aug 2011
      EQUIVALENCE (GGP,IDSG),(ANG,GGP(11)),(LAM0,GGP(12))
      EQUIVALENCE (Z0,GGP(Nmax+12)),(DL0,GGP(2*Nmax+12))           ! 15 Aug 2011
      EQUIVALENCE (LM(1),GGP(13)),(DL(1),GGP(2*Nmax+13))           ! 15 Aug 2011
      EQUIVALENCE (ZM(1),GGP(Nmax+13))                             ! 17 Aug 2011

      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 ----------------------------------------------------------------------!-------
C     This entry point is called once.

      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 ----------------------------------------------------------------------!-------
C     This entry point is called once for each new W array.

      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. 6.) THEN
           PRINT*,' Model check number mismatch: '
           STOP ' W(300) should be 6 if you are using model GTANH2.'
      ENDIF

      MODG(1)='GTANH2'     
      MODG(2)= w(302)
      N = (ANG+1)/3 - 2         
      IF(N.LT.0) then 
           PRINT*,' ERROR in GTANH2.  Invalid number of points = ',N
           STOP   ' at entry ITOPOG.'
      endif
      ANG=0.d0   

C     CONVERT 'ZM' ARRAY INPUT(does not OVERLAY 'C' ARRAY) TO 'C' ARRAY 
      CALL ITANH2(N,LAM0,LM,Z0,ZM,DL,C,CAV,DLC,ALC,DC)             ! 16 Aug 2011
      RETURN
C ----------------------------------------------------------------------!-------
      ENTRY TOPOG 
C ----------------------------------------------------------------------!-------
      IF(N.LE.0) then
           PRINT*,' ERROR in GTANH2.  Invalid number of points = ',n
           STOP   ' at entry TOPOG.'
      endif

      PGRR = 0.d0
      PGRTH = 0.d0
      PGRPH = 0.d0
      PGPH = 0.d0
      PGPHPH = 0.d0
      PGTHPH = 0.d0

      lambda = pid2-th
C ----------------------------------------------------------------------!-------
      CALL ftanh2(lambda,z,pzlm,pzlmlm,n,LAM0,LM,z0,dl,c,CAV,DLC,ALC,DC)!16 Aug 2011
      G=R-EARTHR-Z
      PGR=1.d0    
      PGTH=pzlm  
      PGTHTH=-pzlmlm
      CALL PTOPOG
      RETURN     
C ----------------------------------------------------------------------!-------
      END SUBROUTINE GTANH2
C ----------------------------------------------------------------------!-------