Télécharger noajar.eso

Retour à la liste

Numérotation des lignes :

  1. C NOAJAR SOURCE CHAT 06/03/29 21:28:07 5360
  2. C
  3. C
  4. SUBROUTINE NOAJAR(NUMSO,IEL,NBS,NUMNO,NBNO,
  5. > ICODE,IDE,ITRNO2,NBNMX2,NBE2,
  6. > ITRNOE,NBNMAX,ITRTRI,NBCMAX,
  7. > ITVL,NITMAX,iarr)
  8. C *****************************************************************
  9. C OBJET NOAJAR : AJOUTE DES NOEUDS SUR UNE ARETE
  10. C
  11. C EN ENTREE :
  12. C ---------- NOEUD A AJOUTER -----------------------
  13. C NUMSO(1): SOMMET ORIGINE DE L'ARETE
  14. C NUMSO(2): SOMMET EXTREMITE DE L'ARETE
  15. C IEL : UN ELEMENT INCIDENT A NUMSO1 ET/OU NUMSO2
  16. C NBS : NOMBRE DE SOMMET QUE IEL CONTIENT (1 OU 2)
  17. C NUMNO : LES NUMEROS DES NOEUDS A AJOUTER
  18. C NBNO : LE NOMBRE DE NOEUD A AJOUTER
  19. C ---------- LE MAILLAGE A REMPLIR -----------------------
  20. C ICODE : CODE DES ELEMENTS DE ITRNO2
  21. C ITRNO2 : NOEUDS DES ELEMENTS (A REMPLIR)
  22. C NBNMX2 : NOMBRE DE NOEUDS D'UN ELEMENT
  23. C NBE2 : NOMBRE D'ELEMENTS
  24. C ---------- LE MAILLAGE SANS NOEUDS ---------------------
  25. C ITRNOE : IDEM ITRNO2 (SANS NOEUDS MILIEU)
  26. C ITRTRI : TABLEAU DES ELEMENTS VOISINS
  27. C NBNMAX : NOMBRE DE NOEUDS D'UN ELEMENT
  28. C NBE : NOMBRE D'ELEMENTS = NBE2
  29. C ----------TABLEAU DE TRAVAIL ---------------------------
  30. C ITVL : TABLEAU D'ENTIERS
  31. C NITMAX : TAILLE DE ITVL
  32. C
  33. C EN SORTIE :
  34. C ITRNO2 : NOEUDS DES ELEMENTS AVEC NOEUDS MILIEU
  35. C iarr : CODE D'ERREUR
  36. C *****************************************************************
  37. IMPLICIT INTEGER(I-N)
  38. INTEGER NUMSO(*),IEL,NBS,NUMNO(*),NBNO
  39. INTEGER ICODE,IDE,ITRNO2(*),NBNMX2,NBE2
  40. INTEGER ITRNOE(*),NBNMAX,ITRTRI(*),NBCMAX
  41. INTEGER ITVL(*),NITMAX
  42. INTEGER iarr
  43. C
  44. INTEGER NBNAR
  45. INTEGER NBNOCO,NBCONN
  46. INTEGER IEL2,INDSO2(2),INO,INDNO(1),I,NBNO2
  47. C
  48. C ==================================
  49. C ---- RECHERCHE DES ARETES DANS ITRNOE ----
  50. C ==================================
  51. NBNAR = 2
  52. CALL TTCONN(NBNAR,NUMSO,IEL,NBS,ITRNOE,NBNMAX,ITRTRI,NBCMAX,
  53. > ITVL,NBCONN,NITMAX,NBNOCO,iarr)
  54. IF( NBNOCO.LT.NBNAR )THEN
  55. iarr = -1
  56. CALL DSERRE(1,iarr,'NOAJAR ',' APPEL TTCON')
  57. C PRINT *,' ON A PERDU L ARETE : ',(NUMSO(INO),INO=1,NBNAR)
  58. C PRINT *,' NBNOCO = : ',NBNOCO
  59. C PRINT *,' NBCONN = : ',NBCONN
  60. C PRINT *,' NITMAX = : ',NITMAX
  61. C PRINT *,' iarr = : ',iarr
  62. GOTO 9999
  63. ENDIF
  64. C PRINT *,NBCONN,' ELEMENT(S) SUR L ARETE (',
  65. C > NUMSO(1),NUMSO(2),') = ',
  66. C > (ITVL(INO),INO=1,NBCONN)
  67. C
  68. DO 100 I=1,NBCONN
  69. C
  70. C ---- POUR CHAQUE ELEMENT IL FAUT RETROUVER L'INDICE DU NOEUD ----
  71. C
  72. IEL2 = ITVL(I)
  73. C ---- NUMERO ABSOLU DANS ITRNO2 ------
  74. INDSO2(1) = 0
  75. INDSO2(2) = 0
  76. DO 20 INO=1,NBNMX2
  77. IF( ITRNO2((IEL2-1)*NBNMX2+INO).EQ.NUMSO(1))
  78. > INDSO2(1) = INO
  79. IF( ITRNO2((IEL2-1)*NBNMX2+INO).EQ.NUMSO(2))
  80. > INDSO2(2) = INO
  81. 20 CONTINUE
  82. C ---- NUMERO RELATIFS ------
  83. CALL ELSNAR(ICODE,INDSO2,INDNO,NBNO2,iarr)
  84. IF((INDNO(1).GT.20).OR.(INDNO(1).LT.1))THEN
  85. iarr = -1
  86. CALL DSERRE(1,iarr,'NOAJAR ',' APPEL ELSNAR')
  87. C PRINT *,'INDSO2,INDNO ',INDSO2(1),INDSO2(2),INDNO(1)
  88. GOTO 9999
  89. ENDIF
  90. IF( iarr.NE.0 )THEN
  91. CALL DSERRE(1,iarr,'NOAJAR ',' APPEL ELSNAR')
  92. GOTO 9999
  93. ENDIF
  94. IF( NBNO.NE.NBNO2 )THEN
  95. iarr = -1
  96. C PRINT *,'NBNO != NBNO2 ',NBNO,NBNO2
  97. CALL DSERRE(1,iarr,'NOAJAR ',' NOMBRE DE NOEUD SUR L ARETE')
  98. GOTO 9999
  99. ENDIF
  100. DO 30 INO=1,NBNO2
  101. C PRINT *,'ON AJOUTE LE NOEUD ',NUMNO(INO),
  102. C > ' A L ELEMENT ',IEL2,
  103. C > ' EN POSITION : ',INDNO(INO)
  104. ITRNO2((IEL2-1)*NBNMX2+INDNO(INO)) = NUMNO(INO)
  105. 30 CONTINUE
  106. 100 CONTINUE
  107. C
  108. 9999 END
  109.  
  110.  
  111.  
  112.  

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