/[MITgcm]/MITgcm_contrib/quarter_degree_global/code_srdiags_call/diagnostics_fill.F
ViewVC logotype

Annotation of /MITgcm_contrib/quarter_degree_global/code_srdiags_call/diagnostics_fill.F

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


Revision 1.1.1.1 - (hide annotations) (download) (vendor branch)
Fri Jul 28 22:04:32 2006 UTC (19 years ago) by cnh
Branch: initial_import
CVS Tags: initial
Changes since 1.1: +0 -0 lines
Interface to sub-region diags

1 cnh 1.1 C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagnostics_fill.F,v 1.12 2006/06/05 18:17:22 jmc Exp $
2     C $Name: $
3    
4     #include "DIAG_OPTIONS.h"
5    
6     CBOP
7     C !ROUTINE: DIAGNOSTICS_FILL
8     C !INTERFACE:
9     SUBROUTINE DIAGNOSTICS_FILL(
10     I inpFld, chardiag,
11     I kLev, nLevs, bibjFlg, biArg, bjArg, myThid )
12    
13     C !DESCRIPTION:
14     C***********************************************************************
15     C Wrapper routine to increment the diagnostics arrays with a field
16     C***********************************************************************
17     C !USES:
18     IMPLICIT NONE
19    
20     C == Global variables ===
21     #include "EEPARAMS.h"
22     #include "SIZE.h"
23     #include "DIAGNOSTICS_SIZE.h"
24     #include "DIAGNOSTICS.h"
25    
26     C !INPUT PARAMETERS:
27     C***********************************************************************
28     C Arguments Description
29     C ----------------------
30     C inpFld :: Field to increment diagnostics array
31     C chardiag :: Character expression for diag to fill
32     C kLev :: Integer flag for vertical levels:
33     C > 0 (any integer): WHICH single level to increment in qdiag.
34     C 0,-1 to increment "nLevs" levels in qdiag,
35     C 0 : fill-in in the same order as the input array
36     C -1: fill-in in reverse order.
37     C nLevs :: indicates Number of levels of the input field array
38     C (whether to fill-in all the levels (kLev<1) or just one (kLev>0))
39     C bibjFlg :: Integer flag to indicate instructions for bi bj loop
40     C 0 indicates that the bi-bj loop must be done here
41     C 1 indicates that the bi-bj loop is done OUTSIDE
42     C 2 indicates that the bi-bj loop is done OUTSIDE
43     C AND that we have been sent a local array (with overlap regions)
44     C 3 indicates that the bi-bj loop is done OUTSIDE
45     C AND that we have been sent a local array
46     C AND that the array has no overlap region (interior only)
47     C NOTE - bibjFlg can be NEGATIVE to indicate not to increment counter
48     C biArg :: X-direction tile number - used for bibjFlg=1-3
49     C bjArg :: Y-direction tile number - used for bibjFlg=1-3
50     C myThid :: my thread Id number
51     C***********************************************************************
52     C NOTE: User beware! If a local (1 tile only) array
53     C is sent here, bibjFlg MUST NOT be set to 0
54     C or there will be out of bounds problems!
55     C***********************************************************************
56     _RL inpFld(*)
57     CHARACTER*8 chardiag
58     INTEGER kLev, nLevs, bibjFlg, biArg, bjArg
59     INTEGER myThid
60     CEOP
61    
62     C !LOCAL VARIABLES:
63     C ndId :: diagnostic Id number (in available diagnostics list)
64     C ===============
65     INTEGER m, n, j, k, l, bi, bj
66     INTEGER ndId, ipt, iSp
67     INTEGER region2fill(0:nRegions)
68     _RL scaleFact
69    
70     scaleFact = 1. _d 0
71     IF ( bibjFlg.EQ.0 ) THEN
72     bi = 1
73     bj = 1
74     ELSE
75     bi = biArg
76     bj = bjArg
77     ENDIF
78     C-- 2D/3D Diagnostics :
79     C Run through list of active diagnostics to make sure
80     C we are trying to fill a valid diagnostic
81     DO n=1,nlists
82     DO m=1,nActive(n)
83     IF ( chardiag.EQ.flds(m,n) .AND. idiag(m,n).GT.0 ) THEN
84     ipt = idiag(m,n)
85     IF ( ndiag(ipt,bi,bj).GE.0 ) THEN
86     ndId = jdiag(m,n)
87     ipt = ipt + pdiag(n,bi,bj)*kdiag(ndId)
88     C- diagnostic is valid & active, do the filling:
89     CALL DIAGNOSTICS_FILL_FIELD(
90     I inpFld, inpFld, scaleFact, 1, 0,
91     I ndId, ipt, kLev, nLevs,
92     I bibjFlg, biArg, bjArg, myThid )
93     ENDIF
94     ENDIF
95     ENDDO
96     ENDDO
97    
98     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
99     C-- Global/Regional Statistics :
100    
101     C Run through list of active statistics-diagnostics to make sure
102     C we are trying to compute & fill a valid diagnostic
103    
104     DO n=1,diagSt_nbLists
105     DO m=1,diagSt_nbActv(n)
106     IF ( chardiag.EQ.diagSt_Flds(m,n) .AND. iSdiag(m,n).GT.0 ) THEN
107     iSp = iSdiag(m,n)
108     IF ( qSdiag(0,0,iSp,bi,bj).GE.0. ) THEN
109     ndId = jSdiag(m,n)
110     C- Find list of regions to fill:
111     DO j=0,nRegions
112     region2fill(j) = diagSt_region(j,n)
113     ENDDO
114     C- if this diagnostics appears in several lists (with same freq)
115     C then add regions from other lists
116     DO l=1,diagSt_nbLists
117     DO k=1,diagSt_nbActv(l)
118     IF ( iSdiag(k,l).EQ.-iSp ) THEN
119     DO j=0,nRegions
120     region2fill(j) = MAX(region2fill(j),diagSt_region(j,l))
121     ENDDO
122     ENDIF
123     ENDDO
124     ENDDO
125     C- diagnostics is valid and Active: Now do the filling
126     CALL DIAGSTATS_FILL(
127     I inpFld, inpFld, scaleFact, 1, 0,
128     I ndId, iSp, region2fill, kLev, nLevs,
129     I bibjFlg, biArg, bjArg, myThid )
130     ENDIF
131     ENDIF
132     ENDDO
133     ENDDO
134    
135     RETURN
136     END

  ViewVC Help
Powered by ViewVC 1.1.22