module dStar_crust_mod
    use dStar_crust_def
    integer, parameter :: crust_filename_length=128
contains

    subroutine do_load_crust_table(prefix,eos_handle,Tref,ierr)
        use exceptions_lib
        character(len=*), intent(in) :: prefix
        integer, intent(in) :: eos_handle
        real(dp), intent(in) :: Tref
        integer, intent(out) :: ierr
        logical, parameter :: dbg = .FALSE.
        type(crust_table_type), pointer :: tab
        real(dp), pointer, dimension(:,:) :: lgRho_val
        character(len=crust_filename_length) :: table_name, cache_filename
        logical :: have_cache
        integer :: unitno
        type(alert) :: overwrite=alert(scope='do_load_crust_table', &
        &   message='overwriting previously loaded table')
        character(len=128) :: alert_msg
        type(alert) :: status=alert(scope='do_load_crust_table')
        type(warning) :: cache_write_failure=warning(scope='do_load_crust_table', &
        &   message='unable to write cache')

        ierr = 0
        tab => crust_table
        ! if the table is already allocated, issue a warning and scrub the table
        if (tab% is_loaded) then
            call overwrite% report
            call do_free_crust_table(tab)
        end if

        call generate_crust_filename(prefix,Tref,table_name)
        cache_filename = trim(crust_datadir)//'/cache/'//trim(table_name)//'.bin'
        inquire(file=cache_filename,exist=have_cache)
        if (have_cache) then
            call do_read_crust_cache(cache_filename,tab,ierr)
            if (ierr == 0) return
        end if

        ! if we don't have the table, or could not load it, then generatue a
        ! new one and write to cache
        ierr = 0
        tab% nv = crust_default_number_table_points
        tab% lgP_min = crust_default_lgPmin
        tab% lgP_max = crust_default_lgPmax
        call do_generate_crust_table(prefix,eos_handle,Tref,tab)
        tab% is_loaded = .TRUE.

        lgRho_val(1:4,1:tab% nv) => tab% lgRho(1:4*tab% nv)

        ! write informative message about range of table
        if (dbg) then
            write(alert_msg,'(a,2f8.3)') 'lgNb min, max = ', &
            &   10.0**(minval(lgRho_val(1,:)-log10(amu))-39.0), &
            &   10.0**(maxval(lgRho_val(1,:)-log10(amu))-39.0)
            call status% report(alert_msg)
            write(alert_msg,'(t21,a,2f8.3)') 'lgP min, max = ', &
            &   tab% lgP_min, tab% lgP_max
            call status% report(alert_msg)
        end if

        if (.not.have_cache) then
            call do_write_crust_cache(cache_filename,tab,ierr)
            if (cache_write_failure% raised(ierr)) return
        end if
    end subroutine do_load_crust_table

    subroutine do_generate_crust_table(prefix,eos_handle,Tref,tab)
        use constants_def, only: avogadro
        use nucchem_def, only: composition_info_type
        use hz90
        use interp_1d_def
        use interp_1d_lib
        character(len=*), intent(in) :: prefix
        integer, intent(in) :: eos_handle
        real(dp), intent(in) :: Tref
        type(crust_table_type), pointer :: tab
        real(dp), dimension(:), pointer :: work=>null()
        real(dp), pointer, dimension(:,:) :: lgRho_val, lgEps_val
        real(dp) :: lgPmin, delta_lgP
        integer :: N, i, ierr
        integer :: ncharged
        integer, dimension(HZ90_number) :: charged_ids
        real(dp), dimension(:), allocatable :: lgP, Xneut, lgRho, lgEps
        real(dp), dimension(:,:), allocatable :: Yion
        type(composition_info_type), dimension(:), allocatable :: ion_info

        lgPmin = tab% lgP_min
        delta_lgP = tab% lgP_max - lgPmin
        N = tab% nv
        allocate(lgP(N), Xneut(N), lgRho(N), lgEps(N), Yion(HZ90_number,N), ion_info(N))

        lgP = [ (lgPmin + real(i-1,dp)*(delta_lgP)/real(N-1,dp), i = 1, N)]

        call do_make_crust(lgP,Yion,Xneut,charged_ids,ncharged,ion_info)
        call find_densities(eos_handle,lgP,lgRho,lgEps, &
            & Yion,ncharged,charged_ids,ion_info,Tref)

        call do_allocate_crust_table(tab, N, ierr)
        lgRho_val(1:4,1:N) => tab% lgRho(1:4*N)
        lgEps_val(1:4,1:N) => tab% lgEps(1:4*N)

        tab% lgP = lgP
        lgRho_val(1,:) = lgRho
        lgEps_val(1,:) = lgEps

        allocate(work(tab% nv*pm_work_size))
        call interp_pm(tab% lgP, tab% nv, tab% lgRho, pm_work_size, work, &
        &   'do_generate_crust_table: Rho', ierr)
        call interp_pm(tab% lgP, tab% nv, tab% lgEps, pm_work_size, work, &
        &   'do_generate_crust_table: Eps', ierr)
        deallocate(work)
        deallocate(lgP, Xneut, lgRho, lgEps, Yion, ion_info)

    end subroutine do_generate_crust_table

    subroutine do_read_crust_cache(cache_filename,tab,ierr)
        use exceptions_lib
        character(len=*), intent(in) :: cache_filename
        type(crust_table_type), pointer :: tab
        integer, intent(out) :: ierr
        integer :: unitno, n
        type(failure):: cache_error=failure(scope='do_read_crust_cache')

        open(newunit=unitno,file=trim(cache_filename), &
        &   action='read',status='old',form='unformatted', iostat=ierr)
        if (cache_error% raised(ierr,'opening'//trim(cache_filename))) &
        &   return

        read(unitno) n
        call do_allocate_crust_table(tab,n,ierr)
        if (cache_error% raised(ierr,'allocating table')) then
            close(unitno)
            return
        end if

        read(unitno) tab% lgP(:)
        read(unitno) tab% lgRho
        read(unitno) tab% lgEps
        close(unitno)

        tab% lgP_min = minval(tab% lgP)
        tab% lgP_max = maxval(tab% lgP)
        tab% is_loaded = .TRUE.
    end subroutine do_read_crust_cache

    subroutine do_write_crust_cache(cache_filename,tab,ierr)
        use exceptions_lib
        character(len=*), intent(in) :: cache_filename
        type(crust_table_type), pointer :: tab
        integer, intent(out) :: ierr
        integer :: unitno
        type(failure) :: cache_error=failure(scope='do_write_crust_cache')

        ierr = 0
        if (tab% nv == 0) return
        open(newunit=unitno, file=trim(cache_filename),action='write', &
        &   form='unformatted',iostat=ierr)
        if (cache_error% raised(ierr,'opening '//trim(cache_filename))) &
        &   return

        write(unitno) tab% nv
        write(unitno) tab% lgP
        write(unitno) tab% lgRho
        write(unitno) tab% lgEps
        close(unitno)
    end subroutine do_write_crust_cache

    subroutine do_allocate_crust_table(tab,n,ierr)
        type(crust_table_type),pointer :: tab
        integer, intent(in) :: n
        integer, intent(out) :: ierr

        allocate(tab% lgP(n), tab% lgRho(4*n), tab% lgEps(4*n), stat=ierr)
        if (ierr /= 0) return
        tab% nv = n
    end subroutine do_allocate_crust_table

    subroutine generate_crust_filename(prefix,Tref,filename)
        ! naming convention for flies is prefix_ttt
        ! where ttt = 100*log10(Tref), to 3 significant digits
        character(len=*), intent(in) :: prefix
        real(dp), intent(in) :: Tref
        character(len=crust_filename_length), intent(out) :: filename

        write (filename,'(a,"_",i0.3)') trim(prefix), int(100.0*log10(Tref))
    end subroutine generate_crust_filename

    subroutine do_free_crust_table(tab)
        type(crust_table_type), pointer :: tab
        tab% nv = 0
        tab% lgP_min = 0.0
        tab% lgP_max = 0.0
        if (allocated(tab% lgP)) deallocate(tab% lgP)
        if (associated(tab% lgRho)) deallocate(tab% lgRho)
        if (associated(tab% lgEps)) deallocate(tab% lgEps)
        nullify(tab% lgRho)
        nullify(tab% lgEps)
        tab% is_loaded = .FALSE.
    end subroutine do_free_crust_table

end module dStar_crust_mod


      SUBROUTINE PHO_MCINI
C********************************************************************
C
C     initialization of MC event generation
C
C********************************************************************
      IMPLICIT NONE
      DOUBLE PRECISION ah , ecmpro , edelta , elmin , etablo , PIMASS ,
     &                 sigmax , sprcdf , sprdd , sprsd1 , sprsd2 ,
     &                 TINY , xmpom , xmt1 , xmt2 , xvt1 , xvt2
      INTEGER i , i0 , ic1 , ic2 , ift1 , ift2 , ip , isigm , j , k
      SAVE

      PARAMETER (PIMASS=0.13D0,TINY=1.D-10)

C  input/output channels
      INCLUDE 'inc/poinou'
C  event debugging information
      INCLUDE 'inc/podebg'
C  current beam selection
      INCLUDE 'inc/pobeam'
C  model switches and parameters
      INCLUDE 'inc/pomdls'
C  general process information
      INCLUDE 'inc/poprcs'
C  cross sections
      INCLUDE 'inc/pocsec'
C  hard cross sections and MC selection weights
      INCLUDE 'inc/pohrcs'
C  interpolation tables for hard cross section and MC selection weights
#ifndef FOR_CORSIKA
      INCLUDE 'inc/pohtab'
#else
      INCLUDE 'inc/pohtab50'
#endif
C  global event kinematics and particle IDs
      INCLUDE 'inc/pogcms'
C  obsolete cut-off information
      INCLUDE 'inc/pocut1'
C  event weights and generated cross section
      INCLUDE 'inc/powght'
C  cut probability distribution
#ifndef FOR_CORSIKA
      INCLUDE 'inc/poprob'
#else
      INCLUDE 'inc/poprob50'
#endif
C  energy-interpolation table
      INCLUDE 'inc/potabl'

      CHARACTER*15 PHO_PNAME

      DATA xmpom/0.766D0/

C  initialize fragmentation
      CALL PHO_FRAINI(ISWmdl(6))

C  reset interpolation tables
      DO k = 1 , 4
         DO j = 1 , IEETA1
            DO i = 1 , 80
               SIGtab(i,j,k,IDXmpar) = 0.D0
            END DO
            SIGecm(j,k,IDXmpar) = 0.D0
         END DO
      END DO

C  max. number of allowed colors (large N expansion)
      ic1 = 0
      ic2 = 10000
      CALL PHO_SELCOL(ic1,ic2,0,0,0,0,-1)

C  lower energy limit of initialization
      etablo = PARmdl(19)
      IF ( SQSglobmax.LE.5.D0 ) etablo = MIN(2.5D0,etablo)

      IF ( LPRi.GT.4 ) WRITE (LO,'(/,1X,A,2F12.1)')
     &                      'PHO_MCINI: selected energy range (SQRT(S))'
     &                      , etablo , SQSglobmax
      IF ( LPRi.GT.4 ) WRITE (LO,'(5X,A,A,F7.3,E15.4)')
     &                         'particle 1 (name,mass,virtuality): ' ,
     &                        PHO_PNAME(IFPap(1),1) , PMAss(1) ,
     &                        PVIrt(1)
      IF ( LPRi.GT.4 ) WRITE (LO,'(5X,A,A,F7.3,E15.4)')
     &                         'particle 2 (name,mass,virtuality): ' ,
     &                        PHO_PNAME(IFPap(2),1) , PMAss(2) ,
     &                        PVIrt(2)

C  cuts on probabilities of multiple interactions
      IMAx = MIN(IPAmdl(32),IIMAX)
      KMAx = MIN(IPAmdl(33),KKMAX)
      ah = 2.D0*PTCut(1)/SQSglobmax
      IMAx = MAX(5,MIN(IMAx,INT(SQSglobmax/2.0D0)))
      KMAx = MIN(KMAx,1+INT(0.9*1.D0/ah))

C  hard interpolation table
      ECMf(1,IDXmpar) = SQSglobmax
      ECMf(2,IDXmpar) = 0.9D0*ECMf(1,IDXmpar)
      ECMf(3,IDXmpar) = ECMf(2,IDXmpar)
      ECMf(4,IDXmpar) = ECMf(2,IDXmpar)
      DO k = 1 , 4
         IH_ecm_up(k,IDXmpar) = MIN(IPAmdl(30),MAX_TAB_E)
         IF ( ECMf(k,IDXmpar).LT.100.D0 ) IH_ecm_up(k,IDXmpar)
     &        = MIN(IH_ecm_up(k,IDXmpar),15)
         IF ( ECMf(k,IDXmpar).LT.50.D0 ) IH_ecm_up(k,IDXmpar)
     &        = MIN(IH_ecm_up(k,IDXmpar),10)
         IF ( ECMf(k,IDXmpar).LT.10.D0 ) IH_ecm_up(k,IDXmpar)
     &        = MIN(IH_ecm_up(k,IDXmpar),5)
      END DO

C  initialization of hard scattering for all channels and cutoffs
      IF ( HSWcut(5).GT.PARmdl(36) ) CALL PHO_HARMCI(-1,ECMf(1,IDXmpar))
      i0 = 4
      IF ( ISWmdl(2).EQ.0 ) i0 = 1
      DO i = i0 , 1 , -1
         CALL PHO_HARMCI(i,ECMf(i,IDXmpar))
      END DO

C  dimension of interpolation table of cut probabilities
      ! IEEMAX = INT(7.D0*LOG10(SQSGLOBMAX)) - 1
      IEEmax = MIN(IPAmdl(31),IEETA1)
      IF ( SQSglobmax.LT.100.D0 ) IEEmax = MIN(IEEmax,15)
      IF ( SQSglobmax.LT.50.D0 ) IEEmax = MIN(IEEmax,10)
      IF ( SQSglobmax.LT.10.D0 ) IEEmax = MIN(IEEmax,5)
      ISImax(IDXmpar) = IEEmax

C  calculate probability distribution
      i0 = 4
      ift1 = IFPap(1)
      ift2 = IFPap(2)
      xmt1 = PMAss(1)
      xmt2 = PMAss(2)
      xvt1 = PVIrt(1)
      xvt2 = PVIrt(2)
      IF ( ISWmdl(2).EQ.0 ) i0 = 1
      DO ip = i0 , 1 , -1
         ecmpro = ECMf(ip,IDXmpar)*1.001D0
         IF ( ip.EQ.4 ) THEN
            IFPap(1) = 990
            IFPap(2) = 990
            PMAss(1) = xmpom
            PMAss(2) = xmpom
            PVIrt(1) = 0.D0
            PVIrt(2) = 0.D0
         ELSE IF ( ip.EQ.3 ) THEN
            IFPap(1) = ift2
            IFPap(2) = 990
            PMAss(1) = xmt2
            PMAss(2) = xmpom
            PVIrt(1) = xvt2
            PVIrt(2) = 0.D0
         ELSE IF ( ip.EQ.2 ) THEN
            IFPap(1) = ift1
            IFPap(2) = 990
            PMAss(1) = xmt1
            PMAss(2) = xmpom
            PVIrt(1) = xvt1
            PVIrt(2) = 0.D0
         ELSE
            IFPap(1) = ift1
            IFPap(2) = ift2
            PMAss(1) = xmt1
            PMAss(2) = xmt2
            PVIrt(1) = xvt1
            PVIrt(2) = xvt2
         END IF
         IF ( IEEmax.GT.1 ) THEN
            IF ( ip.EQ.1 ) THEN
               elmin = LOG(etablo)
            ELSE
               elmin = LOG(2.5D0)
            END IF
            edelta = (LOG(ecmpro)-elmin)/DBLE(MAX(1,IEEmax-1))
            DO i = 1 , IEEmax
               ecmpro = EXP(elmin+DBLE(i-1)*edelta)
               CALL PHO_PRBDIS(ip,ecmpro,i)
            END DO
         ELSE
            CALL PHO_PRBDIS(ip,ecmpro,1)
         END IF

C  debug output of cross section tables
         IF ( ((IDEb(62).GE.0) .AND. (ip.EQ.1)) .OR. (IDEb(62).GE.3) )
     &        THEN
            IF ( (PVIrt(1)+PVIrt(2).LE.0.01D0) .OR. (IDEb(62).NE.0) )
     &           THEN
               IF ( LPRi.GT.4 ) WRITE (LO,'(/1X,A,I3/1X,A,/1X,A)')
     &     'Table of total cross sections (mb) for particle combination'
     &     , ip ,
     &   ' Ecm    SIGtot  SIGela  SIGine  SIGqel  SIGsd1  SIGsd2  SIGdd'
     &   ,
     &   '-------------------------------------------------------------'
               DO i = 1 , IEEmax
                  IF ( LPRi.GT.4 ) WRITE (LO,'(1X,1P,8E9.2)')
     &                 SIGecm(i,ip,IDXmpar) , SIGtab(1,i,ip,IDXmpar) ,
     &                 SIGtab(2,i,ip,IDXmpar) , SIGtab(28,i,ip,IDXmpar)
     &                 , SIGtab(3,i,ip,IDXmpar) ,
     &                 SIGtab(30,i,ip,IDXmpar) + SIGtab(32,i,ip,IDXmpar)
     &                 , SIGtab(31,i,ip,IDXmpar)
     &                 + SIGtab(33,i,ip,IDXmpar) ,
     &                 SIGtab(34,i,ip,IDXmpar) + SIGtab(35,i,ip,IDXmpar)
               END DO
            END IF
            IF ( IDEb(62).GE.2 ) THEN
               IF ( LPRi.GT.4 ) WRITE (LO,'(/1X,A,I3/1X,A,/1X,A)')
     &       'Table of partial x-sections (mb) for particle combination'
     &       , ip ,
     &  ' Ecm    SIGSD1L SIGSD1H SIGSD2L SIGSD2H SIGDDL  SIGDDH  SIGCDF'
     &  ,
     &  '--------------------------------------------------------------'
               DO i = 1 , IEEmax
                  IF ( LPRi.GT.4 ) WRITE (LO,'(1X,1P,8E9.2)')
     &                 SIGecm(i,ip,IDXmpar) , SIGtab(30,i,ip,IDXmpar) ,
     &                 SIGtab(32,i,ip,IDXmpar) , SIGtab(31,i,ip,IDXmpar)
     &                 , SIGtab(33,i,ip,IDXmpar) ,
     &                 SIGtab(34,i,ip,IDXmpar) , SIGtab(35,i,ip,IDXmpar)
     &                 , SIGtab(36,i,ip,IDXmpar)
               END DO
            END IF
            IF ( IDEb(62).GE.2 ) THEN
               IF ( LPRi.GT.4 ) WRITE (LO,'(/1X,A,I3/1X,A,/1X,A)')
     &    'Table of born graph x-sections (mb) for particle combination'
     &    , ip ,
     &   ' Ecm    SIGSVDM SIGHRES SIGHDIR SIGTR1  SIGTR2  SIGLOO SIGDPO'
     &   ,
     &   '-------------------------------------------------------------'
               DO i = 1 , IEEmax
                  IF ( LPRi.GT.4 ) WRITE (LO,'(1X,1P,8E9.2)')
     &                 SIGecm(i,ip,IDXmpar) , SIGtab(56,i,ip,IDXmpar)
     &                 + SIGtab(57,i,ip,IDXmpar) ,
     &                 SIGtab(58,i,ip,IDXmpar) , SIGtab(59,i,ip,IDXmpar)
     &                 , SIGtab(60,i,ip,IDXmpar)
     &                 + SIGtab(61,i,ip,IDXmpar) ,
     &                 SIGtab(62,i,ip,IDXmpar) + SIGtab(63,i,ip,IDXmpar)
     &                 , SIGtab(64,i,ip,IDXmpar) ,
     &                 SIGtab(65,i,ip,IDXmpar) + SIGtab(66,i,ip,IDXmpar)
     &                 + SIGtab(67,i,ip,IDXmpar)
     &                 + SIGtab(68,i,ip,IDXmpar)
               END DO
               IF ( LPRi.GT.4 ) WRITE (LO,'(/1X,A,I3/1X,A,/1X,A)')
     &    'Table of unitarized x-sections (mb) for particle combination'
     &    , ip ,
     &   ' Ecm    SIGSVDM SIGHVDM  SIGTR1  SIGTR2  SIGLOO SIGDPO  SLOPE'
     &   ,
     &   '-------------------------------------------------------------'
               DO i = 1 , IEEmax
                  IF ( LPRi.GT.4 ) WRITE (LO,'(1X,1P,8E9.2)')
     &                 SIGecm(i,ip,IDXmpar) , SIGtab(79,i,ip,IDXmpar) ,
     &                 SIGtab(80,i,ip,IDXmpar) , SIGtab(32,i,ip,IDXmpar)
     &                 , SIGtab(33,i,ip,IDXmpar) ,
     &                 SIGtab(35,i,ip,IDXmpar) , SIGtab(36,i,ip,IDXmpar)
     &                 , SIGtab(39,i,ip,IDXmpar)
               END DO
            END IF
            IF ( IDEb(62).GE.1 ) THEN
               IF ( LPRi.GT.4 )
     &               WRITE (LO,'(/1X,A,/1X,A,2I4,/1X,A,/1X,A)')
     &    'Table of expected average number of cuts in non-diff events:'
     &    , '       for max. number of cuts soft/hard:' , IMAx , KMAx ,
     &    ' Ecm   PTCUT   SIGNDF   POM-S   POM-H   REG-S' ,
     &    '---------------------------------------------'
               DO i = 1 , IEEmax
                  IF ( LPRi.GT.4 ) WRITE (LO,'(1X,1P,6E10.3)')
     &                 SIGecm(i,ip,IDXmpar) , SIGtab(77,i,ip,IDXmpar) ,
     &                 SIGtab(78,i,ip,IDXmpar) , SIGtab(74,i,ip,IDXmpar)
     &                 , SIGtab(75,i,ip,IDXmpar) ,
     &                 SIGtab(76,i,ip,IDXmpar)
               END DO
               IF ( ip.EQ.1 ) THEN
                  IF ( LPRi.GT.4 ) WRITE (LO,'(/1X,A,/1X,A,/1X,A)')
     &   'Table of rapidity gap survival probability (high-mass diff.):'
     &   , ' Ecm    Spro-sd1     Spro-sd2    Spro-dd    Spro-cd' ,
     &   '---------------------------------------------------'
                  DO i = 1 , IEEmax
                     IF ( SIGecm(i,ip,IDXmpar).GT.10.D0 ) THEN
                        sprsd1 = SIGtab(32,i,ip,IDXmpar)
     &                     /(SIGtab(60,i,ip,IDXmpar)
     &                     -2.D0*(SIGtab(65,i,ip,IDXmpar)
     &                     +SIGtab(66,i,ip,IDXmpar)))
                        sprsd2 = SIGtab(33,i,ip,IDXmpar)
     &                     /(SIGtab(62,i,ip,IDXmpar)
     &                     -2.D0*(SIGtab(65,i,ip,IDXmpar)
     &                     +SIGtab(67,i,ip,IDXmpar)))
                        sprdd = SIGtab(35,i,ip,IDXmpar)
     &                     /(SIGtab(64,i,ip,IDXmpar)
     &                     +SIGtab(61,i,ip,IDXmpar)
     &                     +SIGtab(63,i,ip,IDXmpar)
     &                     -2.D0*(SIGtab(66,i,ip,IDXmpar)
     &                     +SIGtab(67,i,ip,IDXmpar)
     &                     +2.D0*SIGtab(68,i,ip,IDXmpar)))
                        IF ( SIGtab(65,i,ip,IDXmpar).GT.0.D0 ) THEN
                           sprcdf = SIGtab(36,i,ip,IDXmpar)
     &                        /(SIGtab(65,i,ip,IDXmpar)
     &                        +SIGtab(66,i,ip,IDXmpar)
     &                        +SIGtab(67,i,ip,IDXmpar)
     &                        +SIGtab(68,i,ip,IDXmpar))
                        ELSE
                           sprcdf = 0.D0
                        END IF
                        IF ( LPRi.GT.4 ) WRITE (LO,'(1X,1P,5E10.3)')
     &                       SIGecm(i,ip,IDXmpar) , sprsd1 , sprsd2 ,
     &                       sprdd , sprcdf
                     END IF
                  END DO
               END IF
            END IF
         END IF
      END DO

C  simulate only hard scatterings
      IF ( ISWmdl(2).EQ.0 ) THEN
         IF ( LPRi.GT.4 ) WRITE (LO,'(2(/1X,A))')
     &         'WARNING: generation of hard scatterings only!' ,
     &        '============================================='
         DO i = 2 , 7
            IPRon(i,1) = 0
         END DO
         DO k = 2 , 4
            DO i = 1 , 15
               IPRon(i,k) = 0
            END DO
         END DO
         SIGgen(4) = 0.D0
         DO i = 1 , IEEmax
            sigmax = 0.D0
            IF ( IPRon(1,1).EQ.1 ) sigmax = SIGtab(58,i,1,IDXmpar)
            IF ( IPRon(8,1).EQ.1 ) sigmax = sigmax +
     &           SIGtab(59,i,1,IDXmpar)
            IF ( sigmax.GT.SIGgen(4) ) THEN
               isigm = i
               SIGgen(4) = sigmax
            END IF
         END DO
      ELSE
         IF ( LPRi.GT.4 ) WRITE (LO,'(2(/1X,A))')
     &         'activated processes, cross section' ,
     &        '----------------------------------'
         IF ( LPRi.GT.4 ) WRITE (LO,'(5X,A,I3,2X,3I3)')
     &         '  nondiffr. resolved processes' , (IPRon(1,k),k=1,4)
         IF ( LPRi.GT.4 ) WRITE (LO,'(5X,A,I3,2X,3I3)')
     &         '            elastic scattering' , (IPRon(2,k),k=1,4)
         IF ( LPRi.GT.4 ) WRITE (LO,'(5X,A,I3,2X,3I3)')
     &         'qelast. vectormeson production' , (IPRon(3,k),k=1,4)
         IF ( LPRi.GT.4 ) WRITE (LO,'(5X,A,I3,2X,3I3)')
     &         '      double pomeron processes' , (IPRon(4,k),k=1,4)
         IF ( LPRi.GT.4 ) WRITE (LO,'(5X,A,I3,2X,3I3)')
     &         ' single diffract. particle (1)' , (IPRon(5,k),k=1,4)
         IF ( LPRi.GT.4 ) WRITE (LO,'(5X,A,I3,2X,3I3)')
     &         ' single diffract. particle (2)' , (IPRon(6,k),k=1,4)
         IF ( LPRi.GT.4 ) WRITE (LO,'(5X,A,I3,2X,3I3)')
     &         '    double diffract. processes' , (IPRon(7,k),k=1,4)
         IF ( LPRi.GT.4 ) WRITE (LO,'(5X,A,I3,2X,3I3)')
     &         '       direct photon processes' , (IPRon(8,k),k=1,4)

C  calculate effective cross section
         SIGgen(4) = 0.D0
         DO i = 1 , IEEmax
            CALL PHO_CSINT(1,IFPap(1),IFPap(2),-1,-1,SIGecm(i,1,IDXmpar)
     &                     ,PVIrt(1),PVIrt(2))
            sigmax = 0.D0
            IF ( ISWmdl(2).GE.1 ) THEN
               IF ( IPRon(1,1).EQ.1 ) sigmax = SIGtot - SIGela -
     &              SIGvm(0,0) - SIGcdf(0) - SIGlsd(1) - SIGhsd(1)
     &              - SIGlsd(2) - SIGhsd(2) - SIGldd - SIGhdd - SIGdir
               IF ( IPRon(2,1).EQ.1 ) sigmax = sigmax + SIGela
               IF ( IPRon(3,1).EQ.1 ) sigmax = sigmax + SIGvm(0,0)
               IF ( IPRon(4,1).EQ.1 ) sigmax = sigmax + SIGcdf(0)
               IF ( IPRon(5,1).EQ.1 ) sigmax = sigmax + SIGlsd(1)
     &              + SIGhsd(1)
               IF ( IPRon(6,1).EQ.1 ) sigmax = sigmax + SIGlsd(2)
     &              + SIGhsd(2)
               IF ( IPRon(7,1).EQ.1 ) sigmax = sigmax + SIGldd + SIGhdd
               IF ( IPRon(8,1).EQ.1 ) sigmax = sigmax + SIGdir
            ELSE
               IF ( IPRon(1,1).EQ.1 ) sigmax = SIGhar
               IF ( IPRon(8,1).EQ.1 ) sigmax = sigmax + SIGdir
            END IF
            IF ( sigmax.GT.SIGgen(4) ) THEN
               isigm = i
               SIGgen(4) = sigmax
            END IF
         END DO
      END IF

C  debug output
      IF ( SIGgen(4).LT.1.D-20 ) THEN
         IF ( LPRi.GT.4 ) WRITE (LO,'(//1X,A)')
     &    'PHO_MCINI:ERROR: selected processes have vanishing x-section'
         STOP
      END IF
      IF ( LPRi.GT.4 ) WRITE (LO,'(3X,A,1P3E11.4)')
     &                         'maximum search (Elow/Eup/Epeak)' ,
     &                        SIGecm(1,1,IDXmpar) ,
     &                        SIGecm(IEEmax,1,IDXmpar) ,
     &                        SIGecm(isigm,1,IDXmpar)
      IF ( LPRi.GT.4 ) WRITE (LO,'(11X,A,1PE12.4,/)')
     &                         'max. cross section (mb)' , SIGgen(4)

      END SUBROUTINE


      subroutine adprpl(actw,aw0plo,aw0prn,aw1plo,aw1prn,dlaplo,
     $ dlaprn,dleplo,dleprn,dlhplo,dlhprn,dloplo,dloprn,dltpll,
     $ dltplo,dltprl,dltprn,dlxpll,dlxplo,dlxprl,dlxprn,dlxdmp,
     $ eh,eh0plo,eh0prn,eh1plo,eh1prn,fo2lg,fxprpl,o20plo,o20prn,
     $ o21plo,o21prn,ph,ph0plo,ph0prn,ph1plo,ph1prn,qplaw0,qplaw1,
     $ qpleh0,qpleh1,qplolt,qplolx,qplott,qplotx,qplo20,qplo21,
     $ qplph0,qplph1,qpraw0,qpraw1,qpreh0,qpreh1,qprnlx,qprnlt,
     $ qprntx,qprntt,qpro20,qpro21,qprph0,qprph1,qredox,time1,
     $ tiplol,tiplot,tiprnl,tiprnt,xidump,xiplol,xiplot,xiprnl,
     $ xiprnt,xi1)
c
c     This subroutine adjusts print, plot, and PRS transfer points
c     as needed for the next step along the reaction path.
c
c     This subroutine is called by:
c
c       EQ6/path.f
c
c-----------------------------------------------------------------------
c
c     Principal input:
c
c
c     Principal output:
c
c
c-----------------------------------------------------------------------
c
      implicit none
c
c-----------------------------------------------------------------------
c
      logical qplaw0,qplaw1,qpleh0,qpleh1,qplolt,qplolx,qplott,qplotx,
     $ qplo20,qplo21,qplph0,qplph1,qpraw0,qpraw1,qpreh0,qpreh1,qprnlx,
     $ qprnlt,qprntx,qprntt,qpro20,qpro21,qprph0,qprph1,qredox
c
      real*8 actw,aw0plo,aw0prn,aw1plo,aw1prn,dlaplo,dlaprn,dleplo,
     $ dleprn,dlhplo,dlhprn,dloplo,dloprn,dltpll,dltplo,dltprl,dltprn,
     $ dlxpll,dlxplo,dlxprl,dlxprn,dlxdmp,eh,eh0plo,eh0prn,eh1plo,
     $ eh1prn,fo2lg,fxprpl,o20plo,o20prn,o21plo,o21prn,ph,ph0plo,
     $ ph0prn,ph1plo,ph1prn,time1,tiplol,tiplot,tiprnl,tiprnt,xidump,
     $ xiplol,xiplot,xiprnl,xiprnt,xi1
c
c-----------------------------------------------------------------------
c
c     Local variable declarations.
c
      real*8 tolx,tx,xx
c
      real*8 texp,tlg
c
c-----------------------------------------------------------------------
c
c     Reset print points as necessary.
c
      if (qprntx) then
        tolx = fxprpl*dlxprn
  100   xiprnt = xiprnt + dlxprn
        if ((xi1 + tolx) .ge. xiprnt) go to 100
      endif
c
      if (qprntt) then
        tolx = fxprpl*dlxprn
  110   tiprnt = tiprnt + dltprn
        if ((time1 + tolx) .ge. tiprnt) go to 110
      endif
c
      if (qprnlx) then
        tolx = fxprpl*dlxprl
  120   xiprnl = texp(tlg(xiprnl) + dlxprl)
        xx = texp(tlg(xi1) + tolx)
        if (xx .ge. xiprnl) go to 120
      endif
c
      if (qprnlt) then
        tolx = fxprpl*dltprl
  130   tiprnl = texp(tlg(tiprnl) + dltprl)
        tx = texp(tlg(time1) + tolx)
        if (tx .ge. tiprnl) go to 130
      endif
c
      if (qprph0) then
        tolx = fxprpl*dlhprn
  140   ph0prn = ph0prn - dlhprn
        if ((ph - tolx) .le. ph0prn) go to 140
        ph1prn = ph0prn
  150   ph1prn = ph1prn + dlhprn
        if ((ph + tolx) .ge. ph1prn) go to 150
      endif
c
      if (qprph1) then
        tolx = fxprpl*dlhprn
  160   ph1prn = ph1prn + dlhprn
        if ((ph + tolx) .ge. ph1prn) go to 160
        ph0prn = ph1prn
  170   ph0prn = ph0prn - dlhprn
        if ((ph - tolx) .le. ph0prn) go to 170
      endif
c
      if (qredox) then
        if (qpreh0) then
          tolx = fxprpl*dleprn
  180     eh0prn = eh0prn - dleprn
          if ((eh - tolx) .le. eh0prn) go to 180
          eh1prn = eh0prn
  190     eh1prn = eh1prn + dleprn
          if ((eh + tolx) .ge. eh1prn) go to 190
        endif
c
        if (qpreh1) then
          tolx = fxprpl*dleprn
  200     eh1prn = eh1prn + dleprn
          if ((eh + tolx) .ge. eh1prn) go to 200
          eh0prn = eh1prn
  210     eh0prn = eh0prn - dleprn
          if ((eh - tolx) .le. eh0prn) go to 210
        endif
c
        if (qpro20) then
          tolx = fxprpl*dloprn
  220     o20prn = o20prn - dloprn
          if ((fo2lg - tolx) .le. o20prn) go to 220
          o21prn = o20prn
  230     o21prn = o21prn + dloprn
          if ((fo2lg + tolx) .ge. o21prn) go to 230
        endif
c
        if (qpro21) then
          tolx = fxprpl*dloprn
  240     o21prn = o21prn + dloprn
          if ((fo2lg + tolx) .ge. o21prn) go to 240
          o20prn = o21prn
  250     o20prn = o20prn - dloprn
          if ((fo2lg - tolx) .le. o20prn) go to 250
        endif
c
      endif
c
      if (qpraw0) then
        tolx = fxprpl*dlaprn
  260   aw0prn = aw0prn - dlaprn
        if ((actw - tolx) .le. aw0prn) go to 260
        aw1prn = aw0prn
  270   aw1prn = aw1prn + dlaprn
        if ((actw + tolx) .ge. aw1prn) go to 270
      endif
c
      if (qpraw1) then
        tolx = fxprpl*dlaprn
  280   aw1prn = aw1prn + dlaprn
        if ((actw + tolx) .ge. aw1prn) go to 280
        aw0prn = aw1prn
  290   aw0prn = aw0prn - dlaprn
        if ((actw - tolx) .le. aw0prn) go to 290
      endif
c
c* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
c
c     Reset plot points as necessary.
c
      if (qplotx) then
        tolx = fxprpl*dlxplo
  400   xiplot = xiplot + dlxplo
        if ((xi1 + tolx)  .ge. xiplot) go to 400
      endif
c
      if (qplott) then
        tolx = fxprpl*dltplo
  410   tiplot = tiplot + dltplo
        if ((time1 + tolx)  .ge. tiplot) go to 410
      endif
c
      if (qplolx) then
        tolx = fxprpl*dlxpll
  420   xiplol = texp(tlg(xiplol) + dlxpll)
        xx = texp(tlg(xi1) + tolx)
        if (xx  .ge. xiplol) go to 420
      endif
c
      if (qplolt) then
        tolx = fxprpl*dltpll
  430   tiplol = texp(tlg(tiplol) + dltpll)
        tx = texp(tlg(time1) + tolx)
        if (tx .ge. tiplol) go to 430
      endif
c
      if (qplph0) then
        tolx = fxprpl*dlhplo
  440   ph0plo = ph0plo - dlhplo
        if ((ph - tolx) .le. ph0plo) go to 440
        ph1plo = ph0plo
  450   ph1plo = ph1plo + dlhplo
        if ((ph + tolx) .ge. ph1plo) go to 450
      endif
c
      if (qplph1) then
        tolx = fxprpl*dlhplo
  460   ph1plo = ph1plo + dlhplo
        if ((ph + tolx) .ge. ph1plo) go to 460
        ph0plo = ph1plo
  470   ph0plo = ph0plo - dlhplo
        if ((ph - tolx) .le. ph0plo) go to 470
      endif
c
      if (qredox) then
        if (qpleh0) then
          tolx = fxprpl*dleplo
  480     eh0plo = eh0plo - dleplo
          if ((eh - tolx) .le. eh0plo) go to 480
          eh1plo = eh0plo
  490     eh1plo = eh1plo + dleplo
          if ((eh + tolx) .ge. eh1plo) go to 490
        endif
c
        if (qpleh1) then
          tolx = fxprpl*dleplo
  500     eh1plo = eh1plo + dleplo
          if ((eh + tolx) .ge. eh1plo) go to 500
          eh0plo = eh1plo
  510     eh0plo = eh0plo - dleplo
          if ((eh - tolx) .le. eh0plo) go to 510
        endif
c
        if (qplo20) then
          tolx = fxprpl*dloplo
  520     o20plo = o20plo - dloplo
          if ((fo2lg - tolx) .le. o20plo) go to 520
          o21plo = o20plo
  530     o21plo = o21plo + dloplo
          if ((fo2lg + tolx) .ge. o21plo) go to 530
        endif
c
        if (qplo21) then
          tolx = fxprpl*dloplo
  540     o21plo = o21plo + dloplo
          if ((fo2lg + tolx) .ge. o21plo) go to 540
          o20plo = o21plo
  550     o20plo = o20plo - dloplo
          if ((fo2lg - tolx) .le. o20plo) go to 550
        endif
c
      endif
c
      if (qplaw0) then
        tolx = fxprpl*dlaplo
  560   aw0plo = aw0plo - dlaplo
        if ((actw - tolx) .le. aw0plo) go to 560
        aw1plo = aw0plo
  570   aw1plo = aw1plo + dlaplo
        if ((actw + tolx) .ge. aw1plo) go to 570
      endif
c
      if (qplaw1) then
        tolx = fxprpl*dlaplo
  580   aw1plo = aw1plo + dlaplo
        if ((actw + tolx) .ge. aw1plo) go to 580
        aw0plo = aw1plo
  590   aw0plo = aw0plo - dlaplo
        if ((actw - tolx) .le. aw0plo) go to 590
      endif
c
c* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
c
c     Reset the PRS transfer point as necessary.
c
      if (xidump. le. xi1) then
        tolx = fxprpl*dlxdmp
  700   xidump = xidump + dlxdmp
        if ((xi1 + tolx)  .ge. xidump) go to 700
      endif
c
c* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
c
      end


C$Procedure   RDFFPL ( read triangular plate model flatfile )

      SUBROUTINE RDFFPL ( INFILE, PLTTYP, NV, VRTCES, NP, PLATES )
      IMPLICIT NONE

C$ Abstract
C
C     Read a triangular plate model's flatfile's data file.
C
C$ Disclaimer
C
C     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE
C     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S.
C     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE
C     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE
C     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS"
C     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY
C     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A
C     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC
C     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE
C     SOFTWARE AND RELATED MATERIALS, HOWEVER USED.
C
C     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA
C     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT
C     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND,
C     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS,
C     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE
C     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY.
C
C     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF
C     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY
C     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE
C     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE.
C
C$ Required_Reading
C
C     MKPLAT User's Guide
C     SURFACE
C
C$ Keywords
C
C     PLATE
C     FLATFILE
C
C$ Declarations

      INCLUDE               'mkdsk02.inc'
      INCLUDE               'mkdsk.inc'

      CHARACTER*(*)         INFILE
      INTEGER               PLTTYP
      INTEGER               NV
      DOUBLE PRECISION      VRTCES ( 3, * )
      INTEGER               NP
      INTEGER               PLATES ( 3, * )

C$ Brief_I/O
C
C     VARIABLE  I/O  DESCRIPTION
C     --------  ---  --------------------------------------------------
C     INFILE     I   Name of plate data file.
C     PLTTYP     I   Integer code identifying type of data file.
C     NV         O   Number of vertices in model.
C     VRTCES     O   3 x NV array of vertices.
C     NP         O   Number of plates in model.
C     PLATES     O   3 x NP array of plates.
C
C
C$ Detailed_Input
C
C     INFILE     is the full pathname of the plate model flatfile.
C
C     PLTTYP     the integer code identifying the type of data
C                to read from INFILE. Two values are allowed:
C
C                    1    A standard plate-vertex data file
C                         containing vertex coordinates and
C                         the plate-vertex mappings.
C
C                    2    A Gaskel shape data file containing
C                         plate ordered vertex data.
C
C                    3    A vertex-facet table data file
C                         containing vertex coordinates and
C                         the facet listing.
C
C                    4    Rosetta/Osiris ".ver" format file
C                         containing vertex coordinates
C                         and a plate-vertex mapping.
C
C$ Detailed_Output
C
C     NV         is the number of vertices in the plate model.
C
C
C     VRTCES     is an array of the NV vertices given in a body-fixed
C                frame of reference. Elements
C
C                   VRTCES(J,I), J = 1 ... 3
C
C                are, respectively, the X, Y, and Z coordinates of the
C                Ith vertex.
C
C
C     PLATES     is an array of the NP plates. Elements
C
C                   PLATES(J,I), J = 1 ... 3
C
C                are, respectively, the indices of the vertices of the
C                Ith plate. The vertex indices range from 1 to NV.
C
C                The order of the vertices give the direction of the
C                plate's outward normal vector: the vector is parallel
C                to the cross product of the plate edge connecting
C                vertex 1 to vertex 2 and the plate edge connecting
C                vertex 2 to vertex 3, in that order.
C
C$ Parameters
C
C     None.
C
C$ Exceptions
C
C     1) If the number of vertices (NV) exceeds the value of MAXVRT,
C        SPICE(TOOMANYVERTICES) signals.
C
C     2) If the number of plates (NP) exceeds the value of MAXPLT,
C        SPICE(TOOMANYPLATES) signals.
C
C     3) If the NPARSD routine fails while parsing a double string,
C        SPICE(BADDOUBLEPRECISION) signals.
C
C     4) If the NPARSI routine fails while parsing an integer string,
C        SPICE(BADINTEGER) signals.
C
C     5) If a data line lacks the expected format (data type 3),
C        SPICE(BADDATALINE) signals.
C
C     6) If the PLTTYP variable has an uncoded value,
C        SPICE(BADDATATYPE) signals.
C
C     7) If the Gaskell ICQ parameter "Q" is too large, the error
C        SPICE(QPARAMOUTOFRANGE) is signaled.
C
C$ Files
C
C     None.
C
C$ Particulars
C
C     Input File Format
C     -----------------
C
C     INFILE is assumed to be structured as follows (values
C            are space delimited within each input record).
C
C     -Plate/vertex data file (PLATE_TYPE 1):
C
C        Line  1: NV
C        NV = the number of vertices (INTEGER)
C
C        Lines 2 to (NV+1): VID X Y Z
C        VID         = the vertex ID (INTEGER)
C        X, Y, and Z = the vertex coordinates (DOUBLE PRECISION)
C
C        Line  (NV+2): NP
C        NP = number of triangular plates (INTEGER)
C
C        Lines (NV+3) to (NV+3+NP+1): PID V1 V2 V3
C        PID            = the plate ID (INTEGER)
C        V1, V2, and V3 = the plate vertex ID's (INTEGER)
C
C     -Shape data file (PLATE_TYPE 2):
C
C        Line 1: Q
C        Q = number of vertex coordinates per side of the
C            cube face - not counting the origin. A
C            face has (Q+1)^2 vertex coordinates.
C
C        Lines 2 to (Q+1): X Y Z
C        X, Y, and Z = the vertex coordinates (DOUBLE PRECISION)
C
C     -Vertex/Facet table data file (PLATE_TYPE 3):
C
C        NV = the number of vertices (INTEGER)
C
C        Lines 1 to NV: 'V' X Y Z
C        'V'         = character flag indicating vertex data
C        X, Y, and Z = the vertex coordinates (DOUBLE PRECISION)
C
C        NP = number of triangular plates (INTEGER)
C
C        Lines (NV+1) to (NV+1+NP): 'F' V1 V2 V3
C        'F'            = character flag indicating facet
C                         (plate-vertex) data
C        V1, V2, and V3 = the plate vertex ID's (INTEGER)
C
C$ Examples
C
C  C     The following include file defines MAXVRT and
C  C     MAXPLT, the maximum number of vertices and plates
C  C     used in the plate model software.
C
C        INCLUDE               'mkdsk02.inc'
C
C        INTEGER               NV
C        INTEGER               NP
C        INTEGER               PLATES ( 3, MAXPLT )
C        INTEGER               PLTTYP
C
C        DOUBLE PRECISION      VRTCES ( 3, MAXVRT )
C
C        CHARACTER*(80)        INFILE
C
C        CALL PROMPT ( 'Enter name of plate data file : ', INFILE )
C        CALL PROMPT ( 'Enter type of plate data      : ', PLTTYP )
C
C        CALL RDFFPL ( INFILE,  PLTTYP, NV, VERTCES, NP, PLATES )
C
C$ Restrictions
C
C     It is the user's responsibility to properly dimension
C     arrays in the calling routine large enough to accept data
C     from the given file.
C
C$ Literature_References
C
C     None.
C
C$ Author_and_Institution
C
C     J.A. Bytof      (JPL)
C
C$ Version
C
C-    MKDSK Version 5.1.0, 21-MAR-2017 (NJB)
C
C        Now references non-portable include file
C
C           mkdsk02.inc
C
C        instead of
C
C           dsk02.inc
C
C        This enables use of smaller maximum vertex and plate
C        counts on platforms where the default values consume
C        excessive memory.
C
C        Added checks for excessive vertex and plate counts.
C
C        Added FAILED checks following RDFFDI, RDNBL, and
C        PRSINT calls.
C
C-    MKDSK Version 5.0.0, 25-APR-2016 (NJB)
C
C        Bug fix: added check-out and return to input format 2
C        branch, in the case where a Q value out of range is found.
C
C
C
C        07-APR-2015 (NJB)
C
C           Increased string length used to parse numeric tokens.
C           Updated message indicating completion of input file read.
C           Cleaned up debugging code.
C
C        05-AUG-2014 (NJB)
C
C           Argument list change: arguments PID and VID have been
C           removed; arguments X, Y, Z and V1, V2, V3 have been
C           replaced by arrays VRTCES and PLATES respectively.
C
C           Local array VEC is no longer used.
C
C-    MKDSK Version 4.0.0, 08-JUN-2010 (NJB)
C
C        Added capability of reading Rosetta Osiris ".ver"
C        format file.
C
C-    MKDSK Version 3.1.0, 04-MAY-2010 (NJB)
C
C        Changed INCLUDE file from platmax.inc to dsk02.inc.
C        Added INCLUDE statement referencing mkdsk.inc to
C        declare parameter MAXQ.
C
C-    MKDSK Version 3.0.1, 08-OCT-2009 (NJB)
C
C        Re-ordered header sections.
C
C-    MKDSK Version 3.0.0, 25-OCT-2004 (EDW)
C
C        Added capability to process Bob Gaskell shape files.
C        Added MAXQ parameter to 'pltmax.inc'.
C
C-    MKDSK Version 2.0.0, 22-OCT-1998 (JAB)
C
C-    MKDSK Version 1.0.0, 09-APR-1997 (JAB)
C
C-&

C$ Index_Entries
C
C     read triangular plate model flatfile
C
C-&

C
C     SPICELIB functions
C
      DOUBLE PRECISION      VNORM

      LOGICAL               EQSTR
      LOGICAL               EVEN
      LOGICAL               FAILED
      LOGICAL               RETURN

C
C     Local parameters
C
      INTEGER               MAXWDS
      PARAMETER           ( MAXWDS = 3 )

      INTEGER               SHORT
      PARAMETER           ( SHORT = 80 )

      INTEGER               TOKLEN
      PARAMETER           ( TOKLEN = 40 )
C
C     Local variables
C
      CHARACTER*(TOKLEN)    ARC     ( 6 )
      CHARACTER*(160)       ERROR
      CHARACTER*(10)        FORMAT
      CHARACTER*(LNSIZE)    ILINE
      CHARACTER*(SHORT)     TOKENS ( MAXWDS )

      DOUBLE PRECISION      ARD    ( 3 )
      DOUBLE PRECISION      VEC    ( 3 )
      DOUBLE PRECISION      W1     ( 3 )
      DOUBLE PRECISION      W2     ( 3 )

      INTEGER               ARI    ( 4 )
      INTEGER               FACE
      INTEGER               I
      INTEGER               IX1
      INTEGER               IX2
      INTEGER               J
      INTEGER               N      ( 0:MAXQ, 0:MAXQ, 6)
      INTEGER               N0
      INTEGER               NC
      INTEGER               ND
      INTEGER               NI
      INTEGER               NREC
      INTEGER               NTOK
      INTEGER               PTR
      INTEGER               Q

      LOGICAL               EOF

C
C     Saved variables
C
      SAVE

C
C     Standard SPICE error handling.
C

      IF ( RETURN () ) THEN
         RETURN
      END IF

      CALL CHKIN ( 'RDFFPL' )

C
C     Initialize record counter.
C
      NREC = 1

C
C     Read the data file corresponding to the PLTTYP ID.
C
      IF( PLTTYP .EQ. 1 ) THEN

C
C        Plate data type 1.
C
C        First line, a single integer, number of vertices.
C
         FORMAT = 'I'

         CALL RDFFDI ( INFILE, NREC, FORMAT, ND, NI, NC,
     .                 ARD, ARI, ARC, EOF  )

         IF ( FAILED() ) THEN
            CALL CHKOUT ( 'RDFFPL' )
            RETURN
         END IF

         NV = ARI(1)

C
C        Check the routine can handle the vertices.
C
         IF ( NV .GT. MAXVRT ) THEN
            CALL SETMSG ( 'Number of vertices # exceeds limit #.' )
            CALL ERRINT ( '#',  NV                                )
            CALL ERRINT ( '#',  MAXVRT                            )
            CALL SIGERR ( 'SPICE(TOOMANYVERTICES)'                )
            CALL CHKOUT ( 'RDFFPL'                                )
            RETURN
         END IF

C
C        Read data: integer double double double.
C
         FORMAT = 'I D D D'

         DO I = 1, NV

            NREC   = NREC + 1

            CALL RDFFDI ( INFILE, NREC, FORMAT, ND, NI, NC,
     .                    ARD, ARI, ARC, EOF  )

            IF ( FAILED() ) THEN
               CALL CHKOUT ( 'RDFFPL' )
               RETURN
            END IF

            IF ( EOF ) THEN
               CALL EXTMSI ( 'End of file after line #.', '#', NREC )
            END IF

            VRTCES(1,I) = ARD(1)
            VRTCES(2,I) = ARD(2)
            VRTCES(3,I) = ARD(3)

         END DO

C
C        Plate data type 1 reads the plat-vertex information from
C        the plate file.
C
C        Read number of plates.
C
         NREC   = NREC + 1
         FORMAT = 'I'

         CALL RDFFDI ( INFILE, NREC, FORMAT, ND, NI, NC,
     .                 ARD, ARI, ARC, EOF  )

         IF ( FAILED() ) THEN
            CALL CHKOUT ( 'RDFFPL' )
            RETURN
         END IF

         IF ( EOF ) THEN
            CALL EXTMSI ( 'End of file after line #.', '#', NREC )
         END IF

C
C        Check we can process 'NP' plates.
C
         NP = ARI(1)

         IF ( NP .GT. MAXPLT ) THEN
            CALL SETMSG ( 'Number of plates # exceeds limit #.' )
            CALL ERRINT ( '#', NP                               )
            CALL ERRINT ( '#', MAXPLT                           )
            CALL SIGERR ( 'SPICE(TOOMANYPLATES)'                )
            CALL CHKOUT ( 'RDFFPL'                              )
            RETURN
         END IF

C
C        Read each plate's ID and corresponding vertex set defining
C        the plate.
C
         FORMAT = 'I I I I'

         DO I = 1, NP

            NREC   = NREC + 1

            CALL RDFFDI ( INFILE, NREC, FORMAT, ND, NI, NC,
     .                    ARD, ARI, ARC, EOF  )

            IF ( FAILED() ) THEN
               CALL CHKOUT ( 'RDFFPL' )
               RETURN
            END IF

            IF ( EOF ) THEN
               CALL EXTMSI ( 'End of file after line #.', '#', NREC )
            END IF

            PLATES(1,I) = ARI(2)
            PLATES(2,I) = ARI(3)
            PLATES(3,I) = ARI(4)

         END DO

      ELSE IF( PLTTYP .EQ. 2 ) THEN

C
C        Plate data type 2.
C
C        Read a Gaskell shape file. Shape files contain only vertex
C        data, the plate-vertex mappings implicitly known from the
C        ordering of the data. The Gaskell model uses quadralaterals
C        plates, a plate defined by the vector set:
C
C        [ VEC( *, I, J  , FACE), VEC( *, I+1, J  , FACE),
C          VEC( *, I, J+1, FACE), VEC( *, I+1, J+1, FACE) ]
C
C        The file lists the vertex data in terms cube faces. Six
C        faces, each with Q+1 x Q+1 vertices.
C
         FORMAT = 'I'

         CALL RDFFDI ( INFILE, NREC, FORMAT, ND, NI, NC,
     .                 ARD, ARI, ARC, EOF  )

         IF ( FAILED() ) THEN
            CALL CHKOUT ( 'RDFFPL' )
            RETURN
         END IF

         Q  = ARI(1)
         NV = 6*( (Q+1)**2)

C
C        Does the read Q exceed the maximum value.
C
         IF ( Q .GT. MAXQ ) THEN

            CALL SETMSG ( 'Shape parameter Q = #, exceeds maximum '
     .      //            'value #. This error may indicate that '
     .      //            'the input file format is something other '
     .      //            'than the Gaskell ICQ format.'              )
            CALL ERRINT ( '#', Q                                      )
            CALL ERRINT ( '#', MAXQ                                   )
            CALL SIGERR ( 'SPICE(QPARAMOUTOFRANGE)'                   )
            CALL CHKOUT ( 'RDFFPL'                                    )
            RETURN

         END IF
C
C        Check the routine can handle the vertices.
C
         IF ( NV .GT. MAXVRT ) THEN
            CALL SETMSG ( 'Number of vertices # exceeds limit #.' )
            CALL ERRINT ( '#', NV                                 )
            CALL ERRINT ( '#', MAXVRT                             )
            CALL SIGERR ( 'SPICE(TOOMANYVERTICES)'                )
            CALL CHKOUT ( 'RDFFPL'                                )
            RETURN
         END IF

C
C        Read data: double double double
C
         FORMAT = 'D D D'

         N0 = 0

         DO FACE = 1, 6

            DO J = 0, Q

               DO I = 0, Q

                  NREC = NREC + 1

C
C                 Read the vertex data. The 3-Vector
C                    _                 _
C                   |  VEC(1,I,J,FACE)  |
C                   |  VEC(2,I,J,FACE)  |
C                   |_ VEC(3,I,J,FACE) _|
C
C                 contains the vertex coordinates.
C
                  CALL RDFFDI ( INFILE, NREC, FORMAT,
     .                          ND,     NI,   NC,
     .                          VEC,    ARI,  ARC,
     .                          EOF )

                  IF ( FAILED() ) THEN
                     CALL CHKOUT ( 'RDFFPL' )
                     RETURN
                  END IF

                  IF ( EOF ) THEN
                     CALL EXTMSI ( 'End of file after line #.',
     .                             '#', NREC)
                  END IF

C
C                Store the vertex ID to the 'N' array using the same
C                indexing as 'VEC'.
C
                 N0          = N0+1
                 N(I,J,FACE) = N0

C
C                Copy the vertex coordinates to the corresponding
C                plate model arrays. This operation is somewhat
C                repetitive, but clarity is most important.
C
                 VRTCES(1,N0) = VEC(1)
                 VRTCES(2,N0) = VEC(2)
                 VRTCES(3,N0) = VEC(3)

               END DO

            END DO

         END DO

C
C        Plate data type 2 calculates the plate-vertex mappings
C        from the ordering of the vertex data.

C
C        Number of plates based on the 'Q' value.
C
         NP = 12*(Q**2)

C
C        Check we can process 'NP' plates.
C
         IF ( NP .GT. MAXPLT ) THEN
            CALL SETMSG ( 'Number of plates # exceeds limit #.' )
            CALL ERRINT ( '#', NP                               )
            CALL ERRINT ( '#', MAXPLT                           )
            CALL SIGERR ( 'SPICE(TOOMANYPLATES)'                )
            CALL CHKOUT ( 'RDFFPL'                              )
            RETURN
         END IF

C
C        Expand a Gaskell shape model vertex ordering to
C        form a plate-vertex map.
C

C
C        Cube edges. Associate later IDs with
C        the first occurrence.
C
         DO I=1,Q-1

            N(I,Q,6) = N(Q-I, Q  , 4)
            N(I,0,6) = N(I  , Q  , 2)
            N(I,0,5) = N(Q  , Q-I, 1)
            N(I,0,4) = N(Q-I, 0  , 1)
            N(I,0,3) = N(0  , I  , 1)
            N(I,0,2) = N(I  , Q  , 1)

         END DO

         DO J=1,Q-1

            N(Q,J,6) = N(J  , Q, 5)
            N(Q,J,5) = N(0  , J, 4)
            N(Q,J,4) = N(0  , J, 3)
            N(Q,J,3) = N(0  , J, 2)
            N(0,J,6) = N(Q-J, Q, 3)
            N(0,J,5) = N(Q  , J, 2)

         END DO

C
C        Cube corners. Associate later IDs with
C        the first occurrence.
C
         N(0,0,3) = N(0,0,1)
         N(Q,0,4) = N(0,0,1)
         N(0,0,2) = N(0,Q,1)
         N(Q,0,3) = N(0,Q,1)
         N(0,0,4) = N(Q,0,1)
         N(Q,0,5) = N(Q,0,1)
         N(0,0,5) = N(Q,Q,1)
         N(Q,0,2) = N(Q,Q,1)
         N(0,0,6) = N(0,Q,2)
         N(Q,Q,3) = N(0,Q,2)
         N(0,Q,5) = N(Q,Q,2)
         N(Q,0,6) = N(Q,Q,2)
         N(Q,Q,4) = N(0,Q,3)
         N(0,Q,6) = N(0,Q,3)
         N(Q,Q,5) = N(0,Q,4)
         N(Q,Q,6) = N(0,Q,4)

         N0 = 0

         DO FACE = 1, 6

            DO I = 0, Q-1

               DO J = 0, Q-1

C
C                 As mentioned, the Gaskell shape model uses
C                 quadrilateral plates as opposed to triangular used by
C                 the NAIF plate system. We can reduce a quadrilateral
C                 into two triangles by adding a vector connecting
C                 opposite facing vertices creating two triangles
C                 (1 and 2):
C
C                               V1
C                               /\
C                              / 1\
C                          V4 /____\ V2
C                             \  2 /
C                              \  /
C                               \/
C                               V3
C
C                 or
C                                V1
C                               /|\
C                              / | \
C                         V4  /  |2 \ V2
C                             \ 1|  /
C                              \ | /
C                               \|/
C                                V3
C
C                 We chose the connecting vector to minimize the cross
C                 product magnitude of the connected vertex vectors.
C
C                    connection = MIN( V1 x V3, V2 X V4)
C

C
C                 Connection 1.
C

                  IX1 = (FACE-1)*((Q+1)**2) + ((Q+1)* J   ) +  I    + 1
                  IX2 = (FACE-1)*((Q+1)**2) + ((Q+1)*(J+1)) + (I+1) + 1

                  CALL VCRSS ( VRTCES(1,IX1), VRTCES(1,IX2), W1 )

C
C                 Connection 2.
C

                  IX1 = (FACE-1)*((Q+1)**2) + ((Q+1)* J   ) + (I+1) + 1
                  IX2 = (FACE-1)*((Q+1)**2) + ((Q+1)*(J+1)) +  I    + 1

                  CALL VCRSS ( VRTCES(1,IX1), VRTCES(1,IX2), W2 )

C
C                 Calculate the magnitudes of the cross products;
C                 branch based on the minimum value.
C
C                 Fill two entries of the plate-vertex mapping
C                 from the divided quadralateral.
C
                  IF( VNORM(W1) .LE. VNORM(W2) ) THEN
C
C                    Apply connection 1.
C
                     N0           = N0+1
                     PLATES(1,N0) = N(I ,  J,   FACE)
                     PLATES(2,N0) = N(I+1, J+1, FACE)
                     PLATES(3,N0) = N(I+1, J,   FACE)

                     N0           = N0+1
                     PLATES(1,N0) = N(I,   J,   FACE)
                     PLATES(2,N0) = N(I,   J+1, FACE)
                     PLATES(3,N0) = N(I+1, J+1, FACE)

                  ELSE
C
C                    Apply connection 2.
C
                     N0           = N0+1
                     PLATES(1,N0) = N(I,   J,   FACE)
                     PLATES(2,N0) = N(I,   J+1, FACE)
                     PLATES(3,N0) = N(I+1, J,   FACE)

                     N0           = N0+1
                     PLATES(1,N0) = N(I+1, J,   FACE)
                     PLATES(2,N0) = N(I,   J+1, FACE)
                     PLATES(3,N0) = N(I+1, J+1, FACE)

                  END IF

               END DO

            END DO

         END DO

      ELSE IF( PLTTYP .EQ. 3 ) THEN
C
C        Plate data type 3.
C
C        Read data. The data format depends on the
C        prefix marker either 'v' (vertex) or 'f' (facet).
C        Since we don't know the prefix a priori,
C        extract the four data elements, then parse.
C
         NP     = 0
         NV     = 0
         FORMAT = 'C C C C'
         EOF    = .FALSE.

         DO WHILE ( .NOT. EOF )

            CALL RDFFDI ( INFILE, NREC, FORMAT, ND, NI, NC,
     .                    ARD, ARI, ARC, EOF  )

            IF ( FAILED() ) THEN
               CALL CHKOUT ( 'RDFFPL' )
               RETURN
            END IF

            IF ( .NOT. EOF ) THEN

C
C              Branch based on the type of data, 'v' or 'f'.
C
               IF(  EQSTR( ARC(1), 'v' )  ) THEN

C
C                 Vertex data. Process a line of three doubles.
C                 The algorithm includes an implicit assumption that
C                 the data order defines the vertex IDs.  If not,
C                 the output plate files will be useless.
C
                  NV = NV + 1

                  IF ( NV .GT. MAXVRT ) THEN

                     CALL SETMSG ( 'Number of vertices # exceeds '
     .               //            'limit #.'                    )
                     CALL ERRINT ( '#',  NV                      )
                     CALL ERRINT ( '#',  MAXVRT                  )
                     CALL SIGERR ( 'SPICE(TOOMANYVERTICES)'      )
                     CALL CHKOUT ( 'RDFFPL'                      )
                     RETURN

                  END IF

                  DO J = 2, 4

                     CALL NPARSD ( ARC(J), ARD(J-1), ERROR, PTR )

                     IF ( PTR .NE. 0 ) THEN
                        CALL SETMSG ( 'D.P. error (#) in line #.' )
                        CALL ERRCH  ( '#', ERROR                  )
                        CALL ERRINT ( '#', NREC                   )
                        CALL SIGERR ( 'SPICE(BADDOUBLEPRECISION)' )
                        CALL CHKOUT ( 'RDFFPL'                    )
                        RETURN
                     END IF

                  END DO

                 VRTCES(1,NV) = ARD(1)
                 VRTCES(2,NV) = ARD(2)
                 VRTCES(3,NV) = ARD(3)

               ELSE IF ( EQSTR( ARC(1), 'f') ) THEN

C
C                 Plate-vertex data. Process a line of three integers.
C                 The algorithm includes an implicit assumption that
C                 the data order defines the plate IDs. If not,
C                 the output plate files will be useless.
C
                  NP = NP + 1

                 IF ( NP .GT. MAXPLT ) THEN

                    CALL SETMSG( 'Number of plates # exceeds limit #.' )
                    CALL ERRINT( '#', NP                               )
                    CALL ERRINT( '#', MAXPLT                           )
                    CALL SIGERR( 'SPICE(TOOMANYPLATES)'                )
                    CALL CHKOUT( 'RDFFPL'                              )
                    RETURN

                 END IF

                  DO J =2, 4

                     CALL NPARSI ( ARC(J), ARI(J-1), ERROR, PTR )

                     IF ( PTR .NE. 0 ) THEN
                        CALL SETMSG ( 'Integer error (#) in line #.' )
                        CALL ERRCH  ( '#', ERROR                     )
                        CALL ERRINT ( '#', NREC                      )
                        CALL SIGERR ( 'SPICE(BADINTEGER)'            )
                        CALL CHKOUT ( 'RDFFPL'                       )
                        RETURN
                     END IF

                  END DO

                  PLATES(1,NP) = ARI(1)
                  PLATES(2,NP) = ARI(2)
                  PLATES(3,NP) = ARI(3)

               ELSE

C
C                 This block executes if the first characters of
C                 a type 3 data lacks a 'v' or 'f'.
C
                  CALL SETMSG ( 'Bad data line at record #.' )
                  CALL ERRINT ( '#', NREC                    )
                  CALL SIGERR ( 'SPICE(BADDATALINE)'         )
                  CALL CHKOUT ( 'RDFFPL'                     )
                  RETURN

               END IF

               NREC = NREC + 1

            END IF

         END DO

C
C        All type 3 data read. We should have a non zero NP and NV,
C        if not, something failed.
C
         IF ( (NP .EQ. 0) .OR. (NV .EQ. 0) ) THEN
            CALL SETMSG ( 'Read error, type 3 data file.'
     .                 // ' Num plates = #1, num verts = #2.'
     .                 // 'Both should be non-zero'         )
            CALL ERRINT ( '#1', NP                          )
            CALL ERRINT ( '#2', NV                          )
            CALL SIGERR ( 'SPICE(DATAREADFAILED)'           )
            CALL CHKOUT ( 'RDFFPL'                          )
            RETURN
         END IF

      ELSE IF ( PLTTYP .EQ. 4 ) THEN
C
C        We have a Rosetta Osiris style ".ver" file.
C
C        Get the vertex and plate count from the first non-blank
C        input line.
C
         CALL RDNBL ( INFILE, ILINE, EOF )

         IF ( FAILED() ) THEN
            CALL CHKOUT ( 'RDFFPL' )
            RETURN
         END IF

         CALL LPARSM ( ILINE, ' ,', 2, NTOK, TOKENS )

         IF ( NTOK .NE. 2 ) THEN

            CALL SETMSG ( 'Vertex and plate count were expected '
     .      //            'on first line of input file. Line was '
     .      //            '#.'                                    )
            CALL ERRCH  ( '#', ILINE                              )
            CALL SIGERR ( 'SPICE(UNRECOGNIZEDFORMAT)'             )
            CALL CHKOUT ( 'RDFFPL'                                )
            RETURN

         END IF

         CALL PRSINT ( TOKENS(1), NV )
         CALL PRSINT ( TOKENS(2), NP )

         IF ( FAILED() ) THEN
            CALL CHKOUT ( 'RDFFPL' )
            RETURN
         END IF

         IF ( NV .GT. MAXVRT ) THEN

            CALL SETMSG ( 'Number of vertices # exceeds limit #.' )
            CALL ERRINT ( '#',  NV                                )
            CALL ERRINT ( '#',  MAXVRT                            )
            CALL SIGERR ( 'SPICE(TOOMANYVERTICES)'                )
            CALL CHKOUT ( 'RDFFPL'                                )
            RETURN

         END IF

         IF ( NP .GT. MAXPLT ) THEN

            CALL SETMSG ( 'Number of plates # exceeds limit #.' )
            CALL ERRINT ( '#', NP                               )
            CALL ERRINT ( '#', MAXPLT                           )
            CALL SIGERR ( 'SPICE(TOOMANYPLATES)'                )
            CALL CHKOUT ( 'RDFFPL'                              )
            RETURN

         END IF

C
C        Read the vertex data and store it in the output vertex array.
C
         DO I = 1, NV

            CALL RDNBL ( INFILE, ILINE, EOF )

            IF ( FAILED() ) THEN
               CALL CHKOUT ( 'RDFFPL' )
               RETURN
            END IF

            IF ( EOF ) THEN

               CALL SETMSG ( 'Expected to find # vertices in input '
     .         //            'file # but ran out of data after reading '
     .         //            '# lines of vertex data.'                 )
               CALL ERRINT ( '#', NV                                   )
               CALL ERRCH  ( '#', INFILE                               )
               CALL ERRINT ( '#', I                                    )
               CALL SIGERR ( 'SPICE(FILETRUNCATED)'                    )
               CALL CHKOUT ( 'RDFFPL'                                  )
               RETURN

            END IF

C
C           Parse the input line; we expect it to contain the
C           components of the Ith vertex.
C
            CALL LPARSM ( ILINE, ' ,', 3, NTOK, TOKENS )

            IF ( NTOK .NE. 3 ) THEN

               CALL SETMSG ( 'Three vertex components were expected '
     .         //            'on current line of input file. Line was '
     .         //            '#.'                                    )
               CALL ERRCH  ( '#', ILINE                              )
               CALL SIGERR ( 'SPICE(UNRECOGNIZEDFORMAT)'             )
               CALL CHKOUT ( 'RDFFPL'                                )
               RETURN

            END IF

            CALL PRSDP ( TOKENS(1), VRTCES(1,I) )
            CALL PRSDP ( TOKENS(2), VRTCES(2,I) )
            CALL PRSDP ( TOKENS(3), VRTCES(3,I) )

            IF ( FAILED() ) THEN
               CALL CHKOUT( 'RDFFPL' )
               RETURN
            END IF

         END DO

C
C        Read the plate indices. Discard the first
C        and every second non-blank line of plate data; these
C        lines all contain the same vertex count (3).
C
         J = 0

         DO I = 1,  2 * NP

            CALL RDNBL ( INFILE, ILINE, EOF )

            IF ( FAILED() ) THEN
               CALL CHKOUT ( 'RDFFPL' )
               RETURN
            END IF

            IF ( EOF ) THEN

               CALL SETMSG ( 'Expected to find # plates in input '
     .         //            'file # but ran out of data after reading '
     .         //            '# lines of plate data.'                  )
               CALL ERRINT ( '#', NP                                   )
               CALL ERRCH  ( '#', INFILE                               )
               CALL ERRINT ( '#', I                                    )
               CALL SIGERR ( 'SPICE(FILETRUNCATED)'                    )
               CALL CHKOUT ( 'RDFFPL'                                  )
               RETURN

            END IF

            IF ( EVEN(I) ) THEN
C
C              This line should contain the components of the Jth plate.
C
               J = J + 1

C
C              Parse the current line and store the plate components.
C
               CALL LPARSM ( ILINE, ' ,', 3, NTOK, TOKENS )

               IF ( NTOK .NE. 3 ) THEN

                  CALL SETMSG ( 'Three plate components were expected '
     .            //            'on current line of input file. Line '
     .            //            'was #.'                              )
                  CALL ERRCH  ( '#', ILINE                            )
                  CALL SIGERR ( 'SPICE(UNRECOGNIZEDFORMAT)'           )
                  CALL CHKOUT ( 'RDFFPL'                              )
                  RETURN

               END IF

               CALL PRSINT ( TOKENS(1), PLATES(1,J) )
               CALL PRSINT ( TOKENS(2), PLATES(2,J) )
               CALL PRSINT ( TOKENS(3), PLATES(3,J) )

               IF ( FAILED() ) THEN
                  CALL CHKOUT( 'RDFFPL' )
                  RETURN
               END IF

            END IF

         END DO

      ELSE

         CALL SETMSG ( 'Unkown plate data type: #.' )
         CALL ERRINT( '#', PLTTYP                   )
         CALL SIGERR ( 'SPICE(BADDATATYPE)'         )
         CALL CHKOUT ( 'RDFFPL'                     )
         RETURN

      END IF

      CALL TOSTDO ( '...Done reading plate model input file.' )
      CALL TOSTDO ( ' ' )

      CALL CHKOUT ( 'RDFFPL' )

      RETURN
      END