/[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.2 by jmc, Sun Jul 10 00:57:18 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, 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
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 28  C*************************************** Line 33  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     fractFld ... fraction used for weighted average diagnostics
37    C     scaleFact .. scaling factor
38    C     nLevFract .. number of levels of the fraction field, =0 : do not use fraction
39  C     ndId     ... Diagnostics Id Number (in available diag list) of diag to process  C     ndId     ... Diagnostics Id Number (in available diag list) of diag to process
40  C     kInQSd ...   Pointer to the slot in qSdiag to fill  C     kInQSd ...   Pointer to the slot in qSdiag to fill
41  C     region2fill  array, indicates whether to compute statistics over region  C     region2fill  array, indicates whether to compute statistics over region
# Line 35  C                   "j" (if region2fill( Line 43  C                   "j" (if region2fill(
43  C     kLev   ..... Integer flag for vertical levels:  C     kLev   ..... Integer flag for vertical levels:
44  C                  > 0 (any integer): WHICH single level to increment in qSdiag.  C                  > 0 (any integer): WHICH single level to increment in qSdiag.
45  C                  0,-1 to increment "nLevs" levels in qSdiag,  C                  0,-1 to increment "nLevs" levels in qSdiag,
46  C                  0 : fill-in in the same order as the input array  C                  0 : fill-in in the same order as the input array
47  C                  -1: fill-in in reverse order.  C                  -1: fill-in in reverse order.
48  C     nLevs ...... indicates Number of levels of the input field array  C     nLevs ...... indicates Number of levels of the input field array
49  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))
# Line 57  C                        is sent here, b Line 65  C                        is sent here, b
65  C                        or there will be out of bounds problems!  C                        or there will be out of bounds problems!
66  C***********************************************************************  C***********************************************************************
67        _RL inpFld(*)        _RL inpFld(*)
68          _RL fractFld(*)
69          _RL scaleFact
70          INTEGER nLevFract
71        INTEGER ndId, kInQSd        INTEGER ndId, kInQSd
72        INTEGER region2fill(0:nRegions)        INTEGER region2fill(0:nRegions)
73        INTEGER kLev, nLevs, bibjflg, biArg, bjArg        INTEGER kLev, nLevs, bibjflg, biArg, bjArg
# Line 65  CEOP Line 76  CEOP
76    
77  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
78  C ===============  C ===============
79  c     INTEGER m, n  C     useFract :: flag to increment (or not) with fraction-weigted inpFld
80          LOGICAL useFract
81          INTEGER sizF
82        INTEGER sizI1,sizI2,sizJ1,sizJ2        INTEGER sizI1,sizI2,sizJ1,sizJ2
83        INTEGER sizTx,sizTy        INTEGER sizTx,sizTy
84        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 92  C If-sequence to see if we are a valid a
92  c     IF ( ndId.NE.0 .AND. kInQSd.NE.0 ) THEN  c     IF ( ndId.NE.0 .AND. kInQSd.NE.0 ) THEN
93    
94  C-      select range for 1rst & 2nd indices to accumulate  C-      select range for 1rst & 2nd indices to accumulate
95  C         depending on variable location on C-grid,  C         depending on variable location on C-grid,
96          parms1 = gdiag(ndId)(1:8)          parms1 = gdiag(ndId)(1:8)
97          IF ( parms1(2:2).EQ.'Z' ) THEN          IF ( parms1(2:2).EQ.'Z' ) THEN
98           iRun = sNx+1           iRun = sNx+1
# Line 130  C         and do the loop >> do k=kFirst Line 143  C         and do the loop >> do k=kFirst
143          ELSE          ELSE
144            STOP 'ABNORMAL END in DIAGSTATS_FILL: kLev > nLevs > 0'            STOP 'ABNORMAL END in DIAGSTATS_FILL: kLev > nLevs > 0'
145          ENDIF          ENDIF
146  C-      Which part of qSdiag to update: kd = 3rd index,  C-      Which part of qSdiag to update: kd = 3rd index,
147  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 <<
148  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
149          IF ( kLev.EQ.-1 ) THEN          IF ( kLev.EQ.-1 ) THEN
150            ksgn = -1            ksgn = -1
151            kd0 = kInQSd + nLevs            kd0 = kInQSd + nLevs
# Line 146  C  1rst try this: for the mask: km = km0 Line 159  C  1rst try this: for the mask: km = km0
159            kd0 = kInQSd + kLev - 1            kd0 = kInQSd + kLev - 1
160            km0 = kLev            km0 = kLev
161          ENDIF          ENDIF
162    C-      Set fraction-weight option :
163            useFract = nLevFract.GT.0
164            IF ( useFract ) THEN
165              sizF = nLevFract
166            ELSE
167              sizF = 1
168            ENDIF
169    
170  C-      Check for consistency with Nb of levels reserved in storage array  C-      Check for consistency with Nb of levels reserved in storage array
171          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 188  C-      Check for consistency with Nb of
188          ENDIF          ENDIF
189    
190          IF ( bibjflg.EQ.0 ) THEN          IF ( bibjflg.EQ.0 ) THEN
191            
192           DO bj=myByLo(myThid), myByHi(myThid)           DO bj=myByLo(myThid), myByHi(myThid)
193            DO bi=myBxLo(myThid), myBxHi(myThid)            DO bi=myBxLo(myThid), myBxHi(myThid)
194             DO k = kFirst,kLast             DO k = kFirst,kLast
# Line 176  C-      Check for consistency with Nb of Line 196  C-      Check for consistency with Nb of
196              km = km0 + ksgn*k              km = km0 + ksgn*k
197              CALL DIAGSTATS_LOCAL(              CALL DIAGSTATS_LOCAL(
198       U                  qSdiag(0,0,kd,bi,bj),       U                  qSdiag(0,0,kd,bi,bj),
199       I                  inpFld,       I                  inpFld, fractFld, scaleFact, useFract, sizF,
200       I                  sizI1,sizI2,sizJ1,sizJ2,nLevs,sizTx,sizTy,       I                  sizI1,sizI2,sizJ1,sizJ2,nLevs,sizTx,sizTy,
201       I                  iRun,jRun,k,bi,bj,       I                  iRun,jRun,k,bi,bj,
202       I                  km, bi, bj, region2fill,       I                  km, bi, bj, region2fill,
# Line 192  C-      Check for consistency with Nb of Line 212  C-      Check for consistency with Nb of
212              km = km0 + ksgn*k              km = km0 + ksgn*k
213              CALL DIAGSTATS_LOCAL(              CALL DIAGSTATS_LOCAL(
214       U                  qSdiag(0,0,kd,biArg,bjArg),       U                  qSdiag(0,0,kd,biArg,bjArg),
215       I                  inpFld,       I                  inpFld, fractFld, scaleFact, useFract, sizF,
216       I                  sizI1,sizI2,sizJ1,sizJ2,nLevs,sizTx,sizTy,       I                  sizI1,sizI2,sizJ1,sizJ2,nLevs,sizTx,sizTy,
217       I                  iRun,jRun,k,bi,bj,       I                  iRun,jRun,k,bi,bj,
218       I                  km, biArg, bjArg, region2fill,       I                  km, biArg, bjArg, region2fill,
# Line 205  c     ELSE Line 225  c     ELSE
225    
226  c     ENDIF  c     ENDIF
227    
228        RETURN        RETURN
229        END        END
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22