$
$    scrspca.v2001
$
Compile semtran list $
Alter 'case.*caset' $
Repeat=-1 $ turn off looping on outer loop
Alter 'call super1' $
Call dbstore dti,dtindx,,,//0/0/'     '/0 $ for specsel
Alter 'trlg.*ppt'(,-1) $
Jump befs3 $
Alter 'call super3'(2,-1) $
Label befs3 $
PARTN Ys,,Ys/,YX,,/0 $
MATMOD YX,,,,,/YXX,/28 $ DIAGONALIZE
MERGE, ,YXX,,,,YS/YSX/0 $
Upartn uset,dar/dm,,,/'a'/'l'//1 $
Paraml yxx//'trailer'/1/s,n,nx $ number of static shapes
Matgen ,/pgx/7/nogset/nx $ ssg2 requires a null matrix 
SSG2     USET,GM,YSx,KFS,GOa,DM,pgx/QR,POi,PS,PAx,PLi $  static analysis       
SSG3     LLL,,KLL,PLI,LOO,,KOO,POI,LRSEQ/
            ULx,UOOX,RULX,RUOx,/nooset/
            -1/V,N,NSKIP/S,N,EPSI $ p2=-1 for ires
if (norset>-1) then $
  umerge1 uset,ulx,,,/uax/'a'/'l'//1 $
else $
  equivx ulx/uax/always $
endif $
DIAGONAL BHH/BDIAG/'COLUMN' $
DIAGONAL MHH/MDIAG/'COLUMN' $
ADD      KHH,MHH/OMEGSQ///2 $
DIAGONAL OMEGSQ/OMEG/'COLUMN'/0.5 $ SQUARE ROOT
ADD      OMEG,/FN/.159155 $
MATPRN   FN// $ SELECTED NATURAL FREQUENCIES
ADD      BDIAG,OMEG/BDIAG1///2 $
ADD      BDIAG1,MDIAG/ZETAH/(0.5,0.)//2 $ ELEMENT DIVIDE
SDR1     USET,PG,ULx,UOOx,YSx,GOa,GM,PS,KFS,KSS,QR/UGx,PGscr,QGx/
         V,N,NSKIP/SOLTYPE/-1 $ -1 for nospc
Equivx rph/upt/always $ 
Paraml rph//'trailer'/1/s,n,nz $ number of modes
Type parm,,I,n,ny $ 
Ny = nz + nx $ modes plus static shapes
Matgen ,/vyxz/6/ny/nx/nz$
Call dbstore vyxz,,,,//0/0/'     '/0 $
Merge ugx,,rph,,vyxz,/PHIgy/0 $
Merge uax,,phdh,,vyxz,/phiay/0 $
Equivx PHIgy/upt/always $ get data recovery on mode shapes and static shapes
Mpyad PHIay,Pax,/psiayx1/1 $
Matgen ,/ixx/1/nx $
diagonal omegsq/lmbdinv/'whole'/-1.0 $
add lmbdinv,/mlmbdinv/-1.0 $ divide by fn**2 to get accel. units
Merge ixx,,,mlmbdinv,vyxz,/tyy/-1 $
Mpyad tyy,psiayx1,/psiayx $ mode participation matrix, acceleration type
Trnsp psiayx/psit $ transpose easier to read
Message //'transpose of mode participation factor matrix' $
Matprn psit// $
Merge, ,zetah,,,,vyxz/zetay/0 $
Merge, ,fn,,,,vyxz/fny/0 $
Call dbstore psiayx,zetay,fny,,//0/0/'     '/0 $

Compile super3 list
alter 'sdr2.*,,,,,,/'(2,)$ set nosort2 flag call 469
delete /vvxz,zetay,fny,psiayx,dti $
delete /dtindx,,,, $
Call dbfetch /vvxz,zetay,fny, , /0/0/0/0/0 $
Call dbfetch / psiayx,dti,dtindx, , /0/0/0/0/0 $
DTIIN    DTI,DTINDX/SPECSEL,,,,,,,,,/S,N,P1 $                            
Type parm,,I,n,repeatt $
TYPE PARM,nddl,CHAR8,Y,OPTION $
TYPE PARM,nddl,RS,Y,CLOSE $
If (seid=0) CALL DBSTORE dynamics,,,,//0/0/'     '/0 $
Delete /dynamics,,,, $
Call dbfetch /dynamics,,,,/0/0/0/0/0$ get the on from s.e. 0
Type parm,,I,n,noloop $
      REPEATT=1  $ INITIALIZE
      Noloop=-1 $ rewind casecc
      DO WHILE ( REPEATT <> -1 ) $
         Delete /casexx,,,, $
         CASE     CASEcc,/CASEXX/'TRAN'/S,N,REPEATT/S,N,NOLOOP $
         PVT      PVTS,CASEXX/PVTXX/ $ UPDATE VPS -FORCED ON RESTART
         INTERR   CASEXX,DIT,DYNAMICS,ZETAy,FNy,SPECSEL,PSIayx/
                  UHVR/
                  CLOSE/OPTION $
         PARAML   UHVR//'PRESENCE'////S,N,NOUHVR $
         IF ( NOUHVR>-1 ) THEN $
            MATPRN   UHVR// $ DISPL, VELO, ACCEL VECTOR
            DDRMM    CASEXX,UHVR,, IUG1,IQG1,IES1,IEF1,XYCDBDR/
                     OUPV1,OQP1,DOES1,DOEF1,/
                     OPTION $
            OFP      OUPV1,OQP1,DOEF1,DOES1//S,N,CARDNO $
            if ( dbofpx<>'scratch' 
               ) call xofpindx  OUPV1,OQP1,DOEF1,DOES1,,,,,,//s,np $
            if ( post=-1 and patver>=3. ) then $
               SDR2     CASEDR,CSTMS,MPTS,DIT,EQEXINS,,ett,,BGPDTS,
                        ,,ug2,ESTn,XYCDBDR,,,,gpsnts,,,,,/
                        ,,,IESTR,,,/'mmREIG'//3 $
               DDRMM    CASEXX,UHVR,,IUG1,IQG1,IESTR,,XYCDBDR/
                        OUPDUMMY,OQGDUMMY,DOSTR1,,/OPTION $
               $ review dummies.  Seem to be un-necssary
               OFP      DOSTR1 // $
               OUTPUT2  OUPV1,OQP1,DOEF1,DOES1,DOSTR1//
                        0/ounit2//omaxr/////'oes' $
            endif $ post=-1 and patver>=3.
         ENDIF $ NOUHVR>-1
      ENDDO $ REPEATT
Jump endselp $
Alter 'ENDIF $ ELSE NOUSET=-1' $ 
Label Endselp $ 
$
Compile phase1c list $
alter 'getlll=' $
Type parm,,char8,n,scrspcs='yes' $
Type parm,nddl,char8,n,zuzrch1 $ change to new nddl parameter for production
Zuzrch1=scrspcs $ 
getlll=getlll or zuzrch1='yes' $