1 : C UNIFO1 SOURCE CHAT 09/10/09 21:25:45 6519 2 : * CREATION D'UN 'CHPOINT' UNIFORME. 3 : SUBROUTINE UNIFO1 (IPRIGI,XX,IPCHPO) 4 : ************************************************************************ 5 : * 6 : * U N I F O 1 7 : * ----------- 8 : * 9 : * FONCTION: 10 : * --------- 11 : * 12 : * CREER UN 'CHPOINT' DE MEME VALEUR EN TOUT POINT DU SUPPORT 13 : * GEOMETRIQUE D'UNE 'RIGIDITE' DONNEE. 14 : * 15 : * MODE D'APPEL: 16 : * ------------- 17 : * 17 : * CALL UNIFO1 (IPRIGI,XX,IPCHPO) 18 : * 19 : * PARAMETRES: (E)=ENTREE (S)=SORTIE 20 : * ----------- 21 : * 22 : * IPRIGI ENTIER (E) POINTEUR D'UNE 'RIGIDITE'. 23 : * XX REEL SP (E) VALEUR DU 'CHPOINT' EN TOUT POINT. 24 : * IPCHPO ENTIER (S) POINTEUR DU 'CHPOINT' DETERMINE. 25 : * 26 : * LEXIQUE: (ORDRE ALPHABETIQUE) 27 : * -------- 28 : * 29 : * INC ENTIER NOMBRE D'INCONNUES DU PROBLEME. 30 : * IPMATR ENTIER POINTEUR SUR L'OBJET 'MATRICE' ASSOCIE A LA 31 : * 'RIGIDITE' DE POINTEUR "IPRIGI". 32 : * IPVECT ENTIER POINTEUR D'UN OBJET DE TRAVAIL 'VECTDOUB'. 33 : * 34 : * SOUS-PROGRAMMES APPELES: 35 : * ------------------------ 36 : * 37 : * TRIANG, VCH1. 38 : * 39 : * AUTEUR, DATE DE CREATION: 40 : * ------------------------- 41 : * 42 : * PASCAL MANIGOT 1ER AVRIL 1985 43 : * 44 : * LANGAGE: 45 : * -------- 46 : * 47 : * ESOPE + FORTRAN77 48 : * 49 : ************************************************************************ 50 : * 51 : IMPLICIT INTEGER(I-N) 52 : -INC CCOPTIO 53 : -INC SMMATRI 54 : -INC SMRIGID 55 : -INC SMVECTD 56 : * 57 : * -- DETERMINATION DU NOMBRE D'INCONNUES DU PROBLEME TRAITE -- 58 : * 59 : integer insym 60 : insym = 0 61 : MRIGID = IPRIGI 62 : SEGACT,MRIGID 63 : NRG = IRIGEL(/1) 64 : NBR = IRIGEL(/2) 65 : IPMATR = ICHOLE 66 : IF(NORINC.GT.0 .AND. NORIND.GT.0) THEN 67 : INSYM = 1 68 : ENDIF 69 : IF (NRG.GE.7) THEN 70 : DO 9 IN = 1,NBR 71 : IANTI=IRIGEL(7,IN) 72 : IF(IANTI.GT.0) THEN 73 : INSYM = 1 74 : ENDIF 75 : 9 CONTINUE 76 : ENDIF 77 : SEGDES,MRIGID 78 : * 79 : IF (IPMATR .EQ. 0) THEN 80 : IF (INSYM .EQ. 0) THEN 80 : CALL TRIANG (IPRIGI,1D-15) 81 : ELSE 81 : CALL ldmt1(IPRIGI,1d-15) 82 : ENDIF 83 : IF (IERR .NE. 0) RETURN 84 : MRIGID = IPRIGI 85 : SEGACT,MRIGID 86 : IPMATR = ICHOLE 87 : SEGDES,MRIGID 88 : END IF 89 : * 90 : MMATRI = IPMATR 91 : SEGACT,MMATRI 92 : MILIGN=IILIGN 93 : SEGDES,MMATRI 94 : SEGACT,MILIGN 95 : INC=IPNO(/1) 96 : SEGDES,MILIGN 97 : * 98 : * -- DETERMINATION D'UN VECTEUR UNIFORME, DE DIMENSION EGALE A 99 : * CELLE DU PROBLEME TRAITE -- 100 : * 101 : SEGINI,MVECTD 102 : IPVECT = MVECTD 103 : DO 100 IB=1,INC 104 : VECTBB(IB) = XX 105 : 100 CONTINUE 106 : * END DO 107 : SEGDES,MVECTD 108 : * 109 : * -- TRANSFORMATION DU VECTEUR EN CHPOINT -- 110 : * 110 : CALL VCH1 (IPMATR,IPVECT, IPCHPO,IPRIGI) 111 : IF (IERR .NE. 0) RETURN 112 : * 113 : MVECTD = IPVECT 114 : SEGSUP,MVECTD 115 : * 116 : END 117 : 118 : 119 : 120 : 121 : 122 : 123 : 124 : 125 : 126 : 127 :
© Cast3M 2003 - All rights reserved.
Disclaimer