Télécharger super1.eso

Retour à la liste

Numérotation des lignes :

super1
  1. C SUPER1 SOURCE PV 22/04/15 17:10:55 11344
  2. FUNCTION SUPER1(ILIGF,LIGN,VALF,DAAG,IPKNO,IPPVF,KHG,IVPOF,
  3. # KIDEP,KI1,KQ,NBNNMA,XMATRI,imasq,idep,prec,nc)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. -INC SMMATRI
  7. -INC SMRIGID
  8. -INC CCHOLE
  9. DIMENSION ILIGF(1),VALF(1),DAAG(1),IPKNO(1),IPPVF(1),IVPOF(1)
  10. dimension imasq(1)
  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. ILIG=IPREL+KHG-NBNNMA-1
  18. DO 10 K=KBAS,KHAU
  19. LIG1=ILIGF(K)
  20. IF (LIG1.EQ.LIGN) GOTO 20
  21. IECAR=KQ-LIG1.IPREL+1
  22. ICA=MAX(1,KIDEP+IECAR)
  23. ICB=LIG1.IMMM(/1)
  24. write (6,*) ' appel super2 '
  25. CALL SUPER2(LIG1.IPPVV(1),VALF(1),LIG1.VAL(1),LIG1.IVPO(1),
  26. > KQ,NBNNMA,ILIG,XMATRI,imasq(1),idep,ica,icb,iecar,kprem,
  27. > dnorm)
  28. 10 CONTINUE
  29. GOTO 50
  30. 20 CONTINUE
  31. IECAR=KQ-IPREL+1
  32. DO 30 NNJ=MAX(1,KIDEP+IECAR),KI1+IECAR
  33. KK=NNJ-IECAR
  34. ICOL=KQ+KK-NBNNMA
  35. NNJJ=IPPVF(NNJ+1)
  36. NJ=NNJJ-IPPVF(NNJ)
  37. LLOL=MIN(NJ,KK)-1
  38. LLON=MIN(LLOL-KK+KPREM+1,LLOL-NNJJ+IVPOF(NNJ)+1)
  39. LLON=MIN(LLON,NBNNMA-KQ-KK+LLOL+1)
  40. IF (LLON.GT.0.and.kk.ge.1) THEN
  41. IEC1=KK-LLOL-1
  42. IEC2=NNJJ-IPPKHG-KK
  43. ideq=1+iec1+idep-1
  44. if (llon.gt.masdim+1) then
  45. p=ddotpw(llon,VALF(1+iec1),VALF(1+iec1+iec2),
  46. > imasq(1),ideq-idep+1,nc)
  47. else
  48. ** if (imasq(ideq/masdim+1).gt.0.or.
  49. ** > imasq((ideq+llon)/masdim+1).gt.0)
  50. p=ddotpv(llon,VALF(1+iec1),VALF(1+iec1+iec2))
  51. if (llon.ge.1) nc=nc+llon
  52. endif
  53. VALF(KK)=VALF(KK)-P
  54. IF (ABS(VALF(KK)).GT.DNORM) THEN
  55. KPREM=KK
  56. imasq((kk+idep-1)/masdim+1) =1
  57. imasq((kk)/masdim+1) =1
  58. ELSE
  59. VALF(KK)=0.d0
  60. ENDIF
  61. ENDIF
  62. if (ilig.ge.1.and.icol.ge.1) then
  63. RE(ILIG,ICOL,1)=VALF(KK)
  64. RE(ICOL,ILIG,1)=VALF(KK)
  65. endif
  66. 30 CONTINUE
  67. 50 CONTINUE
  68. AUX1=0.D0
  69. kdeb=1
  70. 43 continue
  71. DO 9 K=kdeb,min(KPREM,nbnnma-kq)
  72. im=imasq((k)/masdim+1)
  73. if (im.eq.0) goto 9
  74. if (im.lt.0) then
  75. imr=-im
  76. if (imr.gt.k+jacc) then
  77. kdeb=imr
  78. GOTO 43
  79. else
  80. goto 9
  81. endif
  82. ENDIF
  83. AUX=VALF(K)
  84. VALF(K)=AUX/DAAG(K)
  85. AUX1=AUX1+AUX*VALF(K)
  86. 9 CONTINUE
  87. IVPOF(KHG)=KPREM+IPPKHG
  88. SUPER1=-AUX1
  89. RETURN
  90. END
  91.  
  92.  
  93.  
  94.  
  95.  
  96.  
  97.  
  98.  
  99.  
  100.  
  101.  
  102.  
  103.  
  104.  
  105.  
  106.  
  107.  
  108.  
  109.  
  110.  
  111.  
  112.  
  113.  
  114.  
  115.  
  116.  
  117.  
  118.  

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