Merge pull request #172 from scrasmussen/new-feature/noncoarray-LUT

New feature: non-coarray LUT allows cray compiled code to generate the linear winds look up table.  Also, some fixes for cray pre-processing step that were somehow braking namelist IO?

src/io/io_routines.f90

@@ -186,7 +186,7 @@ subroutine io_read6d(filename, varname, data_in, extradim)
  implicit none
  ! This is the name of the data_in file and variable we will read.
  character(len=*), intent(in) :: filename, varname
- real, allocatable, intent(inout) :: data_in(:,:,:,:,:,:)[:]
+ real, allocatable, intent(inout) :: data_in(:,:,:,:,:,:)
  integer, optional, intent(in) :: extradim
 
  integer, dimension(io_maxDims) :: diminfo !will hold dimension lengths
@@ -205,7 +205,7 @@ subroutine io_read6d(filename, varname, data_in, extradim)
  call io_getdims(filename,varname,diminfo)
 
  if (allocated(data_in)) deallocate(data_in)
- allocate(data_in(diminfo(2),diminfo(3),diminfo(4),diminfo(5),diminfo(6),diminfo(7))[*])
+ allocate(data_in(diminfo(2),diminfo(3),diminfo(4),diminfo(5),diminfo(6),diminfo(7)))
 
  ! Open the file. NF90_NOWRITE tells netCDF we want read-only access to the file.
  call check(nf90_open(filename, NF90_NOWRITE, ncid),filename)

src/io/lt_lut_io.f90

@@ -59,7 +59,7 @@ module linear_theory_lut_disk_io
  function write_lut(filename, uLUT, vLUT, dz, options) result(error)
  implicit none
  character(len=*), intent(in) :: filename
- real, dimension(:,:,:,:,:,:), intent(in) :: uLUT[*], vLUT[*]
+ real, dimension(:,:,:,:,:,:), intent(in) :: uLUT, vLUT
  real, dimension(:), intent(in) :: dz
  type(lt_options_type), intent(in) :: options
  integer :: error
@@ -134,7 +134,7 @@ end function write_lut
  function read_LUT(filename, uLUT, vLUT, dz, dims, options) result(error)
  implicit none
  character(len=*), intent(in) :: filename
- real, allocatable, dimension(:,:,:,:,:,:), intent(inout) :: uLUT[:], vLUT[:]
+ real, allocatable, dimension(:,:,:,:,:,:), intent(inout) :: uLUT, vLUT
  real, dimension(:), intent(in) :: dz
  integer, dimension(3,2), intent(in) :: dims
  type(lt_options_type), intent(in) :: options

src/makefile

@@ -195,7 +195,7 @@ endif
 ifeq ($(COMPILER), cray)
  COMP= -h omp vector2 -O2 -c -eI -hfp0
  LINK= -fopenmp
- PREPROC= -eZ
+ PREPROC= -eT
  MODOUTPUT= -J $(BUILD) -em
 endif
 
@@ -213,7 +213,7 @@ ifeq ($(MODE), debugslow)
  ifeq ($(COMPILER), cray)
  COMP=-h noomp -c -g -h develop -m 0 -R csp -M 399 -hfp0
  LINK=-h noomp
- PREPROC=-eZ
+ PREPROC=-eT
  MODOUTPUT=-e m -J $(BUILD)
  endif
 endif
@@ -229,7 +229,7 @@ ifeq ($(MODE), debug)
  ifeq ($(COMPILER), cray)
  COMP=-O2 -h noomp -c -g -hfp0
  LINK=-h noomp
- PREPROC=-eZ
+ PREPROC=-eT
  MODOUTPUT=-e m -J $(BUILD)
  endif
 endif
@@ -246,7 +246,7 @@ ifeq ($(MODE), debugompslow)
  ifeq ($(COMPILER), cray)
  COMP=-c -g -m 0 -h develop -R csp -M 399 -hfp0
  LINK=
- PREPROC=-eZ
+ PREPROC=-eT
  MODOUTPUT=-e m -J $(BUILD)
  endif
 endif
@@ -263,7 +263,7 @@ ifeq ($(MODE), debugomp)
  ifeq ($(COMPILER), cray)
  COMP=-O1 -c -g -hfp0
  LINK=
- PREPROC=-eZ
+ PREPROC=-eT
  MODOUTPUT=-e m -J $(BUILD)
  endif
 endif
@@ -454,26 +454,22 @@ TEST_EXECUTABLES= fftshift_test \
 
 icar:${OBJS} $(BUILD)driver.o
  ${LINKER} $^ -o icar ${LFLAGS}
- make move_i
 
 all:icar test
 
 install:icar
  mkdir -p ${INSTALLDIR}
  ${CP} icar ${INSTALLDIR}
 
-move_i:
- $(ECHO_MOVE) *.i ${BUILD} 2>/dev/null || true
-
 clean:
- ${RM} $(BUILD)*.o $(BUILD)*.mod $(BUILD)*.smod *.i *.lst docs/doxygen_sqlite3.db 2>/dev/null ||:
+ ${RM} $(BUILD)*.o $(BUILD)*.mod $(BUILD)*.smod *.lst docs/doxygen_sqlite3.db 2>/dev/null ||:
 
 allclean:cleanall
 
 cleanall:clean
  ${RM} icar $(TEST_EXECUTABLES) 2>/dev/null ||:
 
-test: $(TEST_EXECUTABLES) move_i
+test: $(TEST_EXECUTABLES)
 
 caf_tests: $(CAF_TEST_EXECUTABLES)
 

src/objects/options_obj.f90

@@ -1554,6 +1554,9 @@ subroutine lt_parameters_namelist(filename, options)
  endif
  endif
 
+ ! check if directory paths to LUT file strings exist, if not fails before write step
+ call check_writeable_path(u_LUT_Filename)
+ call check_writeable_path(v_LUT_Filename)
  opt%u_LUT_Filename = u_LUT_Filename
  opt%v_LUT_Filename = v_LUT_Filename
  opt%overwrite_lt_lut = overwrite_lt_lut

src/physics/linear_winds.f90

@@ -90,7 +90,9 @@ module linear_theory_winds
  !! Linear wind look up table values and tables
  real, allocatable, dimension(:) :: dir_values, nsq_values, spd_values
  ! Look Up Tables for linear perturbation are nspd x n_dir_values x n_nsq_values x nx x nz x ny
- real, allocatable, dimension(:,:,:,:,:,:) :: hi_u_LUT[:], hi_v_LUT[:] !, rev_u_LUT, rev_v_LUT
+ real, allocatable, dimension(:,:,:,:,:,:) :: hi_u_LUT, hi_v_LUT
+ real, allocatable, dimension(:,:,:) :: hi_u_LUT_co[:], hi_v_LUT_co[:]
+ integer, allocatable, dimension(:,:) :: LUT_index_co[:]
  ! real, pointer, dimension(:,:,:,:,:,:) :: u_LUT, v_LUT
  real, allocatable, dimension(:,:) :: linear_mask, nsq_calibration
 
@@ -574,28 +576,50 @@ subroutine setup_remote_grids(u_grids, v_grids, terrain, nz)
 
  end subroutine setup_remote_grids
 
- subroutine copy_data_to_remote(wind, grids, LUT, i,j,k, z)
+ subroutine copy_data_to_remote(wind, grids, LUT, LUT_co, LUT_index_co, i, j, k, z)
  implicit none
  real, intent(in) :: wind(:,:)
  type(grid_t), intent(in) :: grids(:)
- real, intent(inout):: LUT(:,:,:,:,:,:)[*]
- integer, intent(in) :: i,j,k, z
-
- integer :: img
-
+ real, intent(inout):: LUT(:,:,:,:,:,:)
+ real, intent(inout):: LUT_co(:,:,:)[*]
+ integer, intent(inout):: LUT_index_co(:,:)[*]
+ integer, intent(in) :: i, j, k, z
+ integer :: img, LUT_i, LUT_j, LUT_k, LUT_z
+
+ ! each image will communicate the wind values it has calculated for an ijkz
+ ! location to the other images, the ijkz values are also sent so the receiving
+ ! images know where to put the incoming values
  do img = 1, num_images()
  associate(ims => grids(img)%ims, &
  ime => grids(img)%ime, &
  jms => grids(img)%jms, &
  jme => grids(img)%jme &
  )
- !$omp critical
- LUT(k,i,j, 1:ime-ims+1, z, 1:jme-jms+1)[img] = wind(ims:ime,jms:jme)
- !$omp end critical
+ LUT_co(1:ime-ims+1, 1:jme-jms+1, this_image())[img] = wind(ims:ime,jms:jme)
 
- end associate
+ LUT_index_co(this_image(), 1)[img] = i
+ LUT_index_co(this_image(), 2)[img] = j
+ LUT_index_co(this_image(), 3)[img] = k
+ LUT_index_co(this_image(), 4)[img] = z
+ end associate
  enddo
 
+ sync all
+
+ associate(ims => grids(this_image())%ims, &
+ ime => grids(this_image())%ime, &
+ jms => grids(this_image())%jms, &
+ jme => grids(this_image())%jme &
+ )
+ do img = 1, num_images()
+ LUT_i = LUT_index_co(img, 1)
+ LUT_j = LUT_index_co(img, 2)
+ LUT_k = LUT_index_co(img, 3)
+ LUT_z = LUT_index_co(img, 4)
+ LUT(LUT_k, LUT_i, LUT_j, 1:ime-ims+1, LUT_z, 1:jme-jms+1) = LUT_co(1:ime-ims+1, 1:jme-jms+1, img)
+ end do
+ end associate
+ sync all
  end subroutine copy_data_to_remote
 
  !>----------------------------------------------------------
@@ -670,8 +694,11 @@ subroutine initialize_spatial_winds(domain,options,reverse)
 
  ! Allocate the (LARGE) look up tables for both U and V
  if (.not.options%lt_options%read_LUT) then
- allocate(hi_u_LUT(n_spd_values, n_dir_values, n_nsq_values, nxu, nz, ny)[*], source=0.0)
- allocate(hi_v_LUT(n_spd_values, n_dir_values, n_nsq_values, nx, nz, nyv)[*], source=0.0)
+ allocate(hi_u_LUT(n_spd_values, n_dir_values, n_nsq_values, nxu, nz, ny), source=0.0)
+ allocate(hi_v_LUT(n_spd_values, n_dir_values, n_nsq_values, nx, nz, nyv), source=0.0)
+ allocate(hi_u_LUT_co(nxu, ny, num_images())[*], source=0.0)
+ allocate(hi_v_LUT_co(nx, nyv, num_images())[*], source=0.0)
+ allocate(LUT_index_co(num_images(), 4)[*], source=0)
  error=0
  else
  if (this_image()==1) write(*,*) " Reading LUT from file: ", trim(LUT_file)
@@ -680,10 +707,18 @@ subroutine initialize_spatial_winds(domain,options,reverse)
  if (error/=0) then
  if (this_image()==1) write(*,*) "WARNING: LUT on disk does not match that specified in the namelist or does not exist."
  if (this_image()==1) write(*,*) " LUT will be recreated"
+
+ if (allocated(hi_u_LUT_co)) deallocate(hi_u_LUT_co)
+ allocate(hi_u_LUT_co(nxu, ny, num_images())[*], source=0.0)
+ if (allocated(hi_v_LUT_co)) deallocate(hi_v_LUT_co)
+ allocate(hi_v_LUT_co(nx, nyv, num_images())[*], source=0.0)
+
+ if (allocated(LUT_index_co)) deallocate(LUT_index_co)
+ allocate(LUT_index_co(num_images(), 4)[*], source=0)
  if (allocated(hi_u_LUT)) deallocate(hi_u_LUT)
- allocate(hi_u_LUT(n_spd_values, n_dir_values, n_nsq_values, nxu, nz, ny)[*], source=0.0)
+ allocate(hi_u_LUT(n_spd_values, n_dir_values, n_nsq_values, nxu, nz, ny), source=0.0)
  if (allocated(hi_v_LUT)) deallocate(hi_v_LUT)
- allocate(hi_v_LUT(n_spd_values, n_dir_values, n_nsq_values, nx, nz, nyv)[*], source=0.0)
+ allocate(hi_v_LUT(n_spd_values, n_dir_values, n_nsq_values, nx, nz, nyv), source=0.0)
  endif
  endif
 
@@ -694,7 +729,6 @@ subroutine initialize_spatial_winds(domain,options,reverse)
  if (this_image()==1) write(*,*) "Stabilities:",exp(nsq_values)
  ! endif
 
-
  if (reverse.or.(.not.((options%lt_options%read_LUT).and.(error==0)))) then
  ! loop over combinations of U, V, and Nsq values
  loops_completed = 0
@@ -780,8 +814,9 @@ subroutine initialize_spatial_winds(domain,options,reverse)
  ( lt_data_m%v_perturb(1+buffer:fftnx-buffer, buffer:fftny-buffer) &
  + lt_data_m%v_perturb(1+buffer:fftnx-buffer, 1+buffer:fftny-buffer+1)) )) / 2
 
- call copy_data_to_remote(temporary_u, u_grids, hi_u_LUT, i,j,k, z)
- call copy_data_to_remote(temporary_v, v_grids, hi_v_LUT, i,j,k, z)
+ call copy_data_to_remote(temporary_u, u_grids, hi_u_LUT, hi_u_LUT_co, LUT_index_co, i, j, k, z)
+ call copy_data_to_remote(temporary_v, v_grids, hi_v_LUT, hi_v_LUT_co, LUT_index_co, i, j, k, z)
+ sync all
 
  else
  stop "ERROR: linear wind LUT creation not set up for non-staggered grids yet"