Esope source files

   1 : C J3ORIE    SOURCE    CHAT      05/01/13    00:47:14     5004           
   2 :       SUBROUTINE J3ORIE(IMOD,XYC,DENS,NPTO,IORI,TOL,IRET)
   3 : C----------------------------------------------------
   4 : C     ORINTATION DANS IORI SI IMOD=0
   5 : C     ORIENTATION SUIVANT IORI SI IMOD=1
   6 : C
   7 : C     PP 6/97,11/98
   8 : C     Pierre Pegon/JRC Ispra
   9 : C----------------------------------------------------
  10 :       IMPLICIT INTEGER(I-N)
  11 :       IMPLICIT REAL*8(A-H,O-Z)
  12 : -INC  CCOPTIO

  13 :       DIMENSION XYC(2,NPTO),DENS(NPTO),XY(2)
  14 : C
  15 : C     ON CHERCHE UN POINT A L'INTERIEUR DU CONTOURS
  16 : C
  17 :       IF (NPTO.EQ.3)THEN
  18 :         XY(1)=(XYC(1,1)+XYC(1,2)+XYC(1,3))/3
  19 :         XY(2)=(XYC(2,1)+XYC(2,2)+XYC(2,3))/3
  19 :         CALL J3INEX(XY,XYC,NPTO,TOL,ICOD,ISIGM,IRET)
  20 :         GOTO 1
  21 :       ENDIF
  22 : C
  23 :       DO IE1=1,NPTO
  24 :         I1=IE1-1+(1/IE1)*NPTO
  25 :         I2=IE1+1-(IE1/NPTO)*IE1
  26 :         XL1=SQRT((XYC(1,I1)-XYC(1,IE1))**2+(XYC(2,I1)-XYC(2,IE1))**2)
  27 :         XL2=SQRT((XYC(1,I2)-XYC(1,IE1))**2+(XYC(2,I2)-XYC(2,IE1))**2)
  28 :         DDD=((XYC(1,I1)-XYC(1,IE1))*(XYC(2,I2)-XYC(2,IE1))
  29 :      >      -(XYC(1,I2)-XYC(1,IE1))*(XYC(2,I1)-XYC(2,IE1)))/XL1/XL2
  30 :         IF(ABS(DDD).GT.10*TOL)THEN
  31 :           DO IE2=1,2
  32 :             XY(IE2)=(XYC(IE2,I1)+XYC(IE2,I2))/2
  33 :           ENDDO
  33 :           CALL J3INEX(XY,XYC,NPTO,TOL,ICOD,ISIGM,IRET)
  34 :           IF(ICOD.EQ.-1)GOTO 1
  35 :         ENDIF
  36 :       ENDDO
  37 :       IRET=IRET+1
  38 :       WRITE(IOIMP,*)'J3ORIE: PAS DE POINT A L"INTERIEUR DU CONTOURS'
  39 :       RETURN
  40 : C
  41 :  1    CONTINUE
  42 : C
  43 :       IF(IMOD.EQ.0)THEN
  44 :         IORI=ISIGM
  45 :         RETURN
  46 :       ENDIF
  47 : C
  48 : C     SI L'ORIENTATION EST NEGATIVE, ON LA CHANGE
  49 : C
  50 :       IF(ISIGM.NE.IORI)THEN
  51 :         DO IE1=1,NPTO/2
  52 :           I1=NPTO+1-IE1
  53 :           DO IE2=1,2
  54 :             XY(IE2)=XYC(IE2,IE1)
  55 :           ENDDO
  56 :           DENS1=DENS(IE1)
  57 :           DO IE2=1,2
  58 :             XYC(IE2,IE1)=XYC(IE2,I1)
  59 :           ENDDO
  60 :           DENS(IE1)=DENS(I1)
  61 :           DO IE2=1,2
  62 :             XYC(IE2,I1)=XY(IE2)
  63 :           ENDDO
  64 :           DENS(I1)=DENS1
  65 :         ENDDO
  66 :       ENDIF
  67 : C
  68 :       RETURN
  69 :       END
  70 :  
  71 :