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

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

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

revision 1.3 by jmc, Sun Jul 10 00:59:01 2005 UTC revision 1.4 by jmc, Mon Jul 11 18:59:07 2005 UTC
# Line 7  CBOP Line 7  CBOP
7  C     !ROUTINE: DIAGNOSTICS_FILL_FIELD  C     !ROUTINE: DIAGNOSTICS_FILL_FIELD
8  C     !INTERFACE:  C     !INTERFACE:
9        SUBROUTINE DIAGNOSTICS_FILL_FIELD(        SUBROUTINE DIAGNOSTICS_FILL_FIELD(
10       I                   inpFld, fractFld, scaleFact, nLevFract,       I               inpFld, fractFld, scaleFact, power, nLevFract,
11       I                   ndiagnum, ipointer, kLev, nLevs,       I               ndiagnum, ipointer, kLev, nLevs,
12       I                   bibjFlg, biArg, bjArg, myThid )       I               bibjFlg, biArg, bjArg, myThid )
13    
14  C     !DESCRIPTION:  C     !DESCRIPTION:
15  C***********************************************************************  C***********************************************************************
16  C   Increment the diagnostics array with a 2D/3D field  C   Increment the diagnostics array with a 2D/3D field
17  C     using a scaling factor  C     using a scaling factor & square option (power=2),
18  C     and with the option to use a fraction-weight (assumed  C     and with the option to use a fraction-weight (assumed
19  C         to be the counter-mate of the current diagnostics)  C         to be the counter-mate of the current diagnostics)
20  C***********************************************************************  C***********************************************************************
# Line 31  C     !INPUT PARAMETERS: Line 31  C     !INPUT PARAMETERS:
31  C***********************************************************************  C***********************************************************************
32  C  Arguments Description  C  Arguments Description
33  C  ----------------------  C  ----------------------
34  C     inpFld ..... Field to increment diagnostics array  C     inpFld    :: Field to increment diagnostics array
35  C     fractFld ... fraction used for weighted average diagnostics  C     fractFld  :: fraction used for weighted average diagnostics
36  C     scaleFact .. scaling factor  C     scaleFact :: scaling factor
37  C     nLevFract .. number of levels of the fraction field, =0 : do not use fraction  C     power     :: option to fill-in with the field square (power=2)
38  C     ndiagnum ... Diagnostics Number (in available diag list) of diag to process  C     nLevFract :: number of levels of the fraction field, =0 : do not use fraction
39  C     ipointer ... Pointer to the slot in qdiag to fill  C     ndiagnum  :: Diagnostics Number (in available diag list) of diag to process
40  C     kLev   ..... Integer flag for vertical levels:  C     ipointer  :: Pointer to the slot in qdiag to fill
41    C     kLev      :: Integer flag for vertical levels:
42  C                  > 0 (any integer): WHICH single level to increment in qdiag.  C                  > 0 (any integer): WHICH single level to increment in qdiag.
43  C                  0,-1 to increment "nLevs" levels in qdiag,  C                  0,-1 to increment "nLevs" levels in qdiag,
44  C                  0 : fill-in in the same order as the input array  C                  0 : fill-in in the same order as the input array
45  C                  -1: fill-in in reverse order.  C                  -1: fill-in in reverse order.
46  C     nLevs ...... indicates Number of levels of the input field array  C     nLevs     :: indicates Number of levels of the input field array
47  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))
48  C     bibjFlg .... Integer flag to indicate instructions for bi bj loop  C     bibjFlg   :: Integer flag to indicate instructions for bi bj loop
49  C                  0 indicates that the bi-bj loop must be done here  C                  0 indicates that the bi-bj loop must be done here
50  C                  1 indicates that the bi-bj loop is done OUTSIDE  C                  1 indicates that the bi-bj loop is done OUTSIDE
51  C                  2 indicates that the bi-bj loop is done OUTSIDE  C                  2 indicates that the bi-bj loop is done OUTSIDE
# Line 53  C                  3 indicates that the Line 54  C                  3 indicates that the
54  C                     AND that we have been sent a local array  C                     AND that we have been sent a local array
55  C                     AND that the array has no overlap region (interior only)  C                     AND that the array has no overlap region (interior only)
56  C                  NOTE - bibjFlg can be NEGATIVE to indicate not to increment counter  C                  NOTE - bibjFlg can be NEGATIVE to indicate not to increment counter
57  C     biArg ...... X-direction tile number - used for bibjFlg=1-3  C     biArg     :: X-direction tile number - used for bibjFlg=1-3
58  C     bjArg ...... Y-direction tile number - used for bibjFlg=1-3  C     bjArg     :: Y-direction tile number - used for bibjFlg=1-3
59  C     myThid     ::  my thread Id number  C     myThid    :: my thread Id number
60  C***********************************************************************  C***********************************************************************
61  C                  NOTE: User beware! If a local (1 tile only) array  C                  NOTE: User beware! If a local (1 tile only) array
62  C                        is sent here, bibjFlg MUST NOT be set to 0  C                        is sent here, bibjFlg MUST NOT be set to 0
# Line 64  C*************************************** Line 65  C***************************************
65        _RL inpFld(*)        _RL inpFld(*)
66        _RL fractFld(*)        _RL fractFld(*)
67        _RL scaleFact        _RL scaleFact
68          INTEGER power
69        INTEGER nLevFract        INTEGER nLevFract
70        INTEGER ndiagnum, ipointer        INTEGER ndiagnum, ipointer
71        INTEGER kLev, nLevs, bibjFlg, biArg, bjArg        INTEGER kLev, nLevs, bibjFlg, biArg, bjArg
# Line 72  CEOP Line 74  CEOP
74    
75  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
76  C ===============  C ===============
77  C     useFract :: flag to increment (or not) with fraction-weigted inpFld  C     useFract  :: flag to increment (or not) with fraction-weigted inpFld
78        LOGICAL useFract        LOGICAL useFract
79        INTEGER sizF        INTEGER sizF
80        INTEGER sizI1,sizI2,sizJ1,sizJ2        INTEGER sizI1,sizI2,sizJ1,sizJ2
# Line 204  C-      Check for consistency with Nb of Line 206  C-      Check for consistency with Nb of
206              kd = kd0 + ksgn*k              kd = kd0 + ksgn*k
207              CALL DIAGNOSTICS_DO_FILL(              CALL DIAGNOSTICS_DO_FILL(
208       U                  qdiag(1-OLx,1-OLy,kd,bi,bj),       U                  qdiag(1-OLx,1-OLy,kd,bi,bj),
209       I                  inpFld, fractFld, scaleFact, useFract,sizF,       I                  inpFld, fractFld,
210         I                  scaleFact, power, useFract,sizF,
211       I                  sizI1,sizI2,sizJ1,sizJ2,nLevs,sizTx,sizTy,       I                  sizI1,sizI2,sizJ1,sizJ2,nLevs,sizTx,sizTy,
212       I                  iRun,jRun,k,bi,bj,       I                  iRun,jRun,k,bi,bj,
213       I                  myThid)       I                  myThid)
# Line 218  C-      Check for consistency with Nb of Line 221  C-      Check for consistency with Nb of
221              kd = kd0 + ksgn*k              kd = kd0 + ksgn*k
222              CALL DIAGNOSTICS_DO_FILL(              CALL DIAGNOSTICS_DO_FILL(
223       U                  qdiag(1-OLx,1-OLy,kd,biArg,bjArg),       U                  qdiag(1-OLx,1-OLy,kd,biArg,bjArg),
224       I                  inpFld, fractFld, scaleFact, useFract,sizF,       I                  inpFld, fractFld,
225         I                  scaleFact, power, useFract,sizF,
226       I                  sizI1,sizI2,sizJ1,sizJ2,nLevs,sizTx,sizTy,       I                  sizI1,sizI2,sizJ1,sizJ2,nLevs,sizTx,sizTy,
227       I                  iRun,jRun,k,bi,bj,       I                  iRun,jRun,k,bi,bj,
228       I                  myThid)       I                  myThid)
# Line 243  C     !ROUTINE: DIAGNOSTICS_DO_FILL Line 247  C     !ROUTINE: DIAGNOSTICS_DO_FILL
247  C     !INTERFACE:  C     !INTERFACE:
248        SUBROUTINE DIAGNOSTICS_DO_FILL(        SUBROUTINE DIAGNOSTICS_DO_FILL(
249       U                  cumFld,       U                  cumFld,
250       I                  inpFld, frcFld, scaleFact, useFract,sizF,       I                  inpFld, frcFld,
251         I                  scaleFact, power, useFract, sizF,
252       I                  sizI1,sizI2,sizJ1,sizJ2,sizK,sizTx,sizTy,       I                  sizI1,sizI2,sizJ1,sizJ2,sizK,sizTx,sizTy,
253       I                  iRun,jRun,k,bi,bj,       I                  iRun,jRun,k,bi,bj,
254       I                  myThid)       I                  myThid)
# Line 265  C     cumFld      :: cumulative array (u Line 270  C     cumFld      :: cumulative array (u
270  C     inpFld      :: input field array to add to cumFld  C     inpFld      :: input field array to add to cumFld
271  C     frcFld      :: fraction used for weighted-average diagnostics  C     frcFld      :: fraction used for weighted-average diagnostics
272  C     scaleFact   :: scaling factor  C     scaleFact   :: scaling factor
273    C     power       :: option to fill-in with the field square (power=2)
274  C     useFract    :: if True, use fraction-weight  C     useFract    :: if True, use fraction-weight
275  C     sizF        :: size of frcFld array: 3rd  dimension  C     sizF        :: size of frcFld array: 3rd  dimension
276  C     sizI1,sizI2 :: size of inpFld array: 1rst index range (min,max)  C     sizI1,sizI2 :: size of inpFld array: 1rst index range (min,max)
# Line 281  C     myThid      :: my Thread Id number Line 287  C     myThid      :: my Thread Id number
287        _RL inpFld(sizI1:sizI2,sizJ1:sizJ2,sizK,sizTx,sizTy)        _RL inpFld(sizI1:sizI2,sizJ1:sizJ2,sizK,sizTx,sizTy)
288        _RL frcFld(sizI1:sizI2,sizJ1:sizJ2,sizF,sizTx,sizTy)        _RL frcFld(sizI1:sizI2,sizJ1:sizJ2,sizF,sizTx,sizTy)
289        _RL scaleFact        _RL scaleFact
290          INTEGER power
291        LOGICAL useFract        LOGICAL useFract
292        INTEGER iRun, jRun, k, bi, bj        INTEGER iRun, jRun, k, bi, bj
293        INTEGER myThid        INTEGER myThid
# Line 289  CEOP Line 296  CEOP
296  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
297  C     i,j    :: loop indices  C     i,j    :: loop indices
298        INTEGER i, j, l        INTEGER i, j, l
299          _RL     tmpFact
300    
301  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
302    
303        IF ( useFract ) THEN        tmpFact = scaleFact
304          IF ( power.EQ.2 ) tmpFact = scaleFact*scaleFact
305    
306          IF ( useFract .AND. power.EQ.2 ) THEN
307           l = MIN(k,sizF)
308           DO j = 1,jRun
309            DO i = 1,iRun
310              cumFld(i,j) = cumFld(i,j)
311         &                + tmpFact*inpFld(i,j,k,bi,bj)
312         &                         *inpFld(i,j,k,bi,bj)
313         &                         *frcFld(i,j,l,bi,bj)
314            ENDDO
315           ENDDO
316          ELSEIF ( useFract ) THEN
317         l = MIN(k,sizF)         l = MIN(k,sizF)
318         DO j = 1,jRun         DO j = 1,jRun
319          DO i = 1,iRun          DO i = 1,iRun
320            cumFld(i,j) = cumFld(i,j) + scaleFact*frcFld(i,j,l,bi,bj)            cumFld(i,j) = cumFld(i,j)
321       &                                         *inpFld(i,j,k,bi,bj)       &                + tmpFact*inpFld(i,j,k,bi,bj)
322         &                         *frcFld(i,j,l,bi,bj)
323            ENDDO
324           ENDDO
325          ELSEIF ( power.EQ.2 ) THEN
326           DO j = 1,jRun
327            DO i = 1,iRun
328              cumFld(i,j) = cumFld(i,j)
329         &                + tmpFact*inpFld(i,j,k,bi,bj)
330         &                         *inpFld(i,j,k,bi,bj)
331          ENDDO          ENDDO
332         ENDDO         ENDDO
333        ELSE        ELSE
# Line 307  C- jmc: try with fixed ranges, that are Line 337  C- jmc: try with fixed ranges, that are
337  C        (might produce a better cash optimisation ?)  C        (might produce a better cash optimisation ?)
338  c      DO j = 1,sNy  c      DO j = 1,sNy
339  c       DO i = 1,sNx  c       DO i = 1,sNx
340            cumFld(i,j) = cumFld(i,j) + scaleFact*inpFld(i,j,k,bi,bj)            cumFld(i,j) = cumFld(i,j)
341         &                + tmpFact*inpFld(i,j,k,bi,bj)
342          ENDDO          ENDDO
343         ENDDO         ENDDO
344        ENDIF        ENDIF
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4
  ViewVC Help
Powered by ViewVC 1.1.22