Sources Esope | Cast3M

flux
C FLUX      SOURCE    CB215821  24/04/12    21:16:00     11897          
 
C=======================================================================
C=                              F L U X                                =
C=                              -------                                =
C=                                                                     =
C=  OPERATEUR CAST3M "FLUX" :                                          =
C=  -------------------------                                          =
C=  FF1  =  'FLUX'  MODL1  | VFLU  MAI1 ( 'DIRE' POI1 ) | ( 'PEAU' ) ; =
C=                         | CH1                        |              =
C=                         | CH2  LMOTS                 |              =
C=                                                                     =
C=  Cet operateur sert a calculer les flux nodaux equivalents a une    =
C=  condition de flux de chaleur impose (CHPOINT au second membre).    =
C=                                                                     =
C=  ARGUMENTS :                                                        =
C=  -----------                                                        =
C=   MODL1  (MMODEL)    Modele (global) associe a la structure         =
C=   VFLU   (FLOTTANT)  Valeur algebrique du flux (constante)          =
C=   MAI1   (MAILLAGE)  Partie de la structure ou on impose le flux de =
C=                      chaleur de valeur VFLU.                        =
C=   CH1 (CHPOINT ou MCHAML)   Valeurs algebriques des flux            =
C=   'DIRE' (MOT)       Indique que le flux est incline par rapport a  =
C=                      a la normale a la (sur)face                    =
C=   POI1   (POINT)     Direction du flux dans le repere global        =
C=   CH2   (CHPOINT ou MCHAML)   Champ a plusieurs composantes         =
C=   LMOTS  (LISTMOTS)  Liste des composantes de CH2, la premiere est  =
C=                      associee a la direction X, la deuxieme a Y et  =
C=                      la troisieme a Z (en 3D)                       =
C=   PEAU   (MOT)       Indique la peau etudie dans le cas des COQUES  =
C=                                                                     =
C=  RESULTAT :                                                         =
C=  ----------                                                         =
C=   FF1     (CHPOINT)  Flux nodaux equivalents a la condition de flux =
C=                      de nature DISCRETE                             =
C=                                                                     =
C=  CREATION / MODIF :                                                 =
C=  ------------------                                                 =
C=  Creation : Denis ROBERT, le 25 janvier 1988.                       =
C=  Modif    : BP, 30/07/2013 : ajout de la possibilité que CH1 et CH2 =
C=             soient des MCHAML                                       =
C=                                                                     =
C=======================================================================
 
      SUBROUTINE FLUX
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
 
-INC PPARAM
-INC CCOPTIO
-INC SMCHPOI
-INC SMLMOTS
-INC SMMODEL
 
      PARAMETER (NP=2)
      CHARACTER*4 PEAU
      CHARACTER*4 MOPEAU(NP),MOFLU(1)
      CHARACTER*(LOCOMP) MOCOMP
 
      DATA MOPEAU / 'INFE','SUPE' /
      DATA MOFLU  / 'DIRE' /
 
C  1 - LECTURE DES ARGUMENTS DE L'OPERATEUR
C ==========================================
C  1.1 - Lecture OBLIGATOIRE du modele (IPMODL)
C =====
      MOTERR(1:8)=' MODELE '
      CALL MESLIR(-137)
      CALL LIROBJ('MMODEL  ',IPMODL,1,iOK)
      CALL ACTOBJ('MMODEL  ',IPMODL,1)
      IF (IERR.NE.0) RETURN
C =====
C  1.2 - Lecture OBLIGATOIRE des flux de chaleur donnes par :
C           1) un CHPOINT (IPCHPO) avec ou sans LISTMOTS (MLMOTX)
C        ou 2) un MCHAML (-IPCHPO) avec ou sans LISTMOTS (MLMOTX)
C        ou 3) un maillage (IPGEOM) et un flottant (VALFLU)
C =====
      IPCHPO=0
      MLMOTX=0
      VALFLU=0.
      CALL MESLIR(-164)
      CALL LIROBJ('CHPOINT ',IPCHPO,0,iOK)
      IF(iOK.EQ.1) CALL ACTOBJ('CHPOINT ',IPCHPO,1)
      IF (IERR.NE.0) RETURN
 
cbp : on ajoute la possibilité de lire un mchaml
      IF (iOK.EQ.0) THEN
        CALL LIROBJ('MCHAML  ',IPIN,0,iOK)
        IF (IERR.NE.0) RETURN
        IPCHPO=0
        IF (iOK .EQ. 1) THEN
          CALL ACTOBJ('MCHAML  ',IPIN,1)
          CALL REDUAF(IPIN,IPMODL,IPCHPO,0,IR,KER)
          IF(IR   .NE. 1) CALL ERREUR(KER)
          IF(IERR .NE. 0) RETURN
          IPCHPO = -1*IPCHPO
        ENDIF
      ENDIF
 
      IF (iOK.EQ.1) THEN
        CALL LIROBJ('LISTMOTS',MLMOTX,0,iOK)
        IF (IERR.NE.0) RETURN
        IF (MLMOTX.NE.0) THEN
          MLMOTS=MLMOTX
          SEGACT,MLMOTS
          NCOMP = MOTS(/2)
          IF (NCOMP.NE.IDIM) THEN
            CALL ERREUR(21)
            RETURN
          ENDIF
        ENDIF
        IPCHP2 = IPCHPO
 
      ELSE
        CALL MESLIR(-163)
        CALL LIRREE(VALFLU,1,iOK)
        IF (IERR.NE.0) RETURN
        MOTERR(1:8)='MAILLAGE'
        CALL MESLIR(-137)
        CALL LIROBJ('MAILLAGE',IPGEOM,1,iOK)
        CALL ACTOBJ('MAILLAGE',IPGEOM,1)
        IF (IERR.NE.0) RETURN
        CALL MANUC2(VALFLU,IPGEOM,1,IPCHP2)
        IF (IERR.NE.0) RETURN
      ENDIF
 
C =====
C  1.3 - Lecture FACULTATIVE du MOT 'DIRE' et du vecteur associe
C =====
      NUMPOI=-1
      CALL LIRMOT(MOFLU,1,iOK,0)
      IF (iOK.NE.0) THEN
        CALL MESLIR(-162)
        CALL LIROBJ('POINT',NUMPOI,1,iOK)
        IF (IERR.NE.0) GOTO 10
      ENDIF
C =====
C  1.4 - Lecture FACULTATIVE du MOT associe a la PEAU (cas des COQUES)
C =====
      PEAU='    '
      CALL MESLIR (-260)
      CALL LIRMOT(MOPEAU,NP,LP,0)
      IF (IERR.NE.0) GOTO 10
      IF (LP.NE.0) PEAU=MOPEAU(LP)
 
C  2 - EXTRACTION DE LA FORMULATION A TRAITER DU MODELE
C ======================================================
C  2.1 - Verification de la formulation (unique) du modele
C =====
      ITHER = 0
      ITHHY = 0
      IELEC = 0
      IDIFF = 0
      MMODEL = IPMODL
      NSOUS = KMODEL(/1)
      DO ISOUS = 1, NSOUS
        IMODEL = KMODEL(ISOUS)
        NFOR = FORMOD(/2)
        IF (NFOR.EQ.1) THEN
          IF (FORMOD(1).EQ.'THERMIQUE') THEN
            ITHER = 1
          ELSE IF (FORMOD(1).EQ.'THERMOHYDRIQUE') THEN
            ITHHY = 1
          ELSE IF (FORMOD(1).EQ.'ELECTROSTATIQUE') THEN
            IELEC = 1
          ELSE IF (FORMOD(1).EQ.'DIFFUSION') THEN
            IDIFF = 1
          ELSE
            MOTERR(1:8) = FORMOD(1)
            CALL ERREUR(193)
          ENDIF
        ELSE IF (NFOR.GT.1) THEN
          MOTERR(1:8) = FORMOD(1)
          CALL ERREUR(193)
        ENDIF
      ENDDO
 
      IF (IERR.NE.0) GOTO 10
      IF ((ITHER+ITHHY+IELEC+IDIFF).NE.1) THEN
*AV Affiner l'erreur !
        write(ioimp,*) 'Une seule formulation dans le modele !'
        CALL ERREUR(21)
        GOTO 10
      ENDIF
C =====
C  2.2 - Recuperation du modele de la formulation retenue
C =====
      IF (ITHER .EQ. 1) CALL ECRCHA('THERMIQUE')
      IF (ITHHY .EQ. 1) CALL ECRCHA('THERMOHYDRIQUE')
      IF (IELEC .EQ. 1) CALL ECRCHA('ELECTROSTATIQUE')
      IF (IDIFF .EQ. 1) CALL ECRCHA('DIFFUSION')
      CALL ECRCHA('FORM')
      CALL ECROBJ('MMODEL',IPMODL)
      CALL EXTRAI
      CALL LIROBJ('MMODEL',IPMODL,1,IRet)
      IF (IERR.NE.0) GOTO 10
C =====
C  2.3 - Adequation nom de composante source & modele
C =====
      MOCOMP = '    '
      IF (ITHER .EQ. 1) THEN
        IF (MOCOMP.EQ.'    ') MOCOMP = 'Q   '
        IF (MOCOMP.NE.'Q   ') CALL ERREUR(665)
C* A finir pour la thermohydrique
      ELSE IF (ITHHY .EQ. 1) THEN
        MOCOMP = 'Q   '
      ELSE
        IPCOMP = 0
        CALL NOVARD(IPMODL,'FORC')
        CALL LIROBJ('LISTMOTS',IPCOMP,1,IRet)
        IF (IERR.NE.0) RETURN
        MLMOTS = IPCOMP
        SEGACT,MLMOTS
        NCOMP = MOTS(/2)
* Normalement : NCOMP est non nul !
* Cas particulier de la diffusion en attendant un traitement adequat ?
        IF (IDIFF.EQ.1 .AND. NCOMP.GT.1) THEN
          write(ioimp,*) 'Modele de DIFFUSION a une seule quantite SVP'
          CALL ERREUR(21)
        ENDIF
        IF (MOCOMP.EQ.'    ') MOCOMP = MOTS(1)
        CALL PLACE(MOTS,NCOMP,IRet,MOCOMP)
        IF (IRet.EQ.0) CALL ERREUR(665)
        SEGSUP,MLMOTS
      ENDIF
      IF (IERR.NE.0) GOTO 10
 
C  3 - CALCUL DES FLUX NODAUX EQUIVALENTS
C ========================================
      IPFLUX=0
      CALL FLUX2(IPMODL,IPCHP2,NUMPOI,MOCOMP,PEAU,MLMOTX,IPFLUX)
      IF (IERR.NE.0) GOTO 10
 
C  4 - ECRITURE DU CHPOINT RESULTAT
C ==================================
C= Attribution d'une nature DISCRETE au CHPOINT resultat
      IF (IPFLUX.NE.0) THEN
        MCHPOI=IPFLUX
        NAT=MAX(1,JATTRI(/1))
        NSOUPO=IPCHP(/1)
        SEGADJ,MCHPOI
        JATTRI(1)=2
        IPFLUX=MCHPOI
 
        CALL ACTOBJ('CHPOINT ',IPFLUX,1)
        CALL ECROBJ('CHPOINT ',IPFLUX)
      ENDIF
 
C  5 - MENAGE : Destruction eventuelle de CHPOINT intermediaire 
c               si syntaxe avec maillage en argument d'entree
C ==============
 10   CONTINUE
      IF (IPCHPO.EQ.0) CALL DTCHPO(IPCHP2)
 
      END