Télécharger mamupv.eso

Retour à la liste

Numérotation des lignes :

  1. C MAMUPV SOURCE PV 16/11/17 22:00:41 9180
  2. subroutine mamupv(ideb,ifin,val,iposrb,lpl,val1,ilpos1b,lpl1,
  3. > imasq,imb,pt,na,na1,nbo)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6. -INC CCHOLE
  7. logical nul
  8. DIMENSION VAL(*),VAL1(*)
  9. dimension imasq(*)
  10. real*8 pt(9)
  11. pt(1)=0.d0
  12. pt(2)=0.d0
  13. pt(3)=0.d0
  14. pt(4)=0.d0
  15. pt(5)=0.d0
  16. pt(6)=0.d0
  17. pt(7)=0.d0
  18. pt(8)=0.d0
  19. pt(9)=0.d0
  20. if (ideb.gt.ifin) goto 999
  21. jini=(ideb+imb)/masdim
  22. 5 continue
  23. jinii=jini
  24. nul=.false.
  25. 6 continue
  26. j=jini
  27. do 10 j=jini,(ifin+imb)/masdim
  28. jm=imasq(j+1)
  29. if (jm.gt.0) goto 20
  30. if (jm.eq.0) goto 10
  31. jinio=-jm/masdim+1
  32. if (jinio.gt.j+7) then
  33. jini=jinio
  34. goto 6
  35. endif
  36. 10 continue
  37. nul=.true.
  38. 20 continue
  39. nmasq=min(imasq(j-1+1),-(j-1)*masdim)
  40. do jj=jinii,j-1
  41. if (imasq(jj+1).le.nmasq) goto 22
  42. imasq(jj+1)=nmasq
  43. enddo
  44. 22 continue
  45. 21 continue
  46. if (nul) goto 999
  47. jini=j
  48. jfines=jini+1
  49. jfin=jfines
  50. if (jfines.gt.(ifin+imb)/masdim) goto 32
  51. 31 continue
  52. jfin=jfines
  53. do 30 jfin=jfines,(ifin+imb)/masdim
  54. jm=imasq(jfin+1)
  55. if (jm.le.0) goto 40
  56. if (jm.eq.1) goto 30
  57. jfineo=jm/masdim+1
  58. if (jfineo.gt.jfin+7) then
  59. jfines=jfineo
  60. goto 31
  61. endif
  62. 30 continue
  63. 40 continue
  64. nmasq=max(imasq(jfin-1+1),(jfin-1)*masdim)
  65. do jj=jini,jfin-1
  66. if (imasq(jj+1).ge.nmasq) goto 33
  67. imasq(jj+1)=nmasq
  68. enddo
  69. 33 continue
  70. 32 continue
  71. jfin=jfin-1
  72. idebn=max((ideb+imb),jini*masdim)-imb
  73. ifinn=min((jfin+1)*masdim-1,ifin+imb)-imb
  74. 998 continue
  75. ** idebn=ideb
  76. ** ifinn=ifin
  77. lon = ifinn-idebn+1
  78. if (lon.le.0) goto 997
  79. ** if (idebn.gt.ifinn+100000) write (6,*) ' mamupv idebn ifinn ',
  80. ** > idebn,ifinn
  81. ilpos1=ilpos1b+idebn
  82. iposr1=iposrb+idebn
  83. if (na.ge.3) then
  84. if (na1.ge.3) then
  85. nbo=nbo+lon*9
  86. call mamu33(lon,val1(ilpos1),lpl1,val(iposr1),lpl,pt)
  87. elseif (na1.ge.2) then
  88. nbo=nbo+lon*6
  89. call mamu32(lon,val1(ilpos1),lpl1,val(iposr1),lpl,pt)
  90. elseif (na1.ge.1) then
  91. nbo=nbo+lon*3
  92. call mamu31(lon,val1(ilpos1) ,val(iposr1),lpl,pt)
  93. endif
  94. elseif (na.ge.2) then
  95. if (na1.ge.3) then
  96. nbo=nbo+lon*6
  97. call mamu23(lon,val1(ilpos1),lpl1,val(iposr1),lpl,pt)
  98. elseif (na1.ge.2) then
  99. nbo=nbo+lon*4
  100. call mamu22(lon,val1(ilpos1),lpl1,val(iposr1),lpl,pt)
  101. elseif (na1.ge.1) then
  102. nbo=nbo+lon*2
  103. call mamu21(lon,val1(ilpos1) ,val(iposr1),lpl,pt)
  104. endif
  105. elseif (na.ge.1) then
  106. if (na1.ge.3) then
  107. nbo=nbo+lon*3
  108. call mamu13(lon,val1(ilpos1),lpl1,val(iposr1) ,pt)
  109. elseif (na1.ge.2) then
  110. nbo=nbo+lon*2
  111. call mamu12(lon,val1(ilpos1),lpl1,val(iposr1) ,pt)
  112. elseif (na1.ge.1) then
  113. nbo=nbo+lon
  114. pt(1)=pt(1)+ddotpv((lon),val1(ilpos1),val(iposr1))
  115. endif
  116. * else
  117. * ilpos2=ilpos1+lpl1
  118. * ilpos3=ilpos2+lpl1+1
  119. * iposr2=iposr1+lpl
  120. * iposr3=iposr2+lpl+1
  121. * do 101 ipos=idebn,ifinn
  122. *
  123. * xval1=val(iposr1)
  124. * iposr1= iposr1+1
  125. * if (na.ge.2) then
  126. * xval2=val(iposr2)
  127. * iposr2= iposr2+1
  128. * endif
  129. * if (na.ge.3) then
  130. * xval3=val(iposr3)
  131. * iposr3=iposr3+1
  132. * endif
  133. *
  134. * xval11=val1(ilpos1)
  135. * ilpos1=ilpos1+1
  136. * pt(1)=pt(1)+xval1*xval11
  137. * if (na.ge.2) pt(4)=pt(4)+xval2*xval11
  138. * if (na.ge.3) pt(7)=pt(7)+xval3*xval11
  139. * if (na1.ge.2) then
  140. * xval12=val1(ilpos2)
  141. * ilpos2=ilpos2+1
  142. * pt(2)=pt(2)+xval1*xval12
  143. * if (na.ge.2) pt(5)=pt(5)+xval2*xval12
  144. * if (na.ge.3) pt(8)=pt(8)+xval3*xval12
  145. * endif
  146. * if (na1.ge.3) then
  147. * xval13=val1(ilpos3)
  148. * ilpos3=ilpos3+1
  149. * pt(3)=pt(3)+xval1*xval13
  150. * if (na.ge.2) pt(6)=pt(6)+xval2*xval13
  151. * if (na.ge.3) pt(9)=pt(9)+xval3*xval13
  152. * endif
  153. * 101 continue
  154. * if (ifinn-idebn.ge.0) nbo=nbo+(ifinn-idebn+1)*na*na1
  155.  
  156. endif
  157. 997 continue
  158. if (ifinn.ge.ifin) goto 999
  159. jini=jfin+1
  160. goto 5
  161. 999 continue
  162. RETURN
  163. END
  164.  
  165.  
  166.  
  167.  
  168.  
  169.  
  170.  
  171.  
  172.  
  173.  
  174.  
  175.  
  176.  
  177.  
  178.  
  179.  
  180.  
  181.  
  182.  
  183.  
  184.  
  185.  
  186.  

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