Télécharger la plaquette Cast3M


fr en

Télécharger kgrav1.eso

Retour à la liste

Numérotation des lignes : 

kgrav1

  1. C KGRAV1    SOURCE    CB215821  24/04/12    21:16:32     11897          
  2.       SUBROUTINE KGRAV1 (IPMODL,XRG,IPOIN1,IPRIG,IRET,IDISS,IFLAM)
  3. *
  4. *_______________________________________________________________________
  5. *
  6. *             APPELE PAR KP
  7. *
  8. *  ENTREES :
  9. *  ========
  10. *
  11. *                  IPMODL: POINTEUR SUR UN MMODEL
  12. *                  IPOIN1: NUMERO DU POINT(VECTEUR) QUI DEFINIT LE SENS
  13. *                          LA PESANTEUR
  14. *                  XRG   : COEFFICIENT MULTIPLICATEUR DE RIGIDITE
  15. *                  IDISS : 0 ---> MATRICE SYMETRIQUE
  16. *                          1 ---> MATRICE DISSYMETRIQUE
  17. *                  IFLAM : 0 ---> SOUS TYPE RIGIDITE
  18. *                          1 ---> SOUS TYPE MASSE
  19. *
  20. *  SORTIES :
  21. *  =========
  22. *
  23. *                  IPRIG POINTEUR SUR LA RIGIDITE CONSTRUITE
  24. *                  IRET   1 SI OK, 0 SINON
  25. *
  26. *    I. Politopoulos    juillet 1995
  27. *_______________________________________________________________________
  28.       IMPLICIT INTEGER(I-N)
  29.       IMPLICIT REAL*8(A-H,O-Z)
  30.  
  31. -INC PPARAM
  32. -INC CCOPTIO
  33. -INC CCREEL
  34. -INC CCHAMP
  35. -INC SMRIGID
  36. -INC SMELEME
  37. -INC SMCOORD
  38. -INC SMINTE
  39. -INC SMMODEL
  40.       LOGICAL lsupfo,lsupdp
  41. C
  42.       SEGMENT NOTYPE
  43.         CHARACTER*16 TYPE(NBTYPE)
  44.       ENDSEGMENT
  45. C
  46.       SEGMENT LIMODL(0)
  47. C                                                                                                                                                            C
  48.       NHRM=NIFOUR
  49.       IRET=1
  50. C
  51. C     ACTIVATION DU MODELE
  52. C
  53.       MMODEL=IPMODL
  54.       SEGACT MMODEL
  55.       NSOUS=KMODEL(/1)
  56. C
  57. C     RECUPERATION DES MODELES
  58. C
  59.       SEGINI,LIMODL
  60.       DO 100 ISOUS=1,NSOUS
  61.         IMODEL=KMODEL(ISOUS)
  62.         SEGACT, IMODEL
  63.         IF(FORMOD(1).EQ.'MECANIQUE'.OR.(FORMOD(1).EQ.'CHARGEMENT'.AND.
  64.      &     MATMOD(1).EQ.'PRESSION')) THEN
  65.           LIMODL(**)=IMODEL
  66.         ELSE
  67.           SEGDES,IMODEL
  68.         ENDIF
  69.  100  CONTINUE
  70. C
  71.       NSOUS = LIMODL(/1)
  72.       IF (NSOUS.LE.0) THEN
  73.         SEGDES, MMODEL
  74.         SEGSUP, LIMODL
  75.         CALL ERREUR(610)
  76.         RETURN
  77.       ENDIF
  78. C
  79. C     CREATION DE L'OBJET MATRICE DE RIGIDITE
  80. C
  81.       NRIGE=7
  82.       NRIGEL=NSOUS
  83.       SEGINI MRIGID
  84.       IPRIG=MRIGID
  85.        IF (IFLAM.EQ.1) THEN
  86.          MTYMAT='MASSE'
  87.        ELSE
  88.          MTYMAT='RIGIDITE'
  89.        ENDIF
  90.       IFORIG=IFOUR
  91.       ICHOLE=0
  92.       IMGEO1=0
  93.       IMGEO2=0
  94.       ISUPEQ=0
  95. C
  96. C      BOUCLE SUR LES SOUS ZONES
  97. C
  98.       DO 499 ISOUS=1,NSOUS
  99.          IRIGEL(4,ISOUS)=0
  100.          COERIG(ISOUS)=1.D0
  101.   499 CONTINUE
  102. C_______________________________________________________________________
  103. C
  104. C     DEBUT DE LA BOUCLE SUR LES DIFFERENTES SOUS ZONES
  105. C_______________________________________________________________________
  106. C
  107.       DO 500 ISOUS=1,NSOUS
  108. C
  109. C     ON RECUPERE LINFORMATION GENERALES
  110. C
  111.       IMODEL=KMODEL(ISOUS)
  112.       SEGACT IMODEL
  113.       IPMAIL=IMAMOD
  114. C
  115. C     TRAITEMENT DU MODELE
  116. C
  117.       MELEME=IMAMOD
  118.       MELE=NEFMOD
  119.       NFOR=FORMOD(/2)
  120.       NMAT=MATMOD(/2)
  121.  
  122. C_______________________________________________________________________
  123. C
  124. C     INFORMATION SUR L ELEMENT FINI
  125. C_______________________________________________________________________
  126. C
  127. *      CALL ELQUOI(MELE,0,4,IPINF,IMODEL)
  128.       IF (IERR.NE.0) THEN
  129.          SEGDES IMODEL,MMODEL
  130.          SEGSUP MRIGID
  131.          IRET=0
  132.          RETURN
  133.       ENDIF
  134. *      INFO=IPINF
  135.       MFR   =INFELE(13)
  136.       LRE   =INFELE(9)
  137.       LW    =INFELE(7)
  138.       NDDL  =INFELE(15)
  139.       IELE=INFELE(14)
  140. *      MINTE=INFELE(11)
  141.        MINTE=infmod(6)
  142.       IPMINT=MINTE
  143. C
  144. C     INITIALISATION DE MINTE
  145. C
  146.       SEGACT MINTE
  147.       NBPGAU=POIGAU(/1)
  148.  
  149. C
  150. C     ON RECUPERE LES MELEME
  151. C
  152.       MELEME=IPMAIL
  153.       SEGACT MELEME
  154.  
  155.       NBNN  =NUM(/1)
  156.       NBELEM=NUM(/2)
  157.  
  158. C
  159. C ---------------------------------------------------------*
  160. C INITIALISATION DU SEGMENT DESCR, SEGMENT DESCRIPTEUR DES *
  161. C DES INCONNUES RELATIVES A LA MATRICE DE RIGIDITE         *
  162. C ---------------------------------------------------------*
  163.          NLIGRP = INFELE(9)
  164.          NLIGRD = INFELE(9)
  165.          SEGINI DESCR
  166.           IPDSCR=DESCR
  167.           if(lnomid(1).ne.0) then
  168.            nomid=lnomid(1)
  169.            segact nomid
  170.            modepl=nomid
  171.            ndepl=lesobl(/2)
  172.            ndum=lesfac(/2)
  173.            lsupdp=.false.
  174.          else
  175.           lsupdp=.true.
  176.           CALL IDPRIM(IMODEL,MFR,MODEPL,NDEPL,NDUM)
  177.         endif
  178.          if(lnomid(2).ne.0) then
  179.            nomid=lnomid(2)
  180.            segact nomid
  181.            moforc=nomid
  182.            nforc=lesobl(/2)
  183.            lsupfo=.false.
  184.          else
  185.           lsupfo=.true.
  186.           CALL IDDUAL(IMODEL,MFR,MOFORC,NFORC,NDUM)
  187.          endif
  188. C
  189.          IF (NDEPL.EQ.0.OR.NFORC.EQ.0.OR.NDEPL.NE.NFORC) THEN
  190.             CALL ERREUR(5)
  191.             SEGSUP DESCR,MRIGID
  192.             SEGDES MMODEL,MELEME
  193.             IRET=0
  194.             RETURN
  195.          ENDIF
  196. C
  197. C        REMPLISSAGE DU SEGMENT DESCRIPTEUR
  198. C
  199.          IDDL=1
  200.          NCOMP=NDEPL
  201.          NBNNS=NBNN
  202.          IF (MFR.EQ.33) NCOMP=NDEPL-1
  203.          IF (IFOUR.EQ.-3) THEN
  204.            NCOMP=NDEPL-3
  205.            NBNNS=NBNN-1
  206.          ENDIF
  207.          IF (MFR.EQ.19.OR.MFR.EQ.21) NBNNS=NBNN/2
  208.          NOMID=MODEPL
  209.          SEGACT NOMID
  210.          NOMID=MOFORC
  211.          SEGACT NOMID
  212.          DO 1004 INOEUD=1,NBNNS
  213.             DO 1005 ICOMP=1,NCOMP
  214.                NOMID=MODEPL
  215.                LISINC(IDDL)=LESOBL(ICOMP)
  216.                NOMID=MOFORC
  217.                LISDUA(IDDL)=LESOBL(ICOMP)
  218.                NOELEP(IDDL)=INOEUD
  219.                NOELED(IDDL)=INOEUD
  220.                IDDL=IDDL+1
  221. 1005        CONTINUE
  222. 1004     CONTINUE
  223. *
  224.  
  225.  
  226.          NOMID=MODEPL
  227.          SEGDES NOMID
  228.          NOMID=MOFORC
  229.          SEGDES NOMID
  230.          SEGDES DESCR
  231.  
  232. C
  233. C ------------------------------------------------------------*
  234. C INITIALISATION DU SEGMENT IMATRI, CHAPEAU SUR LES SEGMENTS  *
  235. C CONTENANT LES MATRICES DE RIGIDITE ELEMENTAIRES             *
  236. C ------------------------------------------------------------*
  237. C NBELEM: NB D'ELEMENTS DANS LA SOUS ZONE
  238.          NLIGRP=LRE
  239.          NLIGRD=LRE
  240.          NELRIG=NBELEM
  241.          SEGINI xMATRI
  242.          IPMATR=xMATRI
  243. C
  244. C------------------------------------------------------*
  245. C
  246. C  TRAITEMENT DU CHAPEAU DES RIGIDITES, SEGMENT MRIGID *
  247. C------------------------------------------------------*
  248. C
  249.  
  250.          IRIGEL(1,ISOUS)=IPMAIL
  251.          IRIGEL(2,ISOUS)=0
  252.          IRIGEL(3,ISOUS)=IPDSCR
  253.          IRIGEL(4,ISOUS)=xMATRI
  254.          IRIGEL(5,ISOUS)=NHRM
  255.          IF (IDISS.EQ.0) IRIGEL(7,ISOUS)= 0
  256.          IF (IDISS.EQ.0) xmatri.symre=0
  257.          IF (IDISS.EQ.1) IRIGEL(7,ISOUS)= 2
  258.          IF (IDISS.EQ.1) xmatri.symre=2
  259.  
  260.  
  261. C_______________________________________________________________________
  262. C
  263. C     coq3/dkt/dst/coq4
  264. C_______________________________________________________________________
  265. C
  266.        IF (MELE.EQ.27.OR.MELE.EQ.28.OR.MELE.EQ.93) THEN
  267. c  coq3/dkt/dst
  268.          CALL KGRAV3(IPMAIL,XRG,IPOIN1,IPMATR,IDISS)
  269.        ELSE IF (MELE.EQ.49) THEN
  270. c  coq4
  271.          CALL KGRAV2(IPMAIL,XRG,IPOIN1,IPMATR,IDISS,IPMINT)
  272.        ELSE
  273.         SEGSUP xMATRI
  274.         IRIGEL(4,ISOUS)=0
  275.         MOTERR(1:4)=NOMTP(MELE)
  276.         MOTERR(5:12)='KGRAV1'
  277.         CALL ERREUR(86)
  278.         GOTO 9990
  279.        ENDIF
  280. C
  281. C_______________________________________________________________________
  282. C_______________________________________________________________________
  283. C
  284. C     DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE IA
  285. C_______________________________________________________________________
  286. C
  287.  
  288.       SEGDES MELEME
  289.       SEGDES IMODEL
  290.  
  291. C
  292.       NOMID=MOFORC
  293.       if(lsupfo)SEGSUP NOMID
  294.       NOMID=MODEPL
  295.       if(lsupdp)SEGSUP NOMID
  296. C
  297.       SEGDES MINTE
  298. *      INFO=IPINF
  299. *      SEGSUP INFO
  300. C
  301. C     ERREUR  DANS KGRAV3
  302. C
  303.       IF (IERR.NE.0) THEN
  304.          IRET=0
  305.          GOTO 888
  306.       ENDIF
  307.  500  CONTINUE
  308.  888  CONTINUE
  309.       SEGDES MMODEL
  310.       SEGDES MRIGID
  311.       GOTO 666
  312. C
  313.  9990 CONTINUE
  314.       IRET=0
  315.  
  316. C
  317. C     ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR
  318. C
  319.  
  320.       NOMID=MOFORC
  321.       if(lsupfo)SEGSUP NOMID
  322.       NOMID=MODEPL
  323.       if(lsupdp)SEGSUP NOMID
  324. C
  325.       SEGDES MELEME
  326.       SEGDES IMODEL
  327. C
  328.       SEGDES MMODEL
  329.       SEGSUP MRIGID
  330. C
  331.       SEGDES MINTE
  332. *      INFO=IPINF
  333. *      SEGSUP INFO
  334.       RETURN
  335.   666 CONTINUE
  336.       RETURN
  337.       END
  338.  
  339.  
  340.  
  341.  
  342.  
  343.  
  344.  
  345.  
  346.  
  347.  
  348.  

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