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