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 |
#ifdef ALLOW_USE_MPI |
57 |
include "mpif.h" |
58 |
#endif |
59 |
integer rank, mpirc |
60 |
character*128 fname ! file name |
61 |
! get unit |
62 |
rank=0 |
63 |
call cp_findunit() |
64 |
! print *, 'OAD: opening CP file ', cp_file_number |
65 |
! construct the file name |
66 |
#ifdef ALLOW_USE_MPI |
67 |
call mpi_comm_rank(MPI_COMM_WORLD,rank, mpirc) |
68 |
#endif |
69 |
write(fname,'(A,I3.3,A,I5.5)') 'oad_cp.',rank,'.',cp_file_number |
70 |
open( UNIT=cp_io_unit,FILE=TRIM(fname),FORM='unformatted',STATUS='UNKNOWN' ) |
71 |
end subroutine |
72 |
|
73 |
subroutine close_i() |
74 |
implicit none |
75 |
close( UNIT=cp_io_unit) |
76 |
end subroutine |
77 |
|
78 |
subroutine findunit_i() |
79 |
! returns a valid, unused unit number for Fortran I/O |
80 |
! the routine stops the program if an error occurs in the process |
81 |
! of searching the I/O channels. |
82 |
implicit none |
83 |
! Local |
84 |
integer ii |
85 |
logical op |
86 |
integer ios |
87 |
character*(1024) msgbuf |
88 |
! Sweep through a valid range of unit numbers |
89 |
cp_io_unit=-1 |
90 |
do ii=9,999 |
91 |
if (cp_io_unit.eq.-1) then |
92 |
inquire(unit=ii,iostat=ios,opened=op) |
93 |
if (ios.ne.0) then |
94 |
write(msgbuf,'(a,i2.2)') 'OAD_cp:findunit_i: inquiring unit number = ',ii |
95 |
print *, msgBuf |
96 |
write(msgbuf,'(a)') 'OAD_cp:findunit_i: inquire statement failed!' |
97 |
print *, msgBuf |
98 |
stop 'ABNORMAL END: S/R OAD_cp:findunit_i' |
99 |
endif |
100 |
if (.NOT. op) then |
101 |
cp_io_unit=ii |
102 |
end if |
103 |
end if |
104 |
end do |
105 |
! Was there an available unit number |
106 |
if (cp_io_unit.eq.-1) then |
107 |
write(msgbuf,'(a)') 'OAD_cp:findunit_i: could not find an available unit number!' |
108 |
print *, msgBuf |
109 |
stop 'ABNORMAL END: S/R OAD_cp:findunit_i' |
110 |
endif |
111 |
end subroutine |
112 |
|
113 |
end module |