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

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

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

revision 1.2 by jmc, Sun Dec 19 20:27:42 2004 UTC revision 1.3 by jmc, Mon Dec 20 19:07:12 2004 UTC
# Line 29  C  ---------------------- Line 29  C  ----------------------
29  C     inpFld ..... Field to increment diagnostics array  C     inpFld ..... Field to increment diagnostics array
30  C     chardiag ... Character expression for diag to fill  C     chardiag ... Character expression for diag to fill
31  C     kLev   ..... Integer flag for vertical levels:  C     kLev   ..... Integer flag for vertical levels:
32  C                  0 indicates multiple levels incremented in qdiag  C                  > 0 (any integer): WHICH single level to increment in qdiag.
33  C                  non-0 (any integer) - WHICH single level to increment.  C                  0,-1 to increment "nLevs" levels in qdiag,
34  C                  negative INTEGER - the input data array is single-leveled  C                  0 : fill-in in the same order as the input array
35  C                  positive INTEGER - the input data array is multi-leveled  C                  -1: fill-in in reverse order.
36  C     nLevs ...... indicates Number of levels of the input field array:  C     nLevs ...... indicates Number of levels of the input field array
37  C                  |nLevs| = 3rd dimension size of inpFld array (=1 if kLev <0)  C                  (whether to fill-in all the levels (kLev<1) or just one (kLev>0))
 C                  positive: fill in "nLevs" levels in the same order as  
 C                            the input array  
 C                  negative: fill in -nLevs levels in reverse order.  
38  C     bibjFlg .... Integer flag to indicate instructions for bi bj loop  C     bibjFlg .... Integer flag to indicate instructions for bi bj loop
39  C                  0 indicates that the bi-bj loop must be done here  C                  0 indicates that the bi-bj loop must be done here
40  C                  1 indicates that the bi-bj loop is done OUTSIDE  C                  1 indicates that the bi-bj loop is done OUTSIDE
# Line 65  C =============== Line 62  C ===============
62        INTEGER m, n        INTEGER m, n
63        INTEGER ndiagnum, ipointer        INTEGER ndiagnum, ipointer
64        INTEGER sizI1,sizI2,sizJ1,sizJ2        INTEGER sizI1,sizI2,sizJ1,sizJ2
65        INTEGER sizK,sizTx,sizTy        INTEGER sizTx,sizTy
66        INTEGER iRun, jRun, kl, bi, bj        INTEGER iRun, jRun, k, bi, bj
67        INTEGER k, kFirst, kLast        INTEGER kFirst, kLast
68        INTEGER kd, kd0, ksgn, kStore        INTEGER kd, kd0, ksgn, kStore
69        CHARACTER*8 parms1        CHARACTER*8 parms1
70        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
# Line 139  C-      Dimension of the input array: Line 136  C-      Dimension of the input array:
136           sizTx = nSx           sizTx = nSx
137           sizTy = nSy           sizTy = nSy
138          ENDIF          ENDIF
139          IF (kLev.GE.0) THEN  C-      Which part of inpFld to add : k = 3rd index,
140           sizK = ABS(nLevs)  C         and do the loop >> do k=kFirst,kLast <<
141          ELSE          IF (kLev.LE.0) THEN
142           sizK = 1            kFirst = 1
143          ENDIF            kLast  = nLevs
144  C-      Which part of inpFld to add : kl = 3rd index,          ELSEIF ( nLevs.EQ.1 ) THEN
 C         and do the loop >> do k=kFirst,kLast ; kl = min(k,sizK) <<  
         IF (kLev.EQ.0) THEN  
145            kFirst = 1            kFirst = 1
146            kLast  = sizK            kLast  = 1
147            ELSEIF ( kLev.LE.nLevs ) THEN
148              kFirst = kLev
149              kLast  = kLev
150          ELSE          ELSE
151            kFirst = ABS(kLev)            STOP 'ABNORMAL END: S/R DIAGNOSTICS_FILL kLev > nLevs > 0'
           kLast  = ABS(kLev)  
152          ENDIF          ENDIF
153  C-      Which part of qdiag to update: kd = 3rd index,  C-      Which part of qdiag to update: kd = 3rd index,
154  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 <<
155          IF ( nLevs.GT.0 ) THEN          IF ( kLev.EQ.-1 ) THEN
156              ksgn = -1
157              kd0 = ipointer + nLevs
158            ELSEIF ( kLev.EQ.0 ) THEN
159            ksgn = 1            ksgn = 1
160            kd0 = ipointer - 1            kd0 = ipointer - 1
161          ELSE          ELSE
162            ksgn = -1            ksgn = 0
163            kd0 = ipointer + sizK            kd0 = ipointer + kLev - 1
164          ENDIF          ENDIF
165    
166  C-      Check for consistency with Nb of levels reserved in storage array  C-      Check for consistency with Nb of levels reserved in storage array
# Line 189  C-      Check for consistency with Nb of Line 189  C-      Check for consistency with Nb of
189            DO bi=myBxLo(myThid), myBxHi(myThid)            DO bi=myBxLo(myThid), myBxHi(myThid)
190             DO k = kFirst,kLast             DO k = kFirst,kLast
191              kd = kd0 + ksgn*k              kd = kd0 + ksgn*k
             kl = MIN(k,sizK)  
192              CALL DIAGNOSTICS_DO_FILL(              CALL DIAGNOSTICS_DO_FILL(
193       U                  qdiag(1-OLx,1-OLy,kd,bi,bj),       U                  qdiag(1-OLx,1-OLy,kd,bi,bj),
194       I                  inpFld,       I                  inpFld,
195       I                  sizI1,sizI2,sizJ1,sizJ2,sizK,sizTx,sizTy,       I                  sizI1,sizI2,sizJ1,sizJ2,nLevs,sizTx,sizTy,
196       I                  iRun,jRun,kl,bi,bj,       I                  iRun,jRun,k,bi,bj,
197       I                  myThid)       I                  myThid)
198             ENDDO             ENDDO
199            ENDDO            ENDDO
# Line 204  C-      Check for consistency with Nb of Line 203  C-      Check for consistency with Nb of
203            bj = MIN(bjArg,sizTy)            bj = MIN(bjArg,sizTy)
204            DO k = kFirst,kLast            DO k = kFirst,kLast
205              kd = kd0 + ksgn*k              kd = kd0 + ksgn*k
             kl = MIN(k,sizK)  
206              CALL DIAGNOSTICS_DO_FILL(              CALL DIAGNOSTICS_DO_FILL(
207       U                  qdiag(1-OLx,1-OLy,kd,biArg,bjArg),       U                  qdiag(1-OLx,1-OLy,kd,biArg,bjArg),
208       I                  inpFld,       I                  inpFld,
209       I                  sizI1,sizI2,sizJ1,sizJ2,sizK,sizTx,sizTy,       I                  sizI1,sizI2,sizJ1,sizJ2,nLevs,sizTx,sizTy,
210       I                  iRun,jRun,kl,bi,bj,       I                  iRun,jRun,k,bi,bj,
211       I                  myThid)       I                  myThid)
212            ENDDO            ENDDO
213          ENDIF          ENDIF
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3
  ViewVC Help
Powered by ViewVC 1.1.22