/[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.24 by jmc, Sun Dec 24 20:18:05 2006 UTC
# Line 220  C     !LOCAL VARIABLES: Line 220  C     !LOCAL VARIABLES:
220    
221        RETURN        RETURN
222        END        END
223    
224    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
225    
226    CBOP 0
227    C     !ROUTINE: DIAGS_MK_TITLE
228    
229    C     !INTERFACE:
230          CHARACTER*80 FUNCTION DIAGS_MK_TITLE(
231         I                            diagTitleInPieces, myThid )
232    
233    C     !DESCRIPTION:
234    C     *==========================================================*
235    C     | FUNCTION DIAGS_MK_TITLE
236    C     | o Return the diagnostic title string (80c) removing
237    C     |   consecutive blanks from the input string
238    C     *==========================================================*
239    
240    C     !USES:
241          IMPLICIT NONE
242    #include "EEPARAMS.h"
243    
244    C     !INPUT PARAMETERS:
245    C     diagTitleInPieces :: string for diagnostic units: in several
246    C                          pieces, with blanks in between
247    C     myThid            ::  my Thread Id number
248          CHARACTER*(*) diagTitleInPieces
249          INTEGER      myThid
250    CEOP
251    
252    C     !LOCAL VARIABLES:
253          CHARACTER*(MAX_LEN_MBUF) msgBuf
254          LOGICAL flag
255          INTEGER i,j,n
256    
257    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
258    
259          DIAGS_MK_TITLE = '                                        '
260         &               //'                                        '
261          n = LEN(diagTitleInPieces)
262    
263          j = 0
264          flag = .FALSE.
265          DO i=1,n
266           IF (diagTitleInPieces(i:i) .NE. ' ' ) THEN
267             IF ( flag ) THEN
268               j = j+1
269               IF (j.LE.80) DIAGS_MK_TITLE(j:j) = ' '
270             ENDIF
271             j = j+1
272             IF ( j.LE.80 ) DIAGS_MK_TITLE(j:j) = diagTitleInPieces(i:i)
273             flag = .FALSE.
274           ELSE
275             flag = j.GE.1
276           ENDIF
277          ENDDO
278    
279          IF ( j.GT.80 ) THEN
280             WRITE(msgBuf,'(2A,I4,A)') '**WARNING** ',
281         &   'DIAGS_MK_TITLE: too long (',j,' >80) input string'
282            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
283         &       SQUEEZE_RIGHT , myThid)
284             WRITE(msgBuf,'(3A)') '**WARNING** ',
285         &   'DIAGS_MK_TITLE: input=', diagTitleInPieces
286            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
287         &       SQUEEZE_RIGHT , myThid)
288          ENDIF
289    
290          RETURN
291          END
292    
293    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
294    
295    CBOP 0
296    C     !ROUTINE: DIAGNOSTICS_GET_POINTERS
297    C     !INTERFACE:
298          SUBROUTINE DIAGNOSTICS_GET_POINTERS(
299         I                       diagName, listId,
300         O                       ndId, ip,
301         I                       myThid )
302    
303    C     !DESCRIPTION:
304    C     *================================================================*
305    C     | o Returns the diagnostic Id number and diagnostic
306    C     |   pointer to storage array for a specified diagnostic.
307    C     *================================================================*
308    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:
319          IMPLICIT NONE
320    #include "EEPARAMS.h"
321    #include "SIZE.h"
322    #include "DIAGNOSTICS_SIZE.h"
323    #include "DIAGNOSTICS.h"
324    
325    C     !INPUT PARAMETERS:
326    C     diagName :: diagnostic identificator name (8 characters long)
327    C     listId   :: list number that specify the output frequency
328    C     myThid   :: my Thread Id number
329    C     !OUTPUT PARAMETERS:
330    C     ndId     :: diagnostics  Id number (in available diagnostics list)
331    C     ip       :: diagnostics  pointer to storage array
332    
333    
334          CHARACTER*8 diagName
335          INTEGER listId
336          INTEGER ndId, ip
337          INTEGER myThid
338    CEOP
339    
340    C     !LOCAL VARIABLES:
341          INTEGER n,m
342    
343          ip   = 0
344          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
364            DO n=1,nlists
365             IF ( ip.EQ.0
366         &        .AND. freq(n) .EQ. freq(listId)
367         &        .AND. phase(n).EQ.phase(listId)
368         &        .AND. averageFreq(n) .EQ.averageFreq(listId)
369         &        .AND. averagePhase(n).EQ.averagePhase(listId)
370         &        .AND. averageCycle(n).EQ.averageCycle(listId)
371         &      ) 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
394          END
Legend:
Removed from v.1.21  
changed lines
  Added in v.1.24
  ViewVC Help
Powered by ViewVC 1.1.22