/[MITgcm]/MITgcm/pkg/mnc/mnc_cw_citer.F
ViewVC logotype

Contents of /MITgcm/pkg/mnc/mnc_cw_citer.F

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

Revision 1.2 - (show annotations) (download)
Wed Sep 14 19:27:31 2005 UTC (18 years, 8 months ago) by edhill
Branch: MAIN
CVS Tags: checkpoint58l_post, checkpoint57t_post, checkpoint58e_post, checkpoint57v_post, checkpoint58u_post, checkpoint58w_post, checkpoint57s_post, checkpoint58r_post, checkpoint57y_post, checkpoint58n_post, checkpoint58x_post, checkpoint58t_post, checkpoint58h_post, checkpoint57y_pre, checkpoint58q_post, checkpoint59q, checkpoint59p, checkpoint58j_post, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint59c, checkpoint59b, checkpoint59m, checkpoint59l, checkpoint59o, checkpoint59n, checkpoint59i, checkpoint59h, checkpoint59k, checkpoint59j, checkpoint59, checkpoint58, checkpoint58f_post, checkpoint57x_post, checkpoint58d_post, checkpoint58c_post, checkpoint57w_post, checkpint57u_post, checkpoint58a_post, checkpoint58i_post, checkpoint58g_post, checkpoint58o_post, checkpoint57z_post, checkpoint58y_post, checkpoint58k_post, checkpoint58v_post, checkpoint58s_post, checkpoint58p_post, checkpoint58b_post, checkpoint58m_post
Changes since 1.1: +19 -2 lines 
 o fix an mnc_filefreq mistake
1 C $Header: /u/gcmpack/MITgcm/pkg/mnc/mnc_cw_citer.F,v 1.1 2005/09/10 18:30:07 edhill Exp $
2 C $Name: $
3
4 #include "MNC_OPTIONS.h"
5
6 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7
8 CBOP 0
9 C !ROUTINE: MNC_CW_CITER_SETG
10
11 C !INTERFACE:
12 SUBROUTINE MNC_CW_CITER_SETG(
13 I igroup,
14 I iflag, ival_curr, ival_next,
15 I myThid )
16
17 C !DESCRIPTION:
18 C Set CITER information for group "igroup"
19
20 C !USES:
21 implicit none
22 #include "mnc_common.h"
23
24 C !INPUT PARAMETERS:
25 integer igroup, iflag, ival_curr, ival_next, myThid
26 CEOP
27
28 C !LOCAL VARIABLES:
29 integer i
30
31 mnc_cw_cit(1,igroup) = iflag
32 IF ( ival_curr .GT. 0 ) THEN
33
34 IF ( mnc_cw_cit(2,igroup) .NE. ival_curr ) THEN
35
36 C The current iteration number has changed so we need to reset
37 C the unlimited dimension for all the files in this citer group
38 DO i = 1,MNC_MAX_ID
39 IF ( mnc_cw_fgci(i) .eq. igroup ) THEN
40 mnc_cw_fgud(i) = 0
41 ENDIF
42 ENDDO
43
44 mnc_cw_cit(2,igroup) = ival_curr
45
46 ENDIF
47
48 ENDIF
49 IF ( ival_next .GT. 0 ) THEN
50 mnc_cw_cit(3,igroup) = ival_next
51 ENDIF
52
53 RETURN
54 END
55
56 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
57
58 CBOP 0
59 C !ROUTINE: MNC_CW_CITER_GETG
60
61 C !INTERFACE:
62 SUBROUTINE MNC_CW_CITER_GETG(
63 I igroup,
64 O iflag, ival_curr, ival_next,
65 I myThid )
66
67 C !DESCRIPTION:
68 C Get the current CITER information for group "igroup"
69
70 C !USES:
71 implicit none
72 #include "mnc_common.h"
73
74 C !INPUT PARAMETERS:
75 integer igroup, iflag, ival_curr, ival_next, myThid
76 CEOP
77
78 iflag = mnc_cw_cit(1,igroup)
79 ival_curr = mnc_cw_cit(2,igroup)
80 ival_next = mnc_cw_cit(3,igroup)
81
82 RETURN
83 END
84
85 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
86
87 CBOP 0
88 C !ROUTINE: MNC_CW_SET_CITER
89
90 C !INTERFACE:
91 SUBROUTINE MNC_CW_SET_CITER(
92 I fgname,
93 I igroup,
94 I iflag, ival_curr, ival_next,
95 I myThid )
96
97 C !DESCRIPTION:
98 C Set the flag and/or current iteration value
99
100 C !USES:
101 implicit none
102 #include "mnc_common.h"
103 #include "EEPARAMS.h"
104
105 C !INPUT PARAMETERS:
106 integer igroup, iflag, ival_curr, ival_next, myThid
107 character*(*) fgname
108 CEOP
109
110 C !LOCAL VARIABLES:
111 integer fgf,fgl, indfg
112 character*(MAX_LEN_MBUF) msgbuf
113
114 C Functions
115 integer IFNBLNK, ILNBLNK
116
117 C Check that this name is not already defined
118 fgf = IFNBLNK(fgname)
119 fgl = ILNBLNK(fgname)
120 CALL MNC_GET_IND(MNC_MAX_ID, fgname, mnc_cw_fgnm, indfg, myThid)
121 IF (indfg .LT. 1) THEN
122 C Error if this file group name is not set
123 write(msgbuf,'(3a)')
124 & 'MNC_CW_SET_CITER ERROR: the file group name ''',
125 & fgname(fgf:fgl), ''' does not exist'
126 CALL print_error(msgbuf, mythid)
127 STOP 'ABNORMAL END: S/R MNC_CW_SET_CITER'
128 ENDIF
129
130 IF (igroup .LT. 1) THEN
131 igroup = mnc_cw_fgci(indfg)
132 ELSE
133 mnc_cw_fgci(indfg) = igroup
134 ENDIF
135 IF ((igroup .LT. 1) .OR. (igroup .GT. MNC_MAX_INFO)) THEN
136 write(msgbuf,'(4a)')
137 & 'MNC_CW_SET_CITER ERROR: invalid igroup index for ',
138 & 'file group name ''', fgname(fgf:fgl), ''''
139 CALL print_error(msgbuf, mythid)
140 STOP 'ABNORMAL END: S/R MNC_CW_SET_CITER'
141 ENDIF
142
143 CALL MNC_CW_CITER_SETG( igroup,
144 & iflag, ival_curr, ival_next, myThid )
145
146 RETURN
147 END
148
149 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
150
151 CBOP 0
152 C !ROUTINE: MNC_CW_GET_CITER
153
154 C !INTERFACE:
155 SUBROUTINE MNC_CW_GET_CITER(
156 I fgname,
157 O igroup,
158 O iflag, ival_curr, ival_next,
159 I myThid )
160
161 C !DESCRIPTION:
162 C Set the flag and/or current iteration value
163
164 C !USES:
165 implicit none
166 #include "mnc_common.h"
167 #include "EEPARAMS.h"
168
169 C !INPUT PARAMETERS:
170 integer igroup, iflag, ival_curr, ival_next, myThid
171 character*(*) fgname
172 CEOP
173
174 C !LOCAL VARIABLES:
175 integer fgf,fgl, indfg
176 character*(MAX_LEN_MBUF) msgbuf
177
178 C Functions
179 integer IFNBLNK, ILNBLNK
180
181 C Check that this name is not already defined
182 fgf = IFNBLNK(fgname)
183 fgl = ILNBLNK(fgname)
184 CALL MNC_GET_IND(MNC_MAX_ID, fgname, mnc_cw_fgnm, indfg, myThid)
185 IF (indfg .LT. 1) THEN
186 C Error if this file group name is not set
187 write(msgbuf,'(3a)')
188 & 'MNC_CW_SET_CITER ERROR: the file group name ''',
189 & fgname(fgf:fgl), ''' does not exist'
190 CALL print_error(msgbuf, mythid)
191 STOP 'ABNORMAL END: S/R MNC_CW_SET_CITER'
192 ENDIF
193
194 igroup = mnc_cw_fgci(indfg)
195 IF ((igroup .LT. 1) .OR. (igroup .GT. MNC_MAX_INFO)) THEN
196 igroup = -1
197 iflag = -1
198 ival_curr = -1
199 ival_next = -1
200 ELSE
201 CALL MNC_CW_CITER_GETG( igroup,
202 & iflag, ival_curr, ival_next, myThid )
203 ENDIF
204
205
206 RETURN
207 END
208
209 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
210
  ViewVC Help
Powered by ViewVC 1.1.22