Télécharger la plaquette Cast3M


fr en

Télécharger racli1.eso

Retour à la liste

Numérotation des lignes : 

racli1

  1. C RACLI1    SOURCE    GOUNAND   24/10/09    21:15:08     12031          
  2.       SUBROUTINE RACLI1(L1,IPE, NL1)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8 (A-H,O-Z)
  5. ************************************************************************
  6. *
  7. *                             R A C L I 1
  8. *                             -----------
  9. *
  10. * FONCTION:
  11. * ---------
  12. *
  13. *     CREER UNE LIGNE 'NL1' S'APPUYANT SUR LA LIGNE 'L1'
  14. *     ET FINISSANT EN UN POINT E
  15. *     L'ORIENTATION EST LIGNE-POINT
  16. *
  17. * MODULES UTILISES:
  18. * -----------------
  19. *
  20. -INC CCGEOME
  21. -INC PPARAM
  22. -INC CCREEL
  23. -INC CCOPTIO
  24. -INC SMELEME
  25. *
  26. * PARAMETRES:   (E)=ENTREE   (S)=SORTIE   (+ = CONTENU DANS UN COMMUN)
  27. * -----------
  28. *
  29. *     L1      (E)  LIGNE
  30. *     IPE     (E)  POINT
  31. *             (S)  ATTENTION: LA DENSITE DU POINT PEUT ETRE MODIFIEE
  32. *                  (EN FONCTION DE LA DENSITE SUR "L1").
  33. *     NL1     (S)  LIGNE DE RACCORDEMENT LIGNE-POINT
  34. *
  35. * CONSTANTES:
  36. * -----------
  37. *
  38.       PARAMETER (DEMI=0.5D0)
  39. *
  40. * VARIABLES:
  41. * ----------
  42. *
  43. *     NBNOEU = NOMBRE DE NOEUD
  44. *     NBELEM = NOMBRE D'ELEMENT
  45. *
  46.       INTEGER NBNOEU,NBELEM,NL,N,
  47.      &        ITYPLM,NBSOUS,NBREF,NBNN
  48. *
  49. * AUTEUR, DATE DE CREATION:
  50. * -------------------------
  51. *
  52. *     LIONEL VIVAN       23 NOVEMBRE 1987
  53. *
  54. * LANGAGE:
  55. * --------
  56. *
  57. *     ESOPE + FORTRAN77
  58. *
  59. ************************************************************************
  60. *
  61.       MELEME=L1
  62.       SEGACT,MELEME
  63.       NL=LISOUS(/1)
  64.       IF (NL.NE.0) THEN
  65.          CALL ERREUR(25)
  66.          RETURN
  67.       END IF
  68.       IF (ILCOUR.EQ.0) THEN
  69.          CALL ERREUR(16)
  70.          RETURN
  71.       END IF
  72.       ITYPLM=KDEGRE(ILCOUR)
  73.       IF (ITYPLM.EQ.0) THEN
  74.          CALL ERREUR(16)
  75.          RETURN
  76.       END IF
  77.       NBNN=NBNNE(ITYPLM)
  78.       IF (NBNN.NE.2.AND.NBNN.NE.3) THEN
  79.          CALL ERREUR(16)
  80.          RETURN
  81.       END IF
  82.       NBSOUS=0
  83.       NBREF=0
  84.       NBNOEU=NUM(/1)
  85.       NBELEM=NUM(/2)
  86.       IP8=NUM(1,NBELEM)
  87.       IP9=NUM(NBNOEU,NBELEM)
  88. *
  89.       CALL EXCOO1(IPE,XE,YE,ZE,DE)
  90.       CALL EXCOO1(IP8,X8,Y8,Z8,D8)
  91.       CALL EXCOO1(IP9,X9,Y9,Z9,D9)
  92. *      write(ioimp,*) 'XE,X8,X9=',XE,X8,X9
  93.       PS=(X9-X8)*(XE-X9)+(Y9-Y8)*(YE-Y9)+(Z9-Z8)*(ZE-Z9)
  94.       DE9=SQRT((X9-XE)**2+(Y9-YE)**2+(Z9-ZE)**2)
  95.       D98=SQRT((X8-X9)**2+(Y8-Y9)**2+(Z8-Z9)**2)
  96. *      write(ioimp,*) 'PS,DE9,D98=',PS,DE9,D98
  97.       IF (PS.GE.0.D0) THEN
  98. *
  99. *        POINT E HORS DE LA DROITE
  100. *
  101.          IF (DE9 .GT. (D98/2.D0) ) THEN
  102. *
  103. *           ON CREE UNE DROITE   NL1 = L1 + DROITE(P9,PE)
  104. *
  105.             IF (ABS(D9).LT.XPETIT) THEN
  106.                DE=D98
  107.             ELSE
  108.                DE=D9
  109.             ENDIF
  110.             CALL MODPOI (XE,YE,ZE,DE,IPE)
  111.             CALL ECROBJ('POINT',IPE)
  112.             CALL ECROBJ('MAILLAGE',L1)
  113.             CALL ECRCHA('DFIN')
  114.             CALL ECRREE(DE)
  115.             CALL LIGNE(1,1,DEN1,DEN2,N)
  116.             IF (IERR.NE.0) RETURN
  117.             CALL LIROBJ('MAILLAGE',NL1,1,IRETOU)
  118.             IF (IERR.NE.0) RETURN
  119.          ELSE
  120. *
  121. *           ON RALLONGE LE DERNIER ELEMENT
  122. *
  123.             IF (ABS(D9).LT.XPETIT) THEN
  124.                DE=D98
  125.             ELSE
  126.                DE=D9
  127.             ENDIF
  128.             CALL MODPOI (XE,YE,ZE,DE,IPE)
  129.             SEGINI,IPT1
  130.             IPT1.ITYPEL=ITYPLM
  131.             NL1=IPT1
  132.             IPT1.NUM(NBNOEU,NBELEM)=IPE
  133.             IPT1.NUM(1,NBELEM)=NUM(1,NBELEM)
  134.             IPT1.ICOLOR(NBELEM)=IDCOUL
  135.             IF (NBNOEU.EQ.3) THEN
  136.                X7=(XE+X8)*DEMI
  137.                Y7=(YE+Y8)*DEMI
  138.                Z7=(ZE+Z8)*DEMI
  139.                D7=(DE+D8)*DEMI
  140.                CALL CREPO2(X7,Y7,Z7,D7,IP7)
  141.                IPT1.NUM(2,NBELEM)=IP7
  142.             END IF
  143.             DO 12 I=1,(NBELEM-1)
  144.                IPT1.ICOLOR(I)=IDCOUL
  145.                DO 121 J=1,NBNOEU
  146.                   IPT1.NUM(J,I)=NUM(J,I)
  147.  121           CONTINUE
  148.  12         CONTINUE
  149.             SEGDES,IPT1
  150.          END IF
  151.       ELSE
  152. *
  153. *        LE POINT E SE SITUE SUR LA DROITE
  154. *
  155. *        RECHERCHE DE L'ELEMENT I OU SE TROUVE LE POINT E
  156. *
  157.  105     CONTINUE
  158.          IF (DE9.GT.D98) THEN
  159.             NBELEM=NBELEM-1
  160.             IF (NBELEM.EQ.0) THEN
  161. *     Rayon du conge trop grand
  162.                CALL ERREUR(399)
  163.                RETURN
  164.             END IF
  165.             IP9=NUM(NBNOEU,NBELEM)
  166.             IP8=NUM(1,NBELEM)
  167.             CALL EXCOO1(IP9,X9,Y9,Z9,D9)
  168.             CALL EXCOO1(IP8,X8,Y8,Z8,D8)
  169.             DE9=SQRT((X9-XE)**2+(Y9-YE)**2+(Z9-ZE)**2)
  170.             D98=SQRT((X8-X9)**2+(Y8-Y9)**2+(Z8-Z9)**2)
  171.             GOTO 105
  172.          END IF
  173.          IF (DE9 .LE. (D98/2.D0) ) THEN
  174. *
  175. *           LE POINT E  EST PROCHE DU POINT 9
  176. *
  177. *gounand            DE = D9
  178.             IF (ABS(D9).LT.XPETIT) THEN
  179.                IF (ABS(D8).LT.XPETIT) THEN
  180.                   DE=D98-DE9
  181.                ELSE
  182.                   DE=D8
  183.                ENDIF
  184.             ELSE
  185.                DE=D9
  186.             ENDIF
  187.             CALL MODPOI (XE,YE,ZE,DE,IPE)
  188.             SEGINI,IPT1
  189.             IPT1.ITYPEL=ITYPLM
  190.             NL1=IPT1
  191.             IPT1.NUM(NBNOEU,NBELEM)=IPE
  192.             IPT1.NUM(1,NBELEM)=NUM(1,NBELEM)
  193.             IPT1.ICOLOR(NBELEM)=IDCOUL
  194.             IF (NBNOEU.EQ.3) THEN
  195.                X7=(X8+XE)*DEMI
  196.                Y7=(Y8+YE)*DEMI
  197.                Z7=(Z8+ZE)*DEMI
  198.                D7=(D8+DE)*DEMI
  199.                CALL CREPO2(X7,Y7,Z7,D7,IP7)
  200.                IPT1.NUM(2,NBELEM)=IP7
  201.             END IF
  202.             DO 22 I=1,(NBELEM-1)
  203.                IPT1.ICOLOR(I)=IDCOUL
  204.                DO 221 J=1,NBNOEU
  205.                   IPT1.NUM(J,I)=NUM(J,I)
  206.  221           CONTINUE
  207.  22         CONTINUE
  208.             SEGDES,IPT1
  209.          ELSE
  210. *
  211. *           LE POINT E  EST PROCHE DU POINT 8
  212. *
  213.             NBELEM = NBELEM - 1
  214.             IF (NBELEM.LE.0) THEN
  215. *              RAYON TROP GRAND
  216.                CALL ERREUR(399)
  217.                RETURN
  218.             END IF
  219. *
  220. * gounand            DE = D8
  221.             IF (ABS(D8).LT.XPETIT) THEN
  222.                DE=D98-DE9
  223.             ELSE
  224.                DE=D8
  225.             ENDIF
  226. *
  227.             CALL MODPOI (XE,YE,ZE,DE,IPE)
  228.             SEGINI,IPT1
  229.             IPT1.ITYPEL=ITYPLM
  230.             NL1=IPT1
  231.             IPT1.NUM(NBNOEU,NBELEM)=IPE
  232.             IPT1.NUM(1,NBELEM)=NUM(1,NBELEM)
  233.             IPT1.ICOLOR(NBELEM)=IDCOUL
  234.             IF (NBNOEU.EQ.3) THEN
  235.                IP6=NUM(1,NBELEM)
  236.                CALL EXCOO1(IP6,X6,Y6,Z6,D6)
  237.                X7=(XE+X6)*DEMI
  238.                Y7=(YE+Y6)*DEMI
  239.                Z7=(ZE+Z6)*DEMI
  240.                D7=(DE+D6)*DEMI
  241.                CALL CREPO2(X7,Y7,Z7,D7,IP7)
  242.                IPT1.NUM(2,NBELEM)=IP7
  243.             END IF
  244.             DO 32 I=1,(NBELEM-1)
  245.                IPT1.ICOLOR(I)=IDCOUL
  246.                DO 321 J=1,NBNOEU
  247.                   IPT1.NUM(J,I)=NUM(J,I)
  248.  321           CONTINUE
  249.  32         CONTINUE
  250.             SEGDES,IPT1
  251.          END IF
  252.       END IF
  253.       SEGDES,MELEME
  254. *
  255.       END
  256.  
  257.  

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