C---------------------------------------------------------------------- subroutine ftwrit(ounit,nrec,length,pbuff,status) C lowest-level routine to write a physical buffer to the disk file C ounit i Fortran unit number to write to C nrec i number of the file record to write C length i number of bytes to write C pbuff i number of the physical buffer to write from C status i output error status integer ounit,nrec,length,pbuff,status C COMMON BLOCK DEFINITIONS:-------------------------------------------- integer nb,ne parameter (nb = 20) parameter (ne = 512) integer bufnum,chdu,hdutyp,maxhdu,hdstrt,hdend,nxthdr,dtstrt integer nxtfld logical wrmode common/ft0001/bufnum(199),chdu(nb),hdutyp(nb),maxhdu(nb), & wrmode(nb),hdstrt(nb,ne),hdend(nb),nxthdr(nb),dtstrt(nb),nxtfld integer buflun,currnt,reclen,bytnum,maxrec common/ftlbuf/buflun(nb),currnt(nb),reclen(nb), & bytnum(nb),maxrec(nb) C have to use separate character arrays because of compiler limitations character*2880 b1,b2,b3,b4,b5,b6,b7,b8,b9,b10,b11,b12,b13,b14, & b15,b16,b17,b18,b19,b20 common /ftbuff/b1,b2,b3,b4,b5,b6,b7,b8,b9,b10,b11,b12,b13,b14, & b15,b16,b17,b18,b19,b20 C END OF COMMON BLOCK DEFINITIONS----------------------------------- integer ibuff C Note: performance testing on a SUN showed that writing a C c*2888 string was MUCH (11x) faster than writing a C*1(2880) array C with write(...)(b1(i),i=1,2880). It was also 2-3 times faster C than if the array was declared as a double and written with C write(...)(darray(i),i=1,360). The VAX took about the same C time for all 3 different ways to write the bytes. ibuff=bufnum(ounit) C Save maximum record written, for comparison in ftread maxrec(ibuff) = max(maxrec(ibuff), nrec) go to (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18, & 19,20)pbuff C if got here, then pbuff is out of range status=101 return 1 write(ounit,rec=nrec,err=900)b1(1:length) return 2 write(ounit,rec=nrec,err=900)b2(1:length) return 3 write(ounit,rec=nrec,err=900)b3(1:length) return 4 write(ounit,rec=nrec,err=900)b4(1:length) return 5 write(ounit,rec=nrec,err=900)b5(1:length) return 6 write(ounit,rec=nrec,err=900)b6(1:length) return 7 write(ounit,rec=nrec,err=900)b7(1:length) return 8 write(ounit,rec=nrec,err=900)b8(1:length) return 9 write(ounit,rec=nrec,err=900)b9(1:length) return 10 write(ounit,rec=nrec,err=900)b10(1:length) return 11 write(ounit,rec=nrec,err=900)b11(1:length) return 12 write(ounit,rec=nrec,err=900)b12(1:length) return 13 write(ounit,rec=nrec,err=900)b13(1:length) return 14 write(ounit,rec=nrec,err=900)b14(1:length) return 15 write(ounit,rec=nrec,err=900)b15(1:length) return 16 write(ounit,rec=nrec,err=900)b16(1:length) return 17 write(ounit,rec=nrec,err=900)b17(1:length) return 18 write(ounit,rec=nrec,err=900)b18(1:length) return 19 write(ounit,rec=nrec,err=900)b19(1:length) return 20 write(ounit,rec=nrec,err=900)b20(1:length) return C come here if there was a disk write error of some sort 900 status=106 end