/[MITgcm]/MITgcm/pkg/mnc/mnc_dim.F
ViewVC logotype

Diff of /MITgcm/pkg/mnc/mnc_dim.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.2 by edhill, Sat Jan 17 13:55:49 2004 UTC revision 1.3 by edhill, Sun Jan 25 00:22:57 2004 UTC
# Line 9  C======================================= Line 9  C=======================================
9       I     myThid,       I     myThid,
10       I     fname,       I     fname,
11       I     dname,       I     dname,
      I     dunits,  
12       I     dlen )       I     dlen )
13    
14    C     Arguments
15          integer myThid, dlen
16          character*(*) fname, dname
17    
18          CALL MNC_DIM_INIT_ALL(myThid, fname, dname, dlen, 'Y')
19    
20          RETURN
21          END
22    
23    
24    C==================================================================
25    
26          SUBROUTINE MNC_DIM_INIT_ALL(
27         I     myThid,
28         I     fname,
29         I     dname,
30         I     dlen,
31         I     doWrite )
32    
33        implicit none        implicit none
34    #include "netcdf.inc"
35  #include "mnc_common.h"  #include "mnc_common.h"
36  #include "EEPARAMS.h"  #include "EEPARAMS.h"
37    
38  C     Arguments  C     Arguments
39        integer myThid        integer myThid, dlen
40        character*(*) fname, dname, dunits        character*(*) fname, dname
41        integer dlen        character*(1) doWrite
42    
43  C     Functions  C     Functions
44        integer ILNBLNK        integer ILNBLNK, IFNBLNK
45    
46  C     Local Variables  C     Local Variables
47        integer i,j, indf,indd, n,nf,ndn,ndu        integer i,j, indf,indd, n,nf, dnf,dnl, ntmp, idd, err, tlen
48        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
49    
50        nf = ILNBLNK(fname)        nf = ILNBLNK(fname)
51        ndn = ILNBLNK(dname)  
52        ndu = ILNBLNK(dunits)        dnf = IFNBLNK(dname)
53          dnl = ILNBLNK(dname)
54    
55  C     Verify that the file exists  C     Verify that the file exists
56        CALL MNC_GET_IND(myThid, MNC_MAX_ID, fname, mnc_f_names, indf)        CALL MNC_GET_IND(myThid, MNC_MAX_ID, fname, mnc_f_names, indf)
# Line 44  C     Verify that the file exists Line 64  C     Verify that the file exists
64  C     Verify that the dim is not currently defined within the file  C     Verify that the dim is not currently defined within the file
65        n = mnc_f_alld(indf,1)        n = mnc_f_alld(indf,1)
66        DO i = 1,n        DO i = 1,n
67            ntmp = ILNBLNK(mnc_d_names(j))
68          j = mnc_f_alld(indf,i+1)          j = mnc_f_alld(indf,i+1)
69          IF (dname(1:ndn) .EQ. mnc_d_names(j)(1:ndn)) THEN          IF ((ntmp .EQ. (dnl-dnf+1))
70            write(msgbuf,'(5a)') 'MNC ERROR: dimension ''', dname(1:ndn),       &       .AND. (dname(dnf:dnl) .EQ. mnc_d_names(j)(1:n))) THEN
71              write(msgbuf,'(5a)') 'MNC ERROR: dimension ''',
72         &         dname(dnf:dnl),
73       &         ''' already exists within file ''', fname(1:nf),       &         ''' already exists within file ''', fname(1:nf),
74       &         ''' and cannot be re-initalized'       &         ''' and cannot be re-initalized'
75            CALL print_error( msgbuf, mythid )            CALL print_error( msgbuf, mythid )
# Line 56  C     Verify that the dim is not current Line 79  C     Verify that the dim is not current
79    
80        CALL MNC_GET_NEXT_EMPTY_IND(myThid, MNC_MAX_ID, mnc_d_names, indd)        CALL MNC_GET_NEXT_EMPTY_IND(myThid, MNC_MAX_ID, mnc_d_names, indd)
81    
82  C     Check that the dimension name fits in the table  C     Create the dim within the file
83        IF ( ndn .GT. MNC_MAX_CHAR) THEN        IF (doWrite(1:1) .EQ. 'Y') THEN
84          ndn = MNC_MAX_CHAR  
85          write(msgbuf,'(a)') 'MNC WARNING: dimension name too long'          tlen = dlen
86          CALL print_error(msgbuf, mythid)          IF (dlen .LT. 1)  tlen = NF_UNLIMITED
87        ENDIF  
88        IF ( ndu .GT. MNC_MAX_CHAR) THEN          CALL MNC_FILE_REDEF(myThid, fname)
89          ndu = MNC_MAX_CHAR          err = NF_DEF_DIM(mnc_f_info(indf,2), dname(dnf:dnl), tlen, idd)
90          write(msgbuf,'(a)') 'MNC WARNING: dimension units too long'          write(msgbuf,'(5a)') 'MNC_DIM_INIT ERROR: cannot create ',
91          CALL print_error(msgbuf, mythid)       &       'dim ''', dname(dnf:dnl), ''' in file ''', fname(1:nf)
92            CALL MNC_HANDLE_ERR(myThid, err, msgbuf)
93    
94        ENDIF        ENDIF
95    
96  C     Add to tables  C     Add to tables
97        mnc_d_names(indd)(1:ndn) = dname(1:ndn)        mnc_d_names(indd)(1:(dnl-dnf+1)) = dname(dnf:dnl)
       mnc_d_units(indd)(1:ndu) = dunits(1:ndu)  
98        mnc_d_size(indd) = dlen        mnc_d_size(indd) = dlen
99          mnc_d_ids(indd) = idd
100        mnc_f_alld(indf,1) = n + 1        mnc_f_alld(indf,1) = n + 1
101        mnc_f_alld(indf,n+2) = indd        mnc_f_alld(indf,n+2) = indd
102    
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3
  ViewVC Help
Powered by ViewVC 1.1.22