$
$     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 alter1ha.v707 - 10/30/00 - corrected problem which
$    occurs if exterior dof are in different order in the creation and 
$    assembly runs...TLR
$
$  alter1ha.v706 -- 11-30-98
$
$ alter1ha.v705 - alter to store reduced matrices and data for a PART
$
$ corrected error in format for writing stiffness and mass if NEUTRAL=1
$   Sept 3, 1999
$
$ if CMS is used for the PART, QSETi entries with SPOINTs must exist
$    in the partitioned bulk data section for that PART
$
$ based on    alter1ga.v70
$
$ FOR V706
$
echooff
$ Created July, 1997 for v70
$
$        PARAM,STDDR - 'YES' => do standard data recovery for the se after 
$                               producing the reduced matrices and OTM
$                      'NO ' => (default) don't do standard data recovery
$
$        PARAM,NOOTM - indicates if no OTM are requested
$                      -1 = creating OTM = default
$                       0 = store info needed for normal data recovery - not yet enabled
$                      +1 = don't create OTM and don't store info for
$                           data recovery
$           NOTE: If you use the OUTPUT2 option and there are
$                 no output requests in this run, then
$                 this parameter MUST BE SET TO +1 - otherwise
$                 the run using alter2g will fail while reading
$                 the input matrices. (Currently there is no method
$                 to check ahead on an INPUTT2 file to see if matrices
$                 exist)
$       alter will write null matrices for the boundary transformations 
$       if the U2 set does not exist - in this case, no interior loads may
$       be applied to the superelements. If any are, they will not
$       be reduced to the boundary points. NOTE: This is only for the
$       special case where the user does not define a U2 set.
$
$       modal damping - can only be used on superelements which
$       do not have a C- or R-set (no SECSETi or SESUP in main bulk data,
$                                  no CSETi or SUPORT in partitioned data)
$       if run requests modal damping and an R_ or C- set exist, it will
$       terminate the run
$
$
$    This alter has the option to use OUTPUT2 for the matrices and
$    tables. This avoids the need for DMIG, which can result in large input
$    files and may result in round-off in the matrix terms. This will write 
$    the information using the MATPOOL format, which is
$    supported by OUTPUT2 neutral and can be transferred across computer types.
$    alter2g.v68 is also updated to read these files.
$
$    This feature is controlled by PARAM,MATFILE - 
$                                                default = -1 => DMIG
$                                          any positive value = OUTPUT2 unit id
$
$    If this feature is used, it is recommended to use the ASSIGN statement 
$    to create the OUTPUT2 file. Here is a sample which creates unit 12, 
$    requiring MATFILE=12 in the partitioned input section for the superelement.
$
$    ASSIGN OUTPUT2='SE1.OUT', unit=12, formatted, delete
$
$    this will create a file named SE1.OUT, which will be used as unit 12
$    for OUTPUT2 using formatted output - this file may be transferred to any
$    computer MSC/NASTRAN V68 runs on.
$    NOTE: if using the "formatted" option, the tables created by the
$          DRMH1 module are not described in the NDDL and cannot be written.
$          If the "unformatted" (default) format is used, the tables can be
$          written. A parameter is provided to assist the alter in handling
$          this. The parameter is NEUTRAL, with a default of -1. Format for
$          this parameter is:
$
$          PARAM,NEUTRAL,x        - where x = -1 => unformatted (DRMH1 tables
$                                                   are written to OUTPUT file)
$
$                                         x =  1 => formatted (DRMH1 tables
$                                                   are written to the punch
$                                                   file in DTI format and should 
$                                                   be included in the partitioned
$                                                   bulk data in the run reading
$                                                   this superelement in)
$
$    When writing the matrices and tables, this alter will write "dummy"
$    matrices which identify what is next on the output2 file
$    These dummy matrices are:
$
$    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 ===> no longer exists
$    OUTFLAG4 (value=4.0) => mlaa in MATPOOL format ===> no longer exists
$    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)
$
$
$                  This alter contains the DRMH1 and DRMH3 modules.
$                  These are prototype modules, which are not documented.
$                  they are enabled by setting PARAM,DRMH,1
$                  If DRMH is set to 1, then the DRMH1 module will convert the
$                  OTM into tables and matrices. The tables may be written as
$                  DTI entries by using the MATMOD module (option 32). These
$                  DTI entries are read by the second run (cbar2g) and converted into
$                  tables for the DRMH3 module by MATMOD (option 32 again). These
$                  tables, when used by DRMH3 with the matrices from DRMH1 (punched
$                  as DMI or written using OUTPUT2 in the first run and read into 
$                  the second) result in the results calculated using the OTM being  
$                  printed using standard MSC/NASTRAN output format with element
$                  labels, grid point labels, etc. As a new feature, the third alter
$                  (alter9g.v68) will allow output and xyplots as requested by case
$                  control of the information from the OTM.
$
$
$  CREATE CMS (CRAIG-BAMPTON BY DEFAULT) MODEL OF S.E. AND WRITE MATRICES.
$      MATRICES ARE BOUNDARY MASS, DAMPING, AND STIFFNESS, PLUS SELECTED
$      DISPLACEMENTS (USED TO GENERATE LOADING VECTORS), AND SELECTED
$      DATA RECOVERY ITEMS FOR AN OTM, LTM, DTM, OR ATM MATRIX
$
$ =============================NOTE================================
$
$   CREATE MATRICES FOR USE IN NEXT RUN
$
$ USER INPUT -
$
$  1) STANDARD INPUT FOR CMS
$
$  2) use the SEALL command to process only the superelements you want to 
$     generate reduced matrices for
$
$  3) SET PARAM,FIXEDB,-1
$
$  4) IN CASE CONTROL REQUEST OUTPUT QUANTITIES FOR OTM
$
$  5) SELECT U2 SET AND SPECIFY IN BULK DATA - SET OF DOF WHICH WILL BE RETAINED
$     IN THE GOA (TRANSFORMATION) MATRIX. IF A DOF IS NOT IN THIS LIST, IT MAY
$     NOT HAVE A LOAD APPLIED. (IF NO U2 SET IS PROVIDED, ALL DOF ARE KEPT)
$
$  6) CASE CONTROL COMMAND SDAMP IN SUPERELEMENT SUBCASE (IF MODAL DAMPING IS
$     DESIRED FOR THE SUPERELEMENT - use param,sesdamp - starting with V70.7
$
$  7) TABDMP1 ENTRY FOR THE SUPERELEMENT MATCHING CASE CONTROL
$     (ONCE AGAIN, IF DESIRED)
$
$  8) PARAMETERS USED IN THIS DMAP
$
$
$        MAKEMAT = SEID TO CREATE MATRICES FOR
$                  DEFAULT = -1 (DON'T CREATE EXTERNAL MATRICES)
$
$        MATFILE = FILE ID TO WRITE MATRICES IN
$                  USED ONLY IF MAKEMAT<>-1
$                  DEFAULT = -1 (WRITE DMIG IN PUNCH FILE)
$                  IF > 0, THEN IT IS THE UNIT FOR OUTPUT2
$
$ ------------------------------------------------
compile ifps
alter 'ifp.*bulk.*igeom1.0.*pvtx'
type parm,,i,y,infile=0, matfile = 0
type parm,,char8,y,label='xxxxxxxx'
message //'in ifps - seid= '/seid $
message //'matfile = '/matfile
if(matfile>0)then $   write bulk data to a file
 matgen ,/ident1/1/1 $
 add ident1,/outflg99/(99.,0.) $
 output2 outflg99,ibulk,,,//-1/matfile/label//'matrix'/'bulk' $
 message //'bulk data for superelement '/seid/' written to '/
          ' file '/matfile $
endif $
$
$ at this point, infile has a value for use
$
alter 'idtindx.*dtindx'
dtiin dti,dtindx/resmeth,,,,,,,,,/s,n,resok $
type parm,,i,n,doit=0 $
call dbstore resmeth,,,,//0/0/'MASTER'/s,doit $
$ ------------------------------------------------
COMPILE SEMODES
alter 1 $ allow alter to work if scratch database is used
putsys(0,192) $
$
$ ------------------------------------------------
$
compile semg
alter 'return'(,-1)
type parm,,rs,y,g=0.
if (nok4gg<=0 and g<>0.)then $
  message //' ' $
  message //'dmap alter information message' $
  message //' ' $
  message //'you have specified PARAM,G,'/g/' in your input, but'/
           ' have not included structural damping on your' $
  message //'material entries. In order to save disk space, the'/
           ' program does not automatically generate the structural' $
  message //'damping matrix in this case. The DMAP alter is overriding'/
           ' this default and generating the structural damping matrix' $
  message //' ' $
  type parm,,cs,n,cmplxg=(0.,0.)
  cmplxg=cmplx(g,0.0) $
  add kjj,/k4jj/cmplxg $
endif $
$ ------------------------------------------------
$
COMPILE PHASE1B
ALTER 2
$ FLAG FOR CREATION OF EXTERNAL S.E. MATRICES
$    IF MAKEMAT <0, DO NOTHING, IF NOT, CREATE MATRICES FOR S.E. MAKEMAT
$
TYPE PARM,,I,Y,(MAKEMAT=-1) $
TYPE PARM,,I,Y,(MATFILE=-1) $
TYPE PARM,,I,Y,(SEPARATE=-1) $
TYPE PARM,,I,N,NEED,BEXISTS,NMODES $
type parm,,cs,n,mattype $
file outflag=ovrwrt $
matgen ,/ident1/1/1 $
$
$ Add modal damping if requested
$
$ REMOVED - V70.7 - NOW A STANDARD FEATURE - PARAM,SESDAMP
$
$ALTER 83 $ alter end of SELR - ENDIF $ SELR
alter 'endif.*selr'
TYPE DB ZUZR01,ZUZR02,ZUZR03,ZUZR04,ZUZR05 $
type parm,,char8,y,label='xxxxxxxx' $
TYPE PARM NDDL I N ZUZR1 $
$
IF (SEID = MAKEMAT) THEN      $          **********
  MESSAGE //'CREATING CRAIG-BAMPTON MATRICES FOR SUPERELEMENT'/SEID $
$
  ZUZR1=SEID $
  MATGEN EQEXINS/INTEXT1/9/0/LUSETS $
$
    UMERGE1 USET,KAA,,,/KAAG/'G'/'A'/'O'/0 $
    MPYAD INTEXT1,KAAG,/KAAGE/1 $
    MPYAD KAAGE,INTEXT1,/KAAEXT $
    MODTRL KAAEXT////6 $
$
    UMERGE1 USET,MAA,,,/MAAG/'G'/'A'/'O'/0 $
    MPYAD INTEXT1,MAAG,/MAAGE/1 $
    MPYAD MAAGE,INTEXT1,/MAAEXT $
    MODTRL MAAEXT////6 $
$
    IF (MATFILE=-1)THEN   $ PUNCH MATRICES
      MATMOD KAAEXT,EQEXINS,,,,/MPkaa,/16/1//////////KA $
      MATMOD MAAEXT,EQEXINS,,,,/MPmaa,/16/1//////////MA $
    ELSE      $
$ don't punch DMIG, write MATPOOL to OUTPUT2
      MATMOD KAAEXT,EQEXINS,,,,/MPkaa,/16/0//////////KA $
      MATMOD MAAEXT,EQEXINS,,,,/MPmaa,/16/0//////////MA $
$tabprt mpkaa//'matpool'///1 $
$tabprt mpmaa//'matpool'///1 $
      mattype = cmplx(1.,0.) $
      add ident1,/outflag1/mattype $
      output2 outflag1,,,,///MATFILE///'matrix'  $
      OUTPUT2 mpkaa,,,,//0/MATFILE///'matpool' $
      mattype = cmplx(2.,0.) $
      add ident1,/outflag2/mattype $
      output2 outflag2,,,,//0/MATFILE///'matrix'  $
      OUTPUT2 mpmaa,,,,//0/MATFILE///'matpool' $
    ENDIF   $
$
   PARAML BAA//'PRESENCE'////S,N,BEXISTS $
   IF (BEXISTS<>-1) THEN $
    UMERGE1 USET,BAA,,,/BAAG/'G'/'A'/'O'/0 $
    MPYAD INTEXT1,BAAG,/BAAGE/1 $
    MPYAD BAAGE,INTEXT1,/BAAEXT $
    MODTRL BAAEXT////6 $
$
    IF (MATFILE=-1)THEN   $ PUNCH MATRICES
      MATMOD BAAEXT,EQEXINS,,,,/MPbaa,/16/1//////////BA $
    ELSE      $
$ don't punch DMIG, write MATPOOL to OUTPUT2
      MATMOD BAAEXT,EQEXINS,,,,/MPbaa,/16/0//////////BA $
      mattype = cmplx(5.,0.) $
      add ident1,/outflag5/mattype $
      output2 outflag5,,,,//0/MATFILE///'matrix' $
      OUTPUT2 mpbaa,,,,//0/MATFILE///'matpool'$
$      OUTPUT2 BAAEXT,,,,///MATFILE $
    ENDIF   $
   endif $ bexists
$
$ CREATE G-SIZE TRANSFORMATION MATRICES WITH TERMS FOR U2 SET.
$ THESE MATRICES WILL BE USED FOR LOAD APPLICATION
$
$
$ addition August, 1996 - check for existance of U2 set
$
PARAML   USET//'USET'////S,N,NOUSETX//'A'/S,N,NOASET/
                                      'G'/S,N,NOGSET/
                                      'U2'/S,N,NOU2SET $
$message //'testing - nou2set = '/nou2set $:
$ if(nou2set<1)then $ 
$$
$$ U2 set not defined - create null matrices
$$
$  message //'you have not defined a u2 set of dof for this'/
$         'superelement - the program will write out null'/
$         'transformation matrices' $
$  matgen ,/zuzr04/7/noGset/noaset/2 $
$  copy zuzr04/zuzr05/always $
$ endif $nou2set<1
$
  if(nomset>-1)then $
$
    vec uset/identt/'A'/'Q'/'T' $
    PARAML   USET//'USET'////S,N,NUSETX//'A'/S,N,NASET $
    matgen ,/aone/1/naset $
    partn aone,identt,/identq2,,identt2,/1 $
    SDR1    USET,,identt2,,,GOA,GM,,KFS,KSS,/
          gogt,,QGSTAT/1/'statics'
$
    SDR1     USET,,identq2,,,GOA,GM,,KFS,KSS,/
           gogq,,QGDYN/1/APP1/NOQGOLD $
$
  else $
    UMERGE USET,GOQ,/GOGQ/'G'/'O'/'A' $
    UMERGE USET,GOT,/GOGT/'G'/'O'/'A' $
$ 10/30/00 - expand columns to 'G' size - TLR - xxxxxxxxxxxxxxxxxx
    umerge1 uset,gogq,,,/goggq/'g'/'q'//2 $
    umerge1 uset,gogt,,,/goggt/'g'/'t'//2 $
  endif $
 if(nou2set>0)then $
  UPARTN USET,GOGgQ/GU2Q,,,/'G'/'U2'/'A'/1 $
  UMERGE USET,GU2Q,/ZUZR04/'G'/'U2'/'A' $
  UPARTN USET,GOGgT/GU2T,,,/'G'/'U2'/'A'/1 $
  UMERGE USET,GU2T,/ZUZR05/'G'/'U2'/'A' $
 else $ if no U2 set, keep all terms
  equivx goggq/zuzr04/always $
  equivx goggt/zuzr05/always $
 endif $
$ 10/30/00 - expand columns to 'G' size - TLR - xxxxxxxxxxxxxxxxxx
 sMPYAD  INTEXT1,ZUZR04,intext1,,,/PHIXQ/3////1 $
$ umerge1 uset,,,phixqq,/phixq/'A'/'T'/'Q'/2 $
$ 10/30/00 - expand columns to 'G' size - TLR - xxxxxxxxxxxxxxxxxx
 sMPYAD  INTEXT1,ZUZR05,intext1,,,/PHIXT/3///1 $
$ umerge1 uset,phixtt,,,/phixt/'A'/'T'/'Q'/2 $
$
 dbstatus phixq//s,n,nophixq $
 dbstatus phixt//s,n,nophixt $
  IF (MATFILE=-1)THEN   $
  if(nophixq=1)then $
    MATMOD PHIXQ,EQEXINS,,,,/MPphixq,/16/1//////////PQ $
   endif $
   if(nophixt=1)then $
    MATMOD PHIXT,EQEXINS,,,,/MPphixt,/16/1//////////PT $
   endif $ nophixt=1
  ELSE    $
$ don't punch DMIG, write MATPOOL to OUTPUT2
   if(nophixq=1)then $
    MATMOD PHIXQ,EQEXINS,,,,/MPphixq,/16/0//////////PQ $
      mattype = cmplx(6.,0.) $
      add ident1,/outflag6/mattype $
      output2 outflag6,,,,///MATFILE///'matrix' $
    OUTPUT2 mpphIXQ,,,,///MATFILE///'matpool' $
   endif $ nophixq=1
   if(nophixt=1)then $
    MATMOD PHIXT,EQEXINS,,,,/MPphixt,/16/0//////////PT $
      mattype = cmplx(7.,0.) $
      add ident1,/outflag7/mattype $
      output2 outflag7,,,,///MATFILE///'matrix' $
    OUTPUT2 mpphIXt,,,,///MATFILE///'matpool' $
   endif $
$    OUTPUT2 PHIXQ,PHIXT,,,///MATFILE///'matrix'/'matrix' $
  ENDIF $
$
  dbstatus k4aa//s,n,nok4aa $
  if(nok4aa=1)then $
    UMERGE1 USET,K4AA,,,/K4AAG/'G'/'A'/'O'/0 $
    MPYAD INTEXT1,K4AAG,/K4AAGE/1 $
    MPYAD K4AAGE,INTEXT1,/K4AAEXT $
    MODTRL K4AAEXT////6 $
    PARAML k4aaext//'PRESENCE'////S,N,k4EXISTS $
   IF (k4EXISTS<>-1) THEN $
$
    IF (MATFILE=-1)THEN   $
      MATMOD K4AAEXT,EQEXINS,,,,/MPk4an,/16/1//////////KA $
    ELSE      $
$     don't create DMIG in punch file, write MATPOOL using OUTPUT2
      MATMOD K4AAEXT,EQEXINS,,,,/MPk4aa,/16/0//////////KA $
      mattype = cmplx(7.5,0.) $
      add ident1,/outflg75/mattype $
      output2 outflg75,,,,///MATFILE///'matrix' $
      output2 mpk4aa,,,,///MATFILE///'matpool' $
$      OUTPUT2 K4aaEXT,,,,///MATFILE///'matrix' $
    ENDIF   $
   endif $ k4exixts
  endif $ nok4aa=1
$
  type parm,,i,y,nootm=-1 $
  if(nootm<>-1 and matfile<>-1)then $
    mattype = cmplx(13.,0.) $
    add ident1,/outflg13/mattype $
    OUTPUT2 outflg13,,,,///MATFILE///'matrix' $ WRITE EOF
    OUTPUT2 outflg13,,,,///MATFILE///'matrix' $ WRITE EOF
    OUTPUT2 outflg13,,,,///MATFILE///'matrix' $ WRITE EOF
    OUTPUT2 outflg13,,,,///MATFILE///'matrix' $ WRITE EOF
    OUTPUT2 outflg13,,,,///MATFILE///'matrix' $ WRITE EOF
   endif $ nootm<>-1
$
ENDIF $                       *********************
$
$
$ ------------------------------------------------
COMPILE SEDISP
$
$ CREATE OTM
$
ALTER 2
TYPE DB,ZUZR06,ZUZR07 $
$ TYPE DB,GOAQ,GOAT $ was needed in v66a and v66
TYPE PARM,NDDL,I,N,ZUZR1 $
$ FLAG FOR CREATION OF EXTERNAL S.E. MATRICES
$    IF MAKEMAT <0, DO NOTHING, IF NOT, CREATE MATRICES FOR S.E. MAKEMAT
$
TYPE PARM,,I,Y,(MAKEMAT=-1)
TYPE PARM,,I,Y,(MATFILE=-1) $
$
file zuzr07=ovrwrt $
$alter 190 $ before actual SDR1
$alter 210 $ before actual SDR1
alter 'endif.*app1.*mmreig' $
$
$ ALTER TO CREATE LTM, ATM, AND/OR DTM
type db pvts
pvt PVTs,/PVT $ 
message //'in sedisp - makemat ='/makemat $
$
IF (SEID = MAKEMAT) THEN  $       *******************
$
  MESSAGE //'CREATING OTM REQUESTED IN CASE CONTROL FOR SE '/SEID $
$
$ CALCULATE AND STORE OUTPUT QUANTITIES FOR S.E. FOR UNIT BOUNDARY DISP
$
$ ADD     GOAT,GOAQ/GOA $
 ZUZR1 = SEID $
 if (newspcf or noqmg>-1) then $ need to use separate data recovery
$
  PARAML   USET//'USET'////S,N,NUSETX//'A'/S,N,NASET/
                                       'Q'/S,N,NQSET/
                                       'T'/S,N,NTSET $
  vec uset/identt/'A'/'Q'/'T' $
  PARAML   USET//'USET'////S,N,NUSETX//'A'/S,N,NASET $
  matgen ,/aone/1/naset $
  partn aone,identt,/identq2,,identt2,/1 $
  dbstatus goa//s,n,needgoa $
  if(needgoa<>1)CALL SEGOA USET,GOT,GOQ/GOA/NOOSET/NOQSET/NOTSET $
  SDR1    USET,,identt2,,,GOA,GM,PS1,KFS,KSS,/
          UGSTAT,,QGSTAT/1/'statics'
$
  SDR1     USET,,identq2,,,GOA,GM,PS1,KFS,KSS,/
           UGDYN,,QGDYN/1/APP1/NOQGOLD $
  Umerge1 uset,ugstat,,ugdyn,/zuzr06/'A'/'T'/'Q'/2 $
 else $
$
  PARAML  GOA//'TRAILER'/1/S,N,NGOA $ NUMBER OF DOF IN GOA
  dbstatus goa//s,n,needgoa $
  if(needgoa<>1)CALL SEGOA USET,GOT,GOQ/GOA/NOOSET/NOQSET/NOTSET $
  paraml goa//'trailer'/1/s,n,ngoa $
  MATGEN  ,/UNITDISP/1/NGOA $ UNIT BOUNDARY DISP
  SDR1    USET,,UNITDISP,,,GOA,GM,PS1,KFS,KSS,/ZUZR06,,ZUZR07/1/APP1 $
 endif $
ENDIF  $                         ********************
$
$alter 248 $ after call cforce
$alter 267 $ after call cforce
$alter 268 $
alter 'call.*cforce.*uh1' $
$ dynamic spcforces
$
IF (SEID = MAKEMAT) THEN  $       *******************
$alter 274
alter 'endif.*noqg.*and.*nosset.*dynspcf.*old'
else $
 CALL CFORCE  USET,,UF,UH1,MSF,M2SF,BSF,B2SF,KSF,K4SF,K2SF,
              PSX,OLX/
              QGDYN/
              APP/APP1/GW3/RW4/C1G/FALSE/SEID $
 append qgstat,qgdyn/zuzr07/1 $
endif $
$
$alter 250 $ after call cforce - MPC
$alter 274 $ after call cforce - MPC
$alter 276 $
$
alter 'call.*cforce.*gm.*uh1'
$
$ mpc forces
IF (SEID <> MAKEMAT) THEN  $       *******************
$alter 247
$alter 281
alter 'endif.*noqmg.*and.*not.*nonlnr' $
else $
 IF ( NOQMG>-1 AND NOT(NONLNR0) AND NOMSET>-1 )then $
 CALL CFORCE,
              USET,GM,UGSTAT,UH1,MMG,M2MG,BMG,B2MG,KMG,K4MG,K2MG,
              PM,OLX/
              QMGSTAT/
              'statics'/'statics'/GW3/RW4/C1G/TRUE/SEID $
$
$ remove unused columns from UGDYN before calling CFORCE
$
LAMX     ,,OLX/OMEGAT/-1 $
paraml omegat//'TRAILER'/2/s,n,nomodes $
paraml ugdyn//'TRAILER'/1/s,n,nocoldyn $
type parm,,i,n,nulcol=-1 $
nulcol = nocoldyn-nomodes $
 if(nulcol>0)then $
  matgen ,/part0/6/nocoldyn/nomodes/nulcol $
  partn  ugdyn,part0,/ugdynok,,ugnull,/1 $
 else $
  equivx ugdyn/ugdynok/always $
 endif $
 CALL CFORCE,
              USET,GM,UGDYNOK,UH1,MMG,M2MG,BMG,B2MG,KMG,K4MG,K2MG,
              PM,OLX/
              QMGDYNOK/
              app/app1/GW3/RW4/C1G/TRUE/SEID $
$              'reig    '/'reig    '/GW3/RW4/C1G/TRUE/SEID $
 if(nulcol>0)then $
  merge qmgdynok,,,,part0,/qmgdyn/1 $
 else $
  equivx qmgdynok/qmgdyn/always $
 endif $
 Umerge1 uset,qmgstat,,qmgdyn,/qmgtot/'A'/'T'/'Q'/2 $
 type parm,,i,n,doit=0
 call dbstore qmgtot,,,,//seid/0/'DBALL'/s,doit $
 endif $
endif $
$
$
$ ------------------------------------------------
COMPILE SEDRCVR
$
$ALTER 2
ALTER 3
TYPE DB,BGPDP,ZUZR06,ZUZR07 $
TYPE PARM,NDDL,I,N,ZUZR1 $
type parm,,i,y,drmh=-1 $
$ FLAG FOR CREATION OF EXTERNAL S.E. MATRICES
$    IF MAKEMAT <0, DO NOTHING, IF NOT, CREATE MATRICES FOR S.E. MAKEMAT
$
TYPE PARM,,I,Y,(MAKEMAT=-1)
TYPE PARM,,I,Y,(MATFILE=-1) $
type parm,,cs,n,mattype $
file outflag=ovrwrt $
type parm,,char3,y,stddr='no ' $ if yes => do standard data recovery 
$ after generating reduced matrices and OTM
$
type parm,,i,y,neutral=-1
matgen ,/ident1/1/1 $
$
$ALTER 41 $ after endif after VECPLOT
$ALTER 27 $ after endif after VECPLOT
alter 'endif.*app.*statics' $
$
IF (SEID = MAKEMAT) THEN $            ****************************
  MATGEN EQEXINS/INTEXT1/9/0/LUSETS $
  ZUZR1 = SEID $
$
  SDR2   CASEDR,CSTMS,MPTS,DIT,EQEXINS,,ETT,OL2,BGPDTS,,
       ZUZR07,ZUZR06,EST,XYCDBDR,,,/ IOPG1,IOQG1,IOUGV1,IOES1,IOEF1,
       IPUGV/APP1/S,N,NOSORT2/NOCOMPS $
$
$ MPC forces
$
type parm,,i,n,gotit=0
call dbfetch /qmgtot,,,,/SEID/0/0/0/S,gotit
if (gotit<>0)then $
SDR2     CASEDR,CSTMS,MPTS,DIT,EQEXINS,,ETT,OL2,BGPDP,
          PJ1,QMGtot,zuzr06,EST ,,OINT,PELSETS,VIEWTB/
          ,IQMG1,,ISTR1,,/
          APP1/S,N,NOSTR2/3/////ACOUT/PREFDB///
          ADPTINDX/ADPTEXIT/FALSE $
endif $
$ CREATE OTM
$
if (drmh>0) then $
  DRMH1 IOUGV1,IOQG1,IOES1,IOEF1/TABDIS,DIS,TABSPCF,
      SPCF,TABSTR,STRESS,TABFOR,FORC/LMODES/1/7/3/1005/1004 $
$
  umerge1 uset,spcf,,,/spcfg/'g'/'a'/'comp'/2 $
  trnsp spcfg/spcfgt $
  mpyad intext1,spcfgt,/spcfge $
$
  umerge1 uset,dis,,,/disg/'g'/'a'/'comp'/2 $
  trnsp disg/disgt $
  mpyad intext1,disgt,/disge $
$
  umerge1 uset,stress,,,/stressg/'g'/'a'/'comp'/2 $
  trnsp stressg/stressgt $
  mpyad intext1,stressgt,/stressge $
$
  umerge1 uset,forc,,,/forcg/'g'/'a'/'comp'/2 $
  trnsp forcg/forcgt $
  mpyad intext1,forcgt,/forcge $
$
$ MPC forces (?)
  DRMH1 ,,IQMG1,,/,,TABMPCF,
      MPCF,,,,/LMODES/1/7/3/1005/1004 $
  MATMOD TABMPCF,,,,,/,/32/0 $
  umerge1 uset,mpcf,,,/mpcfg/'g'/'a'/'comp'/2 $
  trnsp mpcfg/mpcfgt $
  mpyad intext1,mpcfgt,/mpcfge $
$ end MPC forces
 if(matfile>0 and neutral=-1)then $ write output2
  message //' ' $
  message //'tables from DRMH1 module are to be written to OUTPUT2 file' $
  message //' ' $
 else $
  message //' ' $
  message //'tables from DRMH1 module will be in the punch file' $
  message //' ' $
  MATMOD TABDIS,,,,,/,/32/0 $
  MATMOD TABSPCF,,,,,/,/32/0 $
  MATMOD TABSTR,,,,,/,/32/0 $
  MATMOD TABFOR,,,,,/,/32/0 $
 endif $
$
else $
  DRMS1  IOUGV1,IOQG1,IOES1,IOEF1/TABDIS,DIS,TABSPCF,SPCF,TABSTR,
         STRESS,TABFOR,FORC/LMODES $
  umerge1 uset,spcf,,,/spcfg/'g'/'a'/'comp'/2 $
  trnsp spcfg/spcfgt $
  mpyad intext1,spcfgt,/spcfge $
$
  umerge1 uset,dis,,,/disg/'g'/'a'/'comp'/2 $
  trnsp disg/disgt $
  mpyad intext1,disgt,/disge $
$
  umerge1 uset,stress,,,/stressg/'g'/'a'/'comp'/2 $
  trnsp stressg/stressgt $
  mpyad intext1,stressgt,/stressge $
$
  umerge1 uset,forc,,,/forcg/'g'/'a'/'comp'/2 $
  trnsp forcg/forcgt $
  mpyad intext1,forcgt,/forcge $
$
endif $
ofp IOUGV1,IOQG1,IOES1,IOEF1// $
ofp iqmg1// $
$  OFP    IOPG1,OQG1,IOUGV1,IOES1,IOEF1,IPUGV//S,N,CARDNO $
$  TABPT  TABDIS,TABSPCF,TABSTR,TABFOR// $
  IF (MATFILE=-1) THEN $ PUNCH OTM
    MATPCH  DISge// $
    MATPCH  SPCFge// $
    MATPCH  STRESSge// $
    MATPCH  FORCge// $
    MATPCH  mpcfge// $
  ELSE   $ WRITE OTM TO FILE
    paraml disge//'presence'////s,n,isdis $
    if (isdis<>-1) then $
     mattype = cmplx(8.,0.) $
     add ident1,/outflag8/mattype $
     output2 outflag8,,,,///MATFILE///'matrix' $
      MATMOD disge,EQEXINS,,,,/disgem,/16/0//////////ds $
     OUTPUT2 DISgem,,,,///MATFILE///'matpool' $
     if(neutral=-1)then $
      mattype = cmplx(8.5,0.) $
      add ident1,/outfl85/mattype $
      output2 outfl85,,,,///MATFILE $
      output2 tabdis,,,,///MATFILE $
     endif $
    endif $
    paraml spcfge//'presence'////s,n,isspcf $
    if (isspcf<>-1) then $
     mattype = cmplx(9.,0.) $
     add ident1,/outflag9/mattype $
     output2 outflag9,,,,///MATFILE///'matrix' $
     MATMOD spcfge,EQEXINS,,,,/spcfgem,/16/0//////////sp $
     OUTPUT2 SPCFgem,,,,///MATFILE///'matpool' $
     if(neutral=-1)then $
      mattype = cmplx(9.5,0.) $
      add ident1,/outfl95/mattype $
      output2 outfl95,,,,///MATFILE $
      output2 tabdis,,,,///MATFILE $
     endif $
    endif $
     paraml stressge//'presence'////s,n,isstress $
    if (isstress<>-1) then $
     mattype = cmplx(10.,0.) $
     add ident1,/outflg10/mattype $
     output2 outflg10,,,,///MATFILE///'matrix' $
     MATMOD stressge,EQEXINS,,,,/stresgem,/16/0//////////st $
     OUTPUT2 STRESgem,,,,///MATFILE///'matpool' $
     if(neutral=-1)then $
      mattype = cmplx(10.5,0.) $
      add ident1,/outfl105/mattype $
      output2 outfl105,,,,///MATFILE $
      output2 tabdis,,,,///MATFILE $
     endif $
    endif $
    paraml forc//'presence'////s,n,isforc $
    if (isforc<>-1) then $
     mattype = cmplx(11.,0.) $
     add ident1,/outflg11/mattype $
     output2 outflg11,,,,///MATFILE///'matrix' $
     MATMOD forcge,EQEXINS,,,,/forcgem,/16/0//////////fo $
     OUTPUT2 FORCgem,,,,///MATFILE///'matrix' $
     if(neutral=-1)then $
      mattype = cmplx(11.5,0.) $
      add ident1,/outfl115/mattype $
      output2 outfl115,,,,///MATFILE $
      output2 tabdis,,,,///MATFILE $
     endif $
    endif $
    paraml mpcfge//'presence'////s,n,ismpcf $
    if (ismpcf<>-1) then $
     mattype = cmplx(12.,0.) $
     add ident1,/outflg12/mattype $
     output2 outflg12,,,,///MATFILE///'matrix' $
     MATMOD mpcfge,EQEXINS,,,,/Mpcfgem,/16/0//////////mp $
     OUTPUT2 mpcfgem,,,,///MATFILE///'matpool' $
     if(neutral=-1)then $
      mattype = cmplx(12.5,0.) $
      add ident1,/outfl125/mattype $
      output2 outfl125,,,,///MATFILE $
      output2 tabdis,,,,///MATFILE $
     endif $
    endif $
    mattype = cmplx(13.,0.) $
    add ident1,/outflg13/mattype $
    OUTPUT2 outflg13,,,,///MATFILE///'matrix' $ WRITE EOF
    OUTPUT2 outflg13,,,,///MATFILE///'matrix' $ WRITE EOF
    OUTPUT2 outflg13,,,,///MATFILE///'matrix' $ WRITE EOF
    OUTPUT2 outflg13,,,,///MATFILE///'matrix' $ WRITE EOF
    OUTPUT2 outflg13,,,,///MATFILE///'matrix' $ WRITE EOF
    OUTPUT2 outflg13,,,,///MATFILE///'matrix' $ WRITE EOF
    OUTPUT2 outflg13,,,,///MATFILE///'matrix' $ WRITE EOF
    OUTPUT2 outflg13,,,,///MATFILE///'matrix' $ WRITE EOF
    OUTPUT2 ,,,,//-9/MATFILE $ WRITE EOF
  ENDIF  $
MESSAGE //'finished with generating reduced model for superelement'/
         seid $
$
 if(stddr<>'yes')then $
   return $
$  EXIT $
 endif $
$
ENDIF    $                      ***************************
$
$ END OF ALTER1G
$
echoon