c ***************************************************************************** program adhsv_strn c mnemonic: Adhesive Strain c c author : Farhad Tahmasebi, NASA/GSFC c c date : 04/02/96 c c revisions : 06/24/96 - FT - Let user specify thickness of the c adhesive. 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 grid displacements from the c corresponding NASTRAN output file. Using the data c extracted from NASTRAN input and output files, c determines shear and normal strains at the adhesive c grid points. Shear and normal strains 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_ad_grid, sort_node, sort_strn c functions : sqrt, index c common blocks: none c ***************************************************************************** c23456789012345678901234567890123456789012345678901234567890123456789012 c implicit real*8 (a-h, o-z) character*32 infile !input file name character*132 line integer npnt !no. of adhesive grids integer ncnt !total no. of nodes in the model integer nnode !no. of nodes in displacement output set real*8 ad_t !adhesive thickness logical read_err /.true./, more_data /.true./ c integer lgrid1 (50000) !low (first) grids for x springs integer hgrid1 (50000) !high (second) grids for x 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 real*8 t1 (70000) !x translation of node array real*8 t2 (70000) !y translation of node array real*8 t3 (70000) !z translation of node array c real*8 lt1 (50000) !x translation of lgrid1 array real*8 lt2 (50000) !y translation of lgrid1 array real*8 lt3 (50000) !z translation of lgrid1 array real*8 ht1 (50000) !x translation of hgrid1 array real*8 ht2 (50000) !y translation of hgrid1 array real*8 ht3 (50000) !z translation of hgrid1 array c real*8 del1 (50000) !deformations of x springs real*8 del2 (50000) !deformations of y springs real*8 del3 (50000) !deformations of z springs c real*8 gamma (50000) !shear strains real*8 epsilon (50000) !normal strains c integer lgridx (50000) !same as lgrid1 (needed for sorting strains) integer hgridx (50000) !same as hgrid1 (needed for sorting strains) 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 .gamma' write (6, *) 'plot file, a .epsilon plot file, and a .ad_strn' write (6, *) 'output file.' write (6, *) write (6, *) 'A file named t.adhesive (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, *) 't.adhesive file must be the thickness of the' write (6, *) 'adhesive.' 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. npnt = 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 npnt = npnt + 1 lgrid1 (npnt) = ig1 hgrid1 (npnt) = ig2 endif endif enddo c c-----SORT MATRIX OF ADHESIVE LOWER GRID ID'S. REARRANGE THE CORRESPONDING c-----MATRIX OF HIGHER GRID ID'S. 75 call sort_ad_grid (npnt, lgrid1, hgrid1) 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. npnt + 1 ) goto 99 if (node (i) .eq. lgrid1 (icount)) then xgrid (icount) = xn (i) ygrid (icount) = yn (i) zgrid (icount) = zn (i) icount = icount + 1 endif enddo c c-----GET NODE DISPLACEMENTS 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 NODE DISPLACEMENTS. index_disp = 0 dowhile (index_disp .eq. 0) read (10, 51, err = 8400, end = 9000) line index_disp = index (line, 'D I S P') enddo c c-----READ OUTPUT NODE ID'S AND XYZ DISPLACEMENTS. nnode = 0 dowhile (more_data) read (10, 51, err = 8400, end = 140) line if (line (19:22) .eq. 'GRID') then nnode = nnode + 1 read (line (1:18), *) node (nnode) read (line (23:132), *) t1 (nnode), t2 (nnode), t3 (nnode) endif enddo 140 close (unit=10) c c-----SORT MATRIX OF NODES. REARRANGE CORRESPONDING XYZ MATRICES. call sort_node (nnode, node, t1, t2, t3) c c-----DETERMINE DISPLACEMENTS OF SPRING GRIDS. nlgrid = 1 nhgrid = 1 do i = 1, nnode if (node (i) .eq. lgrid1 (nlgrid)) then lt1 (nlgrid) = t1 (i) lt2 (nlgrid) = t2 (i) lt3 (nlgrid) = t3 (i) nlgrid = nlgrid + 1 elseif (node (i) .eq. hgrid1 (nhgrid)) then ht1 (nhgrid) = t1 (i) ht2 (nhgrid) = t2 (i) ht3 (nhgrid) = t3 (i) nhgrid = nhgrid + 1 endif if (nlgrid .eq. (npnt + 1) .and. nhgrid .eq. (npnt + 1)) & goto 160 enddo c c-----DETERMINE SPRING DEFORMATIONS. 160 do i = 1, npnt del1 (i) = ht1 (i) - lt1 (i) del2 (i) = ht2 (i) - lt2 (i) del3 (i) = ht3 (i) - lt3 (i) enddo c c-----READ IN ADHESIVE THICKNESS. open (unit = 11, file='t.adhesive', status='OLD', readonly, & err = 165, form = 'formatted') goto 170 165 write (6, *) 'ERR:Can not find file t.adhesive' goto 9999 170 write (6, *) 'Input File t.adhesive opened.' read (11, *) ad_t close (unit = 11) if (ad_t .eq. 0.0) then write (6, *) 'ERR: Adhesive thickness = 0.' goto 9999 endif c c-----OPEN OUTPUT FILE. PRINT OUT INTERMIDIATE RESULTS. open (unit=19, file=infile (1:len_fn) //'.ad_strn', & status='UNKNOWN', form = 'formatted') write (6, *) 'Output File = '//infile (1:len_fn)//'.ad_strn' c write (19, 180) npnt 180 format (' No. of spring grids = ', i9) c c-----CALCULATE SHEAR AND PEEL STRAINS. PRINT OUT RESULTS. do i = 1, npnt gamma (i) = sqrt (del1 (i) ** 2 + del2 (i) ** 2) / ad_t epsilon (i) = del3 (i) / ad_t write (19, 200) lgrid1 (i), hgrid1 (i), gamma (i), & epsilon (i) 200 format (' Grids: ', 2 (i5,1x), ' => Gamma= ', f14.4, & ', and Epsilon= ', f14.4) enddo c c-----OPEN PLOT DATA FILES. PRINT OUT STRAINS FOR PLOTTING. open (unit=29, file=infile (1:len_fn) //'.gamma', & status='UNKNOWN', form = 'formatted') write (6, *) 'Shear Plot File = '//infile (1:len_fn)//'.gamma' c open (unit=39, file=infile (1:len_fn) //'.epsilon', & status='UNKNOWN', form = 'formatted') write (6, *) 'Peel Plot File = '//infile (1:len_fn)//'.epsilon' c do i = 1, npnt write (29, 240) xgrid (i), ygrid (i), gamma (i) write (39, 240) xgrid (i), ygrid (i), epsilon (i) 240 format (3(f14.4,1x)) enddo c close (29) close (39) c c-----SORT SHEAR AND PEEL STRAINS. WRITE THEM TO OUTPUT FILE. do i = 1, npnt lgridx (i) = lgrid1 (i) hgridx (i) = hgrid1 (i) enddo c call sort_strn (npnt, gamma, lgridx, hgridx) call sort_strn (npnt, epsilon, lgrid1, hgrid1) c write (19, *) '******** SORTED SHEAR STRAINS **********' do i = 1, npnt write (19, 740) lgridx (i), hgridx (i), gamma (i) 740 format (' Grids: ', 2 (i5, 1x), '=> Gamma= ', f14.4) enddo c write (19, *) '******** SORTED PEEL STRAINS **********' do i = 1, npnt write (19, 760) lgrid1 (i), hgrid1 (i), epsilon (i) 760 format (' Grids: ', 2 (i5, 1x), '=> Epsilon= ', f14.4) 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, lgrid, hgrid) 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 lgrid - integer c array of low grid ID's c input to & output from subroutine c c hgrid - integer c array of high grid (or spring) ID's c input to & output from subroutine c c purpose : Sort (in ascending order) grid ID's in array lgrid. c Rearrange elements of array hgrid. 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 lgrid (1), hgrid (1) c do j = 1, ngrids - 1 do i = j + 1, ngrids if (lgrid (i) .lt. lgrid (j)) then ihold = lgrid (i) lgrid (i) = lgrid (j) lgrid (j) = ihold c ihold1 = hgrid (i) hgrid (i) = hgrid (j) hgrid (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_strn (npoint, strain, lgrid, hgrid) c mnemonic: Sort Strains c c author : Farhad Tahmasebi, NASA/GSFC c c date : 4/9/96 c c revisions : c c arguments : npoint - integer c no. of adhesive points c input to subroutine c c strain - real*8 c array of strain values c input to & output from subroutine c c lgrid - integer c array of low grid ID's c input to & output from subroutine c c hgrid - integer c array of high grid ID's c input to & output from subroutine c c purpose : Sort (in descending order) strain values at adhesive c grids. Rearrange elements of arrays lgrid and hgrid. c These arrays contain end grid ID's for the adhesive c springs. c c calls : none c functions : none c common blocks: none c ***************************************************************************** implicit real*8 (a-h, o-z) integer npoint, lgrid (1), hgrid (1) real*8 strain (1) c do j = 1, npoint - 1 do i = j + 1, npoint if (strain (i) .gt. strain (j)) then hold = strain (i) strain (i) = strain (j) strain (j) = hold c ihold1 = lgrid (i) lgrid (i) = lgrid (j) lgrid (j) = ihold1 c ihold2 = hgrid (i) hgrid (i) = hgrid (j) hgrid (j) = ihold2 endif enddo enddo c return end