From a48d6e8ff1db0e602f899515bae21af30e6bd9e4 Mon Sep 17 00:00:00 2001 From: ezhilsabareesh8 Date: Fri, 26 Jun 2026 11:20:50 +1000 Subject: [PATCH 1/5] Avoid ST6 IRANGE heap allocations in source loops --- model/src/w3src6md.F90 | 29 +++++++++++++++++++++-------- model/src/w3swldmd.F90 | 5 +++-- 2 files changed, 24 insertions(+), 10 deletions(-) diff --git a/model/src/w3src6md.F90 b/model/src/w3src6md.F90 index 354d425cd8..28cac6d0ae 100644 --- a/model/src/w3src6md.F90 +++ b/model/src/w3src6md.F90 @@ -435,8 +435,9 @@ SUBROUTINE W3SIN6 (A, CG, WN2, UABS, USTAR, USDIR, CD, DAIR, & ECOS2 = ECOS(1:NSPEC) ! Only indices from 1 to NSPEC ESIN2 = ESIN(1:NSPEC) ! are requested. ! - IKN = IRANGE(1,NSPEC,NTH) ! Index vector for elements of 1 ... NK - ! ! such that e.g. SIG(1:NK) = SIG2(IKN). + DO IK = 1, NK + IKN(IK) = 1 + (IK-1)*NTH + END DO DSII2 = DDEN2 / DTH / SIG2 ! Frequency bandwidths (int.) (rad) DSII = DSII2(IKN) SIG = SIG2(IKN) @@ -673,9 +674,9 @@ SUBROUTINE W3SDS6 (A, CG, WN, S, D) #endif ! !/ 0) --- Initialize essential parameters ---------------------------- / - IKN = IRANGE(1,NSPEC,NTH) ! Index vector for elements of 1, - ! ! 2,..., NK such that for example - ! ! SIG(1:NK) = SIG2(IKN). + DO IK = 1, NK + IKN(IK) = 1 + (IK-1)*NTH + END DO FREQ = SIG2(IKN)/TPI ANAR = 1.0 BNT = 0.035**2 @@ -899,7 +900,9 @@ SUBROUTINE LFACTOR(S, CINV, U10, USTAR, USDIR, SIG, DSII, & NK10Hz = MAX(NK,NK10Hz) ! ALLOCATE(IK10Hz(NK10Hz)) - IK10Hz = REAL( IRANGE(1,NK10Hz,1) ) + DO IK = 1, NK10Hz + IK10Hz(IK) = REAL(IK) + END DO ! ALLOCATE(SIG10Hz(NK10Hz)) ALLOCATE(CINV10Hz(NK10Hz)) @@ -1134,7 +1137,7 @@ SUBROUTINE TAU_WAVE_ATMOS(S, CINV, SIG, DSII, TAUNWX, TAUNWY ) INTEGER, SAVE :: IENT = 0 #endif REAL, PARAMETER :: FRQMAX = 10. ! Upper freq. limit to extrapolate to. - INTEGER :: NK10Hz + INTEGER :: NK10Hz, I ! REAL :: ECOS2(NSPEC), ESIN2(NSPEC) REAL, ALLOCATABLE :: IK10Hz(:), SIG10Hz(:), CINV10Hz(:) @@ -1152,7 +1155,9 @@ SUBROUTINE TAU_WAVE_ATMOS(S, CINV, SIG, DSII, TAUNWX, TAUNWY ) NK10Hz = MAX(NK,NK10Hz) ! ALLOCATE(IK10Hz(NK10Hz)) - IK10Hz = REAL( IRANGE(1,NK10Hz,1) ) + DO I = 1, NK10Hz + IK10Hz(I) = REAL(I) + END DO ! ALLOCATE(SIG10Hz(NK10Hz)) ALLOCATE(CINV10Hz(NK10Hz)) @@ -1193,6 +1198,14 @@ SUBROUTINE TAU_WAVE_ATMOS(S, CINV, SIG, DSII, TAUNWX, TAUNWY ) ! --- The wave supported stress (waves to atmosphere) ------------ / TAUNWX = TAUWINDS(SDENSX10Hz,CINV10Hz,DSII10Hz) ! x-component TAUNWY = TAUWINDS(SDENSY10Hz,CINV10Hz,DSII10Hz) ! y-component + ! + IF (ALLOCATED(IK10Hz)) DEALLOCATE(IK10Hz) + IF (ALLOCATED(SIG10Hz)) DEALLOCATE(SIG10Hz) + IF (ALLOCATED(CINV10Hz)) DEALLOCATE(CINV10Hz) + IF (ALLOCATED(DSII10Hz)) DEALLOCATE(DSII10Hz) + IF (ALLOCATED(SDENSX10Hz)) DEALLOCATE(SDENSX10Hz) + IF (ALLOCATED(SDENSY10Hz)) DEALLOCATE(SDENSY10Hz) + IF (ALLOCATED(UCINV10Hz)) DEALLOCATE(UCINV10Hz) !/ END SUBROUTINE TAU_WAVE_ATMOS !/ ------------------------------------------------------------------- / diff --git a/model/src/w3swldmd.F90 b/model/src/w3swldmd.F90 index 6b8a93a95c..fb88096fda 100644 --- a/model/src/w3swldmd.F90 +++ b/model/src/w3swldmd.F90 @@ -351,8 +351,9 @@ SUBROUTINE W3SWL6 (A, CG, WN, S, D) #endif ! !/ 0) --- Initialize parameters -------------------------------------- / - IKN = IRANGE(1,NSPEC,NTH) ! Index vector for array access, e.g. - ! ! in form of WN(1:NK) == WN2(IKN). + DO IK = 1, NK + IKN(IK) = 1 + (IK-1)*NTH + END DO ABAND = SUM(RESHAPE(A,(/ NTH,NK /)),1) ! action density as function of wavenumber DDIS = 0. D = 0. From 65b55f7907c69c15ee32efd7cf28205f0b46c34b Mon Sep 17 00:00:00 2001 From: ezhilsabareesh8 Date: Thu, 2 Jul 2026 10:09:35 +1000 Subject: [PATCH 2/5] Remove the explicit DEALLOCATE block --- model/src/w3src6md.F90 | 8 -------- 1 file changed, 8 deletions(-) diff --git a/model/src/w3src6md.F90 b/model/src/w3src6md.F90 index 28cac6d0ae..73e8053235 100644 --- a/model/src/w3src6md.F90 +++ b/model/src/w3src6md.F90 @@ -1198,14 +1198,6 @@ SUBROUTINE TAU_WAVE_ATMOS(S, CINV, SIG, DSII, TAUNWX, TAUNWY ) ! --- The wave supported stress (waves to atmosphere) ------------ / TAUNWX = TAUWINDS(SDENSX10Hz,CINV10Hz,DSII10Hz) ! x-component TAUNWY = TAUWINDS(SDENSY10Hz,CINV10Hz,DSII10Hz) ! y-component - ! - IF (ALLOCATED(IK10Hz)) DEALLOCATE(IK10Hz) - IF (ALLOCATED(SIG10Hz)) DEALLOCATE(SIG10Hz) - IF (ALLOCATED(CINV10Hz)) DEALLOCATE(CINV10Hz) - IF (ALLOCATED(DSII10Hz)) DEALLOCATE(DSII10Hz) - IF (ALLOCATED(SDENSX10Hz)) DEALLOCATE(SDENSX10Hz) - IF (ALLOCATED(SDENSY10Hz)) DEALLOCATE(SDENSY10Hz) - IF (ALLOCATED(UCINV10Hz)) DEALLOCATE(UCINV10Hz) !/ END SUBROUTINE TAU_WAVE_ATMOS !/ ------------------------------------------------------------------- / From a4e8ae0b8d1bd5fa6c3ee00d7e645462d6bb4164 Mon Sep 17 00:00:00 2001 From: ezhilsabareesh8 Date: Thu, 2 Jul 2026 14:02:46 +1000 Subject: [PATCH 3/5] Avoid ST6 IRANGE heap allocations in source loops --- model/src/w3src6md.F90 | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/model/src/w3src6md.F90 b/model/src/w3src6md.F90 index 73e8053235..28cac6d0ae 100644 --- a/model/src/w3src6md.F90 +++ b/model/src/w3src6md.F90 @@ -1198,6 +1198,14 @@ SUBROUTINE TAU_WAVE_ATMOS(S, CINV, SIG, DSII, TAUNWX, TAUNWY ) ! --- The wave supported stress (waves to atmosphere) ------------ / TAUNWX = TAUWINDS(SDENSX10Hz,CINV10Hz,DSII10Hz) ! x-component TAUNWY = TAUWINDS(SDENSY10Hz,CINV10Hz,DSII10Hz) ! y-component + ! + IF (ALLOCATED(IK10Hz)) DEALLOCATE(IK10Hz) + IF (ALLOCATED(SIG10Hz)) DEALLOCATE(SIG10Hz) + IF (ALLOCATED(CINV10Hz)) DEALLOCATE(CINV10Hz) + IF (ALLOCATED(DSII10Hz)) DEALLOCATE(DSII10Hz) + IF (ALLOCATED(SDENSX10Hz)) DEALLOCATE(SDENSX10Hz) + IF (ALLOCATED(SDENSY10Hz)) DEALLOCATE(SDENSY10Hz) + IF (ALLOCATED(UCINV10Hz)) DEALLOCATE(UCINV10Hz) !/ END SUBROUTINE TAU_WAVE_ATMOS !/ ------------------------------------------------------------------- / From ad9870efab9d56963b83b064d4aba5e1058c2b37 Mon Sep 17 00:00:00 2001 From: ezhilsabareesh8 Date: Thu, 2 Jul 2026 14:23:36 +1000 Subject: [PATCH 4/5] Remove IRANGE --- model/src/w3src6md.F90 | 52 +------------------------------------- model/src/w3swldmd.F90 | 57 +++--------------------------------------- 2 files changed, 5 insertions(+), 104 deletions(-) diff --git a/model/src/w3src6md.F90 b/model/src/w3src6md.F90 index 28cac6d0ae..cda031354f 100644 --- a/model/src/w3src6md.F90 +++ b/model/src/w3src6md.F90 @@ -73,7 +73,6 @@ MODULE W3SRC6MD ! W3SIN6 Subr. Public Observation-based wind input. ! W3SDS6 Subr. Public Observation-based dissipation. ! - ! IRANGE Func. Private Generate a sequence of integer values. ! LFACTOR Func. Private Calculate reduction factor for Sin. ! TAUWINDS Func. Private Normal stress calculation for Sin. ! ---------------------------------------------------------------- @@ -97,7 +96,7 @@ MODULE W3SRC6MD !/ ------------------------------------------------------------------- / !/ PUBLIC :: W3SPR6, W3SIN6, W3SDS6 - PRIVATE :: LFACTOR, TAUWINDS, IRANGE + PRIVATE :: LFACTOR, TAUWINDS CONTAINS !/ ------------------------------------------------------------------- / @@ -343,7 +342,6 @@ SUBROUTINE W3SIN6 (A, CG, WN2, UABS, USTAR, USDIR, CD, DAIR, & ! Name Type Module Description ! ---------------------------------------------------------------- ! LFACTOR Subr. W3SRC6MD - ! IRANGE Func. W3SRC6MD ! STRACE Subr. W3SERVMD Subroutine tracing. ! ---------------------------------------------------------------- ! @@ -834,7 +832,6 @@ SUBROUTINE LFACTOR(S, CINV, U10, USTAR, USDIR, SIG, DSII, & ! Name Type Scope Description ! ---------------------------------------------------------------- ! STRACE Subr. W3SERVMD Subroutine tracing. - ! IRANGE Func. Private Index generator (ie, array addressing) ! TAUWINDS Func. Private Normal stress calculation (TAU_NRM) ! ---------------------------------------------------------------- ! @@ -1111,7 +1108,6 @@ SUBROUTINE TAU_WAVE_ATMOS(S, CINV, SIG, DSII, TAUNWX, TAUNWY ) ! Name Type Scope Description ! ---------------------------------------------------------------- ! STRACE Subr. W3SERVMD Subroutine tracing. - ! IRANGE Func. Private Index generator (ie, array addressing) ! TAUWINDS Func. Private Normal stress calculation (TAU_NRM) ! ---------------------------------------------------------------- ! @@ -1211,52 +1207,6 @@ END SUBROUTINE TAU_WAVE_ATMOS !/ ------------------------------------------------------------------- / !/ - !> - !> @brief Generate a sequence of linear-spaced integer numbers. - !> - !> @details Used for instance array addressing (indexing). - !> - !> @param X0 - !> @param X1 - !> @param DX - !> @returns IX - !> - !> @author S. Zieger - !> @date 15-Feb-2011 - !> - FUNCTION IRANGE(X0,X1,DX) RESULT(IX) - !/ - !/ +-----------------------------------+ - !/ | WAVEWATCH III NOAA/NCEP | - !/ | S. Zieger | - !/ | FORTRAN 90 | - !/ | Last update : 15-Feb-2011 | - !/ +-----------------------------------+ - !/ - !/ 15-Feb-2011 : Origination ( version 4.04 ) - !/ (S. Zieger) - !/ - ! 1. Purpose : - ! Generate a sequence of linear-spaced integer numbers. - ! Used for instance array addressing (indexing). - ! - !/ - IMPLICIT NONE - INTEGER, INTENT(IN) :: X0, X1, DX - INTEGER, ALLOCATABLE :: IX(:) - INTEGER :: N - INTEGER :: I - ! - N = INT(REAL(X1-X0)/REAL(DX))+1 - ALLOCATE(IX(N)) - DO I = 1, N - IX(I) = X0+ (I-1)*DX - END DO - !/ - END FUNCTION IRANGE - !/ ------------------------------------------------------------------- / - !/ - !> !> @brief Wind stress (tau) computation from wind-momentum-input. !> diff --git a/model/src/w3swldmd.F90 b/model/src/w3swldmd.F90 index fb88096fda..5e299c9a66 100644 --- a/model/src/w3swldmd.F90 +++ b/model/src/w3swldmd.F90 @@ -49,7 +49,6 @@ MODULE W3SWLDMD ! W3SWL4 Subr. Public Ardhuin et al (2010+) swell dissipation ! W3SWL6 Subr. Public Babanin (2011) swell dissipation ! - ! IRANGE Func. Private Generate a sequence of integer values ! ---------------------------------------------------------------- ! ! 4. Subroutines and functions used : @@ -71,7 +70,6 @@ MODULE W3SWLDMD !/ ------------------------------------------------------------------- / !/ PUBLIC :: W3SWL4, W3SWL6 - PRIVATE :: IRANGE !/ CONTAINS !/ ------------------------------------------------------------------- / @@ -126,7 +124,6 @@ SUBROUTINE W3SWL4 (A, CG, WN, DAIR, S, D) ! ! Name Type Module Description ! ---------------------------------------------------------------- - ! IRANGE Func. W3SWLDMD ! STRACE Subr. W3SERVMD Subroutine tracing. ! ---------------------------------------------------------------- ! @@ -174,7 +171,7 @@ SUBROUTINE W3SWL4 (A, CG, WN, DAIR, S, D) #ifdef W3_S INTEGER, SAVE :: IENT = 0 #endif - INTEGER :: IKN(NK), ITH + INTEGER :: IKN(NK), ITH, IK REAL, PARAMETER :: VA = 1.4E-5 ! Air kinematic viscosity (used in WAM). REAL :: EB(NK), WN2(NSPEC), EMEAN REAL :: FE, AORB, RE, RECRIT, UOSIG, CDSV @@ -185,7 +182,9 @@ SUBROUTINE W3SWL4 (A, CG, WN, DAIR, S, D) CALL STRACE (IENT, 'W3SWL4') #endif ! - IKN = IRANGE(1,NSPEC,NTH) + DO IK = 1, NK + IKN(IK) = 1 + (IK-1)*NTH + END DO D = 0. WN2 = 0. ! @@ -288,7 +287,6 @@ SUBROUTINE W3SWL6 (A, CG, WN, S, D) ! ! Name Type Module Description ! ---------------------------------------------------------------- - ! IRANGE Func. W3SWLDMD ! STRACE Subr. W3SERVMD Subroutine tracing. ! ---------------------------------------------------------------- ! @@ -414,51 +412,4 @@ SUBROUTINE W3SWL6 (A, CG, WN, S, D) END SUBROUTINE W3SWL6 !/ ------------------------------------------------------------------- / !/ - !> - !> @brief Generate a linear-spaced sequence of integer numbers. - !> - !> @details Used for array addressing (indexing). - !> - !> @param X0 - !> @param X1 - !> @param DX - !> @returns IX - !> - !> @author H. L. Tolman - !> @author S. Zieger - !> @date 15-Feb-2011 - !> - FUNCTION IRANGE(X0,X1,DX) RESULT(IX) - !/ - !/ +-----------------------------------+ - !/ | WAVEWATCH III NOAA/NCEP | - !/ | H. L. Tolman | - !/ | S. Zieger | - !/ | FORTRAN 90 | - !/ | Last update : 15-Feb-2011 | - !/ +-----------------------------------+ - !/ - !/ 15-Feb-2011 : Origination from W3SRC6MD ( version 4.07 ) - !/ (S. Zieger) - !/ - ! 1. Purpose : - ! Generate a linear-spaced sequence of integer - ! numbers. Used for array addressing (indexing). - ! - !/ - IMPLICIT NONE - INTEGER, INTENT(IN) :: X0, X1, DX - INTEGER, ALLOCATABLE :: IX(:) - INTEGER :: N - INTEGER :: I - ! - N = INT(REAL(X1-X0)/REAL(DX))+1 - ALLOCATE(IX(N)) - DO I = 1, N - IX(I) = X0+ (I-1)*DX - END DO - !/ - END FUNCTION IRANGE - !/ ------------------------------------------------------------------- / - !/ END MODULE W3SWLDMD From 10fa061d11db9fcf442b9587f1718b4c28f6682d Mon Sep 17 00:00:00 2001 From: ezhilsabareesh8 Date: Fri, 3 Jul 2026 09:52:34 +1000 Subject: [PATCH 5/5] Remove the explicit DEALLOCATE block --- model/src/w3src6md.F90 | 8 -------- 1 file changed, 8 deletions(-) diff --git a/model/src/w3src6md.F90 b/model/src/w3src6md.F90 index cda031354f..12c6f860c3 100644 --- a/model/src/w3src6md.F90 +++ b/model/src/w3src6md.F90 @@ -1194,14 +1194,6 @@ SUBROUTINE TAU_WAVE_ATMOS(S, CINV, SIG, DSII, TAUNWX, TAUNWY ) ! --- The wave supported stress (waves to atmosphere) ------------ / TAUNWX = TAUWINDS(SDENSX10Hz,CINV10Hz,DSII10Hz) ! x-component TAUNWY = TAUWINDS(SDENSY10Hz,CINV10Hz,DSII10Hz) ! y-component - ! - IF (ALLOCATED(IK10Hz)) DEALLOCATE(IK10Hz) - IF (ALLOCATED(SIG10Hz)) DEALLOCATE(SIG10Hz) - IF (ALLOCATED(CINV10Hz)) DEALLOCATE(CINV10Hz) - IF (ALLOCATED(DSII10Hz)) DEALLOCATE(DSII10Hz) - IF (ALLOCATED(SDENSX10Hz)) DEALLOCATE(SDENSX10Hz) - IF (ALLOCATED(SDENSY10Hz)) DEALLOCATE(SDENSY10Hz) - IF (ALLOCATED(UCINV10Hz)) DEALLOCATE(UCINV10Hz) !/ END SUBROUTINE TAU_WAVE_ATMOS !/ ------------------------------------------------------------------- /