C RICOLO SOURCE BP208322 13/10/17 21:15:00 7842 C SUBROUTINE RICOLO(MCHPOI,ICLE,MRIGID) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER (I-N) C*********************************************************************** C NOM : RICOLO C DESCRIPTION : Transforme un CHPOINT MCHPOI en matrice colonne MRIGID C En pratique on fait plein de matrices carrées 2x2 C LANGAGE : ESOPE C C AUTEUR, DATE, MODIF : C 16/02/2012, Benoit Prabel : creation C C ... merci de compléter les evolutions futures ... C C*********************************************************************** C ENTREES : MCHPOI (+ autres lectures internes a ricolo) C ENTREES/SORTIES : C SORTIES : MRIGID C*********************************************************************** -INC CCOPTIO -INC SMRIGID -INC SMCHPOI -INC SMELEME -INC CCHAMP CHARACTER*4 MODUAL,MOPRIM CHARACTER*4 MOSYM(3),MOOPT(2) DATA MOSYM/'SYME','ANTI','QUEL'/ DATA MOOPT/'PRIM','DUAL'/ LOGICAL fldiag c*********************************************************************** c Executable statements c*********************************************************************** c======================================================================c c RECUPERATION DES AUTRES OBJETS d ENTREE ET VERIFICATION DES DONNEES c colonne ou ligne = seuls choix possibles IF(ICLE.ne.2.and.ICLE.ne.3) THEN write(IOIMP,*) 'VALEUR DE ICLE ERRONNEE =',ICLE & ,' LORS DE L APPEL A RICOLO ERRONNE' CALL ERREUR(21) ENDIF c symetrique, antisymetrique ou quelconque (syme par defaut) ISYM = 0 CALL LIRMOT(MOSYM,3,ISYM,0) if(ISYM.eq.0) ISYM=1 * LECTURE DU SUPPORT GEOMETRIQUE (1 seul point admis pour l instant) CALL LIROBJ('POINT ',KPOINT,1,IRETOU) IF(IRETOU.EQ.0) CALL ERREUR(20) IF(IERR.NE.0) RETURN c CALL CRELEM(KPOINT) c IPELEM=KPOINT * LECTURE DU NOM DU PRIMAL/DUAL (selon option colonne/ligne ) * ASSOCIE A KPOINT + deduction de l'autre idd1=0 c option colonne : on cherche l inconnue primale IF(ICLE.eq.2) THEN CALL LIRMOT(NOMDD,LNOMDD,idd1,0) if (idd1.ne.0) then MOPRIM=NOMDD(idd1) MODUAL=NOMDU(idd1) c si mot clé 'DUAL' + nom du dual alors MODUAL prend ce nom-la CALL LIRMOT(MOOPT(2),1,IOPT,0) if(iopt.ne.0) then CALL LIRCHA(MODUAL,1,IRETOU) IF(IERR.NE.0) RETURN endif else CALL LIRCHA(MOPRIM,1,IRETOU) CALL LIRMOT(MOOPT(2),1,IOPT,0) if(iopt.ne.0) then CALL LIRCHA(MODUAL,1,IRETOU) IF(IERR.NE.0) RETURN else MODUAL=MOPRIM write(IOIMP,*) 'Attention vous utilisez l inconnue PRIMale ' $ ,MOPRIM,' non définie dans NOMDD du bdata...' write(IOIMP,*) 'On utilise ',MODUAL,' comme DUALe associee' endif endif ENDIF c option ligne : on cherche l inconnue duale IF(ICLE.eq.3) THEN CALL LIRMOT(NOMDU,LNOMDU,idd1,0) if (idd1.ne.0) then MOPRIM=NOMDD(idd1) MODUAL=NOMDU(idd1) c si mot clé 'PRIM' + nom du primal alors MOPRIM prend ce nom-la CALL LIRMOT(MOOPT(1),1,IOPT,0) if(iopt.ne.0) then CALL LIRCHA(MOPRIM,1,IRETOU) IF(IERR.NE.0) RETURN endif else CALL LIRCHA(MODUAL,1,IRETOU) CALL LIRMOT(MOOPT(1),1,IOPT,0) if(iopt.ne.0) then CALL LIRCHA(MOPRIM,1,IRETOU) IF(IERR.NE.0) RETURN else MOPRIM=MODUAL write(IOIMP,*) 'Attention vous utilisez l inconnue DUALe ' $ ,MODUAL,' non définie dans NOMDU du bdata...' write(IOIMP,*) 'On utilise ',MOPRIM,' comme PRIMale associee' endif endif ENDIF if(iimpi.ge.1)write(IOIMP,*)'ICLE,PRIMAL,DUAL',ICLE,MOPRIM,MODUAL IF(IERR.NE.0) RETURN c======================================================================c C TRAVAIL SUR LE CHPOINT SEGACT MCHPOI NSOUPO = IPCHP(/1) C On compte le nombre de matrices à générer NRIGEL=0 DO ISOUPO = 1, NSOUPO MSOUPO = IPCHP(ISOUPO) SEGACT MSOUPO NC=NOCOMP(/2) NRIGEL=NRIGEL+NC SEGDES MSOUPO ENDDO SEGINI MRIGID c On impose MTYMAT, mais on pourrait aussi bien lire le sous-type de la c rigidite a creer apres le mot clé TYPE comme dans la syntaxe a de manuri IF(ICLE.eq.2) MTYMAT='COLONNE ' IF(ICLE.eq.3) MTYMAT='LIGNE ' C IRIG=0 C====> BOUCLE SUR LES ZONES DU CHPOINT ====================== DO ISOUPO = 1, NSOUPO if(iimpi.ge.2) write(IOIMP,*)' Sous-zone',ISOUPO,'/',NSOUPO MSOUPO = IPCHP(ISOUPO) SEGACT MSOUPO NC=NOCOMP(/2) MELEME=IGEOC SEGACT MELEME NBEL=NUM(/2) c Le meleme d un chpoint est constitué de poi1 (=elements a 1 noeud) c creation d une geometrie IPT1 avec KPOINT + IGEOC (=> 1+1=2 noeuds) NBNN=2 NBSOUS=0 NBREF=0 NBELEM=NBEL SEGINI,IPT1 IPT1.ITYPEL=28 Jdiag = 0 DO JEL=1,NBEL IPT1.NUM(1,JEL)=KPOINT IPT1.NUM(2,JEL)=NUM(1,JEL) * on repere une eventuelle diagonale if(IPT1.NUM(1,JEL).eq.IPT1.NUM(2,JEL)) Jdiag=JEL ENDDO c fin de fabrication de IPT1 SEGDES,MELEME,IPT1 MPOVAL=IPOVAL SEGACT MPOVAL C ---> BOUCLE SUR LES COMPOSANTES --------- DO IC=1,NC IRIG=IRIG+1 if(iimpi.ge.2) & write(IOIMP,*)' Composante',IC,'/',NC,' -> rigidite ',IRIG c ---infos generales--- COERIG(IRIG)=1.D0 IRIGEL(1,IRIG)=IPT1 IRIGEL(5,IRIG)=NIFOUR IRIGEL(7,IRIG)=ISYM-1 NLIGRP=2 NLIGRD=2 c ---segment DESCRipteur--- SEGINI DESCR LISINC(1)=MOPRIM LISDUA(1)=MODUAL NOELEP(1)=1 NOELED(1)=1 NOELEP(2)=2 NOELED(2)=2 * -Cas colonne : on a un chpoint de dual : il faut retrouver le primal IF(ICLE.eq.2) THEN idd2=0 CALL PLACE(NOMDU,LNOMDU,idd2,NOCOMP(IC)) IF (idd2.NE.0) THEN LISINC(2)=NOMDD(idd2) ELSE LISINC(2)=NOCOMP(IC) write(IOIMP,*) 'Attention le chpoint utilise la duale ' $ ,NOCOMP(IC),' non definie dans NOMDU du bdata...' write(IOIMP,*) 'On utilise ',NOCOMP(IC) $ ,' comme primale associee' ENDIF LISDUA(2)=NOCOMP(IC) * -Cas ligne : on a un chpoint de primal : il faut retrouver le dual ELSE idd2=0 CALL PLACE(NOMDD,LNOMDD,idd2,NOCOMP(IC)) IF (idd2.NE.0) THEN LISDUA(2)=NOMDU(idd2) ELSE LISDUA(2)=NOCOMP(IC) write(IOIMP,*) 'Attention le chpoint utilise la primale ' $ ,NOCOMP(IC),' non definie dans NOMDD du bdata...' write(IOIMP,*) 'On utilise ',NOCOMP(IC) $ ,' comme duale associee' ENDIF LISINC(2)=NOCOMP(IC) ENDIF if(iimpi.ge.2) then write(IOIMP,*)' LISINC = ',(LISINC(iou),iou=1,2) write(IOIMP,*)' LISDUA = ',(LISDUA(iou),iou=1,2) endif c debut du test pour savoir si on se situe sur une diagonale fldiag = LISINC(1).eq.LISINC(2).and.LISDUA(1).eq.LISDUA(2) SEGDES DESCR IRIGEL(3,IRIG)=DESCR c ---matrice XMATRI proprement dite --- NELRIG=NBEL SEGINI XMATRI c -cas symetrique (cas par defaut) IF(ISYM.le.1) THEN DO JEL=1,NBEL c RE(1,1,JEL)=0.D0 RE(1,2,JEL)=VPOCHA(JEL,IC) RE(2,1,JEL)=VPOCHA(JEL,IC) c RE(2,2,JEL)=0.D0 ENDDO c petite correction pour ne pas remplir 2 fois la meme case ! c (=cas de la diagonale) c rem : inutile dans les cas antisymetrique et quelconque if(Jdiag.ne.0.and.fldiag) then RE(1,1,Jdiag)=VPOCHA(Jdiag,IC) RE(1,2,Jdiag)=0.D0 RE(2,1,Jdiag)=0.D0 RE(2,2,Jdiag)=0.D0 endif ENDIF c -cas antisymetrique IF(ISYM.eq.2) THEN IF(ICLE.eq.2) THEN DO JEL=1,NBEL c RE(1,1,JEL)=0.D0 RE(1,2,JEL)=-1.D0*VPOCHA(JEL,IC) RE(2,1,JEL)=VPOCHA(JEL,IC) c RE(2,2,JEL)=0.D0 ENDDO ELSE DO JEL=1,NBEL c RE(1,1,JEL)=0.D0 RE(1,2,JEL)=VPOCHA(JEL,IC) RE(2,1,JEL)=-1.D0*VPOCHA(JEL,IC) c RE(2,2,JEL)=0.D0 ENDDO ENDIF ENDIF c -cas quelconque IF(ISYM.eq.3) THEN IF(ICLE.eq.2) THEN DO JEL=1,NBEL c RE(1,1,JEL)=0.D0 c RE(1,2,JEL)=0.D0 RE(2,1,JEL)=VPOCHA(JEL,IC) c RE(2,2,JEL)=0.D0 ENDDO ELSE DO JEL=1,NBEL c RE(1,1,JEL)=0.D0 RE(1,2,JEL)=VPOCHA(JEL,IC) c RE(2,1,JEL)=0.D0 c RE(2,2,JEL)=0.D0 ENDDO ENDIF ENDIF if(iimpi.ge.2) then write(IOIMP,*)' RE(1,:) = ',(RE(1,iou),iou=1,2) write(IOIMP,*)' RE(2,:) = ',(RE(2,iou),iou=1,2) endif SEGDES XMATRI IRIGEL(4,IRIG)=XMATRI ENDDO C <--- FIN DE BOUCLE SUR LES COMPOSANTES --------- SEGDES MPOVAL SEGDES MSOUPO ENDDO C<==== FIN DE BOUCLE SUR LES ZONES DU CHPOINT ====================== SEGDES MRIGID SEGDES MCHPOI c*********************************************************************** C Normal termination c*********************************************************************** RETURN c*********************************************************************** c End of subroutine c*********************************************************************** END