Esope source files

   1 : C REZOLU    SOURCE    GOUNAND   12/11/12    21:15:07     7563           
   2 :       SUBROUTINE REZOLU(IDMAT,
   3 :      $     KS2B,
   4 :      $     IMPR,IRET)
   5 :       IMPLICIT INTEGER(I-N)
   6 :       IMPLICIT REAL*8 (A-H,O-Z)
   7 : C************************************************************************
   8 : C     
   9 : C    RESOLUTION (MONTEE DESCENTE) D'UNE MATRICE SYMETRIQUE OU NON
  10 : C    PRECEDEMMENT TRIANGULEE PAR TRIAKS
  11 : C     
  12 : C    POINTEUR : EN ENTREE MATRIK CONTIENT LA MATRICE TRIANGULEE
  13 : C      B  CONTIENT LE SECOND MEMBRE
  14 : C      EN SORTIE B  CONTIENT LA SOLUTION
  15 : C     
  16 : C    VERSION OPTIMISEE EN GESTION MEMOIRE POUR LES TRES GROSSES
  17 : C    MATRICES. ON UTILISE L'ALGORITHME MRU (AVEC LA MODIFICATION
  18 : C    DANS OOOMWD) POUR LES BLOCS DE LA MATRICE. CECI EVITE DE TRANSFERER
  19 : C    SUR DISQUE LE RESTE DU CONTENU DE LA MEMOIRE, I.E. LES TABLEAUX
  20 : C    VITESSE, TEMPERATURE, ETC... QUI AURAIENT A ETRE RAPPELES DES
  21 : C    LA RESOLUTION TERMINEE.
  22 : C     
  23 : C************************************************************************
  24 : -INC CCOPTIO
  25 : -INC SMMATRIK
  26 :       POINTEUR KS2B.IZA
  27 :       POINTEUR ISAL.IZA
  28 :       POINTEUR ISAU.IZA
  29 : *STAT-INC SMSTAT
  30 :       SEGMENT IZD
  31 :       REAL*8 D(1)
  32 :       ENDSEGMENT
  33 : *
  34 :       INTEGER IMPR,IRET
  35 : * Fonctions
  36 :       REAL*8 DDOT
  37 : *     
  38 : * Executable statements
  39 : *
  40 :       IF (IMPR.GT.5) WRITE(IOIMP,*) 'Entrée dans rezolu'
  40 : *STAT      CALL INMSTA(MSTAT,1)
  41 :       SEGACT IDMAT
  42 :       SEGACT KS2B*MOD
  43 :       NBLK=IDESCL(/1)
  44 : C Descente
  45 :       IZD=IDIAG
  46 :       SEGACT IZD
  47 :       NTT=KS2B.A(/1)
  47 :       CALL OOOMRU(1)
  48 :       DO 305 IBLK=1,NBLK
  49 :          KJD=NLDBLK(IBLK)
  50 :          IF(IBLK.EQ.1)KJD=2
  51 :          KJF=NLDBLK(IBLK+1)-1
  52 :          ISAL=IDESCL(IBLK)
  53 :          SEGACT ISAL
  54 :          DO 300 N=KJD,KJF
  55 :             KDEB=N-KZA(N)+1
  56 :             LA=KZA(N)-1
  57 :             IDECI=NUIA(N,2)
  58 :             IF (LA.NE.0) THEN
  59 :                 US=DDOT(LA,ISAL.A(IDECI+1),1,KS2B.A(KDEB),1)
  60 :             ELSE
  61 :                 US=0.D0
  62 :             ENDIF
  63 :             KS2B.A(N)=(KS2B.A(N)-US)
  64 :  300     CONTINUE
  65 :          SEGDES ISAL*MRU
  66 :  305  CONTINUE
  67 : C      segact KS2B
  68 : C      WRITE(IOIMP,*) 'Descente'
  69 : C      WRITE(IOIMP,*) 'KS2B'
  70 : C      WRITE (IOIMP,2022) (KS2B.A(II),II=1,KS2B.A(/1))
  71 : C 2022 FORMAT(10(1X,1PG12.5))
  72 : 
  72 : *STAT      CALL PRMSTA('Descente',MSTAT,1)
  72 :       CALL DIVISE(NTT,KS2B.A,KS2B.A,D)
  73 :       SEGDES IZD*MRU
  73 : *STAT      CALL PRMSTA('Division',MSTAT,1)
  74 : C Remontee
  75 :       DO 304 KBLK=1,NBLK
  76 :          IBLK=NBLK-KBLK+1
  77 :          KJD=NLDBLK(IBLK)
  78 :          KJF=NLDBLK(IBLK+1)-1
  79 :          ISAU=IDESCU(IBLK)
  80 :          SEGACT ISAU
  81 :          DO 302 N=KJF,KJD,-1
  82 :             KDEB=N-KZA(N)
  83 :             SA=-KS2B.A(N)
  84 :             I0=NUIA(N,2)
  85 :             LGL=KZA(N)-1
  86 :             IF (LGL.NE.0)
  86 :      >      CALL DAXPY(LGL,SA,ISAU.A(I0+1),1,KS2B.A(KDEB+1),1)
  87 :  302     CONTINUE
  88 :          SEGDES ISAU*MRU
  89 :  304  CONTINUE
  89 :       CALL OOOMRU(0)
  90 :       SEGDES KS2B
  91 :       SEGDES IDMAT
  91 : *STAT      CALL PRMSTA('Remontée',MSTAT,1)
  92 : *
  93 : * Normal termination
  94 : *
  95 :       IRET=0
  96 :       RETURN
  97 : *
  98 : * Format handling
  99 : *
 100 : *
 101 : * Error handling
 102 : *
 103 :  9999 CONTINUE
 104 :       IRET=1
 105 :       WRITE(IOIMP,*) 'An error was detected in subroutine rezolu'
 106 :       RETURN
 107 : *
 108 : * End of subroutine REZOLU
 109 : *
 110 :       END
 111 :  
 112 :  
 113 :  
 114 :  
 115 :  
 116 :  
 117 :  
 118 :  
 119 :