9 |
I myThid, |
I myThid, |
10 |
I fname, |
I fname, |
11 |
I gname, |
I gname, |
12 |
I vname, |
I vname ) |
|
I units ) |
|
13 |
|
|
14 |
implicit none |
implicit none |
15 |
#include "netcdf.inc" |
#include "netcdf.inc" |
16 |
|
|
17 |
C Arguments |
C Arguments |
18 |
integer myThid |
integer myThid |
19 |
character*(*) fname,gname,vname,units |
character*(*) fname,gname,vname |
20 |
|
|
21 |
CALL MNC_VAR_INIT_ANY(myThid,fname,gname,vname,units, NF_DOUBLE) |
CALL MNC_VAR_INIT_ANY(myThid,fname,gname,vname, NF_DOUBLE) |
22 |
RETURN |
RETURN |
23 |
END |
END |
24 |
|
|
28 |
I myThid, |
I myThid, |
29 |
I fname, |
I fname, |
30 |
I gname, |
I gname, |
31 |
I vname, |
I vname ) |
|
I units ) |
|
32 |
|
|
33 |
implicit none |
implicit none |
34 |
#include "netcdf.inc" |
#include "netcdf.inc" |
35 |
|
|
36 |
C Arguments |
C Arguments |
37 |
integer myThid |
integer myThid |
38 |
character*(*) fname,gname,vname,units |
character*(*) fname,gname,vname |
39 |
|
|
40 |
CALL MNC_VAR_INIT_ANY(myThid,fname,gname,vname,units, NF_FLOAT) |
CALL MNC_VAR_INIT_ANY(myThid,fname,gname,vname, NF_FLOAT) |
41 |
RETURN |
RETURN |
42 |
END |
END |
43 |
|
|
47 |
I myThid, |
I myThid, |
48 |
I fname, |
I fname, |
49 |
I gname, |
I gname, |
50 |
I vname, |
I vname ) |
|
I units ) |
|
51 |
|
|
52 |
implicit none |
implicit none |
53 |
#include "netcdf.inc" |
#include "netcdf.inc" |
54 |
|
|
55 |
C Arguments |
C Arguments |
56 |
integer myThid |
integer myThid |
57 |
character*(*) fname,gname,vname,units |
character*(*) fname,gname,vname |
58 |
|
|
59 |
CALL MNC_VAR_INIT_ANY(myThid,fname,gname,vname,units, NF_INT) |
CALL MNC_VAR_INIT_ANY(myThid,fname,gname,vname, NF_INT) |
60 |
RETURN |
RETURN |
61 |
END |
END |
62 |
|
|
67 |
I fname, |
I fname, |
68 |
I gname, |
I gname, |
69 |
I vname, |
I vname, |
|
I units, |
|
70 |
I vtype ) |
I vtype ) |
71 |
|
|
72 |
implicit none |
implicit none |
76 |
|
|
77 |
C Arguments |
C Arguments |
78 |
integer myThid |
integer myThid |
79 |
character*(*) fname,gname,vname,units |
character*(*) fname,gname,vname |
80 |
integer vtype |
integer vtype |
81 |
|
|
82 |
C Functions |
C Functions |
84 |
|
|
85 |
C Local Variables |
C Local Variables |
86 |
integer i,j,k, n, indf,indv, fid, nd, ngrid, is,ie, err |
integer i,j,k, n, indf,indv, fid, nd, ngrid, is,ie, err |
87 |
integer vid, nv, ind_g_finfo, needed |
integer vid, nv, ind_g_finfo, needed, nvar |
88 |
character*(MAX_LEN_MBUF) msgbuf |
character*(MAX_LEN_MBUF) msgbuf |
89 |
integer ids(20) |
integer ids(20) |
90 |
integer lenf,leng,lenv,lenu |
integer lenf,leng,lenv |
91 |
|
|
92 |
C Strip trailing spaces |
C Strip trailing spaces |
93 |
lenf = ILNBLNK(fname) |
lenf = ILNBLNK(fname) |
94 |
leng = ILNBLNK(gname) |
leng = ILNBLNK(gname) |
95 |
lenv = ILNBLNK(vname) |
lenv = ILNBLNK(vname) |
|
lenu = ILNBLNK(units) |
|
96 |
|
|
97 |
C Check that the file is open |
C Check that the file is open |
98 |
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) |
145 |
stop 'ABNORMAL END: S/R MNC_VAR_INIT_ANY' |
stop 'ABNORMAL END: S/R MNC_VAR_INIT_ANY' |
146 |
10 CONTINUE |
10 CONTINUE |
147 |
|
|
148 |
|
C Check if the variable is already defined |
149 |
|
nvar = mnc_fv_ids(indf,1) |
150 |
|
DO i = 1,nvar |
151 |
|
j = 2 + 3*(i-1) |
152 |
|
IF (mnc_v_names(mnc_fv_ids(indf,j)) .EQ. vname) THEN |
153 |
|
k = mnc_f_info(indf,mnc_fv_ids(indf,j+2)) |
154 |
|
IF (mnc_g_names(k) .NE. gname) THEN |
155 |
|
write(msgbuf,'(5a)') 'MNC ERROR: variable ''', |
156 |
|
& vname(1:lenv), ''' is already defined in file ''', |
157 |
|
& fname(1:lenf), ''' but using a different grid shape' |
158 |
|
CALL print_error(msgbuf, mythid) |
159 |
|
stop 'ABNORMAL END: S/R MNC_VAR_INIT_ANY' |
160 |
|
ELSE |
161 |
|
C Its OK, the variable and grid names are the same |
162 |
|
RETURN |
163 |
|
ENDIF |
164 |
|
ENDIF |
165 |
|
ENDDO |
166 |
|
|
167 |
C Add the variable definition |
C Add the variable definition |
168 |
CALL MNC_FILE_REDEF(myThid, fname) |
CALL MNC_FILE_REDEF(myThid, fname) |
169 |
err = NF_DEF_VAR(fid, vname, vtype, nd, ids, vid) |
err = NF_DEF_VAR(fid, vname, vtype, nd, ids, vid) |
181 |
mnc_fv_ids(indf,i+2) = ind_g_finfo |
mnc_fv_ids(indf,i+2) = ind_g_finfo |
182 |
mnc_fv_ids(indf,1) = nv + 1 |
mnc_fv_ids(indf,1) = nv + 1 |
183 |
|
|
|
C Add the units |
|
|
CALL MNC_VAR_ADD_ATTR_STR(myThid, fname, vname, 'units', units) |
|
|
|
|
184 |
RETURN |
RETURN |
185 |
END |
END |
186 |
|
|