/[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.13 by edhill, Mon Apr 5 06:01:07 2004 UTC revision 1.19 by edhill, Wed Sep 22 21:19:44 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(*), inds_beg(*), inds_end(*)        integer dlens(ndim), inds_beg(ndim), inds_end(ndim)
31        character*(*) dnames(*)        character*(*) dnames(ndim)
32  CEOP  CEOP
33    
34  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
# Line 70  C     Check that this name is not alread Line 70  C     Check that this name is not alread
70        END        END
71    
72  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
73    CBOP 0
74    C     !ROUTINE: MNC_CW_DEL_GNAME
75    
76    C     !INTERFACE:
77          SUBROUTINE MNC_CW_DEL_GNAME(
78         I     name,
79         I     myThid )
80    
81    C     !DESCRIPTION:
82    C     Delete a grid name from the MNC convenience wrapper layer.
83          
84    C     !USES:
85          implicit none
86    #include "mnc_common.h"
87    #include "EEPARAMS.h"
88    
89    C     !INPUT PARAMETERS:
90          integer myThid
91          character*(*) name
92    CEOP
93    
94    C     !LOCAL VARIABLES:
95          integer nnf,nnl, indg
96    
97    C     Functions
98          integer IFNBLNK, ILNBLNK
99    
100          nnf = IFNBLNK(name)
101          nnl = ILNBLNK(name)
102    
103    C     Check that this name is not already defined
104          CALL MNC_GET_IND(MNC_MAX_ID, name, mnc_cw_gname, indg, myThid)
105          IF (indg .LT. 1) THEN
106            RETURN
107          ENDIF
108    
109          mnc_cw_gname(indg)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
110          mnc_cw_ndim(indg) = 0
111    
112          RETURN
113          END
114    
115    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
116  CBOP 1  CBOP 1
117  C     !ROUTINE: MNC_CW_DUMP  C     !ROUTINE: MNC_CW_DUMP
118    
# Line 115  C     !LOCAL VARIABLES: Line 158  C     !LOCAL VARIABLES:
158                        
159            ntot = ntot + 1            ntot = ntot + 1
160            s1(1:NBLNK) = blnk(1:NBLNK)            s1(1:NBLNK) = blnk(1:NBLNK)
161            write(s1,'(a5,2i5,a3,a20,i3,a3,5i4,a4,5i4,a4,5i4,6a4)')            write(s1,'(a5,2i5,a3,a20,i3,a3,5i4,a4,5i4,a4,5i4,6a8)')
162       &         'MNC: ',       &         'MNC: ',
163       &         j, ntot, ' : ', mnc_cw_gname(j)(1:20), mnc_cw_ndim(j),       &         j, ntot, ' : ', mnc_cw_gname(j)(1:20), mnc_cw_ndim(j),
164       &         ' : ', (mnc_cw_dims(i,j), i=1,5),       &         ' : ', (mnc_cw_dims(i,j), i=1,5),
165       &         '  | ', (mnc_cw_is(i,j), i=1,5),       &         '  | ', (mnc_cw_is(i,j), i=1,5),
166       &         '  | ', (mnc_cw_ie(i,j), i=1,5),       &         '  | ', (mnc_cw_ie(i,j), i=1,5),
167       &         '  | ', (mnc_cw_dn(i,j)(1:4), i=1,5)       &         '  | ', (mnc_cw_dn(i,j)(1:7), i=1,5)
168            CALL PRINT_MESSAGE(            CALL PRINT_MESSAGE(
169       &         s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)       &         s1, standardMessageUnit, SQUEEZE_RIGHT, mythid)
170                        
# Line 236  C     !LOCAL VARIABLES: Line 279  C     !LOCAL VARIABLES:
279        integer CW_MAX_LOC        integer CW_MAX_LOC
280        parameter ( CW_MAX_LOC = 5 )        parameter ( CW_MAX_LOC = 5 )
281        integer i, ihorz,ihsub,ivert,itime,ihalo, is,ih, n,ntot        integer i, ihorz,ihsub,ivert,itime,ihalo, is,ih, n,ntot
282        integer ndim, ncomb        integer ndim, ncomb, nvch
       character*(MAX_LEN_MBUF) msgbuf  
283        character*(MNC_MAX_CHAR) name        character*(MNC_MAX_CHAR) name
284        character*(MNC_MAX_CHAR) dn(CW_MAX_LOC)        character*(MNC_MAX_CHAR) dn(CW_MAX_LOC)
285        character*(5) horz_dat(CW_MAX_LOC), hsub_dat(CW_MAX_LOC),        character*(5) horz_dat(CW_MAX_LOC), hsub_dat(CW_MAX_LOC),
# Line 246  C     !LOCAL VARIABLES: Line 288  C     !LOCAL VARIABLES:
288        integer dim(CW_MAX_LOC), ib(CW_MAX_LOC), ie(CW_MAX_LOC)        integer dim(CW_MAX_LOC), ib(CW_MAX_LOC), ie(CW_MAX_LOC)
289    
290  C     Functions  C     Functions
291        integer IFNBLNK, ILNBLNK        integer ILNBLNK
292          external ILNBLNK
293    
294  C     ......12345....12345....12345....12345....12345...  C     ......12345....12345....12345....12345....12345...
295        data horz_dat /        data horz_dat /
# Line 290  C               horiz and hsub Line 333  C               horiz and hsub
333                  name((ntot+1):(ntot+n)) = hsub_dat(ihsub)(1:n)                  name((ntot+1):(ntot+n)) = hsub_dat(ihsub)(1:n)
334                  ntot = ntot + n                  ntot = ntot + n
335    
336  C               vert, time, and halo  C               halo, vert, and time
337                  write(name((ntot+1):(ntot+9)), '(a1,2a2,a1,a2,a1)')                  write(name((ntot+1):(ntot+5)), '(a1,2a2)')
338       &               '_', halo_dat(ihalo)(1:2), '__',       &               '_', halo_dat(ihalo)(1:2), '__'
339       &               vert_dat(ivert)(1:1), '__',                  nvch = ILNBLNK(vert_dat(ivert))
340       &               time_dat(itime)(1:1)                  n = ntot+6+nvch-1
341                    name((ntot+6):(n)) = vert_dat(ivert)(1:nvch)
342                    write(name((n+1):(n+3)), '(a2,a1)')
343         &               '__', time_dat(itime)(1:1)
344    
345                  ndim = 0                  ndim = 0
346                  DO i = 1,CW_MAX_LOC                  DO i = 1,CW_MAX_LOC
# Line 524  C     Check that gname exists Line 570  C     Check that gname exists
570        mnc_cw_vbij(1,indv) = bi_dim        mnc_cw_vbij(1,indv) = bi_dim
571        mnc_cw_vbij(2,indv) = bj_dim        mnc_cw_vbij(2,indv) = bj_dim
572    
573    #ifdef MNC_DEBUG_GTYPE
574        CALL MNC_CW_ADD_VATTR_TEXT(vname,1,'mitgcm_grid',gname, myThid)        CALL MNC_CW_ADD_VATTR_TEXT(vname,1,'mitgcm_grid',gname, myThid)
575    #endif
576    
577          RETURN
578          END
579    
580    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
581    CBOP 0
582    C     !ROUTINE: MNC_CW_DEL_VNAME
583    
584    C     !INTERFACE:
585          SUBROUTINE MNC_CW_DEL_VNAME(
586         I     vname,
587         I     myThid )
588    
589    C     !DESCRIPTION:
590    C     Delete a variable type from the MNC CW layer.
591      
592    C     !USES:
593          implicit none
594    #include "mnc_common.h"
595    #include "EEPARAMS.h"
596    
597    C     !INPUT PARAMETERS:
598          integer myThid
599          character*(*) vname
600    CEOP
601    
602    C     !LOCAL VARIABLES:
603          integer i, indv
604    
605    C     Check that this vname is not already defined
606          CALL MNC_GET_IND(MNC_MAX_ID, vname, mnc_cw_vname, indv, myThid)
607          IF (indv .LT. 1) THEN
608            RETURN
609          ENDIF
610    
611          mnc_cw_vname(indv)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
612          mnc_cw_vgind(indv) = 0
613          DO i = 1,3
614            mnc_cw_vnat(i,indv) = 0
615          ENDDO
616    
617        RETURN        RETURN
618        END        END
# Line 536  C     !ROUTINE: MNC_CW_ADD_VATTR_TEXT Line 624  C     !ROUTINE: MNC_CW_ADD_VATTR_TEXT
624  C     !INTERFACE:  C     !INTERFACE:
625        SUBROUTINE MNC_CW_ADD_VATTR_TEXT(        SUBROUTINE MNC_CW_ADD_VATTR_TEXT(
626       I     vname,       I     vname,
627       I     ntat,       I     tname,
628       I     tnames,       I     tval,
      I     tvals,  
629       I     myThid )       I     myThid )
630    
631  C     !DESCRIPTION:  C     !DESCRIPTION:
# Line 548  C     !USES: Line 635  C     !USES:
635        implicit none        implicit none
636    
637  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
638        integer myThid, ntat        integer myThid
639        character*(*) vname, tnames(*), tvals(*)        character*(*) vname, tname, tval
640  CEOP  CEOP
641    
642        CALL MNC_CW_ADD_VATTR_ANY(vname,        CALL MNC_CW_ADD_VATTR_ANY(vname,
643       &     ntat, 0, 0,       &     tname, ' ', ' ',
644       &     tnames, ' ', ' ',       &     tval, 0, 0.0D0, myThid )
      &     tvals, 0, 0.0D0, myThid )  
645    
646        RETURN        RETURN
647        END        END
# Line 567  C     !ROUTINE: MNC_CW_ADD_VATTR_INT Line 653  C     !ROUTINE: MNC_CW_ADD_VATTR_INT
653  C     !INTERFACE:  C     !INTERFACE:
654        SUBROUTINE MNC_CW_ADD_VATTR_INT(        SUBROUTINE MNC_CW_ADD_VATTR_INT(
655       I     vname,       I     vname,
656       I     niat,       I     iname,
657       I     inames,       I     ival,
      I     ivals,  
658       I     myThid )       I     myThid )
659    
660  C     !DESCRIPTION:  C     !DESCRIPTION:
# Line 578  C     !USES: Line 663  C     !USES:
663        implicit none        implicit none
664    
665  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
666        integer myThid, niat        integer myThid
667        character*(*) vname, inames(*)        character*(*) vname, iname
668        integer ivals(*)        integer ival
669  CEOP  CEOP
670    
671        CALL MNC_CW_ADD_VATTR_ANY(vname,        CALL MNC_CW_ADD_VATTR_ANY(vname,
672       &     0, niat, 0,       &     ' ', iname, ' ',
673       &     ' ', inames, ' ',       &     ' ', ival, 0.0D0, myThid )
      &     ' ', ivals, 0.0D0, myThid )  
674    
675        RETURN        RETURN
676        END        END
# Line 598  C !ROUTINE: MNC_CW_ADD_VATTR_DBL Line 682  C !ROUTINE: MNC_CW_ADD_VATTR_DBL
682  C !INTERFACE:  C !INTERFACE:
683        SUBROUTINE MNC_CW_ADD_VATTR_DBL(        SUBROUTINE MNC_CW_ADD_VATTR_DBL(
684       I     vname,       I     vname,
685       I     ndat,       I     dname,
686       I     dnames,       I     dval,
      I     dvals,  
687       I     myThid )       I     myThid )
688    
689  C     !DESCRIPTION:  C     !DESCRIPTION:
# Line 609  C     !USES: Line 692  C     !USES:
692        implicit none        implicit none
693    
694  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
695        integer myThid, ndat        integer myThid
696        character*(*) vname, dnames(*)        character*(*) vname, dname
697        REAL*8 dvals(*)        REAL*8 dval
698  CEOP  CEOP
699    
700        CALL MNC_CW_ADD_VATTR_ANY(vname,        CALL MNC_CW_ADD_VATTR_ANY(vname,
701       &     0, 0, ndat,       &     ' ', ' ', dname,
702       &     ' ', ' ', dnames,       &     ' ', 0, dval, myThid )
      &     ' ', 0, dvals, myThid )  
703    
704        RETURN        RETURN
705        END        END
# Line 629  C     !ROUTINE: MNC_CW_ADD_VATTR_ANY Line 711  C     !ROUTINE: MNC_CW_ADD_VATTR_ANY
711  C     !INTERFACE:  C     !INTERFACE:
712        SUBROUTINE MNC_CW_ADD_VATTR_ANY(        SUBROUTINE MNC_CW_ADD_VATTR_ANY(
713       I     vname,       I     vname,
714       I     ntat,   niat,   ndat,       I     tname, iname, dname,
715       I     tnames, inames, dnames,       I     tval,  ival,  dval,
      I     tvals,  ivals,  dvals,  
716       I     myThid )       I     myThid )
717    
718  C     !DESCRIPTION:  C     !DESCRIPTION:
# Line 642  C     !USES: Line 723  C     !USES:
723  #include "EEPARAMS.h"  #include "EEPARAMS.h"
724    
725  C     !INPUT PARAMETERS:  C     !INPUT PARAMETERS:
726        integer myThid, ntat, niat, ndat        integer myThid
727        character*(*) vname        character*(*) vname
728        character*(*) tnames(*), inames(*), dnames(*)        character*(*) tname, iname, dname
729        character*(*) tvals(*)        character*(*) tval
730        integer ivals(*)        integer ival
731        REAL*8 dvals(*)        REAL*8 dval
732  CEOP  CEOP
733    
734  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
735        integer i, n, nvf,nvl, n1,n2, indv        integer n, nvf,nvl, n1,n2, indv
736        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
737    
738  C     Functions  C     Functions
# Line 671  C     Check that vname is defined Line 752  C     Check that vname is defined
752    
753  C     Text Attributes  C     Text Attributes
754        n = mnc_cw_vnat(1,indv)        n = mnc_cw_vnat(1,indv)
755        DO i = 1,ntat        n1 = IFNBLNK(tname)
756          n1 = IFNBLNK(tnames(i))        n2 = ILNBLNK(tname)
757          n2 = ILNBLNK(tnames(i))        mnc_cw_vtnm(n+1,indv)(1:MNC_MAX_CHAR) =
758          mnc_cw_vtnm(n+i,indv)(1:(n2-n1+1)) = tnames(i)(n1:n2)       &     mnc_blank_name(1:MNC_MAX_CHAR)
759          n1 = IFNBLNK(tvals(i))        mnc_cw_vtnm(n+1,indv)(1:(n2-n1+1)) = tname(n1:n2)
760          n2 = ILNBLNK(tvals(i))        n1 = IFNBLNK(tval)
761          mnc_cw_vtat(n+i,indv)(1:(n2-n1+1)) = tvals(i)(n1:n2)        n2 = ILNBLNK(tval)
762        ENDDO        mnc_cw_vtat(n+1,indv)(1:MNC_MAX_CHAR) =
763        mnc_cw_vnat(1,indv) = n + ntat       &       mnc_blank_name(1:MNC_MAX_CHAR)
764          mnc_cw_vtat(n+1,indv)(1:(n2-n1+1)) = tval(n1:n2)
765          mnc_cw_vnat(1,indv) = n + 1
766          
767  C     Integer Attributes  C     Integer Attributes
768        n = mnc_cw_vnat(2,indv)        n = mnc_cw_vnat(2,indv)
769        DO i = 1,niat        n1 = IFNBLNK(iname)
770          n1 = IFNBLNK(inames(i))        n2 = ILNBLNK(iname)
771          n2 = ILNBLNK(inames(i))        mnc_cw_vinm(n+1,indv)(1:(n2-n1+1)) = iname(n1:n2)
772          mnc_cw_vinm(n+i,indv)(1:(n2-n1+1)) = inames(i)(n1:n2)        mnc_cw_viat(n+1,indv) = ival
773          mnc_cw_viat(n+i,indv) = ivals(i)        mnc_cw_vnat(2,indv) = n + 1
       ENDDO  
       mnc_cw_vnat(2,indv) = n + niat  
774    
775  C     Double Attributes  C     Double Attributes
776        n = mnc_cw_vnat(3,indv)        n = mnc_cw_vnat(3,indv)
777        DO i = 1,ndat        n1 = IFNBLNK(dname)
778          n1 = IFNBLNK(dnames(i))        n2 = ILNBLNK(dname)
779          n2 = ILNBLNK(dnames(i))        mnc_cw_vdnm(n+1,indv)(1:(n2-n1+1)) = dname(n1:n2)
780          mnc_cw_vdnm(n+i,indv)(1:(n2-n1+1)) = dnames(i)(n1:n2)        mnc_cw_vdat(n+1,indv) = dval
781          mnc_cw_vdat(n+i,indv) = dvals(i)        mnc_cw_vnat(3,indv) = n + 1
782        ENDDO        
       mnc_cw_vnat(3,indv) = n + ndat  
   
783        RETURN        RETURN
784        END        END
785    
# Line 780  C     !INPUT PARAMETERS: Line 859  C     !INPUT PARAMETERS:
859  CEOP  CEOP
860    
861  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
862        integer i, ierr        integer ierr
       character*(MAX_LEN_MBUF) msgbuf  
863    
864  C     Check if the file is already open  C     Check if the file is already open
865        CALL MNC_GET_IND(MNC_MAX_ID, fname, mnc_f_names, indf, myThid)        CALL MNC_GET_IND(MNC_MAX_ID, fname, mnc_f_names, indf, myThid)
Legend:
Removed from v.1.13  
changed lines
  Added in v.1.19
  ViewVC Help
Powered by ViewVC 1.1.22