integer*2 function iuic(ibuf,uicend) C C This function keeps a list of UICs C real*4 uics(50) integer*2 uicend,uic,iuic,termid,uic3(2),ibuf(1) common uics equivalence (uictrm,uic3) c uic=ibuf(5) termid=ibuf(7) c c setup combined uic/termid doubleword for lookup c uic3(1)=uic uic3(2)=termid c if (uic.eq.0) goto 4 !bad uic given c if (uicend.eq.0) goto 2 !first uic in our list c do 1 j=1,uicend !loop for each uic in our list if (uics(j).eq.uictrm)goto 3 !see if the uic is in our list 1 continue c 2 uicend= uicend+1 !bump number of items in list uics(uicend)= uictrm !enter the uic in the list iuic= uicend !return the pointer return c 3 iuic= j !return the pointer return 4 iuic= 0 !return bad uic flag return end subroutine daybeg(ibuf,date,ok) c c This routine compares two dates c integer*2 ibuf(1),date(1) logical*1 ok c if(ibuf(5)-date(3))2,3,1 3 if(ibuf(6)-date(2))2,4,1 4 if(ibuf(7).lt.date(1))goto 2 1 ok=.true. return 2 ok=.false. end subroutine dayend(ibuf,date,ok) c c This routine compares two dates c integer*2 ibuf(1),date(1) logical*1 ok c if(ibuf(5)-date(3))2,3,1 3 if(ibuf(6)-date(2))2,4,1 4 if(ibuf(7).le.date(1))goto 2 1 ok=.false. return 2 ok=.true. return end subroutine copy(in,out,num) c c This routine copys integer arrays c integer*2 in(1),out(1) c do 1 j=1,num out(j)=in(j) 1 continue return end subroutine notequ(in,out,equal) c c This routine compares 3 sequential words c integer*2 in(1),out(1) logical*1 equal c do 1 j=1,3 if(in(j).ne.out(j))goto 2 1 continue equal=.true. return 2 equal=.false. return end subroutine wide(in,out) C C This routine converts a positive double word integer to a REAL*4 C integer*2 in(2) real*4 out C i= in(2) if (i.lt.0) goto 1 !least sig. word <0 so we mustconvert it out= float(i) !convert to R*4 goto 2 1 i= ishft(i,1) !clear sign bit i= ishft(i,-1) !clear sign bit out= float(i)+32768. !convert to R*4 and add offset 2 out= out+(float(in(1))*131072.) !add offset from most sig. word return end