Sources Esope | Cast3M

fdebit
C FDEBIT    SOURCE    OF166741  24/10/21    21:15:13     12042          
 
C______________________________________________________________________
C
C   CALCULE LES FORCES DUES A UN DEBIT IMPOSE SUR UNE FRONTIERE DE
C   MASSIF     ( INSPIRE DE FPMASS )
C
C   ENTREES :
C   ---------
C
C    IPCHE1   CHPOINT CONTENANT LES VALEURS DES DEBITS AUX NOEUDS
C             DE LA FACE D UN MASSIF
C    IPMODL   OBJET MMODEL SUR LEQUEL S APPLIQUE LA CONDITION DE
C             DEBIT
C    MOT1     NOM A DONNER AU RESULTAT SI PAS '    '
C
C  SORTIES :
C  ---------
C
C    IPTFP    CHPOINT DES FORCES NODALES EQUIVALENTES
C    IRETOK   1 OU 0 SUIVANT SUCCES OU NON
C
C  Passage aux nouveaux CHAMELEM par JM CAMPENOB LE 06/91
C
C_______________________________________________________________________
 
      SUBROUTINE FDEBIT(IPCHE1,IPMODL,IPTFP,MOT1,IRETOK)
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
-INC CCGEOME
-INC CCHAMP
 
-INC SMCOORD
-INC SMELEME
-INC SMMODEL
-INC SMCHAML
-INC SMCHPOI
-INC TMTRAV
 
      logical ltelq
      SEGMENT INFO
        INTEGER INFELL(JG)
      ENDSEGMENT
C
C     SEGMENTS DE TRAVAIL POUR CREER LE CHPOINT
C
      SEGMENT ICPR(nbpts)
C
C     CONTENU DU SEGMENT MTRAV
C
C        NNNOE    NOMBRE DE NOEUDS
C        IGEO     LA LISTE DE CES NOEUDS
C        NNIN     NOMBRE D'INCONNUES
C        INCO     LA LISTE DE CES INCONNUES
C        NHAR     LE NUMERO D'HARMONIQUE CORRESPONDANT
C        IBIN     INDIQUE POUR UN NOEUD SI UNE INCONNUE EXISTE (=1 OU 0)
C        BB       LA VALEUR CORRESPONDANTE
C
      CHARACTER*(4) MOAPPU,MOSTRI,MOGEOM,MOFP,MOT1
      DATA MOAPPU/'APPU'/,MOSTRI/'STRI'/
      DATA MOGEOM/'GEOM'/,MOFP/'FP  '/
C
      IRETOK = 0
      IGEOM=0
      NHRM=NIFOUR
C
      MCHPOI=IPCHE1
C
C     ON CREE L OBJET GEOMETRIQUE CONTENANT TOUS LES PTS DU CHPOP
C
      DO I=1,IPCHP(/1)
         MSOUPO=IPCHP(I)
         IF (I.GT.1) THEN
            ltelq=.false.
            CALL FUSE(IGEOM,IGEOC,IPT1,ltelq)
            IGEOM=IPT1
         ELSE
            IGEOM=IGEOC
         ENDIF
      ENDDO
      IF (IERR.NE.0) RETURN
C
C     INITIALISATION DU TABLEAU ICPR
C
      SEGINI,ICPR
C
C     ACTIVATION DU MODEL
C
      MMODEL=IPMODL
      NSOUS=KMODEL(/1)
 
      IRRT=0
      DO 100 ISOUS=1,NSOUS
C
C        ON RECUPERE L INFORMATION GENERALE
C
         IMODEL=KMODEL(ISOUS)
         IPMAIL=IMAMOD
C
C        TRAITEMENT DU MODEL
C
         MELM=NEFMOD
C
C        ON RECUPERE LES ELTS DE L ENVELOPPE DU MASSIF APPUYES
C        STRICTEMENT SUR LE CHPOINT DE DEBIT
C
         CALL ECROBJ('MAILLAGE',IGEOM)
         CALL ECRCHA(MOSTRI)
         CALL ECRCHA(MOAPPU)
         CALL ECROBJ('MAILLAGE',IPMAIL)
         IF (IDIM.EQ.2) CALL PRCONT
         IF (IDIM.EQ.3) CALL ENVELO
         IF (IERR.NE.0) RETURN
         CALL EXTREL (IRR,0,IBNOR)
         IF (IRR.EQ.1) THEN
            IRRT=IRRT+IRR
            GOTO 100
         ENDIF
         CALL LIROBJ('MAILLAGE',IPT3,1,IRETOU)
         IF (IERR.NE.0) RETURN
         CALL ACTOBJ('MAILLAGE',IPT3,1)
         IF (IERR.NE.0) RETURN
C
C     ON DETERMINE LA FORMULATION ASSOCIEE A L OBJET
C     GEOMETRIQUE ELEMENTAIRE DE SURFACE
C
         NBSOU3 = IPT3.LISOUS(/1)
         IPT2 = IPT3
C
C     BOUCLE SUR LES SOUS ZONES DE L ENVELOPPE
C
      DO 110 IB=1,MAX(1,NBSOU3)
         IF (NBSOU3.NE.0) THEN
            IPT2=IPT3.LISOUS(IB)
         ENDIF
         NBNN=IPT2.NUM(/1)
         IPOGEO=IPT2
 
         MELE=0
C
C        MILIEUX POREUX :
C        ON RECUPERE L'ELEMENT QUADRATIQUE DE FACE
C
         IF(MELM.EQ.79.OR.MELM.EQ.80.OR.MELM.EQ.108
     &  .OR.MELM.EQ.173.OR.MELM.EQ.174.OR.MELM.EQ.178
     &  .OR.MELM.EQ.179.OR.MELM.EQ.185.OR.MELM.EQ.188) THEN
            MELE=3
            IELI=2
         ELSE IF(MELM.EQ.81.OR.MELM.EQ.82.OR.MELM.EQ.83
     &  .OR.MELM.EQ.109.OR.MELM.EQ.110.OR.MELM.EQ.175
     &  .OR.MELM.EQ.176.OR.MELM.EQ.177.OR.MELM.EQ.180
     &  .OR.MELM.EQ.181.OR.MELM.EQ.182.OR.MELM.EQ.186
     &  .OR.MELM.EQ.187.OR.MELM.EQ.189.OR.MELM.EQ.190) THEN
            IF (NBNN.EQ.6) THEN
               MELE=33
C               IELI=3  BALD 96/02/23
               IELI=4
            ELSE
               MELE=34
C               IELI=4  BALD 96/02/23
               IELI=8
            ENDIF
         ENDIF
C
         IF (MELE.EQ.0) THEN
C
C        ERREUR : IMPOSSIBLE D UTILISER L OPERATEUR DEBIT  POUR
C                 LES ELEMENTS DE FORMULATION MELM
C
            MOTERR(1:4)=NOMTP(MELM)
            MOTERR(5:8)=' '
            CALL ERREUR(193)
            RETURN
         ENDIF
C
C        ON CREE L OBJET MODEL ASSOCIE A LA SURFACE ELEMENTAIRE
C
         N1=1
         SEGINI MMODE1
         IPMOD1=MMODE1
         NFOR=FORMOD(/2)
         NMAT=MATMOD(/2)
         MN3 =INFMOD(/1)
         NPARMO=0
         nobmod=0
         SEGINI IMODE1
         MMODE1.KMODEL(1)=IMODE1
         IMODE1.IMAMOD=IPOGEO
         IMODE1.NEFMOD=MELE
         IMODE1.CONMOD=CONMOD
         DO I=1,NFOR
            IMODE1.FORMOD(I)=FORMOD(I)
         ENDDO
         DO I=1,NMAT
            IMODE1.MATMOD(I)=MATMOD(I)
         ENDDO
         DO I=1,MN3
            IMODE1.INFMOD(I)=INFMOD(I)
         ENDDO
         lzero=0
         call prquoi(imode1)
         call inomid(imode1,lzero,lzero,lzero,lzero)
C
C        ON TRANSFORME LE CHPOINT DE PRESSION EN CHELEM ELEMENTAIRE
C
         CALL CHAME1(0,IPMOD1,IPCHE1,' ',ICHELP,3)
         IF (IERR.NE.0) RETURN
         MCHEL1=ICHELP
         MCHAM1=MCHEL1.ICHAML(1)
         IPTVPR=MCHAM1.IELVAL(1)
C
C        INFORMATION SUR L'ELEMENT FINI
C
*  AM  11/05/2020 ON APPELLE ELQUOI
**       if(infmod(/1).lt.5) then
         CALL ELQUOI(MELE,0,3,IPINF,IMODEL)
         IF (IERR.NE.0) RETURN
         INFO=IPINF
         MFR   =INFELL(13)
         IELE  =INFELL(14)
         IPTINT=INFELL(11)
         segsup info
**       ELSE
**       iptint=infmod(5)
**       MFR   =INFELE(13)
**       IELE  =INFELE(14)
**       ENDIF
c-dbg      write(ioimp,*) 'fdebit=',MFR,INFELE(13),IELE,infele(14),
c-dbg     &               iptint,infmod(5)
C
C        INITIALISATION DU CHELEM ELEMENTAIRE DES FORCES NODALES
C
         N1=1
         L1=8
         N3=6
         SEGINI MCHELM
         TITCHE='SCALAIRE'
         IFOCHE=IFOUR
         IPCHEL=MCHELM
C
         IMACHE(1)=IPOGEO
         INFCHE(1,1)=0
         INFCHE(1,2)=0
         INFCHE(1,3)=NHRM
         INFCHE(1,4)=0
         INFCHE(1,5)=0
         INFCHE(1,6)=1
C
C        RECHERCHE DE LA TAILLE DES MELVALS
C
         MELEME=IPOGEO
         N1EL  =NUM(/2)
         NBBB=NBNNE(IELI)
         N1PTEL=NBBB
         N2PTEL=0
         N2EL  =0
C
C        CREATION DU MCHAML DE LA SOUS ZONE
C
         N2=1
         SEGINI MCHAML
         ICHAML(1)=MCHAML
         NOMCHE(1)='SCAL'
         TYPCHE(1)='REAL*8'
         SEGINI MELVAL
         IELVAL(1)=MELVAL
         IVAFOR=MELVAL
C
C        CALCUL DES FORCES NODALES EQUIVALENTES
C        DEBRANCHEMENT SUIVANT LE TYPE DES ELEMENTS
C
C        CAS DES ELEMENTS MASSIFS BIDIMENSIONNELS
C            FACE  ASSOCIEE  SEG3
C        CAS DES ELEMENTS MASSIFS TRIDIMENSIONNELS
C            FACES ASSOCIEES FAC6,FAC8
C
         IF (MELE.EQ.3.OR.MELE.EQ.33.OR.MELE.EQ.34) THEN
            CALL FDE23D(IPTVPR,IPOGEO,IPTINT,IVAFOR,IELI)
         ELSE
C
C           ERREUR L ELEMENT N EST PAS ENCORE IMPLEMENTE
C
            MOTERR(1:4)=NOMTP(MELE)
            MOTERR(5:12)='FDEBIT'
            CALL ERREUR(86)
            SEGDES IPT3
            SEGDES MCHEL1
            SEGDES MCHAM1
            CALL DTMODL(IPMOD1)
            GOTO 9990
         ENDIF
C
C
C        ON TRANSFORME LE CHAM/ELEM EN CHAM/POIN
C        ET ON ADDITIONNE LES CHAM/POIN ELEMENTAIRES
C
         MELEME = IPOGEO
         NBNN  =NUM(/1)
         NBELEM=NUM(/2)
C
C        REMPLISSAGE DU TABLEAU ICPR
C
         DO IPT = 1, nbpts
           ICPR(IPT) = 0
         ENDDO
 
         NNNOE=0
         DO IOP = 1,NBNN
            DO JOP = 1,NBELEM
               IPT= NUM(IOP,JOP)
               IF(ICPR(IPT).EQ.0) THEN
                  NNNOE=NNNOE+1
                  ICPR(IPT)=NNNOE
               ENDIF
            ENDDO
         ENDDO
C
         NNIN=1
         SEGINI MTRAV
         IF(MOT1.EQ.'    ') THEN
           INCO(1)=MOFP
         ELSE
           INCO(1)=MOT1
         ENDIF
         MELVAL=IVAFOR
         NBPTEL=VELCHE(/1)
         NEL   =VELCHE(/2)
C
C        BOUCLE SUR LES ELEMENTS ET LES NOEUDS
C
*  AM  11/05/2020
**       iele=itypel
         DO IBB=1,NBELEM
            DO IC=1,NBSOM(IELE)
               ICC=IBSOM(NSPOS(IELE)+IC-1)
               IPT=ICPR(NUM(ICC,IBB))
               BB(1,IPT)=VELCHE(IC,IBB)+BB(1,IPT)
               IBIN(1,IPT)=1
               IGEO(IPT)=NUM(ICC,IBB)
            ENDDO
         ENDDO
C
C        CREATION DU CHPOINT
C
         CALL CRECHP(MTRAV,IPCHPO)
         SEGSUP,MTRAV
C
         SEGDES MELVAL,MCHAML,MCHELM
         CALL DTCHAM(IPCHEL)
C
         IF (IPCHPO.EQ.0) GOTO 9990
C
C        ADDITION DES CHPOINTS ELEMENTAIRES
C
         IF ((ISOUS-IRRT).GT.1.OR.IB.GT.1) THEN
            CALL ADCHPO(IPCHPO,IPTFP,ICHP,1D0,1D0)
            CALL ECRCHA(MOGEOM)
            CALL DTCHPO(IPCHPO)
            CALL ECRCHA(MOGEOM)
            CALL DTCHPO(IPTFP)
            IF (ICHP.EQ.0) GOTO 9990
            IPTFP=ICHP
         ELSE
            IPTFP=IPCHPO
         ENDIF
         CALL DTMODL(IPMOD1)
 110  CONTINUE
 
      SEGDES IPT3
 
 100  CONTINUE
 
      SEGSUP,ICPR
      IF(IRRT.EQ.KMODEL(/1)) THEN
         CALL ERREUR(395)
         RETURN
      ENDIF
 
C FIN NORMALE : Travail accompli
      IRETOK = 1
 
      RETURN
C
 9990 CONTINUE
C
C     ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR
C
      MELVAL=IVAFOR
      SEGSUP,MELVAL
      SEGSUP,MCHAML
      SEGSUP,MCHELM
      SEGSUP,ICPR
 
      RETURN
      END