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

Diff of /MITgcm/pkg/diagnostics/diagstats_fill.F

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

revision 1.1 by jmc, Fri May 20 07:28:51 2005 UTC revision 1.3 by jmc, Mon Jul 11 19:02:17 2005 UTC
# Line 6  C $Name$ Line 6  C $Name$
6  CBOP  CBOP
7  C     !ROUTINE: DIAGSTATS_FILL  C     !ROUTINE: DIAGSTATS_FILL
8  C     !INTERFACE:  C     !INTERFACE:
9        SUBROUTINE DIAGSTATS_FILL( inpFld, ndId, kInQSd, region2fill,        SUBROUTINE DIAGSTATS_FILL(
10       I              kLev, nLevs, bibjflg, biArg, bjArg, myThid )       I               inpFld, fractFld, scaleFact, power, nLevFract,
11         I               ndId, kInQSd, region2fill, kLev, nLevs,
12         I               bibjflg, biArg, bjArg, myThid )
13    
14  C     !DESCRIPTION:  C     !DESCRIPTION:
15  C***********************************************************************  C***********************************************************************
16  C   compute statistics over 1 tile  C   compute statistics over 1 tile
17  C   and increment the diagnostics array  C   and increment the diagnostics array
18    C     using a scaling factor & square option (power=2),
19    C     and with the option to use a fraction-weight (assumed
20    C         to be the counter-mate of the current diagnostics)
21  C***********************************************************************  C***********************************************************************
22  C     !USES:  C     !USES:
23        IMPLICIT NONE        IMPLICIT NONE
# Line 27  C     !INPUT PARAMETERS: Line 32  C     !INPUT PARAMETERS:
32  C***********************************************************************  C***********************************************************************
33  C  Arguments Description  C  Arguments Description
34  C  ----------------------  C  ----------------------
35  C     inpFld ..... Field to increment diagnostics array  C     inpFld    :: Field to increment diagnostics array
36  C     ndId     ... Diagnostics Id Number (in available diag list) of diag to process  C     fractFld  :: fraction used for weighted average diagnostics
37  C     kInQSd ...   Pointer to the slot in qSdiag to fill  C     scaleFact :: scaling factor
38  C     region2fill  array, indicates whether to compute statistics over region  C     power     :: option to fill-in with the field square (power=2)
39    C     nLevFract :: number of levels of the fraction field, =0 : do not use fraction
40    C     ndId      :: Diagnostics Id Number (in available diag list) of diag to process
41    C     kInQSd    :: Pointer to the slot in qSdiag to fill
42    C   region2fill :: array, indicates whether to compute statistics over region
43  C                   "j" (if region2fill(j)=1) or not (if region2fill(j)=0)  C                   "j" (if region2fill(j)=1) or not (if region2fill(j)=0)
44  C     kLev   ..... Integer flag for vertical levels:  C     kLev      :: Integer flag for vertical levels:
45  C                  > 0 (any integer): WHICH single level to increment in qSdiag.  C                  > 0 (any integer): WHICH single level to increment in qSdiag.
46  C                  0,-1 to increment "nLevs" levels in qSdiag,  C                  0,-1 to increment "nLevs" levels in qSdiag,
47  C                  0 : fill-in in the same order as the input array  C                  0 : fill-in in the same order as the input array
48  C                  -1: fill-in in reverse order.  C                  -1: fill-in in reverse order.
49  C     nLevs ...... indicates Number of levels of the input field array  C     nLevs     :: indicates Number of levels of the input field array
50  C                  (whether to fill-in all the levels (kLev<1) or just one (kLev>0))  C                  (whether to fill-in all the levels (kLev<1) or just one (kLev>0))
51  C     bibjflg .... Integer flag to indicate instructions for bi bj loop  C     bibjflg   :: Integer flag to indicate instructions for bi bj loop
52  C                  0 indicates that the bi-bj loop must be done here  C                  0 indicates that the bi-bj loop must be done here
53  C                  1 indicates that the bi-bj loop is done OUTSIDE  C                  1 indicates that the bi-bj loop is done OUTSIDE
54  C                  2 indicates that the bi-bj loop is done OUTSIDE  C                  2 indicates that the bi-bj loop is done OUTSIDE
# Line 48  C                  3 indicates that the Line 57  C                  3 indicates that the
57  C                     AND that we have been sent a local array  C                     AND that we have been sent a local array
58  C                     AND that the array has no overlap region (interior only)  C                     AND that the array has no overlap region (interior only)
59  C                  NOTE - bibjflg can be NEGATIVE to indicate not to increment counter  C                  NOTE - bibjflg can be NEGATIVE to indicate not to increment counter
60  C     biArg ...... X-direction tile number - used for bibjflg=1-3  C     biArg     :: X-direction tile number - used for bibjflg=1-3
61  C     bjArg ...... Y-direction tile number - used for bibjflg=1-3  C     bjArg     :: Y-direction tile number - used for bibjflg=1-3
62  C     myThid     ::  my thread Id number  C     myThid    :: my thread Id number
63  C***********************************************************************  C***********************************************************************
64  C                  NOTE: User beware! If a local (1 tile only) array  C                  NOTE: User beware! If a local (1 tile only) array
65  C                        is sent here, bibjflg MUST NOT be set to 0  C                        is sent here, bibjflg MUST NOT be set to 0
66  C                        or there will be out of bounds problems!  C                        or there will be out of bounds problems!
67  C***********************************************************************  C***********************************************************************
68        _RL inpFld(*)        _RL inpFld(*)
69          _RL fractFld(*)
70          _RL scaleFact
71          INTEGER power
72          INTEGER nLevFract
73        INTEGER ndId, kInQSd        INTEGER ndId, kInQSd
74        INTEGER region2fill(0:nRegions)        INTEGER region2fill(0:nRegions)
75        INTEGER kLev, nLevs, bibjflg, biArg, bjArg        INTEGER kLev, nLevs, bibjflg, biArg, bjArg
# Line 65  CEOP Line 78  CEOP
78    
79  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
80  C ===============  C ===============
81  c     INTEGER m, n  C     useFract  :: flag to increment (or not) with fraction-weigted inpFld
82          LOGICAL useFract
83          INTEGER sizF
84        INTEGER sizI1,sizI2,sizJ1,sizJ2        INTEGER sizI1,sizI2,sizJ1,sizJ2
85        INTEGER sizTx,sizTy        INTEGER sizTx,sizTy
86        INTEGER iRun, jRun, k, bi, bj        INTEGER iRun, jRun, k, bi, bj
# Line 79  C If-sequence to see if we are a valid a Line 94  C If-sequence to see if we are a valid a
94  c     IF ( ndId.NE.0 .AND. kInQSd.NE.0 ) THEN  c     IF ( ndId.NE.0 .AND. kInQSd.NE.0 ) THEN
95    
96  C-      select range for 1rst & 2nd indices to accumulate  C-      select range for 1rst & 2nd indices to accumulate
97  C         depending on variable location on C-grid,  C         depending on variable location on C-grid,
98          parms1 = gdiag(ndId)(1:8)          parms1 = gdiag(ndId)(1:8)
99          IF ( parms1(2:2).EQ.'Z' ) THEN          IF ( parms1(2:2).EQ.'Z' ) THEN
100           iRun = sNx+1           iRun = sNx+1
# Line 130  C         and do the loop >> do k=kFirst Line 145  C         and do the loop >> do k=kFirst
145          ELSE          ELSE
146            STOP 'ABNORMAL END in DIAGSTATS_FILL: kLev > nLevs > 0'            STOP 'ABNORMAL END in DIAGSTATS_FILL: kLev > nLevs > 0'
147          ENDIF          ENDIF
148  C-      Which part of qSdiag to update: kd = 3rd index,  C-      Which part of qSdiag to update: kd = 3rd index,
149  C         and do the loop >> do k=kFirst,kLast ; kd = kd0 + k*ksgn <<  C         and do the loop >> do k=kFirst,kLast ; kd = kd0 + k*ksgn <<
150  C  1rst try this: for the mask: km = km0 + k*ksgn so that kd= km + kInQSd - 1  C  1rst try this: for the mask: km = km0 + k*ksgn so that kd= km + kInQSd - 1
151          IF ( kLev.EQ.-1 ) THEN          IF ( kLev.EQ.-1 ) THEN
152            ksgn = -1            ksgn = -1
153            kd0 = kInQSd + nLevs            kd0 = kInQSd + nLevs
# Line 146  C  1rst try this: for the mask: km = km0 Line 161  C  1rst try this: for the mask: km = km0
161            kd0 = kInQSd + kLev - 1            kd0 = kInQSd + kLev - 1
162            km0 = kLev            km0 = kLev
163          ENDIF          ENDIF
164    C-      Set fraction-weight option :
165            useFract = nLevFract.GT.0
166            IF ( useFract ) THEN
167              sizF = nLevFract
168            ELSE
169              sizF = 1
170            ENDIF
171    
172  C-      Check for consistency with Nb of levels reserved in storage array  C-      Check for consistency with Nb of levels reserved in storage array
173          kStore = kd0 + MAX(ksgn*kFirst,ksgn*kLast) - kInQSd + 1          kStore = kd0 + MAX(ksgn*kFirst,ksgn*kLast) - kInQSd + 1
# Line 168  C-      Check for consistency with Nb of Line 190  C-      Check for consistency with Nb of
190          ENDIF          ENDIF
191    
192          IF ( bibjflg.EQ.0 ) THEN          IF ( bibjflg.EQ.0 ) THEN
193            
194           DO bj=myByLo(myThid), myByHi(myThid)           DO bj=myByLo(myThid), myByHi(myThid)
195            DO bi=myBxLo(myThid), myBxHi(myThid)            DO bi=myBxLo(myThid), myBxHi(myThid)
196             DO k = kFirst,kLast             DO k = kFirst,kLast
# Line 176  C-      Check for consistency with Nb of Line 198  C-      Check for consistency with Nb of
198              km = km0 + ksgn*k              km = km0 + ksgn*k
199              CALL DIAGSTATS_LOCAL(              CALL DIAGSTATS_LOCAL(
200       U                  qSdiag(0,0,kd,bi,bj),       U                  qSdiag(0,0,kd,bi,bj),
201       I                  inpFld,       I                  inpFld, fractFld,
202         I                  scaleFact, power, useFract, sizF,
203       I                  sizI1,sizI2,sizJ1,sizJ2,nLevs,sizTx,sizTy,       I                  sizI1,sizI2,sizJ1,sizJ2,nLevs,sizTx,sizTy,
204       I                  iRun,jRun,k,bi,bj,       I                  iRun,jRun,k,bi,bj,
205       I                  km, bi, bj, region2fill,       I                  km, bi, bj, region2fill,
# Line 192  C-      Check for consistency with Nb of Line 215  C-      Check for consistency with Nb of
215              km = km0 + ksgn*k              km = km0 + ksgn*k
216              CALL DIAGSTATS_LOCAL(              CALL DIAGSTATS_LOCAL(
217       U                  qSdiag(0,0,kd,biArg,bjArg),       U                  qSdiag(0,0,kd,biArg,bjArg),
218       I                  inpFld,       I                  inpFld, fractFld,
219         I                  scaleFact, power, useFract, sizF,
220       I                  sizI1,sizI2,sizJ1,sizJ2,nLevs,sizTx,sizTy,       I                  sizI1,sizI2,sizJ1,sizJ2,nLevs,sizTx,sizTy,
221       I                  iRun,jRun,k,bi,bj,       I                  iRun,jRun,k,bi,bj,
222       I                  km, biArg, bjArg, region2fill,       I                  km, biArg, bjArg, region2fill,
# Line 205  c     ELSE Line 229  c     ELSE
229    
230  c     ENDIF  c     ENDIF
231    
232        RETURN        RETURN
233        END        END
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.3
  ViewVC Help
Powered by ViewVC 1.1.22