C RAYE1 SOURCE CHAT 12/06/07 21:15:55 7389 SUBROUTINE RAYE1(ICHFAC, INFOEL, MATR) C ********************************************************** C **** SUBROUTINE D'INTERFACAGE CHAMELEM --> MATRICE **** C **** POUR LES FACTEURS DE FORME **** C **** **** C **** En entree : ICHFAC matrice des facteurs de **** C **** de type CHAMELEM **** C **** INFOEL segment qui contient la **** C **** structure COQ ou QUAdratique de la **** C **** zone étudiée **** C **** **** C **** En sortie : MATR matrice des facteurs de forme **** C **** exploitable par le programme **** C **** de calcul RAYE3.ESO **** C **** **** C ********************************************************** IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) -INC SMCHAML -INC SMELEME -INC PPARAM -INC CCOPTIO C ********************************************************** C **** Declaration de la structure des facteurs **** C **** de forme **** C ********************************************************** SEGMENT IFACFO INTEGER LFACT(NBEL1) ENDSEGMENT SEGMENT LFAC REAL*8 FACT(NBEL2) ENDSEGMENT SEGMENT INFOEL LOGICAL KCOQ(N1), KQUAD(N1) ENDSEGMENT C ********************************************************** C **** Declaration des variables du probleme **** C ********************************************************** POINTEUR PSUR.LFAC, PLIGI.LFAC, PLIGS.LFAC, PLIG.LFAC POINTEUR MATR.IFACFO POINTEUR ISSM.MELEME POINTEUR ICHFAC.MCHELM POINTEUR IMCHFA.MCHAML POINTEUR ISURF.MELVAL C **** Cas des elements COQ en haut **** POINTEUR IFFAS.MELVAL, IFFAI.MELVAL POINTEUR ISSCHI.MCHELM, ISSCHS.MCHELM POINTEUR ICHFBI.MCHAML, ICHFBS.MCHAML C **** Cas des elements COQ en haut et en bas **** POINTEUR IFFBII.MELVAL, IFFBIS.MELVAL POINTEUR IFFBSI.MELVAL, IFFBSS.MELVAL C **** Cas des elements COQ en haut seulement **** POINTEUR IFFBIM.MELVAL, IFFBSM.MELVAL C **** Pas d'elements COQ en haut **** POINTEUR IFFA.MELVAL POINTEUR ISSCH.MCHELM POINTEUR ICHFB.MCHAML C **** Cas des elements COQ en bas seulement **** POINTEUR IFFBI.MELVAL, IFFBS.MELVAL C **** Cas ou il n'y a pas d'elements COQ **** POINTEUR IFFB.MELVAL C ********************************************************** C **** Recherche de la position du pointeur donnant **** C **** les surfaces des elements **** C ********************************************************** IF (IIMPI.GE.4) WRITE(6,*) 'DEBUT DE RAYE1.ESO' SEGACT ICHFAC NBS = ICHFAC.IMACHE(/1) C **** NBS designe le nombre de sous maillages de type **** C **** tri3, qua4 ... **** SEGACT INFOEL NBEL = 0 DO 10 I = 1, NBS ISSM = ICHFAC.IMACHE(I) SEGACT ISSM NBEL = NBEL + ISSM.NUM(/2) IF (KCOQ(I)) THEN C **** S'il y a des elements COQ, on rajoute **** C **** une ligne. **** NBEL = NBEL + ISSM.NUM(/2) ENDIF SEGDES ISSM 10 CONTINUE SEGDES INFOEL C **** NBEL designe le nombre total d'elements sur la **** C **** frontiere du maillage **** NBEL1 = NBEL + 1 C **** On rajoute une dimension a la matrice MATR pour **** C **** stocker la ligne donnant la surface des elements**** C **** On a donc une matrice de taille NBEL*(NBEL+1) **** SEGINI MATR C ********************************************************** C **** Interface CHAMELEM --> MATRICE **** C ********************************************************** C ********************************************************** C **** PASSAGE DES VALEURS DES SURFACES **** C **** On calcule d'abord la dimension du vecteur PSUR **** C **** Theoriquement, on doit trouver Nbel. Par **** C **** precaution, on le verifie. **** C ********************************************************** SEGACT INFOEL NBEL2 = 0 DO 20 NSMA = 1, NBS IMCHFA = ICHFAC.ICHAML(NSMA) meleme=ichfac.imache(NSMA) segact meleme nbela= num(/2) SEGACT IMCHFA IF (KCOQ(NSMA)) then nbela=nbela*2 ISURF = IMCHFA.IELVAL(3) else ISURF = IMCHFA.IELVAL(2) endif SEGDES IMCHFA nbel2=nbel2+nbela 20 continue C ********************************************************** C **** Si on a des elements COQ **** C ********************************************************** * SEGACT IMCHFA * ISURF = IMCHFA.IELVAL(3) * SEGDES IMCHFA * * SEGACT ISURF * NBELA = ISURF.VELCHE(/2) C Rajout du doublement des surfaces * NBELA = NBELA + NBELA * SEGDES ISURF * C SI KCOQ(NSMA) = FALSE * ELSE * C ********************************************************** C **** Si on n'a pas d'elements COQ **** C ********************************************************** * * SEGACT IMCHFA * ISURF = IMCHFA.IELVAL(2) * SEGDES IMCHFA * * SEGACT ISURF * NBELA = ISURF.VELCHE(/2) * SEGDES ISURF * * ENDIF * * NBEL2 = NBEL2 + NBELA * * 20 CONTINUE IF (IIMPI.GE.4.AND.NBEL.NE.NBEL2) THEN WRITE(6,*) 'Dimensions incompatibles' ENDIF SEGINI PSUR K = 0 C **** Apres avoir verifie les dimensions, on passe **** C **** les valeurs dans le vecteur PSUR. **** DO 30 NSMA = 1, NBS IMCHFA = ICHFAC.ICHAML(NSMA) meleme= ICHFAC.imache(nsma) IF (KCOQ(NSMA)) THEN C ********************************************************** C **** Si on a des elements COQ **** C ********************************************************** SEGACT IMCHFA ISURF = IMCHFA.IELVAL(3) SEGDES IMCHFA SEGACT ISURF NBELA = ISURF.VELCHE(/2) DO 40 I = 1, Num(/2) K = K + 1 ima= min ( i,nbela) PSUR.FACT(K) = ISURF.VELCHE(1,Ima) K = K + 1 ima= min ( i,nbela) PSUR.FACT(K) = ISURF.VELCHE(1,Ima) IF (IIMPI.GE.4) THEN WRITE(6,*) 'SURF = ', ISURF.VELCHE(1,Ima) ENDIF 40 CONTINUE SEGDES ISURF C SI KCOQ(NSMA) = FALSE ELSE C ********************************************************** C **** Si on n'a pas d'elements COQ **** C ********************************************************** SEGACT IMCHFA ISURF = IMCHFA.IELVAL(2) SEGDES IMCHFA SEGACT ISURF NBELA = ISURF.VELCHE(/2) DO 45 I = 1, Num(/2) K = K + 1 ima= min( i,nbela) PSUR.FACT(K) = ISURF.VELCHE(1,Ima) IF (IIMPI.GE.4) THEN WRITE(6,*) 'SURF 2= ', ISURF.VELCHE(1,Ima) ENDIF 45 CONTINUE SEGDES ISURF ENDIF 30 CONTINUE C **** Le vecteur PSUR est de dimension K et est place **** C **** en derniere ligne de MATR. **** IF (IIMPI.GE.4.AND.K.NE.NBEL2) THEN WRITE(6,*) 'K = ',K ,'NBEL2 = ', NBEL2 WRITE(6,*) 'Ces deux nombres doivent etre egaux' ENDIF MATR.LFACT(NBEL1) = PSUR SEGDES PSUR C ********************************************************** C **** PASSAGE DES VALEURS DES FACTEURS DE FORME **** C ********************************************************** C ********************************************************** C **** On se positionne d'abord dans un sous-domaine **** C ********************************************************** I = 0 C **** I designe l'indice de la ligne I de la matrice **** C **** MATR. **** DO 50 NSMA = 1, NBS IMCHFA = ICHFAC.ICHAML(NSMA) IF (IIMPI.GE.4) THEN WRITE(6,*) 'DIM INFOEL =', INFOEL.KCOQ(/1) WRITE(6,*) 'KCOQ = ', KCOQ(NSMA) ENDIF IF (KCOQ(NSMA)) THEN C ********************************************************** C **** Si on a des elements COQ dans la partie sup **** C ********************************************************** SEGACT IMCHFA IFFAS = IMCHFA.IELVAL(1) IFFAI = IMCHFA.IELVAL(2) SEGDES IMCHFA SEGACT IFFAS, IFFAI NBELA = IFFAS.IELCHE(/2) IF (IIMPI.GE.4) THEN WRITE(6,*) 'NBELA = ',NBELA ENDIF C **** NBELA designe le nombre d'elements du sous **** C **** domaine d'indice NSMA. **** C ********************************************************** C **** Puis, on pointe sur les numeros des elements du **** C **** maillage **** C ********************************************************** DO 60 NELMA = 1, NBELA I = I + 1 ISSCHS = IFFAS.IELCHE(1,NELMA) ISSCHI = IFFAI.IELCHE(1,NELMA) SEGINI PLIGI, PLIGS SEGACT ISSCHS NBS2 = ISSCHS.ICHAML(/1) SEGACT ISSCHI NBS3 = ISSCHI.ICHAML(/1) IF (NBS2.NE.NBS3) THEN WRITE(6,*) 'Erreur de dimension' ENDIF J = 0 C **** J designe l'indice de la colonne J de la **** C **** matrice MATR. **** DO 70 NSMB = 1, NBS2 IF (KCOQ(NSMB)) THEN C **** S'il y a des elements COQ dans la partie inf **** ICHFBI = ISSCHI.ICHAML(NSMB) ICHFBS = ISSCHS.ICHAML(NSMB) SEGACT ICHFBI IFFBII = ICHFBI.IELVAL(1) IFFBIS = ICHFBI.IELVAL(2) SEGDES ICHFBI SEGACT ICHFBS IFFBSI = ICHFBS.IELVAL(1) IFFBSS = ICHFBS.IELVAL(2) SEGDES ICHFBS SEGACT IFFBII, IFFBIS SEGACT IFFBSI, IFFBSS NBELB = IFFBSI.VELCHE(/2) C ********************************************************** C **** Et enfin, on pointe sur une surface de ce **** C **** deuxieme domaine. **** C ********************************************************** DO 80 NELB = 1, NBELB J = J + 1 PLIGI.FACT(J) = IFFBIS.VELCHE(1,NELB) PLIGS.FACT(J) = IFFBSS.VELCHE(1,NELB) J = J + 1 PLIGI.FACT(J) = IFFBII.VELCHE(1,NELB) PLIGS.FACT(J) = IFFBSI.VELCHE(1,NELB) 80 CONTINUE SEGDES IFFBII, IFFBIS SEGDES IFFBSI, IFFBSS C **** On a boucle sur tous les elements du sous **** C **** maillage d'indice NSMB. **** C **** si KCOQ(NSMB) = FALSE **** ELSE C **** S'il n'y a pas d'elements COQ dans la partie inf**** ICHFBI = ISSCHI.ICHAML(NSMB) ICHFBS = ISSCHS.ICHAML(NSMB) SEGACT ICHFBI IFFBIM = ICHFBI.IELVAL(1) SEGDES ICHFBI SEGACT ICHFBS IFFBSM = ICHFBS.IELVAL(1) SEGDES ICHFBS SEGACT IFFBSM, IFFBIM NBELB = IFFBSM.VELCHE(/2) DO 90 NELB = 1, NBELB J = J + 1 PLIGI.FACT(J) = IFFBIM.VELCHE(1,NELB) PLIGS.FACT(J) = IFFBSM.VELCHE(1,NELB) 90 CONTINUE SEGDES IFFBIM, IFFBSM ENDIF 70 CONTINUE C **** Test de verification **** IF (IIMPI.GE.4) THEN WRITE(6,*) 'Dimension du vecteur fforme =',J ENDIF C **** On a boucle sur tous les sous maillages. **** SEGDES ISSCHS, ISSCHI MATR.LFACT(I) = PLIGS I = I + 1 MATR.LFACT(I) = PLIGI SEGDES PLIGI, PLIGS 60 CONTINUE SEGDES IFFAI, IFFAS C **** si KCOQ(NSMA) = FALSE **** ELSE IF (IIMPI.GE.4) THEN WRITE(6,*) 'il n''y a pas d''elements COQ en haut' ENDIF C ********************************************************** C **** SI ON N'A PAS D'ELEMENTS COQ DANS LA PARTIE SUP **** C ********************************************************** SEGACT IMCHFA IFFA = IMCHFA.IELVAL(1) SEGDES IMCHFA SEGACT IFFA NBELA = IFFA.IELCHE(/2) IF (IIMPI.GE.4) THEN WRITE(6,*) 'NBELA = ',NBELA ENDIF C **** NBELA designe le nombre d'elements du sous **** C **** domaine d'indice NSMA. **** C ********************************************************** C **** Puis, on pointe sur les numeros des elements du **** C **** maillage **** C ********************************************************** DO 160 NELMA = 1, NBELA I = I + 1 ISSCH = IFFA.IELCHE(1,NELMA) SEGINI PLIG SEGACT ISSCH J = 0 C **** J designe l'indice de la colonne J de la **** C **** matrice MATR. **** NBS2 = ISSCH.ICHAML(/1) C **** Theoriquement, NBS2 = NBS. **** IF (IIMPI.GE.4.AND.NBS.NE.NBS2) THEN WRITE(6,*) 'Probleme de dimension' ENDIF DO 170 NSMB = 1, NBS2 ICHFB = ISSCH.ICHAML(NSMB) IF (KCOQ(NSMB)) THEN C **** S'il y a des elements COQ dans la partie inf **** SEGACT ICHFB IFFBI = ICHFB.IELVAL(1) IFFBS = ICHFB.IELVAL(2) SEGDES ICHFB SEGACT IFFBI NBELB = IFFBI.VELCHE(/2) SEGACT IFFBS DO 180 NELB = 1, NBELB J = J + 1 PLIG.FACT(J) = IFFBS.VELCHE(1,NELB) J = J + 1 PLIG.FACT(J) = IFFBI.VELCHE(1,NELB) 180 CONTINUE SEGDES IFFBI, IFFBS C **** On a boucle sur tous les elements du sous **** C **** maillage d'indice NSMB. **** C **** si KCOQ(NSMB) = FALSE **** ELSE C **** S'il n'y a pas d'elements COQ dans la partie inf**** SEGACT ICHFB IFFB = ICHFB.IELVAL(1) SEGDES ICHFB SEGACT IFFB NBELB = IFFB.VELCHE(/2) DO 190 NELB = 1, NBELB J = J + 1 PLIG.FACT(J) = IFFB.VELCHE(1,NELB) 190 CONTINUE SEGDES IFFB ENDIF 170 CONTINUE C **** Test de verification **** IF (J.NE.NBEL2) THEN WRITE(6,*) 'Erreur de dimension' ENDIF C **** On a boucle sur tous les sous maillages. **** SEGDES ISSCH MATR.LFACT(I) = PLIG SEGDES PLIG 160 CONTINUE C **** On a boucle sur tous les elements du sous **** C **** maillage d'indice NSMA. **** SEGDES IFFA ENDIF 50 CONTINUE C **** Test de verification **** IF (IIMPI.GE.4.AND.I.NE.NBEL2) THEN WRITE(6,*) 'Erreur de dimension' ENDIF C **** On a boucle sur tous les sous maillages. **** C ********************************************************** C **** Desactivation des segments inutiles **** C ********************************************************** SEGDES MATR, INFOEL SEGDES ICHFAC SEGDES IMCHFA IF (IIMPI.GE.4) WRITE(6,*) 'FIN DE RAYE1.ESO OK' RETURN END