C$$$ MAIN PROGRAM DOCUMENTATION BLOCK C C MAIN PROGRAM: CWORDSH C PRGMMR: KEYSER ORG: NP22 DATE: 2011-01-05 C C ABSTRACT: CONVERTS BINARY BYTE STREAM BUFR FILES BACK AND FORTH C FROM A FORTRAN BLOCKED FORMAT. C C PROGRAM HISTORY LOG: C 1999-08-19 J. WOOLLEN ORIGINAL VERSION FOR IMPLEMENTATION C 2004-03-19 D. KEYSER INCREASED SIZE OF ARRAY MBAY FROM 3000 WORDS C TO 5000 WORDS TO ALLOW IT TO PROCESS BUFR C MESSAGES WITH UP TO 20K BYTES C 2005-11-29 J. ATOR REWRITTEN USING BUFRLIB C I/O LOGIC TO HANDLE C ANY INPUT BUFR FILES (INCLUDING FILES WHICH C CONTAIN EXTRANEOUS CHARACTERS (E.G. BULLETIN C HEADERS) AND/OR WHICH PREVIOUSLY REQUIRED THE C USE OF APPLICATION PROGRAM GRABBUFR) AND TO C REMOVE DIRECT LINKS TO BUFRLIB COMMON BLOCKS C 2007-11-28 D. KEYSER INCREASED LIMIT FOR I/O FILENAME LENGTH FROM C 80 CHARACTERS TO 120 CHARACTERS C 2011-01-05 D. KEYSER INCREASED SIZE OF ARRAY MBAY FROM 37500 C 4-BYTE WORDS TO 625000 4-BYTE WORDS TO ALLOW C IT TO PROCESS BUFR MESSAGES WITH UP TO C 2.5 MBYTES (INSTEAD OF UP TO JUST 150K C BYTES); NOW PRINTS DIAGNOSTICS IF EITHER NO C INPUT MESSAGES WERE PROCESSED OR IF ONE OR C MORE INPUT MESSAGES WERE NOT PROCESSED (FOR C WHATEVER REASON); NOW LOOKS FOR SCRIPT C ENVIRONMENT VARIABLE "DX_SKIP" VIA CALL TO C GETENV, IF "YES" OR "yes" WILL NOT COPY BUFR C DICTIONARY (TABLE) MESSAGES TO OUTPUT WHEN C BLOCKING (BEFORE DICTIONARY MESSAGES WERE C ALWAYS COPIED) (DOES NOT APPLY TO UNBLOCKING, C DICTIONARY MESSAGES WILL CONTINUE TO BE C COPIED IN THIS CASE), THE DEFAULT (WHEN C "DX_SKIP" IS NOT FOUND) IS TO COPY DICTIONARY C MESSAGES WHEN BLOCKING (AS BEFORE) C C USAGE: C INPUT FILES: C UNIT 05 - STANDARD INPUT (OPERATION TYPE, INPUT FILENAME, C OUTPUT FILENAME) C C OUTPUT FILES: C UNIT 06 - STANDARD OUTPUT PRINT C UNIT 51 - BLOCKED FORTRAN FILE OUTPUT FOR BLOCKING OPERATION C C SUBPROGRAMS CALLED: C LIBRARY: C SYSTEM: - GETENV C W3LIB - W3TAGB W3TAGE ERREXIT C BUFRLIB - CCBFL COBFL CRBMG CWBMG PADMSG C IUPBS01 C C EXIT STATES: C COND = 0 - SUCCESSFUL RUN C = 8 - INCORRECT INPUT PARAMETER, NO OUTPUT FILE CREATED C C REMARKS: ONE SCRIPT ENVIRONMENT VARIABLE IS READ IN: C DX_SKIP - If = 'YES' or 'yes', then only non- C dictionary (i.e., non-table) BUFR C messages read in will be copied to C output when blocking (i.e., dictionary C messages will not be copied when C blocking). C - Otherwise (including if DX_SKIP is not C set), all BUFR messages read in C (including BUFR dictionary messages) C will be copied to output when blocking C -- this is the default C Note: This variable is currently not C invoked when this program is C unblocking BUFR messages, In this C case all BUFR messages read in C (including BUFR dictionary messages) C will be copied to output. C C C ATTRIBUTES: C LANGUAGE: FORTRAN 90 C MACHINE: NCEP CCS C C$$$ program cwordsh parameter(mxbufr=2500000) parameter(mxbufrd4=mxbufr/4) character*120 bfile,ufile character*8 cword character*3 dx_skip,dx_skip_ORIG character*1 bufr(mxbufr) dimension mbay(mxbufrd4) equivalence (bufr(1),mbay(1)) call w3tagb('CWORDSH',2011,0005,0332,'NP22') istop = 0 igo = 5 c Read and process the input arguments. call getenv('DX_SKIP',dx_skip) dx_skip_ORIG = dx_skip if(dx_skip_ORIG.EQ.' ') dx_skip = 'NO' read(5,'(a)') cword if(cword.eq.'block') then read(5,'(a)') ufile read(5,'(a)') bfile elseif(cword.eq.'unblk') then read(5,'(a)') bfile read(5,'(a)') ufile else print *,'cword must be block or unblk' call w3tage('CWORDSH') call errexit(8) endif c Open the input and output files. if(cword.eq.'block') then print *,'blocking from: ',ufile print *,' to: ',bfile call cobfl(ufile,'r') open(51,file=bfile,form='unformatted') else print *,'unblocking from: ',bfile print *,' to: ',ufile call cobfl(bfile,'r') call cobfl(ufile,'w') endif c Read the next message from the input file. call crbmg(bufr,mxbufr,nbyt,ierr) if(ierr.eq.-1) then print *,'Return value from crbmg is -1 on first BUFR message ', . 'read; input file is empty; no output file created.' go to 88 elseif(ierr.lt.-1) then print *,'Return value from crbmg is -2 on first BUFR message ', . 'read; I/O error reading first input BUFR message; no output', . ' file created.' go to 88 endif do while(ierr.ge.0) if(ierr.eq.0) then c Pad the end of the message with zeroed-out bytes up to the c next 8-byte boundary. call padmsg(mbay,mxbufrd4,npbyt) ntbyt = nbyt + npbyt c Write the message plus padding to the output file... if(cword.eq.'block') then c using a FORTRAN write (check value of dx_skip to see if c dictionary messages should be skipped in write). if(iupbs01(mbay,'MTYP').eq.11 .and. . (dx_skip.eq.'YES' .or. dx_skip.eq.'yes')) then print *,'BUFR dictionary (table) message read; ', . 'message not written to output because DX_SKIP is ', . 'set to "YES" or "yes".' else write(51) (bufr(i),i=1,ntbyt) igo = 0 endif else c using a C write. call cwbmg(bufr,ntbyt,ierw) if(ierw.ne.0) then print *,'return value from cwbmg is ',ierw,' - I/O ', . 'error occurred while writing; message not written ', . 'to output' istop = 4 else igo = 0 endif endif else if(ierr.eq.1) then print *,'return value from crbmg is 1 - BUFR message ', . 'array overflow, increase size of array; message not ', . 'written to output' elseif(ierr.eq.2) then print *,'return value from crbmg is 2 -"7777" ', . 'indicator not found in expected location; message not', . ' written to output' else print *,'return value from crbmg is ',ierr,'; message ', . 'not written to output' endif istop = 4 endif call crbmg(bufr,mxbufr,nbyt,ierr) enddo if(ierr.eq.-1) then print *,'done' elseif(ierr.lt.-1) then print *,'return value from crbmg is -2 - I/O error reading ', . 'input message; message not written to output' istop = 4 endif c Close the input and output files. call ccbfl if(cword.eq.'block') close(51) 88 continue if(cword.eq.'block') then if(igo.eq.5) then print *, '***WARNING: CWORDSH - No input BUFR messages ', . 'were blocked into output file - no output file created' else if(istop.eq.4) then print *, '***WARNING: CWORDSH - One or more input BUFR ', . 'messages could not be blocked into output file - output ', . 'file is incomplete' endif else if(igo.eq.5) then print *, '***WARNING: CWORDSH - No input BUFR messages ', . 'were unblocked into output file - no output file created' else if(istop.eq.4) then print *, '***WARNING: CWORDSH - One or more input BUFR ', . 'messages could not be unblocked into output file - ', . 'output file is incomplete' endif endif call w3tage('CWORDSH') stop end