Télécharger cfnd.eso

Retour à la liste

Numérotation des lignes :

cfnd
  1. C CFND SOURCE CB215821 20/11/25 13:19:09 10792
  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.  
  9. -INC PPARAM
  10. -INC CCOPTIO
  11. -INC CCGEOME
  12. -INC CCHAMP
  13.  
  14. -INC SMMODEL
  15. -INC SMELEME
  16. -INC SMCHPOI
  17. -INC SMRIGID
  18.  
  19. logical ltelq
  20. * Petit tableau des "couleurs" des relations de conformite
  21. DIMENSION LCOLOR(6)
  22. DATA LCOLOR / 1, 3, 6, 10, 16, 24 /
  23.  
  24. call LIROBJ('MMODEL ',mmodel,1,iretou)
  25. call ACTOBJ('MMODEL ',mmodel,1)
  26. if(ierr.ne.0) return
  27. call LIROBJ('CHPOINT ',mchpoi,1,iretou)
  28. call ACTOBJ('CHPOINT ',mchpoi,1)
  29. if(ierr.ne.0) return
  30.  
  31. nmsous = kmodel(/1)
  32. ncofo = 0
  33. do ia = 1, nmsous
  34. imodel=kmodel(ia)
  35. if (nefmod.eq.22) ncofo = ncofo+1
  36. if (nefmod.eq.259) ncofo = ncofo+1
  37. enddo
  38. if (ncofo.eq.0) then
  39. segini,mchpo1=mchpoi
  40. irat = mchpo1
  41. goto 100
  42. endif
  43. *
  44. * il existe des relations de conformités
  45. *
  46. * verif le chpoint n'a qu'une seule zone
  47. if (ipchp(/1).ne.1) then
  48. call erreur (21)
  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).AND.(nefmod.NE.259)) goto 90
  71. ncofo = ncofo+1
  72.  
  73. ipt2=imamod
  74. nbnoe2 = ipt2.num(/1)
  75. nbele2 = ipt2.num(/2)
  76.  
  77. nbelem = nbele2
  78. segini,meleme
  79. do ib = 1, nbelem
  80. num(1,ib) = ipt2.num(2,ib)
  81. enddo
  82. IDEBUT = LCOLOR(ipt2.icolor(1)) - 3
  83.  
  84. if (ncofo.eq.1) then
  85. ipt1=meleme
  86. else
  87. call fuse (ipt1,meleme,ipt3,ltelq)
  88. ipt1=ipt3
  89. endif
  90.  
  91. C====================
  92. C *** SEGMENT XMATRI
  93. C====================
  94. NLIGRD = nbnoe2
  95. NLIGRP = nbnoe2
  96. nelrig = nbele2
  97. SEGINI XMATR6
  98. do 34 i = 1,nelrig
  99. DO 36 ICAZ = 3, nbnoe2
  100. XMATR6.RE(1,ICAZ,i) = XCOEFF(IDEBUT+ICAZ)
  101. XMATR6.RE(ICAZ,1,i) = XMATR6.RE(1,ICAZ,i)
  102. 36 CONTINUE
  103. XMATR6.RE(1,2,i)=-1.D0
  104. XMATR6.RE(2,1,i)=-1.D0
  105. 34 continue
  106. SEGDES,XMATR6
  107. C====================
  108. C *** SEGMENT DESCR
  109. C====================
  110. nomid=lnomid(1)
  111. NEXIST = 0
  112. DO 33 I=1, LNOMDD
  113. IF (NOMDD(I).EQ.nomid.lesobl(1)) NEXIST = I
  114. 33 CONTINUE
  115. IF (NEXIST.EQ.0) THEN
  116. CALL ERREUR(837)
  117. RETURN
  118. ENDIF
  119. c* NLIGRD=nbnoe2
  120. c* NLIGRP=NLIGRD
  121. SEGINI,DES1
  122. DES1.LISINC(1)='LX '
  123. DES1.LISDUA(1)='FLX '
  124. DES1.NOELEP(1)=1
  125. DES1.NOELED(1)=1
  126. DO 35 I=2,NLIGRD
  127. DES1.LISINC(I)=NOMDD(NEXIST)
  128. DES1.LISDUA(I)=NOMDU(NEXIST)
  129. DES1.NOELEP(i)=i
  130. DES1.NOELED(i)=i
  131. 35 CONTINUE
  132. SEGDES,DES1
  133. C====================
  134. C *** SEGMENT MRIGID
  135. C====================
  136. RI6.COERIG(ncofo)=1.D0
  137. RI6.IRIGEL(1,ncofo)=IPT2
  138. * RI6.IRIGEL(2,ncofo)=0
  139. RI6.IRIGEL(3,ncofo)=DES1
  140. RI6.IRIGEL(4,ncofo)=xMATR6
  141. * RI6.IRIGEL(5,ncofo)=0
  142. * RI6.IRIGEL(6,ncofo)=0
  143. * RI6.IRIGEL(7,ncofo)=0
  144. * RI6.IRIGEL(8,ncofo)=0
  145.  
  146. 90 continue
  147.  
  148. enddo
  149.  
  150. call depen3(ri6,ri1)
  151. * call prrigi(ri1,0)
  152. * write(ioimp,*) ' chpoint initial'
  153. * call ecchpo (mchpoi,0)
  154. call mucpri (mchpoi,ri1,mchpo2)
  155. * write(ioimp,*) ' chpoint apres mucpri'
  156. * call ecchpo (mchpo2,0)
  157. call reduir(mchpoi,ipt1,mchpo3)
  158. * write(ioimp,*) ' valeurs initiales à reajuster'
  159. * call ecchpo(mchpo3,0)
  160. call adchpo(mchpoi,mchpo3,mchpo4,1.d0,-1.d0)
  161. if (mchpo4.eq.0) return
  162. call adchpo(mchpo4,mchpo2,irat, 1.d0,1.d0)
  163. if (irat.eq.0) return
  164. * write(ioimp,*) ' sortie de cfnd'
  165. * call ecchpo(irat,0)
  166. segsup,ipt1
  167. segsup,ri6,ri1
  168.  
  169. 100 continue
  170.  
  171. call ACTOBJ('CHPOINT ',irat,1)
  172. call ECROBJ('CHPOINT ',irat)
  173.  
  174. end
  175.  
  176.  
  177.  
  178.  

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