C SIGMAP SOURCE OF166741 26/03/13 21:15:04 12499 SUBROUTINE SIGMAP(IDERI,IPMODL,IPCHP1,IPCHE1,IPCHE2,IMAT, 1 IPSTRS,IRET,inoer) C_______________________________________________________________________ C C OPERATEUR CONTRAINTES APPELE PAR SIGMA c C Entrees: C ________ C c IDERI = | 1 si deformations LINEaires c | 2 si QUADratiques c | 3 si TRUEsdell, c | 4 si JAUMann c | 5 si UTILisateur C IPMODL Pointeur sur un MMODEL C IPCHP1 Pointeur sur un CHAMPOINT deplacements C IPCHE1 Pointeur sur un MCHAML de caracteristiques C IPCHE2 Pointeur sur un MCHAML de HOOKE C IMAT Flag de HOOKE (2 si oui, 1 sinon) C C Sorties: C ________ C C IPSTRS Pointeur sur un MCHAML de CONTRAINTES C IRET 1 ou 0 suivant succes ou pas C C_______________________________________________________________________ C IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC CCHAMP -INC CCREEL C==DEB= FORMULATION HHO == INCLUDE ===================================== -INC CCHHOPA C==FIN= FORMULATION HHO ================================================ -INC SMCHAML -INC SMCHPOI -INC SMELEME -INC SMCOORD -INC SMMODEL -INC SMINTE -INC SMLREEL -INC TMPTVAL SEGMENT NOTYPE CHARACTER*16 TYPE(NBTYPE) ENDSEGMENT POINTEUR MOTYR8.NOTYPE CHARACTER*8 CMATE CHARACTER*(NCONCH) CONM PARAMETER ( NINF=3 ) INTEGER INFOS(NINF) LOGICAL LDPGE,lsupdp,lsupco,lsupma C * quelques initialisations pour enlever des warnings ldpge=.false. lsupdp=.false. ldpge=.false. lsupco=.false. lsupma=.false. IRET = 0 IPSTRS = 0 c on calcule les termes quadratiques seulement si deformations QUAD IF(IDERI.EQ.2) THEN IREPS2=1 ELSE IREPS2=0 ENDIF C NHRM=NIFOUR ISUP=0 ISUP1=0 MCHAML=0 C C VERIFICATION DU LIEU SUPPORT DU MCHAML DE HOOKE C IF (IMAT.EQ.2) THEN CALL QUESUP(IPMODL,IPCHE2,5,1,ISUP,IRETHO) IF (ISUP.NE.0) RETURN ENDIF C C VERIFICATION DU LIEU SUPPORT DU MCHAML DE CARACTERISTIQUES C IF (IPCHE1.NE.0) THEN CALL QUESUP(IPMODL,IPCHE1,5,0,ISUP1,IRETCA) IF (ISUP1.GT.1) RETURN ENDIF C____________________________________________________________________ C C ON CONVERTIT LE CHAMP POINT EN CHAMP PAR ELEMENT C____________________________________________________________________ C CALL CHAME1(0,IPMODL,IPCHP1,' ',IPCHA1,1) IF (IERR.NE.0) RETURN C C ACTIVATION DU MODELE C MMODEL=IPMODL NSOUS=KMODEL(/1) C C CREATION DU MCHELM C C============================================= N1=NSOUS DO IJKL=1,NSOUS IMODEL=KMODEL(IJKL) IF (NEFMOD.EQ.22.OR.NEFMOD.EQ.259) then N1=N1-1 ELSEIF (FORMOD(1).EQ.'CHARGEMENT') then N1=N1-1 * l operateur sait ce qu il peut traiter elseif(formod(1)(1:9).ne.'MECANIQUE'.and. &formod(1)(1:6).ne.'POREUX'.and.formod(1)(1:7).ne.'LIQUIDE') & then N1=N1-1 endif END DO C WRITE(*,*) 'NSOUS=',NSOUS C WRITE(*,*) 'N1=',N1 C============================================= L1=11 N3=6 SEGINI MCHELM TITCHE='CONTRAINTES' IFOCHE=IFOUR C Un petit segment toujours utile : nbtype = 1 SEGINI,MOTYR8 MOTYR8.type(1) = 'REAL*8 ' C C____________________________________________________________________ C C DEBUT DE LA BOUCLE SUR LES DIFFERENTES ZONES C____________________________________________________________________ C ISOUS=0 DO 500 KISOUS=1,NSOUS * * INITIALISATION * IVAMAT=0 IVACAR=0 IVASTR=0 IVADEP=0 IPMING=0 MOSTRS=0 MODEPL=0 MOMATR=0 MOCARA=0 C C TRAITEMENT DU MODELE C IMODEL=KMODEL(KISOUS) C* SEGACT IMODEL MELE=NEFMOD if ((MELE.eq.22).OR.(MELE.eq.259)) go to 500 IF (FORMOD(1).EQ.'CHARGEMENT') GOTO 500 ISOUS=ISOUS+1 C============================================== IIPDPG=imodel.IPDPGE IIPDPG=IPTPOI(IIPDPG) IPMAIL=imodel.IMAMOD CONM =imodel.CONMOD c ideri=ideriv c ireps2=0 c if(ideri.eq.2.and.ibid2.eq.0) ireps2=1 cbp,2020-12-10 : ideriv n'est plus utilise -> IDERI en argument C==DEB= FORMULATION HHO ================================================ IF (MELE.EQ.HHO_NUM_ELEMENT) THEN IF (IDERI.EQ.3.OR.IDERI.EQ.4) THEN moterr = 'EPSI(HHO): IDERI = not compatible' write(moterr(20:20),FMT='(I1)') IDERI call erreur(-385) call erreur(21) goto 9990 ENDIF ENDIF C==FIN= FORMULATION HHO ================================================ IMACHE(ISOUS)=IPMAIL CONCHE(ISOUS)=CONM C COQUE INTEGREE OU PAS ? NPINT = imodel.INFMOD(1) C C NATURE DU MATERIAU C CMATE = imodel.CMATEE MATE = imodel.IMATEE INAT = imodel.INATUU C____________________________________________________________________ C C INFORMATION SUR L'ELEMENT FINI C____________________________________________________________________ MFR =INFELE(13) IELE =INFELE(14) IPORE=INFELE(8) NBG =INFELE(6) NBGS =INFELE(4) NSTRS=INFELE(16) LRE =INFELE(9) LW =INFELE(7) LHOOK=INFELE(10) NDDL =INFELE(15) * MINTE=INFELE(11) MINTE=INFMOD(7) MINTE1=INFMOD(3) IPMINT=MINTE IPMIN1=MINTE1 C CALL INFDPG(MFR,IFOUR, LDPGE,ndpge) C C CREATION DU TABLEAU INFOS C CALL IDENT(IPMAIL,CONM,IPCHA1,IPCHE1,INFOS,IRTD) IF (IRTD.EQ.0) GOTO 9990 C INFCHE(ISOUS,1)=0 INFCHE(ISOUS,2)=0 INFCHE(ISOUS,3)=NHRM INFCHE(ISOUS,4)=MINTE INFCHE(ISOUS,5)=0 INFCHE(ISOUS,6)=5 C C INITIALISATION DE MINTE C if(mele.ne.260) then NBPGAU=POIGAU(/1) endif C C ACTIVATION DU MELEME C MELEME=IPMAIL c* SEGACT MELEME NBNN =NUM(/1) NBELEM=NUM(/2) IPPORE=0 IF(MFR.EQ.33) THEN IPPORE=NBNN ELSE IF(MFR.EQ.57.OR.MFR.EQ.59) THEN IPPORE=NBNN LHOOK=4 IF(IFOUR.EQ.1.OR.IFOUR.EQ.-3) LHOOK=6 ENDIF LHOO2=LHOOK*LHOOK C C EXTRACTION DES DEPLACEMENTS DU NOEUD SUPPORT DE LA C DEFORMATION PLANE GENERALISEE C IF (LDPGE) THEN IF (IIPDPG.LE.0) THEN CALL ERREUR(925) ELSE CALL DEPDPG(IPCHP1,UZDPG,RXDPG,RYDPG,IIPDPG) ENDIF IF (IERR.NE.0) GOTO 9990 ELSE UZDPG=XZero RXDPG=XZero RYDPG=XZero ENDIF C____________________________________________________________________ C C RECHERCHE DES NOMS DE COMPOSANTES C____________________________________________________________________ C if(lnomid(4).ne.0) then lsupco=.false. nomid=lnomid(4) mostrs=nomid nstr=lesobl(/2) nfac=lesfac(/2) else lsupco=.true. CALL IDCONT(IMODEL,IFOUR,MOSTRS,NSTR,NFAC) endif C if(lnomid(1).ne.0) then lsupdp=.false. nomid=lnomid(1) c* segact nomid modepl=nomid ndep=lesobl(/2) nfac=lesfac(/2) else lsupdp=.true. CALL IDPRIM(IMODEL,MFR,MODEPL,NDEP,NFAC) endif C==DEB= FORMULATION HHO == Le MCHAML est vide, on utilise le CHPOINT === IF (MELE .EQ. HHO_NUM_ELEMENT) THEN GOTO 890 END IF C==FIN= FORMULATION HHO ================================================ C____________________________________________________________________ C C VERIFICATION DE LEUR PRESENCE C____________________________________________________________________ C MOTYPE = MOTYR8 CALL KOMCHA(IPCHA1,IPMAIL,CONM,MODEPL,MOTYPE,1,INFOS,3,IVADEP) IF (IERR.NE.0) GOTO 9990 C C RECHERCHE DE LA TAILLE DES MELVAL A ALLOUER C C==DEB= FORMULATION HHO == Etiquette specifique ======================== 890 CONTINUE C==FIN= FORMULATION HHO ================================================ N1PTEL=NBGS N1EL=NBELEM NBPTEL=N1PTEL NEL=N1EL C C CREATION DU MCHAML DE LA SOUS ZONE C N2=NSTRS SEGINI MCHAML ICHAML(ISOUS)=MCHAML NSR=1 NCOSOR=NSTRS SEGINI MPTVAL IVASTR=MPTVAL NOMID=MOSTRS c* SEGACT NOMID DO 100 ICOMP=1,NSTRS NOMCHE(ICOMP)=LESOBL(ICOMP) TYPCHE(ICOMP)='REAL*8' N2PTEL=0 N2EL=0 SEGINI MELVAL IELVAL(ICOMP)=MELVAL IVAL(ICOMP)=MELVAL 100 CONTINUE C____________________________________________________________________ C * RANGEMENT DE LA MATRICE DE HOOKE DANS UN TABLEAU DE TRAVAIL * C____________________________________________________________________ * lsupma=.true. IF (IMAT.EQ.2) THEN IF(MELE.EQ.93.AND.CMATE.NE.'ISOTROPE')THEN NBROBL=3 NBRFAC=0 SEGINI NOMID LESOBL(1)='MAHO' LESOBL(2)='V1X ' LESOBL(3)='V1Y ' NBTYPE=3 SEGINI NOTYPE TYPE(1)='POINTEURLISTREEL' TYPE(2)='REAL*8' TYPE(3)='REAL*8' ELSE NBROBL=1 NBRFAC=0 SEGINI NOMID LESOBL(1)='MAHO' NBTYPE=1 SEGINI NOTYPE TYPE(1)='POINTEURLISTREEL' ENDIF MOMATR=NOMID NMATR=NBROBL NMATF=NBRFAC CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOMATR,NOTYPE,1,INFOS,3,IVAMAT) SEGSUP NOTYPE IF (IERR.NE.0) GOTO 9990 MPTVAL=IVAMAT MELVAL=IVAL(1) NBGMAT=IELCHE(/1) NELMAT=IELCHE(/2) NMATT=NMATR+NMATF ELSE C____________________________________________________________________ * * SINON TRAITEMENT DES CHAMPS DE MATERIAU C____________________________________________________________________ * IF (FORMOD(1).EQ.'MECANIQUE'.AND.CMATE.EQ.'ISOTROPE') THEN NBROBL=2 NBRFAC=0 SEGINI NOMID MOMATR=NOMID IF (MFR.EQ.35) THEN LESOBL(1)='KS ' LESOBL(2)='KN ' ELSE IF(MFR.EQ.53) THEN NBROBL=1 SEGADJ,NOMID LESOBL(1)='KS ' ELSE LESOBL(1)='YOUN' LESOBL(2)='NU ' C=DEB==== FORMULATION HHO ==== Traitement particulier du modele ======== CALL HHOIDC(imodel,MOMATR) NBROBL=nomid.lesobl(/2) ** NBRFAC=nomid.lesfac(/2) C=FIN==== FORMULATION HHO ============================================== ENDIF NMATR=NBROBL NMATF=NBRFAC ELSE $ IF (FORMOD(1).EQ.'MECANIQUE'.AND.CMATE.EQ.'UNIDIREC') THEN IF (MFR.EQ.1.AND.IDIM.EQ.3) THEN NBROBL=7 NBRFAC=0 SEGINI NOMID MOMATR=NOMID LESOBL(1)='YOUN' LESOBL(2)='V1X ' LESOBL(3)='V1Y ' LESOBL(4)='V1Z ' LESOBL(5)='V2X ' LESOBL(6)='V2Y ' LESOBL(7)='V2Z ' ELSE NBROBL=3 NBRFAC=0 SEGINI NOMID MOMATR=NOMID LESOBL(1)='YOUN' LESOBL(2)='V1X ' LESOBL(3)='V1Y ' ENDIF NMATR=NBROBL NMATF=NBRFAC ELSE $ IF (FORMOD(1).EQ.'POREUX '.AND.CMATE.EQ.'ISOTROPE') THEN IF (MELE.GE.79.AND.MELE.LE.83) THEN NBROBL=4 NBRFAC=0 SEGINI NOMID MOMATR=NOMID LESOBL(1)='YOUN' LESOBL(2)='NU ' LESOBL(3)='COB ' LESOBL(4)='MOB ' ELSE IF (MELE.GE.108.AND.MELE.LE.110) THEN NBROBL=4 NBRFAC=0 SEGINI NOMID MOMATR=NOMID LESOBL(1)='KS ' LESOBL(2)='KN ' LESOBL(3)='COB ' LESOBL(4)='MOB ' ELSE IF (MELE.GE.173.AND.MELE.LE.177) THEN NBROBL=10 NBRFAC=0 SEGINI NOMID MOMATR=NOMID LESOBL(1)='YOUN' LESOBL(2)='NU ' LESOBL(3)='COP1' LESOBL(4)='COP2' LESOBL(5)='CPP1' LESOBL(6)='CPP2' LESOBL(7)='KK11' LESOBL(8)='KK12' LESOBL(9)='KK21' LESOBL(10)='KK22' ELSE IF (MELE.GE.178.AND.MELE.LE.182) THEN NBROBL=17 NBRFAC=0 SEGINI NOMID MOMATR=NOMID LESOBL(1)='YOUN' LESOBL(2)='NU ' LESOBL(3)='COP1' LESOBL(4)='COP2' LESOBL(5)='COP3' LESOBL(6)='CPP1' LESOBL(7)='CPP2' LESOBL(8)='CPP3' LESOBL(9)='KK11' LESOBL(10)='KK12' LESOBL(11)='KK13' LESOBL(12)='KK21' LESOBL(13)='KK22' LESOBL(14)='KK23' LESOBL(15)='KK31' LESOBL(16)='KK32' LESOBL(17)='KK33' ELSE IF (MELE.GE.185.AND.MELE.LE.187) THEN NBROBL=10 NBRFAC=0 SEGINI NOMID MOMATR=NOMID LESOBL(1)='KS ' LESOBL(2)='KN ' LESOBL(3)='COP1' LESOBL(4)='COP2' LESOBL(5)='CPP1' LESOBL(6)='CPP2' LESOBL(7)='KK11' LESOBL(8)='KK12' LESOBL(9)='KK21' LESOBL(10)='KK22' ELSE IF (MELE.GE.188.AND.MELE.LE.190) THEN NBROBL=17 NBRFAC=0 SEGINI NOMID MOMATR=NOMID LESOBL(1)='KS ' LESOBL(2)='KN ' LESOBL(3)='COP1' LESOBL(4)='COP2' LESOBL(5)='COP3' LESOBL(6)='CPP1' LESOBL(7)='CPP2' LESOBL(8)='CPP3' LESOBL(9)='KK11' LESOBL(10)='KK12' LESOBL(11)='KK13' LESOBL(12)='KK21' LESOBL(13)='KK22' LESOBL(14)='KK23' LESOBL(15)='KK31' LESOBL(16)='KK32' LESOBL(17)='KK33' ENDIF NMATR=NBROBL NMATF=NBRFAC * ELSEIF(INAT.EQ.67.AND.CMATE.EQ.'ORTHOTRO') THEN NBROBL=6 NBRFAC=0 SEGINI NOMID MOMATR=NOMID LESOBL(1)='YG1 ' LESOBL(2)='YG2 ' LESOBL(3)='NU12' LESOBL(4)='G12 ' LESOBL(5)='V1X ' LESOBL(6)='V1Y ' NMATR=NBROBL NMATF=NBRFAC * * ELSE IF (FORMOD(1).EQ.'ELECTROSTATIQUE') THEN * Pour l'instant, lnomid(6) ou appel a IDMATR suffisent. * * ELSE IF (FORMOD(1).EQ.'DIFFUSION') THEN * Pour l'instant, lnomid(6) ou appel a IDMATR suffisent. * * Autres cas : ELSE if(lnomid(6).ne.0) then nomid=lnomid(6) segact nomid momatr=nomid nmatr=lesobl(/2) nmatf=lesfac(/2) lsupma=.false. else lsupma=.true. CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF) endif ENDIF * IF (CMATE.EQ.'SECTION') THEN NBTYPE=3 SEGINI,notype TYPE(1)='POINTEURMMODEL' TYPE(2)='POINTEURMCHAML' TYPE(3)='POINTEURLISTREEL' ELSE NBTYPE = 1 notype = MOTYR8 ENDIF NMATT=NMATR+NMATF C=DEB==== FORMULATION HHO ==== Traitement particulier du modele ======== IF (MFR.EQ.HHO_MFR_ELEMENT) THEN IF (NBTYPE.EQ.1) THEN NBTYPE = NMATT SEGINI,notype DO ITYP = 1, NBTYPE notype.TYPE(ITYP) = 'REAL*8 ' END DO END IF notype.TYPE(NMATR-1) = 'POINTEURLISTREEL' notype.TYPE(NMATR ) = 'POINTEURLISTREEL' END IF C=FIN==== FORMULATION HHO ============================================== MOTYPE = notype * CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT) IF (MOTYPE .NE. MOTYR8) SEGSUP,notype IF (IERR.NE.0) GOTO 9990 * IF(ISUP1.EQ.1)THEN CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE,MOMATR,MELE) IF(IERR.NE.0)THEN ISUP1=0 GOTO 9990 ENDIF ENDIF MPTVAL=IVAMAT NBGMAT = 0 NELMAT = 0 DO 1108 IM=1,NMATT IF(IVAL(IM).NE.0)THEN MELVAL=IVAL(IM) IF (CMATE.EQ.'SECTION') THEN NBGMAT=MAX(NBGMAT,IELCHE(/1)) NELMAT=MAX(NELMAT,IELCHE(/2)) ELSE NBGMAT=MAX(NBGMAT,VELCHE(/1)) NELMAT=MAX(NELMAT,VELCHE(/2)) ENDIF ENDIF 1108 CONTINUE ENDIF C____________________________________________________________________ C * TRAITEMENT DES CHAMPS DE CARACTERISTIQUES * C____________________________________________________________________ C NBROBL=0 NBRFAC=0 MOCARA=0 IVECT=0 * NOTYPE = MOTYR8 * * EPAISSEUR ET EXCENTREMENT DANS LE CAS DES COQUES * IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN NBROBL=1 NBRFAC=1 SEGINI NOMID MOCARA=NOMID LESOBL(1)='EPAI' LESFAC(1)='EXCE' * * SECTION POUR LES BARRES * ELSE IF (MFR.EQ.27) THEN NBROBL=1 SEGINI NOMID MOCARA=NOMID LESOBL(1)='SECT' * * section, excentrements et orientation pour les barres excentrees * ELSE IF (MFR.EQ.49) THEN NBROBL=6 SEGINI NOMID MOCARA=NOMID LESOBL(1)='SECT' LESOBL(2)='EXCZ' LESOBL(3)='EXCY' LESOBL(4)='VX ' LESOBL(5)='VY ' LESOBL(6)='VZ ' * * raideurs locales et orientation pour l'element LIA2 * de liaison a 2 noeuds * ELSE IF (MFR.EQ.51) THEN NBROBL=9 SEGINI NOMID MOCARA=NOMID LESOBL(1)='RLUX' LESOBL(2)='RLUY' LESOBL(3)='RLUZ' LESOBL(4)='RLRX' LESOBL(5)='RLRY' LESOBL(6)='RLRZ' LESOBL(7)='VX ' LESOBL(8)='VY ' LESOBL(9)='VZ ' * * CARACTERISTIQUES POUR LES POUTRES * ELSE IF (MFR.EQ.7 ) THEN IF ((CMATE.EQ.'SECTION')) THEN NBROBL=0 NBRFAC=3 SEGINI NOMID MOCARA=NOMID LESFAC(1)='VX' LESFAC(2)='VY' LESFAC(3)='VZ' IVECT=1 * * CAS 2D * ELSE IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN NBRFAC=1 NBROBL=2 SEGINI NOMID MOCARA=NOMID LESOBL(1)= 'SECT' LESOBL(2)= 'INRZ' LESFAC(1)= 'SECY' * ELSE NBROBL=4 NBRFAC=5 SEGINI NOMID MOCARA=NOMID LESOBL(1)='TORS' LESOBL(2)='INRY' LESOBL(3)='INRZ' LESOBL(4)='SECT' LESFAC(1)='SECY' LESFAC(2)='SECZ' LESFAC(3)='VX' LESFAC(4)='VY' LESFAC(5)='VZ' IVECT=1 ENDIF * * CARACTERISTIQUES POUR LES TUYAUX * ELSE IF (MFR.EQ.13) THEN NBROBL=2 NBRFAC=6 SEGINI NOMID MOCARA=NOMID LESOBL(1)='EPAI' LESOBL(2)='RAYO' LESFAC(1)='RACO' LESFAC(2)='PRES' LESFAC(3)='CISA' LESFAC(4)='VX' LESFAC(5)='VY' LESFAC(6)='VZ' IVECT=1 * * CARACTERISTIQUES POUR LES LINESPRING * ELSE IF (MFR.EQ.15) THEN NBROBL=5 SEGINI NOMID MOCARA=NOMID LESOBL(1)='EPAI' LESOBL(2)='FISS' LESOBL(3)='VX ' LESOBL(4)='VY ' LESOBL(5)='VZ ' * * CARACTERISTIQUES POUR LES TUYAUX FISSURES * ELSE IF (MFR.EQ.17) THEN NBROBL=9 SEGINI NOMID MOCARA=NOMID LESOBL(1)='RAYO' LESOBL(2)='EPAI' LESOBL(3)='VX ' LESOBL(4)='VY ' LESOBL(5)='VZ ' LESOBL(6)='VXF ' LESOBL(7)='VYF ' LESOBL(8)='VZF ' LESOBL(9)='ANGL' * * CARACTERISTIQUES DES ELEMENTS HOMOGENEISES * ELSE IF (MFR.EQ.37) THEN IF(IFOUR.EQ.1.OR.IFOUR.EQ.0) THEN NBROBL=4 SEGINI NOMID MOCARA=NOMID LESOBL(1)='SCEL' LESOBL(2)='SFLU' LESOBL(3)='EPS ' LESOBL(4)='XINE' ELSE NBROBL=3 SEGINI NOMID MOCARA=NOMID LESOBL(1)='SCEL' LESOBL(2)='SFLU' LESOBL(3)='EPS ' ENDIF * * EPAISSEUR POUR LES JOINTS GENERALISES * ELSE IF (MFR.EQ.55) THEN CcPPj NBROBL=1 CcPPj NBRFAC=0 CcPPj SEGINI NOMID CcPPj MOCARA=NOMID CcPPj LESOBL(1)='EPAI' NBROBL=0 NBRFAC=1 SEGINI NOMID MOCARA=NOMID LESFAC(1)='EPAI' * * CARACTERISTIQUE MACRO_EL (element CIFL) * ELSE IF (MFR.EQ.61)THEN NBRFAC=0 NBROBL=2 SEGINI NOMID MOCARA=NOMID LESOBL(1)= 'SECT' LESOBL(2)= 'INRZ' * ENDIF NCARA=NBROBL NCARF=NBRFAC NCARR=NCARA+NCARF MOTYPE = NOTYPE * IF (IPCHE1.NE.0.AND.MOCARA.NE.0) THEN * CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3, $ IVACAR) IF (IERR.NE.0) GOTO 9990 * IF (ISUP1.EQ.1) THEN CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE) IF(IERR.NE.0)THEN ISUP1=0 GOTO 9990 ENDIF ENDIF ENDIF IF (MOTYPE .NE. MOTYR8) SEGSUP,NOTYPE * C_______________________________________________________________________ C C NUMERO DES ETIQUETTES : C ETIQUETTES DE 1 A 98 POUR TRAITEMENT SPECIFIQUE A L ELEMENT C Les elements sont groupes comme suit : C - massif, poreux, joints poreux ------------------> sigma1 C - coq3,dkt,coq4,coq8,coq2,joints -----------------> sigma2 C - poutre,tuyau,linespring,tuyau fissure,barre ----> sigma3 C et poutre de Timoschenko C_______________________________________________________________________ C SEGACT,MCOORD IF (MELE.LE.100) &GOTO (99,99,99, 4,99, 4,99, 4,99, 4,99,99,99, 4, 4, 4, 4,99,99,99, 1 99,99, 4, 4, 4, 4,27,27,29,29,99,99,99,99,99,99,99,99,99,99, 2 27,29,29,27,29,29,99,99,27,29,99,99,99,99,99,27,99,99,99,99, 3 99,99,99,99,99,99,99,99, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4 4, 4, 4,29,27,27,27,27,99,99,99,99,27,99,29,29,99,99,99,99 5 ),MELE IF (MELE.LE.200) &GOTO (99,99,99,99,99,99,99, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 1 4, 4,29,29,29,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34, 2 34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34, c <168- -172> <173- 3 34,34,34,34,34,34,34,27,27,27,27,27, 4, 4, 4, 4, 4, 4, 4, 4, c Elements mecaniques 1D (M1Dx) : MELE = 193, 194 c -190> 4 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,34,34, 4, 4,34,34,34,34,34,34 5 ),MELE-100 IF (MELE.LE.300) &GOTO (34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34, 1 34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34, c mele = 258, 260 --> goto 29 2 34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,29,34,29, 3 34,34,34,34,29,34,34,34,34,34,34,34, 4, 4,34,34,34,34,34,34, C 4 89,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34,34 5 ),MELE-200 C CASE OF THE NEW JOINT ELEMENTS (JCT3 AND JCI4) C (JGI2 2D GENERALIZED) C (JGT3 AND JGI4 GENERALIZED) 34 CONTINUE C POUR les XFEM on fait un cas particuliers IF(MFR.EQ.63) THEN CALL SIGMAX (MATE,IMAT,NBGMAT,NELMAT,NMATT,CMATE, & IVAMAT,IMODEL,IREPS2,IVADEP, & IVASTR,UZDPG,RYDPG,RXDPG,IIPDPG,IRETER) * write(*,*) 'retour de SIGMAX' IF(IRETER.NE.0) RETURN GO TO 9990 ENDIF C fin des XFEM C 99 CONTINUE MOTERR(1:4)=NOMTP(MELE) MOTERR(9:12)='SIGM' CALL ERREUR(86) GOTO 9990 C_______________________________________________________________________ C C massifs, poreux, joints poreux C_______________________________________________________________________ C 4 CONTINUE IF (MFR.EQ.71) THEN CALL SIGELE (MELE,IELE,IPMAIL,NBPGAU,IPMINT,NDEP,IVADEP,LHOOK, & LRE,MATE,IVAMAT,NMATT, IVASTR) ELSE IF (MFR.EQ.73) THEN CALL SIGDIF (MELE,IELE,IPMAIL,NBPGAU,IPMINT,NDEP,IVADEP,LHOOK, & LRE,MATE,IVAMAT,NMATT, IVASTR) ELSE CALL SIGMA1(MATE,IMAT,IPMAIL,IPMINT,MELE,IELE,IVADEP, & NBPTEL,LRE,NSTRS,IVAMAT,NBGMAT,NELMAT,LHOOK,NMATT,CMATE, & MFR,NDEP,IPORE,IREPS2,NBPGAU,IVASTR,UZDPG,RYDPG,RXDPG & , IIPDPG,inoer) ENDIF GOTO 9990 C_______________________________________________________________________ C C coq3,dkt,coq4,coq8,coq2 ,dst,joint 3D,joints 2D C_______________________________________________________________________ C 27 CONTINUE CALL SIGMA2(IPMAIL,IVADEP,IVACAR,NELMAT,NBGMAT,IVAMAT, & LHOOK,IMAT,MATE,CMATE,NMATT,NSTRS,MFR,IPMINT,IPMIN1, & NDEP,NBPGAU,NBPTEL,MELE,LRE,LW,IREPS2,NPINT,IVASTR & ,UZDPG,RYDPG,RXDPG,IIPDPG,inoer) GOTO 9990 C_______________________________________________________________________ C C poutres,tuyau,linespring,tuyau fissure,barre C_______________________________________________________________________ C 29 CONTINUE CALL SIGMA3(IPMAIL,IVADEP,NDEP,IVACAR,NCARR,IPMINT,IVECT,IVAMAT, & MELE,IMAT,NELMAT,NBGMAT,LHOOK,CMATE,IREPS2,NBPTEL,NSTRS, & MFR,NMATT,NBPGAU,ISOUS,LRE,LW,IVASTR,UZDPG,RYDPG,RXDPG & , IIPDPG,inoer) GOTO 9990 C=DEB==== FORMULATION HHO ==== Cas particulier de la formulation ======= 89 CONTINUE IF (MELE.NE.HHO_NUM_ELEMENT) THEN write(ioimp,*) 'Branchement MELE / HHO incorrect' CALL ERREUR(5) RETURN END IF CALL HHOSIG (IMODEL, IPCHP1,MODEPL, IIPDPG,UZDPG,RYDPG,RXDPG, & MATE,IVAMAT,NMATR, IPMINT,NBPTEL, & IVASTR,NSTRS, ireth) IF (ireth.NE.0) THEN CALL ERREUR(ireth) RETURN END IF GOTO 9990 C=FIN==== FORMULATION HHO ============================================== C____________________________________________________________________ C C DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE ISOUS C____________________________________________________________________ C 9990 CONTINUE * IF(ISUP1.EQ.1.AND.IMAT.NE.2)THEN CALL DTMVAL(IVAMAT,3) ELSE CALL DTMVAL(IVAMAT,1) ENDIF * IF(ISUP1.EQ.1)THEN CALL DTMVAL(IVACAR,3) ELSE CALL DTMVAL(IVACAR,1) ENDIF * IF(IERR.NE.0)THEN CALL DTMVAL(IVASTR,3) ELSE CALL DTMVAL(IVASTR,1) ENDIF * CALL DTMVAL(IVADEP,1) * IF(MOMATR.NE.0)THEN NOMID=MOMATR if(lsupma)SEGSUP NOMID ENDIF * IF(MOCARA.NE.0)THEN NOMID=MOCARA SEGSUP NOMID ENDIF * IF(MOSTRS.NE.0)THEN NOMID=MOSTRS if(lsupco)SEGSUP NOMID ENDIF * IF(MODEPL.NE.0)THEN NOMID=MODEPL if(lsupdp)SEGSUP NOMID ENDIF C C DANS LE CAS D'ERREUR C IF(IERR.NE.0)THEN IF (MCHAML.NE.0) SEGSUP MCHAML GOTO 888 ENDIF C 500 CONTINUE 888 CONTINUE IF (IERR.NE.0) THEN IRET = 0 SEGSUP MCHELM IPSTRS = 0 ELSE IRET = 1 IPSTRS = MCHELM ENDIF SEGSUP,MOTYR8 END