Skip to content

Modify send_data_3d in diag_manager.F90 to move SELECT TYPE blocks out of triple do loops #8

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
MinsukJi-NOAA merged 14 commits into from
Nov 3, 2021
Merged

Modify send_data_3d in diag_manager.F90 to move SELECT TYPE blocks out of triple do loops #8

Changes from all commits
Commits
Show all changes
14 commits
Select commit Hold shift + click to select a range
84fb687
Modify set_tracer_profile in tracer_manager.F90
MinsukJi-NOAA Oct 8, 2021
ba92db8
Specify platform_mod variables used
MinsukJi-NOAA Oct 8, 2021
8a47920
Merge remote-tracking branch 'emc/fms_mixedmode' into feature/mji_mix…
MinsukJi-NOAA Oct 8, 2021
4b63ab9
Modify real_to_time_type in time_manager.F90
MinsukJi-NOAA Oct 9, 2021
fbe2aa2
Merge remote-tracking branch 'emc/fms_mixedmode' into feature/mji_mix…
MinsukJi-NOAA Oct 9, 2021
a9d1638
Modify files in the sat_vapor_pres directory
MinsukJi-NOAA Oct 10, 2021
07ef656
Fix select type statement in sat_vapor_pres_k.F90
MinsukJi-NOAA Oct 10, 2021
d68a06c
Move write temp statement inside select type
MinsukJi-NOAA Oct 10, 2021
b6e5fb4
Merge remote-tracking branch 'emc/fms_mixedmode' into feature/mji_mix…
MinsukJi-NOAA Oct 21, 2021
906b3a6
Fix range size check if statements
MinsukJi-NOAA Oct 21, 2021
b469607
Merge remote-tracking branch 'emc/fms_mixedmode' into feature/mji_mix…
MinsukJi-NOAA Oct 31, 2021
6029a7d
Modify sat_vapor_pres_k.F90 to fix FV3 32 bit atmos_4xdaily* file NaN…
MinsukJi-NOAA Oct 31, 2021
1f31865
Merge remote-tracking branch 'emc/fms_mixedmode' into feature/mji_mix…
MinsukJi-NOAA Nov 3, 2021
8764990
Move SELECT TYPE blocks out of triple do loops in diag_manager.F90
MinsukJi-NOAA Nov 3, 2021
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
84 changes: 54 additions & 30 deletions diag_manager/diag_manager.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3034,58 +3034,82 @@ LOGICAL FUNCTION send_data_3d(diag_field_id, field, time, is_in, js_in, ks_in, &
! If rmask and missing value present, then insert missing value
IF ( PRESENT(rmask) .AND. missvalue_present ) THEN
IF ( need_compute ) THEN
DO k = l_start(3), l_end(3)
k1 = k - l_start(3) + 1
DO j = js, je
DO i = is, ie
IF ( l_start(1)+hi <= i .AND. i <= l_end(1)+hi .AND. l_start(2)+hj <= j .AND. j <= l_end(2)+hj ) THEN
i1 = i-l_start(1)-hi+1
j1 = j-l_start(2)-hj+1
SELECT TYPE (rmask)
TYPE IS (real(kind=r4_kind))
SELECT TYPE (rmask)
TYPE IS (real(kind=r4_kind))
DO k = l_start(3), l_end(3)
k1 = k - l_start(3) + 1
DO j = js, je
DO i = is, ie
IF ( l_start(1)+hi <= i .AND. i <= l_end(1)+hi .AND. l_start(2)+hj <= j .AND. j <= l_end(2)+hj ) THEN
i1 = i-l_start(1)-hi+1
j1 = j-l_start(2)-hj+1
IF ( rmask(i-is+1+hi,j-js+1+hj,k) < 0.5_r4_kind ) &
& output_fields(out_num)%buffer(i1,j1,k1,sample) = missvalue
TYPE IS (real(kind=r8_kind))
END IF
END DO
END DO
END DO
TYPE IS (real(kind=r8_kind))
DO k = l_start(3), l_end(3)
k1 = k - l_start(3) + 1
DO j = js, je
DO i = is, ie
IF ( l_start(1)+hi <= i .AND. i <= l_end(1)+hi .AND. l_start(2)+hj <= j .AND. j <= l_end(2)+hj ) THEN
i1 = i-l_start(1)-hi+1
j1 = j-l_start(2)-hj+1
IF ( rmask(i-is+1+hi,j-js+1+hj,k) < 0.5_r8_kind ) &
& output_fields(out_num)%buffer(i1,j1,k1,sample) = missvalue
END SELECT
END IF
END IF
END DO
END DO
END DO
END DO
END SELECT
ELSE IF ( reduced_k_range ) THEN
ksr= l_start(3)
ker= l_end(3)
DO k= ksr, ker
k1 = k - ksr + 1
DO j=js, je
DO i=is, ie
SELECT TYPE (rmask)
TYPE IS (real(kind=r4_kind))
SELECT TYPE (rmask)
TYPE IS (real(kind=r4_kind))
DO k= ksr, ker
k1 = k - ksr + 1
DO j=js, je
DO i=is, ie
IF ( rmask(i-is+1+hi,j-js+1+hj,k) < 0.5_r4_kind ) &
& output_fields(out_num)%buffer(i-hi,j-hj,k1,sample)= missvalue
TYPE IS (real(kind=r8_kind))
END DO
END DO
END DO
TYPE IS (real(kind=r8_kind))
DO k= ksr, ker
k1 = k - ksr + 1
DO j=js, je
DO i=is, ie
IF ( rmask(i-is+1+hi,j-js+1+hj,k) < 0.5_r8_kind ) &
& output_fields(out_num)%buffer(i-hi,j-hj,k1,sample)= missvalue
END SELECT
END DO
END DO
END DO
END DO
END SELECT
ELSE
DO k=ks, ke
DO j=js, je
DO i=is, ie
SELECT TYPE (rmask)
TYPE IS (real(kind=r4_kind))
SELECT TYPE (rmask)
TYPE IS (real(kind=r4_kind))
DO k=ks, ke
DO j=js, je
DO i=is, ie
IF ( rmask(i-is+1+hi,j-js+1+hj,k) < 0.5_r4_kind ) &
& output_fields(out_num)%buffer(i-hi,j-hj,k,sample)= missvalue
TYPE IS (real(kind=r8_kind))
END DO
END DO
END DO
TYPE IS (real(kind=r8_kind))
DO k=ks, ke
DO j=js, je
DO i=is, ie
IF ( rmask(i-is+1+hi,j-js+1+hj,k) < 0.5_r8_kind ) &
& output_fields(out_num)%buffer(i-hi,j-hj,k,sample)= missvalue
END SELECT
END DO
END DO
END DO
END DO
END SELECT
END IF
END IF

Expand Down