*-----------------------------------------------------------------------
*     G2FCTR
*-----------------------------------------------------------------------
*     Copyright (C) 2000-2022 GFD Dennou Club. All rights reserved.
*-----------------------------------------------------------------------
      SUBROUTINE G2FCTR(UX, UY, CX, CY)

      PARAMETER(NW=@MAXNGRID)

      REAL UXS(NW), UYS(NW)
      REAL UXA(NX), UYA(NY)
      REAL CXA(NX,NY), CYA(NX,NY)

      INTEGER NXS, NYS
      INTEGER IUXINC, IUYINC
      LOGICAL LINIT, LINI

      SAVE

      EXTERNAL LG2INQ
      LOGICAL  LG2INQ

      DATA LINIT /.FALSE./


      IF (.NOT.LINIT) CALL MSGDMP('E','G2FCTR','NOT YET INITIALIZED')

      II = IBLKGE(UXS,NXS,UX)
      I = MIN( MAX(1,II), NXS-1 )
      IF (II.EQ.NXS .AND. UXS(NXS).EQ.UX) II = NXS-1

      JJ = IBLKGE(UYS,NYS,UY)
      J = MIN( MAX(1,JJ), NYS-1 )
      IF (JJ.EQ.NYS .AND. UYS(NYS).EQ.UY) JJ = NYS-1

      CALL G2QGRD(I,J, CX11,CX21,CX12,CX22, CY11,CY21,CY12,CY22)

      P = (UX-UXS(I)) / (UXS(I+1)-UXS(I))
      Q = (UY-UYS(J)) / (UYS(J+1)-UYS(J))

      CALL G2FBL2(P,Q,CX11,CX21,CX12,CX22,CY11,CY21,CY12,CY22, CX,CY)

      IF (II.EQ.0 .OR. II.EQ.NXS .OR. JJ.EQ.0 .OR. JJ.EQ.NYS) THEN
        CALL MSGDMP('W','G2FCTR','UX OR UY: OUT OF THE RANGE')
      ENDIF

      RETURN
*-----------------------------------------------------------------------
      ENTRY G2ICTR(CX, CY, UX, UY)

      DO 20 J=1,NYS-1
        DO 10 I=1,NXS-1
          CALL G2QGRD(I,J, CX11,CX21,CX12,CX22, CY11,CY21,CY12,CY22)
          IF(LG2INQ(CX,CY,CX11,CX21,CX12,CX22,CY11,CY21,CY12,CY22)) THEN
            CALL G2IBL2(CX,CY,CX11,CX21,CX12,CX22,CY11,CY21,CY12,CY22,
     &                  P,Q)

            UX = P * (UXS(I+1)-UXS(I)) + UXS(I)
            UY = Q * (UYS(J+1)-UYS(J)) + UYS(J)
            RETURN
          ENDIF
   10   CONTINUE
   20 CONTINUE
*        CALL MSGDMP('E','G2ICTR','OUT OF THE WHOLE DOMAIN')
        CALL GLRGET('RUNDEF',RUNDEF)
        CALL MSGDMP('W','G2ICTR','OUT OF THE WHOLE DOMAIN')
       UX = RUNDEF
       UY = RUNDEF

      RETURN
*-----------------------------------------------------------------------
* -- whether already initialized
      ENTRY G2QCTI(LINI)

      LINI = LINIT

      RETURN
*-----------------------------------------------------------------------
* -- min & max in the destination coordinate
      ENTRY G2QCTM(CXMINE, CXMAXE, CYMINE, CYMAXE)

      CXMINE = CXMIN
      CXMAXE = CXMAX
      CYMINE = CYMIN
      CYMAXE = CYMAX

      RETURN
*-----------------------------------------------------------------------
      ENTRY G2SCTR(NX, NY, UXA,UYA, CXA,CYA)

      IF (NX.GT.NW) CALL MSGDMP('E','G2SCTR','WORKING AREA NOT ENOUGH')
      IF (NY.GT.NW) CALL MSGDMP('E','G2SCTR','WORKING AREA NOT ENOUGH')
      IF (NX.LT.2) CALL MSGDMP('E','G2SCTR','NX MUST BE >= 2')
      IF (NY.LT.2) CALL MSGDMP('E','G2SCTR','NY MUST BE >= 2')

      NXS = NX
      NYS = NY

      CALL GLRGET('RUNDEF',RUNDEF)

      IF (UXA(2).GT.UXA(1)) THEN
        IUXINC = 1
        UXS(1)=UXA(1)
        DO 30 I=2,NX
          IF (UXA(I).LE.UXA(I-1)) THEN
            CALL MSGDMP('E','G2SCTR','UX IS NOT STRICTLY MONOTONIC')
          ENDIF
          UXS(I)=UXA(I)
   30   CONTINUE
      ELSE
        IUXINC = 0
        UXS(NX)=UXA(1)
        DO 40 I=2,NX
          IF (UXA(I).GE.UXA(I-1)) THEN
            CALL MSGDMP('E','G2SCTR','UX IS NOT STRICTLY MONOTONIC')
          ENDIF
          UXS(NX-I+1)=UXA(I)
   40   CONTINUE
      ENDIF

      IF (UYA(2).GT.UYA(1)) THEN
        IUYINC = 1
        UYS(1)=UYA(1)
        DO 50 J=2,NY
          IF (UYA(J).LE.UYA(J-1)) THEN
            CALL MSGDMP('E','G2SCTR','UY IS NOT STRICTLY MONOTONIC*')
          ENDIF
          UYS(J)=UYA(J)
   50   CONTINUE
      ELSE
        IUYINC = 0
        UYS(NY)=UYA(1)
        DO 60 J=2,NY
          IF (UYA(J).GE.UYA(J-1)) THEN
            CALL MSGDMP('E','G2SCTR','UY IS NOT STRICTLY MONOTONIC')
          ENDIF
          UYS(NY-J+1)=UYA(J)
   60   CONTINUE
      ENDIF
      CALL G2SGRD(RUNDEF, IUXINC,IUYINC, NX,NY, CXA,CYA, UXS,UYS)

      IF (CXA(1,1) .NE. RUNDEF) THEN
         CXMIN = RMIN( CXA,NX*NY,1)
         CXMAX = RMAX( CXA,NX*NY,1)
      ELSE
         CXMIN = UXS(1)
         CXMAX = UXS(NX)
      ENDIF

      IF (CYA(1,1) .NE. RUNDEF) THEN
         CYMIN = RMIN( CYA,NX*NY,1)
         CYMAX = RMAX( CYA,NX*NY,1)
      ELSE
         CYMIN = UYS(1)
         CYMAX = UYS(NY)
      ENDIF

      LINIT = .TRUE.

      RETURN
      END
