Télécharger la plaquette Cast3M


fr en

Télécharger kalpr2.eso

Retour à la liste

Numérotation des lignes : 

kalpr2

  1. C KALPR2    SOURCE    CB215821  24/04/12    21:16:28     11897          
  2.       SUBROUTINE KALPR2 (MYMOD,INFOEL,SKFAC2,SHC2D,XDEC,NELD,SKRESO)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8 (A-H,O-Z)
  5. C----------------------------------------------------------------------
  6. *     Facteurs de forme en 2D-PLAN. Cas general
  7. *     Calcul du decoupage des faces et initialisations
  8. *     SP APPELE PAR facge2
  9. *   entrée
  10. *     MYMOD  : pointeur de l'objet modèle
  11. *     INFOEL : informations concernant le type des éléments des maillages
  12. *     XDEC   : parametre pour le decoupage des faces
  13. *     NELD   : nombre total d'elements
  14. *   sortie
  15. *     SKRESO : pointeur infos. globales
  16. *     SKFAC2 : pointeur sur l objet 'faces' pour le calcul des FF
  17. *     SHC2D  : pointeur sur la surface de projection
  18. C----------------------------------------------------------------------
  19. C     traitement des coques par dedoublement des elements
  20. C     traitement des quadratiques en se ramenant a des elements
  21. C     lineaires
  22. C----------------------------------------------------------------------
  23.       LOGICAL ICOQ
  24.  
  25. -INC PPARAM
  26. -INC CCOPTIO
  27. -INC SMCOORD
  28. -INC SMMODEL
  29.       POINTEUR MYMOD.MMODEL
  30. -INC SMELEME
  31.  
  32. C     ---------------------------------------------------------------
  33. C     Stockage d'informations concernant le type des éléments des maillages
  34.       SEGMENT ,INFOEL
  35.         LOGICAL KCOQ(N1),KQUAD(N1)
  36.       ENDSEGMENT
  37. C     ---------------------------------------------------------------
  38.       SEGMENT SKRESO
  39.       INTEGER KFC,NRES,KES,KIMP
  40.       ENDSEGMENT
  41. C     KFC : NOMBRE DE FACES H.C
  42. C     NRES: RESOLUTION
  43. C     KES : DIM ESPACE
  44. C     KIMP: IMPRESSION
  45. C-----------------------------------------------------------------------
  46.       SEGMENT SKFAC2
  47.       INTEGER  NUK(MS,MFACE),KPATCH(MFACE)
  48.       INTEGER  NCELL(MFACE)
  49.       REAL*8   U(3,MFACE),S(MFACE)
  50.       REAL*8  FF1(MFACE)
  51.       ENDSEGMENT
  52.       SEGMENT IPATCH
  53.       REAL*8   GP(MSP,NPATCH),SP(NPATCH)
  54.       ENDSEGMENT
  55. C
  56. C     DESCRIPTION DES ELEMENTS
  57. C     ------------------------
  58. C     MFACE : NOMBRE DE FACES
  59. C     NUK   : CONNECTIVITES
  60. C     U     : NORMALE UNITAIRE ET EQUATION DU PLAN DE L'ELEMENT
  61. C     S     : SURFACE
  62. C     KVU   : VISIBILITE A PRIORI
  63. C     FF    : FACTEURS DE FORME
  64. C     FF1   : TRAVAIL
  65. C     NCELL : NOMBRE TOTAL DE CELLULES VUES PAR UN POINT
  66. C     KPATCH: POINTEUR SUR IPATCH
  67. C     NPATCH: NOMBRE DE POINTS SUR L'ELEMENT (REDECOUPAGE)
  68. C     GP    : COORDONNEES DES POINTS
  69. C     SP    : ET SURFACES
  70. C-----------------------------------------------------------------------
  71.       SEGMENT SHC2D
  72.       INTEGER IR(NR),KA(NFC),IM(NFC,NFC)
  73.       INTEGER KRO(NFC,NES),KSI(NFC,NES)
  74.       REAL*8  V(NES,NR),G(NR)
  75.       ENDSEGMENT
  76.  
  77. C     DESCRIPTION DU H.C DE PROJECTION
  78. C     --------------------------------
  79. C     V : DIRECTION UNITAIRE DES CELLULES
  80. C     G : FACTEUR DE FORME ASSOCIE
  81. C     IR: CORRESPONDANCE
  82. C     KRO , KSI : POUR LE CHANGEMENT DE REPERE
  83. C     IM  : REFERENCE
  84. C     NR  : RESOLUTION
  85. C     NFC : NOMBRE DE FACES
  86. C-----------------------------------------------------------------------
  87.       SEGMENT SDECOU
  88.       INTEGER KDECOU(MFACE)
  89.       ENDSEGMENT
  90. C--------------------------------------------------------------------
  91. C
  92.       SEGMENT STRAV
  93.       REAL*8    A1(2,2),A2(2,2),U1(3),U2(3)
  94.       ENDSEGMENT
  95. C--------------------------------------------------------------------
  96. C
  97.       DMIN=1.E-5
  98.       DMAX=1./DMIN
  99.       NPM=20
  100. C     pour les elements lineaires (sinon pas=2)
  101.       NSPA=1
  102. C     on se ramene toujours a des SEG2
  103.       NS=2
  104.  
  105.       SEGINI STRAV
  106. C
  107. C>>>  CREATION DE L'OBJET FACE
  108. C
  109.       IF (INFOEL.EQ.0)  THEN
  110.           ICOQ = .FALSE.
  111.       ELSE
  112.           ICOQ = .TRUE.
  113.           SEGACT INFOEL
  114.       ENDIF
  115.  
  116.       SEGACT MYMOD
  117.       NTYP =  MYMOD.KMODEL(/1)
  118.       NFACE = 0
  119.       NELD = 0
  120.       DO 10 ITYP=1,NTYP
  121.          IMODE1 = MYMOD.KMODEL(ITYP)
  122.          SEGACT IMODE1
  123.          IPT1 = IMODE1.IMAMOD
  124.          SEGDES IMODE1
  125.          SEGACT IPT1
  126.          NEL = IPT1.NUM(/2)
  127.          NSGEO  = IPT1.NUM(/1)
  128.          SEGDES IPT1
  129. C
  130. C        un élément COQ -> 2 facteurs de formes
  131.          IF (ICOQ.AND.KCOQ(ITYP)) NEL=2*NEL
  132. C
  133.          NELD = NELD + NEL
  134.          IF (NS.NE.2) WRITE(6,*) ' ON ATTEND DES SEG2 '
  135.          NFACE = NFACE + NEL
  136.   10  CONTINUE
  137.  
  138.       IF (IIMPI.GE.1) THEN
  139. *///////
  140.        WRITE( 6,*) ' NOMBRE TOTAL D ELEMENTS',NELD,', DE FACES ',NFACE
  141. C      NBSEG = 1+3*NTYP+(1+2*NTYP)*NELD
  142. C      WRITE (6,*) 'Le CHAMELEM facteur de forme tient sur',
  143. C    #    NBSEG,' segments .'
  144. *///////
  145.       ENDIF
  146. C
  147.       MFACE = NFACE
  148.       MS = NS
  149.       SEGINI SKFAC2
  150.       SEGINI SDECOU
  151. C
  152. C     UN SEUL TYPE D'ELEMENTS : SEG2
  153. C
  154. C     Remplissage de NUK(*,*) et de U(*,4)
  155.       NELT= 0
  156.       DO 100 ITYP = 1,NTYP
  157.  
  158.  
  159.          IMODE1 = MYMOD.KMODEL(ITYP)
  160.          SEGACT IMODE1
  161.          IPT1 = IMODE1.IMAMOD
  162.          SEGDES IMODE1
  163.          SEGACT IPT1
  164.           NSGEO = IPT1.NUM(/1)
  165.           NSPA=1
  166.           IF (ICOQ.AND.KQUAD(ITYP)) NSPA = 2
  167.           NEL = IPT1.NUM(/2)
  168.             DO 110 I = 1,NEL
  169.                IF (ICOQ.AND.KCOQ(ITYP)) THEN
  170.                 WRITE (6,*) 'IL y a des COQ2'
  171.                   KEL = (2*I-1) + NELT
  172.                ELSE
  173.                   KEL = I + NELT
  174.                ENDIF
  175.  
  176.                DO 111 IS = 1, NSGEO, NSPA
  177.                   LS=IS
  178.                   IF (ICOQ.AND.KQUAD(ITYP)) LS=(IS+1)/2
  179.  
  180. C**               NUK(IS,KEL) = IPT1.NUM(IS,I)
  181.                   NUK(LS,KEL) = IPT1.NUM(IS,I)
  182.                   IF (IIMPI.GE.4) WRITE(6,*)
  183.      #                  'NUK(',LS,',',KEL,')=',NUK(LS,KEL)
  184.                   IREF = (IDIM+1)*(NUK(LS,KEL)-1)
  185.                   DO 112 K = 1,IDIM
  186. C**               A1(K,IS) = XCOOR(IREF+K)
  187.                   A1(K,LS) = XCOOR(IREF+K)
  188.  112              CONTINUE
  189.  111           CONTINUE
  190.                CALL KNORM2(IDIM,A1,NS,U1,S(KEL))
  191. *////////////
  192. *       WRITE (6,*) 'Normale :',(U1(K),K=1,IDIM)
  193. *////////////
  194.                   DO 113 L = 1,IDIM+1
  195.                   U(L,KEL) = U1(L)
  196.  113              CONTINUE
  197. C
  198.                 IF (ICOQ.AND.KCOQ(ITYP)) THEN
  199. C               On remplit NUK , U et S pour l'élément inverse
  200.                    NUK(1,KEL+1) = NUK(2,KEL)
  201.                    NUK(2,KEL+1) = NUK(1,KEL)
  202.                    S(KEL+1) = S(KEL)
  203.                    DO 114 L = 1,IDIM+1
  204.                       U(L,KEL+1) = -U(L,KEL)
  205.  114               CONTINUE
  206.                  ENDIF
  207.  
  208.  110        CONTINUE
  209.             IF (ICOQ.AND.KCOQ(ITYP)) THEN
  210.                NELT=NELT+NEL*2
  211.             ELSE
  212.                NELT=NELT+NEL
  213.             ENDIF
  214. C
  215.          SEGDES IPT1
  216.  100  CONTINUE
  217. C
  218.       SEGDES MYMOD
  219.       IF (ICOQ)  SEGDES INFOEL
  220. C
  221.       SEGACT SDECOU*MOD
  222.  
  223.             DO 200 K1= 1,NFACE
  224.                   DO 213 LS= 1, NS
  225.                   IREF = (IDIM+1)*(NUK(LS,K1)-1)
  226.                   DO 212 K = 1,IDIM
  227. C**               A1(K,IS) = XCOOR(IREF+K)
  228.                   A1(K,LS) = XCOOR(IREF+K)
  229.  212              CONTINUE
  230.  213              CONTINUE
  231.                   DO 214 K=1,IDIM+1
  232.                   U1(K) =  U(K,K1)
  233.  214              CONTINUE
  234.  
  235.             IF (XDEC.GE.0.01) THEN
  236.             DK1 = DMAX
  237.             DO 400 K2 = 1,MFACE
  238. C                WRITE(6,*) ' K2 ',K2
  239. C
  240.                   DO 413 LS= 1, NS
  241.                   IREF = (IDIM+1)*(NUK(LS,K2)-1)
  242.                   DO 412 K = 1,IDIM
  243. C**               A2(K,IS) = XCOOR(IREF+K)
  244.                   A2(K,LS) = XCOOR(IREF+K)
  245.  412              CONTINUE
  246.  413              CONTINUE
  247.                   DO 414 K=1,IDIM+1
  248.                   U2(K) =  U(K,K2)
  249.  414              CONTINUE
  250. C
  251.             CALL KPRIOR(IDIM,NS,NS,A1,A2,U1,U2,KVU)
  252.  
  253.             IF (KVU.NE.0) THEN
  254. C           WRITE(6,*) ' KVU',KVU
  255.               D1 = (A1(1,1)+A1(1,2)-A2(1,1)-A2(1,2))/2.
  256.               D2 = (A1(2,2)+A1(2,2)-A2(2,1)-A2(2,2))/2.
  257.               DKK1 = SQRT(D1*D1+D2*D2)
  258.               IF ((DKK1/S(K1)).GT.DMIN) THEN
  259. C             tri angulaire
  260.                 CK1 = ABS(U1(1)*D1+U1(2)*D2)/DKK1
  261. C               WRITE(6,*) ' K2 KVU DKK1 CK1 ',K1,KVU,DKK1,CK1
  262.                   IF(CK1.GE.0.01) THEN
  263.                     DK1=MIN(DKK1,DK1)
  264.                   ENDIF
  265.               ENDIF
  266.             ENDIF
  267.  400        CONTINUE
  268.              DR=DK1/XDEC
  269. C           WRITE(6,*) ' DR ',DR
  270.  
  271.             ELSE
  272.             DR = DMAX
  273.             ENDIF
  274.  
  275.             NPAT=INT(S(K1)/DR)+1
  276.             NPAT=MIN0(NPAT,NPM)
  277.             NPATCH = NPAT
  278.             MSP = MS
  279.             SEGINI IPATCH
  280.             CALL KCREP2(A1,S(K1),IDIM,NPATCH,GP,SP)
  281.             KDECOU(K1)= NPAT
  282.             KPATCH(K1) = IPATCH
  283.             SEGDES IPATCH
  284.  200        CONTINUE
  285. C
  286.       IF(IIMPI.GE.2) THEN
  287.        WRITE(6,*)
  288.        WRITE(6,*) 'NOMBRE DE SUBDIVISIONS PAR FACE'
  289.        WRITE(6,1000) (KDECOU(I),I=1,MFACE)
  290.  1000  FORMAT(1X,10(I4))
  291.       ENDIF
  292. C
  293. C>>>  CARACTERISTIQUES GLOBALES
  294. C
  295.         NFC = 4
  296.         NR = NRES
  297.         NES = IDIM
  298.         SEGINI SHC2D
  299.         CALL  KCACU2(IDIM,NRES,G,V,NFC,KRO,KSI,IR,KA,IM)
  300. C
  301. C**     KFC = NFC
  302.  
  303.          SEGDES SKFAC2,SHC2D
  304.          SEGSUP SDECOU
  305.       SEGSUP STRAV
  306. C
  307.       RETURN
  308.       END
  309.  
  310.  
  311.  
  312.  
  313.  
  314.  
  315.  
  316.  
  317.  
  318.  
  319.  
  320.  
  321.  
  322.  

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