Télécharger la plaquette Cast3M


fr en

Télécharger hook2p.eso

Retour à la liste

Numérotation des lignes : 

hook2p

  1. C HOOK2P    SOURCE    OF166741  25/02/21    21:17:31     12166          
  2.  
  3.       SUBROUTINE HOOK2P(MODORI,IPCHE1,IPCHE2,LASURF,IPCHOO,IRET  )
  4. C_______________________________________________________________________
  5. C
  6. C  Entrees:
  7. C  ________
  8. C
  9. C    MODORI   Pointeur sur un MMODEL
  10. C    IPCHE1   Pointeur sur un MCHAML de caracteristiques
  11. C    IPCHE2   Pointeur sur un MCHAML de variables internes(FACULTATIF)
  12. C    LASURF   Flag de presence du mot cle REFE
  13. C
  14. C  Sorties:
  15. C  ________
  16. C
  17. C     IPCHOO  Pointeur sur un MCHAML de matrice de HOOKE
  18. C     IRET    1 si tout OK 0 sinon
  19. C_______________________________________________________________________
  20.  
  21.       IMPLICIT INTEGER(I-N)
  22.       IMPLICIT REAL*8(A-H,O-Z)
  23.  
  24. -INC PPARAM
  25. -INC CCOPTIO
  26. -INC SMCOORD
  27. -INC CCHAMP
  28. -INC CCGEOME
  29.  
  30. -INC SMCHAML
  31. -INC SMMODEL
  32. -INC SMLREEL
  33. -INC SMINTE
  34.  
  35. -INC TMPTVAL
  36.  
  37.       SEGMENT NOTYPE
  38.         CHARACTER*16 TYPE(NBTYPE)
  39.       ENDSEGMENT
  40.  
  41.       CHARACTER*8 CMATE
  42.       CHARACTER*(NCONCH) CONM
  43.       PARAMETER ( NINF=3)
  44.       INTEGER INFOS(NINF)
  45.       LOGICAL lsupva,lsupma
  46.  
  47.       IRET = 0
  48.  
  49.       call pimodl(modori,ipmodl,maildg,0)
  50.       if (ipmodl.eq.0) return
  51.  
  52. * AM  16/5/08 REDUCTION PRELABLE DU CHAMP SUR LE MODELE MECA
  53.       call reduaf(ipche1,ipmodl,ipche10,0,iretou,kerr)
  54.       if (iretou.ne.1) call erreur(kerr)
  55.       if (ierr.ne.0) return
  56.       ipche1=ipche10
  57.  
  58. *     VERIFICATION DU LIEU SUPPORT DU MCHAML DE CARACTERISTIQUE
  59. *
  60.       CALL QUESUP(IPMODL,IPCHE1,3,0,ISUP,IRETCA)
  61.       IF (ISUP.GT.1) THEN
  62.         call erreur(329)
  63.         RETURN
  64.       ENDIF
  65. *
  66. *     VERIFICATION DU LIEU SUPPORT DU MCHAML DE VARIABLES INTERNES
  67. *
  68.       IF (IPCHE2.NE.0) THEN
  69.         call reduaf(ipche2,ipmodl,ipche20,0,iretou,kerr)
  70.         if (iretou.ne.1) call erreur(kerr)
  71.         if (ierr.ne.0) return
  72.         ipche2=ipche20
  73.         CALL QUESUP(IPMODL,IPCHE2,3,0,ISUP2,IRETVI)
  74.         IF (ISUP2.GT.1) THEN
  75.           call erreur(329)
  76.           RETURN
  77.         ENDIF
  78.       ENDIF
  79.  
  80. C Petit segment utile
  81.       NBTYPE=1
  82.       SEGINI NOTYPE
  83.       TYPE(1)='REAL*8'
  84.       MOTYR8 = NOTYPE
  85.  
  86. C     ACTIVATION DU MODELE
  87. C
  88.       MMODEL=IPMODL
  89.       NSOUS=KMODEL(/1)
  90.  
  91.       N1 = NSOUS
  92. C
  93. C     ON NE TIENT PAS COMPTE D'UN EVENTUEL MODELE CHARGEMENT
  94. C Pimodl ne le fait-il pas ?
  95.       DO III = 1,NSOUS
  96.         IMODEL = KMODEL(III)
  97.         IF (FORMOD(1).EQ.'CHARGEMENT') N1=N1-1
  98.       END DO
  99.       IF (N1.NE.NSOUS) THEN
  100.         write(ioimp,*) 'HOOK2P : PIMODL & CHARGEMENT'
  101.         call erreur(5)
  102.       ENDIF
  103. C
  104. C     INITIALISATION DU CHAPEAU DES MATRICES DE HOOKE
  105. C
  106.       L1=16
  107.       N3=6
  108.       SEGINI MCHELM
  109.       IPCHOO=MCHELM
  110.       TITCHE='MATRICE DE HOOKE'
  111.       IFOCHE=IFOUR
  112. C
  113. C     BOUCLE SUR LES SOUS ZONES DU MAILLAGE
  114. C
  115.       DO 100 ISOUS=1,N1
  116.  
  117.       IVAMAT=0
  118.       IVACAR=0
  119.       IVARI =0
  120.       IVAHOO=0
  121.       MOMATR=0
  122.       MOCARA=0
  123.       NVART =0
  124.       IPMINT=0
  125.       lsupma=.true.
  126.       lsupva=.true.
  127. C
  128. C     TRAITEMENT DU MODELE
  129. C
  130.       IMODEL=KMODEL(ISOUS)
  131.       MELE=NEFMOD
  132.       IPMAIL=IMAMOD
  133.       CONM  =CONMOD
  134. C
  135. C      CREATION DU TABLEAU INFOS
  136. C
  137.        CALL IDENT(IPMAIL,CONM,IPCHE1,0,INFOS,IRTD)
  138.        IF (IRTD.EQ.0) GOTO 9990
  139. C
  140.        CMATE = CMATEE
  141.        MATE  = IMATEE
  142.        INAT  = INATUU
  143. C
  144. C   COQUE INTEGREE OU PAS ?
  145.         NPINT=INFMOD(1)
  146. C
  147. C     REMPLISSAGE DE MCHELM DE HOOKE
  148. C
  149.       IMACHE(ISOUS)=IPMAIL
  150.       CONCHE(ISOUS)=CONMOD
  151. C
  152. C     INFORMATION ELEMENT FINI
  153. C
  154.       NBPGAU=INFELE(6)
  155.       LHOOK=INFELE(10)
  156.       MFR  =INFELE(13)
  157.       IPPORE=0
  158.       IF(MFR.EQ.33)IPPORE=NBNNE(NUMGEO(MELE))
  159.       LW   =INFELE(7)
  160.       IPORE = INFELE(8)
  161. *
  162. * CAS DES DKT INTEGRES
  163. *
  164.       IF (MFR.EQ.3.AND.NPINT.NE.0) LHOOK=4
  165. *
  166.       LHOO2=LHOOK*LHOOK
  167. *      MINTE=INFELE(11)
  168.       MINTE=INFMOD(5)
  169.       IPMINT=MINTE
  170. C
  171.       INFCHE(ISOUS,1)=0
  172.       INFCHE(ISOUS,2)=0
  173.       INFCHE(ISOUS,3)=NIFOUR
  174.       INFCHE(ISOUS,4)=IPMINT
  175.       INFCHE(ISOUS,5)=0
  176.       INFCHE(ISOUS,6)=3
  177. C
  178. C     CREATION DU MCHAML DE HOOKE
  179. C
  180.       IF((MELE.EQ.93.OR.MELE.EQ.87.OR.MELE.EQ.88).AND.
  181.      &    CMATE.NE.'ISOTROPE')THEN
  182.        N2=3
  183.        SEGINI MCHAML
  184.        NOMCHE(1)='MAHO'
  185.        NOMCHE(2)='V1X '
  186.        NOMCHE(3)='V1Y '
  187.        TYPCHE(1)='POINTEURLISTREEL'
  188.        TYPCHE(2)='REAL*8'
  189.        TYPCHE(3)='REAL*8'
  190.       ELSE
  191.        N2=1
  192.        SEGINI MCHAML
  193.        NOMCHE(1)='MAHO'
  194.        TYPCHE(1)='POINTEURLISTREEL'
  195.       ENDIF
  196.       ICHAML(ISOUS)=MCHAML
  197.  
  198. *     TRAITEMENT DES CHAMPS DE MATERIAU
  199. *
  200.          lsupma=.true.
  201.          NBROBL=0
  202.          NBRFAC=0
  203.          NOMID =0
  204.          IF (FORMOD(1).EQ.'MECANIQUE') THEN
  205.           IF (CMATE.EQ.'ISOTROPE') THEN
  206.            IF(INAT.EQ.26.AND.IPCHE2.NE.0) THEN
  207.              NBROBL=3
  208.              SEGINI NOMID
  209.              LESOBL(1)='YOUN'
  210.              LESOBL(2)='NU  '
  211.              LESOBL(3)='DC  '
  212.            ELSE IF (INAT.EQ.62.AND.IPCHE2.NE.0) THEN
  213.              NBROBL=4
  214.              SEGINI NOMID
  215.              LESOBL(1)='YOUN'
  216.              LESOBL(2)='NU  '
  217.              LESOBL(3)='F   '
  218.              LESOBL(4)='FC  '
  219.            ELSE IF (INAT.EQ.64.AND.IPCHE2.NE.0) THEN
  220.              NBROBL=3
  221.              SEGINI NOMID
  222.              LESOBL(1)='YOUN'
  223.              LESOBL(2)='NU  '
  224.              LESOBL(3)='FF  '
  225.            ELSE
  226.             NBROBL=2
  227.             SEGINI NOMID
  228.             IF (MFR.EQ.35.OR.MFR.EQ.78) THEN
  229.               LESOBL(1)='KS  '
  230.               LESOBL(2)='KN  '
  231.             ELSE IF(MFR.EQ.53) THEN
  232.               NBROBL=1
  233.               SEGADJ,NOMID
  234.               LESOBL(1)='KS  '
  235.             ELSE
  236.               LESOBL(1)='YOUN'
  237.               LESOBL(2)='NU  '
  238.             ENDIF
  239.            ENDIF
  240.           ELSEIF (CMATE.EQ.'ORTHOTRO') THEN
  241.                IF (MFR.EQ.3) THEN
  242. *                 COQUES MINCES
  243.                  NBROBL=6
  244.                  SEGINI NOMID
  245.                  LESOBL(1)='YG1 '
  246.                  LESOBL(2)='YG2 '
  247.                  LESOBL(3)='NU12'
  248.                  LESOBL(4)='G12 '
  249.                  LESOBL(5)='V1X '
  250.                  LESOBL(6)='V1Y '
  251.                ELSE IF (MFR.EQ.9.OR.MFR.EQ.5) THEN
  252. *                 COQUES    AVEC CISAILLEMENT TRANSVERSE
  253.                  NBROBL=8
  254.                  SEGINI NOMID
  255.                  LESOBL(1)='YG1 '
  256.                  LESOBL(2)='YG2 '
  257.                  LESOBL(3)='NU12'
  258.                  LESOBL(4)='G12 '
  259.                  LESOBL(5)='G23 '
  260.                  LESOBL(6)='G13 '
  261.                  LESOBL(7)='V1X '
  262.                  LESOBL(8)='V1Y '
  263.                ELSE IF (MFR.EQ.75) THEN
  264. *
  265. *                 JOINT UNIDIMENSIONNEL JOI1
  266. *
  267.                   IF(IDIM.EQ.3)THEN
  268.                   NBROBL=12
  269.                   SEGINI NOMID
  270.                   LESOBL(1)='V1X '
  271.                   LESOBL(2)='V1Y '
  272.                   LESOBL(3)='V1Z '
  273.                   LESOBL(4)='V2X '
  274.                   LESOBL(5)='V2Y '
  275.                   LESOBL(6)='V2Z '
  276.                   LESOBL(7)='KN '
  277.                   LESOBL(8)='KS1 '
  278.                   LESOBL(9)='KS2'
  279.                   LESOBL(10)='QN '
  280.                   LESOBL(11)='QS1 '
  281.                   LESOBL(12)='QS2 '
  282. *
  283.                   ELSE IF(IDIM.EQ.2)THEN
  284.                   NBROBL=5
  285.                   SEGINI NOMID
  286.                   LESOBL(1)='V1X '
  287.                   LESOBL(2)='V1Y '
  288.                   LESOBL(3)='KN '
  289.                   LESOBL(4)='KS '
  290.                   LESOBL(5)='QS'
  291.                   ENDIF
  292. *
  293.                ELSE IF (MFR.EQ.1 .OR. MFR.EQ.31) THEN
  294. *                 ELEMENTS MASSIFS
  295.                   IF(IDIM.EQ.3)THEN
  296. *                    ELEMENTS 3D
  297.                     NBROBL=15
  298.                     SEGINI NOMID
  299.                     LESOBL(1)='YG1 '
  300.                     LESOBL(2)='YG2 '
  301.                     LESOBL(3)='YG3 '
  302.                     LESOBL(4)='NU12'
  303.                     LESOBL(5)='NU23'
  304.                     LESOBL(6)='NU13'
  305.                     LESOBL(7)='G12 '
  306.                     LESOBL(8)='G23 '
  307.                     LESOBL(9)='G13 '
  308.                     LESOBL(10)='V1X '
  309.                     LESOBL(11)='V1Y '
  310.                     LESOBL(12)='V1Z '
  311.                     LESOBL(13)='V2X '
  312.                     LESOBL(14)='V2Y '
  313.                     LESOBL(15)='V2Z '
  314.                   ELSE IF (IDIM.EQ.2) THEN
  315.                      IF(IFOUR.EQ.-2) THEN
  316. *                       CONT. PLANE
  317.                        NBROBL=9
  318.                        SEGINI NOMID
  319.                        LESOBL(1)='YG1 '
  320.                        LESOBL(2)='YG2 '
  321.                        LESOBL(3)='NU12 '
  322.                        LESOBL(4)='G12'
  323.                        LESOBL(5)='V1X '
  324.                        LESOBL(6)='V1Y '
  325.                        LESOBL(7)='YG3 '
  326.                        LESOBL(8)='NU23'
  327.                        LESOBL(9)='NU13'
  328.          ELSE IF (IFOUR.EQ.-1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.-3) THEN
  329. *            DEFORMATION PLANE ,AXISYMETRIE
  330.                        NBROBL=9
  331.                        SEGINI NOMID
  332.                        LESOBL(1)='YG1 '
  333.                        LESOBL(2)='YG2 '
  334.                        LESOBL(3)='YG3 '
  335.                        LESOBL(4)='NU12'
  336.                        LESOBL(5)='NU23'
  337.                        LESOBL(6)='NU13'
  338.                        LESOBL(7)='G12 '
  339.                        LESOBL(8)='V1X '
  340.                        LESOBL(9)='V1Y '
  341.                      ELSE IF (IFOUR.EQ.1) THEN
  342. *                       AXISYMETRIE DE FOURIER
  343.                        NBROBL=11
  344.                        SEGINI NOMID
  345.                        LESOBL(1)='YG1 '
  346.                        LESOBL(2)='YG2 '
  347.                        LESOBL(3)='YG3 '
  348.                        LESOBL(4)='NU12'
  349.                        LESOBL(5)='NU23'
  350.                        LESOBL(6)='NU13'
  351.                        LESOBL(7)='G12 '
  352.                        LESOBL(8)='G23 '
  353.                        LESOBL(9)='G13 '
  354.                        LESOBL(10)='V1X '
  355.                        LESOBL(11)='V1Y '
  356.                      ENDIF
  357.                   ENDIF
  358.                ELSE IF (MFR.EQ.35) THEN
  359. *                 ELEMENTS JOINTS
  360.                   IF (IFOUR.EQ.2) THEN
  361.                      NBROBL=5
  362.                      SEGINI NOMID
  363.                      LESOBL(1)='KS1 '
  364.                      LESOBL(2)='KS2 '
  365.                      LESOBL(3)='KN  '
  366.                      LESOBL(4)='V1X '
  367.                      LESOBL(5)='V1Y '
  368.                   ENDIF
  369.                ENDIF
  370.           ELSEIF (CMATE.EQ.'ANISOTRO') THEN
  371.                IF(MFR.EQ.75)THEN
  372. *                JOINT UNIDIMESIONNEL JOI1
  373.                     IF(IDIM.EQ.3)THEN
  374.                      NBROBL=27
  375.                      SEGINI NOMID
  376.                      LESOBL(1)='V1X '
  377.                      LESOBL(2)='V1Y '
  378.                      LESOBL(3)='V1Z '
  379.                      LESOBL(4)='V2X '
  380.                      LESOBL(5)='V2Y '
  381.                      LESOBL(6)='V2Z '
  382.                      LESOBL(7)='D11 '
  383.                      LESOBL(8)='D22 '
  384.                      LESOBL(9)='D33 '
  385.                      LESOBL(10)='D44 '
  386.                      LESOBL(11)='D55 '
  387.                      LESOBL(12)='D66 '
  388.                      LESOBL(13)='D21 '
  389.                      LESOBL(14)='D31 '
  390.                      LESOBL(15)='D32 '
  391.                      LESOBL(16)='D41 '
  392.                      LESOBL(17)='D42 '
  393.                      LESOBL(18)='D43 '
  394.                      LESOBL(19)='D51 '
  395.                      LESOBL(20)='D52 '
  396.                      LESOBL(21)='D53 '
  397.                      LESOBL(22)='D54 '
  398.                      LESOBL(23)='D61 '
  399.                      LESOBL(24)='D62 '
  400.                      LESOBL(25)='D63 '
  401.                      LESOBL(26)='D64 '
  402.                      LESOBL(27)='D65 '
  403.                     ELSE IF(IDIM.EQ.2)THEN
  404.                      NBROBL=8
  405.                      SEGINI NOMID
  406.                      LESOBL(1)='V1X '
  407.                      LESOBL(2)='V1Y '
  408.                      LESOBL(3)='D11 '
  409.                      LESOBL(4)='D22 '
  410.                      LESOBL(5)='D33 '
  411.                      LESOBL(6)='D21 '
  412.                      LESOBL(7)='D31 '
  413.                      LESOBL(8)='D32 '
  414.                     ENDIF
  415. *
  416.                ELSE IF (MFR.EQ.1 .OR. MFR.EQ.31) THEN
  417. *                 ELEMENTS MASSIFS
  418.                   IF(IDIM.EQ.3)THEN
  419. *                    ELEMENTS 3D
  420.                    IF (IFOUR.EQ.2) THEN
  421.                     NBROBL=27
  422.                     SEGINI NOMID
  423.                     LESOBL(1)='D11 '
  424.                     LESOBL(2)='D21 '
  425.                     LESOBL(3)='D22 '
  426.                     LESOBL(4)='D31 '
  427.                     LESOBL(5)='D32 '
  428.                     LESOBL(6)='D33 '
  429.                     LESOBL(7)='D41 '
  430.                     LESOBL(8)='D42 '
  431.                     LESOBL(9)='D43 '
  432.                     LESOBL(10)='D44 '
  433.                     LESOBL(11)='D51 '
  434.                     LESOBL(12)='D52 '
  435.                     LESOBL(13)='D53 '
  436.                     LESOBL(14)='D54 '
  437.                     LESOBL(15)='D55 '
  438.                     LESOBL(16)='D61 '
  439.                     LESOBL(17)='D62 '
  440.                     LESOBL(18)='D63 '
  441.                     LESOBL(19)='D64 '
  442.                     LESOBL(20)='D65 '
  443.                     LESOBL(21)='D66 '
  444.                     LESOBL(22)='V1X '
  445.                     LESOBL(23)='V1Y '
  446.                     LESOBL(24)='V1Z '
  447.                     LESOBL(25)='V2X '
  448.                     LESOBL(26)='V2Y '
  449.                     LESOBL(27)='V2Z '
  450.                    ENDIF
  451.                   ELSE IF (IDIM.EQ.2) THEN
  452.                      IF (IFOUR.EQ.-2) THEN
  453. *                       CONTRAINTE PLANE
  454.                        NBROBL=12
  455.                        SEGINI NOMID
  456.                        LESOBL(1)='D11 '
  457.                        LESOBL(2)='D21 '
  458.                        LESOBL(3)='D22 '
  459.                        LESOBL(4)='D41 '
  460.                        LESOBL(5)='D42 '
  461.                        LESOBL(6)='D44 '
  462.                        LESOBL(7)='V1X '
  463.                        LESOBL(8)='V1Y '
  464.                        LESOBL(9)='D31 '
  465.                        LESOBL(10)='D32 '
  466.                        LESOBL(11)='D33 '
  467.                        LESOBL(12)='D43 '
  468.          ELSE IF (IFOUR.EQ.-1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.-3) THEN
  469. *                DEFORMATION PLANE ,AXISYMETRIE
  470.                        NBROBL=12
  471.                        SEGINI NOMID
  472.                        LESOBL(1)='D11 '
  473.                        LESOBL(2)='D21 '
  474.                        LESOBL(3)='D22 '
  475.                        LESOBL(4)='D31 '
  476.                        LESOBL(5)='D32 '
  477.                        LESOBL(6)='D33 '
  478.                        LESOBL(7)='D41 '
  479.                        LESOBL(8)='D42 '
  480.                        LESOBL(9)='D43 '
  481.                        LESOBL(10)='D44 '
  482.                        LESOBL(11)='V1X '
  483.                        LESOBL(12)='V1Y '
  484.                      ELSE IF (IFOUR.EQ.1) THEN
  485. *                       AXISYMETRIE DE FOURIER
  486.                        NBROBL=15
  487.                        SEGINI NOMID
  488.                        LESOBL(1)='D11 '
  489.                        LESOBL(2)='D21 '
  490.                        LESOBL(3)='D22 '
  491.                        LESOBL(4)='D31 '
  492.                        LESOBL(5)='D32 '
  493.                        LESOBL(6)='D33 '
  494.                        LESOBL(7)='D41 '
  495.                        LESOBL(8)='D42 '
  496.                        LESOBL(9)='D43 '
  497.                        LESOBL(10)='D44 '
  498.                        LESOBL(11)='D55 '
  499.                        LESOBL(12)='D65 '
  500.                        LESOBL(13)='D66 '
  501.                        LESOBL(14)='V1X '
  502.                        LESOBL(15)='V1Y '
  503.                      ENDIF
  504.                   ENDIF
  505.                ENDIF
  506.           ELSEIF (CMATE.EQ.'UNIDIREC') THEN
  507.            IF (IDIM.EQ.3.AND.(MFR.EQ.1.OR.MFR.EQ.33)) THEN
  508.              IF (MFR.EQ.1) THEN
  509.               NBROBL=7
  510.              ELSE
  511.               NBROBL=9
  512.              ENDIF
  513.              SEGINI NOMID
  514.              LESOBL(1)='YOUN'
  515.              LESOBL(2)='V1X '
  516.              LESOBL(3)='V1Y '
  517.              LESOBL(4)='V1Z '
  518.              LESOBL(5)='V2X '
  519.              LESOBL(6)='V2Y '
  520.              LESOBL(7)='V2Z '
  521.              IF (MFR.EQ.33) THEN
  522.               LESOBL(8)='COB '
  523.               LESOBL(9)='MOB '
  524.              ENDIF
  525.             ELSE
  526.              IF (MFR.EQ.33) THEN
  527.               NBROBL=5
  528.              ELSE
  529.               NBROBL=3
  530.              ENDIF
  531.              SEGINI NOMID
  532.              LESOBL(1)='YOUN'
  533.              LESOBL(2)='V1X '
  534.              LESOBL(3)='V1Y '
  535.              IF (MFR.EQ.33) THEN
  536.               LESOBL(4)='COB '
  537.               LESOBL(5)='MOB '
  538.              ENDIF
  539.            ENDIF
  540.           ELSEIF (CMATE.EQ.'ZONE_COH') THEN
  541.             IF (MFR.EQ.77) THEN
  542.               NBROBL=2
  543.               SEGINI NOMID
  544.               LESOBL(1)='KS  '
  545.               LESOBL(2)='KN  '
  546.             ENDIF
  547.          ELSE
  548.             nomid=lnomid(6)
  549.             if(nomid.ne.0) then
  550.               NBROBL = lesobl(/2)
  551.               NBRFAC = lesfac(/2)
  552.               lsupma=.false.
  553.             else
  554.               write(ioimp,*) 'LNOMID(6) non defini',imodel,formod(1)
  555.               CALL IDMATR(MFR,IMODEL,NOMID,NBROBL,NBRFAC)
  556.             endif
  557.          ENDIF
  558.         ELSE
  559.             nomid=lnomid(6)
  560.             if(nomid.ne.0) then
  561.               nbrobl=lesobl(/2)
  562.               nbrfac=lesfac(/2)
  563.               lsupma=.false.
  564.             else
  565.               write(ioimp,*) 'LNOMID(6) non defini',imodel,formod(1)
  566.               CALL IDMATR(MFR,IMODEL,NOMID,NBROBL,NBRFAC)
  567.             endif
  568.         ENDIF
  569.         NMATR = NBROBL
  570.         NMATF = NBRFAC
  571.         NMATT = NMATR+NMATF
  572.         MOMATR = NOMID
  573.  
  574.       IF (CMATE.EQ.'SECTION') THEN
  575.          NBTYPE=3
  576.          SEGINI NOTYPE
  577.          TYPE(1)='POINTEURMMODEL'
  578.          TYPE(2)='POINTEURMCHAML'
  579.          TYPE(3)='POINTEURLISTREEL'
  580.       ELSE
  581.          NOTYPE = MOTYR8
  582.       ENDIF
  583.       MOTYPE = NOTYPE
  584.       CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT)
  585.       IF (MOTYPE.NE.MOTYR8) SEGSUP,NOTYPE
  586.       IF (IERR.NE.0) GOTO 9990
  587.  
  588.       IF (MOMATR.NE.0.AND.ISUP.EQ.1) THEN
  589.         CALL VALCHE (IVAMAT,NMATT,IPMINT,IPPORE,MOMATR,MELE)
  590.       ENDIF
  591. C____________________________________________________________________
  592. C
  593. * TRAITEMENT DES CHAMPS DE CARACTERISTIQUES                   *
  594. C____________________________________________________________________
  595. C
  596.          NBROBL=0
  597.          NBRFAC=0
  598.          NBTYPE=0
  599.          NOMID = 0
  600. *
  601. * EPAISSEUR ET EXCENTREMENT DANS LE CAS DES COQUES
  602. *
  603.          IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  604.            NBROBL=1
  605.            NBRFAC=1
  606.            SEGINI NOMID
  607.            LESOBL(1)='EPAI'
  608.            LESFAC(1)='EXCE'
  609. *
  610. * SECTION POUR LES BARRES
  611. *
  612.          ELSE IF (MFR.EQ.27.OR.MFR.EQ.78) THEN
  613.            NBROBL=1
  614.            SEGINI NOMID
  615.            LESOBL(1)='SECT'
  616. *
  617. * EPAISSEUR POUR LES JOINTS GENERALISES
  618. *
  619.          ELSE IF (MFR.EQ.55) THEN
  620.            NBRFAC=1
  621.            SEGINI NOMID
  622.            LESFAC(1)='EPAI'
  623. *
  624. * CARACTERISTIQUES POUR LES POUTRES
  625. *
  626.          ELSE IF (MFR.EQ.7 ) THEN
  627.            IF (CMATE.NE.'SECTION') THEN
  628.             IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN
  629.              NBROBL=2
  630.              NBRFAC=1
  631.              SEGINI NOMID
  632.              LESOBL(1)='SECT'
  633.              LESOBL(2)='INRZ'
  634.              LESFAC(1)='SECY'
  635.             ELSE
  636.              NBROBL=4
  637.              NBRFAC=2
  638.              SEGINI NOMID
  639.              LESOBL(1)='TORS'
  640.              LESOBL(2)='INRY'
  641.              LESOBL(3)='INRZ'
  642.              LESOBL(4)='SECT'
  643.              LESFAC(1)='SECY'
  644.              LESFAC(2)='SECZ'
  645.             ENDIF
  646.            ENDIF
  647. *
  648. * CARACTERISTIQUES POUR LES TUYAUX
  649. *
  650.          ELSE IF (MFR.EQ.13) THEN
  651.            NBROBL=2
  652.            NBRFAC=3
  653.            SEGINI NOMID
  654.            LESOBL(1)='EPAI'
  655.            LESOBL(2)='RAYO'
  656.            LESFAC(1)='RACO'
  657.            LESFAC(2)='PRES'
  658.            LESFAC(3)='CISA'
  659. *
  660. * CARACTERISTIQUES POUR LES LINESPRING
  661. *
  662.          ELSE IF (MFR.EQ.15) THEN
  663.            NBROBL=5
  664.            SEGINI NOMID
  665.            LESOBL(1)='EPAI'
  666.            LESOBL(2)='FISS'
  667.            LESOBL(3)='VX  '
  668.            LESOBL(4)='VY  '
  669.            LESOBL(5)='VZ  '
  670. *
  671. * CARACTERISTIQUES POUR LES TUYAUX FISSURES
  672. *
  673.          ELSE IF (MFR.EQ.17) THEN
  674.            NBROBL=9
  675.            SEGINI NOMID
  676.            LESOBL(1)='RAYO'
  677.            LESOBL(2)='EPAI'
  678.            LESOBL(3)='VX  '
  679.            LESOBL(4)='VY  '
  680.            LESOBL(5)='VZ  '
  681.            LESOBL(6)='VXF '
  682.            LESOBL(7)='VYF '
  683.            LESOBL(8)='VZF '
  684.            LESOBL(9)='ANGL'
  685. *
  686. * CARACTERISTIQUES DES ELEMENTS HOMOGENEISES
  687. *
  688.          ELSE IF (MFR.EQ.37) THEN
  689.            IF(IFOUR.EQ.1.OR.IFOUR.EQ.0) THEN
  690.              NBROBL=4
  691.              SEGINI NOMID
  692.              LESOBL(1)='SCEL'
  693.              LESOBL(2)='SFLU'
  694.              LESOBL(3)='EPS '
  695.              LESOBL(4)='XINE'
  696.            ELSE
  697.              NBROBL=3
  698.              SEGINI NOMID
  699.              LESOBL(1)='SCEL'
  700.              LESOBL(2)='SFLU'
  701.              LESOBL(3)='EPS '
  702.            ENDIF
  703. *
  704. * CARACTERISTIQUE MACRO_EL (element CIFL)
  705. *
  706.          ELSE IF (MFR.EQ.61)THEN
  707.            NBROBL=2
  708.            SEGINI NOMID
  709.            LESOBL(1)= 'SECT'
  710.            LESOBL(2)= 'INRZ'
  711.          ENDIF
  712.  
  713.          NCARA = NBROBL
  714.          NCARF = NBRFAC
  715.          NCARR = NCARA+NCARF
  716.          MOCARA = NOMID
  717.          MOTYPE = MOTYR8
  718.  
  719.          IF (IPCHE1.NE.0.AND.MOCARA.NE.0)  THEN
  720.           CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,IVACAR)
  721.           IF (IERR.NE.0) GOTO 9990
  722. *
  723.          IF (MOCARA.NE.0.AND.ISUP.EQ.1) THEN
  724.             CALL VALCHE (IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  725.          ENDIF
  726.          ENDIF
  727. C         segdes mchaml
  728. *
  729. * DANS LE CAS DE L'ELEMENT DST, JOT3 ET JOI4 ORTHO. ON STOCKE EGALEMENT
  730. * V1X ET V1Y
  731. *
  732.          IF ((MELE.EQ.93.OR.MELE.EQ.87.OR.MELE.EQ.88).AND.
  733.      &        CMATE.NE.'ISOTROPE')THEN
  734.            MPTVAL=IVAMAT
  735.            IF(CMATE.EQ.'ORTHOTRO')THEN
  736.             IF (MELE.EQ.87.OR.MELE.EQ.88) THEN
  737.              MELVA1=IVAL(4)
  738.             ELSE
  739.              MELVA1=IVAL(7)
  740.             ENDIF
  741.            ELSE
  742.             MELVA1=IVAL(2)
  743.            ENDIF
  744.            SEGINI,MELVAL=MELVA1
  745.            IELVAL(2)=MELVAL
  746. C           SEGDES MELVAL
  747.            IF(CMATE.EQ.'ORTHOTRO')THEN
  748.             IF (MELE.EQ.87.OR.MELE.EQ.88) THEN
  749.              MELVA1=IVAL(5)
  750.             ELSE
  751.              MELVA1=IVAL(8)
  752.             ENDIF
  753.            ELSE
  754.             MELVA1=IVAL(3)
  755.            ENDIF
  756.            SEGINI,MELVAL=MELVA1
  757.            IELVAL(3)=MELVAL
  758. C           SEGDES MELVAL
  759.           ENDIF
  760. C____________________________________________________________________
  761. C
  762. * TRAITEMENT DES CHAMPS DE VARIABLES INTERNES                   *
  763. C____________________________________________________________________
  764. C
  765.           IF (IPCHE2.NE.0) THEN
  766.            movari = lnomid(10)
  767.            if(movari.ne.0) then
  768.             nomid=movari
  769.             nvari=lesobl(/2)
  770.             nvarf=lesfac(/2)
  771.             lsupva=.false.
  772.            else
  773.              write(6,*) 'MOVARI = LNOMID(10) = 0',imodel,formod(1)
  774.              CALL IDVARI(MFR,IMODEL,MOVARI,NVARI,NVARF)
  775.             endif
  776.              IF (MOVARI.EQ.0) THEN
  777.                MOTERR(1:4)='VARI'
  778.                MOTERR(5:8)=NOMTP(MELE)
  779.                CALL ERREUR (76)
  780.                GOTO 9990
  781.              ENDIF
  782.              NVART=NVARI+NVARF
  783.              MOTYPE = MOTYR8
  784.  
  785.              CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOVARI,MOTYPE,1,
  786.      1                                        INFOS,3,IVARI)
  787.              IF (IERR.NE.0) GOTO 9990
  788.  
  789.              IF (ISUP2.EQ.1) THEN
  790.               CALL VALCHE(IVARI,NVART,IPMINT,IPPORE,MOVARI,MELE)
  791.              ENDIF
  792.          ENDIF
  793. C____________________________________________________________________
  794. *
  795. *        RECHERCHE DES DIMENSIONS DU MELVAL DE HOOKE
  796. *
  797. C____________________________________________________________________
  798.          N2PTEL=0
  799.          N2EL=0
  800.          MPTVAL=IVAMAT
  801.          DO 40 IO=1,NMATT
  802.           IF(IVAL(IO).NE.0)THEN
  803.            MELVAL=IVAL(IO)
  804.             IF (CMATE.EQ.'SECTION') THEN
  805.               N2PTEL=MAX(N2PTEL,IELCHE(/1))
  806.               N2EL  =MAX(N2EL  ,IELCHE(/2))
  807.             ELSE
  808.               N2PTEL=MAX(N2PTEL,VELCHE(/1))
  809.               N2EL  =MAX(N2EL  ,VELCHE(/2))
  810.             ENDIF
  811.           ENDIF
  812.  40      CONTINUE
  813.          MPTVAL=IVACAR
  814.          DO 41 IO=1,NCARR
  815.           IF(IVAL(IO).NE.0)THEN
  816.            MELVAL=IVAL(IO)
  817.             IF (CMATE.EQ.'SECTION') THEN
  818.               N2PTEL=MAX(N2PTEL,IELCHE(/1))
  819.               N2EL  =MAX(N2EL  ,IELCHE(/2))
  820.             ELSE
  821.               N2PTEL=MAX(N2PTEL,VELCHE(/1))
  822.               N2EL  =MAX(N2EL  ,VELCHE(/2))
  823.             ENDIF
  824.           ENDIF
  825.  41      CONTINUE
  826.          IF (IPCHE2.NE.0) THEN
  827.            MPTVAL=IVARI
  828.            DO 42 IO=1,NVART
  829.             IF(IVAL(IO).NE.0)THEN
  830.               MELVAL=IVAL(IO)
  831.               IF (CMATE.EQ.'SECTION') THEN
  832.                 N2PTEL=MAX(N2PTEL,IELCHE(/1))
  833.                 N2EL  =MAX(N2EL  ,IELCHE(/2))
  834.               ELSE
  835.                 N2PTEL=MAX(N2PTEL,VELCHE(/1))
  836.                 N2EL  =MAX(N2EL  ,VELCHE(/2))
  837.               ENDIF
  838.             ENDIF
  839.  42        CONTINUE
  840.          ENDIF
  841. C
  842.          IF (N2PTEL.EQ.1.OR.NBPGAU.EQ.1) THEN
  843.            N2PTEL=1
  844.          ELSE
  845.            N2PTEL=NBPGAU
  846.          ENDIF
  847. *
  848. *        INITIALISATION DU MELVAL DE HOOKE
  849. *
  850.          N1PTEL=0
  851.          N1EL=0
  852.          SEGINI MELVAL
  853.          IVAHOO=MELVAL
  854.          IELVAL(1)=MELVAL
  855.  
  856. C        Pour ne pas avoir de LOCK dans ESOPE, on cree tous les MLREEL ici
  857. C        Avec un VERROU pour ne pas se marcher dessus dans ESOPE (ooogll)
  858.          JG = LHOO2
  859.          CALL OOOPRL(1)
  860.          DO IB=1,N2EL
  861.            DO IGAU=1,N2PTEL
  862.              SEGINI,MLREEL
  863.              IELCHE(IGAU,IB)=MLREEL
  864.            ENDDO
  865.          ENDDO
  866.          CALL OOOPRL(0)
  867.  
  868.          KCAS=1
  869.          IF (IPCHE2.EQ.0) INAT=0
  870.       CALL HOOK2D(IMODEL,CMATE,INAT,MFR,IVAMAT,NMATT,IVACAR,
  871.      1           NCARR,NPINT,IVARI,NVART,IVAHOO,KCAS,NBPGAU,
  872.      2                     LHOOK,LW,LASURF,IPORE,IRTD)
  873. C
  874.       IF (IRTD.LE.0 ) GOTO 9990
  875. C
  876. C____________________________________________________________________
  877. C
  878. C     DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE ISOUS
  879. C____________________________________________________________________
  880. C
  881.   510 CONTINUE
  882.       MELVAL=IVAHOO
  883. *
  884.       IF (ISUP.EQ.1) THEN
  885.         CALL DTMVAL(IVAMAT,3)
  886.         CALL DTMVAL(IVACAR,3)
  887.       ELSE
  888.         CALL DTMVAL(IVAMAT,1)
  889.         CALL DTMVAL(IVACAR,1)
  890.       ENDIF
  891. *
  892.       NOMID=MOCARA
  893.       IF (MOCARA.NE.0) SEGSUP NOMID
  894.       NOMID=MOMATR
  895.       IF (MOMATR.NE.0.and.lsupma) SEGSUP NOMID
  896. *
  897.        IF(IPCHE2.NE.0) THEN
  898.          IF (ISUP2.EQ.1) THEN
  899.            CALL DTMVAL(IVARI,3)
  900.          ELSE
  901.            CALL DTMVAL(IVARI,1)
  902.          ENDIF
  903.         NOMID=MOVARI
  904.         if(lsupva)SEGSUP NOMID
  905.       ENDIF
  906. C
  907. C     ERREUR LE MATERIAU PAS ENCORE IMPLEMENTE POUR LA
  908. C     FORMULATION MFR ET L OPTION IFOUR
  909. C
  910.       IF(IERR.NE.0) THEN
  911.       MOTERR(1:8)=CMATE
  912. *     MOTERR(9:12)=NOMFR(MFR/2+1)   MFR PAS DEFINI PV
  913.       INTERR(1)=IFOUR
  914.       CALL ERREUR(81)
  915.         GOTO 888
  916.       ENDIF
  917.   100 CONTINUE
  918.  
  919.       IRET = 1
  920.  
  921.       GOTO 888
  922. *
  923. *     ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR
  924. *
  925.  9990 CONTINUE
  926.       IRET  = 0
  927.  
  928. C      IF (IPMINT.NE.0) SEGDES,MINTE
  929.       IF (ISUP.EQ.1) THEN
  930.         CALL DTMVAL(IVAMAT,3)
  931.         CALL DTMVAL(IVACAR,3)
  932.       ELSE
  933.         CALL DTMVAL(IVAMAT,1)
  934.         CALL DTMVAL(IVACAR,1)
  935.       ENDIF
  936. *
  937.       NOMID=MOCARA
  938.       IF (MOCARA.NE.0) SEGSUP NOMID
  939.       NOMID=MOMATR
  940.       IF (MOMATR.NE.0.and.lsupma) SEGSUP NOMID
  941. *
  942.        IF (IPCHE2.NE.0.AND.IVARI.NE.0) THEN
  943.          IF (ISUP2.EQ.1) THEN
  944.            CALL DTMVAL(IVARI,3)
  945.          ELSE
  946.            CALL DTMVAL(IVARI,1)
  947.          ENDIF
  948.         NOMID=MOVARI
  949.         if(lsupva)SEGSUP NOMID
  950.       ENDIF
  951.  
  952.       IF(IVAHOO.NE.0) THEN
  953.         MELVAL=IVAHOO
  954.         SEGSUP MELVAL
  955.       ENDIF
  956.       SEGSUP MCHAML
  957.  
  958.       IF (IPCHE1.NE.0) THEN
  959.         MCHEL1=IPCHE1
  960. C        SEGDES MCHEL1
  961.       ENDIF
  962.       SEGSUP MCHELM
  963.  
  964. C FIN
  965.  888  CONTINUE
  966.       notype = MOTYR8
  967.       SEGSUP,notype
  968.  
  969. c      RETURN
  970.       END
  971.  
  972.  
  973.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales