Sources Esope | Cast3M

chaleu
C CHALEU    SOURCE    CB215821  24/04/12    21:15:13     11897          
 
C=======================================================================
C=                            C H A L E U                              =
C=                            -----------                              =
C=                                                                     =
C=  OPERATEUR CAST3M "SOURCE" :                                        =
C=  ---------------------------                                        =
C=   FF1  =  'SOURCE'  MODL1  |  S1  MAIL1  |  ( CARA1 )  ( 'ELEM' ) ; =
C=                            |  CHP1       |                          =
C=                            |  CHEL1      |                          =
C=                                                                     =
C=   Cet operateur sert a calculer les flux nodaux equivalents a une   =
C=   source volumique de chaleur (CHPOINT au second membre)            =
C=                                                                     =
C=  ARGUMENTS :                                                        =
C=  -----------                                                        =
C=   MODL1  (MMODEL)    Modele (global) associe a la structure         =
C=   S1     (FLOTTANT)  Valeur algebrique de la source (constante)     =
C=   MAI1   (MAILLAGE)  Partie de la structure ou on impose la source  =
C=                      de chaleur de valeur S1.                       =
C=   CHP1   (CHPOINT)   Valeurs algebriques des sources aux NOEUDS     =
C=   CHEL1  (MCHAML)    Valeurs algebriques des sources par ELEMENT    =
C=   CARA1  (MCHAML)    Caracteristiques geometriques (utilisees dans  =
C=                      le cas des elements de type COQUE et BARRe)    =
C=                      Sous-type 'CARACTERISTIQUES'                   =
C=                                                                     =
C=  RESULTAT :                                                         =
C=  ----------                                                         =
C=   FF1    (CHPOINT)   Flux nodaux equivalents                        =
C=                                                                     =
C=  Remarques :                                                        =
C=  -----------                                                        =
C=   Le CHPOINT resultat FF1 est de nature DISCRETE.                   =
C=   Si le MOT 'ELEM' (facultatif) est present, le champ resultat FF1  =
C=   est alors un MCHAML aux NOEUDS.                                   =
C=                                                                     =
C=  Denis ROBERT, le 26 fevrier 1988.                                  =
C=======================================================================
 
      SUBROUTINE CHALEU
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
 
-INC PPARAM
-INC CCOPTIO
-INC SMCOORD
 
-INC SMMODEL
-INC SMCHAML
 
      CHARACTER*4 MOTELE(1)
      CHARACTER*(LOCOMP) MOCOMP
      DATA MOTELE / 'ELEM' /
 
      segact mcoord
C  1 - LECTURE DES ARGUMENTS DE L'OPERATEUR
C ==========================================
C  1.1 - Lecture FACULTATIVE du mot 'ELEM'
C =====
      ICLE = 0
      CALL LIRMOT(MOTELE,1,ICLE,0)
C =====
C  1.2 - Lecture OBLIGATOIRE du modele (IPMODL)
C =====
      MOTERR(1:8)='MODELE'
      CALL MESLIR(-137)
      CALL LIROBJ('MMODEL  ',IPMODL,1,IRet)
      CALL ACTOBJ('MMODEL  ',IPMODL,1)
      IF (IERR.NE.0) RETURN
C =====
C  1.3 - Lecture OBLIGATOIRE des sources volumiques donnees par :
C           1) un CHPOINT (IPCHPO)
C        ou 2) d'un maillage (IPGEOM) et d'un flottant (S1)
C        ou 3) d'un MCHAML (IPCHEL)
C =====
      IPCHPO = 0
      S1     = 0.D0
      IPGEOM = 0
      IPCHEL = 0
      CALL MESLIR(-138)
      CALL LIROBJ('CHPOINT ',IPCHPO,0,iret)
      IF (iret.EQ.0) THEN
        CALL MESLIR(-139)
        CALL LIRREE(S1,0,iret)
        IF (iret.NE.0) THEN
          MOTERR(1:8)='MAILLAGE'
          CALL MESLIR(-137)
          CALL LIROBJ('MAILLAGE',IPGEOM,1,iret)
          CALL ACTOBJ('MAILLAGE',IPGEOM,1)
        ELSE
          CALL LIROBJ('MCHAML  ',IPCHEL,1,iret)
          CALL ACTOBJ('MCHAML  ',IPCHEL,1)
        ENDIF
 
      ELSE
        CALL ACTOBJ('CHPOINT ',IPCHPO,1)
      ENDIF
      IF (IERR.NE.0) RETURN
C =====
C  1.4 - Lecture FACULTATIVE du champ de caracteristiques (IPCARA)
C =====
      IPCARA = 0
      IPCAR1 = 0
      CALL MESLIR(-145)
      CALL LIROBJ('MCHAML  ',IPCARA,0,iret)
      IF (iret .EQ. 1) CALL ACTOBJ('MCHAML  ',IPCARA,1)
      IF (IERR.NE.0) RETURN
C =====
C  1.5 - Lecture de la composante de la source (MOCOMP)
C =====
      MOCOMP = ' '
      CALL LIRCHA(MOCOMP,0,iret)
      IF(iret .EQ. 1)THEN
        PRINT *,'Syntaxe non presente dans la notice !'
        CALL ERREUR(5)
      ENDIF
      IF (IERR.NE.0) RETURN
 
C  2 - VERIFICATION DU MODELE A TRAITER
C ======================================
      IPMOD1 = 0
C IPMOD1 : Modele a traiter
C IFORMU : indice correspondant a la formulation
C ITYPEF : indicateur du type d'elements (massif, coque ou barre)
      CALL CHALVM(IPMODL,IPMOD1,IFORMU,ITYPEF)
      IF (IERR.NE.0) GOTO 9900
 
C  3 - ANALYSE DU TERME SOURCE
C =============================
C Reduction du MCHAML de sources si fourni
      IF (IPCHEL.NE.0) THEN
        IPCHMZ = IPCHEL
        CALL REDUAF(IPCHMZ,IPMOD1,IPCHEL,0,iok,kerre)
        IF (iok.NE.1) CALL ERREUR(kerre)
        IF (IERR.NE.0) GOTO 9900
C Si IPCHEL, verif. si caracteristiques sont dans MCHAML source
        IF (IPCARA.EQ.0.AND.(ITYPEF.EQ.2.OR.ITYPEF.EQ.3)) THEN
          CALL ECRCHA('GEOM')
          CALL ECROBJ('MMODEL  ',IPMOD1)
          CALL EXTRAI
          IF (IERR.NE.0) GOTO 9900
          CALL LIROBJ('LISTMOTS',MLMOT1,1,IRET)
          IF (IERR.NE.0) GOTO 9900
          CALL EXCOC2(IPCHEL,MLMOT1,IPCAR1,MLMOT1,1)
          IF (IERR.NE.0) GOTO 9900
          IPCARA = IPCAR1
        ENDIF
      ENDIF
C Mise sous forme de MCHAML des donnees d'entrees et
C Determination du support du MCHAML de sources
      CALL CHALVS(IPMOD1,IFORMU,ITYPEF, IPCHPO,S1,IPGEOM,IPCHEL,
     &            IPCHSO,ISUPSO)
      IF (IERR.NE.0) GOTO 9900
 
C  4 - ANALYSE DU CHAMP DE CARACTERISTIQUES
C ==========================================
C  Verification de l'existence des caracteristiques
C  dans le cas d'elements COQUEs et BARREs.
C  Si IPCHEL, verif. si caracteristiques sont dans MCHAML source
      IF (IPCARA.EQ.0) THEN
        IF (ITYPEF.EQ.2) THEN
          CALL ERREUR(514)
        ELSE IF (ITYPEF.EQ.3) THEN
          CALL ERREUR(518)
        ENDIF
        IF (IERR.NE.0) GOTO 9900
      ELSE
C En elements MASSIFs, aucune caracteristique n'est necessaire.
        IF (ITYPEF.EQ.1) IPCARA = 0
      ENDIF
      IF (IPCARA.NE.0) THEN
        IPCHMZ = IPCARA
        CALL REDUAF(IPCHMZ,IPMOD1,IPCARA,0,iok,kerre)
        IF (iok.NE.1) CALL ERREUR(kerre)
        IF (IERR.NE.0) GOTO 9900
C
        mchelm = IPCARA
        SEGACT,mchelm
        IF (mchelm.titche.NE.'CARACTERISTIQUES') THEN
          MOTERR(1:16) = 'CARACTERISTIQUES'
          CALL ERREUR(291)
C         SEGDES,mchelm
          GOTO 9900
        ENDIF
      ENDIF
 
C  5 - CALCUL DES FLUX NODAUX EQUIVALENTS
C ========================================
      CALL CHAL1(IPMOD1,IFORMU,ITYPEF, IPCHSO,ISUPSO, IPCARA, IPCHAL)
      IF (IERR.NE.0 .OR. IPCHAL.EQ.0) GOTO 9900
 
C  6 - ECRITURE DE L'OBJET RESULTAT (CHPOINT OU MCHAML)
C ======================================================
      IF (ICLE.EQ.0) THEN
        CALL CHAMPO(IPCHAL,0,IPCHAP,iret)
C= Le resultat est un CHPOINT de nature DISCRETE.
        MCHEL1=IPCHAL
        SEGSUP,MCHEL1
        IF (iret.NE.1 .OR. IERR.NE.0) RETURN
        CALL ACTOBJ('CHPOINT ',IPCHAP,1)
        CALL ECROBJ('CHPOINT ',IPCHAP)
      ELSE
        CALL ACTOBJ('MCHAML  ',IPCHAL,1)
        CALL ECROBJ('MCHAML  ',IPCHAL)
      ENDIF
 
C  7 - FIN
C =========
 9900 CONTINUE
      IF (IPMOD1.NE.0 .AND. IPMOD1 .NE. IPMODL) THEN
        MMODE1 = IPMOD1
        SEGSUP,MMODE1
      ENDIF
      IF (IPCAR1.NE.0 .AND. IPCAR1 .NE. IPCHEL) THEN
        MCHEL1 = IPCAR1
        SEGSUP,MCHEL1
      ENDIF
 
      END