C***********************************************************************
C***********************************************************************
      PROGRAM EXTRACTBCS
C-----------------------------------------------------------------------
C purpose: This program extracts boundary values from an .s2c or.s2r
C           data file (specified by ncd=5,6,9 in a .ncd data file)
C           and writes them to user specified .s2c or .s2r file.
C
C restrictions: 2-D horizontal triangular mesh with linear elements
C
C history:  Written by Christopher E. Naimie
C           Dartmouth College
C           September 26, 1994
C-----------------------------------------------------------------------
      parameter(nndim=13000,nnvdim=21,nedim=24000,nlevels=27)
C
C Mesh Arrays
      real x(nndim),y(nndim),bathy(nndim)
      integer in(3,nedim)
      real s2r(nndim)
      complex s2c(nndim)
      character*72 pathmesh,filetype,sourcefile,ncdfile,resultfile
C
C Load mesh
      write(*,*)'Enter the pathmesh'
      read(*,101)pathmesh
      CALL LOADMESHGOM(nndim,nedim,pathmesh,x,y,in,bathy,nn,ne)
C
C Enter filenames
      write(*,*)'Enter the name of your .ncd file'
      read(*,101)ncdfile
 1    write(*,*)'Enter the type of file you would like to extract bounda
     &ry values from.  (s2c or s2r)'
      read(*,101)filetype
      if(filetype.NE.'s2r'.AND.filetype.EQ.'S2R'.AND.
     &   filetype.NE.'s2c'.AND.filetype.EQ.'S2C')go to 1
C
C Extract BCS for s2c file
      if(filetype.EQ.'s2c'.OR.filetype.EQ.'S2C')then
         write(*,*)'Enter the name of the s2c file you would like to ext
     &ract the boundary values from.'
         read(*,101)sourcefile
         write(*,*)'Enter the name of the .bcs.s2c file you desire to cr
     &eate.'
         read(*,101)resultfile
         CALL LOADS2C(nndim,nn,sourcefile,s2c,freq)
         open(12,file=resultfile,status='new')
         write(12,*)'bank150'
         write(12,'(A)')sourcefile
*         write(12,*)'1995 101.1610'
         write(12,*)freq
         write(13,*)'bank150'
         write(13,'(A)')sourcefile
*         write(13,*)'1995 101.1610'
         write(13,*)freq
         open(11,file=ncdfile,status='old')
         do 10 i=1,nndim
            read(11,*,end=11)node,ncd
            if(ncd.EQ.5.OR.ncd.EQ.6.OR.ncd.EQ.9)
     &write(12,102)node,CABS(s2c(node)),PHASELAGD(s2c(node))
      write(13,102)node,0.0,0.0
 10      continue
 11      continue
      endif
C
C Extract BCS for s2r file
      if(filetype.EQ.'s2r'.OR.filetype.EQ.'S2R')then
         write(*,*)'Enter the name of the s2r file you would like to ext
     &ract the boundary values from.'
         read(*,101)sourcefile
         write(*,*)'Enter the name of the .s2r file you desire to create
     &.'
         read(*,101)resultfile
         CALL LOADS2R(nndim,nn,sourcefile,s2r)
         open(12,file=resultfile,status='new')
         write(12,*)'bank150'
         write(12,*)'1995 101.1610'
         write(12,*)'.1000E-11'
         write(13,*)'bank150'
         write(13,*)'1995 101.1610'
         write(13,*)'.1000E-11'
         open(11,file=ncdfile,status='old')
         do 20 i=1,nndim
            read(11,*,end=21)node,ncd
            if(ncd.EQ.5.OR.ncd.EQ.6.OR.ncd.EQ.9)
     &write(12,102)node,s2r(node),0.0
      write(13,102)node,0.0,0.0
 20      continue
 21      continue
      endif
C
C Format statements
 101  format(a)
 102  format(i5,2e12.4)
      stop
      end
C***********************************************************************
C***********************************************************************
