/[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.25 by jmc, Tue Feb 5 15:31:19 2008 UTC revision 1.26 by jmc, Sat Aug 16 17:28:29 2008 UTC
# Line 7  C--   File diagnostics_utils.F: General Line 7  C--   File diagnostics_utils.F: General
7  C--    Contents:  C--    Contents:
8  C--    o GETDIAG  C--    o GETDIAG
9  C--    o DIAGNOSTICS_COUNT  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)  C--    o DIAGS_MK_UNITS (Function)
13  C--    o DIAGS_MK_TITLE (Function)  C--    o DIAGS_MK_TITLE (Function)
 C--    o DIAGNOSTICS_GET_POINTERS  
14    
15  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
16  CBOP 0  CBOP 0
# Line 175  C-    Increment is done Line 176  C-    Increment is done
176  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
177    
178  CBOP 0  CBOP 0
179    C     !ROUTINE: DIAGNOSTICS_GET_POINTERS
180    C     !INTERFACE:
181          SUBROUTINE DIAGNOSTICS_GET_POINTERS(
182         I                       diagName, listId,
183         O                       ndId, ip,
184         I                       myThid )
185    
186    C     !DESCRIPTION:
187    C     *================================================================*
188    C     | o Returns the diagnostic Id number and diagnostic
189    C     |   pointer to storage array for a specified diagnostic.
190    C     *================================================================*
191    C     | Note: A diagnostics field can be stored multiple times
192    C     |       (for different output frequency,phase, ...).
193    C     | operates in 2 ways:
194    C     | o listId =0 => find 1 diagnostics Id & pointer which name matches.
195    C     | o listId >0 => find the unique diagnostic Id & pointer with
196    C     |      the right name and same output time as "listId" output-list
197    C     | o return ip=0 if did not find the right diagnostic;
198    C     |   (ndId <>0 if diagnostic exist but output time does not match)
199    C     *================================================================*
200    
201    C     !USES:
202          IMPLICIT NONE
203    #include "EEPARAMS.h"
204    #include "SIZE.h"
205    #include "DIAGNOSTICS_SIZE.h"
206    #include "DIAGNOSTICS.h"
207    
208    C     !INPUT PARAMETERS:
209    C     diagName :: diagnostic identificator name (8 characters long)
210    C     listId   :: list number that specify the output frequency
211    C     myThid   :: my Thread Id number
212    C     !OUTPUT PARAMETERS:
213    C     ndId     :: diagnostics  Id number (in available diagnostics list)
214    C     ip       :: diagnostics  pointer to storage array
215    
216    
217          CHARACTER*8 diagName
218          INTEGER listId
219          INTEGER ndId, ip
220          INTEGER myThid
221    CEOP
222    
223    C     !LOCAL VARIABLES:
224          INTEGER n,m
225    
226          ip   = 0
227          ndId = 0
228    
229          IF ( listId.LE.0 ) THEN
230    C--   select the 1rst one which name matches:
231    
232    C-    search for this diag. in the active 2D/3D diagnostics list
233            DO n=1,nlists
234             DO m=1,nActive(n)
235               IF ( ip.EQ.0 .AND. diagName.EQ.flds(m,n)
236         &                  .AND. idiag(m,n).NE.0 ) THEN
237                ip   = ABS(idiag(m,n))
238                ndId = jdiag(m,n)
239               ENDIF
240             ENDDO
241            ENDDO
242    
243          ELSEIF ( listId.LE.nlists ) THEN
244    C--   select the unique diagnostic with output-time identical to listId
245    
246    C-    search for this diag. in the active 2D/3D diagnostics list
247            DO n=1,nlists
248             IF ( ip.EQ.0
249         &        .AND. freq(n) .EQ. freq(listId)
250         &        .AND. phase(n).EQ.phase(listId)
251         &        .AND. averageFreq(n) .EQ.averageFreq(listId)
252         &        .AND. averagePhase(n).EQ.averagePhase(listId)
253         &        .AND. averageCycle(n).EQ.averageCycle(listId)
254         &      ) THEN
255              DO m=1,nActive(n)
256               IF ( ip.EQ.0 .AND. diagName.EQ.flds(m,n)
257         &                  .AND. idiag(m,n).NE.0 ) THEN
258                ip   = ABS(idiag(m,n))
259                ndId = jdiag(m,n)
260               ENDIF
261              ENDDO
262             ELSEIF ( ip.EQ.0 ) 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                ndId = jdiag(m,n)
267               ENDIF
268              ENDDO
269             ENDIF
270            ENDDO
271    
272          ELSE
273            STOP 'DIAGNOSTICS_GET_POINTERS: invalid listId number'
274          ENDIF
275    
276          RETURN
277          END
278    
279    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
280    
281    CBOP 0
282    C     !ROUTINE: DIAGS_GET_PARMS_I
283    
284    C     !INTERFACE:
285          INTEGER FUNCTION DIAGS_GET_PARMS_I(
286         I                            parName, myThid )
287    
288    C     !DESCRIPTION:
289    C     *==========================================================*
290    C     | FUNCTION DIAGS_GET_PARMS_I
291    C     | o Return the value of integer parameter
292    C     |   from one of the DIAGNOSTICS.h common blocs
293    C     *==========================================================*
294    
295    C     !USES:
296          IMPLICIT NONE
297    #include "EEPARAMS.h"
298    #include "SIZE.h"
299    #include "DIAGNOSTICS_SIZE.h"
300    #include "DIAGNOSTICS.h"
301    
302    C     !INPUT PARAMETERS:
303    C     parName   :: string used to identify which parameter to get
304    C     myThid    :: my Thread Id number
305          CHARACTER*(*) parName
306          INTEGER myThid
307    CEOP
308    
309    C     !LOCAL VARIABLES:
310          CHARACTER*(MAX_LEN_MBUF) msgBuf
311          INTEGER n
312    
313    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
314    
315          n = LEN(parName)
316    c     write(0,'(3A,I4)')
317    c    &  'DIAGS_GET_PARMS_I: parName="',parName,'" , length=',n
318    
319          IF ( parName.EQ.'LAST_DIAG_ID' ) THEN
320             DIAGS_GET_PARMS_I = ndiagt
321          ELSE
322             WRITE(msgBuf,'(4A)') 'DIAGS_GET_PARMS_I: ',
323         &    ' parName="', parName, '" not known.'
324             CALL PRINT_ERROR( msgBuf, myThid )
325             STOP 'ABNORMAL END: S/R DIAGS_GET_PARMS_I'
326          ENDIF
327    
328          RETURN
329          END
330    
331    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
332    
333    CBOP 0
334  C     !ROUTINE: DIAGS_MK_UNITS  C     !ROUTINE: DIAGS_MK_UNITS
335    
336  C     !INTERFACE:  C     !INTERFACE:
# Line 296  C---+----1----+----2----+----3----+----4 Line 452  C---+----1----+----2----+----3----+----4
452        ENDIF        ENDIF
453    
454        RETURN        RETURN
       END  
   
 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  
   
 CBOP 0  
 C     !ROUTINE: DIAGNOSTICS_GET_POINTERS  
 C     !INTERFACE:  
       SUBROUTINE DIAGNOSTICS_GET_POINTERS(  
      I                       diagName, listId,  
      O                       ndId, ip,  
      I                       myThid )  
   
 C     !DESCRIPTION:  
 C     *================================================================*  
 C     | o Returns the diagnostic Id number and diagnostic  
 C     |   pointer to storage array for a specified diagnostic.  
 C     *================================================================*  
 C     | Note: A diagnostics field can be stored multiple times  
 C     |       (for different output frequency,phase, ...).  
 C     | operates in 2 ways:  
 C     | o listId =0 => find 1 diagnostics Id & pointer which name matches.  
 C     | o listId >0 => find the unique diagnostic Id & pointer with  
 C     |      the right name and same output time as "listId" output-list  
 C     | o return ip=0 if did not find the right diagnostic;  
 C     |   (ndId <>0 if diagnostic exist but output time does not match)  
 C     *================================================================*  
   
 C     !USES:  
       IMPLICIT NONE  
 #include "EEPARAMS.h"  
 #include "SIZE.h"  
 #include "DIAGNOSTICS_SIZE.h"  
 #include "DIAGNOSTICS.h"  
   
 C     !INPUT PARAMETERS:  
 C     diagName :: diagnostic identificator name (8 characters long)  
 C     listId   :: list number that specify the output frequency  
 C     myThid   :: my Thread Id number  
 C     !OUTPUT PARAMETERS:  
 C     ndId     :: diagnostics  Id number (in available diagnostics list)  
 C     ip       :: diagnostics  pointer to storage array  
   
   
       CHARACTER*8 diagName  
       INTEGER listId  
       INTEGER ndId, ip  
       INTEGER myThid  
 CEOP  
   
 C     !LOCAL VARIABLES:  
       INTEGER n,m  
   
       ip   = 0  
       ndId = 0  
   
       IF ( listId.LE.0 ) THEN  
 C--   select the 1rst one which name matches:  
   
 C-    search for this diag. in the active 2D/3D diagnostics list  
         DO n=1,nlists  
          DO m=1,nActive(n)  
            IF ( ip.EQ.0 .AND. diagName.EQ.flds(m,n)  
      &                  .AND. idiag(m,n).NE.0 ) THEN  
             ip   = ABS(idiag(m,n))  
             ndId = jdiag(m,n)  
            ENDIF  
          ENDDO  
         ENDDO  
   
       ELSEIF ( listId.LE.nlists ) THEN  
 C--   select the unique diagnostic with output-time identical to listId  
   
 C-    search for this diag. in the active 2D/3D diagnostics list  
         DO n=1,nlists  
          IF ( ip.EQ.0  
      &        .AND. freq(n) .EQ. freq(listId)  
      &        .AND. phase(n).EQ.phase(listId)  
      &        .AND. averageFreq(n) .EQ.averageFreq(listId)  
      &        .AND. averagePhase(n).EQ.averagePhase(listId)  
      &        .AND. averageCycle(n).EQ.averageCycle(listId)  
      &      ) THEN  
           DO m=1,nActive(n)  
            IF ( ip.EQ.0 .AND. diagName.EQ.flds(m,n)  
      &                  .AND. idiag(m,n).NE.0 ) THEN  
             ip   = ABS(idiag(m,n))  
             ndId = jdiag(m,n)  
            ENDIF  
           ENDDO  
          ELSEIF ( ip.EQ.0 ) THEN  
           DO m=1,nActive(n)  
            IF ( ip.EQ.0 .AND. diagName.EQ.flds(m,n)  
      &                  .AND. idiag(m,n).NE.0 ) THEN  
             ndId = jdiag(m,n)  
            ENDIF  
           ENDDO  
          ENDIF  
         ENDDO  
   
       ELSE  
         STOP 'DIAGNOSTICS_GET_POINTERS: invalid listId number'  
       ENDIF  
   
       RETURN  
455        END        END
Legend:
Removed from v.1.25  
changed lines
  Added in v.1.26
  ViewVC Help
Powered by ViewVC 1.1.22