C------------------------------------------------------------
C  TDB_PRFINV -- modularized version, no trcom dependency (dmc May 2005)
C
C  GENERALIZED GEOMETRY VERSION-- OCT 1983
C  SYMMETRIZE 2 SIDED PROFILE WITH 2X ONION SKIN ALGORITHM
C    DIFFERS FROM ORIGINAL VERSION IN THAT INDEPENDENT COORDINATE
C  IS DIMENSIONLESS LOCATION X =(R-R0)/A RATHER THAN RADII IN CM
C
C  INPUT DATA IS IN WORKBUF(LBX(1)..)
C  INPUT X VECTOR IS ZXI(INXI)
C   INPUT ZXMAX= MAX X OF INTEREST FOR OUTPUT PROFILE
C
C  SYMMETRIZED OUTPUT PROFILE IS PUT IN WORKBUF(LBX(2)..) (F) AND
C   WORKBUF(LBX(3)..) (CORRESPONDING X VALUES); AND SHIFT FCN <X> IS
C   STORED IN WORKBUF(LBX(5)..)
C
C  OUTPUT PASSED INTEGER INUMR = NUMBER OF PTS IN OUTPUT PROFILES
C   VARIES DEPENDING ON NATURE OF INPUT PROFILE
C
C
      SUBROUTINE TDB_PRFINV(d,ZXI,INUMI,INUMR,ZXMAX)
C
      use trdatbuf_obj
      IMPLICIT NONE

      type (trdatbuf) :: d

      INTEGER, PARAMETER :: R8=SELECTED_REAL_KIND(12,100)
C
C  CHECK DATA FOR 3-PT FLAT SPOTS
C
!============
! idecl:  explicitize implicit INTEGER declarations:
      INTEGER inumi,inumr,in1,in2,i,iadr0,iadr1,iadr2,iloc,ioff
      INTEGER ilocd1,ifound,ioffm1,iwarn,iadr,lunmsg_tdb
!============
! idecl:  explicitize implicit REAL declarations:
      REAL*8 zxmax,zxi,ztol,zdata,zx1,zx2,zx3
!============
      DIMENSION ZXI(INUMI)
C
      DATA IWARN/3/
      DATA ZTOL/1.E-10_R8/
C
C--------------------------------------------------------------------
C
C  ATTEMPT TO REMOVE ALL DATA FLATSPOTS, THEN CHECK ...
C
      CALL TDB_PRFLAX(d%WORKBUF(d%LBX(1)),INUMI)
C
      IN1=INUMI-1
      IN2=INUMI-2
      DO 10 I=1,IN2
         IADR0=d%LBX(1)+I-1
         IADR1=IADR0+1
         IADR2=IADR1+1
         IF((d%WORKBUF(IADR0).EQ.d%WORKBUF(IADR1)).AND.
     >        (d%WORKBUF(IADR1).EQ.d%WORKBUF(IADR2))) GO TO 9000
 10   CONTINUE
C
C  INITIALIZE FUNCTION (MINOR RADIUS VS. DATA ITEM)
C
      INUMR=1
      d%WORKBUF(d%LBX(2))=0.0_R8
      d%WORKBUF(d%LBX(3))=ZXMAX
      d%WORKBUF(d%LBX(5))=0.0_R8
      ZDATA=ZTOL
C
 100  CONTINUE
C  FIND NEXT DATA POINT-- START OF CHORD
      CALL TDB_PRFNXP(d%WORKBUF(d%LBX(1)),ZXI,INUMI,ZDATA,ZX1,ILOC,ZTOL)
C  FINISHED?
      IF(ILOC.EQ.0) GO TO 500
C  ADD POINT TO DEFINITION
      INUMR=INUMR+1
C
      IOFF=INUMR-1
      ILOCD1=d%LBX(1)+ILOC-1
C
      d%WORKBUF(d%LBX(2)+IOFF)=d%WORKBUF(ILOCD1)
      d%WORKBUF(d%LBX(3)+IOFF)=0.0_R8
      d%WORKBUF(d%LBX(5)+IOFF)=0.0_R8
      ZDATA=d%WORKBUF(ILOCD1)*(1.0_R8+ZTOL)
C  FIND OTHER END OF CHORD
 15   CALL TDB_PRFNXX(d%WORKBUF(d%LBX(1)),ZXI,INUMI,
     >              d%WORKBUF(ILOCD1),ZX1,ZX2,IFOUND)
C  FOUND?
      IF(IFOUND.NE.0) GO TO 20
C  NOT FOUND.  IGNORE POINT
      INUMR=INUMR-1
      GO TO 100
C  FOUND.  CHECK FOR HOLLOW PROFILE
 20   CONTINUE
      d%WORKBUF(d%LBX(3)+IOFF)=d%WORKBUF(d%LBX(3)+IOFF)+0.5_R8*(ZX2-ZX1)
      d%WORKBUF(d%LBX(5)+IOFF)=
     >     d%WORKBUF(d%LBX(5)+IOFF)+0.25_R8*(ZX2-ZX1)*(ZX2+ZX1)
C
C  DONE IF AT MAXIMUM: R=0
      IF(d%WORKBUF(d%LBX(3)+IOFF).EQ.0.0_R8) GO TO 500
C
C  CHECK FOR ANOTHER INTERCEPT-- PROBABLY INDICATING A HOLLOW PROFILE
C  INPUT
C
      CALL TDB_PRFNXX(d%WORKBUF(d%LBX(1)),ZXI,INUMI,d%WORKBUF(ILOCD1),
     >              ZX2,ZX3,IFOUND)
      IF(IFOUND.NE.0) GO TO 90
C  CHECK THAT NO DUPLICATE POINT IS TAKEN
      IF(INUMR.EQ.1) GO TO 100
      IOFFM1=INUMR-2
      IF((d%WORKBUF(d%LBX(2)+IOFF).EQ.d%WORKBUF(d%LBX(2)+IOFFM1)).OR.
     >     (d%WORKBUF(d%LBX(3)+IOFF).EQ.d%WORKBUF(d%LBX(3)+IOFFM1))) 
     >     THEN
         INUMR=INUMR-1
      ELSE
C  NORMALIZE <X>
         d%WORKBUF(d%LBX(5)+IOFF)=
     >        d%WORKBUF(d%LBX(5)+IOFF)/d%WORKBUF(d%LBX(3)+IOFF)
      ENDIF
      GO TO 100
C  WARNING ON HOLLOW PROFILES
 90   CONTINUE
      IWARN=IWARN-1
      IF (IWARN.GT.0) write(lunmsg_tdb(0),*)
     >  'WARNING - HOLLOW DATA PROFILE DETECTED SR TDB_PRFINV'
      ZX1=ZX3
      GO TO 15
C----------
C  EXIT
 500  CONTINUE
      IF(INUMR.GT.1) THEN
C  GET SHIFT OF CENTER (PEAK) PT.
        IADR=d%LBX(5)+INUMR-1
        d%WORKBUF(IADR)=ZX1
        RETURN
      ENDIF
C---
C  ERROR
C
 9000 CONTINUE
c
c  flat spot should have been removed by tdb_prlfax...
c
      CALL errmsg_exit(
     >  '? ERROR IN TDB_PRFINV/PROFE2/PROFEX: DATA FLATSPOT   ')
      END
