#!/bin/sh # ------------------------------------------------------------------------ # This script will fortran block or unblock BUFR files on a number of # standard computing platforms. Stictly speaking, real BUFR files are # unblocked, that is, a byte stream containing only allowable BUFR # constructs. On some platforms it is advantagous to use the fortran # blocked structure for i/o efficiency, and on some platforms, when # using fortran i/o, the blocked structure is almost unavoidable. # NOTE: The script is set up to run in the Bourne shell. If you are a # C-shell user, enter 'sh ./cwordsh'. # ------------------------------------------------------------------------ if [ $# -lt 4 ] then echo " Enter the following input parameters: 1 - path/name of blocked BUFR file 2 - path/name of pure byte stream BUFR file 3 - Conversion control (block or unblk) 4 - Platform type (sgi,hp,sun,cray) " exit fi set -eua; mkdir dummy; cd dummy # set parameters here for particular case # --------------------------------------- # BFILE - fortran blocked bufr file to be read or created (path/filename) # UFILE - pure byte stream bufr file to be read or created (path/filename) # CWORD - 'block' or 'unblk' controls the program operation # CPLAT - platform type (sgi,hp,sun,cray,etc) # ------------------------------------------------------------------------ BFILE=$1 UFILE=$2 CWORD=$3 CPLAT=$4 # different platforms use different link name protocols # ----------------------------------------------------- if [ $CPLAT = sgi ] then openrb=openrb_ openwb=openwb_ crdbfr=crdbufr_ cwrbfr=cwrbufr_ lenmsg=lenm_ cc=cc; ff=f77 elif [ $CPLAT = sun ] then openrb=openrb_ openwb=openwb_ crdbfr=crdbufr_ cwrbfr=cwrbufr_ lenmsg=lenm_ cc=cc; ff=f77 elif [ $CPLAT = hp ] then openrb=openrb openwb=openwb crdbfr=crdbufr cwrbfr=cwrbufr lenmsg=lenm cc=cc; ff=f77 elif [ $CPLAT = cray ] then openrb=OPENRB openwb=OPENWB crdbfr=CRDBUFR cwrbfr=CWRBUFR lenmsg=LENM cc=cc; ff=cf77 elif [ $CPLAT = ibm ] then openrb=openrb openwb=openwb crdbfr=crdbufr cwrbfr=cwrbufr lenmsg=lenm cc=cc; ff=f77 fi # compile the c part of the program # --------------------------------- cat <ccwords.c; $cc -c ccwords.c #include FILE *pb; void $openrb () { pb = fopen( "$UFILE", "rb" ); } void $openwb () { pb = fopen( "$UFILE", "wb" ); } int $crdbfr (bufr) int *bufr; { int nwrd; int nb; nb = sizeof(bufr); if((nwrd=fread(bufr,nb,8/nb,pb))!=0) { nwrd = $lenmsg(bufr); fread(bufr+8/nb,nb,nwrd-8/nb,pb); return nwrd; } else return -1; } int $cwrbfr (bufr) int *bufr; { int nwrd; int nb; nb = sizeof(bufr); nwrd = $lenmsg(bufr); fwrite(bufr,nb,nwrd,pb); } eof # compile the fortran part of the program # --------------------------------------- cat <fcwords.f; $ff -c fcwords.f 2> $ff.out program fcwords character*8 cword character*64 bf, uf dimension mbay(3000) integer crdbufr,cwrbufr call wrdlen cword = '$CWORD' bf = '$BFILE' uf = '$UFILE' open(8,file=bf,form='unformatted') if(cword.eq.'block') then print*,"blocking ",uf," to ", bf, " on $CPLAT" call openrb() print*,"--openrb done" do while(crdbufr(mbay).ge.0) iwt = fwrbufr(mbay) print*,"--openrb iwt", iwt enddo stop endif if(cword.eq.'unblk') then print*,"unblocking ", bf, " to ", uf, "on $CPLAT" call openwb() do while(frdbufr(mbay).ge.0) iwt = cwrbufr(mbay) enddo stop endif stop end c----------------------------------------------------------------------- function frdbufr(mbay) common /hrdwrd/ nb,nbitw,nrev,iord(8) dimension mbay(*) read(8,end=100) (mbay(i),i=1,8/nb),(mbay(i),i=1+8/nb,lenm(mbay)) frdbufr = 0 return 100 frdbufr = -1 end c----------------------------------------------------------------------- function fwrbufr(mbay) dimension mbay(*) write(8) (mbay(i),i=1,lenm(mbay)) fwrbufr = 0 return end c----------------------------------------------------------------------- function lenm(mbay) common /hrdwrd/ nb,nbitw,nrev,iord(8) dimension mbay(*) lenm = (1+iupb(mbay,5,24)/8)*8/nb return end c---------------------------------------------------------------------- function iupb(ibay,nbyt,nbits) common /hrdwrd/ nbytw,nbitw,nrev,iord(8) dimension ibay(*) ibit = (nbyt-1)*8 nwd = (ibit)/nbitw+1 nbt = mod(ibit,nbitw) int = ishft(irev(ibay(nwd)),nbt) int = ishft(int,nbits-nbitw) lbt = nbt+nbits if(lbt.gt.nbitw) jnt = irev(ibay(nwd+1)) if(lbt.gt.nbitw) int = ior(int,ishft(jnt,lbt-2*nbitw)) iupb = int return end c---------------------------------------------------------------------- function irev(n) common /hrdwrd/ nbytw,nbitw,nrev,iord(8) character*8 cint,dint equivalence(cint,int) equivalence(dint,jnt) if(nrev.eq.0) then irev = n else int = n do i=1,nbytw dint(i:i) = cint(iord(i):iord(i)) enddo irev = jnt endif return end c----------------------------------------------------------------------- subroutine wrdlen common /hrdwrd/ nbytw,nbitw,nrev,iord(8) character*8 cint,dint equivalence (cint,int) equivalence (dint,jnt) c----------------------------------------------------------------------- c----------------------------------------------------------------------- c count the bits in a word - max 64 allowed c ----------------------------------------- int = 1 do i=1,65 int = ishft(int,1) if(int.eq.0) goto 10 enddo 10 if(i.ge.65) goto 900 if(mod(i,8).ne.0) goto 901 nbitw = i nbytw = i/8 c index the byte storage order - high byte to low byte c ----------------------------------------------------- jnt = 0 do i=1,nbytw int = ishft(1,(nbytw-i)*8) do j=1,nbytw if(cint(j:j).ne.dint(j:j)) goto 20 enddo 20 if(j.gt.nbytw) goto 902 iord(i) = j enddo c set the noreverse flag - 0=noreverse;1=reverse c ---------------------------------------------- nrev = 0 do i=1,nbytw if(iord(i).ne.i) nrev = 1 enddo c show the results c ---------------- print100,nbytw,nbitw,nrev,(iord(i),i=1,nbytw) 100 format('wrdlen:nbytw=',i1,' nbitw=',i2,' irev=',i1,' iord=',8i1) return 900 print *, 'wrdlen - a word is more than 64 bits' 901 print *, 'wrdlen - a word is not made of bytes' 902 print *, 'wrdlen - byte order checking mistake' STOP end eof # load the executable and go - cleanup when done # ---------------------------------------------- $ff -o cwords.x fcwords.o ccwords.o; cd ..; dummy/cwords.x; /bin/rm -rf dummy