*-----------------------------------------------------------------------
*     MAP PROJECTION (VAN DER GRINTEN)              2007-11-04 E. TOYODA
*-----------------------------------------------------------------------
*     Copyright (C) 2000-2022 GFD Dennou Club. All rights reserved.
*-----------------------------------------------------------------------
      SUBROUTINE MPXVDG(XLON, YLAT, X, Y)

      PARAMETER (EPSL = 1.0E-5, EPSX = 1.0E-3)
      PARAMETER (PLDYDB = 25.0, PLDXDB = 1000.0)
      EXTERNAL  RFPI, XMPLON
      REAL LAMBDA, HALFPI

      PI = RFPI()
      HALFPI = PI * 0.5
      LAMBDA = XMPLON(XLON)
      PHI = YLAT
      IF (PHI .GT. HALFPI - EPSL) THEN
        Y = PI + PLDYDB * (PHI - HALFPI)
        X = PLDXDB * LAMBDA * DIM(PHI, HALFPI)
        GOTO 8000
      ELSEIF (PHI .LT. -HALFPI + EPSL) THEN
        Y = -PI + PLDYDB * (PHI + HALFPI)
        X = PLDXDB * LAMBDA * DIM(-PHI, HALFPI)
        GOTO 8000
      ELSEIF (ABS(PHI) .LT. EPSL) THEN
        Y = PHI
        IF (ABS(LAMBDA) .LT. EPSL) THEN
          X = LAMBDA
          GOTO 8000
        ENDIF
        A = 0.5 * ABS(PI / LAMBDA - LAMBDA / PI)
        IF (LAMBDA .GT. 0.0) THEN
          X = PI * (SQRT(A**2 + 1) - A)
        ELSE
          X = -PI * (SQRT(A**2 + 1) - A)
        ENDIF
        GOTO 8000
      ENDIF
      TH = ASIN(ABS(2.0 * PHI / PI))
      G = COS(TH) / (SIN(TH) + COS(TH) - 1.0)
      P = G * (2.0 / SIN(TH) - 1.0)
      IF (ABS(LAMBDA) .LT. EPSX) THEN
        X = LAMBDA
        Y = +9.770711E-01 * PHI
     &      +5.484717E-01 * PHI**3
     &      -2.441382E+00 * PHI**5
     &      +5.923668E+00 * PHI**7
     &      -7.208943E+00 * PHI**9
     &      +4.639224E+00 * PHI**11
     &      -1.500824E+00 * PHI**13
     &      +1.924256E-01 * PHI**15
        GOTO 8000
      ENDIF
      A = 0.5 * ABS(PI / LAMBDA - LAMBDA / PI)
      Q = A * A + G
      IF (LAMBDA .GT. 0.0) THEN
        SGNLAM = 1.0
      ELSE
        SGNLAM = -1.0
      ENDIF
      X = SGNLAM * (
     &    PI * (A * (G - P**2)                                          &
     &  + SQRT(A**2 * (G - P**2)**2 - (P**2 + A**2) * (G**2 - P**2)))   &
     &  ) / (P * P + A * A)
      IF (PHI .GE. 0.0) THEN
        SGNPHI = 1.0
      ELSE
        SGNPHI = -1.0
      ENDIF
      Y = SGNPHI * PI * ABS(P * Q - A * SQRT((A**2 + 1) * (P**2 + A**2) &
     &  - Q**2)) / (P**2 + A**2)
 8000 CONTINUE
      END
*-----------------------------------------------------------------------
      SUBROUTINE MPFVDG(XLON, YLAT, X, Y)
        EXTERNAL MPXVDG
        CALL MPXVDG(XLON, YLAT, X, Y)
        RETURN
      ENTRY MPIVDG(X, Y, XLON, YLAT)
        XLON = X * 0.5
        YLAT = Y * 0.5
        CALL MPNWTN(X, Y, XLON, YLAT, MPXVDG, .FALSE.)
      END
