SUBROUTINE SUFPG2(KFPRGP,LDSAME,LDPOSHOR,PFPLA,PFPLO,PFPGM,PFPNORX,PFPNORY)
 
!**** *SUFPG2*  - INITIALIZE OUTPUT GEOMETRY ARRAYS (Full-POS)
 
!     PURPOSE.
!     --------
!        COMPUTES THE COORDINATES OF OUTPUT POINTS IN THE GEOMETRY OF THE
!        MODEL, THE OUTPUT MAP FACTOR AND THE RELATIVE ROTATION MATRIX.
!        WHEN AN OUTPUT POINT IS AT A GEOGRAPHICAL POLE,
!        THE EQUATION OF THE COMPASS IS DEGENERATING,
!        SO A DIRECT (AND EXACT) COMPUTATION IS NEEDED.
 
!**   INTERFACE. *CALL* *SUFPG2*
!     ----------
 
!        EXPLICIT ARGUMENTS :
!        ------------------
!         All dummy arguments are DM-global.
 
!         INPUT:
!         KFPRGP           : number of points on the (complete) output grid(s)
!         LDSAME           : .TRUE. if the input grid is the same as the output grid
 
!         OUTPUT:
!         LDPOSHOR         : .TRUE. if actual horizontal processing
!         PFPLA, PFPLO     : relative locations (latitudes/longitudes or x/y)
!                            of output points
!         PFPGM            : output map factor
!         PFPNORX, PFPNORY : relative rotation matrix
 
!        IMPLICIT ARGUMENTS
!        ------------------
!        PARDIM, YOMDIM
!        PARFPOS
!        YOMFPC, YOMFPD
!        YOMFPG, NAMFPG
!        YOMVV1, YOMGEM, YOMLEG
!        YOMCST
 
!     EXTERNALS. CORDON ECORDON TRARECA SUGENORD ELALO2XY
!     ----------
 
!     Called by SUFPG.
 
!     AUTHOR.    RYAD EL KHATIB *METEO-FRANCE*
!     -------
!     MODIFICATIONS.
!     --------------
!        970304 ORIGINAL from previous SUFPG
!        9703   K. YESSAD: parallelisation of FULL-POS.
!        971013 R. El Khatib : Use LFPOSHOR
!               + Rotation matrix may include the division by map factor
!        Modified 98-08-10 by K. YESSAD: removal of LRPOLE option.
!        981001 R. El Khatib LFPOSHOR =>LDSAME+LDPOSHOR
!        99-04-15 R. El Khatib Translation in aladin
!        00-05-31 R. El Khatib Do not use EGGX if "latlon" format
!        01-04-14 M. Janousek: Replacement of EGGX by EGGPACK functions
!        R. El Khatib : 01-08-07 Pruning options
!        O.Spaniel    : 03-04-15 cleaning
!        JD. Gril 08-02-2005 : Modifs for Mercator Rotated Tilted
!                              cleaning NSOTRP, test FPRPK
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        Y.Seity       19-Nov-2007 Initialisation of LAT1 LAT2 LON1 LON2 before calling EGGX_n
!-----------------------------------------------------------------------
 
USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK

USE YOMLUN   , ONLY : NULOUT
USE YOMCT0   , ONLY : LELAM    ,LRPLANE
USE YOMDIM   , ONLY : NDGUXG   ,NDLUXG
USE YOMFPC   , ONLY : CFPFMT   ,NFPDOM
USE YOMFPD   , ONLY : NLAT     ,NLON     ,RLATN    ,RLATS    ,RLONW    ,&
 & RLONE    ,NFPLUX   ,NFPGUX   ,RLONC    ,RLATC    ,RDELX    ,RDELY
USE YOMFPG   , ONLY : NFPRGRI  ,RFPMU    ,NFPTTYP  ,FPMUCEN  ,FPLOCEN  ,&
 & FPSTRET  ,FPLON0   ,FPLAT0   ,FPRPK    ,FPLX     ,FPLY     ,LFPMRT
USE YOMGEM   , ONLY : NSTTYP   ,RMUCEN   ,RLOCEN   ,RSTRET   
USE YOMCST   , ONLY : RPI      ,RA
USE YEMGEO   , ONLY :      ELON0    ,ELAT0    ,ELONC    ,ELATC    ,LMRT     ,&
 & EDELX    ,EDELY    ,ELON1    ,ELAT1    ,LMAP
 
IMPLICIT NONE
 
! * DUMMY:
INTEGER(KIND=JPIM),INTENT(IN)    :: KFPRGP
LOGICAL           ,INTENT(IN)    :: LDSAME
LOGICAL           ,INTENT(OUT)   :: LDPOSHOR
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFPLA(KFPRGP)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFPLO(KFPRGP)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFPGM(KFPRGP)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFPNORX(KFPRGP)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFPNORY(KFPRGP)
!-----------------------------------------------------------------------
 
 
!     ZGELAT, ZGELAM   : real latitudes and longitudes in radians
 
!     ZGESLAT          : sine of the real latitudes
!     ZGESLAM, ZGECLAM : sine and cosine of the real longitudes
 
!     ZSLAT            : sine of the relative latitudes
!     ZSLAM, ZCLAM     : sine and cosine of the relative longitudes
 
!     ZFPMU            : sine of latitudes on the "work" pp. sphere
!     ZFPSLO, ZFPCLO   : sine and cosine of longitudes on the "work" pp. sphere
 
!     ZFPNX2, ZFPNY2   : geographical compass, from the output geometry.
!     ZFPNX1, ZFPNY1   : geographical compass, from the input geometry.
 
REAL(KIND=JPRB), ALLOCATABLE :: ZGELAT(:), ZGELAM(:), ZGNORX(:), ZGNORY(:)
REAL(KIND=JPRB), ALLOCATABLE :: ZGESLAT(:), ZGESLAM(:), ZGECLAM(:)
REAL(KIND=JPRB), ALLOCATABLE :: ZSLAT(:), ZSLAM(:), ZCLAM(:)
REAL(KIND=JPRB), ALLOCATABLE :: ZFPMU(:), ZFPSLO(:), ZFPCLO(:)
REAL(KIND=JPRB), ALLOCATABLE :: ZFPNX2(:), ZFPNY2(:), ZFPNX1(:), ZFPNY1(:)
REAL(KIND=JPRB), ALLOCATABLE :: ZZLA(:), ZZLO(:)
 
INTEGER(KIND=JPIM) :: IERR, IFPGUX, IFPLUX, IPTR, ISOTRP, ISTTYP, ITRIV
INTEGER(KIND=JPIM) :: J, JDOM, JGL, JI, JIN, JLON, JOUT, JJ, &
 & IGIVO, IFPGUN, IFPLUN
 
LOGICAL :: LLSUBSET
 
REAL(KIND=JPRB) :: Z180SPI, Z2C, Z2PI, ZC2M1, ZC2P1,&
 & ZCAFPCLO(1), ZCAFPLO, ZCAFPSLA(1), ZCAFPSLO(1), ZCLACEN, &
 & ZCLOCEN, ZDLA, ZDLO, ZDUM, &
 & ZEPS, ZFCLACEN, ZFCLOCEN, ZFSLACEN, &
 & ZFSLOCEN, ZGEFPCLO(1), ZGEFPSLA(1), ZGEFPSLO(1), ZGELOCEN, &
 & ZGEMUCEN, ZLONW, ZLONE, ZLATS, ZLATN, ZLON0, ZLAT0, ZLONC, ZLATC,&
 & ZDELX, ZDELY, ZLON, ZPIS180, ZPISNL, &
 & ZRELA, ZRELO, ZSIGN, ZSLACEN, ZSLOCEN, ZUS2C, &
 & ZLON1, ZLAT1, ZLONR, ZLATR, ZBETA
REAL(KIND=JPRB) :: ZHOOK_HANDLE
 
#include "abor1.intfb.h"
#include "eggx_n.intfb.h"
#include "elalo2xy.intfb.h"
#include "sufpmove.intfb.h"
#include "sugenord.intfb.h"
#include "tracare.intfb.h"
#include "trareca.intfb.h"
 
!-----------------------------------------------------------------------
 
!*       0. PREPARATIONS
!           ------------
 
IF (LHOOK) CALL DR_HOOK('SUFPG2',0,ZHOOK_HANDLE)
Z2PI=2.0_JPRB*RPI
ZPIS180=RPI/180._JPRB
Z180SPI=1.0_JPRB/ZPIS180
 
!*       1. GEOGRAPHICAL COORDINATES, OUTPUT MAP FACTOR AND GEOGRAPHICAL
!           COMPASS, SEEN FROM OUTPUT GEOMETRY
!           ------------------------------------------------------------
IF (CFPFMT == 'LALON') THEN
 
  ALLOCATE(ZFPNX2(KFPRGP))
  ALLOCATE(ZFPNY2(KFPRGP))
  ALLOCATE(ZGELAT(KFPRGP))
  ALLOCATE(ZGELAM(KFPRGP))
 
  IPTR = 0
  DO J = 1, NFPDOM
    ZLATS = RLATS(J) * ZPIS180
    ZLONW = RLONW(J) * ZPIS180
    ZDELX = RDELX(J) * ZPIS180
    ZDELY = RDELY(J) * ZPIS180
    DO JGL = 1, NLAT(J)
      DO JLON = 1, NLON(J)
        IPTR=IPTR+1
        ZGELAM(IPTR) = ZLONW+MOD(REAL(JLON-1,JPRB)*ZDELX,Z2PI)
        IF (ZGELAM(IPTR) >= Z2PI) THEN
          ZGELAM(IPTR)=ZGELAM(IPTR)-Z2PI
        ENDIF
        ZGELAT(IPTR) = ZLATS+REAL(JGL-1,JPRB)*ZDELY
      ENDDO
    ENDDO
  ENDDO
  PFPGM (:) = 1.0_JPRB
  ZFPNX2(:) = 0.0_JPRB
  ZFPNY2(:) = 1.0_JPRB
 
ELSEIF (CFPFMT == 'LELAM'.OR.(CFPFMT == 'MODEL'.AND.LELAM)) THEN
 
  ALLOCATE(ZFPNX2(KFPRGP))
  ALLOCATE(ZFPNY2(KFPRGP))
  ALLOCATE(ZGELAT(KFPRGP))
  ALLOCATE(ZGELAM(KFPRGP))
 
  IPTR = 1
  ZLON0 = FPLON0 * ZPIS180
  ZLAT0 = FPLAT0 * ZPIS180
  ZLONR=0._JPRB
  ZLATR=0._JPRB
  ZLATS=0._JPRB
  ZLATN=0._JPRB
  ZLONW=0._JPRB
  ZLONE=0._JPRB
  ZBETA=0._JPRB
  IGIVO=0_JPIM
  ISOTRP=0_JPIM
  JJ=-1
  IF (LFPMRT) JJ=JJ-1
  IFPGUN=1
  IFPLUN=1
  DO J = 1, NFPDOM
    ZLONC = RLONC(J) * ZPIS180
    ZLATC = RLATC(J) * ZPIS180
    ZDELX = RDELX(J)
    ZDELY = RDELY(J)
    IFPLUX=NFPLUX
    IFPGUX=NFPGUX
    WRITE(NULOUT,*) 'Call EGGX_N by SUFPG2'
!   Call are done in New Eggx
    CALL EGGX_N(RPI,RA,JJ,ZLONR,ZLATR,ZBETA,ZLONW,ZLATS,&
     & ZLONE,ZLATN,ZLON0,ZLAT0,FPRPK,NULOUT,ISOTRP,IGIVO,&
     & ZGELAM(IPTR),ZGELAT(IPTR),PFPGM(IPTR),ZFPNX2(IPTR),&
     & ZFPNY2(IPTR),IFPLUN,IFPLUX,IFPGUN,IFPGUX,IFPLUN,IFPLUX,&
     & IFPGUN,IFPGUX,ZDELX,ZDELY,ZLONC,ZLATC)
    IF (NFPTTYP == 2) THEN
!     Translate
      CALL SUFPMOVE(FPMUCEN,FPLOCEN,ZGELAM(IPTR),ZGELAT(IPTR),IFPLUX,IFPGUX)
    ENDIF
    RLATN(J) = ZLATN * Z180SPI
    RLATS(J) = ZLATS * Z180SPI
    RLONE(J) = ZLONE * Z180SPI
    RLONW(J) = ZLONW * Z180SPI
    IF (RLONE(J) < RLONW(J)) THEN
      RLONW(J)=RLONW(J)-360._JPRB
    ENDIF
    FPLX=RDELX(J)*REAL(NLON(J),JPRB)
    FPLY=RDELY(J)*REAL(NLAT(J),JPRB)
    IPTR = IPTR + IFPLUX*IFPGUX
  ENDDO
  DO J = 1, IPTR-1
    ZGELAM(J) = MOD(ZGELAM(J),Z2PI)
  ENDDO
 
ELSEIF (CFPFMT == 'GAUSS') THEN
  ALLOCATE(ZFPNX2(KFPRGP))
  ALLOCATE(ZFPNY2(KFPRGP))
  ALLOCATE(ZGESLAT(KFPRGP))
  ALLOCATE(ZGESLAM(KFPRGP))
  ALLOCATE(ZGECLAM(KFPRGP))
  ALLOCATE(ZFPMU(KFPRGP))
  ALLOCATE(ZFPSLO(KFPRGP))
  ALLOCATE(ZFPCLO(KFPRGP))
 
  Z2C = 2.0_JPRB* FPSTRET
  ZUS2C = 1.0_JPRB/ Z2C
  ZC2M1 = FPSTRET * FPSTRET - 1.0_JPRB
  ZC2P1 = FPSTRET * FPSTRET + 1.0_JPRB
  IPTR = 0
  DO JGL = 1,NLAT(1)
    ZPISNL = Z2PI / NFPRGRI(JGL)
    DO JLON = 1, NFPRGRI(JGL)
      IPTR = IPTR+1
      ZFPMU(IPTR)=RFPMU(JGL)
      PFPGM(IPTR)=(ZC2P1 + ZC2M1*ZFPMU(IPTR)) * ZUS2C
      ZLON=REAL(JLON-1,JPRB)
      ZFPSLO(IPTR) = SIN(ZPISNL * ZLON)
      ZFPCLO(IPTR) = COS(ZPISNL * ZLON)
    ENDDO
  ENDDO
 
  ZFSLACEN = FPMUCEN
  ZFCLACEN = SQRT(1.0_JPRB - ZFSLACEN*ZFSLACEN)
  ZFCLOCEN = COS(FPLOCEN)
  ZFSLOCEN = SIN(FPLOCEN)
  CALL TRACARE(ZFPMU,ZFPSLO,ZFPCLO,ZGESLAT,ZGESLAM,ZGECLAM,KFPRGP,&
   & ZFSLACEN,ZFCLACEN,ZFSLOCEN,ZFCLOCEN,FPSTRET,&
   & NFPTTYP)
 
  CALL SUGENORD(NFPTTYP,KFPRGP,FPSTRET,FPMUCEN,FPLOCEN,&
   & ZFPMU,ZFPSLO,ZFPCLO,ZFPNX2,ZFPNY2)
 
ELSEIF (CFPFMT == 'MODEL'.AND..NOT.LELAM) THEN
  ZUS2C = 0.5_JPRB / FPSTRET
  ZC2M1 = FPSTRET * FPSTRET - 1.0_JPRB
  ZC2P1 = FPSTRET * FPSTRET + 1.0_JPRB
 
  IPTR = 0
  DO JGL = 1,NLAT(1)
    DO JLON = 1, NFPRGRI(JGL)
      IPTR = IPTR+1
      PFPGM(IPTR)=(ZC2P1 + ZC2M1*RFPMU(JGL)) * ZUS2C
    ENDDO
  ENDDO
 
ENDIF
 
!*       2. INTERFACE
!           ---------
 
IF ((CFPFMT == 'LALON'.OR.CFPFMT == 'LELAM').AND..NOT.LELAM) THEN
 
  ALLOCATE(ZGESLAT(KFPRGP))
  ALLOCATE(ZGESLAM(KFPRGP))
  ALLOCATE(ZGECLAM(KFPRGP))
 
  DO J = 1, KFPRGP
    ZGESLAT(J) = SIN(ZGELAT(J))
    ZGESLAM(J) = SIN(ZGELAM(J))
    ZGECLAM(J) = COS(ZGELAM(J))
  ENDDO
 
ELSEIF (CFPFMT == 'GAUSS'.AND.LELAM) THEN
  ALLOCATE(ZGELAT(KFPRGP))
  ALLOCATE(ZGELAM(KFPRGP))
 
  DO J = 1, KFPRGP
    ZGELAT(J) = ASIN(MAX(-1.0_JPRB,MIN(1.0_JPRB,ZGESLAT(J))))
    ZGELAM(J) = MOD( ACOS(MAX(-1.0_JPRB,MIN(1.0_JPRB,ZGECLAM(J))))&
     & *SIGN(1.0_JPRB,ZGESLAM(J))&
     & - Z2PI*MIN(0.0_JPRB,SIGN(1.0_JPRB,ZGESLAM(J))), Z2PI)
  ENDDO
 
  DEALLOCATE(ZGESLAT)
  DEALLOCATE(ZGESLAM)
  DEALLOCATE(ZGECLAM)
 
ELSEIF (CFPFMT == 'GAUSS'.AND..NOT.LELAM) THEN
  ALLOCATE(ZGELAT(KFPRGP))
  ALLOCATE(ZGELAM(KFPRGP))
 
  DO J = 1, KFPRGP
 
    ZGELAT(J) = ASIN(MAX(-1.0_JPRB,MIN(1.0_JPRB,ZGESLAT(J))))
    ZGELAM(J) = MOD( ACOS(MAX(-1.0_JPRB,MIN(1.0_JPRB,ZGECLAM(J))))&
     & *SIGN(1.0_JPRB,ZGESLAM(J))&
     & - Z2PI*MIN(0.0_JPRB,SIGN(1.0_JPRB,ZGESLAM(J))), Z2PI)
  ENDDO
 
ENDIF
 
!*       3. RELATIVE OUTPUT COORDINATES AND GEOGRAPHICAL COMPASS,
!           SEEN FROM INPUT GEOMETRY
!           -----------------------------------------------------
 
!       3.1 LIMITED AREA CASE
 
IF (LELAM.AND..NOT.LDSAME) THEN
 
  IF (LMAP.AND.LRPLANE) THEN
 
    ALLOCATE(ZGNORX(KFPRGP))
    ALLOCATE(ZGNORY(KFPRGP))
 
    ZLON0=ELON0*Z180SPI ; ZLAT0=ELAT0*Z180SPI
    ZLON1=ELON1*Z180SPI ; ZLAT1=ELAT1*Z180SPI
    ZLONC=ELONC*Z180SPI ; ZLATC=ELATC*Z180SPI
    WRITE(NULOUT,*) 'Call ELALO2XY by SUFPG2'
 
    CALL ELALO2XY(KFPRGP,ZLON0,ZLAT0,ZLON1,ZLAT1,ZLONC,ZLATC,LMRT,&
     & ZGELAM,ZGELAT,PFPLO,PFPLA,ZGNORX,ZGNORY)
 
    DO J = 1, KFPRGP
      PFPNORX(J)=-ZGNORX(J)*ZFPNY2(J)+ZGNORY(J)*ZFPNX2(J)
      PFPNORY(J)=ZGNORY(J)*ZFPNY2(J)+ZGNORX(J)*ZFPNX2(J)
    ENDDO
 
    DEALLOCATE(ZGNORX)
    DEALLOCATE(ZGNORY)
    DEALLOCATE(ZFPNX2)
    DEALLOCATE(ZFPNY2)
 
  ELSE
 
    ! LMAP=.F. and LRPLANE=.F. are treated identicaly
    IPTR=0
    DO JDOM = 1, NFPDOM
      DO JGL = 1, NFPGUX
        DO JLON = 1, NFPLUX
          IPTR=IPTR+1
          PFPLO(IPTR) = REAL(JLON-1,JPRB)*RDELX(JDOM)
          PFPLA(IPTR) = REAL(JGL-1,JPRB)*RDELY(JDOM)
        ENDDO
      ENDDO
    ENDDO
    PFPNORX(:)=ZFPNX2(:)
    PFPNORY(:)=ZFPNY2(:)
 
  ENDIF
 
!       3.2 GLOBAL CASE
 
ELSEIF (.NOT.LELAM.AND..NOT.LDSAME) THEN
!       3.2.1 Relative output coordinates
 
  ALLOCATE(ZSLAT(KFPRGP))
  ALLOCATE(ZSLAM(KFPRGP))
  ALLOCATE(ZCLAM(KFPRGP))
 
  ZSLACEN =  RMUCEN
  ZCLACEN = SQRT(1.0_JPRB-RMUCEN*RMUCEN)
  ZCLOCEN = COS(RLOCEN)
  ZSLOCEN = SIN(RLOCEN)
  CALL TRARECA(ZSLAT,ZSLAM,ZCLAM,ZGESLAT,ZGESLAM,ZGECLAM,KFPRGP,&
   & ZSLACEN,ZCLACEN,ZSLOCEN,ZCLOCEN,RSTRET,NSTTYP)
 
  DEALLOCATE(ZGESLAT)
  DEALLOCATE(ZGESLAM)
  DEALLOCATE(ZGECLAM)
 
!       3.2.2 Direction of North, seen from input geometry
 
  ALLOCATE(ZFPNX1(KFPRGP))
  ALLOCATE(ZFPNY1(KFPRGP))
 
  CALL SUGENORD(NSTTYP,KFPRGP,RSTRET,RMUCEN,RLOCEN,&
   & ZSLAT,ZSLAM,ZCLAM,ZFPNX1,ZFPNY1)
 
!       3.2.3 Interface to output arrays
 
  DO J = 1, KFPRGP
    PFPLA(J) = ASIN(MAX(-1.0_JPRB,MIN(1.0_JPRB,ZSLAT(J))))
    PFPLO(J) = ACOS(MAX(-1.0_JPRB,MIN(1.0_JPRB,ZCLAM(J))))*SIGN(1.0_JPRB,ZSLAM(J))&
     & - Z2PI*MIN(0.0_JPRB,SIGN(1.0_JPRB,ZSLAM(J)))
    PFPNORX(J)=-ZFPNX1(J)*ZFPNY2(J)+ZFPNY1(J)*ZFPNX2(J)
    PFPNORY(J)=ZFPNY1(J)*ZFPNY2(J)+ZFPNX1(J)*ZFPNX2(J)
  ENDDO
 
  DEALLOCATE(ZFPNX1)
  DEALLOCATE(ZFPNY1)
  DEALLOCATE(ZFPNX2)
  DEALLOCATE(ZFPNY2)
 
!       3.3 NO ACTUAL INTERPOLATIONS
 
ELSE
 
  IF (LELAM) THEN
    IPTR=0
    DO JGL = 1, NFPGUX
      DO JLON = 1, NFPLUX
        IPTR=IPTR+1
        PFPLO(IPTR) = REAL(JLON-1,JPRB)*EDELX
        PFPLA(IPTR) = REAL(JGL-1,JPRB)*EDELY
      ENDDO
    ENDDO
  ELSE
    IPTR=0
    DO JGL = 1,NLAT(1)
      ZPISNL = Z2PI / NFPRGRI(JGL)
      DO JLON = 1, NFPRGRI(JGL)
        IPTR = IPTR+1
        PFPLA(IPTR)=ASIN(MAX(-1.0_JPRB,MIN(1.0_JPRB,RFPMU(JGL))))
        ZLON=REAL(JLON-1,JPRB)
        PFPLO(IPTR) = ZPISNL * ZLON
      ENDDO
    ENDDO
  ENDIF
 
  DO J = 1, KFPRGP
    PFPNORX(J) = 0.0_JPRB
    PFPNORY(J) = 1.0_JPRB
  ENDDO
 
ENDIF
 
!*       4. OUTPUT POINTS AT GEOGRAPHICAL POLES
!           -----------------------------------
 
IF (.NOT.LDSAME) THEN
 
!       Here it is considered for the time being that LALON grid cannot
!       be a rotated grid
  ITRIV=0
  IERR=0
  ZEPS=EPSILON(1.0_JPRB)*10._JPRB
  IF (CFPFMT == 'GAUSS'.AND.NFPTTYP == 2) THEN
    ZGEMUCEN=FPMUCEN
    ZGELOCEN=FPLOCEN
  ELSE
    ZGEMUCEN=1._JPRB
    ZGELOCEN=0._JPRB
  ENDIF
  IF (.NOT.LELAM) THEN
    IF (CFPFMT == 'LALON') THEN
      IF (NSTTYP == 1) THEN
!             Trivial : poles are the sames
        ITRIV=1
      ELSE
!             Direct computation : poles are distincts
        ITRIV=2
        ZGEMUCEN=1._JPRB
        ZGELOCEN=0._JPRB
      ENDIF
    ELSEIF (CFPFMT == 'GAUSS') THEN
      IF (NSTTYP /= NFPTTYP) THEN
!             Direct computation : poles are distincts
        ITRIV=2
      ELSEIF (NSTTYP == 1.AND.NFPTTYP == 1) THEN
!             Trivial : poles are the sames
        ITRIV=1
      ELSE
        IF (ABS(FPMUCEN-RMUCEN) <= ZEPS  .AND.&
           & ABS(FPLOCEN-RLOCEN) <= ZEPS       ) THEN
!               Trivial : poles are the sames
          ITRIV=1
        ELSE
!               Direct computation : poles are distincts
          ITRIV=2
        ENDIF
      ENDIF
    ELSE
      IERR=1
    ENDIF
  ELSEIF (LELAM.AND..NOT.LRPLANE) THEN
    IF (CFPFMT == 'LALON') THEN
!  NB: The new EGGX does not use NROTEQ (it is virtually 0)
!      Therefore the rotated lat-lon domains should be defined maybe
!      using ELON0,ELAT0 - not yet coded
      ITRIV=1
    ELSEIF (CFPFMT == 'GAUSS') THEN
      IF (NFPTTYP == 1) THEN
!             Trivial : poles are the sames
        ITRIV=1
      ELSEIF (NFPTTYP == 2) THEN
!             Direct computation from EGGX formulations : poles are distincts
        ITRIV=3
      ELSE
!             Direct computation from EGGX formulations possible only if poles
!             are distincts
        CALL ABOR1(' SUFPG2: ITRIV == 3 NOT YET CODED')
      ENDIF
    ELSE
      IERR=1
    ENDIF
  ELSE
    IF (CFPFMT == 'GAUSS'.AND.NFPTTYP == 2) THEN
      IERR=1
    ENDIF
  ENDIF
 
  DO JI=1, KFPRGP
    IF (ABS(COS(ZGELAT(JI))) < ZEPS) THEN
 
      IF (IERR == 1) THEN
!             No way out !
        WRITE(NULOUT,*) 'AN OUTPUT POINT AT A GEOGRAPHICAL POLE !'
        WRITE(NULOUT,*) 'THIS MAKES WIND TO BE UNCOMPUTABLE '
        WRITE(NULOUT,*) 'CHANGE THE GEOMETRY TO AVOID SUCH A'
        WRITE(NULOUT,*) 'SINGULAR POINT'
        CALL ABOR1(' SUFPG2: AN OUTPUT POINT AT A GEOGRAPHICAL POLE')
      ELSE
        IF (ITRIV == 1) THEN
!                 Trivial case
          PFPNORX(JI) = 0.0_JPRB
          PFPNORY(JI) = 1.0_JPRB
        ELSEIF (ITRIV == 2) THEN
!               Exact computation at poles
          IF (ABS(ABS(SIN(ZGELAT(JI)))-ZGEMUCEN) < ZEPS) THEN
!                 The point is at a pole of its grid
            ZSIGN=SIGN(1.0_JPRB,SIN(ZGELAT(JI)))
            IF (CFPFMT == 'LALON') THEN
              PFPNORX(JI) = - SIN(ZGELAM(JI))
              PFPNORY(JI) = - COS(ZGELAM(JI))*ZSIGN
            ELSE
!                   Lobatto grid
              PFPNORX(JI) = - ZFPSLO(JI)
              PFPNORY(JI) = - ZFPCLO(JI)*ZSIGN
            ENDIF
          ELSE
!                 general case
            ZGEFPSLA(1)=ZGEMUCEN
            ZGEFPSLO(1)=SIN(ZGELOCEN)
            ZGEFPCLO(1)=COS(ZGELOCEN)
            ZSLACEN =  RMUCEN
            ZCLACEN = SQRT(1.0_JPRB-RMUCEN*RMUCEN)
            ZCLOCEN = COS(RLOCEN)
            ZSLOCEN = SIN(RLOCEN)
            CALL TRARECA(ZCAFPSLA,ZCAFPSLO,ZCAFPCLO,ZGEFPSLA,&
             & ZGEFPSLO,ZGEFPCLO,1,ZSLACEN,ZCLACEN,&
             & ZSLOCEN,ZCLOCEN,RSTRET,NSTTYP)
            ZCAFPLO= ACOS(MAX(-1.0_JPRB,MIN(1.0_JPRB,ZCAFPCLO(1))))&
             & *SIGN(1.0_JPRB,ZCAFPSLO(1)) &
             & - Z2PI*MIN(0.0_JPRB,SIGN(1.0_JPRB,ZCAFPSLO(1)))
            ISTTYP=3
            CALL SUGENORD(ISTTYP,1,ZDUM,ZCAFPSLA(1),ZCAFPLO,&
             & ZSLAT(JI),ZSLAM(JI),ZCLAM(JI),&
             & PFPNORX(JI),PFPNORY(JI))
          ENDIF
        ELSEIF (ITRIV == 3) THEN
!               Exact computation at poles
          CALL ABOR1(' SUFPG2: ITRIV == 3 NOT YET CODED')
        ENDIF
      ENDIF
 
    ENDIF
  ENDDO
 
ENDIF
 
IF (ALLOCATED(ZGELAT)) DEALLOCATE(ZGELAT)
IF (ALLOCATED(ZGELAM)) DEALLOCATE(ZGELAM)
IF (ALLOCATED(ZFPMU)) DEALLOCATE(ZFPMU)
IF (ALLOCATED(ZFPSLO)) DEALLOCATE(ZFPSLO)
IF (ALLOCATED(ZFPCLO)) DEALLOCATE(ZFPCLO)
IF (ALLOCATED(ZSLAT))  DEALLOCATE(ZSLAT)
IF (ALLOCATED(ZSLAM))  DEALLOCATE(ZSLAM)
IF (ALLOCATED(ZCLAM))  DEALLOCATE(ZCLAM)
IF (ALLOCATED(ZFPNX1))  DEALLOCATE(ZFPNX1)
IF (ALLOCATED(ZFPNY1))  DEALLOCATE(ZFPNY1)
IF (ALLOCATED(ZFPNX2))  DEALLOCATE(ZFPNX2)
IF (ALLOCATED(ZFPNY2))  DEALLOCATE(ZFPNY2)
IF (ALLOCATED(ZGESLAT)) DEALLOCATE(ZGESLAT)
IF (ALLOCATED(ZGESLAM)) DEALLOCATE(ZGESLAM)
IF (ALLOCATED(ZGECLAM)) DEALLOCATE(ZGECLAM)
 
!*       5. COMPOSE ROTATION AND OUTPUT MAP FACTOR IF GAUSSIAN GRID IN OUTPUT
!           -----------------------------------------------------------------
 
IF((CFPFMT == 'GAUSS').OR.(CFPFMT == 'MODEL'.AND..NOT.LELAM))THEN
  DO J = 1, KFPRGP
    PFPNORX(J)=PFPNORX(J)/PFPGM(J)
    PFPNORY(J)=PFPNORY(J)/PFPGM(J)
  ENDDO
ENDIF
 
!*       6. COMPUTE LDPOSHOR
!           ----------------
 
IF (.NOT.LDSAME) THEN
!       Check if the output grid is a sub-set of the input grid
  LLSUBSET=.TRUE.
  ZEPS=1.E-4_JPRB
  IPTR=0
  IF (LELAM) THEN
    ALLOCATE(ZZLA(NDGUXG*NDLUXG),ZZLO(NDGUXG*NDLUXG))
    ZRELA=1.0_JPRB/EDELY
    ZRELO=1.0_JPRB/EDELX
    DO JGL = 1, NDGUXG
      DO JLON = 1, NDLUXG
        IPTR=IPTR+1
        ZZLO(IPTR) = REAL(JLON-1,JPRB)*EDELX
        ZZLA(IPTR) = REAL(JGL-1,JPRB)*EDELY
      ENDDO
    ENDDO
    DO JOUT=1,KFPRGP
      ZDLA=2.0_JPRB*ZEPS
      ZDLO=2.0_JPRB*ZEPS
      DO JIN=1,IPTR
        ZDLA=MIN(ZDLA,(ABS(PFPLA(JOUT)-ZZLA(JIN)))*ZRELA)
        ZDLO=MIN(ZDLO,(ABS(PFPLO(JOUT)-ZZLO(JIN)))*ZRELO)
      ENDDO
      IF (ZDLA > ZEPS.OR.ZDLO > ZEPS) THEN
        LLSUBSET=.FALSE.
        EXIT
      ENDIF
    ENDDO
    DEALLOCATE(ZZLA)
    DEALLOCATE(ZZLO)
  ELSE
    LLSUBSET=.FALSE.
    WRITE(NULOUT,*) 'THE OUTPUT GRID IS ASSUMED NOT TO BE A SUB-SET OF THE INPUT ONE'
  ENDIF
ELSE
  LLSUBSET=.FALSE.
ENDIF
 
IF (LLSUBSET) THEN
  WRITE(NULOUT,*) 'THE OUTPUT GRID IS A SUB-SET OF THE INPUT ONE'
ENDIF

LDPOSHOR=.NOT.(LDSAME.OR.LLSUBSET)
 
!-----------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('SUFPG2',1,ZHOOK_HANDLE)
END SUBROUTINE SUFPG2
