/[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.1 by jmc, Thu May 19 01:23:39 2005 UTC revision 1.2 by jmc, Sun Jun 26 16:51:49 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( inpFld, ndiagnum, ipointer,        SUBROUTINE DIAGNOSTICS_FILL_FIELD( inpFld, ndiagnum, ipointer,
10       I                   kLev, nLevs, bibjflg, biArg, bjArg, myThid )       I                   kLev, nLevs, bibjFlg, biArg, bjArg, myThid )
11    
12  C     !DESCRIPTION:  C     !DESCRIPTION:
13  C***********************************************************************  C***********************************************************************
# Line 32  C     ipointer ... Pointer to the slot i Line 32  C     ipointer ... Pointer to the slot i
32  C     kLev   ..... Integer flag for vertical levels:  C     kLev   ..... Integer flag for vertical levels:
33  C                  > 0 (any integer): WHICH single level to increment in qdiag.  C                  > 0 (any integer): WHICH single level to increment in qdiag.
34  C                  0,-1 to increment "nLevs" levels in qdiag,  C                  0,-1 to increment "nLevs" levels in qdiag,
35  C                  0 : fill-in in the same order as the input array  C                  0 : fill-in in the same order as the input array
36  C                  -1: fill-in in reverse order.  C                  -1: fill-in in reverse order.
37  C     nLevs ...... indicates Number of levels of the input field array  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))  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  C     bibjFlg .... Integer flag to indicate instructions for bi bj loop
40  C                  0 indicates that the bi-bj loop must be done here  C                  0 indicates that the bi-bj loop must be done here
41  C                  1 indicates that the bi-bj loop is done OUTSIDE  C                  1 indicates that the bi-bj loop is done OUTSIDE
42  C                  2 indicates that the bi-bj loop is done OUTSIDE  C                  2 indicates that the bi-bj loop is done OUTSIDE
# Line 44  C                     AND that we have b Line 44  C                     AND that we have b
44  C                  3 indicates that the bi-bj loop is done OUTSIDE  C                  3 indicates that the bi-bj loop is done OUTSIDE
45  C                     AND that we have been sent a local array  C                     AND that we have been sent a local array
46  C                     AND that the array has no overlap region (interior only)  C                     AND that the array has no overlap region (interior only)
47  C                  NOTE - bibjflg can be NEGATIVE to indicate not to increment counter  C                  NOTE - bibjFlg can be NEGATIVE to indicate not to increment counter
48  C     biArg ...... X-direction tile number - used for bibjflg=1-3  C     biArg ...... X-direction tile number - used for bibjFlg=1-3
49  C     bjArg ...... Y-direction tile number - used for bibjflg=1-3  C     bjArg ...... Y-direction tile number - used for bibjFlg=1-3
50  C     myThid     ::  my thread Id number  C     myThid     ::  my thread Id number
51  C***********************************************************************  C***********************************************************************
52  C                  NOTE: User beware! If a local (1 tile only) array  C                  NOTE: User beware! If a local (1 tile only) array
53  C                        is sent here, bibjflg MUST NOT be set to 0  C                        is sent here, bibjFlg MUST NOT be set to 0
54  C                        or there will be out of bounds problems!  C                        or there will be out of bounds problems!
55  C***********************************************************************  C***********************************************************************
56        _RL inpFld(*)        _RL inpFld(*)
57        INTEGER ndiagnum, ipointer        INTEGER ndiagnum, ipointer
58        INTEGER kLev, nLevs, bibjflg, biArg, bjArg        INTEGER kLev, nLevs, bibjFlg, biArg, bjArg
59        INTEGER myThid        INTEGER myThid
60  CEOP  CEOP
61    
# Line 72  C =============== Line 72  C ===============
72  C If-sequence to see if we are a valid and an active diagnostic  C If-sequence to see if we are a valid and an active diagnostic
73  c     IF ( ndiagnum.NE.0 .AND. ipointer.NE.0 ) THEN  c     IF ( ndiagnum.NE.0 .AND. ipointer.NE.0 ) THEN
74    
75  C Increment the counter for the diagnostic (if we are at bi=bj=myThid=1)         IF ( bibjFlg.GE.0 .AND. ABS(kLev).LE.1 ) THEN
76         _BEGIN_MASTER(myThid)  C Increment the counter for the diagnostic
77          IF((biArg.EQ.1).AND.(bjArg.EQ.1).AND.(ABS(kLev).LE.1).and.          IF ( bibjFlg.EQ.0 ) THEN
78       .      (bibjflg.ge.0) ) ndiag(ndiagnum) = ndiag(ndiagnum) + 1           DO bj=myByLo(myThid), myByHi(myThid)
79         _END_MASTER(myThid)            DO bi=myBxLo(myThid), myBxHi(myThid)
80               ndiag(ipointer,bi,bj) = ndiag(ipointer,bi,bj) + 1
81              ENDDO
82             ENDDO
83            ELSE
84               bi = MIN(biArg,nSx)
85               bj = MIN(bjArg,nSy)
86               ndiag(ipointer,bi,bj) = ndiag(ipointer,bi,bj) + 1
87            ENDIF
88           ENDIF
89    
90  C-      select range for 1rst & 2nd indices to accumulate  C-      select range for 1rst & 2nd indices to accumulate
91  C         depending on variable location on C-grid,  C         depending on variable location on C-grid,
92          parms1 = gdiag(ndiagnum)(1:8)          parms1 = gdiag(ndiagnum)(1:8)
93          IF ( parms1(2:2).EQ.'M' ) THEN          IF ( parms1(2:2).EQ.'M' ) THEN
94           iRun = sNx           iRun = sNx
# Line 99  C         depending on variable location Line 108  C         depending on variable location
108          ENDIF          ENDIF
109    
110  C-      Dimension of the input array:  C-      Dimension of the input array:
111          IF (abs(bibjflg).EQ.3) THEN          IF (abs(bibjFlg).EQ.3) THEN
112            sizI1 = 1            sizI1 = 1
113            sizI2 = sNx            sizI2 = sNx
114            sizJ1 = 1            sizJ1 = 1
# Line 112  C-      Dimension of the input array: Line 121  C-      Dimension of the input array:
121            sizJ1 = 1-OLy            sizJ1 = 1-OLy
122            sizJ2 = sNy+OLy            sizJ2 = sNy+OLy
123          ENDIF          ENDIF
124          IF (abs(bibjflg).GE.2) THEN          IF (abs(bibjFlg).GE.2) THEN
125           sizTx = 1           sizTx = 1
126           sizTy = 1           sizTy = 1
127          ELSE          ELSE
# Line 133  C         and do the loop >> do k=kFirst Line 142  C         and do the loop >> do k=kFirst
142          ELSE          ELSE
143            STOP 'ABNORMAL END in DIAGNOSTICS_FILL_FIELD: kLev > nLevs >0'            STOP 'ABNORMAL END in DIAGNOSTICS_FILL_FIELD: kLev > nLevs >0'
144          ENDIF          ENDIF
145  C-      Which part of qdiag to update: kd = 3rd index,  C-      Which part of qdiag to update: kd = 3rd index,
146  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 <<
147          IF ( kLev.EQ.-1 ) THEN          IF ( kLev.EQ.-1 ) THEN
148            ksgn = -1            ksgn = -1
# Line 166  C-      Check for consistency with Nb of Line 175  C-      Check for consistency with Nb of
175           _END_MASTER(myThid)           _END_MASTER(myThid)
176          ENDIF          ENDIF
177    
178          IF ( bibjflg.EQ.0 ) THEN          IF ( bibjFlg.EQ.0 ) THEN
179            
180           DO bj=myByLo(myThid), myByHi(myThid)           DO bj=myByLo(myThid), myByHi(myThid)
181            DO bi=myBxLo(myThid), myBxHi(myThid)            DO bi=myBxLo(myThid), myBxHi(myThid)
182             DO k = kFirst,kLast             DO k = kFirst,kLast
# Line 203  c     ENDIF Line 212  c     ENDIF
212    
213   1000 format(' ',' Warning: Trying to write to diagnostic ',a8,   1000 format(' ',' Warning: Trying to write to diagnostic ',a8,
214       &        ' But it is not a valid (or active) name ')       &        ' But it is not a valid (or active) name ')
215        RETURN        RETURN
216        END        END
217    
218  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
# Line 219  C     !INTERFACE: Line 228  C     !INTERFACE:
228       I                  myThid)       I                  myThid)
229    
230  C     !DESCRIPTION:  C     !DESCRIPTION:
231  C     Update array cumFld  C     Update array cumFld
232  C     by adding content of input field array inpFld  C     by adding content of input field array inpFld
233  C     over the range [1:iRun],[1:jRun]  C     over the range [1:iRun],[1:jRun]
234    
# Line 238  C     sizJ1,sizJ2 :: size of inpFld arra Line 247  C     sizJ1,sizJ2 :: size of inpFld arra
247  C     sizK        :: size of inpFld array: 3rd  dimension  C     sizK        :: size of inpFld array: 3rd  dimension
248  C     sizTx,sizTy :: size of inpFld array: tile dimensions  C     sizTx,sizTy :: size of inpFld array: tile dimensions
249  C     iRun,jRun   :: range of 1rst & 2nd index  C     iRun,jRun   :: range of 1rst & 2nd index
250  C     k,bi,bj     :: level and tile indices of inFld array  C     k,bi,bj     :: level and tile indices of inFld array
251  C                    to add to cumFld array  C                    to add to cumFld array
252  C     myThid      :: my Thread Id number  C     myThid      :: my Thread Id number
253        _RL cumFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL cumFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
# Line 255  C     i,j    :: loop indices Line 264  C     i,j    :: loop indices
264    
265        DO j = 1,jRun        DO j = 1,jRun
266         DO i = 1,iRun         DO i = 1,iRun
267  C- jmc: try with fixed ranges, that are known at compiling stage  C- jmc: try with fixed ranges, that are known at compiling stage
268  C        (might produce a better cash optimisation ?)  C        (might produce a better cash optimisation ?)
269  c     DO j = 1,sNy  c     DO j = 1,sNy
270  c      DO i = 1,sNx  c      DO i = 1,sNx
# Line 263  c      DO i = 1,sNx Line 272  c      DO i = 1,sNx
272         ENDDO         ENDDO
273        ENDDO        ENDDO
274    
275        RETURN        RETURN
276        END        END
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22