Skip to content

SRTM Optimizations #83

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
reuterbal merged 1 commit into from
Oct 14, 2025
Merged

SRTM Optimizations #83

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
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
30 changes: 30 additions & 0 deletions ifsrrtm/srtm_taumol16.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -210,6 +210,35 @@ SUBROUTINE SRTM_TAUMOL16 &
!$OMP END TARGET TEAMS DISTRIBUTE PARALLEL DO
ENDDO

#if defined(OMPGPU)
!$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO PRIVATE(ind0, ind1, z_tauray)
DO iplon = KIDIA, KFDIA
DO i_lay = laytrop_max+1, i_nlayers
IF (k_jp(iplon,i_lay-1) < layreffr &
& .AND. k_jp(iplon,i_lay) >= layreffr) i_laysolfr(iplon) = i_lay
ENDDO
ENDDO
!$OMP END TARGET TEAMS DISTRIBUTE PARALLEL DO
!$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO COLLAPSE(2) PRIVATE(ind0, ind1, z_tauray)
DO i_lay = laytrop_max+1, i_nlayers
DO iplon = KIDIA, KFDIA
ind0 = ((k_jp(iplon,i_lay)-13)*5+(k_jt(iplon,i_lay)-1))*nspb(16) + 1
ind1 = ((k_jp(iplon,i_lay)-12)*5+(k_jt1(iplon,i_lay)-1))*nspb(16)+ 1
z_tauray = p_colmol(iplon,i_lay) * rayl
!$NEC unroll(NG16)
DO ig = 1, ng16
p_taug(iplon,i_lay,ig) = p_colch4(iplon,i_lay) * &
& (p_fac00(iplon,i_lay) * absb(ind0 ,ig) + &
& p_fac10(iplon,i_lay) * absb(ind0+1,ig) + &
& p_fac01(iplon,i_lay) * absb(ind1 ,ig) + &
& p_fac11(iplon,i_lay) * absb(ind1+1,ig))
IF (i_lay == i_laysolfr(iplon)) p_sfluxzen(iplon,ig) = sfluxrefc(ig)
p_taur(iplon,i_lay,ig) = z_tauray
ENDDO
ENDDO
ENDDO
!$OMP END TARGET TEAMS DISTRIBUTE PARALLEL DO
#else
!$ACC LOOP SEQ
DO i_lay = llaytrop_max+1, i_nlayers
!$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO PRIVATE(ind0, ind1, z_tauray)
Expand All @@ -234,6 +263,7 @@ SUBROUTINE SRTM_TAUMOL16 &
ENDDO
!$OMP END TARGET TEAMS DISTRIBUTE PARALLEL DO
ENDDO
#endif
!$ACC END PARALLEL

!$ACC WAIT
Expand Down
49 changes: 49 additions & 0 deletions ifsrrtm/srtm_taumol17.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -224,6 +224,54 @@ SUBROUTINE SRTM_TAUMOL17 &
!$OMP END TARGET TEAMS DISTRIBUTE PARALLEL DO
ENDDO

#if defined(OMPGPU)
!$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO
DO iplon = KIDIA, KFDIA
DO i_lay = laytrop_max+1, i_nlayers
IF (k_jp(iplon,i_lay-1) < layreffr &
& .AND. k_jp(iplon,i_lay) >= layreffr) i_laysolfr(iplon) = i_lay
ENDDO
ENDDO
!$OMP END TARGET TEAMS DISTRIBUTE PARALLEL DO
!$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO COLLAPSE(2) PRIVATE(ind0, ind1, indf, js, z_fs, z_speccomb, z_specmult, z_specparm, z_tauray)
DO i_lay = laytrop_max+1, i_nlayers
DO iplon = KIDIA, KFDIA
z_speccomb = p_colh2o(iplon,i_lay) + strrat*p_colco2(iplon,i_lay)
z_specparm = p_colh2o(iplon,i_lay)/z_speccomb
z_specparm = MIN(p_oneminus(iplon),z_specparm)
z_specmult = 4._JPRB*(z_specparm)
js = 1 + INT(z_specmult)
z_fs = z_specmult - AINT(z_specmult)
ind0 = ((k_jp(iplon,i_lay)-13)*5+(k_jt(iplon,i_lay)-1))*nspb(17)+ js
ind1 = ((k_jp(iplon,i_lay)-12)*5+(k_jt1(iplon,i_lay)-1))*nspb(17)+js
indf = k_indfor(iplon,i_lay)
z_tauray = p_colmol(iplon,i_lay) * rayl

!$NEC unroll(NG17)
DO ig = 1, ng17
p_taug(iplon,i_lay,ig) = z_speccomb * &
& ( &
& (1._JPRB- z_fs) * ( absb(ind0,ig) * p_fac00(iplon,i_lay) + &
& absb(ind0+5,ig) * p_fac10(iplon,i_lay) + &
& absb(ind1,ig) * p_fac01(iplon,i_lay) + &
& absb(ind1+5,ig) * p_fac11(iplon,i_lay))+ &
& z_fs * ( absb(ind0+1,ig) * p_fac00(iplon,i_lay) + &
& absb(ind0+6,ig) * p_fac10(iplon,i_lay) + &
& absb(ind1+1,ig) * p_fac01(iplon,i_lay) + &
& absb(ind1+6,ig) * p_fac11(iplon,i_lay) ) &
& ) + &
& p_colh2o(iplon,i_lay) * &
& p_forfac(iplon,i_lay) * (forrefc(indf,ig) + &
& p_forfrac(iplon,i_lay) * &
& (forrefc(indf+1,ig) - forrefc(indf,ig)))
IF (i_lay == i_laysolfr(iplon)) p_sfluxzen(iplon,ig) = sfluxrefc(ig,js) &
& + z_fs * (sfluxrefc(ig,js+1) - sfluxrefc(ig,js))
p_taur(iplon,i_lay,ig) = z_tauray
ENDDO
ENDDO
ENDDO
!$OMP END TARGET TEAMS DISTRIBUTE PARALLEL DO
#else
!$ACC LOOP SEQ
DO i_lay = llaytrop_max+1, i_nlayers
!$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO PRIVATE(ind0, ind1, indf, js, z_fs, z_speccomb, z_specmult, z_specparm, z_tauray)
Expand Down Expand Up @@ -267,6 +315,7 @@ SUBROUTINE SRTM_TAUMOL17 &
ENDDO
!$OMP END TARGET TEAMS DISTRIBUTE PARALLEL DO
ENDDO
#endif
!$ACC END PARALLEL

!$ACC WAIT
Expand Down
55 changes: 55 additions & 0 deletions ifsrrtm/srtm_taumol18.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -96,7 +96,61 @@ SUBROUTINE SRTM_TAUMOL18 &
ENDDO
!$OMP END TARGET TEAMS DISTRIBUTE PARALLEL DO

#if defined(OMPGPU)
!$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO
DO iplon = KIDIA, KFDIA
DO i_lay = 1, laytrop_min
IF (k_jp(iplon,i_lay) < layreffr &
& .AND. k_jp(iplon,i_lay+1) >= layreffr) &
& i_laysolfr(iplon) = MIN(i_lay+1,k_laytrop(iplon))
ENDDO
ENDDO
!$OMP END TARGET TEAMS DISTRIBUTE PARALLEL DO
!$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO COLLAPSE(2) PRIVATE(ind0, ind1, inds, indf, js, z_fs, &
!$OMP z_speccomb, z_specmult, z_specparm, z_tauray)
DO i_lay = 1, laytrop_min
DO iplon = KIDIA, KFDIA
z_speccomb = p_colh2o(iplon,i_lay) + strrat*p_colch4(iplon,i_lay)
z_specparm = p_colh2o(iplon,i_lay)/z_speccomb
z_specparm = MIN(p_oneminus(iplon),z_specparm)
z_specmult = 8._JPRB*(z_specparm)
js = 1 + INT(z_specmult)
z_fs = z_specmult - AINT(z_specmult)
ind0 = ((k_jp(iplon,i_lay)-1)*5+(k_jt(iplon,i_lay)-1))*nspa(18) + js
ind1 = (k_jp(iplon,i_lay)*5+(k_jt1(iplon,i_lay)-1))*nspa(18) + js
inds = k_indself(iplon,i_lay)
indf = k_indfor(iplon,i_lay)
z_tauray = p_colmol(iplon,i_lay) * rayl

!$NEC unroll(NG18)
DO ig = 1, ng18
p_taug(iplon,i_lay,ig) = z_speccomb * &
& ( &
& (1._JPRB- z_fs) * ( absa(ind0,ig) * p_fac00(iplon,i_lay) + &
& absa(ind0+9,ig) * p_fac10(iplon,i_lay) + &
& absa(ind1,ig) * p_fac01(iplon,i_lay) + &
& absa(ind1+9,ig) * p_fac11(iplon,i_lay) )+ &
& z_fs * ( absa(ind0+1,ig) * p_fac00(iplon,i_lay) + &
& absa(ind0+10,ig) * p_fac10(iplon,i_lay) + &
& absa(ind1+1,ig) * p_fac01(iplon,i_lay) + &
& absa(ind1+10,ig) * p_fac11(iplon,i_lay) ) &
& ) + &
& p_colh2o(iplon,i_lay) * &
& (p_selffac(iplon,i_lay) * (selfrefc(inds,ig) + &
& p_selffrac(iplon,i_lay) * &
& (selfrefc(inds+1,ig) - selfrefc(inds,ig))) + &
& p_forfac(iplon,i_lay) * (forrefc(indf,ig) + &
& p_forfrac(iplon,i_lay) * &
& (forrefc(indf+1,ig) - forrefc(indf,ig))))
IF (i_lay == i_laysolfr(iplon)) &
& p_sfluxzen(iplon,ig) = sfluxrefc(ig,js) &
& + z_fs * (sfluxrefc(ig,js+1) - sfluxrefc(ig,js))
p_taur(iplon,i_lay,ig) = z_tauray
ENDDO
ENDDO
ENDDO
!$OMP END TARGET TEAMS DISTRIBUTE PARALLEL DO
#else
!$ACC LOOP SEQ
DO i_lay = 1, llaytrop_min
!$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO PRIVATE(ind0, ind1, inds, indf, js, z_fs, &
Expand Down Expand Up @@ -148,6 +202,7 @@ SUBROUTINE SRTM_TAUMOL18 &
ENDDO
!$OMP END TARGET TEAMS DISTRIBUTE PARALLEL DO
ENDDO
#endif

!$ACC LOOP SEQ
DO i_lay = llaytrop_min+1, llaytrop_max
Expand Down
56 changes: 56 additions & 0 deletions ifsrrtm/srtm_taumol19.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -96,6 +96,61 @@ SUBROUTINE SRTM_TAUMOL19 &
ENDDO
!$OMP END TARGET TEAMS DISTRIBUTE PARALLEL DO

#if defined(OMPGPU)
!$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO
DO iplon = KIDIA, KFDIA
DO i_lay = 1, laytrop_min
IF (k_jp(iplon,i_lay) < layreffr &
& .AND. k_jp(iplon,i_lay+1) >= layreffr) &
& i_laysolfr(iplon) = MIN(i_lay+1,k_laytrop(iplon))
ENDDO
ENDDO
!$OMP END TARGET TEAMS DISTRIBUTE PARALLEL DO
!$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO COLLAPSE(2) PRIVATE(ind0, ind1, inds, indf, js, z_fs, z_speccomb, z_specmult, z_specparm, &
!$OMP z_tauray)
DO i_lay = 1, laytrop_min
DO iplon = KIDIA, KFDIA
z_speccomb = p_colh2o(iplon,i_lay) + strrat*p_colco2(iplon,i_lay)
z_specparm = p_colh2o(iplon,i_lay)/z_speccomb
z_specparm = MIN(p_oneminus(iplon),z_specparm)
z_specmult = 8._JPRB*(z_specparm)
js = 1 + INT(z_specmult)
z_fs = z_specmult - AINT(z_specmult)
ind0 = ((k_jp(iplon,i_lay)-1)*5+(k_jt(iplon,i_lay)-1))*nspa(19) + js
ind1 = (k_jp(iplon,i_lay)*5+(k_jt1(iplon,i_lay)-1))*nspa(19) + js
inds = k_indself(iplon,i_lay)
indf = k_indfor(iplon,i_lay)
z_tauray = p_colmol(iplon,i_lay) * rayl

!$NEC unroll(NG19)
DO ig = 1 , ng19
p_taug(iplon,i_lay,ig) = z_speccomb * &
& ( &
& (1._JPRB- z_fs) * ( absa(ind0,ig) * p_fac00(iplon,i_lay) + &
& absa(ind0+9,ig) * p_fac10(iplon,i_lay) + &
& absa(ind1,ig) * p_fac01(iplon,i_lay) + &
& absa(ind1+9,ig) * p_fac11(iplon,i_lay) )+ &
& z_fs * ( absa(ind0+1,ig) * p_fac00(iplon,i_lay) + &
& absa(ind0+10,ig) * p_fac10(iplon,i_lay) + &
& absa(ind1+1,ig) * p_fac01(iplon,i_lay) + &
& absa(ind1+10,ig) * p_fac11(iplon,i_lay) ) &
& ) + &
& p_colh2o(iplon,i_lay) * &
& (p_selffac(iplon,i_lay) * (selfrefc(inds,ig) + &
& p_selffrac(iplon,i_lay) * &
& (selfrefc(inds+1,ig) - selfrefc(inds,ig))) + &
& p_forfac(iplon,i_lay) * (forrefc(indf,ig) + &
& p_forfrac(iplon,i_lay) * &
& (forrefc(indf+1,ig) - forrefc(indf,ig))))
IF (i_lay == i_laysolfr(iplon)) &
& p_sfluxzen(iplon,ig) = sfluxrefc(ig,js) &
& + z_fs * (sfluxrefc(ig,js+1) - sfluxrefc(ig,js))
p_taur(iplon,i_lay,ig) = z_tauray
ENDDO
ENDDO
ENDDO
!$OMP END TARGET TEAMS DISTRIBUTE PARALLEL DO
#else
!$ACC LOOP SEQ
DO i_lay = 1, llaytrop_min
!$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO PRIVATE(ind0, ind1, inds, indf, js, z_fs, z_speccomb, z_specmult, z_specparm, &
Expand Down Expand Up @@ -147,6 +202,7 @@ SUBROUTINE SRTM_TAUMOL19 &
ENDDO
!$OMP END TARGET TEAMS DISTRIBUTE PARALLEL DO
ENDDO
#endif

!$ACC LOOP SEQ
DO i_lay = llaytrop_min+1, llaytrop_max
Expand Down
40 changes: 40 additions & 0 deletions ifsrrtm/srtm_taumol20.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -94,6 +94,45 @@ SUBROUTINE SRTM_TAUMOL20 &
ENDDO
!$OMP END TARGET TEAMS DISTRIBUTE PARALLEL DO

#if defined(OMPGPU)
!$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO
DO iplon = KIDIA, KFDIA
DO i_lay = 1, laytrop_min
IF (k_jp(iplon,i_lay) < layreffr &
& .AND. k_jp(iplon,i_lay+1) >= layreffr) &
& i_laysolfr(iplon) = MIN(i_lay+1,k_laytrop(iplon))
ENDDO
ENDDO
!$OMP END TARGET TEAMS DISTRIBUTE PARALLEL DO
!$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO COLLAPSE(2) PRIVATE(IND0, IND1, INDS, INDF, Z_TAURAY)
DO i_lay = 1, laytrop_min
DO iplon = KIDIA, KFDIA
ind0 = ((k_jp(iplon,i_lay)-1)*5+(k_jt(iplon,i_lay)-1))*nspa(20) + 1
ind1 = (k_jp(iplon,i_lay)*5+(k_jt1(iplon,i_lay)-1))*nspa(20) + 1
inds = k_indself(iplon,i_lay)
indf = k_indfor(iplon,i_lay)
z_tauray = p_colmol(iplon,i_lay) * rayl
!$NEC unroll(NG20)
DO ig = 1 , ng20
p_taug(iplon,i_lay,ig) = p_colh2o(iplon,i_lay) * &
& ((p_fac00(iplon,i_lay) * absa(ind0,ig) + &
& p_fac10(iplon,i_lay) * absa(ind0+1,ig) + &
& p_fac01(iplon,i_lay) * absa(ind1,ig) + &
& p_fac11(iplon,i_lay) * absa(ind1+1,ig)) + &
& p_selffac(iplon,i_lay) * (selfrefc(inds,ig) + &
& p_selffrac(iplon,i_lay) * &
& (selfrefc(inds+1,ig) - selfrefc(inds,ig))) + &
& p_forfac(iplon,i_lay) * (forrefc(indf,ig) + &
& p_forfrac(iplon,i_lay) * &
& (forrefc(indf+1,ig) - forrefc(indf,ig)))) &
& + p_colch4(iplon,i_lay) * absch4c(ig)
p_taur(iplon,i_lay,ig) = z_tauray
IF(i_lay == i_laysolfr(iplon)) p_sfluxzen(iplon,ig)=sfluxrefc(ig)
ENDDO
ENDDO
ENDDO
!$OMP END TARGET TEAMS DISTRIBUTE PARALLEL DO
#else
!$ACC LOOP SEQ
DO i_lay = 1, llaytrop_min
!$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO PRIVATE(IND0, IND1, INDS, INDF, Z_TAURAY)
Expand Down Expand Up @@ -127,6 +166,7 @@ SUBROUTINE SRTM_TAUMOL20 &
ENDDO
!$OMP END TARGET TEAMS DISTRIBUTE PARALLEL DO
ENDDO
#endif

!$ACC LOOP SEQ
DO i_lay = llaytrop_min+1, llaytrop_max
Expand Down
55 changes: 55 additions & 0 deletions ifsrrtm/srtm_taumol21.F90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -96,7 +96,61 @@ SUBROUTINE SRTM_TAUMOL21 &
ENDDO
!$OMP END TARGET TEAMS DISTRIBUTE PARALLEL DO

#if defined(OMPGPU)
!$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO
DO iplon = KIDIA, KFDIA
DO i_lay = 1, laytrop_min
IF (k_jp(iplon,i_lay) < layreffr &
& .AND. k_jp(iplon,i_lay+1) >= layreffr) &
& i_laysolfr(iplon) = MIN(i_lay+1,k_laytrop(iplon))
ENDDO
ENDDO
!$OMP END TARGET TEAMS DISTRIBUTE PARALLEL DO
!$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO COLLAPSE(2) PRIVATE(ind0, ind1, inds, indf, js, z_fs, &
!$OMP z_speccomb, z_specmult, z_specparm, z_tauray)
DO i_lay = 1, laytrop_min
DO iplon = KIDIA, KFDIA
z_speccomb = p_colh2o(iplon,i_lay) + strrat*p_colco2(iplon,i_lay)
z_specparm = p_colh2o(iplon,i_lay)/z_speccomb
z_specparm = MIN(p_oneminus(iplon),z_specparm)
z_specmult = 8._JPRB*(z_specparm)
js = 1 + INT(z_specmult)
z_fs = z_specmult - AINT(z_specmult)
ind0 = ((k_jp(iplon,i_lay)-1)*5+(k_jt(iplon,i_lay)-1))*nspa(21) + js
ind1 = (k_jp(iplon,i_lay)*5+(k_jt1(iplon,i_lay)-1))*nspa(21) + js
inds = k_indself(iplon,i_lay)
indf = k_indfor(iplon,i_lay)
z_tauray = p_colmol(iplon,i_lay) * rayl

!$NEC unroll(NG21)
DO ig = 1 , ng21
p_taug(iplon,i_lay,ig) = z_speccomb * &
& ( &
& (1._JPRB- z_fs) * ( absa(ind0,ig) * p_fac00(iplon,i_lay) + &
& absa(ind0+9,ig) * p_fac10(iplon,i_lay) + &
& absa(ind1,ig) * p_fac01(iplon,i_lay) + &
& absa(ind1+9,ig) * p_fac11(iplon,i_lay) )+ &
& z_fs * ( absa(ind0+1,ig) * p_fac00(iplon,i_lay) + &
& absa(ind0+10,ig) * p_fac10(iplon,i_lay) + &
& absa(ind1+1,ig) * p_fac01(iplon,i_lay) + &
& absa(ind1+10,ig) * p_fac11(iplon,i_lay) ) &
& ) + &
& p_colh2o(iplon,i_lay) * &
& (p_selffac(iplon,i_lay) * (selfrefc(inds,ig) + &
& p_selffrac(iplon,i_lay) * &
& (selfrefc(inds+1,ig) - selfrefc(inds,ig))) + &
& p_forfac(iplon,i_lay) * (forrefc(indf,ig) + &
& p_forfrac(iplon,i_lay) * &
& (forrefc(indf+1,ig) - forrefc(indf,ig))))
IF (i_lay == i_laysolfr(iplon)) &
& p_sfluxzen(iplon,ig) = sfluxrefc(ig,js) &
& + z_fs * (sfluxrefc(ig,js+1) - sfluxrefc(ig,js))
p_taur(iplon,i_lay,ig) = z_tauray
ENDDO
ENDDO
ENDDO
!$OMP END TARGET TEAMS DISTRIBUTE PARALLEL DO
#else
!$ACC LOOP SEQ
DO i_lay = 1, llaytrop_min
!$OMP TARGET TEAMS DISTRIBUTE PARALLEL DO PRIVATE(ind0, ind1, inds, indf, js, z_fs, &
Expand Down Expand Up @@ -148,6 +202,7 @@ SUBROUTINE SRTM_TAUMOL21 &
ENDDO
!$OMP END TARGET TEAMS DISTRIBUTE PARALLEL DO
ENDDO
#endif

!$ACC LOOP SEQ
DO i_lay = llaytrop_min+1, llaytrop_max
Expand Down
Loading
Loading