1 : C COMSOR SOURCE FANDEUR 12/07/18 21:15:33 7435 2 : SUBROUTINE COMSOR(iqmod,ililuc,iwrk52,iwrk53,iwrk54, 3 : & ib,igau,iecou,xecou) 4 : * 5 : ********************************************************************** 6 : * range les resultats du tableau wrk52 dans les melval 7 : ********************************************************************** 8 : * 9 : IMPLICIT INTEGER(I-N) 10 : IMPLICIT REAL*8(A-H,O-Z) 11 : * 12 : -INC CCOPTIO 13 : -INC SMCHAML 14 : -INC SMMODEL 15 : * segment deroulant le mcheml 16 : -INC DECHE 17 : 18 : SEGMENT IECOU 19 : INTEGER icow1,icow2,icow3,icow4,icow5,icow6,icow7, 20 : C INTEGER NYOG, NYNU, NYALFA,NYSMAX,NYN, NYM, NYKK, 21 : 1 icow8,icow9,icow10,icow11,icow12,icow13,icow14,icow15, IND, 22 : C . NYALF1,NYBET1,NYR, NYA, NYRHO,NSIGY, NNKX, NYKX, IND, 23 : 2 NSOM, NINV, NINCMA,NCOMP,icow21,icow22,icow23,icow24, 24 : C . NSOM, NINV, NINCMA,NCOMP, JELEM, LEGAUS,INAT, NCXMAT, 25 : 3 icow25,icow26,icow27,icow28,icow29,icow30,icow31, 26 : C . LTRAC, MFR, IELE, NHRM, NBNN, NBELEM,ICARA, 27 : 4 icow32,icow33,icow34,icow35,icow36,icow37,icow38, 28 : C . LW2, NDEF, NSTRSS,MFR1, NBGMAT,NELMAT,MSOUPA, 29 : 5 icow39,icow40,icow41,icow42,icow43,icow44,NYOG1, 30 : C . NUMAT1,LENDO, NBBB, NNVARI,KERR1, MELEME,NYOG1, 31 : 6 NYNU1,NYALFT1,NYSMAX1,NYN1,NYM1,NYKK1,NYALF2, 32 : C . NYNU1,NYALFT1,NYSMAX1,NYN1,NYM1,NYKK1,NYALF2, 33 : 7 NYBET2,NYR1,NYA1,NYQ1,NYRHO1,NSIGY1 34 : C . NYBET2,NYR1,NYA1,NYQ1,NYRHO1,NSIGY1 35 : ENDSEGMENT 36 : SEGMENT XECOU 37 : REAL*8 DTOPTI, TSOM,TCAR,xcow4,xcow5,xcow6, xcow7 38 : ENDSEGMENT 39 : * 40 : imodel = iqmod 41 : liluc = ililuc 42 : nbluc1 = liluc(/1) 43 : wrk52 = iwrk52 44 : c segact wrk52*mod 45 : wrk53 = iwrk53 46 : wrk54 = iwrk54 47 : * 48 : *------------------------------------------- 49 : * rearrangement pour milieu poreux 50 : *------------------------------------------- 51 : IF (MFR.EQ.33.AND.MATE.EQ.1) THEN 52 : ICAS=2 52 : CALL COMEFF(IQMOD,IWRK52,IWRK53,IWRK54,IECOU,ICAS,IRETOU) 53 : ENDIF 54 : * 55 : do 1000 ino = 1,nbluc1 56 : *tctc on ne garde que contraintes deformation defiela varinter 57 : if(ino.ne.11.and.ino.ne.20.and.ino.ne.24.and.ino.ne.12. 58 : $ and.ino.ne.13.and.ino.ne.14) go to 1000 59 : domdec = liluc(ino) 60 : c segact domdec*nomod 61 : pilnec = jilnec 62 : c segact pilnec*nomod 63 : if (pilnec.le.0) goto 1000 64 : mran = pilobl(/2) 65 : * mran doit correspondre a indeso : indice du deche resultat 66 : if (mran.le.0) goto 1000 67 : mobl = pilobl(/1) 68 : mfac = pilfac(/1) 69 : if (mobl.le.0) goto 101 70 : 71 : do 100 ic = 1,mobl 72 : if (pilobl(ic,mran).gt.0) then 73 : deche = pilobl(ic,mran) 74 : c segact deche*nomod 75 : * on ne modifie que les champs lies au constituant 76 : if (condec.ne.conmod) goto 100 77 : melval = ieldec 78 : segact melval*mod 79 : else 80 : goto 100 81 : endif 82 : * 83 : * AIGUILLAGE SUIVANT MOT CLE 84 : * 85 : if (ino.gt.nmot) goto 98 86 : GOTO ( 1, 2, 1, 1, 1, 6, 7,99,99,10,11,12,13,14,15,16, 17,18, 87 : 1 99,20,21,99,23,24,99) ino 88 : * 89 : 99 CONTINUE 90 : c pas de composantes pour ce champ 91 : RETURN 92 : * 93 : 1 passe1 = scalf(ic) 94 : GOTO 120 95 : * 96 : 2 continue 97 : passe1 = tempf 98 : GOTO 120 99 : * 100 : 6 passe1 = deplf(ic) 101 : GOTO 120 102 : * 103 : 7 passe1 = forcf(ic) 104 : GOTO 120 105 : * 106 : 10 passe1 = gradf(ic) 107 : GOTO 120 108 : * 109 : 11 passe1 = SIGF(ic) 110 : GOTO 120 111 : * 112 : 12 passe1 = epstf(ic) 113 : GOTO 120 114 : * 115 : 13 continue 116 : passe1 = xmatf(ic) 117 : GOTO 120 118 : * 119 : 14 passe1 = xcarbf(ic) 120 : GOTO 120 121 : * 122 : 15 passe1 = turef(ic) 123 : GOTO 120 124 : * 125 : 16 passe1 = prinf(ic) 126 : GOTO 120 127 : * 128 : 17 passe1 = mahof(ic) 129 : GOTO 120 130 : * 131 : 18 passe1 = hotaf(ic) 132 : GOTO 120 133 : * 134 : 20 passe1 = VARF(ic) 135 : GOTO 120 136 : * 137 : 21 passe1 = graff(ic) 138 : GOTO 120 139 : * 140 : 23 passe1 = rhasf(ic) 141 : GOTO 120 142 : * 143 : 24 continue 144 : IF(IND.EQ.1.OR.INPLAS.EQ.31.OR.INPLAS.EQ.30 145 : & .OR.INPLAS.EQ.37.OR.INPLAS.EQ.66.OR.INPLAS.EQ.118 146 : & .OR.INPLAS.EQ.141)THEN 147 : passe1 =EPINF(IC) 148 : ELSE 149 : passe1= epin0(ic) + defp(IC) 150 : ENDIF 151 : GOTO 120 152 : * 153 : 98 passe1 = exova1(ic) 154 : GOTO 120 155 : * 156 : 120 CONTINUE 157 : 158 : if (typdec.eq.'REAL*8') then 159 : IBMN=MIN(IB,VELCHE(/2)) 160 : IGMN=MIN(IGAU,VELCHE(/1)) 161 : VELCHE(IGMN,IBMN)=passe1 162 : else 163 : IBMN=MIN(IB,IELCHE(/2)) 164 : IGMN=MIN(IGAU,IELCHE(/1)) 165 : IELCHE(IGMN,IBMN)=int(passe1) 166 : *kich un cas particulier --- plus dificile traiter cas géneral 167 : if (typdec(1:8).eq.'POINTEUR'.and.IELCHE(/2).eq.1 168 : &.and.IELCHE(/2).eq.1.and.int(passe1).eq.0) then 169 : segsup melval 170 : indec = -1 171 : pilobl(ic,mran) = 0 172 : endif 173 : endif 174 : * 175 : 100 continue 176 : 177 : 101 continue 178 : * 179 : * if (mfac.le.0) goto 301 180 : * mran doit correspondre a indeso, indice du deche resultat 181 : do 200 ic = 1,mfac 182 : if (pilfac(ic,mran).gt.0) then 183 : deche = pilfac(ic,mran) 184 : c segact deche*nomod 185 : if (condec.ne.conmod) goto 200 186 : melval = ieldec 187 : segact melval*mod 188 : else 189 : goto 200 190 : endif 191 : * 192 : * AIGUILLAGE SUIVANT MOT CLE 193 : * 194 : GOTO ( 201,202,201,201,201,206, 207,299,299,210,211, 195 : & 212,213,214,215,216, 217,218,299,220,221,299,223,224,299) ino 196 : if (ino.gt.nmot) goto 298 197 : * 198 : 299 CONTINUE 199 : c pas de composantes pour ce champ 200 : RETURN 201 : * 202 : 201 passe1 = scalf(mobl+ic) 203 : GOTO 320 204 : * 205 : 202 continue 206 : GOTO 320 207 : * 208 : 206 passe1 = deplf(mobl+ic) 209 : GOTO 320 210 : * 211 : 207 passe1 = forcf(mobl+ic) 212 : GOTO 320 213 : * 214 : 210 passe1 = gradf(mobl+ic) 215 : GOTO 320 216 : * 217 : 211 passe1 = SIGF(mobl+ic) 218 : GOTO 320 219 : * 220 : 212 passe1 = epstf(mobl+ic) 221 : GOTO 320 222 : * 223 : 213 passe1 = xmatf(mobl+ic) 224 : GOTO 320 225 : * 226 : 214 passe1 = xcarbf(mobl+ic) 227 : c stockage du pas de temps optimal 228 : 229 : IF ( INPLAS .EQ. 17 .OR. 230 : 2 ( INPLAS .GE. 19 .AND. INPLAS .LE. 25) .OR. 231 : 4 INPLAS .EQ. 61 .OR. INPLAS .EQ. 53 .OR. 232 : 1 INPLAS .EQ. 65 .OR. INPLAS .EQ. 29 .OR. 233 : 1 INPLAS .EQ. 142 .OR. 234 : 2 INPLAS .EQ. 44 .OR. INPLAS .EQ. 45 .OR. 235 : 9 INPLAS .EQ. 76 .OR. INPLAS .EQ. 77 .OR. 236 : 9 INPLAS .EQ. 70 ) THEN 237 : 238 : C Remarque : 239 : C Le vecteur comcar est rempli par COMVAL : on note le nom de la 240 : C composante lors du premier passage (pour le premier point de Gauss 241 : C du premier element) en recopiant le nom que l'on trouve dans lesobl 242 : C (composante obligatoire) ou lesfac (composante facultative). 243 : C Les vecteurs lesobl et lesfac ont ete remplis par COMOU2 qui pour les 244 : C caracteristiques geometriques a appele IDCARB : en aucun cas on ne 245 : C trouve 'DTOPTI' parmi la liste des composantes geometriques reconnues. 246 : C Qui plus est elle constituerait une exception car 6 caracteres au lieu 247 : C des 4 habituels. 248 : C 249 : C Conclusion : LE TEST CI-DESSOUS if (comcar(mobl+ic).eq.'DTOPTI') 250 : C N'EST JAMAIS SATISFAIT, il n'y a pas stockage du pas de temps optimal. 251 : C 252 : C De plus, on n'a pas trouve de composante 'DTOPTI' ou 'DTOP' dans 253 : C aucune des routines IDxxxx, donc on peut dire que 'DTOPTI' n'est 254 : C une composante d'aucun champ de type connu. 255 : C En particulier, 'DTOPTI' n'est pas une composante materielle ou une 256 : C variable interne reconnue d'un quelconque modele. 257 : C 258 : if (comcar(mobl+ic).eq.'DTOPTI') then 259 : TMOY = TSOM/NCOMP 260 : NMOY = NSOM/NCOMP 261 : IF (IIMPI.GE.1) THEN 262 : WRITE(IOIMP,*)' NBRE DE SS PAS : MOYENNE ',NMOY, 263 : 1 ' MAX ',NINCMA 264 : IF (NINV.NE.0) THEN 265 : WRITE(IOIMP,*)' NBRE D"INVERSION ',NINV,'/',NCOMP 266 : END IF 267 : ENDIF 268 : TECAR = SQRT(ABS(TCAR/NCOMP - TMOY*TMOY)) 269 : DTOPTI = MAX(TMOY-TECAR/2.D0,DTOPTI) 270 : passe1=dtopti 271 : 272 : endif 273 : ENDIF 274 : GOTO 320 275 : * 276 : 215 passe1 = turef(mobl+ic) 277 : GOTO 320 278 : * 279 : 216 passe1 = prinf(mobl+ic) 280 : GOTO 320 281 : * 282 : 217 passe1 = mahof(mobl+ic) 283 : GOTO 320 284 : * 285 : 218 passe1 = hotaf(mobl+ic) 286 : GOTO 320 287 : * 288 : 220 passe1 = VARF(mobl+ic) 289 : GOTO 320 290 : * 291 : 221 passe1 = graff(mobl+ic) 292 : GOTO 320 293 : * 294 : 223 passe1 = rhasf(mobl+ic) 295 : GOTO 320 296 : * 297 : 224 continue 298 : IF(IND.EQ.1.OR.INPLAS.EQ.31.OR.INPLAS.EQ.30 299 : & .OR.INPLAS.EQ.37.OR.INPLAS.EQ.66)THEN 300 : passe1 =EPINF(mobl+ic) 301 : ELSE 302 : passe1=epin0(mobl+ic) + defp(mobl+ic) 303 : ENDIF 304 : GOTO 320 305 : * 306 : 298 passe1 =exova1(mobl + ic) 307 : GOTO 320 308 : * 309 : 320 CONTINUE 310 : 311 : if (typdec.eq.'REAL*8') then 312 : IBMN=MIN(IB,VELCHE(/2)) 313 : IGMN=MIN(IGAU,VELCHE(/1)) 314 : VELCHE(IGMN,IBMN) = passe1 315 : else 316 : IBMN=MIN(IB,IELCHE(/2)) 317 : IGMN=MIN(IGAU,IELCHE(/1)) 318 : IELCHE(IGMN,IBMN)= int(passe1) 319 : *kich un cas particulier --- plus dificile traiter cas géneral 320 : if (typdec(1:8).eq.'POINTEUR'.and.IELCHE(/2).eq.1 321 : &.and.IELCHE(/2).eq.1.and.int(passe1).eq.0) then 322 : segsup melval 323 : indec = -1 324 : pilfac(ic,mran) = 0 325 : endif 326 : endif 327 : 328 : 200 continue 329 : 330 : 301 continue 331 : * 332 : 1000 continue 333 : * 334 : RETURN 335 : END 336 : 337 :
© Cast3M 2003 - All rights reserved.
Disclaimer