1 : C FSURPO SOURCE FANDEUR 12/07/18 21:15:46 7434 2 : 3 : SUBROUTINE FSURPO(IPMODL,IPCHPS,IPVECT,IVPROJ, IPCHPF) 4 : 5 : *_______________________________________________________________________ 6 : * 7 : * CALCULE LES FORCES NODALES EQUIVALENTES SUR DES POUTRES 8 : * 9 : * ENTREES : 10 : * --------- 11 : * IPMODL MODELE SUR LEQUEL S APPLIQUE LA DENSITE DE FORCES 12 : * IPCHPS CHPOINT CONTENANT LES VALEURS DE LA DENSITE DE FORCE AUX 13 : * NOEUDS DU MODELE, SINON =0 (IPVECT NON NUL) 14 : * IPVECT VECTEUR (POINT) DEFINISSANT LA DENSITE DE FORCE CONSTANTE 15 : * (=0 SI IPCHPS NON NUL) 16 : * IVPROJ VECTEUR (POINT) POUR LA PROJECTION (?) 17 : * 18 : * SORTIES : 19 : * --------- 20 : * IPCHPF CHPOINT DES FORCES NODALES EQUIVALENTES 21 : * = 0 EN CAS D'ERREUR (ET IERR NON NUL AUSSI DANS CE CAS) 22 : * 23 : * I. Politopoulos Mars 1998 24 : *_______________________________________________________________________ 25 : * 26 : IMPLICIT INTEGER(I-N) 27 : IMPLICIT REAL*8(A-H,O-Z) 28 : 29 : -INC CCOPTIO 30 : 31 : -INC SMMODEL 32 : -INC SMCHAML 33 : -INC SMLMOTS 34 : -INC SMCOORD 35 : -INC SMELEME 36 : -INC TMTRAV 37 : 38 : SEGMENT indic(nbpts) 39 : 40 : REAL*8 xe(3,2),vf(3) 41 : 42 : IPCHPF = 0 43 : * 44 : * --> VERIFICATIONS SUR LA COMPATIBILITE MODE DE CALCUL/DIMENSION 45 : * 46 : iret = 0 47 : IF (IDIM.EQ.3) THEN 48 : IF (IFOUR.NE.2) iret = 1 49 : ELSE IF (IDIM.EQ.2) THEN 50 : IF (IFOUR.EQ.0 .OR. IFOUR.EQ.1) iret = 1 51 : ELSE 52 : iret = 1 53 : ENDIF 54 : IF (iret.NE.0) THEN 54 : CALL ERREUR(21) 55 : RETURN 56 : ENDIF 57 : * 58 : * --> VERIFICATIONS SUR LE VECTEUR DE PROJECTION SI FOURNI 59 : * 60 : IF (IVPROJ.NE.0) THEN 61 : IREFP = (IVPROJ-1)*(IDIM+1) 62 : VP1 = XCOOR(IREFP+1) 63 : VP2 = XCOOR(IREFP+2) 64 : IF (IDIM.EQ.2) THEN 65 : VP3 = 0.D0 66 : ELSE 67 : VP3 = XCOOR(IREFP+3) 68 : ENDIF 69 : vlong = VP1*VP1 + VP2*VP2 + VP3*VP3 70 : IF (vlong.LE.0.D0) THEN 70 : CALL ERREUR(277) 71 : RETURN 72 : ENDIF 73 : vlong = SQRT(vlong) 74 : VP1 = VP1 / vlong 75 : VP2 = VP2 / vlong 76 : VP3 = VP3 / vlong 77 : ENDIF 78 : * 79 : * SI on a donne un vecteur comme densite de forces, il faut le trans- 80 : * former en chpoint defini sur le maillage soustendant le modele : 81 : * 82 : indic = 0 83 : IF (IPVECT.NE.0) THEN 84 : IREFP = (IPVECT-1)*(IDIM+1) 85 : vf(1) = XCOOR(IREFP+1) 86 : vf(2) = XCOOR(IREFP+2) 87 : IF (IDIM.EQ.2) THEN 88 : vf(3) = 0.D0 89 : ELSE 90 : vf(3) = XCOOR(IREFP+3) 91 : ENDIF 92 : vlong = vf(1)*vf(1) + vf(2)*vf(2) + vf(3)*vf(3) 93 : IF (vlong.LE.0.D0) THEN 93 : CALL ERREUR(277) 94 : RETURN 95 : ENDIF 96 : * 97 : nbpts = XCOOR(/1)/(IDIM+1) 98 : SEGINI,indic 99 : * 100 : NNNOE = 0 101 : ENDIF 102 : 103 : * On cree un champ de materiau bidon (masse volumique) 104 : MMODEL=IPMODL 105 : SEGACT,MMODEL 106 : * 107 : N1 = KMODEL(/1) 108 : L1 = 16 109 : N3 = 6 110 : SEGINI,mchelm 111 : titche = 'CARACTERISTIQUES' 112 : ifoche = IFOUR 113 : 114 : IF (IDIM.EQ.3) THEN 115 : N2 = 5 116 : * ELSE IF (IDIM.EQ.2) THEN 117 : ELSE 118 : N2 = 3 119 : ENDIF 120 : 121 : n1ptel = 1 122 : n1el = 1 123 : n2ptel = 0 124 : n2el = 0 125 : 126 : DO 10 I = 1, N1 127 : 128 : IMODEL=KMODEL(I) 129 : SEGACT,IMODEL 130 : 131 : * mele = nefmod 132 : meleme = imamod 133 : * 134 : imache(i) = imamod 135 : conche(i) = conmod 136 : * 137 : infche(i,1) = 0 138 : infche(i,2) = 0 139 : infche(i,3) = 0 140 : infche(i,4) = infmod(6) 141 : infche(i,5) = 0 142 : infche(i,6) = 4 143 : * 144 : SEGINI,mchaml 145 : ichaml(i) = mchaml 146 : * 147 : nomche(1) = 'RHO ' 148 : nomche(2) = 'SECT ' 149 : nomche(3) = 'INRZ ' 150 : IF (IDIM.EQ.3) THEN 151 : nomche(4) = 'INRY ' 152 : nomche(5) = 'TORS ' 153 : ENDIF 154 : * 155 : DO 20 j = 1, N2 156 : * si projection 157 : IF (j.EQ.1 .AND. IVPROJ.NE.0) THEN 158 : SEGACT,meleme 159 : nbelem = num(/2) 160 : n1el = nbelem 161 : SEGINI,melval 162 : DO 50 iel = 1, nbelem 162 : CALL DOXE(xcoor,IDIM,2,num,iel,xe) 163 : vl1 = xe(1,2) - xe(1,1) 164 : vl2 = xe(2,2) - xe(2,1) 165 : vl3 = xe(3,2) - xe(3,1) 166 : vlong = vl1*vl1 + vl2*vl2 + vl3*vl3 167 : xsin = vl1*vp1 + vl2*vp2 + vl3*vp3 168 : xcos = SQRT( 1.d0 - (xsin*xsin / vlong) ) 169 : velche(1,iel) = xcos 170 : 50 CONTINUE 171 : SEGDES,meleme 172 : ELSE 173 : n1el = 1 174 : SEGINI,melval 175 : velche(1,1) = 1.d0 176 : ENDIF 177 : ielval(j) = melval 178 : typche(j) = 'REAL*8' 179 : 20 CONTINUE 180 : 181 : * Si on a donne un vecteur comme densite de forces, il faut le 182 : * transformer en chpoint 183 : IF (IPVECT.NE.0) then 184 : SEGACT,meleme 185 : nbnoe = num(/1) 186 : nbele = num(/2) 187 : DO 3 iel = 1, nbele 188 : DO 3 n = 1, nbnoe 189 : inoe = num(n,iel) 190 : IF (indic(inoe) .EQ. 0) THEN 191 : indic(inoe) = 1 192 : NNNOE = NNNOE + 1 193 : ENDIF 194 : 3 CONTINUE 195 : SEGDES,meleme 196 : ENDIF 197 : 198 : SEGDES,IMODEL 199 : * 200 : 10 CONTINUE 201 : 202 : SEGDES,MMODEL 203 : 204 : * on ne se casse pas trop la tete. On calcule la force en passant 205 : * par la masse 205 : CALL MASSE1(ipmodl,mchelm,ipmas,iret,0) 205 : CALL DTCHAM(mchelm) 206 : IF (IERR.NE.0 .OR. iret.NE.1) RETURN 207 : 208 : IF (IPVECT.NE.0) THEN 209 : NNIN = IDIM 210 : SEGINI,mtrav 211 : inco(1) = 'UX ' 212 : inco(2) = 'UY ' 213 : IF (IDIM.EQ.3) THEN 214 : inco(3) = 'UZ ' 215 : ENDIF 216 : ii = 0 217 : DO inoe = 1, nbpts 218 : IF (indic(inoe) .EQ. 1) THEN 219 : ii = ii + 1 220 : igeo(ii)= inoe 221 : DO 4 k = 1, IDIM 222 : bb(k,ii) = vf(k) 223 : ibin(k,ii) = 1 224 : 4 CONTINUE 225 : IF (ii.EQ.NNNOE) GOTO 401 226 : ENDIF 227 : ENDDO 228 : 401 CONTINUE 228 : CALL CRECHP(mtrav,ipchp2) 229 : SEGSUP,mtrav,indic 230 : ELSE 231 : * noms des variables possibles 232 : * et de leurs duales 233 : jgn = 4 234 : IF (IDIM.EQ.3) THEN 235 : jgm = 6 236 : SEGINI,mlmot1 237 : mlmot1.mots(1) = 'FX ' 238 : mlmot1.mots(2) = 'FY ' 239 : mlmot1.mots(3) = 'FZ ' 240 : mlmot1.mots(4) = 'MX ' 241 : mlmot1.mots(5) = 'MY ' 242 : mlmot1.mots(6) = 'MZ ' 243 : SEGINI,mlmot2 244 : mlmot2.mots(1) = 'UX ' 245 : mlmot2.mots(2) = 'UY ' 246 : mlmot2.mots(3) = 'UZ ' 247 : mlmot2.mots(4) = 'RX ' 248 : mlmot2.mots(5) = 'RY ' 249 : mlmot2.mots(6) = 'RZ ' 250 : c* ELSE IF (IDIM.EQ.2) THEN 251 : ELSE 252 : jgm = 3 253 : SEGINI,mlmot1 254 : mlmot1.mots(1) = 'FX ' 255 : mlmot1.mots(2) = 'FY ' 256 : mlmot1.mots(3) = 'MZ ' 257 : SEGINI,mlmot2 258 : mlmot2.mots(1) = 'UX ' 259 : mlmot2.mots(2) = 'UY ' 260 : mlmot2.mots(3) = 'RZ ' 261 : ENDIF 262 : iplm1 = mlmot1 263 : iplm2 = mlmot2 263 : CALL NOMC2(IPCHPS,iplm1,iplm2,ipchp2) 264 : SEGSUP,mlmot1,mlmot2 265 : ENDIF 266 : 266 : CALL MUCPRI(ipchp2,ipmas, IPCHPF) 267 : 267 : CALL DTCHPO(ipchp2) 267 : CALL ECRCHA('ELEM') 267 : CALL DTRIGI(ipmas) 268 : 269 : RETURN 270 : END 271 : 272 :
© Cast3M 2003 - All rights reserved.
Disclaimer