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

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