hydro/Debug_Utilities/debug_dump_variable.F

   1 module debug_dump_variable
   2 #ifdef MPP_LAND
   3     use module_mpp_land
   4 #endif
   5
   6     implicit none
   7
   8     contains
   9
  10     ! output a land surface dimensioned array to a test file for comparison
  11
  12     subroutine dump_float_2d(target_array, filepath)
  13         implicit none
  14         ! the array to be written to file
  15         real, allocatable, dimension(:,:), intent(in) :: target_array
  16
  17         ! the location to write the file
  18         character(len=*), intent(in) :: filepath
  19
  20 #ifdef MPP_LAND
  21     real, dimension(global_rt_nx,global_rt_ny) :: out_buffer
  22
  23         ! if we are in an mpi enviorment what needs to be done depends of if
  24         ! this process is the IO process
  25         ! if we are not the IO process write_IO_real will send data to the IO process
  26         ! if we are the IO process write_IO_RT_real will return the global array for this
  27         ! variable
  28
  29         call write_IO_RT_real(target_array,out_buffer)
  30         if ( my_id .eq. IO_id ) then
  31             call debug_write_float_to_file(out_buffer,filepath)
  32         end if
  33 #else
  34         call debug_write_float_to_file(target_array, filepath)
  35 #endif
  36
  37     end subroutine dump_float_2d
  38
  39     ! output a routing dimensioned array to a test file for comparison
  40
  41     subroutine dump_float_2d_rt(target_array, filepath)
  42         implicit none
  43         ! the array to be written to file
  44         real, allocatable, dimension(:,:), intent(in) :: target_array
  45
  46         ! the location to write the file
  47         character(len=*), intent(in) :: filepath
  48
  49 #ifdef MPP_LAND
  50     real, dimension(global_rt_nx,global_rt_ny) :: out_buffer
  51
  52         ! if we are in an mpi enviorment what needs to be done depends of if
  53         ! this process is the IO process
  54         ! if we are not the IO process write_IO_RT_real will send data to the IO process
  55         ! if we are the IO process write_IO_RT_real will return the global array for this
  56         ! variable
  57
  58         call write_IO_real(target_array,out_buffer)
  59         if ( my_id .eq. IO_id ) then
  60             call debug_write_float_to_file(out_buffer,filepath)
  61         end if
  62 #else
  63         call debug_write_float_to_file(target_array, filepath)
  64 #endif
  65
  66     end subroutine dump_float_2d_rt
  67
  68     subroutine debug_write_float_to_file(target_array, filepath)
  69         ! parameters
  70         real, dimension(:,:) :: target_array
  71         character(len=*) :: filepath
  72
  73         ! local variables
  74         integer :: nx
  75         integer :: ny
  76
  77         integer :: x_pos, y_pos
  78
  79         nx = size(target_array,1)
  80         ny = size(target_array,2)
  81
  82         ! open the file for writing
  83         open(unit=237, file=filepath, form='formatted', status="replace", action="write")
  84
  85         ! write the array to the file
  86         do y_pos = 1, ny
  87             do x_pos = 1, nx
  88                 write(237,'(F12.5,4X)',advance='no') target_array(x_pos,y_pos)
  89             end do
  90             write(237,*) '' ! write the end line
  91         end do
  92
  93         close(237)
  94
  95     end subroutine
  96
  97
  98
  99 end module debug_dump_variable