Télécharger super3.eso

Retour à la liste

Numérotation des lignes :

super3
  1. C SUPER3 SOURCE PV 22/04/15 17:10:56 11344
  2. SUBROUTINE SUPER3(IPREL,IDERL,IPPV,IPPR,IDDR,IVPO,
  3. # IPPVV1,VAL,VAL1,IVPO1,NBNNMA,XMATRI,imasq,prec,nc)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6. DIMENSION IPPV(100),IVPO(*),IPPVV1(*),VAL(*),VAL1(*),IVPO1(*)
  7. dimension imasq(1)
  8. -INC SMRIGID
  9. -INC CCHOLE
  10. IDD2=IPPV(1)
  11. na=iderl-iprel+1
  12. kidepg=ivpo(1)
  13. kidepb=ivpo(1)
  14. do 121 im=2,na
  15. kidepg=max(kidepg,ivpo(im))
  16. 121 continue
  17. DO 10 J=IPREL,IDERL
  18. ICOL=J-NBNNMA
  19. JID=J-IPREL+1
  20. IDD3=IPPV(JID+1)
  21. N2=IDD3-IDD2
  22. KD2=J-N2+1
  23. c KD2=J-N2
  24. N2J=IDD3-J
  25. KIDEP=IVPO(JID)
  26. c IBABA=MAX(IPPR,KD2+1)
  27. IBABA=MAX(IPPR,KD2)
  28. IF (IBABA.GT.IDDR) GOTO 30
  29. IDEB4=2*IPPVV1(IBABA-IPPR+1)
  30. IDD=IVPO1(IDEB4-1)
  31. DO 20 JHY=IBABA,IDDR
  32. ILIG=JHY-NBNNMA
  33. ILM=JHY-IPPR+1
  34. IDEB3=2*IPPVV1(ILM+1)
  35. NNJJ=IVPO1(IDEB3-1)
  36. N=NNJJ-IDD
  37. KD1=1+JHY-N
  38. IDEP=MAX(KD2,KD1)
  39. LLOL=JHY-IDEP
  40. I1=JHY+N2J
  41. LLON=MIN(LLOL-I1+KIDEPg+1,NBNNMA-IDEP+1)
  42. * on compare a la diagonale de la colonne
  43. DNORM=ABS(VAL1(IVPO1(IDEB3)-1))*prec
  44. IF (LLON.GT.0.and.i1.ge.1) THEN
  45. IPOSM=N-LLOL+IDD-2
  46. IPLAC2=N2J+IDEP-1
  47. idebzc=ivpo1(ideb3)
  48. p=0.D0
  49. DO 2 IDEB2=IDEB3,IDEB4+2,-2
  50. IAUX=IVPO1(IDEB2-3)-IPOSM
  51. IPLAC=IVPO1(IDEB2-2)-IAUX
  52. IFINZ=MIN(IDEBZC-1,LLON+IPLAC)
  53. IDEBZC=MAX(1,IAUX)+IPLAC
  54. IPLAC3=IPLAC2-IPLAC
  55. lond=ifinz-idebzc+1
  56. if (lond.GT.0) then
  57. ideq=IDEBZC+IPLAC3
  58. if (IFINZ-IDEBZC.GT.masdim) then
  59. if (-imasq((ideq-idd2)/masdim+1).le.ideq-ippv(jid)+lond-1)
  60. > p=p+ddotpw(lond,VAL(ideq),VAL1(IDEBZC),
  61. > imasq(1),ideq-idd2,nc)
  62. else
  63. * if (imasq(ideq/masdim+1).gt.0.or.
  64. * > imasq((ifinz+iplac3)/masdim+1).gt.0)
  65. p=p+ddotpv(lond,VAL(ideq),VAL1(IDEBZC))
  66. if (lond.ge.1) nc=nc+lond
  67. endif
  68. endif
  69. IF (IAUX.LE.1) GOTO 3
  70. 2 CONTINUE
  71. 3 CONTINUE
  72. val(i1)=val(i1)-p
  73. if (abs(val(i1)).gt.dnorm) then
  74. imasq(i1/masdim+1)=1
  75. imasq((i1-idd2)/masdim+1)=1
  76. * mise a jour masque
  77. do imt=kidep/masdim+1+1,i1/masdim+1-1
  78. imasq(imt)=-(i1/masdim)*masdim+1
  79. enddo
  80. KIDEP=I1
  81. if (jid.ne.1) then
  82. do imt=kidepb/masdim+1+1,(i1-idd2)/masdim+1-1
  83. imasq(imt)=-((i1-idd2)/masdim)*masdim+1
  84. enddo
  85. endif
  86. kidepb=max(i1-idd2,kidepb)
  87. ELSE
  88. val(i1)=0.d0
  89. ENDIF
  90. ENDIF
  91. if (ilig.ge.1.and.icol.ge.1) then
  92. RE(ILIG,ICOL,1)=VAL(I1)
  93. RE(ICOL,ILIG,1)=VAL(I1)
  94. endif
  95. 5 CONTINUE
  96. IDEB4=IDEB3
  97. IDD=NNJJ
  98. 20 CONTINUE
  99. 30 CONTINUE
  100. IVPO(JID)=KIDEP
  101. IVPO(1)=kidepb
  102. IDD2=IDD3
  103. 10 CONTINUE
  104. RETURN
  105. END
  106.  
  107.  
  108.  
  109.  
  110.  
  111.  
  112.  
  113.  
  114.  
  115.  
  116.  
  117.  
  118.  
  119.  
  120.  
  121.  
  122.  
  123.  
  124.  
  125.  
  126.  

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