diff --git a/src/user/user_dump_param.f90 b/src/user/user_dump_param.f90 index 76b10aa10..852f07bc0 100644 --- a/src/user/user_dump_param.f90 +++ b/src/user/user_dump_param.f90 @@ -1,16 +1,20 @@ submodule(user) s_user_dump_param contains - module procedure user_dump_param + module subroutine user_dump_param(param,t) !! author: David A. Minton !! !! Dump integration parameters to file !! !! Adapted from David E. Kaufmann's Swifter routine io_dump_param.f90 !! Adapted from Martin Duncan's Swift routine io_dump_param.f - use swiftest - use module_interfaces + use swiftest, except_this_one => user_dump_param implicit none + ! Arguments + class(user_input_parameters),intent(in) :: param !! Output collection of user-defined parameters + real(DP),intent(in) :: t !! Current simulation tim + + ! Internals type(user_input_parameters) :: param_dump !! Data type of dumped parameter file integer(I4B), parameter :: LUN = 7 !! Unit number of output file integer(I4B) :: ierr !! Error code @@ -44,5 +48,5 @@ return - end procedure user_dump_param + end subroutine user_dump_param end submodule s_user_dump_param diff --git a/src/user/user_get_token.f90 b/src/user/user_get_token.f90 index 2130e1dd7..ec8ac3992 100644 --- a/src/user/user_get_token.f90 +++ b/src/user/user_get_token.f90 @@ -1,16 +1,23 @@ submodule(user) s_user_get_token contains - module procedure user_get_token + module function user_get_token(buffer, ifirst, ilast, ierr) result(token) !! author: David A. Minton !! !! Retrieves a character token from an input string. Here a token is defined as any set of contiguous non-blank characters not !! beginning with or containing "!". If "!" is present, any remaining part of the buffer including the "!" is ignored !! !! Adapted from David E. Kaufmann's Swifter routine user_get_token.f90 - use swiftest - use module_interfaces + use swiftest, except_this_one => user_get_token implicit none + ! Arguments + character(len=*), intent(in) :: buffer !! Input string buffer + integer(I4B), intent(inout) :: ifirst !! Index of the buffer at which to start the search for a token + integer(I4B), intent(out) :: ilast !! Index of the buffer at the end of the returned token + integer(I4B), intent(out) :: ierr !! Error code + character(len=:),allocatable :: token !! Returned token stringn + + ! Internals integer(I4B) :: i,ilength ilength = len(buffer) @@ -42,5 +49,5 @@ return - end procedure user_get_token + end function user_get_token end submodule s_user_get_token diff --git a/src/user/user_read_param_in.f90 b/src/user/user_read_param_in.f90 index 915feb47b..35d883b72 100644 --- a/src/user/user_read_param_in.f90 +++ b/src/user/user_read_param_in.f90 @@ -1,6 +1,6 @@ submodule (user) s_user_read_param_in contains - module procedure user_read_param_in + module subroutine user_read_param_in(param,inparfile) !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott !! !! Read in parameters for the integration @@ -8,11 +8,14 @@ !! Adapted from David E. Kaufmann's Swifter routine io_init_param.f90 !! Adapted from Martin Duncan's Swift routine io_init_param.f !$ use omp_lib - !use util, only: util_exit ! IMPLEMENTATION TBD - use swiftest - use module_interfaces + use swiftest, except_this_one => user_read_param_in implicit none + ! Arguments + class(user_input_parameters),intent(out) :: param !! Input collection of user-defined parameters + character(*), intent(in) :: inparfile !! Parameter input file name (i.e. param.in) + + ! Internals integer(I4B), parameter :: LUN = 7 !! Unit number of input file integer(I4B) :: ierr = 0 !! Input error code character(STRMAX) :: error_message !! Error message in UDIO procedure @@ -113,6 +116,6 @@ return - end procedure user_read_param_in + end subroutine user_read_param_in end submodule s_user_read_param_in diff --git a/src/user/user_udio_reader.f90 b/src/user/user_udio_reader.f90 index 54d35fa58..5db017422 100644 --- a/src/user/user_udio_reader.f90 +++ b/src/user/user_udio_reader.f90 @@ -1,230 +1,247 @@ submodule (user) s_user_udio_reader contains - module procedure user_udio_reader - !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott - !! - !! Read in parameters for the integration - !! Currently this procedure does not work in user-defined derived-type input mode - !! e.g. read(unit,'(DT)') param - !! as the newline characters are ignored in the input file when compiled in ifort. - !! - !! Adapted from David E. Kaufmann's Swifter routine io_init_param.f90 - !! Adapted from Martin Duncan's Swift routine io_init_param.f - !$ use omp_lib - !use util, only: util_exit ! IMPLEMENTATION TBD - use swiftest - use module_interfaces - implicit none + module subroutine user_udio_reader(param, unit, iotype, v_list, iostat, iomsg) + !! author: The Purdue Swiftest Team - David A. Minton, Carlisle A. Wishard, Jennifer L.L. Pouplin, and Jacob R. Elliott + !! + !! Read in parameters for the integration + !! Currently this procedure does not work in user-defined derived-type input mode + !! e.g. read(unit,'(DT)') param + !! as the newline characters are ignored in the input file when compiled in ifort. + !! + !! Adapted from David E. Kaufmann's Swifter routine io_init_param.f90 + !! Adapted from Martin Duncan's Swift routine io_init_param.f + !$ use omp_lib + !use util, only: util_exit ! IMPLEMENTATION TBD + use swiftest, except_this_one => user_udio_reader + implicit none - logical :: t0_set = .false. !! Is the initial time set in the input file? - logical :: tstop_set = .false. !! Is the final time set in the input file? - logical :: dt_set = .false. !! Is the step size set in the input file? - integer(I4B) :: ilength, ifirst, ilast !! Variables used to parse input file - character(STRMAX) :: line !! Line of the input file - character (len=:), allocatable :: line_trim,param_name, param_value - character(*),parameter :: linefmt = '(A)' + ! Arguments + class(user_input_parameters),intent(inout) :: param !! Input collection of user-defined parameters + integer, intent(in) :: unit + character(len=*), intent(in) :: iotype + integer, intent(in) :: v_list(:) + integer, intent(out) :: iostat + character(len=*), intent(inout) :: iomsg - ! Parse the file line by line, extracting tokens then matching them up with known parameters if possible - do - read(unit = unit, fmt = linefmt, iostat = iostat, end = 1) line - line_trim = trim(adjustl(line)) - ilength = len(line_trim) - if ((ilength /= 0)) then - ifirst = 1 - ! Read the pair of tokens. The first one is the parameter name, the second is the value. - param_name = user_get_token(line_trim, ifirst, ilast, iostat) - if (param_name == '') cycle ! No parameter name (usually because this line is commented out) - call util_toupper(param_name) - ifirst = ilast + 1 - param_value = user_get_token(line_trim, ifirst, ilast, iostat) - select case (param_name) - case ("T0") - read(param_value, *) param%t0 - t0_set = .true. - case ("TSTOP") - read(param_value, *) param%tstop - tstop_set = .true. - case ("DT") - read(param_value, *) param%dt - dt_set = .true. - case ("PL_IN") - param%inplfile = param_value - case ("TP_IN") - param%intpfile = param_value - case ("IN_TYPE") - call util_toupper(param_value) - param%in_type = param_value - case ("ISTEP_OUT") - read(param_value, *) param%istep_out - case ("BIN_OUT") - param%outfile = param_value - case ("PARTICLE_FILE") - param%particle_file = param_value - case ("OUT_TYPE") - call util_toupper(param_value) - param%out_type = param_value - case ("OUT_FORM") - call util_toupper(param_value) - param%out_form = param_value - case ("OUT_STAT") - call util_toupper(param_value) - param%out_stat = param_value - case ("ISTEP_DUMP") - read(param_value, *) param%istep_dump - case ("J2") - read(param_value, *) param%j2rp2 - case ("J4") - read(param_value, *) param%j4rp4 - case ("CHK_CLOSE") - call util_toupper(param_value) - if (param_value == "YES" .or. param_value == 'T') param%lclose = .true. - case ("CHK_RMIN") - read(param_value, *) param%rmin - case ("CHK_RMAX") - read(param_value, *) param%rmax - case ("CHK_EJECT") - read(param_value, *) param%rmaxu - case ("CHK_QMIN") - read(param_value, *) param%qmin - case ("CHK_QMIN_COORD") - call util_toupper(param_value) - param%qmin_coord = param_value - case ("CHK_QMIN_RANGE") - read(param_value, *) param%qmin_alo + ! Internals + logical :: t0_set = .false. !! Is the initial time set in the input file? + logical :: tstop_set = .false. !! Is the final time set in the input file? + logical :: dt_set = .false. !! Is the step size set in the input file? + integer(I4B) :: ilength, ifirst, ilast !! Variables used to parse input file + character(STRMAX) :: line !! Line of the input file + character (len=:), allocatable :: line_trim,param_name, param_value + character(*),parameter :: linefmt = '(A)' + integer(I4B) :: nseeds + + call random_seed(size = nseeds) + if (allocated(param%seed)) deallocate(param%seed) + allocate(param%seed(nseeds)) + !seed(:) = [(i * 1, i = 1, nseeds)] + !call random_seed(put = seed) + + ! Parse the file line by line, extracting tokens then matching them up with known parameters if possible + do + read(unit = unit, fmt = linefmt, iostat = iostat, end = 1) line + line_trim = trim(adjustl(line)) + ilength = len(line_trim) + if ((ilength /= 0)) then + ifirst = 1 + ! Read the pair of tokens. The first one is the parameter name, the second is the value. + param_name = user_get_token(line_trim, ifirst, ilast, iostat) + if (param_name == '') cycle ! No parameter name (usually because this line is commented out) + call util_toupper(param_name) ifirst = ilast + 1 - param_value = user_get_token(line, ifirst, ilast, iostat) - read(param_value, *) param%qmin_ahi - case ("ENC_OUT") - param%encounter_file = param_value - case ("EXTRA_FORCE") - call util_toupper(param_value) - if (param_value == "YES" .or. param_value == 'T') param%lextra_force = .true. - case ("BIG_DISCARD") - call util_toupper(param_value) - if (param_value == "YES" .or. param_value == 'T' ) param%lbig_discard = .true. - case ("RHILL_PRESENT") - call util_toupper(param_value) - if (param_value == "YES" .or. param_value == "T") param%lrhill_present = .true. - ! Added by the Purdue Swiftest development group (Minton, Wishard, Populin, and Elliott) - case ("FRAGMENTATION") - call util_toupper(param_value) - if (param_value == "YES" .or. param_value == "T") param%lfragmentation = .true. - case ("MU2KG") - read(param_value, *) param%MU2KG - case ("TU2S") - read(param_value, *) param%TU2S - case ("DU2M") - read(param_value, *) param%DU2M - case ("MTINY") - read(param_value, *) param%mtiny - case ("ENERGY") - call util_toupper(param_value) - if (param_value == "YES" .or. param_value == 'T') param%lenergy = .true. - case ("ROTATION") - call util_toupper(param_value) - if (param_value == "YES" .or. param_value == 'T') param%lrotation = .true. + param_value = user_get_token(line_trim, ifirst, ilast, iostat) + select case (param_name) + case ("T0") + read(param_value, *) param%t0 + t0_set = .true. + case ("TSTOP") + read(param_value, *) param%tstop + tstop_set = .true. + case ("DT") + read(param_value, *) param%dt + dt_set = .true. + case ("PL_IN") + param%inplfile = param_value + case ("TP_IN") + param%intpfile = param_value + case ("IN_TYPE") + call util_toupper(param_value) + param%in_type = param_value + case ("ISTEP_OUT") + read(param_value, *) param%istep_out + case ("BIN_OUT") + param%outfile = param_value + case ("PARTICLE_FILE") + param%particle_file = param_value + case ("OUT_TYPE") + call util_toupper(param_value) + param%out_type = param_value + case ("OUT_FORM") + call util_toupper(param_value) + param%out_form = param_value + case ("OUT_STAT") + call util_toupper(param_value) + param%out_stat = param_value + case ("ISTEP_DUMP") + read(param_value, *) param%istep_dump + case ("J2") + read(param_value, *) param%j2rp2 + case ("J4") + read(param_value, *) param%j4rp4 + case ("CHK_CLOSE") + call util_toupper(param_value) + if (param_value == "YES" .or. param_value == 'T') param%lclose = .true. + case ("CHK_RMIN") + read(param_value, *) param%rmin + case ("CHK_RMAX") + read(param_value, *) param%rmax + case ("CHK_EJECT") + read(param_value, *) param%rmaxu + case ("CHK_QMIN") + read(param_value, *) param%qmin + case ("CHK_QMIN_COORD") + call util_toupper(param_value) + param%qmin_coord = param_value + case ("CHK_QMIN_RANGE") + read(param_value, *) param%qmin_alo + ifirst = ilast + 1 + param_value = user_get_token(line, ifirst, ilast, iostat) + read(param_value, *) param%qmin_ahi + case ("ENC_OUT") + param%encounter_file = param_value + case ("EXTRA_FORCE") + call util_toupper(param_value) + if (param_value == "YES" .or. param_value == 'T') param%lextra_force = .true. + case ("BIG_DISCARD") + call util_toupper(param_value) + if (param_value == "YES" .or. param_value == 'T' ) param%lbig_discard = .true. + case ("RHILL_PRESENT") + call util_toupper(param_value) + if (param_value == "YES" .or. param_value == "T") param%lrhill_present = .true. + ! Added by the Purdue Swiftest development group (Minton, Wishard, Populin, and Elliott) + case ("FRAGMENTATION") + call util_toupper(param_value) + if (param_value == "YES" .or. param_value == "T") param%lfragmentation = .true. + case ("MU2KG") + read(param_value, *) param%MU2KG + case ("TU2S") + read(param_value, *) param%TU2S + case ("DU2M") + read(param_value, *) param%DU2M + case ("MTINY") + read(param_value, *) param%mtiny + case ("ENERGY") + call util_toupper(param_value) + if (param_value == "YES" .or. param_value == 'T') param%lenergy = .true. + case ("ROTATION") + call util_toupper(param_value) + if (param_value == "YES" .or. param_value == 'T') param%lrotation = .true. - ! The following are not yet implemented - case ("RINGMOONS") - call util_toupper(param_value) - if (param_value == "YES" .or. param_value == 'T') param%lringmoons = .true. - case ("RING_OUTFILE") - param%ring_outfile = param_value - - case ("TIDES") - call util_toupper(param_value) - if (param_value == "YES" .or. param_value == 'T') param%ltides = .true. - case ("GR") - call util_toupper(param_value) - if (param_value == "YES" .or. param_value == 'T') param%lgr = .true. - case ("YARKOVSKY") - call util_toupper(param_value) - if (param_value == "YES" .or. param_value == 'T') param%lyarkovsky = .true. - case ("YORP") - call util_toupper(param_value) - if (param_value == "YES" .or. param_value == 'T') param%lyorp = .true. - case default - write(iomsg,*) "Unknown parameter -> ",param_name - iostat = -1 - return - end select + ! The following are not yet implemented + case ("RINGMOONS") + call util_toupper(param_value) + if (param_value == "YES" .or. param_value == 'T') param%lringmoons = .true. + case ("RING_OUTFILE") + param%ring_outfile = param_value + + case ("TIDES") + call util_toupper(param_value) + if (param_value == "YES" .or. param_value == 'T') param%ltides = .true. + case ("GR") + call util_toupper(param_value) + if (param_value == "YES" .or. param_value == 'T') param%lgr = .true. + case ("YARKOVSKY") + call util_toupper(param_value) + if (param_value == "YES" .or. param_value == 'T') param%lyarkovsky = .true. + case ("YORP") + call util_toupper(param_value) + if (param_value == "YES" .or. param_value == 'T') param%lyorp = .true. + case("SEED") + read(param_value, *) param%qmin + case default + write(iomsg,*) "Unknown parameter -> ",param_name + iostat = -1 + return + end select + end if + end do + 1 continue + iostat = 0 + if ((.not. t0_set) .or. (.not. tstop_set) .or. (.not. dt_set)) then + write(iomsg,*) 'Valid simulation time not set' + iostat = -1 + return end if - end do - 1 continue - iostat = 0 - if ((.not. t0_set) .or. (.not. tstop_set) .or. (.not. dt_set)) then - write(iomsg,*) 'Valid simulation time not set' - iostat = -1 - return - end if - if (param%dt <= 0.0_DP) then - write(iomsg,*) 'Invalid timestep: ' - iostat = -1 - return - end if - if (param%inplfile == "") then - write(iomsg,*) 'No valid planet file in input file' - iostat = -1 - return - end if - if ((param%in_type /= REAL8_TYPE) .and. (param%in_type /= "ASCII")) then - write(iomsg,*) 'Invalid input file type:',trim(adjustl(param%in_type)) - iostat = -1 - return - end if - if ((param%istep_out <= 0) .and. (param%istep_dump <= 0)) then - write(iomsg,*) 'Invalid istep' - iostat = -1 - return - end if - if ((param%istep_out > 0) .and. (param%outfile == "")) then - write(iomsg,*) 'Invalid outfile' - iostat = -1 - return - end if - if ((param%istep_out > 0) .and. (param%particle_file == "")) then - write(iomsg,*) 'Invalid particle file' - iostat = -1 - return - end if - if (param%outfile /= "") then - if ((param%out_type /= REAL4_TYPE) .and. (param%out_type /= REAL8_TYPE) .and. & - (param%out_type /= SWIFTER_REAL4_TYPE) .and. (param%out_type /= SWIFTER_REAL8_TYPE)) then - write(iomsg,*) 'Invalid out_type: ',trim(adjustl(param%out_type)) + if (param%dt <= 0.0_DP) then + write(iomsg,*) 'Invalid timestep: ' iostat = -1 return end if - if ((param%out_form /= "EL") .and. (param%out_form /= "XV")) then - write(iomsg,*) 'Invalid out_form: ',trim(adjustl(param%out_form)) + if (param%inplfile == "") then + write(iomsg,*) 'No valid planet file in input file' iostat = -1 return end if - if ((param%out_stat /= "NEW") .and. (param%out_stat /= "REPLACE") .and. (param%out_stat /= "APPEND")) then - write(iomsg,*) 'Invalid out_stat: ',trim(adjustl(param%out_stat)) + if ((param%in_type /= REAL8_TYPE) .and. (param%in_type /= "ASCII")) then + write(iomsg,*) 'Invalid input file type:',trim(adjustl(param%in_type)) iostat = -1 return end if - end if - if ((param%j2rp2 == 0.0_DP) .and. (param%j4rp4 /= 0.0_DP)) then - write(iomsg,*) 'Cannot have j4 without j2' - return - iostat = -1 - end if - if (param%qmin > 0.0_DP) then - if ((param%qmin_coord /= "HELIO") .and. (param%qmin_coord /= "BARY")) then - write(iomsg,*) 'Invalid qmin_coord: ',trim(adjustl(param%qmin_coord)) + if ((param%istep_out <= 0) .and. (param%istep_dump <= 0)) then + write(iomsg,*) 'Invalid istep' + iostat = -1 + return + end if + if ((param%istep_out > 0) .and. (param%outfile == "")) then + write(iomsg,*) 'Invalid outfile' + iostat = -1 return + end if + if ((param%istep_out > 0) .and. (param%particle_file == "")) then + write(iomsg,*) 'Invalid particle file' iostat = -1 + return end if - if ((param%qmin_alo <= 0.0_DP) .or. (param%qmin_ahi <= 0.0_DP)) then - write(iomsg,*) 'Invalid qmin vals' + if (param%outfile /= "") then + if ((param%out_type /= REAL4_TYPE) .and. (param%out_type /= REAL8_TYPE) .and. & + (param%out_type /= SWIFTER_REAL4_TYPE) .and. (param%out_type /= SWIFTER_REAL8_TYPE)) then + write(iomsg,*) 'Invalid out_type: ',trim(adjustl(param%out_type)) + iostat = -1 + return + end if + if ((param%out_form /= "EL") .and. (param%out_form /= "XV")) then + write(iomsg,*) 'Invalid out_form: ',trim(adjustl(param%out_form)) + iostat = -1 + return + end if + if ((param%out_stat /= "NEW") .and. (param%out_stat /= "REPLACE") .and. (param%out_stat /= "APPEND")) then + write(iomsg,*) 'Invalid out_stat: ',trim(adjustl(param%out_stat)) + iostat = -1 + return + end if + end if + if ((param%j2rp2 == 0.0_DP) .and. (param%j4rp4 /= 0.0_DP)) then + write(iomsg,*) 'Cannot have j4 without j2' return iostat = -1 end if - end if + if (param%qmin > 0.0_DP) then + if ((param%qmin_coord /= "HELIO") .and. (param%qmin_coord /= "BARY")) then + write(iomsg,*) 'Invalid qmin_coord: ',trim(adjustl(param%qmin_coord)) + return + iostat = -1 + end if + if ((param%qmin_alo <= 0.0_DP) .or. (param%qmin_ahi <= 0.0_DP)) then + write(iomsg,*) 'Invalid qmin vals' + return + iostat = -1 + end if + end if - return + return - end procedure user_udio_reader + end subroutine user_udio_reader end submodule s_user_udio_reader diff --git a/src/user/user_udio_writer.f90 b/src/user/user_udio_writer.f90 index 064b589e1..f0c54b2c5 100644 --- a/src/user/user_udio_writer.f90 +++ b/src/user/user_udio_writer.f90 @@ -1,17 +1,24 @@ submodule(user) s_user_udio_writer contains - module procedure user_udio_writer + module subroutine user_udio_writer(param, unit, iotype, v_list, iostat, iomsg) !! author: David A. Minton !! !! Dump integration parameters to file !! !! Adapted from David E. Kaufmann's Swifter routine io_dump_param.f90 !! Adapted from Martin Duncan's Swift routine io_dump_param.f - use swiftest - use module_interfaces + use swiftest, except_this_one => user_udio_writer implicit none - !! In user-defined derived-type output, we need newline characters at the end of each format statement + ! Arguments + class(user_input_parameters),intent(in) :: param !! Output collection of user-defined parameters + integer, intent(in) :: unit + character(len=*), intent(in) :: iotype + integer, intent(in) :: v_list(:) + integer, intent(out) :: iostat + character(len=*), intent(inout) :: iomsg + + ! Internals !character(*),parameter :: Ifmt = '(A20,1X,I0/)' !! Format label for integer values !character(*),parameter :: Rfmt = '(A20,1X,ES25.17/)' !! Format label for real values !character(*),parameter :: R2fmt = '(A20,2(1X,ES25.17)/)' !! Format label for 2x real values @@ -96,5 +103,5 @@ return - end procedure user_udio_writer + end subroutine user_udio_writer end submodule s_user_udio_writer