      character*80 function GETNAM(NAMEIN)
      character*(*) NAMEIN
      character*80 GETNAMES
*
*
*                 new       |||||     mailbox             UNIX type
*                 and        |||      communication       original
*              improved       |       system              commented
*                             |         by                out at the
*                             V       Janusz Mrozek       end of a
*                                     on 1991/08/19       subroutine
c
c
      include 'MOP6FILE'            ! Get parameters common to all the
                                    ! MOPAC v. 6 files
c
c
      character*50 FILnames(Nfiles) ! <== true names of files to be used
c
      character*50 FORnames(Nfiles) ! <==        FORTRAN,
     %    /
     %       'FOR005'  ,            !     system and/or symbolic names
     %       'FOR006'  ,            !     as used in the program
     %       'FOR009'  ,
     %       'FOR010'  ,
     %       'FOR011'  ,
     %       'FOR012'  ,            ! there are Nfiles such names
     %       'FOR013'  ,            ! currently used in the AMPAC program
     %       'FOR014'  ,
     %       'FOR015'  ,
     %       'FOR016'  ,
     %       'FOR020'  ,
     %       'SETUP'   ,
     %       'SHUTDOWN',
     %       '?Setup2' ,
     %       'FOR021'    /
c
c
c       local variables
c
       logical ajar, living
       character *80 line, tfname*65, wchar*1
       equivalence (ajar,living)
c
       save FILnames, FORnames  ! we need some trace of warranty
                           ! that our marvel of technology
                           ! will not forget the data it read in
                           ! after being called as GETNAMES
c
c
c                          G  E  T  N  A  M
c
c
c      When called under the above name this routine does
c      its regular bussiness ...
c
c               customer insists on knowing the real file
c               name to be assigned to the symbolic unit
c               given in NAMEIN
c
      do i=1,Nfiles
        if (FORnames(i).eq.NAMEIN) then
                                       ! ubelievable, we got it !
c
              GETNAM = FILnames(i)     ! let him/her enjoy it ...
c
              return                   ! go back to the caller
        end if
c
      end do                        ! digging further ...
c
                   ! but if we managed to get here
                   ! we cannot afford being nice
                   ! any more ! This is a real
                   ! emmergency - the calling program went berserk.
c
                         ! We are closing whatever is opened
c
      do j=1,Nfiles-1       ! -1 because unit #4 is serving both
                            ! as a SETUP, and if necessary as
                            ! a Secondary SETUP logical unit
        i = loguni(j)
c
        inquire(unit=i,opened=ajar)  ! checking the status
c
        if (ajar) then
                 ! this one was opened
c
                         ! Let us pass the sad news to the output
                         ! files once they are still opened ...
           if (i.eq.6 .or. i.eq.11)  then
              write(i,100) NAMEIN
           end if
c
           close(unit=i)      ! closing
        end if
c
      end do                ! loop checking regular channels ends here
c
                         ! now scratch files
      do j=1,Nscratch
c
         i = luscr(j)
c
         inquire(unit=i,opened=ajar)  ! checking the status
         if (ajar) close(unit=i)       ! killing when opened
c
      end do                ! end killing scratch files
c
                         ! now, one good final stroke ....
c
100      format(///' GETNAM unable to process request for'/
     %          ' a symbolic file name =',a//
     % ' if this is related to the External Parameters or '/
     % ' if this is related to the SETUP see your file table'/
     % ' otherwise it means the program goes berserk'/
     % ' if recently modified do a thorough check ...'////
     % '           %%%%%%%%%%%%%%%%%%%%%%'/
     % '           %       R.i.P.       %'/
     % '           %                    %'/
     % '           %     M O P A C      %'/
     % '           %      ver. 6.0      %'/
     % '           %                    %'/
     % '           %        died        %'/
     % '           %         in         %'/
     % '           %       service      %'/
     % '           %         of         %'/
     % '           %       science      %'/
     % '           %%%%%%%%%%%%%%%%%%%%%%'///)
c
      stop ' MOPAC killed by GETNAM, see output ...'
c
*
*
*         We come here at the very beginning of our task
*         in order to read names of all the files,
*         that we are going to use during this run
*         (with an obvious exception for the scratch ones).
*
*         This part is known to both the mankind and the
*         MOPAC program as:
*
*                     +++++++++++++++++++++
*                     +  G E T N A M E S  +
*                     +++++++++++++++++++++
*
      entry GETNAMES (NAMEIN)
c
*
*       first check how many parameters were given to the program
*       - one is a must. This is checked by the script file but
*       people are getting smart nowadays and someone may play
*       directly with the program.
*
      Nargs = IARGC()  ! Nargs receives the number of args
                       ! used when calling MOPAC
c
      if (Nargs.eq.0) then
                        ! not too much to do  - kill in a spot
c
         stop ' No file table in call of MOPAC !!!'
c
      end if
c
*
*        Situation is good but still not hopeless
*        -  we have got some parameter  in a MOPAC call
*
c
      call GETARG (1,tfname)  ! so we read it in tfname
                             ! hoping that it is a name
                             ! of an existing file
                             ! in the working directory
                             ! of our employer
*           You know,
*           we generally trust our beloved customers,
*           but just in case ....
c
         INQUIRE(file=tfname,exist=living)  ! we hire our
                                            ! Private Eye
c
      if (.not.living) then    ! We were so trustfull !
                              ! still ... we have good heart
                              ! and some educational efforts
                              ! might be worth trying:
c
      write(*,*) ' '
      write(*,*) '+ ++++++++++++++++++++++++++++++++++++++++++'
      write(*,*) '+ This is a bad news from your MOPAC run   +'
      write(*,*) '+ the file of name =',tfname
      write(*,*) '+ supposed to be a file table name         +'
      write(*,*) '+ is not among the living in your directory+'
      write(*,*) '+ Please check, and do not lose hope !     +'
      write(*,*) '+                                          +'
      write(*,*) '+ Sun will shine on our street too!        +'
      write(*,*) '+      (J.V.Stalin, 1941, Coll.Works)      +'
      write(*,*) '+ ++++++++++++++++++++++++++++++++++++++++++'
      write(*,*) ' '
      stop ' Wrong name of the File Table for MOPAC'
c
      end if                  ! and so we got rid of our TURKEY
                              ! and might go for some games
*
*          However, in exceptional cases, it happens
*          that   File Table exists!
*          this goes beyond comprehension!
*                                                ! We are rather shocked
c
      open(unit=99,file=tfname,status='OLD')  ! let us take a risk
                                              ! and open it
c
      rewind 99                               ! even rewind ...
c
           ! start chasing after the line consisting of "======"
c
 200     read(99,'(a)',end=310,err=320) line
      if (index(line,'======').eq.0) go to 200
c
           ! O.K. we somehow managed to get to the right place
           ! and now we have to read the names of files
           ! from the consecutive lines
c
      do 250 i=1,Nfiles-3
c
       read(99,'(a)',end=330,err=340) line
c
           ! first 50 characters of a file box there
           ! should contain name of a file
c
       FILnames(i) = line(26:)
c
          if (i.eq.Nfiles .or.
     %            i.eq.  8  ) then
                             ! the ALTERNATE PARAMETERS
                             ! and SECONDARY SETUP
                             ! files are the exceptional cases
c
            if (Filnames(i) (1:1).eq.'?') then
                             ! no trace of ALTERNATE PARAMETERS
                             ! or       SECONDARY SETUP
               go to 250
                             ! otherwise
                             ! there is probably some name given
                  else
                             ! let us do some moderate efforts
                             ! checking the prospective file name
                             ! we will not go beyond checking for
                             ! the most probable mistakes
c
             do j =1,50
               wchar =  Filnames(i) (j:j)
               if (wchar .eq. '*' .or.
     %                 wchar .eq. '?' .or.
     %                 j.eq.1 .and. wchar .eq. ' ')  then
c
               write(*,*) ' '
               write(*,*) '          ! #$@%&'
               write(*,*) ' Honey! Would you please,'
               write(*,*) ' read carefully the comments below'
               write(*,*) ' the box containing names of files'
               write(*,*) ' in your file table =',tfname
               write(*,*) ' before touching ALT. PARAMETERS'
               write(*,*) ' or  SETUP files'
               write(*,*) ' in line #',i
               write(*,*) ' there is a text =', Filnames(i)
               write(*,*) ' it either starts with a blank,'
               write(*,*) ' and/or includes * or ? after col. #1'
               write(*,*) ' this may invite a disaster'
               stop ' check your file table '
               end if
             end do
c
             FORnames(Nfiles) = FILnames(i)
c
            end if
          end if
c
 250    continue  ! the loop that reads file names ends here
c
      GETNAMES = ' Everything appeared O.K.'
c
      close(99)
c
c
      return ! Done, going back to the caller
c
            ! Four exemplary sermon speaches follow
c
c
 310  write(*,*) ' The file you provided as a file table'
      write(*,*) ' is either empty '
      write(*,*) '       or'
      write(*,*) ' is missing the ===== framing the file box'
      stop ' file table EOF hit before even finding the name box'
c
 320  write(*,*) ' The file you provided as a file table'
      write(*,*) ' could not be read properly'
      write(*,*) ' possibly wrong file type'
      stop ' error when reading the file table head'
c
 330  write(*,*) ' Too few lines in the file name box'
      write(*,*) ' did you erase some lines there ??'
      stop ' file table EOF hit when reading the name box'
c
 340  write(*,*) ' The file you provided as a file table'
      write(*,*) ' is either corrupted or it is not '
      write(*,*) ' a formatted text file'
      stop ' errors when reading the name box'
c
c
*                             ^
*                 new         |       mailbox
*                 and         |       communication
*              improved      |||      system
*                           |||||     by J/M  1991/08/19
*
*
*      The original function for the UNIX system is given below
*      However, I think it is wiser not to transmit data to the
*      program via the environment but to arange a more simple
*      and straightforward way - by a mailbox file as given above.
*      This approach allows for running, if in real need, more
*      tasks from the same directory not to mention easy mixing
*      of names of input files if necessity calls.
*
*                           |||||
*                            |||
*                 original    |      UNIX        disabled !
*                 style       |      coding
*                             V
C
C    THIS FUNCTION IS DESIGNED FOR USE ON A VMS AND ON A UNIX
C    SYSTEM.  if YOUR SYSTEM IS VMS, COMMENT OUT THE LINE
C    "      call GETENV(NAMEIN, NAMEOUT)", FURTHER ON IN THIS FUNCTION.
C    IF YOUR SYSTEM IS UNIX, MAKE SURE THE LINE IS NOT
C    COMMENTED OUT.
C    ON A UNIX SYSTEM, GETENV WILL CONSULT THE ENVIRONMENT
C    FOR THE CURRENT ALIAS OF THE character STRING CONTAINED IN
C    'NAMEIN'.  THE ALIAS, IF IT EXISTS, OR THE ORIGINAL NAME IN NAMEIN
C    WILL BE RETURNED.
C
*      character*(*) NAMEIN
*      character*(80) NAMEOUT
*      NAMEOUT=' '
*C      call GETENV(NAMEIN, NAMEOUT)
*      if (NAMEOUT.EQ.'  ') NAMEOUT=NAMEIN
*      GETNAM = NAMEOUT
*      return
      end
