Skip to content

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

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.

Sign up for GitHub

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

Merged
liujake merged 8 commits into from
Jan 10, 2024
Merged

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

Show file tree
Hide file tree
Changes from 3 commits
Commits
Show all changes
8 commits
Select commit Hold shift + click to select a range
e8c4f17
Update configure.defaults for intel oneAPI
mos3r3n Jan 5, 2024
0a96419
Update da_fill_obs_structures.inc for intel oneAPI
mos3r3n Jan 5, 2024
c2b42f4
Update preproc.sh for intel oneAPI
mos3r3n Jan 5, 2024
ddfb7e7
update configure.defaults
mos3r3n Jan 6, 2024
d8ede5c
Update configure.defaults
mos3r3n Jan 9, 2024
50500bc
Update bufrlib.h
mos3r3n Jan 9, 2024
9414cf4
Update stseq.c
mos3r3n Jan 9, 2024
6e13c2a
Update da_fill_obs_structures.inc
mos3r3n Jan 9, 2024
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
View file
Open in desktop
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
Comment thread
islas marked this conversation as resolved.
Outdated
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
View file
Open in desktop
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)
Comment thread
mgduda marked this conversation as resolved.
Outdated
!---------------------------------------------------------------------------

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
Comment thread
mgduda marked this conversation as 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
View file
Open in desktop
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