Sources Esope | Cast3M

dyne28
C DYNE28    SOURCE    CHAT      05/01/12    23:16:40     5004
      SUBROUTINE DYNE28(INOR,ISUP,XPALB,NLIAB,I,ID1)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
*--------------------------------------------------------------------*
*                                                                    *
*     Op{rateur DYNE : algorithme de Fu - de Vogelaere               *
*     ________________________________________________               *
*                                                                    *
*     Cr{ation d'un rep}re orthonorm{ dans un plan.                  *
*                                                                    *
*     Param}tres:                                                    *
*                                                                    *
* e   INOR   vecteur perpendiculaire aux profils                     *
* e   ISUP   point support                                           *
* es  XPALB  tableau de description des liaisons sur base B          *
* e   NLIAB  nombre total de liaisons sur base B                     *
* e   I      num{ro de la liaison trait{e                            *
* e   ID1    indice de tableau                                       *
*                                                                    *
*                                                                    *
*     Auteur, date de cr{ation:                                      *
*                                                                    *
*     Lionel VIVAN, le 1 f{vrier 1991.                               *
*                                                                    *
*--------------------------------------------------------------------*
 
-INC PPARAM
-INC CCOPTIO
-INC SMCOORD
*
      REAL*8 XPALB(NLIAB,*)
      PARAMETER ( ZERO = 0.D0 )
*
      ID2 = ID1 + IDIM
      ID3 = ID1 + 2*IDIM
      ID4 = ID1 + 3*IDIM
      ID5 = ID1 + 4*IDIM
      ID6 = ID1 + 5*IDIM
*
*     normalisation de la normale
*
      IPNO  = (IDIM + 1) * (INOR - 1)
      IPSU  = (IDIM + 1) * (ISUP - 1)
      PS = 0.D0
      DO 10 ID = 1,IDIM
         XC = XCOOR(IPNO + ID)
         PS = PS + XC * XC
         XPALB(I,ID1+ID) = XCOOR(IPSU + ID)
 10      CONTINUE
*     end do
      IF (PS.LE.ZERO) THEN
         CALL ERREUR(162)
         RETURN
      ENDIF
      PS = SQRT(PS)
      DO 12 ID = 1,IDIM
         XPALB(I,ID5+ID) = XCOOR(IPNO + ID) / PS
 12      CONTINUE
*     end do
*
*     Le premier vecteur orthonorm{ est form{ par le premier {l{ment
      PS = ZERO
      ID61 = ID6 + IDIM
      DO 14 ID = 1,IDIM
         XPALB(I,ID2+ID) = XPALB(I,ID6+ID)
         XXX = XPALB(I,ID61+ID) - XPALB(I,ID6+ID)
         PS = PS + XXX * XXX
 14      CONTINUE
*     end do
      IF (PS.LE.ZERO) THEN
         CALL ERREUR(162)
         RETURN
      ENDIF
      PS = SQRT(PS)
      DO 16 ID = 1,IDIM
         XXX = XPALB(I,ID61+ID) - XPALB(I,ID6+ID)
         XPALB(I,ID3+ID) = XXX / PS
 16      CONTINUE
*     end do
*
*     Le second vecteur orthonorm{ est form{ par le produit vectoriel
      XPALB(I,ID4+1) = XPALB(I,ID5+2)*XPALB(I,ID3+3) -
     &                 XPALB(I,ID5+3)*XPALB(I,ID3+2)
      XPALB(I,ID4+2) = XPALB(I,ID5+3)*XPALB(I,ID3+1) -
     &                 XPALB(I,ID5+1)*XPALB(I,ID3+3)
      XPALB(I,ID4+3) = XPALB(I,ID5+1)*XPALB(I,ID3+2) -
     &                 XPALB(I,ID5+2)*XPALB(I,ID3+1)
*
      END