Sources Esope | Cast3M

depge1
C DEPGE1    SOURCE    FANDEUR   22/01/03    21:15:10     11136          
C
      SUBROUTINE DEPGE1(IPB,IPX,QI,MOT,IBBX2,IPLMOX,IPLMOY)
C
C********************************************************************
C
C      SBR APPELE PAR DEPGEN
C
C      CALCUL DES DEPLACEMENTS GENERALISES
C      """""""""""""""""""""""""""""""""""
C         ECRIT PAR D. BROCHARD 15/5/86
C
C
C      IPB POINTEUR MASSE
C      IPX POINTEUR MODE
C      PROPRE VECTEUR DES CARACTERISTIQUES MODALES)
C      MOT NOM DE LA COMPOSANTE
C      IBBX2 POINTEUR SUR CHPO M*X
C      IPLIMO  POINTEUR SUR LIST MOTS  TABLEAU UX FX ... POUR APPEL A
C              XTY1
C
C      CE SBR CALCULE DTMU
C      TOUT D ABORD GENERATION  DU VECTEUR U AYANT DES COMPOSANTES
C      DE VALEUR 1. SUR LES VARIABLES UX UY UZ  OU SUR UR UT DANS
C      LEC CAS AXI OU FOURIER (1 OU -1 SELON L HARMONIQUE)
C
C      SBR APPELANT  :  DEPGEN
C
C      SBR APPELE  : YTMX,DTCHPO,PLACE
C
C      LE 15/05/86  : OPTION FOURIER N DIFF. 0 NON TESTEE
C                     NUMERO D HARMONIQUE NON ECRITE DANS CHAMP POINT
C
C
C
C      LE 08/07/86  : IFOPOI ET NOHARM CORRECTS SPR. TESTE DANS LE
C                     CAS FOURIER AVEC UNE SEULE HARMONIQUE. RESTE
C                     A TESTER LE CAS AXISYMETRIQUE.
C
C********************************************************************
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
 
-INC SMCHPOI
-INC SMELEME
 
      SEGMENT MTRA(NSOUP1)
C
      REAL*8 QI
      CHARACTER*(*) MOT
 
      CHARACTER*(LOCOMP) MOREF(3),MOT1,MOT2(3),MOT3
      DATA MOT2/'UR  ','UT  ','UZ  '/,MOREF/'UX  ','UY  ','UZ  '/
C
C     EXTRAIRE LA COMPOSANTE DE NOM MOT
C
      IHARM1=0
      MCHPO1=IPX
      SEGACT MCHPO1
      IF(MCHPO1.IFOPOI.NE.1)  GOTO 1001
      LMOREF=3
      CALL PLACE(MOREF,LMOREF,IMOT,MOT)
      GOTO (1,2,3),IMOT
1     CONTINUE
C
C     UX
C
      IHARM1=1
      IDEB=1
      IFIN=2
      GOTO 1001
2     CONTINUE
C
C     UY
C
      IHARM1=-1
      IDEB=1
      IFIN=2
      GOTO 1001
3     CONTINUE
C
C     UZ
C
      IDEB=3
      IFIN=3
C
1001  CONTINUE
      NSOUP1=MCHPO1.IPCHP(/1)
      SEGINI MTRA
      NSOUPO=0
C
C     BOUCLE SUR LES SOUS PAQUETS DE MCHPO1
C
      IF(MCHPO1.IFOPOI.EQ.1) GOTO 400
      DO 100 IA=1,NSOUP1
      MSOUP1=MCHPO1.IPCHP(IA)
      SEGACT MSOUP1
      NC1=MSOUP1.NOCOMP(/2)
      DO 110 IB=1,NC1
      MOT1=MSOUP1.NOCOMP(IB)
      IF(MOT1.NE.MOT) GOTO 110
      NSOUPO=NSOUPO+1
      MTRA(NSOUPO)=MSOUP1
      GOTO 401
  110 CONTINUE
401   CONTINUE
100   CONTINUE
      GOTO 500
400   CONTINUE
      DO 410 IA=1,NSOUP1
      MSOUP1=MCHPO1.IPCHP(IA)
      SEGACT MSOUP1
      NC1=MSOUP1.NOCOMP(/2)
      DO 112 I=IDEB,IFIN
      MOT3=MOT2(I)
      DO 111 IB=1,NC1
      MOT1=MSOUP1.NOCOMP(IB)
      IHARM=MSOUP1.NOHARM(IB)
      IF(MOT1.EQ.MOT3.AND.IHARM.EQ.IHARM1) GOTO 112
  111 CONTINUE
      GOTO 405
  112 CONTINUE
      NSOUPO=NSOUPO+1
      MTRA(NSOUPO)=MSOUP1
  405 CONTINUE
  410 CONTINUE
C
500   CONTINUE
C
      IF(NSOUPO.EQ.0) GOTO  1000
C
      IF(IHARM1.EQ.0) GOTO 300
C
C     CREATION DU CHAMP POINT AYANT SELON LES CAS 1 OU -1 SU UR ET UT
C
      NAT=1
      SEGINI MCHPOI
      IFOPOI=MCHPO1.IFOPOI
      NC=2
      DO 130 ISOUP=1,NSOUPO
      SEGINI MSOUPO
      IPCHP(ISOUP)=MSOUPO
      MSOUP1=MTRA(ISOUP)
      SEGACT MSOUP1
      IGEOC=MSOUP1.IGEOC
      NOCOMP(1)=MOT2(1)
      NOCOMP(2)=MOT2(2)
      NOHARM(1)=IHARM1
      NOHARM(2)=IHARM1
      MPOVA1=MSOUP1.IPOVAL
      SEGACT MPOVA1
      N=MPOVA1.VPOCHA(/1)
      SEGINI MPOVAL
      IPOVAL=MPOVAL
      DO 131 I=1,N
      VPOCHA(I,1)=1.0D0
      VPOCHA(I,2)=1.0D0
      IF(IHARM1.EQ.1) VPOCHA(I,2)=-1.0D0
131   CONTINUE
130   CONTINUE
      GOTO 310
300   NAT=1
      SEGINI MCHPOI
      IFOPOI=MCHPO1.IFOPOI
C
C     CREATION D UN CHAMP POINT DE VALEUR 1.0 SUR UX OU UY OU UZ
C
      NC=1
      DO 120 ISOUP=1,NSOUPO
      SEGINI MSOUPO
      IPCHP(ISOUP)=MSOUPO
      MSOUP1=MTRA(ISOUP)
      SEGACT MSOUP1
      IGEOC=MSOUP1.IGEOC
      NOCOMP(1)=MOT
      NOHARM(1)=0
      MPOVA1=MSOUP1.IPOVAL
      SEGACT MPOVA1
      N     =MPOVA1.VPOCHA(/1)
      SEGINI MPOVAL
      IPOVAL=MPOVAL
      DO 121 I=1,N
      VPOCHA(I,1)= 1.D0
  121 CONTINUE
  120 CONTINUE
 310  CONTINUE
      IP2=MCHPOI
*
      IF(IBBX2.EQ.0) GOTO 2000
      CALL XTY1(IP2,IBBX2,IPLMOX,IPLMOY,QI)
      GOTO 2001
C
2000  CALL YTMX(IPX,IP2,IPB,QI)
2001  CALL DTCHPO(IP2)
      GOTO  1100
1000  CONTINUE
      QI=0.D0
1100  CONTINUE
      SEGSUP MTRA
      END