!*********************************************************************** subroutine rproc_bounds(file) ! ! Import processor boundaries from file. ! ! 10-jul-08/kapelrud: coded ! 16-Feb-2012/Bourdin.KIS: rewritten ! use Mpicomm, only: mpibcast character (len=*) :: file integer :: ierr ! real(KIND=rkind4), dimension(0:nprocx):: procx_boundssg real(KIND=rkind4), dimension(0:nprocy):: procy_boundssg real(KIND=rkind4), dimension(0:nprocz):: procz_boundssg ! real(KIND=rkind8), dimension(0:nprocx):: procx_boundsdb real(KIND=rkind8), dimension(0:nprocy):: procy_boundsdb real(KIND=rkind8), dimension(0:nprocz):: procz_boundsdb ! if (lroot) then open(lun_input,FILE=file,FORM='unformatted',status='old',action='read',iostat=ierr) if (ierr /= 0) call fatal_error("rproc_bounds", "Cannot open "//trim(file)//" for reading") if (lread_from_other_prec) then if (kind(x)==rkind4) then call input_proc_bounds(procx_boundsdb,procy_boundsdb,procz_boundsdb) procx_bounds=procx_boundsdb; procy_bounds=procy_boundsdb; procz_bounds=procz_boundsdb elseif (kind(x)==rkind8) then call input_proc_bounds(procx_boundssg,procy_boundssg,procz_boundssg) procx_bounds=procx_boundssg; procy_bounds=procy_boundssg; procz_bounds=procz_boundssg endif else call input_proc_bounds(procx_bounds,procy_bounds,procz_bounds) endif close(lun_output) endif call mpibcast(procx_bounds,nprocx+1) call mpibcast(procy_bounds,nprocy+1) call mpibcast(procz_bounds,nprocz+1) ! endsubroutine rproc_bounds !*********************************************************************** subroutine wproc_bounds(file) ! ! Export processor boundaries to file. ! ! 22-Feb-2012/PABourdin: adapted from io_dist ! 27-nov-2020/ccyang: make the file single ! character(len=*), intent(in) :: file ! integer :: ierr ! ! Only one process is needed. ! if (.not. lroot) return ! ! Write proc[xyz]_bounds. ! open (lun_output, FILE=file, FORM='unformatted', IOSTAT=ierr, status='replace') if (ierr /= 0) call fatal_error("wproc_bounds", "Cannot open "//trim(file)//" for writing") write (lun_output) procx_bounds write (lun_output) procy_bounds write (lun_output) procz_bounds close (lun_output) ! endsubroutine wproc_bounds !*********************************************************************** subroutine input_proc_bounds_double(procx_bounds,procy_bounds,procz_bounds) ! ! Import processor boundaries from file.in double precision ! ! 23-oct-13/MR: derived from rproc_bounds ! real(KIND=rkind8), dimension(0:nprocx), intent(OUT):: procx_bounds real(KIND=rkind8), dimension(0:nprocy), intent(OUT):: procy_bounds real(KIND=rkind8), dimension(0:nprocz), intent(OUT):: procz_bounds ! read(lun_input) procx_bounds read(lun_input) procy_bounds read(lun_input) procz_bounds ! endsubroutine input_proc_bounds_double !*********************************************************************** subroutine input_proc_bounds_single(procx_bounds,procy_bounds,procz_bounds) ! ! Import processor boundaries from file.in single precision ! ! 23-oct-13/MR: derived from rproc_bounds ! real(KIND=rkind4), dimension(0:nprocx), intent(OUT):: procx_bounds real(KIND=rkind4), dimension(0:nprocy), intent(OUT):: procy_bounds real(KIND=rkind4), dimension(0:nprocz), intent(OUT):: procz_bounds ! read(lun_input) procx_bounds read(lun_input) procy_bounds read(lun_input) procz_bounds ! endsubroutine input_proc_bounds_single !*********************************************************************** subroutine output_ode(file) ! ! Write ODE snapshot file with time. ! ! 08-Sep-2023/MR: coded ! use FarrayManager, only: farray_retrieve_metadata_ode character (len=*) :: file ! character(len=7) :: file_ character(LEN=30), dimension(n_odevars) :: names integer, dimension(n_odevars) :: lengs integer :: num,lun ! if (.not. lroot) return ! if (file(1:3)=='VAR') then file_='ODE'//file(4:) else file_='ode.dat' endif lun = lun_output+10 open(lun,FILE=trim(directory_collect)//'/'//trim(file_),FORM='unformatted') if (n_odevars > 0) then num = farray_retrieve_metadata_ode(names,lengs) write(lun) n_odevars,num write(lun) names(n_odevars-num+1:) write(lun) lengs(n_odevars-num+1:) write(lun) f_ode write(lun) real(t) endif close(lun) if (ip<=10) print*,'written ODE snapshot ', trim (file_) endsubroutine output_ode !*********************************************************************** subroutine input_ode(file) ! ! Write ODE snapshot file with time. ! ! 08-Sep-2023/MR: coded ! use FarrayManager, only: farray_retrieve_metadata_ode use File_Io, only: file_exists use Mpicomm, only: mpibcast character (len=*), intent(IN) :: file character (len=7) :: file_ integer :: n_in, num_in, num character(LEN=30), dimension(n_odevars) :: names character(LEN=30), dimension(:), allocatable :: names_in integer, dimension(n_odevars) :: lengs integer, dimension(:), allocatable :: lengs_in real :: t_in if (lroot) then ! if (file(1:3)=='VAR') then file_='ODE'//file(4:) else file_='ode.dat' endif ! if (file_exists(trim(directory_collect)//'/'//trim(file_))) then if (ip<=8) print*, 'read ODE snapshot', trim (file_) open(lun_input,FILE=trim(directory_collect)//'/'//trim(file_),FORM='unformatted') num = farray_retrieve_metadata_ode(names,lengs) read(lun_input) n_in, num_in if (n_in /= n_odevars) call fatal_error("input_ode", & "numbers of slots differ between "//trim(file)//" and 'f_ode' array") if (num_in /= num) call fatal_error("input_ode", & "numbers of variables differ between "//trim(file)//" and 'f_ode' array") if (n_in > 0) then allocate(lengs_in(num), names_in(num)) read(lun_input) names_in if (any(names_in /= names(n_odevars-num+1:))) call fatal_error("input_ode","variable names differ") read(lun_input) lengs_in if (any(lengs_in /= lengs(n_odevars-num+1:))) call fatal_error("input_ode","variable lengths differ") read(lun_input) f_ode endif read(lun_input) t_in if (t_in/=real(t)) call fatal_error("input_ode","times differ between "//trim(file)//" and var.dat") close(lun_input) else call warning('input_ode','no ODE data available') endif endif call mpibcast(f_ode,n_odevars) endsubroutine input_ode !***********************************************************************