NCEPLIBS-g2 4.0.0
Loading...
Searching...
No Matches
grbindex.f
Go to the documentation of this file.
1
4
17 PROGRAM grbindex
18 parameter(msk1=32000,msk2=4000)
19 CHARACTER cgb*256,cgi*256
20 parameter(mbuf=256*1024)
21 CHARACTER cbuf(mbuf)
22 CHARACTER carg*300
23 INTEGER narg,iargc
24
25! GET ARGUMENTS
26 narg=iargc()
27 IF(narg.NE.2) THEN
28 CALL errmsg('grbindex: Incorrect usage')
29 CALL errmsg('Usage: grbindex gribfile indexfile')
30 CALL errexit(2)
31 ENDIF
32 CALL getarg(1,cgb)
33 ncgb=len_trim(cgb)
34 CALL baopenr(11,cgb(1:ncgb),ios)
35 CALL baseto(1,1)
36 IF(ios.NE.0) THEN
37 lcarg=len('grbindex: Error accessing file '//cgb(1:ncgb))
38 carg(1:lcarg)='grbindex: Error accessing file '//cgb(1:ncgb)
39 CALL errmsg(carg(1:lcarg))
40 CALL errexit(8)
41 ENDIF
42 CALL getarg(2,cgi)
43 ncgi=len_trim(cgi)
44 CALL baopen(31,cgi(1:ncgi),ios)
45 IF(ios.NE.0) THEN
46 lcarg=len('grbindex: Error accessing file '//cgi(1:ncgi))
47 carg(1:lcarg)='grbindex: Error accessing file '//cgi(1:ncgi)
48 CALL errmsg(carg(1:lcarg))
49 CALL errexit(8)
50 ENDIF
51
52! WRITE INDEX FILE
53 mnum=0
54 CALL getgir(11,msk1,msk2,mnum,mbuf,cbuf,nlen,nnum,irgi)
55 IF(irgi.GT.1.OR.nnum.EQ.0) THEN
56 CALL errmsg('grbindex: No GRIB messages detected in file '
57 & //cgb(1:ncgb))
58 CALL baclose(11,iret)
59 CALL baclose(31,iret)
60 CALL errexit(1)
61 ENDIF
62 mnum=mnum+nnum
63 CALL wrgi1h(31,nlen,mnum,cgb(1:ncgb))
64 iw=162
65 CALL bawrite(31,iw,nlen*nnum,kw,cbuf)
66 iw=iw+nlen*nnum
67
68! EXTEND INDEX FILE IF INDEX BUFFER LENGTH GREATER THAN MBUF
69 IF(irgi.EQ.1) THEN
70 dowhile(irgi.EQ.1.AND.nnum.GT.0)
71 CALL getgir(11,msk1,msk2,mnum,mbuf,cbuf,nlen,nnum,irgi)
72 IF(irgi.LE.1.AND.nnum.GT.0) THEN
73 mnum=mnum+nnum
74 CALL bawrite(31,iw,nlen*nnum,kw,cbuf)
75 iw=iw+nlen*nnum
76 ENDIF
77 ENDDO
78 CALL wrgi1h(31,nlen,mnum,cgb(1:ncgb))
79 ENDIF
80 CALL baclose(11,iret)
81 CALL baclose(31,iret)
82
83 END
84
103 SUBROUTINE wrgi1h(LUGI,NLEN,NNUM,CGB)
104 CHARACTER CGB*(*)
105#ifdef __GFORTRAN__
106 CHARACTER CD8*8,CT10*10,HOSTNAME*15
107 INTEGER ISTAT
108#else
109 CHARACTER CD8*8,CT10*10,HOSTNAM*15
110#endif
111 CHARACTER CHEAD(2)*81
112
113! FILL FIRST 81-BYTE HEADER
114 ncgb=len(cgb)
115 ncgb1=ncbase(cgb,ncgb)
116 ncgb2=ncbase(cgb,ncgb1-2)
117 CALL date_and_time(cd8,ct10)
118 chead(1)='!GFHDR!'
119 chead(1)(9:10)=' 1'
120 chead(1)(12:14)=' 1'
121 WRITE(chead(1)(16:20),'(I5)') 162
122 chead(1)(22:31)=cd8(1:4)//'-'//cd8(5:6)//'-'//cd8(7:8)
123 chead(1)(33:40)=ct10(1:2)//':'//ct10(3:4)//':'//ct10(5:6)
124 chead(1)(42:47)='GB1IX1'
125 chead(1)(49:54)=cgb(ncgb2:ncgb1-2)
126#ifdef __GFORTRAN__
127 istat=hostnm(hostname)
128 IF(istat.eq.0) THEN
129 chead(1)(56:70)='0000'
130 ELSE
131 chead(1)(56:70)='0001'
132 ENDIF
133#else
134 chead(1)(56:70)=hostnam(hostname)
135#endif
136! print*,' CHEAD(1)(56:70) = ', CHEAD(1)(56:70)
137 chead(1)(72:80)='grbindex '
138 chead(1)(81:81)=char(10)
139
140! FILL SECOND 81-BYTE HEADER
141 chead(2)='IX1FORM:'
142 WRITE(chead(2)(9:38),'(3I10)') 162,nlen,nnum
143 chead(2)(41:80)=cgb(ncgb1:ncgb)
144 chead(2)(81:81)=char(10)
145
146! WRITE HEADERS AT BEGINNING OF INDEX FILE
147 CALL bawrite(lugi,0,162,kw,chead)
148
149 RETURN
150 END
151
164 FUNCTION ncbase(C,N)
165 CHARACTER c*(*)
166
167 k=n
168 dowhile(k.GE.1.AND.c(k:k).NE.'/')
169 k=k-1
170 ENDDO
171 ncbase=k+1
172
173 RETURN
174 END
integer function ncbase(c, n)
Locate basename of a file.
Definition grb2index.F90:95
subroutine wrgi1h(lugi, nlen, nnum, cgb)
Write index headers.
Definition grbindex.f:104
program grbindex
Create an index file from a grib file.
Definition grbindex.f:17