390 |
IMPLICIT NONE |
IMPLICIT NONE |
391 |
C !DESCRIPTION: |
C !DESCRIPTION: |
392 |
C *==========================================================* |
C *==========================================================* |
393 |
C | o SUBROUTINE PRINT\_LIST\_R8 |
C | o SUBROUTINE PRINT\_LIST\_R8 |
394 |
C *==========================================================* |
C *==========================================================* |
395 |
C | Routine for producing list of values for a field with |
C | Routine for producing list of values for a field with |
396 |
C | duplicate values collected into |
C | duplicate values collected into |
442 |
CHARACTER*(MAX_LEN_MBUF) msgBuf |
CHARACTER*(MAX_LEN_MBUF) msgBuf |
443 |
CHARACTER*2 commOpen,commClose |
CHARACTER*2 commOpen,commClose |
444 |
CHARACTER*3 index_lab |
CHARACTER*3 index_lab |
445 |
|
CHARACTER*25 fmt1, fmt2 |
446 |
INTEGER K |
INTEGER K |
447 |
CEOP |
CEOP |
448 |
|
|
455 |
ELSE |
ELSE |
456 |
index_lab = '?=' |
index_lab = '?=' |
457 |
ENDIF |
ENDIF |
458 |
|
C- fortran format to write 1 or 2 indices: |
459 |
|
fmt1='(A,1X,A,I3,1X,A)' |
460 |
|
fmt2='(A,1X,A,I3,A,I3,1X,A)' |
461 |
|
IF ( lFld.GE.1000 ) THEN |
462 |
|
K = 1+INT(LOG10(FLOAT(lFld))) |
463 |
|
WRITE(fmt1,'(A,I1,A)') '(A,1X,A,I',K,',1X,A)' |
464 |
|
WRITE(fmt2,'(A,I1,A,I1,A)') '(A,1X,A,I',K,',A,I',K,',1X,A)' |
465 |
|
ENDIF |
466 |
commOpen = '/*' |
commOpen = '/*' |
467 |
commClose = '*/' |
commClose = '*/' |
468 |
iLo = 1 |
iLo = 1 |
475 |
nDup = iHi-iLo+1 |
nDup = iHi-iLo+1 |
476 |
IF ( nDup .EQ. 1 ) THEN |
IF ( nDup .EQ. 1 ) THEN |
477 |
WRITE(msgBuf,'(A,1PE23.15,A)') ' ',xOld,punc |
WRITE(msgBuf,'(A,1PE23.15,A)') ' ',xOld,punc |
478 |
IF ( index_type .NE. INDEX_NONE ) |
IF ( index_type .NE. INDEX_NONE ) |
479 |
& WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') |
& WRITE(msgBuf(45:),fmt1) |
480 |
& commOpen,index_lab,iLo,commClose |
& commOpen,index_lab,iLo,commClose |
481 |
ELSE |
ELSE |
482 |
WRITE(msgBuf,'(I5,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc |
WRITE(msgBuf,'(I5,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc |
483 |
IF ( index_type .NE. INDEX_NONE ) |
IF ( index_type .NE. INDEX_NONE ) |
484 |
& WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)') |
& WRITE(msgBuf(45:),fmt2) |
485 |
& commOpen,index_lab,iLo,':',iHi,commClose |
& commOpen,index_lab,iLo,':',iHi,commClose |
486 |
ENDIF |
ENDIF |
487 |
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, |
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, |
488 |
& SQUEEZE_RIGHT , 1) |
& SQUEEZE_RIGHT , 1) |
489 |
iLo = K |
iLo = K |
490 |
iHi = K |
iHi = K |
498 |
nDup = iHi-iLo+1 |
nDup = iHi-iLo+1 |
499 |
IF ( nDup .EQ. 1 ) THEN |
IF ( nDup .EQ. 1 ) THEN |
500 |
WRITE(msgBuf,'(A,1PE23.15,A)') ' ',xOld,punc |
WRITE(msgBuf,'(A,1PE23.15,A)') ' ',xOld,punc |
501 |
IF ( index_type .NE. INDEX_NONE ) |
IF ( index_type .NE. INDEX_NONE ) |
502 |
& WRITE(msgBuf(45:),'(A,1X,A,I3,1X,A)') |
& WRITE(msgBuf(45:),fmt1) |
503 |
& commOpen,index_lab,iLo,commClose |
& commOpen,index_lab,iLo,commClose |
504 |
ELSEIF( nDup .GT. 1 ) THEN |
ELSEIF( nDup .GT. 1 ) THEN |
505 |
WRITE(msgBuf,'(I5,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc |
WRITE(msgBuf,'(I5,'' '',A,1PE23.15,A)') nDup,'@',xOld,punc |
506 |
IF ( index_type .NE. INDEX_NONE ) |
IF ( index_type .NE. INDEX_NONE ) |
507 |
& WRITE(msgBuf(45:),'(A,1X,A,I3,A,I3,1X,A)') |
& WRITE(msgBuf(45:),fmt2) |
508 |
& commOpen,index_lab,iLo,':',iHi,commClose |
& commOpen,index_lab,iLo,':',iHi,commClose |
509 |
ENDIF |
ENDIF |
510 |
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, |
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit, |
511 |
& SQUEEZE_RIGHT , 1) |
& SQUEEZE_RIGHT , 1) |
512 |
|
|
513 |
RETURN |
RETURN |