/[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.3 - (show annotations) (download)
Thu May 22 12:21:19 2008 UTC (16 years ago) by mlosch
Branch: MAIN
CVS Tags: checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint64i, checkpoint64h, checkpoint64k, checkpoint64j, checkpoint64m, checkpoint64l, checkpoint64o, checkpoint64n, checkpoint64a, checkpoint64c, checkpoint64b, checkpoint64e, checkpoint64d, checkpoint64g, checkpoint64f, checkpoint63p, checkpoint63q, checkpoint63r, checkpoint63s, checkpoint63l, checkpoint63m, checkpoint63n, checkpoint63o, checkpoint63h, checkpoint63i, checkpoint63j, checkpoint63k, checkpoint63d, checkpoint63e, checkpoint63f, checkpoint63g, checkpoint63a, checkpoint63b, checkpoint63c, checkpoint64, checkpoint65, checkpoint60, checkpoint61, checkpoint62, checkpoint63, 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, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65o, checkpoint65l, checkpoint65m, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, checkpoint59r, checkpoint62c, checkpoint62b, checkpoint62a, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62k, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint62o, checkpoint62n, checkpoint62m, checkpoint62l, checkpoint62s, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint62w, checkpoint62v, checkpoint62u, checkpoint62t, checkpoint62z, checkpoint62y, checkpoint62x, checkpoint61f, checkpoint61g, checkpoint61d, checkpoint61e, checkpoint61b, checkpoint61c, checkpoint61a, checkpoint61n, checkpoint61o, checkpoint61l, checkpoint61m, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i, checkpoint61v, checkpoint61w, checkpoint61t, checkpoint61u, checkpoint61r, checkpoint61s, checkpoint61p, checkpoint61q, checkpoint61z, checkpoint61x, checkpoint61y, HEAD
Changes since 1.2: +5 -5 lines 
replace mnc_common.h and mnc_id_header.h with corresponding upper case
versions
1 C $Header: /u/gcmpack/MITgcm/pkg/mnc/mnc_cw_citer.F,v 1.2 2005/09/14 19:27:31 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