/[MITgcm]/MITgcm/tools/OAD_support/OAD_cp.F90
ViewVC logotype

Annotation of /MITgcm/tools/OAD_support/OAD_cp.F90

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.2 - (hide annotations) (download)
Sat Feb 23 04:24:42 2013 UTC (11 years, 1 month ago) by utke
Branch: MAIN
CVS Tags: checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64o, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint64n, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint64e, checkpoint64g, checkpoint64f, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65o, checkpoint65l, checkpoint65m, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, checkpoint64i, checkpoint64h, checkpoint64k, checkpoint65, checkpoint64j, checkpoint64m, checkpoint64l, HEAD
Changes since 1.1: +27 -2 lines
revolve loop

1 heimbach 1.1 module OAD_cp
2    
3     implicit none
4    
5     private :: cp_file_number, cp_open
6    
7 utke 1.2 public :: cp_io_unit, cp_init, cp_write_open, cp_read_open, cp_close, cp_fNumber
8 heimbach 1.1
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 utke 1.2 module procedure write_openX_i
22 heimbach 1.1 end interface
23    
24     interface cp_read_open
25     module procedure read_open_i
26 utke 1.2 module procedure read_openX_i
27 heimbach 1.1 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 utke 1.2
37 heimbach 1.1 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 utke 1.2 ! print *, 'writing ', cp_file_number
48 heimbach 1.1 cp_file_number=cp_file_number+1
49     end subroutine
50    
51 utke 1.2 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 heimbach 1.1 subroutine read_open_i()
60     implicit none
61     cp_file_number=cp_file_number-1
62 utke 1.2 ! 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 heimbach 1.1 call cp_open()
72     end subroutine
73    
74     subroutine open_i()
75     implicit none
76     #ifdef ALLOW_USE_MPI
77     include "mpif.h"
78     #endif
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     #ifdef ALLOW_USE_MPI
87     call mpi_comm_rank(MPI_COMM_WORLD,rank, mpirc)
88     #endif
89     write(fname,'(A,I3.3,A,I5.5)') 'oad_cp.',rank,'.',cp_file_number
90     open( UNIT=cp_io_unit,FILE=TRIM(fname),FORM='unformatted',STATUS='UNKNOWN' )
91     end subroutine
92    
93     subroutine close_i()
94     implicit none
95     close( UNIT=cp_io_unit)
96     end subroutine
97    
98     subroutine findunit_i()
99     ! returns a valid, unused unit number for Fortran I/O
100     ! the routine stops the program if an error occurs in the process
101     ! of searching the I/O channels.
102     implicit none
103     ! Local
104     integer ii
105     logical op
106     integer ios
107     character*(1024) msgbuf
108     ! Sweep through a valid range of unit numbers
109     cp_io_unit=-1
110     do ii=9,999
111     if (cp_io_unit.eq.-1) then
112     inquire(unit=ii,iostat=ios,opened=op)
113     if (ios.ne.0) then
114     write(msgbuf,'(a,i2.2)') 'OAD_cp:findunit_i: inquiring unit number = ',ii
115     print *, msgBuf
116     write(msgbuf,'(a)') 'OAD_cp:findunit_i: inquire statement failed!'
117     print *, msgBuf
118     stop 'ABNORMAL END: S/R OAD_cp:findunit_i'
119     endif
120     if (.NOT. op) then
121     cp_io_unit=ii
122     end if
123     end if
124     end do
125     ! Was there an available unit number
126     if (cp_io_unit.eq.-1) then
127     write(msgbuf,'(a)') 'OAD_cp:findunit_i: could not find an available unit number!'
128     print *, msgBuf
129     stop 'ABNORMAL END: S/R OAD_cp:findunit_i'
130     endif
131     end subroutine
132    
133 utke 1.2 function cp_fNumber()
134     integer cp_fNumber
135     cp_fNumber=cp_file_number
136     end function
137    
138 heimbach 1.1 end module

  ViewVC Help
Powered by ViewVC 1.1.22