C HOOK2P SOURCE AM 12/03/15 21:25:22 7321 SUBROUTINE HOOK2P(IPMODL,IPCHE1,IPCHE2,LASURF,IPCHOO,IRET ) C_______________________________________________________________________ C C Entr{es: C ________ C C IPMODL Pointeur sur un MMODEL C IPCHE1 Pointeur sur un MCHAML de caracteristiques C IPCHE2 Pointeur sur un MCHAML de variables internes(FACULTATIF) C LASURF Flag de pr{sence du mot cl{ REFE C C Sorties: C ________ C C IPCHOO Pointeur sur un MCHAML de matrice de HOOKE C IRET 1 si tout OK 0 sinon C C CODE L.EBERSOLT SEPT 84 C C Passage aux nouveaux CHAMELEMs par I.Monnier le 18.06.90 C_______________________________________________________________________ C IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC CCOPTIO -INC CCHAMP -INC CCGEOME -INC SMCHAML -INC SMMODEL -INC SMINTE * SEGMENT NOTYPE CHARACTER*16 TYPE(NBTYPE) ENDSEGMENT * SEGMENT MPTVAL INTEGER IPOS(NS) ,NSOF(NS) INTEGER IVAL(NCOSOU) CHARACTER*16 TYVAL(NCOSOU) ENDSEGMENT * CHARACTER*8 CMATE CHARACTER*(NCONCH) CONM PARAMETER ( NINF=3) INTEGER INFOS(NINF) LOGICAL lsupva,lsupma C IRET = 0 * * VERIFICATION DU LIEU SUPPORT DU MCHAML DE CARACTERISTIQUE * * AM 16/5/08 REDUCTION PRELABLE DU CHAMP SUR LE MODELE MECA * call reduaf(ipche1,ipmodl,ipche10,0,iretou,kerr) if (iretou.ne.1) call erreur(kerr) if (ierr.ne.0) return ipche1=ipche10 CALL QUESUP(IPMODL,IPCHE1,3,0,ISUP,IRETCA) IF (ISUP.GT.1) THEN call erreur(329) RETURN ENDIF * * VERIFICATION DU LIEU SUPPORT DU MCHAML DE VARIABLES INTERNES * IF (IPCHE2.NE.0) THEN call reduaf(ipche2,ipmodl,ipche20,0,iretou,kerr) if (iretou.ne.1) call erreur(kerr) if (ierr.ne.0) return ipche2=ipche20 CALL QUESUP(IPMODL,IPCHE2,3,0,ISUP2,IRETVI) IF (ISUP2.GT.1) THEN call erreur(329) RETURN ENDIF ENDIF C C ACTIVATION DU MODELE C MMODEL=IPMODL SEGACT MMODEL NSOUS=KMODEL(/1) C C INITIALISATION DU CHAPEAU DES MATRICES DE HOOKE C N1=NSOUS L1=16 N3=6 SEGINI MCHELM IPCHOO=MCHELM TITCHE='MATRICE DE HOOKE' IFOCHE=IFOUR C C BOUCLE SUR LES SOUS ZONES DU MAILLAGE C DO 100 ISOUS=1,NSOUS IVAMAT=0 IVACAR=0 IVARI=0 IVAHOO=0 MOMATR=0 MOCARA=0 NVART=0 IPMINT=0 C C TRAITEMENT DU MODELE C IMODEL=KMODEL(ISOUS) SEGACT IMODEL MELE=NEFMOD IPMAIL=IMAMOD CONM =CONMOD C C CREATION DU TABLEAU INFOS C CALL IDENT(IPMAIL,CONM,IPCHE1,0,INFOS,IRTD) IF (IRTD.EQ.0) GOTO 9990 C * NFOR=FORMOD(/2) * NMAT=MATMOD(/2) * CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INAT) CMATE = CMATEE MATE = IMATEE INAT = INATUU * IF (CMATE.EQ.' ') THEN * CALL ERREUR(251) * SEGSUP MCHELM * SEGDES MMODEL,IMODEL * RETURN * ENDIF C C COQUE INTEGREE OU PAS ? C IF(INFMOD(/1).NE.0)THEN NPINT=INFMOD(1) ELSE NPINT=0 ENDIF C C REMPLISSAGE DE MCHELM DE HOOKE C IMACHE(ISOUS)=IPMAIL CONCHE(ISOUS)=CONMOD C C INFORMATION ELEMENT FINI C * CALL ELQUOI(MELE,0,3,IPINF,IMODEL) * IF (IERR.NE.0) THEN * SEGDES IMODEL,MMODEL * SEGSUP MCHELM * RETURN * ENDIF * INFO=IPINF NBPGAU=INFELE(6) LHOOK=INFELE(10) MFR =INFELE(13) IPPORE=0 IF(MFR.EQ.33)IPPORE=NBNNE(NUMGEO(MELE)) LW =INFELE(7) IPORE = INFELE(8) * * CAS DES DKT INTEGRES * IF (MFR.EQ.3.AND.NPINT.NE.0) LHOOK=4 * LHOO2=LHOOK*LHOOK * MINTE=INFELE(11) MINTE=INFMOD(5) IPMINT=MINTE SEGACT,MINTE C INFCHE(ISOUS,1)=0 INFCHE(ISOUS,2)=0 INFCHE(ISOUS,3)=NIFOUR INFCHE(ISOUS,4)=IPMINT INFCHE(ISOUS,5)=0 INFCHE(ISOUS,6)=3 C C CREATION DU MCHAML DE HOOKE C IF((MELE.EQ.93.OR.MELE.EQ.87.OR.MELE.EQ.88).AND. & CMATE.NE.'ISOTROPE')THEN N2=3 SEGINI MCHAML NOMCHE(1)='MAHO' NOMCHE(2)='V1X ' NOMCHE(3)='V1Y ' TYPCHE(1)='POINTEURLISTREEL' TYPCHE(2)='REAL*8' TYPCHE(3)='REAL*8' ELSE N2=1 SEGINI MCHAML NOMCHE(1)='MAHO' TYPCHE(1)='POINTEURLISTREEL' ENDIF ICHAML(ISOUS)=MCHAML C * TRAITEMENT DES CHAMPS DE MATERIAU * lsupma=.true. IF (FORMOD(1).EQ.'MECANIQUE') THEN IF (CMATE.EQ.'ISOTROPE') THEN IF(INAT.EQ.26.AND.IPCHE2.NE.0) THEN NBROBL=3 NBRFAC=0 SEGINI NOMID MOMATR=NOMID LESOBL(1)='YOUN' LESOBL(2)='NU ' LESOBL(3)='DC ' ELSE IF (INAT.EQ.62.AND.IPCHE2.NE.0) THEN NBROBL=4 NBRFAC=0 SEGINI NOMID MOMATR=NOMID LESOBL(1)='YOUN' LESOBL(2)='NU ' LESOBL(3)='F ' LESOBL(4)='FC ' ELSE IF (INAT.EQ.64.AND.IPCHE2.NE.0) THEN NBROBL=3 NBRFAC=0 SEGINI NOMID MOMATR=NOMID LESOBL(1)='YOUN' LESOBL(2)='NU ' LESOBL(3)='FF ' ELSE 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 ' ENDIF ENDIF NMATR=NBROBL NMATF=NBRFAC ELSEIF (CMATE.EQ.'ORTHOTRO') THEN IF (MFR.EQ.3) THEN * COQUES MINCES 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 ' ELSE IF (MFR.EQ.9.OR.MFR.EQ.5) THEN * COQUES AVEC CISAILLEMENT TRANSVERSE NBROBL=8 NBRFAC=0 SEGINI NOMID MOMATR=NOMID LESOBL(1)='YG1 ' LESOBL(2)='YG2 ' LESOBL(3)='NU12' LESOBL(4)='G12 ' LESOBL(5)='G23 ' LESOBL(6)='G13 ' LESOBL(7)='V1X ' LESOBL(8)='V1Y ' ELSE IF (MFR.EQ.75) THEN * * JOINT UNIDIMENSIONNEL JOI1 * IF(IDIM.EQ.3)THEN NBROBL=12 NBRFAC=0 SEGINI NOMID MOMATR=NOMID LESOBL(1)='V1X ' LESOBL(2)='V1Y ' LESOBL(3)='V1Z ' LESOBL(4)='V2X ' LESOBL(5)='V2Y ' LESOBL(6)='V2Z ' LESOBL(7)='KN ' LESOBL(8)='KS1 ' LESOBL(9)='KS2' LESOBL(10)='QN ' LESOBL(11)='QS1 ' LESOBL(12)='QS2 ' * ELSE IF(IDIM.EQ.2)THEN NBROBL=5 NBRFAC=0 SEGINI NOMID MOMATR=NOMID LESOBL(1)='V1X ' LESOBL(2)='V1Y ' LESOBL(3)='KN ' LESOBL(4)='KS ' LESOBL(5)='QS' ENDIF * ELSE IF (MFR.EQ.1 .OR. MFR.EQ.31) THEN * ELEMENTS MASSIFS IF(IDIM.EQ.3)THEN * ELEMENTS 3D NBROBL=15 NBRFAC=0 SEGINI NOMID MOMATR=NOMID LESOBL(1)='YG1 ' LESOBL(2)='YG2 ' LESOBL(3)='YG3 ' LESOBL(4)='NU12' LESOBL(5)='NU23' LESOBL(6)='NU13' LESOBL(7)='G12 ' LESOBL(8)='G23 ' LESOBL(9)='G13 ' LESOBL(10)='V1X ' LESOBL(11)='V1Y ' LESOBL(12)='V1Z ' LESOBL(13)='V2X ' LESOBL(14)='V2Y ' LESOBL(15)='V2Z ' ELSE IF (IDIM.EQ.2) THEN IF(IFOUR.EQ.-2) THEN * CONT. PLANE NBROBL=9 NBRFAC=0 SEGINI NOMID MOMATR=NOMID LESOBL(1)='YG1 ' LESOBL(2)='YG2 ' LESOBL(3)='NU12 ' LESOBL(4)='G12' LESOBL(5)='V1X ' LESOBL(6)='V1Y ' LESOBL(7)='YG3 ' LESOBL(8)='NU23' LESOBL(9)='NU13' ELSE IF (IFOUR.EQ.-1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.-3) THEN * DEFORMATION PLANE ,AXISYMETRIE NBROBL=9 NBRFAC=0 SEGINI NOMID MOMATR=NOMID LESOBL(1)='YG1 ' LESOBL(2)='YG2 ' LESOBL(3)='YG3 ' LESOBL(4)='NU12' LESOBL(5)='NU23' LESOBL(6)='NU13' LESOBL(7)='G12 ' LESOBL(8)='V1X ' LESOBL(9)='V1Y ' ELSE IF (IFOUR.EQ.1) THEN * AXISYMETRIE DE FOURIER NBROBL=11 NBRFAC=0 SEGINI NOMID MOMATR=NOMID LESOBL(1)='YG1 ' LESOBL(2)='YG2 ' LESOBL(3)='YG3 ' LESOBL(4)='NU12' LESOBL(5)='NU23' LESOBL(6)='NU13' LESOBL(7)='G12 ' LESOBL(8)='G23 ' LESOBL(9)='G13 ' LESOBL(10)='V1X ' LESOBL(11)='V1Y ' ENDIF ENDIF ELSE IF (MFR.EQ.35) THEN * ELEMENTS JOINTS IF (IFOUR.EQ.2) THEN NBROBL=5 NBRFAC=0 SEGINI NOMID MOMATR=NOMID LESOBL(1)='KS1 ' LESOBL(2)='KS2 ' LESOBL(3)='KN ' LESOBL(4)='V1X ' LESOBL(5)='V1Y ' ENDIF ENDIF NMATR=NBROBL NMATF=NBRFAC ELSEIF (CMATE.EQ.'ANISOTRO') THEN IF(MFR.EQ.75)THEN * JOINT UNIDIMESIONNEL JOI1 IF(IDIM.EQ.3)THEN NBROBL=27 NBRFAC=0 SEGINI NOMID MOMATR=NOMID LESOBL(1)='V1X ' LESOBL(2)='V1Y ' LESOBL(3)='V1Z ' LESOBL(4)='V2X ' LESOBL(5)='V2Y ' LESOBL(6)='V2Z ' LESOBL(7)='D11 ' LESOBL(8)='D22 ' LESOBL(9)='D33 ' LESOBL(10)='D44 ' LESOBL(11)='D55 ' LESOBL(12)='D66 ' LESOBL(13)='D21 ' LESOBL(14)='D31 ' LESOBL(15)='D32 ' LESOBL(16)='D41 ' LESOBL(17)='D42 ' LESOBL(18)='D43 ' LESOBL(19)='D51 ' LESOBL(20)='D52 ' LESOBL(21)='D53 ' LESOBL(22)='D54 ' LESOBL(23)='D61 ' LESOBL(24)='D62 ' LESOBL(25)='D63 ' LESOBL(26)='D64 ' LESOBL(27)='D65 ' ELSE IF(IDIM.EQ.2)THEN NBROBL=8 NBRFAC=0 SEGINI NOMID MOMATR=NOMID LESOBL(1)='V1X ' LESOBL(2)='V1Y ' LESOBL(3)='D11 ' LESOBL(4)='D22 ' LESOBL(5)='D33 ' LESOBL(6)='D21 ' LESOBL(7)='D31 ' LESOBL(8)='D32 ' ENDIF * ELSE IF (MFR.EQ.1 .OR. MFR.EQ.31) THEN * ELEMENTS MASSIFS IF(IDIM.EQ.3)THEN * ELEMENTS 3D IF (IFOUR.EQ.2) THEN NBROBL=27 NBRFAC=0 SEGINI NOMID MOMATR=NOMID LESOBL(1)='D11 ' LESOBL(2)='D21 ' LESOBL(3)='D22 ' LESOBL(4)='D31 ' LESOBL(5)='D32 ' LESOBL(6)='D33 ' LESOBL(7)='D41 ' LESOBL(8)='D42 ' LESOBL(9)='D43 ' LESOBL(10)='D44 ' LESOBL(11)='D51 ' LESOBL(12)='D52 ' LESOBL(13)='D53 ' LESOBL(14)='D54 ' LESOBL(15)='D55 ' LESOBL(16)='D61 ' LESOBL(17)='D62 ' LESOBL(18)='D63 ' LESOBL(19)='D64 ' LESOBL(20)='D65 ' LESOBL(21)='D66 ' LESOBL(22)='V1X ' LESOBL(23)='V1Y ' LESOBL(24)='V1Z ' LESOBL(25)='V2X ' LESOBL(26)='V2Y ' LESOBL(27)='V2Z ' ENDIF ELSE IF (IDIM.EQ.2) THEN IF (IFOUR.EQ.-2) THEN * CONTRAINTE PLANE NBROBL=12 NBRFAC=0 SEGINI NOMID MOMATR=NOMID LESOBL(1)='D11 ' LESOBL(2)='D21 ' LESOBL(3)='D22 ' LESOBL(4)='D41 ' LESOBL(5)='D42 ' LESOBL(6)='D44 ' LESOBL(7)='V1X ' LESOBL(8)='V1Y ' LESOBL(9)='D31 ' LESOBL(10)='D32 ' LESOBL(11)='D33 ' LESOBL(12)='D43 ' ELSE IF (IFOUR.EQ.-1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.-3) THEN * DEFORMATION PLANE ,AXISYMETRIE NBROBL=12 NBRFAC=0 SEGINI NOMID MOMATR=NOMID LESOBL(1)='D11 ' LESOBL(2)='D21 ' LESOBL(3)='D22 ' LESOBL(4)='D31 ' LESOBL(5)='D32 ' LESOBL(6)='D33 ' LESOBL(7)='D41 ' LESOBL(8)='D42 ' LESOBL(9)='D43 ' LESOBL(10)='D44 ' LESOBL(11)='V1X ' LESOBL(12)='V1Y ' ELSE IF (IFOUR.EQ.1) THEN * AXISYMETRIE DE FOURIER NBROBL=15 NBRFAC=0 SEGINI NOMID MOMATR=NOMID LESOBL(1)='D11 ' LESOBL(2)='D21 ' LESOBL(3)='D22 ' LESOBL(4)='D31 ' LESOBL(5)='D32 ' LESOBL(6)='D33 ' LESOBL(7)='D41 ' LESOBL(8)='D42 ' LESOBL(9)='D43 ' LESOBL(10)='D44 ' LESOBL(11)='D55 ' LESOBL(12)='D65 ' LESOBL(13)='D66 ' LESOBL(14)='V1X ' LESOBL(15)='V1Y ' ENDIF ENDIF ENDIF NMATR=NBROBL NMATF=NBRFAC ELSEIF (CMATE.EQ.'UNIDIREC') THEN IF (IDIM.EQ.3.AND.(MFR.EQ.1.OR.MFR.EQ.33)) THEN IF (MFR.EQ.1) THEN NBROBL=7 ELSE NBROBL=9 ENDIF 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 ' IF (MFR.EQ.33) THEN LESOBL(8)='COB ' LESOBL(9)='MOB ' ENDIF ELSE IF (MFR.EQ.33) THEN NBROBL=5 ELSE NBROBL=3 ENDIF NBRFAC=0 SEGINI NOMID MOMATR=NOMID LESOBL(1)='YOUN' LESOBL(2)='V1X ' LESOBL(3)='V1Y ' IF (MFR.EQ.33) THEN LESOBL(4)='COB ' LESOBL(5)='MOB ' ENDIF ENDIF NMATR=NBROBL NMATF=NBRFAC * ELSEIF (CMATE.EQ.'ZONE_COH') THEN NBROBL=0 NBRFAC=0 IF (MFR.EQ.77) THEN NBROBL=2 SEGINI NOMID MOMATR=NOMID LESOBL(1)='KS ' LESOBL(2)='KN ' ENDIF NMATR=NBROBL NMATF=NBRFAC * 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 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 SEGINI NOTYPE TYPE(1)='REAL*8' ENDIF MOTYPE=NOTYPE CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT) SEGSUP NOTYPE IF (IERR.NE.0) GOTO 9990 NMATT=NMATR+NMATF * IF (MOMATR.NE.0.AND.ISUP.EQ.1) THEN CALL VALCHE (IVAMAT,NMATT,IPMINT,IPPORE) ENDIF C____________________________________________________________________ C * TRAITEMENT DES CHAMPS DE CARACTERISTIQUES * C____________________________________________________________________ C NBROBL=0 NBRFAC=0 NBTYPE=0 * * 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' * * 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' * * CARACTERISTIQUES POUR LES POUTRES * ELSE IF (MFR.EQ.7 ) THEN IF (CMATE.NE.'SECTION') THEN IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN NBROBL=2 NBRFAC=1 SEGINI NOMID MOCARA=NOMID LESOBL(1)='SECT' LESOBL(2)='INRZ' LESFAC(1)='SECY' ELSE NBROBL=4 NBRFAC=2 SEGINI NOMID MOCARA=NOMID LESOBL(1)='TORS' LESOBL(2)='INRY' LESOBL(3)='INRZ' LESOBL(4)='SECT' LESFAC(1)='SECY' LESFAC(2)='SECZ' ENDIF ENDIF * * CARACTERISTIQUES POUR LES TUYAUX * ELSE IF (MFR.EQ.13) THEN NBROBL=2 NBRFAC=3 SEGINI NOMID MOCARA=NOMID LESOBL(1)='EPAI' LESOBL(2)='RAYO' LESFAC(1)='RACO' LESFAC(2)='PRES' LESFAC(3)='CISA' * * 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 * * 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' C ENDIF * IF (IPCHE1.NE.0.AND.MOCARA.NE.0) THEN NBTYPE=1 SEGINI NOTYPE MOTYPE=NOTYPE TYPE(1)='REAL*8' CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,IVACAR) SEGSUP NOTYPE IF (IERR.NE.0) GOTO 9990 NOMID=MOCARA SEGDES NOMID ENDIF NCARA=NBROBL NCARF=NBRFAC NCARR=NCARA+NCARF * IF (MOCARA.NE.0.AND.ISUP.EQ.1) THEN CALL VALCHE (IVACAR,NCARR,IPMINT,IPPORE) ENDIF segdes mchaml * * DANS LE CAS DE L'ELEMENT DST, JOT3 ET JOI4 ORTHO. ON STOCKE EGALEMENT * V1X ET V1Y * IF ((MELE.EQ.93.OR.MELE.EQ.87.OR.MELE.EQ.88).AND. & CMATE.NE.'ISOTROPE')THEN MPTVAL=IVAMAT IF(CMATE.EQ.'ORTHOTRO')THEN IF (MELE.EQ.87.OR.MELE.EQ.88) THEN MELVA1=IVAL(4) ELSE MELVA1=IVAL(7) ENDIF ELSE MELVA1=IVAL(2) ENDIF SEGINI,MELVAL=MELVA1 IELVAL(2)=MELVAL SEGDES MELVAL IF(CMATE.EQ.'ORTHOTRO')THEN IF (MELE.EQ.87.OR.MELE.EQ.88) THEN MELVA1=IVAL(5) ELSE MELVA1=IVAL(8) ENDIF ELSE MELVA1=IVAL(3) ENDIF SEGINI,MELVAL=MELVA1 IELVAL(3)=MELVAL SEGDES MELVAL ENDIF C____________________________________________________________________ C * TRAITEMENT DES CHAMPS DE VARIABLES INTERNES * C____________________________________________________________________ C lsupva=.true. IF (IPCHE2.NE.0) THEN if(lnomid(10).ne.0) then nomid=lnomid(10) segact nomid movari=nomid nvari=lesobl(/2) nvarf=lesfac(/2) lsupva=.false. else CALL IDVARI(MFR,IMODEL,MOVARI,NVARI,NVARF) endif IF (MOVARI.EQ.0) THEN MOTERR(1:4)='VARI' MOTERR(5:8)=NOMTP(MELE) CALL ERREUR (76) GOTO 9990 ENDIF NVART=NVARI+NVARF * NBTYPE=1 SEGINI NOTYPE MOTYPE=NOTYPE TYPE(1)='REAL*8' CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOVARI,MOTYPE,1, 1 INFOS,3,IVARI) SEGSUP NOTYPE IF (IERR.NE.0) GOTO 9990 * IF (ISUP2.EQ.1) THEN CALL VALCHE(IVARI,NVART,IPMINT,IPPORE) ENDIF ENDIF C____________________________________________________________________ * * RECHERCHE DES DIMENSIONS DU MELVAL DE HOOKE * C____________________________________________________________________ N2PTEL=0 N2EL=0 MPTVAL=IVAMAT DO 40 IO=1,NMATT IF(IVAL(IO).NE.0)THEN MELVAL=IVAL(IO) IF (CMATE.EQ.'SECTION') THEN N2PTEL=MAX(N2PTEL,IELCHE(/1)) N2EL =MAX(N2EL ,IELCHE(/2)) ELSE N2PTEL=MAX(N2PTEL,VELCHE(/1)) N2EL =MAX(N2EL ,VELCHE(/2)) ENDIF ENDIF 40 CONTINUE MPTVAL=IVACAR DO 41 IO=1,NCARR IF(IVAL(IO).NE.0)THEN MELVAL=IVAL(IO) IF (CMATE.EQ.'SECTION') THEN N2PTEL=MAX(N2PTEL,IELCHE(/1)) N2EL =MAX(N2EL ,IELCHE(/2)) ELSE N2PTEL=MAX(N2PTEL,VELCHE(/1)) N2EL =MAX(N2EL ,VELCHE(/2)) ENDIF ENDIF 41 CONTINUE IF (IPCHE2.NE.0) THEN MPTVAL=IVARI DO 42 IO=1,NVART IF(IVAL(IO).NE.0)THEN MELVAL=IVAL(IO) IF (CMATE.EQ.'SECTION') THEN N2PTEL=MAX(N2PTEL,IELCHE(/1)) N2EL =MAX(N2EL ,IELCHE(/2)) ELSE N2PTEL=MAX(N2PTEL,VELCHE(/1)) N2EL =MAX(N2EL ,VELCHE(/2)) ENDIF ENDIF 42 CONTINUE ENDIF C IF (N2PTEL.EQ.1.OR.NBPGAU.EQ.1) THEN N2PTEL=1 ELSE N2PTEL=NBPGAU ENDIF * * INITIALISATION DU MELVAL DE HOOKE * N1PTEL=0 N1EL=0 SEGINI MELVAL IVAHOO=MELVAL IELVAL(1)=MELVAL * KCAS=1 IF (IPCHE2.EQ.0) INAT=0 CALL HOOK2D(IMODEL,CMATE,INAT,MFR,IVAMAT,NMATT,IVACAR, 1 NCARR,NPINT,IVARI,NVART,IVAHOO,KCAS,NBPGAU, 2 LHOOK,LHOO2,LW,LASURF,IPORE,IRTD) C IF (IRTD.LE.0 ) GOTO 9990 C C____________________________________________________________________ C C DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE ISOUS C____________________________________________________________________ C 510 CONTINUE SEGDES,MINTE SEGDES IMODEL MELVAL=IVAHOO SEGDES MELVAL * IF (ISUP.EQ.1) THEN CALL DTMVAL(IVAMAT,3) CALL DTMVAL(IVACAR,3) ELSE CALL DTMVAL(IVAMAT,1) CALL DTMVAL(IVACAR,1) ENDIF * NOMID=MOCARA IF (MOCARA.NE.0) SEGSUP NOMID NOMID=MOMATR if(lsupma)SEGSUP NOMID * IF(IPCHE2.NE.0) THEN IF (ISUP2.EQ.1) THEN CALL DTMVAL(IVARI,3) ELSE CALL DTMVAL(IVARI,1) ENDIF NOMID=MOVARI if(lsupva)SEGSUP NOMID ENDIF C C ERREUR LE MATERIAU PAS ENCORE IMPLEMENTE POUR LA C FORMULATION MFR ET L OPTION IFOUR C IF(IERR.NE.0) THEN MOTERR(1:8)=CMATE * MOTERR(9:12)=NOMFR(MFR/2+1) MFR PAS DEFINI PV INTERR(1)=IFOUR CALL ERREUR(81) GOTO 888 ENDIF 100 CONTINUE IRET = 1 * 888 CONTINUE SEGDES MCHELM 666 CONTINUE RETURN * * ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR * 9990 CONTINUE IRET = 0 IF (IPMINT.NE.0) SEGDES,MINTE IF (ISUP.EQ.1) THEN CALL DTMVAL(IVAMAT,3) CALL DTMVAL(IVACAR,3) ELSE CALL DTMVAL(IVAMAT,1) CALL DTMVAL(IVACAR,1) ENDIF * NOMID=MOCARA IF (MOCARA.NE.0) SEGSUP NOMID NOMID=MOMATR IF (MOMATR.NE.0.and.lsupma) SEGSUP NOMID * IF (IPCHE2.NE.0.AND.IVARI.NE.0) THEN IF (ISUP2.EQ.1) THEN CALL DTMVAL(IVARI,3) ELSE CALL DTMVAL(IVARI,1) ENDIF NOMID=MOVARI if(lsupva)SEGSUP NOMID ENDIF * IF(IVAHOO.NE.0) THEN MELVAL=IVAHOO SEGSUP MELVAL ENDIF SEGDES IMODEL SEGSUP MCHAML * SEGDES MMODEL IF (IPCHE1.NE.0) THEN MCHEL1=IPCHE1 SEGDES MCHEL1 ENDIF SEGSUP MCHELM RETURN END