OpenAD/code_shallow_openad3/OpenAD_checkpoints.f90

! $Header: /u/gcmpack/MITgcm_contrib/heimbach/OpenAD/code_shallow_openad3/OpenAD_checkpoints.f90,v 1.3 2007/01/14 22:41:38 utke Exp $
module OpenAD_checkpoints

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