Sources Esope | Cast3M

chacoq
C CHACOQ    SOURCE    MB234859  25/09/08    21:15:08     12358          
 
C=======================================================================
C=                            C H A C O Q                              =
C=                            -----------                              =
C=                                                                     =
C=  Fonction :                                                         =
C=  ----------                                                         =
C=   Calcul des flux equivalents a des sources volumiques dans le cas  =
C    des elements COQUEs.                                              =
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=                 (Epaisseur necessaire pour les elements COQUEs)     =
C=   ISUPCH  (E)   Support des champs en entree                        =
C=   IPCHAL  (S)   Pointeur du champ aux noeuds des flux equivalents   =
C=======================================================================
 
      SUBROUTINE CHACOQ (IPMODL,IFORMU, IPCHSO,IPCHEB,ISUPCH, IPCHAL)
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
 
-INC PPARAM
-INC CCOPTIO
-INC CCREEL
 
-INC SMCHAML
-INC SMMODEL
 
      MMODEL = IPMODL
c*      SEGACT,mmodel             &lt;- Actif en E/S (non modifie)
      NSOU = mmodel.KMODEL(/1)
 
      mchelm = IPCHAL
c*      SEGACT,mchelm             &lt;- Actif en E/S et modifiable
c*      NSZC = mchelm.IMACHE(/1)   &lt;- On a ici : NSZC = NSOU
 
      MCHEL1 = IPCHSO
c*      SEGACT,mchel1             &lt;- Actif en E/S (non modifie)
      NSZ1 = mchel1.IMACHE(/1)
 
      mchel2 = IPCHEB
c*      SEGACT,mchel2             &lt;- Actif en E/S (non modifie)
      NSZ2 = mchel2.IMACHE(/1)
 
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*        SEGACT,IMODEL
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 =====
        IPSON1 = 0
        IPSON2 = 0
        IPSON3 = 0
        DO is = 1, NSZ1
          IF (MCHEL1.IMACHE(is).EQ.imodel.IMAMOD .AND.
     &        MCHEL1.CONCHE(is).EQ.imodel.CONMOD) THEN
            mchaml = MCHEL1.ICHAML(is)
            SEGACT,mchaml
            NCOELE = mchaml.NOMCHE(/2)
            ipo1 = 0
            ipo2 = 0
            ipo3 = 0
            CALL PLACE(mchaml.NOMCHE,NCOELE,ipo1,'QINF')
            CALL PLACE(mchaml.NOMCHE,NCOELE,ipo2,'QVOL')
            CALL PLACE(mchaml.NOMCHE,NCOELE,ipo3,'QSUP')
            IF (ipo1.NE.0 .AND. ipo2.NE.0 .AND. ipo3.NE.0) THEN
              IPSON1 = mchaml.IELVAL(ipo1)
              IPSON2 = mchaml.IELVAL(ipo2)
              IPSON3 = mchaml.IELVAL(ipo3)
            ENDIF
            GOTO 10
          ENDIF
        ENDDO
 10     CONTINUE
        IF (IPSON1.EQ.0) GOTO 100
C =====
C  Recherche dans le MCHAML 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)
            SEGACT,mchaml
            NCOELE = mchaml.NOMCHE(/2)
            IPOSI = 0
            CALL PLACE(mchaml.NOMCHE,NCOELE,IPOSI,'EPAI')
            IF (IPOSI.NE.0) THEN
              MELVA2 = mchaml.IELVAL(IPOSI)
            ENDIF
            GOTO 20
          ENDIF
        ENDDO
 20     CONTINUE
        IF (MELVA2.EQ.0) THEN
          MOTERR(1:4) = 'EPAI'
          MOTERR(5:8) = 'CARA'
          CALL ERREUR(77)
          GOTO 100
        ENDIF
C =====
C  Informations sur l'element fini du modele ISOU
C =====
        NEF    = imodel.NEFMOD
        IPOGEO = imodel.IMAMOD
C Recuperation des caracteristiques d'integration
        IPINT1 = 0
        IF (IFORMU.EQ.1 .OR. IFORMU.EQ.2) THEN
          CALL TSHAPE(NEF,'GAUSS',IPINTE)
C                      COQ6        COQ4         COQ8
          IF (NEF.EQ.41 .OR. NEF.EQ.49 .OR. NEF.EQ.56) THEN
            CALL TSHAPE(NEF,'NOEUD',IPINT1)
          ENDIF
        ELSE
C A priori pour l'instant : formulations non prevues
          IPINTE = 0
          IPINT1 = 0
          CALL ERREUR(19)
          GOTO 100
        ENDIF
C =====
C  Calcul des flux nodaux equivalents
C =====
        IPCHQ1 = 0
        IPCHQ2 = 0
        IPCHQ3 = 0
C Element fini de type  COQ2  COQ3
        IF      (NEF.EQ.44 .OR. NEF.EQ.27) THEN
          CALL CHACO1(IPSON1,IPSON2,IPSON3, MELVA2,
     &                IPOGEO, IPINTE,
     &                IPCHQ1,IPCHQ2,IPCHQ3)
C Element fini de type  COQ8  COQ6  COQ4
        ELSE IF (NEF.EQ.41 .OR. NEF.EQ.56 .OR. NEF.EQ.49) THEN
          CALL CHACO2(IPSON1,IPSON2,IPSON3, MELVA2,
     &                IPOGEO, IPINTE,IPINT1,
     &                IPCHQ1,IPCHQ2,IPCHQ3)
        ELSE
          CALL ERREUR(19)
          GOTO 100
        ENDIF
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 = 3
        SEGINI,MCHAML
        NBROBL=NOMID.LESOBL(/2)
        IF(NBROBL .NE. 3)THEN
          CALL ERREUR(21)
          RETURN
        ENDIF
        mchaml.NOMCHE(1) = NOMID.LESOBL(1)
        mchaml.NOMCHE(2) = NOMID.LESOBL(2)
        mchaml.NOMCHE(3) = NOMID.LESOBL(3)
        mchaml.TYPCHE(1) = 'REAL*8'
        mchaml.TYPCHE(2) = 'REAL*8'
        mchaml.TYPCHE(3) = 'REAL*8'
        mchaml.IELVAL(1) = IPCHQ1
        mchaml.IELVAL(2) = IPCHQ2
        mchaml.IELVAL(3) = IPCHQ3
 
        mchelm.CONCHE(ISOU) = imodel.CONMOD
        mchelm.IMACHE(ISOU) = IPOGEO
        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
 
      END