1 : C RICOLO SOURCE BP208322 13/10/17 21:15:00 7842 2 : C 3 : SUBROUTINE RICOLO(MCHPOI,ICLE,MRIGID) 4 : 5 : IMPLICIT REAL*8 (A-H,O-Z) 6 : IMPLICIT INTEGER (I-N) 7 : 8 : C*********************************************************************** 9 : C NOM : RICOLO 10 : C DESCRIPTION : Transforme un CHPOINT MCHPOI en matrice colonne MRIGID 11 : C En pratique on fait plein de matrices carrées 2x2 12 : C LANGAGE : ESOPE 13 : C 14 : C AUTEUR, DATE, MODIF : 15 : C 16/02/2012, Benoit Prabel : creation 16 : C 17 : C ... merci de compléter les evolutions futures ... 18 : C 19 : C*********************************************************************** 20 : C ENTREES : MCHPOI (+ autres lectures internes a ricolo) 21 : C ENTREES/SORTIES : 22 : C SORTIES : MRIGID 23 : C*********************************************************************** 24 : 25 : -INC CCOPTIO 26 : -INC SMRIGID 27 : -INC SMCHPOI 28 : -INC SMELEME 29 : -INC CCHAMP 30 : 31 : CHARACTER*4 MODUAL,MOPRIM 32 : CHARACTER*4 MOSYM(3),MOOPT(2) 33 : DATA MOSYM/'SYME','ANTI','QUEL'/ 34 : DATA MOOPT/'PRIM','DUAL'/ 35 : LOGICAL fldiag 36 : 37 : c*********************************************************************** 38 : c Executable statements 39 : c*********************************************************************** 40 : 41 : c======================================================================c 42 : c RECUPERATION DES AUTRES OBJETS d ENTREE ET VERIFICATION DES DONNEES 43 : 44 : c colonne ou ligne = seuls choix possibles 45 : IF(ICLE.ne.2.and.ICLE.ne.3) THEN 46 : write(IOIMP,*) 'VALEUR DE ICLE ERRONNEE =',ICLE 47 : & ,' LORS DE L APPEL A RICOLO ERRONNE' 47 : CALL ERREUR(21) 48 : ENDIF 49 : 50 : c symetrique, antisymetrique ou quelconque (syme par defaut) 51 : ISYM = 0 51 : CALL LIRMOT(MOSYM,3,ISYM,0) 52 : if(ISYM.eq.0) ISYM=1 53 : 54 : * LECTURE DU SUPPORT GEOMETRIQUE (1 seul point admis pour l instant) 54 : CALL LIROBJ('POINT ',KPOINT,1,IRETOU) 54 : IF(IRETOU.EQ.0) CALL ERREUR(20) 55 : IF(IERR.NE.0) RETURN 55 : c CALL CRELEM(KPOINT) 56 : c IPELEM=KPOINT 57 : 58 : * LECTURE DU NOM DU PRIMAL/DUAL (selon option colonne/ligne ) 59 : * ASSOCIE A KPOINT + deduction de l'autre 60 : idd1=0 61 : c option colonne : on cherche l inconnue primale 62 : IF(ICLE.eq.2) THEN 62 : CALL LIRMOT(NOMDD,LNOMDD,idd1,0) 63 : if (idd1.ne.0) then 64 : MOPRIM=NOMDD(idd1) 65 : MODUAL=NOMDU(idd1) 66 : c si mot clé 'DUAL' + nom du dual alors MODUAL prend ce nom-la 66 : CALL LIRMOT(MOOPT(2),1,IOPT,0) 67 : if(iopt.ne.0) then 67 : CALL LIRCHA(MODUAL,1,IRETOU) 68 : IF(IERR.NE.0) RETURN 69 : endif 70 : else 70 : CALL LIRCHA(MOPRIM,1,IRETOU) 70 : CALL LIRMOT(MOOPT(2),1,IOPT,0) 71 : if(iopt.ne.0) then 71 : CALL LIRCHA(MODUAL,1,IRETOU) 72 : IF(IERR.NE.0) RETURN 73 : else 74 : MODUAL=MOPRIM 75 : write(IOIMP,*) 'Attention vous utilisez l inconnue PRIMale ' 76 : $ ,MOPRIM,' non définie dans NOMDD du bdata...' 77 : write(IOIMP,*) 'On utilise ',MODUAL,' comme DUALe associee' 78 : endif 79 : endif 80 : ENDIF 81 : c option ligne : on cherche l inconnue duale 82 : IF(ICLE.eq.3) THEN 82 : CALL LIRMOT(NOMDU,LNOMDU,idd1,0) 83 : if (idd1.ne.0) then 84 : MOPRIM=NOMDD(idd1) 85 : MODUAL=NOMDU(idd1) 86 : c si mot clé 'PRIM' + nom du primal alors MOPRIM prend ce nom-la 86 : CALL LIRMOT(MOOPT(1),1,IOPT,0) 87 : if(iopt.ne.0) then 87 : CALL LIRCHA(MOPRIM,1,IRETOU) 88 : IF(IERR.NE.0) RETURN 89 : endif 90 : else 90 : CALL LIRCHA(MODUAL,1,IRETOU) 90 : CALL LIRMOT(MOOPT(1),1,IOPT,0) 91 : if(iopt.ne.0) then 91 : CALL LIRCHA(MOPRIM,1,IRETOU) 92 : IF(IERR.NE.0) RETURN 93 : else 94 : MOPRIM=MODUAL 95 : write(IOIMP,*) 'Attention vous utilisez l inconnue DUALe ' 96 : $ ,MODUAL,' non définie dans NOMDU du bdata...' 97 : write(IOIMP,*) 'On utilise ',MOPRIM,' comme PRIMale associee' 98 : endif 99 : endif 100 : ENDIF 101 : if(iimpi.ge.1)write(IOIMP,*)'ICLE,PRIMAL,DUAL',ICLE,MOPRIM,MODUAL 102 : IF(IERR.NE.0) RETURN 103 : 104 : 105 : 106 : c======================================================================c 107 : C TRAVAIL SUR LE CHPOINT 108 : 109 : SEGACT MCHPOI 110 : NSOUPO = IPCHP(/1) 111 : C On compte le nombre de matrices à générer 112 : NRIGEL=0 113 : DO ISOUPO = 1, NSOUPO 114 : MSOUPO = IPCHP(ISOUPO) 115 : SEGACT MSOUPO 116 : NC=NOCOMP(/2) 117 : NRIGEL=NRIGEL+NC 118 : SEGDES MSOUPO 119 : ENDDO 120 : SEGINI MRIGID 121 : c On impose MTYMAT, mais on pourrait aussi bien lire le sous-type de la 122 : c rigidite a creer apres le mot clé TYPE comme dans la syntaxe a de manuri 123 : IF(ICLE.eq.2) MTYMAT='COLONNE ' 124 : IF(ICLE.eq.3) MTYMAT='LIGNE ' 125 : C 126 : IRIG=0 127 : C====> BOUCLE SUR LES ZONES DU CHPOINT ====================== 128 : DO ISOUPO = 1, NSOUPO 129 : if(iimpi.ge.2) write(IOIMP,*)' Sous-zone',ISOUPO,'/',NSOUPO 130 : MSOUPO = IPCHP(ISOUPO) 131 : SEGACT MSOUPO 132 : NC=NOCOMP(/2) 133 : MELEME=IGEOC 134 : SEGACT MELEME 135 : NBEL=NUM(/2) 136 : c Le meleme d un chpoint est constitué de poi1 (=elements a 1 noeud) 137 : c creation d une geometrie IPT1 avec KPOINT + IGEOC (=> 1+1=2 noeuds) 138 : NBNN=2 139 : NBSOUS=0 140 : NBREF=0 141 : NBELEM=NBEL 142 : SEGINI,IPT1 143 : IPT1.ITYPEL=28 144 : Jdiag = 0 145 : DO JEL=1,NBEL 146 : IPT1.NUM(1,JEL)=KPOINT 147 : IPT1.NUM(2,JEL)=NUM(1,JEL) 148 : * on repere une eventuelle diagonale 149 : if(IPT1.NUM(1,JEL).eq.IPT1.NUM(2,JEL)) Jdiag=JEL 150 : ENDDO 151 : c fin de fabrication de IPT1 152 : SEGDES,MELEME,IPT1 153 : MPOVAL=IPOVAL 154 : SEGACT MPOVAL 155 : 156 : C ---> BOUCLE SUR LES COMPOSANTES --------- 157 : DO IC=1,NC 158 : 159 : IRIG=IRIG+1 160 : if(iimpi.ge.2) 161 : & write(IOIMP,*)' Composante',IC,'/',NC,' -> rigidite ',IRIG 162 : 163 : c ---infos generales--- 164 : COERIG(IRIG)=1.D0 165 : IRIGEL(1,IRIG)=IPT1 166 : IRIGEL(5,IRIG)=NIFOUR 167 : IRIGEL(7,IRIG)=ISYM-1 168 : NLIGRP=2 169 : NLIGRD=2 170 : 171 : c ---segment DESCRipteur--- 172 : SEGINI DESCR 173 : LISINC(1)=MOPRIM 174 : LISDUA(1)=MODUAL 175 : NOELEP(1)=1 176 : NOELED(1)=1 177 : NOELEP(2)=2 178 : NOELED(2)=2 179 : * -Cas colonne : on a un chpoint de dual : il faut retrouver le primal 180 : IF(ICLE.eq.2) THEN 181 : idd2=0 181 : CALL PLACE(NOMDU,LNOMDU,idd2,NOCOMP(IC)) 182 : IF (idd2.NE.0) THEN 183 : LISINC(2)=NOMDD(idd2) 184 : ELSE 185 : LISINC(2)=NOCOMP(IC) 186 : write(IOIMP,*) 'Attention le chpoint utilise la duale ' 187 : $ ,NOCOMP(IC),' non definie dans NOMDU du bdata...' 188 : write(IOIMP,*) 'On utilise ',NOCOMP(IC) 189 : $ ,' comme primale associee' 190 : ENDIF 191 : LISDUA(2)=NOCOMP(IC) 192 : * -Cas ligne : on a un chpoint de primal : il faut retrouver le dual 193 : ELSE 194 : idd2=0 194 : CALL PLACE(NOMDD,LNOMDD,idd2,NOCOMP(IC)) 195 : IF (idd2.NE.0) THEN 196 : LISDUA(2)=NOMDU(idd2) 197 : ELSE 198 : LISDUA(2)=NOCOMP(IC) 199 : write(IOIMP,*) 'Attention le chpoint utilise la primale ' 200 : $ ,NOCOMP(IC),' non definie dans NOMDD du bdata...' 201 : write(IOIMP,*) 'On utilise ',NOCOMP(IC) 202 : $ ,' comme duale associee' 203 : ENDIF 204 : LISINC(2)=NOCOMP(IC) 205 : ENDIF 206 : if(iimpi.ge.2) then 207 : write(IOIMP,*)' LISINC = ',(LISINC(iou),iou=1,2) 208 : write(IOIMP,*)' LISDUA = ',(LISDUA(iou),iou=1,2) 209 : endif 210 : c debut du test pour savoir si on se situe sur une diagonale 211 : fldiag = LISINC(1).eq.LISINC(2).and.LISDUA(1).eq.LISDUA(2) 212 : SEGDES DESCR 213 : IRIGEL(3,IRIG)=DESCR 214 : 215 : c ---matrice XMATRI proprement dite --- 216 : NELRIG=NBEL 217 : SEGINI XMATRI 218 : c -cas symetrique (cas par defaut) 219 : IF(ISYM.le.1) THEN 220 : DO JEL=1,NBEL 221 : c RE(1,1,JEL)=0.D0 222 : RE(1,2,JEL)=VPOCHA(JEL,IC) 223 : RE(2,1,JEL)=VPOCHA(JEL,IC) 224 : c RE(2,2,JEL)=0.D0 225 : ENDDO 226 : c petite correction pour ne pas remplir 2 fois la meme case ! 227 : c (=cas de la diagonale) 228 : c rem : inutile dans les cas antisymetrique et quelconque 229 : if(Jdiag.ne.0.and.fldiag) then 230 : RE(1,1,Jdiag)=VPOCHA(Jdiag,IC) 231 : RE(1,2,Jdiag)=0.D0 232 : RE(2,1,Jdiag)=0.D0 233 : RE(2,2,Jdiag)=0.D0 234 : endif 235 : ENDIF 236 : c -cas antisymetrique 237 : IF(ISYM.eq.2) THEN 238 : IF(ICLE.eq.2) THEN 239 : DO JEL=1,NBEL 240 : c RE(1,1,JEL)=0.D0 241 : RE(1,2,JEL)=-1.D0*VPOCHA(JEL,IC) 242 : RE(2,1,JEL)=VPOCHA(JEL,IC) 243 : c RE(2,2,JEL)=0.D0 244 : ENDDO 245 : ELSE 246 : DO JEL=1,NBEL 247 : c RE(1,1,JEL)=0.D0 248 : RE(1,2,JEL)=VPOCHA(JEL,IC) 249 : RE(2,1,JEL)=-1.D0*VPOCHA(JEL,IC) 250 : c RE(2,2,JEL)=0.D0 251 : ENDDO 252 : ENDIF 253 : ENDIF 254 : c -cas quelconque 255 : IF(ISYM.eq.3) THEN 256 : IF(ICLE.eq.2) THEN 257 : DO JEL=1,NBEL 258 : c RE(1,1,JEL)=0.D0 259 : c RE(1,2,JEL)=0.D0 260 : RE(2,1,JEL)=VPOCHA(JEL,IC) 261 : c RE(2,2,JEL)=0.D0 262 : ENDDO 263 : ELSE 264 : DO JEL=1,NBEL 265 : c RE(1,1,JEL)=0.D0 266 : RE(1,2,JEL)=VPOCHA(JEL,IC) 267 : c RE(2,1,JEL)=0.D0 268 : c RE(2,2,JEL)=0.D0 269 : ENDDO 270 : ENDIF 271 : ENDIF 272 : if(iimpi.ge.2) then 273 : write(IOIMP,*)' RE(1,:) = ',(RE(1,iou),iou=1,2) 274 : write(IOIMP,*)' RE(2,:) = ',(RE(2,iou),iou=1,2) 275 : endif 276 : SEGDES XMATRI 277 : IRIGEL(4,IRIG)=XMATRI 278 : 279 : 280 : ENDDO 281 : C <--- FIN DE BOUCLE SUR LES COMPOSANTES --------- 282 : SEGDES MPOVAL 283 : SEGDES MSOUPO 284 : 285 : ENDDO 286 : C<==== FIN DE BOUCLE SUR LES ZONES DU CHPOINT ====================== 287 : SEGDES MRIGID 288 : SEGDES MCHPOI 289 : 290 : 291 : c*********************************************************************** 292 : C Normal termination 293 : c*********************************************************************** 294 : 295 : RETURN 296 : 297 : 298 : c*********************************************************************** 299 : c End of subroutine 300 : c*********************************************************************** 301 : 302 : END 303 : 304 : 305 : 306 : 307 :
© Cast3M 2003 - All rights reserved.
Disclaimer