TABLE OF CONTENTS
tests/ising_1D [ Unit tests ]
[ Top ] [ Unit tests ]
NAME
ising_1D
SYNOPSIS
!$Id: ising_1D.f90 561 2018-10-14 20:48:19Z mexas $ program ising_1D
PURPOSE
Test ising magnetisation Halo coarrays only, 1D co-rank version + sync all
DESCRIPTION
See ca_kernel_ising and related routines for details. Note that I use a reproducible RND seed and generate a single sequence of RND values for the whole CA model. Thus the results must be exactly reproducible on any number of images. I include the reference value for the final magnetisation (unscaled, integer). If the test does not produce the same value, it fails. However... the ref magnetisation value is obtained here with gfortran7. It is possible (likely?) that other compliers will produce a different sequence of RND from the same seed. In such cases users need to replace the ref value accordingly.
AUTHOR
Anton Shterenlikht
COPYRIGHT
See LICENSE
USES
USED BY
Part of casup test suite
SOURCE
use casup implicit none integer( kind=iarr ), parameter :: huge_iarr = huge(0_iarr) ! Reference values for different compilers for magnet_ref, ! magnetisation at the end of simulation !integer( kind=iarr ), parameter :: magnet_ref = 863379 ! gfortran7 integer( kind=iarr ), parameter :: magnet_ref = 864070 ! Cray real( kind=rdef ) :: bsz(3) ! "box" size integer( kind=iarr ), allocatable :: space(:,:,:), & space0(:,:,:) integer( kind=idef ) :: nimgs, img, c(3) ! coarray dimensions integer( kind=ilrg ) :: icells, mcells !real, allocatable :: space_ini(:,:,:), rnd_array(:) integer :: i, iter, seed_size, run integer( kind=ilrg) :: energy0, energy1, energy2, magnet0, magnet1, & magnet2 integer, allocatable :: seed_array(:) ! real :: time1, time2 !*********************************************************************72 ! first executable statement ! Read the box size from command line call ca_cmd_real( n=3, data=bsz ) ! bsz is simply CA dimensions in cells! but in real, not integer! !bsz = (/ 1.2e2, 1.2e2, 1.2e2 /) ! dimensions of the CA model img = this_image() nimgs = num_images() ! do a check on image 1 if ( img .eq. 1 ) then write (*,*) "running on", nimgs, "images in a 1D grid" write (*,*) "iarr kind:", iarr, "huge(0_iarr):", huge_iarr ! In this test space is assigned image numbers - must be big enough ! integer kind to avoid integer overflow. if ( nimgs .gt. huge_iarr ) then write (*,*) "ERROR: num_images(): ", nimgs, & " is greater than huge(0_iarr)" error stop end if end if ! Only a single codimension, corank 1 c = int(bsz) c(3) = int(bsz(3))/nimgs ! Check that the partition is sane if ( img .eq. 1 ) then if ( c(3)*nimgs .ne. int(bsz(3)) ) then write (*,*) & "ERROR: bad decomposition: bsz(3) must be divisible by nimgs" write (*,*) "ERROR: bsz(3):", int(bsz(3)) write (*,*) "ERROR: nimgs :", nimgs error stop end if ! total number of cells in a coarray icells = product( int( c, kind=ilrg ) ) ! total number of cells in the model mcells = icells * int( nimgs, kind=ilrg ) write ( *, "(5(a,i0),3(a,g10.3),a)" ) & "nimgs: ", nimgs, " (", c(1), "," , c(2), "," , c(3), & ")[", nimgs, "] (", bsz(1), ",", bsz(2), ",", bsz(3), ")" write (*,'(a,i0,a)') "Each image has ",icells, " cells" write (*,'(a,i0,a)') "The model has ", mcells, " cells" ! In this test sum over all cells on an image is done, so the kind ! must be big enough to contain the total number of cells ! on an image. if ( icells .gt. huge_iarr ) then write (*,*) "ERROR: number of cells on an image:", icells, & "is greater than huge(0_iarr)" error stop end if end if ! allocate space arrays ! space - CA array to allocate, with halos! ! c - array with space dimensions ! d - depth of the halo layer call ca_spalloc( space, c, 1 ) call ca_spalloc( space0, c, 1 ) ! allocate hx arrays, implicit sync all ! mask_array is set inside too. call ca_1D_halloc ! Init RND !call cgca_irs( debug = .false. ) ! Use a reproducible RND here for verification call random_seed( size = seed_size ) allocate( seed_array( seed_size ) ) seed_array = (/ (i, i=1,seed_size) /) ! Set space arrays if (img .eq. 1) write (*,*) "RND, serial IO, etc. - wait..." ! Passing allocatable coarray into assumed-shape array, which is ok! call ca_set_space_rnd( seed = seed_array, frac1=0.5, space = space ) ! Calculate initial energy and magnetisation ! run=1 => ca_iter_tl ! run=2 => ca_iter_dc ! run=3 => ca_iter_omp do run=1,3 select case(run) case(1) call ca_ising_energy_col( space = space, hx_sub = ca_1D_hx_sall, & iter_sub = ca_iter_tl, kernel = ca_kernel_ising_ener, & energy = energy0, magnet = magnet0 ) case(2) call ca_ising_energy_col( space = space, hx_sub = ca_1D_hx_sall, & iter_sub = ca_iter_dc, kernel = ca_kernel_ising_ener, & energy = energy1, magnet = magnet1 ) case(3) call ca_ising_energy_col( space = space, hx_sub = ca_1D_hx_sall, & iter_sub = ca_iter_omp, kernel = ca_kernel_ising_ener, & energy = energy2, magnet = magnet2 ) end select end do if (img .eq. 1 ) then write (*,*) "Initial energy and magnetisation" write (*,*) "ca_iter_tl :", energy0, magnet0 write (*,*) "ca_iter_dc :", energy1, magnet1 write (*,*) "ca_iter_omp:", energy2, magnet2 if ( energy0 .ne. energy1 .or. magnet0 .ne. magnet1 .or. & energy0 .ne. energy2 .or. magnet0 .ne. magnet2 ) then write (*,*) "FAIL: ca_iter_tl, ca_iter_dc, ca_iter_omp differ" error stop else write (*,*) "PASS: ca_iter_tl, ca_iter_dc, ca_iter_omp agree" end if end if ! save old space as space0 space0 = space ! run=1 => ca_iter_tl ! run=2 => ca_iter_dc ! run=3 => ca_iter_omp main: do run=1,3 ! Reset space to space0 space = space0 ! No IO here ! No timing ! here ! CA iterations loop: do iter = 1,100 ! Check energy after every iter ! subroutine ca_run( space, hx_sub, iter_sub, kernel, niter ) select case(run) case(1) call ca_run( space = space, hx_sub = ca_1D_hx_sall, & iter_sub = ca_iter_tl, kernel = ca_kernel_ising, niter = 1 ) call ca_ising_energy_col( space = space, hx_sub = ca_1D_hx_sall, & iter_sub = ca_iter_tl, kernel = ca_kernel_ising_ener, & energy = energy1, magnet = magnet1 ) case(2) call ca_run( space = space, hx_sub = ca_1D_hx_sall, & iter_sub = ca_iter_dc, kernel = ca_kernel_ising, niter = 1 ) call ca_ising_energy_col( space = space, hx_sub = ca_1D_hx_sall, & iter_sub = ca_iter_dc, kernel = ca_kernel_ising_ener, & energy = energy1, magnet = magnet1 ) case(3) call ca_run( space = space, hx_sub = ca_1D_hx_sall, & iter_sub = ca_iter_omp, kernel = ca_kernel_ising, niter = 1 ) call ca_ising_energy_col( space = space, hx_sub = ca_1D_hx_sall, & iter_sub = ca_iter_omp, kernel = ca_kernel_ising_ener, & energy = energy1, magnet = magnet1 ) end select if ( img .eq. 1 ) then if ( energy1 .ne. energy0 ) then write (*,*) "FAIL: energy0:", energy0, "energy1:", energy1 error stop else if ( mod((iter-1), 100) .eq. 0 ) then ! write (*,"(a,i0,a,es18.6)") "Magnetisation_after_iter_", & ! iter, ":", real(magnet1) / real(mcells) write (*,*) iter, real(magnet1) / real(mcells) end if end if end if end do loop ! no sync needed here ! ! no IO here ! ! no counter ! here if ( img .eq. 1 ) then select case(run) case(1) if ( magnet1 .eq. magnet_ref ) then write (*,*) "PASS: ca_iter_tl : final mag:", magnet1 ! no timing here else write (*,"(2(a,i0))") & "FAIL: ca_iter_tl : magnetisation ref value: ", & magnet_ref, " my value: ", magnet1 end if case(2) if ( magnet1 .eq. magnet_ref ) then write (*,*) "PASS: ca_iter_dc : final mag:", magnet1 ! no timing here else write (*,"(2(a,i0))") & "FAIL: ca_iter_dc : magnetisation ref value: ", & magnet_ref, " my value: ", magnet1 end if case(3) if ( magnet1 .eq. magnet_ref ) then write (*,*) "PASS: ca_iter_omp: final mag:", magnet1 ! no timing here else write (*,"(2(a,i0))") & "FAIL: ca_iter_omp: magnetisation ref value: ", & magnet_ref, " my value: ", magnet1 end if end select end if end do main ! deallocate halos, implicit sync all call ca_1D_hdalloc ! deallocate space deallocate( space ) deallocate( space0 ) end program ising_1D