Esope source files

   1 : C BCIRCO    SOURCE    SH236661  13/11/25    21:15:00     7869           
   2 :       SUBROUTINE BCIRCO(IRN1,IPT0,JEL,XC,XR)
   3 : C---------------------------------------------------------------------C
   4 : C     BCIRCO renvoie les coordonnees du centre et le rayon de la      C
   5 : C     boule circonscrite a l'element JEL du MELEME IPT0.              C
   6 : C                                                                     C
   7 : C     IPT0 : pointeur de type MELEME actif en entree et en sortie     C
   8 : C     JEL  : numero de l'element de IPT0 dont on cherche le centre et C
   9 : C            le rayon de la boule circonscrite                        C
  10 : C     XC   : vecteur de dimension IDIM contenant les coordonnees du   C
  11 : C            centre de la boule circonscrite                          C
  12 : C     XR   : rayon de la boule circonscrite                           C
  13 : C---------------------------------------------------------------------C
  14 :       IMPLICIT INTEGER(I-N)
  15 :       IMPLICIT REAL*8 (A-H,O-Z)
  16 : c
  17 : -INC CCOPTIO
  18 : -INC SMELEME
  19 : -INC SMCOORD
  20 : -INC CCGEOME
  21 :       DIMENSION XC(3),XPTS(4,3),A(3,3),B(3,1),BB(4),XM(4,3)
  22 : C
  23 :       DIMENSION RPTS(4),XPTS1(3),YPTS1(3),ZPTS1(3),W(3)
  24 : 
  25 :       SEGMENT RAYONOE
  26 :          REAL*8 RAYN(NBNER)
  27 :       ENDSEGMENT
  28 :       POINTEUR IRN1.RAYONOE
  29 : 
  30 : 
  31 :       IDIMP1=IDIM+1
  32 :       IPT1=IPT0
  33 : c
  34 :       DO I=1,IDIMP1
  35 :           RPTS(I)=IRN1.RAYN(IPT1.NUM(I,JEL))
  36 :       END DO
  37 : C
  38 :       IF (IDIM.EQ.3) THEN
  39 :          IREF1=(IPT1.NUM(1,JEL)-1)*IDIMP1
  40 :          IREF2=(IPT1.NUM(2,JEL)-1)*IDIMP1
  41 :          IREF3=(IPT1.NUM(3,JEL)-1)*IDIMP1
  42 :          IREF4=(IPT1.NUM(4,JEL)-1)*IDIMP1
  43 :          XPTS(1,1)=XCOOR(IREF1+1)
  44 :          XPTS(1,2)=XCOOR(IREF1+2)
  45 :          XPTS(1,3)=XCOOR(IREF1+3)
  46 :          XPTS(2,1)=XCOOR(IREF2+1)
  47 :          XPTS(2,2)=XCOOR(IREF2+2)
  48 :          XPTS(2,3)=XCOOR(IREF2+3)
  49 :          XPTS(3,1)=XCOOR(IREF3+1)
  50 :          XPTS(3,2)=XCOOR(IREF3+2)
  51 :          XPTS(3,3)=XCOOR(IREF3+3)
  52 :          XPTS(4,1)=XCOOR(IREF4+1)
  53 :          XPTS(4,2)=XCOOR(IREF4+2)
  54 :          XPTS(4,3)=XCOOR(IREF4+3)
  55 : C
  56 :          DO i=1,3
  57 :          W(i)= (RPTS(1)*RPTS(1))-(RPTS(i+1)*RPTS(i+1))        
  58 :      &       +(XPTS(i+1,1)*XPTS(i+1,1))+(XPTS(i+1,2)*XPTS(i+1,2))
  59 :      &       +(XPTS(i+1,3)*XPTS(i+1,3))-(XPTS(1,1)*XPTS(1,1))
  60 :      &       -(XPTS(1,2)*XPTS(1,2))-(XPTS(1,3)*XPTS(1,3))
  61 :          W(i)=0.5*W(i)
  62 :          END DO
  63 : 
  64 :          A(1,1)=XPTS(2,1)-XPTS(1,1)
  65 :          A(1,2)=XPTS(2,2)-XPTS(1,2)
  66 :          A(1,3)=XPTS(2,3)-XPTS(1,3)
  67 :          A(2,1)=XPTS(3,1)-XPTS(1,1)
  68 :          A(2,2)=XPTS(3,2)-XPTS(1,2)
  69 :          A(2,3)=XPTS(3,3)-XPTS(1,3)
  70 :          A(3,1)=XPTS(4,1)-XPTS(1,1)
  71 :          A(3,2)=XPTS(4,2)-XPTS(1,2)
  72 :          A(3,3)=XPTS(4,3)-XPTS(1,3)
  73 :          B(1,1)=W(1)
  74 :          B(2,1)=W(2)
  75 :          B(3,1)=W(3)
  76 : C
  77 : c
  78 : 
  78 :          CALL GAUSSK(A,3,3,B,1,1)
  79 : C
  80 :          IF (IERR.NE.0) then
  81 :             WRITE(6,*) 'il y a une erreur dans bcirco'
  82 :             RETURN
  83 :          endif
  84 : C
  85 :          XC(1)=B(1,1)
  86 :          XC(2)=B(2,1)
  87 :          XC(3)=B(3,1)
  88 : C
  89 :          XR=(XC(1)-XPTS(1,1))*(XC(1)-XPTS(1,1))
  90 :      &      +(XC(2)-XPTS(1,2))*(XC(2)-XPTS(1,2))
  91 :      &      +(XC(3)-XPTS(1,3))*(XC(3)-XPTS(1,3))
  92 :      &      - ((RPTS(1))*(RPTS(1)))
  93 : c
  94 :          XR = XR**0.5
  95 : c   
  96 : C
  97 :       ELSEIF (IDIM.EQ.2) THEN
  98 :          IREF1=(IPT1.NUM(1,JEL)-1)*IDIMP1
  99 :          IREF2=(IPT1.NUM(2,JEL)-1)*IDIMP1
 100 :          IREF3=(IPT1.NUM(3,JEL)-1)*IDIMP1
 101 :          XPTS(1,1)=XCOOR(IREF1+1)
 102 :          XPTS(1,2)=XCOOR(IREF1+2)
 103 :          XPTS(2,1)=XCOOR(IREF2+1)
 104 :          XPTS(2,2)=XCOOR(IREF2+2)
 105 :          XPTS(3,1)=XCOOR(IREF3+1)
 106 :          XPTS(3,2)=XCOOR(IREF3+2)
 107 : C
 108 :          DO i=1,2
 109 :          W(i)= ((RPTS(1))**2)-((RPTS(i+1))**2)        
 110 :      &       +((XPTS(i+1,1))**2)+((XPTS(i+1,2))**2)
 111 :      &       -((XPTS(1,1))**2)-((XPTS(1,2))**2)
 112 :          W(i)=0.5*W(i)
 113 :          END DO
 114 : c
 115 :          A(1,1)=XPTS(2,1)-XPTS(1,1)
 116 :          A(1,2)=XPTS(2,2)-XPTS(1,2)
 117 :          A(2,1)=XPTS(3,1)-XPTS(1,1)
 118 :          A(2,2)=XPTS(3,2)-XPTS(1,2)
 119 : c
 120 :          B(1,1)=W(1)
 121 :          B(2,1)=W(2)
 122 : C
 122 :          CALL GAUSSK(A,2,3,B,1,1)
 123 : C
 124 :          IF (IERR.NE.0) then
 125 :             print*,'il y a une erreur dans bcirco : GAUSSK'
 126 :             RETURN
 127 :          endif
 128 : C
 129 :          XC(1)=B(1,1)
 130 :          XC(2)=B(2,1)
 131 : C
 132 :          XR=(XC(1)-XPTS(1,1))**2+(XC(2)-XPTS(1,2))**2
 133 :      &     - ((RPTS(1))**2)
 134 : c
 135 :          XR = XR**0.5
 136 : 
 137 : c  
 138 : c
 139 :       ELSEIF (IDIM.EQ.1) THEN
 140 :          XPTS(1,1)=XCOOR((IPT1.NUM(1,JEL)-1)*IDIMP1+1)
 141 :          XPTS(2,1)=XCOOR((IPT1.NUM(2,JEL)-1)*IDIMP1+1)
 142 :          XC(1)=0.5*((RPTS(1)**2)-(RPTS(2)**2)+(XPTS(2,1)**2)-
 143 :      &             (XPTS(1,1)**2))/(XPTS(2,1)-XPTS(1,1))
 144 :          XR = XC(1)-XPTS(1,1)
 145 :       ENDIF
 146 : C
 147 :       RETURN
 148 :       END
 149 :  
 150 :