Télécharger super2.eso

Retour à la liste

Numérotation des lignes :

super2
  1. C SUPER2 SOURCE PV 22/04/15 17:10:56 11344
  2. SUBROUTINE SUPER2(IPPVV,VALF,VAL,IVPO,KQ,NBNNMA,ILIG,XMATRI,
  3. > imasq,idep,ica,icb,iecar,kprem,dnorm)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. -INC SMRIGID
  7. -INC CCHOLE
  8. DIMENSION IPPVV(1),VALF(1),VAL(1),IVPO(1)
  9. dimension imasq(1)
  10. IDEB4=2*IPPVV(ICA)
  11. NNKK=IVPO(IDEB4-1)
  12. DO 10 NNJ=ICA,ICB
  13. KK=NNJ-IECAR
  14. IDEB3=2*IPPVV(NNJ+1)
  15. NNJJ=IVPO(IDEB3-1)
  16. NJ=NNJJ-NNKK
  17. LLOL=MIN(NJ,KK)-1
  18. LLON=MIN(LLOL-KK+KPREM+1,LLOL-KQ+NBNNMA-KK+1)
  19. IF (LLON.GT.0) THEN
  20. IPOSM=NNJJ-LLOL-2
  21. IPLAC2=KK-LLOL-1
  22. IDEBZC=IVPO(IDEB3)
  23. p=0.D0
  24. DO 2 IDEB2=IDEB3,IDEB4+2,-2
  25. IAUX=IVPO(IDEB2-3)-IPOSM
  26. IPLAC=IVPO(IDEB2-2)-IAUX
  27. IFINZ=MIN(IDEBZC-1,LLON+IPLAC)
  28. IDEBZC=MAX(1,IAUX)+IPLAC
  29. IPLAC3=IPLAC2-IPLAC
  30. if (IFINZ-IDEBZC+1.GT.0) then
  31. ideq=IDEBZC+IPLAC3+idep-1
  32. if (IFINZ-IDEBZC.gt.masdim) then
  33. p=p+ddotpw(IFINZ-IDEBZC+1,VALF(ideq-idep+1),VAL(IDEBZC),
  34. > imasq(1),ideq,nbo)
  35. else
  36. if (imasq(ideq/masdim+1).gt.0.or.
  37. > imasq((ifinz+iplac3+idep-1)/masdim+1).gt.0)
  38. > p=p+ddotpv(IFINZ-IDEBZC+1,VALF(ideq-idep+1),VAL(IDEBZC))
  39. endif
  40. endif
  41. IF (IAUX.LE.1) GOTO 3
  42. 2 CONTINUE
  43. 3 CONTINUE
  44. VALF(KK)=VALF(KK)-P
  45. ENDIF
  46. IF (ABS(VALF(KK)).GT.DNORM) THEN
  47. KPREM=KK
  48. ICOL=KQ+KK-NBNNMA
  49. RE(ILIG,ICOL,1)=VALF(KK)
  50. RE(ICOL,ILIG,1)=VALF(KK)
  51. if (imasq((kk+idep-1)/masdim+1).le.0)
  52. > imasq((kk+idep-1)/masdim+1)=1
  53. ENDIF
  54. IDEB4=IDEB3
  55. NNKK=NNJJ
  56. 10 CONTINUE
  57. RETURN
  58. END
  59.  
  60.  
  61.  
  62.  
  63.  
  64.  
  65.  
  66.  
  67.  
  68.  
  69.  
  70.  
  71.  
  72.  
  73.  
  74.  
  75.  
  76.  
  77.  
  78.  

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