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

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

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

revision 1.53 by jmc, Tue Jun 14 00:18:37 2011 UTC revision 1.54 by jmc, Tue Jun 21 18:00:48 2011 UTC
# Line 67  c     COMMON /LOCAL_DIAGNOSTICS_OUT/ qtm Line 67  c     COMMON /LOCAL_DIAGNOSTICS_OUT/ qtm
67    
68        INTEGER i, j, k, lm        INTEGER i, j, k, lm
69        INTEGER bi, bj        INTEGER bi, bj
70        INTEGER md, ndId, ip, im        INTEGER md, ndId, nn, ip, im
71        INTEGER mate, mVec        INTEGER mate, mDbl, mVec
72        CHARACTER*10 gcode        CHARACTER*10 gcode
73        _RL undefRL        _RL undefRL
       INTEGER nFilled  
74        INTEGER nLevOutp, kLev        INTEGER nLevOutp, kLev
75    
76        INTEGER iLen        INTEGER iLen
# Line 180  C---+----1----+----2----+----3----+----4 Line 179  C---+----1----+----2----+----3----+----4
179          gcode = gdiag(ndId)(1:10)          gcode = gdiag(ndId)(1:10)
180          mate = 0          mate = 0
181          mVec = 0          mVec = 0
182            mDbl = 0
183          IF ( gcode(5:5).EQ.'C' ) THEN          IF ( gcode(5:5).EQ.'C' ) THEN
184  C-      Check for Mate of a Counter Diagnostic  C-      Check for Mate of a Counter Diagnostic
185             mate = hdiag(ndId)             mate = hdiag(ndId)
186            ELSEIF ( gcode(5:5).EQ.'P' ) THEN
187    C-      Also load the mate (if stored) for Post-Processing
188               nn = ndId
189               DO WHILE ( gdiag(nn)(5:5).EQ.'P' )
190                 nn = hdiag(nn)
191               ENDDO
192               IF ( mdiag(md,listId).NE.0 ) mDbl = hdiag(nn)
193          ELSEIF ( gcode(1:1).EQ.'U' .OR. gcode(1:1).EQ.'V' ) THEN          ELSEIF ( gcode(1:1).EQ.'U' .OR. gcode(1:1).EQ.'V' ) THEN
194  C-      Check for Mate of a Vector Diagnostic  C-      Check for Mate of a Vector Diagnostic
195             mVec = hdiag(ndId)             mVec = hdiag(ndId)
# Line 199  C--     Start processing 1 Fld : Line 206  C--     Start processing 1 Fld :
206            ip = ABS(idiag(md,listId)) + kdiag(ndId)*(lm-1)            ip = ABS(idiag(md,listId)) + kdiag(ndId)*(lm-1)
207            im = mdiag(md,listId)            im = mdiag(md,listId)
208            IF (mate.GT.0) im = im + kdiag(mate)*(lm-1)            IF (mate.GT.0) im = im + kdiag(mate)*(lm-1)
209              IF (mDbl.GT.0) im = im + kdiag(mDbl)*(lm-1)
210            IF (mVec.GT.0) im = im + kdiag(mVec)*(lm-1)            IF (mVec.GT.0) im = im + kdiag(mVec)*(lm-1)
211    
212            nFilled = ndiag(ip,1,1)            IF ( ndiag(ip,1,1).EQ.0 ) THEN
           IF ( flds(md,listId).EQ.'PhiVEL  ' ) THEN  
               CALL DIAGNOSTICS_CALC_PHIVEL(  
      I                         listId, md, ndId, ip, im, lm,  
      U                         nFilled, qtmp1, qtmp2,  
      I                         myTime, myIter, myThid )  
           ENDIF  
   
 c         IF ( ndiag(ip,1,1).EQ.0 ) THEN  
           IF ( nFilled.EQ.0 ) THEN  
213  C-        Empty diagnostics case :  C-        Empty diagnostics case :
214    
215              _BEGIN_MASTER( myThid )              _BEGIN_MASTER( myThid )
# Line 251  C-        Empty diagnostics case : Line 250  C-        Empty diagnostics case :
250                ENDDO                ENDDO
251              ENDDO              ENDDO
252    
253  c         ELSE            ELSE
           ELSEIF ( ndiag(ip,1,1).NE.0 ) THEN  
254  C-        diagnostics is not empty :  C-        diagnostics is not empty :
255    
256              IF ( debugLevel.GE.debLevB .AND. myThid.EQ.1 ) THEN              IF ( debugLevel.GE.debLevB .AND. myThid.EQ.1 ) THEN
257                WRITE(ioUnit,'(A,I6,3A,I8,2A)')                IF ( gcode(5:5).EQ.'P' ) THEN
258                   WRITE(ioUnit,'(A,I6,7A,I8,2A)')
259         &         ' Post-Processing Diag # ', ndId, '  ', cdiag(ndId),
260         &         '   Parms: ',gdiag(ndId)
261                   IF ( mDbl.EQ.0 ) THEN
262                    WRITE(ioUnit,'(2(3A,I6,A,I8))') '   from diag: ',
263         &            cdiag(nn), ' (#', nn, ') Cnt=', ndiag(ip,1,1)
264                   ELSE
265                    WRITE(ioUnit,'(2(3A,I6,A,I8))') '   from diag: ',
266         &            cdiag(nn), ' (#', nn, ') Cnt=', ndiag(ip,1,1),
267         &          ' and diag: ',
268         &            cdiag(mDbl),' (#',mDbl,') Cnt=',ndiag(im,1,1)
269                   ENDIF
270                  ELSE
271                   WRITE(ioUnit,'(A,I6,3A,I8,2A)')
272       &         ' Computing Diagnostic # ', ndId, '  ', cdiag(ndId),       &         ' Computing Diagnostic # ', ndId, '  ', cdiag(ndId),
273       &         '     Counter:',ndiag(ip,1,1),'   Parms: ',gdiag(ndId)       &         '     Counter:',ndiag(ip,1,1),'   Parms: ',gdiag(ndId)
274                  ENDIF
275                IF ( mate.GT.0 ) THEN                IF ( mate.GT.0 ) THEN
276                 WRITE(ioUnit,'(3A,I6,2A)')                 WRITE(ioUnit,'(3A,I6,2A)')
277       &         '       use Counter Mate for  ', cdiag(ndId),       &         '       use Counter Mate for  ', cdiag(ndId),
# Line 287  C-       get only selected levels: Line 300  C-       get only selected levels:
300                    CALL DIAGNOSTICS_GET_DIAG(                    CALL DIAGNOSTICS_GET_DIAG(
301       I                         kLev, undefRL,       I                         kLev, undefRL,
302       O                         qtmp1(1-OLx,1-OLy,k,bi,bj),       O                         qtmp1(1-OLx,1-OLy,k,bi,bj),
303       I                         ndId,mate,ip,im,bi,bj,myThid)       I                         ndId, mate, ip, im, bi, bj, myThid )
304                  ENDDO                  ENDDO
305                 ENDDO                 ENDDO
306                ENDDO                ENDDO
307                  IF ( mDbl.GT.0 ) THEN
308                   DO bj = myByLo(myThid), myByHi(myThid)
309                    DO bi = myBxLo(myThid), myBxHi(myThid)
310                     DO k = 1,nlevels(listId)
311                      kLev = NINT(levs(k,listId))
312                      CALL DIAGNOSTICS_GET_DIAG(
313         I                         kLev, undefRL,
314         O                         qtmp2(1-OLx,1-OLy,k,bi,bj),
315         I                         mDbl, 0, im, 0, bi, bj, myThid )
316                     ENDDO
317                    ENDDO
318                   ENDDO
319                  ENDIF
320              ELSE              ELSE
321  C-       get all the levels (for vertical post-processing)  C-       get all the levels (for vertical post-processing)
322                DO bj = myByLo(myThid), myByHi(myThid)                DO bj = myByLo(myThid), myByHi(myThid)
# Line 298  C-       get all the levels (for vertica Line 324  C-       get all the levels (for vertica
324                    CALL DIAGNOSTICS_GET_DIAG(                    CALL DIAGNOSTICS_GET_DIAG(
325       I                         0, undefRL,       I                         0, undefRL,
326       O                         qtmp1(1-OLx,1-OLy,1,bi,bj),       O                         qtmp1(1-OLx,1-OLy,1,bi,bj),
327       I                         ndId,mate,ip,im,bi,bj,myThid)       I                         ndId, mate, ip, im, bi, bj, myThid )
328                 ENDDO                 ENDDO
329                ENDDO                ENDDO
330                  IF ( mDbl.GT.0 ) THEN
331                   DO bj = myByLo(myThid), myByHi(myThid)
332                    DO bi = myBxLo(myThid), myBxHi(myThid)
333                     DO k = 1,nlevels(listId)
334                      CALL DIAGNOSTICS_GET_DIAG(
335         I                         0, undefRL,
336         O                         qtmp2(1-OLx,1-OLy,k,bi,bj),
337         I                         mDbl, 0, im, 0, bi, bj, myThid )
338                     ENDDO
339                    ENDDO
340                   ENDDO
341                  ENDIF
342              ENDIF              ENDIF
343    
344  C-----------------------------------------------------------------------  C-----------------------------------------------------------------------
# Line 328  C-          Integrate vertically: for no Line 366  C-          Integrate vertically: for no
366       U                         qtmp1,       U                         qtmp1,
367       I                         undefRL, myTime, myIter, myThid )       I                         undefRL, myTime, myIter, myThid )
368              ENDIF              ENDIF
369                IF ( gcode(5:5).EQ.'P' ) THEN
370    C-          Do Post-Processing:
371                 IF ( flds(md,listId).EQ.'PhiVEL  '
372    c    &       .OR. flds(md,listId).EQ.'PsiVEL  '
373         &          ) THEN
374                  CALL DIAGNOSTICS_CALC_PHIVEL(
375         I                         listId, md, ndId, ip, im, lm,
376         U                         qtmp1, qtmp2,
377         I                         myTime, myIter, myThid )
378                 ELSE
379                   WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_OUT: ',
380         &           'unknown Processing method for diag="',cdiag(ndId),'"'
381                   CALL PRINT_ERROR( msgBuf , myThid )
382                   STOP 'ABNORMAL END: S/R DIAGNOSTICS_OUT'
383                 ENDIF
384                ENDIF
385    
386  C--     End of empty diag / not-empty diag block  C--     End of empty diag / not-empty diag block
387            ENDIF            ENDIF
Legend:
Removed from v.1.53  
changed lines
  Added in v.1.54
  ViewVC Help
Powered by ViewVC 1.1.22