/[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.23 by edhill, Fri Dec 17 04:50:05 2004 UTC revision 1.30 by edhill, Wed Apr 5 21:07:36 2006 UTC
# Line 50  C     Check that this name is not alread Line 50  C     Check that this name is not alread
50          stop 'ABNORMAL END: S/R MNC_CW_ADD_GNAME'          stop 'ABNORMAL END: S/R MNC_CW_ADD_GNAME'
51        ENDIF        ENDIF
52        CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID, mnc_cw_gname,        CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID, mnc_cw_gname,
53       &     indg, myThid)       &     'mnc_cw_gname', indg, myThid)
54    
55        mnc_cw_gname(indg)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)        mnc_cw_gname(indg)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
56        mnc_cw_gname(indg)(1:(nnl-nnf+1)) = name(nnf:nnl)        mnc_cw_gname(indg)(1:(nnl-nnf+1)) = name(nnf:nnl)
# Line 194  C     !LOCAL VARIABLES: Line 194  C     !LOCAL VARIABLES:
194              write(s1,'(a5,a14,i4,a3,a25,a3,a55)')              write(s1,'(a5,a14,i4,a3,a25,a3,a55)')
195       &           'MNC: ','      text_at:',i,       &           'MNC: ','      text_at:',i,
196       &           ' : ', mnc_cw_vtnm(i,j)(1:25), ' : ',       &           ' : ', mnc_cw_vtnm(i,j)(1:25), ' : ',
197       &           mnc_cw_vtat(i,j)(1:55)       &           mnc_cw_vtat(i,j)(1:MNC_MAX_CHAR)
198              CALL PRINT_MESSAGE(              CALL PRINT_MESSAGE(
199       &           s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)       &           s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
200            ENDDO            ENDDO
# Line 321  C     Check that this vname is not alrea Line 321  C     Check that this vname is not alrea
321          stop 'ABNORMAL END: S/R MNC_CW_ADD_VNAME'          stop 'ABNORMAL END: S/R MNC_CW_ADD_VNAME'
322        ENDIF        ENDIF
323        CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID, mnc_cw_vname,        CALL MNC_GET_NEXT_EMPTY_IND(MNC_MAX_ID, mnc_cw_vname,
324       &     indv, myThid)       &     'mnc_cw_vname', indv, myThid)
325    
326  C     Check that gname exists  C     Check that gname exists
327        CALL MNC_GET_IND(MNC_MAX_ID, gname, mnc_cw_gname, indg, myThid)        CALL MNC_GET_IND(MNC_MAX_ID, gname, mnc_cw_gname, indg, myThid)
# 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 612  CEH3      write(*,*) 'iG,jG,uniq_tnum :' Line 632  CEH3      write(*,*) 'iG,jG,uniq_tnum :'
632    
633  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
634  CBOP 1  CBOP 1
635    C     !ROUTINE: MNC_CW_GET_FACE_NUM
636    
637    C     !INTERFACE:
638          SUBROUTINE MNC_CW_GET_FACE_NUM(
639         I     bi, bj,
640         O     uniq_fnum,
641         I     myThid )
642    
643    C     !DESCRIPTION:
644    
645    C     !USES:
646          implicit none
647    #include "EEPARAMS.h"
648    #include "SIZE.h"
649    #ifdef ALLOW_EXCH2
650    #include "W2_EXCH2_TOPOLOGY.h"
651    #include "W2_EXCH2_PARAMS.h"
652    #endif
653    
654    C     !INPUT PARAMETERS:
655          integer myThid, bi,bj, uniq_fnum
656    CEOP
657    
658    #ifdef ALLOW_EXCH2
659    
660          uniq_fnum = exch2_myFace( W2_myTileList(bi) )
661    
662    #else
663    
664    C     Global face number for simple (EXCH "1") domains
665          uniq_fnum = -1
666    
667    #endif
668    
669          RETURN
670          END
671    
672    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
673    CBOP 1
674    C     !ROUTINE: MNC_CW_GET_XYFO
675    
676    C     !INTERFACE:
677          SUBROUTINE MNC_CW_GET_XYFO(
678         I     bi, bj,
679         O     ixoff, iyoff,
680         I     myThid )
681    
682    C     !DESCRIPTION:
683    
684    C     !USES:
685          implicit none
686    #include "EEPARAMS.h"
687    #include "SIZE.h"
688    #ifdef ALLOW_EXCH2
689    #include "W2_EXCH2_TOPOLOGY.h"
690    #include "W2_EXCH2_PARAMS.h"
691    #endif
692    
693    C     !INPUT PARAMETERS:
694          integer myThid, bi,bj, ixoff,iyoff
695    CEOP
696    
697    C     !LOCAL VARIABLES:
698          integer uniq_tnum
699    
700    #ifdef ALLOW_EXCH2
701    
702          uniq_tnum = W2_myTileList(bi)
703          ixoff = exch2_tbasex( uniq_tnum )
704          iyoff = exch2_tbasey( uniq_tnum )
705    
706    #else
707    
708    C     Global tile number for simple (non-cube) domains
709    C     iG = bi+(myXGlobalLo-1)/sNx
710    C     jG = bj+(myYGlobalLo-1)/sNy
711    C     uniq_tnum = (jG - 1)*(nPx*nSx) + iG
712          ixoff = myXGlobalLo + bi * sNx
713          iyoff = myYGlobalLo + bj * sNy
714    
715    #endif
716    
717          RETURN
718          END
719    
720    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
721    CBOP 1
722  C     !ROUTINE: MNC_CW_FILE_AORC  C     !ROUTINE: MNC_CW_FILE_AORC
723                
724  C     !INTERFACE:  C     !INTERFACE:
# Line 640  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
# Line 659  C     Add the global attributes Line 766  C     Add the global attributes
766        END        END
767    
768  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
   

Legend:
Removed from v.1.23  
changed lines
  Added in v.1.30

  ViewVC Help
Powered by ViewVC 1.1.22