OpenAD/OAD_support/OAD_cp.f90

module OAD_cp

  implicit none

  private :: cp_file_number, cp_open

  public :: cp_io_unit,  cp_init, cp_write_open, cp_read_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_write_open
     module procedure write_open_i
  end interface

  interface cp_read_open
     module procedure read_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 write_open_i()
    implicit none
    call cp_open()
    cp_file_number=cp_file_number+1
  end subroutine 

  subroutine read_open_i()
    implicit none
    cp_file_number=cp_file_number-1
    call cp_open()
  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='unformatted',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)')  'OAD_cp:findunit_i: inquiring unit number = ',ii
             print *, msgBuf
             write(msgbuf,'(a)') 'OAD_cp:findunit_i: inquire statement failed!'
             print *, msgBuf
             stop 'ABNORMAL END: S/R OAD_cp: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)')  'OAD_cp:findunit_i: could not find an available unit number!'
       print *, msgBuf
       stop 'ABNORMAL END: S/R OAD_cp:findunit_i'
    endif
  end subroutine

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