Télécharger la plaquette Cast3M


fr en

Télécharger chole3i.eso

Retour à la liste

Numérotation des lignes : 

  1. C CHOLE3I   SOURCE    PV        20/09/26    21:15:32     10724          
  2.       subroutine chole3i(ithr)
  3. C
  4. C  interface avec chole3 qui peut être appelee en parallele
  5. C  pour un ensemble de ligne ligne en stockage complet, effectue les operations
  6. C  avec les lignes superieures lig1 qui sont en stockage compact
  7. C
  8.       IMPLICIT INTEGER(I-N)
  9.       IMPLICIT REAL*8 (A-H,O-Z)
  10. -INC SMMATRI
  11. -INC CCHOLE
  12.       SEGMENT IMASQ(LMASQ)
  13.       SEGMENT ITMASQ(NBLIG)
  14.       segment immt(nblig)
  15.       POINTEUR LILIGN.MILIGN
  16.       nbo=nbop(ithr)
  17. C     write (6,*) ' ith dans chole3i ',ith
  18. **    ic=-1
  19. C     write (6,*) ' dans chole3i il1 il2 iper ider',il1,il2,iper,ider
  20.       ngmaxl=ngmaxx/4
  21.       do 100 jbib=il2,il1,-nbthr
  22. **    ic=mod(ic+1,nbthr)
  23. **    ithrm=(ithr+1)/2 +mod(ithr+1,2)*(nbthr+1)/2
  24. **    jbi=jbib-mod(ithrm+ic-1,nbthr)
  25.       jbi=jbib-ithr+1
  26.       if (jbi.gt.il2) goto 100
  27.       if (jbi.lt.il1) goto 100
  28.       LIGN=ILIGN(JBI)
  29.  
  30.  
  31. *  blocage tertiaire en rondelles
  32.       im=immt(jbi)
  33.       if (im.gt.ider) then
  34.        goto 100
  35.       endif
  36.       imasq=itmasq(jbi)
  37.       lpl=ippvv(2)-ippvv(1)
  38.       kidepb=iprel-lpl
  39.       na=immm(/1)
  40.       im=ipno(immm(1))
  41.       ngm=ngmaxl/na
  42. * ici faire le decoupage de la ligne en rondelles
  43.       iperi=iper
  44.       iprelj=lcara(2,jbi)
  45.       iderlj=lcara(3,jbi)
  46.       do 300 irondh=1,lpl,ngm
  47.        irondi=irondh
  48.        irondf=min(lpl,irondi+ngm-1)
  49.        if (irondi.eq.1) irondi=-kidepb-1
  50.       ivpm=ivpo(1)
  51.       kidep=kidepb+ivpm
  52.       do 10 ip=max(im,iperi),ider
  53. C  kidep nous donne le dernier terme non nul avant le terme courant de la ligne lign
  54. C  lig1.iml (lcara(1 ) est le premier terme de lig1
  55.       ippr=lcara(2,ip)
  56.       iddr=lcara(3,ip)
  57. *  test si la ligne touche la rondelle
  58.       if (iddr.lt.irondh+kidepb) then
  59.         iperi=ip
  60.         goto 10
  61.       endif
  62.       if (lcara(1,ip).gt.irondf+kidepb) goto 10
  63.       lig1=LILIGN.ilign(ip)
  64.       irondj=irondi
  65.       ivd=1
  66.       if (kidep.lt.lcara(1,ip)) then
  67.        mdeb=ippr-kidepb
  68.  13    continue
  69. *  test si la rondelle est non nulle
  70.        do ima=max(irondi,mdeb)/masdim+1         ,
  71.      >      min(iddr-kidepb,irondf+na)/masdim+1
  72.        if (imasq(ima).gt.0) then
  73. **   ivd est le premier terme non nul de la rondelle
  74.          imam=(ima-1)*masdim
  75.          ivd=max(ivd,imam)
  76.          irondj=max(irondi,imam)
  77.          goto 12
  78.        elseif ((-imasq(ima))/masdim+1.gt.ima+7) then
  79.          mdeb=-imasq(ima)
  80.          goto 13
  81.        endif
  82.        enddo
  83.        goto 10
  84.   12   continue
  85.       endif
  86. **    write (6,*) 'chole3 jbi ip',jbi,ip
  87.       CALL CHOLE3(iprelj,iderlj,IPPVV(1),IPPR,IDDR,IVPO(1),
  88.      > LIG1.IPPVV(1),VAL(1),LIG1.VAL(1),LIG1.IVPO(1),
  89.      > imasq(1),nbo,irondj,irondf,ivd)
  90.         ivpm=ivpo(1)
  91.         kidep=kidepb+ivpm
  92.   10  continue
  93.  300  continue
  94.  100  continue
  95.       nbop(ithr)=nbo
  96.       end
  97.  
  98.  
  99.  
  100.  
  101.  
  102.  
  103.  
  104.  
  105.  
  106.  
  107.  
  108.  
  109.  
  110.  
  111.  
  112.  
  113.  
  114.  
  115.  
  116.  

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