C******************** START FILE XMOMRY.FOR ; GROUP TKSERVE *************
      SUBROUTINE XMOMRY ( ZXI, ZTHETA, IJAC, ZR99, ZY99, ZJAC )
 
      use xplasma_calls
      implicit NONE
 
      REAL*8 ZXI, ZTHETA
      INTEGER	IJAC
      REAL*8 ZR99, ZY99, ZJAC(2,2)
 
C
C       RGA Oct00 : the xplasma version of momry
C
C	INPUT
C	-----
C	ZXI	MINOR RADIUS IN MOMENTS GEOMETRY
C	ZTHETA	POLOIDAL ANGLE (RADIANS) IN MOMENTS GEOMETRY
C	IJAC:
C          ---> spline order is ignored in this subroutine <---
C          SPLINE:
C               IJAC=0 FOR ZR99 & ZY99 ONLY; 1 FOR JACOBIAN AS WELL
C          LINEAR:
C               IJAC=2 FOR ZR99 & ZY99 ONLY; 3 FOR JACOBIAN AS WELL
C
C       IJAC negative signals pt should be inside plasma (xi.le.1)
C          (and use abs(IJAC) for above logic)
C
C	OUTPUT
C	------
C	ZR99
C	ZY99
C	ZJAC = D(R,Y)/D(XI,THETA) IF REQUESTED CF IJAC
C
C.............................................

      integer nonlin                    ! for error messages

C.............................................
 
      REAL*8 ZXISV, ZTHETASV, ZR99SV, ZY99SV, ZJACSV(2,2)
      LOGICAL ZNEWXI, ZNEWTH, ZNEWIJAC
      INTEGER IJACSV
 
      SAVE ZXISV, ZTHETASV, IJACSV, ZR99SV, ZY99SV, ZJACSV
 
      integer ierr          ! error return code
      integer iregion(1)    ! greater than one when outside boundary
      integer irzmode       ! choose coordinates for jacobian
 
      real*8 zdtest(1)        ! the jacobian determinant
      real*8 zxia(1)          ! xi    array for use in xplasma call
      real*8 ztha(1)          ! theta array for use in xplasma call
      real*8 zpha(1)          ! phi   array for use in xplasma call
 
      real*8 zra(1)           ! R returned by xplasma call
      real*8 zza(1)           ! Z returned by xplasma call
      real*8 zjtens(3,3,1)    ! jacobian matrix (including phi coordinate)
 
      real*8, parameter :: zconv = 100.0d0 ! m to cm conversion
      real*8, parameter :: zeps6 = 1.0d-6
C
      real*8 zxilim,zzxi
      integer ijaca
C
      DATA ZXISV /1.77D+22/
      DATA ZTHETASV /1.77D+22/
      DATA IJACSV /1234567/
C
C............................................
C	CHECK FOR INVALID "XI" RANGE
C
      call eq_get_lunerr(nonlin)
C
      zxilim=5.0d0   ! relax this requirement, let xplasma call decide limit
C
      IF (ZXI .LT. 0.0 .OR. ZXI .GT. ZXILIM) THEN
         WRITE(NONLIN,3333) ijac,zxi,zxilim
 
3333     FORMAT(' ?? "XMOMRY" ARGUMENT RANGE ERROR:  IJAC = ',i2,
     >		  ' ZXI= ',1PE13.5,'; MAX= ',E13.5)
         call errmsg_exit(' ...XMOMRY fatal error')
      END IF
      ZZXI=max(ZEPS6,ZXI)
C............................................
C	CHECK FOR NEW CONDITIONS
C
      ZNEWXI   = ZXI    .NE. ZXISV
      ZNEWTH   = ZTHETA .NE. ZTHETASV
      ZNEWIJAC = IJAC   .NE. IJACSV
C
      zxia(1) = zzxi
      ztha(1) = ztheta
      zpha(1) = 0.0
C
C     EVALUATE ZR99, ZY99
C
      IF (ZNEWXI .OR. ZNEWTH)  THEN
C
         call eq_rzget(1,zxia,ztha,zpha,zra,zza,iregion,ierr)
 
         if (ierr/=0) then
            write(nonlin,3400) zxi, ztheta
 
 3400       format('Error in call to xplasma/eq_rzget from xmomry'
     1           / ' xi = ',E13.5 / ' phi = ',E13.5)
            call bad_exit
         end if
 
         zr99 = zconv*zra(1)  ! m to cm conversion
         zy99 = zconv*zza(1)
C
      ELSE
          ZR99 = ZR99SV
          ZY99 = ZY99SV
      END IF
C
C   grab the jacobian
C
      IJACA=abs(IJAC)
      IF (IJACA .EQ. 1 .OR. IJACA .EQ. 3)  THEN
 
         IF (ZNEWXI .OR. ZNEWTH .OR. ZNEWIJAC)  THEN
C
            irzmode = 1
            call eq_getjac(1,zxia,ztha,zpha,irzmode,zjtens,zdtest,ierr)
 
            if (ierr/=0) then
               write(nonlin,3401) zxi, ztheta
 
 3401          format('Error in call to xplasma/eq_getjac from xmomry'
     1              / ' xi = ',E13.5 / ' phi = ',E13.5)
               call bad_exit
            end if
            zjac(1,1) = zconv*zjtens(1,1,1)  ! m to cm conversion
            zjac(1,2) = zconv*zjtens(2,1,1)
            zjac(2,1) = zconv*zjtens(1,2,1)
            zjac(2,2) = zconv*zjtens(2,2,1)
C
C  error if jacobian is zero
C
            IF(ZDTEST(1).EQ.0.0) THEN
               WRITE(NONLIN,3337) ZXI, ZDTEST(1), ZJAC
 
 3337          FORMAT(' ?? "XMOMRY" SINGULAR JACOBIAN ERROR:',
     1              ' ZXI= ',1PE13.5,'; D= ',1PE13.5,/
     2              ' ZJAC= ',4E13.5,/)
               CALL errmsg_exit(' ...ERROR IN XMOMRY...')
            END IF
 
         ELSE
            ! ----- reuse the old result ------
            zjac(1,1) = zjacsv(1,1)
            zjac(1,2) = zjacsv(1,2)
            zjac(2,1) = zjacsv(2,1)
            zjac(2,2) = zjacsv(2,2)
 
         END IF                 ! input changed
      ENDIF                     ! jacobian wanted
 
C
C  SAVE OLD VALUES
C
      ZXISV    = ZXI
      ZTHETASV = ZTHETA
      IJACSV   = IJAC
      ZR99SV   = ZR99
      ZY99SV   = ZY99
      zjacsv(1,1) = zjac(1,1)
      zjacsv(1,2) = zjac(1,2)
      zjacsv(2,1) = zjac(2,1)
      zjacsv(2,2) = zjac(2,2)
 
      RETURN
 
      END
C
C******************** END FILE XMOMRY.FOR ; GROUP TKSERVE ***************
