From d175723d7102ec4ee45e80cc5357702274855f29 Mon Sep 17 00:00:00 2001 From: Peter Norris Date: Tue, 5 Nov 2019 15:26:57 -0500 Subject: [PATCH 001/109] pmn: first draft EOT changes --- MAPL_Base/MAPL_sun_uc.F90 | 170 +++++++++++++++++++++++++++++++------- MAPL_Base/sun.H | 106 +++++++++++++++++++++--- 2 files changed, 235 insertions(+), 41 deletions(-) diff --git a/MAPL_Base/MAPL_sun_uc.F90 b/MAPL_Base/MAPL_sun_uc.F90 index 4b30c3352683..dd3f7fb7fe82 100644 --- a/MAPL_Base/MAPL_sun_uc.F90 +++ b/MAPL_Base/MAPL_sun_uc.F90 @@ -74,6 +74,7 @@ module MAPL_SunMod real, pointer, dimension(:) :: ZS => null() real, pointer, dimension(:) :: PP => null() real, pointer, dimension(:) :: TH => null() + real, pointer, dimension(:) :: ET => null() logical :: FIX_SUN end type MAPL_SunOrbit @@ -150,15 +151,31 @@ type(MAPL_SunOrbit) function MAPL_SunOrbitCreate(CLOCK, & character(len=ESMF_MAXSTR), parameter :: IAm = "SunOrbitCreate" integer :: YEARS_PER_CYCLE, DAYS_PER_CYCLE - integer :: KM, K, KP - real*8 :: T1, T2, T3, T4, FUN, Y, SOB, OMG, PRH, TT + integer :: K, KP + real*8 :: T1, T2, T3, T4, dTHdDAY, TH, SOB, OMG, PRH, TT real*8 :: YEARLEN integer :: STATUS type(MAPL_SunOrbit) :: ORBIT -! STATEMENT FUNCTION + real :: D2R, OMECC, OPECC, OMSQECC, EAFAC + real*8 :: TA, EA, MA, PRHV, TREL, M1EL, COB + real*8 :: TRRA, M1RA, OMG0, M2RA - FUN(Y) = OMG*(1.0-ECCENTRICITY*cos(Y-PRH))**2 +! TEMP pmn + type(ESMF_VM) :: VM + logical :: amIRoot + integer :: deId, npes +! end TEMP pmn + +! STATEMENT FUNCTION, dTH/dDAY(TH) (see below) + + dTHdDAY(TH) = OMG*(1.0-ECCENTRICITY*cos(TH-PRH))**2 + +! TEMP pmn + call ESMF_VMGetCurrent(vm, rc=status) + call ESMF_VmGet(VM, localPet=deId, petCount=npes, rc=status); VERIFY_(STATUS) + amIRoot = (deId == 0) +! end TEMP pmn !MJS: This needs to come from the calendar when the time manager works right. @@ -167,9 +184,29 @@ type(MAPL_SunOrbit) function MAPL_SunOrbitCreate(CLOCK, & ! Factors involving the orbital parameters !------------------------------------------ - OMG = (2.0*MAPL_PI/YEARLEN) / (sqrt(1.-ECCENTRICITY**2)**3) - PRH = PERIHELION*(MAPL_PI/180.) - SOB = sin(OBLIQUITY*(MAPL_PI/180.)) + OMECC = 1. - ECCENTRICITY + OPECC = 1. + ECCENTRICITY + OMSQECC = 1. - ECCENTRICITY**2 ! pmn: consider changing to line below when zero-diff not issue +! OMSQECC = OMECC * OPECC + EAFAC = sqrt(OMECC/OPECC) + + D2R = MAPL_PI/180. + OMG0 = 2.*MAPL_PI/YEARLEN + OMG = OMG0/sqrt(OMSQECC)**3 + PRH = PERIHELION*D2R + SOB = sin(OBLIQUITY*D2R) + COB = cos(OBLIQUITY*D2R) + + ! The above PRH is wrt to autumnal equinox. For EOT calculations we + ! will reference the perihelion wrt to the vernal equinox. Of course, + ! the difference is just PI. + ! pmn: once the EOT code is established and zero-diff not an issue, + ! consider removing original PRH and changing the original (non-EOT), + ! code, which employs + ! cos(Y \pm PI) = -COS(Y) + ! to use PRHV, namely + ! -cos(Y-PRH) = cos(Y-PRH-PI) = cos(Y-PRHV) + PRHV = PRH + MAPL_PI_R8 ! Compute length of leap cycle !------------------------------ @@ -198,6 +235,10 @@ type(MAPL_SunOrbit) function MAPL_SunOrbitCreate(CLOCK, & allocate(ORBIT%PP(DAYS_PER_CYCLE), stat=status) VERIFY_(STATUS) + if(associated(ORBIT%ET)) deallocate(ORBIT%ET) + allocate(ORBIT%ET(DAYS_PER_CYCLE), stat=status) + VERIFY_(STATUS) + ORBIT%CLOCK = CLOCK ORBIT%OB = OBLIQUITY ORBIT%ECC = ECCENTRICITY @@ -207,35 +248,82 @@ type(MAPL_SunOrbit) function MAPL_SunOrbitCreate(CLOCK, & ORBIT%YEARS_PER_CYCLE = YEARS_PER_CYCLE ORBIT%DAYS_PER_CYCLE = DAYS_PER_CYCLE -! TH: Orbit anomaly (radians) -! ZS: Sine of declination -! ZC: Cosine of declination -! PP: Inverse of square of earth-sun distance (1/(au**2)) +! TH: Ecliptic longitude of the true Sun (radians) +! ZS: Sine of declination +! ZC: Cosine of declination +! PP: Inverse of square of earth-sun distance (1/(AU**2)) +! ET: Equation of time = True solar time - Mean solar time (radians) + +! From Meeus, J. (1998). Astronomical Algorithms. 2nd ed. p183: +! Consider a first fictitious Sun [M1] travelling along the ecliptic +! with a constant speed and coinciding with the true sun at the perigee +! and apogee (when the Earth is in perihelion and aphelion, respectively). +! Then consider a second fictitious Sun [M2] travelling along the celestial +! equator at a constant speed and coinciding with the first fictitious Sun +! at the equinoxes. This second fictitious sun is the mean Sun..." +! pmn: [M1] and [M2] are my additions for reference to code below. -! Begin integration at vernal equinox +! Begin integration at vernal equinox (K=1, KP = EQUINOX) KP = EQUINOX - TT = 0.0 + TT = 0. ORBIT%ZS(KP) = sin(TT)*SOB - ORBIT%ZC(KP) = sqrt(1.0-ORBIT%ZS(KP)**2) - ORBIT%PP(KP) = ( ( 1.0-ECCENTRICITY*cos(TT-PRH) ) & - / ( 1.0-ECCENTRICITY**2 ) )**2 + ORBIT%ZC(KP) = sqrt(1.-ORBIT%ZS(KP)**2) + ORBIT%PP(KP) = ( (1.-ECCENTRICITY*cos(TT-PRH)) / OMSQECC )**2 ORBIT%TH(KP) = TT + ! pmn: 2019-10-29 + ! Calculation of True (TA), Eccentric (EA), and Mean Anomaly (MA), + ! after Blanco & McCuskey, 1961: "Basic Physics of the Solar System", + ! hereafter BM. + TA = TT - PRHV ! by defn of TA and PRHV + EA = 2.d0*atan(EAFAC*tan(TA/2.d0)) ! BM 4-55 + MA = EA - ECCENTRICITY*sin(EA) ! Kepler's eqn (BM 4-49 ff.) + + ! These anomalies are angles in the ecliptic. We now have to convert + ! to equatorial angles, i.e., right ascensions. The first step is to + ! convert the anomalies (wrt to perihelion) to ecliptic longitudes + ! (wrt to vernal equinox). Clearly the ecliptic longitude of the true + ! sun, TREL, is just TT. The ecliptic longitude of the first mean sun, + ! M1EL, is PRHV + MA. + TREL = TT; M1EL = PRHV + MA + + ! Now right ascensions ... + ! From BM 1-15 and 1-16 with beta=0 (Sun is on ecliptic), + ! and dividing through by common cos(dec) since it does not + ! affect the ratio of sin(RA) to cos(RA). + TRRA = atan2(sin(TREL)*COB,cos(TREL)) + M1RA = atan2(sin(M1EL)*COB,cos(M1EL)) + + ! By Meeus quote above M2RA = M1RA at Equinox + ! and increases by a constant rate thereafter + M2RA = M1RA + + ! Finally, Equation of Time, ET [radians] + ! True Solar hour angle = Mean Solar hour angle + ET + ! (hour angle and right ascension are in reverse direction) + ORBIT%ET(KP) = M2RA - TRRA + if (amIRoot) write(*,'("pmn: ",i4,4(x,f10.6))') & + KP, TT, TRRA, M2RA, ORBIT%ET(KP) + ! Integrate orbit for entire leap cycle using Runge-Kutta do K=2,DAYS_PER_CYCLE - T1 = FUN(TT ) - T2 = FUN(TT+T1*0.5) - T3 = FUN(TT+T2*0.5) - T4 = FUN(TT+T3 ) - KP = mod(KP,DAYS_PER_CYCLE) + 1 - TT = TT + (T1 + 2.0*(T2 + T3) + T4) / 6.0 - ORBIT%ZS(KP) = sin(TT)*SOB - ORBIT%ZC(KP) = sqrt(1.0-ORBIT%ZS(KP)**2) - ORBIT%PP(KP) = ( ( 1.0-ECCENTRICITY*cos(TT-PRH) ) & - / ( 1.0-ECCENTRICITY**2 ) )**2 - ORBIT%TH(KP) = TT + T1 = dTHdDAY(TT ) + T2 = dTHdDAY(TT+T1*0.5) + T3 = dTHdDAY(TT+T2*0.5) + T4 = dTHdDAY(TT+T3 ) + KP = mod(KP,DAYS_PER_CYCLE) + 1 + TT = TT + (T1 + 2.0*(T2 + T3) + T4) / 6.0 + ORBIT%ZS(KP) = sin(TT)*SOB + ORBIT%ZC(KP) = sqrt(1.-ORBIT%ZS(KP)**2) + ORBIT%PP(KP) = ( (1.-ECCENTRICITY*cos(TT-PRH)) / OMSQECC )**2 + ORBIT%TH(KP) = TT + TRRA = atan2(sin(TT)*COB,cos(TT)) + M2RA = M2RA + OMG0 + ORBIT%ET(KP) = M2RA - TRRA + if (amIRoot) write(*,'("pmn: ",i4,4(x,f10.6))') & + KP, TT, TRRA, M2RA, ORBIT%ET(KP) enddo if (present(FIX_SUN)) then @@ -276,6 +364,7 @@ subroutine MAPL_SunOrbitDestroy(ORBIT, RC) if(associated(ORBIT%ZC)) deallocate(ORBIT%ZC) if(associated(ORBIT%ZS)) deallocate(ORBIT%ZS) if(associated(ORBIT%PP)) deallocate(ORBIT%PP) + if(associated(ORBIT%ET)) deallocate(ORBIT%ET) RETURN_(ESMF_SUCCESS) @@ -338,6 +427,9 @@ subroutine MAPL_SunOrbitQuery(ORBIT, & CLOCK, & ZS, & ZC, & + TH, & + PP, & + ET, & RC ) ! !ARGUMENTS: @@ -353,6 +445,9 @@ subroutine MAPL_SunOrbitQuery(ORBIT, & type(ESMF_Clock ), optional, intent(OUT) :: CLOCK real, optional, pointer, dimension(:) :: ZS real, optional, pointer, dimension(:) :: ZC + real, optional, pointer, dimension(:) :: TH + real, optional, pointer, dimension(:) :: PP + real, optional, pointer, dimension(:) :: ET integer, optional, intent(OUT) :: RC !EOPI @@ -373,6 +468,9 @@ subroutine MAPL_SunOrbitQuery(ORBIT, & if(present(YEARS_PER_CYCLE)) YEARS_PER_CYCLE = ORBIT%YEARS_PER_CYCLE if(present(ZS )) ZS => ORBIT%ZS if(present(ZC )) ZC => ORBIT%ZC + if(present(TH )) TH => ORBIT%TH + if(present(PP )) PP => ORBIT%PP + if(present(ET )) ET => ORBIT%ET RETURN_(ESMF_SUCCESS) @@ -424,11 +522,18 @@ end subroutine MAPL_SunOrbitQuery ! MAPL_SunDailyMean ! MAPL_SunAnnualMean !\end{verbatim} +! +! The {\tt EOT} optional logical argument, if present and .TRUE., +! will apply the Equation of Time correction, which shifts the actual +! daylight period w.r.t. to mean solar noon, to account for small +! but cumulative eccentricity and oblquity effects on the actual +! length of the solar day. ! !INTERFACE: ! subroutine MAPL_SunGetInsolation(LONS, LATS, ORBIT,ZTH,SLR,INTV,CLOCK, & -! TIME,currTime,DIST,ZTHB,ZTHD,ZTH1,ZTHN, RC) +! TIME,currTime,DIST,ZTHB,ZTHD,ZTH1,ZTHN, & +! EOT, RC) ! !ARGUMENTS: @@ -446,6 +551,7 @@ end subroutine MAPL_SunOrbitQuery ! TYPE , optional, intent(OUT) :: ZTHD ! TYPE , optional, intent(OUT) :: ZTH1 ! TYPE , optional, intent(OUT) :: ZTHN +! logical , optional, INTENT(IN ) :: EOT ! integer, optional, intent(OUT) :: RC !\end{verbatim} ! where we currently support three overloads for {\tt TYPE} : @@ -459,7 +565,8 @@ end subroutine MAPL_SunOrbitQuery #define DIMENSIONS (:) #define THE_SIZE (size(LONS,1)) recursive subroutine SOLAR_1D(LONS, LATS, ORBIT,ZTH,SLR,INTV,CLOCK, & - TIME,currTime,DIST,ZTHB,ZTHD,ZTH1,ZTHN,STEPSIZE,RC) + TIME,currTime,DIST,ZTHB,ZTHD,ZTH1,ZTHN,& + STEPSIZE,EOT,RC) #include "sun.H" end subroutine SOLAR_1D @@ -470,7 +577,8 @@ end subroutine SOLAR_1D #define DIMENSIONS (:,:) #define THE_SIZE (size(LONS,1),size(LONS,2)) recursive subroutine SOLAR_2D(LONS, LATS, ORBIT,ZTH,SLR,INTV,CLOCK, & - TIME,currTime,DIST,ZTHB,ZTHD,ZTH1,ZTHN,STEPSIZE,RC) + TIME,currTime,DIST,ZTHB,ZTHD,ZTH1,ZTHN,& + STEPSIZE,EOT,RC) #include "sun.H" end subroutine SOLAR_2D #undef DIMENSIONS @@ -515,6 +623,8 @@ subroutine SOLAR_ARR_INT(LONS, LATS, ORBIT, ZTH, SLR, INTV, CLOCK, & ! Begin + ASSERT_(.FALSE.) ! pmn: this routine is not up to date, is it even used anywhere? + call ESMF_ArrayGet(LONS, RANK=RANK, RC=STATUS) VERIFY_(STATUS) diff --git a/MAPL_Base/sun.H b/MAPL_Base/sun.H index d49ee0e1ff97..ef33a3d0b711 100644 --- a/MAPL_Base/sun.H +++ b/MAPL_Base/sun.H @@ -16,6 +16,7 @@ real, optional, intent(OUT) :: ZTH1 DIMENSIONS real, optional, intent(OUT) :: ZTHN DIMENSIONS real, optional, intent(IN) :: STEPSIZE + logical, optional, intent(IN) :: EOT integer, optional, intent(OUT) :: RC ! Locals @@ -25,8 +26,9 @@ integer :: IDAY, IDAYP1, TIME_ integer :: NT - real :: FAC, ZS, ZC, ANG, AA, DD + real :: FAC, ZS, ZC, ANG, AA, DD, ET real*8 :: SECS + logical :: apply_EOT integer :: YEAR integer :: SEC_OF_DAY @@ -45,7 +47,6 @@ TIME_ = 0 endif - if (present(currTime)) then CURRENTTIME = CURRTIME else @@ -57,6 +58,13 @@ VERIFY_(STATUS) end if + ! apply Equation of Time correction? + if (present(EOT)) then + apply_EOT = EOT + else + apply_EOT = .FALSE. + endif + if (ORBIT%FIX_SUN) then call WRITE_PARALLEL('--- WARNING --- sun.H --- Doubly Periodic Using Daily Mean Solar Insolation') TIME_=MAPL_SunDailyMean @@ -84,6 +92,10 @@ select case (TIME_) case(MAPL_SunDailyMean) +! pmn: EOT will just displace sunlit period wrt mean noon, +! but the daily mean values will not change + + ASSERT_(.FALSE.) ! pmn: this routine probably in error (see below) SLR = sin(LATS)*ORBIT%ZS(IDAY) ZTH = cos(LATS)*ORBIT%ZC(IDAY) @@ -92,7 +104,22 @@ where (Y < 1.0) Y = ACOS(Y) SLR = (4.0*ORBIT%PP(IDAY)/MAPL_PI) * (Y *SLR + SIN(Y)*ZTH) + ! pmn: I get this without factor of 4.0 ZTH = SLR*MAPL_PI / (4.0*Y) + ! pmn: If remove factor of 4 above, remove it here too. + ! pmn: This is also wrong because includes the ORBIT%PP(IDAY) factor + +! pmn: I think these lines should read: +! SLR = Y * SLR + SIN(Y) * ZTH +! ZTH = SLR / Y +! SLR = ORBIT%PP(IDAY) * SLR / MAPL_PI +! On the assumption that ZTH is meant to be the linear average +! of cos(sza) over the sunlit part of the day, or what we call ZTHD +! This routine should also produce an insolation-weighted mean ZTH. +! After end select, all these different ZTHs are set to ZTH, since this +! branch is the instantaneous branch, which is clearly not appropriate +! for a daily or annual mean. + elsewhere SLR = 0.0 ZTH = 0.0 @@ -100,6 +127,13 @@ case(MAPL_SunAnnualMean) +!pmn: consistent with above (and erroneous) SunDailyMean, +! but unlike MAPL sun_uc.F90 comment: +! "annual-mean insolation for the year on the clock" +! its a mean over the whole currently fixed 4-year cycle. + + ASSERT_(.FALSE.) ! pmn: this routine probably in error (see above) + SLR = 0.0 ZTH = 0.0 @@ -131,30 +165,80 @@ MAPL_SunSummerSolstice ) FAC = real(SEC_OF_DAY)/86400. - ANG = 2.0*MAPL_PI*FAC if(TIME_==0) then IDAYP1 = mod(IDAY,ORBIT%DAYS_PER_CYCLE) + 1 - ZS = ORBIT%ZS(IDAYP1)*FAC + ORBIT%ZS(IDAY)*(1.-FAC) - ZC = ORBIT%ZC(IDAYP1)*FAC + ORBIT%ZC(IDAY)*(1.-FAC) - AA = ORBIT%PP(IDAYP1)*FAC + ORBIT%PP(IDAY)*(1.-FAC) + ZS = ORBIT%ZS(IDAYP1)*FAC + ORBIT%ZS(IDAY)*(1.-FAC) + ZC = ORBIT%ZC(IDAYP1)*FAC + ORBIT%ZC(IDAY)*(1.-FAC) + AA = ORBIT%PP(IDAYP1)*FAC + ORBIT%PP(IDAY)*(1.-FAC) + if (apply_EOT) & + ET = ORBIT%ET(IDAYP1)*FAC + ORBIT%ET(IDAY)*(1.-FAC) else call GETIDAY(IDAY,TIME_,ORBIT,RC=STATUS) VERIFY_(STATUS) - ZS = ORBIT%ZS(IDAY) - ZC = ORBIT%ZC(IDAY) - AA = ORBIT%PP(IDAY) + ZS = ORBIT%ZS(IDAY) + ZC = ORBIT%ZC(IDAY) + AA = ORBIT%PP(IDAY) + if (apply_EOT) ET = ORBIT%ET(IDAY) endif - ZTH = ZS*SIN(LATS) + ZC*COS(LATS) & - * (sin(ANG)*SIN(LONS) - cos(ANG)*COS(LONS)) + ! Greenwich MEAN solar hour angle OFFSET by PI + ! (since FAC is zero at mignight) + ANG = 2.0*MAPL_PI*FAC + + ! apply equation of time correction? + if (apply_EOT) then + + ! the real (zero at noon) Greenwich MEAN solar hour angle + ANG = ANG + MAPL_PI + + ! Greenwich TRUE solar hour angle + ANG = ANG + ET + + ! LOCAL solar zenith angle + ZTH = ZS*SIN(LATS) + ZC*COS(LATS)*COS(ANG+LONS) + + else + + ! the historical GEOS-5 calculation based on mean solar time, + ! i.e., lacking the required equation of time correction + + ! pmn: this branch can eventually go if EOT becomes default + ! pmn: the sin*sin-cos*cos is less clear and probably less + ! efficient than the EOT branch anyway + + ! solar zenith angle (based on MEAN solar time) + ZTH = ZS*SIN(LATS) + & + ZC*COS(LATS) * (sin(ANG)*SIN(LONS) - cos(ANG)*COS(LONS)) + + end if + + ! enforce zero insolation for sun below horizon ZTH = max(ZTH, 0.0) + + ! normalized downward solar flux at TOA SLR = ZTH*AA if(present(DIST)) DIST = AA + ! ---%--- + +! pmn: Andrea said the following fixed cases are for single column tests, +! which are run at the same start date near or at the equinox. Technic- +! ally, the value of DIST should also be set consistent with these cases, +! since RRTMG uses SC and DIST (not SLR) during the solar REFRESH phase. +! But since the single column test runs always use the same cap_restart +! and so get the same set of default DIST values from above the current +! select statement, at least we are using a CONSISTENT wrong DIST values! +! In fact, the RRTMG REFRESH uses the DIST to multiply the solar input +! at TOA, which is then divided through by again at the end of REFRESH +! to get the required NORMALIZED fluxes. So this is probably only a small +! non-linear effect. In the solar UPDATE_EXPORT() at the heartbeat the +! normalized fluxes are always re-multiplied by SLR, and so the SLR +! values below will be used directly (without reference to DIST.) + case(10) SLR = 0.3278 ZTH = 0.6087247 From 14ff1300aeb36c7c2a2471b11d64b1a59fbe5a76 Mon Sep 17 00:00:00 2001 From: Peter Norris Date: Tue, 17 Dec 2019 09:53:23 -0500 Subject: [PATCH 002/109] Equation of time work in progress --- MAPL_Base/MAPL_sun_uc.F90 | 374 ++++++++++++++++++++------ MAPL_Base/orbit.pdf | Bin 0 -> 224142 bytes MAPL_Base/orbit.tex | 533 ++++++++++++++++++++++++++++++++++++++ 3 files changed, 829 insertions(+), 78 deletions(-) create mode 100644 MAPL_Base/orbit.pdf create mode 100644 MAPL_Base/orbit.tex diff --git a/MAPL_Base/MAPL_sun_uc.F90 b/MAPL_Base/MAPL_sun_uc.F90 index dd3f7fb7fe82..8f375ac7d0ae 100644 --- a/MAPL_Base/MAPL_sun_uc.F90 +++ b/MAPL_Base/MAPL_sun_uc.F90 @@ -96,6 +96,10 @@ module MAPL_SunMod ! ESMF clock passed as an argument. This becomes the orbit`s ! attached clock. Currently we assume a single intercalation. ! +! A good introduction to celestial mechanics for understanding this +! code can be found in Blanco & McCuskey, 1961: "Basic Physics of the +! Solar System", hereafter BM. +! !% \begin{itemize} !% \item[] !\makebox[2in][l]{\bf \em CLOCK} @@ -126,23 +130,24 @@ module MAPL_SunMod ! !INTERFACE: -type(MAPL_SunOrbit) function MAPL_SunOrbitCreate(CLOCK, & - ECCENTRICITY,& - OBLIQUITY, & - PERIHELION, & - EQUINOX, & - FIX_SUN, & - RC ) +type(MAPL_SunOrbit) function MAPL_SunOrbitCreate(CLOCK, & + OLD_ECCENTRICITY, & + OLD_OBLIQUITY, & + OLD_PERIHELION, & + OLD_EQUINOX, & + FIX_SUN, & + RC ) ! !ARGUMENTS: type(ESMF_Clock) , intent(IN ) :: CLOCK - real , intent(IN ) :: ECCENTRICITY - real , intent(IN ) :: OBLIQUITY - real , intent(IN ) :: PERIHELION - integer , intent(IN ) :: EQUINOX + real , intent(IN ) :: OLD_ECCENTRICITY + real , intent(IN ) :: OLD_OBLIQUITY + real , intent(IN ) :: OLD_PERIHELION + integer , intent(IN ) :: OLD_EQUINOX logical, optional , intent(IN ) :: FIX_SUN integer, optional , intent(OUT) :: RC +! TEMP pmn: remove OLD after test !EOPI @@ -150,26 +155,49 @@ type(MAPL_SunOrbit) function MAPL_SunOrbitCreate(CLOCK, & character(len=ESMF_MAXSTR), parameter :: IAm = "SunOrbitCreate" - integer :: YEARS_PER_CYCLE, DAYS_PER_CYCLE - integer :: K, KP - real*8 :: T1, T2, T3, T4, dTHdDAY, TH, SOB, OMG, PRH, TT + integer :: K, KP, YEARS_PER_CYCLE, DAYS_PER_CYCLE + real*8 :: TREL, T1, T2, T3, T4, dTRELdDAY, SOB, OMG, PRH real*8 :: YEARLEN integer :: STATUS type(MAPL_SunOrbit) :: ORBIT real :: D2R, OMECC, OPECC, OMSQECC, EAFAC - real*8 :: TA, EA, MA, PRHV, TREL, M1EL, COB - real*8 :: TRRA, M1RA, OMG0, M2RA + real*8 :: TA, EA, MA, PRHV, M1EL, COB + real*8 :: TRRA, M1RA, OMG0, MNRA ! TEMP pmn type(ESMF_VM) :: VM logical :: amIRoot integer :: deId, npes + real :: ECCENTRICITY, OBLIQUITY, PERIHELION + integer :: EQUINOX ! end TEMP pmn -! STATEMENT FUNCTION, dTH/dDAY(TH) (see below) +! STATEMENT FUNC: dTREL/dDAY(TREL), +! where TREL is ecliptic longitude of true Sun + + dTRELdDAY(TREL) = OMG*(1.0-ECCENTRICITY*cos(TREL-PRH))**2 - dTHdDAY(TH) = OMG*(1.0-ECCENTRICITY*cos(TH-PRH))**2 +! TEMP pmn +! Change orbital parameters to compare with Tom +! These are for year 2000. +ECCENTRICITY = 0.01671022 ! 0.0167 +OBLIQUITY = 23.44 +PERIHELION = 102.94719 ! 102.947 +EQUINOX = 80 +! @ Toms's equinox is: 80 + 7.5/24 +! but this method requires an integer so we'll use 80. +! Actually in THIS code, EQUINOX is only used to set the KP +! at which the TREL is zero. So although its 80 here, outside +! this code, namely in SunGetInsolation where we interpolate +! between days, we should regard the daily value as at 7h30m +! AM. But thats an external issue and wont affect this test. +! But when doing diagnostic tests, we must regard index 80 as +! being 80d7h30m = Mar 20, 7:30 AM UTC (2000 IS a leap year). +! @ Similarly, it is assumed EXTERNALLY that the first three +! years of the cycle are non-leap, and the last leap. This +! won't affect this test. +! end TEMP pmn ! TEMP pmn call ESMF_VMGetCurrent(vm, rc=status) @@ -181,9 +209,8 @@ type(MAPL_SunOrbit) function MAPL_SunOrbitCreate(CLOCK, & YEARLEN = 365.25 -! Factors involving the orbital parameters -!------------------------------------------ - + ! Factors involving the orbital parameters + !----------------------------------------- OMECC = 1. - ECCENTRICITY OPECC = 1. + ECCENTRICITY OMSQECC = 1. - ECCENTRICITY**2 ! pmn: consider changing to line below when zero-diff not issue @@ -197,9 +224,11 @@ type(MAPL_SunOrbit) function MAPL_SunOrbitCreate(CLOCK, & SOB = sin(OBLIQUITY*D2R) COB = cos(OBLIQUITY*D2R) - ! The above PRH is wrt to autumnal equinox. For EOT calculations we - ! will reference the perihelion wrt to the vernal equinox. Of course, - ! the difference is just PI. + ! PRH is the ecliptic longitude of the perihelion, measured (at the Sun) + ! from the autumnal equinox in the direction of the Earth`s orbital motion + ! (counterclockwise as viewed from ecliptic north pole). + ! For EOT calculations we will reference the perihelion wrt to the vernal + ! equinox, PRHV. Of course, the difference is just PI. ! pmn: once the EOT code is established and zero-diff not an issue, ! consider removing original PRH and changing the original (non-EOT), ! code, which employs @@ -208,9 +237,8 @@ type(MAPL_SunOrbit) function MAPL_SunOrbitCreate(CLOCK, & ! -cos(Y-PRH) = cos(Y-PRH-PI) = cos(Y-PRHV) PRHV = PRH + MAPL_PI_R8 -! Compute length of leap cycle -!------------------------------ - + ! Compute length of leap cycle + ! ---------------------------- if(YEARLEN-int(YEARLEN) > 0.) then YEARS_PER_CYCLE = nint(1./(YEARLEN-int(YEARLEN))) else @@ -219,6 +247,26 @@ type(MAPL_SunOrbit) function MAPL_SunOrbitCreate(CLOCK, & DAYS_PER_CYCLE=nint(YEARLEN*YEARS_PER_CYCLE) + ! save inputs and intercalculation details + ! ---------------------------------------- + ORBIT%CLOCK = CLOCK + ORBIT%OB = OBLIQUITY + ORBIT%ECC = ECCENTRICITY + ORBIT%PER = PERIHELION + ORBIT%EQNX = EQUINOX + ORBIT%YEARLEN = YEARLEN + ORBIT%YEARS_PER_CYCLE = YEARS_PER_CYCLE + ORBIT%DAYS_PER_CYCLE = DAYS_PER_CYCLE + + ! Allocate orbital cycle outputs + ! ------------------------------ + ! TH: Ecliptic longitude of the true Sun, TREL [radians] + ! ZS: Sine of declination + ! ZC: Cosine of declination + ! PP: Inverse of square of earth-sun distance [1/(AU**2)] + ! ET: Equation of time [radians] = + ! True solar hour angle - Mean solar hour angle + if(associated(ORBIT%TH)) deallocate(ORBIT%TH) allocate(ORBIT%TH(DAYS_PER_CYCLE), stat=status) VERIFY_(STATUS) @@ -239,91 +287,261 @@ type(MAPL_SunOrbit) function MAPL_SunOrbitCreate(CLOCK, & allocate(ORBIT%ET(DAYS_PER_CYCLE), stat=status) VERIFY_(STATUS) - ORBIT%CLOCK = CLOCK - ORBIT%OB = OBLIQUITY - ORBIT%ECC = ECCENTRICITY - ORBIT%PER = PERIHELION - ORBIT%EQNX = EQUINOX - ORBIT%YEARLEN = YEARLEN - ORBIT%YEARS_PER_CYCLE = YEARS_PER_CYCLE - ORBIT%DAYS_PER_CYCLE = DAYS_PER_CYCLE - -! TH: Ecliptic longitude of the true Sun (radians) -! ZS: Sine of declination -! ZC: Cosine of declination -! PP: Inverse of square of earth-sun distance (1/(AU**2)) -! ET: Equation of time = True solar time - Mean solar time (radians) - -! From Meeus, J. (1998). Astronomical Algorithms. 2nd ed. p183: -! Consider a first fictitious Sun [M1] travelling along the ecliptic -! with a constant speed and coinciding with the true sun at the perigee -! and apogee (when the Earth is in perihelion and aphelion, respectively). -! Then consider a second fictitious Sun [M2] travelling along the celestial -! equator at a constant speed and coinciding with the first fictitious Sun -! at the equinoxes. This second fictitious sun is the mean Sun..." -! pmn: [M1] and [M2] are my additions for reference to code below. - -! Begin integration at vernal equinox (K=1, KP = EQUINOX) +! ======================================= +! PMN Dec 2019: Notes on Equation of Time +! ======================================= +! (Part of a more complete analysis available from PMN) +! +! @ Introduction: +! +! The Earth rotates on its axis with a period T_S called the sidereal +! day (after the Latin for "star", since it is the rotation period of +! the Earth with respect to distant stars). T_S is slightly shorter +! than the so-called mean solar day, or clock day, of duration T_M = +! 86400 seconds. This is because the Earth is a prograde planet, i.e., +! it rotates about its axis in the same sense (counterclockwise look- +! ing down on the North Pole) as it orbits the sun. Specifically, say +! the sun crosses the meridian of some location at a particular time. +! And imagine there is a distant star directly behind the sun at that +! moment. After one sidereal day the location will rotate 360 degrees +! about the earth's axis and the distant star will again cross its +! merdian. But during that period the earth will have moved a small +! counterclockwise distance around its orbit and so it will take a +! small additional rotation of the earth for the sun to also cross +! the meridian and thereby complete a solar day. +! +! Put another way, a solar day is slightly longer than a sidereal day +! because the sun appears to move slowly eastward across the celestial +! sphere with respect to distant stars as the year passes. The path +! of this motion is called the ecliptic. And clearly what governs the +! length of a solar day is the apparent velocity of the sun along the +! ecliptic, or, more particularly, the equatorial component of that +! velocity. But both the magnitude and equatorial component of the solar +! ecliptic velocity change during the year, the former because the earth's +! orbit is elliptical, not circular, and the latter because the earth's +! axis of rotation is tilted with respect to the orbital (ecliptic) plane. +! Thus the length of a solar day changes during the year. While these +! factors cause only a small perturbation to the length of the solar +! day (less than 30 seconds), the perturbations accumulate so that at +! different times of the year apparent solar time ("sundial time") and +! mean solar time ("clock time") can differ by as much as ~15 minutes. +! This difference is called the Equation of Time. +! +! To be more rigorous, consider a fictitious "Mean Sun" that moves at +! constant eastward speed around the celestial equator, completing a +! full revolution in a year, namely in the period Y * T_M, where Y is +! the number of mean solar days in a year (e.g., 365.25). Thus, in one +! mean solar day, T_M, the mean sun has moved an angle 2*PI/Y eastward. +! Hence, beyond one full earth revolution, period T_S, an additional +! earth rotation of (T_M-T_S) * 2*PI/T_S = 2*PI/Y is required to "catch +! up with the moving sun", as described earlier. Hence T_M - T_S = T_S / Y +! and so +! +! T_M = T_S (Y+1)/Y, ..... (1) +! +! a constant (near unity) multiple of the fixed sidereal day. T_M is +! the length of the solar day for the "mean sun", or the "mean solar +! day". Because it is invariant during the year, it is convenient for +! timekeeping, and forms the basis for "mean solar time", which at +! Greenwich is essentially UTC. By *definition*, T_M = 24h = 86400s. +! That is, what we know as "hours", "minutes" and "seconds", are just +! convenient integer fractions of the mean solar day. In these units, +! the sidereal day T_S is approximately 23h 56m 4s. +! +! The solar zenith angle calculation (in MAPL_SunGetInsolation) needs +! the true local solar hour angle, h_T, which is the angle, measured +! westward along the equator, from the local meridian to the true sun. +! This is just the Greenwich solar hour angle, H_T, plus the longitude, +! so we will henceforth work exclusively with Greenwich hour angles. +! We should use the hour angle of the *true* sun, H_T, but a common +! approximation replaces this with the hour angle of the mean sun +! +! H_M = 2*PI*(u-0.5), ..... (2) +! +! where u is UTC time (in days) and the offset is needed because the mean +! solar hour angle is zero at "noon". If more accuracy is required, the +! hour angle of the true sun is typically obtained as a small correction +! to H_M called the Equation of time, EOT: +! +! H_T = H_M + EOT, where EOT = H_T - H_M. +! +! As discussed above, EOT corrects for two factors: +! (a) the variable speed of the earth in its elliptical orbit about +! the sun (e.g., moving fastest at perihelion), and +! (b) the tilt of the earth's axis of rotation wrt its orbital plane +! (the "obliquity"), which causes the equatorial projection of +! the sun's apparent ecliptic motion to vary with the season +! (e.g., being parallel to the equator at the solstices.) +! +! @ Derivation of Equation of Time: +! +! We can write +! +! H_T = H_1 - (H_1 - H_T) = H_1 - a_T, +! +! where H_1 is the Greenwich hour angle of the First Point of Aries (the +! location of the vernal equinox, denoted "1PoA"), and is also known as the +! Greenwich Sidereal hour angle, and where a_T is the right ascension of the +! true sun (since the right ascension of any object is just the difference +! between the hour angles of 1PoA and the object). Hence, +! +! EOT = H_1 - H_M - a_T. ..... (3) +! +! All three terms on the right of (3) are time variable: a_T changes slowly +! throughout the year, and is known from the earth-sun two-body elliptical +! orbit solution, while H_1 and H_M vary rapidly with earth's rotation. H_M +! has a period of one mean solar day, T_M, and H_1 has a period of one +! sidereal day, T_S. +! +! It may seem from from (2) that the mean sun and its hour angle are fully +! specified. That, in fact, is not yet the case: (2) is really just a def- +! inition of UTC, namely, that one UTC day is one mean solar day and that +! the time of culmination of the mean sun, what we call "noon", occurs at +! UTC 12h00m. What we are still at liberty to do is specify the phasing of +! the mean sun in its equatorial orbit, e.g., by specifying the time u_R +! at which the mean sun passes through 1PoA (both on the equator). At this +! time, H_1(u_R) = H_M(u_R), and so +! +! H_1(u) - H_M(u) = 2*PI*(u-u_R)*(Y+1)/Y - 2*PI*(u-u_R) +! = 2*PI * (u-u_R) / Y +! = MA(u) - MA(u_R), ... (4) +! +! where MA(u) = 2*PI * (u-u_P) / Y is the so-called "mean anomaly", known +! from the earth-sun two-body orbital solution, and u_P is the time of +! perihelion. Thus, to fully determine EOT, through (3) and (4), we need +! only to specify MA(u_R). +! +! To understand the mean anomaly MA, consider the standard two-body earth- +! sun problem in which the earth E moves in an elliptical orbit about the +! sun S at one focus, all in the ecliptic plane. The point on the ellipse +! closest to S is called the perihelion P. Obviously, the center of the +! ellipse O, the focus S and the perihelion P are co-linear, the so-called +! major axis of the ellipse. Additionally, let C be the circumscribing circle +! of the ellipse, with center O and passing through P (and the corresponding +! aphelion A). By Kepler's Second Law, the sun-earth vector sweeps out equal +! areas in equal times, so the fractional area of the elliptical sector PSE +! is a linear function of time, being zero at perihelion and one a year later. +! Specifically, this fractional area is none other than the scaled mean anomaly +! MA(u)/(2*PI) = (u - u_P) / Y. Clearly MA(u) can also be interpreted as an +! angle, the angle POQ of a point Q orbiting on the circumcircle C at constant +! speed in the same direction as the earth, also with a yearly period, and +! passing through P at the same time u_P as the earth. Thus the point Q can +! be conceptualized as a sort of "mean earth" orbiting a "second mean sun" +! (different from M above) at O. Note that while the angle MA(u) = angle POQ +! of this mean earth at time u is a linear function of time, the corresponding +! angle of the real earth, namely TA(u) = angle PSE, called the true anomaly, +! is a non-linear function of time, since the real earth has a variable speed +! in its elliptical orbit, e.g., moving faster at perihelion, so that its areal +! fraction is linear in time. The relationship between MA(u) and TA(u) is known +! from the orbital solution. Finally, the ecliptic longitude of the earth, +! lambda = angle 1SE is the angle at the sun, measured in the same direction +! as the earth's motion, from the First Point of Aries to the earth. Then +! +! TA(u) = angle PSE(u) = angle PS1 + angle 1SE(u) = lambda(u) - lambda_P, +! +! where lambda_P = lambda(u_P) = angle 1SP = -angle PS1 is known as the +! longitude of perihelion, and is currently about 283 deg, or equivalently +! -77 deg. +! +! With this background, we can understand the quantity MA(u_R) we are trying +! to specify. If we *choose* +! +! MA(u_R) = -lambda_P = angle PS1 ... (5) +! <==> angle POQ(u_R) = angle PS1, +! +! then at u_R, viewed from the mean earth Q, the second (ecliptic) mean sun +! O is in direction of 1PoA. And at that same time, by definition of u_R, +! the first (equatorial) mean sun M, as seen from the real earth E, is also +! in direction of 1PoA. +! +! I (PMN) have verified that the choice (5) for MA(u_R) leads to zero mean +! EOT to first order in the eccentricity, e. I cannot say, at this point, +! that it is generally true for any order in e. I add below a final explicit +! enforcement of zero mean EOT to the code. [I found that the order e^2 term +! for the mean EOT was NOT zero, and was larger than the mean EOT produced +! by this code (which is valid for all orders in e) before any explicity +! correction of the mean to zero. This suggests: (a) that I made a mistake +! in my calculations, or (b) that higer order e terms provide some cancel- +! ation.] +! +! Hence, finally, +! +! EOT(u) = MA(u) + PRHV - a_T(u) ... (6) +! +! where PRHV is the name for lamba_P in the code. +! +! ========================= + ! Begin integration at the vernal equinox (K=1, KP = EQUINOX), at + ! which, by defn, the ecliptic longitude of the true sun is zero + ! --------------------------------------------------------------- KP = EQUINOX - TT = 0. - ORBIT%ZS(KP) = sin(TT)*SOB + TREL = 0. + ORBIT%ZS(KP) = sin(TREL)*SOB ORBIT%ZC(KP) = sqrt(1.-ORBIT%ZS(KP)**2) - ORBIT%PP(KP) = ( (1.-ECCENTRICITY*cos(TT-PRH)) / OMSQECC )**2 - ORBIT%TH(KP) = TT + ORBIT%PP(KP) = ( (1.-ECCENTRICITY*cos(TREL-PRH)) / OMSQECC )**2 + ORBIT%TH(KP) = TREL ! pmn: 2019-10-29 ! Calculation of True (TA), Eccentric (EA), and Mean Anomaly (MA), ! after Blanco & McCuskey, 1961: "Basic Physics of the Solar System", ! hereafter BM. - TA = TT - PRHV ! by defn of TA and PRHV + TA = TREL - PRHV ! by defn of TA and PRHV EA = 2.d0*atan(EAFAC*tan(TA/2.d0)) ! BM 4-55 MA = EA - ECCENTRICITY*sin(EA) ! Kepler's eqn (BM 4-49 ff.) +MA = OMG0 * time since perihelion +! Note that MA(u) is linearly proportional to the mean (UTC) time +! since perihelion and only needs to be evaluated once during the +! orbit, for example at the equinox, since it simply increases at +! a rate of 2*PI/Y per mean solar day thereafter. + ! These anomalies are angles in the ecliptic. We now have to convert ! to equatorial angles, i.e., right ascensions. The first step is to ! convert the anomalies (wrt to perihelion) to ecliptic longitudes ! (wrt to vernal equinox). Clearly the ecliptic longitude of the true - ! sun, TREL, is just TT. The ecliptic longitude of the first mean sun, - ! M1EL, is PRHV + MA. - TREL = TT; M1EL = PRHV + MA + ! sun is just TREL. The ecliptic longitude of the first mean sun, M1EL, + ! is PRHV + MA. + M1EL = PRHV + MA ! Now right ascensions ... ! From BM 1-15 and 1-16 with beta=0 (Sun is on ecliptic), ! and dividing through by common cos(dec) since it does not ! affect the ratio of sin(RA) to cos(RA). - TRRA = atan2(sin(TREL)*COB,cos(TREL)) + TRRA = atan2(sin(TREL)*COB,cos(TREL)) <--- zero at EQNX since TREL=0 M1RA = atan2(sin(M1EL)*COB,cos(M1EL)) ! By Meeus quote above M2RA = M1RA at Equinox ! and increases by a constant rate thereafter - M2RA = M1RA +! MNRA = M1RA + MNRA = M1EL ! Finally, Equation of Time, ET [radians] ! True Solar hour angle = Mean Solar hour angle + ET ! (hour angle and right ascension are in reverse direction) - ORBIT%ET(KP) = M2RA - TRRA - if (amIRoot) write(*,'("pmn: ",i4,4(x,f10.6))') & - KP, TT, TRRA, M2RA, ORBIT%ET(KP) + ORBIT%ET(KP) = MNRA - TRRA + if (amIRoot) write(*,'("pmn: ",i4,4(x,f12.8))') & + KP, TREL, TRRA, MNRA, ORBIT%ET(KP) ! Integrate orbit for entire leap cycle using Runge-Kutta +! Mean sun moves at constant speed around Celestial Equator do K=2,DAYS_PER_CYCLE - T1 = dTHdDAY(TT ) - T2 = dTHdDAY(TT+T1*0.5) - T3 = dTHdDAY(TT+T2*0.5) - T4 = dTHdDAY(TT+T3 ) + T1 = dTRELdDAY(TREL ) + T2 = dTRELdDAY(TREL+T1*0.5) + T3 = dTRELdDAY(TREL+T2*0.5) + T4 = dTRELdDAY(TREL+T3 ) KP = mod(KP,DAYS_PER_CYCLE) + 1 - TT = TT + (T1 + 2.0*(T2 + T3) + T4) / 6.0 - ORBIT%ZS(KP) = sin(TT)*SOB + TREL = TREL + (T1 + 2.0*(T2 + T3) + T4) / 6.0 + ORBIT%ZS(KP) = sin(TREL)*SOB ORBIT%ZC(KP) = sqrt(1.-ORBIT%ZS(KP)**2) - ORBIT%PP(KP) = ( (1.-ECCENTRICITY*cos(TT-PRH)) / OMSQECC )**2 - ORBIT%TH(KP) = TT - TRRA = atan2(sin(TT)*COB,cos(TT)) - M2RA = M2RA + OMG0 - ORBIT%ET(KP) = M2RA - TRRA - if (amIRoot) write(*,'("pmn: ",i4,4(x,f10.6))') & - KP, TT, TRRA, M2RA, ORBIT%ET(KP) + ORBIT%PP(KP) = ( (1.-ECCENTRICITY*cos(TREL-PRH)) / OMSQECC )**2 + ORBIT%TH(KP) = TREL + TRRA = atan2(sin(TREL)*COB,cos(TREL)) + MNRA = MNRA + OMG0 + ORBIT%ET(KP) = MNRA - TRRA + if (amIRoot) write(*,'("pmn: ",i4,4(x,f12.8))') & + KP, TREL, TRRA, MNRA, ORBIT%ET(KP) enddo if (present(FIX_SUN)) then diff --git a/MAPL_Base/orbit.pdf b/MAPL_Base/orbit.pdf new file mode 100644 index 0000000000000000000000000000000000000000..e97bfea6ae31b95949fc103a31d7fd4a4bcf3999 GIT binary patch literal 224142 zcma&tQ+Fm@urBP_wr$(CZQHhO+vwQt*iN3fW81cq{eC#x>tNN<`~x*+T~*^IR}zz; zXJ%lBA)j9wU4vmIVj^-hv4P>^gJG02cd&G`B4XuYXCnH43x-j`+Rn|~g@{qY&e+Xd z%-qz`%p68Q0LInL#oX8)#%rS&$JTYL?Y=u;)Ss5U6^TzO$&P}xb$dx(r^2C5juQ10 z)Ll|K&ig3*NPMOLwr^lOx;bxYaUl*t3nW(m%ET~eXUp#CWI0=7Oa$~NZL?>Wt}9T` z*V+4J)DX3MQtigSr?Y1V>oiUNP(Fu@W@`GxrTv}RXPx8rZ(DaWc6G5pe`9pQi@57m zyS_VC$1Y*R%Q90M?+wEByJF@ph)cUrK_%Cmk+;ZaIYVq;+IiXD`^y%EvhP(+d!;x49WWu631 z%qHNxW<eQ^oIu7oc?|U)p#8~UlFR5~t+E|^1|!v$CFs>t4as9A55CV< z6pqdM8lSObhaP}xCNWGQjeT>x>JC}lz#UPEWeMJ2Iis(sNUd6zoygmae%@YbBcY4z zeJ+SW&^iuP0y8#47&fx-lLgpiLUBXvQb>i(+aZf|c8HKLhe*Zp+W>%V}^%D}{n1A55ib!A8 z4hCZiG8O7q?9k^!<1~`_Ee2)L&?FsFe-rwwBM_czxAEJ>RQFs}IOc!0fJz{QG~A9K zFu?ch!MX+aZhSG_ua)4;=bR1@f|iMb4n)c8x@o4Vu$-v6tGADo$~7NP3vJyxZKM?D7yL9oGfJMfBu9!#pH2aoAvl{|=feB`&*6UHC} zm?E`+Y6oYFe0%Z)U#IUD1VZ;OGQ)aP<5t_Mg5&QP2* zfyv|PqQ#yE3Y2M6T>sGVe5*~8D@x7c_Gib#PQSRjyYeo*_V~_fD`9kR_5QS7TRjc} zfsTXUNan%Z0$psvE`&xNaN;Dy64veZ(H)Jv*z3Cyssba9Z1Bm6Rh1d7@EZ8)wr{@n z@XWqUa_!|nUM1)=lE8dy8}E+c0vuF2Y`)sv6t&ncl<)3?WSiGm1vw_hgG*{T&_3Y(85T~ra|llTwEhQ!8w6snh+*H|cDrr?StMkNcw(Z7 z&JuBeTo|%(d(7)ZfQR)Yg;8(}Aqbgd)yn^XEL@8;1k{TVx8wQ{LQs-(P;LWoURTIb z?-xS9n!$kt-CyOZ1Qk^$9p-_g|F195@!x=nT57`8K8EV}Hb7Npf|^urN={8Gjm0*@ zI;~#Tj}A@#Ho0!K^a9=KtFOXYiknqF`iuhcKn)Jy&XF{FZoH+tdJ&Tnd#MoPp$%32_y?fzK`kEaLj2MY9@nH{y@BjX2Ne9B}2ykR7$OBt9}F zq?#*ac0gvVq#Y{#Sq*Z%1;#xFVE`u7pRbNSRiY4Hm4SdF`qU_12rCP1L<)YKXocD` z!#2}2#nN`Tya1XtrtOgAdY zm&;vcSoZBP7l%cKqCpr3&k$cBR!S|T$0H5Mh6We+cy!u|fKy{~z^HAb+8MJ(u}1Eb zhY9~%Z_ode)pKu0xMk`r9339jW||LR#|FL&6LZO64Fea1ln!T z*$~fBWkGTJmS@LfZWQIx)wbg6dx0qui-whs%LM~!RFRHU2A z@_2OhCp6hLDGsbhV#p_^kEM}xyr76Q!U+y~ll>Rt3-v2L8Pzf#a}p+nXaigX#a_h6 z=8^AX&R#w9FzGqzH;3*XL#-uK-7HhMVWT{w3>E^+5fN#kGt$%(-2+1)rG`V811M|l zamWBg;3Im_%mj%OIWB-OB1IIkW3ic!(xRiklI3Mz7_)_)GT{MsZT0%412UX6v(Oyv znFtS&w+x*+at>%iU9F{yVLfNxD((gh**PU#ey;i5n}n_edqg={K2Pb|9O6Mb91&`M zo~YIu8*VHI>M~_fV5FnU>;ei#132jH4qDIyY1cwW^nsS=V7wR>yahZ%v$6Z-qx z*_W2=>49AARDdNKNu7N>*v}&GB#)rMiG6on>97l7PKGI+#@>yFb4KFn=d9(IA5VpUDw#tWzcX4jW##hl)dSSF1}jK^~udc@bqZQHQn z?Mm)g8wKJ@rqM6NU?mypZ5`%Cjh273z)>@qmsg`)awzhKs#3T$EMO^j8C^~w<=3Z< z&qUp3Oh;}IR*55kI6Qfza;>nMUMltq?@F-xPg=SPKt&n&J=Lu8oMrcX)r71k|BkdQ ze9JS4IEe_+7fl62tq%qp#aZLE?+t-S;6d^N z_;?zD2tH_hjOPvyExaT(ce+oD+6T76Fg>~9jwkI2Et2=|HLgtY_shDeZj}8<`@0Q>4q`K)edTk z@U+{01Q&0bZ6unIkqz?$1h!p@%KZ&X?exU1~48;MI^fdE&`xE2(OZ=)fRQH-eCT@%14zI%}8lifem$ zOvC*1x|3#RyUC4SBis_FsF{v*mRrYby^jMvRzvp#1~YIR`rk-H8$=CQSvA~R4+KyH zRdxG0AW5I?rB^5DWgo&o{-`)@z6`n4DM<;Bmtu2w zm^W%1h=$kfNi?k}r4#oGp-P{+$RBudXZT~FPyM?}RfE$h6dhF>uzi&vT&Ugc+KMid zQ^@F+`s(U_LPAa;Fza!=-9)d&MCv-`D9;TjT>pJ$ffwNY4BSdXTY22OsEx(k7j4s< z%~=@#LQWN)nq!#l>*M=8o}RbGZ*ktB0)??>r$YoD_6U4ARP<>HP24>&CEzOZWOGAQ zz>y$rZ(JL>OLQi=UIv1KFJT0Z-*yS@P%|Z?9~Yr zRD~CJNEW4BQ^2gQQ=y1&`)Gy~%3*PXLH*KFGz}&ew>+5~Y-U1q)FVO{$=ujPEnuyU z#&IUW!zVKUaZH*->G}f~G>K&*eq+{?eay(Fg%LqP7x&l*2b(<_+oW+qZ&*B_X9DvH zKladXf~Dey9y>pGlXP-9L;9-+OY17F``r; zhyJ|tk6*GN`&1YL*B+uIL0cxHkup(QN)i0^yMioeDz}Gf$O#5{zzxVeZOp@RALT&X zLFs&x6>%qbHcc?8h?|j*h%5l|UyO78SOy`)>HS%k77*;7DllB6Kg!>a-#YbiDN}W| znW)@z;&Qu=v@wKB>m-FL9gQEk?L>b3Ou45%9R)r$Z-Y z&Q;--uGm+$i4=E0dVlh{<=Sf7F6658b#;h~UfQ6Yx|6wO6$Je%dI??yHDak{6l z;)psr+FlE-2nkG%U$M3+e+`*i+37Z+V-nwh^i!*TsU{})-9qy(a@a7`-0dx}bA({- zlWjsNXA#8ba=hEEa{GmityWftF?TTg|55zk>;C~Y3-kXZYbLJ$t*p0owNtm+kOOuN znH~2t*x`hLz|PVL(Ihpl#F|hVrjDDx2J-i9s9Y!5C+}^(FBjt>yx=VuWoMNcyoHd! zaQt5(>2!Pbo0g|oF&@Ei?hNTP1nVpk19?9mN7o7al_mir+Btyb(d8IeWJ;a-zbZ}4 ze(p{B-$?#DOO9BwZQ|RR-tK)0Xt6Ke{%0Ka-rI|=o*i46{)TqvO^&mHJ#R1+m@Sj) zbgZCLo7RS!;ydU!k3%z$%ihJsC-W--MS(}YoF@+%0f_qA{qBoX=TFg5?&aT4jvYz2 zR^>RSL5QnXEhu&MfmFu@L!YhZ7|3<2?+BDe*u<=?$6pa+Cbn3Vh zS<`uBqFSi7@uT8&MpjL8RQB{(=AYsuoCNgwR{o$k3?x8Ewa6UG!G?mW!SVD#Xj`U0 z_@in`j`GQBrV7sm)sKjAcDu9;mq!5-0+J!yjIBKmU;gYwuIPaEbW(Tyoa7C+>1?Ko zc`pYM%=I${2pst@7Ra7xcH88Bo6LvhLS#Yr5LwWWxElUFZktvH)egy!>eq-Z0#-?! zTV+}PvnD0@^1kaCSx*>AD4QOt1+K_%YuI)wA}OxCo0jWZU!2c+GA@fdEj`RjGy7O0XK{Ytfr$1O-_Q}0}&s2H)Uj=8`@0q!*pL^nn6rKt8dN5SF zLdoqcd@LR?eq2=>+u3}l!bWN#kmumZ5$|of*`7zkStc4h?)6}+khMq(v(a%xAlZ5& zTNj_=!0xM|sHqkOblc-r*f|dt@zI;1%l@qbWX{ zF*yX^wm$XBv(4DKs)fwY5FG~IAP*e-$IaPMO|R5dT~4plu@IGz_KxOg6oJLRRq-R? zxPIDpE|%}9jMBq8gTBsX3PsSTj$gsXTN!LcTUr%_&DV^F>p_{DY&n+*jWjqaIqe&Z`}=yLYR`w_&NF@(qY~$;p!=HD}8~5hs6v_4x<=A*n~i4 z-i%@kAt>}7<%D*i3HXhjDUMO`ez%~7ZM#nAL~@Oqa9k52>(C$m!1ZKjGrUL}F>k^= z+S;4Vw+1a^aleJC8i)o(8h;^3%UR142`~HXqXn|6_CfnNK~Jul&7X}bJ{~KxXuVm} ztx$vtz%!xcH5s2TsmBJ@w82nWO}ko-Y&LJ=bvZO%PeJq|lxfZ70sF^KK95e1Y_BFY zbGsJD%{*_E`h#kFzn<4d{l!TKAqFWXB8;BlZ#tYH9ANh$<$y*4tLJl^`f7IJ-*z{S z<_NLdAUixGY0oC(VAk5p`j--STMZ-Q^yL1u^*7U8QGTswCNB=FqB#KtSIQE(KR%fn z`-o+v;@=AC9q@JMWsyabUS#8hSeF!@{%8RF@mPJO3>Y+8;7QB(bsi{|wt56I28}xV z{>t(8*1x^!DZtHeCvX1yH`5eOlx(+P9&MDvQf7ZUH6a|SLUX0P&n>I_394}XKIB@T zv#V)-SbjoloR;-FOmC9vN&+644-pWkk*jt(()fpNT*wIMIP1pUUyVQiluJpPleHs#rn8p@l5^J z&HbYoK^-=l5xoOOl-yn_dG>Cis0+}TpYvyNw)zmlASY^2Q4tVN)ZDzJnD3LVcwn>- zoTIga_9e@x$EO~(EMuT7~q*`Ep%fMLCg=6)OjJ_^-qzQ1ix4$4Nrv8XR*!KJ{P{*Y3_oAFFo|I z?bBowQm}K}h^RSf&B(A$x*5_F9@8WWM*3=;w+l@$$o8>a!e-xV*g;g~?Dk2VI3wvZ z$a*8__TkxN*~3glOCn&UwrBelU4tD?s@%4nU{>B?Y?d4#-m`?jA0rgDpKq~fBd$iZ+UdF<$% zmnk`vV7r=k-jJuX!C_}(VwdZA+VV4Rsc5sIB7@ekfj3i-fQ={^u&LY_V}Bq<{z5gt zO10sF82>Q=n2_EqGTuQ(W1+>B^64kGg~ni#<^YQONqUQH*prdkFv^a{snZm=u%Cq@ zYX!8b*dV_wrsOY{C2Kt+mnV{z^Pqq(+}tB7ymaLFVN@#stdt|C7%I$Xf&-35s*?T- zH@p|*n&-W+J&zEkaju0H&2jk2?ctweA=Ya-80y4lB*6gEbj5_UM;LYs>Oy07UZ(P) z>x!BQZ<0#K_AcAp;mv&7@d*E%GmHyNo{OSGaHuG|Xe?9|C=1gj`nUWJ3%}AwVmoE! zfhwAfI%u>*QTFaWyS8?Rfl?c^y!UG4+$29jCNE;L$eJqv%~?$g-HD0-^PKjG!;A%1 zQVo70Ds7b@+-&(WU1)*2kZqA!9)s;RM?XXROPqvDZA{}yX(Z;vWf54aX%lwj3s9>V zU^&%q*bh~DT8*c5N&jYLE}EehkW255>;f2^g}HEwYCHlZfy>|gdf`(a1m&v7!g@}6 z)CW^klXnr^CjBZIb1hKIL*jOt!un>ySA89&8WZ_C7+|FIxYL|+*=BXtq1K_;U~!-J zUfSL=RjNxsYC0sa^mJkLlPN!ymY4f08cZFZtyyVU%x~LM5v)@q{7<~8g5i|;&s_W3 z5#NZw3vcY*Fp>+6&pdYCBoD?+o^1$0Y_?G%=*@o?2HDXuw8s=sORqTTT1)e)DqZW6 zhckZ(`^6L*W0fhSe<*tn8hgJ<=pq&_AG6=bK@j+-ROpF>NO!`#PTqGF%L+{W4hQ%c+Ba3LXwVV5Ln%MWtI5 z?s`TY@uXVPb@|XKC1lCKO68Lj%$t z5LY!lQ+#t*rD8PekL%{V>p8~X7>{Gf>n*!gqaQF0VaBqT;q=JkgfDK#3lx8+=dw$p zS|pzG4*b4>pqLz!WM+JLqHK@MEEUB}(dn-uww^OcG@E_cqWt?~R*cf%DCMGF!&Cf&46_y_+E#_k(X<(l1Xp+B0r@IPbyN%@2R^9vC1X5i z6n5+I!v;b;@EhKj zN`VQ2W@5f(aeBJL#%RshXN8WGAYhzr79hc@`&;ZCV8vsw0*!N-K4r{&!To*mLKCMVDb; zBgecI6&axVB_Ss0_X=Q#(Ur*zq!~io2HI5lti{ep$6W?X}_^M&fby%MdA&jIwPr9 z!8)ZOFM*}9D$@v<&-{_GKVc*Ju~-wIE5kFLVf9p9EMo+J**<%^@T*ms1AgZHGNgz@X#EL4&7-~_`?UriYp1*9dI$z7`IPM$f$*UjN8Ow3Ox}vL8Ctjfj5V zIY^yBRvZX)IqO!#2JY5W@%Q%jHzB^0{on(pv%Tbqh%gB#e}NglOW%Cdpy6w{#pGkS zOegU$dIn-?Z^{>ob};N$Q3E4&)#sf~iXmO0cYMKnRfRQX=zYd$VPnb`%B$#ox;kde zt&0Q`7bHC(_*F$mc(v_aJ3X?q#`>Xk^77O$?#woZ*xy#ceqPWYtuWcnT=26C3%Vq+ zWd%Cxu|ZVc&aPimVs;u`l8VJyt<(K6IQ_4iw-t01~u zIO&a}8<*5unmia#8f&X_QmXkuIDQ{H?h&t6AZ#qYe4&zhr6mU#S_w#cQTNAq*Q1>>SB4W$k-IdQw48`eUkw&u8yuLhh#rVjWJA*6pF5kMoa{S>k zh@QWjnXBJ!cNtmtyK`NCdwJc~b#K@{bF8SjJ9I>nt%t0wrL`mfX``R6j~-wU?%mgW zWV3U%A>ThwIQ7YN@{#|$<^FuaAjf!k-bqx>^q-rvk^-Mu?VS+b2Enh_Q3UXV!KVk< zXB+pzNklMP!p)e}*8*DghB+?F48M)_9jY675(8?$sFxbKI`yJL<{C7lx|ts%%XjR) z&07W)d3Rsts@bP^!x^XC7uEH#He8i+tcWSdne|?1duQiOpcjh?l{}44TzWkYqE`bd zH+8|F%S2GBC7jJM{)q*rl=}Yse56#pGrG52uG})T<^;mYYM-x!VOzio!zXJ@ zW5fYZ{r$a1Nvp9jF8%v>f*~mXpM{_BHYgWVitQIv@BAagKz+{&1FtG@PkQY$x*1q& z(8OeYG`<g-B|_x#~I&3Z2yb>@vTfQQrQ&+l3De#LMdM2HCQc ze8WfgRy&`KAEkryfUCLIJ^of4y#b2_+8lBSI>{knCA~C+3L`wH1e;EG8kzmfMD^$S zcgq=vOUCMU-c!&$ZoFU?zIsky#r9|aWnyNzA?CZp(5CD)Pc#9{&^t%n(h@zN@0SyN zg-oDSy^}b6P}}iOLS9mI4Hq*mbuiBTNsyCw_?s!{+9HaKmNfnbgTQp{RMsKvSouyP z4}*_HBlxZ7Ylp*^;N2na;O+?=K3tJO?MF(Oo1b2rT&9JUK#3Q?_f8dwfE9;&^HI0) zpnEhVTpAcWc;o%EXlpGp1)Zeoe)^yz@%oj=aZk!WqR^~gK=g*-J?WC)q16B{{9V^G zXM2syp`*`FN%PPULBQF&|1sgPU+zgCm=B(9a9mXDUQ;~5*O_M~;Kg!mtOCYw>rC$c zzrPA)Bxk?z_JvY;WZnzG!zdv*XYS=RsT8Xf@q8~^dZ3bu9RbBIkN`e{x(WEKfWG!j z0KpC^oa)IeQjVg$OevYWq*EJ<-0es-3!E>XA{@lzpaj1DPE+5Q$U6xWre;#*mJ37`Z_LyQMQ8g#h?+IqPxr+9X467= z?{4CHFAkSH9eheD=Fg4bwW`0{yzNBpUr(Z4<=Y>)2q^=nxU=H7z^%I=TPeo#m6zXm zKbZQ74=BITe;mH(H>z_#FoX~6mo*eT^ARCcJLkZ1ZmzrGP_ZCcInM^&4@o2;5qeEg z{t7)$;JLvN*Yk7UxJGQw{;t{K=LiGyl!dMnYCijPXosUqPGxj4616iuXg1%%?)SKj z?TN^hjZCfSmaD|-f>lO*-OB{Of~1Y-@)IKFsX;XL(UjxnV@aC2hdKEt03kxIB~=w2 zWFR(THb|~b)!jh?-9W5O#S*FYaK@Jzb!4{q@_aQDA~3mKOYU1RuH(H-ofxZ3QP^dv`4p(h7i=Ez`v9%3Pl^hW5m1Uob8g#k4-Ju#p+ORrcagh&Zfa_7 zW}vS$2bJQi01UrI$c5q9>q+f=Ix7XaYi~2lN(*Zhgfy@ky2r!^rrx~^e*6PyWtD!v zH)Q9Bs70JQJ)V5?t57Ps){2xQFY=ek{8GePS?$|0#FT6{W0F|{zZ_Um@*;7##j0y- z$V=lvA1!Q!UMK@6@FI5xaM+u%JW;MWWQRpkTTu{oit`h-`m9lEg{gEw(dF5xYQRHTa9wQi=2Zb*jaMP&qa!3veHO$FXQU{p--CEE5$X3J(x>8+L%6<@#(KFy&u0-j&AsqXzt9% zaRB1Iv>X<2Vl{^A7U#Dk?eE@o{g&OOeH#sAUb{+9do^B(_Y^9}XFvB;36a}`MlQty z3jUzV9PDlnu|qI;0tW>q7u+iWSd4vMORgj8mho4r4sKzAu@l% z-bAiW9U_N3H=R~(P8;kBpOHi>5HhDww@AQ@vK9?RS$jLfdZsb?-y~37r8C-akQrk{f@!>8>3pj!_~SDhqb{R}HiHsxB!f z4D8eVj)rzk%WX};NGvUVx-}ePcwF~Z`Nhl5r zyc=lqk>4lvUA=&sjheU#=}L+26DYyaKM<~Pmm`?aoC1V}#-ozd{9FfW5R$`v#)m4J zN&yZNRUhK;ZdbtnEwb;PBN!Y-ZlL1?1}$c}^9{j+OGC_|I-WL)mmUFo>LZ|I(0b29 zcjx(jQ>zehU;b>SMBx0Eae)QywW$UyUX+V{I|+xrWPt`Jc-P(W*ZQm*{x$agr@KpM z*Nh8TOB_4jLQSKh83lVric)+AtDDKSQ9N;Siq1x!=->h^;DbFz9l95qeH~shx-AjG zZ2ip@`HifM^oZ;kG;6m^TXVgcu*o@)6g4}25IlPcqIb6T3ekn_OmDI!G$pXv2oc8I zz5IxhH%6>*UA|d_%g&U?7lgMMA~%o~n9#xo;SKbMg{5ko1&25gl!@TZ(j?i>QW)aF zwPTtCt4f+WxcUjaa3KQmnpvxeaMP58ECr(g$fD8on_Ie2n##l<)gtar*ozVzdZMcm zT!aABE(n!$B-`VTgZ8h9O*V?({&6di!p2bIhwBcJ={5rnyG3kb-Yy}lHYaG`>MWVD zoI)xJg|f83&`v;^bp)=PI0V*fV0N!}4UBK94w)}2G{2kQ=t;>mU871*3HV_#r#^+Y zT%x#TK{n(T`M&?czsj`r10-=}Km>uw9BOpVge;GnV!U)3m3y#w9-+^q&(hIVWz#j$ z>OJvc-rUWiU2JL0rdFP}G4~_L@RODZ&b4guvr%gkBfD_sEhNG5teKfLs3`0l@V>XP z-VA*4v{bDdJAou>MBhj`)ajI{j;`B z@^Y*+ecK-2N}QsLWwZ-dl5|4C{j_#Ws+*x{2dkRv-PA7N6VeZ#1T_L0Q=va{?{H~f zg_{AebuO|P$hBDq&!XJos<_(EbjK^pTR68WO{xWK;GTo4bD- zc(vHXgoa%J^IZkfG=6liZKc1Hfs0@q{gO@-wdd+#fMRfV$gkQrw2OI_%TQzJWB_sV zbF!ExF|WLFD(7PGi{Y#A6AFA8E|XZs=S+vl(HZ<#qVOr#PMz!n7xIU_^M^6~$sEwc zy*8bD>Hh5z*-KIX;I(&$7IB8U0VhfFkxQhPcR}|>rYZ^PPYCxHFf#drerx%3`xFQe zzI(@v57eb5mCBe|lQ$ScDQQIPDGh2s-#p#uvkr&lK!Ja_W+CD*+!(B3SsWxMH*WLN zd7oxJz4&K>J}mz=&oNc)G9z1k2hZ!Y+8es(>s%YG{?8*@|MxWp!q9oMcD0Y6p+^_e9#Z?nudWd;)i}#u`oYeyF!^Z!rouKKvLR*iM^EN_K{__U4pIADY9%*(E z`QTtWPfQUos;PLEB}D6$uZ50H zcBEn(Cx@?vXJcflBKGMlUL5EBxQW;YHW8AYo25PD>p(oNS~ zixF^psRRv`GZHc_H(>t~cf8H*(PxbcScJyw)@$zkX1LPd^&eF@$@~zOeaxi%-+L?8 z|0zMi&GElZP#o(?yW)P;OS*_zDKG!BlB372K20DARuw0><0nGlmC6V zeC)EsIV0%N7J@UUX3)eIt-LQkt=rZ0IXl~qO8D{l|29_0%pb2*pO3k*jE)RHZ|Mi5 zvUw{mZjT-#VMJRK$;vTWQxcq>C52;w+VqCXfZLd34*^}da=nH7VY|-Ft@_i%&4=5W zo0(z1Zu%R5V0+EvWo|=o$3zq@Nq+byWb>~cT8q5$cTeS+AOF5h&qiJ5y~OSeK{dPM zPG({EjNf}b38U(R9@3#4*>4Q=yQ{SIx%B`dgO!==Gj_oaFnB$GIJIXC)U|}_WRTkP zo8s$e7uD^!R&$Q+0aa{!jfUA1+xtU7F)U{v7@s|H^xX@AaQclLB zNB=g4Dt~#{PC44NS8zCst_7} z=haTDM~S}ZJc_sslWaGJ1Sz0^GG?aVE#GE2``SmNBjrFeKp%4&W^tJ^PFeycShCupp&}wM89sCS}J#QFd755CH)VR&Xz->KsaNzZzpl6*fZ* zmh)h*kf!WtoG*z8^3FMuU7AZSU*i0@**#yOgvC{Ym1njw=NIrQcm0#ib@FSZdma#I zvNyv`7??mE1W8dnR+NY1$)H>u;WP$B$?RM!#~viwDIjjL?ImpCHAuj{YZi~WX)8w{ zpodo@bmB7Pa*NUvHFsZ~qP?cc*l_X8I}in7x}GYNPjkDI0R^}WuG_0Z{6c-$LK$gb zr5biq`(04Oin3P&10o{LZa4{A0X6}jW;#|$2;8yfgG%<}+az)U37bH56N0~a$lehI zHDj)^Z=$x&ID==vsM%ciAh?73LLboonETCUVrQr>6^n7cpK|Ea`}T>ZVXcI}6k5-q zI{X-pQ#JJ=fX>6HqA?sK#o{f;s_+YFdu2=qE1)6Zo575gL5ZEI?%A+Ms^K(vMJifS zN(oj2V^VbI)*{C$s_+sv@ug8KeUDLKWeI+mv$iP z#QN<$IPW&muC;`XvyKVntvw~Dch7tL35ExAhY0wGbXk3+j080m^Y1=!)MrR&p~mlO#sq<<*FW(pe<%asrSGHD zUzSwutho-UXLo{_7<=*2MmIa4t_>6{>#OD6q5j5t2Q2WbTdSEVrC|%4de6WI{f}!P zd`?Npx3L@$Z+rpkHG~JmVxVS>)YXbT#3m1fA7$P4{wN$GLI-v{G1}QH?3Z9dX7RbC zre!HlZZv8ZpNJ_EH>DG!S&nY9j>G{}C58W#9RiJz{#GLp-48(d#c_FgPD)cdRv6GF z*a{<~V2WT~h9Vf$#6^TLJ&8PuB>3oH;h+95j^y5n)BzkTOYh?RFAkJW9XgmCQ?-F> zFRKDCDT%vUX6cL^TSA2K@o{g1$kE(DUM`m<1m9-0KJEv*uq>`sOojGt#-lWiDC9!J zN)DKRDua(DC4_BLWhYKNCPq<1`8+;=^5yV9^ouo^ypMg+0#?{v(}>%DUN=iy@QH(ck~Y z_T@(K2U|I*ydvNuy9+?94T-rd$)ms1T8ySLv)k%=j6a+1?=!3J$)y=OK`e;@1W3Ql zkCOT9AMo*p2x`91O_`>^F-tl?c?*GR;&?o^SBLPTTY3C6QC^0Y1J@>w&*ir;Y^Zrw z?>gzH5ftgt2)O6cb(|uM{9*HJ_5Qt6vRl1n-Jt00pDRWhxWvccJ#nc^re5ERQ3l0N>ip!2ia_v& z)ih%(h5h6nQontBmnTA5(_vV2=U+3{z~qpLU+rV$lhYdZ#f}oeDNs=Wi`|lzT-&y_ zv-?DHSxOO^tvZqg^GH68AU$PJRh8~vYV2GIs}bNm!sesBl3=egvT$5b)>v8v=V$P) zb-GTDWM#l2xc+?uT|r^jKq!*Vo#C4#sP_4idy+s1uSz!N#JcvT$anKG`))dU^S753 z%lo|P=gb%{@r3Ox+Psq{*JN|L?S)$p%&%**q6MY3j5J&A@~`?Iq!4 z(?SFRPJiW_7en1zQX}9b{pud+5uK8f{y1s*Cp5&D5+*62A}&&`qv|aS`z1x7k3ZcOKK1)bur^<-GI*%^-gsT8e&xq7|66TrQr-tu`G@dyUtQd=q-t83_t3se<^Y*t> zMPAYa40=ZmX2c`dFxQ<4IF!r_($7nhVA7`Y)w3a0lAhzk?t0XJ=gPdd4fcU2Ce*W< z*csJ81eev+CFieV%wnjDd=k|SOVV3PGd$~cJUQaR1!KW@xPo+iRTRzwY-S);Y=4wJ z^1jZ|v#C8O|GZ=HgO(sz8Yy5`oO`lFF}p2kvQv6*v?DhwYs}tlfW|XdA1`HPl)pT6 z&U}u0Zd-PuAn28_y0L7#gr4rLynt>|9tk|-JqC4rbCc4TenA9K3$DNx`t`glW?dd2 zz+M8y9~F`8V9z&Ds+y1g-hrAN;)dm6F7BI&NDgH9M+84X4-3sKwkN^Of2&3~pxlv* zLF}j3ne2ETFVz?wUVq!gx?_PMLk9lPU)aPS5bnicuVtXGze{@kIkwRr(UwMr2y51! zT*iQ-Y)iE`yT>f}JK2{{^@W!Y5sS{~nsk4LmoFz-?yp#L5z9YD`94M%PD_9}`hge# zX!$t3H1u%R>Rb_{Wh|h8>nrHf-d4ZvoUv(o6dWiQtLVd+HSKY4_8D^0!Fkg_~9>#A#duQFNc_VV(Y>-xsC^(MLp#uaklu+nG=CTg@g7EI-HDdVKIWI9!;f?X zGXjF97z~Hz@t^I`ARDDewj}I*2jPDp+0!u(3O5ZB2LVOw9iHkLzLms1Y40Aj<4;E8 zAAuE+RKfL2_>z~0O5CB~2%*`nZ?fBj+3{f!diSIlz(1tJ9+ioh4kaS_dl5Yz2qbz0 zg8S_}=#ndm)ARMc5cS>S&K3Q2$7DZ~fV;*C zSuGS>7!NTs%fWq3oVWrFKg#5~j}J3-4&cf_GDAOF;8*+mNM$EZy*!Uvo#JhgZtE0d zX`3gfsAEE`CsizG;DV&}-;FcLo?{;ih>7QoNL>d&`;3Uq7;2g1y>s%I+C2fD(4XQWDG>-P53$Q2VnF=yebZh6-+)q;V@)Q3Ne7oBNif6!S;&`}Il^h7Ii_nbj;pcy?x#ySy`fdbZBv722h1KtXgcx-Pp8I;`iR6xB7nuz+Bc zXuk#IY4G4SLOQWQ92-3J@;@ht{u~rcX>pGyl?J6vp9e^(z{ik5!e>nTZ)vfdS*Pkg zpz<=7R6S>9b3S#MlwU2`_yV*fJo)VXanrdrRDJOX56HDLv@9PuA^C4dG5mL_H&CD8 z$b|9<_z$dD3I%YktD*i_Vh}}Fa8D@X6H&e(mL?DzPH>pjiq z2YPaU9{!JE?osA{LY|5HH|PJ+6DDRUL~Bhqzg*p%pB62@f)xGv^sUj8n~fN1FE97b zo;{sfbp7_9r_-P19i#4C{jd0~)s69|Hvt`y5!A%Fp=ZtweY>;tY|n=mPrNg?VEK2z{;%7Z!J``JG9Svk zV=@vKK^lqrV*t~k_(Znl5llnJ7_uP<4YCQL z&%k~%GnEj|RM23wQ39-lp$n8GrnwKrH@}oQ62~-19Fj;wjxi{`y6CJR4EQlh6}b!r zZ2p)}MzXAU&cLbaRQxBdMhaPsWm5PbM>gPIj&H~OG~%piCyclLc0gd5gCUc_VpJ9( zH)bi6nNbkM(1G7f4Fx_t6YzL4txguw>~{gSK>!URzKB3|04QR7o7%)FCb^ISe2K~N z3tN)_1}K>Ip!+Dn^+?Vq)U^3L{{6}PdHEmbAtwhD%=9#hDJENv!hwkD?&RormhLe9 zKJmUFO26sw-9jjf>irwr*Q?1ro)R%<$BT$mrsXVTV%>o|jXi-#kWj+`6;7Q48QDFN z68qf8Ujb0+u?T}1n6uzkaVWs1GD)wTY+tVfVkc=BPzAufA*k4nZ9O{9KNW2ExT1iY z%7;J(^~W!PPN_`lmL8nPR;`kjSP{4}ofuD-H++cTOK7+vDqmdp8$qR1X$y4Z&bb%G zx5T)^~55D;ZEi`DatW_?cA>#;GoEsHM4$q0byqo1l#f!= z0+9+?lw1Y|89M7_5=UqXbzl=UM9GKb>Qg!0(C7}*!Pr2A6|C@;4;PY1Sqi|08E_7! zvfyw|UrNWvhzKoQ#$K4v6zt8iZB50gM2vP%@Rk(75;F({5Ox_NGF<6L%!G|XtacMV zm>X#Apas+t)ms~tSNFm4*_NgVMaGJ0!Gl-0mhWxk+~1v`uvUQD&Zh+ZK_CR*2DEO- z0JPU(+Zg7N#kV+!oI?vmN!-c+)CP1!xCxKfG? zKoBxIh$jOZDp~+Hvfh=h;x=>;llFAM29NsWj|?}w*dA8m#w?-9Zcaq;r(7jTZ^&T$ z0a6IGk2nCe0F=@t)uB225MD;ucqIoN9v|q&X#Mj}`+C_mp-2L#aE_rUtVImH?#f(GMH&7f}QyVsa6IGx8S}}d*>tMi;qT2;;X!t z2+=zQ2vn`++K%DdR`C^w#9{V;bQ=rzRuqc;-YPt=U?*KYDxOrajm;jj~ycG4T0s3(BjrhD$892n;EQz1wqcREiL+l)f;}w1)jni1h)Q(_r?;&uF%8Uz;v(_ zdiT_d1Vo%hSqnk&RDk|(T%n?rf%@x5SGM7U<3oKaF57k@AH75xFG|~3Y{(KCW(b{5 zTa*H!*MXC{1HZg2v!gx2Ncn8dm{Dr$c<3?XR}kA~R1OF3RBO;D0eq#o3$2-bP$6~ZJ=$F;{>1Zb^ z!a@@p{jD^$R6up1a!4Dp!Nv095h?v+`f2#!DUxrE#y6s3~N~2Q5_ivM8Pd(pn^-XdW6< zF{zTWA)$4_5@tYY1~MtOI2i3NPcY+AwQ?}EX?O*zgC0e6-VWD4K4peomO~SZavDXRh6lA1fs5Y z&kdD%Z`}^+7rdfH)tKG9Tu_M`EQqWk{tbNNy}8?o1Ahy1#~0tmI5xo4VmY3?2%BJZ{|Z2DK?%xlip-_*B8tv<*!FWfp8 zPz#m%aYj6Xz!}5bHRnR)XlH;18Z8V5coo>!cK(I9jER*yey7h@eoeJWA2KB; zA!>r!R{lTC^ZMoCyV~W93B(vKmf>;YzY{%VLM8 zjBJK8tw_WZOWSVBOI?oHB7mk);l32a z-AuP3m>NFsSQ6^$Zjcf(AgJciWBO{03jB#W%Q9TPt;ze#b5%hxH98KJJWyuP7!hC! z)7l5*B8D55jzSMJl62~zv3v1RZStU2#U*o_Z+XH)^U9MC3^$D3XH5r$+^Z7!gC$VU z2CaaT(`4g_NJ^@pXR4<&Qc)b+$H?t~AWC{nRNE>>A_p=~d8<+`XzbR_^rw22tuzO~ z&gYVW%C?!SWg{MvYJkeHtWlFQkQ%jDx6;!@UF$6XVIz?K1`Oajs+5+oXaJ?UZ5e3b z?!d-5hawo2`YisiDo>q=1!q(hh*@GM=!Pdk8v&>js}%ouK+}&Fm<`^Tt3wKIQ^ZMu zv1qEAJWI~eGJ{1vPm&15-y)x{1^kkt@b%9agYoh=1JJ$*UMC8>AnGNdmtofuMzR^ErYK&mno9qG=-@6PvWLMIj!H2#C1m(Ft6?M^AyQ&E!f@_F#wMfx94gOxb(K9rs_AUw4D!KA_c9NqmK)LqmtO)&p&GW_RP zW@))bN%Hmc)*;%RO!D)yQ+Mv($=kwUJpK1PTlJQA&He}eDf_tOUn=GD-*2zZp4Sup z_thedN7qpFdEe}McE9sW=cW_EFwUiwZ+pHFn7A-$L_DMT$v|i3GO=1Un-rDyGqc<3r5-ZgP*ge{R#<@}~^ACegD^g~UbIB%O6N!D$GiG2yXx4K6zfauN)*e(L z^d1Qt@ZPBkVvV0(?ed?|3d=x6libR~Qy#d&N`b|JD!2Gw%T`%cXUk2cE7gZ$Q%B&z_8s4V(VOtwo?30#6{Wg z^NVWL+62a|kl3A+`uU6=6Sh&+2$1S}HP*QZN?4>_HOs3qgnhMuEDD2RUSlkUx1Fft zaCf#zc%7XMp2gdM8{N2+01oP$Bk9+==7HpL?UIPA?tjhT2Wfisfuavo?Jm4;b!%9E z)}Oy>>u;-if*fLUb{C$g<$HMA{EZ6_YW|I%AP}^(ot7_RBvIAQW zlL@+dBp2k=Nh-WrB3*BhPHYpmLyGYXNOzYq{FKpJmOrLfGMgqJFL-rza$s8FZt~Hx zi_4yPGU|Hjy->_=9i^Rtr+@iys|R}w^mL=CI^WWxs>r~mhWjmtqk!CWiOwSun&hWt z*EOMpAXQw>1b9KZDHv9flr{oc!&!GB2GB;7pv~m7=1Wf5n;T9FN!0S-stA?EZi(k? z9+QC+mTCAEYeUb6PX8u}Jb_+(;I7XFz&Qb+@O7N$S{MV31!rVV;VGEZgOI1@4oi@5&&)@apm({6Y!sdW<}|8IszB zd|JXr&Lh07Cxo3EC8rDIm4?ZvGNz&TQ*-Ut)O zKWu6Wwc?FfLO}Ud&^M#t2r3X(Q&~R*^}nL~EA8Jv4|+D(xFXporPM_{*E;kox(6En?*E5c zP4Yj5Ckw-W3QrbB#{W4e;6_*bpYTNWd#lH=(I+9vdi0wl8nBCQ8AaQ$YXpp9%LX6K z8?mybrk-|vy!%RIE+!PuiLPlpvIz!gG*L94aQ>bZYBWYTtVKJ6nw}kRv`~N>?*@#JiDC7j@#Q=-XRy{+Ger zsjY8AXBGa_(NiGZL((0qXPB-VyTxt$)tob8!VhGb;`TVq}LZX5(CnHpgrfmz|B(D0f zMFWiS@us}z=ntW+jXeRqdA(AL$D9SP`zkB}rc~`&Sy@>VXm(%ixGqZZN}1y|g6DM2nTqSkH7l%$gk@<>Zc1f`drUrv1iwdS+0 z7MnVZ`tZg_XJlv!b~(Nk-d3Dfou<`!VzRR!b4Fo_kK>dd;gm3THE9ZY9?cV-ah)H|2a}3w)q`Yk znvrL%2?=1sUA`5FFNHUIe3e0e=${2JA}|;c95aHNWdSKOFJQ)Q&6f&RH35@m0J%5G ztenYQXf+GgYn6n^tqt#>*Fl4C5)C4!YfEv1|FpMC4Z!* z1F?`An_1G9RFa7ww9a#q&2r=hWhqb4_oZG%CKK{030nSTg@t}atPo0(aS~}ur_c;~ z=VD{<6Hi3DXC!#mKwUUa#2QwvzWJwzjDpak6)w6`Fa>lkqorCSQp$+P9Y<-O^+~X1 z!++TvLX1l(*jFaKG(+}Dzcg5iU;5Fou2HtLC3p60xCrT1AhVESFfZ->l+6qb0mm}} z4LcWol}PV@AUcvinJbd;=<1hSOzg#|Fpaa}ecX`?TkXO6ggMNUoDUx0JuGyXBaO5L zw1e#?dI&n(dE~@I%$bxth&t}C4zXdfDkR^E$l@HJSK45)EgJqYDbQ4Fer<$wAYcUC{Bu5ILKvV7!b)3~As?q4L#pO9~S^qXly0op;&&w_py5s@bsa4WJCr#6g zJGQIoD)-wSE03++Im*mhbo+I4)!~ho&%-f9udDzJ1&o6zBLsom);Pu25x8dR7wy$G zR7B??*Mvbsq($6w3}@_6E@ZKRrzvBgow$@S0irUoBzW|5mmt{`Pk1tyN;qDdBqsGP z_zo_f5I~@N$%iAy>Zy-FMyYg9vL$;H9>D!?wn8%?>#a^Gg2TFFEJN{DE)wM%yL}>C z_wI|Gg$Y9@iFvLU(``30Asv7=V^ld`+JkWtAsq~eIl1ya->>c2VXzlV3dGGsE`fZw zozvUot_T+ELJ_6=dk@*zNYEQ@$0?KJx$;t@rXX8IL^}@0JgAAW_Lon=_G;UzV#LHW z>Bau;P?);L>^M29Tq_hyQ~H$Zg9w>tz*Y=Q!|V)EZX0D-r|*TSG(Zft%}9k15wVi+ zx33kKT*Jq6v+cS*GC373qfPKpUa|3LmK0yWXqndj#f8Pa;Hu1tam86-*{h0dQ8FeC zcI@GMV>4SPLQ#$@a^eh@F0U=7F^fCya4jj$FKNK9>KLbPI$I~-W=j1IW}NIR+n23b z&Bn_83LwRRFo?LaMVN=A1wf^@zlz*v-sB%5uX^KH*U%4<$9E6n^)^m6Delihc(`PaWK1 z`?J{&g%vjqlCWJUreH#fR&pKeBk=y(<6$p~ZHx)%!=M+t83HB==yh8i26A0sQAAXkaRDxX2uh=7TkNas#*s21K90y3+7B@2-n?;V59ja(y??n?a>@!mVj zrxs#rHs@#7?a)U`SzivVfMon;sC-_a!n-Tn`0s`0CiflwRXBD4PcZJ|^ zOx78k?ry6k_v`BFsF1Ls)|#q{1H&-a>h4@Y*O+=M+V17m?smo=xQ~`~RNZnvur{4s zd@SGFA^$qLw!UD`+_Crhq3!WJ8g_2zsqc02>gVRE(|;fT9q@wxFjMw*^=;nSnMH!7 zOk1ZOH-5ufDmsWy%4Vvo*DOzrU@dbSg5ZA&B{6wDJFNP%!rq>9Yv*oRTjebZd4b4) za;Nc9aYx@adJ47Y9`m>UNFMN(O}%*=?Pa+Bbwh&$?}J8F*k#Le>aMiAnsN-4EWWQ( zD6aG0?e7edSMTik&8E&8GKKEH9)}m9t*nChtRIPya_=?Jz^>OedObbD@xOG@oUxbM z!e)ebm5g|5lGiX&()h+xnL`UY*`)|nZSm2G<||;@ZFGeuDJh(tkZI}5u5EQ=)ZGFs z66%HYWm8e~$ds^2-Rd^LG+v6o226l}w)^Cbqgp%jbb_hT^_Js8a0lbA;_8<>01deB)@Kv> zqQmyew2@tqW#7&Y=}dh}o$RLC?ru3{8o4!4<(Az7+if?o(do{4p zz=&J1`ISZ6D7BVeL5JZE%YWO&Ga(V%Z%buMt}mo7@>|MAsZPcfrGe{>BapXAE43bL zIayStOg$h9{Z=)@nCB%vWznDQVsUNhs-byT=~=4{ZxLp+0P}*uj1p`%;Ve3&On|IW z1VhuPyCF)F?vqlYdRs3I0fO5e%>Z3m)L0@e(^n_e!d+MzVK4@mawr``B4}3Niwsfz zjQEi-@4~p2!Y2aLjWD3me#I0D?MUu$S@G+CB&4;EUE`ukP&ICCI4%iI^`5B9I9PUu z3lG#ne^vcywN$&mng##~mvhS+9(npcViCT$dxg@8;1YAFbqwRXLqFF}2fDM(EvQsFrN^r*QR;daL;$(U=yv$(ZBBR?q$cr=2zHR+wo^dfEg zBgx@yjfv8DNIJ}Lj%yOB_F~q=wFgD5@w)=o+QZ5qCQzyLA#|lr9Uh*xgfpvw zosf1{PjC=HmwmkR=&ns>$D5j)EJO0!^WuARsyK;1m0_U-5FO0 z0eQ2D_l)EQ{U2c1Wn4?u8 z#wi260*}L+r6!_P)ScB7k_XtyeJ$H@vdLQy-z#-DM!K_MVUc<6&0g-x+Ry1uS^cfe z1rgkIAKDOy%BhdtF_b4i(S1;ezwkx`^D&BC){>j6CzF8~ip{|&jcB!T z^5gt){B&ymiB$5-tbLmvwPHJqlCwv@`q~+F^K7U8+1=^y)4hG$Fnu`lWB&U1tDT`E zlKlUq`pJ`JzrJa-?x}y?hi6}|BkRt#{rZW}ug>--WBnd#{ag3R=cYXU@V|J4u}r7W z{EUQOS~IO9ocmyAt)|ib({6VL;B}7S9B$DNx8zO}hSa?u_Ki=XubJfpUE4Oz$sl$K zi66hlJVw?R5W3sjw(PyM_ULb?W;#Bt&-L%v-v=}AOxy3RY9rt}9_ zA(?sPAN$~);DL}l5O43a zeezTHx86*fXC0kK&M6w+cu5=v#lgZ>F2h0+@bV7pxijt{YZoOG1s16kLAUIzgaC4(xo z9RU?at$~qItus-BLyx{0^=q_~rzUUJ%Fmez=i&_|l zW1CL$if1R11lK8#+e4mJCUh_;c2GbBF_f7Ha9TEO3{p1Pu0JCrr!L%1Xa02omQP@s zhnR9gjuQ49xV3Cq-C_Vhu;e}}FC`=1jkd5X8I%B{04h*a4Y<>?SxBI)hQJ+f0BS&N zl~6DTGWjq8xu+LUVg{2cr>M1g{siWU+LjDQrc+Hc4Wl7DJV+mcrs+PM$We%jQX5^0*-uT1ESdd9{ITJe_ z?q`sd0&Y1Ar)7`@MWvLMpbo=C6-f!4nu{Z36TCwVd~=mYa1B(%WkKXv92P-)XDixY zC=IY4edcZ}5$~?R{tFJ+Q^&cNQA?*1j@ms~XM&B&I0;#TWPnuG_5r{bltL_QgsRNI zL@a!ACFC0cTO)!x1Gv{(sg+MALOD23Oq(ofB`;+e>5y4quN*VF7-FPo3MiJm&&pl8 zH}(sLeC3U`KVpB?$fw6cqF^gZb?}pcU&3>!pg4)?PzN0tB4$p57B8k%+y2z;rn=6a z%&Chuf6tDo2l^r+{cO`Nl$e+lF z#c(z{jYUso!Xk~a6&HKqJ;Vu%o>)RdnMB15r=fyI$U+?FM=f2fGfS3F-`MR{F_JIq zK)-Kj8s?!BpTh7_0e?SbhGte@`h|>hf_QYbO11d7Mlqul*KJJ`l0aXfX@u?o;#*VX_y~O6VXM!>hM9;gy$yV z=IV@s*@&fY#4q9q2)UYxqu`K*z(y=(bmU~=!pf5=1a|UxcLX<}oAHv-afdu;NB&R@#Q4TN!gHtRNdVPvOUe3e6 zY>N>^3?&7g#CQYQpnPh|9aMewKm2wnrX;H!2&az@zt8l$Dcno8i=NiE+d3wR%V%wZ zvgxE??*X0j@5U_|<_rE7+?~NGY&S-RsME@t%dVcpD-eA}UFHPz0}X*+1U$e3AH^!= zk0eo`!FuW#+aZ+GCJGJ3AjoFS4Tzw+ehtGzOjQyLn^w`}`f5qCY(t1Shn;Ei@%KPG zw5a>b^+t#1Om6+zYCp;rnbYm&Cz~q5`x8N67O@T+)7>GKmA09!Ji9{{kH7 zVdWid;5akJ^}`eH0i@3*5|wi0$#6@8jQE_dWVXn!_b^nr8-}cbzBUxlUuy5S7lZI~r#NJmRLX6-JH2o%Umca0( z8N#P{cEUu0ZEK=nt%{k{Yd#dzN$Tox7N5Ur8r>f z@bw4p8sL3`t`GlU2_$N(5>Y2B0NwnDNAQs${#C#f;d=@J^WdU#3lV>4aWVC&i~SU0F&ZM>R2y|4KG($6SNU^wq{;beEuMp zRtvL%a=u}|uyq!8J?kutg{-o?2htYrT4hb)E|Ff+iEM=HwZnE5>`HQ$29yNpeP`HB zBva0Hlr*UxTY~!)03>-Rrop0=pMs$njD8G6G;jM##vtEC$I(G7OmvsXMoA@kc!=Z7 za$RC@wAnny@k+xU;1tDxb5mU(?tmcAAeRKTXFHpd%3pZ)b5ODU#u|c4T*^#-hFGs_ z30Vy2;1vYc#i_fCgsc?hz$^zd{tlhb2clLpx?0u*Ri4}CL}8H}MuV+yj;DW<-Ps;3 z!RJb!>$*{=B@)Y~1qO-!V{30xB9WwsW z3yykZF-c^|Vv`UxaU=GhgpC&&S#(pd^d5lf3Dmpl=g0J~leV5po9vrg^)D*^CrG@L zV0lHuRdxiKyN8nFNxB}AaARvfzb5Hb@@@~urmO6e7g<+*45XH;f(c6i=ylJAX?RLG zH_vzPJbMk*kE*O)+cfK6!$I}c!|JR$_74PJ-(1tH!{X7a)ZeE4iYz_*!+!g!?+OF{ zOMq}dG7eR72M@ZAtUeu&e|=(aB2^c54|N4-Gsf{G$53Oiv)!wwABkI!CBL#^>&t?6 zdWjSy4o00?sQG=`X4TV&H@{6cW$&Lx&AayL^@-ANeM*7Aui1w$Y}zHM6Cv6%CT|au zsty-YYiDOsorcK`t|v3k*bLwOGY;K(r#R4$g8tNcb%})Ut8>V1q2VuR+B|~qndVUl zBGl;2CpWW?hh+=B-8SCM9b2hyzq!?aTk@`@8CJ3V~_0i>|x4zKzo_@fFC ztBfvz9@$-va9R&>XjeligZ5003ySN3Y{;`|63bLhpu-ya^KZ>4f-8@CR>_eO4|+XE zUOaI-uc?6izevvr)#vlbJg7K-S*^W~D4s@uRrWs{E89H%MJZ$e<-nGgKiT5_$uXG9 zKWxc7>Xg%Pi|mzr5??&u%qxRI6Z8ZU<`>shR>(0a2vG8ep>18BabiaDOI?T-j#Wh1 z#;sWwxg(B_MVI0p{Z1IjgI7fZ?j+rl1zPa+$Ewx%81yTXyAhd;p~vkY zaGKws<5c0nHvC|igcmj33LAy)BL*_qr@=jdX$@376_1R3Gykv$UvC+J(~dL}fm{wl z0DI7a@rPef_mtPe4o&Z?xV#Bql}0P5zZSOG{doaQNQDR9NdJSN6nH)DB7(i6vVguY zr3kFWEhjMTWw;jJ@=B5+DtWAE#x8}Xkrn)p>iO68hS9=iw^uAF5VanIs{JtylX=}U zC3{Q`v6akvSvtEBB)xZB$la2MwclkAa*=ryjpCpQ@g@_ZQUoW>Am zMl}eU%E^h*Ht1iJ@8|0G>R)CK!t`Hk0gnFyAFwho|L?YdrZY}EqTgA)#+9Y!8c_#) zrwXNZWU`Zzqt2l)($+ugB#Dj0Jyn;f>Ug~zJ7WXTjDh)2aQcyxW{-f*&iBiDESLm2 zKAFp7IIHCwL%jdJ^y8`D#m%0cS zw6M3GpBFE`zD)IgzWUFP+mz~yOS|40@XzTF+11k>|Do~jS)-4_OTDojXTca|*EfDf z!e2};EhGHGuP73Xngs^L-byA<{!Mc5^Ss zH?tw~Lt&!$;{MB1C&QEpV#Uf7Z9QJBA zpA$W;#vzKT^WI~e`F@$1Siv9E*)y~^3rMmbBFNMx7Ef4Q%xGy<7IypwK~q&hu!z9H zLwV5a&xINoweF|{vf}Ms@3MBNDi3PznaUWlEUCDEUK z+^7TK$uwQ&R8_4wz)VhJf6O=mU}Qqrc-l=a5UVX!nr`c<0Adg1rG%6@B{knzGa-*6 zN`M5CfJ#&o-1~ZbGB*UxBMJfHa8ine7Ugvl4p4Gn1B%(AI10f8!5BoY{1P_YN?{XO z>7E0NH!*RXl@1zm*^;E71#sWBpexEle>oc1`fq#y1g`2(Boy%D^0RDc&y89qUjY7` z5K$kNZAAj#wD%Hhb8`Y}(6sCN=Qd+mzSnVduWqnwGNTv)n17W+IZTInfq@h(#TZiJ zYt#^LUK%m{e8TQGKy)E$j9j5w(NiY|3yE_^>I0C9uwsOfF|WYb(^M94MDqoQb6jo8*3@K7pLN0}+*SbG#y3cScj;#Cx> zBt$0()+5y(>b73kukU@;99PZ_Lo|SQz)RKtAhL&p@wuc?-K*gnU^^(YHZp0tlk^`{ zp#8&q=e`m^kM)X(y6fPaP`vA=T5$h%RI#<2Kv-_MY10$|{(wCd4R?tIP|GITRdOI* z2G%wi^ECWA~=O zAprX~E}P;C0vB#&+#x_~s4x)7mcf*RAj~J56lRmu`_WV(B(DHSRW*YwWZEbKaU7!6 zMyh7v%IxGs*g=*;RB+Dw45m;4HcoHLc(^_1V4lGJt9bVe8-0TU8w*NifGU-$yeVD)rQ*@AG-*Z zy6T8Wr`YKsN&rfgNRzC${8Ef@I%D~i6bhNaLDPa~>f#E6)e;h9K-yfH<>t}D6<}&k6 zW5R*2+I-z-i)I+kTB}C)!c;gF0gz?}h@Tuh=j`^4Mso$ecc;SmolE`hYT8jwR z$-?ny7#x5t>xhvPjK;dwnj2OcfdEQHpxP?P7fQh$R0_b`<+@CkE%X*!NsAi50p!km zmuc8a>>2a57E2mh+?YsW7&Ihz*=+O=DM08e^)+02j$;~y2uybXFvsz{s|Z6B1E^D2 zr8EjXQ#ipuTlITIXg!Skmp`OqfCvGCIAgWGOa}ll!4A+B)+Qf!8fPgj^ z$?ZIurVT7f+H51m|?_`hvY~o4Ag-FRy=@r(U2Jdk&qzDs5kt> zzs(Dk?M)Qn67|=n?;a;-jD#p#**~ikz@)bnmFEY-GXn zmc*63ROHG9;7t&-jv6~Lt6l;VHo>2fuIytyIh4kwG;q1GYK=*I;z*sO)8JQtW}xQ> z2>}w)?p)!18axlsKpCdcwaAi<5|QF05571 z!lyJ{-cX$hBNAETWnk7xK|A03%Ibxi*9t)>;2l*bgUJBbG*k*rho)Be10|CMRcKk) zbs+=in&+|DTAvsi5oJ3d^>JU!?q<8Z2Ht{Fe&MvcHr5)aM=OUG`KoEh_015hs|@g|!d<1&e1 z3gKNRd_)Mpx>D7EXlEXaP;l-ifP$X^vP~A!SNXe6v~CM+G(|U4cj9ynJi@>c5jIt- zDFXy$qI3nd)k*RBbZgjGQ46kDud2RZ_k7OXjO&CZS4maH0aDkXsI35R5>q#bKS+zF z)>&El4=BKT{Nu@OoG!Q=N)bR*ex^|=#Mi&feB`{g4iWO3l@;%nUpV7?V=Bt}{V7{I zA@9qg!@^p`%ssDHC+~T28*St*%_dn{zw(>dTQjb3SYa`Dwr*7n+AFqv6}ewpri%jh zgOF!8-N>T7@XI`UWVx!2w?H*&N{@~byaU9t!IOJ06MgGDoN|PWd}x!e=-B+_ZKL1w z`RCT3a3~B;M6AJ+MP1t*GC>87#U`i5>?;G1FROuBLc}G{c)E=b!kBPf5+Q{>In$6l zvf~l8i|)1pbl3OpTrl9Q;u?QKh;r!ZwVxZkS!3Iu+flPAx=^Q2Z*@C<`zkvwy1L4K z{95s_#*Dhwudg7JKmKjd^j!V&nObq_+oM&VgyqbE6ffI9Xji+M;Ykf)XcKo$;pREn zW>;;#YdL9=2B&|@N>45!D}yWY9};Pm(1u?MiX?+Zkh$NL!&>xA2u}}rog3Qh7)o-x zw%|)lKf{@^Ric_M!f9r?fgT!p*Vc~LPdPPpExUlByCp2V*9lQS*IZyWB2}3_`eNL` z54a`r@+Xx(ex>#N0rh`xj7i0x))+tj;hHYV&e=Sl6pTx#FVGp*bsNg zKx2)0d^t^#wI5!`mZZS-4>;|fOq2KSf!k5>>mz{d20R$%Hc*_Zm)izoqu{2f0oa75WTv?<CkuH^!)l}KO7U>)BbIa z0l723 zJP#2F7Q_U7L%;RTc;c5Zj|jeFtc#`arWCS3?Er_B%{d`?L^kd5R&~{Dv~Hn@1@23^ zh#mXN>_MsU{sz+#karF&wEom-&LI2_u7!i5k{LJ+HnaYVDwIYQK%)w#d8#LGwsmp? zCkC=JeDySZ*A*L_MuY;y?xPaChO(2k-c~BA-!-Yc8%`{J62s1v__E#(#D98dC#?FF z3LzT4ATb_K(l=2CV)CUasXunk9|4vlWa`7JL)S?TVZC%f-!wnL3SZBvx|C`3g4@WP z-Ye;IOVKo;)W@#S)+sE?cy;YhvnV<@1pBg@-0~h~l5Y+ZYxaJa&=$@m7Gc6#_F}eb zTL3a<@4B6_xD?n_L(a) zBroEqtSXz6&0oVkEh;H=>*^ujOk4B#f5jLER)4&FYEr<6eS&b+;Z)>toy#Hj4b3f* z7{)H4?N}~x>+oAc55nm3P4k5UekGxPI(Lv&po9$EQaCMnM3lXzD!&qn+8H78Uam67 zu{*dR;&2-%D#7t{N;1+1kv{0)=v>gnA)TqqXUBtm9#RDIxfdt)o$>(uiaCAA z+jjme!D@Z$hMTezx2@vLuhsB;aPd6s{;A7{HsqI^1ty4~28?3_P%5Tvpy?u$JYJRzGCJ5rT?9H>0l_zpXw%&%|P=n(9jBi1mOFr3-dGn+vX`^SA4LA z-IbqUQuzv7c!|&}c_A(y*b)9ZkZNo`{hE;rT4OnfvWpZ$K?GVKshO){3B-k z7g$w!V`chh*rE~kd;Ji5hWX-vdi+h!c=@%wzf^ejU}8}E7a9gO#V6ilf&ylZIqDkU z)^;_1z(7T!xjhY;U)@1)`B7=e31Ntfvbz5D5v2a#yO4-v|${~O}-MgBwwLzfPCb~$sR8e_xL@yW;+nw2f?huvAl z2W@WzG1sBGCU>un06+Yb&0?U--WU??O9{^>+Z%u7vr>mCJ zk9t+vH1DC1FF5_>eSam7W#3(f_-ilk;5k$&vBygHgA9%!udpI&s2)n~oA=i228c`_ z;mvwOXFU|%GLNeyYCK~_J%i(w@o$r~tp3Qg@g1XnxXFt$lyxx(CVA_U`;^Zh)|lwj zpNnTtBAFK?kg_HlAk<#Sf+PnNXb8nMOIuQAz?}ex%Nj7d5`0rD^4EDQ2*7A)v;9xR zLSRfSbV=z75oD;69-Mno&IfTCH=g|Bws%T|R3Lnok?&1U;Nz4Y&sdWNLvKc-pAL=U zI)+0`nnbUZy>LWoxmo-s;lJ`{g8XNxpg?cx3w3Q(d}_|tmXYZse_K&0p!BpHl(E%r z`QV#_!qjN>%zMM;pU(W7y{`RtYJ6WL>z`POFoIar6g(AZ0CxMC#|#-M^TKYVlNTofA3{WS6 z;spZ)k0G%tuWcB;SXHl$4}*#3hwpS+=*i;p8LSyauxe>ggU4XLE;rZ*fUfn|gs6VW zKq5H>_(GIO^CHc+V2_Gj=@vR5Tm@*IdZWpeTKNy6Yy*x+wDO_c_^ z3GPPHcp#;C^{C$$Mkcq;fIeH~>o>pucFe-Bz+nwihrzT%4uNrp0Z!~*R33gCFz&Fa zAj}%%N(9#kgwJ3v#h2qov}{JOSD@}(q%HZ5vWyObg=WoHNiD`|#3~FHw_ggL#qj;8 zwC-Q2pHw7_BZ!r}hvCLt0=Y9giLpJiuY36Ange<%NgO`U#*Emk>ai9L5SPnoCC|m0 zvuCR3&79L$4)}K_WE#*86?@L4H{Q^BqL2pn0p6!HE&ul{WczQ?5Cc8~I|nl)owSLq znX@?~K06aD+kbBVxVirv@j3npiTS8{2q5Fm%IE zbjLGWc#0CK1lwXQ5Rmi4RNDmjim2SjU$HsA)lRn=&0X(LpPj8wpVu+|s)88;3(zKj zseycZSbVZJ2!2hK6@YP=y_1vUqmz>XQ~kdI{W$%<2}Vq30Xo_Q^yTArmJBy8XS@n`_Z@PLq!_D;a=?HwV%MG#I1faCsK1gZckvi^wBkgg-9@u3_Z z9sJhT`)&?DkC6JU#()4JA)xDi8NkFi1GMl`@W}a)ft!Iiw}hI3*Z>>!QV{4j&tXs} zWUcn?Nf2mhVPW88v+Qz|ANs02i|QXL^&AeiZe&`4nE-!vLi|=wEzf}*0=pbL1+jfs#-A5wwpphHYl;nGWA(|mP(ICk8R60D zkGFfh9KLvVQW^*7u@iJi0VfRi^PY{sd z0sM0S_2s0rYV!b{yR-ZI@bAjrYQgk^k*5FX`>27fp&7#Teh!JY2W|}jv`1mBq1|)6 zIfcN009E6s+WUj9fdP&DjD6;yTYs;9+hrbiDurwfp`2e42W$8mQ8j2d(m5 z^u?x23C+lBsODVXCjLT|6zk^#fPll{`3H%q`(ptd9i9S1Kt2F?|2h`~27cv?+l@xb zTcPv6)p_5tUhr{r{ceLy`^iB-?aAp`)_1Ld0;m6;J0scp+D>(W-~D#&`el6WZhV!c z{hF2iauIQ`frsg3zte^M?&FJv2d(a6y475Q^~7=Ny4k!#1>ByT&c!#%OQkQ*2^{XD0r+cc^Xsm;jd`~nfaCkSAz6UFd@YXy(8`iS z`Xku9(0y)+PwsUg$cmGU?0`wm{yMYV- zmf7d>4e$kjvfX*X@)z(8*a_d+J@h?4{6u}3K5@Mh#oqOe+nwD64IcwFesGBPg#iM+ z|4{u7@t@I}sj-QT>Fu`ezMjN^H90$VK!N|d{MmBZ^;_wyb)jEFvX0>40&PNuX{ds= zc-N(P9}hC}c{^tx>h#5g0ykVKS-uA66=jqX5&fGum0|4Yhc@tqrg5Sa!I5b-Y->a# z>b?jyb0U>jWj5C$x|-EsCMv$`N4b_#eO@wHc=R`6?XJW1Wge17bn+$U0* z*&$pb-}VAIkJ-@6cGNMAFgnfSu#U7RUGl|UyQ@5RDLrACAcxPLLoxzEOG=?IYYaK1 z_Hl;-BEnE))9uq{>4}0RJ(e(d=WzZ^a2OMf#g!g6=p^`e`DM`Tj4X zxT|fkvXX^L)k*YZa)W5nP)-QXS4HkIUw)`g>OTFX?p;M%S}piG2Rnl^ssZ$!9ce`b zQMMLsr3w~m5_$sJfxDPb6ST*m<#4Y+N%6=x#|v%q7g6ekSKUqU-aA^42}*VIy_1{! zN^rW98S6DStkH@y#qBC!L)HvNpNYYp3!loCUWpiKxp{9er8H^5h(HtL=*@QP zL2ZxdqlaVvZx_BxJV|eYEXw)QMdzxQn4|?A~;STfE4`Xb+GY?)g4d zwsf+7N{!h4_*#%G!&!ih8Ag}4`R4_%l5l^*J-6Whr5;KYd{ zbk=$vuxKUoNl$K`Ary|NNKp|EIE!JfD7LwmaT%oo&nqOp*$DC=t?OtqapX!e%O^n< zq-*M6$grhvv#-4}QN_!;^gcTQRmd79c1@tmXqNgTD0NQYUOo|@P#^TJs~VP#)&XXI zBQlCmJHjwt7sm24pIZ2j)`d$4%N-*$=B*8}rfhAMTvs8%?sE|IvOGA|;lQ2|T-)Xy zG+s5V8T-?8F4s9d(~gDti8O-}OI79jnOe8fYHgYi>wOLyS6|WN(A&*S`Pp_F#_rFh z0p~=|+hcO+;(`KJ?=t=u5oe5}$1I;icZsHCxm7cF1fS6g?blV4mQZ0n@8ykH6q&&? zFS`D%&sNd*gm&iZ`1JA^8mUd3{Hv^d zANY_o7KGJ3TSo8gQ*>RfGTX~TBYm{OSUhjY9QmSk?((z2)`Z-*^M30%l?t&3$iLTM zH51-tD2lCNlij0C<)NYhS2jB7ZrTV$>x_3>>R%ndBmFgYmA~!z8)m7xux}Jn0U8n2 zgiY(-g_ZZ;B>n1_T{<|Igomx$FJeJEP@Cb|9@uC==M=dQu0wXIRSP|!KIS1kB}*o+ zwAHJ16SQ041ty%}telFhO{Oa{1Q)}gA0_MsAU55TP^?)j@NGpk8EE~MI5J!MK@GZkP%f%rZRO6$}SXy=>XN#Ou z6?;it|G+O{jzwdu(xOCb2*_l`%JpOC5L_-1z<welMTABSzNbr?l^*teLPBYc0wpyq`E39r8cK^#;)50ZNC4S z?qb%f_ZrNbsZ5nVOU=Xqd*YRm#EVdAq`PP-gNYd0o)n4qlqe2i#kiZK>DkSGmY_6&pIj%2 z1PRWOBn>F1jt=?I5tAt3lXRghUXS9*YtMx1r_B6EAKA9UGG1fu^Ob4~_Nq~oU^851 zlMkDrrPvRfkk5C$ zzg@MtuwZg5X(7;J+P0v-OyI?8BnNk7LqNBSRf9~qnHSu7O87&L71OMQY!i1r;#lkw zF)aBZ^_sD~P>xk}3CV@cQenBcCwM?4Tjv(9);J$KEx#VI%;7Mw@ejcRLMS$GFaPhqTYn`K(2QJePEjRV8Sh+c2 zMOpg_dvAVum)d>N6QZl6`+HvuEFxGs>wMf6p{!R9`-0&Iq zx?HW5BI1Bgo*pPDw8$t`ZAk1vk4`RWM1%&LNLeOP-IcLe!lx^(VnsYx68o`!I9Xa@ z{gU-z0a+$sOsaC%`gTmRyl zuyB>nE=o=NB1_f3Prf7kAzhG_u(MW?;1k!R!B&8Okae}iHy?LhpR&vJKXyb@t9-wD zo3-d%#IrE1mM-e)O^~7vNgbZDbxE&axqP|y)rT}OrX^tGe40f`v2?i*lt{DbB{WMW zzDZ&~0_eEZaCH<@e!jwkM4)U1UVyD=APc4e2_SpW9T0I;kQBDfaxN(=etNvvT}$iN z<*_QeanYWFk*7CY6r%^PT*09Bc!MFb@p#EIb zl~icVEW@~lr$K@pt4Y2W>s}XQ%RYg7G>dn3_`nODJx!)VvTonJ;Azxc5$I|s8^kJj z&xa*pgI94PgdFpq0A)lt&aF$YP26QiONU@?bUk8DaZ}^uPVjDJbzHc!VdMM7{mhR% z4ZEwDseK3KG^)wTz<}b_n-0r#fLQGSm_M_ejtOad%0l5w6skxk>BUQtc!{Lot5qO__SxW-!uZiiP`r9N+>2yw?r$%9O_L@9(_3SGjych zXF~Cujau=;_=E(o8+~oC4DgC^lhC;ePdCQDiUM2eW&OCldS#)!khJ^^83ZrVZGGSL z>>Vtp65pFt(2Yf5~kYg+9I`rpo53oqw7em^PWeFBMEEcRH=cRk#EN{QctfK&zxip?0y#UJmaVG% zBEOq2dAPw3JY3yAD5HMRyZ*->A**@O1G^|&zE1r~S}K{P;f59utyex0HN-u+5)0Cz3wQd!W)gL{J%^O9tLO3?&HTRTwX|+ z>w1QWlXWyBh7eS~F7buvJK=>D8`43igT%;>9pZ+2kI1n$Kh+3Gxt%vsd+vUT6Ls9U zG1EY$1;z3zb4DR}rE=&T@q+#Cto_1;XDs&THn`O~&$17vHu+(Ma!oG2kp9GMiEp> zXqGRn?%;gue9r+_YHO1QMKhnEIdww>i~^gH;Ia{fCf{#8wYxp%?WK2L3?2;^%SiE$ z7^G9uDlv`4*RxgA^12SPY0AH~B){*D2G^_oEz)K=!{mg`{&i^aLwU@SSfG-yXxT!j z+1dDI0}Egb-ZEEOl*pO|7Gj-Cgir}y)9gCt6u2t`{^N*kMOaSrd=rX$k2pd;7Q*7f z0X}lUEt|Z7IomYhgw$DDL^CCY5u2`XA0-VPT-wy)`UC|;bUg-hJv3&8r5y@IzW<-s z5V9Vs*ErD|y$G zEWU|Tu+m=h0|grRRlAIYL|WH8led{7a}`0fz{GzKU^T)iYY;oUyZ5G0uLe7HO7o8L zQhY;E>(y(m=5q}UDYcGnBKH?*Y7OD4Xv3B0=+fH*o+d^_MLkI27@$Nvfz@cms{_0I zAUyQ-9ZY$-8zJ(i%8lhmnS<`aT%p_~KeMwGDQs%Di4Lb+0ym#UUHH;uB|qVFkD4L>lcs(Xv?qBVp~kA~1cS!LOZ`5p0oxR1W1cL3YzY-fbMFqevz4ACgl^OEV6)2% z%)`=&1%AC&(4v-mT1>$xDfKLtoq^Q_9j9KkgzB!y!PYgU^)R;S8HCF!IX4052*}tr zpA2q~*N~&m--QbAJs!ZMc!k!r9QtaXIG$s%$5+~o9j0Zu5=LGj)^k->DwYRnRP31PUmppN>w?MQ?uSD^ z*7rKFp)qLVYT?BXYlpR+<|Ng8;j|c1x>hCCr>};yW=dWW%O1--CH^o&=-tGad&G<3 zz8++nc+H@u7)zQgc>mq`+YMP@qTfU<{v<_mgOrA0!=(I`R&LjDTE>5M!t&>p&B;sw}wmL+hwXPMglNbHTkFe~#UML9c}C zwe#4xX#3MU>~bgQD{l;&8RF@Z2YrWQh;X|Szn|BkOrSB|_61H8l6rPtTKtl{CM$|8HCW>j?wuveY(9Q` z{PGHZM7L49>j|;Q7ivAY9^4>pviP+>G0uOAV|N@&FLYJZOsro;;1o89T^ua64IBI* zCl&bx?oN#vM7Q+~Dr0fW_W;<6kipo;-7TTZl$U8?Yqg4OwxXuv^|?HkG#jGAoTx%^ z_F)+*s~)FhVwsW0G41xg$f&gS)QL*!jzkS+$0_|i>+%!mJ*xYD9Q$&l#(meyyj{x- zY!D6fT~pas8BQsU!oS+EI)L%PZ=AyM`I(sHz{#F|hlc2Fs*|e4D#Uu=(?$31 znDI&)8z$HJjYM_GOKJL-nK)w_5LUxMNiJ6RRQMb;3=vA>ZsY~NXB!Sjo9pdZ6eZ>^ zvBeR%Qk4g0ALkGUwg(i?J=s!vF0kVKrBQS{TB#HyO)J!qrbnN9T1De83ay|1K%GO% z`M_+(I;Nc6Vze$IrV|q(8RMpdzvHkQ&4DO!i5o3op|YOb3B{8yXvy_3gPUdR{5?R( z_#D&@F%9=f)7s09Lk>EHIgL0&GI>PJtH^$=AcUR-4g@!@c#ivHFe{~P-_Mle?jrI0 zvA&}X-_*2$%R~!kP)Vbd$8&6*kVUU&xm{*1BH?;hRE%&`3Us{Sdv4;wC-S=Prw%pg zBaT%8pO+>>>kmSd;Q0aXj21S7=&$VpV;_e+!_u!q+38luq)^S2Z`)=+{&kFcyUiil z*73Vy;V68%A_waG3KdT%gO)J~rRL9C3$_kJ#IP$Hlu<3n$?8guaVq@ zY$!Rpyp>6)NE5G8;n78*NxUf{51>$8qC4*pLlOHt9(HU9nUGW&N5~B>hqdW%imuUo z_r-S*-nByU6W#uO8gyI|>85~Clz0@8>{l!wzRs>6eqSyuU|zLO_mHe`SEeL+hHGk~ zpc905dom?>uI@y73jV_S@LU!T^&-)i0=$!#=STSn&6**PD zD%gJ?`c=MYz4_Y0T1286Ptms(Xxm&tEItmXC+G@wl751y$WojFeSON#NxqGgB?P;O zF--g+MjVR?BZQ_kYMaJem0l<)D5o&TM~3#BuXb!-w%KHo9BTDq~{_ za>jS*KWmYuP}h*cN8txO>R9f*zYvJp;YslXDo1by!9ry9?%%GcojX zyxatpBQ`@kf+G34j-xA$(=xa3BJ8hn?jIrzbDEdhOOawqa(XN%Qw)uM>zC&b13iLt z!#%VXN6Ox7)6k$+5qg>4!iDR2!l7vhA17|y;!wS zIJV$d1}wC-9-Ax3sRmN+mH|kD#Fgapn$2aEq#Z~Y2=s3{uvWc641y92mLSTXyWEOt zabG}INL%+xRn-0xPcv(#zexRwZRiztKXXQPcpP!zswh8sbHdu9G;1t|?O+E$uo6%n z5yYb^=LwcjS(tZW*PMSYD3fu6r{8~bI%EeHVfVm{l={1+vJ!C%6%3&n^TXj~41&;W z&5o9Ko)9Hs5St$BDjaPch}2aQK|%Xg!h~W=x5=t@7F%r@Wc+E_1xXUMu5G#UCH|<^ zAoDt%-FUkxYMXo|dVaJqJ2&Rs+tX?Y<1wr$4Q#f4Y)2{iQ|}8oM{jABCbTKQWz&bY z+*Rr(WOyC!?b2d^u9{Fojc2g4#=EVE+6S!xgqTaco~ww;@ILk!@f3JWoyAdU840c@!gV z;~1{EE|4`zVch!u5U>JJYy|=bEZh7ev~!fv&?(f$ncHx_9ZB@T?EvZ8l$Br@qhPhv zKj8JkKTZH4^p$ALgEk08e;POlmG$w!#q3t;Bf`o`@=dFHVfU%L6K4UQ4g$v7$C@DH z>p{qaktq`q`~smm>AR4&_k7bSBJ#iinjySHZ>OJ)gzx6YQgTsl?5{#($WlGDWLy{& zTvVf7bj;aA0#ZUk{<`Ey&qj^b{hsGjP(t;AYlMvfmy(^w>oSl<0*|AX?FwlmE=guX z9L!CrxXawS`XHgQ{QIKG-U!HWV&VHN&@1pUnSB-tZP)31;a6QLOqY_StXpdhgFb?W zD+FHAmywI&&QJA2l4e;W>9Qm4+(mXX>zs__n40A-^O02QnyF>Uu`yBtND{2c%KVy^ z;pA!`EMA-Hp0Laclc^8Dye{~BIp7sqE2E~8?hF2@-coKHGS$^cpdFAue+ma;f?STb zhe7zqc8lG#VMqV1jff3*pqPs}(_>irJ3N4wUKGQ$efEk;ngW+~Sq6Z1@llo7edd^9 zp0718?Jn%nm1e6Bit+wEdm-mks-h}SZ-EHTqBqN`^GhJUvxm&TDd`4ayC5SV7{j(c zMPmG6T1Z&vM;>o3p1Hyb61g6n-s1OjLa;EB#G#4GxGmZ4-t@jLwl5Z28emdu_C>&P ze~cpIB%fKfsb0Uz5_7+rwv>a#w8*O$zx23^8qZc2mUen2#NTvTHd zKl3V)u-|DeaMBUquT_#^Eh(dW=BU-HS6EJULOXP+8&vt(dVd!3rCfp%GZi~B{S^QW zePOKTY(b8VaLN`t{YH^Cg)IEALd7g*jOK z&1&38{}%w=-PreJySQI8hn$pOTlS0rsoO($0t>Iwt2Z@%o3J}$^}bLtcqPDhWy=liCo(l`|^G<#(RKpKIp#ECT(%>p^4IM#VvZWz?|8xzsxe*&zLL)GK zPuse?n8478sEDB$GNEA!#6Kgi2*D+L&0Kdzw462-Zk4^ zxuAsl#k6NDH(50OMQ@!i?Jknu6f$ve>y=6}t+mc5()-?ye z)YUHODSbB~!FBRX${4;q zgUDz;O6C@EW2=zj{(6hcr7;DXR3&w8!{F2ZX8&=LG;}9 zM6l{iKDtJxH|keHtpNU1V{TjB!3|P;L*Xmd3M=#bXJWJ&(mI;zFX}fIsoF+$EBpzN z;HNVyjh?QzXkF^-Wgym}Nqy$aVZ_LK-P3m}EX4x&*n@}(IE-Z_en0}Ne_Kt&)Hi?v z((Ua9-q-g7aVcI}m_nkvs!@`}e;Fpm(%>(MIQLRzdt#YYnQh=9~|O&%r2+!esHhji!iZ9769AjYIrX z7>q4-hQe;;;M{g7IHlR^OeWWxXugM7$!@U8Pf z5ybZ;4!}c9F2h7WiQwY^*at&F=T}vd1m6!p0Q8HW$q}xN0Ef(gdj%lS>U&Y|tDWlm zR~GUDMC07ex#Pk!55gQ090l0Fa}?gqF|H}83J9hs)Yj4yj|M%N`Mn~Tql0)|^$zyg ztzbkvh<^NP^dpFqf1Se1%dr_45f5%7l{);wfnpJUlbrwz0Sx;q5+WWH0;F>RoB%r@ z|7h%tufn`QfqX+7kwHAU33UMOtr6%4K(Ir9ie20Sz61i&o6D)^|Nesg^bmpu0LX)Y z0N00c;KvvLDvyO4-0fOj9Ty?+0!ZPjdf@}yo!;`Gt`udjR_*2l?@8T6!{S{@Q*RMuGPJpHTQ&Uw(N> zp%8Y0WOcpm3F}akpZ6b@D&U6z^4T ztVhG1Su^3q<5J1IRx}0x*!EGw(+j)YUS)-)mW^Kom6AenDG)CO*p`jvPknX`lGFA0 zf9_1WpLAwk!dHu@9x8X$B7nfh|`fuahHsY$HaPRAmwlq({#bBJkync^^c->*?c;Qj1t)-il& ze+ay<+p#<_;0PWZcRBVtw()I5bCrd1C>!V#g%yfd*Q=dUw#)b!1qhF>7$UpLWVgOm z+HS;-|IA|AZDTv@^&-^LjN;x9dgmhZ*FcxdWqxrY_=rY6X+K?Ce6PNUW%LZcjy@=w zFZfB?D0XQsvHz%_Qr8XpK*D4lt}VWq5@iexV{ zuC6!lo(mJtur3AJWOsaT_}=EU%?USs?L->54Q~s$P$uF-;gprcYcu6ohA153+VS!y zX4ottXX&f(IV@Ndkkan8`6J7^p>2e#f+=#`AO|wS83eWjR>oIH zs*C#sUv3^+myP_J=yB=Mnp!A{SXI9zcHn2|5!cx2b=pf=keT@DD?Ox54&Rl zu*W6HAuB!2zZ&wqkYFArUD65%D1tJm0s)p@;6-)jGG8a?vZtj9k5|x5K4ZiixrbxZH>aRm z+ycjhm81=r#6kOtuSBP|07PKLB&y$iNeq zSvuEInI6bnwHj{St=vS&B1mcVsJ)^@#ZgR8yb@(splQT5$bcx1tG_WJ&{L&9)XwlQ zG^6fNdr=u@9J_UZX1r&NW;GY+y1Q5K$aHP5HIBgq^XQF3MhfIWt;H60A8+WmRW^3| ziU_GcsOusYJXIV}Fl$;q64uL3ba4{?1(fJe0Qz6rtsIw; zYa-yyz2kDO7n9=yi<8fD<~nC6%kWBeFnZYWpa@;0HEhROEI*Z2=f zz(!%-lZUSTZTH^|bE5}UG&UXt&}ZWXZmLGje1Cw`#>xintguYSB8}4ARSLaFrL5jL z>PZh8u6y>yAKu5REI=PysDpy3vbW+u$pTjFhP+$D(PO>4M4`Nnp>HxEyxFv#v$hNs zFn;aZ(|=I;e2`L+I4<^&&&=DLUJJ(Cp#Nmjl~4z?-&55glYYI~oAF9XUm;L*)6=oY zDQpxqLt(85Q{R$#OuaB;V%j<@1%!mJ%2jXpA5eXE;C(IWS!!_iT|sMV?lHW{=$1IB!kR&+Q1;`#$i7U%}+l>Az7eNOe%F z!kx5Ld)9c<`fkgzSW6^{r}cEaEz}WpHC?Af!q**9jYvo1_+0>49xjS9I#~P>5l_d9 z*{1aRR~Gjty{;Lr(^UH92os?WUNmTZ{`>sMgqaEt{I=`)2Sk7&a=)XFkrsDZ+&0x6tWR>r-fyaKh4^L08hG{mkHtH6;iIU&I9xRR#!ua4dK<@^)PD5{zwrHBTSk!49# zuH3Dp%oNR90s1!9XNZs!TF^?}Cv^!ix+sY8V96Tk?l@c4^&byciueBID;3({ZW)tV zq6Gz@8RDn9l;-RlJmq&JiGc_lY+4X|ofY87TW0!@XnO6{n|~k{<{`J|@WPRc*Gtb< zY4AO%F;9EnHID)VtQ!li405CB>8Sh%0Qt?kX70JR*gc8DKp9n%#={^pj+~%xMb$Z$ z8wt6Q&$8_uberz%oDwp3vAIp`KKcEnMrZ7TO^XbyJ8(n0@r%-=4vbQHD};ja=azeC zK7cRiqlAV*W13$h=@^$rQ_l+`Zx`pE4Ws)DcHH z^>($^MCl*TEimlEQcYc0W-`<(5zIr0Q0Q2)caypq7E6&ywczZ1l6gJxCf@KA3Lfq$ z)}Dh4CMj6H?okdD5*fQ)n&VdO3QJ(0TIPPv0*n42Dq9Nk;Wn2v9wy(lRqU}?t*#4j zI9`oE4(qCMtS$|?2iLG~i||CS>`vHYEFNnP7bO}$Il@7st|_y2#w(zNngm!0*X#$Y z^lc7sE)iivCIm;UoAUFliN8;y8I_cQ+OzIgnP*$3Ip%K@iwGA5@2 zvQ*(Df9_lGvSZw)4BG9er~s@&G^v1ef!9TIKlBt@7V=(iuR$A?E0kYQ@2Ig}o?d`M z5;G@pgHGHh@=u)`4BFs4nIS$+E`>UkghZ_9Yg0Qx@dp-7GLGzsb*9O{b`}vbKd+B%vpjUfq~fK;$b1z_3LZ z{L_0#U!Cq`E4Frj(wd45+r}g&(oa7V^ZQ!OQ{AqW&=19 zMWPNmPzHr6YT@{X@h<77e+ua_yRU4*ve{2Hu^3k-ib_MjS6wEox&RmRsgE4Z+r4Q2 zDEbZbpWjvf){qHfQ8p{7?p*0!+Og4U$=}0NA$(`DZ*2DQF@?m28A(g!$F25Rb3XMf zI0_;{waS5+ky%kJsmAh<(bb;sdrWE>@s#a$oD$*%%OxjMk#CDKCr|gdj+ilI8x!w= zdV_$$Pqf?sn0x zW43!y9V$#2F2=NgiZ3}~g0mfDg^A9K-u<>RTYCC)j&D}`PJ|6 zNoHOhKJxb5o)DnfzRS5cAz4nFP%H$+~J4R39WH?@66w-p*vKEKfoyBC!@F@jmo zmtg@MIEPa4fc4`V8#0e?U+F2#B9g0pWKjc_1~8HABA_}AAt=@mJztflsH$jd`?$>@n-1 z)SzT(7uY5CA8O~0+t5l@SF}34GIC)N%Tiuen~p_cEi8S@0Vm8}hT>Y0g_?Ry7JR^E z8?TlPq#IjItUtb;bLy;Gg1>?rLAg=mQ7LgkTCH*MEHiFCjuR4+VndPmHA2)o4quNj z0#(K7i*%aRFGkHYKqj!A;6`*OOD2-a`bG6fNO=o zdyS*o^dBeU2gyWU{k+5G!UQ2gc@*oLHvJSqtQK4I(9YTfLq6*C!txeLr@lh2@n)y^ zZ`C5wH5t^{q#lbef86^+qa$WgK{6+A6|IN&=OW?#tS&=X=W`0CB8W$QfXJjZrXXn? zp|jlJWnU}ie5;tcml-Un3HxsIyJd=g>(ftKu`KdCz~+Ic{w~JN1H}}LMOtuydHPrj zd(J|v8z~WOr4(GgOzUZQZEEj26pfo)f9!LWE!{zjN+ETT z+d?!Xb|ehVG+PBP1|J7Fi>{0AH3yviJ*z$t;AXcOO&3zt{a!n+)ySpcBgIIj8LVP= z*!Jt)Gd9COWPN`*UOWKejC+5B zp6>Smn_q2}skM2%3+bB$zr6LSy9@Tyni%@%5&JlqfY4*Fn7Gxjs3D1|m_h;3W@2 zyh_{;T_(X!F?^K&D-AP9_M}egP<42^#F{PoI>Z>m?0Z+pC~SsSAz-B3w=&wyEp7&) z3Yq16GNuT;DOlRT#UKq-R38`P?pIa4vXGqg(BgLWbR?exg>x1w0lM9 zn=7|&BL;383iHWj(Bds_0HH(l&qrkUP8%~Dy|5`%oCQK*t^=5Ip}Q!?jiKB%uzFB$ z4#{L~R5qIw{RS17DEG8v-?QeFwX~Y|we}k+TW${X=HA*4c=u%KWEp6+OMA0dBCG>u zdv=&5&|K|D^R+kdGV255xz~{gK|~XX6F9|O9Wg3ie1jC_v$y+I;3f^TRBRZhF-~z6 z=4+lDoK3+8|Li<3=er%3UhSj;pkZRO9k&huc}E?0{Rk{SBE`V zGJY&uz>RGep7^tmedv6-$uraUS)?;vUr$SPoIzLpnVgp!(iJ4Vsdb=p%o&-AHrdX)^@{3&=6;`DhYLs{_Bn-^~o=OvO#N1s23RBHJ`zFg{N1TtB$| zDz(DlV>W-a}}%R8fVEm7mTSsRJz-N*S4gCGVHE0KWa3XkcJ#>v$H8b7sTC&_b!&u+XSX zp`q(EiR-YVQIbq#l5&Q+j(cfnzHebOKhNX6(AJQwx09Gz^5sj9a%mIe9-CJej>Q5i zx;H`>Sz*IvPpf+L)lpuZsE$}H=jyZXHJ@4CnAN;?l?58u|BP# zv}VmA%#hOEE`>TlO}V=q_t>3>JtaI?LvV#6`gdUfAzFt~y-^XpGZlFHAuj=giPXnZ zWlzFelV=t%VrOTK{IK>#m9KRIqH(95@42=S#W1wGdAKk5-Ss!acx;k2I=eYG{{nyG`ebhmb%p0FGFdK1GhHV<+w!5W?ev8OzU6ZCQ%d&Bh* z{q2&MLc8~BI238a49h>2(u(Nnq$0zI+FshA`#rf_(8dcB$`X|)chFF<=I%phpbDE;9`sms;EVq}cbaMOhWOu4yTcmx-&^+&dVUFg3edJWE z3iYMdJK3!_WpJ`J%LgBb+w}EI@EMfXKbV_m8*2KxTt{Fq-Lc!M z>_7f`7|PQ&_03no>PuJ%sw2;7b3>3Y(@YMl*hXDEOc6fPMiz)e1rFLMx2Xx+RhwsO z3+Yt?cUK^;PI_{gIZG8c?-W;CeSc;F5^p;HgyT8j2{0M1)S4EV4$g<0DT+xjzF9)|Te)*pT6Px2GsQ##Ob<-Gb@Tn9VsRpf?<5Qi?8B z3|-5Dc;tr_dqslDl$B-u&YCT#NPV|wbR@L^ARkXXYE#Sd9KoQqaJ-9bnq$Y1?j4!t zlPEo!@#F|}o;aPXpBC|zjB=6=m08t``^BFT66?itjGPpffX$^CLeL<|F53%TJsL_B zl!c&|wn~V%Mu=l zI~+h(&Wx`#NQM`e>H6{B$o3M_Jt%tFl{ZwcuWS_FJDR!>KywiZ_ENWux!%}h3fq{e zp}vt?p3O5Pio)kHB4Hg&Yxux2d&yGl;>X6*b~`>n;NxQTzG>PF_H}(_SHX-USQii* z8yF;Z*pEB-!V6j`A2R`Ub>|!0p9H;w3~a3b7w|#SikMkC z8vXjgMJ)9kjf9L0Yz&Pcd3Ycl9PN$ttRP+2qh3IiHa4C?AQd;e*ocwI6*jlFuqEOE z0R2J4Y+v@T)eHITT+HfFsns{LP*e6}vK_9k+J0^@54z&$<99ThSJpkIvjU^lwIYQ3 z|LB9p2eI|4vZ=0t04h*WKw@12I6Kq)b9R<-bhs8O4AMW&{7G6d1<< z4&+`d^s6o5LkR`qn;U}d?E~4}MLFC>GBg3Rt#5$(B!%Cn0*?i4_ooJ+s00uW1p*J3 zAqBB}v<1~r8^~UMn<4b=%S7nK$LoE0uW|GZVq@2YWhqP-(H1dS81sbRXOvfV|T|+SheC1}~LotPWH(~nc z$l=?}jQ-vt2&E6<0K^dhAPdS_%RUPDp18lS3uq6@RRue%AO~8??vM2i`|q1`mw7j5 z3edLJ{bj0Ri0h&iU8eY`*XaOA$x0d+y3}_1q(h&qu zcbWzdx5kI_8!gYl7J#bvn9dht6!OydyW~9q!|;vOo5RPXma{kZE6f`U;CZL!hX;e3 ze)7-0?#UhLXAPn8Lj3%~a-#mX$>9$NF){u%04*ww3;+}<9H(zURt9eG%j51tkJF;x zuFw0cO0|CgG4O52>Wz2KuUdh-<6H1gun%%S`0I{-c`WIUVNh$kyjs)WHwq z&X2^~kLbhBFX>DB_Th|os%!X|n7MW7{fWUfg=>CzCEX8er>P~yDCNr@+`aV?eB$%5 zPysOnbguj9(FQ@k6^BKH{U@7fytiv?bn?9c8$9m6#gBTfo7(oY)A+Vg{h(p%tP2*) z0Sx)=HN<69*YJb8lQ2GMl~avyip2Wk445YyAMoWA+e3dUuJp4J5*ffgxZm>5=H?2> zXJV2I_P(&ki;v@rHj*Gk&3ElnhuJ%P4&cXK1dwg~45%uQIp>4RL<{FDz29yqco=ZW>GwTm4Qv@I2q?JJQ)MIgj>vJ}qk{oW%eIU03s^{;3>) zXiSKf4fj?3B!6^-j^5=>lcf~A@}2c*8opax@ANyjN#|nc?43WO zQ}3NW?Q^Sx#teQ4%OIMQ;g<>pvatx-@>8CS=VGw-7e$0a;-hG0j6vNr67nJ;jZRH+ zc6>Tr<(-UkWdh&Aa-oRg?2*#s?IUf)7+bju?1dOA>9QInNo{lT;HaTYsD?5;g^_K_ z_U1`}NCzC1^QEs$QDon_AWTj5$!u=VwWs_lP1>=5lq&8>5!y`U>av<~>cMWeg(6A2&qKa~xN@!s2I6!Z9hdB+`^ ztmiljZoj4wz&2LgA0E@m$YohSnj~*1UYH4w06oOwWP?mPxMyaTZd~c*;rV~HHfP={ zLbgm078b7);XzT`E@-sldk0jz5=sx_*3&?tBJcQDwwkBa#DMawV87SRTMPhY#}Rkg z!kF`!AV<>nN>{M^54v696K&q?(B|UuH%j{r$y&G_3w!42MmhxVyK}>7QuD1rv|bG; zzz)l(G9s(;umjbPT6ikDL0u3;b5DqM$=HDt!g*M}hT|eRL;$&h8mJjE*l8FPM<2jB&gQM9V`O*oNt3 zs-YM@n+2JRQ+-C>VOeWXe$nIL$4eIRk*0TBPn@30S%~>c@uqZv`?I)D&s%IB}!wE zab{FZi;S0bws9)_gH?x85R_1QXTeT zBFT4_3M#C;1ue(f`wq{oDEy?j=E)<{4CpD^->KEf7W9k^p%33krcGkbZ)w@DA>fhq zhs{Y#H}kEEA%F;xa}ghWsO!%^R|J{tIDIRatkr=`#}ai?5sU(p*#1SKcDqQ1SK9Z@U`bStKT<8-To2Q&pCLBpl zo*PA4&;DRib@97t3^wx};q%rHT`*nIJHgi200J8Z!n*CzFR<4?XdAC%4_qaW=3VeU zP;~Yuk;0ztIJp$Sotr>eLVK%rwQ*RgBA`IwrS4R&OlN%kVPABdNYz9Vg7b)jFlQGq z;S`3l*(xf06%shK`)I(}AZ4S4ZsxAZ!CichpZQsYK=1BX%zp*XsrWfK2&ru9Jw@R4Wssim=$h3L0LnQR3B1lSr;>(^wH^}iPyY( zS5LB!8r2)aNAH~QZA%3^&(_j=ExZcmPYpdBr83m|z@O?BDVQ#VYA&8i+z4PEc$Jgx zLy+c`1HAy~X9mxGcvnewuSEY~_aJLSxkp4AUD`KSWC*D=;@OEOV ziyNq#2}~iC7sB?AeHZxGSDW$rS>x_WCc;8v)7!?RA#X7vl|m%kp?_ zdle}H2c43fnnh}!bul`lbam-KGtbI0VT0FNLMCLnD!(E@6sjZBW=;Z{#|lwM8GuGn zT8mNmuxuYRdu*34e#=Cnbqtz)6LpV@F*hS{$nC(QzvbKatglh=n}{hE&qWolrW(zG z67Lk*P?I%C#49ih4W@w1RFvbO?KV8=U%SgQ^jO9&7|r;INon;}Pc=o$Hy8h+FDyTw zyz#V2o8B25fN~LyT?(jW?}qgD`v@D*3Kw>MT)|-C_%tWOeFJUfquep&0m~!jSzE@q zHU1W}*c2*>Ns2Ou z7Spm(+m;iJ>mFs7yW~$XDYRW~jkL&J+-;+}T_B-XeAYw4{`Hjn@Y@sT?L1Q7289-Oe#BcbYP=X#cD(bx==MA<-1yurRrE zug!macEmN7By5+kFG|-VPzDSjOu-p?JdB44ka(Y>{v{8GY>cWR=LXe5Hx>`QWX^Ji zsD?y_5l8f-HnBwj)-FlBTdqRNu-!zKdT$4$TZfe(Z`39Xvl|Qt$9CS(Ise)S|C9V)rd9oqn%f5&`*<1dqWOVr0zLs zmG*~86!pGCe5x|p`!dmN4jV)3V_<0)(_X{cGr=0*UuPa`AAdpO!f}__&i+O+!7Llu zeu$z=6u=aZ=z`aZlbB(zezU&95Z-yV8d#qW4l$!y@L1^t69qfL!WWEAspJF( zrK;U}Z0tG@SC^T&JWF`pC1|B{)T7o$7Y)$5i8sqo8+HcPw5H7L2b^Oof-rc_cx)g? zg0F^dMun~r8_7Hw30+KgHN-270dwiqQgbhqB%scpyXlsF0y<)qR`Rt!oS~ZVezB4< z3r_6S3+Y^cOREIA)qfnRyPGE?`!}QM;W+yaQ}MuH&fFith%umm8hHOvjElC~!A}gB zjZLmmH=QKL_ECY)PVpSZV1uADt`TMT##aWb}z zQ56QwEVS81IRx!765sSf<=T8@Ma}+2-Yjf!(qbh+OL0Y*GMFL_Nvv(g4vq6|=RVM+#*p9R`gzm?Ug?mGsK z1NSu5+I4JaI-6O-x`udq1Pbojrc88>gJ4zZ)#c@;?WtEFwU2mWcU)j7Mv-0GMbQ^F zE5AF>;Ix|GqFMU4F7JI~hR&_bE3u&O0`1K5blyV4x0#=b_O}xch!Hza^VJK*?c{s4 z>&4_>jncz8U5CykJ;)7uc-Zk*q1-|$oG4j3`SCUrFWdZ|Q(0TTA-1PR23#b=qk^kF zbd}H)sJ7T~J<4>AT`5j=XAT#QbB{7dejmRs>;(B_7F-RTBfGn-oTHq&;6owzsEJCG z7YwTk28~|RPveBUp257~!Jf?{9JK>Mc{^CK#cBb@Z6Ta>C96?HbJ}K~0e5LAE=Ym} z&C+f^b&@4C|-$go`kGxWkFo`8d=+1x!5({ zq~O!dJLkMRhuxKtCk<)%!9`}hs--pmRr$-2RV5?k#1l-1?<(+sLa}w%`^T=ipztNhhPQ0+zUEZIq=AMsh-3cK!~E2M+QdGCb8PB39|? zZFscMLYaV06crg@^OC=2{dC^DuFlF`1P1SpMTE%X1dKAxDDmKC3oIHs=lg4w=I8Af zyHe-K)E{|=*Mm!njqgjq|D@F7+R$F6JTz}Ow>Y2u_2R73T<^-4iIxdv4wO&Y3Hmfa zCEVuhXRkZoZxyx@<(8H%dtYAqc%I$WJg7)vC@c^QvgH&@(_}Se7B{`%8r3pqi4fMO zL37d@@IR_4(M75Gj~&#?xAYF{pETGN8%$Dq(LRGPq#L0pN^~NfTEWXR8O}>+qFJU3 zW3`jH+nt43bXK```-CHkj<%^_#pPsJtR8BU`9L_MKu3cP*(n7%%!e-9&n>1P?pSem z7bB{t%lJz{pgySRqEppa7@GZD8TV!n2Zua1G@7YvP!7B9h{TRfaej-p#CZFMV+g$2 zIXZ1e=ALW7zN9Hg{S(GmVPA60rkXzCM%_wzNe&z9NkuDXB0}U!nBJ`=3Z&<6q4eIn zc&mK40tgh2|K6xXsET8sjI4lBg=yX3c)kcBgtO2~Sh_rWy^ql3sG>}Rb_|@dZyY62 z93?b_n~8UPOVETmP?HnzdHC5g*zyTvj4cjg`us+#)-g`}Il!YJm1r6{1Fv}VRz}qI z_dJMSdTA1xS;9e8TB)Y%)>M(NV5_5NzfJ=&csDhbla>594_XbBOW!A_2272Pt(FNA z7skGC`Kdyjn#IcQjul2P_60hEIN@0vIbR$s>&(CBkgqB1ORoCNYlg}{NI@(x;{0-d z!-XOcBGUj@f!4T{%Ys3@8#!s2l7&f3s=|7qXK){0!KO=Prwb6rG%q;R9O;0~72tNV zJz{@B2gW8u{mE1dWzN0^LrHs5>b!l?yyDRBQwGEJB9JkuepD_;@LZFif z&~20%B~M;@SxdC<|K?cN;x7su6()5gc`e4W@x@Ay7?gqqdeoO^>8Z9kq9tfYdkzal zB@FB$d*wLpt6*6-*iQ0M?c&%MRwX5bjo4yQQOg_3uCXoK)zTDK+m8bg6^>b}HzgJ| zg2suXOU+?~QePZowwkmABQ>~x;VH9i55?Lz`sku%IEP3)qfN@ME1txN^BW(@NF2JVgtF7bbw)f< zwRb<0laZp9Z#|GRJ|YQKNH_c1{iZ+cOYjOoNn97WO!&@{fJKD!VSRr1aEYSF5W>an zqKFk8%}g{bNv?DIJXxp;F>sG!6X2)M=uy>$k-1h*AM&kK%xwONt8j)EN9I^kQ;@F7 zi_|Vy(Q%q&iVb7o{>r&ZIz@%{^l3X)?RpMSuw8UILBN<- zG;*DJUt@isxjumI$WjZ13#Ve{O^E^u`^$t1ed$zkCnlfc8U_Wz;5hUIZN5Fb<|H#$ zGx5h7|WhPGPQ0!f-+juC5x_9n1qL6NvQFQ!S?L{QYO_a<^JbVWz) zBkQ@^g|hvosjppgvj1m2!T1=Z8SgSl8z@xEfN+HR`N{QW_tuz+eI{sOHef}|B09(_ zhsjeY{73n7$4dsEq!6PL#BHZID?_=eM{J}wkUZorW~H_Sw)+7mWAjGIqpx-U(F#h1 z1tT~)KN(5~Z(mzuaXkc?J%;(C&#*)GkRIVBo4v_gKw6hlsox~^@Jl0-8O|Vch2WY* zK4;u9c3rE29_rg%@ z+Cjfho?5-H^yuryXQRv87!agPud#7Qyn+T{_ihDu7o8(?k>F=JI*Nb0MGoIQp}NY3 z5zHxa{|ol$5Rh~Z;yzQyXkqpo5MfnH(|sgkpBvgiHq5e>puA3{!#$;>V}q))33rkc zLXHD(dn1@#pyM2psa9MK|Rvl`}kDhi|6PujGH*c1PXtO(klh12EJPD6ki z-^O3PzWVn~=Slv3bX>;sJ}7eA6qa9Im^T0Gw0gfKk0HqEBYB^*j0h7O#6%VTUiT!3 z!|sXMsy-`i_Xeh@+&BkS;pwH1b9~AU52N^(%yi0>R8(k^cl~!}2B{zEvBaapG~fGr0_zL=!IuNsO}~wp4Ys5`16|;on9h zmpshEvLYi)Q7YT9v9d#nldSDdA7|KG(T-HQ3XkDX4Uwp+{iwDmHXRWA%V#c{BNrDi zDi+_eg$a+alybSnO?$?ih~ox%5J!+%ii6BkB|v=o~@u9A;x!JgyF#+qPQE4Nj9gW$k^dC&Q8)ZEHG&Arm*b^wKQ4 z>83%eVB5aTA-;GuBMq!NEG&_dTA6=mfzVN$0Rsx=T%t00pZe9EPbyCHdgz+VWpk#E zp9`O>@5SNSNpBq)t!3Cx*`kN9O=;xy+-2ZD+O;jQ4Z`p6$1S|yEw}q9-c2{7CLe~q zgOUlib!u!-8hPh}g?S_04X1;!Nq7=u?SNY>dC$`|PSE34=V&WCQ?AqyE#D$5{U~~6wgQCl^J0bWlZ-R9_X(wc+y_uTR;KA>it<2S$yHSvvrhnnEsJDMU2gYWuumbgDkTR`ESmfnn%NlNUs!MQlkS3h|qVp^Z|+l>iOUqyR0^ zcm=s=bDf_=y`T#RCJu~TC{mAlolYvXn(ML}$dW|HW^cFdS*R%~c)>oPP5;?k(<=Gr zj*x};9!`+K#5+Fd`iF zE)`H31*QQNme52d%h*&LJ|*hRMcPgdWUv(C1)!+cJ^58ymd%_0?075nWXMJAq}aR2 z!#Ee$`N4jBMKRQgPLmQArB0O;jtM=+|GudM52?rgk7u=S$vBh{x-cM0OQ!o`i??4* zH9I1;v3Rt+%T(OpO{UED1B6v9)QqgccHIe#{KjC3>c;R6kEhsOtIj6jw4p}>29O2XoY&2+!#F@rA*Y0UD&ww`ZAk?86AhHU z2fxiu(wfjBhsj2j&9P2Z8yDjKoo*!@Pd&csz9FG4$(eI9;M;!XwX}hoi~4z@oV8G_ zQsaP{bU9|0FmkvnETuyHhbjmyb8IkLQCDQLkm84K9?S}NCW?eHaon7}*I+Fg!9z>J zq6RI~X9j$gh^-5Fv;_$ob8+ZO64oDn4 zk+2A)B1$k$3rv*!XClMO#{40(7g}U|0XFIeO{OHvhO-6%yEqqtM>BSm4TUj>Kcuvy zU`jfuZ`fR;b0?)I8U&)h(@5tLM#P$OAS{o$bGhD&xDzOT3c^Tw?t!MDS;{mI5#1Z@ z1C8|@9p@C7N=RlJSTIhWht@YW{3Le%XuqxBaN@0&2Q|cT*(k zssnMgktYmulngO;4?rTGY~lTqww$Y8fjr++r)17y9f={#YU81MMPOT@*obkc9@Uiv zx&>8X&L9vZKQ83#avhy{)&`yF)l%kh#12q)mU&DLb#q2yFQ+N$sTp5M&ukq*o!YAa zwagkc#XwJjJy9@P8mB%rQw_6#;kL+H=v_iS6K|u($&iyi6lMM}eQp?u$YN%K0pvKH zl1|MZ2O=$E+J}uh`ZW#PS}A8V-1Qdb2{%~gzuZyo6eF}yk`y!N0>^{5ps_i7d6tPq z=2@vHj6D*@#(=+aX3vP0<(F@^Q~`5|3`9*uiQF^pbp`f%oy>`zYQp8S`J;LIe1n(e zPLa;I3?WEJ+kCe9%Te3#n0lsRwVMPE(u^6Lhw`N_b1PM+Ut7UbgJV!}#|c#F z`gD)4-vak?!;5i|c2br9D$G(Y3o;fBU1QE=3&c=EoRY&-evuFvRhATyS6RJT7+lq( zk%vw)MSIPqbU?_`Bqq^$c>>osXfaqcx zTaH=hm^O++O1sQMKmQqeNuuFU>a;B0l1;{NJVZVR!+PG{GX$KK#R-D&3U1=sXQ2>p z>+UAp;RkcbotCtnVh&-e6CELqqndUQ?ztm5>sJ=s(^8%36Uki-V4l|I#R-*(Gcd5f zI$AMwyCW=8rLd{PVZiQTpiUi9qaw(F#Lli8*Lp{$7Jbhk!+|K{Zax;u8mlOs8$Nva zPpNyHl%qqWDJ7TupSnT4;k>56ocm2^-{rv@8=!1?5(0e)kpUPRw3I8v572{K_rF91 zMT&&!#*uQnU4pRSR@MZKG0g(9koTt%;w06Sk8$zazgPAO$WsmBz@Dz>R?2A=IpYv%>Vvvt%q`{KJhIJ39eCk zH`fxOp3$jRzXsb`4|+l?vQJ@>&g7&l(TF*DmQ2r(QgIpil z@qr#mJfxQq4irtstL@}?T5@EyNJbSNTZh;TF=B*ahZMhHWLsX(+CXlBlG9q!vhY^C$eCFY;TCQ}(%itR+=kKh6GYbsxpHUr7>$<(^&| z5$|6*UV9npOFKnhunGt}zhT5Xl&Di0V!AOw44>tt;I2d2w_(8z-^^iJ(IR7CzyY<1 zVvTxJwBJRMq#m!VB3|CyF(vt>+);mgLKq^_74#VZ70t@0N|4nw`!Z0NM%HG0cqz7M zphcrEy>d@2620T*Nb7j&VGNlB;nzdXC?!KOnM$a37VF0f=3GK-Oz!X=gBZRC?{@e3 zVbiHwvOm!i=%#w8w($j)Gdy|db%Z&t1*DygJ9-I4j?Ew^L$+4Q)ssCq9g9k(*HfWW$P&b)*9Ql5FL7bTVs3kQmr66gmv|WfvDfUG}%%8K{>B(0Ajq!F@V37*6T$YA? zF*bz|%#5&QDnj@j#5QqD6kqSg%=D*Ba+XF8uectuvQloAq#|a}2v?o$lLxGESqRp8 z!h#}LCfpD_>FPcpArMN%44CemVEb`Vq&d$f@vPF-I_6@~-&|GGVi4SzE1s7Tg;0m&cDdOocSMiTX;| z7_sbb0EaUN4J(n5Wc!5$@|JUHSF=8yFZq72NX2aYr($!X`;adon%Sb_POTp&O_{IZ z+lL5L-J8fxRG&vTdbZb;e+EJQ&94)qg;i{ftul=#)FsT58k9l?=8K+Tz6Io&*}8ey zN7bhiwVA>ih}aJ4BmGI&SbJR`*LQr%Cw~Rt2deC5__#`{+%@14p6Xe**^V`M4|HFu zXTpHUlOvA&3n|ElpOW>jzb=CZUS3&fQAe}MS%pF%RP7ev@f}JA8qlYGC7-2t0^%3rJ9;#(EH1Ga9NSn?EPnEDjRPOd1wY z3actL$8snyU2A%^0%*R9?=3@aiunY?nRY7+uL?G?h}n)5IwNWBQ$RGolKD)}uUZE} zYP|KayvgXu>_vDbdWH$6vpB>UdczkCLn>aV zg9!r3ER!J(j$lZnR^O<QWxrKCQc7X# zEqIP>!sZ2VQK_6dkg&y%f(!d0U7XHcD(nTCv$Pz4&+sKUo4ZWOg;5oQw|byOKIJAcY;vaAW=)5s~=}Q=bOhzqr`gz-}PFa<$4{Rq@Z6RO5 zp&>$oo~9ePBI;)7@Y9{94x6{}V^P`%NvA=xnt)}CNHTeh7k>UXx+u%*Mr&9u>Rpge zbmuC7Gb9judGJ&I!rSp-8Z~6gZcUl3cRb|*{(fhAKFn%&5eeaEogm|Kh2oYVCcUwD z)6Dj0(*65B=^v<>dn}#JYDZegzkq_+PC9?>5;gA;RPBPGlPJ%lNyUy*P$?SdcTQ;H zIlBbU$?cR8?3OMZ12k4+JLi)Lz)I)qiMdL-B}unH84fzK4kY;a}IYz zn+Vt{5&NKQz22**93F}+6uTym-aAxhJE~fgBdh)qO%>}Q&kmsrdD-jR#U<9iJuGPt zSt;6uGxlG+&XHKUuQNe2h2fJAKQ4kcH|zX?!Ps*I612$4B2ZGpcrU(H;b|tgf}~FE zrV#uKUNFVcrcIh*6rC;2*a%!ZqNqBr_^6C&qYZ35s+}B(tThD%>WK~4^>p=jL8U7> z$@lgyZ>8Hq^KYlFJ!9jFF&C4==;_Ksl6`z zQ_`j*cer&hzr?AqfFmm$J@1Z!O;lIe@aO__Ct8d%VZ^w$QNJHv3=WXRn2hFV-b+YN zu>hAr9jB}~Ko5;X_ZIAY0NpYF2@(BCTG4z%Du6>Ut z8k9b&_{nf2b~u!JV~MrrE&8GftAip{^gQZGfGQqkT6vBstFP$P#uA8SmALhCPEi5%D7zU~p9 zoAuCFiAJvsxnGenLGsN635*kRBZsg2^0kvu`^*CES_Hb%qw|1_gsp>Y>WiOFLL6t_TUAT>uG5syahkkIOP?K^jNMoJ`GZ|9W!!pZhfR!RR9Z%W`Rdf7>@XrN=xA z&+jR_eY7-4fxg0TJucT%)vqOp`Be{DGO-)|u(tiwen{?-8DPo0-kPjoVxx}BGL!8a zYDi9^EZ=?buvwA2tb1>;*Tms9Xk!0b;yhL|Eog~LPk&9>KcZ#-_ugwtj-tN|QGuCS zrN>*xA@)wwZy^sbK8sGxLz@_%95%V!<3f2FnJ|21^ToJVO^)4=(=+W^-)=(gucS@N zdW6`OL`qiz5~l5W52}u1e9$!ySEvHno7Sso&vEtez&)$BubW(p&#=7_ly*$L4i6Fc zy=>4uNb%iaTl56KId3;t%ZZG+N>6yTbb=Q=RjE8Ta@AivT}%krv@yW#nDnR&HKnHWGOk zoM!LL5}{kNBn zZ44K8XZZ0KOLxb;I6GuL2!X$|!oUV}J8)X&NQ0R%-l;ID21nX5&FfP$IV>i%My1Fv z^+;ONYJM^PgvwA>r?+a9^-8pob=6RilZ>K7KE#;ZQFS2P%bVQ%zb=crAO;;zY4SwyElu*}{_AptSxJ#h9h#01)1}vMpSDgeQjwXb4_WL0W2(S7DqZAqb-8h; zPeW!`t@>uBMt)r_HkRyw`ZHBkTfR8^C;9%tYPq`WdlzH;=+}W#(5mM##kfP}PIe&4 z_L@L(S<$O-wo0>NbEindQoDfGXc<3tBYLe3Z{s0Ds$5`T`!0O9`#fZF<(m5S_%A4J z-?_Uz?V(pglbL;+h#+eSZlRMGi{fJ6m8qyAms>MF@4$t9NY>&kbe|nxo661F!C(&6 zEerOkWW>t=o1Wcaax9RF>yWh#C3Qc?7`>b}Tyrnmorr|NOzsf#DobOARQRu-iwRxk zztlQ4&aXBhlvmZ)#$I*OR= zLlBmylGwQkDc$>{dk*Z#l8TLp3`sknMj~-@ff}zsTF%CHFFaf@0^^SghKIBUPGC-# zMpKZ|mvFH*Swe~nJGyzAHE#U#JdsE^Jh)u7j3GYCRiN|`MY7s!@+on(B5LJdHCC_Ei=JPq8_$t@A#g9pXtEoP zDy16gF;Xw>@33oX9GWqx=XnMGjGaZNs!KR(xGZpWa?$nfa--nKbDl&DWx=nQ*YmVh zvpG0j%jqMx@q{2axV$#oYUebs*G3q&N>TsR@U<}H$~xatwUilYY-l_g%s5aJk)25Q z0AhWRSn|KiK*$;7M&Y*l zpr={#4D$S2r(gHrdJH=OzwQ>YwI(^i;O51YU$+h$B_C|nKTO3D=mf5}bDmyt z=Ej!%OmcS)-Q8mb_~dCH*)40jIT2%{Z00U)2BIS`?H6(QJ4eS@bY&7hS@IZeubNJ} zyiracqSDMbLSUw(rQh@mX_HBm%}s$DuZxW?)ai&zI36GnZxV2sMee;r z`nU0fzMFe*Pu^cd!nzy=fxyPZg&=a=j4{r|m0wzq`EsV4PCN_uu3}TZrdSsw&2d1$K_h5*>*2~| zq~oO{=fuEhnRz#Jx)_{aZ@)1XJhwds3Z4oaI6}-i!=lzV&`RvL2tr-B^2}yiKClH!n}mSG?+MPcb+!3>lnUIIJV^#SpiCu1-DYUL7Ey zCj9DJ-h?}ZhCeXad)Yp=K!x1nVEceT`T%IH)X;ljW48jUeO$h&1Ad_9>3rC%==-v@ z$2kBvyE`3#{%^fMG%u_lD)?;sE)0XqsAuP({I7iouzVh^P|&3Xm180I!gm1p;2k=C z@My9`B)I!9ejR+dslGc|g1+PS?tI|Jy*&qR>+ZcYu?n}1`1jOIt{o~!x zKRW>%W_$M``+DYKSdM=g$47T6+mdSWt}?Ri1JQe@f|c3pgSsH1uL=cZ{~2>ykqUG{vW9;QMqbg}96{ZPInN zrCs@XF3-b5#~;PVqBA@Ofx7bx{NA;dHEN}ultGKGcls1e<87UzEo%2lt6?(vGJrHN!AlcLDq>l>WASM;KxhAMf-3>8QMg6B1pyubfRBR%&#OOq zPXF7Z2M~!+iaq(l+Ti!;2~Gr=@Mmxm3%F6#9sWnXAr(D#=Mn930}%k|O$)DDj`O!q z6_<3)-OW{3{Y@HP3iGGlX964aA!rS8MvB0Scp$5MV5gws@YKsyC8Y57rD3-CPp6>p zvQQ~a(Ok$x8R(3?39~l&jH7>2RhD|w(bn&eUU4^=XN6w*6B5Usk;1mEu0M&ac8+dL z2}mZxW(JW@NRmxF{tTJ?`CL$u2W#{`;jUknUC~6rOeGgEHyj{PMlQ!ZGs}<$$(KNs6Wgh!a=SHic z$)oMJPQT^^(-Kuh;-|TV&%th`wZ6pi8}j4?6#3AgjqcsNWw1~{uH(2l2Ym5yX6j5) zcW)vq9gzc-pl8{Q;jVkx@sj9gB5jPB7+Uzjzz|ZF!1Gc~yVhq#5(MLwPGqWbDlTs! zjEpm!FkDVlkc~A>AL&DS4W90OdtHJq{ryGaEOjzR06osOwj=-;R5CAx&8TlIjqN#k z(v)ldnKv`>$4@TX#i@BA1$;S^Gv?7BPTT1c^_befbi8FhfrOKXxu<@;noAOzj!d6X z&Aa%*l^1q8mt<$@);o-hZ7Tcb$sVnJ7-cDAjc|8%YBIrpakGFRV-R0g#l|_ybvYZ= zwDhrCZs1YBO&@83OSS$ECNi>10Ke_;GtqP(l@MCkyYsHUQ#Ux`{YGJ26_<*JBN*g_ z1q&idiJlC?9kw~9FtR}~L8iB3IWbK&o(tCCit;E>G7E5$*s{h365GGc)%rqFQt;3G zZ5{p|S*}-^#N@yPkt}j~Es{>5at!`4{yp=oJO0VgiG~*Bx>%%bhVQcX(>PAq!+h(M zOEz~(bP#QihL>D1U;B8zGML>C+J>fncX`U_e?qqbV?3D@X`!|6m5pzw7ureV>+4gB zq75L8A?1VE`+QiwpfuuI4Y}1tqMIS4-V3XAf}C``EGnl@(ga2-H}Kk{o*j)w(HK<_ zFpZF!@MuUrH)leN&*|DYk`|4W5ZQ$9R2p#&uHs%m{%>$K-%V^P&k)YjDq)s9-8}=+RM*0&_%zR+zk-~!BRa+cbAWR& zms%W>?h6_)^up2E)S?{~s=*dFJ<9HQ^tClHt3&Ae6P&jC=hHfF0sqbpTNhaebW4C? zGzq(6yZ_Sr@hZJuu7!bUr})~@i*btM^S>B7r)E*2F3TR793kEThfPfIVX_uOsZEo5zKxE&2Za7+nNtkOn}P4Gh$ zF1{^I>J>tmj~anrql@dLVH%chxh#QvSwJPCjFr zm^#q0_3KB&8bssyZ@AFd+-kv8^N(Y)HRbN#QmdJ#r#Wjy5byjk*B338+0|xAxjK4F zP9(LXhMDoRR6>)IWqRpM3#JokzoS#_!9i^1 zhg_&m4I}?2*T!_~LUv6(yupS#Z~PkO@?7@vC&7Q0zC_at*=knb^g#{4z1y*SgF{xR)lL1z$Pk`-B{Ey zR!Ca5`JVmzyscH1Y^}l8STs{`ylFGjaHDG8_*Te4C_&LO!;eUP zBi6R;#7IjyT?V+H3DLL<4GJ+onKVGeW&)@}E#@0@Ix zmJ2?)(22kvIZCufCvMnj^@Z%5#z!u`XWpgeU}dwHr52HrHsH6uXOW?5_AES=$oM;$ z;IQ6u@2G5I*47KNuI@$oKGm#D9;kF$E0-Gf^hqpdp}A0ZZG@7k6*Xg5@;+t#FWO%y zIMvX}LPugrDO8Zd+-Mfp8_cYtTE$6%Gv2hKBz(i}X^Sco{hyD--WG@Ns&uuhlIcD5 zegL1!9N{0Z^}o6T{Hrw_jRnJi5}z6-(f3gw`DNm->ZrmcKco7h5<@E8q2JrQ1R%bx zg|YPMeV&=U+D~FYdK3ne4Gn9F8kCWn^QcjoMzd7=OBHSssy~KU3|D6wH>lXGZ|ButzuIiZN)wi_zBmddl$i!Oe}Nn2g3hViBG45(K(`LDM3>#D$~)XUMz5v8 zm`pRlTWa~Dl1+X8Njf1etf)Jd1^vW2$=y5fzy78qW7RtHnCDcF>)OFCI|~IU9lT=Y zWh_R$pm~Kj%Y z`q{I2SlpL5SZ@(E;0!JhH7(@PaAI|RE1hOby6GDw#3}TqkIyee8kL1Dq;}96P4BT! z5P*DUkhV`rbu29;e$CvF& zITLZQYevZTGdq+L&Fu+V3ScO#fuV+@^Q@^j-d zl-{iDAe;5ArhjN)2EhXCi8oBiZxIu)rZ4!@=k2$KL&NNvy23PWkuW*tNbL3Qk>r^{ z#GF!3!JgDIokiE!iyeoh%-)APp!Q^Fu?d3ZHmRA=2lG4i$1$TN&k}$Vfy;t-Kv{aG ztdT53BtTH6VEWlyX_luUC&iY|{ysrRBsJ@;^;CnD`ljat@DgPZ}Cal=`XX8GEnJ3jG&g$a1#jRKc~%Fff`#ojr|J*84V z3}dzVk}>0v-+6h{rlip@QGuf?E#NpjC_|^cew-vYi16p{bA%1=2YP>;Ww zO{P0~A5WHiQKi&aYjMQ#kV?@X{M&UM6`p{vJe5#G!6Ddn2g~x1g#nn+>A?zTmb0?yDE1$6nY)5ltB%E~;#-EE zbNkg4kZp(CbYBHh``irDaIIqVsyygW!j0!NKpUTxOZ@VDDh)>wBCBpoGxgNL4@1sh zo!>P3&X{fKY!>HH*ek6%xu`Zm-GtyyeB#0a@)(H)7~WlI49y>c1l&=V+d{ROqDM9n zcb&zqt!?Meb5V_4?C0ABdo~SA>iQ2?c5boLC5~|QnQsyEi(Ig4)^1FKJ0&Tj)3ven z%Ril+is_DfD{qKRuS_{>WopzvsC>LC5ymT;cacvgRZ)4HDvrs<^1Rl(4J&w~=3ikE zA~EL&FCRQV&uZjfr{kk`O`HI1o6mXH1445>N=MiV2{5ik)^;W^ys4jc#hMOZTifeg zSf~H00IDS;rEO(n3w;QBbbEr zx^avmh8bJa;-{3ba}x0|4qO2C*0Uh$nA$R%n()<|3LnVw&~ak45y-#eJ!}U>c0=sK zPp@SK^jgak3zqISl&BeDncbQn0W}$C{@O)BHvzyG@p2NphS>Ew@y~}tr^C>+ESH+W2r7L}`Q4~8B zAQ8N#g?YDt{}w?PrB3oTorgV{(9)&x;Z(3ytRw1cd3e$x*C%Hm)zY~F=&0apWNjHM zy+0}MbKI8@qWVPW{oVTleo*SZZM6mTi8DxkY6^w+;ZpGAW6&ZxHIfY3P47XU9BPhc2T?# zBc44vD_2SMl*Zw{to(kT6$Qq#Rci;tuMlokuy0F1HFJsj?}WaG}0f+FS^?Ig|YkdKK7v&~U#d^!-{pqF6ah zP`OEM-`pwWw|;CBInh$pAFui6y`Ks5;$*HqG(T!~83NCk{kw{GRZd1S4P^$7{O`pb z-8>(>5_nZhk;IpF$QGH9GdBIiI0=j1SgQ@nItzVI_RXI}lq`>3h2n)qSB4gM`yg(m zF0RFfl)c9dq1!^oM{iuT00tI>_@Nh(h?4d zNO1?NrB{&)b~^Lp;Z^cGLOOYz!f+2~(Fv0wC#^$RG26*QnuOct?;#!cIFd|9zTkg@ zEBb@cNn2$r#U6JC5XKvPCGkyrm83;MELx1#!jaGt9~42=LxS8h+6ibH`&lpS*=HHf zGMN`;XO>_ZwuPFaC=mH=2R+Vurz+|KhfbH#m^7k59e5bq4i0MJg_HQSW446Z9=)x= zu}FZD!dF_~qsTT#6M7}5%jq)4E1&Szzt6Nj9hR-{ck`z2Y_@OsJT+~EnPz0$0voG@ zO`Ywdyu@>9L1LV23A_@<((LdklO&c9#~wRWm6P^L2#5<@?^1;_n}B zYFEcJTWq45EkZks>ZweFi|&M=4qBh3oqWe%P0-YyI7HSdbZIshi*krB#HmnSQ)}_yt)L9IaQ_q4qj(`Jx>>~-?iA6 zfFdn&AvvK#C)(1d_SU6tIo?x*##4? zj%R7NVCn&Wr~_O_6GM*~WQv*7P=w0 zR@H{UWcV+Y;_}zp=1{O~%b^1uNTToYs$%Tov-e~cjUID<(3R0}gai{?F}yPCN;hh1 zvYGQWh`Bm$v$r|2VT07Srnj1Y!o|+0x~?g<$9ciq$l?mSGuHGHw(9pex*PzKm}qS4 zM<*lW@}o+e^x9mSR4N^w>kI5A*&=%Jb{b!SWmAGPk=2jpOcQEKU)i|Ni_i}$ubC7= z>ruOeXsRlb?>2gth20}|@L@LwPS@pK<6(6#ke894rnYvjhGLlFHrheo@Rqc&$%&F( zMjaf?t>!60hh%(paK~(qXp8wJ^#Hp8dzt<+W6QhFUef z(u~EiepCO`I2rU=ui#-AnY{ByV&{kbW-c&hF+Pdga_=l%rOPyTZ*Qr%+P%$Efp~L~ z^c~ zxR5Kw`q=hyCj-QX`~z>wtIH*Q z?Ms}9e;HFwD|&yHsK$>7GSZ@V5G-s^WKoyXH;$JTWJeW;v3pmNC9(r%8q&pdX=Jxx zjUIpZQeW9{{D>+=E44-Pg#o1A;s9tZuyeToR<1jM0b&mM8_8aydP=Y zl5n>!!4aeIwG0aaIs8E%$Rs0;IC`!;RF^-=@RJ6=Q)EFi%}A^FQtL&XNn5Axg`)D!E3ux+C!kJ+_c zRUbtWS~0Id_1j48An$hicWN2wV<)q}#eaLfjMR_LKR2=1p>K2IfTS!S-fYMI*mSST zph}a?wMQP}tIgNv2?x`w`VL6pJFjV6NLL((eUHSJ+JgQ$9qX$P*)bOcT_MfPEq16l{d8R3{ofI-z2oqy0(_ zQ^y&m;WD>Nq4%TLEIx*v=WJ+G5glj@G=?DHvEx#JD)sh{zfMePzmmn6mqq z_34k~SbDQqBCMZsZHA3W?5fA0_=Q~>vYM`$EM;OVh#*`V9W&e_hx~L(E}SoA1*VfQ9R`mTs%1l?$VtA`|2ZGZmu?zz0X|fF7AU+v)RD$mc=1ip99ea9N zA|F7tD?uTDD4YXvR??UJJbcP1kfUCZ1Oj0%|Coq)p@l3(hOu~4aca19T)w11?2d9T z>2D=9kNuPK_oSujQp|!w`T)cZ1h-04xo=D+Tydi+TJ{4yGa)OHSQ;`vive!m_D|XK zEy`JvSkNS~t1XaNk^-{RD7;({XO>KArZuKp2kjbuaOW!I6$f$4OC~P07iD^q*>n@%_+@!=6<_fI zs3ZA+(OG~dsb0LS%V>-8N76K-&HetxmA!G;S5sa?wzSBfdNzMymUk2Q zSzcdFS0VJEBdDD5q3wqf9x`F)Y~8Mmx{KNI4%48(M*ExA+6_VMu++W%JQ(&dmLA{1 zv~R=*lb#c(O!~z#09)2)qkEHaxoo~~En;GE_I$XEA8ftIOg#m>5@R{?!FFbFM~j_C zpQ?);Qrda@g}Ql0ju>ta4q3DHr-_;Nk|kcgoLOA!3mASZFDKG{yxs{|z8ZI3q^BFZ zen>oDCRyFo!swdmaKUOf2g0+CX+v=uhKrNPJHnWSoec zLx#%GwC{H8e+3J($s8duOp$URlnun+3hdv+nAzKME zbW4nI*o&RJJx10yF{0A4YrOaZ;JDkh{)ga|@jnHxtn~jAwK5WLFfp+FcMSXg2CoeC zOze#RTdZRfsB)GT5=|7Cgx?;>^`7h@-qyAbmRVl>NQOS4xE(wQ^bNvR0JtkTI|#%L zo;F^4JCm!)k8kxWnkCC_&4x;8#Y~ORqozur$kaeT4D~fYaD81P5GVkWq@+U^06|0!das!CImW5{TykB?mv?LyZf7i!1XC2cJ4hSfPzy6B;XDRZufC~UDxFZC{$-N%sS#XsBy%-=XD;pb|YFsyTWnkkn zHkgSYHi!wVJb0&H_U=D)WG^-tMc`GxFQ<`6DWI9AkoM0S3l6n`4S^~B-nc$E1Gtb* z4v}^~n!ah@;ywT@hlpPUF~&z|)mvyE%$p}GfQ#yjZ|Nu3hbs}pQ>}hndwXCvF~kL+ zza}6xp^Ls>L=(}UDclhl009~wWC0giIJx`0R)R3xv8(VqwPOOmrZg;or=`8!>-ID* zAshqRDq4ijU7Ch(*+*t$%Cg{~z-}H4C`W-`om`S3OsgMe7x)%FHcMz{yFia`SZYFf z=*e9f^)}81a{)rx8hwuOUP?K#CtoX7eGEVBvC+x#Q9uALz`mQ46|3GwOAq#dUx$WY zRzByw>*KRMh&nF|pexvV5Wa7rR|mjuP+0H!)rkcc0- z7jmYx2Y8~ z&^B?Qt$wr$gnvXw{PC}P%Wqv4E(nyWi#?$C?-p(mK>y!E&kZ`q&C=JwV~JE>ZGzNN z<9|fQ=w605^X#8aILfm2z~S5O!@UzgzpQKlyfZnq-=H=?-77h03qY4&sdWHW)iU5K zN|3vyMz+3%e$4Mzmd6L6wIrX+A3?duzLFpK1CToN{{lO9{1W&8WbX7Lz9M^g09^_E zw$$-aron#U-<{)Z`U=I6m*S4?Odaq6yO_A@3}{=+P$WYE83R>r4r*4~MD)I{oRtd*!}Y@Jhio1aWsc4rif1YQON z3wmru3{abV+ynVA&RixWIbc=d(MpjEWNGL1wPVXBQ-2v_XM_c-w1UB|aCKD7th2Le zb_ts6zW13N+ghUrmq&mUeQkVJUetj#@=n9vI1+V4seGQnTOx+!hfm~Eq6YQo6pnTz z_iCTxo@ou;5Lv>%Ci-6X+Dqet45lDm5houBQm*PwjdV>?xOKi_j!sI0scEP5>jx0l z(3=n!Ynj52lec;G`7k*wvWV3UuA1CV>Qt=7`e8BRQI9GsHRtC<4_-_#^@_YZMvMXy z3HO>#&l_ir7Mve_wwE?c^Dj7b))-3rtx%QMjld@9?0qq9zyz0~i7j0wr29KOMdyPx z=)QG%TjdNBZvbzvqUFN$biv;?MSLnS*k_}sm^GLF=9vpnC>~CWqfq&nes+kVcAIA!8JJ4WSPtzH*w#M$a{iP&yvlbJ$0 zGQCx%(uyH3pYhH+9bt)a& zq*yAp03t|38G$0EgU9NT1%D6<*mXv?ZoPa^EUP$$n)ALL*d9gKyn%>Dl{FhqV&&@p z(ilkg&nVcsBz1*0g_~m~z+hKq^XeBVLsuYc#h6hJe}yx`I!g&V@Z{)>p=FR*U zf%82a`Q--sw45XXV721KTBH>FIY24HA|%pXXLLqZ(@p>^TG^l;wS1yeNDl54|F6a3 zpzFv3@=7F#VCNQ3ucyZgz-ru)yRu10TLAqYFPhMXI;1nsp!{q?i z!xl2!zYB~ix@0{xoZ*N>t`8YHx9u-HG+_^1`ce>t!~J3rkbRMAZQZ+vmk$_g*~MA6 z^AjHYMv~{zx#$$ukay#(eaQZugRe{B)h~`KmUcpBZTc(|RZUcQu~x}Ql11H7JvYR?8(JXHrJ*#s zkby)sJxflw#1mGH>@Ri7j>nz!?VhYyDT7W6#%-HyY0I#bO@Zionb=COA%`~qpoujI zmQNv{o4T!rlnp+ENgt4`<0;~|j;wr%g;}KsE=|w{BUZY$@FffFmn0B7oqW0Hw390) zL!`1SCiAJytP$-!@Cp}A7{%3gjZSZMx|Mp?2RUCVq@6FH$x(qWTXI-qFuA4XoH_Eg z@{R~KBTxpn_2}Kx6qNxTxzvQIuU!dH=fl>TA1)< zfEskp6ylofNnAN}E1SsNKwYYQXZGy3a2%4BP03nlUHolRIYpz?6m&QhaJ@OAsOy_Ech(z-YsSR2v3XgKS80e9o zuD4wBNcqiZ{lgOkm{pbP=AZ}RPlELMt+jVJ0!)XVCSoHhx_YBPo)zTKo#BkN zRXZBNp|0bvD*#aXu$@5T6mRc{4c!@KRgyuHo$O`7znXG%aG6TQ$ZVuv@geXuK^$pq zhwf5T)Dfq8Rzf3sTjU3BtrX^PNe_Z}qS83bMdO~-xAaup2=q+M5~N_-f^a7&OLMD&BiWrv8|WI%1m4i>b9$ne ztQI)dS}#gQ*pb+xek<^28b8urEmF-EpO z%$W)xoZlwZv*$1aXhcV%I8}G+`vjD>SjBfl+i2}btW|+FeX@p#jKx(^ogXT@-$T8w zCq0{+k$nXqzR<&198({q)GZzd8sf6EUQdelFFpCczcnhz z8jtRnCk0!#8oP68_s{`Cw!G)9~s4PJQ{{|Wwpdi$pfBlBQQ zuN&@mdu7V(kBS6jV zV$AGn5*U_#O4+=t&`hQpZ3{hg@SCH^KX&t&nvcg5rL=|+qZhm?;r@_eZy+JuY_=pQ zLg|H8I(aKcIxoEt+Z7$N?73?8sXE4Sb@f&*%koF49?%0hi|7GwobOXe-uis(^j0=y z8EGZQxcoRoe?UsJ@9WpY%MdrKeh*0O^m~I=x-NYh9))OttdkLS(w+vKk z@|Z$iRX`mE)W*1`GqH(_R+L{n^09?^C&$ss$j&v&!87~x&|&pQWb$1yZeut;g$zA3 zBc5MHal4!hxrV1QzM|F$M{_AzfG8m2A@^ z1)8dF#y3%`=v!P*DQIC0P&L(v1Ox`Px+wqS{E$=54pzR`91Jl0P3;YTpM5Af!cgHi z5v=3r_b7Y32^6}-CbYt|>RS+U|mImeX zRC_Wqw{){c9`68WO-KLqcXGW)kQ6)x51}_Q2j$bVbziAuP-p<8m8&{-f3eM7A>k-T zw9;ev1dM&W-&C?V=3n#@*BGuHsF{?I-~;2R_>p(4Nj~#SB6*$Oz~Tt+EzO($^g~y4 z$^99xlT}d~oy)9=$8I!zCCziyB^qR+!J>8&-n|3vg-u@?X616-+y^NR`E~AFu7b$% z>~lM)P`)nRNG%4dzRRwxKSzIlur*Vo5E}lLn+s!};+qZ1?j^#%d)ZHU+N?`mk~C|{ z*;2SOP&2H%=ExB-mha{-HZW)$^a0-#s*&@cw{0hV3jZvB9~kPeUhhEqAz64~W@u}6 zzb9T_-SY|GkmTxnhk^(Ywv+<5;*hM6+44p7R=!uI8|qKVb>T0%|BX~}{w;~ED;K5*`V=K=<=saq?#DjiL( zrTP%QDyKCA>OzAy$JD2iO0HBPQZttp9f{=3#W0LjxpE&CUEQhZb^f3$040wamoFyR z@=i}TNpTBXz^sy+%RF8dZ1CdBHqn=zSaMQ$<4#HQs36X$TF#_by;z6Bmt;^WMkllrUFJo}niUSwe;l#3n5*m9SE*TYBHEGHTI?ygR8tL_n?g z=HAAUABy%A$TcSMD5gqLZi8^KX>e>Flm~{GIj7{k%XiRG0O=4L-plUhHQ}e|J6Y}n z!a77(CE7EAI)>_7P~kAz-=D85aTG-y|8vQ#S@)>s^%;@d$a9{a^ei4b*KwBxj_f5# zRr(?C-KhsP-_6NdrGz_oB}vQ;T7+ysY{FK7pd)YNTh+^(*Ls1<4?BR;NPFC`tHM8e zaCMbCPfkUd*koG1{g1G=3A+r&kHsQ=D60#vz@hcwFfeSmV8MpX8WpZS(`YHuaZXw! zUqXj56_OsBN&|k`slhZqUmdBNAwima+LAnj4_kQmaX)plgF`oCvG*p=3i&N^1c%qU zcZfq{%|OE#NPe>?7;$J{LAhzAC?3$fcvu4jS-Macn_NYZstt_jYB|rC2h&Mp+5qO6 zQT%qcA5`zkw@b$j`lzXZ$td6qzH$-Ca_*`5!hE*Uh5 zB5uU%dhgVkyQrs-@X3^ns8xgQTr}FhI%8F^M#J~{t+YpUudqBsng?v;5nn{B#dg6| z-kb@`0NV0d z!iTJ{6zg^+KBl)IyzQ&sOX%eso-A?|-{5j$W5bgZ?|RDT-Ow_fV=b=|=9r(CPskx> z*Ip0vD`&$7$!aCh*trn8%RcR!v37US$b?u+)Z5EK0%JVHdKRFNH%IfLEmU=A>4|M| z#iF3$T~W|{N8-ha>1TAC``fm)<8_-WILlubu-jTHLFIal9kpDp;2u7lxf@J5H;%TG z5{8B~qzJclm&Yae!iTJU(8P$uI25T9;)!86(R5%c>d!Fah@NG`m0?wklue6r(wXVn zEpu}R`)=Z(bG-YJ7LyM=?MgU#g~MSAtZ!%}VU!genVSX3nids%fT_;OLAbqxd3 zj#ZJlSc0|wH3m>7U#7L4{?s@4`IEIbypelLD;zNh(F^Kw*wcM-Sk&!H%Mg_EWy9PK zv)X;s$vT94JF5ufVFydR#r$}&{$=BTeIOOJmmxjfppGOA%3PrBEr4cDL3FpxEys4(te?g_V^I57Sfwd;mb-?_VW4HV7~(5Y=)-Eva29hWo262-bP?7}fwiKfZD8xXiw2cL}OcU0})dZ{1$s5>pnvuwF@5XwrFCu(TuZ zme--D>_CLFD%d~UWQ&YAgy?mcyTSqN{MOL(W_B)nQG5|IY;yzUb!i^>?vO#iC6{fL zbTfM4^b?>UBzS8!!zbq3BXf=6K*Ws<{uG5M-ulzG*iPd!8ARci(=v;-vud4&t8rGE zymnw5&z`h!vimv(2b*ZR z|B@6C_=<+!YIDtk*HZ>oxAwARrCaZYyFFR}TtiogQ7*DqKd~jKfTj}nh=5!hiBZ{W z*h(gX*)V&N|VwP$WjqL2wf zP&ZC)E=n{x43HBQ>gW(WK=+>*kC3)dLT-F3P*nX8OZ+?p8;jdp(7>bQyN zEt9}PEOzQaKlYUS4Sx{uJ<$CFo7?%_2t@h?(pq#fh{;L9FrK{j?i`oR+&En?-yTaF zpHbX7r0LjI)A!h@oN?>YbN?+P8~E%9fA~39m1=)R(z$z~B~U7eR;@Eq_$j+YQCo*~ zS*?fZBt}YlKhi7I?N3}5TQEPllk@nU-gupS%XP|% z@ji6wjxY+^|JOdM1jEK$R`+qN?-}|5hNP@C%n&GIBQp>E17C21Imty;OCVHj)oZ(G zJE>({6)7Td{%qIOmJ(X*kg;%F?E0=u(X~3hS=g@au3^v?(FOP*pa zmbWy^t2Pv@MehOJtZ7tyfhuJxog8U^wW2+}6VgU{D@b(>zxWLwFd9!ZsMco$yvd6X{wZ*Q^H56;v*$|BJtHCl&>jnfO z&&<{aZIeo3_CM3F&5l~9c{G4IT-trVEyZ%`geO-5$H!BT)rOHF(KK<;m04A*#oAWb zgB&^bPu&35p^kVGd^?8+lg!&YETmu@@5nWQI3wA)SxbWpqvVn!8s)Hgf|1or2P09w zGh_U&)aOD=_F&SnVP3(d6QhoLqvplOoiWQkoF(x~(jK0`QEE(7&S(6*0HBm++n95r z*{J!`U>kGyj2z}_Ap4a0j>dhef`*~>5ulK`WC2&bqEswI7p3$k?6-FVgwY>6c7LITfA_!h zNW;xYs|kT_yX;`{1v(d{3A$wSAlwq6vViixVA``1dEMb7+LL(3#BWI+qX4oEZqlSH z9vad-j?MnT;nn%lizzDmf`#L;pJ0^fOk8*28pTF85F0Wwy)B^aLMmxv;i1RtFP}&s zY;(YyZ1{#Erb2E$PP8~NXWTfHEH=3r@(1`ZIWJs`BfDskwjr6=1GAzxC(NU98opbR zvi6xz@VE@9Csd!j+svT&N;B2=zm?-PEqPrVxxzKMbW3vZC!=;)8A z<{hTx5@QOT?4P>PnSor|-Pe#;!Q^IaxHB_QxJcWvF9QY=v@U;X#J!`3upX$wtpy1$$p3uV+g9c_3w>HZ9m^Cz4`54|XPti0F== z)hpA>hXS}xd$*(2Y?8*fTp-6Ao7!iPBmbooB#*Eya;}rCEfadvql(pkV!brHI2uFc zVMtX_Wzga{il#JIL`wU#JvaoJxWsvs3%#%YD$Xk9ckB>9ON_o)xn+-ST1@ujflj&( z)$$}x2rs+;=yEekT@sxBtM2VE-&yyEszvi6UJ+RSJ$)#kWbr#W) z_*MC^?fFj|o1-X=Yx8)TC|inOmR0WjSlC}R`Mh&7`Sa0G)+C~;bsB5xKYKZ9<~@9v z$t4HF%&+|ERx)%C@5fX2C$8JhKwbz&+Nz7ET`cGBjauTkb3yzz1}cw{a1IWT7$er> z-`~$c<~{c>R7`$EuaV1|mH}3@9LKEE!hbKpx*=yX83^?{Ctq4`(+z9%zFUYDjeiRs z**4E~vlaeZYsjV%R@^q>dD>jy61UUk?y-8wm$Dl0V$ZWMLFhp6YpJ7o8tNZh?{;Y& zSZUp>FA?M_jIvlRhzm17XE~Er8Xg^G0|~bL=1SNq z759f9Cv>x$xuPvASSdAgpx%cvG{dTO%PUeWoi3Y~Ln*4C<;oR>vTK_Gk$(#`l1P8M z#CD-fAUN*B)dItD?t0K=1NHKokF$%!C5Ps(XDH@8!Z@MzMsGKzBNj86k%Y0{Hp-}} z_tC_Fz}hG~(i7sMMroqrrH!xn7OZj&@0uJljoi=mYUb>oe7PV|I4c=3;?cpBME*pN6CeBP*nI+541Z2Bw_0Qf+4>}O z(rI#eXt_;8%ew}?+~jkFj=bu)MExOZ!Oe9eooY?K_DVfW)y3e<5^HSf*H^t#a$CA3 zmlJa+_zl4)`?PiCwVcPJjTlZM^6`7-(^Jn^rdqxejdh(^Zs1!PMhC1f`bhWRyr!MW zAJpp-tl%r#>e+Zf2_-Eaxr@haj(QZqS`dHt*19M|7PzBBL7V|(7iM+YdOFA4@rQ&D zMaYaxf~Ag8`E9wsh7k~0-iaFe_{X{W>3^`VD|$wxK7LY(E990^p2|+JagMUtzz7oc zp3>@kQWklYRr|(JfatG3m;ZI5H6cbRwX}b9*?6i9*P13oyhQAm7vL!5f!nw>{FK9p1>%1OClC? zuo;o;^r@+i!IfiO*JVDhU%*Kaqa8$CJu66;I`vHaUDEl7#PAaaEHD2mlwu7Zf6lfq z9=8loBHPg^-BEJbDE|V-G;L{4*=3RiSqZx37^zr)Dq}9cPx0r6;BxG|3*>H+{zicaE{cY7kV25J$xka3YL2-ehE8G!!gxiB*0Y@RZ+Ln z?f|$DIKE6=_A|+1A`ma2F8*GvlbjV!j$g=lFEur`?o{VV%{s>X3}B5Cq%`Zef0%9J z>xNb}x98PWaH4*f4Udv{BDgyCTY1D8UI{@L-(N1Mt`}j7E6I?yjuqjueq3C15}o@S z;{zA6g-3&$!zn^rLeq%A!3PGjN-OY|H%J*U^K`SJ?RHJHnK~{xp%3UTsF$gjD;V%~ zr%vqt#jYJU8m>&QJxHY_6vZt?SkCf|_1*u4DqhGA`C}2V8TNbhP~EOH$(T8^;{Mz0 zza}MW(5qMB^a{UqN_KOFmH~bf)=qSbz!Ifgtgvg|hP?=;Sf1zk&|0S!En@ObQ7^Kb z>}I@O>(b~L`E!ZJe9YPM5{Z$lde=|Cc8g-Yev~GZaUQK>BBXzVN3famni~OoDDmAdquybiCO6zSI$KfYn_6}kI)RMt^cWSA+Z+1QL_yK;pwJHMhGQx!-q zUh$jjHhUrFb)9LnGQkW|`EsNeY;UvYQ6Rnv$$jUd zGDq2K?-7&Std!X9Xmm5`28|QZLvai7Xm(m3(UBb-9WWZQo0*$=_Y;ePQNjUEtw#83 zoKDb0x4n9(yyzOHY&Q_Un&B@BVDVkcSrm^JQjb&OafjG9J?8>N!uqdv>%-3~)cu2x z9;CChQ%f+C5Ny$bpyNP~7efkLFUb45lY=(<4+Q=2#CB+m8nstQ}Knh*$<7;Rgy_vk#hh^?XQfcR~9Me2MKr^HQDcMmnYopX`n zdWQEa2MY6M4UR2*A#o#>B1Bh0?bqLoIEl8`y+!7mjNu6%VW|TBY z>xvv2a=OE1lC}q$oAs7OSooD+>F&toHlZp+Rt$#duB5OtI^S@hA^3UT{Fei5i>dE+ zx>al-Cz`hqYnh}MA@#3B2Wyms?@16cD&nA7sFw6%6`k*Q??~B(4Em2N`amL`&h7jwjQ)I^Shg5Rk>f%_UD;wiv1eaxAYz4LyXwN4^>IL z+AY8J3Ig9J##E~XYw?3upabK&9oSa z8GRMZL{A=j+`oJ2a`%xVYH*WkF1_7=f=GK6z)c#8 znXazghDOnB(+nd>s?SA@&1$*fi0c1lcQ*Jaf9p5tJ$&5@yd)(#c9K4^S~Y+ij9`wn zWV&7~>ILGfX>R+f-tFtng?2P_7N0GA1D}Wf?7B|RaWg!bb+H`%NyS&QTxfIw{(yTD zc@ig71D|`$1L6~xxn-X^3@PNhUQ9Ckbi&^I! zZF;Hiuu}s53Z-ou0HE;4)HB`LNBolkFmk7~Q(T>{Sfh54A?dkI!|Z^lZq|F%|A~04 z{4QE_k2a|6D`@+fm zcONpA=w_T()3*=8d=sCOo|%0Nc$Ni$l&le(q-%QpFkcGhZ>y(bz`?=q^P`)t(GtL% z=OgfScQid+wgUbK7AJ2_tq@K*W~rM2)!9=-(eopnHk`D&UtnKsX^sD|1j+oLmLS=g z8UB0ik&%Fbk(uFtKL5WhNG6v5z1+GLR9;(al_tUx0*zVx@aEss-|SB|7tQ?d1qml0 zWDhTE53XM)ki3m6mH5|n=CxPN+17dahG#U1#k#6OMkv2#n8*OM9$-SSPaX|U)kVNB zDS`}~%P%`SGC4aNIXXlX8>AWh2exqj3@BTNAE9oq7p5r7|6~qbdIRUfuoMXJpFH*& z5JwvTPFDbqSHQ&ufSjwd?-xTb3lwnS#D?IHAJiXyL?Ez^ym@f}9G+|e)|R@RXC6e_Cr&2#DveT7;*87WuOOtF`Xz z=}VP0{Yl~EMs^O|E0C|;7bY-bucxm*@>2 z(iYhLi&iC||L2k~qRzqj?;>DembO3Cf^TLQzuB)oD?f!_Xm)nCoF6oR6A%Cowe|WB zMD6uC#Fx_eJ@}WRe{C!A5TgFKBFG&2Us$hqp+^@6S74yLnHqk*Ti-uFT7rjr0P6nK z`2f&)unCYZQGa_6DJefwvB(BOl;e>ZQHhXcHh3;J?yb>{rd3r>*}id9s5nE$}5O!iTqAD ztBL$6NJMiILb{QJ!0$ysZ+|$JK)=Pc(f^{4F75eQq5nN*6pIJiSp6x9 zA;Q#(hn$tc2Wx8lveNnPclkC*=ZAt*4QuuPZdC`OV=Q>nZ^yLM>h^2n(bZGGS46)J z;r{U{gj+>1dV(DKPmJ~P^z?C#Iisj=f;-SQ9;0p}i05b9;6KwN6WIGch&%NRrUATz z#D{UdHxLK@2&P$A)=%IMG<2uI@sAW95C`lZr-_%|)QdTscf{!@!p|DyA4y^$gNDzz z$3!&T+n&cxM&JO2YR05*!r%+?McK&bV}zg9E}`YWm@HqAyWYS=)zd$~T&r!s*3CaC z9zfQA{RS~1YQI!aW@M#zQ+>Z>e-gnD1xa3Hr{n#~^hf)TUmY0(e=1CDV|(U)7}7q- zH6*<>QvJaFq_6bT9Xku3;{Yc|beMlZM^Wx?iXT1=L7hRrVLhPt?;RmOQICsKezM+0 z$T>=@Sa0>|J*9EZziaYefvxp~PI~-*v~grLPEu+9`pv(a7JN&7KO{nc@cRSIVH=QS z^N>0+;+HdNB3iELHjGJB*fu=N;OMqtr){d;Y7zvQRm~u(xb>yIaW4C{x0CaF(Dcdt z9>2F#!|=AV3g;Ye9t<-6a@TDIatOxmycF!Vh}kew(?CZxzsAlKB*oe8dc9Jt-bAu- zD^!2hEIruUZF(K@S$fF=B>K%-*j;HnQf3KdD71`RjG{rJiY*-J>&>936aLZ_Qblu7 z5~MApYN&AK`tc>vQZVJc5ezz_d*W6)`L<@?X;Uv8JD(BdQ?L+`h4c(!r~iEdY|5&W zr9FIWw{CLY%#rCzePai4o2G+Dxx}#+pcG=m+n!dt;%b?ntd75dLFIXEgmt8-{@%PD zUQGW5UsFHChJ&d+^+X`mzG6$?Ht$)qVPTUhQcuOC^#PYQJlpbxKf8M7qkq!K!nHW! zh!2?eW?f}!Tsy1KAX}!DFglp-qcXO_YU(6Q6V3?K1i=rvm<6Tj>@(7H{uuo6Hz%OE z#CN9gkes}0@Xy}zC#=JD4L%H~965Omvh(5#ud(P_Ojdi$nVyZcB7MEV7tz#m*XffraGF(!W!yt{sby`F1R$8cZpL^Rz8P&oa8&KYmCsTF>CjL^KV z0zAtTq^$7By=)$yQViV=QZ%*rv?(LIDUu3>Q&PZh3j_d+Y*~rEyyb%hD9*=t${o~3 ze&^dJ6!I9iBeuFSF$EGyhincHeM>lB3K1wN$)&cH>yADidvH*1T$gA7UhzG23#3A# zl&8)!W%p)(Ar~O{Xr8lM)InwImmcsUcIFBwdX64h`hUpo6iXu81khNR37V-)%KxQy z>PJ$=H7haJx5jv9RT|U`>xLDn+Z>3M2v|eQ$@5}WLQVB9kEoa?Pm)FMC((?N59|77 zW4O~sZb(FT$SaYMae$LR)&>#XxS9$>o6(7pKriLp=HI^aGE?_Gwwd=})47|qTI0rb zlhMkFbGRciILvwzFX6>=-*D}Go91@_inCYkgKp1g>Z+S?s2x_LR z;3l>@`T(YSdQwxvHVP6mGdl4e>$#hgmvlse7i`LX@G6CMa+-|Ki4yYL937xDGJ?7* zW@mrrp>1=#blNJpkm@4}oWHv`%sXO7Rq58q2{vg^^aYr(Nmwb20830w@orjf+M`{9v^V5rPgiSd!)EDF>R z&dyl>_Wh}@OdyXi*s2Y>ePOeAW_mBq#R`$KFo^{u4IdYX7iqjU?L#T!G|&zz7DYFN z%~~z7Gt*OgXQVQBh1|hP*kMYX4L0FLEdpY5h81r^+pf$hb=o8VGKHx z{)OT0PeWV8;9f>0z6^sGfcIP1&vrro;*!sgL86?G;d6)*=E6cRcqPMks$v7)=(F}z z+B18yC@~_F56bRn9kJN95D?8yR`V+Ebbd$00x7MPxU z@FRo?47N+yvhZj(v$LKAFUO?i#MMg1j)uz(^F>oGC-5<6a;!$Olr`62+1ogGd)dNz z^81zQhRYC|&M@BDv$Bkn9pXUK1QcrJe8XRcBClQSC&Uq}+5GEZk2=Mkl=c`Xir+E< zNa)Tgn`>og{FhCXiNPFjGxRB4f42SSvn-REt(?p`xFcI}Ms9SQ>9E#R?&Ee^`Nm4; zIp~?yRF8*`JmCp6;P&vxb27Vp2S?vY^Y&L$Hvzv~sUy{akdIx+4<5;+z1>`}_mKfj z5C9>u$+nSz3h|K)uGg5?5F7gXy02Sun{%y7FPm{FRA2&5D19h-_>t{12?Nx}Tz&IH zRU`8XLH%~{lg)hKuryTsT#SgI>@S<7Yn&wAJH-Q0qsg?(t_bDo0GySEyW;(2uuk2< zd#m$fTU0$Uo&xt`wOq-aN9<(BcxHh0)5yN+a2eB+4i`i)v`0;H^j`>omHpn$**VPA zNpq}(T-R`KnUb;EgdQYw%l$*@bRsyRb6Ci_HwH6`7G_EE?;e%JuDR)^Rz-R975GmB zMLRo{x%4J;W-Wpak-1h4mLxt_>&82GtLdsfVI}r`NGkN#vqGI!O}1Z9QqIgCerYF0 zPsE^~>$G{O;B9<XqS(cck_UCNNDJO;+9&npC#!JzV)ql+^?%Pp7s!CtgfNE zD}(h|zGorwUQ}c~9$YB&My9h!%LMsN@{r-3oda@WeXfUeSd6Kpr%9%fg0mBtWYPYA z*V#o%!62f#=(Ts1hXU+NoE!ki+@UXlCO&NzAm&+U2Hus*5)(LSSD_jnF*8@%yA=c_ z`BQ?IF$NPSH*|WhheCib_GjU!*re_KA|~kz$de^P;~BmcRT9r^;?&+1(nS_9x&d7hxiKoteQ%6xdu#v$B&>DM<}`AMQsI?Nf{Qr>WTP!X5#(d zQ=d-8n1)fXKbb_br9mN@ZoW3SvEpsJrgAzFBw^8gSHh>vkvg`6z&s*_Yw1bDH|_4F zd~ab+My-}xMdS^?r#R^n)b!>wVfMsWb*7-Z7pBS%O`AW(Ws9(%0$|Kv$=oaf{o*tB z)wmXg8>j?#+dyHrmuOj>2oErA-H-)$(CeXmqptL1yw~SHv1s};0^#UDcCo9GPEqJdo7b4N zdCfKStar-0xRB*J(#n2Ko96>*34$^6wvlY9FK~bmbMC@AzK>N?>%;s&7co~V5rg$< zUU*k_QAKAw#v+CL!{$08hHh_ano(nfp^H>3UhunOy>bv!Bci`Box{uER5$I8>95~f zlvn8u*rQEV4yA`0mJfdoVYRPY00#wZ1!8a}YJ5sD=t7jMZOafzYzr zT7;sp9Z!YnOQz59-WAb}?|5Tgh-ptX`NkSW&MuSfC;5(#E)pGR#R+*PzsXgy_a zOhWt+0WG{LGtNKmeE3zJdMS%K(#^g$XM=}6p+lCKuc?IJdFhU(-OS^O9svpr)+#kG zqF}KbGsZ_vN5|QG*M+dLs+NAbe;^}HNK+N<+TW*VdLgWCqb=x3hE_xwQYqu3IWhLP zp>rBesnCA?I-J`E15j0Zenada#E!YHLie6tV8rHeFr1gEFVdk(Xrve~U^kBU$L=88 z<1k-2=)bYOnJ(VlY}Fw=lld9f6I{I9f1YE=bsK7vo~bdTeRE$1s!ZCnqk}_VuXtP> z>AJu0YCd?w_~xgBKsFv0*^A)5fWw%uCF6G6XsP-*DAF7EEX>Z>TO74KBaN+n)sv~- zAJTEcJa2S`Qmw@a*QhUF$NuZ0nS>_|th8I?Zv{ORb-MNTCBEQagr*-$nCkAEA1OLa z?A+Dj@>^|Ni|5SGqG1q+(da8h*Gj7oH(O;KQk?qVXafT@?~Q9CJHr@owNc+@Uxr@yW6uL_VR7HO-?U; zHk{(!VdlFd)K~<|!6N4eO;mEVrE=rFpS4+&*o2;>U4ueCHBd(hY{-)LPT!7C#wy74 zbnPfKcsSz@z?QWufcE0&T_eBZoESr%OpkZ-h{4x$gag&20oa%FTmjw1CRY%4l1aO8 z$e@Em+lVB1*^i$$Iwu;_I5~YL1x4t$aEQ%!N}-{sphF1puK#EBDld^Bwt_&gv~J+$ zD!-??>pSNMDe%T>Pd(O{DmYA%&-NmPEKiz?t1vpp}#W;8$8pH?d^Hj+p$A2)T3EI=BF>?}3`LXhP zH&ocdqvMvZQXZ4H~IdBDJ4`LxPip<_SYqVq$2I}m`=0_7W^Z20kv z#J|de{@%bv_9rcrq@28=&7rotWh)UoHI6?E*CIrVH9OE}y5Pr?eaLl7^!g~-b7eN* zWrU9`eSFb4fm!l_AN8@z$NF=aTtxHk z`lVg7VgPq&5Z4<(T^(=rYxX#+^VQM&?^E3F$V*H{We+O@;npe0JHDpFsYDY;N1=`c z#w9=DDD+$6?StN#{z;DzUMCDXei+3AQmWkRUCOn>*)F%H@^DqX@)I}ZQNBd~cI zUu#MkA(p8t730Z8%xJxip$@sWh@$Ib9oCA@x6;vy!;WQ*ti+joP$g1zcl)OU+)%b} z?M!o@HnmA?Hba18w2AJom1)ICrOp1U0gB`fwpFg``@IYkgX>%*oK^#pFL*o|@R09Q zW)WG=8~nhG*+XJrpV>yPAQ)Uply0taqboFcGD?I$0zg& z^4D^iAlDA6aDc#D+Y&;QWLv3N-a!5K$_St`h^J5Xow9m5uG;+t<4d!+d4vVDukK(g zhY-9g9dBpm{OSwSAK&i7a7x#1a4*~kX&hnn&McMm`F#FE4#Q)Ipw84wVKXy5_i*1E zyEmMr5-+NsCDWQPVQl)wk@8xMkBQRjgJ#7F(z)20K*ayRic__Tm&!Mnu<2^!;wGTY zsqzILncD^z@A{rN1%L8&{llfGD^0j=#pAJrILmx)`1iM{qa?-=^m@Rj*Q+r(tFph= zmPQ6c!(nGZ%1sahxzUvE0KE@|1Y$yTgnL6Ajwr6a8hxc`IzW3vL$sbaxwH;eoTs!( z5A}qj$68{lMPRUFdF)uO5ZdjayW>IEf{q$Dti#wk1h=-$^BBWx#9|YD=1Wb$hmFzr znr^GmX;T^-s%%VdiJR}m%jI`k8rL+XXYZ_reGUa;>`bWDw>CqcWZMlrelhjrFtm^A z*;P-g%i1@J{g0l|-j;a2i?72m*yqd%Vcd&cE3E$Z7#hmA_wZG-!0H8;}q zChIqJK4Ec2$=u?)V=1$r=`~LL6@4n|%H||F( z$~Zmn%I!puP@j|n2MSyPM+ERYTlGt}E`AQiop+0bD<`W|$!Msk8bhyh!`GPB+(f%Z z5Z1^SC+$i{?9GMDEAe{!T7VSBcm^^Z{x0#zW%nc;Q8}w;YlWZ-<}1Y!jCaaTvWkHM ztp0N*FwC)uprgjGiG?{X<;1Z_XS-;Cc7*dqS7gL%i(~r|_+3|WBGk^bhnxg78e?A{ z$4XIM z0lDaEFRoE&)uxP@?Vb`v%*}b^bf4UZGWn8Y<>N69+HSLh%k3{O{J^wo5)JVBx zH!4zk9gf|jKxR*OyXr=bN*7B)b~lTJ%&>^)X*rsnWEL}K2mxr~!j#S0FO>TpE2V5u zev%8PbWnt?C10bosfvJKn^>7d5_2oNiC2J|#A%XSkfCOJMOsPPwX~;*bMzM} zZ#Zc|BGaEN0V3?T2Ud23=sRl4m|BU2X~iCVcbz2o`l+vkAex^~-|`_}y9&nGYgFPw zroX(ijE+!|{!a6yv7D<`tEn3QP;g>f&JRd}O!a!Wv*meLrOKt{7Mf@-RS?wfiz)~7 zhE3-iRFoJctJ$(^Nle7mM5}5dHJSiRr2GJexXIAwTH@b$ zBUYuFC;bKEW+ZB&ZbTqcB}=O{^>xCT{fT$f#x#=aVzcH)Vm?IVoX}wPs>Zl|ws^dU zGsDzm_H_B?PpS}v?|PLeKoV$F2|-}1i|wk?0b0({)@t=S^Y2w>0QE$BgxvlRt~&2C z4tWkiA;`F|AdfHhQkt!_aGElf!hNPT20H)9Z!p1AIW;4nB+=M65ZljNS_!Z<|3mFA z>qRXAWDi4s=k5M0(K6yeQO$sx12;Su^ z*6bWNXoG*u;RxZ9)}I9{$ue#YvdlP-s2b`Z{cgZTLA6m%s51B9qe*#Ma<`$;+x7WN zQ?Z9wkh`g*P|KhXuTU`G@+{cYA3B0u61@4`WLPy#bi57+^2k)8!09mH^ z?PV)$v*(k!TZoOPU^1sHAzP%UfOYp+A}i*zYGd2Lj*RBP(RQ!i>#-cW?Cz5bmbw4u zUe3bO?5R17;mDZNqD|+|TB+>1P$e1l>i&{yL6Z0Z zXMMFDMdLN0h87vbwe4)!NDmnVrm(DtR)*cB5jAWSn&3_gLI|C^nNxUOKvzh93vR^ z2-0tSq{d76O#S8QKSHn`56;iusRQ0-`3VcFp#2>mfFnhVx{=Bochd_kj4{UC>7tj` zWF7$v?-jn9lSC{_^D9L-Ev4Bh^i;(D7Y*M(3qAZ$KmK7EcILiF5luEl+6q`=Rd_7Q zQc8@$-?TK)i5}BRPJKb&mJieVzHX5>WrC~Ku1R(zdQk_$q<;e+;L0=Rg6C2}83f|R z3yxYdXf$9|T=DslBK~eQgg8+g(F#;)K1eU7HFtJpKQ=~@*p)p-P@W1F;6wiH)~EIo z%8qMeEY3|oChN7XnpQHy^7`nA?pCnM1-1KNfr@HldX;WUo2CJkKHa?~n316Q%CIlb zi^TDpdi~4x;ykTZaOWN?z5R&l*~n51J(UkdUb;iFOJg!-2@GbH=8!n0eSpi1@i{77 z#YB!FZ9<M==xpXG4ZGWzEaKe6UZt_X9=Nc)ssM40yu13wLqwGJP zZD_la-*V9SZeEVblr58$e-wZ^ z;A-o}t8SKf^qZ{uyLU`!rNpptK0awttN)rbt;}$X@ENz})}*Nho&lM7+jy*iONdUv zTroh4C}f0L9IQyni+Z`%hM)0%#MOItq%ry5zMnt~r=|EmAHW+{l!O;+>02Hro0o*G z25vwLWnZS~U)SA23brS(_+j4j2uR6(`I=8=pG@*Vx9uQY0475aQsrUdSb$HT#U4^u zljzj+)*|$SZ_meh1=(pPZf*|vHPB~g&NcgUOUllY@6HvuqJ-6246HKhulEjU4S57p zLraAXWPLdpp%*Uv1>vMb5KN5Hu?Zz*1~LsmQ0oozClzWl5}4fR5{14;^-G~OxOhM) zJqh`h3C->K)jvXcY>*z8^^?@|5)a+s879qH2rbBnXMt|7^^_yOB%;%EFA|%#0ljI_ zx(}zv>DF;IH}F~W&wZKxtgyY9r6DTq!c2uN6St*jy8q%5KbLqSURi>u%+rKG2!mbm zaabg;SPyL+4+ZuFR!Q6IHFlJpQcuWoaYb%ByIbnwr93H35&W`krcFG?8Vp}@jULTC zy4?-3T~<;-_uoV+oHd}X#FB6toq<+#sT6pHZ8~@S5BKGzv)-$^WWiS}Bw}l!OQ(&o zCX-3Cfw^?qF4%q+yoYWvg`W7k#v>J)izQq&_yAA^W7KhQV9;;jI0|P?b1xm64QlwW_Zj z8NYlVpt@o%ajNP^kydkI?H)d97jR{Exnf10xHP;WFV(52CerwJW6VodeT*er1O#o$ zBJS-t6d3l~MX(dhY{pH0r+hZ@8`6=apFuFB0e>7NLLQma=L~mr>Pi*KMc2@3-aI)M zk@Ala;O_5)EGY3LP9B)@%K2#E(dXk&NAve#PMjefqEYplkGgiYyyT~KJ%M4M7KMug zf=tC!=`*{bn|bpcT!_vi2uIMIk%W3AHDhLHQp}HVtS8ml$xMx#x5$HQ89Som@oMZg z?)GTE@i6j(9#5doU{#c!_LqUN)}&SS%96&fm0OL}Ig+wS4HI6^VPtIt6Z`Q8>NV8c zcq}eFOfGJ_ZDM17_d!SSL$xTc~{V7y|k8)ACOKxJ4<@xvw zVMaaWBG#3xI8~{af@euvJjO=gzgTVqjme@$@OZxA_1>c^XwVdMm`=u@H7KSb?H>Vc zs+!?(S07S@X`Iz4E90EkY@5whG&N3hkc?XzyF$n$)*MK&Wux%-z1~KMzj@lUthT{X zA;6$vas5tAtVGo3=^i=I4qKX=?A9(Mn9V+;HnIH(tx1ervd?#TKwFhUd;sftqDMP zOvwif79b@C^d}WS?LysgAX6}ll~IR`-e?fAXKt{cOH+u&l@`Y78Iag~Kw>A8x&AWL zAU|Pk{_fI=dTgy66R+bztWtbS1Fw{v*NzVkwnsta^jv~EQGt>ro2{j#_w4z!e)dWE zWMb3D2sV%JA;?CmrlHZJH#@<4)Qu#+EYl{}gZPa)r z=&l0Q5OHAI9J^YeDY7~lIwl(2%*$3c8@dC#hu6mM#%KB6xxIkG>}zHfd$Qa5^k=M4 zz}!`qET|XGRrWMB)4N6yhfue*((b`IDfSR&1-~aBU6hvlk8Ig-+OX%^%7K2Z$wLOF z(@Bm^9Jvi_R5gfUb1bJskorN>tncXr4OO-uh|$GihOKCjclP|E50^C;zeN5AL^1y4 z+w%8t%N(7g|jgzdbwx5Yh-lzWQOJCfF4;(0~O ze!vIlK3bnk8f%b9!jcTZy5Oql7OLl0!eoNDWB`7T`h?!}Q%BGS&i*T*d6I|!(_uO+ zsn5No&vYaX3%VfDYHi_q5LzGj18*%cLpT9eaKE>~w#HoNOu^6=ir3*FT2hgkv{plY zytPxd2_J<=!bZ7S;1lpP1FePvsIqSg(LQ(5m#g8>&;aGlEt%0-mtvLi8ZOOCSoK4v z%J5=Qn3K8XxGop0)<&(698ImZ)|%q{C@x>H7^3P(5+F(oXHPK;&Godgx%JR#k7#rf z={7BAPXN3rZc|~U;L6f3I{8|8PI_Qy^$(0ROfwFgOQl*xbb6-v(~*uxS{9w+L%v3; znbb%SA41T-5_9?i>Dd&6hG&7e`E>_VpwK@Ad<>#kCQ2}WYIVC`nOZnte>-PBC9d5< zY}>A`*T{SKh2~Z3qQkm;p>%F6A=?@YW!EqK?fG@PJoD=|J-DY#o~Jcew%|N)i&u*B zeG76!gO3wrEjc6V%pn5LGTA@LJ$(Bnv zQ7z6-LF>|!GWg2iCVQGlVR~0uy_ch&TkqI==s!O-zn8i=Ww9r^2iO;(c9Q~qGWDJK zOKj-SqFfIToep8OUxV5WUj=2GnS4S7#wh51S&ir=k4tq_gt&4-dHTx-x3-+mai5-K z@d1quRfd+BK|O4YG!hjV@e%e|(Uy8{1cC3Gwm~^>5Jq;?m)`gBa$@LL*tuWl5>MJ~ zqw~RKuuhCI!MFxiP&rD3ud;WeLscG{04(DuIIqc8686Rw1?!(Y(=0mL>Yk~APT?g% zr<&U#BwYGri**i;A)mtg1qaWrMwdwWE4uvF+r$buRzt>*h5(A@lvJmSG}SdlWu}XN zV5j(@fE6pIUH-8bRcbNmL=EE+j$Wzm9-TkyU=91oMKgZn-i( zdRcgDvgM{3ZQLvQM~doc-)9srllw~9bp(5Bly@g90%W+GYu>djs5A5iZo8j`$Ne0! z?^Ai<=zIq&gU}ObaC*ffh~cK_*zQ-6dRy~+VH2QM1V(snIQZs_Q zZvIz163Gd!(RdBrFkUo7;?SwhI@=TWVGDH=nkLm7H1hd3EmT#KjswGK(W)>&Sn*Q) z;phpH)T%)gWCAo_r7W1Fe3MSp+bzTH?IoUj==VM-s=Z?eTBNT}=o7?_7yUhquNGjY zprOtcBo=F9 zq*{zaFKi?9))E9pLz^$f!G2+g+CNC)q~T~Amhu;zO^WZ0XFjw0zc=jR>){pl>&DYa zy2lTjhJ2YaOopqW<1>rb8uf1Y?csxV|W3bE?PlVw;+ZwsG5_qE#l)Y;vm8W-eN z;)sT&&F`YAs}q@${=PpKX){Je@)a(6i5s338dw+jiE<@TwKN&t@N$Vdoe8Q5@Z?(I zeOK$Xf&hU{g#LKA?b{6d?FD}lM*y=akI(_)m#2Tc)S0Uk&M~ z|BCQ7c8Zj6NBf6b=F>>A<{2w}uZ)qSY%&JS_svS_(oR5`r;5Bx=*NbXgY!vC0H<^m z972EMU$Z!neXHzv3g84PI6^4-BkdVT(6hZrm!QrP0&Ondzt8!teUkN|878Z^n>@Nd zSDhMnMij;|y0viuHLX-;1}cmg4g2PQP8RA+65j&8Hf*&9KbuhlMn&#q;{w34&WcJh zhT4=n%XX%u%70DGG1u0?@I??+OLMnT&G|I`>Cgu2dBC1|7!7(m*9ke2)`oXufU%=) zX)=KJ)fVY^A{pF`RJ!V7$Y&1bvB+iXdj?_sMVJai1j>nt{Q@6a*o)Krt0(Jy0aD(2 z6D-9TO^ii9)V(j*Q-;MhV5_Y6HhoIfO-na1y8WvI8Lyt`v(K!aCeG?JeK)Kdm;o;! zr;Z_ccC1AWO{W+|4=t}H{3L{WYi8PgYCg!Sv;p;dgR(ZTZ~5i|e&AmzB_Gwkj9M-M z*e^_lr9qvf)tlQMMQ3`vbJGGZ9)ys#IRyn$M7TRKrJZ&~$HX{n*K0Ca_5qIR7!q$M zgN(VJ-3_p2sU3P&@bYkZwXKz1UmRY?^yw{C-X#fveatLx85(T&w9yX-?bl^@>le2g>BM8U*fGmXJ#=Og z^Z6n%$yCT>F>k>|w>nGtZ8H?P5`N?5HBx)FSDCtg;)K~_?tZkiyvtHG zJ$B{!*>UJ_!>w{b_>H1H2HV~Ylt4$Gd9S;oAiX;JOZPj!J=PdnErA5gqW`lXe z*9vONQrdj=F3_pEp#io zh;rX;2^o~LG_y(LW-k$daA*U3_mMCHMP?D1XLFa)VB|zhOTM0i{Si?+19JX*+sEUWOOYGNO?$>X2zIIXz#GJrZZRCl)BAEDjf3}~CM+&Fu zlsK^1G+`79p1Zz7y?Y6c5M;ei9s+|GQMUMo*P6U2tlE>fl8VZkwMf?Ud6?`n+;I%)%NW?~PJ1 z?HAt$tC_t17pENs8yaDh-Hk*mOi?_1e`kS0%T`H_)9bOd!Vs{hzrK;9S*>I`?kR43 zT`EiPydt(-_AksxRB}c!TooUz#mkzguQQ3`%UpiK(Lk3*m^!_l1#-Qc-u#K%$SG7GgyY0!nmY(*?` z*BwLKy%C7XK(v?C=VoEi+CjXq0xO8iCOj_3GJ>%PMY7PJ(f6t1{TzsOaH683o@MlQ z$G2_Qkm1617fW6ot*ALnG6Lw9=g9YHGK<8d*XGaB(2lX{WTklOY4)9RZM52P&kgz~ zl?@Bj$cnR3Xn$-QiUewM+@$hTIL(Ww!Z)~H;A$0mn8-oyCLi2VM?*Oi1maOp+B~`EzKt`=({^IRb0`Xw1)3!+WHe8XY`1?v3U<0nhJ!`ZEnjU!mEW^H7Ey2!GZU{`hNUVdiL}kIwLH^DWh4Wj9^IQ4JRPaH)g6}?FH$NLE zl`hksD;Y0sAKkeh?c3~hacnNFCf2*^NZ?#>eM1xQD4+r=D;QvbLZ6#NNQA(!Q4DB% zU~jUrz4?d^PGS9qMn4nZlkgxCf1Mo-z{chA5kSk`xqv<10y;&EI{S@?km3=+P`*-0 zH|61|AfJQRftK0=XzZ~Dv;B{-H-|>xE&s#`slBZrkJ?TFAEKk9AAh1EBs+w*3Rm?p z{pG_PgNGIwGPDBZYd2ri*Rc>=1G5d3f;LD5Yb{S6kq{S;4ZuOM86Tb(*YvwamuA9&%< z6ORlzW_G8ik+Ax+cisFPl{mxM&zF7NzbluJAzlLCzFe9^`mL?~;tUS<`U@a~+C7Dm zkG`LU%Amdr8iI)Y1BsBNG{wN69Kc07tFAnJDOa8x0zR4Vzts!g5pSIWI)H4HNrgcE zHX|)Y_0Hg5LIaa*@(}_1{%qVTM);>p!9?IZjn~UxQ2f`*aru0dj%7wstg44 z?=KbY6>KmM%=2>tepjqynZ!Uq`>N1dr2ncgoat$q`Q~Ki^8cB9!iyE50~`G&^v?_g z6J9PQ-2Smk`+48XXC^1OZ8NbW6x2K0CH;0*z- z`gPz4edky33__gmeeS56f?*8-W2a>=^e`fyR|7qTu9}M=FF*SUA2D`q+XZq98zRZK z@;<&mf`@A(o%UE$scZ4(3*cN+@qIH3D;2)|k@iSq-#q5*cm)gbH{j%~MFh4SqLM~B z9f``%gCG1r3=H7gWa0ur2N8?G1ZoWFK>pk=VTzZW0T-uH^-2DYgHelw+ynn1{V4!6 zg=OMKTKLuaTOR7)6KabRZ6jF)hG?}mxu=QRXkM5$!DVBvJf|I^O*9MhK&I{l>SRJD zVsVBP(9oJpUFlLBsc@d%1Nc7DANL1vd%lVhTlc1oKdh#g~1^77W$|Q><=zYc{3LFMJ%+SqUzG(osFg^Z!n4OE8&-nh8 z_NVJ6J>RO$)MpP7Yy`eGP_*&ztqflxOI7CTxHJ_8?5Cm|*(hXZ>Bf1y6CA|G^(7>K zs@~~V4eAI6ii_6BSlIBEAG^S~Fr{F3W9h}O!J7Bdp+Ad0aE5#Wn{;1|k01-zVCJjs^p!FlW_#VA}Ke{&`5TM0XWL=Z4v%tDyqgFUj!2p299hFnt zwEym7)#jh)q%bi(=j0@m(MAzfW4ztQ0TSEatUb`zOhLDB5+sD4Mct>I#)FqKPNc+4 zFHuTzCU<s>gK^)pAuA@gEWd!^D#l_N{AgQ6h zZ$Mp{>7(SH4tBHJ2RI; zz3TVI3B-o+zj7Zz-TAj`*s{5IpeG=G~~n`cw=1L`uHER{cW*`fiAoe*=`!C zpyeg*P#q(yDf&09_cD>hD!SZ*8c^o}9-a_3FtHZa+_%>?>wwDLefKd37(=ErkxuYlKn^`#cUog$9S$k zQ8^~}IEK7Hh7fn`(RYSZ+!|e@2LH8(Xw9x)^WEs%fTAUD+$vtLLujKixNOhg8!wrRY(Hf<_fw>KN%?Jf0Sup{-Auhe8-*naECSjZ;g&`m5icr(QC7k| zz?AAU`FeDE{p%>7CWCbDVxPfH@URYJI{sp7)4u^_axi*5J1Ax^l6l7eYhsF4rNJ!H z#N16qB%%%Mbi>om%9S(JS7U}jliPtUg(Jr;{wN33Q(+%&wFN4|aA+XVJwMpwH>V5N z<~}aVkoKCJg(Z|BWQ`K|uz``jR)1UU5<{F(GNBAMUg*3BXRcYcTB(4OmvQ_IX86~* zMBSK;6B}0^KZ3K7aAD2m{ZZb)I+@^1W|lN}igpYzro9r!wtb3wUZf*og~5}GR(A`0 zvGqCal7Uf`RH>}+x(kekQ9u}u4fO;9eV&{c)`Cj?J58g`Y2>AVuBfQ(kPi~l4Mc0@ zmWh;GoJF@lM?cUg;p%1S(=IYV}w1-p8`sch^Q_NG?zrM<5VX7&!dkQ zMwaZsXkf$_+V`@_bNupVG%6R3XLec?=f^bFr38|e9;xJ4fn1VYFLGVAPNE>xo}cuF z;AJGMSu!knZ5;Fa(&Rq)J#X>C`%(rYHqSdcPjxPxBnQqet9hHtbid;d3Zq{abo`D5 zCsD1N5~ht~zC$yH=Vxg%BwYqSK9w&hLB7z+Zt*AgxFGt_|jJZ5Zd69i5H zSvkzI8r%M?9Q4Tb`ah4LDDpC7d>&Tf*^P|$19w}ZvP&tuLn%X)!wa(P04|p2r8p)> zwW@W_$lC+`W|Y7YBjY~|2f$czgjcW=4`S%Zo`h3MpZ{aQie_~FkH zSaBTg%v@D1ez^c};r4D#*v<^oh{(~4H9SoGa=>H+vc3Q;ExhrYFFwX;4~q?l2*!Wj z3kOV?$f!686+Ww<7s5)iuXnKiMP@&*Z+%$dQHqvMn>zTeXzTP=B_k%{G1aR_A>M;CIa}t`KO#)Q6joEr*3MdRE%E)tOLkG$>DxAY#BV{tB4h}38CP5K(`lcc za8DB0HBD8S=#YpR*|BDw`0%dyPWaJDd^fe(A`799KMJAaU}*iPJ=<>xx93{%$|;Y{ za?g*%bROhYN+qP}n_AcAC%eHOXwr#8TbTXMv<~!)a_XoVmlU(;&%aXJ*BmT)fBtID; z(}=8OQfu{0qJ)5VD=rPYeMVaU%|U{{QB+U%9~^`6_;2~@Wa{M8rP1GYxTmtrncGU)#7)zrrOYY-Q4)I z@G);EYhP`!2@A*MdhM(cj~28nQqtru)h> zz2SqOs*y)XxsZ$l*$_=#b(oS$VH^Cwj%C4y&k+@^PtOQKg|%WpNwRm)LGCpbZ|L!1 z)pkFQR$v(_kJi3VGJPq>1I~qkM1(E@%UMGVwQ9QLw#cWcE*#>MC0rr7E9-B*$5vLp z=dYtR5!bf&!^w`U-tJy*BEA3Fs7gC0%_#C-@nnZ1H66UDTXi|%^bATisCZSxiyW@$ zY22eojqao?smZ#|=rYl0!c0{h6%i%!6Hgs=?0k*q5I?9vWpg=jh5jkHAY7yg*!=J6 zJ7Msp{Ct727MH2|HEREg2a1@^Vw<9&bJcN*!Lw7!V7s&Yd5p`=rXDpsr-7r;?`Lw` zK-qfGSF#)?mUdTVKr|2B7oH+(3I|CQ22sbl&HD-VCWt&P(Q5Wx;uPq?r}~z)h2~yL zzY8Nc{`J@LbRIL? z8Fx9vfzz7J4{CoRYYh%i@dDA{HF5vh&dkmyomfw;Q)6o~jiuFMr)4``Bwo1AcxUyq zlus}dx0p**GH-w1hrN_K{G3e?YX`oyYHf?x4y*6Jm347vDeW-b1zp zq0SfC_YmmBPVagJ)1ds%5_8VEvjKHNLzh@h- zLqhEwm^dAx9fKORZe56+Z{On9uspo0yi_Ls!shTidGW5NU=@7cJfqjTv8Bi9{AWga zMugO`gWKg3>ZB14#;h9BW7$@nu@uY|e%aE#D3;8PC|Zd+1-1eX9;mm!A_y~Cs$>ej z`QW&%{)WxnxmHNd+Vs{atMuRR7HyeyDp!c3zQah8$Hh(vQ}>9HM?2|MGEzR4YpnWP zRZ3DcoP?-E?B6bJ_B6MH1!|kysSrX6x za_andqNU9xOQFgKa}7FpiukpJ*qr$@pOd%;>#gs8*2{%(;fMoT+yXJ69}yoz``yFe?tF|S^nVUa^<1)Nlk~#CaG-hdb@B@+{>-m<#2}Igw`uNK zYg%fSfH8XV(}O9sN)3$l5ck_E%h`QEeBKAO`PdpdDLh&(j0(%a_C23Adr=(&vZW>I zTqM#xs#r#h-rQM?9Braf2&5tdaM>Ccbzl3x&xbCOfjDdKPYZC2yvl;fCylq-f*{)T zDluVKP1Q12q)fI|Xb-nX%+OcGu4(`enySul<26PMg{;De)6&?SH;KZ}xXCw)aqo#v zTk>+)wxoe_b20{&pq?O)L%IomZD#g?sZcI9F}mG_vA+>mu(dFn z4Jpg3``T>6Cqc}v6M`0KE_#Y$K+{>PWFz5F1zx|Cp~Fp*F8vCw)5amKl!^R_VukT}6(J7Ac~Cr*7lHS$A3#(pH8MSslfh6!LJ+ z8zVC0APnPOgErQeLS9_4Pw`g^B{N0S6arA5F(;^4AD+#O!~qV(P|3fQ-#S!%HOOH)>!-9Ga_g3^8RwSP3>ts_p|pt6kKcFnb;M}^-Kd3dKqe+zUuM2 zGqQ@Jrjjp2+bz*`Qdwl$j0Qo8VE?>n)MD)z_cKh6`ex!3(a=uw*h^wJJVXA<4rOV- zX?iS27U+|ZRt2!qTb!bprTb$;Xn6b&ZFNezWTxFkw!)o%J0|K=;~lodFcOG1@2UJs zEfNdfUp34(lM|(>+vEVA6~|wD!7ly8sRctLpm^hmF7Go`FrpAUmS$I0mW47N{=UGz ze`qkrLh8-U)%7mb?_@^==7+W9>cUmaqP$+RMd1|nI%i&UF}G&3M%8_pFF|Y~ z>Q(^>RfTh*Wq;uPhX%^yH&P|+dw`QJNtrG4;4UE&9AF^78Qf4dY%4@#{M%#6yUCG|`TgdzTfNyAW!aad-#<*~63ZVKv3RD#e zy9lIXm9m6=bbfr_R}&W^^-zpVebST8)H4Jhwexl{H2tqGYJNS+Y8T{kVId#0&B`iw zkjuZoyE0MOIr9eC@|1n68OS-_K#}ed$V-ovz*yp|_2On4cR15GkzI*HMKBVi@WpwJ z&Aa=2w0v-fcddE1pO+wWI#mcJGlae04KlB>EfSj7`-n$M{$pa*xRCT7(RbkPVLuYr zC5lYVjpZDBdBipFrZ8nR=WjwQXf>qRCx+|4Mk+qiEz#Y_yFN(>lI8IVCAoh|ryG@o zNy$`h@0dDu0J?B%OwWuQHObLKRev~sOFs{tHaq|i^A+=i0~RBl3CCv(&j!U@4h@#- z`o~JM$BKe&MMDqlSW>$ib6LIK*?yF!N=iUh%YA-H0 zEVB!`c4>dtF8*sM+6EtYt--=W!%Z`nGx`3W8x0?#Zt?cwSpCk7gZY1T>auSESy8D} zbjZIS$*uS-o?xaZb8)))(e88>{TC1Ea$O3BQ15i!Jw5W(lr&uh%1BjS&qU+8TiF@egulXwIy1~bdM&P3?X5D$H4Ku{#N97RsWGJ}J<@IVSCf0hv z{MfR$X7@Gih`1}8u}J+Ve3p(BVEsP!`_cm-S`&6GP8C18szpK63~BuS?mGEyLM|x}frv!$d7;WL_J;Tc832v$>GU>fuy4}q+xSl4&of$q{N-y3 zr=C)z(6*6Irq^3a6W2^ZJME63k#**`r1A429xyasgn z%H@kgZBrv9wDhzFxAeB6jG-q(Q}(Ok%t3wFS9kRgCB%CyxXKwHVhp?<#%vzp5_H$> zeY3Dp0wyQwtgU@-fIeWgk{{SP_k_Nai4U3r`$Jd?Q+K49`ftK`R)CrlJ27uYgkNTy zjAs9e7n3pY!>oA<`432}eah7e+~-piG4q4f#SZbY^1F8Q^&OE{oxDk#N*If6uo__b zF_5whj~I~b&~P69=jiod=sbh8=&h!)9hIyz%)iIn2`y|d+}Oz<2kcp|z3-q?mYCgo zJeQ`B`NSwgz&ZJZ%G9F|wBhI%FImImGsSb$uFs8Vuk?u-I`@KAhe>gj%489v z^nj$w((*C$eL4ApqJK1X%gN;Yh`{9YD{Sxy^8j6{g>iXen@#&R{JdV93Rn6I*oA%kp8%2LKLaB3{{Tb=&i@RE{|2r9 z*MR5_s)B5@%bv3k14S%0dUlg&ryzu3+y}yj0W8KI6v7fjKp5d76&WJME>Q}&KuAD% zFL(RtnfvP3bDMq3&28TKgS&d`p2JL#l~DdSig*C9A~K*5L^MR80f5yPSrPz(gbV~I zG7%uqj3F8OiJlg64k+p=h;Xmrcd{ldBuEh>hYKUraZ$VvkZZ>d0Ff~uqNpk&nFay` z0W{F$=Qu)O0%)n9k3l@(Uo#&#V7ONTz%l}!pG0~iG?enOzBmAU2s!}~F)`^KInLh$ zIMD$D0}cWFXs5sqV=AFOI{;-65HQjAZ(`86E@-G@LTZ|;%S&nyw^t+~f*e#&P=FqW zWavJS3sBJy0bIb|QBaJ4?R!!p#EQwU_ykDPH>DH@L+D>Yy&%m zfc%nN1gID!fPnqjUfg~=JqQ_|HE+!^Sg5YN9|AzcP` zz2qoAIbe+@ux*7{1KYSz;+_d#H}be)Awmq=ugE{n)in+w^gMgDjmR)JXHVWB;`Z={ z&Ky&V*cH`3t>9v!5BNFED4_8GfdWbkOaNu%08wFW5WjMEC#Qhl#whRABTx7!dx3WV z9EM^6VEx&D)A17l=b1_5J82$1I& zunkrM2&CU9^2>klOMdJZcDuLniyz=;_uIm&v;DjN;fw7TU#*UNYWmim8?1JR0_Noz z5d*C6cXJu(16}tyKbFD%^|!^Uunz;StS@K#r&}aFjSL3Xl_e;jfbPHX@ZCPBy?;-E zI0XIbH5dp11u*buGRzQl2=&pz!|?8H6l6I5B#)GJ4cCL7Ej^+fAB*TX>5}yP;No z+av8GJ}2YJdpE&6M>K`n3fd_Qo_>2yD{H4B;e7I`2(7!T+rogt+iljRM_VrKrO8H^ zZh&Wxto8t@u@}!hJSG=_)FnM6?i*0@=JMd2$YuW&rb?cXM`A%PSjEw2rOI;eGvQx8 zAhT4N6qz(0bx(H#`8>y=9&jNR1~(|vcX@z%q;P`r-MK$|V@YI(>aoMrJ-XjSt@* zP}smD6Ftz@wBdM9UHz)GCB3EuG2{%7=BhTg!C$0>(***fY``97r{wB^npC^Cf@^Vm zHP64Lr-^Tmfw;AxK!Q#!IBtnJGFdy`jyvH;z(>u-B3nxHWiw%3_9R$B>+fQE^JsPA z22JMBOn?T95?R0D!~TAquz>^ z+f=0JLAETih@{@8tXaM(1>4ku(E(+(PP^{Ih+9;Czc|4;@9pT5l8T#S(nsUF|K%gT zlujVw_9%>a?6nt~c_-`Vr#Fc3SS$ZMZr3`Z%uiN^OB1=_9!7TI`3II>v8tz79lxLa zpfFwOk~YP_lRdZjImL4+Zn!^tEMG9yc~NXR}fO|;Xz2KGeE|&K zlycqhZj)3)Tq)I-bj*qNC}b+pwt>H3g8Y*UA6^5W_k}n5l1_l~!_frKo*D;^SIf*et2T>T zp2cTj&3FxhUXN)x_Q;807pLrkqpI&7xxNZskhd?&JTD|Z_-$zGdO!F{Q2ju|K~VaO zrahYQfsEohuvWW#5tW_nSqr1oa6}9Dv06oUdT3zN*_LQm$^bD&$&hh7lTB;yEPtgN zPR~4y?vulA0ig|BX-$cPeC2 ztcv`pC9K9D@gaW&{A1m<91p2@oF-Jlyt^=W@H5AxBDg1!j#y$pk)6|hA_==&+mJop zeCb60xAJ8MAvtC2*0R6jBD9yCH=zWvi{phYN!?STzlZ~^vY>~?G=BoJuXCi+YVY;F zDt*djPJ%d>tEf@f@M}G8Tqw)5xgV(X>45JQ^2sr~aB5GLjGj-KR8eL~VL0@eqcF@n z)RfwiYyFGhx|DGrVpl8R8+s+!7tu-)l9TzU*547#$66z>FTTeifAv^1z_GQ?+LGe8 z|6KcQJT;Hn{l8@&7(RWyETa_hXwTPpU>GLFw;{eGr%>`C2m)738} z+0|ZTFQH&bB++`>*zr`@p{W3|AuhMM-Z}6ks9t~z?ky;)zBulbH~nG#wq?VoSMcrG3!l3f*Y|gp z3|(^Q;L7m{q`ylAWXGkGuT_nOV|uc2!}efDW5RZ{*C2NeRCOoOXOdG_rvWcb#qy|P ziTCPt<(5p0ry@lR@Aq`!q2C~?G$<2|d@q2oP;=d}rV_1}@~uo?bV!3sN0h;VbVYDz zr?=q+5$!J_rSbl9aSE(yz5=~d?~|I}U8`PgEX@l$+`kt9nV+Vnrp_3jD?;%fy_R#7 zTeZ;MqMwd|G?`3mw;MF!!I@P4}O3V8>pG z9H3W0rP#iwMCtQze8d`F`O}u=Y!;^h5;_*!yy)R~(>`6GTNq9xMg*j2$VV3tXI=kW zmI_L>6wgApV7QnxLQef1B0ngTFCQv`B=HDYRx633PUiN?(Kj2!*;BY{-arqn;mDz~ z!#8fAL|99XtFH^*X>kd3UQcZyRKIc8oL4S;lb%{y7n1Aw(1={VL~~>}WLp1>_n%F* za1dvCFWb_`7*IDUdd5L4e8y|1*rpfgZN-Rb$C+5dOH(_^Cle)wc+HU&%IyVutc)%0 z3uKX&YB!)(Df@WHd2wm5pkHWuagq;+4jlVDHzQ z&oD?%mCHb47n<>f(|OVJI(kn_T1)QHw3%UO6D>>2@kC3d)nuZK2ePY0$St`$DZzOh zW(s@d+Yf2f$=p5$#`i^VAo>OD*=5`spGqTPF=5d{0d_R+Kg@kvl@&Hhp`BBxs~f(G z-Jmt-R%xA|3#|JSQ6qvhaEh6rD<0Y`;>ADWTX^p}CAW2NQ`j7u7v{_wdPbyS!Pl}Q z&8Q`M95)|D>-94mbu=0$sks$3ExAh@^Ib_6H0NR3=D0Nu-weAQR$cIwJa36McP&^4 zybFOmclj$bP0e$D-Abso#vQGrH8~ohbvMFziKn76@dxjH#Nh@@V=rPvcVO%YmK^wh zaHC)YZ7PD!Vv$^Efy^IT3y0;?1g-YO@$~gycVVEEH-aT1UMqRxDHLaX= z`+Fq;iQ-8rs%mKQdn4*DiMx}7D;lV}%h}X|y9c6mi@GWD>}dg)V;D3*WkbOhHqx@+ zIkpV|Qk~)4lzmeoD`NDxhJKfW59M#WSOa~>ixAGs4AS`9@t$61FPzl60R)4#~zT%6@ne*a+qJKt*07UwVpx5Kg8VsMns2VsIpG zeX7mWqPc*Fbyrj{TqwcikOZ9T z7Ws(#h>j$JI5#)ZlUu2j;=a7L`w(0PN+<1i=U18*%82+Z0H;%BvdzU-Nj_jdZfz#* zJAizW##eDuN4a*>fKV~(8CB=ltuF#GY&ZF<5IQRV-C&-sxzMW7j99XAZ1|Sll$t5z z{FizWpxTZ*n|yZQE;sKj5Y+;WH_^4#9{RSvS@q7vLu4 z6)0LOQfZGjj1D>oeDM!uZ;PV)*v{d|*Ao1FAVt)Iwo?~cC4ld)*oCuNP^A4>)A_b< zZrpbp!*;k((WmUH{(MpGC%i4ygSZO1eEL1?_$^(^JjiPyWSt4aTS=~IK#^dt`Rindb z0Q53(og(p*v`)K%?!0%PUka%`uG z%FlqdC_1%~Xl2}4;-5Dz&zlPaY~I_GqZ+yjm3K3@l{FXdI+*F5HQ%c{86J(T7ru9u zOE0O<^KEk`RVK5CTfSphp4IIEU(Dq+a$);w+`FkWA;ut1p`fiH?1AA%b+KP(q$Z7% zBxzOm^gMERggQ#M&=F`aYj6~+QRlH>t&>~D6x1jo*?I1ZwfzMe`bm3Yw+1#oaGI{` zEt`!oNFt)MyHIEiEZn0-wRir}@rc=ktP}P~K~YVZ-G3F03^G>C``;C+tT}bwuVdNb z)1~06>gPK!_ry!G45?mvh{RaU-i(;@UiTt{6vG|xvVp36l-UaCngkmtGuo^(y&H4M zq6y-BdV z@I06EFA#;?rDq;B@i?dLB2}&|Wv)9+>PFM8k8Lx$DF;+!^G~z5MAu(d9L?F35^OwA z-G(fPrCDLj{cG8!}SZ6)ek$Y`JH>v0)N%O0Yto3;2l@K_evpk#>3;S`gub;2+t z%-=%jKGy1RL+Ku(7D`O)EZTocYWUPXfD(SZd}2e}4I~>8=1SIPLbosX_n~qF2{(3? zqldhpEd+&Y%k7Uy0+;MN@NF0`Q|^GBJ~Saa5qwx8r}l?x)H5H+^pj zq3gbybztoFKGxe|@#AS_%?zXrrPZmuylM2NFzovJi22+#Tm_19i}$~$t(;t;eNPSm zZ>pR7bcZt2oAxLT@8!>6l5)h~JnFZxn*BY3m`S)ANPH@W^z*lDs|!NCfWtgcQgeQ* z?JAvjI)sgC&;6DX_OrV}w@Pvu)+OSW5^+|^)!&6p9r%6ls&M~q%VC2fSe+cL5W5+g zK1xjWLuFj&z1?Al`qeoumjBO-7e3-PmM!_JRJ!WC$mh^w$Y{+|1*f`OtE`1wsylsl z?yy&Ox+di8KGrg=iNjqKLEU50e73jz+^5_=#_feF93`sT;{$wGOoAC3v)b9Uw~2%Z zf{@F;-_F~pVBKB&?0zSME2H}3lkw$DB&MHP;PpetIXq2tG*EDxNLW$lL0`&f_8ZG< z8-1tsGDKNOId%>9VdA~rus)ibEGQJp2Sw8rxUJY}UBz(n@zLA5G#>%`fwdmLUsP6< z&P_5I$O0I_5TPZ}Wp!9dctwm&ELDg|;$})qs=%q-Sf=JrT=sF-h?000w&*v;d`)UN zSe($ySZ5V%N%G?3d)3ZYS0~-*{y{?-^>dD}N{yCnc|F6IdNoBxE!Okm#gNI1F-ki&|&Jw;&&QP>=cUg8ChTGybScr}e0YEFJj zzIPsp>)AYoZykjIZ(4Pa1JJm2_;Oyt`RHpqG#IB;TC>@HRG3twoSQLJZgT>g}9Dh{e|4YaI82Q5oB^ zELkub?VjXf=4(9;&3V?V>G2f3yhxnoJ%jQ(PQl$*LakFc+T;OL=I||xmuBZ?9ftrpdB#imaC~Prz%>TJYpY9#ytBbZ+s*Mm$$Qu5 zkIRjh0`Pzfb53MdeQ;-eftX!4oCobvgz!rjbg+n)cEWG;p#q{6B^hXD-u|9Dya>3R z#)Zu`S4xCf<4>9|TVkZ#*UwZrRDX6>^%hx7sM#+@Y8D_%eQ+WG8XBqHHgkOmA+0+Z zgBIefSMcgeUb~I|q}bEW8m$0VLxYISkf-0r)`jm^+H_}q(-@7HHe*E)HLo=r)=zt9 z8>kRnU9QW49mN+w7ul?q}Rdi?xWrD9JVr_Ce!myEtHy`A>dXwLPbcmh8n z6yk$$1@k%GqvI}rT`Ap=V5!voz9;O)p5@wlm*CzDF3gP*l#+*Vj0e8KJ(FvyD?!ST zYOD@+ziE>9SJ&`NI90MrY)=0wYwM}dM9cwivqZJLo9RG8X?C*2kRrBgR0wHQ#I24x zv&8$ztkx9#cw&W9yICFxG@2lAXU{iA#o0EC&lmzMoN{kg*7V!qP{mhNJ{u-nWxL&c zb>_gt)^761j^NtABcr;Zao`hYZI+LCU0j#tN!w!KHk7cT#98R{nA%^ zEPd^2-#TqL2E2F%M{~Ke5ba@Xc*?lS9-g%IY*^HKdDRp#dilm5cwHBKwof%rus2@> zjs)52VWz>#J1K6#G{9A*(-(e?5jZRE0uG&DDfGb2c;A6k8@W+*a=-cvV&`vy2;G?t zJ3$>nZFL9mCBQ12s>Y}0M|DB(iYumBN2b03d}Af895=V0yxPF`3Qt)W_A8RkLc zp6;0xgskvjR*buOc;Us{FpL^Zn-+jx@>Ar1WG#DQ@v})4v!>2$w)IA}aqFZA%5Mx- z!{E2|u$!?v4VMeFLFBq>C#wEN!*2Rfo7`|&*gOY>U+;#c@5xk&vV$8rw4O|_}H1z1^(t^fa1gPaWi3H{g@8U7#oaWJwm{ok+unHuC|Vq*MXqhHJa zNe!a0MF$Mck-`!aPEXAdY;V)D_5lb__08!<1r)hRNKqpJNtFgjP!Q%QB@z)#vw!rQ zcAaMb>R*1MS;M~exZQqkyn3zOUSi#iuM^uEPDq5HnW0IJL_po0eW2YngT0sNa1 zLby4G`h*6p!yZ(~bs!Ns;D3Umz*vHgp%m(#Gt-g)QP|!@g+K%m5+NZdKr&!Z0DwXJ zO(R4i1yl+7=(`To`Vw#@0Xl&+P#5UtU2l*xR8I9iu$Kn#?{R4_kfZOGhPl15|+ct1*03qKL%szk@22|h- z47+%Xfe2x3du776}*CZss z+hcGE<+nvZIKZDlJRMyD0|x9*RB#{zJi*lL4CE7cTYfM1RUFa-w%95@&RMJrIM-k8 z0MJ2PgERjC0r@g`n6uD_Fi`NH(t}=701%+2@J&xZTfXlB z5D);O^Wl5Hu?5hfzq+7r`1-6Nz(^E7>h))o-<1Y=z4m#Jx5IltKkhWPB$@RL1gHEU ztpL!$*K_>wzvh|0j_<$5ueTJx=s~~syc0V$HU3T6z01G&v`erz7r(7|)9Uv0EU(S+ zXRrcawdIgkwXVxS>x13fKkAhyprW?{I0N&~yTT#fRD<6JFC7l_+@-x`59oGJ-u*iJ z5b1Oa$UmQgfDeLwd%yGftrIh#-xeMP?{DIu!t~Srr7A*egxCJ|X#sT*2vI_U-+*V- zV$uVB0uWxX*M@%n7%(9B#PNC-=mZ_z27iH(K;L}x3IyU4xV_5f-sj)&C2(Q{e-nlR z2|E3yi4X`NPWEGZiu?%?>KG6}e#Juq0ttrvBP_s=dPNCc7@mmV;-cBy#QAw4)YF4k z`6-UZmI8F4yWJRTcy*KUbJa~>MP?Pd8^t0i^i{f z(LG!Lt|p9!%=eg+w;?)SAei9X`@Q^2g>$<52DPI#S|bjoTGfYZdup9-l$Vw|c1Exf zVS_3s=zZ?R9MSeok*`8q=*cWK9J<~x?%T%Uza_}zgC4xefg6+;_aHB~B!7!5C~UeAk)`QP!>Xbht=O+D7!AyRAJ@MEbBet#c7GFq5uH1mX=)f z+s^OfusjNMv#CZHb6kB|H%@rn81LbA@$O1&G$un#eLFCtTa1k)1;?^eV`VZ$N*#`i zi{$x?OU{b04Tq?P+-1p{%L%6`r68gs+5dV6j}rzqcC`#P*0j&KCv*gdIWBTc7wi9Bu>s#K zs*MEeM!lviECEG+x|3r*vYdv+`RWdZXnmOY?nsl)QcvZx&Xe9b8Wk)#@2x`1tZ6HX zREn!S?n*N&?cIRFg9nvyo~p(++jde7QK&DkkK6L1;a^oXu0CBPlE>U;dU3`iym`6Y zOwqN;NuMlc&{sltgyQz-=Au3(Vb^YCd4LoTY6@nBwB$Zs?2>>CYu46b#!o`I**>Sc zG6pGyvD@aYU-Tu$M_3bAKMEjhc3H82kNocWn>dZQ2K>H3Y0Y1NabO>1C9hny!YEIr zj&+1Do0+yDxo^@+We*IA;oeht;9LM!_`d&TlxFAA>0p(XVx#0`<{`~hP_&TXM?f$8?&3q#eKi;?to+EHOheV#Q9F5 zWuA&$)#0pAm(MU_-3@;AA?>gS6Tx?S^EONd$gmfDy12R*`}&_ZDzGlEo`E1I9{%EP zUxLkXAG5FSA|g9MlS?UAvygQVc#e4StlxtU!YX+$7OqU;3WBb3ecA8CeDFPk_w#a~ zKc(D61tkImKtcEv9)!g%td~07!IUmchBe=c00H+WBE%t^>|L5CCo}imY1*Gv=l0MA zb;H!>czD1&Mw8pe6D!Z;WC$^Exvf?Xk0t6mvpF~DZ4tCGzN&}l2V@H|#FjS2`%%L@ zNCw$wzm*@Pf0QCIBB9PT_r-QwcS?5L-Yrhq4yISu@PcKsNT8{aIySGQbCD)_*evoW z!)t<^FRGwwaH7Ep>_)__y*1b0Tuo?b9|O`!elOvIFTxJh!>JST@XDo_euFn1YM=Av z+fylnHrYWm#rloMCWY2HzVhNCRMBX@qrgLkFB`Cf_is$+jJGC(8WB?CaQif&KKXo@ ztS7r>>zewA23ao8IKvUaxGob0kCYO?b4q+%z{{G`Hxind&+S!7ri9?{R6a};NYMm| zIFE-kfira&c5jq2kKS`-Jn@!7d=j@$bo2uElIZXSIf7A;4qhP|=-#JHY==WJq?7}?pon?)+ zT!?ru@7-)43YTOyJJ*ALWNLDf`@m+|m9*{95cd%+ad%8=)Trb(fTtEY8q&BYvtckL zb4C2tXwivOD4AiJ*ILlEq;pZw zS~{;A8jbID? zIk)K9#EDapEq0_2rHYjdyjg45Q=B6;3+&WJOD`@i+8)z$X}q`QzV0J7UhE2H`BAEE zVV}U?3|35v`MI4If{NN*;Fw}-iji$lh84*LWys@EoYz``&WM+q!{t)IaUFhhtCBQ3 z+p&M?*Y&+lj%VB0uv5GZ9r{5EbDsFuvYt3}1nN*kRZ9@&Vm&6LA+)u0#yrP~rp#|X zp0NA?usBpm_}cfS>-nH1t>LzcVC2&!0C+jP638#D2eTuW!%QvzYxNr-x}st*;b2wf zzhP#Yd8~mQIipFron4D`)y|!Je>^)$u$T3hnpN8QQ$4GFFAU7&GpxIwE6c`puAjN2 zh2nw(=;rp=<(l)SC;YWWavXy7K~n4%A5|79xU$s^WVVjSr;hn8rLr1R_ILq0C0ITW zGHdKp+b|JqG($o@8XDxR$kWCkEhW@zNd#?lzVQe!Z|m<8m@wFB#`;7NFS`T!t6Y@h zO_24J$>eMn_(Ui@Rf|Lx(DDXS31cxO-}~-%beV80WtZ++j7chT{6#W<+B&`6wb6VW zStXzgrxyG}7>nM|!=5@65K(-d7&DA0-hio$u`NHOC>;*C_jk~->yE*^f!x#%n`Nw! zkQ-i+#YPr9I6kyU#@7_#;VvSTbi~oFeZ3L>2_2?!RWExH2eOL+opSH1#*5SbXEL=M%fj1)iG*)u9z#D^$$#Vi9h_!FanP%oR<6l8F zv~`Xk4re0{o8!DQ=3Fg>6U+zHB8{=xw~=Cdsey^Nnx`&_t|4ZDvv5loY23$3m7%uB8jL9hkXg+)Tt=Z5P}rkV{cZdi4y+d)6zkzrOik?w zA}RS`^Pa4AH56Zd5Bd9w)v65l%*1&Ua0L`pxNH7W{%fI+a*eW?>|P}Z<--iQA*E`WaDr#e3Rn^dtL~t$XV+N+TSIfjdM76iP0L9 zGqv0y4-3_ECNH^4JSzC6a9zi9Xmer$Z@=&*X}{oo1LF8sR=moG53b zG|RQJVaA@1FWiekz0e(r?p?@CbtE--&^RUesQp$Wy}S;toq|YBaHn`y^G3AD#GPkJ}3Kg<$}71vYPPxBa;i1}qEto<69nIer)Yz7O)9 z{2^+X?atxVMZ(O!>9e52ALqRdQxI8dONGLyyS0s$t#f=)#VrXA!hx~W$OUkIL zx?NL{v{f`w?wH$4+6Uy?uH6qz7ZQd@uxgmpZm~7)R|c4F&{|Cp%dzG38F*)Cl^v#- z#}yu1Wf2b4N6jr$3t}*>BdW<)EwOQjl!}NLOS#<$WvbX}>l3utZkJMfdDRsoikmOB z)&8vBp12TnKBgiF5jAGE&`t+imjp`J8pyqebTcg{B~E@%p4E!>4lZh|;#!G**UH7Q z(lZ(#)g&u%eQd7u6wg{u$hH%#cfUYhe5?W-Q{voLt_#E$`> zHz{Ac3+(s_40;9rvW_?6v4*YkB_XvqV@j9&ezOseTRq%|KG_AM-A9dv}6w%cet><07;aw~(j38)U zL7v=yFye=wBZCFGJy&fc?^4N{Ug71v`s1BclyD81?#j?Er0RKk*Ogo7{}YSpdXN>! zxYLk7aIoWzPuu}3%{in6w!NtL0l>RBA%L-e(5=Mbw7PcSfsCUJ)pA0hbH9*b8B#{?@8Ay6Ct$<_id;avvWAd5K9$( zG-V3kS?O;+swh#BEdkgjuspThWyoW-*Bo;x=bun-aGNDN_^F(xK}Y<9750Xn6lKJO zG)t44OYnr|U2 zp^U&h{D?hbq(cMHg6y@jgj+1_s(5!RJAX(g{0v+ZA`?iH)lD zu^{?-ANUz|9NHU+0pg(~ZmD8T)?Q|gSlhenW?oDedeV2qKmz9Pe)+y;AeAB_T#*1+ zU8+313CaU>+jr%L5XZ{lT}9%)p& zcru@t)K%xVU3ykyRPphAFx4$lq@Z0DdYR3wZ;#=ZM)}kO7+P`=&%mN%;?L8);Z5D) z+d4%-O@R`nf!acgT@jSj-6Fri$vG7-yeIAl_9>ge)9?_EgeC>4r8U3QMfVuBiS0Y} zMd4#w($I1=9P;1_rKB0Ru7UD0lv_R)UNxsG4gD@J)}DsWYNI62%%1aVU0!!%^&GY}$#;q1&CX@z^37d4Xd zG7IrjNzDOtPFssmv$)vA=}on&l>~ACc9&H3YDAl@%fuZ?h&H5AliOp%YEV+}%*u4L zcJzlo>D89GF44m0f>?nT$ZjllCKw367G^IOkUO^oi#)dSjr9+KP{p!N`xxr5uVy7L$DOly-TeEXZZ6b^m zDyL3m%3LJt*G0oQwzF~N4AOz;Cb0m_LcCZTbCMF%nQ?6`UBFVLIrXF*2)adlK4)A? zvw(i;szS`%ndESYm@U$K_so4=6vySQWL36lpL>J>hFq zwr$()*fyTnw(X>2b!^+VZQHiazWT1-i}NSe8gtB=Rhd?&J@pFC6_SE-U33S2*Zx?% z%IB)_E)K=pdiJ}ClRQpbZV6#9v@{6~Y7t!quCB6Hz4F#a7(77ePAaA>RrQwiiyA3A zZPgo%`zxh?8xw;M>x^(!Y6=w3zSLaVkSV`=Y7Lu)-BLp>cQUtxB<0H#9N-5UAv| zzd)k(`1z8M^s;I8(nB{y&=LwY)#r%Y@~7gyvU@jrC&!!ODU`nr4SSlnnD4;v4?JZ5 zR61llQcDpr94%*FHx8i|Ur-(h7HW0=UEH2Jq2Uk>YC_*OFvnuSib`+%ZNpO;ZYAx$ zcyy}agF%{_&1wDz;#8Wn65KZpM}F`T6YnH|2K^!%lzQC~3Mip@O=4!lsNKZ@hIV2{I)RGuyXUJB2IYG`s`1H#D2N!Qat&CqC@;|Yi+8u z=QG%fbjI5X)DWy1CMrOZqP{}J^e*eE!hCN(xa0yxi)0aqWxzhowQBckOij%bZT-+^ zN>tY6z%1q->=UfM3HondO!#S3{B}P*5T7xzsimb*dw0;Wg!z>z0=T@w7L*msVkCtf z&q>c&?X1Q2{AkPkB2uMU3m5NJo*b+*5N{6J638G~rTs7!Y#!3Pq`W^+ge0O?(*;A$ zEsaEXtJgN-yl#k(m(6_$d~lOQzTW!FUTJ0OPELS_-^oe-@_=Y_J0}*q@hzSYROK5$ zB9(dF{88FvVDuP1HqS(*Qhh2z>CvU55)v0E72W5;8TSXKdOhi3$Mq1Q#>Id8Ta1^xZg{^6yVSk>~`JDhWo6_bHMvxk*V+#iKP3L6?T6#hU3mw(K z>)(N9E0HjsF9(VR7J_7l2l?I2JVfI{V!>U+%6nW3Gp#eSK`X?vZK#CuXP4cV7R~sc zsdLPtFn!gwN5PL4d)3Jcya8zvP?p2LeGS=}x+s9o^mrrujoYAx$n5ob7Yy$QGryhg zV>`2@|E8@}4e$50nA-a#gix)@H^n(oC>=qPE*U@6v|tfV&_zI8G;L%odwk=EN)f80 zrkJtI231kIVMUsZ?E{^5;CTV2kszV2wae4~@bEfNv*^77B8N=mwfbi=JfxA`b9r7) zdaW36+ho5_VcYo2B#k-oeM=a5{T-+6nOi9l>}LZ<*n+edtOqy{-RP$Ws|h*Qu_2IL}Dh{&8~!Lu#;WP z*9!JrIdxX;EpPNWm6YxhGRQ_VNk8_c|+!t~$dk z2JVtQaSJOOSgBoqT;O)$Pw$be%uTQqh)3#^?BCyDj54nCDm-D|H2FQ-#+;$01-+VX zon#x6HHmhFWLDGjLMNI@Zzwis@}a#Ssq8%02kyhh8^f*XQI^y+orJOJz(;uBgxY3P zgauN6l96>j9vqBlO2ssJ9D4^}maaz>R%G_XzFZ`T7YD?KZHxs>b5Z;$lA{Gk}0 zD=F$-nDAZd13G0OW8?Xt(f;N4hOR`30bkq?P5Bmh6~+TgZ;uh3(f1;VIX?RfFC28i zwy#A7y8}x~m6wnIMmStOT?x?SR&y)};){2PwtMeH^FY9X^MbAWWDF-}L8HA&vAPHg zHadhuk&ehE>R$y_fP{`G2cw6?Rt^N|u1QZ}j_of&=E=y6W0wa@n2eTPm3en3%e}=2 zig_?7Rn{9`b#3@4Ak{%JUDW zsgEK3f`@kD)IL0GJ**3B|Fyemyoq)f&3_9$>E_wuki3vrL~2BzPWm zL-S|>9D5{v=OHG4QpkR1(flBQ0t#U}n%c|p-`M*TmEI}V%7rb+G86|FS1__==_o`JaZ=6vMWWnjU^r74oaztSV%VGQz5HAUuW>y zU-!RzNFt36HcBgE?Im9%`)egxf#|u!>s4lx_K9hqJ{7I(!UAuAma?XZMB8@;E%EXF zE}8%})xO@<>i*I&0o{^_qX~Aa2orkkoI!>Ao^FGJh0xyUP--N)_A6M{>rnsGhc5jlN`i=$_7N2xc&@uKZsGB{q*VF1a>@VU+nQRq~$8x2L?vjyJ@kJH)OAI52%RCYseOI4`0J zFHAE%3_J5X4e0fp(YA1Aan!FJsvclQmhlyC1;*WdP3!hl-w);oor*yZUpQ7(<;zf~o@uG88HEUhwEFTh|V zFVf}YvYI#N2}Q|s_zY~6_DtpWGvPun&vLp=9H?fAQgj5~`wls>CNx|mo*a7pj5@nI z@;NT75{UE56HL*5f&<{27G4U$KD55bJp;LjD?3TaPwT|AuF~8@+Ld@RfVN?3pg-#{ zUeCJ2KL!?j;t{+iWS$>@y=|(lo|97WuI3CZWfU()lvu$H5!*v|h)kkm{++BK?mXH3 z;kS>AUppV-0F+)M-mIdK`4h;?HuK>0zx9PS{Bc5oO7LjzaAeVWx1az)_+v_(mU*sb z#{DzS>(=f4M9Z)6LQOh|Vp}J-1WY9{&)d`#vevmtufD)%tvI(CVP-6~odqVN{B+pW z*R)<1=T@iaDf505`=*0jA%?EMJ3V?KgtacO_c%6YjsCfmN=y*8ijBx4Na0{n$-kkg zVqQ5fodx}U@$CB?DxY)P(97+BNm=BmG$Jw0IaU1|%!UA1#A`twbPpZlY46hJthA}% zdT(J+QE$;S$~1oz5r2&yx{ zk2w`V+FN@bwT$Lgs?BA+1eKe)meBIzO*>G6aGu>8JQ)VGRqo0ms%KfF- zx$NztCX{!uN%X#rP?IqK3_5xPof5|aftVb83U?xrrdkP6GcW-R&bj(jzNrbj%~i>I zySFBF4JwO?5|badXaTT)c^7}4?PXg((3V-PVgu{lj;8!fp`4sTnNQ!4<2<;w%RF#= zxOM2!>|(KVQz@A~@K~7EVKpvBNu4Ug1!O`lU!%QX zjaGgkp_@k8{s()+^1s+4PS*dUjaZ1dSh>0WCws)s`u}e%Zv$6d^u^_jladKvKq#_y zk#^?{l8Rw=vSE@4cHxwQ4*Cy8B8QSnBl^!ZASE3P^&oG5d+K*{`YU+qJ3F)Pw|n`a z``zBNiOm`uC(v5Oz6DbN7Eav$?%^>E{E+!U;nM}AuMbS1ukXhP0DyXvp*^(X#jisJ zIW&h44*kLs#|H!?P-TEXMS@rj7y+?!QUxdg^-uCC1%89C zyutQ?zb)bc5hCvTZ++MQ9FGyaY+`{y4CZ7DGckIn)Ax-KzyMp&THX=yC+Y$rO?_Y@ zfw_hjUJ2h2c~gzSfWPJNK>Z`Dgayi{`BKTF#WK2$aXEHu4*#h@ew&1^n2uty_H0W= z1q*W-{!GaW;s*hdc;1G6GjEGyYJ;3Qy-kkgpV~Olz+SPN5fV-Bj>Z*J+ed^TANZ66 zzzTzecnpVxhQ0wIVFC@I+CYAx_w`L;Kj{1??x^UW9mT$Zs}oKEzHe*|{3medqbq!a z1cb5=asT*kKisR};o}2j?ahQ@2wvYDzW;rQPad}R*rb$ z()5=y{h9a_XTm~IMV*uqXgm_Wb3_vocY`Xv|18sD32?S^sXi=6YT*i05CSnK}bCmx~M)KGGX{vfL0#2y{2S@buq5(;#%+Mgb`H-QN#L@1!^PO(uUCj>~q zr>wdu%;SfG6=)1Jm{f@ZNHx|E2$u`wcGd7*(Gx_NNrx5;>IzDDJB(w@AV82O|99n^ zeXcjcp}@b>nfLlhtv3GpzU!Wu3#YDLpe9nzQup>5q?$eC~&5a5O%x#M3k5%$$(f?+14 zgVrm9LeNfPB&yY3cR2Rd-q~J8IjA92kddss&|q>AJS))+#!53wzP8>N=ITD6b|l7nL$Sf?vwW`TlGDs3TXrsxq5rOn*?6> zyU%eQ9jI>h>U{KR7FFly_EF%M1sKTiRrH_`PJ%D<4zz-p?z*< zQ5tv_b&gJFO#Y3KKudIP(}x(YI5eZo8^Av+F27&`TS9l@RRYoHZR>3|1``X*b6<6T zgUmk1Trc|+2XQQH^!8R9(HDmWAarr#RPAJ1oapSicAr1eAf#%6Dp->bdNPT}go~cv zwvnJ9cJM9Q4}q^udGTx=%l)AM@<#8}cuRT?7Wf`eXsWDalIymL#q^`}%BuO9@P%GA zXd!1W=9@*(x(gmmd-l?O@nK8~oHN*1=C#>i@F`A8Dn@z}1B!?HtYRqn{h;aE`Rd8*wJ867xI+mjPgHpy z*kN2+=dBw`mTKsXU;>sS6%48MlHfom-P&Q}Vd?j?QvR1(`D+Req%|6()fvJ@yh^1_@5zr;p>oU0l$OKA+?C2mf~N zZTbncdW0yEU|hSG{HY4>BniDbdy!#~@1fnmvj%r^d7o(F`Y~R6Uf2(Y>F{jc@!HT& z1n(w~?OUn|oet(b8qRxx^@RWS!8DZK=;9C8#?wt?_YT6!UwVacQ{@_8ZO3EN}VxmaDbTN?AGbPCOpfuGz4ubZpf2ljTql#{% z*Wd5D(%d4en!_;4IQHOs+H{bL$UX-3B=;80|JAqLc{6HxXiWD%ZqqkXGO)o2XVPmT zQv}h9QyNW^c~ac7l6sEtM1|vUeqCaG(ZAAYOYhN83wZb-@|Bj2LAq;pZfuwNZ0>=j zooXmF5iFc{tNJ+Vw&l&E2*&z-1RoE3@jT@(Tz{MY;Etr+cTU6cr7r@qS!A5ue~of>!BsOcrt0zfJrs>@YBhQ+)i2OmgunWG zsKmPe>ps!M2|w%0Ub|e!(@(JSC*@&`ol~M<>yb*HgW9p!#7igQk&2rxzQP%pzrWSw z<(z*6g7r|Li{6&FGniPP4YJge*U) z>0pMqML0up;Xu|+Xl(|%out;i#4O2JJ$aYz|3}@Tny2jGdJLim3F_r5QHYQotF2Vf zw5(9u{IF0!o#jFrKgyrUN_jcA6LHJgA6L*WbMwI@u170ai&q1{DN4>om+^GpfMA`y zk+m=G|2l+S<5%J(!8=GIcfQ!6cfM?D9=DE!>^=~WNQUY9ru+S0WHia_p*bmJ3K3kH z1ioh}a-%5>xUAa+b}(3{Xe+#QmRkgZ=)<=1t~%G3wolt2vj3R->>dG;)ggmSP^XWxaJ%LbY*8)ZE`}Uu`Pkl)_T=4&v3E z`BX~8Z>G~VAg+Wkl9JXXo0yLBPeb}Cg3c6^=4km?L@leY2B6&JtLPI|d z^E~0zcaT?GkZEyPk+*{HYBAyM#id%kZ`>Q_C*!y`eKN;aT-BtmZ1OU62*DcAB>b|M z_Xdg~#AlJIi8Pk#u9V|q?2KR^Vi|A(I0I{C$xxGU*e91B7F&+yh+Q`y!~a?wDn9>F z$9c^)1Wk%_>^&{Y2July~>Xlf#T0`u0h~ER^rQECvWYl;O7IB|~mEWzlYKg@t%qUEuIzDhJlS=4-pGI}MH4}>) z?m0pCG?x9bFaX?z^X`>qU#083FF3Y^MA^_{EpbY=jshT^o%57rNMcr?jw}7* zfKW#=Hc?-RJv!(@l@|4??wertQ^&QM$K;%SV+;++aK5tE^;E4&ZS+L{Wn1_(m1*jo zZLJiV_*m(m+%vN=v=2^P>;r7jq{z%iRDU6<9sD_HZNFJbb06wr-t55=8)N(g-6hUz zrFbb0H^S&Y=XzNjGX6k5WUZKQcL=8$^nG?_Q3&5sC(vc6nwOEM?YUUrApO!`mMse! z;oL5D2M1xqacwiYTYNc0SQ$m7z^Bzjy5SetBR7(blQM)0FPJN2ySyv(@zAY^&+sWn zTb%8bZrf>rLq*23->bG*Oh-^6Y-{!dyNSn$QSXZvKm1(ccd<<~&S~U&n;M4-_5c); z=*K=^t?XH2i3NaI7zWsMvG4=e-WkBN~}> zQsl#W-eW z6h&Sikc3CZb?!s8;W6mAPKjZfY~x+I%uwDq1m12jHvaYc(GpfdBa zx~NtZyB8_)%P>LeWF5|Lp>?SutchFO*gx0ypE5K2wBaO^y*`aHqjfVoOip;>3TTkM zq};N28R{KQ1M}sPkIz30gxa+78Z8<4u4b;S#GD6AD(%JMwVR|uP9EPG7pjudrU2EhIhlTSy3fEL-S$ypctY?M;awK zZe8Ko;3Fyp!W)gN4VBe_ov<8hAhc?9k@N0~@cl*MH3zc0=XyENuVtw+BH z<$LeVkOKL!e$^~B6&Lsn{6${aQIb%>=$F%_NZq%;6N<{8-m$T;szQtF6LeaJ5Rgn%uUE&K)hB@35Z(E4ul3f!b)*|*Hv)FR(^?pLrz;8pG@|*10kNy05 z#)tY8mdQw5=Y%@#BWpA}{i41bVD|);e zZ~AibfIL`C@sd+_@hSQXC|NUu=&g%pKh&AAuP%XRM%^FgnP?}U*c&`NSGpIJwvbwJ zy#ikluxzo4s#l~TT92w`-OOXiJ@+{>#VhUJ7bV#OESj^}7pUw~?P;QYqXH)F?S?`L zK#n&r3pWo-2K0@(k|AD@ZKiW=Ma1S2b8gWD9%9}Xl80;V$rnHZOWwQz$>=|T}z*zhd2R#Fke8bihnbmhQHOCw3R&q7 z-V?Ko*QmAx(3HFlg`#whbQ`NEZ}7-e{&}g$rc6$~UIIO_{WpLe-x+CtOIU4M^2Q;# zP)tN_3mq82wOF*|indX|YFtpp))g>XW+*uNkzsa!NB)Pvdm2t>QVk$H$S*go-WAq? z1d`_Go;p&I5Br|N2%>Efi=&`-$p`1M<%4qD+0q)PVQ^t8>Fm^7K{d`EBVVb+!`iiE zWTQd|3wuasoyT$>5|QxdF}1!p`*2NXajt8rEUnIU2*X=u0#GoKg9O@K#mAdamz}@1 z@i(VW3Awh`r`xJP#C$kyt8S%)WpD8cneU&u9m{)CR08ZRd$RIwv=ho}ICTEddHRSoN;~+yf~P-)pAs?d>){C);KjoP1I?Til1|EybU*9$p$C+RpkpzjMGmV!;3#4Gt9-N$3fkW>v7c4-9>l>t--4EtvSJT;7DK9J#>hfgCDSk|AI-vJ;kbx z%TRtuM@el#Q+w7^f*M)D>H_bj#jUe&+x%>HrpMAEEFaS~*UU2DHjQ+NUq1(>;^UzW z7j5tABdUQm^Z1wicp;X1{;CN-Xp4qU?v;_&1_3cay#JCGD5&tBZ*AVMWIbIgkKtns zbwcsFUF-siQY1H>(-A$q&8s8_kz!$AJ073F_TbADe#2{ZMnjlGa*clfHQ|iuDWl|< z_Kq&=4Ueox;)9RPCg;jBjHufy#Fk6q&+h71ZW28SOGY|f@B?N5w)z}5sdH~fZE;P< z?rGQS<)|Huk=A%(h#w^#Fz2n)_1|GK?PyR}62g{A&m7o=UlvQ6fK8Btk3Jg-X%)U8aLB4==j#vXusisPVBTdv2o|UcPzNzMD z#K%(x{wP;-7f6`O_N5@njNK=eq>`cBwLH3Q5J8w(lGo2;KIB%$l?!h$vFLry3@tLb zCD-vAFC;!mee)sA$W&{~xRX+?@yN%CE5d<1`O%c?VY5sUc#pf|*fweztXpvNwwaZ- z(lzB)`*i)>NYGc)SHLS%PPz9m%UHZlj0omi&0aJBpNvSy>*l&|Z${O15Z~*7zcaQI zpcJYeuGhx7Y0GPd!TS|Y$tbDv$;}+`n$Yy0+Nk7Eiyc|js$Ec~$?PG69aSwjwG}!c z6yEtpv)_nywoE5L{W7_GG*dzvO|(m-)g(Kv!r(10;?H`~M+zHo1SP{RdoB#oAnv4{ zjx)aWAdI&!cJu|O0wN0F-U$Lij=F@s;L2(4P*#fiV(oNKgd`4)Rxp{6`O~D5j9>JS z<`wUe-?iH5d5ckT+^?!gzM%(MAe_6yUc;sKxcm;xj4Bg#^`R(7;5E6l=sv`KbcsqU ztAa6%ESgim)56zN4KgS-N|Hs-3by*pCdA`OTULzbL4vuA5mrndjy2OiyK_#Yj zM4~=VZXiSH;WPpMjZ~qeu;KD2=IhRG&kL>Q<+V^xW`Q`H_ooTUd~~)-lsPY0YPsbsO~6*_>FfO!?7?f&#YRc_aaT*tC3} zX;%VT2ChKB=aq0O4H2^fPWH9GQ4_EmM0BPUGhrFFgiudwrb(=?6fWgHi|xp1y*>14 zr_fC|_81fxzjKG=|tnTRtK!4%V$KWf(CI-yE4?ZOT=8k{faP zg;j42CN_Y9C>IYT?0T+8^xE7_pH=PoXPP&@_hPvaXJ5XO+kHT}LVHtA`QY>Gig{`j zVn;Yr9-e(IcA)(k`y;30MsYZ*Y*Dhj-`*-FBiB)}I>kC1pKc%SPLhK>9GCef$D+x? zkCb||3POE8x05eb^fP?I3+U+ceW?{P?+%~ay8N}3}-?R>XdEhrtW zTH-olrx!Or&ugtBaj`B}K&*VuFXBe>FPjZwFoO1C_{o94;+`KYgdnDu#F`5$I6>kXce_;V@pQu9ezd7x+^>zk%t>d_8{5fy8@|m>QrswoQKEY z^)GGlNV*bPkNpjsR8h+0Yt5tBUo=oJ{};Pv)mR~_XAE?a(meB7d%LG^G`2(bd?>cP zB~z9VZ_MZI_vN=B`z})^fo(_aai7TbxmKP_&ErqE2|H`o{l79Ot!#XQjMabQ6Zpg)H6fy(nbk6Sj?wv3XUhoKe z7tHg_g4(g9RgK$9eY?_z7=-sU4Nus|&!KJm^s?S1j6sJGXo*~OgpLeiY&^P%F%9)EZpn`jSe3IE}`lyE&qzp7V3c&>Xt zXXBC+Yjb07ZIs^J%Z~YnP&8QX@BtKg@A4($`UI+}U;Jjps$zx84bZEA#+fo+XYs0U zz$i+o{qnfilJ$s9+X^D6(~8L)`D~r$hCtmUslJH%y|{>i@b7XJO#K{YkyWls|CD0W zJ%bfiZRn=gtEl+;jFl}`v2S+rEQ|y8`@;157F#A99kv{^}L z4=$1lj3bRZJF-JZIgU?U(7EgFO2tsa zGNYsYX4gMr|JyD|qpg8`d5?4)YL^leiIWyj7&08@BFyTk_Q^V)qQu*>|FG7SM`O|T1n zPuDT=`7ME)ZvqZGM4g*(q3LoXqH|Zt*QW+ZS!09+8Fm!O&>Q(}VF`|;sC3~_8e#H2 zjd%kqyx|SJ@-Lq#_8x25hQ6(9tJvQjCxgw`%TN1eAz>p%a$G@pcFl_$|T6<%s!P6w$KiGHL+q&>;`+^@~!i{0) zk67~C=P&@ifx0>xRYx)Q9p*^szo?EuXX|J6cm6>Lk#NWk@>aG|NVf?E=j|I3z)l}% zy8U=kRkjb99|N{npp<3T zPZV(X2g6$kdBgK zFN|A<-Lg2ao3C<^?K~UC#YsBbmoywZ(*u0!w`N0FUnsQQ$5A$H6QM4PNptSlKzP;V z=hgY4`Cnaw6c)c+QIMuI(o0V)FP$a8mF2QPhP^h3;9JT9N~QDdxoGdvYqzjc?RYL! zBuyq3k94#VbBk-n<$87m2s?4k25&j&59;U){ER-Do73&+p2oQAm$y5Qs?9xN*>>O? z;@BVVcV<~lI7id_tjiHK7X5B?11@ z4y-s7U`ma$Q=|+}nL^B&18oIUAv4i;W%a99NY)m&JRB=)V&G%sz{i0Od|b#ORN_tZYj?;zCB+Nh0n=hdTQu?F9{JAJGabraeYu(20y*%VoOCa!9i+x^^vLz=u- zA+hi2Y2JL*!j5XE_eel}emwE=5=mi+i7ET#_ak}ABIVB2RPf};u!qYWys*m+@vXl` z{Qf5ver`gu>{Gd{U%y(vljnA?)hTB4$|0x?c9QWthjxs$S%P5T z#J>bbsGUwmy0(n`j)eU64}Nm}_4!JXmAm~-^d_k?^XEf=%v!GX)0DGTynJ=xtV<}c zdu1*Gw8qWWg3z36d>p&xh(whgfG%}#F+P?9~pCmwcI&~vli8|FA>`VN?!x#Q5=LblWc zCPtG-a~eRJZ4Zt^LY4c<<4wvlc4!SU=M^4VUE*~?F#OX;)oMQX7FeT1Z{+_qn1tL< zt*6z5^0e}-9PXEaz4gTH_!^ zC@j@RcdeyiCbY-B0j%PH9->p8ck&m@I8S4zU|rq9CD3KkXF?x0p}riNZdl{d^#*yv zD9BX{`qcD=Lx-7e>n9LJOe2MB>-Bx6a1j%Fx~erdMgGBvl=xvMVa8CeE2-5_*4PL3 z;Et<79tL2X14zYZE-Sj{{IW3+#pqxw_E6?Zi%|b!-+s3pt_+J zgp0s~7G%hPMg9|`xe5>bH!1w2tm*D8xexd5N52~kT+w%2Dn-}vv~9(E@(CtbCl zXnR+8pME7-Zy}W>u;BR;<_Ag`g^GptI|WoQEUBUZ1rLYz8!|swuf`;3nhzPIe{JxC zjo?R0jDIr*(LewX9x$+{7Y6VW%mkEi5z&xS($GUffEpXtUG+v-#NhpdcoZ7| z)-&2ezzKDr>@A6Md+sN?#;;YefeVGczj|?p*{n!vuq{gcSwuV5$Ng0BV8V1aVjKBM1%kR0F~$cH4dDejj0^zng@AZ6 zWQY(jj!#&({ehUqUNiW%Y>aSn1oPgoq&3N9>&A=Mir$<#W2 z>}0s-K*CJjC)dF3j8Q;X12E7a{F^(UyAIp}`X$3voXZb;!B{Ozn~J(*zuG(l0~Fdy z&XBv2g| zqFBK0FT$6zI0Fq#Ut){qp1=S>B+0LWD_%_9XXA*T0K_?bda&aLDtKS7{_hVUG8q#u z*6HOP@%!~V>g-%p^`AE9kL=fNdKAnC?j0&Bc!()E8ITe*G`5hoIvUiQIXV>Fdn@dn zzjCvpn}yJeLSviChsI#8|83rHEhkuj|H^{sp;$D~+i#&GY#rGe#w*3gZ}rnI^)F}O zZ^gs!!ka&5(f*>0Veq)O zP+Jpg26BSRJ3BR0j69?t#owW*6Jh}uIGm`y1;HQf5wiDl(sD)$4J61-^2e)bui-yw z)PK=fv&#@~pSDBOcixb`_S3x2ib9+DI|B~XSa4I}crhx;=|yCFlu?hQc>CWv zV*wFNFtNkMKyBEdK)h^WU#rbQz{r?n6NBHFAGm#g#D>s=hjK<4j|jcjy$qSSCcjg` zY7+gc{XcO7?#p3%84rqi8;NG5aV*48lUMeQfae63qB zOI*%KXb?Glv5|0H_;?@IsSraUBDg0S661Y^nbN;0!8fWW$ecK9#rsfpJ9=r)NhyG1rBpMnRs2GHb+Ie4 zgsGmz-?B}?>R_PHRMEN5Ch!f)W2tVWXiIIuE>me{qnpyguXmDd;UU-W`hI>aajs*^ zy3{hnmeQ3K0tk0(-&HxabHCT;;zml4$gD47s~fGXPrhk7hn$;m&gqt@v!YD^&RmGQ zT+aaMf7>)~{&%sxl-&RlNWwZ=kleo+jhwC|+~82~YEpV%n4~L6r@bjl>6?3{K&wD$ zRpYOQLReYDk`RLtZn|z{x0A!n!4yO2g-l8}opH#>kMrvKy7}>+;EyVKFyG;nd-&3s zkS$|q$IQXYO;gYwInvD+eYc$WS3$0)mK`C1XVsz-PYUvG?(DgAN{GTeF#PuT(?G3; z-Nj2Fd5tSM-s0TT?7b-A!tyMQzn=rKgV^}`Bpe4$@R)G&*;6Ge(F38dcS*8G5h=)B zzcskG_aVW8RPg}`*Hg$~R!Vsz1J$qLUM`F2HTp7{EXpid5%9Y~vUHx$6ZGb0IQgBN zZ^#f&w2$Pd@kO?X@;x1zt(|#V*A9$RLSXn6j;=~>TW&m4@_?wOyZS${u z?LP|1@R0Gp)aU(QueMWxB?d`PE|`a_g3v+@iPpKWpz^7a79lp=p-pXL8_b7YPp13Ix@Mxw%H(JW7Df^%q3QE*A*$CB%IeuA9r9$iJeO`}mm}kiC zI8u+_s{YtU*r0^-#zgrY@|1D`c{Sv&>(o{2qYJ5)eG-=j7e zij{A?sZ)7OGCgb5zHaeG=pVL=L>n9dL}7+c&*;rDrK1Sk8-t;^_NE;ZV4y@h2-2U& z-W5Pc_s3}frL~$CO4luznz>oNpB?7^#+0zJ4ZHfWTX8snqt_c`vDp^7tlkwguJ-D$ zuqz@rLA!WIEhdKcF97QSzArubU$2jZLt52D;qb)2{Y(5P(<_Lht!5A0)EYLmkx9~P zmv>irb}6+?AKGRVXI{@KQ@$K1_9F3g$)`USOG~Ff?dH0`uSaUH`@0NyPfZ>?#vz0~ zXp6FLjJ5dm+Z=!YLgndr56v6*hNaY@X7-}$i37IPLa&a2GF|**LUpTII`#4yIPkn0 zPva1J*2xSvCZOK{*aE2+EnX!&B#@Y^0_zl+_k>Vq#}T}-#<;Wl+C;x zDBMEgWko@OC0yYMo@Jtff^!*FL{*4}56Kadz=OhvpK0o`9^b|_dMm*Eb-;X<=q zR5>?Vy2Fvo;2ByiS?#T@?stEILAb*H6#`v(e3V?=+duO|689{3X}%=~4iq0GLIQms2yBNSqZq7N zqAO&KIL0D7w*F|4=KH76q$SF+2~H54HkQ)Ycz&W=fCE1Rc$xL?BAYy9ay=|`Yeif% zCF7NnO+#V(qknzz*FP)y$$K}r=L$oaHoW!Ch3p6s`!vo@`dBX_YhBgaRJ)9tB6FM| zc7piwMkWGr!$HH%(9vJt{1g2Jf9VHqE2_rAn zK)Gbw@+-V8R-oK4NxX*nQE8N{%N-zV+|XNUPf_Qi+4nNf-Rb*-#O~FgNe%jtu&m43 zEbH?EKkRtbIKJllY-_$#I>Sf^Cws!zslS@)ktJMBAP_b*jcaG8 zC|Wk|lg}MznBf^|sL>Q{89FLsuPhGjBf%IIY~Cx?3=88{6`z3{AGg5b?K@X3LcPiU z%~G3!!(Eh27j7r*eLu+8`DT45QH|sp?60Vu7l4Lvz2Ye~>!Hjl!tw%s=WkJ+e3{AN z)0diU_n7x_JdQf%jz5!Bjr&!r{y7IOVB_PiWKfuGNK`%X!h#uX>($ffNz_CK^!(+?bg@7eH+ZzH>$Lm@?j>@nyZZ7 zb9$%f>P|@iGojc{1%cjrA@AooXq2K#RJiH+5t<+U^a2BGh#G*d2oQbfsvv7k3bM|R zC6a8{C_ag{^V_!y4p3J1Kpy~{Ni65I2UvB-xwB9IKgQ0fNwBcZvT574ZQHhO+qPY4 z+nJTNDs9`gZFKfTbj(D|chT492b}kbz4ux!h<4;nyjO^4gf_yEbLQ;FEbm_Hu7D7$@A5BVHrQUM~Z18j-bm@b_CjP#p^7XjKt9!}!P; zj7kZj6Ob2=${gl|SEHrz(b0#(Nm}IID}{cLkumh<-FYg(kT0p0 zVCbMganX|mz1j;=t|{Z*S9wg^KC>{z)+D@IRv?3T=Iq+Thns&F6b$_&TNvd@u<}w6 zrC5p|otYvWhuq)2$V@FHrzf8m8TC$t64VNnoAMVEjS^Z=PMK}Ji#u7E0`tu16{B=}wR<Z3Ccf;hjIemccgN8tDnH^VbE*jfw5)v+)udy*6X3Aj_ zZWTRjO|afL^)g#*nzjW(<8+AM3f(oUjGu=^)6c?nAS<(hTiIaDTLXg&99oblm?Hje zWo8eg82RIHXDEa&N3xVUVtPoS!Kjhp3xXeT@~!Z_rkXxX#M!XYu=ScGojRKG0-AO+%f_#?Q$)Fd#jAGp;LKjo_%#GejH zhw*qUzlzFE6>1dBiC=}=t-?}l3qsgi{RGr0 zcv!-DM>Hf3PMZG#c71<=Dba6Ll;(2Kr-r4HDsSLQTTV4|Y|UyT-12qf9o_Od1BrDu zN+)0bsy}}ssm@CQlZvair83`o6vV|FF|Q$+{8>>u;B4KUEqb8yA|;y1?e$RM2%Tt0 zA#1OI%2+G-Gr2mVJUh_wr_ays;LZ1<1~@=JFf-7W4ZP_`N_#a~x`boyYTV^hp6~(X z?ldjb1?i>MjNnf5wiFAChmZwicodU*ZRTtW(@vPa@}hppMhO3iT$-Jt+d=f zNA_K6cwkfqwrc#AzpUqJkqE-`H&5}gh7nD%a&CFoquygP%V1&m{k1W3n)a4XRV%2uVfnnyXI`pV z?73It8}po1VJcW036sp^Li(OvXWD||R?#UrRv_zjm=|%d|IAm7wb# zzcc$S_V0DlA;Z^I2H7vLLY>pBkkiniY}0FmZT2>Q%ltL$P+D<#05aun6@J|%m@$|d zBWdb@FDchab*wJm8y>SALb)5Dmf9>qU)IH!+&P=X75iSWp);v(7^0}~tAbl-%6_I2K_m~3qgy9v8rWZxe zord=#f&=juVKgq>PQ-CuO$qtL4}Pj=-5pG2xfc1>u4Dx$k1gb2AzH;Na#t405?c^@ zxQucwai$`N0D4GDChVB7>5<3Q{0h4HjQrpvSBURe@;&FMA~*PC1C6Z3T}3Npo8DWv z;yMqe%i|@=l~;|Ijv;eI`3!k#_R@O#*AyC*A62)HH@!H$o+86E$g>o)R;>9tvfHgU z{juVWJq1`r)Z{9!3Ip0tM0b}wIF$~ye1Lv^<-UC`Bp8~`v+FM7}OlnXtvF`O~^ zzKyx&k@<+U*DLlD%jbKxhb3E^?z05~Blc5cp!b#Hek87$z;vdPx_u)5Ig(vIA<3(5 z>_hQXKq-RT~I|Z66nmFcd{b35nzai$1VJHqO(i4xN=J4r}ozseAu2 z%L@e0sY%JHl!C887M)}-ga%SB3|?!q%q%3PSw&Zn#OfAm$_E?yko?L7;iU zHq~&^x*`j?%n~s!jmC&&94hmIX_a|_hIhJxIF_F~TETKPIqP66YvWz@)pmOP@h`dB0?&eM#SWM{yKe(>PveL>X4zY~SReZS*o|2Y_~RKF!A&03ydfj(I~;0io#J#Ysy5UM$GCM_>f zcJZnr*@JGCA-$-uNMO>jBe9h%Ukk~ArFU%0Dm!8BjyUxKHT?b#$!^W*S6tArd-ebm z2{Reu5CWgb{p_GLd!LfEi!b@laBIVsMu47M%vBo0tAQu>Z@Yi-ug89l%V#A<$g#L& zY(>cD0i%02_3n!D_wmNKw13d0%6}2IsVAC4wmoWMZxlMgtKSYK#8<0Qi}PrizLYLO z;~#nQ!X{M ztZWI`^FSnp%5~zZaGXxAfp;_OZ?55kEJ<%{gLIyCeCOyxPvl0MSl`k|&3Dhqmc~== z$LURIqZNBTosE`GHLo}$pFiB-S2dUce)G=gJoozS+Y`?p^<28-fw5RT-sW*lHI78s z(ry%4iH=R5YK0noVy0G^>;+<0lO5L4-#U{}@Y-yn^3+PCmS#HM>zdbX*?P`SZDX&K z=+}Ln(>f?)FeyiphuZ(`q-F|h)l&blPMo(~vz{k274-OVaA@NvT_)-0=YJERJBVv_ z0zIyGrt8^1heYuivV|^PKdCkETzJv?2UA9k*-5+ zOq)qp*tBHMNjbn&7?esx+|uX(h?QBQY5bqwO)C<|r%5S)G+PW#kb8&cd(e(Yg|7Yk z8~}f~TVTkBfp)oTeanU{(~*n+*{8&`xf4!2W<_EL`Mp6F=o%Szf7Hpxq&cEK3*9!U z@5Cn^BDO{-PuRV`goG9r;93@^Bt2U> zjnN(CyDWq;Mk*k3hDMx;uk4KskXLvEMg@lPLsFk0?@Qc=cc;Mp>znZo+)FV$aYbb zNXy{7(TV%lBX<(gxWj!}QqisV0dIdN{W7_z(>0ZUkDe}TZilja)q^w2*#qg#6*eRl z5J{}I&INtqSr@MwHu6RmZKyUc+PJn*Ris3Zs|d2emGJGsVEtb!*qWla4-v7Ch%5INj-&*J$t%MO9?0 zjjIIBNSe9@-hs3Fbvs6TT3<8HfOZCExp=)Y7vQImlgN@L_}rdYzr0c_8oUd?`Lx~e z(LXI&XernT`y=HJ{0Ac=AyLCT!yjMU#UvY&Y>saTPb{q(rx{kmh5EkeCTmFet5Vriv1LU$Mo9;60V1x_o%jBJ~KuXsAnSSa8Zr<{>*! zEUg|<7gFGi5t2{1jmYwQ*B%WiaU&+(P+D(ey)PRrt?Zmh^lmsZPj6!)So&`hnGX64 zdKB)cfBoZ|$r=1hnAfX_%ZK-a(=2(V>v#Kv^&}CMebR~-ZgG<`=yQu!PiY2j6Yn48 zbncGEh`69A;ikaNL7&J!6`kyizOV21>4p{dJ}fg13hE6#&Y|uSY4}Xq+Y4cMQU?Yx z1vSysn1N>{FE%0IxU>9H2eCqBmoS+YHfI%a-^;p5@v-8j#v-Swy+3CQO9>6DClfbF z!1H1E%)MPKui4tQ2GJ>5KDXi52+yAe@X>e*#F;Dke%&6r-JP49RF*L zjLWY^#&(0209VQ#21){AU^a1nYYT4Rzb!Hh60IT00rMq^^P~~QO)ij9?(R@jpG7@4 zA73}_(^@Chnim--YwDXXJ+um6YSP+AD!=O@VL=Laa{ z<_3&0j`@x*GinDS+A)COaQBl!5FZkxXdwd_BXnX(v6JHV0g&YjzygAEB{xYEZ}TEHe1@ZVWb*$9#6hS7Fgp-l2=A8$Y@(Yl zfdK*oZV{vir-1$#g;2*VfDafbsJQ)O)kk?2Ak-cO9GIJ%>tlfK&IdBDmw5r$iyY2+zzX=0^g+Pas_wv6>PL5kM`$tT+ZR{SHlWK{ zlKgK5Zi@H#*%jPR5GVmc-u&;LAMV>5dLaY|1L)v<0JdMiLG~^G)*Qp)^$fe$t3*0_ zZ#Mp4UW9<3m76?v>836lLffdIfdy9f|3P6ZivvBPS;a`T%-*35?zk1q=`X z$b9@lBOrhu|JFIcf$w#&AAc*=JvWHn0sc-={DmEEzxy-*jvpp)^xd8ACIpKmA;9b( z#CFhs4E!Kp0AK#nU+!Z+vU~qJKL3e)?_ew4JGg!09)IHg@b?>_r#HUnLt4yv<vG4$b`NGyV?FlmcLGFnX5W8VSqA?7^WVWyC`U&TdUZtt{Nr)1@zr#uT|yH~ezQ(+ z-LEv!=&?{EVTdxaNUaYJ+vRe^$lgBEV%qdY$)&#?7BBbC=y2nYec$k!j>(f(ofzEz zJ8b&Hedzmjc7IsJo4kf5XwOfRd2bVXNg$YZHf`)|^YB3*L+&3E*#d2sTzm3m-=3O02C(fhpFM8^hk*-ZmWUjSlJ?AAe`>RYJQ(CNBw$f*ljx@EE3D$ z`rhusIwrZ%RChytp$V^vIp(AF=Fo~_a$!Mk1Lc-#imzPZ_3v&sxwmZ3B#Tzzlnt$Q zb;W3G{Dpm8>=FavRGN;XeyAd|g?DDGr9rah77kUJ%+{#WgJ3l z*vWp*(^jELsK3j0uut7Yaf&sI`iFVVZ7o34xiL7@jI;mdMqva1?)phVFbMFAiACR* zUk+`w9*ycMeNI-Qf>9W&A|ENa->mTG4Zss$rT~racy{oaMX2JX=69+##=$b<%OHI% zXa_dm#S@q<~7{6+>4`_Ni66A23d?)z6j_7JIL;H+(R36Qwn!U6PH53H8@RnAhTNngN}?cg7POBgzrkmn%#7) z=W~rlPc~S$u?T=)StxR6;0*f4Yc*kLE>)PGo$7lmDSeipm2jNHF1`o*v=2a!bdoi=OPWH3ls80>qW>8i6`PMb3q z^tl*l&A#VS)@o#b8G4Fvm?oGmCHNnC!F){Od8_(bMLJDrTc3yH??iO!LVn3oY-3c1 zcGhE2;F$YOXD6%@K-F3*{-I%&SMaG9)A?+F#kPmb1-5ye|FtoW;$ ze2lVtZ4iB~4}0K{dMIbT=~JS5|E)vu?e)Yzo%guEMQta3pw>56L-M3-WymB2L+`ZwT3RZC}0 zjjgTcc%`ZAWK3o;=-s#*KB$Quo)L_A=q3!}vWmyK!C$k0d&B8Z{SZF(Z`|ofVq8lD zX#P1O&e1st=gV&KS(b^ayIykTAj15%S9X-4X+6h|flmKug|96~#dAk1N;l|tHs&9O z?unUMVl9qJab0}HwCYGiW|m(VWWr9}?7JHk{g#nIP=$0nb8x-tG^dS6HtB=qu=r5P z{FD-biP=KJA&bSeTohDWq<)P7A#k%aL)2IG;Bp%cHfD>-RP}KDS{(T!4=?mlPRhkS z%%ce^=e9}caBO-ep}KEvt>t;{6M)ohE*3S|nBKwV%$xr!qBsp1re{T2#n z%X=wr?0^M-ds{gbA%Q_1KU$rk=7B+bvpGG$#ef!MwO;$@p~|p!Y%Je-=bJ?a>V|+< zy>mYxb*1+%0Qu?DC!OmJ?JE7`G>=JzX46TzKuzkY6G$8}( z{@|pNSdgbOpZPSKV!sP3(+9g>0RCu~NOPbetC9`-E;yUc%;Cm=!Rc6EuVQDZ9%CVA zJIydrYAUmz<)I-twd;3+Nmw69wuQTHvJcX?K=P5Tv?hCS57~DydFn)L z9A)jB9T<8?j<)qRq8C7673rNr9Wdc0qG1|tF%oJvKQf;?bB+wuQ$B%dLP%^y?$FTw zX5q3J1@xXST#}u1;Sgy`Hb#!DMu@qlX|+sp_E#9~z9Lq)Xn305{a0c%1dHW;e@^q# z$ZS{uUdO^f&yQy`l!yCFO1YZX8M7q(>a?^^ac>;wlG|)Oa`_2sixd8#Id&rM$DE;8 z90@1ZX$#CNx8NN;6jicKti(>$fXfD7x9CGp=RmB%Kc$k;LRXGR*QlZ` znpUa`;5UGk+pxO|qhtrFdK;*H*=}{~=)NJ1uZ~cogOXIXLnIselWfbek)cF8=ad1@ zP@@OwX^bcpz1TTH^3n0>wUrpsvA7TJQ=4fewsU&juvXFG}15(RMzj7?WGlXXg+ zAK#`7e8Xvr3fUadl*1_Csw$w*!7WpqaYvRlSV2i)s2X^raX69XLTOb@BmwqR;p-js zGpPmqvW8ngBV(tOYfZKVp}F;C>jxI7?Z-Uk7z;Dxnp(L?CQZmpik(*!dBWTdspqC? zd_l`I!D>2ExrFrHghSZCZP&e_WRT`k#R6n0cT!mkl)1HsiG@MR;8aTic|K{~NwHD9 z4C>}7tSd}TDSBh+t>E#6)ifYxcLY(}q}NF`YxC*UKFj*RzY3n~=vq`J5jmOQb?8K{22=mL+xbJM#8A z-n$)&_LZS9T%#{Xjn}lZyZhqktV#D=QC*bX%BOJDP5z1tyh(S6vF>#y zPi8ubIT0Zlst<6BB=bSc8F1@cLs zqfs~dYt}($akSx3e{61ZoL{O=w#+YCr7B+a(5$=g5W1lk94*m*Nz8bPG5(P4CrM&*|ZfbCC${lwNPI= zgsaDgN$O+F{m00?&)qDEy+2Z1H0u$d%xSOe&Y(|rvHm%rtpVUE&^^YbU7M18dh>Hn z*o#mnn~_Ye3=O9}sfwb?D`b21ZTmBTlOaD!kx#)OuI=69VHvLzInYe^w9sBB$NCf< zMr*jNBoCN91YeN%!WhGpE+dnUsmJQ0yEat=)=tvy0#g4`Epu%P3>Pg4#|p3vBMuiz z21nQ}8<$6a7TaQ(cBNHYkbYd4;-G?s zz8M90n|ete#p9@A= zHab6f5rH*kuksZ&2%@`>rG&Tm0R?hV32pvKE2-MY-*Twg!L06E>aE2tO(q&14{Th@ z{hC*OI+w+7S8f{j=E%4;ggUW6aqa%}Nt?~cff=elwTpMc>jSNVu`765miP6ZVM)(- zdAF>NU#t{fThvgPQZMCFZ^2-m+wI?Vyt)EuMZA3ub#0&4VwWtedc2{Ct2RLLNBK{2 zl`KYY?KTTb4kQWl3oKHVK}uq&s6+k|%fLY&msn_-y}O6k2E0l)QB6;EmxRwU(m;i8 zU9TIp9NVUd?5M#2OVKMGIKDAOQpHU>Hq&N(yOE0DJ6>W@ir<@?;VL-nV4M}Da8i)j zF=c|>!a~psFX8bgrpy?*-q%4PDh3Sa7Z_Wsi?F3d`0${VLJ-DX>%w@+;G0AS9R~~i zu10y}a@kDjZh>f_Vm<8~|0~@!3WKwu!iR==$eiB~h3=vb@%I3?VlYe#tg5d#f0@g# z@5np#F(0n9Le-_o5!N$B&U16dz+R_Os34bO%tzL1@$=Yhqpnc~d#tH_7<=gBY8N(& z0egPxn`iYkH8-X_j?U9!A#--7$=!=%4kR;;h|qINKZD$dq2EH-nyk8x)0B_y-$J2s zu%bs8{%3gvHgL~^KEJj`^T1d?e=ZR%75OG9w1zxKXP)p`t43ZisZZKIK|mWifq;0* z>$L_cM|RZ5#nDAd8>X1ECv6J*(Z&LMu3MN3-jVwf)v2x!X3>|JxKz9>Im z(!cR`yA_v)1z!pAb%TT2KEfRIpaXnogiBPb&@~lg8)eA2kH@2B3#^}-KP^!nF5Rjz zMe7&wii3X(<%)74$M(bsxs#!klF~wHNYc@-D!+#ObcN-)B`^48c~dSPJ9(mBZ@ZzH ze@M@u6XOs%PQ_nY%rQ}GroQr0 zE6sOdffL)lAV!`rs+Vbq-x3lvx~9@Z7<8m0S<8n`=vh4!-SoH4xpTs%GDQJ`1-h1G zo3DuL%My*Vz9>@-SWS?rT*dw?14Sa(aQ zLbf{0F%pxMYzaN!ll*fkSlYUXcJ%YGdrwUcicIwlyyX@s<3uv)<%}kyuDpl-)D&~t zD2yw+8gt_!{FbqPm1MO|&)ONU@1crG`8zc1mGZvy5*QqH2I6Sn(rlKwDW9q$)$xi9 zwp1x8-fT!*%3kd7)=ftl!Y$`}=w@c`FC4K1-6Eh2Q_SM)`kJs6z^uM z_!SwgjLgyIL}&$Bi-Gy<U|qvIl1*z0#g1VzsO+d?)&gD#vD82{@=mN6ya zwX)1+Cra{1np~F~1_|Io9K17^GEqjN9TiXQ~~j9D20LPXoY>u zHWy$A*Z8kbqZYeHwX!%1@i7CAIr#R-@7|Dxy}Cr%stS+VMNQHst@EArh^RB!3^N#7 z%_GZmZ`WFyX3i@mL1A~%=F(v&bnDLJ=L3Dp86tBR4J{)5RA zsX)+$@MnL!T$rn%Y!mW3rv_<*(uF`t-pD36N7p?5GBS6ih9y;6^2*0ROoSTeD{6!yjED}^t?QcP(lI? z__W~!LZg#$*4EbMd+yzTwDH-m!t?dhoHnFwhu8QVQ4^s}(vC0KqNhw4FXqH+akC$( zR>!kqOc9o;Ty3jfVR}j?H}nVbCw2RxA$S_2tBqC^7f7jdAWePlvYSV2z#i5}A$j?I z(`KrxS-%(wGI}3C4yMVygp8TiylZXA*(zz&{uVzF?BmKpzLz1tmUwAoYp;l}dTTR& z9NIWi{18i;387|F3z+mF)VOz7G~w#s8^T-e&uMq(9@Qz0!_&msLw-hAct{+$j>qGm zzBvU$SwWHaWOS8ztFGJAm)6KwcF*V!VDUt9JW(>hef80roGnc^ZD@7{zSV~roK)pc zC^n8}K?67~+_?@IoQI7h8Cjac8qfHM;nMz6tdHI_-~*L|F48{OYml7p_;Lm-S>fJ1 zl{zbJtyo25LY&FH_?b4CR%9J4JkBx785_pejK`9>$e#qt_)0?BUX7u;_cd51o|ooE zdQwV9zJmza59ifCh`^n(2Sv8dDZ@M9%%?%%ne4HV6~pxGz4c${2!>TGBGPSE=vkG~0U6unll| z5YG^d14ysh8ny!XolsUMdr^>Q^)AF0P1Hxwc#R&b676kX8po5HxZ@4>5Dhk7U0kaI zO<>U~WR{B~6_jTw#t#E3`gj;m#KZt?|5Dl&70`7{j#c^cxrg)!Yd701&a%V}=@gr~ zWVFW<`XIWRtJ3vO#u)ihO>yBiqoKWzzC=-93Y4We?MdxWRFtHp@?&LjCAPPXI|&gF zD!S~=izGE*xzjl0JT=JG9xnSZe*`r~_8`7+ZN^D-aJz{W%7*E1 ziC0AK3`qCf76ibW!xqI+Gm(jFLiT@OEz?f}>GpME?Kk7`@b7QoTo1ECBe5ITyaQyg zXe_SGDrnneQwN&a?=;lLvhAuZvrvkjcuFE4ZB!|81bKJQ3m3}x3ezb25|}a@-T>5= z2IcUG)I0dvnKHT&O(?dW^s`)Wy3XCQqyJ8A|B{{F-A8xV1FLUpA?8^9nRyY=u$((O zzmUC?0yzns)M%-Lb%*hkxKlx+cIEHyoyN%GoXw%Vu|;JlLeq2HmHZaNcn*xBcY=%A zn@;Z#{|XBjnIB4OO;4 z*tW-GHF3gdaS=64rZ5F+Z?bKOf^CZv=a#O=3 zhI7@k$>RKqGvmzN^tiqP7DTTuP;{H8Szh&HZgk-5Pxw-7Xodd}Y;*jlV4Inl?SBTYOax4<|9AY# zOu+Cz9|)LPm|6d~!FGx=BuBC}b`3=A--5&vpEYBK=$zyn-W;TW^w+=P-i zl?H0>Bb8yLM7d;L6L%U!+woMXBns^xb57Uq@1KtEi+?qmJs<5iCvV#)?Rn~6JBHk% zyhtekSjve*a}}kma~rZVQ9AphzZ2k;0&3W=M-&NTFA|64?h$nWd}nBua=b5;9y`>d%kB< zD(jA0UlargMjn7I1h~bZ0VD>lZ~>^>=$ohNkc60B{L}L=pu9 zl;0>w62QByz;0$}0nPXln&{fq&L`C;4c6hx=1NPaA1;ID$4<}3nD>TmK*}OH7M6N7u z9;q>7lnSy-*#?So$Xy*c2x;70+P%~kY-W6C-a{H)Z3d7g;&ZZPcuR$ELgB}n5!;H9 zc=U8>27$=>j##-aB~wypYnYiLZBv!my-JbBFNR?-lA!)FW&ZCu9Mh>$= z&f!ainMkxpmj!YhBeL2;ceY!>f5mWsK6rNFyG{wsGb{AkTX_b@+nBVE#P_~uIJ5D! zcd@ggy?dg>3)BttzUubP7(x9|Uw`>$bah%nUr}#aUAGnc)Cz&h5W9JiJZE*ld4G$GvJ<+;o|VBmHVs6ZX>&) zRPMtRx$@t~R+kz^Xva&%G!e@KT=@pVyQKPZIbEo3R)bNLAWk>qYeSH}W?4O8JyAU* z`I(!M_{K^3qo29hd?aIQ(3*Ai?t~~yp5fQQl>~K9kNt#hk+K?ju5;yvz)^)dGFIxx z+5^u1yNJS9R6%$gWJmglmo$P_|`Gn zIOizcNxA1Fe-QiIZ2ad`M80i%P{8Jy+a3)-67rO3dwssP6uSBad#4ZODyv+g#HCE& zEcyHtMVx}Tk36Tx%2wG>!vp2yaq~Bzq`TbH`dEJUJ^Hx4s)#4No5ULl+W}l3!Xtq>$w~S0-}0i|;<^WGat^-fO_Td-@h_ zdi_KywaQKhDqc|%c}I6xR+C3q>LdrxB}I^X#0+C|Lg;GJ3CkU75~2 zTF^*M2B)y>VGVK(9E!&A|5grDgeHolv-`HMD8a$68{I}5wc956?dPE*l-wPj@h>hT z45A)S$*(f0omhBSJdBa!6U&|+r2kN6i_VBoJ}R@Z=Y1=;p#9|HEuTNpY2 zV%POlu)9+)TTOdiu4x2D7PUbx>*swWiPBHGbhL_|gM$2Pb!2ZQ^GssO%r)F)A4d|k zH#yNiZ%QzXMt`EVKEj^L?t8Oxjs%kDlBam{!KH_}lDJG}jhm$SZWeTsNpJ4OS~cW~ zPWf)Pm+&2#z>}5OF%^!tg^lVf#>31OGzldXParmgQ=+3Y<3nU7<%a(4Ip4`Rk^!AI zU@zy?bBiLAc{D-JAx_4-t$5t8*-NM?#pqS7KX|ZNght+?-CxM|{HG0eWUVtw3FcA{ zAGboZ{;-;xkCHRm1^e=_fP5T2O_+WE$BoP{}gpG?J=x{+`cFr$y0Za#x#q_ zv|piYw++Rmg5R)r)@GYcbVqrS(^**j?*{J{+5%>1ObH#fF~hBs-u5NdZVdT!dNq@+ zu%$8PgPBOiS&v6-S8{Z1_}B@ukpbAv`$^-XEYBaE|Cl9Oysm|NG8*yS?#a~Vs+-r| zM14f114_r}z~+FlFl>z-(>XL?s=jrr;qCpg!@WRm{OW=+qcn%wgE~+W5ve-yT-z^c zxp=#X)!9j_rP3pMhPd`c{V!4*P0nj!lA1l<4w7nW~IJ8tb-L*}e|e zU;Lk;_TQ0HG4Fv@spVv3;H;H;(#Dqrz}KeL=FYFP?~Mp zKw8-n`Vjq};COG^%WGE;Msd>^>Pf3=m~w&{*KXv=t*fTLC>QDK9->7*bgosFcT;W) z3EZ2NWjs7>?7n|1k4B~s(Fz8!jnB)T@jEHCcayBbUFz(eer6>6tCl%z z(aW4me7yD4!J=}OHS}KWTl+0Ecb)6*hg+o^tAYjtHa1!BV(V?mdybo?{ z&ZdN=bI_cmx~5@Mqn|j_hQu&?RH?Gf4LrNgPK|MXmnRCyto6}Z*aFmi5}eo1F;Y>pXmaMI+ zCds}yvdXv`+iHa;v6*9yugDqBi0d@mveEct-Z;WhvKhb~mxstg%jRPPV>nXkV|*Sh ztCoH1mX+?ti89G1>RrAoo^*Y2&ut@%)&|FJJ^7_@oIDu~VLi)rT(2K>S6r(?y}wV{ z-Zxj{V)R*LJBYaez65Qmeym-1u{wo;h2G#5?n+6umQQ%Pqa7VDJ4? zE)fd6TPf=Smp_cbj$?XiJf~i>VOG9lR_o~>^M?DjOdNN+bHH`B@Nr+621;S~Z@%PH z(XCkI7&$VUp>21V?0>;xk{sAno~AxqYpwbK+KCzBKzTA3Lzu;_XC3tetoQ^!$fo@2 z-(Q`yzoCNz@r&E_nhCQ{ON@Yy zLoB-nlZxu_{PJ`NfHsjW_+pH2KtyaalS~#dO{d1m)V#=%dA*J;f|96kggeVzOMZb&cr+RCogQB(pH28!nf$`Z@=J^eoh5a8fCfcvzx<+OK`6uM56fuZfD`!|2; zWT;9=s*#ABqvc!9dk7+c0xjLS9XwpUTny*%8ibs8Qq0O`mqDzZon@ID^G4{pkJ`_& zW2-lsyWQTqO^sm%1+Cxc_vOjm=dy^+Xm^HgwlvMabd2SfG-gJ5{lBeN6Aa}VPkQ&X zfji}v_#8<-VzXLgTq)K)7kNvM$1xfCHaplIg=a$dzYYGC^r4&QdhU8qZ@Mp*LSt8w zdPWJe+canDcUX5}YOGA=>VLgd`&TD8HP23P3I>l{|3y&6I|I+?{PnxLUsqK(V#ZLK zhVNibUp^(=I?;@8>+_GOYpYkb-mMR9Ub)(y4ZWr9iA$bCqfNMe6%HLKmf{|)#Cq+} z*bs}gFVK#Z`%2{xjN3kB z275DIqMve`icW;_fVIYSPpx)) zVP5@fJvn5Y!A=T1A#J{5<-0L4hrPS0;p{BME2r+ca}YFD)$7SWeH>E-YpI2;B||mY z{PH{SiVp6?1xLr)FSTR7Fo@&|0j<{(^UR{UkPJS}c| zqv=hltD6Xh6<(QH@yauli0C5pNuVJUvMt9M_60>e=&AW?U{ycvX0ZSZQHhOTW@UJNyoN3?AW$#+qTWs zvoW(~2;@ z>U6oUq?}G;Gg&%Xb7{8f8=sZKo$R|a!~Ah0U$Rd3lUwMv^!8D5Y;Ejha9#9`xmd)$ zY-&v=iQ%+0sibsM&`Lh|1j)IEC(z~_p4$1x+lI4r@IY7b*V|F$`{a&Qs)5Y70c>(4ehqdC0JSLJ#ewHiv7oFe|9Lzg7IHEo17pLp-!2o|xzH#4!6zxRZ)xDgNR!0Ie zl9J|V*UMjH+1gHGsrdCb<~n}(K1$C^DT8k?GN^VlRR^$XCU^+4_;Ci=J!EU+bi0J} zI)x<|a=9y)zfakpMnc*z{pVF)jm?G3KR#^hWtR=11OO5GMFu7A{%$uM6Ws?G)t*ne z%u^%Z4Fa6}n5U07expzN=`{jJ>*c4!TktC|@*5?vU@`<~DP>hXJ#V>C6fVxP{=oUw z@M-@^pZv#}TxNEr|D{hjSpUb6{@)ffGaD<{|J{Oy;Z*g+QBciPjZD;m-)U#zXfYF} zM?$X{ZVER(PUqT~Z7r zJ@J0_oWAni+4=bM;_Khj(_RiEx04w7F49a%JWH_`q1rnfb8G^F7y;pNIb2rJ(GSAj zxIbLhA;QZaO}y9xROyLG+3Vvi1RUxtjMV#I_&*4s2w5`ZIv7F}siHW+WC?IuE<}Xl z;9t97(3*&l6UD(c0ip9ol88YnE#hrNyy;`eih%csks|^%5beU~NOTHP&Vma5CIShv;g38D79yO4_+si+J|Q%;ZX*Dy1J)Qm zSny=j=pA`5YPJv!Dur$K!uf3!>B+uPJPWjc;(8P|>fuZp()zV!?tY+xanteYL4KKtbSeNpgCHJEBO3ueDCj#3 zyXk0uW75|KOoM9b}w4d`zjEp(tZ2%S=j6j9VCFah0r82*AU#BPWVP(&u@ zg&+kZBwA(zj>`j~1>c2$?hgP;4ntwG1%M!Ci&m3aV;~W>ep+GyfvqP#y}0QLVj{JM zI{d80miCZkJ(k4OO$LYb5(R`)h5aUq@PE613j?mIR3t)_CO5_@iU&rH5CxWnbqo2z zlR`MWWAtQzLfcr7@IIpzibpIsXvZ&n+)6Mg)|13QoiJVGxZ!)eZ7mB7#LeJ+?KaB< z)cEl1>I=)}c*L!LKqx5i^xVx7$h%pyeaQHw?ymS($HQL2P<2^TC#Wjj^?t;N0~!`A z^gk?wEw^B-`@-#1lGB$$oL6vz{tdY~&aQ=>48Xsr>0{qHsoj@rt1Me@U5n^2UWjim zLQ(c-vpc^Xr@`xxO9pdv$kj7mjs1x`KtvsWbYy&>sx*HLM7M zljc%1)P2S3N*74&-O#yzF8k}}?QdwNpgPx(+$&qr`R@K+T)yh#(d#)xWqKlDXtsD! z72YqW38=_gc_TJ?CuyTPsFi%?&G%gz5wA7MTkpz>W?@>8*cd zbz@BV^Z018Mdh~qkURr>uEYJ%tbE;Yv=-xtomDO1kDyF}5GX9Rc)iEg^G&yfEUrQp zdJHwj@K$k2TjSN4YNgB3C%xS5Xfyg;H|u)()m;U-&di4(i5YisTyS|7#J)UJx>rnO z+_knpT>xs$tY%9~c4=NM!CT=eHQDEHt2Y%^(a>b+dxMN7=+p+;qPJ(a-V#63Hxrs| zf8DyrWsAtHFO7#MOnS4k%s2;gCA*rV^p}&(e@*T=%tL2u{ZqnyA$G#W#=iSA>91@p zoy5&vaAB=c6p^O_T9!gY#SinSot)CjUNTq8zeZK*5C~Oq%`{9D%lcc4?n8#oP+^v_ zH8C8$Jxxc!!Io&D8DHSn-z9_<+<445%t>16@g&%n#9lGA$0x9q}}# zkDPTDqOnd|E;C6{T8=HM&JlbXbQocunFiw8U=>;J$td(zVSnU>W!`rFZQR~U7m~Jw z;9gOZpl(KLVG87wZ$oQ_5+vFGd1QPyywLlLb!>5ZnaZ-X-R-7rp_hl&lyldR@o>u^ zr`&X7k+>OS3ouJFIIQ@s_O=tes4qkh&^W)+4J!lGz?stwI@6Nk=w`lH5Nt8l3N=^z zJ%vq4+{e#Vj6cMli(YSZ-d9wpnStn{>6Zarh?IXjQ!i5dC#M*K%5cp=m*ZtQg&Z+)Tvt z(?d!4dX_y~4`<@aS)(j~rfF}g&}qtJw|mvERgQcva`u#SZk_w{zG}#1eM(Q{y-_ZH zobTy-{k~Mqe%@M_3pb-Zfbzo7bbi5n$S^8<^Y|LdDSG;nRv9%CNs{cgdBiPLBk@>Jv#3 zg!{UiI(l$hDz^WEWl)lzPrr)#6P<&+L)S6KwoLA=1E>aQJZ8_q#BFg0+QA)7vk7o_ zj(UC5Zt>~RiSloYbbUZg1yv==({u2*@V~4qhE#maXe=|s&{-W`n&a5bo2^i3S*ZWG zwR$=OuFoiNN1O`R9#kPS-X8)L{0V>_7;fN8m7}@-^kpXyS8l7%d4Enzws&+Dh>!SO zjal<7n)x>F`sA-w13hpQA~$?%AU7b6@J{{PxyWu)y0qWBp6f|5*repa%DG)1nxK*% z|8D%`0$rQ$PL-(Az_z|Ww+TQ=3r6ow5>{~4wq^x?MUTFL@p2|cLWXxs@~!CDiQ&sW zBjnA*NZl&lWInfSHS=&muUANjVyrgIocY2pGi>9FVDDxb`_MEx3YN}-rgjx9@#ZtA z=J2bZ&2k3QD(oy>@BK2n(>@-&S`Jl%^ls)^P_gT2X%(Hj*w_0R64Q0E@rjZOjsIgk ztMhWT)nw-v3qHvEy_j+0L_O}#+#&9R`ot%LJmb}_FwC)?&B&xW)U7rX+DrFEsNI;u@i^FQOg8M*$y*kt46;`r~c|1CDz zIk*`AuVORiUy)zcdV`&4i-_n~FvvVC9`ZciK!9WfC`&IQ3nL3Fu3$ty4k;;FQHP9B zJj9tYHmRskyyDyJ0oMuN%}>pfuXRn+%fseBN~^0qJ-kS59x|#WsEPzJV-T^hpjH6B zrj!EMFCdVi-vNS3%JlTcoWoepY1zpa{IDURBuMo?f&W4u!gQJpYOn{Ca8aPftsG!t z01%Rt77~>fAtE6(*!U;7Xn_fEIU)ilY90mHtT?fug)%)_Q3VII-AzCO_@^(}?dm;< zsEJ7tm|q5HvaTUzD;*f{Y_K7&A-x8YEzvX(<2*Y2fXB}Scw9Cp!~r!8?d91S6_}$C z43W|^bSDUq0_QNWA(+U3B0eMKuK5^{Z#c}QyQOfEE|4)K=eq(pre)aO?>xf*nn0FK z^iV;Aj8>97M$}zuZlKD)FpLf%MBiW+-%yA^pLXzqqLPR9?mboh+(9IMSRyvI3G~&7 zzd3M?5Nd;Y27n;W+l4V1qJe;d0=~h7v*$)>yu%^Eu3_uiKt84MKom7VfC)9wzN-;z zqk=jBv%(gw4>Q;y{_Sm64cH*%K`xGgM2r^mxo>6tN{ky7-QF-i_|+&NXA!qw7iN$W zf>(a2z^?9S>_WX;n?~B@Jxm(J^Zq8!jIe?rl;p%DbRYq3z=rzG@cjaynBE=zepLPu zHCF%Cb-bYpg0K`BEH2R>QKUc$uAU`?7{^?dkm+?Sl0u5bO3kF!;pT$5kH($HppBriX z_mQoPKr;foEnw0>wl(_1KjzIp%x^ylpCxHODJMTU3GE#X4-9-WxdA^C2#$d~-aiqF z&hDZ4-#CWQAI=6(hKj8n6aLmsjPVs{io&ZrKU@5q+IZLC!Pxyw|A5~0hiSNOV&DE7 z+y& zk|v_S{qY8YHG@SzPPP}Z!g_S0HD`K5Ul-rjI7W;N>2znCtn<%ywZ?J|8 z;h$hDp=T=kLOWcl9Uoj|O3e1A#|JN^D1Q&XH5Q|+t$0UXj{glUU$d_ug*1@{X)}Cw zYmMN<*f%Cl$1**}^6#jX`}!vRR-1j@F5YqH==l(mf1PU0S=Z&VyPi)D^>iuu!-uWk zR3n2PDqO-Ln3a;qZL%Z14K1D}ss({2=XA8rn+0eW3rFgdnw0n$i?X_ZH3?$(eoWNk z`IEco&!An|yW*q8dTcXpUN)(Tx-~R8W;5-A@{{gnk-eee$s?BKINZ`|Sm(Z60d=)1 z&aVMCnk(}_x#O3(oO^DBf(0zY{u0HN7p^_DQBL3;B$FS2z1%C7cHP6Zbb=j7ZAPDC z?sk;3pe=`#BxQBto~8yb!UgSWh9lyou#Q4Gj?E}2)zV^wvb|&2K)vzSFdo?H;f3ED z;VG2c>cOrBb48m9Bk0qkRgxC}kx-zjHl2L(dCFZ=hy^;0ik6ez6;?<2ot z(NQVB<#NS7UWpD1Q-Feif#N+}7G3qAufi52Vwti|V?Rx2B2;ay^B=mkeE8hfFjWL0 zbqH3*-SkY>ANTGoG-q#|8BSpb?2RMQKlA~zQ5&{wI|9;ihsakh{ucT(W|g6}p{w8U z^i;gBoMd{$Dk|`M3(Zn#M5we)d_HrFZ@#17<8e|3SeApcgCTHPMo;>3F~(rM2!in8 z^6{QFIdCiyhk>O)N%${KH7m8Vd_pz@$x#qGSn@Bcqasd0R6@^5)Q5Gbaf{cs)H+db{5DQ~TCO-R zf4}C6Or`x1CFml2f`wo=+S(2z&S+K36htv>Y(OWo(DvIPdp~okx~gyUh=Jr(6G~VQ6Xhi0)H8km7H?Y_l}q<(?+` zC=4z5w9S!;dWG#WwF~aRS!Mg?0e)F8M!=#c1H1y%#GrmFk&trpf994{uGNI`zcKH5 z4Fnc_8-0_6we1lQyiu=F?o^%@Vu(9>CpB5E)keN>Y`qW||FrfkU=$^9bw$N`U9p(w z*W%FBzM*w`J}`j~ep0%R^$IFmLku0aiXN-WDHk!$hkIM5&Hi4}-17;d(LTm|kiajs z(xNcTAG6T96`@JtnaS9-Zk~2sOX603meWOGjEJYp`+H}&(ZQbJ7>kK3nVuRvz&L+- zr=00I{nJ};PFt4b^_)IlKb8E7c2Q1^{!bjPjNp24LRbxFI9F2%g}i~^!h`dnDdbj% z7})nUcP++C!Y!o7%Ru?>#upeX{k5&omIFu;Cf+^Kg|*LWfJ8B3`8*);t0A*dhJe%zO@{Gtaz)SwHA&m?zEq>fd!$|45!EWTiVVcu#&*bozd!ex!Pw)cr}bU!UPoT6Ppo-8@Q04eqbgB!k^4{P2sa$*wK|If=3j>*31iVc z9rF1pFDWB8@8YkGke|wYlx(zqACeckpuVU!td70dW z!LXC^mw_>JzOuW0bozHrLTSHUMA{Xubzw7%HVVV`er9^(~H3qh&xY zyN-aUQe8{;2m99%PyUVF=TBg)o4tclQCIgB}6r z^IBs0xHO(1caq3!nD%+>Pb6Wg1L`_;tRgkhJDwcQxji9_*ah2*mEt&VRs%55t`wO* z{GKPGP+{#|XlaYZhWYe!gl1Y8z3R~ofBwPMEdW772nMwplv7db%KOf4C;4JHgH738nUgu`?Ap9bfXH}lqu8`M+t7VGNb$?^N(F*WCv z=wwVMx#;*!W|$p$Co1|nzCIny5^640puIPVhO;Ccvbq?2YJ*N1FIA4Bepouye<_Zg zxO#l|m7TrXNMZeq$wp++u0cf&)3e~Nhg+JClU2*s$VVP269_)8a3PoM4nmQD070+ zY{^8pv1D65ww-&FDBX9nns3J^ zRZjBXBNDimNAi~+E{AjZa7{Xn?NB85+a=K;L9qoMN$^)-qSY!-2bxkSYd%y@vpEdz z$@6&~V`SBmJoz29Nd5p}RuNmpc+az(1-o(;1MOQjJsz zs#;kWocrC|-M<~|XMCJS)-~7<)ZA1+E65hP0wldDX-x;W?4bPVK3}+95nvmMX;g;q~UCW7^H*gaA_oTcN#cKYBm8tx`KUY68yK2B|UP0faqylK{ z^djq=0nAEs8CoLN=Ne+VLD*#Vi*|z>%KQROcQJ6l?wc-f;r(@Cxx^#!q9l^EVk5gY zwfd=*=wU6RG5U^lgC;yKQQ~?}@2j01r*lr878vYe|Mgpk$KSgasw;p+0_Y)JO^x%W zB+BgH^^-_hi#E&*Ti27iWw+J~h#6PLHxn`SfK^^RH*tU0A!(yiR^=wFbW_wGO25|~ z?z==ATO?th-bVMGvpQhC*RuBqS?lbp!0Ru@&f;yAgovo|`;Fp&5y(%^1QKB*2IAVO z48&-J?1H8;Y)if74y8wjGL!z+aGo&P-JkyIzPLhK? zW|U7JafLddt@d1!SU{k8xKS@UDihhDeap#p1o?Cx4AT9UBr*LKt(tUy;0A|!_XG<4+$*gT%Ox(p5S*_?yddY)PB=T#|P5D)yQnno-=Y}0e<4Ud0#kh#| z;B^c|oYDAtEn{KWw(j>DlnVq;^oxU21YK@D~SDS=%?7`hZ)r_xI(ug_=^33t0C|%!!{W}GqQbYqL8*Sf=S*(r4t`z5ZT7M9X?uHCfP!zygWXy}Xlm}9Lzce16V=IF_- zLYIUd<~r1)Wfbp57Vu+V8B+mum5S#XFhc^AGAMRBSBOfuqlLMnDTN4X4pC4rsevI( ziU-<m$>&6_ol*qyQwhnj%j zcZTfD;9xz?@bM9E^l7~3Z|Yhw)HdYP-MqUpKZvD5DyL}7s12XVGy0^Zfg}Cya=ADm zNy;C5JRlJri1q!FU$XrhLd~5M<--X(M0qm!XM>;}lFb@2XSgO;$KWGDyy~lM(k!7= zER@Y^K7HAC(JJ4KBqhNx-b!-i6@4P7BpD{<0VXM~M-_~VIqV@vykpbXUmRks+($-{ zmFikP?K98VBfP%xJcbu)|N53v>QP;Y<66^fbUs+OryA-4*=*tC;X5U+a*S8=Ah6+KE{iYG9L54M+Y zdPjTU9^UB1IC_5fbbday0su7!=ym?32e$OF)?dG*~y;Ue^ORVpW zz`w7c^%$!!C8n7dgWX>SaF$O6Vv7(L%C8K0S&E7?MMWQPU>KmxV)k> zYnC49cu`9v%M)fRuquw>m$=xV=Inhj%pEc^5ZmTEMMnQJUUpB!X!TX|XqJ2a?#ZG> zS3`H2dS%_8O5Ajw%>na8*$(?bciQm=94Cm_l!Vop-u)SI;DGP*if=U64x7%S^r9Pa> zb>#(F-SP7|U!pmTQ`lnbRYi|J$XCa4TvT#jFxnP8L1wnejdzfO;zcJk)9^41H`ErX# zTIC&^QD1o^;m_T0iKX*Kn7Zt1GtI&)BDW=Zobb_wxzz+wMCqrXn$PwuoM{!aFt^fV z|MEro<2#{7P9CNiiZ=B_ihqm!q9+6u*Z(YLgir#!p-UG zBH!KDvwnDXy&KV%?Cu&}(0W0W*GMJEphkzbjZGleW*H85pSiYMvB_D@StT_7wmHvN z`$y_ac*(`wzbQrl-chZ4E~yb;#dOkeG^ib95T+30o=kmcX}nnocjnu`>KM4#*RKxB zHY8^!DM*DbXitbKL&$BDuP+==5vE%2iZ4~UMQ-^&jIAe^PzkPcO#(KPI<1?XcV2wR zajrS!cmu7WU$smvlH7$ulFc^t?~8bk_Wciv6hfdan9Bc1&zE}RcFX25Fk);CHXFQ5 z#&fsM54e>bYfLFBw;+zWys;-!R4>?$VPTQdQ~}kmfny&ysYKIXUl7@FUnxY~Z!0$R z4A>hP#bYpaAQ0qyWsThQ@A;}!$qn+za&=?4GRk7+*KHg%Pgfa&JJPijzdCzwh`Co+=N!OyvuVrOEUqSS{%wL?5k%)Ftj4>l>2`3EIAZMtc{n$yKl_^L?>

U-+b58{@%Q=d2YmokI{)QL_deV`^qfL5!|OY_ z29kD9?zjQ#LzL5gb%^9TI%UM4UU(Bvbjl{Lc1b~C<5|Ta*14gjw;|XaV-o>k`Vu(@ zLfp8$CB=&IN*vpgN5m|ArpyheowER&dR1r@dxxZb0mE^?b<;qdNN8sx^&OX|H?2mOd+sZbps#PZKzB(dI9xNEF@t&b6 z22g1LE}d@vIASew6vXT>+U@0`P)UA*3vlLuAYyGY7c3>vEVwpsQ9vq?ygblIhx^T} zB~T(Fg#t!=3>~asO;!Fx@8IAk!%Qw}K*))|_#XvfA$CKctA{w8S>XM{Utj}&h`v`K z*#ZTDCeeS@LT~{ACze~i-&5BEd1;~92GAnHx-hu|m9}Yf2G9aa6Uq=`LYn|-is%Bt z`{Mw~{91*6EMcR(U`gdfHG~h~2Bs658418o6)X`TG7CVN9YO*N;r{^@R1AoT;=+99 z1^tI#2GQYe)&3&7y=)2n6dN4_zt7%##r1|z2^KU`l);EcfxXpLlaoHS|HG)`yqdeN zIO~iFROdI{7^K<$ZFyF+$};JUY6cG?0?e2Pd8t4LL)Z%q=IX@w;#2(vdwdA;9u-Q1 z3fBCF0csWiGdsLFG!FbLgnxk7_$On!=N;^`<$5Y78<+Qo8}5zfqK7lUP%$rC=CAbYLF>DoRJzf5{7>^oUjMKF!wUaI zfAlkkbDP9<ec)R&&+b6lY+WCq z?USHST-@#-k)|F)&TmtitN~p?e4v4o)HSYet51P$f34x4fCLB~;eWe9k>r!OHcy@U zKS!@9%`UEvp6X9EI6s@W{_Fm9+=!>ZjiR|fz;&pwbutsOVQMHxu+h?3&n}LHu)n#{ zRxHsDAytLBzZQs>w^K5d?ciLIxMy99f#U8*eao=g9~{#x zb>7mOgH~lD>*ilvcf1J{XsU>@Z|g5?s^ZG6(^0obdhqR!oP_wg&3@&%O(698dmlZ{ z&oDQ!$L7J6;9sjfm2~;859VCZw0H0I1%6Mf6kW?P7hiI+VhcGF_Z;$-lctwsOo-(i zk<3@&6Lx=!^8hj*rCfh5`B%-SaD}J$ z`a6Nf37Fwv5BQ!gON@aQ4rCg=Sh4X#n~J$Hd=AuLNRMe3$#IOf|5j-t#U;wcSzN<8 z1e>hHQEun9Xr~7Q2e`fFzm33wkZsywCli@* zNFEO!`h9g$Wff$a6=XcEtZnaa>>8Q=#{c>bs2T0Oc=@{0Z!UY+K)Q}g8bp?bnRBZU zh;S+c#-q0^5U?xDKp}3yY&=smf|s_dD5nT+`nL6y0<~fv3)g#5OIH_`f?!Pzt2fU7 z3|rXGk%*AlH$y&r7}+r3I*~LssCgN?%z8wHv$U7~>x2t^@^sw-wFS)9QGMW6@X{Og z3T_HV@9llpY~sh|7G3IauD+?cWm!;dFz%P(HaE82V1(^dxs_Z*xIY=a{)+Yih@aa? zWVcyKIk*>B8I3xx@DaV$pgVogX;A&4mhqa)0ca2v(A!-$9%*#FR_X3GVi*<1)q16k zd3nWX4E-D^SKcl(dBu9npM1?qvx`NJ>||riZ~~!z>N6Ie9BBq2d`P zv8fKDpO!<^{O*QDuVaFugvZd*j3!jJSCe5)Lz_AH?w&Az-G48pW&!BwM`%-RWR?GV znB_kEJ*?nDYM*5o-?)eYsX8uQ%oMc(RdOnp|5xGS9hKJ!{r99Zc}w&UR*r_cABtar zy}5xyos{b8iQ~PLFf1(SgtZH!xR1s3dOeL?0!bVXrXP<#?rxoz<-cEpZm+$+V}3>U zyGJh(>DheXrzlRDQ4qYjL+`DQ*&uMW1mfL*e|8Gogve{BYIj9=fk+PLTxuS6(~?E@ zUEQ9zk%LP*(kr(8E0QLudEA{~OmL3X`rXsvzX_eHHZCtc_X&Xmo2Lw&FZSG$c#Y6q zdt@s3vs+EXxHDw?lnk*$Eh^R{cQayGvqSZb?rO7`g-t5<$>je~v-qSi6M6={Lt=Jd z63KwMFNWJ-DX3>(rSyo$Do-y0sz;a1Ldh1MBBgTk)wYM8?_+Pae^>A!Tx?XRcy}q= zbLzaT?_}K&l+RH)n*@u%C*!l3Zcu~gjz2odC3Z2ggOco9^6wyO%!n@QRXq5pNn6m= zpa!~IC2BR|dZz7|l-sZ7cTc^xv5^(itT$B)3MTlISI~V3KW%z{a zq0AW{k|-YS<(#_cKt1*$Y@y;Q3fN#97CUMe!^pBm3BBF;m4#PRU)=1{mO9abWq`n^ z)$CY#25^!7E3N&Z%NEc+tT{f$;$yyXL@fJZ+q*Cf`}zpNCc}1{Nk=yNr@{`( z$HPPr^xz=2vGx;S9B^8Bd?L5*vP@t*HzI*14SkXrh`;nmV$vnyPTbD#1ozLxhXRK4 z^EL__I|(e>aaAX%dYW}ekGva|3LezU`GWPUe1SlR1z&>mG*&Vs{j}j^acn8>KA!kO z@Ax(Y=4+iM(!%6`4)#sHZw)6+y6DUb4>RAQAYSwy*+1iW;SniN!$JN>IZ$aIs+#*O z;i5MNr%?Z+T3iMr{5#OA%1%tG&4#bI@kocW&Kls_qYX#?I9uLA0!sVK=6k)^;!QlJ z4zFXwuc&jhn!8%6Jv}xRSrXgA1K+B6YPBFVgURWP%RO`DhA5TmTo5IVM*WfRdj~M8 z&duHJIbh~7=lzY6#EjrH-g`|U1KQU6O+VYDH7-qVvXsIr)K%BP&OSNQ(tMC~3%;y>HlK4R7cGf4yk+!gGlPLZiY$i0%$k% zGsNa8af}p~ySxn<$iw@7@mMdNW-tqnfn8Oz zMfuAIQz?rct>1MN!iufFhIH#CL$!q`f>0-w@{<;lY4%flH`@c0$3=)fFBG_rfc({q zxx6rGi-m@YW295_Tn~{J{yBoPf~swS*ja`U*UK4;z% zaXCtlavxm>U)0WO5B|?mrs8AiW{Y3IPQujZmCCKmP&hbU!=DuDN5xeQft?|Gsu02E z1A|}h&z!I&I}$FfPuT$J?CX_^RFpcXIiB%I=&e8#_iqj^$VzpJe_0SnXVVTjYW$qX zZA(hG;hq=$opSeduH?}u^g+MojXK(m!2&pP<-BjUMwUH!o z+Kly|+~~FgqE-RT%JH%=V$M=ezZAL^f?-Y&hV{b8gvzn8= z74}4Cl6Z$BjB#c63GYWLmg~Wj-h@i=2zr9D1>da%SR!6g3+mvzLqe6U;iry|Lr;HNFa|=B|3*pm&9sqe35w-+!P5+sFuw}n^zxML>9fUt zBU=UFQ29x(+M=>hcTmA!VINe%x~!iVSSQ0xb(?nF>iGmQ`$FsxaVi4~b zP3De(0g!xV(bC0v`TXVDZ@tDC)_`1MoiD+Ba@sV&7iHe>N4Agd`9U2wFHFJ@^cEts zuvg2=a>RSks@i&5#sk<%zPg_=dp?VZJ%(Ilw(~cMI8s<8EfYkl1b;G`JQf_Nf{JjA zC<*;ny@vDv#GyEI$MhKOjevDt!c_UO4Vx+4yzFe3R^Kq;lh3(-F}u`CI?D&jlqAqV zyPx5&NnlVFP&I9i>gFWHe&%zLKw)=R;!Ec*vce)8_ zz}4#V{Zt}`n>(Lj0NWu!_sd=E7=A_jioKZ7b23RLduolay?Mh8y$QVA3ct6Q0UYAV@CL0j+| zF<=0X6f~r7c^v1aQ0W~^Z_;p`uW4JvPPuZCiMG?BTQZV&8)*Q>i*Q#kufbn1?Mf9D zaw+2!z6vuo3KrqE&b6P!kdYc5F~Z_9kJLAS{&>*QV@02qQ1Fw_0j%#CA^Q0 z@$8Oe@5d10KR&0C_!Rgr7a}{Bhr>UCN|~to(LGh8`@jkPOdxKbSvvsS^uc8dI%s(5 zIDS&fmJdrc|FG0f8+7XICo!q4mmkvl2C#7UrSG2tv|#^HYuXnLPR-fc6A2Rcf=Z;w zJR_4gzNKPAYX3QcZA3(js!(4`{QH8e6fY|nB(V z#dXFG>gMj{U~)$S@Te8GCMDbk zqJvE8>q2xPt6H{`=Jab+4Gbk-C^FK9!+*aEdbM+OGcN_@?2fmMLXW>wxjOZ`Gj z(!PS44yK9mOEQ?}^b(PRI5S=t$l!m)W(CuL#KRL;^Ok=_Ma+!FQI&_+hS!h1pqYZ1 zZ61huW~0&YJ9rjsehs1*VMxdfqZ`=zQ5d(G}bvMh7q;hX-FkPm>o?qE8jrp63GGEy>*bHJOiJ1`+7q!B@X@5HV`P}c0=o|e)fb4_PpYt<3X6I9te_D)mdB+CT4B-%VX^)cYh%5I z1{U;rLLpbEtt8jRiEK0OQ=i?>#d`#mnMhv!C27ss9HclBe|q6#S?x-Xws4Isfg|%d zl^uiNt2ktpm&Z44{&uq&+MR^epdoiz+qyp4DTCAi!cC7^<&oV|8u&Bc#V#?z4tCM` ztU7Z+a?nprTPQ&M50<68)M=gXL@2R$MPYv5-Y2m<&Tp11Nv)mxquYNeN==&@ z9rt1pg(DWJsf8=8H=v0`y!RD>OM}ku)J5EtrM9r62tpoC3dSJk7@lXxzZ8hcUPK0| z!+I)P#s8do=-!e{fn2QEz*n%?2U(y|l%Sl&FO3iL2B0HOeB2g~jK&IAwhc4<)-zR}%FdGEz z(>7{2So$UJQ0Txxyy-|J)XD*5;FW#u+%kOY9Xvzr$ek3=F4#8tRxBaFQKldicbw8^ zg!EP4^6kPvZbK`=-A!Ue>YYizIhF!(KW6YvC63m0s^)jY#NI{hO4{Eu8=h(mctr#9 z`vbTQk?YjeUe3J`#kl7CP>v)4UYI}*VA#dyC>&TUa!{1;BpD%qjrWQaQ$bp#BH~~i zAp#Hd(SY%@V94l}%qH7dzMV2O)K`s&8##*T=n(R+1SvTuDIlH2Y&_vRL-g?w>8Rs1 zHh6re{Ujq`=BX+Zj%Gq;U6M^{rt0{A#2hZ@Up29@?+kXf-g3RvMq7A)=Y{y) zdhi6vWVu~ovp>6mE!?ZWn;FHNaG)4{9tDVz?(*pKAGqfoN*5ja8Y;Ct*QVs3Svb7N znq;z*K+aV-C+c;5wA8x-6rj!7IgYyG+I0Pl<-d4)%9~w9>EInVmgZbm?nDZ3` zM`d$ieQmM~ShffuxF^ZE0V2IEy^9wK_1O_|!DeT|TaicZq=QzGsyn;^{1W$G)vI$! z*3SmjNeFb(|FmQGm^gJlKi*-k@FM1?wGJtEY-^BmkimwH&m~T;0yJjOq&?Q$p3Bc~ zh_4H-ICq>a{DuzIu{gr)c7rfImmjTIYJUv@N5imP*SBw`WxLjE_7ftAGFvQ#uwq;5%z8w$FF=4N!g3s zzlsN-OwW-gKk}-d@WJWZfKDSM9f9{$tp~eP+UCHAKwtHlX4582jSM+6?`wW=qy*iN zW?@hyQg2^6f~^#i%+IrJrALVjd4E|ilE^J)h;Tozs(YP4d6Sa~iRHqUQ~a7ry(U`{ zyW%0C$5$;7a+5Z(iesN%aM`B9Buk^8yJ6jSxoPHJk|ik#+=bAprYQQG|H}+w$T7$d zI-Ba`?z#o9FNKUrjsC75iAZH&o;1gdfcZ-K?yd~$Sv}aIs(@2BO6G)V`3jnut!@f* zK(_9}kC=uhcQUIQoWlK7hcCb38DQ^fq%E|zxK_7S@k~}<&1b#kIR{ZEWROHIWB|+g z5#Lg_(=!ovqdwUMWLc;{MfhGFi?-=Q>Kd~z-=1R~l>teb*I7D|TpT~GMUssNr}Frc z7Y~EL6v z%a3I-&zhvzd{xsn_>Y;HyLxFZ7O@LDyt=xmg|lAaa0OdvC_Y&U!y#=bi$3oHR^&V* zyhWhqPlq-0;m#!T)dSfj+<+su=E)@17pTTK1|=mo?3a$x;;ODEUC?DVCHSS2%Ut)S zWUKrRq+9*=k7g08?8HZ1iB5SH`5E8mjt^Ryv*~xLO=Z>61@?%gxgSAh#wR2?cffEN zxUVu)Omfw04P5YloJQQWRHZj9J-y{?JLs1Kddf}HbCgTPSg#_HXLuYFuA%*&hpr0J zF<>cn5yi~C{PIsCD&!o~?*(mlIjkYBNm+CcibLH?mVMEcU zFGm~HnjR+9ZD|Ji0MC}jrwy8?@I7U!r67YaGIzgG?l{zPy$S->0C$Ul_Dk{h z$WbXej7&0RIm~uyopK2*u|a0h(Jlp8*7B8s&wyMQP7k@p$+Zw->Z)^y8#90N78$MB z6~(J%cn|3ch7v!uR!3$9S(Kq_26DUr2`ef- zWF*QPC+d3hw3Twczyv!5${z1ghQf~7HWfKLhD~7H&tjkW9T?j)OsHhRY8~l5viKb` z{q?|}Z3TKb1UM=x7T?_2Ex5$_lC+q(B}C$pnXfr-nX~$gLP|u7CSh08@q6v9E}i) zN6t+5Knc3=t_=p#M8+V^W10gr_K0N~9Yvw}mM%14o*tM=kjfH{R6l-z;#Zg6wPgIl-J0EY#;%_Mn zf_pKqG09jJZ*pSb2*#SDIChFv1XY9};Sx%+&RcbNQ9d zn8>YI>%sNcNNJDUncKcDB1?^0_rv3x-^9dFvp`GxFRM&N>nw{&V6HDv^*`*sRg_99 zXW4~NQ4n;S-%mB^*u(R#Lbx|Em^5hNpu;wppz82sc4}b(wsv@WY$`=Jm$w->&2T%< zX!*{i<+Eb)X;K|N1wv4}9BzbS^_!_5{j>*H7pRW`%+vriJp|c{G7>LIdRwGusu#9a zH&5T=s#QDg8og%YQ)tWIe?afh1i&Sle@i+_F_>%LdiwdSjASpX37~NwP1r!X1Jm>U z&1DvFDH|y2HMG0yLNxk)l52S9DFwSP_pq!~Zf=RL;?{!|Sv9GuZhNVyu?&x|G>B2= zP1kZRe$KgPYJ(2vcRhjs2EOpqU5`HuK20lYFiH_j?$xInpd{g_0OaF)9Ks$5aQVrf z#Sv8MZ;pL4v-zTM0lys(8|Le@(?3OhL<4CRnd`SyHTGASUT-sfz3gnh&HE%tucQT5h&h%E;4?&?6oKN_uVFQcx*rM;8gnB3j~3 z@3uJ0(AoSSs=Pr)eE<4}I1G@^A{BQ62FeU;C0Z|XA^CTn9itc|kPqdmsFo#zoBH^d zKDMbeKdPEu=qdka>!QJn{N}Zgs~O7-IdCPR)I9J)JeU=YD96l--X)N$u@4=)E*E@;Qm~JLlqA7E?gXeU_Uhpoj@}ek2T$=ZAL|m`4 z5VgGsYX?^~Jtoe&kTVl*?gCr4Vb!G_F6C_)HF}oDw}`-m^Jiyak`s{s#R>@y8aPyC zM;&EU4J=*3K=z{CxMc!bmw9EMkUW)z0=%A)rw_5yoG~#TzWz}dl$_Y`#EU8ZbD&k1 zGWJoOuhKt_90w8(e-03;a02)GJ%`mgX6g^EWZ`NLa54t=s0n1vLqsDumJ}nA+QWi~ zh^k*a!QG)Qoq>4$680b1CS58`DXB3hiPG&PlnDOS&|bvw_!OOGgV~MJJv^DB zi7rAbw*z(cNEvB;&qNI@+b%|v!YBDZ>Z7`?qG$oy2flw(+;=ITNW#90uf3rl8B^F= zWFuMeIY*EYh!Rrs#6CQJUr!NxJ_l<2sSaoGOaldv!rUs9uW}woQoL&+&RgoGRu>XV z3!nxYVEFJrm^P$(x-nQcT{t@;XG#T8a`DkXHcZP`U&VlJ;Nqj49BpVIX)Z8Z*hOBF zZyT^V`JSQ_bQm-3O%WU?y$IAGk_;2w6T?nuaMD_|90-qvs=0eDO8q zZIoM9Z}0<=_0I7p9^~=o!c#GsJPld%HA599_%&4H zBeAtBWeC&{myNDK`va~+{^X@;DD*cyY^nLo#$OvvF}hZnyrs*-hGMqjoCwB0d@(HI zx>@X>9jJjQ+iFrq)hCM)?MzMXja@{{H8;3pGh|?ne@>lro6Uw-2}JpQbCAyj+V~SbZAH zw~PphEmvAG?uY6{pI|FYz@5qqkW3fQ0Ma}3IvP=M^m_7jE16DqDq4Ud?k(hG-w0ni z0BW)|O$4Vd8%m8eNKH`y2^0Ek&-bK2HnX`=_-PZeTPRn;7<#XYElVfnT`w9kdLQ_m z*F!gQp~t2e7(FpIMQUn%2oahmd^JMBGvFj#@1&qbcJwHCwHI?Uy(BxjTvg0Vy%~Yn z)rMc2biyN}$YiwAcz5f>nfC6fCGXtHLQ1@QXv}_jrzriKtSz($C1;ha?Ze})sC|nI zW)hOdpLLz{E^YhSes8~X5wUW8)aoDP1@G1qc884JN$y_>hq~3KLEb86w)#qA%h;NU zfk$*+=1v=!MgZTtdg*JiwOkEu&|N+YM@rjaV4GU#y{voBUI*BKsZRH(nX2^QuDY|Lgz~UfrwpSsWa*fFHbe}{aIM_) zyIq!W;PQtOay$>S2nD!RH2r#kYK$Ql5Bx+0*?E6;hp>TBdxbYpZ06Gi_WELSco%{# zjWNL+8#fuUSTv?i^6wH?#=n_V@k`($0LVJGjGGoNdT-!!G{t4COoGhsLiTVrlMnU$ zyJafJAo;u-241<@T2K5ovHffTZ3UbAS2)tyT)tW>uD#9&WYRBGl2BR)gBpj;bBJ=s zb_60ivP)9b0q6jBk@@3NH0J|)rb>)}Fm&#j)2r*ML6qrKY%I(3@K&-REvTD)t?kLn z@M=U4{A0HcL0tKhfu-Y;ywT9s1{;&~k2KN*4zL8#sh^K}W$cjwkgi{|*;SfLXUaW- zo71N#BvlpYb?nqy2xgCkcSC+?=+b!QO#~aFZ!h;>rCyRAZfH;yV(bbq&cc2b4ui4!((5HR3xl`#3URX9-V(ok;fB84fxf*jGh>w_1n! z@k;O`6={%ryZO6Z`9%an(*#`mIYws1%mh!|@YJuEcFvJn;4gAawdU`K97nf^7VUFC z3N&^sd5ms@PY}<_kQ+P~HCk~y6>Di)31Cxg?4U*Vmx~nHs^E_&i$#`R$VcaY(!+Pk zKn-^?a(h|o6aRJU)|^*A05lNx-v0)8{nwlWE93v!v;Mh0>6zJC{+IXqPr{3Vfr;_| zAzn~)q88T9CXNJjqSgk^Cc-90cE%=9yu46O&WGZXj(|T?8)D}8(yB7>(7N(?j?*}UB*>ytD0{7$W%p{ zB$cg&aUAl)BM5_I<3j|He{|Q>b|0239HlIfWYq+}6vE#0Oq8G$)j1S%kbgE#@e~2S zfIr+E5&>uvfV~4CJ17WMTXy9@LIaSPX#PkcRQf0s$D{=ESjxf^Hb|B?8!7V129J*AVNObQLW|) zzds4Ym9^c;v+5`8)H>=D8!Q|B*!)Kxj56jS2C9b`6&V28DBo48?ac4F6L`lD z4?$?JYv_GUa7J;`-){6iB=eAgngb9IDoFje-SVlITjcj$g8N>PJ-?`~U%!K&O3~kI zq~G72Q@@Z@hsIVl1}Aqdf4?pU|5mY)Da5;%8GvK}KOSaVxL>u%4B)Yy%iolz+Ih}C zzq%CrhSo2&Jno?@n?DD!D|QX`bq-&H5I~du+ySYU1mPjDeG^kZHoAVB&A2oHH7^8W zds#JpaVUKgNd0;^OQcK;G&cyN|%??H=sAH#^vb0k1f|ze3}^0qnmXs;oh6 zf!u&#c0Nw_Kil7aUq2p2ce`o7)tA5A zzuk}g`DAlICLZ(Sf@euKAFD9pum&%4!N~%8@MKr=Wlj#=ssg(DDN1hqoOog`p)j=b)P^zZfVIJRB#!pW6^Vb$LWli2PPMuI(GL!zk4&MFvUC>lKbU6nj)&d``u*n=h{y6`NGx$H{U1q6|oIts;sSw##8o%?-5n)4;&H;{_Lo zz4EC8eCDICU+-HG0nqr{y&@U=hkGWq0cv|SWflhEO*j29+<}HZ;A(|u1jE-yZVSfIpv+RzXLq{C^d*5N+XH26+3|`) z#wWAqmUBikK&sR{0KvY**(FA3Bc~ylfMU9Xzb`>F<~9jBzV@4*vKyP8h$BH;biLO( zNyq*&#!;Fhl98P1t5B^`jmf-Ok*()jq69asnV8!C6<9`%_|jTB@4?jyi&u}j{RCjx zxD18L;%D2MAt<`BOVBj4HtuLtS^$BZGIYW+bfscG;vKz#OgIJ|9UPt3 zBL9p2y>=Nax@&j8oTcjBP!@2gb$q1=8dT__7e`xYlP)NuTh$@9ma|AXg42Vdv$|Wx zrd#!UV7UC}ooPk%^l8jU;arOIH^OlkrN0YrGH6|hpR6>_9;|m7nTgP zxhi;*cs^BGJ-K}3c@_#XMqR2k_yp<`k$tkAJwNI}RIzU|_!CVMnZh2L19oHF;ajUN zS6ibD@U^jD2=~fx;qh{ox6sxoa2iOe7esZjvK(F%f012ZZ_%0nN@>_jwycpX6lH*s`-Z=6X4|K}o)vVIpv8WkqJ{jk=rlx%%E-9{kQ<4?|BGSb9AmoxLu)^SqN(W|nig zmDWxysxUY%D5uj_zN&mz@FF$Tv>D7}P~$N)J;gxJ=1w?`G;<2-P7!VI%<-kUE1hs+ zMh>=Q5)!pRkeyU5oKe8Nq0H^ZSLB0yiU8e zTC>k2<%a_YWYQ5Od%imgCS2h#5#-JZYq)MQ6xN9jJbM0zbG3*;FU~`%v@_wcxlZqF z5@9eZ!0(I$d@J>SEHY^Hh}S0s?+@9VW@mTS)1*5WkVRrg=JXvBVF$R6 z9kcamAgwSc;g8XVi(4}C0=|6i8_Qef@+o9$8?~T!FV$v3QNxAXOiTR9hJ|gxrg|#s zv4Uop&FllM*oP-ZQ<1jLth~Mzy|>BBwK~#msX)F&SE;v3I-%c06;TpPeBIbd$nA?@snVMV)Ew!;WpdWJZ?Y> zGmO*3+e!ctm@fUNo}m5270{>FpEno@5jX#QUsrCDBoUmMCjQ%G-Rpeb4lJ%tlZdtn zZ@H9gnq_y;5RmdM^xd&LxzG3>3f)>B&bE~p=OVI|H!(>}`mnl~=q5g_p%yySvWGni zaOZGm;0^9WK#!lzuTqWsjK1J%#7KnCE7WKUN;Wg-I388UJCZ|It`3+nWF;Dpu-ODm zk!$l;9oE7bPzes}o`-{dpi@+t(eJwti#I!GOQiEU;jr&W7qlG7yQHy0B_@@Rehf*u zl!8GU;QQW6u`;Y)L~5|L=gk9o*dNRn(DoKrhdwUiHk|&F23ml zd-%KxyZL_z%MLprg$fQ*3nQfQ$Y1_Wa2kv@jPiSlZ|bl5>{`GW*Pr&@IhWyYliLC1 zmi7;lVtb3r+P8YQx!Uw1;OwyFmEDvl0ZzwUF<(O#|L{{W<00OU??3G}^zjG_UPDF% zB7Cu?09T%=LL=%`?IDYxZcGIn@?P8LInx*-5K2j=`SFB%=+OWTT#uW*aJ_#~#qQiP zI?b+$8(Cu6`Sh}3huDqv;)Y`fT3+n#T=s~W3-aNi0wT@2Eq;v!^|_xE=U$;BfpdcU zy*Suj(tEHb2-EEpNRj^Lo6Dh>x7o8=CY*_BE(p@B1$kGH^U!}J>l`&Og>O){Q4Y+ zoQm-V+$64bcp|G*eTSnOM-|bcoAnwGTlPj~GC-1gYyp)FeT6tSLY@m~;$8EJo{!91 zNrZzgLP=0Iv;qrkypvON@@4PSB~lTMWn)(VBop~Iqy}!jrp-PZqrpEjn>AMZLH=XcM&{$E|!%8`)@r7NGog1uWNW-3Y&UitG7s7>;2%OvD6|QMq3x?U42vQq^Vx74os=d#al(Hb;lf16unDaQ3D9z z(kC1K@mx?uifX}QNimL|Dwi|EQl1yajvU1MOI+O8sJ60C@6YMQG;We^BpVTc}j`0G`lk;vAjz!9pW5hUVay2%qr|PjtN^?Bsq2_ zT8FdrCQY4Q%5onoi$}RcgUw)xIPZXeySJB=7RaJBXZuI)GZPKw!n9Ep2Hax{RW5b% z4AM-ZDS)Bn$I7Jey@-JG{g#k>u`r@X?&TQc`w0)8nVRf%yNF`GFqbeWj#pohw(ldi z7m;4((3d*mpiGCnPB`Mz>?efq{M4ixt4vNK7DMY!ASKEYoSta%;hz&TIy2V|f@0hC zS7GD)u}ax#$e-yW?$_|$%KxA*(ik+dO9d;zY<(n5PF|1!*1z;0+>a%3sa54>XJttn z6M@k#iXWqd@T1PTarZU1{-yS5HH6|J6@5W@>Hq9QzDNGD49h97n~|GpO}P_mE7y<7 zFIxZ8fD4CKT`^p(z@zL7tTVtZY!^!&w{;qCbqr{}>o=dwYP0p-T$$(Of;@rg#F~hn zwGyT^&xqEE|CVBUPAIPt#Q&~79A6Uv2n(D!uPPzFkp(FP`|}yKH-Il;fY98D8?o{D z4|W!te`umP=lZ=)4Nd_VI$F6Xax6&{+jkg*W}v3U376_vmSVOv5opRZNfI1qz#E9c zy*i2Lfd9-72?jg|2WoHs(N~&z9`-WkHOCqjH1LV-*5LK)_Profg_Bn~Yjn}c^L3C* zB;6~!;q7yaCCnGEZCE~$3)2%bWvpkhlmb+O;#&(zRMk&P%uMr6hug7o=Q)Lj5>qRH zdlT7d?wgODgak?MsP5LMo~JBOSN=6dixR4#Q$n{9Enbj$yf{5aYwPj|!?+YUVj>>n zlk&{-Q*R6l7R=tVPBP&RN0gJEc3=+e+`4t?oU=h@arL|W-dXg^#~V<`^U@h`pYEm$y@|k^& z)b1|sUbBv$YJc4^Yk*(MUtS&RY2*GV`yfm9Ew&Y*G<9eC;jwuF2~DEblFkKrn}L9w z3reS!l7yS)t7Y!giQDxHL4hhoA~dNn~^TL`T#Ch zmc;ZVOc*MaRm0fY!Vw}oU|^F- zl~=9PeISc$wrZ>fKQ?HjU*F~RO*CGi9a$c){m<|IV0HSig`QYEXOlRyAikD z!^3ebIAp-vL@7y|ju>Mcd?Eo{Z>lS5Ri^uK2Xh*=t*&>(4(t%R^uTR;L9y)WP&2yE z#BWaL&jUC!zK=#5lX9=b@@^w+Fk~yd{>$Gmjbjs$K>HL@UoShr>gCgO zKc<~+nqWta^8^4+v3!9jQ>ePOV=Y#AgR&Idv0^QZdf8Iwg#)5E6&+ShSIeu4JyzVM z*AZlCTP{8EGVQ7A7l6Vdzh4Lvk+G{%)4`autta24{+T3fQdOIx#p_l!DcX!=ZPRMN zzh8_Up6AdmRCZbSm;&$rP74QlClq8L7^_Xy>&2+ks-q3^wt_^5$p`hj{|v|Q<`n#I zC8&$3iC;3(%r7rdSD5Z3zF=iNWtH^=I7Go1{iW4GP^J;lUkAv^Z;pa(rr+{UXeiX3 zLb!8o3>!Pl*2^-;S?21i#kPQZsS9E_H$UBJ%0Zw{?L)N@ayAQ5p!OfwDNTX(p`JP% z!JsvAv#Y>j0^_8-eBAQ`hP%}74|--@A@1LGgS55yxOXfVim zLdvt09{sr}CP5AI#Vj}{Gu;#ecGNUi?#hlg@=03Kw#X2=)U zP<*~jf=fV8jLf?-azlUh2oJZFtoe7D4KJ?_|I~1Y5qYfuRG+p7BbDbIbC>`}SK*PB zL}zZdh(jJ=O-S!rKG0TY20tQQF%+W+N?(Kvg`d92J-Du0ix`cF`dUxP~W>odylIt5z9tsoeL*yyS+wi;v89<#4 zvb$28Q_@14gt`E^)xabVPJ5_A8&Eb5Ie1p4K%_oHE+?`Q$<4LTND9oofDChYg(g=L zaf#M3IboN<`vtB$4=P`T$s~KYG2U7;s2YTqt%4()ikS*oxBz={@urS5g9>iSj=q(E&=jBXmmyB; z+Hhhz)vNJe2cX{BYk;t0Z^c+MmUnyFRS=G;*?#kEjozy%);)7|Suq0E=y4rzzDQVT zWiGf_h%*nm1+H}{&K7%2S|1`?%rLb%!|;u?82RPvkjf>%Mdgf~wp9)-(j{J#h#baK zbW(p@>cDUx&wU=tycD`zYlbvjS8zb=6V&Mc&2&fnohyc-UX1<2eFSB0QPJH*A%l>S z7NOzf`?HwI-|g+a&Uh6b@o+)euBNQm*<<#Fv~d+?`9o zOh(hOh$4$4M6eXR1ukj|uKq{e(fuBGnyxRUh_QZGwKsI6`l~m(KI5fb>>NeAlQroL z#WDT62hvhHuS!!#Sd3cW>FYkj5#-JsUfQF#25d&6?a2^JCzcQ08uwV0}J-l1(o=c66qSJqmFV`NPZ!Nq!Vyk@UGfPiSt)9w?~-T`XGF z`T?u^Aago1zb$dvz6)B6%u+Wo@tk!Y1NgZ>u*OYbF#WFUYEH18(Oibm-pCUK*jU)=1EJ?MvyfEs34POgq249JMlZ$jDbDK@2mB`BC&O)xb`T}| zPD#C0YF|OsY`hgIDNW%NIRl8*wlWUS3Xy&?ApMs4hP|g)ir)p07L?E%w%l>~Nvd@w z4EMh4EwMiwsm8f@S&-Q&Sa(ysOUjTdDAD@pZyme=DqE%MJf7vG-5PQ>&jpX@xxX^K zKA37}`fp3cpG5NjN#FI1hja7S=-{}>)_4j|+Q#c^e0jrv_wp+08FO4kW`a=8)R!@w zT#Q?gA`Q}QwrAdzbAu6I>$4(9A1bE)n(n36T@vZR_ilvXE9m zS;su69I(v&@XedApC2#{TTVR?2i{q(jp{TRAO57G>q=-xKI9PEu+m=md5_4~##<~r z9cJ%|3nufmBAEcm*9N)V0ol`U3(R3pYL`eB-44CODB!O-l5G|EsOomI-!cfv zFf_br?>vp=F8MAQ=VyDtoXfJaYgAzlJ;q7RjfO5&_KB<+T6emod{tC|I9>FNv=`wp zhw{uC;P-)=U0N<=>C3<0mWbBjm}xL6)vzOC8@UbXZ0}Rjne)^i2aMD=A=Fv>v?o#k2eV2P>l0F8`eXQ3SE!{Gb8`jgI3*2WZ{!}OH3cN{%%p&GxZ&o}M<4IRCGsBVXm=z}*E)=Xz5)tj5x44UKy+pOlz*AScVw62uO8GZQI5bnY&8C~Z=(pRb_nnJ zG!e6)$)um}^GavJ#Vu(?bb&x~aH~-q7IkfoI2m|>9lZMi4N>LU$^;vllF++a`Dyoh z$=N?ag^)#=arx9ttB3WWr%8BcKX>g#0Do(dHH?^G$wDjSGRPHy+x=R)`fdKZxdtO8 z>oI}<;IXLn#JC=*9Ooi&*^w>Q57pr@pt0n!jmEV0%WRCRajN1T+6l10Eu#0(^GPgn zsViqqHAH>znJqY-fuiPtA<%yxSwlN8ju?s+W`s5cBk&*TSW|AP@H}W*hZIL7m?RgUkvgg=+4-~lpx1k4YGzUHR~J0 z+Qf%-N1e3`vi&IuqN4fa{(_Ji zCMDS~OqiK&__Rzzc?=4iS2X(KZ0=!Ljg-63r+&(fk*e{k-4L?=KKJ3e7ezU+3SLnA zP+|l+hZ1v}1k81O`a=B(DkR$q&`bNCYq0$8eav6JsZ@X=<)wqKwUVUV>4r#+Dp#}p zh;fB=Qq7Fy@q<;KPC=6Ps^urSxFdO@%^3&vQt7XSF}__uhfn?t-;K-yHgi?)njt4f zR$~qb^lyGo;m;<*8dT+~I_F#j5LMLl;>e2O!8J<}n6j#D^+{6+k?IpOyuUCzB7jWj zEEGZY^$WTjTdXb~e#^sg>Z_x_jB&VcYbxP5{*uhn}i77#CN@0A>S zok`vdYiC#6)4Fgxar{J(OhBS<)i6Sf3N4GcbO+KdE6}tnX|9*Sr${GG!xGoHDCjy< zt;BE4U-6Nr=ZliYV_2Yq#SS9JSx3zE72O+c6%vOFHjBrnx3)YkK+S@C-86yn4Pr!W zh5RTUZG%(CV2HO**$%neyiO1CrjX2m0+7P(8r7BbOsQIUFL9Q*5OeAW#k^BoXmZKx?F-?$i zd;K8%(Kr{oVM2=LrkXFGgd0De!v?i?+f@I|9#Pm~CO*ZzC3{n9IZ+(BE^2X?tc>91 zcj_aCv;dx(jJka;5TyoNDe2xi{; z0_Ui;xbb9yZnDw*M6sAuPA<=Gy4m3vTV86$yDY9R$# z9F?wuHKzus^|`g> zgLx(ttVKMRC*h&)+hD)c>!>o>$g*-rXG`3QTzH~AwE`SNE>cod84v-xK-mG&Hkd98(v$ofo z^$&<40UfCZhqjx*orCR9vAQ5o`^S=IP)B($;}3D4&Pp{8ouVc(sE^)}#NCdHhISN51X18WolB%qu+v+&iq zp8PjGoS|`&d!-=5U3#IEpx`GNqD3b}?1C7;-|7vy;1hhb9NJt>l=T@DdK z5Y?W@hLVI@fe9AYHrLY`)lpmWINP_Lw8Xyyoz$fM2mEULw(ReJ%7+anO!oNAT#Cb(uVfDN*VZvQqc)fWu!mPU{Y!Ivf0m?^a1Z59ekW!>9|P;u@y zKl6e`n^uX!gQ*;C5E2%YlKZfxe-s(?E+F=Y(7#{xx4AIICY=46NjUA7X-sn>JU&p< zvmo@pe^9E!MI}m7D4gmChzbOrCljYB-H=Ow^Y5{@O%WX3b0d`{cILId2DcqRjZv{j zFzPbmH!G!-%1CRbETW4a!ui_umVNlsBRawX^XdunMlj`}C<0<>qm{n(cTz@bMbFYN zsNwdVzc^BOW0-6?PtFOtl@LX5=(@vISWs8Kt7{B-p~nOov&$MM`|4s6oY0$xQ$YJ2 z(1z-pC)Q?gMHn^%vD z@SrF{Ig#WNRd82-f@I0MfA~)4h)bQjbd4aNWE)Hr z+MXoZ+mw6%L0a;)2}nFIO{#&uHWZ0~YT>J`vB-;`H}>|LX|>Vu+;Eps;bsh1jn}_| z=}i!@&ynAQD%BKnsW&@eO@RMbGn@>IbOrP}S_VcBfwe z;RcCf2Ps0fzsL52m@r&%<)@`bL!#e@1V28<^Im5yELCP0v5~J1pq4YZF%wKm-Z({6 z3|hKcj_c(`I+4{HVogPSTT5fU$GI=wO;hB+Opb)Z;WUw-=iBc$~Y^UwF92#F9>x`BPK8U0~fwfYKFSLqP>V9TT;H1_1Ml-cvjpeJUTxaLM!lf319TX-kL z>`3-Fmu-CtY_UXnhz zJa1gZwZ`6HSd4#~39vPZjn6(;oSNXs_bt7m#6k~`aiydvSOM#e)4!---IqYBQ_|&A zzf!QS-B}NFxQmL%=nw$~{RXf%@Y#LVadQ6_v`TseMx;PQ91?zwL>+n7CW`i(zT)X) zulp0bPG4=m>J=;De+c8*#HI*teT-^eOHkD@ zS7X=itQadbY475DX-TDw4|4#}A!?9|xuydjiHO*J+{FpAdGmW%tqzMhpMOAO)*4bR z4+N^03Pv79twD?caC$W`U^Ne zRlIm2QWdG0OoW2$sB}3u{U&;(LpUx43HK>q4Xk?-&EUWYKC6NOkudt&r%G}i6+j_XvpH0Tr)P>5QBX ze#gDM5(2w-=pSiM5lTDk4)_HvhMpm5HRVsdeRX1!<`R7Wh^1=t*Bq`1+L`H3c3!ce z@6>2mrl<*HV<00qk{l+W6ju%aO6} zyp8A|GKTgMJGR>s7J197AZ)00xM8C(G{>3gG1d?qIkQlS^;0nNzXiMKBx+Uq?vKf# z+nI;tedSDlia2;|jH`{2akk@YmezFk1Wwy|u-ne;As}V$AoHFoyd(JRZam~Dy~&6Y zFrAHw!F{@6>`HqHm5lozeWBU6=GNU}j=n;OB6$>*4XdL6o{d~JW?V(~*LL*5#snQD zdv3ao(vdw2%+y>(lS4~y-m;fZHzG>K4sy?@ld2s!7aySk|H+YQ(=-qqqR5zscyVE| zYOhaH(vx)xu^0+6vYvMR2-Qz?E#Vp`qOy7ac<&^uc`b`>svx>r!>8wc zes9LL`f@gGoN7o#PHxWld@A#9#WBBQFXRY<{z>J+UrEK4bq)SIhm25%+mGQah)9RB zO#LOK`b^(zyOtL|!?Ef(v-!l% zmF6~N7~MC5-5pC0`}4Kk1fJ=mwr>ILzuZ|JTk#RVEEzD_wENIN2!CsO7E9JtEP}~4 z4WFLsq0!LB@X#b5R02E7kAgZpH`XiDb9DT%ND^mV7UJKECm=ybE%bL}uCGA{Gn<6n z=|v$lkR4btH>jxo0=*2 zsl?8r0FS*6eeoQE6WPnM#q4bRIh1gz4ybKyKXg-xc+F=jqkiPQe;6DXxo~y?xsxv_ z1p+xcD!h>wnbZ4#;V1CqvC>#mbDb#m+O_7m**3$PSMms*cUY}scS zz|G@q}M=5k<# zgQtMqc@@ziW!o%EFg>PD8Zk*SU&aFEqp*?0s~}l}!<5o+xYT40dw5BS;NFp&tV7ap zUgtpP4<*M}>2SWb zhlB@{mmEY~lr^W2ygDgK9U{yR2?ss2&egw#nDhKxG^Ni@4@SmJ60Oz5K#{wb98=(j zp(T={(4OCq&IScwBaCcfv!IeQcZ|kW&G}eZK6`Dt7i-kJy5P5h^9xXbDOK=rpG79< zbyjXo0k!j<~gfFB;hAts896|dD(#Wy7&tp~w>lILRy z+sy@ZIszbg;3PpsONi+g8~%cs!7zcpm-WBE-lgUN|Akv-peLXwursuT;^zKeG?{^b zftC3`#FT6-O#c^Y`%i3{or#_K|65GyW}=>K)5^NA9q!*pK(I}Kq`0sR%LxMvBaI;B zCPhq0u)Qr#yg-1vKmkhxD>)X%yZg!e>E2`ayZ-sj;55}d^Y5*=)Og`KF)^86*h^>; zQTIJSuqQ^vWvQX$!v$!tb6F7UUqB$L(6ZE#2tz^!1KltXYMY*<#p)9v1^Q0{CFm>o z1Fj(vK!X9ky#sm^5fQab`KLj6xrv20!y@%nl-l%-^!LBF9=AgG4Seg3`4k}!VZph3 z{tkk|h^!6v*&p!?|FX-2!+;Uk^Z`&opuo777g!V()d1+L$gcvE`|smxdgTxp``lVVV5gnE^-u`ZA_Va6@>{3Lx&94l_s9L!M))@}HRz-R zGLP^V+6GM3r_#oA0eRph@qhL!VSM$IJ^J+@`b7-*C4Tt19r`X6{XHi9+2x)6ElPC@ z6AN*KgaQ8AVMCbvMTQI($iMm3x#H`F?ejyW3G&zc zLH>-=!?N|Mg+tFnXzkN84Nu}8g0(J(6bQ5iP~|`S9{#Ss?5F9Em50Fbrn}4Q?1n!$ z{su3x0tQ^~_oE_wLI(-e`e_XCn*K?iC9XCuE1{je-?iT0o5_4d4p?$&1qc4IBL!v& zKJJC@EjKnsumzB#{rOaE19<}lBqEvxAesf~{^is7y}SGNQ3WQ#CA0-V*0t5uYxYhjUv zzNNnq+XTUGh_Bo5&d_o6mcXR5hWz25XlY2U8F48uUg`Myk~eazty|{||MdLQgm2_* zJ!fw`v_~HWNa2I@ih&e=Q;R!mDbPz_qaBP(H(UH|5B}Q6hrY$x4>_!ulbHyG8JgC{ zd+%~=g8_wWM>KUpWSmu_J3gM3spCTn>Orj6eR4XLmPyX5J={3^z0en_#1-9ljx|gD zOKpKr73>$B*LC+5VAbn1TZ*Mqkvyv20xf9Ny}a37GRqVamF~91RU(ZmOji4}p!;I& z8or3I#-PxNx%8X2y_e@TwC65Vd&GM#&`G{ zfZ1DkfE>2X5-9)a!HkTezZ-PHg5WQ@;yY+u>}R5W#k|0j_};+g(WwVbk>Z(%aRs)yZ0lJV>3phoB&eqEzf|4x?m)k$Kt;c$q9R zO2+=@Y{s1`rc^FP8NxR83y)!%ZtyC~TP_8LVsx!uWZ5^{53Z^zgEVqKf(Z|^l*TZR z8iy#rPEYw)-gss08>Dal1F-FY3a87`1ua08!)<2BCVV&e&XlFd4S$|up9B5Hp214^ zCv&)*3i`{wtm4E<1*~4XfZ^O*Hp{!l1Rdy7;7G^6qy?&Xiq68HtF`?nq7{R#fhDm4 z-k_=2)vk8QwxuVO*1Ql)J$?i64^0csf+Gc=l4DZN_~vu zGY+yY!XTd^GyesCs)Oy$VYZ2nx`HtPJ)79G_?UN~jznbAPnb<}cr6j+J1Zb~V`=BS zgQ_*~#B8RHwEVGCoy<3lH3jr!imjXrorW)+FaIc7&||IFS4k(akPY(jG;ZSaXX&dl zIN8wJR}RykN0z2)9kJMBR~Y}9E&4Q&EYj)~x!vfc{AQRWZ5rgqXLIWHi846`!`ocq ziFCSw+M2s!A;XSPL|Ev_P+Q{XIX%sk+obBxw8rl*o3-%T(^94+V%l!hE|GPBiziNJ z%$ZjCAHvQdNEn`tvTfV8ZQHhO+qT_r+qP}nwr$(<)huT9SIs_)Y?4YnIrm%(&Yb!! zx_G+$<=6WZoq@4Tl1hI_W|!3FolqUV42Cqg1sZS^ujPm@J|6oaS?rS+(dj7N;(gNt z!w`NpR1ndl;{?lA?OUR4Be&&?AaV8slUz@|>*J&Jvrfoe!OfvpP`vbLmlpCCUPfD% z#6b=}Q9xnX8@aS6Vh_65%XFk=Xtkb>WQ-SD$OnkgiC@=)bGtMwUT%<8mLse+32hX5 z|5WvTe51ogpfbyuUvTw z94qo969tv0wC2N=G9LIXQzElz2l_-xc}`g-sSA>{am$D|!Tk^HVJJwIIvlm~us3gf zipPfn3_`Ywd2b`@y(L%MYtpGnmKYcKp^806AM084L%ZpLa@L8v6w&?n@)adLzBl2& z!~P1&SoR0|B0Vv|aS@FYe<4rdWyNI_|IxNv97%6Nx8QNbX8G*KwVvR!JX{Y@AWMt1 z$wmOVrMU~I@l$}f1glZ{7T18qWbAext6TGMoS}Ikkv3vx z2KFcd0>)r#>)1<1zBe)5E^}=_b~c9b%g!HB-(4fUjyYy0q<-$RtrM-9i&5hQ<8RuV zcXpkEm}l_HR*%KL+vM`!h0fn0RgaSl3RPCU3lPd9?2eOnoy#q zfmtnwfFywwvw-_Ik-k32|C0pjdE)zmD`)9?HBR)Vs=Rx!n;EJU@yo>e4(Kv9tw9ry zpb}<4XjKF7d?IQbmTk^)iED6k;qn=x=+9XcbT+!kSkB&g2y3_4RWQ|;vOhOQ;fI>U zvzmvmz=Yl>lIm(!*L*C@se#$ZfDH^9;}9#yaRkvlx@#Ca$t6&Brh4%pYk1BVS<&&w4 zo+Oz|$ibJe6ZQRQ$yTIX%Z#g^Daj~^YBkm#8I zX?lSt7vG0KQj!^QmPSW;I!<%?NRnlEu>LU(H?wfzC``j2&3{8!9;D+Dc5kd*UZVQ6 zlIZhibg4Huad46fuoqIfaYQE)NyD4|IIeX)^9uYdm!3dEuQ97w!&5zFfC-}chwBzj z(x(^84v@0MhNf}Y&a7fIiQK$v9Ie4Rn;*0$0uAXwN1yqid0F*-KFn&jQbwwik>GV5 zPwTdO3;-jBE5{8Mvz^Ms$7;;KPZwy?i=eTmVq$!or!GRM#W7Jy7go#beXN*KVOMrD zTcYtNRYg%E+o2y;P^V%JVi{Y_Z`m@fRp%;`m8O@K^<(6^tT>1JeF%O_3%kou&HkXi z(Kl5If9Bj1KW=g_YycZEk(~7Vi5g<=gw>7iVyLcvQ!$_OD8VWE=jJn_<>mbsCN{7g zI;X#$AF@`b0mS6Q-6WLqJ;aJTvh4HXE3Jz8B0D1yc8NqzzFsHbY;M5eE^I(MK_}BM zZ?;-mZ+RlvldNq*QW2TrIjmE0a3tBuToW_>z*|(Kl%dNU`al4rjvm$#=ZtdSa*v7DkjO_#o-z0rDFFPlERQbF@h<=~A0 zFTp=jAhs~yu&Jz!)z^I^pn65r<1hu+wg9aPw1tNBaL!3$W*Nu8ew4gs|H*5&t5KG! zof?U8tt%ueu0$!J(&dk4xRc{4Fz{-~cyG|M(Za5IID_q!u`W367Hd7G&~`a)DU_BV z`tRBP#l8=S+Wgr#NPr`%U{tc_e|f^4&4cf#;nVDl49>*YI+gCux`4?!=+2Z#`2@?# z+?3=S*Q`Z3r8KAs^`}JfvpP5i;2tlJGKAV^5jG){qHZKabY;_kZQ19H_(h{+a1;VS zmUwOYkzN23u4Dy1T*+jZk&6Pag9(SE_Ootcir=3il8SDvW6lovcdvnG=*-WC)3l;}9$1|zv z=^?sb8I#SxYVYyeKY0Z16VV*kBSrJOW$LB(W+o?>=S;nNP)!7(z(XQfFtiM8vWrlx zc~i$k!7ag(BcQss2~A<=RU1g$vXzr>he_&_byX8IQ!OVeGeR}5On253P*;vR@E)qw zECG?E3s4eUE^S=7tPss}y|tCFK3zG2mM0#BCf<&3v1$4~UUB0J@zTT`dPMx`&&aiB z$SgdgOYe}XwF{|hXo5V|h1_sR<*3s~U6^h~5yBc?L8n9Mmw`e3o+~ftwT)-WVMMnc z!iQv>Zdap(VB0SncFEO^aLrIZX98P8e#Q2w6}AZfhvW9U-!%PoyojXvUe@o~mC_z# zawfq0k7+(IC42?Wf6wb%!hiSTgmue2E)K7y#O$gL?7MMZ*fje49sAJA6&TP7aI#&4 zE3k^MK;}2)gNYKE)^*Pb^{ahnd-V5xf#~5Y4UbdKeWo5J0ZSkifbj0)XUH}QjR#DZ z-|JFSA^|anb54kH*YRRy>FzVg4l!H?Fx4ZAZCA0M-&rrH+y*Ull&eNiN+!=w;eo!NGcRSO%HF74pQI=o4#oLG?+Ix`!Dwp zzwO1h3nPs1zCTR!U}YoLefuX_!KYHjkzQ!zQH&AI86E4klDSjdk8kKP)DqS6dHF^4oP@0~f{M9v40OEYf=5_Tl83rfbj( z*`ctyTHQ8ND9rBxPtq<+_gg89zb-b99(5-3D*n+#$AoLOHSI%mB8zQK9}nVrE(IiR zzmP*eZ{?V{?(qyUfVtN8-Cuf5&l8Qw8vK8^LD(1Sne6FLH>^pStP2b6531w)luL zF7jL%9-x#37K&G?oO5Fwnti-dR5k~MI+XL&(v~@-uKK)~r{;z_#R8aMnkEJ`vpI9& zAE;Q;&&&M#6t}Ac=k8^C9b2<;mH6-r7{v1BB_m-iUuuk(z2gix{EQch{P=VQ#Lvxb zDO^@Lw^61kMpd5>&=0WAx7@lO3OQem1BDrbmR0|$E8mw6e7^~7Rd^$2@RrwGpHqP5 zGmW}1Q+^A)MgZ%AWlWvn{ZK0*PsWJ-M0JUR%7}{fc(6KMt*uwX9L92;#2169L8o)d zaN;?NiG7bI&lmXTHEr$^SZ1(d#HgZb9l;5kje|wj~u&jyUk)l-xO#dZ<^l! zj?IlO`r?>zWQ|481j{}ME8~y801n$gUG`+%D(=HMRh{*Hte6Gj3ct*PsfRQD?p*nr z-A|+wYGiG_-sc!XdEMl)2VRZNFw-0&h88j~D@LU#Qs=KEaRaSAQgD$(qf!g|Jj)z6 zS#6@HMccLtkpD-C_f6KHilMCNpt*n14 zAeB*0doemt&;xSfNV$?IZ)eBFNBvTd-|*jLY!4h{gd!Kt?zZUxIqM(wV(lTCnGdA9 z0$~XSEbp5>OqhHu@-R-FEA2VA{Rd;4XbgLNuD?R22E1Ia&GjG}!}qQJO4(NW&!9)9 zDFZV6#>&7&OO#{9S1Y09)sqh8X0z<0!Cc{Tdb1$siX)rv0rvw7UtzFn^Ul&W(U@cW zmD=PXI$T*t5=_j{n6rtlfl>Ho83`{;wZ~vL^k)HmjHke3}KrO6M4svDqUeFZco@JK={i$4*hcYb{ z>*;>ZkHW$Ec(}K4T=ym~o}!-TEw;+zQxFUnIJ+(mjE?iCqSr_u?IX4GY371H{3Omt zCUixnhEUu;=w>u z7{OOI1!Hq%b9Hr?^zv9cIv27^nO);Fn%n7z~dTr%iu)t}7F zzQL=dbfVyT`PoGCOC-L5KMm~q|2+!^n;7e|G_=(iEsS>6FaAd31gg4$Cwff>1Lg`axxX5PZ*$#@ovsNX& zdu>`?+gvm{wfxTQ;933v{3c4%7)n;#=0Nd+OJnJe-1@hw+|XBqfa(|Iu{J&wqp(r~jfhuoxdMsyaf8k$9BE z*5z$$cl)GiUw?rWtj%PjZiUUF0^FpIU#me{#iRA~>i&AXb&zX}v-J93CDO&!L>9BB zm(8t~clax3$)1-Hfu0MmF@XDhwWEbX%IwJwM>_rA7fEtkNFllz1Dy75G6P;Ry#Mi# zU;hhBV@KW~Uv5kc%lO{=S$%DHO69l&i1R#ENU|QpH!($2(m~53bc%t-f1WC_9i(Aq z-?&Ty$iHVaw*+*duCJRBZ3EOPQi!+@P9}X6dubm~e>!<|ths41X{OPlPm*)nVGEDb z^R-!es4-Xz&*3&yi%N~eSJAu7>tpoR0AT*v>N+=`DO9YM=9bdq@b%rq4}NGZmdBl9 z&7=_QbCZs%%0=t+$qxg@MeHMfPHdvyo)!wf$Jg5^3HB9<4%q7cAV=@4Laa(9kxS0) z30IdXh+;L9>0bY;W6c*dZ@1z?7ar?7@t{taZAv~D0PHA5a;}f_q;@Ljju8pdf$`&4 z9UURAhqg#OskqE*`gEJz1zANI{7XIi73p+p+ZMO7+6A7X#2m*OpvbqhU!=4-W~jU| zKOUJlCV_XLa)Zu&O+Kuy*jm;(Or@l&P6eH>=6PT7^Y(6eCQHpvRRQPVf)gy=CPxZc z>8y_864DR76-DB|`d-zikrX>I&dofjuuUJz%qJku6WlaDPTfle`~^dsXwDyitT zdt6PD)xkZ0FFFCxzpBdBdj?uZFN|Y!1140jSf-Z zOOBRKNyWR@gpR+v<1z~(nlqKmSP7}vYr1U4meT%Gc|CQFS+OpsY|tRg5N=@V`AM{k z$4VC2#V4mnlLzqYnrD6Wm#-Ke#QEET^J>ch@_z}zO1iC1d!rgrxDDbJ673+&%Z%+XGW)7_qPKvc>4|BQl>xNE!QdJyP$ySsz zgcXcGntf80=Xgi(iGwcpt|MzN@)3*rhIxC0QQLQTyo#c2nZq1}+!xqJ<7lSd?iA=U z^wHOk>AKSJB@>EI+D_b1CQ|F%{jnvySWcUiugC{N+7Pn~@kNIbQJCXH5o>3ImVte^ zs|`7cK~!a6U})sO-LjLa8#vt)^1r!k9OAP@qvl9W0U zfBoB*olr&fp40~+38lt}-zN$tG(h%Cvt8b+c|J}3-Pv2S|897&?iht@0Y*8YKq>j9 z%FIE0i(5x%U2qpMR|c>~#I<~`@NMo-^NCgPH-}A}V5n1YMm<>qIQ0zk7PQzupHn!m z{sl@i1o^WuzQu|W?~cuNbRsRYLGJ>$NT~A!sj5-4X9#Wxpr~og0OM{QS_Rd~lAx?? zX=o!XSv0jK4v=4i;8Cvs!U>&bMym{fyUJ1jn&)5{)KXJxOv-@-;#)m5t=cubku zZgxjY^z9-X!DoL#`?y@hQ>K~SJ(9|z%pT>b^5aC1ARcBze9mk$pe>P@$nr zv80Z8QIT0fE|TqmgHCJl$jQ=d4W`yFXjHGFtdi^y4_glTbiQNs#1QCy6bEviN*{X( zh>&8`&xQ4>e#Jk_F+Bh#xKqQ}ftGjP@r`XGTQMJ$Y68w&v>Qcs+>+ zz?SU=>ZiMx8t|I&?r;=R#QNTDB3AfMw{rVGeVZs)TRnN(m5%fI*M2``^WdPXdRI~I z>+l>f|AG*(OVjwa(~F`2#)>shA|?-cRQJe6=sK(Umo5B3WP^+B5Xk$CNx{d+Pqg9W zl?WlCW<#NdXyCg`w+H-x^aIZEq)cOpGCfS#VFweVFBK@{>+QwJ3(F6GIa0l!_ zm$%g3cf{_iFUm`igY{VGGSkVz3!zpqX}P9mZzcH|g0sYDku};m>Cg~`CuZzH4d^qv zBW{$I=NgC3bX*E2sm}s9CMRw8Xzkv9W3OaFJONRbWJ|l^5KDDAi{NMr%gaw~5euJ6 zec3iNc3q=7wD689Ou4Fi3H3aZb?3ZbT7G9HUKVty3+h)zkSlw!*e!H%jX6&YH;+u4 zcguRM&=*K4k*0kvRF{b>%Wz&-Fw6w6cv$mD8e$3a%4lq1O44+8 zjK&6NYvm?Ll&Ngh0+a-8BLN&glT4%00?!+S>4S5`qY~zdA)jD_L@RH#>q6}~3;Unq z$nf_Gu&}Oof5e>4wqq}6rhGJ*oJFTQtaL~jmc%idae$TV{BwX78SJbceu{}c0er)x z0>fFk?`A*OD2O>3!s-2IbMcNB=Yd7gk)mejb5#c_uVYuF5YhUIKbs>l4))on=|OaI zsZ)V<_UG?E=92}n(X@kW$6K1+%jrMx^slek|HVx({ZDR!`TtdT{^xsRV`uxH-~=N( z8zbBQB`5y>zPIXTV;3{qHZrU&x7_tsTNQ-{)d^(v>?qrToe+iN*JP2w^6fyZmn`KG%?fN0HXP^4NXN+IkAPf@jSs%86C{~ zb-BQCK|<35)8mj9=G1n_CZo{v49uVrSs4Htnt(JsJUk940F2z;?%??yp~wMRvZBFZ zadE%=tbgqQF*|=lkL-(x7Ix72-(N>YX13<`#%5Q~=!bt?3MGB=hy#jxG9d5m(=)OnGk*BVyaIYMf??+u9`5)7&LJ4w85&(bxq->K0p?eSH#eU1 zfPOFi*MF)AyurKr@Ywuq{Rfh-adL2EaROfD0{S#lhDrZ)%aTG9m-sty1N~R8~PFbGw1T#B;WtH*pt}P)AH3;9X zd|_|roKK6h#NS0^{51sEKlp9mQ_=L}zpgWl^UF$b>F*YHYL6&Z>ejk?3!vPD?;sQ9 zCg-mVRQ`9TVfKAT{LvS9_=gtsr+xn8|KFaRp8I$X|JL5V^$SRIYHCnpZGP$c`|M%% z?-CgsLBD&L0X+Np!$&vA5B|`NO@N!-{`f_I)a_xL{L{Yt0g@bwB?kD>H*z=htlL+x@Ys0RTfYKlwNKwgF^nZ2SrX zjrGZzwU++11oyf8RQZv~DvH|5a(4dB1pcHIE$)dreBRpqwYB~�KSD{Gt2?BBHi9 z1A8#kJ2(MjXmn`)_V)FGKGZjQ|JW=2LPwnNn}QOPgXd!loZ0V9)BIij`uqG*Ui_eA zKx!j%FZrv9uS|@uKHs(e$dB-wA)AAT_mTWv0es(l@*n%(^kigYWkCMte9nQ?&o{La z%T%Uyo4qe?m-DBGes@Ull^l8-^x3oO!pmEp$IXQrddnmj9ktw@V|y!6{)z|I+~hCn z(O6aCoiI!D1kp2L@%<>zO2*Z3@&C?vmPS~bWg+6NMLTIDZ05{Z`MZ{*syavS6GoJC zujlO7;azzD*Kzz`FC_mav1eBC@|b~JAxlvH3R-rqA{h=puM%urEDZe1w!kay{*vif zztTOXp*MNXKN7AEY_4tgbRVJKP6tjkI@4AQl_Ik8j^9ClZ8tJ9|A<{dbIC3PVx~VN zz#VfmJ+`<+=N=fyuy`}t81!OtJoKy&x+?v(4jSjy!45Y)`tdBQl!ifM*bsi37>!gZ zQtIRNPZ8BJv{XEu>3O&~<`gyaQ!z>9Ri$`@^aG>1A>_gY1d%9&+811E`E69XsKq;n zN1`CabFhlfTrPz)*V17I8UPUU2qR7x*uKAsIU1U3Q%o6ev=4}%N~KXe+UBu%@YL>& z2vRLRQ%z3(ZYW6FFP^}{>_YV1i*C^~DsvgTFiD_)gBw@!h&$Qyb#iFH^9IAnX z_;vyl4(H`P3iWR2qg{q-(j8wwB`R=gjGFYTncQOE*T7~A9p>eAi8^G*>MrHLybZd{ z>;>f6j!RGNgesP77CVDEY=FLWr;8V(LX-Y^^$FpX#LaF zqr=x7t1Cr5WzWG`nOq^_fAX_QwPjM1$<;#6~0S#9_?|yIGa=RZ}w&sijCaP91pL;?U04S!PO2-3-dmbH`Og zg;1%nqS49qeqY7D!XK=qtE*Qu#gGkBDqwxIBD;ENTcw7{35;@Y}@#%N2&bAiv{40Um3ofM4xkS6{vkg;$H&U&G4pB z@XfW>b|igy`B<%HWj8xc-&|X44A+LC4qwHJmWbqXY}_|H4DQNOzA9MHoF;`M3%zV> z;RLex7g;;rC4_TlJn#}alv-xj~&B|B!aX5&QR@+su zUquVU3ng`l$_tmV-Crk)|PLH_8BoQ-~17}lRzxfJDaK-?Mh-9 zQ^-8I^Hd$-)pQeYOB9!{ZqC*>OU5qCuiS_SuPLnGfC#NO^Qk~qt@2P_+JyZ z$_ypY9%-Z2%26B92(*)`c>_V6%e@(+N=@w66v^F`s9|~*N?Ef-cJQ#rrKeoFt6>uH z!Fo?I(xUWRjYDBWYuXIemM=%I|k-oDd+<6`1vq!aD1KDBe z>5;+!L#JPxZniKzx<0}uUxiEt25-cn52J>LlG+$~)Ckp57{;`gkdR|QI!+T@z!A{Kt{FqLD9U5>@ZKv6x(KQ`5Th* zxt$#!2krrLPH(C>nd*~li~9MTrm{%8q(kW4nH!KSD#~X(h?c|et9e5g{y&>$Lt$%v zYcGl7`jY1<=XZ-=h6P@x_%(QQrAu1X%e$%YM1lGjr~9M~18-~-KrcDJ*8aK$*?Z`O znle+VN@bNgxSw14YV`1)*ppCeZ$NYJzJ`^Z+oJxlW#I~FN|s_gDw!deiKJzUVhQ=< zI^oJafb=reZm4{1whG%DgC^YDYg$9t%AN!#Fmyh=9P*w{gM{B+eL|1u!2YLBwigsf zI&b8AGP9*DVf?3~a+vaNW$S`Oa4Uee zFj+|li2j`sd-4#%3+-NpZ-NF1`quID(t}|od^q8&Qx_?E7r8SqvdvUFQswV$rinQ= z*|8~*i&?^}xo=RG#_kTk{Bkmny`KriL|r8mN%FYqphl5zI7}X5^af390dlt4!6L5E zEbFvf4=8KeOD0SwA1AGDE3}>yvcdsUu*@B;f@lZ{Q(0S?H2c@v;>--g z4fGn~mx~jln1s`Xy9g>HFDBJ}=tHavnf6IBNJ2=I@G_5Za3WVK5yxrlA&A0f;z{Hr z>eu+^GCo*X057Q6pYTa*Cf(dwuu8okPW{`xx?(nKpcv%|Bo-;we0TE5*d55-0^@R! zIL%3N^fw!+QT^wd_t^Bg{&r)3PA;20IixT+F7@ma2iQIX%i|vu;o8;`qvG zATQivW4LQma%JJuFeDVOt!hL}pJc!9y_9iuVGnMG(4(oJTi>-WfKp>T=yf{@rg7qQ zxO&tiGa-^!z6$YK@2&(q94*9ar6)-{_2y47YqM+xKq0?HY_L?I=Rk#lJel0ZYUoCY z-yi%qAx1}}xk*?56m085rSYZ`^RfArB-JU$PS3bpntD zdGzO%I!v90E?lPDN%IfLy>hwA z`v0{uD$lCH{&!&Q<9aABbm(VivF$eq;Z=@*Jn|kkzgEo)oL}+-dLLOB)S0B%TOLfV zLl|RcEf!Iz@+s0k4w5IWKe+#8S6I{etS6x!YVHTM^}EjioccNIa+08%u$&$wye}SH zT<~~iNu{NzZ#ouNLFj*9c0qVe@g;9M1yUXsGhU6kRA?r-IIhCTE$#_h*b}NL<@b8O zOunZ-EBCYfhb!O=A4=1SI2Emigm)44?ctr*Wa?)P)~H)S3qua)Rpn3eGio9q+WM+; z)azsl_BYUz1TWh%9a)rN`RCmAwQop0gp9&UU6q9!G#b={AmJT#m;Q5jFl8Yw9JY+& zoc1%9XltnNP@p>x?i{G9XqxPF3>?1l0N1$*PJ;eHa+?SVaWf1+T_w0Hy|`mO)~acP zGnHUGYq^7=`TU~kiFJ@=@I2(BX?fxr&gvoyiAg$G_13l_V5-NhQ77JN@WM=@;m|a4 z>?YERiUw0!n^5F#N`B`)(j5KhG)2!#)^ok(S?7nGuK&P41%rFNYJWvFRl|#W@$ZA- zm3`#ztc(gr=~K#dxNF^DpU<4Of{jcmCV%UA40~w*C(P!lQG~6wK3mp5wRxPdf)Sho zu$(aYcx?kmkViB)y2?L~$)1NL39iEs{LumNGf=510a+QdZ$hm7u_{9%5z=|rj<@_U zoAS=uA4x6?Ia6~+vA|8_g$^b=#R!Fj2ir7*!E1t`g5F45axVsz4<5Q=3$(z#U~;t( zsItpBWkF205_emM0_N3Z56CIr$z$^3@L~7jzV4al!L(7Z3?&16_I;k%XLRmI+VSvZ zu?Ub<+OG`$oFWX1@{xb#G3lXqRxgAV8fMBZUhEreSD*sC>CWiEeeEfq%mA&SJHN^IQ-_|X1+O-4N6rA0&X$$Y^kz4VY%lV zlvl7*teGkJXy_T6!L{)+8C*xt6G2>S?v2f4+c4KN{=wF3RF)cpzVwHCl|`GHQmHQs zT>!gsx*Vq?{j%DLE3PZDqP%LLvfA@MgFTG`nnxEkqrsuN@l}u&0C~CJAOnS3PV2;b_~VedjZG>`ch)H!O{m)F zmqsO6VX#)Kozpn{%zKb4`X14ZQxQyn5cR1P@2kku5jxQR3h&{R5W=ArRq&D#mBIH4 zy?)~ehTYEPbrOUR-~1oSmQcm6Oi2z6Rhrb{{lQ|H2NXdr6V;j#*w{)@S8LqfA!&$h z(n2zh*~B}(btXB}yf&_Vk_7IYc<6gjshzx=q@uxa43UF9Rd=v&Pj9x!e5^!bQrGw8 zW)68rxqHVEZ=sNtUeM;lakHU3AZh`#7_snE<6kAfqpoQbKXz?)Elqz6sFdBoc-p(2 zP=oJzr>eV?aGXX~);C3mj#`V^4Bp<%7zqBv~xRAuJ~OpTkfubnbIT|Hxo-4O92t!b_FUn_Q*`srKMQ*0H&CiF;nvQ=x z&{aCQ0Tj+jB1QPHAidPS+ZEw;wn`VNk|a~ zB013`{-%}Vz*HPZ?_Zqlpx~oYM#d9O|0HO$tP1Zx0)1snf)G_6>*XU$_SLtvH&nC2 zPWp*7VHirM&uW#C{ACgk;>*Un@X*ke#AW;=oJ!0x@eE#0f6k=mg{R|^p;1TLaZQ2@ zY|$UZh{QTs@hQjH%Cc0I;&a>l)aKSt7aerEeCFT`Xk}8%bZ`PkR@zoy6VVIYZH|=d z1|<6*=yq5s+J51FRNOd-xa0Qi%*iyo^tKy{JI+Ev?>=M|yAq$U0~?19uJ7#MqEPb% z|M6&WN?&GNMjw^HrjodNaI>1?&d>50sE_6rgd4~ejZ-^bjO}TNe5<_HiNL(S#_N;o zYKU;vPgR?VEo3ubkeo{*Oc2~W998y~Nfqy^N&4N=hZ7HisDqehM7zBnza_Cv7sP%O z3Op!UYBCYH{qyHgEun?w3x5U#F`>4hB_>|GY}>2TnJk*_yfc|e4N^vU<-}KIGcfz2 zaRiz7E%5Wb8{Oi%xjD7?&JhAUilc<}TCSK=P;D@SR=P0+t<Ra+hNQo-$j1~)lD%Ggs|i8P}k(P4{+kpSF7tPX)L zX7XQh-^shBZ_&@DKO@C6VmJ{-^`5-3d}7v4ex!0PpR2S&C1HUdGe_y{=lY5?FE0FP zUm|l^p}qm)qIIYh9hsQ4G{kVG?$?gJ>O^9--`gEs3I-;Z+M{i~darLrXIUOIlBgrg ziKUGZqb2V-OMH%P_|Ym0T}@Sx(&DFrl!nIdvd0Da7>%kuXsq44f{Afn)-%<%gioeUB?74#Wh#6H`6uL)RD~;e zC_|zC(4d<8YguwbSRt&_xl2~|kYd#5_|kiU2S2W5zr2!s&tm+l+ByXBlRC)*ipz#< zoq(UpCm}&bIf!vZ!XtRp==0Oj%|^rX&y$e4o*)B@l6w)&CE6V?kAwtQf5|-;?Z=p> z(dnv(Y{n64az~|uL|miz$E`s7dWYLdo$ri~9^?RCODp-DnmtNgcMrt++mO`Yo3iLc zYAO_t+vm0r|7M&t6>7I7)lbCJQpbZ12yyFzpmZ5WzQ%!1FXJDt^%$CH=0A~Xk7Glc zTq^z2Wx*Z1p1D%6pu+Q}hoBw;@L{}|9Q##Wd{+L$X#XYCOxacuaIuzAut4~6lw~s@emtFP6gU*pT`_COVWBdm9Vv1YXKrFm#4dju%CTPlQCBRgnh0& zjL`wD$LW&OrV!KFx0T!Dt>cG`!9y;<%K&KI8{Zz~lswxOQy)xcSprfswrP&lg}Y^1 zpWoywW0k-;LItIRXWY??r?0TdcSLhef9c1{lb1xiN)jw(BraYEc%7C!#Ycox6vh>u zMl{Kf2Z+RuY-J0xp?P$8FSMo1nJJyq_EY+z0SL!G?N*Wd%NHj|852(3fxdNSIa6t? zRu{ZcH4+o%gK(GsYI^C$6Ei!C5R;RZXs_0y`gZs8ie;eX* z=5D*TdK{voQMGKy1Ct_7(jZy98zjx|^GnX|JQRCHegMaPA1+Ji%w4TjOSOK7w#`Vc zKQT2Fa0p!QMVWW+uoiVIyX%Y&qme0A5gG@OMih-!3+MLR;p(}S;0`M@W$CrkOPcVM z(EWIGVXPm7Aa{7@vGy!8m5G1yn`r~GZrxy8n|Ced;Ov`+Ai8MF)I*eC&k$DLV&S*@ z<2~pmwmyy6)M)N4akZB))PMycRj(0BCqLU8TDls|+tL5h=QE5!{C6G4duWx3?))KYEk@RO8^KKQud#QF2Y2i&d-3G_D{#AY>-|l!}r2*iM^%D_yjt4 zzt$F4`_By=FB%maiX~sGn48t^+ArkOyq#tX`klyatZ1aYlh2+^-d3Srl;7F4Ud0+* zrE=`yU)l3@jTfvf(NsrwVRdh9sl+C8(CsQN<N` z@o>Srb$EJAAGa;X@d$r!NN*ya^$*VnJS7I7=}@Ac;)gG3#FFH_Hl#fk?5s6JdZipa zq&2wTiJ^kHdf82jIbQ=s1eR=T!teZd7ZT8=Ut|&L7YPdxM^@GB`4sTMTnKfnd{~jX z!gZo0^C3+`Aqg`n4Z9Rw!w z(%Tc!Cpq*O`6@LFTQBBjuF9p~lFmOV;~^2CPA3xJ9d3!+utt@qIB%%fL$n)?=`|CM z1>cgWtPub^pOS*>PBYMNYr2+Kw4=Ezx88!YHCin%7E2le4kFfUhVyUpu`o9abYl5_ zgfo;t^flB1ynd5T>?{(C$w_BacEhMxpr&oewPZFQ*V&XRxgB6Q(otlp#VSC^PjgIP z=N{MdUX5ObTTuvR!_s8v_Af%e*`5o|=!837eJAjwji+u_R0nBfL+*_|v>_v`(+oI^ zIz}2M=AY;O*Bou=hlv*Z{-rv^G||N;AlH0xoGnzNKOUuX+V=J^yY<%l`fjWlTKQU* zZ78paX|Fb6Gki0i5T}H%TBCbuw^m*FjU@F8>1>J5eT%MX?&EvS)99a9YPrk9CaV${ zyujUG<{Om_d-xroc5#lEVbg$5o5pZu@^Px31=>ZdY?Wj_4onLc(`+eY)l^{XsTOWU zMG&l+yny725^nH{E~-eXl-E6>V@`?hjBP*W)wl`=Vo%u)TQLrx3t(kpby~@c@3_AMIm-$y; z>0Buo83yi&<^22jq|O`D=^x^w@$$p5!T`hPQexJF1yS}9*IpjFlyI{si%j8R?TZi{ zGKbqwtlqkFCi=o{E@^9Z><5|5R~xzRKbigSDR*~SPgz~4Ys%c!*S3nr(T&$ZY2g@T z+rBTNk#8tjpEDChjzJb$8iQqe8CsLMOis<%8o@s1PMnQe(Mt_wV<-kIia?Xb$j^rT z2@(1@(vBK7o499(+hW_hBmux8KgMg+WuJ}5U2^6msJ20`QM34pWyguhXM2iQzGE#}G$XMDrq=8fyAS|KX6Z@52W{YGQ{VxHH*jE9~!2KSd6UKIt`24fI2yE4JDI zUDJ6x_WBec{DE1L+Y;3Bld#@ib`vjs4WLl9Fs(af(&|_>-pD5mCSN`UO2dioxziSJ zdF#D~#K$ruwB!ayn2@V?x(h;uW>oBJ$;votLSQcvqQb6fmS}tjt!+^@Ijmy}l7eEZ z))nDm;1DM2Qw7;uPnnHOR=H+inFRh5UZLkN0v;1hJ`gE?Ln#+dteK#H>q&t|D8N=F ziED<9nP_H%nJyq9Zct2>WX>)T^GtT?J8;3j*7;R0Oqp?SC@g#$82Jt@Ez5UfN+Z4o zx)T9znMsQ7On}=Wv@>^Ze0aSMi9q>%I{XcGEOaQ;bebWf1>5?e3hHp=?EztT;ahq-Cx!&0{q3HqylSPoYi7T zP5z|*SeN;MkNBl^B~f_QVk8_PL0s7r(L$_9F+;7M90}>2k)p8#v8aJghv6-yILCsG7J0y zrO5#7DufJ-WN+TwW!w8AnUzw%F*pq&+Us9_K$Is1ULb+L6r|{KK+lj@md<-AQ45OC zW8X0J)q5HlRB<)G-EH+ebS9`m5qMH_1F9#^1`UXtr5AOfQ+R~$2+uR?iwJ6h!~47( zi&!w3Uj^HvWZ}-j_TVgG(`9M%KXh!hXznIRBF6R_9fjgVrt^TjawAkNpIkTO-mM-% zr%Er!ZU-mBX{amfS@jmc^!x!26|Gs3=JD$BeSb4va8qd-|a%&g7rQB_VvZ`XHycn&Yava2^|# z6$YGGpAQ|Rs0!1{-DvJ))|!0-;-yO-AGvum-yaw5mF_v=Eq$2XC8NGv9FVo@<`*} zfI#tqF=5fk&jcr3_Y$R5Z{L$`Sq}t?%T}CevsefeGq(MX|WDE#MEEl8gQVo z?#SwNMrvn(^pPat=d?d2CB^6@hzjczZNsrB`@C#WAn5!cqRr#a7?rn(T+dY^Qg5VZ z$CA|NiJa;39vQP@zrZLek2zXu;wHO_xM04qaoqgj@rOZ4RcnPmkndM!O79b+^Y7w_ zZ(CWmD*wdX*e_g~&S~w!dQi+!#{#I^@Fw~?<{kGZ*N#J1GNDbuZex7T20LvimW?|g z;-9*kJX}YS^45QXJzQI8xf563U+*h>|C7Gf@BO}nR6g&>5&H!1nngO^p}VY;AUawrPe!CeQ5-^p8cd;(e1asFuf8WGdAeLD z^`A=dY6<=0%dN3sS5(fbX`^<-P52=+{1CoT>LUq^P`2A%064h9tlB%6721jk29W&J z6m^>MtqKQ$CGwUS{@`M0hvNZ-%B}~G#;i)P8>4f48&l_fbv2~77qcL@>z(>o`aZFS z3fWjA(yJ4Zt`-n3Bmm8dQ!OLi0{3cE=r0rtXe#HhPE$)^>kV%Gm5>>PrG zVWQ|dwr$(CZQHhO+qP}nwr!i=*faT4sid+RS3ql~sR{W`^$;Gv6C?GGGqqj;v-5 zIfPm*cSB01G5MM$rZr!{dcml?IWy_DHJJm(37yq>^OR0vN(bFXPq~X5o=*5oUcY%}iY<9|&DKY@wD4a0-M5*KCQ~ z5Z*WjRI)G!rg^o-;QbH&MYR=`ed!{Svw?AXsqaB6<)o73${5`X9~jLBFADIRF&0n4 zAz(aTQ?Y`-9%BwXTk^qJthNF+GAoKb6Rb$dl^i}g^#V*RBJBw@o1{xeHyTKM$K1Qf zpzW!%#2~$9gont@XQA7%Iklgy#7D=bJQH z{~jFKnGsy0p|$$MFG#K7Vvu$ZD5^2N|7P>IHBnlTSohNTV}WUH%&%hDxDbgKs<%$7 z28Uq6$wtR9mbtHmim@?Ehc9@p*2!=w82+OH)Yow=ex~Kh1FCg=c zH20HHReZ%xgzHV&wmJKe31N73&*g7}yRNBb#Lf7OM`5}Bbk23P>q&7o>Dl6sH!xB& zhw%MrA2ZKW4Ao|XN8W;U;Mqg^?p6Y+|i;`eEh^I~PC|WpA91tJcQAjL*dx zH+rmQWC+ED$@aCv#H4>c6qUkDj?|3@@L9`#I*MXqo!?nubP9o z)8G>(PQ*zYpPWgl*~RLsmWDUudQzs>vdF+Gtb-%;ILGaO46&@<2eeX%@P{9tBWJVl z02W0oOSEytZNVJM?8CNfcDD9EK#HaKOssA$KJrA@fj=VV zhHWs$3QUA7#fx+X%oxD$rfUbcpPvrj9RZMez#S4>9jHh5%QO*%o!>d+?n3)Iz!!jJ zsb~0N+c$Eoe19SL>{t9jjM`B?D&^O_Gr6wXK7L61v^F*RF#g$~y*ZR@xv1FR3Z&g% zVgC?#_yoYcl7~8p#dm#cdS7#b?1PLR6P*tg5qa$v!`%s|h1F0R0_);{yI?X$E=xsC z&R2kjF$&F$&#ylV`*kbU1bW)=8ppPkGg0A2wY7ek_Uui81A!-VNPx_n)U*$uKSFrV@yjx zrMbn3TsH*U&K53mCgGIn9$};C?zg=0pb889@am~(z4L9iZ&}L#TkUh6hWq*+>pEM? z!x^?AS}PwkIQTSLfojg5A>!wBZKcMGceLohlgiz)Au)`7ZPjRAq(0En*oy@rfz`H1-nCv(PjH@0jo<#|yny>xjpA*8NO!nog;^f9;4uL_x;qM0zd^WYGsdVA| z^Z^5ZhA^SKg@S(7kiB2Bf&?vr6Dt+6BKv11OgQG+sl=!+2Sf#?_taQkuN<%nKd4?X zO?e;sR$5|F6W93`qY7FEBLp-QB<@J&8O8p|b?t9Z)?sc%VB8{xMQVjZgBs`4RPa2# z{`=a@7&dO(Cl5-f-e#d7EZ9Ie)*b{TPg9&e|C--V_}LFL(6z<-SwP&A6D79x~JcjYiM! zp9_Hb($xpc6T(?~W?x0S>+h}75u(%O$bvQ##coT;XficRhEgJ~ws zf4Da9qIQMhJ9Blr#sr>UlC#?<7)h@XcNE3JVnmg7g||^q!{8Hi?8!_bQ%X+n?UZ!m zWDwk42n3Iw(0h)z=nQe;Qu3`QF!0rA1{jQT{qM&D(Fb%*hv$tzTCSHG3{Ud+=Fsdr zRjBM`x%I~|A?sCL)CVRB@y$94+FJqBF?BPsAD+s6@IEs27$_}bf6R^AR%VSAYC=bB zc2g@<610mJpWNA3fIE_zUb7}V^7#us@*NrOlY}8sy&?ue$Ddi(^zr6Vv*J4w-F(jA z;s#X}rqm(=JT%d2JhAd7m}t_B16@y?7(KA?)0x@!ZX5!`t-_l8AJOI`f|+lNwZ#lE zvF9RTLLp&2fdjV80-eNQ!MmJ-WgvyRbCWxCIe+Xvklf3KzclUPpax>S8UuCM?Itw@ z5M?I!qyZ$R)sG&}&8AQQn`5uRSkNoJ2abZ^I%=IGObDNij~$Jv{6%=Re^q3s3@;-c zibdVgt=|t0wVvZY{F%>2D;=mlq{_M<>i_hkABgh*C1-qJY1r?-%{tEgWVn1NF(%YB z8lqS=Y2?<8Kl6xEN5x@nIUsTE!GC-tN!11OZ9 z=u!Wa7l9|u+6_o3Yxt8Y62;b?zm-h=M*}GdZ4K`AGcNm3 ziFoKN_iU7;79-0i>@+eI`eY0U$d|O9y8kVFxd9)twQ__-)N=%8yRPfM?-0Z*>IEKG ze|~Qrz{)m256rMq>vjE@^od?R7;V9?8isv@48CBQ3~pym0mT|fr6O5V^mjB$E8pfD za=yH)RFVJZUBT7ha4t*(*pw{_OHCG@lvK;w5r#k}g27oH%wru+p+=ToAhCjtL z0A~-Uqyo7*@9;LI(L{qcxsULW=^utpRxfH3&fLc%uvwLmfMyfU8f?;+sX&qgXg12{ zgPPW_wbnESbiVghCvT4T7lZfC6k2$KfTY~@IwVT{Hq)^S)Lwb9P@lLbo)p^%Se($0 z@J<_QZ*Ot?|B)Ps+-S4qV#2o^vv{6?sg?ihHHKNcosk z2bXt2geG{<$+$H=4c=`9tuVGlA4RTR;BrhNp-7sEG?5$N3{mEj6<%kljdPWSwe)w! zxx(b$ZKyHdDwoxKWo_Ryw|9rB&9UMTnmu-X{!^I|ZSYt`LQr^haH3UhEX&VIylNt%%lc76cP~Bnt%DJa zluZ5?ZAQ2@Fa(yZ_IXdFO!ay}z#@LnDm--goufsc+icUT6ac5Hor0r2^Ke~d6{L>y zkw7M$9F;`&JMQ0PZCMD)%_$c;gM5gNcX&!XG^aqO!ngw$d%zS;BupY=nCw8}aS6P2 z7Hpfy*ENB(G4RdsJbW~9yBUKGD2(%>&_0BGyeu@6Z!}nq-+nYQ+*UD}1ddvwlLQCy zM|}1j-X!6O&{}OM;aIPdhRvn@x9&I&Ls-^E`n;XoPYWEG@7MG{-UJtEJHW@b!87OHpuBfYnZq^3zg!bqf;rGdM9HI~y{SYl*N0Pbhx=9{E`- zi3|gGHL{P$swnpRW8}FO*hBx!z5N$$jz86$StMDO114PU52wqY1mL{FcucDXfJvtCU+#+B`4alddmJot#(WzI7BMXHvM_si*f;{0=uV*^f^OG<25 zn`xrkE8$u2VNz(aYF)+go~YjMoTyz#`OuPq2N|h(B#i%0=2$;q})hL1DC`RNXt3 zf{|MigEB?{EfA)UG*DRcY^CFw13yf-aR2noftp<-NoxiX)D5@0sQ`+uK;B*7ujU21AzrVvK0n+ZQv-;l$TQ=D=-IWGodCV_7?9?lt^H#&2oyDP`!j zbqKiz(FV1;E@HHNPIDhlDyB1HJcLs`_-S3v?;9*4^%ems;)qBHfI*~KW)LW0O4Z2o zx}{hV_D;QbE&lSplG8(O&z@|^&-x7|R#98oraA$E0MNC86XV zql}hY?in5Z;t4C8izujb25x}uq1b$9K$DX>EUCh0D4LJ8KDeEhzKe^<{fMZR(C|Jm zy(*;@B}rT|b*Z$|h0*0S3FD>U`+6320X36M&K31F{I_?FrnjV7ZQ~9T3;GGAGG9vM zim((av~~xbON<=xx!$h$5s~kd1#Z1xEo+55e8VSKx<_Ku_eX(+$~0MDO-{%umv2oQ zg50DMcyCFIy37h-l^bVGO-mHtUAR6VwdqC#pb$oJcn%ifnq>;0H<*NnwH`ht9X`%i zMbZqb-8bZMp119%1FkS}g#)zU4WH10| zeeMhc>|ibK4R_Uhdt^hoEwCH`0EVLljDf^OXv>vpp1QD0XhPyav?SC_+jW512VmNP ztr+Kq;t9d&`|e0pwGZkk3~A0wTelL+G2eXUm3ZL;*YIeX@YJomcRn%FTX42M;4jnj zQvG7a)fcF%Xb1}^tKCS(Ig;h>MSZu965G$~N-b$*B9-)9P+$_EFvAeY`(!jTA(@uq z#IYat_rVfh6vH(o(45Qe5L)Wqyc|l&#qe5)b8!8k#OgDoq`-Q3#CXAMJ9vH zm943=#Akk@>U1c>R>z{qQJcs8&UBtYHsTYLVH`2J=L!Ei-1M%SPS$PTW(?Na`T2^e;g2-HR$!wPr z&y$;37I8)}#l37E)mX1n^igS!KEn6twlSInQ@$|k=zUL( zBK(NwUc11M0qdJDtg^^NkXryZqU=dtG&r;lR~*1k(4`Ngn!AQQ95#P=cw==nEvcz1 zq*hDr`p!nz1s4oaWZxyawv|B*5U&?rY?g@-K1z6+R%(3xv0NG`Q0PdT4Ym(9oh8f! zQw^-_clUll%=JC;>zJlAu%-xa1{@Yi>p`^YfPlYF={S6IBCQ|4FWP?kOY#|GI>x>m zyAudZw#6!YpY~F^4BJBK$23-;)SN#>8e34R2HIO=Njv5xas{quP@R)$p!;_JPRze; zion+^ZMyv5AbP!OG{-7?G@g*}=>*8Wo5d14ecA_{ZfQ!p^l~;T?`^*U74cm&iv};} zu+6Ubxn}Q9j8d(>EqIrRb?MuVBFBvJ%xM{-0H0C01Cboja~qcRd|c?1VB9{oF3FR4 z*)79S1t62u^7ghTC0&yoE#YZfWF=AFx2dtzV!aXOr##j@@f(Fh)7U44q~UXp<`S9d zb{;_-{i7+e+KcR!xbe2y2(~8McyFNbOQu>`wntuk2XPOkwyjV6hFD6S7ogtCO$gA7 zsUi`M96OK_wJ{t^ls$K=Z@Rk?cuR$rJE&s06tXE&VD@%Rrm>EGt_gXY#G@5^5IChu z@wJOg>4(@vB(3fPf1|`kW3wp@=@3~1H1-ZLU-tpC`DOMzT*;Kv?}}fxfU9&)$weIhVIvn{c9(k#PO#lf0@+#Fikr^0+`fn5 zP{_Gr`A=BN%i)7bNC`Su;2keL1-+MbCqjJb*x-u$34y&G>%&v`^p^j#0B%V1L(grJ* zvq8CFJ531HNTV)aRw>`_>|MoMq}OjSh$ik!p^km;+=M1z$s^`nxRT(~A=XVj4WO@l zQgu_d#;+yxPRlF}UM4_@MTCC{Jm9aWr3Y#Hspg3G^H=HNL+-^u_o;J;LB#Ej{3X`c zY?s|k&V_#>aa31p`7ahTW`o@S&o#);J>;0 zgMBH>ao}gz zC{(oYP_`M}v5Z^Fma`LMFMuwogNYwEDnHfB%P+MVgn~tDhxSmL;n@x9375)^fD@1v z!>6ptVdcYkkxKv!wPKo#o+kaBeKrK7K7f}yh#1x=8}tOtg6=Lep58~fMgf@bv2Vk zl2$-^ptt{Sm5kp=tlcSgVs3gOVIRY{po95-3;t2vvmAbw0rW0ITjy@mwiph!*!yu? z!uaEKFJ$k|N&o32{R1MaPr7QU7u}kDt8xKohY6po?M6Vs)8GczmHX!r!{MEyT|hfT zMMcZ5oFKe#R2#HzauA8zG357+Ebd@Vz z%^2;R^{+4MrSonwzK+*SE$kna$8%R{yMccNRgAUQ!k;qWHr2PJ4#WX=PL{@TyBgEZ4gKWJmS*>lffDY@pY^HR(@ z!Nu4iGE{OiZ4AeruoFeZ&6v%CMSh5j|39VFY8A7C8ZY?3@7zgmnV71DfO@caFPyz@ zvEy}L$x~=JkqQg@|JKnk5pc4y|DV(UEudj!U}5@S2AcnWk4mkJsYcFr5-S=I2zdwVo!#K> zE~^J{tZVp~Zm_q5dk{B>d;7s4BuM%JB-cq!r}KH|KD)o!UHskoZfljA>aA+G1;q-B z<_PWJnE+-(F*7tcbvJ+j=!wA{&?*3TMZia@21~#i-Q%3uYXEu-cxaf|5~Rf$3=p?e zCMPf`K$n1Y0LlW;z$E0s!TGs(A)rJMA)Xw8HMTiGZ(A50Ff#HJKdrwGz!~13fF4mH zfwefm?Q}Tx0v?Pb02f!k!goC|YoI_tGc1AuXcIUPiR$X}sj3O!a}(7TfMx;l!euEW zE4s6H0;m9_37|^|5GH_{0eQgBK6n7=#v;;lIV;6AbUFu$0a$=g09rvhLqRtv!Xvm5 zm_UFW90A4iDKBi8hytKa|JqvwBGv)*$lml27_ur%` z9Ee6x0fIMkeEJT(2?F_ozG;VmVBFeYO#tQrNDG^DQwz9I;eVHQ{O!*3|8vi1znLLK z^p5K<9`yJ8R)ZxlqgdFFMhy*qBrOkpkhZf-V|_`m6us=lntaATsAOBW>b zP9VM$J?g)GA&t!a(r2W>P7KXG#AEUJ3k!%(``;dlw)b-xD66NaDKi^<;C54H9G_7{r)|ConQX+FGz4}1*-CHMC~~`!RqhDb=fH-0OqhJxarFpU|`W zR=^qBW}tX{9x?hucM3{2NO8C&b<4tKl*Cb~4mPD5Vaqz&dzvF`uTzQBU)t`n8gp|#^S1A=vz9sG-6 zbNqV^tMfOpa45L`R-K1qRCc3biY>tGvtJ?{B{zpxF0b~AE?0N2^P#ifS?F9K% zx_gGwGj2#Gsb!|LD0lC;`p{peCoT4zZdi0K#h>oh&p5rxx^&!Tfu5pSwysGq>sjnc zbWpV4dL#DAPDpRP;Ni<)-$j+x(=Fdn)<2<;Mep~|56Iwe3OsM4SHG#{DPav92{px+ z3BJY5cXk)>biN@eR4la|C3Di~PMX)#vHPOE8hR?63zMI7S30&Om&2QjiFfSx0j+sk z;M}%l7FSm7OZhNe&pYt~A3VP?-MdVX((70ru^|*|{33a&#s`P!VqD~}{?BL6cn&D` zptr=jtS)70Ni+&y^B$f=OLTVn^8Ws!94*MKg`b!*B|(Fkstj>#Gqk$sBO9*0KjE7h zT%6MyN=k*}hpl-MZoVNCFx?wibk8dI$?Yb1r6>ZxncopsFg>)6qpNpHp&_yE@B&=( zv0Y2UV))LExT#udm{LwDT|19!gGB?>oBrrBX##>-;UUyBW_!e72o4s;%+M|K6#K=5 ztIq4vfT%^9m<%VZ^uw#VE5WCpAgYFmJtUG*%7+de-x-#n zv8>K5jE;318xA@S&wzI)LR~h>WK$(d$ZiOw$Aw|)hlmjFd80C_cwkrmHdF~n_xz%c za`!BpH?Vac7=NdGEyt9i_N52oseV+RoG5EpKw~>@qfFo_;e?s)dhV4|ZgXQtL#Wl= z(Qh->kuCv|qE^bpTCzD9@ z&JgXzo@)|I(LtMvl5GJ<+;pO<(A3(ZrLOoFt)k4)iu{8=?>}Hr`V$1odi1-fsL7M) zG|6yl;9gfqv=Kb&lB0GqmCmA)z0!tldVlAk5h$9G;o#Pnw$yIAe>zrYviycT6q7D@ zeq#Q?QY_mUjy@XP5J%qi1N!fz{!1PPiT;_AHyPqs=Q(lAjX3HHjgp_|W6J)@z+xuO zz+rYKbFsl+N8Q~C;FhFRRR2_yRpZJ(!esZk05pz3vMHZ|ruk=*O8nW`qgqAF~HKE*f_5pg0=f2j$R)q280(8e@|L7UCph55+$e63SBP0mGms;!oj`&6Jqv_t& zUg6j#KW1)7x&@EXkBMW)(rB2r)xc`+S)>eHIS)dVxgH?a;+6SipJ}}RAUaEf^)v-N zt`1ydkS{5f%I|LS-a*a4FwQ|*4(*pI4+!gmij#z$(8kU=9$tau>B#L@he(0#nGqf3U#kfqTaZSGvI>28d4-?UsscbXiB~5 z@?%<)JW#T(7U<0#;e12-kF1d4cZ}V|2kq?(HVyFZX#F=Yr=d%Qau{Y{;B0@Ko_sU@ zVM%&jbi9|g>h<`*HZ)T~4dSzQ^mVr?>EP-UYSl7R5ET|+2sN_#n<9iA#c)u^hj~w3 zlnhGUk!f^7R$8c%NG>L)HSEK}AOm%uYOZ1?$x6+i*$lN`VpRwOEALgdoxDF;>XIf~ z%+BSUq4y~6Pq7i_ABnvXx9K74Qo=Dkh|IeZ97s4<(Vrhv$v& zYHtThKDd$R-wQPm1J8e)c?Bj7ah`Ccv%I{G3cirr&*$Ed_t%k*Un(T3RbqE->wHKS z=xWCR_l_2YQ+X5~FMm6y_7H>{^~A!xCIP;AFJuK|DylN4r>GVjxM)2#zqV_ghVY_! zw>f8fS<*Wa>bB-%mG8sXJ*)i%mmRL@N0_{R^Kl?7#4N61E*|H?$?!K8BBJjZL}+mx z*8P04W4aZV@7h`KfK6)m?cmyFD3jEUWe7&qR;&8(;WEk-Jdhk-Xim3%uikEow<)t7 zG^={|3~Us(*#&FC!_S)Wan-hzY|8s{aAG2uyi2fB;tD`>eiVnhn8N^Lja5dinz{0i zQL7n&ar5_U!y%zpO727DoPXPx`xdoBQZaRA?qei2j#8K|EoX!lrz=epAKa zvIuni)2@V-su<)7rc1z(ou zSHCm+0A|Qb`UyWG3*Osq34-~j&Eb$_L%9~#KKtNR9|-ASmpV#Npf|+w{R$K8o-r$q zO0b$MFp}^_BJfXJZ{E+6?{r#TKe0EbC>vrRS>_*1=hORA(#9)=V%Xe7%~SNqecfd! z{QP&c;Jpkgx}3c24meq~&0FKLRoMN&zz;YutidN_vv#|(1`uq~)A=g>3&nN*<+Lj% zvu;$=mhYhQ{yj|u8FLbGa(0~f9W{sbIiXj1DOna+E2)vUXFY88l^BbSbN2h$t2&#;IxX^k&tEVSaIfIWV#?-=;bt-2gq8J}EEP*_ml? zF}&r;w~t6rV&^B zGomY&Ilpe0RM=aH*ZpEmZe2&4 z$62)dRkg+TYP|+$^6sh&!NoPfP;3lpet7AbigpesQmpn{(pkibP;=T8d`IxJjsGPd zZ5TZ&wZD_)3uIU{@`a5b)_E_~=K7J|${C!i- zrboTO*~VkNOJmM;Y_2iHhV*B2F|JVL^I&iF@SPR@spwAi^O>8o*9Z+QulAcMd8IbkUduN67!@xsx$|CJm1*wCpfiEcN5=NSy$ zv8`GDHnz|xd9ys(O zOfFH+U_c*C6_16w0vIhakj5w$;lXQ$=b&fm$#QWiJ{%fvG*~$go)QqYW08hN{7m{i z2-00YVVxbZb3*oGlcS)=v z2%KNxs~%1>L0`7-Ej#01VhTk2$u1$wugd7wZyKZZ8Fk?akPq?Pd<2XeL_Dt2Y#pZt z)qC(MQ*@QqI7UVEh~STJKTN6lsf`L$IROs{HRi=>fFZ;Z={zNWkP!#_S&q7!cQp}2 z9%g4(A3-89EmiR*>>(jFUOkCTzoeur3r7p;*pGPJ1RDeyWy5>^PJ)WDIHeryYU0Gj zEfc|r*z=M= zd&rr0Vgqm9b{y7gJceby+%JhL1}7#nHObV&!|m-A1lUH)<*zw#^vmcZ8}$#~FhX_G zOyS6O5)the`^e8rNWIE2PW79ycE1UT+mvUE297?K*yj06R;)-VyK~tN%1(nEU! z4ci0r!tuHWP}x-vioqAQAJw>~Kp&62?gsC=uD_1F^2hVlDS#>bB4;Pm=UXMI{EE2m zWekclbb3CTFV!qnb9-sLNuX5Aphh?zq`_PM=B%ocqnlO-+QmiUvw+1p94H0w=iC z4us~;WA2viqHnuP$nFII{shL}!f@{F^*ZqUNPZiQ7%9nh<=K9C_x$F%X~x{x(*c?V z*72EZ_rhdcxfRFU!HhA9ph7J_4btAW>W1tO+IBA$Aex^UEsVrItc#)1bV*;k)srgRZIy7!Pvh6fDjSH)#kRy*aN_daW=k^XIFljyO?w5^>B7MV+3qJ0W;?n|V9EcnQky&F!N`i9+&a^3Tn#$U)pQ*9Q+f`ALGZ zTQWJhct)mfZblRw&bvkHNuWMlOrUj%))jxP-Si?i;#n0@g7)<>n**yP5nxL3{#Y_+ zT5eNQkx|3}*F5Ic*;Fv+iAJrAOl08wUo^=rEsQk+9#k&*9Ti?s_HFoEc5mZDDh07dBV2^f5Sce;!$@V0=G;Pe7x@I~Lko3a0qD^wU>Jhr-RA_hv2Ud#${S z3N$qd4U$!}`%yp^J!US0i7cu%DVy zk>T)6hUR+`G`6wqVvg2Q63^?ice139ZRhGrWr+$DJ+xI|R00|0Dik-^q{N6u?#*wz zzSOn;{pWXoLO5>#6CHo?Y&P${op$Lu>(YEZimpb^<8!vnyqEVOK}P&5OcEUlfH`hZ zNeQPe^ZIhKKfm*dn~25eKm?AGzuy_!o}dc93Fc6~dL_lN5aI^8p+?%r+Vx}a*h1u@ zihx|k5~zpg*>eHp5px6INsXMNbb{$)6QAO=ZP){E)Os``e*gS^3A_80__50dlj3B2 z#f{RkvA{E#4*v#rk#9Soq4zY;W?KksA2RXyX{W>xvJC~s+YZp^da@q*I^Hs9ms14H_j{+>T(@$27KK>EjmO*4SZ&%(?p&FtWE8}GdcT$FoJ^5B$2&<433nGHLU#HBh_X7H`=9ea>9Qzqg z@hR#RSZJzm+D1#6ASzKW*^Jx)Zeu?O^lAbxqR+?Gn4aldz=DwpC(>faD>09cQs!xx z@)Vke#I=rx>5Sqi!v(}0IPbO~=EIQkZyYC}y*oj$}OK*ZnXG1*NUH z=x1aDb43+P*A}H72iKIJ3N!+iZDrNp!%#v{euZdP^wUNeW$IiLsYLwk_P85X#^EY3 zmMN-)^4xlYr!3q6S5+k~_*nIk$qW2^O8PrEjOkr}L_F24la8uIF=LE>J_Wr(St3yw z^iEMoTw1^0YrKYl*1)E1B*kgl(tc{UyEbHW(k~Wi2`Y|Ong5!gsN?Wieh_z8WKh{l zsQhF{&LH1J$4+h8H*{gX%~-E(pxL;@Lwj^jjmq|=SW2tKjQTF#@+5wc8K#DY#HB>0 zuR8U$gIXr*Sq^cw&3{`2usgSal{)-~!rHu6df?cdAK1RrJ;=!66tPR_T7r^p_GSCq z2a5@TTCyY|!?s@smBUHWSM>faL<DoRyu`5RJNMa|SOpWl>eu z@j{l=#i8zwCupIXhvi63PzU?(6CB>l{&^c)PCEoU;|IWAA~{agv(zVQIfu0jvWB>? z2S_Wx?+eTq_p)0Ej{6gSCzNxokvoC~Uur$mx7;Ka+M9Li<7qg&J!6c}j~Eiz<5Dy5 zdT@p-0!p{|eg3ISqwcv|Mb(DwR{!#{eAc$m!==j-i(J*q)=NuRB*OBg7)0FKT<}*k z)tDv(3Wj(F2*3qmbY`?g4eCAg5gfO)u9n-YisACp!e zL)zIU{G#kdOs;UfMto(MEr*KKJFiqmg@lht!q4yC*-ETSJBrV9qM3zE5SidK}s4=zDHBapp}I#Eyu~SK@PpA19h0b7KC+9`FnZNKdg$u(JMlAYG*J!%_mc1* z#Z4E>HN>GW$P)KnM658Prs~rIB!8Hw-P6+reA?}2-g67j6e$M8NcJjOKA?PGb z18a@Q=v};{Y>0_}7E9K)|9B;&3x3?qSakrc@ud1H^Y4M}`B{SW@3j<8h@8cLk1cdn ztqhQ^^ftezWkkPhO2jHpTqcu&9ckWC56MZHA%wfg^gaO>FyDW=lSGY$!-ZfF5l9E6 zc`ZWDTKMFC5Ig_MZenGBdj4+$(PRAzm9qqf3l$PE9C3CZ;@6ypubARRynup;NV^ep zjbzK|@M$qHXXGz}%i+&2&Hn_ea!tbqm4%*#e`-lyLV#9G)6HMTWW>_Gh%?AA7MqSb zY0ec&a1^=pa?(c7M(i5H zR&RlHD2;f{W6xm0?tM$<3Drn_>Jn4hk7RnOo3MaXrEm)$ilg&}w63;c$9%f%Jy)VE zt5!|?#%@sLi78W8$_R+nE16?btUCxTMtcEg4%l0tY^H}T%&HC z|E!d0(Z?_`w)V0g^XXxf&WBwi3)d)x?qbHu|2%L`vp?k+Gj*s0QfRzWEPa}|A4cwP zgz_$yII_#(ym1V14P<$TqF;DOhV!S;QdXR2rx7LXQ6%{zXo&KQ8+&P>@#=AElidi) zM4nS z2>5Jdk{A~U%L#&i9d8X*_aKVOV{5}o3uV&02sIjyHk|H5wDdD*Xr6&kPb`&rg3p@G z@1I0_(7t-mc@V{(q+@oXsHu4d`Q2o+RgNY#d$M0{y@oSzxn0Ond*9Hc;I5(Sm3_)j z`eSG8Ikv`1FvDRGBVARce4F_tw7xWbQ}%U|W8ySnc@~|Xn9<~!{+#e4bbkm+#vdaF zQD{TyZwZMdmRc_~XnjLm6|pe>%SL|$^W;IW7EhkTXX;oYwah&@oe#Z3{XNxXF;sY80;vNk3%{;rnqz>lCzykvp=15_8{M?Io^V zxFQ-H^+*K@9LTrk^$PGIVJ3U_2`@(}kHmR zStl=T?+u1sOW2VeWksyN`k8U?C{Yn(u+-|=!g;woh{k8v<_N`1ftldiFcD+>kST)m zvd6b74k;R9$B{@7#MvThQB2+o{KK~;loXx*sWD}pCiAX^myYUjhFSa=_xV=1ac3tE z*U##YOA?@$Y=@i9f{M|#CaLm7Dt~?idd#M|L=jeck*BjtnkMw3pZKAqa3d7S^sN)b zD>kC{B;b?I?t>(p$G;OA)h--+mmDGUXs%T(5U!r0C4bSl>@Fn%A#5dL>VW5*S|;Be z@#V_7+;>hL&+hjU8ah;QLN!G4I%}uhs7S?c6pjNqJ9M!rJTX8OVYBwkr;U=IFF7C^ zIhl6P)}WP%bC2jKO5ty^pJL>SsT+ZXUNLJ;~OBGO6An8ZOa_&7wvHjW@P=(k7UWcUu z7~joxwi|izq1>k|kh(9uTpgH`e6$3sht0gH*aacVo?2jwI9|4_R_UAP z7wd&Y%uuE(^he1h=4rI|GBukPsN$GQi+6z!2OaxNC5C2~L2( z;I6?P0>Kh25L^>1$nx87w`!|)Yrj|TkG}nG*FDwMRj=#Rse207+D`clfkoN4Wv1pYGSVXjj*a zB(8KN9H*;ldr;_K=85Jl#GC+VFS8v+J?2J4Pq~6jxqvvQmLBJ~AvOJqo|BcopD`sV zX!$)jSdx#RYBY`I044M^u*g#6fi8sFcN^(Px z+7@?7UI1;FYbbc_o;8+)jdL+Z5;tEcHwD{1=E=e9GltC6jMZmCGnpsjL<>=Ux70pN0RfhQ;Zshu#&B& zV^zc3(u1AZclwvw`f$OV=0soCln|`am_mBvDH{?E=c|uGyAgjl<@x8nE;`^$5dV5h zx|^nWcW24tL8I^9!08}17+=Y9_VW87*le#-pg;jIGqTiVTPv@NU8bj?wO1{nmYB_hE8rRLVZN*cGxsV}7c5p-Q{=O%^CUOVsepR13_+t@5CmPToBXQt zx!~-lWPe(w)ire;H_oCWPMQVU9&X533|7W!WM$;niV(?#chpvE;kFk!LJv+RCW=$T zx3?Ig!%&dnfX+OQ5)zfE>e!JsI+S$7d}>TQ9Jicw$zE#65xYf4Dbl&VIfpG*?i)v} z<)V|whJOlGUA1`hg#RCRX+ek2Q4;Q3BR7;l)7s^nA)DGbS|F5(#9Q5S6iwa_;i_M` zNZViHpAEPaqO>i85>M6$M2qL<2hUtXF{rmI8T*5ic8ar5iPnGLw!pYHw6~mV3CBzR z?DLZyY`f29W!bNIFQCPYbDPw4^Hd0iYX&*TDN_+#_qj+B%A7g0@Slts&VX+epzE=$ zpQs#WlY1X}Gxhsz_0AXtRNkrV=u4-8uyS=5o|;zbSd0;52wW!EVP-7MEE}UHI~ZUT>A{iB-eZC;a5vH<8<`f_UvaqU zjB*uNJ!IStE@QC$`;h%Z#~QP`to2semawBej)6bsGWa?N9^TeR>*!Qe_zCXz5}CBg zBda4H07m!e%N9Go>a-nC+mEG=kf~6@G9xCQM1CCRc-AHxE;XKQxbk8GyER{D?3e)S z{-%5<8~v$lSXUc2}k8uZ|_tHoTn9BiHZ6|N|VxF=#YA~=6&4wkhuCu>(^mH)5e83pxJrM z_x^)ZEOVgE{ykwebdot(8|AYsKZ12BSHKKMkL@rq!YaOuwDPPoM3ujD*HcTVAHUJn zKpjno%O=Varqb}N;;mud_R=2krBU98T6G^6#sit7u~|s@_>sBv4;+#6%@w>%V$Cv@ zKII)M*kY+4!Jm%~!%VlD`3Fak)N1ATi)etW z@{x`?Ev>cX1prcn8Yl_bK8A9rtK-!~+CceK>AsEYQkM^QcAIuJD2o_!k_z@UO-Jrs zO1|&|lce8BVg4y#;AzoL@Ewvq!*SsF(-y~k%UY+0>QX?EFr+r-FFc;#tlYhyi+)PR zJ6}0NSF`oZ`sj~1sEh7$p-z_NCW>;N{0}VpMDMnX0qurQ-zC*Fy0=wfyY>A@-wHh5sAtex6khydVx7DXD+9!_mwJhhOA>?17e-69NEKH?z@nv&R9d0YruWQG>d;x&cH$PeT=i z!#g)CfDj+wzby9v|6VJ4WN52NEmr?9S(6d}>nm*f9@h8=hC%F6kNyU5r6om4+4Js& zrG0(2U%>sIgSBNba>%r=OS^1e%k0TYv|?Vp`L>WhjjTqN%#&rKJHop>B{@|q^=(&D zUEK#ACD@NvC24uwDSMVsid0Z)f|`AW2KJFE#(h|jgFdY9M#K6oHo<*EWijEj16+!Z z6D_4-JrzGy&=7_>tOu|sHAGtjwLxhX;HFA1RSh;7epp79ge?GRG3 z9ux|++#vfy^g9=hdGb^C7PL4Tr%AL^?0Q^=#!nr=A28!k2pF8SUn?l!cl0ZTrSzx- zPD1-_LKsot-n&(yga*?l>=^4*V9(;?lP+(^o zijPTw!W5G-jkSofzI$xS}d-wn<_o5z~2TB;m;UU`*7q z6Bq_Ez8+BO!l)104+8ZFvD092j-tMK!GkK!G_H}1*&3>@v1)&RcR}uRb!BgaESf=d z4tSJ_MBiHS*N~R~JtLR+{A;d#Ne_(my(~QB)>m>l)4!(6#j3W}gW_j152aLyvjSQB z{eg+#1>HF8{?2va^7S-TzA0J5=ZfG>A#II(Eevf1ArxRS=d;mlORd7vxKD}u%S@)o z_rX4pDo zT7`R-eT@I2e8JLj_o~VS4FD#7vR%e6HY{_&Zd?SD*Oc6s(>KvKdTricH+WXVJ`u|+ z2B}T0g30B(LyPVso*LWGp5lwmW^z!UzNqA%+BmB9VOFr@D4gDS{9FfiI`A8Kx=gP% zb>SS(H$8KZOxYXcXy<|buyc9~>uC|aMY>96sJQA~ROu>;eWEcG^d2rft#=4r2o6kf zSdob%4H|aP-5$PUOtf{QVEiCO4B$80JWdBW)vwYA& zvc+ES2Wf6BIiFOTYK<>18(dau3yPhA?%4Epq+_R6tp@G)VCaOtAμov1d%m{LC` z5XlQrR1fW(A1>(=>ug@BjmjDHFmK`rnHObHG0lmn08CMlI&{bi#UnlwzJl(!;yVJ$ z__5WG2&KaU>o(!k*WfWF<4k zNi@CQp5{a@EFbaodrj4!^j=b?^bDrPgsNTMs^ZC`?CT}7gzCugmDEBH{Q?Fu6_yGZ zx9eBDYSz@H9Irh*pj1y4tMDE%8B5v?yRrsPdfwJ@n(}LA)DQ~w6|Pk43wd`V6K{1v zI*rl?>*F-J)rCY}I5s0=YHY3i$Pg=h6Y-t43>7s2Wc@+(Km*$cyPcI($;FlzKEOWd zCGg!v`J-|xz6B!AmS%;tpq6-Qo5n4yG{W~a|DHL`iPSW{0h&U~QeX6#G@QBjf&N==*i~m~swq?hI*4k)->Ws3swdshDEza6=fa^2%3hqN7x&OLY z0UFn0nkP$;Eb@!^<=^cW+g@XJp8;b=$&Rbqs9lY7=|8UwVrQ(=*n<~eMqAH>k@4oGKqy3gB@J^1RRzER|K&3^6@MrKgjkanYghJC%^16l< zLNk+}$QmoCwC^QkLtv-?>yR5$$HKISQ>I;hjFv{k}1sKQ6Z$>lAjMpwl+PRvbHfAd$qTTv4I zGH%vl$5g79Yfcd9XFK1iezKi`g|o(YNoYnu-Z;z6<*4Q0oHs$-(>)UMYLZq;1lD1U z8s+gEg~g|`Q06e;Aj=Jt@FD#!^V3So_ySWZsg-}(*Cqo*sQWh+_LrAq)b!@ zB>1DdZX7O-$e!<)#Agz!nHh6}ugq)}jjwenE}7FJGBclr7maAocd24C{u-pJ&wfa$0P^Hb3{igE4Pyd7YrX}8V1tX zsj0qQs+IyXC0tx|1NxXE3Os#er|FoA&7Y;u{@ocyJ-EipdE-MfbD0dH6SKJZQY@0) zAnJNrDCx>4oF`Un`#2tStogmn`=Wz3hV$U3N>ZfJdU}BCIDih z+(SHWLWXqY8w{251@^$@S^kyCV&P^bJOFQD<4?OxZ6 zrarwt25;`ijob6CiN=}EoxEGP&+L%f14JkHx6`gK&#!7R6We70T4VRFg~=e>FI>JF zAFRoqY(o)aP(hduQKIG0cQ(j|7aQdGB()HEI|H>-r>b^%)iQaF(SL5yAT5<%sKi!u zuQ>~|>C}YYHI(wij`5IN&{vbX?(yU%?buGKE9zKVvkv49e3+H(K*pJz7uV1TCRurt zzDs6i%o8MWOgJ$NSCr|wXRciA3?2M70NlS>vh!`vnA|+r>Yown%9Fb5cs!p_Z^r_@ z!p0|HEgJJGF^{M9roLC%-_OJ&kN+AwNFlq{w0LpzvNI)|p}lCu(Q*NerD<9j~Ud2+hZ`j zb7k|vZMEC}dBLA24;2 z%o*=;VW_L`F=)kH`Pf3Os(XKr#|Nj_dS&au-m7S%!L^`^lVF3&Nu6Dd* zH@IVGY!W|Js^DV$s3#-#FiCFbEL3URbZtBOU^G>V(L()lyz{>3J^ge6O*U$nO|7=! zS_n@7Vbg=ZT~Kv!QLM_(viIG7H>Y%Bb!f+38w%)un3sdUV~V~xyKG$=4n69)X$T11 z7(43;PmjeWfl6VE95b{9q@_>`-AJ+I)o6dKO+@vrf4uyr6M-@`@~hX1S8IwrqyH75 z^Q2oKig>(0koRI~yaTVR#PoML6uIW+`n{{jc`M=U2X}w*DB3yI!*KKcg@mt2BC5}D z>&V~NQ!~X~VwDVm?UZXV6an>$;Cz#{TqESc*$Yz|S~eHx)V^yUSV{p-t{Z!BW+BLx zur`cC-zB#Eq?I17X(CNnl!&9B-01_=gtYJ0%?Tl%iF;vOm73#0_MC)99^_|RqFwL3T=@C=pWbK_ z4}b5Qho7caKragnV&&+ywhP(|jDxtbxIZ67m$nUtLqVadVW&hPLri$|xZ%QesolO} ztADREDfO!he?a_SXC1t(yAsf%^y6|3k8>dhur7s0OtG=GcXtBlV3o|eH^XQxHI0(x zSkGB>AY)_G$K|A9>)9CgSP~}$YxizW=e`Q9ubUeNYOuI&KPQgTrjP6Khp$bIdXs=F zlwrbk#O){VFZ1ai-9)>jIrgG zr!}n#ch~A13Mtxrky{tZRz8;baN+3ojH7FUlTS(z>RwDt;n}F8(4z&v~3* zuPAL{s%y_r#_+Z0s%Ur^ye~upm_6HcF#57lAb0a6T>1MZ;<_e+f48kCXd=LC?-{q4Hq@}>e zeTB91xba>m7D~CFrq3lT8dQ(NuJ=P?z|#dL(h>gVe;YdSM+9i+dIxm-bB(A|SM%<~BF(dS~b9-MWi&KmGI=OEu@Qzldo zRo)}1l80H{W5^3@wgWb#asOUH-FUyq!5)tu#)^u7Tz^e8YlDF_c3^v1`zW0E)DU!KP=Xg$o=qnL%AczU@CgXz}{`_2a`CxQQIey0h&kpIMc-nLVtr&b|%!SemLFpxG{xH$hQOXhm)u4>d9kd~o*dYRTFnP^bI2wwmRw2+ES+O z*D~0ycO{_`0!MVeD$aqo3AvNJZTQTOgM9#l)pH;KH?y0s_un z;Nd2Xy0+bH2TZCScQP_Um^PmgMT&-{vPdwiHjQv9CXm%B2rDFUC#%+Ba^=q(ctk<) zzIYY4yFf9qSNAg*UxL)rhRKnNEER#WN>|m%Hc$*jPj?+<8$hNq?SUfg&r|s!j5_(8 zFQ^=%zk485fL|u!!bz-~tP{myp2IX}Nw7^O|5>?Z#Xz?NwOL4;BEcSu^ek3upwtpU z>#KRHz>Y)P7jGWu8pBacbh*$M-&Vud4;5|ETR3gPf+Ezb->z2|2w~n~HZt<%wJeCL zj8~I|A-fw{O`+fPllidHV0b&lzq>gyvfo!*XZ(_=ewh)kQ>~}V&<)G^sXzzg<*1FD lJ0}pM0!9Dtlj7 Date: Tue, 17 Dec 2019 10:46:04 -0500 Subject: [PATCH 003/109] Equation of time test --- MAPL_Base/MAPL_sun_uc.F90 | 49 +++++++++++---------------------------- 1 file changed, 13 insertions(+), 36 deletions(-) diff --git a/MAPL_Base/MAPL_sun_uc.F90 b/MAPL_Base/MAPL_sun_uc.F90 index 8f375ac7d0ae..3629db3c13d3 100644 --- a/MAPL_Base/MAPL_sun_uc.F90 +++ b/MAPL_Base/MAPL_sun_uc.F90 @@ -469,54 +469,28 @@ type(MAPL_SunOrbit) function MAPL_SunOrbitCreate(CLOCK, & ! EOT(u) = MA(u) + PRHV - a_T(u) ... (6) ! ! where PRHV is the name for lamba_P in the code. -! -! ========================= +! =========================================================================== - ! Begin integration at the vernal equinox (K=1, KP = EQUINOX), at - ! which, by defn, the ecliptic longitude of the true sun is zero - ! --------------------------------------------------------------- + ! Begin integration at the vernal equinox (K=1, KP=EQUINOX), at + ! which, by defn, the ecliptic longitude of the true sun is zero. + ! Right ascension at true sun at EQUINOX is also zero by defn. + ! -------------------------------------------------------------- KP = EQUINOX TREL = 0. ORBIT%ZS(KP) = sin(TREL)*SOB ORBIT%ZC(KP) = sqrt(1.-ORBIT%ZS(KP)**2) ORBIT%PP(KP) = ( (1.-ECCENTRICITY*cos(TREL-PRH)) / OMSQECC )**2 ORBIT%TH(KP) = TREL + TRRA = 0. - ! pmn: 2019-10-29 - ! Calculation of True (TA), Eccentric (EA), and Mean Anomaly (MA), - ! after Blanco & McCuskey, 1961: "Basic Physics of the Solar System", - ! hereafter BM. + ! Right ascension of "mean sun" = MA(u) + PRHV [eqn (6) above]. + ! Calcn of True (TA), Eccentric (EA), and Mean Anomaly (MA). TA = TREL - PRHV ! by defn of TA and PRHV EA = 2.d0*atan(EAFAC*tan(TA/2.d0)) ! BM 4-55 MA = EA - ECCENTRICITY*sin(EA) ! Kepler's eqn (BM 4-49 ff.) + MNRA = MA + PRHV -MA = OMG0 * time since perihelion -! Note that MA(u) is linearly proportional to the mean (UTC) time -! since perihelion and only needs to be evaluated once during the -! orbit, for example at the equinox, since it simply increases at -! a rate of 2*PI/Y per mean solar day thereafter. - - ! These anomalies are angles in the ecliptic. We now have to convert - ! to equatorial angles, i.e., right ascensions. The first step is to - ! convert the anomalies (wrt to perihelion) to ecliptic longitudes - ! (wrt to vernal equinox). Clearly the ecliptic longitude of the true - ! sun is just TREL. The ecliptic longitude of the first mean sun, M1EL, - ! is PRHV + MA. - M1EL = PRHV + MA - - ! Now right ascensions ... - ! From BM 1-15 and 1-16 with beta=0 (Sun is on ecliptic), - ! and dividing through by common cos(dec) since it does not - ! affect the ratio of sin(RA) to cos(RA). - TRRA = atan2(sin(TREL)*COB,cos(TREL)) <--- zero at EQNX since TREL=0 - M1RA = atan2(sin(M1EL)*COB,cos(M1EL)) - - ! By Meeus quote above M2RA = M1RA at Equinox - ! and increases by a constant rate thereafter -! MNRA = M1RA - MNRA = M1EL - - ! Finally, Equation of Time, ET [radians] + ! Equation of Time, ET [radians] ! True Solar hour angle = Mean Solar hour angle + ET ! (hour angle and right ascension are in reverse direction) ORBIT%ET(KP) = MNRA - TRRA @@ -537,6 +511,9 @@ type(MAPL_SunOrbit) function MAPL_SunOrbitCreate(CLOCK, & ORBIT%ZC(KP) = sqrt(1.-ORBIT%ZS(KP)**2) ORBIT%PP(KP) = ( (1.-ECCENTRICITY*cos(TREL-PRH)) / OMSQECC )**2 ORBIT%TH(KP) = TREL + ! From BM 1-15 and 1-16 with beta=0 (Sun is on ecliptic), + ! and dividing through by common cos(dec) since it does not + ! affect the ratio of sin(RA) to cos(RA). TRRA = atan2(sin(TREL)*COB,cos(TREL)) MNRA = MNRA + OMG0 ORBIT%ET(KP) = MNRA - TRRA From fbeb7795609535f61cbf79bf40c1c0139713a203 Mon Sep 17 00:00:00 2001 From: Peter Norris Date: Wed, 18 Dec 2019 15:55:47 -0500 Subject: [PATCH 004/109] as used EOT_25 ... forced explicit J2000 params for testing, has rect_pmpi EOt with explicit zero mean --- MAPL_Base/MAPL_sun_uc.F90 | 34 ++++++++++++++++++++++++---------- 1 file changed, 24 insertions(+), 10 deletions(-) diff --git a/MAPL_Base/MAPL_sun_uc.F90 b/MAPL_Base/MAPL_sun_uc.F90 index 3629db3c13d3..9b45cb84fc58 100644 --- a/MAPL_Base/MAPL_sun_uc.F90 +++ b/MAPL_Base/MAPL_sun_uc.F90 @@ -156,14 +156,15 @@ type(MAPL_SunOrbit) function MAPL_SunOrbitCreate(CLOCK, & character(len=ESMF_MAXSTR), parameter :: IAm = "SunOrbitCreate" integer :: K, KP, YEARS_PER_CYCLE, DAYS_PER_CYCLE - real*8 :: TREL, T1, T2, T3, T4, dTRELdDAY, SOB, OMG, PRH + real*8 :: TREL, T1, T2, T3, T4, dTRELdDAY, SOB, OMG, PRH, Y real*8 :: YEARLEN integer :: STATUS type(MAPL_SunOrbit) :: ORBIT real :: D2R, OMECC, OPECC, OMSQECC, EAFAC - real*8 :: TA, EA, MA, PRHV, M1EL, COB - real*8 :: TRRA, M1RA, OMG0, MNRA + real*8 :: TA, EA, MA, PRHV, COB + real*8 :: TRRA, OMG0, MNRA + real :: rect_pmpi, meanEOT ! TEMP pmn type(ESMF_VM) :: VM @@ -178,6 +179,9 @@ type(MAPL_SunOrbit) function MAPL_SunOrbitCreate(CLOCK, & dTRELdDAY(TREL) = OMG*(1.0-ECCENTRICITY*cos(TREL-PRH))**2 +! STATEMENT FUNC: rectify to real [-pi,+pi) + rect_pmpi(y) = MODULO( REAL(y) + MAPL_PI, 2*MAPL_PI ) - MAPL_PI + ! TEMP pmn ! Change orbital parameters to compare with Tom ! These are for year 2000. @@ -290,7 +294,7 @@ type(MAPL_SunOrbit) function MAPL_SunOrbitCreate(CLOCK, & ! ======================================= ! PMN Dec 2019: Notes on Equation of Time ! ======================================= -! (Part of a more complete analysis available from PMN) +! (Part of a more complete analysis available in orbit.pdf) ! ! @ Introduction: ! @@ -493,9 +497,7 @@ type(MAPL_SunOrbit) function MAPL_SunOrbitCreate(CLOCK, & ! Equation of Time, ET [radians] ! True Solar hour angle = Mean Solar hour angle + ET ! (hour angle and right ascension are in reverse direction) - ORBIT%ET(KP) = MNRA - TRRA - if (amIRoot) write(*,'("pmn: ",i4,4(x,f12.8))') & - KP, TREL, TRRA, MNRA, ORBIT%ET(KP) + ORBIT%ET(KP) = rect_pmpi(MNRA - TRRA) ! Integrate orbit for entire leap cycle using Runge-Kutta ! Mean sun moves at constant speed around Celestial Equator @@ -516,9 +518,21 @@ type(MAPL_SunOrbit) function MAPL_SunOrbitCreate(CLOCK, & ! affect the ratio of sin(RA) to cos(RA). TRRA = atan2(sin(TREL)*COB,cos(TREL)) MNRA = MNRA + OMG0 - ORBIT%ET(KP) = MNRA - TRRA - if (amIRoot) write(*,'("pmn: ",i4,4(x,f12.8))') & - KP, TREL, TRRA, MNRA, ORBIT%ET(KP) + ORBIT%ET(KP) = rect_pmpi(MNRA - TRRA) + enddo + + ! enforce zero mean EOT (just in case) + meanEOT = sum(ORBIT%ET)/DAYS_PER_CYCLE + print *, 'mean EOT [mins]: ', meanEOT / D2R / 15. * 60. + ORBIT%ET = ORBIT%ET - meanEOT + print *, 'mean EOT enforced to zero' + + ! report + KP = EQUINOX + do K=1,DAYS_PER_CYCLE + if (amIRoot) write(*,'("pmn: ",i4,2(x,f12.8))') & + KP, ORBIT%TH(KP), ORBIT%ET(KP) + KP = mod(KP,DAYS_PER_CYCLE) + 1 enddo if (present(FIX_SUN)) then From 3b51f77487caff060d0c5130dc8a254f8e5f1709 Mon Sep 17 00:00:00 2001 From: Peter Norris Date: Thu, 19 Dec 2019 11:26:55 -0500 Subject: [PATCH 005/109] as for EOT_cmp_26 zero-diff version ready for github --- MAPL_Base/MAPL_sun_uc.F90 | 81 +++++++++++++-------------------------- 1 file changed, 26 insertions(+), 55 deletions(-) diff --git a/MAPL_Base/MAPL_sun_uc.F90 b/MAPL_Base/MAPL_sun_uc.F90 index 9b45cb84fc58..27bced13dd29 100644 --- a/MAPL_Base/MAPL_sun_uc.F90 +++ b/MAPL_Base/MAPL_sun_uc.F90 @@ -96,9 +96,9 @@ module MAPL_SunMod ! ESMF clock passed as an argument. This becomes the orbit`s ! attached clock. Currently we assume a single intercalation. ! -! A good introduction to celestial mechanics for understanding this -! code can be found in Blanco & McCuskey, 1961: "Basic Physics of the -! Solar System", hereafter BM. +! A good introduction to celestial mechanics for understanding +! this code can be found in Blanco & McCuskey, 1961: "Basic +! Physics of the Solar System", hereafter BM. ! !% \begin{itemize} !% \item[] @@ -130,24 +130,23 @@ module MAPL_SunMod ! !INTERFACE: -type(MAPL_SunOrbit) function MAPL_SunOrbitCreate(CLOCK, & - OLD_ECCENTRICITY, & - OLD_OBLIQUITY, & - OLD_PERIHELION, & - OLD_EQUINOX, & - FIX_SUN, & - RC ) +type(MAPL_SunOrbit) function MAPL_SunOrbitCreate(CLOCK, & + ECCENTRICITY, & + OBLIQUITY, & + PERIHELION, & + EQUINOX, & + FIX_SUN, & + RC ) ! !ARGUMENTS: type(ESMF_Clock) , intent(IN ) :: CLOCK - real , intent(IN ) :: OLD_ECCENTRICITY - real , intent(IN ) :: OLD_OBLIQUITY - real , intent(IN ) :: OLD_PERIHELION - integer , intent(IN ) :: OLD_EQUINOX + real , intent(IN ) :: ECCENTRICITY + real , intent(IN ) :: OBLIQUITY + real , intent(IN ) :: PERIHELION + integer , intent(IN ) :: EQUINOX logical, optional , intent(IN ) :: FIX_SUN integer, optional , intent(OUT) :: RC -! TEMP pmn: remove OLD after test !EOPI @@ -155,24 +154,15 @@ type(MAPL_SunOrbit) function MAPL_SunOrbitCreate(CLOCK, & character(len=ESMF_MAXSTR), parameter :: IAm = "SunOrbitCreate" - integer :: K, KP, YEARS_PER_CYCLE, DAYS_PER_CYCLE - real*8 :: TREL, T1, T2, T3, T4, dTRELdDAY, SOB, OMG, PRH, Y real*8 :: YEARLEN - integer :: STATUS - type(MAPL_SunOrbit) :: ORBIT - + integer :: K, KP, YEARS_PER_CYCLE, DAYS_PER_CYCLE + real*8 :: TREL, T1, T2, T3, T4, dTRELdDAY + real*8 :: SOB, COB, OMG0, OMG, PRH, PRHV real :: D2R, OMECC, OPECC, OMSQECC, EAFAC - real*8 :: TA, EA, MA, PRHV, COB - real*8 :: TRRA, OMG0, MNRA + real*8 :: X, TA, EA, MA, TRRA, MNRA real :: rect_pmpi, meanEOT - -! TEMP pmn - type(ESMF_VM) :: VM - logical :: amIRoot - integer :: deId, npes - real :: ECCENTRICITY, OBLIQUITY, PERIHELION - integer :: EQUINOX -! end TEMP pmn + type(MAPL_SunOrbit) :: ORBIT + integer :: STATUS ! STATEMENT FUNC: dTREL/dDAY(TREL), ! where TREL is ecliptic longitude of true Sun @@ -180,33 +170,24 @@ type(MAPL_SunOrbit) function MAPL_SunOrbitCreate(CLOCK, & dTRELdDAY(TREL) = OMG*(1.0-ECCENTRICITY*cos(TREL-PRH))**2 ! STATEMENT FUNC: rectify to real [-pi,+pi) - rect_pmpi(y) = MODULO( REAL(y) + MAPL_PI, 2*MAPL_PI ) - MAPL_PI + rect_pmpi(X) = MODULO( REAL(X) + MAPL_PI, 2*MAPL_PI ) - MAPL_PI ! TEMP pmn -! Change orbital parameters to compare with Tom -! These are for year 2000. -ECCENTRICITY = 0.01671022 ! 0.0167 -OBLIQUITY = 23.44 -PERIHELION = 102.94719 ! 102.947 -EQUINOX = 80 ! @ Toms's equinox is: 80 + 7.5/24 ! but this method requires an integer so we'll use 80. ! Actually in THIS code, EQUINOX is only used to set the KP ! at which the TREL is zero. So although its 80 here, outside ! this code, namely in SunGetInsolation where we interpolate ! between days, we should regard the daily value as at 7h30m -! AM. But thats an external issue and wont affect this test. +! AM. But thats an external issue and wont affect this code. ! But when doing diagnostic tests, we must regard index 80 as ! being 80d7h30m = Mar 20, 7:30 AM UTC (2000 IS a leap year). ! @ Similarly, it is assumed EXTERNALLY that the first three ! years of the cycle are non-leap, and the last leap. This -! won't affect this test. -! end TEMP pmn - -! TEMP pmn - call ESMF_VMGetCurrent(vm, rc=status) - call ESMF_VmGet(VM, localPet=deId, petCount=npes, rc=status); VERIFY_(STATUS) - amIRoot = (deId == 0) +! won't affect this code. +! TODO: add real EQUINOX_FRAC, fractional day past 0Z, +! defaulting to zero in the resource read. Above case +! would be EQUINOX_FRAC = 0.3125 ! end TEMP pmn !MJS: This needs to come from the calendar when the time manager works right. @@ -523,17 +504,7 @@ type(MAPL_SunOrbit) function MAPL_SunOrbitCreate(CLOCK, & ! enforce zero mean EOT (just in case) meanEOT = sum(ORBIT%ET)/DAYS_PER_CYCLE - print *, 'mean EOT [mins]: ', meanEOT / D2R / 15. * 60. ORBIT%ET = ORBIT%ET - meanEOT - print *, 'mean EOT enforced to zero' - - ! report - KP = EQUINOX - do K=1,DAYS_PER_CYCLE - if (amIRoot) write(*,'("pmn: ",i4,2(x,f12.8))') & - KP, ORBIT%TH(KP), ORBIT%ET(KP) - KP = mod(KP,DAYS_PER_CYCLE) + 1 - enddo if (present(FIX_SUN)) then ORBIT%FIX_SUN=FIX_SUN From 1db27ef8724a49c22f1387ec29b7fce50500b408 Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Fri, 20 Dec 2019 10:34:08 -0500 Subject: [PATCH 006/109] Updated ChangeLog.md --- CHANGELOG.md | 6 ++++++ MAPL_Base/sun.H | 2 +- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index cae565a2ffc6..b55bb248fb20 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,6 +4,12 @@ All notable changes to this project will be documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). + +## [Unreleased] + +### Changed +- Corrected handling of Equation of Time in orbit (off by default) + ## [1.1.13] - 2019-12-09 ### Fixed diff --git a/MAPL_Base/sun.H b/MAPL_Base/sun.H index ef33a3d0b711..181ac077573b 100644 --- a/MAPL_Base/sun.H +++ b/MAPL_Base/sun.H @@ -225,7 +225,7 @@ ! ---%--- -! pmn: Andrea said the following fixed cases are for single column tests, +! pmn: Andrea Molod said the following fixed cases are for single column tests, ! which are run at the same start date near or at the equinox. Technic- ! ally, the value of DIST should also be set consistent with these cases, ! since RRTMG uses SC and DIST (not SLR) during the solar REFRESH phase. From 5d1d13a63d77ab8e2922fdf429bee03cb493b528 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Mon, 23 Dec 2019 10:46:42 -0500 Subject: [PATCH 007/109] mods to read cubed-sphere data --- MAPL_Base/FileMetadataUtilities.F90 | 2 +- MAPL_Base/MAPL_AbstractGridFactory.F90 | 31 ++++++ MAPL_Base/MAPL_CubedSphereGridFactory.F90 | 72 ++++++++++++- MAPL_Base/MAPL_ExtDataGridCompMod.F90 | 2 +- MAPL_Base/MAPL_LatLonGridFactory.F90 | 44 ++++++++ MAPL_Base/MAPL_TripolarGridFactory.F90 | 31 ++++++ MAPL_Base/MAPL_newCFIO.F90 | 126 ++++++++-------------- 7 files changed, 226 insertions(+), 82 deletions(-) diff --git a/MAPL_Base/FileMetadataUtilities.F90 b/MAPL_Base/FileMetadataUtilities.F90 index 3201861e4345..ed62dfb13730 100644 --- a/MAPL_Base/FileMetadataUtilities.F90 +++ b/MAPL_Base/FileMetadataUtilities.F90 @@ -342,8 +342,8 @@ function get_level_name(this,rc) result(lev_name) lev_name=var_name _RETURN(_SUCCESS) else + if (var%is_attribute_present('units')) then units => this%get_variable_attribute(var_name,'units') - if (associated(units)) then if (trim(units) .eq. 'hPa' .or. trim(units) .eq. 'sigma_level' .or. & trim(units) .eq. 'mb' .or. trim(units) .eq. 'millibar') then lev_name=var_name diff --git a/MAPL_Base/MAPL_AbstractGridFactory.F90 b/MAPL_Base/MAPL_AbstractGridFactory.F90 index dcdd55652ea6..41a641725b0e 100644 --- a/MAPL_Base/MAPL_AbstractGridFactory.F90 +++ b/MAPL_Base/MAPL_AbstractGridFactory.F90 @@ -75,6 +75,9 @@ module MAPL_AbstractGridFactoryMod procedure(append_metadata), deferred :: append_metadata procedure(get_grid_vars), deferred :: get_grid_vars procedure(append_variable_metadata), deferred :: append_variable_metadata + procedure(generate_file_bounds), deferred :: generate_file_bounds + procedure(generate_file_reference2D), deferred :: generate_file_reference2D + procedure(generate_file_reference3D), deferred :: generate_file_reference3D end type AbstractGridFactory abstract interface @@ -169,6 +172,34 @@ subroutine append_variable_metadata(this,var) type(Variable), intent(inout) :: var end subroutine append_variable_metadata + subroutine generate_file_bounds(this,grid,local_start,global_start,global_count,rc) + use esmf + import AbstractGridFactory + class (AbstractGridFactory), intent(inout) :: this + type(ESMF_Grid), intent(inout) :: grid + integer, allocatable, intent(inout) :: local_start(:) + integer, allocatable, intent(inout) :: global_start(:) + integer, allocatable, intent(inout) :: global_count(:) + integer, optional, intent(out) :: rc + + end subroutine generate_file_bounds + + function generate_file_reference2D(this,fpointer) result(ref) + use pFIO + import AbstractGridFactory + type(ArrayReference) :: ref + class (AbstractGridFactory), intent(inout) :: this + real, pointer, intent(in) :: fpointer(:,:) + end function generate_file_reference2D + + function generate_file_reference3D(this,fpointer) result(ref) + use pFIO + import AbstractGridFactory + type(ArrayReference) :: ref + class (AbstractGridFactory), intent(inout) :: this + real, pointer, intent(in) :: fpointer(:,:,:) + end function generate_file_reference3D + end interface character(len=*), parameter :: MOD_NAME = 'MAPL_AbstractGridFactory::' diff --git a/MAPL_Base/MAPL_CubedSphereGridFactory.F90 b/MAPL_Base/MAPL_CubedSphereGridFactory.F90 index 16fd8ef93f3f..96e8d45648c7 100644 --- a/MAPL_Base/MAPL_CubedSphereGridFactory.F90 +++ b/MAPL_Base/MAPL_CubedSphereGridFactory.F90 @@ -60,7 +60,9 @@ module MAPL_CubedSphereGridFactoryMod ! rectangle decomposition integer, allocatable :: jms_2d(:,:) ! stretching parameters - real :: stretch_factor, target_lon, target_lat + real :: stretch_factor = UNDEFINED_REAL + real :: target_lon = UNDEFINED_REAL + real :: target_lat = UNDEFINED_REAL logical :: stretched_cube = .false. ! For halo @@ -88,6 +90,9 @@ module MAPL_CubedSphereGridFactoryMod procedure :: append_metadata procedure :: get_grid_vars procedure :: append_variable_metadata + procedure :: generate_file_bounds + procedure :: generate_file_reference2D + procedure :: generate_file_reference3D procedure :: get_fake_longitudes procedure :: get_fake_latitudes end type CubedSphereGridFactory @@ -293,6 +298,8 @@ subroutine initialize_from_file_metadata(this, file_metadata, unusable, rc) character(len=*), parameter :: Iam= MOD_NAME // 'initialize_from_file_metadata()' integer :: status + logical :: hasLev,hasLevel + character(:), allocatable :: lev_name associate(im => this%im_world) im = file_metadata%get_dimension('Xdim',rc=status) @@ -300,6 +307,23 @@ subroutine initialize_from_file_metadata(this, file_metadata, unusable, rc) end associate call this%make_arbitrary_decomposition(this%nx, this%ny, reduceFactor=6, rc=status) _VERIFY(status) + + hasLev=.false. + hasLevel=.false. + lev_name = 'lev' + hasLev = file_metadata%has_dimension(lev_name) + if (hasLev) then + this%lm = file_metadata%get_dimension(lev_name,rc=status) + _VERIFY(status) + else + lev_name = 'levels' + hasLevel = file_metadata%has_dimension(lev_name) + if (hasLevel) then + this%lm = file_metadata%get_dimension(lev_name,rc=status) + _VERIFY(status) + end if + end if + allocate(this%ims(0:this%nx-1)) allocate(this%jms(0:this%ny-1)) call MAPL_DecomposeDim(this%im_world, this%ims, this%nx, min_DE_extent=2) @@ -1105,5 +1129,51 @@ function get_fake_latitudes(this, unusable, rc) result(latitudes) latitudes = latitudes * MAPL_RADIANS_TO_DEGREES end function get_fake_latitudes + + subroutine generate_file_bounds(this,grid,local_start,global_start,global_count,rc) + use MAPL_BaseMod + class(CubedSphereGridFactory), intent(inout) :: this + type(ESMF_Grid), intent(inout) :: grid + integer, allocatable, intent(inout) :: local_start(:) + integer, allocatable, intent(inout) :: global_start(:) + integer, allocatable, intent(inout) :: global_count(:) + integer, optional, intent(out) :: rc + + integer :: status + integer :: global_dim(3),i1,j1,in,jn,tile + character(len=*), parameter :: Iam = MOD_NAME // 'generate_file_bounds' + + call MAPL_GridGet(grid,globalCellCountPerDim=global_dim,rc=status) + _VERIFY(status) + call MAPL_GridGetInterior(grid,i1,in,j1,jn) + tile=j1/global_dim(1) + allocate(local_start,source=[i1,j1-tile*global_dim(1),tile+1]) + allocate(global_start,source=[1,1,1]) + allocate(global_count,source=[global_dim(1),global_dim(1),6]) + + _RETURN(_SUCCESS) + + end subroutine generate_file_bounds + + function generate_file_reference2D(this,fpointer) result(ref) + use pFIO + type(ArrayReference) :: ref + class(CubedSphereGridFactory), intent(inout) :: this + real, pointer, intent(in) :: fpointer(:,:) + ref = ArrayReference(fpointer) + end function generate_file_reference2D + + function generate_file_reference3D(this,fpointer) result(ref) + use pFIO + use, intrinsic :: ISO_C_BINDING + type(ArrayReference) :: ref + class(CubedSphereGridFactory), intent(inout) :: this + real, pointer, intent(in) :: fpointer(:,:,:) + type(c_ptr) :: cptr + real, pointer :: ptr_ref(:,:,:,:,:) + cptr = c_loc(fpointer) + call C_F_pointer(cptr,ptr_ref,[size(fpointer,1),size(fpointer,2),1,size(fpointer,3),1]) + ref = ArrayReference(ptr_ref) + end function generate_file_reference3D end module MAPL_CubedSphereGridFactoryMod diff --git a/MAPL_Base/MAPL_ExtDataGridCompMod.F90 b/MAPL_Base/MAPL_ExtDataGridCompMod.F90 index a9e2e2b2f375..9380445d56cc 100644 --- a/MAPL_Base/MAPL_ExtDataGridCompMod.F90 +++ b/MAPL_Base/MAPL_ExtDataGridCompMod.F90 @@ -2127,7 +2127,7 @@ subroutine GetLevs(item, time, allowExtrap, rc) var=>metadata%get_variable(trim(item%var)) _ASSERT(associated(var),"Variable not found in file") end if - + levName = metadata%get_level_name(rc=status) _VERIFY(status) if (trim(levName) /='') then diff --git a/MAPL_Base/MAPL_LatLonGridFactory.F90 b/MAPL_Base/MAPL_LatLonGridFactory.F90 index a4c65000220c..b7677b99c2fc 100644 --- a/MAPL_Base/MAPL_LatLonGridFactory.F90 +++ b/MAPL_Base/MAPL_LatLonGridFactory.F90 @@ -96,6 +96,9 @@ module MAPL_LatLonGridFactoryMod procedure :: append_variable_metadata procedure :: check_decomposition procedure :: generate_newnxy + procedure :: generate_file_bounds + procedure :: generate_file_reference2D + procedure :: generate_file_reference3D end type LatLonGridFactory character(len=*), parameter :: MOD_NAME = 'MAPL_LatLonGridFactory::' @@ -1670,4 +1673,45 @@ subroutine append_variable_metadata(this,var) type(Variable), intent(inout) :: var end subroutine append_variable_metadata + subroutine generate_file_bounds(this,grid,local_start,global_start,global_count,rc) + use MAPL_BaseMod + class(LatLonGridFactory), intent(inout) :: this + type(ESMF_Grid), intent(inout) :: grid + integer, allocatable, intent(inout) :: local_start(:) + integer, allocatable, intent(inout) :: global_start(:) + integer, allocatable, intent(inout) :: global_count(:) + integer, optional, intent(out) :: rc + + integer :: status + integer :: global_dim(3), i1,j1,in,jn + character(len=*), parameter :: Iam = MOD_NAME // 'generate_file_bounds' + + call MAPL_GridGet(grid,globalCellCountPerDim=global_dim,rc=status) + _VERIFY(status) + call MAPL_GridGetInterior(grid,i1,in,j1,jn) + allocate(local_start,source=[i1,j1]) + allocate(global_start,source=[1,1]) + allocate(global_count,source=[global_dim(1),global_dim(2)]) + + _RETURN(_SUCCESS) + + end subroutine generate_file_bounds + + function generate_file_reference2D(this,fpointer) result(ref) + use pFIO + type(ArrayReference) :: ref + class(LatLonGridFactory), intent(inout) :: this + real, pointer, intent(in) :: fpointer(:,:) + ref = ArrayReference(fpointer) + end function generate_file_reference2D + + function generate_file_reference3D(this,fpointer) result(ref) + use pFIO + type(ArrayReference) :: ref + class(LatLonGridFactory), intent(inout) :: this + real, pointer, intent(in) :: fpointer(:,:,:) + ref = ArrayReference(fpointer) + end function generate_file_reference3D + + end module MAPL_LatLonGridFactoryMod diff --git a/MAPL_Base/MAPL_TripolarGridFactory.F90 b/MAPL_Base/MAPL_TripolarGridFactory.F90 index 3ca7286ad858..085afd116c6f 100644 --- a/MAPL_Base/MAPL_TripolarGridFactory.F90 +++ b/MAPL_Base/MAPL_TripolarGridFactory.F90 @@ -74,6 +74,9 @@ module MAPL_TripolarGridFactoryMod procedure :: append_metadata procedure :: get_grid_vars procedure :: append_variable_metadata + procedure :: generate_file_bounds + procedure :: generate_file_reference2D + procedure :: generate_file_reference3D end type TripolarGridFactory character(len=*), parameter :: MOD_NAME = 'MAPL_TripolarGridFactory::' @@ -877,5 +880,33 @@ subroutine append_variable_metadata(this,var) type(Variable), intent(inout) :: var end subroutine append_variable_metadata + subroutine generate_file_bounds(this,grid,local_start,global_start,global_count,rc) + use MAPL_BaseMod + class(TripolarGridFactory), intent(inout) :: this + type(ESMF_Grid), intent(inout) :: grid + integer, allocatable, intent(inout) :: local_start(:) + integer, allocatable, intent(inout) :: global_start(:) + integer, allocatable, intent(inout) :: global_count(:) + integer, optional, intent(out) :: rc + + integer :: status + + end subroutine generate_file_bounds + + function generate_file_reference2D(this,fpointer) result(ref) + use pFIO + type(ArrayReference) :: ref + class(TripolarGridFactory), intent(inout) :: this + real, pointer, intent(in) :: fpointer(:,:) + ref = ArrayReference(fpointer) + end function generate_file_reference2D + + function generate_file_reference3D(this,fpointer) result(ref) + use pFIO + type(ArrayReference) :: ref + class(TripolarGridFactory), intent(inout) :: this + real, pointer, intent(in) :: fpointer(:,:,:) + ref = ArrayReference(fpointer) + end function generate_file_reference3D end module MAPL_TripolarGridFactoryMod diff --git a/MAPL_Base/MAPL_newCFIO.F90 b/MAPL_Base/MAPL_newCFIO.F90 index 64bde6918def..14436a85712c 100644 --- a/MAPL_Base/MAPL_newCFIO.F90 +++ b/MAPL_Base/MAPL_newCFIO.F90 @@ -654,87 +654,54 @@ subroutine stageData(this, field, fileName, tIndex, oClients, rc) integer :: status integer :: fieldRank character(len=ESMF_MAXSTR) :: fieldName - logical :: isCubed real, pointer :: ptr3d(:,:,:) => null() real, pointer :: ptr2d(:,:) => null() type(ArrayReference) :: ref - integer :: i1,in,j1,jn,tile,lm - integer :: global_dim(3) - type(c_ptr) :: cptr - real, pointer :: ptr_ref_3d(:,:,:,:,:) + integer :: lm logical :: hasDE + integer, allocatable :: localStart(:),globalStart(:),globalCount(:) + integer, allocatable :: gridLocalStart(:),gridGlobalStart(:),gridGlobalCount(:) + class (AbstractGridFactory), pointer :: factory - call MAPL_GridGet(this%output_grid,globalCellCountPerDim=global_dim,rc=status) + factory => get_factory(this%output_grid,rc=status) _VERIFY(status) hasDE = MAPL_GridHasDE(this%output_grid,rc=status) _VERIFY(status) - isCubed=.false. - if (global_dim(1)*6 == global_dim(2)) isCubed=.true. lm = this%vdata%lm - call MAPL_Grid_interior(this%output_grid,i1,in,j1,jn) call ESMF_FieldGet(field,rank=fieldRank,name=fieldName,rc=status) _VERIFY(status) - if (isCubed) then - tile = j1/global_dim(1) - if (fieldRank==2) then - if (hasDE) then - call ESMF_FieldGet(field,farrayPtr=ptr2d,rc=status) - _VERIFY(status) - if (this%nbits < 24) then - call pFIO_DownBit(ptr2d,ptr2d,this%nbits,undef=MAPL_undef,rc=status) - _VERIFY(status) - end if - end if - ref = ArrayReference(ptr2d) - call oClients%collective_stage_data(this%write_collection_id,trim(filename),trim(fieldName), & - ref,start=[i1,j1-tile*global_dim(1),tile+1,1], & - global_start=[1,1,1,tindex], global_count=[global_dim(1),global_dim(1),6,1]) - else if (fieldRank==3) then - if (hasDE) then - call ESMF_FieldGet(field,farrayPtr=ptr3d,rc=status) + call factory%generate_file_bounds(this%output_grid,gridLocalStart,gridGlobalStart,gridGlobalCount,rc=status) + _VERIFY(status) + if (fieldRank==2) then + if (hasDE) then + call ESMF_FieldGet(Field,farrayPtr=ptr2d,rc=status) + _VERIFY(status) + if (this%nbits < 24) then + call pFIO_DownBit(ptr2d,ptr2d,this%nbits,undef=MAPL_undef,rc=status) _VERIFY(status) - if (this%nbits < 24) then - call pFIO_DownBit(ptr3d,ptr3d,this%nbits,undef=MAPL_undef,rc=status) - _VERIFY(status) - end if end if - cptr = c_loc(ptr3d) - call C_F_pointer(cptr,ptr_ref_3d,[size(ptr3d,1),size(ptr3d,2),1,size(ptr3d,3),1]) - ref = ArrayReference(ptr_ref_3d) - call oClients%collective_stage_data(this%write_collection_id,trim(filename),trim(fieldName), & - ref,start=[i1,j1-tile*global_dim(1),tile+1,1,1], & - global_start=[1,1,1,1,tindex], global_count=[global_dim(1),global_dim(1),6,lm,1]) end if - else - if (fieldRank==2) then - if (hasDE) then - call ESMF_FieldGet(Field,farrayPtr=ptr2d,rc=status) - _VERIFY(status) - if (this%nbits < 24) then - call pFIO_DownBit(ptr2d,ptr2d,this%nbits,undef=MAPL_undef,rc=status) - _VERIFY(status) - end if - end if - ref = ArrayReference(Ptr2D) - call oClients%collective_stage_data(this%write_collection_id,trim(filename),trim(fieldName), & - ref,start=[i1,j1,1], & - global_start=[1,1,tindex], global_count=[global_dim(1),global_dim(2),1]) - else if (fieldRank==3) then - if (HasDE) then - call ESMF_FieldGet(field,farrayPtr=ptr3d,rc=status) + ref = factory%generate_file_reference2D(Ptr2D) + allocate(localStart,source=[gridLocalStart,1]) + allocate(globalStart,source=[gridGlobalStart,tindex]) + allocate(globalCount,source=[gridGlobalCount,1]) + else if (fieldRank==3) then + if (HasDE) then + call ESMF_FieldGet(field,farrayPtr=ptr3d,rc=status) + _VERIFY(status) + if (this%nbits < 24) then + call pFIO_DownBit(ptr3d,ptr3d,this%nbits,undef=MAPL_undef,rc=status) _VERIFY(status) - if (this%nbits < 24) then - call pFIO_DownBit(ptr3d,ptr3d,this%nbits,undef=MAPL_undef,rc=status) - _VERIFY(status) - end if end if - ref = ArrayReference(Ptr3D) - call oClients%collective_stage_data(this%write_collection_id,trim(filename),trim(fieldName), & - ref,start=[i1,j1,1,1], & - global_start=[1,1,1,tindex], global_count=[global_dim(1),global_dim(2),lm,1]) end if - end if + ref = factory%generate_file_reference3D(Ptr3D) + allocate(localStart,source=[gridLocalStart,1,1]) + allocate(globalStart,source=[gridGlobalStart,1,tindex]) + allocate(globalCount,source=[gridGlobalCount,lm,1]) + end if + call oClients%collective_stage_data(this%write_collection_id,trim(filename),trim(fieldName), & + ref,start=localStart, global_start=GlobalStart, global_count=GlobalCount) end subroutine stageData @@ -807,14 +774,15 @@ subroutine request_data_from_file(this,filename,timeindex,rc) type(ArrayReference) :: ref real, pointer :: ptr2d(:,:) => null() real, pointer :: ptr3d(:,:,:) => null() - integer, allocatable :: start(:) - integer, allocatable :: global_start(:) - integer, allocatable :: global_count(:) + integer, allocatable :: localStart(:), globalStart(:), globalCount(:) + integer, allocatable :: gridLocalStart(:), gridGlobalStart(:), gridGlobalCount(:) type(ESMF_Grid) :: output_grid logical :: hasDE + class(AbstractGridFactory), pointer :: factory collection => extdatacollections%at(this%metadata_collection_id) filegrid = collection%src_grid + factory => get_factory(filegrid) hasDE=MAPL_GridHasDE(filegrid,rc=status) _VERIFY(status) call ESMF_FieldBundleGet(this%output_bundle,grid=output_grid,rc=status) @@ -823,12 +791,11 @@ subroutine request_data_from_file(this,filename,timeindex,rc) this%regrid_handle => new_regridder_manager%make_regridder(filegrid,output_grid,this%regrid_method,rc=status) _VERIFY(status) end if - call MAPL_Grid_Interior(filegrid,i1,in,j1,jn) call MAPL_GridGet(filegrid,globalCellCountPerdim=dims,rc=status) _VERIFY(status) - img=dims(1) - jmg=dims(2) lm=dims(3) + call factory%generate_file_bounds(fileGrid,gridLocalStart,gridGlobalStart,gridGlobalCount,rc=status) + _VERIFY(status) ! create input bundle call ESMF_FieldBundleGet(this%output_bundle,fieldCount=numVars,rc=status) _VERIFY(status) @@ -850,10 +817,10 @@ subroutine request_data_from_file(this,filename,timeindex,rc) call ESMF_FieldGet(input_fields(I),0,farrayPtr=ptr2d,rc=status) _VERIFY(status) end if - ref=ArrayReference(ptr2d) - start = [i1, j1, timeIndex] ! (i,j,t) - global_start = [1, 1, timeIndex] ! (i,j,t) - global_count = [img, jmg, 1] + ref=factory%generate_file_reference2D(ptr2d) + allocate(localStart,source=[gridLocalStart,timeIndex]) + allocate(globalStart,source=[gridGlobalStart,timeIndex]) + allocate(globalCount,source=[gridGlobalCount,1]) else if (rank==3) then call ESMF_FieldGet(output_field,ungriddedLBound=lb,ungriddedUBound=ub,rc=status) _VERIFY(status) @@ -864,15 +831,16 @@ subroutine request_data_from_file(this,filename,timeindex,rc) call ESMF_FieldGet(input_fields(I),0,farrayPtr=ptr3d,rc=status) _VERIFY(status) end if - ref=ArrayReference(ptr3d) - start = [i1, j1, 1, timeIndex] ! (i,j,t) - global_start = [1, 1, 1, timeIndex] ! (i,j,t) - global_count = [img, jmg, lm, 1] + ref=factory%generate_file_reference3D(ptr3d) + allocate(localStart,source=[gridLocalStart,1,timeIndex]) + allocate(globalStart,source=[gridGlobalStart,1,timeIndex]) + allocate(globalCount,source=[gridGlobalCount,lm,1]) end if call i_Clients%collective_prefetch_data( & this%read_collection_id, fileName, trim(names(i)), & - & ref, start=start, global_start=global_start, global_count=global_count) - deallocate(start,global_start,global_count) + & ref, start=localStart, global_start=globalStart, global_count=globalCount) + deallocate(localStart,globalStart,globalCount) + deallocate(gridLocalStart,gridGlobalStart,gridGlobalCount) enddo this%input_bundle = ESMF_FieldBundleCreate(fieldList=input_fields,rc=status) _VERIFY(status) From 9fb2e47008f24cc73d783b51e881a8d64153c339 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 24 Dec 2019 11:06:39 -0500 Subject: [PATCH 008/109] A round of cleaning up unused variables --- MAPL_Base/FileMetadataUtilities.F90 | 1 - MAPL_Base/GetFieldArray.H | 1 - MAPL_Base/GetPointer.H | 1 - MAPL_Base/MAPL_Base.F90 | 6 -- MAPL_Base/MAPL_CFIO.F90 | 2 +- MAPL_Base/MAPL_Comms.F90 | 22 ++--- MAPL_Base/MAPL_ExtDataGridCompMod.F90 | 112 ++++++++++--------------- MAPL_Base/MAPL_ExtData_IOBundleMod.F90 | 9 +- MAPL_Base/MAPL_Generic.F90 | 29 +------ MAPL_Base/MAPL_GetLatLonCoord.F90 | 2 - MAPL_Base/MAPL_HistoryGridComp.F90 | 23 +---- MAPL_Base/MAPL_LocStreamMod.F90 | 42 +++++----- MAPL_Base/MAPL_RegridderManager.F90 | 2 - MAPL_Base/MAPL_ShmemMod.F90 | 1 - MAPL_Base/MAPL_VarSpecMod.F90 | 62 +++++++------- MAPL_Base/MAPL_VerticalInterpMod.F90 | 1 - MAPL_Base/arraygather.H | 1 - MAPL_Base/arraygatherRcvCnt.H | 1 - MAPL_Base/arrayscatter.H | 1 - MAPL_Base/arrayscatterRcvCnt.H | 1 - 20 files changed, 117 insertions(+), 203 deletions(-) diff --git a/MAPL_Base/FileMetadataUtilities.F90 b/MAPL_Base/FileMetadataUtilities.F90 index 3201861e4345..f34111c3d9ad 100644 --- a/MAPL_Base/FileMetadataUtilities.F90 +++ b/MAPL_Base/FileMetadataUtilities.F90 @@ -232,7 +232,6 @@ function is_var_present(this,var_name,rc) result(isPresent) integer, optional, intent(out) :: rc logical :: isPresent - integer :: status class(Variable), pointer :: var var => this%get_variable(var_name) diff --git a/MAPL_Base/GetFieldArray.H b/MAPL_Base/GetFieldArray.H index 1009e9d2f4dc..c4b91bf0850b 100644 --- a/MAPL_Base/GetFieldArray.H +++ b/MAPL_Base/GetFieldArray.H @@ -16,7 +16,6 @@ real(KIND=EKIND_), pointer :: PTR DIMENSIONS_ integer, optional, intent( OUT) :: RC - character(len=ESMF_MAXSTR) :: IAm=SUBSTR_ integer :: STATUS logical :: hasDE diff --git a/MAPL_Base/GetPointer.H b/MAPL_Base/GetPointer.H index 7a6cb5cf5020..b660375ddcea 100644 --- a/MAPL_Base/GetPointer.H +++ b/MAPL_Base/GetPointer.H @@ -19,7 +19,6 @@ logical, optional, intent(IN ) :: notFoundOK integer, optional, intent( OUT) :: RC - character(len=ESMF_MAXSTR) :: IAm=SUBSTR_ integer :: STATUS type (ESMF_FieldBundle) :: bundle diff --git a/MAPL_Base/MAPL_Base.F90 b/MAPL_Base/MAPL_Base.F90 index b73cec33389e..aabd344d7f12 100644 --- a/MAPL_Base/MAPL_Base.F90 +++ b/MAPL_Base/MAPL_Base.F90 @@ -2302,7 +2302,6 @@ function MAPL_LatLonGridCreate (Name, vm, & real :: LastOut(2) integer :: STATUS - character(len=ESMF_MAXSTR) :: IAm='MAPL_LatLonGridCreate' ! ------ @@ -2584,7 +2583,6 @@ subroutine MAPL_GRID_INTERIOR(GRID,I1,IN,J1,JN) type (ESMF_DistGrid) :: distGrid type(ESMF_DELayout) :: LAYOUT - type (ESMF_VM) :: vm integer, allocatable :: AL(:,:) integer, allocatable :: AU(:,:) integer :: nDEs,localDECount @@ -2626,7 +2624,6 @@ subroutine MAPL_GridGetCorners(grid,gridCornerLons, gridCornerLats, RC) real(ESMF_KIND_R8), intent(INOUT) :: gridCornerLats(:,:) integer, optional, intent( OUT) :: RC integer :: status - character(len=ESMF_MAXSTR) :: Iam="MAPL_GridGetCorners" type(ESMF_RouteHandle) :: rh type(ESMF_Field) :: field @@ -2685,7 +2682,6 @@ subroutine MAPL_GridGet(GRID, globalCellCountPerDim, localCellCountPerDim, RC) ! local vars integer :: status - character(len=ESMF_MAXSTR) :: Iam="MAPL_GridGet" integer :: mincounts(ESMF_MAXDIM) integer :: maxcounts(ESMF_MAXDIM) @@ -2920,7 +2916,6 @@ subroutine MAPL_GetImsJms(Imins,Imaxs,Jmins,Jmaxs,Ims,Jms,rc) integer, allocatable :: Im0(:), Jm0(:) integer :: minI,minJ ! in case the starting index is zero integer :: status - character*(14) :: Iam="MAPL_GetImsJms" _ASSERT(.not.associated(Ims), 'Ims is associated and should not be.') _ASSERT(.not.associated(Jms), 'Jms is associated and should not be.') @@ -3451,7 +3446,6 @@ subroutine MAPL_GetHorzIJIndex(npts,II,JJ,lon,lat,lonR8,latR8,Grid,IMGlob,JMGlob ! Currently the lat/lon grid is asumed to go from -180 to 180 !EOPI - character(len=ESMF_MAXSTR) :: Iam integer :: status integer :: IM_World, JM_World, dims(3) diff --git a/MAPL_Base/MAPL_CFIO.F90 b/MAPL_Base/MAPL_CFIO.F90 index 87925452f8d2..d1246be5f794 100644 --- a/MAPL_Base/MAPL_CFIO.F90 +++ b/MAPL_Base/MAPL_CFIO.F90 @@ -399,7 +399,7 @@ subroutine MAPL_CFIOCreateFromBundle ( MCFIO, NAME, CLOCK, BUNDLE, OFFSET, integer :: Comm, nPEs integer :: hours, mins, secs, timeInc integer :: I, J, LT, K, IMO, JMO, LMG, IML, JML - integer :: IMSUB, JMSUB, IMBEG, IMEND, JMBEG, JMEND + integer :: IMBEG, IMEND, JMBEG, JMEND integer :: Field_Type integer :: Df integer :: Num2DVars, Num3dVars diff --git a/MAPL_Base/MAPL_Comms.F90 b/MAPL_Base/MAPL_Comms.F90 index b057a21b1c5c..436a6084cfd4 100644 --- a/MAPL_Base/MAPL_Comms.F90 +++ b/MAPL_Base/MAPL_Comms.F90 @@ -291,7 +291,7 @@ subroutine MAPL_CreateRequest(grid, Root, request, tag, RequestType, & ! Local variables integer :: status - character(len=ESMF_MAXSTR) :: IAm='MAPL_CreateRequest' + type (ESMF_VM) :: VM type (ESMF_DistGrid) :: distGrid @@ -479,7 +479,7 @@ subroutine MAPL_ArrayIGather_R4_2(local_array, request, rc) ! Local variables integer :: status - character(len=ESMF_MAXSTR) :: IAm='MAPL_ArrayIGather2d' + integer :: i1, in, j1, jn @@ -517,7 +517,7 @@ subroutine MAPL_ArrayIScatter_R4_2(global_array, request, hw, rc) ! Local variables integer :: status - character(len=ESMF_MAXSTR) :: IAm='MAPL_ArrayIScatter2d' + integer :: i1,in,j1,jn @@ -586,7 +586,7 @@ subroutine MAPL_CollectiveWait(request, DstArray, rc) integer, optional, intent( OUT) :: rc integer :: status - character(len=ESMF_MAXSTR) :: IAm='MAPL_CollectiveWait' + integer :: i,j,k,n integer :: count @@ -699,7 +699,7 @@ subroutine MAPL_CollectiveGather3D(Grid, LocArray, GlobArray, & !------- integer :: status - character(len=ESMF_MAXSTR) :: IAm='MAPL_CollectiveGather3D' + type (MAPL_CommRequest) :: reqs(size(LocArray,3)) integer :: root(size(LocArray,3)) @@ -788,7 +788,7 @@ subroutine MAPL_CollectiveScatter3D(Grid, GlobArray, LocArray, hw, rc) !------- integer :: status - character(len=ESMF_MAXSTR) :: IAm='MAPL_CollectiveScatter3D' + type (MAPL_CommRequest) :: reqs(size(LocArray,3)) integer :: root(size(LocArray,3)) @@ -863,7 +863,7 @@ subroutine MAPL_RoundRobinPEList(List,nNodes,Root,UseFirstRank,FirstRank,RC) integer, optional, intent( OUT) :: RC integer :: status - character(len=ESMF_MAXSTR) :: IAm='MAPL_RoundRobinPEList' + integer, allocatable :: filled(:),nPerNode(:) integer :: i,n,nlist,locRoot logical :: gotFirstRank,lUseFirstRank @@ -963,7 +963,7 @@ subroutine MAPL_CommsBcast_STRING_0( layout, data, N, ROOT, RC) integer, intent(in ) :: ROOT integer , intent( out), optional :: RC - character(len=ESMF_MAXSTR), parameter :: IAM='MAPL_Bcast' + integer :: status type(ESMF_VM) :: vm @@ -986,7 +986,7 @@ subroutine MAPL_CommsBcastVM_STRING_0( vm, data, N, ROOT,RC) integer, intent(in ) :: ROOT integer , intent( out), optional :: RC - character(len=ESMF_MAXSTR), parameter :: IAM='MAPL_BcastVM' + character(len=N) :: tmpString integer :: slen integer :: status @@ -1026,7 +1026,7 @@ subroutine MAPL_BcastShared_1DR4(VM, Data, N, Root, RootOnly, rc) integer :: status - character(len=ESMF_MAXSTR), parameter :: IAM='MAPL_BcastShared' + if(.not.MAPL_ShmInitialized) then @@ -1058,7 +1058,7 @@ subroutine MAPL_BcastShared_2DR4(VM, Data, N, Root, RootOnly, rc) integer :: status - character(len=ESMF_MAXSTR), parameter :: IAM='MAPL_BcastShared' + if(.not.MAPL_ShmInitialized) then diff --git a/MAPL_Base/MAPL_ExtDataGridCompMod.F90 b/MAPL_Base/MAPL_ExtDataGridCompMod.F90 index d0d503ee1815..f22d05da87f6 100644 --- a/MAPL_Base/MAPL_ExtDataGridCompMod.F90 +++ b/MAPL_Base/MAPL_ExtDataGridCompMod.F90 @@ -414,7 +414,6 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) logical, allocatable :: DerivedVarNeeded(:) logical, allocatable :: LocalVarNeeded(:) - type(ESMF_CFIO), pointer :: cfio type(FileMetadataUtils), pointer :: metadata integer :: counter real, pointer :: ptr2d(:,:) => null() @@ -1284,12 +1283,9 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) type(ESMF_Time) :: time, time0 type(MAPL_MetaComp), pointer :: MAPLSTATE - real, pointer, dimension(:,:) :: var2d_prev, var2d_next - real, pointer, dimension(:,:,:) :: var3d_prev, var3d_next logical :: doUpdate_ - integer :: fieldCount, fieldRank + integer :: fieldCount character(len=ESMF_MAXSTR), ALLOCATABLE :: NAMES (:) - type(ESMF_Field) :: field1, field2 character(len=ESMF_MAXPATHLEN) :: file_processed, file_processed1, file_processed2 logical :: NotSingle logical :: updateL, updateR, swap @@ -1549,7 +1545,7 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) io_bundle%pbundle = ESMF_FieldBundleCreate(rc=status) _VERIFY(STATUS) - call MAPL_ExtDataPopulateBundle(self,item,bracket_side,io_bundle%pbundle,rc=status) + call MAPL_ExtDataPopulateBundle(item,bracket_side,io_bundle%pbundle,rc=status) _VERIFY(status) call bundle_iter%next() enddo @@ -1662,7 +1658,7 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) if (doUpdate_) then - call CalcDerivedField(self%ExtDataState,self%primary,derivedItem%name,derivedItem%expression, & + call CalcDerivedField(self%ExtDataState,derivedItem%name,derivedItem%expression, & derivedItem%masking,__RC__) end if @@ -1975,7 +1971,7 @@ subroutine CreateTimeInterval(item,clock,rc) integer :: cindex,pindex character(len=ESMF_MAXSTR) :: creffTime, ctInt - __Iam__('CreateTimeInterval') + integer :: status creffTime = '' ctInt = '' @@ -2132,7 +2128,7 @@ subroutine GetLevs(item, time, allowExtrap, rc) logical , intent(in ) :: allowExtrap integer, optional , intent(out ) :: rc - __Iam__('GetLevs') + integer :: status integer(ESMF_KIND_I4) :: iyr,imm,idd,ihr,imn,iss,i,n,refYear character(len=ESMF_MAXPATHLEN) :: file @@ -2227,7 +2223,7 @@ subroutine GetLevs(item, time, allowExtrap, rc) var=>metadata%get_variable(trim(item%var)) _ASSERT(associated(var),"Variable not found in file") end if - + levName = metadata%get_level_name(rc=status) _VERIFY(status) if (trim(levName) /='') then @@ -2281,7 +2277,7 @@ subroutine UpdateBracketTime(item,cTime,bSide,interpTime,fileTime,file_processed logical, intent(in ) :: allowExtrap integer, optional, intent(out ) :: rc - __Iam__('UpdateBracketTime') + integer :: status type(ESMF_Time) :: newTime integer :: curDate,curTime,n,tindex @@ -2301,7 +2297,6 @@ subroutine UpdateBracketTime(item,cTime,bSide,interpTime,fileTime,file_processed logical :: LExtrap, RExtrap, LExact, RExact logical :: LSide, RSide, intOK, bracketScan - type (ESMF_CFIO), pointer :: xCFIO type(ESMF_Time), allocatable :: xTSeries(:) type(FileMetaDataUtils), pointer :: fdata @@ -2819,7 +2814,6 @@ subroutine makeMetadata(file,collection_id,metadata,rc) type(FileMetadataUtils), pointer, intent(inout) :: metadata integer, optional, intent(out ) :: rc type(MAPLExtDataCollection), pointer :: collection => null() - integer :: status Collection => ExtDataCollections%at(collection_id) metadata => collection%find(file) @@ -2835,7 +2829,7 @@ subroutine GetTimesOnFile(cfio,tSeries,rc) type(ESMF_Time) :: tSeries(:) integer, optional, intent(out ) :: rc - __Iam__('GetTimesOnFile') + integer :: status integer(ESMF_KIND_I4) :: iyr,imm,idd,ihr,imn,isc integer :: i @@ -3307,15 +3301,14 @@ subroutine GetBracketTimeOnFile(fdata,tSeries,cTime,bSide,UniFileClim,interpTime end subroutine GetBracketTimeOnFile - subroutine CalcDerivedField(state,primaries,exportName,exportExpr,masking,rc) + subroutine CalcDerivedField(state,exportName,exportExpr,masking,rc) type(ESMF_State), intent(inout) :: state - type(PrimaryExports), intent(inout) :: primaries character(len=*), intent(in ) :: exportName character(len=*), intent(in ) :: exportExpr logical, intent(in ) :: masking integer, optional, intent(out ) :: rc - __Iam__('CalcDerivedField') + integer :: status type(ESMF_Field) :: field @@ -3502,22 +3495,21 @@ subroutine MAPL_ExtDataVerticalInterpolate(ExtState,item,filec,rc) integer, optional, intent(out ) :: rc integer :: status - character(len=ESMF_MAXSTR) :: Iam="MAPL_ExtDataVerticalInterpolate" integer :: id_ps type(ESMF_Field) :: field, newfield,psF if (item%do_VertInterp) then if (trim(item%importVDir)/=trim(item%fileVDir)) then - call MAPL_ExtDataFlipVertical(ExtState,item,filec,rc=status) + call MAPL_ExtDataFlipVertical(item,filec,rc=status) _VERIFY(status) end if if (item%vartype == MAPL_fieldItem) then - call MAPL_ExtDataGetBracket(ExtState,item,filec,newField,getRL=.true.,rc=status) + call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,rc=status) _VERIFY(STATUS) - call MAPL_ExtDataGetBracket(ExtState,item,filec,Field,rc=status) + call MAPL_ExtDataGetBracket(item,filec,Field,rc=status) _VERIFY(STATUS) id_ps = ExtState%primaryOrder(1) - call MAPL_ExtDataGetBracket(ExtState,ExtState%primary%item(id_ps),filec,field=psF,rc=status) + call MAPL_ExtDataGetBracket(ExtState%primary%item(id_ps),filec,field=psF,rc=status) _VERIFY(STATUS) call vertInterpolation_pressKappa(field,newfield,psF,item%levs,MAPL_UNDEF,rc=status) _VERIFY(STATUS) @@ -3525,17 +3517,17 @@ subroutine MAPL_ExtDataVerticalInterpolate(ExtState,item,filec,rc) else if (item%vartype == MAPL_ExtDataVectorItem) then id_ps = ExtState%primaryOrder(1) - call MAPL_ExtDataGetBracket(ExtState,ExtState%primary%item(id_ps),filec,field=psF,rc=status) + call MAPL_ExtDataGetBracket(ExtState%primary%item(id_ps),filec,field=psF,rc=status) _VERIFY(STATUS) - call MAPL_ExtDataGetBracket(ExtState,item,filec,newField,getRL=.true.,vcomp=1,rc=status) + call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,vcomp=1,rc=status) _VERIFY(STATUS) - call MAPL_ExtDataGetBracket(ExtState,item,filec,Field,vcomp=1,rc=status) + call MAPL_ExtDataGetBracket(item,filec,Field,vcomp=1,rc=status) _VERIFY(STATUS) call vertInterpolation_pressKappa(field,newfield,psF,item%levs,MAPL_UNDEF,rc=status) _VERIFY(STATUS) - call MAPL_ExtDataGetBracket(ExtState,item,filec,newField,getRL=.true.,vcomp=2,rc=status) + call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,vcomp=2,rc=status) _VERIFY(STATUS) - call MAPL_ExtDataGetBracket(ExtState,item,filec,Field,vcomp=2,rc=status) + call MAPL_ExtDataGetBracket(item,filec,Field,vcomp=2,rc=status) _VERIFY(STATUS) call vertInterpolation_pressKappa(field,newfield,psF,item%levs,MAPL_UNDEF,rc=status) _VERIFY(STATUS) @@ -3544,29 +3536,29 @@ subroutine MAPL_ExtDataVerticalInterpolate(ExtState,item,filec,rc) else if (item%do_Fill) then if (item%vartype == MAPL_fieldItem) then - call MAPL_ExtDataGetBracket(ExtState,item,filec,newField,getRL=.true.,rc=status) + call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,rc=status) _VERIFY(STATUS) - call MAPL_ExtDataGetBracket(ExtState,item,filec,Field,rc=status) + call MAPL_ExtDataGetBracket(item,filec,Field,rc=status) _VERIFY(STATUS) call MAPL_ExtDataFillField(item,field,newfield,rc=status) _VERIFY(STATUS) else if (item%vartype == MAPL_ExtDataVectorItem) then - call MAPL_ExtDataGetBracket(ExtState,item,filec,newField,getRL=.true.,vcomp=1,rc=status) + call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,vcomp=1,rc=status) _VERIFY(STATUS) - call MAPL_ExtDataGetBracket(ExtState,item,filec,Field,vcomp=1,rc=status) + call MAPL_ExtDataGetBracket(item,filec,Field,vcomp=1,rc=status) _VERIFY(STATUS) call MAPL_ExtDataFillField(item,field,newfield,rc=status) _VERIFY(STATUS) - call MAPL_ExtDataGetBracket(ExtState,item,filec,newField,getRL=.true.,vcomp=2,rc=status) + call MAPL_ExtDataGetBracket(item,filec,newField,getRL=.true.,vcomp=2,rc=status) _VERIFY(STATUS) - call MAPL_ExtDataGetBracket(ExtState,item,filec,Field,vcomp=2,rc=status) + call MAPL_ExtDataGetBracket(item,filec,Field,vcomp=2,rc=status) _VERIFY(STATUS) call MAPL_ExtDataFillField(item,field,newfield,rc=status) _VERIFY(STATUS) end if else if (trim(item%importVDir)/=trim(item%fileVDir)) then - call MAPL_ExtDataFlipVertical(ExtState,item,filec,rc=status) + call MAPL_ExtDataFlipVertical(item,filec,rc=status) _VERIFY(status) end if end if @@ -3580,7 +3572,6 @@ subroutine GetMaskName(FuncStr,Var,Needed,rc) logical, intent(inout) :: needed(:) integer, optional, intent(out) :: rc - character(len=ESMF_MAXSTR) :: Iam = "GetMaskName" integer :: status integer :: i1,i2,i,ivar logical :: found,twovar @@ -3637,7 +3628,6 @@ subroutine MAPL_ExtDataEvaluateMask(state,exportName,exportExpr,rc) character(len=*), intent(in) :: exportExpr integer, optional, intent(out) :: rc - character(len=ESMF_MAXSTR) :: Iam = "EvaluateMask" integer :: status integer :: k,i @@ -4102,7 +4092,7 @@ function MAPL_ExtDataGetFStartTime(item,fname, rc) result(stime) integer :: status - integer :: iyr,imm,idd,ihr,imn,isc,begDate,begTime + integer :: iyr,imm,idd,ihr,imn,isc type(FileMetadataUtils), pointer :: metadata => null() call MakeMetadata(fname,item%pfiocollection_id,metadata,__RC__) @@ -4322,9 +4312,8 @@ function MAPL_ExtDataGridChangeLev(Grid,CF,lm,rc) result(NewGrid) end function MAPL_ExtDataGridChangeLev - subroutine MAPL_ExtDataGetBracket(ExtState,item,Bside,field,bundle,getRL,vcomp,rc) + subroutine MAPL_ExtDataGetBracket(item,Bside,field,bundle,getRL,vcomp,rc) - type(MAPL_ExtData_State), intent(inout) :: ExtState type(PrimaryExport), intent(inout) :: item integer, intent(in ) :: bside type(ESMF_Field), optional, intent(inout) :: field @@ -4334,10 +4323,8 @@ subroutine MAPL_ExtDataGetBracket(ExtState,item,Bside,field,bundle,getRL,vcomp,r integer, optional, intent(out ) :: rc character(len=ESMF_MAXSTR) :: Iam - integer :: status logical :: getRL_ - type(ESMF_Grid) :: grid,newGrid Iam = "MAPL_ExtDataGetBracket" @@ -4475,14 +4462,12 @@ subroutine MAPL_ExtDataFillField(item,FieldF,FieldR,rc) end subroutine MAPL_ExtDataFillField - subroutine MAPL_ExtDataFlipVertical(ExtState,item,filec,rc) - type(MAPL_ExtData_State), intent(inout) :: ExtState + subroutine MAPL_ExtDataFlipVertical(item,filec,rc) type(PrimaryExport), intent(inout) :: item integer, intent(in) :: filec integer, optional, intent(out) :: rc integer :: status - character(len=ESMF_MAXSTR) :: Iam = "MAPL_ExtDataFlipVertical" type(ESMF_Field) :: Field,field1,field2 real, pointer :: ptr(:,:,:) @@ -4492,11 +4477,11 @@ subroutine MAPL_ExtDataFlipVertical(ExtState,item,filec,rc) if (item%isVector) then if (item%do_Fill .or. item%do_VertInterp) then - call MAPL_ExtDataGetBracket(ExtState,item,filec,field=Field1,vcomp=1,getRL=.true.,__RC__) - call MAPL_ExtDataGetBracket(ExtState,item,filec,field=Field2,vcomp=2,getRL=.true.,__RC__) + call MAPL_ExtDataGetBracket(item,filec,field=Field1,vcomp=1,getRL=.true.,__RC__) + call MAPL_ExtDataGetBracket(item,filec,field=Field2,vcomp=2,getRL=.true.,__RC__) else - call MAPL_ExtDataGetBracket(ExtState,item,filec,field=Field1,vcomp=1,__RC__) - call MAPL_ExtDataGetBracket(ExtState,item,filec,field=Field2,vcomp=2,__RC__) + call MAPL_ExtDataGetBracket(item,filec,field=Field1,vcomp=1,__RC__) + call MAPL_ExtDataGetBracket(item,filec,field=Field2,vcomp=2,__RC__) end if call ESMF_FieldGet(Field1,0,farrayPtr=ptr,rc=status) @@ -4516,9 +4501,9 @@ subroutine MAPL_ExtDataFlipVertical(ExtState,item,filec,rc) else if (item%do_Fill .or. item%do_VertInterp) then - call MAPL_ExtDataGetBracket(ExtState,item,filec,field=Field,getRL=.true.,__RC__) + call MAPL_ExtDataGetBracket(item,filec,field=Field,getRL=.true.,__RC__) else - call MAPL_ExtDataGetBracket(ExtState,item,filec,field=Field,__RC__) + call MAPL_ExtDataGetBracket(item,filec,field=Field,__RC__) end if call ESMF_FieldGet(Field,0,farrayPtr=ptr,rc=status) @@ -4533,15 +4518,13 @@ subroutine MAPL_ExtDataFlipVertical(ExtState,item,filec,rc) _RETURN(ESMF_SUCCESS) end subroutine MAPL_ExtDataFlipVertical - subroutine MAPL_ExtDataPopulateBundle(ExtState,item,filec,pbundle,rc) - type(MAPL_ExtData_State), intent(inout) :: ExtState + subroutine MAPL_ExtDataPopulateBundle(item,filec,pbundle,rc) type(PrimaryExport), intent(inout) :: item integer, intent(in) :: filec type(ESMF_FieldBundle), intent(inout) :: pbundle integer, optional, intent(out) :: rc integer :: status - character(len=ESMF_MAXSTR) :: Iam = "MAPL_ExtDataPopulateBundle" type(ESMF_Field) :: Field,field1,field2 type(ESMF_Grid) :: grid @@ -4549,11 +4532,11 @@ subroutine MAPL_ExtDataPopulateBundle(ExtState,item,filec,pbundle,rc) if (item%isVector) then if (item%do_Fill .or. item%do_VertInterp) then - call MAPL_ExtDataGetBracket(ExtState,item,filec,field=Field1,vcomp=1,getRL=.true.,__RC__) - call MAPL_ExtDataGetBracket(ExtState,item,filec,field=Field2,vcomp=2,getRL=.true.,__RC__) + call MAPL_ExtDataGetBracket(item,filec,field=Field1,vcomp=1,getRL=.true.,__RC__) + call MAPL_ExtDataGetBracket(item,filec,field=Field2,vcomp=2,getRL=.true.,__RC__) else - call MAPL_ExtDataGetBracket(ExtState,item,filec,field=Field1,vcomp=1,__RC__) - call MAPL_ExtDataGetBracket(ExtState,item,filec,field=Field2,vcomp=2,__RC__) + call MAPL_ExtDataGetBracket(item,filec,field=Field1,vcomp=1,__RC__) + call MAPL_ExtDataGetBracket(item,filec,field=Field2,vcomp=2,__RC__) end if call ESMF_FieldGet(Field1,grid=grid,rc=status) @@ -4577,9 +4560,9 @@ subroutine MAPL_ExtDataPopulateBundle(ExtState,item,filec,pbundle,rc) else if (item%do_Fill .or. item%do_VertInterp) then - call MAPL_ExtDataGetBracket(ExtState,item,filec,field=Field,getRL=.true.,__RC__) + call MAPL_ExtDataGetBracket(item,filec,field=Field,getRL=.true.,__RC__) else - call MAPL_ExtDataGetBracket(ExtState,item,filec,field=Field,__RC__) + call MAPL_ExtDataGetBracket(item,filec,field=Field,__RC__) end if call ESMF_FieldGet(Field,grid=grid,rc=status) @@ -4601,7 +4584,7 @@ subroutine MAPL_ExtDataCreateCFIO(IOBundles, rc) type (IoBundleVectorIterator) :: bundle_iter type (ExtData_IoBundle), pointer :: io_bundle - __Iam__('MAPL_ExtDataCreateCFIO') + integer :: status bundle_iter = IOBundles%begin() do while (bundle_iter /= IOBundles%end()) @@ -4620,7 +4603,7 @@ subroutine MAPL_ExtDataDestroyCFIO(IOBundles,rc) type(IoBundleVectorIterator) :: bundle_iter type (ExtData_IoBundle), pointer :: io_bundle - __Iam__('MAPL_ExtDataDestroyCFIO') + integer :: status bundle_iter = IOBundles%begin() do while (bundle_iter /= IOBundles%end()) @@ -4642,8 +4625,6 @@ subroutine MAPL_ExtDataPrefetch(IOBundles,rc) type(ExtData_IoBundle), pointer :: io_bundle => null() integer :: status - logical :: init = .false. - nfiles = IOBundles%size() do n = 1, nfiles @@ -4662,7 +4643,7 @@ subroutine MAPL_ExtDataReadPrefetch(IOBundles,rc) integer :: nfiles, n type (ExtData_IoBundle), pointer :: io_bundle - __Iam__('MAPL_ExtDataReadPrefetch') + integer :: status nfiles = IOBundles%size() @@ -4682,7 +4663,6 @@ subroutine createFileLevBracket(item,cf,rc) integer, optional, intent(out) :: rc integer :: status - character(len=ESMF_MAXSTR) :: Iam = "createFileLevBracket" type (ESMF_Grid) :: grid, newgrid if (item%vartype==MAPL_FieldItem .or. item%vartype==MAPL_ExtDataVectorItem) then @@ -4711,7 +4691,7 @@ subroutine IOBundle_Add_Entry(IOBundles,item,entry_num,file,bside,time_index,rc) integer, intent(in) :: time_index integer, intent(out), optional :: rc - __Iam__('IOBUNDLE_Add_Entry') + integer :: status type (ExtData_IOBundle) :: io_bundle type (NewCFIOItemVector) :: items diff --git a/MAPL_Base/MAPL_ExtData_IOBundleMod.F90 b/MAPL_Base/MAPL_ExtData_IOBundleMod.F90 index f2d673f3c34c..9b0bc504f4a0 100644 --- a/MAPL_Base/MAPL_ExtData_IOBundleMod.F90 +++ b/MAPL_Base/MAPL_ExtData_IOBundleMod.F90 @@ -49,8 +49,6 @@ module MAPL_ExtData_IOBundleMod function new_ExtData_IoBundle(bracket_side, entry_index, file_name, time_index, regrid_method, fraction, template, metadata_coll_id,server_coll_id,items,rc) result(io_bundle) type (ExtData_IoBundle) :: io_bundle - __Iam__('new_ExtData_IoBundle') - integer, intent(in) :: bracket_side integer, intent(in) :: entry_index character(len=*), intent(in) :: file_name @@ -83,8 +81,9 @@ subroutine clean(this, rc) class (ExtData_IoBundle), intent(inout) :: this integer, optional, intent(out) :: rc - __Iam__('clean') - call ESMF_FieldBundleDestroy(this%pbundle, noGarbage=.true.,__RC__) + integer :: status + call ESMF_FieldBundleDestroy(this%pbundle, noGarbage=.true.,rc=status) + _VERIFY(status) _RETURN(ESMF_SUCCESS) @@ -96,8 +95,6 @@ subroutine make_cfio(this, rc) class (ExtData_IoBundle), intent(inout) :: this integer, optional, intent(out) :: rc - __Iam__('make_cfio') - this%cfio = MAPL_NewCFIO(output_bundle=this%pbundle,regrid_method=this%regrid_method, & read_collection_id=this%server_coll_id, & metadata_collection_id = this%metadata_coll_id, fraction = this%fraction, & diff --git a/MAPL_Base/MAPL_Generic.F90 b/MAPL_Base/MAPL_Generic.F90 index a9b99e498887..52a394c75c6f 100644 --- a/MAPL_Base/MAPL_Generic.F90 +++ b/MAPL_Base/MAPL_Generic.F90 @@ -1957,7 +1957,7 @@ recursive subroutine MAPL_GenericFinalize ( GC, IMPORT, EXPORT, CLOCK, RC ) character(len=ESMF_MAXSTR) :: CHILD_NAME character(len=ESMF_MAXSTR) :: RECFIN type (MAPL_MetaComp), pointer :: STATE - integer :: I,j + integer :: I logical :: final_checkpoint integer :: NC integer :: PHASE @@ -2867,7 +2867,6 @@ subroutine MAPL_InternalStateRetrieve(GC, MAPLOBJ, RC) ! ErrLog Variables - character(len=ESMF_MAXSTR) :: IAm="MAPL_InternalStateRetrieve" integer :: STATUS ! Local variables @@ -3528,11 +3527,9 @@ subroutine MAPL_GridCompSetEntryPoint(GC, registeredMethod, usersRoutine, RC) !EOPI integer :: status - character(len=ESMF_MAXSTR) :: IAm type (MAPL_MetaComp), pointer :: META integer :: phase - integer :: phase0, phase1 call MAPL_InternalStateRetrieve( GC, META, RC=STATUS) _VERIFY(STATUS) @@ -4192,7 +4189,6 @@ recursive integer function MAPL_AddChildFromMeta(META, NAME, GRID, & integer, optional , intent( OUT) :: rc !EOPI - character(len=ESMF_MAXSTR) :: IAm='MAPL_AddChildFromMeta' integer :: STATUS integer :: I @@ -6091,8 +6087,6 @@ subroutine MAPL_StateGetVarSpecs(STATE,IMPORT,EXPORT,INTERNAL,RC) ! ! ErrLog Variables - character(len=ESMF_MAXSTR) :: IAm='MAPL_StateGetVarSpec' - ! Begin ! Get the specs for the 3 ESMF states @@ -6895,7 +6889,6 @@ subroutine MAPL_FriendlyGet ( GC, NAME, FIELD, REQUESTOR, RC ) ! ! ErrLog Variables - character(len=ESMF_MAXSTR) :: IAm='MAPL_FriendlyGet' integer :: STATUS ! Local variables @@ -7011,7 +7004,6 @@ subroutine MAPL_GridCompGetFriendlies0 ( GC, TO, BUNDLE, AddGCPrefix, RC ) ! ! ErrLog Variables - character(len=ESMF_MAXSTR) :: IAm='MAPL_GridCompGetFriendlies0' integer :: STATUS ! Local variables @@ -7288,7 +7280,6 @@ subroutine MAPL_GridCompGetFriendlies2 ( GC, TO, BUNDLE, AddGCPrefix, RC ) ! ! ErrLog Variables - character(len=ESMF_MAXSTR) :: IAm='MAPL_GridCompGetFriendlies2' integer :: STATUS, I character(len=ESMF_MAXSTR) :: TO_(1) @@ -7315,7 +7306,6 @@ subroutine MAPL_GridCompGetFriendlies3 ( GC, TO, BUNDLE, AddGCPrefix, RC ) ! ! ErrLog Variables - character(len=ESMF_MAXSTR) :: IAm='MAPL_GridCompGetFriendlies3' integer :: STATUS, I do I=1,size(GC) @@ -7336,7 +7326,6 @@ subroutine MAPL_SetVarSpecForCC(gcA, gcB, ccAxB, rc) integer, optional, intent( out) :: RC ! Error code: ! Local vars - character(len=ESMF_MAXSTR) :: Iam="MAPL_SetVarSpecForCC" character(len=ESMF_MAXSTR) :: NAME integer :: STATUS integer :: I, N, STAT @@ -8380,7 +8369,6 @@ subroutine MAPL_ReadForcing1(STATE,NAME,DATAFILE,CURRENTTIME, & integer, optional, intent( OUT) :: RC !EOPI - character(len=ESMF_MAXSTR) :: IAm = "MAPL_ReadForcing1" integer :: STATUS call MAPL_ReadForcingX(STATE,NAME,DATAFILE,CURRENTTIME, & @@ -8410,7 +8398,6 @@ subroutine MAPL_ReadForcing2(STATE,NAME,DATAFILE,CURRENTTIME, & integer, optional, intent( OUT) :: RC !EOPI - character(len=ESMF_MAXSTR) :: IAm = "MAPL_ReadForcing2" integer :: STATUS call MAPL_ReadForcingX(STATE,NAME,DATAFILE,CURRENTTIME, & @@ -8438,7 +8425,6 @@ subroutine MAPL_ReadForcingX(MPL,NAME,DATAFILE,CURRTIME, & ! ErrLog Variables - character(len=ESMF_MAXSTR) :: IAm = "MAPL_ReadForcing" integer :: STATUS ! Locals @@ -9176,7 +9162,6 @@ subroutine MAPL_StateGetTimeStamp(STATE,NAME,TIME,RC) ! ErrLog Variables - character(len=ESMF_MAXSTR) :: IAm = "MAPL_StateGetTimeStamp" integer :: STATUS ! Locals @@ -9216,7 +9201,6 @@ subroutine MAPL_StateSetTimeStamp(STATE,NAME,TIME,RC) ! ErrLog Variables - character(len=ESMF_MAXSTR) :: IAm = "MAPL_StateSetTimeStamp" integer :: STATUS ! Locals @@ -9246,7 +9230,6 @@ subroutine MAPL_GenericMakeXchgNatural(STATE, RC) ! ErrLog Variables - character(len=ESMF_MAXSTR) :: IAm = "MAPL_GenericMakeXchgNatural" STATE%LOCSTREAM = STATE%ExchangeGrid @@ -9272,7 +9255,6 @@ subroutine MAPL_GridCreate(GC, MAPLOBJ, ESMFGRID, srcGC, rc) integer :: nn,ny character(len=ESMF_MAXSTR) :: GridName character(len=2) :: dateline - real(ESMF_KIND_R8), pointer :: R8D2(:,:) #ifdef CREATE_REGULAR_GRIDS logical :: isRegular #endif @@ -9388,7 +9370,6 @@ subroutine MAPL_GridCoordAdjustFromFile(GRID, GRIDSPECFILE, RC) ! local vars !------------ - character(len=ESMF_MAXSTR) :: IAm='MAPL_GridCoordAdjustFromFile' integer :: STATUS integer :: UNIT integer :: IM, JM @@ -9471,7 +9452,6 @@ recursive subroutine MAPL_GetRootGC(GC, rootGC, RC) integer, optional, intent(OUT) :: rc integer :: status - character(len=ESMF_MAXSTR) :: IAm type (MAPL_MetaComp), pointer :: META call MAPL_GetObjectFromGC(GC, META, RC=STATUS) @@ -9651,7 +9631,6 @@ function MAPL_GridGetSection(Grid, SectionMap, GridName, RC) result(SECTION) character(len=ESMF_MAXSTR) :: name integer :: status - character(len=ESMF_MAXSTR) :: Iam="MAPL_GridGetSection" call ESMF_GridGet(GRID, Name=Name, DistGrid=distgrid, dimCount=dimCount, RC=STATUS) _VERIFY(STATUS) @@ -9751,7 +9730,6 @@ subroutine MAPL_InternalGridSet(MYGRID, GRID, RC) type(ESMF_VM) :: vm integer :: status - character(len=ESMF_MAXSTR) :: Iam="MAPL_InternalGridSet" ! At this point, this component must have a valid grid! !------------------------------------------------------ @@ -9887,7 +9865,6 @@ recursive subroutine MAPL_GetAllExchangeGrids ( GC, LSADDR, RC ) integer :: status - character(len=ESMF_MAXSTR) :: Iam="MAPL_GetAllExchangeGrids" type (MAPL_MetaComp), pointer :: MAPLOBJ type (MAPL_LocStream) :: LocStream @@ -9957,7 +9934,6 @@ subroutine MAPL_DoNotAllocateImport(GC, NAME, notFoundOK, RC) integer, optional, intent( OUT) :: RC ! Return code integer :: status - character(len=ESMF_MAXSTR) :: Iam="MAPL_DoNotAllocateImport" type (MAPL_MetaComp), pointer :: MAPLOBJ type (MAPL_VarSpec), pointer :: SPEC(:) => null() @@ -9983,7 +9959,6 @@ subroutine MAPL_DoNotAllocateInternal(GC, NAME, notFoundOK, RC) integer, intent( OUT) :: RC ! Return code integer :: status - character(len=ESMF_MAXSTR) :: Iam="MAPL_DoNotAllocateInternal" type (MAPL_MetaComp), pointer :: MAPLOBJ type (MAPL_VarSpec), pointer :: SPEC(:) @@ -10007,7 +9982,6 @@ subroutine MAPL_DoNotAllocateVar(SPEC, NAME, notFoundOK, RC) integer, optional, intent( OUT) :: RC ! Return code integer :: status - character(len=ESMF_MAXSTR) :: Iam="MAPL_DoNotAllocateVar" integer :: I logical :: notFoundOK_ @@ -10046,7 +10020,6 @@ subroutine ArrDescrSetNCPar(ArrDes, MPL, tile, offset, num_readers, num_writers, logical :: tile_loc type(ESMF_Grid) :: TILEGRID character(len=MPI_MAX_INFO_VAL) :: romio_cb_read,cb_buffer_size,romio_cb_write - character(len=ESMF_MAXSTR) :: Iam="ArrDescrSetNCPar" if (present(tile)) then tile_loc=tile diff --git a/MAPL_Base/MAPL_GetLatLonCoord.F90 b/MAPL_Base/MAPL_GetLatLonCoord.F90 index 3eb40f370ddc..598fc0e0872e 100644 --- a/MAPL_Base/MAPL_GetLatLonCoord.F90 +++ b/MAPL_Base/MAPL_GetLatLonCoord.F90 @@ -39,7 +39,6 @@ subroutine MAPL_GetLatLonCoord_REAL64(grid,dim,x,rc) type(ESMF_DeLayout) :: layout type(ESMF_VM) :: vm integer :: status - character(len=ESMF_MAXSTR) :: Iam = "MAPL_GetLatLonCoord_REAL64" call ESMF_GridGetCoord (grid, coordDim=dim, localDE=0, & staggerloc=ESMF_STAGGERLOC_CENTER, & @@ -87,7 +86,6 @@ subroutine MAPL_GetLatLonCoord_REAL32(grid,dim,x,rc) type(ESMF_DeLayout) :: layout type(ESMF_VM) :: vm integer :: status - character(len=ESMF_MAXSTR) :: Iam = "MAPL_GetLatLonCoord_REAL32" call ESMF_GridGetCoord (grid, coordDim=dim, localDE=0, & staggerloc=ESMF_STAGGERLOC_CENTER, & diff --git a/MAPL_Base/MAPL_HistoryGridComp.F90 b/MAPL_Base/MAPL_HistoryGridComp.F90 index 7ad287562fa3..088c0e012bb3 100644 --- a/MAPL_Base/MAPL_HistoryGridComp.F90 +++ b/MAPL_Base/MAPL_HistoryGridComp.F90 @@ -140,7 +140,6 @@ subroutine SetServices ( gc, rc ) integer, optional :: rc ! return code integer :: status - character(len=ESMF_MAXSTR) :: IAm="History:SetServices" type (HISTORY_wrap) :: wrap type (HISTORY_STATE), pointer :: internal_state @@ -260,7 +259,6 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) ! EOP integer :: status - character(len=ESMF_MAXSTR) :: IAm="History:Initalize" logical :: errorFound logical :: found @@ -376,14 +374,13 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) ! Async cfio option type(MAPL_Communicators) :: mapl_comm - logical :: Async, doAsync + logical :: doAsync ! Single colum flag used to set different defalut for TM integer :: snglcol integer :: tm_default ! variable for vector handling - logical :: vectorDone integer :: idx, nvec character(len=ESMF_MAXSTR) :: f1copy, f3copy character(len=ESMF_MAXSTR), pointer :: vectorList(:,:) => null() @@ -413,7 +410,7 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) character(len=:), pointer :: key type(StringFieldSetMapIterator) :: field_set_iter character(ESMF_MAXSTR) :: field_set_name - integer :: nfields,collection_id + integer :: collection_id ! Begin !------ @@ -2679,17 +2676,14 @@ subroutine Run ( gc, import, export, clock, rc ) type(ESMF_State) :: state_out integer :: nymd, nhms character(len=ESMF_MAXSTR) :: DateStamp - integer :: n1, n2, nn, CollBlock, scount + integer :: nn, CollBlock, scount type(MAPL_Communicators) :: mapl_Comm - integer :: nNodes,RootRank - logical :: PrePost_ ! variables for "backwards" mode logical :: fwd logical, allocatable :: Ignore(:) ! ErrLog vars - character(len=ESMF_MAXSTR) :: IAm="HistoryRun" integer :: status !============================================================================= @@ -3067,14 +3061,12 @@ subroutine Finalize ( gc, import, export, clock, rc ) ! = 0 all is well ! otherwise, error - character(len=ESMF_MAXSTR) :: IAm="Finalize" integer :: status type(HistoryCollection), pointer :: list(:) type(HISTORY_wrap) :: wrap type (HISTORY_STATE), pointer :: IntState integer :: nlist, n type (MAPL_MetaComp), pointer :: GENSTATE - type(MAPL_Communicators) :: mapl_Comm ! Begin... @@ -3176,7 +3168,6 @@ subroutine MAPL_GradsCtlWrite ( clock, state,list,fname,expid,expdsc,output_grid 'JUL','AUG','SEP','OCT','NOV','DEC'/ integer :: unit,nfield - character(len=ESMF_MAXSTR) :: IAm="MAPL_GradsCtlWrite" integer :: k,m,rank,status integer :: year,month,day,hour,minute real(kind=REAL64) LONBEG,DLON @@ -3447,7 +3438,6 @@ subroutine get_DateStamp (clock, DateStamp, offset, rc) character*2 second integer :: STATUS - character(len=ESMF_MAXSTR) :: Iam="get_DateStamp" equivalence ( string(01),TimeString ) equivalence ( string(01),year ) @@ -3514,7 +3504,6 @@ subroutine RegridTransform(STATE_IN, XFORM, STATE_OUT, LS_IN, LS_OUT, NTILES_IN, integer, optional , intent( OUT) :: RC integer :: STATUS - character(len=ESMF_MAXSTR), parameter :: Iam='RegridTransform' integer :: L, LM integer :: LL, LU @@ -3646,7 +3635,6 @@ subroutine RegridTransformT2G2G(STATE_IN, XFORM, XFORMntv, STATE_OUT, LS_IN, LS_ integer, optional , intent( OUT) :: RC integer :: STATUS - character(len=ESMF_MAXSTR), parameter :: Iam='RegridTransformT2G2G' integer :: L, LM, K, KM integer :: I @@ -3868,7 +3856,6 @@ subroutine RegridTransformT2G(STATE_IN, XFORM, STATE_OUT, LS_OUT, NTILES_OUT, RC integer, optional , intent( OUT) :: RC integer :: STATUS - character(len=ESMF_MAXSTR), parameter :: Iam = "RegridTransformT2G" integer :: I, L, K, LM, KM integer :: rank_in @@ -4144,7 +4131,6 @@ subroutine MAPL_SetExpression(nfield,fields,tmpfields,rewrite,nPExtraFields, & integer:: i,j,m,k,status,largest_rank,iRepField,ivLoc logical :: ifound_vloc - character(len=ESMF_MAXSTR) :: Iam='MAPL_SetExpression' character(len=ESMF_MAXSTR) :: tmpList character(len=ESMF_MAXSTR) :: VarName integer :: idx @@ -4417,7 +4403,6 @@ subroutine MAPL_RunExpression(state,fields,tmpfields,rewrite,nfield,rc) integer, optional, intent(out) :: rc ! Local variables: - character(len=ESMF_MAXSTR) :: Iam='MAPL_RunExpression' character(len=ESMF_MAXSTR) :: fname,fexpr integer:: m,STATUS type(ESMF_Field) :: field @@ -4443,7 +4428,6 @@ subroutine MAPL_StateDestroy(State, RC) integer, optional,intent( out) :: rc ! Local variables: - character(len=ESMF_MAXSTR) :: Iam='MAPL_StateDestroy' integer :: STATUS type(ESMF_Field) :: field @@ -4505,7 +4489,6 @@ subroutine MAPL_StateGet(state,name,field,rc) type(ESMF_Field), intent(inout) :: field integer, optional, intent(out ) :: rc - character(len=ESMF_MAXSTR), parameter :: Iam='MAPL_StateGet' integer :: status character(len=ESMF_MAXSTR) :: bundlename, fieldname type(ESMF_FieldBundle) :: bundle diff --git a/MAPL_Base/MAPL_LocStreamMod.F90 b/MAPL_Base/MAPL_LocStreamMod.F90 index ccdf24c9db9e..80b5f707667f 100644 --- a/MAPL_Base/MAPL_LocStreamMod.F90 +++ b/MAPL_Base/MAPL_LocStreamMod.F90 @@ -156,7 +156,7 @@ logical function MAPL_LocStreamIsAssociated(LocStream, RC) type(MAPL_LocStream), intent(IN ) :: LocStream integer, optional, intent( OUT) :: RC - character(len=ESMF_MAXSTR) :: IAm='MAPL_LocStreamIsAssocited' + MAPL_LocStreamIsAssociated = associated(LocStream%Ptr) @@ -169,7 +169,7 @@ logical function MAPL_LocStreamXformIsAssociated(Xform, RC) type(MAPL_LocStreamXform), intent(IN ) :: Xform integer, optional, intent( OUT) :: RC - character(len=ESMF_MAXSTR) :: IAm='MAPL_LocStreamXformIsAssocited' + MAPL_LocStreamXformIsAssociated = associated(Xform%Ptr) @@ -204,7 +204,7 @@ subroutine MAPL_LocStreamGet(LocStream, NT_LOCAL, TILETYPE, TILEKIND, & ! Local variables - character(len=ESMF_MAXSTR) :: IAm='MAPL_LocStreamGet' + #ifdef __GFORTRAN__ integer :: i integer, pointer :: tmp_iptr(:) => null() @@ -362,7 +362,7 @@ subroutine MAPL_LocStreamCreateFromFile(LocStream, LAYOUT, FILENAME, NAME, MASK, ! Local variables - character(len=ESMF_MAXSTR) :: IAm='MAPL_LocStreamCreateFromFile' + integer :: STATUS integer :: UNIT @@ -1106,7 +1106,7 @@ subroutine GetBilinearCoeffs(X0,Y0,DX,DY,X,Y,II,JJ,D,RC) real, intent( OUT) :: D(-1:,-1:) integer, optional, intent( OUT) :: RC - character(len=ESMF_MAXSTR) :: IAm='GetBilinearCoeffs' + integer :: STATUS real :: DX0, DY0 real :: X00, Y00 @@ -1155,7 +1155,7 @@ subroutine GetBilinearCoeffs(lons,lats,lon,lat,D,RC) real, intent( OUT) :: D(-1:,-1:) integer, optional, intent( OUT) :: RC - character(len= ESMF_MAXSTR) :: IAm='GetBilinearCoeffs' + integer :: STATUS real, dimension(3) :: pp, p0, dp, dpx, dpy @@ -1337,7 +1337,7 @@ subroutine MAPL_LocStreamCreateFromStream(LocStreamOut, LocStreamIn, NAME, MASK, ! Local variables - character(len=ESMF_MAXSTR) :: IAm='MAPL_LocStreamCreateFromStream' + integer :: STATUS integer :: N, I, K, NT @@ -1474,7 +1474,7 @@ subroutine MAPL_LocStreamAttachGrid(LocStream, GRID, ISMINE, RC) ! Local variables - character(len=ESMF_MAXSTR) :: IAm='MAPL_LocStreamAttachGrid' + integer :: STATUS type(MAPL_LocStreamType), pointer :: STREAM @@ -1558,7 +1558,7 @@ subroutine MAPL_LocStreamCreateTileGrid(LocStream, GRID, RC) ! Local variables - character(len=ESMF_MAXSTR) :: IAm='MAPL_LocStreamCreateTileGrid' + integer :: STATUS @@ -1648,7 +1648,7 @@ subroutine MAPL_LocStreamAdjustNsubtiles(LocStream, NSUBTILES, RC) ! Local variables - character(len=ESMF_MAXSTR) :: IAm='MAPL_LocStreamAdjustNsubtiles' + integer :: STATUS type(MAPL_LocStreamType), pointer :: STREAM @@ -1695,7 +1695,7 @@ subroutine MAPL_LocStreamTransformField (LocStream, OUTPUT, INPUT, MASK, & ! Local variables - character(len=ESMF_MAXSTR) :: IAm='MAPL_LocStreamTransform' + integer :: STATUS integer :: N, NT @@ -1779,7 +1779,7 @@ subroutine MAPL_LocStreamFracArea (LocStream, TYPE, AREA, RC ) ! Local variables - character(len=ESMF_MAXSTR) :: IAm='MAPL_LocStreamFracArea' + integer :: II, JJ, N @@ -1829,7 +1829,7 @@ subroutine MAPL_LocStreamTransformT2G (LocStream, OUTPUT, INPUT, MASK, SAMPLE, T ! Local variables - character(len=ESMF_MAXSTR) :: IAm='MAPL_LocStreamTransformT2G' + integer :: STATUS real, allocatable :: FF(:,:) integer :: II, JJ, N, I1, IN, J1, JN @@ -1970,7 +1970,7 @@ subroutine MAPL_LocStreamTransformG2T ( LocStream, OUTPUT, INPUT, & ! Local variables - character(len=ESMF_MAXSTR) :: IAm='MAPL_LocStreamTransformG2T' + integer :: STATUS integer :: N, I1, IN, J1, JN, I, J, IM, JM @@ -2129,7 +2129,7 @@ subroutine MAPL_LocStreamTileWeight ( LocStream, OUTPUT, INPUT, RC ) integer :: N - character(len=ESMF_MAXSTR) :: IAm='MAPL_LocStreamTileWeight' + ! Fill output subject to mask @@ -2162,7 +2162,7 @@ subroutine MAPL_LocStreamTransformT2T ( OUTPUT, XFORM, INPUT, RC ) ! Local variables - character(len=ESMF_MAXSTR) :: IAm='MAPL_LocStreamTransformT2T' + integer :: STATUS integer :: N, offset @@ -2314,7 +2314,7 @@ subroutine MAPL_LocStreamTransformT2TR4R8 ( OUTPUT, XFORM, INPUT, RC ) ! Local variables - character(len=ESMF_MAXSTR) :: IAm='MAPL_LocStreamTransformT2TR4R8' + integer :: STATUS #ifdef OLD_RUN @@ -2381,7 +2381,7 @@ subroutine MAPL_LocStreamTransformT2TR8R4 ( OUTPUT, XFORM, INPUT, RC ) ! Local variables - character(len=ESMF_MAXSTR) :: IAm='MAPL_LocStreamTransformT2TR8R4' + integer :: STATUS #ifdef OLD_RUN @@ -2442,7 +2442,7 @@ subroutine MAPL_LocStreamCreateXform ( Xform, LocStreamOut, LocStreamIn, NAME, M ! Local variables - character(len=ESMF_MAXSTR) :: IAm='MAPL_LocStreamCreateXform' + integer :: STATUS integer :: N, M, MM @@ -2763,7 +2763,7 @@ integer function GRIDINDEX(STREAM,GRID,RC) type(ESMF_Grid), intent(IN ) :: Grid integer, optional, intent(OUT) :: RC - character(len=ESMF_MAXSTR) :: IAm='GridIndex' + integer :: STATUS integer :: N @@ -2797,7 +2797,7 @@ subroutine MAPL_GridCoordAdjust(GRID, LOCSTREAM, RC) ! local vars !------------ - character(len=ESMF_MAXSTR) :: IAm='MAPL_GridCoordAdjust' + integer :: STATUS integer :: NGRIDS diff --git a/MAPL_Base/MAPL_RegridderManager.F90 b/MAPL_Base/MAPL_RegridderManager.F90 index 462a0304120c..7bf758c58a5d 100644 --- a/MAPL_Base/MAPL_RegridderManager.F90 +++ b/MAPL_Base/MAPL_RegridderManager.F90 @@ -233,8 +233,6 @@ function new_make_regridder_from_grids(this, grid_in, grid_out, regrid_method, u type (RegridderSpec) :: spec integer(ESMF_KIND_I8) :: id_in, id_out - type (EsmfRegridder), pointer :: esmf_regridder - _UNUSED_DUMMY(unusable) if (.not. this%initialized) then diff --git a/MAPL_Base/MAPL_ShmemMod.F90 b/MAPL_Base/MAPL_ShmemMod.F90 index c9e04665e34e..416f7ded2486 100755 --- a/MAPL_Base/MAPL_ShmemMod.F90 +++ b/MAPL_Base/MAPL_ShmemMod.F90 @@ -1480,7 +1480,6 @@ function MAPL_GetNewRank(node,rc) result(rank) integer, optional, intent(out) :: rc integer :: rank - integer :: status rank = MAPL_NodeRankList(node)%RankLastUsed+1 if (rank > size(MAPL_NodeRankList(node)%rank)) then diff --git a/MAPL_Base/MAPL_VarSpecMod.F90 b/MAPL_Base/MAPL_VarSpecMod.F90 index c1c14c9d57a8..85570ec61b44 100644 --- a/MAPL_Base/MAPL_VarSpecMod.F90 +++ b/MAPL_Base/MAPL_VarSpecMod.F90 @@ -220,7 +220,7 @@ subroutine MAPL_VarSpecCreateInList(SPEC, SHORT_NAME, LONG_NAME, & integer , optional , intent(OUT) :: RC - character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_VarSpecCreateInList" + integer :: STATUS type (MAPL_VarSpec ), pointer :: TMP(:) => null() @@ -582,7 +582,7 @@ subroutine MAPL_VarSpecAddRefFromItem(SPEC, ITEM, ALLOW_DUPLICATES, RC) integer, optional , intent(OUT) :: RC - character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_VarSpecAddRefFromItem" + integer :: STATUS type (MAPL_VarSpec ), pointer :: TMP(:) => null() @@ -649,7 +649,7 @@ subroutine MAPL_VarSpecAddRefFromList(SPEC,ITEM,RC) integer, optional , intent(OUT) :: RC - character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_VarSpecAddRefFromList" + integer :: STATUS integer I @@ -672,7 +672,7 @@ function MAPL_VarSpecGetIndexByName(SPEC, NAME, RC) result (INDEX) integer, optional , intent(OUT) :: RC integer :: INDEX - character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_VarSpecGetIndexByName" + integer :: I @@ -701,7 +701,7 @@ subroutine MAPL_VarSpecGetDataByName(SPEC, NAME, PTR1, PTR2, PTR3, RC) real, optional, pointer :: PTR3(:,:,:) integer, optional , intent(OUT) :: RC - character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_VarSpecGetDataByName" + integer :: STATUS integer :: I @@ -730,7 +730,7 @@ subroutine MAPL_VarSpecGetData(SPEC, PTR1, PTR2, PTR3, RC) real, optional, pointer :: PTR3(:,:,:) integer, optional , intent(OUT) :: RC - character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_VarSpecGetData" + integer :: STATUS type(ESMF_Array) :: ARRAY @@ -773,7 +773,7 @@ function MAPL_VarSpecGetIndexOfItem(SPEC, ITEM, RC) result (INDEX) integer, optional , intent(OUT) :: RC integer :: INDEX - character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_VarSpecGetIndexOfItem" + integer :: I @@ -803,7 +803,7 @@ subroutine MAPL_VarSpecAddFromItem(SPEC,ITEM,RC) integer, optional , intent(OUT) :: RC - character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_VarSpecAddFromItem" + integer :: STATUS @@ -851,7 +851,7 @@ subroutine MAPL_VarSpecAddFromList(SPEC,ITEM,RC) integer, optional , intent(OUT) :: RC - character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_VarSpecAddFromList" + integer :: STATUS integer I @@ -872,7 +872,7 @@ subroutine MAPL_VarSpecDestroy0(SPEC, RC ) integer , optional , intent(OUT) :: RC - character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_VarSpecDestroy" + if(associated(SPEC%SPECPtr)) then deallocate(SPEC%SPECPtr) @@ -888,7 +888,7 @@ subroutine MAPL_VarSpecDestroy1(SPEC, RC ) integer , optional , intent(OUT) :: RC - character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_VarSpecDestroy" + integer :: i if (associated(SPEC)) then @@ -940,7 +940,7 @@ subroutine MAPL_VarSpecSetRegular(SPEC, SHORT_NAME, LONG_NAME, UNITS, & integer , optional , intent(OUT) :: RC - character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_VarSpecSet" + if(.not.associated(SPEC%SPECPtr)) then _RETURN(ESMF_FAILURE) @@ -1038,7 +1038,7 @@ subroutine MAPL_VarSpecSetFieldPtr(SPEC, FIELDPTR, RC ) integer , optional , intent( OUT) :: RC - character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_VarSpecSetFieldPtr" + if(.not.associated(SPEC%SPECPtr)) then _RETURN(ESMF_FAILURE) @@ -1057,7 +1057,7 @@ subroutine MAPL_VarSpecSetBundlePtr(SPEC, BUNDLEPTR, RC ) integer , optional , intent( OUT) :: RC - character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_VarSpecSetBundlePtr" + if(.not.associated(SPEC%SPECPtr)) then _RETURN(ESMF_FAILURE) @@ -1076,7 +1076,7 @@ subroutine MAPL_VarSpecSetStatePtr(SPEC, STATEPTR, RC ) integer , optional , intent( OUT) :: RC - character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_VarSpecSetStatePtr" + if(.not.associated(SPEC%SPECPtr)) then _RETURN(ESMF_FAILURE) @@ -1151,7 +1151,7 @@ subroutine MAPL_VarSpecGetRegular(SPEC, SHORT_NAME, LONG_NAME, UNITS, & integer , optional , intent(OUT) :: RC - character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_VarSpecGet" + if(.not.associated(SPEC%SPECPtr)) then _RETURN(ESMF_FAILURE) @@ -1304,7 +1304,7 @@ subroutine MAPL_VarSpecGetFieldPtr(SPEC, FIELDPTR, RC ) integer , optional , intent(OUT) :: RC - character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_VarSpecGetFieldPtr" + if(.not.associated(SPEC%SPECPtr)) then _RETURN(ESMF_FAILURE) @@ -1323,7 +1323,7 @@ subroutine MAPL_VarSpecGetBundlePtr(SPEC, BundlePTR, RC ) integer , optional , intent(OUT) :: RC - character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_VarSpecGetBundlePtr" + if(.not.associated(SPEC%SPECPtr)) then _RETURN(ESMF_FAILURE) @@ -1342,7 +1342,7 @@ subroutine MAPL_VarSpecGetStatePtr(SPEC, StatePTR, RC ) integer , optional , intent(OUT) :: RC - character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_VarSpecGetStatePtr" + if(.not.associated(SPEC%SPECPtr)) then @@ -1363,7 +1363,7 @@ subroutine MAPL_VarSpecAddChildName(SPEC,CN,RC) integer, optional , intent(OUT) :: RC - character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_VarSpecAddChildName" + integer K @@ -1383,7 +1383,7 @@ subroutine MAPL_VarSpecReconnect(SPEC,ITEM,RC) integer, optional , intent(OUT) :: RC - character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_VarSpecReconnect" + integer :: STATUS type(ESMF_Field), pointer :: FIELD @@ -1502,7 +1502,7 @@ subroutine MAPL_VarConnCreate(CONN, SHORT_NAME, TO_NAME, & - character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_VarConnCreate" + integer :: STATUS type (MAPL_VarConn ), pointer :: TMP(:) => null() @@ -1581,7 +1581,7 @@ subroutine MAPL_VarConnGet(CONN, SHORT_NAME, & - character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_VarConnGet" + if(.not.associated(CONN%CONNPtr)) then @@ -1621,7 +1621,7 @@ logical function MAPL_VarIsConnectedEE(CONN, SHORT_NAME, & integer, intent( OUT) :: RC ! Error code: - character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_VarIsConnectedEE" + integer :: I integer :: FI, TI, FE, TE @@ -1677,7 +1677,7 @@ logical function MAPL_VarIsConnectedIE(CONN, IMPORT_NAME, EXPORT_NAME, & integer, optional, intent( OUT) :: RC ! Error code: - character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_VarIsConnectedIE" + integer :: I integer :: FI, TI, FE, TE @@ -1748,7 +1748,7 @@ logical function MAPL_VarIsListed(CONN, SHORT_NAME, IMPORT, RC) integer, optional, intent(OUT) :: RC ! Error code: - character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_VarIsListed" + integer :: I integer :: FI, TI, FE, TE @@ -1793,7 +1793,7 @@ subroutine MAPL_VarSpecPrintOne(SPEC, RC ) integer , optional , intent(OUT) :: RC - character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_VarSpecPrint" + character(len=3) :: tmp character(len=ESMF_MAXSTR) :: string @@ -1824,7 +1824,7 @@ subroutine MAPL_VarSpecPrintMany(SPEC, RC ) integer , optional , intent(OUT) :: RC - character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_VarSpecPrintMany" + integer :: STATUS integer :: I @@ -1848,7 +1848,7 @@ subroutine MAPL_VarSpecPrint1CSV(SPEC, compName, RC ) integer , optional , intent(OUT) :: RC - character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_VarSpecPrint1CSV" + character(len=3) :: dimensions character(len=ESMF_MAXSTR) :: specInfo @@ -1872,7 +1872,7 @@ subroutine MAPL_VarSpecPrintCSV(SPEC, compName, RC ) integer , optional , intent(OUT) :: RC - character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_VarSpecPrintCSV" + integer :: STATUS integer :: I @@ -1915,7 +1915,7 @@ subroutine MAPL_ConnCheckReq(CONN, ImSpecPtr, ExSpecPtr, RC) type (MAPL_VarSpecPtr), pointer :: ExSpecPtr(:) integer, optional, intent(OUT) :: RC - character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_ConnCheckReq" + integer :: I, J integer :: IMP integer :: FI diff --git a/MAPL_Base/MAPL_VerticalInterpMod.F90 b/MAPL_Base/MAPL_VerticalInterpMod.F90 index db21d4bc4bb2..c5695275b236 100644 --- a/MAPL_Base/MAPL_VerticalInterpMod.F90 +++ b/MAPL_Base/MAPL_VerticalInterpMod.F90 @@ -63,7 +63,6 @@ subroutine vertInterpolation_pressKappa (fModel, fPres, ps, plevs, & character(len=1) :: vartype real(REAL64), allocatable :: ak(:),bk(:) integer :: status - character(len=ESMF_MAXSTR) :: Iam = "MAPL_VerticalInterp" real :: gfactor type(ESMF_Grid) :: grid real, pointer :: vMod(:,:,:), vPres(:,:,:), vPS(:,:), vPHIS(:,:) diff --git a/MAPL_Base/arraygather.H b/MAPL_Base/arraygather.H index d2981ce16e33..dc086a22fe16 100644 --- a/MAPL_Base/arraygather.H +++ b/MAPL_Base/arraygather.H @@ -25,7 +25,6 @@ ! Local variables integer :: status - character(len=ESMF_MAXSTR) :: IAm='ArrayGather' type (ESMF_DELayout) :: layout type (ESMF_DistGrid) :: distGrid diff --git a/MAPL_Base/arraygatherRcvCnt.H b/MAPL_Base/arraygatherRcvCnt.H index 891167018994..182cf9d08d97 100644 --- a/MAPL_Base/arraygatherRcvCnt.H +++ b/MAPL_Base/arraygatherRcvCnt.H @@ -24,7 +24,6 @@ ! Local variables integer :: status - character(len=ESMF_MAXSTR) :: IAm='ArrayGatherRcvCnt' integer, allocatable, dimension(:) :: displs integer :: nDEs diff --git a/MAPL_Base/arrayscatter.H b/MAPL_Base/arrayscatter.H index cf9d2a606869..4e9558acc271 100644 --- a/MAPL_Base/arrayscatter.H +++ b/MAPL_Base/arrayscatter.H @@ -28,7 +28,6 @@ ! Local variables integer :: status - character(len=ESMF_MAXSTR) :: IAm='ArrayScatter' TYPE_(kind=EKIND_), pointer :: myglob DIMENSIONS_ => null() TYPE_(kind=EKIND_), pointer :: VAR(:) diff --git a/MAPL_Base/arrayscatterRcvCnt.H b/MAPL_Base/arrayscatterRcvCnt.H index e0b4a811dc48..967d61e2c7f4 100644 --- a/MAPL_Base/arrayscatterRcvCnt.H +++ b/MAPL_Base/arrayscatterRcvCnt.H @@ -24,7 +24,6 @@ ! Local variables integer :: status - character(len=ESMF_MAXSTR) :: IAm='ArrayScatterRcvCnt' integer, allocatable, dimension(:) :: displs integer :: nDEs From d76d318d4ba2901a4078f08a591b4af46d2fa44a Mon Sep 17 00:00:00 2001 From: Peter Norris Date: Tue, 24 Dec 2019 11:57:58 -0500 Subject: [PATCH 009/109] PMN: Bugfix to feature/pnorris/#78-add-equation-of-time The previous version did not pass on the apply_EOT logical to the recursive MAPL_SunGetInsolation subscalls in a time-averaged MAPL_SunGetInsolation call. --- MAPL_Base/sun.H | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/MAPL_Base/sun.H b/MAPL_Base/sun.H index 2e83f52e2499..3c3fba4284b5 100644 --- a/MAPL_Base/sun.H +++ b/MAPL_Base/sun.H @@ -292,7 +292,8 @@ if(present(DIST)) DIST = 0.0 call MAPL_SunGetInsolation( LONS, LATS, ORBIT, ZTT, SLT, & - CLOCK=MYCLOCK, TIME=TIME, DIST=DD, RC=STATUS) + CLOCK=MYCLOCK, TIME=TIME, DIST=DD, & + EOT=apply_EOT, RC=STATUS) _VERIFY(STATUS) if(present(ZTH1)) ZTH1 = max(ZTT,0.0) @@ -315,7 +316,8 @@ _VERIFY(STATUS) call MAPL_SunGetInsolation( LONS, LATS, ORBIT, ZTT, SLT, & - CLOCK=MYCLOCK, TIME=TIME, ZTHB=ZTB, ZTHD=ZTD, DIST=DD, RC=STATUS) + CLOCK=MYCLOCK, TIME=TIME, ZTHB=ZTB, ZTHD=ZTD, DIST=DD, & + EOT=apply_EOT, RC=STATUS) _VERIFY(STATUS) SLR = SLR + SLT*0.5 From 92db168b95e46b77d13e496e2223a8b03458dd55 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 7 Jan 2020 17:14:33 -0500 Subject: [PATCH 010/109] forgot to change the staging of the lat-lons to generic logic --- MAPL_Base/MAPL_newCFIO.F90 | 64 ++++++++++++++++---------------------- 1 file changed, 27 insertions(+), 37 deletions(-) diff --git a/MAPL_Base/MAPL_newCFIO.F90 b/MAPL_Base/MAPL_newCFIO.F90 index feaad020910f..821bf8b92f27 100644 --- a/MAPL_Base/MAPL_newCFIO.F90 +++ b/MAPL_Base/MAPL_newCFIO.F90 @@ -336,7 +336,7 @@ subroutine bundlepost(this,filename,oClients,rc) integer :: status type(ESMF_Field) :: outField - integer :: tindex,request_id + integer :: tindex type(ArrayReference) :: ref type(newCFIOitemVectorIterator) :: iter @@ -601,45 +601,36 @@ subroutine stage2DLatLon(this, fileName, oClients, rc) type (ClientManager), optional, intent(inout) :: oClients integer, optional, intent(out) :: rc - integer :: request_id integer :: status - logical :: isCubed real(REAL64), pointer :: ptr2d(:,:) type(ArrayReference) :: ref - integer :: i1,in,j1,jn,tile - integer :: global_dim(3) + class (AbstractGridFactory), pointer :: factory + integer, allocatable :: localStart(:),globalStart(:),globalCount(:) - call MAPL_GridGet(this%output_grid,globalCellCountPerDim=global_dim,rc=status) + factory => get_factory(this%output_grid,rc=status) _VERIFY(status) - isCubed=.false. - if (global_dim(1)*6 == global_dim(2)) isCubed=.true. - - if (isCubed) then - - call MAPL_Grid_interior(this%output_grid,i1,in,j1,jn) - tile = j1/global_dim(1) - call ESMF_GridGetCoord(this%output_grid, localDE=0, coordDim=1, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=ptr2d, rc=status) - _VERIFY(STATUS) - if (.not.allocated(this%lons)) allocate(this%lons(size(ptr2d,1),size(ptr2d,2))) - this%lons=ptr2d*MAPL_RADIANS_TO_DEGREES - ref = ArrayReference(this%lons) - call oClients%collective_stage_data(this%write_collection_id,trim(filename),'lons', & - ref,start=[i1,j1-tile*global_dim(1),tile+1], & - global_start=[1,1,1], global_count=[global_dim(1),global_dim(1),6]) - call ESMF_GridGetCoord(this%output_grid, localDE=0, coordDim=2, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=ptr2d, rc=status) - _VERIFY(STATUS) - if (.not.allocated(this%lats)) allocate(this%lats(size(ptr2d,1),size(ptr2d,2))) - !ref = ArrayReference(ptr2d) - this%lats=ptr2d*MAPL_RADIANS_TO_DEGREES - ref = ArrayReference(this%lats) - call oClients%collective_stage_data(this%write_collection_id,trim(filename),'lats', & - ref,start=[i1,j1-tile*global_dim(1),tile+1], & - global_start=[1,1,1], global_count=[global_dim(1),global_dim(1),6]) - end if + + call factory%generate_file_bounds(this%output_grid,LocalStart,GlobalStart,GlobalCount,rc=status) + _VERIFY(status) + call ESMF_GridGetCoord(this%output_grid, localDE=0, coordDim=1, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=ptr2d, rc=status) + _VERIFY(STATUS) + if (.not.allocated(this%lons)) allocate(this%lons(size(ptr2d,1),size(ptr2d,2))) + this%lons=ptr2d*MAPL_RADIANS_TO_DEGREES + ref = ArrayReference(this%lons) + call oClients%collective_stage_data(this%write_collection_id,trim(filename),'lons', & + ref,start=localStart, global_start=GlobalStart, global_count=GlobalCount) + call ESMF_GridGetCoord(this%output_grid, localDE=0, coordDim=2, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=ptr2d, rc=status) + _VERIFY(STATUS) + if (.not.allocated(this%lats)) allocate(this%lats(size(ptr2d,1),size(ptr2d,2))) + this%lats=ptr2d*MAPL_RADIANS_TO_DEGREES + ref = ArrayReference(this%lats) + call oClients%collective_stage_data(this%write_collection_id,trim(filename),'lats', & + ref,start=localStart, global_start=GlobalStart, global_count=GlobalCount) + end subroutine stage2DLatLon @@ -651,7 +642,6 @@ subroutine stageData(this, field, fileName, tIndex, oClients, rc) type (ClientManager), optional, intent(inout) :: oClients integer, optional, intent(out) :: rc - integer :: request_id integer :: status integer :: fieldRank character(len=ESMF_MAXSTR) :: fieldName @@ -771,7 +761,7 @@ subroutine request_data_from_file(this,filename,timeindex,rc) character(len=ESMF_MAXSTR), allocatable :: names(:) type(ESMF_Field) :: output_field type(ESMF_Field), allocatable :: input_fields(:) - integer :: ub(1),lb(1),i1,in,j1,jn,img,jmg,dims(3),lm,rank + integer :: ub(1),lb(1),dims(3),lm,rank type(ArrayReference) :: ref real, pointer :: ptr2d(:,:) => null() real, pointer :: ptr3d(:,:,:) => null() From 07320d5e6562c2bfdbf00bc11b810a827c78ceed Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Wed, 8 Jan 2020 11:06:07 -0500 Subject: [PATCH 011/109] fix face index for non-even distribution --- MAPL_Base/MAPL_CubedSphereGridFactory.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/MAPL_Base/MAPL_CubedSphereGridFactory.F90 b/MAPL_Base/MAPL_CubedSphereGridFactory.F90 index 96e8d45648c7..37c6e50b0354 100644 --- a/MAPL_Base/MAPL_CubedSphereGridFactory.F90 +++ b/MAPL_Base/MAPL_CubedSphereGridFactory.F90 @@ -1031,7 +1031,7 @@ function get_fake_longitudes(this, unusable, rc) result(longitudes) j_mid = 1 + this%im_world/2 - tile = 1 + pet/(npes/this%nTiles) + tile = 1 + (j_1-1)/this%im_world if (tile == 1 .and. (j_1 <= j_mid) .and. (j_mid <= j_n)) then allocate(piece(i_1:i_n)) piece(:) = centers(:,j_mid-(j_1-1)) @@ -1101,7 +1101,7 @@ function get_fake_latitudes(this, unusable, rc) result(latitudes) j_mid = 1 + this%im_world/2 - tile = 1 + pet/(npes/this%nTiles) + tile = 1 + (j_1-1)/this%im_world if (tile == 1 .and. (i_1 <= j_mid) .and. (j_mid <= i_n)) then allocate(piece(j_1:j_n)) piece(:) = centers(j_mid-(i_1-1),:) @@ -1146,8 +1146,8 @@ subroutine generate_file_bounds(this,grid,local_start,global_start,global_count, call MAPL_GridGet(grid,globalCellCountPerDim=global_dim,rc=status) _VERIFY(status) call MAPL_GridGetInterior(grid,i1,in,j1,jn) - tile=j1/global_dim(1) - allocate(local_start,source=[i1,j1-tile*global_dim(1),tile+1]) + tile = 1 + (j1-1)/global_dim(1) + allocate(local_start,source=[i1,j1-(tile-1)*global_dim(1),tile]) allocate(global_start,source=[1,1,1]) allocate(global_count,source=[global_dim(1),global_dim(1),6]) From c4bff351947c5da821e6b8766ef93fbb7df9c56b Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Fri, 10 Jan 2020 11:35:17 -0500 Subject: [PATCH 012/109] When making the logic to handle cube/latlon general and not in this layer I forgot that in the stage2d lat/lon routine, sometimes, like on a lat/lon grid you may not have 2D lons and lons to write in the first place. THe original routine had a cube test, the refactoring got rid of that but I should still check that there are lons and lats to stage --- MAPL_Base/MAPL_newCFIO.F90 | 54 ++++++++++++++++++++++---------------- 1 file changed, 31 insertions(+), 23 deletions(-) diff --git a/MAPL_Base/MAPL_newCFIO.F90 b/MAPL_Base/MAPL_newCFIO.F90 index 821bf8b92f27..49625e93387e 100644 --- a/MAPL_Base/MAPL_newCFIO.F90 +++ b/MAPL_Base/MAPL_newCFIO.F90 @@ -606,30 +606,38 @@ subroutine stage2DLatLon(this, fileName, oClients, rc) type(ArrayReference) :: ref class (AbstractGridFactory), pointer :: factory integer, allocatable :: localStart(:),globalStart(:),globalCount(:) + logical :: hasll + class(Variable), pointer :: var_lat,var_lon + + var_lon => this%metadata%get_variable('lons') + var_lat => this%metadata%get_variable('lats') + + hasll = associated(var_lon) .and. associated(var_lat) + if (hasll) then + factory => get_factory(this%output_grid,rc=status) + _VERIFY(status) - factory => get_factory(this%output_grid,rc=status) - _VERIFY(status) - - call factory%generate_file_bounds(this%output_grid,LocalStart,GlobalStart,GlobalCount,rc=status) - _VERIFY(status) - call ESMF_GridGetCoord(this%output_grid, localDE=0, coordDim=1, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=ptr2d, rc=status) - _VERIFY(STATUS) - if (.not.allocated(this%lons)) allocate(this%lons(size(ptr2d,1),size(ptr2d,2))) - this%lons=ptr2d*MAPL_RADIANS_TO_DEGREES - ref = ArrayReference(this%lons) - call oClients%collective_stage_data(this%write_collection_id,trim(filename),'lons', & - ref,start=localStart, global_start=GlobalStart, global_count=GlobalCount) - call ESMF_GridGetCoord(this%output_grid, localDE=0, coordDim=2, & - staggerloc=ESMF_STAGGERLOC_CENTER, & - farrayPtr=ptr2d, rc=status) - _VERIFY(STATUS) - if (.not.allocated(this%lats)) allocate(this%lats(size(ptr2d,1),size(ptr2d,2))) - this%lats=ptr2d*MAPL_RADIANS_TO_DEGREES - ref = ArrayReference(this%lats) - call oClients%collective_stage_data(this%write_collection_id,trim(filename),'lats', & - ref,start=localStart, global_start=GlobalStart, global_count=GlobalCount) + call factory%generate_file_bounds(this%output_grid,LocalStart,GlobalStart,GlobalCount,rc=status) + _VERIFY(status) + call ESMF_GridGetCoord(this%output_grid, localDE=0, coordDim=1, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=ptr2d, rc=status) + _VERIFY(STATUS) + if (.not.allocated(this%lons)) allocate(this%lons(size(ptr2d,1),size(ptr2d,2))) + this%lons=ptr2d*MAPL_RADIANS_TO_DEGREES + ref = ArrayReference(this%lons) + call oClients%collective_stage_data(this%write_collection_id,trim(filename),'lons', & + ref,start=localStart, global_start=GlobalStart, global_count=GlobalCount) + call ESMF_GridGetCoord(this%output_grid, localDE=0, coordDim=2, & + staggerloc=ESMF_STAGGERLOC_CENTER, & + farrayPtr=ptr2d, rc=status) + _VERIFY(STATUS) + if (.not.allocated(this%lats)) allocate(this%lats(size(ptr2d,1),size(ptr2d,2))) + this%lats=ptr2d*MAPL_RADIANS_TO_DEGREES + ref = ArrayReference(this%lats) + call oClients%collective_stage_data(this%write_collection_id,trim(filename),'lats', & + ref,start=localStart, global_start=GlobalStart, global_count=GlobalCount) + end if end subroutine stage2DLatLon From c38000af99b77cb50b8550ede84c438865e8db0d Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 21 Jan 2020 11:24:25 -0500 Subject: [PATCH 013/109] Fixes #205. Adds mepo support This commit adds support for `mepo`. At present, `mepo` is "automatically" used only if `-DUSE_MEPO=ON` is passed in. For now we default to `checkout_externals`. Also, add some logic so that we don't try to clone `@cmake` *again* if it already exists. That causes some ugly error output. Finally, add some directories to `.gitignore` as well as add ESMA_env to the `Externals.cfg`. This is *not* needed to build MAPL, but it is sort of "expected" when building at NCCS/NAS. It's just some extra noise for our Harvard friends though. Sorry. --- .gitignore | 7 ++++++- CMakeLists.txt | 45 +++++++++++++++++++++++++++++++++++---------- Externals.cfg | 7 +++++++ components.yaml | 16 ++++++++++++++++ 4 files changed, 64 insertions(+), 11 deletions(-) create mode 100644 components.yaml diff --git a/.gitignore b/.gitignore index 27391e5e9f7d..d597fe80d418 100644 --- a/.gitignore +++ b/.gitignore @@ -1,2 +1,7 @@ *~ -/@cmake +/@cmake/ +/@env/ +/BUILD/ +/build*/ +/install*/ +/.mepo/ diff --git a/CMakeLists.txt b/CMakeLists.txt index 3399ad104eec..69474a8397ff 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -7,19 +7,44 @@ project ( VERSION 2.0 LANGUAGES Fortran CXX C) # Note - CXX is required for ESMF -if (NOT COMMAND esma) # build as standalone project - # Invoke checkout_ externals, but only the first time we - # configure. - if (NOT SKIP_MANAGE_EXTERNALS) - execute_process ( - COMMAND "checkout_externals" - WORKING_DIRECTORY ${CMAKE_SOURCE_DIR} - ) - endif () - option (SKIP_MANAGE_EXTERNALS "Set to skip manage externals step" ON) +option(USE_MEPO "Set to use mepo to get external dependencies" OFF) +if (EXISTS ${CMAKE_CURRENT_LIST_DIR}/@cmake) list (APPEND CMAKE_MODULE_PATH "${CMAKE_CURRENT_LIST_DIR}/@cmake") include (esma) +else () + if (NOT COMMAND esma) # build as standalone project + + if (USE_MEPO) + if (NOT SKIP_MEPO) + set (MEPO_INIT_COMMAND mepo init) + execute_process ( + COMMAND ${MEPO_INIT_COMMAND} + WORKING_DIRECTORY ${CMAKE_SOURCE_DIR} + ) + + set (MEPO_CLONE_COMMAND mepo clone) + execute_process ( + COMMAND ${MEPO_CLONE_COMMAND} + WORKING_DIRECTORY ${CMAKE_SOURCE_DIR} + ) + endif() + option (SKIP_MEPO "Set to skip mepo steps" ON) + else() + # Invoke checkout_externals, but only the first time we + # configure. + if (NOT SKIP_MANAGE_EXTERNALS) + execute_process ( + COMMAND "checkout_externals" + WORKING_DIRECTORY ${CMAKE_SOURCE_DIR} + ) + endif () + option (SKIP_MANAGE_EXTERNALS "Set to skip manage externals step" ON) + endif() + + list (APPEND CMAKE_MODULE_PATH "${CMAKE_CURRENT_LIST_DIR}/@cmake") + include (esma) + endif() endif() ecbuild_declare_project() diff --git a/Externals.cfg b/Externals.cfg index 74cb29a7be6b..af60003c0264 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -1,3 +1,10 @@ +[ESMA_env] +required = True +repo_url = git@github.com:GEOS-ESM/ESMA_env.git +local_path = ./@env +branch = dev/MAPL-2.0 +protocol = git + [GEOS_cmake] required = True repo_url = git@github.com:GEOS-ESM/ESMA_cmake.git diff --git a/components.yaml b/components.yaml new file mode 100644 index 000000000000..471b321b83fe --- /dev/null +++ b/components.yaml @@ -0,0 +1,16 @@ +ESMA_env: + local: ./@env + remote: git@github.com:GEOS-ESM/ESMA_env.git + branch: dev/MAPL-2.0 + develop: master + +ESMA_cmake: + local: ./@cmake + remote: git@github.com:GEOS-ESM/ESMA_cmake.git + tag: v2.1.1 + develop: develop + +ecbuild: + local: ./@cmake/@ecbuild + remote: git@github.com:GEOS-ESM/ecbuild.git + tag: geos/v1.0.0 From b6a25ba37befd6f8b5fea3a98bef40227bef8b17 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 21 Jan 2020 13:02:44 -0500 Subject: [PATCH 014/109] Use mepo by default --- CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 69474a8397ff..61ea04e86f50 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -7,7 +7,7 @@ project ( VERSION 2.0 LANGUAGES Fortran CXX C) # Note - CXX is required for ESMF -option(USE_MEPO "Set to use mepo to get external dependencies" OFF) +option(USE_MEPO "Set to use mepo to get external dependencies" ON) if (EXISTS ${CMAKE_CURRENT_LIST_DIR}/@cmake) list (APPEND CMAKE_MODULE_PATH "${CMAKE_CURRENT_LIST_DIR}/@cmake") From 49c053febca02d67f2f8a7337907171d9d6e7550 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 21 Jan 2020 10:45:28 -0500 Subject: [PATCH 015/109] Fixes #141. Reduce compiler warning messages Most of these fixes are adding `_UNUSED_DUMMY()` lines or just plain deleting variables that were never used. The one exciting one was in MAPL_TripolarGridFactory where `name` was never set so Intel throws: ``` /discover/swdev/mathomp4/Models/MAPL-MAPL20-Cleanup/MAPL/MAPL_Base/MAPL_TripolarGridFactory.F90(507): warning #6178: The return value of this FUNCTION has not been defined. [NAME] function generate_grid_name(this) result(name) --------------------------------------------^ ``` So we set name to a blank string and then the `error stop` will take care of everything still. Finally, update to ESMA_cmake v2.1.2 to suppress long names warnings: ``` /discover/swdev/mathomp4/Models/GEOSgcm-MAPL20-MAPLCleanup/GEOSgcm/src/Shared/@MAPL/MAPL_Base/MAPL_TilingRegridder.F90: warning #5462: Global name too long, shortened from: mapl_tilingregriddermod_mp_copy_global_to_local_$blk.pfio_errorhandlingmod_mp_mpi_statuses_ignore_ to: pl_tilingregriddermod_mp_copy_global_to_local_$blk.pfio_errorhandlingmod_mp_mpi_statuses_ignore_ ^ ``` This adds a new `DISABLE_GLOBAL_NAME_WARNING` flag to suppress this output --- Externals.cfg | 2 +- GMAO_pFIO/AbstractServer.F90 | 2 +- GMAO_pFIO/ClientManager.F90 | 4 +- GMAO_pFIO/ClientThread.F90 | 3 -- GMAO_pFIO/DirectoryService.F90 | 1 - GMAO_pFIO/ServerThread.F90 | 48 ++++----------------- GMAO_pFIO/pfio_collective_demo.F90 | 3 +- GMAO_pFIO/pfio_server_demo.F90 | 6 +-- GMAO_pFIO/tests/MockClient.F90 | 3 ++ GMAO_pFIO/tests/Test_UnlimitedEntity.pf | 1 - GMAO_pFIO/tests/Test_pFIO_Utilities.pf | 2 +- GMAO_pFIO/tests/pfio_ctest_io.F90 | 5 +-- MAPL_Base/CMakeLists.txt | 3 ++ MAPL_Base/FileMetadataUtilities.F90 | 1 + MAPL_Base/MAPL_AbstractGridFactory.F90 | 22 ++++++++++ MAPL_Base/MAPL_AbstractRegridder.F90 | 7 ++++ MAPL_Base/MAPL_CFIO.F90 | 8 +--- MAPL_Base/MAPL_CapOptions.F90 | 1 - MAPL_Base/MAPL_CubedSphereGridFactory.F90 | 23 +++++++++- MAPL_Base/MAPL_DirPath.F90 | 6 +++ MAPL_Base/MAPL_EsmfRegridder.F90 | 2 + MAPL_Base/MAPL_ExtDataGridCompMod.F90 | 4 ++ MAPL_Base/MAPL_HistoryGridComp.F90 | 2 +- MAPL_Base/MAPL_IO.F90 | 14 +++---- MAPL_Base/MAPL_IdentityRegridder.F90 | 2 + MAPL_Base/MAPL_LatLonGridFactory.F90 | 20 +++++++++ MAPL_Base/MAPL_LatLonToLatLonRegridder.F90 | 11 +++-- MAPL_Base/MAPL_NUOPCWrapperMod.F90 | 6 ++- MAPL_Base/MAPL_NewArthParser.F90 | 1 - MAPL_Base/MAPL_RegridderSpec.F90 | 3 +- MAPL_Base/MAPL_SimpleBundleMod.F90 | 14 +++---- MAPL_Base/MAPL_TimeMethods.F90 | 12 ++++-- MAPL_Base/MAPL_TransposeRegridder.F90 | 22 ++++++++++ MAPL_Base/MAPL_TripolarGridFactory.F90 | 17 ++++++-- MAPL_Base/MAPL_VerticalMethods.F90 | 2 - MAPL_Base/MAPL_ioClients.F90 | 1 + MAPL_Base/MAPL_newCFIO.F90 | 2 - MAPL_Base/MAPL_sun_uc.F90 | 18 ++------ MAPL_Base/Regrid_Functions_Mod.F90 | 27 +++++++----- MAPL_Base/Regrid_Util.F90 | 4 +- MAPL_Base/read_parallel.H | 2 +- MAPL_Base/tests/MockGridFactory.F90 | 49 +++++++++++++++++++++- MAPL_Base/write_parallel.H | 1 - MAPL_cfio/ESMF_CFIOGridMod.F90 | 2 +- MAPL_cfio/ESMF_CFIOSdfMod.F90 | 7 +--- MAPL_cfio/ESMF_CFIOUtilMod.F90 | 31 +++++++------- MAPL_pFUnit/ESMF_TestParameter.F90 | 3 ++ MAPL_pFUnit/unused_dummy.H | 13 ++++++ Tests/ExtDataDriverGridComp.F90 | 17 -------- Tests/ExtDataDriverMod.F90 | 4 +- Tests/ExtDataRoot_GridComp.F90 | 10 ++--- components.yaml | 2 +- 52 files changed, 297 insertions(+), 179 deletions(-) create mode 100644 MAPL_pFUnit/unused_dummy.H diff --git a/Externals.cfg b/Externals.cfg index af60003c0264..5366d484a61f 100644 --- a/Externals.cfg +++ b/Externals.cfg @@ -9,7 +9,7 @@ protocol = git required = True repo_url = git@github.com:GEOS-ESM/ESMA_cmake.git local_path = ./@cmake -tag = v2.1.1 +tag = v2.1.2 externals = Externals.cfg protocol = git diff --git a/GMAO_pFIO/AbstractServer.F90 b/GMAO_pFIO/AbstractServer.F90 index 8b351497cc17..9eacdfa98ca2 100644 --- a/GMAO_pFIO/AbstractServer.F90 +++ b/GMAO_pFIO/AbstractServer.F90 @@ -109,7 +109,6 @@ subroutine init(this,comm) integer, intent(in) :: comm integer :: ierror, MyColor - integer :: i call MPI_Comm_dup(comm, this%comm, ierror) call MPI_Comm_rank(this%comm, this%rank, ierror) @@ -289,6 +288,7 @@ subroutine get_DataFromMem(this,multi, rc) logical, intent(in) :: multi integer, optional, intent(out) :: rc _ASSERT(.false.," no action of server_get_DataFromMem") + _UNUSED_DUMMY(multi) end subroutine get_DataFromMem function am_I_reading_PE(this,id) result (yes) diff --git a/GMAO_pFIO/ClientManager.F90 b/GMAO_pFIO/ClientManager.F90 index 8f029f3b0402..ac5657a7f2e4 100644 --- a/GMAO_pFIO/ClientManager.F90 +++ b/GMAO_pFIO/ClientManager.F90 @@ -96,7 +96,7 @@ function add_hist_collection(this, fmd, unusable, rc) result(hist_collection_id) class (KeywordEnforcer), optional, intent(out) :: unusable integer, optional, intent(out) :: rc type (ClientThread), pointer :: clientPtr - integer :: i, i1,i2 + integer :: i do i = 1, this%size() ClientPtr => this%clients%at(i) @@ -138,7 +138,7 @@ subroutine prefetch_data(this, collection_id, file_name, var_name, data_referenc integer, optional, intent(out) :: rc type (ClientThread), pointer :: clientPtr - integer :: request_id, ith, status + integer :: request_id, status clientPtr =>this%current() request_id = clientPtr%prefetch_data(collection_id, file_name, var_name, data_reference, start=start, rc=status) diff --git a/GMAO_pFIO/ClientThread.F90 b/GMAO_pFIO/ClientThread.F90 index e85981651b87..5cf25ec4e5a7 100644 --- a/GMAO_pFIO/ClientThread.F90 +++ b/GMAO_pFIO/ClientThread.F90 @@ -444,9 +444,6 @@ end subroutine wait subroutine wait_all(this) use pFIO_AbstractRequestHandleMod class (ClientThread), target, intent(inout) :: this - integer :: request_id - type (IntegerRequestMapIterator) :: iter - integer :: status call this%clear_RequestHandle() !call this%shake_hand() diff --git a/GMAO_pFIO/DirectoryService.F90 b/GMAO_pFIO/DirectoryService.F90 index d034f7e50da9..2835653f2a9c 100644 --- a/GMAO_pFIO/DirectoryService.F90 +++ b/GMAO_pFIO/DirectoryService.F90 @@ -450,7 +450,6 @@ function sizeof_directory() result(sz) integer :: sz integer :: sizeof_char, sizeof_integer, sizeof_DirectoryEntry - integer :: ierror integer :: one_integer character :: one_char diff --git a/GMAO_pFIO/ServerThread.F90 b/GMAO_pFIO/ServerThread.F90 index 8cae25726758..f7ad6e7d8187 100644 --- a/GMAO_pFIO/ServerThread.F90 +++ b/GMAO_pFIO/ServerThread.F90 @@ -160,9 +160,7 @@ subroutine run(this, rc) integer, optional, intent(out) :: rc class (AbstractMessage), pointer :: message - type(DoneMessage) :: dMessage class(AbstractSocket),pointer :: connection - logical :: all_backlog_is_empty integer :: status connection=>this%get_connection() @@ -770,7 +768,8 @@ subroutine handle_HandShake(this, message, rc) class(AbstractSocket),pointer :: connection type (DummyMessage) :: handshake_msg - integer :: status + + _UNUSED_DUMMY(message) connection=>this%get_connection() call connection%send(handshake_msg) @@ -1119,19 +1118,10 @@ recursive subroutine handle_Done_collective_stage(this, message, rc) type (CollectiveStageDoneMessage), intent(in) :: message integer, optional, intent(out) :: rc - type (LocalMemReference) :: mem_data_reference - class(AbstractDataReference),pointer :: dataRefPtr - class(AbstractMessage),pointer :: dMessage - integer :: data_status, node_rank, innode_rank - integer(kind=INT64) :: g_offset, offset,msize_word - type(c_ptr) :: offset_address - integer,pointer :: i_ptr(:) - type (MessageVectorIterator) :: iter - class (AbstractMessage), pointer :: msg - class(AbstractSocket),pointer :: connection - class (AbstractRequestHandle), pointer :: handle integer :: status + _UNUSED_DUMMY(message) + this%containing_server%serverthread_done_msgs(this%thread_rank) = .true. if ( .not. all(this%containing_server%serverthread_done_msgs)) then _RETURN(_SUCCESS) @@ -1158,19 +1148,14 @@ recursive subroutine handle_Done_stage(this, message, rc) type (StageDoneMessage), intent(in) :: message integer, optional, intent(out) :: rc - type (LocalMemReference) :: mem_data_reference - class(AbstractDataReference),pointer :: dataRefPtr - class(AbstractMessage),pointer :: dMessage - integer :: data_status, node_rank, innode_rank - integer(kind=INT64) :: g_offset, offset,msize_word - type(c_ptr) :: offset_address - integer,pointer :: i_ptr(:) type (MessageVectorIterator) :: iter class (AbstractMessage), pointer :: msg class(AbstractSocket),pointer :: connection class (AbstractRequestHandle), pointer :: handle integer :: status + _UNUSED_DUMMY(message) + if ( this%request_backlog%empty()) then _RETURN(_SUCCESS) endif @@ -1209,16 +1194,9 @@ recursive subroutine handle_Done_prefetch(this, message, rc) integer, optional, intent(out) :: rc type (LocalMemReference) :: mem_data_reference - class(AbstractDataReference),pointer :: dataRefPtr - class(AbstractMessage),pointer :: dMessage - integer :: data_status, node_rank, innode_rank - integer(kind=INT64) :: g_offset, offset,msize_word - type(c_ptr) :: offset_address - integer,pointer :: i_ptr(:) type (MessageVectorIterator) :: iter class (AbstractMessage), pointer :: msg class(AbstractSocket),pointer :: connection - class (AbstractRequestHandle), pointer :: handle integer :: status iter = this%request_backlog%begin() @@ -1255,17 +1233,7 @@ recursive subroutine handle_Done_collective_prefetch(this, message, rc) type (CollectivePrefetchDoneMessage), intent(in) :: message integer, optional, intent(out) :: rc - type (LocalMemReference) :: mem_data_reference class(AbstractDataReference),pointer :: dataRefPtr - class(AbstractMessage),pointer :: dMessage - integer :: data_status, node_rank, innode_rank - integer(kind=INT64) :: g_offset, offset,msize_word - type(c_ptr) :: offset_address - integer,pointer :: i_ptr(:) - type (MessageVectorIterator) :: iter - class (AbstractMessage), pointer :: msg - class(AbstractSocket),pointer :: connection - class (AbstractRequestHandle), pointer :: handle integer :: status ! first time handling the "Done" message, simple return @@ -1299,15 +1267,13 @@ subroutine get_DataFromMem( this, multi_data_read, rc) integer, optional, intent(out) :: rc type (LocalMemReference) :: mem_data_reference class(AbstractDataReference),pointer :: dataRefPtr - class(AbstractMessage),pointer :: dMessage - integer :: data_status, node_rank, innode_rank + integer :: node_rank, innode_rank integer(kind=INT64) :: g_offset, offset,msize_word type(c_ptr) :: offset_address integer,pointer :: i_ptr(:) type (MessageVectorIterator) :: iter class (AbstractMessage), pointer :: msg class(AbstractSocket),pointer :: connection - class (AbstractRequestHandle), pointer :: handle integer :: status connection=>this%get_connection(status) diff --git a/GMAO_pFIO/pfio_collective_demo.F90 b/GMAO_pFIO/pfio_collective_demo.F90 index 70d90d7fdead..5969fe7712c3 100644 --- a/GMAO_pFIO/pfio_collective_demo.F90 +++ b/GMAO_pFIO/pfio_collective_demo.F90 @@ -307,7 +307,6 @@ program main integer :: rank, npes, ierror, provided,required integer :: status, color, key - class(AbstractServer),allocatable,target :: s class(AbstractServer),pointer :: server class(AbstractDirectoryService), pointer :: d_s => null() @@ -368,6 +367,8 @@ function get_directory_service(stype) result(d_s) allocate(d_s, source=DirectoryService(MPI_COMM_WORLD)) + _UNUSED_DUMMY(stype) + end function function split_color(stype,split_rank) result(color) diff --git a/GMAO_pFIO/pfio_server_demo.F90 b/GMAO_pFIO/pfio_server_demo.F90 index e9e5c4525b01..926f4801c2ff 100644 --- a/GMAO_pFIO/pfio_server_demo.F90 +++ b/GMAO_pFIO/pfio_server_demo.F90 @@ -201,10 +201,11 @@ subroutine run(this, step) type (ArrayReference) :: ref - integer :: i_var,i + integer :: i_var + !integer :: i integer :: lat0, lat1, nlats integer :: collection_id - character(len=4) :: tmp + !character(len=4) :: tmp lat0 = 1 + (this%rank*this%nlat)/this%npes lat1 = (this%rank+1)*this%nlat/this%npes @@ -258,7 +259,6 @@ end subroutine run subroutine finalize(this) class (FakeExtData), intent(inout) :: this - integer :: ierror deallocate(this%bundle) call this%c%terminate() end subroutine finalize diff --git a/GMAO_pFIO/tests/MockClient.F90 b/GMAO_pFIO/tests/MockClient.F90 index 494d342176eb..a5820aadff00 100644 --- a/GMAO_pFIO/tests/MockClient.F90 +++ b/GMAO_pFIO/tests/MockClient.F90 @@ -1,3 +1,5 @@ +#include "unused_dummy.H" + module MockClientMod use pFIO_ClientThreadMod implicit none @@ -16,6 +18,7 @@ module MockClientMod function new_MockClient() result(c) type (MockClient) :: c + _UNUSED_DUMMY(c) end function new_MockClient diff --git a/GMAO_pFIO/tests/Test_UnlimitedEntity.pf b/GMAO_pFIO/tests/Test_UnlimitedEntity.pf index e1e4a52145db..567321c89df4 100644 --- a/GMAO_pFIO/tests/Test_UnlimitedEntity.pf +++ b/GMAO_pFIO/tests/Test_UnlimitedEntity.pf @@ -62,7 +62,6 @@ contains @test subroutine test_is_empty() type (UnlimitedEntity) :: a - character(len=:), allocatable:: str logical :: is ! not initialized diff --git a/GMAO_pFIO/tests/Test_pFIO_Utilities.pf b/GMAO_pFIO/tests/Test_pFIO_Utilities.pf index 80d3bd4bb3b7..be5a18108b11 100644 --- a/GMAO_pFIO/tests/Test_pFIO_Utilities.pf +++ b/GMAO_pFIO/tests/Test_pFIO_Utilities.pf @@ -117,7 +117,7 @@ contains @test subroutine test_serialize_string() - character(len=:), allocatable :: str + !character(len=:), allocatable :: str !call check(str); if (anyExceptions()) return call check(''); if (anyExceptions()) return diff --git a/GMAO_pFIO/tests/pfio_ctest_io.F90 b/GMAO_pFIO/tests/pfio_ctest_io.F90 index 6ed049172c11..ced27961c600 100644 --- a/GMAO_pFIO/tests/pfio_ctest_io.F90 +++ b/GMAO_pFIO/tests/pfio_ctest_io.F90 @@ -470,13 +470,12 @@ program main integer, parameter :: CLIENT_COLOR = 2 integer, parameter :: BOTH_COLOR = 3 - integer :: comm,num_threads type (FakeHistData0), target :: HistData integer :: my_comm_world, my_iComm, my_oComm, my_appcomm - integer :: client_start, size_group,low_rank,up_rank - integer :: local_rank, local_size, i,k, size_iclient, size_oclient + integer :: client_start, low_rank,up_rank + integer :: i,k, size_iclient, size_oclient integer :: app_start_rank, app_end_rank character(len = 20) :: out_file character(len = 100):: cmd diff --git a/MAPL_Base/CMakeLists.txt b/MAPL_Base/CMakeLists.txt index 15e162f0ab71..6836867afb3a 100644 --- a/MAPL_Base/CMakeLists.txt +++ b/MAPL_Base/CMakeLists.txt @@ -65,6 +65,9 @@ set (srcs esma_add_library(${this} SRCS ${srcs} DEPENDENCIES GMAO_pFIO MAPL_cfio_r4 gftl-shared FLAP::FLAP) target_compile_options (${this} PRIVATE $<$:${OpenMP_Fortran_FLAGS}>) +if(DISABLE_GLOBAL_NAME_WARNING) + set_target_properties (${this} PROPERTIES COMPILE_FLAGS ${DISABLE_GLOBAL_NAME_WARNING}) +endif() target_compile_definitions (${this} PRIVATE TWO_SIDED_COMM MAPL_MODE) # Kludge for OSX security and DYLD_LIBRARY_PATH ... diff --git a/MAPL_Base/FileMetadataUtilities.F90 b/MAPL_Base/FileMetadataUtilities.F90 index 6f30dee93f44..fcda36a44d7b 100644 --- a/MAPL_Base/FileMetadataUtilities.F90 +++ b/MAPL_Base/FileMetadataUtilities.F90 @@ -228,6 +228,7 @@ function is_var_present(this,var_name,rc) result(isPresent) logical :: isPresent class(Variable), pointer :: var + _UNUSED_DUMMY(rc) var => this%get_variable(var_name) isPresent = associated(var) diff --git a/MAPL_Base/MAPL_AbstractGridFactory.F90 b/MAPL_Base/MAPL_AbstractGridFactory.F90 index c9a649c1f58d..145d28f211df 100644 --- a/MAPL_Base/MAPL_AbstractGridFactory.F90 +++ b/MAPL_Base/MAPL_AbstractGridFactory.F90 @@ -365,6 +365,8 @@ subroutine spherical_to_cartesian_2d_real32(this,u,v,xyz,basis,unusable,rc) character(len=*), parameter :: Iam= MOD_NAME // 'spherical_to_cartesian_2d' integer :: status + _UNUSED_DUMMY(unusable) + im = size(u,1) jm = size(u,2) _ASSERT(im == size(v,1), 'u-v shape mismatch for IM') @@ -407,6 +409,8 @@ subroutine spherical_to_cartesian_2d_real64(this,u,v,xyz,basis,unusable,rc) character(len=*), parameter :: Iam= MOD_NAME // 'spherical_to_cartesian_2d' integer :: status + _UNUSED_DUMMY(unusable) + im = size(u,1) jm = size(u,2) _ASSERT(im == size(v,1), 'u-v shape mismatch for IM') @@ -449,6 +453,8 @@ subroutine spherical_to_cartesian_3d_real32(this,u,v,xyz,basis,unusable,rc) character(len=*), parameter :: Iam= MOD_NAME // 'spherical_to_cartesian_3d' integer :: status + _UNUSED_DUMMY(unusable) + im = size(u,1) jm = size(u,2) km = size(u,3) @@ -495,6 +501,8 @@ subroutine spherical_to_cartesian_3d_real64(this,u,v,xyz,basis,unusable,rc) character(len=*), parameter :: Iam= MOD_NAME // 'spherical_to_cartesian_3d' integer :: status + _UNUSED_DUMMY(unusable) + im = size(u,1) jm = size(u,2) km = size(u,3) @@ -541,6 +549,8 @@ subroutine cartesian_to_spherical_2d_real32(this,xyz,u,v,basis,unusable,rc) character(len=*), parameter :: Iam= MOD_NAME // 'cartesian_to_spherical_2d' integer :: status + _UNUSED_DUMMY(unusable) + im = size(u,1) jm = size(u,2) _ASSERT(im == size(v,1), 'u-v shape mismatch for IM') @@ -587,6 +597,8 @@ subroutine cartesian_to_spherical_2d_real64(this,xyz,u,v,basis,unusable,rc) character(len=*), parameter :: Iam= MOD_NAME // 'cartesian_to_spherical_2d' integer :: status + _UNUSED_DUMMY(unusable) + im = size(u,1) jm = size(u,2) _ASSERT(im == size(v,1), 'u-v shape mismatch for IM') @@ -633,6 +645,8 @@ subroutine cartesian_to_spherical_3d_real32(this,xyz,u,v,basis,unusable,rc) character(len=*), parameter :: Iam= MOD_NAME // 'cartesian_to_spherical_3d' integer :: status + _UNUSED_DUMMY(unusable) + im = size(u,1) jm = size(u,2) km = size(u,3) @@ -681,6 +695,8 @@ subroutine cartesian_to_spherical_3d_real64(this,xyz,u,v,basis,unusable,rc) character(len=*), parameter :: Iam= MOD_NAME // 'cartesian_to_spherical_3d' integer :: status + _UNUSED_DUMMY(unusable) + im = size(u,1) jm = size(u,2) km = size(u,3) @@ -727,6 +743,8 @@ function get_basis(this,basis,unusable,rc) result(basis_vectors) real(REAL64), pointer :: Xcoord(:,:) => null() real(REAL64), pointer :: Ycoord(:,:) => null() + _UNUSED_DUMMY(unusable) + _ASSERT(allocated(this%grid), 'grid not allocated') select case (basis) case ('north-south') @@ -802,6 +820,8 @@ function ComputeGridBasis(grid,unusable,rc) result(basis) real(REAL64) :: p1(2),p2(2),p3(2),p4(2),c1(2) integer :: i, j, im, jm, counts(3) + _UNUSED_DUMMY(unusable) + call MAPL_GridGet(grid,localCellCountPerDim=counts,rc=status) _VERIFY(status) im=counts(1) @@ -853,6 +873,8 @@ function ComputeXYZBasis(grid_basis,unusable,rc) result(basis) integer :: im, jm, i, j real(real64) :: dp,fac + _UNUSED_DUMMY(unusable) + im = size(grid_basis,3) jm = size(grid_basis,4) allocate(basis(3,2,im,jm),stat=status) diff --git a/MAPL_Base/MAPL_AbstractRegridder.F90 b/MAPL_Base/MAPL_AbstractRegridder.F90 index 8b9355eb0d86..081a1167ebb0 100644 --- a/MAPL_Base/MAPL_AbstractRegridder.F90 +++ b/MAPL_Base/MAPL_AbstractRegridder.F90 @@ -196,6 +196,7 @@ subroutine regrid_vector_2d_real32(this, u_in, v_in, u_out, v_out, rotate, rc) _UNUSED_DUMMY(this) _UNUSED_DUMMY(u_in) _UNUSED_DUMMY(v_in) + _UNUSED_DUMMY(rotate) u_out = 0 v_out = 0 _RETURN(_FAILURE) @@ -217,6 +218,7 @@ subroutine regrid_vector_2d_real64(this, u_in, v_in, u_out, v_out, rotate, rc) _UNUSED_DUMMY(this) _UNUSED_DUMMY(u_in) _UNUSED_DUMMY(v_in) + _UNUSED_DUMMY(rotate) u_out = 0 v_out = 0 _RETURN(_FAILURE) @@ -237,6 +239,7 @@ subroutine regrid_vector_3d_real32(this, u_in, v_in, u_out, v_out, rotate, rc) _UNUSED_DUMMY(this) _UNUSED_DUMMY(u_in) _UNUSED_DUMMY(v_in) + _UNUSED_DUMMY(rotate) u_out = 0 v_out = 0 _RETURN(_FAILURE) @@ -583,6 +586,7 @@ subroutine transpose_regrid_vector_2d_real32(this, u_in, v_in, u_out, v_out, rot _UNUSED_DUMMY(v_in) _UNUSED_DUMMY(u_out) _UNUSED_DUMMY(v_out) + _UNUSED_DUMMY(rotate) u_out = 0 v_out = 0 _RETURN(_FAILURE) @@ -607,6 +611,7 @@ subroutine transpose_regrid_vector_2d_real64(this, u_in, v_in, u_out, v_out, rot _UNUSED_DUMMY(v_in) _UNUSED_DUMMY(u_out) _UNUSED_DUMMY(v_out) + _UNUSED_DUMMY(rotate) u_out = 0 v_out = 0 _RETURN(_FAILURE) @@ -631,6 +636,7 @@ subroutine transpose_regrid_vector_3d_real32(this, u_in, v_in, u_out, v_out, rot _UNUSED_DUMMY(v_in) _UNUSED_DUMMY(u_out) _UNUSED_DUMMY(v_out) + _UNUSED_DUMMY(rotate) u_out = 0 v_out = 0 _RETURN(_FAILURE) @@ -943,6 +949,7 @@ end function get_spec function isTranspose(this) result(amTranspose) logical :: amTranspose class (AbstractRegridder), intent(in) :: this + _UNUSED_DUMMY(this) amTranspose = .false. end function isTranspose diff --git a/MAPL_Base/MAPL_CFIO.F90 b/MAPL_Base/MAPL_CFIO.F90 index d1246be5f794..773ffa850202 100644 --- a/MAPL_Base/MAPL_CFIO.F90 +++ b/MAPL_Base/MAPL_CFIO.F90 @@ -6528,10 +6528,8 @@ subroutine GetTIndex(cfio,time,tindex,rc) integer :: tindex integer, optional, intent(out ) :: rc - __Iam__('GetTindex') - integer(ESMF_KIND_I4) :: iyr,imm,idd,ihr,imn,isc - integer :: i + integer :: i,status integer(ESMF_KIND_I8) :: iCurrInterval integer :: nhmsB, nymdB integer :: begDate, begTime @@ -6563,10 +6561,8 @@ subroutine MAPL_CFIOGetTimeFromIndex(mcfio,tindex,time,rc) integer, intent(in) :: tindex integer, optional, intent(out ) :: rc - __Iam__('MAPL_CFIOGetTimeFromIndex') - integer(ESMF_KIND_I4) :: iyr,imm,idd,ihr,imn,isc - integer :: i + integer :: i,status integer(ESMF_KIND_I8) :: iCurrInterval integer :: nhmsB, nymdB integer :: begDate, begTime diff --git a/MAPL_Base/MAPL_CapOptions.F90 b/MAPL_Base/MAPL_CapOptions.F90 index 0eb39dfe341d..ca3669353108 100644 --- a/MAPL_Base/MAPL_CapOptions.F90 +++ b/MAPL_Base/MAPL_CapOptions.F90 @@ -47,7 +47,6 @@ function new_CapOptions(unusable, cap_rc_file, egress_file, ensemble_subdir_pref character(*), optional, intent(in) :: ensemble_subdir_prefix integer, optional, intent(out) :: rc - integer :: status _UNUSED_DUMMY(unusable) diff --git a/MAPL_Base/MAPL_CubedSphereGridFactory.F90 b/MAPL_Base/MAPL_CubedSphereGridFactory.F90 index 37c6e50b0354..fb69ccba98ee 100644 --- a/MAPL_Base/MAPL_CubedSphereGridFactory.F90 +++ b/MAPL_Base/MAPL_CubedSphereGridFactory.F90 @@ -178,6 +178,8 @@ function make_new_grid(this, unusable, rc) result(grid) integer :: status character(len=*), parameter :: Iam = MOD_NAME // 'make_grid' + _UNUSED_DUMMY(unusable) + grid = this%create_basic_grid(rc=status) _VERIFY(status) @@ -200,6 +202,8 @@ function create_basic_grid(this, unusable, rc) result(grid) integer :: status character(len=*), parameter :: Iam = MOD_NAME // 'create_basic_grid' + _UNUSED_DUMMY(unusable) + if (this%grid_type <=3) then nTile=6 else @@ -579,6 +583,7 @@ subroutine check_and_fill_consistency(this, unusable, rc) integer :: status character(len=*), parameter :: Iam = MOD_NAME // 'check_and_fill_consistency' + _UNUSED_DUMMY(unusable) if (.not. allocated(this%grid_name)) then this%grid_name = GRID_NAME_DEFAULT @@ -760,9 +765,14 @@ subroutine initialize_from_esmf_distGrid(this, dist_grid, lon_array, lat_array, class (KeywordEnforcer), optional, intent(in) :: unusable integer, optional, intent(out) :: rc - integer :: status character(len=*), parameter :: Iam = MOD_NAME // 'CubedSphereGridFactory_initialize_from_esmf_distGrid' + _UNUSED_DUMMY(this) + _UNUSED_DUMMY(dist_grid) + _UNUSED_DUMMY(lon_array) + _UNUSED_DUMMY(lat_array) + _UNUSED_DUMMY(unusable) + ! not implemented _ASSERT(.false.) @@ -783,6 +793,8 @@ subroutine halo(this, array, unusable, halo_width, rc) real, pointer :: ptr(:,:) integer :: useableHalo_width + _UNUSED_DUMMY(unusable) + if (.not. this%halo_initialized) then call this%halo_init(halo_width = halo_width) this%halo_initialized = .true. @@ -973,6 +985,7 @@ function get_grid_vars(this) result(vars) class (CubedSphereGridFactory), intent(inout) :: this character(len=:), allocatable :: vars + _UNUSED_DUMMY(this) vars = 'Xdim,Ydim,nf' @@ -981,6 +994,7 @@ end function get_grid_vars subroutine append_variable_metadata(this,var) class (CubedSphereGridFactory), intent(inout) :: this type(Variable), intent(inout) :: var + _UNUSED_DUMMY(this) call var%add_attribute('coordinates','lons lats') call var%add_attribute('grid_mapping','cubed_sphere') @@ -1014,6 +1028,8 @@ function get_fake_longitudes(this, unusable, rc) result(longitudes) character(len=*), parameter :: Iam = MOD_NAME // 'get_fake_longitudes()' + _UNUSED_DUMMY(unusable) + grid = this%make_grid() call ESMF_GridGetCoord(grid, coordDim=1, localDE=0, & @@ -1083,6 +1099,8 @@ function get_fake_latitudes(this, unusable, rc) result(latitudes) integer :: status character(len=*), parameter :: Iam = MOD_NAME // 'get_fake_latitudes()' + + _UNUSED_DUMMY(unusable) grid = this%make_grid() @@ -1142,6 +1160,7 @@ subroutine generate_file_bounds(this,grid,local_start,global_start,global_count, integer :: status integer :: global_dim(3),i1,j1,in,jn,tile character(len=*), parameter :: Iam = MOD_NAME // 'generate_file_bounds' + _UNUSED_DUMMY(this) call MAPL_GridGet(grid,globalCellCountPerDim=global_dim,rc=status) _VERIFY(status) @@ -1160,6 +1179,7 @@ function generate_file_reference2D(this,fpointer) result(ref) type(ArrayReference) :: ref class(CubedSphereGridFactory), intent(inout) :: this real, pointer, intent(in) :: fpointer(:,:) + _UNUSED_DUMMY(this) ref = ArrayReference(fpointer) end function generate_file_reference2D @@ -1171,6 +1191,7 @@ function generate_file_reference3D(this,fpointer) result(ref) real, pointer, intent(in) :: fpointer(:,:,:) type(c_ptr) :: cptr real, pointer :: ptr_ref(:,:,:,:,:) + _UNUSED_DUMMY(this) cptr = c_loc(fpointer) call C_F_pointer(cptr,ptr_ref,[size(fpointer,1),size(fpointer,2),1,size(fpointer,3),1]) ref = ArrayReference(ptr_ref) diff --git a/MAPL_Base/MAPL_DirPath.F90 b/MAPL_Base/MAPL_DirPath.F90 index ce188d69ea4c..3d55a54bd281 100644 --- a/MAPL_Base/MAPL_DirPath.F90 +++ b/MAPL_Base/MAPL_DirPath.F90 @@ -1,3 +1,5 @@ +#include "unused_dummy.H" + module MAPL_DirPathMod use MAPL_KeywordEnforcerMod use pFIO @@ -34,6 +36,8 @@ function find(this, file, unusable, rc) result(full_name) character(len=:), pointer :: dir logical :: exist + _UNUSED_DUMMY(unusable) + iter = this%begin() do while (iter /= this%end()) dir => iter%get() @@ -63,6 +67,8 @@ subroutine append(this, directory, unusable, rc) class (KeywordEnforcer), optional, intent(in) :: unusable integer, optional, intent(out) :: rc + _UNUSED_DUMMY(unusable) + call this%push_back(directory) if (present(rc)) then diff --git a/MAPL_Base/MAPL_EsmfRegridder.F90 b/MAPL_Base/MAPL_EsmfRegridder.F90 index dea26314b5da..46a4c93c88d7 100644 --- a/MAPL_Base/MAPL_EsmfRegridder.F90 +++ b/MAPL_Base/MAPL_EsmfRegridder.F90 @@ -71,6 +71,8 @@ function new_EsmfRegridder() result(regridder) use MAPL_BaseMod type (EsmfRegridder) :: regridder + _UNUSED_DUMMY(regridder) + ! Nothing to do here end function new_EsmfRegridder diff --git a/MAPL_Base/MAPL_ExtDataGridCompMod.F90 b/MAPL_Base/MAPL_ExtDataGridCompMod.F90 index 7501ab8ec007..f73ffc365b4b 100644 --- a/MAPL_Base/MAPL_ExtDataGridCompMod.F90 +++ b/MAPL_Base/MAPL_ExtDataGridCompMod.F90 @@ -1306,6 +1306,10 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) type(IOBundleVector), target :: IOBundles type(IOBundleVectorIterator) :: bundle_iter type(ExtData_IOBundle), pointer :: io_bundle + + _UNUSED_DUMMY(IMPORT) + _UNUSED_DUMMY(EXPORT) + ! Declare pointers to IMPORT/EXPORT/INTERNAL states ! ------------------------------------------------- ! #include "MAPL_ExtData_DeclarePointer___.h" diff --git a/MAPL_Base/MAPL_HistoryGridComp.F90 b/MAPL_Base/MAPL_HistoryGridComp.F90 index 088c0e012bb3..514fc0b74d00 100644 --- a/MAPL_Base/MAPL_HistoryGridComp.F90 +++ b/MAPL_Base/MAPL_HistoryGridComp.F90 @@ -2676,7 +2676,7 @@ subroutine Run ( gc, import, export, clock, rc ) type(ESMF_State) :: state_out integer :: nymd, nhms character(len=ESMF_MAXSTR) :: DateStamp - integer :: nn, CollBlock, scount + integer :: CollBlock type(MAPL_Communicators) :: mapl_Comm ! variables for "backwards" mode diff --git a/MAPL_Base/MAPL_IO.F90 b/MAPL_Base/MAPL_IO.F90 index 0e3454896272..88c18a10dc39 100644 --- a/MAPL_Base/MAPL_IO.F90 +++ b/MAPL_Base/MAPL_IO.F90 @@ -2819,7 +2819,7 @@ subroutine MAPL_FieldWriteNCPar(formatter, name, FIELD, ARRDES, HomePE, oClients integer :: J,K type (ESMF_DistGrid) :: distGrid type (LocalMemReference) :: lMemRef - integer :: request_id, size_1d + integer :: size_1d call ESMF_FieldGet(field, grid=grid, rc=status) @@ -5177,7 +5177,7 @@ subroutine MAPL_VarWriteNCpar_R4_3d(formatter, name, A, ARRDES, oClients, RC) integer :: status integer :: l - integer :: i1, j1, in, jn, global_dim(3), request_id + integer :: i1, j1, in, jn, global_dim(3) type(ArrayReference) :: ref if (arrdes%write_restart_by_oserver) then @@ -5240,7 +5240,7 @@ subroutine MAPL_VarWriteNCpar_R8_3d(formatter, name, A, ARRDES, oClients, RC) integer :: l - integer :: i1, j1, in, jn, global_dim(3), request_id + integer :: i1, j1, in, jn, global_dim(3) type(ArrayReference) :: ref @@ -5316,7 +5316,7 @@ subroutine MAPL_VarWriteNCpar_R4_2d(formatter, name, A, ARRDES, lev, oClients, R logical :: AM_WRITER type (ArrayReference) :: ref - integer :: i1, j1, in, jn, global_dim(3), request_id + integer :: i1, j1, in, jn, global_dim(3) if (present(arrdes)) then if(arrdes%write_restart_by_oserver) then @@ -6903,7 +6903,7 @@ subroutine MAPL_VarWriteNCpar_R8_2d(formatter, name, A, ARRDES, lev, oClients, R logical :: AM_WRITER type (ArrayReference) :: ref - integer :: i1, j1, in, jn, global_dim(3), request_id + integer :: i1, j1, in, jn, global_dim(3) if (present(arrdes)) then if( arrdes%write_restart_by_oserver) then @@ -7069,7 +7069,6 @@ subroutine MAPL_VarReadNCpar_R8_2d(formatter, name, A, ARRDES, lev, RC) integer :: IM_WORLD integer :: JM_WORLD integer :: status - character(len=ESMF_MAXSTR) :: IAm='MAPL_VarReadNCpar_R8_2d' real(kind=ESMF_KIND_R8), allocatable :: buf(:) integer :: I,J,N,K,L,myrow,myiorank,ndes_x @@ -7314,7 +7313,6 @@ subroutine MAPL_StateVarReadNCPar(filename, STATE, arrdes, bootstrapable, NAME, type (ESMF_Field) :: field integer :: status integer :: I, K - character(len=ESMF_MAXSTR) :: IAm='MAPL_StateVarReadNCPar' integer :: J, ITEMCOUNT type (ESMF_StateItem_Flag), pointer :: ITEMTYPES(:) character(len=ESMF_MAXSTR ), pointer :: ITEMNAMES(:) @@ -8797,7 +8795,6 @@ subroutine MAPL_IOCountNonDimVars(cf,nvars,rc) integer, intent(out) :: nvars integer, intent(out), optional :: rc - integer :: status type(StringVariableMap), pointer :: vars type(StringVariableMapIterator) :: iter type(StringIntegerMap), pointer :: dims @@ -8826,7 +8823,6 @@ function MAPL_IOGetNonDimVars(cf,rc) result(nondim_vars) type(FileMetadata), intent(inout) :: cf integer, intent(out), optional :: rc - integer :: status type(StringVector) :: nondim_vars type(StringVariableMap), pointer :: vars type(StringVariableMapIterator) :: iter diff --git a/MAPL_Base/MAPL_IdentityRegridder.F90 b/MAPL_Base/MAPL_IdentityRegridder.F90 index 191ac0a78ac1..09647848b013 100644 --- a/MAPL_Base/MAPL_IdentityRegridder.F90 +++ b/MAPL_Base/MAPL_IdentityRegridder.F90 @@ -106,6 +106,7 @@ subroutine regrid_vector_2d_real32(this, u_in, v_in, u_out, v_out, rotate, rc) character(len=*), parameter :: Iam = MOD_NAME//'regrid_vector_3d_real32' _UNUSED_DUMMY(this) + _UNUSED_DUMMY(rotate) u_out = u_in v_out = v_in @@ -130,6 +131,7 @@ subroutine regrid_vector_3d_real32(this, u_in, v_in, u_out, v_out, rotate, rc) character(len=*), parameter :: Iam = MOD_NAME//'regrid_vector_3d_real32' _UNUSED_DUMMY(this) + _UNUSED_DUMMY(rotate) _ASSERT(size(u_in,3) == size(u_out,3)) _ASSERT(size(v_in,3) == size(v_out,3)) diff --git a/MAPL_Base/MAPL_LatLonGridFactory.F90 b/MAPL_Base/MAPL_LatLonGridFactory.F90 index b7677b99c2fc..29df1034442c 100644 --- a/MAPL_Base/MAPL_LatLonGridFactory.F90 +++ b/MAPL_Base/MAPL_LatLonGridFactory.F90 @@ -141,6 +141,8 @@ function Latlongridfactory_basic(grid_name, & integer :: status character(*), parameter :: IAM = __FILE__ + _UNUSED_DUMMY(unusable) + factory%is_regular = .false. factory%grid_name = grid_name @@ -336,6 +338,8 @@ function get_longitudes(this, unusable, rc) result(longitudes) class (KeywordEnforcer), optional, intent(in) :: unusable integer, optional, intent(out) :: rc + _UNUSED_DUMMY(unusable) + longitudes = this%lon_centers _RETURN(_SUCCESS) end function get_longitudes @@ -349,6 +353,8 @@ function get_latitudes(this, unusable, rc) result(latitudes) class (KeywordEnforcer), optional, intent(in) :: unusable integer, optional, intent(out) :: rc + _UNUSED_DUMMY(unusable) + latitudes = this%lat_centers _RETURN(_SUCCESS) end function get_latitudes @@ -457,6 +463,8 @@ function get_lon_corners(this, unusable, rc) result(lon_corners) class (KeywordEnforcer), optional, intent(in) :: unusable integer, optional, intent(out) :: rc + _UNUSED_DUMMY(unusable) + lon_corners = this%lon_corners _RETURN(_SUCCESS) @@ -471,6 +479,8 @@ function get_lat_corners(this, unusable, rc) result(lat_corners) class (KeywordEnforcer), optional, intent(in) :: unusable integer, optional, intent(out) :: rc + _UNUSED_DUMMY(unusable) + lat_corners = this%lat_corners _RETURN(_SUCCESS) @@ -1379,6 +1389,8 @@ function check_decomposition(this,unusable,rc) result(can_decomp) integer, optional, intent(out) :: rc logical :: can_decomp integer :: n + _UNUSED_DUMMY(unusable) + can_decomp = .true. if (this%im_world==1 .and. this%jm_world==1) then _RETURN(_SUCCESS) @@ -1397,6 +1409,8 @@ subroutine generate_newnxy(this,unusable,rc) integer, optional, intent(out) :: rc integer :: n + _UNUSED_DUMMY(unusable) + n = this%im_world/this%nx if (n < 2) then this%nx = generate_new_decomp(this%im_world,this%nx) @@ -1663,6 +1677,7 @@ function get_grid_vars(this) result(vars) class (LatLonGridFactory), intent(inout) :: this character(len=:), allocatable :: vars + _UNUSED_DUMMY(this) vars = 'lon,lat' @@ -1671,6 +1686,8 @@ end function get_grid_vars subroutine append_variable_metadata(this,var) class (LatLonGridFactory), intent(inout) :: this type(Variable), intent(inout) :: var + _UNUSED_DUMMY(this) + _UNUSED_DUMMY(var) end subroutine append_variable_metadata subroutine generate_file_bounds(this,grid,local_start,global_start,global_count,rc) @@ -1685,6 +1702,7 @@ subroutine generate_file_bounds(this,grid,local_start,global_start,global_count, integer :: status integer :: global_dim(3), i1,j1,in,jn character(len=*), parameter :: Iam = MOD_NAME // 'generate_file_bounds' + _UNUSED_DUMMY(this) call MAPL_GridGet(grid,globalCellCountPerDim=global_dim,rc=status) _VERIFY(status) @@ -1702,6 +1720,7 @@ function generate_file_reference2D(this,fpointer) result(ref) type(ArrayReference) :: ref class(LatLonGridFactory), intent(inout) :: this real, pointer, intent(in) :: fpointer(:,:) + _UNUSED_DUMMY(this) ref = ArrayReference(fpointer) end function generate_file_reference2D @@ -1710,6 +1729,7 @@ function generate_file_reference3D(this,fpointer) result(ref) type(ArrayReference) :: ref class(LatLonGridFactory), intent(inout) :: this real, pointer, intent(in) :: fpointer(:,:,:) + _UNUSED_DUMMY(this) ref = ArrayReference(fpointer) end function generate_file_reference3D diff --git a/MAPL_Base/MAPL_LatLonToLatLonRegridder.F90 b/MAPL_Base/MAPL_LatLonToLatLonRegridder.F90 index 5ba245610d41..39e93ef5c680 100644 --- a/MAPL_Base/MAPL_LatLonToLatLonRegridder.F90 +++ b/MAPL_Base/MAPL_LatLonToLatLonRegridder.F90 @@ -284,6 +284,9 @@ subroutine apply_weights_real32(this, q_in, q_out, rc) real :: q, w, f real(kind=REAL32) :: undef + + _UNUSED_DUMMY(rc) + undef = -HUGE(1.) do j = 1, this%num_points_out(2) @@ -344,6 +347,9 @@ subroutine apply_weights_real64(this, q_in, q_out, rc) real :: q, w, f real(kind=REAL64) :: undef + + _UNUSED_DUMMY(rc) + undef = -HUGE(1.d0) do j = 1, this%num_points_out(2) @@ -479,14 +485,13 @@ subroutine initialize_subclass(this, unusable, rc) type (RegridderSpec) :: spec logical :: cyclic_dim,hasPoles,stagger - integer :: dim,nsize,nin,j + integer :: dim,nsize,nin type(Weights), pointer :: WeightList(:) => null() real(kind=REAL64), allocatable :: xg_in(:),xg_out(:) real(kind=REAL32), allocatable :: xf_in(:),xf_out(:) - real(kind=REAL64) :: xMaxIn,xMaxOut,xMinIn,xMinOut,rngIn,rngOut,dx_in,dx_out + real(kind=REAL64) :: xMaxIn,xMaxOut,xMinIn,xMinOut,rngIn,rngOut type(dimensionSpec) :: dimspec character(len=ESMF_MAXSTR) :: grid_type - character(len=1024) :: error_msg _UNUSED_DUMMY(unusable) diff --git a/MAPL_Base/MAPL_NUOPCWrapperMod.F90 b/MAPL_Base/MAPL_NUOPCWrapperMod.F90 index 47edb6e5863a..d91e2cba0bec 100644 --- a/MAPL_Base/MAPL_NUOPCWrapperMod.F90 +++ b/MAPL_Base/MAPL_NUOPCWrapperMod.F90 @@ -327,6 +327,8 @@ subroutine CheckImport(model, rc) ! at the future stopTime, as it does its forward stepping from currentTime ! to stopTime. + _UNUSED_DUMMY(model) + rc = ESMF_SUCCESS end subroutine CheckImport @@ -338,10 +340,10 @@ subroutine initialize_data(model, rc) type(ESMF_State) :: import_state, export_state type(ESMF_Clock) :: clock - type(ESMF_Field) :: field + !type(ESMF_Field) :: field integer :: num_items - character(len=ESMF_MAXSTR), allocatable :: item_names(:) + !character(len=ESMF_MAXSTR), allocatable :: item_names(:) call ESMF_GridCompGet(model, clock = clock, importState = import_state, & exportState = export_state, rc = rc) diff --git a/MAPL_Base/MAPL_NewArthParser.F90 b/MAPL_Base/MAPL_NewArthParser.F90 index 3337f0a16544..c3b5070dbc70 100755 --- a/MAPL_Base/MAPL_NewArthParser.F90 +++ b/MAPL_Base/MAPL_NewArthParser.F90 @@ -759,7 +759,6 @@ SUBROUTINE CheckSyntax (FuncStr,Var,needed,ExtVar,rc) INTEGER :: ParCnt, & ! Parenthesis counter j,ib,in,lFunc LOGICAL :: isUndef - INTEGER :: status character(len=ESMF_MAXPATHLEN) :: func integer, allocatable :: ipos(:) character(len=ESMF_MAXSTR), parameter :: IAm="CheckSyntax" diff --git a/MAPL_Base/MAPL_RegridderSpec.F90 b/MAPL_Base/MAPL_RegridderSpec.F90 index 0ba1470a5fa1..6e48f4f99b92 100644 --- a/MAPL_Base/MAPL_RegridderSpec.F90 +++ b/MAPL_Base/MAPL_RegridderSpec.F90 @@ -98,7 +98,6 @@ end function new_RegridderTypeSpec logical function less_than(a, b) class (RegridderTypeSpec), intent(in) :: a type (RegridderTypeSpec), intent(in) :: b - logical :: greater_than ! Compare methods @@ -177,6 +176,8 @@ subroutine get_grid_type(this,unusable,InputGridType,OutputGridType,rc) integer :: status character(len=*), parameter :: Iam = MOD_NAME//'get_grid_type' + _UNUSED_DUMMY(unusable) + if (present(InputGridType)) then call ESMF_AttributeGet(this%grid_in,'GridType',InputGridType,rc=status) _VERIFY(status) diff --git a/MAPL_Base/MAPL_SimpleBundleMod.F90 b/MAPL_Base/MAPL_SimpleBundleMod.F90 index f31d4a20b564..62fd4d3bebca 100644 --- a/MAPL_Base/MAPL_SimpleBundleMod.F90 +++ b/MAPL_Base/MAPL_SimpleBundleMod.F90 @@ -188,7 +188,7 @@ Function MAPL_SimpleBundleCreateFromBundle ( Bundle, rc, & character(len=ESMF_MAXSTR) :: bundleName character(len=ESMF_MAXSTR) :: fieldName - __Iam__('MAPL_SimpleBundleCreate') + integer :: status self%Bundle => Bundle ! remember where it came from @@ -561,7 +561,7 @@ Function MAPL_SimpleBundleCreateFromState ( State, rc, & character(len=ESMF_MAXSTR) :: message type (ESMF_FieldBundle) :: Bundle - __Iam__('MAPL_SimpleBundleCreateFromState') + integer :: status call ESMF_StateGet(State, name=stateName, __RC__) @@ -608,7 +608,7 @@ subroutine MAPL_SimpleBundleDestroy (self, rc ) !EOP !----------------------------------------------------------------------------- - __Iam__('MAPL_SimpleBundleDestroy') + integer :: status deallocate(self%coords%Lons, self%coords%Lats, self%coords%Levs, __STAT__) deallocate(self%r1, self%r2, self%r3, __STAT__) @@ -655,7 +655,7 @@ Function MAPL_SimpleBundleRead (filename, bundle_name, grid, time, verbose, & !EOP !----------------------------------------------------------------------------- - __Iam__('MAPL_SimpleBundleRead') + integer :: status type(ESMF_FieldBundle), pointer :: Bundle allocate(Bundle, stat=STATUS) @@ -700,7 +700,7 @@ subroutine MAPL_SimpleBundleWrite1 ( self, filename, clock, verbose, rc ) ! --- type(MAPL_CFIO) :: cfio - __Iam__ ('MAPL_SimpleBundleWrite0') + integer :: status call MAPL_CFIOCreate ( cfio, filename, clock, self%Bundle, __RC__) call MAPL_CFIOWrite ( cfio, Clock, self%Bundle, verbose=verbose, __RC__) @@ -738,7 +738,7 @@ subroutine MAPL_SimpleBundleWrite2 ( self, filename, time, verbose, rc ) type(ESMF_TimeInterval) :: TimeStep type(ESMF_Clock) :: Clock type(MAPL_CFIO) :: cfio - __Iam__ ('MAPL_SimpleBundleWrite1') + integer :: status call ESMF_TimeIntervalSet( TimeStep, h=0, m=30, s=0, __RC__ ) CLOCK = ESMF_ClockCreate ( name="Clock", timeStep=TimeStep, startTime=Time, __RC__ ) @@ -864,8 +864,6 @@ function MAPL_SimpleBundleGetIndex ( self, name, rank, rc, quiet ) result(iq) logical :: quiet_ integer :: i - _Iam_("MAPL_SimpleBundleGetIndex") - if ( present(quiet) ) then quiet_ = quiet else diff --git a/MAPL_Base/MAPL_TimeMethods.F90 b/MAPL_Base/MAPL_TimeMethods.F90 index 8fbff898095b..dddfcb2550da 100644 --- a/MAPL_Base/MAPL_TimeMethods.F90 +++ b/MAPL_Base/MAPL_TimeMethods.F90 @@ -40,14 +40,14 @@ function new_time_data(clock,ntime,frequency,offset,rc) result(tData) type(ESMF_TimeInterval) :: offset integer, optional, intent(Out) :: rc - integer :: status - tdata%clock=clock tdata%ntime=ntime tdata%frequency=frequency tdata%offset=offset tdata%funits="minutes" + _RETURN(ESMF_SUCCESS) + end function new_time_data function define_time_variable(this,rc) result(v) @@ -110,10 +110,11 @@ function compute_time_vector(this,metadata,rc) result(times) real, allocatable :: times(:) integer :: status - real :: scaleFactor + !real :: scaleFactor type(ESMF_Time) :: currTime,startTime type(ESMF_TimeInterval) :: tint - integer :: tindex,i + integer :: i + !integer :: tindex real(ESMF_KIND_R8) :: tint_s type(ESMFTimeVectorIterator) :: iter type(ESMF_Time), pointer :: tptr @@ -216,6 +217,9 @@ function get_start_time(this,metadata,rc) result(startTime) class(Variable), pointer :: v type(Attribute), pointer :: attr class(*), pointer :: units + + _UNUSED_DUMMY(this) + v => metadata%get_variable('time',rc=status) _VERIFY(status) attr => v%get_attribute('units') diff --git a/MAPL_Base/MAPL_TransposeRegridder.F90 b/MAPL_Base/MAPL_TransposeRegridder.F90 index 054a2f2cc3fd..389e01803a00 100644 --- a/MAPL_Base/MAPL_TransposeRegridder.F90 +++ b/MAPL_Base/MAPL_TransposeRegridder.F90 @@ -73,6 +73,9 @@ subroutine initialize_subclass(this, unusable, rc) class (KeywordEnforcer), optional, intent(in) :: unusable integer, optional, intent(out) :: rc + _UNUSED_DUMMY(this) + _UNUSED_DUMMY(unusable) + ! This is a wrapper class and should not be directly ! initialized. _RETURN(_FAILURE) @@ -149,6 +152,9 @@ subroutine regrid_vector_2d_real32(this, u_in, v_in, u_out, v_out, rotate, rc) character(len=*), parameter :: Iam = MOD_NAME//'regrid_vector_2d_real32' integer :: status + + _UNUSED_DUMMY(rotate) + call this%reference%transpose_regrid(u_in, v_in, u_out, v_out, rc=status) _RETURN(status) @@ -167,6 +173,9 @@ subroutine regrid_vector_2d_real64(this, u_in, v_in, u_out, v_out, rotate, rc) character(len=*), parameter :: Iam = MOD_NAME//'regrid_vector_2d_real64' integer :: status + + _UNUSED_DUMMY(rotate) + call this%reference%transpose_regrid(u_in, v_in, u_out, v_out, rc=status) _RETURN(status) @@ -184,6 +193,9 @@ subroutine regrid_vector_3d_real32(this, u_in, v_in, u_out, v_out, rotate, rc) character(len=*), parameter :: Iam = MOD_NAME//'regrid_vector_3d_real32' integer :: status + + _UNUSED_DUMMY(rotate) + call this%reference%transpose_regrid(u_in, v_in, u_out, v_out, rotate=rotate, rc=status) _RETURN(status) @@ -321,6 +333,9 @@ subroutine transpose_regrid_vector_2d_real32(this, u_in, v_in, u_out, v_out, rot character(len=*), parameter :: Iam = MOD_NAME//'transpose_regrid_vector_2d_real32' integer :: status + + _UNUSED_DUMMY(rotate) + call this%reference%regrid(u_in, v_in, u_out, v_out, rc=status) _RETURN(status) @@ -339,6 +354,9 @@ subroutine transpose_regrid_vector_2d_real64(this, u_in, v_in, u_out, v_out, rot character(len=*), parameter :: Iam = MOD_NAME//'transpose_regrid_vector_2d_real64' integer :: status + + _UNUSED_DUMMY(rotate) + call this%reference%regrid(u_in, v_in, u_out, v_out, rc=status) _RETURN(status) @@ -358,6 +376,9 @@ subroutine transpose_regrid_vector_3d_real32(this, u_in, v_in, u_out, v_out, rot character(len=*), parameter :: Iam = MOD_NAME//'transpose_regrid_vector_3d_real32' integer :: status + + _UNUSED_DUMMY(rotate) + call this%reference%regrid(u_in, v_in, u_out, v_out, rotate=rotate, rc=status) _RETURN(status) @@ -429,6 +450,7 @@ end function get_spec function isTranspose(this) result(amTranspose) logical :: amTranspose class (TransposeRegridder), intent(in) :: this + _UNUSED_DUMMY(this) amTranspose = .true. end function isTranspose diff --git a/MAPL_Base/MAPL_TripolarGridFactory.F90 b/MAPL_Base/MAPL_TripolarGridFactory.F90 index 085afd116c6f..9e0e3f391e13 100644 --- a/MAPL_Base/MAPL_TripolarGridFactory.F90 +++ b/MAPL_Base/MAPL_TripolarGridFactory.F90 @@ -248,9 +248,10 @@ subroutine initialize_from_file_metadata(this, file_metadata, unusable, rc) integer, optional, intent(out) :: rc character(len=*), parameter :: Iam= MOD_NAME // 'initialize_from_file_metadata()' - integer :: status + _UNUSED_DUMMY(this) _UNUSED_DUMMY(unusable) + _UNUSED_DUMMY(rc) end subroutine initialize_from_file_metadata @@ -508,8 +509,8 @@ function generate_grid_name(this) result(name) class (TripolarGridFactory), intent(in) :: this _UNUSED_DUMMY(this) - _UNUSED_DUMMY(name) + name = '' ! needs to be implemented error stop -1 @@ -870,6 +871,7 @@ function get_grid_vars(this) result(vars) class (TripolarGridFactory), intent(inout) :: this character(len=:), allocatable :: vars + _UNUSED_DUMMY(this) vars = 'lon,lat' @@ -878,6 +880,8 @@ end function get_grid_vars subroutine append_variable_metadata(this,var) class (TripolarGridFactory), intent(inout) :: this type(Variable), intent(inout) :: var + _UNUSED_DUMMY(this) + _UNUSED_DUMMY(var) end subroutine append_variable_metadata subroutine generate_file_bounds(this,grid,local_start,global_start,global_count,rc) @@ -889,7 +893,12 @@ subroutine generate_file_bounds(this,grid,local_start,global_start,global_count, integer, allocatable, intent(inout) :: global_count(:) integer, optional, intent(out) :: rc - integer :: status + _UNUSED_DUMMY(this) + _UNUSED_DUMMY(grid) + _UNUSED_DUMMY(local_start) + _UNUSED_DUMMY(global_start) + _UNUSED_DUMMY(global_count) + _UNUSED_DUMMY(rc) end subroutine generate_file_bounds @@ -898,6 +907,7 @@ function generate_file_reference2D(this,fpointer) result(ref) type(ArrayReference) :: ref class(TripolarGridFactory), intent(inout) :: this real, pointer, intent(in) :: fpointer(:,:) + _UNUSED_DUMMY(this) ref = ArrayReference(fpointer) end function generate_file_reference2D @@ -906,6 +916,7 @@ function generate_file_reference3D(this,fpointer) result(ref) type(ArrayReference) :: ref class(TripolarGridFactory), intent(inout) :: this real, pointer, intent(in) :: fpointer(:,:,:) + _UNUSED_DUMMY(this) ref = ArrayReference(fpointer) end function generate_file_reference3D diff --git a/MAPL_Base/MAPL_VerticalMethods.F90 b/MAPL_Base/MAPL_VerticalMethods.F90 index 24fdc9ec5d02..109666350475 100644 --- a/MAPL_Base/MAPL_VerticalMethods.F90 +++ b/MAPL_Base/MAPL_VerticalMethods.F90 @@ -62,8 +62,6 @@ function newVerticalData(levels,vcoord,vscale,vunit,rc) result(vdata) character(len=*), optional, intent(in) :: vunit integer, optional, intent(Out) :: rc - integer :: status - if (.not.present(levels)) then vdata%regrid_type = VERTICAL_METHOD_NONE _RETURN(ESMF_SUCCESS) diff --git a/MAPL_Base/MAPL_ioClients.F90 b/MAPL_Base/MAPL_ioClients.F90 index 70d7098732c4..e2f366c78398 100644 --- a/MAPL_Base/MAPL_ioClients.F90 +++ b/MAPL_Base/MAPL_ioClients.F90 @@ -51,6 +51,7 @@ subroutine init_io_clients(this, unusable, ni, no, rc) i_Clients = ClientManager(n_client=n_i) o_Clients = ClientManager(n_client=n_o) _RETURN(_SUCCESS) + _UNUSED_DUMMY(this) _UNUSED_DUMMY(unusable) end subroutine diff --git a/MAPL_Base/MAPL_newCFIO.F90 b/MAPL_Base/MAPL_newCFIO.F90 index 49625e93387e..22e4dbd7b804 100644 --- a/MAPL_Base/MAPL_newCFIO.F90 +++ b/MAPL_Base/MAPL_newCFIO.F90 @@ -86,8 +86,6 @@ function new_MAPL_newCFIO(metadata,input_bundle,output_bundle,write_collection_i type(newCFIOitemVector), intent(in), optional :: items integer, intent(out), optional :: rc - integer :: status - if (present(metadata)) newCFIO%metadata=metadata if (present(input_bundle)) newCFIO%input_bundle=input_bundle if (present(output_bundle)) newCFIO%output_bundle=output_bundle diff --git a/MAPL_Base/MAPL_sun_uc.F90 b/MAPL_Base/MAPL_sun_uc.F90 index 096e02cb0cd0..18b515f7d55d 100644 --- a/MAPL_Base/MAPL_sun_uc.F90 +++ b/MAPL_Base/MAPL_sun_uc.F90 @@ -539,7 +539,6 @@ subroutine MAPL_SunOrbitDestroy(ORBIT, RC) !EOP character(len=ESMF_MAXSTR), parameter :: IAm = "SunOrbitDestroy" - integer :: STATUS if(associated(ORBIT%TH)) deallocate(ORBIT%TH) if(associated(ORBIT%ZC)) deallocate(ORBIT%ZC) @@ -575,7 +574,6 @@ logical function MAPL_SunOrbitCreated(ORBIT, RC) !EOPI character(len=ESMF_MAXSTR), parameter :: IAm = "SunOrbitCreated" - integer :: STATUS MAPL_SunOrbitCreated = associated(ORBIT%TH) _RETURN(ESMF_SUCCESS) @@ -892,9 +890,6 @@ subroutine GETIDAY(IDAY,TIME,ORBIT,RC) type(MAPL_SunORBIT), intent(IN ) :: ORBIT integer, optional, intent(OUT) :: RC - character(len=ESMF_MAXSTR) :: IAm = "GetIDAY" - integer :: STATUS - real :: ANOMALY select case(TIME) @@ -929,7 +924,6 @@ subroutine MAPL_SunGetSolarConstantByTime(Time,SC,HK,rc) integer :: YY, DOY integer :: STATUS - character(len=ESMF_MAXSTR) :: IAm = "MAPL_SunGetSolarConstantByTime" call ESMF_TimeGet (TIME, YY=YY, DayOfYear=DOY, RC=STATUS) _VERIFY(STATUS) @@ -976,8 +970,7 @@ subroutine MAPL_SunGetSolarConstantByYearDoY(year,dayofyear,SC,HK, rc) integer, optional, intent(OUT) :: rc real :: F - integer :: i1,i2,Current, STATUS - character(len=ESMF_MAXSTR) :: IAm = "MAPL_SunGetSolarConstantByYearDoY" + integer :: i1,i2,Current integer, parameter :: firstYear = 1610 integer, parameter :: finalYear = 2008 @@ -1799,9 +1792,8 @@ subroutine MAPL_SunGetSolarConstantFromNetcdfFile(CLOCK,fileName,SC,HK,MESOPHOT, real, optional, intent(out) :: JCALC4(:) integer, optional, intent(out) :: rc - type(ESMF_VM) :: VM type(ESMF_Time) :: time - integer :: i, k, N + integer :: N integer :: begYear, endYear integer :: INDX1, INDX2 integer :: MM, YY, DD, CCYY @@ -1835,7 +1827,6 @@ subroutine MAPL_SunGetSolarConstantFromNetcdfFile(CLOCK,fileName,SC,HK,MESOPHOT, real, dimension(:,:), allocatable :: coef_jcalc4 integer :: varid_coef_jcalc4 - character(len=ESMF_MAXSTR) :: shortName character(len=ESMF_MAXSTR) :: IAm = "MAPL_SunGetSolarConstantFromNetcdfFile" ! Open the file @@ -2190,8 +2181,7 @@ subroutine MAPL_SunGetSolarConstantFromNRLFile(CLOCK,filename_in,SC,MG,SB,Persis type(ESMF_Time) :: startCycle23, startCycle24 type(ESMF_TimeInterval) :: timeSinceStartOfCycle24 - integer :: currentYear, currentMon, currentDay, currentDOY, & - prevDay, nextDay + integer :: currentYear, currentMon, currentDay, currentDOY integer :: prevDOY, nextDOY, prevNoonYear, nextNoonYear integer :: originalYear, originalMon, originalDay, origDOY @@ -2220,8 +2210,6 @@ subroutine MAPL_SunGetSolarConstantFromNRLFile(CLOCK,filename_in,SC,MG,SB,Persis real, save, allocatable, dimension(:) :: tsi, mgindex, sbindex integer, save :: numlines - character(len=ESMF_MAXSTR) :: IAm = "MAPL_SunGetSolarConstantFromNRLFile" - if (present(PersistSolar)) then PersistSolar_ = PersistSolar else diff --git a/MAPL_Base/Regrid_Functions_Mod.F90 b/MAPL_Base/Regrid_Functions_Mod.F90 index 2fac4a4c7804..2aa95bd4b587 100644 --- a/MAPL_Base/Regrid_Functions_Mod.F90 +++ b/MAPL_Base/Regrid_Functions_Mod.F90 @@ -1,3 +1,5 @@ +#include "unused_dummy.H" + !----------------------------------------------------------------------- ! GEOS-Chem Global Chemical Transport Model ! !----------------------------------------------------------------------- @@ -180,8 +182,6 @@ Subroutine Set_fID(fIDIn, fIDOut, RC) ! ! !LOCAL VARIABLES: ! - Character(Len=255) :: OutMsg - !================================================================= ! Set_fID starts here! !================================================================= @@ -241,8 +241,6 @@ Subroutine Cleanup(RC) ! ! !LOCAL VARIABLES: ! - Character(Len=255) :: OutMsg - !================================================================= ! Cleanup starts here! !================================================================= @@ -307,7 +305,7 @@ subroutine readTileFileNC(TFDir,gridIn,gridOut,RC) ! ! !LOCAL VARIABLES: ! - Character(Len=255) :: fName, errMsg + Character(Len=255) :: fName Logical :: Found Integer :: status @@ -354,7 +352,7 @@ subroutine readTileFileNC_file(fName, RC) ! Expected grid sizes - Integer :: resIn(2), resOut(2) + !Integer :: resIn(2), resOut(2) ! Grid sizes on file integer :: resInFile(2), resOutFile(2) @@ -567,6 +565,8 @@ Subroutine transposeCS(II,JJ,nX,nY,nVal,iFace) Integer :: JJ0(nVal) Integer :: I + _UNUSED_DUMMY(nY) + ! Copy input II0 = II JJ0 = JJ @@ -597,6 +597,8 @@ Subroutine flipCS(II,JJ,nX,nY,nVal,iFace,iDir) Integer :: I Logical :: flipII, flipJJ + _UNUSED_DUMMY(nY) + ! Copy input II0 = II JJ0 = JJ @@ -628,9 +630,10 @@ Subroutine swapCS(II,JJ,nX,nY,nVal) Integer :: II0(nVal) Integer :: JJ0(nVal) Integer :: I - Logical :: flipII, flipJJ Integer, Parameter :: faceMap(6) = (/4,5,1,2,6,3/) + _UNUSED_DUMMY(nY) + ! Copy input II0 = II JJ0 = JJ @@ -922,6 +925,8 @@ Subroutine genGridName(nX, nY, gridName, xVec, yVec, & Logical :: isDE_ Logical :: isPC_ + _UNUSED_DUMMY(rc) + !================================================================= ! genGridName starts here! !================================================================= @@ -1169,7 +1174,7 @@ Subroutine nXYtoVec(xVec,yVec,isCS,isPC,isDE,RC) ! Integer :: nX, nY Integer :: I, RC_ - Real(sp) :: fTemp, fMin, fMax, fStride + Real(sp) :: fMin, fStride !================================================================= ! nXYtoVec starts here! @@ -1328,7 +1333,7 @@ Subroutine regridData(in2D,out2D,RC) ! !LOCAL VARIABLES: ! Integer :: I, iX, iY - Real(kind=sp) :: wVal, inVal, outVal, rCount + Real(kind=sp) :: wVal, inVal, outVal Real(kind=sp), Parameter :: missingVal=0.0 !================================================================= @@ -1406,9 +1411,9 @@ Subroutine ReadInput(resOut,fNameIn,fNameOut,reverseLev,& ! ! !LOCAL VARIABLES: ! - Integer :: fIDGCHP, RC_, IOS, nRead, I + Integer :: fIDGCHP, RC_, I Integer :: resTemp(2) - Character(Len=255) :: currLine, strRead, leftStr, rightStr + Character(Len=255) :: currLine, strRead Logical :: Found, logRead !================================================================= diff --git a/MAPL_Base/Regrid_Util.F90 b/MAPL_Base/Regrid_Util.F90 index e57fbf0e9036..98bfa50dfd3f 100644 --- a/MAPL_Base/Regrid_Util.F90 +++ b/MAPL_Base/Regrid_Util.F90 @@ -510,6 +510,9 @@ subroutine simpleDynMaskProc(dynamicMaskList, dynamicSrcMaskValue, & integer, intent(out) :: rc integer :: i, j real(ESMF_KIND_R8) :: renorm + + _UNUSED_DUMMY(dynamicDstMaskValue) + if (associated(dynamicMaskList)) then do i=1, size(dynamicMaskList) dynamicMaskList(i)%dstElement = 0.d0 ! set to zero @@ -751,7 +754,6 @@ function create_grid(grid_type,gname,im_world,jm_world,lm,nx,ny,dateline,pole,tp integer, optional, intent(out) :: rc integer :: status - character(len=ESMF_MAXSTR) :: Iam = "create_grid" type(LatLonGridFactory) :: ll_factory select case(grid_type) diff --git a/MAPL_Base/read_parallel.H b/MAPL_Base/read_parallel.H index 51353b3ea71b..7cdef78ea7ce 100644 --- a/MAPL_Base/read_parallel.H +++ b/MAPL_Base/read_parallel.H @@ -32,9 +32,9 @@ subroutine SUB_ ( layout, DATA, UNIT, FORMAT, arrdes, RC) integer :: USABLE_UNIT integer :: IOSTAT integer :: status - character(len=ESMF_MAXSTR) :: IAM='READ_PARALLEL' #if (RANK_ == 1 && VARTYPE_ == 4) integer :: nretries + character(len=ESMF_MAXSTR) :: IAM='READ_PARALLEL' #endif if(present(arrdes)) then diff --git a/MAPL_Base/tests/MockGridFactory.F90 b/MAPL_Base/tests/MockGridFactory.F90 index 1023ed2481fb..f10a092f3575 100644 --- a/MAPL_Base/tests/MockGridFactory.F90 +++ b/MAPL_Base/tests/MockGridFactory.F90 @@ -30,6 +30,9 @@ module MockGridFactoryMod procedure :: append_metadata procedure :: append_variable_metadata + procedure :: generate_file_bounds + procedure :: generate_file_reference2D + procedure :: generate_file_reference3D end type MockGridFactory interface MockGridFactory @@ -155,6 +158,10 @@ subroutine initialize_from_file_metadata(this, file_metadata, unusable, rc) type (FileMetadata), target, intent(in) :: file_metadata class (KeywordEnforcer), optional, intent(in) :: unusable integer, optional, intent(out) :: rc + _UNUSED_DUMMY(this) + _UNUSED_DUMMY(file_metadata) + _UNUSED_DUMMY(unusable) + _UNUSED_DUMMY(rc) end subroutine initialize_from_file_metadata @@ -162,7 +169,8 @@ subroutine append_metadata(this, metadata) class (MockGridFactory), intent(inout) :: this type (FileMetadata), intent(inout) :: metadata - type (Variable) :: v + _UNUSED_DUMMY(this) + _UNUSED_DUMMY(metadata) !!$ ! Horizontal grid dimensions !!$ call metadata%add_dimension('lon', this%im_world) @@ -173,6 +181,7 @@ function get_grid_vars(this) result(vars) class (MockGridFactory), intent(inout) :: this character(len=:), allocatable :: vars + _UNUSED_DUMMY(this) vars = 'lon,lat, mock' @@ -181,7 +190,45 @@ end function get_grid_vars subroutine append_variable_metadata(this,var) class (MockGridFactory), intent(inout) :: this type(Variable), intent(inout) :: var + _UNUSED_DUMMY(this) + _UNUSED_DUMMY(var) end subroutine append_variable_metadata + subroutine generate_file_bounds(this,grid,local_start,global_start,global_count,rc) + use MAPL_BaseMod + use ESMF + class(MockGridFactory), intent(inout) :: this + type(ESMF_Grid), intent(inout) :: grid + integer, allocatable, intent(inout) :: local_start(:) + integer, allocatable, intent(inout) :: global_start(:) + integer, allocatable, intent(inout) :: global_count(:) + integer, optional, intent(out) :: rc + + _UNUSED_DUMMY(this) + _UNUSED_DUMMY(grid) + _UNUSED_DUMMY(local_start) + _UNUSED_DUMMY(global_start) + _UNUSED_DUMMY(global_count) + _UNUSED_DUMMY(rc) + + end subroutine generate_file_bounds + + function generate_file_reference2D(this,fpointer) result(ref) + use pFIO + type(ArrayReference) :: ref + class(MockGridFactory), intent(inout) :: this + real, pointer, intent(in) :: fpointer(:,:) + _UNUSED_DUMMY(this) + ref = ArrayReference(fpointer) + end function generate_file_reference2D + + function generate_file_reference3D(this,fpointer) result(ref) + use pFIO + type(ArrayReference) :: ref + class(MockGridFactory), intent(inout) :: this + real, pointer, intent(in) :: fpointer(:,:,:) + _UNUSED_DUMMY(this) + ref = ArrayReference(fpointer) + end function generate_file_reference3D end module MockGridFactoryMod diff --git a/MAPL_Base/write_parallel.H b/MAPL_Base/write_parallel.H index 2f7ae26fd2fb..9c5f3314fb7b 100644 --- a/MAPL_Base/write_parallel.H +++ b/MAPL_Base/write_parallel.H @@ -27,7 +27,6 @@ subroutine SUB_ ( data, UNIT, ARRDES, format, RC) integer , intent( out), optional :: RC character(len=ESMF_MAXSTR) :: FORMATTED - character(len=ESMF_MAXSTR) :: IAM='WRITE_PARALLEL' integer :: recl, status if(present(arrdes)) then diff --git a/MAPL_cfio/ESMF_CFIOGridMod.F90 b/MAPL_cfio/ESMF_CFIOGridMod.F90 index 7d11da58d08c..7b88b533c554 100644 --- a/MAPL_cfio/ESMF_CFIOGridMod.F90 +++ b/MAPL_cfio/ESMF_CFIOGridMod.F90 @@ -191,7 +191,7 @@ subroutine ESMF_CFIOGridSet (grid, gName, im, jm, km, tm, lat, lon, lev,& !------------------------------------------------------------------------------ integer :: rtcode = 0 integer :: i, j - integer :: sz + !integer :: sz _UNUSED_DUMMY(sigma) _UNUSED_DUMMY(reduceGrid) diff --git a/MAPL_cfio/ESMF_CFIOSdfMod.F90 b/MAPL_cfio/ESMF_CFIOSdfMod.F90 index 5263f9b9e519..b6e06563f88d 100644 --- a/MAPL_cfio/ESMF_CFIOSdfMod.F90 +++ b/MAPL_cfio/ESMF_CFIOSdfMod.F90 @@ -106,11 +106,10 @@ subroutine ESMF_CFIOSdfFileCreate (cfio, rc, expid) !EOP !------------------------------------------------------------------------------ integer :: i, rtcode - integer :: maxLen + !integer :: maxLen character(len=MLEN) :: fNameTmp ! file name integer :: date, begTime character(len=MLEN) :: fName - character(len=MLEN) :: string call ESMF_CFIOGet(cfio, date=date, begTime=begTime, fName=fName, rc=rtcode) if (rtcode .ne. 0) print *, "Problems in ESMF_CFIOGet" @@ -372,9 +371,7 @@ subroutine ESMF_CFIOSdfFileOpen (cfio, fmode, rc, expid, cyclic) integer :: nvatts ! number of attributes real*4, pointer :: rtmp(:) integer, pointer :: itmp(:) - character(len=MVARLEN), pointer :: ctmp(:) logical :: esmf_file = .false. - logical :: tmpLog logical :: new_grid integer :: nDims, allVars, recdim integer :: im, jm, km @@ -3802,7 +3799,7 @@ subroutine ESMF_CFIOSdfVarReadT2D__(cfio, vName, date, curTime, field, rc, cfio2 integer rtcode integer begDate, begTime, incSecs, timeIndex1, timeIndex2 integer secs, secs1, secs2, nymd1, nymd2, nhms1, nhms2 - integer i, j, k + integer i, j integer im, jm, km real alpha, amiss diff --git a/MAPL_cfio/ESMF_CFIOUtilMod.F90 b/MAPL_cfio/ESMF_CFIOUtilMod.F90 index 8353de4cda14..ef01ad772277 100644 --- a/MAPL_cfio/ESMF_CFIOUtilMod.F90 +++ b/MAPL_cfio/ESMF_CFIOUtilMod.F90 @@ -655,9 +655,11 @@ subroutine GetDateTimeVec ( fid, begDate, begTime, incVec, rc ) !EOP !------------------------------------------------------------------------- - integer i, timeId, hour, min, sec, corner(1), timInc, incSecs + integer i, timeId, hour, min, sec, corner(1) + !integer incSecs integer year, month, day - character(len=MAXCHR) timeUnits, strTmp, dimUnits + character(len=MAXCHR) timeUnits, dimUnits + !character(len=MAXCHR) strTmp character*(MAXCHR) varName, dimName, stdName integer type, nvDims, vdims(MAXVDIMS), nvAtts, dimSize @@ -668,10 +670,11 @@ subroutine GetDateTimeVec ( fid, begDate, begTime, incVec, rc ) real*8 dtime, dtime_array(1) integer*2 itime, itime_array(1) integer*4 ltime, ltime_array(1) - integer t1, t2, tMult, newDate, newTime + !integer t1 + integer newDate, newTime ! We now have the possibility of a very large interval - integer(Kind=INT64) :: t1Long, t2Long, tMax, tMultLong, incSecsLong + integer(Kind=INT64) :: t1Long, t2Long, tMultLong, incSecsLong integer(Kind=INT64),allocatable :: incVecLong(:) ! Vector of offsets (seconds) ! Get the starting date and time @@ -1326,8 +1329,6 @@ subroutine CFIO_Close ( fid, rc ) !EOP !------------------------------------------------------------------------- - integer i - call ncclos (fid, rc) if (err("Close: error closing file",rc,-54) .NE. 0) return @@ -2311,8 +2312,8 @@ subroutine ParseTimeUnits ( TimeUnits, year, month, day, hour, min, sec, rc ) ! Local variables - integer ypos(2), mpos(2), dpos(2), hpos(2), minpos(2), spos(2) - integer inew, strlen + integer ypos(2), mpos(2), dpos(2), hpos(2), spos(2) + integer strlen integer firstdash, lastdash integer firstcolon, lastcolon integer lastspace @@ -2865,7 +2866,7 @@ subroutine CFIO_SGetVar ( fid, vname, yyyymmdd, hhmmss,& integer corner(3), edges(3), timeIndex integer vid integer i,j,k - integer incSecs + !integer incSecs logical stationFile integer(INT64), allocatable :: incVec(:) @@ -2878,7 +2879,7 @@ subroutine CFIO_SGetVar ( fid, vname, yyyymmdd, hhmmss,& integer dimSize, dimId integer nDims,nvars,ngatts integer varType, myIndex - integer timeShift + !integer timeShift ! Variables for dealing with precision @@ -3240,11 +3241,11 @@ subroutine CFIO_GetVar ( fid, vname, yyyymmdd, hhmmss,& !------------------------------------------------------------------------- integer begDate, begTime, seconds, minutes - integer timeShift + !integer timeShift integer corner(5), edges(5), timeIndex integer vid integer i,j,k - integer incSecs + !integer incSecs integer(INT64), allocatable :: incVec(:) ! Variables for working with dimensions @@ -4049,10 +4050,9 @@ subroutine GetDateInt8 (yyyymmdd_1,hhmmss_1,offset, & !------------------------------------------------------------------------- integer year1,mon1,day1,hour1,min1,sec1 integer year2,mon2,day2,hour2,min2,sec2 - integer seconds1, seconds2 - integer(kind=INT64) julian1, julian2 + integer(kind=INT64) julian1 integer(kind=INT64) julsec, remainder - character*8 dateString + !character*8 dateString ! Error checking. @@ -4207,7 +4207,6 @@ real function CFIO_GetMissing ( fid, rc ) character*(MAXCHR) vnameTemp integer i logical surfaceOnly - logical noTimeInfo integer attType, attLen integer allVars ! all variables - includes dimension vars diff --git a/MAPL_pFUnit/ESMF_TestParameter.F90 b/MAPL_pFUnit/ESMF_TestParameter.F90 index a847e1e8ba83..c1e0a2bee63c 100644 --- a/MAPL_pFUnit/ESMF_TestParameter.F90 +++ b/MAPL_pFUnit/ESMF_TestParameter.F90 @@ -1,3 +1,5 @@ +#include "unused_dummy.H" + module ESMF_TestParameter_mod use pfunit, only: MpiTestParameter implicit none @@ -67,6 +69,7 @@ end function toStringActual function toString(this) result(string) class (ESMF_TestParameter), intent(in) :: this character(:), allocatable :: string + _UNUSED_DUMMY(this) string = '' diff --git a/MAPL_pFUnit/unused_dummy.H b/MAPL_pFUnit/unused_dummy.H new file mode 100644 index 000000000000..91337aca862c --- /dev/null +++ b/MAPL_pFUnit/unused_dummy.H @@ -0,0 +1,13 @@ +! The following macro causes a variable to appear to be "used" +! according to the compiler. This is a kludge to avoid excessive +! warnings. In most cases, a better fix would be to modify the the +! procedure interface, but it is impractical in the short term. +! +! Note that the conditional is never satisfied and a reasonable +! compiler will optimize the line away. (Hopefully without +! reintroducing the warning!) + +#ifdef _UNUSED_DUMMY +# undef _UNUSED_DUMMY +#endif +#define _UNUSED_DUMMY(x) if (.false.) print*,shape(x) diff --git a/Tests/ExtDataDriverGridComp.F90 b/Tests/ExtDataDriverGridComp.F90 index 9c96f051f7ee..36b8dd3de9de 100644 --- a/Tests/ExtDataDriverGridComp.F90 +++ b/Tests/ExtDataDriverGridComp.F90 @@ -63,7 +63,6 @@ function new_ExtData_DriverGridComp(root_set_services, configFileName, name) res type(MAPL_MetaComp_Wrapper) :: meta_comp_wrapper integer :: status, rc - character(len=ESMF_MAXSTR) :: Iam="new_ExtData_DriverGridComp" cap%root_set_services => root_set_services @@ -138,8 +137,6 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) integer :: HEARTBEAT_DT character(len=ESMF_MAXSTR) :: HIST_CF, ROOT_CF, EXTDATA_CF - character(len=ESMF_MAXSTR) :: Iam="initialize_gc" - type (MAPL_MetaComp), pointer :: MAPLOBJ procedure(), pointer :: root_set_services type(ExtData_DriverGridComp), pointer :: cap @@ -436,7 +433,6 @@ subroutine run_gc(gc, import, export, clock, rc) integer, intent(out) :: RC ! Error code: integer :: status - character(len=ESMF_MAXSTR) :: Iam="MAPL_GridCompCap::run()" _UNUSED_DUMMY(import) _UNUSED_DUMMY(export) @@ -456,7 +452,6 @@ subroutine finalize_gc(gc, import_state, export_state, clock, rc) integer, intent(out) :: rc integer :: status - character(len=ESMF_MAXSTR) :: Iam = "CapGridComp_Finalize" type(ExtData_DriverGridComp), pointer :: cap type(MAPL_MetaComp), pointer :: MAPLOBJ @@ -502,7 +497,6 @@ subroutine set_services_gc(gc, rc) integer, intent(out) :: rc integer :: status - character(len=ESMF_MAXSTR) :: Iam="set_services" call ESMF_GridCompSetEntryPoint(gc, ESMF_METHOD_INITIALIZE, userRoutine = initialize_gc, rc = status) _VERIFY(status) @@ -518,7 +512,6 @@ end subroutine set_services_gc subroutine set_services(this, rc) class(ExtData_DriverGridComp), intent(inout) :: this integer, optional, intent(out) :: rc - character(*), parameter :: Iam = "set_services" integer :: status call ESMF_GridCompSetServices(this%gc, set_services_gc, rc = status) @@ -532,7 +525,6 @@ subroutine initialize(this, rc) integer, optional, intent(out) :: rc integer :: status - character(len=ESMF_MAXSTR) :: Iam="Initialize" call ESMF_GridCompInitialize(this%gc, userRc = status) _VERIFY(status) @@ -546,7 +538,6 @@ subroutine run(this, rc) integer :: status integer :: userRc - character(len=ESMF_MAXSTR) :: Iam="run" call ESMF_GridCompRun(this%gc, userRC=userRC,rc=status) _ASSERT(userRC==ESMF_SUCCESS .and. STATUS==ESMF_SUCCESS,'run failed') @@ -560,7 +551,6 @@ subroutine finalize(this, rc) integer, optional, intent(out) :: rc integer :: status - character(len=ESMF_MAXSTR) :: Iam="finalize" call ESMF_GridCompFinalize(this%gc, rc = status) _VERIFY(status) @@ -572,8 +562,6 @@ function get_am_i_root(this, rc) result (amiroot) class (ExtData_DriverGridComp) :: this integer, optional, intent(out) :: rc - character(len=ESMF_MAXSTR) :: Iam="get_am_i_root" - logical :: amiroot amiroot = this%amiroot @@ -608,7 +596,6 @@ subroutine run_MultipleTimes(gc, rc) integer, optional, intent(out) :: rc integer :: n, status - character(len=ESMF_MAXSTR) :: Iam="run_MultipleTimes" type(ExtData_DriverGridComp), pointer :: cap type (MAPL_MetaComp), pointer :: MAPLOBJ @@ -640,7 +627,6 @@ end subroutine run_MultipleTimes subroutine run_one_step(this, rc) class(ExtData_DriverGridComp), intent(inout) :: this integer, intent(out) :: rc - character(*), parameter :: Iam = "run_one_step" integer :: AGCM_YY, AGCM_MM, AGCM_DD, AGCM_H, AGCM_M, AGCM_S integer :: status @@ -716,7 +702,6 @@ subroutine MAPL_ClockInit ( cf, Clock, nsteps, rc) character(ESMF_MAXSTR) :: CALENDAR integer :: status integer :: datetime(2) - character(ESMF_MAXSTR) :: IAM="MAPL_ClockInit" type(ESMF_Calendar) :: cal type(ESMF_Time) :: CurrTime type(ESMF_TimeInterval) :: timeInterval, duration @@ -789,7 +774,6 @@ end subroutine MAPL_ClockInit subroutine parseTimes(this, rc) class(ExtData_DriverGridComp), intent(inout) :: this integer, intent(out), optional :: rc - character(*), parameter :: Iam = "parseTimes" integer :: comp_YY, comp_MM, comp_DD, comp_H, comp_M, comp_S,columnCount,lineCount,i,ctime(2) integer :: status @@ -817,7 +801,6 @@ subroutine advanceClockToTime(this, time,rc) class(ExtData_DriverGridComp), intent(inout) :: this type(ESMF_Time), intent(inout) :: time integer, intent(out), optional :: rc - character(*), parameter :: Iam = "advanceClockToTime" integer :: status type(ESMF_Time) :: currTime diff --git a/Tests/ExtDataDriverMod.F90 b/Tests/ExtDataDriverMod.F90 index 7684272c8573..2ffec2c5e3b5 100644 --- a/Tests/ExtDataDriverMod.F90 +++ b/Tests/ExtDataDriverMod.F90 @@ -46,6 +46,9 @@ function newExtDataDriver(name,set_services, unusable, cap_options) result(drive procedure() :: set_services class (KeywordEnforcer), optional, intent(in) :: unusable class ( MAPL_CapOptions), optional, intent(in) :: cap_options + + _UNUSED_DUMMY(unusable) + driver%name = name driver%set_services => set_services if (present(cap_options)) then @@ -65,7 +68,6 @@ subroutine run(this,RC) integer :: STATUS - character(len=ESMF_MAXSTR) :: Iam="ExtData_Driver" integer :: CommCap diff --git a/Tests/ExtDataRoot_GridComp.F90 b/Tests/ExtDataRoot_GridComp.F90 index 9d6e22adae15..81e1213d649d 100644 --- a/Tests/ExtDataRoot_GridComp.F90 +++ b/Tests/ExtDataRoot_GridComp.F90 @@ -172,9 +172,10 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) integer :: status character(len=ESMF_MAXSTR) :: comp_name - real(REAL64) :: ptop, pint + !real(REAL64) :: ptop, pint !real(REAL64), allocatable :: ak(:),bk(:) - integer :: ls,im,jm,lm,nx,ny,nrows, ncolumn,i + integer :: im,jm,lm,nx,ny,nrows, ncolumn,i + !integer :: ls type(ESMF_Grid) :: grid type(ESMF_Time) :: currTime type(SyntheticFieldSupportWrapper) :: synthWrap @@ -279,7 +280,7 @@ SUBROUTINE Run_ ( GC, IMPORT, EXPORT, CLOCK, rc ) type (ESMF_State), pointer :: GEX(:) character(len=ESMF_MAXSTR) :: Iam - integer :: STATUS,i + integer :: STATUS type(MAPL_MetaComp), pointer :: MAPL character(len=ESMF_MAXSTR) :: comp_name type(SyntheticFieldSupportWrapper) :: synthWrap @@ -518,9 +519,6 @@ subroutine FillState(inState,outState,time,Synth,rc) integer :: status character(len=*), parameter :: Iam=__FILE__//"::FillState" integer :: I - real, pointer :: IMptr3(:,:,:) => null() - real, pointer :: Exptr3(:,:,:) => null() - real, pointer :: IMptr2(:,:) => null() real, pointer :: Exptr2(:,:) => null() integer :: itemcount character(len=ESMF_MAXSTR), allocatable :: outNameList(:) diff --git a/components.yaml b/components.yaml index 471b321b83fe..3ec677cbeed0 100644 --- a/components.yaml +++ b/components.yaml @@ -7,7 +7,7 @@ ESMA_env: ESMA_cmake: local: ./@cmake remote: git@github.com:GEOS-ESM/ESMA_cmake.git - tag: v2.1.1 + tag: v2.1.2 develop: develop ecbuild: From fa1709b8319299174aab85107ff03dfd2da4d605 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 24 Jan 2020 09:15:40 -0500 Subject: [PATCH 016/109] Updates for pFIO and MAPL CMakeLists For some reason, my earlier clean up changes did something to how CMake was working with GCC9. pFIO was no longer seeing the MPI Include files. So, I'm using some CMake namespace bits to have pFIO provide gftl and gftl-shared as `PUBLIC` and netCDF, MPI, and OpenMP as `PRIVATE`. That then meant that MAPL (which was getting MPI from pFIO) needs an explicit dependency. This is passed into `esma_add_library` so I think it's a `PUBLIC`. The model seemed to build and work for me. --- GMAO_pFIO/CMakeLists.txt | 5 ++--- MAPL_Base/CMakeLists.txt | 2 +- 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/GMAO_pFIO/CMakeLists.txt b/GMAO_pFIO/CMakeLists.txt index 3b5a59e0d5b6..2108a950edae 100644 --- a/GMAO_pFIO/CMakeLists.txt +++ b/GMAO_pFIO/CMakeLists.txt @@ -87,11 +87,10 @@ set (srcs ) esma_add_library (${this} SRCS ${srcs}) -target_link_libraries (${this} gftl gftl-shared ${NETCDF_LIBRARIES}) +target_link_libraries (${this} PUBLIC gftl gftl-shared + PRIVATE ${NETCDF_LIBRARIES} OpenMP::OpenMP_Fortran MPI::MPI_Fortran) -target_compile_options (${this} PRIVATE $<$:${OpenMP_Fortran_FLAGS}>) set_target_properties (${this} PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) -target_link_libraries (${this} ${MPI_Fortran_LIBRARIES} ${OpenMP_Fortran_LIBRARIES}) # Kludge for OSX security and DYLD_LIBRARY_PATH ... foreach(dir ${OSX_EXTRA_LIBRARY_PATH}) target_link_libraries(${this} "-Xlinker -rpath -Xlinker ${dir}") diff --git a/MAPL_Base/CMakeLists.txt b/MAPL_Base/CMakeLists.txt index 6836867afb3a..99f3e9ce4aeb 100644 --- a/MAPL_Base/CMakeLists.txt +++ b/MAPL_Base/CMakeLists.txt @@ -63,7 +63,7 @@ set (srcs FileMetadataUtilities.F90 FileMetadataUtilitiesVector.F90 ) -esma_add_library(${this} SRCS ${srcs} DEPENDENCIES GMAO_pFIO MAPL_cfio_r4 gftl-shared FLAP::FLAP) +esma_add_library(${this} SRCS ${srcs} DEPENDENCIES GMAO_pFIO MAPL_cfio_r4 gftl-shared FLAP::FLAP MPI::MPI_Fortran) target_compile_options (${this} PRIVATE $<$:${OpenMP_Fortran_FLAGS}>) if(DISABLE_GLOBAL_NAME_WARNING) set_target_properties (${this} PROPERTIES COMPILE_FLAGS ${DISABLE_GLOBAL_NAME_WARNING}) From 21616cd71f0b05f6f94134504f5255af3af291d8 Mon Sep 17 00:00:00 2001 From: Liam Bindle Date: Wed, 5 Feb 2020 22:26:10 +0000 Subject: [PATCH 017/109] Added missing stretched-grid support to MAPL_ExtDataGridChangeLev() in MAPL_ExtDataGridCompMod.F90 --- MAPL_Base/MAPL_ExtDataGridCompMod.F90 | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/MAPL_Base/MAPL_ExtDataGridCompMod.F90 b/MAPL_Base/MAPL_ExtDataGridCompMod.F90 index f73ffc365b4b..3311b8b0968a 100644 --- a/MAPL_Base/MAPL_ExtDataGridCompMod.F90 +++ b/MAPL_Base/MAPL_ExtDataGridCompMod.F90 @@ -33,7 +33,7 @@ MODULE MAPL_ExtDataGridCompMod use ESMF_CFIOUtilMod use MAPL_CFIOMod use MAPL_NewArthParserMod - use MAPL_ConstantsMod, only: MAPL_PI,MAPL_PI_R8 + use MAPL_ConstantsMod, only: MAPL_PI,MAPL_PI_R8,MAPL_RADIANS_TO_DEGREES use MAPL_IOMod, only: MAPL_NCIOParseTimeUnits use MAPL_regridderSpecMod use, intrinsic :: iso_fortran_env, only: REAL64 @@ -4286,6 +4286,7 @@ function MAPL_ExtDataGridChangeLev(Grid,CF,lm,rc) result(NewGrid) type(ESMF_Grid) :: newGrid type(ESMF_Config) :: cflocal character(len=*), parameter :: CF_COMPONENT_SEPARATOR = '.' + real :: temp_real IAM = "MAPL_ExtDataGridChangeLev" @@ -4313,6 +4314,21 @@ function MAPL_ExtDataGridChangeLev(Grid,CF,lm,rc) result(NewGrid) _VERIFY(status) call MAPL_ConfigSetAttribute(cflocal,value=trim(gname), label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"GRIDNAME:",rc=status) _VERIFY(status) + call ESMF_AttributeGet(grid, name='STRETCH_FACTOR', value=temp_real, rc=status) + if (status == ESMF_SUCCESS) then + call MAPL_ConfigSetAttribute(cflocal,value=temp_real, label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"STRETCH_FACTOR:",rc=status) + _VERIFY(status) + endif + call ESMF_AttributeGet(grid, name='TARGET_LON', value=temp_real, rc=status) + if (status == ESMF_SUCCESS) then + call MAPL_ConfigSetAttribute(cflocal,value=temp_real*MAPL_RADIANS_TO_DEGREES, label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"TARGET_LON:",rc=status) + _VERIFY(status) + endif + call ESMF_AttributeGet(grid, name='TARGET_LAT', value=temp_real, rc=status) + if (status == ESMF_SUCCESS) then + call MAPL_ConfigSetAttribute(cflocal,value=temp_real*MAPL_RADIANS_TO_DEGREES, label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"TARGET_LAT:",rc=status) + _VERIFY(status) + endif else call MAPL_ConfigSetAttribute(cflocal,value=counts(1), label=trim(COMP_Name)//CF_COMPONENT_SEPARATOR//"IM_WORLD:",rc=status) _VERIFY(status) From 02f1927412a6fc6c90870b1133eb51cb30eaf0b3 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 6 Feb 2020 09:42:23 -0500 Subject: [PATCH 018/109] Create PULL_REQUEST_TEMPLATE.md A first attempt at a PR template for MAPL. Might be a bit verbose, but better to start there. --- .github/PULL_REQUEST_TEMPLATE.md | 34 ++++++++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) create mode 100644 .github/PULL_REQUEST_TEMPLATE.md diff --git a/.github/PULL_REQUEST_TEMPLATE.md b/.github/PULL_REQUEST_TEMPLATE.md new file mode 100644 index 000000000000..4e44771fbd25 --- /dev/null +++ b/.github/PULL_REQUEST_TEMPLATE.md @@ -0,0 +1,34 @@ + + + + +## Description + + +## Related Issue + + + + + +## Motivation and Context + + +## How Has This Been Tested? + + + + +## Types of changes + +- [ ] Bug fix (non-breaking change which fixes an issue) +- [ ] New feature (non-breaking change which adds functionality) +- [ ] Breaking change (fix or feature that would cause existing functionality to change) +- [ ] Trivial change (affects only documentation or cleanup) + +## Checklist: + + +- [ ] I have tested this change with a run of GEOSgcm (if non-trivial) +- [ ] I have added one of the required labels (0 diff, 0 diff trivial, 0 diff structural, non 0-diff) +- [ ] I have updated the CHANGELOG.md accordingly following the style of [Keep a Changelog](https://keepachangelog.com/en/1.0.0/#how) From 3fe0b2db113591cb51cce97a23eb22c7137e6bc1 Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Thu, 6 Feb 2020 13:04:51 -0500 Subject: [PATCH 019/109] Fixes #215 Updating files and correcting directory structure so that the generator script at least works on discover. Really should add proper unit tests to this so that it can be efficiently refactored as we explor uses. --- Python/MAPL_SpecsCodeGenerator.py | 23 +++---- Python/{DataSpec.py => src/MAPL_DataSpec.py} | 67 +++++++++----------- Python/src/__init__.py | 0 Python/{DataSpecsReader.py => src/reader.py} | 2 +- 4 files changed, 42 insertions(+), 50 deletions(-) rename Python/{DataSpec.py => src/MAPL_DataSpec.py} (55%) create mode 100644 Python/src/__init__.py rename Python/{DataSpecsReader.py => src/reader.py} (97%) diff --git a/Python/MAPL_SpecsCodeGenerator.py b/Python/MAPL_SpecsCodeGenerator.py index b60cc7a32d35..ce296fbc07fa 100644 --- a/Python/MAPL_SpecsCodeGenerator.py +++ b/Python/MAPL_SpecsCodeGenerator.py @@ -1,6 +1,12 @@ import argparse -import DataSpec -import DataSpecsReader +import sys +import os + +my_tool = os.path.dirname(os.path.abspath(__file__)) + '/src' +sys.path.append(my_tool) + +import MAPL_DataSpec +import reader # command line arguments parser = argparse.ArgumentParser(description='Generate import/export/internal specs for MAPL Gridded Component') @@ -15,19 +21,14 @@ f_local = open(args.declare_local,'w') f_get_pointer = open(args.get_pointer,'w') -specs = DataSpecsReader.read(args.input) +specs = reader.read_specs(args.input) for category in ('IMPORT','EXPORT','INTERNAL'): for item in specs[category].to_dict('records'): - spec = DataSpec.DataSpec(category.capitalize(), item) - f_spec.write(spec.emit_declare_spec()) - f_local.write(spec.emit_declare_local_variable()) + spec = MAPL_DataSpec.MAPL_DataSpec(category.capitalize(), item) + f_spec.write(spec.emit_spec()) + f_local.write(spec.emit_declare_local()) f_get_pointer.write(spec.emit_get_pointer()) f_spec.close() f_local.close() f_get_pointer.close() - - - - - diff --git a/Python/DataSpec.py b/Python/src/MAPL_DataSpec.py similarity index 55% rename from Python/DataSpec.py rename to Python/src/MAPL_DataSpec.py index 6acd9fa1a00d..d33e8c39c3d4 100644 --- a/Python/DataSpec.py +++ b/Python/src/MAPL_DataSpec.py @@ -1,11 +1,8 @@ -class DataSpec: +class MAPL_DataSpec: """Declare and manipulate an import/export/internal specs for a MAPL Gridded component""" - mandatory_options = ['DIMS', 'SHORT_NAME'] - # The following must be quoted when emitted as Fortran source. stringlike_options = ['SHORT_NAME', 'LONG_NAME', 'UNITS'] - # The following should NOT be quoted when emitted as Fortran source. literal_options = ['DIMS', 'VLOCATION', 'NUM_SUBTILES', 'REFRESH_INTERVAL', 'AVERAGING_INTERVAL', 'HALOWIDTH', 'PRECISION','DEFAULT','RESTART', 'UNGRIDDED_DIMS', @@ -17,66 +14,52 @@ def __init__(self, category, args, indent=3): self.category = category self.args = args self.indent = indent - self.has_condition = 'CONDITION' in self.args and DataSpec.not_empty(self.args['CONDITION']) - - def not_empty(string): - return string and not string.isspace() - def newline(self): return "\n" + " "*self.indent def continue_line(self): return "&" + self.newline() + "& " - def emit_declare_spec(self): - return self.wrap_conditional(self.emit_MAPL_AddSpec) + def emit_spec(self): + return self.emit_header() + self.emit_args() + self.emit_trailer() - def wrap_conditional(self, content_method): - text = self.newline() - if self.has_condition: - text = text + "if (" + self.args['CONDITION'] + ") then" - self.indent = self.indent + 3 - text = text + self.newline() - text = text + content_method() - if self.has_condition: - self.indent = self.indent - 3 - text = text + self.newline() - text = text + "endif" - return text + self.newline() - def get_rank(self): - gridded_ranks = {'MAPL_DimsHorzVert':3, 'MAPL_DimsHorzOnly':2, 'MAPL_DimsVertOnly':1} + ranks = {'MAPL_DimsHorzVert':3, 'MAPL_DimsHorzOnly':2, 'MAPL_DimsVertOnly':1} if 'UNGRIDDED_DIMS' in self.args: extra_dims = self.args['UNGRIDDED_DIMS'].strip('][').split(',') extra_rank = len(extra_dims) else: extra_rank = 0 - return gridded_ranks[self.args['DIMS']] + extra_rank + return ranks[self.args['DIMS']] + extra_rank - def emit_declare_local_variable(self): - return self.wrap_conditional(self.emit_MAPL_declare_local_variable) - - def emit_MAPL_declare_local_variable(self): + def emit_declare_local(self): + text = self.emit_header() type = 'real' kind = 'REAL32' rank = self.get_rank() dimension = 'dimension(:' + ',:'*(rank-1) + ')' - text = type + '(kind=' + str(kind) + '), ' + dimension + ' :: ' + self.args['LOCAL_NAME'] + ' => null()' + text = text + type + '(kind=' + str(kind) + '), ' + dimension + ' :: ' + self.args['LOCAL_NAME'] + ' => null()' + text = text + self.emit_trailer() return text def emit_get_pointer(self): - return self.wrap_conditional(self.emit_MAPL_GetPointer) - - def emit_MAPL_GetPointer(self): - text = "call MAPL_GetPointer(" + self.category + ', ' + self.args['LOCAL_NAME'] + ", '" + self.args['SHORT_NAME'] + "', rc=status); VERIFY_(status)" + text = self.emit_header() + text = text + "call MAPL_GetPointer(" + self.category + ', ' + self.args['LOCAL_NAME'] + ", '" + self.args['SHORT_NAME'] + "', rc=status); VERIFY_(status)" + text = text + self.emit_trailer() return text + def emit_header(self): + text = self.newline() + if 'CONDITION' in self.args and self.args['CONDITION']: + self.indent = self.indent + 3 + text = text + "if (" + self.args['CONDITION'] + ") then" + self.newline() + return text - def emit_MAPL_AddSpec(self): + def emit_args(self): self.indent = self.indent + 5 text = "call MAPL_Add" + self.category + "Spec(" + self.continue_line() - for option in DataSpec.all_options: + for option in MAPL_DataSpec.all_options: text = text + self.emit_arg(option) text = text + 'rc=status)' + self.newline() self.indent = self.indent - 5 @@ -88,10 +71,18 @@ def emit_arg(self, option): if option in self.args: value = self.args[option] text = text + option + "=" - if option in DataSpec.stringlike_options: + if option in MAPL_DataSpec.stringlike_options: value = "'" + value + "'" text = text + value + ", " + self.continue_line() return text + def emit_trailer(self): + if 'CONDITION' in self.args and self.args['CONDITION']: + self.indent = self.indent - 3 + text = self.newline() + text = text + "endif" + self.newline() + else: + text = self.newline() + return text diff --git a/Python/src/__init__.py b/Python/src/__init__.py new file mode 100644 index 000000000000..e69de29bb2d1 diff --git a/Python/DataSpecsReader.py b/Python/src/reader.py similarity index 97% rename from Python/DataSpecsReader.py rename to Python/src/reader.py index 2b45594cd80b..5cc938c0d323 100644 --- a/Python/DataSpecsReader.py +++ b/Python/src/reader.py @@ -1,7 +1,7 @@ import csv import pandas as pd -def read(specs_filename): +def read_specs(specs_filename): def csv_record_reader(csv_reader): """ Read a csv reader iterator until a blank line is found. """ From 26efa5b46e52904ec04cf6cae0bfdd4c457d554c Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Thu, 6 Feb 2020 13:08:58 -0500 Subject: [PATCH 020/109] The use of separate servers was not working in the stand alone tester. --- Tests/ExtDataDriverMod.F90 | 38 +++++++++++++++++++------------------- 1 file changed, 19 insertions(+), 19 deletions(-) diff --git a/Tests/ExtDataDriverMod.F90 b/Tests/ExtDataDriverMod.F90 index 2ffec2c5e3b5..da315044b89a 100644 --- a/Tests/ExtDataDriverMod.F90 +++ b/Tests/ExtDataDriverMod.F90 @@ -84,29 +84,29 @@ subroutine run(this,RC) CommCap = MPI_COMM_WORLD call this%initialize_io_clients_servers(commCap, rc = status); _VERIFY(status) - call ESMF_Initialize (vm=vm, logKindFlag=this%cap_options%esmf_logging_mode, mpiCommunicator=this%mapl_comm%esmf%comm, rc=status) - _VERIFY(STATUS) + select case(this%split_comm%get_name()) + case('model') + call ESMF_Initialize (vm=vm, logKindFlag=this%cap_options%esmf_logging_mode, mpiCommunicator=this%mapl_comm%esmf%comm, rc=status) + _VERIFY(STATUS) - config = ESMF_ConfigCreate(rc=status) - _VERIFY(status) - call ESMF_ConfigLoadFile ( config, 'CAP.rc', rc=STATUS ) - _VERIFY(status) - call ESMF_ConfigGetDim(config,lineCount,columnCount,label='CASES::',rc=status) - _VERIFY(status) - call ESMF_ConfigFindLabel(config,label='CASES::',rc=status) - _VERIFY(status) - do i=1,lineCount - call ESMF_ConfigNextLine(config,rc=status) + config = ESMF_ConfigCreate(rc=status) _VERIFY(status) - call ESMF_ConfigGetAttribute(config,ctemp,rc=status) + call ESMF_ConfigLoadFile ( config, 'CAP.rc', rc=STATUS ) + _VERIFY(status) + call ESMF_ConfigGetDim(config,lineCount,columnCount,label='CASES::',rc=status) + _VERIFY(status) + call ESMF_ConfigFindLabel(config,label='CASES::',rc=status) + _VERIFY(status) + do i=1,lineCount + call ESMF_ConfigNextLine(config,rc=status) + _VERIFY(status) + call ESMF_ConfigGetAttribute(config,ctemp,rc=status) + _VERIFY(status) + call cases%push_back(trim(ctemp)) + enddo + call ESMF_ConfigDestroy(config, rc=status) _VERIFY(status) - call cases%push_back(trim(ctemp)) - enddo - call ESMF_ConfigDestroy(config, rc=status) - _VERIFY(status) - select case(this%split_comm%get_name()) - case('model') iter = cases%begin() do while (iter /= cases%end()) From 617702c76fe56c522dce3771763f33d77dcb348c Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Thu, 6 Feb 2020 13:11:51 -0500 Subject: [PATCH 021/109] Updated CHANGELOG --- CHANGELOG.md | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 6057028fe481..1cb24cb0b9a9 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,7 +9,10 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed - Corrected handling of Equation of Time in orbit (off by default) - + +### Fixed +- Corrected Python code generator scripts for component import/export specs. + ## [2.0.0] - New IO server implemented in PFIO library. - History and ExtData component use the PFIO IO server for all file access. Default mode is to run the IO servers on the same resources as the application. From a2b3ce1340bfc109540fc2c42b3748560f4d2916 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 6 Feb 2020 13:24:03 -0500 Subject: [PATCH 022/109] Revert "Fixes #214. Create PULL_REQUEST_TEMPLATE.md" --- .github/PULL_REQUEST_TEMPLATE.md | 34 -------------------------------- 1 file changed, 34 deletions(-) delete mode 100644 .github/PULL_REQUEST_TEMPLATE.md diff --git a/.github/PULL_REQUEST_TEMPLATE.md b/.github/PULL_REQUEST_TEMPLATE.md deleted file mode 100644 index 4e44771fbd25..000000000000 --- a/.github/PULL_REQUEST_TEMPLATE.md +++ /dev/null @@ -1,34 +0,0 @@ - - - - -## Description - - -## Related Issue - - - - - -## Motivation and Context - - -## How Has This Been Tested? - - - - -## Types of changes - -- [ ] Bug fix (non-breaking change which fixes an issue) -- [ ] New feature (non-breaking change which adds functionality) -- [ ] Breaking change (fix or feature that would cause existing functionality to change) -- [ ] Trivial change (affects only documentation or cleanup) - -## Checklist: - - -- [ ] I have tested this change with a run of GEOSgcm (if non-trivial) -- [ ] I have added one of the required labels (0 diff, 0 diff trivial, 0 diff structural, non 0-diff) -- [ ] I have updated the CHANGELOG.md accordingly following the style of [Keep a Changelog](https://keepachangelog.com/en/1.0.0/#how) From b6c4c2e7248bc79c49cd51df0ae55659cb98c14d Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Fri, 7 Feb 2020 12:49:19 -0500 Subject: [PATCH 023/109] Add line to CHANGELOG about mepo --- CHANGELOG.md | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 507709bfc3db..76f3aac55064 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -8,10 +8,13 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ## [Unreleased] ### Changed + - Corrected handling of Equation of Time in orbit (off by default) ### Fixed -- Corrected Python code generator scripts for component import/export specs. + +- Corrected Python code generator scripts for component import/export specs. +- Add directories to `.gitignore` for building with `mepo` ## [2.0.0] - 2019-02-07 From af5bb69604465c24d3fb338385bcb9aa40090cba Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 10 Feb 2020 08:36:30 -0500 Subject: [PATCH 024/109] Fixes #227. Remove CVS Keywords --- GMAO_pFIO/new_overload.macro | 1 - GMAO_pFIO/pFIO_ErrLog.h | 1 - MAPL_Base/ESMFL_Mod.F90 | 1 - MAPL_Base/MAPL_Base.F90 | 1 - MAPL_Base/MAPL_CFIO.F90 | 1 - MAPL_Base/MAPL_Comms.F90 | 1 - MAPL_Base/MAPL_Constants.F90 | 1 - MAPL_Base/MAPL_ErrLog.h | 1 - MAPL_Base/MAPL_ErrLogMain.h | 1 - MAPL_Base/MAPL_Generic.F90 | 1 - MAPL_Base/MAPL_GenericCplComp.F90 | 1 - MAPL_Base/MAPL_Hash.F90 | 1 - MAPL_Base/MAPL_HeapMod.F90 | 1 - MAPL_Base/MAPL_HistoryGridComp.F90 | 1 - MAPL_Base/MAPL_IO.F90 | 1 - MAPL_Base/MAPL_LocStreamMod.F90 | 1 - MAPL_Base/MAPL_Mod.F90 | 1 - MAPL_Base/MAPL_NominalOrbitsMod.F90 | 1 - MAPL_Base/MAPL_Profiler.F90 | 1 - MAPL_Base/MAPL_SatVapor.F90 | 1 - MAPL_Base/MAPL_Sort.F90 | 1 - MAPL_Base/MAPL_VarSpecMod.F90 | 1 - MAPL_Base/MAPL_sun_uc.F90 | 1 - MAPL_Base/allgather.H | 1 - MAPL_Base/allgatherv.H | 1 - MAPL_Base/allreducemax.H | 1 - MAPL_Base/allreducemin.H | 1 - MAPL_Base/allreducesum.H | 1 - MAPL_Base/arraygather.H | 1 - MAPL_Base/arraygatherRcvCnt.H | 1 - MAPL_Base/arrayscatter.H | 1 - MAPL_Base/arrayscatterRcvCnt.H | 1 - MAPL_Base/bcast.H | 1 - MAPL_Base/gather.H | 1 - MAPL_Base/hash.c | 19 +++++++++---------- MAPL_Base/overload.macro | 1 - MAPL_Base/read_parallel.H | 1 - MAPL_Base/recv.H | 1 - MAPL_Base/scatter.H | 1 - MAPL_Base/send.H | 1 - MAPL_Base/sendrecv.H | 1 - MAPL_Base/sun.H | 1 - MAPL_Base/write_parallel.H | 1 - 43 files changed, 9 insertions(+), 52 deletions(-) diff --git a/GMAO_pFIO/new_overload.macro b/GMAO_pFIO/new_overload.macro index 5e1e1be2626e..dd7f84d3f35e 100644 --- a/GMAO_pFIO/new_overload.macro +++ b/GMAO_pFIO/new_overload.macro @@ -1,4 +1,3 @@ -! $Id$ #ifdef _TYPE #undef _TYPE diff --git a/GMAO_pFIO/pFIO_ErrLog.h b/GMAO_pFIO/pFIO_ErrLog.h index b2a1ee661e2c..8dd96e78b5ba 100644 --- a/GMAO_pFIO/pFIO_ErrLog.h +++ b/GMAO_pFIO/pFIO_ErrLog.h @@ -1,5 +1,4 @@ -! $Id$ ! The error logging may eventually evolve into a module based ! on the ESMF logger. For now these macros provide simple diff --git a/MAPL_Base/ESMFL_Mod.F90 b/MAPL_Base/ESMFL_Mod.F90 index 1817ba2e7115..ac4d8414bdd5 100644 --- a/MAPL_Base/ESMFL_Mod.F90 +++ b/MAPL_Base/ESMFL_Mod.F90 @@ -1,4 +1,3 @@ -! $Id$ #include "MAPL_ErrLog.h" #if 0 diff --git a/MAPL_Base/MAPL_Base.F90 b/MAPL_Base/MAPL_Base.F90 index aabd344d7f12..5b31494511e3 100644 --- a/MAPL_Base/MAPL_Base.F90 +++ b/MAPL_Base/MAPL_Base.F90 @@ -1,4 +1,3 @@ -! $Id$ #include "MAPL_ErrLog.h" #include "unused_dummy.H" diff --git a/MAPL_Base/MAPL_CFIO.F90 b/MAPL_Base/MAPL_CFIO.F90 index 773ffa850202..50e4005fb4b3 100644 --- a/MAPL_Base/MAPL_CFIO.F90 +++ b/MAPL_Base/MAPL_CFIO.F90 @@ -1,4 +1,3 @@ -! $Id$ #include "MAPL_Generic.h" #define MPI_NULL_TAG 99 diff --git a/MAPL_Base/MAPL_Comms.F90 b/MAPL_Base/MAPL_Comms.F90 index 436a6084cfd4..5f861e65c48a 100644 --- a/MAPL_Base/MAPL_Comms.F90 +++ b/MAPL_Base/MAPL_Comms.F90 @@ -1,5 +1,4 @@ -! $Id$ #include "MAPL_ErrLog.h" diff --git a/MAPL_Base/MAPL_Constants.F90 b/MAPL_Base/MAPL_Constants.F90 index c796a963c015..fb70c5c691b2 100644 --- a/MAPL_Base/MAPL_Constants.F90 +++ b/MAPL_Base/MAPL_Constants.F90 @@ -1,6 +1,5 @@ module MAPL_ConstantsMod -! $Id$ use, intrinsic :: iso_fortran_env, only: REAL64, REAL32 implicit none private diff --git a/MAPL_Base/MAPL_ErrLog.h b/MAPL_Base/MAPL_ErrLog.h index 53a5ec4930c9..342163792afe 100644 --- a/MAPL_Base/MAPL_ErrLog.h +++ b/MAPL_Base/MAPL_ErrLog.h @@ -1,5 +1,4 @@ -! $Id$ ! The error logging may eventually evolve into a module based ! on the ESMF logger. For now these macros provide simple diff --git a/MAPL_Base/MAPL_ErrLogMain.h b/MAPL_Base/MAPL_ErrLogMain.h index 0c5008b6e68f..6c9bcf9d273f 100644 --- a/MAPL_Base/MAPL_ErrLogMain.h +++ b/MAPL_Base/MAPL_ErrLogMain.h @@ -1,5 +1,4 @@ -! $Id$ ! The error logging may eventually evolve into a module based ! on the ESMF logger. For now these macros provide simple diff --git a/MAPL_Base/MAPL_Generic.F90 b/MAPL_Base/MAPL_Generic.F90 index 52a394c75c6f..9e80dc6a4a41 100644 --- a/MAPL_Base/MAPL_Generic.F90 +++ b/MAPL_Base/MAPL_Generic.F90 @@ -1,4 +1,3 @@ -! $Id$ #include "MAPL_ErrLog.h" #define GET_POINTER ESMFL_StateGetPointerToData diff --git a/MAPL_Base/MAPL_GenericCplComp.F90 b/MAPL_Base/MAPL_GenericCplComp.F90 index e5965be04f93..c92838a21d9a 100644 --- a/MAPL_Base/MAPL_GenericCplComp.F90 +++ b/MAPL_Base/MAPL_GenericCplComp.F90 @@ -1,4 +1,3 @@ -! $Id$ #include "MAPL_Generic.h" #include "unused_dummy.H" diff --git a/MAPL_Base/MAPL_Hash.F90 b/MAPL_Base/MAPL_Hash.F90 index 174cf495932e..4fb326a73567 100644 --- a/MAPL_Base/MAPL_Hash.F90 +++ b/MAPL_Base/MAPL_Hash.F90 @@ -3,7 +3,6 @@ #include "MAPL_ErrLog.h" -! $Id$ !============================================================================= !BOP diff --git a/MAPL_Base/MAPL_HeapMod.F90 b/MAPL_Base/MAPL_HeapMod.F90 index c81cd8beefdf..15bd36c45872 100644 --- a/MAPL_Base/MAPL_HeapMod.F90 +++ b/MAPL_Base/MAPL_HeapMod.F90 @@ -1,5 +1,4 @@ -! $Id$ #include "MAPL_ErrLog.h" #define ADDRS_POSITION 1 diff --git a/MAPL_Base/MAPL_HistoryGridComp.F90 b/MAPL_Base/MAPL_HistoryGridComp.F90 index 514fc0b74d00..c7872c38e625 100644 --- a/MAPL_Base/MAPL_HistoryGridComp.F90 +++ b/MAPL_Base/MAPL_HistoryGridComp.F90 @@ -1,4 +1,3 @@ -! $Id$ #include "MAPL_Generic.h" #include "unused_dummy.H" diff --git a/MAPL_Base/MAPL_IO.F90 b/MAPL_Base/MAPL_IO.F90 index 88c18a10dc39..1d864b31394b 100644 --- a/MAPL_Base/MAPL_IO.F90 +++ b/MAPL_Base/MAPL_IO.F90 @@ -1,4 +1,3 @@ -! $Id$ #include "MAPL_ErrLog.h" #define DEALOC_(A) if(associated(A))then;if(MAPL_ShmInitialized)then;call MAPL_SyncSharedMemory(rc=STATUS);call MAPL_DeAllocNodeArray(A,rc=STATUS);else;deallocate(A,stat=STATUS);endif;_VERIFY(STATUS);NULLIFY(A);endif diff --git a/MAPL_Base/MAPL_LocStreamMod.F90 b/MAPL_Base/MAPL_LocStreamMod.F90 index 80b5f707667f..b20320075f45 100644 --- a/MAPL_Base/MAPL_LocStreamMod.F90 +++ b/MAPL_Base/MAPL_LocStreamMod.F90 @@ -1,4 +1,3 @@ -! $Id$ #include "MAPL_ErrLog.h" diff --git a/MAPL_Base/MAPL_Mod.F90 b/MAPL_Base/MAPL_Mod.F90 index 47ddd4250e47..e4c83eff5434 100644 --- a/MAPL_Base/MAPL_Mod.F90 +++ b/MAPL_Base/MAPL_Mod.F90 @@ -1,4 +1,3 @@ -! $Id$ module MAPL_Mod diff --git a/MAPL_Base/MAPL_NominalOrbitsMod.F90 b/MAPL_Base/MAPL_NominalOrbitsMod.F90 index 9d83f79c7c3b..ad1b020d335e 100644 --- a/MAPL_Base/MAPL_NominalOrbitsMod.F90 +++ b/MAPL_Base/MAPL_NominalOrbitsMod.F90 @@ -1,4 +1,3 @@ -! $Id$ #include "unused_dummy.H" MODULE MAPL_NominalOrbitsMod IMPLICIT NONE diff --git a/MAPL_Base/MAPL_Profiler.F90 b/MAPL_Base/MAPL_Profiler.F90 index 65cb28b8e0cc..2214ffca5dc5 100644 --- a/MAPL_Base/MAPL_Profiler.F90 +++ b/MAPL_Base/MAPL_Profiler.F90 @@ -1,5 +1,4 @@ -! $Id$ #include "MAPL_ErrLog.h" diff --git a/MAPL_Base/MAPL_SatVapor.F90 b/MAPL_Base/MAPL_SatVapor.F90 index 2bbedb5d14dc..30a83bd86bc4 100644 --- a/MAPL_Base/MAPL_SatVapor.F90 +++ b/MAPL_Base/MAPL_SatVapor.F90 @@ -1,5 +1,4 @@ -! $Id$ module MAPL_SatVaporMod diff --git a/MAPL_Base/MAPL_Sort.F90 b/MAPL_Base/MAPL_Sort.F90 index 8ebeeb0b1f5c..aef0d3a1c312 100644 --- a/MAPL_Base/MAPL_Sort.F90 +++ b/MAPL_Base/MAPL_Sort.F90 @@ -1,7 +1,6 @@ #include "MAPL_ErrLog.h" -! $Id$ !============================================================================= !BOP diff --git a/MAPL_Base/MAPL_VarSpecMod.F90 b/MAPL_Base/MAPL_VarSpecMod.F90 index 85570ec61b44..3c5a89cee2fa 100644 --- a/MAPL_Base/MAPL_VarSpecMod.F90 +++ b/MAPL_Base/MAPL_VarSpecMod.F90 @@ -1,4 +1,3 @@ -! $Id$ #include "MAPL_ErrLog.h" diff --git a/MAPL_Base/MAPL_sun_uc.F90 b/MAPL_Base/MAPL_sun_uc.F90 index 18b515f7d55d..cb8552b8bfd6 100644 --- a/MAPL_Base/MAPL_sun_uc.F90 +++ b/MAPL_Base/MAPL_sun_uc.F90 @@ -1,4 +1,3 @@ -! $Id$ #include "MAPL_ErrLog.h" diff --git a/MAPL_Base/allgather.H b/MAPL_Base/allgather.H index 3ab536b8faf5..d0066ff4be3f 100644 --- a/MAPL_Base/allgather.H +++ b/MAPL_Base/allgather.H @@ -1,4 +1,3 @@ -! $Id$ #ifdef NAME_ #undef NAME_ diff --git a/MAPL_Base/allgatherv.H b/MAPL_Base/allgatherv.H index 780026fda558..2aa475833405 100644 --- a/MAPL_Base/allgatherv.H +++ b/MAPL_Base/allgatherv.H @@ -1,4 +1,3 @@ -! $Id$ #ifdef NAME_ #undef NAME_ diff --git a/MAPL_Base/allreducemax.H b/MAPL_Base/allreducemax.H index ef565dc435fa..ce991bafbf10 100755 --- a/MAPL_Base/allreducemax.H +++ b/MAPL_Base/allreducemax.H @@ -1,4 +1,3 @@ -! $Id$ #ifdef NAME_ #undef NAME_ diff --git a/MAPL_Base/allreducemin.H b/MAPL_Base/allreducemin.H index 212ae2e14dcf..3e7cb4366e06 100755 --- a/MAPL_Base/allreducemin.H +++ b/MAPL_Base/allreducemin.H @@ -1,4 +1,3 @@ -! $Id$ #ifdef NAME_ #undef NAME_ diff --git a/MAPL_Base/allreducesum.H b/MAPL_Base/allreducesum.H index 8995394c7661..1cbeed251b3b 100755 --- a/MAPL_Base/allreducesum.H +++ b/MAPL_Base/allreducesum.H @@ -1,4 +1,3 @@ -! $Id$ #ifdef NAME_ #undef NAME_ diff --git a/MAPL_Base/arraygather.H b/MAPL_Base/arraygather.H index dc086a22fe16..26a94ee48064 100644 --- a/MAPL_Base/arraygather.H +++ b/MAPL_Base/arraygather.H @@ -1,4 +1,3 @@ -! $Id$ #ifdef NAME_ #undef NAME_ diff --git a/MAPL_Base/arraygatherRcvCnt.H b/MAPL_Base/arraygatherRcvCnt.H index 182cf9d08d97..6f52b1627e38 100644 --- a/MAPL_Base/arraygatherRcvCnt.H +++ b/MAPL_Base/arraygatherRcvCnt.H @@ -1,4 +1,3 @@ -! $Id$ #ifdef NAME_ #undef NAME_ diff --git a/MAPL_Base/arrayscatter.H b/MAPL_Base/arrayscatter.H index 4e9558acc271..3b32f69d5cc7 100644 --- a/MAPL_Base/arrayscatter.H +++ b/MAPL_Base/arrayscatter.H @@ -1,4 +1,3 @@ -! $Id$ #ifdef NAME_ #undef NAME_ diff --git a/MAPL_Base/arrayscatterRcvCnt.H b/MAPL_Base/arrayscatterRcvCnt.H index 967d61e2c7f4..a9c372d59556 100644 --- a/MAPL_Base/arrayscatterRcvCnt.H +++ b/MAPL_Base/arrayscatterRcvCnt.H @@ -1,4 +1,3 @@ -! $Id$ #ifdef NAME_ #undef NAME_ diff --git a/MAPL_Base/bcast.H b/MAPL_Base/bcast.H index 4dec82d9a471..6be76af425a1 100644 --- a/MAPL_Base/bcast.H +++ b/MAPL_Base/bcast.H @@ -1,4 +1,3 @@ -! $Id$ #ifdef NAME_ #undef NAME_ diff --git a/MAPL_Base/gather.H b/MAPL_Base/gather.H index 21a4ce9b4290..b525601dca4f 100644 --- a/MAPL_Base/gather.H +++ b/MAPL_Base/gather.H @@ -1,4 +1,3 @@ -! $Id$ #ifdef NAME_ #undef NAME_ diff --git a/MAPL_Base/hash.c b/MAPL_Base/hash.c index db1a436689e7..983f0d0f680e 100644 --- a/MAPL_Base/hash.c +++ b/MAPL_Base/hash.c @@ -1,5 +1,4 @@ -// $Id$ #ifndef sysAIX #include @@ -39,7 +38,7 @@ void init_hash(hash_t *h, int nbuckets) { h->bucket_list = (bucket_t *)malloc((size_t)(nbuckets*sizeof(bucket_t))); if(!h->bucket_list) { - printf("hash.c $Name$ line=%d : Could not allocate bucket list\n",__LINE__); + printf("hash.c line=%d : Could not allocate bucket list\n",__LINE__); exit(1); } for(l=0; lnext_entry = 0; b->entry_list = (entry_t *)malloc((size_t)(b->size*sizeof(entry_t))); if(!b->entry_list) { - printf("hash.c $Name$ line=%d : Could not allocate entry list\n",__LINE__); + printf("hash.c line=%d : Could not allocate entry list\n",__LINE__); exit(1); } } @@ -72,7 +71,7 @@ int create_hash(int nbuckets) if(!hash_heap) { hash_heap = (hash_t *)malloc(hash_heap_size*sizeof(hash_t)); if(!hash_heap) { - printf("hash.c $Name$ line=%d : Could not allocate hash_heap\n",__LINE__); + printf("hash.c line=%d : Could not allocate hash_heap\n",__LINE__); exit(1); } for(i=0;ientry_list = (entry_t *)realloc(bucket->entry_list,sizeof(entry_t)*bucket->size); if(!bucket->entry_list) { - printf("hash.c $Name$ %d : Could not reallocate entry list\n",__LINE__); + printf("hash.c line=%d : Could not reallocate entry list\n",__LINE__); exit(1); } } diff --git a/MAPL_Base/overload.macro b/MAPL_Base/overload.macro index 676c618493ea..d3631419848f 100755 --- a/MAPL_Base/overload.macro +++ b/MAPL_Base/overload.macro @@ -1,4 +1,3 @@ -! $Id$ #ifdef TYPE_ #undef TYPE_ diff --git a/MAPL_Base/read_parallel.H b/MAPL_Base/read_parallel.H index 7cdef78ea7ce..d0350df23b3a 100644 --- a/MAPL_Base/read_parallel.H +++ b/MAPL_Base/read_parallel.H @@ -1,4 +1,3 @@ -! $Id$ #ifdef NAME_ #undef NAME_ diff --git a/MAPL_Base/recv.H b/MAPL_Base/recv.H index 0a0144792685..74af62acb51b 100644 --- a/MAPL_Base/recv.H +++ b/MAPL_Base/recv.H @@ -1,4 +1,3 @@ -! $Id$ #ifdef NAME_ #undef NAME_ diff --git a/MAPL_Base/scatter.H b/MAPL_Base/scatter.H index 77aeb1d29537..6f8a10970eb0 100644 --- a/MAPL_Base/scatter.H +++ b/MAPL_Base/scatter.H @@ -1,4 +1,3 @@ -! $Id$ #ifdef NAME_ #undef NAME_ diff --git a/MAPL_Base/send.H b/MAPL_Base/send.H index ccd733dd0ad1..cd5c3ccc7cc7 100644 --- a/MAPL_Base/send.H +++ b/MAPL_Base/send.H @@ -1,4 +1,3 @@ -! $Id$ #ifdef NAME_ #undef NAME_ diff --git a/MAPL_Base/sendrecv.H b/MAPL_Base/sendrecv.H index 1402c11291a8..5a325dd9a2fd 100644 --- a/MAPL_Base/sendrecv.H +++ b/MAPL_Base/sendrecv.H @@ -1,4 +1,3 @@ -! $Id$ #ifdef NAME_ #undef NAME_ diff --git a/MAPL_Base/sun.H b/MAPL_Base/sun.H index 3c3fba4284b5..203c608c2526 100644 --- a/MAPL_Base/sun.H +++ b/MAPL_Base/sun.H @@ -1,4 +1,3 @@ -! $Id$ type(MAPL_SunOrbit), intent(IN ) :: ORBIT diff --git a/MAPL_Base/write_parallel.H b/MAPL_Base/write_parallel.H index 9c5f3314fb7b..34522e856f2a 100644 --- a/MAPL_Base/write_parallel.H +++ b/MAPL_Base/write_parallel.H @@ -1,4 +1,3 @@ -! $Id$ #ifdef NAME_ #undef NAME_ From 6472d68e4521c2b824aa55a7aa6f387a9e63dd8d Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 10 Feb 2020 12:12:52 -0500 Subject: [PATCH 025/109] Fix for mixed compiler build On the GMAO desktop, an Intel Fortran flag was leaking into GCC. This fixes it for me by passing that flag only to Fortran files. --- MAPL_Base/CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/MAPL_Base/CMakeLists.txt b/MAPL_Base/CMakeLists.txt index 99f3e9ce4aeb..a3b7b39d44ec 100644 --- a/MAPL_Base/CMakeLists.txt +++ b/MAPL_Base/CMakeLists.txt @@ -66,7 +66,7 @@ set (srcs esma_add_library(${this} SRCS ${srcs} DEPENDENCIES GMAO_pFIO MAPL_cfio_r4 gftl-shared FLAP::FLAP MPI::MPI_Fortran) target_compile_options (${this} PRIVATE $<$:${OpenMP_Fortran_FLAGS}>) if(DISABLE_GLOBAL_NAME_WARNING) - set_target_properties (${this} PROPERTIES COMPILE_FLAGS ${DISABLE_GLOBAL_NAME_WARNING}) + target_compile_options (${this} PRIVATE $<$:${DISABLE_GLOBAL_NAME_WARNING}>) endif() target_compile_definitions (${this} PRIVATE TWO_SIDED_COMM MAPL_MODE) From dad060ed2fad78c70c17cd0899ee13954bb569e7 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 10 Feb 2020 12:16:04 -0500 Subject: [PATCH 026/109] Update CHANGELOG --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 76f3aac55064..9ba784431b9a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -15,6 +15,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Corrected Python code generator scripts for component import/export specs. - Add directories to `.gitignore` for building with `mepo` +- Bug building with mixed Intel/GCC compilers ## [2.0.0] - 2019-02-07 From 56ca6c12757932251cda0d41589c54445c50ca00 Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Tue, 11 Feb 2020 09:31:47 -0500 Subject: [PATCH 027/109] Updated version of ACG in python. 1. Renamed top level script. 2. Added WARNING message to top of generated files. 3. Updated conventions for separating and naming columns. Not quite done, but usable as is. --- ...Generator.py => MAPL_GridCompSpecs_ACG.py} | 26 +++++++++- Python/src/.gitignore | 2 + Python/src/MAPL_DataSpec.py | 16 +++---- Python/src/reader.py | 48 +++++++++++++++---- 4 files changed, 73 insertions(+), 19 deletions(-) rename Python/{MAPL_SpecsCodeGenerator.py => MAPL_GridCompSpecs_ACG.py} (60%) create mode 100644 Python/src/.gitignore diff --git a/Python/MAPL_SpecsCodeGenerator.py b/Python/MAPL_GridCompSpecs_ACG.py similarity index 60% rename from Python/MAPL_SpecsCodeGenerator.py rename to Python/MAPL_GridCompSpecs_ACG.py index ce296fbc07fa..d6db70a00792 100644 --- a/Python/MAPL_SpecsCodeGenerator.py +++ b/Python/MAPL_GridCompSpecs_ACG.py @@ -17,14 +17,31 @@ args = parser.parse_args() -f_spec = open(args.declare_specs,'w') +f_spec = open(args.declare_specs,'w') f_local = open(args.declare_local,'w') f_get_pointer = open(args.get_pointer,'w') +def header(): + return """ +! ------------------- +! W A R N I N G +! ------------------- +! +! This code fragment is automatically generated by a MAPL_GridCompSpecs_ACG. +! Please DO NOT edit it. Any modification made in here will be overwritten +! next time this file is auto-generated. Instead, enter your additions +! or deletions in the .rc file in the src tree. +! + """ + +f_spec.write(header()) +f_local.write(header()) +f_get_pointer.write(header()) + specs = reader.read_specs(args.input) for category in ('IMPORT','EXPORT','INTERNAL'): for item in specs[category].to_dict('records'): - spec = MAPL_DataSpec.MAPL_DataSpec(category.capitalize(), item) + spec = MAPL_DataSpec.MAPL_DataSpec(category.lower(), item) f_spec.write(spec.emit_spec()) f_local.write(spec.emit_declare_local()) f_get_pointer.write(spec.emit_get_pointer()) @@ -32,3 +49,8 @@ f_spec.close() f_local.close() f_get_pointer.close() + + + + + diff --git a/Python/src/.gitignore b/Python/src/.gitignore new file mode 100644 index 000000000000..2f78cf5b6651 --- /dev/null +++ b/Python/src/.gitignore @@ -0,0 +1,2 @@ +*.pyc + diff --git a/Python/src/MAPL_DataSpec.py b/Python/src/MAPL_DataSpec.py index d33e8c39c3d4..40ac5dd59270 100644 --- a/Python/src/MAPL_DataSpec.py +++ b/Python/src/MAPL_DataSpec.py @@ -2,11 +2,11 @@ class MAPL_DataSpec: """Declare and manipulate an import/export/internal specs for a MAPL Gridded component""" - stringlike_options = ['SHORT_NAME', 'LONG_NAME', 'UNITS'] - literal_options = ['DIMS', 'VLOCATION', 'NUM_SUBTILES', - 'REFRESH_INTERVAL', 'AVERAGING_INTERVAL', 'HALOWIDTH', - 'PRECISION','DEFAULT','RESTART', 'UNGRIDDED_DIMS', - 'FIELD_TYPE', 'STAGGERING', 'ROTATION'] + stringlike_options = ['short_name', 'long_name', 'units'] + literal_options = ['dims', 'vlocation', 'num_subtiles', + 'refresh_interval', 'averaging_interval', 'halowidth', + 'precision','default','restart', 'ungridded_dims', + 'field_type', 'staggering', 'rotation'] all_options = stringlike_options + literal_options @@ -31,7 +31,7 @@ def get_rank(self): extra_rank = len(extra_dims) else: extra_rank = 0 - return ranks[self.args['DIMS']] + extra_rank + return ranks[self.args['dims']] + extra_rank def emit_declare_local(self): text = self.emit_header() @@ -39,13 +39,13 @@ def emit_declare_local(self): kind = 'REAL32' rank = self.get_rank() dimension = 'dimension(:' + ',:'*(rank-1) + ')' - text = text + type + '(kind=' + str(kind) + '), ' + dimension + ' :: ' + self.args['LOCAL_NAME'] + ' => null()' + text = text + type + '(kind=' + str(kind) + '), ' + dimension + ' :: ' + self.args['short_name'] + ' => null()' text = text + self.emit_trailer() return text def emit_get_pointer(self): text = self.emit_header() - text = text + "call MAPL_GetPointer(" + self.category + ', ' + self.args['LOCAL_NAME'] + ", '" + self.args['SHORT_NAME'] + "', rc=status); VERIFY_(status)" + text = text + "call MAPL_GetPointer(" + self.category + ', ' + self.args['short_name'] + ", '" + self.args['short_name'] + "', rc=status); VERIFY_(status)" text = text + self.emit_trailer() return text diff --git a/Python/src/reader.py b/Python/src/reader.py index 5cc938c0d323..396b0eff0497 100644 --- a/Python/src/reader.py +++ b/Python/src/reader.py @@ -10,28 +10,58 @@ def csv_record_reader(csv_reader): if not (len(row) == 0): if row[0].startswith('#'): continue - yield row + yield [cell.strip() for cell in row] prev_row_blank = False elif not prev_row_blank: return + column_aliases = { + 'NAME' : 'short_name', + 'LONG NAME' : 'long_name', + 'VLOC' : 'vlocation', + 'UNITS' : 'units', + 'DIMS' : 'dims', + 'UNGRIDDED' : 'ungridded_dims', + 'COND' : 'condition' + } + specs = {} with open(specs_filename, 'r') as specs_file: - specs_reader = csv.reader(specs_file, skipinitialspace=True) + specs_reader = csv.reader(specs_file, skipinitialspace=True,delimiter='|') + gen = csv_record_reader(specs_reader) + schema_version = next(gen)[0] + print("version: ",schema_version) + component = next(gen)[0] + print("component: ",component) while True: try: gen = csv_record_reader(specs_reader) - category = next(gen)[0] - columns = next(gen) + category = next(gen)[0].split()[1] + bare_columns = next(gen) + bare_columns = [c.strip() for c in bare_columns] + columns = [] + for c in bare_columns: + if c in column_aliases: + columns.append(column_aliases[c]) + else: + columns.append(c) specs[category] = pd.DataFrame(gen, columns=columns) except StopIteration: break - if '*ALIASES*' in specs: - for alias in specs['*ALIASES*'].to_dict('records'): - specs['IMPORT'].replace({alias['OPTION']:{alias['ALIAS']:alias['VALUE']}},inplace=True) - specs['EXPORT'].replace({alias['OPTION']:{alias['ALIAS']:alias['VALUE']}},inplace=True) - specs['INTERNAL'].replace({alias['OPTION']:{alias['ALIAS']:alias['VALUE']}},inplace=True) + entry_aliases = {'z' : 'MAPL_DimsVertOnly', + 'z*' : 'MAPL_DimsVertOnly', + 'xy' : 'MAPL_DimsHorzOnly', + 'xy*' : 'MAPL_DimsHorzOnly', + 'xyz' : 'MAPL_DimsHorzVert', + 'xyz*' : 'MAPL_DimsHorzVert', + 'C' : 'MAPL_VlocationCenter', + 'E' : 'MAPL_VlocationEdge' + } + + specs['IMPORT'].replace(entry_aliases,inplace=True) + specs['EXPORT'].replace(entry_aliases,inplace=True) + specs['INTERNAL'].replace(entry_aliases,inplace=True) return specs From 593258056b70962ca649a51b0e5ef63d63b3b472 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 18 Feb 2020 10:14:32 -0500 Subject: [PATCH 028/109] Fixes #234. Update ASSERT in MAPL_ExtDataGridComp I am not sure if I got this right. @mmanyin had: ```fortran _ASSERT(associated(var),"Variable "//TRIM(item%var)//" not found in file "//TRIM(file)) ``` but I'm pretty sure it should be `item%file` given some of the other `_ASSERT()` in this module. Also, I changed the `_ASSERT()` in three places since the message looked to be generic. But, I might not have gotten the variable name variables correct. @bena-nasa can double-check --- MAPL_Base/MAPL_ExtDataGridCompMod.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/MAPL_Base/MAPL_ExtDataGridCompMod.F90 b/MAPL_Base/MAPL_ExtDataGridCompMod.F90 index 3311b8b0968a..9d6d71000cb7 100644 --- a/MAPL_Base/MAPL_ExtDataGridCompMod.F90 +++ b/MAPL_Base/MAPL_ExtDataGridCompMod.F90 @@ -2227,13 +2227,13 @@ subroutine GetLevs(item, time, allowExtrap, rc) var => null() if (item%isVector) then var=>metadata%get_variable(trim(item%fcomp1)) - _ASSERT(associated(var),"Variable not found in file") + _ASSERT(associated(var),"Variable "//TRIM(item%fcomp1)//" not found in file "//TRIM(item%file)) var => null() var=>metadata%get_variable(trim(item%fcomp2)) - _ASSERT(associated(var),"Variable not found in file") + _ASSERT(associated(var),"Variable "//TRIM(item%fcomp2)//" not found in file "//TRIM(item%file)) else var=>metadata%get_variable(trim(item%var)) - _ASSERT(associated(var),"Variable not found in file") + _ASSERT(associated(var),"Variable "//TRIM(item%var)//" not found in file "//TRIM(item%file)) end if levName = metadata%get_level_name(rc=status) From e2e2dcfc0ef3839e7937720d0164c584b12b967a Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 18 Feb 2020 10:17:55 -0500 Subject: [PATCH 029/109] Update CHANGELOG.md --- CHANGELOG.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 76f3aac55064..a69276fb0573 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -10,7 +10,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed - Corrected handling of Equation of Time in orbit (off by default) - +- Made ASSERT in ExtData more explicit in case of missing variables. + ### Fixed - Corrected Python code generator scripts for component import/export specs. From 92f75bba9a08dcaa517026afc6804fd881469124 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 18 Feb 2020 11:30:19 -0500 Subject: [PATCH 030/109] Update CHANGELOG.md --- CHANGELOG.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 76f3aac55064..94facb91ab56 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -10,7 +10,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Changed - Corrected handling of Equation of Time in orbit (off by default) - +- Removed CVS keywords + ### Fixed - Corrected Python code generator scripts for component import/export specs. From 5edefe5355f4bf86392465399110cf40f6f454a6 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 18 Feb 2020 17:57:33 -0500 Subject: [PATCH 031/109] When the stepping it not controlled by the cap itself (like when using the NUOPC wrapper or JEDI) the throughput timer was broken. This is because they were relying on a timer in the method that loops in the cap. If running with nuopc this is never initialized. Add a flag to record it was intialized. If not initialize it. --- MAPL_Base/MAPL_CapGridComp.F90 | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/MAPL_Base/MAPL_CapGridComp.F90 b/MAPL_Base/MAPL_CapGridComp.F90 index 926c8b20ba08..8c00d394abad 100644 --- a/MAPL_Base/MAPL_CapGridComp.F90 +++ b/MAPL_Base/MAPL_CapGridComp.F90 @@ -42,7 +42,7 @@ module MAPL_CapGridCompMod type (MAPL_Communicators) :: mapl_comm !!$ integer :: mapl_comm integer :: nsteps, heartbeat_dt, perpetual_year, perpetual_month, perpetual_day - logical :: amiroot, lperp + logical :: amiroot, lperp, started_loop_timer integer :: extdata_id, history_id, root_id, printspec type(ESMF_Clock) :: clock, clock_hist type(ESMF_Config) :: cf_ext, cf_root, cf_hist, config @@ -360,6 +360,7 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) call MAPL_TimerModeSet(timerMode, RC=status) _VERIFY(status) end if + cap%started_loop_timer=.false. enableMemUtils = ESMF_UtilStringUpperCase(enableMemUtils, rc=STATUS) _VERIFY(STATUS) @@ -985,6 +986,7 @@ subroutine run_MAPL_GridComp(gc, rc) call ESMF_VMBarrier(cap%vm,rc=status) _VERIFY(status) cap%loop_start_timer = MPI_WTime(status) + cap%started_loop_timer = .true. TIME_LOOP: do n = 1, cap%nsteps call MAPL_MemUtilsWrite(cap%vm, 'MAPL_Cap:TimeLoop', rc = status) @@ -1028,6 +1030,10 @@ subroutine step(this, rc) call ESMF_GridCompGet(this%gc, vm = this%vm) + if (.not.this%started_loop_timer) then + this%loop_start_timer = MPI_WTime(status) + this%started_loop_timer=.true. + end if start_timer = MPI_Wtime(status) ! Run the ExtData Component ! -------------------------- @@ -1122,9 +1128,9 @@ subroutine step(this, rc) call MAPL_MemCommited ( mem_total, mem_commit, mem_percent, RC=STATUS ) _VERIFY(STATUS) - if( mapl_am_I_Root(this%vm) ) write(6,1000) AGCM_YY,AGCM_MM,AGCM_DD,AGCM_H,AGCM_M,AGCM_S,& + if( mapl_am_I_Root(this%vm) ) write(6,1000) trim(ESMF_UtilStringUpperCase(this%name)),AGCM_YY,AGCM_MM,AGCM_DD,AGCM_H,AGCM_M,AGCM_S,& LOOP_THROUGHPUT,INST_THROUGHPUT,RUN_THROUGHPUT,HRS_R,MIN_R,SEC_R,mem_percent - 1000 format(1x,'AGCM Date: ',i4.4,'/',i2.2,'/',i2.2,2x,'Time: ',i2.2,':',i2.2,':',i2.2, & + 1000 format(1x,a,' Date: ',i4.4,'/',i2.2,'/',i2.2,2x,'Time: ',i2.2,':',i2.2,':',i2.2, & 2x,'Throughput(days/day)[Avg Tot Run]: ',f6.1,1x,f6.1,1x,f6.1,2x,'TimeRemaining(Est) ',i3.3,':'i2.2,':',i2.2,2x,f5.1,'% Memory Committed') _RETURN(ESMF_SUCCESS) From 6cf1de3989b807243e74d9df3648dcf0cf3b73c4 Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Tue, 18 Feb 2020 11:30:56 -0500 Subject: [PATCH 032/109] Fixes # 117 Incorporating MAPL_Profiler. This package was developed prior to the big GEOS transition to git, and is being copied now from the old bridge repository. Also in this update: - updated naming conventions in MAPL_Profiler - eliminate some compiler warnings - fixed cmake problem in which parallel builds of the tests would fail. --- CHANGELOG.md | 4 +- CMakeLists.txt | 1 + GMAO_pFIO/tests/CMakeLists.txt | 13 +- MAPL_Base/CMakeLists.txt | 4 +- MAPL_Base/tests/CMakeLists.txt | 16 +- MAPL_Base/tests/MAPL_Initialize.F90 | 4 +- MAPL_Base/tests/Test_LatLon_Corners.pf | 2 + MAPL_Profiler/AbstractColumn.F90 | 89 ++++ MAPL_Profiler/AbstractGauge.F90 | 27 ++ MAPL_Profiler/AbstractMeter.F90 | 51 ++ MAPL_Profiler/AbstractMeterFactory.F90 | 23 + MAPL_Profiler/AbstractMeterNode.F90 | 167 +++++++ MAPL_Profiler/AdvancedMeter.F90 | 292 ++++++++++++ MAPL_Profiler/BaseProfiler.F90 | 342 ++++++++++++++ MAPL_Profiler/CMakeLists.txt | 63 +++ MAPL_Profiler/ColumnVector.F90 | 10 + MAPL_Profiler/DistributedMeter.F90 | 367 +++++++++++++++ MAPL_Profiler/DistributedMeterNode.F90 | 22 + MAPL_Profiler/DistributedProfiler.F90 | 96 ++++ MAPL_Profiler/ExclusiveColumn.F90 | 73 +++ MAPL_Profiler/FormattedTextColumn.F90 | 123 +++++ MAPL_Profiler/FortranTimerGauge.F90 | 47 ++ MAPL_Profiler/InclusiveColumn.F90 | 71 +++ MAPL_Profiler/MAPL_Profiler.F90 | 41 ++ MAPL_Profiler/MaxCycleColumn.F90 | 79 ++++ MAPL_Profiler/MeanCycleColumn.F90 | 80 ++++ MAPL_Profiler/MemoryProfiler.F90 | 141 ++++++ MAPL_Profiler/MemoryTextColumn.F90 | 172 +++++++ MAPL_Profiler/MeterNode.F90 | 440 ++++++++++++++++++ MAPL_Profiler/MeterNodeStack.F90 | 15 + MAPL_Profiler/MeterNodeVector.F90 | 15 + MAPL_Profiler/MinCycleColumn.F90 | 80 ++++ MAPL_Profiler/MpiTimerGauge.F90 | 42 ++ MAPL_Profiler/MultiColumn.F90 | 166 +++++++ MAPL_Profiler/NameColumn.F90 | 81 ++++ MAPL_Profiler/NumCyclesColumn.F90 | 41 ++ MAPL_Profiler/PercentageColumn.F90 | 92 ++++ MAPL_Profiler/ProfileReporter.F90 | 65 +++ MAPL_Profiler/RssMemoryGauge.F90 | 81 ++++ MAPL_Profiler/SeparatorColumn.F90 | 70 +++ MAPL_Profiler/SimpleColumn.F90 | 61 +++ MAPL_Profiler/SimpleTextColumn.F90 | 84 ++++ MAPL_Profiler/StdDevColumn.F90 | 91 ++++ MAPL_Profiler/TextColumn.F90 | 131 ++++++ MAPL_Profiler/TextColumnVector.F90 | 10 + MAPL_Profiler/TimeProfiler.F90 | 137 ++++++ MAPL_Profiler/VmstatMemoryGauge.F90 | 67 +++ MAPL_Profiler/tests/CMakeLists.txt | 23 + MAPL_Profiler/tests/test_AdvancedMeter.pf | 203 ++++++++ MAPL_Profiler/tests/test_Column.pf | 27 ++ MAPL_Profiler/tests/test_DistributedMeter.pf | 162 +++++++ MAPL_Profiler/tests/test_ExclusiveColumn.pf | 46 ++ MAPL_Profiler/tests/test_MeterNode.pf | 141 ++++++ MAPL_Profiler/tests/test_MeterNodeIterator.pf | 180 +++++++ MAPL_Profiler/tests/test_NameColumn.pf | 53 +++ MAPL_Profiler/tests/test_PercentageColumn.pf | 44 ++ MAPL_Profiler/tests/test_ProfileReporter.pf | 121 +++++ MAPL_Profiler/tests/test_TimeProfiler.pf | 118 +++++ MAPL_pFUnit/CMakeLists.txt | 4 +- {MAPL_Base => include}/unused_dummy.H | 0 60 files changed, 5299 insertions(+), 12 deletions(-) create mode 100644 MAPL_Profiler/AbstractColumn.F90 create mode 100644 MAPL_Profiler/AbstractGauge.F90 create mode 100644 MAPL_Profiler/AbstractMeter.F90 create mode 100644 MAPL_Profiler/AbstractMeterFactory.F90 create mode 100644 MAPL_Profiler/AbstractMeterNode.F90 create mode 100644 MAPL_Profiler/AdvancedMeter.F90 create mode 100644 MAPL_Profiler/BaseProfiler.F90 create mode 100644 MAPL_Profiler/CMakeLists.txt create mode 100644 MAPL_Profiler/ColumnVector.F90 create mode 100644 MAPL_Profiler/DistributedMeter.F90 create mode 100644 MAPL_Profiler/DistributedMeterNode.F90 create mode 100644 MAPL_Profiler/DistributedProfiler.F90 create mode 100644 MAPL_Profiler/ExclusiveColumn.F90 create mode 100644 MAPL_Profiler/FormattedTextColumn.F90 create mode 100644 MAPL_Profiler/FortranTimerGauge.F90 create mode 100644 MAPL_Profiler/InclusiveColumn.F90 create mode 100644 MAPL_Profiler/MAPL_Profiler.F90 create mode 100644 MAPL_Profiler/MaxCycleColumn.F90 create mode 100644 MAPL_Profiler/MeanCycleColumn.F90 create mode 100644 MAPL_Profiler/MemoryProfiler.F90 create mode 100644 MAPL_Profiler/MemoryTextColumn.F90 create mode 100644 MAPL_Profiler/MeterNode.F90 create mode 100644 MAPL_Profiler/MeterNodeStack.F90 create mode 100644 MAPL_Profiler/MeterNodeVector.F90 create mode 100644 MAPL_Profiler/MinCycleColumn.F90 create mode 100644 MAPL_Profiler/MpiTimerGauge.F90 create mode 100644 MAPL_Profiler/MultiColumn.F90 create mode 100644 MAPL_Profiler/NameColumn.F90 create mode 100644 MAPL_Profiler/NumCyclesColumn.F90 create mode 100644 MAPL_Profiler/PercentageColumn.F90 create mode 100644 MAPL_Profiler/ProfileReporter.F90 create mode 100644 MAPL_Profiler/RssMemoryGauge.F90 create mode 100644 MAPL_Profiler/SeparatorColumn.F90 create mode 100644 MAPL_Profiler/SimpleColumn.F90 create mode 100644 MAPL_Profiler/SimpleTextColumn.F90 create mode 100644 MAPL_Profiler/StdDevColumn.F90 create mode 100644 MAPL_Profiler/TextColumn.F90 create mode 100644 MAPL_Profiler/TextColumnVector.F90 create mode 100644 MAPL_Profiler/TimeProfiler.F90 create mode 100644 MAPL_Profiler/VmstatMemoryGauge.F90 create mode 100644 MAPL_Profiler/tests/CMakeLists.txt create mode 100644 MAPL_Profiler/tests/test_AdvancedMeter.pf create mode 100644 MAPL_Profiler/tests/test_Column.pf create mode 100644 MAPL_Profiler/tests/test_DistributedMeter.pf create mode 100644 MAPL_Profiler/tests/test_ExclusiveColumn.pf create mode 100644 MAPL_Profiler/tests/test_MeterNode.pf create mode 100644 MAPL_Profiler/tests/test_MeterNodeIterator.pf create mode 100644 MAPL_Profiler/tests/test_NameColumn.pf create mode 100644 MAPL_Profiler/tests/test_PercentageColumn.pf create mode 100644 MAPL_Profiler/tests/test_ProfileReporter.pf create mode 100644 MAPL_Profiler/tests/test_TimeProfiler.pf rename {MAPL_Base => include}/unused_dummy.H (100%) diff --git a/CHANGELOG.md b/CHANGELOG.md index a69276fb0573..b668f44c0a9b 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,11 +11,13 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Corrected handling of Equation of Time in orbit (off by default) - Made ASSERT in ExtData more explicit in case of missing variables. - +- (re) Introduced MAPL Profiling package + ### Fixed - Corrected Python code generator scripts for component import/export specs. - Add directories to `.gitignore` for building with `mepo` +- Implemented workaround to cmake error that happens when building tests in parallel. ## [2.0.0] - 2019-02-07 diff --git a/CMakeLists.txt b/CMakeLists.txt index 61ea04e86f50..ec7cfb5c0515 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -55,6 +55,7 @@ add_subdirectory (MAPL_cfio MAPL_cfio_r4) add_subdirectory (MAPL_cfio MAPL_cfio_r8) add_subdirectory (GMAO_pFIO) +add_subdirectory (MAPL_Profiler) add_subdirectory (MAPL_Base) add_subdirectory (MAPL) diff --git a/GMAO_pFIO/tests/CMakeLists.txt b/GMAO_pFIO/tests/CMakeLists.txt index f1fd856d988b..a95a6a949419 100644 --- a/GMAO_pFIO/tests/CMakeLists.txt +++ b/GMAO_pFIO/tests/CMakeLists.txt @@ -19,7 +19,6 @@ set (TEST_SRCS # SRCS are mostly mocks to facilitate tests set (SRCS - pFIO_Initialize.F90 MockServerThread.F90 MockClientThread.F90 MockClient.F90 @@ -27,10 +26,19 @@ set (SRCS MockSocket.F90 ) +# This file needs to be in a library because CMake cannot detect the +# dependency of the pFUnit driver on it. This is due to the use of +# preprocesor in the driver for specifying the include file. +add_library (pfio_extras + pFIO_Initialize.F90 + ) +target_link_libraries (pfio_extras PUBLIC MAPL_pFUnit) + + add_pfunit_ctest(pFIO_tests TEST_SOURCES ${TEST_SRCS} OTHER_SOURCES ${SRCS} - LINK_LIBRARIES GMAO_pFIO MAPL_pFUnit + LINK_LIBRARIES GMAO_pFIO pfio_extras MAPL_pFUnit EXTRA_INITIALIZE Initialize EXTRA_USE pFIO_pFUNIT_Initialize MAX_PES 8 @@ -44,7 +52,6 @@ include_directories( include_directories(${CMAKE_CURRENT_SOURCE_DIR}/..) include_directories(${CMAKE_CURRENT_BINARY_DIR}/..) include_directories(${include_GMAO_pFIO}) -include_directories(${include_MAPL_pFUnit}) set(TESTO pfio_ctest_io.x) diff --git a/MAPL_Base/CMakeLists.txt b/MAPL_Base/CMakeLists.txt index 99f3e9ce4aeb..946a0c750412 100644 --- a/MAPL_Base/CMakeLists.txt +++ b/MAPL_Base/CMakeLists.txt @@ -69,6 +69,8 @@ if(DISABLE_GLOBAL_NAME_WARNING) set_target_properties (${this} PROPERTIES COMPILE_FLAGS ${DISABLE_GLOBAL_NAME_WARNING}) endif() target_compile_definitions (${this} PRIVATE TWO_SIDED_COMM MAPL_MODE) +target_include_directories (${this} PRIVATE ${MAPL_SOURCE_DIR}/include) + # Kludge for OSX security and DYLD_LIBRARY_PATH ... foreach(dir ${OSX_EXTRA_LIBRARY_PATH}) @@ -98,7 +100,7 @@ target_link_libraries (${this} PUBLIC ${ESMF_LIBRARIES} ${MPI_Fortran_LIBRARIES} # We could leave these in the source directory, and just broaden the search path # in the other libaries, but this make it explicit which aspects are externally # used. -file (COPY unused_dummy.H DESTINATION ${esma_include}/${this}) +file (COPY ${MAPL_SOURCE_DIR}/include/unused_dummy.H DESTINATION ${esma_include}/${this}) file (COPY MAPL_Generic.h DESTINATION ${esma_include}/${this}) file (COPY MAPL_Exceptions.h DESTINATION ${esma_include}/${this}) file (COPY MAPL_ErrLog.h DESTINATION ${esma_include}/${this}) diff --git a/MAPL_Base/tests/CMakeLists.txt b/MAPL_Base/tests/CMakeLists.txt index 800b6eeb2e73..617b855ef4f8 100644 --- a/MAPL_Base/tests/CMakeLists.txt +++ b/MAPL_Base/tests/CMakeLists.txt @@ -17,17 +17,27 @@ set (TEST_SRCS # SRCS are mostly mocks to facilitate tests set (SRCS - MAPL_Initialize.F90 MockGridFactory.F90 MockRegridder.F90 ) +# This file needs to be in a library because CMake cannot detect the +# dependency of the pFUnit driver on it. This is due to the use of +# preprocesor in the driver for specifying the include file. +add_library (base_extras + MAPL_Initialize.F90 + ) +target_link_libraries (base_extras PUBLIC ${ESMF_LIBRARIES} MAPL_Base MAPL_pFUnit) +target_include_directories (base_extras PUBLIC ${INC_ESMF}) +target_include_directories (base_extras PUBLIC ${INC_NETCDF}) + + add_pfunit_ctest(MAPL_Base_tests TEST_SOURCES ${TEST_SRCS} OTHER_SOURCES ${SRCS} - LINK_LIBRARIES MAPL_Base GMAO_pFIO MAPL_pFUnit + LINK_LIBRARIES MAPL_Base GMAO_pFIO base_extras MAPL_pFUnit EXTRA_INITIALIZE Initialize - EXTRA_USE MAPL_pFUNIT_Initialize + EXTRA_USE MAPL_pFUnit_Initialize MAX_PES 8 ) diff --git a/MAPL_Base/tests/MAPL_Initialize.F90 b/MAPL_Base/tests/MAPL_Initialize.F90 index d201a6250c1d..6f2f9d231b0f 100644 --- a/MAPL_Base/tests/MAPL_Initialize.F90 +++ b/MAPL_Base/tests/MAPL_Initialize.F90 @@ -1,4 +1,4 @@ -module MAPL_pFUNIT_Initialize +module MAPL_pFUnit_Initialize contains subroutine Initialize() use ESMF @@ -9,4 +9,4 @@ subroutine Initialize() call MAPL_set_throw_method(throw) end subroutine Initialize -end module +end module MAPL_pFUnit_Initialize diff --git a/MAPL_Base/tests/Test_LatLon_Corners.pf b/MAPL_Base/tests/Test_LatLon_Corners.pf index b6629795f24e..33313e666d7a 100644 --- a/MAPL_Base/tests/Test_LatLon_Corners.pf +++ b/MAPL_Base/tests/Test_LatLon_Corners.pf @@ -1,3 +1,4 @@ +#include "unused_dummy.H" module Test_LatLon_Corners use pfunit use ESMF_TestCase_mod @@ -62,6 +63,7 @@ contains type (Test_LatLonCorners) :: aTest class (GridCase), intent(in) :: testParameter + _UNUSED_DUMMY(testParameter) !$$ allocate(aTest%testParameter, source=testParameter) select type (p => aTest%testParameter) class is (GridCase) diff --git a/MAPL_Profiler/AbstractColumn.F90 b/MAPL_Profiler/AbstractColumn.F90 new file mode 100644 index 000000000000..7e872e0aa3fe --- /dev/null +++ b/MAPL_Profiler/AbstractColumn.F90 @@ -0,0 +1,89 @@ +module MAPL_AbstractColumn + use GFTL_UnlimitedVector + use MAPL_AbstractMeterNode + use MAPL_DistributedMeter + implicit none + private + + public :: AbstractColumn + + type, abstract :: AbstractColumn + private + contains + procedure(i_get_rows), deferred :: get_rows + procedure, nopass :: fill_row_real64_stats + procedure, nopass :: fill_row_integer_stats + generic :: fill_row => fill_row_real64_stats, fill_row_integer_stats + end type AbstractColumn + + + abstract interface + + function i_get_rows(this, node) result(rows) + import AbstractColumn + import AbstractMeterNode + import UnlimitedVector + ! Some columns return reals, others return integers + type(UnlimitedVector) :: rows + class(AbstractColumn), intent(in) :: this + class(AbstractMeterNode), target, intent(in) :: node + + end function i_get_rows + + end interface + + +contains + + + ! These probably belong somewhere else. + subroutine fill_row_real64_stats(stats, option, row) + type(DistributedReal64), intent(in) :: stats + character(*), intent(in) :: option + class(*), allocatable, intent(out) :: row + + select case (option) + case ('MAX') + allocate(row, source=stats%max) + case ('MAX_PE') + allocate(row, source=stats%max_pe) + case ('MIN') + allocate(row, source=stats%min) + case ('MIN_PE') + allocate(row, source=stats%min_pe) + case ('MEAN') + allocate(row, source=stats%total / stats%num_pes) + case ('TOTAL') + allocate(row, source=stats%total) + case default + print*,__FILE__,__LINE__,'ERROR: unsupported option '//option + end select + + end subroutine fill_row_real64_stats + + subroutine fill_row_integer_stats(stats, option, row) + type(DistributedInteger), intent(in) :: stats + character(*), intent(in) :: option + class(*), allocatable, intent(out) :: row + + select case (option) + case ('MAX') + allocate(row, source=stats%max) + case ('MAX_PE') + allocate(row, source=stats%max_pe) + case ('MIN') + allocate(row, source=stats%min) + case ('MIN_PE') + allocate(row, source=stats%min_pe) + case ('MEAN') + allocate(row, source=stats%total / stats%num_pes) + case ('TOTAL') + allocate(row, source=stats%total) + case default + print*,__FILE__,__LINE__,'ERROR: unsupported option '//option + end select + + end subroutine fill_row_integer_stats + + +end module MAPL_AbstractColumn diff --git a/MAPL_Profiler/AbstractGauge.F90 b/MAPL_Profiler/AbstractGauge.F90 new file mode 100644 index 000000000000..5792cdffcf48 --- /dev/null +++ b/MAPL_Profiler/AbstractGauge.F90 @@ -0,0 +1,27 @@ +module MAPL_AbstractGauge + use, intrinsic :: iso_fortran_env, only: REAL64 + use MAPL_AbstractMeter + implicit none + private + + public :: AbstractGauge + type, abstract :: AbstractGauge + private + contains + procedure(i_get_measurement), deferred :: get_measurement + end type AbstractGauge + + + abstract interface + + function i_get_measurement(this) result(measurement) + import REAL64 + import AbstractGauge + real(kind=REAL64) :: measurement + class (AbstractGauge), intent(inout) :: this + end function i_get_measurement + + end interface + + +end module MAPL_AbstractGauge diff --git a/MAPL_Profiler/AbstractMeter.F90 b/MAPL_Profiler/AbstractMeter.F90 new file mode 100644 index 000000000000..0fc963d5d0ac --- /dev/null +++ b/MAPL_Profiler/AbstractMeter.F90 @@ -0,0 +1,51 @@ +module MAPL_AbstractMeter + use, intrinsic :: iso_fortran_env, only: REAL64 + implicit none + private + + public :: AbstractMeter + type, abstract :: AbstractMeter + private + contains + ! Override in subclasses for different timing mechanisms + procedure(i_action), deferred :: start + procedure(i_action), deferred :: stop + procedure(i_action), deferred :: reset + procedure(i_add_cycle), deferred :: add_cycle + + procedure(i_get), deferred :: get_total + procedure(i_accumulate), deferred :: accumulate + + end type AbstractMeter + + + abstract interface + + subroutine i_action(this) + import AbstractMeter + class (AbstractMeter), intent(inout) :: this + end subroutine i_action + + subroutine i_add_cycle(this, increment) + import AbstractMeter + import REAL64 + class (AbstractMeter), intent(inout) :: this + real(kind=REAL64), intent(in) :: increment + end subroutine i_add_cycle + + function i_get(this) result(val) + import AbstractMeter + import REAL64 + real(kind=REAL64) :: val + class (AbstractMeter), intent(in) :: this + end function i_get + + subroutine i_accumulate(this, lap) + import AbstractMeter + class(AbstractMeter), intent(inout) :: this + class(AbstractMeter), intent(in) :: lap + end subroutine i_accumulate + + end interface + +end module MAPL_AbstractMeter diff --git a/MAPL_Profiler/AbstractMeterFactory.F90 b/MAPL_Profiler/AbstractMeterFactory.F90 new file mode 100644 index 000000000000..425d4b840835 --- /dev/null +++ b/MAPL_Profiler/AbstractMeterFactory.F90 @@ -0,0 +1,23 @@ +module MAPL_AbstractMeterFactory + use MAPL_AbstractMeter + implicit none + private + + public :: AbstractMeterFactory + + type, abstract :: AbstractMeterFactory + contains + procedure(i_make_meter), deferred :: make_meter + end type AbstractMeterFactory + + abstract interface + function i_make_meter(this) result(meter) + import AbstractMeterFactory + import AbstractMeter + class(AbstractMeter), allocatable :: meter + class(AbstractMeterFactory), intent(in) :: this + end function i_make_meter + end interface + +end module MAPL_AbstractMeterFactory + diff --git a/MAPL_Profiler/AbstractMeterNode.F90 b/MAPL_Profiler/AbstractMeterNode.F90 new file mode 100644 index 000000000000..ea96fdfe1683 --- /dev/null +++ b/MAPL_Profiler/AbstractMeterNode.F90 @@ -0,0 +1,167 @@ +module MAPL_AbstractMeterNode + use MAPL_AbstractMeter + implicit none + private + + public :: AbstractMeterNode + public :: AbstractMeterNodeIterator + + ! A node consists of a meter and a name. We need an abstract base + ! class so that we can use gFTL in a relatively painless manner. + type, abstract :: AbstractMeterNode + private + contains + procedure(i_get_meter), deferred :: get_meter + procedure(i_get_name), deferred :: get_name + procedure(i_get_depth), deferred :: get_depth + procedure(i_get_inclusive), deferred :: get_inclusive + procedure(i_get_inclusive), deferred :: get_exclusive + procedure(i_add_child), deferred :: add_child + procedure(i_get_child), deferred :: get_child + procedure(i_has_child), deferred :: has_child + procedure(i_get_num_nodes), deferred :: get_num_children + procedure(i_get_num_nodes), deferred :: get_num_nodes + procedure(i_reset), deferred :: reset + procedure(i_accumulate), deferred :: accumulate + + ! Iterator factory methods + procedure(i_make_iterator), deferred :: begin + procedure(i_make_iterator), deferred :: end + end type AbstractMeterNode + + type, abstract :: AbstractMeterNodeIterator + private + contains + procedure(i_get), deferred :: get + procedure(i_iter_get_meter), deferred :: get_meter + procedure(i_iter_get_name), deferred :: get_name + procedure(i_compare), deferred :: equals + procedure(i_compare), deferred :: not_equals + generic :: operator(==) => equals + generic :: operator(/=) => not_equals + procedure(i_next), deferred :: next + end type AbstractMeterNodeIterator + + + abstract interface + + function i_get_meter(this) result(meter) + import AbstractMeter + import AbstractMeterNode + class(AbstractMeter), pointer :: meter + class(AbstractMeterNode), target, intent(in) :: this + end function i_get_meter + + function i_get_depth(this) result(depth) + import AbstractMeterNode + integer :: depth + class(AbstractMeterNode), intent(in) :: this + end function i_get_depth + + + subroutine i_add_child(this, name, meter) + import AbstractMeterNode + import AbstractMeter + class(AbstractMeterNode), target, intent(inout) :: this + character(*), intent(in) :: name + class (AbstractMeter), intent(in) :: meter + end subroutine i_add_child + + + function i_get_child(this, name) result(children) + import AbstractMeterNode + class(AbstractMeterNode), pointer :: children + class(AbstractMeterNode), target, intent(inout) :: this + character(*), intent(in) :: name + end function i_get_child + + + logical function i_has_child(this, name) + import AbstractMeterNode + class(AbstractMeterNode), pointer :: children + class(AbstractMeterNode), target, intent(in) :: this + character(*), intent(in) :: name + end function i_has_child + + + integer function i_get_num_nodes(this) result(num_nodes) + import AbstractMeterNode + class(AbstractMeterNode), target, intent(in) :: this + end function i_get_num_nodes + + + subroutine i_accumulate(this, other) + import AbstractMeterNode + class(AbstractMeterNode), intent(inout) :: this + class(AbstractMeterNode), target, intent(in) :: other + end subroutine i_accumulate + + + function i_get(this) result(node) + import AbstractMeterNode + import AbstractMeterNodeIterator + class(AbstractMeterNode), pointer :: node + class(AbstractMeterNodeIterator), target, intent(in) :: this + end function i_get + + + function i_iter_get_meter(this) result(t) + import AbstractMeterNode + import AbstractMeterNodeIterator + import AbstractMeter + class(AbstractMeter), pointer :: t + class(AbstractMeterNodeIterator), intent(in) :: this + end function i_iter_get_meter + + + function i_iter_get_name(this) result(name) + import AbstractMeterNode + import AbstractMeterNodeIterator + character(:), pointer :: name + class(AbstractMeterNodeIterator), intent(in) :: this + end function i_iter_get_name + + + function i_make_iterator(this) result(iterator) + import AbstractMeterNode + import AbstractMeterNodeIterator + class(AbstractMeterNodeIterator), allocatable :: iterator + class(AbstractMeterNode), target, intent(in) :: this + end function i_make_iterator + + + logical function i_compare(a, b) + import AbstractMeterNodeIterator + class(AbstractMeterNodeIterator), intent(in) :: a + class(AbstractMeterNodeIterator), intent(in) :: b + end function i_compare + + + subroutine i_next(this) + import AbstractMeterNodeIterator + class(AbstractMeterNodeIterator), intent(inout) :: this + end subroutine i_next + + + function i_get_name(this) result(name) + import AbstractMeterNode + character(:), pointer :: name + class(AbstractMeterNode), target, intent(in) :: this + end function i_get_name + + + function i_get_inclusive(this) result(inclusive) + use, intrinsic :: iso_fortran_env, only: REAL64 + import AbstractMeterNode + real(kind=REAL64) :: inclusive + class(AbstractMeterNode), intent(in) :: this + end function i_get_inclusive + + subroutine i_reset(this) + import AbstractMeterNode + class(AbstractMeterNode), target, intent(inout) :: this + end subroutine i_reset + + end interface + +end module MAPL_AbstractMeterNode diff --git a/MAPL_Profiler/AdvancedMeter.F90 b/MAPL_Profiler/AdvancedMeter.F90 new file mode 100644 index 000000000000..7d4c90398892 --- /dev/null +++ b/MAPL_Profiler/AdvancedMeter.F90 @@ -0,0 +1,292 @@ +#include "unused_dummy.H" + +module MAPL_AdvancedMeter + use, intrinsic :: iso_fortran_env, only: REAL64 + use MAPL_AbstractMeter + use MAPL_AbstractGauge + implicit none + private + + public :: AdvancedMeter + + public :: MAPL_METER_IS_VALID + public :: MAPL_METER_START_ACTIVE + public :: MAPL_METER_STOP_INACTIVE + + enum, bind(c) + enumerator :: MAPL_METER_IS_VALID = 0 + enumerator :: MAPL_METER_START_ACTIVE + enumerator :: MAPL_METER_STOP_INACTIVE + end enum + + type, extends(AbstractMeter) :: AdvancedMeter + private + + class(AbstractGauge), allocatable :: gauge + real(kind=REAL64) :: start_value + + real(kind=REAL64) :: total = 0 + logical :: active = .false. + integer :: status = MAPL_METER_IS_VALID + + real(kind=REAL64) :: min_cycle = huge(1._REAL64) + real(kind=REAL64) :: max_cycle = 0. + real(kind=REAL64) :: sum_square_deviation = 0. + + integer :: num_cycles = 0 + + contains + + procedure :: start + procedure :: stop + + procedure :: reset + procedure :: is_active + procedure :: get_status + procedure :: get_overhead + + procedure :: get_total + + procedure :: get_min_cycle + procedure :: get_max_cycle + procedure :: get_mean_cycle + procedure :: get_sum_square_deviation + procedure :: get_standard_deviation + procedure :: get_relative_deviation + procedure :: get_num_cycles + + procedure :: add_cycle + procedure :: accumulate + + + end type AdvancedMeter + + + + interface AdvancedMeter + module procedure :: new_AdvancedMeter + end interface AdvancedMeter + + +contains + + + function new_AdvancedMeter(gauge) result(meter) + type(AdvancedMeter) :: meter + class(AbstractGauge), intent(in) :: gauge + + meter%gauge = gauge + + end function new_AdvancedMeter + + + subroutine start(this) + class(AdvancedMeter), intent(inout) :: this + + if (this%active) then + this%status = MAPL_METER_START_ACTIVE + return + end if + + this%active = .true. + + this%start_value = this%gauge%get_measurement() + + end subroutine start + + + subroutine stop(this) + class(AdvancedMeter), intent(inout) :: this + + real(kind=REAL64) :: increment + + if (.not. this%active) then + this%status = MAPL_METER_STOP_INACTIVE + return + end if + + this%active = .false. + increment = this%gauge%get_measurement() - this%start_value + call this%add_cycle(increment) + + end subroutine stop + + + function get_total(this) result(val) + real(kind=REAL64) :: val + class(AdvancedMeter), intent(in) :: this + + val = this%total + + end function get_total + + + logical function is_active(this) + class(AdvancedMeter), intent(in) :: this + is_active = this%active + end function is_active + + + integer function get_status(this) result(status) + class(AdvancedMeter), intent(in) :: this + status = this%status + end function get_status + + + subroutine add_cycle(this, increment) + class(AdvancedMeter), intent(inout) :: this + real(kind=REAL64), intent(in) :: increment + + real(kind=REAL64) :: old_mean, new_mean + + associate ( n => this%num_cycles, t => increment ) + this%min_cycle = min(this%min_cycle, t) + this%max_cycle = max(this%max_cycle, t) + + old_mean = this%get_mean_cycle() + n = n + 1 + new_mean = old_mean + (t - old_mean) / n ! denominator provably always > 0 (modulo integer overflow) + + this%sum_square_deviation = this%sum_square_deviation + (t - old_mean)*(t - new_mean) + + this%total = this%total + t + + end associate + + + end subroutine add_cycle + + + subroutine reset(this) + class(AdvancedMeter), intent(inout) :: this + + this%total = 0 + this%active = .false. + + this%num_cycles = 0 + this%min_cycle = huge(1._REAL64) + this%max_cycle = 0._REAL64 + this%sum_square_deviation = 0._REAL64 + + end subroutine reset + + + + function get_min_cycle(this) result(min_cycle) + real(kind=REAL64) :: min_cycle + class(AdvancedMeter), intent(in) :: this + + min_cycle = this%min_cycle + + end function get_min_cycle + + + function get_max_cycle(this) result(max_cycle) + real(kind=REAL64) :: max_cycle + class(AdvancedMeter), intent(in) :: this + + max_cycle = this%max_cycle + + end function get_max_cycle + + + function get_mean_cycle(this) result(mean_cycle) + real(kind=REAL64) :: mean_cycle + class(AdvancedMeter), intent(in) :: this + + integer :: n + + n = this%get_num_cycles() + if (n > 0) then + mean_cycle = this%total / n + else + mean_cycle = 0 ! undefined actually + end if + + end function get_mean_cycle + + + function get_sum_square_deviation(this) result(sum_square_deviation) + real(kind=REAL64) :: sum_square_deviation + class(AdvancedMeter), intent(in) :: this + + sum_square_deviation = this%sum_square_deviation + + end function get_sum_square_deviation + + + function get_standard_deviation(this) result(standard_deviation) + real(kind=REAL64) :: standard_deviation + class(AdvancedMeter), intent(in) :: this + + standard_deviation = sqrt(this%sum_square_deviation / this%num_cycles) + + end function get_standard_deviation + + + ! Relative standard deviation (expressed as percentage) + ! R = 100 * standard_deviation / mean + ! https://en.wikipedia.org/wiki/Coefficient_of_variation + function get_relative_deviation(this) result(relative_deviation) + use, intrinsic :: ieee_arithmetic, only: IEEE_POSITIVE_INF, ieee_value + real(kind=REAL64) :: relative_deviation + class(AdvancedMeter), intent(in) :: this + + real(kind=REAL64) :: abs_mean + + abs_mean = abs(this%get_mean_cycle()) + if (abs_mean > 0) then + relative_deviation = 100*(this%get_standard_deviation()/abs_mean) + else + ! Gfortran stops with overflow exception even to do the assignment below. + ! So we default to 0 when there the mean is 0. + relative_deviation = ieee_value(1.0_REAL64, IEEE_POSITIVE_INF) + end if + + end function get_relative_deviation + + + integer function get_num_cycles(this) result(num_cycles) + class(AdvancedMeter), intent(in) :: this + + num_cycles = this%num_cycles + + end function get_num_cycles + + + function get_overhead(this) result(overhead) + real(kind=REAL64) :: overhead + class(AdvancedMeter), intent(in) :: this + + class(AdvancedMeter), allocatable :: t_outer + class(AdvancedMeter), allocatable :: t_inner + + call t_outer%start() + call t_inner%start() + call t_inner%stop() + call t_outer%stop() + + overhead = t_outer%get_total() + + end function get_overhead + + + subroutine accumulate(this, lap) + class(AdvancedMeter), intent(inout) :: this + class(AbstractMeter), intent(in) :: lap + + select type(lap) + class is (AdvancedMeter) + this%min_cycle = min(this%min_cycle, lap%min_cycle) + this%max_cycle = max(this%max_cycle, lap%max_cycle) + + this%total = this%total + lap%total + this%num_cycles = this%num_cycles + lap%num_cycles + this%sum_square_deviation = this%sum_square_deviation + lap%sum_square_deviation + class default + print*,'add error handling here' + end select + + end subroutine accumulate + +end module MAPL_AdvancedMeter diff --git a/MAPL_Profiler/BaseProfiler.F90 b/MAPL_Profiler/BaseProfiler.F90 new file mode 100644 index 000000000000..5fd9e934b591 --- /dev/null +++ b/MAPL_Profiler/BaseProfiler.F90 @@ -0,0 +1,342 @@ +module MAPL_BaseProfiler + use MAPL_AdvancedMeter + use MAPL_AbstractMeter + use MAPL_AbstractMeterNode + use MAPL_MeterNode + use MAPL_MeterNodeStack + implicit none + private + + public :: BaseProfiler + public :: BaseProfilerIterator + + public :: INCORRECTLY_NESTED_METERS + + enum, bind(c) + enumerator :: INCORRECTLY_NESTED_METERS=1 + end enum + + type, abstract :: BaseProfiler + private + type(MeterNode) :: node + type(MeterNodeStack) :: stack + integer :: status = 0 + contains + procedure :: start_name + procedure :: stop_name + procedure :: start_self + generic :: start => start_name + generic :: start => start_self + generic :: stop => stop_name + generic :: zeit_ci => start_name + generic :: zeit_co => stop_name + procedure :: get_num_meters + procedure :: finalize + + ! Override make_meter() to measure other things. + procedure(i_make_meter), deferred :: make_meter + + procedure :: set_node + procedure :: get_root_node + procedure :: get_status + procedure :: copy_profiler + procedure(copy_profiler), deferred :: copy + generic :: assignment(=) => copy + + procedure :: reset + procedure :: accumulate + + procedure :: begin + procedure :: end + procedure :: get_depth + + end type BaseProfiler + + type :: BaseProfilerIterator + private + class (AbstractMeterNodeIterator), allocatable :: node_iterator + contains + procedure :: get_node + procedure :: get_meter + procedure :: get_name + procedure :: next + procedure :: equals + procedure :: not_equals + generic :: operator(==) => equals + generic :: operator(/=) => not_equals + end type BaseProfilerIterator + + abstract interface + + function i_make_meter(this) result(meter) + import AbstractMeter + import BaseProfiler + class(AbstractMeter), allocatable :: meter + class(BaseProfiler), intent(in) :: this + end function i_make_meter + + end interface + + +contains + + + subroutine start_self(this) + class(BaseProfiler), target, intent(inout) :: this + + class(AbstractMeter), pointer :: t + + call this%stack%push_back(this%node) + t => this%node%get_meter() + call t%start() + + end subroutine start_self + + + subroutine start_name(this, name) + class(BaseProfiler), target, intent(inout) :: this + character(*), intent(in) :: name + + class(AbstractMeter), pointer :: t + class(AbstractMeterNode), pointer :: node + class(AbstractMeter), allocatable :: m + + node => this%stack%back() + if (.not. node%has_child(name)) then + m = this%make_meter() + call node%add_child(name, m) !this%make_meter()) + end if + node => node%get_child(name) + call this%stack%push_back(node) + + t => node%get_meter() + call t%start() +!!$ block +!!$ use MPI +!!$ integer :: rank, ierror +!!$ call MPI_Comm_rank(MPI_COMM_WORLD, rank, ierror) +!!$ if (rank == 0) then +!!$ print*,'start: ', __FILE__,__LINE__,this%get_depth(),name +!!$ end if +!!$ end block + + end subroutine start_name + + + subroutine stop_name(this, name) + class(BaseProfiler), intent(inout) :: this + character(*), intent(in) :: name + + class(AbstractMeter), pointer :: t + class(AbstractMeterNode), pointer :: node + +!!$ block +!!$ use MPI +!!$ integer :: rank, ierror +!!$ call MPI_Comm_rank(MPI_COMM_WORLD, rank, ierror) +!!$ if (rank == 0) then +!!$ print*,'stop: ', __FILE__,__LINE__,this%get_depth(),name +!!$ end if +!!$ end block + node => this%stack%back() + t => node%get_meter() + if (name /= node%get_name()) then + this%status = INCORRECTLY_NESTED_METERS + block + use MPI + integer :: rank, ierror + call MPI_Comm_rank(MPI_COMM_WORLD, rank, ierror) + if (rank == 0) then + print*,__FILE__,__LINE__,'stop called on non-bottom timer'//name + end if + end block + return + end if + call t%stop() + call this%stack%pop_back() + + end subroutine stop_name + + integer function get_num_meters(this) result(num_meters) + class(BaseProfiler), intent(in) :: this + + num_meters = this%node%get_num_nodes() + + end function get_num_meters + + + subroutine finalize(this) + class(BaseProfiler), target, intent(inout) :: this + + class(AbstractMeter), pointer :: t + + call this%stack%pop_back() + t => this%node%get_meter() + call t%stop() + + end subroutine finalize + + subroutine copy_profiler(new, old) + class(BaseProfiler), target, intent(inout) :: new + class(BaseProfiler), target, intent(in) :: old + + class(AbstractMeterNode), pointer :: subnode + class(AbstractMeterNode), pointer :: next_item + type(MeterNodeStackIterator) :: iter + character(:), pointer :: name + + new%node = old%node + subnode => new%node + + ! Stack always starts with root node of node + iter = old%stack%begin() + call new%stack%push_back(subnode) + call iter%next() + + do while (iter /= old%stack%end()) + next_item => iter%get() + name => next_item%get_name() + subnode => subnode%get_child(name) + call new%stack%push_back(subnode) + call iter%next() + end do + + end subroutine copy_profiler + + + integer function get_status(this) result(status) + class(BaseProfiler), intent(in) :: this + status = this%status + end function get_status + + + + function get_root_node(this) result(root_node) + class(AbstractMeterNode), pointer :: root_node + class(BaseProfiler), target, intent(in) :: this + + root_node => this%node + + end function get_root_node + + + ! TODO: move most logic to MeterNode + recursive subroutine reset(this) + class(BaseProfiler), target, intent(inout) :: this + class(AbstractMeterNodeIterator), allocatable :: iter + class(AbstractMeterNode), pointer :: node + class(AbstractMeter), pointer :: t + + node => this%get_root_node() + iter = node%begin() + do while (iter /= node%end()) + t => iter%get_meter() + call t%reset() + call iter%next() + end do + + call this%start() + + end subroutine reset + + + recursive subroutine accumulate(a, b) + class(BaseProfiler), target, intent(inout) :: a + class(BaseProfiler), target, intent(in) :: b + + class(AbstractMeterNode), pointer :: node_a, node_b + + node_a => a%stack%back() + node_b => b%get_root_node() + + call node_a%accumulate(node_b) + + end subroutine accumulate + + + function begin(this) result(iterator) + type (BaseProfilerIterator) :: iterator + class (BaseProfiler), target, intent(in) :: this + + iterator%node_iterator = this%node%begin() + end function begin + + function end(this) result(iterator) + type (BaseProfilerIterator) :: iterator + class (BaseProfiler), target, intent(in) :: this + + iterator%node_iterator = this%node%end() + end function end + + + subroutine next(this) + class (BaseProfilerIterator), intent(inout) :: this + call this%node_iterator%next() + end subroutine next + + ! Type cast to concrete class for convenience of client code. + function get_node(this) result(node) + class (MeterNode), pointer :: node + class (BaseProfilerIterator), target, intent(in) :: this + + class (AbstractMeterNode), pointer :: abstract_node + + abstract_node => this%node_iterator%get() + select type (q => abstract_node) + class is (MeterNode) + node => q + class default + print*,'put error handling here' + end select + + end function get_node + + + subroutine set_node(this, node) + class (BaseProfiler), intent(inout) :: this + type (MeterNode), intent(in) :: node + this%node = node + end subroutine set_node + + function get_name(this) result(name) + character(:), pointer :: name + class (BaseProfilerIterator), target, intent(in) :: this + name => this%node_iterator%get_name() + end function get_name + + function get_meter(this) result(meter) + class (AdvancedMeter), pointer :: meter + class (BaseProfilerIterator), target, intent(in) :: this + + class (AbstractMeter), pointer :: abstract_meter + + abstract_meter => this%node_iterator%get_meter() + select type (q => abstract_meter) + class is (AdvancedMeter) + meter => q + class default + print*,'put error handling here' + end select + end function get_meter + + logical function equals(this, other) + class (BaseProfilerIterator), intent(in) :: this + class (BaseProfilerIterator), intent(in) :: other + equals = (this%node_iterator == other%node_iterator) + end function equals + + logical function not_equals(this, other) + class (BaseProfilerIterator), intent(in) :: this + class (BaseProfilerIterator), intent(in) :: other + not_equals = .not. (this == other) + end function not_equals + + integer function get_depth(this) result(depth) + class(BaseProfiler), intent(in) :: this + depth = this%stack%size() + end function get_depth + +end module MAPL_BaseProfiler + + + diff --git a/MAPL_Profiler/CMakeLists.txt b/MAPL_Profiler/CMakeLists.txt new file mode 100644 index 000000000000..27bc1c4100ed --- /dev/null +++ b/MAPL_Profiler/CMakeLists.txt @@ -0,0 +1,63 @@ +esma_set_this () + +set (srcs + AbstractMeter.F90 + AbstractMeterNode.F90 + AbstractMeterFactory.F90 + MeterNodeVector.F90 + MeterNodeStack.F90 + + # Low-level measures + AbstractGauge.F90 + MpiTimerGauge.F90 + FortranTimerGauge.F90 + RssMemoryGauge.F90 + VmstatMemoryGauge.F90 + + + + AdvancedMeter.F90 + DistributedMeter.F90 + + MeterNode.F90 + + AbstractColumn.F90 + SimpleColumn.F90 + TextColumn.F90 + SimpleTextColumn.F90 + NameColumn.F90 + + FormattedTextColumn.F90 + MemoryTextColumn.F90 + SeparatorColumn.F90 + NumCyclesColumn.F90 + InclusiveColumn.F90 + ExclusiveColumn.F90 + StdDevColumn.F90 + MinCycleColumn.F90 + MeanCycleColumn.F90 + MaxCycleColumn.F90 + MinCycleColumn.F90 + PercentageColumn.F90 + ColumnVector.F90 + TextColumnVector.F90 + MultiColumn.F90 + + BaseProfiler.F90 + TimeProfiler.F90 + MemoryProfiler.F90 + DistributedProfiler.F90 + ProfileReporter.F90 + + # The package + MAPL_Profiler.F90 + + ) +esma_add_library (${this} SRCS ${srcs} DEPENDENCIES gftl-shared gftl MPI::MPI_Fortran) +target_include_directories (${this} PRIVATE ${MAPL_SOURCE_DIR}/include) + +if (PFUNIT_FOUND) + add_subdirectory (tests) +endif () + + diff --git a/MAPL_Profiler/ColumnVector.F90 b/MAPL_Profiler/ColumnVector.F90 new file mode 100644 index 000000000000..65842667219c --- /dev/null +++ b/MAPL_Profiler/ColumnVector.F90 @@ -0,0 +1,10 @@ +module MAPL_ColumnVector + use MAPL_AbstractColumn + +#define _type class(AbstractColumn) +#define _allocatable +#define _vector ColumnVector +#define _iterator ColumnVectorIterator +#include "templates/vector.inc" + +end module MAPL_ColumnVector diff --git a/MAPL_Profiler/DistributedMeter.F90 b/MAPL_Profiler/DistributedMeter.F90 new file mode 100644 index 000000000000..b4ca9d82c423 --- /dev/null +++ b/MAPL_Profiler/DistributedMeter.F90 @@ -0,0 +1,367 @@ +module MAPL_DistributedMeter + use, intrinsic :: iso_fortran_env, only: REAL64 + use MAPL_AdvancedMeter + use MAPL_AbstractGauge + use MPI + implicit none + private + + public :: DistributedMeter + public :: DistributedReal64 + public :: DistributedInteger + public :: DistributedStatistics + public :: operator(.reduce.) + + interface operator(.reduce.) + module procedure reduce_distributed_real64 + module procedure reduce_distributed_integer + module procedure reduce_distributed_data + end interface + + type :: DistributedReal64 + sequence + real(kind=REAL64) :: total = 0 + real(kind=REAL64) :: min = huge(1._REAL64) + real(kind=REAL64) :: max = -huge(1._REAL64) + integer :: min_pe = huge(1) + integer :: max_pe = -1 + integer :: num_pes = 1 + integer :: pad + end type DistributedReal64 + + type :: DistributedInteger + sequence + integer :: total = 0 + integer :: min + integer :: max + integer :: min_pe = huge(1) + integer :: max_pe = -1 + integer :: num_pes = 1 + end type DistributedInteger + + type :: DistributedStatistics + sequence + type(DistributedReal64) :: total + type(DistributedReal64) :: exclusive + type(DistributedReal64) :: min_cycle + type(DistributedReal64) :: max_cycle + type(DistributedReal64) :: mean_cycle + type(DistributedReal64) :: sum_square_deviation + type(DistributedInteger) :: num_cycles + end type DistributedStatistics + + type, extends(AdvancedMeter) :: DistributedMeter + private + type(DistributedStatistics) :: statistics + contains + procedure :: reduce_global + procedure :: reduce_mpi + generic :: reduce => reduce_global, reduce_mpi + + procedure :: get_statistics + procedure :: get_stats_total + procedure :: get_stats_min_cycle + procedure :: get_stats_max_cycle + procedure :: get_stats_num_cycles +!!$ procedure :: get_stats_sum_square_deviation + + procedure :: make_mpi_type_distributed_data + procedure :: make_mpi_type_distributed_real64 + procedure :: make_mpi_type_distributed_integer + generic :: make_mpi_type => make_mpi_type_distributed_data + generic :: make_mpi_type => make_mpi_type_distributed_real64 + generic :: make_mpi_type => make_mpi_type_distributed_integer + end type DistributedMeter + + + interface DistributedReal64 + module procedure :: new_DistributedReal64 + end interface DistributedReal64 + + interface DistributedInteger + module procedure :: new_DistributedInteger + end interface DistributedInteger + + interface DistributedMeter + module procedure :: new_DistributedMeter + end interface DistributedMeter + + + logical, save :: initialized = .false. + + integer, save :: mpi_dist_type + integer, save :: mpi_reduce_op + +contains + + function new_DistributedReal64(value, rank) result(distributed_real64) + type(DistributedReal64) :: distributed_real64 + real(kind=REAL64), intent(in) :: value + integer, intent(in) :: rank + + distributed_real64%total = value + distributed_real64%min = value + distributed_real64%max = value + distributed_real64%min_pe = rank + distributed_real64%max_pe = rank + distributed_real64%num_pes = 1 + + end function new_DistributedReal64 + + function new_DistributedInteger(value, rank) result(distributed_integer) + type(DistributedInteger) :: distributed_integer + integer, intent(in) :: value + integer, intent(in) :: rank + + distributed_integer%total = value + distributed_integer%min = value + distributed_integer%max = value + distributed_integer%min_pe = rank + distributed_integer%max_pe = rank + distributed_integer%num_pes = 1 + end function new_DistributedInteger + + + function new_DistributedMeter(gauge) result(distributed_meter) + type(DistributedMeter) :: distributed_meter + class(AbstractGauge), intent(in) :: gauge + + integer :: ierror + + if (.not. initialized) then + call initialize(ierror) + initialized = .true. + end if + + distributed_meter%AdvancedMeter = AdvancedMeter(gauge) + + end function new_DistributedMeter + + subroutine initialize(ierror) + integer, intent(out) :: ierror + + type (DistributedMeter) :: dummy + logical :: commute + + call dummy%make_mpi_type(dummy%statistics, mpi_dist_type, ierror) + call MPI_Type_commit(mpi_dist_type, ierror) + + commute = .true. + call MPI_Op_create(true_reduce, commute, mpi_reduce_op, ierror) + + end subroutine initialize + + function get_statistics(this) result(statistics) + type (DistributedStatistics) :: statistics + class (DistributedMeter), intent(in) :: this + statistics = this%statistics + end function get_statistics + + function reduce_distributed_real64(a, b) result(c) + type(DistributedReal64) :: c + type(DistributedReal64), intent(in) :: a + type(DistributedReal64), intent(in) :: b + + c%total = a%total + b%total + + if (b%min < a%min) then + c%min_pe = b%min_pe + elseif (a%min < b%min) then + c%min_pe = a%min_pe + else ! tie + c%min_pe = min(a%min_pe, b%min_pe) + end if + c%min = min(a%min, b%min) + + if (b%max > a%max) then + c%max_pe = b%max_pe + elseif (a%max < b%max) then + c%max_pe = a%max_pe + else ! tie + c%max_pe = min(a%max_pe, b%max_pe) + end if + c%max = max(a%max, b%max) + + c%num_pes = a%num_pes + b%num_pes + + end function reduce_distributed_real64 + + + function reduce_distributed_integer(a, b) result(c) + type(DistributedInteger) :: c + type(DistributedInteger), intent(in) :: a + type(DistributedInteger), intent(in) :: b + + c%total = a%total + b%total + + if (b%min < a%min) then + c%min_pe = b%min_pe + elseif (a%min < b%min) then + c%min_pe = a%min_pe + else ! tie + c%min_pe = min(a%min_pe, b%min_pe) + end if + c%min = min(a%min, b%min) + + if (b%max > a%max) then + c%max_pe = b%max_pe + elseif (a%max < b%max) then + c%max_pe = a%max_pe + else ! tie + c%max_pe = min(a%max_pe, b%max_pe) + end if + c%max = max(a%max, b%max) + + c%num_pes = a%num_pes + b%num_pes + + end function reduce_distributed_integer + + + function reduce_distributed_data(a, b) result(c) + type(DistributedStatistics) :: c + type(DistributedStatistics), intent(in) :: a + type(DistributedStatistics), intent(in) :: b + + c%total = a%total .reduce. b%total + c%exclusive = a%exclusive .reduce. b%exclusive + c%min_cycle = a%min_cycle .reduce. b%min_cycle + + c%max_cycle = a%max_cycle .reduce. b%max_cycle + c%sum_square_deviation = a%sum_square_deviation .reduce. b%sum_square_deviation + c%num_cycles = a%num_cycles .reduce. b%num_cycles + + end function reduce_distributed_data + + + function get_stats_total(this) result(total) + type(DistributedReal64) :: total + class(DistributedMeter), intent(in) :: this + + total = this%statistics%total + end function get_stats_total + + function get_stats_min_cycle(this) result(min_cycle) + type(DistributedReal64) :: min_cycle + class(DistributedMeter), intent(in) :: this + + min_cycle = this%statistics%min_cycle + end function get_stats_min_cycle + + function get_stats_max_cycle(this) result(max_cycle) + type(DistributedReal64) :: max_cycle + class(DistributedMeter), intent(in) :: this + + max_cycle = this%statistics%max_cycle + end function get_stats_max_cycle + + function get_stats_num_cycles(this) result(num_cycles) + type(DistributedInteger) :: num_cycles + class(DistributedMeter), intent(in) :: this + + num_cycles = this%statistics%num_cycles + end function get_stats_num_cycles + + + subroutine reduce_global(this, exclusive) + class(DistributedMeter), intent(inout) :: this + real(kind=REAL64), intent(in) :: exclusive + call this%reduce(MPI_COMM_WORLD, exclusive) + end subroutine reduce_global + + + subroutine reduce_mpi(this, comm, exclusive) + class(DistributedMeter), intent(inout) :: this + integer, intent(in) :: comm + real(kind=REAL64), intent(in) :: exclusive + + integer :: ierror + + integer :: dist_type + integer :: rank + type(DistributedStatistics) :: tmp, tmp2 + + call MPI_Comm_rank(comm, rank, ierror) + + this%statistics%total = DistributedReal64(this%get_total(), rank) + this%statistics%exclusive = DistributedReal64(exclusive, rank) + this%statistics%min_cycle = DistributedReal64(this%get_min_cycle(), rank) + this%statistics%max_cycle = DistributedReal64(this%get_max_cycle(), rank) + this%statistics%sum_square_deviation = DistributedReal64(this%get_sum_square_deviation(), rank) + this%statistics%num_cycles = DistributedInteger(this%get_num_cycles(), rank) + + tmp = this%statistics + call MPI_Reduce(tmp, this%statistics, 1, mpi_dist_type, mpi_reduce_op, 0, comm, ierror) + + end subroutine reduce_mpi + + + subroutine make_mpi_type_distributed_real64(this, r64, new_type, ierror) + class (DistributedMeter), intent(in) :: this + type (DistributedReal64), intent(in) :: r64 ! used only for generic resolution + integer, intent(out) :: new_type + integer, intent(out) :: ierror + + integer(kind=MPI_ADDRESS_KIND) :: displacements(2) + integer(kind=MPI_ADDRESS_KIND) :: lb, sz + + call MPI_Type_get_extent_x(MPI_REAL8, lb, sz, ierror) + displacements = [0_MPI_ADDRESS_KIND, 3*sz] + + call MPI_Type_create_struct(2, [3,4], displacements, [MPI_REAL8, MPI_INTEGER], new_type, ierror) + + end subroutine make_mpi_type_distributed_real64 + + + subroutine make_mpi_type_distributed_integer(this, int, new_type, ierror) + class (DistributedMeter), intent(in) :: this + type (DistributedInteger), intent(in) :: int ! used only for generic resolution + integer, intent(out) :: new_type + integer, intent(out) :: ierror + + integer(kind=MPI_ADDRESS_KIND) :: displacements(1) + + displacements = [0_MPI_ADDRESS_KIND] + call MPI_Type_create_struct(1, [6], displacements, [MPI_INTEGER], new_type, ierror) + + end subroutine make_mpi_type_distributed_integer + + + subroutine make_mpi_type_distributed_data(this, d, new_type, ierror) + class (DistributedMeter), intent(in) :: this + type (DistributedStatistics), intent(in) :: d ! used only for generic resolution + integer, intent(out) :: new_type + integer, intent(out) :: ierror + + integer(kind=MPI_ADDRESS_KIND) :: displacements(2) + integer(kind=MPI_ADDRESS_KIND) :: lb, sz, sz2 + integer :: type_dist_real64, type_dist_integer + + call this%make_mpi_type(this%statistics%total, type_dist_real64, ierror) + call this%make_mpi_type(this%statistics%num_cycles, type_dist_integer, ierror) + + call MPI_Type_get_extent_x(type_dist_real64, lb, sz, ierror) + displacements = [0_MPI_ADDRESS_KIND, 6*sz] + call MPI_Type_create_struct(2, [6,1], displacements, [type_dist_real64, type_dist_integer], new_type, ierror) + call MPI_Type_get_extent_x(new_type, lb, sz2, ierror) + + end subroutine make_mpi_type_distributed_data + + + + subroutine true_reduce(invec, inoutvec, len, type) + integer, intent(in) :: len + type(DistributedStatistics), intent(in) :: invec(len) + type(DistributedStatistics), intent(inout) :: inoutvec(len) + integer, intent(in) :: type + + integer :: i + + do i = 1, len + inoutvec(i) = invec(i) .reduce. inoutvec(i) + end do + + end subroutine true_reduce + +end module MAPL_DistributedMeter + + diff --git a/MAPL_Profiler/DistributedMeterNode.F90 b/MAPL_Profiler/DistributedMeterNode.F90 new file mode 100644 index 000000000000..471eb57c5f08 --- /dev/null +++ b/MAPL_Profiler/DistributedMeterNode.F90 @@ -0,0 +1,22 @@ +module MAP_DistributedMeterNode + implicit none + private + + public :: DistributedMeterNode + + + interface DistributedMeterNode + module procedure new_DistributedMeterNode + end interface DistributedMeterNode + + +contains + + + function new_DistributedMeterNode(meter_node, comm) result(distributed_meter_node) + class (AbstractMeterNode), intent(in) :: meter_node + integer, intent(in) :: comm ! mpi _communicator + + end function new_DistributedMeterNode + +end module MAP_DistributedMeterNode diff --git a/MAPL_Profiler/DistributedProfiler.F90 b/MAPL_Profiler/DistributedProfiler.F90 new file mode 100644 index 000000000000..67e414d484bd --- /dev/null +++ b/MAPL_Profiler/DistributedProfiler.F90 @@ -0,0 +1,96 @@ +module MAPL_DistributedProfiler + use MAPL_AbstractMeter + use MAPL_AbstractGauge + use MAPL_AbstractMeterNode + use MAPL_MeterNode + use MAPL_BaseProfiler + use Mapl_DistributedMeter + + use MAPL_AdvancedMeter + use MAPL_MpiTimerGauge + implicit none + private + + public :: DistributedProfiler + + type, extends(BaseProfiler) :: DistributedProfiler + private + class(AbstractGauge), allocatable :: gauge + integer :: comm = -1 + contains + procedure :: make_meter + procedure :: reduce + procedure :: copy + end type DistributedProfiler + + interface DistributedProfiler + module procedure :: new_DistributedProfiler + end interface DistributedProfiler + + +contains + + + function new_DistributedProfiler(name, gauge, comm) result(distributed_profiler) + type(DistributedProfiler), target :: distributed_profiler + character(*), intent(in) :: name + class(AbstractGauge), intent(in) :: gauge + integer, intent(in) :: comm + + distributed_profiler%gauge = gauge + distributed_profiler%comm = comm + + call distributed_profiler%set_node(MeterNode(name, distributed_profiler%make_meter())) + call distributed_profiler%start() + + end function new_DistributedProfiler + + + function make_meter(this) result(meter) + class(AbstractMeter), allocatable :: meter + class(DistributedProfiler), intent(in) :: this + + meter = DistributedMeter(this%gauge) +!!$ meter = DistributedMeter(MpiTimerGauge()) + end function make_meter + + + subroutine reduce(this) + class(DistributedProfiler), target, intent(inout) :: this + + class(AbstractMeterNodeIterator), target, allocatable :: iter + class(AbstractMeterNode), pointer :: root, node + class(AbstractMeter), pointer :: m + + root => this%get_root_node() + iter = root%begin() + do while (iter /= root%end()) + node => iter%get() + m => iter%get_meter() + + select type (m) + class is (DistributedMeter) + call m%reduce(this%comm, node%get_exclusive()) + class default + print*,'error - wrong type (other)' + end select + + call iter%next() + end do + + end subroutine reduce + + subroutine copy(new, old) + class(DistributedProfiler), target, intent(inout) :: new + class(BaseProfiler), target, intent(in) :: old + + call new%copy_profiler(old) + select type (old) + class is (DistributedProfiler) + new%gauge = old%gauge + new%comm = old%comm + end select + + end subroutine copy + +end module MAPL_DistributedProfiler diff --git a/MAPL_Profiler/ExclusiveColumn.F90 b/MAPL_Profiler/ExclusiveColumn.F90 new file mode 100644 index 000000000000..967066af7b25 --- /dev/null +++ b/MAPL_Profiler/ExclusiveColumn.F90 @@ -0,0 +1,73 @@ +module MAPL_ExclusiveColumn + use, intrinsic :: iso_fortran_env, only: REAL64 + use MAPL_AbstractColumn + use MAPL_SimpleColumn + use MAPL_AbstractMeterNode + use MAPL_AbstractMeter + use Mapl_DistributedMeter + implicit none + private + + public :: ExclusiveColumn + + type, extends(SimpleColumn) :: ExclusiveColumn + private + character(:), allocatable :: option + contains + procedure :: get_row + procedure :: get_row_dist + end type ExclusiveColumn + + interface ExclusiveColumn + module procedure :: new_ExclusiveColumn + end interface ExclusiveColumn + + +contains + + + function new_ExclusiveColumn(option) result(column) + type(ExclusiveColumn) :: column + character(*), optional, intent(in) :: option + if (present(option)) column%option = option + end function new_ExclusiveColumn + + + function get_row(this, node) result(row) + class(*), allocatable :: row + class (ExclusiveColumn), intent(in) :: this + class (AbstractMeterNode), target, intent(in) :: node + + + if (.not. allocated(this%option)) then + allocate(row, source=node%get_exclusive()) + else + call this%get_row_dist(node, row) + end if + + end function get_row + + + subroutine get_row_dist(this, node, row) + class(*), allocatable, intent(out) :: row + class (ExclusiveColumn), target, intent(in) :: this + class (AbstractMeterNode), target, intent(in) :: node + + class(AbstractMeter), pointer :: m + type(DistributedStatistics) :: stats + type(DistributedReal64) :: exclusive + + m => node%get_meter() + + select type (m) + class is (DistributedMeter) + stats = m%get_statistics() + exclusive = stats%exclusive + call this%fill_row(exclusive, this%option, row) + end select + + end subroutine get_row_dist + +end module MAPL_ExclusiveColumn + + diff --git a/MAPL_Profiler/FormattedTextColumn.F90 b/MAPL_Profiler/FormattedTextColumn.F90 new file mode 100644 index 000000000000..07685d58c268 --- /dev/null +++ b/MAPL_Profiler/FormattedTextColumn.F90 @@ -0,0 +1,123 @@ +module MAPL_FormattedTextColumn + use, intrinsic :: iso_fortran_env, only: REAL64 + use MAPL_AbstractColumn + use MAPL_AbstractMeterNode + use MAPL_TextColumn + use GFTL_UnlimitedVector + implicit none + private + + public :: FormattedTextColumn + + type, extends(TextColumn) :: FormattedTextColumn + private + + character(:), allocatable :: header(:) + character(:), allocatable :: format + class (AbstractColumn), allocatable :: data_column + contains + procedure :: get_header + procedure :: get_rows + procedure :: get_num_rows_header + end type FormattedTextColumn + + + interface FormattedTextColumn + module procedure new_FormattedTextColumn_scalar_header + module procedure new_FormattedTextColumn_array_header + end interface FormattedTextColumn + + +contains + + + function new_FormattedTextColumn_scalar_header(header, format, width, data_column, separator) result(column) + type (FormattedTextColumn) :: column + character(*), intent(in) :: header + character(*), intent(in) :: format + integer, intent(in) :: width + class (AbstractColumn), intent(in) :: data_column + character(1), optional :: separator + + column = FormattedTextColumn([header], format, width, data_column, separator=separator) + + end function new_FormattedTextColumn_scalar_header + + + function new_FormattedTextColumn_array_header(header, format, width, data_column, separator) result(column) + type (FormattedTextColumn) :: column + character(*), intent(in) :: header(:) + character(*), intent(in) :: format + integer, intent(in) :: width + class (AbstractColumn), intent(in) :: data_column + character(1), optional :: separator + + column%header = header + column%format = format + call column%set_width(width) + column%data_column = data_column + + if (present(separator)) then + call column%set_separator(separator) + end if + + end function new_FormattedTextColumn_array_header + + + + subroutine get_header(this, header) + class (FormattedTextColumn), intent(in) :: this + character(:), allocatable, intent(out) :: header(:) + + integer :: w, n, n0 + integer :: i + + w = this%get_width() + n0 = size(this%header) + n = this%get_num_rows_header() + allocate(character(w) :: header(n)) + + do i = 1, n0 + header(i)(:) = this%header(i) + end do + call this%get_separator(header(n0+1:n)) + call this%center(header) + + end subroutine get_header + + integer function get_num_rows_header(this) result(num_rows) + class(FormattedTextColumn), intent(in) :: this + + num_rows = size(this%header) + this%get_num_rows_separator() + + end function get_num_rows_header + + + subroutine get_rows(this, node, rows) + use MAPL_AbstractMeterNode + class (FormattedTextColumn), intent(in) :: this + class (AbstractMeterNode), target, intent(in) :: node + character(:), allocatable, intent(out) :: rows(:) + + type (UnlimitedVector) :: values + + integer :: i, n + + values = this%data_column%get_rows(node) + + n = this%get_width() + allocate(character(n) :: rows(values%size())) + + do i = 1, values%size() + select type (v => values%at(i)) + type is (integer) + write(rows(i),this%format) v + type is (real(kind=REAL64)) + write(rows(i),this%format) v + end select + end do + + end subroutine get_rows + + +end module MAPL_FormattedTextColumn diff --git a/MAPL_Profiler/FortranTimerGauge.F90 b/MAPL_Profiler/FortranTimerGauge.F90 new file mode 100644 index 000000000000..bdb1949fcb37 --- /dev/null +++ b/MAPL_Profiler/FortranTimerGauge.F90 @@ -0,0 +1,47 @@ +module MAPL_FortranTimerGauge + use, intrinsic :: iso_fortran_env, only: REAL64, INT64 + use MAPL_AbstractGauge + implicit none + private + + public :: FortranTimerGauge + + type, extends(AbstractGauge) :: FortranTimerGauge + private + real(kind=REAL64) :: denominator + contains + procedure :: get_measurement + end type FortranTimerGauge + + interface FortranTimerGauge + module procedure :: new_FortranTimerGauge + end interface FortranTimerGauge + + +contains + + + function new_FortranTimerGauge() result(gauge) + type (FortranTimerGauge) :: gauge + integer(kind=REAL64) :: count_rate + + call system_clock(count_rate=count_rate) + gauge%denominator = 1._REAL64/count_rate + + end function new_FortranTimerGauge + + + ! TODO: compute denomintor once during initialization + function get_measurement(this) result(measurement) + real(kind=REAL64) :: measurement + class(FortranTimerGauge), intent(inout) :: this + + integer(kind=INT64) :: tick, rate + call system_clock(count=tick, count_rate=rate) + + measurement = tick * this%denominator + + end function get_measurement + + +end module MAPL_FortranTimerGauge diff --git a/MAPL_Profiler/InclusiveColumn.F90 b/MAPL_Profiler/InclusiveColumn.F90 new file mode 100644 index 000000000000..b792b258ff98 --- /dev/null +++ b/MAPL_Profiler/InclusiveColumn.F90 @@ -0,0 +1,71 @@ +module MAPL_InclusiveColumn + use, intrinsic :: iso_fortran_env, only: REAL64 + use MAPL_AbstractColumn + use MAPL_SimpleColumn + use MAPL_AbstractMeterNode + use MAPL_AbstractMeter + use Mapl_DistributedMeter + implicit none + private + + public :: InclusiveColumn + + type, extends(SimpleColumn) :: InclusiveColumn + private + character(:), allocatable :: option + contains + procedure :: get_row + procedure :: get_row_dist + end type InclusiveColumn + + interface InclusiveColumn + module procedure :: new_InclusiveColumn + end interface InclusiveColumn + + +contains + + + function new_InclusiveColumn(option) result(column) + type(InclusiveColumn) :: column + character(*), optional, intent(in) :: option + if (present(option)) column%option = option + end function new_InclusiveColumn + + + function get_row(this, node) result(row) + class(*), allocatable :: row + class (InclusiveColumn), intent(in) :: this + class (AbstractMeterNode), target, intent(in) :: node + + if (.not. allocated(this%option)) then + allocate(row, source=node%get_inclusive()) + else + call this%get_row_dist(node, row) + end if + + end function get_row + + + subroutine get_row_dist(this, node, row) + class (InclusiveColumn), target, intent(in) :: this + class (AbstractMeterNode), target, intent(in) :: node + class(*), allocatable, intent(out) :: row + + class(AbstractMeter), pointer :: m + type(DistributedStatistics) :: stats + type(DistributedReal64) :: inclusive + + m => node%get_meter() + + select type (m) + class is (DistributedMeter) + stats = m%get_statistics() + inclusive = stats%total + + call this%fill_row(inclusive, this%option, row) + end select + + end subroutine get_row_dist + +end module MAPL_InclusiveColumn diff --git a/MAPL_Profiler/MAPL_Profiler.F90 b/MAPL_Profiler/MAPL_Profiler.F90 new file mode 100644 index 000000000000..73479da34a43 --- /dev/null +++ b/MAPL_Profiler/MAPL_Profiler.F90 @@ -0,0 +1,41 @@ +! Package exporter +module MAPL_Profiler + use MAPL_AbstractMeter + use MAPL_AbstractMeterNode + use MAPL_AbstractMeterFactory + use MAPL_MeterNodeVector + use MAPL_MeterNode + use MAPL_BaseProfiler + + use MAPL_AdvancedMeter + use MAPL_MpiTimerGauge + use MAPL_FortranTimerGauge + use MAPL_RssMemoryGauge + use MAPL_VmstatMemoryGauge + + use MAPL_AbstractColumn + use MAPL_SimpleColumn + use MAPL_TextColumn + use MAPL_SimpleTextColumn + use MAPL_FormattedTextColumn + use MAPL_MemoryTextColumn + use MAPL_NameColumn + use MAPL_NumCyclesColumn + use MAPL_InclusiveColumn + use MAPL_ExclusiveColumn + use MAPL_StdDevColumn + use MAPL_MinCycleColumn + use MAPL_MaxCycleColumn + use MAPL_MeanCycleColumn + use MAPL_PercentageColumn + use MAPL_TextColumnVector + use MAPL_MultiColumn + + use MAPL_TimeProfiler + use MAPL_MemoryProfiler + use MAPL_ProfileReporter + use MAPL_DistributedMeter + use MAPL_DistributedProfiler + implicit none + +end module MAPL_Profiler diff --git a/MAPL_Profiler/MaxCycleColumn.F90 b/MAPL_Profiler/MaxCycleColumn.F90 new file mode 100644 index 000000000000..af3ea6838e0c --- /dev/null +++ b/MAPL_Profiler/MaxCycleColumn.F90 @@ -0,0 +1,79 @@ +module MAPL_MaxCycleColumn + use, intrinsic :: iso_fortran_env, only: REAL64 + use MAPL_SimpleColumn + use MAPL_AbstractMeterNode + use MAPL_AbstractMeter + use MAPL_AdvancedMeter + use Mapl_DistributedMeter + implicit none + private + + public :: MaxCycleColumn + + type, extends(SimpleColumn) :: MaxCycleColumn + private + character(:), allocatable :: option + contains + procedure :: get_row + procedure :: get_row_dist + end type MaxCycleColumn + + interface MaxCycleColumn + module procedure :: new_MaxCycleColumn + end interface MaxCycleColumn + + +contains + + + function new_MaxCycleColumn(option) result(column) + type(MaxCycleColumn) :: column + character(*), optional, intent(in) :: option + if (present(option)) column%option = option + end function new_MaxCycleColumn + + + function get_row(this, node) result(row) + class(*), allocatable :: row + class (MaxCycleColumn), intent(in) :: this + class (AbstractMeterNode), target, intent(in) :: node + class (AbstractMeter), pointer :: tmr + + tmr => node%get_meter() + select type (tmr) + class is (AdvancedMeter) + if (.not. allocated(this%option)) then + allocate(row, source=tmr%get_max_cycle()) + else + call this%get_row_dist(node, row) + end if + end select + + end function get_row + + + subroutine get_row_dist(this, node, row) + class (MaxCycleColumn), target, intent(in) :: this + class (AbstractMeterNode), target, intent(in) :: node + class(*), allocatable, intent(out) :: row + + class(AbstractMeter), pointer :: m + type(DistributedStatistics) :: stats + type(DistributedReal64) :: max_cycle + + m => node%get_meter() + + select type (m) + class is (DistributedMeter) + stats = m%get_statistics() + max_cycle = stats%max_cycle + + call this%fill_row(max_cycle, this%option, row) + + end select + + end subroutine get_row_dist + +end module MAPL_MaxCycleColumn + + diff --git a/MAPL_Profiler/MeanCycleColumn.F90 b/MAPL_Profiler/MeanCycleColumn.F90 new file mode 100644 index 000000000000..4082d9b6204b --- /dev/null +++ b/MAPL_Profiler/MeanCycleColumn.F90 @@ -0,0 +1,80 @@ +module MAPL_MeanCycleColumn + use, intrinsic :: iso_fortran_env, only: REAL64 + use MAPL_SimpleColumn + use MAPL_AbstractMeterNode + use MAPL_AbstractMeter + use MAPL_AdvancedMeter + use Mapl_DistributedMeter + implicit none + private + + public :: MeanCycleColumn + + type, extends(SimpleColumn) :: MeanCycleColumn + private + character(:), allocatable :: option + contains + procedure :: get_row + procedure :: get_row_dist + end type MeanCycleColumn + + interface MeanCycleColumn + module procedure :: new_MeanCycleColumn + end interface MeanCycleColumn + + +contains + + + function new_MeanCycleColumn(option) result(column) + type(MeanCycleColumn) :: column + character(*), optional, intent(in) :: option + if (present(option)) column%option = option + end function new_MeanCycleColumn + + + function get_row(this, node) result(row) + class(*), allocatable :: row + class (MeanCycleColumn), intent(in) :: this + class (AbstractMeterNode), target, intent(in) :: node + class (AbstractMeter), pointer :: tmr + + tmr => node%get_meter() + select type (tmr) + class is (AdvancedMeter) + if (.not. allocated(this%option)) then + allocate(row, source=tmr%get_mean_cycle()) + else + call this%get_row_dist(node, row) + end if + end select + + end function get_row + + + subroutine get_row_dist(this, node, row) + class (MeanCycleColumn), target, intent(in) :: this + class (AbstractMeterNode), target, intent(in) :: node + class(*), allocatable, intent(out) :: row + + class(AbstractMeter), pointer :: m + type(DistributedStatistics) :: stats + type(DistributedReal64) :: mean_cycle + + m => node%get_meter() + + select type (m) + class is (DistributedMeter) + stats = m%get_statistics() + mean_cycle = stats%mean_cycle + + call this%fill_row(mean_cycle, this%option, row) + + end select + + end subroutine get_row_dist + +end module MAPL_MeanCycleColumn + + + diff --git a/MAPL_Profiler/MemoryProfiler.F90 b/MAPL_Profiler/MemoryProfiler.F90 new file mode 100644 index 000000000000..57bad67e272c --- /dev/null +++ b/MAPL_Profiler/MemoryProfiler.F90 @@ -0,0 +1,141 @@ +module MAPL_MemoryProfiler_private + use MAPL_BaseProfiler, only: BaseProfiler + use MAPL_BaseProfiler, only: MemoryProfilerIterator => BaseProfilerIterator + + use MAPL_RssMemoryGauge + use MAPL_VmstatMemoryGauge + use MAPL_AdvancedMeter + use MAPL_AbstractMeter + use MAPL_MeterNode + implicit none + private + + public :: MemoryProfiler + public :: MemoryProfilerIterator + public :: get_global_memory_profiler + + + type, extends(BaseProfiler) :: MemoryProfiler + private + contains + procedure :: make_meter + procedure :: copy + end type MemoryProfiler + + interface MemoryProfiler + module procedure new_MemoryProfiler + end interface MemoryProfiler + + type(MemoryProfiler), protected, target :: global_memory_profiler + +contains + + + function new_MemoryProfiler(name) result(prof) + type(MemoryProfiler), target :: prof + character(*), intent(in) :: name + + class(AbstractMeter), pointer :: t + + call prof%set_node(MeterNode(name, prof%make_meter())) + call prof%start() + + end function new_MemoryProfiler + + function make_meter(this) result(meter) + class(AbstractMeter), allocatable :: meter + class(MemoryProfiler), intent(in) :: this + meter = AdvancedMeter(RssMemoryGauge()) +!!$ meter = AdvancedMeter(VmstatMemoryGauge()) + end function make_meter + + + function get_global_memory_profiler() result(memory_profiler) + type(MemoryProfiler), pointer :: memory_profiler + + memory_profiler => global_memory_profiler + + end function get_global_memory_profiler + + + subroutine copy(new, old) + class(MemoryProfiler), target, intent(inout) :: new + class(BaseProfiler), target, intent(in) :: old + + call new%copy_profiler(old) + + end subroutine copy + + +end module MAPL_MemoryProfiler_private + + + +module MAPL_MemoryProfiler + use MAPL_BaseProfiler + use MAPL_MemoryProfiler_private + implicit none + private + + public :: MemoryProfiler + public :: MemoryProfilerIterator + public :: get_global_memory_profiler + public :: initialize + public :: finalize + public :: start + public :: stop + +contains + + subroutine initialize(name) + character(*), optional, intent(in) :: name + + type(MemoryProfiler), pointer :: memory_profiler + character(:), allocatable :: name_ + + if (present(name)) then + name_ = name + else + name_ = 'top' + end if + + memory_profiler => get_global_memory_profiler() + memory_profiler = MemoryProfiler(name_) + + end subroutine initialize + + + subroutine finalize() + + type(MemoryProfiler), pointer :: memory_profiler + + memory_profiler => get_global_memory_profiler() + call memory_profiler%finalize() + + end subroutine finalize + + + subroutine start(name) + character(*), intent(in) :: name + + type(MemoryProfiler), pointer :: memory_profiler + + memory_profiler => get_global_memory_profiler() + call memory_profiler%start(name) + + end subroutine start + + + subroutine stop(name) + character(*), intent(in) :: name + + type(MemoryProfiler), pointer :: memory_profiler + + memory_profiler => get_global_memory_profiler() + call memory_profiler%stop(name) + + end subroutine stop + + + +end module MAPL_MemoryProfiler diff --git a/MAPL_Profiler/MemoryTextColumn.F90 b/MAPL_Profiler/MemoryTextColumn.F90 new file mode 100644 index 000000000000..71c7b94edd4e --- /dev/null +++ b/MAPL_Profiler/MemoryTextColumn.F90 @@ -0,0 +1,172 @@ +module MAPL_MemoryTextColumn + use, intrinsic :: iso_fortran_env, only: REAL64, INT64 + use MAPL_AbstractColumn + use MAPL_AbstractMeterNode + use MAPL_TextColumn + use GFTL_UnlimitedVector + implicit none + private + + public :: MemoryTextColumn + + type String + character(:), allocatable :: string + end type String + type, extends(TextColumn) :: MemoryTextColumn + private +!!$ character(:), allocatable :: header(:) + type (String), allocatable :: header(:) + character(:), allocatable :: format + class (AbstractColumn), allocatable :: data_column + contains + procedure :: get_header + procedure :: get_num_rows_header + procedure :: get_rows + end type MemoryTextColumn + + + interface MemoryTextColumn + module procedure new_MemoryTextColumn + end interface MemoryTextColumn + + +contains + + + function new_MemoryTextColumn(header, format, width, data_column, separator) result(column) + type (MemoryTextColumn) :: column + character(*), intent(in) :: header(:) + character(*), intent(in) :: format + integer, intent(in) :: width + class (AbstractColumn), intent(in) :: data_column + character(1), optional, intent(in) :: separator + + integer :: i, n + character(:), allocatable :: word + + n = size(header) + allocate(column%header(n)) + do i = 1, n + column%header(i)%string = header(i) + end do + + column%format = format + call column%set_width(width) + + column%data_column = data_column + + if (present(separator)) then + call column%set_separator(separator) + end if + + + end function new_MemoryTextColumn + + + + subroutine get_header(this, header) + class (MemoryTextColumn), intent(in) :: this + character(:), allocatable, intent(out) :: header(:) + integer :: w, n + integer :: i + + w = this%get_width() + n = this%get_num_rows_header() + allocate(character(w) :: header(n)) + do i = 1, size(this%header) + header(i)(:) = this%header(i)%string + end do + call this%get_separator(header(size(this%header)+1:)) + call this%center(header) + + end subroutine get_header + + + integer function get_num_rows_header(this) result(num_rows) + class(MemoryTextColumn), intent(in) :: this + num_rows = size(this%header) + this%get_num_rows_separator() + end function get_num_rows_header + + + subroutine get_rows(this, node, rows) + use MAPL_AbstractMeterNode + class (MemoryTextColumn), intent(in) :: this + class (AbstractMeterNode), target, intent(in) :: node + character(:), allocatable, intent(out) :: rows(:) + + integer :: n, i + character(2) :: suffix + real(kind=REAL64) :: x + type (UnlimitedVector) :: values + + n = this%get_width() + + values = this%data_column%get_rows(node) + allocate(character(n) :: rows(values%size())) + + do i = 1, values%size() + select type (v => values%at(i)) + type is (integer) + x = real(v, kind=REAL64) + suffix = get_suffix(x) + write(rows(i),this%format) convert(x), suffix + type is (real(kind=REAL64)) + suffix = get_suffix(v) + write(rows(i),this%format) convert(v), suffix + end select + end do + + contains + + + function get_suffix(x) result(suffix) + character(2) :: suffix + real(kind=REAL64), intent(in) :: x + + integer(kind=INT64) :: ix + integer(kind=INT64) :: KB = 1024 + + ix = ceiling(abs(x)) + if (ix < KB) then + suffix = ' B' + elseif (ix < KB**2) then + suffix = 'KB' + elseif (ix < KB**3) then + suffix = 'MB' + elseif (ix < KB**4) then + suffix = 'GB' + else + suffix = 'TB' + end if + + end function get_suffix + + function convert(x) result(ix) + integer(kind=INT64) :: ix + real(kind=REAL64), intent(in) :: x + + + integer(kind=INT64) :: KB = 1024 + + ix = ceiling(abs(x)) + + if (ix < KB) then + ix = ix + elseif (ix < KB**2) then + ix = ix / KB + elseif (ix < KB**3) then + ix = ix / KB**2 + elseif (ix < KB**4) then + ix = ix / KB**3 + else + ix = ix / KB**4 + end if + + ix = sign(1.d0, x) * ix + + end function convert + + end subroutine get_rows + + +end module MAPL_MemoryTextColumn diff --git a/MAPL_Profiler/MeterNode.F90 b/MAPL_Profiler/MeterNode.F90 new file mode 100644 index 000000000000..dac0f4dd8a52 --- /dev/null +++ b/MAPL_Profiler/MeterNode.F90 @@ -0,0 +1,440 @@ +module MAPL_MeterNode + use, intrinsic :: iso_fortran_env, only: REAL64, REAL128 + use MAPL_AbstractMeter + use MAPL_AbstractMeterNode + use MAPL_MeterNodeVector + implicit none + private + + public :: MeterNode + public :: MeterNodeIterator + + type, extends(AbstractMeterNode) :: MeterNode + private + + ! Node data + class(AbstractMeter), allocatable :: meter + character(:), allocatable :: name + + ! Tree structure + integer :: depth + type (MeterNodeVector) :: children + integer :: last_child_accessed = 0 + + contains + procedure :: get_meter + procedure :: get_name + procedure :: get_depth + procedure :: get_inclusive + procedure :: get_exclusive + procedure :: add_child + procedure :: find_child + procedure :: get_child + procedure :: has_child + procedure :: get_num_nodes + procedure :: get_num_children + + procedure :: accumulate + procedure :: reset + + procedure :: begin + procedure :: end + end type MeterNode + + + type, extends(AbstractMeterNodeIterator) :: MeterNodeIterator + private + class (MeterNode), pointer :: reference => null() + class (AbstractMeterNode), pointer :: current => null() + + ! Subiterators are allocated after iterator goes beyond the root node + type (MeterNodeVectorIterator), allocatable :: iterator_over_children + class (AbstractMeterNodeIterator), allocatable :: iterator_of_current_child + contains + procedure :: get + procedure :: get_name => get_name_iter + procedure :: get_meter => get_meter_iter + procedure :: equals + procedure :: not_equals + procedure :: next + end type MeterNodeIterator + + + interface MeterNode + module procedure new_MeterNode + end interface MeterNode + + interface MeterNodeIterator + module procedure new_MeterNodeIterator + end interface MeterNodeIterator + + + integer, parameter :: NOT_FOUND = -1 + +contains + + + function new_MeterNode(name, meter, depth) result(tree) + type (MeterNode) :: tree + character(*), intent(in) :: name + class(AbstractMeter), intent(in) :: meter + integer, optional, intent(in) :: depth + + tree%name = name + tree%meter = meter + + if (present(depth)) then + tree%depth = depth + else + tree%depth = 0 + end if + + tree%last_child_accessed = 0 + + end function new_MeterNode + + + function get_meter(this) result(meter) + class (AbstractMeter), pointer :: meter + class (MeterNode), target, intent(in) :: this + meter => this%meter + end function get_meter + + + function get_name(this) result(name) + character(:), pointer :: name + class (MeterNode), target, intent(in) :: this + name => this%name + end function get_name + + + function get_inclusive(this) result(inclusive) + real(kind=REAL64) :: inclusive + class (MeterNode), intent(in) :: this + inclusive = this%meter%get_total() + end function get_inclusive + + + function get_exclusive(this) result(exclusive) + real(kind=REAL64) :: exclusive + class (MeterNode), intent(in) :: this + + type (MeterNodevectorIterator) :: iter + class (AbstractMeterNode), pointer :: child + real(kind=REAL128) :: tmp + + ! Subtract time of submeters from time of node meter. Note the + ! use of 128-bit precision to avoid negative exclusive times due + ! to roundoff. + tmp = this%get_inclusive() + + iter = this%children%begin() + do while (iter /= this%children%end()) + child => iter%get() + tmp = tmp - child%get_inclusive() + call iter%next() + end do + + exclusive = tmp + end function get_exclusive + + + subroutine add_child(this, name, meter) + class(MeterNode), target, intent(inout) :: this + character(*), intent(in) :: name + class(AbstractMeter), intent(in) :: meter + + class(AbstractMeterNode), pointer :: child + type (MeterNode) :: tmp + integer :: idx + + idx = this%find_child(name) + + if (idx == NOT_FOUND) then ! really add child + tmp = MeterNode(name, meter, this%get_depth()+1) + call this%children%push_back(tmp) + ! Note: last still references the previous child because we are likely + ! to follow this call with a get_child(), which should then be the 1st child + ! tested. + this%last_child_accessed = this%children%size() - 1 + else + ! node exists - makes it easier on client code to not throw + ! an exception here. + end if + + end subroutine add_child + + + function get_depth(this) result(depth) + integer :: depth + class (MeterNode), intent(in) :: this + depth = this%depth + end function get_depth + + + ! TODO: needs return code for failure + function get_child(this, name) result(child) + class (AbstractMeterNode), pointer :: child + class (MeterNode), target, intent(inout) :: this + character(*), intent(in) :: name + + integer :: idx + + idx = this%find_child(name) + if (idx /= NOT_FOUND) then + child => this%children%at(idx) + this%last_child_accessed = idx + else + child => null() + this%last_child_accessed = 0 + end if + + end function get_child + + ! We search by starting just after the last child accessed. The + ! theory is that meters are usually accessed cyclically in the same + ! order as they are first created. This is why the children + ! are stored as a vector rather than a map with the names as keys. + integer function find_child(this, name) result(idx) + class (MeterNode), intent(in) :: this + character(*), intent(in) :: name + + integer :: i, ii, n + class (AbstractMeterNode), pointer :: t + + n = this%children%size() + do i = 1, n + ii = 1 + mod(i + this%last_child_accessed - 1, n) + t => this%children%at(ii) + select type (t) + class is (MeterNode) + if (name == t%name) then + idx = ii + return + end if + class default + print*,'insert error handler' + end select + end do + + idx = NOT_FOUND + + end function find_child + + logical function has_child(this, name) + class (AbstractMeterNode), pointer :: child + class (MeterNode), target, intent(in) :: this + character(*), intent(in) :: name + has_child = (this%find_child(name) /= NOT_FOUND) + end function has_child + + + recursive integer function get_num_nodes(this) result(num_nodes) + class (MeterNode), target, intent(in) :: this + type (MeterNodeVectorIterator) :: iter + + class (AbstractMeterNode), pointer :: child + + num_nodes = 1 + iter = this%children%begin() + do while (iter /= this%children%end()) + child => iter%get() + num_nodes = num_nodes + child%get_num_nodes() + call iter%next() + end do + + end function get_num_nodes + + + integer function get_num_children(this) result(num_children) + class (MeterNode), target, intent(in) :: this + + num_children = this%children%size() + + end function get_num_children + + + + function new_MeterNodeIterator(meter_node) result(iterator) + type (MeterNode), target, intent(in) :: meter_node + type (MeterNodeIterator) :: iterator + + iterator%reference => meter_node + iterator%current => meter_node + + end function new_MeterNodeIterator + + + function begin(this) result(iterator) + class (AbstractMeterNodeIterator), allocatable :: iterator + class (MeterNode), target, intent(in) :: this + +!!$ iterator = MeterNodeIterator(this) + allocate(iterator, source=MeterNodeIterator(this)) + + end function begin + + + + function end(this) result(iterator) + class (AbstractMeterNodeIterator), allocatable :: iterator + class (MeterNode), target, intent(in) :: this + + type (MeterNodeIterator) :: tmp + + tmp = MeterNodeIterator(this) +!!$ iterator = MeterNodeIterator(this) + iterator = tmp + + select type (q => iterator) + class is (MeterNodeIterator) + q%current => null() + class default + print*,'uh oh' + end select + + end function end + + + recursive subroutine next(this) + class (MeterNodeIterator), intent(inout) :: this + class (AbstractMeterNode), pointer :: current_child + + + if (.not. associated(this%current)) return ! done + + if (.not. allocated(this%iterator_over_children)) then + this%iterator_over_children = this%reference%children%begin() + if (this%iterator_over_children /= this%reference%children%end()) then + current_child => this%iterator_over_children%get() + this%iterator_of_current_child = current_child%begin() + this%current => this%iterator_of_current_child%get() + else + this%current => null() + end if + else + call this%iterator_of_current_child%next() + this%current => this%iterator_of_current_child%get() + + if (.not. associated(this%current)) then ! go to next child + deallocate(this%iterator_of_current_child) + call this%iterator_over_children%next() + if (this%iterator_over_children == this%reference%children%end()) then ! done + deallocate(this%iterator_over_children) + else + current_child => this%iterator_over_children%get() + this%iterator_of_current_child = current_child%begin() ! always at least one node + this%current => this%iterator_of_current_child%get() + end if + end if + end if + + end subroutine next + + + function get(this) result(tree) + class (AbstractMeterNode), pointer :: tree + class (MeterNodeIterator), target, intent(in) :: this + tree => this%current + end function get + + + function get_meter_iter(this) result(t) + class (AbstractMeter), pointer :: t + class (MeterNodeIterator), intent(in) :: this + t => this%current%get_meter() + end function get_meter_iter + + + function get_name_iter(this) result(name) + character(:), pointer :: name + class (MeterNodeIterator), intent(in) :: this + name => this%current%get_name() + end function get_name_iter + + + logical function equals(a, b) + class (MeterNodeIterator), intent(in) :: a + class (AbstractMeterNodeIterator), intent(in) :: b + + + select type (b) + type is (MeterNodeIterator) + equals = associated(a%reference, b%reference) + if (.not. equals) return + + equals = associated(a%current) .eqv. associated(b%current) + if (.not. equals) return + + if (associated(a%current)) then + equals = associated(a%current, b%current) + if (.not. equals) return + end if + class default + equals = .false. + end select + + end function equals + + + logical function not_equals(a, b) + class (MeterNodeIterator), intent(in) :: a + class (AbstractMeterNodeIterator), intent(in) :: b + not_equals = .not. (a == b) + end function not_equals + + + ! Set all meters back to 0 + recursive subroutine reset(this) + class (MeterNode), target, intent(inout) :: this + type (MeterNodeVectorIterator) :: iter + class (AbstractMeterNode), pointer :: child + + call this%meter%reset + + iter = this%children%begin() + do while (iter /= this%children%end()) + child => iter%get() + call child%reset() + call iter%next() + end do + + end subroutine reset + + recursive subroutine accumulate(this, other) + class (MeterNode), intent(inout) :: this + class (AbstractMeterNode), target, intent(in) :: other + + class (AbstractMeterNode), pointer :: child + class (AbstractMeterNodeIterator), allocatable :: iter + class (AbstractMeter), pointer :: t + character(:), pointer :: name + + ! GFortran 8.2 complains about recursive call of nonrecursive + ! procedure (nested copy of data structure) + + + name => other%get_name() + child => this%get_child(name) + if (associated(child)) then + t => child%get_meter() + else + call this%add_child(name, this%get_meter()) + child => this%get_child(name) + t => child%get_meter() + call t%reset() + end if + call t%accumulate(other%get_meter()) + + ! recurse over children of other + iter = other%begin() + call iter%next() ! skip top node (already handled) + do while (iter /= other%end()) + call child%accumulate(iter%get()) + call iter%next() + end do + + end subroutine accumulate + + +end module MAPL_MeterNode diff --git a/MAPL_Profiler/MeterNodeStack.F90 b/MAPL_Profiler/MeterNodeStack.F90 new file mode 100644 index 000000000000..34f69ea4d089 --- /dev/null +++ b/MAPL_Profiler/MeterNodeStack.F90 @@ -0,0 +1,15 @@ +module MAPL_MeterNodeStack + use MAPL_AbstractMeterNode + +#define _type class (AbstractMeterNode) +#define _pointer +#define _vector MeterNodeStack +#define _iterator MeterNodeStackIterator +#include "templates/vector.inc" + +#undef _iterator +#undef _vector +#undef _pointer +#undef _type + +end module MAPL_MeterNodeStack diff --git a/MAPL_Profiler/MeterNodeVector.F90 b/MAPL_Profiler/MeterNodeVector.F90 new file mode 100644 index 000000000000..65abd6d43c30 --- /dev/null +++ b/MAPL_Profiler/MeterNodeVector.F90 @@ -0,0 +1,15 @@ +module MAPL_MeterNodeVector + use MAPL_AbstractMeterNode + +#define _type class (AbstractMeterNode) +#define _allocatable +#define _vector MeterNodeVector +#define _iterator MeterNodeVectorIterator +#include "templates/vector.inc" + +#undef _iterator +#undef _vector +#undef _pointer +#undef _type + +end module MAPL_MeterNodeVector diff --git a/MAPL_Profiler/MinCycleColumn.F90 b/MAPL_Profiler/MinCycleColumn.F90 new file mode 100644 index 000000000000..c66ba580aeeb --- /dev/null +++ b/MAPL_Profiler/MinCycleColumn.F90 @@ -0,0 +1,80 @@ +module MAPL_MinCycleColumn + use, intrinsic :: iso_fortran_env, only: REAL64 + use MAPL_SimpleColumn + use MAPL_AbstractMeterNode + use MAPL_AbstractMeter + use MAPL_AdvancedMeter + use Mapl_DistributedMeter + implicit none + private + + public :: MinCycleColumn + + type, extends(SimpleColumn) :: MinCycleColumn + private + character(:), allocatable :: option + contains + procedure :: get_row + procedure :: get_row_dist + end type MinCycleColumn + + interface MinCycleColumn + module procedure :: new_MinCycleColumn + end interface MinCycleColumn + + +contains + + + function new_MinCycleColumn(option) result(column) + type(MinCycleColumn) :: column + character(*), optional, intent(in) :: option + if (present(option)) column%option = option + end function new_MinCycleColumn + + + function get_row(this, node) result(row) + class(*), allocatable :: row + class (MinCycleColumn), intent(in) :: this + class (AbstractMeterNode), target, intent(in) :: node + class (AbstractMeter), pointer :: tmr + + tmr => node%get_meter() + select type (tmr) + class is (AdvancedMeter) + if (.not. allocated(this%option)) then + allocate(row, source=tmr%get_min_cycle()) + else + call this%get_row_dist(node, row) + end if + end select + + end function get_row + + + subroutine get_row_dist(this, node, row) + class (MinCycleColumn), target, intent(in) :: this + class (AbstractMeterNode), target, intent(in) :: node + class(*), allocatable, intent(out) :: row + + class(AbstractMeter), pointer :: m + type(DistributedStatistics) :: stats + type(DistributedReal64) :: min_cycle + + m => node%get_meter() + + select type (m) + class is (DistributedMeter) + stats = m%get_statistics() + min_cycle = stats%min_cycle + + call this%fill_row(min_cycle, this%option, row) + + end select + + end subroutine get_row_dist + +end module MAPL_MinCycleColumn + + + diff --git a/MAPL_Profiler/MpiTimerGauge.F90 b/MAPL_Profiler/MpiTimerGauge.F90 new file mode 100644 index 000000000000..10532402654e --- /dev/null +++ b/MAPL_Profiler/MpiTimerGauge.F90 @@ -0,0 +1,42 @@ +#include "unused_dummy.H" + +module MAPL_MpiTimerGauge + use, intrinsic :: iso_fortran_env, only: REAL64 + use MPI, only: MPI_Wtime + use MAPL_AbstractGauge + implicit none + private + + public :: MpiTimerGauge + + type, extends(AbstractGauge) :: MpiTimerGauge + private + contains + procedure :: get_measurement + end type MpiTimerGauge + + interface MpiTimerGauge + module procedure :: new_MpiTimerGauge + end interface MpiTimerGauge + + +contains + + + ! Constructor is for convenience - avoids the need of naming a temp + ! variable when constructing advanced timers. + function new_MpiTimerGauge() result(gauge) + type (MpiTimerGauge) :: gauge + + end function new_MpiTimerGauge + + function get_measurement(this) result(measurement) + real(kind=REAL64) :: measurement + class(MpiTimerGauge), intent(inout) :: this + + _UNUSED_DUMMY(this) + measurement = MPI_Wtime() + + end function get_measurement + +end module MAPL_MpiTimerGauge diff --git a/MAPL_Profiler/MultiColumn.F90 b/MAPL_Profiler/MultiColumn.F90 new file mode 100644 index 000000000000..850555d04422 --- /dev/null +++ b/MAPL_Profiler/MultiColumn.F90 @@ -0,0 +1,166 @@ +module MAPL_MultiColumn + use MAPL_TextColumn + use MAPL_TextColumnVector + use MAPL_AbstractMeterNode + use MAPL_SeparatorColumn + implicit none + private + + public :: MultiColumn + + type, extends(TextColumn) :: MultiColumn + private + type (TextColumnVector) :: columns + integer :: num_rows_header = 0 + character(:), allocatable :: shared_header(:) + contains + procedure :: add_column + procedure :: get_header + procedure :: get_num_rows_header + procedure :: get_rows + end type MultiColumn + + interface MultiColumn + module procedure :: new_MultiColumn + end interface MultiColumn + + +contains + + + function new_MultiColumn(header, separator) result(column) + character(*), intent(in) :: header(:) + type(MultiColumn) :: column + character(1), optional, intent(in) :: separator + + integer :: i, w, n + + w = len(header) + n = size(header) + allocate(character(w) :: column%shared_header(n)) + do i = 1, n + column%shared_header(i) = header(i) + end do + if (present(separator)) call column%set_separator(separator) + column%num_rows_header = column%get_num_rows_separator() + call column%set_width(0) + + end function new_MultiColumn + + + subroutine add_column(this, column) + class (MultiColumn), intent(inout) :: this + class (TextColumn), intent(in) :: column + + integer :: h, h0, w + + w = this%get_width() + + if (this%columns%size() > 0) then + call this%columns%push_back(SeparatorColumn(' ')) + w = w + 1 + end if + call this%columns%push_back(column) + + h0 = size(this%shared_header) + this%get_num_rows_separator() + h = column%get_num_rows_header() + this%num_rows_header = max(this%num_rows_header, h0 + h) + w = w + column%get_width() + call this%set_width(w) + + end subroutine add_column + + + recursive subroutine get_rows(this, node, rows) + class (MultiColumn), intent(in) :: this + class (AbstractMeterNode), target, intent(in) :: node + character(:), allocatable, intent(out) :: rows(:) + + integer :: i, j + integer :: w0, w1 + class(TextColumn), pointer :: c + + integer :: total_width, height + character(:), allocatable :: column(:) + + total_width = this%get_width() + height = node%get_num_nodes() + + allocate(character(total_width) :: rows(height)) + + w0 = 1 + do i = 1, this%columns%size() + + c => this%columns%at(i) + w1 = w0 + c%get_width() - 1 + call c%get_rows(node, column) + + do j = 1, height + rows(j)(w0:w1) = column(j) + end do + + w0 = w1 + 1 + end do + + end subroutine get_rows + + + recursive subroutine get_header(this, header) + class (MultiColumn), intent(in) :: this + character(:), allocatable, intent(out) :: header(:) + + integer :: i, column_width, column_height + integer :: w, w0, w1, h, h0, h1, h2 + integer :: total_width, total_height, shared_height + class(TextColumn), pointer :: c + character(:), allocatable :: column_header(:) + character(1) :: char + integer :: n_shared + + total_width = this%get_width() + total_height = this%num_rows_header + n_shared = size(this%shared_header) + shared_height = n_shared + this%get_num_rows_separator() + + allocate(character(total_width) :: header(total_height)) + + header(1:n_shared) = this%shared_header + call this%center(header(1:n_shared)) + call this%get_separator(header(n_shared+1:shared_height)) + + c => this%columns%at(1) + column_height = c%get_num_rows_header() + column_width = c%get_width() + header(shared_height+1:total_height-column_height) = repeat(' ', column_width) + call c%get_header(column_header) + do h = 1, column_height + h0 = total_height - column_height + h + header(h0) = column_header(h) + end do + deallocate(column_header) + + w0 = 1 + do i = 1, this%columns%size() + c => this%columns%at(i) + column_height = c%get_num_rows_header() + w = c%get_width() + w1 = w0 + w - 1 + h0 = shared_height + 1 + h1 = total_height-column_height+1 + h2 = total_height + + header(h0:h1-1)(w0:w1) = repeat(' ',w) + call c%get_header(column_header) + header(h1:h2)(w0:w1) = column_header + w0 = w1 + 1 ! space + deallocate(column_header) + end do + + end subroutine get_header + + integer function get_num_rows_header(this) result(num_rows) + class(MultiColumn), intent(in) :: this + num_rows = this%num_rows_header + end function get_num_rows_header + +end module MAPL_MultiColumn diff --git a/MAPL_Profiler/NameColumn.F90 b/MAPL_Profiler/NameColumn.F90 new file mode 100644 index 000000000000..835e08fba270 --- /dev/null +++ b/MAPL_Profiler/NameColumn.F90 @@ -0,0 +1,81 @@ +module MAPL_NameColumn + use MAPL_AbstractMeterNode + use MAPL_SimpleTextColumn + implicit none + private + + public :: NameColumn + + type, extends(SimpleTextColumn) :: NameColumn + private + character(:), allocatable :: indent + contains + procedure :: get_header + procedure :: get_num_rows_header + procedure :: get_row + end type NameColumn + + interface NameColumn + module procedure new_NameColumn + end interface NameColumn + + +contains + + + function new_NameColumn(width, indent, separator) result(column) + type (NameColumn) :: column + integer, intent(in) :: width + character(*), optional, intent(in) :: indent + character(1), optional, intent(in) :: separator + + call column%set_width(width) + if (present(indent)) then + column%indent = indent + else + column%indent = '--' + end if + + if (present(separator)) call column%set_separator(separator) + + end function new_NameColumn + + + subroutine get_header(this, header) + class (NameColumn), intent(in) :: this + character(:), allocatable, intent(out) :: header(:) + + integer :: w, h + character(:), allocatable :: separator + + w = this%get_width() + h = this%get_num_rows_header() + + allocate(character(len=w) :: header(h)) + header(1) = 'Name' + call this%get_separator(header(2:)) + + end subroutine get_header + + + function get_row(this, node) result(row) + character(:), allocatable :: row + class (NameColumn), intent(in) :: this + class (AbstractMeterNode), intent(in) :: node + + integer :: n + + n = this%get_width() + allocate(character(len=n) :: row) + row(:) = repeat(this%indent, ncopies=node%get_depth()) // node%get_name() + + end function get_row + + + integer function get_num_rows_header(this) result(num_rows) + class(NameColumn), intent(in) :: this + num_rows = 1 + this%get_num_rows_separator() + end function get_num_rows_header + + +end module MAPL_NameColumn diff --git a/MAPL_Profiler/NumCyclesColumn.F90 b/MAPL_Profiler/NumCyclesColumn.F90 new file mode 100644 index 000000000000..720538b6b3ee --- /dev/null +++ b/MAPL_Profiler/NumCyclesColumn.F90 @@ -0,0 +1,41 @@ +module MAPL_NumCyclesColumn + use MAPL_AbstractColumn + use MAPL_SimpleColumn + use MAPL_AbstractMeterNode + use MAPL_AdvancedMeter + use MAPL_AbstractMeter + implicit none + private + + public :: NumCyclesColumn + + type, extends(SimpleColumn) :: NumCyclesColumn + private + contains + procedure :: get_row + end type NumCyclesColumn + + +contains + + + function get_row(this, node) result(row) + class(*), allocatable :: row + class(NumCyclesColumn), intent(in) :: this + class (AbstractMeterNode), target, intent(in) :: node + class (AbstractMeter), pointer :: tmr + + tmr => node%get_meter() + + select type (tmr) + class is (AdvancedMeter) + allocate(row, source=tmr%get_num_cycles()) +!!$ row = num_cycles + class default + print*,'error handling here' + end select + + end function get_row + + +end module MAPL_NumCyclesColumn diff --git a/MAPL_Profiler/PercentageColumn.F90 b/MAPL_Profiler/PercentageColumn.F90 new file mode 100644 index 000000000000..0c22d7cf2136 --- /dev/null +++ b/MAPL_Profiler/PercentageColumn.F90 @@ -0,0 +1,92 @@ +module MAPL_PercentageColumn + use, intrinsic :: iso_fortran_env, only: REAL64 + use MAPL_AbstractMeterNode + use MAPL_AbstractColumn + implicit none + private + + public :: PercentageColumn + + type, extends(AbstractColumn) :: PercentageColumn + private + character(:), allocatable :: mode + class (AbstractColumn), allocatable :: reference_column + contains + procedure :: get_rows + procedure :: get_row + end type PercentageColumn + + interface PercentageColumn + module procedure new_PercentageColumn + end interface PercentageColumn + + +contains + + + function new_PercentageColumn(reference_column, mode) result(column) + type (PercentageColumn) :: column + class (AbstractColumn), intent(in) :: reference_column + character(*), optional, intent(in) :: mode + + column%reference_column = reference_column + if (present(mode)) then + column%mode = mode + else + column%mode = 'TOTAL' + end if + + end function new_PercentageColumn + + + function get_rows(this, node) result(rows) + use GFTL_UnlimitedVector + type (UnlimitedVector) :: rows + class (PercentageColumn), intent(in) :: this + class (AbstractMeterNode), target, intent(in) :: node + + type (UnlimitedVector) :: values + integer :: i + real(kind=REAL64) :: s, x + + values = this%reference_column%get_rows(node) + + s = 0 + do i = 1, values%size() + select type (v => values%at(i)) + type is (real(kind=REAL64)) + x = v + type is (integer) + x = v + end select + + select case (this%mode) + case ('TOTAL') + s = s + x + case ('MAX') + s = max(s, x) + end select + + end do + + do i = 1, values%size() + select type (v => values%at(i)) + type is (real(kind=REAL64)) + x = v + type is (integer) + x = v + end select + call rows%push_back(100*x/s) + end do + + end function get_rows + + ! Not used - PercentageColumn combines results across rows + function get_row(this, node) result(row) + class(*), allocatable :: row + class (PercentageColumn), intent(in) :: this + class (AbstractMeterNode), target, intent(in) :: node + + end function get_row + +end module MAPL_PercentageColumn diff --git a/MAPL_Profiler/ProfileReporter.F90 b/MAPL_Profiler/ProfileReporter.F90 new file mode 100644 index 000000000000..1bf3e0d02c8f --- /dev/null +++ b/MAPL_Profiler/ProfileReporter.F90 @@ -0,0 +1,65 @@ +module MAPL_ProfileReporter + use MAPL_AbstractMeterNode + use MAPL_TextColumn + use MAPL_SeparatorColumn + use MAPL_TextColumnVector + use MAPL_MultiColumn + use MAPL_BaseProfiler + use MAPL_MultiColumn + implicit none + private + + public :: ProfileReporter + + type, extends(MultiColumn) :: ProfileReporter + private + contains + procedure :: generate_report_profiler + generic :: generate_report => generate_report_profiler + end type ProfileReporter + + + interface ProfileReporter + module procedure :: new_ProfileReporter + end interface ProfileReporter + + +contains + + function new_ProfileReporter(header) result(reporter) + type(ProfileReporter) :: reporter + character(*), intent(in) :: header(:) + reporter%MultiColumn = MultiColumn(header) + end function new_ProfileReporter + + + function generate_report_profiler(this, p) result(report_lines) + character(:), allocatable :: report_lines(:) + class (ProfileReporter), target, intent(in) :: this + class (BaseProfiler), target, intent(in) :: p + + integer :: width, height + integer :: i + character(:), allocatable :: rows(:) + character(:), allocatable :: header(:) + class (AbstractMeterNode), pointer :: node + + call this%get_header(header) + node => p%get_root_node() + call this%get_rows(node, rows) + width = this%get_width() + height = size(header) + size(rows) + + allocate(character(len=width) :: report_lines(height)) + do i = 1, size(header) + report_lines(i) = header(i) + end do + do i = size(header)+1, height + report_lines(i) = rows(i - size(header)) + end do + + end function generate_report_profiler + + + +end module MAPL_ProfileReporter diff --git a/MAPL_Profiler/RssMemoryGauge.F90 b/MAPL_Profiler/RssMemoryGauge.F90 new file mode 100644 index 000000000000..28c850586977 --- /dev/null +++ b/MAPL_Profiler/RssMemoryGauge.F90 @@ -0,0 +1,81 @@ +#include "unused_dummy.H" + +module MAPL_RssMemoryGauge + use, intrinsic :: iso_fortran_env, only: REAL64, INT64 + use MAPL_AbstractGauge + implicit none + private + + public :: RssMemoryGauge + + + type, extends(AbstractGauge) :: RssMemoryGauge + private + integer(kind=INT64) :: baseline = 0 + character(:), allocatable :: command + contains + procedure :: get_measurement + end type RssMemoryGauge + + interface RssMemoryGauge + module procedure :: new_RssMemoryGauge + end interface RssMemoryGauge + +#define PID_T kind(1) + + interface + function getpid() bind(c) + integer(kind=PID_T) :: getpid + end function getpid + end interface + +contains + + + function new_RssMemoryGauge() result(gauge) + type (RssMemoryGauge) :: gauge + + integer :: length + + call get_command_argument(0, length=length) + allocate(character(len=length) :: gauge%command) + call get_command_argument(0, value=gauge%command) + + end function new_RssMemoryGauge + + + function get_measurement(this) result(mem_use) + class (RssMemoryGauge), intent(inout) :: this + real(kind=REAL64) :: mem_use + + integer :: unit + integer(kind=INT64) :: MEM_UNITS = 1024 ! KB + character(:), allocatable :: tmp_file + + integer(kind=PID_T) :: pid + + character(16) :: buffer + character(:), allocatable :: pid_str + + _UNUSED_DUMMY(this) + pid = getpid() + write(buffer,'(i0)')pid + pid_str = trim(buffer) + tmp_file = 'tmp.pid'//pid_str + call execute_command_line("ps -p " // pid_str // " -ocommand='',rss='' | awk '{ print $2 }'> " // tmp_file) + + open(newunit=unit, file=tmp_file, form='formatted', access='sequential', status='old') + read(unit,*) mem_use + mem_use = mem_use * MEM_UNITS + close(unit, status='delete') + + + end function get_measurement + + +end module MAPL_RssMemoryGauge + + + + + diff --git a/MAPL_Profiler/SeparatorColumn.F90 b/MAPL_Profiler/SeparatorColumn.F90 new file mode 100644 index 000000000000..0b42a5fc65ae --- /dev/null +++ b/MAPL_Profiler/SeparatorColumn.F90 @@ -0,0 +1,70 @@ +module MAPL_SeparatorColumn + use MAPL_AbstractColumn + use MAPL_AbstractMeterNode + use Mapl_SimpleTextColumn + implicit none + private + + public :: SeparatorColumn + + type, extends(SimpleTextColumn) :: SeparatorColumn + private + character(:), allocatable :: field + contains + procedure :: get_header + procedure :: get_num_rows_header + procedure :: get_row + end type SeparatorColumn + + + interface SeparatorColumn + module procedure new_SeparatorColumn + end interface SeparatorColumn + + +contains + + + function new_SeparatorColumn(field) result(column) + type (SeparatorColumn) :: column + character(*), intent(in) :: field + + column%field = field + call column%set_width(len(field)) + + end function new_SeparatorColumn + + + subroutine get_header(this, header) + class (SeparatorColumn), intent(in) :: this + character(:), allocatable, intent(out) :: header(:) + + header = [this%field] + + end subroutine get_header + + + function get_row(this, node) result(row) + character(:), allocatable :: row + class (SeparatorColumn), intent(in) :: this + class (AbstractMeterNode), intent(in) :: node + + integer :: n + + if (.false.) print*,shape(node) ! intentionally unused dummy + + n = this%get_width() + + allocate(character(n) :: row) + row = this%field + + end function get_row + + + integer function get_num_rows_header(this) result(num_rows) + class(SeparatorColumn), intent(in) :: this + num_rows = 1 + end function get_num_rows_header + +end module MAPL_SeparatorColumn + diff --git a/MAPL_Profiler/SimpleColumn.F90 b/MAPL_Profiler/SimpleColumn.F90 new file mode 100644 index 000000000000..ec1c4966a3b4 --- /dev/null +++ b/MAPL_Profiler/SimpleColumn.F90 @@ -0,0 +1,61 @@ +module MAPL_SimpleColumn + use MAPL_AbstractColumn + use GFTL_UnlimitedVector + use MAPL_AbstractMeterNode + use MAPL_DistributedMeter + implicit none + private + + public :: SimpleColumn + + type, abstract, extends(AbstractColumn) :: SimpleColumn + private + contains + procedure :: get_rows + procedure(i_get_row), deferred :: get_row + end type SimpleColumn + + + abstract interface + + function i_get_row(this, node) result(row) + import SimpleColumn + import AbstractMeterNode + ! Some columns return reals, others return integers + class(*), allocatable :: row + class(SimpleColumn), intent(in) :: this + class(AbstractMeterNode), target, intent(in) :: node + + end function i_get_row + + end interface + + +contains + + + function get_rows(this, node) result(rows) + type (UnlimitedVector) :: rows + class (SimpleColumn), intent(in) :: this + class (AbstractMeterNode), target, intent(in) :: node + + integer :: n_meters + integer :: i + class (AbstractMeterNodeIterator), allocatable :: iter + class (AbstractMeterNode), pointer :: subnode + + n_meters = node%get_num_nodes() + + iter = node%begin() + i = 0 + do while (iter /= node%end()) + i = i + 1 + subnode => iter%get() + call rows%push_back(this%get_row(subnode)) + call iter%next() + end do + + end function get_rows + + +end module MAPL_SimpleColumn diff --git a/MAPL_Profiler/SimpleTextColumn.F90 b/MAPL_Profiler/SimpleTextColumn.F90 new file mode 100644 index 000000000000..b4780a0ff92d --- /dev/null +++ b/MAPL_Profiler/SimpleTextColumn.F90 @@ -0,0 +1,84 @@ +module MAPL_SimpleTextColumn + use MAPL_TextColumn + use MAPL_AbstractMeterNode + implicit none + private + + public :: SimpleTextColumn + + type, abstract, extends(TextColumn) :: SimpleTextColumn + private + contains + procedure :: get_rows_range + procedure :: get_rows + procedure(i_get_row), deferred :: get_row + end type SimpleTextColumn + + abstract interface + + function i_get_row(this, node) result(row) + use MAPL_AbstractMeterNode + import SimpleTextColumn + character(:), allocatable :: row + class (SimpleTextColumn), intent(in) :: this + class (AbstractMeterNode), intent(in) :: node + end function i_get_row + + end interface + + +contains + + + ! Using subroutines instead of functions as a workaround for gfortran 8.2 + ! Reproducer being submitted by Damian Rouson (10/12/2018) + subroutine get_rows_range(this, begin, end, rows) + class (SimpleTextColumn), target, intent(in) :: this + class (AbstractMeterNodeIterator), intent(in) :: begin + class (AbstractMeterNodeIterator), intent(in) :: end + character(:), allocatable, intent(inout) :: rows(:) + + class (AbstractMeterNodeIterator), allocatable :: iter + integer :: i + integer :: width + class (AbstractMeterNode), pointer :: subnode + + ! count_nodes + iter = begin + i = 0 + do while (iter /= end) + i = i + 1 + call iter%next() + end do + + width = this%get_width() + allocate(character(width) :: rows(i)) + + ! Fill rows + iter = begin + i = 0 + do while (iter /= end) + i = i + 1 + subnode => iter%get() + rows(i) = this%get_row(subnode) + call iter%next() + end do + + end subroutine get_rows_range + + + subroutine get_rows(this, node, rows) + class (SimpleTextColumn), intent(in) :: this + class (AbstractMeterNode), target, intent(in) :: node + character(:), allocatable, intent(out) :: rows(:) + + class (AbstractMeterNodeIterator), allocatable :: b, e + + b = node%begin() + e = node%end() + + call this%get_rows_range(b, e, rows) + + end subroutine get_rows + +end module MAPL_SimpleTextColumn diff --git a/MAPL_Profiler/StdDevColumn.F90 b/MAPL_Profiler/StdDevColumn.F90 new file mode 100644 index 000000000000..8954cb13a247 --- /dev/null +++ b/MAPL_Profiler/StdDevColumn.F90 @@ -0,0 +1,91 @@ +module MAPL_StdDevColumn + use, intrinsic :: iso_fortran_env, only: REAL64 + use MAPL_AbstractColumn + use MAPL_SimpleColumn + use MAPL_AbstractMeterNode + use MAPL_AbstractMeter + use MAPL_AdvancedMeter + use Mapl_DistributedMeter + implicit none + private + + public :: StdDevColumn + + type, extends(SimpleColumn) :: StdDevColumn + private + logical :: relative = .false. + character(:), allocatable :: option + contains + procedure :: get_row + procedure :: get_row_dist + end type StdDevColumn + + interface StdDevColumn + module procedure :: new_StdDevColumn + end interface StdDevColumn + + +contains + + + function new_StdDevColumn(relative, option) result(column) + type(StdDevColumn) :: column + logical, optional, intent(in) :: relative + character(*), optional, intent(in) :: option + + if (present(relative)) column%relative = relative + if (present(option)) column%option = option + + end function new_StdDevColumn + + + function get_row(this, node) result(row) + class(*), allocatable :: row + class (StdDevColumn), intent(in) :: this + class (AbstractMeterNode), target, intent(in) :: node + + class (AbstractMeter), pointer :: tmr + + + if (.not. allocated(this%option)) then + tmr => node%get_meter() + select type (tmr) + class is (AdvancedMeter) + if (this%relative) then + allocate(row, source=tmr%get_relative_deviation()) + else + allocate(row, source=tmr%get_standard_deviation()) + end if + class default + print*,'error handling here' + end select + else + call this%get_row_dist(node, row) + end if + + end function get_row + + + subroutine get_row_dist(this, node, row) + class (StdDevColumn), target, intent(in) :: this + class (AbstractMeterNode), target, intent(in) :: node + class(*), allocatable, intent(out) :: row + + class(AbstractMeter), pointer :: m + type(DistributedStatistics) :: stats + type(DistributedReal64) :: std_deviation + + m => node%get_meter() + + select type (m) + class is (DistributedMeter) + stats = m%get_statistics() + std_deviation = stats%sum_square_deviation + print*,__FILE__,__LINE__,'std deviation not fully implemented' + call this%fill_row(std_deviation, this%option, row) + end select + end subroutine get_row_dist + +end module MAPL_StdDevColumn + + diff --git a/MAPL_Profiler/TextColumn.F90 b/MAPL_Profiler/TextColumn.F90 new file mode 100644 index 000000000000..b257ea92bab8 --- /dev/null +++ b/MAPL_Profiler/TextColumn.F90 @@ -0,0 +1,131 @@ +module MAPL_TextColumn + use MAPL_AbstractMeterNode + implicit none + private + + public :: TextColumn + + type, abstract :: TextColumn + private + integer :: column_width = 0 + character(:), allocatable :: separator + contains + procedure :: set_width + procedure :: get_width + procedure(i_get_header), deferred :: get_header + procedure(i_get_num_rows_header), deferred :: get_num_rows_header + procedure(i_get_rows), deferred :: get_rows + procedure :: center + + procedure :: set_separator + procedure :: get_separator + procedure :: get_num_rows_separator + end type TextColumn + + abstract interface + + subroutine i_get_header(this, header) + import TextColumn + class (TextColumn), intent(in) :: this + character(:), allocatable, intent(out) :: header(:) + end subroutine i_get_header + + subroutine i_get_rows(this, node, rows) + use MAPL_AbstractMeterNode + import TextColumn + class (TextColumn), intent(in) :: this + class (AbstractMeterNode), target, intent(in) :: node + character(:), allocatable, intent(out) :: rows(:) + end subroutine i_get_rows + + integer function i_get_num_rows_header(this) result(num_rows) + import TextColumn + class (TextColumn), intent(in) :: this + end function i_get_num_rows_header + + end interface + + +contains + + + subroutine set_width(this, column_width) + class (TextColumn), intent(inout) :: this + integer, intent(in) :: column_width + + this%column_width = column_width + + end subroutine set_width + + + integer function get_width(this) result(column_width) + class (TextColumn), intent(in) :: this + column_width = this%column_width + end function get_width + + + subroutine center(this, rows, space) + class (TextColumn), intent(in) :: this + character(*), intent(inout) :: rows(:) + character(1), optional, intent(in) :: space + + integer :: w, i + integer :: n, n_0, n_1 + character(:), allocatable :: tmp + character(1) :: space_ + + if (present(space)) then + space_ = space + else + space_ = ' ' + end if + + w = this%get_width() + do i = 1, size(rows) + tmp = trim(adjustl(rows(i))) + n = len(tmp) + n_0 = (w - n)/2 + n_1 = w - (n + n_0) + rows(i)(:) = repeat(space_,n_0) // tmp // repeat(space_, n_1) + end do + + + end subroutine center + + + subroutine set_separator(this, separator) + class(TextColumn), intent(inout) :: this + character(1), intent(in) :: separator + this%separator = separator + end subroutine set_separator + + ! Would be a function, but this is a workaround for gfortran 8.2 + ! issue with allocatable arrays of deferred length strings. + subroutine get_separator(this, separator) + class(TextColumn), intent(in) :: this + character(*), intent(out) :: separator(:) + + integer :: w + character(1) :: c + + w = this%get_width() + if (allocated(this%separator)) then + c = this%separator + separator(1) = repeat(c, w) + end if + + end subroutine get_separator + + + integer function get_num_rows_separator(this) result(num_rows) + class (TextColumn), intent(in) :: this + + if (allocated(this%separator)) then + num_rows = 1 + else + num_rows = 0 + end if + + end function get_num_rows_separator + +end module MAPL_TextColumn diff --git a/MAPL_Profiler/TextColumnVector.F90 b/MAPL_Profiler/TextColumnVector.F90 new file mode 100644 index 000000000000..18502a0966b0 --- /dev/null +++ b/MAPL_Profiler/TextColumnVector.F90 @@ -0,0 +1,10 @@ +module MAPL_TextColumnVector + use MAPL_TextColumn + +#define _type class(TextColumn) +#define _allocatable +#define _vector TextColumnVector +#define _iterator TextColumnVectorIterator +#include "templates/vector.inc" + +end module MAPL_TextColumnVector diff --git a/MAPL_Profiler/TimeProfiler.F90 b/MAPL_Profiler/TimeProfiler.F90 new file mode 100644 index 000000000000..d791abcff9c6 --- /dev/null +++ b/MAPL_Profiler/TimeProfiler.F90 @@ -0,0 +1,137 @@ +module MAPL_TimeProfiler_private + use MAPL_BaseProfiler, only: BaseProfiler + use MAPL_BaseProfiler, only: TimeProfilerIterator => BaseProfilerIterator + + use MAPL_MpiTimerGauge + use MAPL_AdvancedMeter + use MAPL_AbstractMeter + use MAPL_MeterNode + implicit none + private + + public :: TimeProfiler + public :: TimeProfilerIterator + public :: get_global_time_profiler + + type, extends(BaseProfiler) :: TimeProfiler + private + contains + procedure :: make_meter + procedure :: copy + end type TimeProfiler + + interface TimeProfiler + module procedure new_TimeProfiler + end interface TimeProfiler + + type(TimeProfiler), protected, target :: global_time_profiler + +contains + + + function new_TimeProfiler(name) result(prof) + type(TimeProfiler), target :: prof + character(*), intent(in) :: name + + class(AbstractMeter), pointer :: t + + call prof%set_node(MeterNode(name, prof%make_meter())) + call prof%start() + + end function new_TimeProfiler + + function make_meter(this) result(meter) + class(AbstractMeter), allocatable :: meter + class(TimeProfiler), intent(in) :: this + meter = AdvancedMeter(MpiTimerGauge()) + end function make_meter + + + function get_global_time_profiler() result(time_profiler) + type(TimeProfiler), pointer :: time_profiler + + time_profiler => global_time_profiler + + end function get_global_time_profiler + + + subroutine copy(new, old) + class(TimeProfiler), target, intent(inout) :: new + class(BaseProfiler), target, intent(in) :: old + + call new%copy_profiler(old) + + end subroutine copy + + +end module MAPL_TimeProfiler_Private + + + +module MAPL_TimeProfiler + use MAPL_BaseProfiler + use MAPL_TimeProfiler_private + implicit none + private + + public :: TimeProfiler + public :: TimeProfilerIterator + public :: get_global_time_profiler + public :: initialize + public :: finalize + public :: start + public :: stop + +contains + + subroutine initialize(name) + character(*), optional, intent(in) :: name + + type(TimeProfiler), pointer :: time_profiler + character(:), allocatable :: name_ + + if (present(name)) then + name_ = name + else + name_ = 'top' + end if + + time_profiler => get_global_time_profiler() + time_profiler = TimeProfiler(name_) + + end subroutine initialize + + + subroutine finalize() + + type(TimeProfiler), pointer :: time_profiler + + time_profiler => get_global_time_profiler() + call time_profiler%finalize() + + end subroutine finalize + + + subroutine start(name) + character(*), intent(in) :: name + + type(TimeProfiler), pointer :: time_profiler + + time_profiler => get_global_time_profiler() + call time_profiler%start(name) + + end subroutine start + + + subroutine stop(name) + character(*), intent(in) :: name + + type(TimeProfiler), pointer :: time_profiler + + time_profiler => get_global_time_profiler() + call time_profiler%stop(name) + + end subroutine stop + + +end module MAPL_TimeProfiler diff --git a/MAPL_Profiler/VmstatMemoryGauge.F90 b/MAPL_Profiler/VmstatMemoryGauge.F90 new file mode 100644 index 000000000000..b54ec3dac92b --- /dev/null +++ b/MAPL_Profiler/VmstatMemoryGauge.F90 @@ -0,0 +1,67 @@ +module MAPL_VmstatMemoryGauge + use, intrinsic :: iso_fortran_env, only: REAL64, INT64 + use MAPL_AbstractGauge + implicit none + private + + public :: VmstatMemoryGauge + + + type, extends(AbstractGauge) :: VmstatMemoryGauge + private + integer(kind=INT64) :: baseline = 0 + contains + procedure :: get_measurement + end type VmstatMemoryGauge + + interface VmstatMemoryGauge + module procedure :: new_VmstatMemoryGauge + end interface VmstatMemoryGauge + + +contains + + + function new_VmstatMemoryGauge() result(gauge) + type (VmstatMemoryGauge) :: gauge + + end function new_VmstatMemoryGauge + + + function get_measurement(this) result(mem_use) + class (VmstatMemoryGauge), intent(inout) :: this + real(kind=REAL64) :: mem_use + + integer :: unit + integer(kind=INT64) :: MEM_UNITS = 4096 ! page size is 4096 bytes + character(:), allocatable :: tmp_file + block + use MPI + integer :: rank, ierror + call MPI_Comm_rank(MPI_COMM_WORLD, rank, ierror) + allocate(character(4) :: tmp_file) + write(tmp_file,'(i4.4)')rank + tmp_file = 'tmp_' // tmp_file // '.dat' + if (rank == 0) then + call execute_command_line("vm_stat | grep free | awk '{ print $3 }'> " // tmp_file) + + open(newunit=unit, file=tmp_file, form='formatted', access='sequential', status='old') + read(unit,*) mem_use + mem_use = - mem_use * MEM_UNITS ! mem free is negative memory used + close(unit, status='delete') + else + mem_use = 0 + end if + end block + + + + end function get_measurement + + +end module MAPL_VmstatMemoryGauge + + + + + diff --git a/MAPL_Profiler/tests/CMakeLists.txt b/MAPL_Profiler/tests/CMakeLists.txt new file mode 100644 index 000000000000..56b29f74788c --- /dev/null +++ b/MAPL_Profiler/tests/CMakeLists.txt @@ -0,0 +1,23 @@ +set (TEST_SRCS + test_AdvancedMeter.pf + test_NameColumn.pf + test_ExclusiveColumn.pf + test_PercentageColumn.pf + test_TimeProfiler.pf + test_ProfileReporter.pf + test_MeterNode.pf + test_MeterNodeIterator.pf + test_DistributedMeter.pf + ) + + +add_pfunit_ctest ( + MAPL_Profiler_tests + TEST_SOURCES ${TEST_SRCS} + LINK_LIBRARIES MAPL_Profiler + MAX_PES 8 + ) + + +add_dependencies (tests MAPL_Profiler_tests) + diff --git a/MAPL_Profiler/tests/test_AdvancedMeter.pf b/MAPL_Profiler/tests/test_AdvancedMeter.pf new file mode 100644 index 000000000000..348f0fdcad30 --- /dev/null +++ b/MAPL_Profiler/tests/test_AdvancedMeter.pf @@ -0,0 +1,203 @@ +module test_AdvancedMeter + use, intrinsic :: iso_fortran_env, only: REAL64 + use funit + use MAPL_Profiler + implicit none + +contains + + + @test + subroutine test_is_active() + type (AdvancedMeter) :: t + + t = AdvancedMeter(MpiTimerGauge()) + + ! Initial state is + @assertFalse(t%is_active()) + + call t%start() + @assertTrue(t%is_active()) + + call t%stop() + @assertFalse(t%is_active()) + + end subroutine test_is_active + + + @test + subroutine test_fail_on_double_start() + type (AdvancedMeter) :: t + + t = AdvancedMeter(MpiTimerGauge()) + + @assertEqual(MAPL_METER_IS_VALID, t%get_status()) + call t%start() + @assertEqual(MAPL_METER_IS_VALID, t%get_status()) + call t%start() + @assertEqual(MAPL_METER_START_ACTIVE, t%get_status()) + + end subroutine test_fail_on_double_start + + + @test + subroutine test_fail_on_double_stop() + type (AdvancedMeter) :: t + + t = AdvancedMeter(MpiTimerGauge()) + call t%stop() + @assertEqual(MAPL_METER_STOP_INACTIVE, t%get_status()) + + end subroutine test_fail_on_double_stop + + + @test + subroutine test_get_num_cycles() + type (AdvancedMeter) :: t + + t = AdvancedMeter(MpiTimerGauge()) + @assertEqual(0, t%get_num_cycles()) + call t%start() + @assertEqual(0, t%get_num_cycles()) + call t%stop() + @assertEqual(1, t%get_num_cycles()) + call t%start() + @assertEqual(1, t%get_num_cycles()) + call t%stop() + @assertEqual(2, t%get_num_cycles()) + + end subroutine test_get_num_cycles + + + @test + subroutine test_add_cycle() + type (AdvancedMeter) :: t + + t = AdvancedMeter(MpiTimerGauge()) + call t%add_cycle(increment=1.0_REAL64) + @assertEqual(1.0, t%get_total()) + call t%add_cycle(increment=2.0_REAL64) + @assertEqual(3.0, t%get_total()) + + @assertEqual(2, t%get_num_cycles()) + @assertFalse(t%is_active()) + + end subroutine test_add_cycle + + @test + subroutine test_reset() + type (AdvancedMeter) :: t + + t = AdvancedMeter(MpiTimerGauge()) + call t%start() + call t%add_cycle(increment=1._REAL64) + call t%reset() + + @assertEqual(0, t%get_num_cycles()) + @assertFalse(t%is_active()) + @assertEqual(0, t%get_total()) + + end subroutine test_reset + + + @test + subroutine test_get_min_cycle() + type (AdvancedMeter) :: t + + t = AdvancedMeter(MpiTimerGauge()) + call t%add_cycle(increment=1._REAL64) + call t%add_cycle(increment=3._REAL64) + @assertEqual(1., t%get_min_cycle()) + + call t%reset() + call t%add_cycle(increment=2._REAL64) + call t%add_cycle(increment=4._REAL64) + @assertEqual(2., t%get_min_cycle()) + + end subroutine test_get_min_cycle + + @test + subroutine test_get_max_cycle() + type (AdvancedMeter) :: t + + t = AdvancedMeter(MpiTimerGauge()) + call t%add_cycle(increment=2._REAL64) + call t%add_cycle(increment=4._REAL64) + @assertEqual(4., t%get_max_cycle()) + + call t%reset() + call t%add_cycle(increment=1._REAL64) + call t%add_cycle(increment=3._REAL64) + @assertEqual(3., t%get_max_cycle()) + + end subroutine test_get_max_cycle + + + @test + subroutine test_get_mean_cycle() + type (AdvancedMeter) :: t + + t = AdvancedMeter(MpiTimerGauge()) + call t%add_cycle(increment=1._REAL64) + call t%add_cycle(increment=3._REAL64) + @assertEqual(2., t%get_mean_cycle()) + + call t%reset() + call t%add_cycle(increment=3._REAL64) + call t%add_cycle(increment=5._REAL64) + @assertEqual(4., t%get_mean_cycle()) + + end subroutine test_get_mean_cycle + + + @test + subroutine test_get_standard_deviation() + type (AdvancedMeter) :: t + + t = AdvancedMeter(MpiTimerGauge()) + call t%add_cycle(increment=1._REAL64) + call t%add_cycle(increment=3._REAL64) + @assertEqual(1., t%get_standard_deviation()) + + call t%reset() + call t%add_cycle(increment=1._REAL64) + call t%add_cycle(increment=3._REAL64) + @assertEqual(1., t%get_standard_deviation()) + + call t%reset() + call t%add_cycle(increment=7._REAL64 - 2) + call t%add_cycle(increment=7._REAL64 - 1) + call t%add_cycle(increment=7._REAL64 + 3) + + @assertEqual(sqrt(14._REAL64/3), t%get_standard_deviation()) + + end subroutine test_get_standard_deviation + + + subroutine test_accumulate() + type (AdvancedMeter) :: t, lap + + t = AdvancedMeter(MpiTimerGauge()) + lap = t + + call lap%add_cycle(increment=1._REAL64) + call lap%add_cycle(increment=3._REAL64) + + ! Copy lap and verify state is as expected + t = lap + call lap%reset() + @assertEqual(4., t%get_total()) + @assertEqual(1., t%get_standard_deviation()) + + ! Use lap again and accumulate + call lap%add_cycle(increment=2._REAL64) + call lap%add_cycle(increment=4._REAL64) + + call t%accumulate(lap) + @assertEqual(9., t%get_total()) + @assertEqual(4, t%get_num_cycles()) + + end subroutine test_accumulate + + +end module test_AdvancedMeter diff --git a/MAPL_Profiler/tests/test_Column.pf b/MAPL_Profiler/tests/test_Column.pf new file mode 100644 index 000000000000..e7f948e0d7db --- /dev/null +++ b/MAPL_Profiler/tests/test_Column.pf @@ -0,0 +1,27 @@ +module test_Column + use MAPL_Profiler + use funit + +contains + + + subroutine test_one_timer() + type (ExclusiveTimeColumn) :: column + type (TimerTree), target :: tree + type (TimerReport) :: report + type (AbstractTimer) :: t + + tree = TimerTree('all') + t => tree%get_timer() + call t%add_cycle(1.0) + + column = ExclusiveTimeColumn(format='(f7.2)') + report = column%report(tree) + + @assertEqual(' exc ',report%get_header()) + @assertEqual(' 1.00',report%get_row(1)) + + end subroutine test_one_timer + + +end module test_Column diff --git a/MAPL_Profiler/tests/test_DistributedMeter.pf b/MAPL_Profiler/tests/test_DistributedMeter.pf new file mode 100644 index 000000000000..b5bb9138452f --- /dev/null +++ b/MAPL_Profiler/tests/test_DistributedMeter.pf @@ -0,0 +1,162 @@ +module test_DistributedMeter + use, intrinsic :: iso_fortran_env, only: REAL64 + use pfunit + use MAPL_Profiler + implicit none + +contains + + + @test(npes=[1]) + subroutine test_trivial(this) + class (MpiTestMethod), intent(inout) :: this + + type (DistributedMeter) :: distributed + type (DistributedReal64) :: distributed_total + + + distributed = DistributedMeter(MpiTimerGauge()) + call distributed%add_cycle(1.0_REAL64) + call distributed%reduce(this%getMpiCommunicator(), 0._REAL64) + + distributed_total = distributed%get_stats_total() + @assertEqual(1.0, distributed_total%total) + @assertEqual(1.0, distributed_total%min) + @assertEqual(1.0, distributed_total%max) + + @assertEqual(0, distributed_total%min_pe) + @assertEqual(0, distributed_total%max_pe) + @assertEqual(1, distributed_total%num_pes) + + end subroutine test_trivial + + + @test(npes=[2]) + subroutine test_get_total(this) + class (MpiTestMethod), intent(inout) :: this + + type (DistributedMeter) :: distributed + type (DistributedReal64) :: distributed_total + + distributed = DistributedMeter(MpiTimerGauge()) + select case (this%getProcessRank()) + case (0) + call distributed%add_cycle(1.0_REAL64) + call distributed%add_cycle(3.0_REAL64) + case (1) + call distributed%add_cycle(2.0_REAL64) + end select + call distributed%reduce(this%getMpiCommunicator(), 0._REAL64) + + distributed_total = distributed%get_stats_total() + + if (this%getProcessRank() == 0) then + @assertEqual(6.0, distributed_total%total) + @assertEqual(2.0, distributed_total%min) + @assertEqual(4.0, distributed_total%max) + + @assertEqual(1, distributed_total%min_pe) + @assertEqual(0, distributed_total%max_pe) + @assertEqual(2, distributed_total%num_pes) + end if + + end subroutine test_get_total + + @test(npes=[2]) + subroutine test_get_min(this) + class (MpiTestMethod), intent(inout) :: this + + type (DistributedMeter) :: distributed + type (DistributedReal64) :: distributed_min_cycle + + distributed = DistributedMeter(MpiTimerGauge()) + select case (this%getProcessRank()) + case (0) + call distributed%add_cycle(1.0_REAL64) + call distributed%add_cycle(3.0_REAL64) + case (1) + call distributed%add_cycle(2.0_REAL64) + end select + call distributed%reduce(this%getMpiCommunicator(), 0._REAL64) + + distributed_min_cycle = distributed%get_stats_min_cycle() + + if (this%getProcessRank() == 0) then + ! Some of these are meaningless/pointless + @assertEqual(3.0, distributed_min_cycle%total) + @assertEqual(1.0, distributed_min_cycle%min) + @assertEqual(2.0, distributed_min_cycle%max) + + @assertEqual(0, distributed_min_cycle%min_pe) + @assertEqual(1, distributed_min_cycle%max_pe) + @assertEqual(2, distributed_min_cycle%num_pes) + end if + + end subroutine test_get_min + + @test(npes=[2]) + subroutine test_get_max(this) + class (MpiTestMethod), intent(inout) :: this + + type (DistributedMeter) :: distributed + type (DistributedReal64) :: distributed_max_cycle + + distributed = DistributedMeter(MpiTimerGauge()) + select case (this%getProcessRank()) + case (0) + call distributed%add_cycle(1.0_REAL64) + call distributed%add_cycle(3.0_REAL64) + case (1) + call distributed%add_cycle(2.0_REAL64) + end select + + call distributed%reduce(this%getMpiCommunicator(), 0._REAL64) + distributed_max_cycle = distributed%get_stats_max_cycle() + + if (this%getProcessRank() == 0) then + ! Some of these are meaningless/pointless + @assertEqual(5.0, distributed_max_cycle%total) + @assertEqual(2.0, distributed_max_cycle%min) + @assertEqual(3.0, distributed_max_cycle%max) + + @assertEqual(1, distributed_max_cycle%min_pe) + @assertEqual(0, distributed_max_cycle%max_pe) + @assertEqual(2, distributed_max_cycle%num_pes) + end if + + end subroutine test_get_max + + @test(npes=[2]) + subroutine test_get_num_cycles(this) + class (MpiTestMethod), intent(inout) :: this + + type (DistributedMeter) :: distributed + type (DistributedInteger) :: distributed_num_cycles + + + distributed = DistributedMeter(MpiTimerGauge()) + select case (this%getProcessRank()) + case (0) + call distributed%add_cycle(1.0_REAL64) + call distributed%add_cycle(3.0_REAL64) + case (1) + call distributed%add_cycle(2.0_REAL64) + end select + call distributed%reduce(this%getMpiCommunicator(), 0._REAL64) + + distributed_num_cycles = distributed%get_stats_num_cycles() + + if (this%getProcessRank() == 0) then + ! Some of these are meaningless/pointless + @assertEqual(3, distributed_num_cycles%total) + @assertEqual(1, distributed_num_cycles%min) + @assertEqual(2, distributed_num_cycles%max) + + @assertEqual(1, distributed_num_cycles%min_pe) + @assertEqual(0, distributed_num_cycles%max_pe) + @assertEqual(2, distributed_num_cycles%num_pes) + end if + + end subroutine test_get_num_cycles + +end module test_DistributedMeter diff --git a/MAPL_Profiler/tests/test_ExclusiveColumn.pf b/MAPL_Profiler/tests/test_ExclusiveColumn.pf new file mode 100644 index 000000000000..e570bde34550 --- /dev/null +++ b/MAPL_Profiler/tests/test_ExclusiveColumn.pf @@ -0,0 +1,46 @@ +module test_ExclusiveColumn + use funit + use MAPL_Profiler + use GFTL_UnlimitedVector + +contains + + @test + subroutine test_simple() + type(MeterNode), target :: node + class(AbstractMeterNode), pointer :: subnode + class(AbstractMeter), pointer :: t + type(ExclusiveColumn) :: c + type(UnlimitedVector) :: v + integer :: i + integer :: expected(3) + class(*), allocatable :: q + + node = MeterNode('top', AdvancedMeter(MpiTimerGauge())) + t => node%get_meter() + call t%add_cycle(10.0d0) + + call node%add_child('a', AdvancedMeter(MpiTimerGauge())) + subnode => node%get_child('a') + t => subnode%get_meter() + call t%add_cycle(1.0d0) + + call node%add_child('b', AdvancedMeter(MpiTimerGauge())) + subnode => node%get_child('b') + t => subnode%get_meter() + call t%add_cycle(2.0d0) + + v = c%get_rows(node) + expected = [7,1,2] + do i = 1, 3 + q = v%at(i) + select type (q) + type is (integer) + @assertEqual(expected(i), q) + end select + end do + + end subroutine test_simple + + +end module test_ExclusiveColumn diff --git a/MAPL_Profiler/tests/test_MeterNode.pf b/MAPL_Profiler/tests/test_MeterNode.pf new file mode 100644 index 000000000000..28d975649983 --- /dev/null +++ b/MAPL_Profiler/tests/test_MeterNode.pf @@ -0,0 +1,141 @@ +module test_MeterNode + use, intrinsic :: iso_fortran_env, only: REAL64 + use funit + use MAPL_Profiler + implicit none + + +contains + + + @test + subroutine test_get_inclusive() + type (MeterNode), target:: node + class (AbstractMeter), pointer :: root_meter + class (AbstractMeter), pointer :: submeter + class (AbstractMeterNode), pointer :: child + + node = MeterNode('all', AdvancedMeter(MpiTimerGauge())) + + call node%add_child('sub1', AdvancedMeter(MpiTimerGauge())) + + root_meter => node%get_meter() + child => node%get_child('sub1') + submeter => child%get_meter() + + call submeter%add_cycle(1.0_REAL64) + call root_meter%add_cycle(3.0_REAL64) + @assertEqual(3.0, node%get_inclusive()) + + end subroutine test_get_inclusive + + + @test + subroutine test_get_exclusive() + type (MeterNode), target:: node + class (AbstractMeter), pointer :: root_meter + class (AbstractMeter), pointer :: submeter + class (AbstractMeterNode), pointer :: child + + node = MeterNode('all', AdvancedMeter(MpiTimerGauge())) + call node%add_child('sub1', AdvancedMeter(MpiTimerGauge())) + + root_meter => node%get_meter() + child => node%get_child('sub1') + submeter => child%get_meter() + + call submeter%add_cycle(1.0_REAL64) + call root_meter%add_cycle(3.0_REAL64) + @assertEqual(2.0, node%get_exclusive()) + + end subroutine test_get_exclusive + + + @test + subroutine test_get_num_nodes() + type (MeterNode) :: node + class (AbstractMeterNode), pointer :: child + + @assertEqual(1, node%get_num_nodes()) + + call node%add_child('a', AdvancedMeter(MpiTimerGauge())) + @assertEqual(2, node%get_num_nodes()) + + call node%add_child('b', AdvancedMeter(MpiTimerGauge())) + @assertEqual(3, node%get_num_nodes()) + + child => node%get_child('a') + call child%add_child('cat', AdvancedMeter(MpiTimerGauge())) + call child%add_child('dog', AdvancedMeter(MpiTimerGauge())) + call child%add_child('fish', AdvancedMeter(MpiTimerGauge())) + + @assertEqual(6, node%get_num_nodes()) + + + end subroutine test_get_num_nodes + + @test + subroutine test_get_num_nodes_2() + type (MeterNode) :: node + class (AbstractMeterNode), pointer :: child + + @assertEqual(1, node%get_num_nodes()) + + call node%add_child('a', AdvancedMeter(MpiTimerGauge())) + child => node%get_child('a') + call child%add_child('1', AdvancedMeter(MpiTimerGauge())) + call child%add_child('2', AdvancedMeter(MpiTimerGauge())) + + call node%add_child('b', AdvancedMeter(MpiTimerGauge())) + child => node%get_child('b') + call child%add_child('1', AdvancedMeter(MpiTimerGauge())) + call child%add_child('2', AdvancedMeter(MpiTimerGauge())) + + @assertEqual(7, node%get_num_nodes()) + call node%add_child('a', AdvancedMeter(MpiTimerGauge())) ! should already exist + + @assertEqual(7, node%get_num_nodes()) + + + end subroutine test_get_num_nodes_2 + + + @test + subroutine test_node_reset() + type (MeterNode) :: node + + class (AbstractMeter), pointer :: root_meter + class (AbstractMeter), pointer :: submeter + class (AbstractMeterNode), pointer :: child, grandchild + + node = MeterNode('all', AdvancedMeter(MpiTimerGauge())) + call node%add_child('A', AdvancedMeter(MpiTimerGauge())) + + root_meter => node%get_meter() + child => node%get_child('A') + submeter => child%get_meter() + + call submeter%add_cycle(10.0_REAL64) + + call child%add_child('A1', AdvancedMeter(MpiTimerGauge())) + call child%add_child('A2', AdvancedMeter(MpiTimerGauge())) + + grandchild => child%get_child('A1') + submeter => grandchild%get_meter() + call submeter%add_cycle(2.0_REAL64) + + grandchild => child%get_child('A2') + submeter => grandchild%get_meter() + call submeter%add_cycle(3.0_REAL64) + + call node%reset() + + @assertEqual(0, node%get_inclusive()) + @assertEqual(0, child%get_inclusive()) + @assertEqual(0, grandchild%get_inclusive()) + + end subroutine test_node_reset + + + +end module test_MeterNode diff --git a/MAPL_Profiler/tests/test_MeterNodeIterator.pf b/MAPL_Profiler/tests/test_MeterNodeIterator.pf new file mode 100644 index 000000000000..4e15735d2a3b --- /dev/null +++ b/MAPL_Profiler/tests/test_MeterNodeIterator.pf @@ -0,0 +1,180 @@ +module test_MeterNodeIterator + use, intrinsic :: iso_fortran_env, only: REAL64 + use MAPL_Profiler + use funit + implicit none + +contains + + @test + subroutine test_next_trivial() + type (MeterNode), target :: node + + class (AbstractMeterNodeIterator), allocatable :: iter_1 + class (AbstractMeterNodeIterator), allocatable :: iter_2 + + node = MeterNode('all', AdvancedMeter(MpiTimerGauge())) + + iter_1 = node%begin() + iter_2 = node%begin() + @assertTrue(iter_1 == iter_2) + @assertFalse(iter_1 /= iter_2) + @assertTrue(iter_1 /= node%end()) + @assertFalse(iter_1 == node%end()) + + call iter_1%next() + @assertTrue(iter_1 == node%end()) + @assertFalse(iter_1 == iter_2) + @assertFalse(iter_1 == iter_2) + @assertFalse(iter_2 == iter_1) + @assertTrue(iter_1 /= iter_2) + @assertTrue(iter_2 /= iter_1) + + call iter_2%next() + @assertTrue(iter_2 == node%end()) + @assertFalse(iter_2 /= node%end()) + @assertTrue(iter_1 == iter_2) + @assertFalse(iter_1 /= iter_2) + + end subroutine test_next_trivial + + @test + subroutine test_next_one_child() + type (MeterNode) :: node + + class (AbstractMeterNodeIterator), allocatable :: iter_1 + class (AbstractMeterNodeIterator), allocatable :: iter_2 + + node = MeterNode('all', AdvancedMeter(MpiTimerGauge())) + iter_1 = node%begin() + iter_2 = node%begin() + + call node%add_child('a', AdvancedMeter(MpiTimerGauge())) + + call iter_1%next() + call iter_2%next() + @assertTrue(iter_1 == iter_2) + @assertFalse(iter_1 /= iter_2) + + call iter_1%next() + call iter_2%next() + @assertTrue(iter_1 == iter_2) + @assertFalse(iter_1 /= iter_2) + + end subroutine test_next_one_child + + @test + subroutine test_count_nodes_depth_0() + type (MeterNode), target :: node + + class (AbstractMeterNodeIterator), allocatable :: iter + integer :: count + + node = MeterNode('all', AdvancedMeter(MpiTimerGauge())) + + count = 0 + iter = node%begin() + do while (iter /= node%end()) + count = count + 1 + call iter%next() + end do + + @assertEqual(node%get_num_nodes(), count) + + + end subroutine test_count_nodes_depth_0 + + + @test + subroutine test_count_nodes_depth_1() + type (MeterNode), target :: node + + class (AbstractMeterNodeIterator), allocatable :: iter + integer :: count + + node = MeterNode('all', AdvancedMeter(MpiTimerGauge())) + call node%add_child('a', AdvancedMeter(MpiTimerGauge())) + call node%add_child('b', AdvancedMeter(MpiTimerGauge())) + call node%add_child('c', AdvancedMeter(MpiTimerGauge())) + + count = 0 + iter = node%begin() + do while (iter /= node%end()) + count = count + 1 + call iter%next() + end do + + @assertEqual(node%get_num_nodes(), count) + + + end subroutine test_count_nodes_depth_1 + + + ! The next test verifies that the desired pointer is retrieved at each level. + + @test + subroutine test_depth_2() + type (MeterNode), target :: node + + class (AbstractMeterNodeIterator), allocatable :: iter + class (AbstractMeterNode), pointer :: child, child_2 + class (AbstractMeter), pointer :: t + integer :: count + + node = MeterNode('all', AdvancedMeter(MpiTimerGauge())) + t => node%get_meter() + call t%add_cycle(1.0_REAL64) + + call node%add_child('a', AdvancedMeter(MpiTimerGauge())) + child => node%get_child('a') + t => child%get_meter() + call t%add_cycle(2.0_REAL64) + + call child%add_child('a_1', AdvancedMeter(MpiTimerGauge())) + child_2 => child%get_child('a_1') + t => child_2%get_meter() + call t%add_cycle(3.0_REAL64) + + call child%add_child('a_2', AdvancedMeter(MpiTimerGauge())) + child_2 => child%get_child('a_2') + t => child_2%get_meter() + call t%add_cycle(4.0_REAL64) + + call node%add_child('b', AdvancedMeter(MpiTimerGauge())) + child => node%get_child('b') + t => child%get_meter() + call t%add_cycle(5.0_REAL64) + + call child%add_child('b_1', AdvancedMeter(MpiTimerGauge())) + child_2 => child%get_child('b_1') + t => child_2%get_meter() + call t%add_cycle(6.0_REAL64) + + call child%add_child('b_2', AdvancedMeter(MpiTimerGauge())) + child_2 => child%get_child('b_2') + t => child_2%get_meter() + call t%add_cycle(7.0_REAL64) + + call node%add_child('c', AdvancedMeter(MpiTimerGauge())) + child => node%get_child('c') + t => child%get_meter() + call t%add_cycle(8.0_REAL64) + + + count = 0 + iter = node%begin() + do while (iter /= node%end()) + count = count + 1 + t => iter%get_meter() + @assertEqual(count, t%get_total()) + call iter%next() + end do + + @assertEqual(8, count) + + end subroutine test_depth_2 + + + +end module test_MeterNodeIterator + diff --git a/MAPL_Profiler/tests/test_NameColumn.pf b/MAPL_Profiler/tests/test_NameColumn.pf new file mode 100644 index 000000000000..dc5847aa6eab --- /dev/null +++ b/MAPL_Profiler/tests/test_NameColumn.pf @@ -0,0 +1,53 @@ +module test_NameColumn + use, intrinsic :: iso_fortran_env, only: REAL64 + use MAPL_Profiler + use funit + +contains + + + @test + subroutine test_one_timer() + type (NameColumn) :: column + type (MeterNode), target :: node + integer, parameter :: WIDTH = 10 + character(:), allocatable :: header(:) + + node = MeterNode('all', AdvancedMeter(MpiTimerGauge())) + column = NameColumn(width=WIDTH) + + ! Check proper padding. + call column%get_header(header) + @assertEqual(WIDTH, len(header)) + @assertEqual(WIDTH, len(column%get_row(node))) + @assertEqual('Name ',header(1)) + @assertEqual('all ',column%get_row(node)) + + end subroutine test_one_timer + + @test + subroutine test_get_rows() +!!$ type (NameColumn) :: column +!!$ type (MeterNode), target :: node +!!$ integer, parameter :: WIDTH = 10 +!!$ character(len=WIDTH) :: expected(3) +!!$ character(:), allocatable :: found(:) +!!$ +!!$ node = MeterNode('all', AdvancedMeter(MpiTimerGauge())) +!!$ call node%add_child('t1', AdvancedMeter(MpiTimerGauge())) +!!$ call node%add_child('t2', AdvancedMeter(MpiTimerGauge())) +!!$ +!!$ column = NameColumn(width=WIDTH) +!!$ +!!$ expected(1) = 'all' +!!$ expected(2) = '--t1' +!!$ expected(3) = '--t2' +!!$ +!!$ call column%get_rows(node, found) +!!$ do i = 1, 3 +!!$ @assertEqual(expected(i), found(i)) +!!$ end do + + end subroutine test_get_rows + +end module test_NameColumn diff --git a/MAPL_Profiler/tests/test_PercentageColumn.pf b/MAPL_Profiler/tests/test_PercentageColumn.pf new file mode 100644 index 000000000000..2d3047938346 --- /dev/null +++ b/MAPL_Profiler/tests/test_PercentageColumn.pf @@ -0,0 +1,44 @@ +module test_PercentageColumn + use, intrinsic :: iso_fortran_env, only: REAL64 + use MAPL_Profiler + use funit + use GFTL_UnlimitedVector + +contains + + @test + subroutine test_percent_inclusive() + use, intrinsic :: iso_fortran_env, only: REAL64 + type (PercentageColumn) :: c + type (MeterNode), target :: node + class (AbstractMeterNode), pointer :: child + class (AbstractMeter), pointer :: t + type(UnlimitedVector) :: v + integer :: i + integer :: expected(2) + class(*), allocatable :: q + + node = MeterNode('foo', AdvancedMeter(MpiTimerGauge())) + t => node%get_meter() + call t%add_cycle(10.0_REAL64) + + call node%add_child('a', AdvancedMeter(MpiTimerGauge())) + child => node%get_child('a') + t => child%get_meter() + call t%add_cycle(5.0_REAL64) + + c = PercentageColumn(InclusiveColumn(),'MAX') + + v = c%get_rows(node) + expected = [100.,50.] + do i = 1, 2 + q = v%at(i) + select type (q) + type is (real(kind=REAL64)) + @assertEqual(expected(i), q) + end select + end do + + end subroutine test_percent_inclusive + +end module test_PercentageColumn diff --git a/MAPL_Profiler/tests/test_ProfileReporter.pf b/MAPL_Profiler/tests/test_ProfileReporter.pf new file mode 100644 index 000000000000..5ec4debfcbd0 --- /dev/null +++ b/MAPL_Profiler/tests/test_ProfileReporter.pf @@ -0,0 +1,121 @@ +module test_ProfileReporter + use funit + use MAPL_Profiler + implicit none + + character(1) :: empty(0) + +contains + + + @test + subroutine test_simple_report_timer() + type (TimeProfiler), target :: prof + type (ProfileReporter), target :: reporter + + character(:), allocatable :: report_lines(:) + + prof = TimeProfiler('top') ! timer 1 + call prof%start('timer_1') ! 2 + call prof%start('timer_1a')! 3 + call prof%stop('timer_1a') + call prof%start('timer_1b') ! 4 + call prof%start('timer_1b1') ! 5 + call prof%stop('timer_1b1') + call prof%stop('timer_1b') + call prof%stop('timer_1') + call prof%start('timer_2') ! 6 + call prof%start('timer_2b')! 7 + call prof%stop('timer_2b') + call prof%stop('timer_2') + + call prof%start('timer_1') ! 2 + call prof%start('timer_1a')! 3 + call prof%stop('timer_1a') + call prof%stop('timer_1') + + call prof%start('timer_2') ! 6 + call prof%stop('timer_2') + call prof%start('timer_2') ! 6 + call prof%stop('timer_2') + + call prof%finalize() + + reporter = ProfileReporter(empty) + call reporter%add_column(NameColumn(20)) + call reporter%add_column(FormattedTextColumn('# cycles','(i8.0)', 8, NumCyclesColumn())) + allocate(report_lines, source=reporter%generate_report(prof)) + + @assertEqual(1 + 7, size(report_lines)) + @assertEqual(20 + 1 + 8, len(report_lines(1))) + + @assertEqual('Name # cycles', report_lines(1)) + @assertEqual('top 1', report_lines(2)) + @assertEqual('--timer_1 2', report_lines(3)) + @assertEqual('----timer_1a 2', report_lines(4)) + @assertEqual('----timer_1b 1', report_lines(5)) + @assertEqual('------timer_1b1 1', report_lines(6)) + @assertEqual('--timer_2 3', report_lines(7)) + @assertEqual('----timer_2b 1', report_lines(8)) + + end subroutine test_simple_report_timer + + + @test + subroutine test_simple_report_timer_b() + type (TimeProfiler), target :: prof + type (ProfileReporter) :: reporter + + character(:), allocatable :: report_lines(:) + + prof = TimeProfiler('top') ! timer 1 + + call prof%start('timer_1') ! 2 + call prof%start('timer_1a')! 3 + call prof%stop('timer_1a') + call prof%start('timer_1b') ! 4 + call prof%start('timer_1b1') ! 5 + call prof%stop('timer_1b1') + call prof%stop('timer_1b') + call prof%stop('timer_1') + call prof%start('timer_2') ! 6 + call prof%start('timer_2b')! 7 + call prof%stop('timer_2b') + call prof%stop('timer_2') + + call prof%start('timer_1') ! 2 + call prof%start('timer_1a')! 3 + call prof%stop('timer_1a') + call prof%stop('timer_1') + + call prof%start('timer_2') ! 6 + call prof%stop('timer_2') + call prof%start('timer_2') ! 6 + call prof%stop('timer_2') + + call prof%finalize() + + + reporter = ProfileReporter(empty) + call reporter%add_column(NameColumn(20)) + call reporter%add_column(FormattedTextColumn('# cycles','(i8.0)', 8, NumCyclesColumn())) + call reporter%add_column(FormattedTextColumn('T(incl)','(f15.6)', 15, InclusiveColumn())) + report_lines = reporter%generate_report(prof) + + @assertEqual(1 + 7, size(report_lines)) + @assertEqual(20 + 1 + 8 + 1 + 15, len(report_lines(1))) + + @assertEqual('Name # cycles', report_lines(1)(1:29)) + @assertEqual('top 1', report_lines(2)(1:29)) + @assertEqual('--timer_1 2', report_lines(3)(1:29)) + @assertEqual('----timer_1a 2', report_lines(4)(1:29)) + @assertEqual('----timer_1b 1', report_lines(5)(1:29)) + @assertEqual('------timer_1b1 1', report_lines(6)(1:29)) + @assertEqual('--timer_2 3', report_lines(7)(1:29)) + @assertEqual('----timer_2b 1', report_lines(8)(1:29)) + + end subroutine test_simple_report_timer_b + + + +end module test_ProfileReporter diff --git a/MAPL_Profiler/tests/test_TimeProfiler.pf b/MAPL_Profiler/tests/test_TimeProfiler.pf new file mode 100644 index 000000000000..e969b34c3738 --- /dev/null +++ b/MAPL_Profiler/tests/test_TimeProfiler.pf @@ -0,0 +1,118 @@ +module test_TimeProfiler + use funit + use MAPL_Profiler + implicit none + + +contains + + + @test + subroutine test_start_one() + type (TimeProfiler), target :: prof + + prof = TimeProfiler('top') + + call prof%start('timer_1') + call prof%stop('timer_1') + + call prof%finalize() + + @assertEqual(2, prof%get_num_meters()) + + end subroutine test_start_one + + + @test + subroutine test_stop_wrong_meter() + type (TimeProfiler), target :: prof + + prof = TimeProfiler('top') + + call prof%start('timer_1') + call prof%start('timer_2') + @assertEqual(0, prof%get_status()) + call prof%stop('timer_1') ! not the current timer + + @assertEqual(INCORRECTLY_NESTED_METERS, prof%get_status()) + call prof%finalize() + + end subroutine test_stop_wrong_meter + + @test + subroutine test_accumulate_sub() + type(TimeProfiler), target :: main, lap + class(AbstractMeterNode), pointer :: main_node + + main = TimeProfiler('main') + lap = TimeProfiler('lap') + call lap%finalize() + call main%accumulate(lap) + + ! should now have 'lap' as a subtimer of 'main' + @assertEqual(2, main%get_num_meters()) + + main_node => main%get_root_node() + @assertTrue(main_node%has_child('lap')) + + end subroutine test_accumulate_sub + + + @test + subroutine test_accumulate_nested() + type(TimeProfiler), target :: main, lap + class(AbstractMeterNode), pointer :: main_node + class(AbstractMeterNode), pointer :: child + class(AbstractMeter), pointer :: t + + main = TimeProfiler('main') + lap = TimeProfiler('lap') + call lap%start('A') + call lap%stop('A') + call lap%finalize() + call main%accumulate(lap) + + ! should now have 'lap' as a subtimer of 'main' + @assertEqual(3, main%get_num_meters()) + + main_node => main%get_root_node() + @assertTrue(main_node%has_child('lap')) + + child => main_node%get_child('lap') + t => child%get_meter() + select type (t) + class is (AdvancedMeter) + @assertEqual(1, t%get_num_cycles()) + end select + + @assertTrue(child%has_child('A')) + child => child%get_child('A') + t => child%get_meter() + select type (t) + class is (AdvancedMeter) + @assertEqual(1, t%get_num_cycles()) + end select + + end subroutine test_accumulate_nested + + @test + subroutine test_accumulate_multi() + type(TimeProfiler), target :: main, lap + + main = TimeProfiler('main') + lap = TimeProfiler('lap') + call lap%start('A') + call lap%stop('A') + call lap%finalize() + call main%accumulate(lap) + + call lap%reset() + call lap%start('A') + call lap%stop('A') + call lap%finalize() + call main%accumulate(lap) + + + end subroutine test_accumulate_multi + +end module test_TimeProfiler diff --git a/MAPL_pFUnit/CMakeLists.txt b/MAPL_pFUnit/CMakeLists.txt index 8674e890b13e..f0c2185053b6 100644 --- a/MAPL_pFUnit/CMakeLists.txt +++ b/MAPL_pFUnit/CMakeLists.txt @@ -9,8 +9,8 @@ set (srcs esma_add_library (${this} EXCLUDE_FROM_ALL SRCS ${srcs}) -include_directories (${INC_ESMF}) -include_directories (${INC_NETCDF}) +target_include_directories (${this} PRIVATE ${INC_ESMF}) +target_include_directories (${this} PRIVATE ${INC_NETCDF}) target_link_libraries (${this} ${ESMF_LIBRARIES} pfunit) set_target_properties (${this} PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) diff --git a/MAPL_Base/unused_dummy.H b/include/unused_dummy.H similarity index 100% rename from MAPL_Base/unused_dummy.H rename to include/unused_dummy.H From e774a54132aa2f8860afb0750ca7a017a1d047ec Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 18 Feb 2020 14:15:24 -0500 Subject: [PATCH 033/109] Fixes for mepo, remove manage_externals, add CircleCI Changes include: * Remove support for `checkout_externals` * Move to ESMA_env v2.0.1 * Add CircleCI for build testing * Note that `make tests` in CircleCI/Docker still does not work. This is waiting on help from Open MPI at present --- .circleci/config.yml | 48 ++++++++++++++++++++++++++++++++++ CHANGELOG.md | 11 ++++++++ CMakeLists.txt | 27 +++++-------------- Externals.cfg | 18 ------------- GMAO_pFIO/CMakeLists.txt | 4 +-- GMAO_pFIO/tests/CMakeLists.txt | 4 +-- components.yaml | 2 +- 7 files changed, 70 insertions(+), 44 deletions(-) create mode 100644 .circleci/config.yml delete mode 100644 Externals.cfg diff --git a/.circleci/config.yml b/.circleci/config.yml new file mode 100644 index 000000000000..dd1980f69307 --- /dev/null +++ b/.circleci/config.yml @@ -0,0 +1,48 @@ +version: 2.1 + +executors: + gcc-build-env: + docker: + - image: gmao/geos-build-env-gcc-source:6.0.4 + environment: + OMPI_ALLOW_RUN_AS_ROOT: 1 + OMPI_ALLOW_RUN_AS_ROOT_CONFIRM: 1 + OMPI_MCA_btl_vader_single_copy_mechanism: none + +jobs: + build-and-test-gcc: + executor: gcc-build-env + working_directory: /root/project + steps: + - checkout + - run: + name: Versions, etc. + command: mpirun --version && gfortran --version && echo $BASEDIR && pwd && ls + - run: + name: Mepo clone external repos + command: | + mepo init + mepo clone + mepo status + - run: + name: CMake + command: | + mkdir build + cd build + cmake .. -DBASEDIR=$BASEDIR/Linux -DCMAKE_Fortran_COMPILER=gfortran -DCMAKE_BUILD_TYPE=Debug + - run: + name: Build and install + command: | + cd build + make -j2 install + #- run: + #name: Run MAPL tests + #command: | + #cd build + #make -j2 tests || ctest -VV + +workflows: + version: 2.1 + pull_request_tests: + jobs: + - build-and-test-gcc diff --git a/CHANGELOG.md b/CHANGELOG.md index 7c738baca229..d113a05b2bab 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -17,6 +17,17 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Corrected Python code generator scripts for component import/export specs. - Add directories to `.gitignore` for building with `mepo` - Bug building with mixed Intel/GCC compilers +- Set correct ESMA_env tag in `components.yaml` + +### Removed + +- Removed support for `checkout_externals` and moved solely to `mepo` + - Removed `Externals.cfg` + - Removed `checkout_externals` code in `CMakeLists.txt` + +### Added + +- Added configuration for CircleCI (build only) ## [2.0.0] - 2019-02-07 diff --git a/CMakeLists.txt b/CMakeLists.txt index 61ea04e86f50..842f2fa3c628 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -7,40 +7,26 @@ project ( VERSION 2.0 LANGUAGES Fortran CXX C) # Note - CXX is required for ESMF -option(USE_MEPO "Set to use mepo to get external dependencies" ON) - if (EXISTS ${CMAKE_CURRENT_LIST_DIR}/@cmake) list (APPEND CMAKE_MODULE_PATH "${CMAKE_CURRENT_LIST_DIR}/@cmake") include (esma) else () if (NOT COMMAND esma) # build as standalone project - if (USE_MEPO) - if (NOT SKIP_MEPO) - set (MEPO_INIT_COMMAND mepo init) - execute_process ( + if (NOT SKIP_MEPO) + set (MEPO_INIT_COMMAND mepo init) + execute_process ( COMMAND ${MEPO_INIT_COMMAND} WORKING_DIRECTORY ${CMAKE_SOURCE_DIR} ) - set (MEPO_CLONE_COMMAND mepo clone) - execute_process ( + set (MEPO_CLONE_COMMAND mepo clone) + execute_process ( COMMAND ${MEPO_CLONE_COMMAND} WORKING_DIRECTORY ${CMAKE_SOURCE_DIR} ) - endif() - option (SKIP_MEPO "Set to skip mepo steps" ON) - else() - # Invoke checkout_externals, but only the first time we - # configure. - if (NOT SKIP_MANAGE_EXTERNALS) - execute_process ( - COMMAND "checkout_externals" - WORKING_DIRECTORY ${CMAKE_SOURCE_DIR} - ) - endif () - option (SKIP_MANAGE_EXTERNALS "Set to skip manage externals step" ON) endif() + option (SKIP_MEPO "Set to skip mepo steps" ON) list (APPEND CMAKE_MODULE_PATH "${CMAKE_CURRENT_LIST_DIR}/@cmake") include (esma) @@ -49,7 +35,6 @@ endif() ecbuild_declare_project() - # Special case - MAPL_cfio is built twice with two different precisions. add_subdirectory (MAPL_cfio MAPL_cfio_r4) add_subdirectory (MAPL_cfio MAPL_cfio_r8) diff --git a/Externals.cfg b/Externals.cfg deleted file mode 100644 index 5366d484a61f..000000000000 --- a/Externals.cfg +++ /dev/null @@ -1,18 +0,0 @@ -[ESMA_env] -required = True -repo_url = git@github.com:GEOS-ESM/ESMA_env.git -local_path = ./@env -branch = dev/MAPL-2.0 -protocol = git - -[GEOS_cmake] -required = True -repo_url = git@github.com:GEOS-ESM/ESMA_cmake.git -local_path = ./@cmake -tag = v2.1.2 -externals = Externals.cfg -protocol = git - -[externals_description] -schema_version = 1.0.0 - diff --git a/GMAO_pFIO/CMakeLists.txt b/GMAO_pFIO/CMakeLists.txt index 2108a950edae..e1c9d34fd20e 100644 --- a/GMAO_pFIO/CMakeLists.txt +++ b/GMAO_pFIO/CMakeLists.txt @@ -102,14 +102,14 @@ if (NOT CMAKE_Fortran_COMPILER_ID MATCHES GNU) ecbuild_add_executable ( TARGET pfio_server_demo.x SOURCES pfio_server_demo.F90 - LIBS ${this} ${NETCDF_LIBRARIES} ${OpenMP_Fortran_LIBRARIES}) + LIBS ${this} ${NETCDF_LIBRARIES} OpenMP::OpenMP_Fortran MPI::MPI_Fortran) set_target_properties (pfio_server_demo.x PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) set_target_properties(pfio_server_demo.x PROPERTIES LINK_FLAGS "${OpenMP_Fortran_FLAGS}") ecbuild_add_executable ( TARGET pfio_collective_demo.x SOURCES pfio_collective_demo.F90 - LIBS ${this} ${NETCDF_LIBRARIES} ${OpenMP_Fortran_LIBRARIES}) + LIBS ${this} ${NETCDF_LIBRARIES} OpenMP::OpenMP_Fortran MPI::MPI_Fortran) set_target_properties (pfio_collective_demo.x PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) set_target_properties(pfio_collective_demo.x PROPERTIES LINK_FLAGS "${OpenMP_Fortran_FLAGS}") endif () diff --git a/GMAO_pFIO/tests/CMakeLists.txt b/GMAO_pFIO/tests/CMakeLists.txt index f1fd856d988b..e61d3d311df0 100644 --- a/GMAO_pFIO/tests/CMakeLists.txt +++ b/GMAO_pFIO/tests/CMakeLists.txt @@ -52,7 +52,7 @@ ecbuild_add_executable ( TARGET ${TESTO} PROPERTIES EXCLUDE_FROM_ALL=TRUE SOURCES pfio_ctest_io.F90 - LIBS GMAO_pFIO ${NETCDF_LIBRARIES} + LIBS GMAO_pFIO ${NETCDF_LIBRARIES} MPI::MPI_Fortran DEFINITIONS USE_MPI) set_target_properties(${TESTO} PROPERTIES LINK_FLAGS "${OpenMP_Fortran_FLAGS}") target_link_libraries(${TESTO} GMAO_pFIO ${NETCDF_LIBRARIES}) @@ -84,7 +84,7 @@ ecbuild_add_executable ( PROPERTIES EXCLUDE_FROM_ALL=TRUE SOURCES pfio_performance.F90 DEFINITIONS USE_MPI - LIBS GMAO_pFIO ${NETCDF_LIBRARIES}) + LIBS GMAO_pFIO ${NETCDF_LIBRARIES} MPI::MPI_Fortran) set_target_properties(${TESTPERF} PROPERTIES LINK_FLAGS "${OpenMP_Fortran_FLAGS}") target_link_libraries(${TESTPERF} GMAO_pFIO ${NETCDF_LIBRARIES}) diff --git a/components.yaml b/components.yaml index 3ec677cbeed0..61a3c15d51cb 100644 --- a/components.yaml +++ b/components.yaml @@ -1,7 +1,7 @@ ESMA_env: local: ./@env remote: git@github.com:GEOS-ESM/ESMA_env.git - branch: dev/MAPL-2.0 + tag: v2.0.1 develop: master ESMA_cmake: From 63ff6aa28713c602ea0702ea3aa4d8110715b488 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 25 Feb 2020 10:01:25 -0500 Subject: [PATCH 034/109] Try running pFIO and MAPL_Base unit tests in CI --- .circleci/config.yml | 21 ++++++++++++++------- 1 file changed, 14 insertions(+), 7 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index dd1980f69307..ffb2e2377071 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -10,7 +10,7 @@ executors: OMPI_MCA_btl_vader_single_copy_mechanism: none jobs: - build-and-test-gcc: + build-and-test-GNU: executor: gcc-build-env working_directory: /root/project steps: @@ -35,14 +35,21 @@ jobs: command: | cd build make -j2 install - #- run: - #name: Run MAPL tests - #command: | - #cd build - #make -j2 tests || ctest -VV + - run: + name: Run pFIO Unit tests + command: | + cd build + make -j2 pFIO_tests + ctest -R 'pFIO_tests$' || ctest -R 'pFIO_tests$' -VV + - run: + name: Run MAPL_Base Unit tests + command: | + cd build + make -j2 MAPL_Base_tests + ctest -R 'MAPL_Base_tests$' || ctest -R 'MAPL_Base_tests$' -VV workflows: version: 2.1 pull_request_tests: jobs: - - build-and-test-gcc + - build-and-test-GNU From 800fdb191d32de44f9588f0b06ef8b27e0e6cfdb Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 25 Feb 2020 10:22:19 -0500 Subject: [PATCH 035/109] Update CHANGELOG --- CHANGELOG.md | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index d113a05b2bab..0630e5e131b6 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -27,7 +27,9 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added -- Added configuration for CircleCI (build only) +- Added configuration for CircleCI + - Builds MAPL using GCC 9.2.0 and Open MPI 4.0.2 + - Builds and runs `pFIO_tests` and `MAPL_Base_tests` ## [2.0.0] - 2019-02-07 From df01fd0008c927a52c7c5955afa3327850de4c57 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Wed, 26 Feb 2020 10:28:02 -0500 Subject: [PATCH 036/109] Move to ESMA_env 2.0.2 --- components.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/components.yaml b/components.yaml index 61a3c15d51cb..569fd2cf9b0b 100644 --- a/components.yaml +++ b/components.yaml @@ -1,7 +1,7 @@ ESMA_env: local: ./@env remote: git@github.com:GEOS-ESM/ESMA_env.git - tag: v2.0.1 + tag: v2.0.2 develop: master ESMA_cmake: From 7dfccc3a22a4cf8e9e5f22f211a2b840ccb7813a Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Tue, 3 Mar 2020 18:39:03 -0500 Subject: [PATCH 037/109] add MAPL_VerticalGrid.F90 to replace set_eta --- MAPL_Base/CMakeLists.txt | 2 +- MAPL_Base/MAPL_VerticalGrid.F90 | 260 +++++++++ MAPL_Base/write_eta.F90 | 963 ++++++++++++++++++++++++++++++++ 3 files changed, 1224 insertions(+), 1 deletion(-) create mode 100644 MAPL_Base/MAPL_VerticalGrid.F90 create mode 100644 MAPL_Base/write_eta.F90 diff --git a/MAPL_Base/CMakeLists.txt b/MAPL_Base/CMakeLists.txt index 99f3e9ce4aeb..c996f87aa342 100644 --- a/MAPL_Base/CMakeLists.txt +++ b/MAPL_Base/CMakeLists.txt @@ -26,7 +26,7 @@ set (srcs MAPL_Cap.F90 hash.c MAPL_CapGridComp.F90 MAPL_GridType.F90 - MAPL_GridSpec.F90 MAPL_VerticalMethods.F90 MAPL_newCFIOitem.F90 + MAPL_GridSpec.F90 MAPL_VerticalMethods.F90 MAPL_newCFIOitem.F90 MAPL_VerticalGrid.F90 MAPL_VerticalInterpMod.F90 MAPL_ESMFTimeVectorMod.F90 MAPL_TimeMethods.F90 MAPL_ioClients.F90 MAPL_DirPath.F90 diff --git a/MAPL_Base/MAPL_VerticalGrid.F90 b/MAPL_Base/MAPL_VerticalGrid.F90 new file mode 100644 index 000000000000..814fd25f9bd3 --- /dev/null +++ b/MAPL_Base/MAPL_VerticalGrid.F90 @@ -0,0 +1,260 @@ +#include "MAPL_ErrLog.h" +#include "unused_dummy.H" + +module MAPL_VerticalGrid + use, intrinsic :: ISO_FORTRAN_ENV, only: REAL64, REAL32 + use ESMF + use ESMFL_Mod + use MAPL_ErrorHandlingMod + use MAPL_KeywordEnforcerMod + use pFIO + implicit none + private + + public :: VerticalGrid + + + type :: VerticalGrid + private + real(kind=REAL64), allocatable :: ak(:) + real(kind=REAL64), allocatable :: bk(:) + integer :: ks + integer :: num_levels = 0 + logical :: use_sigma_levels = .false. + logical :: use_ncep_levels = .false. + contains + procedure :: set_eta_r8 + procedure :: set_eta_r4 + procedure :: get_pressure_levels_r8 + procedure :: get_pressure_levels_r4 + generic :: set_eta =>set_eta_r8, set_eta_r4 + generic :: get_pressure_levels=>get_pressure_levels_r8, get_pressure_levels_r4 + end type VerticalGrid + + interface newVerticalGrid + module procedure new_VerticalGrid_by_ak_bk + module procedure new_VerticalGrid_by_cfg + end interface + + real(kind=REAL64), parameter :: DEFAULT_REFENCE_PRESSURE = 98400.d0 ! Pa + +contains + + + function new_VerticalGrid_by_ak_bk(ak, bk, ks, unused, use_sigma_levels, use_ncep_levels, rc) result(grid) + type (VerticalGrid) :: grid + real(kind=REAL64), intent(in) :: ak(:) + real(kind=REAL64), intent(in) :: bk(:) + integer, intent(in) :: ks + class(KeywordEnforcer), optional, intent(in) :: unused + logical, optional,intent(in) :: use_sigma_levels + logical, optional,intent(in) :: use_ncep_levels + integer, optional, intent(inout) :: rc + + character(len=*), parameter :: Iam="new_VerticalGrid_by_ak_bk" + + _ASSERT(size(ak) >= 2, 'size of ak should be >=2') + _ASSERT(size(ak) == size(bk), ' size of ak should be the same as that of bk') + + grid%ak = ak + grid%bk = bk + grid%ks = ks + + if (present(use_sigma_levels)) then + grid%use_sigma_levels = use_sigma_levels + else + grid%use_sigma_levels = .false. + end if + + if (present(use_ncep_levels)) then + grid%use_ncep_levels = use_ncep_levels + else + grid%use_ncep_levels = .false. + end if + + grid%num_levels = size(ak) - 1 + + end function new_VerticalGrid_by_ak_bk + + function new_VerticalGrid_by_cfg(config, unused, reference_pressure, rc) result(grid) + type (VerticalGrid) :: grid + type (ESMF_Config) :: config + class (KeywordEnforcer), optional, intent(in) :: unused + real(kind=REAL64), optional, intent(in) :: reference_pressure + integer, optional, intent(inout) :: rc + logical :: use_sigma_levels + logical :: use_ncep_levels + real(kind=REAL64), allocatable :: ak(:) + real(kind=REAL64), allocatable :: bk(:) + + integer :: k,ks, num_levels + real(kind=REAL64) :: ptop, pint + character(len=32) :: data_label + character(len=*), parameter :: Iam="new_VerticalGrid_by_cfg" + + call ESMF_ConfigGetAttribute(config, num_levels,label='NUM_LEVELS:', default = 0, rc=rc) + call ESMF_ConfigGetAttribute(config, use_sigma_levels, label='USE_SIGMA_LEVELS:', default=.false., rc=rc) + call ESMF_ConfigGetAttribute(config, use_ncep_levels, label='USE_NCEP_LEVELS:', default=.false., rc=rc) + + data_label = "levels_"//i_to_string(num_levels)//":" + if(use_sigma_levels) then + _ASSERT(num_levels==64, "sigma only 64 levels") + data_label = "sigma_levels_64:" + _ASSERT( .not. use_ncep_levels, "64 .or. 72") + endif + + if(use_ncep_levels) then + _ASSERT(num_levels==72, "ncep_gmao 72 levels") + data_label = "ncep_levels_72:" + endif +#ifdef _BETA3P1_N_EARLIER_ + _ASSERT( .not. use_ncep_levels, " not ncep grid") + _ASSERT( .not. use_sigma_levels, " not sigma grid") + _ASSERT(num_levels==72, " _BETA3P1_N_EARLIER_ is defines") + eta_lable = "BETA3P1_levels_72:" +#endif + + allocate(ak(num_levels+1), bk(num_levels+1)) + + call ESMF_ConfigFindLabel(config, trim(data_label), rc=rc) + + ! get ak and bk + do k = 1, num_levels+1 + call ESMF_ConfigNextLine(config, rc=rc) + call ESMF_ConfigGetAttribute(config, ak(k), rc=rc) + call ESMF_ConfigGetAttribute(config, bk(k), rc=rc) + enddo + ! the last row is ks for pint = ak(ks+1) + call ESMF_ConfigNextLine(config, rc=rc) + call ESMF_ConfigGetAttribute(config, ks, rc=rc) + + grid = VerticalGrid(ak, bk, ks, use_sigma_levels, use_ncep_levels) + + end function new_VerticalGrid_by_cfg + + subroutine set_eta_r8(this, km, ks, ptop, pint, ak, bk, unused,rc) + class(VerticalGrid), intent(in) :: this + integer, intent(in) :: km + integer, intent(out) :: ks + real(kind=REAL64), intent(out) :: ak(:) + real(kind=REAL64), intent(out) :: bk(:) + real(kind=REAL64), intent(out) :: ptop ! model top (Pa) + real(kind=REAL64), intent(out) :: pint ! transition to p (Pa) + class(KeywordEnforcer), optional, intent(in) :: unused + integer, optional, intent(out) :: rc + + _ASSERT(km == size(ak)-1 ,"size ak should be consistent") + _ASSERT(km == size(bk)-1 ,"size ak should be consistent") + _ASSERT(km == this%num_levels,"size vertical grid should be consistent") + + ak = this%ak + bk = this%bk + ks = this%ks + ptop = this%ak(1) + pint = this%ak(ks+1) + + _RETURN(_SUCCESS) + + end subroutine set_eta_r8 + + subroutine set_eta_r4(this, km, ks, ptop, pint, ak, bk, unused,rc) + class(VerticalGrid), intent(in) :: this + integer, intent(in) :: km + integer, intent(out) :: ks + real(kind=REAL32), intent(out) :: ak(:) + real(kind=REAL32), intent(out) :: bk(:) + real(kind=REAL32), intent(out) :: ptop ! model top (Pa) + real(kind=REAL32), intent(out) :: pint ! transition to p (Pa) + class(KeywordEnforcer), optional, intent(in) :: unused + integer, optional, intent(out) :: rc + + real(kind=REAL64), allocatable :: ak8(:) + real(kind=REAL64), allocatable :: bk8(:) + real(kind=REAL64) :: ptop8 ! model top (Pa) + real(kind=REAL64) :: pint8 ! transition to p (Pa) + + _ASSERT(km == size(ak)-1 ,"size ak should be consistent") + _ASSERT(km == size(bk)-1 ,"size ak should be consistent") + _ASSERT(km == this%num_levels,"size vertical grid should be consistent") + + allocate(ak8(km+1)) + allocate(bk8(km+1)) + + call this%set_eta(km, ks, ptop8, pint8, ak8, bk8) + + ak = real(ak8, kind=REAL32) + bk = real(bk8, kind=REAL32) + ptop = ak(1) + pint = ak(ks+1) + + deallocate(ak8,bk8) + + _RETURN(_SUCCESS) + end subroutine set_eta_r4 + + subroutine get_pressure_levels_r8(this, pressure_levels, unused, reference_pressure, rc) + class(VerticalGrid), intent(in) :: this + real(kind=REAL64), intent(out) :: pressure_levels(:) + class(KeywordEnforcer), optional, intent(in) :: unused + real(kind=REAL64), optional, intent(in) :: reference_pressure + integer, optional, intent(out) :: rc + real(kind=REAL64) :: p0 + integer :: k, n_levels + character(len=*), parameter :: Iam="get_pressure_levels" + + n_levels = this%num_levels + _ASSERT(size(pressure_levels) == n_levels, 'incorrect array size for pressure_levels dummy argument') + + if (present(reference_pressure)) then + p0 = reference_pressure + else + p0 = DEFAULT_REFENCE_PRESSURE + end if + + pressure_levels(1) = this%ak(1) + 0.50d0 * dpref_(1,p0) + + do k = 2, n_levels + pressure_levels(k) = pressure_levels(k-1) + 0.5d0 * (dpref_(k-1, p0) + dpref_(k,p0)) + end do + + Pressure_levels = pressure_levels/100.0d0 + + contains + real(kind=REAL64) function dpref_ (k,pbot) + integer k + real(kind=REAL64) pbot + dpref_ = ( this%ak(k+1) - this%ak(k) ) + & + ( this%bk(k+1) - this%bk(k) ) * pbot + end function dpref_ + + end subroutine get_pressure_levels_r8 + + subroutine get_pressure_levels_r4(this, pressure_levels, unused, reference_pressure, rc) + class(VerticalGrid), intent(in) :: this + real(kind=REAL32), intent(out) :: pressure_levels(:) + class(KeywordEnforcer), optional, intent(in) :: unused + real(kind=REAL32), optional, intent(in) :: reference_pressure + integer, optional, intent(out) :: rc + real(kind=REAL64) :: p0 + integer :: k, n_levels + real(kind=REAL64), allocatable :: plevels(:) + character(len=*), parameter :: Iam="get_pressure_levels" + + n_levels = this%num_levels + _ASSERT(size(pressure_levels) == n_levels, 'incorrect array size for pressure_levels dummy argument') + + if (present(reference_pressure)) then + p0 = reference_pressure + else + p0 = DEFAULT_REFENCE_PRESSURE + end if + + allocate(plevels(n_levels)) + + call get_pressure_levels_r8(this, plevels, reference_pressure=p0) + + pressure_levels = real(plevels,kind=REAL32) + + end subroutine get_pressure_levels_r4 + +end module MAPL_VerticalGrid diff --git a/MAPL_Base/write_eta.F90 b/MAPL_Base/write_eta.F90 new file mode 100644 index 000000000000..02549ee8c6fa --- /dev/null +++ b/MAPL_Base/write_eta.F90 @@ -0,0 +1,963 @@ +! +! This same files resides in 2 different standard places, with different names: +! +! shared/hermes/m_set_eta.F90 +! fvgcm/misc/set_eta.F90 +! +! When compiled under Hermes it becomes a module; otherwise it is a regular +! f77 routine. +! +! !HISTORY: +! 18May2005 Todling added (un)set_sigma routines to allow sigma levs setup +! 13Jun2005 Todling defined new 72-eta levs (gAdas-1_5beta3p2 and later) +! 17Apr2006 Elena N. 72-lev bug fix for ks definition +! ?????2008 Ravi Added 91 levs for ECMWF Nature run +! 13Oct2008 Todling Ravi's addition using wrong version of this file (fixed) +! 24Nov2008 Takacs/RT Fix ks for ECMWF 91 level-case +! 31Jul2009 Ravi Updated NCEP 64 Layer ak and bk (source Dr.da silva Arlindo) +! 20Oct2009 Todling Multiplied NCEP 64 ak levels by 10 (should be in Pa) +! 07Jul2012 Todling Create a 72-level set from NCEP's 64-level set +! 04Apr2018 Todling Overload for r4/r8 support +! +program write_eta + use, intrinsic :: iso_fortran_env, only: REAL32, REAL64 + implicit none + + logical :: SIGMA_LEVS = .false. ! controls whether levs are sigma or eta + logical :: NCEP72_4GMAO= .false. ! controls whether levs are 72, but largely as NCEP's 64 + + +! Choices for vertical resolutions are as follows: +! NCAR: 18, 26, and 30 +! NASA DAO: smoothed version of CCM4's 30-level, 32, 48, 55 +! Revised 32-layer setup with top at 0.4 mb for high horizontal +! resolution runs. (sjl: 04/01/2002) +! Revised 55-level eta with pint at 176.93 mb SJL: 2000-03-20 +! +! NCEP 64-level sigma and hybrid eta + +! NCAR specific + real(REAL64) a18(19),b18(19) ! CCM3 + real(REAL64) a26(27),b26(27) ! CCM4 + real(REAL64) a30(31),b30(31) ! CCM4 + +! NASA only + real(REAL64) a01(2),b01(2) ! to allow single-level utils to rely on sim code + real(REAL64) a30m(31),b30m(31) ! smoothed CCM4 30-L + real(REAL64) a32(33),b32(33) + real(REAL64) a44(45),b44(45) + real(REAL64) a48(49),b48(49) + real(REAL64) a55(56),b55(56) + real(REAL64) a72(73),b72(73) ! geos-5 + real(REAL64) a91(92),b91(92) ! Nature EC + real(REAL64) a96(97),b96(97) ! not sure + real(REAL64) a72_ncep(73),b72_ncep(73) ! mainly NCEP's 64 with the GMAO-72 top levels + real(REAL64) a72_BETA3P1(73),b72_BETA3P1(73) + real(REAL64) a137(138), b137(138) + real(REAL64) a144(145), b144(145) + real(REAL64) a132(133), b132(133) + +! NCEP + real(REAL64) a64(65),b64(65), a64_sig(65),b64_sig(65) + + integer ks, k, km + !real(REAL64) ak(km+1),bk(km+1) + real(REAL64) ptop ! model top (Pa) + real(REAL64) pint ! transition to p (Pa) + +! *** NCAR settings *** + + data a18 /291.70, 792.92, 2155.39, 4918.34, 8314.25, & + 7993.08, 7577.38, 7057.52, 6429.63, 5698.38, & + 4879.13, 3998.95, 3096.31, 2219.02, 1420.39, & + 754.13, 268.38, 0.0000, 0.0000 / + + data b18 /0.0000, 0.0000, 0.0000, 0.0000, 0.0000, & + 0.0380541, 0.0873088, 0.1489307, 0.2232996, & + 0.3099406, 0.4070096, 0.5112977, 0.6182465, & + 0.7221927, 0.8168173, 0.8957590, 0.9533137, & + 0.9851122, 1.0 / + + data a26 /219.4067, 489.5209, 988.2418, 1805.201, & + 2983.724, 4462.334, 6160.587, 7851.243, & + 7731.271, 7590.131, 7424.086, 7228.744, & + 6998.933, 6728.574, 6410.509, 6036.322, & + 5596.111, 5078.225, 4468.96, 3752.191, & + 2908.949, 2084.739, 1334.443, 708.499, & + 252.136, 0., 0. / + + data b26 /0., 0., 0., 0., & + 0., 0., 0., 0., & + 0.01505309, 0.03276228, 0.05359622, 0.07810627, & + 0.1069411, 0.14086370, 0.180772, 0.227722, & + 0.2829562, 0.3479364, 0.4243822, 0.5143168, & + 0.6201202, 0.7235355, 0.8176768, 0.8962153, & + 0.9534761, 0.9851122, 1. / + + data a30 /225.523952394724, 503.169186413288, 1015.79474285245, & + 1855.53170740604, 3066.91229343414, 4586.74766123295, & + 6332.34828710556, 8070.14182209969, 9494.10423636436, & + 11169.321089983, 13140.1270627975, 15458.6806893349, & + 18186.3352656364, 17459.799349308, 16605.0657629967, & + 15599.5160341263, 14416.541159153, 13024.8308181763, & + 11387.5567913055, 9461.38575673103, 7534.44507718086, & + 5765.89405536652, 4273.46378564835, 3164.26791250706, & + 2522.12174236774, 1919.67375576496, 1361.80268600583, & + 853.108894079924, 397.881818935275, 0., & + 0. / + + data b30 /0., 0., & + 0., 0., 0., & + 0., 0., 0., & + 0., 0., 0., & + 0., 0., 0.03935482725501, & + 0.085653759539127, 0.140122056007385, 0.20420117676258, & + 0.279586911201477, 0.368274360895157, 0.47261056303978, & + 0.576988518238068, 0.672786951065063, 0.75362843275070, & + 0.813710987567902, 0.848494648933411, 0.88112789392471, & + 0.911346435546875, 0.938901245594025, 0.96355980634689, & + 0.985112190246582, 1. / + +! *** NASA DAO settings *** + +! Smoothed CCM4's 30-Level setup + data a30m / 300.00000, 725.00000, 1500.00000, & + 2600.00000, 3800.00000, 5050.00000, & + 6350.00000, 7750.00000, 9300.00000, & + 11100.00000, 13140.00000, 15458.00000, & + 18186.33580, 20676.23761, 22275.23783, & + 23025.65071, 22947.33569, 22038.21991, & + 20274.24578, 17684.31619, 14540.98138, & + 11389.69990, 8795.97971, 6962.67963, & + 5554.86684, 4376.83633, 3305.84967, & + 2322.63910, 1437.78398, 660.76994, & + 0.00000 / + + data b30m / 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00719, 0.02895, & + 0.06586, 0.11889, 0.18945, & + 0.27941, 0.38816, 0.50692, & + 0.61910, 0.70840, 0.77037, & + 0.81745, 0.85656, 0.89191, & + 0.92421, 0.95316, 0.97850, & + 1.00000 / + + data a32/40.00000, 106.00000, 224.00000, & + 411.00000, 685.00000, 1065.00000, & + 1565.00000, 2179.80000, 2900.00000, & + 3680.00000, 4550.00000, 5515.00000, & + 6607.00000, 7844.00000, 9236.56616, & + 10866.34280, 12783.70000, 15039.29900, & + 17693.00000, 20815.20900, 24487.49020, & + 28808.28710, 32368.63870, 33739.96480, & + 32958.54300, 30003.29880, 24930.12700, & + 18568.89060, 12249.20510, 6636.21191, & + 2391.51416, 0.00000, 0.00000 / + + data b32/ 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.01523, 0.06132, & + 0.13948, 0.25181, 0.39770, & + 0.55869, 0.70853, 0.83693, & + 0.93208, 0.98511, 1.00000 / + + data a48/40.00000, 100.00000, 200.00000, & + 350.00000, 550.00000, 800.00000, & + 1085.00000, 1390.00000, 1720.00000, & + 2080.00000, 2470.00000, 2895.00000, & + 3365.00000, 3890.00000, 4475.00000, & + 5120.00000, 5830.00000, 6608.00000, & + 7461.00000, 8395.00000, 9424.46289, & + 10574.46900, 11864.80330, 13312.58850, & + 14937.03770, 16759.70760, 18804.78670, & + 21099.41250, 23674.03720, 26562.82650, & + 29804.11680, 32627.31601, 34245.89759, & + 34722.29104, 34155.20062, 32636.50533, & + 30241.08406, 27101.45052, 23362.20912, & + 19317.04955, 15446.17194, 12197.45091, & + 9496.39912, 7205.66920, 5144.64339, & + 3240.79521, 1518.62245, 0.00000, & + 0.00000 / + + data b48/0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00813, 0.03224, & + 0.07128, 0.12445, 0.19063, & + 0.26929, 0.35799, 0.45438, & + 0.55263, 0.64304, 0.71703, & + 0.77754, 0.82827, 0.87352, & + 0.91502, 0.95235, 0.98511, & + 1.00000 / + + data a55/ 1.00000, 2.00000, 3.27000, & + 4.75850, 6.60000, 8.93450, & + 11.97030, 15.94950, 21.13490, & + 27.85260, 36.50410, 47.58060, & + 61.67790, 79.51340, 101.94420, & + 130.05080, 165.07920, 208.49720, & + 262.02120, 327.64330, 407.65670, & + 504.68050, 621.68000, 761.98390, & + 929.29430, 1127.68880, 1364.33920, & + 1645.70720, 1979.15540, 2373.03610, & + 2836.78160, 3380.99550, 4017.54170, & + 4764.39320, 5638.79380, 6660.33770, & + 7851.22980, 9236.56610, 10866.34270, & + 12783.70000, 15039.30000, 17693.00000, & + 20119.20876, 21686.49129, 22436.28749, & + 22388.46844, 21541.75227, 19873.78342, & + 17340.31831, 13874.44006, 10167.16551, & + 6609.84274, 3546.59643, 1270.49390, & + 0.00000, 0.00000 / + + data b55 /0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00696, 0.02801, 0.06372, & + 0.11503, 0.18330, 0.27033, & + 0.37844, 0.51046, 0.64271, & + 0.76492, 0.86783, 0.94329, & + 0.98511, 1.00000 / + + +! NCEP's 64 sigma layers + + data a64_sig/1.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000 / + + data b64_sig/0.00000 , 6.419999991E-4, 1.378000015E-3, & + 2.219999908E-3, 3.183000023E-3, 4.284000024E-3, & + 5.54399984E-3 , 6.984999869E-3, 8.631000295E-3, & + 1.051099971E-2, 1.265799999E-2, 1.510700025E-2, & + 1.790099964E-2, 2.108399943E-2, 2.470799908E-2, & + 2.882999927E-2, 3.351499885E-2, 3.883099928E-2, & + 4.485499859E-2, 5.167099833E-2, 5.936999992E-2, & + 6.804899871E-2, 7.780800015E-2, 8.875600249E-2, & + 0.101002 , 0.114655003 , 0.129822999 , & + 0.146607995 , 0.165098995 , 0.185371995 , & + 0.207481995 , 0.231454 , 0.257283986 , & + 0.284927994 , 0.314300001 , 0.345268995 , & + 0.377658993 , 0.411249012 , 0.445778012 , & + 0.480955005 , 0.516462982 , 0.551973999 , & + 0.587159991 , 0.621704996 , 0.655315995 , & + 0.687731028 , 0.718729019 , 0.748133004 , & + 0.775811017 , 0.801676989 , 0.825685024 , & + 0.847829998 , 0.868139029 , 0.88666302 , & + 0.903479993 , 0.918677986 , 0.932359993 , & + 0.94463098 , 0.955603004 , 0.96538502 , & + 0.974083006 , 0.98180002 , 0.988632023 , & + 0.994670987 , 1.0 / + + +! data a64/1.00000, 3.90000, 8.70000, & +! 15.42000, 24.00000, 34.50000, & +! 47.00000, 61.50000, 78.60000, & +! 99.13500, 124.12789, 154.63770, & +! 191.69700, 236.49300, 290.38000, & +! 354.91000, 431.82303, 523.09300, & +! 630.92800, 757.79000, 906.45000, & +! 1079.85000, 1281.00000, 1515.00000, & +! 1788.00000, 2105.00000, 2470.00000, & +! 2889.00000, 3362.00000, 3890.00000, & +! 4475.00000, 5120.00000, 5830.00000, & +! 6608.00000, 7461.00000, 8395.00000, & +! 9424.46289, 10574.46880, 11864.80270, & +! 13312.58890, 14937.03710, 16759.70700, & +! 18804.78710, 21099.41210, 23674.03710, & +! 26562.82810, 29804.11720, 32627.31640, & +! 34245.89840, 34722.28910, 34155.19920, & +! 32636.50390, 30241.08200, 27101.44920, & +! 23362.20700, 19317.05270, 15446.17090, & +! 12197.45210, 9496.39941, 7205.66992, & +! 5144.64307, 3240.79346, 1518.62134, & +! 0.00000, 0.00000 / + + +! data b64/0.00000, 0.00000, 0.00000, & +! 0.00000, 0.00000, 0.00000, & +! 0.00000, 0.00000, 0.00000, & +! 0.00000, 0.00000, 0.00000, & +! 0.00000, 0.00000, 0.00000, & +! 0.00000, 0.00000, 0.00000, & +! 0.00000, 0.00000, 0.00000, & +! 0.00000, 0.00000, 0.00000, & +! 0.00000, 0.00000, 0.00000, & +! 0.00000, 0.00000, 0.00000, & +! 0.00000, 0.00000, 0.00000, & +! 0.00000, 0.00000, 0.00000, & +! 0.00000, 0.00000, 0.00000, & +! 0.00000, 0.00000, 0.00000, & +! 0.00000, 0.00000, 0.00000, & +! 0.00000, 0.00000, 0.00813, & +! 0.03224, 0.07128, 0.12445, & +! 0.19063, 0.26929, 0.35799, & +! 0.45438, 0.55263, 0.64304, & +! 0.71703, 0.77754, 0.82827, & +! 0.87352, 0.91502, 0.95235, & +! 0.98511, 1.00000 / + +! NCEP updated ak and bk. + + data a64/ 0.000000, 64.24700, 137.78999, & + 221.95799, 318.26601, 428.43403, & + 554.42398, 698.45703, 863.05794, & + 1051.08002, 1265.75195, 1510.71091, & + 1790.05096, 2108.36609, 2470.78796, & + 2883.03802, 3351.45996, 3883.05206, & + 4485.49316, 5167.14600, 5937.04956, & + 6804.87366, 7777.15027, 8832.53662, & + 9936.61377, 11054.85352, 12152.93701, & + 13197.06543, 14154.31641, 14993.07495, & + 15683.48877, 16197.96753, 16511.73584, & + 16611.60522, 16503.14575, 16197.31567, & + 15708.89282, 15056.34155, 14261.43433, & + 13348.67065, 12344.48975, 11276.34766, & + 10171.71204, 9057.05078, 7956.90796, & + 6893.11707, 5884.20593, 4945.02869, & + 4086.61407, 3316.21704, 2637.55310, & + 2051.15005, 1554.78897, 1143.98804, & + 812.48894, 552.71999, 356.22299, & + 214.01501, 116.89899, 55.71200, & + 21.51600, 5.741000, 0.575000, & + 0.000000, 0.000000 / + + data b64/0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.000036970, 0.00043106, & + 0.0016359, 0.0041067, 0.0082940, & + 0.014637, 0.023556, 0.035442, & + 0.050647, 0.069475, 0.092167, & + 0.11881, 0.14927, 0.18330, & + 0.22057, 0.26069, 0.30316, & + 0.34747, 0.39302, 0.43921, & + 0.48544, 0.53113, 0.57575, & + 0.61880, 0.65989, 0.69868, & + 0.73495, 0.76851, 0.79931, & + 0.82732, 0.85259, 0.87522, & + 0.89535, 0.91315, 0.92880, & + 0.94249, 0.95443, 0.96483, & + 0.97387, 0.98174, 0.98863, & + 0.99467, 1.00000/ + +! NCEP levels adapted to 72-level GMAO-like: +! all levels below ak=137.78999 are identical to the 64-NCEP levels +! levels above that were fix as top=gmao-72, and others interpololated +! somewhat at will (RTodling) + + data a72_ncep/ 1.0000000, 2.6350000, & + 5.6792510, 10.452402, 13.959903, & + 18.542203, 24.493755, 42.042359, & + 70.595662, 101.94402, 137.78999, & + 221.95799, 318.26601, 428.43403, & + 554.42398, 698.45703, 863.05794, & + 1051.08002, 1265.75195, 1510.71091, & + 1790.05096, 2108.36609, 2470.78796, & + 2883.03802, 3351.45996, 3883.05206, & + 4485.49316, 5167.14600, 5937.04956, & + 6804.87366, 7777.15027, 8832.53662, & + 9936.61377, 11054.85352, 12152.93701, & + 13197.06543, 14154.31641, 14993.07495, & + 15683.48877, 16197.96753, 16511.73584, & + 16611.60522, 16503.14575, 16197.31567, & + 15708.89282, 15056.34155, 14261.43433, & + 13348.67065, 12344.48975, 11276.34766, & + 10171.71204, 9057.05078, 7956.90796, & + 6893.11707, 5884.20593, 4945.02869, & + 4086.61407, 3316.21704, 2637.55310, & + 2051.15005, 1554.78897, 1143.98804, & + 812.48894, 552.71999, 356.22299, & + 214.01501, 116.89899, 55.71200, & + 21.51600, 5.741000, 0.575000, & + 0.000000, 0.000000 / + + data b72_ncep/0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.000036970, 0.00043106, & + 0.0016359, 0.0041067, 0.0082940, & + 0.014637, 0.023556, 0.035442, & + 0.050647, 0.069475, 0.092167, & + 0.11881, 0.14927, 0.18330, & + 0.22057, 0.26069, 0.30316, & + 0.34747, 0.39302, 0.43921, & + 0.48544, 0.53113, 0.57575, & + 0.61880, 0.65989, 0.69868, & + 0.73495, 0.76851, 0.79931, & + 0.82732, 0.85259, 0.87522, & + 0.89535, 0.91315, 0.92880, & + 0.94249, 0.95443, 0.96483, & + 0.97387, 0.98174, 0.98863, & + 0.99467, 1.00000/ + + + + data a72_BETA3P1 / & + 1.00000, 2.00000, 3.27000, 4.75850, 6.60000, 8.93450, & + 11.9703, 15.9495, 21.1349, 27.8526, 36.5041, 47.5806, & + 61.6779, 79.5134, 101.944, 130.051, 165.079, 208.497, & + 262.021, 327.643, 407.657, 504.680, 621.680, 761.984, & + 929.294, 1127.69, 1364.34, 1645.71, 1979.16, 2373.04, & + 2836.78, 3381.00, 4017.54, 4764.39, 5638.79, 6660.34, & + 7851.23, 9236.57, 10866.3, 12783.7, 15039.3, 17693.0, & + 20119.2, 21686.5, 22436.3, 22389.8, 21877.6, 21215.0, & + 20325.9, 19309.7, 18161.9, 16960.9, 15626.0, 14291.0, & + 12869.6, 11409.0, 9936.52, 8909.99, 7883.42, 6856.90, & + 5805.32, 5169.61, 4533.90, 3898.20, 3257.08, 2609.20, & + 1961.31, 1313.48, 659.375, 332.086, 4.80469, 0.00000, & + 0.00000 / + + data b72_BETA3P1 / & + 0.00000, 0.00000, 0.00000, 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, 0.00000, 0.00000, 0.00000, & + 0.00696000, 0.0280100, 0.0637200, 0.113602, 0.156224, 0.200350, & + 0.246741, 0.294403, 0.343381, 0.392891, 0.443740, 0.494590, & + 0.546304, 0.598410, 0.650635, 0.685900, 0.721166, 0.756431, & + 0.791947, 0.813304, 0.834661, 0.856018, 0.877429, 0.898908, & + 0.920387, 0.941865, 0.963406, 0.974179, 0.984952, 0.992500, & + 1.00000 / + + data a72 / & + 1.0000000, 2.0000002, 3.2700005, 4.7585009, 6.6000011, & + 8.9345014, 11.970302, 15.949503, 21.134903, 27.852606, & + 36.504108, 47.580610, 61.677911, 79.513413, 101.94402, & + 130.05102, 165.07903, 208.49704, 262.02105, 327.64307, & + 407.65710, 504.68010, 621.68012, 761.98417, 929.29420, & + 1127.6902, 1364.3402, 1645.7103, 1979.1604, 2373.0405, & + 2836.7806, 3381.0007, 4017.5409, 4764.3911, 5638.7912, & + 6660.3412, 7851.2316, 9236.5722, 10866.302, 12783.703, & + 15039.303, 17693.003, 20119.201, 21686.501, 22436.301, & + 22389.800, 21877.598, 21214.998, 20325.898, 19309.696, & + 18161.897, 16960.896, 15625.996, 14290.995, 12869.594, & + 11895.862, 10918.171, 9936.5219, 8909.9925, 7883.4220, & + 7062.1982, 6436.2637, 5805.3211, 5169.6110, 4533.9010, & + 3898.2009, 3257.0809, 2609.2006, 1961.3106, 1313.4804, & + 659.37527, 4.8048257, 0.0000000 / + + + data b72 / & + 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000, & + 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000, & + 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000, & + 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000, & + 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000, & + 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000, & + 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000, & + 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000, & + 0.0000000, 8.1754130e-09, 0.0069600246, 0.028010041, 0.063720063, & + 0.11360208, 0.15622409, 0.20035011, 0.24674112, 0.29440312, & + 0.34338113, 0.39289115, 0.44374018, 0.49459020, 0.54630418, & + 0.58104151, 0.61581843, 0.65063492, 0.68589990, 0.72116594, & + 0.74937819, 0.77063753, 0.79194696, 0.81330397, 0.83466097, & + 0.85601798, 0.87742898, 0.89890800, 0.92038701, 0.94186501, & + 0.96340602, 0.98495195, 1.0000000 / + + +! Fake single-level for util codes - mimic lowest lev of 72 GMAO case + data a01 / 4.8048257, 0.0000000 / + data b01 / 0.98495195, 1.0000000 / + +! ECMWF Nature +! + data a91/ 0.000000000000, 2.000040054321, 3.980832099915, 7.387186050415, & + 12.908319473267, 21.413604736328, 33.952865600586, 51.746597290039, & + 76.167663574219, 108.715560913086, 150.986022949219, 204.637451171875, & + 271.356445312500, 352.824462890625, 450.685791015625, 566.519287109375, & + 701.813232421875, 857.945800781250, & + 1036.166503906250, 1237.585449218750, 1463.163818359375, 1713.709716796875, & + 1989.874511718750, 2292.155517578125, 2620.898437500000, 2976.302246093750, & + 3358.425781250000, 3767.196044921875, 4202.417968750000, 4663.777343750000, & + 5150.859375000000, 5663.156250000000, 6199.839843750000, 6759.726562500000, & + 7341.468750000000, 7942.925781250000, 8564.625000000000, 9208.304687500000, & + 9873.562500000000, 10558.882812500000, 11262.484375000000, 11982.660156250000, & + 12713.898437500000, 13453.226562500000, 14192.011718750000, 14922.687500000000, & + 15638.054687500000, 16329.562500000000, 16990.625000000000, 17613.281250000000, & + 18191.031250000000, 18716.968750000000, 19184.546875000000, 19587.515625000000, & + 19919.796875000000, 20175.394531250000, 20348.917968750000, 20434.156250000000, & + 20426.218750000000, 20319.011718750000, 20107.031250000000, 19785.359375000000, & + 19348.777343750000, 18798.824218750000, 18141.296875000000, 17385.593750000000, & + 16544.585937500000, 15633.566406250000, 14665.644531250000, 13653.218750000000, & + 12608.382812500000, 11543.167968750000, 10471.312500000000, 9405.222656250000, & + 8356.253906250000, 7335.164062500000, 6353.921875000000, 5422.800781250000, & + 4550.214843750000, 3743.464355468750, 3010.146972656250, 2356.202636718750, & + 1784.854492187500, 1297.656250000000, 895.193603515625, 576.314208984375, & + 336.772460937500, 162.043426513672, 54.208343505859 , 6.575628280640, & + 0.003160000080, 0.000000000000/ + + data b91/ 0.000000000000, 0.000000000000, 0.000000000000, 0.000000000000, & + 0.000000000000, 0.000000000000, 0.000000000000, 0.000000000000, & + 0.000000000000, 0.000000000000, 0.000000000000, 0.000000000000, & + 0.000000000000, 0.000000000000, 0.000000000000, 0.000000000000, & + 0.000000000000, 0.000000000000, 0.000000000000, 0.000000000000, & + 0.000000000000, 0.000000000000, 0.000000000000, 0.000000000000, & + 0.000000000000, 0.000000000000, 0.000000000000, 0.000000000000, & + 0.000000000000, 0.000000000000, 0.000000000000, 0.000000000000, & + 0.000000000000, 0.000000000000, 0.000000272400, 0.000013911600, & + 0.000054667194, 0.000131364097, 0.000278884778, 0.000548384152, & + 0.001000134507, 0.001701075351, 0.002764719306, 0.004267048091, & + 0.006322167814, 0.009034991264, 0.012508261949, 0.016859579831, & + 0.022188644856, 0.028610348701, 0.036226909608, 0.045146133751, & + 0.055474229157, 0.067316174507, 0.080777287483, 0.095964074135, & + 0.112978994846, 0.131934821606, 0.152933537960, 0.176091074944, & + 0.201520144939, 0.229314863682, 0.259554445744, 0.291993439198, & + 0.326329410076, 0.362202584743, 0.399204790592, 0.436906337738, & + 0.475016415119, 0.513279736042, 0.551458477974, 0.589317142963, & + 0.626558899879, 0.662933588028, 0.698223590851, 0.732223808765, & + 0.764679491520, 0.795384764671, 0.824185431004, 0.850950419903, & + 0.875518381596, 0.897767245770, 0.917650938034, 0.935157060623, & + 0.950273811817, 0.963007092476, 0.973466038704, 0.982238113880, & + 0.989152967930, 0.994204163551, 0.997630119324, 1.000000000000/ + + + data a96/ 1.00000, 2.32782, 3.34990, & + 4.49484, 5.62336, 6.93048, & + 8.41428, 10.06365, 11.97630, & + 14.18138, 16.70870, 19.58824, & + 22.84950, 26.52080, 30.62845, & + 35.19588, 40.24273, 45.78375, & + 51.82793, 58.43583, 65.62319, & + 73.40038, 81.77154, 90.73373, & + 100.27628, 110.82243, 122.47773, & + 135.35883, 149.59464, 165.32764, & + 182.71530, 201.93164, 223.16899, & + 246.63988, 272.57922, 301.24661, & + 332.92902, 367.94348, 406.64044, & + 449.40720, 496.67181, 548.90723, & + 606.63629, 670.43683, 740.94727, & + 818.87329, 904.99493, 1000.17395, & + 1105.36304, 1221.61499, 1350.09326, & + 1492.08362, 1649.00745, 1822.43469, & + 2014.10168, 2225.92627, 2460.02905, & + 2718.75195, 3004.68530, 3320.69092, & + 3669.93066, 4055.90015, 4482.46240, & + 4953.88672, 5474.89111, 6050.68994, & + 6687.04492, 7390.32715, 8167.57373, & + 9026.56445, 9975.89648, 11025.06934, & + 12184.58398, 13466.04785, 14882.28320, & + 16447.46289, 18177.25781, 20088.97461, & + 21886.89453, 23274.16602, 24264.66602, & + 24868.31641, 25091.15430, 24935.41016, & + 24399.52148, 23478.13281, 22162.01758, & + 20438.00586, 18288.83984, 15693.01172, & + 12624.54199, 9584.35352, 6736.55713, & + 4231.34326, 2199.57910, 747.11890, & + 0.00000 / + + data b96/0.00000, 0.00000, 0.00000,& + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00000, 0.00000, 0.00000, & + 0.00315, 0.01263, 0.02853, & + 0.05101, 0.08030, 0.11669, & + 0.16055, 0.21231, 0.27249, & + 0.34169, 0.42062, 0.51005, & + 0.61088, 0.70748, 0.79593, & + 0.87253, 0.93400, 0.97764, & + 1.00000 / + +! ECMWF 91-Levels reduced to 44 +! ----------------------------- + data a44 / 2.000040 , 12.90832 , 33.95286 , 76.16766 , 150.9860 , & + 271.3565 , 450.6858 , 701.8134 , 1036.167 , 1463.164 , & + 1989.874 , 2620.898 , 3358.426 , 4202.417 , 5150.860 , & + 6199.839 , 7341.470 , 8564.624 , 9873.561 , 11262.48 , & + 12713.90 , 14192.01 , 15638.05 , 16990.62 , 18191.03 , & + 19184.54 , 19919.80 , 20348.92 , 20426.22 , 20107.03 , & + 19348.78 , 18141.30 , 16544.59 , 14665.65 , 12608.38 , & + 10471.31 , 8356.253 , 6353.921 , 4550.216 , 3010.147 , & + 1784.855 , 895.1935 , 336.7724 , 54.20834 , 0.0000000E+00 / + + data b44 / 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00 , & + 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00 , & + 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00 , & + 0.0000000E+00, 0.0000000E+00, 5.5000000E-05, 2.7900000E-04, 1.0000000E-03 , & + 2.7650001E-03, 6.3220002E-03, 1.2508000E-02, 2.2189001E-02, 3.6226999E-02 , & + 5.5473998E-02, 8.0776997E-02, 0.1129790 , 0.1529340 , 0.2015200 , & + 0.2595540 , 0.3263290 , 0.3992050 , 0.4750160 , 0.5514580 , & + 0.6265590 , 0.6982240 , 0.7646790 , 0.8241850 , 0.8755180 , & + 0.9176510 , 0.9502740 , 0.9734660 , 0.9891530 , 1.000000 / + + +! ECMWF 137-Levels +! -------------- + data a137 & + /1.000000, 2.000365, 3.102241, 4.666084, 6.827977, 9.746966, 13.605424, 18.608931, 24.985718, 32.985710, & + 42.879242, 54.955463, 69.520576, 86.895882, 107.415741, 131.425507, 159.279404, 191.338562, 227.968948, 269.539581, & + 316.420746, 368.982361, 427.592499, 492.616028, 564.413452, 643.339905, 729.744141, 823.967834, 926.344910, 1037.20117, & + 1156.853638, 1285.610352, 1423.770142, 1571.622925, 1729.448975, 1897.519287, 2076.095947, 2265.431641, 2465.770508, 2677.348145, & + 2900.391357, 3135.119385, 3381.743652, 3640.468262, 3911.490479, 4194.930664, 4490.817383, 4799.149414, 5119.895020, 5452.990723, & + 5798.344727, 6156.074219, 6526.946777, 6911.870605, 7311.869141, 7727.412109, 8159.354004, 8608.525391, 9076.400391, 9562.682617, & + 10065.978516, 10584.631836, 11116.662109, 11660.067383, 12211.547852, 12766.873047, 13324.668945, 13881.331055, 14432.139648, 14975.615234, & + 15508.256836, 16026.115234, 16527.322266, 17008.789062, 17467.613281, 17901.621094, 18308.433594, 18685.718750, 19031.289062, 19343.511719, & + 19620.042969, 19859.390625, 20059.931641, 20219.664062, 20337.863281, 20412.308594, 20442.078125, 20425.718750, 20361.816406, 20249.511719, & + 20087.085938, 19874.025391, 19608.572266, 19290.226562, 18917.460938, 18489.707031, 18006.925781, 17471.839844, 16888.687500, 16262.046875, & + 15596.695312, 14898.453125, 14173.324219, 13427.769531, 12668.257812, 11901.339844, 11133.304688, 10370.175781, 9617.515625, 8880.453125, & + 8163.375000, 7470.343750, 6804.421875, 6168.531250, 5564.382812, 4993.796875, 4457.375000, 3955.960938, 3489.234375, 3057.265625, & + 2659.140625, 2294.242188, 1961.500000, 1659.476562, 1387.546875, 1143.250000, 926.507812, 734.992188, 568.062500, 424.414062, & + 302.476562, 202.484375, 122.101562, 62.781250, 22.835938, 3.757813, 0.000000, 0.000000/ + + data b137 & + /0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, & + 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, & + 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, & + 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, & + 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, & + 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000007, 0.000024, 0.000059, 0.000112, 0.000199, & + 0.000340, 0.000562, 0.000890, 0.001353, 0.001992, 0.002857, 0.003971, 0.005378, 0.007133, 0.009261, & + 0.011806, 0.014816, 0.018318, 0.022355, 0.026964, 0.032176, 0.038026, 0.044548, 0.051773, 0.059728, & + 0.068448, 0.077958, 0.088286, 0.099462, 0.111505, 0.124448, 0.138313, 0.153125, 0.168910, 0.185689, & + 0.203491, 0.222333, 0.242244, 0.263242, 0.285354, 0.308598, 0.332939, 0.358254, 0.384363, 0.411125, & + 0.438391, 0.466003, 0.493800, 0.521619, 0.549301, 0.576692, 0.603648, 0.630036, 0.655736, 0.680643, & + 0.704669, 0.727739, 0.749797, 0.770798, 0.790717, 0.809536, 0.827256, 0.843881, 0.859432, 0.873929, & + 0.887408, 0.899900, 0.911448, 0.922096, 0.931881, 0.940860, 0.949064, 0.956550, 0.963352, 0.969513, & + 0.975078, 0.980072, 0.984542, 0.988500, 0.991984, 0.995003, 0.997630, 1.000000/ + +! GEOS-5 144 levels +! -------------- + + data a144 / & + 1.000000, 1.960339, 3.018127, 4.519399, 6.594791, 9.396987, 13.101062, 17.904371, & + 24.026014, 31.705914, 41.203591, 52.796624, 66.778966, 83.459060, 103.157888, 126.206988, & + 152.946409, 183.722832, 218.887582, 258.794912, 303.800291, 354.258838, 410.523897, 472.945737, & + 541.870439, 617.638927, 700.586001, 791.039663, 889.320479, 995.741215, 1110.606209, 1234.211175, & + 1366.842986, 1508.779958, 1660.291153, 1821.636721, 1993.068262, 2174.828352, 2367.151362, 2570.263462, & + 2784.382383, 3009.718592, 3246.475054, 3494.847707, 3755.025920, 4027.125241, 4311.173090, 4607.168297, & + 4915.080393, 5234.848439, 5566.384314, 5909.800516, 6265.833909, 6635.356361, 7019.350358, 7418.266832, & + 7832.926088, 8264.125457, 8713.280080, 9180.105429, 9663.263708, 10161.164935, 10671.907883, 11193.570701, & + 11722.985614, 12256.091419, 12791.569071, 13325.958299, 13854.728219, 14376.458535, 14887.788352, 15384.926463, & + 15866.079454, 16328.282045, 16768.748022, 17185.390535, 17575.925860, 17938.115274, 18269.858802, 18569.588965, & + 18835.055787, 19064.826786, 19257.343857, 19410.685145, 19524.155037, 19595.621682, 19624.200090, 19608.495278, & + 19547.149762, 19439.338553, 19283.411670, 19078.875993, 18824.044044, 18518.435827, 18160.585111, 17749.946276, & + 17286.481825, 16772.805474, 16212.985926, 15611.418127, 14972.688273, 14685.145246, 14343.270330, 13949.485200, & + 13506.727241, 13018.449574, 12488.621027, 11921.726145, 11322.765171, 10701.274117, 10064.717511, 9415.890690, & + 8757.741793, 8093.371764, 7426.034348, 6759.136076, 6096.236214, 5441.046941, 4797.433388, 4167.668812, & + 3553.036489, 2953.887909, 2369.719063, 1802.141374, 1252.799272, 723.370122, 215.564278, -268.874847, & + -728.170839, -1160.514171, -1564.062288, -1936.939948, -2277.238943, -2583.017359, -2852.300196, -3083.080054, & + -3273.316548, -3420.936755, -3523.834829, -3579.870938, -3586.872187, -3542.632607, -3444.913165, -3291.442693, & + 0.000000/ + + data b144 / & + 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, & + 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, & + 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, & + 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, & + 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, & + 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, & + 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000007, & + 0.000023, 0.000057, 0.000108, 0.000191, 0.000326, 0.000540, 0.000854, 0.001299, & + 0.001912, 0.002743, 0.003812, 0.005163, 0.006848, 0.008890, 0.011334, 0.014223, & + 0.017585, 0.021461, 0.025885, 0.030889, 0.036505, 0.042766, 0.049701, 0.057338, & + 0.065709, 0.074839, 0.084754, 0.095482, 0.107044, 0.119469, 0.132779, 0.146998, & + 0.162152, 0.178259, 0.195349, 0.213437, 0.232551, 0.252709, 0.273937, 0.296251, & + 0.319618, 0.343920, 0.368984, 0.394675, 0.420850, 0.440673, 0.460647, 0.480716, & + 0.500823, 0.520907, 0.540908, 0.560763, 0.580407, 0.599826, 0.619030, 0.637990, & + 0.656675, 0.675052, 0.693090, 0.710758, 0.728021, 0.744846, 0.761201, 0.777101, & + 0.792575, 0.807657, 0.822389, 0.836759, 0.850752, 0.864358, 0.877561, 0.890349, & + 0.902708, 0.914625, 0.926086, 0.937078, 0.947586, 0.957597, 0.967096, 0.976070, & + 0.984504, 0.992384, 0.999696, 1.006424, 1.012554, 1.018072, 1.022962, 1.027209, & + 1.000000/ + +! GEOS-5 132 levels +! -------------- + data a132 / & + 1.000000, 1.996276, 3.093648, 4.651099, 6.804155, 9.711212, 13.553898, 18.536953, & + 24.887674, 32.854966, 42.708057, 54.734916, 69.240493, 86.544776, 106.980758, 130.892382, & + 158.632424, 190.560538, 227.041195, 268.441904, 315.131439, 367.478204, 425.848769, 490.606509, & + 562.110455, 640.714290, 726.765342, 820.603888, 922.562490, 1032.965616, 1152.128995, 1280.359406, & + 1417.954457, 1565.202880, 1722.383803, 1889.767115, 2067.613829, 2256.175598, 2455.695564, 2666.408361, & + 2888.539866, 3122.308425, 3367.924596, 3625.591648, 3895.506041, 4177.787642, 4472.464900, 4779.536600, & + 5098.971133, 5430.705281, 5774.647623, 6130.914868, 6500.271455, 6883.621876, 7281.985387, 7695.829790, & + 8126.006088, 8573.341452, 9039.303976, 9523.598485, 10024.837122, 10541.370406, 11071.225963, 11612.410025, & + 12161.636274, 12714.691534, 13270.207397, 13824.594107, 14373.151226, 14914.405313, 15444.869700, 15960.611311, & + 16459.769620, 16939.268383, 17396.217121, 17828.450893, 18233.600515, 18609.343488, 18953.501254, 19264.447677, & + 19539.848583, 19778.217887, 19977.939176, 20137.018678, 20254.734748, 20328.875760, 20358.523606, 20342.231101, & + 20278.589963, 20166.744330, 20004.982477, 19792.792832, 19528.424768, 19211.380327, 18840.138412, 18414.132983, & + 17933.325139, 17400.426408, 16819.657745, 16195.578563, 15532.946677, 14837.558610, 14115.393726, 13372.886551, & + 12616.479397, 11852.696266, 11087.800514, 10327.790957, 9578.207359, 8844.157660, 8129.832058, 7440.098773, & + 6777.003948, 6143.217998, 5541.186971, 4972.725810, 4438.905073, 3940.077056, 3475.984433, 3045.886238, & + 2648.697264, 2283.946319, 1951.862407, 1652.526827, 1385.902714, 1151.874101, 950.288155, 780.991556, & + 643.875906, 538.919476, 466.225293, 426.071190, 0.000000 / + + data b132 / & + 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, & + 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, & + 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, & + 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, & + 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, & + 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, & + 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000007, & + 0.000024, 0.000059, 0.000112, 0.000198, 0.000339, 0.000560, 0.000886, 0.001347, & + 0.001984, 0.002845, 0.003955, 0.005356, 0.007104, 0.009223, 0.011758, 0.014755, & + 0.018243, 0.022264, 0.026854, 0.032044, 0.037871, 0.044366, 0.051561, 0.059484, & + 0.068168, 0.077639, 0.087925, 0.099055, 0.111049, 0.123939, 0.137748, 0.152499, & + 0.168220, 0.184930, 0.202659, 0.221424, 0.241254, 0.262166, 0.284188, 0.307337, & + 0.331578, 0.356790, 0.382792, 0.409444, 0.436599, 0.464098, 0.491782, 0.519487, & + 0.547056, 0.574335, 0.601181, 0.627461, 0.653056, 0.677861, 0.701765, 0.724759, & + 0.746767, 0.767710, 0.787535, 0.806224, 0.823790, 0.840276, 0.855742, 0.870260, & + 0.883905, 0.896733, 0.908781, 0.920085, 0.930681, 0.940600, 0.949868, 0.958500, & + 0.966498, 0.973850, 0.980526, 0.986474, 1.000000 / + + + open(10, file="eta.rc", action="write", FORM="FORMATTED") + + write(10,'(A)') "# The data for each label: ak(k) bk(k)" + write(10,'(A)') "# the last row of the label ks for pint" + write(10,'(A)') "NUM_LEVELS: 72" + write(10,'(A)') "USE_SIGMA_LEVELS: .false." + write(10,'(A)') "USE_NCEP_LEVELS: .false" + +! Fake single-level for util codes + write(10,'(A)') "levels_1:" + km = 1 + ks = 1 + do k=1,km+1 + write(10,*) a01(k),b01(k) + enddo + write(10,*) ks + +! *** Original CCM3 18-Level setup *** + ! case (18) + write(10,'(A)') "levels_18:" + km=18 + ks = 4 + do k=1,km+1 + write(10,*) a18(k), b18(k) + enddo + write(10,*) ks + + !case (26) +! CCM4 26-Level setup *** + write(10,'(A)') "levels_26:" + km=26 + ks = 7 + do k=1,km+1 + write(10,*) a26(k), b26(k) + enddo + write(10,*) ks + + !case (30) +! CCM4 30-Level setup *** + write(10,'(A)') "levels_30:" + km=30 + ks = 12 + do k=1,km+1 + write(10,*) a30(k), b30(k) + enddo + write(10,*) ks + +! *** Revised 32-L setup with ptop at 0.4 mb *** +! SJL: 04/01/2002 + write(10,'(A)') "levels_32:" + km=32 + ks = 21 + do k=1,km+1 + write(10,*) a32(k), b32(k) + enddo + write(10,*) ks + + write(10,'(A)') "levels_48:" + km=48 + ks = 30 + do k=1,km+1 + write(10,*) a48(k), b48(k) + enddo + write(10,*) ks + +! *** Revised 55-L setup with ptop at 0.01 mb *** + !case (55) + write(10,'(A)') "levels_55:" + km=55 + ks = 41 + do k=1,km+1 + write(10,*) a55(k), b55(k) + enddo + write(10,*) ks + + write(10,'(A)') "sigma_levels_64:" + km=64 + ks = 0 + do k=1,km+1 + write(10, *) a64_sig(k), b64_sig(k) + enddo + write(10,*) ks + !else + + write(10,'(A)') "levels_64:" + km=64 + ks = 21 + do k=1,km+1 + write(10,*) a64(k), b64(k) + enddo + write(10,*) ks + + write(10,'(A)') "levels_44:" + km=44 + ks = 16 + do k=1,km+1 + write(10,*) a44(k), b44(k) + enddo + write(10,*) ks + + write(10,'(A)') "ncep_levels_72:" + km=72 + ks = 29 + do k=1,km+1 + write(10,*) a72_ncep(k), b72_ncep(k) + enddo + write(10,*) ks + + write(10,'(A)') "levels_72:" + ks = 40 + do k=1,km+1 + write(10,*) a72(k), b72(k) + enddo + write(10,*) ks + + write(10,'(A)') "BETA3P1_levels_72:" + ks = 40 + do k=1,km+1 + write(10,*) a72_BETA3P1(k), b72_BETA3P1(k) + enddo + write(10,*) ks + + + write(10,'(A)') "levels_91:" + km=91 + ks = 33 + do k=1,km+1 + write(10,*) a91(k), b91(k) + end do + write(10,*) ks + + write(10,'(A)') "levels_96:" + km =96 + ks = 77 + do k=1,km+1 + write(10,*) a96(k), b96(k) + enddo + write(10,*) ks + + write(10,'(A)') "levels_137:" + km= 137 + ks = 54 + do k=1,km+1 + write(10,*) a137(k), b137(k) + enddo + write(10,*) ks + + write(10,'(A)') "levels_144:" + km=144 + ks = 56 + do k=1,km+1 + write(10,*) a144(k), b144(k) + enddo + write(10,*) ks + + write(10,'(A)') "levels_132:" + km= 132 + ks = 54 + do k=1,km+1 + write(10,*) a132(k), b132(k) + enddo + write(10,*) ks + + close(10) + + print*, i_to_string(1),i_to_string (100) + +contains + + function i_to_string(count, rc) result(str) + character(len=:), allocatable :: str + integer, intent(in) :: count + integer, optional, intent(out) :: rc + character(len=9) :: buffer + write(buffer,'(i0)') count + str = trim(buffer) + + end function i_to_string +end program From 90ecb678a4f75dfe82022613e8bd511572ecff72 Mon Sep 17 00:00:00 2001 From: Peter Norris Date: Fri, 10 Jan 2020 12:53:33 -0500 Subject: [PATCH 038/109] pmn: first crack at precession using alternative ORB2B system --- MAPL_Base/MAPL_Generic.F90 | 138 ++++++++- MAPL_Base/MAPL_sun_uc.F90 | 588 +++++++++++++++++++++++++------------ MAPL_Base/sun.H | 166 +++++++---- 3 files changed, 658 insertions(+), 234 deletions(-) diff --git a/MAPL_Base/MAPL_Generic.F90 b/MAPL_Base/MAPL_Generic.F90 index 52a394c75c6f..28c3c78a1923 100644 --- a/MAPL_Base/MAPL_Generic.F90 +++ b/MAPL_Base/MAPL_Generic.F90 @@ -1957,7 +1957,7 @@ recursive subroutine MAPL_GenericFinalize ( GC, IMPORT, EXPORT, CLOCK, RC ) character(len=ESMF_MAXSTR) :: CHILD_NAME character(len=ESMF_MAXSTR) :: RECFIN type (MAPL_MetaComp), pointer :: STATE - integer :: I + integer :: I,j logical :: final_checkpoint integer :: NC integer :: PHASE @@ -2867,6 +2867,7 @@ subroutine MAPL_InternalStateRetrieve(GC, MAPLOBJ, RC) ! ErrLog Variables + character(len=ESMF_MAXSTR) :: IAm="MAPL_InternalStateRetrieve" integer :: STATUS ! Local variables @@ -3527,9 +3528,11 @@ subroutine MAPL_GridCompSetEntryPoint(GC, registeredMethod, usersRoutine, RC) !EOPI integer :: status + character(len=ESMF_MAXSTR) :: IAm type (MAPL_MetaComp), pointer :: META integer :: phase + integer :: phase0, phase1 call MAPL_InternalStateRetrieve( GC, META, RC=STATUS) _VERIFY(STATUS) @@ -3740,6 +3743,14 @@ subroutine MAPL_GenericStateGet (STATE, IM, JM, LM, VERTDIM, & logical :: FIX_SUN character(len=ESMF_MAXSTR) :: gname + logical :: EOT, ORBIT_ANAL2B + integer :: ORB2B_REF_YYYYMMDD, ORB2B_REF_HHMMSS, & + ORB2B_EQUINOX_YYYYMMDD, ORB2B_EQUINOX_HHMMSS + real :: ORB2B_YEARLEN, & + ORB2B_ECC_REF, ORB2B_ECC_RATE, & + ORB2B_OBQ_REF, ORB2B_OBQ_RATE, & + ORB2B_LAMBDAP_REF, ORB2B_LAMBDAP_RATE + if(present(IM)) then IM=STATE%GRID%IM endif @@ -3792,23 +3803,116 @@ subroutine MAPL_GenericStateGet (STATE, IM, JM, LM, VERTDIM, & FIX_SUN=.false. end if + ! Fixed parameters of standard orbital system (tabularized intercalation cycle) + ! ----------------------------------------------------------------------------- + call MAPL_GetResource(STATE, ECC, Label="ECCENTRICITY:", default=0.0167, & RC=STATUS) _VERIFY(STATUS) - call MAPL_GetResource(STATE, OB, Label="OBLIQUITY:" , default=23.45 , & + call MAPL_GetResource(STATE, OB, Label="OBLIQUITY:", default=23.45, & + RC=STATUS) + _VERIFY(STATUS) + + call MAPL_GetResource(STATE, PER, Label="PERIHELION:", default=102.0, & + RC=STATUS) + _VERIFY(STATUS) + + call MAPL_GetResource(STATE, EQNX, Label="EQUINOX:", default=80, & + RC=STATUS) + _VERIFY(STATUS) + + ! Apply Equation of Time correction by default? + ! (Can be overridden in MAPL_SunGetInsolation call) + ! ------------------------------------------------- + call MAPL_GetResource(STATE, EOT, Label="EOT:", default=.FALSE., & + RC=STATUS) + _VERIFY(STATUS) + + ! New orbital system (analytic two-body) allows some time-varying behavior, + ! namely, linear variation in LAMBDAP, ECC, and OBQ. + ! ------------------------------------------------------------------------- + + call MAPL_GetResource(STATE, & + ORB_ANAL2B, Label="ORBIT_ANAL2B:", default=.FALSE., & + RC=STATUS) + _VERIFY(STATUS) + + ! Fixed anomalistic year length in mean solar days + call MAPL_GetResource(STATE, & + ORB2B_YEARLEN, Label="ORB2B_YEARLEN:", default=365.2596, & + RC=STATUS) + _VERIFY(STATUS) + + ! Reference date and time for orbital parameters + ! (defaults to J2000 = 01Jan2000 12:00:00 TT = 11:58:56 UTC) + call MAPL_GetResource(STATE, & + ORB2B_REF_YYYYMMDD, Label="ORB2B_REF_YYYYMMDD:", default=20000101, & + RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetResource(STATE, & + ORB2B_REF_HHMMSS, Label="ORB2B_REF_HHMMSS:", default=115856, & + RC=STATUS) + _VERIFY(STATUS) + + ! Orbital eccentricity at reference date + call MAPL_GetResource(STATE, & + ORB2B_ECC_REF, Label="ORB2B_ECC_REF:", default=0.016710, & + RC=STATUS) + _VERIFY(STATUS) + + ! Rate of change of orbital eccentricity per Julian century + call MAPL_GetResource(STATE, & + ORB2B_ECC_RATE, Label="ORB2B_ECC_RATE:", default=-4.2e-5, & + RC=STATUS) + _VERIFY(STATUS) + + ! Earth's obliquity (axial tilt) at reference date [degrees] + call MAPL_GetResource(STATE, & + ORB2B_OBQ_REF, Label="ORB2B_OBQ_REF:", default=23.44, & RC=STATUS) _VERIFY(STATUS) - call MAPL_GetResource(STATE, PER, Label="PERIHELION:" , default=102.0 , & + ! Rate of change of obliquity [degrees per Julian century] + call MAPL_GetResource(STATE, & + ORB2B_OBQ_RATE, Label="ORB2B_OBQ_RATE:", default=-1.3e-2, & RC=STATUS) _VERIFY(STATUS) - call MAPL_GetResource(STATE, EQNX, Label="EQUINOX:" , default=80 , & + ! Longitude of perihelion at reference date [degrees] + ! (from March equinox to perihelion in direction of earth's motion) + call MAPL_GetResource(STATE, & + ORB2B_LAMBDAP_REF, Label="ORB2B_LAMBDAP_REF:", default=282.947, & RC=STATUS) _VERIFY(STATUS) - STATE%ORBIT = MAPL_SunOrbitCreate(STATE%CLOCK,ECC,OB,PER,EQNX,FIX_SUN=FIX_SUN,RC=STATUS) + ! Rate of change of LAMBDAP [degrees per Julian century] + ! (Combines both equatorial and ecliptic precession) + call MAPL_GetResource(STATE, & + ORB2B_LAMBDAP_RATE, Label="ORB2B_LAMBDAP_RATE:", default=1.7195, & + RC=STATUS) + _VERIFY(STATUS) + + ! March Equinox date and time + ! (defaults to March 20, 2000 at 07:35:00 UTC) + call MAPL_GetResource(STATE, & + ORB2B_EQUINOX_YYYYMMDD, Label="ORB2B_EQUINOX_YYYYMMDD:", default=20000320, & + RC=STATUS) + _VERIFY(STATUS) + call MAPL_GetResource(STATE, & + ORB2B_EQUINOX_HHMMSS, Label="ORB2B_EQUINOX_HHMMSS:", default=073500, & + RC=STATUS) + _VERIFY(STATUS) + + ! create the orbit object + STATE%ORBIT = MAPL_SunOrbitCreate(STATE%CLOCK, ECC, OB, PER, EQNX, & + EOT, ORBIT_ANAL2B, ORB2B_YEARLEN, & + ORB2B_REF_YYYYMMDD, ORB2B_REF_HHMMSS, & + ORB2B_ECC_REF, ORB2B_ECC_RATE, & + ORB2B_OBQ_REF, ORB2B_OBQ_RATE, & + ORB2B_LAMBDAP_REF, ORB2B_LAMBDAP_RATE, & + ORB2B_EQUINOX_YYYYMMDD, ORB2B_EQUINOX_HHMMSS, & + FIX_SUN=FIX_SUN,RC=STATUS) _VERIFY(STATUS) end if @@ -4189,6 +4293,7 @@ recursive integer function MAPL_AddChildFromMeta(META, NAME, GRID, & integer, optional , intent( OUT) :: rc !EOPI + character(len=ESMF_MAXSTR) :: IAm='MAPL_AddChildFromMeta' integer :: STATUS integer :: I @@ -6087,6 +6192,8 @@ subroutine MAPL_StateGetVarSpecs(STATE,IMPORT,EXPORT,INTERNAL,RC) ! ! ErrLog Variables + character(len=ESMF_MAXSTR) :: IAm='MAPL_StateGetVarSpec' + ! Begin ! Get the specs for the 3 ESMF states @@ -6889,6 +6996,7 @@ subroutine MAPL_FriendlyGet ( GC, NAME, FIELD, REQUESTOR, RC ) ! ! ErrLog Variables + character(len=ESMF_MAXSTR) :: IAm='MAPL_FriendlyGet' integer :: STATUS ! Local variables @@ -7004,6 +7112,7 @@ subroutine MAPL_GridCompGetFriendlies0 ( GC, TO, BUNDLE, AddGCPrefix, RC ) ! ! ErrLog Variables + character(len=ESMF_MAXSTR) :: IAm='MAPL_GridCompGetFriendlies0' integer :: STATUS ! Local variables @@ -7280,6 +7389,7 @@ subroutine MAPL_GridCompGetFriendlies2 ( GC, TO, BUNDLE, AddGCPrefix, RC ) ! ! ErrLog Variables + character(len=ESMF_MAXSTR) :: IAm='MAPL_GridCompGetFriendlies2' integer :: STATUS, I character(len=ESMF_MAXSTR) :: TO_(1) @@ -7306,6 +7416,7 @@ subroutine MAPL_GridCompGetFriendlies3 ( GC, TO, BUNDLE, AddGCPrefix, RC ) ! ! ErrLog Variables + character(len=ESMF_MAXSTR) :: IAm='MAPL_GridCompGetFriendlies3' integer :: STATUS, I do I=1,size(GC) @@ -7326,6 +7437,7 @@ subroutine MAPL_SetVarSpecForCC(gcA, gcB, ccAxB, rc) integer, optional, intent( out) :: RC ! Error code: ! Local vars + character(len=ESMF_MAXSTR) :: Iam="MAPL_SetVarSpecForCC" character(len=ESMF_MAXSTR) :: NAME integer :: STATUS integer :: I, N, STAT @@ -8369,6 +8481,7 @@ subroutine MAPL_ReadForcing1(STATE,NAME,DATAFILE,CURRENTTIME, & integer, optional, intent( OUT) :: RC !EOPI + character(len=ESMF_MAXSTR) :: IAm = "MAPL_ReadForcing1" integer :: STATUS call MAPL_ReadForcingX(STATE,NAME,DATAFILE,CURRENTTIME, & @@ -8398,6 +8511,7 @@ subroutine MAPL_ReadForcing2(STATE,NAME,DATAFILE,CURRENTTIME, & integer, optional, intent( OUT) :: RC !EOPI + character(len=ESMF_MAXSTR) :: IAm = "MAPL_ReadForcing2" integer :: STATUS call MAPL_ReadForcingX(STATE,NAME,DATAFILE,CURRENTTIME, & @@ -8425,6 +8539,7 @@ subroutine MAPL_ReadForcingX(MPL,NAME,DATAFILE,CURRTIME, & ! ErrLog Variables + character(len=ESMF_MAXSTR) :: IAm = "MAPL_ReadForcing" integer :: STATUS ! Locals @@ -9162,6 +9277,7 @@ subroutine MAPL_StateGetTimeStamp(STATE,NAME,TIME,RC) ! ErrLog Variables + character(len=ESMF_MAXSTR) :: IAm = "MAPL_StateGetTimeStamp" integer :: STATUS ! Locals @@ -9201,6 +9317,7 @@ subroutine MAPL_StateSetTimeStamp(STATE,NAME,TIME,RC) ! ErrLog Variables + character(len=ESMF_MAXSTR) :: IAm = "MAPL_StateSetTimeStamp" integer :: STATUS ! Locals @@ -9230,6 +9347,7 @@ subroutine MAPL_GenericMakeXchgNatural(STATE, RC) ! ErrLog Variables + character(len=ESMF_MAXSTR) :: IAm = "MAPL_GenericMakeXchgNatural" STATE%LOCSTREAM = STATE%ExchangeGrid @@ -9255,6 +9373,7 @@ subroutine MAPL_GridCreate(GC, MAPLOBJ, ESMFGRID, srcGC, rc) integer :: nn,ny character(len=ESMF_MAXSTR) :: GridName character(len=2) :: dateline + real(ESMF_KIND_R8), pointer :: R8D2(:,:) #ifdef CREATE_REGULAR_GRIDS logical :: isRegular #endif @@ -9370,6 +9489,7 @@ subroutine MAPL_GridCoordAdjustFromFile(GRID, GRIDSPECFILE, RC) ! local vars !------------ + character(len=ESMF_MAXSTR) :: IAm='MAPL_GridCoordAdjustFromFile' integer :: STATUS integer :: UNIT integer :: IM, JM @@ -9452,6 +9572,7 @@ recursive subroutine MAPL_GetRootGC(GC, rootGC, RC) integer, optional, intent(OUT) :: rc integer :: status + character(len=ESMF_MAXSTR) :: IAm type (MAPL_MetaComp), pointer :: META call MAPL_GetObjectFromGC(GC, META, RC=STATUS) @@ -9631,6 +9752,7 @@ function MAPL_GridGetSection(Grid, SectionMap, GridName, RC) result(SECTION) character(len=ESMF_MAXSTR) :: name integer :: status + character(len=ESMF_MAXSTR) :: Iam="MAPL_GridGetSection" call ESMF_GridGet(GRID, Name=Name, DistGrid=distgrid, dimCount=dimCount, RC=STATUS) _VERIFY(STATUS) @@ -9730,6 +9852,7 @@ subroutine MAPL_InternalGridSet(MYGRID, GRID, RC) type(ESMF_VM) :: vm integer :: status + character(len=ESMF_MAXSTR) :: Iam="MAPL_InternalGridSet" ! At this point, this component must have a valid grid! !------------------------------------------------------ @@ -9865,6 +9988,7 @@ recursive subroutine MAPL_GetAllExchangeGrids ( GC, LSADDR, RC ) integer :: status + character(len=ESMF_MAXSTR) :: Iam="MAPL_GetAllExchangeGrids" type (MAPL_MetaComp), pointer :: MAPLOBJ type (MAPL_LocStream) :: LocStream @@ -9934,6 +10058,7 @@ subroutine MAPL_DoNotAllocateImport(GC, NAME, notFoundOK, RC) integer, optional, intent( OUT) :: RC ! Return code integer :: status + character(len=ESMF_MAXSTR) :: Iam="MAPL_DoNotAllocateImport" type (MAPL_MetaComp), pointer :: MAPLOBJ type (MAPL_VarSpec), pointer :: SPEC(:) => null() @@ -9959,6 +10084,7 @@ subroutine MAPL_DoNotAllocateInternal(GC, NAME, notFoundOK, RC) integer, intent( OUT) :: RC ! Return code integer :: status + character(len=ESMF_MAXSTR) :: Iam="MAPL_DoNotAllocateInternal" type (MAPL_MetaComp), pointer :: MAPLOBJ type (MAPL_VarSpec), pointer :: SPEC(:) @@ -9982,6 +10108,7 @@ subroutine MAPL_DoNotAllocateVar(SPEC, NAME, notFoundOK, RC) integer, optional, intent( OUT) :: RC ! Return code integer :: status + character(len=ESMF_MAXSTR) :: Iam="MAPL_DoNotAllocateVar" integer :: I logical :: notFoundOK_ @@ -10020,6 +10147,7 @@ subroutine ArrDescrSetNCPar(ArrDes, MPL, tile, offset, num_readers, num_writers, logical :: tile_loc type(ESMF_Grid) :: TILEGRID character(len=MPI_MAX_INFO_VAL) :: romio_cb_read,cb_buffer_size,romio_cb_write + character(len=ESMF_MAXSTR) :: Iam="ArrDescrSetNCPar" if (present(tile)) then tile_loc=tile diff --git a/MAPL_Base/MAPL_sun_uc.F90 b/MAPL_Base/MAPL_sun_uc.F90 index 18b515f7d55d..ae5fb1586603 100644 --- a/MAPL_Base/MAPL_sun_uc.F90 +++ b/MAPL_Base/MAPL_sun_uc.F90 @@ -68,19 +68,109 @@ module MAPL_SunMod type MAPL_SunOrbit private + logical :: CREATED = .FALSE. type(ESMF_Clock) :: CLOCK - real :: OB, ECC, PER, YEARLEN + real :: OB, ECC, PER, YEARLEN, EQNX_FRAC, integer :: EQNX, YEARS_PER_CYCLE, DAYS_PER_CYCLE real, pointer, dimension(:) :: ZC => null() real, pointer, dimension(:) :: ZS => null() real, pointer, dimension(:) :: PP => null() real, pointer, dimension(:) :: TH => null() real, pointer, dimension(:) :: ET => null() + logical :: apply_EOT logical :: FIX_SUN + logical :: ANAL2B + real :: ORB2B_YEARLEN + type(ESMF_Time) :: ORB2B_TIME_REF + real :: ORB2B_ECC_REF + real :: ORB2B_ECC_RATE + real :: ORB2B_OBQ_REF + real :: ORB2B_OBQ_RATE + real :: ORB2B_LAMBDAP_REF + real :: ORB2B_LAMBDAP_RATE + type(ESMF_Time) :: ORB2B_TIME_EQUINOX + real :: ORB2B_OMG0 + type(ESMF_Time) :: ORB2B_TIME_PERI end type MAPL_SunOrbit contains +!========================================================================== + ! utlity functions + + ! rectify to [-pi,+pi) + function RECT_PMPI(X) + real :: X, RECT_PMPI + RECT_PMPI = MODULO( X + MAPL_PI, 2*MAPL_PI ) - MAPL_PI + end function + + ! true anomaly from eccentric anomaly + function calcTAfromEA(EA,EAFAC) result(TA) + real :: EA, EAFAC, TA + TA = 2. * atan( tan(EA / 2.) / EAFAC) + end function + + ! eccentric anomaly from true anomaly + function calcEAfromTA(TA,EAFAC) result(EA) + real :: TA, EAFAC, EA + EA = 2. * atan( EAFAC * tan(TA / 2.)) + end function + + ! mean anomaly from eccentric anomaly (Kepler's equation) + function calcMAfromEA(EA,ECC) result(MA) + real :: EA, ECC, MA + MA = EA - ECC * sin(EA) + end function + + ! eccentric anomaly from mean anomaly + ! (invert Kepler's equation by Newton-Raphson) + subroutine invert_Keplers_Newton( & + MA, ECC, & + EA, dE, nits, & + tol, max_its) + + real, intent(in ) :: MA + real, intent(in ) :: ECC + + real, intent(out) :: EA + real, intent(out) :: dE + integer, intent(out) :: nits + + real, optional, intent(in ) :: tol + integer, optional, intent(in ) :: max_its + + real :: f, df, tol_ + integer :: max_its_ + + if (present(tol)) then + tol_ = tol + else + tol_ = 1.e-10 + endif + + if (present(max_its)) then + max_its_ = max_its + else + max_its_ = 10 + endif + + EA = MA + do nits = 1, max_its_ + f = EA - ECC * sin(EA) - MA + df = 1. - ECC * cos(EA) + dE = -f / df + EA = EA + dE + if (abs(dE) < tol_) exit + enddo + + end subroutine + + ! Earth-Sun distance from true anomaly + function calcRadfromTA(TA,ECC,OMSQECC) result(Rad) + real :: TA, ECC, OMSQECC, Rad + Rad = OMSQECC / (1. + ECC * cos(TA)) + end function + !========================================================================== !BOPI @@ -124,20 +214,95 @@ module MAPL_SunMod !% \item[] !\makebox[2in][l]{\bf \em EQUINOX} ! \parbox[t]{4in}{Day of year of vernal equinox. -! Equinox is assumed to occur at 0Z on this day -! on the first year of the cycle.} +! Equinox is assumed to occur at 0Z on this day on the +! first year of the cycle.} +!% \item[] +!\makebox[2in][l]{\bf \em EOT} +! \parbox[t]{4in}{Apply Equation of Time correction by default? +! The correction is always available, but only applied if requested +! by this flag. An explicit EOT argument in MAPL_SunGetInsolation() +! will override the default behavior.} +! +!% \item[] +!\makebox[2in][l]{\bf \em ORBIT\_ANAL2B} +! \parbox[t]{4in}{New orbital system (analytic two-body) allows some +! time-varying behavior, namely, linear time variation in LAMBDAP, +! ECC, and OBQ. If .TRUE., the following ORB2B parameters are used +! and only CLOCK and EOT above are used, i.e., the ECCENTRICITY, +! OBLIQUITY, PERIHELION and EQUINOX above are NOT used and are +! replaced by the relevant ORB2B parameters below.} +! +!% \item[] +!\makebox[2in][l]{\bf \em ORB2B\_YEARLEN} +! \parbox[t]{4in}{Fixed anomalistic year length in mean solar days.} +! +!% \item[] +!\makebox[2in][l]{\bf \em ORB2B\_REF\_YYYYMMDD} +! \parbox[t]{4in}{Reference date for orbital parameters.} +! +!% \item[] +!\makebox[2in][l]{\bf \em ORB2B\_REF\_HHMMSS} +! \parbox[t]{4in}{Reference time for orbital parameters.} +! +!% \item[] +!\makebox[2in][l]{\bf \em ORB2B\_ECC\_REF} +! \parbox[t]{4in}{Orbital eccentricity at reference date.} +! +!% \item[] +!\makebox[2in][l]{\bf \em ORB2B\_ECC\_RATE} +! \parbox[t]{4in}{Rate of change of orbital eccentricity per Julian century.} +! +!% \item[] +!\makebox[2in][l]{\bf \em ORB2B\_OBQ\_REF} +! \parbox[t]{4in}{Earth's obliquity (axial tilt) at reference date [degrees].} +! +!% \item[] +!\makebox[2in][l]{\bf \em ORB2B\_OBQ\_RATE} +! \parbox[t]{4in}{Rate of change of obliquity [degrees per Julian century].} +! +!% \item[] +!\makebox[2in][l]{\bf \em ORB2B\_LAMBDAP\_REF} +! \parbox[t]{4in}{Longitude of perihelion at reference date [degrees] +! (from March equinox to perihelion in direction of earth's motion).} +! +!% \item[] +!\makebox[2in][l]{\bf \em ORB2B\_LAMBDAP\_RATE} +! \parbox[t]{4in}{Rate of change of LAMBDAP [degrees per Julian century] +! (Combines both equatorial and ecliptic precession).} +! +!% \item[] +!\makebox[2in][l]{\bf \em ORB2B\_EQUINOX\_YYYYMMDD} +! \parbox[t]{4in}{March equinox date.} +! +!% \item[] +!\makebox[2in][l]{\bf \em ORB2B\_EQUINOX\_HHMMSS} +! \parbox[t]{4in}{March equinox time.} +! !% \end{itemize} ! ! !INTERFACE: -type(MAPL_SunOrbit) function MAPL_SunOrbitCreate(CLOCK, & - ECCENTRICITY, & - OBLIQUITY, & - PERIHELION, & - EQUINOX, & - FIX_SUN, & - RC ) +type(MAPL_SunOrbit) function MAPL_SunOrbitCreate(CLOCK, & + ECCENTRICITY, & + OBLIQUITY, & + PERIHELION, & + EQUINOX, & + EOT, & + ORBIT_ANAL2B, & + ORB2B_YEARLEN, & + ORB2B_REF_YYYYMMDD, & + ORB2B_REF_HHMMSS, & + ORB2B_ECC_REF, & + ORB2B_ECC_RATE, & + ORB2B_OBQ_REF, & + ORB2B_OBQ_RATE, & + ORB2B_LAMBDAP_REF, & + ORB2B_LAMBDAP_RATE, & + ORB2B_EQUINOX_YYYYMMDD, & + ORB2B_EQUINOX_HHMMSS, & + FIX_SUN, & + RC ) ! !ARGUMENTS: @@ -146,133 +311,24 @@ type(MAPL_SunOrbit) function MAPL_SunOrbitCreate(CLOCK, & real , intent(IN ) :: OBLIQUITY real , intent(IN ) :: PERIHELION integer , intent(IN ) :: EQUINOX + logical , intent(IN ) :: EOT + logical , intent(IN ) :: ORBIT_ANAL2B + real , intent(IN ) :: ORB2B_YEARLEN + integer , intent(IN ) :: ORB2B_REF_YYYYMMDD + integer , intent(IN ) :: ORB2B_REF_HHMMSS + real , intent(IN ) :: ORB2B_ECC_REF + real , intent(IN ) :: ORB2B_ECC_RATE + real , intent(IN ) :: ORB2B_OBQ_REF + real , intent(IN ) :: ORB2B_OBQ_RATE + real , intent(IN ) :: ORB2B_LAMBDAP_REF + real , intent(IN ) :: ORB2B_LAMBDAP_RATE + integer , intent(IN ) :: ORB2B_EQUINOX_YYYYMMDD + integer , intent(IN ) :: ORB2B_EQUINOX_HHMMSS logical, optional , intent(IN ) :: FIX_SUN integer, optional , intent(OUT) :: RC !EOPI -! Locals - - character(len=ESMF_MAXSTR), parameter :: IAm = "SunOrbitCreate" - - real*8 :: YEARLEN - integer :: K, KP, YEARS_PER_CYCLE, DAYS_PER_CYCLE - real*8 :: TREL, T1, T2, T3, T4, dTRELdDAY - real*8 :: SOB, COB, OMG0, OMG, PRH, PRHV - real :: D2R, OMECC, OPECC, OMSQECC, EAFAC - real*8 :: X, TA, EA, MA, TRRA, MNRA - real :: rect_pmpi, meanEOT - type(MAPL_SunOrbit) :: ORBIT - integer :: STATUS - -! STATEMENT FUNC: dTREL/dDAY(TREL), -! where TREL is ecliptic longitude of true Sun - - dTRELdDAY(TREL) = OMG*(1.0-ECCENTRICITY*cos(TREL-PRH))**2 - -! STATEMENT FUNC: rectify to real [-pi,+pi) - rect_pmpi(X) = MODULO( REAL(X) + MAPL_PI, 2*MAPL_PI ) - MAPL_PI - -! TEMP pmn -! @ Toms's equinox is: 80 + 7.5/24 -! but this method requires an integer so we'll use 80. -! Actually in THIS code, EQUINOX is only used to set the KP -! at which the TREL is zero. So although its 80 here, outside -! this code, namely in SunGetInsolation where we interpolate -! between days, we should regard the daily value as at 7h30m -! AM. But thats an external issue and wont affect this code. -! But when doing diagnostic tests, we must regard index 80 as -! being 80d7h30m = Mar 20, 7:30 AM UTC (2000 IS a leap year). -! @ Similarly, it is assumed EXTERNALLY that the first three -! years of the cycle are non-leap, and the last leap. This -! won't affect this code. -! TODO: add real EQUINOX_FRAC, fractional day past 0Z, -! defaulting to zero in the resource read. Above case -! would be EQUINOX_FRAC = 0.3125 -! end TEMP pmn - -!MJS: This needs to come from the calendar when the time manager works right. - - YEARLEN = 365.25 - - ! Factors involving the orbital parameters - !----------------------------------------- - OMECC = 1. - ECCENTRICITY - OPECC = 1. + ECCENTRICITY - OMSQECC = 1. - ECCENTRICITY**2 ! pmn: consider changing to line below when zero-diff not issue -! OMSQECC = OMECC * OPECC - EAFAC = sqrt(OMECC/OPECC) - - D2R = MAPL_PI/180. - OMG0 = 2.*MAPL_PI/YEARLEN - OMG = OMG0/sqrt(OMSQECC)**3 - PRH = PERIHELION*D2R - SOB = sin(OBLIQUITY*D2R) - COB = cos(OBLIQUITY*D2R) - - ! PRH is the ecliptic longitude of the perihelion, measured (at the Sun) - ! from the autumnal equinox in the direction of the Earth`s orbital motion - ! (counterclockwise as viewed from ecliptic north pole). - ! For EOT calculations we will reference the perihelion wrt to the vernal - ! equinox, PRHV. Of course, the difference is just PI. - ! pmn: once the EOT code is established and zero-diff not an issue, - ! consider removing original PRH and changing the original (non-EOT), - ! code, which employs - ! cos(Y \pm PI) = -COS(Y) - ! to use PRHV, namely - ! -cos(Y-PRH) = cos(Y-PRH-PI) = cos(Y-PRHV) - PRHV = PRH + MAPL_PI_R8 - - ! Compute length of leap cycle - ! ---------------------------- - if(YEARLEN-int(YEARLEN) > 0.) then - YEARS_PER_CYCLE = nint(1./(YEARLEN-int(YEARLEN))) - else - YEARS_PER_CYCLE = 1 - endif - - DAYS_PER_CYCLE=nint(YEARLEN*YEARS_PER_CYCLE) - - ! save inputs and intercalculation details - ! ---------------------------------------- - ORBIT%CLOCK = CLOCK - ORBIT%OB = OBLIQUITY - ORBIT%ECC = ECCENTRICITY - ORBIT%PER = PERIHELION - ORBIT%EQNX = EQUINOX - ORBIT%YEARLEN = YEARLEN - ORBIT%YEARS_PER_CYCLE = YEARS_PER_CYCLE - ORBIT%DAYS_PER_CYCLE = DAYS_PER_CYCLE - - ! Allocate orbital cycle outputs - ! ------------------------------ - ! TH: Ecliptic longitude of the true Sun, TREL [radians] - ! ZS: Sine of declination - ! ZC: Cosine of declination - ! PP: Inverse of square of earth-sun distance [1/(AU**2)] - ! ET: Equation of time [radians] = - ! True solar hour angle - Mean solar hour angle - - if(associated(ORBIT%TH)) deallocate(ORBIT%TH) - allocate(ORBIT%TH(DAYS_PER_CYCLE), stat=status) - _VERIFY(STATUS) - - if(associated(ORBIT%ZC)) deallocate(ORBIT%ZC) - allocate(ORBIT%ZC(DAYS_PER_CYCLE), stat=status) - _VERIFY(STATUS) - - if(associated(ORBIT%ZS)) deallocate(ORBIT%ZS) - allocate(ORBIT%ZS(DAYS_PER_CYCLE), stat=status) - _VERIFY(STATUS) - - if(associated(ORBIT%PP)) deallocate(ORBIT%PP) - allocate(ORBIT%PP(DAYS_PER_CYCLE), stat=status) - _VERIFY(STATUS) - - if(associated(ORBIT%ET)) deallocate(ORBIT%ET) - allocate(ORBIT%ET(DAYS_PER_CYCLE), stat=status) - VERIFY_(STATUS) - ! ======================================= ! PMN Dec 2019: Notes on Equation of Time ! ======================================= @@ -457,55 +513,223 @@ type(MAPL_SunOrbit) function MAPL_SunOrbitCreate(CLOCK, & ! where PRHV is the name for lamba_P in the code. ! =========================================================================== - ! Begin integration at the vernal equinox (K=1, KP=EQUINOX), at - ! which, by defn, the ecliptic longitude of the true sun is zero. - ! Right ascension at true sun at EQUINOX is also zero by defn. - ! -------------------------------------------------------------- - KP = EQUINOX - TREL = 0. - ORBIT%ZS(KP) = sin(TREL)*SOB - ORBIT%ZC(KP) = sqrt(1.-ORBIT%ZS(KP)**2) - ORBIT%PP(KP) = ( (1.-ECCENTRICITY*cos(TREL-PRH)) / OMSQECC )**2 - ORBIT%TH(KP) = TREL - TRRA = 0. - - ! Right ascension of "mean sun" = MA(u) + PRHV [eqn (6) above]. - ! Calcn of True (TA), Eccentric (EA), and Mean Anomaly (MA). - TA = TREL - PRHV ! by defn of TA and PRHV - EA = 2.d0*atan(EAFAC*tan(TA/2.d0)) ! BM 4-55 - MA = EA - ECCENTRICITY*sin(EA) ! Kepler's eqn (BM 4-49 ff.) - MNRA = MA + PRHV - - ! Equation of Time, ET [radians] - ! True Solar hour angle = Mean Solar hour angle + ET - ! (hour angle and right ascension are in reverse direction) - ORBIT%ET(KP) = rect_pmpi(MNRA - TRRA) - -! Integrate orbit for entire leap cycle using Runge-Kutta -! Mean sun moves at constant speed around Celestial Equator - - do K=2,DAYS_PER_CYCLE - T1 = dTRELdDAY(TREL ) - T2 = dTRELdDAY(TREL+T1*0.5) - T3 = dTRELdDAY(TREL+T2*0.5) - T4 = dTRELdDAY(TREL+T3 ) - KP = mod(KP,DAYS_PER_CYCLE) + 1 - TREL = TREL + (T1 + 2.0*(T2 + T3) + T4) / 6.0 +! Locals + + character(len=ESMF_MAXSTR), parameter :: IAm = "SunOrbitCreate" + + real*8 :: YEARLEN + integer :: K, KP, YEARS_PER_CYCLE, DAYS_PER_CYCLE + real*8 :: TREL, T1, T2, T3, T4, dTRELdDAY + real*8 :: SOB, COB, OMG0, OMG, PRH, PRHV + real :: D2R, OMECC, OPECC, OMSQECC, EAFAC + real*8 :: X, TA, EA, MA, TRRA, MNRA + real :: meanEOT + type(MAPL_SunOrbit) :: ORBIT + integer :: STATUS + + integer :: year, month, day, hour, minute, second + real(ESMF_KIND_R8) :: days + real :: ECC_EQNX, LAMBDAP_EQNX, EAFAC_EQNX + real :: TA_EQNX, EA_EQNX, MA_EQNX + + ! STATEMENT FUNC: dTREL/dDAY(TREL), + ! where TREL is ecliptic longitude of true Sun + dTRELdDAY(TREL) = OMG*(1.0-ECCENTRICITY*cos(TREL-PRH))**2 + + ! useful constants + D2R = MAPL_PI / 180. + + ! record inputs needed by both orbit methods + ORBIT% CLOCK = CLOCK + ORBIT% apply_EOT = EOT + ORBIT% ANAL2B = ORBIT_ANAL2B + + ! Analytic two-body orbit? + if (ORBIT_ANAL2B) then + + ! record inputs in ORBIT type + ORBIT% ORB2B_YEARLEN = ORB2B_YEARLEN + ORBIT% ORB2B_ECC_REF = ORB2B_ECC_REF + ORBIT% ORB2B_OBQ_REF = ORB2B_OBQ_REF * D2R ! radians + ORBIT% ORB2B_LAMBDAP_REF = ORB2B_LAMBDAP_REF * D2R ! radians + ORBIT% ORB2B_ECC_RATE = ORB2B_ECC_RATE / 36525. ! per day + ORBIT% ORB2B_OBQ_RATE = ORB2B_OBQ_RATE * D2R / 36525. ! radians per day + ORBIT% ORB2B_LAMBDAP_RATE = ORB2B_LAMBDAP_RATE * D2R / 36525. ! radians per day + ! record MAPL Time object for REFerence time + year = ORB2B_REF_YYYYMMDD / 10000 + month = mod(ORB2B_REF_YYYYMMDD, 10000) / 100 + day = mod(ORB2B_REF_YYYYMMDD, 100) + hour = ORB2B_REF_HHMMSS / 10000 + minute = mod(ORB2B_REF_HHMMSS, 10000) / 100 + second = mod(ORB2B_REF_HHMMSS, 100) + call ESMF_TimeSet(ORBIT% ORB2B_TIME_REF, & + yy=year, mm=month, dd=day, h=hour, m=minute, s=second, rc=STATUS) + _VERIFY(STATUS) + ! record MAPL Time object for EQUINOX + year = ORB2B_EQUINOX_YYYYMMDD / 10000 + month = mod(ORB2B_EQUINOX_YYYYMMDD, 10000) / 100 + day = mod(ORB2B_EQUINOX_YYYYMMDD, 100) + hour = ORB2B_EQUINOX_HHMMSS / 10000 + minute = mod(ORB2B_EQUINOX_HHMMSS, 10000) / 100 + second = mod(ORB2B_EQUINOX_HHMMSS, 100) + call ESMF_TimeSet(ORBIT% ORB2B_TIME_EQUINOX, & + yy=year, mm=month, dd=day, h=hour, m=minute, s=second, rc=STATUS) + _VERIFY(STATUS) + + ! time-invariant precalculations + ORBIT % ORB2B_OMG0 = 2. * MAPL_PI / ORB2B_YEARLEN + + ! at provided ORB2B_TIME_EQUINOX LAMBDA=0 by definition + call ESMF_TimeIntervalGet( & + ORBIT % ORB2B_TIME_EQUINOX - ORBIT % ORB2B_TIME_REF, & + d_r8=days, rc=STATUS) + _VERIFY(STATUS) + ECC_EQNX = ORBIT % ORB2B_ECC_REF + days * ORBIT % ORB2B_ECC_RATE + LAMBDAP_EQNX = ORBIT % ORB2B_LAMBDAP_REF + days * ORBIT % ORB2B_LAMBDAP_RATE + EAFAC_EQNX = sqrt((1.-ECC_EQNX)/(1.+ECC_EQNX)) + TA_EQNX = -LAMBDAP_EQNX ! since LAMBDA=0 + EA_EQNX = calcEAfromTA(TA_EQNX,EAFAC_EQNX) + MA_EQNX = calcMAfromEA(EA_EQNX,ECC_EQNX) + + ! Time of one perihelion (all subsequent ORB2B_YEARLEN apart) + ORBIT % ORB2B_TIME_PERI = ORBIT % ORB2B_TIME_EQUINOX - MA_EQNX / ORBIT % ORB2B_OMG0 + + else + + ! ================================== + ! Standard tabularized intercalation + ! ================================== + + ! MJS: This needs to come from the calendar when the time manager works right. + YEARLEN = 365.25 + + ! Factors involving the orbital parameters + !----------------------------------------- + OMECC = 1. - ECCENTRICITY + OPECC = 1. + ECCENTRICITY + OMSQECC = 1. - ECCENTRICITY**2 ! pmn: consider changing to line below when zero-diff not issue +! OMSQECC = OMECC * OPECC + EAFAC = sqrt(OMECC/OPECC) + + OMG0 = 2.*MAPL_PI/YEARLEN + OMG = OMG0/sqrt(OMSQECC)**3 + PRH = PERIHELION*D2R + SOB = sin(OBLIQUITY*D2R) + COB = cos(OBLIQUITY*D2R) + + ! PRH is the ecliptic longitude of the perihelion, measured (at the Sun) + ! from the autumnal equinox in the direction of the Earth`s orbital motion + ! (counterclockwise as viewed from ecliptic north pole). + ! For EOT calculations we will reference the perihelion wrt to the vernal + ! equinox, PRHV. Of course, the difference is just PI. + ! pmn: once the EOT code is established and zero-diff not an issue, + ! consider removing original PRH and changing the original (non-EOT), + ! code, which employs + ! cos(Y \pm PI) = -COS(Y) + ! to use PRHV, namely + ! -cos(Y-PRH) = cos(Y-PRH-PI) = cos(Y-PRHV) + PRHV = PRH + MAPL_PI_R8 + + ! Compute length of leap cycle + ! ---------------------------- + if(YEARLEN-int(YEARLEN) > 0.) then + YEARS_PER_CYCLE = nint(1./(YEARLEN-int(YEARLEN))) + else + YEARS_PER_CYCLE = 1 + endif + + DAYS_PER_CYCLE=nint(YEARLEN*YEARS_PER_CYCLE) + + ! save inputs and intercalculation details + ! ---------------------------------------- + ORBIT%OB = OBLIQUITY + ORBIT%ECC = ECCENTRICITY + ORBIT%PER = PERIHELION + ORBIT%EQNX = EQUINOX + ORBIT%YEARLEN = YEARLEN + ORBIT%YEARS_PER_CYCLE = YEARS_PER_CYCLE + ORBIT%DAYS_PER_CYCLE = DAYS_PER_CYCLE + + ! Allocate orbital cycle outputs + ! ------------------------------ + ! TH: Ecliptic longitude of the true Sun, TREL [radians] + ! ZS: Sine of declination + ! ZC: Cosine of declination + ! PP: Inverse of square of earth-sun distance [1/(AU**2)] + ! ET: Equation of time [radians] = + ! True solar hour angle - Mean solar hour angle + + if(associated(ORBIT%TH)) deallocate(ORBIT%TH) + allocate(ORBIT%TH(DAYS_PER_CYCLE), stat=status) + _VERIFY(STATUS) + + if(associated(ORBIT%ZC)) deallocate(ORBIT%ZC) + allocate(ORBIT%ZC(DAYS_PER_CYCLE), stat=status) + _VERIFY(STATUS) + + if(associated(ORBIT%ZS)) deallocate(ORBIT%ZS) + allocate(ORBIT%ZS(DAYS_PER_CYCLE), stat=status) + _VERIFY(STATUS) + + if(associated(ORBIT%PP)) deallocate(ORBIT%PP) + allocate(ORBIT%PP(DAYS_PER_CYCLE), stat=status) + _VERIFY(STATUS) + + if(associated(ORBIT%ET)) deallocate(ORBIT%ET) + allocate(ORBIT%ET(DAYS_PER_CYCLE), stat=status) + VERIFY_(STATUS) + + ! Begin integration at the vernal equinox (K=1, KP=EQUINOX), at + ! which, by defn, the ecliptic longitude of the true sun is zero. + ! Right ascension of true sun at EQUINOX is also zero by defn. + ! -------------------------------------------------------------- + KP = EQUINOX + TREL = 0. ORBIT%ZS(KP) = sin(TREL)*SOB ORBIT%ZC(KP) = sqrt(1.-ORBIT%ZS(KP)**2) ORBIT%PP(KP) = ( (1.-ECCENTRICITY*cos(TREL-PRH)) / OMSQECC )**2 ORBIT%TH(KP) = TREL - ! From BM 1-15 and 1-16 with beta=0 (Sun is on ecliptic), - ! and dividing through by common cos(dec) since it does not - ! affect the ratio of sin(RA) to cos(RA). - TRRA = atan2(sin(TREL)*COB,cos(TREL)) - MNRA = MNRA + OMG0 + TRRA = 0. + + ! Right ascension of "mean sun" = MA(u) + PRHV [eqn (6) above]. + ! Calcn of True (TA), Eccentric (EA), and Mean Anomaly (MA). + TA = TREL - PRHV ! by defn of TA and PRHV + EA = 2.d0*atan(EAFAC*tan(TA/2.d0)) ! BM 4-55 + MA = EA - ECCENTRICITY*sin(EA) ! Kepler's eqn (BM 4-49 ff.) + MNRA = MA + PRHV ! see EOT notes above + + ! Equation of Time, ET [radians] + ! True Solar hour angle = Mean Solar hour angle + ET + ! (hour angle and right ascension are in reverse direction) ORBIT%ET(KP) = rect_pmpi(MNRA - TRRA) - enddo - ! enforce zero mean EOT (just in case) - meanEOT = sum(ORBIT%ET)/DAYS_PER_CYCLE - ORBIT%ET = ORBIT%ET - meanEOT + ! Integrate orbit for entire leap cycle using Runge-Kutta + ! Mean sun moves at constant speed around Celestial Equator + ! --------------------------------------------------------- + do K=2,DAYS_PER_CYCLE + T1 = dTRELdDAY(TREL ) + T2 = dTRELdDAY(TREL+T1*0.5) + T3 = dTRELdDAY(TREL+T2*0.5) + T4 = dTRELdDAY(TREL+T3 ) + KP = mod(KP,DAYS_PER_CYCLE) + 1 + TREL = TREL + (T1 + 2.0*(T2 + T3) + T4) / 6.0 + ORBIT%ZS(KP) = sin(TREL)*SOB + ORBIT%ZC(KP) = sqrt(1.-ORBIT%ZS(KP)**2) + ORBIT%PP(KP) = ( (1.-ECCENTRICITY*cos(TREL-PRH)) / OMSQECC )**2 + ORBIT%TH(KP) = TREL + ! From BM 1-15 and 1-16 with beta=0 (Sun is on ecliptic), + ! and dividing through by common cos(dec) since it does not + ! affect the ratio of sin(RA) to cos(RA). + TRRA = atan2(sin(TREL)*COB,cos(TREL)) + MNRA = MNRA + OMG0 + ORBIT%ET(KP) = rect_pmpi(MNRA - TRRA) + enddo + + ! enforce zero mean EOT (just in case) + meanEOT = sum(ORBIT%ET)/DAYS_PER_CYCLE + ORBIT%ET = ORBIT%ET - meanEOT + + end if if (present(FIX_SUN)) then ORBIT%FIX_SUN=FIX_SUN @@ -513,6 +737,7 @@ type(MAPL_SunOrbit) function MAPL_SunOrbitCreate(CLOCK, & ORBIT%FIX_SUN=.FALSE. end if + ORBIT% CREATED = .TRUE. MAPL_SunOrbitCreate = ORBIT _RETURN(ESMF_SUCCESS) @@ -545,6 +770,7 @@ subroutine MAPL_SunOrbitDestroy(ORBIT, RC) if(associated(ORBIT%ZS)) deallocate(ORBIT%ZS) if(associated(ORBIT%PP)) deallocate(ORBIT%PP) if(associated(ORBIT%ET)) deallocate(ORBIT%ET) + ORBIT% CREATED = .FALSE. _RETURN(ESMF_SUCCESS) @@ -575,7 +801,7 @@ logical function MAPL_SunOrbitCreated(ORBIT, RC) character(len=ESMF_MAXSTR), parameter :: IAm = "SunOrbitCreated" - MAPL_SunOrbitCreated = associated(ORBIT%TH) + MAPL_SunOrbitCreated = ORBIT % CREATED _RETURN(ESMF_SUCCESS) return @@ -635,7 +861,7 @@ subroutine MAPL_SunOrbitQuery(ORBIT, & character(len=ESMF_MAXSTR), parameter :: IAm = "SunOrbitQuery" integer :: STATUS - _ASSERT(MAPL_SunOrbitCreated(ORBIT,RC=STATUS),'needs informative message') + _ASSERT(MAPL_SunOrbitCreated(ORBIT,RC=STATUS),'MAPL_SunOrbit not yet created!') if(present(CLOCK )) CLOCK = ORBIT%CLOCK if(present(OBLIQUITY )) OBLIQUITY = ORBIT%OB @@ -650,6 +876,7 @@ subroutine MAPL_SunOrbitQuery(ORBIT, & if(present(TH )) TH => ORBIT%TH if(present(PP )) PP => ORBIT%PP if(present(ET )) ET => ORBIT%ET +! this needs fixing for ORBIT % ANAL2B or not _RETURN(ESMF_SUCCESS) @@ -706,7 +933,8 @@ end subroutine MAPL_SunOrbitQuery ! will apply the Equation of Time correction, which shifts the actual ! daylight period w.r.t. to mean solar noon, to account for small ! but cumulative eccentricity and oblquity effects on the actual -! length of the solar day. +! length of the solar day. If NOT PRESENT, the default behavior +! from ORBIT%apply_EOT is used. ! !INTERFACE: @@ -1751,9 +1979,9 @@ subroutine MAPL_SunGetSolarConstantByYearDoY(year,dayofyear,SC,HK, rc) HK(6) = ChouBand6(i1)*(1.-F) + ChouBand6(i2)*F HK(7) = ChouBand7(i1)*(1.-F) + ChouBand7(i2)*F HK(8) = ChouBand8(i1)*(1.-F) + ChouBand8(i2)*F - _ASSERT(abs(1.0-sum(HK))<1.e-4,'needs informative message') + _ASSERT(abs(1.0-sum(HK))<1.e-4,'Chou Solar band weightings do not sum to unity!') else - _ASSERT(.false.,'needs informative message') + _ASSERT(.false.,'HK: Solar band weightings only available for Chou') endif end if diff --git a/MAPL_Base/sun.H b/MAPL_Base/sun.H index 3c3fba4284b5..72fa58cd24b5 100644 --- a/MAPL_Base/sun.H +++ b/MAPL_Base/sun.H @@ -37,16 +37,27 @@ type (ESMF_Time) :: CURRENTTIME type (ESMF_Clock) :: MYCLOCK type (ESMF_TimeInterval) :: ts - real, dimension THE_SIZE :: ZTT, SLT, Y, ZTB, ZTD, NCC + real, dimension THE_SIZE :: ZTT, SLT, Y, ZTB, ZTD, NCC + + real(ESMF_KIND_R8) :: days + real :: ECC, OBQ, LAMBDAP + real :: OMECC, OPECC, OMSQECC, EAFAC + real :: MA, EA, dE, TA, LAMBDA, RT, RM + integer :: nits ! Begin + _ASSERT(MAPL_SunOrbitCreated(ORBIT,RC=STATUS), & + 'MAPL_SunOrbit not yet created!') + + ! which time mode? if (present(TIME)) then TIME_ = TIME else TIME_ = 0 endif + ! which current time? if (present(currTime)) then CURRENTTIME = CURRTIME else @@ -62,40 +73,51 @@ if (present(EOT)) then apply_EOT = EOT else - apply_EOT = .FALSE. + apply_EOT = ORBIT% apply_EOT endif + ! fixed sun option if (ORBIT%FIX_SUN) then - call WRITE_PARALLEL('--- WARNING --- sun.H --- Doubly Periodic Using Daily Mean Solar Insolation') - TIME_=MAPL_SunDailyMean + call WRITE_PARALLEL('--- WARNING --- sun.H --- Doubly Periodic Using Daily Mean Solar Insolation') + TIME_=MAPL_SunDailyMean end if + ! analytic two-body currently only works with TIME_=0 currently + _ASSERT(.NOT.(ORBIT%ANAL2B.AND.TIME_/=0), & + 'analytic two-body orbit currently requires TIME_=0') + MEAN_OR_INST: if(.not.present(INTV) .or. TIME_==MAPL_SunDailyMean & .or. TIME_==MAPL_SunAnnualMean) then call ESMF_TimeGet(CURRENTTIME, YY=YEAR, S=SEC_OF_DAY, & - dayOfYear=DAY_OF_YEAR, RC=STATUS) + dayOfYear=DAY_OF_YEAR, RC=STATUS) _VERIFY(STATUS) - if (ORBIT%FIX_SUN) then - TIME_=10 - YEAR=2005 - SEC_OF_DAY=86400/2 - DAY_OF_YEAR=31*7 - end if + if (.NOT. ORBIT%ANAL2B) then + + if (ORBIT%FIX_SUN) then + TIME_=10 + YEAR=2005 + SEC_OF_DAY=86400/2 + DAY_OF_YEAR=31*7 + end if + + YEAR = mod(YEAR-1,ORBIT%YEARS_PER_CYCLE) + IDAY = YEAR*int(ORBIT%YEARLEN)+DAY_OF_YEAR - YEAR = mod(YEAR-1,ORBIT%YEARS_PER_CYCLE) - IDAY = YEAR*int(ORBIT%YEARLEN)+DAY_OF_YEAR + if(present(DIST)) DIST = ORBIT%PP(IDAY) - if(present(DIST)) DIST = ORBIT%PP(IDAY) + endif select case (TIME_) case(MAPL_SunDailyMean) -! pmn: EOT will just displace sunlit period wrt mean noon, -! but the daily mean values will not change - ASSERT_(.FALSE.) ! pmn: this routine probably in error (see below) + ! pmn: EOT will just displace sunlit period wrt mean noon, + ! but the daily mean values will not change + + _ASSERT(.FALSE.,'pmn: MAPL_SunDailyMean probably in error!') + _ASSERT(.NOT.ORBIT%ANAL2B, 'not implemented for analytic two-body orbit') SLR = sin(LATS)*ORBIT%ZS(IDAY) ZTH = cos(LATS)*ORBIT%ZC(IDAY) @@ -109,16 +131,16 @@ ! pmn: If remove factor of 4 above, remove it here too. ! pmn: This is also wrong because includes the ORBIT%PP(IDAY) factor -! pmn: I think these lines should read: -! SLR = Y * SLR + SIN(Y) * ZTH -! ZTH = SLR / Y -! SLR = ORBIT%PP(IDAY) * SLR / MAPL_PI -! On the assumption that ZTH is meant to be the linear average -! of cos(sza) over the sunlit part of the day, or what we call ZTHD -! This routine should also produce an insolation-weighted mean ZTH. -! After end select, all these different ZTHs are set to ZTH, since this -! branch is the instantaneous branch, which is clearly not appropriate -! for a daily or annual mean. + ! pmn: I think these lines should read: + ! SLR = Y * SLR + SIN(Y) * ZTH + ! ZTH = SLR / Y + ! SLR = ORBIT%PP(IDAY) * SLR / MAPL_PI + ! On the assumption that ZTH is meant to be the linear average + ! of cos(sza) over the sunlit part of the day, or what we call ZTHD + ! This routine should also produce an insolation-weighted mean ZTH. + ! After end select, all these different ZTHs are set to ZTH, since this + ! branch is the instantaneous branch, which is clearly not appropriate + ! for a daily or annual mean. elsewhere SLR = 0.0 @@ -127,12 +149,14 @@ case(MAPL_SunAnnualMean) -!pmn: consistent with above (and erroneous) SunDailyMean, -! but unlike MAPL sun_uc.F90 comment: -! "annual-mean insolation for the year on the clock" -! its a mean over the whole currently fixed 4-year cycle. + !pmn: consistent with above (and erroneous) SunDailyMean, + ! but unlike MAPL sun_uc.F90 comment: + ! "annual-mean insolation for the year on the clock" + ! its a mean over the whole currently fixed 4-year cycle. - ASSERT_(.FALSE.) ! pmn: this routine probably in error (see above) + ! see above + _ASSERT(.FALSE.,'pmn: MAPL_SunAnnualMean probably in error!') + _ASSERT(.NOT.ORBIT%ANAL2B, 'not implemented for analytic two-body orbit') SLR = 0.0 ZTH = 0.0 @@ -164,29 +188,73 @@ MAPL_SunVernalEquinox , & MAPL_SunSummerSolstice ) + ! Greenwich MEAN solar hour angle OFFSET by PI + ! (since FAC is zero at mignight) FAC = real(SEC_OF_DAY)/86400. + ANG = 2.0*MAPL_PI*FAC - if(TIME_==0) then - IDAYP1 = mod(IDAY,ORBIT%DAYS_PER_CYCLE) + 1 + if (ORBIT%ANAL2B) then - ZS = ORBIT%ZS(IDAYP1)*FAC + ORBIT%ZS(IDAY)*(1.-FAC) - ZC = ORBIT%ZC(IDAYP1)*FAC + ORBIT%ZC(IDAY)*(1.-FAC) - AA = ORBIT%PP(IDAYP1)*FAC + ORBIT%PP(IDAY)*(1.-FAC) - if (apply_EOT) & - ET = ORBIT%ET(IDAYP1)*FAC + ORBIT%ET(IDAY)*(1.-FAC) - else - call GETIDAY(IDAY,TIME_,ORBIT,RC=STATUS) + ! include time variation in orbit from reference time + call ESMF_TimeIntervalGet( & + CURRENTTIME - ORBIT % ORB2B_TIME_REF, & + d_r8=days, rc=STATUS) + _VERIFY(STATUS) + ECC = ORBIT % ORB2B_ECC_REF + days * ORBIT % ORB2B_ECC_RATE + OBQ = ORBIT % ORB2B_OBQ_REF + days * ORBIT % ORB2B_OBQ_RATE + LAMBDAP = ORBIT % ORB2B_LAMBDAP_REF + days * ORBIT % ORB2B_LAMBDAP_RATE + ! derived quantities + OMECC = 1. - ECC + OPECC = 1. + ECC + OMSQECC = OMECC * OPECC + EAFAC = sqrt(OMECC/OPECC) + ! time interval since perhelion in days + call ESMF_TimeIntervalGet( & + CURRENTTIME - ORBIT % ORB2B_TIME_PERI, & + d_r8=days, rc=STATUS) _VERIFY(STATUS) + ! mean anomaly + MA = ORBIT % ORB2B_OMG0 * days + ! eccentric anomaly + call invert_Keplers_Newton(MA,ECC,EA,dE,nits) + ! true anomaly + TA = calcTAfromEA(EA,EAFAC) + ! inverse distance to sun squared + AA = 1. / calcRadfromTA(TA,ECC,OMSQECC) ** 2 + ! celestial longitude + LAMBDA = TA + LAMBDAP + ! sin and cos of solar declination + ZS = sin(LAMBDA) * sin(OBQ) + ZC = sqrt(1. - ZS**2) + if (apply_EOT) then + ! solar right ascension (true and mean) + RT = atan2(sin(LAMBDA)*cos(OBQ),cos(LAMBDA)) + RM = MA + LAMBDAP + ! equation of time + ET = RECT_PMPI(RM - RT) + end if - ZS = ORBIT%ZS(IDAY) - ZC = ORBIT%ZC(IDAY) - AA = ORBIT%PP(IDAY) - if (apply_EOT) ET = ORBIT%ET(IDAY) - endif + else - ! Greenwich MEAN solar hour angle OFFSET by PI - ! (since FAC is zero at mignight) - ANG = 2.0*MAPL_PI*FAC + if(TIME_==0) then + IDAYP1 = mod(IDAY,ORBIT%DAYS_PER_CYCLE) + 1 + + ZS = ORBIT%ZS(IDAYP1)*FAC + ORBIT%ZS(IDAY)*(1.-FAC) + ZC = ORBIT%ZC(IDAYP1)*FAC + ORBIT%ZC(IDAY)*(1.-FAC) + AA = ORBIT%PP(IDAYP1)*FAC + ORBIT%PP(IDAY)*(1.-FAC) + if (apply_EOT) & + ET = ORBIT%ET(IDAYP1)*FAC + ORBIT%ET(IDAY)*(1.-FAC) + else + call GETIDAY(IDAY,TIME_,ORBIT,RC=STATUS) + _VERIFY(STATUS) + + ZS = ORBIT%ZS(IDAY) + ZC = ORBIT%ZC(IDAY) + AA = ORBIT%PP(IDAY) + if (apply_EOT) ET = ORBIT%ET(IDAY) + endif + + endif ! apply equation of time correction? if (apply_EOT) then From b72772ecc082f7324f8e0e068a20b65eded25f76 Mon Sep 17 00:00:00 2001 From: Peter Norris Date: Mon, 13 Jan 2020 14:57:18 -0500 Subject: [PATCH 039/109] pmn: second draft precession and EOT -- seems ok for SOLAR but nneds work on Query for land --- MAPL_Base/MAPL_Generic.F90 | 27 ++++++-- MAPL_Base/MAPL_sun_uc.F90 | 127 +++++++++++++++++++------------------ MAPL_Base/sun.H | 43 +++++-------- 3 files changed, 103 insertions(+), 94 deletions(-) diff --git a/MAPL_Base/MAPL_Generic.F90 b/MAPL_Base/MAPL_Generic.F90 index 28c3c78a1923..93b31589ca97 100644 --- a/MAPL_Base/MAPL_Generic.F90 +++ b/MAPL_Base/MAPL_Generic.F90 @@ -3791,6 +3791,20 @@ subroutine MAPL_GenericStateGet (STATE, IM, JM, LM, VERTDIM, & CF=STATE%CF endif + ! pmn: There is one orbit is per STATE, so, for example, the MAPL states of the + ! solar and land gridded components can potentially have independent solar orbits. + ! Usually these "independent orbits" will be IDENTICAL because the configuration + ! resources such as "ECCENTRICITY:" or "EOT:" will not be qualified by the name + ! of the gridded component. But for example, if the resource file specifies + ! "EOT: .FALSE." + ! but + ! "SOLAR_EOT: .TRUE." + ! then only SOLAR will have an EOT correction. The same goes for the new orbital + ! system choice ORBIT_ANAL2B. + ! A state's orbit is actually created in this routine by requesting the ORBIT + ! object. If its not already created then it will be made below. GridComps that + ! don't needed an orbit and dont request one will not have one. + if(present(ORBIT)) then if(.not.MAPL_SunOrbitCreated(STATE%ORBIT)) then @@ -3822,19 +3836,18 @@ subroutine MAPL_GenericStateGet (STATE, IM, JM, LM, VERTDIM, & RC=STATUS) _VERIFY(STATUS) - ! Apply Equation of Time correction by default? - ! (Can be overridden in MAPL_SunGetInsolation call) - ! ------------------------------------------------- + ! Apply Equation of Time correction? + ! ---------------------------------- call MAPL_GetResource(STATE, EOT, Label="EOT:", default=.FALSE., & RC=STATUS) _VERIFY(STATUS) - ! New orbital system (analytic two-body) allows some time-varying behavior, - ! namely, linear variation in LAMBDAP, ECC, and OBQ. - ! ------------------------------------------------------------------------- + ! New orbital system (analytic two-body) allows some time-varying + ! behavior, namely, linear variation in LAMBDAP, ECC, and OBQ. + ! --------------------------------------------------------------- call MAPL_GetResource(STATE, & - ORB_ANAL2B, Label="ORBIT_ANAL2B:", default=.FALSE., & + ORBIT_ANAL2B, Label="ORBIT_ANAL2B:", default=.FALSE., & RC=STATUS) _VERIFY(STATUS) diff --git a/MAPL_Base/MAPL_sun_uc.F90 b/MAPL_Base/MAPL_sun_uc.F90 index ae5fb1586603..72401ea4e3f9 100644 --- a/MAPL_Base/MAPL_sun_uc.F90 +++ b/MAPL_Base/MAPL_sun_uc.F90 @@ -70,14 +70,14 @@ module MAPL_SunMod private logical :: CREATED = .FALSE. type(ESMF_Clock) :: CLOCK - real :: OB, ECC, PER, YEARLEN, EQNX_FRAC, + real :: OB, ECC, PER, YEARLEN integer :: EQNX, YEARS_PER_CYCLE, DAYS_PER_CYCLE real, pointer, dimension(:) :: ZC => null() real, pointer, dimension(:) :: ZS => null() real, pointer, dimension(:) :: PP => null() real, pointer, dimension(:) :: TH => null() real, pointer, dimension(:) :: ET => null() - logical :: apply_EOT + logical :: EOT logical :: FIX_SUN logical :: ANAL2B real :: ORB2B_YEARLEN @@ -218,10 +218,7 @@ function calcRadfromTA(TA,ECC,OMSQECC) result(Rad) ! first year of the cycle.} !% \item[] !\makebox[2in][l]{\bf \em EOT} -! \parbox[t]{4in}{Apply Equation of Time correction by default? -! The correction is always available, but only applied if requested -! by this flag. An explicit EOT argument in MAPL_SunGetInsolation() -! will override the default behavior.} +! \parbox[t]{4in}{Apply Equation of Time correction?} ! !% \item[] !\makebox[2in][l]{\bf \em ORBIT\_ANAL2B} @@ -531,6 +528,7 @@ type(MAPL_SunOrbit) function MAPL_SunOrbitCreate(CLOCK, & real(ESMF_KIND_R8) :: days real :: ECC_EQNX, LAMBDAP_EQNX, EAFAC_EQNX real :: TA_EQNX, EA_EQNX, MA_EQNX + type(ESMF_TimeInterval) :: DT ! STATEMENT FUNC: dTREL/dDAY(TREL), ! where TREL is ecliptic longitude of true Sun @@ -540,21 +538,21 @@ type(MAPL_SunOrbit) function MAPL_SunOrbitCreate(CLOCK, & D2R = MAPL_PI / 180. ! record inputs needed by both orbit methods - ORBIT% CLOCK = CLOCK - ORBIT% apply_EOT = EOT - ORBIT% ANAL2B = ORBIT_ANAL2B + ORBIT%CLOCK = CLOCK + ORBIT%EOT = EOT + ORBIT%ANAL2B = ORBIT_ANAL2B ! Analytic two-body orbit? if (ORBIT_ANAL2B) then ! record inputs in ORBIT type - ORBIT% ORB2B_YEARLEN = ORB2B_YEARLEN - ORBIT% ORB2B_ECC_REF = ORB2B_ECC_REF - ORBIT% ORB2B_OBQ_REF = ORB2B_OBQ_REF * D2R ! radians - ORBIT% ORB2B_LAMBDAP_REF = ORB2B_LAMBDAP_REF * D2R ! radians - ORBIT% ORB2B_ECC_RATE = ORB2B_ECC_RATE / 36525. ! per day - ORBIT% ORB2B_OBQ_RATE = ORB2B_OBQ_RATE * D2R / 36525. ! radians per day - ORBIT% ORB2B_LAMBDAP_RATE = ORB2B_LAMBDAP_RATE * D2R / 36525. ! radians per day + ORBIT%ORB2B_YEARLEN = ORB2B_YEARLEN + ORBIT%ORB2B_ECC_REF = ORB2B_ECC_REF + ORBIT%ORB2B_OBQ_REF = ORB2B_OBQ_REF * D2R ! radians + ORBIT%ORB2B_LAMBDAP_REF = ORB2B_LAMBDAP_REF * D2R ! radians + ORBIT%ORB2B_ECC_RATE = ORB2B_ECC_RATE / 36525. ! per day + ORBIT%ORB2B_OBQ_RATE = ORB2B_OBQ_RATE * D2R / 36525. ! radians per day + ORBIT%ORB2B_LAMBDAP_RATE = ORB2B_LAMBDAP_RATE * D2R / 36525. ! radians per day ! record MAPL Time object for REFerence time year = ORB2B_REF_YYYYMMDD / 10000 month = mod(ORB2B_REF_YYYYMMDD, 10000) / 100 @@ -562,7 +560,7 @@ type(MAPL_SunOrbit) function MAPL_SunOrbitCreate(CLOCK, & hour = ORB2B_REF_HHMMSS / 10000 minute = mod(ORB2B_REF_HHMMSS, 10000) / 100 second = mod(ORB2B_REF_HHMMSS, 100) - call ESMF_TimeSet(ORBIT% ORB2B_TIME_REF, & + call ESMF_TimeSet(ORBIT%ORB2B_TIME_REF, & yy=year, mm=month, dd=day, h=hour, m=minute, s=second, rc=STATUS) _VERIFY(STATUS) ! record MAPL Time object for EQUINOX @@ -572,27 +570,28 @@ type(MAPL_SunOrbit) function MAPL_SunOrbitCreate(CLOCK, & hour = ORB2B_EQUINOX_HHMMSS / 10000 minute = mod(ORB2B_EQUINOX_HHMMSS, 10000) / 100 second = mod(ORB2B_EQUINOX_HHMMSS, 100) - call ESMF_TimeSet(ORBIT% ORB2B_TIME_EQUINOX, & + call ESMF_TimeSet(ORBIT%ORB2B_TIME_EQUINOX, & yy=year, mm=month, dd=day, h=hour, m=minute, s=second, rc=STATUS) _VERIFY(STATUS) ! time-invariant precalculations - ORBIT % ORB2B_OMG0 = 2. * MAPL_PI / ORB2B_YEARLEN + ORBIT%ORB2B_OMG0 = 2. * MAPL_PI / ORB2B_YEARLEN ! at provided ORB2B_TIME_EQUINOX LAMBDA=0 by definition call ESMF_TimeIntervalGet( & - ORBIT % ORB2B_TIME_EQUINOX - ORBIT % ORB2B_TIME_REF, & + ORBIT%ORB2B_TIME_EQUINOX - ORBIT%ORB2B_TIME_REF, & d_r8=days, rc=STATUS) _VERIFY(STATUS) - ECC_EQNX = ORBIT % ORB2B_ECC_REF + days * ORBIT % ORB2B_ECC_RATE - LAMBDAP_EQNX = ORBIT % ORB2B_LAMBDAP_REF + days * ORBIT % ORB2B_LAMBDAP_RATE + ECC_EQNX = ORBIT%ORB2B_ECC_REF + days * ORBIT%ORB2B_ECC_RATE + LAMBDAP_EQNX = ORBIT%ORB2B_LAMBDAP_REF + days * ORBIT%ORB2B_LAMBDAP_RATE EAFAC_EQNX = sqrt((1.-ECC_EQNX)/(1.+ECC_EQNX)) TA_EQNX = -LAMBDAP_EQNX ! since LAMBDA=0 EA_EQNX = calcEAfromTA(TA_EQNX,EAFAC_EQNX) MA_EQNX = calcMAfromEA(EA_EQNX,ECC_EQNX) ! Time of one perihelion (all subsequent ORB2B_YEARLEN apart) - ORBIT % ORB2B_TIME_PERI = ORBIT % ORB2B_TIME_EQUINOX - MA_EQNX / ORBIT % ORB2B_OMG0 + call ESMF_TimeIntervalSet(DT, d_r8 = dble(MA_EQNX / ORBIT%ORB2B_OMG0)) + ORBIT%ORB2B_TIME_PERI = ORBIT%ORB2B_TIME_EQUINOX - DT else @@ -675,9 +674,11 @@ type(MAPL_SunOrbit) function MAPL_SunOrbitCreate(CLOCK, & allocate(ORBIT%PP(DAYS_PER_CYCLE), stat=status) _VERIFY(STATUS) - if(associated(ORBIT%ET)) deallocate(ORBIT%ET) - allocate(ORBIT%ET(DAYS_PER_CYCLE), stat=status) - VERIFY_(STATUS) + if (ORBIT%EOT) then + if(associated(ORBIT%ET)) deallocate(ORBIT%ET) + allocate(ORBIT%ET(DAYS_PER_CYCLE), stat=status) + VERIFY_(STATUS) + end if ! Begin integration at the vernal equinox (K=1, KP=EQUINOX), at ! which, by defn, the ecliptic longitude of the true sun is zero. @@ -689,19 +690,21 @@ type(MAPL_SunOrbit) function MAPL_SunOrbitCreate(CLOCK, & ORBIT%ZC(KP) = sqrt(1.-ORBIT%ZS(KP)**2) ORBIT%PP(KP) = ( (1.-ECCENTRICITY*cos(TREL-PRH)) / OMSQECC )**2 ORBIT%TH(KP) = TREL - TRRA = 0. - ! Right ascension of "mean sun" = MA(u) + PRHV [eqn (6) above]. - ! Calcn of True (TA), Eccentric (EA), and Mean Anomaly (MA). - TA = TREL - PRHV ! by defn of TA and PRHV - EA = 2.d0*atan(EAFAC*tan(TA/2.d0)) ! BM 4-55 - MA = EA - ECCENTRICITY*sin(EA) ! Kepler's eqn (BM 4-49 ff.) - MNRA = MA + PRHV ! see EOT notes above - - ! Equation of Time, ET [radians] - ! True Solar hour angle = Mean Solar hour angle + ET - ! (hour angle and right ascension are in reverse direction) - ORBIT%ET(KP) = rect_pmpi(MNRA - TRRA) + if (ORBIT%EOT) then + ! Right ascension of "mean sun" = MA(u) + PRHV [eqn (6) above]. + ! Calcn of True (TA), Eccentric (EA), and Mean Anomaly (MA). + TA = TREL - PRHV ! by defn of TA and PRHV + EA = 2.d0*atan(EAFAC*tan(TA/2.d0)) ! BM 4-55 + MA = EA - ECCENTRICITY*sin(EA) ! Kepler's eqn (BM 4-49 ff.) + MNRA = MA + PRHV ! see EOT notes above + TRRA = 0. ! because TREL=0 at Equinox + + ! Equation of Time, ET [radians] + ! True Solar hour angle = Mean Solar hour angle + ET + ! (hour angle and right ascension are in reverse direction) + ORBIT%ET(KP) = rect_pmpi(real(MNRA - TRRA)) + end if ! Integrate orbit for entire leap cycle using Runge-Kutta ! Mean sun moves at constant speed around Celestial Equator @@ -717,17 +720,21 @@ type(MAPL_SunOrbit) function MAPL_SunOrbitCreate(CLOCK, & ORBIT%ZC(KP) = sqrt(1.-ORBIT%ZS(KP)**2) ORBIT%PP(KP) = ( (1.-ECCENTRICITY*cos(TREL-PRH)) / OMSQECC )**2 ORBIT%TH(KP) = TREL - ! From BM 1-15 and 1-16 with beta=0 (Sun is on ecliptic), - ! and dividing through by common cos(dec) since it does not - ! affect the ratio of sin(RA) to cos(RA). - TRRA = atan2(sin(TREL)*COB,cos(TREL)) - MNRA = MNRA + OMG0 - ORBIT%ET(KP) = rect_pmpi(MNRA - TRRA) + if (ORBIT%EOT) then + ! From BM 1-15 and 1-16 with beta=0 (Sun is on ecliptic), + ! and dividing through by common cos(dec) since it does not + ! affect the ratio of sin(RA) to cos(RA). + TRRA = atan2(sin(TREL)*COB,cos(TREL)) + MNRA = MNRA + OMG0 + ORBIT%ET(KP) = rect_pmpi(real(MNRA - TRRA)) + end if enddo ! enforce zero mean EOT (just in case) - meanEOT = sum(ORBIT%ET)/DAYS_PER_CYCLE - ORBIT%ET = ORBIT%ET - meanEOT + if (ORBIT%EOT) then + meanEOT = sum(ORBIT%ET)/DAYS_PER_CYCLE + ORBIT%ET = ORBIT%ET - meanEOT + end if end if @@ -737,7 +744,7 @@ type(MAPL_SunOrbit) function MAPL_SunOrbitCreate(CLOCK, & ORBIT%FIX_SUN=.FALSE. end if - ORBIT% CREATED = .TRUE. + ORBIT%CREATED = .TRUE. MAPL_SunOrbitCreate = ORBIT _RETURN(ESMF_SUCCESS) @@ -770,7 +777,7 @@ subroutine MAPL_SunOrbitDestroy(ORBIT, RC) if(associated(ORBIT%ZS)) deallocate(ORBIT%ZS) if(associated(ORBIT%PP)) deallocate(ORBIT%PP) if(associated(ORBIT%ET)) deallocate(ORBIT%ET) - ORBIT% CREATED = .FALSE. + ORBIT%CREATED = .FALSE. _RETURN(ESMF_SUCCESS) @@ -801,7 +808,7 @@ logical function MAPL_SunOrbitCreated(ORBIT, RC) character(len=ESMF_MAXSTR), parameter :: IAm = "SunOrbitCreated" - MAPL_SunOrbitCreated = ORBIT % CREATED + MAPL_SunOrbitCreated = ORBIT%CREATED _RETURN(ESMF_SUCCESS) return @@ -855,6 +862,10 @@ subroutine MAPL_SunOrbitQuery(ORBIT, & real, optional, pointer, dimension(:) :: ET integer, optional, intent(OUT) :: RC +! BUGS: +! Not updated for ORBIT_ANAL2B option, which does not precalc +! many of the above outputs. + !EOPI @@ -876,7 +887,6 @@ subroutine MAPL_SunOrbitQuery(ORBIT, & if(present(TH )) TH => ORBIT%TH if(present(PP )) PP => ORBIT%PP if(present(ET )) ET => ORBIT%ET -! this needs fixing for ORBIT % ANAL2B or not _RETURN(ESMF_SUCCESS) @@ -929,18 +939,16 @@ end subroutine MAPL_SunOrbitQuery ! MAPL_SunAnnualMean !\end{verbatim} ! -! The {\tt EOT} optional logical argument, if present and .TRUE., -! will apply the Equation of Time correction, which shifts the actual -! daylight period w.r.t. to mean solar noon, to account for small -! but cumulative eccentricity and oblquity effects on the actual -! length of the solar day. If NOT PRESENT, the default behavior -! from ORBIT%apply_EOT is used. +! Note: if ORBIT%EOT is .TRUE., an Equation of Time correction will be +! applied. This shifts the actual daylight period w.r.t. to mean solar +! noon, to account for small but cumulative eccentricity and obliquity +! effects on the actual length of the solar day. ! !INTERFACE: ! subroutine MAPL_SunGetInsolation(LONS, LATS, ORBIT,ZTH,SLR,INTV,CLOCK, & ! TIME,currTime,DIST,ZTHB,ZTHD,ZTH1,ZTHN, & -! EOT, RC) +! RC) ! !ARGUMENTS: @@ -958,7 +966,6 @@ end subroutine MAPL_SunOrbitQuery ! TYPE , optional, intent(OUT) :: ZTHD ! TYPE , optional, intent(OUT) :: ZTH1 ! TYPE , optional, intent(OUT) :: ZTHN -! logical , optional, INTENT(IN ) :: EOT ! integer, optional, intent(OUT) :: RC !\end{verbatim} ! where we currently support three overloads for {\tt TYPE} : @@ -973,7 +980,7 @@ end subroutine MAPL_SunOrbitQuery #define THE_SIZE (size(LONS,1)) recursive subroutine SOLAR_1D(LONS, LATS, ORBIT,ZTH,SLR,INTV,CLOCK, & TIME,currTime,DIST,ZTHB,ZTHD,ZTH1,ZTHN,& - STEPSIZE,EOT,RC) + STEPSIZE,RC) #include "sun.H" end subroutine SOLAR_1D @@ -985,7 +992,7 @@ end subroutine SOLAR_1D #define THE_SIZE (size(LONS,1),size(LONS,2)) recursive subroutine SOLAR_2D(LONS, LATS, ORBIT,ZTH,SLR,INTV,CLOCK, & TIME,currTime,DIST,ZTHB,ZTHD,ZTH1,ZTHN,& - STEPSIZE,EOT,RC) + STEPSIZE,RC) #include "sun.H" end subroutine SOLAR_2D #undef DIMENSIONS diff --git a/MAPL_Base/sun.H b/MAPL_Base/sun.H index 72fa58cd24b5..8107ed46ec1a 100644 --- a/MAPL_Base/sun.H +++ b/MAPL_Base/sun.H @@ -16,7 +16,6 @@ real, optional, intent(OUT) :: ZTH1 DIMENSIONS real, optional, intent(OUT) :: ZTHN DIMENSIONS real, optional, intent(IN) :: STEPSIZE - logical, optional, intent(IN) :: EOT integer, optional, intent(OUT) :: RC ! Locals @@ -28,7 +27,6 @@ integer :: NT real :: FAC, ZS, ZC, ANG, AA, DD, ET real*8 :: SECS - logical :: apply_EOT integer :: YEAR integer :: SEC_OF_DAY @@ -47,8 +45,7 @@ ! Begin - _ASSERT(MAPL_SunOrbitCreated(ORBIT,RC=STATUS), & - 'MAPL_SunOrbit not yet created!') + _ASSERT(MAPL_SunOrbitCreated(ORBIT),'MAPL_SunOrbit not yet created!') ! which time mode? if (present(TIME)) then @@ -69,13 +66,6 @@ _VERIFY(STATUS) end if - ! apply Equation of Time correction? - if (present(EOT)) then - apply_EOT = EOT - else - apply_EOT = ORBIT% apply_EOT - endif - ! fixed sun option if (ORBIT%FIX_SUN) then call WRITE_PARALLEL('--- WARNING --- sun.H --- Doubly Periodic Using Daily Mean Solar Insolation') @@ -83,8 +73,7 @@ end if ! analytic two-body currently only works with TIME_=0 currently - _ASSERT(.NOT.(ORBIT%ANAL2B.AND.TIME_/=0), & - 'analytic two-body orbit currently requires TIME_=0') + _ASSERT(.NOT.(ORBIT%ANAL2B.AND.TIME_/=0),'analytic two-body orbit currently requires TIME_=0') MEAN_OR_INST: if(.not.present(INTV) .or. TIME_==MAPL_SunDailyMean & .or. TIME_==MAPL_SunAnnualMean) then @@ -117,7 +106,7 @@ ! but the daily mean values will not change _ASSERT(.FALSE.,'pmn: MAPL_SunDailyMean probably in error!') - _ASSERT(.NOT.ORBIT%ANAL2B, 'not implemented for analytic two-body orbit') + _ASSERT(.NOT.ORBIT%ANAL2B,'not implemented for analytic two-body orbit') SLR = sin(LATS)*ORBIT%ZS(IDAY) ZTH = cos(LATS)*ORBIT%ZC(IDAY) @@ -156,7 +145,7 @@ ! see above _ASSERT(.FALSE.,'pmn: MAPL_SunAnnualMean probably in error!') - _ASSERT(.NOT.ORBIT%ANAL2B, 'not implemented for analytic two-body orbit') + _ASSERT(.NOT.ORBIT%ANAL2B,'not implemented for analytic two-body orbit') SLR = 0.0 ZTH = 0.0 @@ -197,12 +186,12 @@ ! include time variation in orbit from reference time call ESMF_TimeIntervalGet( & - CURRENTTIME - ORBIT % ORB2B_TIME_REF, & + CURRENTTIME - ORBIT%ORB2B_TIME_REF, & d_r8=days, rc=STATUS) _VERIFY(STATUS) - ECC = ORBIT % ORB2B_ECC_REF + days * ORBIT % ORB2B_ECC_RATE - OBQ = ORBIT % ORB2B_OBQ_REF + days * ORBIT % ORB2B_OBQ_RATE - LAMBDAP = ORBIT % ORB2B_LAMBDAP_REF + days * ORBIT % ORB2B_LAMBDAP_RATE + ECC = ORBIT%ORB2B_ECC_REF + days * ORBIT%ORB2B_ECC_RATE + OBQ = ORBIT%ORB2B_OBQ_REF + days * ORBIT%ORB2B_OBQ_RATE + LAMBDAP = ORBIT%ORB2B_LAMBDAP_REF + days * ORBIT%ORB2B_LAMBDAP_RATE ! derived quantities OMECC = 1. - ECC OPECC = 1. + ECC @@ -210,11 +199,11 @@ EAFAC = sqrt(OMECC/OPECC) ! time interval since perhelion in days call ESMF_TimeIntervalGet( & - CURRENTTIME - ORBIT % ORB2B_TIME_PERI, & + CURRENTTIME - ORBIT%ORB2B_TIME_PERI, & d_r8=days, rc=STATUS) _VERIFY(STATUS) ! mean anomaly - MA = ORBIT % ORB2B_OMG0 * days + MA = ORBIT%ORB2B_OMG0 * days ! eccentric anomaly call invert_Keplers_Newton(MA,ECC,EA,dE,nits) ! true anomaly @@ -226,7 +215,7 @@ ! sin and cos of solar declination ZS = sin(LAMBDA) * sin(OBQ) ZC = sqrt(1. - ZS**2) - if (apply_EOT) then + if (ORBIT%EOT) then ! solar right ascension (true and mean) RT = atan2(sin(LAMBDA)*cos(OBQ),cos(LAMBDA)) RM = MA + LAMBDAP @@ -242,7 +231,7 @@ ZS = ORBIT%ZS(IDAYP1)*FAC + ORBIT%ZS(IDAY)*(1.-FAC) ZC = ORBIT%ZC(IDAYP1)*FAC + ORBIT%ZC(IDAY)*(1.-FAC) AA = ORBIT%PP(IDAYP1)*FAC + ORBIT%PP(IDAY)*(1.-FAC) - if (apply_EOT) & + if (ORBIT%EOT) & ET = ORBIT%ET(IDAYP1)*FAC + ORBIT%ET(IDAY)*(1.-FAC) else call GETIDAY(IDAY,TIME_,ORBIT,RC=STATUS) @@ -251,13 +240,13 @@ ZS = ORBIT%ZS(IDAY) ZC = ORBIT%ZC(IDAY) AA = ORBIT%PP(IDAY) - if (apply_EOT) ET = ORBIT%ET(IDAY) + if (ORBIT%EOT) ET = ORBIT%ET(IDAY) endif endif ! apply equation of time correction? - if (apply_EOT) then + if (ORBIT%EOT) then ! the real (zero at noon) Greenwich MEAN solar hour angle ANG = ANG + MAPL_PI @@ -361,7 +350,7 @@ call MAPL_SunGetInsolation( LONS, LATS, ORBIT, ZTT, SLT, & CLOCK=MYCLOCK, TIME=TIME, DIST=DD, & - EOT=apply_EOT, RC=STATUS) + RC=STATUS) _VERIFY(STATUS) if(present(ZTH1)) ZTH1 = max(ZTT,0.0) @@ -385,7 +374,7 @@ call MAPL_SunGetInsolation( LONS, LATS, ORBIT, ZTT, SLT, & CLOCK=MYCLOCK, TIME=TIME, ZTHB=ZTB, ZTHD=ZTD, DIST=DD, & - EOT=apply_EOT, RC=STATUS) + RC=STATUS) _VERIFY(STATUS) SLR = SLR + SLT*0.5 From 9cbd5f47aa8d17e1795125970a7efb34e9e4555c Mon Sep 17 00:00:00 2001 From: Peter Norris Date: Fri, 17 Jan 2020 09:32:52 -0500 Subject: [PATCH 040/109] pmn: added two new routines that will be called from catchCN in a later commit --- MAPL_Base/MAPL_sun_uc.F90 | 194 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 194 insertions(+) diff --git a/MAPL_Base/MAPL_sun_uc.F90 b/MAPL_Base/MAPL_sun_uc.F90 index 72401ea4e3f9..1c1bd5ee276c 100644 --- a/MAPL_Base/MAPL_sun_uc.F90 +++ b/MAPL_Base/MAPL_sun_uc.F90 @@ -2795,4 +2795,198 @@ end function find_file_index end subroutine MAPL_SunGetSolarConstantFromNRLFile +!========================================================================== + +!BOPI + +! !IROUTINE: MAPL_SunGetDaylightDuration + +! !DESCRIPTION: + +! Return the daylight duration in seconds (i.e, the time between sunrise and sunset) for +! a day around the specified time. The routine is accurate enough for most purposes, but +! does not solve for precise sunrise/sunset times influenced by changes in the orbital +! parameters between those times. The time input does NOT need to be noon --- it is used +! simply to evaluate the solar declination needed for the daylight duration calculation. +! In order of preference, time is taken from currTime, if present, or else the currTime +! of CLOCK, if present, or else the currTime of the ORBIT's associated clock. + +! !INTERFACE: + + subroutine MAPL_SunGetDaylightDuration(ORBIT,LATS,DAYL,currTime,CLOCK,RC) + +! !ARGUMENTS: + + type(MAPL_SunOrbit), intent(IN ) :: ORBIT + real, dimension(:) , intent(IN ) :: LATS + real, dimension(:) , intent(OUT) :: DAYL + type(ESMF_Time) , optional, intent(IN ) :: currTime + type(ESMF_Clock) , optional, intent(IN ) :: CLOCK + integer, optional, intent(OUT) :: RC + +!EOPI + +! Locals + + character(len=ESMF_MAXSTR), parameter :: IAm = "MAPL_SunGetDaylightDuration" + integer :: STATUS + + type(ESMF_Time) :: CURRENTTIME + integer :: YEAR, SEC_OF_DAY, DAY_OF_YEAR, IDAY, IDAYP1 + real :: FAC, ZS, ZC + + real(ESMF_KIND_R8) :: days + real :: ECC, OBQ, LAMBDAP + real :: OMECC, OPECC, OMSQECC, EAFAC + real :: MA, EA, dE, TA, LAMBDA + integer :: nits + +! Begin + + _ASSERT(MAPL_SunOrbitCreated(ORBIT),'MAPL_SunOrbit not yet created!') + + ! which current time? + if (present(currTime)) then + CURRENTTIME = CURRTIME + else + if (present(CLOCK)) then + call ESMF_ClockGet( CLOCK, currTime=CURRENTTIME, RC=STATUS) + else + call ESMF_ClockGet(ORBIT%CLOCK, currTime=CURRENTTIME, RC=STATUS) + end if + _VERIFY(STATUS) + end if + + if (ORBIT%ANAL2B) then + + ! include time variation in orbit from reference time + call ESMF_TimeIntervalGet( & + CURRENTTIME - ORBIT%ORB2B_TIME_REF, & + d_r8=days, rc=STATUS) + _VERIFY(STATUS) + ECC = ORBIT%ORB2B_ECC_REF + days * ORBIT%ORB2B_ECC_RATE + OBQ = ORBIT%ORB2B_OBQ_REF + days * ORBIT%ORB2B_OBQ_RATE + LAMBDAP = ORBIT%ORB2B_LAMBDAP_REF + days * ORBIT%ORB2B_LAMBDAP_RATE + ! derived quantities + OMECC = 1. - ECC + OPECC = 1. + ECC + OMSQECC = OMECC * OPECC + EAFAC = sqrt(OMECC/OPECC) + ! time interval since perhelion in days + call ESMF_TimeIntervalGet( & + CURRENTTIME - ORBIT%ORB2B_TIME_PERI, & + d_r8=days, rc=STATUS) + _VERIFY(STATUS) + ! mean anomaly + MA = ORBIT%ORB2B_OMG0 * days + ! eccentric anomaly + call invert_Keplers_Newton(MA,ECC,EA,dE,nits) + ! true anomaly + TA = calcTAfromEA(EA,EAFAC) + ! celestial longitude + LAMBDA = TA + LAMBDAP + ! sin and cos of solar declination + ZS = sin(LAMBDA) * sin(OBQ) + ZC = sqrt(1. - ZS**2) + + else + + call ESMF_TimeGet(CURRENTTIME, YY=YEAR, S=SEC_OF_DAY, & + dayOfYear=DAY_OF_YEAR, RC=STATUS) + _VERIFY(STATUS) + + YEAR = mod(YEAR-1,ORBIT%YEARS_PER_CYCLE) + IDAY = YEAR*int(ORBIT%YEARLEN)+DAY_OF_YEAR + IDAYP1 = mod(IDAY,ORBIT%DAYS_PER_CYCLE) + 1 + + FAC = real(SEC_OF_DAY)/86400. + ZS = ORBIT%ZS(IDAYP1)*FAC + ORBIT%ZS(IDAY)*(1.-FAC) + ZC = ORBIT%ZC(IDAYP1)*FAC + ORBIT%ZC(IDAY)*(1.-FAC) + + endif + + ! dayligt duration [secs] + DAYL = (86400./MAPL_PI)*acos(min(1.,max(-1.,-tan(LATS)*ZS/ZC))) + + _RETURN(ESMF_SUCCESS) + + end subroutine MAPL_SunGetDaylightDuration + +!========================================================================== + +!BOPI + +! !IROUTINE: MAPL_SunGetDaylightDurationMax + +! !DESCRIPTION: + +! Return the daylight duration in seconds (i.e, the time between sunrise and sunset) for +! its MAXIMUM at the summer solstice. The routine is accurate enough for most purposes, +! but does not solve for precise sunrise/sunset times influenced by changes in the orbital +! parameters between those times. The time input does NOT need to be noon --- it is used +! simply to evaluate the obliquity needed for the maximum daylight duration calculation. +! In order of preference, time is taken from currTime, if present, or else the currTime +! of CLOCK, if present, or else the currTime of the ORBIT's associated clock. +! Note: Unless ORBIT_ANAL2B, the obliquity is fixed and the time is irrelevant. + +! !INTERFACE: + + subroutine MAPL_SunGetDaylightDurationMax(ORBIT,LATS,DAYL,currTime,CLOCK,RC) + +! !ARGUMENTS: + + type(MAPL_SunOrbit), intent(IN ) :: ORBIT + real, dimension(:) , intent(IN ) :: LATS + real, dimension(:) , intent(OUT) :: DAYL + type(ESMF_Time) , optional, intent(IN ) :: currTime + type(ESMF_Clock) , optional, intent(IN ) :: CLOCK + integer, optional, intent(OUT) :: RC + +!EOPI + + character(len=ESMF_MAXSTR), parameter :: IAm = "MAPL_SunGetDaylightDurationMax" + integer :: STATUS + + type(ESMF_Time) :: CURRENTTIME + real(ESMF_KIND_R8) :: days + real :: OBQ + + _ASSERT(MAPL_SunOrbitCreated(ORBIT),'MAPL_SunOrbit not yet created!') + + ! Which time? + if (present(currTime)) then + CURRENTTIME = CURRTIME + else + if (present(CLOCK)) then + call ESMF_ClockGet( CLOCK, currTime=CURRENTTIME, RC=STATUS) + else + call ESMF_ClockGet(ORBIT%CLOCK, currTime=CURRENTTIME, RC=STATUS) + end if + _VERIFY(STATUS) + end if + + if (ORBIT%ANAL2B) then + ! time variation in obliquity from ref time + call ESMF_TimeIntervalGet( & + CURRENTTIME - ORBIT%ORB2B_TIME_REF, & + d_r8=days, rc=STATUS) + _VERIFY(STATUS) + OBQ = ORBIT%ORB2B_OBQ_REF + days * ORBIT%ORB2B_OBQ_RATE + else + ! obliquity fixed in this case + OBQ = ORBIT%OB * (MAPL_PI/180.) + endif + _ASSERT(0. <= OBQ .and. OBQ < MAPL_PI, 'Strange obliquity!') + + ! Maximum daylight duration at summer solstice [secs] + ! (an even function of latitude) + DAYL = (86400./MAPL_PI)*acos(min(1.,max(-1., & + -tan(ABS(LATS))*tan(OBQ)))) + + _RETURN(ESMF_SUCCESS) + + end subroutine MAPL_SunGetDaylightDurationMax + +!========================================================================== + end module MAPL_SunMod From 3f04e6e91191dea6b74bd85aca9810703667d8e5 Mon Sep 17 00:00:00 2001 From: Peter Norris Date: Fri, 17 Jan 2020 14:28:40 -0500 Subject: [PATCH 041/109] pmn: made MAPL_SunGetDaylight routines public --- MAPL_Base/MAPL_sun_uc.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/MAPL_Base/MAPL_sun_uc.F90 b/MAPL_Base/MAPL_sun_uc.F90 index 1c1bd5ee276c..9189814516a7 100644 --- a/MAPL_Base/MAPL_sun_uc.F90 +++ b/MAPL_Base/MAPL_sun_uc.F90 @@ -38,6 +38,8 @@ module MAPL_SunMod public MAPL_SunOrbitQuery public MAPL_SunGetInsolation public MAPL_SunGetSolarConstant + public MAPL_SunGetDaylightDuration + public MAPL_SunGetDaylightDurationMax ! !PUBLIC TYPES: From d651b7df2dba777673aac71f3e532f7a2cac36d0 Mon Sep 17 00:00:00 2001 From: Peter Norris Date: Thu, 5 Mar 2020 09:09:35 -0500 Subject: [PATCH 042/109] Remove lines in this branch but not in develop --- MAPL_Base/MAPL_Generic.F90 | 29 +---------------------------- 1 file changed, 1 insertion(+), 28 deletions(-) diff --git a/MAPL_Base/MAPL_Generic.F90 b/MAPL_Base/MAPL_Generic.F90 index 93b31589ca97..87bc3148ceaf 100644 --- a/MAPL_Base/MAPL_Generic.F90 +++ b/MAPL_Base/MAPL_Generic.F90 @@ -1957,7 +1957,7 @@ recursive subroutine MAPL_GenericFinalize ( GC, IMPORT, EXPORT, CLOCK, RC ) character(len=ESMF_MAXSTR) :: CHILD_NAME character(len=ESMF_MAXSTR) :: RECFIN type (MAPL_MetaComp), pointer :: STATE - integer :: I,j + integer :: I logical :: final_checkpoint integer :: NC integer :: PHASE @@ -2867,7 +2867,6 @@ subroutine MAPL_InternalStateRetrieve(GC, MAPLOBJ, RC) ! ErrLog Variables - character(len=ESMF_MAXSTR) :: IAm="MAPL_InternalStateRetrieve" integer :: STATUS ! Local variables @@ -3528,11 +3527,9 @@ subroutine MAPL_GridCompSetEntryPoint(GC, registeredMethod, usersRoutine, RC) !EOPI integer :: status - character(len=ESMF_MAXSTR) :: IAm type (MAPL_MetaComp), pointer :: META integer :: phase - integer :: phase0, phase1 call MAPL_InternalStateRetrieve( GC, META, RC=STATUS) _VERIFY(STATUS) @@ -4306,7 +4303,6 @@ recursive integer function MAPL_AddChildFromMeta(META, NAME, GRID, & integer, optional , intent( OUT) :: rc !EOPI - character(len=ESMF_MAXSTR) :: IAm='MAPL_AddChildFromMeta' integer :: STATUS integer :: I @@ -6205,8 +6201,6 @@ subroutine MAPL_StateGetVarSpecs(STATE,IMPORT,EXPORT,INTERNAL,RC) ! ! ErrLog Variables - character(len=ESMF_MAXSTR) :: IAm='MAPL_StateGetVarSpec' - ! Begin ! Get the specs for the 3 ESMF states @@ -7009,7 +7003,6 @@ subroutine MAPL_FriendlyGet ( GC, NAME, FIELD, REQUESTOR, RC ) ! ! ErrLog Variables - character(len=ESMF_MAXSTR) :: IAm='MAPL_FriendlyGet' integer :: STATUS ! Local variables @@ -7125,7 +7118,6 @@ subroutine MAPL_GridCompGetFriendlies0 ( GC, TO, BUNDLE, AddGCPrefix, RC ) ! ! ErrLog Variables - character(len=ESMF_MAXSTR) :: IAm='MAPL_GridCompGetFriendlies0' integer :: STATUS ! Local variables @@ -7402,7 +7394,6 @@ subroutine MAPL_GridCompGetFriendlies2 ( GC, TO, BUNDLE, AddGCPrefix, RC ) ! ! ErrLog Variables - character(len=ESMF_MAXSTR) :: IAm='MAPL_GridCompGetFriendlies2' integer :: STATUS, I character(len=ESMF_MAXSTR) :: TO_(1) @@ -7429,7 +7420,6 @@ subroutine MAPL_GridCompGetFriendlies3 ( GC, TO, BUNDLE, AddGCPrefix, RC ) ! ! ErrLog Variables - character(len=ESMF_MAXSTR) :: IAm='MAPL_GridCompGetFriendlies3' integer :: STATUS, I do I=1,size(GC) @@ -7450,7 +7440,6 @@ subroutine MAPL_SetVarSpecForCC(gcA, gcB, ccAxB, rc) integer, optional, intent( out) :: RC ! Error code: ! Local vars - character(len=ESMF_MAXSTR) :: Iam="MAPL_SetVarSpecForCC" character(len=ESMF_MAXSTR) :: NAME integer :: STATUS integer :: I, N, STAT @@ -8494,7 +8483,6 @@ subroutine MAPL_ReadForcing1(STATE,NAME,DATAFILE,CURRENTTIME, & integer, optional, intent( OUT) :: RC !EOPI - character(len=ESMF_MAXSTR) :: IAm = "MAPL_ReadForcing1" integer :: STATUS call MAPL_ReadForcingX(STATE,NAME,DATAFILE,CURRENTTIME, & @@ -8524,7 +8512,6 @@ subroutine MAPL_ReadForcing2(STATE,NAME,DATAFILE,CURRENTTIME, & integer, optional, intent( OUT) :: RC !EOPI - character(len=ESMF_MAXSTR) :: IAm = "MAPL_ReadForcing2" integer :: STATUS call MAPL_ReadForcingX(STATE,NAME,DATAFILE,CURRENTTIME, & @@ -8552,7 +8539,6 @@ subroutine MAPL_ReadForcingX(MPL,NAME,DATAFILE,CURRTIME, & ! ErrLog Variables - character(len=ESMF_MAXSTR) :: IAm = "MAPL_ReadForcing" integer :: STATUS ! Locals @@ -9290,7 +9276,6 @@ subroutine MAPL_StateGetTimeStamp(STATE,NAME,TIME,RC) ! ErrLog Variables - character(len=ESMF_MAXSTR) :: IAm = "MAPL_StateGetTimeStamp" integer :: STATUS ! Locals @@ -9330,7 +9315,6 @@ subroutine MAPL_StateSetTimeStamp(STATE,NAME,TIME,RC) ! ErrLog Variables - character(len=ESMF_MAXSTR) :: IAm = "MAPL_StateSetTimeStamp" integer :: STATUS ! Locals @@ -9360,7 +9344,6 @@ subroutine MAPL_GenericMakeXchgNatural(STATE, RC) ! ErrLog Variables - character(len=ESMF_MAXSTR) :: IAm = "MAPL_GenericMakeXchgNatural" STATE%LOCSTREAM = STATE%ExchangeGrid @@ -9386,7 +9369,6 @@ subroutine MAPL_GridCreate(GC, MAPLOBJ, ESMFGRID, srcGC, rc) integer :: nn,ny character(len=ESMF_MAXSTR) :: GridName character(len=2) :: dateline - real(ESMF_KIND_R8), pointer :: R8D2(:,:) #ifdef CREATE_REGULAR_GRIDS logical :: isRegular #endif @@ -9502,7 +9484,6 @@ subroutine MAPL_GridCoordAdjustFromFile(GRID, GRIDSPECFILE, RC) ! local vars !------------ - character(len=ESMF_MAXSTR) :: IAm='MAPL_GridCoordAdjustFromFile' integer :: STATUS integer :: UNIT integer :: IM, JM @@ -9585,7 +9566,6 @@ recursive subroutine MAPL_GetRootGC(GC, rootGC, RC) integer, optional, intent(OUT) :: rc integer :: status - character(len=ESMF_MAXSTR) :: IAm type (MAPL_MetaComp), pointer :: META call MAPL_GetObjectFromGC(GC, META, RC=STATUS) @@ -9765,7 +9745,6 @@ function MAPL_GridGetSection(Grid, SectionMap, GridName, RC) result(SECTION) character(len=ESMF_MAXSTR) :: name integer :: status - character(len=ESMF_MAXSTR) :: Iam="MAPL_GridGetSection" call ESMF_GridGet(GRID, Name=Name, DistGrid=distgrid, dimCount=dimCount, RC=STATUS) _VERIFY(STATUS) @@ -9865,7 +9844,6 @@ subroutine MAPL_InternalGridSet(MYGRID, GRID, RC) type(ESMF_VM) :: vm integer :: status - character(len=ESMF_MAXSTR) :: Iam="MAPL_InternalGridSet" ! At this point, this component must have a valid grid! !------------------------------------------------------ @@ -10001,7 +9979,6 @@ recursive subroutine MAPL_GetAllExchangeGrids ( GC, LSADDR, RC ) integer :: status - character(len=ESMF_MAXSTR) :: Iam="MAPL_GetAllExchangeGrids" type (MAPL_MetaComp), pointer :: MAPLOBJ type (MAPL_LocStream) :: LocStream @@ -10071,7 +10048,6 @@ subroutine MAPL_DoNotAllocateImport(GC, NAME, notFoundOK, RC) integer, optional, intent( OUT) :: RC ! Return code integer :: status - character(len=ESMF_MAXSTR) :: Iam="MAPL_DoNotAllocateImport" type (MAPL_MetaComp), pointer :: MAPLOBJ type (MAPL_VarSpec), pointer :: SPEC(:) => null() @@ -10097,7 +10073,6 @@ subroutine MAPL_DoNotAllocateInternal(GC, NAME, notFoundOK, RC) integer, intent( OUT) :: RC ! Return code integer :: status - character(len=ESMF_MAXSTR) :: Iam="MAPL_DoNotAllocateInternal" type (MAPL_MetaComp), pointer :: MAPLOBJ type (MAPL_VarSpec), pointer :: SPEC(:) @@ -10121,7 +10096,6 @@ subroutine MAPL_DoNotAllocateVar(SPEC, NAME, notFoundOK, RC) integer, optional, intent( OUT) :: RC ! Return code integer :: status - character(len=ESMF_MAXSTR) :: Iam="MAPL_DoNotAllocateVar" integer :: I logical :: notFoundOK_ @@ -10160,7 +10134,6 @@ subroutine ArrDescrSetNCPar(ArrDes, MPL, tile, offset, num_readers, num_writers, logical :: tile_loc type(ESMF_Grid) :: TILEGRID character(len=MPI_MAX_INFO_VAL) :: romio_cb_read,cb_buffer_size,romio_cb_write - character(len=ESMF_MAXSTR) :: Iam="ArrDescrSetNCPar" if (present(tile)) then tile_loc=tile From 07e912aaa408a75a4ff570fcdd5b44e468c6d9e5 Mon Sep 17 00:00:00 2001 From: Peter Norris Date: Thu, 5 Mar 2020 09:17:21 -0500 Subject: [PATCH 043/109] Add to CHANGELOG --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index e85f6f7c40ad..529666c89752 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -30,6 +30,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Added configuration for CircleCI - Builds MAPL using GCC 9.2.0 and Open MPI 4.0.2 - Builds and runs `pFIO_tests` and `MAPL_Base_tests` +- Add precession of equinox (not on by default) ## [2.0.1] - 2019-03-02 From cb422f85e03767d7baa4d935c34859ea3c2c9fb4 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Thu, 5 Mar 2020 09:55:18 -0500 Subject: [PATCH 044/109] cleanup --- MAPL_Base/MAPL_VerticalGrid.F90 | 82 +-- MAPL_Base/write_eta.F90 | 963 -------------------------------- 2 files changed, 26 insertions(+), 1019 deletions(-) delete mode 100644 MAPL_Base/write_eta.F90 diff --git a/MAPL_Base/MAPL_VerticalGrid.F90 b/MAPL_Base/MAPL_VerticalGrid.F90 index 814fd25f9bd3..416464703acf 100644 --- a/MAPL_Base/MAPL_VerticalGrid.F90 +++ b/MAPL_Base/MAPL_VerticalGrid.F90 @@ -20,14 +20,13 @@ module MAPL_VerticalGrid real(kind=REAL64), allocatable :: bk(:) integer :: ks integer :: num_levels = 0 - logical :: use_sigma_levels = .false. - logical :: use_ncep_levels = .false. + real(kind=REAL64) :: ref_pressure contains - procedure :: set_eta_r8 - procedure :: set_eta_r4 + procedure :: get_eta_r8 + procedure :: get_eta_r4 procedure :: get_pressure_levels_r8 procedure :: get_pressure_levels_r4 - generic :: set_eta =>set_eta_r8, set_eta_r4 + generic :: get_eta =>get_eta_r8, get_eta_r4 generic :: get_pressure_levels=>get_pressure_levels_r8, get_pressure_levels_r4 end type VerticalGrid @@ -36,19 +35,18 @@ module MAPL_VerticalGrid module procedure new_VerticalGrid_by_cfg end interface - real(kind=REAL64), parameter :: DEFAULT_REFENCE_PRESSURE = 98400.d0 ! Pa + real(kind=REAL64), parameter :: DEFAULT_REFERENCE_PRESSURE = 98400.d0 ! default reference pressure contains - function new_VerticalGrid_by_ak_bk(ak, bk, ks, unused, use_sigma_levels, use_ncep_levels, rc) result(grid) + function new_VerticalGrid_by_ak_bk(ak, bk, ks, unused, ref_pressure, rc) result(grid) type (VerticalGrid) :: grid real(kind=REAL64), intent(in) :: ak(:) real(kind=REAL64), intent(in) :: bk(:) integer, intent(in) :: ks class(KeywordEnforcer), optional, intent(in) :: unused - logical, optional,intent(in) :: use_sigma_levels - logical, optional,intent(in) :: use_ncep_levels + real(kind=REAL64),optional, intent(in) :: ref_pressure integer, optional, intent(inout) :: rc character(len=*), parameter :: Iam="new_VerticalGrid_by_ak_bk" @@ -59,60 +57,35 @@ function new_VerticalGrid_by_ak_bk(ak, bk, ks, unused, use_sigma_levels, use_nce grid%ak = ak grid%bk = bk grid%ks = ks + grid%num_levels = size(ak) - 1 - if (present(use_sigma_levels)) then - grid%use_sigma_levels = use_sigma_levels - else - grid%use_sigma_levels = .false. - end if - - if (present(use_ncep_levels)) then - grid%use_ncep_levels = use_ncep_levels + if (present(ref_pressure)) then + grid%ref_pressure = ref_pressure else - grid%use_ncep_levels = .false. + grid%ref_pressure = DEFAULT_REFERENCE_PRESSURE end if - grid%num_levels = size(ak) - 1 end function new_VerticalGrid_by_ak_bk - function new_VerticalGrid_by_cfg(config, unused, reference_pressure, rc) result(grid) + function new_VerticalGrid_by_cfg(config, unused, rc) result(grid) type (VerticalGrid) :: grid type (ESMF_Config) :: config class (KeywordEnforcer), optional, intent(in) :: unused - real(kind=REAL64), optional, intent(in) :: reference_pressure integer, optional, intent(inout) :: rc - logical :: use_sigma_levels - logical :: use_ncep_levels real(kind=REAL64), allocatable :: ak(:) real(kind=REAL64), allocatable :: bk(:) integer :: k,ks, num_levels - real(kind=REAL64) :: ptop, pint + real(kind=REAL64) :: ptop, pint, ref_pressure character(len=32) :: data_label character(len=*), parameter :: Iam="new_VerticalGrid_by_cfg" - call ESMF_ConfigGetAttribute(config, num_levels,label='NUM_LEVELS:', default = 0, rc=rc) - call ESMF_ConfigGetAttribute(config, use_sigma_levels, label='USE_SIGMA_LEVELS:', default=.false., rc=rc) - call ESMF_ConfigGetAttribute(config, use_ncep_levels, label='USE_NCEP_LEVELS:', default=.false., rc=rc) - - data_label = "levels_"//i_to_string(num_levels)//":" - if(use_sigma_levels) then - _ASSERT(num_levels==64, "sigma only 64 levels") - data_label = "sigma_levels_64:" - _ASSERT( .not. use_ncep_levels, "64 .or. 72") - endif - - if(use_ncep_levels) then - _ASSERT(num_levels==72, "ncep_gmao 72 levels") - data_label = "ncep_levels_72:" - endif -#ifdef _BETA3P1_N_EARLIER_ - _ASSERT( .not. use_ncep_levels, " not ncep grid") - _ASSERT( .not. use_sigma_levels, " not sigma grid") - _ASSERT(num_levels==72, " _BETA3P1_N_EARLIER_ is defines") - eta_lable = "BETA3P1_levels_72:" -#endif + call ESMF_ConfigGetAttribute(config, num_levels,label='NUM_LEVELS:', rc=rc) + call ESMF_ConfigGetAttribute(config, ref_pressure,label='REF_PRESSURE:', default = DEFAULT_REFERENCE_PRESSURE, rc=rc) + call ESMF_ConfigGetAttribute(config, ks,label='TRANSIT_TO_P:', rc=rc) + + data_label = "ak-bk:" allocate(ak(num_levels+1), bk(num_levels+1)) @@ -124,15 +97,12 @@ function new_VerticalGrid_by_cfg(config, unused, reference_pressure, rc) result( call ESMF_ConfigGetAttribute(config, ak(k), rc=rc) call ESMF_ConfigGetAttribute(config, bk(k), rc=rc) enddo - ! the last row is ks for pint = ak(ks+1) - call ESMF_ConfigNextLine(config, rc=rc) - call ESMF_ConfigGetAttribute(config, ks, rc=rc) - grid = VerticalGrid(ak, bk, ks, use_sigma_levels, use_ncep_levels) + grid = VerticalGrid(ak, bk, ks, ref_pressure=ref_pressure) end function new_VerticalGrid_by_cfg - subroutine set_eta_r8(this, km, ks, ptop, pint, ak, bk, unused,rc) + subroutine get_eta_r8(this, km, ks, ptop, pint, ak, bk, unused,rc) class(VerticalGrid), intent(in) :: this integer, intent(in) :: km integer, intent(out) :: ks @@ -155,9 +125,9 @@ subroutine set_eta_r8(this, km, ks, ptop, pint, ak, bk, unused,rc) _RETURN(_SUCCESS) - end subroutine set_eta_r8 + end subroutine get_eta_r8 - subroutine set_eta_r4(this, km, ks, ptop, pint, ak, bk, unused,rc) + subroutine get_eta_r4(this, km, ks, ptop, pint, ak, bk, unused,rc) class(VerticalGrid), intent(in) :: this integer, intent(in) :: km integer, intent(out) :: ks @@ -180,7 +150,7 @@ subroutine set_eta_r4(this, km, ks, ptop, pint, ak, bk, unused,rc) allocate(ak8(km+1)) allocate(bk8(km+1)) - call this%set_eta(km, ks, ptop8, pint8, ak8, bk8) + call this%get_eta(km, ks, ptop8, pint8, ak8, bk8) ak = real(ak8, kind=REAL32) bk = real(bk8, kind=REAL32) @@ -190,7 +160,7 @@ subroutine set_eta_r4(this, km, ks, ptop, pint, ak, bk, unused,rc) deallocate(ak8,bk8) _RETURN(_SUCCESS) - end subroutine set_eta_r4 + end subroutine get_eta_r4 subroutine get_pressure_levels_r8(this, pressure_levels, unused, reference_pressure, rc) class(VerticalGrid), intent(in) :: this @@ -208,7 +178,7 @@ subroutine get_pressure_levels_r8(this, pressure_levels, unused, reference_press if (present(reference_pressure)) then p0 = reference_pressure else - p0 = DEFAULT_REFENCE_PRESSURE + p0 = DEFAULT_REFERENCE_PRESSURE end if pressure_levels(1) = this%ak(1) + 0.50d0 * dpref_(1,p0) @@ -246,7 +216,7 @@ subroutine get_pressure_levels_r4(this, pressure_levels, unused, reference_press if (present(reference_pressure)) then p0 = reference_pressure else - p0 = DEFAULT_REFENCE_PRESSURE + p0 = DEFAULT_REFERENCE_PRESSURE end if allocate(plevels(n_levels)) diff --git a/MAPL_Base/write_eta.F90 b/MAPL_Base/write_eta.F90 deleted file mode 100644 index 02549ee8c6fa..000000000000 --- a/MAPL_Base/write_eta.F90 +++ /dev/null @@ -1,963 +0,0 @@ -! -! This same files resides in 2 different standard places, with different names: -! -! shared/hermes/m_set_eta.F90 -! fvgcm/misc/set_eta.F90 -! -! When compiled under Hermes it becomes a module; otherwise it is a regular -! f77 routine. -! -! !HISTORY: -! 18May2005 Todling added (un)set_sigma routines to allow sigma levs setup -! 13Jun2005 Todling defined new 72-eta levs (gAdas-1_5beta3p2 and later) -! 17Apr2006 Elena N. 72-lev bug fix for ks definition -! ?????2008 Ravi Added 91 levs for ECMWF Nature run -! 13Oct2008 Todling Ravi's addition using wrong version of this file (fixed) -! 24Nov2008 Takacs/RT Fix ks for ECMWF 91 level-case -! 31Jul2009 Ravi Updated NCEP 64 Layer ak and bk (source Dr.da silva Arlindo) -! 20Oct2009 Todling Multiplied NCEP 64 ak levels by 10 (should be in Pa) -! 07Jul2012 Todling Create a 72-level set from NCEP's 64-level set -! 04Apr2018 Todling Overload for r4/r8 support -! -program write_eta - use, intrinsic :: iso_fortran_env, only: REAL32, REAL64 - implicit none - - logical :: SIGMA_LEVS = .false. ! controls whether levs are sigma or eta - logical :: NCEP72_4GMAO= .false. ! controls whether levs are 72, but largely as NCEP's 64 - - -! Choices for vertical resolutions are as follows: -! NCAR: 18, 26, and 30 -! NASA DAO: smoothed version of CCM4's 30-level, 32, 48, 55 -! Revised 32-layer setup with top at 0.4 mb for high horizontal -! resolution runs. (sjl: 04/01/2002) -! Revised 55-level eta with pint at 176.93 mb SJL: 2000-03-20 -! -! NCEP 64-level sigma and hybrid eta - -! NCAR specific - real(REAL64) a18(19),b18(19) ! CCM3 - real(REAL64) a26(27),b26(27) ! CCM4 - real(REAL64) a30(31),b30(31) ! CCM4 - -! NASA only - real(REAL64) a01(2),b01(2) ! to allow single-level utils to rely on sim code - real(REAL64) a30m(31),b30m(31) ! smoothed CCM4 30-L - real(REAL64) a32(33),b32(33) - real(REAL64) a44(45),b44(45) - real(REAL64) a48(49),b48(49) - real(REAL64) a55(56),b55(56) - real(REAL64) a72(73),b72(73) ! geos-5 - real(REAL64) a91(92),b91(92) ! Nature EC - real(REAL64) a96(97),b96(97) ! not sure - real(REAL64) a72_ncep(73),b72_ncep(73) ! mainly NCEP's 64 with the GMAO-72 top levels - real(REAL64) a72_BETA3P1(73),b72_BETA3P1(73) - real(REAL64) a137(138), b137(138) - real(REAL64) a144(145), b144(145) - real(REAL64) a132(133), b132(133) - -! NCEP - real(REAL64) a64(65),b64(65), a64_sig(65),b64_sig(65) - - integer ks, k, km - !real(REAL64) ak(km+1),bk(km+1) - real(REAL64) ptop ! model top (Pa) - real(REAL64) pint ! transition to p (Pa) - -! *** NCAR settings *** - - data a18 /291.70, 792.92, 2155.39, 4918.34, 8314.25, & - 7993.08, 7577.38, 7057.52, 6429.63, 5698.38, & - 4879.13, 3998.95, 3096.31, 2219.02, 1420.39, & - 754.13, 268.38, 0.0000, 0.0000 / - - data b18 /0.0000, 0.0000, 0.0000, 0.0000, 0.0000, & - 0.0380541, 0.0873088, 0.1489307, 0.2232996, & - 0.3099406, 0.4070096, 0.5112977, 0.6182465, & - 0.7221927, 0.8168173, 0.8957590, 0.9533137, & - 0.9851122, 1.0 / - - data a26 /219.4067, 489.5209, 988.2418, 1805.201, & - 2983.724, 4462.334, 6160.587, 7851.243, & - 7731.271, 7590.131, 7424.086, 7228.744, & - 6998.933, 6728.574, 6410.509, 6036.322, & - 5596.111, 5078.225, 4468.96, 3752.191, & - 2908.949, 2084.739, 1334.443, 708.499, & - 252.136, 0., 0. / - - data b26 /0., 0., 0., 0., & - 0., 0., 0., 0., & - 0.01505309, 0.03276228, 0.05359622, 0.07810627, & - 0.1069411, 0.14086370, 0.180772, 0.227722, & - 0.2829562, 0.3479364, 0.4243822, 0.5143168, & - 0.6201202, 0.7235355, 0.8176768, 0.8962153, & - 0.9534761, 0.9851122, 1. / - - data a30 /225.523952394724, 503.169186413288, 1015.79474285245, & - 1855.53170740604, 3066.91229343414, 4586.74766123295, & - 6332.34828710556, 8070.14182209969, 9494.10423636436, & - 11169.321089983, 13140.1270627975, 15458.6806893349, & - 18186.3352656364, 17459.799349308, 16605.0657629967, & - 15599.5160341263, 14416.541159153, 13024.8308181763, & - 11387.5567913055, 9461.38575673103, 7534.44507718086, & - 5765.89405536652, 4273.46378564835, 3164.26791250706, & - 2522.12174236774, 1919.67375576496, 1361.80268600583, & - 853.108894079924, 397.881818935275, 0., & - 0. / - - data b30 /0., 0., & - 0., 0., 0., & - 0., 0., 0., & - 0., 0., 0., & - 0., 0., 0.03935482725501, & - 0.085653759539127, 0.140122056007385, 0.20420117676258, & - 0.279586911201477, 0.368274360895157, 0.47261056303978, & - 0.576988518238068, 0.672786951065063, 0.75362843275070, & - 0.813710987567902, 0.848494648933411, 0.88112789392471, & - 0.911346435546875, 0.938901245594025, 0.96355980634689, & - 0.985112190246582, 1. / - -! *** NASA DAO settings *** - -! Smoothed CCM4's 30-Level setup - data a30m / 300.00000, 725.00000, 1500.00000, & - 2600.00000, 3800.00000, 5050.00000, & - 6350.00000, 7750.00000, 9300.00000, & - 11100.00000, 13140.00000, 15458.00000, & - 18186.33580, 20676.23761, 22275.23783, & - 23025.65071, 22947.33569, 22038.21991, & - 20274.24578, 17684.31619, 14540.98138, & - 11389.69990, 8795.97971, 6962.67963, & - 5554.86684, 4376.83633, 3305.84967, & - 2322.63910, 1437.78398, 660.76994, & - 0.00000 / - - data b30m / 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00719, 0.02895, & - 0.06586, 0.11889, 0.18945, & - 0.27941, 0.38816, 0.50692, & - 0.61910, 0.70840, 0.77037, & - 0.81745, 0.85656, 0.89191, & - 0.92421, 0.95316, 0.97850, & - 1.00000 / - - data a32/40.00000, 106.00000, 224.00000, & - 411.00000, 685.00000, 1065.00000, & - 1565.00000, 2179.80000, 2900.00000, & - 3680.00000, 4550.00000, 5515.00000, & - 6607.00000, 7844.00000, 9236.56616, & - 10866.34280, 12783.70000, 15039.29900, & - 17693.00000, 20815.20900, 24487.49020, & - 28808.28710, 32368.63870, 33739.96480, & - 32958.54300, 30003.29880, 24930.12700, & - 18568.89060, 12249.20510, 6636.21191, & - 2391.51416, 0.00000, 0.00000 / - - data b32/ 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.01523, 0.06132, & - 0.13948, 0.25181, 0.39770, & - 0.55869, 0.70853, 0.83693, & - 0.93208, 0.98511, 1.00000 / - - data a48/40.00000, 100.00000, 200.00000, & - 350.00000, 550.00000, 800.00000, & - 1085.00000, 1390.00000, 1720.00000, & - 2080.00000, 2470.00000, 2895.00000, & - 3365.00000, 3890.00000, 4475.00000, & - 5120.00000, 5830.00000, 6608.00000, & - 7461.00000, 8395.00000, 9424.46289, & - 10574.46900, 11864.80330, 13312.58850, & - 14937.03770, 16759.70760, 18804.78670, & - 21099.41250, 23674.03720, 26562.82650, & - 29804.11680, 32627.31601, 34245.89759, & - 34722.29104, 34155.20062, 32636.50533, & - 30241.08406, 27101.45052, 23362.20912, & - 19317.04955, 15446.17194, 12197.45091, & - 9496.39912, 7205.66920, 5144.64339, & - 3240.79521, 1518.62245, 0.00000, & - 0.00000 / - - data b48/0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00813, 0.03224, & - 0.07128, 0.12445, 0.19063, & - 0.26929, 0.35799, 0.45438, & - 0.55263, 0.64304, 0.71703, & - 0.77754, 0.82827, 0.87352, & - 0.91502, 0.95235, 0.98511, & - 1.00000 / - - data a55/ 1.00000, 2.00000, 3.27000, & - 4.75850, 6.60000, 8.93450, & - 11.97030, 15.94950, 21.13490, & - 27.85260, 36.50410, 47.58060, & - 61.67790, 79.51340, 101.94420, & - 130.05080, 165.07920, 208.49720, & - 262.02120, 327.64330, 407.65670, & - 504.68050, 621.68000, 761.98390, & - 929.29430, 1127.68880, 1364.33920, & - 1645.70720, 1979.15540, 2373.03610, & - 2836.78160, 3380.99550, 4017.54170, & - 4764.39320, 5638.79380, 6660.33770, & - 7851.22980, 9236.56610, 10866.34270, & - 12783.70000, 15039.30000, 17693.00000, & - 20119.20876, 21686.49129, 22436.28749, & - 22388.46844, 21541.75227, 19873.78342, & - 17340.31831, 13874.44006, 10167.16551, & - 6609.84274, 3546.59643, 1270.49390, & - 0.00000, 0.00000 / - - data b55 /0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00696, 0.02801, 0.06372, & - 0.11503, 0.18330, 0.27033, & - 0.37844, 0.51046, 0.64271, & - 0.76492, 0.86783, 0.94329, & - 0.98511, 1.00000 / - - -! NCEP's 64 sigma layers - - data a64_sig/1.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000 / - - data b64_sig/0.00000 , 6.419999991E-4, 1.378000015E-3, & - 2.219999908E-3, 3.183000023E-3, 4.284000024E-3, & - 5.54399984E-3 , 6.984999869E-3, 8.631000295E-3, & - 1.051099971E-2, 1.265799999E-2, 1.510700025E-2, & - 1.790099964E-2, 2.108399943E-2, 2.470799908E-2, & - 2.882999927E-2, 3.351499885E-2, 3.883099928E-2, & - 4.485499859E-2, 5.167099833E-2, 5.936999992E-2, & - 6.804899871E-2, 7.780800015E-2, 8.875600249E-2, & - 0.101002 , 0.114655003 , 0.129822999 , & - 0.146607995 , 0.165098995 , 0.185371995 , & - 0.207481995 , 0.231454 , 0.257283986 , & - 0.284927994 , 0.314300001 , 0.345268995 , & - 0.377658993 , 0.411249012 , 0.445778012 , & - 0.480955005 , 0.516462982 , 0.551973999 , & - 0.587159991 , 0.621704996 , 0.655315995 , & - 0.687731028 , 0.718729019 , 0.748133004 , & - 0.775811017 , 0.801676989 , 0.825685024 , & - 0.847829998 , 0.868139029 , 0.88666302 , & - 0.903479993 , 0.918677986 , 0.932359993 , & - 0.94463098 , 0.955603004 , 0.96538502 , & - 0.974083006 , 0.98180002 , 0.988632023 , & - 0.994670987 , 1.0 / - - -! data a64/1.00000, 3.90000, 8.70000, & -! 15.42000, 24.00000, 34.50000, & -! 47.00000, 61.50000, 78.60000, & -! 99.13500, 124.12789, 154.63770, & -! 191.69700, 236.49300, 290.38000, & -! 354.91000, 431.82303, 523.09300, & -! 630.92800, 757.79000, 906.45000, & -! 1079.85000, 1281.00000, 1515.00000, & -! 1788.00000, 2105.00000, 2470.00000, & -! 2889.00000, 3362.00000, 3890.00000, & -! 4475.00000, 5120.00000, 5830.00000, & -! 6608.00000, 7461.00000, 8395.00000, & -! 9424.46289, 10574.46880, 11864.80270, & -! 13312.58890, 14937.03710, 16759.70700, & -! 18804.78710, 21099.41210, 23674.03710, & -! 26562.82810, 29804.11720, 32627.31640, & -! 34245.89840, 34722.28910, 34155.19920, & -! 32636.50390, 30241.08200, 27101.44920, & -! 23362.20700, 19317.05270, 15446.17090, & -! 12197.45210, 9496.39941, 7205.66992, & -! 5144.64307, 3240.79346, 1518.62134, & -! 0.00000, 0.00000 / - - -! data b64/0.00000, 0.00000, 0.00000, & -! 0.00000, 0.00000, 0.00000, & -! 0.00000, 0.00000, 0.00000, & -! 0.00000, 0.00000, 0.00000, & -! 0.00000, 0.00000, 0.00000, & -! 0.00000, 0.00000, 0.00000, & -! 0.00000, 0.00000, 0.00000, & -! 0.00000, 0.00000, 0.00000, & -! 0.00000, 0.00000, 0.00000, & -! 0.00000, 0.00000, 0.00000, & -! 0.00000, 0.00000, 0.00000, & -! 0.00000, 0.00000, 0.00000, & -! 0.00000, 0.00000, 0.00000, & -! 0.00000, 0.00000, 0.00000, & -! 0.00000, 0.00000, 0.00000, & -! 0.00000, 0.00000, 0.00813, & -! 0.03224, 0.07128, 0.12445, & -! 0.19063, 0.26929, 0.35799, & -! 0.45438, 0.55263, 0.64304, & -! 0.71703, 0.77754, 0.82827, & -! 0.87352, 0.91502, 0.95235, & -! 0.98511, 1.00000 / - -! NCEP updated ak and bk. - - data a64/ 0.000000, 64.24700, 137.78999, & - 221.95799, 318.26601, 428.43403, & - 554.42398, 698.45703, 863.05794, & - 1051.08002, 1265.75195, 1510.71091, & - 1790.05096, 2108.36609, 2470.78796, & - 2883.03802, 3351.45996, 3883.05206, & - 4485.49316, 5167.14600, 5937.04956, & - 6804.87366, 7777.15027, 8832.53662, & - 9936.61377, 11054.85352, 12152.93701, & - 13197.06543, 14154.31641, 14993.07495, & - 15683.48877, 16197.96753, 16511.73584, & - 16611.60522, 16503.14575, 16197.31567, & - 15708.89282, 15056.34155, 14261.43433, & - 13348.67065, 12344.48975, 11276.34766, & - 10171.71204, 9057.05078, 7956.90796, & - 6893.11707, 5884.20593, 4945.02869, & - 4086.61407, 3316.21704, 2637.55310, & - 2051.15005, 1554.78897, 1143.98804, & - 812.48894, 552.71999, 356.22299, & - 214.01501, 116.89899, 55.71200, & - 21.51600, 5.741000, 0.575000, & - 0.000000, 0.000000 / - - data b64/0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.000036970, 0.00043106, & - 0.0016359, 0.0041067, 0.0082940, & - 0.014637, 0.023556, 0.035442, & - 0.050647, 0.069475, 0.092167, & - 0.11881, 0.14927, 0.18330, & - 0.22057, 0.26069, 0.30316, & - 0.34747, 0.39302, 0.43921, & - 0.48544, 0.53113, 0.57575, & - 0.61880, 0.65989, 0.69868, & - 0.73495, 0.76851, 0.79931, & - 0.82732, 0.85259, 0.87522, & - 0.89535, 0.91315, 0.92880, & - 0.94249, 0.95443, 0.96483, & - 0.97387, 0.98174, 0.98863, & - 0.99467, 1.00000/ - -! NCEP levels adapted to 72-level GMAO-like: -! all levels below ak=137.78999 are identical to the 64-NCEP levels -! levels above that were fix as top=gmao-72, and others interpololated -! somewhat at will (RTodling) - - data a72_ncep/ 1.0000000, 2.6350000, & - 5.6792510, 10.452402, 13.959903, & - 18.542203, 24.493755, 42.042359, & - 70.595662, 101.94402, 137.78999, & - 221.95799, 318.26601, 428.43403, & - 554.42398, 698.45703, 863.05794, & - 1051.08002, 1265.75195, 1510.71091, & - 1790.05096, 2108.36609, 2470.78796, & - 2883.03802, 3351.45996, 3883.05206, & - 4485.49316, 5167.14600, 5937.04956, & - 6804.87366, 7777.15027, 8832.53662, & - 9936.61377, 11054.85352, 12152.93701, & - 13197.06543, 14154.31641, 14993.07495, & - 15683.48877, 16197.96753, 16511.73584, & - 16611.60522, 16503.14575, 16197.31567, & - 15708.89282, 15056.34155, 14261.43433, & - 13348.67065, 12344.48975, 11276.34766, & - 10171.71204, 9057.05078, 7956.90796, & - 6893.11707, 5884.20593, 4945.02869, & - 4086.61407, 3316.21704, 2637.55310, & - 2051.15005, 1554.78897, 1143.98804, & - 812.48894, 552.71999, 356.22299, & - 214.01501, 116.89899, 55.71200, & - 21.51600, 5.741000, 0.575000, & - 0.000000, 0.000000 / - - data b72_ncep/0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.000036970, 0.00043106, & - 0.0016359, 0.0041067, 0.0082940, & - 0.014637, 0.023556, 0.035442, & - 0.050647, 0.069475, 0.092167, & - 0.11881, 0.14927, 0.18330, & - 0.22057, 0.26069, 0.30316, & - 0.34747, 0.39302, 0.43921, & - 0.48544, 0.53113, 0.57575, & - 0.61880, 0.65989, 0.69868, & - 0.73495, 0.76851, 0.79931, & - 0.82732, 0.85259, 0.87522, & - 0.89535, 0.91315, 0.92880, & - 0.94249, 0.95443, 0.96483, & - 0.97387, 0.98174, 0.98863, & - 0.99467, 1.00000/ - - - - data a72_BETA3P1 / & - 1.00000, 2.00000, 3.27000, 4.75850, 6.60000, 8.93450, & - 11.9703, 15.9495, 21.1349, 27.8526, 36.5041, 47.5806, & - 61.6779, 79.5134, 101.944, 130.051, 165.079, 208.497, & - 262.021, 327.643, 407.657, 504.680, 621.680, 761.984, & - 929.294, 1127.69, 1364.34, 1645.71, 1979.16, 2373.04, & - 2836.78, 3381.00, 4017.54, 4764.39, 5638.79, 6660.34, & - 7851.23, 9236.57, 10866.3, 12783.7, 15039.3, 17693.0, & - 20119.2, 21686.5, 22436.3, 22389.8, 21877.6, 21215.0, & - 20325.9, 19309.7, 18161.9, 16960.9, 15626.0, 14291.0, & - 12869.6, 11409.0, 9936.52, 8909.99, 7883.42, 6856.90, & - 5805.32, 5169.61, 4533.90, 3898.20, 3257.08, 2609.20, & - 1961.31, 1313.48, 659.375, 332.086, 4.80469, 0.00000, & - 0.00000 / - - data b72_BETA3P1 / & - 0.00000, 0.00000, 0.00000, 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, 0.00000, 0.00000, 0.00000, & - 0.00696000, 0.0280100, 0.0637200, 0.113602, 0.156224, 0.200350, & - 0.246741, 0.294403, 0.343381, 0.392891, 0.443740, 0.494590, & - 0.546304, 0.598410, 0.650635, 0.685900, 0.721166, 0.756431, & - 0.791947, 0.813304, 0.834661, 0.856018, 0.877429, 0.898908, & - 0.920387, 0.941865, 0.963406, 0.974179, 0.984952, 0.992500, & - 1.00000 / - - data a72 / & - 1.0000000, 2.0000002, 3.2700005, 4.7585009, 6.6000011, & - 8.9345014, 11.970302, 15.949503, 21.134903, 27.852606, & - 36.504108, 47.580610, 61.677911, 79.513413, 101.94402, & - 130.05102, 165.07903, 208.49704, 262.02105, 327.64307, & - 407.65710, 504.68010, 621.68012, 761.98417, 929.29420, & - 1127.6902, 1364.3402, 1645.7103, 1979.1604, 2373.0405, & - 2836.7806, 3381.0007, 4017.5409, 4764.3911, 5638.7912, & - 6660.3412, 7851.2316, 9236.5722, 10866.302, 12783.703, & - 15039.303, 17693.003, 20119.201, 21686.501, 22436.301, & - 22389.800, 21877.598, 21214.998, 20325.898, 19309.696, & - 18161.897, 16960.896, 15625.996, 14290.995, 12869.594, & - 11895.862, 10918.171, 9936.5219, 8909.9925, 7883.4220, & - 7062.1982, 6436.2637, 5805.3211, 5169.6110, 4533.9010, & - 3898.2009, 3257.0809, 2609.2006, 1961.3106, 1313.4804, & - 659.37527, 4.8048257, 0.0000000 / - - - data b72 / & - 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000, & - 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000, & - 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000, & - 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000, & - 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000, & - 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000, & - 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000, & - 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000, & - 0.0000000, 8.1754130e-09, 0.0069600246, 0.028010041, 0.063720063, & - 0.11360208, 0.15622409, 0.20035011, 0.24674112, 0.29440312, & - 0.34338113, 0.39289115, 0.44374018, 0.49459020, 0.54630418, & - 0.58104151, 0.61581843, 0.65063492, 0.68589990, 0.72116594, & - 0.74937819, 0.77063753, 0.79194696, 0.81330397, 0.83466097, & - 0.85601798, 0.87742898, 0.89890800, 0.92038701, 0.94186501, & - 0.96340602, 0.98495195, 1.0000000 / - - -! Fake single-level for util codes - mimic lowest lev of 72 GMAO case - data a01 / 4.8048257, 0.0000000 / - data b01 / 0.98495195, 1.0000000 / - -! ECMWF Nature -! - data a91/ 0.000000000000, 2.000040054321, 3.980832099915, 7.387186050415, & - 12.908319473267, 21.413604736328, 33.952865600586, 51.746597290039, & - 76.167663574219, 108.715560913086, 150.986022949219, 204.637451171875, & - 271.356445312500, 352.824462890625, 450.685791015625, 566.519287109375, & - 701.813232421875, 857.945800781250, & - 1036.166503906250, 1237.585449218750, 1463.163818359375, 1713.709716796875, & - 1989.874511718750, 2292.155517578125, 2620.898437500000, 2976.302246093750, & - 3358.425781250000, 3767.196044921875, 4202.417968750000, 4663.777343750000, & - 5150.859375000000, 5663.156250000000, 6199.839843750000, 6759.726562500000, & - 7341.468750000000, 7942.925781250000, 8564.625000000000, 9208.304687500000, & - 9873.562500000000, 10558.882812500000, 11262.484375000000, 11982.660156250000, & - 12713.898437500000, 13453.226562500000, 14192.011718750000, 14922.687500000000, & - 15638.054687500000, 16329.562500000000, 16990.625000000000, 17613.281250000000, & - 18191.031250000000, 18716.968750000000, 19184.546875000000, 19587.515625000000, & - 19919.796875000000, 20175.394531250000, 20348.917968750000, 20434.156250000000, & - 20426.218750000000, 20319.011718750000, 20107.031250000000, 19785.359375000000, & - 19348.777343750000, 18798.824218750000, 18141.296875000000, 17385.593750000000, & - 16544.585937500000, 15633.566406250000, 14665.644531250000, 13653.218750000000, & - 12608.382812500000, 11543.167968750000, 10471.312500000000, 9405.222656250000, & - 8356.253906250000, 7335.164062500000, 6353.921875000000, 5422.800781250000, & - 4550.214843750000, 3743.464355468750, 3010.146972656250, 2356.202636718750, & - 1784.854492187500, 1297.656250000000, 895.193603515625, 576.314208984375, & - 336.772460937500, 162.043426513672, 54.208343505859 , 6.575628280640, & - 0.003160000080, 0.000000000000/ - - data b91/ 0.000000000000, 0.000000000000, 0.000000000000, 0.000000000000, & - 0.000000000000, 0.000000000000, 0.000000000000, 0.000000000000, & - 0.000000000000, 0.000000000000, 0.000000000000, 0.000000000000, & - 0.000000000000, 0.000000000000, 0.000000000000, 0.000000000000, & - 0.000000000000, 0.000000000000, 0.000000000000, 0.000000000000, & - 0.000000000000, 0.000000000000, 0.000000000000, 0.000000000000, & - 0.000000000000, 0.000000000000, 0.000000000000, 0.000000000000, & - 0.000000000000, 0.000000000000, 0.000000000000, 0.000000000000, & - 0.000000000000, 0.000000000000, 0.000000272400, 0.000013911600, & - 0.000054667194, 0.000131364097, 0.000278884778, 0.000548384152, & - 0.001000134507, 0.001701075351, 0.002764719306, 0.004267048091, & - 0.006322167814, 0.009034991264, 0.012508261949, 0.016859579831, & - 0.022188644856, 0.028610348701, 0.036226909608, 0.045146133751, & - 0.055474229157, 0.067316174507, 0.080777287483, 0.095964074135, & - 0.112978994846, 0.131934821606, 0.152933537960, 0.176091074944, & - 0.201520144939, 0.229314863682, 0.259554445744, 0.291993439198, & - 0.326329410076, 0.362202584743, 0.399204790592, 0.436906337738, & - 0.475016415119, 0.513279736042, 0.551458477974, 0.589317142963, & - 0.626558899879, 0.662933588028, 0.698223590851, 0.732223808765, & - 0.764679491520, 0.795384764671, 0.824185431004, 0.850950419903, & - 0.875518381596, 0.897767245770, 0.917650938034, 0.935157060623, & - 0.950273811817, 0.963007092476, 0.973466038704, 0.982238113880, & - 0.989152967930, 0.994204163551, 0.997630119324, 1.000000000000/ - - - data a96/ 1.00000, 2.32782, 3.34990, & - 4.49484, 5.62336, 6.93048, & - 8.41428, 10.06365, 11.97630, & - 14.18138, 16.70870, 19.58824, & - 22.84950, 26.52080, 30.62845, & - 35.19588, 40.24273, 45.78375, & - 51.82793, 58.43583, 65.62319, & - 73.40038, 81.77154, 90.73373, & - 100.27628, 110.82243, 122.47773, & - 135.35883, 149.59464, 165.32764, & - 182.71530, 201.93164, 223.16899, & - 246.63988, 272.57922, 301.24661, & - 332.92902, 367.94348, 406.64044, & - 449.40720, 496.67181, 548.90723, & - 606.63629, 670.43683, 740.94727, & - 818.87329, 904.99493, 1000.17395, & - 1105.36304, 1221.61499, 1350.09326, & - 1492.08362, 1649.00745, 1822.43469, & - 2014.10168, 2225.92627, 2460.02905, & - 2718.75195, 3004.68530, 3320.69092, & - 3669.93066, 4055.90015, 4482.46240, & - 4953.88672, 5474.89111, 6050.68994, & - 6687.04492, 7390.32715, 8167.57373, & - 9026.56445, 9975.89648, 11025.06934, & - 12184.58398, 13466.04785, 14882.28320, & - 16447.46289, 18177.25781, 20088.97461, & - 21886.89453, 23274.16602, 24264.66602, & - 24868.31641, 25091.15430, 24935.41016, & - 24399.52148, 23478.13281, 22162.01758, & - 20438.00586, 18288.83984, 15693.01172, & - 12624.54199, 9584.35352, 6736.55713, & - 4231.34326, 2199.57910, 747.11890, & - 0.00000 / - - data b96/0.00000, 0.00000, 0.00000,& - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00000, 0.00000, 0.00000, & - 0.00315, 0.01263, 0.02853, & - 0.05101, 0.08030, 0.11669, & - 0.16055, 0.21231, 0.27249, & - 0.34169, 0.42062, 0.51005, & - 0.61088, 0.70748, 0.79593, & - 0.87253, 0.93400, 0.97764, & - 1.00000 / - -! ECMWF 91-Levels reduced to 44 -! ----------------------------- - data a44 / 2.000040 , 12.90832 , 33.95286 , 76.16766 , 150.9860 , & - 271.3565 , 450.6858 , 701.8134 , 1036.167 , 1463.164 , & - 1989.874 , 2620.898 , 3358.426 , 4202.417 , 5150.860 , & - 6199.839 , 7341.470 , 8564.624 , 9873.561 , 11262.48 , & - 12713.90 , 14192.01 , 15638.05 , 16990.62 , 18191.03 , & - 19184.54 , 19919.80 , 20348.92 , 20426.22 , 20107.03 , & - 19348.78 , 18141.30 , 16544.59 , 14665.65 , 12608.38 , & - 10471.31 , 8356.253 , 6353.921 , 4550.216 , 3010.147 , & - 1784.855 , 895.1935 , 336.7724 , 54.20834 , 0.0000000E+00 / - - data b44 / 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00 , & - 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00 , & - 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00, 0.0000000E+00 , & - 0.0000000E+00, 0.0000000E+00, 5.5000000E-05, 2.7900000E-04, 1.0000000E-03 , & - 2.7650001E-03, 6.3220002E-03, 1.2508000E-02, 2.2189001E-02, 3.6226999E-02 , & - 5.5473998E-02, 8.0776997E-02, 0.1129790 , 0.1529340 , 0.2015200 , & - 0.2595540 , 0.3263290 , 0.3992050 , 0.4750160 , 0.5514580 , & - 0.6265590 , 0.6982240 , 0.7646790 , 0.8241850 , 0.8755180 , & - 0.9176510 , 0.9502740 , 0.9734660 , 0.9891530 , 1.000000 / - - -! ECMWF 137-Levels -! -------------- - data a137 & - /1.000000, 2.000365, 3.102241, 4.666084, 6.827977, 9.746966, 13.605424, 18.608931, 24.985718, 32.985710, & - 42.879242, 54.955463, 69.520576, 86.895882, 107.415741, 131.425507, 159.279404, 191.338562, 227.968948, 269.539581, & - 316.420746, 368.982361, 427.592499, 492.616028, 564.413452, 643.339905, 729.744141, 823.967834, 926.344910, 1037.20117, & - 1156.853638, 1285.610352, 1423.770142, 1571.622925, 1729.448975, 1897.519287, 2076.095947, 2265.431641, 2465.770508, 2677.348145, & - 2900.391357, 3135.119385, 3381.743652, 3640.468262, 3911.490479, 4194.930664, 4490.817383, 4799.149414, 5119.895020, 5452.990723, & - 5798.344727, 6156.074219, 6526.946777, 6911.870605, 7311.869141, 7727.412109, 8159.354004, 8608.525391, 9076.400391, 9562.682617, & - 10065.978516, 10584.631836, 11116.662109, 11660.067383, 12211.547852, 12766.873047, 13324.668945, 13881.331055, 14432.139648, 14975.615234, & - 15508.256836, 16026.115234, 16527.322266, 17008.789062, 17467.613281, 17901.621094, 18308.433594, 18685.718750, 19031.289062, 19343.511719, & - 19620.042969, 19859.390625, 20059.931641, 20219.664062, 20337.863281, 20412.308594, 20442.078125, 20425.718750, 20361.816406, 20249.511719, & - 20087.085938, 19874.025391, 19608.572266, 19290.226562, 18917.460938, 18489.707031, 18006.925781, 17471.839844, 16888.687500, 16262.046875, & - 15596.695312, 14898.453125, 14173.324219, 13427.769531, 12668.257812, 11901.339844, 11133.304688, 10370.175781, 9617.515625, 8880.453125, & - 8163.375000, 7470.343750, 6804.421875, 6168.531250, 5564.382812, 4993.796875, 4457.375000, 3955.960938, 3489.234375, 3057.265625, & - 2659.140625, 2294.242188, 1961.500000, 1659.476562, 1387.546875, 1143.250000, 926.507812, 734.992188, 568.062500, 424.414062, & - 302.476562, 202.484375, 122.101562, 62.781250, 22.835938, 3.757813, 0.000000, 0.000000/ - - data b137 & - /0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, & - 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, & - 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, & - 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, & - 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, & - 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000007, 0.000024, 0.000059, 0.000112, 0.000199, & - 0.000340, 0.000562, 0.000890, 0.001353, 0.001992, 0.002857, 0.003971, 0.005378, 0.007133, 0.009261, & - 0.011806, 0.014816, 0.018318, 0.022355, 0.026964, 0.032176, 0.038026, 0.044548, 0.051773, 0.059728, & - 0.068448, 0.077958, 0.088286, 0.099462, 0.111505, 0.124448, 0.138313, 0.153125, 0.168910, 0.185689, & - 0.203491, 0.222333, 0.242244, 0.263242, 0.285354, 0.308598, 0.332939, 0.358254, 0.384363, 0.411125, & - 0.438391, 0.466003, 0.493800, 0.521619, 0.549301, 0.576692, 0.603648, 0.630036, 0.655736, 0.680643, & - 0.704669, 0.727739, 0.749797, 0.770798, 0.790717, 0.809536, 0.827256, 0.843881, 0.859432, 0.873929, & - 0.887408, 0.899900, 0.911448, 0.922096, 0.931881, 0.940860, 0.949064, 0.956550, 0.963352, 0.969513, & - 0.975078, 0.980072, 0.984542, 0.988500, 0.991984, 0.995003, 0.997630, 1.000000/ - -! GEOS-5 144 levels -! -------------- - - data a144 / & - 1.000000, 1.960339, 3.018127, 4.519399, 6.594791, 9.396987, 13.101062, 17.904371, & - 24.026014, 31.705914, 41.203591, 52.796624, 66.778966, 83.459060, 103.157888, 126.206988, & - 152.946409, 183.722832, 218.887582, 258.794912, 303.800291, 354.258838, 410.523897, 472.945737, & - 541.870439, 617.638927, 700.586001, 791.039663, 889.320479, 995.741215, 1110.606209, 1234.211175, & - 1366.842986, 1508.779958, 1660.291153, 1821.636721, 1993.068262, 2174.828352, 2367.151362, 2570.263462, & - 2784.382383, 3009.718592, 3246.475054, 3494.847707, 3755.025920, 4027.125241, 4311.173090, 4607.168297, & - 4915.080393, 5234.848439, 5566.384314, 5909.800516, 6265.833909, 6635.356361, 7019.350358, 7418.266832, & - 7832.926088, 8264.125457, 8713.280080, 9180.105429, 9663.263708, 10161.164935, 10671.907883, 11193.570701, & - 11722.985614, 12256.091419, 12791.569071, 13325.958299, 13854.728219, 14376.458535, 14887.788352, 15384.926463, & - 15866.079454, 16328.282045, 16768.748022, 17185.390535, 17575.925860, 17938.115274, 18269.858802, 18569.588965, & - 18835.055787, 19064.826786, 19257.343857, 19410.685145, 19524.155037, 19595.621682, 19624.200090, 19608.495278, & - 19547.149762, 19439.338553, 19283.411670, 19078.875993, 18824.044044, 18518.435827, 18160.585111, 17749.946276, & - 17286.481825, 16772.805474, 16212.985926, 15611.418127, 14972.688273, 14685.145246, 14343.270330, 13949.485200, & - 13506.727241, 13018.449574, 12488.621027, 11921.726145, 11322.765171, 10701.274117, 10064.717511, 9415.890690, & - 8757.741793, 8093.371764, 7426.034348, 6759.136076, 6096.236214, 5441.046941, 4797.433388, 4167.668812, & - 3553.036489, 2953.887909, 2369.719063, 1802.141374, 1252.799272, 723.370122, 215.564278, -268.874847, & - -728.170839, -1160.514171, -1564.062288, -1936.939948, -2277.238943, -2583.017359, -2852.300196, -3083.080054, & - -3273.316548, -3420.936755, -3523.834829, -3579.870938, -3586.872187, -3542.632607, -3444.913165, -3291.442693, & - 0.000000/ - - data b144 / & - 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, & - 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, & - 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, & - 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, & - 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, & - 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, & - 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000007, & - 0.000023, 0.000057, 0.000108, 0.000191, 0.000326, 0.000540, 0.000854, 0.001299, & - 0.001912, 0.002743, 0.003812, 0.005163, 0.006848, 0.008890, 0.011334, 0.014223, & - 0.017585, 0.021461, 0.025885, 0.030889, 0.036505, 0.042766, 0.049701, 0.057338, & - 0.065709, 0.074839, 0.084754, 0.095482, 0.107044, 0.119469, 0.132779, 0.146998, & - 0.162152, 0.178259, 0.195349, 0.213437, 0.232551, 0.252709, 0.273937, 0.296251, & - 0.319618, 0.343920, 0.368984, 0.394675, 0.420850, 0.440673, 0.460647, 0.480716, & - 0.500823, 0.520907, 0.540908, 0.560763, 0.580407, 0.599826, 0.619030, 0.637990, & - 0.656675, 0.675052, 0.693090, 0.710758, 0.728021, 0.744846, 0.761201, 0.777101, & - 0.792575, 0.807657, 0.822389, 0.836759, 0.850752, 0.864358, 0.877561, 0.890349, & - 0.902708, 0.914625, 0.926086, 0.937078, 0.947586, 0.957597, 0.967096, 0.976070, & - 0.984504, 0.992384, 0.999696, 1.006424, 1.012554, 1.018072, 1.022962, 1.027209, & - 1.000000/ - -! GEOS-5 132 levels -! -------------- - data a132 / & - 1.000000, 1.996276, 3.093648, 4.651099, 6.804155, 9.711212, 13.553898, 18.536953, & - 24.887674, 32.854966, 42.708057, 54.734916, 69.240493, 86.544776, 106.980758, 130.892382, & - 158.632424, 190.560538, 227.041195, 268.441904, 315.131439, 367.478204, 425.848769, 490.606509, & - 562.110455, 640.714290, 726.765342, 820.603888, 922.562490, 1032.965616, 1152.128995, 1280.359406, & - 1417.954457, 1565.202880, 1722.383803, 1889.767115, 2067.613829, 2256.175598, 2455.695564, 2666.408361, & - 2888.539866, 3122.308425, 3367.924596, 3625.591648, 3895.506041, 4177.787642, 4472.464900, 4779.536600, & - 5098.971133, 5430.705281, 5774.647623, 6130.914868, 6500.271455, 6883.621876, 7281.985387, 7695.829790, & - 8126.006088, 8573.341452, 9039.303976, 9523.598485, 10024.837122, 10541.370406, 11071.225963, 11612.410025, & - 12161.636274, 12714.691534, 13270.207397, 13824.594107, 14373.151226, 14914.405313, 15444.869700, 15960.611311, & - 16459.769620, 16939.268383, 17396.217121, 17828.450893, 18233.600515, 18609.343488, 18953.501254, 19264.447677, & - 19539.848583, 19778.217887, 19977.939176, 20137.018678, 20254.734748, 20328.875760, 20358.523606, 20342.231101, & - 20278.589963, 20166.744330, 20004.982477, 19792.792832, 19528.424768, 19211.380327, 18840.138412, 18414.132983, & - 17933.325139, 17400.426408, 16819.657745, 16195.578563, 15532.946677, 14837.558610, 14115.393726, 13372.886551, & - 12616.479397, 11852.696266, 11087.800514, 10327.790957, 9578.207359, 8844.157660, 8129.832058, 7440.098773, & - 6777.003948, 6143.217998, 5541.186971, 4972.725810, 4438.905073, 3940.077056, 3475.984433, 3045.886238, & - 2648.697264, 2283.946319, 1951.862407, 1652.526827, 1385.902714, 1151.874101, 950.288155, 780.991556, & - 643.875906, 538.919476, 466.225293, 426.071190, 0.000000 / - - data b132 / & - 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, & - 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, & - 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, & - 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, & - 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, & - 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, & - 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000000, 0.000007, & - 0.000024, 0.000059, 0.000112, 0.000198, 0.000339, 0.000560, 0.000886, 0.001347, & - 0.001984, 0.002845, 0.003955, 0.005356, 0.007104, 0.009223, 0.011758, 0.014755, & - 0.018243, 0.022264, 0.026854, 0.032044, 0.037871, 0.044366, 0.051561, 0.059484, & - 0.068168, 0.077639, 0.087925, 0.099055, 0.111049, 0.123939, 0.137748, 0.152499, & - 0.168220, 0.184930, 0.202659, 0.221424, 0.241254, 0.262166, 0.284188, 0.307337, & - 0.331578, 0.356790, 0.382792, 0.409444, 0.436599, 0.464098, 0.491782, 0.519487, & - 0.547056, 0.574335, 0.601181, 0.627461, 0.653056, 0.677861, 0.701765, 0.724759, & - 0.746767, 0.767710, 0.787535, 0.806224, 0.823790, 0.840276, 0.855742, 0.870260, & - 0.883905, 0.896733, 0.908781, 0.920085, 0.930681, 0.940600, 0.949868, 0.958500, & - 0.966498, 0.973850, 0.980526, 0.986474, 1.000000 / - - - open(10, file="eta.rc", action="write", FORM="FORMATTED") - - write(10,'(A)') "# The data for each label: ak(k) bk(k)" - write(10,'(A)') "# the last row of the label ks for pint" - write(10,'(A)') "NUM_LEVELS: 72" - write(10,'(A)') "USE_SIGMA_LEVELS: .false." - write(10,'(A)') "USE_NCEP_LEVELS: .false" - -! Fake single-level for util codes - write(10,'(A)') "levels_1:" - km = 1 - ks = 1 - do k=1,km+1 - write(10,*) a01(k),b01(k) - enddo - write(10,*) ks - -! *** Original CCM3 18-Level setup *** - ! case (18) - write(10,'(A)') "levels_18:" - km=18 - ks = 4 - do k=1,km+1 - write(10,*) a18(k), b18(k) - enddo - write(10,*) ks - - !case (26) -! CCM4 26-Level setup *** - write(10,'(A)') "levels_26:" - km=26 - ks = 7 - do k=1,km+1 - write(10,*) a26(k), b26(k) - enddo - write(10,*) ks - - !case (30) -! CCM4 30-Level setup *** - write(10,'(A)') "levels_30:" - km=30 - ks = 12 - do k=1,km+1 - write(10,*) a30(k), b30(k) - enddo - write(10,*) ks - -! *** Revised 32-L setup with ptop at 0.4 mb *** -! SJL: 04/01/2002 - write(10,'(A)') "levels_32:" - km=32 - ks = 21 - do k=1,km+1 - write(10,*) a32(k), b32(k) - enddo - write(10,*) ks - - write(10,'(A)') "levels_48:" - km=48 - ks = 30 - do k=1,km+1 - write(10,*) a48(k), b48(k) - enddo - write(10,*) ks - -! *** Revised 55-L setup with ptop at 0.01 mb *** - !case (55) - write(10,'(A)') "levels_55:" - km=55 - ks = 41 - do k=1,km+1 - write(10,*) a55(k), b55(k) - enddo - write(10,*) ks - - write(10,'(A)') "sigma_levels_64:" - km=64 - ks = 0 - do k=1,km+1 - write(10, *) a64_sig(k), b64_sig(k) - enddo - write(10,*) ks - !else - - write(10,'(A)') "levels_64:" - km=64 - ks = 21 - do k=1,km+1 - write(10,*) a64(k), b64(k) - enddo - write(10,*) ks - - write(10,'(A)') "levels_44:" - km=44 - ks = 16 - do k=1,km+1 - write(10,*) a44(k), b44(k) - enddo - write(10,*) ks - - write(10,'(A)') "ncep_levels_72:" - km=72 - ks = 29 - do k=1,km+1 - write(10,*) a72_ncep(k), b72_ncep(k) - enddo - write(10,*) ks - - write(10,'(A)') "levels_72:" - ks = 40 - do k=1,km+1 - write(10,*) a72(k), b72(k) - enddo - write(10,*) ks - - write(10,'(A)') "BETA3P1_levels_72:" - ks = 40 - do k=1,km+1 - write(10,*) a72_BETA3P1(k), b72_BETA3P1(k) - enddo - write(10,*) ks - - - write(10,'(A)') "levels_91:" - km=91 - ks = 33 - do k=1,km+1 - write(10,*) a91(k), b91(k) - end do - write(10,*) ks - - write(10,'(A)') "levels_96:" - km =96 - ks = 77 - do k=1,km+1 - write(10,*) a96(k), b96(k) - enddo - write(10,*) ks - - write(10,'(A)') "levels_137:" - km= 137 - ks = 54 - do k=1,km+1 - write(10,*) a137(k), b137(k) - enddo - write(10,*) ks - - write(10,'(A)') "levels_144:" - km=144 - ks = 56 - do k=1,km+1 - write(10,*) a144(k), b144(k) - enddo - write(10,*) ks - - write(10,'(A)') "levels_132:" - km= 132 - ks = 54 - do k=1,km+1 - write(10,*) a132(k), b132(k) - enddo - write(10,*) ks - - close(10) - - print*, i_to_string(1),i_to_string (100) - -contains - - function i_to_string(count, rc) result(str) - character(len=:), allocatable :: str - integer, intent(in) :: count - integer, optional, intent(out) :: rc - character(len=9) :: buffer - write(buffer,'(i0)') count - str = trim(buffer) - - end function i_to_string -end program From beb8f74e1d6776348f1a0a8a4d479deef42d19f4 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Wed, 11 Mar 2020 21:57:32 -0400 Subject: [PATCH 045/109] clean up --- MAPL_Base/MAPL_VerticalGrid.F90 | 3 +++ 1 file changed, 3 insertions(+) diff --git a/MAPL_Base/MAPL_VerticalGrid.F90 b/MAPL_Base/MAPL_VerticalGrid.F90 index 416464703acf..147475d3e27b 100644 --- a/MAPL_Base/MAPL_VerticalGrid.F90 +++ b/MAPL_Base/MAPL_VerticalGrid.F90 @@ -100,6 +100,7 @@ function new_VerticalGrid_by_cfg(config, unused, rc) result(grid) grid = VerticalGrid(ak, bk, ks, ref_pressure=ref_pressure) + deallocate(ak, bk) end function new_VerticalGrid_by_cfg subroutine get_eta_r8(this, km, ks, ptop, pint, ak, bk, unused,rc) @@ -224,6 +225,8 @@ subroutine get_pressure_levels_r4(this, pressure_levels, unused, reference_press call get_pressure_levels_r8(this, plevels, reference_pressure=p0) pressure_levels = real(plevels,kind=REAL32) + + deallocate(plevels) end subroutine get_pressure_levels_r4 From 5a59b474c8a7219dd293e316349744928af7b88d Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Tue, 17 Mar 2020 13:09:33 -0400 Subject: [PATCH 046/109] add 3d inteface for get pressure. remove who knows ks --- MAPL_Base/CMakeLists.txt | 2 +- ...0 => MAPL_EtaHybridVerticalCoordinate.F90} | 172 +++++++++++------- 2 files changed, 103 insertions(+), 71 deletions(-) rename MAPL_Base/{MAPL_VerticalGrid.F90 => MAPL_EtaHybridVerticalCoordinate.F90} (50%) diff --git a/MAPL_Base/CMakeLists.txt b/MAPL_Base/CMakeLists.txt index c996f87aa342..109cade40ada 100644 --- a/MAPL_Base/CMakeLists.txt +++ b/MAPL_Base/CMakeLists.txt @@ -26,7 +26,7 @@ set (srcs MAPL_Cap.F90 hash.c MAPL_CapGridComp.F90 MAPL_GridType.F90 - MAPL_GridSpec.F90 MAPL_VerticalMethods.F90 MAPL_newCFIOitem.F90 MAPL_VerticalGrid.F90 + MAPL_GridSpec.F90 MAPL_VerticalMethods.F90 MAPL_newCFIOitem.F90 MAPL_EtaHybridVerticalCoordinate.F90 MAPL_VerticalInterpMod.F90 MAPL_ESMFTimeVectorMod.F90 MAPL_TimeMethods.F90 MAPL_ioClients.F90 MAPL_DirPath.F90 diff --git a/MAPL_Base/MAPL_VerticalGrid.F90 b/MAPL_Base/MAPL_EtaHybridVerticalCoordinate.F90 similarity index 50% rename from MAPL_Base/MAPL_VerticalGrid.F90 rename to MAPL_Base/MAPL_EtaHybridVerticalCoordinate.F90 index 147475d3e27b..ecb3496ebdf6 100644 --- a/MAPL_Base/MAPL_VerticalGrid.F90 +++ b/MAPL_Base/MAPL_EtaHybridVerticalCoordinate.F90 @@ -1,7 +1,8 @@ +#include "MAPL_Generic.h" #include "MAPL_ErrLog.h" #include "unused_dummy.H" -module MAPL_VerticalGrid +module MAPL_EtaHybridVerticalCoordinate use, intrinsic :: ISO_FORTRAN_ENV, only: REAL64, REAL32 use ESMF use ESMFL_Mod @@ -11,52 +12,50 @@ module MAPL_VerticalGrid implicit none private - public :: VerticalGrid + public :: EtaHybridVerticalCoordinate - type :: VerticalGrid + type :: EtaHybridVerticalCoordinate private real(kind=REAL64), allocatable :: ak(:) real(kind=REAL64), allocatable :: bk(:) - integer :: ks integer :: num_levels = 0 real(kind=REAL64) :: ref_pressure contains procedure :: get_eta_r8 procedure :: get_eta_r4 procedure :: get_pressure_levels_r8 + procedure :: get_pressure_levels_r8_3d procedure :: get_pressure_levels_r4 + procedure :: get_pressure_levels_r4_3d generic :: get_eta =>get_eta_r8, get_eta_r4 - generic :: get_pressure_levels=>get_pressure_levels_r8, get_pressure_levels_r4 - end type VerticalGrid + generic :: get_pressure_levels=>get_pressure_levels_r8, get_pressure_levels_r4, & + get_pressure_levels_r8_3d,get_pressure_levels_r4_3d + end type EtaHybridVerticalCoordinate - interface newVerticalGrid - module procedure new_VerticalGrid_by_ak_bk - module procedure new_VerticalGrid_by_cfg + interface newEtaHybridVerticalCoordinate + module procedure new_EtaHybridVerticalCoordinate_by_ak_bk + module procedure new_EtaHybridVerticalCoordinate_by_cfg end interface - real(kind=REAL64), parameter :: DEFAULT_REFERENCE_PRESSURE = 98400.d0 ! default reference pressure + real(kind=REAL64), parameter :: DEFAULT_REFERENCE_PRESSURE = 98400.d0 ! (Pa) default reference pressure contains - function new_VerticalGrid_by_ak_bk(ak, bk, ks, unused, ref_pressure, rc) result(grid) - type (VerticalGrid) :: grid + function new_EtaHybridVerticalCoordinate_by_ak_bk(ak, bk, unused, ref_pressure, rc) result(grid) + type (EtaHybridVerticalCoordinate) :: grid real(kind=REAL64), intent(in) :: ak(:) real(kind=REAL64), intent(in) :: bk(:) - integer, intent(in) :: ks class(KeywordEnforcer), optional, intent(in) :: unused real(kind=REAL64),optional, intent(in) :: ref_pressure integer, optional, intent(inout) :: rc - character(len=*), parameter :: Iam="new_VerticalGrid_by_ak_bk" - _ASSERT(size(ak) >= 2, 'size of ak should be >=2') _ASSERT(size(ak) == size(bk), ' size of ak should be the same as that of bk') grid%ak = ak grid%bk = bk - grid%ks = ks grid%num_levels = size(ak) - 1 if (present(ref_pressure)) then @@ -64,63 +63,67 @@ function new_VerticalGrid_by_ak_bk(ak, bk, ks, unused, ref_pressure, rc) result( else grid%ref_pressure = DEFAULT_REFERENCE_PRESSURE end if - - end function new_VerticalGrid_by_ak_bk + end function new_EtaHybridVerticalCoordinate_by_ak_bk - function new_VerticalGrid_by_cfg(config, unused, rc) result(grid) - type (VerticalGrid) :: grid + function new_EtaHybridVerticalCoordinate_by_cfg(config, unused, rc) result(grid) + type (EtaHybridVerticalCoordinate) :: grid type (ESMF_Config) :: config class (KeywordEnforcer), optional, intent(in) :: unused integer, optional, intent(inout) :: rc real(kind=REAL64), allocatable :: ak(:) real(kind=REAL64), allocatable :: bk(:) - - integer :: k,ks, num_levels + integer :: status + integer :: k, num_levels real(kind=REAL64) :: ptop, pint, ref_pressure character(len=32) :: data_label - character(len=*), parameter :: Iam="new_VerticalGrid_by_cfg" - call ESMF_ConfigGetAttribute(config, num_levels,label='NUM_LEVELS:', rc=rc) - call ESMF_ConfigGetAttribute(config, ref_pressure,label='REF_PRESSURE:', default = DEFAULT_REFERENCE_PRESSURE, rc=rc) - call ESMF_ConfigGetAttribute(config, ks,label='TRANSIT_TO_P:', rc=rc) + call ESMF_ConfigGetAttribute(config, num_levels,label='NUM_LEVELS:', __RC__ ) + call ESMF_ConfigGetAttribute(config, ref_pressure,label='REF_PRESSURE:', default = DEFAULT_REFERENCE_PRESSURE, __RC__ ) data_label = "ak-bk:" allocate(ak(num_levels+1), bk(num_levels+1)) - call ESMF_ConfigFindLabel(config, trim(data_label), rc=rc) + call ESMF_ConfigFindLabel(config, trim(data_label), __RC__ ) ! get ak and bk do k = 1, num_levels+1 - call ESMF_ConfigNextLine(config, rc=rc) - call ESMF_ConfigGetAttribute(config, ak(k), rc=rc) - call ESMF_ConfigGetAttribute(config, bk(k), rc=rc) + call ESMF_ConfigNextLine(config, __RC__ ) + call ESMF_ConfigGetAttribute(config, ak(k), __RC__ ) + call ESMF_ConfigGetAttribute(config, bk(k), __RC__ ) enddo - grid = VerticalGrid(ak, bk, ks, ref_pressure=ref_pressure) + grid = EtaHybridVerticalCoordinate(ak, bk, ref_pressure=ref_pressure) deallocate(ak, bk) - end function new_VerticalGrid_by_cfg + end function new_EtaHybridVerticalCoordinate_by_cfg - subroutine get_eta_r8(this, km, ks, ptop, pint, ak, bk, unused,rc) - class(VerticalGrid), intent(in) :: this - integer, intent(in) :: km - integer, intent(out) :: ks + subroutine get_eta_r8(this, ptop, pint, ak, bk, unused,rc) + class(EtaHybridVerticalCoordinate), intent(in) :: this real(kind=REAL64), intent(out) :: ak(:) real(kind=REAL64), intent(out) :: bk(:) real(kind=REAL64), intent(out) :: ptop ! model top (Pa) real(kind=REAL64), intent(out) :: pint ! transition to p (Pa) class(KeywordEnforcer), optional, intent(in) :: unused integer, optional, intent(out) :: rc - - _ASSERT(km == size(ak)-1 ,"size ak should be consistent") - _ASSERT(km == size(bk)-1 ,"size ak should be consistent") - _ASSERT(km == this%num_levels,"size vertical grid should be consistent") + integer :: num_levels, k, ks + + _ASSERT(this%num_levels == size(ak) - 1 ,"size vertical grid should be consistent") ak = this%ak bk = this%bk - ks = this%ks + do k = 1, num_levels+1 + if (num_levels == 1) then + ks = 1 + exit + endif + + if ( bk(k) > 0.0d0) then + ks = k -2 + exit + endif + enddo ptop = this%ak(1) pint = this%ak(ks+1) @@ -128,10 +131,8 @@ subroutine get_eta_r8(this, km, ks, ptop, pint, ak, bk, unused,rc) end subroutine get_eta_r8 - subroutine get_eta_r4(this, km, ks, ptop, pint, ak, bk, unused,rc) - class(VerticalGrid), intent(in) :: this - integer, intent(in) :: km - integer, intent(out) :: ks + subroutine get_eta_r4(this, ptop, pint, ak, bk, unused,rc) + class(EtaHybridVerticalCoordinate), intent(in) :: this real(kind=REAL32), intent(out) :: ak(:) real(kind=REAL32), intent(out) :: bk(:) real(kind=REAL32), intent(out) :: ptop ! model top (Pa) @@ -143,38 +144,36 @@ subroutine get_eta_r4(this, km, ks, ptop, pint, ak, bk, unused,rc) real(kind=REAL64), allocatable :: bk8(:) real(kind=REAL64) :: ptop8 ! model top (Pa) real(kind=REAL64) :: pint8 ! transition to p (Pa) - - _ASSERT(km == size(ak)-1 ,"size ak should be consistent") - _ASSERT(km == size(bk)-1 ,"size ak should be consistent") - _ASSERT(km == this%num_levels,"size vertical grid should be consistent") + integer :: num_levels - allocate(ak8(km+1)) - allocate(bk8(km+1)) + num_levels = this%num_levels + allocate(ak8(num_levels+1)) + allocate(bk8(num_levels+1)) - call this%get_eta(km, ks, ptop8, pint8, ak8, bk8) + call this%get_eta(ptop8, pint8, ak8, bk8) - ak = real(ak8, kind=REAL32) - bk = real(bk8, kind=REAL32) - ptop = ak(1) - pint = ak(ks+1) + ak = real(ak8, kind=REAL32) + bk = real(bk8, kind=REAL32) + + ptop = ptop8 + pint = pint8 - deallocate(ak8,bk8) + deallocate(ak8,bk8) _RETURN(_SUCCESS) end subroutine get_eta_r4 subroutine get_pressure_levels_r8(this, pressure_levels, unused, reference_pressure, rc) - class(VerticalGrid), intent(in) :: this + class(EtaHybridVerticalCoordinate), intent(in) :: this real(kind=REAL64), intent(out) :: pressure_levels(:) class(KeywordEnforcer), optional, intent(in) :: unused real(kind=REAL64), optional, intent(in) :: reference_pressure integer, optional, intent(out) :: rc real(kind=REAL64) :: p0 - integer :: k, n_levels - character(len=*), parameter :: Iam="get_pressure_levels" + integer :: k, num_levels - n_levels = this%num_levels - _ASSERT(size(pressure_levels) == n_levels, 'incorrect array size for pressure_levels dummy argument') + num_levels = this%num_levels + _ASSERT(size(pressure_levels) == num_levels, 'incorrect array size for pressure_levels dummy argument') if (present(reference_pressure)) then p0 = reference_pressure @@ -184,7 +183,7 @@ subroutine get_pressure_levels_r8(this, pressure_levels, unused, reference_press pressure_levels(1) = this%ak(1) + 0.50d0 * dpref_(1,p0) - do k = 2, n_levels + do k = 2, num_levels pressure_levels(k) = pressure_levels(k-1) + 0.5d0 * (dpref_(k-1, p0) + dpref_(k,p0)) end do @@ -200,19 +199,37 @@ end function dpref_ end subroutine get_pressure_levels_r8 + subroutine get_pressure_levels_r8_3d(this, pressure_levels, unused, reference_pressure, rc) + class(EtaHybridVerticalCoordinate), intent(in) :: this + real(kind=REAL64), intent(out) :: pressure_levels(:,:,:) + class(KeywordEnforcer), optional, intent(in) :: unused + real(kind=REAL64), optional, intent(in) :: reference_pressure(:,:) + integer, optional, intent(out) :: rc + integer :: i,j, isize, jsize + + isize = size(pressure_levels,2) + jsize = size(pressure_levels,3) + + do j = 1, jsize + do i = 1, isize + call this%get_pressure_levels(pressure_levels(:,i,j), reference_pressure = reference_pressure(i,j)) + enddo + enddo + end subroutine + subroutine get_pressure_levels_r4(this, pressure_levels, unused, reference_pressure, rc) - class(VerticalGrid), intent(in) :: this + class(EtaHybridVerticalCoordinate), intent(in) :: this real(kind=REAL32), intent(out) :: pressure_levels(:) class(KeywordEnforcer), optional, intent(in) :: unused real(kind=REAL32), optional, intent(in) :: reference_pressure integer, optional, intent(out) :: rc real(kind=REAL64) :: p0 - integer :: k, n_levels + integer :: k, num_levels real(kind=REAL64), allocatable :: plevels(:) character(len=*), parameter :: Iam="get_pressure_levels" - n_levels = this%num_levels - _ASSERT(size(pressure_levels) == n_levels, 'incorrect array size for pressure_levels dummy argument') + num_levels = this%num_levels + _ASSERT(size(pressure_levels) == num_levels, 'incorrect array size for pressure_levels dummy argument') if (present(reference_pressure)) then p0 = reference_pressure @@ -220,9 +237,9 @@ subroutine get_pressure_levels_r4(this, pressure_levels, unused, reference_press p0 = DEFAULT_REFERENCE_PRESSURE end if - allocate(plevels(n_levels)) + allocate(plevels(num_levels)) - call get_pressure_levels_r8(this, plevels, reference_pressure=p0) + call this%get_pressure_levels(plevels, reference_pressure=p0) pressure_levels = real(plevels,kind=REAL32) @@ -230,4 +247,19 @@ subroutine get_pressure_levels_r4(this, pressure_levels, unused, reference_press end subroutine get_pressure_levels_r4 -end module MAPL_VerticalGrid + subroutine get_pressure_levels_r4_3d(this, pressure_levels, unused, reference_pressure, rc) + class(EtaHybridVerticalCoordinate), intent(in) :: this + real(kind=REAL32), intent(out) :: pressure_levels(:,:,:) + class(KeywordEnforcer), optional, intent(in) :: unused + real(kind=REAL32), optional, intent(in) :: reference_pressure(:,:) + integer, optional, intent(out) :: rc + integer :: i,j + + do j = 1, size(pressure_levels,3) + do i = 1, size(pressure_levels,2) + call this%get_pressure_levels(pressure_levels(:,i,j), reference_pressure = reference_pressure(i,j)) + enddo + enddo + end subroutine + +end module MAPL_EtaHybridVerticalCoordinate From b5876df17fac908afdf718d7342fe448bb0cf663 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Tue, 17 Mar 2020 13:19:14 -0400 Subject: [PATCH 047/109] clean up --- MAPL_Base/MAPL_EtaHybridVerticalCoordinate.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/MAPL_Base/MAPL_EtaHybridVerticalCoordinate.F90 b/MAPL_Base/MAPL_EtaHybridVerticalCoordinate.F90 index ecb3496ebdf6..7f9e45ef17b7 100644 --- a/MAPL_Base/MAPL_EtaHybridVerticalCoordinate.F90 +++ b/MAPL_Base/MAPL_EtaHybridVerticalCoordinate.F90 @@ -178,7 +178,7 @@ subroutine get_pressure_levels_r8(this, pressure_levels, unused, reference_press if (present(reference_pressure)) then p0 = reference_pressure else - p0 = DEFAULT_REFERENCE_PRESSURE + p0 = this%ref_pressure end if pressure_levels(1) = this%ak(1) + 0.50d0 * dpref_(1,p0) @@ -234,7 +234,7 @@ subroutine get_pressure_levels_r4(this, pressure_levels, unused, reference_press if (present(reference_pressure)) then p0 = reference_pressure else - p0 = DEFAULT_REFERENCE_PRESSURE + p0 = this%ref_pressure end if allocate(plevels(num_levels)) From 90d225fd6b4e6abd046aa80a9ad7eb817bffc5c5 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Tue, 17 Mar 2020 16:12:31 -0400 Subject: [PATCH 048/109] further clean up. --- .../MAPL_EtaHybridVerticalCoordinate.F90 | 81 +++++++++++-------- 1 file changed, 46 insertions(+), 35 deletions(-) diff --git a/MAPL_Base/MAPL_EtaHybridVerticalCoordinate.F90 b/MAPL_Base/MAPL_EtaHybridVerticalCoordinate.F90 index 7f9e45ef17b7..b512bf434c30 100644 --- a/MAPL_Base/MAPL_EtaHybridVerticalCoordinate.F90 +++ b/MAPL_Base/MAPL_EtaHybridVerticalCoordinate.F90 @@ -5,10 +5,8 @@ module MAPL_EtaHybridVerticalCoordinate use, intrinsic :: ISO_FORTRAN_ENV, only: REAL64, REAL32 use ESMF - use ESMFL_Mod use MAPL_ErrorHandlingMod use MAPL_KeywordEnforcerMod - use pFIO implicit none private @@ -25,12 +23,12 @@ module MAPL_EtaHybridVerticalCoordinate procedure :: get_eta_r8 procedure :: get_eta_r4 procedure :: get_pressure_levels_r8 - procedure :: get_pressure_levels_r8_3d procedure :: get_pressure_levels_r4 - procedure :: get_pressure_levels_r4_3d + procedure :: get_pressures_r8_3d + procedure :: get_pressures_r4_3d generic :: get_eta =>get_eta_r8, get_eta_r4 - generic :: get_pressure_levels=>get_pressure_levels_r8, get_pressure_levels_r4, & - get_pressure_levels_r8_3d,get_pressure_levels_r4_3d + generic :: get_pressure_levels=>get_pressure_levels_r8, get_pressure_levels_r4 + generic :: get_pressures =>get_pressures_r8_3d,get_pressures_r4_3d end type EtaHybridVerticalCoordinate interface newEtaHybridVerticalCoordinate @@ -42,7 +40,6 @@ module MAPL_EtaHybridVerticalCoordinate contains - function new_EtaHybridVerticalCoordinate_by_ak_bk(ak, bk, unused, ref_pressure, rc) result(grid) type (EtaHybridVerticalCoordinate) :: grid real(kind=REAL64), intent(in) :: ak(:) @@ -199,24 +196,6 @@ end function dpref_ end subroutine get_pressure_levels_r8 - subroutine get_pressure_levels_r8_3d(this, pressure_levels, unused, reference_pressure, rc) - class(EtaHybridVerticalCoordinate), intent(in) :: this - real(kind=REAL64), intent(out) :: pressure_levels(:,:,:) - class(KeywordEnforcer), optional, intent(in) :: unused - real(kind=REAL64), optional, intent(in) :: reference_pressure(:,:) - integer, optional, intent(out) :: rc - integer :: i,j, isize, jsize - - isize = size(pressure_levels,2) - jsize = size(pressure_levels,3) - - do j = 1, jsize - do i = 1, isize - call this%get_pressure_levels(pressure_levels(:,i,j), reference_pressure = reference_pressure(i,j)) - enddo - enddo - end subroutine - subroutine get_pressure_levels_r4(this, pressure_levels, unused, reference_pressure, rc) class(EtaHybridVerticalCoordinate), intent(in) :: this real(kind=REAL32), intent(out) :: pressure_levels(:) @@ -226,7 +205,6 @@ subroutine get_pressure_levels_r4(this, pressure_levels, unused, reference_press real(kind=REAL64) :: p0 integer :: k, num_levels real(kind=REAL64), allocatable :: plevels(:) - character(len=*), parameter :: Iam="get_pressure_levels" num_levels = this%num_levels _ASSERT(size(pressure_levels) == num_levels, 'incorrect array size for pressure_levels dummy argument') @@ -247,19 +225,52 @@ subroutine get_pressure_levels_r4(this, pressure_levels, unused, reference_press end subroutine get_pressure_levels_r4 - subroutine get_pressure_levels_r4_3d(this, pressure_levels, unused, reference_pressure, rc) + subroutine get_pressures_r8_3d(this, pressures, surface_pressure, unused, rc) class(EtaHybridVerticalCoordinate), intent(in) :: this - real(kind=REAL32), intent(out) :: pressure_levels(:,:,:) + real(kind=REAL64), intent(out) :: pressures(:,:,:) class(KeywordEnforcer), optional, intent(in) :: unused - real(kind=REAL32), optional, intent(in) :: reference_pressure(:,:) + real(kind=REAL64), optional, intent(in) :: surface_pressure(:,:) integer, optional, intent(out) :: rc - integer :: i,j - - do j = 1, size(pressure_levels,3) - do i = 1, size(pressure_levels,2) - call this%get_pressure_levels(pressure_levels(:,i,j), reference_pressure = reference_pressure(i,j)) + integer :: i,j, isize, jsize, ksize + real(kind=REAL64), allocatable :: tmp_pressures(:) + + isize = size(pressures,1) + jsize = size(pressures,2) + ksize = size(pressures,3) + allocate(tmp_pressures(ksize)) + + do i = 1, isize + do j = 1, jsize + call this%get_pressure_levels(tmp_pressures(:), reference_pressure = surface_pressure(i,j)) + pressures(i,j,:) = tmp_pressures(:) enddo enddo - end subroutine + deallocate(tmp_pressures) + + end subroutine get_pressures_r8_3d + + subroutine get_pressures_r4_3d(this, pressures, surface_pressure, unused, rc) + class(EtaHybridVerticalCoordinate), intent(in) :: this + real(kind=REAL32), intent(out) :: pressures(:,:,:) + class(KeywordEnforcer), optional, intent(in) :: unused + real(kind=REAL32), optional, intent(in) :: surface_pressure(:,:) + integer, optional, intent(out) :: rc + integer :: i,j, isize, jsize, ksize + real(kind=REAL32), allocatable :: tmp_pressures(:) + + isize = size(pressures,1) + jsize = size(pressures,2) + ksize = size(pressures,3) + allocate(tmp_pressures(ksize)) + + do i = 1, isize + do j = 1, jsize + call this%get_pressure_levels(tmp_pressures(:), reference_pressure = surface_pressure(i,j)) + pressures(i,j,:) = tmp_pressures(:) + enddo + enddo + deallocate(tmp_pressures) + + end subroutine get_pressures_r4_3d end module MAPL_EtaHybridVerticalCoordinate From 74068a06b3f4f6eb50e2a9e3ef275d0f34dbf384 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Wed, 18 Mar 2020 09:40:34 -0400 Subject: [PATCH 049/109] more efficient 3d pressure calculation --- .../MAPL_EtaHybridVerticalCoordinate.F90 | 46 +++++++++++-------- 1 file changed, 26 insertions(+), 20 deletions(-) diff --git a/MAPL_Base/MAPL_EtaHybridVerticalCoordinate.F90 b/MAPL_Base/MAPL_EtaHybridVerticalCoordinate.F90 index b512bf434c30..04181ee4647e 100644 --- a/MAPL_Base/MAPL_EtaHybridVerticalCoordinate.F90 +++ b/MAPL_Base/MAPL_EtaHybridVerticalCoordinate.F90 @@ -231,21 +231,24 @@ subroutine get_pressures_r8_3d(this, pressures, surface_pressure, unused, rc) class(KeywordEnforcer), optional, intent(in) :: unused real(kind=REAL64), optional, intent(in) :: surface_pressure(:,:) integer, optional, intent(out) :: rc - integer :: i,j, isize, jsize, ksize - real(kind=REAL64), allocatable :: tmp_pressures(:) + integer :: i, j, k, isize, jsize, ksize + real(kind=REAL64), allocatable :: levels(:) isize = size(pressures,1) jsize = size(pressures,2) ksize = size(pressures,3) - allocate(tmp_pressures(ksize)) - - do i = 1, isize - do j = 1, jsize - call this%get_pressure_levels(tmp_pressures(:), reference_pressure = surface_pressure(i,j)) - pressures(i,j,:) = tmp_pressures(:) - enddo + _ASSERT(this%num_levels == ksize, "pressure levels should match") + allocate(levels(ksize)) + call this%get_pressure_levels(levels(:), reference_pressure = 0._REAL64) + + do k = 1, ksize + do j = 1, jsize + do i = 1, isize + pressures(i,j,k) = surface_pressure(i,j) + levels(k) + enddo + enddo enddo - deallocate(tmp_pressures) + deallocate(levels) end subroutine get_pressures_r8_3d @@ -255,21 +258,24 @@ subroutine get_pressures_r4_3d(this, pressures, surface_pressure, unused, rc) class(KeywordEnforcer), optional, intent(in) :: unused real(kind=REAL32), optional, intent(in) :: surface_pressure(:,:) integer, optional, intent(out) :: rc - integer :: i,j, isize, jsize, ksize - real(kind=REAL32), allocatable :: tmp_pressures(:) + integer :: i, j, k, isize, jsize, ksize + real(kind=REAL32), allocatable :: levels(:) isize = size(pressures,1) jsize = size(pressures,2) ksize = size(pressures,3) - allocate(tmp_pressures(ksize)) - - do i = 1, isize - do j = 1, jsize - call this%get_pressure_levels(tmp_pressures(:), reference_pressure = surface_pressure(i,j)) - pressures(i,j,:) = tmp_pressures(:) - enddo + _ASSERT(this%num_levels == ksize, "pressure levels should match") + allocate(levels(ksize)) + call this%get_pressure_levels(levels(:), reference_pressure = 0._REAL32) + + do k = 1, ksize + do j = 1, jsize + do i = 1, isize + pressures(i,j,k) = surface_pressure(i,j) + levels(k) + enddo + enddo enddo - deallocate(tmp_pressures) + deallocate(levels) end subroutine get_pressures_r4_3d From 71564b81f519fbce1c56b9b374002a87dc14539d Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Wed, 18 Mar 2020 12:30:56 -0400 Subject: [PATCH 050/109] further polish --- MAPL_Base/CMakeLists.txt | 3 +- .../MAPL_EtaHybridVerticalCoordinate.F90 | 61 +++++++++++++++++-- 2 files changed, 58 insertions(+), 6 deletions(-) diff --git a/MAPL_Base/CMakeLists.txt b/MAPL_Base/CMakeLists.txt index 109cade40ada..f580c4bae567 100644 --- a/MAPL_Base/CMakeLists.txt +++ b/MAPL_Base/CMakeLists.txt @@ -26,7 +26,8 @@ set (srcs MAPL_Cap.F90 hash.c MAPL_CapGridComp.F90 MAPL_GridType.F90 - MAPL_GridSpec.F90 MAPL_VerticalMethods.F90 MAPL_newCFIOitem.F90 MAPL_EtaHybridVerticalCoordinate.F90 + MAPL_GridSpec.F90 MAPL_VerticalMethods.F90 MAPL_newCFIOitem.F90 + MAPL_EtaHybridVerticalCoordinate.F90 MAPL_VerticalInterpMod.F90 MAPL_ESMFTimeVectorMod.F90 MAPL_TimeMethods.F90 MAPL_ioClients.F90 MAPL_DirPath.F90 diff --git a/MAPL_Base/MAPL_EtaHybridVerticalCoordinate.F90 b/MAPL_Base/MAPL_EtaHybridVerticalCoordinate.F90 index 04181ee4647e..b0f1e78f8e19 100644 --- a/MAPL_Base/MAPL_EtaHybridVerticalCoordinate.F90 +++ b/MAPL_Base/MAPL_EtaHybridVerticalCoordinate.F90 @@ -1,6 +1,4 @@ #include "MAPL_Generic.h" -#include "MAPL_ErrLog.h" -#include "unused_dummy.H" module MAPL_EtaHybridVerticalCoordinate use, intrinsic :: ISO_FORTRAN_ENV, only: REAL64, REAL32 @@ -11,7 +9,7 @@ module MAPL_EtaHybridVerticalCoordinate private public :: EtaHybridVerticalCoordinate - + public :: get_eta type :: EtaHybridVerticalCoordinate private @@ -31,9 +29,15 @@ module MAPL_EtaHybridVerticalCoordinate generic :: get_pressures =>get_pressures_r8_3d,get_pressures_r4_3d end type EtaHybridVerticalCoordinate - interface newEtaHybridVerticalCoordinate + interface EtaHybridVerticalCoordinate module procedure new_EtaHybridVerticalCoordinate_by_ak_bk module procedure new_EtaHybridVerticalCoordinate_by_cfg + module procedure new_EtaHybridVerticalCoordinate_by_file + end interface + + interface get_eta + module procedure get_eta_onestep_r4 + module procedure get_eta_onestep_r8 end interface real(kind=REAL64), parameter :: DEFAULT_REFERENCE_PRESSURE = 98400.d0 ! (Pa) default reference pressure @@ -76,7 +80,8 @@ function new_EtaHybridVerticalCoordinate_by_cfg(config, unused, rc) result(grid) character(len=32) :: data_label call ESMF_ConfigGetAttribute(config, num_levels,label='NUM_LEVELS:', __RC__ ) - call ESMF_ConfigGetAttribute(config, ref_pressure,label='REF_PRESSURE:', default = DEFAULT_REFERENCE_PRESSURE, __RC__ ) + call ESMF_ConfigGetAttribute(config, ref_pressure,label='REF_PRESSURE:', & + default = DEFAULT_REFERENCE_PRESSURE, __RC__ ) data_label = "ak-bk:" @@ -96,6 +101,20 @@ function new_EtaHybridVerticalCoordinate_by_cfg(config, unused, rc) result(grid) deallocate(ak, bk) end function new_EtaHybridVerticalCoordinate_by_cfg + function new_EtaHybridVerticalCoordinate_by_file(filename, unused, rc) result(grid) + type (EtaHybridVerticalCoordinate) :: grid + character(len=*), intent(in) :: filename + class (KeywordEnforcer), optional, intent(in) :: unused + integer, optional, intent(inout) :: rc + type (ESMF_Config) :: config + integer :: status + + call ESMF_ConfigLoadFile (config, filename, __RC__) + + grid = EtaHybridVerticalCoordinate(config) + + end function new_EtaHybridVerticalCoordinate_by_file + subroutine get_eta_r8(this, ptop, pint, ak, bk, unused,rc) class(EtaHybridVerticalCoordinate), intent(in) :: this real(kind=REAL64), intent(out) :: ak(:) @@ -160,6 +179,38 @@ subroutine get_eta_r4(this, ptop, pint, ak, bk, unused,rc) _RETURN(_SUCCESS) end subroutine get_eta_r4 + subroutine get_eta_onestep_r4(filename, ptop, pint, ak, bk, unused, rc) + character(len=*), intent(in) :: filename + real(kind=REAL32), intent(out) :: ak(:) + real(kind=REAL32), intent(out) :: bk(:) + real(kind=REAL32), intent(out) :: ptop ! model top (Pa) + real(kind=REAL32), intent(out) :: pint ! transition to p (Pa) + class(KeywordEnforcer), optional, intent(in) :: unused + integer, optional, intent(out) :: rc + integer :: status + type (EtaHybridVerticalCoordinate) :: vgrid + + vgrid = EtaHybridVerticalCoordinate(filename) + call vgrid%get_eta(ptop, pint, ak, bk, __RC__ ) + + end subroutine get_eta_onestep_r4 + + subroutine get_eta_onestep_r8(filename, ptop, pint, ak, bk, unused, rc) + character(len=*), intent(in) :: filename + real(kind=REAL64), intent(out) :: ak(:) + real(kind=REAL64), intent(out) :: bk(:) + real(kind=REAL64), intent(out) :: ptop ! model top (Pa) + real(kind=REAL64), intent(out) :: pint ! transition to p (Pa) + class(KeywordEnforcer), optional, intent(in) :: unused + integer, optional, intent(out) :: rc + integer :: status + type (EtaHybridVerticalCoordinate) :: vgrid + + vgrid = EtaHybridVerticalCoordinate(filename) + call vgrid%get_eta(ptop, pint, ak, bk, __RC__ ) + + end subroutine get_eta_onestep_r8 + subroutine get_pressure_levels_r8(this, pressure_levels, unused, reference_pressure, rc) class(EtaHybridVerticalCoordinate), intent(in) :: this real(kind=REAL64), intent(out) :: pressure_levels(:) From 3f8b1a1d9c0b77dc6004d61906c8d8ef74e9f086 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Wed, 18 Mar 2020 20:07:17 -0400 Subject: [PATCH 051/109] elevate MAPL_EtaHybridVerticalCoordinate.F90 --- MAPL_Base/MAPL_EtaHybridVerticalCoordinate.F90 | 4 ++-- MAPL_Base/MAPL_Mod.F90 | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/MAPL_Base/MAPL_EtaHybridVerticalCoordinate.F90 b/MAPL_Base/MAPL_EtaHybridVerticalCoordinate.F90 index b0f1e78f8e19..b80fb8cf7366 100644 --- a/MAPL_Base/MAPL_EtaHybridVerticalCoordinate.F90 +++ b/MAPL_Base/MAPL_EtaHybridVerticalCoordinate.F90 @@ -1,6 +1,6 @@ #include "MAPL_Generic.h" -module MAPL_EtaHybridVerticalCoordinate +module MAPL_EtaHybridVerticalCoordinateMod use, intrinsic :: ISO_FORTRAN_ENV, only: REAL64, REAL32 use ESMF use MAPL_ErrorHandlingMod @@ -330,4 +330,4 @@ subroutine get_pressures_r4_3d(this, pressures, surface_pressure, unused, rc) end subroutine get_pressures_r4_3d -end module MAPL_EtaHybridVerticalCoordinate +end module MAPL_EtaHybridVerticalCoordinateMod diff --git a/MAPL_Base/MAPL_Mod.F90 b/MAPL_Base/MAPL_Mod.F90 index 47ddd4250e47..22ce21d2ae86 100644 --- a/MAPL_Base/MAPL_Mod.F90 +++ b/MAPL_Base/MAPL_Mod.F90 @@ -48,7 +48,7 @@ module MAPL_Mod use MAPL_KeywordEnforcerMod use MAPL_SimpleCommSplitterMod use MAPL_SplitCommunicatorMod - + use MAPL_EtaHybridVerticalCoordinateMod logical, save, private :: mapl_is_initialized = .false. end module MAPL_Mod From b277bb7ac63d493862dbabf1724141c075cdd46d Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Fri, 20 Mar 2020 16:31:16 -0400 Subject: [PATCH 052/109] Fixes and style updates for Python ACG - Fixes: * missing 'gc' argument for add spec * incorrect handling of empty argument for vloc - Style change: * add spec file split into 3: import,export,internal * declare_local.h is now declare_pointer.h (consistent with legacy Perl) --- Python/MAPL_GridCompSpecs_ACG.py | 40 ++++++++++++++++++-------------- Python/src/MAPL_DataSpec.py | 10 ++++---- Python/src/reader.py | 3 ++- 3 files changed, 30 insertions(+), 23 deletions(-) diff --git a/Python/MAPL_GridCompSpecs_ACG.py b/Python/MAPL_GridCompSpecs_ACG.py index d6db70a00792..959b2b86f407 100644 --- a/Python/MAPL_GridCompSpecs_ACG.py +++ b/Python/MAPL_GridCompSpecs_ACG.py @@ -11,16 +11,12 @@ # command line arguments parser = argparse.ArgumentParser(description='Generate import/export/internal specs for MAPL Gridded Component') parser.add_argument('-i','--input', action='store') -parser.add_argument('--declare_specs', action='store', default='declare_specs.h') -parser.add_argument('--declare_local', action='store', default='declare_local.h') +parser.add_argument('--declare_specs', action='store', default='specs.h') +parser.add_argument('--declare_pointer', action='store', default='declare_pointer.h') parser.add_argument('--get_pointer', action='store', default='get_pointer.h') args = parser.parse_args() -f_spec = open(args.declare_specs,'w') -f_local = open(args.declare_local,'w') -f_get_pointer = open(args.get_pointer,'w') - def header(): return """ ! ------------------- @@ -34,21 +30,31 @@ def header(): ! """ -f_spec.write(header()) -f_local.write(header()) -f_get_pointer.write(header()) - specs = reader.read_specs(args.input) + +def open_with_header(filename): + f = open(filename,'w') + f.write(header()) + return f + +f_specs = {} +for category in ('IMPORT','EXPORT','INTERNAL'): + f_specs[category] = open_with_header(category.lower()+'_'+args.declare_specs) + +f_declare_pointers = open_with_header(args.declare_pointer) +f_get_pointers = open_with_header(args.get_pointer) + for category in ('IMPORT','EXPORT','INTERNAL'): for item in specs[category].to_dict('records'): spec = MAPL_DataSpec.MAPL_DataSpec(category.lower(), item) - f_spec.write(spec.emit_spec()) - f_local.write(spec.emit_declare_local()) - f_get_pointer.write(spec.emit_get_pointer()) - -f_spec.close() -f_local.close() -f_get_pointer.close() + f_specs[category].write(spec.emit_specs()) + f_declare_pointers.write(spec.emit_declare_pointers()) + f_get_pointers.write(spec.emit_get_pointers()) + +for category, f in f_specs.items(): + f.close() +f_declare_pointers.close() +f_get_pointers.close() diff --git a/Python/src/MAPL_DataSpec.py b/Python/src/MAPL_DataSpec.py index 40ac5dd59270..623363fd8622 100644 --- a/Python/src/MAPL_DataSpec.py +++ b/Python/src/MAPL_DataSpec.py @@ -21,7 +21,7 @@ def newline(self): def continue_line(self): return "&" + self.newline() + "& " - def emit_spec(self): + def emit_specs(self): return self.emit_header() + self.emit_args() + self.emit_trailer() def get_rank(self): @@ -33,17 +33,17 @@ def get_rank(self): extra_rank = 0 return ranks[self.args['dims']] + extra_rank - def emit_declare_local(self): + def emit_declare_pointers(self): text = self.emit_header() type = 'real' kind = 'REAL32' rank = self.get_rank() dimension = 'dimension(:' + ',:'*(rank-1) + ')' - text = text + type + '(kind=' + str(kind) + '), ' + dimension + ' :: ' + self.args['short_name'] + ' => null()' + text = text + type + '(kind=' + str(kind) + '), pointer, ' + dimension + ' :: ' + self.args['short_name'] + ' => null()' text = text + self.emit_trailer() return text - def emit_get_pointer(self): + def emit_get_pointers(self): text = self.emit_header() text = text + "call MAPL_GetPointer(" + self.category + ', ' + self.args['short_name'] + ", '" + self.args['short_name'] + "', rc=status); VERIFY_(status)" text = text + self.emit_trailer() @@ -58,7 +58,7 @@ def emit_header(self): def emit_args(self): self.indent = self.indent + 5 - text = "call MAPL_Add" + self.category + "Spec(" + self.continue_line() + text = "call MAPL_Add" + self.category.capitalize() + "Spec(gc," + self.continue_line() for option in MAPL_DataSpec.all_options: text = text + self.emit_arg(option) text = text + 'rc=status)' + self.newline() diff --git a/Python/src/reader.py b/Python/src/reader.py index 396b0eff0497..e3d29b03dd5c 100644 --- a/Python/src/reader.py +++ b/Python/src/reader.py @@ -56,7 +56,8 @@ def csv_record_reader(csv_reader): 'xyz' : 'MAPL_DimsHorzVert', 'xyz*' : 'MAPL_DimsHorzVert', 'C' : 'MAPL_VlocationCenter', - 'E' : 'MAPL_VlocationEdge' + 'E' : 'MAPL_VlocationEdge', + '' : 'MAPL_VlocationNone' } specs['IMPORT'].replace(entry_aliases,inplace=True) From 76b60623c0e92710d4fbb20b66dd206ff029ba67 Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Mon, 23 Mar 2020 16:44:37 -0400 Subject: [PATCH 053/109] Moved Python to Apps dir. - Also fixed issues with ungridded_dims - Made default precision default. --- {Python => Apps}/MAPL_GridCompSpecs_ACG.py | 0 {Python => Apps}/src/.gitignore | 0 {Python => Apps}/src/MAPL_DataSpec.py | 16 ++++++++++++---- {Python => Apps}/src/__init__.py | 0 {Python => Apps}/src/reader.py | 1 + 5 files changed, 13 insertions(+), 4 deletions(-) rename {Python => Apps}/MAPL_GridCompSpecs_ACG.py (100%) rename {Python => Apps}/src/.gitignore (100%) rename {Python => Apps}/src/MAPL_DataSpec.py (84%) rename {Python => Apps}/src/__init__.py (100%) rename {Python => Apps}/src/reader.py (98%) diff --git a/Python/MAPL_GridCompSpecs_ACG.py b/Apps/MAPL_GridCompSpecs_ACG.py similarity index 100% rename from Python/MAPL_GridCompSpecs_ACG.py rename to Apps/MAPL_GridCompSpecs_ACG.py diff --git a/Python/src/.gitignore b/Apps/src/.gitignore similarity index 100% rename from Python/src/.gitignore rename to Apps/src/.gitignore diff --git a/Python/src/MAPL_DataSpec.py b/Apps/src/MAPL_DataSpec.py similarity index 84% rename from Python/src/MAPL_DataSpec.py rename to Apps/src/MAPL_DataSpec.py index 623363fd8622..f238652e6992 100644 --- a/Python/src/MAPL_DataSpec.py +++ b/Apps/src/MAPL_DataSpec.py @@ -26,8 +26,8 @@ def emit_specs(self): def get_rank(self): ranks = {'MAPL_DimsHorzVert':3, 'MAPL_DimsHorzOnly':2, 'MAPL_DimsVertOnly':1} - if 'UNGRIDDED_DIMS' in self.args: - extra_dims = self.args['UNGRIDDED_DIMS'].strip('][').split(',') + if 'ungridded_dims' in self.args: + extra_dims = self.args['ungridded_dims'].strip('][').split(',') extra_rank = len(extra_dims) else: extra_rank = 0 @@ -36,10 +36,16 @@ def get_rank(self): def emit_declare_pointers(self): text = self.emit_header() type = 'real' - kind = 'REAL32' + if 'precision' in self.args: + kind = self.args['precision'] + else: + kind = None rank = self.get_rank() dimension = 'dimension(:' + ',:'*(rank-1) + ')' - text = text + type + '(kind=' + str(kind) + '), pointer, ' + dimension + ' :: ' + self.args['short_name'] + ' => null()' + text = text + type + if kind: + text = text + '(kind=' + str(kind) + ')' + text = text +', pointer, ' + dimension + ' :: ' + self.args['short_name'] + ' => null()' text = text + self.emit_trailer() return text @@ -73,6 +79,8 @@ def emit_arg(self, option): text = text + option + "=" if option in MAPL_DataSpec.stringlike_options: value = "'" + value + "'" + elif option == 'ungridded_dims': + value = '[' + value + ']' # convert to Fortran 1D array text = text + value + ", " + self.continue_line() return text diff --git a/Python/src/__init__.py b/Apps/src/__init__.py similarity index 100% rename from Python/src/__init__.py rename to Apps/src/__init__.py diff --git a/Python/src/reader.py b/Apps/src/reader.py similarity index 98% rename from Python/src/reader.py rename to Apps/src/reader.py index e3d29b03dd5c..5bf831e77c5a 100644 --- a/Python/src/reader.py +++ b/Apps/src/reader.py @@ -22,6 +22,7 @@ def csv_record_reader(csv_reader): 'UNITS' : 'units', 'DIMS' : 'dims', 'UNGRIDDED' : 'ungridded_dims', + 'PREC' : 'precision', 'COND' : 'condition' } From be6dbf4baf3306b3a7b44f310e3396ad0f3cafcf Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Tue, 24 Mar 2020 08:54:31 -0400 Subject: [PATCH 054/109] Fixes for GOCART use case. - better handling of non present ungridded_dims - better handling of vlocation --- Apps/src/MAPL_DataSpec.py | 30 ++++++++++++++++++++---------- Apps/src/reader.py | 2 +- 2 files changed, 21 insertions(+), 11 deletions(-) diff --git a/Apps/src/MAPL_DataSpec.py b/Apps/src/MAPL_DataSpec.py index f238652e6992..84c44caa3311 100644 --- a/Apps/src/MAPL_DataSpec.py +++ b/Apps/src/MAPL_DataSpec.py @@ -2,12 +2,18 @@ class MAPL_DataSpec: """Declare and manipulate an import/export/internal specs for a MAPL Gridded component""" + all_options = ['short_name', 'long_name', 'units', + 'dims', 'vlocation', 'num_subtiles', + 'refresh_interval', 'averaging_interval', 'halowidth', + 'precision','default','restart', 'ungridded_dims', + 'field_type', 'staggering', 'rotation'] + + # The following options require quotes in generated code stringlike_options = ['short_name', 'long_name', 'units'] - literal_options = ['dims', 'vlocation', 'num_subtiles', - 'refresh_interval', 'averaging_interval', 'halowidth', - 'precision','default','restart', 'ungridded_dims', - 'field_type', 'staggering', 'rotation'] - all_options = stringlike_options + literal_options + # The following arguments are skipped if value is empty string + optional_options = ['ungridded_dims'] + # The following arguments must be placed within array brackets. + arraylike_options = ['ungridded_dims'] def __init__(self, category, args, indent=3): @@ -26,11 +32,12 @@ def emit_specs(self): def get_rank(self): ranks = {'MAPL_DimsHorzVert':3, 'MAPL_DimsHorzOnly':2, 'MAPL_DimsVertOnly':1} + extra_rank = 0 # unless if 'ungridded_dims' in self.args: - extra_dims = self.args['ungridded_dims'].strip('][').split(',') - extra_rank = len(extra_dims) - else: - extra_rank = 0 + ungridded = self.args['ungridded_dims'] + if ungridded: + extra_dims = ungridded.strip('][').split(',') + extra_rank = len(extra_dims) return ranks[self.args['dims']] + extra_rank def emit_declare_pointers(self): @@ -76,10 +83,13 @@ def emit_arg(self, option): text = '' if option in self.args: value = self.args[option] + if option in MAPL_DataSpec.optional_options: + if self.args[option] == '': + return '' text = text + option + "=" if option in MAPL_DataSpec.stringlike_options: value = "'" + value + "'" - elif option == 'ungridded_dims': + elif option in MAPL_DataSpec.arraylike_options: value = '[' + value + ']' # convert to Fortran 1D array text = text + value + ", " + self.continue_line() return text diff --git a/Apps/src/reader.py b/Apps/src/reader.py index 5bf831e77c5a..cd8f446c11b1 100644 --- a/Apps/src/reader.py +++ b/Apps/src/reader.py @@ -58,7 +58,7 @@ def csv_record_reader(csv_reader): 'xyz*' : 'MAPL_DimsHorzVert', 'C' : 'MAPL_VlocationCenter', 'E' : 'MAPL_VlocationEdge', - '' : 'MAPL_VlocationNone' + 'N' : 'MAPL_VlocationNone' } specs['IMPORT'].replace(entry_aliases,inplace=True) From 014a0a53477ffca39ba0b55a61444c36496a83dd Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Tue, 24 Mar 2020 09:04:09 -0400 Subject: [PATCH 055/109] Updated output name conventions - now defaults are more consistent with legacy Perl ACG --- Apps/MAPL_GridCompSpecs_ACG.py | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/Apps/MAPL_GridCompSpecs_ACG.py b/Apps/MAPL_GridCompSpecs_ACG.py index 959b2b86f407..76f853b70cb1 100644 --- a/Apps/MAPL_GridCompSpecs_ACG.py +++ b/Apps/MAPL_GridCompSpecs_ACG.py @@ -11,9 +11,9 @@ # command line arguments parser = argparse.ArgumentParser(description='Generate import/export/internal specs for MAPL Gridded Component') parser.add_argument('-i','--input', action='store') -parser.add_argument('--declare_specs', action='store', default='specs.h') -parser.add_argument('--declare_pointer', action='store', default='declare_pointer.h') -parser.add_argument('--get_pointer', action='store', default='get_pointer.h') +parser.add_argument('--declare_specs', action='store', default='Spec.h') +parser.add_argument('--declare_pointers', action='store', default='DeclarePointer.h') +parser.add_argument('--get_pointers', action='store', default='GetPointer.h') args = parser.parse_args() @@ -39,10 +39,10 @@ def open_with_header(filename): f_specs = {} for category in ('IMPORT','EXPORT','INTERNAL'): - f_specs[category] = open_with_header(category.lower()+'_'+args.declare_specs) + f_specs[category] = open_with_header(category.lower()+args.declare_specs) -f_declare_pointers = open_with_header(args.declare_pointer) -f_get_pointers = open_with_header(args.get_pointer) +f_declare_pointers = open_with_header(args.declare_pointers) +f_get_pointers = open_with_header(args.get_pointers) for category in ('IMPORT','EXPORT','INTERNAL'): for item in specs[category].to_dict('records'): From 5af16d865aad4f3d5559c0807a9107890a1d5631 Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Tue, 24 Mar 2020 09:10:08 -0400 Subject: [PATCH 056/109] Further consistency with Perl ACG. usage: MAPL_GridCompSpecs_ACG.py [-h] [-i INPUT] [--add_specs ADD_SPECS] [--declare_pointers DECLARE_POINTERS] [--get_pointers GET_POINTERS] Generate import/export/internal specs for MAPL Gridded Component optional arguments: -h, --help show this help message and exit -i INPUT, --input INPUT --add_specs ADD_SPECS --declare_pointers DECLARE_POINTERS --get_pointers GET_POINTERS --- Apps/MAPL_GridCompSpecs_ACG.py | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Apps/MAPL_GridCompSpecs_ACG.py b/Apps/MAPL_GridCompSpecs_ACG.py index 76f853b70cb1..cf20cee4e104 100644 --- a/Apps/MAPL_GridCompSpecs_ACG.py +++ b/Apps/MAPL_GridCompSpecs_ACG.py @@ -11,7 +11,7 @@ # command line arguments parser = argparse.ArgumentParser(description='Generate import/export/internal specs for MAPL Gridded Component') parser.add_argument('-i','--input', action='store') -parser.add_argument('--declare_specs', action='store', default='Spec.h') +parser.add_argument('--add_specs', action='store', default='Spec.h') parser.add_argument('--declare_pointers', action='store', default='DeclarePointer.h') parser.add_argument('--get_pointers', action='store', default='GetPointer.h') args = parser.parse_args() @@ -39,7 +39,7 @@ def open_with_header(filename): f_specs = {} for category in ('IMPORT','EXPORT','INTERNAL'): - f_specs[category] = open_with_header(category.lower()+args.declare_specs) + f_specs[category] = open_with_header(category.capitalize()+args.add_specs) f_declare_pointers = open_with_header(args.declare_pointers) f_get_pointers = open_with_header(args.get_pointers) From 14f70037a5547a81d9aa9626ccc41b584e59ca06 Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Tue, 24 Mar 2020 10:44:57 -0400 Subject: [PATCH 057/109] Converted app into single executable script. --- Apps/MAPL_GridCompSpecs_ACG.py | 224 ++++++++++++++++++++++++++++++--- Apps/src/.gitignore | 2 - Apps/src/MAPL_DataSpec.py | 106 ---------------- Apps/src/__init__.py | 0 Apps/src/reader.py | 70 ----------- 5 files changed, 208 insertions(+), 194 deletions(-) mode change 100644 => 100755 Apps/MAPL_GridCompSpecs_ACG.py delete mode 100644 Apps/src/.gitignore delete mode 100644 Apps/src/MAPL_DataSpec.py delete mode 100644 Apps/src/__init__.py delete mode 100644 Apps/src/reader.py diff --git a/Apps/MAPL_GridCompSpecs_ACG.py b/Apps/MAPL_GridCompSpecs_ACG.py old mode 100644 new mode 100755 index cf20cee4e104..bd2b269cbaba --- a/Apps/MAPL_GridCompSpecs_ACG.py +++ b/Apps/MAPL_GridCompSpecs_ACG.py @@ -1,56 +1,248 @@ +#!/usr/bin/env python3 import argparse import sys import os +import csv +import pandas as pd -my_tool = os.path.dirname(os.path.abspath(__file__)) + '/src' -sys.path.append(my_tool) -import MAPL_DataSpec -import reader +############################################################### +class MAPL_DataSpec: + """Declare and manipulate an import/export/internal specs for a + MAPL Gridded component""" + + all_options = ['short_name', 'long_name', 'units', + 'dims', 'vlocation', 'num_subtiles', + 'refresh_interval', 'averaging_interval', 'halowidth', + 'precision','default','restart', 'ungridded_dims', + 'field_type', 'staggering', 'rotation'] + + # The following options require quotes in generated code + stringlike_options = ['short_name', 'long_name', 'units'] + # The following arguments are skipped if value is empty string + optional_options = ['ungridded_dims'] + # The following arguments must be placed within array brackets. + arraylike_options = ['ungridded_dims'] + + + def __init__(self, category, args, indent=3): + self.category = category + self.args = args + self.indent = indent + + def newline(self): + return "\n" + " "*self.indent + + def continue_line(self): + return "&" + self.newline() + "& " + + def emit_specs(self): + return self.emit_header() + self.emit_args() + self.emit_trailer() + + def get_rank(self): + ranks = {'MAPL_DimsHorzVert':3, 'MAPL_DimsHorzOnly':2, 'MAPL_DimsVertOnly':1} + extra_rank = 0 # unless + if 'ungridded_dims' in self.args: + ungridded = self.args['ungridded_dims'] + if ungridded: + extra_dims = ungridded.strip('][').split(',') + extra_rank = len(extra_dims) + return ranks[self.args['dims']] + extra_rank + + def emit_declare_pointers(self): + text = self.emit_header() + type = 'real' + if 'precision' in self.args: + kind = self.args['precision'] + else: + kind = None + rank = self.get_rank() + dimension = 'dimension(:' + ',:'*(rank-1) + ')' + text = text + type + if kind: + text = text + '(kind=' + str(kind) + ')' + text = text +', pointer, ' + dimension + ' :: ' + self.args['short_name'] + ' => null()' + text = text + self.emit_trailer() + return text + + def emit_get_pointers(self): + text = self.emit_header() + text = text + "call MAPL_GetPointer(" + self.category + ', ' + self.args['short_name'] + ", '" + self.args['short_name'] + "', rc=status); VERIFY_(status)" + text = text + self.emit_trailer() + return text + + def emit_header(self): + text = self.newline() + if 'CONDITION' in self.args and self.args['CONDITION']: + self.indent = self.indent + 3 + text = text + "if (" + self.args['CONDITION'] + ") then" + self.newline() + return text + + def emit_args(self): + self.indent = self.indent + 5 + text = "call MAPL_Add" + self.category.capitalize() + "Spec(gc," + self.continue_line() + for option in MAPL_DataSpec.all_options: + text = text + self.emit_arg(option) + text = text + 'rc=status)' + self.newline() + self.indent = self.indent - 5 + text = text + 'VERIFY_(status)' + return text + + def emit_arg(self, option): + text = '' + if option in self.args: + value = self.args[option] + if option in MAPL_DataSpec.optional_options: + if self.args[option] == '': + return '' + text = text + option + "=" + if option in MAPL_DataSpec.stringlike_options: + value = "'" + value + "'" + elif option in MAPL_DataSpec.arraylike_options: + value = '[' + value + ']' # convert to Fortran 1D array + text = text + value + ", " + self.continue_line() + return text + + def emit_trailer(self): + if 'CONDITION' in self.args and self.args['CONDITION']: + self.indent = self.indent - 3 + text = self.newline() + text = text + "endif" + self.newline() + else: + text = self.newline() + return text + + + + + +def read_specs(specs_filename): + + def csv_record_reader(csv_reader): + """ Read a csv reader iterator until a blank line is found. """ + prev_row_blank = True + for row in csv_reader: + if not (len(row) == 0): + if row[0].startswith('#'): + continue + yield [cell.strip() for cell in row] + prev_row_blank = False + elif not prev_row_blank: + return + + column_aliases = { + 'NAME' : 'short_name', + 'LONG NAME' : 'long_name', + 'VLOC' : 'vlocation', + 'UNITS' : 'units', + 'DIMS' : 'dims', + 'UNGRIDDED' : 'ungridded_dims', + 'PREC' : 'precision', + 'COND' : 'condition' + } + + specs = {} + with open(specs_filename, 'r') as specs_file: + specs_reader = csv.reader(specs_file, skipinitialspace=True,delimiter='|') + gen = csv_record_reader(specs_reader) + schema_version = next(gen)[0] + print("version: ",schema_version) + component = next(gen)[0] + print("component: ",component) + while True: + try: + gen = csv_record_reader(specs_reader) + category = next(gen)[0].split()[1] + bare_columns = next(gen) + bare_columns = [c.strip() for c in bare_columns] + columns = [] + for c in bare_columns: + if c in column_aliases: + columns.append(column_aliases[c]) + else: + columns.append(c) + specs[category] = pd.DataFrame(gen, columns=columns) + except StopIteration: + break + + entry_aliases = {'z' : 'MAPL_DimsVertOnly', + 'z*' : 'MAPL_DimsVertOnly', + 'xy' : 'MAPL_DimsHorzOnly', + 'xy*' : 'MAPL_DimsHorzOnly', + 'xyz' : 'MAPL_DimsHorzVert', + 'xyz*' : 'MAPL_DimsHorzVert', + 'C' : 'MAPL_VlocationCenter', + 'E' : 'MAPL_VlocationEdge', + 'N' : 'MAPL_VlocationNone' + } + + specs['IMPORT'].replace(entry_aliases,inplace=True) + specs['EXPORT'].replace(entry_aliases,inplace=True) + specs['INTERNAL'].replace(entry_aliases,inplace=True) + + return specs -# command line arguments -parser = argparse.ArgumentParser(description='Generate import/export/internal specs for MAPL Gridded Component') -parser.add_argument('-i','--input', action='store') -parser.add_argument('--add_specs', action='store', default='Spec.h') -parser.add_argument('--declare_pointers', action='store', default='DeclarePointer.h') -parser.add_argument('--get_pointers', action='store', default='GetPointer.h') -args = parser.parse_args() def header(): + """ + Returns a standard warning that can be placed at the top of each + generated _Fortran_ include file. + """ + return """ ! ------------------- ! W A R N I N G ! ------------------- ! -! This code fragment is automatically generated by a MAPL_GridCompSpecs_ACG. +! This code fragment is automatically generated by MAPL_GridCompSpecs_ACG. ! Please DO NOT edit it. Any modification made in here will be overwritten ! next time this file is auto-generated. Instead, enter your additions ! or deletions in the .rc file in the src tree. ! """ -specs = reader.read_specs(args.input) - def open_with_header(filename): f = open(filename,'w') f.write(header()) return f + + +############################################# +# Main program begins here +############################################# + + +# Process command line arguments +parser = argparse.ArgumentParser(description='Generate import/export/internal specs for MAPL Gridded Component') +parser.add_argument('-i','--input', action='store') +parser.add_argument('--add_specs', action='store', default='Spec.h') +parser.add_argument('--declare_pointers', action='store', default='DeclarePointer.h') +parser.add_argument('--get_pointers', action='store', default='GetPointer.h') +args = parser.parse_args() + + +# Process blocked CSV input file using pandas +specs = read_specs(args.input) + +# open all output files f_specs = {} for category in ('IMPORT','EXPORT','INTERNAL'): f_specs[category] = open_with_header(category.capitalize()+args.add_specs) - f_declare_pointers = open_with_header(args.declare_pointers) f_get_pointers = open_with_header(args.get_pointers) + +# Generate code from specs (processed above with pandas) for category in ('IMPORT','EXPORT','INTERNAL'): for item in specs[category].to_dict('records'): - spec = MAPL_DataSpec.MAPL_DataSpec(category.lower(), item) + spec = MAPL_DataSpec(category.lower(), item) f_specs[category].write(spec.emit_specs()) f_declare_pointers.write(spec.emit_declare_pointers()) f_get_pointers.write(spec.emit_get_pointers()) +# Close output files for category, f in f_specs.items(): f.close() f_declare_pointers.close() diff --git a/Apps/src/.gitignore b/Apps/src/.gitignore deleted file mode 100644 index 2f78cf5b6651..000000000000 --- a/Apps/src/.gitignore +++ /dev/null @@ -1,2 +0,0 @@ -*.pyc - diff --git a/Apps/src/MAPL_DataSpec.py b/Apps/src/MAPL_DataSpec.py deleted file mode 100644 index 84c44caa3311..000000000000 --- a/Apps/src/MAPL_DataSpec.py +++ /dev/null @@ -1,106 +0,0 @@ -class MAPL_DataSpec: - """Declare and manipulate an import/export/internal specs for a - MAPL Gridded component""" - - all_options = ['short_name', 'long_name', 'units', - 'dims', 'vlocation', 'num_subtiles', - 'refresh_interval', 'averaging_interval', 'halowidth', - 'precision','default','restart', 'ungridded_dims', - 'field_type', 'staggering', 'rotation'] - - # The following options require quotes in generated code - stringlike_options = ['short_name', 'long_name', 'units'] - # The following arguments are skipped if value is empty string - optional_options = ['ungridded_dims'] - # The following arguments must be placed within array brackets. - arraylike_options = ['ungridded_dims'] - - - def __init__(self, category, args, indent=3): - self.category = category - self.args = args - self.indent = indent - - def newline(self): - return "\n" + " "*self.indent - - def continue_line(self): - return "&" + self.newline() + "& " - - def emit_specs(self): - return self.emit_header() + self.emit_args() + self.emit_trailer() - - def get_rank(self): - ranks = {'MAPL_DimsHorzVert':3, 'MAPL_DimsHorzOnly':2, 'MAPL_DimsVertOnly':1} - extra_rank = 0 # unless - if 'ungridded_dims' in self.args: - ungridded = self.args['ungridded_dims'] - if ungridded: - extra_dims = ungridded.strip('][').split(',') - extra_rank = len(extra_dims) - return ranks[self.args['dims']] + extra_rank - - def emit_declare_pointers(self): - text = self.emit_header() - type = 'real' - if 'precision' in self.args: - kind = self.args['precision'] - else: - kind = None - rank = self.get_rank() - dimension = 'dimension(:' + ',:'*(rank-1) + ')' - text = text + type - if kind: - text = text + '(kind=' + str(kind) + ')' - text = text +', pointer, ' + dimension + ' :: ' + self.args['short_name'] + ' => null()' - text = text + self.emit_trailer() - return text - - def emit_get_pointers(self): - text = self.emit_header() - text = text + "call MAPL_GetPointer(" + self.category + ', ' + self.args['short_name'] + ", '" + self.args['short_name'] + "', rc=status); VERIFY_(status)" - text = text + self.emit_trailer() - return text - - def emit_header(self): - text = self.newline() - if 'CONDITION' in self.args and self.args['CONDITION']: - self.indent = self.indent + 3 - text = text + "if (" + self.args['CONDITION'] + ") then" + self.newline() - return text - - def emit_args(self): - self.indent = self.indent + 5 - text = "call MAPL_Add" + self.category.capitalize() + "Spec(gc," + self.continue_line() - for option in MAPL_DataSpec.all_options: - text = text + self.emit_arg(option) - text = text + 'rc=status)' + self.newline() - self.indent = self.indent - 5 - text = text + 'VERIFY_(status)' - return text - - def emit_arg(self, option): - text = '' - if option in self.args: - value = self.args[option] - if option in MAPL_DataSpec.optional_options: - if self.args[option] == '': - return '' - text = text + option + "=" - if option in MAPL_DataSpec.stringlike_options: - value = "'" + value + "'" - elif option in MAPL_DataSpec.arraylike_options: - value = '[' + value + ']' # convert to Fortran 1D array - text = text + value + ", " + self.continue_line() - return text - - def emit_trailer(self): - if 'CONDITION' in self.args and self.args['CONDITION']: - self.indent = self.indent - 3 - text = self.newline() - text = text + "endif" + self.newline() - else: - text = self.newline() - return text - - diff --git a/Apps/src/__init__.py b/Apps/src/__init__.py deleted file mode 100644 index e69de29bb2d1..000000000000 diff --git a/Apps/src/reader.py b/Apps/src/reader.py deleted file mode 100644 index cd8f446c11b1..000000000000 --- a/Apps/src/reader.py +++ /dev/null @@ -1,70 +0,0 @@ -import csv -import pandas as pd - -def read_specs(specs_filename): - - def csv_record_reader(csv_reader): - """ Read a csv reader iterator until a blank line is found. """ - prev_row_blank = True - for row in csv_reader: - if not (len(row) == 0): - if row[0].startswith('#'): - continue - yield [cell.strip() for cell in row] - prev_row_blank = False - elif not prev_row_blank: - return - - column_aliases = { - 'NAME' : 'short_name', - 'LONG NAME' : 'long_name', - 'VLOC' : 'vlocation', - 'UNITS' : 'units', - 'DIMS' : 'dims', - 'UNGRIDDED' : 'ungridded_dims', - 'PREC' : 'precision', - 'COND' : 'condition' - } - - specs = {} - with open(specs_filename, 'r') as specs_file: - specs_reader = csv.reader(specs_file, skipinitialspace=True,delimiter='|') - gen = csv_record_reader(specs_reader) - schema_version = next(gen)[0] - print("version: ",schema_version) - component = next(gen)[0] - print("component: ",component) - while True: - try: - gen = csv_record_reader(specs_reader) - category = next(gen)[0].split()[1] - bare_columns = next(gen) - bare_columns = [c.strip() for c in bare_columns] - columns = [] - for c in bare_columns: - if c in column_aliases: - columns.append(column_aliases[c]) - else: - columns.append(c) - specs[category] = pd.DataFrame(gen, columns=columns) - except StopIteration: - break - - entry_aliases = {'z' : 'MAPL_DimsVertOnly', - 'z*' : 'MAPL_DimsVertOnly', - 'xy' : 'MAPL_DimsHorzOnly', - 'xy*' : 'MAPL_DimsHorzOnly', - 'xyz' : 'MAPL_DimsHorzVert', - 'xyz*' : 'MAPL_DimsHorzVert', - 'C' : 'MAPL_VlocationCenter', - 'E' : 'MAPL_VlocationEdge', - 'N' : 'MAPL_VlocationNone' - } - - specs['IMPORT'].replace(entry_aliases,inplace=True) - specs['EXPORT'].replace(entry_aliases,inplace=True) - specs['INTERNAL'].replace(entry_aliases,inplace=True) - - return specs - - From 020dbab3d3043a35a3930b38428456fb7183b822 Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Tue, 24 Mar 2020 10:47:01 -0400 Subject: [PATCH 058/109] Default python should work. --- Apps/MAPL_GridCompSpecs_ACG.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Apps/MAPL_GridCompSpecs_ACG.py b/Apps/MAPL_GridCompSpecs_ACG.py index bd2b269cbaba..0108d4106c8b 100755 --- a/Apps/MAPL_GridCompSpecs_ACG.py +++ b/Apps/MAPL_GridCompSpecs_ACG.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python3 +#!/usr/bin/env python import argparse import sys import os From 9cbc8eaf762c284f03d3b51132bec6a07da84e3f Mon Sep 17 00:00:00 2001 From: Elliot Sherman Date: Wed, 25 Mar 2020 13:27:15 -0400 Subject: [PATCH 059/109] added friendlyto option --- Apps/MAPL_GridCompSpecs_ACG.py | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/Apps/MAPL_GridCompSpecs_ACG.py b/Apps/MAPL_GridCompSpecs_ACG.py index bd2b269cbaba..7a30525e6f29 100755 --- a/Apps/MAPL_GridCompSpecs_ACG.py +++ b/Apps/MAPL_GridCompSpecs_ACG.py @@ -1,4 +1,4 @@ -#!/usr/bin/env python3 +#!/usr/bin/env python import argparse import sys import os @@ -15,10 +15,11 @@ class MAPL_DataSpec: 'dims', 'vlocation', 'num_subtiles', 'refresh_interval', 'averaging_interval', 'halowidth', 'precision','default','restart', 'ungridded_dims', - 'field_type', 'staggering', 'rotation'] + 'field_type', 'staggering', 'rotation', + 'friendlyto'] # The following options require quotes in generated code - stringlike_options = ['short_name', 'long_name', 'units'] + stringlike_options = ['short_name', 'long_name', 'units', 'friendlyto'] # The following arguments are skipped if value is empty string optional_options = ['ungridded_dims'] # The following arguments must be placed within array brackets. From ab032fd0f8afefa699e4b5a272827cb752f3d362 Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Wed, 25 Mar 2020 14:12:41 -0400 Subject: [PATCH 060/109] Added aliases for additional options. --- Apps/MAPL_GridCompSpecs_ACG.py | 51 +++++++++++++++++++++------------- 1 file changed, 32 insertions(+), 19 deletions(-) diff --git a/Apps/MAPL_GridCompSpecs_ACG.py b/Apps/MAPL_GridCompSpecs_ACG.py index 7a30525e6f29..1b05bfd86419 100755 --- a/Apps/MAPL_GridCompSpecs_ACG.py +++ b/Apps/MAPL_GridCompSpecs_ACG.py @@ -18,10 +18,17 @@ class MAPL_DataSpec: 'field_type', 'staggering', 'rotation', 'friendlyto'] + # The following arguments are skipped if value is empty string + optional_options = [ 'dims', 'vlocation', 'num_subtiles', + 'refresh_interval', 'averaging_interval', 'halowidth', + 'precision','default','restart', 'ungridded_dims', + 'field_type', 'staggering', 'rotation', + 'friendlyto'] + # The following options require quotes in generated code stringlike_options = ['short_name', 'long_name', 'units', 'friendlyto'] - # The following arguments are skipped if value is empty string - optional_options = ['ungridded_dims'] + + # The following arguments must be placed within array brackets. arraylike_options = ['ungridded_dims'] @@ -132,14 +139,17 @@ def csv_record_reader(csv_reader): return column_aliases = { - 'NAME' : 'short_name', - 'LONG NAME' : 'long_name', - 'VLOC' : 'vlocation', - 'UNITS' : 'units', - 'DIMS' : 'dims', - 'UNGRIDDED' : 'ungridded_dims', - 'PREC' : 'precision', - 'COND' : 'condition' + 'NAME' : 'short_name', + 'LONG NAME' : 'long_name', + 'VLOC' : 'vlocation', + 'UNITS' : 'units', + 'DIMS' : 'dims', + 'UNGRIDDED' : 'ungridded_dims', + 'PREC' : 'precision', + 'COND' : 'condition', + 'DEFAULT' : 'default', + 'RESTART' : 'restart', + 'FRIENDLYTO' : 'friendlyto' } specs = {} @@ -166,15 +176,18 @@ def csv_record_reader(csv_reader): except StopIteration: break - entry_aliases = {'z' : 'MAPL_DimsVertOnly', - 'z*' : 'MAPL_DimsVertOnly', - 'xy' : 'MAPL_DimsHorzOnly', - 'xy*' : 'MAPL_DimsHorzOnly', - 'xyz' : 'MAPL_DimsHorzVert', - 'xyz*' : 'MAPL_DimsHorzVert', - 'C' : 'MAPL_VlocationCenter', - 'E' : 'MAPL_VlocationEdge', - 'N' : 'MAPL_VlocationNone' + entry_aliases = {'z' : 'MAPL_DimsVertOnly', + 'xy' : 'MAPL_DimsHorzOnly', + 'xyz' : 'MAPL_DimsHorzVert', + 'C' : 'MAPL_VlocationCenter', + 'E' : 'MAPL_VlocationEdge', + 'N' : 'MAPL_VlocationNone', + 'OPT' : 'MAPL_RestartOptional', + 'SKIP' : 'MAPL_RestartSkip', + 'REQ' : 'MAPL_RestartRequired', + 'BOOT' : 'MAPL_RestartBoot', + 'SKIPI' : 'MAPL_RestartSkipInitial' + } specs['IMPORT'].replace(entry_aliases,inplace=True) From 643792e78ea2559a8d043732de96cb910019a91c Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Thu, 26 Mar 2020 08:45:21 -0400 Subject: [PATCH 061/109] Importing a directory that has long been part of MAPL. - Apparently was never tagged (under CVS) for any ADAS or AGCM modules. --- Python/MAPL/Abstract.py | 15 ++ Python/MAPL/Date.py | 354 +++++++++++++++++++++++++++++++++ Python/MAPL/__init__.py | 56 ++++++ Python/MAPL/config.py | 320 +++++++++++++++++++++++++++++ Python/MAPL/constants.py | 33 +++ Python/MAPL/eta.py | 420 +++++++++++++++++++++++++++++++++++++++ Python/MAPL/exp.py | 112 +++++++++++ Python/MAPL/filelock.py | 77 +++++++ Python/MAPL/history.py | 59 ++++++ Python/MAPL/job.py | 92 +++++++++ Python/MAPL/run.py | 84 ++++++++ 11 files changed, 1622 insertions(+) create mode 100644 Python/MAPL/Abstract.py create mode 100644 Python/MAPL/Date.py create mode 100644 Python/MAPL/__init__.py create mode 100644 Python/MAPL/config.py create mode 100644 Python/MAPL/constants.py create mode 100644 Python/MAPL/eta.py create mode 100644 Python/MAPL/exp.py create mode 100644 Python/MAPL/filelock.py create mode 100644 Python/MAPL/history.py create mode 100644 Python/MAPL/job.py create mode 100644 Python/MAPL/run.py diff --git a/Python/MAPL/Abstract.py b/Python/MAPL/Abstract.py new file mode 100644 index 000000000000..b6edda13a460 --- /dev/null +++ b/Python/MAPL/Abstract.py @@ -0,0 +1,15 @@ +class Method (object): + def __init__(self, func): + self._function = func + + def __get__(self, obj, type): + return self.AbstractMethodHelper(self._function, type) + + class AbstractMethodHelper (object): + def __init__(self, func, cls): + self._function = func + self._class = cls + + def __call__(self, *args, **kwargs): + raise NotImplementedError('Abstract method `' + self._class.__name__ \ + + '.' + self._function + '\' called') diff --git a/Python/MAPL/Date.py b/Python/MAPL/Date.py new file mode 100644 index 000000000000..60e73a5ec4b5 --- /dev/null +++ b/Python/MAPL/Date.py @@ -0,0 +1,354 @@ +""" +The module defines a class Date and several methods to deal with it, including conversions. + +The "format" of the Date class is as follows: Each instance has three attributes, +year, month and day, all represented as integers and writable. Although no constraints are +enforced, the intended range of values is: + +1 <= day <= 31 (more precisely 1 <= day <= NumberDaysMonth(month, year)) +1 <= month <= 12 (1 is January and 12 is December) + +It is up to the client of this class to make sure that all assignments are correct. + +In making conversions with the time module (wether in seconds or in a 9-tuple) local time +is always used. + +History of changes: +version 2.0.1: + - Added docstring to the module. + - Changed implementation of next() and previous() to take advantage of NumberDaysMonth(). + +version 2.0: Complete rewrite of the module. + - Removed weekday as instance attribute of the class. + - Added conversion to and from Julian Day number. Added NumberDaysMonth function. Added + __sub__ and __add__. Made the class hashable. + - Added some (still insuficient and completely ad-hoc) test code when run as __main__. +""" + +__version__ = 2.01 +__author__ = "G. Rodrigues" + +import time + +#Needed for conversion to COM dates. +try: + import pythoncom +except: + pass + +def IsLeapYear(year): + """Returns 1 if year is a leap year, zero otherwise.""" + if year%4 == 0: + if year%100 == 0: + if year%400 == 0: + return 1 + else: + return 0 + else: + return 1 + else: + return 0 + +def NumberDaysYear(year): + """Returns the number of days in the year.""" + return 365 + IsLeapYear(year) + +def NumberDaysMonth(month = None, year = None): + """Returns the number of days in the month. + + If any of the arguments is missing (month or year) the current month/year is assumed.""" + if month is None: + m = time.localtime()[1] + else: + m = month + + if year is None: + y = time.localtime()[0] + else: + y = year + + if m == 2: + if IsLeapYear(y): + return 29 + else: + return 28 + elif m in (1, 3, 5, 7, 8, 10, 12): + return 31 + else: + return 30 + + +class Date(object): + """The Date class.""" + + Weekdays = ["Monday", + "Tuesday", + "Wednesday", + "Thursday", + "Friday", + "Saturday", + "Sunday"] + + Months = ["January", + "February", + "March", + "April", + "May", + "June", + "July", + "August", + "September", + "October", + "November", + "December"] + + #The slots in a Date object are constrained to allow more efficient operations. + __slots__ = ["year", "month", "day"] + + def __init__(self, tm = None): + """The initializer has an optional argument, time, in the time module format, + wether as in seconds since the epoch (Unix time) wether as a tuple (time tuple). + If it is not provided, then it returns the current date.""" + if tm is None: + t = time.localtime() + else: + if isinstance(tm, int): + t = time.localtime(tm) + else: + t = tm + + self.year, self.month, self.day = t[:3] + + def weekday(self): + """Returns the weekday of the date. + + The format is as in the time module: Monday is 0 and sunday is 6.""" + a = (14 - self.month)//12 + y = self.year - a + m = self.month + 12*a -2 + d = (self.day + y + y//4 - y//100 + y//400 + (31*m//12))%7 + if d: + ret = d - 1 + else: + ret = 6 + return ret + + def __str__(self): + return "%s, %d-%s-%d" % (Date.Weekdays[self.weekday()], + self.day, + Date.Months[self.month - 1], + self.year) + + def copy(self): + """Deep copy of Date objects.""" + ret = Date() + ret.year, ret.month, ret.day = self.year, self.month, self.day + return ret + + #The iterator protocol. The iteration is "destructive", like in files. + def __iter__(self): + return self + + def next(self): + #Last day of the month. + if self.day == NumberDaysMonth(self.month, self.year): + self.day = 1 + #December case. + if self.month == 12: + self.month = 1 + self.year += 1 + else: + self.month += 1 + else: + self.day += 1 + + #Extended iterator protocol. One can go backwards. + def previous(self): + #First day of the month. + if self.day == 1: + #January case. + if self.month == 1: + self.month = 12 + self.year -= 1 + else: + self.month -= 1 + self.day = NumberDaysMonth(self.month, self.year) + else: + self.day -= 1 + + #Comparison methods. + def __eq__(self, date): + return self.year == date.year and self.month == date.month and\ + self.day == date.day + + def __lt__(self, other): + return (self.year, self.month, self.day) < (other.year, other.month, other.day) + + def __le__(self, other): + return (self.year, self.month, self.day) <= (other.year, other.month, other.day) + + #Dates can be used as keys in dictionaries. + def __hash__(self): + return hash((self.year, self.month, self.day)) + + #Some useful methods. + def GetYearDay(self): + """Returns the year day of a date.""" + ret = self.day + for month in range(1, self.month): + ret += NumberDaysMonth(month, self.year) + return ret + + def DaysToEndYear(self): + """Returns the number of days until the end of the year.""" + ret = NumberDaysMonth(self.month, self.year) - self.day + for i in range(self.month + 1, 13): + ret += NumberDaysMonth(i, self.year) + return ret + + def GetWeekday(self): + """Returns the weekday of the date in string format.""" + return Date.Weekdays[self.weekday()] + + def GetMonth(self): + """Returns the month of the date in string format.""" + return Date.Months[self.month - 1] + + def ToJDNumber(self): + """Returns the Julian day number of a date.""" + a = (14 - self.month)//12 + y = self.year + 4800 - a + m = self.month + 12*a - 3 + return self.day + ((153*m + 2)//5) + 365*y + y//4 - y//100 + y//400 - 32045 + + #Binary operations. + def __add__(self, n): + """Adds a (signed) number of days to the date.""" + if isinstance(n, int): + #Calculate julian day number and add n. + temp = self.ToJDNumber() + n + #Convert back to date format. + return DateFromJDNumber(temp) + else: + raise TypeError, "%s is not an integer." % str(n) + + def __sub__(self, date): + """Returns the (signed) difference of days between the dates.""" + #If it is an integer defer calculation to the __add__ method. + if isinstance(date, int): + return self.__add__(-date) + elif isinstance(date, Date): + #Case: The years are equal. + if self.year == date.year: + return self.GetYearDay() - date.GetYearDay() + else: + if self < date: + ret = self.DaysToEndYear() + date.GetYearDay() + for year in range(self.year + 1, date.year): + ret += NumberDaysYear(year) + return -ret + else: + ret = date.DaysToEndYear() + self.GetYearDay() + for year in range(date.year + 1, self.year): + ret += NumberDaysYear(year) + return ret + else: + raise TypeError, "%s is neither an integer nor a Date." % str(date) + + #Adding an integer is "commutative". + def __radd__(self, n): + return self.__add__(n) + + #Conversion methods. + def ToTimeTuple(self): + """Convert a date into a time tuple (time module) corresponding to the + same day with the midnight hour.""" + ret = [self.year, self.month, self.day] + ret.extend([0, 0, 0]) + ret.append(self.weekday()) + ret.extend([self.GetYearDay(), 0]) + return tuple(ret) + + def ToUnixTime(self): + """Convert a date into Unix time (seconds since the epoch) corresponding + to the same day with the midnight hour.""" + return time.mktime(self.ToTimeTuple()) + + def ToCOMTime(self): + """Convert a date into COM format.""" + return pythoncom.MakeTime(self.ToUnixTime()) + + +#More conversion functions. +def DateFromJDNumber(n): + """Returns a date corresponding to the given Julian day number.""" + if not isinstance(n, int): + raise TypeError, "%s is not an integer." % str(n) + + a = n + 32044 + b = (4*a + 3)//146097 + c = a - (146097*b)//4 + d = (4*c + 3)//1461 + e = c - (1461*d)//4 + m = (5*e + 2)//153 + + ret = Date() + ret.day = e + 1 - (153*m + 2)//5 + ret.month = m + 3 - 12*(m//10) + ret.year = 100*b + d - 4800 + m/10 + return ret + +def DateFromCOM(t): + """Converts a COM time directly into the Date format.""" + return Date(int(t)) + +def strpdate(s): + """This function reads a string in the standard date representation + format and returns a date object.""" + ret = Date() + temp = s.split(", ") + temp = temp[1].split("-") + ret.year, ret.month, ret.day = (int(temp[2]), + Date.Months.index(temp[1]) + 1, + int(temp[0])) + return ret + + +#Some test code. +if __name__ == "__main__": + #Print the days still left in the month. + temp = Date() + curr_month = temp.month + while temp.month == curr_month: + print temp + temp.next() + + print "\n" + + #How many days until the end of the year? + temp = Date() + temp.day, temp.month = 1, 1 + curr_year = temp.year + while temp.year == curr_year: + print "%s is %d days away from the end of the year." % (str(temp), + temp.DaysToEndYear()) + temp += NumberDaysMonth(temp.month) + + print "\n" + + #Playing with __sub__. + temp = Date() + temp_list = [] + curr_year = temp.year + while temp.year == curr_year: + temp_list.append(temp) + temp += NumberDaysMonth(temp.month) + for elem in temp_list: + print "%s differs %d days from current date: %s" % (str(elem), + elem - Date(), + str(Date())) + + print "\n" + + #Swapping arguments works? + print 23 + Date() diff --git a/Python/MAPL/__init__.py b/Python/MAPL/__init__.py new file mode 100644 index 000000000000..329656a7e887 --- /dev/null +++ b/Python/MAPL/__init__.py @@ -0,0 +1,56 @@ +""" +This package contains foundation classes for assembling MAPL-based +systems using Python as the scripting language. At this stage of +development system are composed of MAPL-based Applications in the form +of stand alone executables (e.g., GEOSgcm.x). The following packages +define the basic functionality: + +exp + This package defines the base class *Exp* (as in *experiment*) which + controls the execution of a long *experiment*. Each experiment is + carried out by means of several *jobs* which are submitted through a + queueing system such as PBS. + +job + This package defines the base class *Job* which inherits from + *Exp*. A *job* carries out a portion of the *experiment*, + itself consisting of several *run* segments. + +run + This package defines the base class *Run* which inherits from + *Job* extending it with methods for running a single *segment* of a + job. A *run* segment consists of running the stand-alone Fortran + executable for a fixed period of time. + +config + This package defines the class Config providing functionality for + basic resource file management loosely based in the ESMF_Config + class. + +Typically, an application such as GEOSgcm would inherit from +*Run* and implement specific methods for dealing with its own +resource files, boundary contitions, restarts and pre- and +post-processing. + +Here is an illustration of an experiment consistng of 3 jobs, each +with 2 run segments. + + |----------------------- Experiment ------------------------| + |------ Job 1 ------|------ Job 2 ------|------ Job 3 ------| + |- Run 1 -|- Run 2 -|- Run 3 -|- Run 4 -|- Run 5 -|- Run 6 -| + +If each run segment is 2 weeks long, each job performs a 4 week +integration, and the the whole experiment is about 3 month long. + +""" + +__version__ = "0.1.2" + +from exp import * +from job import * +from run import * +from config import * +from history import * +from Date import * +from filelock import * + diff --git a/Python/MAPL/config.py b/Python/MAPL/config.py new file mode 100644 index 000000000000..36cedb329ab2 --- /dev/null +++ b/Python/MAPL/config.py @@ -0,0 +1,320 @@ +""" +A simpe implementation of a ESMF_Config-like class in Python. +Tables are not supported yet. + +""" + +__version__ = "0.1.0" + +import string +import re +import os +import sys +from types import * +from datetime import datetime + +class Config(object): + + def __init__(self,RcFiles,delim=':',Environ=True): + """ + Creates config object from one or more resource files. + If set to True, the *Environ* parameter will be used to + determined whether resource files are interpolated based on + the current value of environment variables. + """ + + if type(RcFiles) is StringType: + Files = ( RcFiles, ) # in case a single file is given + else: + Files = RcFiles # more often, a List/Tuple of RC files + + self.Rc = {} + self.delim = delim + for rcfile in Files: + self.Lines = open(rcfile).readlines() + for line in self.Lines: + line = line.rstrip() + name, value, comment = _parseLine(line,self.delim) + if Environ: + if value is not None: + value = string.Template(value).safe_substitute(os.environ) + if name: + self.Rc[name] = { 'value': value, + 'comment': comment, + 'flag': 0} + + def __call__(self,name,value=None): + """Either get or set a resource depending on whether *value* is given""" + if value == None: + if self.Rc.__contains__(name): + return self.Rc[name]['value'] + else: + if self.Rc.__contains__(name): + self.Rc[name]['value'] = value + self.Rc[name]['flag'] = 1 + return self.Rc[name]['value'] + return None + + get = __call__ + + def set(self,name,value): + return self.__call__(name,value) + + def save(self,rcfile=None): + """Save to resource file.""" + if rcfile is None: + f = sys.stdout + else: + f = open(rcfile,'w') + for line in self.Lines: + line = line.rstrip() + name, value, comment = _parseLine(line,self.delim) + if name: + if self.Rc[name]['flag']: + if comment: + comment = '#' + comment + else: + comment = '' + value = self.Rc[name]['value'] + print >>f, name + self.delim+' ' + str(value) + comment # this line has been edited + else: + print >>f, line + else: + print >>f, line + f.close() + + def upd(self,dict): + pass + + def interp(self,str,outFile=None,**kws): + """ + Use the resource values for $-substitution (a.k.a. + interpolation.) When *outFile* is specified *str* is assumed + to be the name of the input template file. Otherwise, + *str* is a simple string template to be interpolated. + """ + if outFile is None: + return self.interpStr(str,**kws) + else: + self.interpFile(str,outFile,**kws) + + def interpFile(self,template,outFile,**kws): + """ + Use the resource values for $-substitution in the + input template file *Template* + """ + Tmpl = open(template).readlines() + Text = [] + for tmpl in Tmpl: + Text.append(self.interpStr(tmpl,**kws)) + open(outFile,"w").writelines(Text) + + def interpStr(self,template,strict=False): + """ + Replace occurences of resource variables in the + input string *StrTemplate*. For example, if + StrTemplate = "This is $thing" + $thing will be replaced with the value of the + resource *thing*. When *strict* is True, an + exeption will be raised if any $-token is left + unresolved. + """ + dict = {} + for name in self.Rc: + dict[name] = self.Rc[name]['value'] + if strict: + return string.Template(template).substitute(dict) + else: + return string.Template(template).safe_substitute(dict) + + def regex(self,pattern,ignoreCase=True): + """ + Return a dictionary with those resources matching the + regular expression *pattern*. For example. + cf.regex('RESTART_FILE').values() + return a list of all restart files. + """ + if ignoreCase is True: + p = re.compile(pattern,re.IGNORECASE) + else: + p = re.compile(pattern) + dict = {} + for name in self.Rc: + if p.search(name) is not None: + dict[name] = self.Rc[name]['value'] + return dict + + def setenv(self,Only=None): + """ + Use resources to set environment variables. Option, + one can provide a list of strings (*Only*) with those + resources to be turned into environment variables. + """ + for name in self.Rc: + if Only is None: + os.environ[name] = self.Rc[name]['value'] + elif name in Only: + os.environ[name] = self.Rc[name]['value'] + + def keys(self): + """ + Return list of resource names. + """ + return self.Rc.keys() + + def values(self): + """ + Return list of resource names. + """ + vals = [] + for name in self.Rc: + vals.append(self.Rc[name]['value']) + return vals + + def strTemplate(self,name,expid=None,nymd=None,nhms=None, + yy=None,mm=None,dd=None,h=None,m=None,s=None,dtime=None): + """ + Expand GrADS style templates in resource *name*. See + static method strTemplate() for additional information + on the date/time input parameters. + """ + return strTemplate(self(name),expid,nymd,nhms,yy,mm,dd,h,m,s,dtime) + +# Static Methods +# -------------- + +def _parseLine(line,delim): + name, value, comment = (None,None,None) + if line: + all = line.split('#',1) + rc = all[0] + if len(all)>1: + comment = all[1] + if rc: + rcs = rc.split(delim,1) # resource name and value + if len(rcs) > 1: + name = rcs[0].strip() + value = rcs[1].strip() + return name, value, comment + +def strTemplate(templ,expid=None,nymd=None,nhms=None, + yy=None,mm=None,dd=None,h=None,m=None,s=None, + dtime=None): + """ + Expands GrADS template in string *templ*. On input, + + expid --- experiment id, expands %s + yy --- year, expands %y4 and %y2 + mm --- month, expands %m2 or %m3 + dd --- day, expands %d2 + h --- hour, expands %h2 + m --- minute, expands %n2 + s --- minute, expands %S2 (notice capital "S") + + nymd --- same as yy*10000 + mm*100 + dd + nhms --- same as h *10000 + h*100 + s + + dtime --- python datetime + + Unlike GrADS, notice that seconds are expanded using the %S2 token. + Input date/time can be either strings or integers. + + Examples: + + >>> templ = "%s.aer_f.eta.%m3%y2.%y4%m2%d2_%h2:%n2:%S2z.nc" + >>> print strTemplate(templ,expid="e0054A",yy=2008,mm=6,dd=30,h=1,m=30,s=47) + e0054A.aer_f.eta.jun08.20080630_01:30:47z.nc + >>> print strTemplate(templ,expid="e0054A",nymd=20080630,nhms=13000) + e0054A.aer_f.eta.jun08.20080630_01:30:00z.nc + + """ + + MMM = ( 'jan', 'feb', 'mar', 'apr', 'may', 'jun', + 'jul', 'aug', 'sep', 'oct', 'nov', 'dec' ) + + str_ = templ[:] + + if dtime is not None: + yy = dtime.year + mm = dtime.month + dd = dtime.day + h = dtime.hour + m = dtime.minute + s = dtime.second + + if nymd is not None: + nymd = int(nymd) + yy = nymd/10000 + mm = (nymd - yy*10000)/100 + dd = nymd - (10000*yy + 100*mm ) + + if nhms is not None: + nhms = int(nhms) + h = nhms/10000 + m = (nhms - h * 10000)/100 + s = nhms - (10000*h + 100*m) + + if expid is not None: + str_ = str_.replace('%s',expid) + if yy is not None: + y2 = yy%100 + str_ = str_.replace('%y4',str(yy)) + str_ = str_.replace('%y2',"%02d"%y2) + if mm is not None: + mm = int(mm) + mmm = MMM[mm-1] + str_ = str_.replace('%m2',"%02d"%mm) + str_ = str_.replace('%m3',mmm) + if dd is not None: + str_ = str_.replace('%d2',"%02d"%int(dd)) + if h is not None: + str_ = str_.replace('%h2',"%02d"%int(h)) + if m is not None: + str_ = str_.replace('%n2',"%02d"%int(m)) + if s is not None: + str_ = str_.replace('%S2',"%02d"%int(s)) + + return str_ + +#................................................................ + +# Testing +# ------- + +def _ut_strTemplate(): + + + + templ = "%s.aer_f.eta.%m3%y2.%y4%m2%d2_%h2:%n2:%S2z.nc" + + expid = "e0054A" + yy = "2008" + mm = "10" + dd = "30" + + h = "1" + m = "30" + s = "47" + + dtime = datetime(2008,10,30,1,30,47) + + nymd = int(yy) * 10000 + int(mm)*100 + int(dd) + nhms = int(h) * 10000 + int(m) * 100 + int(s) + + print "Template: "+templ + print strTemplate(templ) + print strTemplate(templ,expid=expid) + print strTemplate(templ,expid=expid,yy=2008) + print strTemplate(templ,expid=expid,yy=2008,mm=mm) + print strTemplate(templ,expid=expid,yy=2008,mm=mm,dd=dd) + print strTemplate(templ,expid=expid,yy=2008,mm=mm,dd=dd,h=h) + print strTemplate(templ,expid=expid,yy=2008,mm=mm,dd=dd,h=h,m=m,s=s) + print strTemplate(templ,expid=expid,nymd=nymd) + print strTemplate(templ,expid=expid,nymd=nymd,nhms=nhms) + print strTemplate(templ,expid=expid,dtime=dtime) + +if __name__ == "__main__": + cf = Config('test.rc', delim=' = ') + +# _ut_strTemplate() + diff --git a/Python/MAPL/constants.py b/Python/MAPL/constants.py new file mode 100644 index 000000000000..54bc5fe35c8d --- /dev/null +++ b/Python/MAPL/constants.py @@ -0,0 +1,33 @@ +""" +Python version of MAPL Constants. +""" + +MAPL_PI = 3.14159265358979323846 +MAPL_GRAV = 9.80 # m^2/s +MAPL_RADIUS = 6376.0E3 # m +MAPL_OMEGA = 2.0*MAPL_PI/86164.0 # 1/s +MAPL_ALHL = 2.4665E6 # J/kg @15C +MAPL_ALHF = 3.3370E5 # J/kg +MAPL_ALHS = MAPL_ALHL+MAPL_ALHF # J/kg +MAPL_STFBOL = 5.6734E-8 # W/(m^2 K^4) +MAPL_AIRMW = 28.97 # kg/Kmole +MAPL_H2OMW = 18.01 # kg/Kmole +MAPL_O3MW = 47.9982 # kg/Kmole +MAPL_RUNIV = 8314.3 # J/(Kmole K) +MAPL_KAPPA = 2.0/7.0 # -- +MAPL_RVAP = MAPL_RUNIV/MAPL_H2OMW # J/(kg K) +MAPL_RGAS = MAPL_RUNIV/MAPL_AIRMW # J/(kg K) +MAPL_CP = MAPL_RGAS/MAPL_KAPPA # J/(kg K) +MAPL_P00 = 100000.0 # Pa +MAPL_CAPICE = 2000. # J/(K kg) +MAPL_CAPWTR = 4218. # J/(K kg) +MAPL_RHOWTR = 1000. # kg/m^3 +MAPL_NUAIR = 1.533E-5 # m^2/S (@ 18C) +MAPL_TICE = 273.16 # K +MAPL_SRFPRS = 98470 # Pa +MAPL_KARMAN = 0.40 # -- +MAPL_USMIN = 1.00 # m/s +MAPL_VIREPS = MAPL_AIRMW/MAPL_H2OMW-1.0 # -- +MAPL_AVOGAD = 6.023E26 # 1/kmol + +MAPL_UNDEF = 1.0e15 diff --git a/Python/MAPL/eta.py b/Python/MAPL/eta.py new file mode 100644 index 000000000000..c39b07ffb6f0 --- /dev/null +++ b/Python/MAPL/eta.py @@ -0,0 +1,420 @@ +""" +Python implementation of set_eta module under GMA_Shared/GMAO_hermes. + +""" + +from numpy import ones + +ak = {} +bk = {} + +# NCAR settings +# ------------- + +ak['18'] = [ 291.70, 792.92, 2155.39, 4918.34, 8314.25, + 7993.08, 7577.38, 7057.52, 6429.63, 5698.38, + 4879.13, 3998.95, 3096.31, 2219.02, 1420.39, + 754.13, 268.38, 0.0000, 0.0000 ] + +bk['18'] = [ 0.0000, 0.0000, 0.0000, 0.0000, 0.0000, + 0.0380541, 0.0873088, 0.1489307, 0.2232996, + 0.3099406, 0.4070096, 0.5112977, 0.6182465, + 0.7221927, 0.8168173, 0.8957590, 0.9533137, + 0.9851122, 1.0 ] + +ak['26'] = [ 219.4067, 489.5209, 988.2418, 1805.201, + 2983.724, 4462.334, 6160.587, 7851.243, + 7731.271, 7590.131, 7424.086, 7228.744, + 6998.933, 6728.574, 6410.509, 6036.322, + 5596.111, 5078.225, 4468.96, 3752.191, + 2908.949, 2084.739, 1334.443, 708.499, + 252.136, 0., 0. ] + +bk['26'] = [ 0., 0., 0., 0., + 0., 0., 0., 0., + 0.01505309, 0.03276228, 0.05359622, 0.07810627, + 0.1069411, 0.14086370, 0.180772, 0.227722, + 0.2829562, 0.3479364, 0.4243822, 0.5143168, + 0.6201202, 0.7235355, 0.8176768, 0.8962153, + 0.9534761, 0.9851122, 1. ] + +ak['30'] = [ 225.523952394724, 503.169186413288, 1015.79474285245, + 1855.53170740604, 3066.91229343414, 4586.74766123295, + 6332.34828710556, 8070.14182209969, 9494.10423636436, + 11169.321089983, 13140.1270627975, 15458.6806893349, + 18186.3352656364, 17459.799349308, 16605.0657629967, + 15599.5160341263, 14416.541159153, 13024.8308181763, + 11387.5567913055, 9461.38575673103, 7534.44507718086, + 5765.89405536652, 4273.46378564835, 3164.26791250706, + 2522.12174236774, 1919.67375576496, 1361.80268600583, + 853.108894079924, 397.881818935275, 0., + 0. ] + +bk['30'] = [ 0., 0., + 0., 0., 0., + 0., 0., 0., + 0., 0., 0., + 0., 0., 0.03935482725501, + 0.085653759539127, 0.140122056007385, 0.20420117676258, + 0.279586911201477, 0.368274360895157, 0.47261056303978, + 0.576988518238068, 0.672786951065063, 0.75362843275070, + 0.813710987567902, 0.848494648933411, 0.88112789392471, + 0.911346435546875, 0.938901245594025, 0.96355980634689, + 0.985112190246582, 1. ] + +# NASA DAO settings +# ----------------- + +ak['32'] = [0.00000, 106.00000, 224.00000, + 411.00000, 685.00000, 1065.00000, + 1565.00000, 2179.80000, 2900.00000, + 3680.00000, 4550.00000, 5515.00000, + 6607.00000, 7844.00000, 9236.56616, + 10866.34280, 12783.70000, 15039.29900, + 17693.00000, 20815.20900, 24487.49020, + 28808.28710, 32368.63870, 33739.96480, + 32958.54300, 30003.29880, 24930.12700, + 18568.89060, 12249.20510, 6636.21191, + 2391.51416, 0.00000, 0.00000 ] + +bk['32'] = [0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.01523, 0.06132, + 0.13948, 0.25181, 0.39770, + 0.55869, 0.70853, 0.83693, + 0.93208, 0.98511, 1.00000 ] + +ak['48'] = [40.00000, 100.00000, 200.00000, + 350.00000, 550.00000, 800.00000, + 1085.00000, 1390.00000, 1720.00000, + 2080.00000, 2470.00000, 2895.00000, + 3365.00000, 3890.00000, 4475.00000, + 5120.00000, 5830.00000, 6608.00000, + 7461.00000, 8395.00000, 9424.46289, + 10574.46900, 11864.80330, 13312.58850, + 14937.03770, 16759.70760, 18804.78670, + 21099.41250, 23674.03720, 26562.82650, + 29804.11680, 32627.31601, 34245.89759, + 34722.29104, 34155.20062, 32636.50533, + 30241.08406, 27101.45052, 23362.20912, + 19317.04955, 15446.17194, 12197.45091, + 9496.39912, 7205.66920, 5144.64339, + 3240.79521, 1518.62245, 0.00000, + 0.00000 ] + +bk['48'] = [0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00813, 0.03224, + 0.07128, 0.12445, 0.19063, + 0.26929, 0.35799, 0.45438, + 0.55263, 0.64304, 0.71703, + 0.77754, 0.82827, 0.87352, + 0.91502, 0.95235, 0.98511, + 1.00000 ] + +ak['55'] = [ 1.00000, 2.00000, 3.27000, + 4.75850, 6.60000, 8.93450, + 11.97030, 15.94950, 21.13490, + 27.85260, 36.50410, 47.58060, + 61.67790, 79.51340, 101.94420, + 130.05080, 165.07920, 208.49720, + 262.02120, 327.64330, 407.65670, + 504.68050, 621.68000, 761.98390, + 929.29430, 1127.68880, 1364.33920, + 1645.70720, 1979.15540, 2373.03610, + 2836.78160, 3380.99550, 4017.54170, + 4764.39320, 5638.79380, 6660.33770, + 7851.22980, 9236.56610, 10866.34270, + 12783.70000, 15039.30000, 17693.00000, + 20119.20876, 21686.49129, 22436.28749, + 22388.46844, 21541.75227, 19873.78342, + 17340.31831, 13874.44006, 10167.16551, + 6609.84274, 3546.59643, 1270.49390, + 0.00000, 0.00000 ] + +bk['55'] = [0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00696, 0.02801, 0.06372, + 0.11503, 0.18330, 0.27033, + 0.37844, 0.51046, 0.64271, + 0.76492, 0.86783, 0.94329, + 0.98511, 1.00000 ] + + +# NCEP's 64 sigma layers +# ---------------------- + +ak['64'] = [1.00000, 3.90000, 8.70000, + 15.42000, 24.00000, 34.50000, + 47.00000, 61.50000, 78.60000, + 99.13500, 124.12789, 154.63770, + 191.69700, 236.49300, 290.38000, + 354.91000, 431.82303, 523.09300, + 630.92800, 757.79000, 906.45000, + 1079.85000, 1281.00000, 1515.00000, + 1788.00000, 2105.00000, 2470.00000, + 2889.00000, 3362.00000, 3890.00000, + 4475.00000, 5120.00000, 5830.00000, + 6608.00000, 7461.00000, 8395.00000, + 9424.46289, 10574.46880, 11864.80270, + 13312.58890, 14937.03710, 16759.70700, + 18804.78710, 21099.41210, 23674.03710, + 26562.82810, 29804.11720, 32627.31640, + 34245.89840, 34722.28910, 34155.19920, + 32636.50390, 30241.08200, 27101.44920, + 23362.20700, 19317.05270, 15446.17090, + 12197.45210, 9496.39941, 7205.66992, + 5144.64307, 3240.79346, 1518.62134, + 0.00000, 0.00000 ] + +bk['64'] = [0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00813, + 0.03224, 0.07128, 0.12445, + 0.19063, 0.26929, 0.35799, + 0.45438, 0.55263, 0.64304, + 0.71703, 0.77754, 0.82827, + 0.87352, 0.91502, 0.95235, + 0.98511, 1.00000 ] + + +ak['72'] = [ 1.0000000, 2.0000002, 3.2700005, 4.7585009, 6.6000011, + 8.9345014, 11.970302, 15.949503, 21.134903, 27.852606, + 36.504108, 47.580610, 61.677911, 79.513413, 101.94402, + 130.05102, 165.07903, 208.49704, 262.02105, 327.64307, + 407.65710, 504.68010, 621.68012, 761.98417, 929.29420, + 1127.6902, 1364.3402, 1645.7103, 1979.1604, 2373.0405, + 2836.7806, 3381.0007, 4017.5409, 4764.3911, 5638.7912, + 6660.3412, 7851.2316, 9236.5722, 10866.302, 12783.703, + 15039.303, 17693.003, 20119.201, 21686.501, 22436.301, + 22389.800, 21877.598, 21214.998, 20325.898, 19309.696, + 18161.897, 16960.896, 15625.996, 14290.995, 12869.594, + 11895.862, 10918.171, 9936.5219, 8909.9925, 7883.4220, + 7062.1982, 6436.2637, 5805.3211, 5169.6110, 4533.9010, + 3898.2009, 3257.0809, 2609.2006, 1961.3106, 1313.4804, + 659.37527, 4.8048257, 0.0000000 ] + + +bk['72'] = [0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000, + 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000, + 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000, + 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000, + 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000, + 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000, + 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000, + 0.0000000, 0.0000000, 0.0000000, 0.0000000, 0.0000000, + 0.0000000, 8.1754130e-09, 0.0069600246, 0.028010041, 0.063720063, + 0.11360208, 0.15622409, 0.20035011, 0.24674112, 0.29440312, + 0.34338113, 0.39289115, 0.44374018, 0.49459020, 0.54630418, + 0.58104151, 0.61581843, 0.65063492, 0.68589990, 0.72116594, + 0.74937819, 0.77063753, 0.79194696, 0.81330397, 0.83466097, + 0.85601798, 0.87742898, 0.89890800, 0.92038701, 0.94186501, + 0.96340602, 0.98495195, 1.0000000 ] + + +# ECMWF Nature +# ------------ +ak['91'] = [ 0.000000000000, 2.000040054321, 3.980832099915, 7.387186050415, + 12.908319473267, 21.413604736328, 33.952865600586, 51.746597290039, + 76.167663574219, 108.715560913086, 150.986022949219, 204.637451171875, + 271.356445312500, 352.824462890625, 450.685791015625, 566.519287109375, + 701.813232421875, 857.945800781250, + 1036.166503906250, 1237.585449218750, 1463.163818359375, 1713.709716796875, + 1989.874511718750, 2292.155517578125, 2620.898437500000, 2976.302246093750, + 3358.425781250000, 3767.196044921875, 4202.417968750000, 4663.777343750000, + 5150.859375000000, 5663.156250000000, 6199.839843750000, 6759.726562500000, + 7341.468750000000, 7942.925781250000, 8564.625000000000, 9208.304687500000, + 9873.562500000000, 10558.882812500000, 11262.484375000000, 11982.660156250000, + 12713.898437500000, 13453.226562500000, 14192.011718750000, 14922.687500000000, + 15638.054687500000, 16329.562500000000, 16990.625000000000, 17613.281250000000, + 18191.031250000000, 18716.968750000000, 19184.546875000000, 19587.515625000000, + 19919.796875000000, 20175.394531250000, 20348.917968750000, 20434.156250000000, + 20426.218750000000, 20319.011718750000, 20107.031250000000, 19785.359375000000, + 19348.777343750000, 18798.824218750000, 18141.296875000000, 17385.593750000000, + 16544.585937500000, 15633.566406250000, 14665.644531250000, 13653.218750000000, + 12608.382812500000, 11543.167968750000, 10471.312500000000, 9405.222656250000, + 8356.253906250000, 7335.164062500000, 6353.921875000000, 5422.800781250000, + 4550.214843750000, 3743.464355468750, 3010.146972656250, 2356.202636718750, + 1784.854492187500, 1297.656250000000, 895.193603515625, 576.314208984375, + 336.772460937500, 162.043426513672, 54.208343505859 , 6.575628280640, + 0.003160000080, 0.000000000000] + +bk['91'] = [ 0.000000000000, 0.000000000000, 0.000000000000, 0.000000000000, + 0.000000000000, 0.000000000000, 0.000000000000, 0.000000000000, + 0.000000000000, 0.000000000000, 0.000000000000, 0.000000000000, + 0.000000000000, 0.000000000000, 0.000000000000, 0.000000000000, + 0.000000000000, 0.000000000000, 0.000000000000, 0.000000000000, + 0.000000000000, 0.000000000000, 0.000000000000, 0.000000000000, + 0.000000000000, 0.000000000000, 0.000000000000, 0.000000000000, + 0.000000000000, 0.000000000000, 0.000000000000, 0.000000000000, + 0.000000000000, 0.000000000000, 0.000000272400, 0.000013911600, + 0.000054667194, 0.000131364097, 0.000278884778, 0.000548384152, + 0.001000134507, 0.001701075351, 0.002764719306, 0.004267048091, + 0.006322167814, 0.009034991264, 0.012508261949, 0.016859579831, + 0.022188644856, 0.028610348701, 0.036226909608, 0.045146133751, + 0.055474229157, 0.067316174507, 0.080777287483, 0.095964074135, + 0.112978994846, 0.131934821606, 0.152933537960, 0.176091074944, + 0.201520144939, 0.229314863682, 0.259554445744, 0.291993439198, + 0.326329410076, 0.362202584743, 0.399204790592, 0.436906337738, + 0.475016415119, 0.513279736042, 0.551458477974, 0.589317142963, + 0.626558899879, 0.662933588028, 0.698223590851, 0.732223808765, + 0.764679491520, 0.795384764671, 0.824185431004, 0.850950419903, + 0.875518381596, 0.897767245770, 0.917650938034, 0.935157060623, + 0.950273811817, 0.963007092476, 0.973466038704, 0.982238113880, + 0.989152967930, 0.994204163551, 0.997630119324, 1.000000000000] + + +ak['96'] = [ 1.00000, 2.32782, 3.34990, + 4.49484, 5.62336, 6.93048, + 8.41428, 10.06365, 11.97630, + 14.18138, 16.70870, 19.58824, + 22.84950, 26.52080, 30.62845, + 35.19588, 40.24273, 45.78375, + 51.82793, 58.43583, 65.62319, + 73.40038, 81.77154, 90.73373, + 100.27628, 110.82243, 122.47773, + 135.35883, 149.59464, 165.32764, + 182.71530, 201.93164, 223.16899, + 246.63988, 272.57922, 301.24661, + 332.92902, 367.94348, 406.64044, + 449.40720, 496.67181, 548.90723, + 606.63629, 670.43683, 740.94727, + 818.87329, 904.99493, 1000.17395, + 1105.36304, 1221.61499, 1350.09326, + 1492.08362, 1649.00745, 1822.43469, + 2014.10168, 2225.92627, 2460.02905, + 2718.75195, 3004.68530, 3320.69092, + 3669.93066, 4055.90015, 4482.46240, + 4953.88672, 5474.89111, 6050.68994, + 6687.04492, 7390.32715, 8167.57373, + 9026.56445, 9975.89648, 11025.06934, + 12184.58398, 13466.04785, 14882.28320, + 16447.46289, 18177.25781, 20088.97461, + 21886.89453, 23274.16602, 24264.66602, + 24868.31641, 25091.15430, 24935.41016, + 24399.52148, 23478.13281, 22162.01758, + 20438.00586, 18288.83984, 15693.01172, + 12624.54199, 9584.35352, 6736.55713, + 4231.34326, 2199.57910, 747.11890, + 0.00000 ] + +bk['96'] = [0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00000, 0.00000, 0.00000, + 0.00315, 0.01263, 0.02853, + 0.05101, 0.08030, 0.11669, + 0.16055, 0.21231, 0.27249, + 0.34169, 0.42062, 0.51005, + 0.61088, 0.70748, 0.79593, + 0.87253, 0.93400, 0.97764, + 1.00000 ] + +def getEdge(km): + """Return tuple with edge values of (ak,bk) for the input number of + vertical layers *km*. Notice that the ak's are in units of Pascal (Pa). """ + ae = ones(km+1) + be = ones(km+1) + ae[:] = ak[str(km)] + be[:] = bk[str(km)] + return (ae,be) + +def getMid(km): + """Return tuple with mid-layer values of (ak,bk) for the input number of + vertical layers *km*. Notice that the ak's are in units of Pascal (Pa). """ + ae, be = (ak[str(km)], bk[str(km)]) + am = ones(km) + bm = ones(km) + for k in range(km): + am[k] = (ae[k+1] + ae[k]) / 2. + bm[k] = (be[k+1] + be[k]) / 2. + return (am,bm) + +def getDelta(km): + """Return tuple with delta values of (ak,bk) for the input number of + vertical layers *km*. Notice that the ak's are in units of Pascal (Pa). """ + ae, be = (ak[str(km)], bk[str(km)]) + dak = ones(km) + dbk = ones(km) + for k in range(km): + dak[k] = ae[k+1] - ae[k] + dbk[k] = be[k+1] - be[k] + return (dak,dbk) + +def getPe(km,p_ref=100000.): + """Return pressure at edges given a reference pressure.""" + ae, be = getEdge(km) + return (ae + p_ref * be) + +def getPm(km,p_ref=100000.): + """Return pressure at mid-layer given a reference pressure.""" + am, bm = getMid(km) + return (am + p_ref * bm) + +def getDelp(km,p_ref=100000.): + """Return pressure thickness at mid-layer given a reference pressure.""" + dak, dbk = getDelta(km) + return (dak + p_ref * dbk) + + + diff --git a/Python/MAPL/exp.py b/Python/MAPL/exp.py new file mode 100644 index 000000000000..70d7119c0a59 --- /dev/null +++ b/Python/MAPL/exp.py @@ -0,0 +1,112 @@ +""" +This package implements the Experiment class. +""" + +import os + +class Exp(object): + + def __init__(self,ConfigFiles=None): + + if ConfigFiles is None: + here = _whereami() + Configfiles = [ here + 'Experiment.rc', + here + 'Grids.rc', + here + 'Chem_Registry.rc' + ] + + self.cf = Config(ConfigFiles); + + self.EsmaDir = self.cf.EsmaDir # Location of system binaries + + self.SysID = self.cf.SysID # e.g., "GEOSagcm" + self.ExpID = self.cf.ExpID # e.g., "a0202" + self.ExpDescr = self.cf.ExpDescr + + self.ExpHomeDir = self.cf.ExpHomeDir + self.ExpExecDir = self.cf.ExpExecDir + self.ExpHoldDir = self.cf.ExpHoldDir + self.ExpArchDir = self.cf.ExpArchDir + + self.ExpBegTime = cf.ExpBegTime + self.ExpEndTime = cf.ExpEndTime + + def __del__(self): + self.submit() # resubmit itsef + + def submit(self): + raise NotImplementedError, "Not implemented yet" + + +# -------------- +# Static Methods +# -------------- + +def setup(inConfigFiles=None): + """ + In the very beginning, setup the environment for + running the experiment. It interacts with the user + to setup all the necessary experiment directories + and resource files. + """ + +# Default (input) Config files +# ---------------------------- + if inConfigFiles is None: + etc = _whereami() + '../etc' + inConfigfiles = [ here + 'Experiment.irc', + here + 'Grids.irc', + here + 'Chem_Registry.irc', + here + 'History.irc' + ] + +# Derive Config file names by replacing ".irc" extensions with ".rc" +# ------------------------------------------------------------------ + cmd = '$ESMADIR/bin/red_ma.pl' + ConfigFiles = [] + for irc in inConfigFiles: + cmd = cmd + ' ' + irc + ConfigFiles.append(irc.replace('.irc','.rc')) + +# Get user input by lauching Red MAPL GUI +# --------------------------------------- + tmpdir = "/tmp/red_mapl.%s-%d"%(os.getenv('USER'),os.getpid()) + os.mkdir(tmpdir) + os.chdir(tmpdir) + if os.system(cmd): + raise IOerror, "red_ma.pl did not complete successfully" + +# Resources as specified by user +# ------------------------------ + cf = Config(ConfigFiles) + +# Setup directory tree +# -------------------- + for dir in cf.regex('Dir$').values(): + os.mkdir(dir) + +# Populate Resources +# ------------------ + cf.save(cf('ExpRsrcDir')+'/Master.rc') + os.system('/bin/cp -pr $ESMADIR/$ARCH/etc/*.rc ' + + cf('ExpRsrcDir') ) + +# All done +# -------- + os.system('/bin/rm -rf ' + tmpdir) + +def tearDown(self): + """ + Once an experiment is completed, run this for all + necessary cleanup. + """ + pass # can't think of anything useful yet + +#......................................................................................... + +if __name__ == "__main__": + + e = Experiment() + e.submitt() + + diff --git a/Python/MAPL/filelock.py b/Python/MAPL/filelock.py new file mode 100644 index 000000000000..ec754800c712 --- /dev/null +++ b/Python/MAPL/filelock.py @@ -0,0 +1,77 @@ +import os +import time +import errno + +class FileLockException(Exception): + pass + +class FileLock(object): + """ A file locking mechanism that has context-manager support so + you can use it in a with statement. This should be relatively cross + compatible as it doesn't rely on msvcrt or fcntl for the locking. + """ + + def __init__(self, file_name, timeout=10, delay=.05): + """ Prepare the file locker. Specify the file to lock and optionally + the maximum timeout and the delay between each attempt to lock. + """ + self.is_locked = False + self.lockfile = os.path.join(os.getcwd(), "%s.lock" % file_name) + self.file_name = file_name + self.timeout = timeout + self.delay = delay + + + def acquire(self): + """ Acquire the lock, if possible. If the lock is in use, it check again + every `wait` seconds. It does this until it either gets the lock or + exceeds `timeout` number of seconds, in which case it throws + an exception. + """ + start_time = time.time() + while True: + try: + self.fd = os.open(self.lockfile, os.O_CREAT|os.O_EXCL|os.O_RDWR) + break; + except OSError: + if OSError.errno != errno.EEXIST: + raise + if (time.time() - start_time) >= self.timeout: + raise FileLockException("Timeout occured.") + time.sleep(self.delay) + self.is_locked = True + + + def release(self): + """ Get rid of the lock by deleting the lockfile. + When working in a `with` statement, this gets automatically + called at the end. + """ + if self.is_locked: + os.close(self.fd) + os.unlink(self.lockfile) + self.is_locked = False + + + def __enter__(self): + """ Activated when used in the with statement. + Should automatically acquire a lock to be used in the with block. + """ + if not self.is_locked: + self.acquire() + return self + + + def __exit__(self, type, value, traceback): + """ Activated at the end of the with statement. + It automatically releases the lock if it isn't locked. + """ + if self.is_locked: + self.release() + + + def __del__(self): + """ Make sure that the FileLock instance doesn't leave a lockfile + lying around. + """ + self.release() diff --git a/Python/MAPL/history.py b/Python/MAPL/history.py new file mode 100644 index 000000000000..476da2173652 --- /dev/null +++ b/Python/MAPL/history.py @@ -0,0 +1,59 @@ +""" +A special class for handling history resources. +""" + +from config import * + +class History(Config): + + def collections(self): + """ + Returns a list of active collections. + """ + p = re.compile('^[ ]*::') + on = False + for line in self.Lines: + tok = line.lstrip() + if tok[0:11] == 'COLLECTIONS': + first = self.get('COLLECTIONS') + if first != '': + colls = [ first.replace("'",""), ] + else: + colls = [] + on = True + elif on is True: + if tok[0:2] == '::': + break + elif tok[0:1] != '#': + coll = tok.split()[0] + colls.append(coll.replace("'","")) + return colls + + def arc(self,outFile): + """ + Create a PESTO resource file (.arc) based on the + *.temkplate resources. + """ + dict = self.regex('template$') + Tmpl = [str.replace("'","").replace(",","") for str in dict.values()] + Coll = [ str.split('.')[0].replace(",","") for str in dict.keys() ] + Arch = [str.replace("'","").replace(",","") \ + for str in self.regex('archive$').values()] + + if len(Tmpl) != len(Arch): + raise IOError,\ + "There are %d template resources but only %d archive resources."\ + %(len(Tmpl),len(Arch)) + + header = '# PESTO resource for History Collections ' + \ + '(automatically generated - do not edit)' + Text = [header,] + c = 0 + for tmpl in Tmpl: + coll = Coll[c] + path = Arch[c].replace('%c',coll) + line = '$PESTOROOT%s/' + path + '/%s.' + coll + \ + '.' + tmpl + '\n' + Text.append(line) + c = c + 1 + open(outFile,"w").writelines(Text) diff --git a/Python/MAPL/job.py b/Python/MAPL/job.py new file mode 100644 index 000000000000..abfd3ce5d571 --- /dev/null +++ b/Python/MAPL/job.py @@ -0,0 +1,92 @@ +""" +This package implements the functionality of a single Job. Methods +specifics of an applcation are defined as "abstract" --- that is, to be +defined by each specific Application. + +Design remarks: + +1. A Job should not have any knowledge of the specific Operating System + (OS) and Queueing System (QS). If this knowledge becomes essential + it should be abstracted out and implemented in the Experiment class. + +""" + +import Abstract +from exp import Exp + +class Job(Exp): + + def __init__(self,ConfigFile): + """Initialize a Job.""" + +# Initialize Experiment specific stuff in base class +# -------------------------------------------------- + Exp.__init__(self,ConfigFile) + +# Job specific parameters (will raise exception if not present) +# ------------------------------------------------------------- + self.nSegs = self.cf.nSegs + self.recyclables = self.cf.recyclables # File list + self.JobDelTime = self.cf.DelTime + +# Bring over resource files +# ------------------------- + self.getResources() + +# Bring over recyclables to runing ExpExecDir +# ---------------------------------- -------- + self.getRecyclables() + + def __call__(self): + """ + Carries out a single Job by running several segments of the + Application. + """ + +# Per-job Application setup +# ------------------------- + self.signin() + +# Run application for each segment +# -------------------------------- + for n in range(self.nSegs): + self.execute() + +# Per-job Application clean-up +# ---------------------------- + self.signout() + + def __del__(self): + +# Save recyclables to ExpHomeDir for next Job +# ------------------------------------------- + self.putRecyclables() + +# Finalize experiment specific stuff in base class; +# this will resubmit the job if necessary +# ------------------------------------------------ + Experiment.__del__(self) + +# ----------------- +# Recycling Methods +# ----------------- + + def getResources(self): + raise NotImplementedError, "Not implemented yet" + + def getRecyclables(self): + raise NotImplementedError, "Not implemented yet" + + def putRecyclables(self): + raise NotImplementedError, "Not implemented yet" + + +# ---------------- +# Abstract Methods +# ---------------- + + signin = Abstract.Method('signin') + execute = Abstract.Method('execute') + signout = Abstract.Method('signout') + + diff --git a/Python/MAPL/run.py b/Python/MAPL/run.py new file mode 100644 index 000000000000..4a6837097230 --- /dev/null +++ b/Python/MAPL/run.py @@ -0,0 +1,84 @@ +""" +This package implements the running of a segment: it runs a MAPL +application for a prescribed period of time (or the end of the +experiment, whichever is sooner.) + +""" + +from job import Job + +class Run(Job): + + def __init__(self,ConfigFile,Children=[]): + +# Initialize Job specific stuff in base class +# ------------------------------------------- + Job.__init__(self,ConfigFile) + + self.Children = Children + +# ------------------- +# Per-segment Methods +# ------------------- + + def execute(self): + """Executes the Application for one segment.""" + self.initialize() + self.run() + self.finalize() + + def initialize(self): + self._initialize() + for child in self.Children: + child.initialize() + self.initialize_() + + def run(self): + self._run() + for child in self.Children: + child.run() + self.run_() + + def finalize(self): + self._finalize() + for child in self.Children: + child.finalize() + self.finalize_() + + +# ----------------- +# Per-job Methods +# ----------------- + + def signin(self): + self._signin() + for child in self.Children: + child.signin() + self.signin_() + + def signout(self): + self._signout() + for child in self.Children: + child.signout() + self.signout_() + + +# --------------------- +# No-op Default Methods +# --------------------- + +# No-op pre-child methods +# ----------------------- + def _initialize(self): pass + def _run(self): pass + def _finalize(self): pass + def _signin(self): pass + def _signout(self): pass + +# No-op post-child methods +# ------------------------ + def initialize_(self): pass + def run_(self): pass + def finalize_(self): pass + def signin_(self): pass + def signout_(self): pass From bd6177abb2fa8760bce9aa193db7157bb8451a45 Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Thu, 26 Mar 2020 08:51:20 -0400 Subject: [PATCH 062/109] Updated change log. --- CHANGELOG.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index b5fd7bfe69d8..6521946152de 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -30,6 +30,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Added configuration for CircleCI - Builds MAPL using GCC 9.2.0 and Open MPI 4.0.2 - Builds and runs `pFIO_tests` and `MAPL_Base_tests` +- Imported Python/MAPL subdir (old, but never imported to GitHub) + ## [2.0.2] - 2020-03-10 From 0f6e00508be60e19bf1b5972d5d2a04454178f8c Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Thu, 26 Mar 2020 16:58:57 -0400 Subject: [PATCH 063/109] Missed commit of new file. --- Apps/CMakeLists.txt | 2 ++ 1 file changed, 2 insertions(+) create mode 100644 Apps/CMakeLists.txt diff --git a/Apps/CMakeLists.txt b/Apps/CMakeLists.txt new file mode 100644 index 000000000000..203ad1c4cde0 --- /dev/null +++ b/Apps/CMakeLists.txt @@ -0,0 +1,2 @@ +install (PROGRAMS MAPL_GridCompSpecs_ACG.py DESTINATION "${esma_etc}/MAPL") + From 1ed55158832d6ac3fbdd67086e7f67228b045b99 Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Sat, 28 Mar 2020 21:37:29 -0400 Subject: [PATCH 064/109] Introduced new code generator (in Python) - Similar to old mapl_acg.pl - Tested with next gen GOCART DU grid comp --- Apps/CMakeLists.txt | 2 +- Apps/MAPL_GridCompSpecs_ACG.py | 77 +++++++++++++++++++++++++--------- CHANGELOG.md | 1 + GMAO_pFIO/CMakeLists.txt | 2 +- 4 files changed, 61 insertions(+), 21 deletions(-) diff --git a/Apps/CMakeLists.txt b/Apps/CMakeLists.txt index 203ad1c4cde0..4b73c02d0bef 100644 --- a/Apps/CMakeLists.txt +++ b/Apps/CMakeLists.txt @@ -1,2 +1,2 @@ -install (PROGRAMS MAPL_GridCompSpecs_ACG.py DESTINATION "${esma_etc}/MAPL") +file (COPY MAPL_GridCompSpecs_ACG.py DESTINATION ${esma_etc}/MAPL) diff --git a/Apps/MAPL_GridCompSpecs_ACG.py b/Apps/MAPL_GridCompSpecs_ACG.py index 1b05bfd86419..564e918ffa64 100755 --- a/Apps/MAPL_GridCompSpecs_ACG.py +++ b/Apps/MAPL_GridCompSpecs_ACG.py @@ -156,9 +156,9 @@ def csv_record_reader(csv_reader): with open(specs_filename, 'r') as specs_file: specs_reader = csv.reader(specs_file, skipinitialspace=True,delimiter='|') gen = csv_record_reader(specs_reader) - schema_version = next(gen)[0] + schema_version = next(gen)[0].split(' ')[1] print("version: ",schema_version) - component = next(gen)[0] + component = next(gen)[0].split(' ')[1] print("component: ",component) while True: try: @@ -230,37 +230,76 @@ def open_with_header(filename): # Process command line arguments parser = argparse.ArgumentParser(description='Generate import/export/internal specs for MAPL Gridded Component') -parser.add_argument('-i','--input', action='store') -parser.add_argument('--add_specs', action='store', default='Spec.h') -parser.add_argument('--declare_pointers', action='store', default='DeclarePointer.h') -parser.add_argument('--get_pointers', action='store', default='GetPointer.h') +parser.add_argument("input", action='store', + help="input filename") +parser.add_argument("-n", "--name", action="store", + help="override default grid component name derived from input filename") +parser.add_argument("-i", "--import_specs", action="store", nargs='?', + default=None, const="{component}_Import___.h", + help="override default output filename for AddImportSpec() code") +parser.add_argument("-x", "--export_specs", action="store", nargs='?', + default=None, const="{component}_Export___.h", + help="override default output filename for AddExternalSpec() code") +parser.add_argument("-p", "--internal_specs", action="store", nargs='?', + default=None, const="{component}_Internal___.h", + help="override default output filename for AddImportSpec() code") +parser.add_argument("-g", "--get-pointers", action="store", nargs='?', + default=None, const="{component}_GetPointer___.h", + help="override default output filename for get_pointer() code") +parser.add_argument("-d", "--declare-pointers", action="store", nargs='?', + const="{component}_DeclarePointer___.h", default=None, + help="override default output filename for AddSpec code") args = parser.parse_args() # Process blocked CSV input file using pandas specs = read_specs(args.input) +if args.name: + component = args.name +else: + component = os.path.splitext(os.path.basename(args.input))[0] + component = component.replace('_Registry','') + component = component.replace('_StateSpecs','') + # open all output files f_specs = {} -for category in ('IMPORT','EXPORT','INTERNAL'): - f_specs[category] = open_with_header(category.capitalize()+args.add_specs) -f_declare_pointers = open_with_header(args.declare_pointers) -f_get_pointers = open_with_header(args.get_pointers) - +for category in ("IMPORT","EXPORT","INTERNAL"): + option = args.__dict__[category.lower()+"_specs"] + if option: + fname = option.format(component=component) + f_specs[category] = open_with_header(fname) + else: + f_specs[category] = None + +if args.declare_pointers: + f_declare_pointers = open_with_header(args.declare_pointers.format(component=component)) +else: + f_declare_pointers = None +if args.get_pointers: + f_get_pointers = open_with_header(args.get_pointers.format(component=component)) +else: + f_get_pointers = None # Generate code from specs (processed above with pandas) -for category in ('IMPORT','EXPORT','INTERNAL'): - for item in specs[category].to_dict('records'): +for category in ("IMPORT","EXPORT","INTERNAL"): + for item in specs[category].to_dict("records"): spec = MAPL_DataSpec(category.lower(), item) - f_specs[category].write(spec.emit_specs()) - f_declare_pointers.write(spec.emit_declare_pointers()) - f_get_pointers.write(spec.emit_get_pointers()) + if f_specs[category]: + f_specs[category].write(spec.emit_specs()) + if f_declare_pointers: + f_declare_pointers.write(spec.emit_declare_pointers()) + if f_get_pointers: + f_get_pointers.write(spec.emit_get_pointers()) # Close output files for category, f in f_specs.items(): - f.close() -f_declare_pointers.close() -f_get_pointers.close() + if f: + f.close() +if f_declare_pointers: + f_declare_pointers.close() +if f_get_pointers: + f_get_pointers.close() diff --git a/CHANGELOG.md b/CHANGELOG.md index b5fd7bfe69d8..667c63e446ae 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -30,6 +30,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Added configuration for CircleCI - Builds MAPL using GCC 9.2.0 and Open MPI 4.0.2 - Builds and runs `pFIO_tests` and `MAPL_Base_tests` + - Python automatic code generator for grid comp include files ## [2.0.2] - 2020-03-10 diff --git a/GMAO_pFIO/CMakeLists.txt b/GMAO_pFIO/CMakeLists.txt index e1c9d34fd20e..9ac4da334672 100644 --- a/GMAO_pFIO/CMakeLists.txt +++ b/GMAO_pFIO/CMakeLists.txt @@ -93,7 +93,7 @@ target_link_libraries (${this} PUBLIC gftl gftl-shared set_target_properties (${this} PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) # Kludge for OSX security and DYLD_LIBRARY_PATH ... foreach(dir ${OSX_EXTRA_LIBRARY_PATH}) - target_link_libraries(${this} "-Xlinker -rpath -Xlinker ${dir}") + target_link_libraries(${this} PRIVATE "-Xlinker -rpath -Xlinker ${dir}") endforeach() From 3610ab298cb46e662d82c10cf0a68e03ac5488c2 Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Sun, 29 Mar 2020 08:24:15 -0400 Subject: [PATCH 065/109] Relocated CMake function to be colocated with python code. --- Apps/CMakeLists.txt | 66 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 66 insertions(+) diff --git a/Apps/CMakeLists.txt b/Apps/CMakeLists.txt index 4b73c02d0bef..7c473d00f6be 100644 --- a/Apps/CMakeLists.txt +++ b/Apps/CMakeLists.txt @@ -1,2 +1,68 @@ file (COPY MAPL_GridCompSpecs_ACG.py DESTINATION ${esma_etc}/MAPL) + +################################################################################################ +# Automatically generate files from a file that provides specs +# for the states of a gridde component. +# +# Usage: +# +# esma_acg (target specs_file ) +# +# Options: +# IMPORT_SPECS [file] filename for AddImportSpec() code (default _Import___.h) +# EXPORT_SPECS [file] filename for AddExportSpec() code (default _Export___.h) +# INTERNAL_SPECS [file] filename for AddInternalSpec() code (default _Internal___.h) +# GET_POINTERS [file] filename for GetPointer() code (default _GetPointer___.h) +# GET_POINTERS [file] filename for GetPointer() code (default _DeclarePointer___.h) +# +################################################################################################ + + +function (esma_acg target specs_file) + set (options) + set (oneValueArgs IMPORT_SPECS EXPORT_SPECS INTERNAL_SPECS GET_POINTERS DECLARE_POINTERS) + # This list must align with oneValueArgs above (for later ZIP_LISTS) + set (flags -i -x -p -g -d) + set (defaults Import Export Internal GetPointer DeclarePointer) + set (multiValueArgs) + cmake_parse_arguments (ARGS "${options}" "${oneValueArgs}" "${multiValueArgs}" ${ARGN}) + + string (REPLACE "_GridComp" "" component_name ${target}) + + if (ARGS_UNPARSED_ARGUMENTS) + ecbuild_error ("esma_set_this unparsed arguments: ${ARGS_UNPARSED_ARGUMENTS}") + endif () + + set (generated) # empty unless + set (options "") + + + # Handle oneValueArgs with no value (Python provides default) + foreach (opt flag default IN ZIP_LISTS oneValueArgs flags defaults) + + if (ARGS_${opt}) + string (REPLACE "{component}" component_name fname ${ARGS_${opt}}) + list (APPEND generated ${fname}) + list (APPEND options ${flag} ${ARGS_${opt}}) + elseif (${opt} IN_LIST ARGS_KEYWORDS_MISSING_VALUES) + string (REPLACE "{component}" component_name fname ${default}) + list (APPEND generated ${fname}) + list (APPEND options ${flag}) + endif () + + endforeach () + + set(generator ${esma_etc}/MAPL/MAPL_GridCompSpecs_ACG.py) + add_custom_command ( + OUTPUT ${generated} + COMMAND ${generator} ${CMAKE_CURRENT_SOURCE_DIR}/${specs_file} ${options} + MAIN_DEPENDENCY ${CMAKE_CURRENT_SOURCE_DIR}/${specs_file} + DEPENDS ${generator} ${specs_file} + WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR} + COMMENT "Generating automatic code for ${specs_file}" + ) + add_custom_target (acg_phony_${target} DEPENDS ${generated}) + add_dependencies (${target} acg_phony_${target}) + +endfunction () From 9d4ee28d2ee6348a5b9908c04902ef047a5f79ed Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Sun, 29 Mar 2020 10:08:49 -0400 Subject: [PATCH 066/109] Brought CMake AGC function into MAPL - This keeps the macro close to the Python script that it drives. --- Apps/CMakeLists.txt | 67 ---------------------------------- Apps/MAPL_GridCompSpecs_ACG.py | 3 +- CMakeLists.txt | 3 ++ 3 files changed, 4 insertions(+), 69 deletions(-) diff --git a/Apps/CMakeLists.txt b/Apps/CMakeLists.txt index 7c473d00f6be..8fdb68a70308 100644 --- a/Apps/CMakeLists.txt +++ b/Apps/CMakeLists.txt @@ -1,68 +1 @@ file (COPY MAPL_GridCompSpecs_ACG.py DESTINATION ${esma_etc}/MAPL) - - -################################################################################################ -# Automatically generate files from a file that provides specs -# for the states of a gridde component. -# -# Usage: -# -# esma_acg (target specs_file ) -# -# Options: -# IMPORT_SPECS [file] filename for AddImportSpec() code (default _Import___.h) -# EXPORT_SPECS [file] filename for AddExportSpec() code (default _Export___.h) -# INTERNAL_SPECS [file] filename for AddInternalSpec() code (default _Internal___.h) -# GET_POINTERS [file] filename for GetPointer() code (default _GetPointer___.h) -# GET_POINTERS [file] filename for GetPointer() code (default _DeclarePointer___.h) -# -################################################################################################ - - -function (esma_acg target specs_file) - set (options) - set (oneValueArgs IMPORT_SPECS EXPORT_SPECS INTERNAL_SPECS GET_POINTERS DECLARE_POINTERS) - # This list must align with oneValueArgs above (for later ZIP_LISTS) - set (flags -i -x -p -g -d) - set (defaults Import Export Internal GetPointer DeclarePointer) - set (multiValueArgs) - cmake_parse_arguments (ARGS "${options}" "${oneValueArgs}" "${multiValueArgs}" ${ARGN}) - - string (REPLACE "_GridComp" "" component_name ${target}) - - if (ARGS_UNPARSED_ARGUMENTS) - ecbuild_error ("esma_set_this unparsed arguments: ${ARGS_UNPARSED_ARGUMENTS}") - endif () - - set (generated) # empty unless - set (options "") - - - # Handle oneValueArgs with no value (Python provides default) - foreach (opt flag default IN ZIP_LISTS oneValueArgs flags defaults) - - if (ARGS_${opt}) - string (REPLACE "{component}" component_name fname ${ARGS_${opt}}) - list (APPEND generated ${fname}) - list (APPEND options ${flag} ${ARGS_${opt}}) - elseif (${opt} IN_LIST ARGS_KEYWORDS_MISSING_VALUES) - string (REPLACE "{component}" component_name fname ${default}) - list (APPEND generated ${fname}) - list (APPEND options ${flag}) - endif () - - endforeach () - - set(generator ${esma_etc}/MAPL/MAPL_GridCompSpecs_ACG.py) - add_custom_command ( - OUTPUT ${generated} - COMMAND ${generator} ${CMAKE_CURRENT_SOURCE_DIR}/${specs_file} ${options} - MAIN_DEPENDENCY ${CMAKE_CURRENT_SOURCE_DIR}/${specs_file} - DEPENDS ${generator} ${specs_file} - WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR} - COMMENT "Generating automatic code for ${specs_file}" - ) - add_custom_target (acg_phony_${target} DEPENDS ${generated}) - add_dependencies (${target} acg_phony_${target}) - -endfunction () diff --git a/Apps/MAPL_GridCompSpecs_ACG.py b/Apps/MAPL_GridCompSpecs_ACG.py index 564e918ffa64..d3b0196a277b 100755 --- a/Apps/MAPL_GridCompSpecs_ACG.py +++ b/Apps/MAPL_GridCompSpecs_ACG.py @@ -157,9 +157,8 @@ def csv_record_reader(csv_reader): specs_reader = csv.reader(specs_file, skipinitialspace=True,delimiter='|') gen = csv_record_reader(specs_reader) schema_version = next(gen)[0].split(' ')[1] - print("version: ",schema_version) component = next(gen)[0].split(' ')[1] - print("component: ",component) +# print("Generating specification code for component: ",component) while True: try: gen = csv_record_reader(specs_reader) diff --git a/CMakeLists.txt b/CMakeLists.txt index 3e8bedd2395c..722c4a810780 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -47,6 +47,9 @@ if (PFUNIT_FOUND) add_subdirectory (MAPL_pFUnit EXCLUDE_FROM_ALL) endif () +# Support for automated code generation +list (APPEND CMAKE_MODULE_PATH "${CMAKE_CURRENT_LIST_DIR}/cmake") +include(mapl_acg) add_subdirectory (Apps) # Git transition defect: From 3e22efedcd7f9f7d4be9ae953351585081fc0415 Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Sun, 29 Mar 2020 10:59:05 -0400 Subject: [PATCH 067/109] Forgot to stage the new cmake dir/file. --- cmake/mapl_acg.cmake | 66 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 66 insertions(+) create mode 100644 cmake/mapl_acg.cmake diff --git a/cmake/mapl_acg.cmake b/cmake/mapl_acg.cmake new file mode 100644 index 000000000000..ab7d3f9b3f1f --- /dev/null +++ b/cmake/mapl_acg.cmake @@ -0,0 +1,66 @@ +################################################################################################ +# Automatically generate files from a file that provides specs +# for the states of a gridde component. +# +# Usage: +# +# mapl_acg (target specs_file ) +# +# Options: +# IMPORT_SPECS [file] filename for AddImportSpec() code (default _Import___.h) +# EXPORT_SPECS [file] filename for AddExportSpec() code (default _Export___.h) +# INTERNAL_SPECS [file] filename for AddInternalSpec() code (default _Internal___.h) +# GET_POINTERS [file] filename for GetPointer() code (default _GetPointer___.h) +# GET_POINTERS [file] filename for GetPointer() code (default _DeclarePointer___.h) +# +################################################################################################ + + +function (mapl_acg target specs_file) + set (options) + set (oneValueArgs IMPORT_SPECS EXPORT_SPECS INTERNAL_SPECS GET_POINTERS DECLARE_POINTERS) + # This list must align with oneValueArgs above (for later ZIP_LISTS) + set (flags -i -x -p -g -d) + set (defaults Import Export Internal GetPointer DeclarePointer) + set (multiValueArgs) + cmake_parse_arguments (ARGS "${options}" "${oneValueArgs}" "${multiValueArgs}" ${ARGN}) + + string (REPLACE "_GridComp" "" component_name ${target}) + + if (ARGS_UNPARSED_ARGUMENTS) + ecbuild_error ("esma_set_this unparsed arguments: ${ARGS_UNPARSED_ARGUMENTS}") + endif () + + set (generated) # empty unless + set (options "") + + + # Handle oneValueArgs with no value (Python provides default) + foreach (opt flag default IN ZIP_LISTS oneValueArgs flags defaults) + + if (ARGS_${opt}) + string (REPLACE "{component}" component_name fname ${ARGS_${opt}}) + list (APPEND generated ${fname}) + list (APPEND options ${flag} ${ARGS_${opt}}) + elseif (${opt} IN_LIST ARGS_KEYWORDS_MISSING_VALUES) + string (REPLACE "{component}" component_name fname ${default}) + list (APPEND generated ${fname}) + list (APPEND options ${flag}) + endif () + + endforeach () + + set(generator ${esma_etc}/MAPL/MAPL_GridCompSpecs_ACG.py) + + add_custom_command ( + OUTPUT ${generated} + COMMAND ${generator} ${CMAKE_CURRENT_SOURCE_DIR}/${specs_file} ${options} + MAIN_DEPENDENCY ${CMAKE_CURRENT_SOURCE_DIR}/${specs_file} + DEPENDS ${generator} ${specs_file} + WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR} + COMMENT "Generating automatic code for ${specs_file}" + ) + add_custom_target (acg_phony_${target} DEPENDS ${generated}) + add_dependencies (${target} acg_phony_${target}) + +endfunction () From 96609a08c6c0450b4a133ff25c0e652ada216b57 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Sun, 29 Mar 2020 14:52:25 -0400 Subject: [PATCH 068/109] change tag value for portable reason --- MAPL_Base/MAPL_Cap.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/MAPL_Base/MAPL_Cap.F90 b/MAPL_Base/MAPL_Cap.F90 index 68054a02440f..cdcc33a50333 100644 --- a/MAPL_Base/MAPL_Cap.F90 +++ b/MAPL_Base/MAPL_Cap.F90 @@ -324,7 +324,7 @@ subroutine fill_mapl_comm(split_comm, gcomm, running_old_o_server, mapl_comm, un integer :: status integer :: grank integer :: source - integer, parameter :: MAPL_TAG_GLOBAL_IOROOT_RANK = 987654 + integer, parameter :: MAPL_TAG_GLOBAL_IOROOT_RANK = 987 integer :: stat(MPI_STATUS_SIZE) character(len=:), allocatable :: s_name From 0bf09cf17fcadf1331a38921ed570758502e996b Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 30 Mar 2020 10:25:31 -0400 Subject: [PATCH 069/109] Fixes #269. Use NF90_NETCDF4 Changes code to use a non-deprecated constant --- GMAO_pFIO/NetCDF4_FileFormatter.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/GMAO_pFIO/NetCDF4_FileFormatter.F90 b/GMAO_pFIO/NetCDF4_FileFormatter.F90 index d11aa8dbe7f3..9c5ea1da1c1b 100644 --- a/GMAO_pFIO/NetCDF4_FileFormatter.F90 +++ b/GMAO_pFIO/NetCDF4_FileFormatter.F90 @@ -133,7 +133,7 @@ subroutine create(this, file, unusable, rc) integer :: status !$omp critical - status = nf90_create(file, NF90_NOCLOBBER + NF90_HDF5, this%ncid) + status = nf90_create(file, NF90_NOCLOBBER + NF90_NETCDF4, this%ncid) !$omp end critical _VERIFY(status) From 38e047f7e0fa9b14a3fa162ff57f142150ba12d3 Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Mon, 30 Mar 2020 13:54:13 -0400 Subject: [PATCH 070/109] Corrected documentation and output messages. --- Apps/mapl_acg.cmake | 67 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 67 insertions(+) create mode 100644 Apps/mapl_acg.cmake diff --git a/Apps/mapl_acg.cmake b/Apps/mapl_acg.cmake new file mode 100644 index 000000000000..aafb9160b310 --- /dev/null +++ b/Apps/mapl_acg.cmake @@ -0,0 +1,67 @@ +################################################################################################ +# Automatically generate files from a file that provides specs +# for the states of a gridde component. +# +# Usage: +# +# mapl_acg (target specs_file ) +# +# Options: +# IMPORT_SPECS [file] filename for AddImportSpec() code (default _Import___.h) +# EXPORT_SPECS [file] filename for AddExportSpec() code (default _Export___.h) +# INTERNAL_SPECS [file] filename for AddInternalSpec() code (default _Internal___.h) +# GET_POINTERS [file] filename for GetPointer() code (default _GetPointer___.h) +# DECLARE_POINTERS [file] filename for GetPointer() code (default _DeclarePointer___.h) +# +################################################################################################ + + +macro (mapl_acg target specs_file) + set (options) + set (oneValueArgs IMPORT_SPECS EXPORT_SPECS INTERNAL_SPECS GET_POINTERS DECLARE_POINTERS) + # This list must align with oneValueArgs above (for later ZIP_LISTS) + set (flags -i -x -p -g -d) + set (defaults Import Export Internal GetPointer DeclarePointer) + set (multiValueArgs) + cmake_parse_arguments (ARGS "${options}" "${oneValueArgs}" "${multiValueArgs}" ${ARGN}) + + string (REPLACE "_GridComp" "" component_name ${target}) + + if (ARGS_UNPARSED_ARGUMENTS) + ecbuild_error ("mapl_acg() unparsed arguments: ${ARGS_UNPARSED_ARGUMENTS}") + endif () + + set (generated) # empty unless + set (options "") + + + # Handle oneValueArgs with no value (Python provides default) + foreach (opt flag default IN ZIP_LISTS oneValueArgs flags defaults) + + if (ARGS_${opt}) + string (REPLACE "{component}" component_name fname ${ARGS_${opt}}) + list (APPEND generated ${fname}) + list (APPEND options ${flag} ${ARGS_${opt}}) + elseif (${opt} IN_LIST ARGS_KEYWORDS_MISSING_VALUES) + string (REPLACE "{component}" component_name fname ${default}) + list (APPEND generated ${fname}) + list (APPEND options ${flag}) + endif () + + endforeach () + + set(generator ${esma_etc}/MAPL/MAPL_GridCompSpecs_ACG.py) + add_custom_command ( + OUTPUT ${generated} + COMMAND ${generator} ${CMAKE_CURRENT_SOURCE_DIR}/${specs_file} ${options} + MAIN_DEPENDENCY ${CMAKE_CURRENT_SOURCE_DIR}/${specs_file} + DEPENDS ${generator} ${specs_file} + WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR} + COMMENT "Generating automatic code for ${specs_file}" + ) + add_custom_target (acg_phony_${target} DEPENDS ${generated}) + add_dependencies (${target} acg_phony_${target}) + +endmacro () + + From 5799d48bb9b4cb46ede5da2fea49a598e9d58aac Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Mon, 30 Mar 2020 14:19:59 -0400 Subject: [PATCH 071/109] Updated documentation. --- Apps/mapl_acg.cmake | 67 -------------------------------------------- cmake/mapl_acg.cmake | 12 ++++---- 2 files changed, 6 insertions(+), 73 deletions(-) delete mode 100644 Apps/mapl_acg.cmake diff --git a/Apps/mapl_acg.cmake b/Apps/mapl_acg.cmake deleted file mode 100644 index aafb9160b310..000000000000 --- a/Apps/mapl_acg.cmake +++ /dev/null @@ -1,67 +0,0 @@ -################################################################################################ -# Automatically generate files from a file that provides specs -# for the states of a gridde component. -# -# Usage: -# -# mapl_acg (target specs_file ) -# -# Options: -# IMPORT_SPECS [file] filename for AddImportSpec() code (default _Import___.h) -# EXPORT_SPECS [file] filename for AddExportSpec() code (default _Export___.h) -# INTERNAL_SPECS [file] filename for AddInternalSpec() code (default _Internal___.h) -# GET_POINTERS [file] filename for GetPointer() code (default _GetPointer___.h) -# DECLARE_POINTERS [file] filename for GetPointer() code (default _DeclarePointer___.h) -# -################################################################################################ - - -macro (mapl_acg target specs_file) - set (options) - set (oneValueArgs IMPORT_SPECS EXPORT_SPECS INTERNAL_SPECS GET_POINTERS DECLARE_POINTERS) - # This list must align with oneValueArgs above (for later ZIP_LISTS) - set (flags -i -x -p -g -d) - set (defaults Import Export Internal GetPointer DeclarePointer) - set (multiValueArgs) - cmake_parse_arguments (ARGS "${options}" "${oneValueArgs}" "${multiValueArgs}" ${ARGN}) - - string (REPLACE "_GridComp" "" component_name ${target}) - - if (ARGS_UNPARSED_ARGUMENTS) - ecbuild_error ("mapl_acg() unparsed arguments: ${ARGS_UNPARSED_ARGUMENTS}") - endif () - - set (generated) # empty unless - set (options "") - - - # Handle oneValueArgs with no value (Python provides default) - foreach (opt flag default IN ZIP_LISTS oneValueArgs flags defaults) - - if (ARGS_${opt}) - string (REPLACE "{component}" component_name fname ${ARGS_${opt}}) - list (APPEND generated ${fname}) - list (APPEND options ${flag} ${ARGS_${opt}}) - elseif (${opt} IN_LIST ARGS_KEYWORDS_MISSING_VALUES) - string (REPLACE "{component}" component_name fname ${default}) - list (APPEND generated ${fname}) - list (APPEND options ${flag}) - endif () - - endforeach () - - set(generator ${esma_etc}/MAPL/MAPL_GridCompSpecs_ACG.py) - add_custom_command ( - OUTPUT ${generated} - COMMAND ${generator} ${CMAKE_CURRENT_SOURCE_DIR}/${specs_file} ${options} - MAIN_DEPENDENCY ${CMAKE_CURRENT_SOURCE_DIR}/${specs_file} - DEPENDS ${generator} ${specs_file} - WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR} - COMMENT "Generating automatic code for ${specs_file}" - ) - add_custom_target (acg_phony_${target} DEPENDS ${generated}) - add_dependencies (${target} acg_phony_${target}) - -endmacro () - - diff --git a/cmake/mapl_acg.cmake b/cmake/mapl_acg.cmake index ab7d3f9b3f1f..58ad5bcff7fb 100644 --- a/cmake/mapl_acg.cmake +++ b/cmake/mapl_acg.cmake @@ -7,11 +7,11 @@ # mapl_acg (target specs_file ) # # Options: -# IMPORT_SPECS [file] filename for AddImportSpec() code (default _Import___.h) -# EXPORT_SPECS [file] filename for AddExportSpec() code (default _Export___.h) -# INTERNAL_SPECS [file] filename for AddInternalSpec() code (default _Internal___.h) -# GET_POINTERS [file] filename for GetPointer() code (default _GetPointer___.h) -# GET_POINTERS [file] filename for GetPointer() code (default _DeclarePointer___.h) +# IMPORT_SPECS [file] include file for AddImportSpec() code (default _Import___.h) +# EXPORT_SPECS [file] include file for AddExportSpec() code (default _Export___.h) +# INTERNAL_SPECS [file] include file for AddInternalSpec() code (default _Internal___.h) +# GET_POINTERS [file] include file for GetPointer() code (default _GetPointer___.h) +# DECLARE_POINTERS [file] include file for declaring local pointers (default _DeclarePointer___.h) # ################################################################################################ @@ -28,7 +28,7 @@ function (mapl_acg target specs_file) string (REPLACE "_GridComp" "" component_name ${target}) if (ARGS_UNPARSED_ARGUMENTS) - ecbuild_error ("esma_set_this unparsed arguments: ${ARGS_UNPARSED_ARGUMENTS}") + ecbuild_error ("maple_acg() - unparsed arguments: ${ARGS_UNPARSED_ARGUMENTS}") endif () set (generated) # empty unless From 64ea24241aa5d3d5ebe7d2863209fc1b009cb9d7 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 30 Mar 2020 19:00:30 -0400 Subject: [PATCH 072/109] Fixes #272. Use IOR() for netcdf modes As the subject says, this PR uses IOR() to "combine" netCDF modes. --- GMAO_pFIO/NetCDF4_FileFormatter.F90 | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/GMAO_pFIO/NetCDF4_FileFormatter.F90 b/GMAO_pFIO/NetCDF4_FileFormatter.F90 index 9c5ea1da1c1b..f363303377d8 100644 --- a/GMAO_pFIO/NetCDF4_FileFormatter.F90 +++ b/GMAO_pFIO/NetCDF4_FileFormatter.F90 @@ -133,7 +133,7 @@ subroutine create(this, file, unusable, rc) integer :: status !$omp critical - status = nf90_create(file, NF90_NOCLOBBER + NF90_NETCDF4, this%ncid) + status = nf90_create(file, IOR(NF90_NOCLOBBER, NF90_NETCDF4), this%ncid) !$omp end critical _VERIFY(status) @@ -153,6 +153,7 @@ subroutine create_par(this, file, unusable, comm, info, rc) integer :: comm_ integer :: info_ integer :: status + integer :: mode if (present(comm)) then comm_ = comm @@ -170,8 +171,13 @@ subroutine create_par(this, file, unusable, comm, info, rc) this%comm = comm_ this%info = info_ + mode = NF90_NOCLOBBER + mode = IOR(mode, NF90_NETCDF4) + mode = IOR(mode, NF90_SHARE) + mode = IOR(mode, NF90_MPIIO) + !$omp critical - status = nf90_create(file, NF90_NOCLOBBER + NF90_NETCDF4 + NF90_SHARE + NF90_MPIIO, comm=comm_, info=info_, ncid=this%ncid) + status = nf90_create(file, mode, comm=comm_, info=info_, ncid=this%ncid) !$omp end critical _VERIFY(status) @@ -214,12 +220,12 @@ subroutine open(this, file, mode, unusable, comm, info, rc) if (this%parallel) then !$omp critical - status = nf90_open(file, omode + NF90_MPIIO, comm=this%comm, info=this%info, ncid=this%ncid) + status = nf90_open(file, IOR(omode, NF90_MPIIO), comm=this%comm, info=this%info, ncid=this%ncid) !$omp end critical _VERIFY(status) else !$omp critical - status = nf90_open(file, omode + NF90_SHARE, this%ncid) + status = nf90_open(file, IOR(omode, NF90_SHARE), this%ncid) !$omp end critical _VERIFY(status) end if From 2317ed95d8a73099eea056b9e2d86303b7b0fbc6 Mon Sep 17 00:00:00 2001 From: Benjamin Auer Date: Tue, 31 Mar 2020 15:14:55 -0400 Subject: [PATCH 073/109] fixes issue #274 --- MAPL_Base/MAPL_newCFIO.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/MAPL_Base/MAPL_newCFIO.F90 b/MAPL_Base/MAPL_newCFIO.F90 index 1ab404172a04..b32e159cc674 100644 --- a/MAPL_Base/MAPL_newCFIO.F90 +++ b/MAPL_Base/MAPL_newCFIO.F90 @@ -843,8 +843,8 @@ subroutine request_data_from_file(this,filename,timeindex,rc) this%read_collection_id, fileName, trim(names(i)), & & ref, start=localStart, global_start=globalStart, global_count=globalCount) deallocate(localStart,globalStart,globalCount) - deallocate(gridLocalStart,gridGlobalStart,gridGlobalCount) enddo + deallocate(gridLocalStart,gridGlobalStart,gridGlobalCount) this%input_bundle = ESMF_FieldBundleCreate(fieldList=input_fields,rc=status) _VERIFY(status) _RETURN(_SUCCESS) From fbe45feec45a6d2358ca7aa9f521f1442d2af5e5 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Tue, 31 Mar 2020 18:48:12 -0400 Subject: [PATCH 074/109] applying new profiler --- MAPL_Base/CMakeLists.txt | 2 +- MAPL_Base/MAPL_Cap.F90 | 70 ++++++++++++++++- MAPL_Base/MAPL_CapGridComp.F90 | 33 +++++++- MAPL_Base/MAPL_Generic.F90 | 134 ++++++++++++++++++++++++++++++++- 4 files changed, 233 insertions(+), 6 deletions(-) diff --git a/MAPL_Base/CMakeLists.txt b/MAPL_Base/CMakeLists.txt index 9674c0caeebb..03f79ffdf664 100644 --- a/MAPL_Base/CMakeLists.txt +++ b/MAPL_Base/CMakeLists.txt @@ -64,7 +64,7 @@ set (srcs FileMetadataUtilities.F90 FileMetadataUtilitiesVector.F90 ) -esma_add_library(${this} SRCS ${srcs} DEPENDENCIES GMAO_pFIO MAPL_cfio_r4 gftl-shared FLAP::FLAP MPI::MPI_Fortran) +esma_add_library(${this} SRCS ${srcs} DEPENDENCIES MAPL_Profiler GMAO_pFIO MAPL_cfio_r4 gftl-shared FLAP::FLAP MPI::MPI_Fortran) target_compile_options (${this} PRIVATE $<$:${OpenMP_Fortran_FLAGS}>) if(DISABLE_GLOBAL_NAME_WARNING) target_compile_options (${this} PRIVATE $<$:${DISABLE_GLOBAL_NAME_WARNING}>) diff --git a/MAPL_Base/MAPL_Cap.F90 b/MAPL_Base/MAPL_Cap.F90 index cdcc33a50333..ff78ffa41d05 100644 --- a/MAPL_Base/MAPL_Cap.F90 +++ b/MAPL_Base/MAPL_Cap.F90 @@ -14,6 +14,7 @@ module MAPL_CapMod use MAPL_BaseMod use MAPL_ErrorHandlingMod use pFIO + use MAPL_Profiler use MAPL_ioClientsMod use MAPL_CapOptionsMod implicit none @@ -34,7 +35,7 @@ module MAPL_CapMod logical :: mpi_already_initialized = .false. type(MAPL_CapGridComp), public :: cap_gc - type (SplitCommunicator) :: split_comm + type(SplitCommunicator) :: split_comm type(MAPL_Communicators) :: mapl_comm type(MpiServer), pointer :: i_server=>null() type(MpiServer), pointer :: o_server=>null() @@ -119,13 +120,15 @@ subroutine run(this, unusable, rc) class (MAPL_Cap), intent(inout) :: this class (KeywordEnforcer), optional, intent(in) :: unusable integer, optional, intent(out) :: rc - integer :: status +! + _UNUSED_DUMMY(unusable) call this%run_ensemble(rc=status); _VERIFY(status) call this%finalize_mpi(rc=status); _VERIFY(status) + _RETURN(_SUCCESS) end subroutine run @@ -416,9 +419,26 @@ subroutine run_model(this, mapl_comm, unusable, rc) type (ESMF_VM) :: vm integer :: start_tick, stop_tick, tick_rate integer :: status + +! profiler +! + type (ProfileReporter) :: reporter + type (ProfileReporter) :: mem_reporter + integer :: i + character(:), allocatable :: report_lines(:) + type (MultiColumn) :: inclusive + type (MultiColumn) :: exclusive + class (BaseProfiler), pointer :: t_p, m_p + integer :: npes, my_rank, rank, ierror + _UNUSED_DUMMY(unusable) + t_p => get_global_time_profiler() + m_p => get_global_memory_profiler() + t_p = TimeProfiler('All') + m_p = MemoryProfiler('All') + call start_timer() call ESMF_Initialize (vm=vm, logKindFlag=this%cap_options%esmf_logging_mode, mpiCommunicator=mapl_comm%esmf%comm, rc=status) _VERIFY(status) @@ -439,6 +459,52 @@ subroutine run_model(this, mapl_comm, unusable, rc) call stop_timer() call report_throughput() + call t_p%finalize() + call m_p%finalize() + print*,__FILE__,__LINE__,t_p%get_num_meters() + call reporter%add_column(NameColumn(50)) + call reporter%add_column(FormattedTextColumn('#-cycles','(i5.0)', 5, NumCyclesColumn(),separator='-')) + + inclusive = MultiColumn(['Inclusive'], separator='=') + call inclusive%add_column(FormattedTextColumn(' T (sec) ','(f9.3)', 9, InclusiveColumn(), separator='-')) + call inclusive%add_column(FormattedTextColumn(' % ','(f6.2)', 6, PercentageColumn(InclusiveColumn(),'MAX'),separator='-')) + call reporter%add_column(inclusive) + + exclusive = MultiColumn(['Exclusive'], separator='=') + call exclusive%add_column(FormattedTextColumn(' T (sec) ','(f9.3)', 9, ExclusiveColumn(), separator='-')) + call exclusive%add_column(FormattedTextColumn(' % ','(f6.2)', 6, PercentageColumn(ExclusiveColumn()), separator='-')) + call reporter%add_column(exclusive) + +!!$ call reporter%add_column(FormattedTextColumn(' std. dev ','(f12.4)', 12, StdDevColumn())) +!!$ call reporter%add_column(FormattedTextColumn(' rel. dev ','(f12.4)', 12, StdDevColumn(relative=.true.))) +!!$ call reporter%add_column(FormattedTextColumn(' max cyc ','(f12.8)', 12, MaxCycleColumn())) +!!$ call reporter%add_column(FormattedTextColumn(' min cyc ','(f12.8)', 12, MinCycleColumn())) +!!$ call reporter%add_column(FormattedTextColumn(' mean cyc','(f12.8)', 12, MeanCycleColumn())) + call mem_reporter%add_column(NameColumn(50,separator='-')) + call mem_reporter%add_column(MemoryTextColumn(['RSS'],'(i10,1x,a2)',13, InclusiveColumn(),separator='-')) + call mem_reporter%add_column(MemoryTextColumn(['Cyc RSS'],'(i10,1x,a2)',13, MeanCycleColumn(),separator='-')) + +!!$ report_lines = reporter%generate_report(get_global_time_profiler()) + + call MPI_Comm_size(mapl_comm%esmf%comm, npes, ierror) + call MPI_Comm_Rank(mapl_comm%esmf%comm, my_rank, ierror) + + do rank = 0, npes-1 +!!$ if (this%rank == 0) then + if (rank == my_rank) then + report_lines = reporter%generate_report(t_p) + write(*,'(a,1x,i0)')'Report on process: ', rank + do i = 1, size(report_lines) + write(*,'(a)') report_lines(i) + end do + print*,' ' + report_lines = mem_reporter%generate_report(m_p) + do i = 1, size(report_lines) + write(*,'(a)') report_lines(i) + end do + end if + call MPI_Barrier(mapl_comm%esmf%comm, ierror) + end do _RETURN(_SUCCESS) contains diff --git a/MAPL_Base/MAPL_CapGridComp.F90 b/MAPL_Base/MAPL_CapGridComp.F90 index 8c00d394abad..ce870300071c 100644 --- a/MAPL_Base/MAPL_CapGridComp.F90 +++ b/MAPL_Base/MAPL_CapGridComp.F90 @@ -6,6 +6,7 @@ module MAPL_CapGridCompMod use MAPL_ErrorHandlingMod use MAPL_BaseMod use MAPL_ConstantsMod + use MAPL_Profiler, only: BaseProfiler, get_global_time_profiler, get_global_memory_profiler use MAPL_ProfMod use MAPL_MemUtilsMod use MAPL_IOMod @@ -169,6 +170,7 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) type (MAPL_MetaComp), pointer :: MAPLOBJ procedure(), pointer :: root_set_services type(MAPL_CapGridComp), pointer :: cap + class(BaseProfiler), pointer :: t_p, m_p _UNUSED_DUMMY(import_state) _UNUSED_DUMMY(export_state) @@ -177,6 +179,11 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) cap => get_CapGridComp_from_gc(gc) maplobj => get_MetaComp_from_gc(gc) + t_p => get_global_time_profiler() + m_p => get_global_memory_profiler() + call t_p%start('Initialize') + call m_p%start('Initialize') + call ESMF_GridCompGet(gc, vm = cap%vm, rc = status) _VERIFY(status) call ESMF_VMGet(cap%vm, petcount = NPES, mpiCommunicator = comm, rc = status) @@ -574,6 +581,10 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) ExtData_internal_state%expState = CAP%CHILD_EXPORTS(cap%extdata_id) end if end if + + call m_p%stop('Initialize') + call t_p%stop('Initialize') + _RETURN(ESMF_SUCCESS) end subroutine initialize_gc @@ -714,13 +725,23 @@ subroutine run_gc(gc, import, export, clock, rc) integer, intent(out) :: RC ! Error code: integer :: status + class (BaseProfiler), pointer :: t_p, m_p _UNUSED_DUMMY(import) _UNUSED_DUMMY(export) _UNUSED_DUMMY(clock) + t_p => get_global_time_profiler() + m_p => get_global_memory_profiler() + call t_p%start('Run') + call m_p%start('Run') + call run_MAPL_GridComp(gc, rc=status) _VERIFY(status) + + call m_p%stop('Run') + call t_p%stop('Run') + _RETURN(ESMF_SUCCESS) end subroutine run_gc @@ -736,6 +757,7 @@ subroutine finalize_gc(gc, import_state, export_state, clock, rc) type(MAPL_CapGridComp), pointer :: cap type(MAPL_MetaComp), pointer :: MAPLOBJ + class (BaseProfiler), pointer :: t_p, m_p _UNUSED_DUMMY(import_state) _UNUSED_DUMMY(export_state) @@ -744,6 +766,11 @@ subroutine finalize_gc(gc, import_state, export_state, clock, rc) cap => get_CapGridComp_from_gc(gc) MAPLOBJ => get_MetaComp_from_gc(gc) + t_p => get_global_time_profiler() + m_p => get_global_memory_profiler() + call t_p%start('Finalize') + call m_p%start('Finalize') + if (.not. cap%printspec > 0) then call ESMF_GridCompFinalize(cap%gcs(cap%root_id), importstate = cap%child_imports(cap%root_id), & @@ -786,6 +813,10 @@ subroutine finalize_gc(gc, import_state, export_state, clock, rc) end if end if end if + + call m_p%stop('Finalize') + call t_p%stop('Finalize') + _RETURN(ESMF_SUCCESS) end subroutine finalize_gc @@ -844,7 +875,6 @@ subroutine run(this, rc) end subroutine run - subroutine finalize(this, rc) class(MAPL_CapGridComp), intent(inout) :: this integer, optional, intent(out) :: rc @@ -856,7 +886,6 @@ subroutine finalize(this, rc) _RETURN(ESMF_SUCCESS) end subroutine finalize - function get_model_duration(this, rc) result (duration) class (MAPL_CapGridComp) :: this integer, optional, intent(out) :: rc diff --git a/MAPL_Base/MAPL_Generic.F90 b/MAPL_Base/MAPL_Generic.F90 index 52a394c75c6f..86bd4db3a53b 100644 --- a/MAPL_Base/MAPL_Generic.F90 +++ b/MAPL_Base/MAPL_Generic.F90 @@ -115,6 +115,7 @@ module MAPL_GenericMod use MAPL_BaseMod use MAPL_IOMod use MAPL_ProfMod + use MAPL_Profiler use MAPL_MemUtilsMod use MAPL_CommsMod use MAPL_ConstantsMod @@ -126,6 +127,7 @@ module MAPL_GenericMod use MAPL_ErrorHandlingMod use, intrinsic :: ISO_C_BINDING use, intrinsic :: iso_fortran_env, only: REAL32, REAL64, int32, int64 + use, intrinsic :: iso_fortran_env, only: OUTPUT_UNIT ! !PUBLIC MEMBER FUNCTIONS: @@ -395,6 +397,8 @@ module MAPL_GenericMod integer , pointer :: phase_coldstart(:)=> null() real :: HEARTBEAT type (MAPL_Communicators) :: mapl_comm + type (TimeProfiler) :: t_profiler + type (MemoryProfiler) :: m_profiler !!$ integer :: comm end type MAPL_MetaComp !EOC @@ -888,6 +892,7 @@ recursive subroutine MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, RC ) logical :: isPresent logical :: isCreated logical :: gridIsPresent + class(BaseProfiler), pointer :: t_p, m_p character(len=ESMF_MAXSTR) :: write_restart_by_face character(len=ESMF_MAXSTR) :: read_restart_by_face character(len=ESMF_MAXSTR) :: write_restart_by_oserver @@ -912,6 +917,12 @@ recursive subroutine MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, RC ) ! Start my timer !--------------- + t_p => get_global_time_profiler() + m_p => get_global_memory_profiler() + call t_p%start(trim(state%compname)) + call m_p%start(trim(state%compname)) + call state%t_profiler%start('Initialize') + call state%m_profiler%start('Initialize') call MAPL_GenericStateClockOn(STATE,"TOTAL") call MAPL_GenericStateClockOn(STATE,"GenInitTot") @@ -1669,6 +1680,11 @@ recursive subroutine MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_GenericStateClockOff(STATE,"GenInitTot") call MAPL_GenericStateClockOff(STATE,"TOTAL") + call state%m_profiler%stop('Initialize') + call state%t_profiler%stop('Initialize') + call m_p%stop(trim(state%compname)) + call t_p%stop(trim(state%compname)) + ! Write Memory Use Statistics. ! ------------------------------------------- call MAPL_MemUtilsWrite(VM, Iam, RC=STATUS ) @@ -1711,6 +1727,8 @@ subroutine MAPL_GenericWrapper ( GC, IMPORT, EXPORT, CLOCK, RC) integer :: I type(ESMF_Method_Flag) :: method type(ESMF_VM) :: VM + class(BaseProfiler), pointer :: t_p, m_p + character(1) :: char_phase character(len=12), pointer :: timers(:) => NULL() ! the next declaration assumes all 5 methods have the same signature @@ -1748,6 +1766,21 @@ subroutine MAPL_GenericWrapper ( GC, IMPORT, EXPORT, CLOCK, RC) ! TIMERS on + t_p => get_global_time_profiler() + m_p => get_global_memory_profiler() + if (phase > 1) then + write(char_phase,'(i1)')phase + call t_p%start(trim(state%compname)//'_'//char_phase) + call m_p%start(trim(state%compname)//'_'//char_phase) + call state%t_profiler%start('Run'//char_phase) + call state%m_profiler%start('Run'//char_phase) + else + call t_p%start(trim(state%compname)) + call m_p%start(trim(state%compname)) + call state%t_profiler%start('Run') + call state%m_profiler%start('Run') + end if + MethodBlock: if (method == ESMF_METHOD_RUN) then func_ptr => ESMF_GridCompRun timers => timers_run @@ -1808,6 +1841,18 @@ subroutine MAPL_GenericWrapper ( GC, IMPORT, EXPORT, CLOCK, RC) end do end if + if (phase > 1) then + call state%m_profiler%stop('Run'//char_phase) + call state%t_profiler%stop('Run'//char_phase) + call m_p%stop(trim(state%compname)//'_'//char_phase) + call t_p%stop(trim(state%compname)//'_'//char_phase) + else + call state%m_profiler%stop('Run') + call state%t_profiler%stop('Run') + call m_p%stop(trim(state%compname)) + call t_p%stop(trim(state%compname)) + end if + _RETURN(ESMF_SUCCESS) end subroutine MAPL_GenericWrapper @@ -1971,6 +2016,8 @@ recursive subroutine MAPL_GenericFinalize ( GC, IMPORT, EXPORT, CLOCK, RC ) character(len=ESMF_MAXSTR) :: id_string integer :: ens_id_width type(ESMF_Time) :: CurrTime + class(BaseProfiler), pointer :: t_p, m_p + !============================================================================= ! Begin... @@ -1992,6 +2039,13 @@ recursive subroutine MAPL_GenericFinalize ( GC, IMPORT, EXPORT, CLOCK, RC ) ! Finalize the children ! --------------------- + t_p => get_global_time_profiler() + m_p => get_global_memory_profiler() + call t_p%start(trim(state%compname)) + call m_p%start(trim(state%compname)) + call state%t_profiler%start('Final') + call state%m_profiler%start('Final') + call MAPL_GenericStateClockOn(STATE,"TOTAL") call MAPL_GenericStateClockOn(STATE,"GenFinalTot") if(associated(STATE%GCS)) then @@ -2122,8 +2176,57 @@ recursive subroutine MAPL_GenericFinalize ( GC, IMPORT, EXPORT, CLOCK, RC ) ! Write summary of profiled times !-------------------------------- + + call state%m_profiler%stop('Final') + call state%t_profiler%stop('Final') + call state%m_profiler%finalize() + call state%t_profiler%finalize() if (.not. MAPL_ProfIsDisabled()) then + + block + character(:), allocatable :: report(:) + type (ProfileReporter) :: reporter, mem_reporter + type (MultiColumn) :: inclusive, exclusive + type (ESMF_VM) :: vm + + call ESMF_VmGetCurrent(vm, rc=status) + _VERIFY(STATUS) + if (MAPL_AM_I_Root(vm)) then + + call mem_reporter%add_column(NameColumn(50,separator='-')) + call mem_reporter%add_column(MemoryTextColumn(['RSS'],'(i10,1x,a2)', 13, InclusiveColumn(),separator='-')) + call mem_reporter%add_column(MemoryTextColumn(['Cyc RSS'],'(i10,1x,a2)', 13, MeanCycleColumn(),separator='-')) + + report = mem_reporter%generate_report(state%m_profiler) + write(OUTPUT_UNIT,*)'' + write(OUTPUT_UNIT,*)'Memory for ' // trim(comp_name) + do i = 1, size(report) + write(OUTPUT_UNIT,'(a)')report(i) + end do + write(OUTPUT_UNIT,*)'' + + call reporter%add_column(NameColumn(50)) + call reporter%add_column(FormattedTextColumn('#-cycles','(i5.0)', 5, NumCyclesColumn(),separator='-')) + inclusive = MultiColumn(['Inclusive'], separator='=') + call inclusive%add_column(FormattedTextColumn(' T (sec) ','(f9.3)', 9, InclusiveColumn(), separator='-')) + call inclusive%add_column(FormattedTextColumn(' % ','(f6.2)', 6, PercentageColumn(InclusiveColumn(),'MAX'),separator='-')) + call reporter%add_column(inclusive) + exclusive = MultiColumn(['Exclusive'], separator='=') + call exclusive%add_column(FormattedTextColumn(' T (sec) ','(f9.3)', 9, ExclusiveColumn(), separator='-')) + call exclusive%add_column(FormattedTextColumn(' % ','(f6.2)', 6, PercentageColumn(ExclusiveColumn()), separator='-')) + call reporter%add_column(exclusive) + + report = reporter%generate_report(state%t_profiler) + write(OUTPUT_UNIT,*)'' + write(OUTPUT_UNIT,*)'Time for ' // trim(comp_name) + do i = 1, size(report) + write(OUTPUT_UNIT,'(a)')report(i) + end do + write(OUTPUT_UNIT,*)'' + end if + end block + call WRITE_PARALLEL(" ") call WRITE_PARALLEL(" Times for "//trim(COMP_NAME)) @@ -2133,6 +2236,9 @@ recursive subroutine MAPL_GenericFinalize ( GC, IMPORT, EXPORT, CLOCK, RC ) call WRITE_PARALLEL(" ") end if + call m_p%stop(trim(state%compname)) + call t_p%stop(trim(state%compname)) + ! Clean-up !--------- !ALT @@ -2184,6 +2290,7 @@ recursive subroutine MAPL_GenericRecord ( GC, IMPORT, EXPORT, CLOCK, RC ) integer :: K logical :: ftype(0:1) + class(BaseProfiler), pointer :: t_p, m_p !============================================================================= ! Begin... @@ -2199,6 +2306,13 @@ recursive subroutine MAPL_GenericRecord ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_InternalStateRetrieve(GC, STATE, RC=STATUS) _VERIFY(STATUS) + t_p => get_global_time_profiler() + m_p => get_global_memory_profiler() + call t_p%start(trim(state%compname)) + call m_p%start(trim(state%compname)) + call state%t_profiler%start('Record') + call state%m_profiler%start('Record') + call MAPL_GenericStateClockOn(STATE,"TOTAL") call MAPL_GenericStateClockOn(STATE,"GenRecordTot") ! Record the children @@ -2290,6 +2404,10 @@ recursive subroutine MAPL_GenericRecord ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_GenericStateClockOff(STATE,"GenRecordTot") call MAPL_GenericStateClockOff(STATE,"TOTAL") + call state%m_profiler%stop('Record') + call state%t_profiler%stop('Record') + call m_p%stop(trim(state%compname)) + call t_p%stop(trim(state%compname)) _RETURN(ESMF_SUCCESS) end subroutine MAPL_GenericRecord @@ -2397,7 +2515,7 @@ recursive subroutine MAPL_GenericRefresh ( GC, IMPORT, EXPORT, CLOCK, RC ) character(len=ESMF_MAXSTR) :: filetypechar character(len=4) :: extension integer :: hdr - + class(BaseProfiler), pointer :: t_p, m_p !============================================================================= ! Begin... @@ -2413,6 +2531,13 @@ recursive subroutine MAPL_GenericRefresh ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_InternalStateRetrieve(GC, STATE, RC=STATUS) _VERIFY(STATUS) + t_p => get_global_time_profiler() + m_p => get_global_memory_profiler() + call t_p%start(trim(state%compname)) + call m_p%start(trim(state%compname)) + call state%t_profiler%start('Refresh') + call state%m_profiler%start('Refresh') + call MAPL_GenericStateClockOn(STATE,"TOTAL") call MAPL_GenericStateClockOn(STATE,"GenRefreshTot") ! Refresh the children @@ -2493,6 +2618,10 @@ recursive subroutine MAPL_GenericRefresh ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_GenericStateClockOff(STATE,"GenRefreshTot") call MAPL_GenericStateClockOff(STATE,"TOTAL") + call state%m_profiler%stop('Refresh') + call state%t_profiler%stop('Refresh') + call m_p%stop(trim(state%compname)) + call t_p%stop(trim(state%compname)) _RETURN(ESMF_SUCCESS) end subroutine MAPL_GenericRefresh @@ -4821,6 +4950,9 @@ subroutine MAPL_GenericStateClockAdd(GC, NAME, RC) call MAPL_ProfSet(STATE%TIMES,NAME=NAME,RC=STATUS) _VERIFY(STATUS) + state%t_profiler = TimeProfiler(trim(state%compname)) + state%m_profiler = MemoryProfiler(trim(state%compname)) + _RETURN(ESMF_SUCCESS) end subroutine MAPL_GenericStateClockAdd From 13b78e3943a22749b34b0ef9ee8d4b6f767aeb12 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Tue, 31 Mar 2020 20:24:28 -0400 Subject: [PATCH 075/109] bug fix for cml options --- MAPL_Profiler/RssMemoryGauge.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/MAPL_Profiler/RssMemoryGauge.F90 b/MAPL_Profiler/RssMemoryGauge.F90 index 28c850586977..aee14fc31196 100644 --- a/MAPL_Profiler/RssMemoryGauge.F90 +++ b/MAPL_Profiler/RssMemoryGauge.F90 @@ -62,7 +62,7 @@ function get_measurement(this) result(mem_use) write(buffer,'(i0)')pid pid_str = trim(buffer) tmp_file = 'tmp.pid'//pid_str - call execute_command_line("ps -p " // pid_str // " -ocommand='',rss='' | awk '{ print $2 }'> " // tmp_file) + call execute_command_line("ps -p " // pid_str // " -ocommand='',rss='' | awk '{ print $NF }'> " // tmp_file) open(newunit=unit, file=tmp_file, form='formatted', access='sequential', status='old') read(unit,*) mem_use From a25691e72b15840caf23517a5edb988713912fc5 Mon Sep 17 00:00:00 2001 From: Atanas Trayanov Date: Tue, 31 Mar 2020 14:58:18 -0400 Subject: [PATCH 076/109] AT: first attempt to merge the changes (from the CVS version) that enable monthly averages in History. Fixed logic with partial month average. Cleaned up debugging prints --- MAPL_Base/MAPL_GenericCplComp.F90 | 520 +++++++++++++++++++++++++-- MAPL_Base/MAPL_HistoryCollection.F90 | 2 + MAPL_Base/MAPL_HistoryGridComp.F90 | 113 +++++- 3 files changed, 594 insertions(+), 41 deletions(-) diff --git a/MAPL_Base/MAPL_GenericCplComp.F90 b/MAPL_Base/MAPL_GenericCplComp.F90 index e5965be04f93..762fd9feef1d 100644 --- a/MAPL_Base/MAPL_GenericCplComp.F90 +++ b/MAPL_Base/MAPL_GenericCplComp.F90 @@ -25,6 +25,7 @@ module MAPL_GenericCplCompMod use MAPL_BaseMod use MAPL_ConstantsMod use MAPL_IOMod + use MAPL_CommsMod use MAPL_ProfMod use MAPL_SunMod use MAPL_VarSpecMod @@ -37,6 +38,7 @@ module MAPL_GenericCplCompMod public GenericCplSetServices public MAPL_CplCompSetVarSpecs + public MAPL_CplCompSetAlarm !EOP @@ -51,6 +53,7 @@ module MAPL_GenericCplCompMod ! These are done in set services type (ESMF_Config) :: CF logical :: ACTIVE + type (ESMF_Alarm), pointer :: TIME2CPL_ALARM => null() character(LEN=ESMF_MAXSTR) :: NAME type (MAPL_VarSpec), pointer :: SRC_SPEC(:) => null() type (MAPL_VarSpec), pointer :: DST_SPEC(:) => null() @@ -142,6 +145,14 @@ subroutine GenericCplSetServices ( CC, RC ) rc=STATUS ) _VERIFY(STATUS) +!ALT: Add these 2 IO methods to facilitate transparent checkpointing +! to support monthly averages + call ESMF_CplCompSetEntryPoint ( CC, ESMF_METHOD_READRESTART, ReadRestart, & + rc=STATUS ) + _VERIFY(STATUS) + call ESMF_CplCompSetEntryPoint ( CC, ESMF_METHOD_WRITERESTART, WriteRestart, & + rc=STATUS ) + _VERIFY(STATUS) ! Put the inherited configuration in the internal state ! ----------------------------------------------------- @@ -367,46 +378,50 @@ subroutine Initialize(CC, SRC, DST, CLOCK, RC) rTime = TM0 + TOFF - STATE%TIME_TO_COUPLE(J) = ESMF_AlarmCreate(NAME='TIME2COUPLE_' // trim(COMP_NAME) & - // '_' // trim(NAME), & - clock = CLOCK, & - ringInterval = TCPL, & - ringTime = rTime, & - sticky = .false., & - rc=STATUS ) - _VERIFY(STATUS) - - if(rTime == currTime) then - call ESMF_AlarmRingerOn(STATE%TIME_TO_COUPLE(J), rc=status); _VERIFY(STATUS) - end if + if (associated(STATE%TIME2CPL_ALARM)) then + STATE%TIME_TO_COUPLE(J) = STATE%TIME2CPL_ALARM + STATE%TIME_TO_CLEAR(J) = STATE%TIME2CPL_ALARM + else + STATE%TIME_TO_COUPLE(J) = ESMF_AlarmCreate(NAME='TIME2COUPLE_' // trim(COMP_NAME) & + // '_' // trim(NAME), & + clock = CLOCK, & + ringInterval = TCPL, & + ringTime = rTime, & + sticky = .false., & + rc=STATUS ) + _VERIFY(STATUS) + if(rTime == currTime) then + call ESMF_AlarmRingerOn(STATE%TIME_TO_COUPLE(J), rc=status); _VERIFY(STATUS) + end if ! initalize CLEAR ALARM from destination properties !-------------------------------------------------- - call ESMF_TimeIntervalSet(TCLR, S=STATE%CLEAR_INTERVAL(J), & - calendar=cal, RC=STATUS) - _VERIFY(STATUS) + call ESMF_TimeIntervalSet(TCLR, S=STATE%CLEAR_INTERVAL(J), & + calendar=cal, RC=STATUS) + _VERIFY(STATUS) - if (TCLR < TS) TCLR = TS + if (TCLR < TS) TCLR = TS - rTime = TM0 + TOFF - TCLR + rTime = TM0 + TOFF - TCLR - do while (rTime < currTime) - rTime = rTime + TCPL - end do + do while (rTime < currTime) + rTime = rTime + TCPL + end do - STATE%TIME_TO_CLEAR(J) = ESMF_AlarmCreate(NAME='TIME2CLEAR_' // trim(COMP_NAME) & - // '_' // trim(NAME), & - clock = CLOCK, & - ringInterval = TCPL, & - ringTime = rTime, & - sticky = .false., & - rc=STATUS ) - _VERIFY(STATUS) + STATE%TIME_TO_CLEAR(J) = ESMF_AlarmCreate(NAME='TIME2CLEAR_' // trim(COMP_NAME) & + // '_' // trim(NAME), & + clock = CLOCK, & + ringInterval = TCPL, & + ringTime = rTime, & + sticky = .false., & + rc=STATUS ) + _VERIFY(STATUS) - if(rTime == currTime) then - call ESMF_AlarmRingerOn(STATE%TIME_TO_CLEAR(J), rc=status); _VERIFY(STATUS) + if(rTime == currTime) then + call ESMF_AlarmRingerOn(STATE%TIME_TO_CLEAR(J), rc=status); _VERIFY(STATUS) + end if end if ! Get info from the SRC spec @@ -815,8 +830,10 @@ subroutine ZERO_CLEAR_COUNT(STATE, RC) _VERIFY(STATUS) if (RINGING) then - call ESMF_AlarmRingerOff(STATE%TIME_TO_CLEAR(J), RC=STATUS) - _VERIFY(STATUS) + if(.not.associated(STATE%TIME2CPL_ALARM)) then + call ESMF_AlarmRingerOff(STATE%TIME_TO_CLEAR(J), RC=STATUS) + _VERIFY(STATUS) + end if DIMS = STATE%ACCUM_RANK(J) @@ -914,8 +931,10 @@ subroutine COUPLE(SRC, STATE, RC) if (RINGING) then - call ESMF_AlarmRingerOff(STATE%TIME_TO_COUPLE(J), RC=STATUS) - _VERIFY(STATUS) + if(.not.associated(STATE%TIME2CPL_ALARM)) then + call ESMF_AlarmRingerOff(STATE%TIME_TO_COUPLE(J), RC=STATUS) + _VERIFY(STATUS) + end if call MAPL_VarSpecGet(STATE%DST_SPEC(J), SHORT_NAME=NAME, RC=STATUS) _VERIFY(STATUS) @@ -1103,4 +1122,437 @@ subroutine Finalize(CC, SRC, DST, CLOCK, RC) call write_parallel('STUBBED in CPL finalize') _RETURN(ESMF_SUCCESS) end subroutine Finalize + + subroutine ReadRestart(CC, SRC, DST, CLOCK, RC) + +! !ARGUMENTS: + + type (ESMF_CplComp) :: CC + type (ESMF_State) :: SRC + type (ESMF_State) :: DST + type (ESMF_Clock) :: CLOCK + integer, intent( OUT) :: RC + +!EOPI +! ErrLog Variables + + character(len=ESMF_MAXSTR) :: IAm + character(len=ESMF_MAXSTR) :: COMP_NAME + integer :: STATUS + +! Locals + + type (MAPL_GenericCplState), pointer :: STATE + type (MAPL_GenericCplWrap ) :: WRAP + type(ESMF_VM) :: VM + type(ESMF_Grid) :: grid + type(ESMF_Field) :: field + character(len=ESMF_MAXSTR) :: name + character(len=ESMF_MAXSTR) :: filename + logical :: file_exists + logical :: am_i_root + integer :: unit + integer :: n_vars + integer :: n_count + integer :: n_undefs + integer :: rank + integer :: i + integer :: dims + integer, pointer :: mask(:) => null() + real, allocatable :: buf1(:), buf2(:,:), buf3(:,:,:) + real, pointer :: ptr1(:), ptr2(:,:), ptr3(:,:,:) + +! Begin... + +! Get the target components name and set-up traceback handle. +! ----------------------------------------------------------- + + IAm = "MAPL_GenericCplComReadRestart" + call ESMF_CplCompGet( CC, NAME=COMP_NAME, RC=STATUS ) + _VERIFY(STATUS) + Iam = trim(COMP_NAME) // Iam + +! Retrieve the pointer to the internal state. It comes in a wrapper. +! ------------------------------------------------------------------ + + call ESMF_CplCompGetInternalState ( CC, WRAP, STATUS ) + _VERIFY(STATUS) + + STATE => WRAP%INTERNAL_STATE + + +!ALT remove this line when done + call write_parallel('STUBBED in CPL ReadRestart') +!ALT: Uncomment when done +!strategy +!root tries to open the restart (or inquire) +!if the file is there +! read the restart: +!================== +! call ESMF_CplCompGet(CC, vm=vm, name=name, rc=status) +! _VERIFY(STATUS) + +! filename = trim(name) // '_rst' ! following Andrea's suggestion + + call ESMF_CplCompGet(CC, vm=vm, rc=status) + _VERIFY(STATUS) + filename = trim(state%name) // '_rst' ! following Andrea's suggestion + am_i_root = MAPL_AM_I_ROOT(vm) + if (am_i_root) then + ! check if file exists + inquire(file=filename, exist=file_exists) + end if + + call MAPL_CommsBcast(vm, file_exists, n=1, ROOT=MAPL_Root, rc=status) + _VERIFY(status) + + if (file_exists) then + !ALT: ideally, we should check the monthly alarm: read only when not ringing. + ! read metadata: grid info, number of vars + unit=0 ! just to initialize + if (am_i_root) then + UNIT = GETFILE(filename, rc=status) + _VERIFY(status) + read(unit) n_vars + ASSERT_(size(state%src_spec) == n_vars) + end if + + ! for each var + n_vars = size(state%src_spec) + do i = 1, n_vars + ! varname we can get from query SHORT_NAME in state%src_spec(i) + call MAPL_VarSpecGet(state%src_spec(i), SHORT_NAME=name, rc=status) + _VERIFY(status) + call ESMF_StateGet(SRC, name, field=field, rc=status) + _VERIFY(status) + call ESMF_FieldGet(field, grid=grid, rc=status) + _VERIFY(status) + + rank = state%accum_rank(i) + call ESMF_AttributeGet(field, name='DIMS', value=DIMS, rc=status) + _VERIFY(STATUS) + mask => null() + if (DIMS == MAPL_DimsTileOnly .or. DIMS == MAPL_DimsTileTile) then + call MAPL_TileMaskGet(grid, mask, rc=status) + _VERIFY(STATUS) + end if + ! ALT note: calling a procedure with optional argument, and passing NULL pointer to indicate "absent", needs ifort16 or newer + + if (am_i_root) then + read(unit) n_count + end if + call MAPL_CommsBcast(vm, n_count, n=1, ROOT=MAPL_Root, rc=status) + _VERIFY(status) + state%accum_count(i) = n_count + + if (am_i_root) then + read(unit) n_undefs + end if + call MAPL_CommsBcast(vm, n_undefs, n=1, ROOT=MAPL_Root, rc=status) + _VERIFY(status) + + select case(rank) + case (3) + call ESMF_LocalArrayGet(STATE%ACCUMULATORS(i), & + farrayPtr=ptr3, RC=status) + _VERIFY(status) + + call MAPL_VarRead(unit, grid, ptr3, rc=status) + _VERIFY(STATUS) + if (n_undefs /=0) then + allocate(buf3(size(ptr3,1),size(ptr3,2),size(ptr3,3)), stat=status) + _VERIFY(STATUS) + call MAPL_VarRead(unit, grid, buf3, rc=status) + _VERIFY(STATUS) + if (.not. associated(state%array_count(i)%ptr3c)) then + allocate(state%array_count(i)%ptr3c(size(ptr3,1),size(ptr3,2),size(ptr3,3)), stat=status) + _VERIFY(STATUS) + end if + state%array_count(i)%ptr3c = buf3 + deallocate(buf3) + end if + case (2) + call ESMF_LocalArrayGet(STATE%ACCUMULATORS(i), & + farrayPtr=ptr2, RC=status) + _VERIFY(status) + + call MAPL_VarRead(unit, grid, ptr2, mask=mask, rc=status) + _VERIFY(STATUS) + if (n_undefs /=0) then + allocate(buf2(size(ptr2,1),size(ptr2,2)), stat=status) + _VERIFY(STATUS) + call MAPL_VarRead(unit, grid, buf2, mask=mask, rc=status) + _VERIFY(STATUS) + if (.not. associated(state%array_count(i)%ptr2c)) then + allocate(state%array_count(i)%ptr2c(size(ptr2,1),size(ptr2,2)), stat=status) + _VERIFY(STATUS) + end if + state%array_count(i)%ptr2c = buf2 + deallocate(buf2) + end if + case (1) + call ESMF_LocalArrayGet(STATE%ACCUMULATORS(i), & + farrayPtr=ptr1, RC=status) + _VERIFY(status) + + call MAPL_VarRead(unit, grid, ptr1, mask=mask, rc=status) + _VERIFY(STATUS) + if (n_undefs /=0) then + allocate(buf1(size(ptr1,1)), stat=status) + _VERIFY(STATUS) + call MAPL_VarRead(unit, grid, buf1, mask=mask, rc=status) + _VERIFY(STATUS) + if (.not. associated(state%array_count(i)%ptr1c)) then + allocate(state%array_count(i)%ptr1c(size(ptr1,1)), stat=status) + _VERIFY(STATUS) + end if + state%array_count(i)%ptr1c = buf1 + deallocate(buf1) + end if + case default + ASSERT_(.false.) + end select + if(associated(mask)) deallocate(mask) + end do + + if (am_i_root) call Free_File(unit = UNIT, rc=STATUS) + + else + RC = ESMF_RC_FILE_READ + return + end if + + RETURN_(ESMF_SUCCESS) + end subroutine ReadRestart + + subroutine WriteRestart(CC, SRC, DST, CLOCK, RC) + +! !ARGUMENTS: + + type (ESMF_CplComp) :: CC + type (ESMF_State) :: SRC + type (ESMF_State) :: DST + type (ESMF_Clock) :: CLOCK + integer, intent( OUT) :: RC + +!EOPI +! ErrLog Variables + + character(len=ESMF_MAXSTR) :: IAm + character(len=ESMF_MAXSTR) :: COMP_NAME + integer :: STATUS + +! Locals + + type (MAPL_GenericCplState), pointer :: STATE + type (MAPL_GenericCplWrap ) :: WRAP + type(ESMF_VM) :: VM + type(ESMF_Grid) :: grid + type(ESMF_Field) :: field + character(len=ESMF_MAXSTR) :: name + character(len=ESMF_MAXSTR) :: filename + logical :: am_i_root + logical :: local_undefs + integer :: unit + integer :: n_vars + integer :: n_count + integer :: n_undefs + integer :: rank + integer :: i + integer :: dims + integer :: have_undefs + integer, pointer :: mask(:) => null() + real, allocatable :: buf1(:), buf2(:,:), buf3(:,:,:) + real, pointer :: ptr1(:), ptr2(:,:), ptr3(:,:,:) + +! Begin... + +! Get the target components name and set-up traceback handle. +! ----------------------------------------------------------- + + IAm = "MAPL_GenericCplComWriteRestart" + call ESMF_CplCompGet( CC, NAME=COMP_NAME, RC=STATUS ) + _VERIFY(STATUS) + Iam = trim(COMP_NAME) // Iam + +! Retrieve the pointer to the internal state. It comes in a wrapper. +! ------------------------------------------------------------------ + + call ESMF_CplCompGetInternalState ( CC, WRAP, STATUS ) + _VERIFY(STATUS) + + STATE => WRAP%INTERNAL_STATE + + call ESMF_CplCompGet(CC, vm=vm, rc=status) + _VERIFY(STATUS) + + filename = trim(state%name) // '_chk' ! following Andrea's suggestion + am_i_root = MAPL_AM_I_ROOT(vm) + + unit=0 ! just to initialize + n_vars = size(state%src_spec) + if (am_i_root) then + UNIT = GETFILE(filename, rc=status) + _VERIFY(status) + write(unit) n_vars + end if + + ! for each var + do i = 1, n_vars + ! varname we can get from query SHORT_NAME in state%src_spec(i) + call MAPL_VarSpecGet(state%src_spec(i), SHORT_NAME=name, rc=status) + _VERIFY(status) + call ESMF_StateGet(SRC, name, field=field, rc=status) + _VERIFY(status) + call ESMF_FieldGet(field, grid=grid, rc=status) + _VERIFY(status) + + rank = state%accum_rank(i) + call ESMF_AttributeGet(field, name='DIMS', value=DIMS, rc=status) + _VERIFY(STATUS) + mask => null() + if (DIMS == MAPL_DimsTileOnly .or. DIMS == MAPL_DimsTileTile) then + call MAPL_TileMaskGet(grid, mask, rc=status) + _VERIFY(STATUS) + end if + ! ALT note: calling a procedure with optional argument, and passing NULL pointer to indicate "absent", needs ifort16 or newer + + !we need to get the MAX n_count + call MAPL_CommsAllReduceMax(vm, sendbuf=state%accum_count(i), & + recvbuf=n_count, cnt=1, RC=status) + _VERIFY(status) + if (am_i_root) then + write(unit) n_count + end if + select case (rank) + case(1) + local_undefs = associated(state%array_count(i)%ptr1c) + case(2) + local_undefs = associated(state%array_count(i)%ptr2c) + case(3) + local_undefs = associated(state%array_count(i)%ptr3c) + case default + ASSERT_(.false.) + end select + have_undefs = 0 + n_undefs = 0 + if (local_undefs) have_undefs = 1 + call MAPL_CommsAllReduceMax(vm, sendbuf=have_undefs, & + recvbuf=n_undefs, cnt=1, RC=status) + _VERIFY(status) + if (am_i_root) then + write(unit) n_undefs + end if + + select case(rank) + case (3) + call ESMF_LocalArrayGet(STATE%ACCUMULATORS(i), & + farrayPtr=ptr3, RC=status) + _VERIFY(status) + + call MAPL_VarWrite(unit, grid, ptr3, rc=status) + _VERIFY(STATUS) + if (n_undefs /=0) then + allocate(buf3(size(ptr3,1),size(ptr3,2),size(ptr3,3)), stat=status) + _VERIFY(STATUS) + if (associated(state%array_count(i)%ptr3c)) then + buf3 = state%array_count(i)%ptr3c + else + buf3 = state%accum_count(i) + end if + call MAPL_VarWrite(unit, grid, buf3, rc=status) + _VERIFY(STATUS) + deallocate(buf3) + end if + case (2) + call ESMF_LocalArrayGet(STATE%ACCUMULATORS(i), & + farrayPtr=ptr2, RC=status) + _VERIFY(status) + + call MAPL_VarWrite(unit, grid, ptr2, mask=mask, rc=status) + _VERIFY(STATUS) + if (n_undefs /=0) then + allocate(buf2(size(ptr2,1),size(ptr2,2)), stat=status) + _VERIFY(STATUS) + if (associated(state%array_count(i)%ptr2c)) then + buf2 = state%array_count(i)%ptr2c + else + buf2 = state%accum_count(i) + end if + call MAPL_VarWrite(unit, grid, buf2, mask=mask, rc=status) + _VERIFY(STATUS) + deallocate(buf2) + end if + case (1) + call ESMF_LocalArrayGet(STATE%ACCUMULATORS(i), & + farrayPtr=ptr1, RC=status) + _VERIFY(status) + + call MAPL_VarWrite(unit, grid, ptr1, mask=mask, rc=status) + _VERIFY(STATUS) + if (n_undefs /=0) then + allocate(buf1(size(ptr1,1)), stat=status) + _VERIFY(STATUS) + if (associated(state%array_count(i)%ptr1c)) then + buf1 = state%array_count(i)%ptr1c + else + buf1 = state%accum_count(i) + end if + call MAPL_VarWrite(unit, grid, buf1, mask=mask, rc=status) + _VERIFY(STATUS) + deallocate(buf1) + end if + case default + ASSERT_(.false.) + end select + if(associated(mask)) deallocate(mask) + end do + + if(am_i_root) call Free_File(unit = UNIT, rc=STATUS) + + + RETURN_(ESMF_SUCCESS) + end subroutine WriteRestart + + subroutine MAPL_CplCompSetAlarm ( CC, ALARM, RC ) + type (ESMF_CplComp ), intent(INOUT) :: CC + type (ESMF_Alarm), target, intent(IN ) :: ALARM + integer, optional, intent( OUT) :: RC + +! ErrLog Variables + + character(len=ESMF_MAXSTR) :: IAm + character(len=ESMF_MAXSTR) :: COMP_NAME + integer :: STATUS + +! Locals + + type (MAPL_GenericCplState), pointer :: STATE + type (MAPL_GenericCplWrap ) :: WRAP + + +! Begin... + +! Get this instance's name and set-up traceback handle. +! ----------------------------------------------------- + + call ESMF_CplCompGet( CC, name=COMP_NAME, RC=STATUS ) + _VERIFY(STATUS) + Iam = trim(COMP_NAME) // "MAPL_CplCompSetAlarm" + +! Retrieve the pointer to the internal state. It comes in a wrapper. +! ------------------------------------------------------------------ + + call ESMF_CplCompGetInternalState ( CC, WRAP, STATUS ) + _VERIFY(STATUS) + + STATE => WRAP%INTERNAL_STATE + + if (.not.associated(STATE%TIME2CPL_ALARM)) then + STATE%TIME2CPL_ALARM => ALARM + else + ASSERT_(.false.) + end if + end subroutine MAPL_CplCompSetAlarm + end module MAPL_GenericCplCompMod diff --git a/MAPL_Base/MAPL_HistoryCollection.F90 b/MAPL_Base/MAPL_HistoryCollection.F90 index 519eaf3dc1ff..6a9ef108079a 100644 --- a/MAPL_Base/MAPL_HistoryCollection.F90 +++ b/MAPL_Base/MAPL_HistoryCollection.F90 @@ -66,6 +66,8 @@ module MAPL_HistoryCollectionMod integer :: Psize integer :: tm logical :: ForceOffsetZero + logical :: monthly + logical :: partial = .false. ! Adding Arithemtic Field Rewrite character(len=ESMF_MAXSTR),pointer :: tmpfields(:) => null() logical, pointer :: ReWrite(:) => null() diff --git a/MAPL_Base/MAPL_HistoryGridComp.F90 b/MAPL_Base/MAPL_HistoryGridComp.F90 index 514fc0b74d00..10fbfc9f0cb4 100644 --- a/MAPL_Base/MAPL_HistoryGridComp.F90 +++ b/MAPL_Base/MAPL_HistoryGridComp.F90 @@ -359,6 +359,7 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) logical :: isPresent real :: lvl + integer :: mntly integer :: unitr, unitw integer :: tm,resolution(2) logical :: match, contLine @@ -661,6 +662,8 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) _VERIFY(STATUS) allocate( Vvarn(nlist), stat=STATUS) _VERIFY(STATUS) + allocate(INTSTATE%STAMPOFFSET(nlist), stat=status) + _VERIFY(STATUS) ! We are parsing HISTORY config file to split each collection into separate RC ! ---------------------------------------------------------------------------- @@ -734,6 +737,8 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) list(n)%disabled = .false. end if + list(n)%monthly = .false. + cfg = ESMF_ConfigCreate(rc=STATUS) _VERIFY(STATUS) @@ -753,6 +758,10 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) label=trim(string) // 'descr:' ,rc=status ) _VERIFY(STATUS) + call ESMF_ConfigGetAttribute ( cfg, mntly, default=0, & + label=trim(string) // 'monthly:',rc=status ) + _VERIFY(STATUS) + list(n)%monthly = (mntly /= 0) call ESMF_ConfigGetAttribute ( cfg, list(n)%frequency, default=060000, & label=trim(string) // 'frequency:',rc=status ) _VERIFY(STATUS) @@ -1149,6 +1158,9 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) REF_TIME(4) = list(n)%ref_time/10000 REF_TIME(5) = mod(list(n)%ref_time,10000)/100 REF_TIME(6) = mod(list(n)%ref_time,100) + + !ALT if monthly, modify ref_time(4:6)=0 + if (list(n)%monthly) REF_TIME(4:6) = 0 call ESMF_TimeSet( RefTime, YY = REF_TIME(1), & MM = REF_TIME(2), & @@ -1157,6 +1169,8 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) M = REF_TIME(5), & S = REF_TIME(6), calendar=cal, rc=rc ) + ! ALT if monthly, set interval "Frequncy" to 1 month + ! also in this case sec should be set to non-zero sec = MAPL_nsecf( list(n)%frequency ) call ESMF_TimeIntervalSet( Frequency, S=sec, calendar=cal, rc=status ) ; _VERIFY(STATUS) RingTime = RefTime @@ -1176,11 +1190,21 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) list(n)%his_alarm = ESMF_AlarmCreate( clock=clock, RingInterval=Frequency, RingTime=RingTime, sticky=.false., rc=status ) endif _VERIFY(STATUS) - + + !ALT if monthly overwrite duration and frequency + if (list(n)%monthly) then + list(n)%duration = 1 !ALT simply non-zero + end if if( list(n)%duration.ne.0 ) then - sec = MAPL_nsecf( list(n)%duration ) - call ESMF_TimeIntervalSet( Frequency, S=sec, calendar=cal, rc=status ) ; _VERIFY(STATUS) - RingTime = RefTime + IntState%StampOffset(n) + if (.not.list(n)%monthly) then + sec = MAPL_nsecf( list(n)%duration ) + call ESMF_TimeIntervalSet( Frequency, S=sec, calendar=cal, rc=status ) ; _VERIFY(STATUS) + RingTime = RefTime + else + !ALT keep the values from above + ! and for debugging print + call WRITE_PARALLEL("DEBUG: monthly averaging is active for collection "//trim(list(n)%collection)) + end if if (RingTime < currTime) then RingTime = RingTime + (INT((currTime - RingTime)/frequency)+1)*frequency endif @@ -1190,6 +1214,11 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) list(n)%seg_alarm = ESMF_AlarmCreate( clock=clock, RingInterval=Frequency, RingTime=RingTime, sticky=.false., rc=status ) endif _VERIFY(STATUS) + if (list(n)%monthly .and. (currTime == RingTime)) then + call ESMF_AlarmRingerOn( list(n)%his_alarm,rc=status ) + _VERIFY(STATUS) + end if + else ! this alarm should never ring, but it is checked if ringing list(n)%seg_alarm = ESMF_AlarmCreate( clock=clock, enabled=.false., & @@ -1224,7 +1253,15 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) list(n)%mon_alarm = ESMF_AlarmCreate( clock=clock, RingInterval=Frequency, RingTime=RingTime, sticky=.false., rc=status ) endif _VERIFY(STATUS) - + if(list(n)%monthly) then + !ALT this is temporary workaround. It has a memory leak + ! we need to at least destroy his_alarm before assignment + ! better yet, create it like this one in the first place + call ESMF_AlarmDestroy(list(n)%his_alarm) + list(n)%his_alarm = list(n)%mon_alarm + intState%stampOffset(n) = Frequency ! we go to the beginning of the month + end if + ! End Alarm based on end_date and end_time ! ---------------------------------------- if( list(n)%end_date.ne.-999 .and. list(n)%end_time.ne.-999 ) then @@ -1537,6 +1574,23 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) _ASSERT(.not. errorFound,'needs informative message') + allocate(INTSTATE%AVERAGE (nlist), stat=status) + _VERIFY(STATUS) + + IntState%average = .false. + do n=1, nlist + if (list(n)%disabled) cycle + if(list(n)%mode == "instantaneous" .or. list(n)%ForceOffsetZero) then + sec = 0 + else + IntState%average(n) = .true. + sec = MAPL_nsecf(list(n)%acc_interval) / 2 + if(list(n)%monthly) cycle + endif + call ESMF_TimeIntervalSet( INTSTATE%STAMPOFFSET(n), S=sec, rc=status ) + _VERIFY(STATUS) + end do + nactual = npes if (.not. disableSubVmChecks) then allocate(allPes(npes), stat=status) @@ -2152,13 +2206,13 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) ! create CC if (nactual == npes) then IntState%CCS(n) = ESMF_CplCompCreate ( & - NAME = 'History', & + NAME = list(n)%collection, & contextFlag = ESMF_CONTEXT_PARENT_VM, & RC=STATUS ) _VERIFY(STATUS) else IntState%CCS(n) = ESMF_CplCompCreate ( & - NAME = 'History', & + NAME = list(n)%collection, & petList = list(n)%peAve, & contextFlag = ESMF_CONTEXT_OWN_VM, & RC=STATUS ) @@ -2175,6 +2229,12 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) INTSTATE%DSTS(n)%SPEC,RC=STATUS) _VERIFY(STATUS) + if (list(n)%monthly) then + call MAPL_CplCompSetAlarm(IntState%CCS(n), & + list(n)%his_alarm, RC=STATUS) + _VERIFY(STATUS) + end if + ! CCInitialize call ESMF_CplCompInitialize (INTSTATE%CCS(n), & importState=INTSTATE%CIM(n), & @@ -2182,6 +2242,23 @@ subroutine Initialize ( gc, import, dumexport, clock, rc ) clock=CLOCK, & userRC=STATUS) _VERIFY(STATUS) + + if(list(n)%monthly) then + ! check if alarm is ringing + if (.not. ESMF_AlarmIsRinging ( list(n)%his_alarm )) then + call ESMF_CplCompReadRestart (INTSTATE%CCS(n), & + importState=INTSTATE%CIM(n), & + exportState=INTSTATE%GIM(n), & + clock=CLOCK, & + userRC=STATUS) + if (status == ESMF_RC_FILE_READ) then + list(n)%partial = .true. + STATUS = ESMF_SUCCESS + call WRITE_PARALLEL("DEBUG: no cpl restart found, producing partial month") + end if + _VERIFY(STATUS) + end if + end if end if end do @@ -2893,6 +2970,15 @@ subroutine Run ( gc, import, export, clock, rc ) nymd=nymd, nhms=nhms, stat=status ) ! here is where we get the actual filename of file we will write _VERIFY(STATUS) + if(list(n)%monthly .and. list(n)%partial) then + filename(n)=trim(filename(n)) // '-partial' + list(n)%currentFile = filename(n) + end if + + if( NewSeg) then + list(n)%partial = .false. + endif + if( list(n)%unit.eq.0 ) then if (list(n)%format == 'CFIO') then call list(n)%mNewCFIO%modifyTime(oClients=o_Clients,rc=status) @@ -3099,6 +3185,19 @@ subroutine Finalize ( gc, import, export, clock, rc ) ELSE if( list(n)%unit.ne.0 ) call FREE_FILE( list(n)%unit ) END if + if(list(n)%monthly) then + !ALT need some logic if alarm if not ringing + if (.not. ESMF_AlarmIsRinging ( list(n)%his_alarm )) then + if (.not. list(n)%partial) then + call ESMF_CplCompWriteRestart (INTSTATE%CCS(n), & + importState=INTSTATE%CIM(n), & + exportState=INTSTATE%GIM(n), & + clock=CLOCK, & + userRC=STATUS) + _VERIFY(STATUS) + end if + end if + end if enddo #if 0 From d8a00bd9c0b83b081688ec75a4599e5db690a898 Mon Sep 17 00:00:00 2001 From: Atanas Trayanov Date: Thu, 2 Apr 2020 09:53:34 -0400 Subject: [PATCH 077/109] AT: General clean-up following the review comments. Fixed missing RETURN macro --- MAPL_Base/MAPL_GenericCplComp.F90 | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/MAPL_Base/MAPL_GenericCplComp.F90 b/MAPL_Base/MAPL_GenericCplComp.F90 index 762fd9feef1d..93c34652ad60 100644 --- a/MAPL_Base/MAPL_GenericCplComp.F90 +++ b/MAPL_Base/MAPL_GenericCplComp.F90 @@ -1214,7 +1214,7 @@ subroutine ReadRestart(CC, SRC, DST, CLOCK, RC) UNIT = GETFILE(filename, rc=status) _VERIFY(status) read(unit) n_vars - ASSERT_(size(state%src_spec) == n_vars) + _ASSERT(size(state%src_spec) == n_vars, "Number of variables on the restart does not agree with spec") end if ! for each var @@ -1310,7 +1310,7 @@ subroutine ReadRestart(CC, SRC, DST, CLOCK, RC) deallocate(buf1) end if case default - ASSERT_(.false.) + _ASSERT(.false., "Unsupported rank") end select if(associated(mask)) deallocate(mask) end do @@ -1322,7 +1322,7 @@ subroutine ReadRestart(CC, SRC, DST, CLOCK, RC) return end if - RETURN_(ESMF_SUCCESS) + _RETURN(ESMF_SUCCESS) end subroutine ReadRestart subroutine WriteRestart(CC, SRC, DST, CLOCK, RC) @@ -1415,7 +1415,6 @@ subroutine WriteRestart(CC, SRC, DST, CLOCK, RC) call MAPL_TileMaskGet(grid, mask, rc=status) _VERIFY(STATUS) end if - ! ALT note: calling a procedure with optional argument, and passing NULL pointer to indicate "absent", needs ifort16 or newer !we need to get the MAX n_count call MAPL_CommsAllReduceMax(vm, sendbuf=state%accum_count(i), & @@ -1432,7 +1431,7 @@ subroutine WriteRestart(CC, SRC, DST, CLOCK, RC) case(3) local_undefs = associated(state%array_count(i)%ptr3c) case default - ASSERT_(.false.) + _ASSERT(.false., "Unsupported rank") end select have_undefs = 0 n_undefs = 0 @@ -1503,7 +1502,7 @@ subroutine WriteRestart(CC, SRC, DST, CLOCK, RC) deallocate(buf1) end if case default - ASSERT_(.false.) + _ASSERT(.false.," Unsupported rank") end select if(associated(mask)) deallocate(mask) end do @@ -1511,7 +1510,7 @@ subroutine WriteRestart(CC, SRC, DST, CLOCK, RC) if(am_i_root) call Free_File(unit = UNIT, rc=STATUS) - RETURN_(ESMF_SUCCESS) + _RETURN(ESMF_SUCCESS) end subroutine WriteRestart subroutine MAPL_CplCompSetAlarm ( CC, ALARM, RC ) @@ -1551,8 +1550,9 @@ subroutine MAPL_CplCompSetAlarm ( CC, ALARM, RC ) if (.not.associated(STATE%TIME2CPL_ALARM)) then STATE%TIME2CPL_ALARM => ALARM else - ASSERT_(.false.) + _ASSERT(.false., "Alarm is already associated! Cannot set it again!") end if + _RETURN(ESMF_SUCCESS) end subroutine MAPL_CplCompSetAlarm end module MAPL_GenericCplCompMod From e8783441280bc16c1efc29459f6653dec31a6003 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Thu, 2 Apr 2020 12:53:13 -0400 Subject: [PATCH 078/109] move the finalization of profiler --- MAPL_Base/MAPL_Cap.F90 | 119 +++++++++++++++++++++-------------------- 1 file changed, 61 insertions(+), 58 deletions(-) diff --git a/MAPL_Base/MAPL_Cap.F90 b/MAPL_Base/MAPL_Cap.F90 index ff78ffa41d05..c5aa408c3b5b 100644 --- a/MAPL_Base/MAPL_Cap.F90 +++ b/MAPL_Base/MAPL_Cap.F90 @@ -419,21 +419,13 @@ subroutine run_model(this, mapl_comm, unusable, rc) type (ESMF_VM) :: vm integer :: start_tick, stop_tick, tick_rate integer :: status - +! ! profiler ! - type (ProfileReporter) :: reporter - type (ProfileReporter) :: mem_reporter - integer :: i - character(:), allocatable :: report_lines(:) - type (MultiColumn) :: inclusive - type (MultiColumn) :: exclusive class (BaseProfiler), pointer :: t_p, m_p - integer :: npes, my_rank, rank, ierror _UNUSED_DUMMY(unusable) - t_p => get_global_time_profiler() m_p => get_global_memory_profiler() t_p = TimeProfiler('All') @@ -453,58 +445,14 @@ subroutine run_model(this, mapl_comm, unusable, rc) _VERIFY(status) call this%cap_gc%finalize(rc=status) _VERIFY(status) -!!$ call ESMF_Finalize(rc=status) -!!$ _VERIFY(status) - + call ESMF_Finalize(rc=status) + _VERIFY(status) call stop_timer() - call report_throughput() + call t_p%finalize() call m_p%finalize() - print*,__FILE__,__LINE__,t_p%get_num_meters() - call reporter%add_column(NameColumn(50)) - call reporter%add_column(FormattedTextColumn('#-cycles','(i5.0)', 5, NumCyclesColumn(),separator='-')) - - inclusive = MultiColumn(['Inclusive'], separator='=') - call inclusive%add_column(FormattedTextColumn(' T (sec) ','(f9.3)', 9, InclusiveColumn(), separator='-')) - call inclusive%add_column(FormattedTextColumn(' % ','(f6.2)', 6, PercentageColumn(InclusiveColumn(),'MAX'),separator='-')) - call reporter%add_column(inclusive) - - exclusive = MultiColumn(['Exclusive'], separator='=') - call exclusive%add_column(FormattedTextColumn(' T (sec) ','(f9.3)', 9, ExclusiveColumn(), separator='-')) - call exclusive%add_column(FormattedTextColumn(' % ','(f6.2)', 6, PercentageColumn(ExclusiveColumn()), separator='-')) - call reporter%add_column(exclusive) - -!!$ call reporter%add_column(FormattedTextColumn(' std. dev ','(f12.4)', 12, StdDevColumn())) -!!$ call reporter%add_column(FormattedTextColumn(' rel. dev ','(f12.4)', 12, StdDevColumn(relative=.true.))) -!!$ call reporter%add_column(FormattedTextColumn(' max cyc ','(f12.8)', 12, MaxCycleColumn())) -!!$ call reporter%add_column(FormattedTextColumn(' min cyc ','(f12.8)', 12, MinCycleColumn())) -!!$ call reporter%add_column(FormattedTextColumn(' mean cyc','(f12.8)', 12, MeanCycleColumn())) - call mem_reporter%add_column(NameColumn(50,separator='-')) - call mem_reporter%add_column(MemoryTextColumn(['RSS'],'(i10,1x,a2)',13, InclusiveColumn(),separator='-')) - call mem_reporter%add_column(MemoryTextColumn(['Cyc RSS'],'(i10,1x,a2)',13, MeanCycleColumn(),separator='-')) - -!!$ report_lines = reporter%generate_report(get_global_time_profiler()) - - call MPI_Comm_size(mapl_comm%esmf%comm, npes, ierror) - call MPI_Comm_Rank(mapl_comm%esmf%comm, my_rank, ierror) - - do rank = 0, npes-1 -!!$ if (this%rank == 0) then - if (rank == my_rank) then - report_lines = reporter%generate_report(t_p) - write(*,'(a,1x,i0)')'Report on process: ', rank - do i = 1, size(report_lines) - write(*,'(a)') report_lines(i) - end do - print*,' ' - report_lines = mem_reporter%generate_report(m_p) - do i = 1, size(report_lines) - write(*,'(a)') report_lines(i) - end do - end if - call MPI_Barrier(mapl_comm%esmf%comm, ierror) - end do + call report_profiling() _RETURN(_SUCCESS) contains @@ -538,8 +486,63 @@ subroutine report_throughput(rc) end subroutine report_throughput - end subroutine run_model + subroutine report_profiling(rc) + integer, optional, intent(out) :: rc + type (ProfileReporter) :: reporter + type (ProfileReporter) :: mem_reporter + integer :: i + character(:), allocatable :: report_lines(:) + type (MultiColumn) :: inclusive + type (MultiColumn) :: exclusive + integer :: npes, my_rank, rank, ierror + + call reporter%add_column(NameColumn(50)) + call reporter%add_column(FormattedTextColumn('#-cycles','(i5.0)', 5, NumCyclesColumn(),separator='-')) + + inclusive = MultiColumn(['Inclusive'], separator='=') + call inclusive%add_column(FormattedTextColumn(' T (sec) ','(f9.3)', 9, InclusiveColumn(), separator='-')) + call inclusive%add_column(FormattedTextColumn(' % ','(f6.2)', 6, PercentageColumn(InclusiveColumn(),'MAX'),separator='-')) + call reporter%add_column(inclusive) + + exclusive = MultiColumn(['Exclusive'], separator='=') + call exclusive%add_column(FormattedTextColumn(' T (sec) ','(f9.3)', 9, ExclusiveColumn(), separator='-')) + call exclusive%add_column(FormattedTextColumn(' % ','(f6.2)', 6, PercentageColumn(ExclusiveColumn()), separator='-')) + call reporter%add_column(exclusive) + +!!$ call reporter%add_column(FormattedTextColumn(' std. dev ','(f12.4)', 12, StdDevColumn())) +!!$ call reporter%add_column(FormattedTextColumn(' rel. dev ','(f12.4)', 12, StdDevColumn(relative=.true.))) +!!$ call reporter%add_column(FormattedTextColumn(' max cyc ','(f12.8)', 12, MaxCycleColumn())) +!!$ call reporter%add_column(FormattedTextColumn(' min cyc ','(f12.8)', 12, MinCycleColumn())) +!!$ call reporter%add_column(FormattedTextColumn(' mean cyc','(f12.8)', 12, MeanCycleColumn())) + call mem_reporter%add_column(NameColumn(50,separator='-')) + call mem_reporter%add_column(MemoryTextColumn(['RSS'],'(i10,1x,a2)',13, InclusiveColumn(),separator='-')) + call mem_reporter%add_column(MemoryTextColumn(['Cyc RSS'],'(i10,1x,a2)',13, MeanCycleColumn(),separator='-')) + +!!$ report_lines = reporter%generate_report(get_global_time_profiler()) + + call MPI_Comm_size(mapl_comm%esmf%comm, npes, ierror) + call MPI_Comm_Rank(mapl_comm%esmf%comm, my_rank, ierror) + + do rank = 0, npes-1 +!!$ if (this%rank == 0) then + if (rank == my_rank) then + report_lines = reporter%generate_report(t_p) + write(*,'(a,1x,i0)')'Report on process: ', rank + do i = 1, size(report_lines) + write(*,'(a)') report_lines(i) + end do + print*,' ' + report_lines = mem_reporter%generate_report(m_p) + do i = 1, size(report_lines) + write(*,'(a)') report_lines(i) + end do + end if + call MPI_Barrier(mapl_comm%esmf%comm, ierror) + end do + + end subroutine report_profiling + end subroutine run_model subroutine initialize_cap_gc(this, mapl_comm) class(MAPL_Cap), intent(inout) :: this From fc503e454aca3c4cd93f90be8e783cd237ff4fb3 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 6 Apr 2020 15:34:44 -0400 Subject: [PATCH 079/109] Add github actions, update components.yaml This PR does a few things: 1. Adds a configuration to use Github Actions in a thought to perhaps removing CircleCI at some point 2. Update CircleCI to use `--output-on-failure` 3. Update `components.yaml` to match that in GEOSgcm --- .circleci/config.yml | 4 +-- .github/workflows/workflow.yml | 49 ++++++++++++++++++++++++++++++++++ components.yaml | 16 +++++------ 3 files changed, 59 insertions(+), 10 deletions(-) create mode 100644 .github/workflows/workflow.yml diff --git a/.circleci/config.yml b/.circleci/config.yml index ffb2e2377071..48e8b101b43e 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -40,13 +40,13 @@ jobs: command: | cd build make -j2 pFIO_tests - ctest -R 'pFIO_tests$' || ctest -R 'pFIO_tests$' -VV + ctest -R 'pFIO_tests$' --output-on-failure - run: name: Run MAPL_Base Unit tests command: | cd build make -j2 MAPL_Base_tests - ctest -R 'MAPL_Base_tests$' || ctest -R 'MAPL_Base_tests$' -VV + ctest -R 'MAPL_Base_tests$' --output-on-failure workflows: version: 2.1 diff --git a/.github/workflows/workflow.yml b/.github/workflows/workflow.yml new file mode 100644 index 000000000000..2ba6b8a0b7d6 --- /dev/null +++ b/.github/workflows/workflow.yml @@ -0,0 +1,49 @@ +name: Build MAPL + +on: pull_request + +jobs: + build_mapl: + runs-on: ubuntu-latest + container: gmao/geos-build-env-gcc-source:6.0.4 + env: + LANGUAGE: en_US.UTF-8 + LC_ALL: en_US.UTF-8 + LANG: en_US.UTF-8 + LC_TYPE: en_US.UTF-8 + OMPI_ALLOW_RUN_AS_ROOT: 1 + OMPI_ALLOW_RUN_AS_ROOT_CONFIRM: 1 + OMPI_MCA_btl_vader_single_copy_mechanism: none + steps: + - uses: actions/checkout@v2 + with: + fetch-depth: 1 + - name: Versions etc. + run: | + gfortran --version + mpirun --version + echo $BASEDIR + - name: Mepo clone external repos + run: | + mepo init + mepo clone + mepo status + - name: CMake + run: | + mkdir build + cd build + cmake .. -DBASEDIR=$BASEDIR/Linux -DCMAKE_Fortran_COMPILER=gfortran -DCMAKE_BUILD_TYPE=Debug + - name: Build + run: | + cd build + make -j4 install + - name: Run pFIO Unit tests + run: | + cd build + make -j4 pFIO_tests + ctest -R 'pFIO_tests$' --output-on-failure + - name: Run MAPL_Base Unit tests + run: | + cd build + make -j4 MAPL_Base_tests + ctest -R 'MAPL_Base_tests$' --output-on-failure diff --git a/components.yaml b/components.yaml index 569fd2cf9b0b..4a839178e840 100644 --- a/components.yaml +++ b/components.yaml @@ -1,16 +1,16 @@ -ESMA_env: +env: local: ./@env - remote: git@github.com:GEOS-ESM/ESMA_env.git - tag: v2.0.2 + remote: ../ESMA_env.git + tag: v2.0.4 develop: master -ESMA_cmake: +cmake: local: ./@cmake - remote: git@github.com:GEOS-ESM/ESMA_cmake.git - tag: v2.1.2 + remote: ../ESMA_cmake.git + tag: v2.2.1 develop: develop ecbuild: local: ./@cmake/@ecbuild - remote: git@github.com:GEOS-ESM/ecbuild.git - tag: geos/v1.0.0 + remote: ../ecbuild.git + tag: geos/v1.0.1 From 36e42028481eaca146564b1826d4b868d644244e Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Mon, 6 Apr 2020 15:58:41 -0400 Subject: [PATCH 080/109] Update CHANGELOG --- CHANGELOG.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 6521946152de..08288d087290 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -18,6 +18,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Add directories to `.gitignore` for building with `mepo` - Bug building with mixed Intel/GCC compilers - Set correct ESMA_env tag in `components.yaml` +- Updated `components.yaml` to be inline with GEOSgcm ### Removed @@ -27,7 +28,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Added -- Added configuration for CircleCI +- Added configuration for CircleCI and Github Actions - Builds MAPL using GCC 9.2.0 and Open MPI 4.0.2 - Builds and runs `pFIO_tests` and `MAPL_Base_tests` - Imported Python/MAPL subdir (old, but never imported to GitHub) From 09e096137d0ef1b5b193b0ed8ce9955151d86ed2 Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Tue, 7 Apr 2020 10:49:54 -0400 Subject: [PATCH 081/109] Fixes #276 - better messages for typos in rc file - History now reports the field name or bundle name requested if not found. # This is the commit message #2: --- CHANGELOG.md | 1 + GMAO_pFIO/CMakeLists.txt | 2 +- MAPL_Base/MAPL_HistoryGridComp.F90 | 5 +++-- 3 files changed, 5 insertions(+), 3 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 08288d087290..a72d3daa8881 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,6 +11,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Corrected handling of Equation of Time in orbit (off by default) - Made ASSERT in ExtData more explicit in case of missing variables. +- Improved diagnostic message in HistoryGridComp for misspelled fields/bundles ### Fixed diff --git a/GMAO_pFIO/CMakeLists.txt b/GMAO_pFIO/CMakeLists.txt index e1c9d34fd20e..9ac4da334672 100644 --- a/GMAO_pFIO/CMakeLists.txt +++ b/GMAO_pFIO/CMakeLists.txt @@ -93,7 +93,7 @@ target_link_libraries (${this} PUBLIC gftl gftl-shared set_target_properties (${this} PROPERTIES Fortran_MODULE_DIRECTORY ${include_${this}}) # Kludge for OSX security and DYLD_LIBRARY_PATH ... foreach(dir ${OSX_EXTRA_LIBRARY_PATH}) - target_link_libraries(${this} "-Xlinker -rpath -Xlinker ${dir}") + target_link_libraries(${this} PRIVATE "-Xlinker -rpath -Xlinker ${dir}") endforeach() diff --git a/MAPL_Base/MAPL_HistoryGridComp.F90 b/MAPL_Base/MAPL_HistoryGridComp.F90 index b040aebaa864..298ebb919cd7 100644 --- a/MAPL_Base/MAPL_HistoryGridComp.F90 +++ b/MAPL_Base/MAPL_HistoryGridComp.F90 @@ -4599,11 +4599,12 @@ subroutine MAPL_StateGet(state,name,field,rc) bundlename = name(:i-1) fieldname = name(i+1:) call ESMF_StateGet(state,trim(bundlename),bundle,rc=status) - _VERIFY(STATUS) + _ASSERT(status==ESMF_SUCCESS,'Bundle '//trim(bundlename)//' not found') call ESMF_FieldBundleGet(bundle,trim(fieldname),field=field,rc=status) - _VERIFY(STATUS) + _ASSERT(status==ESMF_SUCCESS,'Field '//trim(fieldname)//' not found') else call ESMF_StateGet(state,trim(name),field,rc=status) + _ASSERT(status==ESMF_SUCCESS,'Field '//trim(name)//' not found') _VERIFY(STATUS) end if From 7761684ac6054ef510624ed1eb7724490299961a Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Tue, 7 Apr 2020 12:35:52 -0400 Subject: [PATCH 082/109] bug fix and more timers --- MAPL_Base/MAPL_Cap.F90 | 8 +- MAPL_Base/MAPL_Generic.F90 | 160 +++++++++++++++----------- MAPL_Profiler/BaseProfiler.F90 | 18 ++- MAPL_Profiler/DistributedMeter.F90 | 4 +- MAPL_Profiler/DistributedProfiler.F90 | 4 +- MAPL_Profiler/MemoryProfiler.F90 | 6 +- MAPL_Profiler/TimeProfiler.F90 | 6 +- 7 files changed, 127 insertions(+), 79 deletions(-) diff --git a/MAPL_Base/MAPL_Cap.F90 b/MAPL_Base/MAPL_Cap.F90 index c5aa408c3b5b..12814a9bb0c9 100644 --- a/MAPL_Base/MAPL_Cap.F90 +++ b/MAPL_Base/MAPL_Cap.F90 @@ -428,8 +428,8 @@ subroutine run_model(this, mapl_comm, unusable, rc) t_p => get_global_time_profiler() m_p => get_global_memory_profiler() - t_p = TimeProfiler('All') - m_p = MemoryProfiler('All') + t_p = TimeProfiler('All', comm_world = mapl_comm%esmf%comm) + m_p = MemoryProfiler('All', comm_world = mapl_comm%esmf%comm) call start_timer() call ESMF_Initialize (vm=vm, logKindFlag=this%cap_options%esmf_logging_mode, mpiCommunicator=mapl_comm%esmf%comm, rc=status) @@ -446,8 +446,8 @@ subroutine run_model(this, mapl_comm, unusable, rc) call this%cap_gc%finalize(rc=status) _VERIFY(status) - call ESMF_Finalize(rc=status) - _VERIFY(status) + !call ESMF_Finalize(rc=status) + !_VERIFY(status) call stop_timer() call t_p%finalize() diff --git a/MAPL_Base/MAPL_Generic.F90 b/MAPL_Base/MAPL_Generic.F90 index 86bd4db3a53b..91798d4201f3 100644 --- a/MAPL_Base/MAPL_Generic.F90 +++ b/MAPL_Base/MAPL_Generic.F90 @@ -528,6 +528,7 @@ recursive subroutine MAPL_GenericSetServices ( GC, RC ) type (MAPL_VarSpecPtr), pointer :: ImSpecPtr(:) type (MAPL_VarSpecPtr), pointer :: ExSpecPtr(:) type(ESMF_GridComp) :: rootGC +integer :: comm !============================================================================= @@ -550,6 +551,11 @@ recursive subroutine MAPL_GenericSetServices ( GC, RC ) MAPLOBJ%COMPNAME = COMP_NAME + call ESMF_VmGet(VM, mpicommunicator=comm, rc=status) + _VERIFY(STATUS) + + MAPLOBJ%t_profiler = TimeProfiler(trim(COMP_NAME), comm_world = comm ) + MAPLOBJ%m_profiler = MemoryProfiler(trim(COMP_NAME), comm_world = comm) ! Set the Component's Total timer ! ------------------------------- @@ -923,6 +929,8 @@ recursive subroutine MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, RC ) call m_p%start(trim(state%compname)) call state%t_profiler%start('Initialize') call state%m_profiler%start('Initialize') + call state%t_profiler%start('InitializeMine') + call state%m_profiler%start('InitializeMine') call MAPL_GenericStateClockOn(STATE,"TOTAL") call MAPL_GenericStateClockOn(STATE,"GenInitTot") @@ -1449,6 +1457,8 @@ recursive subroutine MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, RC ) end if end if call MAPL_GenericStateClockOff(STATE,"--GenInitMine") + call state%m_profiler%stop('InitializeMine') + call state%t_profiler%stop('InitializeMine') ! Initialize the children ! ----------------------- @@ -1524,6 +1534,8 @@ recursive subroutine MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, RC ) enddo endif call MAPL_GenericStateClockOn(STATE,"--GenInitMine") + call state%t_profiler%start('InitializeMine') + call state%m_profiler%start('InitializeMine') ! Create import and initialize state variables ! -------------------------------------------- @@ -1670,7 +1682,9 @@ recursive subroutine MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, RC ) _VERIFY(STATUS) end if - call MAPL_GenericStateClockOff(STATE,"--GenInitMine") + call MAPL_GenericStateClockOff(STATE,"--GenInitMine") + call state%m_profiler%stop('InitializeMine') + call state%t_profiler%stop('InitializeMine') if (.not. associated(STATE%parentGC)) then call MAPL_AdjustIsNeeded(GC, EXPORT, RC=STATUS) @@ -1768,18 +1782,21 @@ subroutine MAPL_GenericWrapper ( GC, IMPORT, EXPORT, CLOCK, RC) t_p => get_global_time_profiler() m_p => get_global_memory_profiler() - if (phase > 1) then - write(char_phase,'(i1)')phase - call t_p%start(trim(state%compname)//'_'//char_phase) - call m_p%start(trim(state%compname)//'_'//char_phase) - call state%t_profiler%start('Run'//char_phase) - call state%m_profiler%start('Run'//char_phase) - else - call t_p%start(trim(state%compname)) - call m_p%start(trim(state%compname)) - call state%t_profiler%start('Run') - call state%m_profiler%start('Run') - end if + + if ( method == ESMF_METHOD_RUN ) then + if (phase > 1) then + write(char_phase,'(i1)')phase + call t_p%start(trim(state%compname)//'_'//char_phase) + call m_p%start(trim(state%compname)//'_'//char_phase) + call state%t_profiler%start('Run'//char_phase) + call state%m_profiler%start('Run'//char_phase) + else + call t_p%start(trim(state%compname)) + call m_p%start(trim(state%compname)) + call state%t_profiler%start('Run') + call state%m_profiler%start('Run') + end if + endif MethodBlock: if (method == ESMF_METHOD_RUN) then func_ptr => ESMF_GridCompRun @@ -1820,13 +1837,13 @@ subroutine MAPL_GenericWrapper ( GC, IMPORT, EXPORT, CLOCK, RC) ! Method itself ! ---------- - #ifdef DEBUG IF (mapl_am_i_root(vm)) then print *,'DBG: running ', sbrtn, ' phase ',phase,' of ',trim(COMP_NAME) end IF #endif + call func_ptr (GC, & importState=IMPORT, & exportState=EXPORT, & @@ -1841,17 +1858,19 @@ subroutine MAPL_GenericWrapper ( GC, IMPORT, EXPORT, CLOCK, RC) end do end if - if (phase > 1) then - call state%m_profiler%stop('Run'//char_phase) - call state%t_profiler%stop('Run'//char_phase) - call m_p%stop(trim(state%compname)//'_'//char_phase) - call t_p%stop(trim(state%compname)//'_'//char_phase) - else - call state%m_profiler%stop('Run') - call state%t_profiler%stop('Run') - call m_p%stop(trim(state%compname)) - call t_p%stop(trim(state%compname)) - end if + if ( method == ESMF_METHOD_RUN ) then + if (phase > 1) then + call state%m_profiler%stop('Run'//char_phase) + call state%t_profiler%stop('Run'//char_phase) + call m_p%stop(trim(state%compname)//'_'//char_phase) + call t_p%stop(trim(state%compname)//'_'//char_phase) + else + call state%m_profiler%stop('Run') + call state%t_profiler%stop('Run') + call m_p%stop(trim(state%compname)) + call t_p%stop(trim(state%compname)) + end if + endif _RETURN(ESMF_SUCCESS) @@ -2179,21 +2198,46 @@ recursive subroutine MAPL_GenericFinalize ( GC, IMPORT, EXPORT, CLOCK, RC ) call state%m_profiler%stop('Final') call state%t_profiler%stop('Final') - call state%m_profiler%finalize() - call state%t_profiler%finalize() + !call state%m_profiler%finalize() + !call state%t_profiler%finalize() if (.not. MAPL_ProfIsDisabled()) then - block - character(:), allocatable :: report(:) - type (ProfileReporter) :: reporter, mem_reporter - type (MultiColumn) :: inclusive, exclusive - type (ESMF_VM) :: vm + call report_generic_profile() - call ESMF_VmGetCurrent(vm, rc=status) - _VERIFY(STATUS) - if (MAPL_AM_I_Root(vm)) then + !call WRITE_PARALLEL(" ") + !call WRITE_PARALLEL(" Times for "//trim(COMP_NAME)) + + !call MAPL_ProfWrite(STATE%TIMES,RC=STATUS) + !_VERIFY(STATUS) + + !call WRITE_PARALLEL(" ") + end if + + call m_p%stop(trim(state%compname)) + call t_p%stop(trim(state%compname)) + +! Clean-up +!--------- +!ALT + call MAPL_GenericStateDestroy (STATE, RC=STATUS) + _VERIFY(STATUS) + + _RETURN(ESMF_SUCCESS) +contains + + subroutine report_generic_profile( rc ) + integer, optional, intent( out) :: RC ! Error code: + character(:), allocatable :: report(:) + type (ProfileReporter) :: reporter, mem_reporter + type (MultiColumn) :: inclusive, exclusive + type (ESMF_VM) :: vm + + call ESMF_VmGetCurrent(vm, rc=status) + _VERIFY(STATUS) + + if (MAPL_AM_I_Root(vm)) then call mem_reporter%add_column(NameColumn(50,separator='-')) call mem_reporter%add_column(MemoryTextColumn(['RSS'],'(i10,1x,a2)', 13, InclusiveColumn(),separator='-')) call mem_reporter%add_column(MemoryTextColumn(['Cyc RSS'],'(i10,1x,a2)', 13, MeanCycleColumn(),separator='-')) @@ -2224,32 +2268,11 @@ recursive subroutine MAPL_GenericFinalize ( GC, IMPORT, EXPORT, CLOCK, RC ) write(OUTPUT_UNIT,'(a)')report(i) end do write(OUTPUT_UNIT,*)'' - end if - end block - - call WRITE_PARALLEL(" ") - call WRITE_PARALLEL(" Times for "//trim(COMP_NAME)) - - call MAPL_ProfWrite(STATE%TIMES,RC=STATUS) - _VERIFY(STATUS) - - call WRITE_PARALLEL(" ") - end if - - call m_p%stop(trim(state%compname)) - call t_p%stop(trim(state%compname)) - -! Clean-up -!--------- -!ALT - call MAPL_GenericStateDestroy (STATE, RC=STATUS) - _VERIFY(STATUS) -! call ESMF_StateDestroy (IMPORT, RC=STATUS) -! _VERIFY(STATUS) -! call ESMF_StateDestroy (EXPORT, RC=STATUS) -! _VERIFY(STATUS) - - _RETURN(ESMF_SUCCESS) + end if + + _RETURN(ESMF_SUCCESS) + end subroutine report_generic_profile + end subroutine MAPL_GenericFinalize @@ -2313,6 +2336,7 @@ recursive subroutine MAPL_GenericRecord ( GC, IMPORT, EXPORT, CLOCK, RC ) call state%t_profiler%start('Record') call state%m_profiler%start('Record') + call MAPL_GenericStateClockOn(STATE,"TOTAL") call MAPL_GenericStateClockOn(STATE,"GenRecordTot") ! Record the children @@ -2334,6 +2358,9 @@ recursive subroutine MAPL_GenericRecord ( GC, IMPORT, EXPORT, CLOCK, RC ) ! Do my "own" record ! ------------------ call MAPL_GenericStateClockOn(STATE,"--GenRecordMine") + call state%t_profiler%start('RecordMine') + call state%m_profiler%start('RecordMine') + if (associated(STATE%RECORD)) then FILETYPE = MAPL_Write2Disk @@ -2400,6 +2427,8 @@ recursive subroutine MAPL_GenericRecord ( GC, IMPORT, EXPORT, CLOCK, RC ) END DO endif call MAPL_GenericStateClockOff(STATE,"--GenRecordMine") + call state%m_profiler%stop('RecordMine') + call state%t_profiler%stop('RecordMine') call MAPL_GenericStateClockOff(STATE,"GenRecordTot") call MAPL_GenericStateClockOff(STATE,"TOTAL") @@ -2557,6 +2586,9 @@ recursive subroutine MAPL_GenericRefresh ( GC, IMPORT, EXPORT, CLOCK, RC ) ! Do my "own" refresh ! ------------------ call MAPL_GenericStateClockOn(STATE,"--GenRefreshMine") + call state%t_profiler%start('RefreshMine') + call state%m_profiler%start('RefreshMine') + if (associated(STATE%RECORD)) then ! add timestamp to filename @@ -2614,6 +2646,8 @@ recursive subroutine MAPL_GenericRefresh ( GC, IMPORT, EXPORT, CLOCK, RC ) _VERIFY(STATUS) endif call MAPL_GenericStateClockOff(STATE,"--GenRefreshMine") + call state%m_profiler%stop('RefreshMine') + call state%t_profiler%stop('RefreshMine') call MAPL_GenericStateClockOff(STATE,"GenRefreshTot") call MAPL_GenericStateClockOff(STATE,"TOTAL") @@ -4950,14 +4984,10 @@ subroutine MAPL_GenericStateClockAdd(GC, NAME, RC) call MAPL_ProfSet(STATE%TIMES,NAME=NAME,RC=STATUS) _VERIFY(STATUS) - state%t_profiler = TimeProfiler(trim(state%compname)) - state%m_profiler = MemoryProfiler(trim(state%compname)) - _RETURN(ESMF_SUCCESS) end subroutine MAPL_GenericStateClockAdd - !============================================================================= !============================================================================= !============================================================================= diff --git a/MAPL_Profiler/BaseProfiler.F90 b/MAPL_Profiler/BaseProfiler.F90 index 5fd9e934b591..6c3ab52ac0f3 100644 --- a/MAPL_Profiler/BaseProfiler.F90 +++ b/MAPL_Profiler/BaseProfiler.F90 @@ -21,6 +21,7 @@ module MAPL_BaseProfiler type(MeterNode) :: node type(MeterNodeStack) :: stack integer :: status = 0 + integer :: comm_world contains procedure :: start_name procedure :: stop_name @@ -49,6 +50,7 @@ module MAPL_BaseProfiler procedure :: begin procedure :: end procedure :: get_depth + procedure :: set_comm_world end type BaseProfiler @@ -145,7 +147,7 @@ subroutine stop_name(this, name) block use MPI integer :: rank, ierror - call MPI_Comm_rank(MPI_COMM_WORLD, rank, ierror) + call MPI_Comm_rank(this%comm_world, rank, ierror) if (rank == 0) then print*,__FILE__,__LINE__,'stop called on non-bottom timer'//name end if @@ -186,6 +188,7 @@ subroutine copy_profiler(new, old) character(:), pointer :: name new%node = old%node + new%comm_world = old%comm_world subnode => new%node ! Stack always starts with root node of node @@ -336,6 +339,19 @@ integer function get_depth(this) result(depth) depth = this%stack%size() end function get_depth + subroutine set_comm_world(this, comm_world) + use MPI + class(BaseProfiler), intent(inout) :: this + integer, optional, intent(in) :: comm_world + integer :: status + + if(present(comm_world)) then + call MPI_Comm_dup(comm_world, this%comm_world, status) + else + this%comm_world = MPI_COMM_WORLD + endif + end subroutine set_comm_world + end module MAPL_BaseProfiler diff --git a/MAPL_Profiler/DistributedMeter.F90 b/MAPL_Profiler/DistributedMeter.F90 index b4ca9d82c423..252b0b20dddb 100644 --- a/MAPL_Profiler/DistributedMeter.F90 +++ b/MAPL_Profiler/DistributedMeter.F90 @@ -54,9 +54,9 @@ module MAPL_DistributedMeter private type(DistributedStatistics) :: statistics contains - procedure :: reduce_global + !procedure :: reduce_global procedure :: reduce_mpi - generic :: reduce => reduce_global, reduce_mpi + generic :: reduce => reduce_mpi !,reduce_global procedure :: get_statistics procedure :: get_stats_total diff --git a/MAPL_Profiler/DistributedProfiler.F90 b/MAPL_Profiler/DistributedProfiler.F90 index 67e414d484bd..aae4448c66b7 100644 --- a/MAPL_Profiler/DistributedProfiler.F90 +++ b/MAPL_Profiler/DistributedProfiler.F90 @@ -31,15 +31,17 @@ module MAPL_DistributedProfiler contains - function new_DistributedProfiler(name, gauge, comm) result(distributed_profiler) + function new_DistributedProfiler(name, gauge, comm, comm_world) result(distributed_profiler) type(DistributedProfiler), target :: distributed_profiler character(*), intent(in) :: name class(AbstractGauge), intent(in) :: gauge integer, intent(in) :: comm + integer, optional, intent(in) :: comm_world distributed_profiler%gauge = gauge distributed_profiler%comm = comm + call distributed_profiler%set_comm_world(comm_world = comm_world) call distributed_profiler%set_node(MeterNode(name, distributed_profiler%make_meter())) call distributed_profiler%start() diff --git a/MAPL_Profiler/MemoryProfiler.F90 b/MAPL_Profiler/MemoryProfiler.F90 index 57bad67e272c..1607c1eee3d0 100644 --- a/MAPL_Profiler/MemoryProfiler.F90 +++ b/MAPL_Profiler/MemoryProfiler.F90 @@ -31,12 +31,12 @@ module MAPL_MemoryProfiler_private contains - function new_MemoryProfiler(name) result(prof) + function new_MemoryProfiler(name, comm_world) result(prof) type(MemoryProfiler), target :: prof character(*), intent(in) :: name + integer, optional, intent(in) :: comm_world - class(AbstractMeter), pointer :: t - + call prof%set_comm_world(comm_world = comm_world) call prof%set_node(MeterNode(name, prof%make_meter())) call prof%start() diff --git a/MAPL_Profiler/TimeProfiler.F90 b/MAPL_Profiler/TimeProfiler.F90 index d791abcff9c6..bebb399a9d29 100644 --- a/MAPL_Profiler/TimeProfiler.F90 +++ b/MAPL_Profiler/TimeProfiler.F90 @@ -29,12 +29,12 @@ module MAPL_TimeProfiler_private contains - function new_TimeProfiler(name) result(prof) + function new_TimeProfiler(name, comm_world) result(prof) type(TimeProfiler), target :: prof character(*), intent(in) :: name + integer, optional,intent(in) :: comm_world - class(AbstractMeter), pointer :: t - + call prof%set_comm_world(comm_world = comm_world) call prof%set_node(MeterNode(name, prof%make_meter())) call prof%start() From 9c3e1131a7a7dc9247f5857cc01efb453f61a34b Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Tue, 7 Apr 2020 13:32:01 -0400 Subject: [PATCH 083/109] test old and new profiling --- MAPL_Base/MAPL_Cap.F90 | 1 + MAPL_Base/MAPL_Generic.F90 | 4 ++-- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/MAPL_Base/MAPL_Cap.F90 b/MAPL_Base/MAPL_Cap.F90 index 12814a9bb0c9..8e167d4a5cec 100644 --- a/MAPL_Base/MAPL_Cap.F90 +++ b/MAPL_Base/MAPL_Cap.F90 @@ -452,6 +452,7 @@ subroutine run_model(this, mapl_comm, unusable, rc) call t_p%finalize() call m_p%finalize() + !call report_throughput() call report_profiling() _RETURN(_SUCCESS) diff --git a/MAPL_Base/MAPL_Generic.F90 b/MAPL_Base/MAPL_Generic.F90 index 91798d4201f3..9e254fb23e56 100644 --- a/MAPL_Base/MAPL_Generic.F90 +++ b/MAPL_Base/MAPL_Generic.F90 @@ -2198,8 +2198,8 @@ recursive subroutine MAPL_GenericFinalize ( GC, IMPORT, EXPORT, CLOCK, RC ) call state%m_profiler%stop('Final') call state%t_profiler%stop('Final') - !call state%m_profiler%finalize() - !call state%t_profiler%finalize() + call state%m_profiler%finalize() + call state%t_profiler%finalize() if (.not. MAPL_ProfIsDisabled()) then From 63283f3ca5f198d08af69fe7656ea67e22f6041a Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Wed, 8 Apr 2020 08:35:59 -0400 Subject: [PATCH 084/109] remove memory profiler and add demo --- MAPL_Base/MAPL_Cap.F90 | 26 ++--- MAPL_Base/MAPL_CapGridComp.F90 | 15 +-- MAPL_Base/MAPL_Generic.F90 | 63 +---------- MAPL_Profiler/CMakeLists.txt | 1 + MAPL_Profiler/demo/CMakeLists.txt | 7 ++ MAPL_Profiler/demo/demo.F90 | 133 ++++++++++++++++++++++ MAPL_Profiler/demo/mpi_demo.F90 | 182 ++++++++++++++++++++++++++++++ 7 files changed, 339 insertions(+), 88 deletions(-) create mode 100644 MAPL_Profiler/demo/CMakeLists.txt create mode 100644 MAPL_Profiler/demo/demo.F90 create mode 100644 MAPL_Profiler/demo/mpi_demo.F90 diff --git a/MAPL_Base/MAPL_Cap.F90 b/MAPL_Base/MAPL_Cap.F90 index 8e167d4a5cec..c261f4bdd333 100644 --- a/MAPL_Base/MAPL_Cap.F90 +++ b/MAPL_Base/MAPL_Cap.F90 @@ -422,14 +422,12 @@ subroutine run_model(this, mapl_comm, unusable, rc) ! ! profiler ! - class (BaseProfiler), pointer :: t_p, m_p + class (BaseProfiler), pointer :: t_p _UNUSED_DUMMY(unusable) t_p => get_global_time_profiler() - m_p => get_global_memory_profiler() t_p = TimeProfiler('All', comm_world = mapl_comm%esmf%comm) - m_p = MemoryProfiler('All', comm_world = mapl_comm%esmf%comm) call start_timer() call ESMF_Initialize (vm=vm, logKindFlag=this%cap_options%esmf_logging_mode, mpiCommunicator=mapl_comm%esmf%comm, rc=status) @@ -451,7 +449,6 @@ subroutine run_model(this, mapl_comm, unusable, rc) call stop_timer() call t_p%finalize() - call m_p%finalize() !call report_throughput() call report_profiling() @@ -490,7 +487,6 @@ end subroutine report_throughput subroutine report_profiling(rc) integer, optional, intent(out) :: rc type (ProfileReporter) :: reporter - type (ProfileReporter) :: mem_reporter integer :: i character(:), allocatable :: report_lines(:) type (MultiColumn) :: inclusive @@ -515,31 +511,23 @@ subroutine report_profiling(rc) !!$ call reporter%add_column(FormattedTextColumn(' max cyc ','(f12.8)', 12, MaxCycleColumn())) !!$ call reporter%add_column(FormattedTextColumn(' min cyc ','(f12.8)', 12, MinCycleColumn())) !!$ call reporter%add_column(FormattedTextColumn(' mean cyc','(f12.8)', 12, MeanCycleColumn())) - call mem_reporter%add_column(NameColumn(50,separator='-')) - call mem_reporter%add_column(MemoryTextColumn(['RSS'],'(i10,1x,a2)',13, InclusiveColumn(),separator='-')) - call mem_reporter%add_column(MemoryTextColumn(['Cyc RSS'],'(i10,1x,a2)',13, MeanCycleColumn(),separator='-')) +!!$ call mem_reporter%add_column(NameColumn(50,separator='-')) +!!$ call mem_reporter%add_column(MemoryTextColumn(['RSS'],'(i10,1x,a2)',13, InclusiveColumn(),separator='-')) +!!$ call mem_reporter%add_column(MemoryTextColumn(['Cyc RSS'],'(i10,1x,a2)',13, MeanCycleColumn(),separator='-')) !!$ report_lines = reporter%generate_report(get_global_time_profiler()) call MPI_Comm_size(mapl_comm%esmf%comm, npes, ierror) call MPI_Comm_Rank(mapl_comm%esmf%comm, my_rank, ierror) - do rank = 0, npes-1 -!!$ if (this%rank == 0) then - if (rank == my_rank) then + if (my_rank == 0) then report_lines = reporter%generate_report(t_p) write(*,'(a,1x,i0)')'Report on process: ', rank do i = 1, size(report_lines) write(*,'(a)') report_lines(i) end do - print*,' ' - report_lines = mem_reporter%generate_report(m_p) - do i = 1, size(report_lines) - write(*,'(a)') report_lines(i) - end do - end if - call MPI_Barrier(mapl_comm%esmf%comm, ierror) - end do + end if + call MPI_Barrier(mapl_comm%esmf%comm, ierror) end subroutine report_profiling diff --git a/MAPL_Base/MAPL_CapGridComp.F90 b/MAPL_Base/MAPL_CapGridComp.F90 index ce870300071c..f46b427f2e22 100644 --- a/MAPL_Base/MAPL_CapGridComp.F90 +++ b/MAPL_Base/MAPL_CapGridComp.F90 @@ -170,7 +170,7 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) type (MAPL_MetaComp), pointer :: MAPLOBJ procedure(), pointer :: root_set_services type(MAPL_CapGridComp), pointer :: cap - class(BaseProfiler), pointer :: t_p, m_p + class(BaseProfiler), pointer :: t_p _UNUSED_DUMMY(import_state) _UNUSED_DUMMY(export_state) @@ -180,9 +180,7 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) maplobj => get_MetaComp_from_gc(gc) t_p => get_global_time_profiler() - m_p => get_global_memory_profiler() call t_p%start('Initialize') - call m_p%start('Initialize') call ESMF_GridCompGet(gc, vm = cap%vm, rc = status) _VERIFY(status) @@ -582,7 +580,6 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) end if end if - call m_p%stop('Initialize') call t_p%stop('Initialize') _RETURN(ESMF_SUCCESS) @@ -725,21 +722,18 @@ subroutine run_gc(gc, import, export, clock, rc) integer, intent(out) :: RC ! Error code: integer :: status - class (BaseProfiler), pointer :: t_p, m_p + class (BaseProfiler), pointer :: t_p _UNUSED_DUMMY(import) _UNUSED_DUMMY(export) _UNUSED_DUMMY(clock) t_p => get_global_time_profiler() - m_p => get_global_memory_profiler() call t_p%start('Run') - call m_p%start('Run') call run_MAPL_GridComp(gc, rc=status) _VERIFY(status) - call m_p%stop('Run') call t_p%stop('Run') _RETURN(ESMF_SUCCESS) @@ -757,7 +751,7 @@ subroutine finalize_gc(gc, import_state, export_state, clock, rc) type(MAPL_CapGridComp), pointer :: cap type(MAPL_MetaComp), pointer :: MAPLOBJ - class (BaseProfiler), pointer :: t_p, m_p + class (BaseProfiler), pointer :: t_p _UNUSED_DUMMY(import_state) _UNUSED_DUMMY(export_state) @@ -767,9 +761,7 @@ subroutine finalize_gc(gc, import_state, export_state, clock, rc) MAPLOBJ => get_MetaComp_from_gc(gc) t_p => get_global_time_profiler() - m_p => get_global_memory_profiler() call t_p%start('Finalize') - call m_p%start('Finalize') if (.not. cap%printspec > 0) then @@ -814,7 +806,6 @@ subroutine finalize_gc(gc, import_state, export_state, clock, rc) end if end if - call m_p%stop('Finalize') call t_p%stop('Finalize') _RETURN(ESMF_SUCCESS) diff --git a/MAPL_Base/MAPL_Generic.F90 b/MAPL_Base/MAPL_Generic.F90 index 9e254fb23e56..0116a4cf79dd 100644 --- a/MAPL_Base/MAPL_Generic.F90 +++ b/MAPL_Base/MAPL_Generic.F90 @@ -398,7 +398,6 @@ module MAPL_GenericMod real :: HEARTBEAT type (MAPL_Communicators) :: mapl_comm type (TimeProfiler) :: t_profiler - type (MemoryProfiler) :: m_profiler !!$ integer :: comm end type MAPL_MetaComp !EOC @@ -555,7 +554,6 @@ recursive subroutine MAPL_GenericSetServices ( GC, RC ) _VERIFY(STATUS) MAPLOBJ%t_profiler = TimeProfiler(trim(COMP_NAME), comm_world = comm ) - MAPLOBJ%m_profiler = MemoryProfiler(trim(COMP_NAME), comm_world = comm) ! Set the Component's Total timer ! ------------------------------- @@ -898,7 +896,7 @@ recursive subroutine MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, RC ) logical :: isPresent logical :: isCreated logical :: gridIsPresent - class(BaseProfiler), pointer :: t_p, m_p + class(BaseProfiler), pointer :: t_p character(len=ESMF_MAXSTR) :: write_restart_by_face character(len=ESMF_MAXSTR) :: read_restart_by_face character(len=ESMF_MAXSTR) :: write_restart_by_oserver @@ -924,13 +922,9 @@ recursive subroutine MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, RC ) ! Start my timer !--------------- t_p => get_global_time_profiler() - m_p => get_global_memory_profiler() call t_p%start(trim(state%compname)) - call m_p%start(trim(state%compname)) call state%t_profiler%start('Initialize') - call state%m_profiler%start('Initialize') call state%t_profiler%start('InitializeMine') - call state%m_profiler%start('InitializeMine') call MAPL_GenericStateClockOn(STATE,"TOTAL") call MAPL_GenericStateClockOn(STATE,"GenInitTot") @@ -1457,7 +1451,6 @@ recursive subroutine MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, RC ) end if end if call MAPL_GenericStateClockOff(STATE,"--GenInitMine") - call state%m_profiler%stop('InitializeMine') call state%t_profiler%stop('InitializeMine') ! Initialize the children @@ -1535,7 +1528,6 @@ recursive subroutine MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, RC ) endif call MAPL_GenericStateClockOn(STATE,"--GenInitMine") call state%t_profiler%start('InitializeMine') - call state%m_profiler%start('InitializeMine') ! Create import and initialize state variables ! -------------------------------------------- @@ -1683,7 +1675,6 @@ recursive subroutine MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, RC ) end if call MAPL_GenericStateClockOff(STATE,"--GenInitMine") - call state%m_profiler%stop('InitializeMine') call state%t_profiler%stop('InitializeMine') if (.not. associated(STATE%parentGC)) then @@ -1694,9 +1685,7 @@ recursive subroutine MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_GenericStateClockOff(STATE,"GenInitTot") call MAPL_GenericStateClockOff(STATE,"TOTAL") - call state%m_profiler%stop('Initialize') call state%t_profiler%stop('Initialize') - call m_p%stop(trim(state%compname)) call t_p%stop(trim(state%compname)) ! Write Memory Use Statistics. @@ -1741,7 +1730,7 @@ subroutine MAPL_GenericWrapper ( GC, IMPORT, EXPORT, CLOCK, RC) integer :: I type(ESMF_Method_Flag) :: method type(ESMF_VM) :: VM - class(BaseProfiler), pointer :: t_p, m_p + class(BaseProfiler), pointer :: t_p character(1) :: char_phase character(len=12), pointer :: timers(:) => NULL() @@ -1781,20 +1770,15 @@ subroutine MAPL_GenericWrapper ( GC, IMPORT, EXPORT, CLOCK, RC) ! TIMERS on t_p => get_global_time_profiler() - m_p => get_global_memory_profiler() if ( method == ESMF_METHOD_RUN ) then if (phase > 1) then write(char_phase,'(i1)')phase call t_p%start(trim(state%compname)//'_'//char_phase) - call m_p%start(trim(state%compname)//'_'//char_phase) call state%t_profiler%start('Run'//char_phase) - call state%m_profiler%start('Run'//char_phase) else call t_p%start(trim(state%compname)) - call m_p%start(trim(state%compname)) call state%t_profiler%start('Run') - call state%m_profiler%start('Run') end if endif @@ -1860,14 +1844,10 @@ subroutine MAPL_GenericWrapper ( GC, IMPORT, EXPORT, CLOCK, RC) if ( method == ESMF_METHOD_RUN ) then if (phase > 1) then - call state%m_profiler%stop('Run'//char_phase) call state%t_profiler%stop('Run'//char_phase) - call m_p%stop(trim(state%compname)//'_'//char_phase) call t_p%stop(trim(state%compname)//'_'//char_phase) else - call state%m_profiler%stop('Run') call state%t_profiler%stop('Run') - call m_p%stop(trim(state%compname)) call t_p%stop(trim(state%compname)) end if endif @@ -2035,7 +2015,7 @@ recursive subroutine MAPL_GenericFinalize ( GC, IMPORT, EXPORT, CLOCK, RC ) character(len=ESMF_MAXSTR) :: id_string integer :: ens_id_width type(ESMF_Time) :: CurrTime - class(BaseProfiler), pointer :: t_p, m_p + class(BaseProfiler), pointer :: t_p !============================================================================= @@ -2059,11 +2039,8 @@ recursive subroutine MAPL_GenericFinalize ( GC, IMPORT, EXPORT, CLOCK, RC ) ! --------------------- t_p => get_global_time_profiler() - m_p => get_global_memory_profiler() call t_p%start(trim(state%compname)) - call m_p%start(trim(state%compname)) call state%t_profiler%start('Final') - call state%m_profiler%start('Final') call MAPL_GenericStateClockOn(STATE,"TOTAL") call MAPL_GenericStateClockOn(STATE,"GenFinalTot") @@ -2196,9 +2173,7 @@ recursive subroutine MAPL_GenericFinalize ( GC, IMPORT, EXPORT, CLOCK, RC ) ! Write summary of profiled times !-------------------------------- - call state%m_profiler%stop('Final') call state%t_profiler%stop('Final') - call state%m_profiler%finalize() call state%t_profiler%finalize() if (.not. MAPL_ProfIsDisabled()) then @@ -2214,7 +2189,6 @@ recursive subroutine MAPL_GenericFinalize ( GC, IMPORT, EXPORT, CLOCK, RC ) !call WRITE_PARALLEL(" ") end if - call m_p%stop(trim(state%compname)) call t_p%stop(trim(state%compname)) ! Clean-up @@ -2230,7 +2204,7 @@ recursive subroutine MAPL_GenericFinalize ( GC, IMPORT, EXPORT, CLOCK, RC ) subroutine report_generic_profile( rc ) integer, optional, intent( out) :: RC ! Error code: character(:), allocatable :: report(:) - type (ProfileReporter) :: reporter, mem_reporter + type (ProfileReporter) :: reporter type (MultiColumn) :: inclusive, exclusive type (ESMF_VM) :: vm @@ -2238,17 +2212,6 @@ subroutine report_generic_profile( rc ) _VERIFY(STATUS) if (MAPL_AM_I_Root(vm)) then - call mem_reporter%add_column(NameColumn(50,separator='-')) - call mem_reporter%add_column(MemoryTextColumn(['RSS'],'(i10,1x,a2)', 13, InclusiveColumn(),separator='-')) - call mem_reporter%add_column(MemoryTextColumn(['Cyc RSS'],'(i10,1x,a2)', 13, MeanCycleColumn(),separator='-')) - - report = mem_reporter%generate_report(state%m_profiler) - write(OUTPUT_UNIT,*)'' - write(OUTPUT_UNIT,*)'Memory for ' // trim(comp_name) - do i = 1, size(report) - write(OUTPUT_UNIT,'(a)')report(i) - end do - write(OUTPUT_UNIT,*)'' call reporter%add_column(NameColumn(50)) call reporter%add_column(FormattedTextColumn('#-cycles','(i5.0)', 5, NumCyclesColumn(),separator='-')) @@ -2313,7 +2276,7 @@ recursive subroutine MAPL_GenericRecord ( GC, IMPORT, EXPORT, CLOCK, RC ) integer :: K logical :: ftype(0:1) - class(BaseProfiler), pointer :: t_p, m_p + class(BaseProfiler), pointer :: t_p !============================================================================= ! Begin... @@ -2330,11 +2293,8 @@ recursive subroutine MAPL_GenericRecord ( GC, IMPORT, EXPORT, CLOCK, RC ) _VERIFY(STATUS) t_p => get_global_time_profiler() - m_p => get_global_memory_profiler() call t_p%start(trim(state%compname)) - call m_p%start(trim(state%compname)) call state%t_profiler%start('Record') - call state%m_profiler%start('Record') call MAPL_GenericStateClockOn(STATE,"TOTAL") @@ -2359,7 +2319,6 @@ recursive subroutine MAPL_GenericRecord ( GC, IMPORT, EXPORT, CLOCK, RC ) ! ------------------ call MAPL_GenericStateClockOn(STATE,"--GenRecordMine") call state%t_profiler%start('RecordMine') - call state%m_profiler%start('RecordMine') if (associated(STATE%RECORD)) then @@ -2427,15 +2386,12 @@ recursive subroutine MAPL_GenericRecord ( GC, IMPORT, EXPORT, CLOCK, RC ) END DO endif call MAPL_GenericStateClockOff(STATE,"--GenRecordMine") - call state%m_profiler%stop('RecordMine') call state%t_profiler%stop('RecordMine') call MAPL_GenericStateClockOff(STATE,"GenRecordTot") call MAPL_GenericStateClockOff(STATE,"TOTAL") - call state%m_profiler%stop('Record') call state%t_profiler%stop('Record') - call m_p%stop(trim(state%compname)) call t_p%stop(trim(state%compname)) _RETURN(ESMF_SUCCESS) @@ -2544,7 +2500,7 @@ recursive subroutine MAPL_GenericRefresh ( GC, IMPORT, EXPORT, CLOCK, RC ) character(len=ESMF_MAXSTR) :: filetypechar character(len=4) :: extension integer :: hdr - class(BaseProfiler), pointer :: t_p, m_p + class(BaseProfiler), pointer :: t_p !============================================================================= ! Begin... @@ -2561,11 +2517,8 @@ recursive subroutine MAPL_GenericRefresh ( GC, IMPORT, EXPORT, CLOCK, RC ) _VERIFY(STATUS) t_p => get_global_time_profiler() - m_p => get_global_memory_profiler() call t_p%start(trim(state%compname)) - call m_p%start(trim(state%compname)) call state%t_profiler%start('Refresh') - call state%m_profiler%start('Refresh') call MAPL_GenericStateClockOn(STATE,"TOTAL") call MAPL_GenericStateClockOn(STATE,"GenRefreshTot") @@ -2587,7 +2540,6 @@ recursive subroutine MAPL_GenericRefresh ( GC, IMPORT, EXPORT, CLOCK, RC ) ! ------------------ call MAPL_GenericStateClockOn(STATE,"--GenRefreshMine") call state%t_profiler%start('RefreshMine') - call state%m_profiler%start('RefreshMine') if (associated(STATE%RECORD)) then @@ -2646,15 +2598,12 @@ recursive subroutine MAPL_GenericRefresh ( GC, IMPORT, EXPORT, CLOCK, RC ) _VERIFY(STATUS) endif call MAPL_GenericStateClockOff(STATE,"--GenRefreshMine") - call state%m_profiler%stop('RefreshMine') call state%t_profiler%stop('RefreshMine') call MAPL_GenericStateClockOff(STATE,"GenRefreshTot") call MAPL_GenericStateClockOff(STATE,"TOTAL") - call state%m_profiler%stop('Refresh') call state%t_profiler%stop('Refresh') - call m_p%stop(trim(state%compname)) call t_p%stop(trim(state%compname)) _RETURN(ESMF_SUCCESS) diff --git a/MAPL_Profiler/CMakeLists.txt b/MAPL_Profiler/CMakeLists.txt index 27bc1c4100ed..acd42beb4517 100644 --- a/MAPL_Profiler/CMakeLists.txt +++ b/MAPL_Profiler/CMakeLists.txt @@ -56,6 +56,7 @@ set (srcs esma_add_library (${this} SRCS ${srcs} DEPENDENCIES gftl-shared gftl MPI::MPI_Fortran) target_include_directories (${this} PRIVATE ${MAPL_SOURCE_DIR}/include) +add_subdirectory (demo) if (PFUNIT_FOUND) add_subdirectory (tests) endif () diff --git a/MAPL_Profiler/demo/CMakeLists.txt b/MAPL_Profiler/demo/CMakeLists.txt new file mode 100644 index 000000000000..290d3a674f34 --- /dev/null +++ b/MAPL_Profiler/demo/CMakeLists.txt @@ -0,0 +1,7 @@ +add_executable(demo.x demo.F90) +target_link_libraries(demo.x MAPL_Profiler) + +add_executable(mpi_demo.x mpi_demo.F90) +target_link_libraries(mpi_demo.x MAPL_Profiler ${MPI_Fortran_LIBRARIES}) +target_include_directories (mpi_demo.x PUBLIC ${MPI_Fortran_INCLUDE_DIRS}) +target_include_directories (mpi_demo.x PUBLIC ${CMAKE_BINARY_DIR}/src) diff --git a/MAPL_Profiler/demo/demo.F90 b/MAPL_Profiler/demo/demo.F90 new file mode 100644 index 000000000000..aa363029e6cf --- /dev/null +++ b/MAPL_Profiler/demo/demo.F90 @@ -0,0 +1,133 @@ +program main + use MPI + use MAPL_Profiler + implicit none + + + !type (MemoryProfiler), target :: mem_prof + type (TimeProfiler), target :: main_prof + type (TimeProfiler), target :: lap_prof + type (ProfileReporter) :: reporter + !type (ProfileReporter) :: mem_reporter + + character(:), allocatable :: report_lines(:) + integer :: i + integer :: ierror + + call MPI_Init(ierror) + main_prof = TimeProfiler('TOTAL') ! timer 1 + lap_prof = TimeProfiler('Lap') + !mem_prof = MemoryProfiler('TOTAL') + + call main_prof%start('init reporter') + call reporter%add_column(NameColumn(20)) + call reporter%add_column(FormattedTextColumn('#-cycles','(i5.0)', 5, NumCyclesColumn())) + call reporter%add_column(FormattedTextColumn(' T(inc)','(f9.6)', 9, InclusiveColumn())) + call reporter%add_column(FormattedTextColumn(' T(exc)','(f9.6)', 9, ExclusiveColumn())) + call reporter%add_column(FormattedTextColumn('%(inc)','(f6.2)', 6, PercentageColumn(InclusiveColumn()))) + call reporter%add_column(FormattedTextColumn('%(exc)','(f6.2)', 6, PercentageColumn(ExclusiveColumn()))) + call reporter%add_column(FormattedTextColumn(' std. dev ','(f12.4)', 12, StdDevColumn())) + call reporter%add_column(FormattedTextColumn(' rel. dev ','(f12.4)', 12, StdDevColumn(relative=.true.))) + call reporter%add_column(FormattedTextColumn(' max cyc ','(f12.8)', 12, MaxCycleColumn())) + call reporter%add_column(FormattedTextColumn(' min cyc ','(f12.8)', 12, MinCycleColumn())) + call reporter%add_column(FormattedTextColumn(' mean cyc','(f12.8)', 12, MeanCycleColumn())) + + !call mem_reporter%add_column(NameColumn(20)) + !call mem_reporter%add_column(FormattedTextColumn('#-cycles','(i5.0)', 5, NumCyclesColumn())) + !call mem_reporter%add_column(MemoryTextColumn(' RSS ','(i4,1x,a2)', 7, InclusiveColumn())) + !call mem_reporter%add_column(MemoryTextColumn('Cyc RSS','(i4,1x,a2)', 7, MeanCycleColumn())) + + call main_prof%stop('init reporter') + + + !call mem_prof%start('lap') + call do_lap(lap_prof) ! lap 1 + call lap_prof%finalize() + call main_prof%accumulate(lap_prof) + !call mem_prof%stop('lap') + + + call main_prof%start('use reporter') + report_lines = reporter%generate_report(lap_prof) + write(*,'(a)')'Lap 1' + write(*,'(a)')'=====' + do i = 1, size(report_lines) + write(*,'(a)') report_lines(i) + end do + write(*,'(a)')'' + call main_prof%stop('use reporter') + + !call mem_prof%start('lap') + call lap_prof%reset() + call do_lap(lap_prof) ! lap 2 + call lap_prof%finalize() + call main_prof%accumulate(lap_prof) + call main_prof%start('use reporter') + report_lines = reporter%generate_report(lap_prof) + write(*,'(a)')'Lap 2' + write(*,'(a)')'=====' + do i = 1, size(report_lines) + write(*,'(a)') report_lines(i) + end do + write(*,'(a)') '' + call main_prof%stop('use reporter') + !call mem_prof%stop('lap') + + call main_prof%finalize() + report_lines = reporter%generate_report(main_prof) + write(*,'(a)')'Final profile' + write(*,'(a)')'=============' + do i = 1, size(report_lines) + write(*,'(a)') report_lines(i) + end do + write(*,'(a)') '' + + + call MPI_Finalize(ierror) + + !call mem_prof%finalize() + !report_lines = mem_reporter%generate_report(mem_prof) + !write(*,'(a)')'Memory profile' + !write(*,'(a)')'==============' + !do i = 1, size(report_lines) + ! write(*,'(a)') report_lines(i) + !end do + !write(*,'(a)') '' + +contains + + subroutine do_lap(prof) + type (TimeProfiler), target :: prof + + real, pointer :: x(:) + + allocate(x(10**7)) + call random_number(x) + print*,sum(x) + call prof%start('timer_1') ! 2 + call prof%start('timer_1a')! 3 + call prof%stop('timer_1a') + call prof%start('timer_1b') ! 4 + call prof%start('timer_1b1') ! 5 + call prof%stop('timer_1b1') + call prof%stop('timer_1b') + call prof%stop('timer_1') + call prof%start('timer_2') ! 6 + call prof%start('timer_2b')! 7 + call prof%stop('timer_2b') + call prof%stop('timer_2') + + call prof%start('timer_1') ! 2 + call prof%start('timer_1a')! 3 + call prof%stop('timer_1a') + call prof%stop('timer_1') + + call prof%start('timer_2') ! 6 + call prof%stop('timer_2') + call prof%start('timer_2') ! 6 + call prof%stop('timer_2') + end subroutine do_lap + + +end program main + diff --git a/MAPL_Profiler/demo/mpi_demo.F90 b/MAPL_Profiler/demo/mpi_demo.F90 new file mode 100644 index 000000000000..d99dba2085d4 --- /dev/null +++ b/MAPL_Profiler/demo/mpi_demo.F90 @@ -0,0 +1,182 @@ +program main + use MAPL_Profiler + use MPI + implicit none + + + type (MemoryProfiler), target :: mem_prof + type (DistributedProfiler), target :: main_prof + type (DistributedProfiler), target :: lap_prof + type (ProfileReporter) :: reporter, main_reporter + type (ProfileReporter) :: mem_reporter + + character(:), allocatable :: report_lines(:) + integer :: i + integer :: rank, ierror + +!!$ mem_prof = MemoryProfiler('TOTAL') + + call MPI_Init(ierror) + call MPI_Comm_rank(MPI_COMM_WORLD, rank, ierror) + + main_prof = DistributedProfiler('TOTAL', MpiTimerGauge(), MPI_COMM_WORLD) ! timer 1 + lap_prof = DistributedProfiler('Lap', MpiTimerGauge(), MPI_COMM_WORLD) + + call main_prof%start('init reporter') + call reporter%add_column(NameColumn(20)) + call reporter%add_column(FormattedTextColumn('#-cycles','(i5.0)', 5, NumCyclesColumn())) + call reporter%add_column(FormattedTextColumn(' T(inc)','(f9.6)', 9, InclusiveColumn())) + call reporter%add_column(FormattedTextColumn(' T(exc)','(f9.6)', 9, ExclusiveColumn())) + call reporter%add_column(FormattedTextColumn('%(inc)','(f6.2)', 6, PercentageColumn(InclusiveColumn()))) + call reporter%add_column(FormattedTextColumn('%(exc)','(f6.2)', 6, PercentageColumn(ExclusiveColumn()))) + call reporter%add_column(FormattedTextColumn(' std. dev ','(f12.4)', 12, StdDevColumn())) + call reporter%add_column(FormattedTextColumn(' rel. dev ','(f12.4)', 12, StdDevColumn(relative=.true.))) + call reporter%add_column(FormattedTextColumn(' max cyc ','(f12.8)', 12, MaxCycleColumn())) + call reporter%add_column(FormattedTextColumn(' min cyc ','(f12.8)', 12, MinCycleColumn())) + call reporter%add_column(FormattedTextColumn(' mean cyc','(f12.8)', 12, MeanCycleColumn())) + + call main_reporter%add_column(NameColumn(20)) + call main_reporter%add_column(FormattedTextColumn('Inclusive','(f9.6)', 9, InclusiveColumn('MEAN'))) + call main_reporter%add_column(FormattedTextColumn('% Incl','(f6.2)', 6, PercentageColumn(InclusiveColumn('MEAN'),'MAX'))) + call main_reporter%add_column(FormattedTextColumn('Exclusive','(f9.6)', 9, ExclusiveColumn('MEAN'))) + call main_reporter%add_column(FormattedTextColumn('% Excl','(f6.2)', 6, PercentageColumn(ExclusiveColumn('MEAN')))) + call main_reporter%add_column(FormattedTextColumn(' Max Excl)','(f9.6)', 9, ExclusiveColumn('MAX'))) + call main_reporter%add_column(FormattedTextColumn(' Min Excl)','(f9.6)', 9, ExclusiveColumn('MIN'))) + call main_reporter%add_column(FormattedTextColumn('Max PE)','(1x,i4.4,1x)', 6, ExclusiveColumn('MAX_PE'))) + call main_reporter%add_column(FormattedTextColumn('Min PE)','(1x,i4.4,1x)', 6, ExclusiveColumn('MIN_PE'))) + + call mem_reporter%add_column(NameColumn(20)) + call mem_reporter%add_column(FormattedTextColumn('#-cycles','(i5.0)', 5, NumCyclesColumn())) + !call mem_reporter%add_column(MemoryTextColumn(' RSS ','(i4,1x,a2)', 7, InclusiveColumn())) + !call mem_reporter%add_column(MemoryTextColumn('Cyc RSS','(i4,1x,a2)', 7, MeanCycleColumn())) + + call main_prof%stop('init reporter') + + +!!$ call mem_prof%start('lap') + call do_lap(lap_prof) ! lap 1 + call lap_prof%finalize() + call main_prof%accumulate(lap_prof) +!!$ call mem_prof%stop('lap') + + + call main_prof%start('use reporter') + if (rank == 0) then + report_lines = reporter%generate_report(lap_prof) + write(*,'(a)')'Lap 1' + write(*,'(a)')'=====' + do i = 1, size(report_lines) + write(*,'(a)') report_lines(i) + end do + write(*,'(a)')'' + end if + call main_prof%stop('use reporter') + +!!$ call mem_prof%start('lap') + call lap_prof%reset() + call do_lap(lap_prof) ! lap 2 + call lap_prof%finalize() + call main_prof%accumulate(lap_prof) + call main_prof%start('use reporter') + + if (rank == 0) then + report_lines = reporter%generate_report(lap_prof) + write(*,'(a)')'Lap 2' + write(*,'(a)')'=====' + do i = 1, size(report_lines) + write(*,'(a)') report_lines(i) + end do + write(*,'(a)') '' + end if + + call main_prof%stop('use reporter') +!!$ call mem_prof%stop('lap') + + call main_prof%finalize() + call main_prof%reduce() + report_lines = reporter%generate_report(main_prof) + if (rank == 0) then + write(*,'(a)')'Final profile(0)' + write(*,'(a)')'=============' + do i = 1, size(report_lines) + write(*,'(a)') report_lines(i) + end do + write(*,'(a)') '' + end if + call MPI_Barrier(MPI_COMM_WORLD, ierror) + if (rank == 1) then + write(*,'(a)')'Final profile (1)' + write(*,'(a)')'================' + do i = 1, size(report_lines) + write(*,'(a)') report_lines(i) + end do + write(*,'(a)') '' + end if + call MPI_Barrier(MPI_COMM_WORLD, ierror) + + report_lines = main_reporter%generate_report(main_prof) + if (rank == 0) then + write(*,'(a)')'Parallel profile' + write(*,'(a)')'================' + do i = 1, size(report_lines) + write(*,'(a)') report_lines(i) + end do + write(*,'(a)') '' + end if + +!!$ call mem_prof%finalize() +!!$ if (rank == 0) then +!!$ report_lines = mem_reporter%generate_report(mem_prof) +!!$ write(*,'(a)')'Memory profile' +!!$ write(*,'(a)')'==============' +!!$ do i = 1, size(report_lines) +!!$ write(*,'(a)') report_lines(i) +!!$ end do +!!$ write(*,'(a)') '' +!!$ end if + + call MPI_Finalize(ierror) + +contains + + subroutine do_lap(prof) + type (DistributedProfiler), target :: prof + + real, pointer :: x(:) + + call prof%start('timer_1') ! 2 + allocate(x(10**7 * rank)) + call random_number(x) + print*,sum(x) + call prof%start('timer_1a')! 3 + call prof%stop('timer_1a') + call prof%start('timer_1b') ! 4 + call prof%start('timer_1b1') ! 5 + call prof%stop('timer_1b1') + call prof%stop('timer_1b') + call prof%stop('timer_1') + call prof%start('timer_2') ! 6 + call prof%start('timer_2b')! 7 + call prof%stop('timer_2b') + call prof%stop('timer_2') + + call prof%start('timer_1') ! 2 + block + real, allocatable :: x(:) + allocate(x(1000000)) + call random_number(x) + print*,'sum: ', sum(exp(x)) + deallocate(x) + end block + call prof%start('timer_1a')! 3 + call prof%stop('timer_1a') + call prof%stop('timer_1') + + call prof%start('timer_2') ! 6 + call prof%stop('timer_2') + call prof%start('timer_2') ! 6 + call prof%stop('timer_2') + end subroutine do_lap + +end program main + From 778392a791960738467be5360721a92edf36f687 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Wed, 8 Apr 2020 17:14:34 -0400 Subject: [PATCH 085/109] move timer constructor to AddChild --- MAPL_Base/MAPL_Cap.F90 | 3 ++- MAPL_Base/MAPL_Generic.F90 | 42 ++++++++++++++++++---------------- MAPL_Profiler/BaseProfiler.F90 | 31 +++++++++++++++++++++++++ MAPL_Profiler/TimeProfiler.F90 | 1 - MAPL_Profiler/demo/demo.F90 | 8 ++++--- 5 files changed, 60 insertions(+), 25 deletions(-) diff --git a/MAPL_Base/MAPL_Cap.F90 b/MAPL_Base/MAPL_Cap.F90 index c261f4bdd333..8dd0b803ea6b 100644 --- a/MAPL_Base/MAPL_Cap.F90 +++ b/MAPL_Base/MAPL_Cap.F90 @@ -428,6 +428,7 @@ subroutine run_model(this, mapl_comm, unusable, rc) t_p => get_global_time_profiler() t_p = TimeProfiler('All', comm_world = mapl_comm%esmf%comm) + call t_p%start() call start_timer() call ESMF_Initialize (vm=vm, logKindFlag=this%cap_options%esmf_logging_mode, mpiCommunicator=mapl_comm%esmf%comm, rc=status) @@ -448,7 +449,7 @@ subroutine run_model(this, mapl_comm, unusable, rc) !_VERIFY(status) call stop_timer() - call t_p%finalize() + call t_p%stop() !call report_throughput() call report_profiling() diff --git a/MAPL_Base/MAPL_Generic.F90 b/MAPL_Base/MAPL_Generic.F90 index 0116a4cf79dd..806bc9d4b5e4 100644 --- a/MAPL_Base/MAPL_Generic.F90 +++ b/MAPL_Base/MAPL_Generic.F90 @@ -527,7 +527,7 @@ recursive subroutine MAPL_GenericSetServices ( GC, RC ) type (MAPL_VarSpecPtr), pointer :: ImSpecPtr(:) type (MAPL_VarSpecPtr), pointer :: ExSpecPtr(:) type(ESMF_GridComp) :: rootGC -integer :: comm +class(BaseProfiler), pointer :: t_p !============================================================================= @@ -547,13 +547,12 @@ recursive subroutine MAPL_GenericSetServices ( GC, RC ) call MAPL_InternalStateRetrieve( GC, MAPLOBJ, RC=STATUS) _VERIFY(STATUS) - MAPLOBJ%COMPNAME = COMP_NAME - call ESMF_VmGet(VM, mpicommunicator=comm, rc=status) - _VERIFY(STATUS) - - MAPLOBJ%t_profiler = TimeProfiler(trim(COMP_NAME), comm_world = comm ) + t_p => get_global_time_profiler() + call t_p%start(trim(COMP_Name)) + call MAPLOBJ%t_profiler%start() + call MAPLOBJ%t_profiler%start('SetService') ! Set the Component's Total timer ! ------------------------------- @@ -791,6 +790,9 @@ recursive subroutine MAPL_GenericSetServices ( GC, RC ) ! All done !--------- + call MAPLOBJ%t_profiler%stop('SetService') + call MAPLOBJ%t_profiler%stop() + call t_p%stop(trim(COMP_NAME)) _RETURN(ESMF_SUCCESS) @@ -923,8 +925,9 @@ recursive subroutine MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, RC ) !--------------- t_p => get_global_time_profiler() call t_p%start(trim(state%compname)) + + call state%t_profiler%start() call state%t_profiler%start('Initialize') - call state%t_profiler%start('InitializeMine') call MAPL_GenericStateClockOn(STATE,"TOTAL") call MAPL_GenericStateClockOn(STATE,"GenInitTot") @@ -1451,7 +1454,6 @@ recursive subroutine MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, RC ) end if end if call MAPL_GenericStateClockOff(STATE,"--GenInitMine") - call state%t_profiler%stop('InitializeMine') ! Initialize the children ! ----------------------- @@ -1527,7 +1529,6 @@ recursive subroutine MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, RC ) enddo endif call MAPL_GenericStateClockOn(STATE,"--GenInitMine") - call state%t_profiler%start('InitializeMine') ! Create import and initialize state variables ! -------------------------------------------- @@ -1675,7 +1676,6 @@ recursive subroutine MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, RC ) end if call MAPL_GenericStateClockOff(STATE,"--GenInitMine") - call state%t_profiler%stop('InitializeMine') if (.not. associated(STATE%parentGC)) then call MAPL_AdjustIsNeeded(GC, EXPORT, RC=STATUS) @@ -1686,6 +1686,7 @@ recursive subroutine MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_GenericStateClockOff(STATE,"TOTAL") call state%t_profiler%stop('Initialize') + call state%t_profiler%stop() call t_p%stop(trim(state%compname)) ! Write Memory Use Statistics. @@ -1772,12 +1773,12 @@ subroutine MAPL_GenericWrapper ( GC, IMPORT, EXPORT, CLOCK, RC) t_p => get_global_time_profiler() if ( method == ESMF_METHOD_RUN ) then + call t_p%start(trim(state%compname)) + call state%t_profiler%start() if (phase > 1) then write(char_phase,'(i1)')phase - call t_p%start(trim(state%compname)//'_'//char_phase) call state%t_profiler%start('Run'//char_phase) else - call t_p%start(trim(state%compname)) call state%t_profiler%start('Run') end if endif @@ -1845,11 +1846,11 @@ subroutine MAPL_GenericWrapper ( GC, IMPORT, EXPORT, CLOCK, RC) if ( method == ESMF_METHOD_RUN ) then if (phase > 1) then call state%t_profiler%stop('Run'//char_phase) - call t_p%stop(trim(state%compname)//'_'//char_phase) else call state%t_profiler%stop('Run') - call t_p%stop(trim(state%compname)) end if + call state%t_profiler%stop() + call t_p%stop(trim(state%compname)) endif _RETURN(ESMF_SUCCESS) @@ -2040,6 +2041,7 @@ recursive subroutine MAPL_GenericFinalize ( GC, IMPORT, EXPORT, CLOCK, RC ) t_p => get_global_time_profiler() call t_p%start(trim(state%compname)) + call state%t_profiler%start() call state%t_profiler%start('Final') call MAPL_GenericStateClockOn(STATE,"TOTAL") @@ -2174,7 +2176,7 @@ recursive subroutine MAPL_GenericFinalize ( GC, IMPORT, EXPORT, CLOCK, RC ) !-------------------------------- call state%t_profiler%stop('Final') - call state%t_profiler%finalize() + call state%t_profiler%stop() if (.not. MAPL_ProfIsDisabled()) then @@ -2294,6 +2296,7 @@ recursive subroutine MAPL_GenericRecord ( GC, IMPORT, EXPORT, CLOCK, RC ) t_p => get_global_time_profiler() call t_p%start(trim(state%compname)) + call state%t_profiler%start() call state%t_profiler%start('Record') @@ -2318,7 +2321,6 @@ recursive subroutine MAPL_GenericRecord ( GC, IMPORT, EXPORT, CLOCK, RC ) ! Do my "own" record ! ------------------ call MAPL_GenericStateClockOn(STATE,"--GenRecordMine") - call state%t_profiler%start('RecordMine') if (associated(STATE%RECORD)) then @@ -2386,12 +2388,12 @@ recursive subroutine MAPL_GenericRecord ( GC, IMPORT, EXPORT, CLOCK, RC ) END DO endif call MAPL_GenericStateClockOff(STATE,"--GenRecordMine") - call state%t_profiler%stop('RecordMine') call MAPL_GenericStateClockOff(STATE,"GenRecordTot") call MAPL_GenericStateClockOff(STATE,"TOTAL") call state%t_profiler%stop('Record') + call state%t_profiler%stop() call t_p%stop(trim(state%compname)) _RETURN(ESMF_SUCCESS) @@ -2518,6 +2520,7 @@ recursive subroutine MAPL_GenericRefresh ( GC, IMPORT, EXPORT, CLOCK, RC ) t_p => get_global_time_profiler() call t_p%start(trim(state%compname)) + call state%t_profiler%start() call state%t_profiler%start('Refresh') call MAPL_GenericStateClockOn(STATE,"TOTAL") @@ -2539,7 +2542,6 @@ recursive subroutine MAPL_GenericRefresh ( GC, IMPORT, EXPORT, CLOCK, RC ) ! Do my "own" refresh ! ------------------ call MAPL_GenericStateClockOn(STATE,"--GenRefreshMine") - call state%t_profiler%start('RefreshMine') if (associated(STATE%RECORD)) then @@ -2598,12 +2600,12 @@ recursive subroutine MAPL_GenericRefresh ( GC, IMPORT, EXPORT, CLOCK, RC ) _VERIFY(STATUS) endif call MAPL_GenericStateClockOff(STATE,"--GenRefreshMine") - call state%t_profiler%stop('RefreshMine') call MAPL_GenericStateClockOff(STATE,"GenRefreshTot") call MAPL_GenericStateClockOff(STATE,"TOTAL") call state%t_profiler%stop('Refresh') + call state%t_profiler%stop() call t_p%stop(trim(state%compname)) _RETURN(ESMF_SUCCESS) @@ -2744,7 +2746,6 @@ subroutine MAPL_InternalStateCreate( GC, MAPLOBJ, RC) character(len=ESMF_MAXSTR) :: IAm character(len=ESMF_MAXSTR) :: COMP_NAME integer :: STATUS - ! Local variables ! --------------- @@ -4414,6 +4415,7 @@ recursive integer function MAPL_AddChildFromMeta(META, NAME, GRID, & ! copy communicator to childs mapl_metacomp CHILD_META%mapl_comm = META%mapl_comm + CHILD_META%t_profiler = TimeProfiler(trim(NAME), comm_world = META%mapl_comm%esmf%comm ) call ESMF_GridCompSetServices ( META%GCS(I), SS, RC=status ) _VERIFY(STATUS) diff --git a/MAPL_Profiler/BaseProfiler.F90 b/MAPL_Profiler/BaseProfiler.F90 index 6c3ab52ac0f3..150d9ad99009 100644 --- a/MAPL_Profiler/BaseProfiler.F90 +++ b/MAPL_Profiler/BaseProfiler.F90 @@ -26,9 +26,11 @@ module MAPL_BaseProfiler procedure :: start_name procedure :: stop_name procedure :: start_self + procedure :: stop_self generic :: start => start_name generic :: start => start_self generic :: stop => stop_name + generic :: stop => stop_self generic :: zeit_ci => start_name generic :: zeit_co => stop_name procedure :: get_num_meters @@ -159,6 +161,32 @@ subroutine stop_name(this, name) end subroutine stop_name + subroutine stop_self(this) + class(BaseProfiler), intent(inout) :: this + + class(AbstractMeter), pointer :: t + class(AbstractMeterNode), pointer :: node + + if( .not. this%stack%size() == 1) then + block + use MPI + integer :: rank, ierror + call MPI_Comm_rank(this%comm_world, rank, ierror) + if (rank == 0) then + print*,__FILE__,__LINE__,'stop called on self timer' + end if + end block + return + end if + + node => this%stack%back() + t => node%get_meter() + call t%stop() + call this%stack%pop_back() + + end subroutine stop_self + + integer function get_num_meters(this) result(num_meters) class(BaseProfiler), intent(in) :: this @@ -192,6 +220,9 @@ subroutine copy_profiler(new, old) subnode => new%node ! Stack always starts with root node of node + + if (old%stack%empty()) return + iter = old%stack%begin() call new%stack%push_back(subnode) call iter%next() diff --git a/MAPL_Profiler/TimeProfiler.F90 b/MAPL_Profiler/TimeProfiler.F90 index bebb399a9d29..14d5d71b67dc 100644 --- a/MAPL_Profiler/TimeProfiler.F90 +++ b/MAPL_Profiler/TimeProfiler.F90 @@ -36,7 +36,6 @@ function new_TimeProfiler(name, comm_world) result(prof) call prof%set_comm_world(comm_world = comm_world) call prof%set_node(MeterNode(name, prof%make_meter())) - call prof%start() end function new_TimeProfiler diff --git a/MAPL_Profiler/demo/demo.F90 b/MAPL_Profiler/demo/demo.F90 index aa363029e6cf..3ea422c138c4 100644 --- a/MAPL_Profiler/demo/demo.F90 +++ b/MAPL_Profiler/demo/demo.F90 @@ -16,7 +16,9 @@ program main call MPI_Init(ierror) main_prof = TimeProfiler('TOTAL') ! timer 1 + call main_prof%start() lap_prof = TimeProfiler('Lap') + call lap_prof%start() !mem_prof = MemoryProfiler('TOTAL') call main_prof%start('init reporter') @@ -42,7 +44,7 @@ program main !call mem_prof%start('lap') call do_lap(lap_prof) ! lap 1 - call lap_prof%finalize() + call lap_prof%stop() call main_prof%accumulate(lap_prof) !call mem_prof%stop('lap') @@ -60,7 +62,7 @@ program main !call mem_prof%start('lap') call lap_prof%reset() call do_lap(lap_prof) ! lap 2 - call lap_prof%finalize() + call lap_prof%stop() call main_prof%accumulate(lap_prof) call main_prof%start('use reporter') report_lines = reporter%generate_report(lap_prof) @@ -73,7 +75,7 @@ program main call main_prof%stop('use reporter') !call mem_prof%stop('lap') - call main_prof%finalize() + call main_prof%stop() report_lines = reporter%generate_report(main_prof) write(*,'(a)')'Final profile' write(*,'(a)')'=============' From 408a748c33541c7cb66fba4bf5a967861ca5d00a Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Wed, 8 Apr 2020 23:43:15 -0400 Subject: [PATCH 086/109] fix hist and extdata init timier --- MAPL_Base/MAPL_CapGridComp.F90 | 6 +++- MAPL_Base/MAPL_Generic.F90 | 56 ++++++++++++++++------------------ 2 files changed, 31 insertions(+), 31 deletions(-) diff --git a/MAPL_Base/MAPL_CapGridComp.F90 b/MAPL_Base/MAPL_CapGridComp.F90 index f46b427f2e22..e848dc3ffc35 100644 --- a/MAPL_Base/MAPL_CapGridComp.F90 +++ b/MAPL_Base/MAPL_CapGridComp.F90 @@ -558,10 +558,15 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) exportState = cap%child_exports(cap%root_id), clock = cap%clock, userRC = status) _VERIFY(status) + call t_p%start('HIST') call cap%initialize_history(rc=status) _VERIFY(status) + call t_p%stop('HIST') + + call t_p%start('EXTDATA') call cap%initialize_extdata(rc=status) _VERIFY(status) + call t_p%stop('EXTDATA') ! Finally check is this is a regular replay ! If so stuff gc and input state for ExtData in GCM internal state @@ -596,7 +601,6 @@ subroutine initialize_history(cap, rc) if (present(rc)) rc = ESMF_SUCCESS ! All the EXPORTS of the Hierachy are made IMPORTS of History !------------------------------------------------------------ - call ESMF_StateAdd(cap%child_imports(cap%history_id), [cap%child_exports(cap%root_id)], rc = status) _VERIFY(STATUS) diff --git a/MAPL_Base/MAPL_Generic.F90 b/MAPL_Base/MAPL_Generic.F90 index 806bc9d4b5e4..d29146de5d3c 100644 --- a/MAPL_Base/MAPL_Generic.F90 +++ b/MAPL_Base/MAPL_Generic.F90 @@ -549,10 +549,10 @@ recursive subroutine MAPL_GenericSetServices ( GC, RC ) _VERIFY(STATUS) MAPLOBJ%COMPNAME = COMP_NAME - t_p => get_global_time_profiler() - call t_p%start(trim(COMP_Name)) + !t_p => get_global_time_profiler() + !call t_p%start(trim(COMP_Name)) call MAPLOBJ%t_profiler%start() - call MAPLOBJ%t_profiler%start('SetService') + call MAPLOBJ%t_profiler%start('GenSetService') ! Set the Component's Total timer ! ------------------------------- @@ -790,9 +790,9 @@ recursive subroutine MAPL_GenericSetServices ( GC, RC ) ! All done !--------- - call MAPLOBJ%t_profiler%stop('SetService') + call MAPLOBJ%t_profiler%stop('GenSetService') call MAPLOBJ%t_profiler%stop() - call t_p%stop(trim(COMP_NAME)) + !call t_p%stop(trim(COMP_NAME)) _RETURN(ESMF_SUCCESS) @@ -924,10 +924,10 @@ recursive subroutine MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, RC ) ! Start my timer !--------------- t_p => get_global_time_profiler() - call t_p%start(trim(state%compname)) + if (state%compname /= 'EXTDATA') call t_p%start(trim(state%compname)) call state%t_profiler%start() - call state%t_profiler%start('Initialize') + call state%t_profiler%start('GenInitialize') call MAPL_GenericStateClockOn(STATE,"TOTAL") call MAPL_GenericStateClockOn(STATE,"GenInitTot") @@ -1685,9 +1685,9 @@ recursive subroutine MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_GenericStateClockOff(STATE,"GenInitTot") call MAPL_GenericStateClockOff(STATE,"TOTAL") - call state%t_profiler%stop('Initialize') + call state%t_profiler%stop('GenInitialize') call state%t_profiler%stop() - call t_p%stop(trim(state%compname)) + if (state%compname /= 'EXTDATA') call t_p%stop(trim(state%compname)) ! Write Memory Use Statistics. ! ------------------------------------------- @@ -1772,21 +1772,14 @@ subroutine MAPL_GenericWrapper ( GC, IMPORT, EXPORT, CLOCK, RC) t_p => get_global_time_profiler() - if ( method == ESMF_METHOD_RUN ) then - call t_p%start(trim(state%compname)) - call state%t_profiler%start() - if (phase > 1) then - write(char_phase,'(i1)')phase - call state%t_profiler%start('Run'//char_phase) - else - call state%t_profiler%start('Run') - end if - endif - MethodBlock: if (method == ESMF_METHOD_RUN) then func_ptr => ESMF_GridCompRun timers => timers_run sbrtn = 'Run' + if (phase > 1) then + write(char_phase,'(i1)')phase + sbrtn = 'Run'//char_phase + end if else if (method == ESMF_METHOD_INITIALIZE) then func_ptr => ESMF_GridCompInitialize !ALT: enable this when fully implemented (for now NULLIFY) @@ -1814,6 +1807,12 @@ subroutine MAPL_GenericWrapper ( GC, IMPORT, EXPORT, CLOCK, RC) endif MethodBlock ! TIMERS on + if (method == ESMF_METHOD_RUN ) then + call t_p%start(trim(state%compname)) + call state%t_profiler%start() + call state%t_profiler%start(trim(sbrtn)) + endif + if (associated(timers)) then do i = 1, size(timers) call MAPL_TimerOn (STATE,timers(i)) @@ -1843,16 +1842,13 @@ subroutine MAPL_GenericWrapper ( GC, IMPORT, EXPORT, CLOCK, RC) end do end if - if ( method == ESMF_METHOD_RUN ) then - if (phase > 1) then - call state%t_profiler%stop('Run'//char_phase) - else - call state%t_profiler%stop('Run') - end if + if (method == ESMF_METHOD_RUN) then + call state%t_profiler%stop(trim(sbrtn)) call state%t_profiler%stop() call t_p%stop(trim(state%compname)) endif + _RETURN(ESMF_SUCCESS) end subroutine MAPL_GenericWrapper @@ -2191,13 +2187,13 @@ recursive subroutine MAPL_GenericFinalize ( GC, IMPORT, EXPORT, CLOCK, RC ) !call WRITE_PARALLEL(" ") end if - call t_p%stop(trim(state%compname)) - ! Clean-up !--------- !ALT - call MAPL_GenericStateDestroy (STATE, RC=STATUS) - _VERIFY(STATUS) + call MAPL_GenericStateDestroy (STATE, RC=STATUS) + _VERIFY(STATUS) + + call t_p%stop(trim(state%compname)) _RETURN(ESMF_SUCCESS) From 379b7cef1e46fd8f7ff2f9a80ca07053c3d9fe65 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Thu, 9 Apr 2020 12:43:43 -0400 Subject: [PATCH 087/109] more fix. report both new timer and old timer results --- MAPL_Base/MAPL_Cap.F90 | 3 ++- MAPL_Base/MAPL_Generic.F90 | 47 ++++++++++++++++++++++------------ MAPL_Profiler/BaseProfiler.F90 | 12 ++++++--- 3 files changed, 42 insertions(+), 20 deletions(-) diff --git a/MAPL_Base/MAPL_Cap.F90 b/MAPL_Base/MAPL_Cap.F90 index 8dd0b803ea6b..f16405da7b75 100644 --- a/MAPL_Base/MAPL_Cap.F90 +++ b/MAPL_Base/MAPL_Cap.F90 @@ -450,8 +450,9 @@ subroutine run_model(this, mapl_comm, unusable, rc) call stop_timer() call t_p%stop() - !call report_throughput() call report_profiling() + ! W.J note : below reporting will be remove soon + call report_throughput() _RETURN(_SUCCESS) contains diff --git a/MAPL_Base/MAPL_Generic.F90 b/MAPL_Base/MAPL_Generic.F90 index d29146de5d3c..b94aae9568db 100644 --- a/MAPL_Base/MAPL_Generic.F90 +++ b/MAPL_Base/MAPL_Generic.F90 @@ -552,7 +552,7 @@ recursive subroutine MAPL_GenericSetServices ( GC, RC ) !t_p => get_global_time_profiler() !call t_p%start(trim(COMP_Name)) call MAPLOBJ%t_profiler%start() - call MAPLOBJ%t_profiler%start('GenSetService') + call MAPLOBJ%t_profiler%start('SetService') ! Set the Component's Total timer ! ------------------------------- @@ -790,7 +790,7 @@ recursive subroutine MAPL_GenericSetServices ( GC, RC ) ! All done !--------- - call MAPLOBJ%t_profiler%stop('GenSetService') + call MAPLOBJ%t_profiler%stop('SetService') call MAPLOBJ%t_profiler%stop() !call t_p%stop(trim(COMP_NAME)) @@ -927,7 +927,8 @@ recursive subroutine MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, RC ) if (state%compname /= 'EXTDATA') call t_p%start(trim(state%compname)) call state%t_profiler%start() - call state%t_profiler%start('GenInitialize') + call state%t_profiler%start('Initialize') + call state%t_profiler%start('Initialize_self') call MAPL_GenericStateClockOn(STATE,"TOTAL") call MAPL_GenericStateClockOn(STATE,"GenInitTot") @@ -1454,6 +1455,7 @@ recursive subroutine MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, RC ) end if end if call MAPL_GenericStateClockOff(STATE,"--GenInitMine") + call state%t_profiler%stop('Initialize_self') ! Initialize the children ! ----------------------- @@ -1529,6 +1531,7 @@ recursive subroutine MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, RC ) enddo endif call MAPL_GenericStateClockOn(STATE,"--GenInitMine") + call state%t_profiler%start('Initialize_self') ! Create import and initialize state variables ! -------------------------------------------- @@ -1676,6 +1679,7 @@ recursive subroutine MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, RC ) end if call MAPL_GenericStateClockOff(STATE,"--GenInitMine") + call state%t_profiler%stop('Initialize_self') if (.not. associated(STATE%parentGC)) then call MAPL_AdjustIsNeeded(GC, EXPORT, RC=STATUS) @@ -1685,7 +1689,7 @@ recursive subroutine MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_GenericStateClockOff(STATE,"GenInitTot") call MAPL_GenericStateClockOff(STATE,"TOTAL") - call state%t_profiler%stop('GenInitialize') + call state%t_profiler%stop('Initialize') call state%t_profiler%stop() if (state%compname /= 'EXTDATA') call t_p%stop(trim(state%compname)) @@ -2074,6 +2078,7 @@ recursive subroutine MAPL_GenericFinalize ( GC, IMPORT, EXPORT, CLOCK, RC ) endif call MAPL_GenericStateClockOn(STATE,"--GenFinalMine") + call state%t_profiler%start('Final_self') call MAPL_GetResource( STATE, RECFIN, LABEL="RECORD_FINAL:", & RC=STATUS ) @@ -2171,6 +2176,7 @@ recursive subroutine MAPL_GenericFinalize ( GC, IMPORT, EXPORT, CLOCK, RC ) ! Write summary of profiled times !-------------------------------- + call state%t_profiler%stop('Final_self') call state%t_profiler%stop('Final') call state%t_profiler%stop() @@ -2178,13 +2184,14 @@ recursive subroutine MAPL_GenericFinalize ( GC, IMPORT, EXPORT, CLOCK, RC ) call report_generic_profile() - !call WRITE_PARALLEL(" ") - !call WRITE_PARALLEL(" Times for "//trim(COMP_NAME)) + ! WJ node: the old report will be removed + call WRITE_PARALLEL(" ") + call WRITE_PARALLEL(" Times for "//trim(COMP_NAME)) - !call MAPL_ProfWrite(STATE%TIMES,RC=STATUS) - !_VERIFY(STATUS) + call MAPL_ProfWrite(STATE%TIMES,RC=STATUS) + _VERIFY(STATUS) - !call WRITE_PARALLEL(" ") + call WRITE_PARALLEL(" ") end if ! Clean-up @@ -2317,6 +2324,7 @@ recursive subroutine MAPL_GenericRecord ( GC, IMPORT, EXPORT, CLOCK, RC ) ! Do my "own" record ! ------------------ call MAPL_GenericStateClockOn(STATE,"--GenRecordMine") + call state%t_profiler%start('Record_self') if (associated(STATE%RECORD)) then @@ -2384,10 +2392,10 @@ recursive subroutine MAPL_GenericRecord ( GC, IMPORT, EXPORT, CLOCK, RC ) END DO endif call MAPL_GenericStateClockOff(STATE,"--GenRecordMine") - call MAPL_GenericStateClockOff(STATE,"GenRecordTot") call MAPL_GenericStateClockOff(STATE,"TOTAL") + call state%t_profiler%stop('Record_self') call state%t_profiler%stop('Record') call state%t_profiler%stop() call t_p%stop(trim(state%compname)) @@ -2538,6 +2546,7 @@ recursive subroutine MAPL_GenericRefresh ( GC, IMPORT, EXPORT, CLOCK, RC ) ! Do my "own" refresh ! ------------------ call MAPL_GenericStateClockOn(STATE,"--GenRefreshMine") + call state%t_profiler%start('Refresh_self') if (associated(STATE%RECORD)) then @@ -2596,10 +2605,10 @@ recursive subroutine MAPL_GenericRefresh ( GC, IMPORT, EXPORT, CLOCK, RC ) _VERIFY(STATUS) endif call MAPL_GenericStateClockOff(STATE,"--GenRefreshMine") - call MAPL_GenericStateClockOff(STATE,"GenRefreshTot") call MAPL_GenericStateClockOff(STATE,"TOTAL") + call state%t_profiler%stop('Refresh_self') call state%t_profiler%stop('Refresh') call state%t_profiler%stop() call t_p%stop(trim(state%compname)) @@ -4825,16 +4834,18 @@ subroutine MAPL_GenericStateClockOn(STATE,NAME,RC) !EOPI character(len=ESMF_MAXSTR), parameter :: IAm = "MAPL_GenericStateClockOn" - integer :: STATUS - + integer :: STATUS, n + call MAPL_ProfClockOn(STATE%TIMES,NAME,RC=STATUS) _VERIFY(STATUS) + + ! WJ notes : will replace above code with below + !n = index(NAME,'-',.true.)+1 + !call state%t_profiler%start(trim(Name(n:))) _RETURN(ESMF_SUCCESS) end subroutine MAPL_GenericStateClockOn - - subroutine MAPL_StateAlarmAdd(STATE,ALARM,RC) type (MAPL_MetaComp), intent(INOUT) :: STATE @@ -4894,11 +4905,15 @@ subroutine MAPL_GenericStateClockOff(STATE,NAME,RC) !EOPI character(len=ESMF_MAXSTR), parameter :: IAm = "MAPL_GenericStateClockOff" - integer :: STATUS + integer :: STATUS, n call MAPL_ProfClockOff(STATE%TIMES,NAME,RC=STATUS) _VERIFY(STATUS) + ! WJ notes : will replace above code with below + !n = index(NAME,'-',.true.)+1 + !call state%t_profiler%stop(trim(Name(n:))) + _RETURN(ESMF_SUCCESS) end subroutine MAPL_GenericStateClockOff diff --git a/MAPL_Profiler/BaseProfiler.F90 b/MAPL_Profiler/BaseProfiler.F90 index 150d9ad99009..2d01b6108a4c 100644 --- a/MAPL_Profiler/BaseProfiler.F90 +++ b/MAPL_Profiler/BaseProfiler.F90 @@ -105,11 +105,17 @@ subroutine start_name(this, name) class(AbstractMeterNode), pointer :: node class(AbstractMeter), allocatable :: m - node => this%stack%back() - if (.not. node%has_child(name)) then + if (this%stack%empty()) then m = this%make_meter() call node%add_child(name, m) !this%make_meter()) - end if + else + node => this%stack%back() + if (.not. node%has_child(name)) then + m = this%make_meter() + call node%add_child(name, m) !this%make_meter()) + end if + endif + node => node%get_child(name) call this%stack%push_back(node) From 686cd5327972940f5fbbcfad431b6a2af1ee6033 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Thu, 9 Apr 2020 14:30:07 -0400 Subject: [PATCH 088/109] fix MPAL_Profiler unit tests --- MAPL_Profiler/tests/test_ProfileReporter.pf | 3 ++- MAPL_Profiler/tests/test_TimeProfiler.pf | 8 ++++++++ 2 files changed, 10 insertions(+), 1 deletion(-) diff --git a/MAPL_Profiler/tests/test_ProfileReporter.pf b/MAPL_Profiler/tests/test_ProfileReporter.pf index 5ec4debfcbd0..86b75f1c7b61 100644 --- a/MAPL_Profiler/tests/test_ProfileReporter.pf +++ b/MAPL_Profiler/tests/test_ProfileReporter.pf @@ -16,6 +16,7 @@ contains character(:), allocatable :: report_lines(:) prof = TimeProfiler('top') ! timer 1 + call prof%start() call prof%start('timer_1') ! 2 call prof%start('timer_1a')! 3 call prof%stop('timer_1a') @@ -69,7 +70,7 @@ contains character(:), allocatable :: report_lines(:) prof = TimeProfiler('top') ! timer 1 - + call prof%start() call prof%start('timer_1') ! 2 call prof%start('timer_1a')! 3 call prof%stop('timer_1a') diff --git a/MAPL_Profiler/tests/test_TimeProfiler.pf b/MAPL_Profiler/tests/test_TimeProfiler.pf index e969b34c3738..2fd33440e896 100644 --- a/MAPL_Profiler/tests/test_TimeProfiler.pf +++ b/MAPL_Profiler/tests/test_TimeProfiler.pf @@ -12,6 +12,7 @@ contains type (TimeProfiler), target :: prof prof = TimeProfiler('top') + call Prof%start() call prof%start('timer_1') call prof%stop('timer_1') @@ -28,6 +29,7 @@ contains type (TimeProfiler), target :: prof prof = TimeProfiler('top') + call prof%start() call prof%start('timer_1') call prof%start('timer_2') @@ -45,7 +47,9 @@ contains class(AbstractMeterNode), pointer :: main_node main = TimeProfiler('main') + call main%start() lap = TimeProfiler('lap') + call lap%start() call lap%finalize() call main%accumulate(lap) @@ -66,7 +70,9 @@ contains class(AbstractMeter), pointer :: t main = TimeProfiler('main') + call main%start() lap = TimeProfiler('lap') + call lap%start() call lap%start('A') call lap%stop('A') call lap%finalize() @@ -100,7 +106,9 @@ contains type(TimeProfiler), target :: main, lap main = TimeProfiler('main') + call main%start() lap = TimeProfiler('lap') + call lap%start() call lap%start('A') call lap%stop('A') call lap%finalize() From 8e69f27914606804ca339a547c26f72bc873d048 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Sat, 11 Apr 2020 21:56:11 -0400 Subject: [PATCH 089/109] re-arrange timer --- MAPL_Base/MAPL_CapGridComp.F90 | 33 +++++++++++++++-- MAPL_Base/MAPL_Generic.F90 | 67 ++++++++++++++++++++-------------- MAPL_Profiler/BaseProfiler.F90 | 30 ++++++++++----- 3 files changed, 90 insertions(+), 40 deletions(-) diff --git a/MAPL_Base/MAPL_CapGridComp.F90 b/MAPL_Base/MAPL_CapGridComp.F90 index e848dc3ffc35..cff6615d4d08 100644 --- a/MAPL_Base/MAPL_CapGridComp.F90 +++ b/MAPL_Base/MAPL_CapGridComp.F90 @@ -168,6 +168,7 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) type (MAPL_MetaComp), pointer :: MAPLOBJ + type (MAPL_MetaComp), pointer :: CHILD_MAPLOBJ procedure(), pointer :: root_set_services type(MAPL_CapGridComp), pointer :: cap class(BaseProfiler), pointer :: t_p @@ -180,7 +181,6 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) maplobj => get_MetaComp_from_gc(gc) t_p => get_global_time_profiler() - call t_p%start('Initialize') call ESMF_GridCompGet(gc, vm = cap%vm, rc = status) _VERIFY(status) @@ -481,6 +481,7 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) root_set_services => cap%root_set_services + call t_p%start('SetService') cap%root_id = MAPL_AddChild(MAPLOBJ, name = root_name, SS = root_set_services, rc = status) _VERIFY(status) @@ -520,6 +521,7 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) cap%extdata_id = MAPL_AddChild (MAPLOBJ, name = 'EXTDATA', SS = ExtData_SetServices, rc = status) _VERIFY(status) + call t_p%stop('SetService') ! Add NX and NY from AGCM.rc to ExtData.rc as well as name of ExtData rc file call ESMF_ConfigGetAttribute(cap%cf_root, value = NX, Label="NX:", rc=status) @@ -554,9 +556,17 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) ! Initialize the Computational Hierarchy !---------------------------------------- + call t_p%start('Initialize') + call t_p%start(trim(root_name)) + call MAPL_InternalStateRetrieve(cap%gcs(cap%root_id), CHILD_MAPLOBJ, RC=status) + call CHILD_MAPLOBJ%t_profiler%start() + call CHILD_MAPLOBJ%t_profiler%start('Intialize') call ESMF_GridCompInitialize(cap%gcs(cap%root_id), importState = cap%child_imports(cap%root_id), & exportState = cap%child_exports(cap%root_id), clock = cap%clock, userRC = status) _VERIFY(status) + call CHILD_MAPLOBJ%t_profiler%stop('Intialize') + call CHILD_MAPLOBJ%t_profiler%stop() + call t_p%stop(trim(root_name)) call t_p%start('HIST') call cap%initialize_history(rc=status) @@ -583,9 +593,9 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) ExtData_internal_state%gc = CAP%GCS(cap%extdata_id) ExtData_internal_state%expState = CAP%CHILD_EXPORTS(cap%extdata_id) end if + call t_p%stop('Initialize') end if - call t_p%stop('Initialize') _RETURN(ESMF_SUCCESS) end subroutine initialize_gc @@ -596,7 +606,8 @@ subroutine initialize_history(cap, rc) integer, optional, intent(out) :: rc integer :: status type(HISTORY_ExchangeListWrap) :: lswrap - integer*8, pointer :: LSADDR(:) => null() + integer*8, pointer :: LSADDR(:) => null() + type (MAPL_MetaComp), pointer :: CHILD_MAPLOBJ if (present(rc)) rc = ESMF_SUCCESS ! All the EXPORTS of the Hierachy are made IMPORTS of History @@ -616,10 +627,17 @@ subroutine initialize_history(cap, rc) ! Initialize the History !------------------------ + call MAPL_InternalStateRetrieve(cap%gcs(cap%history_id), CHILD_MAPLOBJ, RC=status) + call CHILD_MAPLOBJ%t_profiler%start() + call CHILD_MAPLOBJ%t_profiler%start('Intialize') + call ESMF_GridCompInitialize (CAP%GCS(cap%history_id), importState=CAP%CHILD_IMPORTS(cap%history_id), & exportState=CAP%CHILD_EXPORTS(cap%history_id), clock=CAP%CLOCK_HIST, userRC=STATUS ) _VERIFY(STATUS) + call CHILD_MAPLOBJ%t_profiler%stop('Intialize') + call CHILD_MAPLOBJ%t_profiler%stop() + _RETURN(ESMF_SUCCESS) end subroutine initialize_history @@ -637,6 +655,7 @@ subroutine initialize_extdata(cap , rc) integer :: i type(ESMF_State) :: state, root_imports, component_state character(len=:), allocatable :: component_name, field_name + type (MAPL_MetaComp), pointer :: CHILD_MAPLOBJ ! Prepare EXPORTS for ExtData ! --------------------------- @@ -707,11 +726,19 @@ subroutine initialize_extdata(cap , rc) ! Initialize the ExtData !------------------------ + + call MAPL_InternalStateRetrieve(cap%gcs(cap%extdata_id), CHILD_MAPLOBJ, RC=status) + call CHILD_MAPLOBJ%t_profiler%start() + call CHILD_MAPLOBJ%t_profiler%start('Intialize') + call ESMF_GridCompInitialize (cap%gcs(cap%extdata_id), importState = cap%child_imports(cap%extdata_id), & exportState = cap%child_exports(cap%extdata_id), & clock = cap%clock, userRc = status) _VERIFY(status) + call CHILD_MAPLOBJ%t_profiler%stop('Intialize') + call CHILD_MAPLOBJ%t_profiler%stop() + _RETURN(ESMF_SUCCESS) end subroutine initialize_extdata diff --git a/MAPL_Base/MAPL_Generic.F90 b/MAPL_Base/MAPL_Generic.F90 index b94aae9568db..dea063ad171f 100644 --- a/MAPL_Base/MAPL_Generic.F90 +++ b/MAPL_Base/MAPL_Generic.F90 @@ -203,7 +203,7 @@ module MAPL_GenericMod public MAPL_GCGet public MAPL_CheckpointState public MAPL_ESMFStateReadFromFile - + public MAPL_InternalStateRetrieve !BOP ! !PUBLIC TYPES: @@ -397,7 +397,7 @@ module MAPL_GenericMod integer , pointer :: phase_coldstart(:)=> null() real :: HEARTBEAT type (MAPL_Communicators) :: mapl_comm - type (TimeProfiler) :: t_profiler + type (TimeProfiler), public :: t_profiler !!$ integer :: comm end type MAPL_MetaComp !EOC @@ -527,7 +527,6 @@ recursive subroutine MAPL_GenericSetServices ( GC, RC ) type (MAPL_VarSpecPtr), pointer :: ImSpecPtr(:) type (MAPL_VarSpecPtr), pointer :: ExSpecPtr(:) type(ESMF_GridComp) :: rootGC -class(BaseProfiler), pointer :: t_p !============================================================================= @@ -549,10 +548,7 @@ recursive subroutine MAPL_GenericSetServices ( GC, RC ) _VERIFY(STATUS) MAPLOBJ%COMPNAME = COMP_NAME - !t_p => get_global_time_profiler() - !call t_p%start(trim(COMP_Name)) - call MAPLOBJ%t_profiler%start() - call MAPLOBJ%t_profiler%start('SetService') + call MAPLOBJ%t_profiler%start('GenSetService') ! Set the Component's Total timer ! ------------------------------- @@ -790,9 +786,7 @@ recursive subroutine MAPL_GenericSetServices ( GC, RC ) ! All done !--------- - call MAPLOBJ%t_profiler%stop('SetService') - call MAPLOBJ%t_profiler%stop() - !call t_p%stop(trim(COMP_NAME)) + call MAPLOBJ%t_profiler%stop('GenSetService') _RETURN(ESMF_SUCCESS) @@ -923,16 +917,13 @@ recursive subroutine MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, RC ) ! Start my timer !--------------- - t_p => get_global_time_profiler() - if (state%compname /= 'EXTDATA') call t_p%start(trim(state%compname)) - call state%t_profiler%start() - call state%t_profiler%start('Initialize') - call state%t_profiler%start('Initialize_self') + call state%t_profiler%start('GenInitialize') call MAPL_GenericStateClockOn(STATE,"TOTAL") call MAPL_GenericStateClockOn(STATE,"GenInitTot") call MAPL_GenericStateClockOn(STATE,"--GenInitMine") + call state%t_profiler%start('GenInitialize_self') ! Put the inherited grid in the generic state !-------------------------------------------- @@ -1454,8 +1445,8 @@ recursive subroutine MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, RC ) STATE%RECORD%INT_LEN = 0 end if end if + call state%t_profiler%stop('GenInitialize_self') call MAPL_GenericStateClockOff(STATE,"--GenInitMine") - call state%t_profiler%stop('Initialize_self') ! Initialize the children ! ----------------------- @@ -1487,14 +1478,21 @@ recursive subroutine MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, RC ) call ESMF_GridCompGet( STATE%GCS(I), NAME=CHILD_NAME, RC=STATUS ) _VERIFY(STATUS) + t_p => get_global_time_profiler() + call t_p%start(trim(CHILD_NAME)) call MAPL_GenericStateClockOn (STATE,trim(CHILD_NAME)) + call CHLDMAPL(I)%ptr%t_profiler%start() + call CHLDMAPL(I)%ptr%t_profiler%start('Initialize') call ESMF_GridCompInitialize (STATE%GCS(I), & importState=STATE%GIM(I), & exportState=STATE%GEX(I), & clock=CLOCK, PHASE=CHLDMAPL(I)%PTR%PHASE_INIT(PHASE), & userRC=userRC, RC=STATUS ) _ASSERT(userRC==ESMF_SUCCESS .and. STATUS==ESMF_SUCCESS,'needs informative message') + call CHLDMAPL(I)%ptr%t_profiler%stop('Initialize') + call CHLDMAPL(I)%ptr%t_profiler%stop() call MAPL_GenericStateClockOff(STATE,trim(CHILD_NAME)) + call t_p%stop(trim(CHILD_NAME)) end if end do deallocate(CHLDMAPL) @@ -1531,7 +1529,7 @@ recursive subroutine MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, RC ) enddo endif call MAPL_GenericStateClockOn(STATE,"--GenInitMine") - call state%t_profiler%start('Initialize_self') + call state%t_profiler%start('GenInitialize_self') ! Create import and initialize state variables ! -------------------------------------------- @@ -1678,8 +1676,8 @@ recursive subroutine MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, RC ) _VERIFY(STATUS) end if + call state%t_profiler%stop('GenInitialize_self') call MAPL_GenericStateClockOff(STATE,"--GenInitMine") - call state%t_profiler%stop('Initialize_self') if (.not. associated(STATE%parentGC)) then call MAPL_AdjustIsNeeded(GC, EXPORT, RC=STATUS) @@ -1689,9 +1687,7 @@ recursive subroutine MAPL_GenericInitialize ( GC, IMPORT, EXPORT, CLOCK, RC ) call MAPL_GenericStateClockOff(STATE,"GenInitTot") call MAPL_GenericStateClockOff(STATE,"TOTAL") - call state%t_profiler%stop('Initialize') - call state%t_profiler%stop() - if (state%compname /= 'EXTDATA') call t_p%stop(trim(state%compname)) + call state%t_profiler%stop('GenInitialize') ! Write Memory Use Statistics. ! ------------------------------------------- @@ -2169,6 +2165,7 @@ recursive subroutine MAPL_GenericFinalize ( GC, IMPORT, EXPORT, CLOCK, RC ) endif end if + call state%t_profiler%stop('Final_self') call MAPL_GenericStateClockOff(STATE,"--GenFinalMine") call MAPL_GenericStateClockOff(STATE,"GenFinalTot") call MAPL_GenericStateClockOff(STATE,"TOTAL") @@ -2176,7 +2173,6 @@ recursive subroutine MAPL_GenericFinalize ( GC, IMPORT, EXPORT, CLOCK, RC ) ! Write summary of profiled times !-------------------------------- - call state%t_profiler%stop('Final_self') call state%t_profiler%stop('Final') call state%t_profiler%stop() @@ -2391,11 +2387,11 @@ recursive subroutine MAPL_GenericRecord ( GC, IMPORT, EXPORT, CLOCK, RC ) end if END DO endif + call state%t_profiler%stop('Record_self') call MAPL_GenericStateClockOff(STATE,"--GenRecordMine") call MAPL_GenericStateClockOff(STATE,"GenRecordTot") call MAPL_GenericStateClockOff(STATE,"TOTAL") - call state%t_profiler%stop('Record_self') call state%t_profiler%stop('Record') call state%t_profiler%stop() call t_p%stop(trim(state%compname)) @@ -4318,6 +4314,7 @@ recursive integer function MAPL_AddChildFromMeta(META, NAME, GRID, & character(len=ESMF_MAXSTR) :: FNAME, PNAME type(ESMF_GridComp) :: pGC type(ESMF_Context_Flag) :: contextFlag + class(BaseProfiler), pointer :: t_p if (.not.associated(META%GCS)) then ! this is the first child to be added @@ -4330,6 +4327,7 @@ recursive integer function MAPL_AddChildFromMeta(META, NAME, GRID, & allocate(META%GCNameList(0), stat=status) _VERIFY(STATUS) end if + I = size(META%GCS) + 1 MAPL_AddChildFromMeta = I ! realloc GCS, gcnamelist @@ -4422,7 +4420,16 @@ recursive integer function MAPL_AddChildFromMeta(META, NAME, GRID, & CHILD_META%mapl_comm = META%mapl_comm CHILD_META%t_profiler = TimeProfiler(trim(NAME), comm_world = META%mapl_comm%esmf%comm ) + t_p => get_global_time_profiler() + + call t_p%start(trim(NAME)) + call CHILD_META%t_profiler%start() + call CHILD_META%t_profiler%start('SetService') call ESMF_GridCompSetServices ( META%GCS(I), SS, RC=status ) + call CHILD_META%t_profiler%stop('SetService') + call CHILD_META%t_profiler%stop() + call t_p%stop(trim(NAME)) + _VERIFY(STATUS) _RETURN(ESMF_SUCCESS) @@ -4835,13 +4842,16 @@ subroutine MAPL_GenericStateClockOn(STATE,NAME,RC) character(len=ESMF_MAXSTR), parameter :: IAm = "MAPL_GenericStateClockOn" integer :: STATUS, n + type(ESMF_VM) :: VM call MAPL_ProfClockOn(STATE%TIMES,NAME,RC=STATUS) _VERIFY(STATUS) ! WJ notes : will replace above code with below - !n = index(NAME,'-',.true.)+1 - !call state%t_profiler%start(trim(Name(n:))) + !call ESMF_VmGetCurrent(VM, rc=status) + !if (MAPL_AM_I_Root(VM))print*, trim(state%compname) //"::"//trim(name) // "::clock on " + n = index(NAME,'-',.true.)+1 + call state%t_profiler%start(trim(Name(n:))) _RETURN(ESMF_SUCCESS) end subroutine MAPL_GenericStateClockOn @@ -4906,13 +4916,16 @@ subroutine MAPL_GenericStateClockOff(STATE,NAME,RC) character(len=ESMF_MAXSTR), parameter :: IAm = "MAPL_GenericStateClockOff" integer :: STATUS, n + type(ESMF_VM) :: VM call MAPL_ProfClockOff(STATE%TIMES,NAME,RC=STATUS) _VERIFY(STATUS) ! WJ notes : will replace above code with below - !n = index(NAME,'-',.true.)+1 - !call state%t_profiler%stop(trim(Name(n:))) + n = index(NAME,'-',.true.)+1 + call state%t_profiler%stop(trim(Name(n:))) + !call ESMF_VmGetCurrent(VM, rc=status) + !if (MAPL_AM_I_Root(VM))print*, trim(state%compname) //"::"//trim(name) // "::clock off " _RETURN(ESMF_SUCCESS) end subroutine MAPL_GenericStateClockOff diff --git a/MAPL_Profiler/BaseProfiler.F90 b/MAPL_Profiler/BaseProfiler.F90 index 2d01b6108a4c..23a7211ee1ec 100644 --- a/MAPL_Profiler/BaseProfiler.F90 +++ b/MAPL_Profiler/BaseProfiler.F90 @@ -91,12 +91,23 @@ subroutine start_self(this) class(AbstractMeter), pointer :: t call this%stack%push_back(this%node) + + if( .not. this%stack%size() == 1) then + block + use MPI + integer :: rank, ierror + call MPI_Comm_rank(this%comm_world, rank, ierror) + if (rank == 0) then + print*,__FILE__,__LINE__,'nesting start called on self timer' + end if + end block + end if + t => this%node%get_meter() call t%start() end subroutine start_self - subroutine start_name(this, name) class(BaseProfiler), target, intent(inout) :: this character(*), intent(in) :: name @@ -152,14 +163,14 @@ subroutine stop_name(this, name) t => node%get_meter() if (name /= node%get_name()) then this%status = INCORRECTLY_NESTED_METERS - block - use MPI - integer :: rank, ierror - call MPI_Comm_rank(this%comm_world, rank, ierror) - if (rank == 0) then - print*,__FILE__,__LINE__,'stop called on non-bottom timer'//name - end if - end block + block + use MPI + integer :: rank, ierror + call MPI_Comm_rank(this%comm_world, rank, ierror) + if (rank == 0) then + print*,__FILE__,__LINE__,'stop called on non-bottom timer'//name + end if + end block return end if call t%stop() @@ -182,7 +193,6 @@ subroutine stop_self(this) print*,__FILE__,__LINE__,'stop called on self timer' end if end block - return end if node => this%stack%back() From d59fc1c8f075d7419565e4b8ae2b264f46dfcd02 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Mon, 13 Apr 2020 12:44:16 -0400 Subject: [PATCH 090/109] clean up --- MAPL_Base/MAPL_Generic.F90 | 12 ++---------- 1 file changed, 2 insertions(+), 10 deletions(-) diff --git a/MAPL_Base/MAPL_Generic.F90 b/MAPL_Base/MAPL_Generic.F90 index dea063ad171f..2fdba15f7f3b 100644 --- a/MAPL_Base/MAPL_Generic.F90 +++ b/MAPL_Base/MAPL_Generic.F90 @@ -4842,15 +4842,11 @@ subroutine MAPL_GenericStateClockOn(STATE,NAME,RC) character(len=ESMF_MAXSTR), parameter :: IAm = "MAPL_GenericStateClockOn" integer :: STATUS, n - type(ESMF_VM) :: VM call MAPL_ProfClockOn(STATE%TIMES,NAME,RC=STATUS) _VERIFY(STATUS) - ! WJ notes : will replace above code with below - !call ESMF_VmGetCurrent(VM, rc=status) - !if (MAPL_AM_I_Root(VM))print*, trim(state%compname) //"::"//trim(name) // "::clock on " - n = index(NAME,'-',.true.)+1 + n = index(NAME,'-',.true.) + 1 call state%t_profiler%start(trim(Name(n:))) _RETURN(ESMF_SUCCESS) @@ -4916,16 +4912,12 @@ subroutine MAPL_GenericStateClockOff(STATE,NAME,RC) character(len=ESMF_MAXSTR), parameter :: IAm = "MAPL_GenericStateClockOff" integer :: STATUS, n - type(ESMF_VM) :: VM call MAPL_ProfClockOff(STATE%TIMES,NAME,RC=STATUS) _VERIFY(STATUS) - ! WJ notes : will replace above code with below - n = index(NAME,'-',.true.)+1 + n = index(NAME,'-',.true.) + 1 call state%t_profiler%stop(trim(Name(n:))) - !call ESMF_VmGetCurrent(VM, rc=status) - !if (MAPL_AM_I_Root(VM))print*, trim(state%compname) //"::"//trim(name) // "::clock off " _RETURN(ESMF_SUCCESS) end subroutine MAPL_GenericStateClockOff From ffa092b71e2be3f7b77dbadf27f71fa6ad485e6e Mon Sep 17 00:00:00 2001 From: Sebastian David Eastham Date: Mon, 13 Apr 2020 18:01:55 -0400 Subject: [PATCH 091/109] Fix vertical flipping for 0-indexed arrays When flipping vertical arrays, ExtData is implicitly assuming that the array indexing starts from 1. However, 3-D arrays which are defined at the grid edges (e.g. cloud mass flux) are indexed beginning at 0 (i.e. TOA or surface). This commit makes the routine robust by explicitly flipping the arrays based on lbound:ubound, rather than 1:size. --- MAPL_Base/MAPL_ExtDataGridCompMod.F90 | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/MAPL_Base/MAPL_ExtDataGridCompMod.F90 b/MAPL_Base/MAPL_ExtDataGridCompMod.F90 index 9d6d71000cb7..d0a550462b6e 100644 --- a/MAPL_Base/MAPL_ExtDataGridCompMod.F90 +++ b/MAPL_Base/MAPL_ExtDataGridCompMod.F90 @@ -4506,7 +4506,7 @@ subroutine MAPL_ExtDataFlipVertical(item,filec,rc) type(ESMF_Field) :: Field,field1,field2 real, pointer :: ptr(:,:,:) real, allocatable :: ptemp(:,:,:) - integer :: lm + integer :: ls, le if (item%isVector) then @@ -4522,13 +4522,14 @@ subroutine MAPL_ExtDataFlipVertical(item,filec,rc) _VERIFY(STATUS) allocate(ptemp,source=ptr,stat=status) _VERIFY(status) - lm = size(ptr,3) - ptr(:,:,lm:1:-1) = ptemp(:,:,1:lm:+1) + ls = lbound(ptr,3) + le = ubound(ptr,3) + ptr(:,:,le:ls:-1) = ptemp(:,:,ls:le:+1) call ESMF_FieldGet(Field2,0,farrayPtr=ptr,rc=status) _VERIFY(STATUS) ptemp=ptr - ptr(:,:,lm:1:-1) = ptemp(:,:,1:lm:+1) + ptr(:,:,le:ls:-1) = ptemp(:,:,ls:le:+1) deallocate(ptemp) @@ -4544,8 +4545,9 @@ subroutine MAPL_ExtDataFlipVertical(item,filec,rc) _VERIFY(STATUS) allocate(ptemp,source=ptr,stat=status) _VERIFY(status) - lm = size(ptr,3) - ptr(:,:,lm:1:-1) = ptemp(:,:,1:lm:+1) + ls = lbound(ptr,3) + le = ubound(ptr,3) + ptr(:,:,le:ls:-1) = ptemp(:,:,ls:le:+1) deallocate(ptemp) end if From 3b09aae2cc69e3bceac1eeafa4d989d59e06bb5c Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Tue, 14 Apr 2020 00:14:44 -0400 Subject: [PATCH 092/109] re-position finalize timer --- MAPL_Base/MAPL_Generic.F90 | 19 +++++++++++++------ MAPL_Profiler/BaseProfiler.F90 | 27 +++++++++------------------ MAPL_Profiler/TextColumn.F90 | 2 +- 3 files changed, 23 insertions(+), 25 deletions(-) diff --git a/MAPL_Base/MAPL_Generic.F90 b/MAPL_Base/MAPL_Generic.F90 index 2fdba15f7f3b..7049abe583fa 100644 --- a/MAPL_Base/MAPL_Generic.F90 +++ b/MAPL_Base/MAPL_Generic.F90 @@ -1813,6 +1813,13 @@ subroutine MAPL_GenericWrapper ( GC, IMPORT, EXPORT, CLOCK, RC) call state%t_profiler%start(trim(sbrtn)) endif + if (method == ESMF_METHOD_FINALIZE ) then + call t_p%start(trim(state%compname)) + call state%t_profiler%start() + call state%t_profiler%start('Finalize') + endif + + if (associated(timers)) then do i = 1, size(timers) call MAPL_TimerOn (STATE,timers(i)) @@ -2036,9 +2043,9 @@ recursive subroutine MAPL_GenericFinalize ( GC, IMPORT, EXPORT, CLOCK, RC ) ! --------------------- t_p => get_global_time_profiler() - call t_p%start(trim(state%compname)) - call state%t_profiler%start() - call state%t_profiler%start('Final') + !call t_p%start(trim(state%compname)) + !call state%t_profiler%start() + !call state%t_profiler%start('Final') call MAPL_GenericStateClockOn(STATE,"TOTAL") call MAPL_GenericStateClockOn(STATE,"GenFinalTot") @@ -2173,7 +2180,7 @@ recursive subroutine MAPL_GenericFinalize ( GC, IMPORT, EXPORT, CLOCK, RC ) ! Write summary of profiled times !-------------------------------- - call state%t_profiler%stop('Final') + call state%t_profiler%stop('Finalize') call state%t_profiler%stop() if (.not. MAPL_ProfIsDisabled()) then @@ -2190,14 +2197,14 @@ recursive subroutine MAPL_GenericFinalize ( GC, IMPORT, EXPORT, CLOCK, RC ) call WRITE_PARALLEL(" ") end if + call t_p%stop(trim(state%compname)) + ! Clean-up !--------- !ALT call MAPL_GenericStateDestroy (STATE, RC=STATUS) _VERIFY(STATUS) - call t_p%stop(trim(state%compname)) - _RETURN(ESMF_SUCCESS) contains diff --git a/MAPL_Profiler/BaseProfiler.F90 b/MAPL_Profiler/BaseProfiler.F90 index 23a7211ee1ec..5976bcd3e02e 100644 --- a/MAPL_Profiler/BaseProfiler.F90 +++ b/MAPL_Profiler/BaseProfiler.F90 @@ -117,8 +117,15 @@ subroutine start_name(this, name) class(AbstractMeter), allocatable :: m if (this%stack%empty()) then - m = this%make_meter() - call node%add_child(name, m) !this%make_meter()) + block + use MPI + integer :: rank, ierror + call MPI_Comm_rank(MPI_COMM_WORLD, rank, ierror) + if (rank == 0) then + print*,'start name should not be empty: ', __FILE__,__LINE__,name + end if + end block + return else node => this%stack%back() if (.not. node%has_child(name)) then @@ -132,14 +139,6 @@ subroutine start_name(this, name) t => node%get_meter() call t%start() -!!$ block -!!$ use MPI -!!$ integer :: rank, ierror -!!$ call MPI_Comm_rank(MPI_COMM_WORLD, rank, ierror) -!!$ if (rank == 0) then -!!$ print*,'start: ', __FILE__,__LINE__,this%get_depth(),name -!!$ end if -!!$ end block end subroutine start_name @@ -151,14 +150,6 @@ subroutine stop_name(this, name) class(AbstractMeter), pointer :: t class(AbstractMeterNode), pointer :: node -!!$ block -!!$ use MPI -!!$ integer :: rank, ierror -!!$ call MPI_Comm_rank(MPI_COMM_WORLD, rank, ierror) -!!$ if (rank == 0) then -!!$ print*,'stop: ', __FILE__,__LINE__,this%get_depth(),name -!!$ end if -!!$ end block node => this%stack%back() t => node%get_meter() if (name /= node%get_name()) then diff --git a/MAPL_Profiler/TextColumn.F90 b/MAPL_Profiler/TextColumn.F90 index b257ea92bab8..e4ef7eb17072 100644 --- a/MAPL_Profiler/TextColumn.F90 +++ b/MAPL_Profiler/TextColumn.F90 @@ -103,7 +103,7 @@ end subroutine set_separator ! issue with allocatable arrays of deferred length strings. subroutine get_separator(this, separator) class(TextColumn), intent(in) :: this - character(*), intent(out) :: separator(:) + character(*), intent(inout) :: separator(:) integer :: w character(1) :: c From 89f7b688b12f7112dabe0c83a3d54e53f7c1e662 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Tue, 14 Apr 2020 01:02:12 -0400 Subject: [PATCH 093/109] fix timer --- MAPL_Base/MAPL_ExtDataGridCompMod.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/MAPL_Base/MAPL_ExtDataGridCompMod.F90 b/MAPL_Base/MAPL_ExtDataGridCompMod.F90 index 9d6d71000cb7..a4bdc47b783d 100644 --- a/MAPL_Base/MAPL_ExtDataGridCompMod.F90 +++ b/MAPL_Base/MAPL_ExtDataGridCompMod.F90 @@ -471,6 +471,8 @@ SUBROUTINE Initialize_ ( GC, IMPORT, EXPORT, CLOCK, rc ) end if if (.not.self%active) then + call MAPL_TimerOff(MAPLSTATE,"Initialize") + call MAPL_TimerOff(MAPLSTATE,"TOTAL") _RETURN(ESMF_SUCCESS) end if From e33600df9329ea27974ca5aa81649ac3668dcce1 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Tue, 14 Apr 2020 10:02:36 -0400 Subject: [PATCH 094/109] comment out the timers in TimerOn and Timeroff --- MAPL_Base/MAPL_Generic.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/MAPL_Base/MAPL_Generic.F90 b/MAPL_Base/MAPL_Generic.F90 index 7049abe583fa..c0f29e1ec218 100644 --- a/MAPL_Base/MAPL_Generic.F90 +++ b/MAPL_Base/MAPL_Generic.F90 @@ -4853,8 +4853,8 @@ subroutine MAPL_GenericStateClockOn(STATE,NAME,RC) call MAPL_ProfClockOn(STATE%TIMES,NAME,RC=STATUS) _VERIFY(STATUS) - n = index(NAME,'-',.true.) + 1 - call state%t_profiler%start(trim(Name(n:))) + !n = index(NAME,'-',.true.) + 1 + !call state%t_profiler%start(trim(Name(n:))) _RETURN(ESMF_SUCCESS) end subroutine MAPL_GenericStateClockOn @@ -4923,8 +4923,8 @@ subroutine MAPL_GenericStateClockOff(STATE,NAME,RC) call MAPL_ProfClockOff(STATE%TIMES,NAME,RC=STATUS) _VERIFY(STATUS) - n = index(NAME,'-',.true.) + 1 - call state%t_profiler%stop(trim(Name(n:))) + !n = index(NAME,'-',.true.) + 1 + !call state%t_profiler%stop(trim(Name(n:))) _RETURN(ESMF_SUCCESS) end subroutine MAPL_GenericStateClockOff From 3eafcec3d33fb742256d0d097ccad65d8fcbec11 Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Thu, 9 Apr 2020 11:45:19 -0400 Subject: [PATCH 095/109] Fixes #412 - Integrate support for pFlogger Added support to use pFlogger for logging - Command line option: --logging_config= - Each grid comp now has an associated logger with name given by the ancestry. E.g., CAP.GCM.AGCM.PHYSICS - Added warning message: When not providing pFlogger a yaml file, a warning message is emitted (to last_resort handler most likely). --- CHANGELOG.md | 7 +++- CMakeLists.txt | 2 + MAPL_Base/CMakeLists.txt | 4 +- MAPL_Base/MAPL_Cap.F90 | 13 ++++++- MAPL_Base/MAPL_CapGridComp.F90 | 65 +++++++++++++------------------ MAPL_Base/MAPL_CapOptions.F90 | 2 + MAPL_Base/MAPL_FlapCapOptions.F90 | 14 +++++++ MAPL_Base/MAPL_Generic.F90 | 37 +++++++++++++++++- MAPL_Base/MAPL_ShmemMod.F90 | 25 ++++++------ 9 files changed, 114 insertions(+), 55 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index f15407d8282d..20548fc139a8 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -21,6 +21,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Implemented workaround to cmake error that happens when building tests in parallel. - Set correct ESMA_env tag in `components.yaml` - Updated `components.yaml` to be inline with GEOSgcm +- Minor problem in GMAO_pFIO Cmakelists (consistency with PRIVATE) ### Removed @@ -33,8 +34,10 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Added configuration for CircleCI and Github Actions - Builds MAPL using GCC 9.2.0 and Open MPI 4.0.2 - Builds and runs `pFIO_tests` and `MAPL_Base_tests` - - Imported Python/MAPL subdir (old, but never imported to GitHub) - - Python automatic code generator for grid comp include files + - Imported Python/MAPL subdir (old, but never imported to GitHub) + - Python automatic code generator for grid comp include files + - Added support to use pFlogger for logging + - Command line option: --logging_config= ## [2.0.5] - 2020-04-13 diff --git a/CMakeLists.txt b/CMakeLists.txt index e63ee1f7dc44..a3996da4b732 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -35,6 +35,8 @@ endif() ecbuild_declare_project() +find_package(PFLOGGER REQUIRED) + # Special case - MAPL_cfio is built twice with two different precisions. add_subdirectory (MAPL_cfio MAPL_cfio_r4) add_subdirectory (MAPL_cfio MAPL_cfio_r8) diff --git a/MAPL_Base/CMakeLists.txt b/MAPL_Base/CMakeLists.txt index 03f79ffdf664..7e65916d6f4c 100644 --- a/MAPL_Base/CMakeLists.txt +++ b/MAPL_Base/CMakeLists.txt @@ -64,7 +64,9 @@ set (srcs FileMetadataUtilities.F90 FileMetadataUtilitiesVector.F90 ) -esma_add_library(${this} SRCS ${srcs} DEPENDENCIES MAPL_Profiler GMAO_pFIO MAPL_cfio_r4 gftl-shared FLAP::FLAP MPI::MPI_Fortran) +esma_add_library( + ${this} SRCS ${srcs} + DEPENDENCIES MAPL_Profiler GMAO_pFIO MAPL_cfio_r4 pflogger gftl-shared FLAP::FLAP MPI::MPI_Fortran) target_compile_options (${this} PRIVATE $<$:${OpenMP_Fortran_FLAGS}>) if(DISABLE_GLOBAL_NAME_WARNING) target_compile_options (${this} PRIVATE $<$:${DISABLE_GLOBAL_NAME_WARNING}>) diff --git a/MAPL_Base/MAPL_Cap.F90 b/MAPL_Base/MAPL_Cap.F90 index f16405da7b75..926af42d69be 100644 --- a/MAPL_Base/MAPL_Cap.F90 +++ b/MAPL_Base/MAPL_Cap.F90 @@ -17,6 +17,9 @@ module MAPL_CapMod use MAPL_Profiler use MAPL_ioClientsMod use MAPL_CapOptionsMod + use pflogger, only: initialize_pflogger => initialize + use pflogger, only: logging + use pflogger, only: Logger implicit none private @@ -88,6 +91,7 @@ function new_MAPL_Cap(name, set_services, unusable, cap_options, rc) result(cap) class ( MAPL_CapOptions), optional, intent(in) :: cap_options integer, optional, intent(out) :: rc integer :: status + type(Logger), pointer :: lgr cap%name = name cap%set_services => set_services @@ -106,9 +110,16 @@ function new_MAPL_Cap(name, set_services, unusable, cap_options, rc) result(cap) endif call cap%initialize_mpi(rc=status) - _VERIFY(status) + call initialize_pflogger() + if (cap%cap_options%logging_config /= '') then + call logging%load_file(cap%cap_options%logging_config) + else + lgr => logging%get_logger('MAPL') + call lgr%warning('No configure file specified for logging layer. Using defaults.') + end if + _RETURN(_SUCCESS) _UNUSED_DUMMY(unusable) end function new_MAPL_Cap diff --git a/MAPL_Base/MAPL_CapGridComp.F90 b/MAPL_Base/MAPL_CapGridComp.F90 index cff6615d4d08..d403c71fd106 100644 --- a/MAPL_Base/MAPL_CapGridComp.F90 +++ b/MAPL_Base/MAPL_CapGridComp.F90 @@ -24,6 +24,7 @@ module MAPL_CapGridCompMod use MAPL_DirPathMod use pFIO use gFTL_StringVector + use pflogger, only: logging, Logger use iso_fortran_env @@ -31,7 +32,6 @@ module MAPL_CapGridCompMod private character(*), parameter :: internal_cap_name = "InternalCapGridComp" - character(*), parameter :: internal_meta_comp_name = "InternalCapMetaComp" public :: MAPL_CapGridComp, MAPL_CapGridCompCreate, MAPL_CapGridComp_Wrapper @@ -70,10 +70,6 @@ module MAPL_CapGridCompMod type(MAPL_CapGridComp), pointer :: ptr => null() end type MAPL_CapGridComp_Wrapper - type :: MAPL_MetaComp_Wrapper - type(MAPL_MetaComp), pointer :: ptr => null() - end type MAPL_MetaComp_Wrapper - include "mpif.h" character(len=*), parameter :: Iam = __FILE__ @@ -90,7 +86,7 @@ subroutine MAPL_CapGridCompCreate(cap, mapl_comm, root_set_services, cap_rc, nam character(len=*), optional, intent(in) :: final_file type(MAPL_CapGridComp_Wrapper) :: cap_wrapper - type(MAPL_MetaComp_Wrapper) :: meta_comp_wrapper + type(MAPL_MetaComp), pointer :: meta integer :: status, rc @@ -110,9 +106,9 @@ subroutine MAPL_CapGridCompCreate(cap, mapl_comm, root_set_services, cap_rc, nam call ESMF_UserCompSetInternalState(cap%gc, internal_cap_name, cap_wrapper, status) _VERIFY(status) - allocate(meta_comp_wrapper%ptr) - call ESMF_UserCompSetInternalState(cap%gc, internal_meta_comp_name, meta_comp_wrapper, status) + call MAPL_InternalStateCreate(cap%gc, meta, rc=status) _VERIFY(status) + end subroutine MAPL_CapGridCompCreate @@ -167,18 +163,20 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) logical :: tend,foundPath - type (MAPL_MetaComp), pointer :: MAPLOBJ + type (MAPL_MetaComp), pointer :: maplobj type (MAPL_MetaComp), pointer :: CHILD_MAPLOBJ procedure(), pointer :: root_set_services type(MAPL_CapGridComp), pointer :: cap class(BaseProfiler), pointer :: t_p + class(Logger), pointer :: lgr _UNUSED_DUMMY(import_state) _UNUSED_DUMMY(export_state) _UNUSED_DUMMY(clock) cap => get_CapGridComp_from_gc(gc) - maplobj => get_MetaComp_from_gc(gc) + call MAPL_GetObjectFromGC(gc, maplobj, rc=status) + _VERIFY(status) t_p => get_global_time_profiler() @@ -210,9 +208,15 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) call MAPL_Set(MAPLOBJ, mapl_comm = cap%mapl_Comm, rc = status) _VERIFY(STATUS) - call MAPL_Set(MAPLOBJ, name = cap%name, cf = cap%config, rc = status) + call MAPL_Set(MAPLOBJ, name='CAP', cf = cap%config, rc = status) _VERIFY(status) + ! Note the call to GetLogger must be _after_ the call to MAPL_Set(). + ! That call establishes the name of this component which is used in + ! retrieving this component's logger. + call MAPL_GetLogger(gc, lgr, rc=status) + _VERIFY(status) + ! Check if user wants to use node shared memory (default is no) !-------------------------------------------------------------- call MAPL_GetResource(MAPLOBJ, useShmem, label = 'USE_SHMEM:', default = 0, rc = status) @@ -286,11 +290,9 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) endif if (cap%lperp) then - if (AmIRoot_) then - if (cap%perpetual_year /= -999 ) print *, 'Using Perpetual Year: ', cap%perpetual_year - if (cap%perpetual_month /= -999 ) print *, 'Using Perpetual Month: ', cap%perpetual_month - if (cap%perpetual_day /= -999 ) print *, 'Using Perpetual Day: ', cap%perpetual_day - endif + if (cap%perpetual_year /= -999) call lgr%info('Using Perpetual Year: %i0', cap%perpetual_year) + if (cap%perpetual_month /= -999) call lgr%info('Using Perpetual Month: %i0', cap%perpetual_month) + if (cap%perpetual_day /= -999) call lgr%info('Using Perpetual Day: %i0', cap%perpetual_day) call ESMF_ClockGet(cap%clock, name = clockname, rc = status) clockname = trim(clockname) // '_PERPETUAL' @@ -408,11 +410,8 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) call ESMF_ConfigGetAttribute(cap%cf_root, value=RUN_DT, Label="RUN_DT:", rc=status) if (STATUS == ESMF_SUCCESS) then if (heartbeat_dt /= run_dt) then - if (AmIRoot_) then - print *, "ERROR: inconsistent values of HEARTBEAT_DT and RUN_DT" - end if - call ESMF_VMBarrier(CAP%VM) - _RETURN(ESMF_FAILURE) + call lgr%error('inconsistent values of HEARTBEAT_DT (%g0) and root RUN_DT (%g0)', heartbeat_dt, run_dt) + _FAIL('inconsistent values of HEARTBEAT_DT and RUN_DT') end if else call MAPL_ConfigSetAttribute(cap%cf_root, value=heartbeat_dt, Label="RUN_DT:", rc=status) @@ -505,11 +504,8 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) call ESMF_ConfigGetAttribute(cap%cf_ext, value=RUN_DT, Label="RUN_DT:", rc=status) if (STATUS == ESMF_SUCCESS) then if (heartbeat_dt /= run_dt) then - if (AmIRoot_) then - print *, "ERROR: inconsistent values of HEATBEAT_DT and RUN_DT", heartbeat_dt, run_dt - end if - call ESMF_VMBarrier(CAP%VM) - _RETURN(ESMF_FAILURE) + call lgr%error('inconsistent values of HEARTBEAT_DT (%g0) and ExtData RUN_DT (%g0)', heartbeat_dt, run_dt) + _FAIL('inconsistent values of HEARTBEAT_DT and RUN_DT') end if else call MAPL_ConfigSetAttribute(cap%cf_ext, value=heartbeat_dt, Label="RUN_DT:", rc=status) @@ -781,7 +777,7 @@ subroutine finalize_gc(gc, import_state, export_state, clock, rc) integer :: status type(MAPL_CapGridComp), pointer :: cap - type(MAPL_MetaComp), pointer :: MAPLOBJ + type(MAPL_MetaComp), pointer :: maplobj class (BaseProfiler), pointer :: t_p _UNUSED_DUMMY(import_state) @@ -789,7 +785,8 @@ subroutine finalize_gc(gc, import_state, export_state, clock, rc) _UNUSED_DUMMY(clock) cap => get_CapGridComp_from_gc(gc) - MAPLOBJ => get_MetaComp_from_gc(gc) + call MAPL_GetObjectFromGC(gc, maplobj, rc=status) + _VERIFY(status) t_p => get_global_time_profiler() call t_p%start('Finalize') @@ -958,15 +955,6 @@ function get_CapGridComp_from_gc(gc) result(cap) end function get_CapGridComp_from_gc - function get_MetaComp_from_gc(gc) result(meta_comp) - type(ESMF_GridComp), intent(inout) :: gc - type(MAPL_MetaComp), pointer :: meta_comp - type(MAPL_MetaComp_Wrapper) :: meta_comp_wrapper - integer :: rc - call ESMF_UserCompGetInternalState(gc, internal_meta_comp_name, meta_comp_wrapper, rc) - meta_comp => meta_comp_wrapper%ptr - end function get_MetaComp_from_gc - function get_vec_from_config(config, key) result(vec) type(ESMF_Config), intent(inout) :: config @@ -1028,7 +1016,8 @@ subroutine run_MAPL_GridComp(gc, rc) procedure(), pointer :: root_set_services cap => get_CapGridComp_from_gc(gc) - MAPLOBJ => get_MetaComp_from_gc(gc) + call MAPL_GetObjectFromGC(gc, maplobj, rc=status) + _VERIFY(status) if (.not. cap%printspec > 0) then diff --git a/MAPL_Base/MAPL_CapOptions.F90 b/MAPL_Base/MAPL_CapOptions.F90 index ca3669353108..731b51141db5 100644 --- a/MAPL_Base/MAPL_CapOptions.F90 +++ b/MAPL_Base/MAPL_CapOptions.F90 @@ -30,6 +30,8 @@ module MAPL_CapOptionsMod ! ensemble options integer :: n_members = 1 character(:), allocatable :: ensemble_subdir_prefix + ! logging options + character(:), allocatable :: logging_config end type MAPL_CapOptions diff --git a/MAPL_Base/MAPL_FlapCapOptions.F90 b/MAPL_Base/MAPL_FlapCapOptions.F90 index 8a3aed1f79e7..cea574ddf09f 100644 --- a/MAPL_Base/MAPL_FlapCapOptions.F90 +++ b/MAPL_Base/MAPL_FlapCapOptions.F90 @@ -8,6 +8,7 @@ module MAPL_FlapCapOptionsMod use MAPL_KeywordEnforcerMod use MAPL_ErrorHandlingMod use MAPL_CapOptionsMod + use pflogger implicit none private @@ -163,6 +164,14 @@ subroutine add_command_line_options(options, unusable, rc) error=status) _VERIFY(status) + call options%add(switch='--logging_config', & + help='Configuration file for logging', & + required=.false., & + def='', & + act='store', & + error=status) + _VERIFY(status) + _RETURN(_SUCCESS) end subroutine add_command_line_options @@ -213,6 +222,10 @@ subroutine parse_command_line_arguments(this, unusable, rc) call this%cli_options%get(val=buffer, switch='--cap_rc', error=status); _VERIFY(status) this%cap_rc_file = trim(buffer) + ! Logging options + call this%cli_options%get(val=buffer, switch='--logging_config', error=status); _VERIFY(status) + this%logging_config = trim(buffer) + end subroutine parse_command_line_arguments subroutine set_esmf_logging_mode(this, flag_name, unusable, rc) @@ -238,4 +251,5 @@ subroutine set_esmf_logging_mode(this, flag_name, unusable, rc) _RETURN(_SUCCESS) end subroutine set_esmf_logging_mode + end module MAPL_FlapCapOptionsMod diff --git a/MAPL_Base/MAPL_Generic.F90 b/MAPL_Base/MAPL_Generic.F90 index c0f29e1ec218..eef69e7791b3 100644 --- a/MAPL_Base/MAPL_Generic.F90 +++ b/MAPL_Base/MAPL_Generic.F90 @@ -125,6 +125,7 @@ module MAPL_GenericMod use MAPL_LocStreamMod use MAPL_ConfigMod use MAPL_ErrorHandlingMod + use pFlogger, only: logging, Logger use, intrinsic :: ISO_C_BINDING use, intrinsic :: iso_fortran_env, only: REAL32, REAL64, int32, int64 use, intrinsic :: iso_fortran_env, only: OUTPUT_UNIT @@ -149,6 +150,7 @@ module MAPL_GenericMod public MAPL_GetObjectFromGC public MAPL_Get public MAPL_Set + public MAPL_InternalStateCreate public MAPL_GenericRunCouplers public MAPL_ChildAddAttribToImportSpec @@ -204,6 +206,7 @@ module MAPL_GenericMod public MAPL_CheckpointState public MAPL_ESMFStateReadFromFile public MAPL_InternalStateRetrieve + public :: MAPL_GetLogger !BOP ! !PUBLIC TYPES: @@ -398,6 +401,9 @@ module MAPL_GenericMod real :: HEARTBEAT type (MAPL_Communicators) :: mapl_comm type (TimeProfiler), public :: t_profiler + character(:), allocatable :: full_name ! Period separated list of ancestor names + class(Logger), pointer :: lgr + !!$ integer :: comm end type MAPL_MetaComp !EOC @@ -431,6 +437,7 @@ module MAPL_GenericMod type(MAPL_MetaComp), pointer :: PTR end type MAPL_MetaPtr +character(*), parameter :: SEPARATOR = '.' include "netcdf.inc" contains @@ -546,7 +553,6 @@ recursive subroutine MAPL_GenericSetServices ( GC, RC ) call MAPL_InternalStateRetrieve( GC, MAPLOBJ, RC=STATUS) _VERIFY(STATUS) - MAPLOBJ%COMPNAME = COMP_NAME call MAPLOBJ%t_profiler%start('GenSetService') @@ -4102,6 +4108,10 @@ subroutine MAPL_GenericStateSet (STATE, ORBIT, LM, RUNALARM, CHILDINIT, & if(present(NAME)) then STATE%COMPNAME=NAME + if (.not. allocated(state%full_name)) then + state%full_name = trim(name) + state%lgr => logging%get_logger(trim(name)) + end if endif if(present(Cf)) then @@ -4323,6 +4333,10 @@ recursive integer function MAPL_AddChildFromMeta(META, NAME, GRID, & type(ESMF_Context_Flag) :: contextFlag class(BaseProfiler), pointer :: t_p + class(Logger), pointer :: lgr + + lgr => logging%get_logger('MAPL.GENERIC') + if (.not.associated(META%GCS)) then ! this is the first child to be added allocate(META%GCS(0), stat=status) @@ -4423,6 +4437,12 @@ recursive integer function MAPL_AddChildFromMeta(META, NAME, GRID, & CHILD_META%parentGC = parentGC end if + + call lgr%debug('Adding logger for component %a ',trim(fname)) + child_meta%full_name = meta%full_name // SEPARATOR // trim(fname) + child_meta%compname = trim(fname) + child_meta%lgr => logging%get_logger(child_meta%full_name) + ! copy communicator to childs mapl_metacomp CHILD_META%mapl_comm = META%mapl_comm CHILD_META%t_profiler = TimeProfiler(trim(NAME), comm_world = META%mapl_comm%esmf%comm ) @@ -10257,4 +10277,19 @@ end subroutine set_arrdes_by_face end subroutine ArrDescrSetNCPar + subroutine MAPL_GetLogger(gc, lgr, rc) + type(ESMF_GridComp), intent(inout) :: gc + class(Logger), pointer :: lgr + integer, optional, intent(out) :: rc + type (MAPL_MetaComp), pointer :: meta + + integer :: status + + call MAPL_GetObjectFromGC(gc, meta, rc=status) + _VERIFY(status) + + lgr => meta%lgr + _RETURN(_SUCCESS) + end subroutine MAPL_GetLogger + end module MAPL_GenericMod diff --git a/MAPL_Base/MAPL_ShmemMod.F90 b/MAPL_Base/MAPL_ShmemMod.F90 index 416f7ded2486..1d692189fc93 100755 --- a/MAPL_Base/MAPL_ShmemMod.F90 +++ b/MAPL_Base/MAPL_ShmemMod.F90 @@ -8,6 +8,7 @@ module MAPL_ShmemMod use, intrinsic :: ISO_C_BINDING use, intrinsic :: ISO_FORTRAN_ENV, only: REAL64 use MAPL_ErrorHandlingMod + use pflogger, only: logging, Logger implicit none private @@ -1510,6 +1511,7 @@ function getNodeComm(Comm, rc) result(NodeComm) integer :: i1, i2 integer, allocatable :: newNode(:) + class(Logger), pointer :: lgr NodeComm=MPI_COMM_NULL @@ -1611,18 +1613,17 @@ function getNodeComm(Comm, rc) result(NodeComm) 1, MPI_INTEGER, MPI_MAX, comm, status ) _VERIFY(STATUS) + lgr => logging%get_logger('MAPL.SHMEM') + if(rank==0) then - print * - print *, "In MAPL_Shmem:" if (MAPL_CoresPerNodeMin == MAPL_CoresPerNodeMax) then - print *, " NumCores per Node = ", NumCores + call lgr%info("NumCores per Node = %i0", NumCores) else - print *, " NumCores per Node varies from ", & - MAPL_CoresPerNodeMin, " to ", MAPL_CoresPerNodeMax + call lgr%info("NumCores per Node varies from %i0 to %i0", & + MAPL_CoresPerNodeMin, MAPL_CoresPerNodeMax) end if - print *, " NumNodes in use = ", NumColors - print *, " Total PEs = ", npes - print * + call lgr%info("NumNodes in use = %i0", NumColors) + call lgr%info("Total PEs = %i0", npes) end if deallocate(names,stat=STATUS) @@ -1655,6 +1656,7 @@ function getNodeRootsComm(Comm, rc) result(NodeRootsComm) integer :: NodeRootsComm integer :: STATUS, MyColor, NumNodes, npes, rank + class(Logger), pointer :: lgr NodeRootsComm=MPI_COMM_NULL @@ -1685,11 +1687,10 @@ function getNodeRootsComm(Comm, rc) result(NodeRootsComm) _ASSERT(MAPL_MyNodeNum == rank+1,'needs informative message') endif + lgr => logging%get_logger('MAPL.SHMEM') + if(rank==0) then - print * - print *, "In MAPL_InitializeShmem (NodeRootsComm):" - print *, " NumNodes in use = ", NumNodes - print * + call lgr%info("NumNodes in use = %i0", NumNodes) end if _RETURN(SHM_SUCCESS) From 131e0b715cbf546c4517275bf7ec0fe08fcc933d Mon Sep 17 00:00:00 2001 From: William Putman Date: Tue, 14 Apr 2020 13:18:59 -0400 Subject: [PATCH 096/109] Added % memory used, and skipped init for estimating run time remaining --- MAPL_Base/MAPL_CapGridComp.F90 | 24 +++++++++++++--- MAPL_Base/MAPL_MemUtils.F90 | 51 ++++++++++++++++++++++++++++++++++ 2 files changed, 71 insertions(+), 4 deletions(-) diff --git a/MAPL_Base/MAPL_CapGridComp.F90 b/MAPL_Base/MAPL_CapGridComp.F90 index 926c8b20ba08..174b487cfed6 100644 --- a/MAPL_Base/MAPL_CapGridComp.F90 +++ b/MAPL_Base/MAPL_CapGridComp.F90 @@ -999,6 +999,16 @@ subroutine run_MAPL_GridComp(gc, rc) call cap%step(status) _VERIFY(status) + ! Reset loop average timer to get a better + ! estimate of true run time left by ignoring + ! initialization costs in the averageing. + !------------------------------------------- + if (n == 1) then + call ESMF_VMBarrier(cap%vm,rc=status) + _VERIFY(status) + cap%loop_start_timer = MPI_WTime(status) + endif + enddo TIME_LOOP ! end of time loop end if @@ -1019,7 +1029,8 @@ subroutine step(this, rc) real(kind=REAL64) :: LOOP_THROUGHPUT=0.0_REAL64 real(kind=REAL64) :: INST_THROUGHPUT=0.0_REAL64 real(kind=REAL64) :: RUN_THROUGHPUT=0.0_REAL64 - real :: mem_total, mem_commit, mem_percent + real :: mem_total, mem_commit, mem_committed_percent + real :: mem_used, mem_used_percent type(ESMF_Time) :: currTime type(ESMF_TimeInterval) :: delt @@ -1118,14 +1129,19 @@ subroutine step(this, rc) SEC_R = FLOOR(TIME_REMAINING - 3600.0*HRS_R - 60.0*MIN_R) ! Reset Inst timer START_TIMER=END_TIMER + ! Get percent of used memory + call MAPL_MemUsed ( mem_total, mem_used, mem_used_percent, RC=STATUS ) + _VERIFY(STATUS) ! Get percent of committed memory - call MAPL_MemCommited ( mem_total, mem_commit, mem_percent, RC=STATUS ) + call MAPL_MemCommited ( mem_total, mem_commit, mem_committed_percent, RC=STATUS ) _VERIFY(STATUS) if( mapl_am_I_Root(this%vm) ) write(6,1000) AGCM_YY,AGCM_MM,AGCM_DD,AGCM_H,AGCM_M,AGCM_S,& - LOOP_THROUGHPUT,INST_THROUGHPUT,RUN_THROUGHPUT,HRS_R,MIN_R,SEC_R,mem_percent + LOOP_THROUGHPUT,INST_THROUGHPUT,RUN_THROUGHPUT,HRS_R,MIN_R,SEC_R,& + mem_committed_percent,mem_used_percent 1000 format(1x,'AGCM Date: ',i4.4,'/',i2.2,'/',i2.2,2x,'Time: ',i2.2,':',i2.2,':',i2.2, & - 2x,'Throughput(days/day)[Avg Tot Run]: ',f6.1,1x,f6.1,1x,f6.1,2x,'TimeRemaining(Est) ',i3.3,':'i2.2,':',i2.2,2x,f5.1,'% Memory Committed') + 2x,'Throughput(days/day)[Avg Tot Run]: ',f6.1,1x,f6.1,1x,f6.1,2x,'TimeRemaining(Est) ',i3.3,':'i2.2,':',i2.2,2x, & + f5.1,'% : ',f5.1,'% Mem Comm:Used') _RETURN(ESMF_SUCCESS) end subroutine step diff --git a/MAPL_Base/MAPL_MemUtils.F90 b/MAPL_Base/MAPL_MemUtils.F90 index bb7726ef7e66..ea4db242fcdf 100755 --- a/MAPL_Base/MAPL_MemUtils.F90 +++ b/MAPL_Base/MAPL_MemUtils.F90 @@ -52,6 +52,7 @@ module MAPL_MemUtilsMod public MAPL_MemUtilsIsDisabled public MAPL_MemUtilsFree public MAPL_MemCommited + public MAPL_MemUsed #ifdef _CRAY public :: hplen @@ -449,6 +450,56 @@ end subroutine MAPL_MemUtilsWriteComm !####################################################################### +subroutine MAPL_MemUsed ( memtotal, used, percent_used, RC ) + +real, intent(out) :: memtotal, used, percent_used +integer, optional, intent(OUT ) :: RC + +! This routine returns the memory usage on Linux systems. +! It does this by querying a system file (file_name below). + +character(len=32) :: meminfo = '/proc/meminfo' +character(len=32) :: string +integer :: mem_unit +real :: multiplier, available + +character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_MemUtils:MAPL_MemUsed" +integer :: status + +#ifdef sysDarwin + memtotal = 0.0 + used = 0.0 + percent_used = 0.0 + RETURN_(ESMF_SUCCESS) +#endif + + multiplier = 1.0 + + call get_unit(mem_unit) + open(UNIT=mem_unit,FILE=meminfo,FORM='formatted',IOSTAT=STATUS) + VERIFY_(STATUS) + do; read (mem_unit,'(a)', end=20) string + if ( INDEX ( string, 'MemTotal:' ) == 1 ) then ! High Water Mark + read (string(10:LEN_TRIM(string)-2),*) memtotal + if (TRIM(string(LEN_TRIM(string)-1:)) == "kB" ) & + multiplier = 1.0/1024. ! Convert from kB to MB + memtotal = memtotal * multiplier + endif + if ( INDEX ( string, 'MemAvailable:' ) == 1 ) then ! Resident Memory + read (string(14:LEN_TRIM(string)-2),*) available + if (TRIM(string(LEN_TRIM(string)-1:)) == "kB" ) & + multiplier = 1.0/1024. ! Convert from kB to MB + available = available * multiplier + endif + enddo +20 close(mem_unit) + + used = memtotal-available + percent_used = 100.0*(used/memtotal) + + RETURN_(ESMF_SUCCESS) +end subroutine MAPL_MemUsed + subroutine MAPL_MemCommited ( memtotal, committed_as, percent_committed, RC ) real, intent(out) :: memtotal, committed_as, percent_committed From 767c271d28638c6442a636ed3b99d3fcde77d902 Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Tue, 14 Apr 2020 13:21:23 -0400 Subject: [PATCH 097/109] Fixed uninitialized variable bug present in base (develop). --- MAPL_Base/MAPL_Cap.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/MAPL_Base/MAPL_Cap.F90 b/MAPL_Base/MAPL_Cap.F90 index 926af42d69be..e830c6c8e0df 100644 --- a/MAPL_Base/MAPL_Cap.F90 +++ b/MAPL_Base/MAPL_Cap.F90 @@ -535,7 +535,7 @@ subroutine report_profiling(rc) if (my_rank == 0) then report_lines = reporter%generate_report(t_p) - write(*,'(a,1x,i0)')'Report on process: ', rank + write(*,'(a,1x,i0)')'Report on process: ', my_rank do i = 1, size(report_lines) write(*,'(a)') report_lines(i) end do From fb8100f929816b4113797ed4c3f78c45b92f64f0 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Tue, 7 Apr 2020 14:47:48 -0400 Subject: [PATCH 098/109] Move to the 6.0.10 image Various updates to support MAPL 2.1 * Update workflow.yml * Update config.yml * Add `-DMPIEXEC_PREFLAGS='--oversubscribe'` --- .circleci/config.yml | 4 ++-- .github/workflows/workflow.yml | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 48e8b101b43e..d288dd383a8b 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -3,7 +3,7 @@ version: 2.1 executors: gcc-build-env: docker: - - image: gmao/geos-build-env-gcc-source:6.0.4 + - image: gmao/geos-build-env-gcc-source:6.0.10 environment: OMPI_ALLOW_RUN_AS_ROOT: 1 OMPI_ALLOW_RUN_AS_ROOT_CONFIRM: 1 @@ -29,7 +29,7 @@ jobs: command: | mkdir build cd build - cmake .. -DBASEDIR=$BASEDIR/Linux -DCMAKE_Fortran_COMPILER=gfortran -DCMAKE_BUILD_TYPE=Debug + cmake .. -DBASEDIR=$BASEDIR/Linux -DCMAKE_Fortran_COMPILER=gfortran -DCMAKE_BUILD_TYPE=Debug -DMPIEXEC_PREFLAGS='--oversubscribe' - run: name: Build and install command: | diff --git a/.github/workflows/workflow.yml b/.github/workflows/workflow.yml index 2ba6b8a0b7d6..fa7c8f8797d0 100644 --- a/.github/workflows/workflow.yml +++ b/.github/workflows/workflow.yml @@ -5,7 +5,7 @@ on: pull_request jobs: build_mapl: runs-on: ubuntu-latest - container: gmao/geos-build-env-gcc-source:6.0.4 + container: gmao/geos-build-env-gcc-source:6.0.10 env: LANGUAGE: en_US.UTF-8 LC_ALL: en_US.UTF-8 @@ -32,7 +32,7 @@ jobs: run: | mkdir build cd build - cmake .. -DBASEDIR=$BASEDIR/Linux -DCMAKE_Fortran_COMPILER=gfortran -DCMAKE_BUILD_TYPE=Debug + cmake .. -DBASEDIR=$BASEDIR/Linux -DCMAKE_Fortran_COMPILER=gfortran -DCMAKE_BUILD_TYPE=Debug -DMPIEXEC_PREFLAGS='--oversubscribe' - name: Build run: | cd build From 4fd82b61ef2bcc3a0d3e22fe1148bcd599ec3561 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Tue, 14 Apr 2020 15:47:35 -0400 Subject: [PATCH 099/109] fix GNU --- MAPL_Base/MAPL_Cap.F90 | 4 +++- MAPL_Base/MAPL_Generic.F90 | 4 +++- MAPL_Profiler/FormattedTextColumn.F90 | 2 +- MAPL_Profiler/MemoryTextColumn.F90 | 2 +- MAPL_Profiler/MultiColumn.F90 | 2 +- MAPL_Profiler/NameColumn.F90 | 3 ++- MAPL_Profiler/ProfileReporter.F90 | 1 - MAPL_Profiler/TextColumn.F90 | 5 +++-- 8 files changed, 14 insertions(+), 9 deletions(-) diff --git a/MAPL_Base/MAPL_Cap.F90 b/MAPL_Base/MAPL_Cap.F90 index f16405da7b75..d2e1615a8e21 100644 --- a/MAPL_Base/MAPL_Cap.F90 +++ b/MAPL_Base/MAPL_Cap.F90 @@ -494,8 +494,10 @@ subroutine report_profiling(rc) type (MultiColumn) :: inclusive type (MultiColumn) :: exclusive integer :: npes, my_rank, rank, ierror + character(1) :: empty(0) - call reporter%add_column(NameColumn(50)) + reporter = ProfileReporter(empty) + call reporter%add_column(NameColumn(50, separator= " ")) call reporter%add_column(FormattedTextColumn('#-cycles','(i5.0)', 5, NumCyclesColumn(),separator='-')) inclusive = MultiColumn(['Inclusive'], separator='=') diff --git a/MAPL_Base/MAPL_Generic.F90 b/MAPL_Base/MAPL_Generic.F90 index c0f29e1ec218..6ca152610196 100644 --- a/MAPL_Base/MAPL_Generic.F90 +++ b/MAPL_Base/MAPL_Generic.F90 @@ -2215,13 +2215,15 @@ subroutine report_generic_profile( rc ) type (ProfileReporter) :: reporter type (MultiColumn) :: inclusive, exclusive type (ESMF_VM) :: vm + character(1) :: empty(0) call ESMF_VmGetCurrent(vm, rc=status) _VERIFY(STATUS) if (MAPL_AM_I_Root(vm)) then - call reporter%add_column(NameColumn(50)) + reporter = ProfileReporter(empty) + call reporter%add_column(NameColumn(50 , separator=" ")) call reporter%add_column(FormattedTextColumn('#-cycles','(i5.0)', 5, NumCyclesColumn(),separator='-')) inclusive = MultiColumn(['Inclusive'], separator='=') call inclusive%add_column(FormattedTextColumn(' T (sec) ','(f9.3)', 9, InclusiveColumn(), separator='-')) diff --git a/MAPL_Profiler/FormattedTextColumn.F90 b/MAPL_Profiler/FormattedTextColumn.F90 index 07685d58c268..07423176a52d 100644 --- a/MAPL_Profiler/FormattedTextColumn.F90 +++ b/MAPL_Profiler/FormattedTextColumn.F90 @@ -80,7 +80,7 @@ subroutine get_header(this, header) do i = 1, n0 header(i)(:) = this%header(i) end do - call this%get_separator(header(n0+1:n)) + call this%get_separator(header(n0+1), n-n0) call this%center(header) end subroutine get_header diff --git a/MAPL_Profiler/MemoryTextColumn.F90 b/MAPL_Profiler/MemoryTextColumn.F90 index 71c7b94edd4e..c067750d91f2 100644 --- a/MAPL_Profiler/MemoryTextColumn.F90 +++ b/MAPL_Profiler/MemoryTextColumn.F90 @@ -76,7 +76,7 @@ subroutine get_header(this, header) do i = 1, size(this%header) header(i)(:) = this%header(i)%string end do - call this%get_separator(header(size(this%header)+1:)) + call this%get_separator(header(size(this%header)+1), n - size(this%header)) call this%center(header) end subroutine get_header diff --git a/MAPL_Profiler/MultiColumn.F90 b/MAPL_Profiler/MultiColumn.F90 index 850555d04422..5221b9d449c9 100644 --- a/MAPL_Profiler/MultiColumn.F90 +++ b/MAPL_Profiler/MultiColumn.F90 @@ -126,7 +126,7 @@ recursive subroutine get_header(this, header) header(1:n_shared) = this%shared_header call this%center(header(1:n_shared)) - call this%get_separator(header(n_shared+1:shared_height)) + call this%get_separator(header(n_shared+1), shared_height - n_shared) c => this%columns%at(1) column_height = c%get_num_rows_header() diff --git a/MAPL_Profiler/NameColumn.F90 b/MAPL_Profiler/NameColumn.F90 index 835e08fba270..2c73d0a5c7cd 100644 --- a/MAPL_Profiler/NameColumn.F90 +++ b/MAPL_Profiler/NameColumn.F90 @@ -53,7 +53,8 @@ subroutine get_header(this, header) allocate(character(len=w) :: header(h)) header(1) = 'Name' - call this%get_separator(header(2:)) + if ( h <=1 ) return ! when separator is not in the constructor + call this%get_separator(header(2), h-1) end subroutine get_header diff --git a/MAPL_Profiler/ProfileReporter.F90 b/MAPL_Profiler/ProfileReporter.F90 index 1bf3e0d02c8f..14ff532bab7e 100644 --- a/MAPL_Profiler/ProfileReporter.F90 +++ b/MAPL_Profiler/ProfileReporter.F90 @@ -5,7 +5,6 @@ module MAPL_ProfileReporter use MAPL_TextColumnVector use MAPL_MultiColumn use MAPL_BaseProfiler - use MAPL_MultiColumn implicit none private diff --git a/MAPL_Profiler/TextColumn.F90 b/MAPL_Profiler/TextColumn.F90 index e4ef7eb17072..cef2ad6282f7 100644 --- a/MAPL_Profiler/TextColumn.F90 +++ b/MAPL_Profiler/TextColumn.F90 @@ -101,9 +101,10 @@ end subroutine set_separator ! Would be a function, but this is a workaround for gfortran 8.2 ! issue with allocatable arrays of deferred length strings. - subroutine get_separator(this, separator) + subroutine get_separator(this, separator, k) class(TextColumn), intent(in) :: this - character(*), intent(inout) :: separator(:) + character(*), intent(inout) :: separator(k) + integer, intent(in) :: k integer :: w character(1) :: c From 91aa18cf1ca8214942d818d69e6877cbebee65b1 Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Tue, 14 Apr 2020 16:02:13 -0400 Subject: [PATCH 100/109] flip declaration --- MAPL_Profiler/TextColumn.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/MAPL_Profiler/TextColumn.F90 b/MAPL_Profiler/TextColumn.F90 index cef2ad6282f7..a96a3f5ec73b 100644 --- a/MAPL_Profiler/TextColumn.F90 +++ b/MAPL_Profiler/TextColumn.F90 @@ -103,8 +103,8 @@ end subroutine set_separator ! issue with allocatable arrays of deferred length strings. subroutine get_separator(this, separator, k) class(TextColumn), intent(in) :: this - character(*), intent(inout) :: separator(k) integer, intent(in) :: k + character(*), intent(inout) :: separator(k) integer :: w character(1) :: c From a2b816ae6d4f35bf3c0bba9cb5d9d1f4975c04d2 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Wed, 15 Apr 2020 11:05:41 -0400 Subject: [PATCH 101/109] Fixes #310. Update components.yaml for MAPL 2.1 --- components.yaml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/components.yaml b/components.yaml index 4a839178e840..b35a1cfd01c4 100644 --- a/components.yaml +++ b/components.yaml @@ -1,13 +1,13 @@ env: local: ./@env remote: ../ESMA_env.git - tag: v2.0.4 + tag: v2.1.0 develop: master cmake: local: ./@cmake remote: ../ESMA_cmake.git - tag: v2.2.1 + tag: v3.0.0 develop: develop ecbuild: From 4e003f1579ab08b203a6f38ccb1f83b95d9cf7b9 Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Wed, 15 Apr 2020 22:09:12 -0400 Subject: [PATCH 102/109] Fixed new MemUtil utility. - The new routine will only work under SLES 12 as SLES 11 does not have "MemAvailable" in /proc/meminfo. - Even on SLES12 the implementation incorrectly fixed the multiplication factor twice. This fix probably needs further investigation on SLES 12. --- MAPL_Base/MAPL_MemUtils.F90 | 91 +++++++++++++++++++++---------------- 1 file changed, 51 insertions(+), 40 deletions(-) diff --git a/MAPL_Base/MAPL_MemUtils.F90 b/MAPL_Base/MAPL_MemUtils.F90 index ea4db242fcdf..27292607f802 100755 --- a/MAPL_Base/MAPL_MemUtils.F90 +++ b/MAPL_Base/MAPL_MemUtils.F90 @@ -450,55 +450,66 @@ end subroutine MAPL_MemUtilsWriteComm !####################################################################### -subroutine MAPL_MemUsed ( memtotal, used, percent_used, RC ) + subroutine MAPL_MemUsed ( memtotal, used, percent_used, RC ) -real, intent(out) :: memtotal, used, percent_used -integer, optional, intent(OUT ) :: RC + real, intent(out) :: memtotal, used, percent_used + integer, optional, intent(OUT ) :: RC -! This routine returns the memory usage on Linux systems. -! It does this by querying a system file (file_name below). + ! This routine returns the memory usage on Linux systems. + ! It does this by querying a system file (file_name below). -character(len=32) :: meminfo = '/proc/meminfo' -character(len=32) :: string -integer :: mem_unit -real :: multiplier, available + character(len=32) :: meminfo = '/proc/meminfo' + character(len=32) :: string + integer :: mem_unit + real :: multiplier, available -character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_MemUtils:MAPL_MemUsed" -integer :: status + character(len=ESMF_MAXSTR), parameter :: IAm="MAPL_MemUtils:MAPL_MemUsed" + integer :: status #ifdef sysDarwin - memtotal = 0.0 - used = 0.0 - percent_used = 0.0 - RETURN_(ESMF_SUCCESS) + memtotal = 0.0 + used = 0.0 + percent_used = 0.0 + RETURN_(ESMF_SUCCESS) +#else + available = -1 + memtotal = -1 #endif - multiplier = 1.0 - - call get_unit(mem_unit) - open(UNIT=mem_unit,FILE=meminfo,FORM='formatted',IOSTAT=STATUS) - VERIFY_(STATUS) - do; read (mem_unit,'(a)', end=20) string - if ( INDEX ( string, 'MemTotal:' ) == 1 ) then ! High Water Mark - read (string(10:LEN_TRIM(string)-2),*) memtotal - if (TRIM(string(LEN_TRIM(string)-1:)) == "kB" ) & - multiplier = 1.0/1024. ! Convert from kB to MB - memtotal = memtotal * multiplier - endif - if ( INDEX ( string, 'MemAvailable:' ) == 1 ) then ! Resident Memory - read (string(14:LEN_TRIM(string)-2),*) available - if (TRIM(string(LEN_TRIM(string)-1:)) == "kB" ) & - multiplier = 1.0/1024. ! Convert from kB to MB - available = available * multiplier - endif - enddo -20 close(mem_unit) - - used = memtotal-available - percent_used = 100.0*(used/memtotal) - RETURN_(ESMF_SUCCESS) -end subroutine MAPL_MemUsed + call get_unit(mem_unit) + open(UNIT=mem_unit,FILE=meminfo,FORM='formatted',IOSTAT=STATUS) + VERIFY_(STATUS) + do + read (mem_unit,'(a)', end=20) string + if ( index ( string, 'MemTotal:' ) == 1 ) then ! High Water Mark + read (string(10:LEN_trim(string)-2),*) memtotal + multiplier = 1.0 + if (trim(string(LEN_trim(string)-1:)) == "kB" ) & + multiplier = 1.0/1024. ! Convert from kB to MB + memtotal = memtotal * multiplier + endif + if ( index ( string, 'MemAvailable:' ) == 1 ) then ! Resident Memory + multiplier = 1.0 + read (string(14:LEN_trim(string)-2),*) available + if (trim(string(LEN_trim(string)-1:)) == "kB" ) & + multiplier = 1.0/1024. ! Convert from kB to MB + available = available * multiplier + endif + enddo +20 close(mem_unit) + + if (memtotal >= 0 .and. available >= 0) then + used = memtotal-available + percent_used = 100.0*(used/memtotal) + else + ! fail, but don't crash + used = -1 + percent_used = -1 + end if + + RETURN_(ESMF_SUCCESS) + end subroutine MAPL_MemUsed subroutine MAPL_MemCommited ( memtotal, committed_as, percent_committed, RC ) From 543eedcc52955333f611ae0471b93eaf017f4abc Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Thu, 16 Apr 2020 09:26:42 -0400 Subject: [PATCH 103/109] Mosty a bug fix. - Fixing issues associated with earlier attempt to let CapGridComp use more services from Generic. - Also throttling the warning message for absence of a logging config file to just root process. --- MAPL_Base/MAPL_Cap.F90 | 8 +++++--- MAPL_Base/MAPL_CapGridComp.F90 | 24 ++++++++---------------- 2 files changed, 13 insertions(+), 19 deletions(-) diff --git a/MAPL_Base/MAPL_Cap.F90 b/MAPL_Base/MAPL_Cap.F90 index 5dfe47785e2b..6ee61d6159a9 100644 --- a/MAPL_Base/MAPL_Cap.F90 +++ b/MAPL_Base/MAPL_Cap.F90 @@ -112,12 +112,14 @@ function new_MAPL_Cap(name, set_services, unusable, cap_options, rc) result(cap) call cap%initialize_mpi(rc=status) _VERIFY(status) - call initialize_pflogger() + call initialize_pflogger() if (cap%cap_options%logging_config /= '') then call logging%load_file(cap%cap_options%logging_config) else - lgr => logging%get_logger('MAPL') - call lgr%warning('No configure file specified for logging layer. Using defaults.') + if (cap%rank == 0) then + lgr => logging%get_logger('MAPL') + call lgr%warning('No configure file specified for logging layer. Using defaults.') + end if end if _RETURN(_SUCCESS) diff --git a/MAPL_Base/MAPL_CapGridComp.F90 b/MAPL_Base/MAPL_CapGridComp.F90 index 43947ec9c5d5..526a9912c505 100644 --- a/MAPL_Base/MAPL_CapGridComp.F90 +++ b/MAPL_Base/MAPL_CapGridComp.F90 @@ -97,18 +97,22 @@ subroutine MAPL_CapGridCompCreate(cap, mapl_comm, root_set_services, cap_rc, nam allocate(cap%final_file, source=final_file) end if + cap%config = ESMF_ConfigCreate(rc=status) + _VERIFY(status) + call ESMF_ConfigLoadFile(cap%config,cap%cap_rc_file,rc=STATUS) + _VERIFY(STATUS) + allocate(cap%name, source=name) + cap%gc = ESMF_GridCompCreate(name='MAPL_CapGridComp', config=cap%config, rc=status) + _VERIFY(status) - cap%gc = ESMF_GridCompCreate(name='MAPL_CapGridComp', rc=status) + call MAPL_InternalStateCreate(cap%gc, meta, rc=status) _VERIFY(status) cap_wrapper%ptr => cap call ESMF_UserCompSetInternalState(cap%gc, internal_cap_name, cap_wrapper, status) _VERIFY(status) - call MAPL_InternalStateCreate(cap%gc, meta, rc=status) - _VERIFY(status) - end subroutine MAPL_CapGridCompCreate @@ -194,23 +198,11 @@ subroutine initialize_gc(gc, import_state, export_state, clock, rc) cap%AmIRoot = AmIRoot_ - ! Open the CAP's configuration from CAP.rc - !------------------------------------------ - - cap%config = ESMF_ConfigCreate(rc = status) - _VERIFY(status) - - call ESMF_ConfigLoadFile(cap%config, cap%cap_rc_file, rc = status) - _VERIFY(status) - ! CAP's MAPL MetaComp !--------------------- call MAPL_Set(MAPLOBJ, mapl_comm = cap%mapl_Comm, rc = status) _VERIFY(STATUS) - call MAPL_Set(MAPLOBJ, name='CAP', cf = cap%config, rc = status) - _VERIFY(status) - ! Note the call to GetLogger must be _after_ the call to MAPL_Set(). ! That call establishes the name of this component which is used in ! retrieving this component's logger. From e96fc30330d17e667e6d65934f67f5fd2183611d Mon Sep 17 00:00:00 2001 From: Weiyuan Jiang Date: Thu, 16 Apr 2020 10:29:42 -0400 Subject: [PATCH 104/109] fix for debug. When passed in an empty string and attemped to step out of the boundary , the debug would crash --- MAPL_Profiler/FormattedTextColumn.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/MAPL_Profiler/FormattedTextColumn.F90 b/MAPL_Profiler/FormattedTextColumn.F90 index 07423176a52d..04e6ef1847fa 100644 --- a/MAPL_Profiler/FormattedTextColumn.F90 +++ b/MAPL_Profiler/FormattedTextColumn.F90 @@ -80,7 +80,8 @@ subroutine get_header(this, header) do i = 1, n0 header(i)(:) = this%header(i) end do - call this%get_separator(header(n0+1), n-n0) + + if (n>n0) call this%get_separator(header(n0+1), n-n0) call this%center(header) end subroutine get_header From 282ed546332c83312d1f1d1954ec1a47290ac9dd Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 16 Apr 2020 12:54:35 -0400 Subject: [PATCH 105/109] Fix for max_pe --- MAPL_Profiler/DistributedMeter.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/MAPL_Profiler/DistributedMeter.F90 b/MAPL_Profiler/DistributedMeter.F90 index 252b0b20dddb..d661dca85873 100644 --- a/MAPL_Profiler/DistributedMeter.F90 +++ b/MAPL_Profiler/DistributedMeter.F90 @@ -175,7 +175,7 @@ function reduce_distributed_real64(a, b) result(c) if (b%max > a%max) then c%max_pe = b%max_pe - elseif (a%max < b%max) then + elseif (a%max > b%max) then c%max_pe = a%max_pe else ! tie c%max_pe = min(a%max_pe, b%max_pe) From 4cc413e01be9ad921c28a6f739bd620b6447e799 Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 16 Apr 2020 12:58:34 -0400 Subject: [PATCH 106/109] Add MAPL_Profiler to CI tests --- .circleci/config.yml | 6 ++++++ .github/workflows/workflow.yml | 5 +++++ 2 files changed, 11 insertions(+) diff --git a/.circleci/config.yml b/.circleci/config.yml index d288dd383a8b..db31fe0261c5 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -47,6 +47,12 @@ jobs: cd build make -j2 MAPL_Base_tests ctest -R 'MAPL_Base_tests$' --output-on-failure + - run: + name: Run MAPL_Profiler Unit tests + command: | + cd build + make -j2 MAPL_Profiler_tests + ctest -R 'MAPL_Profiler_tests$' --output-on-failure workflows: version: 2.1 diff --git a/.github/workflows/workflow.yml b/.github/workflows/workflow.yml index fa7c8f8797d0..b03461cde922 100644 --- a/.github/workflows/workflow.yml +++ b/.github/workflows/workflow.yml @@ -47,3 +47,8 @@ jobs: cd build make -j4 MAPL_Base_tests ctest -R 'MAPL_Base_tests$' --output-on-failure + - name: Run MAPL_Profiler Unit tests + run: | + cd build + make -j4 MAPL_Profiler_tests + ctest -R 'MAPL_Profiler_tests$' --output-on-failure From 8cff585e2002eac49134fae9d168d45c87166d10 Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Thu, 16 Apr 2020 13:22:30 -0400 Subject: [PATCH 107/109] Update CMakeLists.txt --- CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index a3996da4b732..7370af60eef5 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -4,7 +4,7 @@ cmake_policy (SET CMP0054 NEW) project ( MAPL - VERSION 2.0 + VERSION 2.1.0 LANGUAGES Fortran CXX C) # Note - CXX is required for ESMF if (EXISTS ${CMAKE_CURRENT_LIST_DIR}/@cmake) From 520db159153e71c3af4c5cf7ea0021412728f706 Mon Sep 17 00:00:00 2001 From: Tom Clune Date: Thu, 16 Apr 2020 13:24:06 -0400 Subject: [PATCH 108/109] Update CHANGELOG.md --- CHANGELOG.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index aa25b20376d0..8152a49bfa55 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,6 +7,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ## [Unreleased] +## [2.1.0] 2020-04-16 + ### Changed - Corrected handling of Equation of Time in orbit (off by default) From 110faec87357f691b226f683615801c8fe59315e Mon Sep 17 00:00:00 2001 From: Matthew Thompson Date: Thu, 16 Apr 2020 13:25:56 -0400 Subject: [PATCH 109/109] Update CHANGELOG.md --- CHANGELOG.md | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 8152a49bfa55..340e7e002164 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,6 +7,11 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ## [Unreleased] +### Changed +### Fixed +### Removed +### Added + ## [2.1.0] 2020-04-16 ### Changed