Download devfb7.eso

Back to the list

   1 : C DEVFB7    SOURCE    CHAT      05/01/12    22:45:43     5004           
   2 : C DEVFB6    SOURCE    LAVARENN  96/10/30    21:16:12     2349           
   3 :       SUBROUTINE DEVFB7(ITYP,FTOTB,XPTB,IPALB,IPLIB,XPALB,XVALB,NLIAB,          
   4 :      &                  NPLB,IND,IND2,PDTS2,I,iannul,XCHPFB)                                          
   5 :       IMPLICIT INTEGER(I-N)
   6 :       IMPLICIT REAL*8(A-H,O-Z)                                                       
   7 : *--------------------------------------------------------------------*          
   8 : *                                                                    *          
   9 : *     Opérateur DYNE : algorithme de Fu - de Vogelaere               *          
  10 : *     ________________________________________________               *          
  11 : *                                                                    *          
  12 : *     Calcul des forces de choc sur base B pour les liaisons de      *          
  13 : *     type LIGNE_CERCLE                                            *          
  14 : *                                                                    *          
  15 : *     Paramètres:                                                    *          
  16 : *                                                                    *          
  17 : * e   ITYP    type de la liaison.                                    *          
  18 : * es  FTOTB   Forces extérieures totalisées sur la base B.           *          
  19 : * e   XPTB    Tableau des déplacements des points                    *          
  20 : * e   IPALB   Renseigne sur la liaison.                              *          
  21 : * e   IPLIB   Tableau contenant les numéros "DYNE" de la liaison.    *          
  22 : * e   XPALB   Tableau contenant les paramètres de la liaison.        *          
  23 : * es  XVALB   Tableau contenant les variables internes de liaisons.  *          
  24 : * es  XCHPFB  Tableau contenant les valeurs des futurs chpoints      *        
  25 : * e   NLIAB   Nombre de liaisons sur la base B.                      *          
  26 : * e   NPLB    Nombre total de points intervenant dans les liaisons.  *          
  27 : * e   IND     Indice du pas.                                         *          
  28 : * e   I       numéro de la liaison.                                  *          
  29 : *                                                                    *          
  30 : *                                                                    *          
  31 : *     Auteur, date de création:                                      *          
  32 : *                                                                    *           
  33 : *     Ibrahim PINTO, 05/97                                           *          
  34 : *--------------------------------------------------------------------*          
  35 : *                                                                               
  36 :       INTEGER IPALB(NLIAB,*),IPLIB(NLIAB,*)  
  37 :       REAL*8  XPALB(NLIAB,*),XPTB(NPLB,4,*),FTOTB(NPLB,*)                       
  38 :       REAL*8  XVALB(NLIAB,4,*),XCHPFB(2,NLIAB,4,*)                           
  39 : 
  40 : 
  41 : 
  42 : 
  43 : *
  44 : *  Initialisations
  45 : *
  46 : *
  47 :         XVALB(I,IND,1) =0.D0
  48 :         XVALB(I,IND,3) =0.D0
  49 :         XVALB(I,IND,4) =0.D0
  50 :         XVALB(I,IND,5) =0.D0
  51 :         XVALB(I,IND,6) =0.D0
  52 :         XVALB(I,IND,10) = 0.D0
  53 :         XVALB(I,IND,11) = 0.D0
  54 :         XVALB(I,IND,12) = 0.D0  
  55 :         IDIM = IPALB(I,3)
  56 :         IF (ITYP.EQ.37 .OR. ITYP.EQ.39) THEN
  57 :            ID1 = 6
  58 :         ELSE
  59 :            ID1 = 7
  60 :         ENDIF
  61 :         NNOEES = IPALB(I,22)
  62 :         NNOEMA=IPALB(I,21)
  63 :         IFO =ID1 + (4 + NNOEMA+NNOEES)*IDIM
  64 :         ICH = 26 + NNOEMA+NNOEES
  65 :         ICG = 26 + 2*(NNOEMA+NNOEES)
  66 :         DO 5 J=1,(NNOEMA+NNOEES)
  67 :            IPALB(I,ICH+J) = 0
  68 :            IPALB(I,ICG+J) = 0
  69 :            DO 7 ID=1,IDIM
  70 :               XPALB(I,IFO+ID) = 0.D0
  71 :  7         CONTINUE
  72 :            IFO = IFO + IDIM
  73 :  5      CONTINUE
  74 :         IF (IDIM.EQ.3) THEN
  75 :             IDIMB=6
  76 :         ELSE
  77 :             IDIMB=3
  78 :         ENDIF
  79 :         DO 8 IP=1,NPLB
  80 :               XCHPFB(1,I,IND,IP)=0.D0
  81 :               XCHPFB(2,I,IND,IP)=0.D0
  82 :  8      CONTINUE
  83 : *******************************************************************
  84 : * On s'intéresse au choc des noeuds esclaves sur le maillage maitre
  85 : *******************************************************************
  86 : 
  87 : 
  88 : 
  89 :       ILOCAL=IPALB(I,23)
  90 :       ISYM = IPALB(I,26)
  91 :       
  92 :       
  93 :       IF (ISYM.EQ.1 .OR. ISYM.EQ.0) THEN
  94 :       
  95 : ********************************************************************
  96 : * On s'intéresse au choc des noeuds maitres sur le maillage esclave*
  97 : ********************************************************************
  98 : 
  99 : * Recherche des plus proches voisins
  99 :       CALL DYVOIS(IPALB,IPLIB,XPALB,XPTB,IND,I,NLIAB,NPLB,ILOCAL,1)
 100 : * Boucle sur tous les noeuds MAITRES
 101 :         DO 10 IESC=1,NNOEMA
 101 :         CALL DYFOR1(XPTB,XVALB,IPALB,IPLIB,XPALB,NLIAB,NPLB,IND
 102 :      &,IND2,PDTS2,I,IANNUL,IESC,1,XCHPFB)
 103 :  10     CONTINUE
 104 :  
 105 :  
 106 :       ELSE
 107 :       
 108 :  
 109 : ********************************************************************
 110 : * On s'intéresse au choc des noeuds esclaves sur le maillage maitre*
 111 : ********************************************************************      
 112 :       
 113 : * Recherche des plus proches voisins
 113 :        CALL DYVOIS(IPALB,IPLIB,XPALB,XPTB,IND,I,NLIAB,NPLB,ILOCAL,0)
 114 : * Boucle sur tous les noeuds esclaves
 115 :         DO 20 IESC=1,NNOEES
 115 :         CALL DYFOR1(XPTB,XVALB,IPALB,IPLIB,XPALB,NLIAB,NPLB,IND
 116 :      &,IND2,PDTS2,I,IANNUL,IESC,0,XCHPFB)
 117 :  20     CONTINUE
 118 :  
 119 :       ENDIF      
 120 :             
 121 : 
 122 :            IFO =ID1 + (4 + NNOEMA+NNOEES)*IDIM
 123 :            DO 40 INOE=1,(NNOEMA+NNOEES)
 124 :               DO 42 ID=1,IDIM
 125 :                   FTOTB(IPLIB(I,INOE),ID)=FTOTB(IPLIB(I,INOE),ID)+
 126 :      &XPALB(I,IFO+ID)
 127 :  42           CONTINUE
 128 :               IFO = IFO+IDIM   
 129 :  40        CONTINUE            
 130 : *                
 131 : *
 132 : 
 133 :        END
 134 :  
 135 :  
 136 :  
 137 :  

© Cast3M 2003 - All rights reserved.
Disclaimer