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

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