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    OF166741  25/02/21    21:16:17     12166          
  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. -INC PPARAM
  31. -INC CCOPTIO
  32. -INC CCGEOME
  33. -INC CCREEL
  34. -INC CCHAMP
  35. C==DEB= FORMULATION HHO == INCLUDE =====================================
  36. -INC CCHHOPA
  37. C==FIN= FORMULATION HHO ================================================
  38.  
  39. -INC SMCHAML
  40. -INC SMELEME
  41. -INC SMINTE
  42. -INC SMMODEL
  43. -INC SMCOORD
  44.  
  45. -INC TMPTVAL
  46.  
  47.       SEGMENT NOTYPE
  48.         CHARACTER*16 TYPE(NBTYPE)
  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.         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.         CMATE = CMATEE
  166.         MATE  = IMATEE
  167.         INAT  = INATUU
  168.         LOGMA = CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR.
  169.      &          CMATE.EQ.'UNIDIREC'
  170. C =====
  171. C  3.5 - Recuperation d'informations sur l'element fini du sous-modele
  172. C        Activation du segment d'integration
  173. C =====
  174.         NBGS=INFELE(4)
  175.         IPORE=INFELE(8)
  176. *        IPMINT=INFELE(11)
  177.         IPMINT=infmod(7)
  178.         MINTE=IPMINT
  179.         if (mele.eq.260) then
  180.           nbpgau=5
  181.         else
  182.           NBPGAU=POIGAU(/1)
  183.         endif
  184.         MFR =INFELE(13)
  185. C=DEB==== FORMULATION HHO ==== Traitement MFR = 1 (MASSIF) =============
  186.         IF (MFR .EQ. HHO_MFR_ELEMENT) MFR = 1
  187. C=FIN==== FORMULATION HHO ==============================================
  188.         NEPTH=INFELE(16)
  189.         LOGMF = MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33.OR.MFR.EQ.63
  190. C =====
  191. C  3.6 - Recuperation d'informations liees au maillage IPMAIL
  192. C =====
  193.         MELEME=IPMAIL
  194.         NBNN=NUM(/1)
  195.         NBELEM=NUM(/2)
  196.         NBNO=NBNN
  197.         IPPORE=0
  198.         IF (MFR.EQ.33) THEN
  199.           NBNO=IPORE
  200.           IPPORE=NBNN
  201.         ENDIF
  202.         IF (MFR.EQ.63) THEN
  203. C         NBNO=IPORE
  204.           IPPORE=NBNN
  205.         ENDIF
  206. C =====
  207. C  3.7 - Recuperation des temperatures associees au sous-modele
  208. C        Verification de leur presence dans le MCHAML (IPCHE2)
  209. C =====
  210.         NFAC=0
  211.         if(lnomid(8).ne.0) then
  212.           lsupte=.false.
  213.           nomid =lnomid(8)
  214.           motemp=nomid
  215.           ntem  =lesobl(/2)
  216.           nfac  =lesfac(/2)
  217.         else
  218.           CALL IDTEMP(MFR,IFOUR,NPINT,MOTEMP,NTEM,NFAC)
  219.         endif
  220.         CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOTEMP,MOTYTE,1,INFOS,3,IVATEM)
  221.         IF (IERR.NE.0) GOTO 230
  222.         IF (ISupT.EQ.1)THEN
  223.           CALL VALCHE(IVATEM,NTEM,IPMINT,IPPORE,MOTEMP,MELE)
  224.           IF (IERR.NE.0) THEN
  225.             ISupT=0
  226.             GOTO 230
  227.           ENDIF
  228.         ENDIF
  229. C =====
  230. C  3.8 - Recuperation des noms des caracteristiques MATERIAU
  231. C        Traitement suivant la formulation MFR et l'element fini MELE
  232. C        Verification de leur presence dans le MCHAML (IPCHE1)
  233. C =====
  234.         NBROBL=0
  235.         NBRFAC=0
  236.         NOMID =0
  237. C= 3.8.1 - Elements POUTRE,BARRE,POI1,TUYAUX...
  238.         IF (MELE.EQ.29.OR.MELE.EQ. 42.OR.MELE.EQ. 45.OR.MELE.EQ. 46.OR.
  239.      .      MELE.EQ.95.OR.MELE.EQ.123.OR.MELE.EQ.124) THEN
  240.           NBROBL=2
  241.           SEGINI,NOMID
  242.           LESOBL(1)='ALPH'
  243.           LESOBL(2)='TALP'
  244.  
  245. C= 3.8.2 - Materiau isotrope
  246.         ELSEIF (CMATE.EQ.'ISOTROPE') THEN
  247.           NBROBL=2
  248.           SEGINI,NOMID
  249.           IF (MFR.EQ.35) THEN
  250.             LESOBL(1)='ALPN'
  251.           ELSE
  252.             LESOBL(1)='ALPH'
  253.           ENDIF
  254.           LESOBL(2)='TALP'
  255.  
  256. C= 3.8.3 - Materiau orthotrope
  257.         ELSEIF (CMATE.EQ.'ORTHOTRO') THEN
  258.           IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN
  259.             NBROBL=5
  260.             SEGINI,NOMID
  261.             LESOBL(1)='ALP1'
  262.             LESOBL(2)='ALP2'
  263.             LESOBL(3)='V1X'
  264.             LESOBL(4)='V1Y'
  265.             LESOBL(5)='TALP'
  266.           ELSEIF (MFR.EQ.75) THEN
  267.             IF (IDIM.EQ.3) THEN
  268.             NBROBL=7
  269.             SEGINI,NOMID
  270.               LESOBL(1)='ALPN'
  271.               LESOBL(2)='ALP1'
  272.               LESOBL(3)='ALP2'
  273.               LESOBL(4)='ALQN'
  274.               LESOBL(5)='ALQ1'
  275.               LESOBL(6)='ALQ2'
  276.               LESOBL(7)='TALP'
  277.             ELSEIF (IDIM.EQ.2) THEN
  278.             NBROBL=4
  279.             SEGINI,NOMID
  280.               LESOBL(1)='ALPN'
  281.               LESOBL(2)='ALPS'
  282.               LESOBL(3)='ALQS'
  283.               LESOBL(4)='TALP'
  284.             ENDIF
  285.           ELSEIF (MFR.EQ.35) THEN
  286.             NBROBL=4
  287.             SEGINI,NOMID
  288.             LESOBL(1)='ALPN'
  289.             LESOBL(2)='V1X'
  290.             LESOBL(3)='V1Y'
  291.             LESOBL(4)='TALP'
  292.           ELSEIF (MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33) THEN
  293.             IF (IFOUR.EQ.-2) THEN
  294.               NBROBL=5
  295.               SEGINI,NOMID
  296.               LESOBL(1)='ALP1'
  297.               LESOBL(2)='ALP2'
  298.               LESOBL(3)='V1X'
  299.               LESOBL(4)='V1Y'
  300.               LESOBL(5)='TALP'
  301.             ELSEIF (IFOUR.EQ.-1.OR.IFOUR.EQ.-3.OR.
  302.      .               IFOUR.EQ.0.OR.IFOUR.EQ.1) THEN
  303.               NBROBL=6
  304.               SEGINI,NOMID
  305.               LESOBL(1)='ALP1'
  306.               LESOBL(2)='ALP2'
  307.               LESOBL(3)='ALP3'
  308.               LESOBL(4)='V1X'
  309.               LESOBL(5)='V1Y'
  310.               LESOBL(6)='TALP'
  311.             ELSEIF (IFOUR.EQ.2) THEN
  312.               NBROBL=10
  313.               SEGINI,NOMID
  314.               LESOBL(1 )='ALP1'
  315.               LESOBL(2 )='ALP2'
  316.               LESOBL(3 )='ALP3'
  317.               LESOBL(4 )='V1X '
  318.               LESOBL(5 )='V1Y '
  319.               LESOBL(6 )='V1Z '
  320.               LESOBL(7 )='V2X '
  321.               LESOBL(8 )='V2Y '
  322.               LESOBL(9 )='V2Z '
  323.               LESOBL(10)='TALP'
  324.             ELSEIF (IFOUR.GE.3.AND.IFOUR.LE.15) THEN
  325.               IF (IFOUR.EQ.6) THEN
  326.                 NBROBL=2
  327.                 SEGINI,NOMID
  328.                 LESOBL(1)='ALP1'
  329.                 LESOBL(2)='TALP'
  330.               ELSEIF (IFOUR.EQ.5.OR.IFOUR.EQ.10) THEN
  331.                 NBROBL=3
  332.                 SEGINI,NOMID
  333.                 LESOBL(1)='ALP1'
  334.                 LESOBL(2)='ALP3'
  335.                 LESOBL(3)='TALP'
  336.               ELSEIF (IFOUR.EQ.4.OR.IFOUR.EQ.8.OR.IFOUR.EQ.13) THEN
  337.                 NBROBL=3
  338.                 SEGINI,NOMID
  339.                 LESOBL(1)='ALP1'
  340.                 LESOBL(2)='ALP2'
  341.                 LESOBL(3)='TALP'
  342.               ELSE
  343.                 NBROBL=4
  344.                 SEGINI,NOMID
  345.                 LESOBL(1)='ALP1'
  346.                 LESOBL(2)='ALP2'
  347.                 LESOBL(3)='ALP3'
  348.                 LESOBL(4)='TALP'
  349.               ENDIF
  350.             ENDIF
  351.           ENDIF
  352.  
  353. C= 3.8.4 - Materiau anisotrope
  354.         ELSEIF (CMATE.EQ.'ANISOTRO') THEN
  355.           IF (MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33) THEN
  356.             IF (IFOUR.EQ.-2) THEN
  357.               NBROBL=6
  358.               SEGINI,NOMID
  359.               LESOBL(1)='ALP1'
  360.               LESOBL(2)='ALP2'
  361.               LESOBL(3)='AL12'
  362.               LESOBL(4)='V1X '
  363.               LESOBL(5)='V1Y '
  364.               LESOBL(6)='TALP'
  365.             ELSEIF (IFOUR.EQ.-3 .OR.IFOUR.EQ.-1.OR.
  366.      .              IFOUR.EQ. 0 .OR.IFOUR.EQ. 1) THEN
  367.               NBROBL=7
  368.               SEGINI,NOMID
  369.               LESOBL(1)='ALP1'
  370.               LESOBL(2)='ALP2'
  371.               LESOBL(3)='AL12'
  372.               LESOBL(4)='ALP3'
  373.               LESOBL(5)='V1X '
  374.               LESOBL(6)='V1Y '
  375.               LESOBL(7)='TALP'
  376.             ELSEIF (IFOUR.EQ.2) THEN
  377.               NBROBL=13
  378.               SEGINI,NOMID
  379.               LESOBL(1 )='ALP1'
  380.               LESOBL(2 )='ALP2'
  381.               LESOBL(3 )='ALP3'
  382.               LESOBL(4 )='AL12'
  383.               LESOBL(5 )='AL13'
  384.               LESOBL(6 )='AL23'
  385.               LESOBL(7 )='V1X '
  386.               LESOBL(8 )='V1Y '
  387.               LESOBL(9 )='V1Z '
  388.               LESOBL(10)='V2X '
  389.               LESOBL(11)='V2Y '
  390.               LESOBL(12)='V2Z '
  391.               LESOBL(13)='TALP'
  392.             ENDIF
  393.           ELSEIF (MFR.EQ.75) THEN
  394.             IF (IDIM.EQ.3) THEN
  395.             NBROBL=7
  396.             SEGINI,NOMID
  397.               LESOBL(1)='ALP1'
  398.               LESOBL(2)='ALP2'
  399.               LESOBL(3)='ALP3'
  400.               LESOBL(4)='ALQ1'
  401.               LESOBL(5)='ALQ2'
  402.               LESOBL(6)='ALQ3'
  403.               LESOBL(7)='TALP'
  404.             ELSEIF (IDIM.EQ.2) THEN
  405.             NBROBL=4
  406.             SEGINI,NOMID
  407.               LESOBL(1)='ALP1'
  408.               LESOBL(2)='ALP2'
  409.               LESOBL(3)='ALQ3'
  410.               LESOBL(4)='TALP'
  411.             ENDIF
  412.           ENDIF
  413.  
  414. C= 3.8.5 - Materiau unidirectionnel
  415.         ELSEIF (CMATE.EQ.'UNIDIREC') THEN
  416.           IF (MFR.EQ.1.AND.IDIM.EQ.3) THEN
  417.             NBROBL=8
  418.             SEGINI,NOMID
  419.             LESOBL(1)='ALPH'
  420.             LESOBL(2)='V1X '
  421.             LESOBL(3)='V1Y '
  422.             LESOBL(4)='V1Z '
  423.             LESOBL(5)='V2X '
  424.             LESOBL(6)='V2Y '
  425.             LESOBL(7)='V2Z '
  426.             LESOBL(8)='TALP'
  427.           ELSE
  428.             NBROBL=4
  429.             SEGINI,NOMID
  430.             LESOBL(1)='ALPH'
  431.             LESOBL(2)='V1X '
  432.             LESOBL(3)='V1Y '
  433.             LESOBL(4)='TALP'
  434.           ENDIF
  435.  
  436.         ELSE
  437.           if(lnomid(6).ne.0) then
  438.             lsupma=.false.
  439.             nomid=lnomid(6)
  440.             momatr=nomid
  441.             nmatr=lesobl(/2)
  442.             nmatf=lesfac(/2)
  443.           else
  444.             CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF)
  445.           endif
  446.           NOMID =MOMATR
  447.           NBROBL=NMATR
  448.           NBRFAC=NMATF
  449.         ENDIF
  450.  
  451.         MOMATR = NOMID
  452.         NMATR  = NBROBL
  453.         NMATF  = NBRFAC
  454.         NMATT  = NMATR + NMATF
  455.         NBGMAT = 0
  456.         NELMAT = 0
  457. C= 3.8.6 - Verification de la presence des caracteristiques dans IPCHE1
  458.         IF (MOMATR.NE.0) THEN
  459.           IF (CMATE.EQ.'SECTION') THEN
  460.             NBTYPE=3
  461.             SEGINI,NOTYPE
  462.             TYPE(1)='POINTEURMMODEL'
  463.             TYPE(2)='POINTEURMCHAML'
  464.             TYPE(3)='POINTEURLISTREEL'
  465.           ELSE
  466.             NBTYPE=1
  467.             SEGINI,NOTYPE
  468.             TYPE(1)='REAL*8'
  469.           ENDIF
  470.           MOTYPE=NOTYPE
  471.           CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOMATR,MOTYPE,1,
  472.      .                INFOS,3,IVAMAT)
  473.           SEGSUP,NOTYPE
  474.           IF (IERR.NE.0) GOTO 240
  475.           IF (ISupC.EQ.1) THEN
  476.             CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE,MOMATR,MELE)
  477.             IF (IERR.NE.0)THEN
  478.                ISupC=0
  479.                GOTO 240
  480.             ENDIF
  481.           ENDIF
  482.           MPTVAL=IVAMAT
  483.           MELVAL=IVAL(1)
  484.           DO i=1,NMATT
  485.             IF (IVAL(i).NE.0) THEN
  486.               MELVAL=IVAL(i)
  487.               IF (CMATE.EQ.'SECTION') THEN
  488.                 NBGMAT=MAX(NBGMAT,IELCHE(/1))
  489.                 NELMAT=MAX(NELMAT,IELCHE(/2))
  490.               ELSE
  491.                 NBGMAT=MAX(NBGMAT,VELCHE(/1))
  492.                 NELMAT=MAX(NELMAT,VELCHE(/2))
  493.               ENDIF
  494.             ENDIF
  495.           ENDDO
  496.         ENDIF
  497. C =====
  498. C  3.9 - Recuperation des noms des caracteristiques
  499. C =====
  500.         NBROBL=0
  501.         NBRFAC=0
  502.         IVECT =0
  503.         NOMID =0
  504.         NOTYPE=MOTYTE
  505. C= 3.9.1 - Elements COQUES : epaisseur
  506.         IF (MFR.EQ.3.OR.MFR.EQ.9) THEN
  507.           NBROBL=1
  508.           SEGINI,NOMID
  509.           LESOBL(1)='EPAI'
  510. C= 3.9.2 - Elements BARREs et CERCEs : section
  511.         ELSEIF (MFR.EQ.27) THEN
  512.           NBROBL=1
  513.           SEGINI,NOMID
  514.           LESOBL(1)='SECT'
  515. C= 3.9.3 - Elements BAEX : section, excentrements et orientation
  516.         ELSEIF (MFR.EQ.49) THEN
  517.           NBROBL=6
  518.           SEGINI,NOMID
  519.           LESOBL(1)='SECT'
  520.           LESOBL(2)='EXCZ'
  521.           LESOBL(3)='EXCY'
  522.           LESOBL(4)='VX  '
  523.           LESOBL(5)='VY  '
  524.           LESOBL(6)='VZ  '
  525. C= 3.9.4 - Elements POUTREs
  526.         ELSEIF (MFR.EQ.7) THEN
  527.           IF (CMATE.NE.'SECTION') THEN
  528.             NBROBL=1
  529.             SEGINI,NOMID
  530.             LESOBL(1)='SECT'
  531.           ENDIF
  532. C= 3.9.5 - Elements TUYAUx
  533.         ELSEIF (MFR.EQ.13) THEN
  534.           NBROBL=2
  535.           NBRFAC=4
  536.           SEGINI,NOMID
  537.           LESOBL(1)='EPAI'
  538.           LESOBL(2)='RAYO'
  539.           LESFAC(1)='RACO'
  540.           LESFAC(2)='VX  '
  541.           LESFAC(3)='VY  '
  542.           LESFAC(4)='VZ  '
  543.           IVECT=1
  544.         ENDIF
  545.         MOCARA= NOMID
  546.         NCARA = NBROBL
  547.         NCARF = NBRFAC
  548.         NCARR = NCARA + NCARF
  549.  
  550. C= 3.9.6 - Verification de leur presence dans IPCHE1
  551.         IF (MOCARA.NE.0) THEN
  552.           MOTYPE=NOTYPE
  553.           IF (IPCHE1.NE.0) THEN
  554.             CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCARA,MOTYPE,1,
  555.      .                  INFOS,3,IVACAR)
  556.             IF (IERR.NE.0) GOTO 250
  557.  
  558.           ELSE
  559.             MOTERR(1:4)='CARA'
  560.             MOTERR(5:8)='CARA'
  561.             MOTERR(9:12)=NOMTP(MELE)
  562.             MOTERR(13:20)='EPTH'
  563.             CALL ERREUR(145)
  564.             GOTO 250
  565.           ENDIF
  566.  
  567.           IF (ISupC.EQ.1) THEN
  568.             CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  569.             IF (IERR.NE.0) THEN
  570.               ISupC=0
  571.               GOTO 250
  572.             ENDIF
  573.           ENDIF
  574.         ENDIF
  575. C ======
  576. C  3.10 - Recuperation des noms des composantes de deformations
  577. C ======
  578.         if(lnomid(5).ne.0) then
  579.           nomid=lnomid(5)
  580.           moepth=nomid
  581.           lsupde=.false.
  582.           nstr=lesobl(/2)
  583.         else
  584.          CALL IDDEFO(IMODEL,IFOUR,MOEPTH,NSTR,NFAC)
  585.          lsupde=.true.
  586.         endif
  587.  
  588. C       Meme verification que dans modeli.eso (On a eu un BUG une fois)
  589.         IF(NSTR .NE. NEPTH)THEN
  590.           IPT1     =IMAMOD
  591.           MOTERR   =NOMS(IPT1.ITYPEL)
  592.           INTERR(1)=NSTR
  593.           INTERR(2)=NEPTH
  594.           CALL ERREUR(1098)
  595.           RETURN
  596.         ENDIF
  597. C ======
  598. C  3.11 - Initialisation du MCHAML des contraintes de Von Mises (MCHAML)
  599. C         associe au modele elementaire iSou (de maillage IPMAIL)
  600. C         Remplissage des donnees associees a MCHAML dans MCHELM(global)
  601. C ======
  602. C= 3.11.1 - Initialisation de MCHAML
  603.         N2=NEPTH
  604.         SEGINI,MCHAML
  605. C= 3.11.2 - Remplissage de MCHEML  (KSou)
  606.         CONCHE(KSou)=CONM
  607.         IMACHE(KSou)=IPMAIL
  608.         ICHAML(KSou)=MCHAML
  609.         INFCHE(KSou,1)=0
  610.         INFCHE(KSou,2)=0
  611.         INFCHE(KSou,3)=NIFOUR
  612.         INFCHE(KSou,4)=IPMINT
  613.         INFCHE(KSou,5)=0
  614.         INFCHE(KSou,6)=5
  615. C= 3.11.3 - Initialisation des N2 MELVAL associes a MCHAML
  616. C=          Fin du remplissage de MCHAML
  617.         N1PTEL=NBGS
  618.         N1EL=NBELEM
  619.         IF (MELE.EQ.30.OR.MELE.EQ.43) THEN
  620.           N1PTEL=1
  621.           N1EL  =1
  622.         ENDIF
  623.         N2PTEL=0
  624.         N2EL  =0
  625.         NSR   =1
  626.         NCOSOR=N2
  627.         SEGINI,MPTVAL
  628.         IVAETH=MPTVAL
  629.         NOMID=MOEPTH
  630.         DO i=1,N2
  631.           NOMCHE(i)=LESOBL(i)
  632.           TYPCHE(i)='REAL*8'
  633.           SEGINI,MELVAL
  634.           IELVAL(i)=MELVAL
  635.           IVAL(i)  =MELVAL
  636.         ENDDO
  637. C ======
  638. C  3.12 - Initialisation de quelques segments de travail
  639. C         Recuperation des fonctions de forme et de leurs derivees au
  640. C         centre de l'element pour le calcul des axes locaux
  641. C ======
  642.         IF (LOGMA) THEN
  643.           IF (LOGMF) THEN
  644.             IELE=NUMGEO(MELE)
  645.             CALL RESHPT(1,NBNO,IELE,MELE,NPINT,IPT1,IRT1)
  646.             IF (IERR.NE.0) GOTO 260
  647.             MINTE2=IPT1
  648.           ENDIF
  649.           SEGINI,MWRK2
  650.         ENDIF
  651.         NV1=NMATT
  652.         SEGINI,MVELCH,MWRK3
  653. C ======
  654. C  3.13 - Boucle sur les elements du sous-modele elementaire
  655. C ======
  656.         DO iElt=1,NBELEM
  657. C= 3.13.1 - Cas des elements MASSIFs - materiau a "TROPIE"
  658. C=          Recuperation des coordonnees des noeuds de l element iElt
  659. C=          Determination des axes locaux aux noeuds
  660.           IF (LOGMA.AND.LOGMF) THEN
  661.             CALL DOXE(XCOOR,IDIM,NBNN,NUM,iElt,XE)
  662.             NBSH=MINTE2.SHPTOT(/2)
  663.             CALL RLOCAL(XE,MINTE2.SHPTOT,NBSH,NBNN,TXR)
  664.             IF (nbsh.EQ.-1) THEN
  665.               CALL ERREUR(525)
  666.               GOTO 260
  667.             ENDIF
  668.           ENDIF
  669. C= 3.13.2 - Cas de la poutre TIMO et modele SECTION
  670.           IF (CMATE.EQ.'SECTION') THEN
  671.             MPTVAL=IVAMAT
  672.             MELVAL=IVAL(1)
  673.             IBMN=MIN(iElt,IELCHE(/2))
  674.             IPMODL=IELCHE(1,IBMN)
  675.             MELVAL=IVAL(2)
  676.             IBMN=MIN(iElt,IELCHE(/2))
  677.             IPMAT=IELCHE(1,IBMN)
  678.             CALL FRIGTH(IPMODL,IPMAT,CRIGI,0,0)
  679.           ENDIF
  680. C= 3.13.3 - Boucle sur les points de Gauss
  681.           DO iGau=1,NBPGAU
  682. C= 3.13.3.1 - Remplissage du tableau des caracteristiques du materiau
  683.             IF (CMATE.NE.'SECTION') THEN
  684.               MPTVAL=IVAMAT
  685.               DO i=1,NMATT
  686.                 MELVAL=IVAL(i)
  687.                 IBMN=MIN(iElt,VELCHE(/2))
  688.                 IGMN=MIN(iGau,VELCHE(/1))
  689.                 VALMAT(i)=VELCHE(IGMN,IBMN)
  690.               ENDDO
  691.             ENDIF
  692. C= 3.13.3.2 - Prise en compte des epaisseur et excentrement dans le cas
  693. C=            des coques minces avec ou sans cisaillement transverse
  694.             IF ((CMATE.EQ.'ISOTROPE'.OR.CMATE.EQ.'ORTHOTRO'.
  695.      $   OR.CMATE.EQ.'UNIDIREC') .AND.(MFR.EQ.3.OR.MFR.EQ.9)) THEN
  696.               MPTVAL=IVACAR
  697.               MELVAL=IVAL(1)
  698.               IF (MELVAL.NE.0) THEN
  699.                 IBMN=MIN(iElt,VELCHE(/2))
  700.                 IGMN=MIN(iGau,VELCHE(/1))
  701.                 EPAIST=VELCHE(IGMN,IBMN)
  702.               ELSE
  703.                 CALL ERREUR(527)
  704.                 GOTO 260
  705.               ENDIF
  706.             ENDIF
  707. C= 3.13.3.3 - Recuperation des temperatures du point de Gauss iGau (T et TALP)
  708. C             TEMP = T_courant - T_ALPHA_REFERENCE
  709.             MPTVAL=IVAMAT
  710.             MELVAL=IVAL(IVAL(/1))
  711.             TALP  =VELCHE(IGMN,IBMN)
  712.  
  713.             MPTVAL=IVATEM
  714.             MELVAL=IVAL(1)
  715.             IGMN=MIN(iGau,VELCHE(/1))
  716.             IBMN=MIN(iElt,VELCHE(/2))
  717.             TEMP=VELCHE(IGMN,IBMN) - TALP
  718.  
  719. C           write(6,*) 'EPTHP',ielt,igau,igmn,ibmn,temp
  720.             IF (((MFR.EQ.3.OR.MFR.EQ.9).AND.(CMATE.EQ.'ISOTROPE'.
  721.      $       OR.CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'UNIDIREC')).
  722.      $         OR.(MFR.EQ.5.AND.
  723.      $          (CMATE.EQ.'ISOTROPE'.OR.CMATE.EQ.'ORTHOTRO'))) THEN
  724.               IF (NPINT.EQ.0) THEN
  725.                 THIF=TEMP
  726.                 TEMP=XZero
  727.                 MELVAL=IVAL(2)
  728.                 IGMN=MIN(iGau,VELCHE(/1))
  729.                 IBMN=MIN(iElt,VELCHE(/2))
  730.                 THM=VELCHE(IGMN,IBMN)
  731.                 MELVAL=IVAL(3)
  732.                 IGMN=MIN(iGau,VELCHE(/1))
  733.                 IBMN=MIN(iElt,VELCHE(/2))
  734.                 THSU=VELCHE(IGMN,IBMN)
  735.               ENDIF
  736.               E3=DZEGAU(iGau)
  737.             ELSE
  738.               IF (CMATE.EQ.'SECTION') TEMP=TEMP*CRIGI(1)
  739.             ENDIF
  740.  
  741. C= 3.13.3.4 - Cas ISOTROPE : calcul des deformations thermiques
  742.             IF (CMATE.EQ.'ISOTROPE') THEN
  743.               CALL EPTHIS(MFR,MELE,VALMAT,NEPTH,TEMP,THIF,THM,THSU,
  744.      .                    E3,EPAIST,RES,NPINT,KERRE)
  745. C= 3.13.3.5 - Cas ORTHOTROPE : calcul des deformations thermiques
  746.             ELSEIF (CMATE.EQ.'ORTHOTRO') THEN
  747.               IF (NPINT.EQ.0) THEN
  748.                 CALL EPTHOR(MFR,MELE,VALMAT,NEPTH,TEMP,THIF,THM,THSU,
  749.      .                      E3,EPAIST,TXR,XLOC,XGLOB,ROTS,RES,KERRE)
  750.               ELSE
  751.                 KERRE=19
  752.               ENDIF
  753. C= 3.13.3.6 - Cas ANISOTROPE : calcul des deformations thermiques
  754.             ELSEIF (CMATE.EQ.'ANISOTRO') THEN
  755.               IF (NPINT.EQ.0) THEN
  756.                 CALL EPTHAN(MFR,MELE,VALMAT,NEPTH,TEMP,TXR,XLOC,XGLOB,
  757.      .                      ROTS,RES,KERRE)
  758.               ELSE
  759.                 KERRE=19
  760.               ENDIF
  761. C= 3.13.3.7 - Cas UNIDIRECTIONNEL : calcul des deformations thermiques
  762.             ELSEIF (CMATE.EQ.'UNIDIREC') THEN
  763.               IF (NPINT.EQ.0) THEN
  764.                 CALL EPTHUN(MFR,MELE,VALMAT,NEPTH,TEMP,THIF,THM,THSU,
  765.      .                      EPAIST,TXR,XLOC,XGLOB,ROTS,RES,KERRE)
  766.               ELSE
  767.                 KERRE=19
  768.               ENDIF
  769. C= 3.13.3.8 - Cas HOMOGENEISE et SECTION : calcul des deformations ther.
  770.             ELSEIF (CMATE.EQ.'HOMOGENE'.OR.CMATE.EQ.'SECTION') THEN
  771.               IF (NPINT.EQ.0) THEN
  772.                 CALL EPTHHS(MELE,VALMAT,NEPTH,TEMP,RES,KERRE)
  773.               ELSE
  774.                 KERRE=19
  775.               ENDIF
  776. C= 3.13.3.9 - Cas non prevus et traitement des ERREURS
  777.             ELSE
  778.               KERRE=19
  779.             ENDIF
  780.             IF (KERRE.EQ.19) THEN
  781.               CALL ERREUR(19)
  782.               GOTO 260
  783.             ELSEIF (KERRE.EQ.86) THEN
  784.               MOTERR(1:4)=NOMTP(MELE)
  785.               MOTERR(5:12)='EPTH'
  786.               CALL ERREUR(86)
  787.               GOTO 260
  788.             ENDIF
  789. C= 3.13.3.10 - Stockage des deformations dans les MELVAL
  790.             MPTVAL=IVAETH
  791.             DO i=1,NEPTH
  792.               MELVAL=IVAL(i)
  793.               VELCHE(iGau,iElt)=RES(i)
  794.             ENDDO
  795.           ENDDO
  796. C       Fin boucle sur les points de Gauss
  797.  
  798.         ENDDO
  799. C       Fin boucle sur les elements
  800.  
  801. C       Traitement elements ICompressibles (methode BBAR)
  802.         IF (MFR.EQ.31) THEN
  803.           IELE=NUMGEO(MELE)
  804.           CALL RESHPT(NBPGAU,NBNO,IELE,MELE,NPINT,IPMINT,IRT1)
  805.           IF (IERR.NE.0) RETURN
  806.           IPCHA1 = MCHAML
  807.           CALL EPTBBA(MELE,IPCHA1,IPMINT,IPMAIL,IPCHA2)
  808.           IF (IERR.NE.0) RETURN
  809.           IF (IPCHA2.NE.MCHAML) SEGSUP,MCHAML
  810.           MCHAML = IPCHA2
  811.           ICHAML(KSou)=MCHAML
  812.         ENDIF
  813.  
  814. C ======
  815. C  3.14 - Desactivation/suppression de segments associes a iSou
  816. C         Sortie prematuree en cas d'ERREUR (iOK=0)
  817. C ======
  818.         IF (IERR.EQ.0) iOK=1
  819.  260    SEGSUP,MVELCH,MWRK3
  820.         IF (MOEPTH.NE.0) THEN
  821.           NOMID=MOEPTH
  822.           if(lsupde)SEGSUP,NOMID
  823.         ENDIF
  824.         IF (LOGMA) THEN
  825.           SEGSUP,MWRK2
  826.         ENDIF
  827.  250    IF (MOCARA.NE.0) THEN
  828.           NOMID=MOCARA
  829.           SEGSUP,NOMID
  830.           IF (ISupC.EQ.1) THEN
  831.             CALL DTMVAL(IVACAR,3)
  832.           ELSE
  833.             CALL DTMVAL(IVACAR,1)
  834.           ENDIF
  835.         ENDIF
  836.  240    IF (MOMATR.NE.0) THEN
  837.           NOMID=MOMATR
  838.           if(lsupma)SEGSUP,NOMID
  839.           IF (ISupC.EQ.1) THEN
  840.             CALL DTMVAL(IVAMAT,3)
  841.           ELSE
  842.             CALL DTMVAL(IVAMAT,1)
  843.           ENDIF
  844.         ENDIF
  845.  230    IF (MOTEMP.NE.0) THEN
  846.           NOMID=MOTEMP
  847.           if(lsupte)SEGSUP,NOMID
  848.         ENDIF
  849.         IF (ISupT.EQ.1) THEN
  850.           CALL DTMVAL(IVATEM,3)
  851.         ELSE
  852.          CALL DTMVAL(IVATEM,1)
  853.         ENDIF
  854.  220    CONTINUE
  855.  210    CONTINUE
  856.         IF (iOK.EQ.0) THEN
  857.           CALL DTMVAL(IVAETH,3)
  858.           IF (MCHAML.NE.0) SEGSUP,MCHAML
  859.           SEGSUP,MCHELM
  860.           GOTO 300
  861.         ENDIF
  862.         CALL DTMVAL(IVAETH,1)
  863.  98    CONTINUE
  864.       ENDDO
  865.  
  866. C  4 - MENAGE : DESACTIVATION/DESTRUCTION DE SEGMENTS
  867. C ====================================================
  868.       IRET=1
  869.       N1 = KSOU
  870.       SEGADJ MCHELM
  871.  300  CONTINUE
  872.       NOTYPE=MOTYTE
  873.       SEGSUP,NOTYPE
  874.  
  875.       END
  876.  
  877.  
  878.  

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