1 : C DYNE07 SOURCE CHAT 05/01/12 23:13:01 5004 2 : SUBROUTINE DYNE07(ICHT2,MMATRX,IPCREF,IPCHPO) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : ************************************************************************ 6 : * 7 : * D Y N E 0 7 8 : * ----------- 9 : * 10 : * FONCTION: 11 : * --------- 12 : * UTILITAIRE DE L'OPERATEUR "DYNE" 13 : * MET LES VALEURS D'UN VECTEUR ORDONNE SELON L'OBJET RIGIDITE M 14 : * DANS UN CHPOINT, ORDONNE SELON UN AUTRE CHPOINT DE REFERENCE. 15 : * 16 : * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) 17 : * ----------- 18 : * 19 : * VEC (E) VECTEUR 20 : * MMATRX (E) POINTEUR SUR LE SEGMENT MMATRI ( ACTIF ) 21 : * IPCREF (E) POINTEUR SUR LE CHPOINT DE REFERENCE 22 : * IPCHPO (S) POINTEUR SUR LE CHPOINT RESULTAT 23 : * 24 : * AUTEUR, DATE DE CREATION: 25 : * ------------------------- 26 : * DENIS ROBERT, LE 6 DECEMBRE 1988. 27 : * REVU ET CORRIGE DECEMBRE 89 MP 28 : * 29 : * LANGAGE: 30 : * -------- 31 : * ESOPE + FORTRAN77 32 : * 33 : ************************************************************************ 34 : * 35 : * MODULES UTILISES: 36 : * 37 : -INC SMCHPOI 38 : -INC SMMATRI 39 : -INC CCOPTIO 40 : -INC SMELEME 41 : -INC SMCOORD 42 : * 43 : SEGMENT,MCHT2 44 : REAL*8 VCC2(NDDL) 45 : ENDSEGMENT 46 : * 47 : * REAL*8 VEC(*) 48 : * 49 : SEGMENT,ICPR(XCOOR(/1)/(IDIM+1)) 50 : SEGMENT,ICOR(NC1) 51 : * 52 : *--- ACTIVATION DES SEGMENTS 53 : * 54 : MCHT2=ICHT2 55 : MMATRI=MMATRX 56 : MCHPO1=IPCREF 57 : SEGACT,MCHPO1 58 : NSOUP1=MCHPO1.IPCHP(/1) 59 : MELEME=IGEOMA 60 : MIMIK=IIMIK 61 : IMI=IMIK(/2) 62 : MHARK=IHARK 63 : MINCPO=IINCPO 64 : N2=NUM(/2) 65 : * 66 : *--- RECENSEMENT DES POINTS SUPPORTS 67 : * 68 : SEGINI,ICPR 69 : DO 10 I=1,N2 70 : ICPR(NUM(1,I))=I 71 : 10 CONTINUE 72 : * END DO 73 : * 74 : *--- INITIALISATION DU CHPOINT RESULTAT 75 : * 76 : NSOUPO=NSOUP1 77 : NAT=1 78 : SEGINI,MCHPOI 79 : IPCHPO=MCHPOI 80 : MTYPOI='SCALAIRE' 81 : MOCHDE=' ' 82 : JATTRI(1)=MCHPO1.JATTRI(1) 83 : IFOPOI=IFOUR 84 : * 85 : *--- BOUCLE SUR LES PARTITIONS DU CHPOINT DE REFERENCE 86 : * 87 : DO 100 I=1,NSOUP1 88 : MSOUP1=MCHPO1.IPCHP(I) 89 : SEGACT,MSOUP1 90 : IPT1=MSOUP1.IGEOC 91 : SEGACT,IPT1 92 : SEGINI,IPT2=IPT1 93 : NC=MSOUP1.NOCOMP(/2) 94 : SEGINI,MSOUPO 95 : IPCHP(I)=MSOUPO 96 : IGEOC=IPT2 97 : NC1=NC 98 : SEGINI,ICOR 99 : DO 110 KI=1,NC 100 : NOCOMP(KI)=MSOUP1.NOCOMP(KI) 101 : NOHARM(KI)=MSOUP1.NOHARM(KI) 102 : DO 120 J=1,IMI 103 : IF (MSOUP1.NOCOMP(KI).NE.IMIK(J)) GO TO 120 104 : IF (MSOUP1.NOHARM(KI).NE.IHAR(J)) GO TO 120 105 : ICOR(KI)=J 106 : GO TO 110 107 : 120 CONTINUE 108 : * END DO 109 : 110 CONTINUE 110 : * END DO 111 : MPOVA1=MSOUP1.IPOVAL 112 : SEGACT,MPOVA1 113 : N=MPOVA1.VPOCHA(/1) 114 : SEGINI,MPOVAL=MPOVA1 115 : IPOVAL=MPOVAL 116 : DO 200 J=1,N 117 : K=ICPR(IPT1.NUM(1,J)) 118 : IF (K.NE.0) GO TO 300 119 : * 120 : *--- INCOMPATIBILITE D'UN POINT SUPPORT 121 : * 121 : CALL ERREUR(252) 122 : RETURN 123 : 300 CONTINUE 124 : DO 200 LI=1,NC 125 : KKIL=ICOR(LI) 126 : IF (KKIL.EQ.0) GO TO 200 127 : KI=INCPO(KKIL,K) 128 : IF (KI.NE.0) GO TO 400 129 : * 130 : *--- INCOMPATIBILITE DE TYPE D'INCONNUE 131 : * 131 : CALL ERREUR(288) 132 : * RETURN 133 : 400 CONTINUE 134 : VPOCHA(J,LI)=VCC2(KI) 135 : 200 CONTINUE 136 : * END DO 137 : SEGDES,MPOVA1,MSOUP1,IPT1 138 : SEGDES,MPOVAL,MSOUPO,IPT2 139 : SEGSUP,ICOR 140 : 100 CONTINUE 141 : * END DO 142 : SEGSUP,ICPR 143 : SEGDES,MCHPO1,MCHPOI 144 : * 145 : END 146 : 147 : 148 : 149 :
© Cast3M 2003 - All rights reserved.
Disclaimer