/[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.4 by jmc, Tue Feb 5 15:31:19 2008 UTC revision 1.5 by jmc, Thu Sep 3 20:41:37 2009 UTC
# Line 3  C $Name$ Line 3  C $Name$
3    
4  #include "DIAG_OPTIONS.h"  #include "DIAG_OPTIONS.h"
5    
6    C--   File diagstats_fill.F:
7    C--    Contents:
8    C--    o DIAGSTATS_FILL
9    C--    o DIAGSTATS_TO_RL
10    
11    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
12    
13  CBOP  CBOP
14  C     !ROUTINE: DIAGSTATS_FILL  C     !ROUTINE: DIAGSTATS_FILL
15  C     !INTERFACE:  C     !INTERFACE:
16        SUBROUTINE DIAGSTATS_FILL(        SUBROUTINE DIAGSTATS_FILL(
17       I               inpFld, fractFld, scaleFact, power, nLevFract,       I               inpFldRL, fracFldRL,
18    #ifndef REAL4_IS_SLOW
19         I               inpFldRS, fracFldRS,
20    #endif
21         I               scaleFact, power, arrType, nLevFract,
22       I               ndId, kInQSd, region2fill, kLev, nLevs,       I               ndId, kInQSd, region2fill, kLev, nLevs,
23       I               bibjflg, biArg, bjArg, myThid )       I               bibjflg, biArg, bjArg, myThid )
24    
# Line 32  C     !INPUT PARAMETERS: Line 43  C     !INPUT PARAMETERS:
43  C***********************************************************************  C***********************************************************************
44  C  Arguments Description  C  Arguments Description
45  C  ----------------------  C  ----------------------
46  C     inpFld    :: Field to increment diagnostics array  C     inpFldRL  :: Field to increment diagnostics array (arrType=0,1)
47  C     fractFld  :: fraction used for weighted average diagnostics  C     fracFldRL :: fraction used for weighted average diagnostics (arrType=0,2)
48    C     inpFldRS  :: Field to increment diagnostics array (arrType=2,3)
49    C     fracFldRS :: fraction used for weighted average diagnostics (arrType=1,3)
50  C     scaleFact :: scaling factor  C     scaleFact :: scaling factor
51  C     power     :: option to fill-in with the field square (power=2)  C     power     :: option to fill-in with the field square (power=2)
52  C     nLevFract :: number of levels of the fraction field, =0 : do not use fraction  C     arrType   :: select which array & fraction (RL/RS) to process:
53    C                  0: both RL ; 1: inpRL & fracRS ; 2: inpRS,fracRL ; 3: both RS
54    C     nLevFract :: number of levels of the fraction field, =0: do not use fraction
55  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
56  C     kInQSd    :: Pointer to the slot in qSdiag to fill  C     kInQSd    :: Pointer to the slot in qSdiag to fill
57  C   region2fill :: array, indicates whether to compute statistics over region  C   region2fill :: array, indicates whether to compute statistics over region
# Line 65  C                  NOTE: User beware! If Line 80  C                  NOTE: User beware! If
80  C                        is sent here, bibjflg MUST NOT be set to 0  C                        is sent here, bibjflg MUST NOT be set to 0
81  C                        or there will be out of bounds problems!  C                        or there will be out of bounds problems!
82  C***********************************************************************  C***********************************************************************
83        _RL inpFld(*)        _RL inpFldRL(*)
84        _RL fractFld(*)        _RL fracFldRL(*)
85    #ifndef REAL4_IS_SLOW
86          _RS inpFldRS(*)
87          _RS fracFldRS(*)
88    #endif
89        _RL scaleFact        _RL scaleFact
90        INTEGER power        INTEGER power
91          INTEGER arrType
92        INTEGER nLevFract        INTEGER nLevFract
93        INTEGER ndId, kInQSd        INTEGER ndId, kInQSd
94        INTEGER region2fill(0:nRegions)        INTEGER region2fill(0:nRegions)
# Line 89  C     useFract  :: flag to increment (or Line 109  C     useFract  :: flag to increment (or
109        CHARACTER*8 parms1        CHARACTER*8 parms1
110        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
111        INTEGER km, km0        INTEGER km, km0
112    #ifndef REAL4_IS_SLOW
113          _RL tmpFldRL( sNx+1,sNy+1)
114          _RL tmpFracRL(sNx+1,sNy+1)
115    #endif
116    
117  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
118  c     IF ( ndId.NE.0 .AND. kInQSd.NE.0 ) THEN  c     IF ( ndId.NE.0 .AND. kInQSd.NE.0 ) THEN
# Line 189  C-      Check for consistency with Nb of Line 213  C-      Check for consistency with Nb of
213           _END_MASTER(myThid)           _END_MASTER(myThid)
214          ENDIF          ENDIF
215    
216    #ifndef REAL4_IS_SLOW
217          IF ( arrType.EQ.0 .OR. ( arrType.EQ.1 .AND. .NOT.useFract ) ) THEN
218    #endif
219          IF ( bibjflg.EQ.0 ) THEN          IF ( bibjflg.EQ.0 ) THEN
   
220           DO bj=myByLo(myThid), myByHi(myThid)           DO bj=myByLo(myThid), myByHi(myThid)
221            DO bi=myBxLo(myThid), myBxHi(myThid)            DO bi=myBxLo(myThid), myBxHi(myThid)
222             DO k = kFirst,kLast             DO k = kFirst,kLast
# Line 198  C-      Check for consistency with Nb of Line 224  C-      Check for consistency with Nb of
224              km = km0 + ksgn*k              km = km0 + ksgn*k
225              CALL DIAGSTATS_LOCAL(              CALL DIAGSTATS_LOCAL(
226       U                  qSdiag(0,0,kd,bi,bj),       U                  qSdiag(0,0,kd,bi,bj),
227       I                  inpFld, fractFld,       I                  inpFldRL, fracFldRL,
228       I                  scaleFact, power, useFract, sizF,       I                  scaleFact, power, useFract, sizF,
229       I                  sizI1,sizI2,sizJ1,sizJ2,nLevs,sizTx,sizTy,       I                  sizI1,sizI2,sizJ1,sizJ2,nLevs,sizTx,sizTy,
230       I                  iRun,jRun,k,bi,bj,       I                  iRun,jRun,k,bi,bj,
# Line 215  C-      Check for consistency with Nb of Line 241  C-      Check for consistency with Nb of
241              km = km0 + ksgn*k              km = km0 + ksgn*k
242              CALL DIAGSTATS_LOCAL(              CALL DIAGSTATS_LOCAL(
243       U                  qSdiag(0,0,kd,biArg,bjArg),       U                  qSdiag(0,0,kd,biArg,bjArg),
244       I                  inpFld, fractFld,       I                  inpFldRL, fracFldRL,
245       I                  scaleFact, power, useFract, sizF,       I                  scaleFact, power, useFract, sizF,
246       I                  sizI1,sizI2,sizJ1,sizJ2,nLevs,sizTx,sizTy,       I                  sizI1,sizI2,sizJ1,sizJ2,nLevs,sizTx,sizTy,
247       I                  iRun,jRun,k,bi,bj,       I                  iRun,jRun,k,bi,bj,
# Line 224  C-      Check for consistency with Nb of Line 250  C-      Check for consistency with Nb of
250            ENDDO            ENDDO
251          ENDIF          ENDIF
252    
253    #ifndef REAL4_IS_SLOW
254          ELSE
255            IF ( bibjflg.EQ.0 ) THEN
256             DO bj=myByLo(myThid), myByHi(myThid)
257              DO bi=myBxLo(myThid), myBxHi(myThid)
258               DO k = kFirst,kLast
259                kd = kd0 + ksgn*k
260                km = km0 + ksgn*k
261                CALL DIAGSTATS_TO_RL(
262         I                  inpFldRL, fracFldRL, inpFldRS, fracFldRS,
263         O                  tmpFldRL, tmpFracRL,
264         I                  arrType, useFract, sizF,
265         I                  sizI1,sizI2,sizJ1,sizJ2,nLevs,sizTx,sizTy,
266         I                  iRun,jRun,k,bi,bj, myThid )
267                CALL DIAGSTATS_LOCAL(
268         U                  qSdiag(0,0,kd,bi,bj),
269         I                  tmpFldRL, tmpFracRL,
270         I                  scaleFact, power, useFract, 1,
271         I                  1, iRun, 1, jRun, 1, 1, 1,
272         I                  iRun, jRun, 1, 1, 1,
273         I                  km, bi, bj, region2fill,
274         I                  ndId, gdiag(ndId), myThid )
275               ENDDO
276              ENDDO
277             ENDDO
278            ELSE
279              bi = MIN(biArg,sizTx)
280              bj = MIN(bjArg,sizTy)
281              DO k = kFirst,kLast
282                kd = kd0 + ksgn*k
283                km = km0 + ksgn*k
284                CALL DIAGSTATS_TO_RL(
285         I                  inpFldRL, fracFldRL, inpFldRS, fracFldRS,
286         O                  tmpFldRL, tmpFracRL,
287         I                  arrType, useFract, sizF,
288         I                  sizI1,sizI2,sizJ1,sizJ2,nLevs,sizTx,sizTy,
289         I                  iRun,jRun,k,bi,bj, myThid )
290                CALL DIAGSTATS_LOCAL(
291         U                  qSdiag(0,0,kd,biArg,bjArg),
292         I                  tmpFldRL, tmpFracRL,
293         I                  scaleFact, power, useFract, 1,
294         I                  1, iRun, 1, jRun, 1, 1, 1,
295         I                  iRun, jRun, 1, 1, 1,
296         I                  km, biArg, bjArg, region2fill,
297         I                  ndId, gdiag(ndId), myThid )
298              ENDDO
299            ENDIF
300          ENDIF
301    #endif /* ndef REAL4_IS_SLOW */
302    
303  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
304  c     ELSE  c     ELSE
305    
# Line 231  c     ENDIF Line 307  c     ENDIF
307    
308        RETURN        RETURN
309        END        END
310    
311    #ifndef REAL4_IS_SLOW
312    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
313    
314    CBOP
315    C     !ROUTINE: DIAGSTATS_TO_RL
316    C     !INTERFACE:
317          SUBROUTINE DIAGSTATS_TO_RL(
318         I                  inpFldRL, inpFrcRL, inpFldRS, inpFrcRS,
319         O                  outFldRL, outFrcRL,
320         I                  arrType, useFract, sizF,
321         I                  sizI1,sizI2,sizJ1,sizJ2,sizK,sizTx,sizTy,
322         I                  iRun,jRun,kIn,biIn,bjIn,
323         I                  myThid )
324    
325    C     !DESCRIPTION:
326    C     Do a local copy with conversion to RL type array
327    
328    C     !USES:
329          IMPLICIT NONE
330    
331    #include "EEPARAMS.h"
332    #include "SIZE.h"
333    
334    C     !INPUT/OUTPUT PARAMETERS:
335    C     == Routine Arguments ==
336    C     inpFldRL    :: input field array    to convert (arrType=0,1)
337    C     inpFrcRL    :: input fraction array to convert (arrType=0,2)
338    C     inpFldRS    :: input field array    to convert (arrType=2,3)
339    C     inpFrcRS    :: input fraction array to convert (arrType=1,3)
340    C     outFldRL    :: output field array
341    C     outFrcRL    :: output fraction array
342    C     arrType     :: select which array & fraction (RL/RS) to process:
343    C                    0: both RL ; 1: fldRL & frcRS ; 2: fldRS,frcRL ; 3: both RS
344    C     useFract    :: if True, process fraction-weight
345    C     sizF        :: size of inpFrc array: 3rd  dimension
346    C     sizI1,sizI2 :: size of inpFld array: 1rst index range (min,max)
347    C     sizJ1,sizJ2 :: size of inpFld array: 2nd  index range (min,max)
348    C     sizK        :: size of inpFld array: 3rd  dimension
349    C     sizTx,sizTy :: size of inpFld array: tile dimensions
350    C     iRun,jRun   :: range of 1rst & 2nd index
351    C     kIn         :: level index of inpFld array to process
352    C     biIn,bjIn   :: tile indices of inpFld array to process
353    C     myThid      :: my Thread Id number
354          INTEGER sizI1,sizI2,sizJ1,sizJ2
355          INTEGER sizF,sizK,sizTx,sizTy
356          INTEGER iRun, jRun, kIn, biIn, bjIn
357          _RL     inpFldRL(sizI1:sizI2,sizJ1:sizJ2,sizK,sizTx,sizTy)
358          _RL     inpFrcRL(sizI1:sizI2,sizJ1:sizJ2,sizF,sizTx,sizTy)
359          _RS     inpFldRS(sizI1:sizI2,sizJ1:sizJ2,sizK,sizTx,sizTy)
360          _RS     inpFrcRS(sizI1:sizI2,sizJ1:sizJ2,sizF,sizTx,sizTy)
361          _RL     outFldRL(1:iRun,1:jRun)
362          _RL     outFrcRL(1:iRun,1:jRun)
363          INTEGER arrType
364          LOGICAL useFract
365          INTEGER myThid
366    CEOP
367    
368    C     !LOCAL VARIABLES:
369    C     i,j    :: loop indices
370          INTEGER i, j, kFr
371    
372          IF ( arrType.LE.1 ) THEN
373            DO j=1,jRun
374             DO i=1,iRun
375               outFldRL(i,j) = inpFldRL(i,j,kIn,biIn,bjIn)
376             ENDDO
377            ENDDO
378          ELSE
379            DO j=1,jRun
380             DO i=1,iRun
381               outFldRL(i,j) = inpFldRS(i,j,kIn,biIn,bjIn)
382             ENDDO
383            ENDDO
384          ENDIF
385    
386          IF ( useFract ) THEN
387           kFr = MIN(kIn,sizF)
388           IF ( arrType.EQ.0 .OR. arrType.EQ.2 ) THEN
389            DO j=1,jRun
390             DO i=1,iRun
391               outFrcRL(i,j) = inpFrcRL(i,j,kFr,biIn,bjIn)
392             ENDDO
393            ENDDO
394           ELSE
395            DO j=1,jRun
396             DO i=1,iRun
397               outFrcRL(i,j) = inpFrcRS(i,j,kFr,biIn,bjIn)
398             ENDDO
399            ENDDO
400           ENDIF
401          ENDIF
402    
403          RETURN
404          END
405    #endif /* ndef REAL4_IS_SLOW */
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5
  ViewVC Help
Powered by ViewVC 1.1.22