Numérotation des lignes :

disp3d
C DISP3D    SOURCE    PV090527  23/02/07    11:58:35     11592                subroutine disp3d(s,xg,yg,zg,tri,npos)       implicit real*8 (a-h,o-z)      implicit integer (i-n)c      include './decl_disc_spher.h' -INC HDECSPH        integer i,j,k,nc calcule les surfaces et les orientations des cdg de triangles qui discrétisent une surfacec en repère sphérique pour 1/2 de sphere   c    orientation des points      do i=1,npos+1        thet1(i)=(i-1)*ang1/npos               gam1(i)=-pi/2+(i-1)*ang1/npos       end do c coordonnées des points      do i=1,npos+1        do j=1,npos+1           x(i,j)=sin(thet1(j))*cos(gam1(i))                y(i,j)=sin(thet1(j))*sin(gam1(i))           z(i,j)=cos(thet1(j))  c           open(unit=1,file="ptsphere.res")c           if(i.eq.1) thenc           write(unit=1,fmt='(11g13.5)')c           end ifc           write(unit=1,fmt='(11g13.5)') x(i,j),y(i,j),z(i,j)c          splot "ptsphere.res" u 1:2:3 with pm3d at sc          splot "ptsphere.res" u 1:2:3 with lines        end do      end do c numérotation des trianglesc n,k : trianglesc l : sommetc m : coordonnée      do n=1,npos        do k=1,2*npos-2c               print*,mod(k,2),k            if(k.eq.1) thenc sommet 1               tri(n,k,1,1)=x(1,1)              tri(n,k,1,2)=y(1,1)              tri(n,k,1,3)=z(1,1)c sommet 2                             tri(n,k,2,1)=x(n+1,2)               tri(n,k,2,2)=y(n+1,2)               tri(n,k,2,3)=z(n+1,2)             c sommet 3                              tri(n,k,3,1)=x(n,2)               tri(n,k,3,2)=y(n,2)               tri(n,k,3,3)=z(n,2)              else if (k.eq.2*npos-2) then c sommet 1               tri(n,k,1,1)=x(n+1,npos)              tri(n,k,1,2)=y(n+1,npos)              tri(n,k,1,3)=z(n+1,npos)c sommet 2                             tri(n,k,2,1)=x(n,npos)               tri(n,k,2,2)=y(n,npos)               tri(n,k,2,3)=z(n,npos)             c sommet 3                              tri(n,k,3,1)=x(npos+1,npos+1)               tri(n,k,3,2)=y(npos+1,npos+1)               tri(n,k,3,3)=z(npos+1,npos+1)                             else if( mod(k,2).eq.0) then c            =0 si pair, 1 si impair   c sommet 1                           tri(n,k,1,1)=x(n+1,k/2+1)              tri(n,k,1,2)=y(n+1,k/2+1)              tri(n,k,1,3)=z(n+1,k/2+1)c sommet 2                             tri(n,k,2,1)=x(n,k/2+1)               tri(n,k,2,2)=y(n,k/2+1)               tri(n,k,2,3)=z(n,k/2+1)         c sommet 3                             tri(n,k,3,1)=x(n+1,k/2+2)               tri(n,k,3,2)=y(n+1,k/2+2)               tri(n,k,3,3)=z(n+1,k/2+2)             else if( mod(k,2).eq.1) then c            =0 si pair, 1 si impair c sommet 1                           tri(n,k,1,1)=x(n,(k-1)/2+1)              tri(n,k,1,2)=y(n,(k-1)/2+1)              tri(n,k,1,3)=z(n,(k-1)/2+1)c sommet 2                             tri(n,k,2,1)=x(n+1,(k+1)/2+1)               tri(n,k,2,2)=y(n+1,(k+1)/2+1)               tri(n,k,2,3)=z(n+1,(k+1)/2+1)         c sommet 3                             tri(n,k,3,1)=x(n,(k+1)/2+1)               tri(n,k,3,2)=y(n,(k+1)/2+1)               tri(n,k,3,3)=z(n,(k+1)/2+1)            end if      end do         end do c calcul des positions des cdg       do n=1,npos        do k=1,2*npos-2             xg(n,k)=(tri(n,k,1,1)+tri(n,k,2,1)+tri(n,k,3,1))/3.d0         yg(n,k)=(tri(n,k,1,2)+tri(n,k,2,2)+tri(n,k,3,2))/3.d0         zg(n,k)=(tri(n,k,1,3)+tri(n,k,2,3)+tri(n,k,3,3))/3.d0 c normalisation des vecteurs                  xg(n,k)=xg(n,k)/sqrt(xg(n,k)**2+yg(n,k)**2+zg(n,k)**2)         yg(n,k)=yg(n,k)/sqrt(xg(n,k)**2+yg(n,k)**2+zg(n,k)**2)         zg(n,k)=zg(n,k)/sqrt(xg(n,k)**2+yg(n,k)**2+zg(n,k)**2) c           open(unit=2,file="cdgtri.res")c           write(unit=2,fmt='(11g13.5)') xg(n,k),yg(n,k),zg(n,k)c           splot "cdgtri.res"c           splot "cdgtri.res","ptsphere.res" lc "blue" w pm3d at s      end do        end do           c calcul des surfaces      do n=1,npos        do k=1,2*npos-2          s(n,k) = sqrt((tri(n, k, 2, 2) * tri(n, k, 1, 1) - tri(n, k, 1,1)*      #tri(n, k, 3, 2) - tri(n, k, 1, 2) * tri(n, k, 2, 1) + tri(n, k, 2,     # 1) * tri(n, k, 3, 2) + tri(n, k, 1, 2) * tri(n, k, 3, 1) - tri(n,     # k, 3, 1) * tri(n, k, 2, 2)) ** 2 + (tri(n, k, 1, 2) * tri(n, k, 2     #, 3) - tri(n, k, 1, 2) * tri(n, k, 3, 3) - tri(n, k, 1, 3) * tri(n     #, k, 2, 2) + tri(n, k, 2, 2) * tri(n, k, 3, 3) + tri(n, k, 1, 3) *     # tri(n, k, 3, 2) - tri(n, k, 3, 2) * tri(n, k, 2, 3)) ** 2 + (-tri     #(n, k, 1, 1) * tri(n, k, 2, 3) + tri(n, k, 1, 1) * tri(n, k, 3, 3)     # + tri(n, k, 1, 3) * tri(n, k, 2, 1) - tri(n, k, 2, 1) * tri(n, k,     # 3, 3) - tri(n, k, 1, 3) * tri(n, k, 3, 1) + tri(n, k, 3, 1) * tri     #(n, k, 2, 3)) ** 2) / 0.2D1      end do        end do  c    somme des surfaces      sum1=sum(s)c normalisation des surfaces pour que la somme fasse 2 ang1      do n=1,npos        do k=1,2*npos-2        s(n,k)=s(n,k)/sum1*2*ang1        end do        end do        return       end   

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