Télécharger super1.eso

Retour à la liste

Numérotation des lignes :

  1. C SUPER1 SOURCE PV 19/04/28 14:43:02 10210
  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+5) 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.  

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