!  . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
!  .                                                             .
!  .                  copyright (c) 1998 by UCAR                 .
!  .                                                             .
!  .       University Corporation for Atmospheric Research       .
!  .                                                             .
!  .                      all rights reserved                    .
!  .                                                             .
!  .                                                             .
!  .                         SPHEREPACK3.0                       .
!  .                                                             .
!  . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
!
!
! ... file ihgeod.f
!
!     contains documentation and code for subroutine ihgeod
!
!
      SUBROUTINE IHGEOD(M,Idp,Jdp,X,Y,Z)
      IMPLICIT NONE
      REAL beta , dphi , dxi , dxj , dyi , dyj , dzi , dzj , hdphi ,    &
         & phi , pi , rad , tdphi , theta , theta1 , theta2 , X , x1 ,  &
         & x2 , x3
      REAL x4 , x5 , x6 , xs , Y , y1 , y2 , y3 , y4 , y5 , y6 , ys ,   &
         & Z , z1 , z2 , z3 , z4 , z5 , z6 , zs
      INTEGER i , Idp , j , Jdp , k , M
      DIMENSION X(Idp,Jdp,5) , Y(Idp,Jdp,5) , Z(Idp,Jdp,5)
!
!     m         is the number of points on the edge of a
!               single geodesic triangle
!
!     x,y,z     the coordinates of the geodesic points on
!               the sphere are x(i,j,k), y(i,j,k), z(i,j,k)
!               where i=1,...,m+m-1; j=1,...,m; and k=1,...,5.
!               the indices are defined on the unfolded
!               icosahedron as follows for the case m=3
!
!                north pole
!
!                 (5,1)          0      l
!        i     (4,1) (5,2)              a    (repeated for
!           (3,1) (4,2) (5,3)  theta1   t    k=2,3,4,5 in
!        (2,1) (3,2) (4,3)              i        -->
!     (1,1) (2,2) (3,3)        theta2   t    the longitudinal
!        (1,2) (2,3)                    u    direction)
!           (1,3)                pi     d
!      j                                e
!         south pole
!
!                total number of points is 10*(m-1)**2+2
!                total number of triangles is 20*(m-1)**2
!                total number of edges is 30*(m-1)**2
!
      pi = 4.*ATAN(1.)
      dphi = .4*pi
      beta = COS(dphi)
      theta1 = ACOS(beta/(1.-beta))
      theta2 = pi - theta1
      hdphi = dphi/2.
      tdphi = 3.*hdphi
      DO k = 1 , 5
         phi = (k-1)*dphi
         CALL STOC(1.,theta2,phi,x1,y1,z1)
         CALL STOC(1.,pi,phi+hdphi,x2,y2,z2)
         CALL STOC(1.,theta2,phi+dphi,x3,y3,z3)
         dxi = (x2-x1)/(M-1)
         dyi = (y2-y1)/(M-1)
         dzi = (z2-z1)/(M-1)
         dxj = (x3-x2)/(M-1)
         dyj = (y3-y2)/(M-1)
         dzj = (z3-z2)/(M-1)
         DO i = 1 , M
            xs = x1 + (i-1)*dxi
            ys = y1 + (i-1)*dyi
            zs = z1 + (i-1)*dzi
            DO j = 1 , i
               X(j,i,k) = xs + (j-1)*dxj
               Y(j,i,k) = ys + (j-1)*dyj
               Z(j,i,k) = zs + (j-1)*dzj
            ENDDO
         ENDDO
         CALL STOC(1.,theta1,phi+hdphi,x4,y4,z4)
         dxi = (x3-x4)/(M-1)
         dyi = (y3-y4)/(M-1)
         dzi = (z3-z4)/(M-1)
         dxj = (x4-x1)/(M-1)
         dyj = (y4-y1)/(M-1)
         dzj = (z4-z1)/(M-1)
         DO j = 1 , M
            xs = x1 + (j-1)*dxj
            ys = y1 + (j-1)*dyj
            zs = z1 + (j-1)*dzj
            DO i = 1 , j
               X(j,i,k) = xs + (i-1)*dxi
               Y(j,i,k) = ys + (i-1)*dyi
               Z(j,i,k) = zs + (i-1)*dzi
            ENDDO
         ENDDO
         CALL STOC(1.,theta1,phi+tdphi,x5,y5,z5)
         dxj = (x5-x3)/(M-1)
         dyj = (y5-y3)/(M-1)
         dzj = (z5-z3)/(M-1)
         DO i = 1 , M
            xs = x4 + (i-1)*dxi
            ys = y4 + (i-1)*dyi
            zs = z4 + (i-1)*dzi
            DO j = 1 , i
               X(j+M-1,i,k) = xs + (j-1)*dxj
               Y(j+M-1,i,k) = ys + (j-1)*dyj
               Z(j+M-1,i,k) = zs + (j-1)*dzj
            ENDDO
         ENDDO
         CALL STOC(1.,0.,phi+dphi,x6,y6,z6)
         dxi = (x5-x6)/(M-1)
         dyi = (y5-y6)/(M-1)
         dzi = (z5-z6)/(M-1)
         dxj = (x6-x4)/(M-1)
         dyj = (y6-y4)/(M-1)
         dzj = (z6-z4)/(M-1)
         DO j = 1 , M
            xs = x4 + (j-1)*dxj
            ys = y4 + (j-1)*dyj
            zs = z4 + (j-1)*dzj
            DO i = 1 , j
               X(j+M-1,i,k) = xs + (i-1)*dxi
               Y(j+M-1,i,k) = ys + (i-1)*dyi
               Z(j+M-1,i,k) = zs + (i-1)*dzi
            ENDDO
         ENDDO
      ENDDO
      DO k = 1 , 5
         DO j = 1 , M + M - 1
            DO i = 1 , M
               CALL CTOS(X(j,i,k),Y(j,i,k),Z(j,i,k),rad,theta,phi)
               CALL STOC(1.,theta,phi,X(j,i,k),Y(j,i,k),Z(j,i,k))
            ENDDO
         ENDDO
      ENDDO
    END SUBROUTINE IHGEOD

    
    SUBROUTINE CTOS(X,Y,Z,R,Theta,Phi)
      IMPLICIT NONE
      REAL Phi , R , r1 , Theta , X , Y , Z
      r1 = X*X + Y*Y
      IF ( r1/=0. ) THEN
         R = SQRT(r1+Z*Z)
         r1 = SQRT(r1)
         Phi = ATAN2(Y,X)
         Theta = ATAN2(r1,Z)
         GOTO 99999
      ENDIF
      Phi = 0.
      Theta = 0.
      IF ( Z<0. ) Theta = 4.*ATAN(1.)
      RETURN
99999 END SUBROUTINE CTOS

      
      SUBROUTINE STOC(R,Theta,Phi,X,Y,Z)
      IMPLICIT NONE
      REAL Phi , R , st , Theta , X , Y , Z
      st = SIN(Theta)
      X = R*st*COS(Phi)
      Y = R*st*SIN(Phi)
      Z = R*COS(Theta)
      END SUBROUTINE STOC



      SUBROUTINE DIHGEOD(M,IDP,JDP,X,Y,Z)
        IMPLICIT NONE
        INTEGER M,  IDP, JDP, I, J, K
      DOUBLE PRECISION X
      DOUBLE PRECISION Y
      DOUBLE PRECISION Z
      DOUBLE PRECISION PI
      DOUBLE PRECISION DPHI
      DOUBLE PRECISION BETA
      DOUBLE PRECISION THETA1
      DOUBLE PRECISION THETA2
      DOUBLE PRECISION HDPHI
      DOUBLE PRECISION TDPHI
      DOUBLE PRECISION PHI
      DOUBLE PRECISION X1
      DOUBLE PRECISION Y1
      DOUBLE PRECISION Z1
      DOUBLE PRECISION X2
      DOUBLE PRECISION Y2
      DOUBLE PRECISION Z2
      DOUBLE PRECISION X3
      DOUBLE PRECISION Y3
      DOUBLE PRECISION Z3
      DOUBLE PRECISION DXI
      DOUBLE PRECISION DYI
      DOUBLE PRECISION DZI
      DOUBLE PRECISION DXJ
      DOUBLE PRECISION DYJ
      DOUBLE PRECISION DZJ
      DOUBLE PRECISION XS
      DOUBLE PRECISION YS
      DOUBLE PRECISION ZS
      DOUBLE PRECISION X4
      DOUBLE PRECISION Y4
      DOUBLE PRECISION Z4
      DOUBLE PRECISION X5
      DOUBLE PRECISION Y5
      DOUBLE PRECISION Z5
      DOUBLE PRECISION X6
      DOUBLE PRECISION Y6
      DOUBLE PRECISION Z6
      DOUBLE PRECISION RAD
      DOUBLE PRECISION THETA
      DIMENSION X(IDP,JDP,5),Y(IDP,JDP,5),Z(IDP,JDP,5)
!
!     m         is the number of points on the edge of a
!               single geodesic triangle
!
!     x,y,z     the coordinates of the geodesic points on
!               the sphere are x(i,j,k), y(i,j,k), z(i,j,k)
!               where i=1,...,m+m-1; j=1,...,m; and k=1,...,5.
!               the indices are defined on the unfolded
!               icosahedron as follows for the case m=3
!
!                north pole
!
!                 (5,1)          0      l
!        i     (4,1) (5,2)              a    (repeated for
!           (3,1) (4,2) (5,3)  theta1   t    k=2,3,4,5 in
!        (2,1) (3,2) (4,3)              i        -->
!     (1,1) (2,2) (3,3)        theta2   t    the longitudinal
!        (1,2) (2,3)                    u    direction)
!           (1,3)                pi     d
!      j                                e
!         south pole
!
!                total number of points is 10*(m-1)**2+2
!                total number of triangles is 20*(m-1)**2
!                total number of edges is 30*(m-1)**2
!
      PI = 4.D0*ATAN(1.D0)
      DPHI = .4D0*PI
      BETA = COS(DPHI)
      THETA1 = ACOS(BETA/ (1.D0-BETA))
      THETA2 = PI - THETA1
      HDPHI = DPHI/2.D0
      TDPHI = 3.D0*HDPHI
      DO K = 1,5
          PHI = (K-1)*DPHI
          CALL DSTOC(1.D0,THETA2,PHI,X1,Y1,Z1)
          CALL DSTOC(1.D0,PI,PHI+HDPHI,X2,Y2,Z2)
          CALL DSTOC(1.D0,THETA2,PHI+DPHI,X3,Y3,Z3)
          DXI = (X2-X1)/ (M-1)
          DYI = (Y2-Y1)/ (M-1)
          DZI = (Z2-Z1)/ (M-1)
          DXJ = (X3-X2)/ (M-1)
          DYJ = (Y3-Y2)/ (M-1)
          DZJ = (Z3-Z2)/ (M-1)
          DO I = 1,M
              XS = X1 + (I-1)*DXI
              YS = Y1 + (I-1)*DYI
              ZS = Z1 + (I-1)*DZI
              DO J = 1,I
                  X(J,I,K) = XS + (J-1)*DXJ
                  Y(J,I,K) = YS + (J-1)*DYJ
                  Z(J,I,K) = ZS + (J-1)*DZJ
              END DO
          END DO
          CALL DSTOC(1.D0,THETA1,PHI+HDPHI,X4,Y4,Z4)
          DXI = (X3-X4)/ (M-1)
          DYI = (Y3-Y4)/ (M-1)
          DZI = (Z3-Z4)/ (M-1)
          DXJ = (X4-X1)/ (M-1)
          DYJ = (Y4-Y1)/ (M-1)
          DZJ = (Z4-Z1)/ (M-1)
          DO J = 1,M
              XS = X1 + (J-1)*DXJ
              YS = Y1 + (J-1)*DYJ
              ZS = Z1 + (J-1)*DZJ
              DO I = 1,J
                  X(J,I,K) = XS + (I-1)*DXI
                  Y(J,I,K) = YS + (I-1)*DYI
                  Z(J,I,K) = ZS + (I-1)*DZI
              END DO
          END DO
          CALL DSTOC(1.D0,THETA1,PHI+TDPHI,X5,Y5,Z5)
          DXJ = (X5-X3)/ (M-1)
          DYJ = (Y5-Y3)/ (M-1)
          DZJ = (Z5-Z3)/ (M-1)
          DO I = 1,M
              XS = X4 + (I-1)*DXI
              YS = Y4 + (I-1)*DYI
              ZS = Z4 + (I-1)*DZI
              DO J = 1,I
                  X(J+M-1,I,K) = XS + (J-1)*DXJ
                  Y(J+M-1,I,K) = YS + (J-1)*DYJ
                  Z(J+M-1,I,K) = ZS + (J-1)*DZJ
              END DO
          END DO
          CALL DSTOC(1.D0,0.D0,PHI+DPHI,X6,Y6,Z6)
          DXI = (X5-X6)/ (M-1)
          DYI = (Y5-Y6)/ (M-1)
          DZI = (Z5-Z6)/ (M-1)
          DXJ = (X6-X4)/ (M-1)
          DYJ = (Y6-Y4)/ (M-1)
          DZJ = (Z6-Z4)/ (M-1)
          DO J = 1,M
              XS = X4 + (J-1)*DXJ
              YS = Y4 + (J-1)*DYJ
              ZS = Z4 + (J-1)*DZJ
              DO I = 1,J
                  X(J+M-1,I,K) = XS + (I-1)*DXI
                  Y(J+M-1,I,K) = YS + (I-1)*DYI
                  Z(J+M-1,I,K) = ZS + (I-1)*DZI
              END DO
          END DO
      END DO
      DO K = 1,5
          DO J = 1,M + M - 1
              DO I = 1,M
                  CALL DCTOS(X(J,I,K),Y(J,I,K),Z(J,I,K),RAD,THETA,PHI)
                  CALL DSTOC(1.D0,THETA,PHI,X(J,I,K),Y(J,I,K),Z(J,I,K))
              END DO
          END DO
      END DO
      RETURN
    END SUBROUTINE DIHGEOD
    
    SUBROUTINE DCTOS(X,Y,Z,R,THETA,PHI)
      DOUBLE PRECISION X
      DOUBLE PRECISION Y
      DOUBLE PRECISION Z
      DOUBLE PRECISION R
      DOUBLE PRECISION THETA
      DOUBLE PRECISION PHI
      DOUBLE PRECISION R1

      R1 = X*X + Y*Y
      IF (R1.NE.0.D0) GO TO 10
      PHI = 0.D0
      THETA = 0.D0
      IF (Z.LT.0.D0) THETA = 4.D0*ATAN(1.D0)
      RETURN
   10 R = SQRT(R1+Z*Z)
      R1 = SQRT(R1)
      PHI = ATAN2(Y,X)
      THETA = ATAN2(R1,Z)
      RETURN
    END SUBROUTINE DCTOS
    
    SUBROUTINE DSTOC(R,THETA,PHI,X,Y,Z)
      DOUBLE PRECISION R
      DOUBLE PRECISION THETA
      DOUBLE PRECISION PHI
      DOUBLE PRECISION X
      DOUBLE PRECISION Y
      DOUBLE PRECISION Z
      DOUBLE PRECISION ST

      ST = SIN(THETA)
      X = R*ST*COS(PHI)
      Y = R*ST*SIN(PHI)
      Z = R*COS(THETA)
      RETURN
    END SUBROUTINE DSTOC
