Commit b0f6f010 authored by Zolnierczuk, Piotr's avatar Zolnierczuk, Piotr
Browse files

moved is_pixel_ok to data_types

parent f2c735fe

sources/data_types.f90

+15 −1
Original line number Diff line number Diff line
@@ -851,6 +851,20 @@ CONTAINS 
    call print_spectrum(this%spectrum_struct, this%id)

  end subroutine print_transmission_data



  !> test if pixel is OK (optionally ignoring masked flags)

  function is_pixel_ok(this, ignore_mask) result(res)

    logical                              :: res

    type(phase_scan_struct), intent(in)  :: this

    logical, intent(in), optional        :: ignore_mask

    !

    integer :: cmask

    cmask = NOT(PIXEL_OK)

    if (present(ignore_mask)) then

        if (ignore_mask) cmask = PIXEL_MASK_CLEAR

    end if

    res = IAND(this%status, cmask)==PIXEL_OK

    return

  end function is_pixel_ok





!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -1656,7 +1670,7 @@ dotau: do it=it1,it2 
               dq_var = 0.0_DBL

            end if



            write(iok,'("tau/ns ",f12.6," var ",f12.6,"    Q/A**-1 ",f12.6," var ",f12.6 , i8)') &

            write(iok,'("tau/ns ",e12.6," var ",e12.6,"    Q/A**-1 ",e12.6," var ",e12.6 , i8)') &

                 ci%fqt_tau/NS, sqrt(dtau_var)/NS,               &

                 ci%fqt_q*ANGSTROEM,   sqrt(dq_var)*ANGSTROEM, ci%update_counter

            write(cmsg,'(6e15.7,i8)')  ci%fqt_tau/NS, ci%fqt_tau_var, ci%fqt_tau**2,           &

sources/drspine_parameters.f90

+0 −16
Original line number Diff line number Diff line
@@ -481,22 +481,6 @@ CONTAINS 
  end function cformat_fit_flag





  function is_pixel_ok(pixel_status, ignore_mask) result(res)

    logical                       :: res

    integer, intent(in)           :: pixel_status

    logical, intent(in), optional :: ignore_mask

    !

    integer :: cmask

    cmask = NOT(PIXEL_OK)

    if (present(ignore_mask)) then

        if (ignore_mask) cmask = PIXEL_MASK_CLEAR

    end if

    res = IAND(pixel_status, cmask)==PIXEL_OK

    return

  end function is_pixel_ok







  !> function that formats the pixel status

  !! @param pixel_status pixel status flag

  function cformat_pixel_status(pixel_status, short_format) result(cresult)

tests/testbase.f90

+5 −11
Original line number Diff line number Diff line
@@ -12,11 +12,11 @@ program testdata 


  call loginit(LOG_TRACE, file_level=LOG_OFF)

  call test_parameters

  !call test_data_sizes

  !call test_constants

  !call test_value_struct

  !call test_namedvalue_struct

  !call test_datetime

  call test_data_sizes

  call test_constants

  call test_value_struct

  call test_namedvalue_struct

  call test_datetime



contains
@@ -65,12 +65,6 @@ contains 
    write(*,"(a16,1x,a)") "pixel not ok:"          , trim(cformat_pixel_status_short(IOR(PIXEL_OK,&

                                                    IOR(PIXEL_FIT_FAILED,PIXEL_MASKED_Q))))



    write(*,*) '== PIXEL_STATUS'

    write(*,"(a16,1x,l1)") "pixel_ok T?"          , is_pixel_ok(PIXEL_OK)

    write(*,"(a16,1x,l1)") "pixel_ok F?"          , is_pixel_ok(IOR(PIXEL_OK, PIXEL_FIT_FAILED))

    write(*,"(a16,1x,l1)") "pixel_ok F?"          , is_pixel_ok(IOR(PIXEL_OK, PIXEL_MASKED_Q))

    write(*,"(a16,1x,l1)") "pixel_ok T?"          , is_pixel_ok(IOR(PIXEL_OK, PIXEL_MASKED_Q), ignore_mask=.TRUE.)



    write(*,*) '== PIXEL_FLAG (MASK)'

    write(*,"(a16,1x,z8)") "pixel_ok:"          , PIXEL_OK

    write(*,"(a16,1x,z8)") "pixel_masked_tau:"  , IOR (PIXEL_OK, PIXEL_MASKED_TAU)

tests/testdata.f90

+21 −5
Original line number Diff line number Diff line 


program testdata

  use, intrinsic :: iso_fortran_env, only : output_unit

  use drspine_parameters

  use data_types



  use print_helper
@@ -10,7 +11,7 @@ program testdata 


  call loginit(LOG_DEBUG, file_level=LOG_OFF)

  call test_data_sizes

  call test_data_types

  call test_phase_scan_struct

  call test_collection

contains
@@ -48,10 +49,25 @@ contains 
  end subroutine test_data_sizes





  subroutine test_data_types

    write(*,*) '=========== DATA TYPES STRUCTURES ========='

  end subroutine test_data_types

  subroutine test_phase_scan_struct

    type(phase_scan_struct) :: pix



    write(*,*) '=========== PHASE SCAN STRUCT ========='

    call init_phase_scan_struct(pix, 13)





    write(*,*) '== PIXEL_STATUS'

    write(*,"(a32,1x,l1,1x,a)") "pixel_ok T?"   , is_pixel_ok(pix), trim(cformat_pixel_status(pix%status))



    pix%status = IOR(PIXEL_OK, PIXEL_FIT_FAILED)

    write(*,"(a32,1x,l1,1x,a)") "pixel_ok F?"   , is_pixel_ok(pix), trim(cformat_pixel_status(pix%status))





    pix%status = IOR(PIXEL_OK, PIXEL_MASKED_Q)

    write(*,"(a32,1x,l1,1x,a)") "pixel_ok F?"   , is_pixel_ok(pix), trim(cformat_pixel_status(pix%status))

    write(*,"(a32,1x,l1,1x,a)") "(ignore mask) pixel_ok T?", is_pixel_ok(pix, ignore_mask=.TRUE.), trim(cformat_pixel_status(pix%status))



  end subroutine test_phase_scan_struct



  subroutine test_collection

    type(collection) :: sqt_collection