1 : C PRLIMI SOURCE AF221230 13/08/01 21:15:10 7808 2 : C PRLIMI SOURCE 3 : SUBROUTINE PRLIMI(CALDYN,IG,ITAB,IFIC1,IRIG,NMOD,IMAI,NNO,IFIC2) 4 : C 5 : C======================================================================= 6 : C POUR MISS3D : ECRITURE DES MODES SUR FICHIER .chp 7 : C ET DU MAILLAGE SUR FICHIER .mail 8 : C 9 : C Appelle par l'operateur MISE 10 : C======================================================================= 11 : C 12 : IMPLICIT INTEGER(I-N) 13 : IMPLICIT REAL*8(A-H,O-Z) 14 : LOGICAL CALDYN 15 : -INC SMTABLE 16 : -INC SMCOORD 17 : -INC CCOPTIO 18 : -INC SMELEME 19 : -INC SMCHPOI 20 : C 21 : CHARACTER*8 ITYPE 22 : CHARACTER*72 LEMOT 23 : PARAMETER (ZERO=0.D0) 24 : INTEGER ICMP(3) 25 : INTEGER KN(8) 26 : DATA KN /0,0,0,0,0,0,0,0/ 27 : C 28 : IF(CALDYN)THEN 29 : C 30 : C Ecriture pour les vrais modes 31 : WRITE(IFIC1,*)'GROUP 2' 32 : WRITE(IFIC1,*)'MODE',NMOD 33 : DO 20 I=1,NMOD 34 : WRITE(IFIC1,*)'TOUS 0 0 0' 35 : WRITE(IFIC1,*)'FIN' 36 : 20 CONTINUE 37 : C 38 : C Ecriture des modes statiques 39 : WRITE(IFIC1,*)'GROUP 1 2' 40 : MTABLE=ABS(ITAB) 41 : SEGACT MTABLE 42 : NB=MLOTAB 43 : WRITE(IFIC1,*)'MODE',NB-1 44 : 45 : IF(IRIG.EQ.1)THEN 46 : C 47 : C Fondation souple, on n'ecrit que le DDL concerne pour chaque mode 48 : NBP=(NB-1)/3 49 : 50 : DO 10 IJ=1,NB 51 : ITYPE=MTABTI(IJ) 52 : IF(ITYPE.EQ.'ENTIER')THEN 53 : IRET=MTABII(IJ) 54 : MTAB1=MTABIV(IJ) 54 : CALL ACCTAB(MTAB1,'MOT',0,0.0D0,'POINT_LIAISON',.TRUE.,0, 55 : & 'POINT',IP,RR,LEMOT,.TRUE.,IPOIN) 55 : CALL ACCTAB(MTAB1,'MOT',0,0.0D0,'DDL_LIAISON',.TRUE.,0, 56 : & 'MOT',IP,RR,LEMOT,.TRUE.,IZ) 56 : CALL ACCTAB(MTAB1,'MOT',0,0.0D0,'VALEUR_DDL',.TRUE.,0, 57 : & 'FLOTTANT',IP,VAL,LEMOT,.TRUE.,IZ) 58 : IF (VAL.EQ.00013081984) THEN 58 : CALL ACCTAB(MTAB1,'MOT',0,0.0D0,'DEFORMEE',.TRUE.,0, 59 : & 'CHPOINT',IP,RR,LEMOT,.TRUE.,JCHP1) 60 : MCHPOI=JCHP1 61 : SEGACT MCHPOI 62 : NSOU=IPCHP(/1) 63 : DO 71 ISOU=1,NSOU 64 : MSOUPO=IPCHP(ISOU) 65 : SEGACT MSOUPO 66 : IF(NOCOMP(1).EQ.'LX ')THEN 67 : SEGDES MSOUPO 68 : GOTO 71 69 : ENDIF 70 : IPT1=IGEOC 71 : SEGACT IPT1 72 : NBP=IPT1.NUM(/2) 73 : MPOVAL=IPOVAL 74 : SEGACT MPOVAL 75 : C 76 : C On ordonne les composantes UX, UY et UZ car bizarrement c'est pas toujours dans l'ordre ! 77 : NBCOMP=VPOCHA(/2) 78 : DO ICOMP=1,NBCOMP 79 : IF(NOCOMP(ICOMP).EQ.'UX ')THEN 80 : ICMP(1)=ICOMP 81 : ELSEIF(NOCOMP(ICOMP).EQ.'UY ')THEN 82 : ICMP(2)=ICOMP 83 : ELSEIF(NOCOMP(ICOMP).EQ.'UZ ')THEN 84 : ICMP(3)=ICOMP 85 : ENDIF 86 : ENDDO 87 : DO 72 IN=1,NBP 88 : IPOIN=IPT1.NUM(1,IN) 89 : WRITE(IFIC1,110)IPOIN,(VPOCHA(IN,ICMP(IC)),IC=1,3) 90 : 72 CONTINUE 91 : SEGDES MPOVAL 92 : SEGDES MSOUPO 93 : SEGDES IPT1 94 : 71 CONTINUE 95 : WRITE(IFIC1,*)'FIN' 96 : SEGDES MCHPOI 97 : ELSE 98 : C 99 : IF(LEMOT(1:2).EQ.'UX')THEN 100 : WRITE(IFIC1,110)IPOIN,VAL,ZERO,ZERO 101 : ELSEIF(LEMOT(1:2).EQ.'UY')THEN 102 : WRITE(IFIC1,110)IPOIN,ZERO,VAL,ZERO 103 : ELSE 104 : WRITE(IFIC1,110)IPOIN,ZERO,ZERO,VAL 105 : ENDIF 106 : 110 FORMAT(I7,3(1X,E15.6)) 107 : WRITE(IFIC1,*)'FIN' 108 : ENDIF 109 : ENDIF 110 : 10 CONTINUE 111 : ELSE 112 : C 113 : C Fondation rigide, on ecrit tous les ddl pour chaque mode 114 : DO 60 IJ=1,NB 115 : ITYPE=MTABTI(IJ) 116 : IF(ITYPE.EQ.'ENTIER')THEN 117 : IRET=MTABII(IJ) 118 : MTAB1=MTABIV(IJ) 118 : CALL ACCTAB(MTAB1,'MOT',0,0.0D0,'DEFORMEE',.TRUE.,0, 119 : & 'CHPOINT',IP,RR,LEMOT,.TRUE.,JCHP1) 120 : MCHPOI=JCHP1 121 : SEGACT MCHPOI 122 : NSOU=IPCHP(/1) 123 : DO 61 ISOU=1,NSOU 124 : MSOUPO=IPCHP(ISOU) 125 : SEGACT MSOUPO 126 : IF(NOCOMP(1).EQ.'LX ')THEN 127 : SEGDES MSOUPO 128 : GOTO 61 129 : ENDIF 130 : IPT1=IGEOC 131 : SEGACT IPT1 132 : NBP=IPT1.NUM(/2) 133 : MPOVAL=IPOVAL 134 : SEGACT MPOVAL 135 : C 136 : C On ordonne les composantes UX, UY et UZ car bizarrement c'est pas toujours dans l'ordre ! 137 : NBCOMP=VPOCHA(/2) 138 : DO ICOMP=1,NBCOMP 139 : IF(NOCOMP(ICOMP).EQ.'UX ')THEN 140 : ICMP(1)=ICOMP 141 : ELSEIF(NOCOMP(ICOMP).EQ.'UY ')THEN 142 : ICMP(2)=ICOMP 143 : ELSEIF(NOCOMP(ICOMP).EQ.'UZ ')THEN 144 : ICMP(3)=ICOMP 145 : ENDIF 146 : ENDDO 147 : DO 62 IN=1,NBP 148 : IPOIN=IPT1.NUM(1,IN) 149 : WRITE(IFIC1,110)IPOIN,(VPOCHA(IN,ICMP(IC)),IC=1,3) 150 : 62 CONTINUE 151 : SEGDES MPOVAL 152 : SEGDES MSOUPO 153 : SEGDES IPT1 154 : 61 CONTINUE 155 : WRITE(IFIC1,*)'FIN' 156 : SEGDES MCHPOI 157 : ENDIF 158 : 60 CONTINUE 159 : ENDIF 160 : SEGDES MTABLE 161 : ELSE 162 : ID=(IDIM+1)*(IG-1) 163 : WRITE(IFIC1,*)'GROUP 1' 164 : WRITE(IFIC1,*)'RIGIDE',XCOOR(ID+1),XCOOR(ID+2),XCOOR(ID+3) 165 : ENDIF 166 : C 167 : C Ecriture maillage 168 : MELEME=IMAI 169 : SEGACT MELEME 170 : NBEL=NUM(/2) 171 : NBSOUS=LISOUS(/1) 172 : IF(NBSOUS.NE.0)STOP 'Plusieurs sous maillages' 173 : C 174 : C coordonnees 175 : NNOT=XCOOR(/1)/4 176 : C WRITE(IFIC2,310)NNOT,NBEL 177 : WRITE(IFIC2,310)NNO,NBEL 178 : 310 FORMAT('Maillage interface',/,I5,I5,/,'LIBRE') 179 : C DO 40 IP=1,NNOT 180 : DO 40 IP=1,NNO 181 : WRITE(IFIC2,320)(XCOOR((IP-1)*4+K),K=1,3) 182 : 320 FORMAT(3(1X,E15.6)) 183 : 40 CONTINUE 184 : C 185 : C connectivite maillage interface 186 : cccc???? SEGACT MCOORD 187 : C 188 : NBN=NUM(/1) 189 : DO 50 IE=1,NBEL 190 : IF(NBN.EQ.4)THEN 191 : KN(1)=NUM(1,IE) 192 : KN(3)=NUM(2,IE) 193 : KN(5)=NUM(3,IE) 194 : KN(7)=NUM(4,IE) 195 : ELSEIF(NBN.EQ.3)THEN 196 : KN(1)=NUM(1,IE) 197 : KN(3)=NUM(2,IE) 198 : KN(5)=NUM(3,IE) 199 : ELSE 200 : WRITE(IOIMP,*) 'Nombre de noeuds par element : ',NBN 201 : STOP 'pas encore fait dans prlimi.eso' 202 : ENDIF 203 : WRITE(IFIC2,330)(KN(K),K=1,8) 204 : 330 FORMAT(8I7,' GR 1') 205 : C 206 : 50 CONTINUE 207 : C 208 : SEGDES MELEME 209 : C 210 : RETURN 211 : END 212 :
© Cast3M 2003 - All rights reserved.
Disclaimer