$
$     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 version of alter2ha.v707 - 10/30/00 - corrected problem which
$    occurs if exterior dof are in different order in the creation and 
$    assembly runs...TLR
$
$   alter2ha.v707  -  9/7/99
$
$   alter2ha.v70  --- July-97
$
echooff $
$
$ DMAP TO READ IN CRAIG-BAMPTON MATRICES FROM RUN USING
$   FILE alter1ha.v70 INCLUDING OTM
$
$ FILE alter2ha.v70  - updated to use INPUTT2 - if this option is used, multiple
$  superelements may be processed in a single run. For each superelement coming
$  from an external source, simply include PARAM,INFILE,xx in the Partitioned Bulk 
$  Data section for that superelement (xx is the unit id of the file containing
$  the INPUTT2 data from the appropriate alter1g run.
$
$     INFILE => (default = 0) where the input is comming from.
$             if INFILE = 0 - DMIG (as in previous versions of the alter)
$
$             if INFILE >0, then INPUTT2 from unit INFILE for the DMIG
$                           NOTE: each superelement may have a unique
$                                 value for INFILE, therefore, multiple
$                                 superelements may now be processed.
$                                 Also, if INFILE>0, then the case
$                                 control commands K2GG, M2GG, and B2GG
$                                 are not required as they are if the
$                                 matrices are read in by DMIG.
$
$     NEUTRAL => indicate if the OTM are on the INPUTT2 file -
$             if NEUTRAL <0 (default = -1) the otm are on DTI and DMI entries
$                NEUTRAL>0 the OTM are on the INPUTT2 file (neutral format)
$                          but the tables are in DTI entries (the tables are
$                          not described in the NDDL and cannot be written
$                          using the neutral format))
$      NOTE - if NEUTRAL>0, then special effort is required to used multiple
$                           superelements, since the tables in the punch file from
$                           the run using alter1g would all have the same name.
$
$
$  When reading using INPUTT2, there are dummy matrices read in to indicate which
$  datablocks are being read - these dummy matrices are identified as follows:
$
$    OUTFLAG1 (value=1.0) => kaa (or kaan if adding matrices) in MATPOOL format
$    OUTFLAG2 (value=2.0) => maa (or maan if adding matrices) in MATPOOL format
$    OUTFLAG3 (value=3.0) => klaa in MATPOOL format
$    OUTFLAG4 (value=4.0) => mlaa in MATPOOL format
$    OUTFLAG5 (value=5.0) => baa in MATPOOL format
$    OUTFLAG6 (value=6.0) => phixq in MATPOOL format
$    OUTFLAG7 (value=7.0) => phixt in MATPOOL format
$    OUTFLG75 (value=7.5) => k4aa in MATPOOL format
$    OUTFLAG8 (value=8.0) => dis (output from DRMH1 or DRMS1) in MATPOOL format
$    OUTFLG85 (value=8.5) => tabdis (output from DRMH1 or DRMS1) if NEUTRAL=-1
$    OUTFLAG9 (value=9.0) => spcf (output from DRMH1 or DRMS1) in MATPOOL format
$    OUTFLG95 (value=9.5) => tabspcf (output from DRMH1 or DRMS1) if NEUTRAL=-1
$    OUTFLG10 (value=10.0) => stress (output from DRMH1 or DRMS1) in MATPOOL format
$    OUTFL105 (value=10.5) => tabstr (output from DRMH1 or DRMS1) if NEUTRAL=-1
$    OUTFLG11 (value=11.0) => forc (output from DRMH1 or DRMS1) in MATPOOL format
$    OUTFL115 (value=11.5) => tabfor (output from DRMH1 or DRMS1) if NEUTRAL=-1
$    OUTFLG12 (value=12.0) => mpcf (output from DRMH1 or DRMS1) in MATPOOL format
$    OUTFL125 (value=12.5) => tabmpcf (output from DRMH1 or DRMS1) if NEUTRAL=-1
$    OUTFLG13 (value=13.0) => flag that OUTPUT2 file is complete (written several times)
$
$
$------------------------------------------------------------
$-------------------------------------------------------------
$COMPILE IFPL, SOUIN=MSCSOU, NOREF
$alter 1
$putsys(0,192) $
$ALTER 103
$CALL DBSTORE DMI,DMINDX,dti,dtindx,//0/0/'DBALL'/0 $
compile IFPS
$putsys(0,192) $
alter 'ifp.*bulk.*igeom1.0.*pvtx'
type parm,nddl,char8,n,zname $
type parm,,i,y,infile=0,neutral=-1
$message //'in ifps - seid= '/seid/' infile = '/infile $
$
$ store infile in database as zuzri1
$
type parm,nddl,i,n,zuzri1,zuzr1
zuzr1=seid $
zname = 'infile' $
zuzri1=infile $
zname = 'neutral' $
zuzri1 = neutral $
$
if(infile>0)then $ read information from external file
  message //'reading data for superelement '/seid/
          ' from unit '/infile $
CALL DBSTORE iDMI,iDMINDX,iDTI,iDTINDX,//seid/0/'DBALL'/0 $
  delete  /ibulk,IGEOM1.0,IEPT.0,IMPT.0,IEDT $
  delete  /IDIT,IDYNAMIC,IGEOM2.0,IGEOM3.0,IGEOM4.0 $
  delete  /IEPTA,UNUSED2,IMTPOL.0,IAXIC,PVTX $
  delete  /IDMI,IDMINDX,IDTI,IDTINDX, $
  delete  /DEFUSET,IEDOM,DEQATNX,DEQINDX,CONTACT $
  delete  /OINT,UNUSED3,,, $
  type parm,,char8,y,label='xxxxxxxx' $
  inputt2 /mattyp,ibulk,,,/-1/infile/label $ $
  IFP     IBULK/                                                                 
          IGEOM1.0,IEPT.0,IMPT.0,IEDT,IDIT,IDYNAMIC,                             
          IGEOM2.0,IGEOM3.0,IGEOM4.0,IEPTA,UNUSED2,                              
          IMTPOL.0,IAXIC,PVTX,IDMI,IDMINDX,IDTI,IDTINDX,                         
          DEFUSET,IEDOM,DEQATNX,DEQINDX,CONTACT,OINT,UNUSED3/                    
          S,N,NOGOIFP0/S,N,RUNIFP3/S,N,RUNIFP4/S,N,RUNIFP5/
          S,N,RUNIFP6/S,N,RUNIFP7/S,N,RUNIFP8/S,N,RUNIFP9/SEID $                             
endif $
$
$alter 103
alter 'equivx.*idtindx.*dtindx' $
CALL DBSTORE DMI,DMINDX,DTI,DTINDX,//seid/0/'DBALL'/0 $
$
$ modify semg to read inputt2 if wanted
$
compile semg
$alter 14 $ after last TYPE PARM...
alter 15
type parm,,i,n,infile = 0, neutral=-1
type parm,,rs,n,flag
type parm,,i,n,nogood=-1
type parm,nddl,i,n,zuzri1,zuzr1
type parm,nddl,char8,n,zname $
$
$alter 100 $ 97
$alter 156 $
alter 'endif.*fscoup.*and.*seid.*0' $
zuzr1=seid $
zname = 'infile' $
infile = zuzri1 $
zname = 'neutral' $
neutral = zuzri1 $
message //'in semg infile = '/infile $
if (infile<=0)then $ standard DMIG matrix input
$alter 101 $ 98
$alter 157 $ after "MTRXIN"
alter 'mtrxin ' $ Read INPUTT2 matrices
else $ (infile>0)
$
message //'param infile is >0, therefore, input matrices are on '/
          'inputt2 file '/infile $
message //'no k2gg, m2gg, or b2gg matrices will be read in using '/
          'dmig in the bulk data section for'/
          'this superelement' $
$ only the first 16 datablocks are checked for matrices
$   (remember there is a set of matrices for each datablock)
$
 inputt2 /mat1,mat2,mat3,mat4,/-1/infile $
 message //'checking first 2 blocks for matrices' $
  call getflag mat1,mat2,uset0,eqexins,sils/
               temp/s,flag/s,nogood/seid/lusets $
  delete /mat1,mat2,,, $
  message //'flag = '/flag/' nogood ='/nogood $
  message //'checking blocks 3 & 4 ' $
   if(nogood<>-1) call getflag mat3,mat4,uset0,eqexins,sils/
                       temp1/
                       s,flag/s,nogood/seid/lusets $
  delete /mat3,mat4,,, $
  if(nogood<>-1) then $
   inputt2 /mat5,mat6,mat7,mat8,//infile $
  message //'checking matrices 5 & 6 ' $
  call getflag mat5,mat6,uset0,eqexins,sils/temp2/
               s,flag/s,nogood/seid/lusets $
   message //'flag = '/flag/' nogood ='/nogood $
   message //'checking matrices 7 & 8 ' $
   if(nogood<>-1) call getflag mat7,mat8,uset0,eqexins,sils/
                       temp3/
                       s,flag/s,nogood/seid/lusets $
  endif $
  if(nogood<>-1) then $
   inputt2 /mat9,mat10,mat11,mat12,//infile $
  message //'checking matrices 9 & 10 ' $
  call getflag mat9,mat10,uset0,eqexins,sils/temp4/
               s,flag/s,nogood/seid/lusets $
   message //'flag = '/flag/' nogood ='/nogood $
   message //'checking matrices 11 & 12 ' $
   if(nogood<>-1) call getflag mat11,mat12,uset0,eqexins,sils/
                       temp5/
                       s,flag/s,nogood/seid/lusets $
  endif $
  if(nogood<>-1) then $
   inputt2 /mat13,mat14,,,//infile $
  message //'checking matrices 13 & 14 ' $
  call getflag mat13,mat14,uset0,eqexins,sils/temp6/
               s,flag/s,nogood/seid/lusets $
   message //'flag = '/flag/' nogood ='/nogood $
  endif $
$
  if(nogood<>-1) then $
   inputt2 /mat15,mat16,,,//infile $
  message //'checking matrices 15 & 16 ' $
  call getflag mat15,mat16,uset0,eqexins,sils/
               temp75/s,flag/s,nogood/seid/lusets $
   message //'flag = '/flag/' nogood ='/nogood $
  endif $
$ store matpool tables for use when needed
$
$dbdict select(name,size,seid,peid,zuzr1,zuzr2,zname,vers,
$              trl1,trl2,trl3) $
$
$ check if K2GG, M2GG, B2GG
$
type parm,,i,n,gotit
 call dbfetch /maap,kaap,baap,,/seid/0/0/0/s,gotit $
$if (nok2jj=-1) then $
 mtrxin ,,kaap,EQEXINS,SILS,/kaaext,,/LUSETS/
         S,N,nok2jjx///1 $
$  equivx kaaext/k2jj/always $
delete /kjjz,,,, $
equivx kaaext/kjjz/always $
$endif $
$ mass matrix
$  
$if (nom2jj=-1) then $
  mtrxin ,,maap,EQEXINS,SILS,/maaext,,/LUSETS/
         S,N,NOM2jjx///1 $
$  equivx maaext/m2jj/always $
delete /mjjx,,,, $
equivx maaext/mjjx/always $
$endif $
$
$ damping matrix
$if (nobgg=-1)then $
 mtrxin ,,baap,EQEXINS,SILS,/baaext,,/LUSETS/
         S,N,NOb2jjx///1 $
$  equivx baaext/b2jj/always $
delete /bjjx,,,, $
equivx baaext/bjjx/always $
$endif $
endif $ infile>0
$ 
$ delete matpool datablocks
$
call dbmgr //5/seid/0/0/0/0/'maap  '/'kaap  '/'baap  '/
             '       '/'       ' $
$
$ modify SEKR0
$
COMPILE SEKR0
ALTER 2 $
PUTSYS(1,125) $ ALLOW FOR LATER RESTART WITHOUT WARNING
$TYPE PARM,NDDL,I,N,SEID,PEID,ZUZR1 $ QUALIFERS
type parm,,i,n,nogood=-1
type parm,,rs,n,flag
type parm,,i,n,infile = 0,lusets=-1
type parm,,i,y, neutral = -1
TYPE PARM,,I,N,GARBAGE $
type parm,nddl,i,n,zuzr1,zuzri1
type parm,nddl,char8,n,zname
$
$ALTER 28 $  BEFORE GPSP - READ OTM AND LET THE USER KNOW NOT TO WORRY
alter 'gpsp..*knn.*uset'(,-1) $
$
$ READ OTM & STORE
$
PARAML   USET0//'USET'//////'G'/S,N,LUSETS
zuzr1=seid $
zname='infile' $
infile = zuzri1 $
zname = 'neutral' $
neutral = zuzri1 $
if(neutral>0 and infile>0) then $
 CALL DBFETCH /idti,idtindx,,,/seid/0/0/0/S,GARBAGE $
 dtiin idti,idtindx/TABDIS,TABSPCF,TABSTR,TABFOR,tabmpcf,,,,,/ $
 matmod tabdis,,,,,/tabdis1,/32/1 $
 matmod tabfor,,,,,/tabfor1,/32/1 $
 matmod tabstr,,,,,/tabstr1,/32/1 $
 matmod tabspcf,,,,,/tabspcf1,/32/1 $
 matmod tabmpcf,,,,,/tabmpcf1,/32/1 $
 CALL DBSTORE TABDIS1,TABSPCF1,TABSTR1,TABFOR1,tabmpcf1//
             SEID/0/'DBALL'/0 $ STORE tables
endif $
$
if(infile>0) then $
$
$ check inputt2 file for matrices
$
$  read matrices from INPUTT2 file
 inputt2 /mat1,mat2,mat3,mat4,/-1/infile $ rewind and start at beginning
$
$ check input flag
$ - odd matrices are input flags
$
  message //'checking first 2 matrices for otm' $
  call getflag mat1,mat2,uset0,eqexins,sils/
               temp/s,flag/s,nogood/seid/lusets $
  delete /mat1,mat2,,, $
  message //'flag = '/flag/' nogood ='/nogood $
$
  message //'checking matrices 3 & 4 ' $
  if(nogood<>-1) call getflag mat3,mat4,uset0,eqexins,sils/
                      temp1/
                      s,flag/s,nogood/seid/lusets $
  if(nogood<>-1) then $
   inputt2 /mat5,mat6,mat7,mat8,//infile $
$
  message //'checking matrices 5 & 6 ' $
   call getflag mat5,mat6,uset0,eqexins,sils/temp2/
                s,flag/s,nogood/seid/lusets $
   message //'flag = '/flag/' nogood ='/nogood $
$
   message //'checking matrices 7 & 8 ' $
   if(nogood<>-1) call getflag mat7,mat8,uset0,eqexins,
                       sils/temp3/
                       s,flag/s,nogood/seid/lusets $
  endif $
$
  if(nogood<>-1) then $
   inputt2 /mat9,mat10,mat11,mat12,//infile $
  message //'checking matrices 9 & 10 ' $
   call getflag mat9,mat10,uset0,eqexins,sils/temp4/
                s,flag/s,nogood/seid/lusets $
   message //'flag = '/flag/' nogood ='/nogood $
$
   message //'checking matrices 11 & 12 ' $
   if(nogood<>-1) call getflag mat11,mat12,uset0,eqexins,
                       sils/temp5/
                       s,flag/s,nogood/seid/lusets $
  endif $
  if(nogood<>-1) then $
   inputt2 /mat13,mat14,mat15,mat16,//infile $
  message //'checking matrices 13 & 14 ' $
   call getflag mat13,mat14,uset0,eqexins,sils/temp6/
                s,flag/s,nogood/seid/lusets $
   message //'flag = '/flag/' nogood ='/nogood $
   message //'checking matrices 15 & 16 ' $
   if(nogood<>-1) call getflag mat15,mat16,uset0,eqexins,
                       sils/temp7/
                       s,flag/s,nogood/seid/lusets $
  endif $
  if(nogood<>-1) then $
   inputt2 /mat17,mat18,mat19,mat20,//infile $
  message //'checking matrices 17 & 18 ' $
   call getflag mat17,mat18,uset0,eqexins,sils/temp8/
                s,flag/s,nogood/seid/lusets $
   message //'flag = '/flag/' nogood ='/nogood $
   message //'checking matrices 19 & 20 ' $
   if(nogood<>-1) call getflag mat19,mat20,uset0,eqexins,
                       sils/temp9/
                       s,flag/s,nogood/seid/lusets $
   message //'flag = '/flag/' nogood ='/nogood $
  endif $
  if(nogood<>-1) then $
   inputt2 /mat21,mat22,mat23,mat24,//infile $
  message //'checking matrices 21 & 22 ' $
   call getflag mat21,mat22,uset0,eqexins,sils/temp10/
                s,flag/s,nogood/seid/lusets $
   message //'flag = '/flag/' nogood ='/nogood $
   message //'checking matrices 23 & 24 ' $
   if(nogood<>-1) call getflag mat23,mat24,uset0,eqexins,
                       sils/temp11/
                       s,flag/s,nogood/seid/lusets $
   message //'flag = '/flag/' nogood ='/nogood $
  endif $
  if(nogood<>-1) then $
   inputt2 /mat25,mat26,mat27,mat28,//infile $
  message //'checking matrices 25 & 26 ' $
   call getflag mat25,mat26,uset0,eqexins,sils/temp12/s,flag/
                s,nogood/seid/lusets $
   message //'flag = '/flag/' nogood ='/nogood $
   message //'checking matrices 27 & 28 ' $
   if(nogood<>-1) call getflag mat27,mat28,uset0,eqexins,
                       sils/temp13/
                       s,flag/s,nogood/seid/lusets $
   message //'flag = '/flag/' nogood ='/nogood $
  endif $
  if(nogood<>-1) then $
   inputt2 /mat29,mat30,mat31,mat32,//infile $
  message //'checking matrices 29 & 30 ' $
   call getflag mat29,mat30,uset0,eqexins,sils/temp14/
                s,flag/s,nogood/seid/lusets $
   message //'flag = '/flag/' nogood ='/nogood $
   message //'checking matrices 31 & 32 ' $
   if(nogood<>-1) call getflag mat31,mat32,uset0,eqexins,
                       sils/temp15/
                       s,flag/s,nogood/seid/lusets $
   message //'flag = '/flag/' nogood ='/nogood $
  endif $
  if(nogood<>-1) then $
   inputt2 /mat33,mat34,mat35,mat36,//infile $
  message //'checking matrices 33 & 34 ' $
   call getflag mat33,mat34,uset0,eqexins,sils/
                temp16/s,flag/s,nogood/seid/lusets $
   message //'flag = '/flag/' nogood ='/nogood $
   message //'checking matrices 35 & 36 ' $
   if(nogood<>-1) call getflag mat35,mat36,uset0,eqexins,
                       sils/temp17/
                       s,flag/s,nogood/seid/lusets $
   message //'flag = '/flag/' nogood ='/nogood $
  endif $
$else $
$ CALL DBFETCH /iDMI,iDMINDX,,,/seid/0/0/0/S,GARBAGE $
$ DMIIN iDMI,iDMINDX/DIS,SPCF,STRESS,FORC,mpcf,,,,,/ $
$ CALL DBSTORE DIS,SPCF,STRESS,FORC,mpcf//SEID/0/'DBALL   '/0 $ STORE MATRICES
$endif $
$dbdict select(name,size,seid,peid,zuzr1,zuzr2,zname,vers,trl1,trl2,trl3) $
$
MESSAGE //'  ' $
MESSAGE //'UFM 5290 WILL OCCUR FOR Q-SET DOF WHICH'/
          ' HAVE COMPONENT MODES ATTACHED' $
MESSAGE //'  ' $
MESSAGE //'  THIS INDICATES THAT THE COMPONENT MODES HAVE'/
          ' BEEN PROPERLY READ IN - DO NOT PANIC' $
MESSAGE //'  ' $
MESSAGE //'  ' $
endif $ - read inputt2
$
alter 'gpsp.*knn.*uset'
if(infile>0)then $
 ngerr = 0 $ disable termination due to fatal in gpsp
$
$ DELETE EFFECTS OF GPSP AND PARTITION MATRICES
$
 PURGEX /USET,,,,/ALWAYS $
 EQUIVX USET0/USET/ALWAYS $
endif $
$
$ -----------------------------------------------------------------
$
compile sekmr
$
$
alter 'call.*sekr '(,-1) 
$
$
TYPE PARM,NDDL,CHAR8,N,K2GG,M2GG $
TYPE PARM,,CHAR8,N,TEMPM,TEMPK $
TYPE PARM,,I,N,NASET,SPARE,SPARET $
type parm,,i,n,nogood=-1
type parm,,rs,n,flag
type parm,,i,n,infile = -1 $
type parm,nddl,i,n,zuzr1,zuzri1 $
type parm,nddl,char8,n,zname $
type parm,,i,y, neutral = -1
$
zuzr1=seid $
zname = 'infile'
infile = zuzri1 $
if(infile>0)then $ skip sekr if infile>0 
$ 
CALL PMLUSET  USET//S,NOASET/S,NOBSET/S,NOCSET/S,NOGSET/S,NOLSET/
           S,NOOSET/S,NOQSET/S,NORSET/S,NOSSET/S,NOTSET/
           S,NOVSET/S,NOA/S,NOSET/S,NORC/S,NOMSET/0 $
$
$ CHECK FOR NULL STIFFNESS MATRIX - IF NULL, THEN CREATE TRAILER
$
TYPE PARM,,I,N,NOKGG $
PARAML KGG//'PRESENCE'////S,N,NOKGG $
IF (NOKGG=-1)MATGEN ,/KGG/7/LUSETS/LUSETS/0/2 $
$
  UPARTN USET,KGG/KAA,,,/'G'/'A'/'O' $
  MODTRL KAA////6 $
$
$ FOLLOWING STATEMENT ONLY INCLUDED TO SHOW THAT MATRICES GOT IN
$MATPRN KAA// $
$
$ CHECK FOR NULL STIFFNESS MATRIX - IF NULL, THEN CREATE TRAILER
$
PARAML mGG//'PRESENCE'////S,N,NOmGG $
IF (NOmGG=-1)MATGEN ,/mGG/7/LUSETS/LUSETS/0/2 $
$
  UPARTN USET,mGG/mAA,,,/'G'/'A'/'O' $
  MODTRL mAA////6 $
endif $
$
$
$ READ IN TRANSFORMATIONS
$
zuzr1=seid $
zname = 'infile' $
infile = zuzri1 $
zname = 'neutral'
neutral = zuzri1 $
if (infile>0) then $
$ CALL dbstore matpool,,,,//seid/0/'DBALL   '/0 $ STORE MATRICES
$ check if INPUTT2
 type parm,,i,n,gotit = 0 $
 call dbfetch /phixqp,phixtp,,,/seid/0/0/0/s,gotit $
 MTRXIN  ,,phixqp,EQEXINS,SILS,/PHIXQ,,/LUSETS/S,N,NOPXQ $
 MTRXIN  ,,phixtp,EQEXINS,SILS,/PHIXT,,/LUSETS/S,N,NOPXT $
call dbmgr //5/seid/0/0/0/0/'phixqp','phixtp'/'       '/
            '       '/'       ' $
$else $
$ PARAML   MATPOOL//'PRESENCE'////S,N,NOMPOOL $
$ message //'nompool ='/nompool/'lusets ='/lusets $ $
$ MTRXIN  ,,MATPOOL,EQEXINS,SILS,/PHIXQ,PHIXT,/LUSETS/S,N,NOPXQ/
$        S,N,NOPXT $
$$ MATPRN  PHIXQ,PHIXT// $
$endif $ checking inputt2
COND  NOPXT,NOPXT $
$
$ FOLLOWING ADDED TO CHECK DMIG PROBLEM (fixed in v68)
$  THE DMIG ENTRIES SHOULD HAVE 'NCOL'
$  CORRECT. IF NOT, INCORRECT ANSWERS MAY
$  RESULT
$ 10/30/00 - reduce columns from 'G' size - TLR - xxxxxxxxxxxxxxxxxx
upartn uset,phixt/phixt1,,,/'g'/'t'/'q'/2 $
upartn uset,phixq/phixq1,,,/'g'/'q'/'t'/2 $
PARAML PHIXT1//'TRAILER'/1/S,N,NCOLXT $
PARAML PHIXQ1//'TRAILER'/1/S,N,NCOLXQ $
TYPE PARM,,I,Y,QUIT=0 $
IF (NCOLXQ<>NOqSET OR NCOLXT<>NOtSET)THEN $  POSSIBLE ERROR
  MESSAGE //' DMAP FATAL ERROR - THE NUMBER OF COLUMNS'/
            ' IN EITHER PHIXQ OR PHIXT DOES NOT MATCH THE '/
            'NUMBER OF DOF IN THE ASSOCIATED SET ' $
  message //' ' $
  MESSAGE //'CHECK THE HEADER ENTRY ON THE DMIG - NCOL'/
           ' for phixq EQUAL '/NOqSET/' ncol for phixt '/
           'should equal '/notset  $
  message //'NCOL for the phixq matrix is '/ncolxq $
  message //'NCOL for the phixt matrix is '/ncolxt $
  message //' ' $
  MESSAGE //' THIS MAY PRODUCE INCORRECT OR UNREASONABLE RESULTS'/
           ' SINCE THESE MATRICES ARE USED TO APPLY LOADS AND FOR'/
           ' OUTPUT' $
  MESSAGE //'THE RUN WILL TERMINATE NOW UNLESS PARAM,QUIT is -1' $
  MESSAGE //' ' $
  MESSAGE //'THE DATA BASE WILL NOT BE VALID FOR THIS SUPERELEMENT' $
  message //' ' $
  IF (QUIT <>-1)EXIT $
ENDIF $ 
UPARTN USET,PHIXT1/GOAT1,,,/'G'/'O'/'A'/1 $
$MATPRN GOAT1// $
PARAML PHIXT//'TRAILER'/1/S,N,NCOLT $
$IF (NCOLT<>NOASET) THEN $
$MESSAGE //'NOASET ='/NOASET/'    NCOLT ='/NCOLT $
$  SPARET = NOASET-NCOLT $
$  MATGEN ,/MERGT/6/NOASET/NCOLT/SPARET $
$  MERGE  GOAT1,,,,MERGT,/GOT/1 $
$ELSE $
  EQUIVX GOAT1/GOT/ALWAYS $
$ENDIF $
LABEL NOPXT $
$
COND  NOPXQ,NOPXQ $
UPARTN USET,PHIXQ1/GOAQ1,,,/'G'/'O'/'A'/1 $
$PARAML PHIXQ//'TRAILER'/1/S,N,NCOLQ $
$$MATPRN GOAQ1// $
$      MESSAGE //' NCOLQ = '/NCOLQ $
$      IF (NCOLQ<>NOASET) THEN $
$  SPARE = NOASET-NCOLQ $
$  MATGEN ,/MERGQ/6/NOASET/0/SPARE/NCOLQ $
$  MERGE  GOAQ1,,,,MERGQ,/GOQ/1 $
$ELSE $
  EQUIVX GOAQ1/GOQ/ALWAYS $
$ENDIF $
LABEL NOPXQ $
$ADD GOQ,GOT/GOA $
$MATPRN GOQ,GOT,GOA// $
$
$
RETURN $
$
endif $infile>0
$
compile phase1b
$alter 61 $ after "IF ( NOK4AA=-1 ) CALL SEMRB"
alter 'if.*nok4aa.*call.*semrb'(,-2) $
$ READ K4AA
$
$ check inputt2
type parm,,i,n,infile=0 $
type parm,nddl,i,n,zuzr1,zuzri1
type parm,nddl,char8,n,zname
$
zuzr1=seid $
zname = 'infile' $
infile = zuzri1 $
if (infile>0) then $
 type parm,,i,n,gotit = 0 $
 call dbfetch /k4aapp,,,,/seid/0/0/0/s,gotit $
 MTRXIN  ,,k4aapp,EQEXINS,SILS,/k4aaext,,/LUSETS/S,N,NOklaa $
 call dbmgr //5/seid/0/0/0/0/'k4aap'/'       '/'       '/
             '       '/'       ' $
$else $
$ PARAML   MATPOOL//'PRESENCE'////S,N,NOMPOOL $
$ message //'nompool ='/nompool/'lusets ='/lusets $ $
$ MTRXIN  ,,MATPOOL,EQEXINS,SILS,/K4AAEXT,,/LUSETS/
$         S,N,NOKLAA $
$endif $
PARAML   k4aaext//'PRESENCE'////S,N,NOk4aap $
if (nok4aap=>0) upartn uset,k4aaext/k4aa,,,/'G'/'A'/'O' $
$dbdict select(name,size,seid,peid,zuzr1,zuzr2,zname,vers,
$              trl1,trl2,trl3) $
endif $ infile>0
$
$    modify SEMRM
$
COMPILE SEMRM
ALTER 2 $
type parm,,i,n,lusets $
$ALTER 19 $ after "IF ( SKIPSE ) RETURN"
$alter 'equivx.*goat.*goa' $
alter 'if.*skipse.*return' $
$
$ READ KLAA AND MLAA AND REDUCE MATRICES
$
$ check inputt2
type parm,,i,n,infile=0 $
type parm,nddl,i,n,zuzr1,zuzri1
type parm,nddl,char8,n,zname
zuzr1=seid $
zname = 'infile' $
infile = zuzri1 $
if (infile>0) then $
 type parm,,i,n,gotit = 0 $
 call dbfetch /mlaap,klaap,,,/seid/0/0/0/s,gotit $
 MTRXIN  ,,mlaap,EQEXINS,SILS,/mlaaext,,/LUSETS/S,N,NOmlaa $
 MTRXIN  ,,klaap,EQEXINS,SILS,/klaaext,,/LUSETS/S,N,NOklaa $
 call dbmgr //5/seid/0/0/0/0/'mlaap'/'klaap'/'       '/
            '       '/'       ' $
$else $
$ PARAML   MATPOOL//'PRESENCE'////S,N,NOMPOOL $
$ message //'nompool ='/nompool/'lusets ='/lusets $ $
$ MTRXIN  ,,MATPOOL,EQEXINS,SILS,/KLAAEXT,MLAAEXT,/LUSETS/
$         S,N,NOKLAA/S,N,NOMLAA $
$endif $
 IF (NOKLAA<>-1) UPARTN USET,KLAAEXT/KLAA,,,/'G'/'A'/'O' $)
 IF (NOMLAA<>-1) UPARTN USET,MLAAEXT/MLAA,,,/'G'/'A'/'O' $)
$IF (NOMLAA=-1)MESSAGE //'NO MLAA FOUND in matpool FOR SE '/SEID $
$IF (NOKLAA=-1)MESSAGE //'NO KLAA FOUND in matpool FOR SE '/SEID $
$
 UPARTN USET,MGG/MAA,,,/'G'/'A'/'O' $
$
$ FOLLOWING PRINT DONE ONLY TO CONFIRM THAT MATRICES EXIST
$
$MATPRN MAA,MLAA,KLAA// $
$ dbdict select(name,size,seid,peid,zuzr1,zuzr2,zname,vers,
$              trl1,trl2,trl3) $
$DBDIR // $
 RETURN
$
endif $ infile>0
$
$   Add a new subdmap GETFLAG
$
compile getflag $
subdmap getflag mat1,mat2,uset,eqexins,sils/tempxyz/
                flag/nogood/seid/lusets $
type parm,,rs,n,flag
type parm,,i,n,seid=0,lusets
type parm,,i,n,nogood=-1
type parm,,i,n,storit=0
$
 dbstatus mat1//s,n,nomat1 $
if (nomat1>0) then $ first matrix exists
 paraml mat1//'trailer'/1/s,n,nocol $
 paraml mat1//'trailer'/2/s,n,norow $
 if (nocol=1 and norow=1)then $
  paraml mat1//'dmi'/1/1/s,n,flag  $
message //' in getflag, flag = '/flag $
  if (flag>=0. and flag<13.) then $
$  good flag
   nogood = 1 $
$  if flag=99. => IBULK
   if (flag=1.)message //'input matrix is mpkaa' $
   if (flag=2.)message //'input matrix is mpmaa' $
   if (flag=3.)message //'input matrix is mpklaa' $
   if (flag=4.)message //'input matrix is mpmlaa' $
   if (flag=5.)message //'input matrix is mpbaa' $
   if (flag=6.)message //'input matrix is mpphixq' $
   if (flag=7.)message //'input matrix is mpphixt' $
   if (flag=7.5)message //'input matrix is mpk4aa' $
   if (flag=8.)message //'input matrix is dis' $
   if (flag=8.5)message //'input matrix is tabdis' $
   if (flag=9.)message //'input matrix is spcf' $
   if (flag=9.5)message //'input matrix is tabspcf' $
   if (flag=10.)message //'input matrix is stress' $
   if (flag=10.5)message //'input matrix is tabstr' $
   if (flag=11.)message //'input matrix is forc' $
   if (flag=11.5)message //'input matrix is tabfor' $
   if (flag=12.)message //'input matrix is mpcf' $
   if (flag=12.5)message //'input matrix is tabmpcf' $
   if (flag=1.0)then $
    equivx mat2/kaap/always $
    CALL DBSTORE kaap,,,,//seid/0/'DBALL'/s,storit $
    return $
   endif $
   if (flag=2.0)then $
    equivx mat2/maap/always $
    CALL DBSTORE maap,,,,//seid/0/'DBALL'/s,storit $
    return $
   endif $
   if (flag=3.0)then $
    equivx mat2/klaap/always $
    CALL DBSTORE klaap,,,,//seid/0/'DBALL'/s,storit $
    return $
   endif $
   if (flag=4.0)then $
    equivx mat2/mlaap/always $
    CALL DBSTORE mlaap,,,,//seid/0/'DBALL'/s,storit $
    return $
   endif $
   if (flag=5.0)then $
    equivx mat2/baap/always $
    CALL DBSTORE baap,,,,//seid/0/'DBALL'/s,storit  $
    return $
   endif $
   if (flag=6.0)then $
    equivx mat2/phixqp/always $
    CALL DBSTORE phixqp,,,,//seid/0/'DBALL'/s,storit $
    return $
   endif $
   if (flag=7.0)then $
    equivx mat2/phixtp/always $
    CALL DBSTORE phixtp,,,,//seid/0/'DBALL'/s,storit $
    return $
   endif $
   if (flag=7.5)then $
    equivx mat2/k4aapp/always $
    CALL DBSTORE k4aapp,,,,//seid/0/'DBALL'/s,storit $
    return $
   endif $
$ OTM
   if (flag=8.0)then $
    MTRXIN  ,,mat2,EQEXINS,SILS,/disge,,/LUSETS/S,N,NOPXQ $
    upartn uset,disge/dist,,,/'g'/'a'/'o'/1 $
    trnsp dist/dis $
    CALL DBSTORE dis,,,,//seid/0/'DBALL'/s,storit $
    return $
   endif $
   if (flag=8.5)then $
    equivx mat2/tabdis1/always $
    CALL DBSTORE tabdis1,,,,//seid/0/'DBALL'/s,storit $
    return $
   endif $
   if (flag=9.0)then $
    MTRXIN  ,,mat2,EQEXINS,SILS,/spcfge,,/LUSETS/S,N,NOPXQ $
    upartn uset,spcfge/spcft,,,/'g'/'a'/'o'/1 $
    trnsp spcft/spcf $
    CALL DBSTORE spcf,,,,//seid/0/'DBALL'/s,storit $
    return $
   endif $
   if (flag=9.5)then $
    equivx mat2/tabspcf1/always $
    CALL DBSTORE tabspcf1,,,,//seid/0/'DBALL'/s,storit $
    return $
   endif $
   if (flag=10.0)then $
    MTRXIN  ,,mat2,EQEXINS,SILS,/stressge,,/LUSETS/S,N,NOPXQ $
    upartn uset,stressge/stresst,,,/'g'/'a'/'o'/1 $
    trnsp stresst/stress $
    CALL DBSTORE stress,,,,//seid/0/'DBALL'/s,storit $
    return $
   endif $
   if (flag=10.5)then $
    equivx mat2/tabstr1/always $
    CALL DBSTORE tabstr1,,,,//seid/0/'DBALL'/s,storit $
    return $
   endif $
   if (flag=11.0)then $
    MTRXIN  ,,mat2,EQEXINS,SILS,/forcge,,/LUSETS/S,N,NOPXQ $
    upartn uset,forcge/forct,,,/'g'/'a'/'o'/1 $
    trnsp forct/forc $
    CALL DBSTORE forc,,,,//seid/0/'DBALL'/s,storit $
    return $
   endif $
   if (flag=11.5)then $
    equivx mat2/tabfor1/always $
    CALL DBSTORE tabfor1,,,,//seid/0/'DBALL'/s,storit $
    return $
   endif $
   if (flag=12.)then $
    MTRXIN  ,,mat2,EQEXINS,SILS,/mpcfge,,/LUSETS/S,N,NOPXQ $
    upartn uset,mpcfge/mpcft,,,/'g'/'a'/'o'/1 $
    trnsp mpcft/mpcf $
    CALL DBSTORE mpcf,,,,//seid/0/'DBALL'/s,storit $
    return $
   endif $
   if (flag=12.5)then $
    equivx mat2/tabmpcf1/always $
    CALL DBSTORE tabmpcf1,,,,//seid/0/'DBALL'/s,storit $
    return $
   endif $
$
  else if(flag=99.)then $
   nogood = 1 $
   message //'data read from file is bulk data' $
  else $ bad flag
   message //'dmap message from alter2g' $
   message //'during inputt2, the end of file was encountered' $
   message //'the flag is '/flag $
   nogood = -1 $
  endif $
 else $ no good - wrong size on matrix size
  message //'dmap fatal message from alter2g' $
  message //'matrix read by inputt2 has wrong trialer' $
  message //'the flag matrix should be 1x1 and is'/nocol/'x'/norow $
  message //'run terminated' $
  exit $
 endif $
else $ flag matrix doesn't exist
 message //'dmap information message from alter2g'
 message //'attempting to read input matrices - the flag does not exist'
 message //'matrices not read and stored' $
 nogood = -1 $
endif $
return $
end $
$
$ ---------------------------------------------------------------
$
$ remove check for non-null q-set mass terms in semr2
$
compile semr2
alter 'if.*noqset.*notset','if.*noqset.*notset'(,6)
$
$ END OF ALTER2H
$
echoon $