From d7abf08e22e345e74bbc2ca648666daeb4c937d7 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 18 Feb 2022 09:09:05 -0500 Subject: [PATCH 1/7] Fixes #1382. Update NRL solar table read code --- CHANGELOG.md | 3 +- base/MAPL_sun_uc.F90 | 405 +++++++++++++++++++----------------------- include/MAPL_ErrLog.h | 12 +- 3 files changed, 197 insertions(+), 223 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index e2e11e028613..34158b431a79 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -17,7 +17,6 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Fixed io profiler report format - Fixed issue on macOS where enabling memutils caused crash - ### Added - New gauge for measuring memory allocation based upon mallinfo(). @@ -29,9 +28,11 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Updates to CircleCI - Added GEOSadas CI ifort build test - Add "like-UFS" build to CI. This is no FLAP and pFlogger, and static build +- Added new `_STAT` and `_IOSTAT` macros a la `_RC` ### Changed +- Updated `MAPL_SunGetSolarConstantFromNRLFile` to open NRL Solar Table file only on root and broadcast the tables to all processes. Now all processes do interpolation. - Major refactoring of GenericSetServices Work is not completed, but a new layer is introduced with the intent that the user SetServices is called from with in the new layer as opposed to the previous mechanism that obligated user SetServices to call diff --git a/base/MAPL_sun_uc.F90 b/base/MAPL_sun_uc.F90 index 0773fe2cede3..2cd7f26452b9 100644 --- a/base/MAPL_sun_uc.F90 +++ b/base/MAPL_sun_uc.F90 @@ -2475,54 +2475,45 @@ subroutine MAPL_SunGetSolarConstantFromNRLFile(CLOCK,filename_in,SC,MG,SB,Persis CREATE_TABLE: if (.not. TableCreated) then - ! Open the file - ! ------------- - - filename = trim(filename_in) - - ! Does the file exist? - inquire( FILE=filename, EXIST=found ) - _ASSERT( found ,'Could not find NRL data file '//trim(filename) ) - - UNIT = GETFILE(filename, DO_OPEN=0, form="formatted", rc=status) - _VERIFY(STATUS) - - open(unit=unit, file=filename) + ! First we open the file on root to get the + ! number of lines so we can allocate our tables + ! --------------------------------------------- if (amIRoot) then + ! Open the file + ! ------------- + filename = trim(filename_in) + open(newunit=unit, file=filename, form="formatted", status="old", iostat=status) + _ASSERT(status==0,'Could not find NRL data file '// filename ) + ! Determine length of file ! ------------------------ - call lgr%debug("Scanning the Solar Table to determine number of data points") - numlines = num_lines_in_file(UNIT) - call lgr%debug("Solar Table Data Points: %i0", numlines) - ! Allocate our arrays - ! ------------------- - - allocate(yearTable(numlines), source=0, stat=status) - _VERIFY(STATUS) + ! Broadcast the number of lines + ! ----------------------------- + call MAPL_CommsBcast(vm, DATA=numlines, N=1, ROOT=0, _RC) - allocate(doyTable(numlines), source=0, stat=status) - _VERIFY(STATUS) + end if - allocate(tsi(numlines), source=0.0, stat=status) - _VERIFY(STATUS) + ! Allocate our arrays on all processes + ! ------------------------------------ - allocate(mgindex(numlines), source=0.0, stat=status) - _VERIFY(STATUS) + allocate(yearTable(numlines), source=0, _STAT) + allocate(doyTable(numlines), source=0, _STAT) + allocate(tsi(numlines), source=0.0, _STAT) + allocate(mgindex(numlines), source=0.0, _STAT) + allocate(sbindex(numlines), source=0.0, _STAT) - allocate(sbindex(numlines), source=0.0, stat=status) - _VERIFY(STATUS) + ! Back to root to read in the values + ! ---------------------------------- - ! Read in arrays - ! -------------- + if (amIRoot) then call lgr%debug("Reading the Solar Table") - i = 1 do read(unit,'(A)',iostat=stat) line @@ -2536,221 +2527,195 @@ subroutine MAPL_SunGetSolarConstantFromNRLFile(CLOCK,filename_in,SC,MG,SB,Persis ! Belt and suspenders check that all data was read _ASSERT(size(yearTable) == numlines,"Inconsistency in NRL number of lines") + call close(unit, _IOSTAT) + end if - ! Close the file - ! -------------- + ! Broadcast the tables + ! -------------------- - call FREE_FILE(UNIT) + call MAPL_CommsBcast(vm, DATA=yearTable, N=numlines, ROOT=0, _RC) + call MAPL_CommsBcast(vm, DATA=doyTable, N=numlines, ROOT=0, _RC) + call MAPL_CommsBcast(vm, DATA=tsi, N=numlines, ROOT=0, _RC) + call MAPL_CommsBcast(vm, DATA=mgindex, N=numlines, ROOT=0, _RC) + call MAPL_CommsBcast(vm, DATA=sbindex, N=numlines, ROOT=0, _RC) TableCreated = .TRUE. end if CREATE_TABLE - ON_ROOT: if (amIRoot) then - - ! Now we need to find the two bracketing days - ! ------------------------------------------- - - ! Get current time - ! ---------------- - call ESMF_ClockGet(CLOCK, CURRTIME=currentTime, RC=STATUS) - _VERIFY(STATUS) + ! Now we need to find the two bracketing days + ! ------------------------------------------- - call ESMF_TimeGet( currentTime, YY = currentYear, & - MM = currentMon, & - DD = currentDay, & - dayOfYear = currentDOY, & - RC = STATUS ) - _VERIFY(STATUS) + ! Get current time + ! ---------------- + call ESMF_ClockGet(CLOCK, CURRTIME=currentTime, _RC) - ! Test if current time is outside our file - ! ---------------------------------------- + call ESMF_TimeGet( currentTime, YY = currentYear, & + MM = currentMon, & + DD = currentDay, & + dayOfYear = currentDOY, _RC) - outOfTable = .FALSE. + ! Test if current time is outside our file + ! ---------------------------------------- - ! First is current year higher than last in file... - if ( currentYear > yearTable(numlines) ) then - outOfTable = .TRUE. - ! ...or if a partial year, are we near the end - else if ( currentYear == yearTable(numlines) .and. currentDOY >= doyTable(numlines)) then - outOfTable = .TRUE. - end if + outOfTable = .FALSE. - ! If we are out of the table and not persisting, we must - ! recenter our day to be based on the last complete Solar Cycle - ! ------------------------------------------------------------- - OUT_OF_TABLE_AND_CYCLE: if ( outOfTable .and. (.not. PersistSolar_) ) then - - ! Create an ESMF_Time at start of Cycle 24 - ! ---------------------------------------- - call ESMF_TimeSet( startCycle24, YY = 2008, & - MM = 12, & - DD = 1, & - H = 12, & - M = 00, & - S = 00, & - RC = STATUS ) - _VERIFY(STATUS) - - ! Create an ESMF_Time at start of Cycle 25 - ! ---------------------------------------- - call ESMF_TimeSet( startCycle25, YY = 2019, & - MM = 12, & - DD = 1, & - H = 12, & - M = 00, & - S = 00, & - RC = STATUS ) - _VERIFY(STATUS) - - ! Create TimeInterval based on interval - ! from start of latest Cycle 25 - ! ------------------------------------- - - timeSinceStartOfCycle25 = currentTime - startCycle25 + ! First is current year higher than last in file... + if ( currentYear > yearTable(numlines) ) then + outOfTable = .TRUE. + ! ...or if a partial year, are we near the end + else if ( currentYear == yearTable(numlines) .and. currentDOY >= doyTable(numlines)) then + outOfTable = .TRUE. + end if - ! Make a new time based on that - ! interval past start of Cycle 24 - ! ------------------------------- + ! If we are out of the table and not persisting, we must + ! recenter our day to be based on the last complete Solar Cycle + ! ------------------------------------------------------------- + OUT_OF_TABLE_AND_CYCLE: if ( outOfTable .and. (.not. PersistSolar_) ) then - timeBasedOnCycle24 = startCycle24 + timeSinceStartOfCycle25 + ! Create an ESMF_Time at start of Cycle 24 + ! ---------------------------------------- + call ESMF_TimeSet( startCycle24, YY = 2008, & + MM = 12, & + DD = 1, & + H = 12, & + M = 00, & + S = 00, _RC) + + ! Create an ESMF_Time at start of Cycle 25 + ! ---------------------------------------- + call ESMF_TimeSet( startCycle25, YY = 2019, & + MM = 12, & + DD = 1, & + H = 12, & + M = 00, & + S = 00, _RC) + + ! Create TimeInterval based on interval + ! from start of latest Cycle 25 + ! ------------------------------------- - ! Store our original time just in case - ! ------------------------------------ - origTime = currentTime - originalYear = currentYear - originalMon = currentMon - originalDay = currentDay - origDOY = currentDOY + timeSinceStartOfCycle25 = currentTime - startCycle25 - ! Make our "current" time the one calculated above - ! ------------------------------------------------ - currentTime = timeBasedOnCycle24 + ! Make a new time based on that + ! interval past start of Cycle 24 + ! ------------------------------- - ! Get new currentYear, currentMon, currentDay - ! ------------------------------------------- + timeBasedOnCycle24 = startCycle24 + timeSinceStartOfCycle25 - call ESMF_TimeGet( currentTime, YY = currentYear, & - MM = currentMon, & - DD = currentDay, & - dayOfYear = currentDOY, & - RC = STATUS ) - _VERIFY(STATUS) + ! Store our original time just in case + ! ------------------------------------ + origTime = currentTime + originalYear = currentYear + originalMon = currentMon + originalDay = currentDay + origDOY = currentDOY + ! Make our "current" time the one calculated above + ! ------------------------------------------------ + currentTime = timeBasedOnCycle24 - ! Debugging Prints - ! ---------------- - call lgr%debug('Off the end of table, moving into last complete cycle') - call lgr%debug(' Original Year-Mon-Day to Find: %i0.4~-%i0.2~-%i0.2', originalYear,originalMon,originalDay) - call lgr%debug(' Original Day of Year: %i0', origDOY) - call lgr%debug(' New Year-Mon-Day to Find: %i0.4~-%i0.2~-%i0.2', currentYear,currentMon,currentDay) - call lgr%debug(' New Day of Year: %i0', currentDOY) - - end if OUT_OF_TABLE_AND_CYCLE - - ! Create an ESMF_Time on noon of current day - ! ------------------------------------------ - call ESMF_TimeSet( noonCurrentDay, YY = currentYear, & - MM = currentMon, & - DD = currentDay, & - H = 12, & - M = 00, & - S = 00, & - RC = STATUS ) - _VERIFY(STATUS) + ! Get new currentYear, currentMon, currentDay + ! ------------------------------------------- - ! Figure out bracketing days for interpolation - ! NOTE: nextNoon is mainly for debugging purposes - ! ----------------------------------------------- - call ESMF_TimeIntervalSet(oneDayInterval, D=1, rc=status) - if (currentTime <= noonCurrentDay) then - prevNoon = noonCurrentDay - oneDayInterval - nextNoon = noonCurrentDay - else - prevNoon = noonCurrentDay - nextNoon = noonCurrentDay + oneDayInterval - end if + call ESMF_TimeGet( currentTime, YY = currentYear, & + MM = currentMon, & + DD = currentDay, & + dayOfYear = currentDOY, _RC) - ! Get the DOYs - ! ------------ - call ESMF_TimeGet( prevNoon, YY = prevNoonYear, dayOfYear = prevDOY, rc = status ) - call ESMF_TimeGet( nextNoon, YY = nextNoonYear, dayOfYear = nextDOY, rc = status ) + call lgr%debug('Off the end of table, moving into last complete cycle') + call lgr%debug(' Original Year-Mon-Day to Find: %i0.4~-%i0.2~-%i0.2', originalYear,originalMon,originalDay) + call lgr%debug(' Original Day of Year: %i0', origDOY) + call lgr%debug(' New Year-Mon-Day to Find: %i0.4~-%i0.2~-%i0.2', currentYear,currentMon,currentDay) + call lgr%debug(' New Day of Year: %i0', currentDOY) - ! Our interpolation factor is based of when we are compared to the next noon - ! -------------------------------------------------------------------------- - intToNextNoon = nextNoon-currentTime + end if OUT_OF_TABLE_AND_CYCLE - ! The FAC for interpolating is just the real version - ! of the size of the timeinterval to the next noon - ! -------------------------------------------------- - call ESMF_TimeIntervalGet(intToNextNoon, d_r8=days_r8, rc=STATUS) - _VERIFY(STATUS) - FAC = real(days_r8) - - ! Use our find_file_index function to get the index for previous noon - ! ------------------------------------------------------------------- - INDX1 = find_file_index(numlines, yearTable, prevNoonYear, prevDOY) - INDX2 = INDX1 + 1 - - ! If we are outOfTable and we have the PersistSolar - ! option we just use the last value in the table... - ! ------------------------------------------------- - OUT_OF_TABLE_AND_PERSIST: if ( outOfTable .and. PersistSolar_) then - - SC = tsi(numlines) - MG = mgindex(numlines) - SB = sbindex(numlines) - - ! Debugging Prints - ! ---------------- - call lgr%debug('Off the end of table, persisting last values') - call lgr%debug(' tsi at end of table: %F8.3', tsi(numlines)) - call lgr%debug(' mgindex at end of table: %F8.6', mgindex(numlines)) - call lgr%debug(' sbindex at end of table: %F9.4', sbindex(numlines)) - - ! Otherwise we interpolate to the table - ! ------------------------------------- - else + ! Create an ESMF_Time on noon of current day + ! ------------------------------------------ + call ESMF_TimeSet( noonCurrentDay, YY = currentYear, & + MM = currentMon, & + DD = currentDay, & + H = 12, & + M = 00, & + S = 00, _RC) + + ! Figure out bracketing days for interpolation + ! NOTE: nextNoon is mainly for debugging purposes + ! ----------------------------------------------- + call ESMF_TimeIntervalSet(oneDayInterval, D=1, _RC) + if (currentTime <= noonCurrentDay) then + prevNoon = noonCurrentDay - oneDayInterval + nextNoon = noonCurrentDay + else + prevNoon = noonCurrentDay + nextNoon = noonCurrentDay + oneDayInterval + end if - ! Linear Interpolation to the given day-of-month - ! ---------------------------------------------- - - SC = tsi(INDX1)*FAC + tsi(INDX2)*(1.0-FAC) - MG = mgindex(INDX1)*FAC + mgindex(INDX2)*(1.0-FAC) - SB = sbindex(INDX1)*FAC + sbindex(INDX2)*(1.0-FAC) - - ! Debugging Prints - ! ---------------- - call lgr%debug(' First DOY to Find: %i3', prevDOY) - call lgr%debug(' file_index for date: %i6', INDX1) - call lgr%debug(' yearTable(date): %i4', yearTable(INDX1)) - call lgr%debug(' doyTable(date): %i3', doyTable(INDX1)) - call lgr%debug(' tsi(date): %f8.3', tsi(INDX1)) - call lgr%debug(' mgindex(date): %f8.6', mgindex(INDX1)) - call lgr%debug(' sbindex(date): %f9.4', sbindex(INDX1)) - - call lgr%debug(' Second DOY to Find: %i3', nextDOY) - call lgr%debug(' file_index for date: %i6', INDX2) - call lgr%debug(' yearTable(date): %i4', yearTable(INDX2)) - call lgr%debug(' doyTable(date): %i3', doyTable(INDX2)) - call lgr%debug(' tsi(date): %f8.3', tsi(INDX2)) - call lgr%debug(' mgindex(date): %f8.6', mgindex(INDX2)) - call lgr%debug(' sbindex(date): %f9.4', sbindex(INDX2)) - - call lgr%debug(' Interpolation Factor: %f8.6', FAC) - end if OUT_OF_TABLE_AND_PERSIST - end if ON_ROOT - - ! Broadcast the values - ! -------------------- + ! Get the DOYs + ! ------------ + call ESMF_TimeGet( prevNoon, YY = prevNoonYear, dayOfYear = prevDOY, _RC) + call ESMF_TimeGet( nextNoon, YY = nextNoonYear, dayOfYear = nextDOY, _RC) + + ! Our interpolation factor is based of when we are compared to the next noon + ! -------------------------------------------------------------------------- + intToNextNoon = nextNoon-currentTime + + ! The FAC for interpolating is just the real version + ! of the size of the timeinterval to the next noon + ! -------------------------------------------------- + call ESMF_TimeIntervalGet(intToNextNoon, d_r8=days_r8, _RC) + FAC = real(days_r8) + + ! Use our find_file_index function to get the index for previous noon + ! ------------------------------------------------------------------- + INDX1 = find_file_index(numlines, yearTable, prevNoonYear, prevDOY) + INDX2 = INDX1 + 1 + + ! If we are outOfTable and we have the PersistSolar + ! option we just use the last value in the table... + ! ------------------------------------------------- + OUT_OF_TABLE_AND_PERSIST: if ( outOfTable .and. PersistSolar_) then + + SC = tsi(numlines) + MG = mgindex(numlines) + SB = sbindex(numlines) + + call lgr%debug('Off the end of table, persisting last values') + call lgr%debug(' tsi at end of table: %F8.3', tsi(numlines)) + call lgr%debug(' mgindex at end of table: %F8.6', mgindex(numlines)) + call lgr%debug(' sbindex at end of table: %F9.4', sbindex(numlines)) + + ! Otherwise we interpolate to the table + ! ------------------------------------- + else - call MAPL_CommsBcast(vm, DATA=SC, N=1, ROOT=0, RC=status) - _VERIFY(STATUS) - call MAPL_CommsBcast(vm, DATA=MG, N=1, ROOT=0, RC=status) - _VERIFY(STATUS) - call MAPL_CommsBcast(vm, DATA=SB, N=1, ROOT=0, RC=status) - _VERIFY(STATUS) + ! Linear Interpolation to the given day-of-month + ! ---------------------------------------------- + + SC = tsi(INDX1)*FAC + tsi(INDX2)*(1.0-FAC) + MG = mgindex(INDX1)*FAC + mgindex(INDX2)*(1.0-FAC) + SB = sbindex(INDX1)*FAC + sbindex(INDX2)*(1.0-FAC) + + call lgr%debug(' First DOY to Find: %i3', prevDOY) + call lgr%debug(' file_index for date: %i6', INDX1) + call lgr%debug(' yearTable(date): %i4', yearTable(INDX1)) + call lgr%debug(' doyTable(date): %i3', doyTable(INDX1)) + call lgr%debug(' tsi(date): %f8.3', tsi(INDX1)) + call lgr%debug(' mgindex(date): %f8.6', mgindex(INDX1)) + call lgr%debug(' sbindex(date): %f9.4', sbindex(INDX1)) + + call lgr%debug(' Second DOY to Find: %i3', nextDOY) + call lgr%debug(' file_index for date: %i6', INDX2) + call lgr%debug(' yearTable(date): %i4', yearTable(INDX2)) + call lgr%debug(' doyTable(date): %i3', doyTable(INDX2)) + call lgr%debug(' tsi(date): %f8.3', tsi(INDX2)) + call lgr%debug(' mgindex(date): %f8.6', mgindex(INDX2)) + call lgr%debug(' sbindex(date): %f9.4', sbindex(INDX2)) + + call lgr%debug(' Interpolation Factor: %f8.6', FAC) + end if OUT_OF_TABLE_AND_PERSIST _RETURN(ESMF_SUCCESS) diff --git a/include/MAPL_ErrLog.h b/include/MAPL_ErrLog.h index 36e8bb9a69fe..6c5dacb8a597 100644 --- a/include/MAPL_ErrLog.h +++ b/include/MAPL_ErrLog.h @@ -2,7 +2,7 @@ ! The error logging may eventually evolve into a module based ! on the ESMF logger. For now these macros provide simple -! traceback capability. +! traceback capability. #ifndef MAPL_ErrLog_DONE @@ -44,6 +44,12 @@ # ifdef _RC # undef _RC # endif +# ifdef _STAT +# undef _STAT +# endif +# ifdef _IOSTAT +# undef _IOSTAT +# endif # ifdef __return # undef __return # endif @@ -55,7 +61,7 @@ # ifdef I_AM_MAIN # define __return call MAPL_abort() -# define __rc(rc) +# define __rc(rc) # else # define __return return # define __rc(rc) ,rc @@ -92,6 +98,8 @@ # define _RC_(rc,status) rc=status);_VERIFY(status # define _RC _RC_(rc,status) +# define _STAT _RC_(stat,status) +# define _IOSTAT _RC_(iostat,status) # define _ASSERT_MSG_AND_LOC_AND_RC(A,msg,stat,file,line,rc) if(MAPL_Assert(A,msg,stat,file,line __rc(rc))) __return From 52358209775ff1147343688512e94cbce5450c1b Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 18 Feb 2022 09:56:00 -0500 Subject: [PATCH 2/7] close is not a subroutine but a function --- base/MAPL_sun_uc.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/base/MAPL_sun_uc.F90 b/base/MAPL_sun_uc.F90 index 2cd7f26452b9..904ebbcea971 100644 --- a/base/MAPL_sun_uc.F90 +++ b/base/MAPL_sun_uc.F90 @@ -2527,7 +2527,7 @@ subroutine MAPL_SunGetSolarConstantFromNRLFile(CLOCK,filename_in,SC,MG,SB,Persis ! Belt and suspenders check that all data was read _ASSERT(size(yearTable) == numlines,"Inconsistency in NRL number of lines") - call close(unit, _IOSTAT) + close(unit, _IOSTAT) end if From e85cff31aec0134a64cbf4c7b3b3c8e49524400a Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 18 Feb 2022 10:07:28 -0500 Subject: [PATCH 3/7] Bcast on all processes --- base/MAPL_sun_uc.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/base/MAPL_sun_uc.F90 b/base/MAPL_sun_uc.F90 index 904ebbcea971..66b62a6089f8 100644 --- a/base/MAPL_sun_uc.F90 +++ b/base/MAPL_sun_uc.F90 @@ -2493,12 +2493,12 @@ subroutine MAPL_SunGetSolarConstantFromNRLFile(CLOCK,filename_in,SC,MG,SB,Persis numlines = num_lines_in_file(UNIT) call lgr%debug("Solar Table Data Points: %i0", numlines) - ! Broadcast the number of lines - ! ----------------------------- - call MAPL_CommsBcast(vm, DATA=numlines, N=1, ROOT=0, _RC) - end if + ! Broadcast the number of lines + ! ----------------------------- + call MAPL_CommsBcast(vm, DATA=numlines, N=1, ROOT=0, _RC) + ! Allocate our arrays on all processes ! ------------------------------------ From 2428a99e8311495a5b1d9340ff4821358d271028 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 18 Feb 2022 10:46:32 -0500 Subject: [PATCH 4/7] Add Asserts suggested by Peter Norris --- base/MAPL_sun_uc.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/base/MAPL_sun_uc.F90 b/base/MAPL_sun_uc.F90 index 66b62a6089f8..7e387cbdf6c5 100644 --- a/base/MAPL_sun_uc.F90 +++ b/base/MAPL_sun_uc.F90 @@ -2671,7 +2671,9 @@ subroutine MAPL_SunGetSolarConstantFromNRLFile(CLOCK,filename_in,SC,MG,SB,Persis ! Use our find_file_index function to get the index for previous noon ! ------------------------------------------------------------------- INDX1 = find_file_index(numlines, yearTable, prevNoonYear, prevDOY) + _ASSERT(INDX1 /= YEAR_NOT_FOUND, 'dropped off end of NRL table v1') INDX2 = INDX1 + 1 + _ASSERT(INDX2 <= numlines, 'dropped off end of NRL table v2') ! If we are outOfTable and we have the PersistSolar ! option we just use the last value in the table... From f9c36ce50e322261e7998a33b93530f5f855dc84 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 18 Feb 2022 13:05:23 -0500 Subject: [PATCH 5/7] Last asserts were in wrong place. Remove for now --- base/MAPL_sun_uc.F90 | 2 -- 1 file changed, 2 deletions(-) diff --git a/base/MAPL_sun_uc.F90 b/base/MAPL_sun_uc.F90 index 7e387cbdf6c5..66b62a6089f8 100644 --- a/base/MAPL_sun_uc.F90 +++ b/base/MAPL_sun_uc.F90 @@ -2671,9 +2671,7 @@ subroutine MAPL_SunGetSolarConstantFromNRLFile(CLOCK,filename_in,SC,MG,SB,Persis ! Use our find_file_index function to get the index for previous noon ! ------------------------------------------------------------------- INDX1 = find_file_index(numlines, yearTable, prevNoonYear, prevDOY) - _ASSERT(INDX1 /= YEAR_NOT_FOUND, 'dropped off end of NRL table v1') INDX2 = INDX1 + 1 - _ASSERT(INDX2 <= numlines, 'dropped off end of NRL table v2') ! If we are outOfTable and we have the PersistSolar ! option we just use the last value in the table... From 9c54e213b5994cd48f881c7400f3612d0e931ddd Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 18 Feb 2022 13:09:37 -0500 Subject: [PATCH 6/7] Update base/MAPL_sun_uc.F90 Co-authored-by: Tom Clune --- base/MAPL_sun_uc.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/base/MAPL_sun_uc.F90 b/base/MAPL_sun_uc.F90 index 66b62a6089f8..ef4271aa1da5 100644 --- a/base/MAPL_sun_uc.F90 +++ b/base/MAPL_sun_uc.F90 @@ -2485,7 +2485,7 @@ subroutine MAPL_SunGetSolarConstantFromNRLFile(CLOCK,filename_in,SC,MG,SB,Persis ! ------------- filename = trim(filename_in) open(newunit=unit, file=filename, form="formatted", status="old", iostat=status) - _ASSERT(status==0,'Could not find NRL data file '// filename ) + _ASSERT(status==0,'Could not find NRL data file '// trim(filename )) ! Determine length of file ! ------------------------ From b6cefa509d194c3597e3bb19507d202e88d963a2 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 22 Feb 2022 13:18:58 -0500 Subject: [PATCH 7/7] Reloop code per Peter Norris --- base/MAPL_sun_uc.F90 | 204 ++++++++++++++++++++++--------------------- 1 file changed, 105 insertions(+), 99 deletions(-) diff --git a/base/MAPL_sun_uc.F90 b/base/MAPL_sun_uc.F90 index ef4271aa1da5..14b9d7166a6f 100644 --- a/base/MAPL_sun_uc.F90 +++ b/base/MAPL_sun_uc.F90 @@ -2569,68 +2569,93 @@ subroutine MAPL_SunGetSolarConstantFromNRLFile(CLOCK,filename_in,SC,MG,SB,Persis outOfTable = .TRUE. end if - ! If we are out of the table and not persisting, we must - ! recenter our day to be based on the last complete Solar Cycle - ! ------------------------------------------------------------- - OUT_OF_TABLE_AND_CYCLE: if ( outOfTable .and. (.not. PersistSolar_) ) then - - ! Create an ESMF_Time at start of Cycle 24 - ! ---------------------------------------- - call ESMF_TimeSet( startCycle24, YY = 2008, & - MM = 12, & - DD = 1, & - H = 12, & - M = 00, & - S = 00, _RC) - - ! Create an ESMF_Time at start of Cycle 25 - ! ---------------------------------------- - call ESMF_TimeSet( startCycle25, YY = 2019, & - MM = 12, & - DD = 1, & - H = 12, & - M = 00, & - S = 00, _RC) - - ! Create TimeInterval based on interval - ! from start of latest Cycle 25 - ! ------------------------------------- - - timeSinceStartOfCycle25 = currentTime - startCycle25 - - ! Make a new time based on that - ! interval past start of Cycle 24 - ! ------------------------------- - - timeBasedOnCycle24 = startCycle24 + timeSinceStartOfCycle25 - - ! Store our original time just in case - ! ------------------------------------ - origTime = currentTime - originalYear = currentYear - originalMon = currentMon - originalDay = currentDay - origDOY = currentDOY + ! If we are out of the table... + ! ----------------------------- + + OUT_OF_TABLE: if ( outOfTable ) then + + PERSIST_SOLAR: if ( PersistSolar_ ) then - ! Make our "current" time the one calculated above - ! ------------------------------------------------ - currentTime = timeBasedOnCycle24 + ! If we are outOfTable and we have the PersistSolar + ! option we just use the last value in the table... + ! ------------------------------------------------- - ! Get new currentYear, currentMon, currentDay - ! ------------------------------------------- + SC = tsi(numlines) + MG = mgindex(numlines) + SB = sbindex(numlines) - call ESMF_TimeGet( currentTime, YY = currentYear, & - MM = currentMon, & - DD = currentDay, & - dayOfYear = currentDOY, _RC) + call lgr%debug('Off the end of table, persisting last values') + call lgr%debug(' tsi at end of table: %F8.3', tsi(numlines)) + call lgr%debug(' mgindex at end of table: %F8.6', mgindex(numlines)) + call lgr%debug(' sbindex at end of table: %F9.4', sbindex(numlines)) - call lgr%debug('Off the end of table, moving into last complete cycle') - call lgr%debug(' Original Year-Mon-Day to Find: %i0.4~-%i0.2~-%i0.2', originalYear,originalMon,originalDay) - call lgr%debug(' Original Day of Year: %i0', origDOY) - call lgr%debug(' New Year-Mon-Day to Find: %i0.4~-%i0.2~-%i0.2', currentYear,currentMon,currentDay) - call lgr%debug(' New Day of Year: %i0', currentDOY) + _RETURN(ESMF_SUCCESS) + + else - end if OUT_OF_TABLE_AND_CYCLE + ! If we are out of the table and not persisting, we must + ! recenter our day to be based on the last complete Solar Cycle + ! ------------------------------------------------------------- + + ! Create an ESMF_Time at start of Cycle 24 + ! ---------------------------------------- + call ESMF_TimeSet( startCycle24, YY = 2008, & + MM = 12, & + DD = 1, & + H = 12, & + M = 00, & + S = 00, _RC) + + ! Create an ESMF_Time at start of Cycle 25 + ! ---------------------------------------- + call ESMF_TimeSet( startCycle25, YY = 2019, & + MM = 12, & + DD = 1, & + H = 12, & + M = 00, & + S = 00, _RC) + + ! Create TimeInterval based on interval + ! from start of latest Cycle 25 + ! ------------------------------------- + + timeSinceStartOfCycle25 = currentTime - startCycle25 + + ! Make a new time based on that + ! interval past start of Cycle 24 + ! ------------------------------- + + timeBasedOnCycle24 = startCycle24 + timeSinceStartOfCycle25 + + ! Store our original time just in case + ! ------------------------------------ + origTime = currentTime + originalYear = currentYear + originalMon = currentMon + originalDay = currentDay + origDOY = currentDOY + + ! Make our "current" time the one calculated above + ! ------------------------------------------------ + currentTime = timeBasedOnCycle24 + + ! Get new currentYear, currentMon, currentDay + ! ------------------------------------------- + + call ESMF_TimeGet( currentTime, YY = currentYear, & + MM = currentMon, & + DD = currentDay, & + dayOfYear = currentDOY, _RC) + + call lgr%debug('Off the end of table, moving into last complete cycle') + call lgr%debug(' Original Year-Mon-Day to Find: %i0.4~-%i0.2~-%i0.2', originalYear,originalMon,originalDay) + call lgr%debug(' Original Day of Year: %i0', origDOY) + call lgr%debug(' New Year-Mon-Day to Find: %i0.4~-%i0.2~-%i0.2', currentYear,currentMon,currentDay) + call lgr%debug(' New Day of Year: %i0', currentDOY) + + end if PERSIST_SOLAR + + end if OUT_OF_TABLE ! Create an ESMF_Time on noon of current day ! ------------------------------------------ @@ -2673,49 +2698,30 @@ subroutine MAPL_SunGetSolarConstantFromNRLFile(CLOCK,filename_in,SC,MG,SB,Persis INDX1 = find_file_index(numlines, yearTable, prevNoonYear, prevDOY) INDX2 = INDX1 + 1 - ! If we are outOfTable and we have the PersistSolar - ! option we just use the last value in the table... - ! ------------------------------------------------- - OUT_OF_TABLE_AND_PERSIST: if ( outOfTable .and. PersistSolar_) then - - SC = tsi(numlines) - MG = mgindex(numlines) - SB = sbindex(numlines) - - call lgr%debug('Off the end of table, persisting last values') - call lgr%debug(' tsi at end of table: %F8.3', tsi(numlines)) - call lgr%debug(' mgindex at end of table: %F8.6', mgindex(numlines)) - call lgr%debug(' sbindex at end of table: %F9.4', sbindex(numlines)) - - ! Otherwise we interpolate to the table - ! ------------------------------------- - else + ! Linear Interpolation to the given day-of-month + ! ---------------------------------------------- - ! Linear Interpolation to the given day-of-month - ! ---------------------------------------------- - - SC = tsi(INDX1)*FAC + tsi(INDX2)*(1.0-FAC) - MG = mgindex(INDX1)*FAC + mgindex(INDX2)*(1.0-FAC) - SB = sbindex(INDX1)*FAC + sbindex(INDX2)*(1.0-FAC) - - call lgr%debug(' First DOY to Find: %i3', prevDOY) - call lgr%debug(' file_index for date: %i6', INDX1) - call lgr%debug(' yearTable(date): %i4', yearTable(INDX1)) - call lgr%debug(' doyTable(date): %i3', doyTable(INDX1)) - call lgr%debug(' tsi(date): %f8.3', tsi(INDX1)) - call lgr%debug(' mgindex(date): %f8.6', mgindex(INDX1)) - call lgr%debug(' sbindex(date): %f9.4', sbindex(INDX1)) - - call lgr%debug(' Second DOY to Find: %i3', nextDOY) - call lgr%debug(' file_index for date: %i6', INDX2) - call lgr%debug(' yearTable(date): %i4', yearTable(INDX2)) - call lgr%debug(' doyTable(date): %i3', doyTable(INDX2)) - call lgr%debug(' tsi(date): %f8.3', tsi(INDX2)) - call lgr%debug(' mgindex(date): %f8.6', mgindex(INDX2)) - call lgr%debug(' sbindex(date): %f9.4', sbindex(INDX2)) - - call lgr%debug(' Interpolation Factor: %f8.6', FAC) - end if OUT_OF_TABLE_AND_PERSIST + SC = tsi(INDX1)*FAC + tsi(INDX2)*(1.0-FAC) + MG = mgindex(INDX1)*FAC + mgindex(INDX2)*(1.0-FAC) + SB = sbindex(INDX1)*FAC + sbindex(INDX2)*(1.0-FAC) + + call lgr%debug(' First DOY to Find: %i3', prevDOY) + call lgr%debug(' file_index for date: %i6', INDX1) + call lgr%debug(' yearTable(date): %i4', yearTable(INDX1)) + call lgr%debug(' doyTable(date): %i3', doyTable(INDX1)) + call lgr%debug(' tsi(date): %f8.3', tsi(INDX1)) + call lgr%debug(' mgindex(date): %f8.6', mgindex(INDX1)) + call lgr%debug(' sbindex(date): %f9.4', sbindex(INDX1)) + + call lgr%debug(' Second DOY to Find: %i3', nextDOY) + call lgr%debug(' file_index for date: %i6', INDX2) + call lgr%debug(' yearTable(date): %i4', yearTable(INDX2)) + call lgr%debug(' doyTable(date): %i3', doyTable(INDX2)) + call lgr%debug(' tsi(date): %f8.3', tsi(INDX2)) + call lgr%debug(' mgindex(date): %f8.6', mgindex(INDX2)) + call lgr%debug(' sbindex(date): %f9.4', sbindex(INDX2)) + + call lgr%debug(' Interpolation Factor: %f8.6', FAC) _RETURN(ESMF_SUCCESS)