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

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