Télécharger cham12.eso

Retour à la liste

Numérotation des lignes :

  1. C CHAM12 SOURCE PV 20/02/27 21:15:01 10537
  2. SUBROUTINE CHAM12(NBTHL,ITHR,ISUP,ISAUT,MMODEL,MCHELM,ICPR,MTRA2)
  3.  
  4. implicit real*8 (a-h,o-z)
  5.  
  6. -INC PPARAM
  7. -INC CCOPTIO
  8. -INC CCGEOME
  9.  
  10. -INC SMCHAML
  11. -INC SMINTE
  12. -INC SMMODEL
  13. -INC SMELEME
  14.  
  15. CHARACTER*(NCONCH) CONM
  16. CHARACTER*8 LENAME
  17.  
  18. LOGICAL FLAG1
  19. LOGICAL FLAG3
  20. LOGICAL FLAG4
  21.  
  22. SEGMENT ISAUT(IVAL,NSOUS)
  23. SEGMENT ICPR(NNNN)
  24.  
  25. SEGMENT MTRA2
  26. C Copie du CHPOINT dans MTRA2 pour aller plus vite ensuite
  27. CHARACTER*4 INCO(N2)
  28. REAL*8 BB(NX,N2)
  29. C INCO : Nom des INCONNUES du CHPOINT
  30. C BB : Valeurs au noeuds du MMODEL (associees au ICPR)
  31. C NX : Nombre de noeuds differents dans le MODELE
  32. C N2 : Nombre de composantes dans le CHPOINT
  33. ENDSEGMENT
  34.  
  35.  
  36. CONM =' '
  37.  
  38. NSOUS=ISAUT(/2)
  39. N2 =MTRA2.BB(/2)
  40.  
  41. C boucle sur les zones geometriques elementaires
  42. C
  43. isouss=0
  44. DO 20 ISOUS=1,NSOUS
  45. IPT2=ISAUT(1,ISOUS)
  46. C On saute directement les SOUS-ZONES inutiles
  47. IF(IPT2 .EQ. 0)GOTO 20
  48. isouss=isouss+1
  49.  
  50. IF (MMODEL.NE.0) THEN
  51. IPMINT = ISAUT(4,ISOUS)
  52. ISUP1 = ISAUT(6,ISOUS)
  53. IMODEL = KMODEL(ISOUS)
  54. CONM = CONMOD
  55. IF (ISUP1.GT.1) MELE=NEFMOD
  56. IF(INFMOD(/1).NE.0) NPINT=INFMOD(1)
  57. ELSE
  58. ISUP1 =ISUP
  59. IPMINT=0
  60. ENDIF
  61.  
  62. IMACHE(ISOUSs) =IPT2
  63. CONCHE(ISOUSs) =CONM
  64. INFCHE(ISOUSs,1)=0
  65. INFCHE(ISOUSs,2)=0
  66. INFCHE(ISOUSs,3)=NIFOUR
  67. IF (ISUP1.GT.1) THEN
  68. INFCHE(ISOUSs,4)=IPMINT
  69. INFCHE(ISOUSs,5)=0
  70. ENDIF
  71. INFCHE(ISOUSs,6)=ISUP1
  72.  
  73. MCHAML=ICHAML(ISOUSs)
  74. DO ICOMP=1,N2
  75. NOMCHE(ICOMP)= MTRA2.INCO(ICOMP)
  76. TYPCHE(ICOMP)='REAL*8'
  77. ENDDO
  78. NBN1 =IPT2.NUM(/1)
  79. NBELE1=IPT2.NUM(/2)
  80.  
  81. C On assure le travail contigu en memoire (Si // sur les threads)
  82. IF(NBTHL .EQ. 1)THEN
  83. IDEB = 1
  84. IFIN = NBELE1
  85.  
  86. ELSE
  87. NBTHR= MIN(NBELE1,NBTHL)
  88. IF(ithr .GT. NBTHR) GOTO 20
  89. IRES = MOD(NBELE1,NBTHR)
  90. IF(IRES .EQ. 0)THEN
  91. ILON = NBELE1 / NBTHR
  92. IDEB = (ithr-1)* ILON + 1
  93. ELSE
  94. IF (ithr .LE. IRES) THEN
  95. ILON = (NBELE1 / NBTHR) + 1
  96. IDEB = (ithr-1)* ILON + 1
  97. ELSE
  98. ILON = NBELE1 / NBTHR
  99. IDEB = (IRES * (ILON+1)) + (ithr-IRES-1)* ILON + 1
  100. ENDIF
  101. ENDIF
  102. IFIN = IDEB + ILON - 1
  103. ENDIF
  104.  
  105. IF (IPMINT .EQ. 0) THEN
  106. C Remplissage des MELVAL aux NOEUDS de chaque composante
  107. DO IE=IDEB,IFIN
  108. DO IG=1,NBN1
  109. INOEU=IPT2.NUM(IG,IE)
  110. IPCPR=ICPR(INOEU)
  111. DO ICOMP=1,N2
  112. MELVAL=IELVAL(ICOMP)
  113. VELCHE(IG,IE)=BB(IPCPR,ICOMP)
  114. ENDDO
  115. ENDDO
  116. ENDDO
  117.  
  118. ELSE
  119. C Changement de support
  120. MINTE =IPMINT
  121. NBPGAU=SHPTOT(/3)
  122. NBNO =ISAUT(5,ISOUS)
  123.  
  124. DO ICOMP=1,N2
  125. MELVAL= IELVAL(ICOMP)
  126. MELGEO=NUMGEO(MELE)
  127. IF( MELGEO.EQ.12 .OR. MELGEO.EQ.13 .OR. MELGEO.EQ.29 .OR.
  128. & MELGEO.EQ.30 .OR. MELGEO.EQ.31) THEN
  129. C Cas des JOINTS
  130.  
  131. IDECA=0
  132. IF(MELGEO.EQ.29) IDECA=2
  133. IF(MELGEO.EQ.30) IDECA=3
  134. IF(MELGEO.EQ.31) IDECA=4
  135. NBNOU=NBNNE(MELGEO)-IDECA
  136. NBNOV=NBNO - IDECA
  137.  
  138. LENAME = NOMCHE(ICOMP)
  139. IF(LENAME.EQ.'P '.OR.LENAME.EQ.'PQ '
  140. & .OR.LENAME.EQ.'TP ') THEN
  141. NBNOV=NBNO - IDECA
  142. DO IE=IDEB,IFIN
  143. DO IG=1,NBPGAU
  144. XVAL1=0.D0
  145. DO INBNO=1,IDECA
  146. INOE =NBNOU + INBNO
  147. INB2 =NBNOV + INBNO
  148. INOEU=IPT2.NUM(INOE,IE)
  149. IPCPR=ICPR(INOEU)
  150. XVAL1=XVAL1 + BB(IPCPR,ICOMP)*SHPTOT(1,INB2,IG)
  151. ENDDO
  152. VELCHE(IG,IE)=XVAL1
  153. ENDDO
  154. ENDDO
  155.  
  156. ELSE
  157. FAC=2.D0
  158. IF((MELGEO.EQ.12 .OR. MELGEO.EQ.13) .AND.
  159. & NBNOU .GT.NBNO) THEN
  160. NBNOU=NBNO
  161. FAC=1.D0
  162. ENDIF
  163.  
  164. DO IE=IDEB,IFIN
  165. DO IG=1,NBPGAU
  166. XVAL1=0.D0
  167. DO INOE=1,NBNOU
  168. INOEU=IPT2.NUM(INOE,IE)
  169. IPCPR=ICPR(INOEU)
  170. XVAL1=XVAL1 + BB(IPCPR,ICOMP)*SHPTOT(1,INOE,IG)
  171. ENDDO
  172. VELCHE(IG,IE)=XVAL1/FAC
  173. ENDDO
  174. ENDDO
  175. ENDIF
  176.  
  177. ELSE
  178. C Autres CAS
  179. DO IE=IDEB,IFIN
  180. DO IG=1,NBPGAU
  181. XVAL1=0.D0
  182. DO INOE=1,NBNO
  183. INOEU=IPT2.NUM(INOE,IE)
  184. IPCPR=ICPR(INOEU)
  185. XVAL1=XVAL1 + BB(IPCPR,ICOMP)*SHPTOT(1,INOE,IG)
  186. ENDDO
  187. VELCHE(IG,IE)=XVAL1
  188. ENDDO
  189. ENDDO
  190. ENDIF
  191. ENDDO
  192. ENDIF
  193.  
  194.  
  195. C cas integration dans l'epaisseur avec variable t temperature.
  196. C on transforme 'TINF' 'T' 'TSUP' en 'T' defini par une variation
  197. C parabolique dans l'epaisseur. si il n'y a que 'T' on ne fait rien.
  198. C Ce travail n'est a faire que pour les elements DKT, COQ4, COQ6 et COQ8
  199. C et uniquement si le MCHAML resultat n'est pas exprime aux noeuds !
  200. IF (ISUP1.NE.1) THEN
  201. IF ( (MELE.EQ.28.AND.NPINT.NE.0) .OR. (MELE.EQ.49) .OR.
  202. & (MELE.EQ.56) .OR. (MELE.EQ.41) ) THEN
  203. FLAG1 = .FALSE.
  204. FLAG3 = .FALSE.
  205. FLAG4 = .FALSE.
  206. DO 21 ISOU1 = 1,N2
  207. LENAME=NOMCHE(ISOU1)
  208. IF(LENAME.EQ.'T ') FLAG1 = .TRUE.
  209. IF(LENAME.EQ.'TINF ') FLAG3 = .TRUE.
  210. IF(LENAME.EQ.'TSUP ') FLAG4 = .TRUE.
  211. 21 CONTINUE
  212. IF (FLAG1.AND.FLAG3.AND.FLAG4) THEN
  213. CALL CHAME4(MCHAML,IPMINT,IPT2)
  214. ENDIF
  215. ENDIF
  216. ENDIF
  217. C
  218. 20 CONTINUE
  219. C fin de la boucle sur les zones elementaires
  220. END
  221.  
  222.  
  223.  

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