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

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