C LANCZ3 SOURCE PV 11/02/18 21:15:04 6875 SUBROUTINE LANCZ3 IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) ************************************************************************ * * L A N C Z 3 * ----------- * * FONCTION: * --------- * * CREATION DES OBJETS 'RIGIDITE' DU PROBLEME REDUIT TRIDIAGONAL * SYMETRIQUE: * * | A1 B1 0 0 0 | | S1 0 0 0 0 | * | B1 A2 B2 0 0 | | 0 S2 0 0 0 | * "TRID" = | 0 B2 A3 B3 0 | "DIAG" = | 0 0 S3 0 0 | * | 0 0 B3 A4 B4 | | 0 0 0 S4 0 | * | 0 0 0 B4 A5 | | 0 0 0 0 S5 | * * (EXEMPLE D'UN PROBLEME REDUIT A LA TAILLE 5) * * MODE D'APPEL: * ------------- * * CALL LANCZ3 * * PARAMETRES: (E)=ENTREE (S)=SORTIE * ----------- * * +A1 REEL DP (E) * +B1 REEL DP (E) * +IPV1 ENTIER (E) * +NUMV ENTIER (E) * +S1 REEL DP (E) * +IPDIAG ENTIER E/S * +IPTRID ENTIER E/S * +IPTABV ENTIER E/S * * + = PARAMETRE PASSE PAR L'UN DES COMMUNS "CLANCZ" ET "CSIMUL" * (VOIR LES DEFINITIONS DETAILLEES DANS LE SOUS-PROGRAMME "SIMUL0"). * * LEXIQUE: (ORDRE ALPHABETIQUE) * -------- * * A0 REEL DP VALEUR DE "A1" A L'ITERATION PRECEDENTE. * IPCOMP ENTIER POINTEUR DU 'LISTMOTS' CONTENANT LE NOM DES * COMPOSANTES DES POINTS DES 'RIGIDITES' CREEES * (VOIR LE SOUS-PROGRAMME "MANRIG"). * IPLM1 ENTIER POINTEUR DU SUPPORT GEOMETRIQUE (OBJET * 'MAILLAGE') D'UNE PARTIE DE LA 'RIGIDITE' "DIAG" * IPLM2 ENTIER POINTEUR DU SUPPORT GEOMETRIQUE (OBJET * 'MAILLAGE') D'UNE PARTIE DE LA 'RIGIDITE' "TRID" * IPOIN0 ENTIER POINT CREE A L'ITERATION PRECEDENTE. * IPOIN1 ENTIER POINT CREE POUR DEFINIR DES SUPPORTS * GEOMETRIQUES AUX 'RIGIDITES' CREEES. * IPS ENTIER POINTEUR D'UN 'LISTREEL' CONTENANT UNE MATRICE * ELEMENTAIRE DE LA 'RIGIDITE' "DIAG". * IP0BA ENTIER POINTEUR D'UN 'LISTREEL' CONTENANT UNE MATRICE * ELEMENTAIRE DE LA 'RIGIDITE' "TRID". * LISPO1 ENTIER CONTIENT LE OU LES POINTS UTILE(S) POUR CREER * UN SUPPORT GEOMETRIQUE. * * MODE DE FONCTIONNEMENT: * ----------------------- * * "TRID" ET "DIAG" SONT FAITES PAR AJOUT D'UNE PETITE 'RIGIDITE' A * CHAQUE CREATION D'UN NOUVEAU VECTEUR DE LANCZOS. CES 'RIGIDITES' * SONT DE LA FORME (POUR LE VECTEUR NUMERO "I"): * * POUR "DIAG": |S(I)| (MATRICE 1X1) * * POUR "TRID": | 0 B(I)| SAUF LA 1ERE FOIS: |A(1) B(2)| * |B(I) A(I)| |B(2) A(2)| * * PAR RAPPORT AUX NOTATIONS DU PARAGRAPHE "FONCTION", ON A: * A(1) = A1, A(2) = A2, ... * S(1) = S1, S(2) = S2, ... * MAIS: B(2) = B1, B(3) = B2, ... * * SOUS-PROGRAMMES APPELES: * ------------------------ * * CREPO1, DTRIGI, FUSRIG, INSER0, MANELM, MANRIG, PRRIGI. * * AUTEUR, DATE DE CREATION: * ------------------------- * * PASCAL MANIGOT 25 AVRIL 1985 * * LANGAGE: * -------- * * ESOPE + FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS. * ************************************************************************ * -INC CCOPTIO -INC SMLREEL -INC SMCOORD -INC SMTABLE -INC SMELEME -INC SMRIGID -INC SMLENTI * * REGOUPEMENT DE RENSEIGNEMENTS POUR LES SOUS-PROGRAMMES "LANCZ.": COMMON/CLANCZ/ A1,B1,S0,S1,NOMBRV,NUMV,NUMV1,IPV0,IPV1 & ,IPMV1,IPVV,IPKVV,IPVTKV,IPLMOX,IPLMOY, & IVEV1, IVEMV1,ivev0,ipla,iplb,iplc * * REGROUPEMENT D'INFORMATIONS POUR LES SOUS-PROGRAMMES "SIMUL.": COMMON/CSIMUL/ W2SHIF,IPTTA,IPTTB,IPTABV,IPTRID,IPDIAG,iptvev, $ mvecri * * nbno=xcoor(/1)/(idim+1) nbpts=nbno+numv segadj mcoord * mlree1=ipla mlree2=iplb mlree3=iplc mlent1=ipvv mlent3=ivev1 segact mlent1,mlent3 M=numv segini mtable,mtab1 iptvev=mtab1 iptabv=mtable mlotab=m * write(6,18)'ipla ',(iou, mlree1.prog(iou),iou=1,mlree1.prog(/1)) * write(6,18)'iplb ',(iou, mlree2.prog(iou),iou=1,mlree1.prog(/1)) * write(6,18)'iplc ',(iou, mlree3.prog(iou),iou=1,mlree1.prog(/1)) * 18 format( A6,(I6,2X, f15.8,3X,I6,2X,f15.8)) do iou=1,m mtabti(iou)='POINT' mtabii(iou)=nbno+iou * write(6,*) iou, 'ieme point cree numero ',nbno+iou mtabtv(iou)='CHPOINT' mtabiv(iou)=mlent1.lect(iou) mtab1.mtabiv(iou)=mlent3.lect(iou) enddo * on commence par la matrice "ipdiag" nbelem=numv nbnn=1 nbsous=0 nbref=0 segini meleme itypel=1 nrigel=1 segini mrigid coerig(1)=1.d0 mtymat='MASSE' nligrp=1 nligrd=1 segini descr lisinc(1)='ALFA' lisdua(1)='FALF' noelep(1)=1 noeled(1)=1 segdes descr irigel(1,1)=meleme irigel(3,1)=descr nelrig=numv segini xmatri irigel(4,1)=xmatri irigel(5,1)=nifour do irig=1,numv num(1,irig)=nbno+irig re(1,1,irig)=mlree3.prog(irig) enddo ipdiag=mrigid * on continue par matrice tridiagonale "iptrid" nbelem=numv-1 nbnn=2 nbsous=0 nbref=0 segini meleme itypel=2 nrigel=1 segini mrigid coerig(1)=1.d0 mtymat='RIGIDITE' nligrp=2 nligrd=2 segini descr lisinc(1)='ALFA' lisinc(2)='ALFA' lisdua(1)='FALF' lisdua(2)='FALF' noelep(1)=1 noelep(2)=2 noeled(1)=1 noeled(2)=2 segdes descr irigel(1,1)=meleme irigel(3,1)=descr nelrig=numv-1 segini xmatri irigel(4,1)=xmatri irigel(5,1)=nifour do irig=1,numv-1 num(1,irig)=nbno+irig num(2,irig)=nbno+irig+1 if(irig.eq.1)re(1,1,irig)=mlree1.prog(irig) re(1,2,irig)=mlree2.prog(irig) re(2,1,irig)=mlree2.prog(irig) re(2,2,irig)=mlree1.prog(irig+1) enddo iptrid=mrigid RETURN END