#! /bin/sh
#
#    Last change: Mihai Dima 2001
#
if [ $# -lt 7 ]
then
  echo " "
  echo "            *****     SELBOX     *****      "
  echo " "
  echo "  The program selects a rectangular area of a field"
  echo " "
  echo "   Syntax: selbox <file1> <file2> <nr_lines>"
  echo "                   <xdim1> <xdim2> <ydim1> <ydim2>"
  echo " "
  exit 0
else
 echo " "
 echo "            *****     SELBOX     *****      "
 echo " "
 echo "file1="$1
 echo "file2="$2
 echo "Nr. of lines in the input file="$3
 echo "Initial x point in the new box="$4
 echo "Last x point in the new box="$5
 echo "Initial y point in the new box="$6
 echo "Last y point in the new box="$7
 echo " "
 cp $1 fort.1
fi
cat > selbox.f <<EOF
      PROGRAM PSELBOX
      IMPLICIT REAL (A-H,O-Z)
      PRINT *,'0**** SELBOX (INPUT,OUTPUT,TAPE1,TAPE2)****'
      PRINT *,'   '
      NCHAN=1
      CALL PARLES (NCHAN,NDIM,NSET)
      CALL SELBOX (NDIM)     
      STOP 
      END
C******************************************************************
      SUBROUTINE PARLES (NCHAN,NDIM,NSET)
      IMPLICIT REAL (A-H,O-Z)
C
      INTEGER I1,I2,I3

      REWIND NCHAN
      READ(NCHAN,END=10) ITIME,INAME,ILEV,ISIZE
      REWIND NCHAN

      NSET=0
      NDIM=0  
    1 READ (NCHAN,END=100) I1,I2,I3,I4
      NDIM=MAX0(NDIM,I4)
      READ (NCHAN,END=101) 
      NSET=NSET+1
      GOTO1
      
  101 PRINT *,' MORE HEADER THEN DATA '     
  100 PRINT 1000,NCHAN,NDIM,NSET
      REWIND NCHAN
      RETURN    
   10 PRINT *,'INPUT FILE ON TAPE',NCHAN,' IS EMPTY'
      STOP 'MISTAKE'
 1000 FORMAT (1X,' TAPE=',I2,',  NDIM=',I5,',  NSET=',I5)
      END

C*****************************************************************
      SUBROUTINE SELBOX (IE)
      IMPLICIT REAL (A-H,O-Z)
C
      PARAMETER (UNDEF=0.9E+10,UNDEFE=.9*UNDEF)
      LOGICAL MERID
C IF YOU USE THIS PROGRAM NOT ON A CRAY-2 DELETE THE
C FOLLOWING TWO LINES
C      PARAMETER(IE77=9E12)
C      DIMENSION X(IE),XHELP(IE)
C      POINTER (NPX,X),(NPXHELP,XHELP)
C      ALLOCATE (NPXHELP,IE)
C      ALLOCATE (NPX,IE)
C AND ACTIVATE THE FOLLOWING LINES
      PARAMETER(IE77=20000)
      DIMENSION X(IE77),XHELP(IE77)
C NOW YOU HAVE DONE ALL CHANGES FOR STANDARD FORTRAN.
      DATA MERID/.FALSE./
      DATA ONE/1.0/
C
      PRINT *,' *SELBOX* ENTER: NROWS, ILON1, ILON2, ILAT1, ILAT2'
      PRINT *,'    FOR EXAMPLE:   50     3      35     5      18 '
      READ(5, *,END=12) NROWS, ILON1, ILON2, ILAT1, ILAT2
      IF(NROWS.EQ.0) NROWS = 1
      NCOL = IE/NROWS
      IF(NCOL*NROWS .NE. IE) GOTO 13
      WRITE(6,6011) ' NROWS, NCOLS, ILON1, ILON2, ILAT1, ILAT2 '
      WRITE(6,'(8X,6(1X,I6),/)') NROWS,NCOL,ILON1,ILON2,ILAT1,ILAT2
      IF(ILON1.LE.0) ILON1 = 1
      IF(ILON2.LE.0) ILON2 = NCOL
      IF(ILAT1.LE.0) ILAT1 = 1
      IF(ILAT2.LE.0) ILAT2 = NROWS
      IF(ILON1.GT.ILON2) MERID=.TRUE.
      IF(ILAT1.GT.ILAT2) GOTO 19
      IF (MERID) THEN
        IOUT=(NCOL-ILON1+1+ILON2)*(ILAT2-ILAT1+1)
      ELSE
        IOUT = (ILON2-ILON1+1)*(ILAT2-ILAT1+1)
      ENDIF
C
C*  CHECK THE INPUT FILE.
C
      REWIND 1
      READ(1,END=10) ITIME,INAME,ILEV,ISIZE
      IF(ISIZE.GT.IE) GOTO 11
      IE=ISIZE
      REWIND 1
      WRITE(6,6010) ' FIRST RECORD:',ITIME,INAME,ILEV,ISIZE
C
C*  MAIN LOOP.
C
      ICNT=0
  100 READ(1,END=9920) ITIME,INAME,ILEV,ISIZE
        IF(ISIZE.GT.IE) GOTO 14
        READ(1,END=15) (X(I),I=1,IE)
        ICNT=ICNT+1
        WRITE(2) ITIME,INAME,ILEV,IOUT
        IF (MERID) THEN
          WRITE(2) ((X((I-1)*NCOL+J),J=ILON1,NCOL),(X((I-1)*NCOL+K),
     +              K=1,ILON2),I=ILAT1,ILAT2)
        ELSE 
          WRITE(2) ((X((I-1)*NCOL+J),J=ILON1,ILON2),I=ILAT1,ILAT2)
        ENDIF
        GOTO 100
   10 WRITE(6,6010) ' INPUT FILE IS EMPTY '
         GOTO 9910
   11 WRITE(6,6010) ' INPUT GRIDS TOO LARGE '
         GOTO 9910
   12 WRITE(6,6010) ' PARAMETER CARD TOO SHORT OR MISSING '
         GOTO 9910
   13 WRITE(6,6010) ' NRWOS * NCOL .NE. IE '
         GOTO 9910
   14 WRITE(6,6010) ' INVALID RECORD LENGTH:', ISIZE
         GOTO 9910
   15 WRITE(6,6010) ' UNEXPECTED *EOF* DURING READ '
         GOTO 9910
   19 WRITE(6,6010) ' ILAT 1 > ILAT2 ', ILAT1, ILAT2
 9910 CONTINUE
C
C*  ABNORMAL TERMINATION.
C
         PRINT *, '*SELBOX*: FATAL END '
         CALL MINONE(ONE,XNEGO)
         ZZ=SQRT(XNEGO)
         STOP
C
C*  NORMAL TERMINATION.
C
 9920 WRITE(6,6010) '  LAST RECORD:',ITIME,INAME,ILEV,ISIZE
      WRITE(6,6010) ' NEW FIELD SIZE:',IOUT
      WRITE(6,6060) ICNT
      PRINT *, '*SELBOX*: NORMAL '
      STOP
 6010 FORMAT(' *SELBOX*: ', A,/,(6I10))
 6011 FORMAT(' *SELBOX*: ', A)
 6060 FORMAT(' *SELBOX* -- READ ',I10,' RECORDS.')
      END
      SUBROUTINE MINONE(XIN,XOUT)
        XOUT=-XIN
      RETURN
      END
EOF
f77 selbox.f -o selbox.x
selbox.x $1 $2 << M
$3
$4
$5
$6
$7
M
cp fort.2 $2
rm fort.1 fort.2
rm selbox.x selbox.f
exit