Télécharger la plaquette Cast3M


fr en

Télécharger sste1.eso

Retour à la liste

Numérotation des lignes : 

sste1

  1. C SSTE1     SOURCE    CB215821  24/04/12    21:17:17     11897          
  2.  
  3. *************************************************************************
  4. *************************************************************************
  5. *************************************************************************
  6.       SUBROUTINE SSTE1 (IPMODL,IPCHE1,IPCHE2,IPCHE4,IPCAR,
  7.      .                    PRECIS,NITMAX,NMAXSSTEPS,NNUMER,DELTAX,
  8.      .                    IPCHE7,IPCHE8,IPCHE9,IPRIGI)
  9. *  entrees:
  10. *  ipmodl = pointeur sur un objet mmodel
  11. *  ipche1 = pointeur sur un mchaml de contraintes initiales
  12. *  ipche2 = pointeur sur un mchaml de variables internes initiales
  13. *  ipche4 = pointeur sur un mchaml d'increment elastique de deformations
  14. *  ipcar  = pointeur sur un mchaml de caracteristiques
  15. *  precis = precision des iterations internes
  16. * sorties:
  17. *  ipche7 = pointeur sur un mchaml de contraintes
  18. *  ipche8 = pointeur sur un mchaml de variables internes
  19. *  ipche9 = pointeur sur un mchaml de deformations
  20. *  iprigi = pointeur sur l'objet de type rigidite
  21. *
  22.       IMPLICIT INTEGER(I-N)
  23.       IMPLICIT REAL*8(A-H,O-Z)
  24. *
  25.  
  26. -INC PPARAM
  27. -INC CCOPTIO
  28. -INC CCGEOME
  29. -INC SMCHAML
  30. -INC SMELEME
  31. -INC SMINTE
  32. -INC SMMODEL
  33. -INC SMRIGID
  34.       SEGMENT NOTYPE
  35.          CHARACTER*16 TYPE(NBTYPE)
  36.       ENDSEGMENT
  37.       SEGMENT MPTVAL
  38.          INTEGER      IPOS(NS)
  39.          INTEGER      NSOF(NS)
  40.          INTEGER      IVAL(NCOSOU)
  41.          CHARACTER*16 TYVAL(NCOSOU)
  42.       ENDSEGMENT
  43.  
  44.       CHARACTER*8 CMATE
  45.       CHARACTER*(NCONCH) CONM
  46.       PARAMETER (NINF=3)
  47.       INTEGER INFOS(NINF)
  48.       LOGICAL lsupde,lsupfo,lsupva,lsupdp,lsupco,lsupma
  49.  
  50.       CALL  QUESUP(IPMODL,IPCHE1,5,0,ISUP1,IRET1)
  51.       IF (ISUP1.GT.1) RETURN
  52.       CALL  QUESUP(IPMODL,IPCHE2,5,0,ISUP2,IRET2)
  53.       IF (ISUP2.GT.1) RETURN
  54.       CALL  QUESUP(IPMODL,IPCHE4,5,0,ISUP4,IRET4)
  55.       IF (ISUP4.GT.1) RETURN
  56.       CALL  QUESUP(IPMODL,IPCAR,3,0,ISUP5,IRET5)
  57.       IF (ISUP5.GT.1) RETURN
  58. c
  59. c Activar el modelo
  60. c
  61.       MMODEL=IPMODL
  62.       SEGACT MMODEL
  63.       NSOUS=MMODEL.KMODEL(/1)
  64. c
  65. c Creation de los 3 mchelms de salida
  66. c
  67.       N1=NSOUS
  68.       L1=11
  69.       N3=6
  70.       SEGINI MCHELM
  71.       MCHELM.TITCHE='CONTRAINTES'
  72.       MCHELM.IFOCHE=IFOUR
  73.       IPCHE7=MCHELM
  74.       L1=18
  75.       SEGINI MCHEL1
  76.       MCHEL1.TITCHE='VARIABLES INTERNES'
  77.       MCHEL1.IFOCHE=IFOUR
  78.       IPCHE8=MCHEL1
  79.       L1=12
  80.       SEGINI MCHEL2
  81.       MCHEL2.TITCHE='DEFORMATIONS'
  82.       MCHEL2.IFOCHE=IFOUR
  83.       IPCHE9=MCHEL2
  84. c
  85. c Creacion del objeto rigidite
  86. c
  87.       NRIGE =7
  88.       NRIGEL=NSOUS
  89.       SEGINI MRIGID
  90.       MRIGID.MTYMAT = 'RIGIDITE'
  91.       MRIGID.ICHOLE=0
  92.       MRIGID.IMGEO1=0
  93.       MRIGID.IMGEO2=0
  94.       MRIGID.IFORIG=IFOUR
  95.       DO ISOUS=1,NSOUS
  96.          MRIGID.COERIG(ISOUS)=1.D0
  97.          MRIGID.IRIGEL(4,ISOUS)=0
  98.       ENDDO
  99.       IPRIGI=MRIGID
  100. c
  101. c     bucle sobre zonas
  102. c
  103.       DO 1000 ISOUS=1,NSOUS
  104.          NSTR=0
  105.          MOSTRS=0
  106.          IVASTR=0
  107.          MOVARI=0
  108.          NVARI=0
  109.          NVARF=0
  110.          IVARI=0
  111.          MOEPSI=0
  112.          NDEF=0
  113.          IVADEF=0
  114.          IVADS=0
  115.          NCARA=0
  116.          NCARF=0
  117.          MOCARA=0
  118.          IVACAR=0
  119.          NMATF=0
  120.          NMATR=0
  121.          MOMATR=0
  122.          IVAMAT=0
  123.          IVASTF=0
  124.          IVARIF=0
  125.          IVADEP=0
  126.          KERRE=0
  127.          KERR1=0
  128.          MCHAML=0
  129.          MCHAM1=0
  130.          MCHAM2=0
  131. c Recuperar la informacion general de la zona
  132. c Activa el modelo de la zona
  133.       IMODEL=KMODEL(ISOUS)
  134.       SEGACT IMODEL
  135.       MELE  =IMODEL.NEFMOD
  136.       MELEME=IMODEL.IMAMOD
  137.       CONM  =IMODEL.CONMOD
  138. c Activa la malla
  139.       SEGACT MELEME
  140.       NBNN  =MELEME.NUM(/1)
  141.       NBELEM=MELEME.NUM(/2)
  142. c Tipo de material
  143.       NFOR  =IMODEL.FORMOD(/2)
  144.       NMAT  =IMODEL.MATMOD(/2)
  145.       CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INPLAS)
  146. ccc
  147. c Controlar que sea uno de los materiales de trabajo
  148.       IF ((INPLAS.lt.111).or.(INPLAS.gt.113)) then
  149.          write(*,*) ' Material no disponible'
  150.       ENDIF
  151. ccc
  152. *  informacion de elementos finitos
  153. *  activa un segmento q se llama luego INFO, q tiene INFELE
  154. *      CALL ELQUOI(MELE,0,5,IPINF,IMODEL)
  155. *      INFO =IPINF
  156. *      MELE =INFO.INFELE(1)
  157. *      NBGS =INFO.INFELE(4)
  158. *      NBG  =INFO.INFELE(6)
  159. *      IPORE=INFO.INFELE(8)
  160. *      LRE  =INFO.INFELE(9)
  161. *      LHOOK=INFO.INFELE(10)
  162. *      MINTE=INFO.INFELE(11)
  163. *      MFR  =INFO.INFELE(13)
  164. *      NDDL =INFO.INFELE(15)
  165. *      NSTRS=INFO.INFELE(16)
  166.       MELE =INFELE(1)
  167.       NBGS =INFELE(4)
  168.       NBG  =INFELE(6)
  169.       IPORE=INFELE(8)
  170.       LRE  =INFELE(9)
  171.       LHOOK=INFELE(10)
  172.       MINTE=INFMOD(7)
  173.       MFR  =INFELE(13)
  174.       NDDL =INFELE(15)
  175.       NSTRS=INFELE(16)
  176. *  Controla que sean elementos masivos
  177.       IF ((MFR.lt.1).or.(MFR.gt.1)) then
  178.          write(*,*) ' Tipo de elemento no disponible'
  179.       ENDIF
  180. * Llena informacion en los 3 campos de salida
  181.       MCHELM.IMACHE(ISOUS)=MELEME
  182.       MCHELM.CONCHE(ISOUS)=CONM
  183.       MCHEL1.IMACHE(ISOUS)=MELEME
  184.       MCHEL1.CONCHE(ISOUS)=CONM
  185.       MCHEL2.IMACHE(ISOUS)=MELEME
  186.       MCHEL2.CONCHE(ISOUS)=CONM
  187.       MCHELM.INFCHE(ISOUS,1)=0
  188.       MCHELM.INFCHE(ISOUS,2)=0
  189.       MCHELM.INFCHE(ISOUS,3)=NIFOUR
  190.       MCHELM.INFCHE(ISOUS,4)=MINTE
  191.       MCHELM.INFCHE(ISOUS,5)=0
  192.       MCHELM.INFCHE(ISOUS,6)=5
  193.       MCHEL1.INFCHE(ISOUS,1)=0
  194.       MCHEL1.INFCHE(ISOUS,2)=0
  195.       MCHEL1.INFCHE(ISOUS,3)=NIFOUR
  196.       MCHEL1.INFCHE(ISOUS,4)=MINTE
  197.       MCHEL1.INFCHE(ISOUS,5)=0
  198.       MCHEL1.INFCHE(ISOUS,6)=5
  199.       MCHEL2.INFCHE(ISOUS,1)=0
  200.       MCHEL2.INFCHE(ISOUS,2)=0
  201.       MCHEL2.INFCHE(ISOUS,3)=NIFOUR
  202.       MCHEL2.INFCHE(ISOUS,4)=MINTE
  203.       MCHEL2.INFCHE(ISOUS,5)=0
  204.       MCHEL2.INFCHE(ISOUS,6)=5
  205. * Llena informacion la rigidite
  206. *  Activa segmento MINTE
  207.       NBNO=NBNN
  208.       SEGACT MINTE
  209.       NBPGAU=MINTE.POIGAU(/1)
  210. *  Inicializa segmento descr, descripcion incognitas matriz rigidite
  211.       NLIGRP=LRE
  212.       NLIGRD=LRE
  213.       SEGINI DESCR
  214.       IPDESCR=DESCR
  215.       if(lnomid(1).ne.0) then
  216.          nomid=lnomid(1)
  217.          segact nomid
  218.          modepl=nomid
  219.          ndepl=lesobl(/2)
  220.          ndum=lesfac(/2)
  221.          lsupdp=.false.
  222.       else
  223.          lsupdp=.true.
  224.          CALL IDPRIM(IMODEL,MFR,MODEPL,NDEPL,NDUM)
  225.       endif
  226.       if(lnomid(2).ne.0) then
  227.         nomid=lnomid(2)
  228.         segact nomid
  229.         moforc=nomid
  230.         nforc=lesobl(/2)
  231.         lsupfo=.false.
  232.         else
  233.           lsupfo=.true.
  234.          CALL IDDUAL(IMODEL,MFR,MOFORC,NFORC,NDUM)
  235.         endif
  236. *  Llena el segmento descr con los nombres de las incognitas
  237.       IDDL=1
  238.       NCOMP=NDEPL
  239.       NBNNS=NBNN
  240.       NOMID=MODEPL
  241.       SEGACT NOMID
  242.       NOMID=MOFORC
  243.       SEGACT NOMID
  244.       DO INOEUD=1,NBNNS
  245.           DO ICOMP=1,NCOMP
  246.                NOMID=MODEPL
  247.                DESCR.LISINC(IDDL)=LESOBL(ICOMP)
  248.                NOMID=MOFORC
  249.                DESCR.LISDUA(IDDL)=LESOBL(ICOMP)
  250.                NOELEP(IDDL)=INOEUD
  251.                NOELED(IDDL)=INOEUD
  252.                IDDL=IDDL+1
  253.           ENDDO
  254.       ENDDO
  255.       NOMID=MODEPL
  256.       if(lsupdp)SEGsup NOMID
  257.       NOMID=MOFORC
  258.       if(lsupfo)SEGsup NOMID
  259. *  Inicializa segmento imatri, chapeau sur les segments
  260. *      contenant les matrices de rigidite elementaires
  261.       NELRIG =NBELEM
  262.       SEGINI xMATRI
  263. *  Trata la rigidite
  264.       MRIGID.IRIGEL(1,ISOUS)=MELEME
  265.       MRIGID.IRIGEL(2,ISOUS)=0
  266.       MRIGID.IRIGEL(3,ISOUS)=IPDESCR
  267.       MRIGID.IRIGEL(4,ISOUS)=xMATRI
  268.       MRIGID.IRIGEL(5,ISOUS)=NIFOUR
  269.       MRIGID.IRIGEL(6,ISOUS)=0
  270. c     no simetricas = 2, simetricas = 0
  271.       IRIGE7=2
  272.       MRIGID.IRIGEL(7,ISOUS)=IRIGE7
  273.       xmatri.symre=irige7
  274. * tratamiento de los 4 campos dados
  275.       NBNO=NBNNE(NUMGEO(MELE))
  276.       CALL IDENT(MELEME,CONM,IPCHE1,IPCHE2,INFOS,IRTD)
  277.       IF (IRTD.EQ.0)THEN
  278.          write(*,*)' no compatibles'
  279.          SEGSUP MCHELM,MCHEL1,MCHEL2
  280. *         INFO=IPINF
  281. *         SEGSUP INFO
  282.          RETURN
  283.       ENDIF
  284.       NBTYPE =1
  285.       SEGINI NOTYPE
  286.       NOTYPE.TYPE(1)='REAL*8'
  287.  
  288. *  contraintes: IVASTR
  289.       if(lnomid(4).ne.0) then
  290.          nomid=lnomid(4)
  291.          segact nomid
  292.          mostrs=nomid
  293.          nstr=lesobl(/2)
  294.          nfac=lesfac(/2)
  295.          lsupco=.false.
  296.       else
  297.          lsupco=.true.
  298.          CALL IDCONT(IMODEL,IFOUR,MOSTRS,NSTR,NFAC)
  299.       endif
  300.       MOTYPE=NOTYPE
  301.       CALL KOMCHA(IPCHE1,MELEME,CONM,MOSTRS,MOTYPE,1,INFOS,3,IVASTR)
  302.       IPMINT=MINTE
  303.       IF (ISUP1.EQ.1) THEN
  304.        ippore=0
  305.        CALL VALCHE(IVASTR,NSTR,IPMINT,ippore,MOSTRS,MELE)
  306.        SEGSUP NOTYPE
  307.        goto 888
  308.       ENDIF
  309. *  variables internes: IVARI
  310.       if(lnomid(10).ne.0) then
  311.          nomid=lnomid(10)
  312.          segact nomid
  313.          movari=nomid
  314.          nvari=lesobl(/2)
  315.          nvarf=lesfac(/2)
  316.          lsupva=.false.
  317.       else
  318.          lsupva=.true.
  319.         CALL IDVARI(MFR,IMODEL,MOVARI,NVARI,NVARF)
  320.       endif
  321.       MOTYVA=NOTYPE
  322.       CALL KOMCHA(IPCHE2,MELEME,CONM,MOVARI,MOTYVA,1,INFOS,3,IVARI)
  323.       NVART=NVARI+NVARF
  324.       IF (ISUP2.EQ.1) THEN
  325.        ippore=0
  326.        CALL VALCHE(IVARI,NVART,IPMINT,ippore,MOVARI,IELE)
  327.        SEGSUP NOTYPE
  328.        goto 888
  329.       ENDIF
  330. *  increments de deformations: IVADS
  331.       if(lnomid(5).ne.0) then
  332.         nomid=lnomid(5)
  333.         segact nomid
  334.         ndef=lesobl(/2)
  335.         nfac=lesfac(/2)
  336.         moepsi=nomid
  337.         lsupde=.false.
  338.       else
  339.         lsupde=.true.
  340.         CALL IDDEFO(IMODEL,IFOUR,MOEPSI,NDEF,NFAC)
  341.       endif
  342.       CALL KOMCHA(IPCHE4,MELEME,CONM,MOEPSI,MOTYPE,1,INFOS,3,IVADS)
  343.       IF (ISUP4.EQ.1) THEN
  344.        ippore=0
  345.        CALL VALCHE(IVADS,NDEF,IPMINT,ippore,MOEPSI,MELE)
  346.        SEGSUP NOTYPE
  347.        goto 888
  348.       ENDIF
  349. *  caracteristiques materielles: IVAMAT
  350.       if(lnomid(6).ne.0) then
  351.          nomid=lnomid(6)
  352.          segact nomid
  353.          momatr=nomid
  354.          nmatr=lesobl(/2)
  355.          nmatf=lesfac(/2)
  356.          lsupma=.false.
  357.       else
  358.          lsupma=.true.
  359.          CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF)
  360.       endif
  361.       CALL KOMCHA(IPCAR,MELEME,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAT)
  362.       SEGSUP NOTYPE
  363.       NMATT=NMATR+NMATF
  364.       IF (ISUP5.EQ.1) THEN
  365.        ippore=0
  366.        CALL VALCHE(IVAMAT,NMATT,IPMINT,ippore,MOMATR,MELE)
  367.        goto 888
  368.       ENDIF
  369. * Creacion de los mchamls de las zonas
  370.       NBPTEL=NBGS
  371.       NEL   =NBELEM
  372.       N1PTEL=NBPTEL
  373.       N1EL  =NEL
  374. *  contraintes
  375.       N2    =NSTRS
  376.       SEGINI MCHAML
  377.       MCHELM.ICHAML(ISOUS)=MCHAML
  378.       mchelm.conche(isous) = conmod
  379.       NS    =1
  380.       NCOSOU=NSTRS
  381.       SEGINI MPTVAL
  382.       IVASTF=MPTVAL
  383.       NOMID =MOSTRS
  384.       SEGACT NOMID
  385.       DO ICOMP=1,NSTRS
  386.          MCHAML.NOMCHE(ICOMP)=NOMID.LESOBL(ICOMP)
  387.          MCHAML.TYPCHE(ICOMP)='REAL*8'
  388.          N2PTEL=0
  389.          N2EL=0
  390.          SEGINI MELVAL
  391.          MCHAML.IELVAL(ICOMP)=MELVAL
  392.          IVAL(ICOMP)=MELVAL
  393.       enddo
  394. *  variables internes
  395.       N2    =NVART
  396.       SEGINI MCHAM1
  397.       MCHEL1.ICHAML(ISOUS)=MCHAM1
  398.       mchel1.conche(isous) = conmod
  399.       NS    =1
  400.       NCOSOU=NVART
  401.       SEGINI MPTVAL
  402.       IVARIF=MPTVAL
  403.       NOMID=MOVARI
  404.       SEGACT NOMID
  405.       DO ICOMP=1,NVARI
  406.          MCHAM1.NOMCHE(ICOMP)=LESOBL(ICOMP)
  407.          MCHAM1.TYPCHE(ICOMP)='REAL*8'
  408.          N2PTEL=0
  409.          N2EL=0
  410.          SEGINI MELVAL
  411.          MCHAM1.IELVAL(ICOMP)=MELVAL
  412.          IVAL(ICOMP)=MELVAL
  413.       enddo
  414.       DO ICOMP=NVARI+1,NVART
  415.          MCHAM1.NOMCHE(ICOMP)=LESFAC(ICOMP)
  416.          MCHAM1.TYPCHE(ICOMP)='REAL*8'
  417.          N2PTEL=0
  418.          N2EL=0
  419.          SEGINI MELVAL
  420.          MCHAM1.IELVAL(ICOMP)=MELVAL
  421.          IVAL(ICOMP)=MELVAL
  422.       enddo
  423.       N1PTEL=NBPTEL
  424.       N1EL=NEL
  425.       N2=NDEF
  426.       SEGINI MCHAM2
  427.       MCHEL2.ICHAML(ISOUS)=MCHAM2
  428.       mchel2.conche(isous) = conmod
  429.       NS=1
  430.       NCOSOU=NDEF
  431.       SEGINI MPTVAL
  432.       IVADEP=MPTVAL
  433.       NOMID=MOEPSI
  434.       SEGACT NOMID
  435.       DO ICOMP=1,NDEF
  436.          MCHAM2.NOMCHE(ICOMP)=LESOBL(ICOMP)
  437.          MCHAM2.TYPCHE(ICOMP)='REAL*8'
  438.          N2PTEL=0
  439.          N2EL=0
  440.          SEGINI MELVAL
  441.          MCHAM2.IELVAL(ICOMP)=MELVAL
  442.          IVAL(ICOMP)=MELVAL
  443.       enddo
  444.       CALL SSTE2(MATE,INPLAS,MELE,MELEME,MINTE,xMATRI,
  445.      .     NBELEM,NBPTEL,NBNN,LRE,MFR,
  446.      .     IVASTR,IVARI,IVADS,IVAMAT,NSTRS,NVARI,NMATT,
  447.      .     IVASTF,IVARIF,IVADEP,LHOOK,IRIGE7,
  448.      .     PRECIS,NITMAX,NMAXSSTEPS,NNUMER,DELTAX,KERRE)
  449.  
  450. * Desactivar segmentos
  451.          IF(ISUP1.EQ.1)THEN
  452.             CALL DTMVAL (IVASTR,3)
  453.          ELSE
  454.             CALL DTMVAL (IVASTR,1)
  455.          ENDIF
  456.          IF(ISUP2.EQ.1)THEN
  457.             CALL DTMVAL (IVARI,3)
  458.          ELSE
  459.             CALL DTMVAL (IVARI,1)
  460.          ENDIF
  461.          IF(ISUP4.EQ.1)THEN
  462.             CALL DTMVAL (IVADS,3)
  463.          ELSE
  464.             CALL DTMVAL (IVADS,1)
  465.          ENDIF
  466.          IF(ISUP5.EQ.1)THEN
  467.             CALL DTMVAL (IVAMAT,3)
  468.          ELSE
  469.             CALL DTMVAL (IVAMAT,1)
  470.          ENDIF
  471.          IF (KERRE.EQ.0) THEN
  472.             CALL DTMVAL (IVASTF,1)
  473.             CALL DTMVAL (IVARIF,1)
  474.             CALL DTMVAL (IVADEP,1)
  475.          ELSE
  476.             CALL DTMVAL (IVASTF,3)
  477.             CALL DTMVAL (IVARIF,3)
  478.             CALL DTMVAL (IVADEP,3)
  479.             SEGSUP MCHAML,MCHAM1,MCHAM2,MINTE
  480.             GO TO 888
  481.          END IF
  482.          IF (MOSTRS.NE.0) THEN
  483.             NOMID=MOSTRS
  484.             if(lsupco)SEGSUP NOMID
  485.          END IF
  486.          IF (lsupva.and.MOVARI.NE.0) THEN
  487.             NOMID=MOVARI
  488.             SEGSUP NOMID
  489.          END IF
  490.          IF (lsupde.and.MOEPSI.NE.0) THEN
  491.             NOMID=MOEPSI
  492.             SEGSUP NOMID
  493.          END IF
  494.          IF (MOMATR.NE.0) THEN
  495.             NOMID=MOMATR
  496.             if(lsupma)SEGSUP NOMID
  497.          END IF
  498. *         IF (IPINF .NE.0) THEN
  499. *            INFO=IPINF
  500. *            SEGSUP INFO
  501. *         END IF
  502. 1000  continue
  503.  888  CONTINUE
  504.       IF(KERRE.NE.0)THEN
  505.          SEGSUP MCHELM,MCHEL1,MCHEL2,MRIGID,xMATRI,DESCR
  506.       ENDIF
  507.       RETURN
  508.       END
  509.  
  510.  
  511.  

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