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

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

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

revision 1.23 by jmc, Sun Jun 25 23:03:55 2006 UTC revision 1.24 by jmc, Sun Dec 24 20:18:05 2006 UTC
# Line 293  C---+----1----+----2----+----3----+----4 Line 293  C---+----1----+----2----+----3----+----4
293  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
294    
295  CBOP 0  CBOP 0
296  C     !ROUTINE: diagnostics_get_pointers  C     !ROUTINE: DIAGNOSTICS_GET_POINTERS
297  C     !INTERFACE:  C     !INTERFACE:
298        subroutine diagnostics_get_pointers(diagName,ipoint,jpoint,myThid)        SUBROUTINE DIAGNOSTICS_GET_POINTERS(
299         I                       diagName, listId,
300         O                       ndId, ip,
301         I                       myThid )
302    
303  C     !DESCRIPTION:  C     !DESCRIPTION:
304  C     *==========================================================*  C     *================================================================*
305  C     | subroutine diagnostics_get_pointers  C     | o Returns the diagnostic Id number and diagnostic
306  C     | o Returns the idiag and jdiag pointers for a  C     |   pointer to storage array for a specified diagnostic.
307  C     |   specified diagnostic - returns 0 if not active  C     *================================================================*
308  C     *==========================================================*  C     | Note: A diagnostics field can be stored multiple times
309    C     |       (for different output frequency,phase, ...).
310    C     | operates in 2 ways:
311    C     | o listId =0 => find 1 diagnostics Id & pointer which name matches.
312    C     | o listId >0 => find the unique diagnostic Id & pointer with
313    C     |      the right name and same output time as "listId" output-list
314    C     | o return ip=0 if did not find the right diagnostic;
315    C     |   (ndId <>0 if diagnostic exist but output time does not match)
316    C     *================================================================*
317    
318  C     !USES:  C     !USES:
319        IMPLICIT NONE        IMPLICIT NONE
# Line 312  C     !USES: Line 323  C     !USES:
323  #include "DIAGNOSTICS.h"  #include "DIAGNOSTICS.h"
324    
325  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
326  C     diagName   ::  diagnostic identificator name (8 characters long)  C     diagName :: diagnostic identificator name (8 characters long)
327  C     myThid     ::  my thread Id number  C     listId   :: list number that specify the output frequency
328    C     myThid   :: my Thread Id number
329  C     !OUTPUT PARAMETERS:  C     !OUTPUT PARAMETERS:
330  C     ipoint     ::  pointer value into qdiag array  C     ndId     :: diagnostics  Id number (in available diagnostics list)
331  C     jpoint     ::  pointer value into diagnostics list  C     ip       :: diagnostics  pointer to storage array
332    
333    
334        CHARACTER*8 diagName        CHARACTER*8 diagName
335        INTEGER ipoint, jpoint, myThid        INTEGER listId
336          INTEGER ndId, ip
337          INTEGER myThid
338  CEOP  CEOP
339    
340  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
341        INTEGER n,m        INTEGER n,m
342    
343        ipoint = 0        ip   = 0
344        jpoint = 0        ndId = 0
345    
346          IF ( listId.LE.0 ) THEN
347    C--   select the 1rst one which name matches:
348    
349    C-    search for this diag. in the active 2D/3D diagnostics list
350            DO n=1,nlists
351             DO m=1,nActive(n)
352               IF ( ip.EQ.0 .AND. diagName.EQ.flds(m,n)
353         &                  .AND. idiag(m,n).NE.0 ) THEN
354                ip   = ABS(idiag(m,n))
355                ndId = jdiag(m,n)
356               ENDIF
357             ENDDO
358            ENDDO
359    
360          ELSEIF ( listId.LE.nlists ) THEN
361    C--   select the unique diagnostic with output-time identical to listId
362    
363  C-    search for this diag. in the active 2D/3D diagnostics list  C-    search for this diag. in the active 2D/3D diagnostics list
364        DO n=1,nlists          DO n=1,nlists
365         DO m=1,nActive(n)           IF ( ip.EQ.0
366          IF ( diagName.EQ.flds(m,n) .AND. idiag(m,n).NE.0 ) THEN       &        .AND. freq(n) .EQ. freq(listId)
367            ipoint = abs(idiag(m,n))       &        .AND. phase(n).EQ.phase(listId)
368            jpoint = jdiag(m,n)       &        .AND. averageFreq(n) .EQ.averageFreq(listId)
369          ENDIF       &        .AND. averagePhase(n).EQ.averagePhase(listId)
370         ENDDO       &        .AND. averageCycle(n).EQ.averageCycle(listId)
371        ENDDO       &      ) THEN
372              DO m=1,nActive(n)
373               IF ( ip.EQ.0 .AND. diagName.EQ.flds(m,n)
374         &                  .AND. idiag(m,n).NE.0 ) THEN
375                ip   = ABS(idiag(m,n))
376                ndId = jdiag(m,n)
377               ENDIF
378              ENDDO
379             ELSEIF ( ip.EQ.0 ) THEN
380              DO m=1,nActive(n)
381               IF ( ip.EQ.0 .AND. diagName.EQ.flds(m,n)
382         &                  .AND. idiag(m,n).NE.0 ) THEN
383                ndId = jdiag(m,n)
384               ENDIF
385              ENDDO
386             ENDIF
387            ENDDO
388    
389          ELSE
390            STOP 'DIAGNOSTICS_GET_POINTERS: invalid listId number'
391          ENDIF
392    
393        RETURN        RETURN
394        END        END
Legend:
Removed from v.1.23  
changed lines
  Added in v.1.24
  ViewVC Help
Powered by ViewVC 1.1.22