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

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

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

Revision 1.2 - (hide annotations) (download)
Sat Jan 17 13:55:49 2004 UTC (20 years, 4 months ago) by edhill
Branch: MAIN
CVS Tags: checkpoint52i_post, checkpoint52i_pre, checkpoint52h_pre
Changes since 1.1: +38 -51 lines 
 o fix MNC dimensions so they are now per-NetCDF-file: this was a serious
     error in the earlier design
 o fix use of _RL,_RS where they should be REAL*4,REAL*8
 o intelligent error handling for situations where the number of NetCDF
     variables exceeds the available storage space within the MNC
     "tables"
 o add descriptions to the variables in the model_grid output
1 edhill 1.2 C $Header: /u/u3/gcmpack/MITgcm/pkg/mnc/mnc_dim.F,v 1.1 2004/01/06 23:19:27 edhill Exp $
2 edhill 1.1 C $Name: $
3    
4     #include "MNC_OPTIONS.h"
5    
6     C==================================================================
7    
8     SUBROUTINE MNC_DIM_INIT(
9     I myThid,
10 edhill 1.2 I fname,
11 edhill 1.1 I dname,
12     I dunits,
13     I dlen )
14    
15     implicit none
16     #include "mnc_common.h"
17     #include "EEPARAMS.h"
18    
19     C Arguments
20     integer myThid
21 edhill 1.2 character*(*) fname, dname, dunits
22 edhill 1.1 integer dlen
23    
24     C Functions
25     integer ILNBLNK
26    
27     C Local Variables
28 edhill 1.2 integer i,j, indf,indd, n,nf,ndn,ndu
29 edhill 1.1 character*(MAX_LEN_MBUF) msgbuf
30    
31 edhill 1.2 nf = ILNBLNK(fname)
32     ndn = ILNBLNK(dname)
33     ndu = ILNBLNK(dunits)
34    
35     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 edhill 1.1 CALL print_error( msgbuf, mythid )
41 edhill 1.2 stop 'ABNORMAL END: S/R MNC_DIM_INIT'
42 edhill 1.1 ENDIF
43 edhill 1.2
44     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 edhill 1.1
59     C Check that the dimension name fits in the table
60 edhill 1.2 IF ( ndn .GT. MNC_MAX_CHAR) THEN
61     ndn = MNC_MAX_CHAR
62 edhill 1.1 write(msgbuf,'(a)') 'MNC WARNING: dimension name too long'
63     CALL print_error(msgbuf, mythid)
64     ENDIF
65 edhill 1.2 IF ( ndu .GT. MNC_MAX_CHAR) THEN
66     ndu = MNC_MAX_CHAR
67 edhill 1.1 write(msgbuf,'(a)') 'MNC WARNING: dimension units too long'
68     CALL print_error(msgbuf, mythid)
69     ENDIF
70    
71     C Add to tables
72 edhill 1.2 mnc_d_names(indd)(1:ndn) = dname(1:ndn)
73     mnc_d_units(indd)(1:ndu) = dunits(1:ndu)
74     mnc_d_size(indd) = dlen
75     mnc_f_alld(indf,1) = n + 1
76     mnc_f_alld(indf,n+2) = indd
77 edhill 1.1
78     RETURN
79     END
80    
  ViewVC Help
Powered by ViewVC 1.1.22