C CONVEC    SOURCE    CHAT      12/06/07    21:15:10     7389           

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 CCOPTIO
-INC SMMODEL
-INC SMCHPOI

      PARAMETER (NBRAC=7,NP=6)
      INTEGER IRAC(NBRAC)
      CHARACTER*4 MOCNV(1)

      DATA MOCNV(1) / 'T   ' /

C Elem. RACCORD : RAC2 RAC3 LIA3 LIA4 LIA6 LIA8 SEG2
C Cas Particulier : en 1D, SEG2 = element RACCORD (OF)
C ---------------
      DATA IRAC /  12 , 13 , 18 , 19 , 20 , 21 ,  2  /

C Petit traitement pour le cas 1D : on simule l'element raccord 1D via
C un element fini SEG2 (cela evite de creer un nouvel element fini)
      IF (IDIM.EQ.1) THEN
        KRACC=7
        NRACC=1
      ELSE
        KRACC=1
        NRACC=NP
      ENDIF

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',IPMODE,1,IRET)
      IF (IERR.NE.0) RETURN
      call selmod (ipmode,ipmod1,'CONVECTION')
      call selmod ( ipmode,ipmod2,'RAYONNEMENT')
      mmode1=ipmod1
      mmode2=ipmod2
      segact mmode1,mmode2
      if( mmode1.kmodel(/1).eq.0) then 
        ipmode=mmode2
        segsup mmode1
      elseif( mmode2.kmodel(/1).eq.0) then 
        ipmode=mmode1
        segsup mmode2
      else
        n1= mmode1.kmodel(/1)+mmode2.kmodel(/1)
        na=mmode1.kmodel(/1)
        segadj mmode1        
        do io=1,mmode2.kmodel(/1)
          mmode1.kmodel(na+io)= mmode2.kmodel(io)
        enddo
        segsup mmode2
        ipmode=mmode1
      endif
           
C =====
C  1.2 - Lecture OBLIGATOIRE du champ de caracteristiques (IPCHEL)
C =====
      CALL MESLIR(-145)
      CALL LIROBJ('MCHAML',IPCHEL,1,IRET)
      IF (IERR.NE.0) RETURN
C =====
C  1.3 - Lecture OBLIGATOIRE des temperatures exterieures donnees par :
C           1) un CHPOINT (IPCHPO)
C        ou 2) un mot ('T   ') et un flottant (TE)
C =====
      CALL MESLIR(-146)
      CALL LIROBJ('CHPOINT',IPCHPO,0,IRET1)
      IF (IERR.NE.0) RETURN
      IF (IRET1.EQ.1) THEN
        CALL ECRCHA('GEOM')
        CALL ECROBJ('CHPOINT',IPCHPO)
        CALL COPIER
        CALL LIROBJ('CHPOINT',IPCHP2,0,IRET)
        IF (IERR.NE.0) RETURN
      ELSE
        CALL LIRMOT(MOCNV,1,IRET,1)
        IF (IERR.NE.0) RETURN
        CALL MESLIR(-147)
        CALL LIRREE(TE,1,IRET)
        IF (IERR.NE.0) RETURN
        CALL EXTRA8(IPMODE,IPGEOM)
        IF (IERR.NE.0) RETURN
        CALL MANUC2(TE,IPGEOM,1,IPCHP2)
        IF (IERR.NE.0) RETURN
      ENDIF

C  2 - EXTRACTION DES ELEMENTS RACCORDS DU MODELE (s'ils existent)
C ================================================
      MMODEL=IPMODE
      SEGACT,MMODEL
      NSOU=KMODEL(/1)
      JRac=0
      N1=NSOU
      SEGINI,MMODE1
      DO iSou=1,NSOU
        IMODEL=KMODEL(iSou)
        SEGACT,IMODEL
        NFOR=FORMOD(/2)
        nmat=matmod(/2)
        CALL PLACE(FORMOD,NFOR,IMO,'CONVECTION')
        call place (matmod,nmat,imoo,'CONVECTION') 
        CALL PLACE2(IRAC(KRACC),NRACC,IOK,NEFMOD)
        IF (IOK.NE.0.AND.IMO+imoo.NE.0) THEN
          JRac=JRac+1
        ELSE
          MMODE1.KMODEL(iSou-JRac)=KMODEL(iSou)
        ENDIF
        SEGDES,IMODEL
      ENDDO
      N1=NSOU-JRac
C= Reduction du modele initial au modele sans elements raccords
      IF (N1.NE.0.AND.N1.NE.NSOU) THEN
        SEGADJ,MMODE1
        IPMODE1=MMODE1
        SEGDES,MMODE1
        CALL REDUAF(IPCHEL,IPMODE1,IPCHE1,0,IRET,KERRE)
        IF (IRET.NE.1) THEN 
          CALL ERREUR(KERRE)
          RETURN
        ENDIF
*
        IPCHEL=IPCHE1
C= Cas particulier du modele ne contenant que des elements raccords
C= Le champ de flux nodaux equivalents est vide.
      ELSE IF (N1.EQ.0) THEN
        NSOUPO=0
        NAT=1
        SEGINI,MCHPOI
        MTYPOI='CHALEUR '
        JATTRI(1)=2
C*      IFOPOI=IFOMOD
        IFOPOI=IFOUR
        SEGDES,MCHPOI
        CALL ECROBJ('CHPOINT',MCHPOI)
        RETURN
      ELSE
        IPMODE1=IPMODE
      ENDIF

C  3 - CALCUL DES FLUX NODAUX EQUIVALENTS
C ========================================
      CALL CONVMA(IPMODE1,IPCHEL,IPCHP2,IPCONV)
      IF (IERR.NE.0) GOTO 10

C  4 - ECRITURE DU CHPOINT RESULTAT
C ==================================
C= Attribution d'une nature DISCRETE au CHPOINT resultat
      IF (IPCONV.NE.0) THEN
        MCHPOI=IPCONV
        SEGACT,MCHPOI
        NAT=MAX(JATTRI(/1),1)
        NSOUPO=IPCHP(/1)
        SEGADJ,MCHPOI
        JATTRI(1)=2
        SEGDES,MCHPOI
        CALL ECROBJ('CHPOINT',IPCONV)
      ENDIF

C  5 - MENAGE : Destruction de CHPOINT intermediaire
C ==============
 10   CALL DTCHPO(IPCHP2)

      RETURN
      END