1 : C STRUCT SOURCE FANDEUR 10/12/14 21:19:53 6812 2 : SUBROUTINE STRUCT 3 : C 4 : C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 5 : C C 6 : C C * LECTURE D UNE STRUCTURE ELEMENTAIRE 7 : C C SYNTAXE : S = STRU K M ; 8 : C C * FABRICATION DE N SOUS STRUCTURES IDENTIQUES 9 : C C SYNTAXE : S = STRU K M NFOIS; 10 : C C 11 : C C S : OBJET DE TYPE STRUCTURE 12 : C C K : OBJET DE TYPE RIGIDITE .MTYMAT=RIGIDITE 13 : C C M : OBJET DE TYPE RIGIDITE .MTYMAT=MASSE 14 : C C NFOIS : ENTIER .IL Y A NFOIS STRUCTURES IDENTIQUES 15 : C C OU BIEN: 16 : C C S=STRU CHMATE CHCARA (NFOIS); 17 : C C CHMATE:OBJET DE TYPE CHMELEME DE SOUS TYPE MATE 18 : C C CHCARA:OBJET DE TYPE CHMELEME DE SOUS TYPE CARA 19 : C C 20 : C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 21 : C 22 : IMPLICIT INTEGER(I-N) 23 : IMPLICIT REAL*8(A-H,O-Z) 24 : -INC SMRIGID 25 : -INC SMSTRUC 26 : -INC CCOPTIO 27 : C 28 : IRIGI=0 29 : IMASS=0 29 : 1 CALL LIROBJ('RIGIDITE',IRET,0,IRETOU) 30 : IF(IRETOU.EQ.0) GO TO 105 31 : MRIGID=IRET 32 : SEGACT MRIGID 33 : IF(MTYMAT.NE.'RIGIDITE') GO TO 100 34 : IF(IRIGI.EQ.0) GO TO 101 35 : MOTERR(1:8)='RIGIDITE' 36 : MOTERR(9:16)='RIGIDITE' 36 : CALL ERREUR(130) 37 : C LA RIGIDITE A DEJA ETE DONNEE 38 : SEGDES MRIGID 39 : GO TO 5000 40 : 101 CONTINUE 41 : IRIGI=MRIGID 42 : SEGDES MRIGID 43 : IF(IMASS.EQ.0) GO TO 1 44 : GO TO 105 45 : 100 IF(MTYMAT.NE.'MASSE') GO TO 104 46 : IF(IMASS.EQ.0) GO TO 103 47 : MOTERR(1:8)='RIGIDITE' 48 : MOTERR(9:16)='MASSE' 48 : CALL ERREUR(130) 49 : C LA MASSE A DEJA ETE DONNEE 50 : SEGDES MRIGID 51 : GO TO 5000 52 : 103 CONTINUE 53 : IMASS=MRIGID 54 : SEGDES MRIGID 55 : IF(IRIGI.EQ.0) GO TO 1 56 : GO TO 105 57 : 104 CONTINUE 58 : MOTERR(1:8)='RIGIDITE' 59 : MOTERR(9:16)=MTYMAT 59 : CALL ERREUR(131) 60 : C ON N ATTEND PAS CE SOUS TYPE DE RIGIDITE 61 : SEGDES MRIGID 62 : GO TO 5000 63 : C 64 : 105 CONTINUE 65 : IF(IRIGI.NE.0) GO TO 106 66 : 106 CONTINUE 66 : CALL LIRENT(N,0,IRETOU) 67 : IF(IRETOU.EQ.0) N=1 68 : SEGINI MSTRUC 69 : NS=2 70 : DO 200 I=1,N 71 : SEGINI MSOSTU 72 : ISRAID=IRIGI 73 : ISMASS=IMASS 74 : ITYSOU=0 75 : SEGDES MSOSTU 76 : LISTRU(I)=MSOSTU 77 : 200 CONTINUE 78 : SEGDES MSTRUC 78 : CALL ECROBJ('STRUCTUR',MSTRUC) 79 : 80 : 5000 CONTINUE 81 : RETURN 82 : END 83 : 84 :
© Cast3M 2003 - All rights reserved.
Disclaimer