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    MB234859  26/01/26    21:15:05     12460          
  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. C
  134.         IF (bmamu) THEN
  135.           DO 301 IA2=0,NA2-1,NBL
  136.             IPOSR2=-IDEB2+ILDEB2+IA2*NVAL2+(IA2*(IA2-1))/2+IMB
  137.             DO 300 IA1=0,NA1-1,NBL
  138.               IPOSR1=IDECV+IA1*NVAL1+(IA1*(IA1-1))/2
  139. C
  140.               NBOQ=NBO
  141.               NPA1=MIN(NBL,NA1-IA1)
  142.               NPA2=MIN(NBL,NA2-IA2)
  143. C
  144.               CALL MAMUPW(IDEBN,IFINN,VAL2(1),IPOSR2,NVAL2+IA2,NPA2,
  145.      &                                VAL1(1),IPOSR1,NVAL1+IA1,NPA1,
  146.      &                                PT,NBO)
  147.               IF (NBO.EQ.NBOQ) GOTO 300
  148. C
  149. C             Mise a jour VAL2
  150.               IDEC=IPRE1+IA1-IDEPV2
  151.               DO IC=1,NPA2
  152.                 IVAD=IDEC+(IA2+IC-1)*NCOL2+((IA2+IC-1)*(IA2+IC-2))/2
  153.                 IAUX=-IVAD+(IC-1)*NPA1
  154.                 IMSQ=IMASQ(MASQA(IVAD+1))
  155.                 IVMSQ=IVPO2(2*(IMSQ+1)-1) 
  156.                 IDBC=IVPO2(2*IMSQ-1)
  157.                 IDBV=IVPO2(2*IMSQ  )
  158.                 DO IV=MAX(1,1+IVAD),NPA1+IVAD
  159. C
  160. C                 Ne devrait pas se produire...
  161.                   IF (IMSQ.LT.0) THEN
  162.                     WRITE(*,*) 'erreur interne chole4'
  163.                     CALL ERREUR(5)
  164.                   ENDIF
  165. C
  166.   114             CONTINUE
  167.                   IF (IV.GE.IVMSQ) THEN
  168.                     IMSQ=IMSQ+1
  169.                     IVMSQ=IVPO2(2*(IMSQ+1)-1) 
  170.                     IDBC=IVPO2(2*IMSQ-1)
  171.                     IDBV=IVPO2(2*IMSQ  )
  172.                     GOTO 114
  173.                   ENDIF
  174. C
  175.                   P=PT(IV+IAUX)
  176.                   IF(ABS(P).GT.XPETIT) THEN
  177.                     IV2=IDBV+(IV-IDBC)
  178.                     VAL2(IV2)=VAL2(IV2)-P
  179.                   ENDIF
  180. C
  181.                 ENDDO
  182.               ENDDO
  183. C
  184.   300       CONTINUE
  185.   301     CONTINUE
  186.         ELSE
  187. C
  188.           LOND=IFINN-IDEBN+1
  189.           IF (LOND.LE.0) GOTO 16
  190.           IPOS1=IDEBN+IDECV
  191.           IPOS2=IDEBN-IDEB2+ILDEB2+IMB
  192. C
  193.           P=DDOTPV(LOND,VAL2(IPOS2),VAL1(IPOS1))
  194.           NBO=NBO+LOND
  195. C
  196.           IF (ABS(P).GT.XPETIT) THEN
  197. C           Mise a jour VAL2
  198.             IVAD=IPRE1+1-IDEPV2
  199.             IMSQ=IMASQ(MASQA(IVAD))
  200.   115       CONTINUE
  201.             IF (IVAD.GE.IVPO2(2*(IMSQ+1)-1)) THEN
  202.               IMSQ=IMSQ+1
  203.               GOTO 115
  204.             ENDIF
  205. C
  206.             IDBC=IVPO2(2*IMSQ-1)
  207.             IDBV=IVPO2(2*IMSQ  )
  208.             IVAE=IDBV+(IVAD-IDBC)
  209.             VAL2(IVAE)=VAL2(IVAE)-P
  210. C           WRITE(*,*)'REMPLISSAGE',IVAE,IPRE1,IDBC,IDBV,VAL2(IVAE),P
  211.           ENDIF
  212. C
  213.         ENDIF
  214.   16    CONTINUE
  215. C
  216.         IDEB1=IFINT+1
  217.         IF (IDEB1.GT.IFIN1) THEN
  218.           ICPT1=ICPT1+1
  219.           GOTO 10
  220.         ELSE
  221.           IF (ICPT2.EQ.ICPTM) GOTO 15
  222.           ICPT2=ICPT2+1
  223.           GOTO 13
  224.         ENDIF
  225. C
  226.   10  CONTINUE
  227. C
  228.   15  CONTINUE
  229. C
  230. C     Le groupe diagonal
  231.       IF ((NA1.EQ.1).AND.(IPRE2+NA2-1.LE.NBNNMA)) GOTO 400
  232. C
  233.       DO 210 IM2=1,NA2
  234.         IVAC=(IM2-1)*NCOL2+((IM2-2)*(IM2-1))/2
  235.         ICPT2=IT1
  236.         IIND2=IPRE2+IM2-1-NBNNMA
  237.         DO 220 IM1=1,NA1
  238. C
  239.           IF (IVPO1(2*(NBG1+1)-1)+IM1-1.LT.IRONDI-IMB) GOTO 220
  240. C
  241.           IIND1=IPRE1+IM1-1-NBNNMA
  242. C
  243.           IDEBV=IVPO1(2*NBG1)
  244.           IDEB1=IVPO1(2*NBG1-1)
  245.           IFIN1=IDEB1+IM1-2
  246. C
  247.   14      CONTINUE
  248. C
  249.           IF (IVPO2(2*(ICPT2+1)-1).LT.IRONDI) THEN
  250.             IF (ICPT2.EQ.ICPTM) GOTO 210
  251.             ICPT2=ICPT2+1
  252.             GOTO 14
  253.           ENDIF
  254. C
  255.           ILDEB2=IVPO2(2*ICPT2)
  256.           ILFIN2=IVPO2(2*(ICPT2+1))-1
  257.           IDEB2=IVPO2(2*ICPT2-1)
  258.           IFIN2=IDEB2+ILFIN2-ILDEB2
  259. C
  260.           IDEB3=IDEB2-IMB
  261.           IFIN3=IFIN2-IMB
  262. C
  263.           IF (IFIN3.LT.IDEB1) THEN
  264.             IF (ICPT2.EQ.ICPTM) GOTO 210
  265.             ICPT2=ICPT2+1
  266.             GOTO 14
  267.           ENDIF
  268. C
  269.           IDEBN=MAX(IDEB1,IDEB3,IRONDI-IMB)
  270.           IFINN=MIN(IFIN1,IFIN3,IRONDF-IMB)
  271.           IFINN=MIN(IFINN,NBNNMA-IDEPV1+1)
  272. C
  273.           P=0.D0
  274.           IF (IFINN-IDEBN.LT.0) THEN
  275.             IF (XMATRI.EQ.0)              GOTO 220
  276.             IF (IIND1.LT.1.OR.IIND2.LT.1) GOTO 220
  277.             GOTO 230
  278.           ENDIF
  279. C
  280.           IPOS1=IDEBN-IDEB1+IDEBV +(IM1-1)*NVAL1+((IM1-1)*(IM1-2))/2
  281.           IPOS2=IDEBN-IDEB2+ILDEB2+(IM2-1)*NVAL2+((IM2-1)*(IM2-2))/2+IMB
  282.           NBO=NBO+IFINN-IDEBN+1
  283.           DO 200 IPOS=ipos1,ipos1+ifinn-idebn
  284.             P=P+VAL2(IPOS+ipos2-ipos1)*VAL1(IPOS)
  285.  200      CONTINUE
  286. C
  287.  230      CONTINUE
  288.           IDEC=IPRE1+IM1-1-IDEPV2+1
  289.           IDED=IDEC+IVAC
  290.           IMSQ=IMASQ(MASQA(IDED))
  291.   116     CONTINUE
  292.           IF (IDED.GE.IVPO2(2*(IMSQ+1)-1)) THEN
  293.             IMSQ=IMSQ+1
  294.             GOTO 116
  295.           ENDIF
  296. C
  297.           IDBC=IVPO2(2*IMSQ-1)
  298.           IDBV=IVPO2(2*IMSQ  )
  299.           IVAD=IDBV+(IDED-IDBC)
  300.           IF (ABS(P).GT.XPETIT) THEN
  301.             VAL2(IVAD)=VAL2(IVAD)-P
  302.           ENDIF
  303. C
  304. C         Cas du super-element
  305.           IF (XMATRI.NE.0.AND.IIND1.GE.1.AND.IIND2.GE.1) THEN
  306.             XX=VAL2(IVAD)
  307.             IF (ABS(XX).GT.XPETIT) THEN
  308.               RE(IIND1,IIND2,1)=XX
  309.               RE(IIND2,IIND1,1)=XX
  310.             ENDIF
  311.           ENDIF
  312. C
  313.           IF (IFIN3.LT.IFIN1) THEN
  314.             IF (ICPT2.EQ.ICPTM) GOTO 210
  315.             ICPT2=ICPT2+1
  316.             GOTO 14
  317.           ENDIF
  318. C
  319.  220    CONTINUE
  320.  210  CONTINUE
  321. C
  322.  400  CONTINUE
  323.       END
  324.  
  325.  

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