1 : C DEPIM2 SOURCE KICH 08/07/30 21:15:00 6140 2 : SUBROUTINE DEPIM2(IPT) 3 : IMPLICIT INTEGER(I-N) 4 : CHARACTER*4 charm,charre 5 : REAL*8 XXA,vval,X0,X1 6 : -INC CCOPTIO 7 : -INC SMTABLE 8 : 9 : mtable = ipt 10 : segact mtable 11 : ima = mlotab - 1 12 : c if (ima.eq.1) RETURN 13 : 14 : do 1200 im = 1,ima 14 : CALL ACCTAB(IPT,'ENTIER',IM,0.d0,' ',.true.,IP0, 15 : & 'TABLE',I1,X1,CHARRE,.true.,ITMOD) 16 : if (ierr.ne.0) return 16 : CALL ACCTAB(ITMOD,'MOT',I0,X0,'BLOCAGE',.true.,IP0, 17 : & 'RIGIDITE',I1,X1,charre,.true.,IR1) 18 : if (ir1.lt.0) goto 1200 19 : if (ierr.ne.0) return 20 : * 20 : call ecrree(1.d0) 20 : call ecrobj('RIGIDITE',ir1) 20 : call depimp 20 : call lirobj('CHPOINT',ichpoi,1, iretou) 21 : if (ierr.ne.0) return 22 : 22 : CALL ECCTAB(ITMOD,'MOT',0,0.0D0,'FORCE',.TRUE.,IPO, 23 : & 'CHPOINT',0,0.0D0,' ',.TRUE.,ichpoi) 24 : 25 : 1200 continue 26 : c 27 : c 28 : RETURN 29 : END 30 : 31 :
© Cast3M 2003 - All rights reserved.
Disclaimer