1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
|
PROGRAM READVALUES
INTEGER IFILE
INTEGER GRIBID
INTEGER GRIBID2
INTEGER VALUE
INTEGER NARGS
INTEGER IRET
INTEGER IFILEN
INTEGER VALUESLEN
INTEGER J
INTEGER JCOUNT
INTEGER GRIB_OPEN_FILE
EXTERNAL GRIB_OPEN_FILE
INTEGER GRIB_CLONE
EXTERNAL GRIB_CLONE
EXTERNAL GRIB_PRINT
INTEGER GRIB_PRINT
INTEGER GRIB_CLOSE_FILE
INTEGER GRIB_NEW_FROM_FILE
INTEGER GRIB_NEW_FROM_TEMPLATE
INTEGER GRIB_SET_REAL8_ARRAY
INTEGER GRIB_SET_REAL4_ARRAY
INTEGER GRIB_SET_INT_ARRAY
INTEGER GRIB_GET_INT
INTEGER GRIB_SET_INT
INTEGER GRIB_GET_REAL8_ARRAY
INTEGER GRIB_RELEASE
EXTERNAL GRIB_CLOSE_FILE
EXTERNAL GRIB_NEW_FROM_FILE
EXTERNAL GRIB_NEW_FROM_TEMPLATE
EXTERNAL GRIB_GET_INT
EXTERNAL GRIB_SET_INT
EXTERNAL GRIB_GET_REAL8_ARRAY
EXTERNAL GRIB_SET_REAL8_ARRAY
EXTERNAL GRIB_SET_REAL4_ARRAY
EXTERNAL GRIB_SET_INT_ARRAY
EXTERNAL GRIB_RELEASE
INTEGER PVSIZE
INTEGER GRIB_WRITE_TO
EXTERNAL GRIB_WRITE_TO
INTEGER GRIB_GET_ERROR_STRING
EXTERNAL GRIB_GET_ERROR_STRING
INTEGER PLSIZE
CHARACTER*2 INPUT
CHARACTER*256 YDATAFILE
CHARACTER*256 MPARAM
CHARACTER*256 MERROR
REAL*8 VALUES(2048)
INTEGER PL(32)
REAL*8 PVSS(20)
REAL*8 VMAX
REAL*8 VMIN
IFILE = 0
IRET = 5
GRIBID = 0;
PVSIZE =20
PLSIZE =32
NARGS = IARGC()
VALUESLEN = 2048
CALL GETARG(1,INPUT)
IF(INPUT.EQ.'-i') THEN
CALL GETARG(2,YDATAFILE)
ELSE
print*,'Usage: readvalues -i inputfile'
STOP
END IF
JCOUNT = 0
IFILEN = INDEX(YDATAFILE,' ') - 1
IRET = GRIB_OPEN_FILE(IFILE, YDATAFILE (1: IFILEN),"r")
WRITE (*,*) "Opened returned ", IRET, IFILE
JCOUNT = 0
50 CONTINUE
JCOUNT = JCOUNT + 1
IRET = GRIB_NEW_FROM_TEMPLATE(GRIBID, "gg_ml")
C IRET = GRIB_NEW_FROM_FILE(IFILE,GRIBID)
C WRITE (*,*) "gribid ret ",IRET, IFILE
IF ( IRET .LT. 0 ) THEN
WRITE (*, *) 'total ', JCOUNT ,' ret = ', IRET
C IRET = GRIB_CLOSE_FILE(IFILE)
STOP 'no more gribs'
ENDIF
IF ( JCOUNT .GT. 1 ) THEN
WRITE (*, *) 'total ', JCOUNT ,' ret = ', IRET
IRET = GRIB_CLOSE_FILE(IFILE)
STOP 'no more gribs'
ENDIF
IRET = GRIB_GET_INT(GRIBID,"ni",VALUE)
WRITE (*,*) "NI ", VALUE , " ret ",IRET
IRET = GRIB_GET_ERROR_STRING(IRET,MERROR)
WRITE (*,*) "ERROR ", MERROR
DO J = 1, PVSIZE
PVSS(J) = J
ENDDO
IRET = GRIB_SET_REAL8_ARRAY(GRIBID,"pv",PVSS, PVSIZE)
IRET = GRIB_GET_ERROR_STRING(IRET,MERROR)
DO J = 1, PLSIZE
PL(J) = 64
ENDDO
IRET = GRIB_SET_INT_ARRAY(GRIBID,"pl",PL, PLSIZE)
IRET = GRIB_GET_ERROR_STRING(IRET,MERROR)
VALUE = 1
IRET = GRIB_SET_INT(GRIBID,"marsClass",VALUE)
WRITE (*,*) "Class ", VALUE , " ret ",IRET
VMAX = VALUES(1)
VMIN = VMAX
DO J = 1, VALUESLEN
VALUES(J) = J + 0.5
ENDDO
IRET = GRIB_SET_REAL8_ARRAY(GRIBID,"values",VALUES, VALUESLEN)
IRET = GRIB_GET_ERROR_STRING(IRET,MERROR)
WRITE (*,*) "PACK ERROR here", MERROR
IRET = GRIB_PRINT(GRIBID,"level")
IRET = GRIB_PRINT(GRIBID,"topLevel")
IRET = GRIB_PRINT(GRIBID,"bottomLevel")
IRET = GRIB_PRINT(GRIBID,"GRIB")
IRET = GRIB_WRITE_TO(GRIBID,"test.grib")
IRET = GRIB_RELEASE(GRIBID)
GO TO 50
END
|
