Merge pull request #10 from jeanbraun/MPIProblem

Fixed a series of small bugs, including MPI bug, tmp directory, top

docs/Pecube.adoc

@@ -450,10 +450,10 @@ Uplift velocity (in km/Myr) imposed across the entire depth range at the bottom
 `bottom_right` _(default = `1`)_::
 Uplift velocity (in km/Myr) imposed across the entire depth range at the bottom right corner of the **Pecube** domain (maximum longitude and minimum latitude).
 
-`upper_right` _(default = `1`)_::
+`top_right` _(default = `1`)_::
 Uplift velocity (in km/Myr) imposed across the entire depth range at the upper right corner of the **Pecube** domain (maximum longitude and maximum latitude).
 
-`upper_left` _(default = `1`)_::
+`top_left` _(default = `1`)_::
 Uplift velocity (in km/Myr) imposed across the entire depth range at the upper left corner of the **Pecube** domain (minimum longitude and maximum latitude).
 
 `nstep**__i__**` (no default value)::

src/Pecube324.f90

@@ -257,9 +257,9 @@ program Pecube324
     read (55,'(a1024)') line
     write (77,'(a," = ",a)') 'bottom_right',trim(line)
     read (55,'(a1024)') line
-    write (77,'(a," = ",a)') 'upper_right',trim(line)
+    write (77,'(a," = ",a)') 'top_right',trim(line)
     read (55,'(a1024)') line
-    write (77,'(a," = ",a)') 'upper_left',trim(line)
+    write (77,'(a," = ",a)') 'top_left',trim(line)
 ! real fault geometry
     else
       do k=1,n

src/module_Pecube.f90

@@ -10,7 +10,7 @@ module Pecube
 
   type version
 
-  character*5 :: str = "4.2.0"
+  character*5 :: str = "4.2.1"
   integer :: major = 4
   integer :: minor = 2
   integer :: patch = 0
@@ -180,10 +180,10 @@ module Pecube
   character*128 :: bottom_right_desc = "Scaling value for uplift function applied at bottom right corner of grid"
 
   double precision :: upper_right = 1.d0
-  character*128 :: upper_right_desc = "Scaling value for uplift function applied at upper right corner of grid"
+  character*128 :: upper_right_desc = "Scaling value for uplift function applied at top right corner of grid"
 
   double precision :: upper_left = 1.d0
-  character*128 :: upper_left_desc = "Scaling value for uplift function applied at upper left corner of grid"
+  character*128 :: upper_left_desc = "Scaling value for uplift function applied at top left corner of grid"
 
   integer, dimension(:), allocatable :: npoint
   character*128 :: npoint_desc = "number of points used to describe each fault geometry"

src/naMPI.f

@@ -198,7 +198,7 @@ Subroutine NA (ndin,rangein,run)
 c             		                	Generate or read in
 c						starting models 
 c
- 	call NA_initial_sample
+ 	      call NA_initial_sample
      &       (na_models,nd,ranget,range,nsamplei,
      &        istype,monte,calcmovement,scales,misfit,run)
 c
@@ -223,6 +223,9 @@ Subroutine NA (ndin,rangein,run)
         tmis = 0.
         tnat = 0.
         ns = nsamplei
+         CALL MPI_BCAST
+     &          (na_models(ntot+1), nsamplei,
+     &           MPI_REAL, 0, MPI_COMM_WORLD, ierr)
 
 
 	do 20 it = 1,itmax+1
@@ -364,6 +367,10 @@ Subroutine NA (ndin,rangein,run)
 
 	   end if
 
+            CALL MPI_BCAST
+     &          (na_models(ntot+1), nsample,
+     &           MPI_REAL, 0, MPI_COMM_WORLD, ierr)
+
 c
  20	continue
 c

src/read_data_files.f90

@@ -101,6 +101,8 @@ subroutine read_data_folder ( folder, echo, xlon1, xlon2, xlat1, xlat2, iproc, n
 if (iproc.lt.100) cproc(1:2)='00'
 if (iproc.lt.1000) cproc(1:1)='0'
 
+call system ('mkdir -p tmp')
+
 call system ('ls '//folder//' > tmp/data_lst'//cproc//'.txt')
 
   if (nd.eq.0) then
@@ -148,7 +150,8 @@ subroutine read_data_folder ( folder, echo, xlon1, xlon2, xlat1, xlat2, iproc, n
 ! third check that data is complete
 
 if (iproc.eq.0) open (123, file = folder//'_Messages.txt', status = 'unknown')
-if (iproc.eq.0) call check_obs (nsample, sample, obs, field_name, nfield, xlon1, xlon2, xlat1, xlat2)
+call check_obs (nsample, sample, obs, field_name, nfield, xlon1, xlon2, xlat1, xlat2, iproc)
+if (iproc.eq.0) close (123)
 
 ! HERE WE WRITE DATA TO PECUBE INPUT FILE
 
@@ -249,7 +252,7 @@ end subroutine add_to_obs
 ! Here we run a few tests on the data to make sure that they can be localized, that each data has its uncertainty and that
 ! uncertainty has its data
 
-subroutine check_obs (nsample, sample, obs, field_name, nfield, xlon1, xlon2, xlat1, xlat2)
+subroutine check_obs (nsample, sample, obs, field_name, nfield, xlon1, xlon2, xlat1, xlat2, iproc)
 
 integer :: nsample, nfield
 double precision, dimension(nfield,nsample) :: obs
@@ -264,11 +267,11 @@ subroutine check_obs (nsample, sample, obs, field_name, nfield, xlon1, xlon2, xl
   do jsample = 1, nsample
     if ((obs(1,jsample)-xlon1)*(obs(1,jsample)-xlon2).gt.0.d0 .or. &
         (obs(2,jsample)-xlat1)*(obs(2,jsample)-xlat2).gt.0.d0) then
-    write (123,'(a)') 'Warning: sample '//trim(sample(jsample))//' Outside lat-lon box for this Pecube run'
-    write (123,'(a)') 'Lat-Lon:'
-    write (123,*) obs(2,jsample), obs(1,jsample)
-    write (123,'(a)') 'Bounds:'
-    write (123,*) xlat1, xlat2, xlon1, xlon2
+    if (iproc.eq.0) write (123,'(a)') 'Warning: sample '//trim(sample(jsample))//' Outside lat-lon box for this Pecube run'
+    if (iproc.eq.0) write (123,'(a)') 'Lat-Lon:'
+    if (iproc.eq.0) write (123,*) obs(2,jsample), obs(1,jsample)
+    if (iproc.eq.0) write (123,'(a)') 'Bounds:'
+    if (iproc.eq.0) write (123,*) xlat1, xlat2, xlon1, xlon2
       do isample = jsample, nsample - 1
       obs(:,isample) = obs(:,isample + 1)
       sample(isample) = sample(isample + 1)
@@ -281,22 +284,22 @@ subroutine check_obs (nsample, sample, obs, field_name, nfield, xlon1, xlon2, xl
 ! sends warning and error messages
 
   do jsample = 1, nsample
-  if (obs(1,jsample).lt.-9998.) write (123,'(a)') 'Error: NO LONGITUDE, cannot use sample '&
+  if (obs(1,jsample).lt.-9998..and.iproc.eq.0) write (123,'(a)') 'Error: NO LONGITUDE, cannot use sample '&
                                 //trim(sample(jsample))//' that is not located'
-  if (obs(2,jsample).lt.-9998.) write (123,'(a)') 'Error: NO LATITUDE, cannot use sample '&
+  if (obs(2,jsample).lt.-9998..and.iproc.eq.0) write (123,'(a)') 'Error: NO LATITUDE, cannot use sample '&
                                 //trim(sample(jsample))//' that is not located'
-  if (obs(3,jsample).lt.-9998.) write (123,'(a)') 'Warning: No Height provided, set to zero for sample '&
+  if (obs(3,jsample).lt.-9998..and.iproc.eq.0) write (123,'(a)') 'Warning: No Height provided, set to zero for sample '&
                                 //trim(sample(jsample))
     do i = 4, 19, 2
-    if (obs(i,jsample).gt.-9998. .and. obs(i+1,jsample).lt.-9998.) write (123,'(a)') 'Warning: Adding uncertainty for ' &
+    if (obs(i,jsample).gt.-9998. .and. obs(i+1,jsample).lt.-9998..and.iproc.eq.0) write (123,'(a)') &
+    'Warning: Adding uncertainty for ' &
     //field_name(i)//' in sample '//trim(sample(jsample))
-    if (obs(i,jsample).lt.-9998. .and. obs(i+1,jsample).gt.-9998.) write (123,'(a)') 'Error: Uncertainty is specified' &
+    if (obs(i,jsample).lt.-9998. .and. obs(i+1,jsample).gt.-9998..and.iproc.eq.0) write (123,'(a)') &
+    'Error: Uncertainty is specified' &
     //'but not data for '//field_name(i)//' in sample '//trim(sample(jsample))
     enddo
   enddo
 
-close (123)
-
 ! normalizes track distributions
   do jsample = 1, nsample
   if (maxval(obs(20:39,jsample)).gt.0.d0) then

src/read_in_fault_parameters.f90

@@ -50,8 +50,8 @@ subroutine read_in_fault_parameters (fault,nfault,xlon1,xlat1,xlon2,xlat2,xl,yl,
   allocate (fault(i)%x(4),fault(i)%y(4))
   fault(i)%x(1) = p%bottom_left
   fault(i)%x(2) = p%bottom_right
-  fault(i)%x(3) = p%upper_right
-  fault(i)%x(4) = p%upper_left
+  fault(i)%x(4) = p%upper_right
+  fault(i)%x(3) = p%upper_left
   else
   allocate (fault(i)%x(fault(i)%n),fault(i)%y(fault(i)%n))
     do k=1,fault(i)%n

src/read_input_file.f90

@@ -165,9 +165,9 @@ subroutine read_input_file (fnme, vocal, p, nd, range, par)
 
 call scanfile (fnme, "bottom_right", p%bottom_right, p%bottom_right_desc, res, vocal, nd, range, par)
 
-call scanfile (fnme, "upper_right", p%upper_right, p%upper_right_desc, res, vocal, nd, range, par)
+call scanfile (fnme, "top_right", p%upper_right, p%upper_right_desc, res, vocal, nd, range, par)
 
-call scanfile (fnme, "upper_left", p%upper_left, p%upper_left_desc, res, vocal, nd, range, par)
+call scanfile (fnme, "top_left", p%upper_left, p%upper_left_desc, res, vocal, nd, range, par)
 
 npoint_max = maxval(p%npoint)
 if (npoint_max.lt.0) npoint_max = 4