Sources Esope | Cast3M

convec
C CONVEC    SOURCE    OF166741  24/08/06    21:15:02     11982          
 
C=======================================================================
C=                            C O N V E C                              =
C=                            -----------                              =
C=                                                                     =
C=  OPERATEUR CAST3M "CONVEC" :                                        =
C=  ---------------------------                                        =
C=  FF1  =  'CONVECTION'  MODL1  MAT1  |  'T   ' TE  |  ;              =
C=                                     |  CHPTE      |                 =
C=                                                                     =
C=  Cet operateur sert a calculer les flux nodaux equivalents a une    =
C=  condition de type convection forcee (CHPOINT au second membre).    =
C=                                                                     =
C=  ARGUMENTS :                                                        =
C=  -----------                                                        =
C=   MODL1  (MMODEL)    Modele de la structure (contour ou enveloppe)  =
C=   MAT1   (MCHAML)    Caracteristiques : coefficient d'echange       =
C=   'T   ' (MOT)       Precise que la temperature du milieu exterieur =
C=                      imposee est constante (flottant suivant)       =
C=   TE     (FLOTTANT)  Valeur de la temperature imposee (constante)   =
C=   CHPTE  (CHPOINT)   Valeurs des temperatures aux NOEUDS            =
C=                                                                     =
C=  RESULTAT :                                                         =
C=  ----------                                                         =
C=   FF1     (CHPOINT)  Flux nodaux equivalents                        =
C=   Le CHPOINT resultat FF1 est de nature DISCRETE.                   =
C=                                                                     =
C=  Denis ROBERT, le 15 avril 1988.                                    =
C=======================================================================
 
      SUBROUTINE CONVEC
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
 
-INC SMCOORD
-INC SMMODEL
-INC SMCHPOI
-INC SMELEME
 
      PARAMETER (NBMOCV=3)
      CHARACTER*(LOCOMP) MOCNV(NBMOCV),MOCOMP
      CHARACTER*(8) TYPOBJ
 
      DATA MOCNV/ 'T   ','TINF','TSUP' /
 
      IPMODE = 0
      IPMODC = 0
      IPCHCA = 0
      IPCHTE = 0
      valeTE = 0.D0
      IPCHPT = 0
      IPCONV = 0
 
C  1 - LECTURE DES ARGUMENTS DE L'OPERATEUR
C ==========================================
C  1.1 - Lecture OBLIGATOIRE du modele (IPMODE)
C =====
      MOTERR(1:8)=' MODELE '
      CALL MESLIR(-137)
      TYPOBJ = 'MMODEL  '
      CALL LIROBJ(TYPOBJ,IPMODE,1,iret)
      IF (IERR.NE.0) RETURN
 
C =====
C  1.2 - Lecture OBLIGATOIRE du champ de caracteristiques (IPCHEL)
C =====
      CALL MESLIR(-145)
      TYPOBJ = 'MCHAML  '
      CALL LIROBJ(TYPOBJ,IPCHEL,1,iret)
      IF (IERR.NE.0) RETURN
 
C =====
C  1.3 - Lecture OBLIGATOIRE des temperatures exterieures donnees par :
C           1) un CHPOINT (IPCHTE)
C        ou 2) un mot ('T   ') et un flottant (valeTE)
C =====
      CALL MESLIR(-146)
      TYPOBJ = 'CHPOINT '
      CALL LIROBJ(TYPOBJ,IPCHTE,0,iret)
      IF (IERR.NE.0) RETURN
      IF (IPCHTE.EQ.0) THEN
        CALL LIRCHA(MOCOMP,1,iret)
        IF (IERR.NE.0) RETURN
        iret = 0
        CALL PLACE(MOCNV,NBMOCV,iret,MOCOMP)
        IF (iret .EQ. 0) THEN
          MOTERR=MOCOMP
          CALL ERREUR(197)
          RETURN
        ENDIF
        CALL MESLIR(-147)
        CALL LIRREE(valeTE,1,iret)
        IF (IERR.NE.0) RETURN
      ENDIF
 
C  2 - ANALYSE DES ARGUMENTS
C ===========================
C  2.1 - Le modele (IPMODE)
C =====
      TYPOBJ = 'MMODEL  '
      CALL ACTOBJ(TYPOBJ,IPMODE,1)
      IF (IERR.NE.0) RETURN
 
C Modele THERMIQUE 'CONVECTION' sans RACCORD et 'RAYONNEMENT'
      CALL SELMOD(IPMODE,IPMODC)
      mmodel = IPMODC
*      segact,mmodel
      N1C = mmodel.kmodel(/1)
 
C= Cas particulier du modele ne contenant que des elements raccords
C= Le champ de flux nodaux equivalents est vide.
      IF (N1C.EQ.0) THEN
        NSOUPO=0
        NAT=1
        SEGINI,MCHPOI
        MTYPOI='CHALEUR '
        JATTRI(1)=2
        IFOPOI=IFOUR
        IPCONV = MCHPOI
        GOTO 900
      ENDIF
 
C =====
C  2.2 - Champ de caracteristiques (IPCHEL)
C =====
      TYPOBJ = 'MCHAML  '
      CALL ACTOBJ(TYPOBJ,IPCHEL,1)
      IF (IERR.NE.0) GOTO 990
      CALL REDUAF(IPCHEL,IPMODC,IPCHCA,0,ir,ker)
      IF (ir   .NE. 1) CALL ERREUR(ker)
      IF (IERR .NE. 0) GOTO 990
 
C =====
C  2.3 - Temperatures exterieures (IPCHPT)
C =====
      IF (IPCHTE.NE.0) THEN
        IPCHPT = IPCHTE
      ELSE
C       Extraction du MAILLAGE du MODELE
        CALL EXTRA8(IPMODC,IPGEOM)
        IF (IERR.NE.0) GOTO 990
        CALL CHANGE(IPGEOM,1)
        IF (IERR.NE.0) GOTO 990
        MELEME = IPGEOM
*        SEGACT,MELEME
 
C       Creation d'un CHPOINT de composante MOCOMP et de valeur TE
        NSOUPO=1
        NAT   =1
        SEGINI,MCHPOI
        MTYPOI = '        '
        MOCHDE = ' '
        IFOPOI = IFOMOD
C       NATURE 'DIFFUS'
        JATTRI(1)=1
        NC=1
        N =NUM(/2)
        SEGINI,MSOUPO,MPOVAL
        IPCHP(1) = MSOUPO
        NOCOMP(1)= MOCOMP
        IGEOC    = IPGEOM
        IPOVAL   = MPOVAL
        DO io = 1, N
          mpoval.vpocha(io,1) = valeTE
        ENDDO
        IPCHPT = MCHPOI
      ENDIF
      TYPOBJ = 'CHPOINT '
      CALL ACTOBJ(TYPOBJ,IPCHPT,1)
 
      segact,mcoord*nomod
 
C  3 - CALCUL DES FLUX NODAUX EQUIVALENTS
C ========================================
      CALL CONVMA(IPMODC,IPCHCA,IPCHPT,IPCONV)
      IF (IERR.NE.0) GOTO 990
 
C  4 - ECRITURE DU CHPOINT RESULTAT
C ==================================
C= Attribution d'une nature DISCRETE au CHPOINT resultat
 900  CONTINUE
      IF (IPCONV.NE.0) THEN
        MCHPOI=IPCONV
        NAT=MAX(JATTRI(/1),1)
        NSOUPO=IPCHP(/1)
        SEGADJ,MCHPOI
        JATTRI(1)=2
        TYPOBJ = 'CHPOINT '
        CALL ACTOBJ(TYPOBJ,IPCONV,1)
        CALL ECROBJ(TYPOBJ,IPCONV)
      ENDIF
 
C  5 - MENAGE :
C ==============
 990  CONTINUE
      IF (IPCHTE.EQ.0) CALL DTCHPO(IPCHPT)
 
c      return
      END