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

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