/[MITgcm]/MITgcm/eesupp/src/print.F
ViewVC logotype

Diff of /MITgcm/eesupp/src/print.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.26 by jmc, Tue Oct 10 19:18:47 2006 UTC revision 1.27 by jmc, Tue Mar 20 23:42:16 2007 UTC
# Line 390  C     !INTERFACE: Line 390  C     !INTERFACE:
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                          
# Line 442  C     K    - Loop counter Line 442  C     K    - Loop counter
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    
# Line 454  CEOP Line 455  CEOP
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
# Line 466  CEOP Line 475  CEOP
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
# Line 489  CEOP Line 498  CEOP
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
Legend:
Removed from v.1.26  
changed lines
  Added in v.1.27
  ViewVC Help
Powered by ViewVC 1.1.22