Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Bufrlib C code fix for WRFDA build with intel oneAPI compiler and a run-time segfault Fortran bugfix #1972

Merged
merged 8 commits into from
Jan 10, 2024
Merged
Show file tree
Hide file tree
Changes from 3 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion arch/configure.defaults
Original file line number Diff line number Diff line change
Expand Up @@ -2144,7 +2144,7 @@ LD = $(FC)
RWORDSIZE = CONFIGURE_RWORDSIZE
PROMOTION = -real-size `expr 8 \* $(RWORDSIZE)` -i4
ARCH_LOCAL = -DNONSTANDARD_SYSTEM_FUNC CONFIGURE_D_CTSM
CFLAGS_LOCAL = -w -O3 -ip #-xHost -fp-model fast=2 -no-prec-div -no-prec-sqrt -ftz -no-multibyte-chars # -DRSL0_ONLY
CFLAGS_LOCAL = -w -O3 -ip -w -O3 -ip -Wno-implicit-function-declaration -Wno-incompatible-function-pointer-types #-xHost -fp-model fast=2 -no-prec-div -no-prec-sqrt -ftz -no-multibyte-chars # -DRSL0_ONLY
islas marked this conversation as resolved.
Show resolved Hide resolved
LDFLAGS_LOCAL = -ip #-xHost -fp-model fast=2 -no-prec-div -no-prec-sqrt -ftz -align all -fno-alias -fno-common
CPLUSPLUSLIB =
ESMF_LDFLAG = $(CPLUSPLUSLIB)
Expand Down
75 changes: 45 additions & 30 deletions var/da/da_obs/da_fill_obs_structures.inc
Original file line number Diff line number Diff line change
Expand Up @@ -16,9 +16,24 @@ subroutine da_fill_obs_structures(iv, ob, uvq_direct)
real :: geometric_h, geopotential_h
integer :: i,j
logical :: outside
logical :: uvq_direct_local

if (trace_use) call da_trace_entry("da_fill_obs_structures")

!---------------------------------------------------------------------------
! Initialise uvq_direct_local (for intel oneAPI)
mgduda marked this conversation as resolved.
Show resolved Hide resolved
!---------------------------------------------------------------------------

if (.not. present(uvq_direct)) then
uvq_direct_local = .false.
else
if (.not. uvq_direct) then
uvq_direct_local = .false.
else
uvq_direct_local = .true.
end if
end if
mgduda marked this conversation as resolved.
Show resolved Hide resolved

!---------------------------------------------------------------------------
! Initialise obs error factors (which will be overwritten in use_obs_errfac)
!---------------------------------------------------------------------------
Expand Down Expand Up @@ -147,21 +162,21 @@ subroutine da_fill_obs_structures(iv, ob, uvq_direct)
if ( q_error_options == 1 ) then
! Calculate q error from rh error:

if (.not. present(uvq_direct) .or. (present(uvq_direct) .and. (.not. uvq_direct))) then
rh_error = iv%synop(n)%q%error ! q error is rh at this stage!
if (.not. uvq_direct_local) then
rh_error = iv%synop(n)%q%error ! q error is rh at this stage!

! if((ob % synop(n) % p > iv%ptop) .AND. &
! (ob % synop(n) % t > 100.0) .AND. &
! (ob % synop(n) % q > 0.0) .AND. &
! (iv % synop(n) % p % qc >= obs_qc_pointer) .and. &
! (iv % synop(n) % t % qc >= obs_qc_pointer) .and. &
! (iv % synop(n) % q % qc >= obs_qc_pointer)) then
call da_get_q_error(ob % synop(n) % p, &
call da_get_q_error(ob % synop(n) % p, &
ob % synop(n) % t, &
ob % synop(n) % q, &
iv % synop(n) % t % error, &
rh_error, iv % synop(n) % q % error)
if (iv%synop(n)% q % error == missing_r) iv%synop(n)% q % qc = missing_data
if (iv%synop(n)% q % error == missing_r) iv%synop(n)% q % qc = missing_data

! end if
end if
Expand All @@ -181,16 +196,16 @@ subroutine da_fill_obs_structures(iv, ob, uvq_direct)

! Calculate q error from rh error:

if (.not. present(uvq_direct) .or. (present(uvq_direct) .and. (.not. uvq_direct))) then
rh_error = iv%metar(n)%q%error ! q error is rh at this stage!
call da_get_q_error(iv % metar(n) % p % inv, &
if (.not. uvq_direct_local) then
rh_error = iv%metar(n)%q%error ! q error is rh at this stage!
call da_get_q_error(iv % metar(n) % p % inv, &
ob % metar(n) % t, &
ob % metar(n) % q, &
iv % metar(n) % t % error, &
rh_error, q_error)
iv % metar(n) % q % error = q_error
if (iv%metar(n)% q % error == missing_r) &
iv%metar(n)% q % qc = missing_data
iv % metar(n) % q % error = q_error
if (iv%metar(n)% q % error == missing_r) &
iv%metar(n)% q % qc = missing_data
end if
end do
end if
Expand All @@ -207,16 +222,16 @@ subroutine da_fill_obs_structures(iv, ob, uvq_direct)

! Calculate q error from rh error:

if (.not. present(uvq_direct) .or. (present(uvq_direct) .and. (.not. uvq_direct))) then
rh_error = iv%ships(n)%q%error ! q error is rh at this stage!
call da_get_q_error(iv % ships(n) % p % inv, &
if (.not. uvq_direct_local) then
rh_error = iv%ships(n)%q%error ! q error is rh at this stage!
call da_get_q_error(iv % ships(n) % p % inv, &
ob % ships(n) % t, &
ob % ships(n) % q, &
iv % ships(n) % t % error, &
rh_error, q_error)
iv % ships(n) % q % error = q_error
iv % ships(n) % q % error = q_error

if(iv%ships(n)% q % error == missing_r) iv%ships(n)% q % qc = missing_data
if(iv%ships(n)% q % error == missing_r) iv%ships(n)% q % qc = missing_data
end if
end do

Expand Down Expand Up @@ -301,7 +316,7 @@ subroutine da_fill_obs_structures(iv, ob, uvq_direct)

! Calculate q error from rh error:

if (.not. present(uvq_direct) .or. (present(uvq_direct) .and. (.not. uvq_direct))) then
if (.not. uvq_direct_local) then
rh_error = iv%sound(n)%q(k)%error ! q error is rh at this stage!
call da_get_q_error(iv % sound(n) % p(k), &
ob % sound(n) % t(k), &
Expand All @@ -310,8 +325,8 @@ subroutine da_fill_obs_structures(iv, ob, uvq_direct)
rh_error, q_error)

iv % sound(n) % q(k) % error = q_error
if (iv%sound(n)% q(k) % error == missing_r) &
iv%sound(n)% q(k) % qc = missing_data
if (iv%sound(n)% q(k) % error == missing_r) &
iv%sound(n)% q(k) % qc = missing_data
end if
end do
end do
Expand All @@ -327,15 +342,15 @@ subroutine da_fill_obs_structures(iv, ob, uvq_direct)

! Calculate q error from rh error:

if (.not. present(uvq_direct) .or. (present(uvq_direct) .and. (.not. uvq_direct))) then
rh_error = iv%sonde_sfc(n)%q%error ! q error is rh at this stage!
call da_get_q_error(iv % sonde_sfc(n) % p % inv, &
if (.not. uvq_direct_local) then
rh_error = iv%sonde_sfc(n)%q%error ! q error is rh at this stage!
call da_get_q_error(iv % sonde_sfc(n) % p % inv, &
ob % sonde_sfc(n) % t, &
ob % sonde_sfc(n) % q, &
iv % sonde_sfc(n) % t % error, &
rh_error, iv % sonde_sfc(n) % q % error)
if (iv%sonde_sfc(n)% q % error == missing_r) &
iv%sonde_sfc(n)% q % qc = missing_data
if (iv%sonde_sfc(n)% q % error == missing_r) &
iv%sonde_sfc(n)% q % qc = missing_data
end if
end do
end if
Expand All @@ -350,7 +365,7 @@ subroutine da_fill_obs_structures(iv, ob, uvq_direct)
ob % airep(n) % t(k) = iv % airep(n) % t(k) % inv
ob % airep(n) % q(k) = iv % airep(n) % q(k) % inv

if (.not. present(uvq_direct) .or. (present(uvq_direct) .and. (.not. uvq_direct))) then
if (.not. uvq_direct_local) then
rh_error = iv%airep(n)%q(k)%error ! q error is rh at this stage!
call da_get_q_error(iv % airep(n) % p(k), &
ob % airep(n) % t(k), &
Expand Down Expand Up @@ -463,16 +478,16 @@ subroutine da_fill_obs_structures(iv, ob, uvq_direct)

! Calculate q error from rh error:

if (.not. present(uvq_direct) .or. (present(uvq_direct) .and. (.not. uvq_direct))) then
rh_error = iv%buoy(n)%q%error ! q error is rh at this stage!
call da_get_q_error(iv % buoy(n) % p % inv, &
if (.not. uvq_direct_local) then
rh_error = iv%buoy(n)%q%error ! q error is rh at this stage!
call da_get_q_error(iv % buoy(n) % p % inv, &
ob % buoy(n) % t, &
ob % buoy(n) % q, &
iv % buoy(n) % t % error, &
rh_error, q_error)
iv % buoy(n) % q % error = q_error
iv % buoy(n) % q % error = q_error

if(iv%buoy (n)% q % error == missing_r) iv%buoy (n)% q % qc = missing_data
if(iv%buoy (n)% q % error == missing_r) iv%buoy (n)% q % qc = missing_data
end if
end do
end if
Expand Down Expand Up @@ -555,7 +570,7 @@ subroutine da_fill_obs_structures(iv, ob, uvq_direct)

! Calculate q error from rh error:

if (.not. present(uvq_direct) .or. (present(uvq_direct) .and. (.not. uvq_direct))) then
if (.not. uvq_direct_local) then
rh_error = iv%airsr(n)%q(k)%error ! q error is rh at this stage!
call da_get_q_error(iv % airsr(n) % p(k), &
ob % airsr(n) % t(k), &
Expand Down
8 changes: 4 additions & 4 deletions var/external/bufr/preproc.sh
Original file line number Diff line number Diff line change
Expand Up @@ -15,14 +15,14 @@ cat > endiantest.c << ENDIANTEST
} \
printf("\n");

void fill(p, size) char *p; int size; {
void fill(char *p, int size) {
char *ab= "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
int i;

for (i=0; i<size; i++) p[i]= ab[i];
}

void endian(byte_size) int byte_size; {
void endian(int byte_size) {
int j=0;
unsigned int mask, i, c;

Expand All @@ -31,7 +31,7 @@ void endian(byte_size) int byte_size; {
Order(j);
}

int cprop() {
int cprop(void) {
/* Properties of type char */
char c;
int byte_size;
Expand All @@ -42,7 +42,7 @@ int cprop() {
return byte_size;
}

main()
int main(void)
{
int byte_size;

Expand Down