tools/OAD_support/OAD_regular_cp.F90

module OAD_regular_cp

  implicit none

  private :: cp_file_number, cp_open

  public :: cp_io_unit, cp_init, cp_write_open, cp_read_open, cp_close, cp_fNumber

  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
     module procedure write_openX_i
  end interface

  interface cp_read_open
     module procedure read_open_i
     module procedure read_openX_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()
!    print *, 'writing ', cp_file_number
    cp_file_number=cp_file_number+1
  end subroutine 

  subroutine write_openX_i(X)
    implicit none
    integer X
    cp_file_number=X
!    print *, 'writing ', cp_file_number
    call cp_open()
  end subroutine 

  subroutine read_open_i()
    implicit none
    cp_file_number=cp_file_number-1
!    print *, 'reading ', cp_file_number
    call cp_open()
  end subroutine 

  subroutine read_openX_i(X)
    implicit none
    integer X
    cp_file_number=X
!    print *, 'reading ', cp_file_number
    call cp_open()
  end subroutine 

  subroutine open_i()
    implicit none


    integer rank, mpirc
    character*128 fname ! file name
    ! get unit
    rank=0
    call cp_findunit()
!    print *, 'OAD: opening CP file ', cp_file_number
    ! construct the file name


    write(fname,'(A,I3.3,A,I5.5)') 'oad_reg_cp.',rank,'.',cp_file_number
    open( UNIT=cp_io_unit,FILE=TRIM(fname),FORM='unformatted',STATUS='UNKNOWN' )
    !open( UNIT=cp_io_unit,FILE=TRIM(fname),FORM='formatted',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_regular_cp:findunit_i: inquiring unit number = ',ii
             print *, msgBuf
             write(msgbuf,'(a)') 'OAD_regular_cp:findunit_i: inquire statement failed!'
             print *, msgBuf
             stop 'ABNORMAL END: S/R OAD_regular_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_regular_cp:findunit_i: could not find an available unit number!'
       print *, msgBuf
       stop 'ABNORMAL END: S/R OAD_regular_cp:findunit_i'
    endif
  end subroutine

  function cp_fNumber()
    integer cp_fNumber
    cp_fNumber=cp_file_number
  end function 

end module 
1	module OAD_regular_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, cp_fNumber
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	module procedure write_openX_i
22	end interface
23
24	interface cp_read_open
25	module procedure read_open_i
26	module procedure read_openX_i
27	end interface
28
29	interface cp_close
30	module procedure close_i
31	end interface
32
33	interface cp_findunit
34	module procedure findunit_i
35	end interface
36
37	contains
38
39	subroutine init_i
40	implicit none
41	cp_file_number=1
42	end subroutine
43
44	subroutine write_open_i()
45	implicit none
46	call cp_open()
47	! print *, 'writing ', cp_file_number
48	cp_file_number=cp_file_number+1
49	end subroutine
50
51	subroutine write_openX_i(X)
52	implicit none
53	integer X
54	cp_file_number=X
55	! print *, 'writing ', cp_file_number
56	call cp_open()
57	end subroutine
58
59	subroutine read_open_i()
60	implicit none
61	cp_file_number=cp_file_number-1
62	! print *, 'reading ', cp_file_number
63	call cp_open()
64	end subroutine
65
66	subroutine read_openX_i(X)
67	implicit none
68	integer X
69	cp_file_number=X
70	! print *, 'reading ', cp_file_number
71	call cp_open()
72	end subroutine
73
74	subroutine open_i()
75	implicit none
76
77
78
79	integer rank, mpirc
80	character*128 fname ! file name
81	! get unit
82	rank=0
83	call cp_findunit()
84	! print *, 'OAD: opening CP file ', cp_file_number
85	! construct the file name
86
87
88
89	write(fname,'(A,I3.3,A,I5.5)') 'oad_reg_cp.',rank,'.',cp_file_number
90	open( UNIT=cp_io_unit,FILE=TRIM(fname),FORM='unformatted',STATUS='UNKNOWN' )
91	!open( UNIT=cp_io_unit,FILE=TRIM(fname),FORM='formatted',STATUS='UNKNOWN' )
92	end subroutine
93
94	subroutine close_i()
95	implicit none
96	close( UNIT=cp_io_unit)
97	end subroutine
98
99	subroutine findunit_i()
100	! returns a valid, unused unit number for Fortran I/O
101	! the routine stops the program if an error occurs in the process
102	! of searching the I/O channels.
103	implicit none
104	! Local
105	integer ii
106	logical op
107	integer ios
108	character*(1024) msgbuf
109	! Sweep through a valid range of unit numbers
110	cp_io_unit=-1
111	do ii=9,999
112	if (cp_io_unit.eq.-1) then
113	inquire(unit=ii,iostat=ios,opened=op)
114	if (ios.ne.0) then
115	write(msgbuf,'(a,i2.2)') 'OAD_regular_cp:findunit_i: inquiring unit number = ',ii
116	print *, msgBuf
117	write(msgbuf,'(a)') 'OAD_regular_cp:findunit_i: inquire statement failed!'
118	print *, msgBuf
119	stop 'ABNORMAL END: S/R OAD_regular_cp:findunit_i'
120	endif
121	if (.NOT. op) then
122	cp_io_unit=ii
123	end if
124	end if
125	end do
126	! Was there an available unit number
127	if (cp_io_unit.eq.-1) then
128	write(msgbuf,'(a)') 'OAD_regular_cp:findunit_i: could not find an available unit number!'
129	print *, msgBuf
130	stop 'ABNORMAL END: S/R OAD_regular_cp:findunit_i'
131	endif
132	end subroutine
133
134	function cp_fNumber()
135	integer cp_fNumber
136	cp_fNumber=cp_file_number
137	end function
138
139	end module