OpenAD/code_shallow_openad2/OpenAD_checkpoints.f90

! $Header: $
module OpenAD_checkpoints

  implicit none

  private :: cp_file_number

  public :: cp_io_unit,  cp_init, cp_open, cp_close

  integer :: cp_file_number, cp_io_unit

  interface cp_init
     module procedure init_i
  end interface

  interface cp_open
     module procedure open_i
  end interface

  interface cp_close
     module procedure close_i
  end interface

  interface cp_findunit
     module procedure findunit_i
  end interface

contains

  subroutine init_i
    implicit none
    cp_file_number=1
  end subroutine

  subroutine open_i()
    implicit none
    character*128 fname ! file name
    ! get unit
    call cp_findunit()
    ! print *, 'JU: opening CP file ', cp_file_number
    ! construct the file name
    write(fname,'(A,I20.20)') 'openad_checkpoint_',cp_file_number
    open( UNIT=cp_io_unit,FILE=TRIM(fname),FORM='binary',STATUS='UNKNOWN' )
  end subroutine 

  subroutine close_i()
    implicit none
    close( UNIT=cp_io_unit)
  end subroutine

  subroutine findunit_i()
    ! returns a valid, unused unit number for Fortran I/O
    ! the routine stops the program if an error occurs in the process
    ! of searching the I/O channels.
    implicit none
    ! Local
    integer ii
    logical op
    integer ios
    character*(1024) msgbuf
    ! Sweep through a valid range of unit numbers
    cp_io_unit=-1
    do ii=9,999
       if (cp_io_unit.eq.-1) then
          inquire(unit=ii,iostat=ios,opened=op)
          if (ios.ne.0) then
             write(msgbuf,'(a,i2.2)')  'OpenAD_checkpoints:findunit_i: inquiring unit number = ',ii
             print *, msgBuf
             write(msgbuf,'(a)') 'OpenAD_checkpoints:findunit_i: inquire statement failed!'
             print *, msgBuf
             stop 'ABNORMAL END: S/R OpenAD_checkpoints:findunit_i'
          endif
          if (.NOT. op) then
             cp_io_unit=ii
          end if
       end if
    end do
    ! Was there an available unit number
    if (cp_io_unit.eq.-1) then
       write(msgbuf,'(a)')  'OpenAD_checkpoints:findunit_i: could not find an available unit number!'
       print *, msgBuf
       stop 'ABNORMAL END: S/R OpenAD_checkpoints:findunit_i'
    endif
  end subroutine

end module OpenAD_checkpoints
1	utke	1.5	! $Header: $
2	utke	1.1	module OpenAD_checkpoints
3
4			implicit none
5
6	utke	1.5	private :: cp_file_number
7	utke	1.1
8	utke	1.5	public :: cp_io_unit, cp_init, cp_open, cp_close
9	utke	1.1
10	utke	1.5	integer :: cp_file_number, cp_io_unit
11	utke	1.1
12			interface cp_init
13	utke	1.5	module procedure init_i
14			end interface
15	utke	1.1
16	utke	1.2	interface cp_open
17	utke	1.5	module procedure open_i
18			end interface
19	utke	1.2
20			interface cp_close
21	utke	1.5	module procedure close_i
22			end interface
23	utke	1.2
24			interface cp_findunit
25	utke	1.5	module procedure findunit_i
26	utke	1.2	end interface
27
28	utke	1.1	contains
29
30	utke	1.5	subroutine init_i
31			implicit none
32	utke	1.2	cp_file_number=1
33	utke	1.5	end subroutine
34	utke	1.2
35	utke	1.5	subroutine open_i()
36			implicit none
37			character*128 fname ! file name
38			! get unit
39			call cp_findunit()
40			! print *, 'JU: opening CP file ', cp_file_number
41			! construct the file name
42			write(fname,'(A,I20.20)') 'openad_checkpoint_',cp_file_number
43			open( UNIT=cp_io_unit,FILE=TRIM(fname),FORM='binary',STATUS='UNKNOWN' )
44			end subroutine
45
46			subroutine close_i()
47			implicit none
48			close( UNIT=cp_io_unit)
49			end subroutine
50
51			subroutine findunit_i()
52			! returns a valid, unused unit number for Fortran I/O
53			! the routine stops the program if an error occurs in the process
54			! of searching the I/O channels.
55			implicit none
56			! Local
57			integer ii
58			logical op
59			integer ios
60			character*(1024) msgbuf
61			! Sweep through a valid range of unit numbers
62			cp_io_unit=-1
63			do ii=9,999
64			if (cp_io_unit.eq.-1) then
65	utke	1.2	inquire(unit=ii,iostat=ios,opened=op)
66			if (ios.ne.0) then
67	utke	1.5	write(msgbuf,'(a,i2.2)') 'OpenAD_checkpoints:findunit_i: inquiring unit number = ',ii
68			print *, msgBuf
69			write(msgbuf,'(a)') 'OpenAD_checkpoints:findunit_i: inquire statement failed!'
70			print *, msgBuf
71			stop 'ABNORMAL END: S/R OpenAD_checkpoints:findunit_i'
72	utke	1.2	endif
73			if (.NOT. op) then
74	utke	1.5	cp_io_unit=ii
75			end if
76			end if
77			end do
78			! Was there an available unit number
79			if (cp_io_unit.eq.-1) then
80			write(msgbuf,'(a)') 'OpenAD_checkpoints:findunit_i: could not find an available unit number!'
81			print *, msgBuf
82			stop 'ABNORMAL END: S/R OpenAD_checkpoints:findunit_i'
83			endif
84			end subroutine
85	utke	1.2
86	utke	1.1	end module OpenAD_checkpoints