/[MITgcm]/MITgcm/pkg/mnc/mnc_cwrapper.F
ViewVC logotype

Diff of /MITgcm/pkg/mnc/mnc_cwrapper.F

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

revision 1.26 by edhill, Fri Mar 10 05:50:23 2006 UTC revision 1.30 by edhill, Wed Apr 5 21:07:36 2006 UTC
# Line 494  C     !INPUT PARAMETERS: Line 494  C     !INPUT PARAMETERS:
494  CEOP  CEOP
495    
496  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
497        integer n, nvf,nvl, n1,n2, indv        integer n, nvf,nvl, n1,n2, indv, ic
498        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
499    
500  C     Functions  C     Functions
# Line 517  C       Text Attribute Line 517  C       Text Attribute
517          n = mnc_cw_vnat(1,indv) + 1          n = mnc_cw_vnat(1,indv) + 1
518          n1 = IFNBLNK(tname)          n1 = IFNBLNK(tname)
519          n2 = ILNBLNK(tname)          n2 = ILNBLNK(tname)
520            IF ((n2-n1+1) .GT. MNC_MAX_CHAR) THEN
521              write(msgbuf,'(3a,i6,2a)')
522         &         'MNC_CW_ADD_VATTR_ANY WARNING: attribute name ''',
523         &         tname(n1:n2), ''' has more than ', MNC_MAX_CHAR,
524         &         ' characters and has been truncated to fit--please',
525         &         'use a smaller name or increase MNC_MAX_CHAR'
526              CALL PRINT_MESSAGE( msgbuf, errorMessageUnit,
527         &                        SQUEEZE_RIGHT , myThid)
528    C         MNC_MAX_CHAR = n2 - n1 + 1
529              n2 = MNC_MAX_CHAR + n1 - 1
530            ENDIF
531  C       write(*,*) atype,tname(n1:n2)  C       write(*,*) atype,tname(n1:n2)
532          mnc_cw_vtnm(n,indv)(1:MNC_MAX_CHAR) =          mnc_cw_vtnm(n,indv)(1:MNC_MAX_CHAR) =
533       &       mnc_blank_name(1:MNC_MAX_CHAR)       &       mnc_blank_name(1:MNC_MAX_CHAR)
534          mnc_cw_vtnm(n,indv)(1:(n2-n1+1)) = tname(n1:n2)          mnc_cw_vtnm(n,indv)(1:(n2-n1+1)) = tname(n1:n2)
535    
536          n1 = IFNBLNK(tval)          n1 = IFNBLNK(tval)
537          n2 = ILNBLNK(tval)          n2 = ILNBLNK(tval)
538          IF ((n1 .EQ. 0) .OR. (n2 .EQ. 0)) THEN          IF ((n2-n1+1) .GT. MNC_MAX_CATT) THEN
539            mnc_cw_vtat(n,indv)(1:MNC_MAX_CHAR) =            write(msgbuf,'(3a,i6,2a)')
540       &         mnc_blank_name(1:MNC_MAX_CHAR)                 &         'MNC_CW_ADD_VATTR_ANY WARNING: attribute value ''',
541            mnc_cw_vnat(1,indv) = n       &         tval(n1:n2), ''' has more than ', MNC_MAX_CATT,
542          ELSE       &         ' characters and has been truncated to fit--please',
543            mnc_cw_vtat(n,indv)(1:MNC_MAX_CHAR) =       &         'use a smaller name or increase MNC_MAX_CATT'
544       &         mnc_blank_name(1:MNC_MAX_CHAR)            CALL PRINT_MESSAGE( msgbuf, errorMessageUnit,
545         &                        SQUEEZE_RIGHT , myThid)
546              n2 = MNC_MAX_CATT + n1 - 1
547            ENDIF
548            
549            mnc_cw_vnat(1,indv) = n
550            DO ic = 1,MNC_MAX_CATT
551              mnc_cw_vtat(n,indv)(ic:ic) = ' '
552            ENDDO
553            IF ((n1 .NE. 0) .AND. (n2 .NE. 0)) THEN
554            mnc_cw_vtat(n,indv)(1:(n2-n1+1)) = tval(n1:n2)            mnc_cw_vtat(n,indv)(1:(n2-n1+1)) = tval(n1:n2)
           mnc_cw_vnat(1,indv) = n  
555          ENDIF          ENDIF
556        ENDIF        ENDIF
557                    
# Line 727  C     !LOCAL VARIABLES: Line 747  C     !LOCAL VARIABLES:
747        integer ierr        integer ierr
748    
749  C     Check if the file is already open  C     Check if the file is already open
750        CALL MNC_GET_IND(MNC_MAX_ID, fname, mnc_f_names, indf, myThid)        CALL MNC_GET_IND(MNC_MAX_FID, fname, mnc_f_names, indf, myThid)
751        IF (indf .GT. 0) THEN        IF (indf .GT. 0) THEN
752          RETURN          RETURN
753        ENDIF        ENDIF
Legend:
Removed from v.1.26  
changed lines
  Added in v.1.30
  ViewVC Help
Powered by ViewVC 1.1.22