program viz_shade C C --- This reads the output of the bundle modeler program and converts C --- the results to PV-Wave proceedure Shade.Pro C Common/cmn090/ iuntin Common/cmn091/ iuntout C Data iuntin, iuntout/2, 3/ C C --- open external files C call opnfls C C --- read the output file of the bundle model C call redout C C --- modify the data C call moddat C C --- write the graphics file C call wrtgrf C end Subroutine Opnfls C----------------------------------------------------------------------- C C Program unit: Opnfls C Description: Subroutine that opens input and output files C Coded: 8/2/95 C Modified Last: 8/2/95 C Common/cmn090/ iuntin Common/cmn091/ iuntout C Character*24 filein, fileout C write(*,*) 'Enter the bundle modeler output file name' read(*,'(A)') filein open(iuntin, FILE = filein, READONLY, STATUS = 'OLD') C open(iuntdsp, FILE = 'dsp.out', READONLY, STATUS = 'OLD') C open(iuntout, FILE = 'shd.dat', STATUS = 'NEW') C return end C --------------------------------------------------- subroutine redout C common/cmn090/ iuntin common /datstyp/ diam(10), bdiam(10), htap(10) common /datster/ istyp(100), xpos(100), zpos(100) common /datdsp/ xdisp(1000), ydisp(1000), zdisp(1000) common /datrot/ xrot(1000), zrot(1000) common /datnod/ ypos(1000), idster(1000) common /datscl/ nnode, ngnode, npar C character*80 phrase C C read stereocilia type data C do while (phrase .ne. 'Stereocilia Type Data') read (iuntin,10) phrase C write (*,*) phrase enddo read (iuntin,20) nstyp write (*,*) 'number of types:', nstyp C read(iuntin, 25) do i = 1, nstyp read (iuntin,*) idum, diam(i), bdiam(i), htap(i) C write (*,*) 'type ',idum enddo 10 format (a) 20 format (//9x, i3////) C 25 format (///) C C read stereocilia data C read (iuntin,30) nster write (*,*) 'Number of stereocilia', nster 30 format(////9x, i4////) do i = 1, nster read (iuntin,*) idum, istyp(i), xpos(i), zpos(i) C write (*,*) idum enddo C C --- read displacements C do while (phrase .ne. 'Results of FEA Analysis') read (iuntin,40) phrase C write (*,*) phrase enddo 40 format (a) read(iuntin, 50) in = 1 do is = 1, nster read(iuntin, 60) idone = 0 do while (idone .eq. 0) read (iuntin,*, IOSTAT = idone) 1 idum, ypos(in), xdisp(in), ydisp(in), zdisp(in), 2 zrot(in), xrot(in) C write (*,*) 'node ',idum, in idster(in) = is if (idone .eq. 0) in = in + 1 enddo write (*,*) in enddo nnode = in - 1 write (*, *) ypos 50 format(//) 60 format(////) return end subroutine moddat C --------------------------------------------------- call modnod call modnrm call modpar return end subroutine modnod C --------------------------------------------------- common /datscl/ nnode, ngnode, npar common /datstyp/ diam(10), bdiam(10), htap(10) common /datster/ istyp(100), xpos(100), zpos(100) common /datdsp/ xdisp(1000), ydisp(1000), zdisp(1000) common /datrot/ xrot(1000), zrot(1000) common /datnod/ ypos(1000), idster(1000) common/datgnod/ xg(8000), yg(8000), zg(8000) C data piover4 /0.785398164/ C ign = 0 Do i = 1, nnode alpha = 0.0 call getrad(i, rad) xnode = xpos(idster(i)) + xdisp(i) ynode = ypos(i) + ydisp(i) znode = zpos(idster(i)) + zdisp(i) do j = 1, 8 ign = ign + 1 xnode1 = xnode + rad*cos(alpha) znode1 = znode + rad*sin(alpha) xg((i-1)*8+j) = xnode1*cos(zrot(i)) yg((i-1)*8+j) = ynode + xnode1*sin(zrot(i)) + 1 znode1*sin(xrot(i)) zg((i-1)*8+j) = znode1*cos(xrot(i)) alpha = alpha + piover4 enddo enddo ngnode = nnode*8 return end C --------------------------------------------------- subroutine getrad(i, rad) C common /datnod/ ypos(1000), idster(1000) common /datstyp/ diam(10), bdiam(10), htap(10) common /datster/ istyp(100), xpos(100), zpos(100) C ist = istyp(idster(i)) if (ypos(i) .gt. htap(ist)) then rad = diam(ist)/2.0 else rad = (bdiam(ist) + 1 (diam(ist)-bdiam(ist))*ypos(i)/htap(ist))/2.0 endif C return end C --------------------------------------------------- subroutine modnrm C common /datnod/ ypos(1000), idster(1000) common /datscl/ nnode, ngnode, npar common/datnvec/ xn(8000), yn(8000), zn(8000) C npar = 0 do in = 1, nnode if (idster(in) .eq. idster(in + 1).and. in .ne. nnode) then do j = 1, 8 nodA = (in-1)*8 + j if (j .ne. 8) then nodB = nodA + 1 else nodB = (in-1)*8 + 1 endif nodC = nodA + 8 call crsvec(nodA, nodB, nodC, x1, x2, x3) npar = npar + 1 xn(npar) = x1 yn(npar) = x2 zn(npar) = x3 enddo else nodA = (in-1)*8 + 2 nodB = (in-1)*8 + 3 nodC = (in-1)*8 + 5 call crsvec(nodA, nodB, nodC, x1, x2, x3) npar = npar + 1 xn(npar) = x1 yn(npar) = x2 zn(npar) = x3 nodA = (in-1)*8 + 1 nodB = (in-1)*8 + 2 nodC = (in-1)*8 + 6 call crsvec(nodA, nodB, nodC, x1, x2, x3) npar = npar + 1 xn(npar) = x1 yn(npar) = x2 zn(npar) = x3 nodA = (in-1)*8 + 8 nodB = (in-1)*8 + 1 nodC = (in-1)*8 + 6 call crsvec(nodA, nodB, nodC, x1, x2, x3) npar = npar + 1 xn(npar) = x1 yn(npar) = x2 zn(npar) = x3 endif enddo C npar = npar - 1 return end C --------------------------------------------------- subroutine crsvec(nodA, nodB, nodC, x1, x2, x3) C C --- take the cross product of two vectors which C --- are defined by three node indices. C common/datgnod/ xg(8000), yg(8000), zg(8000) C xAB = xg(nodB) - xg(nodA) yAB = yg(nodB) - yg(nodA) zAB = zg(nodB) - zg(nodA) xAC = xg(nodC) - xg(nodA) yAC = yg(nodC) - yg(nodA) zAC = zg(nodC) - zg(nodA) x1 = yAC*zAB - zAC*yAB x2 = zAC*xAB - xAC*zAB x3 = xAC*yAB - yAC*xAB C return end C --------------------------------------------------- subroutine modpar common /datscl/ nnode, ngnode, npar common /datstyp/ diam(10), bdiam(10), htap(10) common /datster/ istyp(100), xpos(100), zpos(100) common /datnod/ ypos(1000), idster(1000) common/datnlst/ n1(8000), n2(8000), n3(8000), n4(8000) ipar = 0 do in = 1, nnode if (idster(in) .eq. idster(in + 1) .and. in .ne. nnode) then do i = 1, 8 ibase = (in-1)*8 + i - 1 ipar = ipar + 1 n1(ipar) = ibase n4(ipar) = ibase + 8 if (i .ne. 8) then n2(ipar) = ibase + 1 n3(ipar) = ibase + 9 else n2(ipar) = (in-1)*8 n3(ipar) = (in-1)*8 + 8 endif enddo else ibase = (in-1)*8 ipar = ipar + 1 n1(ipar) = ibase + 4 n2(ipar) = ibase + 3 n3(ipar) = ibase + 2 n4(ipar) = ibase + 1 ipar = ipar + 1 n1(ipar) = ibase + 5 n2(ipar) = ibase + 4 n3(ipar) = ibase + 1 n4(ipar) = ibase ipar = ipar + 1 n1(ipar) = ibase + 6 n2(ipar) = ibase + 5 n3(ipar) = ibase n4(ipar) = ibase + 7 endif enddo C return end subroutine wrtgrf C --------------------------------------------------- Common/cmn091/ iuntout Common/cmn092/ iuntnd common /datscl/ nnode, ngnode, npar common/datgnod/ xg(8000), yg(8000), zg(8000) common/datnvec/ xn(8000), yn(8000), zn(8000) common/datnlst/ n1(8000), n2(8000), n3(8000), n4(8000) C C --- write all verticess C write (iuntout, '(2i7)') Ngnode, Npar do indx = 1, Ngnode write (iuntout,'(3e11.3)') xg(indx), yg(indx), zg(indx) enddo C C --- write normal indices C nperpol = 4 do indx = 1, Npar write (iuntout,'(5i10)') nperpol, n1(indx), n2(indx), 1 n3(indx), n4(indx) enddo C C return end