/[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.1 by edhill, Tue Jan 27 05:47:32 2004 UTC revision 1.2 by edhill, Thu Jan 29 05:30:37 2004 UTC
# Line 32  C       END Line 32  C       END
32    
33  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
34    
35        SUBROUTINE MNC_CW_ADD_NAME(        SUBROUTINE MNC_CW_ADD_GNAME(
36       I     myThid,       I     myThid,
37       I     name,       I     name,
38       I     ndim,       I     ndim,
# Line 44  C---+----1----+----2----+----3----+----4 Line 44  C---+----1----+----2----+----3----+----4
44  #include "mnc_common.h"  #include "mnc_common.h"
45  #include "EEPARAMS.h"  #include "EEPARAMS.h"
46    
 C     Functions  
       integer IFNBLNK, ILNBLNK  
   
47  C     Arguments  C     Arguments
48        integer myThid, ndim        integer myThid, ndim
49        character*(*) name        character*(*) name
50        integer dlens(*), inds_beg(*), inds_end(*)        integer dlens(*), inds_beg(*), inds_end(*)
51        character*(*) dnames(*)        character*(*) dnames(*)
52    
53    C     Functions
54          integer IFNBLNK, ILNBLNK
55    
56  C     Local Variables  C     Local Variables
57        integer i, nnf,nnl, indg        integer i, nnf,nnl, indg
58        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
# Line 61  C     Local Variables Line 61  C     Local Variables
61        nnl = ILNBLNK(name)        nnl = ILNBLNK(name)
62    
63  C     Check that this name is not already defined  C     Check that this name is not already defined
64        CALL MNC_GET_IND(myThid, MNC_MAX_ID, name, mnc_cw_names, indg)        CALL MNC_GET_IND(myThid, MNC_MAX_ID, name, mnc_cw_gname, indg)
65        IF (indg .GT. 0) THEN        IF (indg .GT. 0) THEN
66          write(msgbuf,'(3a)') 'MNC_CW_ADD_NAME ERROR: ''', name,          write(msgbuf,'(3a)') 'MNC_CW_ADD_GNAME ERROR: ''', name,
67       &       ''' is already defined'       &       ''' is already defined'
68          CALL print_error(msgbuf, mythid)          CALL print_error(msgbuf, mythid)
69          stop 'ABNORMAL END: S/R MNC_CW_ADD_NAME'          stop 'ABNORMAL END: S/R MNC_CW_ADD_GNAME'
70        ENDIF        ENDIF
71        CALL MNC_GET_NEXT_EMPTY_IND(myThid, MNC_MAX_ID, mnc_cw_names,        CALL MNC_GET_NEXT_EMPTY_IND(myThid, MNC_MAX_ID, mnc_cw_gname,
72       &     indg)       &     indg)
73    
74        mnc_cw_names(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)
75        mnc_cw_names(indg)(1:(nnl-nnf+1)) = name(nnf:nnl)        mnc_cw_gname(indg)(1:(nnl-nnf+1)) = name(nnf:nnl)
76        mnc_cw_ndim(indg) = ndim        mnc_cw_ndim(indg) = ndim
77    
78        DO i = 1,ndim        DO i = 1,ndim
# Line 88  C     Check that this name is not alread Line 88  C     Check that this name is not alread
88        RETURN        RETURN
89        END        END
90    
91    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
92    
93          SUBROUTINE MNC_CW_DUMP()
94    
95          implicit none
96    #include "mnc_common.h"
97    
98    C     Local Variables
99          integer i,j, ntot
100    
101          ntot = 0
102          DO j = 1,MNC_MAX_ID
103            IF (mnc_cw_gname(j)(1:MNC_MAX_CHAR)
104         &       .NE. mnc_blank_name(1:MNC_MAX_CHAR)) THEN
105              
106              ntot = ntot + 1
107              write(*,'(2i5,a3,a20,i3,a3,5i4,a4,5i4,a4,5i4,6a4)')
108         &         j, ntot, ' : ', mnc_cw_gname(j)(1:20), mnc_cw_ndim(j),
109         &         ' : ', (mnc_cw_dims(i,j), i=1,5),
110         &         '  | ', (mnc_cw_is(i,j), i=1,5),
111         &         '  | ', (mnc_cw_ie(i,j), i=1,5),
112         &         '  | ', (mnc_cw_dn(i,j)(1:4), i=1,5)
113              
114    
115            ENDIF
116          ENDDO
117    
118          RETURN
119          END
120    
121  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
122    
# Line 109  C     Functions Line 138  C     Functions
138  C     Local Variables  C     Local Variables
139        integer CW_MAX_LOC        integer CW_MAX_LOC
140        parameter ( CW_MAX_LOC = 5 )        parameter ( CW_MAX_LOC = 5 )
141        integer i, ihorz,ihsub,ivert,itime,ihalo, is, n,ntot        integer i, ihorz,ihsub,ivert,itime,ihalo, is,ih, n,ntot
142        integer ndim        integer ndim, ncomb
143        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
144        character*(MNC_MAX_CHAR) name        character*(MNC_MAX_CHAR) name
145        character*(MNC_MAX_CHAR) dn(CW_MAX_LOC)        character*(MNC_MAX_CHAR) dn(CW_MAX_LOC)
# Line 124  C     ......12345....12345....12345....1 Line 153  C     ......12345....12345....12345....1
153       &     '-    ', 'U    ', 'V    ', 'Cen  ', 'Cor  '  /       &     '-    ', 'U    ', 'V    ', 'Cen  ', 'Cor  '  /
154        data hsub_dat /        data hsub_dat /
155       &     'xy   ', 'x    ', 'y    ', '-    ', '     '  /       &     'xy   ', 'x    ', 'y    ', '-    ', '     '  /
156          data halo_dat /
157         &     'Hn   ', 'Hy   ', '--   ', '     ', '     '  /
158        data vert_dat /        data vert_dat /
159       &     '-    ', 'C    ', 'I    ', '     ', '     '  /       &     '-    ', 'C    ', 'I    ', '     ', '     '  /
160        data time_dat /        data time_dat /
161       &     '-    ', 't    ', '     ', '     ', '     '  /       &     '-    ', 't    ', '     ', '     ', '     '  /
       data halo_dat /  
      &     'Hn   ', 'Hy   ', '     ', '     ', '     '  /  
   
162    
163          ncomb = 0
164        DO ihorz = 1,5        DO ihorz = 1,5
165          DO is = 1,3          DO is = 1,3
166              DO ih = 1,2
167  C         Loop just ONCE if the Horiz component is "-"              
168            ihsub = is  C           Loop just ONCE if the Horiz component is "-"
169            IF (ihorz .EQ. 1) THEN              ihsub = is
170              IF (is .EQ. 1) THEN              ihalo = ih
171                ihsub = 4              IF (ihorz .EQ. 1) THEN
172              ELSE                IF ((is .EQ. 1) .AND. (ih .EQ. 1)) THEN
173                GOTO 10                  ihsub = 4
174                    ihalo = 3
175                  ELSE
176                    GOTO 10
177                  ENDIF
178              ENDIF              ENDIF
179            ENDIF              
180                DO ivert = 1,3
181            DO ivert = 1,3                DO itime = 1,2
182              DO itime = 1,2                  
               DO ihalo = 1,2  
   
183  C               horiz and hsub  C               horiz and hsub
184                  name(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)                  name(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)
185                  n = ILNBLNK(horz_dat(ihorz))                  n = ILNBLNK(horz_dat(ihorz))
# Line 160  C               horiz and hsub Line 191  C               horiz and hsub
191                  ntot = ntot + n                  ntot = ntot + n
192    
193  C               vert, time, and halo  C               vert, time, and halo
194                  write(name((ntot+1):(ntot+7)), '(5a1,a2)') '_',                  write(name((ntot+1):(ntot+9)), '(a1,2a2,a1,a2,a1)')
195       &               vert_dat(ivert)(1:1), '_',       &               '_', halo_dat(ihalo)(1:2), '__',
196       &               time_dat(itime)(1:1), '_',       &               vert_dat(ivert)(1:1), '__',
197       &               halo_dat(ihalo)(1:2)       &               time_dat(itime)(1:1)
198    
199                  ndim = 0                  ndim = 0
200                  DO i = 1,CW_MAX_LOC                  DO i = 1,CW_MAX_LOC
201                    dn(i)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)                    dn(i)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
202                    dim(i) = 0                    dim(i) = 0
203                      ib(i) = 0
204                      ie(i) = 0
205                  ENDDO                  ENDDO
206    
207  C               Horizontal dimensions  C               Horizontal dimensions
# Line 225  C               Horizontal dimensions Line 258  C               Horizontal dimensions
258                      dn(ndim)(1:3) = 'Ywh'                      dn(ndim)(1:3) = 'Ywh'
259                      dim(ndim) = sNy + 2*OLy                      dim(ndim) = sNy + 2*OLy
260                      ib(ndim)  = 1                      ib(ndim)  = 1
261                      ie(ndim)  = sNx + 2*OLx                      ie(ndim)  = sNy + 2*OLy
262                    ENDIF                    ENDIF
263    
264                  ENDIF                  ENDIF
# Line 255  C               Time dimension Line 288  C               Time dimension
288                    ie(ndim)  = 1                    ie(ndim)  = 1
289                  ENDIF                  ENDIF
290    
                 write(*,*) name(1:15), ndim, ' : ', (dim(i), i=1,5)  
   
291                  IF (ndim .GT. 0) THEN                  IF (ndim .GT. 0) THEN
292                    CALL MNC_CW_ADD_NAME(myThid, name, ndim,  #ifdef MNC_DEBUG
293                      ncomb = ncomb + 1
294                      write(*,'(i4,a3,a15,i3,a3,5i4,a4,5i4,a4,5i4,6a4)')
295         &                 ncomb, ' : ', name(1:15), ndim,
296         &                 ' : ', (dim(i), i=1,5),
297         &                 '  | ', (ib(i), i=1,5),
298         &                 '  | ', (ie(i), i=1,5),
299         &                 '  | ', (dn(i)(1:4), i=1,5)
300    #endif
301    
302                      CALL MNC_CW_ADD_GNAME(myThid, name, ndim,
303       &                 dim, dn, ib, ie)       &                 dim, dn, ib, ie)
304                  ENDIF                  ENDIF
305    
306                ENDDO                ENDDO
307              ENDDO              ENDDO
           ENDDO  
308    
309   10       CONTINUE   10         CONTINUE
310              ENDDO
311          ENDDO          ENDDO
312        ENDDO        ENDDO
313                
314        RETURN        RETURN
315        END        END
316    
317    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
318    
319          SUBROUTINE MNC_CW_ADD_VNAME(
320         I     myThid,
321         I     vname,
322         I     gname )
323    
324          implicit none
325    #include "mnc_common.h"
326    #include "EEPARAMS.h"
327    
328    C     Arguments
329          integer myThid
330          character*(*) vname, gname
331    
332    C     Functions
333          integer IFNBLNK, ILNBLNK
334    
335    C     Local Variables
336          integer i, nvf,nvl, ngf,ngl, indv,indg
337          character*(MAX_LEN_MBUF) msgbuf
338    
339          nvf = IFNBLNK(vname)
340          nvl = ILNBLNK(vname)
341          ngf = IFNBLNK(gname)
342          ngl = ILNBLNK(gname)
343    
344    C     Check that this vname is not already defined
345          CALL MNC_GET_IND(myThid, MNC_MAX_ID, vname, mnc_cw_vname, indv)
346          IF (indv .GT. 0) THEN
347            write(msgbuf,'(3a)') 'MNC_CW_ADD_VNAME ERROR: ''',
348         &       vname(nvf:nvl), ''' is already defined'
349            CALL print_error(msgbuf, mythid)
350            stop 'ABNORMAL END: S/R MNC_CW_ADD_VNAME'
351          ENDIF
352          CALL MNC_GET_NEXT_EMPTY_IND(myThid, MNC_MAX_ID, mnc_cw_vname,
353         &     indv)
354    
355    C     Check that gname exists
356          CALL MNC_GET_IND(myThid, MNC_MAX_ID, gname, mnc_cw_gname, indg)
357          IF (indg .LT. 1) THEN
358            write(msgbuf,'(3a)') 'MNC_CW_ADD_VNAME ERROR: ''',
359         &       gname(ngf:ngl), ''' is not defined'
360            CALL print_error(msgbuf, mythid)
361            stop 'ABNORMAL END: S/R MNC_CW_ADD_VNAME'
362          ENDIF
363          CALL MNC_GET_NEXT_EMPTY_IND(myThid, MNC_MAX_ID, mnc_cw_gname,
364         &     indg)
365    
366          mnc_cw_vname(indv)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
367          mnc_cw_vname(indv)(1:(nvl-nvf+1)) = vname(nvf:nvl)
368          mnc_cw_vgind(indv) = indg
369          DO i = 1,3
370            mnc_cw_vnat(i,indv) = 0
371          ENDDO
372    
373          RETURN
374          END
375    
376    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
377    
378          SUBROUTINE MNC_CW_ADD_VATTR_ANY(
379         I     myThid,
380         I     vname,
381         I     ntat,   niat,   ndat,
382         I     tnames, inames, dnames,
383         I     tvals,  ivals,  dvals )
384    
385          implicit none
386    #include "mnc_common.h"
387    #include "EEPARAMS.h"
388    
389    C     Arguments
390          integer myThid, ntat, niat, ndat
391          character*(*) vname
392          character*(*) tnames(*), inames(*), dnames(*)
393          character*(*) tvals(*)
394          integer ivals(*)
395          REAL*8 dvals(*)
396    
397    C     Functions
398          integer IFNBLNK, ILNBLNK
399    
400    C     Local Variables
401          integer i, n, nvf,nvl, n1,n2, indv
402          character*(MAX_LEN_MBUF) msgbuf
403    
404          nvf = IFNBLNK(vname)
405          nvl = ILNBLNK(vname)
406    
407    C     Check that vname is defined
408          CALL MNC_GET_IND(myThid, MNC_MAX_ID, vname, mnc_cw_vname, indv)
409          IF (indv .LT. 1) THEN
410            write(msgbuf,'(3a)') 'MNC_CW_ADD_VATTR_ANY ERROR: ''',
411         &       vname(nvf:nvl), ''' is not defined'
412            CALL print_error(msgbuf, mythid)
413            stop 'ABNORMAL END: S/R MNC_CW_ADD_VATTR_ANY'
414          ENDIF
415    
416    C     Text Attributes
417          n = mnc_cw_vnat(1,indv)
418          DO i = 1,ntat
419            n1 = IFNBLNK(tnames(i))
420            n2 = ILNBLNK(tnames(i))
421            mnc_cw_vtnm(n+i,indv)(1:(n2-n1+1)) = tnames(i)(n1:n2)
422            n1 = IFNBLNK(tvals(i))
423            n2 = ILNBLNK(tvals(i))
424            mnc_cw_vtat(n+i,indv)(1:(n2-n1+1)) = tvals(i)(n1:n2)
425          ENDDO
426          mnc_cw_vnat(1,indv) = n + ntat
427    
428    C     Integer Attributes
429          n = mnc_cw_vnat(2,indv)
430          DO i = 1,niat
431            n1 = IFNBLNK(inames(i))
432            n2 = ILNBLNK(inames(i))
433            mnc_cw_vinm(n+i,indv)(1:(n2-n1+1)) = inames(i)(n1:n2)
434            mnc_cw_viat(n+i,indv) = ivals(i)
435          ENDDO
436          mnc_cw_vnat(2,indv) = n + niat
437    
438    C     Double Attributes
439          n = mnc_cw_vnat(3,indv)
440          DO i = 1,ndat
441            n1 = IFNBLNK(dnames(i))
442            n2 = ILNBLNK(dnames(i))
443            mnc_cw_vdnm(n+i,indv)(1:(n2-n1+1)) = dnames(i)(n1:n2)
444            mnc_cw_vdat(n+i,indv) = dvals(i)
445          ENDDO
446          mnc_cw_vnat(3,indv) = n + ndat
447    
448          RETURN
449          END
450    
451  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
452    
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22