/[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.29 by jmc, Fri Jan 15 00:25:58 2010 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 DIAGNOSTICS_SETKLEV
12    C--    o DIAGS_GET_PARMS_I (Function)
13  C--    o DIAGS_MK_UNITS (Function)  C--    o DIAGS_MK_UNITS (Function)
14  C--    o DIAGS_MK_TITLE (Function)  C--    o DIAGS_MK_TITLE (Function)
 C--    o DIAGNOSTICS_GET_POINTERS  
15    
16  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
17  CBOP 0  CBOP 0
# Line 68  C-      No counter diagnostics => averag Line 70  C-      No counter diagnostics => averag
70            factor = FLOAT(ndiag(ip,bi,bj))            factor = FLOAT(ndiag(ip,bi,bj))
71            IF (ndiag(ip,bi,bj).NE.0) factor = 1. _d 0 / factor            IF (ndiag(ip,bi,bj).NE.0) factor = 1. _d 0 / factor
72    
73    #ifdef ALLOW_FIZHI
74            DO j = 1,sNy+1            DO j = 1,sNy+1
75              DO i = 1,sNx+1              DO i = 1,sNx+1
76                IF ( qdiag(i,j,ipnt,bi,bj) .LE. undef ) THEN                IF ( qdiag(i,j,ipnt,bi,bj) .LE. undef ) THEN
# Line 77  C-      No counter diagnostics => averag Line 80  C-      No counter diagnostics => averag
80                ENDIF                ENDIF
81              ENDDO              ENDDO
82            ENDDO            ENDDO
83    #else /* ALLOW_FIZHI */
84              DO j = 1,sNy+1
85                DO i = 1,sNx+1
86                  qtmp(i,j) = qdiag(i,j,ipnt,bi,bj)*factor
87                ENDDO
88              ENDDO
89    #endif /* ALLOW_FIZHI */
90    
91          ELSE          ELSE
92  C-      With counter diagnostics => average = Sum / counter:  C-      With counter diagnostics => average = Sum / counter:
# Line 141  C     !LOCAL VARIABLES: Line 151  C     !LOCAL VARIABLES:
151  C ===============  C ===============
152        INTEGER m, n        INTEGER m, n
153        INTEGER bi, bj        INTEGER bi, bj
154        INTEGER ipt        INTEGER ipt, ndId
155  c     CHARACTER*(MAX_LEN_MBUF) msgBuf  c     CHARACTER*(MAX_LEN_MBUF) msgBuf
156    
157          IF ( biArg.EQ.0 .AND. bjArg.EQ.0 ) THEN
158            bi = myBxLo(myThid)
159            bj = myByLo(myThid)
160          ELSE
161            bi = MIN(biArg,nSx)
162            bj = MIN(bjArg,nSy)
163          ENDIF
164    
165  C--   Run through list of active diagnostics to find which counter  C--   Run through list of active diagnostics to find which counter
166  C     to increment (needs to be a valid & active diagnostic-counter)  C     to increment (needs to be a valid & active diagnostic-counter)
167        DO n=1,nlists        DO n=1,nlists
168         DO m=1,nActive(n)         DO m=1,nActive(n)
169          IF ( chardiag.EQ.flds(m,n) .AND. idiag(m,n).GT.0 ) THEN          IF ( chardiag.EQ.flds(m,n) .AND. idiag(m,n).GT.0 ) THEN
170           ipt = idiag(m,n)           ipt = idiag(m,n)
171           IF (ndiag(ipt,1,1).GE.0) THEN           IF (ndiag(ipt,bi,bj).GE.0) THEN
172              ndId = jdiag(m,n)
173              ipt = ipt + pdiag(n,bi,bj)*kdiag(ndId)
174  C-    Increment the counter for the diagnostic  C-    Increment the counter for the diagnostic
175            IF ( biArg.EQ.0 .AND. bjArg.EQ.0 ) THEN            IF ( biArg.EQ.0 .AND. bjArg.EQ.0 ) THEN
176             DO bj=myByLo(myThid), myByHi(myThid)             DO bj=myByLo(myThid), myByHi(myThid)
# Line 159  C-    Increment the counter for the diag Line 179  C-    Increment the counter for the diag
179              ENDDO              ENDDO
180             ENDDO             ENDDO
181            ELSE            ELSE
              bi = MIN(biArg,nSx)  
              bj = MIN(bjArg,nSy)  
182               ndiag(ipt,bi,bj) = ndiag(ipt,bi,bj) + 1               ndiag(ipt,bi,bj) = ndiag(ipt,bi,bj) + 1
183            ENDIF            ENDIF
184  C-    Increment is done  C-    Increment is done
# Line 175  C-    Increment is done Line 193  C-    Increment is done
193  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
194    
195  CBOP 0  CBOP 0
196    C     !ROUTINE: DIAGNOSTICS_GET_POINTERS
197    C     !INTERFACE:
198          SUBROUTINE DIAGNOSTICS_GET_POINTERS(
199         I                       diagName, listId,
200         O                       ndId, ip,
201         I                       myThid )
202    
203    C     !DESCRIPTION:
204    C     *================================================================*
205    C     | o Returns the diagnostic Id number and diagnostic
206    C     |   pointer to storage array for a specified diagnostic.
207    C     *================================================================*
208    C     | Note: A diagnostics field can be stored multiple times
209    C     |       (for different output frequency,phase, ...).
210    C     | operates in 2 ways:
211    C     | o listId =0 => find 1 diagnostics Id & pointer which name matches.
212    C     | o listId >0 => find the unique diagnostic Id & pointer with
213    C     |      the right name and same output time as "listId" output-list
214    C     | o return ip=0 if did not find the right diagnostic;
215    C     |   (ndId <>0 if diagnostic exist but output time does not match)
216    C     *================================================================*
217    
218    C     !USES:
219          IMPLICIT NONE
220    #include "EEPARAMS.h"
221    #include "SIZE.h"
222    #include "DIAGNOSTICS_SIZE.h"
223    #include "DIAGNOSTICS.h"
224    
225    C     !INPUT PARAMETERS:
226    C     diagName :: diagnostic identificator name (8 characters long)
227    C     listId   :: list number that specify the output frequency
228    C     myThid   :: my Thread Id number
229    C     !OUTPUT PARAMETERS:
230    C     ndId     :: diagnostics  Id number (in available diagnostics list)
231    C     ip       :: diagnostics  pointer to storage array
232    
233    
234          CHARACTER*8 diagName
235          INTEGER listId
236          INTEGER ndId, ip
237          INTEGER myThid
238    CEOP
239    
240    C     !LOCAL VARIABLES:
241          INTEGER n,m
242    
243          ip   = 0
244          ndId = 0
245    
246          IF ( listId.LE.0 ) THEN
247    C--   select the 1rst one which name matches:
248    
249    C-    search for this diag. in the active 2D/3D diagnostics list
250            DO n=1,nlists
251             DO m=1,nActive(n)
252               IF ( ip.EQ.0 .AND. diagName.EQ.flds(m,n)
253         &                  .AND. idiag(m,n).NE.0 ) THEN
254                ip   = ABS(idiag(m,n))
255                ndId = jdiag(m,n)
256               ENDIF
257             ENDDO
258            ENDDO
259    
260          ELSEIF ( listId.LE.nlists ) THEN
261    C--   select the unique diagnostic with output-time identical to listId
262    
263    C-    search for this diag. in the active 2D/3D diagnostics list
264            DO n=1,nlists
265             IF ( ip.EQ.0
266         &        .AND. freq(n) .EQ. freq(listId)
267         &        .AND. phase(n).EQ.phase(listId)
268         &        .AND. averageFreq(n) .EQ.averageFreq(listId)
269         &        .AND. averagePhase(n).EQ.averagePhase(listId)
270         &        .AND. averageCycle(n).EQ.averageCycle(listId)
271         &      ) THEN
272              DO m=1,nActive(n)
273               IF ( ip.EQ.0 .AND. diagName.EQ.flds(m,n)
274         &                  .AND. idiag(m,n).NE.0 ) THEN
275                ip   = ABS(idiag(m,n))
276                ndId = jdiag(m,n)
277               ENDIF
278              ENDDO
279             ELSEIF ( ip.EQ.0 ) THEN
280              DO m=1,nActive(n)
281               IF ( ip.EQ.0 .AND. diagName.EQ.flds(m,n)
282         &                  .AND. idiag(m,n).NE.0 ) THEN
283                ndId = jdiag(m,n)
284               ENDIF
285              ENDDO
286             ENDIF
287            ENDDO
288    
289          ELSE
290            STOP 'DIAGNOSTICS_GET_POINTERS: invalid listId number'
291          ENDIF
292    
293          RETURN
294          END
295    
296    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
297    
298    CBOP 0
299    C     !ROUTINE: DIAGNOSTICS_SETKLEV
300    
301    C     !INTERFACE:
302          SUBROUTINE DIAGNOSTICS_SETKLEV(
303         I                                diagName, nLevDiag, myThid )
304    
305    C     !DESCRIPTION:
306    C     *==========================================================*
307    C     | S/R DIAGNOSTICS_SETKLEV
308    C     | o Define explicitly the number of level (stored in kdiag)
309    C     |   of a diagnostic field. For most diagnostics, the number
310    C     |   of levels is derived (in S/R SET_LEVELS) from gdiag(10)
311    C     |   but occasionally one may want to set it explicitly.
312    C     *==========================================================*
313    
314    C     !USES:
315          IMPLICIT NONE
316    #include "EEPARAMS.h"
317    #include "SIZE.h"
318    #include "DIAGNOSTICS_SIZE.h"
319    #include "DIAGNOSTICS.h"
320    
321    C     !INPUT PARAMETERS:
322    C     diagName  :: diagnostic identificator name (8 characters long)
323    C     nLevDiag  :: number of level to set for this diagnostics field
324    C     myThid    :: my Thread Id number
325          CHARACTER*8  diagName
326          INTEGER nLevDiag
327          INTEGER myThid
328    CEOP
329    
330    C     !LOCAL VARIABLES:
331          CHARACTER*(MAX_LEN_MBUF) msgBuf
332          INTEGER n, ndId
333    
334    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
335    
336    C--   Check if this S/R is called from the right place ;
337    C     needs to be after DIAGNOSTICS_INIT_EARLY and before DIAGNOSTICS_INIT_FIXED
338          IF ( .NOT.settingDiags ) THEN
339            WRITE(msgBuf,'(4A,I5)') 'DIAGNOSTICS_SETKLEV: ',
340         &     'diagName="', diagName, '" , nLevDiag=', nLevDiag
341            CALL PRINT_ERROR( msgBuf, myThid )
342            WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_SETKLEV: ',
343         &     '<== called from the WRONG place, i.e.'
344            CALL PRINT_ERROR( msgBuf, myThid )
345            WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_SETKLEV: ',
346         &     'outside diagnostics setting section = from'
347            CALL PRINT_ERROR( msgBuf, myThid )
348            WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_SETKLEV: ',
349         &     '   Diag_INIT_EARLY down to Diag_INIT_FIXED'
350            CALL PRINT_ERROR( msgBuf, myThid )
351            STOP 'ABNORMAL END: S/R DIAGNOSTICS_SETKLEV'
352          ENDIF
353    
354    C--   Find this diagnostics in the list of available diag.
355          ndId = 0
356          DO n = 1,ndiagt
357            IF ( diagName.EQ.cdiag(n) ) THEN
358              ndId = n
359            ENDIF
360          ENDDO
361          IF ( ndId.EQ.0 ) THEN
362            WRITE(msgBuf,'(4A)') 'DIAGNOSTICS_SETKLEV: ',
363         &     'diagName="', diagName, '" not known.'
364            CALL PRINT_ERROR( msgBuf, myThid )
365            STOP 'ABNORMAL END: S/R DIAGNOSTICS_SETKLEV'
366          ENDIF
367    
368    C-    Optional level number diagnostics (X): set number of levels
369          IF ( kdiag(ndId).EQ.0
370         &   .AND. gdiag(ndId)(10:10).EQ.'X' ) THEN
371            kdiag(ndId) = nLevDiag
372          ELSEIF ( kdiag(ndId).EQ.nLevDiag
373         &   .AND. gdiag(ndId)(10:10).EQ.'X' ) THEN
374    C-    level number already set to same value: send warning
375            WRITE(msgBuf,'(4A,I5)') '** WARNING ** DIAGNOSTICS_SETKLEV: ',
376         &     'diagName="', diagName, '" , nLevDiag=', nLevDiag
377            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
378         &                      SQUEEZE_RIGHT , myThid )
379            WRITE(msgBuf,'(2A,I5,A)')'** WARNING ** DIAGNOSTICS_SETKLEV:',
380         &     ' level Nb (=', kdiag(ndId), ') already set.'
381            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
382         &                      SQUEEZE_RIGHT , myThid )
383          ELSEIF ( gdiag(ndId)(10:10).EQ.'X' ) THEN
384    C-    level number already set to a different value: do not reset but stop
385            WRITE(msgBuf,'(4A,I5)') 'DIAGNOSTICS_SETKLEV: ',
386         &     'diagName="', diagName, '" , nLevDiag=', nLevDiag
387            CALL PRINT_ERROR( msgBuf, myThid )
388            WRITE(msgBuf,'(2A,I5,3A)') 'DIAGNOSTICS_SETKLEV: ',
389         &     'level Nb already set to', kdiag(ndId), ' => STOP'
390            CALL PRINT_ERROR( msgBuf, myThid )
391          ELSE
392    C-    for now, do nothing but just send a warning
393            WRITE(msgBuf,'(4A,I5)') '** WARNING ** DIAGNOSTICS_SETKLEV: ',
394         &     'diagName="', diagName, '" , nLevDiag=', nLevDiag
395            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
396         &                      SQUEEZE_RIGHT , myThid )
397            WRITE(msgBuf,'(2A,I5,3A)') '** WARNING ** will set level Nb',
398         &     ' from diagCode(ndId=', ndId, ')="', gdiag(ndId)(1:10), '"'
399            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
400         &                      SQUEEZE_RIGHT , myThid )
401            WRITE(msgBuf,'(4A)') '** WARNING ** DIAGNOSTICS_SETKLEV',
402         &     '("', diagName, '") <== Ignore this call.'
403            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
404         &                      SQUEEZE_RIGHT , myThid )
405          ENDIF
406    
407          RETURN
408          END
409    
410    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
411    
412    CBOP 0
413    C     !ROUTINE: DIAGS_GET_PARMS_I
414    
415    C     !INTERFACE:
416          INTEGER FUNCTION DIAGS_GET_PARMS_I(
417         I                            parName, myThid )
418    
419    C     !DESCRIPTION:
420    C     *==========================================================*
421    C     | FUNCTION DIAGS_GET_PARMS_I
422    C     | o Return the value of integer parameter
423    C     |   from one of the DIAGNOSTICS.h common blocs
424    C     *==========================================================*
425    
426    C     !USES:
427          IMPLICIT NONE
428    #include "EEPARAMS.h"
429    #include "SIZE.h"
430    #include "DIAGNOSTICS_SIZE.h"
431    #include "DIAGNOSTICS.h"
432    
433    C     !INPUT PARAMETERS:
434    C     parName   :: string used to identify which parameter to get
435    C     myThid    :: my Thread Id number
436          CHARACTER*(*) parName
437          INTEGER myThid
438    CEOP
439    
440    C     !LOCAL VARIABLES:
441          CHARACTER*(MAX_LEN_MBUF) msgBuf
442          INTEGER n
443    
444    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
445    
446          n = LEN(parName)
447    c     write(0,'(3A,I4)')
448    c    &  'DIAGS_GET_PARMS_I: parName="',parName,'" , length=',n
449    
450          IF ( parName.EQ.'LAST_DIAG_ID' ) THEN
451             DIAGS_GET_PARMS_I = ndiagt
452          ELSE
453             WRITE(msgBuf,'(4A)') 'DIAGS_GET_PARMS_I: ',
454         &    ' parName="', parName, '" not known.'
455             CALL PRINT_ERROR( msgBuf, myThid )
456             STOP 'ABNORMAL END: S/R DIAGS_GET_PARMS_I'
457          ENDIF
458    
459          RETURN
460          END
461    
462    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
463    
464    CBOP 0
465  C     !ROUTINE: DIAGS_MK_UNITS  C     !ROUTINE: DIAGS_MK_UNITS
466    
467  C     !INTERFACE:  C     !INTERFACE:
# Line 204  C     !LOCAL VARIABLES: Line 491  C     !LOCAL VARIABLES:
491        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
492        INTEGER i,j,n        INTEGER i,j,n
493    
494        DIAGS_MK_UNITS = '          '        DIAGS_MK_UNITS = '                '
495        n = LEN(diagUnitsInPieces)        n = LEN(diagUnitsInPieces)
496    
497        j = 0        j = 0
# Line 216  C     !LOCAL VARIABLES: Line 503  C     !LOCAL VARIABLES:
503        ENDDO        ENDDO
504    
505        IF ( j.GT.16 ) THEN        IF ( j.GT.16 ) THEN
506           WRITE(msgBuf,'(2A,I4,A)') '**WARNING** ',           WRITE(msgBuf,'(2A,I4,A)') '** WARNING ** ',
507       &   'DIAGS_MK_UNITS: too long (',j,' >16) input string'       &   'DIAGS_MK_UNITS: too long (',j,' >16) input string'
508          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
509       &       SQUEEZE_RIGHT , myThid)       &       SQUEEZE_RIGHT , myThid)
510           WRITE(msgBuf,'(3A)') '**WARNING** ',           WRITE(msgBuf,'(3A)') '** WARNING ** ',
511       &   'DIAGS_MK_UNITS: input=', diagUnitsInPieces       &   'DIAGS_MK_UNITS: input=', diagUnitsInPieces
512          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
513       &       SQUEEZE_RIGHT , myThid)       &       SQUEEZE_RIGHT , myThid)
# Line 285  C---+----1----+----2----+----3----+----4 Line 572  C---+----1----+----2----+----3----+----4
572        ENDDO        ENDDO
573    
574        IF ( j.GT.80 ) THEN        IF ( j.GT.80 ) THEN
575           WRITE(msgBuf,'(2A,I4,A)') '**WARNING** ',           WRITE(msgBuf,'(2A,I4,A)') '** WARNING ** ',
576       &   'DIAGS_MK_TITLE: too long (',j,' >80) input string'       &   'DIAGS_MK_TITLE: too long (',j,' >80) input string'
577          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
578       &       SQUEEZE_RIGHT , myThid)       &       SQUEEZE_RIGHT , myThid)
579           WRITE(msgBuf,'(3A)') '**WARNING** ',           WRITE(msgBuf,'(3A)') '** WARNING ** ',
580       &   'DIAGS_MK_TITLE: input=', diagTitleInPieces       &   'DIAGS_MK_TITLE: input=', diagTitleInPieces
581          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
582       &       SQUEEZE_RIGHT , myThid)       &       SQUEEZE_RIGHT , myThid)
583        ENDIF        ENDIF
584    
585        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  
586        END        END
Legend:
Removed from v.1.25  
changed lines
  Added in v.1.29
  ViewVC Help
Powered by ViewVC 1.1.22