1 : C ELFGR2 SOURCE CHAT 05/01/12 23:32:01 5004 2 : SUBROUTINE ELFGR2(KGREEN,DELTAT,M,NPAS,MAXBLO,KNREFE,KANBN,KDNCN) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : C 6 : C ===================================================================== 7 : C APPELE PAR ELFE 8 : C INITIALISATION DES BLOCS ANBN ET DNCN 9 : C REMPLISSAGE DES ANBN AVEC LES FONCTIONS DE GREEN ( KGREEN ) 10 : C 11 : C CREATION : 22/09/87 12 : C PROGRAMMEUR : GUILBAUD 13 : C ===================================================================== 14 : -INC CCOPTIO 15 : -INC CCREEL 16 : -INC SMEVOLL 17 : -INC SMLREEL 18 : C 19 : SEGMENT MANBN 20 : POINTEUR KAB(NSGA).ANBN 21 : ENDSEGMENT 22 : C 23 : C NSGA : NOMBRE DE BLOCS ANBN 24 : C 25 : SEGMENT ANBN 26 : REAL*8 AB(NTANBN,LANBN) 27 : ENDSEGMENT 28 : C 29 : C AB(I,K) : TERME I DE LA MATRICE A OU B D'UN ELEMENT AU TEMPS K 30 : C NTANBN : NOMBRE DE TERMES DES MATRICES A ET B DE TOUS LES ELEMENTS 31 : C LANBN : NOMBRE DE PAS DE TEMPS STOCKES DANS UN BLOC ANBN 32 : C 33 : SEGMENT MDNCN 34 : POINTEUR KDC(NSGD).DNCN 35 : ENDSEGMENT 36 : C 37 : C NSGD : NOMBRE DE BLOCS DNCN 38 : C 39 : SEGMENT DNCN 40 : REAL*8 DC(NIDNCN,LDNCN) 41 : ENDSEGMENT 42 : C 43 : C DC(I,K) : DDL I AU TEMPS (K-1)*DELTAT 44 : C NIDNCN : NOMBRE TOTAL D'INCONNUES 45 : C LDNCN : 1 + NOMBRE DE PAS DE TEMPS STOCKES DANS UN BLOC DNCN 46 : C 47 : SEGMENT MNREFE 48 : INTEGER NREFE(8,NSTR) 49 : INTEGER NTANBN 50 : INTEGER NIDNCN 51 : INTEGER NTVN 52 : POINTEUR NREPA.MPASS 53 : POINTEUR NRECA.MCARA 54 : POINTEUR NRENO.MNORM 55 : POINTEUR NRECPR.ICPR 56 : POINTEUR NREMEL.MELEME 57 : POINTEUR NREDEN.MDEN 58 : ENDSEGMENT 59 : C 60 : C NSTR : NOMBRE D'ELEMENTS 61 : C NREFE(1,I) : MELEME 62 : C NREFE(2,I) : MSOSTU 63 : C NREFE(3,I) : TYPE DE L'ELEMENT 64 : C NREFE(4,I) : NOMBRE DE POINTS DU MELEME 65 : C NREFE(5,I) : NOMBRE DE DDL PAR POINT 66 : C NREFE(6,I)=IVN :LE 1ER DDL DE L'ELEMENT EST LE IVN+1 IEME DE VN 67 : C NREFE(7,I)=IAN :LE 1ER TERME DE LA MATRICE A EST LE IAN IEME DE ANBN 68 : C NREFE(8,I)=1 :LE IEME ELEMENT EST RIGIDE (OU PARTIELLEMENT) SINON 0 69 : C NTANBN : NOMBRE DE TERMES DES MATRICES A ET B POUR TOUS LES ELEMENTS 70 : C NIDNCN : NOMBRE TOTAL D'INCONNUES DE DNCN 71 : C NTVN : LONGUEUR DU TABLEAU VN 72 : C 73 : SEGMENT MCARA 74 : REAL*8 CARA(LCAR*NSTR) 75 : ENDSEGMENT 76 : C 77 : C LCAR : NOMBRE DE CARACTERISTIQUES DE L'ELEMENT 78 : C 79 : SEGMENT MDEN 80 : INTEGER IDEN(INS) 81 : ENDSEGMENT 82 : C 83 : C IL Y A INS STRUCTURES AYANT DES CARACTERISTIQUES DIFFERENTES 84 : C IDEN CONTIENT LEUR NUMERO D'ORDRE DANS MNREFE 85 : C 86 : SEGMENT ITRAV(INS) 87 : CHARACTER *72 ITEX 88 : LOGICAL TRACTI,TORSIO 89 : C 90 : EPS=1.D-3 91 : IF (IIMPI.EQ.1) THEN 92 : WRITE(IOIMP,*) ' DEBUT DE ELFGR2 ' 93 : END IF 94 : MNREFE=KNREFE 95 : MDEN=NREDEN 96 : NSTR=NREFE(/2) 97 : MCARA=NRECA 98 : LCAR=CARA(/1)/NSTR 99 : IF(M.EQ.0) M=NPAS 100 : TMAX=M*DELTAT 101 : C 102 : C RECHERCHE DES FONCTIONS DE GREEN 103 : C 104 : MEVOLL=KGREEN 105 : SEGACT MEVOLL 106 : NBEL=IEVOLL(/1) 107 : IF(MOD(NBEL,28).NE.0) THEN 108 : C *** IL MANQUE DES FONCTIONS DE GREEN 108 : CALL ERREUR(388) 109 : SEGDES MEVOLL 110 : RETURN 111 : ENDIF 112 : NBEL=NBEL/28 113 : INS=IDEN(/1) 114 : SEGINI ITRAV 115 : DO 20 NB=1,NBEL 116 : KEVOLL=IEVOLL((NB-1)*28+1) 117 : SEGACT KEVOLL 118 : MLREEL=IPROGX 119 : SEGACT MLREEL 120 : DT=PROG(2)-PROG(1) 121 : IL=PROG(/1) 122 : TT=PROG(IL) 123 : SEGDES MLREEL 124 : DT2=DT*0.999999999 125 : IF (DELTAT.LT.DT2 .OR. (INT(DELTAT/DT)*DT).LT.DT2) THEN 125 : CALL ERREUR(389) 126 : SEGDES KEVOLL 127 : SEGDES MEVOLL 128 : RETURN 129 : END IF 130 : IF(TMAX .GT. TT) THEN 131 : C *** LA DUREE DU CALCUL EST TROP GRANDE POUR LES FONCTIONS DE GREEN 131 : CALL ERREUR(390) 132 : SEGDES KEVOLL 133 : SEGDES MEVOLL 134 : RETURN 135 : ENDIF 136 : ITEX=KEVTEX 137 : READ (ITEX(6:17),FMT='(1PE12.5)') DLL 138 : READ (ITEX(24:35),FMT='(1PE12.5)') CTC 139 : READ (ITEX(43:54),FMT='(1PE12.5)') RTC 140 : SEGDES KEVOLL 141 : KEVOLL=IEVOLL((NB-1)*28+3) 142 : SEGACT KEVOLL 143 : ITEX=KEVTEX 144 : READ (ITEX(24:35),FMT='(1PE12.5)') CTO 145 : READ (ITEX(43:54),FMT='(1PE12.5)') RTO 146 : SEGDES KEVOLL 147 : KEVOLL=IEVOLL((NB-1)*28+5) 148 : SEGACT KEVOLL 149 : ITEX=KEVTEX 150 : READ (ITEX(43:54),FMT='(1PE12.5)') RFZ 151 : SEGDES KEVOLL 152 : KEVOLL=IEVOLL((NB-1)*28+10) 153 : SEGACT KEVOLL 154 : ITEX=KEVTEX 155 : READ (ITEX(43:54),FMT='(1PE12.5)') RFY 156 : SEGDES KEVOLL 157 : C 158 : C BOUCLE SUR LES ELEMENTS------------------------------ 159 : C 160 : DO 10 IN=1,INS 161 : IF(ITRAV(IN).EQ.0) THEN 162 : NS=IDEN(IN) 163 : NCA=LCAR*(NS-1) 164 : DIF=ABS(1.D0-DLL/CARA(NCA+1)) 165 : IF(DIF.GT.EPS) GOTO 10 166 : C DIF=ABS(1.D0-CTC/CARA(NCA+6)) 167 : C IF(DIF.GT.EPS) GOTO 10 168 : DIF=ABS(1.D0-RTC/CARA(NCA+2)) 169 : IF(DIF.GT.EPS) GOTO 10 170 : C DIF=ABS(1.D0-CTO/CARA(NCA+7)) 171 : C IF(DIF.GT.EPS) GOTO 10 172 : DIF=ABS(1.D0-RTO/CARA(NCA+3)) 173 : IF(DIF.GT.EPS) GOTO 10 174 : DIF=ABS(1.D0-RFY/CARA(NCA+4)) 175 : IF(DIF.GT.EPS) GOTO 10 176 : DIF=ABS(1.D0-RFZ/CARA(NCA+5)) 177 : IF(DIF.GT.EPS) GOTO 10 178 : ITRAV(IN)=NB 179 : GOTO 20 180 : ENDIF 181 : 10 CONTINUE 182 : 20 CONTINUE 183 : DO 30 IN=1,INS 184 : IF(ITRAV(IN).EQ.0) THEN 185 : C *** IL MANQUE LES FONCTIONS DE GREEN DE LA SOUS-STRUCTURE 186 : NS=IDEN(IN) 187 : INTERR(1)=NREFE(2,NS) 187 : CALL ERREUR(391) 188 : ENDIF 189 : 30 CONTINUE 190 : IF(IERR.EQ.2) THEN 191 : SEGSUP ITRAV 192 : SEGDES MEVOLL 193 : RETURN 194 : ENDIF 195 : C 196 : C CREATION DES BLOCS ANBN 197 : C 198 : IF(NTANBN.GT.MAXBLO) THEN 199 : C *** TAILLE DU CALCUL TROP IMPORTANTE 199 : CALL ERREUR(382) 200 : RETURN 201 : ENDIF 202 : LANBN=MAXBLO/NTANBN 203 : LANBND=LANBN 204 : NSGA=(M-1)/LANBN+1 205 : SEGINI MANBN 206 : KANBN=MANBN 207 : DO 40 K=1,NSGA 208 : IF(K.EQ.NSGA) LANBN=M-(NSGA-1)*LANBN 209 : SEGINI ANBN 210 : SEGDES ANBN 211 : KAB(K)=ANBN 212 : 40 CONTINUE 213 : LANBN=LANBND 214 : C 215 : C CREATION DES BLOCS DNCN 216 : C 217 : IF(NIDNCN.GT.MAXBLO) THEN 218 : C *** TAILLE DU CALCUL TROP IMPORTANTE 218 : CALL ERREUR(382) 219 : RETURN 220 : ENDIF 221 : LDNCN=MAXBLO/NIDNCN 222 : MPAS=NPAS 223 : IF(M.NE.NPAS) THEN 224 : C TRONCATURE DU PRODUIT DE CONVOLUTION ( MEMOIRE GLISSANT PAR BLOC ) 225 : MMPAS=M+LDNCN 226 : IF(NPAS.GT.MMPAS) MPAS=MMPAS 227 : ENDIF 228 : NSGD=MPAS/LDNCN+1 229 : SEGINI MDNCN 230 : KDNCN=MDNCN 231 : DO 50 K=1,NSGD 232 : SEGINI DNCN 232 : CALL ZERO(DC,NIDNCN,LDNCN) 233 : SEGDES DNCN 234 : KDC(K)=DNCN 235 : 50 CONTINUE 236 : IF (IIMPI .EQ. 1801) THEN 237 : WRITE(IOIMP,*) 'NIDNC= ',NIDNCN 238 : WRITE(IOIMP,*) 'MAXBLO= ',MAXBLO 239 : WRITE(IOIMP,*) 'NB DE BLOCS ',NSGD 240 : END IF 241 : C 242 : C BOUCLE SUR LES BLOCS 243 : C 244 : LDEC=0 245 : DO 100 K=1,NSGA 246 : ANBN=KAB(K) 247 : SEGACT ANBN 248 : LANBN=AB(/2) 249 : C 250 : C--------BOUCLE SUR LES ELEMENTS------------------------------ 251 : C 252 : DO 90 IN=1,INS 253 : NB=ITRAV(IN) 254 : NS=IDEN(IN) 255 : NRG=NREFE(7,NS)-1 256 : * 257 : DO 80 J=1,28 258 : KEVOLL=IEVOLL((NB-1)*28+J) 259 : SEGACT KEVOLL 260 : MLREEL=IPROGX 261 : SEGACT MLREEL 262 : DT=PROG(2)-PROG(1) 263 : DIF=ABS(1.D0-DT/DELTAT) 264 : SEGDES MLREEL 265 : MLREEL=IPROGY 266 : SEGACT MLREEL 267 : IF (DIF.LT.EPS) THEN 268 : DO 60 L=1,LANBN 269 : AB(NRG+J,L)=PROG(L+LDEC) 270 : 60 CONTINUE 271 : ELSE 272 : DO 70 L=1,LANBN 273 : T=DELTAT*DBLE(L+LDEC) 274 : N=IDINT(T/DT) 275 : ALPHA=(T-DBLE(N)*DT)/DT 276 : N1=N+1 277 : N2=N+2 278 : AB(NRG+J,L)=(PROG(N2)-PROG(N1))*ALPHA+PROG(N1) 279 : 70 CONTINUE 280 : END IF 281 : SEGDES MLREEL 282 : SEGDES KEVOLL 283 : 80 CONTINUE 284 : * 285 : IF(IIMPI.EQ.1801)THEN 286 : WRITE(IOIMP,*) ' STRUCTURE ',NS 287 : WRITE(IOIMP,1000) K 288 : 1000 FORMAT(1X,//I5,'IEME BLOC DES TERMES DES MATRICES ANBN'/) 289 : DO 120 J=1,28 290 : WRITE(IOIMP,1001) (J,AB(NRG+J,LL2),LL2=1,LANBN) 291 : 1001 FORMAT(1X,5(I5,1X,1PE12.5)) 292 : 120 CONTINUE 293 : ENDIF 294 : 90 CONTINUE 295 : SEGDES ANBN 296 : LDEC=LDEC+LANBN 297 : 100 CONTINUE 298 : C 299 : C BOUCLE SUR LES ELEMENTS POUR DETERMINER CEUX QUI SONT RIGIDES 300 : C 301 : DO 110 NS=1,NSTR 302 : NCA=LCAR*(NS-1) 303 : DLL=CARA(NCA+1) 304 : CTC=CARA(NCA+6) 305 : WRITE(IOIMP,*)' CTC= ',CTC 306 : DTL=DLL/CTC 307 : IF(DELTAT.GT.DTL) THEN 308 : NREFE(8,NS)=1 309 : GOTO 110 310 : ENDIF 311 : CTO=CARA(NCA+7) 312 : DTL=DLL/CTO 313 : IF(DELTAT.GT.DTL) THEN 314 : NREFE(8,NS)=1 315 : GOTO 110 316 : ENDIF 317 : RFY=CARA(NCA+4) 318 : DTL=DLL*DLL/(3.D0*CTC*RFY*XPI) 319 : IF(DELTAT.GT.DTL) THEN 320 : NREFE(8,NS)=1 321 : GOTO 110 322 : ENDIF 323 : RFZ=CARA(NCA+5) 324 : DTL=DLL*DLL/(3.D0*CTC*RFZ*XPI) 325 : IF(DELTAT.GT.DTL) THEN 326 : NREFE(8,NS)=1 327 : GOTO 110 328 : ENDIF 329 : 110 CONTINUE 330 : WRITE(IOIMP,*) ' NREFE ',(NREFE(8,NS),NS=1,NSTR) 331 : SEGSUP ITRAV 332 : SEGDES MEVOLL 333 : IF (IIMPI.EQ.1) THEN 334 : WRITE(IOIMP,*)' FIN DE ELFGR2 ' 335 : END IF 336 : RETURN 337 : END 338 : 339 : 340 :
© Cast3M 2003 - All rights reserved.
Disclaimer