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    PV090527  25/01/07    14:43:01     12115          
  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. -INC PPARAM
  26. -INC CCOPTIO
  27. -INC CCGEOME
  28. -INC SMCOORD
  29.  
  30. -INC SMCHAML
  31. -INC SMELEME
  32. -INC SMINTE
  33. -INC SMMODEL
  34. -INC SMRIGID
  35.       SEGMENT NOTYPE
  36.          CHARACTER*16 TYPE(NBTYPE)
  37.       ENDSEGMENT
  38.       SEGMENT MPTVAL
  39.          INTEGER      IPOS(NS)
  40.          INTEGER      NSOF(NS)
  41.          INTEGER      IVAL(NCOSOU)
  42.          CHARACTER*16 TYVAL(NCOSOU)
  43.       ENDSEGMENT
  44.  
  45.       CHARACTER*8 CMATE
  46.       CHARACTER*(NCONCH) CONM
  47.       PARAMETER (NINF=3)
  48.       INTEGER INFOS(NINF)
  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.  
  59.       NBTYPE = 1
  60.       SEGINI,notype
  61.       notype.TYPE(1) = 'REAL*8  '
  62.       MOTYR8 = notype
  63. c
  64. c Activar el modelo
  65. c
  66.       MMODEL=IPMODL
  67.       NSOUS=MMODEL.KMODEL(/1)
  68. c
  69. c Creation de los 3 mchelms de salida
  70. c
  71.       N1=NSOUS
  72.       L1=11
  73.       N3=6
  74.       SEGINI MCHELM
  75.       MCHELM.TITCHE='CONTRAINTES'
  76.       MCHELM.IFOCHE=IFOUR
  77.       IPCHE7=MCHELM
  78.       L1=18
  79.       SEGINI MCHEL1
  80.       MCHEL1.TITCHE='VARIABLES INTERNES'
  81.       MCHEL1.IFOCHE=IFOUR
  82.       IPCHE8=MCHEL1
  83.       L1=12
  84.       SEGINI MCHEL2
  85.       MCHEL2.TITCHE='DEFORMATIONS'
  86.       MCHEL2.IFOCHE=IFOUR
  87.       IPCHE9=MCHEL2
  88. c
  89. c Creacion del objeto rigidite
  90. c
  91.       NRIGEL=NSOUS
  92.       SEGINI MRIGID
  93.       MRIGID.MTYMAT = 'RIGIDITE'
  94.       MRIGID.ICHOLE=0
  95.       MRIGID.IMGEO1=0
  96.       MRIGID.IMGEO2=0
  97.       MRIGID.IFORIG=IFOUR
  98.       DO ISOUS=1,NSOUS
  99.          MRIGID.COERIG(ISOUS)=1.D0
  100.          MRIGID.IRIGEL(4,ISOUS)=0
  101.       ENDDO
  102.       IPRIGI=MRIGID
  103. c
  104. c     bucle sobre zonas
  105. c
  106.       DO 1000 ISOUS=1,NSOUS
  107.          NSTR=0
  108.          MOSTRS=0
  109.          IVASTR=0
  110.          MOVARI=0
  111.          NVARI=0
  112.          NVARF=0
  113.          IVARI=0
  114.          MOEPSI=0
  115.          NDEF=0
  116.          IVADEF=0
  117.          IVADS=0
  118.          NCARA=0
  119.          NCARF=0
  120.          MOCARA=0
  121.          IVACAR=0
  122.          NMATF=0
  123.          NMATR=0
  124.          MOMATR=0
  125.          IVAMAT=0
  126.          IVASTF=0
  127.          IVARIF=0
  128.          IVADEP=0
  129.          KERRE=0
  130.          KERR1=0
  131.          MCHAML=0
  132.          MCHAM1=0
  133.          MCHAM2=0
  134. c Recuperar la informacion general de la zona
  135. c Activa el modelo de la zona
  136.         IMODEL=KMODEL(ISOUS)
  137.         MELE  =IMODEL.NEFMOD
  138.         CONM  =IMODEL.CONMOD
  139. c Activa la malla
  140.         MELEME=IMODEL.IMAMOD
  141.         NBNN  =MELEME.NUM(/1)
  142.         NBELEM=MELEME.NUM(/2)
  143. c Tipo de material
  144.         CMATE  = imodel.CMATEE
  145.         MATE   = imodel.IMATEE
  146.         INPLAS = imodel.INATUU
  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.       MELE =INFELE(1)
  155.       NBGS =INFELE(4)
  156.       NBG  =INFELE(6)
  157.       IPORE=INFELE(8)
  158.       LRE  =INFELE(9)
  159.       LHOOK=INFELE(10)
  160.       MINTE=INFMOD(7)
  161.       MFR  =INFELE(13)
  162.       NDDL =INFELE(15)
  163.       NSTRS=INFELE(16)
  164.         ippore=0
  165. *  Controla que sean elementos masivos
  166.       IF ((MFR.lt.1).or.(MFR.gt.1)) then
  167.          write(*,*) ' Tipo de elemento no disponible'
  168.       ENDIF
  169. * Llena informacion en los 3 campos de salida
  170.       MCHELM.IMACHE(ISOUS)=MELEME
  171.       MCHELM.CONCHE(ISOUS)=CONM
  172.       MCHEL1.IMACHE(ISOUS)=MELEME
  173.       MCHEL1.CONCHE(ISOUS)=CONM
  174.       MCHEL2.IMACHE(ISOUS)=MELEME
  175.       MCHEL2.CONCHE(ISOUS)=CONM
  176.       MCHELM.INFCHE(ISOUS,1)=0
  177.       MCHELM.INFCHE(ISOUS,2)=0
  178.       MCHELM.INFCHE(ISOUS,3)=NIFOUR
  179.       MCHELM.INFCHE(ISOUS,4)=MINTE
  180.       MCHELM.INFCHE(ISOUS,5)=0
  181.       MCHELM.INFCHE(ISOUS,6)=5
  182.       MCHEL1.INFCHE(ISOUS,1)=0
  183.       MCHEL1.INFCHE(ISOUS,2)=0
  184.       MCHEL1.INFCHE(ISOUS,3)=NIFOUR
  185.       MCHEL1.INFCHE(ISOUS,4)=MINTE
  186.       MCHEL1.INFCHE(ISOUS,5)=0
  187.       MCHEL1.INFCHE(ISOUS,6)=5
  188.       MCHEL2.INFCHE(ISOUS,1)=0
  189.       MCHEL2.INFCHE(ISOUS,2)=0
  190.       MCHEL2.INFCHE(ISOUS,3)=NIFOUR
  191.       MCHEL2.INFCHE(ISOUS,4)=MINTE
  192.       MCHEL2.INFCHE(ISOUS,5)=0
  193.       MCHEL2.INFCHE(ISOUS,6)=5
  194. * Llena informacion la rigidite
  195. *  Activa segmento MINTE
  196.       NBNO=NBNN
  197.       NBPGAU=MINTE.POIGAU(/1)
  198.       IPMINT=MINTE
  199. *  Inicializa segmento descr, descripcion incognitas matriz rigidite
  200.       NLIGRP=LRE
  201.       NLIGRD=LRE
  202.       SEGINI DESCR
  203.       IPDESCR=DESCR
  204.  
  205.         nomid=lnomid(1)
  206.         if (nomid.eq.0) then
  207.           write(ioimp,*) 'LNOMID(1)=0'
  208.           call erreur(5)
  209.         endif
  210.         modepl=nomid
  211.         ndepl=lesobl(/2)
  212.         ndum=lesfac(/2)
  213.  
  214.         nomid=lnomid(2)
  215.         if (nomid.eq.0) then
  216.           write(ioimp,*) 'LNOMID(2)=0'
  217.           call erreur(5)
  218.         endif
  219.         moforc=nomid
  220.         nforc=lesobl(/2)
  221.         ndum=lesfac(/2)
  222.  
  223. *  Llena el segmento descr con los nombres de las incognitas
  224.       IDDL=1
  225.       NCOMP=NDEPL
  226.       NBNNS=NBNN
  227.       DO INOEUD=1,NBNNS
  228.           DO ICOMP=1,NCOMP
  229.                NOMID=MODEPL
  230.                DESCR.LISINC(IDDL)=LESOBL(ICOMP)
  231.                NOMID=MOFORC
  232.                DESCR.LISDUA(IDDL)=LESOBL(ICOMP)
  233.                NOELEP(IDDL)=INOEUD
  234.                NOELED(IDDL)=INOEUD
  235.                IDDL=IDDL+1
  236.           ENDDO
  237.       ENDDO
  238. *  Inicializa segmento imatri, chapeau sur les segments
  239. *      contenant les matrices de rigidite elementaires
  240.       NELRIG =NBELEM
  241.       SEGINI xMATRI
  242. *  Trata la rigidite
  243.       MRIGID.IRIGEL(1,ISOUS)=MELEME
  244.       MRIGID.IRIGEL(2,ISOUS)=0
  245.       MRIGID.IRIGEL(3,ISOUS)=IPDESCR
  246.       MRIGID.IRIGEL(4,ISOUS)=xMATRI
  247.       MRIGID.IRIGEL(5,ISOUS)=NIFOUR
  248.       MRIGID.IRIGEL(6,ISOUS)=0
  249. c     no simetricas = 2, simetricas = 0
  250.       IRIGE7=2
  251.       MRIGID.IRIGEL(7,ISOUS)=IRIGE7
  252.       xmatri.symre=irige7
  253. * tratamiento de los 4 campos dados
  254.       NBNO=NBNNE(NUMGEO(MELE))
  255.       CALL IDENT(MELEME,CONM,IPCHE1,IPCHE2,INFOS,IRTD)
  256.       IF (IRTD.EQ.0)THEN
  257.          write(*,*)' no compatibles'
  258.          RETURN
  259.       ENDIF
  260.  
  261. *  contraintes: IVASTR
  262.         nomid=lnomid(4)
  263.         if (nomid.eq.0) then
  264.           write(ioimp,*) 'LNOMID(4)=0'
  265.           call erreur(5)
  266.         endif
  267.         mostrs=nomid
  268.         nstr=lesobl(/2)
  269.         nfac=lesfac(/2)
  270.       CALL KOMCHA(IPCHE1,MELEME,CONM,MOSTRS,MOTYR8,1,INFOS,3,IVASTR)
  271.       IF (ISUP1.EQ.1) THEN
  272.        CALL VALCHE(IVASTR,NSTR,IPMINT,ippore,MOSTRS,MELE)
  273.        goto 888
  274.       ENDIF
  275. *  variables internes: IVARI
  276.         nomid=lnomid(10)
  277.         if (nomid.eq.0) then
  278.           write(ioimp,*) 'LNOMID(10)=0'
  279.           call erreur(5)
  280.         endif
  281.         movari=nomid
  282.         nvari=lesobl(/2)
  283.         nvarf=lesfac(/2)
  284.       NVART=NVARI+NVARF
  285.       CALL KOMCHA(IPCHE2,MELEME,CONM,MOVARI,MOTYR8,1,INFOS,3,IVARI)
  286.       IF (ISUP2.EQ.1) THEN
  287.        CALL VALCHE(IVARI,NVART,IPMINT,ippore,MOVARI,IELE)
  288.        goto 888
  289.       ENDIF
  290. *  increments de deformations: IVADS
  291.         nomid=lnomid(5)
  292.         if (nomid.eq.0) then
  293.           write(ioimp,*) 'LNOMID(5)=0'
  294.           call erreur(5)
  295.         endif
  296.         moepsi=nomid
  297.         ndef=lesobl(/2)
  298.         nfac=lesfac(/2)
  299.  
  300.       CALL KOMCHA(IPCHE4,MELEME,CONM,MOEPSI,MOTYR8,1,INFOS,3,IVADS)
  301.       IF (ISUP4.EQ.1) THEN
  302.        CALL VALCHE(IVADS,NDEF,IPMINT,ippore,MOEPSI,MELE)
  303.        goto 888
  304.       ENDIF
  305.  
  306. *  caracteristiques materielles: IVAMAT
  307.         nomid=lnomid(6)
  308.         if (nomid.eq.0) then
  309.           write(ioimp,*) 'LNOMID(6)=0'
  310.           call erreur(5)
  311.         endif
  312.         momatr=nomid
  313.         nmatr=lesobl(/2)
  314.         nmatf=lesfac(/2)
  315.       NMATT=NMATR+NMATF
  316.       CALL KOMCHA(IPCAR,MELEME,CONM,MOMATR,MOTYR8,1,INFOS,3,IVAMAT)
  317.       IF (ISUP5.EQ.1) THEN
  318.        CALL VALCHE(IVAMAT,NMATT,IPMINT,ippore,MOMATR,MELE)
  319.        goto 888
  320.       ENDIF
  321. * Creacion de los mchamls de las zonas
  322.       NBPTEL=NBGS
  323.       NEL   =NBELEM
  324.       N1PTEL=NBPTEL
  325.       N1EL  =NEL
  326. *  contraintes
  327.       N2    =NSTRS
  328.       SEGINI MCHAML
  329.       MCHELM.ICHAML(ISOUS)=MCHAML
  330.       mchelm.conche(isous) = conmod
  331.       NS    =1
  332.       NCOSOU=NSTRS
  333.       SEGINI MPTVAL
  334.       IVASTF=MPTVAL
  335.       NOMID =MOSTRS
  336.       DO ICOMP=1,NSTRS
  337.          MCHAML.NOMCHE(ICOMP)=NOMID.LESOBL(ICOMP)
  338.          MCHAML.TYPCHE(ICOMP)='REAL*8'
  339.          N2PTEL=0
  340.          N2EL=0
  341.          SEGINI MELVAL
  342.          MCHAML.IELVAL(ICOMP)=MELVAL
  343.          IVAL(ICOMP)=MELVAL
  344.       enddo
  345. *  variables internes
  346.       N2    =NVART
  347.       SEGINI MCHAM1
  348.       MCHEL1.ICHAML(ISOUS)=MCHAM1
  349.       mchel1.conche(isous) = conmod
  350.       NS    =1
  351.       NCOSOU=NVART
  352.       SEGINI MPTVAL
  353.       IVARIF=MPTVAL
  354.       NOMID=MOVARI
  355.       DO ICOMP=1,NVARI
  356.          MCHAM1.NOMCHE(ICOMP)=LESOBL(ICOMP)
  357.          MCHAM1.TYPCHE(ICOMP)='REAL*8'
  358.          N2PTEL=0
  359.          N2EL=0
  360.          SEGINI MELVAL
  361.          MCHAM1.IELVAL(ICOMP)=MELVAL
  362.          IVAL(ICOMP)=MELVAL
  363.       enddo
  364.       DO ICOMP=NVARI+1,NVART
  365.          MCHAM1.NOMCHE(ICOMP)=LESFAC(ICOMP-NVARI)
  366.          MCHAM1.TYPCHE(ICOMP)='REAL*8'
  367.          N2PTEL=0
  368.          N2EL=0
  369.          SEGINI MELVAL
  370.          MCHAM1.IELVAL(ICOMP)=MELVAL
  371.          IVAL(ICOMP)=MELVAL
  372.       enddo
  373.       N1PTEL=NBPTEL
  374.       N1EL=NEL
  375.       N2=NDEF
  376.       SEGINI MCHAM2
  377.       MCHEL2.ICHAML(ISOUS)=MCHAM2
  378.       mchel2.conche(isous) = conmod
  379.       NS=1
  380.       NCOSOU=NDEF
  381.       SEGINI MPTVAL
  382.       IVADEP=MPTVAL
  383.       NOMID=MOEPSI
  384.       DO ICOMP=1,NDEF
  385.          MCHAM2.NOMCHE(ICOMP)=LESOBL(ICOMP)
  386.          MCHAM2.TYPCHE(ICOMP)='REAL*8'
  387.          N2PTEL=0
  388.          N2EL=0
  389.          SEGINI MELVAL
  390.          MCHAM2.IELVAL(ICOMP)=MELVAL
  391.          IVAL(ICOMP)=MELVAL
  392.       enddo
  393.  
  394.       CALL SSTE2(MATE,INPLAS,MELE,MELEME,MINTE,xMATRI,
  395.      .     NBELEM,NBPTEL,NBNN,LRE,MFR,
  396.      .     IVASTR,IVARI,IVADS,IVAMAT,NSTRS,NVARI,NMATT,
  397.      .     IVASTF,IVARIF,IVADEP,LHOOK,IRIGE7,
  398.      .     PRECIS,NITMAX,NMAXSSTEPS,NNUMER,DELTAX,KERRE)
  399.  
  400. * Desactivar segmentos
  401.          IF(ISUP1.EQ.1)THEN
  402.             CALL DTMVAL (IVASTR,3)
  403.          ELSE
  404.             CALL DTMVAL (IVASTR,1)
  405.          ENDIF
  406.          IF(ISUP2.EQ.1)THEN
  407.             CALL DTMVAL (IVARI,3)
  408.          ELSE
  409.             CALL DTMVAL (IVARI,1)
  410.          ENDIF
  411.          IF(ISUP4.EQ.1)THEN
  412.             CALL DTMVAL (IVADS,3)
  413.          ELSE
  414.             CALL DTMVAL (IVADS,1)
  415.          ENDIF
  416.          IF(ISUP5.EQ.1)THEN
  417.             CALL DTMVAL (IVAMAT,3)
  418.          ELSE
  419.             CALL DTMVAL (IVAMAT,1)
  420.          ENDIF
  421.          IF (KERRE.EQ.0) THEN
  422.             CALL DTMVAL (IVASTF,1)
  423.             CALL DTMVAL (IVARIF,1)
  424.             CALL DTMVAL (IVADEP,1)
  425.          ELSE
  426.             CALL DTMVAL (IVASTF,3)
  427.             CALL DTMVAL (IVARIF,3)
  428.             CALL DTMVAL (IVADEP,3)
  429.             SEGSUP MCHAML,MCHAM1,MCHAM2
  430.             GO TO 888
  431.          END IF
  432. 1000  continue
  433.  
  434.  888  CONTINUE
  435.       IF(KERRE.NE.0)THEN
  436.          SEGSUP MCHELM,MCHEL1,MCHEL2,MRIGID,xMATRI,DESCR
  437.       ENDIF
  438.  
  439.       notype = MOTYR8
  440.       SEGSUP,notype
  441.  
  442.       RETURN
  443.       END
  444.  
  445.  
  446.  
  447.  

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