1 : C DYNE04 SOURCE CHAT 05/01/12 23:12:41 5004 2 : SUBROUTINE DYNE04(MMATRX,ISECO,ICHT2,NDDL,MOOPT) 3 : ************************************************************************ 4 : * 5 : * D Y N E 0 4 6 : * ----------- 7 : * 8 : * FONCTION: 9 : * --------- 10 : * UTILITAIRE DE L'OPERATEUR "DYNE" 11 : * MET LES VALEURS D'UN CHPOINT DANS UN VECTEUR, SELON LES 12 : * PARTITIONS GEOMETRIQUES DE L'OBJET RIGIDITE M 13 : * 14 : * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) 15 : * ----------- 16 : * 17 : * MMATRX (E) POINTEUR SUR UN SEGMENT MMATRI ( ACTIF ) 18 : * ISECO (E) POINTEUR SUR LE CHPOINT 19 : * VEC (E/S) VECTEUR CONTENANT LES VALEURS DU CHPOINT 20 : * NDDL (E) NOMBRE DE DEGRES DE LIBERTE 21 : * MOOPT (E) 'INCO' SI ON TRAVAILLE SUR LES INCONNUES PRIMALES 22 : * 'DUAL' SI ON TRAVAILLE SUR LES INCONNUES DUALES 23 : * 24 : * AUTEUR, DATE DE CREATION: 25 : * ------------------------- 26 : * DENIS ROBERT, LE 25 NOVEMBRE 1988. 27 : * REVU ET CORRIGE DECEMBRE 89 MP 28 : * 29 : * LANGAGE: 30 : * -------- 31 : * ESOPE + FORTRAN77 32 : * 33 : ************************************************************************ 34 : * 35 : * MODULES UTILISES: 36 : * 37 : IMPLICIT INTEGER(I-N) 38 : -INC SMMATRI 39 : -INC SMCHPOI 40 : -INC SMELEME 41 : -INC CCOPTIO 42 : -INC SMCOORD 43 : * 44 : SEGMENT,ICPR(XCOOR(/1)/(IDIM+1)) 45 : SEGMENT,ICOR(NC1) 46 : * 47 : SEGMENT,MCHT2 48 : REAL*8 VCC2(NDDL) 49 : ENDSEGMENT 50 : * 51 : * REAL*8 VEC(*) 52 : CHARACTER*4 MOOPT 53 : * 54 : *--- ACTIVATION DES SEGMENTS 55 : * 56 : MCHT2=ICHT2 57 : MMATRI=MMATRX 58 : MCHPOI=ISECO 59 : SEGACT,MCHPOI 60 : NSOUPO=IPCHP(/1) 61 : MELEME=IGEOMA 62 : MIMIK=IIMIK 63 : MIDUA=IIDUA 64 : IDU=IMIK(/2) 65 : MHARK=IHARK 66 : MINCPO=IINCPO 67 : N2=NUM(/2) 68 : * 69 : DO 33 I33=1,NDDL 70 : VCC2(I33)=0.D0 71 : 33 CONTINUE 72 : * END DO 73 : * 74 : *--- DANS ICPR ON COMPTE LES POINTS DE MELEME 75 : * 76 : SEGINI,ICPR 77 : DO 25 I=1,N2 78 : ICPR(NUM(1,I))=I 79 : 25 CONTINUE 80 : * END DO 81 : * 82 : *--- FABRICATION D'UN VECTEUR, ON VERIFIE QUE TOUTES LES COMPOSANTES 83 : *--- DU CHPOINT EXISTENT DANS L'OBJET MMATRI 84 : * 85 : DO 1 I=1,NSOUPO 86 : MSOUPO=IPCHP(I) 87 : SEGACT,MSOUPO 88 : IPT1=IGEOC 89 : SEGACT,IPT1 90 : NC=NOCOMP(/2) 91 : NC1=NC 92 : SEGINI,ICOR 93 : IF (MOOPT.EQ.'DUAL') THEN 94 : DO 11 KI=1,NC 95 : DO 10 J=1,IDU 96 : IF(NOCOMP(KI).NE.IDUA(J)) GO TO 10 97 : IF(NOHARM(KI).NE.IHAR(J)) GO TO 10 98 : ICOR(KI)=J 99 : GO TO 11 100 : 10 CONTINUE 101 : * END DO 102 : 11 CONTINUE 103 : * END DO 104 : ELSE IF (MOOPT.EQ.'INCO') THEN 105 : DO 21 KI=1,NC 106 : DO 20 J=1,IDU 107 : IF(NOCOMP(KI).NE.IMIK(J)) GO TO 20 108 : IF(NOHARM(KI).NE.IHAR(J)) GO TO 20 109 : ICOR(KI)=J 110 : GO TO 21 111 : 20 CONTINUE 112 : * END DO 113 : 21 CONTINUE 114 : * END DO 115 : ELSE 115 : CALL ERREUR(510) 116 : RETURN 117 : ENDIF 118 : MPOVAL=IPOVAL 119 : SEGACT,MPOVAL 120 : N=VPOCHA(/1) 121 : DO 2 J=1,N 122 : K=ICPR(IPT1.NUM(1,J)) 123 : IF (K.NE.0) GO TO 4 124 : * 125 : *--- LE NUMERO DU NOEUD DU VECTEUR N'EXISTAIT PAS DANS LA MATRICE 126 : * 126 : CALL ERREUR (53) 127 : RETURN 128 : 4 CONTINUE 129 : DO 2 LI=1,NC 130 : KKIL=ICOR(LI) 131 : IF (KKIL.EQ.0) GOTO 2 132 : KI=INCPO(KKIL,K) 133 : IF (KI.NE.0) GO TO 6 134 : * 135 : *--- LE TYPE D'INCONNUE N'EXISTAIT PAS DANS LA MATRICE 136 : * 136 : CALL ERREUR(54) 137 : RETURN 138 : 6 CONTINUE 139 : VCC2(KI)=VPOCHA(J,LI) 140 : 2 CONTINUE 141 : * END DO 142 : * END DO 143 : SEGDES,MPOVAL,MSOUPO,IPT1 144 : SEGSUP,ICOR 145 : 1 CONTINUE 146 : * END DO 147 : SEGSUP,ICPR 148 : * 149 : END 150 : 151 : 152 : 153 :
© Cast3M 2003 - All rights reserved.
Disclaimer