Télécharger cfnd.eso

Retour à la liste

Numérotation des lignes :

  1. C CFND SOURCE BP208322 16/11/18 21:15:27 9177
  2. subroutine cfnd
  3.  
  4. implicit real*8(a-h,o-z)
  5. implicit integer (i-n)
  6. * rendre un chpoint compatible avec des relations de conformités
  7.  
  8. -INC CCOPTIO
  9. -INC CCGEOME
  10. -INC CCHAMP
  11.  
  12. -INC SMMODEL
  13. -INC SMELEME
  14. -INC SMCHPOI
  15. -INC SMRIGID
  16.  
  17. logical ltelq
  18. * Petit tableau des "couleurs" des relations de conformite
  19. DIMENSION LCOLOR(6)
  20. DATA LCOLOR / 1, 3, 6, 10, 16, 24 /
  21.  
  22. call lirobj('MMODEL ',mmodel,1,iretou)
  23. if(ierr.ne.0) return
  24. call lirobj('CHPOINT ',mchpoi,1,iretou)
  25. if(ierr.ne.0) return
  26.  
  27. segact,mmodel
  28. nmsous = kmodel(/1)
  29. ncofo = 0
  30. do ia = 1, nmsous
  31. imodel=kmodel(ia)
  32. segact imodel
  33. if (nefmod.eq.22) ncofo = ncofo+1
  34. enddo
  35. if (ncofo.eq.0) then
  36. segini,mchpo1=mchpoi
  37. segdes,mchpo1
  38. irat = mchpo1
  39. goto 100
  40. endif
  41. *
  42. * il existe des relations de conformités
  43. *
  44. * verif le chpoint n'a qu'une seule zone
  45. segact,mchpoi
  46. if (ipchp(/1).ne.1) then
  47. call erreur (21)
  48. segdes,mchpoi
  49. return
  50. endif
  51. *
  52. * on fabrique les matrices de liaisons et un maillage contenant
  53. * les noeuds dépendants
  54. nrigel = ncofo
  55. segini,RI6
  56. RI6.ICHOLE=0
  57. RI6.IMGEO1=0
  58. RI6.IMGEO2=0
  59. RI6.IFORIG=0
  60. RI6.ISUPEQ=0
  61.  
  62. nbnn = 1
  63. nbsous = 0
  64. nbref = 0
  65. ltelq=.false.
  66.  
  67. ncofo = 0
  68. do ia = 1, nmsous
  69. imodel=kmodel(ia)
  70. if (nefmod.ne.22) goto 90
  71. ncofo = ncofo+1
  72.  
  73. ipt2=imamod
  74. SEGACT IPT2
  75. nbnoe2 = ipt2.num(/1)
  76. nbele2 = ipt2.num(/2)
  77.  
  78. nbelem = nbele2
  79. segini,meleme
  80. do ib = 1, nbelem
  81. num(1,ib) = ipt2.num(2,ib)
  82. enddo
  83. IDEBUT = LCOLOR(ipt2.icolor(1)) - 3
  84. segdes,ipt2
  85.  
  86. if (ncofo.eq.1) then
  87. ipt1=meleme
  88. segdes,meleme
  89. else
  90. call fuse (ipt1,meleme,ipt3,ltelq)
  91. ipt1=ipt3
  92. endif
  93.  
  94. C====================
  95. C *** SEGMENT XMATRI
  96. C====================
  97. NLIGRD = nbnoe2
  98. NLIGRP = nbnoe2
  99. nelrig = nbele2
  100. SEGINI XMATR6
  101. do 34 i = 1,nelrig
  102. DO 36 ICAZ = 3, nbnoe2
  103. XMATR6.RE(1,ICAZ,i) = XCOEFF(IDEBUT+ICAZ)
  104. XMATR6.RE(ICAZ,1,i) = XMATR6.RE(1,ICAZ,i)
  105. 36 CONTINUE
  106. XMATR6.RE(1,2,i)=-1.D0
  107. XMATR6.RE(2,1,i)=-1.D0
  108. 34 continue
  109. SEGDES,XMATR6
  110. C====================
  111. C *** SEGMENT DESCR
  112. C====================
  113. nomid=lnomid(1)
  114. segact,nomid
  115. NEXIST = 0
  116. DO 33 I=1, LNOMDD
  117. IF (NOMDD(I).EQ.nomid.lesobl(1)) NEXIST = I
  118. 33 CONTINUE
  119. segdes,nomid
  120. IF (NEXIST.EQ.0) THEN
  121. CALL ERREUR(837)
  122. RETURN
  123. ENDIF
  124. c* NLIGRD=nbnoe2
  125. c* NLIGRP=NLIGRD
  126. SEGINI,DES1
  127. DES1.LISINC(1)='LX '
  128. DES1.LISDUA(1)='FLX '
  129. DES1.NOELEP(1)=1
  130. DES1.NOELED(1)=1
  131. DO 35 I=2,NLIGRD
  132. DES1.LISINC(I)=NOMDD(NEXIST)
  133. DES1.LISDUA(I)=NOMDU(NEXIST)
  134. DES1.NOELEP(i)=i
  135. DES1.NOELED(i)=i
  136. 35 CONTINUE
  137. SEGDES,DES1
  138. C====================
  139. C *** SEGMENT MRIGID
  140. C====================
  141. RI6.COERIG(ncofo)=1.D0
  142. RI6.IRIGEL(1,ncofo)=IPT2
  143. * RI6.IRIGEL(2,ncofo)=0
  144. RI6.IRIGEL(3,ncofo)=DES1
  145. RI6.IRIGEL(4,ncofo)=xMATR6
  146. * RI6.IRIGEL(5,ncofo)=0
  147. * RI6.IRIGEL(6,ncofo)=0
  148. * RI6.IRIGEL(7,ncofo)=0
  149. * RI6.IRIGEL(8,ncofo)=0
  150.  
  151. 90 continue
  152. segdes,imodel
  153.  
  154. enddo
  155.  
  156. call depen3(ri6,ri1)
  157. * call prrigi(ri1,0)
  158. * write(ioimp,*) ' chpoint initial'
  159. * call ecchpo (mchpoi,0)
  160. call mucpri (mchpoi,ri1,mchpo2)
  161. * write(ioimp,*) ' chpoint apres mucpri'
  162. * call ecchpo (mchpo2,0)
  163. call reduir(mchpoi,ipt1,mchpo3)
  164. * write(ioimp,*) ' valeurs initiales à reajuster'
  165. * call ecchpo(mchpo3,0)
  166. call adchpo(mchpoi,mchpo3,mchpo4,1.d0,-1.d0)
  167. if (mchpo4.eq.0) return
  168. call adchpo(mchpo4,mchpo2,irat, 1.d0,1.d0)
  169. if (irat.eq.0) return
  170. * write(ioimp,*) ' sortie de cfnd'
  171. * call ecchpo(irat,0)
  172. segsup,ipt1
  173. segsup,ri6,ri1
  174.  
  175. 100 continue
  176. segdes,mmodel
  177. call ecrobj('CHPOINT',irat)
  178.  
  179. return
  180. end
  181.  
  182.  
  183.  
  184.  
  185.  
  186.  

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