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/04/07    21:15:01     10574          
  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
  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.       im=ipno(immm(1))
  37. **    do ih=2,na
  38. **     im=min(im,ipno(immm(ih)))
  39. **    enddo
  40.       imasq=itmasq(jbi)
  41.       lpl=ippvv(2)-ippvv(1)
  42.       if (iper.eq.ider) ngm=lpl
  43.       kidepb=iprel-lpl
  44.       na=immm(/1)
  45.       ngm=ngmaxl/(4    *na)
  46. * ici faire le decoupage de la ligne en rondelles
  47.       iperi=iper
  48.       iprelj=lcara(2,jbi)
  49.       iderlj=lcara(3,jbi)
  50.       do 300 irondh=1,lpl,ngm
  51.        irondi=irondh
  52.        irondf=min(lpl,irondi+ngm-1)
  53.        if (irondi.eq.1) irondi=-kidepb-1
  54.       ivpm=ivpo(1)
  55.       kidep=kidepb+ivpm
  56.       do 10 ip=max(im,iperi),ider
  57. C  kidep nous donne le dernier terme non nul avant le terme courant de la ligne lign
  58. C  lig1.iml (lcara(1 ) est le premier terme de lig1
  59.       ippr=lcara(2,ip)
  60.       iddr=lcara(3,ip)
  61. *  test si la ligne touche la rondelle
  62.       if (iddr.lt.irondh+kidepb) then
  63.         iperi=ip
  64.         goto 10
  65.       endif
  66.       if (lcara(1,ip).gt.irondf+kidepb) goto 10
  67.       lig1=LILIGN.ilign(ip)
  68.       irondj=irondi
  69.       ivd=1
  70.       if (kidep.lt.lcara(1,ip)) then
  71.        mdeb=ippr-kidepb
  72.  13    continue
  73. *  test si la rondelle est non nulle
  74.        do ima=max(irondi,mdeb)/masdim+1         ,
  75.      >      min(iddr-kidepb,irondf+na)/masdim+1
  76.        if (imasq(ima).gt.0) then
  77. **   ivd est le premier terme non nul de la rondelle
  78.          ivd=max(ivd,(ima-1)*masdim)
  79.          irondj=max(irondi,(ima-1)*masdim)
  80.          goto 12
  81.        elseif ((-imasq(ima))/masdim+1.gt.ima+7) then
  82.          mdeb=-imasq(ima)
  83.          goto 13
  84.        endif
  85.        enddo
  86.        goto 10
  87.   12   continue
  88.       endif
  89. **    write (6,*) 'chole3 jbi ip',jbi,ip
  90.       CALL CHOLE3(iprelj,iderlj,IPPVV(1),IPPR,IDDR,IVPO(1),
  91.      > LIG1.IPPVV(1),VAL(1),LIG1.VAL(1),LIG1.IVPO(1),
  92.      > imasq(1),nbo,irondj,irondf,ivd)
  93.         ivpm=ivpo(1)
  94.         kidep=kidepb+ivpm
  95.   10  continue
  96.  300  continue
  97.  100  continue
  98.       nbop(ithr)=nbo
  99.       end
  100.  
  101.  
  102.  
  103.  
  104.  
  105.  
  106.  
  107.  
  108.  
  109.  
  110.  
  111.  
  112.  
  113.  
  114.  
  115.  
  116.  
  117.  

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