Sources Esope | Cast3M

resock
C RESOCK    SOURCE    FANDEUR   22/05/02    21:15:30     11359          
      SUBROUTINE RESOCK(IZB,IZL,IZR)
C************************************************************************
C
C  1/ KTYPI = 1 OU 5
C
C    RESOLUTION (MONTEE DESCENTE) D'UNE MATRICE SYMETRIQUE LIGNE A LIGNE
C    PRECEDEMMENT TRIANGULEE PAR TRIAWS
C
C    POINTEUR : EN ENTREE IZL  CONTIENT LA MATRICE TRIANGULEE
C                         IZB  CONTIENT LE SECOND MEMBRE
C               EN SORTIE IZB  CONTIENT LA SOLUTION
C
C    VERSION OPTIMISEE EN GESTION MEMOIRE POUR LES TRES GROSSES
C    MATRICES. ON UTILISE L'ALGORITHME MRU (AVEC LA MODIFICATION
C    DANS OOOMWD) POUR LES BLOCS DE LA MATRICE. CECI EVITE DE TRANSFERER
C    SUR DISQUE LE RESTE DU CONTENU DE LA MEMOIRE, I.E. LES TABLEAUX
C    VITESSE, TEMPERATURE, ETC... QUI AURAIENT A ETRE RAPPELES DES
C    LA RESOLUTION TERMINEE.
C
C************************************************************************
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
      REAL*8 AUX,BJ
C-INC SMMATRAKANC
C*************************************************************************
C
C    REPERAGE ET STOKAGE DES MATRICES ELEMENTAIRES  puis assemblees
C
 
* LGEOC SPG de la pression et/ou des multiplicateurs de Lagrange
* (points CENTRE ) pour chaque operateur de contrainte
* KGEOC SPG pour la totalite des points CENTRE.
* KGEOS SPG pour la totalite des points SOMMET (Diagonale vitesse)
* KLEMC Connectivites de l'ensemble des contraintes
* LIZAFM(NBSOUS) contient les pointeurs IZAFM des sous-zones
 
      SEGMENT MATRAK
      INTEGER LGEOC(NBOP),IDEBS(NBOP),IFINS(NBOP)
      INTEGER LIZAFM(NBSOUS)
      INTEGER IKAM0 (NBSOUS)
      INTEGER IMEM  (NBELC)
      INTEGER KLEMC,KGEOS,KGEOC,KDIAG,KCAC,KIZCL,KIZGC
      ENDSEGMENT
 
      SEGMENT IZAFM
      REAL*8  AM(NNELP,NP,IESP),RPGI(NELAX)
      ENDSEGMENT
 
      POINTEUR IPMJ.IZAFM,IPMK.IZAFM
 
C*******************************************************************
-INC SMMATRK1
-INC SMCHPOI
      SEGMENT/IZA/(A(1)*D)
      SEGMENT/IZD/(D(1)*D)
 
      REAL*8   DDOT
      EXTERNAL DDOT
      EXTERNAL DAXPY
 
      KTYPI = 1
      MPOVAL=IZB
      SEGACT MPOVAL,IZL*MOD
      IDMAT=KZA1
      SEGACT IDMAT
      NBLK=IDESCR(/1)
C
C---------------------METHODE DIRECTE-----------------------*
C
      NL=VPOCHA(/1)
      N1=B(/1)
 
C---  LE SECOND MEMBRE EST R{ORDONN{ DANS LA NUM{ROTATION OPTIMIS{E
 
      DO I=1,NL
        B(I)=VPOCHA(NUNA(I),1)
      ENDDO
 
C     WRITE(6,*)' RESOCK BB: NL=',NL
C     WRITE(6,1002)(VPOCHA(I,1),I=1,NL)
C     WRITE(6,*)' NUNA'
C     WRITE(6,1001)(NUNA(I),I=1,NL)
C1001 FORMAT(20(1X,I5))
 
      SEGDES MPOVAL
      N1=KZA(/1)
      IF(KTYPI.EQ.5)GOTO 50
      IF(N1.NE.NL)CALL ARRET(0)
C
C         DESCENTE
C
      CALL OOOMRU(1)
      DO 100 IBLK=1,NBLK
      IJD=NLDBLK(IBLK)
      IJF=NLDBLK(IBLK+1)-1
      IDBLK=IDESCR(IBLK)
      SEGACT IDBLK
      IZA=IMAT
      SEGACT IZA
      DO 1 I=IJD,IJF
      AUX=0.D0
C LA=LONGUEUR DE LA LIGNE I
      LA=IDEBLK(I-IJD+2)-IDEBLK(I-IJD+1)
C DÉCALAGE DANS LE TABLEAU POUR ACCÉDER À LA LIGNE I
C - NUMÉRO DE LA LIGNE I DANS LE BLOC =I-IJD+1
      IDECI=IDEBLK(I-IJD+1)-1
      IF(LA.EQ.0)GO TO 3
      JMIN=I-LA
      AUX=DDOT(LA,A(IDECI+1),1,B(JMIN),1)
 3    CONTINUE
      B(I)=B(I)-AUX
 1    CONTINUE
      SEGDES IZA*(NOMOD,MRU)
      SEGDES IDBLK*(NOMOD,MRU)
 100  CONTINUE
C
      IZD=IDIAG
      SEGACT IZD
C     write(6,*)' DIAGONALE'
C     NDI=D(/1)
C     write(6,1002)(D(I),I=1,NDI)
C     write(6,*)' B=       '
C     NBI=B(/1)
C     write(6,1002)(B(I),I=1,NBI)
 
      CALL DIVISE(NL,B,B,D)
      SEGDES IZD*(NOMOD,MRU)
C
C         REMONTEE
C
      DO 200 KBLK=1,NBLK
      IBLK=NBLK-KBLK+1
      IJD=NLDBLK(IBLK)
      IJF=NLDBLK(IBLK+1)-1
      IDBLK=IDESCR(IBLK)
      SEGACT IDBLK
      IZA=IMAT
      SEGACT IZA
      DO 9 K=IJD,IJF
      I=IJF-K+IJD
C LA=LONGUEUR DE LA LIGNE I
      LA=IDEBLK(I-IJD+2)-IDEBLK(I-IJD+1)
C DÉCALAGE DANS LE TABLEAU POUR ACCÉDER À LA LIGNE I
C - NUMÉRO DE LA LIGNE I DANS LE BLOC =I-IJD+1
      IDECI=IDEBLK(I-IJD+1)-1
      IF(LA.EQ.0)GO TO 9
      JMIN=I-LA
      J2=I-1
      BJ=-B(I)
      CALL DAXPY(LA,BJ,A(IDECI+1),1,B(JMIN),1)
 9    CONTINUE
      SEGDES IZA*(NOMOD,MRU)
      SEGDES IDBLK*(NOMOD,MRU)
 200  CONTINUE
      CALL OOOMRU(0)
 
C---  LE R{SULTAT EST R{ORDONN{ DANS LA NUM{ROTATION NATURELLE
 
      MPOVAL=IZR
      SEGACT MPOVAL*MOD
      DO 31 I=1,NL
      VPOCHA(I,1)=B(NUAN(I))
 31   CONTINUE
 
C      WRITE(6,*)' RESOCK BB:EN SORTIE NL=',NL
C      WRITE(6,1002)(VPOCHA(I,1),I=1,NL)
C      WRITE(6,1002)(B(I)       ,I=1,NL)
C      WRITE(6,*)' NUAN'
C      WRITE(6,1001)(NUAN(I),I=1,NL)
 
      SEGDES MPOVAL,IZL
      SEGDES IDMAT
      RETURN
C
C     KTYPI=5 LES SEGMENTS ONT ETE ACTIVES
C
   50 CONTINUE
      IF(N1.NE.NL)CALL ARRET(0)
C
C         DESCENTE
C
      DO 51 I=2,NL
      IZA=KZA(I)
      AUX=0.D0
      LA=A(/1)
      IF(LA.EQ.0)GO TO 53
      JMIN=I-LA
      AUX=DDOT(LA,A(1),1,B(JMIN),1)
 53   CONTINUE
      B(I)=B(I)-AUX
 51   CONTINUE
C
      IZD=KZA(1)
      CALL DIVISE(NL,B,B,D)
C
C         REMONTEE
C
      DO 59 K=2,NL
      J=NL-K+2
      IZA=KZA(J)
      LA=A(/1)
      IF(LA.EQ.0)GO TO 59
      JMIN=J-LA
      J2=J-1
      BJ=-B(J)
      CALL DAXPY(LA,BJ,A,1,B(JMIN),1)
 59   CONTINUE
C
C------- FIN RESOLUTION DIRECTE  -------*
C
      RETURN
 1002 FORMAT(10(1X,1PE11.4))
      END