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

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

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


Revision 1.1 - (hide annotations) (download)
Fri Jul 3 21:33:55 2015 UTC (8 years, 8 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65n, checkpoint65o, HEAD
Merge and update from Krishna Narayanan's contrib area:
o genmake2 flag -diva (but only for OpenAD)
o required modifs for OAD_support

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

  ViewVC Help
Powered by ViewVC 1.1.22