Télécharger la plaquette Cast3M


fr en

Télécharger chole4.eso

Retour à la liste

Numérotation des lignes : 

chole4

  1. C CHOLE4    SOURCE    PV090527  26/02/03    21:15:07     12465          
  2. C----------------------------------------------------------------------
  3. C        Effectue les produits entre blocs de valeurs non nulles
  4. C        entre la ligne a traiter et une ligne dont elle depend
  5. C
  6. C Entrees :                                                 
  7. C ---------                                                 
  8. C
  9. C Concernant la ligne a traiter :                           
  10. C   IPRE2 : Numero de ligne de la premiere inconnue
  11. C   NA2   : Nombre d'inconnues
  12. C   NBG2  : Nombre de blocs de valeurs composant la premiere inconnue
  13. C   IVPO2 : Tableau decrivant la ligne
  14. C   IMASQ : Tableau indiquant si un groupe de valeurs contient une 
  15. C           valeur non nulle ou non
  16. C
  17. C Concernant la ligne en relation :                         
  18. C   IPRE1 : Numero de ligne de la premiere inconnue
  19. C   NA1   : Nombre d'inconnues
  20. C   NBG1  : Nombre de blocs de valeurs composant la premiere inconnue
  21. C   IVPO1 : Tableau decrivant la ligne
  22. C   VAL1  : Tableau contenant les valeurs de la ligne
  23. C
  24. C  IT1    : Troncon de debut et de fin du fait du decoupage en
  25. C  IT2    : rondelle dans chole4i
  26. C  IRONDI : Indices de debut et de fin du fait du decoupage en 
  27. C  IRONDJ : rondelle dans chole4i
  28. C                                                           
  29. C Sortie  :                                                 
  30. C ---------                                                 
  31. C   VAL2  : Tableau contenant les valeurs de la ligne
  32. C   NBO   : Entier donnant le nombre d'operations
  33. C----------------------------------------------------------------------
  34.       SUBROUTINE CHOLE4(IPRE2,NA2,NBG2,IVPO2,VAL2,IMASQ,IT1,IT2,
  35.      &                  IPRE1,NA1,NBG1,IVPO1,VAL1,NBO,IRONDI,IRONDF)
  36. C
  37.       IMPLICIT INTEGER(I-N)
  38.       IMPLICIT REAL*8(A-H,O-Z)
  39. -INC SMRIGID
  40. -INC CCHOLE
  41. -INC CCREEL
  42.       DIMENSION IVPO1(*),VAL1(*)
  43.       DIMENSION IVPO2(*),VAL2(*),IMASQ(*)
  44.       REAL*8 pt(36)
  45.       LOGICAL bmamu
  46. C
  47. C     Nombre max de lignes traitees simultanement
  48.       nbl=6
  49. C
  50. C     Recuperer en cas de super element dans cchole
  51.       xmatri=matric
  52.       nbnnma=nbnnmc
  53. C
  54. C     Subroutine a utiliser
  55.       bmamu=(NA2.GT.1.OR.NA1.GT.1)
  56. C
  57. C     Nombre de termes pour la premiere inco de chaque LIGN
  58. CCC   NVAL1=IVPO1(2*(NBG1+1))-1                 
  59. CCC   NVAL2=IVPO2(2*(NBG2+1))-1                 
  60.       NVAL1=IVPO1(2*NBG1)
  61.       NVAL2=IVPO2(2*NBG2)
  62. C
  63. C     Nombre de colonnes entre le premiere terme non nul et la diag
  64. CCC   NCOL1=IVPO1(2*(NBG1+1)-1)-1                 
  65. CCC   NCOL2=IVPO2(2*(NBG2+1)-1)-1                 
  66.       NCOL1=IVPO1(2*NBG1-1)
  67.       NCOL2=IVPO2(2*NBG2-1)
  68. C
  69. C     Colonne de la premiere valeur non nulle
  70.       IDEPV1=IPRE1-NCOL1+1
  71.       IDEPV2=IPRE2-NCOL2+1
  72.       IMB=IDEPV1-IDEPV2
  73. C
  74. C     Compteurs pour parcourir les troncons
  75.       ICPT1=1
  76.       ICPT2=IT1
  77.       ICPTM=IT2+1
  78. C
  79. CCC   IWA1=IPRE1+NA1-1
  80. CCC   IWA2=IPRE2+NA2-1
  81. CCC   WRITE(*,*) '---- LIGNES',IPRE2,'A',IWA2,'AVEC',IPRE1,'A',IWA1
  82. CCC   WRITE(*,*) 'DECALAGE   ',NCOL1,IDEPV1,NCOL2,IDEPV2,IMB
  83. C
  84. C     Boucles sur les groupes de valeurs (hors groupe diagonal)
  85.       DO 10 IG1=1,NBG1-1
  86. C
  87.         IF (IVPO1(2*ICPT1-1).GT.IRONDF-IMB) THEN
  88.           GOTO 15
  89.         ENDIF
  90.         IF (IVPO1(2*(ICPT1+1)-1)-1.LT.IRONDI-IMB) THEN
  91.           ICPT1=ICPT1+1
  92.           GOTO 10
  93.         ENDIF
  94. C
  95.         ILDEB1=IVPO1(2*ICPT1)
  96.         ILFIN1=IVPO1(2*(ICPT1+1))-1
  97.         IDEB1=IVPO1(2*ICPT1-1)
  98.         IFIN1=IDEB1+ILFIN1-ILDEB1
  99.         IDECV=-IDEB1+ILDEB1
  100. C
  101.   13    CONTINUE
  102. C
  103.         IF (IVPO2(2*ICPT2-1).GT.IRONDF) THEN
  104.           GOTO 15
  105.         ENDIF
  106.         IF (IVPO2(2*(ICPT2+1)-1)-1.LT.IRONDI) THEN
  107.           IF (ICPT2.EQ.ICPTM) GOTO 15
  108.           ICPT2=ICPT2+1
  109.           GOTO 13
  110.         ENDIF
  111. C
  112.         ILDEB2=IVPO2(2*ICPT2)
  113.         ILFIN2=IVPO2(2*(ICPT2+1))-1
  114.         IDEB2=IVPO2(2*ICPT2-1)
  115.         IFIN2=IDEB2+ILFIN2-ILDEB2
  116. C
  117.         IDEB3=IDEB2-IMB
  118.         IFIN3=IFIN2-IMB
  119. C
  120.         IF (IFIN1.LT.IDEB3) THEN
  121.           ICPT1=ICPT1+1
  122.           GOTO 10
  123.         ELSE IF (IFIN3.LT.IDEB1) THEN
  124.           IF (ICPT2.EQ.ICPTM) GOTO 15
  125.           ICPT2=ICPT2+1
  126.           GOTO 13
  127.         ENDIF
  128. C
  129.         IDEBN=MAX(IDEB1,IDEB3,IRONDI-IMB)
  130.         IFINT=MIN(IFIN1,IFIN3)
  131.         IFINN=MIN(IFINT,IRONDF-IMB)
  132.         IFINN=MIN(IFINN,NBNNMA-IDEPV1+1)
  133.         LOND=IFINN-IDEBN+1
  134.         IF (LOND.LE.0) GOTO 16
  135. C
  136.         IF (bmamu) THEN
  137.           DO 301 IA2=0,NA2-1,NBL
  138.             IPOSR2=-IDEB2+ILDEB2+IA2*NVAL2+(IA2*(IA2-1))/2+IMB
  139.             DO 300 IA1=0,NA1-1,NBL
  140.               IPOSR1=IDECV+IA1*NVAL1+(IA1*(IA1-1))/2
  141. C
  142.               NBOQ=NBO
  143.               NPA1=MIN(NBL,NA1-IA1)
  144.               NPA2=MIN(NBL,NA2-IA2)
  145. C
  146.               CALL MAMUPW(IDEBN,IFINN,VAL2(1),IPOSR2,NVAL2+IA2,NPA2,
  147.      &                                VAL1(1),IPOSR1,NVAL1+IA1,NPA1,
  148.      &                                PT,NBO)
  149.               IF (NBO.EQ.NBOQ) GOTO 300
  150. C
  151. C             Mise a jour VAL2
  152.               IDEC=IPRE1+IA1-IDEPV2
  153.               DO IC=1,NPA2
  154.                 IVAD=IDEC+(IA2+IC-1)*NCOL2+((IA2+IC-1)*(IA2+IC-2))/2
  155.                 IAUX=-IVAD+(IC-1)*NPA1
  156.                 IMSQ=IMASQ(MASQA(IVAD+1))
  157.                 IVMSQ=IVPO2(2*(IMSQ+1)-1) 
  158.                 IDBC=IVPO2(2*IMSQ-1)
  159.                 IDBV=IVPO2(2*IMSQ  )
  160.                 DO IV=MAX(1,1+IVAD),NPA1+IVAD
  161. C
  162. C                 Ne devrait pas se produire...
  163.                   IF (IMSQ.LT.0) THEN
  164.                     WRITE(*,*) 'erreur interne chole4'
  165.                     CALL ERREUR(5)
  166.                   ENDIF
  167. C
  168.   114             CONTINUE
  169.                   IF (IV.GE.IVMSQ) THEN
  170.                     IMSQ=IMSQ+1
  171.                     IVMSQ=IVPO2(2*(IMSQ+1)-1) 
  172.                     IDBC=IVPO2(2*IMSQ-1)
  173.                     IDBV=IVPO2(2*IMSQ  )
  174.                     GOTO 114
  175.                   ENDIF
  176. C
  177.                   P=PT(IV+IAUX)
  178.                   IF(ABS(P).GT.XPETIT) THEN
  179.                     IV2=IDBV+(IV-IDBC)
  180.                     VAL2(IV2)=VAL2(IV2)-P
  181.                   ENDIF
  182. C
  183.                 ENDDO
  184.               ENDDO
  185. C
  186.   300       CONTINUE
  187.   301     CONTINUE
  188.         ELSE
  189. C
  190. ***       LOND=IFINN-IDEBN+1
  191. ***       IF (LOND.LE.0) GOTO 16
  192.           IPOS1=IDEBN+IDECV
  193.           IPOS2=IDEBN-IDEB2+ILDEB2+IMB
  194. C
  195.           P=DDOTPV(LOND,VAL2(IPOS2),VAL1(IPOS1))
  196.           NBO=NBO+LOND
  197. C
  198.           IF (ABS(P).GT.XPETIT) THEN
  199. C           Mise a jour VAL2
  200.             IVAD=IPRE1+1-IDEPV2
  201.             IMSQ=IMASQ(MASQA(IVAD))
  202.   115       CONTINUE
  203.             IF (IVAD.GE.IVPO2(2*(IMSQ+1)-1)) THEN
  204.               IMSQ=IMSQ+1
  205.               GOTO 115
  206.             ENDIF
  207. C
  208.             IDBC=IVPO2(2*IMSQ-1)
  209.             IDBV=IVPO2(2*IMSQ  )
  210.             IVAE=IDBV+(IVAD-IDBC)
  211.             VAL2(IVAE)=VAL2(IVAE)-P
  212. C           WRITE(*,*)'REMPLISSAGE',IVAE,IPRE1,IDBC,IDBV,VAL2(IVAE),P
  213.           ENDIF
  214. C
  215.         ENDIF
  216.   16    CONTINUE
  217. C
  218.         IDEB1=IFINT+1
  219.         IF (IDEB1.GT.IFIN1) THEN
  220.           ICPT1=ICPT1+1
  221.           GOTO 10
  222.         ELSE
  223.           IF (ICPT2.EQ.ICPTM) GOTO 15
  224.           ICPT2=ICPT2+1
  225.           GOTO 13
  226.         ENDIF
  227. C
  228.   10  CONTINUE
  229. C
  230.   15  CONTINUE
  231. C
  232. C     Le groupe diagonal
  233.       IF ((NA1.EQ.1).AND.(IPRE2+NA2-1.LE.NBNNMA)) GOTO 400
  234. C
  235.       DO 210 IM2=1,NA2
  236.         IVAC=(IM2-1)*NCOL2+((IM2-2)*(IM2-1))/2
  237.         ICPT2=IT1
  238.         IIND2=IPRE2+IM2-1-NBNNMA
  239.         DO 220 IM1=1,NA1
  240. C
  241.           IF (IVPO1(2*(NBG1+1)-1)+IM1-1.LT.IRONDI-IMB) GOTO 220
  242. C
  243.           IIND1=IPRE1+IM1-1-NBNNMA
  244. C
  245.           IDEBV=IVPO1(2*NBG1)
  246.           IDEB1=IVPO1(2*NBG1-1)
  247.           IFIN1=IDEB1+IM1-2
  248. C
  249.   14      CONTINUE
  250. C
  251.           IF (IVPO2(2*(ICPT2+1)-1).LT.IRONDI) THEN
  252.             IF (ICPT2.EQ.ICPTM) GOTO 210
  253.             ICPT2=ICPT2+1
  254.             GOTO 14
  255.           ENDIF
  256. C
  257.           ILDEB2=IVPO2(2*ICPT2)
  258.           ILFIN2=IVPO2(2*(ICPT2+1))-1
  259.           IDEB2=IVPO2(2*ICPT2-1)
  260.           IFIN2=IDEB2+ILFIN2-ILDEB2
  261. C
  262.           IDEB3=IDEB2-IMB
  263.           IFIN3=IFIN2-IMB
  264. C
  265.           IF (IFIN3.LT.IDEB1) THEN
  266.             IF (ICPT2.EQ.ICPTM) GOTO 210
  267.             ICPT2=ICPT2+1
  268.             GOTO 14
  269.           ENDIF
  270. C
  271.           IDEBN=MAX(IDEB1,IDEB3,IRONDI-IMB)
  272.           IFINN=MIN(IFIN1,IFIN3,IRONDF-IMB)
  273.           IFINN=MIN(IFINN,NBNNMA-IDEPV1+1)
  274. C
  275.           P=0.D0
  276.           IF (IFINN-IDEBN.LT.0) THEN
  277.             IF (XMATRI.EQ.0)              GOTO 220
  278.             IF (IIND1.LT.1.OR.IIND2.LT.1) GOTO 220
  279.             GOTO 230
  280.           ENDIF
  281. C
  282.           IPOS1=IDEBN-IDEB1+IDEBV +(IM1-1)*NVAL1+((IM1-1)*(IM1-2))/2
  283.           IPOS2=IDEBN-IDEB2+ILDEB2+(IM2-1)*NVAL2+((IM2-1)*(IM2-2))/2+IMB
  284.           NBO=NBO+IFINN-IDEBN+1
  285.           DO 200 IPOS=ipos1,ipos1+ifinn-idebn
  286.             P=P+VAL2(IPOS+ipos2-ipos1)*VAL1(IPOS)
  287.  200      CONTINUE
  288. C
  289.  230      CONTINUE
  290.           IDEC=IPRE1+IM1-1-IDEPV2+1
  291.           IDED=IDEC+IVAC
  292.           IMSQ=IMASQ(MASQA(IDED))
  293.   116     CONTINUE
  294.           IF (IDED.GE.IVPO2(2*(IMSQ+1)-1)) THEN
  295.             IMSQ=IMSQ+1
  296.             GOTO 116
  297.           ENDIF
  298. C
  299.           IDBC=IVPO2(2*IMSQ-1)
  300.           IDBV=IVPO2(2*IMSQ  )
  301.           IVAD=IDBV+(IDED-IDBC)
  302.           IF (ABS(P).GT.XPETIT) THEN
  303.             VAL2(IVAD)=VAL2(IVAD)-P
  304.           ENDIF
  305. C
  306. C         Cas du super-element
  307.           IF (XMATRI.NE.0.AND.IIND1.GE.1.AND.IIND2.GE.1) THEN
  308.             XX=VAL2(IVAD)
  309.             IF (ABS(XX).GT.XPETIT) THEN
  310.               RE(IIND1,IIND2,1)=XX
  311.               RE(IIND2,IIND1,1)=XX
  312.             ENDIF
  313.           ENDIF
  314. C
  315.           IF (IFIN3.LT.IFIN1) THEN
  316.             IF (ICPT2.EQ.ICPTM) GOTO 210
  317.             ICPT2=ICPT2+1
  318.             GOTO 14
  319.           ENDIF
  320. C
  321.  220    CONTINUE
  322.  210  CONTINUE
  323. C
  324.  400  CONTINUE
  325.       END
  326.  
  327.  
  328.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales