/[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.9 by jmc, Sun Jun 26 16:51:49 2005 UTC revision 1.10 by jmc, Sun Jul 10 00:57:18 2005 UTC
# Line 6  C $Name$ Line 6  C $Name$
6  CBOP  CBOP
7  C     !ROUTINE: DIAGNOSTICS_FILL  C     !ROUTINE: DIAGNOSTICS_FILL
8  C     !INTERFACE:  C     !INTERFACE:
9        SUBROUTINE DIAGNOSTICS_FILL (inpfld, chardiag,        SUBROUTINE DIAGNOSTICS_FILL(
10       I                kLev, nLevs, bibjFlg, biArg, bjArg, myThid)       I                inpFld, chardiag,
11         I                kLev, nLevs, bibjFlg, biArg, bjArg, myThid )
12    
13  C     !DESCRIPTION:  C     !DESCRIPTION:
14  C***********************************************************************  C***********************************************************************
# Line 26  C     !INPUT PARAMETERS: Line 27  C     !INPUT PARAMETERS:
27  C***********************************************************************  C***********************************************************************
28  C  Arguments Description  C  Arguments Description
29  C  ----------------------  C  ----------------------
30  C     inpfld ..... Field to increment diagnostics array  C     inpFld    :: Field to increment diagnostics array
31  C     chardiag ... Character expression for diag to fill  C     chardiag  :: Character expression for diag to fill
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                  3 indicates that the Line 45  C                  3 indicates that the
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        CHARACTER*8 chardiag        CHARACTER*8 chardiag
58        INTEGER kLev, nLevs, bibjFlg, biArg, bjArg        INTEGER kLev, nLevs, bibjFlg, biArg, bjArg
59        INTEGER myThid        INTEGER myThid
# Line 64  C =============== Line 65  C ===============
65        INTEGER m, n, j, k, l, bi, bj        INTEGER m, n, j, k, l, bi, bj
66        INTEGER ndId, ipt, iSp        INTEGER ndId, ipt, iSp
67        INTEGER region2fill(0:nRegions)        INTEGER region2fill(0:nRegions)
68          _RL     scaleFact
69    
70          scaleFact = 1. _d 0
71        IF ( bibjFlg.EQ.0 ) THEN        IF ( bibjFlg.EQ.0 ) THEN
72          bi = 1          bi = 1
73          bj = 1          bj = 1
# Line 80  C we are trying to fill a valid diagnost Line 83  C we are trying to fill a valid diagnost
83          IF ( chardiag.EQ.flds(m,n) .AND. idiag(m,n).GT.0 ) THEN          IF ( chardiag.EQ.flds(m,n) .AND. idiag(m,n).GT.0 ) THEN
84           ipt = idiag(m,n)           ipt = idiag(m,n)
85           IF ( ndiag(ipt,bi,bj).GE.0 ) THEN           IF ( ndiag(ipt,bi,bj).GE.0 ) THEN
 C diagnostic is valid & active, do the filling:  
86             ndId = jdiag(m,n)             ndId = jdiag(m,n)
87             CALL DIAGNOSTICS_FILL_FIELD( inpfld, ndId, ipt,  C-    diagnostic is valid & active, do the filling:
88       I                kLev, nLevs, bibjFlg, biArg, bjArg, myThid )             CALL DIAGNOSTICS_FILL_FIELD(
89         I                inpFld, inpFld, scaleFact, 0,
90         I                ndId, ipt, kLev, nLevs,
91         I                bibjFlg, biArg, bjArg, myThid )
92           ENDIF           ENDIF
93          ENDIF          ENDIF
94         ENDDO         ENDDO
# Line 100  C we are trying to compute & fill a vali Line 105  C we are trying to compute & fill a vali
105          IF ( chardiag.EQ.diagSt_Flds(m,n) .AND. iSdiag(m,n).GT.0 ) THEN          IF ( chardiag.EQ.diagSt_Flds(m,n) .AND. iSdiag(m,n).GT.0 ) THEN
106           iSp = iSdiag(m,n)           iSp = iSdiag(m,n)
107           IF ( qSdiag(0,0,iSp,bi,bj).GE.0. ) THEN           IF ( qSdiag(0,0,iSp,bi,bj).GE.0. ) THEN
108  C-         diagnostics is valid and Active. Find list of regions to fill:             ndId = jSdiag(m,n)
109    C-    Find list of regions to fill:
110             DO j=0,nRegions             DO j=0,nRegions
111              region2fill(j) = diagSt_region(j,n)              region2fill(j) = diagSt_region(j,n)
112             ENDDO             ENDDO
113  C-         if this diagnostics appears in several lists (with same freq)  C-    if this diagnostics appears in several lists (with same freq)
114  C          then add regions from other lists  C     then add regions from other lists
115             DO l=1,diagSt_nbLists             DO l=1,diagSt_nbLists
116              DO k=1,diagSt_nbActv(l)              DO k=1,diagSt_nbActv(l)
117               IF ( iSdiag(k,l).EQ.-iSp ) THEN               IF ( iSdiag(k,l).EQ.-iSp ) THEN
# Line 115  C          then add regions from other l Line 121  C          then add regions from other l
121               ENDIF               ENDIF
122              ENDDO              ENDDO
123             ENDDO             ENDDO
124  C-         Now do the filling :  C-    diagnostics is valid and Active: Now do the filling
125             ndId = jSdiag(m,n)             CALL DIAGSTATS_FILL(
126             CALL DIAGSTATS_FILL( inpfld, ndId, iSp, region2fill,       I                inpFld, inpFld, scaleFact, 0,
127       I                kLev, nLevs, bibjFlg, biArg, bjArg, myThid )       I                ndId, iSp, region2fill, kLev, nLevs,
128         I                bibjFlg, biArg, bjArg, myThid )
129           ENDIF           ENDIF
130          ENDIF          ENDIF
131         ENDDO         ENDDO
Legend:
Removed from v.1.9  
changed lines
  Added in v.1.10
  ViewVC Help
Powered by ViewVC 1.1.22