From caf4416c9b9ff079dfece6ff91bedab66902f6a9 Mon Sep 17 00:00:00 2001 From: jeanbraun Date: Wed, 23 Oct 2019 20:05:11 +0200 Subject: [PATCH] Fixed a series of small bugs, including MPI bug, tmp directory, top for upper --- docs/Pecube.adoc | 4 ++-- src/Pecube324.f90 | 4 ++-- src/module_Pecube.f90 | 6 +++--- src/naMPI.f | 9 ++++++++- src/read_data_files.f90 | 31 +++++++++++++++++-------------- src/read_in_fault_parameters.f90 | 4 ++-- src/read_input_file.f90 | 4 ++-- 7 files changed, 36 insertions(+), 26 deletions(-) diff --git a/docs/Pecube.adoc b/docs/Pecube.adoc index 3dc1ec3..9acba40 100644 --- a/docs/Pecube.adoc +++ b/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):: diff --git a/src/Pecube324.f90 b/src/Pecube324.f90 index dc5a24f..911b1d3 100644 --- a/src/Pecube324.f90 +++ b/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 diff --git a/src/module_Pecube.f90 b/src/module_Pecube.f90 index 1e5e781..5436d1d 100644 --- a/src/module_Pecube.f90 +++ b/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" diff --git a/src/naMPI.f b/src/naMPI.f index 8cebe91..7584098 100644 --- a/src/naMPI.f +++ b/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 diff --git a/src/read_data_files.f90 b/src/read_data_files.f90 index 25ca3b7..a6a680b 100644 --- a/src/read_data_files.f90 +++ b/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 diff --git a/src/read_in_fault_parameters.f90 b/src/read_in_fault_parameters.f90 index 23f5943..4a741d0 100644 --- a/src/read_in_fault_parameters.f90 +++ b/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 diff --git a/src/read_input_file.f90 b/src/read_input_file.f90 index c708a58..0d56f1b 100644 --- a/src/read_input_file.f90 +++ b/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