c ***************************************************************************** program adhsv_strs c mnemonic: Adhesive Stress c c author : Farhad Tahmasebi, NASA/GSFC c c date : 02/19/96 c c revisions : 05/09/96 - FT - Allow no. of springs in the force c output set to be less than no. of springs in model. c c 06/24/96 - FT - Let user specify average area of the c plate elements used to represent the adherends. c c 11/27/96 - FT - Increased the dimension of arrays. c c purpose : Extracts adhesive XYZ spring (linear or non-linear) c ID's, corresponding adhesive grid ID's, and c corresponding coordinates from a NASTRAN input c file. Also, extracts spring forces from the c corresponding NASTRAN output file. Using the data c extracted from NASTRAN input and output files, c determines shear and normal stresses at the adhesive c grid points. Shear and normal stresses are then sorted c in descending order. Coordinates of adhesive grid c points and strains are written to plot files for c generating Mathematica scatter or carpet plots. Note c that adhesive grids and springs can be numbered in c any order. c c calls : sort_mgrid, sort_node, sort_spring, sort_strs c functions : sqrt, index, min c common blocks: none c ***************************************************************************** c23456789012345678901234567890123456789012345678901234567890123456789012 c implicit real*8 (a-h, o-z) character*32 infile !input file name character*132 line, prev_line integer ns1, ns2, ns3 !no. of x, y, and z springs integer ncnt !total no. of nodes in the model integer nspring !no. of springs in the force output set integer nlspring !no. of spring forces on an output line real*8 area !average area of plate elements logical read_err /.true./, more_data /.true./ c integer mgrid1 (50000) !min. grid ID for x springs integer mgrid2 (50000) !min. grid ID for y springs integer mgrid3 (50000) !min. grid ID for z springs c integer spring1 (50000) !x springs integer spring2 (50000) !y springs integer spring3 (50000) !z springs c integer node (70000) !all nodes in the model real*8 xn (70000) !x coord. of all nodes real*8 yn (70000) !y coord. of all nodes real*8 zn (70000) !z coord. of all nodes c real*8 xgrid (50000) !x coord. of adhesive grid points real*8 ygrid (50000) !y coord. of adhesive grid points real*8 zgrid (50000) !z coord. of adhesive grid points c integer nelem (70000) !springs in the force output set real*8 felem (70000) !output spring forces c real*8 f1 (50000) !forces of spring1 array real*8 f2 (50000) !forces in spring2 array real*8 f3 (50000) !forces in spring3 array c real*8 tau (50000) !node shear stresses real*8 sigma (50000) !node peel stresses c integer sprng_x (50000) !same as spring1 (needed for sorting stresses) integer sprng_y (50000) !same as spring2 (needed for sorting stresses) integer sprng_z (50000) !same as spring3 (needed for sorting stresses) c c-----GET INPUT FILE NAME. OPEN IT. write (6, *) write (6, *) 'This program reads a NASTRAN input file (normally' write (6, *) 'a .dat file) and its corresponding NASTRAN output' write (6, *) 'file (must be a .prt file). It generates a .tau' write (6, *) 'plot file, a .sigma plot file, and a .ad_strs' write (6, *) 'output file.' write (6, *) write (6, *) 'A file named area.element (all lower case) must' write (6, *) 'exist in the working directory from which the' write (6, *) 'program is invoked. The only data in the' write (6, *) 'area.element file must be the average area of the' write (6, *) 'plate elements used to represent the adherends.' write (6, *) dowhile (read_err) write (6, *) 'Enter NASTRAN input filename'// & ' (normally a .dat file).' read (5, 20) infile 20 format (a32) len_infile = index (infile, ' ') - 1 if (len_infile .le. 0) then write (6, *) 'Error in file name. Try again.' goto 35 endif c open (unit = 9, file=infile (1:len_infile), status='OLD', & readonly, err = 31, form = 'formatted') goto 45 31 write (6, *) 'Can not find file '//infile (1:len_infile)// & '. Try Again.' 35 enddo 45 write (6,*) 'Input File = '//infile (1:len_infile)//' opened.' c c-----FIND SPRING NOS., AND THEIR CORRESPONDING GRID ID'S. ns1 = 0 ns2 = 0 ns3 = 0 dowhile (more_data) read (9, 51, err = 8000, end = 75) line 51 format (a132) index_celas = index (line, 'CELAS') if (index_celas .ne. 0) then read (line (9:132), *) ispring, k_val, ig1, idof, ig2 if (idof .eq. 1) then ns1 = ns1 + 1 mgrid1 (ns1) = min (ig1, ig2) spring1 (ns1) = ispring elseif (idof .eq. 2) then ns2 = ns2 + 1 mgrid2 (ns2) = min (ig1, ig2) spring2 (ns2) = ispring elseif (idof .eq. 3) then ns3 = ns3 + 1 mgrid3 (ns3) = min (ig1, ig2) spring3 (ns3) = ispring else write (6, *) 'Error in spring component ID' goto 9999 endif endif enddo c c-----CHECK FOR ERROR IN NO. OF SPRINGS. 75 if ((ns1 .ne. ns2) .or. (ns1 .ne. ns3)) then write (6, *) 'Error in no. of x, y, or z springs.' goto 9999 endif c c-----SORT MATRICES OF ADHESIVE MIN. GRID ID'S. REARRANGE THE CORRESPONDING c-----MATRICES OF SPRING ID'S. call sort_ad_grid (ns1, mgrid1, spring1) call sort_ad_grid (ns2, mgrid2, spring2) call sort_ad_grid (ns3, mgrid3, spring3) c c-----FIND ALL NODES IN THE INPUT FILE AND THEIR COORDINATES. rewind 9 ncnt = 0 dowhile (more_data) read (9, 51, err = 8200, end = 89) line index_grid = index (line, 'GRID') if (index_grid .ne. 0) then ncnt = ncnt + 1 read (line (9:132), *) nodeid, icp, xc, yc, zc node (ncnt) = nodeid xn (ncnt) = xc yn (ncnt) = yc zn (ncnt) = zc endif enddo 89 close (unit = 9) c c-----SORT MATRIX OF NODES. REARRANGE CORRESPONDING XYZ MATRICES. call sort_node (ncnt, node, xn, yn, zn) c c-----GENERATE COORD. MATRICES FOR ADHESIVE GRIDS. icount = 1 do i = 1, ncnt if (icount .eq. ns1 + 1 ) goto 99 if (node (i) .eq. mgrid1 (icount)) then xgrid (icount) = xn (i) ygrid (icount) = yn (i) zgrid (icount) = zn (i) icount = icount + 1 endif enddo c c-----GET SPRING FORCES FROM THE CORRESPONDING NASTRAN OUTPUT FILE. 99 len_fn = index (infile, '.') - 1 open (unit = 10, file=infile (1:len_fn)//'.prt', & status='OLD', readonly, err = 110, form = 'formatted') goto 120 110 write (6, *) 'ERR:Can not find file '//infile (1:len_fn)//'.prt' goto 9999 120 write (6, *) 'Input File = '//infile (1:len_fn)//'.prt' & //' opened.' c c-----FIND BEGINNING OF SPRING FORCES. index_force = 0 dowhile (index_force .eq. 0) read (10, 51, err = 8400, end = 9000) line index_force = index (line, 'F O R C E S') enddo c c-----READ SPRING NUMBERS AND FORCES. nspring = 0 prev_line = line dowhile (more_data) read (10, 51, err = 8400, end = 9000) line c if (line .eq. prev_line) then more_data = .false. goto 135 endif prev_line = line c if (line (21:31) .eq. 'F O R C E S') then more_data = .false. goto 135 endif c if (line (1:4) .eq. '0***') then more_data = .false. goto 135 endif if (line (1:1) .eq. '0') goto 135 if (line (1:1) .eq. '1') goto 135 if (line (25:35) .eq. ' ') goto 135 if (line (31:41) .eq. 'F O R C E S') goto 135 if (line (7:13) .eq. 'ELEMENT') goto 135 c c--------DETERMINE NO. OF SPRINGS ON A LINE (NLSPRING). if (line (42:46) .eq. ' ' ) then nlspring = 1 elseif (line (75:79) .eq. ' ' ) then nlspring = 2 elseif (line (108:112) .eq. ' ' ) then nlspring = 3 else nlspring = 4 endif c c--------READ SPRING NUMBERS AND FORCES ON A LINE. read (line, *) (nelem (i), felem (i), & i = nspring + 1, nspring + nlspring) nspring = nspring + nlspring 135 enddo close (unit=10) c c-----SORT MATRIX OF SPRING ID'S. REARRANGE CORRESPONDING MATRIX OF c-----SPRING FORCES. call sort_spring (nspring, nelem, felem) c c-----SORT MATRICES OF SPRING ID'S. REARRANGE THE CORRESPONDING c-----MATRICES OF ADHESIVE MIN. GRID ID'S call sort_ad_grid (ns1, spring1, mgrid1) call sort_ad_grid (ns2, spring2, mgrid2) call sort_ad_grid (ns3, spring3, mgrid3) c c-----DETERMINE FORCES IN ADHESIVE SPRINGS. do i = 1, ns1 f1 (i) = 0.0 f2 (i) = 0.0 f3 (i) = 0.0 enddo c if ((3 * ns1) .le. nspring) then nmgrid1 = 1 nmgrid2 = 1 nmgrid3 = 1 do i = 1, nspring if (nelem (i) .eq. spring1 (nmgrid1)) then f1 (nmgrid1) = felem (i) nmgrid1 = nmgrid1 + 1 elseif (nelem (i) .eq. spring2 (nmgrid2)) then f2 (nmgrid2) = felem (i) nmgrid2 = nmgrid2 + 1 elseif (nelem (i) .eq. spring3 (nmgrid3)) then f3 (nmgrid3) = felem (i) nmgrid3 = nmgrid3 + 1 endif if (nmgrid1 .eq. (ns1 + 1) .and. nmgrid2 .eq. (ns2 + 1) & .and. nmgrid3 .eq. (ns3 + 1)) goto 160 enddo else low1 = 1 low2 = 1 low3 = 1 do i = 1, nspring do j = low1, ns1 if (nelem (i) .eq. spring1 (j)) then f1 (j) = felem (i) low1 = j + 1 goto 145 endif enddo do j = low2, ns1 if (nelem (i) .eq. spring2 (j)) then f2 (j) = felem (i) low2 = j + 1 goto 145 endif enddo do j = low3, ns1 if (nelem (i) .eq. spring3 (j)) then f3 (j) = felem (i) low3 = j + 1 goto 145 endif enddo 145 enddo endif c c-----READ IN AVERAGE AREA OF THE PLATE ELEMENTS USED TO REPRESENT THE c-----ADHERENDS. 160 open (unit = 11, file='area.element', status='OLD', readonly, & err = 165, form = 'formatted') goto 170 165 write (6, *) 'ERR:Can not find file area.element' goto 9999 170 write (6, *) 'Input File area.element opened.' read (11, *) area close (unit = 11) if (area .eq. 0.0) then write (6, *) 'ERR: Average area of plate elments = 0.' goto 9999 endif c c-----OPEN OUTPUT FILE. PRINT OUT INTERMIDIATE RESULTS. open (unit=19, file=infile (1:len_fn) //'.ad_strs', & status='UNKNOWN', form = 'formatted') write (6, *) 'Output File = '//infile (1:len_fn)//'.ad_strs' c write (19, 180) nspring, ns1 180 format (' No. of springs = ', i9, '. No. of points = ', i9) c c-----CALCULATE SHEAR AND PEEL STRESSES. PRINT OUT RESULTS. do i = 1, ns1 tau (i) = sqrt (f1 (i) ** 2 + f2 (i) ** 2) / area sigma (i) = f3 (i) / area if (tau (i) .ne. 0.0) then write (19, 200) spring1 (i), spring2 (i), spring3 (i), & tau (i), sigma (i) 200 format (' Springs: ', 3 (i5, 1x), ' => Tau= ', f14.4, & ', and Sigma= ', f14.4) endif enddo c c-----OPEN PLOT DATA FILES. PRINT OUT STRESSES FOR PLOTTING. open (unit=29, file=infile (1:len_fn) //'.tau', & status='UNKNOWN', form = 'formatted') write (6, *) 'Shear Plot File = '//infile (1:len_fn)//'.tau' c open (unit=39, file=infile (1:len_fn) //'.sigma', & status='UNKNOWN', form = 'formatted') write (6, *) 'Peel Plot File = '//infile (1:len_fn)//'.sigma' c do i = 1, ns1 if (tau (i) .ne. 0.0) then write (29, 240) xgrid (i), ygrid (i), tau (i) write (39, 240) xgrid (i), ygrid (i), sigma (i) 240 format (3(f14.4,1x)) endif enddo c close (29) close (39) c c-----SORT SHEAR AND PEEL STRESSES. WRITE THEM TO THE OUTPUT FILE. do i = 1, ns1 sprng_x (i) = spring1 (i) sprng_y (i) = spring2 (i) sprng_z (i) = spring3 (i) enddo c call sort_strs (ns1, tau, sprng_x, sprng_y, sprng_z) call sort_strs (ns1, sigma, spring1, spring2, spring3) c write (19, *) '******** SORTED SHEAR STRESSES **********' do i = 1, ns1 if (tau (i) .ne. 0.0) then write (19, 740) sprng_x (i), sprng_y (i), sprng_z (i), & tau (i) 740 format (' Springs: ', 3 (i5, 1x), ' => Tau= ', f14.4) endif enddo c write (19, *) '******** SORTED PEEL STRESSES **********' do i = 1, ns1 if (sigma (i) .ne. 0.0) then write (19, 760) spring1 (i), spring2 (i), spring3 (i), & sigma (i) 760 format (' Springs: ', 3 (i5, 1x), ' => Sigma= ', f14.4) endif enddo close (19) goto 9999 c c-----INPUT ERROR MESSAGES. 8000 write (6, *) ' Error in reading NASTRAN input file (1st pass).' close (unit=9) goto 9999 8200 write (6, *) ' Error in reading NASTRAN input file (2nd pass).' close (unit=9) goto 9999 8400 write (6, *) ' Error in reading NASTRAN output file.' close (unit=10) goto 9999 c 9000 write (6, *) ' Unexpected end of input file!' close (unit=9) c 9999 end c ***************************************************************************** subroutine sort_ad_grid (ngrids, array1, array2) c mnemonic: Sort Adhesive Grids c c author : Farhad Tahmasebi, NASA/GSFC c c date : 4/9/96 c c revisions : c c arguments : ngrids - integer c no. of grids c input to subroutine c c array1 - integer c array to be sorted c input to & output from subroutine c c array2 - integer c array to be rearranged c input to & output from subroutine c c purpose : Sort (in ascending order) elements of array1. c Rearrange elements of array2. These arrays contain c end grid (or spring) ID's for the adhesive springs. c c calls : none c functions : none c common blocks: none c ***************************************************************************** integer ngrids integer array1 (1), array2 (1) c do j = 1, ngrids - 1 do i = j + 1, ngrids if (array1 (i) .lt. array1 (j)) then ihold = array1 (i) array1 (i) = array1 (j) array1 (j) = ihold c ihold1 = array2 (i) array2 (i) = array2 (j) array2 (j) = ihold1 endif enddo enddo c return end c ***************************************************************************** subroutine sort_node (nnode, node, tx, ty, tz) c mnemonic: Sort Nodes c c author : Farhad Tahmasebi, NASA/GSFC c c date : 4/9/96 c c revisions : c c arguments : nnode - integer c no. of nodes c input to subroutine c c node - integer c array of low node ID's c input to & output from subroutine c c tx - real*8 c array of X translations or X coordinates c input to & output from subroutine c c ty - real*8 c array of Y translations or Y coordinates c input to & output from subroutine c c tz - real*8 c array of Z translations or Z coordinates c input to & output from subroutine c c purpose : Sort (in ascending order) node ID's in array node. c Rearrange elements of arrays tx, ty, and tz c (node translations in XYZ directions). c c calls : none c functions : none c common blocks: none c ***************************************************************************** implicit real*8 (a-h, o-z) integer nnode, node (1) real*8 tx (1), ty (1), tz (1) c do j = 1, nnode - 1 do i = j + 1, nnode if (node (i) .lt. node (j)) then ihold = node (i) node (i) = node (j) node (j) = ihold c hold1 = tx (i) tx (i) = tx (j) tx (j) = hold1 c hold2 = ty (i) ty (i) = ty (j) ty (j) = hold2 c hold3 = tz (i) tz (i) = tz (j) tz (j) = hold3 endif enddo enddo return end c ***************************************************************************** subroutine sort_spring (nsprng, id_sprng, f_sprng) c mnemonic: Sort Adhesive Grids c c author : Farhad Tahmasebi, NASA/GSFC c c date : 4/17/96 c c revisions : c c arguments : nsprng - integer c no. of springs c input to subroutine c c id_sprng - integer c array of spring ID's c input to & output from subroutine c c f_sprng - real*8 c array of spring forces c input to & output from subroutine c c purpose : Sort (in ascending order) spring ID's in array c id_sprng. Rearrange elements of array f_sprng. c c calls : none c functions : none c common blocks: none c ***************************************************************************** implicit real*8 (a-h, o-z) integer nsprng, id_sprng (1) real*8 f_sprng (1) c do j = 1, nsprng - 1 do i = j + 1, nsprng if (id_sprng (i) .lt. id_sprng (j)) then ihold = id_sprng (i) id_sprng (i) = id_sprng (j) id_sprng (j) = ihold c hold = f_sprng (i) f_sprng (i) = f_sprng (j) f_sprng (j) = hold endif enddo enddo c return end c ***************************************************************************** subroutine sort_strs (npoint, stress, sprng1, sprng2, sprng3) c mnemonic: Sort Strains c c author : Farhad Tahmasebi, NASA/GSFC c c date : 4/17/96 c c revisions : c c arguments : npoint - integer c no. of adhesive points c input to subroutine c c stress - real*8 c array of strain values c input to & output from subroutine c c sprng1 - integer c array of x spring ID's c input to & output from subroutine c c sprng2 - integer c array of y spring ID's c input to & output from subroutine c c sprng3 - integer c array of z spring ID's c input to & output from subroutine c c purpose : Sort (in descending order) stress values at adhesive c grids. Rearrange elements of arrays sprng1, sprng2, c and sprng3. c c calls : none c functions : none c common blocks: none c ***************************************************************************** implicit real*8 (a-h, o-z) integer npoint, sprng1 (1), sprng2 (1), sprng3 (1) real*8 stress (1) c do j = 1, npoint - 1 do i = j + 1, npoint if (stress (i) .gt. stress (j)) then hold = stress (i) stress (i) = stress (j) stress (j) = hold c ihold1 = sprng1 (i) sprng1 (i) = sprng1 (j) sprng1 (j) = ihold1 c ihold2 = sprng2 (i) sprng2 (i) = sprng2 (j) sprng2 (j) = ihold2 c ihold3 = sprng3 (i) sprng3 (i) = sprng3 (j) sprng3 (j) = ihold3 endif enddo enddo return end