C MANURI SOURCE BP208322 12/03/08 21:15:03 7293 SUBROUTINE MANURI ************************************************************************ * * M A N U R I * ----------- * * SOUS-PROGRAMME ASSOCIE A L'OPTION "RIGIDITE" DE L'OPERATEUR * "MANUEL". * * FONCTION: * --------- * * CREER, EN LISANT EXPLICITEMENT SES COMPOSANTS, UN OBJET 'RIGIDITE' * DANS LEQUEL TOUTES LES MATRICES DE RIGIDITE ELEMENTAIRES SONT LES * MEMES. * CAS PARTICULIER FREQUENT: LA 'RIGIDITE' S'APPUIE SUR UN SEUL * ELEMENT GEOMETRIQUE ET ELLE NE CONTIENDRA QU'UNE SEULE MATRICE * ELEMENTAIRE. * * PHRASE D'APPEL (EN GIBIANE): * ---------------------------- * * AA = MANUEL RIGIDITE (BB) CC
('DUAL' ) ('ANTI') ; * * LES PARENTHESES INDIQUANT DES OPERANDES FACULTATIFS ET LES * CROCHETS DES OPERANDES POUVANT ETRE REPETES. * * OPERANDES ET RESULTATS: * ----------------------- * * BB 'MOT ' SOUS-TYPE DE LA 'RIGIDITE' QUE L'ON CREE. * CE SOUS-TYPE S'ECRIVANT SUR 8 CARACTERES, ET * UN 'MOT' NE COMPORTANT ACTUELLEMENT QUE 4 * CARACTERES, ON DOIT PROVISOIREMENT FOURNIR * NON PAS 1 MAIS 2 MOTS "BB1" ET "BB2". * CC 'MAILLAGE' SUPPORT GEOMETRIQUE. * DD 'LISTMOTS' CONTIENT LES NOMS DES COMPOSANTES POUR UN * NOEUD D'UN ELEMENT DE "CC". * SI TOUS LES NOEUDS D'UN MEME ELEMENT DE "CC" * N'ONT PAS LES MEMES COMPOSANTES, ON DONNE * PLUSIEURS 'LISTMOTS' (PLUS PRECISEMENT * AUTANT DE 'LISTMOTS' QU'IL Y A DE NOEUDS * PAR ELEMENT). C+PP C ILS PEUVENT ETRE CONTENUS DANS UNE TABLE C (IDEM POUR FF) C+PP * FF 'LISTMOTS' CONTIENT LES NOMS DES INCONNUES DUALES * AUTANT DE 'LISTMOTS' QUE POUR LES INCONNUES * EE 'LISTREEL' SI 1 SEUL "EE" EST FOURNI: * IL CONTIENT TOUS LES TERMES DU TRIANGLE * INFERIEUR DE LA MATRICE ELEMENTAIRE, LIGNE * PAR LIGNE. * SI PLUSIEURS "EE" SONT FOURNIS: * IL DOIT Y AVOIR AUTANT DE 'LISTREEL' QU'IL * Y A DE LIGNES DANS LA MATRICE ELEMENTAIRE, * LE N-IEME 'LISTREEL' DECRIVANT LA N-IEME * LIGNE DE LA MATRICE DU BORD GAUCHE JUSQU'A * LA DIAGONALE. * AA 'RIGIDITE' OBJET CREE. * * EXEMPLE D'ENTREE DE LA MATRICE ELEMENTAIRE: * * | A B C | * | B D E | * | C E F | * * PEUT ETRE DONNEE PAR: (PROG A B D C E F) * OU BIEN PAR: (PROG A) (PROG B D) (PROG C E F) * * "PROG" ETANT L'OPERATEUR DE CREATION D'UN 'LISTREEL'. * * LEXIQUE: (ORDRE ALPHABETIQUE) * -------- * * IPELEM ENTIER POINTEUR DU SUPPORT GEOMETRIQUE "CC". * IPRIGI ENTIER POINTEUR DE LA 'RIGIDITE' "AA". * LETYPE ENTIER SOUS-TYPE DE L'OBJET 'RIGIDITE' (CONTIENT UNE * CHAINE DE CARACTERES). * MTEMP3 SEGMENT CONTIENT LE(S) POINTEUR(S) DU (DES) 'LISTMOTS' * "DD". * MTEMP4 SEGMENT CONTIENT LE(S) POINTEUR(S) DU (DES) 'LISTREEL' * "EE". * * SOUS-PROGRAMMES APPELES: * ------------------------ * * ECRIRE, LIRE, LIRMO8, MANUR1. * * REMARQUES: * ---------- * * ACTUELLEMENT, L'OBJET 'MAILLAGE' "CC" DOIT CONTENIR DES ELEMENTS * GEOMETRIQUES TOUS DE MEME TYPE. * * AUTEUR, DATE DE CREATION: * ------------------------- * * PASCAL MANIGOT 19 FEVRIER 1985 * Lionel VIVAN 12 juin 1991, ajout du mot clé ANTI * Michel BULIK 29 novembre 1995, ajout du mot clé QUEL * Stephane Gounand 08 mai 2011, ajout de la syntaxe MANU RIGI * CHPO1 permettant de créer une rigidité * diagonale * Benoit Prabel 16 fevrier 2012 : ajout des options COLOnnes * et LIGNes pour la syntaxe avec un chpoint * + possibilité rigidité vide * * LANGAGE: * -------- * * ESOPE + FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS * ************************************************************************ * IMPLICIT INTEGER(I-N) -INC CCOPTIO -INC SMRIGID C+PP -INC SMTABLE CHARACTER*8 TYPOBJ,CH0,CH1 REAL*8 X0,X1 INTEGER I1 LOGICAL L0,L1 C+PP * SEGMENT /MTEMP3/ (ILMOTS(0)),MTEM3.MTEMP3 SEGMENT /MTEMP4/ (ILREEL(0)) * PARAMETER (INFINI = 9999) * CHARACTER*8 LETYPE,CTYP CHARACTER*4 MODUA(1),MOTYP(2),MOMOT(1) CHARACTER*4 MOCLE(3) * DATA MODUA(1) /'DUAL'/ DATA MOTYP(1),MOTYP(2) /'ANTI','QUEL'/ DATA MOMOT(1) /'TYPE'/ DATA MOCLE(1),MOCLE(2),MOCLE(3) /'DIAG','COLO','LIGN'/ C c C=== Syntaxe b : Rig1 = MANU RIGI (mocle) CHPO1 (...) ==================== c * * -- LECTURE EVENTUELLE DU MOT CLE : DIAG ou COLO ou LIGN ... -- * ICLE = 0 CALL LIRMOT(MOCLE,3,ICLE,0) if(iimpi.ge.1) write(IOIMP,*) 'ICLE=',ICLE * * -- LECTURE DU CHPOINT ? -- * IF (ICLE.NE.0) THEN c cas ou on a lu DIAG, COLO ou LIGN CALL LIROBJ('CHPOINT ',MCHPOI,1,IRET) IF (IERR.NE.0) RETURN ELSE c si aucun mot clé mais présence d'un chpoint, option DIAG par défaut CALL QUETYP(CTYP,0,IRETOU) IF (IRETOU.EQ.0) THEN c CALL ERREUR(533) c si rien du tout, CREATION D'UNE RIGIDITE VIDE NRIGEL=0 segini,MRIGID IPRIGI=MRIGID MTYMAT='MANUELLE' IFORIG= IFOMOD ICHOLE = 0 IMGEO1 = 0 IMGEO2 = 0 IFORIG = 0 c ISUPEQ,JRCOND,JRDEPP,JRDEPD = 0 c JRELIM,JRGARD,JRTOT,IMLAG = 0 c IPROFO,IVECRI = 0 segdes,MRIGID CALL ECROBJ ('RIGIDITE',IPRIGI) RETURN ENDIF IF(CTYP.EQ.'CHPOINT ') THEN ICLE = 1 CALL LIROBJ(CTYP,MCHPOI,1,IRET) IF (IERR.NE.0) RETURN ENDIF ENDIF * * -- CREATION RIGIDITE DEPUIS UN CHPOINT -- * IF (ICLE.NE.0) THEN IF (ICLE.eq.1) THEN c rigidite diagonale CALL KOPDIR(MCHPOI,MRIGID) ELSE c rigidite colonne ou ligne CALL RICOLO(MCHPOI,ICLE,MRIGID) ENDIF IF (IERR.NE.0) RETURN CALL ECROBJ('RIGIDITE',MRIGID) RETURN ENDIF c c C=== Syntaxe a : Rig1 = MANU RIGI (TYPE mot1) GEO1 LMOT1 (...) LREEL1 ==== c * * -- LECTURE DU SOUS-TYPE DE LA "RIGIDITE" A CREER -- * ITYP = 0 CALL LIRMOT(MOMOT,1,ITYP,0) IF(ITYP.EQ.1) THEN ICODE = 1 CALL LIRCHA (LETYPE,ICODE,IRETOU) IF (IERR .NE. 0) RETURN ELSE C ... Si on n'a rien trouvé, on met les blancs dedans, C sinon il y a des cochonneries ... LETYPE=' ' ENDIF * * -- LECTURE DU SUPPORT GEOMETRIQUE -- * CALL LIROBJ('POINT ',KPOINT,0,IRETOU) IF(IRETOU.NE.0) THEN CALL CRELEM(KPOINT) IPELEM=KPOINT ELSE ICODE = 1 CALL LIROBJ ('MAILLAGE',IPELEM,ICODE,IRETOU) IF (IERR .NE. 0) RETURN ENDIF * * -- LECTURE DU (OU DES) "LISTMOTS" CONTENANT LES NOMS DES * COMPOSANTES DES NOEUDS D'UN ELEMENT DU SUPPORT GEOMETRIQUE -- * SEGINI,MTEMP3 IINCO=MTEMP3 C+PP CALL LIROBJ ('TABLE',MTABLE,0,IRETOU) IF (IRETOU.EQ.1)THEN DO IE1=1,INFINI TYPOBJ=' ' CALL ACCTAB(MTABLE,'ENTIER',IE1,X0,CH0,L0,IOBIN, $ TYPOBJ ,I1 ,X1,CH1,L1,IPLMOT) IF (TYPOBJ .EQ. 'LISTMOTS')THEN ILMOTS(**) = IPLMOT ELSE IF (IE1 .EQ. 1)THEN CALL ERREUR(314) SEGSUP MTEMP3 RETURN ENDIF * --> SORTIE DE BOUCLE N.100 GOTO 102 ENDIF ENDDO ENDIF C+PP ICODE = 1 DO 100 IB100=1,INFINI CALL LIROBJ ('LISTMOTS',IPLMOT,ICODE,IRETOU) IF(IERR.NE.0) THEN SEGSUP MTEMP3 RETURN ENDIF IF (IRETOU .EQ. 1) THEN ILMOTS(**) = IPLMOT ELSE * --> SORTIE DE BOUCLE N.100 GOTO 102 END IF ICODE = 0 100 CONTINUE * END DO 102 CONTINUE SEGDES,MTEMP3 * * -- LECTURE DU (OU DES) "LISTMOTS" CONTENANT LES NOMS DES * DUALES * IDUAL=0 CALL LIRMOT(MODUA,1,IDU,0) IF (IDU.EQ.0) GOTO 400 SEGINI,MTEM3 C+PP CALL LIROBJ ('TABLE',MTABLE,0,IRETOU) IF (IRETOU.EQ.1)THEN DO IE1=1,INFINI TYPOBJ=' ' CALL ACCTAB(MTABLE,'ENTIER',IE1,X0,CH0,L0,IOBIN, $ TYPOBJ ,I1 ,X1,CH1,L1,IPLMOT) IF (TYPOBJ .EQ. 'LISTMOTS')THEN MTEM3.ILMOTS(**) = IPLMOT ELSE IF (IE1 .EQ. 1)THEN CALL ERREUR(314) SEGSUP MTEMP3,MTEM3 RETURN ENDIF GOTO 302 ENDIF ENDDO ENDIF C+PP ICODE = 1 DO 300 IB300=1,INFINI CALL LIROBJ ('LISTMOTS',IPLMOT,ICODE,IRETOU) IF(IERR.NE.0) THEN SEGSUP MTEMP3,MTEM3 RETURN ENDIF IF (IRETOU .EQ. 1) THEN MTEM3.ILMOTS(**) = IPLMOT ELSE GOTO 302 END IF ICODE = 0 300 CONTINUE 302 CONTINUE SEGACT MTEMP3 IF (ILMOTS(/1).NE.MTEM3.ILMOTS(/1)) THEN SEGSUP MTEMP3 SEGSUP MTEM3 CALL ERREUR(730) RETURN ENDIF IDUAL=MTEM3 SEGDES MTEM3 SEGDES MTEMP3 * * Lecture du mot clé 'ANTI' ou 'QUEL' * 400 CONTINUE IAN = 0 CALL LIRMOT(MOTYP,2,IAN,0) IANTI = IAN * * -- LECTURE DU (OU DES) "LISTREEL" CONTENANT LA MATRICE * ELEMENTAIRE DE RIGIDITE -- * 500 CONTINUE SEGINI,MTEMP4 ICODE = 1 DO 200 IB200=1,INFINI CALL LIROBJ ('LISTREEL',IPLREE,ICODE,IRETOU) IF(IERR.NE.0) THEN SEGSUP MTEMP3,MTEM3 SEGSUP MTEMP4 RETURN ENDIF IF (IRETOU .EQ. 1) THEN ILREEL(**) = IPLREE ELSE * --> SORTIE DE BOUCLE N.200 GOTO 202 END IF ICODE = 0 200 CONTINUE * END DO 202 CONTINUE SEGDES,MTEMP4 * * -- CREATION DE LA "RIGIDITE" -- * CALL MANUR1 (LETYPE,IPELEM,IINCO,IDUAL,MTEMP4,IPRIGI,IANTI) IF (IERR .NE. 0) RETURN * * SUPPRESSION DES SEGMENTS DE TRAVAIL: MTEMP3=IINCO SEGSUP MTEMP3 IF (IDUAL.NE.0) THEN MTEMP3=IDUAL SEGSUP MTEMP3 ENDIF SEGSUP,MTEMP4 * CALL ECROBJ ('RIGIDITE',IPRIGI) * END