[cig-commits] r8576 - seismo/2D/SPECFEM2D/trunk

[walter at geodynamics.org]

Author: walter
Date: 2007-12-07 15:57:51 -0800 (Fri, 07 Dec 2007)
New Revision: 8576

Modified:
   seismo/2D/SPECFEM2D/trunk/create_color_image.f90
   seismo/2D/SPECFEM2D/trunk/specfem2D.F90
Log:
fixed display of velocity model in color image in parallel.

Modified: seismo/2D/SPECFEM2D/trunk/create_color_image.f90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/create_color_image.f90	2007-09-11 13:14:45 UTC (rev 8575)
+++ seismo/2D/SPECFEM2D/trunk/create_color_image.f90	2007-12-07 23:57:51 UTC (rev 8576)
@@ -11,7 +11,7 @@
 !
 !========================================================================
 
-  subroutine create_color_image(color_image_2D_data,iglob_image_color_2D,NX,NY,it,cutsnaps,vp_display,npoin)
+  subroutine create_color_image(color_image_2D_data,iglob_image_color_2D,NX,NY,it,cutsnaps,image_color_vp_display)
 
 ! display a given field as a red and blue color image
 
@@ -23,14 +23,14 @@
 
   include "constants.h"
 
-  integer :: NX,NY,it,npoin
+  integer :: NX,NY,it
 
   double precision :: cutsnaps
 
   integer, dimension(NX,NY) :: iglob_image_color_2D
 
   double precision, dimension(NX,NY) :: color_image_2D_data
-  double precision, dimension(npoin) :: vp_display
+  double precision, dimension(NX,NY) :: image_color_vp_display
 
   integer :: ix,iy,R,G,B,tenthousands,thousands,hundreds,tens,units,remainder,current_rec
 
@@ -122,8 +122,8 @@
 
 ! compute maximum amplitude
   amplitude_max = maxval(abs(color_image_2D_data))
-  vpmin = minval(vp_display)
-  vpmax = maxval(vp_display)
+  vpmin = minval(image_color_vp_display)
+  vpmax = maxval(image_color_vp_display)
 
 ! in the PNM format, the image starts in the upper-left corner
   do iy=NY,1,-1
@@ -142,7 +142,7 @@
 
 ! use P velocity model as background where amplitude is negligible
         if((vpmax-vpmin)/vpmin > 0.02d0) then
-          x1 = (vp_display(iglob_image_color_2D(ix,iy))-vpmin)/(vpmax-vpmin)
+          x1 = (image_color_vp_display(ix,iy)-vpmin)/(vpmax-vpmin)
         else
           x1 = 0.5d0
         endif

Modified: seismo/2D/SPECFEM2D/trunk/specfem2D.F90
===================================================================
--- seismo/2D/SPECFEM2D/trunk/specfem2D.F90	2007-09-11 13:14:45 UTC (rev 8575)
+++ seismo/2D/SPECFEM2D/trunk/specfem2D.F90	2007-12-07 23:57:51 UTC (rev 8576)
@@ -219,6 +219,7 @@
     zmin_color_image,zmax_color_image,size_pixel_horizontal,size_pixel_vertical
   integer, dimension(:,:), allocatable :: iglob_image_color,copy_iglob_image_color
   double precision, dimension(:,:), allocatable :: image_color_data
+  double precision, dimension(:,:), allocatable :: image_color_vp_display
 
   double precision  :: xmin_color_image_loc, xmax_color_image_loc, zmin_color_image_loc, &
        zmax_color_image_loc
@@ -1079,8 +1080,12 @@
   call assemble_MPI_scalar(myrank,rmass_inverse_acoustic, rmass_inverse_elastic,npoin, &
      ninterface, max_interface_size, max_ibool_interfaces_size_ac, max_ibool_interfaces_size_el, &
      ibool_interfaces_acoustic,ibool_interfaces_elastic, nibool_interfaces_acoustic,nibool_interfaces_elastic, my_neighbours)
-end if
 
+  else 
+    ninterface_acoustic = 0
+    ninterface_elastic = 0
+  end if
+
 #endif
 
 
@@ -1155,6 +1160,7 @@
 
 ! allocate an array for image data
   allocate(image_color_data(NX_IMAGE_color,NZ_IMAGE_color))
+  allocate(image_color_vp_display(NX_IMAGE_color,NZ_IMAGE_color))
 
 ! allocate an array for the grid point that corresponds to a given image data point
   allocate(iglob_image_color(NX_IMAGE_color,NZ_IMAGE_color))
@@ -2142,11 +2148,13 @@
   endif
 
   image_color_data(:,:) = 0.d0
-
+  image_color_vp_display(:,:) = 0.d0
+      
   do k = 1, nb_pixel_loc
      j = ceiling(real(num_pixel_loc(k)) / real(NX_IMAGE_color))
      i = num_pixel_loc(k) - (j-1)*NX_IMAGE_color
      image_color_data(i,j) = vector_field_display(2,iglob_image_color(i,j))
+     image_color_vp_display(i,j) = vp_display(iglob_image_color(i,j))
 
   end do
 
@@ -2182,10 +2190,41 @@
   end if
 
 #endif
+! assembling array image_color_vp_display on process zero for color output
+#ifdef USE_MPI
+  if ( nproc > 1 ) then
+     if ( myrank == 0 ) then
 
+        do iproc = 1, nproc-1
 
+           call MPI_RECV(data_pixel_recv(1),nb_pixel_per_proc(iproc+1), MPI_DOUBLE_PRECISION, &
+                iproc, 43, MPI_COMM_WORLD, request_mpi_status, ier)
+
+           do k = 1, nb_pixel_per_proc(iproc+1)
+              j = ceiling(real(num_pixel_recv(k,iproc+1)) / real(NX_IMAGE_color))
+              i = num_pixel_recv(k,iproc+1) - (j-1)*NX_IMAGE_color
+              image_color_vp_display(i,j) = data_pixel_recv(k)
+
+           end do
+        end do
+
+     else
+        do k = 1, nb_pixel_loc
+           j = ceiling(real(num_pixel_loc(k)) / real(NX_IMAGE_color))
+           i = num_pixel_loc(k) - (j-1)*NX_IMAGE_color
+           data_pixel_send(k) = vp_display(iglob_image_color(i,j))
+
+        end do
+
+        call MPI_SEND(data_pixel_send(1),nb_pixel_loc,MPI_DOUBLE_PRECISION, 0, 43, MPI_COMM_WORLD, ier)
+
+     end if
+  end if
+
+#endif
+
   if ( myrank == 0 ) then
-     call create_color_image(image_color_data,iglob_image_color,NX_IMAGE_color,NZ_IMAGE_color,it,cutsnaps,vp_display,npoin)
+     call create_color_image(image_color_data,iglob_image_color,NX_IMAGE_color,NZ_IMAGE_color,it,cutsnaps,image_color_vp_display)
      write(IOUT,*) 'Color image created'
   endif