1 : C RGBASE SOURCE CHAT 09/10/09 21:23:01 6519 2 : SUBROUTINE RGBASE(IPOI2,IRIG,IRET) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : C======================================================================= 6 : C CE SUBROUTINE ENCHAINE LES CALCULS DES RIGIDITES SUIVANTES : 7 : C . RIGIDITE DUES AUX MODES (MN OU KN) ....RGMODE 8 : C . COUPLAGE MODE-LIAISONS ....RGLIMO 9 : C . COUPLAGE LIAISONS-LIAISONS ....RGLILI 10 : C LE RESULTAT EST MIS DANS IRET 11 : C 12 : C PROGRAMME PAR FARVACQUE 13 : C APPELE PAR RIGI 14 : C APPELLE RGLIMO FUSRIG RGLILI RIGMOD 15 : C======================================================================= 16 : -INC CCOPTIO 17 : -INC SMRIGID 18 : -INC SMBASEM 19 : -INC SMSOLUT 20 : -INC SMSTRUC 21 : -INC SMATTAC 22 : C 23 : SEGMENT LIAT(NBASE) 24 : SEGMENT LRAT(0) 25 : C 26 : KRIGI=0 27 : LRAT=0 28 : IFLAT=0 29 : LIAT=0 30 : MBASEM=IPOI2 31 : SEGACT MBASEM 32 : NBASE=LISBAS(/1) 33 : C 34 : C ON TRAITE D ABORD LES OBJETS ATTACHE 35 : C ON ENVOIT A RGMATT UN ATTACHE OU LES RIGIDITES SONT TOUTES 36 : C DIFFERENTES POUR NE PAS COMPTER PLUSIEURS FOIS LE MEME TERME 37 : C 38 : IF(IRIG.NE.2) GOTO 100 39 : SEGINI LIAT 40 : NLIA=0 41 : DO 10 IA=1,NBASE 42 : MSOBAS=LISBAS(IA) 43 : SEGACT MSOBAS 44 : IF(IBSTRM(4).EQ.0) GO TO 12 45 : DO 11 IAT=1,NLIA 46 : IF(IBSTRM(4).EQ.LIAT(IAT)) GO TO 12 47 : 11 CONTINUE 48 : NLIA=NLIA+1 49 : LIAT(NLIA)=IBSTRM(4) 50 : 12 CONTINUE 51 : SEGDES MSOBAS 52 : 10 CONTINUE 53 : IF(NLIA.EQ.0) GO TO 100 54 : IF(NLIA.EQ.1) THEN 55 : KATTAC=LIAT(1) 56 : GO TO 19 57 : ENDIF 58 : C 59 : SEGINI LRAT 60 : DO 13 JAT=1,NLIA 61 : MATTAC=LIAT(JAT) 62 : SEGACT MATTAC 63 : DO 16 JJAT=1,LISATT(/1) 64 : MSOUMA=LISATT(JJAT) 65 : SEGACT MSOUMA 66 : DO 14 KAT=1,IPMATK(/1) 67 : IF(IPMATK(KAT).EQ.0)GO TO 14 68 : DO 15 LAT=1,LRAT(/1) 69 : IF(IPMATK(KAT).EQ.LRAT(LAT))GO TO 14 70 : 15 CONTINUE 71 : LRAT(**)=IPMATK(KAT) 72 : 14 CONTINUE 73 : SEGDES MSOUMA 74 : 16 CONTINUE 75 : SEGDES MATTAC 76 : 13 CONTINUE 77 : C 78 : C ON CREE L ATTACHE SI BESOIN 79 : C 80 : IFLAT=1 81 : N=1 82 : SEGINI MATTAC 83 : KATTAC=MATTAC 84 : N=0 85 : M=LRAT(/1) 86 : SEGINI MSOUMA 87 : LISATT(1)=MSOUMA 88 : ITYATT='MECA' 89 : IGEOCH=0 90 : IPHYCH=0 91 : DO 18 NLI=1,M 92 : IPMATK(NLI)=LRAT(NLI) 93 : 18 CONTINUE 94 : C 95 : C MATTAC ET MSOUMA SEGDESES DANS RGMATT 96 : C 97 : 19 CONTINUE 97 : CALL RGMATT(KATTAC,KRIG) 98 : KRIGI=KRIG 99 : C 100 : 100 CONTINUE 101 : IF(LIAT.NE.0)SEGSUP LIAT 102 : IF(LRAT.NE.0)SEGSUP LRAT 102 : IF(IFLAT.NE.0)CALL DTMATT(KATTAC) 103 : DO 1 IB=1,NBASE 104 : MSOBAS=LISBAS(IB) 105 : SEGACT MSOBAS 106 : ISTRU=IBSTRM(1) 107 : IMODE=IBSTRM(2) 108 : ISOLS=IBSTRM(3) 109 : IF(ISOLS.EQ.0) GO TO 4 110 : IF(IMODE.EQ.0) GO TO 1032 111 : IF(IRIG.EQ.2) GO TO 1032 111 : CALL RGLIMO(IMODE,ISOLS,ISTRU,IRIG,KRIG) 112 : IF(IERR.NE.0) GO TO 2000 113 : IF(KRIG.EQ.0) GO TO 1032 114 : IF(KRIGI.EQ.0) THEN 115 : KRIGI=KRIG 116 : ELSE 116 : CALL FUSRIG(KRIGI,KRIG,IRET) 117 : MRIGID=KRIGI 118 : SEGSUP MRIGID 119 : KRIGI=IRET 120 : ENDIF 120 : 1032 CALL RGLILI(ISOLS,ISTRU,IRIG,KRIG) 121 : IF(IERR.NE.0) GO TO 2000 122 : IF(KRIG.EQ.0) GO TO 4 123 : IF(KRIGI.EQ.0) THEN 124 : KRIGI=KRIG 125 : ELSE 125 : CALL FUSRIG(KRIGI,KRIG,IRET) 126 : MRIGID=KRIGI 127 : SEGSUP MRIGID 128 : KRIGI=IRET 129 : ENDIF 130 : 4 CONTINUE 131 : IF(IMODE.EQ.0) GO TO 1036 131 : CALL RIGMOD(IMODE,IRIG,KRIG) 132 : IF(IERR.NE.0) GO TO 2000 133 : IF(KRIGI.EQ.0) THEN 134 : KRIGI=KRIG 135 : ELSE 135 : CALL FUSRIG(KRIGI,KRIG,IRET) 136 : MRIGID=KRIGI 137 : SEGSUP MRIGID 138 : KRIGI=IRET 139 : ENDIF 140 : 1036 CONTINUE 141 : SEGDES MSOBAS 142 : 1 CONTINUE 143 : SEGDES MBASEM 144 : C 145 : IRET=KRIGI 146 : 2000 CONTINUE 147 : RETURN 148 : END 149 : 150 : 151 : 152 : 153 : 154 :
© Cast3M 2003 - All rights reserved.
Disclaimer