293 |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| |
294 |
|
|
295 |
CBOP 0 |
CBOP 0 |
296 |
C !ROUTINE: diagnostics_get_pointers |
C !ROUTINE: DIAGNOSTICS_GET_POINTERS |
297 |
C !INTERFACE: |
C !INTERFACE: |
298 |
subroutine diagnostics_get_pointers(diagName,ipoint,jpoint,myThid) |
SUBROUTINE DIAGNOSTICS_GET_POINTERS( |
299 |
|
I diagName, listId, |
300 |
|
O ndId, ip, |
301 |
|
I myThid ) |
302 |
|
|
303 |
C !DESCRIPTION: |
C !DESCRIPTION: |
304 |
C *==========================================================* |
C *================================================================* |
305 |
C | subroutine diagnostics_get_pointers |
C | o Returns the diagnostic Id number and diagnostic |
306 |
C | o Returns the idiag and jdiag pointers for a |
C | pointer to storage array for a specified diagnostic. |
307 |
C | specified diagnostic - returns 0 if not active |
C *================================================================* |
308 |
C *==========================================================* |
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: |
C !USES: |
319 |
IMPLICIT NONE |
IMPLICIT NONE |
323 |
#include "DIAGNOSTICS.h" |
#include "DIAGNOSTICS.h" |
324 |
|
|
325 |
C !INPUT PARAMETERS: |
C !INPUT PARAMETERS: |
326 |
C diagName :: diagnostic identificator name (8 characters long) |
C diagName :: diagnostic identificator name (8 characters long) |
327 |
C myThid :: my thread Id number |
C listId :: list number that specify the output frequency |
328 |
|
C myThid :: my Thread Id number |
329 |
C !OUTPUT PARAMETERS: |
C !OUTPUT PARAMETERS: |
330 |
C ipoint :: pointer value into qdiag array |
C ndId :: diagnostics Id number (in available diagnostics list) |
331 |
C jpoint :: pointer value into diagnostics list |
C ip :: diagnostics pointer to storage array |
332 |
|
|
333 |
|
|
334 |
CHARACTER*8 diagName |
CHARACTER*8 diagName |
335 |
INTEGER ipoint, jpoint, myThid |
INTEGER listId |
336 |
|
INTEGER ndId, ip |
337 |
|
INTEGER myThid |
338 |
CEOP |
CEOP |
339 |
|
|
340 |
C !LOCAL VARIABLES: |
C !LOCAL VARIABLES: |
341 |
INTEGER n,m |
INTEGER n,m |
342 |
|
|
343 |
ipoint = 0 |
ip = 0 |
344 |
jpoint = 0 |
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 |
C- search for this diag. in the active 2D/3D diagnostics list |
364 |
DO n=1,nlists |
DO n=1,nlists |
365 |
DO m=1,nActive(n) |
IF ( ip.EQ.0 |
366 |
IF ( diagName.EQ.flds(m,n) .AND. idiag(m,n).NE.0 ) THEN |
& .AND. freq(n) .EQ. freq(listId) |
367 |
ipoint = abs(idiag(m,n)) |
& .AND. phase(n).EQ.phase(listId) |
368 |
jpoint = jdiag(m,n) |
& .AND. averageFreq(n) .EQ.averageFreq(listId) |
369 |
ENDIF |
& .AND. averagePhase(n).EQ.averagePhase(listId) |
370 |
ENDDO |
& .AND. averageCycle(n).EQ.averageCycle(listId) |
371 |
ENDDO |
& ) 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 |
RETURN |
394 |
END |
END |