X-Git-Url: http://info.iut-bm.univ-fcomte.fr/pub/gitweb/simgrid.git/blobdiff_plain/d64b23f264fa43f785c688073c66297a7c475c40..d8983d99631ddba747941cadb391ce80243a5529:/examples/smpi/NAS/LU/pintgr.f diff --git a/examples/smpi/NAS/LU/pintgr.f b/examples/smpi/NAS/LU/pintgr.f deleted file mode 100644 index de514cccd2..0000000000 --- a/examples/smpi/NAS/LU/pintgr.f +++ /dev/null @@ -1,288 +0,0 @@ - -c--------------------------------------------------------------------- -c--------------------------------------------------------------------- - - subroutine pintgr - -c--------------------------------------------------------------------- -c--------------------------------------------------------------------- - - implicit none - - include 'mpinpb.h' - include 'applu.incl' - -c--------------------------------------------------------------------- -c local variables -c--------------------------------------------------------------------- - integer i, j, k - integer ibeg, ifin, ifin1 - integer jbeg, jfin, jfin1 - integer iglob, iglob1, iglob2 - integer jglob, jglob1, jglob2 - integer ind1, ind2 - double precision phi1(0:isiz2+1,0:isiz3+1), - > phi2(0:isiz2+1,0:isiz3+1) - double precision frc1, frc2, frc3 - double precision dummy - - integer IERROR - - -c--------------------------------------------------------------------- -c set up the sub-domains for integeration in each processor -c--------------------------------------------------------------------- - ibeg = nx + 1 - ifin = 0 - iglob1 = ipt + 1 - iglob2 = ipt + nx - if (iglob1.ge.ii1.and.iglob2.lt.ii2+nx) ibeg = 1 - if (iglob1.gt.ii1-nx.and.iglob2.le.ii2) ifin = nx - if (ii1.ge.iglob1.and.ii1.le.iglob2) ibeg = ii1 - ipt - if (ii2.ge.iglob1.and.ii2.le.iglob2) ifin = ii2 - ipt - jbeg = ny + 1 - jfin = 0 - jglob1 = jpt + 1 - jglob2 = jpt + ny - if (jglob1.ge.ji1.and.jglob2.lt.ji2+ny) jbeg = 1 - if (jglob1.gt.ji1-ny.and.jglob2.le.ji2) jfin = ny - if (ji1.ge.jglob1.and.ji1.le.jglob2) jbeg = ji1 - jpt - if (ji2.ge.jglob1.and.ji2.le.jglob2) jfin = ji2 - jpt - ifin1 = ifin - jfin1 = jfin - if (ipt + ifin1.eq.ii2) ifin1 = ifin -1 - if (jpt + jfin1.eq.ji2) jfin1 = jfin -1 - -c--------------------------------------------------------------------- -c initialize -c--------------------------------------------------------------------- - do i = 0,isiz2+1 - do k = 0,isiz3+1 - phi1(i,k) = 0. - phi2(i,k) = 0. - end do - end do - - do j = jbeg,jfin - jglob = jpt + j - do i = ibeg,ifin - iglob = ipt + i - - k = ki1 - - phi1(i,j) = c2*( u(5,i,j,k) - > - 0.50d+00 * ( u(2,i,j,k) ** 2 - > + u(3,i,j,k) ** 2 - > + u(4,i,j,k) ** 2 ) - > / u(1,i,j,k) ) - - k = ki2 - - phi2(i,j) = c2*( u(5,i,j,k) - > - 0.50d+00 * ( u(2,i,j,k) ** 2 - > + u(3,i,j,k) ** 2 - > + u(4,i,j,k) ** 2 ) - > / u(1,i,j,k) ) - end do - end do - -c--------------------------------------------------------------------- -c communicate in i and j directions -c--------------------------------------------------------------------- - call exchange_4(phi1,phi2,ibeg,ifin1,jbeg,jfin1) - - frc1 = 0.0d+00 - - do j = jbeg,jfin1 - do i = ibeg, ifin1 - frc1 = frc1 + ( phi1(i,j) - > + phi1(i+1,j) - > + phi1(i,j+1) - > + phi1(i+1,j+1) - > + phi2(i,j) - > + phi2(i+1,j) - > + phi2(i,j+1) - > + phi2(i+1,j+1) ) - end do - end do - -c--------------------------------------------------------------------- -c compute the global sum of individual contributions to frc1 -c--------------------------------------------------------------------- - dummy = frc1 - call MPI_ALLREDUCE( dummy, - > frc1, - > 1, - > dp_type, - > MPI_SUM, - > MPI_COMM_WORLD, - > IERROR ) - - frc1 = dxi * deta * frc1 - -c--------------------------------------------------------------------- -c initialize -c--------------------------------------------------------------------- - do i = 0,isiz2+1 - do k = 0,isiz3+1 - phi1(i,k) = 0. - phi2(i,k) = 0. - end do - end do - jglob = jpt + jbeg - ind1 = 0 - if (jglob.eq.ji1) then - ind1 = 1 - do k = ki1, ki2 - do i = ibeg, ifin - iglob = ipt + i - phi1(i,k) = c2*( u(5,i,jbeg,k) - > - 0.50d+00 * ( u(2,i,jbeg,k) ** 2 - > + u(3,i,jbeg,k) ** 2 - > + u(4,i,jbeg,k) ** 2 ) - > / u(1,i,jbeg,k) ) - end do - end do - end if - - jglob = jpt + jfin - ind2 = 0 - if (jglob.eq.ji2) then - ind2 = 1 - do k = ki1, ki2 - do i = ibeg, ifin - iglob = ipt + i - phi2(i,k) = c2*( u(5,i,jfin,k) - > - 0.50d+00 * ( u(2,i,jfin,k) ** 2 - > + u(3,i,jfin,k) ** 2 - > + u(4,i,jfin,k) ** 2 ) - > / u(1,i,jfin,k) ) - end do - end do - end if - -c--------------------------------------------------------------------- -c communicate in i direction -c--------------------------------------------------------------------- - if (ind1.eq.1) then - call exchange_5(phi1,ibeg,ifin1) - end if - if (ind2.eq.1) then - call exchange_5 (phi2,ibeg,ifin1) - end if - - frc2 = 0.0d+00 - do k = ki1, ki2-1 - do i = ibeg, ifin1 - frc2 = frc2 + ( phi1(i,k) - > + phi1(i+1,k) - > + phi1(i,k+1) - > + phi1(i+1,k+1) - > + phi2(i,k) - > + phi2(i+1,k) - > + phi2(i,k+1) - > + phi2(i+1,k+1) ) - end do - end do - -c--------------------------------------------------------------------- -c compute the global sum of individual contributions to frc2 -c--------------------------------------------------------------------- - dummy = frc2 - call MPI_ALLREDUCE( dummy, - > frc2, - > 1, - > dp_type, - > MPI_SUM, - > MPI_COMM_WORLD, - > IERROR ) - - frc2 = dxi * dzeta * frc2 - -c--------------------------------------------------------------------- -c initialize -c--------------------------------------------------------------------- - do i = 0,isiz2+1 - do k = 0,isiz3+1 - phi1(i,k) = 0. - phi2(i,k) = 0. - end do - end do - iglob = ipt + ibeg - ind1 = 0 - if (iglob.eq.ii1) then - ind1 = 1 - do k = ki1, ki2 - do j = jbeg, jfin - jglob = jpt + j - phi1(j,k) = c2*( u(5,ibeg,j,k) - > - 0.50d+00 * ( u(2,ibeg,j,k) ** 2 - > + u(3,ibeg,j,k) ** 2 - > + u(4,ibeg,j,k) ** 2 ) - > / u(1,ibeg,j,k) ) - end do - end do - end if - - iglob = ipt + ifin - ind2 = 0 - if (iglob.eq.ii2) then - ind2 = 1 - do k = ki1, ki2 - do j = jbeg, jfin - jglob = jpt + j - phi2(j,k) = c2*( u(5,ifin,j,k) - > - 0.50d+00 * ( u(2,ifin,j,k) ** 2 - > + u(3,ifin,j,k) ** 2 - > + u(4,ifin,j,k) ** 2 ) - > / u(1,ifin,j,k) ) - end do - end do - end if - -c--------------------------------------------------------------------- -c communicate in j direction -c--------------------------------------------------------------------- - if (ind1.eq.1) then - call exchange_6(phi1,jbeg,jfin1) - end if - if (ind2.eq.1) then - call exchange_6(phi2,jbeg,jfin1) - end if - - frc3 = 0.0d+00 - - do k = ki1, ki2-1 - do j = jbeg, jfin1 - frc3 = frc3 + ( phi1(j,k) - > + phi1(j+1,k) - > + phi1(j,k+1) - > + phi1(j+1,k+1) - > + phi2(j,k) - > + phi2(j+1,k) - > + phi2(j,k+1) - > + phi2(j+1,k+1) ) - end do - end do - -c--------------------------------------------------------------------- -c compute the global sum of individual contributions to frc3 -c--------------------------------------------------------------------- - dummy = frc3 - call MPI_ALLREDUCE( dummy, - > frc3, - > 1, - > dp_type, - > MPI_SUM, - > MPI_COMM_WORLD, - > IERROR ) - - frc3 = deta * dzeta * frc3 - frc = 0.25d+00 * ( frc1 + frc2 + frc3 ) -c if (id.eq.0) write (*,1001) frc - - return - - 1001 format (//5x,'surface integral = ',1pe12.5//) - - end