1 : C PRLIN3 SOURCE GOUNAND 06/01/18 21:15:45 5293 2 : SUBROUTINE PRLIN3(CGEOME,LGDISC,TABCPR,TABCDU,LERF, 3 : $ MYFALS,MYCOMS, 4 : $ TABGEO,TABVDC,TATRAV, 5 : $ IMPR,IRET) 6 : IMPLICIT REAL*8 (A-H,O-Z) 7 : IMPLICIT INTEGER (I-N) 8 : C*********************************************************************** 9 : C NOM : PRLIN3 10 : C DESCRIPTION : Initialisations, tests et formatage des données et des 11 : C résultats pour nlin 12 : C base sur prls93 13 : C 14 : C LANGAGE : ESOPE 15 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) 16 : C mél : gounand@semt2.smts.cea.fr 17 : C*********************************************************************** 18 : C APPELES : 19 : C APPELE PAR : PRLIN2 20 : C*********************************************************************** 21 : C ENTREES : 22 : C SORTIES : 23 : C TRAVAIL : 24 : C 25 : C*********************************************************************** 26 : C VERSION : v1, 10/05/2004, version initiale 27 : C HISTORIQUE : v1, 10/05/2004, création 28 : C HISTORIQUE : 29 : C HISTORIQUE : 30 : C*********************************************************************** 31 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 32 : C en cas de modification de ce sous-programme afin de faciliter 33 : C la maintenance ! 34 : C*********************************************************************** 35 : -INC CCOPTIO 36 : -INC SMELEME 37 : POINTEUR CGEOME.MELEME 38 : -INC SMTABLE 39 : POINTEUR TABCPR.MTABLE 40 : POINTEUR TABCDU.MTABLE 41 : POINTEUR TABLC.MTABLE 42 : POINTEUR TAVAPR.MTABLE 43 : POINTEUR TAVADU.MTABLE 44 : POINTEUR TADAPR.MTABLE 45 : POINTEUR TADADU.MTABLE 46 : POINTEUR TAVDPD.MTABLE 47 : POINTEUR TACOPR.MTABLE 48 : POINTEUR TACODU.MTABLE 49 : POINTEUR TABCOF.MTABLE 50 : POINTEUR TABI.MTABLE 51 : POINTEUR TABJ.MTABLE 52 : POINTEUR TABK.MTABLE 53 : -INC SMLMOTS 54 : POINTEUR MYLMOT.MLMOTS 55 : -INC SMLENTI 56 : POINTEUR MYLENT.MLENTI 57 : POINTEUR LDAT.MLENTI 58 : POINTEUR LDAT3.MLENTI 59 : POINTEUR LCOF.MLENTI 60 : POINTEUR LCOF3.MLENTI 61 : POINTEUR POWCOF.MLENTI 62 : POINTEUR POWCO2.MLENTI 63 : POINTEUR KREP.MLENTI 64 : * Segments à moi 65 : CBEGININCLUDE SFALRF 66 : SEGMENT FALRF 67 : CHARACTER*(LNNFA) NOMFA 68 : INTEGER NUQUAF(NBLRF) 69 : POINTEUR ELEMF(NBLRF).ELREF 70 : ENDSEGMENT 71 : SEGMENT FALRFS 72 : POINTEUR LISFA(0).FALRF 73 : ENDSEGMENT 74 : CENDINCLUDE SFALRF 75 : POINTEUR MYFALS.FALRFS 76 : CBEGININCLUDE SLCOMP 77 : SEGMENT COMP 78 : CHARACTER*8 NOMCOM 79 : INTEGER DERCOF(NCOCOF) 80 : LOGICAL LTREF 81 : ENDSEGMENT 82 : SEGMENT COMPS 83 : POINTEUR LISCOM(NBCOMP).COMP 84 : ENDSEGMENT 85 : CENDINCLUDE SLCOMP 86 : POINTEUR MYCOMS.COMPS 87 : POINTEUR MYCOM.COMP 88 : -INC SMCHPOI 89 : POINTEUR MYCHPO.MCHPOI 90 : CBEGININCLUDE SMCHAEL 91 : SEGMENT MCHAEL 92 : POINTEUR IMACHE(N1).MELEME 93 : POINTEUR ICHEVA(N1).MCHEVA 94 : ENDSEGMENT 95 : SEGMENT MCHEVA 96 : REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM) 97 : ENDSEGMENT 98 : SEGMENT LCHEVA 99 : POINTEUR LISCHE(NBCHE).MCHEVA 100 : ENDSEGMENT 101 : CENDINCLUDE SMCHAEL 102 : POINTEUR ICOOR.MCHAEL 103 : POINTEUR MYMCHA.MCHAEL 104 : CBEGININCLUDE SMPOUET 105 : SEGMENT TABGEO 106 : CHARACTER*4 DISGEO 107 : POINTEUR IGEO.MCHAEL 108 : ENDSEGMENT 109 : SEGMENT TABVDC 110 : INTEGER VVARPR(NUMVPR) 111 : INTEGER VVARDU(NUMVDU) 112 : INTEGER VDATPR(NUMDPR) 113 : INTEGER VDATDU(NUMDDU) 114 : INTEGER VCOFPR(NUMCPR) 115 : INTEGER VCOFDU(NUMCDU) 116 : INTEGER ILCPR(NUMDER+1,NUMOP,NUMVPR) 117 : INTEGER ILCDU(NUMDER+1,NUMOP,NUMVDU) 118 : POINTEUR VLCOF(JLCOF).MLENTI 119 : POINTEUR VCOMP(JGCOF).COMP 120 : POINTEUR VLDAT(JGCOF).MLENTI 121 : INTEGER DJSVD(JGVD) 122 : POINTEUR NOMVD(JGVD).MLMOTS 123 : POINTEUR MVD(JGVD).MCHPOI 124 : REAL*8 XVD(JGVD) 125 : CHARACTER*4 DISVD(KGVD) 126 : ENDSEGMENT 127 : SEGMENT TATRAV 128 : POINTEUR VVCOF(JLCOF).MCHEVA 129 : POINTEUR VCOF(JGCOF).MCHEVA 130 : POINTEUR IVD(JGVD).MCHAEL 131 : POINTEUR VD(JGVD).MCHEVA 132 : POINTEUR DVD(JGVD).MCHEVA 133 : POINTEUR FFVD(KGVD).MCHEVA 134 : POINTEUR DFFVD(KGVD).MCHEVA 135 : LOGICAL LVCOF(JGCOF) 136 : LOGICAL LVD(JGVD) 137 : LOGICAL LDVD(JGVD) 138 : LOGICAL LFFVD(KGVD) 139 : LOGICAL LDFFVD(KGVD) 140 : ENDSEGMENT 141 : SEGMENT TABMAT 142 : POINTEUR VMAT(NUMVDU,NUMVPR).MCHAEL 143 : ENDSEGMENT 144 : CENDINCLUDE SMPOUET 145 : INTEGER NUMOP,NUMDER,NUMVPR,NUMVDU 146 : INTEGER NUMOP2,NUMDE2 147 : INTEGER JGVC,KGVC 148 : * 149 : INTEGER IMPR,IRET 150 : * 151 : CHARACTER*4 LGDISC 152 : CHARACTER*4 MYDISC 153 : CHARACTER*8 CNCOM 154 : REAL*8 MYREAL 155 : CHARACTER*8 TYP0,TYP1,TYP2,BLAN,TYPE 156 : CHARACTER*8 TYTABL,TYLMOT,TYCHPO,TYMOT,TYENT,TYFLO,TYLENT 157 : * 158 : INTEGER IBID,IVAL,IOBJ 159 : REAL*8 XBID,XVAL 160 : CHARACTER*8 CBID,CVD,CPD 161 : LOGICAL LBID 162 : INTEGER IOP,JVARPR,JVARDU,KDER 163 : INTEGER IJVC,IKGVD 164 : INTEGER LNMOTS 165 : LOGICAL LFOUND,LEGDAT,LEGCOF 166 : INTEGER LERF 167 : * 168 : * Executable statements 169 : * 170 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans prlin3' 171 : BLAN=' ' 172 : TYTABL='TABLE ' 173 : TYLMOT='LISTMOTS' 174 : TYLENT='LISTENTI' 175 : TYCHPO='CHPOINT ' 176 : TYMOT ='MOT ' 177 : TYENT ='ENTIER ' 178 : TYFLO ='FLOTTANT' 179 : * Récupération des dimensions 179 : CALL ACME(TABCPR,'NUMDER',NUMDER) 180 : IF (IERR.NE.0) GOTO 9999 181 : * 182 : * Si les dérivées se font sur les éléments de référence, il 183 : * faut vérifier que tous les éléments de CGEOME 184 : * sont de la meme dimension et avoir sa valeur 185 : * 186 : IF (LERF.NE.0) THEN 186 : CALL DIMESH(CGEOME,IDMESH,IMPR,IRET) 187 : IF (IRET.NE.0) GOTO 9999 188 : IESDER=IDMESH 189 : ELSE 190 : IESDER=IDIM 191 : ENDIF 192 : * 193 : IF (NUMDER.NE.IESDER) THEN 194 : WRITE(IOIMP,*) 'NUMDER=',NUMDER,' incorrect' 195 : GOTO 9999 196 : ENDIF 196 : CALL ACME(TABCPR,'NUMOP',NUMOP) 197 : IF (IERR.NE.0) GOTO 9999 197 : CALL ACME(TABCPR,'NUMVAR',NUMVPR) 198 : IF (IERR.NE.0) GOTO 9999 198 : CALL ACME(TABCPR,'NUMDAT',NUMDPR) 199 : IF (IERR.NE.0) GOTO 9999 199 : CALL ACME(TABCPR,'NUMCOF',NUMCPR) 200 : IF (IERR.NE.0) GOTO 9999 201 : * 201 : CALL ACME(TABCDU,'NUMDER',NUMDE2) 202 : IF (IERR.NE.0) GOTO 9999 203 : IF (NUMDE2.NE.IESDER) THEN 204 : WRITE(IOIMP,*) 'NUMDE2=',NUMDE2,' incorrect' 205 : GOTO 9999 206 : ENDIF 206 : CALL ACME(TABCDU,'NUMOP',NUMOP2) 207 : IF (IERR.NE.0) GOTO 9999 208 : IF (NUMOP2.NE.NUMOP) THEN 209 : WRITE(IOIMP,*) 'NUMOP2.NE.NUMOP' 210 : GOTO 9999 211 : ENDIF 211 : CALL ACME(TABCDU,'NUMVAR',NUMVDU) 212 : IF (IERR.NE.0) GOTO 9999 212 : CALL ACME(TABCDU,'NUMDAT',NUMDDU) 213 : IF (IERR.NE.0) GOTO 9999 213 : CALL ACME(TABCDU,'NUMCOF',NUMCDU) 214 : IF (IERR.NE.0) GOTO 9999 215 : * 215 : CALL ACMO(TABCPR,'VAR',TYTABL,TAVAPR) 216 : IF (IERR.NE.0) GOTO 9999 216 : CALL ACMO(TABCDU,'VAR',TYTABL,TAVADU) 217 : IF (IERR.NE.0) GOTO 9999 217 : CALL ACMO(TABCPR,'DAT',TYTABL,TADAPR) 218 : IF (IERR.NE.0) GOTO 9999 218 : CALL ACMO(TABCDU,'DAT',TYTABL,TADADU) 219 : IF (IERR.NE.0) GOTO 9999 219 : CALL ACMO(TABCPR,'COF',TYTABL,TACOPR) 220 : IF (IERR.NE.0) GOTO 9999 220 : CALL ACMO(TABCDU,'COF',TYTABL,TACODU) 221 : IF (IERR.NE.0) GOTO 9999 222 : * Initialisation du gros objet de données 223 : SEGINI,TABGEO 224 : JLCOF=(NUMDER+1)*NUMOP*(NUMVPR+NUMVDU) 225 : JGCOF=NUMCPR+NUMCDU 226 : JGVD=NUMVPR+NUMVDU+NUMDPR+NUMDDU 227 : KGVD=JGVD 228 : IJLCOF=0 229 : IJGCOF=0 230 : IJGVD=0 231 : IKGVD=0 232 : SEGINI,TABVDC 233 : * géométrie 234 : LNMOTS=LEN(LGDISC) 235 : IF (LNMOTS.NE.4) THEN 236 : WRITE(IOIMP,*) 'Erreur esp. discr. geometrie' 237 : GOTO 9999 238 : ENDIF 239 : TABGEO.DISGEO=LGDISC 240 : * Pointeur bidon négatif 241 : IPBID=0 242 : * 243 : * Lecture des variables et des données primales et duales 244 : * 245 : DO IVADA=1,2 246 : DO IPRDU=1,2 247 : IF (IVADA.EQ.1) THEN 248 : CVD='VARIABLE' 249 : IF (IPRDU.EQ.1) THEN 250 : NUMVAR=NUMVPR 251 : CPD='PRIMAL ' 252 : ELSE 253 : NUMVAR=NUMVDU 254 : CPD='DUAL ' 255 : ENDIF 256 : ELSE 257 : CVD='DATA ' 258 : IF (IPRDU.EQ.1) THEN 259 : NUMVAR=NUMDPR 260 : CPD='PRIMAL ' 261 : ELSE 262 : NUMVAR=NUMDDU 263 : CPD='DUAL ' 264 : ENDIF 265 : ENDIF 266 : * 267 : DO JVAR=1,NUMVAR 268 : IJGVD=IJGVD+1 269 : IKGVD=IKGVD+1 270 : IF (IVADA.EQ.1) THEN 271 : IF (IPRDU.EQ.1) THEN 272 : TABVDC.VVARPR(JVAR)=IJGVD 273 : TAVDPD=TAVAPR 274 : ELSE 275 : TABVDC.VVARDU(JVAR)=IJGVD 276 : TAVDPD=TAVADU 277 : ENDIF 278 : ELSE 279 : IF (IPRDU.EQ.1) THEN 280 : TABVDC.VDATPR(JVAR)=IJGVD 281 : TAVDPD=TADAPR 282 : ELSE 283 : TABVDC.VDATDU(JVAR)=IJGVD 284 : TAVDPD=TADADU 285 : ENDIF 286 : ENDIF 287 : TYPE=TYTABL 287 : CALL ACCTAB(TAVDPD,'ENTIER',JVAR,XBID,CBID,LBID,IBID, 288 : $ TYPE,IBID,XBID,CBID,LBID,TABJ) 289 : IF (IERR.NE.0) GOTO 9999 290 : ** 291 : TYPE=TYMOT 291 : CALL ACCTAB(TABJ,'MOT',IBID,XBID,'DISC',LBID,IBID, 292 : $ TYPE,IBID,XBID,MYDISC,LBID,IBID) 293 : IF (IERR.NE.0) GOTO 9999 294 : TABVDC.DISVD(IKGVD)=MYDISC 295 : TABVDC.DJSVD(IJGVD)=IKGVD 296 : * 297 : TYPE=TYLMOT 297 : CALL ACCTAB(TABJ,'MOT',IBID,XBID,'NOMDDL',LBID,IBID, 298 : $ TYPE,IBID,XBID,CBID,LBID,MYLMOT) 299 : IF (IERR.NE.0) GOTO 9999 300 : TABVDC.NOMVD(IJGVD)=MYLMOT 301 : * 302 : TYPE=BLAN 302 : CALL ACCTAB(TABJ,'MOT',IBID,XBID,'VALEUR',LBID,IBID, 303 : $ TYPE,IVAL,XVAL,CBID,LBID,IOBJ) 304 : * Seules les variables sont autorisées à ne pas avoir de valeur. 305 : IF ((TYPE.EQ.BLAN).AND.(IVADA.EQ.1)) THEN 306 : TABVDC.MVD(IJGVD)=0 307 : TABVDC.XVD(IJGVD)=0.D0 308 : ELSEIF (TYPE.EQ.TYCHPO) THEN 309 : TABVDC.MVD(IJGVD)=IOBJ 310 : TABVDC.XVD(IJGVD)=0.D0 311 : ELSEIF (TYPE.EQ.TYENT) THEN 312 : IPBID=IPBID-1 313 : TABVDC.MVD(IJGVD)=IPBID 314 : TABVDC.XVD(IJGVD)=DBLE(IVAL) 315 : ELSEIF (TYPE.EQ.TYFLO) THEN 316 : IPBID=IPBID-1 317 : TABVDC.MVD(IJGVD)=IPBID 318 : TABVDC.XVD(IJGVD)=XVAL 319 : ELSE 320 : WRITE(IOIMP,*) CPD,' ',CVD,' number ',JVAR 321 : WRITE(IOIMP,*) 'wrong type = ',TYPE 322 : WRITE(IOIMP,*) 'should be = ',TYENT, ' or ' 323 : $ ,TYFLO, ' or ',TYCHPO 324 : GOTO 9999 325 : ENDIF 326 : ENDDO 327 : ENDDO 328 : ENDDO 329 : * 330 : JGVD=IJGVD 331 : KGVD=IKGVD 332 : SEGADJ,TABVDC 333 : * 334 : * Lecture des coefficients primaux et duaux 335 : * 336 : SEGACT MYCOMS 337 : CVD='COEFF. ' 338 : DO IPRDU=1,2 339 : IF (IPRDU.EQ.1) THEN 340 : NUMCOF=NUMCPR 341 : NUMDAT=NUMDPR 342 : CPD='PRIMAL ' 343 : ELSE 344 : NUMCOF=NUMCDU 345 : NUMDAT=NUMDDU 346 : CPD='DUAL ' 347 : ENDIF 348 : DO JCOF=1,NUMCOF 349 : IJGCOF=IJGCOF+1 350 : IF (IPRDU.EQ.1) THEN 351 : TABVDC.VCOFPR(JCOF)=IJGCOF 352 : TABCOF=TACOPR 353 : ELSE 354 : TABVDC.VCOFDU(JCOF)=IJGCOF 355 : TABCOF=TACODU 356 : ENDIF 357 : TYPE=TYTABL 357 : CALL ACCTAB(TABCOF,'ENTIER',JCOF,XBID,CBID,LBID,IBID, 358 : $ TYPE,IBID,XBID,CBID,LBID,TABJ) 359 : IF (IERR.NE.0) GOTO 9999 360 : ** 361 : TYP0=BLAN 361 : CALL ACCTAB(TABJ,'MOT',IBID,XBID,'COMPOR',LBID,IBID, 362 : $ TYP0,IBID,XBID,CNCOM,LBID,IBID) 363 : IF (IERR.NE.0) GOTO 9999 364 : * 365 : TYP1=BLAN 365 : CALL ACCTAB(TABJ,'MOT',IBID,XBID,'LDAT',LBID,IBID, 366 : $ TYP1,IBID,XBID,CBID,LBID,MYLENT) 367 : IF (IERR.NE.0) GOTO 9999 368 : * 369 : C TYP2=BLAN 369 : C CALL ACCTAB(TABJ,'MOT',IBID,XBID,'FACMUL',LBID,IBID, 370 : C $ TYP2,IVAL,XVAL,CBID,LBID,IBID) 371 : IF (.NOT.(TYP0.EQ.BLAN)) THEN 372 : IF (TYP0.EQ.TYMOT) THEN 372 : CALL FICOMP(CNCOM,MYCOMS,MYCOM,IMPR,IRET) 373 : IF (IRET.NE.0) GOTO 9999 374 : SEGACT MYCOM 375 : NCOCO1=MYCOM.DERCOF(/1) 376 : SEGDES MYCOM 377 : TABVDC.VCOMP(IJGCOF)=MYCOM 378 : ELSE 379 : WRITE(IOIMP,*) CPD,' ',CVD,' number ',JCOF,' . COMPOR' 380 : $ 381 : WRITE(IOIMP,*) 'wrong type = ',TYP0 382 : WRITE(IOIMP,*) 'should be = ',TYMOT 383 : GOTO 9999 384 : ENDIF 385 : IF (TYP1.EQ.BLAN) THEN 386 : JG=0 387 : SEGINI MYLENT 388 : SEGDES MYLENT 389 : TYP1=TYLENT 390 : ENDIF 391 : IF (TYP1.EQ.TYLENT) THEN 392 : SEGACT MYLENT 393 : NCOCO2=MYLENT.LECT(/1) 394 : JG=NCOCO2 395 : SEGINI LDAT 396 : LBID=.TRUE. 397 : DO ICOCO2=1,NCOCO2 398 : IBID=MYLENT.LECT(ICOCO2) 399 : IF (IBID.LT.1.OR.IBID.GT.NUMDAT) LBID=.FALSE. 400 : IF (IPRDU.EQ.1) THEN 401 : LDAT.LECT(ICOCO2)=TABVDC.VDATPR(IBID) 402 : ELSE 403 : LDAT.LECT(ICOCO2)=TABVDC.VDATDU(IBID) 404 : ENDIF 405 : ENDDO 406 : SEGDES MYLENT 407 : SEGDES LDAT 408 : IF (.NOT.NCOCO1.EQ.NCOCO2) THEN 409 : WRITE(IOIMP,*) CPD,' ',CVD,' number ',JCOF 410 : $ ,' . LDAT' 411 : WRITE(IOIMP,*) 'wrong length = ',NCOCO2 412 : WRITE(IOIMP,*) 'should be = ',NCOCO1 413 : GOTO 9999 414 : ENDIF 415 : IF (.NOT.LBID) THEN 416 : WRITE(IOIMP,*) CPD,' ',CVD,' number ',JCOF 417 : $ ,' . LDAT' 418 : WRITE(IOIMP,*) 'some values out of range [1,', 419 : $ NUMDAT,']' 420 : SEGPRT,MYLENT 421 : GOTO 9999 422 : ENDIF 423 : TABVDC.VLDAT(IJGCOF)=LDAT 424 : ELSE 425 : WRITE(IOIMP,*) CPD,' ',CVD,' number ',JCOF 426 : $ ,' . LDAT' 427 : WRITE(IOIMP,*) 'wrong type = ',TYP1 428 : WRITE(IOIMP,*) 'should be = ',TYLENT 429 : GOTO 9999 430 : ENDIF 431 : C IF (TYP2.EQ.TYENT) THEN 432 : C XCOF=DBLE(IVAL) 433 : C ELSEIF (TYP2.EQ.TYFLO) THEN 434 : C XCOF=XVAL 435 : C ELSEIF (TYP2.EQ.BLAN) THEN 436 : C XCOF=1.D0 437 : C ELSE 438 : C WRITE(IOIMP,*) CPD,' ',CVD,' number ',JCOF 439 : C $ ,' . FACMUL' 440 : C WRITE(IOIMP,*) 'wrong type = ',TYP2 441 : C WRITE(IOIMP,*) 'should be = ',TYENT, ' or ',TYFLO 442 : C GOTO 9999 443 : C ENDIF 444 : C IF (IPRDU.EQ.1) THEN 445 : C TABVDC.XCOFPR(JCOF)=XCOF 446 : C ELSE 447 : C TABVDC.XCOFDU(JCOF)=XCOF 448 : C ENDIF 449 : ENDIF 450 : ENDDO 451 : ENDDO 452 : SEGDES MYCOMS 453 : JGCOF=IJGCOF 454 : SEGADJ,TABVDC 455 : * 456 : * Lecture des listes de coefficients (pour la table primale et 457 : * et la table duale) 458 : * 459 : CVD='LISTCOEF' 460 : DO IPRDU=1,2 461 : IF (IPRDU.EQ.1) THEN 462 : NUMVAR=NUMVPR 463 : TABLC=TABCPR 464 : CPD='PRIMAL ' 465 : ELSE 466 : NUMVAR=NUMVDU 467 : TABLC=TABCDU 468 : CPD='DUAL ' 469 : ENDIF 470 : DO IOP=1,NUMOP 471 : TYPE=TYTABL 471 : CALL ACCTAB(TABLC,'ENTIER',IOP,XBID,CBID,LBID,IBID, 472 : $ TYPE,IBID,XBID,CBID,LBID,TABI) 473 : IF (IERR.NE.0) GOTO 9999 474 : DO JVAR=1,NUMVAR 475 : TYPE=TYTABL 475 : CALL ACCTAB(TABI,'ENTIER',JVAR,XBID,CBID,LBID,IBID, 476 : $ TYPE,IBID,XBID,CBID,LBID,TABJ) 477 : DO KDER=0,NUMDER 478 : TYPE=BLAN 478 : CALL ACCTAB(TABJ,'ENTIER',KDER,XBID,CBID,LBID,IBID, 479 : $ TYPE,IBID,XBID,CBID,LBID,MYLENT) 480 : ** 481 : IF (.NOT.(TYPE.EQ.BLAN)) THEN 482 : IF (TYPE.EQ.TYLENT) THEN 483 : IJLCOF=IJLCOF+1 484 : SEGACT MYLENT 485 : NLCOF=MYLENT.LECT(/1) 486 : JG=JGCOF 487 : SEGINI POWCOF 488 : DO ILCOF=1,NLCOF 489 : INUC=MYLENT.LECT(ILCOF) 490 : IAINUC=ABS(INUC) 491 : IF (IPRDU.EQ.1) THEN 492 : IF ((IAINUC.LE.0).OR.(IAINUC.GT.NUMCPR)) 493 : $ THEN 494 : WRITE(IOIMP,*) CPD,' ',CVD,' operator ' 495 : $ ,IOP 496 : WRITE(IOIMP,*) 'variable ',JVAR, 497 : $ ' derivative ',KDER 498 : WRITE(IOIMP,*) 499 : $ 'some values out of range [1,' 500 : $ ,NUMCPR,']U[-',NUMCPR,',-1]' 501 : SEGPRT,MYLENT 502 : GOTO 9999 503 : ENDIF 504 : IGCOF=TABVDC.VCOFPR(IAINUC) 505 : ELSE 506 : IF ((IAINUC.LE.0).OR.(IAINUC.GT.NUMCDU)) 507 : $ THEN 508 : WRITE(IOIMP,*) CPD,' ',CVD,' operator ' 509 : $ ,IOP 510 : WRITE(IOIMP,*) 'variable ',JVAR, 511 : $ ' derivative ',KDER 512 : WRITE(IOIMP,*) 513 : $ 'some values out of range [1,' 514 : $ ,NUMCDU,']',']U[-',NUMCDU,',-1]' 515 : SEGPRT,MYLENT 516 : GOTO 9999 517 : ENDIF 518 : IGCOF=TABVDC.VCOFDU(IAINUC) 519 : ENDIF 520 : IF (INUC.GT.0) THEN 521 : POWCOF.LECT(IGCOF)=POWCOF.LECT(IGCOF)+1 522 : ELSEIF(INUC.LT.0) THEN 523 : POWCOF.LECT(IGCOF)=POWCOF.LECT(IGCOF)-1 524 : ELSE 525 : WRITE(IOIMP,*) 'Programming error 1' 526 : GOTO 9999 527 : ENDIF 528 : ENDDO 529 : SEGDES MYLENT 530 : SEGDES POWCOF 531 : TABVDC.VLCOF(IJLCOF)=POWCOF 532 : IF (IPRDU.EQ.1) THEN 533 : TABVDC.ILCPR(KDER+1,IOP,JVAR)=IJLCOF 534 : ELSE 535 : TABVDC.ILCDU(KDER+1,IOP,JVAR)=IJLCOF 536 : ENDIF 537 : ELSE 538 : WRITE(IOIMP,*) CPD,' ',CVD,' operator ',IOP 539 : WRITE(IOIMP,*) 'variable ',JVAR, 540 : $ ' derivative ',KDER 541 : WRITE(IOIMP,*) 'wrong type = ',TYPE 542 : WRITE(IOIMP,*) 'should be = ',TYLENT 543 : GOTO 9999 544 : ENDIF 545 : ELSE 546 : IF (IPRDU.EQ.1) THEN 547 : TABVDC.ILCPR(KDER+1,IOP,JVAR)=0 548 : ELSE 549 : TABVDC.ILCDU(KDER+1,IOP,JVAR)=0 550 : ENDIF 551 : ENDIF 552 : ENDDO 553 : ENDDO 554 : ENDDO 555 : ENDDO 556 : JLCOF=IJLCOF 557 : SEGADJ,TABVDC 558 : * 559 : * On supprime les doublons dans les listes d'espaces de discrétisation 560 : * et on corrige les pointeurs sur cette liste 561 : * 562 : JG=KGVD 563 : JG=KGVD 564 : SEGINI KREP 565 : IKGVD2=1 566 : KREP.LECT(1)=IKGVD2 567 : DO IKGVD=2,KGVD 568 : LFOUND=.FALSE. 569 : IKGVD3=0 570 : 12 CONTINUE 571 : IKGVD3=IKGVD3+1 572 : IF (TABVDC.DISVD(IKGVD3).EQ.TABVDC.DISVD(IKGVD)) THEN 573 : LFOUND=.TRUE. 574 : ELSE 575 : IF (IKGVD3.LT.IKGVD2) THEN 576 : GOTO 12 577 : ENDIF 578 : ENDIF 579 : IF (.NOT.LFOUND) THEN 580 : IKGVD2=IKGVD2+1 581 : KREP.LECT(IKGVD)=IKGVD2 582 : TABVDC.DISVD(IKGVD2)=TABVDC.DISVD(IKGVD) 583 : ELSE 584 : KREP.LECT(IKGVD)=IKGVD3 585 : ENDIF 586 : ENDDO 587 : KGVD=IKGVD2 588 : SEGADJ,TABVDC 589 : * 590 : DO IJGVD=1,JGVD 591 : TABVDC.DJSVD(IJGVD)=KREP.LECT(TABVDC.DJSVD(IJGVD)) 592 : ENDDO 593 : SEGSUP KREP 594 : * 595 : * On supprime les doublons dans les listes d'espaces de champs 596 : * et on corrige les pointeurs sur cette liste 597 : * 598 : JG=JGVD 599 : SEGINI KREP 600 : IJGVD2=1 601 : KREP.LECT(1)=IJGVD2 602 : DO IJGVD=2,JGVD 603 : LFOUND=.FALSE. 604 : IJGVD3=0 605 : 22 CONTINUE 606 : IJGVD3=IJGVD3+1 607 : IF (TABVDC.DJSVD(IJGVD3).EQ.TABVDC.DJSVD(IJGVD) 608 : $ .AND.TABVDC.NOMVD(IJGVD3).EQ.TABVDC.NOMVD(IJGVD) 609 : $ .AND.TABVDC.MVD(IJGVD3).EQ.TABVDC.MVD(IJGVD) 610 : $ ) THEN 611 : LFOUND=.TRUE. 612 : ELSE 613 : IF (IJGVD3.LT.IJGVD2) THEN 614 : GOTO 22 615 : ENDIF 616 : ENDIF 617 : IF (.NOT.LFOUND) THEN 618 : IJGVD2=IJGVD2+1 619 : KREP.LECT(IJGVD)=IJGVD2 620 : TABVDC.DJSVD(IJGVD2)=TABVDC.DJSVD(IJGVD) 621 : TABVDC.NOMVD(IJGVD2)=TABVDC.NOMVD(IJGVD) 622 : TABVDC.MVD(IJGVD2)=TABVDC.MVD(IJGVD) 623 : TABVDC.XVD(IJGVD2)=TABVDC.XVD(IJGVD) 624 : ELSE 625 : KREP.LECT(IJGVD)=IJGVD3 626 : ENDIF 627 : ENDDO 628 : JGVD=IJGVD2 629 : SEGADJ,TABVDC 630 : * 631 : DO JVARPR=1,NUMVPR 632 : TABVDC.VVARPR(JVARPR)=KREP.LECT(TABVDC.VVARPR(JVARPR)) 633 : ENDDO 634 : DO JVARDU=1,NUMVDU 635 : TABVDC.VVARDU(JVARDU)=KREP.LECT(TABVDC.VVARDU(JVARDU)) 636 : ENDDO 637 : DO JDATPR=1,NUMDPR 638 : TABVDC.VDATPR(JDATPR)=KREP.LECT(TABVDC.VDATPR(JDATPR)) 639 : ENDDO 640 : DO JDATDU=1,NUMDDU 641 : TABVDC.VDATDU(JDATDU)=KREP.LECT(TABVDC.VDATDU(JDATDU)) 642 : ENDDO 643 : DO IJGCOF=1,JGCOF 644 : LDAT=TABVDC.VLDAT(IJGCOF) 645 : SEGACT LDAT*MOD 646 : NLDAT=LDAT.LECT(/1) 647 : DO ILDAT=1,NLDAT 648 : LDAT.LECT(ILDAT)=KREP.LECT(LDAT.LECT(ILDAT)) 649 : ENDDO 650 : SEGDES LDAT 651 : ENDDO 652 : SEGSUP KREP 653 : * On supprime les doublons dans les coefficients 654 : * et on corrige les pointeurs sur cette liste 655 : IF (JGCOF.GT.1) THEN 656 : JG=JGCOF 657 : SEGINI KREP 658 : IJGCO2=1 659 : KREP.LECT(1)=IJGCO2 660 : DO IJGCOF=2,JGCOF 661 : LFOUND=.FALSE. 662 : LDAT=TABVDC.VLDAT(IJGCOF) 663 : IJGCO3=0 664 : 32 CONTINUE 665 : IJGCO3=IJGCO3+1 666 : IF (TABVDC.VCOMP(IJGCO3).EQ.TABVDC.VCOMP(IJGCOF)) THEN 667 : LDAT3=TABVDC.VLDAT(IJGCO3) 667 : CALL EGLENT(LDAT3,LDAT,LEGDAT,IMPR,IRET) 668 : IF (IRET.NE.0) GOTO 9999 669 : IF (LEGDAT) THEN 670 : LFOUND=.TRUE. 671 : ENDIF 672 : ELSE 673 : IF (IJGCO3.LT.IJGCO2) THEN 674 : GOTO 32 675 : ENDIF 676 : ENDIF 677 : IF (.NOT.LFOUND) THEN 678 : IJGCO2=IJGCO2+1 679 : KREP.LECT(IJGCOF)=IJGCO2 680 : TABVDC.VCOMP(IJGCO2)=TABVDC.VCOMP(IJGCOF) 681 : C Je ne suis pas arrivé à savoir quand il faut supprimmer les segments 682 : C LDAT=TABVDC.VLDAT(IJGCO2) 683 : C* SEGACT LDAT*MOD 684 : C SEGSUP LDAT 685 : TABVDC.VLDAT(IJGCO2)=TABVDC.VLDAT(IJGCOF) 686 : ELSE 687 : KREP.LECT(IJGCOF)=IJGCO3 688 : C LDAT=TABVDC.VLDAT(IJGCO3) 689 : C* SEGACT LDAT*MOD 690 : C SEGSUP LDAT 691 : ENDIF 692 : ENDDO 693 : C DO IJGCOF=IJGCO2+1,JGCOF 694 : C LDAT=TABVDC.VLDAT(IJGCOF) 695 : C* SEGACT LDAT*MOD 696 : C SEGSUP LDAT 697 : C ENDDO 698 : JGCOF=IJGCO2 699 : SEGADJ,TABVDC 700 : * 701 : DO JCOFPR=1,NUMCPR 702 : TABVDC.VCOFPR(JCOFPR)=KREP.LECT(TABVDC.VCOFPR(JCOFPR)) 703 : ENDDO 704 : DO JCOFDU=1,NUMCDU 705 : TABVDC.VCOFDU(JCOFDU)=KREP.LECT(TABVDC.VCOFDU(JCOFDU)) 706 : ENDDO 707 : * 708 : DO IJLCOF=1,JLCOF 709 : POWCOF=TABVDC.VLCOF(IJLCOF) 710 : SEGACT POWCOF 711 : JG=JGCOF 712 : SEGINI POWCO2 713 : DO IPC=1,POWCOF.LECT(/1) 714 : IPC2=KREP.LECT(IPC) 715 : POWCO2.LECT(IPC2)=POWCO2.LECT(IPC2)+POWCOF.LECT(IPC) 716 : ENDDO 717 : SEGDES POWCO2 718 : SEGSUP POWCOF 719 : TABVDC.VLCOF(IJLCOF)=POWCO2 720 : ENDDO 721 : SEGSUP KREP 722 : ENDIF 723 : 724 : * On supprime les doublons dans les listes de coefficients 725 : * et on corrige les pointeurs sur cette liste 726 : IF (JLCOF.GT.1) THEN 727 : JG=JLCOF 728 : SEGINI KREP 729 : IJLCO2=1 730 : KREP.LECT(1)=IJLCO2 731 : DO IJLCOF=2,JLCOF 732 : LFOUND=.FALSE. 733 : LCOF=TABVDC.VLCOF(IJLCOF) 734 : IJLCO3=0 735 : 42 CONTINUE 736 : IJLCO3=IJLCO3+1 737 : LCOF3=TABVDC.VLCOF(IJLCO3) 737 : CALL EGLENT(LCOF3,LCOF,LEGCOF,IMPR,IRET) 738 : IF (LEGCOF) THEN 739 : LFOUND=.TRUE. 740 : ELSE 741 : IF (IJLCO3.LT.IJLCO2) THEN 742 : GOTO 42 743 : ENDIF 744 : ENDIF 745 : IF (.NOT.LFOUND) THEN 746 : IJLCO2=IJLCO2+1 747 : KREP.LECT(IJLCOF)=IJLCO2 748 : C Je ne suis pas arrivé à savoir quand il faut supprimmer les segments 749 : C LCOF=TABVDC.VLCOF(IJLCO2) 750 : C* SEGACT LCOF*MOD 751 : C SEGSUP LCOF 752 : TABVDC.VLCOF(IJLCO2)=TABVDC.VLCOF(IJLCOF) 753 : ELSE 754 : KREP.LECT(IJLCOF)=IJLCO3 755 : C LCOF=TABVDC.VLCOF(IJLCO3) 756 : C* SEGACT LCOF*MOD 757 : C SEGSUP LCOF 758 : ENDIF 759 : ENDDO 760 : C DO IJLCOF=IJLCO2+1,JLCOF 761 : C LCOF=TABVDC.VLCOF(IJLCOF) 762 : C* SEGACT LCOF*MOD 763 : C SEGSUP LCOF 764 : C ENDDO 765 : JLCOF=IJLCO2 766 : SEGADJ,TABVDC 767 : * 768 : DO IOP=1,NUMOP 769 : DO IDER=1,NUMDER+1 770 : DO JVARPR=1,NUMVPR 771 : IJLCOF=TABVDC.ILCPR(IDER,IOP,JVARPR) 772 : IF (IJLCOF.NE.0) THEN 773 : TABVDC.ILCPR(IDER,IOP,JVARPR)= 774 : $ KREP.LECT(IJLCOF) 775 : ENDIF 776 : ENDDO 777 : DO JVARDU=1,NUMVDU 778 : IJLCOF=TABVDC.ILCDU(IDER,IOP,JVARDU) 779 : IF (IJLCOF.NE.0) THEN 780 : TABVDC.ILCDU(IDER,IOP,JVARDU)= 781 : $ KREP.LECT(IJLCOF) 782 : ENDIF 783 : ENDDO 784 : ENDDO 785 : ENDDO 786 : SEGSUP KREP 787 : ENDIF 788 : * 789 : * On crée le champ par éléments contenant les coordonnées 790 : * des points servant pour la transformation géométrique 791 : * (ddl de la transformation géométrique)... 792 : * 793 : MYDISC=TABGEO.DISGEO 793 : CALL MKCOOR(CGEOME,MYDISC, 794 : $ MYFALS, 795 : $ ICOOR, 796 : $ IMPR,IRET) 797 : IF (IRET.NE.0) GOTO 9999 798 : TABGEO.IGEO=ICOOR 799 : * 800 : * On teste les noms des ddls des variables et des coefficients 801 : * 802 : DO IJGVD=1,JGVD 803 : MYDISC=TABVDC.DISVD(TABVDC.DJSVD(IJGVD)) 804 : MYLMOT=TABVDC.NOMVD(IJGVD) 804 : CALL KECOM6(CGEOME,MYLMOT,MYDISC, 805 : $ MYFALS, 806 : $ IMPR,IRET) 807 : IF (IRET.NE.0) GOTO 9999 808 : ENDDO 809 : * 810 : * On crée les champs par éléments correspondant aux éventuels 811 : * champs de variables et aux champs coefficients (globaux) 812 : * 813 : SEGINI,TATRAV 814 : DO IJGVD=1,JGVD 815 : MYDISC=TABVDC.DISVD(TABVDC.DJSVD(IJGVD)) 816 : MYLMOT=TABVDC.NOMVD(IJGVD) 817 : MYCHPO=TABVDC.MVD(IJGVD) 818 : MYREAL=TABVDC.XVD(IJGVD) 819 : * segprt,mychpo 819 : CALL CP2CV7(CGEOME,MYLMOT,MYDISC,MYCHPO,MYREAL, 820 : $ MYFALS, 821 : $ MYMCHA, 822 : $ IMPR,IRET) 823 : IF (IRET.NE.0) GOTO 9999 824 : * segprt,mymcha 825 : TATRAV.IVD(IJGVD)=MYMCHA 826 : ENDDO 827 : * 828 : * Fin... 829 : * 830 : SEGDES,TATRAV 831 : SEGDES,TABVDC 832 : SEGDES,TABGEO 833 : * SEGPRT,TABGEO 834 : * SEGPRT,TABVDC 835 : * 836 : * Normal termination 837 : * 838 : IRET=0 839 : RETURN 840 : * 841 : * Format handling 842 : * 843 : * 844 : * Error handling 845 : * 846 : 9999 CONTINUE 847 : IRET=1 848 : WRITE(IOIMP,*) 'An error was detected in subroutine prlin3' 849 : RETURN 850 : * 851 : * End of subroutine PRLIN3 852 : * 853 : END 854 : 855 : 856 :
© Cast3M 2003 - All rights reserved.
Disclaimer