Télécharger la plaquette Cast3M


fr en

Télécharger mamupv.eso

Retour à la liste

Numérotation des lignes : 

mamupv

  1. C MAMUPV    SOURCE    PV        22/04/15    17:10:53     11344          
  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(36)
  11.            do i=1,min(6,na) * min(6,na1)
  12.            pt(i)=0.d0
  13.            enddo
  14.         if (ideb.gt.ifin) goto 999
  15.         jini=(ideb+imb)/masdim
  16.    5    continue
  17.         jinii=jini
  18.         nul=.false.
  19.    6    continue
  20.         j=jini
  21.         do 10 j=jini,(ifin+imb)/masdim
  22.           jm=imasq(j+1)
  23.           if (jm.gt.0) goto 20
  24.           if (jm.eq.0) goto 10
  25.           jinio=-jm/masdim+1
  26.           if (jinio.gt.j+jacc) then
  27.            jini=jinio
  28.            goto 6
  29.           endif
  30.   10    continue
  31.         nul=.true.
  32.   20    continue
  33.         nmasq=min(imasq(j-1+1),-(j-1)*masdim)
  34.         do jj=jinii,j-1
  35.           if (imasq(jj+1).le.nmasq) goto 22
  36.           imasq(jj+1)=nmasq
  37.         enddo
  38.   22    continue
  39.   21    continue
  40.         if (nul) goto 999
  41.         jini=j
  42.         jfines=jini+1
  43.         jfin=jfines
  44.         if (jfines.gt.(ifin+imb)/masdim) goto 32
  45.   31    continue
  46.         jfin=jfines
  47.         do 30 jfin=jfines,(ifin+imb)/masdim
  48.            jm=imasq(jfin+1)
  49.            if (jm.le.0) goto 40
  50.            if (jm.eq.1) goto 30
  51.            jfineo=jm/masdim+1
  52.            if (jfineo.gt.jfin+jacc) then
  53.              jfines=jfineo
  54.              goto 31
  55.            endif
  56.   30    continue
  57.   40    continue
  58.         nmasq=max(imasq(jfin-1+1),(jfin-1)*masdim)
  59.         do jj=jini,jfin-1
  60.             if (imasq(jj+1).ge.nmasq) goto 33
  61.             imasq(jj+1)=nmasq
  62.         enddo
  63.   33    continue
  64.   32    continue
  65.         jfin=jfin-1
  66.         idebn=max((ideb+imb),jini*masdim)-imb
  67.         ifinn=min((jfin+1)*masdim-1,ifin+imb)-imb
  68.  998    continue
  69. **       idebn=ideb
  70. **       ifinn=ifin
  71.       lon = ifinn-idebn+1
  72.       if (lon.le.0) goto 997
  73. **    if (idebn.gt.ifinn+100000) write (6,*) ' mamupv idebn ifinn ',
  74. **   >      idebn,ifinn
  75.               ilpos1=ilpos1b+idebn
  76.               iposr1=iposrb+idebn
  77. **        if (na.gt.3.or.na1.gt.3) write(6,*) ' mamupv na na1 ',na,na1
  78.            if (na.ge.6) then
  79.             if (na1.ge.6) then
  80.       nbo=nbo+lon*36
  81.       call mamu66(lon,val1(ilpos1),lpl1,val(iposr1),lpl,pt)
  82.             elseif (na1.ge.5) then
  83.       nbo=nbo+lon*30
  84.       call mamu65(lon,val1(ilpos1),lpl1,val(iposr1),lpl,pt)
  85.             elseif (na1.ge.4) then
  86.       nbo=nbo+lon*24
  87.       call mamu64(lon,val1(ilpos1),lpl1,val(iposr1),lpl,pt)
  88.             elseif (na1.ge.3) then
  89.       nbo=nbo+lon*18
  90.       call mamu63(lon,val1(ilpos1),lpl1,val(iposr1),lpl,pt)
  91.             elseif (na1.ge.2) then
  92.       nbo=nbo+lon*12
  93.       call mamu62(lon,val1(ilpos1),lpl1,val(iposr1),lpl,pt)
  94.             elseif (na1.ge.1) then
  95.       nbo=nbo+lon*6
  96.       call mamu61(lon,val1(ilpos1),     val(iposr1),lpl,pt)
  97.             endif
  98.            elseif (na.ge.5) then
  99.             if (na1.ge.6) then
  100.       nbo=nbo+lon*30
  101.       call mamu56(lon,val1(ilpos1),lpl1,val(iposr1),lpl,pt)
  102.             elseif (na1.ge.5) then
  103.       nbo=nbo+lon*25
  104.       call mamu55(lon,val1(ilpos1),lpl1,val(iposr1),lpl,pt)
  105.             elseif (na1.ge.4) then
  106.       nbo=nbo+lon*20
  107.       call mamu54(lon,val1(ilpos1),lpl1,val(iposr1),lpl,pt)
  108.             elseif (na1.ge.3) then
  109.       nbo=nbo+lon*15
  110.       call mamu53(lon,val1(ilpos1),lpl1,val(iposr1),lpl,pt)
  111.             elseif (na1.ge.2) then
  112.       nbo=nbo+lon*10
  113.       call mamu52(lon,val1(ilpos1),lpl1,val(iposr1),lpl,pt)
  114.             elseif (na1.ge.1) then
  115.       nbo=nbo+lon*5
  116.       call mamu51(lon,val1(ilpos1),     val(iposr1),lpl,pt)
  117.             endif
  118.            elseif (na.ge.4) then
  119.             if (na1.ge.6) then
  120.       nbo=nbo+lon*24
  121.       call mamu46(lon,val1(ilpos1),lpl1,val(iposr1),lpl,pt)
  122.             elseif (na1.ge.5) then
  123.       nbo=nbo+lon*20
  124.       call mamu45(lon,val1(ilpos1),lpl1,val(iposr1),lpl,pt)
  125.             elseif (na1.ge.4) then
  126.       nbo=nbo+lon*16
  127.       call mamu44(lon,val1(ilpos1),lpl1,val(iposr1),lpl,pt)
  128.             elseif (na1.ge.3) then
  129.       nbo=nbo+lon*12
  130.       call mamu43(lon,val1(ilpos1),lpl1,val(iposr1),lpl,pt)
  131.             elseif (na1.ge.2) then
  132.       nbo=nbo+lon*8
  133.       call mamu42(lon,val1(ilpos1),lpl1,val(iposr1),lpl,pt)
  134.             elseif (na1.ge.1) then
  135.       nbo=nbo+lon*4
  136.       call mamu41(lon,val1(ilpos1),     val(iposr1),lpl,pt)
  137.             endif
  138.            elseif (na.ge.3) then
  139.             if (na1.ge.6) then
  140.       nbo=nbo+lon*18
  141.       call mamu36(lon,val1(ilpos1),lpl1,val(iposr1),lpl,pt)
  142.             elseif (na1.ge.5) then
  143.       nbo=nbo+lon*15
  144.       call mamu35(lon,val1(ilpos1),lpl1,val(iposr1),lpl,pt)
  145.             elseif (na1.ge.4) then
  146.       nbo=nbo+lon*12
  147.       call mamu34(lon,val1(ilpos1),lpl1,val(iposr1),lpl,pt)
  148.             elseif (na1.ge.3) then
  149.       nbo=nbo+lon*9
  150.       call mamu33(lon,val1(ilpos1),lpl1,val(iposr1),lpl,pt)
  151.             elseif (na1.ge.2) then
  152.       nbo=nbo+lon*6
  153.       call mamu32(lon,val1(ilpos1),lpl1,val(iposr1),lpl,pt)
  154.             elseif (na1.ge.1) then
  155.       nbo=nbo+lon*3
  156.       call mamu31(lon,val1(ilpos1),     val(iposr1),lpl,pt)
  157.             endif
  158.            elseif (na.ge.2) then
  159.             if (na1.ge.6) then
  160.       nbo=nbo+lon*12
  161.       call mamu26(lon,val1(ilpos1),lpl1,val(iposr1),lpl,pt)
  162.             elseif (na1.ge.5) then
  163.       nbo=nbo+lon*10
  164.       call mamu25(lon,val1(ilpos1),lpl1,val(iposr1),lpl,pt)
  165.             elseif (na1.ge.4) then
  166.       nbo=nbo+lon*8
  167.       call mamu24(lon,val1(ilpos1),lpl1,val(iposr1),lpl,pt)
  168.             elseif (na1.ge.3) then
  169.       nbo=nbo+lon*6
  170.       call mamu23(lon,val1(ilpos1),lpl1,val(iposr1),lpl,pt)
  171.            elseif (na1.ge.2) then
  172.       nbo=nbo+lon*4
  173.       call mamu22(lon,val1(ilpos1),lpl1,val(iposr1),lpl,pt)
  174.            elseif (na1.ge.1) then
  175.       nbo=nbo+lon*2
  176.       call mamu21(lon,val1(ilpos1),     val(iposr1),lpl,pt)
  177.             endif
  178.            elseif (na.ge.1) then
  179.             if (na1.ge.6) then
  180.       nbo=nbo+lon*6
  181.       call mamu16(lon,val1(ilpos1),lpl1,val(iposr1),    pt)
  182.             elseif (na1.ge.5) then
  183.       nbo=nbo+lon*5
  184.       call mamu15(lon,val1(ilpos1),lpl1,val(iposr1),    pt)
  185.             elseif (na1.ge.4) then
  186.       nbo=nbo+lon*4
  187.       call mamu14(lon,val1(ilpos1),lpl1,val(iposr1),    pt)
  188.             elseif (na1.ge.3) then
  189.       nbo=nbo+lon*3
  190.       call mamu13(lon,val1(ilpos1),lpl1,val(iposr1),    pt)
  191.             elseif (na1.ge.2) then
  192.       nbo=nbo+lon*2
  193.       call mamu12(lon,val1(ilpos1),lpl1,val(iposr1),    pt)
  194.             elseif (na1.ge.1) then
  195.       nbo=nbo+lon
  196.       pt(1)=pt(1)+ddotpv((lon),val1(ilpos1),val(iposr1))
  197.             endif
  198. *           else
  199. *              ilpos2=ilpos1+lpl1
  200. *              ilpos3=ilpos2+lpl1+1
  201. *              iposr2=iposr1+lpl
  202. *              iposr3=iposr2+lpl+1
  203. *           do 101 ipos=idebn,ifinn
  204. *
  205. *              xval1=val(iposr1)
  206. *              iposr1= iposr1+1
  207. *              if (na.ge.2) then
  208. *               xval2=val(iposr2)
  209. *               iposr2= iposr2+1
  210. *              endif
  211. *              if (na.ge.3) then
  212. *               xval3=val(iposr3)
  213. *               iposr3=iposr3+1
  214. *              endif
  215. *
  216. *              xval11=val1(ilpos1)
  217. *              ilpos1=ilpos1+1
  218. *              pt(1)=pt(1)+xval1*xval11
  219. *              if (na.ge.2) pt(4)=pt(4)+xval2*xval11
  220. *              if (na.ge.3) pt(7)=pt(7)+xval3*xval11
  221. *              if (na1.ge.2) then
  222. *               xval12=val1(ilpos2)
  223. *               ilpos2=ilpos2+1
  224. *               pt(2)=pt(2)+xval1*xval12
  225. *               if (na.ge.2) pt(5)=pt(5)+xval2*xval12
  226. *               if (na.ge.3) pt(8)=pt(8)+xval3*xval12
  227. *              endif
  228. *              if (na1.ge.3) then
  229. *               xval13=val1(ilpos3)
  230. *               ilpos3=ilpos3+1
  231. *               pt(3)=pt(3)+xval1*xval13
  232. *               if (na.ge.2) pt(6)=pt(6)+xval2*xval13
  233. *               if (na.ge.3) pt(9)=pt(9)+xval3*xval13
  234. *              endif
  235. * 101       continue
  236. *         if (ifinn-idebn.ge.0) nbo=nbo+(ifinn-idebn+1)*na*na1
  237.  
  238.            endif
  239.  997  continue
  240.        if (ifinn.ge.ifin) goto 999
  241.        jini=jfin+1
  242.        goto 5
  243.  999       continue
  244.       RETURN
  245.       END
  246.  
  247.  
  248.  
  249.  
  250.  
  251.  
  252.  
  253.  
  254.  
  255.  
  256.  
  257.  
  258.  
  259.  
  260.  
  261.  
  262.  
  263.  
  264.  
  265.  
  266.  
  267.  
  268.  
  269.  
  270.  
  271.  
  272.  
  273.  
  274.  

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