Télécharger blopha.eso

Retour à la liste

Numérotation des lignes :

blopha
  1. C BLOPHA SOURCE CB215821 24/04/12 21:15:06 11897
  2. SUBROUTINE BLOPHA
  3.  
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6.  
  7. * +------------------------------------------------------------------------+
  8. * | création des matrices de bloquage pour le modele CHANGEMENT_PHASE |
  9. * | RIGIDITE sont de type 2 avec des 'FLX' a mettre en face |
  10. * +------------------------------------------------------------------------+
  11.  
  12.  
  13. -INC PPARAM
  14. -INC CCOPTIO
  15. -INC SMELEME
  16. -INC SMMODEL
  17. -INC SMRIGID
  18. -INC SMCOORD
  19. -INC SMCHPOI
  20. -INC SMCHAML
  21.  
  22. * +------------------------------------------------------------------------+
  23. call LIROBJ('MMODEL ',mmodel,1,iretou)
  24. call ACTOBJ('MMODEL ',mmodel,1)
  25. if(ierr.ne.0) return
  26. nbsou =kmodel(/1)
  27. nrigel=0
  28. do 100 i=1,nbsou
  29. imodel=kmodel(i)
  30.  
  31. nfor=imodel.formod(/2)
  32. call place(imodel.formod,nfor,iplac,'CHANGEMENT_PHASE')
  33. if (iplac .eq. 0) goto 100
  34.  
  35. C RAPPEL : RESO suppose un seul 'LX' par rigidite et il doit etre en premier
  36. IF (imodel.matmod(1)(1:10) .EQ. 'PARFAIT ')THEN
  37. C 1 seule RIGIDITE suffit
  38. nrigel = nrigel + 1
  39. ELSEIF(imodel.matmod(1)(1:10) .EQ. 'SOLUBILITE')THEN
  40. C 2 RIGIDITES pour les besoins de RESO
  41. nrigel = nrigel + 2
  42. ELSE
  43. CALL ERREUR(5)
  44. ENDIF
  45. 100 continue
  46.  
  47. segini,mrigid
  48. mtymat='BLO_PHAS'
  49. iforig = ifour
  50.  
  51. * Boucle sur les sous zones du model pour creer les matrices de blocages
  52. nrigel = 0
  53. do 1 i=1,nbsou
  54. imodel=kmodel(i)
  55.  
  56. nfor=imodel.formod(/2)
  57. call place(imodel.formod,nfor,iplac,'CHANGEMENT_PHASE')
  58. if (iplac .eq. 0) goto 1
  59.  
  60. IF (imodel.matmod(1)(1:10) .EQ. 'PARFAIT ')THEN
  61. ICAS = 1
  62. IF(tymode(2) .NE. 'MAILLAGE')THEN
  63. CALL ERREUR(5)
  64. ENDIF
  65. ipt2 = ivamod(2)
  66.  
  67. ELSEIF(imodel.matmod(1)(1:10) .EQ. 'SOLUBILITE')THEN
  68. ICAS = 2
  69. DO ii=1,imodel.tymode(/2) - 1
  70. IF(imodel.tymode(ii+1) .NE. 'MAILLAGE')THEN
  71. CALL ERREUR(5)
  72. ENDIF
  73. ENDDO
  74. ipt2 = ivamod(2)
  75. ipt3 = ivamod(3)
  76.  
  77. ELSE
  78. CALL ERREUR(5)
  79. ENDIF
  80.  
  81. C Remplissage des objets rigidite
  82. IF (ICAS .EQ. 1)THEN
  83. nrigel = nrigel + 1
  84. nelrig = ipt2.num(/2)
  85. nligrp = 2
  86. nligrd = 2
  87. segini,descr,xmatri
  88.  
  89. coerig(nrigel) = 1.D0
  90. irigel(1,nrigel)= ipt2
  91. irigel(3,nrigel)= descr
  92. irigel(4,nrigel)= xmatri
  93. irigel(5,nrigel)= nifour
  94. irigel(6,nrigel)= 2
  95. isym = 0
  96. irigel(7,nrigel)= isym
  97. xmatri.SYMRE = isym
  98.  
  99. NOMID=lnomid(1)
  100. lisinc(1)='LX'
  101. lisinc(2)= nomid.lesobl(1)
  102.  
  103. NOMID=lnomid(2)
  104. lisdua(1)='FLX'
  105. lisdua(2)= nomid.lesobl(1)
  106.  
  107. noelep(1)=1
  108. noelep(2)=2
  109. noeled(1)=1
  110. noeled(2)=2
  111.  
  112. do iou=1,nelrig
  113. re(1,1,iou)= 0.D0
  114. re(2,1,iou)= 1.D0
  115.  
  116. re(1,2,iou)= 1.D0
  117. re(2,2,iou)= 0.D0
  118. enddo
  119. segdes,descr,xmatri
  120.  
  121. ELSEIF(ICAS .EQ. 2)THEN
  122. C RIGIDITE n° 1
  123. C -------------
  124. nrigel = nrigel + 1
  125. nelrig = ipt2.num(/2)
  126. nligrp = 3
  127. nligrd = 3
  128. segini,descr,xmatri
  129. coerig(nrigel) = 1.D0
  130. irigel(1,nrigel)= ipt2
  131. irigel(3,nrigel)= descr
  132. irigel(4,nrigel)= xmatri
  133. irigel(5,nrigel)= nifour
  134. irigel(6,nrigel)= 1
  135. isym = 2
  136. irigel(7,nrigel)= isym
  137. xmatri.SYMRE = isym
  138.  
  139. NOMID = lnomid(1)
  140. lisinc(1)='LX'
  141. lisinc(2)= nomid.lesobl(1)
  142. lisinc(3)= nomid.lesobl(2)
  143.  
  144. NOMID = lnomid(2)
  145. lisdua(1)='FLX'
  146. lisdua(2)= nomid.lesobl(1)
  147. lisdua(3)= nomid.lesobl(2)
  148.  
  149. DO iel=1,nligrp
  150. noelep(iel)=iel
  151. noeled(iel)=iel
  152. ENDDO
  153.  
  154. do iou=1,nelrig
  155. re(1,1,iou)= 0.D0
  156. re(2,1,iou)= 1.D0
  157. re(3,1,iou)=-1.D0
  158.  
  159. re(1,2,iou)= 1.D0
  160. re(2,2,iou)= 0.D0
  161. re(3,2,iou)= 0.D0
  162.  
  163. re(1,3,iou)= 0.D0
  164. re(2,3,iou)= 0.D0
  165. re(3,3,iou)= 0.D0
  166. enddo
  167. segdes,descr,xmatri
  168.  
  169. C RIGIDITE n° 2
  170. C -------------
  171. nrigel = nrigel + 1
  172. nelrig2 = ipt3.num(/2)
  173. IF(nelrig2 .NE. nelrig)THEN
  174. CALL ERREUR(5)
  175. ENDIF
  176. nelrig = nelrig2
  177. nligrp = 3
  178. nligrd = 3
  179. segini,descr,xmatri
  180.  
  181. coerig(nrigel) = 1.D0
  182. irigel(1,nrigel)= ipt3
  183. irigel(3,nrigel)= descr
  184. irigel(4,nrigel)= xmatri
  185. irigel(5,nrigel)= nifour
  186. irigel(6,nrigel)=-1
  187. isym = 2
  188. irigel(7,nrigel)= isym
  189. xmatri.SYMRE = isym
  190.  
  191. NOMID = lnomid(1)
  192. lisinc(1)='LX'
  193. lisinc(2)= nomid.lesobl(1)
  194. lisinc(3)= nomid.lesobl(2)
  195.  
  196. NOMID = lnomid(2)
  197. lisdua(1)='FLX'
  198. lisdua(2)= nomid.lesobl(1)
  199. lisdua(3)= nomid.lesobl(2)
  200.  
  201. DO iel=1,nligrp
  202. noelep(iel)=iel
  203. noeled(iel)=iel
  204. ENDDO
  205.  
  206. do iou=1,nelrig
  207. re(1,1,iou)= 0.D0
  208. re(2,1,iou)=-1.D0
  209. re(3,1,iou)= 1.D0
  210.  
  211. re(1,2,iou)= 0.D0
  212. re(2,2,iou)= 0.D0
  213. re(3,2,iou)= 0.D0
  214.  
  215. re(1,3,iou)= 1.D0
  216. re(2,3,iou)= 0.D0
  217. re(3,3,iou)= 0.D0
  218. enddo
  219. segdes,descr,xmatri
  220.  
  221. ELSE
  222. CALL ERREUR(5)
  223. ENDIF
  224. 1 continue
  225. segdes,mrigid
  226.  
  227. call ECROBJ('RIGIDITE',mrigid)
  228.  
  229. end
  230.  
  231.  
  232.  
  233.  

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