Esope source files

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