Télécharger cham12.eso

Retour à la liste

Numérotation des lignes :

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

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