Télécharger cham12.eso

Retour à la liste

Numérotation des lignes :

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

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