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

Annotation of /MITgcm/pkg/diagnostics/diagstats_setdiag.F

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


Revision 1.1 - (hide annotations) (download)
Fri May 20 07:28:52 2005 UTC (18 years, 11 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint57i_post
Add new capability: compute & write Global/Regional & per level statistics

1 jmc 1.1 C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagnostics_setdiag.F,v 1.1 2004/12/13 21:43:54 jmc Exp $
2     C $Name: $
3    
4     #include "DIAG_OPTIONS.h"
5    
6     CBOP
7     C !ROUTINE: DIAGSTATS_SETDIAG
8     C !INTERFACE:
9     SUBROUTINE DIAGSTATS_SETDIAG(
10     O mate,
11     U ndiagmx,
12     I num, myThid )
13    
14     C !DESCRIPTION: \bv
15     C *==================================================================
16     C | S/R DIAGSTATS_SETDIAG
17     C | o activate statistics diagnostic "num":
18     C | set pointer locations for this diagnostic ;
19     C | look for a counter mate and set it
20     C *==================================================================
21     C \ev
22    
23     C !USES:
24     IMPLICIT NONE
25    
26     C == Global variables ===
27     #include "EEPARAMS.h"
28     #include "SIZE.h"
29     #include "DIAGNOSTICS_SIZE.h"
30     #include "DIAGNOSTICS.h"
31    
32     C !INPUT/OUTPUT PARAMETERS:
33     C == Routine arguments ==
34     C myThid - Thread number for this instance of the routine.
35     INTEGER mate
36     INTEGER ndiagmx
37     INTEGER num
38     INTEGER myThid
39     CEOP
40    
41     C !LOCAL VARIABLES:
42     C == Local variables ==
43     INTEGER stdUnit, errUnit
44    
45     CHARACTER*8 parms1
46     CHARACTER*3 mate_index
47     CHARACTER*(MAX_LEN_MBUF) msgBuf
48    
49    
50     C **********************************************************************
51     C **** SET POINTERS FOR DIAGNOSTIC NUM ****
52     C **********************************************************************
53    
54     parms1 = gdiag(num)(1:8)
55     stdUnit = standardMessageUnit
56     errUnit = errorMessageUnit
57    
58     IF ( iSdiag(num).EQ.0 ) THEN
59     IF (ndiagmx+kdiag(num).GT.diagSt_size) THEN
60     WRITE(msgBuf,'(A,I4,1X,A)')
61     & 'SETDIAG: Not enough space for Stats-Diag #', num, cdiag(num)
62     CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)
63     ELSE
64     WRITE(msgBuf,'(A,I3,A,I4,1X,A)') 'SETDIAG: Allocate',
65     & kdiag(num), ' Levels for Stats-Diag #', num, cdiag(num)
66     CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)
67     ENDIF
68     iSdiag(num) = ndiagmx + 1
69     ndiagmx = ndiagmx + kdiag(num)
70     ELSE
71     WRITE(msgBuf,'(A,I4,1X,2A)')
72     & '- WARNING - SETDIAG: Stats-Diag #', num, cdiag(num),
73     & ' has already been set'
74     CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)
75     ENDIF
76    
77     c Check for Counter Diagnostic
78     c ----------------------------
79     mate = 0
80     IF ( parms1(5:5).EQ.'C') THEN
81     mate_index = parms1(6:8)
82     READ (mate_index,'(I3)') mate
83    
84     IF ( iSdiag(mate).EQ.0 ) THEN
85     IF (ndiagmx+kdiag(mate).GT.diagSt_size) THEN
86     WRITE(msgBuf,'(A,I4,1X,A)')
87     & 'SETDIAG: Not enough space for Counter Diagnostic #',
88     & num, cdiag(num)
89     CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)
90     ELSE
91     WRITE(msgBuf,'(A,I3,A,I4,1X,A)') 'SETDIAG: Allocate',
92     & kdiag(mate), ' Levels for Count.Diag #', mate, cdiag(mate)
93     CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)
94     ENDIF
95     iSdiag(mate) = ndiagmx + 1
96     ndiagmx = ndiagmx + kdiag(mate)
97     ELSE
98     WRITE(msgBuf,'(A,I4,1X,2A)')
99     & '- NOTE - SETDIAG: Counter Diagnostic #', mate, cdiag(mate),
100     & ' has already been set'
101     CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)
102     mate = -mate
103     ENDIF
104     ENDIF
105    
106     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
107     RETURN
108     END

  ViewVC Help
Powered by ViewVC 1.1.22