Télécharger la plaquette Cast3M


fr en

Télécharger choli1.eso

Retour à la liste

Numérotation des lignes : 

  1. C CHOLI1    SOURCE    PV        19/03/06    21:15:01     10147          
  2.       FUNCTION CHOLI1(ILIGF,LIGN,VALF,DAAG,IPKNO,IPPVF,KHG,IVPOF,
  3.      # KIDEP,KI1,KQ,imasq,idep,prec,icle,nc,diagref)
  4.       IMPLICIT INTEGER(I-N)
  5.       IMPLICIT REAL*8 (A-H,O-Z)
  6. -INC SMMATRI
  7. -INC CCHOLE
  8.       DIMENSION ILIGF(1),VALF(1),DAAG(1),IPKNO(1),IPPVF(1),IVPOF(1)
  9.       dimension imasq(1)
  10.       IPPKHG=IPPVF(KHG)
  11.       KBAS=IPKNO(KIDEP)
  12.       KHAU=IPKNO(KI1)
  13.       KDIAG=KI1+1
  14.       DNORM=ABS(VALF(KDIAG))*PREC
  15.       KPREM=IVPOF(KHG)-IPPKHG
  16.       DO 10 K=KBAS,KHAU
  17.        LIG1=ILIGF(K)
  18.        IF (LIG1.EQ.LIGN) GOTO 20
  19.        IECAR=KQ-LIG1.IPREL+1
  20.        ICA=MAX(1,KIDEP+IECAR)
  21.        ICB=LIG1.IMMM(/1)
  22.        CALL CHOLE2(LIG1.IPPVV(1),VALF(1),LIG1.VAL(1),LIG1.IVPO(1),
  23.      >  imasq(1),idep,prec,ica,icb,iecar,kprem,dnorm)
  24.   10  CONTINUE
  25. *      LIGN=ILIGF(KHAU+1)
  26. *      IECAR = KQ-IPREL+1
  27.       GOTO 50
  28.   20  CONTINUE
  29.       IECAR=KQ-IPREL+1
  30.       DO 30 NNJ=MAX(1,KIDEP+IECAR),KI1+IECAR
  31.        KK=NNJ-IECAR
  32.        NNJJ=IPPVV(NNJ+1)
  33.        NJ=NNJJ-IPPVV(NNJ)
  34.        LLOL=MIN(NJ,KK)-1
  35.        LLON=MIN(LLOL-KK+KPREM+1,LLOL-NNJJ+IVPO(NNJ)+1)
  36. C 3 lignes ajoutees
  37.        IF (LLON.GT.0.and.kk.ge.1) THEN
  38.         IEC1=KK-LLOL-1
  39.         IEC2=NNJJ-llol -1
  40.         if (llon.gt.masdim) then
  41.         ideq=1+iec1+idep-1
  42.         ideq=1+idep-1
  43.         p=ddotpw(llon,VALF(1+iec1),VAL(1+iec2),
  44.      >     imasq(1),ideq,nc)
  45.         else
  46.         p=ddotpv(llon,VALF(1+iec1),VAL(1+iec2))
  47.         if (llon.gt.0) nc=nc+llon
  48.         endif
  49.         VALF(KK)=VALF(KK)-P
  50.        ENDIF
  51.        IF (ABS(VALF(KK)).GT.DNORM) then
  52.          KPREM=KK
  53.          imasq((kk+idep-1)/masdim+1) =1
  54.          imasq((kk)/masdim+1) =1
  55.        else
  56.          valf(kk)=0.d0
  57.        ENDIF
  58.   30  CONTINUE
  59.   50  CONTINUE
  60.       AUX1=0.D0
  61.       if(ICLE.EQ.2) THEN
  62.       iecar = KQ-IPREL+1
  63.       nnj= ki1+IECAR+1
  64.       kk = nnj-iecar
  65.       nnjj=IPPVV(NNJ+1)
  66.       NJ=NNJJ-IPPVV(NNJ)
  67.       LLOL=MIN(NJ,KK)-1
  68.       LLON=MIN(LLOL-KK+KPREM+1,LLOL-NNJJ+IVPO(NNJ)+1)
  69.       IEC1=KK-LLOL-1
  70.       IEC2=NNJJ-llol -1
  71.       IF(LLON.GT.0) THEN
  72. *      write(6,*)'diagonale llon iec1  iec2' , llon, iec1,iec2
  73.         DO 9 K=1+iec1,iec1+LLON
  74.         AUX1=AUX1+valf(K)*VAL(K-iec1+iec2)
  75.    9    CONTINUE
  76.         if (llon.gt.0) nc=nc+llon
  77.       ENDIF
  78.  
  79.       DO 91 K=1,kprem
  80.         VALF(K)=VALF(K)  /DAAG(K)
  81.       diagref=max(diagref,abs(daag(k)))
  82.   91  CONTINUE
  83.       else
  84.       DO 90 K=1,KPREM
  85.       VALF(K)=VALF(K)  /DAAG(K)
  86.       diagref=max(diagref,abs(daag(k)))
  87.   90  CONTINUE
  88.       endif
  89.       IVPOF(KHG)=KPREM+IPPKHG
  90.       CHOLI1=-AUX1
  91.       RETURN
  92.       END
  93.  
  94.  
  95.  
  96.  
  97.  
  98.  
  99.  
  100.  
  101.  
  102.  
  103.  
  104.  
  105.  
  106.  
  107.  
  108.  
  109.  
  110.  

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