Télécharger la plaquette Cast3M


fr en

Télécharger chole4i.eso

Retour à la liste

Numérotation des lignes : 

chole4i

  1. C CHOLE4I   SOURCE    PV090527  26/03/11    21:15:03     12460          
  2. C----------------------------------------------------------------------
  3. C Actualise les termes de la ligne LIGN courante, associee au noeud I,
  4. C en calculant les produits entre blocs de valeurs non nulles avec 
  5. C les lignes associees aux noeuds IMIN a (I-1).
  6. C
  7. C Notations :                                               
  8. C -----------                                               
  9. C   LIGN  : Pointeur sur le segment LIGN associe au noeud I
  10. C   I     : Numero du noeud concerne
  11. C   IMIN  : Numero du noeud associe a la premier valeur non nulle
  12. C           du segment LIGN           
  13. C----------------------------------------------------------------------
  14.       SUBROUTINE CHOLE4I(ITHR)
  15. C
  16.       IMPLICIT INTEGER(I-N)
  17.       IMPLICIT REAL*8 (A-H,O-Z)
  18. -INC SMMATRI
  19. -INC CCHOLE
  20. -INC CCREEL
  21. -INC CCASSIS
  22.       SEGMENT IMMT(NBLIG)
  23.       POINTEUR LILIGN.MILIGN
  24.       NBO=NBOP(ITHR)
  25. C
  26.       DO 100 JBIB=IL2,IL1,-NBTHR
  27.         JBI=JBIB-ITHR+1
  28.         IF (JBI.GT.IL2) GOTO 100
  29.         IF (JBI.LT.IL1) GOTO 100
  30.         IMJBI=IMMT(JBI)
  31.         IF(IMJBI.GT.IDER) GOTO 100
  32.         LIGN=ILIGN(JBI)
  33. CCC     WRITE(*,*) '++++ CHOLE4I LIGNE=',JBI,'DE',MAX(IM,IPER),'A',IDER
  34.         NBG2=LIGN.IPPVV(2)-1
  35.         kidepb=lcara(1,jbi)-1
  36.         lpl=lcara(2,jbi)-kidepb
  37.         lplc=ivpo(2*(nbg2+1))-1
  38. *  decoupage en rondelle pour optimiser la gestion du cache dans les produits scalaires
  39.         iperi=iper
  40.         iprelj=lcara(2,jbi)
  41.         iderlj=lcara(3,jbi)
  42.         na2=iderlj-iprelj+1
  43.         ngm= 8500/na2
  44. C
  45.         itron=1
  46.         do 300 ironda=1,lplc,ngm
  47.           irondb=min(ironda+ngm-1,lplc)
  48.  310      continue
  49.           if (ivpo(2*(itron+1)).le.ironda) then
  50.             itron=itron+1
  51.             goto 310
  52.           endif
  53.           igt1=itron
  54.           igt1a=igt1
  55.           irondi=ironda-ivpo(2*itron)+ivpo(2*itron-1)
  56.  311      continue
  57.           if (ivpo(2*(itron+1)).le.irondb) then
  58.             itron=itron+1
  59.             goto 311
  60.           endif
  61.           igt2=itron
  62.           igt2a=igt2
  63.           irondf=irondb-ivpo(2*itron)+ivpo(2*itron-1)
  64. *          if (ithr.eq.1)
  65. *    >     write(6,*) 'ironda irondb irondi irondf',
  66. *    >        ironda,irondb,irondi,irondf
  67. *
  68.           IGD=LIGN.IVPO(2*igt1)              
  69.           do 11 ig=igt1,nbg2-1
  70. C
  71.             if(ipno(ivpo(2*ig-1)+kidepb).gt.ider) goto 300
  72.             IGF=LIGN.IVPO(2*(IG+1))-1
  73.             do 10 j=max(IMJBI,iperi,ipno(lign.ivpo(2*ig-1)+kidepb)),
  74.      >       min(ider,ipno(igf-igd+lign.ivpo(2*ig-1)+kidepb))
  75.  
  76.               iprem=lcara(1,j)
  77.               IPPR=LCARA(2,J)
  78.               IDDR=LCARA(3,J)
  79. *  sauver le nouveau debut                      
  80.               if (iddr.lt.irondf+kidepb) then
  81.                 iperi=j+1
  82.               endif
  83. *  test si la ligne touche la rondelle
  84.               if (iddr.lt.irondi+kidepb) then
  85.                 goto 10
  86.               endif
  87.  
  88.               IND1=MAX(1,IPPR-KIDEPB)
  89.               IND2=IDDR-KIDEPB
  90.               JND1=MASQA(IND1)
  91.               JND2=MASQA(IND2)
  92.               IMSQ1=IMASQ(JND1)
  93.               IMSQ2=IMASQ(JND2)
  94.               IMSQ=IMSQ1
  95.               IF (IMSQ.EQ.0) THEN
  96.                 WRITE(*,*) 'erreur interne chole4i 1'
  97.                 CALL ERREUR(5)
  98.               ENDIF
  99. *  test si la ligne correspond a un terme a remplir
  100.               if(jnd2-jnd1.gt.1) then
  101.                 WRITE(*,*) 'erreur interne chole4i 2'
  102.                 CALL ERREUR(5)
  103.               ENDIF
  104.               if(imsq1.lt.0.and.imsq2.lt.0) goto 10
  105.               IF (IMSQ.LT.0) imsq=-imsq
  106.   18          CONTINUE
  107.               IGD1=LIGN.IVPO(2*IMSQ-1)
  108.               IGF1=LIGN.IVPO(2*(IMSQ+1)-1)-1
  109.               if (igd1.gt.ind2) goto 10
  110.               if (igf1.lt.ind1) then
  111.                 imsq=imsq+1
  112.                 goto 18 
  113.               endif
  114. *  verif supplementaire avec la rondelle ????
  115.               ird1=max(iprem-kidepb,irondi,1)
  116.               ird2=min(iddr-kidepb,irondf)
  117.               jrd1=masqa(ird1)
  118. *             write(6,*) 'jrd1 jrd2',jrd1,jrd2,iprem,kidepb,irondi
  119.               jr=imasq(jrd1)
  120.               if (jr.lt.0) jr=-jr
  121.   19            CONTINUE
  122.                 IGD1=LIGN.IVPO(2*jr-1)
  123.                 IGF1=LIGN.IVPO(2*(jr+1)-1)-1
  124.                 if (igd1.gt.ird2) goto 10
  125.                 if (igf1.lt.ird1) then
  126.                   jr=jr+1
  127.                   goto 19
  128.                 endif
  129.                 igt1a=jr
  130.                 igt2a=max(igt2,jr)
  131.                 goto 12
  132. C
  133.   12          CONTINUE
  134.               LIG1=LILIGN.ILIGN(J)
  135.               NBG1=LIG1.IPPVV(2)-1
  136.               NA1 =IDDR-IPPR+1
  137.               CALL CHOLE4(LIGN.IPREL,NA2,NBG2,LIGN.IVPO(1),LIGN.VAL(1),
  138.      &                 LIGN.IMASQ(1),IGT1a,IGT2a,
  139.      &                 LIG1.IPREL,NA1,NBG1,LIG1.IVPO(1),LIG1.VAL(1),NBO,
  140.      &                 irondi,irondf)
  141.   10        CONTINUE
  142.             IGD=IGF+1
  143.   11      CONTINUE
  144.   300   CONTINUE
  145. CCC     WRITE(*,*) ' SEGMENT APRES CHOLE4',JBI
  146. CCC     segprt,lign
  147.  100  CONTINUE
  148.       NBOP(ITHR)=NBO
  149.       END
  150.  
  151.  
  152.  
  153.  
  154.  

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