Télécharger cfnd.eso

Retour à la liste

Numérotation des lignes :

cfnd
  1. C CFND SOURCE FANDEUR 22/01/03 21:15:04 11237
  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. c* RI6.IFORIG=0
  60. c* RI6.IFORIG=IFOUR
  61. RI6.IFORIG=mchpoi.ifopoi
  62. RI6.ISUPEQ=0
  63.  
  64. nbnn = 1
  65. nbsous = 0
  66. nbref = 0
  67. ltelq=.false.
  68.  
  69. ncofo = 0
  70. do ia = 1, nmsous
  71. imodel=kmodel(ia)
  72. if ((nefmod.ne.22).AND.(nefmod.NE.259)) goto 90
  73. ncofo = ncofo+1
  74.  
  75. ipt2=imamod
  76. nbnoe2 = ipt2.num(/1)
  77. nbele2 = ipt2.num(/2)
  78.  
  79. nbelem = nbele2
  80. segini,meleme
  81. do ib = 1, nbelem
  82. num(1,ib) = ipt2.num(2,ib)
  83. enddo
  84. IDEBUT = LCOLOR(ipt2.icolor(1)) - 3
  85.  
  86. if (ncofo.eq.1) then
  87. ipt1=meleme
  88. else
  89. call fuse (ipt1,meleme,ipt3,ltelq)
  90. ipt1=ipt3
  91. endif
  92.  
  93. C====================
  94. C *** SEGMENT XMATRI
  95. C====================
  96. NLIGRD = nbnoe2
  97. NLIGRP = nbnoe2
  98. nelrig = nbele2
  99. SEGINI XMATR6
  100. do 34 i = 1,nelrig
  101. DO 36 ICAZ = 3, nbnoe2
  102. XMATR6.RE(1,ICAZ,i) = XCOEFF(IDEBUT+ICAZ)
  103. XMATR6.RE(ICAZ,1,i) = XMATR6.RE(1,ICAZ,i)
  104. 36 CONTINUE
  105. XMATR6.RE(1,2,i)=-1.D0
  106. XMATR6.RE(2,1,i)=-1.D0
  107. 34 continue
  108. SEGDES,XMATR6
  109. C====================
  110. C *** SEGMENT DESCR
  111. C====================
  112. nomid=lnomid(1)
  113. NEXIST = 0
  114. DO 33 I=1, LNOMDD
  115. IF (NOMDD(I).EQ.nomid.lesobl(1)) NEXIST = I
  116. 33 CONTINUE
  117. IF (NEXIST.EQ.0) THEN
  118. CALL ERREUR(837)
  119. RETURN
  120. ENDIF
  121. c* NLIGRD=nbnoe2
  122. c* NLIGRP=NLIGRD
  123. SEGINI,DES1
  124. DES1.LISINC(1)='LX '
  125. DES1.LISDUA(1)='FLX '
  126. DES1.NOELEP(1)=1
  127. DES1.NOELED(1)=1
  128. DO 35 I=2,NLIGRD
  129. DES1.LISINC(I)=NOMDD(NEXIST)
  130. DES1.LISDUA(I)=NOMDU(NEXIST)
  131. DES1.NOELEP(i)=i
  132. DES1.NOELED(i)=i
  133. 35 CONTINUE
  134. SEGDES,DES1
  135. C====================
  136. C *** SEGMENT MRIGID
  137. C====================
  138. RI6.COERIG(ncofo)=1.D0
  139. RI6.IRIGEL(1,ncofo)=IPT2
  140. * RI6.IRIGEL(2,ncofo)=0
  141. RI6.IRIGEL(3,ncofo)=DES1
  142. RI6.IRIGEL(4,ncofo)=xMATR6
  143. * RI6.IRIGEL(5,ncofo)=0
  144. * RI6.IRIGEL(6,ncofo)=0
  145. * RI6.IRIGEL(7,ncofo)=0
  146. * RI6.IRIGEL(8,ncofo)=0
  147.  
  148. 90 continue
  149.  
  150. enddo
  151.  
  152. call depen3(ri6,ri1)
  153. * call prrigi(ri1,0)
  154. * write(ioimp,*) ' chpoint initial'
  155. * call ecchpo (mchpoi,0)
  156. call mucpri (mchpoi,ri1,mchpo2)
  157. * write(ioimp,*) ' chpoint apres mucpri'
  158. * call ecchpo (mchpo2,0)
  159. call reduir(mchpoi,ipt1,mchpo3)
  160. * write(ioimp,*) ' valeurs initiales à reajuster'
  161. * call ecchpo(mchpo3,0)
  162. call adchpo(mchpoi,mchpo3,mchpo4,1.d0,-1.d0)
  163. if (mchpo4.eq.0) return
  164. call adchpo(mchpo4,mchpo2,irat, 1.d0,1.d0)
  165. if (irat.eq.0) return
  166. * write(ioimp,*) ' sortie de cfnd'
  167. * call ecchpo(irat,0)
  168. segsup,ipt1
  169. segsup,ri6,ri1
  170.  
  171. 100 continue
  172.  
  173. call ACTOBJ('CHPOINT ',irat,1)
  174. call ECROBJ('CHPOINT ',irat)
  175.  
  176. end
  177.  
  178.  
  179.  

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