Télécharger la plaquette Cast3M


fr en

Télécharger cfnd.eso

Retour à la liste

Numérotation des lignes : 

cfnd

  1. C CFND      SOURCE    CB215821  24/04/12    21:15:12     11897          
  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.  
  180.  

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