C ------------------------   PROGRAM FINDMODL   ------------------------!-------
c     fndmodlh.for
C ----------------------------------------------------------------------!-------
! 20 Apr 2010 - Included gravity-wave dispersion relation with wind (GWWNL)
C 10 Sep 2008 - Corrected dimension of array
C  5 Dec 2006 - Allow acoustic dispersion relation with gravity models
C 12 Jul 2006 - Flag correction
C  2 Feb 2006 - General version for all programs
c 31 Jan 2006 - Corrected some errors
c 30 Jan 2006 - Make consistent with way the ray tracing program reads data
c  3 Jan 2006 - Included gravity-wave dispersion relations
C ----------------------------------------------------------------------!-------
      Program FINDMODL
C ----------------------------------------------------------------------!-------

C This program reads the DINP file to determine the models that will be
C used by the PC-HARPO program.  The main difference between PC-HARPO
C and the other programs e.g., PROFILE, is that PC-HARPO needs to be linked
C with one of ANCNL, ANCWL, AWCNL, AWCWL, GNWNL, GWWNL dispersion relation 
C models.
C ANCNL = ACOUSTIC NO CURRENT NO LOSSES
C AWCWL = ACOUSTIC WITH CURRENT WITH LOSSES
C etc..
C GNWNL = GRAVITY NO WIND NO LOSSES
C GWWNL = GRAVITY WITH WIND NO LOSSES
C Because of this, the last line of the LINKMODL.DAT file will always be
C one of the dispersion relation models.
C
C   A model may be used for any of the following:
C
C   1. Background Current
C   2. Current Perturbation
C   3. Sound Speed
C   4. Sound Speed Perturbation
C   5. Temperature
C   6. Temperautre Perturbation
C   7. Molecular Weight
C   8. Receiver-Surface
C   9. Bottom Surface
C  10. Bottom Perturbation
C  11. Ocean Surface
C  12. Ocean Surface Perturbation
C  13. Ocean Absorption
C  14. Ocean Absorption Perturbation
C  15. Pressure
C  16. Pressure Pertubation
C  17. Gravity
C  18. Gravity Perturbation
C  19. Density
C  20. Density Pertubation
C
C
C For each of the above model categories, the DINP file is scanned to
C determine which (if any) model is to be used.  The appropriate model
C is then pulled from a table and written to an ASCII file.  The ASCII
C then serves as input to a LINK command batch file thus creating an
C executable file containing references to the correct models.
C

      PARAMETER (NWARSZ=1000) ! 31 Jan 2006

      LOGICAL existflag,
     &	      eof,
     &	      currflag,
     &	      lossflag,
     &        surflag,
     &        tempflag,
     &        botmflag,
     &        pressflag,                                ! 3 January 2006
     &        gravflag,                                 ! 3 January 2006
     &        densflag,                                 ! 3 January 2006
     &        endtabdata

      REAL model,
     &     VALUE(0:NWARSZ) ! 30 Jan 2006                           ! 30 Sep 2008

      INTEGER ist,
     &	      w

      CHARACTER(LEN=80)
     &        fname,
     &        objlocation,
     &        argfile

      integer*2 status     ! gives the length of the second argument
                           ! See GETARG call
C==>
C.....This is a MicroSoft subroutine which returns the nth argument
C     on the command line when the program (FINDMODL in our case) is
C     invoked.  ARGFILE is a character buffer which stores the argument
C     (an input data file name, in our case).  STATUS returns the length
C     of ARGFILE without trailing blanks.

      call GETARG (1,argfile,status)
      if (status .gt. 0) then
           do i = 1, status
                fname(i:i) = argfile(i:i)
           enddo
C..........I HATED TO DO THIS GO TO, BUT IT WAS SOOO EASY.  So, we have the
C          name of the input file (it cannot be DINP) and we just
C          do the same thing as is done if the person did not enter
C          it on the RUNHARPO L command line as the second argument but
C          instead had just typed RUNHARPO L and there was no DINP file.

           GO TO 20
      endif


      INQUIRE (FILE='DINP',EXIST=existflag)
      if (.not. existflag .and. status .lt. 0) then

	  WRITE(*,*) ' No DINP file exists for FINDMODL program.'
10        WRITE (*,11)
11        FORMAT ('  Enter filename: ',$)
          READ (*,22) fname
22        FORMAT (A)
20        INQUIRE (FILE=fname, EXIST=existflag)
          if (.not. existflag) then
               WRITE (*,*) ' Could not find file: ',fname
               go to 10
          endif
          OPEN (UNIT=1,FILE=fname,STATUS='OLD',IOSTAT=ist)
          if (ist.ne.0) then
	      PRINT*,' Error opening ',fname,' file.  Error code = ',ist
	      STOP 'Check error code in FORTRAN Reference Manual.'
          endif

C.........For input file names other than DINP, write the file name to
C         a standard output.  This is then re-directed to FNAME.OUT by the
C         batch file RUNHARPO.BAT.  See the batch file RUNHARPO.BAT.
C         This causes the PCHARPO program to read FNAME.OUT instead of
C         reading from the terminal in subroutine CONBLK.

          OPEN (UNIT=4, FILE='FNAME.OUT',STATUS='UNKNOWN',IOSTAT=ist)
          if (ist.ne.0) then
	      PRINT*,' Error opening FNAME.OUT.  Error code = ',ist
	      STOP 'Check error code in FORTRAN Reference Manual.'
          endif

          WRITE (4,22) fname
      else

C.....Open the input DINP file.

          OPEN (UNIT=1, FILE='DINP',STATUS='OLD',IOSTAT=ist)
          if (ist.ne.0) then
	      PRINT*, ' Error opening DINP file.  Error code = ',ist
	      STOP 'Check error code in FORTRAN Reference Manual.'
          endif

      endif


C.....Open the input MODELDIR.DAT file. This file contains the path/directory
C     which determines where the .OBJ files for all the models are located.
C     This location is written to the LINKMODL.DAT file so the linker can
C     find them.

      INQUIRE (FILE='MODELDIR.DAT',EXIST=existflag)
      if (.not. existflag) then

           objlocation = ' '
      else

           OPEN (UNIT=3, FILE='MODELDIR.DAT',STATUS='OLD',IOSTAT=ist)
           if (ist .ne. 0) then
                PRINT*, ' Error opening MODELDIR.DAT file.  ',
     &                  'Error code = ',ist
	        STOP 'Check error code in FORTRAN Reference Manual.'
           endif

C..........Read the model OBJ file location.

           READ (3,111,IOSTAT=ios) objlocation
111        FORMAT (A)
           if (ios .gt. 0) then
                PRINT *,'ERROR reading Object Modules location in ',
     &                  'MODELDIR.DAT.  Error code: ',ios
                STOP 'Check error code in FORTRAN Reference Manual.'

           else if (ios .eq. -1) then

C..........End of file reached by READ statement.  It could be that
C          the user has a blank line for the object location meaning
C          that they want to use the current directory for the location.

                objlocation = ' '
           endif

      endif

C.....Open the output LINKMODL.DAT file.

      OPEN (UNIT=2, FILE='LINKMODL.DAT',STATUS='UNKNOWN',IOSTAT=ist)
      if (ist.ne.0) then
	 print*, ' Error opening LINKMODL.DAT file.  Error code = ',ist
	 STOP 'Check error code in FORTRAN Reference Manual.'
      endif
                 
C.....Skip the first two lines in DINP.  These are the description lines.

      READ (1,*)
      READ (1,*)

      currflag = .false.
      lossflag = .false.
      surflag = .false.
      tempflag = .false.
      botmflag = .false.
      pressflag = .false.                               ! 3 January 2006
      gravflag = .false.                                ! 3 January 2006
      densflag = .false.                                ! 3 January 2006

C.....Use the path/directory location in the MODELDIR.DAT file.
C     Trim off the trailing blanks of the OBJ location.
C     If the MODELDIR.DAT file is blank, then LENOBJ = 0.  This would
C     cause a problem in the rest of the program, so set LENOBJ = 1.
C     This is equivalent to setting OBJLOCATION to ' '.

      lenobj = LEN_TRIMMED (objlocation)
      if (lenobj .eq. 0) lenobj = 1

C.....Read the DINP file.  Ignore READ errors so that lines in the file
C     which we are not interested in will not cause run-time errors.
C     That is, the single 222 FORMAT statement will work for the whole
C     file, except while reading tabular data.  The errors produced while
C     reading the tabular data are thus ignored.

      do while (.not. eof)

	   READ (1,222,IOSTAT=ist) w,model
222	   FORMAT (I3,BZ,E14.7)
	   if (ist .lt. 0) eof = .true.
	   if (w .lt. 0) then
                endtabdata = .false.
C...............Ignore read errors.  There will be lots of them
C               while reading through data that we are not interested in.

                do while (.not. endtabdata)
                     READ (1,333,ERR=100) icode
333                  FORMAT (I3)
100                  continue
                     if (icode .eq. 0) endtabdata = .true.
                enddo
           else

                value(w) = model ! 30 Jan 2006

	   endif
      enddo

      Do 23 W=100,675,25 ! 30 Jan 2006

c     &         if (MOD(w,25) == 0 .and. w >= 100 .and. w <= 675 ! 31 Jan 2006
c     &	           ) then ! 31 Jan 2006
                  call CHECK_MODEL_TABLE (w, value(w), objlocation,! 30 Jan 2006
     &                                    lenobj, currflag, lossflag,
     &                                    surflag, tempflag, botmflag,
     &                                    pressflag, gravflag, densflag)
23    CONTINUE ! 30 Jan 2006

C.....Must include a current model even if none are selected by the DINP.
C     This is to satisfy external references by one of the PCHARPO routines.
C     If no current model is selected, use NOCURR by default.
C     NOTE:  This does NOT cause the current model to be used, however.
C            It simply satisfies the linker.
C
C.....As for current models, if there is no ocean surface model
C     then the default will be NOSURF.
C
C.....Also, the default absorption (loss) model and default temperature
C     models are NOLOSS and NOTEMP, respectively.

C.....Deleted the LASTCMDFILLED stuff for PC-HARPO.

c      if (.not. currflag) then
c           WRITE (2,*) objlocation(1:lenobj)//'NOCURR +'
c      endif
c      if (.not. lossflag) then
c           WRITE (2,*) objlocation(1:lenobj)//'NOLOSS +'
c      endif
      if (.not. surflag) then
           WRITE (2,*) objlocation(1:lenobj)//'NOSURF '
      endif
c      if (.not. tempflag) then
c           WRITE (2,*) objlocation(1:lenobj)//'NOTEMP +'
c      endif
      if (.not. botmflag) then
           WRITE (2,*) objlocation(1:lenobj)//'NOBOTM '
      endif

C.....The following is for PC-HARPO.

	      PRINT*,' gravflag = ', gravflag
	      PRINT*,' lossflag = ', lossflag
	      PRINT*,' currflag = ', currflag

      if (gravflag .and. .not. lossflag .and. .not. currflag) then
           WRITE (2,*) objlocation(1:lenobj)//'GNWNL' ! 3 Jan 2006
      elseif (gravflag .and. .not. lossflag .and. currflag) then
           WRITE (2,*) objlocation(1:lenobj)//'GWWNL' ! 20 Apr 2010
      elseif ( ! .not. gravflag .and. ! 5 Dec 2006
     & .not. currflag .and. .not. lossflag) then
           WRITE (2,*) objlocation(1:lenobj)//'ANCNL' ! 3 Jan 2006
      elseif ( ! .not. gravflag .and. ! 5 Dec 2006
     & .not. currflag .and. lossflag) then
           WRITE (2,*) objlocation(1:lenobj)//'ANCWL' ! 3 Jan 2006
      elseif ( ! .not. gravflag .and. ! 5 Dec 2006
     & currflag .and. .not. lossflag) then
           WRITE (2,*) objlocation(1:lenobj)//'AWCNL' ! 3 Jan 2006
      elseif ( ! .not. gravflag .and. ! 5 Dec 2006
     & currflag .and. lossflag) then
           WRITE (2,*) objlocation(1:lenobj)//'AWCWL' ! 3 Jan 2006
      endif
C      write(2,*)'/out:pcharpo.exe' ! 2 Feb 2006 - General version
C      write(2,*)'/out:conplt.exe'
C      write(2,*)'/out:eigen.exe'
C      write(2,*)'/out:profile.exe'
      write(2,*)'            '  ! map file location. default nul.map.

C      write(2,*)'c:\wbm\src\pcharpo\lib\llibfor7.lib' ! fortran library location
C ----------------------------------------------------------------------!-------
      end Program FINDMODL
C ----------------------------------------------------------------------!-------

C ----------------------------------------------------------------------!-------
      SUBROUTINE CHECK_MODEL_TABLE (w, model, objlocation, lenobj,
     &                              currflag, lossflag, surflag,
     &                              tempflag, botmflag, pressflag,
     &                              gravflag, densflag)
C ----------------------------------------------------------------------!-------
C Finds each requested model in the model table (MODLTABL.DAT). 
C ----------------------------------------------------------------------!-------

      REAL model
      INTEGER w, lenobj
      LOGICAL currflag,
     &	      lossflag,
     &        surflag,
     &        tempflag,
     &        botmflag,
     &        pressflag,                                ! 3 January 2006
     &        gravflag,                                 ! 3 January 2006
     &        densflag                                  ! 3 January 2006

      CHARACTER*80 objlocation

      INCLUDE 'modltabl.dat'

ccccc	The array, MODEL_TABLE, is defined as follows (in MODLTABL.DAT):
ccccc
ccccc	CHARACTER*7 model_table(maxtypes=20,maxmodels=20)


      if (w.eq. 100.and.model.ge.0.) then ! 30 Jan 2006
	   WRITE (2,*)
     &                objlocation(1:lenobj)//model_table(1,NINT(model))
C     &                // '+'
	   if(model.gt.0.) currflag = .true.  ! 12 Jul 2006

      else if (w.eq. 125.and.model.ge.0.) then ! 30 Jan 2006
	   WRITE (2,*) objlocation(1:lenobj)//model_table(2,NINT(model))
C     &                 // '+'

      else if (w.eq. 150.and.model.ge.0.) then ! 30 Jan 2006
	   WRITE (2,*) objlocation(1:lenobj)//model_table(3,NINT(model))
C     &                 // '+'

      else if (w.eq. 175.and.model.ge.0.) then ! 30 Jan 2006
	   WRITE (2,*) objlocation(1:lenobj)//model_table(4,NINT(model))
C     &                 // '+'

      else if (w.eq. 200.and.model.ge.0.) then ! 30 Jan 2006
	   WRITE (2,*)objlocation(1:lenobj)//model_table(12,NINT(model))
C     &                 // '+'
           tempflag = .true.  

      else if (w.eq. 225.and.model.ge.0.) then ! 30 Jan 2006
	   WRITE (2,*)objlocation(1:lenobj)//model_table(13,NINT(model))
C     &                 // '+'

      else if (w.eq. 250.and.model.ge.0.) then ! 30 Jan 2006
	   WRITE (2,*)objlocation(1:lenobj)//model_table(14,NINT(model))
C     &                 // '+'

      else if (w.eq. 275.and.model.ge.0.) then ! 30 Jan 2006
	   WRITE (2,*) objlocation(1:lenobj)//model_table(5,NINT(model))
C     &                 // '+'

      else if (w.eq. 300.and.model.ge.0.) then ! 30 Jan 2006
	   WRITE (2,*) objlocation(1:lenobj)//model_table(6,NINT(model))
C     &                 // '+'
           botmflag = .true.  

      else if (w.eq. 325.and.model.ge.0.) then ! 30 Jan 2006
	   WRITE (2,*) objlocation(1:lenobj)//model_table(7,NINT(model))
C     &                 // '+'

      else if (w.eq. 350.and.model.ge.0.) then ! 30 Jan 2006
	   WRITE (2,*) objlocation(1:lenobj)//model_table(8,NINT(model))
C     &                 // '+'
           surflag = .true.  

      else if (w.eq. 375.and.model.ge.0.) then ! 30 Jan 2006
	   WRITE (2,*) objlocation(1:lenobj)//model_table(9,NINT(model))
C     &                 // '+'

      else if (w.eq. 500.and.model.ge.0.) then ! 30 Jan 2006
	   WRITE (2,*)objlocation(1:lenobj)//model_table(10,NINT(model))
C     &                 // '+'
	   if(model.gt.0.) lossflag = .true.  ! 12 Jul 2006

      else if (w.eq. 525.and.model.ge.0.) then ! 30 Jan 2006
	   WRITE (2,*)objlocation(1:lenobj)//model_table(11,NINT(model))
C     &                 // '+'
c	   if(model.gt.0.) lossflag = .true. ! 31 Jan 2006  ! 12 Jul 2006

      else if (w.eq. 550.and.model.ge.0.) then ! 30 Jan 2006
	   WRITE (2,*)objlocation(1:lenobj)//model_table(15,NINT(model))
C     &                 // '+'
           pressflag = .true.  

      else if (w.eq. 575.and.model.ge.0.) then ! 30 Jan 2006
	   WRITE (2,*)objlocation(1:lenobj)//model_table(16,NINT(model))
C     &                 // '+'

      ! 3 January 2006 - Added models after W(600)
      else if (w == 600.and.model.ge.0.) then ! 30 Jan 2006
           WRITE (2,*)objlocation(1:lenobj)//model_table(17,NINT(model))
C     &                 // '+'
           if(model.gt.0.) gravflag = .true.  ! 12 Jul 2006

      else if (w == 625.and.model.ge.0.) then ! 30 Jan 2006
           WRITE (2,*)objlocation(1:lenobj)//model_table(18,NINT(model))
C     &                 // '+'

      else if (w == 650.and.model.ge.0.) then ! 30 Jan 2006
           WRITE (2,*)objlocation(1:lenobj)//model_table(19,NINT(model))
C     &                 // '+'
           if(model.gt.0.) densflag = .true.  ! 12 Jul 2006

      else if (w == 675.and.model.ge.0.) then ! 30 Jan 2006
           WRITE (2,*)objlocation(1:lenobj)//model_table(20,NINT(model))
C     &                 // '+'

      else
	   PRINT*,'Illegal model type: ',model ,' for W(',w,').'
c	   STOP 'Correct DINP file and re-run.' ! 31 Jan 2006
      endif


      RETURN
C ----------------------------------------------------------------------!-------
      END SUBROUTINE CHECK_MODEL_TABLE 
C ----------------------------------------------------------------------!-------
C ----------------------------------------------------------------------!-------
      INTEGER FUNCTION LEN_TRIMMED (oldstring)
C ----------------------------------------------------------------------!-------

C This function determines the length of OLDSTRING without any trailing
C blanks.
C
C Some FORTRAN compilers have built-in functions which accomplish the
C same thing.
C ----------------------------------------------------------------------!-------
C

      CHARACTER*(*) oldstring

      len_trimmed = LEN(oldstring)

      if (len_trimmed .eq. 0) RETURN

      do i = LEN(oldstring),1,-1
	   if (oldstring(i:i) .eq. ' ') then
	       len_trimmed = len_trimmed-1
	   else
	       RETURN
	   endif
      enddo

      RETURN
C ----------------------------------------------------------------------!-------
      END FUNCTION LEN_TRIMMED 
C ----------------------------------------------------------------------!-------
