Télécharger la plaquette Cast3M


fr en

Télécharger tresk.eso

Retour à la liste

Numérotation des lignes : 

tresk

  1. C TRESK     SOURCE    OF166741  25/02/21    21:19:00     12166          
  2.       SUBROUTINE TRESK(IPMODL,IPCHE1,IPCHE2,IMIL,IPSCAL,IRET)
  3. *____________________________________________________________________
  4. *
  5. *  Entrees :
  6. *  ---------
  7. *
  8. *     IPCHE1  Pointeur sur un MCHAML de CONTRAINTES
  9. *     IPCHE2  Pointeur sur un MCHAML de CARACTERISTIQUES
  10. *     IMIL    Indicateur ou on calcul les CONTRAINTES pour
  11. *             les COQUES
  12. *
  13. *  Sorties :
  14. *  ---------
  15. *
  16. *     IPSCAL  Pointeur sur un MCHAML SCALAIRE
  17. *     IRET =1  OU  0   SUIVANT SUCCES OU PAS
  18. *
  19. *  Passage aux nouveaux chamelem par jm CAMPENON le 04/91
  20. *
  21. *__________________________________________________________________
  22. *
  23.       IMPLICIT INTEGER(I-N)
  24.       IMPLICIT REAL*8(A-H,O-Z)
  25.  
  26. -INC PPARAM
  27. -INC CCOPTIO
  28. -INC CCHAMP
  29. -INC CCGEOME
  30. -INC SMCOORD
  31.  
  32. -INC SMCHAML
  33. -INC SMMODEL
  34. -INC SMINTE
  35.  
  36. -INC TMPTVAL
  37.  
  38.       SEGMENT NOTYPE
  39.         CHARACTER*16 TYPE(NBTYPE)
  40.       ENDSEGMENT
  41.  
  42.       PARAMETER ( NINF=3 )
  43.       INTEGER INFOS(NINF)
  44.       CHARACTER*(NCONCH) CONM
  45.       LOGICAL lsupco
  46.       INTEGER ISUP1,ISUP2
  47. *
  48.       DIMENSION A(3,3),D(3),S(3,3)
  49.       DIMENSION SIG(9)
  50.  
  51.       ISUP1=0
  52.       ISUP2=0
  53.       IRET = 0
  54.       IPSCAL = 0
  55. *
  56. *     Verification du lieu support du MCHAML de CONTRAINTES
  57. *
  58.       CALL QUESUP (IPMODL,IPCHE1,5,0,ISUP1,IRETCO)
  59.       IF (ISUP1.GT.1) RETURN
  60. *
  61. *     Verification du lieu support du MCHAML de CARACTERISTIQUES
  62. *
  63.       IF (IPCHE2.NE.0) THEN
  64.          CALL QUESUP (IPMODL,IPCHE2,3,0,ISUP2,IRETCA)
  65.          IF (ISUP2.GT.1) RETURN
  66.       ENDIF
  67. *
  68.       IDIMM=IDIM
  69.       IDEUX=2
  70.       DO  I=1,3
  71.          D(I)=0.D0
  72.          DO  J=1,3
  73.             A(J,I)=0.D0
  74.             S(J,I)=0.D0
  75.          ENDDO
  76.       ENDDO
  77. *
  78. *     Activation du MMODEL
  79. *
  80.       MMODEL=IPMODL
  81.       SEGACT MMODEL
  82.       NSOUS=KMODEL(/1)
  83.       KEL22 = 0
  84.       DO ISOUS = 1, NSOUS
  85.         IMODEL=KMODEL(ISOUS)
  86.         SEGACT,IMODEL
  87.         IF (NEFMOD.EQ.22.or.formod.ne.'MECANIQUE') KEL22 = KEL22 + 1
  88.       ENDDO
  89. *
  90. *     Creation du MCHELM
  91. *
  92.       N1=NSOUS-KEL22
  93.       L1=8
  94.       N3=6
  95.       SEGINI MCHELM
  96.       IFOCHE=IFOUR
  97.       TITCHE='SCALAIRE'
  98. *
  99. *     Debut de la boucle sur les differentes sous zones
  100. *
  101.       ISOUSS=0
  102.       DO 200 ISOUS=1,NSOUS
  103. *
  104. *        On recupere l'information generale
  105. *
  106.          IMODEL=KMODEL(ISOUS)
  107.          MELE=NEFMOD
  108.          IF (NEFMOD.EQ.22.OR.FORMOD.NE.'MECANIQUE') GOTO 200
  109. *
  110.          ISOUSS=ISOUSS+1
  111. *
  112.          IPMAIL=IMAMOD
  113.          CONM  =CONMOD
  114. C
  115. C   COQUE INTEGREE OU PAS ?
  116. C
  117.          NPINT=INFMOD(1)
  118.          IF (NPINT.NE.0)THEN
  119.             CALL ERREUR(615)
  120.             GOTO 9999
  121.          ENDIF
  122. C
  123.          IMACHE(ISOUSS)=IPMAIL
  124.          CONCHE(ISOUSS)=CONMOD
  125. *
  126. *        Traitement du modele
  127. *
  128.          MELE=NEFMOD
  129. *
  130. *        Information sur l'element fini
  131. *
  132. *         CALL ELQUOI (MELE,0,5,IPINF,IMODEL)
  133. *         IF (IERR.NE.0) GOTO 9999
  134. *
  135. *         INFO=IPINF
  136.          MFR   =INFELE(13)
  137.          NSTRS =INFELE(16)
  138.          NBPGAU=INFELE( 4)
  139. *         MINTE =INFELE(11)
  140.          MINTE=INFMOD(7)
  141.          IPMINT=MINTE
  142.          IF (IPMINT.NE.0) SEGACT,MINTE
  143.          IPPORE=0
  144.          IF(MFR.EQ.33)IPPORE=NBNNE(NUMGEO(MELE))
  145. *         SEGSUP INFO
  146. *
  147. *        Creation du tableau INFOS
  148. *
  149.          CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE2,INFOS,IRTD)
  150.          IF (IRTD.EQ.0) GOTO 9998
  151. *
  152.          INFCHE(ISOUSS,1)=0
  153.          INFCHE(ISOUSS,2)=0
  154.          INFCHE(ISOUSS,3)=NIFOUR
  155.          INFCHE(ISOUSS,4)=MINTE
  156.          INFCHE(ISOUSS,5)=0
  157.          INFCHE(ISOUSS,6)=5
  158. *
  159. *        Creation du MCHAML
  160. *
  161.          N2=1
  162.          SEGINI MCHAML
  163.          ICHAML(ISOUSS)=MCHAML
  164.          NOMCHE(1)='SCAL'
  165.          TYPCHE(1)='REAL*8'
  166. *
  167. *        Noms de composantes necessaires
  168. *
  169.          if(lnomid(4).ne.0) then
  170.           nomid=lnomid(4)
  171.           segact nomid
  172.           mostrs=nomid
  173.           nstr=lesobl(/2)
  174.           nfac=lesfac(/2)
  175.           lsupco=.false.
  176.          else
  177.           lsupco=.true.
  178.           CALL IDCONT(IMODEL,IFOUR,MOSTRS,NSTR,NFAC)
  179.          endif
  180. *
  181. *        Verification de leur presence
  182. *
  183.          NCARA=0
  184.          NCARF=0
  185.          MOCARA=0
  186.          IVACAR=0
  187.          IVAMIS=0
  188. *
  189.          NBTYPE=1
  190.          SEGINI NOTYPE
  191.          MOTYPE=NOTYPE
  192.          TYPE(1)='REAL*8'
  193.          CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOSTRS,MOTYPE,1,INFOS,3,IVASTR)
  194.          SEGSUP NOTYPE
  195.          IF (IERR.NE.0) GOTO 9990
  196. *
  197.          IF (ISUP1.EQ.1) CALL VALCHE (IVASTR,NSTR,IPMINT,IPPORE,
  198.      &                   MOSTRS,MELE)
  199. *
  200. *        Recherche de la taille des MELVALs
  201. *
  202.          N1EL=0
  203.          N1PTEL=0
  204.          MPTVAL=IVASTR
  205.          DO 20 IO=1,NSTRS
  206.             MELVAL=IVAL(IO)
  207.             N1PTEL=MAX(N1PTEL,VELCHE(/1))
  208.             N1EL  =MAX(N1EL  ,VELCHE(/2))
  209.  20      CONTINUE
  210.          IF (N1PTEL.EQ.1.OR.NBPGAU.EQ.1) THEN
  211.            N1PTEL=1
  212.          ELSE
  213.            N1PTEL=NBPGAU
  214.          ENDIF
  215.          NBPTEL=N1PTEL
  216.          NEL   =N1EL
  217. *
  218. *        Creation du MELVAL de tresca
  219. *
  220.          N2PTEL=0
  221.          N2EL=0
  222.          SEGINI MELVAL
  223.          IELVAL(1)=MELVAL
  224.          IVAMIS   =MELVAL
  225. *
  226. *        Traitement des caracteristiques
  227. *
  228.          NBROBL=0
  229.          NBRFAC=0
  230. *
  231. *        Epaisseur dans le cas des coques et coques avec cisaillement
  232. *
  233.          IF (MFR.EQ.3.OR.MFR.EQ.9) THEN
  234.            NBROBL=1
  235.            SEGINI NOMID
  236.            MOCARA=NOMID
  237.            LESOBL(1)='EPAI'
  238.          ENDIF
  239. *
  240.          NCARA=NBROBL
  241.          NCARF=NBRFAC
  242.          NCARR=NCARA+NCARF
  243. *
  244.          IF (MOCARA.NE.0)  THEN
  245.             IF (IPCHE2.NE.0)  THEN
  246.                NBTYPE=1
  247.                SEGINI NOTYPE
  248.                MOTYPE=NOTYPE
  249.                TYPE(1)='REAL*8'
  250.                CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOCARA,
  251.      1                              MOTYPE,1,INFOS,3,IVACAR)
  252.                SEGSUP NOTYPE
  253.                IF (IERR.NE.0) GOTO 9990
  254.             ELSE
  255.                MOTERR(1:8)='CARACTER'
  256.                MOTERR(9:12)=NOMTP(MELE)
  257.                MOTERR(13:20)='TRESCA'
  258.                CALL ERREUR(145)
  259.                IVACAR=0
  260.                NCARA=0
  261.                NCARF=0
  262.                GOTO 9990
  263.             ENDIF
  264.             IF (ISUP2.EQ.1) THEN
  265.                CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  266.             ENDIF
  267.          ENDIF
  268. *
  269. *        Branchement suivant la formulation
  270. *
  271. *          MASSI COQUE COQEP POUT  CIST  THER  TUYA  LISP
  272.       GOTO (30,22,60,22,80,22,22,22,120,22,22,22,22,22,22),MFR
  273. *
  274.   22  CONTINUE
  275.       MOTERR(1:8)=NOMFR(MFR/2+1)
  276.       CALL ERREUR(193)
  277.       GOTO 9990
  278. *_______________________________________________________________________
  279. *
  280. *    FORMULATION MASSIVE
  281. *_______________________________________________________________________
  282. *
  283.  30   CONTINUE
  284. *
  285. C        On distingue le cas IDIM=1 des autres dimensions
  286.         IF (IDIM.EQ.1) THEN
  287.           DO IB=1,NEL
  288.             DO IGAU=1,NBPTEL
  289.               MPTVAL=IVASTR
  290.               MELVAL=IVAL(1)
  291.               IGMN=MIN(IGAU,VELCHE(/1))
  292.               IBMN=MIN(IB  ,VELCHE(/2))
  293.               D1=VELCHE(IGMN,IBMN)
  294.               MELVAL=IVAL(2)
  295.               IGMN=MIN(IGAU,VELCHE(/1))
  296.               IBMN=MIN(IB  ,VELCHE(/2))
  297.               D2=VELCHE(IGMN,IBMN)
  298.               MELVAL=IVAL(3)
  299.               IGMN=MIN(IGAU,VELCHE(/1))
  300.               IBMN=MIN(IB  ,VELCHE(/2))
  301.               D3=VELCHE(IGMN,IBMN)
  302.               W1=MAX(D1,D2,D3)
  303.               W2=MIN(D1,D2,D3)
  304.               MELVAL=IVAMIS
  305.               VELCHE(IGAU,IB)=ABS(W1-W2)
  306.             ENDDO
  307.           ENDDO
  308.           GOTO 150
  309.         ENDIF
  310.  
  311.       DO  IB=1,NEL
  312.          DO  IGAU=1,NBPTEL
  313.             MPTVAL=IVASTR
  314. *
  315.             MELVAL=IVAL(1)
  316.             IGMN=MIN(IGAU,VELCHE(/1))
  317.             IBMN=MIN(IB  ,VELCHE(/2))
  318.             A(1,1)=VELCHE(IGMN,IBMN)
  319. *
  320.             MELVAL=IVAL(2)
  321.             IGMN=MIN(IGAU,VELCHE(/1))
  322.             IBMN=MIN(IB  ,VELCHE(/2))
  323.             A(2,2)=VELCHE(IGMN,IBMN)
  324. *
  325.             MELVAL=IVAL(3)
  326.             IGMN=MIN(IGAU,VELCHE(/1))
  327.             IBMN=MIN(IB  ,VELCHE(/2))
  328.             A(3,3)=VELCHE(IGMN,IBMN)
  329. *
  330.             MELVAL=IVAL(4)
  331.             IGMN=MIN(IGAU,VELCHE(/1))
  332.             IBMN=MIN(IB  ,VELCHE(/2))
  333.             A(1,2)=VELCHE(IGMN,IBMN)
  334. *
  335.             A(2,1)=A(1,2)
  336. *
  337.             IF(IFOUR.LT.1.AND.IFOUR.GE.-3) GO TO 36
  338. *
  339.             IF(IFOUR.EQ.1) IDIMM=3
  340.             MELVAL=IVAL(5)
  341.             IGMN=MIN(IGAU,VELCHE(/1))
  342.             IBMN=MIN(IB  ,VELCHE(/2))
  343.             A(3,1)=VELCHE(IGMN,IBMN)
  344. *
  345.             MELVAL=IVAL(6)
  346.             IGMN=MIN(IGAU,VELCHE(/1))
  347.             IBMN=MIN(IB  ,VELCHE(/2))
  348.             A(3,2)=VELCHE(IGMN,IBMN)
  349. *
  350.             A(1,3)=A(3,1)
  351.             A(2,3)=A(3,2)
  352. *
  353.  36         CONTINUE
  354. *
  355.             CALL JACOB3(A,IDIMM,D,S)
  356.             W1=MAX(D(3),D(1),D(2))
  357.             W2=MIN(D(3),D(1),D(2))
  358. *
  359.             MELVAL=IVAMIS
  360.             VELCHE(IGAU,IB)=ABS(W1-W2)
  361.       ENDDO
  362.       ENDDO
  363.          GOTO 150
  364. *_______________________________________________________________________
  365. *
  366. *    FORMULATION COQUE
  367. *_______________________________________________________________________
  368. *
  369.    60 CONTINUE
  370. *
  371.       DO    IB=1,NEL
  372.          DO    IGAU=1,NBPTEL
  373.             MPTVAL=IVASTR
  374.             DO 62 ICOMP=1,NSTRS
  375.                MELVAL=IVAL(ICOMP)
  376.                IGMN=MIN(IGAU,VELCHE(/1))
  377.                IBMN=MIN(IB  ,VELCHE(/2))
  378.                SIG(ICOMP)=VELCHE(IGMN,IBMN)
  379.    62       CONTINUE
  380. *
  381.             MPTVAL=IVACAR
  382.             MELVAL=IVAL(1)
  383.             IGMN=MIN(IGAU,VELCHE(/1))
  384.             IBMN=MIN(IB  ,VELCHE(/2))
  385.             EPAIST=VELCHE(IGMN,IBMN)
  386. *
  387.             CALL EFCONT(EPAIST,0.D0,NSTRS,SIG)
  388. *
  389. *           Calcul des contraintes
  390. *
  391.             IF(IFOUR.GT.0) THEN
  392.                A(1,1)=SIG(1)+SIG(4)*IMIL
  393.                A(2,2)=SIG(2)+SIG(5)*IMIL
  394.                A(1,2)=SIG(3)+SIG(6)*IMIL
  395.                A(2,1)=A(1,2)
  396.             ELSE IF(IFOUR.LE.0) THEN
  397.                A(1,1)=SIG(1)+SIG(3)*IMIL
  398.                A(2,2)=SIG(2)+SIG(4)*IMIL
  399.             ENDIF
  400. *
  401.             CALL JACOB3(A,IDEUX,D,S)
  402.             W1=MAX(D(3),D(1),D(2))
  403.             W2=MIN(D(3),D(1),D(2))
  404. *
  405.             MELVAL=IVAMIS
  406.             VELCHE(IGAU,IB)=ABS(W1-W2)
  407.       ENDDO
  408.       ENDDO
  409.       GOTO 150
  410. *_______________________________________________________________________
  411. *
  412. *    FORMULATION COQUE EPAISSE
  413. *_______________________________________________________________________
  414. *
  415.    80 CONTINUE
  416. *
  417.       DO    IB=1,NEL
  418.          DO    IGAU=1,NBPTEL
  419.             MPTVAL=IVASTR
  420. *
  421.             MELVAL=IVAL(1)
  422.             IGMN=MIN(IGAU,VELCHE(/1))
  423.             IBMN=MIN(IB  ,VELCHE(/2))
  424.             A(1,1)=VELCHE(IGMN,IBMN)
  425. *
  426.             MELVAL=IVAL(2)
  427.             IGMN=MIN(IGAU,VELCHE(/1))
  428.             IBMN=MIN(IB  ,VELCHE(/2))
  429.             A(2,2)=VELCHE(IGMN,IBMN)
  430. *
  431.             MELVAL=IVAL(3)
  432.             IGMN=MIN(IGAU,VELCHE(/1))
  433.             IBMN=MIN(IB  ,VELCHE(/2))
  434.             A(1,2)=VELCHE(IGMN,IBMN)
  435. *
  436.             MELVAL=IVAL(4)
  437.             IGMN=MIN(IGAU,VELCHE(/1))
  438.             IBMN=MIN(IB  ,VELCHE(/2))
  439.             A(1,3)=VELCHE(IGMN,IBMN)
  440. *
  441.             MELVAL=IVAL(5)
  442.             IGMN=MIN(IGAU,VELCHE(/1))
  443.             IBMN=MIN(IB  ,VELCHE(/2))
  444.             A(2,3)=VELCHE(IGMN,IBMN)
  445. *
  446.             A(2,1)=A(1,2)
  447.             A(3,1)=A(1,3)
  448.             A(3,2)=A(2,3)
  449. *
  450.             CALL JACOB3(A,IDIM,D,S)
  451.             W1=MAX(D(3),D(1),D(2))
  452.             W2=MIN(D(3),D(1),D(2))
  453. *
  454.             MELVAL=IVAMIS
  455.             VELCHE(IGAU,IB)=ABS(W1-W2)
  456.       ENDDO
  457.       ENDDO
  458.       GOTO 150
  459. *_______________________________________________________________________
  460. *
  461. *    FORMULATION COQUE AVEC CISAILLEMENT
  462. *_______________________________________________________________________
  463. *
  464.   120 CONTINUE
  465. *
  466.       DO     IB=1,NEL
  467.          DO     IGAU=1,NBPTEL
  468.             MPTVAL=IVASTR
  469.             DO 122 ICOMP=1,NSTRS
  470.                MELVAL=IVAL(ICOMP)
  471.                IGMN=MIN(IGAU,VELCHE(/1))
  472.                IBMN=MIN(IB  ,VELCHE(/2))
  473.                SIG(ICOMP)=VELCHE(IGMN,IBMN)
  474.   122       CONTINUE
  475. *
  476.             MPTVAL=IVACAR
  477.             MELVAL=IVAL(1)
  478.             IGMN=MIN(IGAU,VELCHE(/1))
  479.             IBMN=MIN(IB  ,VELCHE(/2))
  480.             EPAIST=VELCHE(IGMN,IBMN)
  481. *
  482.             CALL EFCONT(EPAIST,0.D0,NSTRS,SIG)
  483. *
  484. *           Calcul des contraintes
  485. *
  486.             A(1,1)=SIG(1)+SIG(4)*IMIL
  487.             A(2,2)=SIG(2)+SIG(5)*IMIL
  488.             A(1,2)=SIG(3)+SIG(6)*IMIL
  489.             A(2,1)=A(1,2)
  490.             A(3,3)=0.D0
  491.             A(1,3)=SIG(7)
  492.             A(2,3)=SIG(8)
  493.             A(3,1)=A(1,3)
  494.             A(3,2)=A(2,3)
  495. *
  496.             CALL JACOB3(A,IDIM,D,S)
  497.             W1=MAX(D(3),D(1),D(2))
  498.             W2=MIN(D(3),D(1),D(2))
  499. *
  500.             MELVAL=IVAMIS
  501.             VELCHE(IGAU,IB)=ABS(W1-W2)
  502.       ENDDO
  503.       ENDDO
  504.       GOTO 150
  505. *
  506. *     Desactivation des segments propres a la geometrie ISOUS
  507. *
  508.   150 CONTINUE
  509.       IF (ISUP1.EQ.1) THEN
  510.         CALL DTMVAL(IVASTR,3)
  511.       ELSE
  512.         CALL DTMVAL(IVASTR,1)
  513.       ENDIF
  514.       NOMID =MOSTRS
  515.       if(lsupco)SEGSUP NOMID
  516. *
  517.       IF (ISUP2.EQ.1) THEN
  518.         CALL DTMVAL(IVACAR,3)
  519.       ELSE
  520.         CALL DTMVAL(IVACAR,1)
  521.       ENDIF
  522. *
  523.       NOMID =MOCARA
  524.       IF (MOCARA.NE.0) SEGSUP NOMID
  525. *
  526.  200  CONTINUE
  527.  
  528.       IRET = 1
  529.       IPSCAL = MCHELM
  530.       GOTO 888
  531. *
  532. *     Erreur dans une sous zone / desactivation et retour
  533. *
  534.  9990 CONTINUE
  535. *
  536.       IF (ISUP1.EQ.1) THEN
  537.         CALL DTMVAL(IVASTR,3)
  538.       ELSE
  539.         CALL DTMVAL(IVASTR,1)
  540.       ENDIF
  541. *
  542.       IF (ISUP2.EQ.1) THEN
  543.         CALL DTMVAL(IVACAR,3)
  544.       ELSE
  545.         CALL DTMVAL(IVACAR,1)
  546.       ENDIF
  547. *
  548.       NOMID =MOSTRS
  549.       if(lsupco)SEGSUP NOMID
  550.       NOMID =MOCARA
  551.       IF (MOCARA.NE.0) SEGSUP NOMID
  552. *
  553.       MELVAL=IVAMIS
  554.       IF (IVAMIS.NE.0) SEGSUP MELVAL
  555.       SEGSUP MCHAML
  556. *
  557.  9998 CONTINUE
  558.  9999 CONTINUE
  559. *
  560.       SEGSUP MCHELM
  561.       IPSCAL = 0
  562.       IRET = 0
  563.  
  564.  888  CONTINUE
  565.  
  566.       RETURN
  567.       END
  568.  
  569.  
  570.  

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