Skip to content

Commit 138636d

Browse files
zbeekmanzbeekman
committed
Removed associate constructs
This is a work around for Intel Fortran Compiler issue DPD200247629, wherein associate constructs combined with certain compiler optimization flags results in incorrect code. See https://prd1idz.cps.intel.com/en-us/forums/topic/405706 for more details. This defect is theoretically fixed since fort 13 update 2, but I have not verified this myself yet. I intentionally did not change the indentation, and only commented, rather than removed the associate block openings and closings so that a simple interactive regexp search and replace in Emacs can undo these changes at a later date, and so that lines with only indentation changes won’t show up in the Git diff.
1 parent 8f148c7 commit 138636d

File tree

1 file changed

+77
-77
lines changed

1 file changed

+77
-77
lines changed

‎src/json_module.f90

Lines changed: 77 additions & 77 deletions
Original file line numberDiff line numberDiff line change
@@ -1920,9 +1920,9 @@ recursive subroutine json_value_print(this,iunit,indent,need_comma,colon,str)
19201920

19211921
nullify(element)
19221922

1923-
associate (d => this%data)
1923+
!associate (d => this%data)
19241924

1925-
select case (d%var_type)
1925+
select case (this%data%var_type)
19261926

19271927
case (json_object)
19281928

@@ -1973,8 +1973,8 @@ recursive subroutine json_value_print(this,iunit,indent,need_comma,colon,str)
19731973

19741974
case (json_string)
19751975

1976-
if (allocated(d%str_value)) then
1977-
call write_it( repeat(space, spaces)//'"'// trim(d%str_value)//'"', comma=print_comma )
1976+
if (allocated(this%data%str_value)) then
1977+
call write_it( repeat(space, spaces)//'"'// trim(this%data%str_value)//'"', comma=print_comma )
19781978
else
19791979
call throw_exception('Error in json_value_print: this%value_string not allocated')
19801980
call cleanup()
@@ -1983,21 +1983,21 @@ recursive subroutine json_value_print(this,iunit,indent,need_comma,colon,str)
19831983

19841984
case (json_logical)
19851985

1986-
if (d%log_value) then
1986+
if (this%data%log_value) then
19871987
call write_it( repeat(space, spaces)// 'true', comma=print_comma )
19881988
else
19891989
call write_it( repeat(space, spaces)//'false', comma=print_comma )
19901990
end if
19911991

19921992
case (json_integer)
19931993

1994-
call integer_to_string(d%int_value,tmp)
1994+
call integer_to_string(this%data%int_value,tmp)
19951995

19961996
call write_it( repeat(space, spaces)//trim(tmp), comma=print_comma )
19971997

19981998
case (json_real)
19991999

2000-
call real_to_string(d%dbl_value,tmp)
2000+
call real_to_string(this%data%dbl_value,tmp)
20012001

20022002
call write_it( repeat(space, spaces)//trim(tmp), comma=print_comma )
20032003

@@ -2007,7 +2007,7 @@ recursive subroutine json_value_print(this,iunit,indent,need_comma,colon,str)
20072007

20082008
end select
20092009

2010-
end associate
2010+
!end associate
20112011

20122012
call cleanup()
20132013

@@ -2362,22 +2362,22 @@ subroutine json_get_integer(this, path, value, found)
23622362

23632363
else
23642364

2365-
associate (d => p%data)
2366-
select case(d%var_type)
2365+
!associate (d => p%data)
2366+
select case(p%data%var_type)
23672367
case (json_integer)
2368-
value = d%int_value
2368+
value = p%data%int_value
23692369
case (json_real)
2370-
value = d%dbl_value
2370+
value = p%data%dbl_value
23712371
case (json_logical)
2372-
if (d%log_value) then
2372+
if (p%data%log_value) then
23732373
value = 1
23742374
else
23752375
value = 0
23762376
end if
23772377
case default
23782378
call throw_exception('Error in get_integer: Unable to resolve value to integer: '//trim(path))
23792379
end select
2380-
end associate
2380+
!end associate
23812381

23822382
nullify(p)
23832383

@@ -2441,22 +2441,22 @@ subroutine json_get_double(this, path, value, found)
24412441

24422442
else
24432443

2444-
associate (d => p%data)
2445-
select case (d%var_type)
2444+
!associate (d => p%data)
2445+
select case (p%data%var_type)
24462446
case (json_integer)
2447-
value = d%int_value
2447+
value = p%data%int_value
24482448
case (json_real)
2449-
value = d%dbl_value
2449+
value = p%data%dbl_value
24502450
case (json_logical)
2451-
if (d%log_value) then
2451+
if (p%data%log_value) then
24522452
value = 1.0_wp
24532453
else
24542454
value = 0.0_wp
24552455
end if
24562456
case default
24572457
call throw_exception('Error in json_get_double: Unable to resolve value to double: '//trim(path))
24582458
end select
2459-
end associate
2459+
!end associate
24602460

24612461
nullify(p)
24622462

@@ -2520,16 +2520,16 @@ subroutine json_get_logical(this, path, value, found)
25202520

25212521
else
25222522

2523-
associate (d => p%data)
2524-
select case (d%var_type)
2523+
!associate (d => p%data)
2524+
select case (p%data%var_type)
25252525
case (json_integer)
2526-
value = (d%int_value > 0)
2526+
value = (p%data%int_value > 0)
25272527
case (json_logical)
2528-
value = d % log_value
2528+
value = p%data % log_value
25292529
case default
25302530
call throw_exception('Error in json_get_logical: Unable to resolve value to logical: '//trim(path))
25312531
end select
2532-
end associate
2532+
!end associate
25332533

25342534
nullify(p)
25352535

@@ -2597,13 +2597,13 @@ subroutine json_get_chars(this, path, value, found)
25972597

25982598
else
25992599

2600-
associate (d => p%data)
2601-
select case (d%var_type)
2600+
!associate (d => p%data)
2601+
select case (p%data%var_type)
26022602
case (json_string)
2603-
if (allocated(d%str_value)) then
2603+
if (allocated(p%data%str_value)) then
26042604

26052605
!get the value as is:
2606-
s = d%str_value
2606+
s = p%data%str_value
26072607

26082608
! Now, have to remove the escape characters:
26092609
!
@@ -2726,7 +2726,7 @@ subroutine json_get_chars(this, path, value, found)
27262726
! Note: for the other cases, we could do val to string conversions... TO DO
27272727

27282728
end select
2729-
end associate
2729+
!end associate
27302730

27312731
end if
27322732

@@ -2798,8 +2798,8 @@ subroutine json_get_array(this, path, array_callback, found)
27982798

27992799
else
28002800

2801-
associate (d => p%data)
2802-
select case (d%var_type)
2801+
!associate (d => p%data)
2802+
select case (p%data%var_type)
28032803
case (json_array)
28042804
count = json_value_count(p)
28052805
do i = 1, count
@@ -2809,7 +2809,7 @@ subroutine json_get_array(this, path, array_callback, found)
28092809
case default
28102810
call throw_exception('Error in json_get_array: Resolved value is not an array. '//trim(path))
28112811
end select
2812-
end associate
2812+
!end associate
28132813

28142814
!cleanup:
28152815
if (associated(p)) nullify(p)
@@ -2969,14 +2969,14 @@ recursive subroutine parse_value(unit, value)
29692969
! string
29702970
call to_string(value) !allocate class
29712971

2972-
associate (d => value%data)
2973-
!select type (d)
2974-
select case (d%var_type)
2972+
!associate (d => value%data)
2973+
!select type (value%data)
2974+
select case (value%data%var_type)
29752975
!type is (json_string)
29762976
case (json_string)
2977-
call parse_string(unit, d%str_value)
2977+
call parse_string(unit, value%data%str_value)
29782978
end select
2979-
end associate
2979+
!end associate
29802980

29812981
case ('t')
29822982

@@ -3036,16 +3036,16 @@ subroutine to_logical(me,val,name)
30363036
logical,intent(in),optional :: val
30373037

30383038
!set type and value:
3039-
associate (d => me%data)
3040-
call d%destroy()
3041-
d%var_type = json_logical
3042-
allocate(d%log_value)
3039+
!associate (d => me%data)
3040+
call me%data%destroy()
3041+
me%data%var_type = json_logical
3042+
allocate(me%data%log_value)
30433043
if (present(val)) then
3044-
d%log_value = val
3044+
me%data%log_value = val
30453045
else
3046-
d%log_value = .false. !default value
3046+
me%data%log_value = .false. !default value
30473047
end if
3048-
end associate
3048+
!end associate
30493049

30503050
!name:
30513051
if (present(name)) me%name = trim(name)
@@ -3076,16 +3076,16 @@ subroutine to_integer(me,val,name)
30763076
integer,intent(in),optional :: val
30773077

30783078
!set type and value:
3079-
associate (d => me%data)
3080-
call d%destroy()
3081-
d%var_type = json_integer
3082-
allocate(d%int_value)
3079+
!associate (d => me%data)
3080+
call me%data%destroy()
3081+
me%data%var_type = json_integer
3082+
allocate(me%data%int_value)
30833083
if (present(val)) then
3084-
d%int_value = val
3084+
me%data%int_value = val
30853085
else
3086-
d%int_value = 0 !default value
3086+
me%data%int_value = 0 !default value
30873087
end if
3088-
end associate
3088+
!end associate
30893089

30903090
!name:
30913091
if (present(name)) me%name = trim(name)
@@ -3117,16 +3117,16 @@ subroutine to_real(me,val,name)
31173117
real(wp),intent(in),optional :: val
31183118

31193119
!set type and value:
3120-
associate (d => me%data)
3121-
call d%destroy()
3122-
d%var_type = json_real
3123-
allocate(d%dbl_value)
3120+
!associate (d => me%data)
3121+
call me%data%destroy()
3122+
me%data%var_type = json_real
3123+
allocate(me%data%dbl_value)
31243124
if (present(val)) then
3125-
d%dbl_value = val
3125+
me%data%dbl_value = val
31263126
else
3127-
d%dbl_value = 0.0_wp !default value
3127+
me%data%dbl_value = 0.0_wp !default value
31283128
end if
3129-
end associate
3129+
!end associate
31303130

31313131
!name:
31323132
if (present(name)) me%name = trim(name)
@@ -3158,15 +3158,15 @@ subroutine to_string(me,val,name)
31583158
character(len=*),intent(in),optional :: val
31593159

31603160
!set type and value:
3161-
associate (d => me%data)
3162-
call d%destroy()
3163-
d%var_type = json_string
3161+
!associate (d => me%data)
3162+
call me%data%destroy()
3163+
me%data%var_type = json_string
31643164
if (present(val)) then
3165-
d%str_value = val
3165+
me%data%str_value = val
31663166
else
3167-
d%str_value = '' !default value
3167+
me%data%str_value = '' !default value
31683168
end if
3169-
end associate
3169+
!end associate
31703170

31713171
!name:
31723172
if (present(name)) me%name = trim(name)
@@ -3197,10 +3197,10 @@ subroutine to_null(me,name)
31973197
character(len=*),intent(in),optional :: name
31983198

31993199
!set type and value:
3200-
associate (d => me%data)
3201-
call d%destroy()
3202-
d%var_type = json_null
3203-
end associate
3200+
!associate (d => me%data)
3201+
call me%data%destroy()
3202+
me%data%var_type = json_null
3203+
!end associate
32043204

32053205
!name:
32063206
if (present(name)) me%name = trim(name)
@@ -3231,10 +3231,10 @@ subroutine to_object(me,name)
32313231
character(len=*),intent(in),optional :: name
32323232

32333233
!set type and value:
3234-
associate (d => me%data)
3235-
call d%destroy()
3236-
d%var_type = json_object
3237-
end associate
3234+
!associate (d => me%data)
3235+
call me%data%destroy()
3236+
me%data%var_type = json_object
3237+
!end associate
32383238

32393239
!name:
32403240
if (present(name)) me%name = trim(name)
@@ -3264,10 +3264,10 @@ subroutine to_array(me,name)
32643264
character(len=*),intent(in),optional :: name
32653265

32663266
!set type and value:
3267-
associate (d => me%data)
3268-
call d%destroy()
3269-
d%var_type = json_array
3270-
end associate
3267+
!associate (d => me%data)
3268+
call me%data%destroy()
3269+
me%data%var_type = json_array
3270+
!end associate
32713271

32723272
!name:
32733273
if (present(name)) me%name = trim(name)

0 commit comments

Comments
 (0)