Télécharger la plaquette Cast3M


fr en

Télécharger choli1.eso

Retour à la liste

Numérotation des lignes : 

choli1

  1. C CHOLI1    SOURCE    PV090527  24/01/12    21:15:03     11821          
  2.       FUNCTION CHOLI1(ILIGF,LIGN,VALF,DAAG,IPKNO,IPPVF,KHG,IVPOF,
  3.      # KIDEP,KI1,KQ,imasql,idep,prec,icle,nbo)
  4.       IMPLICIT INTEGER(I-N)
  5.       IMPLICIT REAL*8 (A-H,O-Z)
  6. -INC SMMATRI
  7. -INC CCHOLE
  8.       DIMENSION ILIGF(*),VALF(*),DAAG(*),IPKNO(*),IPPVF(*),IVPOF(*)
  9.       dimension imasql(*)
  10.       nbnnma=nbnnmc
  11.       IPPKHG=IPPVF(KHG)
  12.       KBAS=IPKNO(KIDEP)
  13.       KHAU=IPKNO(KI1)
  14.       KDIAG=KI1+1
  15.       DNORM=ABS(VALF(KDIAG))*PREC
  16.       KPREM=IVPOF(KHG)-IPPKHG
  17.       IECAR=KQ-IPREL+1
  18.       DO 30 NNJ=MAX(1,KIDEP+IECAR),KI1+IECAR
  19.        KK=NNJ-IECAR
  20.        NNJJ=IPPVV(NNJ+1)
  21.        NJ=NNJJ-IPPVV(NNJ)
  22.        LLOL=MIN(NJ,KK)-1
  23.        LLON=MIN(LLOL-KK+KPREM+1,LLOL-NNJJ+IVPO(NNJ)+1)
  24. C 3 lignes ajoutees
  25.        IF (LLON.GT.0.and.kk.ge.1) THEN
  26.         IEC1=KK-LLOL-1
  27.         IEC2=NNJJ-llol -1
  28.         if (llon.gt.masdim) then
  29.         ideq=1+idep-1
  30.         p=ddotpw(llon,VALF(1+iec1),VAL(1+iec2),
  31.      >     imasql(1),ideq,nbo)
  32.         else
  33.         p=ddotpv(llon,VALF(1+iec1),VAL(1+iec2))
  34.         if (llon.gt.0) nbo=nbo+llon
  35.         endif
  36.         VALF(KK)=VALF(KK)-P
  37.        ENDIF
  38.        IF (ABS(VALF(KK)).GT.DNORM) then
  39.          KPREM=KK
  40.          imasql((kk+idep-1)/masdim+1) =1
  41.          imasql((kk)/masdim+1) =1
  42.        else
  43.          valf(kk)=0.d0
  44.        ENDIF
  45.   30  CONTINUE
  46.       AUX1=0.D0
  47.       if(ICLE.EQ.2) THEN
  48.       iecar = KQ-IPREL+1
  49.       nnj= ki1+IECAR+1
  50.       kk = nnj-iecar
  51.       nnjj=IPPVV(NNJ+1)
  52.       NJ=NNJJ-IPPVV(NNJ)
  53.       LLOL=MIN(NJ,KK)-1
  54.       LLON=MIN(LLOL-KK+KPREM+1,LLOL-NNJJ+IVPO(NNJ)+1)
  55.       IEC1=KK-LLOL-1
  56.       IEC2=NNJJ-llol -1
  57.         if (llon.gt.masdim) then
  58.         ideq=1+idep-1
  59.         p=ddotpw(llon,VALF(1+iec1),VAL(1+iec2),
  60.      >     imasql(1),ideq,nbo)
  61.         else
  62.         p=ddotpv(llon,VALF(1+iec1),VAL(1+iec2))
  63.         if (llon.gt.0) nbo=nbo+llon
  64.         endif
  65.         aux1 = p
  66.       endif
  67.       kdeb=1
  68.   43  continue
  69.       kdebi=kdeb
  70.   44  continue
  71.       do 100 im=kdeb/masdim+1,kprem/masdim+1
  72.          jm=imasql(im)
  73.          if (jm.gt.0) goto 105
  74.          if (jm.eq.0) goto 100
  75.          jinio=-jm/masdim+1
  76.         if (jinio.gt.im+jacc) then
  77. *         write (6,*) 'saut kdeb jm ',kdeb,jm
  78.           kdeb=-jm
  79.           goto 44
  80.         endif
  81.  100  continue
  82.  105  continue
  83.       ideb=max((im-1)*masdim,kdebi)
  84.       kdeb=ideb
  85.  111  continue
  86.       do 110 im=kdeb/masdim+1,kprem/masdim+1
  87.          jm=imasql(im)
  88.          if (jm.le.0) goto 115
  89.          if (jm.eq.1) goto 110
  90.          jfineo=jm/masdim+1
  91.          if(jfineo.gt.im+jacc) then
  92.            kdeb=jm
  93.            goto 111        
  94.          endif
  95.  110  continue
  96.  115  continue
  97.       im=im-1
  98.       ifin=min(im*masdim-1,kprem)
  99. **    write (6,*) ' chole1 kdeb kprem ideb ifin ',kdeb,kprem,ideb,ifin
  100.       DO 9 K=ideb,min(ifin,nbnnma-kq)
  101.        AUX=VALF(K)
  102.        if (aux.eq.0.d0) goto 9
  103.        nbo=nbo+1
  104.        VALFK=AUX*DAAG(K)
  105.        VALF(K)=VALFK
  106.    9  CONTINUE
  107.       if (ifin.lt.kprem) then
  108.        kdeb=ifin+1
  109.        goto 43
  110.       endif
  111.       ivpof(khg)=kprem+ippkhg
  112.       CHOLi1=-AUX1
  113.       RETURN
  114.       END
  115.  
  116.  
  117.  
  118.  

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