Télécharger fpma2d.eso

Retour à la liste

Numérotation des lignes :

fpma2d
  1. C FPMA2D SOURCE OF166741 25/02/06 21:15:04 12146
  2.  
  3. C____________________________________________________________________
  4. C CALCULE LES FORCES DE PRESSIONS SUR LES FACES D ELEMENTS
  5. C MASSIFS BIDIMENSIONNELS
  6. C
  7. C ENTREES :
  8. C ---------
  9. C
  10. C IPTVPR POINTEUR SUR UN MELVAL CONTENANT LES PRESSIONS APPLIQUEES
  11. C 0 SI ON A DONNE UNE VALEUR CONSTANTE
  12. C IPMAIL POINTEUR SUR UN OBJET GEOMETRIQUE
  13. C IPTINT POINTEUR SUR UN MINTE CONTENANT LES POINTS D INTEGRATION
  14. C (ACTIF EN ENTREE ET EN SORTIE SANS MODIFICATION)
  15. C IVAFOR POINTEUR SUR UN MPTVAL ET LES MELVALS CONTENANT LES FORCES
  16. C NODALE RESULTANTES
  17. C IVACAR POINTEUR SUR UN MELVAL DE CARACTERISTIQUES
  18. C
  19. C JACQUELINE BROCHARD AVRIL 85
  20. C
  21. C PASSAGE AUX NOUVEAUX CHAMELEM PAR JM CAMPENON LE 17 09 90
  22. C
  23. C____________________________________________________________________
  24.  
  25. SUBROUTINE FPMA2D(IPTVPR,IPMAIL,ipmaim,IPTINT,IVAFOR,IVACAR,XP
  26. & ,netn1,ietn1)
  27.  
  28. IMPLICIT INTEGER(I-N)
  29. IMPLICIT REAL*8 (A-H,O-Z)
  30.  
  31. -INC PPARAM
  32. -INC CCOPTIO
  33. -INC CCREEL
  34. C= Quelques constantes (2.Pi)
  35. PARAMETER (X2Pi=6.283185307179586476925286766559D0)
  36.  
  37. -INC SMCHAML
  38. -INC SMELEME
  39. -INC SMINTE
  40. -INC SMCOORD
  41.  
  42. segment netn(notn)
  43. segment ietn(letn)
  44.  
  45. SEGMENT MWORK
  46. REAL*8 XE(3,NBNN)
  47. ENDSEGMENT
  48.  
  49. SEGMENT MPTVAL
  50. INTEGER IPOS(NS),NSOF(NS)
  51. INTEGER IVAL(NCOSOU)
  52. CHARACTER*16 TYVAL(NCOSOU)
  53. ENDSEGMENT
  54.  
  55. idimp1 = IDIM+1
  56. * prob optimiseur il faut initialiser melva1
  57. MELVA1=IVAFOR
  58. IF (IPTVPR.NE.0) THEN
  59. MELVA1=IPTVPR
  60. c* SEGACT,MELVA1 <- ACTIF EN E/S
  61. IG11 = MELVA1.VELCHE(/1)
  62. IB12 = MELVA1.VELCHE(/2)
  63. ENDIF
  64.  
  65. MINTE=IPTINT
  66. C* SEGACT,MINTE <- ACTIF EN E/S
  67. NBPGAU=POIGAU(/1)
  68.  
  69. MELEME = IPMAIL
  70. c* SEGACT,MELEME <- ACTIF EN E/S
  71. NBNN = meleme.NUM(/1)
  72. NBELEM = meleme.NUM(/2)
  73.  
  74. SEGINI,MWORK
  75.  
  76. netn = netn1
  77. ietn = ietn1
  78. ipt1 = ipmaim
  79. IF (IPT1.GT.0) THEN
  80. if (netn.eq.0 .or. ietn.eq.0) then
  81. write(ioimp,*) 'FPMA2D : incompatibilite netn, ietn & IPMAIM'
  82. endif
  83. c* SEGACT,IPT1 <- ACTIF en E/S
  84. nbnn1 = ipt1.num(/1)
  85. nbel1 = ipt1.num(/2)
  86. ELSE
  87. if (netn.gt.0 .or. ietn.gt.0) then
  88. write(ioimp,*) 'FPMA2D : incompatibilite netn, ietn & IPMAIM'
  89. endif
  90. ENDIF
  91. C
  92. C BOUCLE SUR LES ELEMENTS
  93. C
  94. DO IB = 1, NBELEM
  95.  
  96. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  97.  
  98. XFLOT = +1.D0
  99. IF (netn.GT.0) THEN
  100. DO inf = 1, nbnn
  101. ip = meleme.num(inf,ib)
  102. ideb = netn(ip)+1
  103. ifin = netn(ip+1)
  104. do itn = ideb, ifin
  105. IEM = ietn(itn)
  106. jne = 0
  107. do i = 1, nbnn
  108. ino = meleme.num(i,ib)
  109. do i1 = 1, nbnn1
  110. if (ino.eq.ipt1.num(i1,IEM)) jne=jne+1
  111. enddo
  112. enddo
  113. if (jne.eq.nbnn) goto 170
  114. enddo
  115. ENDDO
  116. CALL ERREUR(26)
  117. GOTO 9900
  118. 170 continue
  119. XG = 0.D0
  120. YG = 0.D0
  121. DO I = 1, NBNN1
  122. ino = (IPT1.NUM(I,IEM)-1)*idimp1
  123. XG=XG+XCOOR(ino+1)
  124. YG=YG+XCOOR(ino+2)
  125. ENDDO
  126. XG=XG / NBNN1
  127. YG=YG / NBNN1
  128.  
  129. XK=0.D0
  130. YK=0.D0
  131. DO i = 1,NBNN
  132. XK=XK+XE(1,I)
  133. YK=YK+XE(2,I)
  134. ENDDO
  135. XK=XK/NBNN
  136. YK=YK/NBNN
  137.  
  138. V_1 = XG - XK
  139. V_2 = YG - YK
  140. r_z = 1.D0 / SQRT(V_1*V_1+V_2*V_2)
  141. V_1 = V_1 * r_z
  142. V_2 = V_2 * r_z
  143. ENDIF
  144. C
  145. C BOUCLE SUR LES POINTS DE GAUSS
  146. C
  147. DO IGAU = 1, NBPGAU
  148. C
  149. C RECUPERATION DE L'EPAISSEUR
  150. C
  151. DIM3=1.D0
  152. MPTVAL=IVACAR
  153. IF (IVACAR.NE.0 .AND. IFOUR.EQ.-2) THEN
  154. MELVAL=IVAL(1)
  155. IF (MELVAL.NE.0) THEN
  156. IGMN=MIN(IGAU,VELCHE(/1))
  157. IBMN=MIN(IB,VELCHE(/2))
  158. DIM3=VELCHE(IGMN,IBMN)
  159. ENDIF
  160. ENDIF
  161.  
  162. VNQSI1 = 0.D0
  163. VNQSI2 = 0.D0
  164. R = 0.D0
  165. DO I = 1, NBNN
  166. VNQSI1 = VNQSI1+SHPTOT(2,I,IGAU)*XE(1,I)
  167. VNQSI2 = VNQSI2+SHPTOT(2,I,IGAU)*XE(2,I)
  168. R = R+SHPTOT(1,I,IGAU)*XE(1,I)
  169. ENDDO
  170.  
  171. VNN1 = -VNQSI2
  172. VNN2 = VNQSI1
  173.  
  174. if (igau.eq.1.and.netn.gt.0) then
  175. vnnn = 1.D0 / sqrt(vnn1*vnn1+vnn2*vnn2)
  176. test = v_1*(vnn1*vnnn) + v_2*(vnn2*vnnn)
  177. if (test.lt.0d0) xflot = -1.d0
  178. endif
  179.  
  180. IF (IFOUR.LT.0) THEN
  181. R=1.D0
  182. ELSEIF (IFOUR.EQ.0.OR.(IFOUR.EQ.1
  183. + .AND.NIFOUR.EQ.0)) THEN
  184. R=X2PI*R
  185. ELSEIF (IFOUR.EQ.1.AND.NIFOUR.NE.0) THEN
  186. R=XPI*R
  187. ENDIF
  188. r_z = POIGAU(IGAU) * R * DIM3 * XFLOT
  189. IF (IPTVPR.NE.0) THEN
  190. IGMN=MIN(IGAU,IG11)
  191. IBMN=MIN(IB ,IB12)
  192. r_z = r_z * MELVA1.VELCHE(IGMN,IBMN)
  193. ELSE
  194. r_z = r_z * XP
  195. ENDIF
  196. T1 = r_z * VNN1
  197. T2 = r_z * VNN2
  198.  
  199. MPTVAL=IVAFOR
  200. MELVAL=IVAL(1)
  201. DO i=1,NBNN
  202. VELCHE(i,IB) = VELCHE(i,IB) + SHPTOT(1,i,IGAU)*T1
  203. ENDDO
  204. MELVAL=IVAL(2)
  205. DO i=1,NBNN
  206. VELCHE(i,IB) = VELCHE(i,IB) + SHPTOT(1,i,IGAU)*T2
  207. ENDDO
  208.  
  209. ENDDO
  210.  
  211. ENDDO
  212.  
  213. 9900 CONTINUE
  214. SEGSUP,MWORK
  215. c* SEGDES,MINTE <- ACTIF en E/S
  216. c* SEGDES,MELEME <- ACTIF en E/S
  217. c* IF (IPTVPR.NE.0) SEGDES,MELVA1 <- ACTIF en E/S
  218.  
  219. RETURN
  220. END
  221.  
  222.  
  223.  

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