diff --git a/src/io/io_routines.f90 b/src/io/io_routines.f90 index 1e501c07..27831b78 100644 --- a/src/io/io_routines.f90 +++ b/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) diff --git a/src/io/lt_lut_io.f90 b/src/io/lt_lut_io.f90 index d0fe93aa..72dd6dda 100644 --- a/src/io/lt_lut_io.f90 +++ b/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 diff --git a/src/makefile b/src/makefile index deca2b06..1ecc0d08 100644 --- a/src/makefile +++ b/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,7 +454,6 @@ TEST_EXECUTABLES= fftshift_test \ icar:${OBJS} $(BUILD)driver.o ${LINKER} $^ -o icar ${LFLAGS} - make move_i all:icar test @@ -462,18 +461,15 @@ 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) diff --git a/src/objects/options_obj.f90 b/src/objects/options_obj.f90 index b5767adb..4f753507 100644 --- a/src/objects/options_obj.f90 +++ b/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 diff --git a/src/physics/linear_winds.f90 b/src/physics/linear_winds.f90 index dbbaa7dc..478caa8d 100644 --- a/src/physics/linear_winds.f90 +++ b/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"