Télécharger fsurpo.eso

Retour à la liste

Numérotation des lignes :

  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
  55. CALL ERREUR(21)
  56. RETURN
  57. ENDIF
  58. *
  59. * --> VERIFICATIONS SUR LE VECTEUR DE PROJECTION SI FOURNI
  60. *
  61. IF (IVPROJ.NE.0) THEN
  62. IREFP = (IVPROJ-1)*(IDIM+1)
  63. VP1 = XCOOR(IREFP+1)
  64. VP2 = XCOOR(IREFP+2)
  65. IF (IDIM.EQ.2) THEN
  66. VP3 = 0.D0
  67. ELSE
  68. VP3 = XCOOR(IREFP+3)
  69. ENDIF
  70. vlong = VP1*VP1 + VP2*VP2 + VP3*VP3
  71. IF (vlong.LE.0.D0) THEN
  72. CALL ERREUR(277)
  73. RETURN
  74. ENDIF
  75. vlong = SQRT(vlong)
  76. VP1 = VP1 / vlong
  77. VP2 = VP2 / vlong
  78. VP3 = VP3 / vlong
  79. ENDIF
  80. *
  81. * SI on a donne un vecteur comme densite de forces, il faut le trans-
  82. * former en chpoint defini sur le maillage soustendant le modele :
  83. *
  84. indic = 0
  85. IF (IPVECT.NE.0) THEN
  86. IREFP = (IPVECT-1)*(IDIM+1)
  87. vf(1) = XCOOR(IREFP+1)
  88. vf(2) = XCOOR(IREFP+2)
  89. IF (IDIM.EQ.2) THEN
  90. vf(3) = 0.D0
  91. ELSE
  92. vf(3) = XCOOR(IREFP+3)
  93. ENDIF
  94. vlong = vf(1)*vf(1) + vf(2)*vf(2) + vf(3)*vf(3)
  95. IF (vlong.LE.0.D0) THEN
  96. CALL ERREUR(277)
  97. RETURN
  98. ENDIF
  99. *
  100. nbpts = XCOOR(/1)/(IDIM+1)
  101. SEGINI,indic
  102. *
  103. NNNOE = 0
  104. ENDIF
  105.  
  106. * On cree un champ de materiau bidon (masse volumique)
  107. MMODEL=IPMODL
  108. SEGACT,MMODEL
  109. *
  110. N1 = KMODEL(/1)
  111. L1 = 16
  112. N3 = 6
  113. SEGINI,mchelm
  114. titche = 'CARACTERISTIQUES'
  115. ifoche = IFOUR
  116.  
  117. IF (IDIM.EQ.3) THEN
  118. N2 = 5
  119. * ELSE IF (IDIM.EQ.2) THEN
  120. ELSE
  121. N2 = 3
  122. ENDIF
  123.  
  124. n1ptel = 1
  125. n1el = 1
  126. n2ptel = 0
  127. n2el = 0
  128.  
  129. DO 10 I = 1, N1
  130.  
  131. IMODEL=KMODEL(I)
  132. SEGACT,IMODEL
  133.  
  134. * mele = nefmod
  135. meleme = imamod
  136. *
  137. imache(i) = imamod
  138. conche(i) = conmod
  139. *
  140. infche(i,1) = 0
  141. infche(i,2) = 0
  142. infche(i,3) = 0
  143. infche(i,4) = infmod(6)
  144. infche(i,5) = 0
  145. infche(i,6) = 4
  146. *
  147. SEGINI,mchaml
  148. ichaml(i) = mchaml
  149. *
  150. nomche(1) = 'RHO '
  151. nomche(2) = 'SECT '
  152. nomche(3) = 'INRZ '
  153. IF (IDIM.EQ.3) THEN
  154. nomche(4) = 'INRY '
  155. nomche(5) = 'TORS '
  156. ENDIF
  157. *
  158. DO 20 j = 1, N2
  159. * si projection
  160. IF (j.EQ.1 .AND. IVPROJ.NE.0) THEN
  161. SEGACT,meleme
  162. nbelem = num(/2)
  163. n1el = nbelem
  164. SEGINI,melval
  165. DO 50 iel = 1, nbelem
  166. CALL DOXE(xcoor,IDIM,2,num,iel,xe)
  167. vl1 = xe(1,2) - xe(1,1)
  168. vl2 = xe(2,2) - xe(2,1)
  169. vl3 = xe(3,2) - xe(3,1)
  170. vlong = vl1*vl1 + vl2*vl2 + vl3*vl3
  171. xsin = vl1*vp1 + vl2*vp2 + vl3*vp3
  172. xcos = SQRT( 1.d0 - (xsin*xsin / vlong) )
  173. velche(1,iel) = xcos
  174. 50 CONTINUE
  175. SEGDES,meleme
  176. ELSE
  177. n1el = 1
  178. SEGINI,melval
  179. velche(1,1) = 1.d0
  180. ENDIF
  181. ielval(j) = melval
  182. typche(j) = 'REAL*8'
  183. 20 CONTINUE
  184.  
  185. * Si on a donne un vecteur comme densite de forces, il faut le
  186. * transformer en chpoint
  187. IF (IPVECT.NE.0) then
  188. SEGACT,meleme
  189. nbnoe = num(/1)
  190. nbele = num(/2)
  191. DO 3 iel = 1, nbele
  192. DO 3 n = 1, nbnoe
  193. inoe = num(n,iel)
  194. IF (indic(inoe) .EQ. 0) THEN
  195. indic(inoe) = 1
  196. NNNOE = NNNOE + 1
  197. ENDIF
  198. 3 CONTINUE
  199. SEGDES,meleme
  200. ENDIF
  201.  
  202. SEGDES,IMODEL
  203. *
  204. 10 CONTINUE
  205.  
  206. SEGDES,MMODEL
  207.  
  208. * on ne se casse pas trop la tete. On calcule la force en passant
  209. * par la masse
  210. CALL MASSE1(ipmodl,mchelm,ipmas,iret,0)
  211. CALL DTCHAM(mchelm)
  212. IF (IERR.NE.0 .OR. iret.NE.1) RETURN
  213.  
  214. IF (IPVECT.NE.0) THEN
  215. NNIN = IDIM
  216. SEGINI,mtrav
  217. inco(1) = 'UX '
  218. inco(2) = 'UY '
  219. IF (IDIM.EQ.3) THEN
  220. inco(3) = 'UZ '
  221. ENDIF
  222. ii = 0
  223. DO inoe = 1, nbpts
  224. IF (indic(inoe) .EQ. 1) THEN
  225. ii = ii + 1
  226. igeo(ii)= inoe
  227. DO 4 k = 1, IDIM
  228. bb(k,ii) = vf(k)
  229. ibin(k,ii) = 1
  230. 4 CONTINUE
  231. IF (ii.EQ.NNNOE) GOTO 401
  232. ENDIF
  233. ENDDO
  234. 401 CONTINUE
  235. CALL CRECHP(mtrav,ipchp2)
  236. SEGSUP,mtrav,indic
  237. ELSE
  238. * noms des variables possibles
  239. * et de leurs duales
  240. jgn = 4
  241. IF (IDIM.EQ.3) THEN
  242. jgm = 6
  243. SEGINI,mlmot1
  244. mlmot1.mots(1) = 'FX '
  245. mlmot1.mots(2) = 'FY '
  246. mlmot1.mots(3) = 'FZ '
  247. mlmot1.mots(4) = 'MX '
  248. mlmot1.mots(5) = 'MY '
  249. mlmot1.mots(6) = 'MZ '
  250. SEGINI,mlmot2
  251. mlmot2.mots(1) = 'UX '
  252. mlmot2.mots(2) = 'UY '
  253. mlmot2.mots(3) = 'UZ '
  254. mlmot2.mots(4) = 'RX '
  255. mlmot2.mots(5) = 'RY '
  256. mlmot2.mots(6) = 'RZ '
  257. c* ELSE IF (IDIM.EQ.2) THEN
  258. ELSE
  259. jgm = 3
  260. SEGINI,mlmot1
  261. mlmot1.mots(1) = 'FX '
  262. mlmot1.mots(2) = 'FY '
  263. mlmot1.mots(3) = 'MZ '
  264. SEGINI,mlmot2
  265. mlmot2.mots(1) = 'UX '
  266. mlmot2.mots(2) = 'UY '
  267. mlmot2.mots(3) = 'RZ '
  268. ENDIF
  269. iplm1 = mlmot1
  270. iplm2 = mlmot2
  271. CALL NOMC2(IPCHPS,iplm1,iplm2,ipchp2)
  272. SEGSUP,mlmot1,mlmot2
  273. ENDIF
  274.  
  275. CALL MUCPRI(ipchp2,ipmas, IPCHPF)
  276.  
  277. CALL DTCHPO(ipchp2)
  278. CALL ECRCHA('ELEM')
  279. CALL DTRIGI(ipmas)
  280.  
  281. RETURN
  282. END
  283.  
  284.  
  285.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales