C*************************   PROGRAM FINDMODL ***************************

      Program FINDMODL



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 dispersion relation models.

C ANCNL = NO CURRENT NO LOSSES

C AWCWL = WITH CURRENT WITH LOSSES

C etc..

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. Receiver-Surface

C   6. Bottom Surface

C   7. Bottom Perturbation

C   8. Ocean Surface

C   9. Ocean Surface Perturbation

C  10. Ocean Absorption

C  11. Ocean Absorption Perturbation

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

      LOGICAL existflag,

     &	      eof,

     &	      currflag,

     &	      lossflag,

     &        surflag,

     &        tempflag,

     &        botmflag,

     &        endtabdata



      REAL model



      INTEGER ist,

     &	      w



      CHARACTER*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,*)



      surflag = .false.

      currflag = .false.

      lossflag = .false.

      botmflag = .false.

      tempflag = .false.



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



     &	       if (MOD(w,25) .eq. 0 .and. w .ge. 100 .and. w .le. 575

     &	           .and. .not. eof) then

	           call CHECK_MODEL_TABLE (w, model, objlocation,

     &                                     lenobj, currflag, lossflag,

     &                                     surflag, tempflag, botmflag)

	   endif

      enddo



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.



      if (.not. currflag .and. .not. lossflag) then

           WRITE (2,*) objlocation(1:lenobj)//'ANCNL'

      elseif (.not. currflag .and. lossflag) then

           WRITE (2,*) objlocation(1:lenobj)//'ANCWL'

      elseif(currflag .and. .not. lossflag) then

           WRITE (2,*) objlocation(1:lenobj)//'AWCNL'

      elseif(currflag .and. lossflag) then

           WRITE (2,*) objlocation(1:lenobj)//'AWCWL'

      endif

      write(2,*)'pcharpo.exe'

      write(2,*)'            '  ! map file location. default nul.map.



      write(2,*)'c:\lib\llibfor7.lib' ! fortran library location

      end

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

      Subroutine CHECK_MODEL_TABLE (w, model, objlocation, lenobj,

     &                              currflag, lossflag, surflag,

     &                              tempflag, botmflag)





      REAL model

      INTEGER w, lenobj

      LOGICAL currflag,

     &	      lossflag,

     &        surflag,

     &        tempflag,

     &        botmflag



      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) then

	   WRITE (2,*)

     &                objlocation(1:lenobj)//model_table(1,NINT(model))

     &                // '+'

	   currflag = .true.



      else if (w.eq. 125) then

	   WRITE (2,*) objlocation(1:lenobj)//model_table(2,NINT(model))

     &                 // '+'

      else if (w.eq. 150) then

	   WRITE (2,*) objlocation(1:lenobj)//model_table(3,NINT(model))

     &                 // '+'

      else if (w.eq. 175) then

	   WRITE (2,*) objlocation(1:lenobj)//model_table(4,NINT(model))

     &                 // '+'



      else if (w.eq. 200) then

           tempflag = .true.

	   WRITE (2,*)objlocation(1:lenobj)//model_table(12,NINT(model))

     &                 // '+'

      else if (w.eq. 225) then

	   WRITE (2,*)objlocation(1:lenobj)//model_table(13,NINT(model))

     &                 // '+'

      else if (w.eq. 250) then

	   WRITE (2,*)objlocation(1:lenobj)//model_table(14,NINT(model))

     &                 // '+'



      else if (w.eq. 275) then

	   WRITE (2,*) objlocation(1:lenobj)//model_table(5,NINT(model))

     &                 // '+'

      else if (w.eq. 300) then

	   WRITE (2,*) objlocation(1:lenobj)//model_table(6,NINT(model))

     &                 // '+'

           botmflag = .true.



      else if (w.eq. 325) then

	   WRITE (2,*) objlocation(1:lenobj)//model_table(7,NINT(model))

     &                 // '+'

      else if (w.eq. 350) then

	   WRITE (2,*) objlocation(1:lenobj)//model_table(8,NINT(model))

     &                 // '+'

           surflag = .true.



      else if (w.eq. 375) then

	   WRITE (2,*) objlocation(1:lenobj)//model_table(9,NINT(model))

     &                 // '+'

      else if (w.eq. 500) then

	   WRITE (2,*)objlocation(1:lenobj)//model_table(10,NINT(model))

     &            // '+'

	   lossflag = .true.



      else if (w.eq. 525) then

	   WRITE (2,*)objlocation(1:lenobj)//model_table(11,NINT(model))

     &                 // '+'

	   lossflag = .true.



      else if (w.eq. 550) then

	   WRITE (2,*)objlocation(1:lenobj)//model_table(15,NINT(model))

     &                 // '+'

      else if (w.eq. 575) then

	   WRITE (2,*)objlocation(1:lenobj)//model_table(16,NINT(model))

     &                 // '+'



      else

	   PRINT*,'Illegal model type: ',model ,' for W(',w,').'

	   STOP 'Correct DINP file and re-run.'

      endif





      RETURN

      END

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

      INTEGER FUNCTION LEN_TRIMMED (oldstring)



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



      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

      END

