本文发表在 rolia.net 枫下论坛SUBROUTINE CCCCCR(IARG,SLOT)
C SUBROUTINE CCCCR/TCCCR
C IARG = MACHINE ARRAY INDEX
C SLOT = ARRAY ALLOCATION TABLE INDEX
C J = STRTIN(1,SLOT) [ USES CON(J) THROUGH CON(J+10) ]
C K = STRTIN(2,SLOT) [ USES STATE(K) THROUGH STATE(K+2) ]
C L = STRTIN(3,SLOT) [ USES VAR(L) ]
C M = STRTIN(4,SLOT) [ USES ICON(M) AND ICON(M+1) ]
C
$INSERT PARAM4
$INSERT PERM4
$INSERT HEADR4
$INSERT PSSCM4
$INSERT DSCOM4
$INSERT SITCM4
C
INTEGER IBUSA, KOUNTA, JA, KA, LA, MA,
# IARG, SLOT
CHARACTER IMA*1
EXTERNAL BSSEQN, OLDDYN, VLTFOR
INTRINSIC ABS, SQRT
C
INTEGER I, IB, IBUS, J, JJ, K,
# KK, L, M
REAL DEL2, THI, THO, XXRE, XXIM, XXR(2)
COMPLEX XX
LOGICAL NEW
CHARACTER IM*1, VLTI*4
C
EQUIVALENCE (XX,XXR,XXRE), (XXR(2),XXIM)
C
I=IARG
J=STRTIN(1,SLOT)
K=STRTIN(2,SLOT)
L=STRTIN(3,SLOT)
M=STRTIN(4,SLOT)
C
IF (MODE.GT.4) GO TO 1000
C
IF (MSTATE.GT.0) RETURN
C
NEW=MODE.EQ.4
C
WHEN (NEW .OR. (KPAUSE.EQ.2 .AND. MODE.EQ.3) )
. IB=ABS(NUMTRM(I))
. NUMTRM(I)=-IB
C .
. IF (JCODE(IB).NE.2 .OR. MCSTAT(I).LE.0)
. . ICON(M+1)=-IB
. . ZERO-MACHINE-ARRAYS
. . IF (NEW) VAR(L)=0.
. . RETURN
. ...FIN更多精彩文章及讨论,请光临枫下论坛 rolia.net
C SUBROUTINE CCCCR/TCCCR
C IARG = MACHINE ARRAY INDEX
C SLOT = ARRAY ALLOCATION TABLE INDEX
C J = STRTIN(1,SLOT) [ USES CON(J) THROUGH CON(J+10) ]
C K = STRTIN(2,SLOT) [ USES STATE(K) THROUGH STATE(K+2) ]
C L = STRTIN(3,SLOT) [ USES VAR(L) ]
C M = STRTIN(4,SLOT) [ USES ICON(M) AND ICON(M+1) ]
C
$INSERT PARAM4
$INSERT PERM4
$INSERT HEADR4
$INSERT PSSCM4
$INSERT DSCOM4
$INSERT SITCM4
C
INTEGER IBUSA, KOUNTA, JA, KA, LA, MA,
# IARG, SLOT
CHARACTER IMA*1
EXTERNAL BSSEQN, OLDDYN, VLTFOR
INTRINSIC ABS, SQRT
C
INTEGER I, IB, IBUS, J, JJ, K,
# KK, L, M
REAL DEL2, THI, THO, XXRE, XXIM, XXR(2)
COMPLEX XX
LOGICAL NEW
CHARACTER IM*1, VLTI*4
C
EQUIVALENCE (XX,XXR,XXRE), (XXR(2),XXIM)
C
I=IARG
J=STRTIN(1,SLOT)
K=STRTIN(2,SLOT)
L=STRTIN(3,SLOT)
M=STRTIN(4,SLOT)
C
IF (MODE.GT.4) GO TO 1000
C
IF (MSTATE.GT.0) RETURN
C
NEW=MODE.EQ.4
C
WHEN (NEW .OR. (KPAUSE.EQ.2 .AND. MODE.EQ.3) )
. IB=ABS(NUMTRM(I))
. NUMTRM(I)=-IB
C .
. IF (JCODE(IB).NE.2 .OR. MCSTAT(I).LE.0)
. . ICON(M+1)=-IB
. . ZERO-MACHINE-ARRAYS
. . IF (NEW) VAR(L)=0.
. . RETURN
. ...FIN更多精彩文章及讨论,请光临枫下论坛 rolia.net