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

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