/[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.2 by jmc, Mon Jul 11 18:59:07 2005 UTC revision 1.5 by jmc, Tue Feb 5 15:13:01 2008 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***********************************************************************
# Line 80  C =============== Line 80  C ===============
80        INTEGER ndId, ipt, iSp        INTEGER ndId, ipt, iSp
81        INTEGER region2fill(0:nRegions)        INTEGER region2fill(0:nRegions)
82        INTEGER mate, nLevFract        INTEGER mate, nLevFract
83        CHARACTER*8 parms1        CHARACTER*10 gcode
84        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
85    
86        IF ( bibjFlg.EQ.0 ) THEN        IF ( bibjFlg.EQ.0 ) THEN
87          bi = 1          bi = myBxLo(myThid)
88          bj = 1          bj = myByLo(myThid)
89        ELSE        ELSE
90          bi = biArg          bi = biArg
91          bj = bjArg          bj = bjArg
# Line 99  C we are trying to fill a valid diagnost Line 99  C we are trying to fill a valid diagnost
99           ipt = idiag(m,n)           ipt = idiag(m,n)
100           IF ( ndiag(ipt,bi,bj).GE.0 ) THEN           IF ( ndiag(ipt,bi,bj).GE.0 ) THEN
101             ndId = jdiag(m,n)             ndId = jdiag(m,n)
102               ipt = ipt + pdiag(n,bi,bj)*kdiag(ndId)
103  C-    check for a counter-mate:  C-    check for a counter-mate:
104             mate = 0             mate = 0
105             parms1 = gdiag(ndId)(1:8)             gcode = gdiag(ndId)(1:10)
106             IF ( parms1(5:5).EQ.'C' ) READ(parms1,'(5X,I3)') mate             IF ( gcode(5:5).EQ.'C' ) mate = hdiag(ndId)
107             IF ( mdiag(m,n).EQ.0 ) mate = 0             IF ( mdiag(m,n).EQ.0 ) mate = 0
108             IF ( mate.LE.0 ) THEN             IF ( mate.LE.0 ) THEN
109               WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_FRACT_FILL: ',               WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_FRACT_FILL: ',
110       &            'did not find a valid counter-mate'       &            'did not find a valid counter-mate'
111               CALL PRINT_ERROR( msgBuf , myThid )               CALL PRINT_ERROR( msgBuf , myThid )
112               WRITE(msgBuf,'(2A,I4,2A)') 'DIAGNOSTICS_FRACT_FILL: ',               WRITE(msgBuf,'(2A,I6,2A)') 'DIAGNOSTICS_FRACT_FILL: ',
113       &            'for diag(#',ndId,' ) :', chardiag       &            'for diag(#',ndId,' ) :', chardiag
114               CALL PRINT_ERROR( msgBuf , myThid )               CALL PRINT_ERROR( msgBuf , myThid )
115               STOP 'ABNORMAL END: S/R DIAGNOSTICS_FRACT_FILL'               STOP 'ABNORMAL END: S/R DIAGNOSTICS_FRACT_FILL'
# Line 139  C we are trying to compute & fill a vali Line 140  C we are trying to compute & fill a vali
140             ndId = jSdiag(m,n)             ndId = jSdiag(m,n)
141  C-    check for a counter-mate:  C-    check for a counter-mate:
142             mate = 0             mate = 0
143             parms1 = gdiag(ndId)(1:8)             gcode = gdiag(ndId)(1:10)
144             IF ( parms1(5:5).EQ.'C' ) READ(parms1,'(5X,I3)') mate  c          IF ( gcode(5:5).EQ.'C' ) READ(gcode,'(5X,I3)') mate
145               IF ( gcode(5:5).EQ.'C' ) mate = hdiag(ndId)
146             IF ( mSdiag(m,n).EQ.0 ) mate = 0             IF ( mSdiag(m,n).EQ.0 ) mate = 0
147             IF ( mate.LE.0 ) THEN             IF ( mate.LE.0 ) THEN
148               WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_FRACT_FILL: ',               WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_FRACT_FILL: ',
149       &            'did not find a valid counter-mate'       &            'did not find a valid counter-mate'
150               CALL PRINT_ERROR( msgBuf , myThid )               CALL PRINT_ERROR( msgBuf , myThid )
151               WRITE(msgBuf,'(2A,I4,2A)') 'DIAGNOSTICS_FRACT_FILL: ',               WRITE(msgBuf,'(2A,I6,2A)') 'DIAGNOSTICS_FRACT_FILL: ',
152       &            'for diag(#',ndId,' ) :', chardiag       &            'for diag(#',ndId,' ) :', chardiag
153               CALL PRINT_ERROR( msgBuf , myThid )               CALL PRINT_ERROR( msgBuf , myThid )
154               STOP 'ABNORMAL END: S/R DIAGNOSTICS_FRACT_FILL'               STOP 'ABNORMAL END: S/R DIAGNOSTICS_FRACT_FILL'
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.5
  ViewVC Help
Powered by ViewVC 1.1.22