$
$     THIS ALTER IS CONFIDENTIAL AND A TRADE SECRET OF THE 
$     MSC.Software CORP.  THE RECEIPT OR POSSESSION OF
$     THIS ALTER DOES NOT CONVEY ANY RIGHTS TO REPRODUCE OR
$     DISCLOSE ITS CONTENTS, OR TO MANUFACTURE, USE, OR SELL
$     ANYTHING HEREIN, IN WHOLE OR IN PART, WITHOUT THE 
$     SPECIFIC WRITTEN CONSENT OF THE MSC.Software CORPORATION.                                
$
$
$    updated 7-1-97
$
$echooff $
$
$
$        mica.v69 -  updated for v69 -- 9-25-96
$
$  updated for system built on on 3-14-95   VERSION 68.2 
$  updated to replace second eigenvalue solution by orthogonalization
$
$ DMAP ALTER FOR INITIAL CONDITIONS IN MODAL TRANSIENT
$  FOR STRUCTURED SOL 112
$
$ based on 1991 WUC paper "A Method to Apply Initial Conditions
$  in Modal Transient Solutions", by T. Rose
$
$ User input:
$
$ PARAM,MIC,xx
$    if xx>=0, ignore this DMAP (default)
$    if xx <0, then include initial conditions
$
$ DMIG,MIC......
$    one or 2 column matrix containing all non-zero initial
$    conditions. Column1 = displacements, Column 2 = Velocities.
$
$ Note: this DMAP does not include EPOINTs. If using them,
$       additional terms (rows) should be added to the initial condition
$       matrix to account for them. Normally 0.0 in these terms is
$       fine, but if the i.c. for them is non-zero, it should be
$       entered in these terms.
$
COMPILE MODERS $
alter 1 $
putsys(0,192) $
ALTER 5
TYPE PARM,,I,Y,MIC=0,MODENO=0 $
TYPE PARM,,I,N,MODNOM1,MOLEFT $
TYPE PARM,NDDL,I,N,LUSETS,ZUZR1 $
TYPE DB,MATPOOL $
TYPE DB,ZUZR01 $
$ALTER 86 $ V66
$ALTER 89 $ V66A AND V66B
$ALTER 95 $ V675
$ALTER 96 $ V68
$ALTER 116 $ V68
alter 'if.*.*neigv.*0.*call.*sesum'(1,-1)
$
$ ADD INITIAL CONDITIONS
$
IF (MIC<0) THEN $ (A0) INITIAL CONDITIONS
  MESSAGE //'INITIAL CONDITIONS REQUESTED'/
      ' CURRENTLY ONLY FOR R.S. A-SET' $
      MTRXIN ,,MATPOOL,EQEXINS,SILS,/MIC,,/LUSETS $
$      MATPRN MIC// $
      UPARTN  USET,MIC/MICA,,,/'G'/'A'/'O'/1 $
$
$ remove null columns if they exist - added 5/25/1994
$
MATMOD   MICa,,,,,/partic,matic/12/S,N,nonull/1    $
if (nonull>0) then $
  if (nonull=2) then $
    message //'Matrix mica is null' $
    exit $
  endif $
  partn mica,partic,/micok,,,/1 $ remove null columns
else $
  equivx mica/micok/always $'
endif $
matprn mica,partic,micok// $
$  APPEND RESIDUAL I.C. TO MODES AND CHECK
$        *** NOTE *** AT THIS POINT MIC IS CHECKED TO
$                     BE SURE IT IS NOT A LINEAR COMBINATION OF
$                     OF THE MODES
$
$
$
$ FOR MODAL TRANSIENT, ALWAYS NORMALIZE RES FLEX VECTORS
$
      MESSAGE //'ORTHOGONALIZING INITIAL CONDITION VECTORS' $
$matprn pha,mkaa,mmaa,micok// $
      call sweepit pha,mkaa,mmaa,micok/lamanew,phianew/norset $
      PURGEX /LAMA,PHA,,,/ALWAYS $
      equivx lamanew/lama/always $
      equivx phianew/pha/always $
      MESSAGE //'THE FOLLOWING EIGENVALUE SUMMARY TABLE INCLUDES'/
                ' THE ORIGINAL EIGENVALUES PLUS ONE FOR EACH '/
                'NON-ZERO COLUMN IN YOUR INITIAL CONDITIONS' $
      OFP LAMA// $ **********
$
$ CHECK RESULTS
$
      SMPYAD  PHA,MMAA,MICA,,,/PARTFAC/3////1 $ MODAL 'PART' FACTORS
      MESSAGE //'MATRIX PARTFAC IS THE SCALING FACTORS FOR'/
                ' EACH MODE TO REPRESENT THE INITIAL CONDITIONS' $
      MATPRN  PARTFAC// $
   MPYAD PHA,PARTFAC,/NEWIC $ NEWIC = SUM OF PHI*PARTFAC
   ADD NEWIC,MICA/ZERO/(-1.,0.) $ FOR CHECK PURPOSES
$   MATGPR GPLS,USET,SILS,ZERO//'H'/'A'//1.-9 $
$   MATGPR GPLS,USET,SILS,NEWIC//'H'/'A'//1.-9 $
$
$ STORE IN DATA BASE AS ZUZR01
$
ZUZR1=0 $
EQUIVX PARTFAC/ZUZR01/ALWAYS $
$
ENDIF $ (A0)
$
$COMPILE MTRANRS, SOUIN=MSCSOU, NOREF
$
$ ADD MODAL INITIAL CONDITIONS IF MIC<0
$ INITIAL CONDITIONS ARE STORED IN ZUZR01
$ THE DMAP WILL USE PARAM, NOAP IN TRD1 TO IMPLEMENT THE INITIAL CONDITIONS
$ THE DIRECT SOLUTION WILL BE USED, BUT SINCE THE EQUATIONS ARE UNCOUPLED,
$ THIS IS CHEAP
$
$
compile semtran $
alter 1$
diagoff(8) $
putsys(0,192) $
ALTER 2
TYPE PARM,,I,Y,MIC=0,MODENO=0 $
TYPE PARM,,I,N,NEEDCOL $
TYPE PARM,NDDL,I,N,ZUZR1 $
TYPE DB,ZUZR01 $
$ALTER 6 $ V66
$ALTER 12 $ V66A AND V66B
$ALTER 16 $ V675
$ALTER 15
alter 'trd1'(1,-1)
IF (MIC>=0) THEN $  NO MODAL INITIAL CONDITIONS
$
$ NORMAL MODAL TRANSIENT SOLUTION
$
$ALTER 7 $ V66
$ALTER 13 $ V66A AND V66B
$ALTER 17 $ V675
$ALTER 16 $
alter 'trd1'
ELSE $  MODAL INITIAL CONDITIONS
  FILE MIC=APPEND $
  DBVIEW MIC1=ZUZR01 (WHERE ZUZR1=0) $
  APPEND MIC1,/MIC/2 $
$
$ ADD NULL COLUMNS TO INITIAL CONDITION TO GET 3 COLUMNS
$
  PARAML MIC//'TRAILER'/1/S,N,NOCOL $
  IF (NOCOL<3) THEN $
    NEEDCOL=3-NOCOL $
    PARAML MIC//'TRAILER'/2/S,N,NROW $
    MATGEN ,/EXTCOL/7/NROW/NEEDCOL $
matprn extcol,mic// $
    APPEND EXTCOL,/MIC/2 $
matprn mic// $
  ENDIF $
  TRD1 CASEt,TRL,NLFT,DIT,KHH,BHH,MHH,PHt,,,/
       MIC,pnlh/'DIRECT'/NOUE/1/1 $
  EQUIVX MIC/UHT/ALWAYS $
ENDIF $
$
$           ------------------------------------------
$
compile sweepit list $
subdmap sweepit phsa,mkaa,mmaa,uarsflx/lama,pha/norset $
type parm,,i,n,norset
type parm,,i,y,dontzero=0
$
$ Subdmap Sweepit - orthogonalize vectors to original modes
$ 
$    INPUT:
$        phsa  - original modes
$        mkaa  - stiffness matrix
$        mmaa  - mass matrix 
$        uarsflx - vectors to be orthogonalized to modes
$
$    OUTPUT:
$        lama    - updated eigenvalue table - includes new "modes'
$        pha     - updated modes - includes orthogonalized vectors
$
$
type parm,,rs,n,scfac $
type parm,,rs,n,scfinv $
type parm,,rs,n,scf1 $
type parm,,rs,n,scf2 $
type parm,,rs,n,wnnew $
type parm,,rs,n,freqnew $
type parm,,rs,n,ratiost $
type parm,,rs,y,kpfac=.01 $
file resnew = append $
setval //s,n,nwnadd/0
setval //s,n,nwntot/0
setval //s,n,nwnadd1/0
setval //s,n,iload/0 $
setval //s,n,iloadm1/0 $
setval //s,n,iload2/0 $
setval //s,n,nloads2/0 $
$
$
$ calculate the strain energy of the modes
$
copy phsa/phiajc/always $
smpyad phiajc,mkaa,phiajc,,,/strmode/3////1 $
$message //' ' $
$message //' ' $
$    message //'strain energy of modes '/ $
$message //' ' $
$    matprn strmode// $
$message //' ' $
$message //' ' $
$
$
$matprn uarsflx,resvec// $
matgen ,/dispnor/1/1 $
    
   paraml uarsflx//'trailer'/1/s,n,nloads $
$
$
$ mass normalize the static results
$
    iload = 0 $
    do while(iload < nloads) $
      iload = iload + 1 $
$
      matmod uarsflx,,,,,/dispcol,/1/iload $ get the disp column
      smpyad dispcol,mmaa,dispcol,,,/mmasta/3////1 $
matprn mmaa,mmasta// $
      paraml mmasta//'dmi'/1/1/s,n,msta
      purgex /mmasta,,,,/always $
prtparm //0/'msta' $
      scf2 =1. / sqrt(msta)
      paramr //'complex'//scf2//s,n,scf2a $
      add dispcol,/dispcol2/scf2a $
       if(iload = 1 ) then $
        equivx dispcol2/dispnor/always $
      else $
        append dispnor,dispcol2/dispnor1 $
        equivx dispnor1/dispnor/always $
        purgex /dispnor1,,,,/always $
      endif
     enddo
purgex /uarsflx,dispcol,,,/always $
equivx dispnor/uarsflx/always $
$
$ static results now normalized
$
$ generate the participation factors
$
    smpyad phiajc,mmaa,uarsflx,,,/pfac/3////1 $
$message //' ' $
$message //' ' $
$    message //'participation factors '/ $
$message //' ' $
$    matprn pfac// $
$message //' ' $
$message //' ' $
$
$ use the participation vectors to create residual vectors
$
    mpyad phiajc,pfac,/stamod/0 $
    add stamod,uarsflx/resvec//-1. $
$
$
$ sweep out the redundent information 
$ from the residual vectors
$
smpyad resvec,mkaa,resvec,,,/str1/3////1 $
$message //' ' $
$message //' ' $
$message //'strain energy matrix before sweeping' $
$message //' ' $
$message //' ' $
$matprn str1// $
$message //' ' $
$
$ determine the threshod based on
$ the larget digfaonal term in the strain 
$ energy matrix
message //' ' $
message //' Keep Factor =  '/kpfac$
message //' ' $
$
matgen ,/id1/1/nloads $
add str1,id1/stid1///1 $
matmod stid1,,,,,/stcol,/6 $
matmod stcol,,,,,/stone,/7 $
paraml stone//'dmi'/1/1/s,n,thres
thres = thres * kpfac
message //' ' $
message //' ' $
message //'Strain Energy Threshold = '/thres $
message //' ' $
message //' ' $
$
$
      message //' ' $
      message //' ' $
      message //' **************** strain energy results '/
                ' ****************' $
      message //' ' $
      message //' if strain energy of the residual vector is less ' $
      message //' than kpfac * max of the static load strain energy' $
      message //' the residual vectors will not be used ' $
      message //' ' $
      message //' load case   residual vec.'/
                 '      included'/ $
      message // ' ' $
      message // ' ' $
$
    call ortho resvec,mkaa,mmaa/resnew2/nloads/thres/1 $
    paraml resnew2//'trailer'/1/s,n,nloads $
$ message //'nloads = '/nloads
    equivx resnew2/resvec/always $
    purgex /resnew2,,,,/always $
    call ortho resvec,mkaa,mmaa/resnew2/nloads/thres/2 $
    paraml resnew2//'trailer'/1/s,n,nloads $
$
message //' ' $
message //' ' $
message //'NUMBER OF RESIDUAL VECTORS LEFT = '/nloads $
message //' ' $
message //' ' $
$
$
smpyad resnew2,mkaa,resnew2,,,/str2/3////1 $
$message //' ' $
$message // $
$message //'strain energy matrix after sweeping' $
$message //' ' $
$message //' ' $
$matprn str2// $
$message //' ' $
$
$
iload = 0 $
    do while(iload < nloads)
$     message //' load number '/iload $
      iload = iload + 1 $
      purgex /rescol,rescol2,dispcol,mmass,/always $
      matmod resnew2,,,,,/rescol,/1/iload $ get the res column
      smpyad rescol,mmaa,rescol,,,/mmass/3////1 $
      paraml mmass//'dmi'/1/1/s,n,mmass2
      purgex /mmass,,,,/always $
      scfac =1. / sqrt(mmass2)
      paramr //'complex'//scfac//s,n,scfac2 $
      add rescol,/rescol2/scfac2 $
$      smpyad rescol2,mmaa,rescol2,,,/mmass/3////1 $
      append phiajc,rescol2/phiajc2 $ add residual vector to phia
      equivx phiajc2/phiajc/always $
      purgex /phiajc2,,,,/always $
    enddo $
$matprn phiajc2// $
$$
$$ get new eigenvalues
$$ 
$$
      SMPYAD phiajc,MMAA,phiajc,,,/MAANEW/3////1 $
      SMPYAD phiajc,MKAA,phiajc,,,/KAANEW/3////1 $
diagonal maanew/maadiag $
diagonal kaanew/kaadiag $
add kaadiag,maadiag/eigval///2 $
trnsp eigval/lamat $
$
if(norset>0 and dontzero=0)then $ 
$ set r-set eigenvalues to 0.0
$
  paraml lamat//'TRAILER'/1/s,n,nmodes $
  matgen ,/partzero/6/nmodes/0/norset $ 1's for r-set
  partn lamat,partzero,/nonzero,,,/1 $
  merge nonzero,,,,partzero,/lamatnew/1 $
  purgex /lamat,,,,/always $
  equivx lamatnew/lamat/always $
endif $
diagonal lamat/radian/'WHOLE'/.5 $ radians/sec
type parm,,cs,n,complpi 
complpi=cmplx(1.,0.) $
complpi=(1.,0.)/((2.,0.)*pi(complpi)) $
$message //'complpi='/complpi $
add radian,/freq/complpi $
trnsp maadiag/modemass $
matgen ,/mergit1/6/2/1/1 $
merge  freq,,,,,mergit1/freq1/1 $
matgen ,/mergit2/6/3/2/1 $
merge  freq1,modemass,,,,mergit2/newlamat/1 $
$matprn freq,newlamat// $
lamx newlamat,/newlama $
$ofp newlama// $
equivx phiajc/pha/always $
equivx newlama/lama/always $
$
Return
End $ subdmap sweepit
$
$ ---------------------------------------------------------
$
compile ortho $
subdmap ortho resvec,mkaa,mmaa/resnew2/nloads/thres/itype $
$
$ Feb 16, 1993  ortho.dat
$
type parm,,rs,n,scfac $
type parm,,rs,y,thres $
type parm,,i,n,nloads $
type parm,,i,n,iload $
type parm,,i,n,nloads2 $
type parm,,i,n,itype $
file resnew2=save $
file resnew=append $
$
if(itype = 2) then
  copy mkaa/mmaajc/always
  message //' ' $
  message //' sweeping on stiffness matrix ' $
  message //' ' $
else
  copy mmaa/mmaajc/always
  message //' ' $
  message //' sweeping on mass matrix ' $
  message //' ' $
endif
    iload = 1 $
    nloads2 = nloads
    do while(iload < nloads) $
$
      matgen ,/cp1/6/nloads2/0/1 $
      purgex /resleft,,,,/always $
      partn resvec,cp1,/resleft,,rescol,/1 $
      smpyad rescol,mkaa,rescol,,,/stt/3////1 $
      paraml stt//'dmi'/1/1/s,n,stt2
      purgex /stt,,,,/always $
      if (stt2 > thres or iload = 1) then
        smpyad rescol,mmaajc,rescol,,,/mmass/3////1 $
        paraml mmass//'dmi'/1/1/s,n,mmass2
        purgex /mmass,,,,/always $
        scfac =1. / sqrt(mmass2) $ 
        paramr //'complex'//scfac//s,n,scfac2 $
        purgex /rescol2,,,,/always $
        add rescol,/rescol2/scfac2 $
        smpyad rescol2,mmaajc,resleft,,,/respart/3////1 $
        mpyad rescol2,respart,/respart2 $
        purgex /resvec,,,,/always $
        add respart2,resleft/resvec/-1. $
$
        if(iload = 1 ) then $
          equivx rescol/resnew/always $
        else
          append rescol,/resnew/2 $
        endif
        message //iload/stt2/'            yes' $
       else
        message //iload/stt2/'            no' $
        purgex /resvec,,,,/always $
        copy resleft/resvec/always $
       endif
$
   iload = iload +1
   nloads2 = nloads2 - 1 $
   enddo
$
   smpyad resvec,mkaa,resvec,,,/stt/3////1 $ *** resleft to resvec 2/15
   paraml stt//'dmi'/1/1/s,n,stt2
   purgex /stt,,,,/always $
   if (stt2 > thres) then
     message //iload/stt2/'            yes' $
     append resnew,resvec/resnew2 $ *** resleft to resvec 2/15
     purgex /resvec,,,,/always $
   else
     message //iload/stt2/'            no' $
     copy resnew/resnew2/always $ 
   endif
$
$ sweeping complete
$
return $
end alter$
$
$ END OF ALTER FOR MODAL INITIAL CONDITIONS
$
$echoon $