/[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.24 by jmc, Tue Aug 1 23:16:45 2006 UTC revision 1.27 by jmc, Tue Mar 20 23:42:16 2007 UTC
# Line 13  C--    o print_list_l   Prints one-deime Line 13  C--    o print_list_l   Prints one-deime
13  C--                     variables.  C--                     variables.
14  C--    o print_list_r8  Prints one-deimensional list of Real*8  C--    o print_list_r8  Prints one-deimensional list of Real*8
15  C--                     numbers.  C--                     numbers.
16  C--    o print_mapr4    Formats ABCD... contour map of a Real*4 field  C--    o print_maprs    Formats ABCD... contour map of a Real(_RS) field
17  C--                     Uses print_message for writing  C--                     Uses print_message for writing
18  C--    o print_mapr8    Formats ABCD... contour map of a Real*8 field  C--    o print_maprl    Formats ABCD... contour map of a Real(_RL) field
19  C--                     Uses print_message for writing  C--                     Uses print_message for writing
20  C--    o print_message  Does IO with unhighlighted header  C--    o print_message  Does IO with unhighlighted header
21    
# 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
# Line 517  C     !INTERFACE: Line 526  C     !INTERFACE:
526        IMPLICIT NONE        IMPLICIT NONE
527  C     !DESCRIPTION:  C     !DESCRIPTION:
528  C     *==========================================================*  C     *==========================================================*
529  C     | SUBROUTINE PRINT\_MAPR4                                      C     | SUBROUTINE PRINT\_MAPRS                                    
530  C     | o Does textual mapping printing of a field.                C     | o Does textual mapping printing of a field.              
531  C     *==========================================================*  C     *==========================================================*
532  C     | This routine does the actual formatting of the data        C     | This routine does the actual formatting of the data      
533  C     | and printing to a file. It assumes an array using the      C     | and printing to a file. It assumes an array using the    
534  C     | MITgcm UV indexing scheme and base index variables.        C     | MITgcm UV indexing scheme and base index variables.      
535  C     | User code should call an interface routine like            C     | User code should call an interface routine like          
536  C     | PLOT\_FIELD\_XYR4( ... ) rather than this code directly.      C     | PLOT\_FIELD\_XYRS( ... ) rather than this code directly.    
537  C     | Text plots can be oriented XY, YZ, XZ. An orientation      C     | Text plots can be oriented XY, YZ, XZ. An orientation    
538  C     | is specficied through the "plotMode" argument. All the      C     | is specficied through the "plotMode" argument. All the    
539  C     | plots made by a single call to this routine will use the    C     | plots made by a single call to this routine will use the  
# Line 861  C      Data Line 870  C      Data
870             IF ( 10*((iBuf-7)/10) .EQ. iBuf-7 ) THEN             IF ( 10*((iBuf-7)/10) .EQ. iBuf-7 ) THEN
871              WRITE(plotBuf(iBuf:),'(A)')  '|'              WRITE(plotBuf(iBuf:),'(A)')  '|'
872             ELSE             ELSE
873              WRITE(plotBuf(iBuf:iBuf),'(I1)') MOD(iDx,10)              WRITE(plotBuf(iBuf:iBuf),'(I1)') MOD(ABS(iDx),10)
874             ENDIF             ENDIF
875            ENDDO            ENDDO
876           ENDDO           ENDDO
# Line 948  C     | This routine does the actual for Line 957  C     | This routine does the actual for
957  C     | and printing to a file. It assumes an array using the      C     | and printing to a file. It assumes an array using the    
958  C     | MITgcm UV indexing scheme and base index variables.        C     | MITgcm UV indexing scheme and base index variables.      
959  C     | User code should call an interface routine like            C     | User code should call an interface routine like          
960  C     | PLOT\_FIELD\_XYR8( ... ) rather than this code directly.      C     | PLOT\_FIELD\_XYRL( ... ) rather than this code directly.    
961  C     | Text plots can be oriented XY, YZ, XZ. An orientation      C     | Text plots can be oriented XY, YZ, XZ. An orientation    
962  C     | is specficied through the "plotMode" argument. All the      C     | is specficied through the "plotMode" argument. All the    
963  C     | plots made by a single call to this routine will use the    C     | plots made by a single call to this routine will use the  
# Line 1285  C      Data Line 1294  C      Data
1294             IF ( 10*((iBuf-7)/10) .EQ. iBuf-7 ) THEN             IF ( 10*((iBuf-7)/10) .EQ. iBuf-7 ) THEN
1295              WRITE(plotBuf(iBuf:),'(A)')  '|'              WRITE(plotBuf(iBuf:),'(A)')  '|'
1296             ELSE             ELSE
1297              WRITE(plotBuf(iBuf:iBuf),'(I1)') MOD(iDx,10)              WRITE(plotBuf(iBuf:iBuf),'(I1)') MOD(ABS(iDx),10)
1298             ENDIF             ENDIF
1299            ENDDO            ENDDO
1300           ENDDO           ENDDO

Legend:
Removed from v.1.24  
changed lines
  Added in v.1.27

  ViewVC Help
Powered by ViewVC 1.1.22