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

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