Télécharger adtuy.eso

Retour à la liste

Numérotation des lignes :

  1. C ADTUY SOURCE CHAT 12/06/07 21:15:00 7389
  2. SUBROUTINE adtuy (NEF,IPMAIL,IPINTE,IMATE,IVAMAT,NMATR,
  3. & IPMATR,NLIGR)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6. -INC CCOPTIO
  7. -INC SMCHAML
  8. -INC SMCOORD
  9. -INC SMELEME
  10. -INC SMINTE
  11. -INC SMRIGID
  12.  
  13. SEGMENT MPTVAL
  14. INTEGER IPOS(NS),NSOF(NS),IVAL(NCOSOU)
  15. CHARACTER*16 TYVAL(NCOSOU)
  16. ENDSEGMENT
  17.  
  18. SEGMENT,MMAT1
  19. REAL*8 CEL(NBNN,NBNN),XE(3,NBNN)
  20. REAL*8 SHP(6,NBNN),GRAD(NDIM,NBNN)
  21. C* REAL*8 FORME(NBNN),V77(NBNN),V22(IDIM) <- A verifier pour V22
  22. REAL*8 FORME(NBNN),V77(NBNN),V22(NDIM)
  23. REAL*8 CMAT(NDIM,NDIM),CMAT1(IDIM,IDIM),CMAT2(IDIM,IDIM)
  24. ENDSEGMENT
  25.  
  26. C 1 - INITIALISATIONS ET VERIFICATIONS
  27. C ======================================
  28. MELEME = IPMAIL
  29. c* SEGACT,MELEME
  30. NBNN = NUM(/1)
  31. NBELEM = NUM(/2)
  32. C =====
  33. MINTE = IPINTE
  34. c* SEGACT,MINTE
  35. NBPGAU = POIGAU(/1)
  36.  
  37. C =====
  38. MPTVAL = IVAMAT
  39. c* SEGACT,MPTVAL
  40. C =====
  41. XMATRI = IPMATR
  42.  
  43. C =====
  44. C Initialisation des segments de travail
  45. C =====
  46. IF (IFOMOD.EQ.1) THEN
  47. NDIM = 3
  48. ELSE
  49. NDIM = IDIM
  50. ENDIF
  51. segini mmat1
  52. C 2 - BOUCLE SUR LES ELEMENTS DU MAILLAGE ELEMENTAIRE IPMAIL
  53. C ============================================================
  54. DO IEL = 1, NBELEM
  55. *
  56. * MISE A ZERO DU TABLEAU CEL
  57. *
  58. CALL ZERO(CEL,NBNN,NBNN)
  59. *
  60. * COORDONNEES DES NOEUDS DE L'ELEMENT IEL DANS LE REPERE GLOBAL
  61. *
  62. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IEL,XE)
  63. *
  64. *
  65. if(nef.eq.269) then
  66. DO i = 1, NMATR
  67. c* IF (IVAL(i).NE.0) THEN
  68. MELVAL = IVAL(i)
  69. ibmn = MIN(iel ,VELCHE(/2))
  70. igmn = 1
  71. V22(i) = VELCHE(igmn,ibmn)
  72. c* ELSE
  73. c* VALMAT(i) = 0.
  74. c* ENDIF
  75. ENDDO
  76. rhosv=v22(1)*v22(2)*v22(3)*v22(4)
  77. cel(1,1)=-0.5d0*rhosv
  78. cel(1,2)=0.5d0*rhosv
  79. cel(2,1)= cel(1,1)
  80. cel(2,2)= cel(1,2)
  81. elseif( nef.eq.270) then
  82. IFOIS = 0
  83. DO IGAU = 1, NBPGAU
  84. c calcul de la longueur ou du jacobien
  85. * dx= shptot(2,1,igau)*xe(1,1)+shptot(2,2,igau)*xe(1,2)
  86. * $ + shptot(2,3,igau)*xe(1,3)
  87. * dy= shptot(2,1,igau)*xe(2,1)+shptot(2,2,igau)*xe(2,2)
  88. * $ + shptot(2,3,igau)*xe(2,3)
  89. * dl2= dx*dx + dy * dy
  90. * if(idim.eq.3) then
  91. * dz= shptot(2,1,igau)*xe(3,1)+shptot(2,2,igau)*xe(3,2)
  92. * $ + shptot(2,3,igau)*xe(3,3)
  93. * dl2=dl2+ dz*dz
  94. * endif
  95. * djac= sqrt ( dl2)
  96.  
  97. *
  98. *- Recuperation de rho cp et section en un point de la barre
  99. *- NB : ces composantes sont obligatoires donc IVAL(i) n'est pas nul !
  100. DO i = 1, NMATR
  101. c* IF (IVAL(i).NE.0) THEN
  102. MELVAL = IVAL(i)
  103. ibmn = MIN(iel ,VELCHE(/2))
  104. igmn = MIN(igau,VELCHE(/1))
  105. V22(i) = VELCHE(igmn,ibmn)
  106. ENDDO
  107. rhsvs= v22(1)*v22(2)*v22(3)*v22(4)
  108. rhosv= rhsvs*poigau(igau)
  109. do i=1,nbnn
  110. * do j=1,idim
  111. cz= shptot(1,i,igau)* rhosv
  112.  
  113. * enddo
  114. do j=1,nbnn
  115. cel(i,j)=cel(i,j) +cz*shptot(2,j,igau)
  116. enddo
  117. enddo
  118. ENDDO
  119. endif
  120. * write(6,*) ' cel(1,)', ( cel(1,jou),jou=1,nbnn)
  121. * write(6,*) ' cel(2,)', ( cel(2,jou),jou=1,nbnn)
  122. * if(nbnn.eq.3)write(6,*) ' cel(3,)', ( cel(3,jou),jou=1,nbnn)
  123. call rempms(cel,nbnn,re(1,1,iel))
  124. enddo
  125. SEGSUP,MMAT1
  126. return
  127. end
  128.  
  129.  
  130.  

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