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

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

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

Revision 1.1 - (hide annotations) (download)
Sat Sep 10 18:30:07 2005 UTC (18 years, 9 months ago) by edhill
Branch: MAIN 
 o various changes to mnc including:
   - all files use the new "BASENAME[[.ITER].{t|f}NUM].nc" format
   - output can now be grouped so that all files within a group
       change the ITER portion of their names in lock-step together
   - can now read ("global") PER-FACE (in addition to PER-TILE) files
       and works with both EXCH1 and EXCH2 (but needs more testing)
   - writing works for all verification test cases w/ g77 on Linux
1 edhill 1.1 C $Header: $
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     mnc_cw_cit(1,igroup) = iflag
29     IF ( ival_curr .GT. 0 ) THEN
30     mnc_cw_cit(2,igroup) = ival_curr
31     ENDIF
32     IF ( ival_next .GT. 0 ) THEN
33     mnc_cw_cit(3,igroup) = ival_next
34     ENDIF
35    
36     RETURN
37     END
38    
39     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
40    
41     CBOP 0
42     C !ROUTINE: MNC_CW_CITER_GETG
43    
44     C !INTERFACE:
45     SUBROUTINE MNC_CW_CITER_GETG(
46     I igroup,
47     O iflag, ival_curr, ival_next,
48     I myThid )
49    
50     C !DESCRIPTION:
51     C Get the current CITER information for group "igroup"
52    
53     C !USES:
54     implicit none
55     #include "mnc_common.h"
56    
57     C !INPUT PARAMETERS:
58     integer igroup, iflag, ival_curr, ival_next, myThid
59     CEOP
60    
61     iflag = mnc_cw_cit(1,igroup)
62     ival_curr = mnc_cw_cit(2,igroup)
63     ival_next = mnc_cw_cit(3,igroup)
64    
65     RETURN
66     END
67    
68     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
69    
70     CBOP 0
71     C !ROUTINE: MNC_CW_SET_CITER
72    
73     C !INTERFACE:
74     SUBROUTINE MNC_CW_SET_CITER(
75     I fgname,
76     I igroup,
77     I iflag, ival_curr, ival_next,
78     I myThid )
79    
80     C !DESCRIPTION:
81     C Set the flag and/or current iteration value
82    
83     C !USES:
84     implicit none
85     #include "mnc_common.h"
86     #include "EEPARAMS.h"
87    
88     C !INPUT PARAMETERS:
89     integer igroup, iflag, ival_curr, ival_next, myThid
90     character*(*) fgname
91     CEOP
92    
93     C !LOCAL VARIABLES:
94     integer fgf,fgl, indfg
95     character*(MAX_LEN_MBUF) msgbuf
96    
97     C Functions
98     integer IFNBLNK, ILNBLNK
99    
100     C Check that this name is not already defined
101     fgf = IFNBLNK(fgname)
102     fgl = ILNBLNK(fgname)
103     CALL MNC_GET_IND(MNC_MAX_ID, fgname, mnc_cw_fgnm, indfg, myThid)
104     IF (indfg .LT. 1) THEN
105     C Error if this file group name is not set
106     write(msgbuf,'(3a)')
107     & 'MNC_CW_SET_CITER ERROR: the file group name ''',
108     & fgname(fgf:fgl), ''' does not exist'
109     CALL print_error(msgbuf, mythid)
110     STOP 'ABNORMAL END: S/R MNC_CW_SET_CITER'
111     ENDIF
112    
113     IF (igroup .LT. 1) THEN
114     igroup = mnc_cw_fgci(indfg)
115     ELSE
116     mnc_cw_fgci(indfg) = igroup
117     ENDIF
118     IF ((igroup .LT. 1) .OR. (igroup .GT. MNC_MAX_INFO)) THEN
119     write(msgbuf,'(4a)')
120     & 'MNC_CW_SET_CITER ERROR: invalid igroup index for ',
121     & 'file group name ''', fgname(fgf:fgl), ''''
122     CALL print_error(msgbuf, mythid)
123     STOP 'ABNORMAL END: S/R MNC_CW_SET_CITER'
124     ENDIF
125    
126     CALL MNC_CW_CITER_SETG( igroup,
127     & iflag, ival_curr, ival_next, myThid )
128    
129     RETURN
130     END
131    
132     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
133    
134     CBOP 0
135     C !ROUTINE: MNC_CW_GET_CITER
136    
137     C !INTERFACE:
138     SUBROUTINE MNC_CW_GET_CITER(
139     I fgname,
140     O igroup,
141     O iflag, ival_curr, ival_next,
142     I myThid )
143    
144     C !DESCRIPTION:
145     C Set the flag and/or current iteration value
146    
147     C !USES:
148     implicit none
149     #include "mnc_common.h"
150     #include "EEPARAMS.h"
151    
152     C !INPUT PARAMETERS:
153     integer igroup, iflag, ival_curr, ival_next, myThid
154     character*(*) fgname
155     CEOP
156    
157     C !LOCAL VARIABLES:
158     integer fgf,fgl, indfg
159     character*(MAX_LEN_MBUF) msgbuf
160    
161     C Functions
162     integer IFNBLNK, ILNBLNK
163    
164     C Check that this name is not already defined
165     fgf = IFNBLNK(fgname)
166     fgl = ILNBLNK(fgname)
167     CALL MNC_GET_IND(MNC_MAX_ID, fgname, mnc_cw_fgnm, indfg, myThid)
168     IF (indfg .LT. 1) THEN
169     C Error if this file group name is not set
170     write(msgbuf,'(3a)')
171     & 'MNC_CW_SET_CITER ERROR: the file group name ''',
172     & fgname(fgf:fgl), ''' does not exist'
173     CALL print_error(msgbuf, mythid)
174     STOP 'ABNORMAL END: S/R MNC_CW_SET_CITER'
175     ENDIF
176    
177     igroup = mnc_cw_fgci(indfg)
178     IF ((igroup .LT. 1) .OR. (igroup .GT. MNC_MAX_INFO)) THEN
179     igroup = -1
180     iflag = -1
181     ival_curr = -1
182     ival_next = -1
183     ELSE
184     CALL MNC_CW_CITER_GETG( igroup,
185     & iflag, ival_curr, ival_next, myThid )
186     ENDIF
187    
188    
189     RETURN
190     END
191    
192     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
193    
  ViewVC Help
Powered by ViewVC 1.1.22