/[MITgcm]/MITgcm/pkg/diagnostics/diagstats_set_pointers.F
ViewVC logotype

Contents of /MITgcm/pkg/diagnostics/diagstats_set_pointers.F

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

Revision 1.7 - (show annotations) (download)
Thu Oct 30 18:52:54 2008 UTC (15 years, 5 months ago) by dfer
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, 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, 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, checkpoint61n, checkpoint61o, checkpoint61l, checkpoint61m, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i, checkpoint61v, checkpoint61w, checkpoint61t, checkpoint61u, checkpoint61r, checkpoint61s, checkpoint61p, checkpoint61q, checkpoint61z, checkpoint61x, checkpoint61y, HEAD
Changes since 1.6: +3 -2 lines 
Fixing bug + retiring KPPmld diagnostic
1 C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagstats_set_pointers.F,v 1.6 2008/02/05 15:31:19 jmc Exp $
2 C $Name: $
3
4 #include "DIAG_OPTIONS.h"
5
6 CBOP
7 C !ROUTINE: DIAGSTATS_SET_POINTERS
8 C !INTERFACE:
9 SUBROUTINE DIAGSTATS_SET_POINTERS( myThid )
10
11 C !DESCRIPTION: \bv
12 C *==================================================================
13 C | S/R DIAGSTATS_SET_POINTERS
14 C | o set pointers for active statistics diagnostics
15 C *==================================================================
16 C \ev
17
18 C !USES:
19 IMPLICIT NONE
20
21 C == Global variables ===
22 #include "EEPARAMS.h"
23 #include "SIZE.h"
24 #include "DIAGNOSTICS_SIZE.h"
25 #include "DIAGNOSTICS.h"
26 #include "DIAGSTATS_REGIONS.h"
27
28 C !INPUT/OUTPUT PARAMETERS:
29 C == Routine arguments ==
30 C myThid - Thread number for this instance of the routine.
31 INTEGER myThid
32 CEOP
33
34 C !LOCAL VARIABLES:
35 C == Local variables ==
36 INTEGER ndiagcount, ndCount
37 INTEGER md,ld,nd
38 INTEGER mm, mate, nActiveMax
39 INTEGER j, k, l
40 LOGICAL found, addMate2List, inList, regListPb
41 CHARACTER*(MAX_LEN_MBUF) msgBuf
42
43
44 _BEGIN_MASTER( myThid)
45
46 C-- Initialize pointer arrays to zero:
47 DO ld=1,numlists
48 DO md=1,numperlist
49 iSdiag(md,ld) = 0
50 jSdiag(md,ld) = 0
51 mSdiag(md,ld) = 0
52 ENDDO
53 ENDDO
54
55 C-- Calculate pointers for diagnostics set to non-zero frequency
56
57 ndiagcount = 0
58 nActiveMax = 0
59 DO ld=1,diagSt_nbLists
60 diagSt_nbActv(ld) = diagSt_nbFlds(ld)
61 DO md=1,diagSt_nbFlds(ld)
62
63 found = .FALSE.
64 C Search all possible model diagnostics
65 DO nd=1,ndiagt
66 IF ( diagSt_Flds(md,ld).EQ.cdiag(nd) ) THEN
67 CALL DIAGSTATS_SETDIAG(mate,ndiagcount,md,ld,nd,myThid)
68 found = .TRUE.
69 jSdiag(md,ld) = nd
70 ENDIF
71 ENDDO
72 IF ( .NOT.found ) THEN
73 CALL DIAGNOSTICS_LIST_CHECK(
74 O ndCount,
75 I ld,md, diagSt_nbLists,
76 I diagSt_nbFlds,diagSt_Flds,myThid)
77 IF ( ndCount.EQ.0 ) THEN
78 WRITE(msgBuf,'(3A)') 'DIAGSTATS_SET_POINTERS: ',
79 & diagSt_Flds(md,ld),' is not a Diagnostic'
80 CALL PRINT_ERROR( msgBuf , myThid )
81 ENDIF
82 STOP 'ABNORMAL END: S/R DIAGSTATS_SET_POINTERS'
83 ENDIF
84 IF ( found .AND. mate.LE.-1 ) THEN
85 C- add this fields to the active list in case regions are differents:
86 addMate2List = .FALSE.
87 DO l=1,ld-1
88 inList = .FALSE.
89 DO k=1,diagSt_nbActv(l)
90 IF ( diagSt_Flds(k,l).EQ.cdiag(-mate) ) inList=.TRUE.
91 ENDDO
92 IF ( inList ) THEN
93 DO j=0,nRegions
94 addMate2List = addMate2List
95 & .OR. (diagSt_region(j,l).LT.diagSt_region(j,ld))
96 ENDDO
97 ENDIF
98 ENDDO
99 IF ( .NOT.addMate2List ) mate = 0
100 ENDIF
101 IF ( found .AND. mate.NE.0 ) THEN
102 mm = diagSt_nbActv(ld) + 1
103 IF ( mm.LE.numperlist ) THEN
104 iSdiag(mm,ld) = SIGN(mSdiag(md,ld),mate)
105 mate = ABS(mate)
106 jSdiag(mm,ld) = mate
107 diagSt_Flds(mm,ld) = cdiag(mate)
108 ENDIF
109 diagSt_nbActv(ld) = mm
110 ENDIF
111
112 ENDDO
113 nActiveMax = MAX(diagSt_nbActv(ld),nActiveMax)
114 ENDDO
115
116 IF ( ndiagcount.LE.diagSt_size .AND.
117 & nActiveMax.LE.numperlist ) THEN
118 WRITE(msgBuf,'(A,I8,A)')
119 & ' space allocated for all stats-diags:',
120 & ndiagcount, ' levels'
121 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
122 & SQUEEZE_RIGHT , myThid)
123 ELSE
124 IF ( ndiagcount.GT.diagSt_size ) THEN
125 WRITE(msgBuf,'(2A)')
126 & 'DIAGSTATS_SET_POINTERS: Not enough space',
127 & ' for all active stats-diags (from data.diagnostics)'
128 CALL PRINT_ERROR( msgBuf , myThid )
129 WRITE(msgBuf,'(A,I8,A,I8)')
130 & 'DIAGSTATS_SET_POINTERS: diagSt_size=', diagSt_size,
131 & ' but needs at least', ndiagcount
132 CALL PRINT_ERROR( msgBuf , myThid )
133 ENDIF
134 IF ( nActiveMax.GT.numperlist ) THEN
135 WRITE(msgBuf,'(2A)')
136 & 'DIAGSTATS_SET_POINTERS: Not enough space',
137 & ' for all active stats-diags (from data.diagnostics)'
138 CALL PRINT_ERROR( msgBuf , myThid )
139 WRITE(msgBuf,'(A,I6,A,I6)')
140 & 'DIAGSTATS_SET_POINTERS: numperlist=', numperlist,
141 & ' but needs at least', nActiveMax
142 CALL PRINT_ERROR( msgBuf , myThid )
143 ENDIF
144 STOP 'ABNORMAL END: S/R DIAGSTATS_SET_POINTERS'
145 ENDIF
146
147 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
148 C-- Set list of regions to write
149 C- check that all selected regions are actually defined
150 regListPb = .FALSE.
151 DO l=1,diagSt_nbLists
152 DO j=1,nRegions
153 IF ( diagSt_region(j,l).NE.0 ) THEN
154 IF ( diagSt_kRegMsk(j).LT.1 .OR.
155 & diagSt_kRegMsk(j).GT.nSetRegMask ) THEN
156 WRITE(msgBuf,'(A,3(A,I5))') 'DIAGSTATS_SET_POINTERS:',
157 & ' region', j, ' undefined (k=', diagSt_kRegMsk(j),
158 & ') in list l=', l
159 CALL PRINT_ERROR( msgBuf , myThid )
160 regListPb = .TRUE.
161 ENDIF
162 ENDIF
163 ENDDO
164 ENDDO
165 IF ( regListPb ) THEN
166 WRITE(msgBuf,'(2A)') 'DIAGSTATS_SET_POINTERS:',
167 & ' Cannot select undefined regions'
168 CALL PRINT_ERROR( msgBuf , myThid )
169 STOP 'ABNORMAL END: S/R DIAGSTATS_SET_POINTERS'
170 ENDIF
171
172 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
173
174 WRITE(msgBuf,'(A)') 'DIAGSTATS_SET_POINTERS: done'
175 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
176 & SQUEEZE_RIGHT , myThid)
177 WRITE(msgBuf,'(2A)')
178 & '------------------------------------------------------------'
179 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
180 & SQUEEZE_RIGHT , myThid)
181
182 _END_MASTER( myThid )
183
184 RETURN
185 END
  ViewVC Help
Powered by ViewVC 1.1.22