C FDEBIT SOURCE CHAT 11/03/16 21:22:10 6902 SUBROUTINE FDEBIT(IPCHE1,IPMODL,IPTFP,MOT1,IRET) 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 IRET 1 OU 0 SUIVANT SUCCES OU NON C C Passage aux nouveaux CHAMELEM par JM CAMPENOB LE 06/91 C C_______________________________________________________________________ C IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) C -INC CCOPTIO -INC CCGEOME -INC CCHAMP -INC SMCOORD -INC SMELEME -INC SMMODEL -INC SMCHAML -INC SMCHPOI -INC TMTRAV C logical ltelq SEGMENT INFO INTEGER INFELL(JG) ENDSEGMENT C C SEGMENTS DE TRAVAIL POUR CREER LE CHPOINT C SEGMENT ICPR(XCOOR(/1)/(IDIM+1)) 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 IRET=1 NHRM=NIFOUR C MCHPOI=IPCHE1 SEGACT MCHPOI C C ON CREE L OBJET GEOMETRIQUE CONTENANT TOUS LES PTS DU CHPOP C DO 50 I=1,IPCHP(/1) MSOUPO=IPCHP(I) SEGACT MSOUPO IF (I.GT.1) THEN ltelq=.false. CALL FUSE(IGEOM,IGEOC,IRET,ltelq) IGEOM=IRET ELSE IGEOM=IGEOC ENDIF SEGDES MSOUPO 50 CONTINUE SEGDES MCHPOI IF (IERR.NE.0) RETURN C C ACTIVATION DU MODEL C MMODEL=IPMODL SEGACT MMODEL NSOUS=KMODEL(/1) IRRT=0 DO 100 ISOUS=1,NSOUS C C ON RECUPERE L INFORMATION GENERALE C IMODEL=KMODEL(ISOUS) SEGACT IMODEL 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) THEN IRET=0 SEGDES MMODEL SEGDES IMODEL RETURN ENDIF CALL EXTREL (IRR,0,IBNOR) IF(IRR.EQ.1) THEN IRRT=IRRT+IRR GOTO 100 ENDIF CALL LIROBJ('MAILLAGE',IPOGEO,1,IRETOU) IF (IERR.NE.0) THEN IRET=0 SEGDES MMODEL,IMODEL RETURN ENDIF C C ON DETERMINE LA FORMULATION ASSOCIEE A L OBJET C GEOMETRIQUE ELEMENTAIRE DE SURFACE C IPT3=IPOGEO SEGACT IPT3 IPT2=IPT3 IB=0 C C BOUCLE SUR LES SOUS ZONES DE L ENVELOPPE C DO 110 IB=1,MAX(1,IPT3.LISOUS(/1)) IF (IPT3.LISOUS(/1).NE.0) THEN IPT2=IPT3.LISOUS(IB) SEGACT IPT2 IPOGEO=IPT2 ENDIF NBNN=IPT2.NUM(/1) IF (IPT3.LISOUS(/1).EQ.0) GOTO 112 SEGDES IPT2 C 112 CONTINUE 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) SEGDES MMODEL SEGDES IMODEL SEGDES IPT3 IRET=0 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 DO 10 I=1,NFOR IMODE1.FORMOD(I)=FORMOD(I) 10 CONTINUE DO 11 I=1,NFOR IMODE1.MATMOD(I)=MATMOD(I) 11 CONTINUE SEGDES MMODE1 lzero=0 call inomid ( imode1,' ',iret,lzero,lzero,lzero,lzero) call prquoi(imode1) SEGDES IMODE1 C C ON TRANSFORME LE CHPOINT DE PRESSION EN CHELEM ELEMENTAIRE C CALL CHAME1(0,IPMOD1,IPCHE1,' ',ICHELP,3) IF (IERR.NE.0) THEN IRET=0 CALL DTMODL(IPMOD1) SEGDES IPT3 RETURN ENDIF MCHEL1=ICHELP SEGACT MCHEL1 MCHAM1=MCHEL1.ICHAML(1) SEGACT MCHAM1 IPTVPR=MCHAM1.IELVAL(1) C C INFORMATION SUR L'ELEMENT FINI C if(infmod(/1).lt.5) then CALL ELQUOI(MELE,0,3,IPINF,IMODEL) IF (IERR.NE.0) THEN IRET=0 SEGDES MMODEL SEGDES IMODEL SEGDES IPT3 CALL DTCHAM(ICHELP) CALL DTMODL(IPMOD1) RETURN ENDIF 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 C INITIALISATION DU CHELEM ELEMENTAIRE DES FORCES NODALES C N1=1 L1=8 N3=3 SEGINI MCHELM TITCHE='SCALAIRE' IFOCHE=IFOUR IPCHEL=MCHELM C IMACHE(1)=IPOGEO INFCHE(1,1)=0 INFCHE(1,2)=0 INFCHE(1,3)=NHRM C C RECHERCHE DE LA TAILLE DES MELVALS C MELEME=IPOGEO SEGACT MELEME N1EL =NUM(/2) NBBB=NBNNE(IELI) N1PTEL=NBBB N2PTEL=0 N2EL =0 SEGDES MELEME 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 MELVAL=IVAFOR C C ON TRANSFORME LE CHAM/ELEM EN CHAM/POIN C ET ON ADDITIONNE LES CHAM/POIN ELEMENTAIRES C SEGINI ICPR NNNOE=0 MELEME = IPOGEO C C CREATION DU TABLEAU ICPR C SEGACT MELEME NBNN =NUM(/1) NBELEM=NUM(/2) C DO 511 IOP = 1,NBNN DO 511 JOP = 1,NBELEM IPT= NUM(IOP,JOP) IF(ICPR(IPT).EQ.0) THEN NNNOE=NNNOE+1 ICPR(IPT)=NNNOE ENDIF 511 CONTINUE C NNIN=1 SEGINI MTRAV IF(MOT1.EQ.' ') THEN INCO(1)=MOFP ELSE INCO(1)=MOT1 ENDIF SEGACT MELVAL NBPTEL=VELCHE(/1) NEL =VELCHE(/2) C C BOUCLE SUR LES ELEMENTS ET LES NOEUDS C DO 420 IBB=1,NBELEM DO 420 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) 420 CONTINUE C SEGDES MELVAL,MELEME C C CREATION DU CHPOINT C CALL CRECHP(MTRAV,IPCHPO) SEGSUP MTRAV,ICPR C SEGDES MELVAL,MCHAML,MCHELM CALL DTCHAM(IPCHEL) CALL DTCHAM(ICHELP) 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,IRET,1D0,1D0) CALL ECRCHA(MOGEOM) CALL DTCHPO(IPCHPO) CALL ECRCHA(MOGEOM) CALL DTCHPO(IPTFP) IF (IRET.EQ.0) GOTO 9990 IPTFP=IRET ELSE IPTFP=IPCHPO ENDIF CALL DTMODL(IPMOD1) 110 CONTINUE SEGDES IPT3 SEGDES IMODEL C 100 CONTINUE IF(IRRT.EQ.KMODEL(/1)) THEN CALL ERREUR(395) IRET=0 ENDIF SEGDES MMODEL RETURN C 9990 CONTINUE IRET=0 C C ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR C MELVAL=IVAFOR SEGSUP MELVAL SEGSUP MCHAML SEGSUP MCHELM C SEGDES IMODEL SEGDES MMODEL RETURN END