/[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.2 by jmc, Sun Jun 26 16:51:49 2005 UTC revision 1.3 by jmc, Sun Jul 10 00:59:01 2005 UTC
# Line 6  C $Name$ Line 6  C $Name$
6  CBOP  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(
10       I                   kLev, nLevs, bibjFlg, biArg, bjArg, myThid )       I                   inpFld, fractFld, scaleFact, nLevFract,
11         I                   ndiagnum, ipointer, kLev, nLevs,
12         I                   bibjFlg, biArg, bjArg, myThid )
13    
14  C     !DESCRIPTION:  C     !DESCRIPTION:
15  C***********************************************************************  C***********************************************************************
16  C   routine to increment the diagnostics array with a field  C   Increment the diagnostics array with a 2D/3D field
17    C     using a scaling factor
18    C     and with the option to use a fraction-weight (assumed
19    C         to be the counter-mate of the current diagnostics)
20  C***********************************************************************  C***********************************************************************
21  C     !USES:  C     !USES:
22        IMPLICIT NONE        IMPLICIT NONE
# Line 27  C*************************************** Line 32  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
36    C     scaleFact .. scaling factor
37    C     nLevFract .. number of levels of the fraction field, =0 : do not use fraction
38  C     ndiagnum ... Diagnostics Number (in available diag list) of diag to process  C     ndiagnum ... Diagnostics Number (in available diag list) of diag to process
39  C     ipointer ... Pointer to the slot in qdiag to fill  C     ipointer ... Pointer to the slot in qdiag to fill
40  C     kLev   ..... Integer flag for vertical levels:  C     kLev   ..... Integer flag for vertical levels:
# Line 54  C                        is sent here, b Line 62  C                        is sent here, b
62  C                        or there will be out of bounds problems!  C                        or there will be out of bounds problems!
63  C***********************************************************************  C***********************************************************************
64        _RL inpFld(*)        _RL inpFld(*)
65          _RL fractFld(*)
66          _RL scaleFact
67          INTEGER nLevFract
68        INTEGER ndiagnum, ipointer        INTEGER ndiagnum, ipointer
69        INTEGER kLev, nLevs, bibjFlg, biArg, bjArg        INTEGER kLev, nLevs, bibjFlg, biArg, bjArg
70        INTEGER myThid        INTEGER myThid
# Line 61  CEOP Line 72  CEOP
72    
73  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
74  C ===============  C ===============
75    C     useFract :: flag to increment (or not) with fraction-weigted inpFld
76          LOGICAL useFract
77          INTEGER sizF
78        INTEGER sizI1,sizI2,sizJ1,sizJ2        INTEGER sizI1,sizI2,sizJ1,sizJ2
79        INTEGER sizTx,sizTy        INTEGER sizTx,sizTy
80        INTEGER iRun, jRun, k, bi, bj        INTEGER iRun, jRun, k, bi, bj
# Line 154  C         and do the loop >> do k=kFirst Line 168  C         and do the loop >> do k=kFirst
168            ksgn = 0            ksgn = 0
169            kd0 = ipointer + kLev - 1            kd0 = ipointer + kLev - 1
170          ENDIF          ENDIF
171    C-      Set fraction-weight option :
172            useFract = nLevFract.GT.0
173            IF ( useFract ) THEN
174              sizF = nLevFract
175            ELSE
176              sizF = 1
177            ENDIF
178    
179  C-      Check for consistency with Nb of levels reserved in storage array  C-      Check for consistency with Nb of levels reserved in storage array
180          kStore = kd0 + MAX(ksgn*kFirst,ksgn*kLast) - ipointer + 1          kStore = kd0 + MAX(ksgn*kFirst,ksgn*kLast) - ipointer + 1
# Line 183  C-      Check for consistency with Nb of Line 204  C-      Check for consistency with Nb of
204              kd = kd0 + ksgn*k              kd = kd0 + ksgn*k
205              CALL DIAGNOSTICS_DO_FILL(              CALL DIAGNOSTICS_DO_FILL(
206       U                  qdiag(1-OLx,1-OLy,kd,bi,bj),       U                  qdiag(1-OLx,1-OLy,kd,bi,bj),
207       I                  inpFld,       I                  inpFld, fractFld, scaleFact, useFract,sizF,
208       I                  sizI1,sizI2,sizJ1,sizJ2,nLevs,sizTx,sizTy,       I                  sizI1,sizI2,sizJ1,sizJ2,nLevs,sizTx,sizTy,
209       I                  iRun,jRun,k,bi,bj,       I                  iRun,jRun,k,bi,bj,
210       I                  myThid)       I                  myThid)
# Line 197  C-      Check for consistency with Nb of Line 218  C-      Check for consistency with Nb of
218              kd = kd0 + ksgn*k              kd = kd0 + ksgn*k
219              CALL DIAGNOSTICS_DO_FILL(              CALL DIAGNOSTICS_DO_FILL(
220       U                  qdiag(1-OLx,1-OLy,kd,biArg,bjArg),       U                  qdiag(1-OLx,1-OLy,kd,biArg,bjArg),
221       I                  inpFld,       I                  inpFld, fractFld, scaleFact, useFract,sizF,
222       I                  sizI1,sizI2,sizJ1,sizJ2,nLevs,sizTx,sizTy,       I                  sizI1,sizI2,sizJ1,sizJ2,nLevs,sizTx,sizTy,
223       I                  iRun,jRun,k,bi,bj,       I                  iRun,jRun,k,bi,bj,
224       I                  myThid)       I                  myThid)
# Line 222  C     !ROUTINE: DIAGNOSTICS_DO_FILL Line 243  C     !ROUTINE: DIAGNOSTICS_DO_FILL
243  C     !INTERFACE:  C     !INTERFACE:
244        SUBROUTINE DIAGNOSTICS_DO_FILL(        SUBROUTINE DIAGNOSTICS_DO_FILL(
245       U                  cumFld,       U                  cumFld,
246       I                  inpFld,       I                  inpFld, frcFld, scaleFact, useFract,sizF,
247       I                  sizI1,sizI2,sizJ1,sizJ2,sizK,sizTx,sizTy,       I                  sizI1,sizI2,sizJ1,sizJ2,sizK,sizTx,sizTy,
248       I                  iRun,jRun,k,bi,bj,       I                  iRun,jRun,k,bi,bj,
249       I                  myThid)       I                  myThid)
# Line 242  C     !INPUT/OUTPUT PARAMETERS: Line 263  C     !INPUT/OUTPUT PARAMETERS:
263  C     == Routine Arguments ==  C     == Routine Arguments ==
264  C     cumFld      :: cumulative array (updated)  C     cumFld      :: cumulative array (updated)
265  C     inpFld      :: input field array to add to cumFld  C     inpFld      :: input field array to add to cumFld
266    C     frcFld      :: fraction used for weighted-average diagnostics
267    C     scaleFact   :: scaling factor
268    C     useFract    :: if True, use fraction-weight
269    C     sizF        :: size of frcFld array: 3rd  dimension
270  C     sizI1,sizI2 :: size of inpFld array: 1rst index range (min,max)  C     sizI1,sizI2 :: size of inpFld array: 1rst index range (min,max)
271  C     sizJ1,sizJ2 :: size of inpFld array: 2nd  index range (min,max)  C     sizJ1,sizJ2 :: size of inpFld array: 2nd  index range (min,max)
272  C     sizK        :: size of inpFld array: 3rd  dimension  C     sizK        :: size of inpFld array: 3rd  dimension
# Line 252  C                    to add to cumFld ar Line 277  C                    to add to cumFld ar
277  C     myThid      :: my Thread Id number  C     myThid      :: my Thread Id number
278        _RL cumFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL cumFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
279        INTEGER sizI1,sizI2,sizJ1,sizJ2        INTEGER sizI1,sizI2,sizJ1,sizJ2
280        INTEGER sizK,sizTx,sizTy        INTEGER sizF,sizK,sizTx,sizTy
281        _RL inpFld(sizI1:sizI2,sizJ1:sizJ2,sizK,sizTx,sizTy)        _RL inpFld(sizI1:sizI2,sizJ1:sizJ2,sizK,sizTx,sizTy)
282          _RL frcFld(sizI1:sizI2,sizJ1:sizJ2,sizF,sizTx,sizTy)
283          _RL scaleFact
284          LOGICAL useFract
285        INTEGER iRun, jRun, k, bi, bj        INTEGER iRun, jRun, k, bi, bj
286        INTEGER myThid        INTEGER myThid
287  CEOP  CEOP
288    
289  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
290  C     i,j    :: loop indices  C     i,j    :: loop indices
291        INTEGER i, j        INTEGER i, j, l
292    
293        DO j = 1,jRun  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
294         DO i = 1,iRun  
295          IF ( useFract ) THEN
296           l = MIN(k,sizF)
297           DO j = 1,jRun
298            DO i = 1,iRun
299              cumFld(i,j) = cumFld(i,j) + scaleFact*frcFld(i,j,l,bi,bj)
300         &                                         *inpFld(i,j,k,bi,bj)
301            ENDDO
302           ENDDO
303          ELSE
304           DO j = 1,jRun
305            DO i = 1,iRun
306  C- jmc: try with fixed ranges, that are known at compiling stage  C- jmc: try with fixed ranges, that are known at compiling stage
307  C        (might produce a better cash optimisation ?)  C        (might produce a better cash optimisation ?)
308  c     DO j = 1,sNy  c      DO j = 1,sNy
309  c      DO i = 1,sNx  c       DO i = 1,sNx
310          cumFld(i,j) = cumFld(i,j) + inpFld(i,j,k,bi,bj)            cumFld(i,j) = cumFld(i,j) + scaleFact*inpFld(i,j,k,bi,bj)
311            ENDDO
312         ENDDO         ENDDO
313        ENDDO        ENDIF
314    
315        RETURN        RETURN
316        END        END
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3
  ViewVC Help
Powered by ViewVC 1.1.22