Esope source files

   1 : C ADTUY     SOURCE    CHAT      12/06/07    21:15:00     7389           
   2 :       SUBROUTINE adtuy (NEF,IPMAIL,IPINTE,IMATE,IVAMAT,NMATR,
   3 :      &                   IPMATR,NLIGR)
   4 :       IMPLICIT INTEGER(I-N)
   5 :       IMPLICIT REAL*8(A-H,O-Z)
   6 : -INC CCOPTIO
   7 : -INC SMCHAML
   8 : -INC SMCOORD
   9 : -INC SMELEME
  10 : -INC SMINTE
  11 : -INC SMRIGID
  12 : 
  13 :       SEGMENT MPTVAL
  14 :         INTEGER IPOS(NS),NSOF(NS),IVAL(NCOSOU)
  15 :         CHARACTER*16 TYVAL(NCOSOU)
  16 :       ENDSEGMENT
  17 : 
  18 :       SEGMENT,MMAT1
  19 :         REAL*8 CEL(NBNN,NBNN),XE(3,NBNN)
  20 :         REAL*8 SHP(6,NBNN),GRAD(NDIM,NBNN)
  21 : C*      REAL*8 FORME(NBNN),V77(NBNN),V22(IDIM) <- A verifier pour V22
  22 :         REAL*8 FORME(NBNN),V77(NBNN),V22(NDIM)
  23 :         REAL*8 CMAT(NDIM,NDIM),CMAT1(IDIM,IDIM),CMAT2(IDIM,IDIM)
  24 :       ENDSEGMENT
  25 :       
  26 : C  1 - INITIALISATIONS ET VERIFICATIONS
  27 : C ======================================
  28 :       MELEME = IPMAIL
  29 : c*      SEGACT,MELEME
  30 :       NBNN   = NUM(/1)
  31 :       NBELEM = NUM(/2)
  32 : C =====
  33 :       MINTE = IPINTE
  34 : c*      SEGACT,MINTE
  35 :       NBPGAU = POIGAU(/1)
  36 : 
  37 : C =====
  38 :       MPTVAL = IVAMAT
  39 : c*      SEGACT,MPTVAL
  40 : C =====
  41 :       XMATRI = IPMATR
  42 : 
  43 : C =====
  44 : C Initialisation des segments de travail
  45 : C =====
  46 :       IF (IFOMOD.EQ.1) THEN
  47 :          NDIM = 3
  48 :       ELSE
  49 :          NDIM = IDIM
  50 :       ENDIF
  51 :       segini mmat1
  52 : C  2 - BOUCLE SUR LES ELEMENTS DU MAILLAGE ELEMENTAIRE IPMAIL
  53 : C ============================================================
  54 :       DO IEL = 1, NBELEM
  55 : *
  56 : * MISE A ZERO DU TABLEAU CEL
  57 : *
  57 :         CALL ZERO(CEL,NBNN,NBNN)
  58 : *
  59 : * COORDONNEES DES NOEUDS DE L'ELEMENT IEL DANS LE REPERE GLOBAL
  60 : *
  60 :         CALL DOXE(XCOOR,IDIM,NBNN,NUM,IEL,XE)
  61 : *
  62 : * 
  63 :         if(nef.eq.269) then
  64 :           DO i = 1, NMATR
  65 : c*          IF (IVAL(i).NE.0) THEN
  66 :               MELVAL = IVAL(i)
  67 :               ibmn = MIN(iel ,VELCHE(/2))
  68 :               igmn = 1
  69 :               V22(i) = VELCHE(igmn,ibmn)
  70 : c*          ELSE
  71 : c*            VALMAT(i) = 0.
  72 : c*          ENDIF
  73 :           ENDDO   
  74 :           rhosv=v22(1)*v22(2)*v22(3)*v22(4)
  75 :           cel(1,1)=-0.5d0*rhosv
  76 :           cel(1,2)=0.5d0*rhosv
  77 :           cel(2,1)=  cel(1,1) 
  78 :           cel(2,2)=  cel(1,2)     
  79 :         elseif( nef.eq.270) then                             
  80 :           IFOIS = 0      
  81 :           DO IGAU = 1, NBPGAU      
  82 : c  calcul de la longueur ou du jacobien  
  83 : *            dx= shptot(2,1,igau)*xe(1,1)+shptot(2,2,igau)*xe(1,2)
  84 : *     $      + shptot(2,3,igau)*xe(1,3)
  85 : *            dy= shptot(2,1,igau)*xe(2,1)+shptot(2,2,igau)*xe(2,2)
  86 : *     $      + shptot(2,3,igau)*xe(2,3) 
  87 : *            dl2= dx*dx + dy * dy    
  88 : *            if(idim.eq.3) then
  89 : *              dz= shptot(2,1,igau)*xe(3,1)+shptot(2,2,igau)*xe(3,2)
  90 : *     $        + shptot(2,3,igau)*xe(3,3)
  91 : *              dl2=dl2+ dz*dz
  92 : *            endif
  93 : *           djac= sqrt ( dl2)
  94 :        
  95 : *
  96 : *- Recuperation de rho cp et section en un point de la barre
  97 : *- NB : ces composantes sont obligatoires donc IVAL(i) n'est pas nul !
  98 :             DO i = 1, NMATR
  99 : c*          IF (IVAL(i).NE.0) THEN
 100 :               MELVAL = IVAL(i)
 101 :               ibmn = MIN(iel ,VELCHE(/2))
 102 :               igmn = MIN(igau,VELCHE(/1))
 103 :               V22(i) = VELCHE(igmn,ibmn)
 104 :             ENDDO  
 105 :              rhsvs= v22(1)*v22(2)*v22(3)*v22(4)       
 106 :             rhosv= rhsvs*poigau(igau)
 107 :             do i=1,nbnn
 108 : *              do j=1,idim
 109 :                 cz=  shptot(1,i,igau)* rhosv
 110 :                 
 111 : *              enddo
 112 :               do j=1,nbnn
 113 :                 cel(i,j)=cel(i,j) +cz*shptot(2,j,igau)
 114 :               enddo
 115 :             enddo
 116 :           ENDDO
 117 :         endif
 118 : *        write(6,*) ' cel(1,)', ( cel(1,jou),jou=1,nbnn)
 119 : *        write(6,*) ' cel(2,)', ( cel(2,jou),jou=1,nbnn)  
 120 : *        if(nbnn.eq.3)write(6,*) ' cel(3,)', ( cel(3,jou),jou=1,nbnn)            
 120 :         call rempms(cel,nbnn,re(1,1,iel))
 121 :       enddo       
 122 :       SEGSUP,MMAT1 
 123 :       return
 124 :       end
 125 :        
 126 :