/[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.22 by molod, Mon Jul 11 16:20:10 2005 UTC revision 1.27 by jmc, Tue Nov 18 21:41:06 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 DIAGNOSTICS_GET_POINTERS
11    C--    o DIAGS_GET_PARMS_I (Function)
12    C--    o DIAGS_MK_UNITS (Function)
13    C--    o DIAGS_MK_TITLE (Function)
14    
15  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
16  CBOP 0  CBOP 0
17  C     !ROUTINE: GETDIAG  C     !ROUTINE: GETDIAG
# Line 60  C-      No counter diagnostics => averag Line 69  C-      No counter diagnostics => averag
69            factor = FLOAT(ndiag(ip,bi,bj))            factor = FLOAT(ndiag(ip,bi,bj))
70            IF (ndiag(ip,bi,bj).NE.0) factor = 1. _d 0 / factor            IF (ndiag(ip,bi,bj).NE.0) factor = 1. _d 0 / factor
71    
72    #ifdef ALLOW_FIZHI
73            DO j = 1,sNy+1            DO j = 1,sNy+1
74              DO i = 1,sNx+1              DO i = 1,sNx+1
75                IF ( qdiag(i,j,ipnt,bi,bj) .LE. undef ) THEN                IF ( qdiag(i,j,ipnt,bi,bj) .LE. undef ) THEN
# Line 69  C-      No counter diagnostics => averag Line 79  C-      No counter diagnostics => averag
79                ENDIF                ENDIF
80              ENDDO              ENDDO
81            ENDDO            ENDDO
82    #else /* ALLOW_FIZHI */
83              DO j = 1,sNy+1
84                DO i = 1,sNx+1
85                  qtmp(i,j) = qdiag(i,j,ipnt,bi,bj)*factor
86                ENDDO
87              ENDDO
88    #endif /* ALLOW_FIZHI */
89    
90          ELSE          ELSE
91  C-      With counter diagnostics => average = Sum / counter:  C-      With counter diagnostics => average = Sum / counter:
# Line 167  C-    Increment is done Line 184  C-    Increment is done
184  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
185    
186  CBOP 0  CBOP 0
187    C     !ROUTINE: DIAGNOSTICS_GET_POINTERS
188    C     !INTERFACE:
189          SUBROUTINE DIAGNOSTICS_GET_POINTERS(
190         I                       diagName, listId,
191         O                       ndId, ip,
192         I                       myThid )
193    
194    C     !DESCRIPTION:
195    C     *================================================================*
196    C     | o Returns the diagnostic Id number and diagnostic
197    C     |   pointer to storage array for a specified diagnostic.
198    C     *================================================================*
199    C     | Note: A diagnostics field can be stored multiple times
200    C     |       (for different output frequency,phase, ...).
201    C     | operates in 2 ways:
202    C     | o listId =0 => find 1 diagnostics Id & pointer which name matches.
203    C     | o listId >0 => find the unique diagnostic Id & pointer with
204    C     |      the right name and same output time as "listId" output-list
205    C     | o return ip=0 if did not find the right diagnostic;
206    C     |   (ndId <>0 if diagnostic exist but output time does not match)
207    C     *================================================================*
208    
209    C     !USES:
210          IMPLICIT NONE
211    #include "EEPARAMS.h"
212    #include "SIZE.h"
213    #include "DIAGNOSTICS_SIZE.h"
214    #include "DIAGNOSTICS.h"
215    
216    C     !INPUT PARAMETERS:
217    C     diagName :: diagnostic identificator name (8 characters long)
218    C     listId   :: list number that specify the output frequency
219    C     myThid   :: my Thread Id number
220    C     !OUTPUT PARAMETERS:
221    C     ndId     :: diagnostics  Id number (in available diagnostics list)
222    C     ip       :: diagnostics  pointer to storage array
223    
224    
225          CHARACTER*8 diagName
226          INTEGER listId
227          INTEGER ndId, ip
228          INTEGER myThid
229    CEOP
230    
231    C     !LOCAL VARIABLES:
232          INTEGER n,m
233    
234          ip   = 0
235          ndId = 0
236    
237          IF ( listId.LE.0 ) THEN
238    C--   select the 1rst one which name matches:
239    
240    C-    search for this diag. in the active 2D/3D diagnostics list
241            DO n=1,nlists
242             DO m=1,nActive(n)
243               IF ( ip.EQ.0 .AND. diagName.EQ.flds(m,n)
244         &                  .AND. idiag(m,n).NE.0 ) THEN
245                ip   = ABS(idiag(m,n))
246                ndId = jdiag(m,n)
247               ENDIF
248             ENDDO
249            ENDDO
250    
251          ELSEIF ( listId.LE.nlists ) THEN
252    C--   select the unique diagnostic with output-time identical to listId
253    
254    C-    search for this diag. in the active 2D/3D diagnostics list
255            DO n=1,nlists
256             IF ( ip.EQ.0
257         &        .AND. freq(n) .EQ. freq(listId)
258         &        .AND. phase(n).EQ.phase(listId)
259         &        .AND. averageFreq(n) .EQ.averageFreq(listId)
260         &        .AND. averagePhase(n).EQ.averagePhase(listId)
261         &        .AND. averageCycle(n).EQ.averageCycle(listId)
262         &      ) THEN
263              DO m=1,nActive(n)
264               IF ( ip.EQ.0 .AND. diagName.EQ.flds(m,n)
265         &                  .AND. idiag(m,n).NE.0 ) THEN
266                ip   = ABS(idiag(m,n))
267                ndId = jdiag(m,n)
268               ENDIF
269              ENDDO
270             ELSEIF ( ip.EQ.0 ) THEN
271              DO m=1,nActive(n)
272               IF ( ip.EQ.0 .AND. diagName.EQ.flds(m,n)
273         &                  .AND. idiag(m,n).NE.0 ) THEN
274                ndId = jdiag(m,n)
275               ENDIF
276              ENDDO
277             ENDIF
278            ENDDO
279    
280          ELSE
281            STOP 'DIAGNOSTICS_GET_POINTERS: invalid listId number'
282          ENDIF
283    
284          RETURN
285          END
286    
287    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
288    
289    CBOP 0
290    C     !ROUTINE: DIAGS_GET_PARMS_I
291    
292    C     !INTERFACE:
293          INTEGER FUNCTION DIAGS_GET_PARMS_I(
294         I                            parName, myThid )
295    
296    C     !DESCRIPTION:
297    C     *==========================================================*
298    C     | FUNCTION DIAGS_GET_PARMS_I
299    C     | o Return the value of integer parameter
300    C     |   from one of the DIAGNOSTICS.h common blocs
301    C     *==========================================================*
302    
303    C     !USES:
304          IMPLICIT NONE
305    #include "EEPARAMS.h"
306    #include "SIZE.h"
307    #include "DIAGNOSTICS_SIZE.h"
308    #include "DIAGNOSTICS.h"
309    
310    C     !INPUT PARAMETERS:
311    C     parName   :: string used to identify which parameter to get
312    C     myThid    :: my Thread Id number
313          CHARACTER*(*) parName
314          INTEGER myThid
315    CEOP
316    
317    C     !LOCAL VARIABLES:
318          CHARACTER*(MAX_LEN_MBUF) msgBuf
319          INTEGER n
320    
321    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
322    
323          n = LEN(parName)
324    c     write(0,'(3A,I4)')
325    c    &  'DIAGS_GET_PARMS_I: parName="',parName,'" , length=',n
326    
327          IF ( parName.EQ.'LAST_DIAG_ID' ) THEN
328             DIAGS_GET_PARMS_I = ndiagt
329          ELSE
330             WRITE(msgBuf,'(4A)') 'DIAGS_GET_PARMS_I: ',
331         &    ' parName="', parName, '" not known.'
332             CALL PRINT_ERROR( msgBuf, myThid )
333             STOP 'ABNORMAL END: S/R DIAGS_GET_PARMS_I'
334          ENDIF
335    
336          RETURN
337          END
338    
339    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
340    
341    CBOP 0
342  C     !ROUTINE: DIAGS_MK_UNITS  C     !ROUTINE: DIAGS_MK_UNITS
343    
344  C     !INTERFACE:  C     !INTERFACE:
# Line 220  C     !LOCAL VARIABLES: Line 392  C     !LOCAL VARIABLES:
392    
393        RETURN        RETURN
394        END        END
395    
396  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
397    
398  CBOP 0  CBOP 0
399  C     !ROUTINE: diagnostics_get_pointers  C     !ROUTINE: DIAGS_MK_TITLE
400    
401  C     !INTERFACE:  C     !INTERFACE:
402        subroutine diagnostics_get_pointers(diagName,ipoint,jpoint,myThid)        CHARACTER*80 FUNCTION DIAGS_MK_TITLE(
403         I                            diagTitleInPieces, myThid )
404    
405  C     !DESCRIPTION:  C     !DESCRIPTION:
406  C     *==========================================================*  C     *==========================================================*
407  C     | subroutine diagnostics_get_pointers  C     | FUNCTION DIAGS_MK_TITLE
408  C     | o Returns the idiag and jdiag pointers for a  C     | o Return the diagnostic title string (80c) removing
409  C     |   specified diagnostic - returns 0 if not active  C     |   consecutive blanks from the input string
410  C     *==========================================================*  C     *==========================================================*
411    
412  C     !USES:  C     !USES:
413        IMPLICIT NONE        IMPLICIT NONE
414  #include "EEPARAMS.h"  #include "EEPARAMS.h"
 #include "SIZE.h"  
 #include "DIAGNOSTICS_SIZE.h"  
 #include "DIAGNOSTICS.h"  
415    
416  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
417  C     diagName   ::  diagnostic identificator name (8 characters long)  C     diagTitleInPieces :: string for diagnostic units: in several
418  C     myThid     ::  my thread Id number  C                          pieces, with blanks in between
419  C     !OUTPUT PARAMETERS:  C     myThid            ::  my Thread Id number
420  C     ipoint     ::  pointer value into qdiag array        CHARACTER*(*) diagTitleInPieces
421  C     jpoint     ::  pointer value into diagnostics list        INTEGER      myThid
   
       CHARACTER*8 diagName  
       INTEGER ipoint, jpoint, myThid  
422  CEOP  CEOP
423    
424  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
425        INTEGER n,m        CHARACTER*(MAX_LEN_MBUF) msgBuf
426          LOGICAL flag
427          INTEGER i,j,n
428    
429        ipoint = 0  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
       jpoint = 0  
430    
431  C-    search for this diag. in the active 2D/3D diagnostics list        DIAGS_MK_TITLE = '                                        '
432        DO n=1,nlists       &               //'                                        '
433         DO m=1,nActive(n)        n = LEN(diagTitleInPieces)
434          IF ( diagName.EQ.flds(m,n) .AND. idiag(m,n).NE.0 ) THEN  
435            ipoint = abs(idiag(m,n))        j = 0
436            jpoint = jdiag(m,n)        flag = .FALSE.
437          ENDIF        DO i=1,n
438         ENDDO         IF (diagTitleInPieces(i:i) .NE. ' ' ) THEN
439             IF ( flag ) THEN
440               j = j+1
441               IF (j.LE.80) DIAGS_MK_TITLE(j:j) = ' '
442             ENDIF
443             j = j+1
444             IF ( j.LE.80 ) DIAGS_MK_TITLE(j:j) = diagTitleInPieces(i:i)
445             flag = .FALSE.
446           ELSE
447             flag = j.GE.1
448           ENDIF
449        ENDDO        ENDDO
450    
451          IF ( j.GT.80 ) THEN
452             WRITE(msgBuf,'(2A,I4,A)') '**WARNING** ',
453         &   'DIAGS_MK_TITLE: too long (',j,' >80) input string'
454            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
455         &       SQUEEZE_RIGHT , myThid)
456             WRITE(msgBuf,'(3A)') '**WARNING** ',
457         &   'DIAGS_MK_TITLE: input=', diagTitleInPieces
458            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
459         &       SQUEEZE_RIGHT , myThid)
460          ENDIF
461    
462        RETURN        RETURN
463        END        END
Legend:
Removed from v.1.22  
changed lines
  Added in v.1.27
  ViewVC Help
Powered by ViewVC 1.1.22