Télécharger chabat.eso

Retour à la liste

chabat
C CHABAT    SOURCE    MB234859  25/09/08    21:15:06     12358          
 
C=======================================================================
C=                            C H A B A T                              =
C=                            -----------                              =
C=                                                                     =
C=  Fonction :                                                         =
C=  ----------                                                         =
C=   Calcul des flux equivalents a des sources volumiques dans le cas  =
C=   des elements BARRE (THERMIQUE) et TUYAU (ADVECTION)               =
C=                                                                     =
C=  Parametres :  (E)=Entree  (S)=Sortie                               =
C=  ------------                                                       =
C=   IPMODL  (E)   Pointeur du MMODEL a traiter                        =
C=   IFORMU  (E)   Entier indiquant la formulation du modele a traiter =
C=   IPCHSO  (E)   Pointeur du MCHAML de sources                       =
C=   IPCHEB  (E)   Pointeur du MCHAML de CARACTERISTIQUES              =
C=                 (necessaire pour les elements BARRes et TUYAux)     =
C=   ISUPCH  (E)   Support des champs en entree                        =
C=   IPCHAL  (S)   MCHAML aux noeuds des flux equivalents              =
C=======================================================================
 
      SUBROUTINE CHABAT (IPMODL,IFORMU, IPCHSO,IPCHEB,ISUPCH, IPCHAL)
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
 
-INC PPARAM
-INC CCOPTIO
-INC CCREEL
 
-INC SMCOORD
-INC SMCHAML
-INC SMELEME
-INC SMINTE
-INC SMMODEL
 
      SEGMENT MMAT1
        REAL*8 XEL(3,NBPTEL),AEL(NBPTEL,NBPTEL)
      ENDSEGMENT
 
      MMODEL = IPMODL
      NSOU   = KMODEL(/1)
 
      MCHELM = IPCHAL
      MCHEL1 = IPCHSO
      NSZ1   = MCHEL1.IMACHE(/1)
 
      MCHEL2 = IPCHEB
      NSZ2   = MCHEL2.IMACHE(/1)
 
      MMAT1  = 0
 
C  BOUCLE SUR LES ZONES ELEMENTAIRES DU MODELE (ISOU)
C ====================================================
      DO 100 ISOU = 1, NSOU
 
C  Modele elementaire ISOU
C =====
        IMODEL = mmodel.KMODEL(ISOU)
C =====
C  Recherche dans le MCHAML des sources (IPCHSO) de la sous-zone
C  associee au modele elementaire ISOU (IMAMOD et CONMOD), puis
C  recuperation des valeurs du champ elementaire de sources (MELVA1)
C =====
        MELVA1 = 0
        DO is = 1, NSZ1
          IF (MCHEL1.IMACHE(is).EQ.imodel.IMAMOD .AND.
     &        MCHEL1.CONCHE(is).EQ.imodel.CONMOD) THEN
            mchaml = MCHEL1.ICHAML(is)
c il faudrait chercher la composante si le champ en a plus d'une.
            MELVA1 = mchaml.IELVAL(1)
            GOTO 10
          ENDIF
        ENDDO
 10     CONTINUE
        IF (MELVA1.EQ.0) GOTO 100
 
C =====
C  Recherche dans le MCHMAL des caracteristiques (IPCHEB) du
C  maillage (IMAMOD) associe au modele elementaire ISOU, puis
C  recuperation du MCHAML elementaire associe (MELVA2)
C =====
        MELVA2 = 0
        DO is = 1, NSZ2
          IF (MCHEL2.IMACHE(is).EQ.imodel.IMAMOD .AND.
     &        MCHEL2.CONCHE(is).EQ.imodel.CONMOD) THEN
            mchaml = MCHEL2.ICHAML(is)
            NCOELE = mchaml.NOMCHE(/2)
            IPOSI = 0
            CALL PLACE(mchaml.NOMCHE,NCOELE,IPOSI,'SECT')
            IF (IPOSI.NE.0) THEN
              MELVA2 = mchaml.IELVAL(IPOSI)
            ENDIF
            GOTO 20
          ENDIF
        ENDDO
 20     CONTINUE
        IF (MELVA2.EQ.0) THEN
          MOTERR(1:4) = 'SECT'
          MOTERR(5:8) = 'CARA'
          CALL ERREUR(77)
          GOTO 100
        ENDIF
C =====
C  Informations sur l'element fini du modele ISOU
C =====
        NEF    = imodel.NEFMOD
        MELEME = imodel.IMAMOD
C* Rappel : diffusion = thermique (en attendant retour a "mecanique")
        IF (IFORMU.EQ.1 .OR. IFORMU.EQ.2 .OR. IFORMU.EQ.3) THEN
          CALL TSHAPE(NEF,'GAUSS',IPINTE)
        ELSE
          IPINTE = IMODEL.INFMOD(2+ISUPCH)
        ENDIF
C =====
C  3.6 - Calcul des flux nodaux equivalents (segment MELVAL)
C =====
C  3.6.1 - Recuperation d'informations sur le maillage elementaire
        MELEME = imodel.IMAMOD
        NBPTEL = meleme.NUM(/1)
        NBELT  = meleme.NUM(/2)
 
C  3.6.2 - Recuperation d'informations sur l'element fini du maillage
        MINTE = IPINTE
        NBPGAU = minte.POIGAU(/1)
c*        NBNO   = minte.SHPTOT(/2)
 
C  3.6.3 - Activation du MCHAML contenant les valeurs des sources
        NBPTE1 = MELVA1.VELCHE(/1)
        NEL1   = MELVA1.VELCHE(/2)
 
C  3.6.4 - Element fini BARRe : recuperation de la section
        IF (IFOMOD.NE.0 .AND. IFOMOD.NE.1) THEN
          iBarre = 1
          iVA1 = MELVA2.VELCHE(/1)
          iMin1 = MIN(1,iVA1)
          iMin2 = MIN(2,iVA1)
          iVA2 = MELVA2.VELCHE(/2)
        ELSE
          iBarre = 0
          SMoy = 1.D0
        ENDIF
 
C  3.6.5 - Initialisation du segment de travail MMAT1
        IF(MMAT1 .EQ. 0)THEN
          SEGINI,MMAT1
        ELSEIF(NBPTEL .GT. MMAT1.XEL(/2))THEN
          SEGADJ,MMAT1
        ENDIF
C  3.6.6 - Initialisation du segment resultat MELVAL des valeurs
C          des flux nodaux pour chaque element du maillage (IMAMOD)
        N1PTEL = NBPTEL
        N1EL   = NBELT
        N2PTEL = 0
        N2EL   = 0
        SEGINI,MELVAL
C  3.6.7 - Boucle sur les elements du maillage elementaire IMAMOD
        DO iELT = 1, NBELT
          CALL ZERO(AEL,NBPTEL,NBPTEL)
          CALL DOXE(XCOOR,IDIM,NBPTEL,meleme.NUM,iELT,XEL)
          IF (iBarre.EQ.1) THEN
            i = MIN(iELT,iVA2)
            SMoy = (MELVA2.VELCHE(iMin1,i)+MELVA2.VELCHE(iMin2,i))*0.5D0
          ENDIF
          IF (IDIM.EQ.3) THEN
            DO iGau = 1, NBPGAU
              DLX = XZERO
              DLY = XZERO
              DLZ = XZERO
              DO i = 1, NBPTEL
                r_z = minte.SHPTOT(2,i,iGau)
                DLX = DLX + r_z * XEL(1,i)
                DLY = DLY + r_z * XEL(2,i)
                DLZ = DLZ + r_z * XEL(3,i)
              ENDDO
              Volu = SMoy * SQRT(DLX*DLX+DLY*DLY+DLZ*DLZ)
     &                    * minte.POIGAU(iGau)
              DO i = 1, NBPTEL
                r_z = minte.SHPTOT(1,i,iGau) * Volu
                DO j = 1, NBPTEL
                  AEL(i,j) = AEL(i,j) + minte.SHPTOT(1,j,iGau) * r_z
                ENDDO
              ENDDO
            ENDDO
          ELSE IF (IDIM.EQ.2) THEN
            DO iGau = 1, NBPGAU
              DLX = XZERO
              DLY = XZERO
              DO i = 1, NBPTEL
                r_z = minte.SHPTOT(2,i,iGau)
                DLX = DLX + r_z * XEL(1,i)
                DLY = DLY + r_z * XEL(2,i)
              ENDDO
              Volu = SMoy*SQRT(DLX*DLX+DLY*DLY)*POIGAU(iGau)
              DO i = 1, NBPTEL
                r_z = minte.SHPTOT(1,i,iGau) * Volu
                DO j = 1,NBPTEL
                  AEL(i,j) = AEL(i,j) + minte.SHPTOT(1,j,iGau) * r_z
                ENDDO
              ENDDO
            ENDDO
          ENDIF
          IEMIN = MIN(NEL1,iELT)
          DO i = 1, NBPTEL
            r_z = XZERO
            DO j = 1, NBPTEL
              k = MIN(NBPTE1,j)
              r_z = r_z + MELVA1.VELCHE(k,IEMIN) * AEL(j,i)
            ENDDO
            melval.VELCHE(i,iElt) = r_z
          ENDDO
        ENDDO
C =====
C  Initialisation du MCHAML des flux de chaleur nodaux equivalents
C  (MCHAML) associe au modele elementaire ISOU (maillage IMAMOD)
C  Remplissage des donnees associees a MCHAML dans MCHELM (global)
C =====
C       Recuperation du nom de la composante duale dans le modele
        NOMID  = imodel.LNOMID(2)
 
        N2 = 1
        SEGINI,MCHAML
        NBROBL=NOMID.LESOBL(/2)
        IF(NBROBL .NE. 1)THEN
          CALL ERREUR(21)
          RETURN
        ENDIF
        mchaml.NOMCHE(1) = NOMID.LESOBL(1)
        mchaml.TYPCHE(1) ='REAL*8'
        mchaml.IELVAL(1) = MELVAL
 
        mchelm.CONCHE(ISOU)   = imodel.CONMOD
        mchelm.IMACHE(ISOU)   = MELEME
        mchelm.ICHAML(ISOU)   = MCHAML
        mchelm.INFCHE(ISOU,3) = NIFOUR
        mchelm.INFCHE(ISOU,6) = 1
 
C===
 100  CONTINUE
C===
C Fin de la boucle sur les sous-modeles elementaires
 
      IF(MMAT1 .NE. 0) SEGSUP,MMAT1
 
      END
 
 
 
 

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