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

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