/[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.19 by edhill, Wed Sep 22 21:19:44 2004 UTC revision 1.20 by edhill, Thu Sep 23 03:28:42 2004 UTC
# Line 27  C     !USES: Line 27  C     !USES:
27  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
28        integer myThid, ndim        integer myThid, ndim
29        character*(*) name        character*(*) name
30        integer dlens(ndim), inds_beg(ndim), inds_end(ndim)        integer dlens(*), inds_beg(*), inds_end(*)
31        character*(*) dnames(ndim)        character*(*) dnames(*)
32  CEOP  CEOP
33    
34  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
# Line 618  C     Check that this vname is not alrea Line 618  C     Check that this vname is not alrea
618        END        END
619    
620  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
621  CBOP 0  CBOP
622  C     !ROUTINE: MNC_CW_ADD_VATTR_TEXT  C     !ROUTINE: MNC_CW_ADD_VATTR_TEXT
   
623  C     !INTERFACE:  C     !INTERFACE:
624        SUBROUTINE MNC_CW_ADD_VATTR_TEXT(        SUBROUTINE MNC_CW_ADD_VATTR_TEXT(
625       I     vname,       I     vname, tname, tval,
      I     tname,  
      I     tval,  
626       I     myThid )       I     myThid )
627    
628  C     !DESCRIPTION:  C     !DESCRIPTION:
# Line 637  C     !USES: Line 634  C     !USES:
634  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
635        integer myThid        integer myThid
636        character*(*) vname, tname, tval        character*(*) vname, tname, tval
637          integer ival
638          REAL*8 dval
639  CEOP  CEOP
640          ival = 0
641        CALL MNC_CW_ADD_VATTR_ANY(vname,        dval = 0.0D0
642       &     tname, ' ', ' ',        CALL MNC_CW_ADD_VATTR_ANY(vname, 1,
643       &     tval, 0, 0.0D0, myThid )       &     tname, ' ', ' ', tval, ival, dval, myThid )
   
644        RETURN        RETURN
645        END        END
   
646  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
647  CBOP  CBOP
648  C     !ROUTINE: MNC_CW_ADD_VATTR_INT  C     !ROUTINE: MNC_CW_ADD_VATTR_INT
   
649  C     !INTERFACE:  C     !INTERFACE:
650        SUBROUTINE MNC_CW_ADD_VATTR_INT(        SUBROUTINE MNC_CW_ADD_VATTR_INT(
651       I     vname,       I     vname, iname, ival,
      I     iname,  
      I     ival,  
652       I     myThid )       I     myThid )
653    
654  C     !DESCRIPTION:  C     !DESCRIPTION:
655    C     Add integer attribute
656    
657  C     !USES:  C     !USES:
658        implicit none        implicit none
# Line 666  C     !INPUT PARAMETERS: Line 661  C     !INPUT PARAMETERS:
661        integer myThid        integer myThid
662        character*(*) vname, iname        character*(*) vname, iname
663        integer ival        integer ival
664          REAL*8 dval
665  CEOP  CEOP
666          dval = 0.0D0
667        CALL MNC_CW_ADD_VATTR_ANY(vname,        CALL MNC_CW_ADD_VATTR_ANY(vname, 2,
668       &     ' ', iname, ' ',       &     ' ', iname, ' ', ' ', ival, dval, myThid )
      &     ' ', ival, 0.0D0, myThid )  
   
669        RETURN        RETURN
670        END        END
   
671  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
672  CBOP 0  CBOP
673  C !ROUTINE: MNC_CW_ADD_VATTR_DBL  C !ROUTINE: MNC_CW_ADD_VATTR_DBL
   
674  C !INTERFACE:  C !INTERFACE:
675        SUBROUTINE MNC_CW_ADD_VATTR_DBL(        SUBROUTINE MNC_CW_ADD_VATTR_DBL(
676       I     vname,       I     vname, dname, dval,
      I     dname,  
      I     dval,  
677       I     myThid )       I     myThid )
678    
679  C     !DESCRIPTION:  C     !DESCRIPTION:
680    C     Add double-precision real attribute
681    
682  C     !USES:  C     !USES:
683        implicit none        implicit none
# Line 694  C     !USES: Line 685  C     !USES:
685  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
686        integer myThid        integer myThid
687        character*(*) vname, dname        character*(*) vname, dname
688          integer ival
689        REAL*8 dval        REAL*8 dval
690  CEOP  CEOP
691          ival = 0
692        CALL MNC_CW_ADD_VATTR_ANY(vname,        CALL MNC_CW_ADD_VATTR_ANY(vname, 3,
693       &     ' ', ' ', dname,       &     ' ', ' ', dname, ' ', ival, dval, myThid )
      &     ' ', 0, dval, myThid )  
   
694        RETURN        RETURN
695        END        END
   
696  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
697  CBOP 1  CBOP 1
698  C     !ROUTINE: MNC_CW_ADD_VATTR_ANY  C     !ROUTINE: MNC_CW_ADD_VATTR_ANY
# Line 711  C     !ROUTINE: MNC_CW_ADD_VATTR_ANY Line 700  C     !ROUTINE: MNC_CW_ADD_VATTR_ANY
700  C     !INTERFACE:  C     !INTERFACE:
701        SUBROUTINE MNC_CW_ADD_VATTR_ANY(        SUBROUTINE MNC_CW_ADD_VATTR_ANY(
702       I     vname,       I     vname,
703         I     atype,
704       I     tname, iname, dname,       I     tname, iname, dname,
705       I     tval,  ival,  dval,       I     tval,  ival,  dval,
706       I     myThid )       I     myThid )
# Line 724  C     !USES: Line 714  C     !USES:
714    
715  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
716        integer myThid        integer myThid
717          integer atype
718        character*(*) vname        character*(*) vname
719        character*(*) tname, iname, dname        character*(*) tname, iname, dname
720        character*(*) tval        character*(*) tval
# Line 750  C     Check that vname is defined Line 741  C     Check that vname is defined
741          stop 'ABNORMAL END: S/R MNC_CW_ADD_VATTR_ANY'          stop 'ABNORMAL END: S/R MNC_CW_ADD_VATTR_ANY'
742        ENDIF        ENDIF
743    
744  C     Text Attributes        IF (atype .EQ. 1) THEN
745        n = mnc_cw_vnat(1,indv)  C       Text Attribute
746        n1 = IFNBLNK(tname)          n = mnc_cw_vnat(1,indv) + 1
747        n2 = ILNBLNK(tname)          n1 = IFNBLNK(tname)
748        mnc_cw_vtnm(n+1,indv)(1:MNC_MAX_CHAR) =          n2 = ILNBLNK(tname)
749       &     mnc_blank_name(1:MNC_MAX_CHAR)  C       write(*,*) atype,tname(n1:n2)
750        mnc_cw_vtnm(n+1,indv)(1:(n2-n1+1)) = tname(n1:n2)          mnc_cw_vtnm(n,indv)(1:MNC_MAX_CHAR) =
       n1 = IFNBLNK(tval)  
       n2 = ILNBLNK(tval)  
       mnc_cw_vtat(n+1,indv)(1:MNC_MAX_CHAR) =  
751       &       mnc_blank_name(1:MNC_MAX_CHAR)       &       mnc_blank_name(1:MNC_MAX_CHAR)
752        mnc_cw_vtat(n+1,indv)(1:(n2-n1+1)) = tval(n1:n2)          mnc_cw_vtnm(n,indv)(1:(n2-n1+1)) = tname(n1:n2)
753        mnc_cw_vnat(1,indv) = n + 1          n1 = IFNBLNK(tval)
754                  n2 = ILNBLNK(tval)
755  C     Integer Attributes          mnc_cw_vtat(n,indv)(1:MNC_MAX_CHAR) =
756        n = mnc_cw_vnat(2,indv)       &       mnc_blank_name(1:MNC_MAX_CHAR)
757        n1 = IFNBLNK(iname)          mnc_cw_vtat(n,indv)(1:(n2-n1+1)) = tval(n1:n2)
758        n2 = ILNBLNK(iname)          mnc_cw_vnat(1,indv) = n
759        mnc_cw_vinm(n+1,indv)(1:(n2-n1+1)) = iname(n1:n2)        ENDIF
760        mnc_cw_viat(n+1,indv) = ival          
761        mnc_cw_vnat(2,indv) = n + 1        IF (atype .EQ. 2) THEN
762    C       Integer Attribute
763  C     Double Attributes          n = mnc_cw_vnat(2,indv) + 1
764        n = mnc_cw_vnat(3,indv)          n1 = IFNBLNK(iname)
765        n1 = IFNBLNK(dname)          n2 = ILNBLNK(iname)
766        n2 = ILNBLNK(dname)  C       write(*,*) atype,iname(n1:n2)
767        mnc_cw_vdnm(n+1,indv)(1:(n2-n1+1)) = dname(n1:n2)          mnc_cw_vinm(n,indv)(1:(n2-n1+1)) = iname(n1:n2)
768        mnc_cw_vdat(n+1,indv) = dval          mnc_cw_viat(n,indv) = ival
769        mnc_cw_vnat(3,indv) = n + 1          mnc_cw_vnat(2,indv) = n
770          ENDIF
771    
772          IF (atype .EQ. 3) THEN
773    C       Double Attribute
774            n = mnc_cw_vnat(3,indv) + 1
775            n1 = IFNBLNK(dname)
776            n2 = ILNBLNK(dname)
777    C       write(*,*) atype,dname(n1:n2)
778            mnc_cw_vdnm(n,indv)(1:(n2-n1+1)) = dname(n1:n2)
779            mnc_cw_vdat(n,indv) = dval
780            mnc_cw_vnat(3,indv) = n
781          ENDIF
782                
783        RETURN        RETURN
784        END        END
Legend:
Removed from v.1.19  
changed lines
  Added in v.1.20
  ViewVC Help
Powered by ViewVC 1.1.22