Merge pull request #136 from openmopac/jjps-1122-updates

November updates from Jimmy & minor bug fix

cmake/CPackOptions.cmake

@@ -1,6 +1,7 @@
 set(CPACK_ARCHIVE_COMPONENT_INSTALL ON)
 
 if("${CPACK_GENERATOR}" MATCHES "TGZ")
+   set(CPACK_COMPONENT_INCLUDE_TOPLEVEL_DIRECTORY ON)
    set(CPACK_COMPONENTS_ALL_IN_ONE_PACKAGE ON)
    set(CPACK_COMPONENTS_ALL main extra redist)
 endif()

src/PARAM/parkey.F90

@@ -16,7 +16,7 @@
 
  subroutine parkey (keywrd)
     use param_global_C, only : ifiles_8
-    use molkst_C, only : method_PM7, method_PM8
+    use molkst_C, only : method_PM7, method_PM8, keywrd_quoted
     implicit none
     character (len=*), intent (in) :: keywrd
     integer :: i, j, k
@@ -213,18 +213,18 @@ subroutine parkey (keywrd)
         end if
       end do
     end if
-    i = Index(keywrd, "EXTERNAL=") + Index(keywrd, "PARAMS=")
+    i = Index(keywrd_quoted, "EXTERNAL=")
     if (i /= 0) then
-      i = index(keywrd(i:), "=") + i
-      k = end_of_keyword(keywrd, len_trim(keywrd), i)
-      line = get_a_name(keywrd(i:k), len_trim(keywrd(i:k)))
+      i = index(keywrd_quoted(i:), "=") + i
+      k = end_of_keyword(keywrd_quoted, len_trim(keywrd_quoted), i)
+      line = get_a_name(keywrd_quoted(i:k), len_trim(keywrd_quoted(i:k)))
       write (ifiles_8, '(" *",/," *  EXTERNAL=n  -  DEFAULT PARAMETERS RESET USING&
                         & DATA IN FILES: ",/," *",17x, a)') '"'//trim(line)//'"'
       do
-        j = index(keywrd(i:k), ";")
+        j = index(keywrd_quoted(i:k), ";")
         if (j /= 0) then
           i = i + j
-          line = get_a_name(keywrd(i:), len_trim(keywrd(i:)))
+          line = get_a_name(keywrd_quoted(i:), len_trim(keywrd_quoted(i:)))
           write (ifiles_8, '(" *", 10x, a)')'   and "'//trim(line)//'"'
         else
           exit

src/input/datin.F90

@@ -20,7 +20,7 @@ subroutine datin(ir, iw)
 !-----------------------------------------------
       USE parameters_C, only : partyp, n_partyp, n_partyp_alpb, v_par, t_par
       use Common_arrays_C, only : ijpars, parsij
-      use molkst_C, only : keywrd, lpars, line, backslash
+      use molkst_C, only : keywrd, keywrd_quoted, lpars, line, backslash
       use chanel_C, only : iext
 !***********************************************************************
 !-----------------------------------------------
@@ -60,7 +60,7 @@ subroutine datin(ir, iw)
         'AC', 'TH', 'PA', 'U ', 'NP', 'PU', 'AM', 'CM', 'BK', 'MI', 'XX', 'FM'&
         , 'MD', 'CB', '++', '+', '--', '-', 'TV'/
     if (.not. allocated(ijpars))  allocate(ijpars(5,5000), parsij(5000))
-    i = Index(keywrd, "EXTERNAL") + Index(keywrd, "PARAMS=")
+    i = Index(keywrd_quoted, "EXTERNAL")
     t_par     = "Add a description of this parameter near line 50 in datin.F90  "
     t_par(1)  = "Used in ccrep for scalar correction of C-C triple bonds."
     t_par(2)  = "Used in ccrep for exponent correction of C-C triple bonds."
@@ -93,26 +93,26 @@ subroutine datin(ir, iw)
     t_par(30) = "Used in ccrep for exponent correction of F-H term."
     t_par(31) = "Used in ccrep for offset correction of F-H term."
     nref = 0
-    k = Index (keywrd(i:), "=") + i
-    j = end_of_keyword(keywrd, len_trim(keywrd), k)
+    k = Index (keywrd_quoted(i:), "=") + i
+    j = end_of_keyword(keywrd_quoted, len_trim(keywrd_quoted), k)
 !
 ! k = start of reference data directory list
 ! j = end of list.
 ! in between are the names of the reference directories, separated by ";"
 !
     do l = 1, 20
-      i = Index(keywrd(k:j),";")
+      i = Index(keywrd_quoted(k:j),";")
       if (i /= 0) then
         nref = nref + 1
-        file(nref) = trim(get_a_name(keywrd(k:j), len_trim(keywrd(k:j))))
+        file(nref) = trim(get_a_name(keywrd_quoted(k:j), len_trim(keywrd_quoted(k:j))))
         k = k + i
       end if
       if (i == 0) then
 !
 !  Last entry
 !
         nref = nref + 1
-        file(nref) = keywrd(k:j)
+        file(nref) = keywrd_quoted(k:j)
         exit
       end if
     end do

src/input/geo_ref.F90

@@ -36,7 +36,7 @@ subroutine geo_ref
 !
       use molkst_C, only : numat, keywrd, nvar, id, natoms, moperr, line, refkey, density, &
         maxtxt, numat_old, koment, title, geo_ref_name, geo_dat_name, arc_hof_2, arc_hof_1, &
-        keywrd_txt, pdb_label, ncomments, refkey_ref, backslash, formula
+        keywrd_txt, pdb_label, ncomments, refkey_ref, backslash, formula, keywrd_quoted
 !
       use parameters_C, only : ams
 !
@@ -48,15 +48,15 @@ subroutine geo_ref
 !
       integer :: i, j, k, l, ii, jj, i4, j4, k4, iquit, numat_dat, numat_ref, ub
       integer, allocatable :: map_atoms_A(:), atom_no(:)
+      integer, external :: quoted
       character, allocatable :: tmp_txt(:)*27, diffs(:)*80
       double precision, allocatable :: tmp_geoa(:,:)
       double precision :: dum1, dum2, sum, rms, rms_min, sum1, sum2, sum3, &
         toler, xmin, sum4
       double precision, external :: reada
       logical :: intern = .true., exists, bug, any_bug, swap, first, let, l_0SCF_HTML, opend
       logical, allocatable :: same(:), ok(:)
-      character :: line_1*1000, line_2*1000, num*2, geo_dat*7, txt(12)*1
-      data txt /" ",".","0","1","2","3","4","5","6","7","8","9"/
+      character :: line_1*1000, line_2*1000, num*2, geo_dat*7
 !
 !   For Geo-Ref to work, some very specific conditions must be satisfied.
 !   So before attempting a GEO_REF calculation, check that the data are okay
@@ -83,36 +83,18 @@ subroutine geo_ref
       id = 0
       if (moperr) return
       allocate(geoa(3,natoms + 300), c(3,natoms + 300)) ! Generous safety factor for second geometry
-      j = index(keywrd," GEO_REF")
-      i = index(keywrd(j:j + 10), '"') + j
-      if (i == j) then
-        write(line,'(a)')" File name after GEO_REF must be in quotation marks."
-        call mopend(trim(line))
-        return
-      end if
-!
-! Search for '" ' or '"x' where "x" is one of ., 0 - 9
-!
-      l = 1000
-      do k = 1, 12
-        j = index(keywrd(i + 2:),'"'//txt(k)) + i
-        if (j /= i) l = min(l,j)
-      end do
-      if (l /= 1000) j = l
-      if (j == i) then
-        write(line,'(a)')" File name after GEO_REF must end with a quotation mark."
-        call mopend(trim(line))
-        return
-      end if
-      line = keywrd(i:j)
+      i = quoted('GEO_REF=')
+      if (i < -10) stop ! dummy use of "i" to prevent FORCHECK from flagging a possible error
+      j = len_trim(line)
+      if (line(j:j) == '"') line(j:j) = " "
       line_1 = trim(line)
       call upcase(line_1, len_trim(line_1))
       geo_ref_name = trim(line)
-      i = index(keywrd," GEO_DAT")
+      i = index(keywrd_quoted," GEO_DAT")
       if (i > 0) then
-        i = index(keywrd(i:), '"') + i
-        j = index(keywrd(i + 2:),'" ') + i
-        geo_dat_name = keywrd(i:j)
+        i = index(keywrd_quoted(i:), '"') + i
+        j = index(keywrd_quoted(i + 2:),'" ') + i
+        geo_dat_name = keywrd_quoted(i:j)
       else
         geo_dat_name = trim(job_fn)
       end if
@@ -220,14 +202,14 @@ subroutine geo_ref
         if (ii /= 0) rewind(99)
       end if
       line_1 = trim(keywrd)
-      if (index(keywrd,"GEO_DAT") /= 0) then
+      if (index(keywrd_quoted,"GEO_DAT") /= 0) then
         if (geo_ref_name == job_fn) then
-          i = index(keywrd," GEO_REF") + 11
+          i = index(keywrd_quoted," GEO_REF") + 11
           do
-            if (keywrd(i:i) == '"' .or. keywrd(i:i) == "'") exit
+            if (keywrd_quoted(i:i) == '"' .or. keywrd_quoted(i:i) == "'") exit
             i = i + 1
           end do
-          density = reada(keywrd, i + 1)
+          density = reada(keywrd_quoted, i + 1)
           write(iw,'(/10x,a,f8.3,a)')"A restraining force of",density," kcal/mol/A^2 will be used"
           geoa(:,:numat) = geo(:,:numat)
           ii = numat
@@ -271,17 +253,17 @@ subroutine geo_ref
       goto 97
 99    write(iw,*)" File' "//trim(line)//"' is faulty"
       return
-97    i = index(keywrd," GEO_REF") + 11
+97    i = quoted('GEO_REF=') + 11
       do
-        if (keywrd(i:i) == '"' .or. keywrd(i:i) == "'") exit
+        if (keywrd_quoted(i:i) == '"' .or. keywrd_quoted(i:i) == "'") exit
         i = i + 1
       end do
-      if (keywrd(i + 1: i + 1) == " ") then
+      if (keywrd_quoted(i + 1: i + 1) == " ") then
         if (.not. l_0SCF_HTML .and. index(keywrd, "LOCATE-TS") + index(keywrd, "SADDLE") == 0) &
           write(iw,'(/10x,a)')"By default, no restraining force will be used"
         density = 0.d0
       else
-        density = reada(keywrd, i + 1)
+        density = reada(keywrd_quoted, i + 1)
         write(iw,'(/10x,a,f8.3,a)')"A restraining force of",density," kcal/mol/A^2 will be used"
       end if
       if (id == 3 .and. abs(density) > 1.d-10 .and. index(keywrd, " 0SCF") == 0) then
@@ -348,6 +330,7 @@ subroutine geo_ref
       if (index(keywrd, " 0SCF") == 0 .and. ii /= numat) then
         num = char(ichar("1") +int(log10(ii + 0.05)))
         write(iw,'(/10x,a,i'//num//')')"Number of atoms in """//trim(geo_dat_name)//""" = ", ii
+        num = char(ichar("1") +int(log10(numat + 0.05)))
         write(iw,'(/10x,a,i'//num//')')"Number of atoms in """//trim(geo_ref_name)//""" = ", numat
         call mopend("Number of atoms in both systems must be the same, unless keyword ""0SCF"" is present")
         return

src/input/getdat.F90

@@ -295,8 +295,8 @@ subroutine getdat(input, output)
         if (.not. exists) open(unit=iw, file=trim(jobnam)//'.out')
         if (keywrd /= " ") then
           if (index(keywrd, "++") == 0) &
-          write(iw,'(3/10x,a,/)')" Data set does not contain "//&
-            "any atoms and neither GEO_DAT or SETUP is  present on the keyword line"
+          write(iw,'(3/10x,a,/)') &
+            " Data set does not contain any atoms and neither GEO_DAT or SETUP is present on the keyword line"
         end if
       end if
       keywrd = "  "

src/input/getgeo.F90

@@ -60,7 +60,7 @@ subroutine getgeo(iread, labels, geo, xyz, lopt, na, nb, nc, int)
 !-----------------------------------------------
       integer , dimension(40) :: istart
       integer :: i, icapa, icapz, iserr, k, icomma, khar, nvalue, label, j, ndmy, &
-      jj, ltl, max_atoms, ii
+      jj, ltl, max_atoms, ii, ios
       double precision :: weight, real, sum
       logical :: lxyz, velo, leadsp, ircdrc, saddle, mini, l_gaussian
       character , dimension(107) :: elemnt*2
@@ -157,7 +157,7 @@ subroutine getgeo(iread, labels, geo, xyz, lopt, na, nb, nc, int)
       end if
       ii = 0
    20 continue
-      read (iread, '(A241)', end=120, err=210) line
+      read (iread, '(A241)', iostat=ios, end=120, err=210) line
       if (line == '$coord') go to 20
       if (line == '$end') go to 20
       if (line(1:1) == '*') go to 20
@@ -170,7 +170,7 @@ subroutine getgeo(iread, labels, geo, xyz, lopt, na, nb, nc, int)
           rewind (iread)
           sum = 0.d0
           do i = 1, 10000
-            read (iread, '(A)', end=120, err=210) line
+            read (iread, '(A)', iostat=ios, end=120, err=210) line
             if (index(line, "HEAT OF FORMATION") > 0) sum = reada(line,20)
             if (index(line, "FINAL GEOMETRY OBTAINED") > 0) exit
             if (index(line, "GEOMETRY IN CARTESIAN COORDINATE") > 0) exit
@@ -197,7 +197,7 @@ subroutine getgeo(iread, labels, geo, xyz, lopt, na, nb, nc, int)
             int = (index(keywrd, " INT ") > 0)
             velo = (index(keywrd,' VELO') > 0)
             lmop = (Index (keywrd, " MOPAC") /= 0)
-            read (iread, '(A)', end=120, err=210) line
+            read (iread, '(A)', iostat=ios, end=120, err=210) line
             ii = 3
           else
             natoms = -3
@@ -829,6 +829,8 @@ subroutine getgeo(iread, labels, geo, xyz, lopt, na, nb, nc, int)
       return
 ! ERROR CONDITIONS
   210 continue
+! gfortran flags all EOF reads past the first one as a 5001 error, and MOPAC doesn't avoid this behavior at the moment
+      if (ios == 5001) goto 120
       j = natoms - 1
       write (iw, '('' DATA CURRENTLY READ IN ARE: '',/)')
       do k = 1, j