/[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.1 by edhill, Tue Jan 6 23:19:27 2004 UTC revision 1.2 by edhill, Sat Jan 17 13:55:49 2004 UTC
# Line 7  C======================================= Line 7  C=======================================
7    
8        SUBROUTINE MNC_DIM_INIT(        SUBROUTINE MNC_DIM_INIT(
9       I     myThid,       I     myThid,
10         I     fname,
11       I     dname,       I     dname,
12       I     dunits,       I     dunits,
13       I     dlen )       I     dlen )
# Line 17  C======================================= Line 18  C=======================================
18    
19  C     Arguments  C     Arguments
20        integer myThid        integer myThid
21        character*(*) dname        character*(*) fname, dname, dunits
       character*(*) dunits  
22        integer dlen        integer dlen
23    
24  C     Functions  C     Functions
25        integer ILNBLNK        integer ILNBLNK
26    
27  C     Local Variables  C     Local Variables
28        integer ind, n1,n2        integer i,j, indf,indd, n,nf,ndn,ndu
29        character*(MAX_LEN_MBUF) msgbuf        character*(MAX_LEN_MBUF) msgbuf
30    
31  C     Check that dname is not already used        nf = ILNBLNK(fname)
32        CALL MNC_GET_IND(myThid, MNC_MAX_ID, dname, mnc_d_names, ind)        ndn = ILNBLNK(dname)
33        IF ( ind .GT. 0 ) THEN        ndu = ILNBLNK(dunits)
34          write(msgbuf,'(3a)') 'MNC ERROR: dimension ''',  
35       &       dname, ''' already exists--cannot declare it twice'  C     Verify that the file exists
36          CALL MNC_GET_IND(myThid, MNC_MAX_ID, fname, mnc_f_names, indf)
37          IF ( indf .LT. 1 ) THEN
38            write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname(1:nf),
39         &       ''' does not exist'
40          CALL print_error( msgbuf, mythid )          CALL print_error( msgbuf, mythid )
41          stop 'ABNORMAL END: S/R MNC_DIM_INT'          stop 'ABNORMAL END: S/R MNC_DIM_INIT'
42        ENDIF        ENDIF
43          
44        CALL MNC_GET_NEXT_EMPTY_IND(myThid, MNC_MAX_ID, mnc_d_names, ind)  C     Verify that the dim is not currently defined within the file
45          n = mnc_f_alld(indf,1)
46          DO i = 1,n
47            j = mnc_f_alld(indf,i+1)
48            IF (dname(1:ndn) .EQ. mnc_d_names(j)(1:ndn)) THEN
49              write(msgbuf,'(5a)') 'MNC ERROR: dimension ''', dname(1:ndn),
50         &         ''' already exists within file ''', fname(1:nf),
51         &         ''' and cannot be re-initalized'
52              CALL print_error( msgbuf, mythid )
53              stop 'ABNORMAL END: S/R MNC_DIM_INIT'
54            ENDIF
55          ENDDO
56    
57          CALL MNC_GET_NEXT_EMPTY_IND(myThid, MNC_MAX_ID, mnc_d_names, indd)
58    
59  C     Check that the dimension name fits in the table  C     Check that the dimension name fits in the table
60        n1 = ILNBLNK(dname)        IF ( ndn .GT. MNC_MAX_CHAR) THEN
61        IF ( n1 .GT. MNC_MAX_CHAR) THEN          ndn = MNC_MAX_CHAR
         n1 = MNC_MAX_CHAR  
62          write(msgbuf,'(a)') 'MNC WARNING: dimension name too long'          write(msgbuf,'(a)') 'MNC WARNING: dimension name too long'
63          CALL print_error(msgbuf, mythid)          CALL print_error(msgbuf, mythid)
64        ENDIF        ENDIF
65        n2 = ILNBLNK(dunits)        IF ( ndu .GT. MNC_MAX_CHAR) THEN
66        IF ( n2 .GT. MNC_MAX_CHAR) THEN          ndu = MNC_MAX_CHAR
         n2 = MNC_MAX_CHAR  
67          write(msgbuf,'(a)') 'MNC WARNING: dimension units too long'          write(msgbuf,'(a)') 'MNC WARNING: dimension units too long'
68          CALL print_error(msgbuf, mythid)          CALL print_error(msgbuf, mythid)
69        ENDIF        ENDIF
70    
71  C     Add to tables  C     Add to tables
72        mnc_d_names(ind)(1:n1) = dname(1:n1)        mnc_d_names(indd)(1:ndn) = dname(1:ndn)
73        mnc_d_units(ind)(1:n2) = dunits(1:n2)        mnc_d_units(indd)(1:ndu) = dunits(1:ndu)
74        mnc_d_size(ind) = dlen        mnc_d_size(indd) = dlen
75          mnc_f_alld(indf,1) = n + 1
76          mnc_f_alld(indf,n+2) = indd
77    
78        RETURN        RETURN
79        END        END
80    
 C==================================================================  
   
       SUBROUTINE MNC_DIM_REMOVE(  
      I     myThid,  
      I     dname )  
   
       implicit none  
 #include "mnc_common.h"  
 #include "EEPARAMS.h"  
   
 C     Arguments  
       integer myThid  
       character*(*) dname  
   
 C     Functions  
       integer ILNBLNK  
   
 C     Local Variables  
       integer ind, n  
       character*(MAX_LEN_MBUF) msgbuf  
   
 C     Check that dname is not already used  
       CALL MNC_GET_IND(myThid, MNC_MAX_ID, dname, mnc_d_names, ind)  
       IF ( ind .GT. 0 ) THEN  
         mnc_d_names(ind)(1:MNC_MAX_CHAR) =  
      &       mnc_blank_name(1:MNC_MAX_CHAR)  
       ENDIF  
   
       RETURN  
       END  
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22