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

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