70 CHARACTER*128 bort_str
82 CALL
status(lunit,lun,il,im)
89 CALL
parstr(str,tgs,maxtg,ntg,
' ',.true.)
95 CALL
parutg(lun,1,tgs(1),nnod,kon,roid)
98 IF(ioid.LE.0) ioid = 1
101 DO WHILE((ii.LE.10).AND.(tgs(1)(ii:ii).NE.
'#'))
102 ctag(ii:ii)=tgs(1)(ii:ii)
110 IF(
iupbs3(mbay(1,lun),
'ICMP').GT.0)
THEN
117 DO WHILE (n+1.LE.nval(lun))
120 IF(itp(node).EQ.1)
THEN
121 CALL
usrtpl(lun,n,matx(n,ncol))
122 ELSEIF(ctag.EQ.tag(node))
THEN
124 IF(itagct.EQ.ioid)
THEN
125 IF(itp(node).NE.3) goto 904
133 nchr=min(mxlcc,ibt(node)/8)
134 catx(n,ncol)=chr(1:nchr)
145 CALL
getlens(mbay(1,lun),3,len0,len1,len2,len3,l4,l5)
146 mbyte = len0 + len1 + len2 + len3 + 4
151 DO WHILE(nsubs.LT.nsub(lun))
153 CALL
upb(nbyt,16,mbay(1,lun),ibit)
158 IF(nsubs.NE.nsub(lun))
THEN
160 CALL
errwrt(
'+++++++++++++++++++++WARNING+++++++++++++++++++++++')
161 errstr =
'BUFRLIB: WRITLC - COULDN''T WRITE VALUE FOR ' // ctag
162 . //
' INTO SUBSET, BECAUSE NO SUBSET WAS OPEN FOR WRITING'
164 CALL
errwrt(
'+++++++++++++++++++++WARNING+++++++++++++++++++++++')
177 DO WHILE (n+1.LE.nval(lun))
182 IF(itp(node).EQ.1)
THEN
183 CALL
upbb(ival,nbit,mbit,mbay(1,lun))
185 ELSEIF(ctag.EQ.tag(node))
THEN
187 IF(itagct.EQ.ioid)
THEN
188 IF(itp(node).NE.3) goto 904
192 CALL
pkc(
' ',1,mbay(1,lun),ibit)
194 CALL
pkc(chr,nchr,mbay(1,lun),mbit)
203 CALL
errwrt(
'+++++++++++++++++++++WARNING+++++++++++++++++++++++')
204 errstr =
'BUFRLIB: WRITLC - COULDN''T WRITE VALUE FOR ' // ctag
205 . //
' INTO SUBSET, BECAUSE IT WASN''T FOUND IN THE SUBSET'
208 errstr =
'(' // ctag //
' MAY NOT BE IN THE BUFR TABLE(?))'
210 CALL
errwrt(
'+++++++++++++++++++++WARNING+++++++++++++++++++++++')
218 900 CALL
bort(
'BUFRLIB: WRITLC - OUTPUT BUFR FILE IS CLOSED, IT '//
219 .
'MUST BE OPEN FOR OUTPUT')
220 901 CALL
bort(
'BUFRLIB: WRITLC - OUTPUT BUFR FILE IS OPEN FOR '//
221 .
'INPUT, IT MUST BE OPEN FOR OUTPUT')
222 902 CALL
bort(
'BUFRLIB: WRITLC - A MESSAGE MUST BE OPEN IN OUTPUT '//
223 .
'BUFR FILE, NONE ARE')
224 903
WRITE(bort_str,
'("BUFRLIB: WRITLC - THERE CANNOT BE MORE THAN '//
225 .
' ONE MNEMONIC IN THE INPUT STRING (",A,") (HERE THERE ARE",I4'//
228 904
WRITE(bort_str,
'("BUFRLIB: WRITLC - MNEMONIC ",A," DOES NOT '//
229 .
'REPRESENT A CHARACTER ELEMENT (TYP=",A,")")') ctag,typ(node)
231 905
WRITE(bort_str,
'("BUFRLIB: WRITLC - THE MOST RECENTLY WRITTEN '//
232 . .NE.
' SUBSET NO. (",I3,") IN MSG THE STORED VALUE FOR THE NO.'//
233 .
' OF SUBSETS (",I3,") IN MSG")') nsubs,nsub(lun)
subroutine upbb(NVAL, NBITS, IBIT, IBAY)
THIS SUBROUTINE UNPACKS AND RETURNS A BINARY INTEGER CONTAINED WITHIN NBITS BITS OF IBAY...
function iupbs3(MBAY, S3MNEM)
This function returns a specified value from within Section 3 of a BUFR message.
subroutine upb(NVAL, NBITS, IBAY, IBIT)
THIS SUBROUTINE UNPACKS AND RETURNS A BINARY INTEGER CONTAINED WITHIN NBITS BITS OF IBAY...
subroutine parstr(STR, TAGS, MTAG, NTAG, SEP, LIMIT80)
THIS SUBROUTINE PARSES A STRING CONTAINING ONE OR MORE SUBSTRINGS INTO AN ARRAY OF SUBSTRINGS...
subroutine pkc(CHR, NCHR, IBAY, IBIT)
This subroutine encodes a character string within a specified number of bits of an integer array...
subroutine usrtpl(LUN, INVN, NBMP)
THIS SUBROUTINE STORES THE SUBSET TEMPLATE INTO INTERNAL SUBSET ARRAYS IN MODULE USRINT FOR CASES OF ...
subroutine getlens(MBAY, LL, LEN0, LEN1, LEN2, LEN3, LEN4, LEN5)
This subroutine reads the lengths of all of the individual sections of a given BUFR message...
This module contains array and variable declarations used to store the internal jump/link table...
subroutine status(LUNIT, LUN, IL, IM)
This subroutine checks whether a specified Fortran logical unit number is currently connected to the ...
subroutine parutg(LUN, IO, UTG, NOD, KON, VAL)
THIS SUBROUTINE PARSES A USER-SPECIFIED TAG (MNEMONIC) (UTG) THAT REPRESENTS A VALUE EITHER BEING DEC...
subroutine errwrt(STR)
This subroutine allows the user to specify a custom location for the logging of error and diagnostic ...
subroutine bort(STR)
This subroutine calls subroutine errwrt() to log an error message, then calls subroutine bort_exit() ...
This module contains array and variable declarations used to store BUFR messages internally for multi...
subroutine writlc(LUNIT, CHR, STR)
This subroutine writes a long character string (greater than 8 bytes) to a data subset.