1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81
|
SUBROUTINE OPT2B (IPR,PR,PL,RR)
C
INTEGER COUNT,IPR(1),OUTTAP,SYSBUF,IY(1)
REAL PL(1),PR(1),RR(1),Y(1),Z(8)
CHARACTER UFM*23,UWM*25
COMMON /XMSSG / UFM,UWM
COMMON /BLANK / SKP1(2),COUNT,SKP2(6),NWDSP,
1 SKP3(6),NPRW,NKLW,NTOTL,CONV
COMMON /ZZZZZZ/ CORE(1)
COMMON /SYSTEM/ SYSBUF,OUTTAP
EQUIVALENCE (CORE(1),Z(1),MAX), (EPS,Z(2)), (GAMA,Z(3)),
1 (IPRNT,Z(7)), (IY(1),Y(1),Z(8))
C EQUIVALENT ARE (IPR,PR)
C
NMES = 0
CH = 1.0
C
DO 100 NP = 1,NPRW,NWDSP
ALPH= PR(NP+4)
I = 1
ICP = NTOTL - 4
3 ICP = ICP+4
IF (IY(ICP) .LE. 0) GO TO 5
IF (IY(ICP) .NE. NP) GO TO 3
C
C SPECIAL HANDLING OF TRIM6
C
4 ALPH = Y(ICP+I)
C
5 IF (ALPH) 70,40,10
C
C POSITIVE ALPHA, CALCULATE PNEW
C
10 IRR = (NP+NWDSP)/NWDSP
IF (ABS(GAMA-1.0) .LT. 1.0E-4) CH = 0.25*RR(IRR) + 0.75
PNEW = PR(NP+3)*((ALPH/(ALPH+(1.0-ALPH)*GAMA))**CH)
IF (IPR(NP+5) .EQ. 0) GO TO 30
C
C COMPARE TO LIMIT DATA
C
KPL = IPR(NP+5)
DELP = PNEW/PR(NP+2)
IF (DELP .LT. PL(KPL)) GO TO 20
KPL = KPL + 1
IF (DELP.LE.PL(KPL) .OR. PL(KPL).EQ.0) GO TO 30
C
C RECALCULATE ALPHA, PNEW BASED ON THE LIMIT
C
20 PNEW = PR(NP+2)*PL(KPL)
ALPH =-PNEW*GAMA/(PNEW*(1.0-GAMA)-PR(NP+3))
C
30 PR(NP+4) = ALPH
IF (NP .EQ. IY(ICP)) Y(ICP+I) = ALPH
GO TO 80
C
C ZERO STRESS INPUT, CHANGE ALPH TO 0.0001
C
40 IF (IPRNT.EQ.0 .OR. NMES.GE.100) GO TO 60
NMES = NMES + 1
CALL PAGE2 (-2)
WRITE (OUTTAP,50) UWM,IPR(NP)
50 FORMAT (A25,' 2303, FULLY-STRESSED DESIGN DETECTED ZERO STRESS ',
1 'FOR PROPERTY',I9, /5X,'CHECK PROPERTY CARD OR UNLOADED ',
2 'ELEMENT(S)')
60 ALPH = 1.0E-4
GO TO 10
C
C NO CHANGE IN ALPH (-1.0 DETECTED)
C
70 ALPH = -1.0E0
IF (NP .EQ. IY(ICP)) GO TO 30
C
80 IF (NP .NE. IY(ICP)) GO TO 100
I = I + 1
IF (I .LE. 3) GO TO 4
ICP = ICP + 4
C
100 CONTINUE
C
RETURN
END
|