eggx_n.F90

Go to the documentation of this file.

SUBROUTINE eggx_n(PI,PRA,KROTEQ,PLONR,PLATR,PBETA,PLON1,PLAT1,PLON2,PLAT2,&
     & PLON0,PLAT0,PRPK,KULOUT,KSOTRP,KGIVO,&
     & PGELAM,PGELAT,PGM,PGNORX,PGNORY,KDLSA,&
     & KDLSUR,KDGSA,KDGEN,KDLUN,KDLUX,KDGUN,KDGUX,&
     & PDELX,PDELY,PLONC,PLATC)  

! Version 2006.1016 by JD GRIL

!** *EGGX_N*  - the interface to both old and new geographic package of ALADIN

!     Purpose.
!     --------
!      To provide an interface to both new and old geographic setup
!      routines MAKDO and EGGX.
!      Convert between the old EGGX domain definition and the new 
!      domain definition
!      The old definition uses corners, number of grid points and EGGX
!      projection definition parameters
!      The new definition uses the centre of domain, number of grid points
!      and the resolution in x and y.

!**   Interface.
!     ----------
!        *CALL* *EGGX_N

!     Explicit arguments :
!     --------------------

!     INPUT:
!      PI : pi (3.14ETC)
!      PRA  : radius of spherical planet
!      KROTEQ : previous rotation parameter
!               here it is a control of the direction of the conversion
!               since the options KROTEQ>0 are already no more supported
!      PLONR : geographic longitude of reference point of rotation
!      PLATR : geographic latitude of reference point of rotation
!      PLON0 : longitude of reference for the projection
!      PLAT0 : latitude of reference for the projection
!      PBETA : angle (in rd) between x-axis and rotated latitude circles
!              at the reference longitude
!              (usually, pbeta = 0. : gives pure projections)
!      KSOTRP : isotropy parameter under projection
!      KGIVO  : choice of reference point for projection
!      KDLSA:KDLSUR : lower and upper first dimensions of arrays (X)
!      KDGSA:KDGEN  : lower and upper second dimensions of arrays (Y)
!      KDLUN:KDLUX  : lower and upper first dimensions of
!                     the domain of interest, where arrays are initialized.
!      KDGUN:KDGUX  : lower and upper second dimensions of
!                     the domain of interest, where arrays are initialized.
!      KULOUT : unit of control prints file

!     INPUT/OUTPUT (depending on KROTEQ):
!      PLON1, PLAT1 : latitude of the south-west corner of useful domain
!      PLON2, PLAT2 : latitude of the north-east corner of useful domain
!      PLONC, PLATC : longitude and latitude of the centre of domain
!      PDELX, PDELY : horizontal resolution in x and y direction
!      PRPK  : projection parameter and definition in the old EGGX
!              PRPK = 10. projection type self determined
!                         by minimizing the variation of the map factor
!              PRPK = 1.  polar stereographic projection
!              0. < PRPK < 1.  lambert conformal projection with
!                              cone parameter prpk
!              PRPK = 0.  mercator conformal projection
!              PRPK < 0.  no projection
!             on output, PRPK contains the effective projection
!             parameter that has been used

!     OUTPUT:
!      PGELAM, PGELAT : longitude and latitude of the grid points
!      PGM            : map factor at the grid points
!      PGNORX, PGNORY : components of the vector pointing to the north pole
!                       at the grid points locations

!     Implicit arguments :
!     --------------------

!     Method.
!     -------
!      The parameter KROTEQ controls the direction in which the conversion
!      is performed:
!        KROTEQ<0: the new parameter set defining the domain and projection
!                  (PLON0,PLAT0,PLONC,PLATC,PDELX,PDELY) is converted
!                  to the old one by the call of MAKDO
!                     KROTEQ = -1 Normal mode
!                     KROTEQ = -2 Mercator Rotated-Tilted mode
!        KROTEQ=0: the old parameter set defining the domain and projection
!                  (PLONR,PLATR,PBETA,PLON1,PLAT1,PLON2,PLAT2,PLON0,PLAT0,
!                  PRPK,KSOTRP,KGIVO) is converted to the new one by the
!                  call of EGGX
!      All geographic coordinates must be in radians.
!      All latitudes in <-PI/2;PI/2>, all longitudes <-PI;+PI>.
!********* future : All latitudes in <-PI/2;PI/2>, all longitudes <0;2*PI>

!     Externals.
!     ----------
!      EGGX : old geographic setup routine
!      MAKDO: new geographic setup routine

!     Reference.
!     ----------

!     Author.
!     -------
!       Jean-Daniel GRIL, 2000-2001

!     Modifications.
!     --------------
!       Modified in April 2001 by M.Janousek:
!           all input/output angles are in radians
!           add check of unsupported old EGGX domains
!        C. Fischer & J.D. Gril 02-04-16 : Improve new EGGX calls
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        O.Spaniel     Oct-2004 cleaning AL29
!        JD Gril       17-Nov-2004 Mercator Rotated-Tilted case 
!        JD Gril       18-Nov-2005 add KGIVO=0 and KGIVO=0
!        JD Gril       03-Jui-2006 comment lines 328/329
!        JD Gril       15-Sep-2006 correct both previous case
!        JD Gril       16-Oct-2006 cleaning
!      F. Vana  05-Mar-2015  Support for single precision
!        P. Marguinaud 04-10-2016 Port to single precision
!     ------------------------------------------------------------------

USE parkind1  ,ONLY : jpim     ,jprb
USE yomhook   ,ONLY : lhook,   dr_hook
USE eggpack   ,ONLY : lola,xy,nbpts,pgn,delta,error,domi,param_proj,makdo,&
 & ref_datas,latlon_to_xy,xy_to_latlon
USE eggangles ,ONLY : angle_domain

!     ------------------------------------------------------------------

IMPLICIT NONE
INTEGER(KIND=JPIM),INTENT(INOUT) :: KROTEQ
INTEGER(KIND=JPIM),INTENT(IN)    :: KULOUT
INTEGER(KIND=JPIM),INTENT(INOUT) :: KSOTRP
INTEGER(KIND=JPIM),INTENT(INOUT) :: KGIVO
INTEGER(KIND=JPIM),INTENT(INOUT) :: KDLSA
INTEGER(KIND=JPIM),INTENT(INOUT) :: KDLSUR
INTEGER(KIND=JPIM),INTENT(INOUT) :: KDGSA
INTEGER(KIND=JPIM),INTENT(INOUT) :: KDGEN
INTEGER(KIND=JPIM),INTENT(IN)    :: KDLUN
INTEGER(KIND=JPIM),INTENT(IN)    :: KDLUX
INTEGER(KIND=JPIM),INTENT(IN)    :: KDGUN
INTEGER(KIND=JPIM),INTENT(IN)    :: KDGUX
REAL(KIND=JPRB)   ,INTENT(IN)    :: PI 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRA 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PLONR 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PLATR 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PBETA 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PLON1 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PLAT1 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PLON2 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PLAT2 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PLON0 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PLAT0 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PRPK 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PGELAM(kdlsa:kdlsur,kdgsa:kdgen) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PGELAT(kdlsa:kdlsur,kdgsa:kdgen) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PGM(kdlsa:kdlsur,kdgsa:kdgen) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PGNORX(kdlsa:kdlsur,kdgsa:kdgen) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PGNORY(kdlsa:kdlsur,kdgsa:kdgen) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PDELX 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PDELY 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PLONC 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PLATC 

!     ------------------------------------------------------------------

type(lola)              :: yl_tlkres, yl_tlcent, yl_tlsw_lola, yl_tlne_lola
type(lola), ALLOCATABLE :: yl_tlgrid_lola(:,:)
type(xy)                :: yl_tlsw_xy , yl_tlne_xy, yl_tlcent_xy
type(nbpts)             :: yl_tlnb_pts
type(pgn), ALLOCATABLE  :: yl_tlgrid_pgn(:,:)
type(delta)             :: yl_tldel
type(error)             :: yl_tlerr
type(domi)              :: yl_tlgrid_info
type(param_proj)        :: yl_tlmoddom
REAL(KIND=JPRB)          :: ZGRID_MF(kdlux-kdlun+1,kdgux-kdgun+1) 
REAL(KIND=JPRB)          :: ZRTD
REAL(KIND=JPRB)          :: ZPI, ZRA
REAL(KIND=JPRB) :: ZHOOK_HANDLE
REAL(KIND=JPRB)          :: ZEPS
LOGICAL                  :: LLMRT

!     ------------------------------------------------------------------

#include "eggx.h"

#include "abor1.intfb.h"

!     ------------------------------------------------------------------
IF (lhook) CALL dr_hook('EGGX_N',0,zhook_handle)
!     ------------------------------------------------------------------

! The routine can be sometimes called before constants are initialized
! Check if it is the case and then set defaults
IF (int(pi*100._jprb) == 314) THEN
  zpi=REAL(pi,jprb)
  zra=REAL(pra,jprb)
ELSE
  zpi=asin(1.0_jprb)*2.0_jprb
  zra=6371229._jprb
ENDIF
zeps=epsilon(1.0_jprb)*100.0_jprb
zrtd   = 180.0_jprb/zpi
pgelam = 0.0_jprb
pgelat = 0.0_jprb
pgm    = 0.0_jprb
pgnorx = 0.0_jprb
pgnory = 0.0_jprb

WRITE(kulout,*) '********* INFO of Input data in EGGX_N **************'
WRITE(kulout,*) 'PLON0 (rd) = ',plon0,'PLON0 (dg) = ',plon0*zrtd
WRITE(kulout,*) 'PLAT0 (rd) = ',plat0,'PLAT0 (dg) = ',plat0*zrtd 
WRITE(kulout,*) 'PLONC (rd) = ',plonc,'PLONC (dg) = ',plonc*zrtd
WRITE(kulout,*) 'PLATC (rd) = ',platc,'PLATC (dg) = ',platc*zrtd 
WRITE(kulout,*) 'PLON1 (rd) = ',plon1,'PLON1 (dg) = ',plon1*zrtd
WRITE(kulout,*) 'PLAT1 (rd) = ',plat1,'PLAT1 (dg) = ',plat1*zrtd
WRITE(kulout,*) 'PLON2 (rd) = ',plon2,'PLON2 (dg) = ',plon2*zrtd
WRITE(kulout,*) 'PLAT2 (rd) = ',plat2,'PLAT2 (dg) = ',plat2*zrtd 
WRITE(kulout,*) 'PDELX      = ',pdelx
WRITE(kulout,*) 'PDELY      = ',pdely
WRITE(kulout,*) 'KROTEQ     = ',kroteq
WRITE(kulout,*) '****************************************************'

IF (kroteq < 0) THEN
  WRITE(kulout,*) 'KROTEQ < 0 : New Eggx domain'
  ! the input parameters are in the new style of the domain definition
  llmrt = (kroteq == -2)
  IF (.NOT.llmrt) kroteq = -1
  WRITE(kulout,*) 'KROTEQ = ',kroteq,'LLMRT = ',llmrt
  IF (llmrt .AND. (abs(plat0) >= zeps)) THEN
    WRITE(kulout,*) 'EGGX_N: PLAT0=',plat0,&
     & ' MUST BE EQUAL ZERO IF LLMRT IS TRUE!'
    CALL abor1('EGGX_N: LLMRT & PLAT0 INCONSISTENT')
  ENDIF
  ksotrp              = 0_jpim
  kgivo               = 0_jpim
  plonr               = 0.0_jprb
  platr               = 0.0_jprb
  pbeta               = 0.0_jprb
  yl_tlkres%LON       = plon0*zrtd
  yl_tlkres%LAT       = plat0*zrtd
  yl_tlcent%LON       = plonc*zrtd
  yl_tlcent%LAT       = platc*zrtd
  yl_tlkres           = angle_domain(yl_tlkres,zpi,'-+','D')
  yl_tlcent           = angle_domain(yl_tlcent,zpi,'-+','D')
  yl_tldel%ONX        = pdelx
  yl_tldel%ONY        = pdely
  yl_tlnb_pts%ONX     = kdlux-kdlun+1
  yl_tlnb_pts%ONY     = kdgux-kdgun+1
  ALLOCATE(yl_tlgrid_lola(kdlux-kdlun+1,kdgux-kdgun+1))
  ALLOCATE(yl_tlgrid_pgn(kdlux-kdlun+1,kdgux-kdgun+1))
  CALL makdo(yl_tlkres,yl_tlcent,yl_tldel,yl_tlnb_pts,yl_tlgrid_lola,&
   & zgrid_mf,yl_tlgrid_pgn,yl_tlgrid_info,yl_tlerr,.true.,.true.,&
   & zpi,zra,kulout,llmrt)  
  plon1                           = yl_tlgrid_lola(1,1)%LON
  plat1                           = yl_tlgrid_lola(1,1)%LAT
  plon2                           = yl_tlgrid_lola(yl_tlnb_pts%ONX,yl_tlnb_pts%ONY)%LON
  plat2                           = yl_tlgrid_lola(yl_tlnb_pts%ONX,yl_tlnb_pts%ONY)%LAT
  plon0                           = yl_tlkres%LON
  plat0                           = yl_tlkres%LAT 
  plonc                           = yl_tlcent%LON
  platc                           = yl_tlcent%LAT
  prpk                            = yl_tlgrid_info%INFO_PROJ%KL
  pgelam(kdlun:kdlux,kdgun:kdgux) = yl_tlgrid_lola(1:yl_tlnb_pts%ONX,1:yl_tlnb_pts%ONY)%LON  
  pgelat(kdlun:kdlux,kdgun:kdgux) = yl_tlgrid_lola(1:yl_tlnb_pts%ONX,1:yl_tlnb_pts%ONY)%LAT  
  pgm(kdlun:kdlux,kdgun:kdgux)    = zgrid_mf(1:yl_tlnb_pts%ONX,1:yl_tlnb_pts%ONY)
  pgnorx(kdlun:kdlux,kdgun:kdgux) = yl_tlgrid_pgn(1:yl_tlnb_pts%ONX,1:yl_tlnb_pts%ONY)%ONX  
  pgnory(kdlun:kdlux,kdgun:kdgux) = yl_tlgrid_pgn(1:yl_tlnb_pts%ONX,1:yl_tlnb_pts%ONY)%ONY  
  DEALLOCATE(yl_tlgrid_lola)
  DEALLOCATE(yl_tlgrid_pgn)
ELSE
  ! KROTEQ>0 => the input is in the old style
  ! Some old EGGX domains are no more supported in ALADIN
  ! Check if that is not the case of this domain
  IF (kroteq > 0) THEN
    WRITE(kulout,*) 'EGGX_N: NROTEQ=',kroteq,&
     & ' IS NOT VALID VALUE, IT MUST BE ZERO!'  
    CALL abor1('EGGX_N: UNSUPPORTED NROTEQ')
  ELSEIF (pbeta /= 0.0_jprb .AND. prpk == 0.0_jprb) THEN
    WRITE(kulout,*) 'EGGX_N: ROTATED DOMAIN IN MERCATOR PROJECTION NOT&
     & SUPPORTED (EBETA HAS TO BE 0)'
    CALL abor1('EGGX_N: UNSUPPORTED EBETA')
  ELSEIF ( abs(prpk-abs(sin(plat0))) > 1.e-7 ) THEN
    WRITE(kulout,*) 'EGGX_N: YOU SEEM TO HAVE A SECANT CASE OF PROJECTION'
    WRITE(kulout,*) '       ERPK=',prpk,'  SIN(ELAT0)=',sin(plat0)
    CALL abor1('EGGX_N: UNSUPPORTED SECANT PROJECTION')
  ENDIF
  WRITE(kulout,*) 'KROTEQ = 0 : Old Eggx domain'
  ! Call EGGX to handle cases when corners may change
  ! Fill in every case the arrays. Not needed in model
  ! (call echien) but outside. So, either with old eggx,
  ! either with makdo (see below)
  IF(ksotrp/=0 .OR. kgivo/=0 .OR. prpk==10._jprb) THEN
    WRITE(kulout,*) 'Call old EGGX to handle cases when corners may change'
    WRITE(kulout,*) 'KSOTRP = ',ksotrp,'  KGIVO = ',kgivo,'  PRPK = ',prpk
    CALL eggx(REAL(ZPI,JPRB),REAL(ZRA,JPRB),KROTEQ,PLONR,PLATR,PBETA,PLON1,PLAT1,PLON2,PLAT2,&
     & PLON0,PLAT0,PRPK,KULOUT,KSOTRP,KGIVO,&
     & PGELAM,PGELAT,PGM,PGNORX,PGNORY,KDLSA,KDLSUR,KDGSA,KDGEN,&
     & KDLUN,KDLUX,KDGUN,KDGUX,PDELX,PDELY)  
  ENDIF
  ! Now calculate x,y coordinates of the corners, compute the centre
  ! point and convert it to lat-lon by the EGGPACK functions
  WRITE(kulout,*) 'COMPUTATION OF CENTER'
  yl_tlkres%LON    = plon0*zrtd
  yl_tlkres%LAT    = plat0*zrtd
  yl_tlkres        = angle_domain(yl_tlkres,zpi,'-+','D')
  yl_tlmoddom      = ref_datas(yl_tlkres,zra)
  yl_tlsw_lola%LON = plon1
  yl_tlsw_lola%LAT = plat1
  yl_tlne_lola%LON = plon2
  yl_tlne_lola%LAT = plat2
  yl_tlsw_lola     = angle_domain(yl_tlsw_lola,zpi,'-+','R')
  yl_tlne_lola     = angle_domain(yl_tlne_lola,zpi,'-+','R')
  yl_tlsw_xy       = latlon_to_xy(yl_tlsw_lola,yl_tlmoddom,zpi)
  yl_tlne_xy       = latlon_to_xy(yl_tlne_lola,yl_tlmoddom,zpi)
  yl_tlcent_xy%X   = (yl_tlsw_xy%X+yl_tlne_xy%X)*0.5_jprb
  yl_tlcent_xy%Y   = (yl_tlsw_xy%Y+yl_tlne_xy%Y)*0.5_jprb
  yl_tlcent        = angle_domain(xy_to_latlon(yl_tlcent_xy,yl_tlmoddom,zpi),zpi,'0+','R')
  plonc            = yl_tlcent%LON
  platc            = yl_tlcent%LAT 
  ! If KSOTRP=0 and KGIVO=0 then the values of SW,NE,REF are fixed. They come from
  ! - old eggx (rare) but can be computed by new eggx
  ! - new eggx but with NCADFORM=0 (old "cadre")
  ! In both cases we can use new eggx to recompute missing values, this way protects
  ! us from old eggx possible bugs in case number 2 (new eggx + NCADFORM=0) 
  ! We use Makdo to compute all arrays
  IF(ksotrp==0 .AND. kgivo==0 .AND. prpk/=10._jprb) THEN
    ! Computation of resolution to use Makdo
    ! We test the case "point" or "linear" wide
    ! Protect from divided by zero
    WRITE(kulout,*) .AND..AND.'KSOTRP==0  KGIVO==0  PRPK/=10'
    WRITE(kulout,*) 'COMPUTATION OF RESOLUTION AND USE OF MAKDO'
    WRITE(kulout,*) 'because cadre is in old style but domain may be created'
    WRITE(kulout,*) 'by new eggx (may be not supported by old eggx)'  
    IF ((kdlux-kdlun) == 0) THEN
      pdelx = 0.0_jprb
    ELSE
      pdelx = abs(yl_tlne_xy%X-yl_tlsw_xy%X)/REAL(kdlux-kdlun,jprb)
    ENDIF
    IF ((kdgux-kdgun) == 0) THEN
      pdely = 0.0_jprb
    ELSE
      pdely = abs(yl_tlne_xy%Y-yl_tlsw_xy%Y)/REAL(kdgux-kdgun,jprb)
    ENDIF
    yl_tlcent%LON       = plonc*zrtd
    yl_tlcent%LAT       = platc*zrtd
    yl_tlkres           = angle_domain(yl_tlkres,zpi,'-+','D')
    yl_tlcent           = angle_domain(yl_tlcent,zpi,'-+','D')
    yl_tldel%ONX        = pdelx
    yl_tldel%ONY        = pdely
    yl_tlnb_pts%ONX     = kdlux-kdlun+1
    yl_tlnb_pts%ONY     = kdgux-kdgun+1
    ALLOCATE(yl_tlgrid_lola(kdlux-kdlun+1,kdgux-kdgun+1))
    ALLOCATE(yl_tlgrid_pgn(kdlux-kdlun+1,kdgux-kdgun+1))
    CALL makdo(yl_tlkres,yl_tlcent,yl_tldel,yl_tlnb_pts,yl_tlgrid_lola,&
     & zgrid_mf,yl_tlgrid_pgn,yl_tlgrid_info,yl_tlerr,.true.,.true.,&
     & zpi,zra,kulout,.false.)  
    plon1                           = yl_tlgrid_lola(1,1)%LON
    plat1                           = yl_tlgrid_lola(1,1)%LAT
    plon2                           = yl_tlgrid_lola(yl_tlnb_pts%ONX,yl_tlnb_pts%ONY)%LON
    plat2                           = yl_tlgrid_lola(yl_tlnb_pts%ONX,yl_tlnb_pts%ONY)%LAT
    plon0                           = yl_tlkres%LON
    plat0                           = yl_tlkres%LAT 
    plonc                           = yl_tlcent%LON
    platc                           = yl_tlcent%LAT
    prpk                            = yl_tlgrid_info%INFO_PROJ%KL
    pgelam(kdlun:kdlux,kdgun:kdgux) = yl_tlgrid_lola(1:yl_tlnb_pts%ONX,1:yl_tlnb_pts%ONY)%LON  
    pgelat(kdlun:kdlux,kdgun:kdgux) = yl_tlgrid_lola(1:yl_tlnb_pts%ONX,1:yl_tlnb_pts%ONY)%LAT  
    pgm(kdlun:kdlux,kdgun:kdgux)    = zgrid_mf(1:yl_tlnb_pts%ONX,1:yl_tlnb_pts%ONY)
    pgnorx(kdlun:kdlux,kdgun:kdgux) = yl_tlgrid_pgn(1:yl_tlnb_pts%ONX,1:yl_tlnb_pts%ONY)%ONX  
    pgnory(kdlun:kdlux,kdgun:kdgux) = yl_tlgrid_pgn(1:yl_tlnb_pts%ONX,1:yl_tlnb_pts%ONY)%ONY  
    DEALLOCATE(yl_tlgrid_lola)
    DEALLOCATE(yl_tlgrid_pgn)
  ENDIF
  WRITE(kulout,*) 'SWX = ',yl_tlsw_xy%X,'NEX = ',yl_tlne_xy%X,'CEX = ',yl_tlcent_xy%X
  WRITE(kulout,*) 'SWY = ',yl_tlsw_xy%Y,'NEY = ',yl_tlne_xy%Y,'CEY = ',yl_tlcent_xy%Y   
ENDIF

WRITE(kulout,*) '********* INFO before Return out of EGGX_N *********'
WRITE(kulout,*) 'PLON0 (rd) = ',plon0,'PLON0 (dg) = ',plon0*zrtd
WRITE(kulout,*) 'PLAT0 (rd) = ',plat0,'PLAT0 (dg) = ',plat0*zrtd 
WRITE(kulout,*) 'PLONC (rd) = ',plonc,'PLONC (dg) = ',plonc*zrtd
WRITE(kulout,*) 'PLATC (rd) = ',platc,'PLATC (dg) = ',platc*zrtd 
WRITE(kulout,*) 'PLON1 (rd) = ',plon1,'PLON1 (dg) = ',plon1*zrtd
WRITE(kulout,*) 'PLAT1 (rd) = ',plat1,'PLAT1 (dg) = ',plat1*zrtd
WRITE(kulout,*) 'PGELAM(KDLUN,KDGUN):SW (rd) = ',pgelam(kdlun,kdgun)
WRITE(kulout,*) 'PGELAM(KDLUN,KDGUN):SW (dg) = ',pgelam(kdlun,kdgun)*zrtd
WRITE(kulout,*) 'PGELAT(KDLUN,KDGUN):SW (rd) = ',pgelat(kdlun,kdgun)
WRITE(kulout,*) 'PGELAT(KDLUN,KDGUN):SW (dg) = ',pgelat(kdlun,kdgun)*zrtd
WRITE(kulout,*) 'PLON2 (rd) = ',plon2,'PLON2 (dg) = ',plon2*zrtd
WRITE(kulout,*) 'PLAT2 (rd) = ',plat2,'PLAT2 (dg) = ',plat2*zrtd
WRITE(kulout,*) 'PGELAM(KDLUX,KDGUX):NE (rd) = ',pgelam(kdlux,kdgux)
WRITE(kulout,*) 'PGELAM(KDLUX,KDGUX):NE (dg) = ',pgelam(kdlux,kdgux)*zrtd
WRITE(kulout,*) 'PGELAT(KDLUX,KDGUX):NE (rd) = ',pgelat(kdlux,kdgux)
WRITE(kulout,*) 'PGELAT(KDLUX,KDGUX):NE (dg) = ',pgelat(kdlux,kdgux)*zrtd
WRITE(kulout,*) 'PRPK = ',prpk
WRITE(kulout,*) 'PGM(KDLUN,KDGUN)    (SW) = ',pgm(kdlun,kdgun)
WRITE(kulout,*) 'PGNORX(KDLUN,KDGUN) (SW) = ',pgnorx(kdlun,kdgun)
WRITE(kulout,*) 'PGNORY(KDLUN,KDGUN) (SW) = ',pgnory(kdlun,kdgun)
WRITE(kulout,*) 'PDELX = ',pdelx
WRITE(kulout,*) 'PDELY = ',pdely
WRITE(kulout,*) '****************************************************'

!     ------------------------------------------------------------------
IF (lhook) CALL dr_hook('EGGX_N',1,zhook_handle)
END SUBROUTINE eggx_n