[comp.sys.handhelds] Composite analysis program

jn190068@longs.LANCE.ColoState.EDU (Jay Nestle) (05/19/91)

%%HP: T(3)A(D)F(.);
DIR
  INT1
    \<<
"No. of new materials?"
"" INPUT OBJ\->
      \<< \-> C
        \<<
          WHILE 0
'C' DECR \<=
          REPEAT
MATER
          END
        \>>
      \>> EVAL
"Change in temp?"
":\GDT:" INPUT OBJ\->
OBJ\-> DROP '\GDT' STO
"Number of Layers?"
"" INPUT OBJ\-> 1
SWAP
      FOR X LAYER
      NEXT
    \>>
  CALC
    \<< 'L1' LAYERS
layerlist OBJ\-> SWAP
DUP UPDIR
'CurrentLayer' STO
SWAP 1 SWAP
      FOR TC DUP
LAYERS EVAL '\Gh' RCL
'\Gh' '\Ga1' RCL '\Ga1'
'\Ga2' RCL '\Ga2' 'MAT'
RCL UPDIR UPDIR
MATERIALS EVAL 'E1'
RCL 'E1' 'E2' RCL
'E2' 'v21' RCL
'v21' 'v12' RCL
'v12' 'G12' RCL
'G12' UPDIR UPDIR
Formulas STO STO
STO STO STO STO STO
STO EQ11 ERPT EQ22
ERPT EQ66 ERPT EQ12
ERPT EQ11B ERPT
EQ12B ERPT EQ22B
ERPT EQ16B ERPT
EQ26B ERPT EQ66B
ERPT E\Gaxy ERPT E\Gax
ERPT E\Gay ERPT \Gax \Gay
\Gaxy { 3 1 } \->ARRY
SWAP Q11B Q12B Q16B
Q12B Q22B Q26B Q16B
Q26B Q66B { 3 3 }
\->ARRY UPDIR
CurrentLayer LAYERS
EVAL SWAP "QB" SWAP
+ OBJ\-> STO 'M\Gaxy'
STO UPDIR UPDIR DUP
'CurrentLayer' STO
LAYERS
      NEXT AMAT
BMAT DMAT ABD2M
DROP
    \>>
  CNT\Ga
    \<< LAYERS
layerlist OBJ\-> 1
SWAP
      FOR X X ROLL
DUP EVAL "QB" SWAP
+ OBJ\-> t * \GDT *
M\Gaxy * UPDIR
      NEXT 1
NoLayers 1 -
      FOR X +
      NEXT 2 * DUP
\GDT / ABDM A INV
SWAP * 2 / '\GaLAM'
STO 'NT' STO
    \>>
  MATERIALS
    DIR
      materiallist
{ }
    END
  LAYERS
    DIR
      ABDM
        DIR
        END
      NoLayers 0
      layerlist { }
    END
  Formulas
    DIR
      E\Gaxy '\Gaxy=2*(
\Ga1-\Ga2)*COS(\Gh)*SIN(\Gh
)'
      E\Gay '\Gay=\Ga2*
COS(\Gh)^2+\Ga1*SIN(\Gh)^
2'
      E\Gax '\Gax=\Ga1*
COS(\Gh)^2+\Ga2*SIN(\Gh)^
2'
      EQ66B 'Q66B=(
Q11+Q22-2*Q12-2*Q66
)*SIN(\Gh)^2*COS(\Gh)^2
+Q66*(SIN(\Gh)^4+COS(
\Gh)^4)'
      EQ26B 'Q26B=(
Q11-Q12-2*Q66)*SIN(
\Gh)^3*COS(\Gh)+(Q12-
Q22+2*Q66)*SIN(\Gh)*
COS(\Gh)^3'
      EQ16B 'Q16B=(
Q11-Q12-2*Q66)*SIN(
\Gh)*COS(\Gh)^3+(Q12-
Q22+2*Q66)*SIN(\Gh)^3
*COS(\Gh)'
      EQ22B 'Q22B=
Q11*SIN(\Gh)^4+2*(Q12
+2*Q66)*SIN(\Gh)^2*
COS(\Gh)^2+Q22*COS(\Gh)
^4'
      EQ12B 'Q12B=(
Q11+Q22-4*Q66)*SIN(
\Gh)^2*COS(\Gh)^2+Q12*(
SIN(\Gh)^4+COS(\Gh)^4)'
      EQ11B 'Q11B=
Q11*COS(\Gh)^4+2*(Q12
+2*Q66)*SIN(\Gh)^2*
COS(\Gh)^2+Q22*SIN(\Gh)
^4'
      EQ11 'Q11=E1/
(1-v12*v21)'
      EQ12 'Q12=v12
*E2/(1-v12*v21)'
      EQ22 'Q22=E2/
(1-v12*v21)'
      EQ66 'Q66=G12
'
    END
  ERPT
    \<< EQ\-> EVAL SWAP
STO
    \>>
  CLLAYERS
    \<< CLLCD
"Clear all layers?"
4 DISP { " " yes
" " " " } TMENU
-1 WAIT
      IF 12.1 SAME
      THEN LAYERS
'layerlist' RCL
OBJ\-> 1 SWAP
        FOR X EVAL
CLVAR UPDIR
        NEXT
layerlist PURGE { }
'layerlist' STO 0
'NoLayers' STO
'ABDM' EVAL { ABDM
A B D } PURGE UPDIR
UPDIR
      END
    \>>
  CLMAT
    \<< CLLCD
"Clear materials?"
4 DISP { " " yes }
TMENU -1 WAIT
      IF 12.1 SAME
      THEN
MATERIALS
'materiallist' RCL
OBJ\-> 1 SWAP
        FOR X EVAL
CLVAR UPDIR
        NEXT
materiallist PURGE
{ } 'materiallist'
STO UPDIR
      END
    \>>
  \GDT 0
  ABD2M
    \<< LAYERS ABDM A
{ 1 3 } RDM OBJ\->
DROP B { 1 3 } RDM
OBJ\-> DROP 1 3
      FOR X 2 X 2
\->LIST A SWAP GET
      NEXT 1 3
      FOR X 2 X 2
\->LIST B SWAP GET
      NEXT 1 3
      FOR X 3 X 2
\->LIST A SWAP GET
      NEXT 1 3
      FOR X 3 X 2
\->LIST B SWAP GET
      NEXT B { 1 3
} RDM OBJ\-> DROP D {
1 3 } RDM OBJ\-> DROP
1 3
      FOR X 2 X 2
\->LIST B SWAP GET
      NEXT 1 3
      FOR X 2 X 2
\->LIST D SWAP GET
      NEXT 1 3
      FOR X 3 X 2
\->LIST B SWAP GET
      NEXT 1 3
      FOR X 3 X 2
\->LIST D SWAP GET
      NEXT { 6 6 }
\->ARRY 'ABDM' STO
UPDIR UPDIR
    \>>
  DMAT
    \<< LAYERS
layerlist OBJ\-> 1
SWAP
      FOR X X ROLL
DUP EVAL "QB" SWAP
+ OBJ\-> t zbar SQ *
t t * t * 12 / + *
UPDIR
      NEXT 1
NoLayers 1 -
      FOR X +
      NEXT ABDM D
STO UPDIR UPDIR
    \>>
  BMAT
    \<< LAYERS
layerlist OBJ\-> 1
SWAP
      FOR X X ROLL
DUP EVAL "QB" SWAP
+ OBJ\-> t * zbar *
UPDIR
      NEXT 1
NoLayers 1 -
      FOR X +
      NEXT ABDM B
STO UPDIR UPDIR
    \>>
  AMAT
    \<< LAYERS
layerlist OBJ\-> 1
SWAP
      FOR X X ROLL
DUP EVAL "QB" SWAP
+ OBJ\-> t * UPDIR
      NEXT 1
NoLayers 1 -
      FOR X +
      NEXT ABDM A
STO UPDIR UPDIR
    \>>
  MATER
    \<<
"
    Material name?"
":name:" INPUT OBJ\->
OBJ\-> DROP DUP
'CurrentMat' STO
MATERIALS DUP CRDIR
materiallist +
'materiallist' STO
UPDIR 1 5
      FOR X INPT
      NEXT
    \>>
  INPT
    \<<
"Variable Name?"
":name:" { E1 E2
G12 v21 v12 } TMENU
INPUT OBJ\-> OBJ\->
DROP DUP
"Enter Value for: "
SWAP + ":value:"
INPUT OBJ\-> OBJ\->
DROP SWAP CLLCD
MATERIALS
CurrentMat STO
UPDIR UPDIR
    \>>
  LAYER
    \<< "Layer name?"
":name:" INPUT OBJ\->
OBJ\-> DROP DUP
'CurrentLayer' STO
LAYERS DUP CRDIR
layerlist +
'layerlist' STO
layerlist OBJ\->
'NoLayers' STO
CurrentLayer
"Material?" ":Mat:"
INPUT OBJ\-> OBJ\->
DROP 'MAT' STO
"Angle?" ":\Gh:"
INPUT OBJ\-> OBJ\->
OBJ\-> STO "Ztop?"
":zt:" INPUT OBJ\->
OBJ\-> OBJ\-> STO
"Zbottom?" ":zb:"
INPUT OBJ\-> OBJ\->
OBJ\-> STO zt zb -
't' STO zt t 2 / -
'zbar' STO
"\Ga1 for this layer?"
":\Ga1:" INPUT OBJ\->
OBJ\-> OBJ\-> STO
"\Ga2 for this layer?"
":\Ga2:" INPUT OBJ\->
OBJ\-> OBJ\-> STO UPDIR
UPDIR CLEAR
    \>>
  CurrentLayer O7
  CurrentMat OP
END