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
|
C Copyright 1981-2007 ECMWF
C
C Licensed under the GNU Lesser General Public License which
C incorporates the terms and conditions of version 3 of the GNU
C General Public License.
C See LICENSE and gpl-3.0.txt for details.
C
PROGRAM SAMPLE1
C
IMPLICIT NONE
INTEGER IPROD
INTEGER INTV
REAL REALV
CHARACTER*20 CHARV
DIMENSION INTV(4), REALV(4), CHARV(4)
C
INTEGER JPGRIB, JPBYTES
C
PARAMETER (JPGRIB = 2000000)
C
C JPBYTES is the size in bytes on an 'INTEGER'
C Set JPBYTES = 8 on a 64-bit machine.
C
PARAMETER (JPBYTES = 4)
C
INTEGER INGRIB, NEWFLD
DIMENSION INGRIB(JPGRIB), NEWFLD(JPGRIB)
C
REAL ZNFELDI, ZNFELDO
DIMENSION ZNFELDI(1), ZNFELDO(1)
C
INTEGER IUNIT1, IUNIT2, IREC, INLEN, NEWLEN, IRET, NARGS
INTEGER*4 J
C
C Externals
INTEGER INTOUT, INTF, IARGC
CHARACTER*128 INFILE, OUTFILE, CARG(4)
C
C **********************************************************************
C
C Pick up file names from command line.
C
NARGS = IARGC()
IF( NARGS.LT.4 ) THEN
print*,'Usage: interpolation_example -i inputfile -o outputfile'
STOP
END IF
DO 101 J=1,NARGS
CALL GETARG(J,CARG(J))
101 CONTINUE
DO 102 J=1,NARGS,2
IF(CARG(J).EQ.'-i') THEN
INFILE=CARG(J+1)
ELSEIF(CARG(J).EQ.'-o') THEN
OUTFILE=CARG(J+1)
ELSE
print*,'Usage: interpolation_example -i inputfile -o outputfile'
STOP
END IF
102 CONTINUE
C Define the packing accuracy for the new field(s).
C
INTV(1) = 24
IRET = INTOUT('accuracy', INTV, REALV, CHARV)
IF ( IRET.NE.0 ) THEN
WRITE(*,*) ' First INTOUT failed.'
STOP
ENDIF
C
C Define the geographical area for the new field(s).
C
REALV(1) = 60.0
REALV(2) = -10.0
REALV(3) = 40.0
REALV(4) = 15.0
IRET = INTOUT('area', INTV, REALV, CHARV)
IF ( IRET.NE.0 ) THEN
WRITE(*,*) ' Second INTOUT failed.'
STOP
ENDIF
C
C Define the grid interval for the new field(s).
C
REALV(1) = 1.5
REALV(2) = 1.5
IRET = INTOUT('grid', INTV, REALV, CHARV)
IF ( IRET.NE.0 ) THEN
WRITE(*,*) ' Third INTOUT failed.'
STOP
ENDIF
C
C Open input and output files.
C
CALL PBOPEN(IUNIT1, INFILE, 'r', IRET)
IF ( IRET.NE.0 ) STOP ' PBOPEN failed'
CALL PBOPEN(IUNIT2, OUTFILE, 'w', IRET)
IF ( IRET.NE.0 ) STOP ' PBOPEN failed'
IPROD = 0
C
C Start of loop through input GRIB-coded fields
C
200 CONTINUE
IPROD = IPROD + 1
C
C Read next product.
C
CALL PBGRIB(IUNIT1, INGRIB, JPGRIB*JPBYTES, IREC, IRET)
IF ( IRET.EQ.-1 ) GOTO 900
IF ( IRET.NE.0 ) STOP ' PBGRIB failed'
C
C Interpolate.
C
WRITE(*,*) ' Interpolate product number ', IPROD
NEWLEN = JPGRIB
INLEN = IREC/JPBYTES
IRET = INTF(INGRIB,INLEN,ZNFELDI,NEWFLD,NEWLEN,ZNFELDO)
IF ( IRET.NE.0 ) THEN
WRITE(*,*) ' INTF failed.'
STOP
ENDIF
C
C Write the new product to file.
C
CALL PBWRITE( IUNIT2, NEWFLD, NEWLEN*JPBYTES, IRET)
IF ( IRET.LT.(NEWLEN*JPBYTES) ) STOP ' PBWRITE failed'
C
C Loop back for next product.
C
GOTO 200
C
C Closedown.
C
900 CONTINUE
C
IPROD = IPROD - 1
WRITE(*,*) ' All done after ', IPROD, ' products.'
C
C Close input and output files.
C
CALL PBCLOSE(IUNIT1, IRET)
CALL PBCLOSE(IUNIT2, IRET)
C
STOP
END
|
