Download chama2.eso

Back to the list

   1 : C CHAMA2    SOURCE    FANDEUR   10/12/17    21:16:02     6427           
   2 : 
   3 : C=======================================================================
   4 : C=                            C H A M A 2                              =
   5 : C=                            -----------                              =
   6 : C=                                                                     =
   7 : C=  Fonction :                                                         =
   8 : C=  ----------                                                         =
   9 : C=   Calcul du MCHAML (champ par element aux noeuds) des flux nodaux   =
  10 : C=   equivalents a des sources volumiques. Cas BIDIMENSIONNEL MASSIF   =
  11 : C=                                                                     =
  12 : C=  Parametres :  (E)=Entree  (S)=Sortie                               =
  13 : C=  ------------                                                       =
  14 : C=   IPSONO   (E)   Pointeur sur le segment MELVAL des SOURCES         =
  15 : C=   IPGEOM   (E)   Pointeur sur un objet MAILLAGE elementaire         =
  16 : C=   IPINTE   (E)   Pointeur sur un segment MINTE contenant les        =
  17 : C=                  caracteristiques d'integration                     =
  18 : C=   IPCHEQ   (S)   Pointeur sur un segment MELVAL contenant les       =
  19 : C=                  flux de chaleur nodaux equivalents                 =
  20 : C=                                                                     =
  21 : C=  Variables locales :                                                =
  22 : C=  -------------------                                                =
  23 : C=   XEL(3,NBPTEL)  Coordonnees GLOBALES des noeuds d'un element       =
  24 : C=   Surf           Surface elementaire au point de Gauss              =
  25 : C=   AEL            Matrice de travail                                 =
  26 : C=                                                                     =
  27 : C=  Denis ROBERT, le 16 fevrier 1988.                                  =
  28 : C=======================================================================
  29 : 
  30 :       SUBROUTINE CHAMA2 (IPSONO,IPGEOM,IPINTE, IPCHEQ)
  31 : 
  32 :       IMPLICIT INTEGER(I-N)
  33 :       IMPLICIT REAL*8 (A-H,O-Z)
  34 : 
  35 : -INC CCOPTIO
  36 : -INC CCREEL
  37 : 
  38 : -INC SMCHAML
  39 : -INC SMELEME
  40 : -INC SMINTE
  41 : -INC SMCOORD
  42 : 
  43 :       SEGMENT MMAT1
  44 :         REAL*8 XEL(3,NBPTEL), AEL(NBPTEL,NBPTEL)
  45 :       ENDSEGMENT
  46 : 
  47 :       PARAMETER (X2Pi=6.283185307179586476925286766559D0)
  48 : 
  49 : C  1 - INITIALISATION
  50 : C ====================
  51 : C  1.1 - Recuperation d'informations sur le maillage elementaire
  52 : C =====
  53 :       MELEME=IPGEOM
  54 :       SEGACT,MELEME
  55 :       NBPTEL=NUM(/1)
  56 :       NbElt=NUM(/2)
  57 : C =====
  58 : C  1.2 - Recuperation d'informations sur l'element fini du maillage
  59 : C =====
  60 :       MINTE=IPINTE
  61 :       SEGACT,MINTE
  62 :       NBPGAU=POIGAU(/1)
  63 :       NBNO=SHPTOT(/2)
  64 : C =====
  65 : C  1.3 - Activation du MCHAML contenant les valeurs des sources
  66 : C =====
  67 :       MELVA1=IPSONO
  68 :       SEGACT,MELVA1
  69 :       NBPTE1=MELVA1.VELCHE(/1)
  70 :       NEL1=MELVA1.VELCHE(/2)
  71 : C =====
  72 : C  1.4 - Initialisation du segment de travail MMAT1
  73 : C =====
  74 :       SEGINI,MMAT1
  75 : C =====
  76 : C  1.5 - Initialisation du segment resultat MELVAL contenant les valeurs
  77 : C        des flux nodaux pour chaque element du maillage (IPGEOM)
  78 : C =====
  79 :       N1PTEL=NBPTEL
  80 :       N1EL=NbElt
  81 :       N2PTEL=0
  82 :       N2EL=0
  83 :       SEGINI,MELVAL
  84 :       IPCHEQ=MELVAL
  85 : 
  86 : C  2 - BOUCLE SUR LES ELEMENTS DU MAILLAGE ELEMENTAIRE IMAMOD
  87 : C ============================================================
  88 :       DO iElt=1,NbElt
  89 : C =====
  90 : C  2.1 - Mise a zero de la matrice symetrique AEL(i,j)=Forme(i).Forme(j)
  91 : C =====
  91 :         CALL ZERO(AEL,NBPTEL,NBPTEL)
  92 : C =====
  93 : C  2.2 - Recuperation des coordonnees GLOBALES des noeuds de l'element
  94 : C =====
  94 :         CALL DOXE(XCOOR,IDIM,NBPTEL,NUM,iElt,XEL)
  95 : C =====
  96 : C  2.3 - Boucle sur les points de Gauss de l'element iElt
  97 : C =====
  98 :         DO iGau=1,NBPGAU
  99 : C =======
 100 : C  2.4.1 - Calcul de la surface associee au point de Gauss iGau
 101 : C          Pour les elements MASSIFs, traitement du cas axisymetrique
 102 : C =======
 103 :           S1=XZERO
 104 :           S2=XZERO
 105 :           S3=XZERO
 106 :           S4=XZERO
 107 :           S5=XZERO
 108 :           S6=XZERO
 109 :           DO i=1,NBPTEL
 110 :             S1=S1+SHPTOT(2,i,iGau)*XEL(2,i)
 111 :             S2=S2+SHPTOT(3,i,iGau)*XEL(3,i)
 112 :             S3=S3+SHPTOT(3,i,iGau)*XEL(2,i)
 113 :             S4=S4+SHPTOT(2,i,iGau)*XEL(3,i)
 114 :             S5=S5+SHPTOT(3,i,iGau)*XEL(1,i)
 115 :             S6=S6+SHPTOT(2,i,iGau)*XEL(1,i)
 116 :           ENDDO
 117 :           SurfX=S1*S2-S3*S4
 118 :           SurfY=S4*S5-S2*S6
 119 :           SurfZ=S6*S3-S5*S1
 120 :           Surf=SQRT(SurfX*SurfX+SurfY*SurfY+SurfZ*SurfZ)
 121 :           IF (IFOMOD.EQ.0) THEN
 121 :             CALL DISTRR(XEL,SHPTOT(1,1,iGau),NBPTEL,RR)
 122 :             Surf=X2Pi*RR*Surf
 123 :           ENDIF
 124 :           Surf=Surf*POIGAU(iGau)
 125 : C =======
 126 : C  2.3.2 - Calcul de la contribution du point de Gauss a la matrice AEL
 127 : C =======
 128 :           DO i=1,NBPTEL
 129 :             ZZ=SHPTOT(1,i,iGau)*Surf
 130 :             DO j=1,NBPTEL
 131 :               AEL(i,j)=AEL(i,j)+SHPTOT(1,j,iGau)*ZZ
 132 :             ENDDO
 133 :           ENDDO
 134 :         ENDDO
 135 : C =====
 136 : C  2.4 - Calcul des flux equivalents sur cet element (MCHAML aux noeuds)
 137 : C =====
 138 :         IEMIN=MIN(NEL1,iElt)
 139 :         DO i=1,NBPTEL
 140 :           ZZ=XZERO
 141 :           DO j=1,NBPTEL
 142 :             k=MIN(NBPTE1,j)
 143 :             ZZ=ZZ+MELVA1.VELCHE(k,IEMIN)*AEL(j,i)
 144 :           ENDDO
 145 :           VELCHE(i,iElt)=ZZ
 146 :         ENDDO
 147 :       ENDDO
 148 : 
 149 : C  3 - MENAGE : DESACTIVATION/DESTRUCTION DE SEGMENTS
 150 : C ====================================================
 151 :       SEGSUP,MMAT1
 152 :       SEGDES,MELEME,MELVA1,MINTE,MELVAL
 153 : 
 154 :       RETURN
 155 :       END
 156 : 
 157 :  

© Cast3M 2003 - All rights reserved.
Disclaimer