*-----------------------------------------------------------------------
*     BASIC ROUTINES
*-----------------------------------------------------------------------
*     UMSPCT : CONTACT POINT MODE
*-----------------------------------------------------------------------
*     Copyright (C) 2000-2022 GFD Dennou Club. All rights reserved.
*-----------------------------------------------------------------------
      SUBROUTINE UMSPCT

      COMMON    /UMWK1/ITR, RUNDEF, IUNDEF, PI, CPR, CPD, CP

      SAVE


      CALL SGQMPL(PLX, PLY, PLROT)
      IF (PLX.NE.RUNDEF .AND. PLY.NE. RUNDEF .AND.
     +    PLROT.NE.RUNDEF ) RETURN

      CALL UMQCNT(XCTCT, YCTCT, ROT)
      IF (XCTCT .EQ. RUNDEF .OR. YCTCT.EQ.RUNDEF .OR.
     +      ROT .EQ. RUNDEF ) RETURN

      XCTCTZ = XCTCT/CPR
      YCTCTZ = YCTCT/CPR
      ROTZ   = ROT/CPR

*--------------------- CYLINDRICAL PROJECTION --------------------------

      IF (10.LE.ITR .AND. ITR.LE.19) THEN
        IF (ROTZ .NE. 0.) THEN
          A = PI/2. - YCTCTZ
          C = ACOS(SIN(A)*COS(ROTZ))
          ALPH = SIGN(ACOS(COS(A)/SIN(C)), ROTZ)
          BETA = SIGN(ACOS(-COS(ALPH)*COS(ROTZ)), ROTZ)

          PLX = (XCTCTZ-BETA)*CPR
          PLY = (PI/2.- C)*CPR
          PLROT = (PI-ALPH)*CPR

        ELSE
          PLY = PI/2.*CPR - ABS(YCTCT)
          IF (YCTCT.LE.0) THEN
            PLX = XCTCT
            PLROT =  0
          ELSE
            PLX = XCTCT + PI*CPR
            PLROT = - PI*CPR
          END IF
        END IF

*----------------------- CONICAL PROJECTION ----------------------------

      ELSE IF (20.LE.ITR .AND. ITR.LE.24) THEN
        CALL SGRGET('STLAT1', ST1)
        IF (ITR.EQ.22) THEN
          CALL SGRGET('STLAT2', ST2)
          IF (ST1 .EQ. RUNDEF) THEN
            ST1 = MAX(YCTCT-5.*CPD, -PI/2.)
            CALL SGRSET('STLAT1', ST1)
          END IF
          IF (ST2 .EQ. RUNDEF) THEN
            ST2 = MIN(YCTCT+5.*CPD, PI/2.)
            CALL SGRSET('STLAT2', ST2)
          END IF
          YC = (ST1+ST2)/2./CPR
        ELSE
          IF (ST1 .EQ. RUNDEF) THEN
            ST1 = YCTCT
            CALL SGRSET('STLAT1', ST1)
          END IF
          YC = ST1/CPR
        END IF
        IF (YC .EQ. 0)
     +    CALL MSGDMP('E', 'UMSCNT', 'INVALID STANDARD LATITUDE')

        IF (ROT .NE. 0.) THEN
          A = PI/2. - YCTCTZ
          B = PI/2. - YC
          C = ACOS(COS(A)*COS(B) + SIN(A)*SIN(B)*COS(ROTZ))
          ALPH = SIGN(ACOS((COS(A)-COS(C)*COS(B))/(SIN(C)*SIN(B))),ROTZ)
          BETA = SIGN(ACOS((COS(B)-COS(C)*COS(A))/(SIN(C)*SIN(A))),ROTZ)

          PLX = (XCTCTZ-BETA)*CPR
          PLY = (PI/2.- C)*CPR
          PLROT = (PI-ALPH)*CPR

        ELSE
          PLX = XCTCT
          PLY =   90.*CPD
          PLROT =  0.*CPD
        END IF

*---------------------- AZIMUTHAL PROJECTION ---------------------------

      ELSE IF (30.LE.ITR .AND. ITR.LE.34) THEN
        PLX = XCTCT
        PLY = YCTCT
        PLROT = ROT
      ELSE
        CALL MSGDMP('E', 'UMSCNT', 'INVALID ITR')
      END IF

      CALL SGSMPL(PLX, PLY, PLROT)

      END
