1 : C CHVNS SOURCE CHAT 05/01/12 22:02:24 5004 2 : SUBROUTINE CHVNS(MMATRX,ISECO,MVECTX,NOID) 3 : C 4 : C **** SUBROUTINE QUI A PARTIR D UN OBJET DE TYPE MATRICE ET D UN 5 : C **** CHPOINT FABRIQUE UN VECTEUR SECOND MEMBRE 6 : C **** LE CHPOIN EST DE TYPE SECOND MEMBRE 7 : C 8 : IMPLICIT INTEGER(I-N) 9 : -INC SMMATRI 10 : -INC SMCHPOI 11 : -INC SMELEME 12 : -INC CCOPTIO 13 : -INC SMVECTD 14 : -INC SMCOORD 15 : SEGMENT,ICPR(XCOOR(/1)/(IDIM+1)) 16 : SEGMENT,ICOR(NC1) 17 : C 18 : IF(IIMPI.EQ.3) WRITE(IOIMP,1000) MMATRX,ISECO 19 : 1000 FORMAT(' SUBROUTINE CHV2 : POINTEUR DE LA MATRICE=',I5, 20 : 1 ' POINTEUR DE L''OBJET CHPOINT=',I5) 21 : C 22 : C **** ACTIVATION DES SEGMENTS 23 : C 24 : C ... ceux dépendant de MMATRI ... 25 : 26 : MMATRI=MMATRX 27 : SEGACT,MMATRI 28 : 29 : MILIGN=IILIGN 30 : SEGACT,MILIGN 31 : INC=IPNO(/1) 32 : SEGDES,MILIGN 33 : C ... La taille de MVECTD est INC ... 34 : SEGINI,MVECTD 35 : 36 : MIDUA=IIDUA 37 : SEGACT,MIDUA 38 : IDU=IDUA(/2) 39 : 40 : MHARK=IHARDU 41 : SEGACT,MHARK 42 : 43 : MINCPO=IDUAPO 44 : SEGACT,MINCPO 45 : 46 : MELEME=IGEOMA 47 : SEGACT,MELEME 48 : N2=NUM(/2) 49 : 50 : C ... ceux dépendant de MCHPOI ... 51 : 52 : MCHPOI=ISECO 53 : SEGACT MCHPOI 54 : NSOUPO=IPCHP(/1) 55 : C 56 : C **** DANS ICPR ON COMPTE LES POINTS DE MELEME 57 : C 58 : SEGINI ICPR 59 : DO 25 I=1,N2 60 : ICPR(NUM(1,I))=I 61 : 25 CONTINUE 62 : C 63 : C 64 : C **** FABRICATION D'UN VECTEUR SECOND MEMBRE DANS MVECTD 65 : C **** ON VERIFIE QUE TOUTES LES COMPOSANTES DU VECTEUR EXISTENT DANS 66 : C **** LA MATRICE SI NOID=0 . 67 : C 68 : DO 1 I=1,NSOUPO 69 : MSOUPO=IPCHP(I) 70 : SEGACT,MSOUPO 71 : IPT1=IGEOC 72 : SEGACT,IPT1 73 : NC=NOCOMP(/2) 74 : C ... NC1 = taille de ICOR ... 75 : NC1=NC 76 : SEGINI,ICOR 77 : DO 110 KKIL = 1,NC1 78 : 110 ICOR(KKIL)=0 79 : 80 : DO 11 KI=1,NC 81 : DO 10 J=1,IDU 82 : IF(NOCOMP(KI).NE.IDUA(J)) GO TO 10 83 : IF(NOHARM(KI).NE.IHAR(J)) GO TO 10 84 : C ... dans ICOR on met la correspondance entre les composantes du champ 85 : C et les variables duales de la matrice, s'il y a un zero, alors !!! ... 86 : ICOR(KI)=J 87 : GO TO 11 88 : 10 CONTINUE 89 : 11 CONTINUE 90 : 91 : MPOVAL=IPOVAL 92 : SEGACT,MPOVAL 93 : C ... N = nombre de valeurs de chaque composante (=> noeuds) ... 94 : N=VPOCHA(/1) 95 : DO 20 J=1,N 96 : C ... K = n° d'ordre du noeud examiné dans la rigidité, 0 => !!! ... 97 : K=ICPR(IPT1.NUM(1,J)) 98 : IF(K.NE.0) GO TO 4 99 : IF(NOID.EQ.1) GO TO 20 100 : C 101 : C **** LE NUMERO DU NOEUD DU VECTEUR N'EXISTAIT PAS DANS LA MATRICE 102 : C 103 : ITYP=53 104 : INTERR(1) = IPT1.NUM(1,J) 104 : CALL ERREUR (ITYP) 105 : RETURN 106 : 107 : 4 CONTINUE 108 : ccc 40 CONTINUE 109 : DO 2 LI=1,NC 110 : C ... KKIL = n° local dans la matrice de la composante LI ... 111 : KKIL=ICOR(LI) 112 : IF (KKIL.EQ.0) GOTO 55 113 : 114 : C ... KI = n° global du DDL dual ... 115 : KI=INCPO(KKIL,K) 116 : IF(KI.NE.0) GO TO 6 117 : 118 : 55 CONTINUE 119 : IF(NOID.EQ.1) GO TO 2 120 : C 121 : C **** LE TYPE D'INCONNUE N'EXISTAIT PAS DANS LA MATRICE 122 : C 123 : ITYP=54 124 : MOTERR(1:4) = NOCOMP(LI) 125 : INTERR(1) = NOHARM (LI) 126 : INTERR(2) = IPT1.NUM(1,J) 126 : CALL ERREUR(ITYP) 127 : RETURN 128 : 129 : 6 CONTINUE 130 : VECTBB(KI)=VPOCHA(J,LI) 131 : 2 CONTINUE 132 : 20 CONTINUE 133 : 134 : SEGDES,MPOVAL 135 : SEGDES,MSOUPO 136 : SEGSUP,ICOR 137 : SEGDES,IPT1 138 : 139 : 1 CONTINUE 140 : 141 : SEGSUP ICPR 142 : SEGDES,MELEME 143 : SEGDES,MCHPOI 144 : SEGDES MMATRI 145 : SEGDES,MIDUA 146 : SEGDES,MHARK 147 : SEGDES,MINCPO 148 : MVECTX=MVECTD 149 : C 150 : IF(IIMPI.EQ.3) WRITE(IOIMP,1002)MVECTD 151 : 1002 FORMAT(' SUBROUTINE CHV2 : POINTEUR DU VECTEUR =',I5) 152 : SEGDES MVECTD 153 : RETURN 154 : END 155 : 156 : 157 : 158 : 159 : 160 :
© Cast3M 2003 - All rights reserved.
Disclaimer