$
$     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.                                
$
$   alter2ga.v707  --  updated 8-5-99
$
$   alter2ga.v705  --- March, 1998
$   
$
$ DMAP TO READ IN CRAIG-BAMPTON MATRICES FROM RUN USING
$   FILE alter1g.v705 INCLUDING OTM
echooff $
$
$ updated for V70.5 - March, 1998
$
$ FILE alter2g.v682  - updated to allow 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 CASE CONTROL
$  SUBCASE for that superelement (xx is the unit id of the file containing
$  the INPUTT2 data from the appropriate alter1g run.
$
$ updated March, 1995 to include MPCFORCE output
$   also included K4AA - element damping matrix from Ge on MATi entry
$
$ updated Jan, 1995 to allow INPUTT2 to be used for the DMIG matrices
$ new parameters added:
$     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)
$
$
$
$ NOTE: IF KAA IS NULL (EX: 6 DOF I/F, THEN THE CASE
$       CONTROL SHOULD NOT REFERENCE IT AND THE HEADER
$       ENTRY FOR IT MUST BE REMOVED FROM THE PUNCH FILE
$
$------------------------------------------------------------
$-------------------------------------------------------------
$COMPILE IFPL, SOUIN=MSCSOU, LIST, NOREF
$alter 1
$putsys(0,192) $
$ALTER 103
$CALL DBSTORE DMI,DMINDX,dti,dtindx,//0/0/'DBALL'/0 $
compile IFPS $
$putsys(0,192) $
$alter 103
alter 'equivx.*idtindx.*dtindx' $
CALL DBSTORE DMI,DMINDX,DTI,DTINDX,//0/0/'DBALL'/0 $
$
$ modify semg to read inputt2 if wanted
$
compile semg $
$alter 14 $ after last TYPE PARM...
alter 15
type parm,,i,y,infile = 0
type parm,,rs,n,flag
type parm,,i,n,nogood=-1
$
$alter 100 $ 97
$alter 156 $ 
alter 'endif.*fscoup.*and.*seid.*0' $
$message //'in semg infile = '/infile $
if (infile<=0)then $ Read INPUTT2 matrices
$alter 101 $ 98
$alter 157 $ after "MTRXIN"
alter 'mtrxin ' $
 else $
$
message //'param infile is >0, therefore, input matrices are on '/
          'inputt2 file '/infile $
message //'no k2gg, m2gg, or b2gg matrices are read in by dmig for'/
          'this superelement' $
$ only the first 16 datablocks are checked for matrices
$   (remember 2 input matrices per output matrix)
$
 inputt2 /mat1,mat2,mat3,mat4,/-1/infile $
 message //'checking first 2 blocks for matrices' $
  call getflag mat1,mat2/temp/s,flag/s,nogood/seid $
  delete /mat1,mat2,,, $
  message //'flag = '/flag/' nogood ='/nogood $
  message //'checking blocks 3 & 4 ' $
   if(nogood<>-1) call getflag mat3,mat4/temp1/
                       s,flag/s,nogood/seid $
  delete /mat3,mat4,,, $
  if(nogood<>-1) then $
   inputt2 /mat5,mat6,mat7,mat8,//infile $
  message //'checking matrices 5 & 6 ' $
  call getflag mat5,mat6/temp2/s,flag/s,nogood/seid $
   message //'flag = '/flag/' nogood ='/nogood $
   message //'checking matrices 7 & 8 ' $
   if(nogood<>-1) call getflag mat7,mat8/temp3/
                       s,flag/s,nogood/seid $
  endif $
  if(nogood<>-1) then $
   inputt2 /mat9,mat10,mat11,mat12,//infile $
  message //'checking matrices 9 & 10 ' $
  call getflag mat9,mat10/temp4/s,flag/s,nogood/seid $
   message //'flag = '/flag/' nogood ='/nogood $
   message //'checking matrices 11 & 12 ' $
   if(nogood<>-1) call getflag mat11,mat12/
                       temp5/
                       s,flag/s,nogood/seid $
  endif $
  if(nogood<>-1) then $
   inputt2 /mat13,mat14,,,//infile $
  message //'checking matrices 13 & 14 ' $
  call getflag mat13,mat14/temp6/s,flag/s,nogood/seid $
   message //'flag = '/flag/' nogood ='/nogood $
  endif $
$
  if(nogood<>-1) then $
   inputt2 /mat15,mat16,,,//infile $
  message //'checking matrices 15 & 16 ' $
  call getflag mat15,mat16/temp75/s,flag/s,nogood/seid $
   message //'flag = '/flag/' nogood ='/nogood $
  endif $
$ store matpool tables for use when needed
$
dbdict select(name,size,seid,peid,zuzr1,zuzr2,zname,vers) $
$
$ check if K2GG, M2GG, B2GG
$
type parm,,i,n,gotit
 call dbfetch /maap,kaap,baap,,/seid/0/0/0/s,gotit $
$if (nokggx=-1)then $
$ need Ted's review. I think they change NOKGGX to NOKGG
$ if (nokgg=-1) then $
if (nok2jj=-1) then $
 mtrxin ,,kaap,EQEXINS,SILS,/kaaext,,/LUSETS/
         S,N,nok2jj///1 $
  equivx kaaext/k2jj/always $
endif $
$ mass matrix
$ if (nom2gg=-1)then $
$ need Ted's review. I changed NOM2GG to NOMGG
$if (nomgg=-1) then $
 if (nom2jj=-1) then $
 mtrxin ,,maap,EQEXINS,SILS,/maaext,,/LUSETS/
         S,N,NOM2jj///1 $
  equivx maaext/m2jj/always $
endif $
$
$ damping matrix
if (nobgg=-1)then $
 mtrxin ,,baap,EQEXINS,SILS,/baaext,,/LUSETS/
         S,N,NOb2GG///1 $
$         S,N,NOM2GG///1 $
  equivx baaext/b2jj/always $
endif $
endif $ infile>0
$
$ 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,y,infile = 0, neutral = -1
TYPE PARM,,I,N,GARBAGE $
$
$ALTER 28 $  replace GPSP for OTM superelements
alter 'gpsp.*knn.*uset',''   $
type parm,,i,n,ngerr=0
$
$ READ OTM & STORE
$
CALL DBFETCH /dti,dtindx,,,/0/0/0/0/S,GARBAGE $
dtiin dti,dtindx/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 $
$
$ check inputt2 file for matrices
$
if (infile>0) then $
$
 if (neutral>=0) then $
$  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/temp/s,flag/s,nogood/seid $
  delete /mat1,mat2,,, $
  message //'flag = '/flag/' nogood ='/nogood $
$
  message //'checking matrices 3 & 4 ' $
  if(nogood<>-1) call getflag mat3,mat4/temp1/
                       s,flag/s,nogood/seid $
  if(nogood<>-1) then $
   inputt2 /mat5,mat6,mat7,mat8,//infile $
$
  message //'checking matrices 5 & 6 ' $
   call getflag mat5,mat6/temp2/s,flag/s,nogood/seid $
   message //'flag = '/flag/' nogood ='/nogood $
$
   message //'checking matrices 7 & 8 ' $
   if(nogood<>-1) call getflag mat7,mat8/temp3/
                       s,flag/s,nogood/seid $
  endif $
$
  if(nogood<>-1) then $
   inputt2 /mat9,mat10,mat11,mat12,//infile $
  message //'checking matrices 9 & 10 ' $
   call getflag mat9,mat10/temp4/s,flag/s,nogood/seid $
   message //'flag = '/flag/' nogood ='/nogood $
$
   message //'checking matrices 11 & 12 ' $
   if(nogood<>-1) call getflag mat11,mat12/temp5/
                       s,flag/s,nogood/seid $
  endif $
  if(nogood<>-1) then $
   inputt2 /mat13,mat14,mat15,mat16,//infile $
  message //'checking matrices 13 & 14 ' $
   call getflag mat13,mat14/temp6/s,flag/s,nogood/seid $
   message //'flag = '/flag/' nogood ='/nogood $
   message //'checking matrices 15 & 16 ' $
   if(nogood<>-1) call getflag mat15,mat16/temp7/
                       s,flag/s,nogood/seid $
  endif $
  if(nogood<>-1) then $
   inputt2 /mat17,mat18,mat19,mat20,//infile $
  message //'checking matrices 17 & 18 ' $
   call getflag mat17,mat18/temp8/s,flag/s,nogood/seid $
   message //'flag = '/flag/' nogood ='/nogood $
   message //'checking matrices 19 & 20 ' $
   if(nogood<>-1) call getflag mat19,mat20/temp9/
                       s,flag/s,nogood/seid $
   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/temp10/s,flag/s,nogood/seid $
   message //'flag = '/flag/' nogood ='/nogood $
   message //'checking matrices 23 & 24 ' $
   if(nogood<>-1) call getflag mat23,mat24/temp11/
                       s,flag/s,nogood/seid $
   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/temp12/s,flag/s,nogood/seid $
   message //'flag = '/flag/' nogood ='/nogood $
   message //'checking matrices 27 & 28 ' $
   if(nogood<>-1) call getflag mat27,mat28/temp13/
                       s,flag/s,nogood/seid $
   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/temp14/s,flag/s,nogood/seid $
   message //'flag = '/flag/' nogood ='/nogood $
   message //'checking matrices 31 & 32 ' $
   if(nogood<>-1) call getflag mat31,mat32/temp15/
                       s,flag/s,nogood/seid $
   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/temp16/s,flag/s,nogood/seid $
   message //'flag = '/flag/' nogood ='/nogood $
   message //'checking matrices 35 & 36 ' $
   if(nogood<>-1) call getflag mat35,mat36/temp17/
                       s,flag/s,nogood/seid $
   message //'flag = '/flag/' nogood ='/nogood $
  endif $
 endif $ - read inputt2
else $
 CALL DBFETCH /DMI,DMINDX,,,/0/0/0/0/S,GARBAGE $
 DMIIN DMI,DMINDX/DIS,SPCF,STRESS,FORC,mpcf,,,,,/ $
 CALL DBSTORE DIS,SPCF,STRESS,FORC,mpcf//SEID/0/'DBALL   '/0 $ STORE MATRICES
endif $
CALL DBSTORE TABDIS1,TABSPCF1,TABSTR1,TABFOR1,tabmpcf1//SEID/0/'DBALL'/0 $ STORE tables
dbdict select(name,size,seid,peid,zuzr1,zuzr2,zname,vers) $
$
MESSAGE //'  ' $
MESSAGE //'GRID POINT SINGULARITY TESTS DISABLED '/
          'BY THIS ALTER - do not process conventional' $
MESSAGE //'  superelements with this alter included' $
MESSAGE //'  ' $
MESSAGE //'  ' $
$
$alter 'gpsp.*uset' 
$
$ DELETE EFFECTS OF GPSP AND PARTITION MATRICES
$
PURGEX /USET,,,,/ALWAYS $
EQUIVX USET0/USET/ALWAYS $
type parm,nddl,char8,n,zname $
type parm,nddl,i,n,zuzr1
zname = 'stored' $
zuzr1 = seid $
type db,zuzr11 $
matgen ,/zuzr11/6/1/1 $
$    flag to mark that this superelement was created
$       by the alter
$
$ -----------------------------------------------------------------
$
compile sekmr, list
$
$ skip call sekr 
$
alter 'call.*sekr ',''
$
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,y,infile = -1 $
type parm,,i,y, neutral = -1
$
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 $ 
$
type db,kjj
  equivx kgg/kjj/always $
  UPARTN USET,KGG/KAA,,,/'G'/'A'/'O' $
  MODTRL KAA////6 $
if(noqset>0)then $
 upartn uset,kaa/kqq,ktq,kqt,ktt/'a'/'q'/'t' $
else $
 equivx kaa/ktt $
 matgen ,/kqq/6/1/1 $ - try to prevent calling semrm again
endif $

$
$ 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 $
if(noqset>0)then $
 upartn uset,maa/mqq,mtq,mqt,mtt/'a'/'q'/'t' $
else $
 equivx maa/mtt $
 matgen ,/mqq/6/1/1 $ - try to prevent calling semrm again
endif $
$
$
$ READ IN TRANSFORMATIONS
$
CALL dbstore matpool,,,,//0/0/'DBALL   '/0 $ STORE MATRICES
$ check if INPUTT2
if (infile>0) then $
 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 $
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
PARAML PHIXT//'TRAILER'/1/S,N,NCOLXT $
PARAML PHIXQ//'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,PHIXT/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,PHIXQ/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 $
$
compile phase1b $
$alter 61 $ after "IF ( NOK4AA=-1 ) CALL SEMRB"
alter 'if.*nok4aa.*call.*semrb' $
$ READ K4AA
$
$ check inputt2
type parm,,i,y,infile=0 $
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 $
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) $
$
$    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,y,infile=0 $
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 $
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) $
$DBDIR // $
RETURN
$ 
$   Add a new subdmap GETFLAG 
$
compile getflag $
subdmap getflag mat1,mat2/temp/flag/nogood/seid $
type parm,,rs,n,flag
type parm,,i,n,seid=0
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=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 $
    equivx mat2/dis/always $
    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 $
    equivx mat2/spcf/always $
    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 $
    equivx mat2/stress/always $
    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 $
    equivx mat2/forc/always $
    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 $
    equivx mat2/mpcf/always $
    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 $ 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 ALTER2G
$
echoon $