Télécharger la plaquette Cast3M


fr en

Télécharger epthp.eso

Retour à la liste

Numérotation des lignes : 

epthp

  1. C EPTHP     SOURCE    CB215821  24/04/12    21:15:48     11897          
  2.  
  3. C=======================================================================
  4. C=                             E P T H P                               =
  5. C=                             ---------                               =
  6. C=                                                                     =
  7. C=  Fonction :                                                         =
  8. C=  ----------                                                         =
  9. C=   Calcul des deformations d'origine thermique.                      =
  10. C=   Sous-programme appele par EPTH (epth.eso).                        =
  11. C=                                                                     =
  12. C=  Parametres :  (E)=Entree   (S)=Sortie                              =
  13. C=  ------------                                                       =
  14. C=   IPMODL   (E)   Pointeur sur le segment MMODEL                     =
  15. C=   IPCHE1   (E)   Pointeur sur le segment MCHELM de CARACTERISTIQUES =
  16. C=   IPCHE2   (E)   Pointeur sur le segment MCHELM de TEMPERATURES     =
  17. C=   IPEPTH   (S)   Pointeur sur le segment MCHPOI de forces nodales   =
  18. C=   IRET     (S)   Entier valant 1 en cas de succes, 0 sinon (et un   =
  19. C=                  message d'erreur est imprime dans ce cas)          =
  20. C=                                                                     =
  21. C=  Remarque : Variation parabolique de la temperature dans les COQUES =
  22. C   ---------- Cas ORTHOTROPE et ANISOTROPE traites pour les MASSIFS   =
  23. C=======================================================================
  24.  
  25.       SUBROUTINE EPTHP (IPMODL,IPCHE1,IPCHE2,IPEPTH,IRET)
  26.  
  27.       IMPLICIT INTEGER(I-N)
  28.       IMPLICIT REAL*8 (A-H,O-Z)
  29.  
  30.  
  31. -INC PPARAM
  32. -INC CCOPTIO
  33. -INC CCGEOME
  34. -INC CCREEL
  35. -INC CCHAMP
  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),IVAL(NCOSOU)
  48.         CHARACTER*16 TYVAL(NCOSOU)
  49.       ENDSEGMENT
  50.  
  51.       SEGMENT MVELCH
  52.         REAL*8 VALMAT(NV1)
  53.       ENDSEGMENT
  54.  
  55.       SEGMENT MWRK2
  56.         REAL*8 XE(3,NBNN)
  57.         REAL*8 TXR(IDIM,IDIM),XLOC(3,3),XGLOB(3,3)
  58.         REAL*8 ROTS(NEPTH,NEPTH)
  59.       ENDSEGMENT
  60.  
  61.       SEGMENT MWRK3
  62.         REAL*8 RES(NEPTH)
  63.       ENDSEGMENT
  64.  
  65.       SEGMENT ISEG(0)
  66.  
  67.       PARAMETER (NINF=3)
  68.       INTEGER INFOS(NINF)
  69.       DIMENSION CRIGI(12)
  70.       CHARACTER*8 CMATE,PHAM
  71.       CHARACTER*(NCONCH) CONM
  72.       LOGICAL LOGMA,LOGMF,lsupde,lsupma,lsupte
  73.  
  74.       IRET=0
  75.  
  76. c preliminaire : modèle effectif
  77.  
  78. C  1 - VERIFICATIONS DES DONNEES DE L'OPERATEUR
  79. C ==============================================
  80. C  1.1 - Verification du lieu support du MCHAML de caracteristiques
  81. C =====
  82.       ISupC=0
  83.       CALL QUESUP(IPMODL,IPCHE1,5,0,ISupC,iOK)
  84.       IF (ISupC.GT.1) RETURN
  85. C =====
  86. C  1.2 - Verification du lieu support du MCHAML de temperatures
  87. C =====
  88.       ISupT=0
  89.       CALL QUESUP(IPMODL,IPCHE2,5,0,ISupT,iOK)
  90.       IF (ISupT.GT.1) RETURN
  91.  
  92. C  2 - QUELQUES INITIALISATIONS
  93. C ==============================
  94. C  2.1 - Activation du MMODEL
  95. C =====
  96.       MMODEL=IPMODL
  97.       NSOUS =KMODEL(/1)
  98. C =====
  99. C  2.2 - Activation du MCHELM associe au champ de deformations
  100. C =====
  101.       L1=12
  102.       N1=NSOUS
  103.       N3=6
  104.       SEGINI,MCHELM
  105.       TITCHE='DEFORMATIONS'
  106.       IFOCHE=IFOUR
  107.       IPEPTH=MCHELM
  108. C =====
  109. C  2.3 - Initialisation du segment du type des composantes du champ de
  110. C        temperatures et defini une seule fois (identique sur IPMODL)
  111. C =====
  112.       NBTYPE=1
  113.       SEGINI,NOTYPE
  114.       TYPE(1)='REAL*8'
  115.       MOTYTE=NOTYPE
  116.  
  117. C  3 - BOUCLE SUR LES ZONES ELEMENTAIRES DU MODELE (iSou)
  118. C ========================================================
  119.       KSOU = 0
  120.       DO iSou=1,NSOUS
  121. C =====
  122. C  3.1 - Quelques initialisations
  123. C =====
  124.         lsupma =.true.
  125.         lsupte =.true.
  126.         MOTEMP = 0
  127.         IVATEM = 0
  128.         MOMATR = 0
  129.         IVAMAT = 0
  130.         MOCARA = 0
  131.         IVACAR = 0
  132.         MOEPTH = 0
  133.         IVAETH = 0
  134.         MCHAML = 0
  135.         TEMP   = XZero
  136.         THM    = XZero
  137.         THIF   = XZero
  138.         THSU   = XZero
  139.         IPMINT = 0
  140. C =====
  141. C  3.2 - Activation du sous-modele (iSou)
  142. C =====
  143.         IMODEL = KMODEL(iSou)
  144.         MELE   = NEFMOD
  145.         IPMAIL = IMAMOD
  146.         CONM   = CONMOD
  147.  
  148.         PHAM  =conm(17:24)
  149.         NPINT =0
  150. * l operateur sait ce qu il peut traiter
  151.         if(formod(1)(1:9).ne.'MECANIQUE'.and.
  152.      &formod(1)(1:6).ne.'POREUX'.and.formod(1)(1:7).ne.'LIQUIDE')
  153.      & goto 98
  154.         KSOU = KSOU + 1
  155.         IF (INFMOD(/1).NE.0) NPINT=INFMOD(1)
  156. C =====
  157. C  3.3 - Determination ...
  158. C =====
  159.         CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE2,INFOS,iOK)
  160.         IF (iOK.EQ.0) GOTO 210
  161.         iOK=0
  162. C =====
  163. C  3.4 - Determination de la nature du materiau et verification
  164. C =====
  165. C*      NFOR=FORMOD(/2)
  166. C*      NMAT=MATMOD(/2)
  167. C*      CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INAT)
  168.         CMATE = CMATEE
  169.         MATE  = IMATEE
  170.         INAT  = INATUU
  171. C*      IF (CMATE.EQ.' ') THEN
  172. C*        CALL ERREUR(251)
  173. C*        GOTO 210
  174. C*      ENDIF
  175.         LOGMA = CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  176.      &          CMATE.EQ.'UNIDIREC'
  177. C =====
  178. C  3.5 - Recuperation d'informations sur l'element fini du sous-modele
  179. C        Activation du segment d'integration
  180. C =====
  181. *        CALL ELQUOI(MELE,0,5,IPINF,IMODEL)
  182. *        IF (IERR.NE.0) GOTO 210
  183. *        INFO=IPINF
  184.         NBGS=INFELE(4)
  185.         IPORE=INFELE(8)
  186. *        IPMINT=INFELE(11)
  187.         IPMINT=infmod(7)
  188.         MINTE=IPMINT
  189.         if (mele.eq.260) then
  190.           nbpgau=5
  191.         else
  192.           NBPGAU=POIGAU(/1)
  193.         endif
  194.         MFR=INFELE(13)
  195.         NEPTH=INFELE(16)
  196.         LOGMF = MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33.OR.MFR.EQ.63
  197. C =====
  198. C  3.6 - Recuperation d'informations liees au maillage IPMAIL
  199. C =====
  200.         MELEME=IPMAIL
  201.         NBNN=NUM(/1)
  202.         NBELEM=NUM(/2)
  203.         NBNO=NBNN
  204.         IPPORE=0
  205.         IF (MFR.EQ.33) THEN
  206.           NBNO=IPORE
  207.           IPPORE=NBNN
  208.         ENDIF
  209.         IF (MFR.EQ.63) THEN
  210. C         NBNO=IPORE
  211.           IPPORE=NBNN
  212.         ENDIF
  213. C =====
  214. C  3.7 - Recuperation des temperatures associees au sous-modele
  215. C        Verification de leur presence dans le MCHAML (IPCHE2)
  216. C =====
  217.         NFAC=0
  218.         if(lnomid(8).ne.0) then
  219.           lsupte=.false.
  220.           nomid =lnomid(8)
  221.           motemp=nomid
  222.           ntem  =lesobl(/2)
  223.           nfac  =lesfac(/2)
  224.         else
  225.           CALL IDTEMP(MFR,IFOUR,NPINT,MOTEMP,NTEM,NFAC)
  226.         endif
  227.         CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOTEMP,MOTYTE,1,INFOS,3,IVATEM)
  228.         IF (IERR.NE.0) GOTO 230
  229.         IF (ISupT.EQ.1)THEN
  230.           CALL VALCHE(IVATEM,NTEM,IPMINT,IPPORE,MOTEMP,MELE)
  231.           IF (IERR.NE.0) THEN
  232.             ISupT=0
  233.             GOTO 230
  234.           ENDIF
  235.         ENDIF
  236. C =====
  237. C  3.8 - Recuperation des noms des caracteristiques MATERIAU
  238. C        Traitement suivant la formulation MFR et l'element fini MELE
  239. C        Verification de leur presence dans le MCHAML (IPCHE1)
  240. C =====
  241.         NBROBL=0
  242.         NBRFAC=0
  243.         NOMID =0
  244. C= 3.8.1 - Elements POUTRE,BARRE,POI1,TUYAUX...
  245.         IF (MELE.EQ.29.OR.MELE.EQ. 42.OR.MELE.EQ. 45.OR.MELE.EQ. 46.OR.
  246.      .      MELE.EQ.95.OR.MELE.EQ.123.OR.MELE.EQ.124) THEN
  247.           NBROBL=2
  248.           SEGINI,NOMID
  249.           LESOBL(1)='ALPH'
  250.           LESOBL(2)='TALP'
  251.  
  252. C= 3.8.2 - Materiau isotrope
  253.         ELSEIF (CMATE.EQ.'ISOTROPE') THEN
  254.           NBROBL=2
  255.           SEGINI,NOMID
  256.           IF (MFR.EQ.35) THEN
  257.             LESOBL(1)='ALPN'
  258.           ELSE
  259.             LESOBL(1)='ALPH'
  260.           ENDIF
  261.           LESOBL(2)='TALP'
  262.  
  263. C= 3.8.3 - Materiau orthotrope
  264.         ELSEIF (CMATE.EQ.'ORTHOTRO') THEN
  265.           IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  266.             NBROBL=5
  267.             SEGINI,NOMID
  268.             LESOBL(1)='ALP1'
  269.             LESOBL(2)='ALP2'
  270.             LESOBL(3)='V1X'
  271.             LESOBL(4)='V1Y'
  272.             LESOBL(5)='TALP'
  273.           ELSEIF (MFR.EQ.75) THEN
  274.             IF (IDIM.EQ.3) THEN
  275.             NBROBL=7
  276.             SEGINI,NOMID
  277.               LESOBL(1)='ALPN'
  278.               LESOBL(2)='ALP1'
  279.               LESOBL(3)='ALP2'
  280.               LESOBL(4)='ALQN'
  281.               LESOBL(5)='ALQ1'
  282.               LESOBL(6)='ALQ2'
  283.               LESOBL(7)='TALP'
  284.             ELSEIF (IDIM.EQ.2) THEN
  285.             NBROBL=4
  286.             SEGINI,NOMID
  287.               LESOBL(1)='ALPN'
  288.               LESOBL(2)='ALPS'
  289.               LESOBL(3)='ALQS'
  290.               LESOBL(4)='TALP'
  291.             ENDIF
  292.           ELSEIF (MFR.EQ.35) THEN
  293.             NBROBL=4
  294.             SEGINI,NOMID
  295.             LESOBL(1)='ALPN'
  296.             LESOBL(2)='V1X'
  297.             LESOBL(3)='V1Y'
  298.             LESOBL(4)='TALP'
  299.           ELSEIF (MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33) THEN
  300.             IF (IFOUR.EQ.-2) THEN
  301.               NBROBL=5
  302.               SEGINI,NOMID
  303.               LESOBL(1)='ALP1'
  304.               LESOBL(2)='ALP2'
  305.               LESOBL(3)='V1X'
  306.               LESOBL(4)='V1Y'
  307.               LESOBL(5)='TALP'
  308.             ELSEIF (IFOUR.EQ.-1.OR.IFOUR.EQ.-3.OR.
  309.      .               IFOUR.EQ.0.OR.IFOUR.EQ.1) THEN
  310.               NBROBL=6
  311.               SEGINI,NOMID
  312.               LESOBL(1)='ALP1'
  313.               LESOBL(2)='ALP2'
  314.               LESOBL(3)='ALP3'
  315.               LESOBL(4)='V1X'
  316.               LESOBL(5)='V1Y'
  317.               LESOBL(6)='TALP'
  318.             ELSEIF (IFOUR.EQ.2) THEN
  319.               NBROBL=10
  320.               SEGINI,NOMID
  321.               LESOBL(1 )='ALP1'
  322.               LESOBL(2 )='ALP2'
  323.               LESOBL(3 )='ALP3'
  324.               LESOBL(4 )='V1X '
  325.               LESOBL(5 )='V1Y '
  326.               LESOBL(6 )='V1Z '
  327.               LESOBL(7 )='V2X '
  328.               LESOBL(8 )='V2Y '
  329.               LESOBL(9 )='V2Z '
  330.               LESOBL(10)='TALP'
  331.             ELSEIF (IFOUR.GE.3.AND.IFOUR.LE.15) THEN
  332.               IF (IFOUR.EQ.6) THEN
  333.                 NBROBL=2
  334.                 SEGINI,NOMID
  335.                 LESOBL(1)='ALP1'
  336.                 LESOBL(2)='TALP'
  337.               ELSEIF (IFOUR.EQ.5.OR.IFOUR.EQ.10) THEN
  338.                 NBROBL=3
  339.                 SEGINI,NOMID
  340.                 LESOBL(1)='ALP1'
  341.                 LESOBL(2)='ALP3'
  342.                 LESOBL(3)='TALP'
  343.               ELSEIF (IFOUR.EQ.4.OR.IFOUR.EQ.8.OR.IFOUR.EQ.13) THEN
  344.                 NBROBL=3
  345.                 SEGINI,NOMID
  346.                 LESOBL(1)='ALP1'
  347.                 LESOBL(2)='ALP2'
  348.                 LESOBL(3)='TALP'
  349.               ELSE
  350.                 NBROBL=4
  351.                 SEGINI,NOMID
  352.                 LESOBL(1)='ALP1'
  353.                 LESOBL(2)='ALP2'
  354.                 LESOBL(3)='ALP3'
  355.                 LESOBL(4)='TALP'
  356.               ENDIF
  357.             ENDIF
  358.           ENDIF
  359.  
  360. C= 3.8.4 - Materiau anisotrope
  361.         ELSEIF (CMATE.EQ.'ANISOTRO') THEN
  362.           IF (MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33) THEN
  363.             IF (IFOUR.EQ.-2) THEN
  364.               NBROBL=6
  365.               SEGINI,NOMID
  366.               LESOBL(1)='ALP1'
  367.               LESOBL(2)='ALP2'
  368.               LESOBL(3)='AL12'
  369.               LESOBL(4)='V1X '
  370.               LESOBL(5)='V1Y '
  371.               LESOBL(6)='TALP'
  372.             ELSEIF (IFOUR.EQ.-3 .OR.IFOUR.EQ.-1.OR.
  373.      .              IFOUR.EQ. 0 .OR.IFOUR.EQ. 1) THEN
  374.               NBROBL=7
  375.               SEGINI,NOMID
  376.               LESOBL(1)='ALP1'
  377.               LESOBL(2)='ALP2'
  378.               LESOBL(3)='AL12'
  379.               LESOBL(4)='ALP3'
  380.               LESOBL(5)='V1X '
  381.               LESOBL(6)='V1Y '
  382.               LESOBL(7)='TALP'
  383.             ELSEIF (IFOUR.EQ.2) THEN
  384.               NBROBL=13
  385.               SEGINI,NOMID
  386.               LESOBL(1 )='ALP1'
  387.               LESOBL(2 )='ALP2'
  388.               LESOBL(3 )='ALP3'
  389.               LESOBL(4 )='AL12'
  390.               LESOBL(5 )='AL13'
  391.               LESOBL(6 )='AL23'
  392.               LESOBL(7 )='V1X '
  393.               LESOBL(8 )='V1Y '
  394.               LESOBL(9 )='V1Z '
  395.               LESOBL(10)='V2X '
  396.               LESOBL(11)='V2Y '
  397.               LESOBL(12)='V2Z '
  398.               LESOBL(13)='TALP'
  399.             ENDIF
  400.           ELSEIF (MFR.EQ.75) THEN
  401.             IF (IDIM.EQ.3) THEN
  402.             NBROBL=7
  403.             SEGINI,NOMID
  404.               LESOBL(1)='ALP1'
  405.               LESOBL(2)='ALP2'
  406.               LESOBL(3)='ALP3'
  407.               LESOBL(4)='ALQ1'
  408.               LESOBL(5)='ALQ2'
  409.               LESOBL(6)='ALQ3'
  410.               LESOBL(7)='TALP'
  411.             ELSEIF (IDIM.EQ.2) THEN
  412.             NBROBL=4
  413.             SEGINI,NOMID
  414.               LESOBL(1)='ALP1'
  415.               LESOBL(2)='ALP2'
  416.               LESOBL(3)='ALQ3'
  417.               LESOBL(4)='TALP'
  418.             ENDIF
  419.           ENDIF
  420.  
  421. C= 3.8.5 - Materiau unidirectionnel
  422.         ELSEIF (CMATE.EQ.'UNIDIREC') THEN
  423.           IF (MFR.EQ.1.AND.IDIM.EQ.3) THEN
  424.             NBROBL=8
  425.             SEGINI,NOMID
  426.             LESOBL(1)='ALPH'
  427.             LESOBL(2)='V1X '
  428.             LESOBL(3)='V1Y '
  429.             LESOBL(4)='V1Z '
  430.             LESOBL(5)='V2X '
  431.             LESOBL(6)='V2Y '
  432.             LESOBL(7)='V2Z '
  433.             LESOBL(8)='TALP'
  434.           ELSE
  435.             NBROBL=4
  436.             SEGINI,NOMID
  437.             LESOBL(1)='ALPH'
  438.             LESOBL(2)='V1X '
  439.             LESOBL(3)='V1Y '
  440.             LESOBL(4)='TALP'
  441.           ENDIF
  442.  
  443.         ELSE
  444.           if(lnomid(6).ne.0) then
  445.             lsupma=.false.
  446.             nomid=lnomid(6)
  447.             momatr=nomid
  448.             nmatr=lesobl(/2)
  449.             nmatf=lesfac(/2)
  450.           else
  451.             CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF)
  452.           endif
  453.           NOMID =MOMATR
  454.           NBROBL=NMATR
  455.           NBRFAC=NMATF
  456.         ENDIF
  457.  
  458.         MOMATR = NOMID
  459.         NMATR  = NBROBL
  460.         NMATF  = NBRFAC
  461.         NMATT  = NMATR + NMATF
  462.         NBGMAT = 0
  463.         NELMAT = 0
  464. C= 3.8.6 - Verification de la presence des caracteristiques dans IPCHE1
  465.         IF (MOMATR.NE.0) THEN
  466.           IF (CMATE.EQ.'SECTION') THEN
  467.             NBTYPE=3
  468.             SEGINI,NOTYPE
  469.             TYPE(1)='POINTEURMMODEL'
  470.             TYPE(2)='POINTEURMCHAML'
  471.             TYPE(3)='POINTEURLISTREEL'
  472.           ELSE
  473.             NBTYPE=1
  474.             SEGINI,NOTYPE
  475.             TYPE(1)='REAL*8'
  476.           ENDIF
  477.           MOTYPE=NOTYPE
  478.           CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOMATR,MOTYPE,1,
  479.      .                INFOS,3,IVAMAT)
  480.           SEGSUP,NOTYPE
  481.           IF (IERR.NE.0) GOTO 240
  482.           IF (ISupC.EQ.1) THEN
  483.             CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE,MOMATR,MELE)
  484.             IF (IERR.NE.0)THEN
  485.                ISupC=0
  486.                GOTO 240
  487.             ENDIF
  488.           ENDIF
  489.           MPTVAL=IVAMAT
  490.           MELVAL=IVAL(1)
  491.           DO i=1,NMATT
  492.             IF (IVAL(i).NE.0) THEN
  493.               MELVAL=IVAL(i)
  494.               IF (CMATE.EQ.'SECTION') THEN
  495.                 NBGMAT=MAX(NBGMAT,IELCHE(/1))
  496.                 NELMAT=MAX(NELMAT,IELCHE(/2))
  497.               ELSE
  498.                 NBGMAT=MAX(NBGMAT,VELCHE(/1))
  499.                 NELMAT=MAX(NELMAT,VELCHE(/2))
  500.               ENDIF
  501.             ENDIF
  502.           ENDDO
  503.         ENDIF
  504. C =====
  505. C  3.9 - Recuperation des noms des caracteristiques
  506. C =====
  507.         NBROBL=0
  508.         NBRFAC=0
  509.         IVECT =0
  510.         NOMID =0
  511.         NOTYPE=0
  512. C= 3.9.1 - Elements COQUES : epaisseur
  513.         IF (MFR.EQ.3.OR.MFR.EQ.9) THEN
  514.           NBROBL=1
  515.           SEGINI,NOMID
  516.           LESOBL(1)='EPAI'
  517.           NBTYPE=1
  518.           SEGINI,NOTYPE
  519.           TYPE(1)='REAL*8'
  520. C= 3.9.2 - Elements BARREs et CERCEs : section
  521.         ELSEIF (MFR.EQ.27) THEN
  522.           NBROBL=1
  523.           SEGINI,NOMID
  524.           LESOBL(1)='SECT'
  525.           NBTYPE=1
  526.           SEGINI,NOTYPE
  527.           TYPE(1)='REAL*8'
  528. C= 3.9.3 - Elements BAEX : section, excentrements et orientation
  529.         ELSEIF (MFR.EQ.49) THEN
  530.           NBROBL=6
  531.           SEGINI,NOMID
  532.           LESOBL(1)='SECT'
  533.           LESOBL(2)='EXCZ'
  534.           LESOBL(3)='EXCY'
  535.           LESOBL(4)='VX  '
  536.           LESOBL(5)='VY  '
  537.           LESOBL(6)='VZ  '
  538.           NBTYPE=1
  539.           SEGINI,NOTYPE
  540.           TYPE(1)='REAL*8'
  541. C= 3.9.4 - Elements POUTREs
  542.         ELSEIF (MFR.EQ.7) THEN
  543.           IF (CMATE.NE.'SECTION') THEN
  544.             NBROBL=1
  545.             SEGINI,NOMID
  546.             LESOBL(1)='SECT'
  547.             NBTYPE=1
  548.             SEGINI,NOTYPE
  549.             TYPE(1)='REAL*8'
  550.           ENDIF
  551. C= 3.9.5 - Elements TUYAUx
  552.         ELSEIF (MFR.EQ.13) THEN
  553.           NBROBL=2
  554.           NBRFAC=4
  555.           SEGINI,NOMID
  556.           LESOBL(1)='EPAI'
  557.           LESOBL(2)='RAYO'
  558.           LESFAC(1)='RACO'
  559.           LESFAC(2)='VX'
  560.           LESFAC(3)='VY'
  561.           LESFAC(4)='VZ'
  562.           IVECT=1
  563.           NBTYPE=6
  564.           SEGINI,NOTYPE
  565.           TYPE(1)='REAL*8'
  566.           TYPE(2)='REAL*8'
  567.           TYPE(3)='REAL*8'
  568.           TYPE(4)='REAL*8'
  569.           TYPE(5)='REAL*8'
  570.           TYPE(6)='REAL*8'
  571.         ENDIF
  572.         MOCARA= NOMID
  573.         NCARA = NBROBL
  574.         NCARF = NBRFAC
  575.         NCARR = NCARA + NCARF
  576.  
  577. C= 3.9.6 - Verification de leur presence dans IPCHE1
  578.         IF (MOCARA.NE.0) THEN
  579.           MOTYPE=NOTYPE
  580.           IF (IPCHE1.NE.0) THEN
  581.             CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCARA,MOTYPE,1,
  582.      .                  INFOS,3,IVACAR)
  583.             SEGSUP,NOTYPE
  584.             IF (IERR.NE.0) GOTO 250
  585.  
  586.           ELSE
  587.             MOTERR(1:4)='CARA'
  588.             MOTERR(5:8)='CARA'
  589.             MOTERR(9:12)=NOMTP(MELE)
  590.             MOTERR(13:20)='EPTH'
  591.             CALL ERREUR(145)
  592.             SEGSUP,NOTYPE
  593.             GOTO 250
  594.           ENDIF
  595.  
  596.           IF (ISupC.EQ.1) THEN
  597.             CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  598.             IF (IERR.NE.0) THEN
  599.               ISupC=0
  600.               GOTO 250
  601.             ENDIF
  602.           ENDIF
  603.         ENDIF
  604. C ======
  605. C  3.10 - Recuperation des noms des composantes de deformations
  606. C ======
  607.         if(lnomid(5).ne.0) then
  608.           nomid=lnomid(5)
  609.           moepth=nomid
  610.           lsupde=.false.
  611.           nstr=lesobl(/2)
  612.         else
  613.          CALL IDDEFO(IMODEL,IFOUR,MOEPTH,NSTR,NFAC)
  614.          lsupde=.true.
  615.         endif
  616.  
  617. C       Meme verification que dans modeli.eso (On a eu un BUG une fois)
  618.         IF(NSTR .NE. NEPTH)THEN
  619.           IPT1     =IMAMOD
  620.           MOTERR   =NOMS(IPT1.ITYPEL)
  621.           INTERR(1)=NSTR
  622.           INTERR(2)=NEPTH
  623.           CALL ERREUR(1098)
  624.           RETURN
  625.         ENDIF
  626. C ======
  627. C  3.11 - Initialisation du MCHAML des contraintes de Von Mises (MCHAML)
  628. C         associe au modele elementaire iSou (de maillage IPMAIL)
  629. C         Remplissage des donnees associees a MCHAML dans MCHELM(global)
  630. C ======
  631. C= 3.11.1 - Initialisation de MCHAML
  632.         N2=NEPTH
  633.         SEGINI,MCHAML
  634. C= 3.11.2 - Remplissage de MCHEML  (KSou)
  635.         CONCHE(KSou)=CONM
  636.         IMACHE(KSou)=IPMAIL
  637.         ICHAML(KSou)=MCHAML
  638.         INFCHE(KSou,1)=0
  639.         INFCHE(KSou,2)=0
  640.         INFCHE(KSou,3)=NIFOUR
  641.         INFCHE(KSou,4)=IPMINT
  642.         INFCHE(KSou,5)=0
  643.         INFCHE(KSou,6)=5
  644. C= 3.11.3 - Initialisation des N2 MELVAL associes a MCHAML
  645. C=          Fin du remplissage de MCHAML
  646.         N1PTEL=NBGS
  647.         N1EL=NBELEM
  648.         IF (MELE.EQ.30.OR.MELE.EQ.43) THEN
  649.           N1PTEL=1
  650.           N1EL  =1
  651.         ENDIF
  652.         N2PTEL=0
  653.         N2EL  =0
  654.         NS    =1
  655.         NCOSOU=N2
  656.         SEGINI,MPTVAL
  657.         IVAETH=MPTVAL
  658.         NOMID=MOEPTH
  659.         DO i=1,N2
  660.           NOMCHE(i)=LESOBL(i)
  661.           TYPCHE(i)='REAL*8'
  662.           SEGINI,MELVAL
  663.           IELVAL(i)=MELVAL
  664.           IVAL(i)  =MELVAL
  665.         ENDDO
  666. C ======
  667. C  3.12 - Initialisation de quelques segments de travail
  668. C         Recuperation des fonctions de forme et de leurs derivees au
  669. C         centre de l'element pour le calcul des axes locaux
  670. C ======
  671.         IF (LOGMA) THEN
  672.           IF (LOGMF) THEN
  673.             IELE=NUMGEO(MELE)
  674.             CALL RESHPT(1,NBNO,IELE,MELE,NPINT,IPT1,IRT1)
  675.             IF (IERR.NE.0) GOTO 260
  676.             MINTE2=IPT1
  677.           ENDIF
  678.           SEGINI,MWRK2
  679.         ENDIF
  680.         NV1=NMATT
  681.         SEGINI,MVELCH,MWRK3
  682. C ======
  683. C  3.13 - Boucle sur les elements du sous-modele elementaire
  684. C ======
  685.         DO 10 iElt=1,NBELEM
  686. C= 3.13.1 - Cas des elements MASSIFs - materiau a "TROPIE"
  687. C=          Recuperation des coordonnees des noeuds de l element iElt
  688. C=          Determination des axes locaux aux noeuds
  689.           IF (LOGMA.AND.LOGMF) THEN
  690.             CALL DOXE(XCOOR,IDIM,NBNN,NUM,iElt,XE)
  691.             NBSH=MINTE2.SHPTOT(/2)
  692.             CALL RLOCAL(XE,MINTE2.SHPTOT,NBSH,NBNN,TXR)
  693.             IF (nbsh.EQ.-1) THEN
  694.               CALL ERREUR(525)
  695.               GOTO 260
  696.             ENDIF
  697.           ENDIF
  698. C= 3.13.2 - Cas de la poutre TIMO et modele SECTION
  699.           IF (CMATE.EQ.'SECTION') THEN
  700.             MPTVAL=IVAMAT
  701.             MELVAL=IVAL(1)
  702.             IBMN=MIN(iElt,IELCHE(/2))
  703.             IPMODL=IELCHE(1,IBMN)
  704.             MELVAL=IVAL(2)
  705.             IBMN=MIN(iElt,IELCHE(/2))
  706.             IPMAT=IELCHE(1,IBMN)
  707.             CALL FRIGTH(IPMODL,IPMAT,CRIGI,0,0)
  708.           ENDIF
  709.  
  710.  
  711. C= 3.13.3 - Boucle sur les points de Gauss
  712.  
  713.           DO 100 iGau=1,NBPGAU
  714. C= 3.13.3.1 - Remplissage du tableau des caracteristiques du materiau
  715.             IF (CMATE.NE.'SECTION') THEN
  716.               MPTVAL=IVAMAT
  717.               DO i=1,NMATT
  718.                 MELVAL=IVAL(i)
  719.                 IBMN=MIN(iElt,VELCHE(/2))
  720.                 IGMN=MIN(iGau,VELCHE(/1))
  721.                 VALMAT(i)=VELCHE(IGMN,IBMN)
  722.               ENDDO
  723.             ENDIF
  724. C= 3.13.3.2 - Prise en compte des epaisseur et excentrement dans le cas
  725. C=            des coques minces avec ou sans cisaillement transverse
  726.             IF ((CMATE.EQ.'ISOTROPE'.OR.CMATE.EQ.'ORTHOTRO'.
  727.      $   OR.CMATE.EQ.'UNIDIREC') .AND.(MFR.EQ.3.OR.MFR.EQ.9)) THEN
  728.               MPTVAL=IVACAR
  729.               MELVAL=IVAL(1)
  730.               IF (MELVAL.NE.0) THEN
  731.                 IBMN=MIN(iElt,VELCHE(/2))
  732.                 IGMN=MIN(iGau,VELCHE(/1))
  733.                 EPAIST=VELCHE(IGMN,IBMN)
  734.               ELSE
  735.                 CALL ERREUR(527)
  736.                 GOTO 260
  737.               ENDIF
  738.             ENDIF
  739. C= 3.13.3.3 - Recuperation des temperatures du point de Gauss iGau (T et TALP)
  740. C             TEMP = T_courant - T_ALPHA_REFERENCE
  741.             MPTVAL=IVAMAT
  742.             MELVAL=IVAL(IVAL(/1))
  743.             TALP  =VELCHE(IGMN,IBMN)
  744.  
  745.             MPTVAL=IVATEM
  746.             MELVAL=IVAL(1)
  747.             IGMN=MIN(iGau,VELCHE(/1))
  748.             IBMN=MIN(iElt,VELCHE(/2))
  749.             TEMP=VELCHE(IGMN,IBMN) - TALP
  750.  
  751. C           write(6,*) 'EPTHP',ielt,igau,igmn,ibmn,temp
  752.             IF (((MFR.EQ.3.OR.MFR.EQ.9).AND.(CMATE.EQ.'ISOTROPE'.
  753.      $       OR.CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'UNIDIREC')).
  754.      $         OR.(MFR.EQ.5.AND.
  755.      $          (CMATE.EQ.'ISOTROPE'.OR.CMATE.EQ.'ORTHOTRO'))) THEN
  756.               IF (NPINT.EQ.0) THEN
  757.                 THIF=TEMP
  758.                 TEMP=XZero
  759.                 MELVAL=IVAL(2)
  760.                 IGMN=MIN(iGau,VELCHE(/1))
  761.                 IBMN=MIN(iElt,VELCHE(/2))
  762.                 THM=VELCHE(IGMN,IBMN)
  763.                 MELVAL=IVAL(3)
  764.                 IGMN=MIN(iGau,VELCHE(/1))
  765.                 IBMN=MIN(iElt,VELCHE(/2))
  766.                 THSU=VELCHE(IGMN,IBMN)
  767.               ENDIF
  768.               E3=DZEGAU(iGau)
  769.             ELSE
  770.               IF (CMATE.EQ.'SECTION') TEMP=TEMP*CRIGI(1)
  771.             ENDIF
  772.  
  773. C= 3.13.3.4 - Cas ISOTROPE : calcul des deformations thermiques
  774.             IF (CMATE.EQ.'ISOTROPE') THEN
  775.               CALL EPTHIS(MFR,MELE,VALMAT,NEPTH,TEMP,THIF,THM,THSU,
  776.      .                    E3,EPAIST,RES,NPINT,KERRE)
  777. C= 3.13.3.5 - Cas ORTHOTROPE : calcul des deformations thermiques
  778.             ELSEIF (CMATE.EQ.'ORTHOTRO') THEN
  779.               IF (NPINT.EQ.0) THEN
  780.                 CALL EPTHOR(MFR,MELE,VALMAT,NEPTH,TEMP,THIF,THM,THSU,
  781.      .                      E3,EPAIST,TXR,XLOC,XGLOB,ROTS,RES,KERRE)
  782.               ELSE
  783.                 KERRE=19
  784.               ENDIF
  785. C= 3.13.3.6 - Cas ANISOTROPE : calcul des deformations thermiques
  786.             ELSEIF (CMATE.EQ.'ANISOTRO') THEN
  787.               IF (NPINT.EQ.0) THEN
  788.                 CALL EPTHAN(MFR,MELE,VALMAT,NEPTH,TEMP,TXR,XLOC,XGLOB,
  789.      .                      ROTS,RES,KERRE)
  790.               ELSE
  791.                 KERRE=19
  792.               ENDIF
  793. C= 3.13.3.7 - Cas UNIDIRECTIONNEL : calcul des deformations thermiques
  794.             ELSEIF (CMATE.EQ.'UNIDIREC') THEN
  795.               IF (NPINT.EQ.0) THEN
  796.                 CALL EPTHUN(MFR,MELE,VALMAT,NEPTH,TEMP,THIF,THM,THSU,
  797.      .                      EPAIST,TXR,XLOC,XGLOB,ROTS,RES,KERRE)
  798.               ELSE
  799.                 KERRE=19
  800.               ENDIF
  801. C= 3.13.3.8 - Cas HOMOGENEISE et SECTION : calcul des deformations ther.
  802.             ELSEIF (CMATE.EQ.'HOMOGENE'.OR.CMATE.EQ.'SECTION') THEN
  803.               IF (NPINT.EQ.0) THEN
  804.                 CALL EPTHHS(MELE,VALMAT,NEPTH,TEMP,RES,KERRE)
  805.               ELSE
  806.                 KERRE=19
  807.               ENDIF
  808. C= 3.13.3.9 - Cas non prevus et traitement des ERREURS
  809.             ELSE
  810.               KERRE=19
  811.             ENDIF
  812.             IF (KERRE.EQ.19) THEN
  813.               CALL ERREUR(19)
  814.               GOTO 260
  815.             ELSEIF (KERRE.EQ.86) THEN
  816.               MOTERR(1:4)=NOMTP(MELE)
  817.               MOTERR(5:12)='EPTH'
  818.               CALL ERREUR(86)
  819.               GOTO 260
  820.             ENDIF
  821. C= 3.13.3.10 - Stockage des deformations dans les MELVAL
  822.             MPTVAL=IVAETH
  823.             DO i=1,NEPTH
  824.               MELVAL=IVAL(i)
  825.               VELCHE(iGau,iElt)=RES(i)
  826.             ENDDO
  827.  
  828. C         Fin boucle sur les points de Gauss
  829.  100      CONTINUE
  830.  
  831. C       Fin boucle sur les elements
  832.  10     CONTINUE
  833.  
  834. C       Traitement elements ICompressibles (methode BBAR)
  835.         IF (MFR.EQ.31) THEN
  836.           IELE=NUMGEO(MELE)
  837.           CALL RESHPT(NBPGAU,NBNO,IELE,MELE,NPINT,IPMINT,IRT1)
  838.           IF (IERR.NE.0) RETURN
  839.           IPCHA1 = MCHAML
  840.           CALL EPTBBA(MELE,IPCHA1,IPMINT,IPMAIL,IPCHA2)
  841.           IF (IERR.NE.0) RETURN
  842.           IF (IPCHA2.NE.MCHAML) SEGSUP,MCHAML
  843.           MCHAML = IPCHA2
  844.           ICHAML(KSou)=MCHAML
  845.         ENDIF
  846.  
  847. C ======
  848. C  3.14 - Desactivation/suppression de segments associes a iSou
  849. C         Sortie prematuree en cas d'ERREUR (iOK=0)
  850. C ======
  851.         IF (IERR.EQ.0) iOK=1
  852.  260    SEGSUP,MVELCH,MWRK3
  853.         IF (MOEPTH.NE.0) THEN
  854.           NOMID=MOEPTH
  855.           if(lsupde)SEGSUP,NOMID
  856.         ENDIF
  857.         IF (LOGMA) THEN
  858.           SEGSUP,MWRK2
  859.         ENDIF
  860.  250    IF (MOCARA.NE.0) THEN
  861.           NOMID=MOCARA
  862.           SEGSUP,NOMID
  863.           IF (ISupC.EQ.1) THEN
  864.             CALL DTMVAL(IVACAR,3)
  865.           ELSE
  866.             CALL DTMVAL(IVACAR,1)
  867.           ENDIF
  868.         ENDIF
  869.  240    IF (MOMATR.NE.0) THEN
  870.           NOMID=MOMATR
  871.           if(lsupma)SEGSUP,NOMID
  872.           IF (ISupC.EQ.1) THEN
  873.             CALL DTMVAL(IVAMAT,3)
  874.           ELSE
  875.             CALL DTMVAL(IVAMAT,1)
  876.           ENDIF
  877.         ENDIF
  878.  230    IF (MOTEMP.NE.0) THEN
  879.           NOMID=MOTEMP
  880.           if(lsupte)SEGSUP,NOMID
  881.         ENDIF
  882.         IF (ISupT.EQ.1) THEN
  883.           CALL DTMVAL(IVATEM,3)
  884.         ELSE
  885.          CALL DTMVAL(IVATEM,1)
  886.         ENDIF
  887.  220    CONTINUE
  888.  210    CONTINUE
  889.         IF (iOK.EQ.0) THEN
  890.           CALL DTMVAL(IVAETH,3)
  891.           IF (MCHAML.NE.0) SEGSUP,MCHAML
  892.           SEGSUP,MCHELM
  893.           GOTO 300
  894.         ENDIF
  895.         CALL DTMVAL(IVAETH,1)
  896.  98    CONTINUE
  897.       ENDDO
  898.  
  899. C  4 - MENAGE : DESACTIVATION/DESTRUCTION DE SEGMENTS
  900. C ====================================================
  901.       IRET=1
  902.       N1 = KSOU
  903.       SEGADJ MCHELM
  904.  300  CONTINUE
  905.       NOTYPE=MOTYTE
  906.       SEGSUP,NOTYPE
  907.  
  908.       END
  909.  
  910.  
  911.  
  912.  
  913.  
  914.  
  915.  

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