1 |
heimbach |
1.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 |