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

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

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

revision 1.4 by jmc, Mon Jul 31 16:26:32 2006 UTC revision 1.7 by jmc, Wed Jun 15 13:50:22 2011 UTC
# Line 8  C     !ROUTINE: DIAGNOSTICS_FRACT_FILL Line 8  C     !ROUTINE: DIAGNOSTICS_FRACT_FILL
8  C     !INTERFACE:  C     !INTERFACE:
9        SUBROUTINE DIAGNOSTICS_FRACT_FILL(        SUBROUTINE DIAGNOSTICS_FRACT_FILL(
10       I               inpFld, fractFld, scaleFact, power, chardiag,       I               inpFld, fractFld, scaleFact, power, chardiag,
11       I               kLev, nLevs, bibjFlg, biArg, bjArg, myThid)       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           using a scaling factor & square option (power=2)  C           using a scaling factor & square option (power=2)
17  C           and using a fraction-weight (assumed to be the counter-mate  C           and using a RL fraction-weight (assumed to be the
18  C           of the current diagnostics)  C           counter-mate of the current diagnostics)
19  C   Note: 1) fraction-weight has to correspond to the diagnostics  C   Note: 1) fraction-weight has to correspond to the diagnostics
20  C            counter-mate (filled independently with a call to  C            counter-mate (filled independently with a call to
21  C             DIAGNOSTICS_FILL)  C             DIAGNOSTICS_FILL)
# Line 75  CEOP Line 75  CEOP
75    
76  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
77  C     ndId      :: diagnostic Id number (in available diagnostics list)  C     ndId      :: diagnostic Id number (in available diagnostics list)
 C ===============  
78        INTEGER m, n, j, k, l, bi, bj        INTEGER m, n, j, k, l, bi, bj
79        INTEGER ndId, ipt, iSp        INTEGER ndId, ipt, iSp
80        INTEGER region2fill(0:nRegions)        INTEGER region2fill(0:nRegions)
81        INTEGER mate, nLevFract        INTEGER mate, nLevFract
82        CHARACTER*8 parms1        CHARACTER*10 gcode
83        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
84          INTEGER arrType
85          _RS     dummyRS(1)
86    C ===============
87    
88          arrType = 0
89        IF ( bibjFlg.EQ.0 ) THEN        IF ( bibjFlg.EQ.0 ) THEN
90          bi = myBxLo(myThid)          bi = myBxLo(myThid)
91          bj = myByLo(myThid)          bj = myByLo(myThid)
# Line 102  C we are trying to fill a valid diagnost Line 105  C we are trying to fill a valid diagnost
105             ipt = ipt + pdiag(n,bi,bj)*kdiag(ndId)             ipt = ipt + pdiag(n,bi,bj)*kdiag(ndId)
106  C-    check for a counter-mate:  C-    check for a counter-mate:
107             mate = 0             mate = 0
108             parms1 = gdiag(ndId)(1:8)             gcode = gdiag(ndId)(1:10)
109             IF ( parms1(5:5).EQ.'C' ) READ(parms1,'(5X,I3)') mate             IF ( gcode(5:5).EQ.'C' ) mate = hdiag(ndId)
            IF ( mdiag(m,n).EQ.0 ) mate = 0  
110             IF ( mate.LE.0 ) THEN             IF ( mate.LE.0 ) THEN
111               WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_FRACT_FILL: ',               WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_FRACT_FILL: ',
112       &            'did not find a valid counter-mate'       &            'did not find a valid counter-mate'
113               CALL PRINT_ERROR( msgBuf , myThid )               CALL PRINT_ERROR( msgBuf , myThid )
114               WRITE(msgBuf,'(2A,I4,2A)') 'DIAGNOSTICS_FRACT_FILL: ',               WRITE(msgBuf,'(2A,I6,2A)') 'DIAGNOSTICS_FRACT_FILL: ',
115       &            'for diag(#',ndId,' ) :', chardiag       &            'for diag(#',ndId,' ) :', chardiag
116               CALL PRINT_ERROR( msgBuf , myThid )               CALL PRINT_ERROR( msgBuf , myThid )
117               STOP 'ABNORMAL END: S/R DIAGNOSTICS_FRACT_FILL'               STOP 'ABNORMAL END: S/R DIAGNOSTICS_FRACT_FILL'
# Line 118  C-    set the nb of levels of fraction-w Line 120  C-    set the nb of levels of fraction-w
120             nLevFract = MIN(nLevs,kdiag(mate))             nLevFract = MIN(nLevs,kdiag(mate))
121  C-    diagnostic is valid & active, has a counter-mate, do the filling:  C-    diagnostic is valid & active, has a counter-mate, do the filling:
122             CALL DIAGNOSTICS_FILL_FIELD(             CALL DIAGNOSTICS_FILL_FIELD(
123       I              inpFld, fractFld, scaleFact, power, nLevFract,       I              inpFld, fractFld, dummyRS, dummyRS,
124         I              scaleFact, power, arrType, nLevFract,
125       I              ndId, ipt, kLev, nLevs,       I              ndId, ipt, kLev, nLevs,
126       I              bibjFlg, biArg, bjArg, myThid )       I              bibjFlg, biArg, bjArg, myThid )
127           ENDIF           ENDIF
# Line 140  C we are trying to compute & fill a vali Line 143  C we are trying to compute & fill a vali
143             ndId = jSdiag(m,n)             ndId = jSdiag(m,n)
144  C-    check for a counter-mate:  C-    check for a counter-mate:
145             mate = 0             mate = 0
146             parms1 = gdiag(ndId)(1:8)             gcode = gdiag(ndId)(1:10)
147             IF ( parms1(5:5).EQ.'C' ) READ(parms1,'(5X,I3)') mate  c          IF ( gcode(5:5).EQ.'C' ) READ(gcode,'(5X,I3)') mate
148             IF ( mSdiag(m,n).EQ.0 ) mate = 0             IF ( gcode(5:5).EQ.'C' ) mate = hdiag(ndId)
149             IF ( mate.LE.0 ) THEN             IF ( mate.LE.0 ) THEN
150               WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_FRACT_FILL: ',               WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_FRACT_FILL: ',
151       &            'did not find a valid counter-mate'       &            'did not find a valid counter-mate'
152               CALL PRINT_ERROR( msgBuf , myThid )               CALL PRINT_ERROR( msgBuf , myThid )
153               WRITE(msgBuf,'(2A,I4,2A)') 'DIAGNOSTICS_FRACT_FILL: ',               WRITE(msgBuf,'(2A,I6,2A)') 'DIAGNOSTICS_FRACT_FILL: ',
154       &            'for diag(#',ndId,' ) :', chardiag       &            'for diag(#',ndId,' ) :', chardiag
155               CALL PRINT_ERROR( msgBuf , myThid )               CALL PRINT_ERROR( msgBuf , myThid )
156               STOP 'ABNORMAL END: S/R DIAGNOSTICS_FRACT_FILL'               STOP 'ABNORMAL END: S/R DIAGNOSTICS_FRACT_FILL'
# Line 171  C     then add regions from other lists Line 174  C     then add regions from other lists
174             ENDDO             ENDDO
175  C-    diagnostics is valid and Active, has a counter mate: Now do the filling  C-    diagnostics is valid and Active, has a counter mate: Now do the filling
176             CALL DIAGSTATS_FILL(             CALL DIAGSTATS_FILL(
177       I              inpFld, fractFld, scaleFact, power, nLevFract,       I              inpFld, fractFld,
178    #ifndef REAL4_IS_SLOW
179         I              dummyRS, dummyRS,
180    #endif
181         I              scaleFact, power, arrType, nLevFract,
182       I              ndId, iSp, region2fill, kLev, nLevs,       I              ndId, iSp, region2fill, kLev, nLevs,
183       I              bibjFlg, biArg, bjArg, myThid )       I              bibjFlg, biArg, bjArg, myThid )
184           ENDIF           ENDIF
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.7
  ViewVC Help
Powered by ViewVC 1.1.22