Télécharger la plaquette Cast3M


fr en

Télécharger ddotpw.eso

Retour à la liste

Numérotation des lignes : 

ddotpw

  1. C DDOTPW    SOURCE    PV090527  23/01/09    21:15:04     11549          
  2.       function ddotpw(lon,val1,val2,imasq,idep,nbo)
  3. *
  4. *  produit scalaire utilisant imasq pour savoir quand operer
  5. * 
  6.       IMPLICIT INTEGER(I-N)
  7.       IMPLICIT REAL*8 (A-H,O-Z)
  8. -INC CCHOLE
  9.       logical nul
  10.       dimension val1(*),val2(*),imasq(*)
  11.       if (lon.le.0) then
  12.         ddotpw=0.d0
  13.         return
  14.       endif
  15.       pt=0.d0
  16.        jini=idep/masdim
  17. *      write (6,*) ' entree dans ddotpw ',idep,lon
  18.    5   continue
  19. *      write (6,*) ' apres 5 dans ddotpw',jini,imasq(jini+1)
  20.        jinii=jini
  21.        nul=.false.
  22. ***    if (imasq(jini+1).lt.0) jini=-imasq(jini+1)/masdim+1
  23.    6   continue
  24.        j=jini
  25.        do 10 j=jini,(idep+lon-1)/masdim
  26.         jm=imasq(j+1)
  27.         if (jm.gt.0) goto 20
  28.         if (jm.eq.0) goto 10
  29. *       write (6,*) ' acc 1 ',jini,-imasq(j+1)/masdim+1
  30.         jinio=-jm/masdim+1
  31.         if (jinio.gt.j+jacc) then
  32. **       if (j-jini.gt.100) write (6,*) ' rien trouve 2 jini ',jini,j
  33.          jini=jinio
  34.          goto 6
  35.         endif
  36.   10   continue
  37. **       if (j-jini.gt.100) write (6,*) ' rien trouve jini ',jini,j
  38.        nul=.true.
  39.   20   continue
  40.         nmasq=min(imasq(j-1+1),-(j-1)*masdim)
  41.         do jj=jinii,j-1
  42.            if (imasq(jj+1).le.nmasq) goto 22
  43.            imasq(jj+1)=nmasq
  44.         enddo
  45.   22    continue
  46. *  tous les masques nuls
  47.        if (nul) goto 100
  48.        jini=j
  49.        jfines=jini+1
  50.        jfin=jfines
  51.        if (jfines.gt.(idep+lon-1)/masdim) goto 32
  52. *      write (6,*) ' apres 21 dans ddotpw ',j,imasq(jfines+1)
  53. ***    if (imasq(jfines+1).gt.1) jfines=imasq(jfines+1)/masdim+1
  54.   31   continue
  55.        jfin=jfines
  56.        do 30 jfin=jfines,(idep+lon-1)/masdim
  57.         jm=imasq(jfin+1)
  58.         if (jm.le.0) goto 40
  59.         if (jm.eq.1) goto 30
  60. *        write (6,*) ' acc 2 ',idep,jfines,imasq(jfin+1)/masdim+1
  61.          jfineo=jm/masdim+1
  62.          if (jfineo.gt.jfin+jacc) then
  63.           jfines=jfineo
  64.           goto 31
  65.          endif
  66.   30   continue
  67. **       if (jfin-jfines.gt.10) write (6,*) 'rien trouve jfin ',
  68. **     >       jfin,jfines
  69.   40   continue
  70.         nmasq=max(imasq(jfin-1+1),(jfin-1)*masdim)
  71.         do jj=j,jfin-1
  72.           if (imasq(jj+1).ge.nmasq) goto 33
  73.           imasq(jj+1)=nmasq
  74.         enddo
  75.   33    continue
  76.   32   continue
  77.        jfin=jfin-1
  78.        ideb=max(1,jini*masdim-idep+1)
  79.        ifin=min((jfin+1)*masdim-idep,lon)
  80. *      write (6,*) ' ddotpw ideb ifin lon ',ideb,ifin,lon,jini,jfines,
  81. *    >   jfin
  82. **     do i=ideb,ifin
  83. **        pt=pt+val1(i)*val2(i)
  84. **     enddo
  85.  
  86.       lonl=ifin-ideb+1
  87.       if (lonl.gt.0) then
  88.       pt=pt+ddotpv(lonl,val1(ideb),val2(ideb))
  89.       nbo=nbo+lonl
  90.       if (indeb.gt.ifin+100000) write (6,*) ' ddotpw indeb ifin ',
  91.      >      ideb,ifin
  92.       endif
  93.        if (ifin.ge.lon) goto 100
  94.        jini=jfin+1
  95.        goto 5
  96.  100  continue
  97.       ddotpw=pt
  98.       return
  99.       end
  100.  
  101.  
  102.  
  103.  
  104.  
  105.  
  106.  
  107.  
  108.  
  109.  
  110.  
  111.  
  112.  
  113.  
  114.  
  115.  
  116.  
  117.  
  118.  
  119.  
  120.  
  121.  

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