1 : C FORCE2 SOURCE KICH 08/07/30 21:15:10 6140 2 : SUBROUTINE FORCE2(IPT) 3 : 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8 (A-H,O-Z) 6 : -INC CCOPTIO 7 : -INC SMTABLE 8 : CHARACTER*4 MOTYPO(10),charm,charre 9 : character*8 typret 10 : CHARACTER*4 MODEDU(6),MORODU(5) 11 : REAL*8 XXA,vval,X0,X1 12 : DATA MODEDU / 'FX ','FY ','FZ ','FR ','FZ ','FT ' / 13 : DATA MORODU / 'MX ','MY ','MZ ','MT ','MS ' / 14 : 15 : mtable = ipt 16 : segact mtable 17 : ima = mlotab - 1 18 : if (ima.eq.1) RETURN 19 : do 1200 im = 1,ima 20 : typret = ' ' 20 : CALL ACCTAB(IPT,'ENTIER',IM,0.d0,' ',.true.,IP0, 21 : & 'TABLE',I1,X1,CHARRE,.true.,ITMOD) 22 : if (ierr.ne.0) return 22 : CALL ACCTAB(ITMOD,'MOT',I0,X0,'DDL_LIAISON',.true.,IP0, 23 : & typret,I1,X1,charre,.true.,IR1) 24 : if (typret.ne.'MOT') goto 1200 25 : do kmo = 1,6 26 : if (charre.eq.modedu(kmo)) goto 220 27 : enddo 28 : do kmo = 1,5 29 : if (charre.eq.morodu(kmo)) goto 220 30 : enddo 31 : cc write(6,*) charre,' ne correspond pas à un effort' 32 : goto 1200 33 : 220 continue 33 : CALL ACCTAB(ITMOD,'MOT',I0,X0,'POINT_LIAISON',.true.,IP0, 34 : & 'POINT',I1,X1,charre,.true.,IPTS) 35 : if (ierr.ne.0) return 36 : 37 : 38 : if (ierr.ne.0) return 39 : * 39 : call ecrobj('POINT',IPTS) 39 : call ecrree(1.d0) 39 : call ecrcha(charre) 39 : call force(1) 39 : call lirobj('CHPOINT',ichpoi,1, iretou) 40 : if (ierr.ne.0) return 41 : 41 : CALL ECCTAB(ITMOD,'MOT',0,0.0D0,'FORCE',.TRUE.,IPO, 42 : & 'CHPOINT',0,0.0D0,' ',.TRUE.,ichpoi) 43 : 44 : 1200 continue 45 : segdes mtable 46 : return 47 : END 48 :
© Cast3M 2003 - All rights reserved.
Disclaimer