C CONVMA    SOURCE    CHAT      11/03/16    21:18:04     6902           

C=======================================================================
C=                            C O N V M A                              =
C=                            -----------                              =
C=                                                                     =
C=  Fonction :                                                         =
C=  ----------                                                         =
C=   Calcul des flux nodaux equivalents a une condition de convection  =
C=   forcee. Sousprogramme appele par CONVEC (convec.eso).             =
C=                                                                     =
C=  Parametres :  (E)=Entree   (S)=Sortie                              =
C=  ------------                                                       =
C=   IPMODE   (E)   Pointeur sur le segment MMODEL                     =
C=   IPCHEL   (E)   Pointeur sur le segment MCHELM de CARACTERISTIQUES =
C=   IPCHPO   (E)   Pointeur sur le CHPOINT contenant la temperature   =
C=                  exterieure le long de la surface de convection     =
C=   IPCONV   (S)   Pointeur sur le champ des flux equivalents         =
C=                                                                     =
C=  Variables locales :                                                =
C=  -------------------                                                =
C=   IPGEOM   Pointeur sur un MAILLAGE elementaire du CHPOINT          =
C=   IPOGEO   Pointeur sur un MAILLAGE commun au CHPOINT et au MASSIF  =
C=                                                                     =
C=  Denis ROBERT, le 28 avril 1988.                                    =
C=======================================================================

      SUBROUTINE CONVMA (IPMODE,IPCHEL,IPCHPO,IPCONV)

      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)

-INC CCOPTIO
-INC CCHAMP
-INC SMCHAML
-INC SMCHPOI
-INC SMMODEL
-INC SMELEME
      logical ltelq
      SEGMENT MPTVAL
        INTEGER IPOS(NS),NSOF(NS),IVAL(NCOSOU)
        CHARACTER*16 TYVAL(NCOSOU)
      ENDSEGMENT
      SEGMENT NOTYPE
        CHARACTER*16 TYPE(NBTYPE)
      ENDSEGMENT
      PARAMETER (NINF=3)
      INTEGER INFOS(NINF)
      CHARACTER*(NCONCH) CONM
      CHARACTER*4 nomatt,nomcq
      CHARACTER*10 PEAU

      IPCONV=0

C  1 - QUELQUES TRANSFORMATIONS SUR LES DONNEES
C ==============================================
C  1.1 - Changement de support du MCHAML de caracteristiques (noeuds ->
C        points de Gauss) puis transformation de ce MCHAML en CHPOINT
C =====
*      IPCHE1=0
*      IPCHCA=0
*      CALL CHASUP(IPMODE,IPCHEL,IPCHE1,iOK,1)
*      IF (iOK.NE.0) THEN
*        CALL ERREUR(iOK)
**        RETURN
*      ENDIF
*      CALL CHAMPO(IPCHE1,1,IPCHCA,iOK)
*      CALL DTCHAM(IPCHE1)
*      IF (iOK.EQ.0) RETURN
C =====
C  1.2 - Creation d'un objet MAILLAGE contenant une seule fois tous les
C        points du CHPOINT IPCHPO (fusion des maillages supports de tous
C        les MSOUPO)
C =====
      MCHPOI=IPCHPO
      SEGACT,MCHPOI
      MSOUPO=IPCHP(1)
      SEGACT,MSOUPO
      IPGEOM=IGEOC
      SEGDES,MSOUPO
      DO i=2,IPCHP(/1)
        MSOUPO=IPCHP(i)
        SEGACT,MSOUPO
        IGEO1=IGEOC
        SEGDES,MSOUPO
        ltelq=.false.
        CALL FUSE(IPGEOM,IGEO1,IRET,ltelq)
        IF (IERR.NE.0) GOTO 100
        IPGEOM=IRET
      ENDDO
      SEGDES,MCHPOI
C =====
C  1.3 - Activation du MMODEL
C =====
      MMODEL=IPMODE
      SEGACT,MMODEL
      NSOUS=KMODEL(/1)

C  2 - BOUCLE SUR LES ZONES ELEMENTAIRES DU MODELE (iSou)
C ========================================================
      IRRT=0
      DO iSou=1,NSOUS
        iOK=0
C =====
C  2.1 - Activation du sous-modele (iSou)
C =====
        IMODEL=KMODEL(iSou)
        SEGACT,IMODEL
        PEAU='          '
        IF (MATMOD(/1).NE.0) PEAU=MATMOD(1)
*   RECUPERATION DES CARACTERISTIQUES D'INTEGRATION
        NEF=NEFMOD
        NLG=NUMGEO(NEF)
        CALL TSHAPE(NLG,'GAUSS',IPINTE)
        IF (IERR.NE.0) THEN
          CALL ERREUR(251)
          GOTO 50
        ENDIF
        IF (NEF.EQ.44.OR.NEF.EQ.27.OR.NEF.EQ.56.OR.NEF.EQ.49.OR.
     .      NEF.EQ.41) THEN
          IF (PEAU.EQ.'INFERIEURE') THEN
            nomcq='QINF'
          ELSE
            nomcq='QSUP'
          ENDIF
        ELSE
          nomcq='Q   '
        ENDIF
*  ON RECUPERE LES MAILLAGES ELEMENTAIRES DU MODELE, QUI SONT
*  APPUYES STRICTEMENT SUR LE CHPOINT
*        ITGEOM=IMAMOD
*        CALL ECROBJ('MAILLAGE',IPGEOM)
*        CALL ECRCHA('STRI')
*        CALL ECRCHA('APPU')
*       CALL ECROBJ('MAILLAGE',ITGEOM)
*       CALL EXTREL(IRR,0,i)
*  ON N'A PAS TROUVE DE MAILLAGE COMMUN A CETTE PARTIE DE
*  L'ENVELOPPE ET DU CHPOINT
*        IF (IRR.NE.0) THEN
*          IRRT=IRRT+1
*          iOK=1
*          GOTO 50
*        ENDIF
*        CALL LIROBJ('MAILLAGE',IPOGEO,1,IRET)
*        IF (IERR.NE.0) GOTO 50
*    ON DESIRE CONNAITRE LES CARACTERISTIQUES DE CES MAILLAGES
*        IPT3=IPOGEO
*        SEGACT,IPT3
*        ipt3=imamod
*        NSOU3=IPT3.LISOUS(/1)
*        IF (NSOU3.EQ.0) THEN
*          NBN2=IPT3.NUM(/1)
*        ENDIF
*    BOUCLE SUR LES ZONES DE CET OBJET GEOMETRIQUE
*        DO IMAIL=1,MAX(1,NSOU3)
*          iOK=0
*          IF (NSOU3.NE.0) THEN
*            IPT2=IPT3.LISOUS(IMAIL)
*            SEGACT,IPT2
*            IPOGEO=IPT2
*            NBN2=IPT2.NUM(/1)
*            SEGDES,IPT2
*          ENDIF
*    ON GENERE UN CHAMELEM ELEMENTAIRE A PARTIR DU CHPOINT
*    DE SOURCE ET DU MAILLAGE ELEMENTAIRE DE POINTEUR IPOGEO


          IPMAIL=IMAMOD
          CONM=CONMOD
          CALL CHAME1(IPMAIL,0,IPCHPO,' ',ICHELS,1)
          MCHEL1=ICHELS
          IF (IERR.NE.0) GOTO 30
          SEGACT,MCHEL1
          MCHAM1=MCHEL1.ICHAML(1)
          SEGACT,MCHAM1
* recherche de la bonne composante
          ivfr=1
          IF (MCHAM1.IELVAL(/1).NE.1) THEN
            nomatt='T   '
            IF (PEAU.EQ.'SUPERIEURE') nomatt='TSUP'
            IF (PEAU.EQ.'INFERIEURE') nomatt='TINF'
            ivfr=0
            DO i=1,mcham1.ielval(/1)
              IF (mcham1.NOMCHE(i).EQ.nomatt) ivfr=i
            ENDDO
            IF (ivfr.EQ.0) THEN
              MOTERR(1:4)=nomatt
              MOTERR(5:8)='TEMP'
              CALL ERREUR(77)
              GOTO 30
            ENDIF
          ENDIF
          IPTEMP=MCHAM1.IELVAL(ivfr)
*     RECUPERATION DU COEFFICIENT D'ECHANGE
*     ON GENERE UN CHAMELEM ELEMENTAIRE A PARTIR DU CHPOINT
*     DE CARACTERISTIQUES ET DU MAILLAGE ELEMENTAIRE IPOGEO
      CALL IDENT(IPMAIL,CONM,IPCHEL,0,INFOS,IOK)
      NBROBL=1
      NBRFAC=0
      SEGINI,NOMID
      LESOBL(1)='H   '
      NBTYPE=1
      SEGINI,NOTYPE
      TYPE(1)='REAL*8'
      MOMATR=NOMID
      MOTYPE=NOTYPE
      CALL KOMCHA(IPCHEL,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT)
      SEGSUP,NOTYPE
      IF (IERR.NE.0) GOTO 20
      MPTVAL=IVAMAT
      MELVAL=IVAL(1)
      IVEL1=VELCHE(/1)
      IVEL2=VELCHE(/2)
      IPCOEF=MELVAL
      segsup, mptval,nomid,notype
      
*          CALL CHAME1(IPOGEO,0,IPCHCA,' ',ICHELC,1)
*          MCHEL3=ICHELC
*          IF (IERR.NE.0) GOTO 20
*          SEGACT,MCHEL3
*          MCHAM3=MCHEL3.ICHAML(1)
*          SEGACT,MCHAM3
*          NCOELE=MCHAM3.NOMCHE(/2)
*          CALL PLACE(MCHAM3.NOMCHE,NCOELE,IPOSI,'H   ')
*          IF (IPOSI.EQ.0) THEN
*            MOTERR(1:4)='H   '
*            MOTERR(5:8)='CARA'
*            CALL ERREUR(77)
*            GOTO 20
*          ENDIF
*          IPCOEF=MCHAM3.IELVAL(IPOSI)

*   PRODUIT DES SEGMENTS ELEMENTAIRES CONTENANT LA
*   TEMPERATURE EXTERIEURE ET LE COEFFICIENT D'ECHANGE
          CALL PRCHA1(IPTEMP,IPCOEF,IPSONO)
*   CHAMELEM ELEMENTAIRE DES CHALEURS NODALES EQUIVALENTES
          L1=7
          N1=1
          N3=3
          SEGINI,MCHEL2
          MCHEL2.TITCHE='CHALEUR'
          MCHEL2.IMACHE(1)=IPMAIL
          MCHEL2.CONCHE(1)=' '
C*        MCHEL2.IFOCHE=IFOMOD
          MCHEL2.IFOCHE=IFOUR
          MCHEL2.INFCHE(1,3)=NIFOUR
          IPCHE2=MCHEL2
          N2=1
          SEGINI,MCHAM2
          MCHAM2.NOMCHE(1)='CHALEUR'
          MCHAM2.TYPCHE(1)='REAL*8'
          MCHEL2.ICHAML(1)=MCHAM2

*    CALCUL DES FLUX NODAUX EQUIVALENTS
          IF (NLG.EQ.1) THEN
            CALL INTCN0(IPSONO,IPMAIL,IPINTE,IPCHEQ)
          ELSE IF (NLG.EQ.2.OR.NLG.EQ.3) THEN
            CALL INTCN1(IPSONO,IPMAIL,IPINTE,IPCHEQ)
          ELSE IF (NLG.EQ.4.OR.NLG.EQ.6.OR.NLG.EQ.8.OR.
     .             NLG.EQ.10) THEN
            CALL INTCN2(IPSONO,IPMAIL,IPINTE,IPCHEQ)
          ENDIF
          IF (IERR.NE.0) GOTO 10
          MCHAM2.IELVAL(1)=IPCHEQ

*      ON TRANSFORME LE CHAMELEM EN CHPOINT
          CALL CHAMPO(IPCHE2,0,IPCH1,IDUM)
          melval=ipcheq
          segsup melval
          IF (IERR.NE.0) GOTO 10
          MCHPOI=IPCH1
          SEGACT,MCHPOI
          DO i=1,IPCHP(/1)
            MSOUPO=IPCHP(i)
            SEGACT,MSOUPO*MOD
            NOCOMP(1)=nomcq
            SEGDES,MSOUPO
          ENDDO
          SEGDES,MCHPOI
*    ON REGROUPE,LE CAS ECHEANT,LES DIFFERENTS CHPOINTS
          IF (iSou.GT.1) THEN
            
            CALL ADCHPO(IPCH1,IPCONV,IRET,1.D0,1.D0)
            CALL DTCHPO(IPCH1)
            CALL DTCHPO(IPCONV)
*            write(6,*) ' isou iret',isou,iret
            IF (IRET.EQ.0) GOTO 10
            IPCONV=IRET
          ELSE
            IPCONV=IPCH1
          ENDIF
          iOK=1
 10       SEGSUP,MCHAM2,MCHEL2
 20       continue
          melval=ipsono
          segsup melval
  30       call dtchel(mchel1)
          IF (iOK.EQ.0) GOTO 40
          meleme=imamod
          segdes meleme
          segdes imodel   
        ENDDO
        iOK=1
  40    CONTINUE
* 40     SEGDES,IPT3
 50     SEGDES,IMODEL
        IF (iOK.EQ.0) GOTO 100
*      ENDDO

*  LES SUPPORTS GEOMETRIQUES DU CHPOINT ET DE L'OBJET MODELE
*  SONT INCOMPATIBLES
*      IF (IRRT.EQ.NSOUS) THEN
*        MOTERR(1:8)='MODELE  '
*        MOTERR(9:16)='CHPOINT '
*        CALL ERREUR(135)
*      ENDIF
  100  CONTINUE
* 100  CALL DTCHPO(IPCHCA)
      SEGDES,MMODEL

      RETURN
      END