/[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.2 by edhill, Thu Jan 29 05:30:37 2004 UTC revision 1.3 by edhill, Sat Jan 31 04:13:09 2004 UTC
# Line 5  C $Name$ Line 5  C $Name$
5                
6  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7    
 C       SUBROUTINE MNC_CW_W_RL(  
 C      I     myThid, myIter,  
 C      I     filebn,  
 C      I     bi,bj,  
 C      I     Gtype,  
 C      I     Rtype,  
 C      I     vname,  
 C      I     var )  
   
 C       implicit none  
 C #include "netcdf.inc"  
 C #include "mnc_common.h"  
 C #include "EEPARAMS.h"  
   
 C C     Arguments  
 C       integer myThid, myIter, bi,bj  
 C       character*(*) filebn, Gtype  
 C       character*(2) Rtype  
 C       _RL var*(*)  
   
         
   
 C       RETURN  
 C       END  
   
 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  
   
8        SUBROUTINE MNC_CW_ADD_GNAME(        SUBROUTINE MNC_CW_ADD_GNAME(
9       I     myThid,       I     myThid,
10       I     name,       I     name,
# Line 98  C---+----1----+----2----+----3----+----4 Line 71  C---+----1----+----2----+----3----+----4
71  C     Local Variables  C     Local Variables
72        integer i,j, ntot        integer i,j, ntot
73    
74          write(*,'(a)') 'The currently defined Grid Types are:'
75        ntot = 0        ntot = 0
76        DO j = 1,MNC_MAX_ID        DO j = 1,MNC_MAX_ID
77          IF (mnc_cw_gname(j)(1:MNC_MAX_CHAR)          IF (mnc_cw_gname(j)(1:MNC_MAX_CHAR)
# Line 110  C     Local Variables Line 84  C     Local Variables
84       &         '  | ', (mnc_cw_is(i,j), i=1,5),       &         '  | ', (mnc_cw_is(i,j), i=1,5),
85       &         '  | ', (mnc_cw_ie(i,j), i=1,5),       &         '  | ', (mnc_cw_ie(i,j), i=1,5),
86       &         '  | ', (mnc_cw_dn(i,j)(1:4), i=1,5)       &         '  | ', (mnc_cw_dn(i,j)(1:4), i=1,5)
             
87    
88          ENDIF          ENDIF
89        ENDDO        ENDDO
90    
91          write(*,'(a)') 'The currently defined Variable Types are:'
92          ntot = 0
93          DO j = 1,MNC_MAX_ID
94            IF (mnc_cw_vname(j)(1:MNC_MAX_CHAR)
95         &       .NE. mnc_blank_name(1:MNC_MAX_CHAR)) THEN
96    
97              ntot = ntot + 1
98              write(*,'(2i5,a3,a25,a3,i4)') j, ntot, ' : ',
99         &         mnc_cw_vname(j)(1:20), ' : ', mnc_cw_vgind(j)
100    
101              DO i = 1,mnc_cw_vnat(1,j)
102                write(*,'(a14,i4,a3,a25,a3,a25)') '      text_at:',i,
103         &           ' : ', mnc_cw_vtnm(i,j)(1:25), ' : ',
104         &           mnc_cw_vtat(i,j)(1:25)
105              ENDDO
106              DO i = 1,mnc_cw_vnat(2,j)
107                write(*,'(a14,i4,a3,a25,a3,i20)') '      int__at:',i,
108         &           ' : ', mnc_cw_vinm(i,j)(1:25), ' : ',
109         &           mnc_cw_viat(i,j)
110              ENDDO
111              DO i = 1,mnc_cw_vnat(3,j)
112                write(*,'(a14,i4,a3,a25,a3,f25.10)') '      dbl__at:',i,
113         &           ' : ', mnc_cw_vdnm(i,j)(1:25), ' : ',
114         &           mnc_cw_vdat(i,j)
115              ENDDO
116    
117            ENDIF
118          ENDDO
119          IF (ntot .EQ. 0) THEN
120            write(*,'(a)') '   None defined!'
121          ENDIF
122    
123    
124        RETURN        RETURN
125        END        END
126    
# Line 360  C     Check that gname exists Line 366  C     Check that gname exists
366          CALL print_error(msgbuf, mythid)          CALL print_error(msgbuf, mythid)
367          stop 'ABNORMAL END: S/R MNC_CW_ADD_VNAME'          stop 'ABNORMAL END: S/R MNC_CW_ADD_VNAME'
368        ENDIF        ENDIF
       CALL MNC_GET_NEXT_EMPTY_IND(myThid, MNC_MAX_ID, mnc_cw_gname,  
      &     indg)  
369    
370        mnc_cw_vname(indv)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)        mnc_cw_vname(indv)(1:MNC_MAX_CHAR)=mnc_blank_name(1:MNC_MAX_CHAR)
371        mnc_cw_vname(indv)(1:(nvl-nvf+1)) = vname(nvf:nvl)        mnc_cw_vname(indv)(1:(nvl-nvf+1)) = vname(nvf:nvl)
# Line 375  C     Check that gname exists Line 379  C     Check that gname exists
379    
380  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
381    
382          SUBROUTINE MNC_CW_ADD_VATTR_TEXT(
383         I     myThid,
384         I     vname,
385         I     ntat,
386         I     tnames,
387         I     tvals )
388    
389          implicit none
390    
391    C     Arguments
392          integer myThid, ntat
393          character*(*) vname, tnames(*), tvals(*)
394    
395          CALL MNC_CW_ADD_VATTR_ANY(myThid, vname,
396         &     ntat, 0, 0,
397         &     tnames, ' ', ' ',
398         &     tvals, 0, 0.0D0 )
399    
400          RETURN
401          END
402    
403    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
404    
405          SUBROUTINE MNC_CW_ADD_VATTR_INT(
406         I     myThid,
407         I     vname,
408         I     niat,
409         I     inames,
410         I     ivals )
411    
412          implicit none
413    
414    C     Arguments
415          integer myThid, niat
416          character*(*) vname, inames(*)
417          integer ivals(*)
418    
419          CALL MNC_CW_ADD_VATTR_ANY(myThid, vname,
420         &     0, niat, 0,
421         &     ' ', inames, ' ',
422         &     ' ', ivals, 0.0D0 )
423    
424          RETURN
425          END
426    
427    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
428    
429          SUBROUTINE MNC_CW_ADD_VATTR_DBL(
430         I     myThid,
431         I     vname,
432         I     ndat,
433         I     dnames,
434         I     dvals )
435    
436          implicit none
437    
438    C     Arguments
439          integer myThid, ndat
440          character*(*) vname, dnames(*)
441          REAL*8 dvals(*)
442    
443          CALL MNC_CW_ADD_VATTR_ANY(myThid, vname,
444         &     0, 0, ndat,
445         &     ' ', ' ', dnames,
446         &     ' ', 0, dvals )
447    
448          RETURN
449          END
450    
451    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
452    
453        SUBROUTINE MNC_CW_ADD_VATTR_ANY(        SUBROUTINE MNC_CW_ADD_VATTR_ANY(
454       I     myThid,       I     myThid,
455       I     vname,       I     vname,
# Line 447  C     Double Attributes Line 522  C     Double Attributes
522    
523        RETURN        RETURN
524        END        END
525    
526    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
527    
528          SUBROUTINE MNC_CW_GET_TILE_NUM(
529         I     myThid,
530         I     bi, bj,
531         O     uniq_tnum )
532    
533          implicit none
534    #include "EEPARAMS.h"
535    #include "SIZE.h"
536    
537    C     Arguments
538          integer myThid, bi,bj, uniq_tnum
539    
540    C     Local Variables
541          integer iG,jG
542    
543    #ifdef ALLOW_EXCH2
544    
545    #include "W2_EXCH2_PARAMS.h"
546          uniq_tnum = W2_myTileList(bi)
547    
548    #else
549    
550    C     Global tile number for simple (non-cube) domains
551          iG = bi+(myXGlobalLo-1)/sNx
552          jG = bj+(myYGlobalLo-1)/sNy
553    C     .          full rows                partial rows
554          uniq_tnum = (jG - 1)*nPx*(nSx*nSy) + (iG - 1)*(nSx*nSy)
555    
556    #endif
557    
558          RETURN
559          END
560    
561    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
562    
563          SUBROUTINE MNC_CW_FILE_AORC(
564         I     myThid,
565         I     fname )
566    
567          implicit none
568    #include "netcdf.inc"
569    #include "mnc_common.h"
570    #include "EEPARAMS.h"
571    
572    C     Arguments
573          integer myThid
574          character*(*) fname
575    
576    C     Local Variables
577          integer i, ierr, indf
578          character*(MAX_LEN_MBUF) msgbuf
579    
580    C     Check if the file is already open
581          CALL MNC_GET_IND(myThid, MNC_MAX_ID, fname, mnc_f_names, indf)
582          IF (indf .GT. 0) THEN
583            RETURN
584          ENDIF
585    
586    C     Try to open an existing file
587          CALL MNC_FILE_TRY_READ(myThid, fname, ierr)
588          IF (ierr .EQ. NF_NOERR) THEN
589            RETURN
590          ENDIF
591    
592    C     Try to create a new one
593          
594    
595          RETURN
596          END
597    
598  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
599    
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3
  ViewVC Help
Powered by ViewVC 1.1.22