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