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    OF166741  24/10/03    21:15:22     12022          
  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.       NTYP =  MYMOD.KMODEL(/1)
  117.       NFACE = 0
  118.       NELD = 0
  119.       DO 10 ITYP=1,NTYP
  120.          IMODE1 = MYMOD.KMODEL(ITYP)
  121.          IPT1 = IMODE1.IMAMOD
  122.          NEL = IPT1.NUM(/2)
  123.          NSGEO  = IPT1.NUM(/1)
  124. C
  125. C        un élément COQ -> 2 facteurs de formes
  126.          IF (ICOQ.AND.KCOQ(ITYP)) NEL=2*NEL
  127. C
  128.          NELD = NELD + NEL
  129.          IF (NS.NE.2) WRITE(6,*) ' ON ATTEND DES SEG2 '
  130.          NFACE = NFACE + NEL
  131.   10  CONTINUE
  132.  
  133.       IF (IIMPI.GE.1) THEN
  134. *///////
  135.        WRITE( 6,*) ' NOMBRE TOTAL D ELEMENTS',NELD,', DE FACES ',NFACE
  136. C      NBSEG = 1+3*NTYP+(1+2*NTYP)*NELD
  137. C      WRITE (6,*) 'Le CHAMELEM facteur de forme tient sur',
  138. C    #    NBSEG,' segments .'
  139. *///////
  140.       ENDIF
  141. C
  142.       MFACE = NFACE
  143.       MS = NS
  144.       SEGINI SKFAC2
  145.       SEGINI SDECOU
  146. C
  147. C     UN SEUL TYPE D'ELEMENTS : SEG2
  148. C
  149. C     Remplissage de NUK(*,*) et de U(*,4)
  150.       NELT= 0
  151.       DO 100 ITYP = 1,NTYP
  152.  
  153.          IMODE1 = MYMOD.KMODEL(ITYP)
  154.          IPT1 = IMODE1.IMAMOD
  155.           NSGEO = IPT1.NUM(/1)
  156.           NSPA=1
  157.           IF (ICOQ.AND.KQUAD(ITYP)) NSPA = 2
  158.           NEL = IPT1.NUM(/2)
  159.             DO 110 I = 1,NEL
  160.                IF (ICOQ.AND.KCOQ(ITYP)) THEN
  161.                 WRITE (6,*) 'IL y a des COQ2'
  162.                   KEL = (2*I-1) + NELT
  163.                ELSE
  164.                   KEL = I + NELT
  165.                ENDIF
  166.  
  167.                DO 111 IS = 1, NSGEO, NSPA
  168.                   LS=IS
  169.                   IF (ICOQ.AND.KQUAD(ITYP)) LS=(IS+1)/2
  170.  
  171. C**               NUK(IS,KEL) = IPT1.NUM(IS,I)
  172.                   NUK(LS,KEL) = IPT1.NUM(IS,I)
  173.                   IF (IIMPI.GE.4) WRITE(6,*)
  174.      #                  'NUK(',LS,',',KEL,')=',NUK(LS,KEL)
  175.                   IREF = (IDIM+1)*(NUK(LS,KEL)-1)
  176.                   DO 112 K = 1,IDIM
  177. C**               A1(K,IS) = XCOOR(IREF+K)
  178.                   A1(K,LS) = XCOOR(IREF+K)
  179.  112              CONTINUE
  180.  111           CONTINUE
  181.                CALL KNORM2(IDIM,A1,NS,U1,S(KEL))
  182. *////////////
  183. *       WRITE (6,*) 'Normale :',(U1(K),K=1,IDIM)
  184. *////////////
  185.                   DO 113 L = 1,IDIM+1
  186.                   U(L,KEL) = U1(L)
  187.  113              CONTINUE
  188. C
  189.                 IF (ICOQ.AND.KCOQ(ITYP)) THEN
  190. C               On remplit NUK , U et S pour l'élément inverse
  191.                    NUK(1,KEL+1) = NUK(2,KEL)
  192.                    NUK(2,KEL+1) = NUK(1,KEL)
  193.                    S(KEL+1) = S(KEL)
  194.                    DO 114 L = 1,IDIM+1
  195.                       U(L,KEL+1) = -U(L,KEL)
  196.  114               CONTINUE
  197.                  ENDIF
  198.  
  199.  110        CONTINUE
  200.             IF (ICOQ.AND.KCOQ(ITYP)) THEN
  201.                NELT=NELT+NEL*2
  202.             ELSE
  203.                NELT=NELT+NEL
  204.             ENDIF
  205. C
  206.  100  CONTINUE
  207. C
  208.       IF (ICOQ)  SEGDES INFOEL
  209. C
  210.       SEGACT SDECOU*MOD
  211.  
  212.             DO 200 K1= 1,NFACE
  213.                   DO 213 LS= 1, NS
  214.                   IREF = (IDIM+1)*(NUK(LS,K1)-1)
  215.                   DO 212 K = 1,IDIM
  216. C**               A1(K,IS) = XCOOR(IREF+K)
  217.                   A1(K,LS) = XCOOR(IREF+K)
  218.  212              CONTINUE
  219.  213              CONTINUE
  220.                   DO 214 K=1,IDIM+1
  221.                   U1(K) =  U(K,K1)
  222.  214              CONTINUE
  223.  
  224.             IF (XDEC.GE.0.01) THEN
  225.             DK1 = DMAX
  226.             DO 400 K2 = 1,MFACE
  227. C                WRITE(6,*) ' K2 ',K2
  228. C
  229.                   DO 413 LS= 1, NS
  230.                   IREF = (IDIM+1)*(NUK(LS,K2)-1)
  231.                   DO 412 K = 1,IDIM
  232. C**               A2(K,IS) = XCOOR(IREF+K)
  233.                   A2(K,LS) = XCOOR(IREF+K)
  234.  412              CONTINUE
  235.  413              CONTINUE
  236.                   DO 414 K=1,IDIM+1
  237.                   U2(K) =  U(K,K2)
  238.  414              CONTINUE
  239. C
  240.             CALL KPRIOR(IDIM,NS,NS,A1,A2,U1,U2,KVU)
  241.  
  242.             IF (KVU.NE.0) THEN
  243. C           WRITE(6,*) ' KVU',KVU
  244.               D1 = (A1(1,1)+A1(1,2)-A2(1,1)-A2(1,2))/2.
  245.               D2 = (A1(2,2)+A1(2,2)-A2(2,1)-A2(2,2))/2.
  246.               DKK1 = SQRT(D1*D1+D2*D2)
  247.               IF ((DKK1/S(K1)).GT.DMIN) THEN
  248. C             tri angulaire
  249.                 CK1 = ABS(U1(1)*D1+U1(2)*D2)/DKK1
  250. C               WRITE(6,*) ' K2 KVU DKK1 CK1 ',K1,KVU,DKK1,CK1
  251.                   IF(CK1.GE.0.01) THEN
  252.                     DK1=MIN(DKK1,DK1)
  253.                   ENDIF
  254.               ENDIF
  255.             ENDIF
  256.  400        CONTINUE
  257.              DR=DK1/XDEC
  258. C           WRITE(6,*) ' DR ',DR
  259.  
  260.             ELSE
  261.             DR = DMAX
  262.             ENDIF
  263.  
  264.             NPAT=INT(S(K1)/DR)+1
  265.             NPAT=MIN0(NPAT,NPM)
  266.             NPATCH = NPAT
  267.             MSP = MS
  268.             SEGINI IPATCH
  269.             CALL KCREP2(A1,S(K1),IDIM,NPATCH,GP,SP)
  270.             KDECOU(K1)= NPAT
  271.             KPATCH(K1) = IPATCH
  272.             SEGDES IPATCH
  273.  200        CONTINUE
  274. C
  275.       IF(IIMPI.GE.2) THEN
  276.        WRITE(6,*)
  277.        WRITE(6,*) 'NOMBRE DE SUBDIVISIONS PAR FACE'
  278.        WRITE(6,1000) (KDECOU(I),I=1,MFACE)
  279.  1000  FORMAT(1X,10(I4))
  280.       ENDIF
  281. C
  282. C>>>  CARACTERISTIQUES GLOBALES
  283. C
  284.         NFC = 4
  285.         NR = NRES
  286.         NES = IDIM
  287.         SEGINI SHC2D
  288.         CALL  KCACU2(IDIM,NRES,G,V,NFC,KRO,KSI,IR,KA,IM)
  289. C
  290. C**     KFC = NFC
  291.  
  292.          SEGDES SKFAC2,SHC2D
  293.          SEGSUP SDECOU
  294.       SEGSUP STRAV
  295. C
  296.       RETURN
  297.       END
  298.  
  299.  
  300.  

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