Télécharger la plaquette Cast3M


fr en

Télécharger adtuy.eso

Retour à la liste

Numérotation des lignes : 

adtuy

  1. C ADTUY     SOURCE    OF166741  25/02/21    21:15:05     12166          
  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.  
  7. -INC PPARAM
  8. -INC CCOPTIO
  9. -INC SMCHAML
  10. -INC SMCOORD
  11. -INC SMELEME
  12. -INC SMINTE
  13. -INC SMRIGID
  14.  
  15. -INC TMPTVAL
  16.  
  17.       SEGMENT,MMAT1
  18.         REAL*8 CEL(NBNN,NBNN),XE(3,NBNN)
  19.       ENDSEGMENT
  20.  
  21. C  1 - INITIALISATIONS ET VERIFICATIONS
  22. C ======================================
  23.       MELEME = IPMAIL
  24. c*      SEGACT,MELEME
  25.       NBNN   = NUM(/1)
  26.       NBELEM = NUM(/2)
  27. C =====
  28.       MINTE = IPINTE
  29. c*      SEGACT,MINTE
  30.       NBPGAU = POIGAU(/1)
  31.  
  32. C =====
  33.       MPTVAL = IVAMAT
  34. c*      SEGACT,MPTVAL
  35. C =====
  36.       XMATRI = IPMATR
  37.  
  38. C =====
  39. C Initialisation des segments de travail
  40. C =====
  41.       IF (IFOMOD.EQ.1) THEN
  42.          NDIM = 3
  43.       ELSE
  44.          NDIM = IDIM
  45.       ENDIF
  46.       SEGINI,MMAT1
  47.  
  48. C  2 - BOUCLE SUR LES ELEMENTS DU MAILLAGE ELEMENTAIRE IPMAIL
  49. C ============================================================
  50.       DO IEL = 1, NBELEM
  51. *
  52. * MISE A ZERO DU TABLEAU CEL
  53. *
  54.         CALL ZERO(CEL,NBNN,NBNN)
  55. *
  56. * COORDONNEES DES NOEUDS DE L'ELEMENT IEL DANS LE REPERE GLOBAL
  57. *
  58.         CALL DOXE(XCOOR,IDIM,NBNN,NUM,IEL,XE)
  59.  
  60.         DO IGAU = 1, NBPGAU
  61. *-        Recuperation de rho cp et section en un point de la barre
  62. *-        NB : ces composantes sont obligatoires donc IVAL(i) n'est pas nul !
  63.           rhsvs = 1.D0
  64.           DO i = 1, NMATR
  65.             MELVAL = IVAL(i)
  66.             ibmn = MIN(iel ,VELCHE(/2))
  67.             igmn = MIN(igau,VELCHE(/1))
  68.             rhsvs= rhsvs*VELCHE(igmn,ibmn)
  69.           ENDDO
  70.  
  71.           rhosv= rhsvs*poigau(igau)
  72.           DO i=1,nbnn
  73.               cz=  shptot(1,i,igau)* rhosv
  74.             DO j=1,nbnn
  75.               cel(i,j)=cel(i,j) +cz*shptot(2,j,igau)
  76.             ENDDO
  77.           ENDDO
  78.         ENDDO
  79.  
  80.         CALL rempms(cel,nbnn,re(1,1,iel))
  81.       ENDDO
  82.  
  83.       SEGSUP,MMAT1
  84.       RETURN
  85.       END
  86.  
  87.  
  88.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales