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

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