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

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