C MANUR4 SOURCE PV090527 26/04/30 21:15:51 12529 SUBROUTINE MANUR4 (IPELEM,IPDESC,MTEMP4,IPMATR,IANTI) ************************************************************************ * * M A N U R 4 * ----------- * * FONCTION: * --------- * * CONSTRUCTION DES MATRICES ELEMENTAIRES DE RIGIDITE POUR UN OBJET * 'RIGIDITE' CREE MANUELLEMENT. * L'UTILISATION DE CE SOUS-PROGRAMME N'EST PAS UNIVERSELLE. * * MODE D'APPEL: * ------------- * * CALL MANUR4 (IPELEM,IPDESC,MTEMP4,IPMATR,IANTI) * * PARAMETRES: (E)=ENTREE (S)=SORTIE * ----------- * * IPELEM ENTIER (E) POINTEUR DE L'OBJET 'MAILLAGE' SUR LEQUEL * VA S'APPUYER LA 'RIGIDITE'. * IPDESC ENTIER (E) POINTEUR SUR LE SEGMENT DESCRIPTEUR DE * L'OBJET 'RIGIDITE'. * MTEMP4 SEGMENT (E) REGROUPEMENT DE POINTEURS SUR DES * 'LISTREEL'. * SOIT IL N'Y A QU'1 'LISTREEL', QUI CONTIENT * TOUS LES TERMES DE LA * MATRICE ELEMENTAIRE DE RIGIDITE, ECRITS * LIGNE PAR LIGNE, * SOIT IL Y A AUTANT DE 'LISTREEL' QUE DE * LIGNES DANS LA MATRICE ELEMENTAIRE DE * RIGIDITE, LE N-IEME 'LISTREEL' DECRIVANT LA * N-IEME LIGNE DE LA MATRICE . * IPMATR ENTIER (S) POINTEUR SUR LE SEGMENT CONTENANT LA LISTE * DES POINTEURS DES MATRICES ELEMENTAIRES DE * RIGIDITE. * * EXEMPLE DE PRESENTATION DE LA MATRICE ELEMENTAIRE : * | A B C | * | D E F | * | G H I | * Elle peut etre donnee par: (PROG A B C D E F G H I ) * ou bien par : (PROG A B C ) (PROG D E F) (PROG G H I ) * si la matrice est symetrique ou antisymetrique on peut aussi * la decrire par 1 LISTREEEL : (PROG A D E G H I ) * ou bien par plusieurs LISTREEL : (PROG A ) (PROG D E) (PROG G H I) * * LEXIQUE: (ORDRE ALPHABETIQUE) * -------- * * LONG ENTIER LONGUEUR DU 'LISTREEL' TRAITE. * NBLREE ENTIER NOMBRE DE 'LISTREEL' REFERENCES PAR "MTEMP4". * * LES AUTRES VARIABLES IMPORTANTES SONT EXPLIQUEES DANS LES MODULES * INCLUS. * ************************************************************************ * IMPLICIT INTEGER(I-N) LOGICAL ZTRI -INC PPARAM -INC CCOPTIO -INC SMELEME -INC SMLREEL -INC SMRIGID -INC CCREEL * SEGMENT /MTEMP4/ (ILREEL(0)) ************************************************************************ * INITIALISATIONS ET OUVERTURE ************************************************************************ * MELEME = IPELEM SEGACT,MELEME NELRIG = NUM(/2) SEGDES,MELEME * DESCR = IPDESC SEGACT,DESCR C ... La distinction entre les deux nombres est un peu artificielle, C car manur3 vérifie si les listmots sont de longueurs égales, C on en a juste besoin pour initialiser XMATRI ... NLIGRP = NOELEP(/1) NLIGRD = NOELED(/1) C ... LVAL = nombre de termes d'une matrice pleine ... LVAL = NLIGRP * NLIGRD SEGDES,DESCR * rigrel=0 SEGINI,xMATRI IPMATR = xMATRI * SEGINI,XMATRI * DO 100 IB100=1,NELRIG * IMATTT(IB100) = XMATRI * 100 CONTINUE * END DO * SEGDES,IMATRI * * RQ: "XMATRI" EST GARDE ACTIF. * SEGACT,MTEMP4 NBLREE = ILREEL(/1) * ************************************************************************ * Cas 1 seul LISTREEL ************************************************************************ IF (NBLREE .EQ. 1) THEN * MLREEL = ILREEL(1) SEGACT,MLREEL C ... LVA1 = nombre de termes d'une matrice carrée défini par C sa moitié ... LVA1=NLIGRP*(NLIGRP+1)/2 IF (LVAL .NE. PROG(/1).AND.PROG(/1).NE.LVA1 ) THEN NUMERR = 199 PRINT *,'On attend ',LVAL, ' termes',NLIGRP CALL ERREUR (NUMERR) RETURN END IF * C ... ILA = N° de ligne de la matrice élémentaire ... ILA=1 C ... ILC = N° de colonne de la matrice élémentaire ... ILC=1 C ... ZTRI dit si toutes les composantes ont été données ou C juste le triangle inférieur ... ZTRI=.FALSE. cbp IF(PROG(/1).EQ.LVA1) ZTRI=.TRUE. IF(PROG(/1).EQ.LVA1.AND.PROG(/1).NE.LVAL) ZTRI=.TRUE. IF(ZTRI .AND. IANTI.EQ.2) THEN CALL ERREUR(731) C ... On laisse les cochonneries dans XMATRI ... * SEGDES,XMATRI C ... puis on s'en va ... RETURN ENDIF DO 200 IB200=1,PROG(/1) RE(ILA,ILC,1) = PROG(IB200) IF(ZTRI) THEN IF(IANTI.EQ.1) THEN RE(ILC,ILA,1)=-PROG(IB200) ELSE RE(ILC,ILA,1)=PROG(IB200) ENDIF ENDIF ILC=ILC+1 C ... On passe à la ligne si on a traversé la diagonale (cas triangulaire) ... IF(ILC.GT.ILA.AND. ZTRI) THEN ILC=1 ILA=ILA+1 ENDIF C ... On passe à la ligne si on est au bout (cas plein) ... IF(ILC.GT.NLIGRP) THEN ILC=1 ILA=ILA+1 ENDIF 200 CONTINUE do ib=2,nelrig do io=1,nligrp do iu=1,nligrd re(iu,io,ib)=re(iu,io,1) enddo enddo enddo * END DO * SEGDES,MLREEL ************************************************************************ * Cas plusieurs LISTREEL ************************************************************************ ELSE IF (NBLREE .GT. 1) THEN * IF (NBLREE .EQ. NLIGRD) THEN * MLREEL=ILREEL(1) SEGACT MLREEL C ... Cas triangulaire ? ... ZTRI=.FALSE. IF(PROG(/1).EQ.1) ZTRI=.TRUE. IF(ZTRI .AND. IANTI.EQ.2) THEN CALL ERREUR(731) C ... On laisse les cochonneries dans XMATRI ... * SEGDES,XMATRI C ... puis on s'en va ... RETURN ENDIF C ... Boucle sur les lignes (IB300 = N° de la ligne) ... DO 300 IB300=1,NBLREE * MLREEL = ILREEL(IB300) SEGACT,MLREEL LONG = PROG(/1) C ... Cas lignes pleines : longueur doit être NLIGRP ... IF (.not.ZTRI .AND. LONG.NE.NLIGRP) THEN NUMERR = 200 CALL ERREUR (NUMERR) RETURN END IF C ... Cas triangulaire : longueur doit être N° de la ligne ... IF (ZTRI .AND. LONG.NE.IB300) THEN NUMERR = 200 CALL ERREUR (NUMERR) RETURN END IF C ... Boucle sur les colonnes (IB310 = N° de la colonne) ... DO 310 IB310=1,LONG RE(IB300,IB310,1) = PROG(IB310) IF(IANTI.EQ.1.AND.ZTRI) RE(IB310,IB300,1)=-RE(IB300,IB310,1) IF(IANTI.EQ.0.AND.ZTRI) RE(IB310,IB300,1)=RE(IB300,IB310,1) 310 CONTINUE * END DO * SEGDES,MLREEL * 300 CONTINUE do ib=2,nelrig do io=1,nligrp do iu=1,nligrd re(iu,io,ib)=re(iu,io,1) enddo enddo enddo * END DO C ... c.à.d. le nombre de LISTREEL est différent du nombre de variables duales ... ELSE * NUMERR = 201 CALL ERREUR (NUMERR) RETURN * END IF ************************************************************************ * Cas aucun LISTREEL ! ************************************************************************ ELSE * * AUCUN 'LISTREEL' N'A ETE FOURNI EN DONNEE. MOTERR(1:8) = 'LISTREEL' NUMERR = 37 CALL ERREUR (NUMERR) RETURN * END IF ************************************************************************ * VERIFICATION EN FONCTION DES CAS (ajout, bp 2020) ************************************************************************ IF(IANTI.EQ.0) THEN XMATRI.SYMRE=0 IF(.NOT.ZTRI) THEN * SI SYM ET COMPLET : VERIF DES TERMES EXTRA-DIAGONAUX Aij=Aji call versym(re,re(/1),re(/2),re(/3),IANTI) if (ierr.ne.0) return * ELSE * SI SYM ET TRIANGULAIRE : PAS DE VERIF ENDIF ELSEIF(IANTI.EQ.1) THEN XMATRI.SYMRE=1 IF(ZTRI) THEN * SI ANTI-SYM ET TRIANGULAIRE : VERIF DE LA DIAGONALE xzref=(xpetit/xzprec) do iel=1,re(/3) do ir=1,re(/1) re1=re(ir,ir,iel) if (abs(re1).gt.xzref) then MOTERR(1:15)='ANTI-SYMETRIQUE' reaerr(1)=re1 reaerr(2)=0.D0 reaerr(3)=abs(re1) call erreur(1044) return endif enddo enddo ELSE * SI ANTI-SYM ET COMPLET : VERIF DE TOUS LES TERMES Aij=-Aji call versym(re,re(/1),re(/2),re(/3),IANTI) if (ierr.ne.0) return ENDIF ELSE * SI QUELCONQUE : On place SYMRE XMATRI.SYMRE=2 ENDIF SEGDES,XMATRI SEGDES,MTEMP4 END