C KALPR2 SOURCE OF166741 24/10/03 21:15:22 12022 SUBROUTINE KALPR2 (MYMOD,INFOEL,SKFAC2,SHC2D,XDEC,NELD,SKRESO) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C---------------------------------------------------------------------- * Facteurs de forme en 2D-PLAN. Cas general * Calcul du decoupage des faces et initialisations * SP APPELE PAR facge2 * entrée * MYMOD : pointeur de l'objet modèle * INFOEL : informations concernant le type des éléments des maillages * XDEC : parametre pour le decoupage des faces * NELD : nombre total d'elements * sortie * SKRESO : pointeur infos. globales * SKFAC2 : pointeur sur l objet 'faces' pour le calcul des FF * SHC2D : pointeur sur la surface de projection C---------------------------------------------------------------------- C traitement des coques par dedoublement des elements C traitement des quadratiques en se ramenant a des elements C lineaires C---------------------------------------------------------------------- LOGICAL ICOQ -INC PPARAM -INC CCOPTIO -INC SMCOORD -INC SMMODEL POINTEUR MYMOD.MMODEL -INC SMELEME C --------------------------------------------------------------- C Stockage d'informations concernant le type des éléments des maillages SEGMENT ,INFOEL LOGICAL KCOQ(N1),KQUAD(N1) ENDSEGMENT C --------------------------------------------------------------- SEGMENT SKRESO INTEGER KFC,NRES,KES,KIMP ENDSEGMENT C KFC : NOMBRE DE FACES H.C C NRES: RESOLUTION C KES : DIM ESPACE C KIMP: IMPRESSION C----------------------------------------------------------------------- SEGMENT SKFAC2 INTEGER NUK(MS,MFACE),KPATCH(MFACE) INTEGER NCELL(MFACE) REAL*8 U(3,MFACE),S(MFACE) REAL*8 FF1(MFACE) ENDSEGMENT SEGMENT IPATCH REAL*8 GP(MSP,NPATCH),SP(NPATCH) ENDSEGMENT C C DESCRIPTION DES ELEMENTS C ------------------------ C MFACE : NOMBRE DE FACES C NUK : CONNECTIVITES C U : NORMALE UNITAIRE ET EQUATION DU PLAN DE L'ELEMENT C S : SURFACE C KVU : VISIBILITE A PRIORI C FF : FACTEURS DE FORME C FF1 : TRAVAIL C NCELL : NOMBRE TOTAL DE CELLULES VUES PAR UN POINT C KPATCH: POINTEUR SUR IPATCH C NPATCH: NOMBRE DE POINTS SUR L'ELEMENT (REDECOUPAGE) C GP : COORDONNEES DES POINTS C SP : ET SURFACES C----------------------------------------------------------------------- SEGMENT SHC2D INTEGER IR(NR),KA(NFC),IM(NFC,NFC) INTEGER KRO(NFC,NES),KSI(NFC,NES) REAL*8 V(NES,NR),G(NR) ENDSEGMENT C DESCRIPTION DU H.C DE PROJECTION C -------------------------------- C V : DIRECTION UNITAIRE DES CELLULES C G : FACTEUR DE FORME ASSOCIE C IR: CORRESPONDANCE C KRO , KSI : POUR LE CHANGEMENT DE REPERE C IM : REFERENCE C NR : RESOLUTION C NFC : NOMBRE DE FACES C----------------------------------------------------------------------- SEGMENT SDECOU INTEGER KDECOU(MFACE) ENDSEGMENT C-------------------------------------------------------------------- C SEGMENT STRAV REAL*8 A1(2,2),A2(2,2),U1(3),U2(3) ENDSEGMENT C-------------------------------------------------------------------- C DMIN=1.E-5 DMAX=1./DMIN NPM=20 C pour les elements lineaires (sinon pas=2) NSPA=1 C on se ramene toujours a des SEG2 NS=2 SEGINI STRAV C C>>> CREATION DE L'OBJET FACE C IF (INFOEL.EQ.0) THEN ICOQ = .FALSE. ELSE ICOQ = .TRUE. SEGACT INFOEL ENDIF NTYP = MYMOD.KMODEL(/1) NFACE = 0 NELD = 0 DO 10 ITYP=1,NTYP IMODE1 = MYMOD.KMODEL(ITYP) IPT1 = IMODE1.IMAMOD NEL = IPT1.NUM(/2) NSGEO = IPT1.NUM(/1) C C un élément COQ -> 2 facteurs de formes IF (ICOQ.AND.KCOQ(ITYP)) NEL=2*NEL C NELD = NELD + NEL IF (NS.NE.2) WRITE(6,*) ' ON ATTEND DES SEG2 ' NFACE = NFACE + NEL 10 CONTINUE IF (IIMPI.GE.1) THEN */////// WRITE( 6,*) ' NOMBRE TOTAL D ELEMENTS',NELD,', DE FACES ',NFACE C NBSEG = 1+3*NTYP+(1+2*NTYP)*NELD C WRITE (6,*) 'Le CHAMELEM facteur de forme tient sur', C # NBSEG,' segments .' */////// ENDIF C MFACE = NFACE MS = NS SEGINI SKFAC2 SEGINI SDECOU C C UN SEUL TYPE D'ELEMENTS : SEG2 C C Remplissage de NUK(*,*) et de U(*,4) NELT= 0 DO 100 ITYP = 1,NTYP IMODE1 = MYMOD.KMODEL(ITYP) IPT1 = IMODE1.IMAMOD NSGEO = IPT1.NUM(/1) NSPA=1 IF (ICOQ.AND.KQUAD(ITYP)) NSPA = 2 NEL = IPT1.NUM(/2) DO 110 I = 1,NEL IF (ICOQ.AND.KCOQ(ITYP)) THEN WRITE (6,*) 'IL y a des COQ2' KEL = (2*I-1) + NELT ELSE KEL = I + NELT ENDIF DO 111 IS = 1, NSGEO, NSPA LS=IS IF (ICOQ.AND.KQUAD(ITYP)) LS=(IS+1)/2 C** NUK(IS,KEL) = IPT1.NUM(IS,I) NUK(LS,KEL) = IPT1.NUM(IS,I) IF (IIMPI.GE.4) WRITE(6,*) # 'NUK(',LS,',',KEL,')=',NUK(LS,KEL) IREF = (IDIM+1)*(NUK(LS,KEL)-1) DO 112 K = 1,IDIM C** A1(K,IS) = XCOOR(IREF+K) A1(K,LS) = XCOOR(IREF+K) 112 CONTINUE 111 CONTINUE CALL KNORM2(IDIM,A1,NS,U1,S(KEL)) *//////////// * WRITE (6,*) 'Normale :',(U1(K),K=1,IDIM) *//////////// DO 113 L = 1,IDIM+1 U(L,KEL) = U1(L) 113 CONTINUE C IF (ICOQ.AND.KCOQ(ITYP)) THEN C On remplit NUK , U et S pour l'élément inverse NUK(1,KEL+1) = NUK(2,KEL) NUK(2,KEL+1) = NUK(1,KEL) S(KEL+1) = S(KEL) DO 114 L = 1,IDIM+1 U(L,KEL+1) = -U(L,KEL) 114 CONTINUE ENDIF 110 CONTINUE IF (ICOQ.AND.KCOQ(ITYP)) THEN NELT=NELT+NEL*2 ELSE NELT=NELT+NEL ENDIF C 100 CONTINUE C IF (ICOQ) SEGDES INFOEL C SEGACT SDECOU*MOD DO 200 K1= 1,NFACE DO 213 LS= 1, NS IREF = (IDIM+1)*(NUK(LS,K1)-1) DO 212 K = 1,IDIM C** A1(K,IS) = XCOOR(IREF+K) A1(K,LS) = XCOOR(IREF+K) 212 CONTINUE 213 CONTINUE DO 214 K=1,IDIM+1 U1(K) = U(K,K1) 214 CONTINUE IF (XDEC.GE.0.01) THEN DK1 = DMAX DO 400 K2 = 1,MFACE C WRITE(6,*) ' K2 ',K2 C DO 413 LS= 1, NS IREF = (IDIM+1)*(NUK(LS,K2)-1) DO 412 K = 1,IDIM C** A2(K,IS) = XCOOR(IREF+K) A2(K,LS) = XCOOR(IREF+K) 412 CONTINUE 413 CONTINUE DO 414 K=1,IDIM+1 U2(K) = U(K,K2) 414 CONTINUE C CALL KPRIOR(IDIM,NS,NS,A1,A2,U1,U2,KVU) IF (KVU.NE.0) THEN C WRITE(6,*) ' KVU',KVU D1 = (A1(1,1)+A1(1,2)-A2(1,1)-A2(1,2))/2. D2 = (A1(2,2)+A1(2,2)-A2(2,1)-A2(2,2))/2. DKK1 = SQRT(D1*D1+D2*D2) IF ((DKK1/S(K1)).GT.DMIN) THEN C tri angulaire CK1 = ABS(U1(1)*D1+U1(2)*D2)/DKK1 C WRITE(6,*) ' K2 KVU DKK1 CK1 ',K1,KVU,DKK1,CK1 IF(CK1.GE.0.01) THEN DK1=MIN(DKK1,DK1) ENDIF ENDIF ENDIF 400 CONTINUE DR=DK1/XDEC C WRITE(6,*) ' DR ',DR ELSE DR = DMAX ENDIF NPAT=INT(S(K1)/DR)+1 NPAT=MIN0(NPAT,NPM) NPATCH = NPAT MSP = MS SEGINI IPATCH CALL KCREP2(A1,S(K1),IDIM,NPATCH,GP,SP) KDECOU(K1)= NPAT KPATCH(K1) = IPATCH SEGDES IPATCH 200 CONTINUE C IF(IIMPI.GE.2) THEN WRITE(6,*) WRITE(6,*) 'NOMBRE DE SUBDIVISIONS PAR FACE' WRITE(6,1000) (KDECOU(I),I=1,MFACE) 1000 FORMAT(1X,10(I4)) ENDIF C C>>> CARACTERISTIQUES GLOBALES C NFC = 4 NR = NRES NES = IDIM SEGINI SHC2D CALL KCACU2(IDIM,NRES,G,V,NFC,KRO,KSI,IR,KA,IM) C C** KFC = NFC SEGDES SKFAC2,SHC2D SEGSUP SDECOU SEGSUP STRAV C RETURN END