/[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.5 - (hide annotations) (download)
Wed Feb 4 05:45:09 2004 UTC (20 years, 3 months ago) by edhill
Branch: MAIN
Changes since 1.4: +19 -9 lines
 o working (though incomplete) version of the "wrapper":
   - 149 pre-defined grids:
     - all "meaningful" X,Y,Z,T combinations
     - X,Y with or without halos
     - Horiz: centered, U, V, and corner (vorticity) grids
     - Vert: centered or interface
   - just two function calls to write a variable using one of the
     pre-defined grids
 o tile numbering scheme for both cube and XY grids
 o read, write, and append NetCDF files
 o checks for (acceptable) re-definition of dims, grids, and vars
 o numerous small bug fixes
 o warning: the two mnc_model_* files are now broken/obsolete and
   will soon be removed

1 edhill 1.5 C $Header: /u/u3/gcmpack/MITgcm/pkg/mnc/mnc_dim.F,v 1.4 2004/01/27 05:47:32 edhill Exp $
2 edhill 1.1 C $Name: $
3    
4     #include "MNC_OPTIONS.h"
5    
6 edhill 1.4 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7 edhill 1.1
8     SUBROUTINE MNC_DIM_INIT(
9     I myThid,
10 edhill 1.2 I fname,
11 edhill 1.1 I dname,
12     I dlen )
13    
14 edhill 1.3 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 edhill 1.4 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
25 edhill 1.3
26     SUBROUTINE MNC_DIM_INIT_ALL(
27     I myThid,
28     I fname,
29     I dname,
30     I dlen,
31     I doWrite )
32    
33 edhill 1.1 implicit none
34 edhill 1.3 #include "netcdf.inc"
35 edhill 1.1 #include "mnc_common.h"
36     #include "EEPARAMS.h"
37    
38     C Arguments
39 edhill 1.3 integer myThid, dlen
40     character*(*) fname, dname
41     character*(1) doWrite
42 edhill 1.1
43     C Functions
44 edhill 1.3 integer ILNBLNK, IFNBLNK
45 edhill 1.1
46     C Local Variables
47 edhill 1.3 integer i,j, indf,indd, n,nf, dnf,dnl, ntmp, idd, err, tlen
48 edhill 1.1 character*(MAX_LEN_MBUF) msgbuf
49    
50 edhill 1.2 nf = ILNBLNK(fname)
51 edhill 1.3
52     dnf = IFNBLNK(dname)
53     dnl = ILNBLNK(dname)
54 edhill 1.2
55     C Verify that the file exists
56     CALL MNC_GET_IND(myThid, MNC_MAX_ID, fname, mnc_f_names, indf)
57     IF ( indf .LT. 1 ) THEN
58     write(msgbuf,'(3a)') 'MNC ERROR: file ''', fname(1:nf),
59     & ''' does not exist'
60 edhill 1.1 CALL print_error( msgbuf, mythid )
61 edhill 1.2 stop 'ABNORMAL END: S/R MNC_DIM_INIT'
62 edhill 1.1 ENDIF
63 edhill 1.2
64     C Verify that the dim is not currently defined within the file
65     n = mnc_f_alld(indf,1)
66     DO i = 1,n
67 edhill 1.5 j = mnc_f_alld(indf,i+1)
68 edhill 1.3 ntmp = ILNBLNK(mnc_d_names(j))
69     IF ((ntmp .EQ. (dnl-dnf+1))
70 edhill 1.5 & .AND. (dname(dnf:dnl) .EQ. mnc_d_names(j)(1:ntmp))) THEN
71     IF (mnc_d_size(j) .NE. dlen) THEN
72     IF ((mnc_d_size(j) .GT. 0) .OR. (dlen .GT. 0)) THEN
73     write(msgbuf,'(5a)') 'MNC ERROR: dimension ''',
74     & dname(dnf:dnl), ''' already exists within file ''',
75     & fname(1:nf), ''' and its size cannot be changed'
76     CALL print_error(msgbuf, mythid)
77     stop 'ABNORMAL END: S/R MNC_DIM_INIT'
78     ELSE
79     C Its OK, the names are the same and both are specifying the
80     C unlimited dimension
81     RETURN
82     ENDIF
83     ELSE
84     C Its OK, the names and sizes are identical
85     RETURN
86     ENDIF
87 edhill 1.2 ENDIF
88     ENDDO
89    
90     CALL MNC_GET_NEXT_EMPTY_IND(myThid, MNC_MAX_ID, mnc_d_names, indd)
91 edhill 1.1
92 edhill 1.3 C Create the dim within the file
93     IF (doWrite(1:1) .EQ. 'Y') THEN
94    
95     tlen = dlen
96     IF (dlen .LT. 1) tlen = NF_UNLIMITED
97    
98     CALL MNC_FILE_REDEF(myThid, fname)
99     err = NF_DEF_DIM(mnc_f_info(indf,2), dname(dnf:dnl), tlen, idd)
100     write(msgbuf,'(5a)') 'MNC_DIM_INIT ERROR: cannot create ',
101     & 'dim ''', dname(dnf:dnl), ''' in file ''', fname(1:nf)
102     CALL MNC_HANDLE_ERR(myThid, err, msgbuf)
103    
104 edhill 1.1 ENDIF
105    
106     C Add to tables
107 edhill 1.3 mnc_d_names(indd)(1:(dnl-dnf+1)) = dname(dnf:dnl)
108 edhill 1.2 mnc_d_size(indd) = dlen
109 edhill 1.3 mnc_d_ids(indd) = idd
110 edhill 1.2 mnc_f_alld(indf,1) = n + 1
111     mnc_f_alld(indf,n+2) = indd
112 edhill 1.1
113     RETURN
114     END
115    

  ViewVC Help
Powered by ViewVC 1.1.22