Skip to content

Commit

Permalink
v.4.16 - deployed at AWS for CSU
Browse files Browse the repository at this point in the history 
  - lots of fixes

Signed-off-by: Ricolindo L Carino <Ricolindo.Carino@gmail.com>
  • Loading branch information
Ricolindo L Carino authored and Ricolindo L Carino committed May 13, 2013
1 parent ec82724 commit d880e19
Show file tree
Hide file tree
Showing 47 changed files with 4,676 additions and 3,481 deletions.
62 changes: 34 additions & 28 deletions ADVISING.F90
View file
Expand Up @@ -42,8 +42,8 @@ module ADVISING
#include "custom_advising.F90"


subroutine get_scholastic_three_terms (givenYear, givenTerm, UnitsPaid, UnitsDropped, UnitsPassed, Standing)
integer :: Standing, UnitsPaid, UnitsDropped, UnitsPassed, givenYear, givenTerm
subroutine get_scholastic_three_terms (std, givenYear, givenTerm, UnitsPaid, UnitsDropped, UnitsPassed, Standing)
integer :: std, Standing, UnitsPaid, UnitsDropped, UnitsPassed, givenYear, givenTerm
integer :: gdx, cdx, i, tUnits, performanceUnits, UnitsREGD, tHours
integer :: HoursPaid, HoursDropped, HoursPassed, HoursREGD
real :: pctFailed
Expand All @@ -56,37 +56,41 @@ subroutine get_scholastic_three_terms (givenYear, givenTerm, UnitsPaid, UnitsDro
HoursDropped = 0
HoursPassed = 0
HoursREGD = 0
do i=1,lenTCG
if (TCG(i)%ErrorCode/=0 .or. TCG(i)%Code/=2) cycle
! ignore not enrolled subjects
if (index(TCG(i)%txtLine, 'APE')>0) cycle ! not enrolled
if (index(TCG(i)%txtLine, 'REMOVAL')>0) cycle ! not enrolled
if (index(TCG(i)%txtLine, 'COMPLETION')>0) cycle ! not enrolled
!
if (TCG(i)%Year==givenYear .and. TCG(i)%Term==givenTerm) then

gdx = TCG(i)%Grade
cdx = TCG(i)%Subject
if (gdx>0 .and. cdx>0) then
tUnits = Subject(cdx)%Units
tHours = Subject(cdx)%LectHours+Subject(cdx)%LabHours
UnitsPaid = UnitsPaid + tUnits
HoursPaid = HoursPaid + tHours
if (gdx==gdxREGD) then
do i=1,Student(std)%Record(1,0)

! Record(i,:) 1=type,2=year,3=term,4=subject,5=grade
if (Student(std)%Record(1,i)/=1) cycle ! not FINALGRADE

if (Student(std)%Record(2,i)/=givenYear .or. &
Student(std)%Record(3,i)/=givenTerm) cycle

cdx = Student(std)%Record(4,i)
gdx = Student(std)%Record(5,i)
if (gdx>0 .and. cdx>0) then
tUnits = Subject(cdx)%Units
tHours = Subject(cdx)%LectHours+Subject(cdx)%LabHours
UnitsPaid = UnitsPaid + tUnits
HoursPaid = HoursPaid + tHours
if (gdx==gdxREGD) then
if (advisingPeriod) then ! currently registered
UnitsREGD = UnitsREGD + tUnits
HoursREGD = HoursREGD + tHours
else if (gdx==gdxDRP .or. gdx==gdxLOA) then
UnitsDropped = UnitsDropped + tUnits
HoursDropped = HoursDropped + tHours
else if (is_grade_passing(gdx) ) then
UnitsPassed = UnitsPassed + tUnits
HoursPassed = HoursPassed + tHours
else if (is_grade_passing(TCG(i)%ReExam,advisingPeriod) ) then
else ! assume passed
UnitsPassed = UnitsPassed + tUnits
HoursPassed = HoursPassed + tHours
end if
else if (gdx==gdxDRP .or. gdx==gdxLOA) then
UnitsDropped = UnitsDropped + tUnits
HoursDropped = HoursDropped + tHours
else if (is_grade_passing(gdx) ) then
UnitsPassed = UnitsPassed + tUnits
HoursPassed = HoursPassed + tHours
else if (is_grade_passing(TCG(i)%ReExam,advisingPeriod) ) then
UnitsPassed = UnitsPassed + tUnits
HoursPassed = HoursPassed + tHours
end if
end if

end do

Standing = 0
Expand Down Expand Up @@ -119,10 +123,11 @@ subroutine get_scholastic_three_terms (givenYear, givenTerm, UnitsPaid, UnitsDro
Standing = 1 ! no failures
end if
end if
return

end subroutine get_scholastic_three_terms



subroutine advise_all_students(UseCLASSES, Offering)
logical, intent (in) :: UseCLASSES
type (TYPE_OFFERED_SUBJECTS), intent(in) :: Offering(MAX_ALL_DUMMY_SUBJECTS:)
Expand All @@ -144,7 +149,8 @@ subroutine advise_all_students(UseCLASSES, Offering)
call advise_student (std, UseCLASSES, Offering, WaiverCOI(std), Advised(std), MissingPOCW, NRemaining)
end do

return

end subroutine advise_all_students


end module ADVISING
113 changes: 72 additions & 41 deletions BASE.F90
View file
Expand Up @@ -33,7 +33,7 @@ module BASE
implicit none

! software version
character(len= 7), parameter :: VERSION = ' v.4.13'
character(len= 7), parameter :: VERSION = ' v.4.16'

integer, parameter :: lenPasswordEncryptionKey = 16
character(len=lenPasswordEncryptionKey), parameter :: &
Expand All @@ -47,24 +47,23 @@ module BASE
character(len= 9), parameter :: mkdirCmd = 'mkdir -p '
character(len= 6), parameter :: mvCmd = 'mv -f '
character(len= 1), parameter :: DIRSEP = '/'
character(len= 8), parameter :: UPDATES = 'UPDATES/'
#else
! file separator; delete, directory, mkdir commands
character(len= 7), parameter :: delCmd = 'del /q '
character(len= 6), parameter :: mkdirCmd = 'mkdir '
character(len= 8), parameter :: mvCmd = 'move /y '
character(len= 1), parameter :: DIRSEP = '\'
character(len= 8), parameter :: UPDATES = 'UPDATES\'
#endif

! flag to control generation of backups
logical, parameter :: DO_NOT_BACKUP = .false. ! .false. ! create backups?

! from the command line
! the Academic Year
integer :: currentYear ! year of start of Academic Year
integer :: currentTerm ! current term 1=1st sem, 2=2nd sem; 3=summer
integer :: nextYear, nextTerm, targetTerm, termBegin, termEnd
integer :: cTm1Year, cTm1, cTm2Year, cTm2, cTm3Year, cTm3
logical :: advisingPeriod
! ACTION
character (len=20) :: ACTION
logical :: advisingPeriod, isActionClasslists, isActionAdvising

character(len=10) :: currentTime ! current time
character(len= 8) :: currentDate ! current date
Expand All @@ -88,20 +87,17 @@ module BASE
! data & output paths (set in MAIN.F90)
character (len=MAX_LEN_FILE_PATH) :: &
dirHEEDS, & ! HEEDS root directory
dirBAK, & ! directory for backup files
dirLOG, & ! directory for log files
dirRAW, & ! directory for raw data files
dirXML, & ! directory for XML data files
dirSUBSTITUTIONS, & ! directory for input/UNEDITED checklists from Registrar
dirTRANSCRIPTS, & ! directory for raw transcripts
dirEditedCHECKLISTS, & ! directory for output/EDITED checklists from College Secretaries
dirBACKUP, & ! directory for backup files
dirDATA, & ! directory for XML data files
dirSUBSTITUTIONS, & ! directory for subject substitutions
dirTRANSCRIPTS, & ! directory for individual enrollment records
pathToYear, pathToNextYear, & ! path data files for the year, next year
pathToTerm, & ! path to files of changes by stand-alone users
fileExecutable, & ! name of executable
CGI_PATH ! URI

! position of last character in dirXML (to simplify derivation of path to backup)
integer :: lenDirXML
! position of last character in dirDATA (to simplify derivation of path to backup)
integer :: lenDirDAT

! constants
character(len= 1), parameter :: &
Expand All @@ -114,7 +110,24 @@ module BASE
character(len=16), parameter :: HEXDIGITS = '0123456789ABCDEF'
character(len=24), parameter :: SPECIAL = '<>"#%{}|^~[]`;/?:=&$+().'

! 123456789A123456789B123456789C123456789D123456789E
! some HTML colors
character(len=20), parameter :: Blue = '<font color=#0000FF>'
character(len=20), parameter :: Fuchsia = '<font color=#FF00FF>'
character(len=20), parameter :: Gray = '<font color=#808080>'
character(len=20), parameter :: Green = '<font color=#008000>'
character(len=20), parameter :: Lime = '<font color=#00FF00>'
character(len=20), parameter :: Maroon = '<font color=#800000>'
character(len=20), parameter :: Navy = '<font color=#000080>'
character(len=20), parameter :: Olive = '<font color=#808000>'
character(len=20), parameter :: Purple = '<font color=#800080>'
character(len=20), parameter :: Red = '<font color=#FF0000>'
character(len=20), parameter :: Silver = '<font color=#C0C0C0>'
character(len=20), parameter :: Teal = '<font color=#008080>'
character(len=20), parameter :: White = '<font color=#FFFFFF>'
character(len=20), parameter :: Yellow = '<font color=#FFFF00>'
character(len= 7), parameter :: black='</font>'

! 123456789A123456789B123456789C123456789D123456789E
character(len= 5), parameter :: PROGNAME = 'HEEDS'
character(len=45), parameter :: COPYRIGHT = 'Copyright (C) 2012, 2013 Ricolindo L. Carino'
character(len=38), parameter :: EMAIL = 'Ricolindo.Carino@AcademicForecasts.com'
Expand Down Expand Up @@ -142,7 +155,6 @@ subroutine initialize_random_seed()

deallocate(seed)

return
end subroutine initialize_random_seed


Expand All @@ -159,7 +171,7 @@ subroutine encrypt(key, text)
i = i-1
if (i==0) i = lenKey
end do
return

end subroutine encrypt


Expand All @@ -168,10 +180,7 @@ subroutine decrypt(key, text)
character(len=*), intent (in out) :: text ! in=cipher, out=plaintext
integer :: i, j, k, lenKey, lenText, intText

#if defined PRODUCTION
#else
write(unitHTML,AFORMAT) '<!-- decrypt('//trim(text)//') -->'
#endif
call html_comment('decrypt('//trim(text)//')')

lenKey = len_trim(key)
lenText = len_trim(text)/2
Expand All @@ -184,7 +193,7 @@ subroutine decrypt(key, text)
if (i==0) i = lenKey
end do
text = text(lenText+1:) ! move to front
return

end subroutine decrypt


Expand All @@ -197,7 +206,7 @@ subroutine blank_to_underscore (inString, outString)
do i=1,l
if (outString(i:i)==SPACE) outString(i:i) = '_'
end do
return

end subroutine blank_to_underscore


Expand All @@ -210,7 +219,7 @@ subroutine underscore_to_blank (inString, outString)
do i=1,l
if (outString(i:i)=='_') outString(i:i) = SPACE
end do
return

end subroutine underscore_to_blank


Expand All @@ -224,7 +233,7 @@ subroutine upper_case(string)
if (string(i:i) .gt. 'z') cycle
string(i:i) = char(ichar(string(i:i))-32)
end do
return

end subroutine upper_case


Expand All @@ -238,7 +247,7 @@ subroutine lower_case(string)
if (string(i:i) .gt. 'Z') cycle
string(i:i) = char(ichar(string(i:i))+32)
end do
return

end subroutine lower_case


Expand Down Expand Up @@ -270,7 +279,7 @@ function atoi(inString)
end do
end if
atoi = num*pref
return

end function atoi


Expand Down Expand Up @@ -315,7 +324,7 @@ function atof(inString)
else
atof = num*pref
end if
return

end function atof


Expand All @@ -335,7 +344,7 @@ function itoa(num)
end do
if (num < 0) str10 = DASH//str10
itoa = str10
return

end function itoa


Expand Down Expand Up @@ -368,7 +377,6 @@ function ftoa(num, dadp)
if (num < 0) str10 = DASH//str10
ftoa = str10

return
end function ftoa


Expand All @@ -380,7 +388,7 @@ function itoabz(num)
else
itoabz = itoa(num)
end if
return

end function itoabz


Expand All @@ -404,7 +412,7 @@ function itoa2bz(num)
end do
end if
itoa2bz = str2
return

end function itoa2bz


Expand All @@ -430,7 +438,7 @@ function itoa3bz(num)
end do
end if
itoa3bz = str3
return

end function itoa3bz


Expand All @@ -451,7 +459,7 @@ subroutine index_to_delimiters(symbol, string, nsymbols, pos)
end if
end do
pos(nsymbols+1) = k+1
return

end subroutine index_to_delimiters


Expand All @@ -465,7 +473,6 @@ subroutine check_array_bound(current, limit, msg)
stop
end if

return
end subroutine check_array_bound


Expand All @@ -489,24 +496,48 @@ subroutine file_log_message(mesg1, mesg2, mesg3, mesg4, mesg5)

flush(unitLOG)

return
end subroutine file_log_message


subroutine move_to_backup(fname)
character (len=*), intent (in) :: fname ! must be in dirXML
character (len=*), intent (in) :: fname ! must be in dirDATA
character (len=MAX_LEN_FILE_PATH) :: path
integer :: iStat

if (noWrites) return ! no backups

path = trim(dirBAK)//fname(lenDirXML+1:)
path = trim(dirBACKUP)//fname(lenDirDAT+1:)
call rename (fname, path, iStat)
if (iStat/=0) call file_log_message('Status='//trim(itoa(iStat))//' in moving to '//trim(path) )

return
end subroutine move_to_backup


subroutine html_comment(str1, str2, str3, str4, str5)
character(len=*), intent(in) :: str1
character(len=*), intent(in), optional :: str2, str3, str4, str5

#if defined PRODUCTION
#else
if (present(str2)) then
write(unitHTML,AFORMAT) '<!--', trim(str1), trim(str2)
if (present(str3)) then
write(unitHTML,AFORMAT) trim(str3)
if (present(str4)) then
write(unitHTML,AFORMAT) trim(str4)
if (present(str5)) then
write(unitHTML,AFORMAT) trim(str5)
end if
end if
end if
write(unitHTML,AFORMAT) '--> '
else
write(unitHTML,AFORMAT) '<!-- '//trim(str1)//' -->'
end if
#endif

end subroutine html_comment


end module BASE

0 comments on commit d880e19

Please sign in to comment.