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

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

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


Revision 1.2 - (show annotations) (download)
Sat Feb 23 04:24:42 2013 UTC (6 years, 8 months 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 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, 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 #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 function cp_fNumber()
134 integer cp_fNumber
135 cp_fNumber=cp_file_number
136 end function
137
138 end module

  ViewVC Help
Powered by ViewVC 1.1.22