C Copyright(C) 1999-2020 National Technology & Engineering Solutions
C of Sandia, LLC (NTESS).  Under the terms of Contract DE-NA0003525 with
C NTESS, the U.S. Government retains certain rights in this software.
C
C See packages/seacas/LICENSE for details

C=======================================================================
      SUBROUTINE RDINPT (TIMES,IDA,IDB,MP,SEABMP,IMP,MBLK)

C     ******************************************************************

C     SUBROUTINE TO READ, CHECK AND PRINT INPUT DATA FROM STD-INPUT
C     BATCH TYPE EXECUTION IS ACCOMPLISHEDBY PIPING INPUT DATA
C     FROM A TEXT FILE; NORMALLY INPUT READ INTERACTIVELY.
C     INPUT IS READ UNDER A FREE FIELD FORMAT IN SUBROUTINE FREFLD

C     SUBROUTINE FREFLD IS PART OF THE EXTERNAL "SUPES"
C     LIBRARY (SAND86-0911)

C     Calls subroutines BANNR2, ERROR

C     Called by MAPVAR

C     ******************************************************************

      include 'exodusII.inc'
      CHARACTER*10 CVAL

      include 'amesh.blk'
      include 'bmesh.blk'
      include 'contrl.blk'
      include 'ex2tp.blk'
      include 'rundat.blk'
      include 'schdat.blk'
      include 'steps.blk'
      include 'tapes.blk'
      include 'debg.blk'
      include 'inival.blk'

      DIMENSION KVALUE(8),CVAL(8),IVALUE(8),RVALUE(8)
      DIMENSION TIMES(*),IDA(*),IDB(*),MP(3,*)
C search box size per map
      DIMENSION SEABMP(*)

C     ******************************************************************
      MFIELD = 8

C     PRINT RUN-TIME DATA

      WRITE (NOUT, 1000)
      WRITE (NTPOUT, 1000)
      CALL BANNR2 (84,QAINFO(1),NOUT)
      CALL BANNR2 (84,QAINFO(1),NTPOUT)
      WRITE (NOUT, 1010)
      WRITE (NTPOUT, 1010)
      WRITE (NOUT, 1020) QAINFO(3)
      WRITE (NTPOUT, 1020) QAINFO(3)
      WRITE (NOUT, 1030) QAINFO(5)
      WRITE (NTPOUT, 1030) QAINFO(5)
      WRITE (NOUT, 1040) QAINFO(6)
      WRITE (NTPOUT, 1040) QAINFO(6)
      WRITE (NOUT, 1050)
      WRITE (NTPOUT, 1050)

C default map

      CALL EXGEBI(NTP2EX,IDA,IERR)
      CALL EXGEBI(NTP3EX,IDB,IERR)
      IMP = 0
      IMP2 = 0
      DO 2 I = 1, NBLKSB
        DO 3 J = 1, NBLKSA
          IF (IDB(I) .EQ. IDA(J))THEN
            IMP = IMP + 1
            MP(1,IMP) = IDA(J)
            MP(2,IMP) = IDB(I)
            MP(3,IMP) = ISCHEM
            SEABMP(IMP) = -1.0
            GO TO 2
          END IF
    3   CONTINUE
    2 CONTINUE

      NUMTIM = EXINQI (NTP2EX,EXTIMS)
      CALL EXGATM (NTP2EX,TIMES,IERR)
      OUTTIM = -1.
      ISTEP = NUMTIM
      RTIME = TIMES(NUMTIM)
    4 CONTINUE
      WRITE (NOUT, 1060)
      WRITE (NOUT, 1061)

    5 CONTINUE
      CALL FREFLD (0,0,'CMD >',MFIELD,IOSTAT,NFIELD,KVALUE,CVAL,
     1IVALUE,RVALUE)

      if (iostat .ne. 0) go to 100
      if (nfield .eq. 0) go to 5
      IF (KVALUE(1)      .NE. 0)     GO TO 10
      if (cval(1)(1:1) .EQ. '#') go to 5
      if (cval(1)(1:1) .EQ. '$') go to 5
      IF (CVAL(1)(1:3) .EQ. 'HEL') GO TO 20
      IF (CVAL(1)(1:3) .EQ. 'TIM') GO TO 30
      IF (CVAL(1)(1:3) .EQ. 'STE') GO TO 35
      IF (CVAL(1)(1:3) .EQ. 'OUT') GO TO 39
      IF (CVAL(1)(1:3) .EQ. 'LIS') GO TO 40
      IF (CVAL(1)(1:3) .EQ. 'SCH') GO TO 50
      IF (CVAL(1)(1:3) .EQ. 'SEA') GO TO 60
      IF (CVAL(1)(1:3) .EQ. 'INI') GO TO 65
      IF (CVAL(1)(1:3) .EQ. 'DEF') GO TO 70
      IF (CVAL(1)(1:3) .EQ. 'DEB') GO TO 75
      IF (CVAL(1)(1:3) .EQ. 'MAP') GO TO 80
      IF (CVAL(1)(1:3) .EQ. 'CHE') GO TO 89

      IF (CVAL(1)(1:3) .EQ. 'STO') GO TO 90
      IF (CVAL(1)(1:3) .EQ. 'QUI') GO TO 90
      IF (CVAL(1)(1:3) .EQ. 'END') GO TO 100
      IF (CVAL(1)(1:3) .EQ. 'EXI') GO TO 100
      IF (CVAL(1)(1:3) .EQ. 'RUN') GO TO 100

   10 CONTINUE

C Bad input

      WRITE (NOUT,1100) CVAL(1)
      WRITE (NTPOUT,1100) CVAL(1)
      GO TO 5

   20 CONTINUE

C Help

      IF (NFIELD .EQ. 1)THEN
        GO TO 4
      ELSE IF (CVAL(2)(1:3) .EQ. 'TIM') THEN
        WRITE(NOUT,2000)
        GO TO 5
      ELSE IF (CVAL(2)(1:3) .EQ. 'LIS') THEN
        WRITE(NOUT,2010)
        GO TO 5
      ELSE IF (CVAL(2)(1:3) .EQ. 'SCH') THEN
        WRITE(NOUT,2020)
        GO TO 5
      ELSE IF (CVAL(2)(1:3) .EQ. 'DEF')THEN
        WRITE(NOUT,2030)
        WRITE(NOUT,2040)
        WRITE(NOUT,2045)
        GO TO 5
      ELSE IF (CVAL(2)(1:3) .EQ. 'SEA')THEN
        WRITE(NOUT,2050)
        GO TO 5
      ELSE IF (CVAL(2)(1:3) .EQ. 'MAP')THEN
        WRITE(NOUT,2060)
        GO TO 5
      ELSE IF (CVAL(2)(1:3) .EQ. 'CHE')THEN
        WRITE(NOUT,2070)
        GO TO 5
      END IF

   30 CONTINUE

C Time

      IF (KVALUE(2) .NE. 1 .AND. KVALUE(2) .NE. 2)THEN
        IF(CVAL(2)(1:3) .EQ. 'ALL')THEN
          ISTEP = -1
          IDEF = 0
          WRITE(NOUT,3000)
          GO TO 40
        ELSE
          WRITE(NOUT,3010)CVAL(2)
          GO TO 5
        END IF
      ELSE

C convert time to closest time step

        RTIME = RVALUE(2)
        ISTEP = NUMTIM
        DO 32 I = 1, NUMTIM - 1
          TMID = (TIMES(I) + TIMES(I + 1)) / 2.
          IF(TMID .GT. RTIME) THEN
            ISTEP = I
            GO TO 33
          END IF
   32   CONTINUE
   33   WRITE(NOUT,3020)RTIME,TIMES(ISTEP),ISTEP
        GO TO 5
      END IF

   35 CONTINUE

C Step

      IF (KVALUE(2) .NE. 1 .AND. KVALUE(2) .NE. 2)THEN
        IF(CVAL(2)(1:3) .EQ. 'ALL')THEN
          ISTEP = -1
          IDEF = 0
          WRITE(NOUT,3005)
          GO TO 40
        ELSE
          WRITE(NOUT,3015)CVAL(2)
          GO TO 5
        END IF
      ELSE
        ISTEP = IVALUE(2)
        WRITE(NOUT,3025)ISTEP,TIMES(ISTEP)
        GO TO 5
      END IF

   39 CONTINUE

C output time

      IF (ISTEP .EQ. -1)THEN
        WRITE(NOUT,3040)
        GO TO 5
      END IF
      IF (KVALUE(2) .EQ. 0)THEN
        IF (KVALUE(3) .EQ. 1 .OR. KVALUE(3) .EQ. 2)THEN
          OUTTIM = RVALUE(3)
        END IF
      ELSE IF (KVALUE(2) .EQ. 1 .OR. KVALUE(2) .EQ. 2)THEN
        OUTTIM = RVALUE(2)
      ELSE
        WRITE(NOUT,3030)CVAL(2),CVAL(3)
      END IF
      GO TO 5

   40 CONTINUE

C List times

      WRITE (NOUT,4000)
      WRITE (NOUT,4010)(TIMES(I),I=1,NUMTIM)
      GO TO 5

   50 CONTINUE

C Scheme

      IF (KVALUE(2) .NE. 2)THEN
        WRITE(NOUT,5000)CVAL(2)
        GO TO 5
      END IF
      ISCHEM = IVALUE(2)
      DO 55 I = 1, IMP
        MP(3,I) = ISCHEM
   55 CONTINUE
      IF (ISCHEM .EQ. 0)THEN
        WRITE(NOUT,5010)ISCHEM
      ELSE IF (ISCHEM .EQ. 1)THEN
        WRITE(NOUT,5020)ISCHEM
      ELSE IF (ISCHEM .EQ. 2)THEN
        WRITE(NOUT,5030)ISCHEM
      ELSE IF (ISCHEM .EQ. 3)THEN
        WRITE(NOUT,5035)ISCHEM
      ELSE
        WRITE(NOUT,5040)ISCHEM
      END IF
      GO TO 5

   60 CONTINUE

C Searchbox (tolerance)
C Searchbox toler_shell, toler_quad, toler_hex, toler_tet

      if (nfield .eq. 2) then
        IF (KVALUE(2) .EQ. 1 .OR. KVALUE(2) .EQ. 2) THEN
          TOLSHL = RVALUE(2)
          TOLTET = RVALUE(2)
          TOLQAD = RVALUE(2)
          TOLHEX = RVALUE(2)
          if (tolshl .ge. 1.0) then
             WRITE(NOUT,6000) TOLSHL
             WRITE(NTPOUT,6000) TOLSHL
          else
             WRITE(NOUT,6001)'Overall', TOLSHL
             WRITE(NTPOUT,6001)'Overall', TOLSHL
          end if

        ELSE
          WRITE(NOUT,6010)CVAL(2)
        END IF
        GO TO 5

      else if (nfield .eq. 3) then
        IF (KVALUE(3) .NE. 1 .AND. KVALUE(3) .NE. 2) THEN
          WRITE(NOUT,6011) CVAL(2), 3, CVAL(3)
          go to 5
        end if

        if (CVAL(2)(:1) .eq. 'H' .or. CVAL(2)(:1) .eq. 'h') THEN
          TOLHEX = RVALUE(3)
          WRITE(NOUT,6001) CVAL(2), TOLHEX
          WRITE(NTPOUT,6001) CVAL(2), TOLHEX

        else if (CVAL(2)(:1) .eq. 'S' .or. CVAL(2)(:1) .eq. 's') THEN
          TOLSHL = RVALUE(3)
          WRITE(NOUT,6001) CVAL(2), TOLSHL
          WRITE(NTPOUT,6001) CVAL(2), TOLSHL

        else if (CVAL(2)(:1) .eq. 'T' .or. CVAL(2)(:1) .eq. 't') THEN
          TOLTET = RVALUE(3)
          WRITE(NOUT,6001) CVAL(2), TOLTET
          WRITE(NTPOUT,6001) CVAL(2), TOLTET

        else if (CVAL(2)(:1) .eq. 'Q' .or. CVAL(2)(:1) .eq. 'q') THEN
          TOLQAD = RVALUE(3)
          WRITE(NOUT,6001) CVAL(2), TOLQAD
          WRITE(NTPOUT,6001) CVAL(2), TOLQAD

        end if
        GO TO 5
      end if

 65   CONTINUE

C Initial Value (value)

      IF (KVALUE(3) .EQ. 1 .OR. KVALUE(3) .EQ. 2) THEN
        VALINI = RVALUE(3)
        WRITE(NOUT,6501) VALINI
        WRITE(NTPOUT,6501) VALINI
      ELSE
        WRITE(NOUT,6510) CVAL(3)
      END IF
      GO TO 5

   70 CONTINUE

C Deformed vs undeformed processing

      IF (KVALUE(2) .NE. 2)THEN
        WRITE(NOUT,7000)CVAL(2)
        GO TO 5
      END IF
      IDEF = IVALUE(2)
      IF (IDEF .EQ. 0)THEN
        WRITE(NOUT,7010)idef
      ELSE IF (IDEF .EQ. 1 .OR. IDEF .EQ. 2)THEN
        IF (ISTEP .EQ. -1)THEN
          WRITE(NOUT,7020)idef
          IDEF = 0
        END IF
        IF (IDEF .EQ. 1)THEN
          WRITE(NOUT,7030)idef
        ELSE IF (IDEF .EQ. 2) THEN
          WRITE(NOUT,7035)idef
        END IF
      ELSE
        WRITE(NOUT,7040)idef
      END IF
      GO TO 5

 75   CONTINUE

C Debug output

      IF (KVALUE(2) .NE. 2)THEN
        WRITE(NOUT,7005)CVAL(2)
        GO TO 5
      END IF
      IDEBUG = IVALUE(2)
      WRITE(NOUT,7006) IDEBUG
      WRITE(NTPOUT,7006) IDEBUG
      GO TO 5

   80 CONTINUE

C Map definition - donor mesh e-block to recipient mesh e-block

      if (nfield .eq. 2 .and. cval(2)(1:3) .eq. 'RES') then
C ... Reset to no block mappings.
         IMP  = 0
         IMP2 = 0
         write(nout,8000)
         go to 5
      end if

C save global scheme value
      ISCHEC = ISCHEM
      IF (KVALUE(2) .EQ. 0 .AND. CVAL(2) .EQ. 'ALL')THEN
        IF (CVAL(3) .NE. 'TO')THEN
          WRITE(NOUT,8010)
          WRITE(NTPOUT,8010)
          GO TO 5
        END IF
        IF (KVALUE(4) .NE. 1 .AND. KVALUE(4) .NE. 2)THEN
          WRITE(NOUT,8020)CVAL(4)
          WRITE(NTPOUT,8020)CVAL(4)
          GO TO 5
        END IF
        IF (KVALUE(5) .EQ. 0 .AND. CVAL(5)(1:3) .EQ. 'SCH' .AND.
     &      (KVALUE(6) .EQ. 1 .OR. KVALUE(6) .EQ. 2))THEN
          IF (IVALUE(6) .GE. 0 .AND. IVALUE(6) .LE. 3) THEN
            ISCHEM = IVALUE(6)
          END IF
        END IF
        IF (KVALUE(7) .EQ. 0 .AND. CVAL(7)(1:3) .EQ. 'SCH' .AND.
     &      (KVALUE(8) .EQ. 1 .OR. KVALUE(8) .EQ. 2))THEN
          IF (IVALUE(8) .GE. 0 .AND. IVALUE(8) .LE. 3) THEN
            ISCHEM = IVALUE(8)
          END IF
        END IF
C process input for search box size for this map
        SEABOX = -1.0
        IF ( ( KVALUE( 5) .EQ. 0) .AND.
     &       ( CVAL( 5)(1:3) .EQ. 'SEA')) THEN
          IF ( KVALUE( 6) .EQ. 1) THEN
            SEABOX = RVALUE( 6)
          ELSE IF ( KVALUE( 6) .EQ. 2) THEN
            SEABOX = IVALUE( 6)
          END IF
        END IF
        IF ( ( KVALUE( 7) .EQ. 0) .AND.
     &       ( CVAL( 7)(1:3) .EQ. 'SEA')) THEN
          IF ( KVALUE( 8) .EQ. 1) THEN
            SEABOX = RVALUE( 8)
          ELSE IF ( KVALUE( 8) .EQ. 2) THEN
            SEABOX = IVALUE( 8)
          END IF
        END IF
C ... Check for valid id
        ID = IVALUE(4)
        idl = locint(id, nblksb, idb)
        if (idl .eq. 0) then
          write (nout, 8090) id
          ISCHEM = ISCHEC
          go to 5
        end if
        DO 82 I = 1, NBLKSA
          MP(1,I+IMP2) = IDA(I)
          MP(2,I+IMP2) = IVALUE(4)
          MP(3,I+IMP2) = ISCHEM
          SEABMP(I+IMP2) = SEABOX
 82   CONTINUE
        IMP2 = IMP2 + NBLKSA
        IMP = IMP2
        WRITE(NOUT,8040)
        call pmap(imp, mp, seabmp, nout)
C restore global scheme value
        ISCHEM = ISCHEC
        GO TO 5
      ELSE IF (KVALUE(4) .EQ. 0 .AND. CVAL(4) .EQ. 'ALL')THEN
        IF (CVAL(3) .NE. 'TO')THEN
          WRITE(NOUT,8010)
          WRITE(NTPOUT,8010)
          GO TO 5
        END IF
        IF (KVALUE(2) .NE. 1 .AND. KVALUE(2) .NE. 2)THEN
          WRITE(NOUT,8030)CVAL(2)
          WRITE(NTPOUT,8030)CVAL(2)
          GO TO 5
        END IF
        IF (KVALUE(5) .EQ. 0 .AND. CVAL(5)(1:3) .EQ. 'SCH' .AND.
     &      (KVALUE(6) .EQ. 1 .OR. KVALUE(6) .EQ. 2))THEN
          IF (IVALUE(6) .GE. 0 .AND. IVALUE(6) .LE. 3) THEN
            ISCHEM = IVALUE(6)
          END IF
        END IF

        IF (KVALUE(7) .EQ. 0 .AND. CVAL(7)(1:3) .EQ. 'SCH' .AND.
     &      (KVALUE(8) .EQ. 1 .OR. KVALUE(8) .EQ. 2))THEN
          IF (IVALUE(8) .GE. 0 .AND. IVALUE(8) .LE. 3) THEN
            ISCHEM = IVALUE(8)
          END IF
        END IF
C process input for search box size for this map
        SEABOX = -1.0
        IF ( ( KVALUE( 5) .EQ. 0) .AND.
     &       ( CVAL( 5)(1:3) .EQ. 'SEA')) THEN
          IF ( KVALUE( 6) .EQ. 1) THEN
            SEABOX = RVALUE( 6)
          ELSE IF ( KVALUE( 6) .EQ. 2) THEN
            SEABOX = IVALUE( 6)
          END IF
        END IF
        IF ( ( KVALUE( 7) .EQ. 0) .AND.
     &       ( CVAL( 7)(1:3) .EQ. 'SEA')) THEN
          IF ( KVALUE( 8) .EQ. 1) THEN
            SEABOX = RVALUE( 8)
          ELSE IF ( KVALUE( 8) .EQ. 2) THEN
            SEABOX = IVALUE( 8)
          END IF
        END IF

C ... Check for valid id
        ID = IVALUE(2)
        idl = locint(id, nblksa, ida)
        if (idl .eq. 0) then
          write (nout, 8090) id
          ischem = ischec
          go to 5
        end if

        DO 84 I = 1, NBLKSB
          MP(2,I+IMP2) = IDB(I)
          MP(1,I+IMP2) = IVALUE(2)
          MP(3,I+IMP2) = ISCHEM
          SEABMP(I+IMP2) = SEABOX
   84   CONTINUE
        IMP2 = IMP2 + NBLKSB
        IMP = IMP2
        WRITE(NOUT,8040)
        call pmap(imp, mp, seabmp, nout)
        ISCHEM = ISCHEC
        GO TO 5
      ELSE IF (KVALUE(2) .EQ. 1 .OR. KVALUE(2) .EQ. 2 .AND.
     &         KVALUE(4) .EQ. 1 .OR. KVALUE(4) .EQ. 2)THEN
        IF (CVAL(3) .NE. 'TO')THEN
          WRITE(NOUT,8010)
          WRITE(NTPOUT,8010)
          GO TO 5
        END IF
        IF (KVALUE(5) .EQ. 0 .AND. CVAL(5)(1:3) .EQ. 'SCH' .AND.
     &      (KVALUE(6) .EQ. 1 .OR. KVALUE(6) .EQ. 2))THEN
          IF (IVALUE(6) .GE. 0 .AND. IVALUE(6) .LE. 3) THEN
            ISCHEM = IVALUE(6)
          END IF
        END IF
        IF (KVALUE(7) .EQ. 0 .AND. CVAL(7)(1:3) .EQ. 'SCH' .AND.
     &      (KVALUE(8) .EQ. 1 .OR. KVALUE(8) .EQ. 2))THEN
          IF (IVALUE(8) .GE. 0 .AND. IVALUE(8) .LE. 3) THEN
            ISCHEM = IVALUE(8)
          END IF
        END IF
C process input for search box size for this map
        SEABOX = -1.0
        IF ( ( KVALUE( 5) .EQ. 0) .AND.
     &       ( CVAL( 5)(1:3) .EQ. 'SEA')) THEN
          IF ( KVALUE( 6) .EQ. 1) THEN
            SEABOX = RVALUE( 6)
          ELSE IF ( KVALUE( 6) .EQ. 2) THEN
            SEABOX = IVALUE( 6)
          END IF
        END IF
        IF ( ( KVALUE( 7) .EQ. 0) .AND.
     &       ( CVAL( 7)(1:3) .EQ. 'SEA')) THEN
          IF ( KVALUE( 8) .EQ. 1) THEN
            SEABOX = RVALUE( 8)
          ELSE IF ( KVALUE( 8) .EQ. 2) THEN
            SEABOX = IVALUE( 8)
          END IF
        END IF
C ... Check for valid ids
        ID = IVALUE(2)
        idl = locint(id, nblksa, ida)
        if (idl .eq. 0) then
          write (nout, 8090) id
          ischem = ischec
          go to 5
        end if

        ID = IVALUE(4)
        idl = locint(id, nblksb, idb)
        if (idl .eq. 0) then
          write (nout, 8090) id
          ischem = ischec
          go to 5
        end if

        IMP2 = IMP2 + 1
        if (imp2 .gt. mblk) then
           CALL ERROR('RDINPT','Too many block mappings entered',
     $          'Entered', imp2,'Maximum',mblk,' ',' ',1)
        end if
        IMP = IMP2
        MP(1,IMP2) = IVALUE(2)
        MP(2,IMP2) = IVALUE(4)
        MP(3,IMP2) = ISCHEM
        SEABMP(IMP2) = SEABOX
        WRITE(NOUT,8040)
        call pmap(imp, mp, seabmp, nout)
        WRITE(NOUT,8070)
        DO 88 I = 1, NBLKSB
          WRITE(NOUT,8080)IDB(I)
   88   CONTINUE
        ischem = ischec
        GO TO 5
      ELSE
        WRITE(NOUT,8060)CVAL(2)
        WRITE(NTPOUT,8060)CVAL(2)
        GO TO 5
      END IF

   89 CONTINUE

C Read integer flag for accuracy checks (comparison of
C various quantities between donor and recipient meshes

      IF (KVALUE(2) .NE. 2) THEN
        WRITE (NOUT,8900)CVAL(2)
        WRITE (NTPOUT,8900)CVAL(2)
        GO TO 5
      END IF
      IACCU = IVALUE(2)
      IF (IACCU .EQ. 0)THEN
        WRITE(NOUT,8910)IACCU
        WRITE(NTPOUT,8910)IACCU
      ELSE IF (IACCU .EQ. 1)THEN
        WRITE(NOUT,8920)IACCU
        WRITE(NTPOUT,8920)IACCU
      ELSE
        WRITE(NOUT,8930)IACCU
        WRITE(NTPOUT,8930)IACCU
      END IF
      GO TO 5

   90 CONTINUE

C Stop execution

      WRITE(NOUT,9000)
      WRITE(NTPOUT,9000)
      CALL ERROR('RDINPT','YOU ELECTED TO TERMINATE THE PROGRAM',' ',
     &           0,' ',0,' ',' ',1)

  100 CONTINUE

C Continue execution (run)

C sort map array (MP) on second entry (recipient mesh element block)
C this is required because of way mapping of multiple donor mesh
C element blocks into one recipient mesh element blocks is
C implemented (required to have all such maps located sequentially)
C a simple sort on the 2nd entry accomplishes this and is easier
C than rewriting the offending algorithm

      IBOTOM = IMP - 1
 110  ISWICH = 1
      DO 120 I = 1, IBOTOM
        IF (MP(2,I) .LE. MP(2,I+1))THEN
          GO TO 120
        ELSE
          ITEMP = MP(1,I)
          MP(1,I) = MP(1,I+1)
          MP(1,I+1) = ITEMP
          ITEMP = MP(2,I)
          MP(2,I) = MP(2,I+1)
          MP(2,I+1) = ITEMP
          ITEMP = MP(3,I)
          MP(3,I) = MP(3,I+1)
          MP(3,I+1) = ITEMP
          RTEMP = SEABMP(I)
          SEABMP(I) = SEABMP(I+1)
          SEABMP(I+1) = RTEMP
          ISWICH = I
          GO TO 120
        END IF
  120 CONTINUE
      IF (ISWICH .EQ. 1)THEN
        GO TO 130
      ELSE
        IBOTOM = ISWICH - 1
        GO TO 110
      END IF
  130 CONTINUE

C end sort

      WRITE(NOUT,10000)
      WRITE(NTPOUT,10000)
      IF (ISTEP .EQ. -1) THEN
        WRITE(NOUT,10010)
        WRITE(NTPOUT,10010)
      ELSE
        WRITE(NOUT,10020)RTIME,TIMES(ISTEP),ISTEP
        WRITE(NTPOUT,10020)RTIME,TIMES(ISTEP),ISTEP
      END IF
      IF (IDEF .EQ. 0)THEN
        WRITE(NOUT,7010)idef
        WRITE(NTPOUT,7010)idef
      ELSE IF (IDEF .EQ. 1)THEN
        WRITE(NOUT,7030)idef
        WRITE(NTPOUT,7030)idef
      ELSE IF (IDEF .EQ. 2) THEN
        WRITE(NOUT,7035)idef
        WRITE(NTPOUT,7035)idef
      END IF
      IF (ISCHEM .EQ. 0)THEN
         WRITE(NOUT,5010)ISCHEM
         WRITE(NTPOUT,5010)ISCHEM
      ELSE IF (ISCHEM .EQ. 2)THEN
         WRITE(NOUT,5030)ISCHEM
         WRITE(NTPOUT,5030)ISCHEM
      ELSE IF (ISCHEM .EQ. 3)THEN
         WRITE(NOUT,5035)ISCHEM
         WRITE(NTPOUT,5035)ISCHEM
      ELSE
         WRITE(NOUT,5020)ISCHEM
         WRITE(NTPOUT,5020)ISCHEM
      END IF
      WRITE(NOUT,10030)
      WRITE(NTPOUT,10030)
      call pmap(imp, mp, seabmp, nout)
      call pmap(imp, mp, seabmp, ntpout)
      RETURN
 1000 FORMAT ('1',/////)
 1010 FORMAT (//,5X,'***************************************************
     1********',//)
 1020 FORMAT (5X,'VERSION -- ',A32,//)
 1030 FORMAT (5X,'DATE OF EXECUTION -- ',A32,//)
 1040 FORMAT (5X,'TIME OF EXECUTION -- ',A32,//)
 1050 FORMAT (2X,'READING INPUT DATA' ,//)
 1060 FORMAT (5X,'MAPVAR INPUT - SYNTAX:',/,' KEY_WORD <value>',//,
     1' HELp                  - REPEATS THIS MESSAGE',/,
     2' HELp <key_word>       - DESCRIPTION OF COMMAND - key_word',/,
     3' SCHeme <int>          - MAPPING SCHEME TO USE',/,
     4' DEFormed <int>        - ORIGINAL OR DEFORMED GEOMETRY',/,
     5' LISt TIMes            - WRITES A LIST OF TIMES AVAILABLE',/,
     6' TIMes <real or ALL>   - TIME TO BE MAPPED',/,
     7' STEp <int or ALL>     - TIME STEP TO BE MAPPED',/,
     8' OUTput TIMe <real>    - TIME TO BE WRITTEN TO OUTPUT FILE',/,
     9' SEArchbox <real>      - SEARCH BOX TO BE USED')
 1061 FORMAT (
     *' MAP <int or ALL> TO <int or ALL>',/,
     1  ' MAP <int or ALL> TO <int or ALL> SCHeme <int>',/,
     *  ' MAP <int or ALL> TO <int or ALL> SEArchbox <real>',/,
     *' MAP <int or ALL> TO <int or ALL> SCHeme <int>',
     *' SEArchbox <real>',/,
     *' MAP <int or ALL> TO <int or ALL> SEArchbox <real>',
     *' SCHeme <int>',/,
     *' DEBUG 0,1,2,3         - CONTROL DEBUG OUTPUT',/,
     *' INITIAL VALUE <real>  - SPECIFY VALUE USED TO INIT VARS',/,
     2'                       - ELEMENT BLOCK MAPPING ',/,
     3' CHEck <int>           - CHECK ACCURACY OF MAPPING',/,
     3' RUN                   - END INPUT - RESUME PROGRAM',/,
     3' QUIT                  - TERMINATES THE PROGRAM',/,
     4' STOP                  - TERMINATES THE PROGRAM')

 1100 FORMAT(5X,'UNKNOWN INPUT - READING',A20,/,
     1'          PLEASE TRY AGAIN')

 2000 FORMAT(5X,'TIMe <real or ALL>',//,
     1'          IF A REAL NUMBER VALUE IS ENTERED, IT REPRESENTS',/,
     2'          THE TIME (STEP) SELECTED AT WHICH VARIABLES WILL',/,
     3'          BE MAPPED FROM THE DONOR TO THE RECIPIENT MESH',/,
     4'          DEFAULT - the last time step in restart file',/,
     5'          IF *ALL* IS ENTERED, ALL THE TIME STEPS IN THE',/,
     6'          DONOR MESH WILL BE MAPPED.',/,
     7'          NOTE: ONLY ORIGINAL GEOMETRY MAPPING IS ALLOWED',/,
     8'          *DEFORMED 0*')
 2010 FORMAT(5x,'LISt TIMes',//,
     1'          LIST TIMES COMMAND READS THE DONOR MESH FILE',/,
     2'          AND ECHOS TO THE CRT A LIST OF TIMES AVAILABLE TO',/,
     3'          THE USER.',//,
     4'          DEFAULT - none')
 2020 FORMAT(5x,'SCHeme <int>',//,
     1'          SCHEME COMMAND PICKS THE MAPPING SCHEME TO USE',/,
     2'          SCHEME 0 - NODAL BASED SIMPLE INTERPOLATION',/,
     3'          SCHEME 1 - NODAL BASED LEAST SQUARES',/,
     4'          SCHEME 2 - DIRECT TRANSFER',/,
     5'          SCHEME 3 - ELEMENT CENTROID BASED LEAST SQUARES',/,
     7'          DEFAULT  - 1')
 2030 FORMAT(5X,'DEFormed <int>',//,
     1'          THE DEFORMED COMMAND SELECTS USE OF ORIGINAL OR',/,
     2'          DEFORMED GEOMETRY',/,
     3'          DEFORMED 0 - ORIGINAL GEOMETRY - COORDINATES ARE',/,
     4'                       NOT MODIFIED BY DISPLACEMENTS',/,
     5'                       RECIPIENT MESH BOUNDARIES IDENTICAL',/,
     6'                       TO UNDEFORMED DONOR MESH BOUNDARIES')
 2040 FORMAT(10X,'DEFORMED 1 - DEFORMED GEOMETRY - DISPLACEMENTS ARE',/,
     1'                       ADDED TO DONOR MESH COORDINATES PRIOR',/,
     2'                       TO USE AND THE MAPPED DISPLACEMENTS',/,
     3'                       ARE SUBTRACTED FROM RECIPIENT MESH',/,
     4'                       COORDINATES PRIOR TO OUTPUT',/,
     5'                       RECIPIENT MESH BOUNDARIES IDENTICAL',/,
     6'                       TO DEFORMED DONOR MESH BOUNDARIES')
 2045 FORMAT(10X,'DEFORMED 2 - MESH ANNEALING - MAP IS PERFORMED IN',/,
     1'                       DEFORMED COORDINATES (DISPLACEMENTS',/,
     2'                       ARE ADDED TO DONOR MESH COORDINATES',/,
     3'                       PRIOR TO USE. OUTPUT DISPLACEMENTS',/,
     4'                       ARE SET TO ZERO.',/,
     5'                       THIS OPTION WAS REQUESTED FOR GOMA',/,
     6'          DEFAULT - 1')
 2050 FORMAT(10X,'SEArchbox <REAL>',/,
     *'           SEArchbox SHELL <REAL>',/,
     *'           SEArchbox HEX   <REAL>',/,
     *'           SEArchbox QUAD  <REAL>',/,
     *'           SEArchbox TET   <REAL>',//,
     1'           THE SEARCHBOX IS A BOUNDING BOX AROUND THE DONOR',/,
     2'           MESH ELEMENT OR GROUP OF ELEMENTS IN WHICH THE',/,
     3'           SEARCH ROUTINE ATTEMPTS TO FIND A POINT',/,
     4'           (RECIPIENT MESH NODE OR ELEMENT CENTROID).',/,
     5'           THE SEARCH BOX CAN BE INCREASED MODESTLY',/,
     5'           TO OVERCOME MESHING ISSUES - AS DIFFERENT',/,
     6'           DISCRETIZATION ON A RADIUS.',/,
     7'           BE GENTLE - INCREASE CAN HAVE A LARGE EFFECT ON',/,
     8'           RUN TIMES. GREATER THAN 1.0 IS NOT RECOMMENDED.',/,
     9'           DEFAULT = 0.01')
 2060 FORMAT(10X,'MAP <int or ALL> TO <int or ALL>',/,
     1 '          MAP <int or ALL> TO <int or ALL> SCHeme <int>',/,
     2 '          MAP <int or ALL> TO <int or ALL> SEArchbox <real>',/,
     4 '          MAP <int or ALL> TO <int or ALL> SCHeme <int>',
     *' SEArchbox <real>',/,
     5 '          MAP <int or ALL> TO <int or ALL> SEArchbox ',
     *'<real> SCHeme <int>',//,
     6'           THE MAP COMMAND ALLOWS THE USER TO DEFINE THE',/,
     7'           DONOR MESH ELEMENT BLOCK I.D. TO BE MAPPED INTO',/,
     8'           THE RECIPIENT MESH ELEMENT BLOCK I.D. ALONG WITH',/,
     9'           THE SCHEME AND SEARCHBOX TO USE FOR THIS MAPPING.',/,
     *'           IF THE VALUE "ALL" IS ENTERED THE OTHER BLOCK I.D.',/,
     *'           FIELD MUST CONTAIN AN INTEGER. THE SCHEME AND',/,
     *'           SEARCHBOX VALUES ARE OPTIONAL. SPECIFYING',/,
     *'           SEARCHBOX > 0 WILL OVERRIDE THE GLOBAL SEARCHBOX',/,
     *'           SETTING FOR THIS MAP ONLY.',/,
     *'           DEFAULT:',/,
     *'           1 TO 1   2 TO 2   ETC',/,
     *'           DEFAULT SCHEME value entered with SCH command or 1',/,
     *'           DEFAULT SEARCHBOX is no override of global setting',/,
     *'           global SEARCHBOX setting is default 0.01 or value',/,
     *'                            entered using SEARCHBOX COMMAND')
 2070 FORMAT(10X,'CHEck <int>',//,
     1'           THE CHECK COMMAND COMPUTES QUANTITIES FOR',/,
     2'           COMPARISON BETWEEN THE DONOR AND RECIPIENT',/,
     3'           MESHES',/,
     4'           0 - NO CHECK QUANTITIES COMPUTED',/,
     5'           1 - ALL APPROPRIATE QUANTITIES COMPUTED',/,
     6'           DEFAULT - 0')

 3000 FORMAT(5X,'TIME YOU HAVE ENTERED - TIMES ALL',/,
     1'          ALL THE TIME STEPS WILL BE MAPPED',/,
     2'          ONLY UNDEFORMED GEOMETRY PROCESSING IS',/,
     3'          IMPLEMENTED WITH *TIMES ALL* TIME STEP INPUT',/,
     4'          DEFORMED 0',///)
 3005 FORMAT(5X,'STEP YOU HAVE ENTERED - STEPS ALL',/,
     1'          ALL THE TIME STEPS WILL BE MAPPED',/,
     2'          ONLY UNDEFORMED GEOMETRY PROCESSING IS',/,
     3'          IMPLEMENTED WITH *STEPS ALL* TIME STEP INPUT',/,
     4'          DEFORMED 0',///)
 3010 FORMAT(5X,'READING TIMES COMMAND',/,
     1'          EXPECTED A REAL NUMBER IN FIELD 2',/,
     2'          READ',A20,/,
     3'          PLEASE TRY AGAIN')
 3015 FORMAT(5X,'READING STEP COMMAND',/,
     1'          EXPECTED A REAL NUMBER IN FIELD 2',/,
     2'          READ',A20,/,
     3'          PLEASE TRY AGAIN')
 3020 FORMAT(5X,'TIME YOU HAVE ENTERED',F14.6,/,
     1'          CLOSEST TIME ON DATABASE',F14.6,/,
     2'          TIME STEP',I5,///)
 3025 FORMAT(5X,'STEP YOU HAVE ENTERED',I3,/,
     1'          TIME ',F14.6,///)
 3030 FORMAT(5X,'READING OUTPUT TIME COMMAND',/,
     1'          EXPECTED A REAL NUMBER IN FIELD 2 OR 3',/,
     2'          READ',A20,A20,/,
     3'          PLEASE TRY AGAIN')
 3040 FORMAT(5X,'YOU HAVE ALREADY SELECTED TO PROCESS',/,
     1'          ALL TIME STEPS AVAILABLE. YOU CANNOT ALSO',/,
     2'          CHANGE THE OUTPUT TIME')

 4000 FORMAT(5X,'TIMES AVAILABLE FROM THE RESTART FILE')
 4010 FORMAT(5X,/,E14.6)

 5000 FORMAT(5X,'READING SCHEME COMMAND',/,
     1'          EXPECTED AN INTEGER IN FIELD 2',/,
     2'          READ',A20,/,
     3'          PLEASE TRY AGAIN')
 5010 FORMAT(//,5X,'YOU HAVE ENTERED SCHEME ',I5,/,
     1'          NODAL BASED SIMPLE INTERPOLATION')
 5020 FORMAT(//,5X,'YOU HAVE ENTERED SCHEME ',I5,/,
     1'          NODAL BASED LEAST SQUARES')
 5030 FORMAT(//,5X,'YOU HAVE ENTERED SCHEME ',I5,/,
     1'          DIRECT TRANSFER')
 5035 FORMAT(//,5X,'YOU HAVE ENTERED SCHEME ',I5,/,
     1'          ELEMENT CENTROID BASED LEAST SQUARES')
 5040 FORMAT(5X,'YOU HAVE ENTERED SCHEME ',I5,/,
     1'          THIS SCHEME HAS NOT BEEN IMPLEMENTED',/,
     2'          PLEASE TRY AGAIN')

 6000 FORMAT(//,5X,'YOU HAVE ENTERED SEARCH ',F12.4,/,
     1'          VALUES GREATER THAN 1. ARE NOT RECOMMENDED')
 6001 FORMAT(//,5X,A,' Search Tolerance is ',F12.4)
 6010 FORMAT(5X,'READING SEArch COMMAND',/,
     1'          EXPECTED A REAL NUMBER IN FIELD 2',/,
     2'          READ',A20,/,
     3'          PLEASE TRY AGAIN')
 6011 FORMAT(5X,'READING SEArch ',A,' COMMAND',/,
     1'          EXPECTED A REAL NUMBER IN FIELD ', I1,/,
     2'          READ',A20,/,
     3'          PLEASE TRY AGAIN')
 6501 FORMAT(//,5X,'Initial Value is ',1Pe12.4)
 6510 FORMAT(5X,'READING INItial Value COMMAND',/,
     1'          EXPECTED A REAL NUMBER IN FIELD 3',/,
     2'          READ',A20,/,
     3'          PLEASE TRY AGAIN')

 7000 FORMAT(5X,'READING DEFORMED GEOMETRY COMMAND',/,
     1'          EXPECTED AN INTEGER IN FIELD 2',/,
     2'          READ',A20,/,
     3'          PLEASE TRY AGAIN')
 7005 FORMAT(5X,'READING DEBUG OUTPUT COMMAND',/,
     1'          EXPECTED AN INTEGER IN FIELD 2',/,
     2'          READ',A20,/,
     3'          PLEASE TRY AGAIN')
 7006 FORMAT(//,5X,'YOU HAVE ENTERED - DEBUG',I5,/)
 7010 FORMAT(//,5X,'YOU HAVE ENTERED - DEFORMED',I5,/,
     1'          ORIGINAL GEOMETRY - COORDINATES ARE NOT',/,
     2'          MODIFIED BY DISPLACEMENTS')
 7020 FORMAT(5X,'YOU HAVE ENTERED - DEFORMED',I5,/,
     1'          ONLY ORIGINAL GEOMETRY PROCESSING IS',/,
     2'          COMPATIBLE WITH *TIMES ALL* TIME STEP INPUT',/,
     3'          DEFORMED 0',///)
 7030 FORMAT(//,5X,'YOU HAVE ENTERED - DEFORMED',I5,/,
     1'          DEFORMED GEOMETRY - DISPLACEMENTS ARE',/,
     2'          ADDED TO DONOR MESH COORDINATES AND',/,
     3'          SUBTRACTED FROM RECIPIENT MESH COORDINATES')
 7035 FORMAT(//,5X,'YOU HAVE ENTERED - DEFORMED',I5,/,
     1'          MESH ANNEALING - DISPLACEMENTS ARE',/,
     2'          ADDED TO DONOR MESH COORDINATES.',/,
     3'          DISPLACEMENTS ARE ZERO ON THE INTERPOLATED MESH.')
 7040 FORMAT(//,5X,'YOU HAVE ENTERED - DEFORMED',I5,/,
     1'          value - MUST BE EITHER 0 OR 1',/,
     2'          PLEASE TRY AGAIN')

 8000 FORMAT(5x,'Reset all block mappings.')
 8010 FORMAT(5X,'READING MAP COMMAND',/,
     &'          EXPECTING THE CHARACTER STRING "TO" ',/,
     &'          COMMAND SYNTAX IS:',/,
     &'          MAP <int or "ALL"> TO <int or "ALL">',//,
     &'          PLEASE TRY AGAIN')
 8020 FORMAT(5X,'READING MAP COMMAND',/,
     &'          EXPECTING AN INTEGER AFTER "MAP ALL TO"',/,
     &'          READ',A20,/,
     &'          PLEASE TRY AGAIN')
 8030 FORMAT(5X,'READING MAP COMMAND',/,
     &'          EXPECTING AN INTEGER IN FIELD 2 OF COMMAND',/,
     &'          "MAP ?? TO ALL"',/,
     &'          READ',A20,/,
     &'          PLEASE TRY AGAIN')
 8040 FORMAT(5X,/,'MAP AS ENTERED SO FAR IS:')
 8060 FORMAT(5X,'READING MAP COMMAND',/,
     &'          EXPECTING EITHER AN INTEGER OR THE STRING "ALL"',/,
     &'          READ',A20,/,
     &'          PLEASE TRY AGAIN')
 8070 FORMAT(//,5X,'AVAILABLE RECIPIENT MESH ELEMENT BLOCK I.D.')
 8080 FORMAT(10X,I7)
 8090 FORMAT(//,5x,'ERROR: The entered id ', i5,
     *  ' is not a valid block id.',/)

 8900 FORMAT(5X,'READING CHECK ACCURACY COMMAND',/,
     1'          EXPECTED AN INTEGER IN FIELD 2',/,
     2'          READ',A20,/,
     3'          PLEASE TRY AGAIN')
 8910 FORMAT(//,5X,'YOU HAVE ENTERED - CHECK',I5,/,
     1'          NO ACCURACY CHECKING WILL BE DONE')
 8920 FORMAT(//,5X,'YOU HAVE ENTERED - CHECK',I5,/,
     1'          ALL APPROPRIATE QUANTITIES WILL BE COMPUTED',/,
     2'          AND WRITTEN TO THE TEXT OUTPUT FILE FOR',/,
     3'          COMPARISON BETWEEN THE DONOR AND RECIPIENT MESHES')
 8930 FORMAT(//,5X,'YOU HAVE ENTERED - CHECK',I5,/,
     1'          ONLY VALUES 0 OR 1 HAVE BEEN IMPLEMENTED')

 9000 FORMAT(5X,'YOU HAVE ELECTED TO TERMINATE THE PROGRAM',/,
     1'          NOTHING WILL BE COMPUTED OR SAVED')

10000 FORMAT(5X,'LEAVING RDINPT - VALUES USED ARE:',//)
10010 FORMAT(//5X,'YOU HAVE ENTERED FOR THE TIMES COMMAND',/,
     1'          *TIMES ALL* - ALL TIME STEPS WILL BE MAPPED',//)
10020 FORMAT(//5X,'YOU HAVE ENTERED FOR THE TIMES COMMAND',/,
     1'          rtime = ',F14.6,/,
     2'          CLOSEST TIME ON DATABASE',/,
     3'          ctime = ',f14.6,/,
     4'          TIME STEP',/,
     5'          istep =',i5,//)
10030 FORMAT(5X,'MAP TO BE USED:')

      END

      subroutine pmap(imp, mp, seabmp, nout)
      DIMENSION MP(3,*), SEABMP(*)

      DO 86 I = 1, IMP
         IF ( SEABMP( I) .GT. 0.0) THEN
            WRITE(NOUT,8051)MP(1,I),MP(2,I),MP(3,I),SEABMP(I)
         ELSE
            WRITE(NOUT,8050)MP(1,I),MP(2,I),MP(3,I)
         END IF
 86   CONTINUE
 8050 FORMAT(5X,'MAP ',I5,' TO', I5, ' SCHEME', I5)
 8051 FORMAT(5X,'MAP ',I5,' TO', I5, ' SCHEME', I5,' SEARCHBOX', F14.6)
      return
      end
