Télécharger la plaquette Cast3M


fr en

Télécharger fcoul1.eso

Retour à la liste

Numérotation des lignes : 

fcoul1

  1. C FCOUL1    SOURCE    CB215821  24/04/12    21:15:55     11897          
  2.       SUBROUTINE FCOUL1(DEPSI,IPMODL,IPCHE1,IPCHE2,IPCAR,TIME0,TIMEF,
  3.      &                  SIGMA,IPCHE7,IPCHE8,IRETO,NSTRS2)
  4. **********************************************************************
  5. *
  6. *     ECOULEMENT INELASTIQUE POUR LES MODELE A SECTION
  7. *     Boucle sur les ss-zone du modele de section
  8. *
  9. **********************************************************************
  10. *     Pierre Pegon (ISPRA) Juillet/Aout 1993
  11. **********************************************************************
  12. *
  13. *  ENTREES:
  14. *
  15. *  DEPSI(6) INCREMENT DE DEFORMATION POUR LA FIBRE CENTRALE
  16. *  IPMODL = POINTEUR SUR UN OBJET MMODEL
  17. *  IPCHE1 = POINTEUR SUR UN MCHAML DE CONTRAINTES INITIALES
  18. *  IPCHE2 = POINTEUR SUR UN MCHAML DE VARIABLES INTERNES INITIALES
  19. *  IPCAR  = POINTEUR SUR UN MCHAML DE CARACTERISTIQUES
  20. *  TIME0  = INSTANT INITIAL
  21. *  TIMEF  = INSTANT FINAL
  22. *
  23. * SORTIES:
  24. *
  25. *  SIGMA(6) ELEMENT DE REDUCTION DES EFFORT POUR LA FIBRE CENTRALE
  26. *  IPCHE7 = POINTEUR SUR UN MCHAML DE CONTRAINTES
  27. *  IPCHE8 = POINTEUR SUR UN MCHAML DE VARIABLES INTERNES
  28. *
  29. ************************************************************************
  30.       IMPLICIT INTEGER(I-N)
  31.       IMPLICIT REAL*8(A-H,O-Z)
  32. *
  33.  
  34. -INC PPARAM
  35. -INC CCOPTIO
  36. -INC SMCHAML
  37. -INC SMELEME
  38. -INC SMCOORD
  39. -INC SMMODEL
  40. -INC SMINTE
  41. -INC CCHAMP
  42. C
  43.       DIMENSION DEPSI(NSTRS2),SIGMA(NSTRS2)
  44.  
  45.       SEGMENT NOTYPE
  46.         CHARACTER*16 TYPE(NBTYPE)
  47.       ENDSEGMENT
  48. *
  49.       SEGMENT MPTVAL
  50.         INTEGER IPOS(NS)    ,NSOF(NS)
  51.         INTEGER      IVAL(NCOSOU)
  52.         CHARACTER*16 TYVAL(NCOSOU)
  53.       ENDSEGMENT
  54. *
  55.       CHARACTER*8 CMATE
  56.       CHARACTER*(NCONCH) CONM
  57.       CHARACTER*16 MOMODL(10)
  58.       PARAMETER ( NINF=3 )
  59.       INTEGER INFOS(NINF)
  60.       LOGICAL lsupva,lsupco,lsupma,lsupca
  61.          lsupva=.false.
  62.          lsupco=.false.
  63.          lsupma=.false.
  64.          lsupca=.false.
  65. C
  66.       IRETO=0
  67.       NHRM=NIFOUR
  68. C
  69. C     VERIFICATION DU LIEU SUPPORT DU MCHAML DE CONTRAINTES
  70. C
  71.       CALL  QUESUP(IPMODL,IPCHE1,5,0,ISUP1,IRET1)
  72.       IF (ISUP1.GT.1) RETURN
  73. *
  74. *     VERIFICATION DU LIEU SUPPORT DU MCHAML DE VARIABLES INTERNES
  75. *
  76.       CALL  QUESUP(IPMODL,IPCHE2,5,0,ISUP2,IRET2)
  77.       IF (ISUP2.GT.1) RETURN
  78. C
  79. C     VERIFICATION DU LIEU SUPPORT DU MCHAML DE CARACTERISTIQUES
  80. C
  81.       CALL  QUESUP(IPMODL,IPCAR,5,0,ISUP5,IRET5)
  82.       IF (ISUP5.GT.1) RETURN
  83. C
  84. C     ACTIVATION DU MODELE
  85. C
  86.       MMODEL=IPMODL
  87.       SEGACT MMODEL
  88.       NSOUS=KMODEL(/1)
  89. C
  90. C     CREATION DES 2 MCHELMS
  91. C
  92.       N1=NSOUS
  93.       L1=11
  94.       N3=6
  95.       SEGINI MCHELM
  96.       TITCHE='CONTRAINTES'
  97.       IFOCHE=IFOUR
  98.       IPCHE7=MCHELM
  99.       L1=18
  100.       SEGINI MCHEL1
  101.       MCHEL1.TITCHE='VARIABLES INTERNES'
  102.       MCHEL1.IFOCHE=IFOUR
  103.       IPCHE8=MCHEL1
  104. C
  105. C     MISE A ZERO DES CONTRAINTES
  106. C
  107.       DO IE1=1,NSTRS2
  108.         SIGMA(IE1)=0.D0
  109.       ENDDO
  110. C____________________________________________________________________
  111. C
  112. C     DEBUT DE LA BOUCLE SUR LES DIFFERENTES ZONES
  113. C____________________________________________________________________
  114. C
  115. *-DC-
  116.       EPSUP=-1.0D10
  117.       EPINF= 1.0D10
  118. *
  119.       DAMAG= 0.0D0
  120.       ETIQE= 0.0D0
  121. *-DC-
  122.  
  123.       DO 1000 ISOUS=1,NSOUS
  124. *
  125. *   INITIALISATION
  126. *
  127.          NSTR=0
  128.          MOSTRS=0
  129.          IVASTR=0
  130.          MOVARI=0
  131.          NVARI=0
  132.          NVARF=0
  133.          IVARI=0
  134.          NMATF=0
  135.          NMATR=0
  136.          MOMATR=0
  137.          IVAMAT=0
  138.          NCARA=0
  139.          NCARF=0
  140.          MOCARA=0
  141.          IVACAR=0
  142.          IVASTF=0
  143.          IVARIF=0
  144. C
  145. C     ON RECUPERE L INFORMATION GENERALE
  146. C
  147.          IMODEL=KMODEL(ISOUS)
  148.          SEGACT IMODEL
  149.          IPMAIL=IMAMOD
  150.          CONM  =CONMOD
  151.          IMACHE(ISOUS)=IPMAIL
  152.          CONCHE(ISOUS)=CONMOD
  153.          MCHEL1.IMACHE(ISOUS)=IPMAIL
  154.          MCHEL1.CONCHE(ISOUS)=CONMOD
  155. *
  156.          MELE=NEFMOD
  157.          MELEME=IMAMOD
  158.          SEGACT MELEME
  159.          NBNN=NUM(/1)
  160.          NBELEM=NUM(/2)
  161. C+PPf
  162. C     ON EVACUE LE CAS DU SEGS EN 3D
  163.          IF(MELE.EQ.166.AND.IDIM.EQ.3)THEN
  164.             CALL ERREUR(832)
  165.             GOTO 888
  166.          ENDIF
  167. C+PPf
  168. C
  169. C     TRAITEMENT DU MODELE
  170. C
  171.          NFOR=FORMOD(/2)
  172.          NMAT=MATMOD(/2)
  173. C
  174. C     NATURE DU MATERIAU
  175. C
  176.          CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INFIBR)
  177.          IF (CMATE.EQ.' ')THEN
  178.             CALL ERREUR(251)
  179.             GOTO 888
  180.          ENDIF
  181.          IF(MATE.NE.1)THEN
  182.             CALL ERREUR(635)
  183.             GOTO 888
  184.          ENDIF
  185.          CALL TEMANF(INFIBR,NIFIBR)
  186.          IF((NIFIBR.EQ.0).AND.(INFIBR.NE.0))THEN
  187.             CALL ERREUR(636)
  188.             GOTO 888
  189.          ENDIF
  190.          INFIBR=NIFIBR
  191. *
  192. C____________________________________________________________________
  193. C
  194. C     INFORMATION SUR L'ELEMENT FINI
  195. C____________________________________________________________________
  196. C
  197. *         CALL ELQUOI(MELE,0,5,IPINF,IMODEL)
  198. *         IF (IERR.NE.0) THEN
  199. *            GOTO 888
  200. *         ENDIF
  201. *         INFO=IPINF
  202.          MFR  =INFELE(13)
  203.          IPPORE=0
  204.          IF(MFR.EQ.33) IPPORE=NBNN
  205.          IF (MFR.NE.47)THEN
  206.             CALL ERREUR(637)
  207.             SEGSUP MCHELM,MCHEL1
  208.             RETURN
  209.          ENDIF
  210.          NBG  =INFELE(6)
  211.          NBGS =INFELE(4)
  212.          NSTRS=INFELE(16)
  213.          LRE  =INFELE(9)
  214.          LHOOK=INFELE(10)
  215.          LHOO2=LHOOK*LHOOK
  216. *         MINTE=INFELE(11)
  217.          MINTE=infmod(7)
  218.         IPMINT=MINTE
  219.         SEGACT,MINTE
  220. *
  221. *   REMPLISSAGE DES TABLEAUX INFCHE
  222. *
  223.          INFCHE(ISOUS,1)=0
  224.          INFCHE(ISOUS,2)=0
  225.          INFCHE(ISOUS,3)=NHRM
  226.          INFCHE(ISOUS,4)=IPMINT
  227.          INFCHE(ISOUS,5)=0
  228.          INFCHE(ISOUS,6)=5
  229. *
  230.          MCHEL1.INFCHE(ISOUS,1)=0
  231.          MCHEL1.INFCHE(ISOUS,2)=0
  232.          MCHEL1.INFCHE(ISOUS,3)=NHRM
  233.          MCHEL1.INFCHE(ISOUS,4)=IPMINT
  234.          MCHEL1.INFCHE(ISOUS,5)=0
  235.          MCHEL1.INFCHE(ISOUS,6)=5
  236. C
  237. C     CREATION DU TABLEAU INFOS
  238. C
  239.          CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE2,INFOS,IRTD)
  240.          IF (IRTD.EQ.0)THEN
  241. *            INFO=IPINF
  242. *            SEGSUP INFO
  243.             GOTO 888
  244.          ENDIF
  245. *
  246. *       TRAITEMENT DU CHAMP DE CONTRAINTES
  247. *
  248.         if(lnomid(4).ne.0) then
  249.          nomid=lnomid(4)
  250.          segact nomid
  251.          mostrs=nomid
  252.          nstr=lesobl(/2)
  253.          nfac=lesfac(/2)
  254.          lsupco=.false.
  255.         else
  256.          lsupco=.true.
  257.          CALL IDCONT(IMODEL,IFOUR,MOSTRS,NSTR,NFAC)
  258.         endif
  259.          IF (MOSTRS.EQ.0) THEN
  260.             MOTERR(1:4)='CONT'
  261.             MOTERR(5:8)=NOMTP(MELE)
  262.             CALL ERREUR (76)
  263. *            INFO=IPINF
  264. *            SEGSUP INFO
  265.             GOTO 888
  266.          ENDIF
  267. *
  268.          NBTYPE=1
  269.          SEGINI NOTYPE
  270.          MOTYPE=NOTYPE
  271.          TYPE(1)='REAL*8'
  272.          CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOSTRS,MOTYPE,1,INFOS,3,IVASTR)
  273.          IF(IERR.NE.0)THEN
  274.             SEGSUP NOTYPE
  275.             GOTO 9990
  276.          ENDIF
  277. *
  278.         IF (ISUP1.EQ.1) THEN
  279.            CALL VALCHE(IVASTR,NSTR,IPMINT,IPPORE,MOSTRS,MELE)
  280.            IF(IERR.NE.0)THEN
  281.              SEGSUP NOTYPE
  282.              ISUP1=0
  283.              GOTO 9990
  284.             ENDIF
  285.         ENDIF
  286. *
  287. *       TRAITEMENT DU CHAMP DE VARIABLES INTERNES
  288. *
  289.        if(lnomid(10).ne.0) then
  290.          nomid=lnomid(10)
  291.          segact nomid
  292.          movari=nomid
  293.          nvari=lesobl(/2)
  294.          nvarf=lesfac(/2)
  295.          lsupva=.false.
  296.        else
  297.          lsupva=.true.
  298.          CALL IDVARI(MFR,IMODEL,MOVARI,NVARI,NVARF)
  299.        endif
  300. *       write(6,*) ' lnomid(10) nvari nvarf ', lnomid(10),nvari,nvarf
  301.          IF (MOVARI.EQ.0) THEN
  302.             MOTERR(1:4)='VARI'
  303.             MOTERR(5:8)=NOMTP(MELE)
  304.             CALL ERREUR (76)
  305.             SEGSUP NOTYPE
  306.             GOTO 9990
  307.          ENDIF
  308. *
  309.          CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOVARI,MOTYPE,1,INFOS,3,IVARI)
  310.          IF(IERR.NE.0)THEN
  311.             SEGSUP NOTYPE
  312.             GOTO 9990
  313.          ENDIF
  314. *
  315.         NVART=NVARI+NVARF
  316.         IF (ISUP2.EQ.1) THEN
  317.            CALL VALCHE(IVARI,NVART,IPMINT,IPPORE,MOVARI,MELE)
  318.            IF(IERR.NE.0)THEN
  319.              SEGSUP NOTYPE
  320.              ISUP2=0
  321.              GOTO 9990
  322.             ENDIF
  323.         ENDIF
  324. *
  325. *   TRAITEMENT DU CHAMP DE CARACTERISTIQUES MATERIELLES
  326. *
  327.         if(lnomid(6).ne.0) then
  328.          nomid=lnomid(6)
  329.          segact nomid
  330.          momatr=nomid
  331.          nmatr=lesobl(/2)
  332.          nmatf=lesfac(/2)
  333.          lsupma=.false.
  334.         else
  335.          lsupma=.true.
  336.          CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF)
  337.         endif
  338.         IF (MOMATR.EQ.0) THEN
  339.            MOTERR(1:4)='MATE'
  340.            MOTERR(5:8)=NOMTP(MELE)
  341.            CALL ERREUR (76)
  342.            GOTO 9990
  343.         ENDIF
  344. *
  345.         IF (NIFIBR.NE.8) THEN
  346.          NBTYPE=1
  347.          SEGINI NOTYPE
  348.          MOTYPE=NOTYPE
  349.          TYPE(1)='REAL*8'
  350. *
  351.         ELSE
  352.           NBTYPE=13
  353.           SEGINI NOTYPE
  354.           MOTYPE=NOTYPE
  355.           DO I=1,NBTYPE
  356.             TYPE(I)='REAL*8'
  357.           ENDDO
  358.           TYPE(10)='POINTEUREVOLUTIO'
  359.           TYPE(11)='POINTEUREVOLUTIO'
  360. *
  361.         ENDIF
  362. *
  363.         CALL KOMCHA(IPCAR,IPMAIL,CONM,MOMATR,MOTYPE,1,
  364.      &                                  INFOS,3,IVAMAT)
  365.         SEGSUP NOTYPE
  366.         IF(IERR.NE.0)THEN
  367.            GOTO 9990
  368.         ENDIF
  369.         NMATT=NMATR+NMATF
  370. *
  371.         IF (ISUP5.EQ.1) THEN
  372.            CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE,MOMATR,MELE)
  373.            IF(IERR.NE.0)THEN
  374.               ISUP5=0
  375.               GOTO 9990
  376.            ENDIF
  377.         ENDIF
  378. *
  379. *      TRAITEMENT DU CHAMP DE CARACTERISTIQUES GEOMETRIQUES
  380. *
  381.         if(lnomid(7).ne.0) then
  382.          nomid=lnomid(7)
  383.          segact nomid
  384.          mocara=nomid
  385.          ncara=lesobl(/2)
  386.          ncarf=lesfac(/2)
  387.          lsupca=.false.
  388.         else
  389.          lsupca=.true.
  390.          CALL IDCARB(MELE,IFOUR,MOCARA,NCARA,NCARF)
  391.         endif
  392. *
  393. *        write(6,*) ' lnomid(7) ncara ncarf ' , lnomid(7),ncara,ncarf
  394.         NBTYPE=1
  395.         SEGINI NOTYPE
  396.         MOTYPE=NOTYPE
  397.         TYPE(1)='REAL*8'
  398. *
  399.         CALL KOMCHA(IPCAR,IPMAIL,CONM,MOCARA,MOTYPE,1,
  400.      &                                     INFOS,3,IVACAR)
  401.         SEGSUP NOTYPE
  402.         IF(IERR.NE.0)THEN
  403.            GOTO 9990
  404.         ENDIF
  405.         NCARR=NCARA+NCARF
  406. *
  407.         IF (ISUP5.EQ.1.AND.MOCARA.NE.0) THEN
  408.            CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE,MOCARA,MELE)
  409.            IF(IERR.NE.0)THEN
  410.               ISUP5=0
  411.               GOTO 9990
  412.            ENDIF
  413.         ENDIF
  414. *
  415. *      CREATION DES MCHAMLS DE LA SOUS ZONE
  416. *
  417.          NBPTEL=NBGS
  418.          NEL=NBELEM
  419.          N1PTEL=NBPTEL
  420.          N1EL=NEL
  421. *
  422. *   CONTRAINTES
  423. *
  424.          N2=NSTRS
  425.          SEGINI MCHAML
  426.          ICHAML(ISOUS)=MCHAML
  427.          NS=1
  428.          NCOSOU=NSTRS
  429.          SEGINI MPTVAL
  430.          IVASTF=MPTVAL
  431.          NOMID=MOSTRS
  432.          SEGACT NOMID
  433.          DO 1100 ICOMP=1,NSTRS
  434.             NOMCHE(ICOMP)=LESOBL(ICOMP)
  435.             TYPCHE(ICOMP)='REAL*8'
  436.             N2PTEL=0
  437.             N2EL=0
  438.             SEGINI MELVAL
  439.             IELVAL(ICOMP)=MELVAL
  440.             IVAL(ICOMP)=MELVAL
  441. 1100     CONTINUE
  442. *
  443. *    VARIABLES INTERNES
  444. *
  445.          N2=NVART
  446.          SEGINI MCHAM1
  447.          MCHEL1.ICHAML(ISOUS)=MCHAM1
  448.          NS=1
  449.          NCOSOU=NVART
  450.          SEGINI MPTVAL
  451.          IVARIF=MPTVAL
  452.          NOMID=MOVARI
  453.          SEGACT NOMID
  454.          DO 1200 ICOMP=1,NVARI
  455.             MCHAM1.NOMCHE(ICOMP)=LESOBL(ICOMP)
  456.             MCHAM1.TYPCHE(ICOMP)='REAL*8'
  457.             N2PTEL=0
  458.             N2EL=0
  459.             SEGINI MELVAL
  460.             MCHAM1.IELVAL(ICOMP)=MELVAL
  461.             IVAL(ICOMP)=MELVAL
  462. 1200     CONTINUE
  463.          DO 1201 ICOMP=NVARI+1,NVART
  464.             MCHAM1.NOMCHE(ICOMP)=LESFAC(ICOMP)
  465.             MCHAM1.TYPCHE(ICOMP)='REAL*8'
  466.             N2PTEL=0
  467.             N2EL=0
  468.             SEGINI MELVAL
  469.             MCHAM1.IELVAL(ICOMP)=MELVAL
  470.             IVAL(ICOMP)=MELVAL
  471. 1201     CONTINUE
  472. *
  473. *     APPEL A L'ECOULEMENT PROPREMENT DIT
  474. *
  475.          CALL FCOUL2(DEPSI,INFIBR,MELE,IPMAIL,IPMINT,NBPTEL,IVASTR,
  476.      1        IVARI,IVAMAT,IVACAR,NSTRS,NVART,NMATT,NCARR,TIME0,TIMEF,
  477.      2        SIGMA,IVASTF,IVARIF,EPSUP,EPINF,DAMAG,NSTRS2)
  478. *
  479.  9990    CONTINUE
  480. *
  481. ckich contraction eventuelle des melval
  482.         MPTVAL = IVASTF
  483.         do ICOMP=1,NSTRS
  484.           ichin = ival(icomp)
  485.           call comred(ichin)
  486.           ielval(icomp) = ichin
  487. C*        ival(icomp) = ichin
  488.         enddo
  489.  
  490.         MPTVAL=IVARIF
  491.         do ICOMP=1,NVARI
  492.           ichin = ival(icomp)
  493.           call comred(ichin)
  494.           mcham1.ielval(icomp) = ichin
  495. C*        ival(icomp) = ichin
  496.         enddo
  497.         do ICOMP=NVARI+1,NVART
  498.           ichin = ival(icomp)
  499.           call comred(ichin)
  500.           mcham1.ielval(icomp) = ichin
  501. C*        ival(icomp) = ichin
  502.         enddo
  503. *     DESACTIVATION DES SEGMENTS
  504. *
  505.          IF(ISUP1.EQ.1)THEN
  506.             CALL DTMVAL (IVASTR,3)
  507.          ELSE
  508.             CALL DTMVAL (IVASTR,1)
  509.          ENDIF
  510.          IF(ISUP2.EQ.1)THEN
  511.             CALL DTMVAL (IVARI,3)
  512.          ELSE
  513.             CALL DTMVAL (IVARI,1)
  514.          ENDIF
  515.          IF(ISUP5.EQ.1)THEN
  516.             CALL DTMVAL (IVAMAT,3)
  517.             CALL DTMVAL (IVACAR,3)
  518.          ELSE
  519.             CALL DTMVAL (IVAMAT,1)
  520.             CALL DTMVAL (IVACAR,1)
  521.          ENDIF
  522.          IF (IERR.EQ.0) THEN
  523.             CALL DTMVAL (IVASTF,1)
  524.             CALL DTMVAL (IVARIF,1)
  525.          ELSE
  526.             CALL DTMVAL (IVASTF,3)
  527.             CALL DTMVAL (IVARIF,3)
  528.          END IF
  529. *
  530.          IF (MOCARA.NE.0) THEN
  531.             NOMID=MOCARA
  532.             if(lsupca)SEGSUP NOMID
  533.          END IF
  534. *
  535.          IF (MOMATR.NE.0) THEN
  536.             NOMID=MOMATR
  537.             if(lsupma)SEGSUP NOMID
  538.          END IF
  539. *
  540.          IF (MOVARI.NE.0) THEN
  541.             NOMID=MOVARI
  542.             if(lsupva)SEGSUP NOMID
  543.          END IF
  544. *
  545.          IF (MOSTRS.NE.0) THEN
  546.             NOMID=MOSTRS
  547.             if(lsupco)SEGSUP NOMID
  548.          END IF
  549. *
  550. *         IF (IPINF .NE.0) THEN
  551. *             INFO=IPINF
  552. *             SEGSUP INFO
  553. *         END IF
  554. *
  555.          IF (IERR.NE.0) THEN
  556.             SEGSUP MCHAML,MCHAM1
  557.             GOTO 888
  558.          ENDIF
  559. 1000  CONTINUE
  560. *
  561.  888  CONTINUE
  562.       IF (IERR.EQ.0)THEN
  563.          IRETO=1
  564.       ELSE
  565.          IRETO=0
  566.          SEGSUP MCHELM,MCHEL1
  567.       ENDIF
  568.       END
  569.  
  570.  
  571.  
  572.  
  573.  
  574.  
  575.  

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