Add iostat check (#37)

* Change function name from test_h2o to test_h2

* fix: exit was required when the end of file is reached.

* Remove builtin open in files except ivo

* Refactored to avoid warnings other than ‘is_in_range_real’ defined but not used ( gfortan)

* Remove unused label (line number)

* Add check_iostat

src/casci_ty.f90

@@ -160,4 +160,4 @@ FUNCTION comb(n, m) RESULT(res)
     End do
 
     res = j
-1000 end function comb
+end function comb

src/create_binmdcint.f90

@@ -23,7 +23,7 @@ Subroutine create_newmdcint ! 2 Electorn Integrals In Mdcint
     integer :: nnkr, iiit, jjjt, kkkt, lllt
     integer :: nkr, nz, file_idx, iostat
     integer :: mdcint_unit, mdcintnew_unit
-    logical :: is_file_exist
+    logical :: is_file_exist, is_end_of_file
 
     mdcint_unit = default_unit; mdcintnew_unit = default_unit
     Call timing(date1, tsec1, date0, tsec0)
@@ -121,16 +121,9 @@ Subroutine create_newmdcint ! 2 Electorn Integrals In Mdcint
                     (rklr(inz), rkli(inz), inz=1, nz)
             end if
 
-            ! iostat is less than 0 if end-of-file is reached.
-            if (iostat < 0) then
-                if (rank == 0) print *, "end-of-file reached."
+            call check_iostat(iostat=iostat, file=mdcint_filename, end_of_file_reached=is_end_of_file)
+            if (is_end_of_file) then
                 exit mdcint_file_read
-            else if (iostat > 0) then
-                if (rank == 0) then
-                    ! Error in reading 2-electron integrals.
-                    print *, "error in reading 2-electron integrals. Filename", mdcint_filename
-                end if
-                stop
             end if
 
 !------------------------------!

src/diag.f90

@@ -75,7 +75,6 @@ SUBROUTINE rdiag(sr, dimn, dimm, w, thresd, cutoff)
         dimm = dimn
     end if
 
-1000 continue
 end subroutine rdiag
 
 ! +=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=+=

src/e0after_tra_ty.f90

@@ -162,7 +162,7 @@ SUBROUTINE e0aftertra_ty
 
                 oneeff = oneeff - cmplxint
 
-300         end do           ! k
+            end do           ! k
 
             Call tramo1_ty(i, j, cmplxint)
 
@@ -277,7 +277,7 @@ SUBROUTINE e0aftertra_ty
 
                     end if
 
-100             end do        ! l
+                end do        ! l
             end do    ! k
         end do       ! j
     end do          ! i
@@ -323,7 +323,6 @@ SUBROUTINE e0aftertra_ty
     if (rank == 0) then  ! Only master ranks are allowed to create files used by CASPT2 except for MDCINTNEW.
         close (e0after_unit)
     end if
-1000 continue
     deallocate (energy)
     print *, 'e0aftertra end'
 End subroutine e0aftertra_ty
@@ -522,7 +521,7 @@ SUBROUTINE e0aftertrac_ty
 
                 oneeff = oneeff - cmplxint
 
-300         end do           ! k
+            end do           ! k
 
             Call tramo1_ty(i, j, cmplxint)
 
@@ -637,7 +636,7 @@ SUBROUTINE e0aftertrac_ty
 
                     end if
 
-100             end do        ! l
+                end do        ! l
             end do    ! k
         end do       ! j
     end do          ! i
@@ -694,9 +693,6 @@ SUBROUTINE e0aftertrac_ty
     if (rank == 0) then ! Only master ranks are allowed to create files used by CASPT2 except for MDCINTNEW.
         close (e0after_unit)
     end if
-1000 continue
     deallocate (energy)
-!      print *,'e0aftertrac end'
-! Iwamuro modify
     if (rank == 0) print *, 'e0aftertrac_ty end'
 End subroutine e0aftertrac_ty

src/intra.f90

@@ -15,6 +15,7 @@ SUBROUTINE intra_1(spi, spj, spk, spl, fname)
 #endif
     integer, intent(in)        :: spi, spj, spk, spl
     character(50), intent(in)    :: fname
+    logical :: is_end_of_file
 
     integer                 :: unit
     integer, allocatable    :: indsym(:, :, :), nsym(:, :)
@@ -78,14 +79,9 @@ SUBROUTINE intra_1(spi, spj, spk, spl, fname)
     call open_unformatted_file(unit=unit, file=trim(fname), status='old', optional_action='read')
     do
         read (unit, iostat=iostat) i, j, k, l, cint2
-        ! Exit the loop if the end of the file is reached
-        if (iostat < 0) then
-            if (rank == 0) print *, 'End of the first index integral transformation '//trim(fname)
+        call check_iostat(iostat=iostat, file=trim(fname), end_of_file_reached=is_end_of_file)
+        if (is_end_of_file) then
             exit
-        elseif (iostat > 0) then
-            ! If iostat is greater than 0, error detected in the input file, so exit the program
-            print *, "Error : Error in reading file ", trim(fname)
-            stop
         end if
 
         isym = irpmo(l)
@@ -129,14 +125,9 @@ SUBROUTINE intra_1(spi, spj, spk, spl, fname)
     call open_unformatted_file(unit=unit, file=trim(fname), status='old', optional_action='read')
     do
         read (unit, iostat=iostat) i, j, k, l, cint2
-        ! Exit the loop if the end of the file is reached
-        if (iostat < 0) then
-            if (rank == 0) print *, 'End of the second index integral transformation '//trim(fname)
+        call check_iostat(iostat=iostat, file=trim(fname), end_of_file_reached=is_end_of_file)
+        if (is_end_of_file) then
             exit
-        elseif (iostat > 0) then
-            ! If iostat is greater than 0, error detected in the input file, so exit the program
-            print *, "Error : Error in reading file ", trim(fname)
-            stop
         end if
         isym = irpmo(k)
 
@@ -170,14 +161,9 @@ SUBROUTINE intra_1(spi, spj, spk, spl, fname)
     call open_unformatted_file(unit=unit, file=trim(fname), status='old', optional_action='read')
     do
         read (unit, iostat=iostat) i, j, k, l, cint2
-        ! Exit the loop if the end of the file is reached
-        if (iostat < 0) then
-            if (rank == 0) print *, 'End of the third index integral transformation '//trim(fname)
+        call check_iostat(iostat=iostat, file=trim(fname), end_of_file_reached=is_end_of_file)
+        if (is_end_of_file) then
             exit
-        elseif (iostat > 0) then
-            ! If iostat is greater than 0, error detected in the input file, so exit the program
-            print *, "Error : Error in reading file ", trim(fname)
-            stop
         end if
         isym = irpmo(j)
 
@@ -211,14 +197,9 @@ SUBROUTINE intra_1(spi, spj, spk, spl, fname)
     call open_unformatted_file(unit=unit, file=trim(fname), status='old', optional_action='read')
     do
         read (unit, iostat=iostat) i, j, k, l, cint2
-        ! Exit the loop if the end of the file is reached
-        if (iostat < 0) then
-            if (rank == 0) print *, 'End of the fourth index integral transformation  '//trim(fname)
+        call check_iostat(iostat=iostat, file=trim(fname), end_of_file_reached=is_end_of_file)
+        if (is_end_of_file) then
             exit
-        elseif (iostat > 0) then
-            ! If iostat is greater than 0, error detected in the input file, so exit the program
-            print *, "Error : Error in reading file ", trim(fname)
-            stop
         end if
         isym = irpmo(i)
 
@@ -266,6 +247,7 @@ SUBROUTINE intra_2(spi, spj, spk, spl, fname)
 #endif
     integer, intent(in)        :: spi, spj, spk, spl
     character(50), intent(in)    :: fname
+    logical :: is_end_of_file
 
     integer                 :: unit = 20
     integer, allocatable    :: indsym(:, :, :), nsym(:, :)
@@ -333,14 +315,9 @@ SUBROUTINE intra_2(spi, spj, spk, spl, fname)
     call open_unformatted_file(unit=unit, file=trim(fname), status='old', optional_action='read')
     do
         read (unit, iostat=iostat) i, j, k, l, cint2
-        ! Exit the loop if the end of the file is reached
-        if (iostat < 0) then
-            if (rank == 0) print *, 'End of the first index integral transformation '//trim(fname)
+        call check_iostat(iostat=iostat, file=trim(fname), end_of_file_reached=is_end_of_file)
+        if (is_end_of_file) then
             exit
-        elseif (iostat > 0) then
-            ! If iostat is greater than 0, error detected in the input file, so exit the program
-            print *, "Error : Error in reading file ", trim(fname)
-            stop
         end if
         isym = irpmo(l)
 
@@ -423,14 +400,9 @@ SUBROUTINE intra_2(spi, spj, spk, spl, fname)
     do
 
         read (unit, iostat=iostat) i, j, k, l, cint2
-        ! Exit the loop if the end of the file is reached
-        if (iostat < 0) then
-            if (rank == 0) print *, 'End of the second index integral transformation '//trim(fname)
+        call check_iostat(iostat=iostat, file=trim(fname), end_of_file_reached=is_end_of_file)
+        if (is_end_of_file) then
             exit
-        elseif (iostat > 0) then
-            ! If iostat is greater than 0, error detected in the input file, so exit the program
-            print *, "Error : Error in reading file ", trim(fname)
-            stop
         end if
 
         isym = irpmo(k)
@@ -465,14 +437,9 @@ SUBROUTINE intra_2(spi, spj, spk, spl, fname)
     call open_unformatted_file(unit=unit, file=trim(fname), status='old', optional_action='read')
     do
         read (unit, iostat=iostat) i, j, k, l, cint2
-! Exit the loop if the end of the file is reached
-        if (iostat < 0) then
-            if (rank == 0) print *, 'End of the third index integral transformation '//trim(fname)
+        call check_iostat(iostat=iostat, file=trim(fname), end_of_file_reached=is_end_of_file)
+        if (is_end_of_file) then
             exit
-        elseif (iostat > 0) then
-            ! If iostat is greater than 0, error detected in the input file, so exit the program
-            print *, "Error : Error in reading file ", trim(fname)
-            stop
         end if
 
         isym = irpmo(j)
@@ -507,15 +474,9 @@ SUBROUTINE intra_2(spi, spj, spk, spl, fname)
     call open_unformatted_file(unit=unit, file=trim(fname), status='old', optional_action='read')
     do
         read (unit, iostat=iostat) i, j, k, l, cint2
-
-        ! Exit the loop if the end of the file is reached
-        if (iostat < 0) then
-            if (rank == 0) print *, 'End of the fourth index integral transformation '//trim(fname)
+        call check_iostat(iostat=iostat, file=trim(fname), end_of_file_reached=is_end_of_file)
+        if (is_end_of_file) then
             exit
-        elseif (iostat > 0) then
-            ! If iostat is greater than 0, error detected in the input file, so exit the program
-            print *, "Error : Error in reading file ", trim(fname)
-            stop
         end if
 
         isym = irpmo(i)
@@ -563,6 +524,7 @@ SUBROUTINE intra_3(spi, spj, spk, spl, fname)
 #endif
     integer, intent(in)        :: spi, spj, spk, spl
     character(50), intent(in)    :: fname
+    logical :: is_end_of_file
 
     integer                 :: unit = 20
     integer, allocatable    :: indsym(:, :, :), nsym(:, :)
@@ -633,15 +595,9 @@ SUBROUTINE intra_3(spi, spj, spk, spl, fname)
     call open_unformatted_file(unit=unit, file=trim(fname), status='old', optional_action='read')
     do
         read (unit, iostat=iostat) i, j, k, l, cint2
-
-        ! Exit the loop if the end of the file is reached
-        if (iostat < 0) then
-            if (rank == 0) print *, 'End of the first index integral transformation '//trim(fname)
+        call check_iostat(iostat=iostat, file=trim(fname), end_of_file_reached=is_end_of_file)
+        if (is_end_of_file) then
             exit
-        elseif (iostat > 0) then
-            ! If iostat is greater than 0, error detected in the input file, so exit the program
-            print *, "Error : Error in reading file ", trim(fname)
-            stop
         end if
 
         ! save initial indices i,j,k,l to initial_i,initial_j,initial_k,initial_l, respectively.
@@ -716,15 +672,9 @@ SUBROUTINE intra_3(spi, spj, spk, spl, fname)
     call open_unformatted_file(unit=unit, file=trim(fname), status='old', optional_action='read')
     do
         read (unit, iostat=iostat) i, j, k, l, cint2
-
-        ! Exit the loop if the end of the file is reached
-        if (iostat < 0) then
-            if (rank == 0) print *, 'End of the second index integral transformation '//trim(fname)
+        call check_iostat(iostat=iostat, file=trim(fname), end_of_file_reached=is_end_of_file)
+        if (is_end_of_file) then
             exit
-        elseif (iostat > 0) then
-            ! If iostat is greater than 0, error detected in the input file, so exit the program
-            print *, "Error : Error in reading file ", trim(fname)
-            stop
         end if
 
         isym = irpamo(k)
@@ -759,15 +709,9 @@ SUBROUTINE intra_3(spi, spj, spk, spl, fname)
     call open_unformatted_file(unit=unit, file=trim(fname), status='old', optional_action='read')
     do
         read (unit, iostat=iostat) i, j, k, l, cint2
-
-        ! Exit the loop if the end of the file is reached
-        if (iostat < 0) then
-            if (rank == 0) print *, 'End of third index integral transformation '//trim(fname)
+        call check_iostat(iostat=iostat, file=trim(fname), end_of_file_reached=is_end_of_file)
+        if (is_end_of_file) then
             exit
-        elseif (iostat > 0) then
-            ! If iostat is greater than 0, error detected in the input file, so exit the program
-            print *, "Error : Error in reading file ", trim(fname)
-            stop
         end if
 
         isym = irpamo(j)
@@ -802,15 +746,9 @@ SUBROUTINE intra_3(spi, spj, spk, spl, fname)
     call open_unformatted_file(unit=unit, file=trim(fname), status='old', optional_action='read')
     do
         read (unit, iostat=iostat) i, j, k, l, cint2
-
-        ! Exit the loop if the end of the file is reached
-        if (iostat < 0) then
-            if (rank == 0) print *, 'End of the fourth index integral transformation '//trim(fname)
+        call check_iostat(iostat=iostat, file=trim(fname), end_of_file_reached=is_end_of_file)
+        if (is_end_of_file) then
             exit
-        elseif (iostat > 0) then
-            ! If iostat is greater than 0, error detected in the input file, so exit the program
-            print *, "Error : Error in reading file ", trim(fname)
-            stop
         end if
 
         isym = irpamo(i)