Télécharger la plaquette Cast3M


fr en

Télécharger thetap.eso

Retour à la liste

Numérotation des lignes : 

thetap

  1. C THETAP    SOURCE    OF166741  25/02/21    21:18:55     12166          
  2.  
  3. *_______________________________________________________________________
  4.  
  5. *  OPERATEUR DE CALCUL DE CONTRAINTES DUES A UN CHAMP DE TEMPERATURE
  6. *  APPELE PAR THETA
  7.  
  8. *  ENTREES :
  9. *  ---------
  10.  
  11. *     IPMODL   POINTEUR SUR UN MMODEL
  12. *     IPCHE1   MCHAML DE SOUS TYPE CARACTERISTIQUE
  13. *     IPCHE2   MCHAML DE SOUS TYPE TEMPERATURE
  14.  
  15. *  SORTIES :
  16. *  ---------
  17.  
  18. *     IPSTRS   MCHAML DE SOUS TYPE CONTRAINTE (DUE @ LA TEMP{RATURE)
  19. *     IRET     1 OU 0 SUIVANT SUCCES OU PAS
  20.  
  21. * PASSAGE AUX NOUVEAUX CHAMELEMS PAR S.RAMAHANDRY LE 05/09/90
  22.  
  23. * VARIATION PARABOLIQUE DE TEMPERATURE DANS LES COQUES,OPTION ORTHOTROPE
  24. * ET ANISOTROPE POUR LES MASSIFS PAR P.DOWLATYARI LE 15/03/91
  25. *_______________________________________________________________________
  26.  
  27.       SUBROUTINE THETAP(IPMODL,IPCHE1,IPCHE2,IPSTRS,IRET)
  28.  
  29.       IMPLICIT INTEGER(I-N)
  30.       IMPLICIT REAL*8(A-H,O-Z)
  31.  
  32. -INC PPARAM
  33. -INC CCOPTIO
  34. -INC CCHAMP
  35.  
  36. -INC SMCHAML
  37. -INC SMELEME
  38. -INC SMINTE
  39. -INC SMMODEL
  40. -INC SMCOORD
  41.  
  42. -INC TMPTVAL
  43.  
  44.       SEGMENT NOTYPE
  45.         CHARACTER*16 TYPE(NBTYPE)
  46.       ENDSEGMENT
  47.  
  48.       SEGMENT WRK1
  49.         REAL*8 WORK(LW)
  50.       ENDSEGMENT
  51.  
  52.       SEGMENT WRK2
  53.         REAL*8 XE(3,NBNN),TXR(IDIM,IDIM)
  54.         REAL*8 XLOC(3,3),XGLOB(3,3)
  55.         REAL*8 ROTS(NSTRS,NSTRS),DHOOK(LHOOK,LHOOK)
  56.       ENDSEGMENT
  57.  
  58.       SEGMENT WRK3
  59.         REAL*8 RES(NSTRS)
  60.       ENDSEGMENT
  61.  
  62.       SEGMENT MVELCH
  63.         REAL*8 VALMAT(NV1)
  64.       ENDSEGMENT
  65.  
  66.       CHARACTER*8        CMATE
  67.       CHARACTER*(NCONCH) CONM
  68.       PARAMETER (NINF=3)
  69.       INTEGER            INFOS(NINF)
  70.       DIMENSION          CRIGI(12)
  71.       LOGICAL            lsupma
  72.  
  73.       IRET   = 0
  74.       IPSTRS = 0
  75.  
  76.       NHRM  = NIFOUR
  77.       THM   = 0.D0
  78.       THIF  = 0.D0
  79.       THSU  = 0.D0
  80.       TEMP  = 0.D0
  81.  
  82. *    VERIFICATION DU LIEU SUPPORT DU MCHAML DE CARACTERISTIQUES
  83.  
  84.       CALL QUESUP(IPMODL,IPCHE1,5,0,ISUPMA,IRETMA)
  85.       IF (ISUPMA.GT.1) RETURN
  86.  
  87. *    VERIFICATION DU LIEU SUPPORT DU MCHAML DE TEMPERATURE
  88.  
  89.       CALL QUESUP(IPMODL,IPCHE2,5,0,ISUPTE,IRETTE)
  90.       IF (ISUPTE.GT.1) RETURN
  91.  
  92. C=============================================
  93. *     CREATION DU MCHELM resultat (decompte des SOUS-ZONES)
  94. C=============================================
  95.       MMODEL=IPMODL
  96.       NSOUS =KMODEL(/1)
  97.       N1=0
  98.       DO 200 ISOUS=1,NSOUS
  99.         IMODEL=KMODEL(ISOUS)
  100.         IF (NEFMOD.EQ.22 ) GOTO 200
  101.         IF (NEFMOD.EQ.259) GOTO 200
  102.         IF (IMODEL.FORMOD(1) .EQ. 'MELANGE         ') GOTO 200
  103.         N1 = N1 + 1
  104.  200  CONTINUE
  105.  
  106.       L1=11
  107.       N3=6
  108.       SEGINI,MCHELM
  109.       mchelm.TITCHE = 'CONTRAINTES'
  110.       mchelm.IFOCHE = IFOUR
  111.  
  112.       nbtype = 1
  113.       SEGINI,notype
  114.       notype.TYPE(1)='REAL*8  '
  115.       MOTYR8 = notype
  116.  
  117. *  Introduction en 2020 : T_ALPHA_REFERENCE dans le MATERIAU
  118.       nbrobl = 1
  119.       nbrfac = 0
  120.       SEGINI,NOMID
  121.       nomid.LESOBL(1) = 'TALP    '
  122.       MOTTAL = nomid
  123.  
  124. *____________________________________________________________________
  125.  
  126. *     DEBUT DE LA BOUCLE SUR LES DIFFERENTES ZONES
  127. *____________________________________________________________________
  128.  
  129.       ISOUS=0
  130.       DO 500 KISOUS=1,NSOUS
  131.  
  132. *     INITIALISATION
  133.  
  134.         MOCARA=0
  135.         MOMATR=0
  136.         MOSTRS=0
  137.         MOTEMP=0
  138.         IVAMAT=0
  139.         IVACAR=0
  140.         IVATEM=0
  141.         IVASTR=0
  142.         NCARA =0
  143.         NCARF =0
  144.  
  145.         IMODEL=KMODEL(KISOUS)
  146.  
  147.         MELE=NEFMOD
  148.         if(mele.eq.22) GOTO 999
  149.         if(mele.eq.259) GOTO 999
  150.         IF (IMODEL.FORMOD(1) .EQ. 'MELANGE         ') GOTO 999
  151.  
  152.         ISOUS=ISOUS+1
  153.  
  154. *     TRAITEMENT DU MODELE
  155.  
  156.         IPMAIL=IMAMOD
  157.         CONM  =CONMOD
  158.  
  159.         IMACHE(ISOUS)=IPMAIL
  160.         CONCHE(ISOUS)=CONMOD
  161.  
  162. *        CREATION DU TABLEAU INFOS
  163.  
  164.         CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE2,INFOS,IRTD)
  165.         IF (IRTD.EQ.0) GOTO 999
  166.  
  167. *     NATURE DU MATERIAU
  168.         CMATE = imodel.CMATEE
  169.         MATE  = imodel.IMATEE
  170.         INAT  = imodel.INATUU
  171.  
  172. C   COQUE INTEGREE OU PAS ?
  173.         NPINT = imodel.INFMOD(1)
  174.  
  175. *        INFORMATION SUR L'ELEMENT FINI
  176.  
  177.         MELE =INFELE(1)
  178.         ICARA=INFELE(5)
  179.         IPORE=INFELE(8)
  180.         MFR  =INFELE(13)
  181.         LHOOK=INFELE(10)
  182.         NBGS =INFELE(4)
  183.         NSTRS=INFELE(16)
  184.         LW   =INFELE(7)
  185. *        IPMINT=INFELE(11)
  186.         IPMINT=INFMOD(7)
  187.  
  188.         INFCHE(ISOUS,1)=0
  189.         INFCHE(ISOUS,2)=0
  190.         INFCHE(ISOUS,3)=NHRM
  191.         INFCHE(ISOUS,4)=IPMINT
  192.         INFCHE(ISOUS,5)=0
  193.         INFCHE(ISOUS,6)=5
  194.  
  195. *        INITIALISATION DE MINTE
  196.  
  197.         MINTE=IPMINT
  198.         NBPGAU = POIGAU(/1)
  199.  
  200. *        ACTIVATION DU MELEME
  201.  
  202.         MELEME=IPMAIL
  203.         NBNN  =NUM(/1)
  204.         NBELEM=NUM(/2)
  205.         NBNO=NBNN
  206.         IF(MFR.EQ.33) NBNO=IPORE
  207.         IELE = NUMGEO(MELE)
  208.         IPPORE=0
  209.         IF(MFR.EQ.33) IPPORE=NBNN
  210.  
  211. *     RECUPERATION DES NOMS DE COMPOSANTES DES STRESSES
  212.         nomid =lnomid(4)
  213.         if (nomid.eq.0) then
  214.           write(ioimp,*) 'MOSTRS = 0'
  215.           call erreur(5)
  216.         endif
  217.         mostrs=nomid
  218.         nstr  =lesobl(/2)
  219.         nfac  =lesfac(/2)
  220.         if (nstr.ne.NSTRS) then
  221.           write(ioimp,*) 'NSTRS != nstr'
  222.           call erreur(5)
  223.         endif
  224.  
  225. *     RECUPERATION DES NOMS DE COMPOSANTES DE LA TEMPERATURE
  226.         nomid = lnomid(8)
  227.         if (nomid.eq.0) then
  228.           write(ioimp,*) 'MOTEMP = 0'
  229.           call erreur(5)
  230.         endif
  231.         motemp=nomid
  232.         ntem =lesobl(/2)
  233.         nfac =lesfac(/2)
  234.  
  235. *     RECUPERATION DES COMPOSANTES DE LA TEMPERATURE DANS IPCHE2
  236.         CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOTEMP,
  237.      1                     MOTYR8,1,INFOS,3,IVATEM)
  238.         IF (IERR.NE.0) GOTO 9990
  239.  
  240. *      CHANGEMENT DE SUPPORT DES MELVAL DANS IVATEM ==> Passage au STRESSES
  241.         IF (ISUPTE.EQ.1)THEN
  242.           CALL VALCHE(IVATEM,NTEM,IPMINT,IPPORE,MOTEMP,MELE)
  243.           IF(IERR.NE.0)THEN
  244.             ISUPTE=0
  245.             GOTO 9990
  246.           ENDIF
  247.         ENDIF
  248.  
  249. *     RECUPERATION DES COMPOSANTES DE T_ALPHA_REFERENCE DANS IPCHE1
  250.         CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOTTAL,
  251.      1                     MOTYR8,1,INFOS,3,IVATAL)
  252.         IF (IERR.NE.0) GOTO 9990
  253.  
  254. *     CHANGEMENT DE SUPPORT DES MELVAL DANS IVATAL ==> Passage au STRESSES
  255.         IF (ISUPTE.EQ.1)THEN
  256.           NCOMP=1
  257.           CALL VALCHE(IVATAL,NCOMP,IPMINT,IPPORE,MOTTAL,MELE)
  258.           IF(IERR.NE.0)THEN
  259.             ISUPTE=0
  260.             GOTO 9990
  261.           ENDIF
  262.         ENDIF
  263.  
  264. *        RECHERCHE DE LA TAILLE DES MELVAL A ALLOUER
  265.  
  266.         N1PTEL=NBGS
  267.         N1EL=NBELEM
  268.  
  269. *        CREATION DU MCHAML DE LA SOUS ZONE
  270.  
  271.         N2=NSTRS
  272.         SEGINI MCHAML
  273.         ICHAML(ISOUS)=MCHAML
  274.         NSR=1
  275.         NCOSOR=NSTRS
  276.         SEGINI MPTVAL
  277.         IVASTR=MPTVAL
  278.         NOMID =MOSTRS
  279.         N2PTEL=0
  280.         N2EL  =0
  281.  
  282.         IF(MELE.EQ.30.OR.MELE.EQ.43) THEN
  283.           N1PTEL=1
  284.           N1EL=1
  285.         ENDIF
  286.         DO 100 ICOMP=1,NSTRS
  287.           NOMCHE(ICOMP)=LESOBL(ICOMP)
  288.           TYPCHE(ICOMP)='REAL*8'
  289.           SEGINI MELVAL
  290.           IELVAL(ICOMP)=MELVAL
  291.           IVAL(ICOMP)=MELVAL
  292.  100    CONTINUE
  293.  
  294. *        TRAITEMENT DES CHAMPS DE MATERIAU
  295.  
  296.         NBROBL = 0
  297.         NBRFAC = 0
  298.         NOMID  = 0
  299.         MOMATR = 0
  300.  
  301.          IF (MELE.EQ.29.OR.MELE.EQ.42.OR.MELE.EQ.45.OR.MELE.EQ.46
  302.      &   .OR.MELE.EQ.95.OR.MELE.EQ.123.OR.MELE.EQ.124
  303.      &   .OR.MELE.EQ.84) THEN
  304.             NBROBL=2
  305.             SEGINI NOMID
  306.             LESOBL(1)='YOUN'
  307.             LESOBL(2)='ALPH'
  308.  
  309. *   materiau isotrope
  310.  
  311.          ELSE IF (CMATE.EQ.'ISOTROPE') THEN
  312.            IF (MFR.EQ.35) THEN
  313.              NBROBL=3
  314.              SEGINI NOMID
  315.              LESOBL(1)='KS  '
  316.              LESOBL(2)='KN  '
  317.              LESOBL(3)='ALPN'
  318.            ELSE
  319.              NBROBL=3
  320.              SEGINI NOMID
  321.              LESOBL(1)='YOUN'
  322.              LESOBL(2)='NU  '
  323.              LESOBL(3)='ALPH'
  324.            ENDIF
  325.  
  326. *  materiau orthotrope
  327.  
  328.          ELSE IF(CMATE.EQ.'ORTHOTRO') THEN
  329.            IF(MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9)THEN
  330.               NBROBL=7
  331.               SEGINI NOMID
  332.               LESOBL(1)='YG1 '
  333.               LESOBL(2)='YG2 '
  334.               LESOBL(3)='NU12'
  335.               LESOBL(4)='ALP1'
  336.               LESOBL(5)='ALP2'
  337.               LESOBL(6)='V1X '
  338.               LESOBL(7)='V1Y '
  339.            ELSE IF (MFR.EQ.35) THEN
  340.               NBROBL=6
  341.               SEGINI NOMID
  342.               LESOBL(1)='KS1 '
  343.               LESOBL(2)='KS2 '
  344.               LESOBL(3)='KN  '
  345.               LESOBL(4)='ALPN'
  346.               LESOBL(5)='V1X'
  347.               LESOBL(6)='V1Y '
  348.            ELSE IF (MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33) THEN
  349.               IF(IFOUR.EQ.-2) THEN
  350.                 NBROBL =10
  351.                 SEGINI NOMID
  352.                 LESOBL(1)='YG1 '
  353.                 LESOBL(2)='YG2 '
  354.                 LESOBL(3)='NU12'
  355.                 LESOBL(4)='ALP1'
  356.                 LESOBL(5)='ALP2'
  357.                 LESOBL(6)='V1X '
  358.                 LESOBL(7)='V1Y '
  359.                 LESOBL(8)='YG3 '
  360.                 LESOBL(9)='NU23'
  361.                 LESOBL(10)='NU13'
  362.  
  363.               ELSE IF (IFOUR.EQ.-1.OR.IFOUR.EQ.0
  364.      1            .OR.IFOUR.EQ.1.OR.IFOUR.EQ.-3)THEN
  365.                 NBROBL = 11
  366.                 SEGINI NOMID
  367.                 LESOBL(1)='YG1 '
  368.                 LESOBL(2)='YG2 '
  369.                 LESOBL(3)='YG3 '
  370.                 LESOBL(4)='NU12'
  371.                 LESOBL(5)='NU23'
  372.                 LESOBL(6)='NU13'
  373.                 LESOBL(7)='ALP1'
  374.                 LESOBL(8)='ALP2'
  375.                 LESOBL(9)='ALP3'
  376.                 LESOBL(10)='V1X '
  377.                 LESOBL(11)='V1Y '
  378.               ELSEIF(IFOUR.EQ.2)THEN
  379.                 NBROBL = 15
  380.                 SEGINI NOMID
  381.                 LESOBL(1)='YG1 '
  382.                 LESOBL(2)='YG2 '
  383.                 LESOBL(3)='YG3 '
  384.                 LESOBL(4)='NU12'
  385.                 LESOBL(5)='NU23'
  386.                 LESOBL(6)='NU13'
  387.                 LESOBL(7)='ALP1'
  388.                 LESOBL(8)='ALP2'
  389.                 LESOBL(9)='ALP3'
  390.                 LESOBL(10)='V1X '
  391.                 LESOBL(11)='V1Y '
  392.                 LESOBL(12)='V1Z '
  393.                 LESOBL(13)='V2X '
  394.                 LESOBL(14)='V2Y '
  395.                 LESOBL(15)='V2Z '
  396. C= Modes de calcul UNIDIMENSIONNELS (1D)
  397.               ELSE IF (IFOUR.GE.3.AND.IFOUR.LE.15) THEN
  398. C= Mode 1D UNID PLAN CYCZ
  399.                 IF (IFOUR.EQ.6) THEN
  400.                   NBROBL=7
  401.                   SEGINI,NOMID
  402.                   LESOBL(1)='YG1 '
  403.                   LESOBL(2)='YG2 '
  404.                   LESOBL(3)='YG3 '
  405.                   LESOBL(4)='NU12'
  406.                   LESOBL(5)='NU23'
  407.                   LESOBL(6)='NU13'
  408.                   LESOBL(7)='ALP1'
  409. C= Modes 1D UNID PLAN CYDZ et CYGZ
  410.                 ELSE IF (IFOUR.EQ.5.OR.IFOUR.EQ.10) THEN
  411.                   NBROBL=8
  412.                   SEGINI,NOMID
  413.                   LESOBL(1)='YG1 '
  414.                   LESOBL(2)='YG2 '
  415.                   LESOBL(3)='YG3 '
  416.                   LESOBL(4)='NU12'
  417.                   LESOBL(5)='NU23'
  418.                   LESOBL(6)='NU13'
  419.                   LESOBL(7)='ALP1'
  420.                   LESOBL(8)='ALP3'
  421.                 ELSE IF (IFOUR.EQ.4.OR.IFOUR.EQ.8.OR.IFOUR.EQ.13) THEN
  422. C= Modes 1D UNID PLAN DYCZ et GYCZ, et mode 1D UNID AXIS AXCZ
  423.                   NBROBL=8
  424.                   SEGINI,NOMID
  425.                   LESOBL(1)='YG1 '
  426.                   LESOBL(2)='YG2 '
  427.                   LESOBL(3)='YG3 '
  428.                   LESOBL(4)='NU12'
  429.                   LESOBL(5)='NU23'
  430.                   LESOBL(6)='NU13'
  431.                   LESOBL(7)='ALP1'
  432.                   LESOBL(8)='ALP2'
  433.                 ELSE
  434. C= Autres modes de calcul 1D UNID
  435. C= Mode 1D UNID SPHErique : on suppose que YG2=YG3  NU12=NU13  ALP2=ALP3
  436.                   NBROBL=9
  437.                   SEGINI,NOMID
  438.                   LESOBL(1)='YG1 '
  439.                   LESOBL(2)='YG2 '
  440.                   LESOBL(3)='YG3 '
  441.                   LESOBL(4)='NU12'
  442.                   LESOBL(5)='NU23'
  443.                   LESOBL(6)='NU13'
  444.                   LESOBL(7)='ALP1'
  445.                   LESOBL(8)='ALP2'
  446.                   LESOBL(9)='ALP3'
  447.                 ENDIF
  448.               ENDIF
  449.            ENDIF
  450.  
  451. *  materiau anisotrope
  452.  
  453.          ELSE IF(CMATE.EQ.'ANISOTRO') THEN
  454.            IF(MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33)THEN
  455.              IF(IFOUR.EQ.-2) THEN
  456.                NBROBL=15
  457.                SEGINI NOMID
  458.                LESOBL(1)='D11 '
  459.                LESOBL(2)='D21 '
  460.                LESOBL(3)='D22 '
  461.                LESOBL(4)='D41 '
  462.                LESOBL(5)='D42 '
  463.                LESOBL(6)='D44 '
  464.                LESOBL(7)='ALP1'
  465.                LESOBL(8)='ALP2'
  466.                LESOBL(9)='AL12'
  467.                LESOBL(10)='V1X '
  468.                LESOBL(11)='V1Y '
  469.                LESOBL(12)='D31 '
  470.                LESOBL(13)='D32 '
  471.                LESOBL(14)='D33 '
  472.                LESOBL(15)='D43 '
  473.              ELSE IF(IFOUR.EQ.-3.OR.IFOUR.
  474.      1        EQ.-1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.1)THEN
  475.                NBROBL=16
  476.                SEGINI NOMID
  477.                LESOBL(1)='D11 '
  478.                LESOBL(2)='D21 '
  479.                LESOBL(3)='D22 '
  480.                LESOBL(4)='D31 '
  481.                LESOBL(5)='D32 '
  482.                LESOBL(6)='D33 '
  483.                LESOBL(7)='D41 '
  484.                LESOBL(8)='D42 '
  485.                LESOBL(9)='D43 '
  486.                LESOBL(10)='D44 '
  487.                LESOBL(11)='ALP1'
  488.                LESOBL(12)='ALP2'
  489.                LESOBL(13)='AL12'
  490.                LESOBL(14)='ALP3'
  491.                LESOBL(15)='V1X '
  492.                LESOBL(16)='V1Y '
  493.              ELSEIF(IFOUR.EQ.2)THEN
  494.                NBROBL=33
  495.                SEGINI NOMID
  496.                LESOBL(1)='D11 '
  497.                LESOBL(2)='D21 '
  498.                LESOBL(3)='D22 '
  499.                LESOBL(4)='D31 '
  500.                LESOBL(5)='D32 '
  501.                LESOBL(6)='D33 '
  502.                LESOBL(7)='D41 '
  503.                LESOBL(8)='D42 '
  504.                LESOBL(9)='D43 '
  505.                LESOBL(10)='D44 '
  506.                LESOBL(11)='D51 '
  507.                LESOBL(12)='D52 '
  508.                LESOBL(13)='D53 '
  509.                LESOBL(14)='D54 '
  510.                LESOBL(15)='D55 '
  511.                LESOBL(16)='D61 '
  512.                LESOBL(17)='D62 '
  513.                LESOBL(18)='D63 '
  514.                LESOBL(19)='D64 '
  515.                LESOBL(20)='D65 '
  516.                LESOBL(21)='D66 '
  517.                LESOBL(22)='ALP1'
  518.                LESOBL(23)='ALP2'
  519.                LESOBL(24)='ALP3'
  520.                LESOBL(25)='AL12'
  521.                LESOBL(26)='AL13'
  522.                LESOBL(27)='AL23'
  523.                LESOBL(28)='V1X '
  524.                LESOBL(29)='V1Y '
  525.                LESOBL(30)='V1Z '
  526.                LESOBL(31)='V2X '
  527.                LESOBL(32)='V2Y '
  528.                LESOBL(33)='V2Z '
  529.              ENDIF
  530.            ENDIF
  531.  
  532. *  materiau unidirectionnel
  533.  
  534.          ELSE IF(CMATE.EQ.'UNIDIREC') THEN
  535. *  MLR 31/1/97      IF(IFOUR.EQ.2)THEN
  536.           IF (MFR.EQ.1.AND.IDIM.EQ.3) THEN
  537.               NBROBL=8
  538.               SEGINI NOMID
  539.               LESOBL(1)='YOUN'
  540.               LESOBL(2)='ALPH'
  541.               LESOBL(3)='V1X '
  542.               LESOBL(4)='V1Y '
  543.               LESOBL(5)='V1Z '
  544.               LESOBL(6)='V2X '
  545.               LESOBL(7)='V2Y '
  546.               LESOBL(8)='V2Z '
  547.             ELSE
  548.               NBROBL=4
  549.               SEGINI NOMID
  550.               LESOBL(1)='YOUN'
  551.               LESOBL(2)='ALPH'
  552.               LESOBL(3)='V1X '
  553.               LESOBL(4)='V1Y '
  554.             ENDIF
  555. C         ENDIF
  556.         ENDIF
  557.         MOMATR = NOMID
  558.         IF (MOMATR.EQ.0) CALL ERREUR(5)
  559.         NMATT=NBROBL+NBRFAC
  560.  
  561. *        Types attendus des composantes
  562.         IF (CMATE.EQ.'SECTION') THEN
  563.           NBTYPE=3
  564.           SEGINI NOTYPE
  565.           TYPE(1)='POINTEURMMODEL'
  566.           TYPE(2)='POINTEURMCHAML'
  567.           TYPE(3)='POINTEURLISTREEL'
  568.         ELSE
  569.           NOTYPE=MOTYR8
  570.         ENDIF
  571.  
  572. *     Recuperation des COMPOSANTES des NOMID
  573.         CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOMATR,
  574.      1                      NOTYPE,1,INFOS,3,IVAMAT)
  575.         IF (NOTYPE.NE.MOTYR8) SEGSUP,NOTYPE
  576.         IF (IERR.NE.0) GOTO 9990
  577.  
  578. *        CHANGEMENT DE SUPPORT DES MELVAL DANS IVAMAT ==> Passage au STRESSES
  579.         IF(ISUPMA.EQ.1)THEN
  580.           CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE,MOMATR,MELE)
  581.           IF(IERR.NE.0)THEN
  582.             ISUPMA=0
  583.             GOTO 9990
  584.           ENDIF
  585.         ENDIF
  586.         NBGMAT = 0
  587.         NELMAT = 0
  588.         MPTVAL=IVAMAT
  589.         DO 1108 IM=1,NMATT
  590.           MELVAL=IVAL(IM)
  591.           IF(MELVAL.NE.0)THEN
  592.             IF (CMATE.EQ.'SECTION') THEN
  593.               NBGMAT=MAX(NBGMAT,MELVAL.IELCHE(/1))
  594.               NELMAT=MAX(NELMAT,MELVAL.IELCHE(/2))
  595.             ELSE
  596.               NBGMAT=MAX(NBGMAT,MELVAL.VELCHE(/1))
  597.               NELMAT=MAX(NELMAT,MELVAL.VELCHE(/2))
  598.             ENDIF
  599.           ENDIF
  600.  1108   CONTINUE
  601.  
  602. *     TRAITEMENT DES CHAMPS DE CARACTERISTIQUES
  603.         NBROBL = 0
  604.         NBRFAC = 0
  605.         NOMID  = 0
  606.         IVECT  = 0
  607.         NOTYPE = MOTYR8
  608.  
  609. *        EPAISSEUR DANS LE CAS DES COQUES
  610.         IF (MFR.EQ.3.OR.MFR.EQ.9) THEN
  611.           NBROBL=1
  612.           SEGINI NOMID
  613.           LESOBL(1)='EPAI'
  614.  
  615. *        SECTION POUR LES BARRES ET LES CERCES
  616.         ELSE IF (MFR.EQ.27) THEN
  617.           NBROBL=1
  618.           SEGINI NOMID
  619.           LESOBL(1)='SECT'
  620.  
  621. * section, excentrements et orientation pour les barres excentrees
  622.         ELSE IF (MFR.EQ.49) THEN
  623.           NBROBL=6
  624.           SEGINI NOMID
  625.           LESOBL(1)='SECT'
  626.           LESOBL(2)='EXCZ'
  627.           LESOBL(3)='EXCY'
  628.           LESOBL(4)='VX  '
  629.           LESOBL(5)='VY  '
  630.           LESOBL(6)='VZ  '
  631.  
  632. *     CARACTERISTIQUES POUR LES POUTRES
  633.         ELSE IF (MFR.EQ.7 ) THEN
  634.           IF (CMATE.NE.'SECTION') THEN
  635.             NBROBL=1
  636.             SEGINI NOMID
  637.             LESOBL(1)='SECT'
  638.           ENDIF
  639.  
  640. *     CARACTERISTIQUES POUR LES TUYAUX
  641.         ELSE IF (MFR.EQ.13) THEN
  642.           NBROBL=2
  643.           NBRFAC=5
  644.           SEGINI NOMID
  645.           LESOBL(1)='EPAI'
  646.           LESOBL(2)='RAYO'
  647.           LESFAC(1)='RACO'
  648.           LESFAC(2)='CISA'
  649.           LESFAC(3)='VX'
  650.           LESFAC(4)='VY'
  651.           LESFAC(5)='VZ'
  652.           IVECT=1
  653.         ENDIF
  654.  
  655.         NCARA=NBROBL
  656.         NCARF=NBRFAC
  657.         NCARR=NCARA+NCARF
  658.         MOCARA = NOMID
  659.  
  660.         IF (MOCARA.NE.0) THEN
  661.           IF (IPCHE1.EQ.0) THEN
  662.             MOTERR(1:4)='CARA'
  663.             MOTERR(5:8)='CARA'
  664.             MOTERR(9:12)=NOMTP(MELE)
  665.             MOTERR(13:20)='THETA'
  666.             CALL ERREUR(145)
  667.             GOTO 9990
  668.           ENDIF
  669.           CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCARA,NOTYPE,
  670.      1                                   1,INFOS,3,IVACAR)
  671.           IF (NOTYPE.NE.MOTYR8) SEGSUP,NOTYPE
  672.           IF (IERR.NE.0) GOTO 9990
  673.  
  674. *       CHANGEMENT DE SUPPORT DES MELVAL DANS IVACAR ==> Passage au STRESSES
  675.           IF (ISUPMA.EQ.1) THEN
  676.             CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  677.             IF (IERR.NE.0) THEN
  678.               ISUPMA=0
  679.               GOTO 9990
  680.             ENDIF
  681.           ENDIF
  682.         ENDIF
  683.  
  684.         NV1=NMATT
  685.         SEGINI,MVELCH
  686.         SEGINI, WRK3
  687.  
  688.         IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  689.      1     CMATE.EQ.'UNIDIREC')) THEN
  690. C                RENSEIGNEMENTS SUR LE MAILLAGE
  691.            MELEME=IPMAIL
  692.            NBNN=NUM(/1)
  693.            SEGINI WRK2
  694.  
  695. *  RECUPERATION DES FONCTIONS DE FORME ET LEURS DERIVEES AU CENTRE DE
  696. *  L'ELEMENT POUR LE CALCUL DES AXES LOCAUX
  697.            IF (MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33) THEN
  698.              CALL RESHPT(1,NBNO,IELE,MELE,NPINT,IPT1,IRT1)
  699.              IF (IERR.NE.0) THEN
  700.                SEGSUP MVELCH,WRK2,WRK3
  701.                GOTO 9990
  702.              ENDIF
  703.              MINTE2=IPT1
  704.            ENDIF
  705.         ENDIF
  706.  
  707. * BOUCLE SUR LES ELEMENTS
  708.  
  709.        DO 1000 IB=1,NBELEM
  710. C
  711.         IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  712.      1       CMATE.EQ.'UNIDIREC').AND.
  713.      2      (MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33)) THEN
  714. C
  715. C     ON CHERCHE  LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  716. C
  717.           CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  718. C
  719. C     CALCUL DES AXES LOCAUX
  720. C
  721.           NBSH=MINTE2.SHPTOT(/2)
  722.           CALL RLOCAL (XE,MINTE2.SHPTOT,NBSH,NBNN,TXR)
  723.         if (nbsh.eq.-1) then
  724.          call erreur(525)
  725.          return
  726.         endif
  727.         ENDIF
  728. C
  729.         IF(CMATE.EQ.'SECTION') THEN
  730.  
  731. *  CAS DE LA POUTRE TIMO - MODELE SECTION
  732.  
  733.             MPTVAL=IVAMAT
  734.             MELVAL=IVAL(1)
  735.             IBMN=MIN(IB,IELCHE(/2))
  736.             IPMODL=IELCHE(1,IBMN)
  737.             MELVAL=IVAL(2)
  738.             IBMN=MIN(IB,IELCHE(/2))
  739.             IPMAT=IELCHE(1,IBMN)
  740.             CALL FRIGTH(IPMODL,IPMAT,CRIGI,0,1)
  741.         ENDIF
  742. C
  743. * BOUCLE SUR LES POINTS
  744.  
  745.          DO 2000 IGAU=1,NBPGAU
  746.  
  747. * initialisations
  748.  
  749.            EPAIST=0.D0
  750.            SD    =0.D0
  751.            TEMP  =0.D0
  752.            THIF  =0.D0
  753.            THM   =0.D0
  754.            THSU  =0.D0
  755.            E3    =0.D0
  756.  
  757. * remplissage du tableau des caracteristiques du materiau
  758.  
  759.         IF(CMATE.NE.'SECTION') THEN
  760.           MPTVAL=IVAMAT
  761.           DO 1100 IO = 1,NMATT
  762.              MELVAL = IVAL(IO)
  763.              IF(MELVAL .EQ. 0)GOTO 1100
  764.              IBMN=MIN(IB,VELCHE(/2))
  765.              IGMN=MIN(IGAU,VELCHE(/1))
  766.              VALMAT(IO) = VELCHE( IGMN,IBMN)
  767.  1100     CONTINUE
  768.         ENDIF
  769.  
  770. C  Prise en compte de l'epaisseur et de l'excentrement
  771. C  dans le cas des coques minces avec ou sans cisaillement
  772. C  transverse
  773. C
  774.         IF ((CMATE.EQ.'ISOTROPE'.OR.CMATE.EQ.'ORTHOTRO'.
  775.      1         OR.CMATE.EQ.'UNIDIREC').AND.
  776.      2                       (MFR.EQ.3.OR.MFR.EQ.9)) THEN
  777.          MPTVAL=IVACAR
  778.          MELVAL=IVAL(1)
  779.          IF (MELVAL.NE.0) THEN
  780.            IBMN=MIN(IB  ,VELCHE(/2))
  781.            IGMN=MIN(IGAU,VELCHE(/1))
  782.            EPAIST=VELCHE(IGMN,IBMN)
  783.          ELSE
  784.            CALL ERREUR(527)
  785.            GOTO 9990
  786.          ENDIF
  787.         ENDIF
  788.  
  789. * remplissage du tableau des caracteristiques geometriques
  790.         IF (MELE.EQ.29.OR.MELE.EQ.42.OR.MELE.EQ.45.OR.MELE.EQ.123
  791.      1       .OR.MELE.EQ.124.OR.MELE.EQ.46.OR.MELE.EQ.95
  792.      1       .OR.MELE.EQ.84) THEN
  793.         SEGINI WRK1
  794.          IF(MELE.EQ.42) THEN
  795.             MPTVAL=IVACAR
  796.             DO 1200 IC=1,NCARR
  797.                MELVAL=IVAL(IC)
  798.                IF (MELVAL.NE.0) THEN
  799.                   IBMN=MIN(IB,VELCHE(/2))
  800.                   WORK(IC)=VELCHE(1,IBMN)
  801.                ELSE
  802.                   WORK(IC)=0.D0
  803.                ENDIF
  804.  1200       CONTINUE
  805.  
  806. *  CAS DES TUYAUX - ON CALCULE LES CARACTERISTIQUES DE LA POUTRE  EQUIVA
  807.  
  808.             CISA=WORK(4)
  809.             VX=WORK(5)
  810.             VY=WORK(6)
  811.             VZ=WORK(7)
  812.             CALL TUYCAR(WORK,CISA,VX,VY,VZ,KERRE,1)
  813.             SD=WORK(4)
  814.          ELSE
  815.             MPTVAL=IVACAR
  816.             MELVAL=IVAL(1)
  817.             IBMN=MIN(IB,VELCHE(/2))
  818.             SD=0.D0
  819.             DO 1201 IAUX=1,NBPGAU
  820.               IGMN=MIN(IAUX,VELCHE(/1))
  821.               SD=SD+VELCHE(IGMN,IBMN)
  822.  1201       CONTINUE
  823.             SD=SD/NBPGAU
  824.          ENDIF
  825.         ENDIF
  826.         IF(CMATE.EQ.'SECTION') SD=CRIGI(1)
  827.  
  828. *      'T_ALPHA_REFERENCE'
  829.         MPTVAL=IVATAL
  830.         MELVAL=IVAL(1)
  831.         IGMN  =MIN(IGAU,VELCHE(/1))
  832.         IBMN  =MIN(IB  ,VELCHE(/2))
  833.         TALP  =VELCHE(IGMN,IBMN)
  834.  
  835.         IF (((MFR.EQ.3.OR.MFR.EQ.9).AND.(CMATE.EQ.'ISOTROPE'.
  836.      +       OR.CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'UNIDIREC')).
  837.      +       OR.(MFR.EQ.5.AND.(CMATE.EQ.'ISOTROPE'.OR.CMATE.
  838.      +       EQ.'ORTHOTRO')))   THEN
  839.  
  840.             IF(NPINT.EQ.0) THEN
  841.                MPTVAL=IVATEM
  842. *             'TINF' - 'T_ALPHA_REFERENCE'
  843.                MELVAL=IVAL(1)
  844.                IGMN=MIN(IGAU,VELCHE(/1))
  845.                IBMN=MIN(IB  ,VELCHE(/2))
  846.                THIF=VELCHE(IGMN,IBMN) - TALP
  847.  
  848. *             'T' - 'T_ALPHA_REFERENCE'
  849.                MELVAL=IVAL(2)
  850.                IGMN=MIN(IGAU,VELCHE(/1))
  851.                IBMN=MIN(IB  ,VELCHE(/2))
  852.                THM=VELCHE(IGMN,IBMN) - TALP
  853.  
  854. *             'TSUP' - 'T_ALPHA_REFERENCE'
  855.                MELVAL=IVAL(3)
  856.                IGMN=MIN(IGAU,VELCHE(/1))
  857.                IBMN=MIN(IB  ,VELCHE(/2))
  858.                THSU=VELCHE(IGMN,IBMN) - TALP
  859.             ELSE
  860. *             'T' - 'T_ALPHA_REFERENCE'
  861.                MPTVAL=IVATEM
  862.                MELVAL=IVAL(1)
  863.                IGMN=MIN(IGAU,VELCHE(/1))
  864.                IBMN=MIN(IB  ,VELCHE(/2))
  865.                TEMP=VELCHE(IGMN,IBMN) - TALP
  866.             ENDIF
  867.  
  868.             E3 = DZEGAU(IGAU)
  869.  
  870.          ELSEIF((MFR.EQ.7.OR.MFR.EQ.13.OR.MFR.EQ.27.OR.MELE.EQ.85.OR.
  871.      +       MELE.EQ.86.OR.MELE.EQ.87.OR.MELE.EQ.88.OR.MFR.EQ.49.OR.
  872.      +       MELE.EQ.84.OR.MFR.EQ.51).OR.((MFR.EQ.1.OR.MFR.EQ.33.OR.
  873.      +       MFR.EQ.31).AND.(CMATE.EQ.'ISOTROPE'.OR.CMATE.EQ.'ORTHOTRO'
  874.      +       .OR.CMATE.EQ.'ANISOTRO'.OR.CMATE.EQ.'UNIDIREC'))) THEN
  875.  
  876. *          'T' - 'T_ALPHA_REFERENCE'
  877.             MPTVAL=IVATEM
  878.             MELVAL=IVAL(1)
  879.             IGMN  =MIN(IGAU,VELCHE(/1))
  880.             IBMN  =MIN(IB  ,VELCHE(/2))
  881.             TEMP  =VELCHE(IGMN,IBMN) - TALP
  882.          ENDIF
  883. *--------------------------------------------------------------
  884. *                      CAS ISOTROPE
  885. *--------------------------------------------------------------
  886.  
  887.       IF(CMATE.EQ.'ISOTROPE') THEN
  888.  
  889.             CALL THETIS(MFR,MELE,VALMAT,NSTRS,NPINT,TEMP,THIF,
  890.      1                  THM,THSU,E3,SD,EPAIST,RES,KERRE)
  891.  
  892. *--------------------------------------------------------------
  893. *                      CAS ORTHOTROPE
  894. *--------------------------------------------------------------
  895.       ELSEIF(CMATE.EQ.'ORTHOTRO') THEN
  896.             CALL THETOR(MFR,MELE,VALMAT,LHOOK,NSTRS,TEMP,THIF,
  897.      1                  THM,THSU,E3,SD,EPAIST,TXR,XLOC,XGLOB,
  898.      2                                  ROTS,DHOOK,RES,KERRE)
  899.  
  900. *--------------------------------------------------------------
  901. *                      CAS ANISOTROPE
  902. *--------------------------------------------------------------
  903.       ELSEIF(CMATE.EQ.'ANISOTRO') THEN
  904.             CALL THETAN(MFR,MELE,VALMAT,LHOOK,NSTRS,TEMP,
  905.      1            SD,TXR,XLOC,XGLOB,ROTS,DHOOK,RES,KERRE)
  906.  
  907. *--------------------------------------------------------------
  908. *                      CAS UNIDIRECTIONNEL
  909. *--------------------------------------------------------------
  910.       ELSEIF(CMATE.EQ.'UNIDIREC') THEN
  911.             CALL THETUN(MFR,MELE,VALMAT,LHOOK,NSTRS,TEMP,THIF,
  912.      1                      THM,THSU,SD,EPAIST,TXR,XLOC,XGLOB,
  913.      2                                   ROTS,DHOOK,RES,KERRE)
  914.  
  915. *--------------------------------------------------------------
  916. *                      CAS HOMOGENEISE ET SECTION
  917. *--------------------------------------------------------------
  918.       ELSEIF(CMATE.EQ.'HOMOGENE'.OR.CMATE.EQ.'SECTION') THEN
  919.             CALL THETHS(MELE,VALMAT,NSTRS,TEMP,SD,RES,KERRE)
  920.  
  921. *--------------------------------------------------------------
  922.  
  923.       ELSE
  924.          CALL ERREUR(19)
  925.          GOTO 9900
  926.       ENDIF
  927.  
  928.       IF (KERRE.EQ.19) THEN
  929.          CALL ERREUR(19)
  930.          GOTO 9900
  931.       ELSEIF (KERRE.EQ.86) THEN
  932.          MOTERR(1:4) =NOMTP(MELE)
  933.          MOTERR(5:12)='THET'
  934.          CALL ERREUR(86)
  935.          GOTO 9900
  936.       ENDIF
  937.  
  938.       MPTVAL=IVASTR
  939.       DO 1600 I=1,NSTRS
  940.         MELVAL=IVAL(I)
  941.         VELCHE(IGAU,IB)=RES(I)
  942.  1600   CONTINUE
  943.  
  944.  2000   CONTINUE
  945.  1000  CONTINUE
  946.  
  947. *____________________________________________________________________
  948.  
  949. *    DESACTIVATION DES SEGMENTS DE TRAVAIL
  950. *____________________________________________________________________
  951.  
  952.  9900 CONTINUE
  953.  
  954.         IF ((CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  955.      1     CMATE.EQ.'UNIDIREC')) SEGSUP WRK2
  956.         IF (MELE.EQ.29.OR.MELE.EQ.42)  SEGSUP WRK1
  957.         SEGSUP MVELCH,WRK3
  958.  
  959.  9990   CONTINUE
  960. *____________________________________________________________________
  961.  
  962. *    DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE IA
  963. *____________________________________________________________________
  964.  
  965.       MPTVAL=IVAMAT
  966.       IF (MPTVAL .GT. 0) SEGSUP,MPTVAL
  967.       MPTVAL=IVACAR
  968.       IF (MPTVAL .GT. 0) SEGSUP,MPTVAL
  969.       MPTVAL=IVASTR
  970.       IF (MPTVAL .GT. 0) SEGSUP,MPTVAL
  971.       MPTVAL=IVATEM
  972.       IF (MPTVAL .GT. 0) SEGSUP,MPTVAL
  973.       MPTVAL=IVATAL
  974.       IF (MPTVAL .GT. 0) SEGSUP,MPTVAL
  975.       IF (IERR.NE.0) GOTO 888
  976.  
  977.  999  CONTINUE
  978.       IF (IERR.NE.0) GOTO 888
  979.  
  980.  500  CONTINUE
  981.  
  982.  888  CONTINUE
  983.       IF(IERR.NE.0)THEN
  984.          IRET   = 0
  985.          SEGSUP MCHELM
  986.          IPSTRS = 0
  987.       ELSE
  988.          IRET   = 1
  989.          IPSTRS = MCHELM
  990.       ENDIF
  991.  
  992.       nomid = MOTTAL
  993.       SEGSUP,nomid
  994.  
  995.       notype = MOTYR8
  996.       SEGINI,notype
  997.  
  998. c      RETURN
  999.       END
  1000.  
  1001.  
  1002.  

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