/[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.21 by jmc, Sun Jun 26 16:51:49 2005 UTC revision 1.25 by jmc, Tue Feb 5 15:31:19 2008 UTC
# Line 3  C $Name$ Line 3  C $Name$
3    
4  #include "DIAG_OPTIONS.h"  #include "DIAG_OPTIONS.h"
5    
6    C--   File diagnostics_utils.F: General purpose support routines
7    C--    Contents:
8    C--    o GETDIAG
9    C--    o DIAGNOSTICS_COUNT
10    C--    o DIAGS_MK_UNITS (Function)
11    C--    o DIAGS_MK_TITLE (Function)
12    C--    o DIAGNOSTICS_GET_POINTERS
13    
14  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
15  CBOP 0  CBOP 0
16  C     !ROUTINE: GETDIAG  C     !ROUTINE: GETDIAG
# Line 219  C     !LOCAL VARIABLES: Line 227  C     !LOCAL VARIABLES:
227        ENDIF        ENDIF
228    
229        RETURN        RETURN
230          END
231    
232    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
233    
234    CBOP 0
235    C     !ROUTINE: DIAGS_MK_TITLE
236    
237    C     !INTERFACE:
238          CHARACTER*80 FUNCTION DIAGS_MK_TITLE(
239         I                            diagTitleInPieces, myThid )
240    
241    C     !DESCRIPTION:
242    C     *==========================================================*
243    C     | FUNCTION DIAGS_MK_TITLE
244    C     | o Return the diagnostic title string (80c) removing
245    C     |   consecutive blanks from the input string
246    C     *==========================================================*
247    
248    C     !USES:
249          IMPLICIT NONE
250    #include "EEPARAMS.h"
251    
252    C     !INPUT PARAMETERS:
253    C     diagTitleInPieces :: string for diagnostic units: in several
254    C                          pieces, with blanks in between
255    C     myThid            ::  my Thread Id number
256          CHARACTER*(*) diagTitleInPieces
257          INTEGER      myThid
258    CEOP
259    
260    C     !LOCAL VARIABLES:
261          CHARACTER*(MAX_LEN_MBUF) msgBuf
262          LOGICAL flag
263          INTEGER i,j,n
264    
265    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
266    
267          DIAGS_MK_TITLE = '                                        '
268         &               //'                                        '
269          n = LEN(diagTitleInPieces)
270    
271          j = 0
272          flag = .FALSE.
273          DO i=1,n
274           IF (diagTitleInPieces(i:i) .NE. ' ' ) THEN
275             IF ( flag ) THEN
276               j = j+1
277               IF (j.LE.80) DIAGS_MK_TITLE(j:j) = ' '
278             ENDIF
279             j = j+1
280             IF ( j.LE.80 ) DIAGS_MK_TITLE(j:j) = diagTitleInPieces(i:i)
281             flag = .FALSE.
282           ELSE
283             flag = j.GE.1
284           ENDIF
285          ENDDO
286    
287          IF ( j.GT.80 ) THEN
288             WRITE(msgBuf,'(2A,I4,A)') '**WARNING** ',
289         &   'DIAGS_MK_TITLE: too long (',j,' >80) input string'
290            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
291         &       SQUEEZE_RIGHT , myThid)
292             WRITE(msgBuf,'(3A)') '**WARNING** ',
293         &   'DIAGS_MK_TITLE: input=', diagTitleInPieces
294            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
295         &       SQUEEZE_RIGHT , myThid)
296          ENDIF
297    
298          RETURN
299          END
300    
301    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
302    
303    CBOP 0
304    C     !ROUTINE: DIAGNOSTICS_GET_POINTERS
305    C     !INTERFACE:
306          SUBROUTINE DIAGNOSTICS_GET_POINTERS(
307         I                       diagName, listId,
308         O                       ndId, ip,
309         I                       myThid )
310    
311    C     !DESCRIPTION:
312    C     *================================================================*
313    C     | o Returns the diagnostic Id number and diagnostic
314    C     |   pointer to storage array for a specified diagnostic.
315    C     *================================================================*
316    C     | Note: A diagnostics field can be stored multiple times
317    C     |       (for different output frequency,phase, ...).
318    C     | operates in 2 ways:
319    C     | o listId =0 => find 1 diagnostics Id & pointer which name matches.
320    C     | o listId >0 => find the unique diagnostic Id & pointer with
321    C     |      the right name and same output time as "listId" output-list
322    C     | o return ip=0 if did not find the right diagnostic;
323    C     |   (ndId <>0 if diagnostic exist but output time does not match)
324    C     *================================================================*
325    
326    C     !USES:
327          IMPLICIT NONE
328    #include "EEPARAMS.h"
329    #include "SIZE.h"
330    #include "DIAGNOSTICS_SIZE.h"
331    #include "DIAGNOSTICS.h"
332    
333    C     !INPUT PARAMETERS:
334    C     diagName :: diagnostic identificator name (8 characters long)
335    C     listId   :: list number that specify the output frequency
336    C     myThid   :: my Thread Id number
337    C     !OUTPUT PARAMETERS:
338    C     ndId     :: diagnostics  Id number (in available diagnostics list)
339    C     ip       :: diagnostics  pointer to storage array
340    
341    
342          CHARACTER*8 diagName
343          INTEGER listId
344          INTEGER ndId, ip
345          INTEGER myThid
346    CEOP
347    
348    C     !LOCAL VARIABLES:
349          INTEGER n,m
350    
351          ip   = 0
352          ndId = 0
353    
354          IF ( listId.LE.0 ) THEN
355    C--   select the 1rst one which name matches:
356    
357    C-    search for this diag. in the active 2D/3D diagnostics list
358            DO n=1,nlists
359             DO m=1,nActive(n)
360               IF ( ip.EQ.0 .AND. diagName.EQ.flds(m,n)
361         &                  .AND. idiag(m,n).NE.0 ) THEN
362                ip   = ABS(idiag(m,n))
363                ndId = jdiag(m,n)
364               ENDIF
365             ENDDO
366            ENDDO
367    
368          ELSEIF ( listId.LE.nlists ) THEN
369    C--   select the unique diagnostic with output-time identical to listId
370    
371    C-    search for this diag. in the active 2D/3D diagnostics list
372            DO n=1,nlists
373             IF ( ip.EQ.0
374         &        .AND. freq(n) .EQ. freq(listId)
375         &        .AND. phase(n).EQ.phase(listId)
376         &        .AND. averageFreq(n) .EQ.averageFreq(listId)
377         &        .AND. averagePhase(n).EQ.averagePhase(listId)
378         &        .AND. averageCycle(n).EQ.averageCycle(listId)
379         &      ) 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                ip   = ABS(idiag(m,n))
384                ndId = jdiag(m,n)
385               ENDIF
386              ENDDO
387             ELSEIF ( ip.EQ.0 ) THEN
388              DO m=1,nActive(n)
389               IF ( ip.EQ.0 .AND. diagName.EQ.flds(m,n)
390         &                  .AND. idiag(m,n).NE.0 ) THEN
391                ndId = jdiag(m,n)
392               ENDIF
393              ENDDO
394             ENDIF
395            ENDDO
396    
397          ELSE
398            STOP 'DIAGNOSTICS_GET_POINTERS: invalid listId number'
399          ENDIF
400    
401          RETURN
402        END        END
Legend:
Removed from v.1.21  
changed lines
  Added in v.1.25
  ViewVC Help
Powered by ViewVC 1.1.22