/[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.16 by jmc, Wed Aug 14 01:00:11 2013 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***********************************************************************
15  C   Wrapper routine to increment the diagnostics arrays with a field  C   Wrapper routine to increment the diagnostics arrays with a RL field
16  C***********************************************************************  C***********************************************************************
17  C     !USES:  C     !USES:
18        IMPLICIT NONE        IMPLICIT NONE
# 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
43  C                     AND that we have been sent a local array (with overlap regions)  C                     AND that we have been sent a local array (with overlap regions)
44    C                     (local array here means that it has no bi-bj dimensions)
45  C                  3 indicates that the bi-bj loop is done OUTSIDE  C                  3 indicates that the bi-bj loop is done OUTSIDE
46  C                     AND that we have been sent a local array  C                     AND that we have been sent a local array
47  C                     AND that the array has no overlap region (interior only)  C                     AND that the array has no overlap region (interior only)
48  C                  NOTE - bibjFlg can be NEGATIVE to indicate not to increment counter  C                  NOTE - bibjFlg can be NEGATIVE to indicate not to increment counter
49  C     biArg ...... X-direction tile number - used for bibjFlg=1-3  C     biArg     :: X-direction tile number - used for bibjFlg=1-3
50  C     bjArg ...... Y-direction tile number - used for bibjFlg=1-3  C     bjArg     :: Y-direction tile number - used for bibjFlg=1-3
51  C     myThid     ::  my thread Id number  C     myThid    ::  my thread Id number
52  C***********************************************************************  C***********************************************************************
53  C                  NOTE: User beware! If a local (1 tile only) array  C                  NOTE: User beware! If a local (1 tile only) array
54  C                        is sent here, bibjFlg MUST NOT be set to 0  C                        is sent here, bibjFlg MUST NOT be set to 0
55  C                        or there will be out of bounds problems!  C                        or there will be out of bounds problems!
56  C***********************************************************************  C***********************************************************************
57        _RL inpfld(*)        _RL     inpFld(*)
58        CHARACTER*8 chardiag        CHARACTER*8 chardiag
59        INTEGER kLev, nLevs, bibjFlg, biArg, bjArg        INTEGER kLev, nLevs, bibjFlg, biArg, bjArg
60        INTEGER myThid        INTEGER myThid
# Line 60  CEOP Line 62  CEOP
62    
63  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
64  C     ndId      :: diagnostic Id number (in available diagnostics list)  C     ndId      :: diagnostic Id number (in available diagnostics list)
 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          INTEGER arrType
69          _RL     scaleFact
70          _RL     dummyRL(1)
71          _RS     dummyRS(1)
72    C ===============
73    
74    C--   Check if this S/R is called from the right place ;
75    C     needs to be after DIAGNOSTICS_SWITCH_ONOFF and before DIAGNOSTICS_WRITE
76          IF ( diag_pkgStatus.NE.ready2fillDiags ) THEN
77            CALL DIAGNOSTICS_STATUS_ERROR( 'DIAGNOSTICS_FILL',
78         &                   ' ', chardiag, ready2fillDiags, myThid )
79          ENDIF
80    
81          arrType = 0
82          scaleFact = 1. _d 0
83        IF ( bibjFlg.EQ.0 ) THEN        IF ( bibjFlg.EQ.0 ) THEN
84          bi = 1          bi = myBxLo(myThid)
85          bj = 1          bj = myByLo(myThid)
86        ELSE        ELSE
87          bi = biArg          bi = biArg
88          bj = bjArg          bj = bjArg
# Line 80  C we are trying to fill a valid diagnost Line 95  C we are trying to fill a valid diagnost
95          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
96           ipt = idiag(m,n)           ipt = idiag(m,n)
97           IF ( ndiag(ipt,bi,bj).GE.0 ) THEN           IF ( ndiag(ipt,bi,bj).GE.0 ) THEN
 C diagnostic is valid & active, do the filling:  
98             ndId = jdiag(m,n)             ndId = jdiag(m,n)
99             CALL DIAGNOSTICS_FILL_FIELD( inpfld, ndId, ipt,             ipt = ipt + pdiag(n,bi,bj)*kdiag(ndId)
100       I                kLev, nLevs, bibjFlg, biArg, bjArg, myThid )  C-    diagnostic is valid & active, do the filling:
101               CALL DIAGNOSTICS_FILL_FIELD(
102         I              inpFld, dummyRL, dummyRS, dummyRS,
103         I              scaleFact, 1, arrType, 0,
104         I              ndId, ipt, kLev, nLevs,
105         I              bibjFlg, biArg, bjArg, myThid )
106           ENDIF           ENDIF
107          ENDIF          ENDIF
108         ENDDO         ENDDO
# Line 100  C we are trying to compute & fill a vali Line 119  C we are trying to compute & fill a vali
119          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
120           iSp = iSdiag(m,n)           iSp = iSdiag(m,n)
121           IF ( qSdiag(0,0,iSp,bi,bj).GE.0. ) THEN           IF ( qSdiag(0,0,iSp,bi,bj).GE.0. ) THEN
122  C-         diagnostics is valid and Active. Find list of regions to fill:             ndId = jSdiag(m,n)
123    C-    Find list of regions to fill:
124             DO j=0,nRegions             DO j=0,nRegions
125              region2fill(j) = diagSt_region(j,n)              region2fill(j) = diagSt_region(j,n)
126             ENDDO             ENDDO
127  C-         if this diagnostics appears in several lists (with same freq)  C-    if this diagnostics appears in several lists (with same freq)
128  C          then add regions from other lists  C     then add regions from other lists
129             DO l=1,diagSt_nbLists             DO l=1,diagSt_nbLists
130              DO k=1,diagSt_nbActv(l)              DO k=1,diagSt_nbActv(l)
131               IF ( iSdiag(k,l).EQ.-iSp ) THEN               IF ( iSdiag(k,l).EQ.-iSp ) THEN
# Line 115  C          then add regions from other l Line 135  C          then add regions from other l
135               ENDIF               ENDIF
136              ENDDO              ENDDO
137             ENDDO             ENDDO
138  C-         Now do the filling :  C-    diagnostics is valid and Active: Now do the filling
139             ndId = jSdiag(m,n)             CALL DIAGSTATS_FILL(
140             CALL DIAGSTATS_FILL( inpfld, ndId, iSp, region2fill,       I              inpFld, dummyRL,
141       I                kLev, nLevs, bibjFlg, biArg, bjArg, myThid )  #ifndef REAL4_IS_SLOW
142         I              dummyRS, dummyRS,
143    #endif
144         I              scaleFact, 1, arrType, 0,
145         I              ndId, iSp, region2fill, kLev, nLevs,
146         I              bibjFlg, biArg, bjArg, myThid )
147           ENDIF           ENDIF
148          ENDIF          ENDIF
149         ENDDO         ENDDO
Legend:
Removed from v.1.9  
changed lines
  Added in v.1.16
  ViewVC Help
Powered by ViewVC 1.1.22