$ %+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%
$
$  ASSIGN STATEMENT EXAMPLES
$
$ASSIGN INPUTT4='temp.km',OLD,UNIT=23
$ASSIGN INPUTT4='temp.delk',OLD,UNIT=20
$ASSIGN OUTPUT4='temp_2001.kmp',unknown,UNIT=31
$ASSIGN OUTPUT4='temp_2001.phz',unknown,UNIT=32
$ASSIGN OUTPUT4='temp_2001.rbv',unknown,UNIT=26
$ 
$         Below is the latest DMAP for generation of a Craig-Bampton
$       fixed interface modal model.  This DMAP is written for version 2005r2
$       of MSC NASTRAN
$  
$  (1) BULK DATA PARAMETERS FOR MERGING :
$  
$  	PARAM,MERGE,1	        CB MODEL WITH MERGED SUBSTRUCTURES 
$ 	PARAM,MERGE,-1          CB MODEL W/O MERGED SUBSTRUCTURES (DEFAULT)
$  
$  (2) OUTPUT OF G-SET PHIG AND PHIZ
$
$       PARAM,PHGOUT,1		REQUIRED TO OUTPUT G-SET PHIG MATRIX
$       PARAM,PHZOUT,1		REQUIRED TO OUTPUT PHIZ MATRIX (G-set
$                               size if no user set defined (see below))       
$
$  (3) OUTPUT USER DEFINED PARTITION OF PHIG AND PHIZ
$  
$	a) Partition PHIG for grids Ids 1 and 2 and output to unit 31
$		USET1	U1	123456	1	2
$
$	b) Partition PHIZ for grids Ids 1 and 2 and output to unit 32
$		USET1	U2	123456	1	2
$
$	The sets U1 and U2 can be re-named using the DEFUSET bulk data card.  
$ 
$       Note:  If a user set is defined for PHIG and PARAM,PHGOUT is also used, both
$              a partitioned and full G-set will be output
$              If a user set is defined for PHIZ, only a partioned matrix will be
$              output.
$
$  (4)  OUTPUT RIGID BODY VECTOR TO UNIT 26  
$
$	PARAM,RBVEC,1	Output interface rigid body vectors to unit 26.  
$			Rigid body vectors are taken w.r.t. to model's CM.  
$  
$  (5) PARAMETER 'DELK' FOR ADDING A DELTA-K STIFFNESS FROM UNIT 20 (G-SET) SIZE TO KGG.
$      DEFAULT VALUE FOR 'DELK' IS, OF COURSE, PARAM,DELK,-1 .  
$  
$  (6) OUTPUT PHIG IN BASIC COORDINATE SYSTEM
$  
$  	PARAM,PHGBAS,1	Output PHIG in basic coordinate system. Default is
$  			PARAM,PHGBAS,-1 which means global output coordinates
$ 
$ ---------------------------------------------------------------------------------
$ ---------------------------------------------------------------------------------
$
$ >> Craig-Bampton Model DMAP User's Notes :
$
$ Craig Bampton model generation routine for NASTRAN solution
$ 103.  Solution 103 is the superelement solution sequence and can loop
$ through subroutines multiple times.  This DMAP was written for the
$ simple case of a single pass structure and has only been checked for
$ that case.  The boundary d-o-f should be constrained with SUPORT cards.  
$
$    OUTPUT 
$ 
$      Unit 31 will always be output and must be assigned to a file.
$      The unit 31 file will contain these files in binary output4 
$      format:
$            KRRGN - generalized stiffness
$            MRRGN - generalized mass
$            LTM   - net loads ltm followed by I/F forces in R-set order
$            PHI1  - USET partition of PHIG (if U1 set specified)
$            PHIG  - G-set phi in internal order (if PARAM,PHGOUT,1 specified)
$
$      Unit 32 will be output if PARAM PHZOUT 1  is specified and
$      will contain PHIZ, the displacements due to modal accelerations.
$      
$      Note that both LTM and PHIZ will already contain displacement
$      information if the boundary is redundant. 
$
$      If element forces or stresses are requested in case control the
$      output in the .F06 file will correspond to the modal acceleration
$      method (PHIZ) of generating loads - not modal displacments.  
$
$      If grid point forces are requested in case control the
$      output in the .F06 file will also correspond to the Craig-Bampton 
$      PHIZ, but applied loads for the constraint modes will appear
$      as F-OF-SPC in the force table.  There will be no applied load
$      output for the flexible modes.
$       
$ %+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%
$ %+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%
$ %+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%+%
$
$ %+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%
$ MERGING OF SUBSTRUCTURES  
$ 
$ Merge in subtructure mass and stiffness matri(x,ces) by reading matrix size from trailer.  
$ For a set of "n" substructures, this DMAP expects the mass and stiffness matrices 
$ read in, MGEN and KGEN, be in the following format:  
$  
$            { [M1]  0    0   .  .  .  0   }            { [K1]  0    0   .  .  .  0   }
$   [MGEN] = {  0   [M2]  0   .  .  .  0   }   [KGEN] = {  0   [K2]  0   .  .  .  0   }
$            {           . . .             }            {           . . ..             }
$            {  0    0    0   .  .  . [Mn] }            {  0    0    0   .  .  . [Kn] }
$ 
$ Where the matrices [M1],[M2],...,[Mn] and [K1],[K2],...,[Kn] are the "n" substructure mass 
$ and stiffness matrices.  The substructures are placed at the lower partition of the G-set 
$ mass, MGG, and stiffness, KGG, matrices as follows:
$ 
$ 	[MGG] = { [Mphys]   0    } 			[KGG] = { [Kphys]   0    }
$ 	        {    0    [MGEN] }    		        	{    0    [KGEN] }
$  
$ The placement of [MGEN] and [KGEN] at the end of [MGG] and [KGG] is only possible if
$ the bulk data deck has additional GRIDs or SPOINTs which are numbered higher than all
$ GRIDs/SPOINTs that correspond to [Mphys] and [Kphys].  Therefore, the number of d-o-f
$ that must be added to the bulk data to account for merged substructures should be 
$ equal to the row/col size of either [KGEN] or [MGEN].  
$ %+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%
$
$
$
$ %+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%
$ Merge substructure mass [MGEN] and stifffness [KGEN]  
$ %+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%
COMPILE SUBDMAP=SEMG,SOUIN=MSCSOU,NOREF,LIST
ALTER 183
$   
TYPE  PARM,,I,Y,DELK=-1                        $ 
IF (DELK > -1) THEN                            $ 
 INPUTT4   /KDGG,,,,/1/20/-1                   $   Input G-set size del-K stiffness
 PARAML    KDGG//'TRAILER'/1/S,N,KDSIZE//      $ 
 PARAM	  //'SUB'/S,N,ZEROS/LUSETS/V,N,KDSIZE  $ 
 IF ( ZEROS <> 0 ) THEN                        $ 
  MESSAGE //' FATAL MESSAGE -- DELTA-K STIFF MATRIX FROM UNIT 20'/ 
            '                  NOT G-SIZE MATRIX !!!            '/ 
            '                                                   ' $ 
  EXIT                                         $ 
 ENDIF                                         $ 
 ADD    KJJZ,KDGG/K1X                          $ 
 MODTRL K1X////6/                              $ 
 EQUIVX K1X/KJJZ/ALWAYS                        $ 
ENDIF                                          $ 
$ 
TYPE  PARM,,I,Y,MERGE=-1                       $ 
IF (MERGE > -1) THEN                           $ 
$
INPUTT4   /KGEN,MGEN,,,/2/23/-1                $   Input Mass matrix and print
PARAML    KGEN//'TRAILER'/1/S,N,KSIZE//        $ 
PARAML    MGEN//'TRAILER'/1/S,N,MSIZE//        $ 
PARAM	  //'SUB'/S,N,KMDIF/KSIZE/MSIZE        $ 
IF ( KMDIF <> 0 ) THEN                         $ 
  MESSAGE //' FATAL MESSAGE -- MASS AND STIFFNESS MATRICES'/
            '                  MUST BE THE SAME SIZE, PROGRAM'/
            '                  HALTED BY DMAP ALTER mg_67_10x_auto' $
  EXIT                                         $
ENDIF                                          $
$   
PARAM	  //'SUB'/S,N,GPHYS/LUSETS/V,N,KSIZE $ Subtract substructure size
MATGEN,   /P1/6/LUSETS/GPHYS/KSIZE           $ from g-set size and create
$                                            $ merge vector
$
$ PRTPARM   //0/'LUSETS'                    $ Check The parameter Sizes
PRTPARM   //0/'KSIZE'                     $        
PRTPARM   //0/'GPHYS'                     $  
$   
MERGE,    ,,,MGEN,P1,/MFIN/               $ Merge substructure with
MERGE,    ,,,KGEN,P1,/KFIN/               $ zero's to get g-set size
$
MATGEN   EQEXINS/INTEXTT/9/1/LUSETS       $ Create the transpose of
$                                         $ INTEXT for transforming from
$                                         $ external order to internal
$
SMPYAD   INTEXTT,MFIN,INTEXTT,,,/M3INT/
         3////1////6                      $ Transform substructure
ADD      MJJX,M3INT/MJJX1                 $ mass to internal order,
MODTRL   MJJX1////6/                      $ add to physical mass,
EQUIVX   MJJX1/MJJX/ALWAYS                $ set as symmetrical and
$                                         $ equiv to MJJX
$
SMPYAD   INTEXTT,KFIN,INTEXTT,,,/K3INT/
         3////1////6                      $ Transform substructure
ADD      KJJZ,K3INT/KJJZ1                 $ stiffness to internal 
MODTRL   KJJZ1////6/                      $ order, add to phisical
EQUIVX   KJJZ1/KJJZ/ALWAYS                $ stiffness and equiv
$
ENDIF                                     $  MERGE > -1
$   
ALTER 184
CALL    DBSTORE KELM,KDICT,ECTS,GPECT,EQEXINS//1/1/'     '/0/         $ 
CALL    DBSTORE SILS,CSTMS,VELEM,BGPDTS,//1/1/'     '/0/              $
ENDALTER
$
$
$ %+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%
$ Grid Point Weight Generator
$ %+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%+++%
COMPILE SUBDMAP=SEMR2,SOUIN=MSCSOU,NOREF,LIST          
ALTER 23
$
TYPE  PARM,,I,Y,MERGE=-1                  $ 
IF (MERGE > -1) THEN                            $ Check if merging subtructures
$   
CALL    DBFETCH /BGPDTS,CSTMS,EQEXINS,,/1/1/0/0/0           $
$TYPE	PARM,,RS,Y,WTMASS                       $
TYPE	PARM,,I,Y,GRDPNT                        $
$
VEC USET/VGA/'G'/'N'/'COMP'                          $ Merge N-set mass to
MERGE,MNN,,,,VGA,/MNNX/                              $ G-set size and run
GPWG BGPDTS,CSTMS,EQEXINS,MNNX,,/OGPW2/GRDPNT/WTMASS $ GPWG to get coupled
$                                                    $ weight generater
MESSAGE //' INFORMATION MESSAGE -- THE FOLLOWING WEIGHT TABLE WAS'/
          '                        PRINTED AFTER N-SET REDUCTION BY'/
          '                        A DMAP ALTER'     $
OFP OGPW2//                                          $
ENDIF                                                $ MERGE > -1
$
ALTER 136	$<== After ENDIF before RETURN
CALL    DBSTORE MFF,,,,//1/1/'     '/0/     $ 
$
ENDALTER
$
$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
$                        BEGIN EQUILIBRIUM CHECK DMAP                           $
$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
COMPILE SUBDMAP=SEKR0,SOUIN=MSCSOU,NOREF,LIST
$
$ G-SET CHECK (INSERTED HERE SO IT WILL OCCUR EVEN IF A PROBLEM WITH THE M-SET  $
$              CAUSES THE RUN TO BOMB)
ALTER 10
$ TYPE DB,BGPDTS,CSTMS                        $
  VECPLOT, ,BGPDTS,EQEXINS,CSTMS,,,,,/
           RBGL,,,,/V,Y,MPFPNT=0//4             $ CREATE RBGL                       $
  CALL    DBSTORE RBGL,,,,//1/1/'     '/0/  $ STORE IT FOR F AND A SET CHECKS   $
  TRNSP  RBGL/RBGLT                         $ PERFORM G-SET EQUILIBRIUM CHECK   $
  MPYAD  KGG,RBGLT,/KPHIG                   $ {RBGL}[KGG]{RBGL}^T = [0]         $
  MPYAD  RBGL,KPHIG,/KPHG6                  $                                   $
  MATPRN KPHG6//                            $ SUMMATION OF FORCES               $
  MATGPR GPLS,USET0,SILS,KPHIG//'G'///1.-5  $ ALL FORCES                        $
$
$ N-SET CHECK (PERFORMED AS SOON AS KNN BECOMES AVAILABLE)
$
ALTER 75  
  VEC    USET0/VGN/'G'/'N'/'COMP'           $ PARTITION RBGL DOWN TO N-SET      $
  PARTN  RBGL,VGN,/RBNN,,,/1                $                                   $
  TRNSP  RBNN/RBNNT                         $ PERFORM N-SET EQUILIBRIUM CHECK	$
  MPYAD  KNN,RBNNT,/KPHIN/                  $ {RBGL}[KNN]{RBGL}^T = [0] 	$
  MPYAD  RBNN,KPHIN,/KPHN6/                 $                                   $
  MATPRN KPHN6//                            $ SUMMATION OF FORCES               $
  MATGPR GPLS,USET0,SILS,KPHIN//'N'///1.-5  $ ALL FORCES                        $
ENDALTER
$
$ F-SET CHECK (PERFORMED AS SOON AS KFF BECOMES AVAILABLE)
$
COMPILE SUBDMAP=SEKR,SOUIN=MSCSOU,NOREF,LIST
ALTER 18
  IF (NOSSET >= 0) THEN			    $ SKIP F-SET CHECK IF F-SET = N-SET $
    CALL   DBFETCH /RBGL,,,,/1/1/0/0/0      $ FETCH THE RIGID BODY VECTOR       $
    VEC    USET/VGF/'G'/'F'/'COMP'          $ PARTITION RBGL DOWN TO F-SET	$
    PARTN  RBGL,VGF,/RBFF,,,/1              $					$
    TRNSP  RBFF/RBFFT                       $ PERFORM F-SET EQUILIBRIUM CHECK	$
    MPYAD  KFF,RBFFT,/KPHIF/                $ {RBGL}[KFF]{RBGL}^T = [0] 	$
    MPYAD  RBFF,KPHIF,/KPHF6/               $					$
    MATPRN KPHF6//                          $ SUMMATION OF FORCES		$
    MATGPR GPLS,USET,SILS,KPHIF//'F'///1.-5 $ ALL FORCES			$
  ENDIF                                     $                                   $
$
$ DBSTORE OF KFF REQUIRED, MUST BE LEFT IN EVEN IF EUILIBRIUM CHECK IS REMOVED  $
$
ALTER 129
CALL    DBSTORE KFF,GOT,,,//1/1/'     '/0/   $ 
ENDALTER
$
$ A-SET CHECK (PERFORMED AS SOON AS KAA BECOMES AVAILABLE)
$
COMPILE SUBDMAP=SEKMR,SOUIN=MSCSOU,NOREF,LIST
ALTER 36
  CALL   DBFETCH /RBGL,,,,/1/1/0/0/0        $ FETCH THE RIGID BODY VECTOR	$
  VEC    USET/VGA/'G'/'A'/'COMP'            $ PARTITION RBGL DOWN TO A-SET	$
  PARTN  RBGL,VGA,/RBAA,,,/1                $					$
  TRNSP  RBAA/RBAAT                         $ PERFORM A-SET EQUILIBRIUM CHECK	$
  MPYAD  KAA,RBAAT,/KPHIA/                  $ {RBGL}[KAA]{RBGL}^T = [0] 	$
  MPYAD  RBAA,KPHIA,/KPHA6/                 $					$
  MATPRN KPHA6//                            $ SUMMATION OF FORCES		$
  MATGPR GPLS,USET,SILS,KPHIA//'A'///1.-5   $ ALL FORCES			$
ENDALTER
$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
$                        END EQUILIBRIUM CHECK DMAP                             $
$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$


$
$----------------------------------------------------------------------*
$------begin Craig-Bampton section-------------------------------------*
$----------------------------------------------------------------------*
$
$COMPILE SUBDMAP=PHASE1C,SOUIN=MSCSOU,NOREF,LIST
$ALTER 24
$CALL    DBSTORE MLL,KLL,MLR,,//1/1/'     '/0/  $ 
$ENDALTER
$  
COMPILE SUBDMAP=SEKRRS,SOUIN=MSCSOU,NOREF,LIST
ALTER 46
CALL    DBSTORE KLR,KRR,KLL,,//1/1/'     '/0/  $ 
ENDALTER
$  
COMPILE SUBDMAP=SEMRRS,SOUIN=MSCSOU,NOREF,LIST
ALTER 16
CALL    DBSTORE MLR,MLL,,,//1/1/'     '/0/  $ 
ENDALTER
$
COMPILE SUBDMAP=MODERS,SOUIN=MSCSOU,NOREF,LIST
ALTER 100,100
$
TYPE    DB,MPTS,XYCDB                              $
TYPE    DB,DIT,EST                                 $ FILES NOT NORMALLY USED
$TYPE    DB,GOT,GM,KFS,MAA                         $ IN THIS ROUTINE
TYPE    DB,KFS,MAA
TYPE    PARM,,RS,Y,WTMASS                          $
TYPE    PARM,,RS,Y,TINY                            $
TYPE    PARM,,I,N,NOMSET                           $
CALL    DBFETCH /KRR,KLR,MLL,KLL,/1/1/0/0/0        $
CALL    DBFETCH /MLR,,,,/1/1/0/0/0                 $ 
CALL    DBFETCH /KFF,BGPDTS,CSTMS,MFF,/1/1/0/0/0   $
$
PARAML    GM//'NULL'////S,N,NOMSET         	   $ CHECK TO SEE IF
PRTPARM   //0/'NOMSET'                     	   $ DATA-BLOCKS ARE
PARAML    MPTS//'NULL'////S,N,NOMPTS       	   $ NULL
PRTPARM   //0/'NOMPTS'                     	   $  
PARAML    XYCDB//'NULL'////S,N,NOXYCDB     	   $ 
PRTPARM   //0/'NOXYCDB'                    	   $       
PARAML    MLR//'NULL'////S,N,NOMLR         	   $ 
PRTPARM   //0/'NOMLR'                      	   $  
PARAML    DIT//'NULL'////S,N,NODIT         	   $ 
PRTPARM   //0/'NODIT'                      	   $  
PARAML    EST//'NULL'////S,N,NOEST         	   $ 
PRTPARM   //0/'NOEST'                      	   $  
PARAML    MAA//'NULL'////S,N,NOMAA        	   $ 
PRTPARM   //0/'NOMAA'                     	   $   
PARAML    MFF//'NULL'////S,N,NOMFF        	   $ 
PRTPARM   //0/'NOMFF'                     	   $  
PARAML    GOT//'NULL'////S,N,NOGOT      	   $ 
PRTPARM   //0/'NOGOT'                    	   $  
PARAML    KFS//'NULL'////S,N,NOKFS        	   $  
PRTPARM   //0/'NOKFS'                     	   $  
$
READ	 KLL,MLL,,,EED,USET,CASES,VAXW,SILS,,,LLL,EQEXINS,/ 		
	 LAMA,PHIL,MIX,OEIGS,EIGVMAT,MECHA/  					
	 READAPP/S,N,NEIGV/NSKIP/SECND $					
IF ( NEIGV < 1 ) THEN                                  $
  MESSAGE //' FATAL MESSAGE -- NO EIGENVALUES FOUND'/
            '                  PROGRAM TERMINATED BY'/
            '                  DMAP ALTER CB103_705'    $
  EXIT                                                 $
ENDIF                                                  $
$
OFP     LAMA//                          $ PRINT EIGENVALUE TABLE
$
UMERGE   USET,PHIL,/PHILA/'A'/'L'/'R'   $ MERGE PHIL WITH ZEROS
MATGEN,  /AMR/1/NORSET                  $   TO FORM PHIA
DIAGONAL MIX/MIXDIAG/'SQUARE'             $
EQUIV    MIXDIAG,MIX/ALWAYS               $ MERGE R-SET IDENTITY
UPARTN   USET,DAR/DLR,DRR,,/'A'/'L'/'R'/1 $
UMERGE   USET,DLR,AMR/PHIRB/'A'/'L'/'R'  $   WITH DM TO FORM PHIRB
PARAM    //'ADD'/S,N,NORPN/NORSET/NEIGV $ CREATE BOUNDARY TO
MATGEN,  /MP/6/NORPN/NORSET/NEIGV       $   MODES PARTITION
$
MERGE    PHIRB,,PHILA,,MP,/PHIX/1       $
MPYAD    MLL,DLR,MLR/MTP1////2           $
MPYAD    PHIL,MTP1,/MHB/1///2           $
TRNSP    MHB/MBH                        $
MERGE    MR,MHB,MBH,MIX,MP,/MRRGN       $
MERGE    MR,,MBH,,MP,/IFFOR/1           $
LAMX,    ,LAMA/LMAT/-1                  $
MATMOD   LMAT,,,,,/KWW,/28              $
MPYAD    KLR,DLR,KRR/KBB/1///2           $
MERGE    KBB,,,KWW,MP,/KRRGN            $
$---------------------------------------$
PARAMR //'DIV'/S,N,ONEOVR/1./WTMASS     $ 
PARAMR //'COMPLEX'//ONEOVR//S,N,C1OVR   $
PARAMR //'COMPLEX'//WTMASS//S,N,CWTMS   $
VECPLOT, ,BGPDTS,EQEXINS,CSTMS,,,,,/
         RBGL,,,,/0//4                      $
VEC    USET/VRB/'G'/'R'/'COMP'          $
PARTN  RBGL,VRB,/RBRSET,,,/+1           $
TRNSP  RBRSET/RBRSE                     $ CHECK RIGID BODY MASS FROM
SMPYAD RBRSET,MR,RBRSE,,,/RBMM/3        $ BOUNDARY IN ZERO COORD SYSTEM
ADD    RBMM,/RBWT/C1OVR                 $
MATPRT RBWT//                           $
$---------------------------------------$
MATGEN, /SIX/6/6/3/3                    $
PARTN   RBMM,SIX,/,,OFFDG,/             $ GENERATE CG TRANSFORMATION
PARAML  RBMM//'DMI'/1/1/S,N,MM          $
PARAMR  //'DIV'/S,N,MMI/1./MM           $
PARAMR  //'COMPLEX'//MMI//S,N,MMIC/     $
MATGEN, /CGI/1/6                        $
ADD     OFFDG,/CGTR/MMIC                $
MERGE,  ,CGTR,,,SIX,/CGTR6              $
ADD     CGI,CGTR6/CGTRAN                $
$---------------------------------------$
MPYAD   CGTRAN,RBRSET,/RBRCG            $ 
TYPE  PARM,,I,Y,RBVEC=-1                $ Output RBVEC to unit 26
IF (RBVEC > -1) THEN                    $ if requested by parameter RBVEC
  MESSAGE //'  User set Parameter RBVEC > -1, '/
            'R-set rigid body vectors '/
            'written to unit 26       ' $
OUTPUT4  RBRCG,,,,//-1/26               $ 
ENDIF                                   $ 
TRNSP   RBRCG/RBRCGT                    $ CHECK NEW RIGID BODY
SMPYAD  RBRCG,MR,RBRCGT,,,/RBMCG/3      $ WEIGHT ABOUT CG
ADD     RBMCG,/RBCGWT/C1OVR             $
MATPRT  RBCGWT//                        $
$---------------------------------------$
DECOMP  RBMCG/RBMCGL,RBMCGU,,           $
MATGEN  ,/ID6/1/6                       $ GENERATE NLF ABOUT
FBS     RBMCGL,RBMCGU,ID6/RBMCGI        $         CG
PARTN   MRRGN,,MP/MBBH,,,/1             $
MPYAD   RBRCG,MBBH,/RBMBBH/0            $
MPYAD   RBMCGI,RBMBBH,/NLFA/0           $
$---------------------------------------$
MATGEN  ,/I3T/1/3                       $
MATGEN  ,/I3B/1/3                       $ CREATE SCALE MATRIX
MATGEN  ,/PI3/6/6/3/3                   $ FOR NLF G'S
ADD     I3T,/I3T1/CWTMS                 $
MERGE   I3T1,,,I3B,PI3,/SCALE/          $
MPYAD   SCALE,NLFA,/NLF/0               $
PARAM //'ADD'/S,N,NLTM1/NORSET/6        $
MATGEN  ,/PLTM/6/NLTM1/6/NORSET         $
$---------------------------------------$
IF (NORSET > 6) THEN                    $
  PARAM  //'ADD'/S,N,NCBR/NORPN/
         NORSET                         $ IF REDUNDANT
  MATGEN ,/MPR/6/NCBR/NORPN/NORSET      $ BOUNDARY EXISTS
  MERGE  NLF,MBBH,,KBB,MPR,PLTM/
         LTM/1                          $ PLACE I/F INFO AT END
ELSE                                    $
  MERGE   NLF,MBBH,,,,PLTM/LTM/1        $ OR NOT
ENDIF                                   $
$ $---------------------------------------$
SDR1     USET,,PHIX,,,GOT,GM,,KFS,,,/         
         PHIG,,/1/'REIGS'                     $ OUTPUT:	MASS, STIFF
PARAM    //'NOP'/S,N,NOUSET=1                 $ LOOP FOR U2 AND
PARAML   USET//'TRAILER'/4///S,N,NOUSET//'U1' $ LTM, U1 AND G 
PRTPARM  //0/'NOUSET'                         $ SET MODESHAPES 
$ 
$PARAM   //'NOP'/S,Y,PHGBAS=-1                     $ 
TYPE	PARM,,I,Y,PHGBAS=-1                         $
$  
IF (PHGBAS>-1) THEN			      $  >>> PHIG output 
 VECPLOT  PHIG,BGPDTS,EQEXINS,CSTMS,CASES,,,,/PHIG2,,,,/0/0/1   $ 
 MESSAGE  //'PHIG converted to Basic '/
            'output by user request'/        $  
ELSE                                         $     
 COPY     PHIG/PHIG2/ALWAYS/-1               $ 
ENDIF
$                                              
IF (NOUSET>-1) THEN                          $  >>> USER SETS DECLARED
  MESSAGE //'  User set partition of PHIG, called '/
            'PHI1, output to unit 31 with '/
            'KRRGN, MRRGN, and LTM matrices' $ 
  VEC	   USET/XRSPG/'BITID'////'U1'        $ 
  PARTN	   PHIG2,,XRSPG/,PHI1,,/1/           $
  $PARAM   //'NOP'/S,Y,PHGOUT=-1
  TYPE	PARM,,I,Y,PHGOUT=-1                         $
  IF (PHGOUT>-1) THEN
  MESSAGE //'  Parameter PHGOUT > -1, PHIG matrix '/
             'output to unit 31 with KRRGN, '/
             'MRRGN,LTM, and PHI1 matrices'  $
  OUTPUT4    KRRGN,MRRGN,LTM,PHI1,PHIG2//-1/31   $
  ELSE
  OUTPUT4    KRRGN,MRRGN,LTM,PHI1,//-1/31    $    
  ENDIF
ELSE
  IF (PHGOUT>-1) THEN
  OUTPUT4    KRRGN,MRRGN,LTM,PHIG2,//-1/31   $  >>> NO USER SETS DECLARED
  ELSE                                       $ 
   OUTPUT4  KRRGN,MRRGN,LTM,,//-1/31         $  Put everything in unit 31
  ENDIF                                      $
ENDIF                                        $ 
$
$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
$   PHIZ: displacements due to boundary and modal accelerations
$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
$
PARTN PHIG,MP,/PHIRB2,,PHIFLEX,/1/      $
$
$ The following two lines will print the cantilevered mode shapes to
$ the .f06 file if requested in case control.  These are not the full
$ set of shapes which are output in the KMNP file or the PHIZ file.
$
$SDR2    CASES,CSTMS,MPTS,DIT,EQEXINS,SILS,,,BGPDTS,LAMA,,PHIFLEX,EST,
$        XYCDB,,,,,,,,,/,,OPFLEX,,,,/'REIG'/S,N,NOSORT2=-1/  $
SDR2    CASES,CSTMS,MPTS,DIT,EQEXINS,SILS,,LAMA,BGPDTS,,,PHIFLEX,
        EST,XYCDB,,,,,,,,,,,,,,/,,OPFLEX,,,,,,,,,
        /'REIG'/S,N,NOSORT2=-1/  $
OFP     OPFLEX//                        $ 
$
DIAGONAL KWW/LAMINV/'SQUARE'/-1.        $
MPYAD PHIFLEX,LAMINV,/PHIZFLEX//-1      $
$
VEC USET/PVGF/'G'/'F'/'COMP'            $
VEC USET/PVNF/'N'/'F'/'COMP'            $
VEC USET/PVF2/'F'/'R'/'COMP'            $
VEC USET/PVNM/'G'/'N'/'COMP'            $
PARTN PHIRB2,,PVGF/PHIRBF,,,/1          $
PARTN PHIRBF,,PVF2/,PHIRBF2,,/1         $
PARTN KFF,PVF2,/,,,KFF2/-1              $
PARTN MFF,PVF2,/,MFR2,,MFF2/-1          $
MPYAD MFF2,PHIRBF2,MFR2/MIF2//-1/-1/    $
DECOMP KFF2/LFF2,,,/1                   $
FBS LFF2,,MIF2/PHIZ2RB                  $
$
$
MERGE, ,PHIZ2RB,,,,PVF2/PHIZRBF/1       $
MERGE PHIZRBF,,,,,PVNF/PHIZRBN/1        $
MPYAD GM,PHIZRBN,/PHIZRBM               $
PARAML PHIZRBN//'NULL'////S,N,NOPHZN    $ 
PARAML GM//'NULL'////S,N,NOMSET         $ 
$ 
IF (NOMSET>-1) THEN                       $ 
  MERGE PHIZRBN,PHIZRBM,,,,PVNM/PHIZRB/1  $
ELSE                                      $ 
  EQUIVX PHIZRBN/PHIZRB/ALWAYS              
ENDIF                                     $ 
$
MERGE  PHIZRB,,PHIZFLEX,,MP,/PHIZA1/1/    $
$
$
IF (NORSET >6)THEN                        $ PLACE I/F DISPLACEMENTS AFTER
  MERGE  PHIZA1,,PHIRB2,,MPR,/PHIZG/1     $ THE BOUNDARY AND MODAL ACCEL.
ELSE                                      $ DATA IF REDUNDANT
  EQUIVX  PHIZA1/PHIZG/ALWAYS             $
ENDIF                                     $
$
$SDR2    CASES,CSTMS,MPTS,DIT,EQEXINS,SILS,,,BGPDTS,LAMA,,PHIZG,EST,
$        XYCDB,,,,,,,,,/,,,OES2,OEF2,,/'REIG'/NOSORT2/  $
SDR2    CASES,CSTMS,MPTS,DIT,EQEXINS,SILS,,LAMA,BGPDTS,,,PHIZG,
        EST,XYCDB,,,,,,,,,,,,,,/,,,OES2,OEF2,,,,,,,/'REIG'/NOSORT2/  $
OFP     OEF2,OES2//                     $
$---------------------------------------$
CALL    DBFETCH /KELM,KDICT,ECTS,GPECT,/1/1/0/0/0      $
CALL    DBFETCH /SILS,VELEM,MGG,,/1/1/0/0/0              $
MPYAD MGG,PHIG,/LOADGB//-1              $ MAKE APPLIED LOAD VECTOR FOR
$                                       $ CONSTRAINT AND FLEX-BODY
$                                       $ INERTIA TERMS - see note 7 supra
IF (NORSET >6)THEN                      $ 
  MERGE  LOADGB,,,,MPR,/LOAD/1/         $ MATCH LOAD SIZE TO PHIZG SIZE
ELSE                                    $
  EQUIVX  LOADGB/LOAD/ALWAYS            $
ENDIF                                   $
$
PARAML    PHIZG//'TRAILER'/1/S,N,PZCOL// $
MATGEN   ,/UMI/4/PZCOL/3/0/PZCOL/0/0/0/PZCOL/ $
LAMX   UMI,/LAMA2/ $
GPFDR CASES,PHIZG,KELM,KDICT,ECTS,EQEXINS,GPECT,,LOAD,
      BGPDTS,LAMA2,CSTMS,VELEM,,,,,,,,,,,/ONRGY4,OGPFB4,,/'REIG'/TINY    $
OFP ONRGY4,OGPFB4//                                         $
$ 
$---------------------------------------------------$
$PARAM   //'NOP'/S,Y,PHZOUT=-1                       $ LOOP FOR U2 AND
TYPE	PARM,,I,Y,PHZOUT=-1                          $
IF (PHZOUT > -1) THEN                               $ G SET PHIZ OUTPUT
 NOUSET=2                                           $ LTM, U1 AND G 
 PARAML   USET//'TRAILER'/4///S,N,NOUSET//'U2'            $ SET MODESHAPES 
 IF (NOUSET>-1) THEN                                $ 
  MESSAGE //'  User set partition of PHIZ, called '/
            'PHI2, output to unit 32'               $ 
  VEC	  USET/XRSPZ/'BITID'////'U2'	            $ 
  PARTN    PHIZG,,XRSPZ/,PHI2,,/1/                  $ 
  OUTPUT4  PHI2,,,,//-1/32                          $    
 ELSE                                               $
  OUTPUT4  PHIZG,,,,//-1/32                         $    
 ENDIF                                              $ 
ENDIF                                               $
$---------------------------------------------------$
$  
VEC      USET/VGT/'G'/'T'/'COMP'        $ MODAL MASS PARTICIPATION
PARTN    RBGL,VGT,/RBASET,,,/1          $ SECTION 
MPYAD    CGTRAN,RBASET,/RBACG           $    ABOUT CG
MPYAD    RBACG,MAA,/RBMAA/              $
MPYAD    RBMAA,PHILA,/RBMPHI/           $
DIAGONAL RBMPHI/MPHI2/'WHOLE'/2.        $
ADD      MPHI2,/EFWGHT/C1OVR            $
MATGEN,  /IDP/1/NEIGV                   $
DIAGONAL IDP/CIDP/'COLUMN'/1.           $
MPYAD    EFWGHT,CIDP,/WTSUM/            $ OUTPUT
MATPRT   EFWGHT//                       $    EFFECTIVE WTS = EFWGHT
MATPRT   WTSUM//                        $    SUM OF WTS    = WTSUM
$---------------------------------------$
EXIT                                    $ 
ENDALTER
$
COMPILE SUBDMAP=SEMRM,SOUIN=MSCSOU,NOREF,LIST
ALTER 13
CALL    DBSTORE MGG,,,,//1/1/'     '/0/                           $ 
ENDALTER