From d880e19de45c027b850fb7a0e1ce35efc60ed42d Mon Sep 17 00:00:00 2001 From: Ricolindo L Carino Date: Sun, 12 May 2013 21:05:01 -0500 Subject: [PATCH] v.4.16 - deployed at AWS for CSU - lots of fixes Signed-off-by: Ricolindo L Carino --- ADVISING.F90 | 62 +- BASE.F90 | 113 +- BLOCKS.F90 | 29 +- CGI.F90 | 96 +- CHECKLISTS.F90 | 934 +++----------- COLLEGES.F90 | 9 +- CURRICULA.F90 | 69 +- CUSTOM/custom_advising.F90 | 144 ++- CUSTOM/custom_checklists.F90 | 60 +- CUSTOM/custom_read_colleges.F90 | 2 +- CUSTOM/custom_read_curricula.F90 | 6 +- CUSTOM/custom_read_departments.F90 | 2 +- CUSTOM/custom_read_pre_enlistment.F90 | 121 ++ CUSTOM/custom_read_rooms.F90 | 2 +- CUSTOM/custom_read_students.F90 | 8 +- CUSTOM/custom_read_subjects.F90 | 8 +- CUSTOM/custom_read_teachers.F90 | 4 +- CUSTOM/custom_read_university.F90 | 2 +- CUSTOM/custom_reports.F90 | 9 +- DEMAND.F90 | 16 +- DEPARTMENTS.F90 | 14 +- EditBLOCKS.F90 | 66 +- EditCURRICULA.F90 | 51 +- EditENLISTMENT.F90 | 1719 +++++++++++++------------ EditPREDICTIONS.F90 | 825 ++++++------ EditROOMS.F90 | 226 ++-- EditSECTIONS.F90 | 202 ++- EditSUBJECTS.F90 | 8 +- EditTEACHERS.F90 | 78 +- EditUNIVERSITY.F90 | 4 +- GRADES.F90 | 24 +- HEEDS.bat | 121 ++ HTML.F90 | 791 ++++++++---- MAIN.F90 | 1166 +++++++++++++++-- PRE_ENLISTMENT.F90 | 223 +--- REPORTS.F90 | 31 +- ROOMS.F90 | 107 +- SECTIONS.F90 | 40 +- STUDENTS.F90 | 49 +- SUBJECTS.F90 | 72 +- TEACHERS.F90 | 34 +- TIMES.F90 | 29 +- TIMETABLES.F90 | 34 +- UNIVERSITY.F90 | 10 +- WAIVERS.F90 | 16 +- WEBSERVER.F90 | 406 +++++- XML.F90 | 115 +- 47 files changed, 4676 insertions(+), 3481 deletions(-) create mode 100644 CUSTOM/custom_read_pre_enlistment.F90 create mode 100644 HEEDS.bat diff --git a/ADVISING.F90 b/ADVISING.F90 index ad5cf83..52ed8a6 100644 --- a/ADVISING.F90 +++ b/ADVISING.F90 @@ -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 @@ -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 @@ -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:) @@ -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 diff --git a/BASE.F90 b/BASE.F90 index 43b9935..493d810 100644 --- a/BASE.F90 +++ b/BASE.F90 @@ -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 :: & @@ -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 @@ -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 :: & @@ -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 = '' + character(len=20), parameter :: Fuchsia = '' + character(len=20), parameter :: Gray = '' + character(len=20), parameter :: Green = '' + character(len=20), parameter :: Lime = '' + character(len=20), parameter :: Maroon = '' + character(len=20), parameter :: Navy = '' + character(len=20), parameter :: Olive = '' + character(len=20), parameter :: Purple = '' + character(len=20), parameter :: Red = '' + character(len=20), parameter :: Silver = '' + character(len=20), parameter :: Teal = '' + character(len=20), parameter :: White = '' + character(len=20), parameter :: Yellow = '' + character(len= 7), parameter :: black='' + + ! 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' @@ -142,7 +155,6 @@ subroutine initialize_random_seed() deallocate(seed) - return end subroutine initialize_random_seed @@ -159,7 +171,7 @@ subroutine encrypt(key, text) i = i-1 if (i==0) i = lenKey end do - return + end subroutine encrypt @@ -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) '' -#endif + call html_comment('decrypt('//trim(text)//')') lenKey = len_trim(key) lenText = len_trim(text)/2 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -270,7 +279,7 @@ function atoi(inString) end do end if atoi = num*pref - return + end function atoi @@ -315,7 +324,7 @@ function atof(inString) else atof = num*pref end if - return + end function atof @@ -335,7 +344,7 @@ function itoa(num) end do if (num < 0) str10 = DASH//str10 itoa = str10 - return + end function itoa @@ -368,7 +377,6 @@ function ftoa(num, dadp) if (num < 0) str10 = DASH//str10 ftoa = str10 - return end function ftoa @@ -380,7 +388,7 @@ function itoabz(num) else itoabz = itoa(num) end if - return + end function itoabz @@ -404,7 +412,7 @@ function itoa2bz(num) end do end if itoa2bz = str2 - return + end function itoa2bz @@ -430,7 +438,7 @@ function itoa3bz(num) end do end if itoa3bz = str3 - return + end function itoa3bz @@ -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 @@ -465,7 +473,6 @@ subroutine check_array_bound(current, limit, msg) stop end if - return end subroutine check_array_bound @@ -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) ' ' + else + write(unitHTML,AFORMAT) '' + end if +#endif + + end subroutine html_comment + + end module BASE diff --git a/BLOCKS.F90 b/BLOCKS.F90 index 0136a95..54c2f33 100644 --- a/BLOCKS.F90 +++ b/BLOCKS.F90 @@ -64,7 +64,7 @@ module BLOCKS subroutine initialize_block(B) type (TYPE_BLOCK) :: B B = TYPE_BLOCK ('Block Code', 'Block Name and Description', 0, 0, 0, 0, 0, 0, 0, 0) - return + end subroutine initialize_block @@ -93,7 +93,7 @@ function index_to_block(tBlock, NumBlocks, Block) end if end do index_to_block = sdx - return + end function index_to_block @@ -113,7 +113,7 @@ subroutine sort_alphabetical_blocks(NumBlocks, Block) end do end do call initialize_block(Block(kdx)) - return + end subroutine sort_alphabetical_blocks @@ -138,7 +138,7 @@ subroutine delete_blocks_from_dept(NumBlocks, Block, DeptIdx) end do NumBlocks = blk !write(*,*) NumBlocks, ' left' - return + end subroutine delete_blocks_from_dept @@ -162,7 +162,7 @@ subroutine delete_section_from_blocks(sect, NumSections, Section, NumBlocks, Blo !end do !call initialize_section(Section(NumSections)) !NumSections = NumSections - 1 - return + end subroutine delete_section_from_blocks @@ -184,17 +184,17 @@ subroutine xml_write_blocks(path, NumBlocks, Block, Section, iDept, dirOPT) if (present(dirOPT)) then fileName = trim(dirOPT)//trim(path)//'BLOCKS-'//trim(Department(iDept)%Code)//'.XML' else - fileName = trim(dirXML)//trim(path)//'BLOCKS-'//trim(Department(iDept)%Code)//'.XML' + fileName = trim(dirDATA)//trim(path)//'BLOCKS-'//trim(Department(iDept)%Code)//'.XML' endif else if (present(dirOPT)) then fileName = trim(dirOPT)//trim(path)//'BLOCKS.XML' else - fileName = trim(dirXML)//trim(path)//'BLOCKS.XML' + fileName = trim(dirDATA)//trim(path)//'BLOCKS.XML' endif end if - write(unitHTML,AFORMAT) '' + call html_comment('xml_write_blocks('//trim(fileName)//')') ! write file call xml_open_file(unitXML, XML_ROOT_BLOCKS, fileName, i) @@ -246,7 +246,7 @@ subroutine xml_write_blocks(path, NumBlocks, Block, Section, iDept, dirOPT) ! close file for blocks call xml_close_file(unitXML, XML_ROOT_BLOCKS) - return + end subroutine xml_write_blocks @@ -259,19 +259,19 @@ subroutine read_blocks(path, NumBlocks, Block, NumSections, Section, errNo) type (TYPE_BLOCK), dimension(0:), intent(out) :: Block integer, intent (out) :: errNo - integer :: ddx, ierr, mainEntries, numEntries, numUpdates, partialEntries + integer :: ddx, ierr, mainEntries, numEntries, numUpdates!, partialEntries logical :: noXML = .false. errNo = 0 ! no blocks is OK; none may be defined yet - fileName = trim(dirXML)//trim(path)//'BLOCKS.XML' + fileName = trim(dirDATA)//trim(path)//'BLOCKS.XML' call xml_read_blocks(fileName, NumBlocks, Block, NumSections, Section, ierr) numEntries = NumBlocks mainEntries = NumBlocks noXML = mainEntries==0 ! ! check for blocks edited by departments ! do ddx=2,NumDepartments-1 -! fileName = trim(dirXML)//UPDATES//trim(path)//'BLOCKS-'//trim(Department(ddx)%Code)//'.XML' +! fileName = trim(dirDATA)//trim(path)//'BLOCKS-'//trim(Department(ddx)%Code)//'.XML' ! call xml_read_blocks(fileName, NumBlocks, Block, NumSections, Section, ierr) ! partialEntries = NumBlocks-numEntries ! numEntries = NumBlocks @@ -283,7 +283,7 @@ subroutine read_blocks(path, NumBlocks, Block, NumSections, Section, errNo) numUpdates = NumBlocks-mainEntries if (NumBlocks==0) then ! really no XML BLOCKS files; try the custom format - fileName = trim(dirRAW)//trim(path)//'BLOCKS' + fileName = trim(dirDATA)//trim(path)//'BLOCKS' call custom_read_blocks(fileName, NumBlocks, Block, NumSections, Section, ierr) mainEntries = NumBlocks numUpdates = 0 @@ -307,7 +307,6 @@ subroutine read_blocks(path, NumBlocks, Block, NumSections, Section, errNo) if ( (noXML .and. NumBlocks>0) .or. numUpdates>0 ) & call xml_write_blocks(path, NumBlocks, Block, Section, 0) - return end subroutine read_blocks @@ -408,7 +407,6 @@ subroutine xml_read_blocks(fName, NumBlocks, Block, NumSections, Section, errNo) call xml_close_file(unitXML) call file_log_message (itoa(NumBlocks)//' blocks after reading '//fName) - return end subroutine xml_read_blocks @@ -505,7 +503,6 @@ subroutine custom_read_blocks(fName, NumBlocks, Block, NumSections, Section, err close (unitRAW) call file_log_message (itoa(NumBlocks)//' blocks after reading '//fName) - return end subroutine custom_read_blocks diff --git a/CGI.F90 b/CGI.F90 index 41b5ee2..975f403 100644 --- a/CGI.F90 +++ b/CGI.F90 @@ -54,23 +54,7 @@ module CGI /) ! some HTML tokens - character(len=20), parameter :: Blue = '' - character(len=20), parameter :: Fuchsia = '' - character(len=20), parameter :: Gray = '' - character(len=20), parameter :: Green = '' - character(len=20), parameter :: Lime = '' - character(len=20), parameter :: Maroon = '' - character(len=20), parameter :: Navy = '' - character(len=20), parameter :: Olive = '' - character(len=20), parameter :: Purple = '' - character(len=20), parameter :: Red = '' - character(len=20), parameter :: Silver = '' - character(len=20), parameter :: Teal = '' - character(len=20), parameter :: White = '' - character(len=20), parameter :: Yellow = '' - character(len= 7), parameter :: black='' character(len= 6), parameter :: nbsp=' ' - character(len=19), parameter :: tdaligncenter= '', thaligncenter= '' character(len=18), parameter :: tdalignright= '', thalignright= '' character(len=17), parameter :: thalignleft= '' @@ -180,7 +164,6 @@ subroutine cgi_url_encode(str_in, str_out) idx_out = idx_out + 1 ! advance idx_out by 1 end do - return end subroutine cgi_url_encode @@ -222,13 +205,9 @@ subroutine cgi_url_decode (str_in, str_out) idx_out = idx_out + 1 end do -#if defined PRODUCTION -#else - write(unitHTML,AFORMAT) '' -#endif + call html_comment('cgi_url_decode() = '//str_out) - return end subroutine cgi_url_decode @@ -267,15 +246,8 @@ subroutine cgi_get_name_value(string, lname, rvalue, ierr) string(i_start:) = cgi_wrk(j_end+1:) ! update string rvalue = cgi_wrk(:j_end-1) -#if defined PRODUCTION -#else - write(unitHTML,AFORMAT) '' -#endif - - !write(*,*) lname, '=', rvalue + call html_comment('cgi_get_name_value() : '//lname//'='//rvalue) - return end subroutine cgi_get_name_value @@ -296,7 +268,7 @@ subroutine cgi_get_named_string(string, lname, rvalue, ierr) call cgi_url_decode(tmp, rvalue) ! decode end if - return + end subroutine cgi_get_named_string @@ -315,7 +287,6 @@ subroutine cgi_get_named_integer(string, lname, rvalue, ierr) rvalue = atoi(cgi_int) ! convert end if - return end subroutine cgi_get_named_integer @@ -335,7 +306,6 @@ subroutine cgi_get_named_float(string, lname, rvalue, ierr) rvalue = atof(cgi_flt) ! convert end if - return end subroutine cgi_get_named_float @@ -351,12 +321,6 @@ subroutine cgi_get_wild_name_value(string, wild, lname, rvalue, ierr) integer :: w_start, i_start, j_end, l_string, l_lname, l_wild character(len=MAX_CGI_WRK_LEN) :: tmp -#if defined PRODUCTION -#else - write(unitHTML,AFORMAT) '' -#endif - ! default return values lname = ' ' rvalue = ' ' @@ -371,7 +335,7 @@ subroutine cgi_get_wild_name_value(string, wild, lname, rvalue, ierr) w_start = index(string, cgi_wrk(:l_wild)) if (w_start==0) then ! not found ierr = -1 - return + end if ! yes; collect lname @@ -396,7 +360,8 @@ subroutine cgi_get_wild_name_value(string, wild, lname, rvalue, ierr) tmp = cgi_wrk(:j_end-1) call cgi_url_decode(tmp, rvalue) ! decode - return + call html_comment('cgi_get_wild_name_value() : '//wild//lname//'= '//rvalue) + end subroutine cgi_get_wild_name_value @@ -416,25 +381,25 @@ subroutine FCGI_getquery( unitNo ) ! write to the beginning of file unitNo rewind (unitNo) -#if defined PRODUCTION -#else - write(unitNo,AFORMAT) '' -#endif + call html_comment('FCGI_getquery()') + + ! the remote IP + call get_environment_variable('REMOTE_ADDR', value=REMOTE_ADDR, length=iLen, status=i) + + call html_comment('REMOTE_ADDR='//REMOTE_ADDR//SPACE//itoa(iLen)//itoa(i)) ! QUERY_STRING (request method was GET) ? call get_environment_variable( "QUERY_STRING", value=QUERY_STRING, length=iLen ) + if ( iLen > 0 ) then -#if defined PRODUCTION -#else - write(unitNo, AFORMAT) '' -#endif + + call html_comment('QUERY_STRING='//QUERY_STRING(:iLen)) + else ! anything in CONTENT_LENGTH (request method was POST) ? call get_environment_variable( "CONTENT_LENGTH", value=cLen, length=iLen ) -#if defined PRODUCTION -#else - write(unitNo, AFORMAT) '' -#endif + call html_comment('CONTENT_LENGTH='//trim(cLen)) + if ( iLen > 0 ) then read( cLen, * ) iLen do i=1,iLen @@ -442,20 +407,10 @@ subroutine FCGI_getquery( unitNo ) QUERY_STRING( i:i ) = ch end do QUERY_STRING( iLen+1: ) = ' ' -#if defined PRODUCTION -#else - write(unitNo, AFORMAT) '' -#endif + call html_comment('CONTENT='//trim(QUERY_STRING)) end if endif - ! the remote IP - call get_environment_variable('REMOTE_ADDR', value=REMOTE_ADDR, length=iLen, status=i) -#if defined PRODUCTION -#else - write(unitNo, AFORMAT) '' -#endif - ! the requested script ('/' if none) call get_environment_variable('DOCUMENT_URI', value=DOCUMENT_URI) iLen = len_trim(DOCUMENT_URI) @@ -463,11 +418,8 @@ subroutine FCGI_getquery( unitNo ) ! default is / DOCUMENT_URI = '/' endif -#if defined PRODUCTION -#else - iLen = len_trim(DOCUMENT_URI) - write(unitNo, AFORMAT) '' -#endif + + call html_comment('DOCUMENT_URI='//DOCUMENT_URI(:iLen)) ! for other environment variables, see /conf/fastcgi_params @@ -481,10 +433,8 @@ subroutine FCGI_putfile ( unitNo ) integer, intent(in) :: unitNo integer :: iStat -#if defined PRODUCTION -#else - write(unitNo,AFORMAT) '' -#endif + call html_comment('FCGI_putfile()') + ! flush any pending writes flush(unitNo) diff --git a/CHECKLISTS.F90 b/CHECKLISTS.F90 index e96b035..ddef04b 100644 --- a/CHECKLISTS.F90 +++ b/CHECKLISTS.F90 @@ -115,7 +115,6 @@ subroutine xml_write_student_grades(std) ! generate file name idx = year_prefix(Student(std)) fileName = trim(dirTRANSCRIPTS)//trim(Student(std)%StdNo(1:idx))//DIRSEP//trim(Student(std)%StdNo)//'.XML' - !write(*,*) Student(std)%StdNo, Student(std)%StdNo(1:idx), trim(fileName) ! write file call xml_open_file(unitXML, XML_STUDENT_RECORD, fileName, idx) @@ -125,25 +124,12 @@ subroutine xml_write_student_grades(std) FSLASH//currentDate(5:6)//FSLASH//currentDate(7:8), & ' StdNo - Student number', & ' Name - Student name', & - ' Gender - M=male, F=female', & - ' Country - Country index; 1=Philippines', & - ' Curriculum - Curriculum code', & - ' Scholarship - Scholarship code', & - ' Classification - 0=undetermined; 1=NF, 2=SO, 3=JR, 4=SR', & ' Grade - YEAR,TERM,SUBJECT,GRADE', & ' ' call xml_write_character(unitXML, indent0, 'StdNo', Student(std)%StdNo) if (trim(Student(std)%Name)/='(not in directory)') & call xml_write_character(unitXML, indent0, 'Name', Student(std)%Name) -! if (Student(std)%Gender/=SPACE .and. Student(std)%Gender/='X') & -! call xml_write_character(unitXML, indent0, 'Gender', Student(std)%Gender) -! if (Student(std)%CountryIdx/=1) & -! call xml_write_integer(unitXML, indent0, 'Country', Student(std)%CountryIdx) -! if (Student(std)%CurriculumIdx/=0) & -! call xml_write_character(unitXML, indent0, 'Curriculum', Curriculum(Student(std)%CurriculumIdx)%Code) -! if (Student(std)%Classification/=-1) & -! call xml_write_integer(unitXML, indent0, 'Classification', Student(std)%Classification) do idx=1,Student(std)%Record(1,0) if (Student(std)%Record(4,idx)<=0) cycle call xml_write_character(unitXML, indent0, trim(txtGradeType(Student(std)%Record(1,idx))), & @@ -153,7 +139,7 @@ subroutine xml_write_student_grades(std) txtGrade(pGrade(Student(std)%Record(5,idx))) ) end do call xml_close_file(unitXML, XML_STUDENT_RECORD) - return + end subroutine xml_write_student_grades @@ -171,6 +157,8 @@ subroutine xml_write_substitutions(std) idx = year_prefix(Student(std)) fileName = trim(dirSUBSTITUTIONS)//trim(Student(std)%StdNo(1:idx))//DIRSEP//trim(Student(std)%StdNo)//'.XML' + call html_comment('xml_write_substitutions('//trim(filename)//')') + ! write file call xml_open_file(unitXML, XML_SUBSTITUTIONS, fileName, idx) write(unitXML,AFORMAT) & @@ -185,8 +173,10 @@ subroutine xml_write_substitutions(std) idxCURR = Student(std)%CurriculumIdx call xml_write_character(unitXML, indent0, 'StdNo', Student(std)%StdNo) + if (trim(Student(std)%Name)/='(not in directory)') & call xml_write_character(unitXML, indent0, 'Name', Student(std)%Name) + if (Student(std)%CurriculumIdx/=0) & call xml_write_character(unitXML, indent0, 'Curriculum', Curriculum(idxCURR)%Code) @@ -195,6 +185,7 @@ subroutine xml_write_substitutions(std) crse_required = Curriculum(idxCURR)%SubjectIdx(k) if (crse_required < 0) l = l + 1 end do + if (l>0) then write(unitXML,AFORMAT) ' ', & ' Substitutions for '//trim(Curriculum(idxCURR)%Code) @@ -211,77 +202,40 @@ subroutine xml_write_substitutions(std) end do write(unitXML,AFORMAT) ' ' end if -! l = 0 ! how many entries? -! do idx=1,lenTCG -! if (TCG(idx)%Code==1) l = l+1 -! end do -! if (l>0) then -! do idx=1,lenTCG -! if (TCG(idx)%Code/=1) cycle -! call rank_to_year_term(TCG(idx)%Term, Year, Term) -! -! !write(*,*) idx, trim(TCG(idx)%txtLine) -! call xml_write_character(unitXML, indent0, 'Substitution') -! call xml_write_character(unitXML, indent1, 'Year', txtYear(Year) ) -! call xml_write_character(unitXML, indent1, 'Term', txtSemester(Term) ) -! line = SPACE -! !write(*,*) 'xml_write_substitution : Required=', TCG(idx)%Reqd(0) -! do k=1,TCG(idx)%Reqd(0) -! -! !write(*,*) k, Subject(TCG(idx)%Reqd(k))%Name -! -! line = COMMA//trim(Subject(TCG(idx)%Reqd(k))%Name)//line -! end do -! call xml_write_character(unitXML, indent1, 'Required', line(2:)) -! line = SPACE -! !write(*,*) 'xml_write_substitution : Replacement=', TCG(idx)%Subst(0) -! do k=1,TCG(idx)%Subst(0) -! -! !write(*,*) k, Subject(TCG(idx)%Subst(k))%Name -! -! line = COMMA//trim(Subject(TCG(idx)%Subst(k))%Name)//line -! end do -! call xml_write_character(unitXML, indent1, 'Replacement', line(2:)) -! call xml_write_character(unitXML, indent0, '/Substitution') -! end do -! end if - -! write(unitXML,AFORMAT) & -! ' ', & -! ' # Entries = '//itoa(Student(std)%Reqd(0,0)), & -! ' ' + do idx=1,Student(std)%Reqd(0,0) - call rank_to_year_term(Student(std)%Reqd(-1,idx), Year, Term) + if (Student(std)%Reqd(0,idx)==0) cycle call xml_write_character(unitXML, indent0, 'Substitution') - call xml_write_character(unitXML, indent1, 'Year', txtYear(Year) ) - call xml_write_character(unitXML, indent1, 'Term', txtSemester(Term) ) + if (Student(std)%Reqd(-1,idx)>0) then + call rank_to_year_term(Student(std)%Reqd(-1,idx), Year, Term) + call xml_write_character(unitXML, indent1, 'Year', txtYear(Year) ) + call xml_write_character(unitXML, indent1, 'Term', txtSemester(Term) ) + end if + line = SPACE do k=1,Student(std)%Reqd(0,idx) - - !write(*,*) k, Subject(Student(std)%Reqd(k,idx))%Name - line = COMMA//trim(Subject(Student(std)%Reqd(k,idx))%Name)//line end do call xml_write_character(unitXML, indent1, 'Required', line(2:)) + line = SPACE - !write(*,*) 'xml_write_substitution : Replacement=', TCG(idx)%Subst(0) do k=1,Student(std)%Subst(0,idx) - - !write(*,*) k, Subject(Student(std)%Subst(k,idx))%Name - line = COMMA//trim(Subject(Student(std)%Subst(k,idx))%Name)//line end do call xml_write_character(unitXML, indent1, 'Replacement', line(2:)) + call xml_write_character(unitXML, indent0, '/Substitution') + end do call xml_close_file(unitXML, XML_SUBSTITUTIONS) - return + end subroutine xml_write_substitutions + subroutine xml_read_student_grades(std, errNo) integer, intent (in) :: std @@ -305,8 +259,10 @@ subroutine xml_read_student_grades(std, errNo) call xml_open_file(unitXML, XML_STUDENT_RECORD, fileName, errNo, forReading) if (errNo/=0) return + call html_comment('xml_read_student_grades('//trim(filename)//')') + + ! initialize using existing info - wrkStudent = Student(std) wrkStudent%Record = 0 ! examine the file line by line @@ -324,8 +280,9 @@ subroutine xml_read_student_grades(std, errNo) ! do nothing; should not change case ('Name') - call upper_case(value) - wrkStudent%Name = adjustl(value) + ! do nothing + !call upper_case(value) + !wrkStudent%Name = adjustl(value) case ('Gender') ! do nothing @@ -351,34 +308,37 @@ subroutine xml_read_student_grades(std, errNo) !wrkStudent%Classification = atoi(value) case default - call upper_case(tag) + + call upper_case(tag) ! APE, FINALGRADE, REMOVAL, COMPLETION + do grdType = 0,3 - if (trim(tag)==trim(txtGradeType(grdType))) then - call index_to_delimiters(COMMA, value, ndels, pos) - idx = wrkStudent%Record(1,0)+1 - wrkStudent%Record(1,idx) = grdType ! type - wrkStudent%Record(2,idx) = atoi(value(1:pos(2)-1)) ! year - tTerm = value(pos(2)+1:pos(3)-1) - call upper_case(tTerm) - wrkStudent%Record(3,idx) = index_to_term(tTerm) ! term - tSubject = value(pos(3)+1:pos(4)-1) - wrkStudent%Record(4,idx) = index_to_subject(tSubject) ! subject - tGrade = value(pos(4)+1:pos(5)-1) - gdx = index_to_grade(tGrade) ! grade - if (gdx==gdxREGD .and. .not. advisingPeriod) then - ! exclude - cycle - elseif (gdx<=0 .and. & - wrkStudent%Record(2,idx)==currentYear .and. & - wrkStudent%Record(3,idx)==currentTerm .and. & - advisingPeriod) then - gdx = gdxREGD - !write(*,*) wrkStudent%Record(2,idx), tTerm, tSubject, tGrade, gdx - end if - wrkStudent%Record(5,idx) = gdx - wrkStudent%Record(1,0) = idx - exit - end if + + if (trim(tag)/=trim(txtGradeType(grdType))) cycle + + call index_to_delimiters(COMMA, value, ndels, pos) + idx = wrkStudent%Record(1,0)+1 + wrkStudent%Record(1,idx) = grdType ! type + + wrkStudent%Record(2,idx) = atoi(value(1:pos(2)-1)) ! year + + tTerm = value(pos(2)+1:pos(3)-1) + call upper_case(tTerm) + wrkStudent%Record(3,idx) = index_to_term(tTerm) ! term + + tSubject = value(pos(3)+1:pos(4)-1) + wrkStudent%Record(4,idx) = index_to_subject(tSubject) ! subject + + tGrade = value(pos(4)+1:pos(5)-1) + gdx = index_to_grade(tGrade) ! grade +! if (gdx==gdxREGD) then ! registered +! if (.not. advisingPeriod) cycle ! exclude +! end if + wrkStudent%Record(5,idx) = gdx + + wrkStudent%Record(1,0) = idx ! number of records + + exit + end do end select @@ -387,27 +347,8 @@ subroutine xml_read_student_grades(std, errNo) call xml_close_file(unitXML) ! update student record - Student(std) = wrkStudent + Student(std)%Record = wrkStudent%Record - ! add to TCG - do idx=1,Student(std)%Record(1,0) ! Record(i,:) 1=type,2=year,3=term,4=subject,5=grade - lenTCG = lenTCG + 1 - !Grade,Year,Term,Subject,Section,Units,Grade - TCG(lenTCG)%txtLine = 'Grade,'// & - trim(itoa(Student(std)%Record(2,idx)))//COMMA// & - trim(txtSemester(Student(std)%Record(3,idx)))//COMMA// & - trim(Subject(Student(std)%Record(4,idx))%Name)//COMMA// & - trim(txtGradeType(Student(std)%Record(1,idx)))//COMMA// & - trim(ftoa(Subject(Student(std)%Record(4,idx))%Units,1))//COMMA// & - txtGrade(pGrade(Student(std)%Record(5,idx))) - TCG(lenTCG)%Code = 2 ! grade - TCG(lenTCG)%Year = Student(std)%Record(2,idx) - TCG(lenTCG)%Term = Student(std)%Record(3,idx) - TCG(lenTCG)%Subject = Student(std)%Record(4,idx) - TCG(lenTCG)%Grade = Student(std)%Record(5,idx) - end do - - return end subroutine xml_read_student_grades @@ -420,7 +361,7 @@ subroutine xml_read_substitutions(std, errNo) character(len=MAX_LEN_XML_TAG) :: tag character (len=MAX_LEN_TEXT_SEMESTER) :: tTerm character (len=MAX_LEN_TEXT_YEAR) :: tYear - integer :: idx + integer :: idx, lenSubst ! generate file name idx = year_prefix(Student(std)) @@ -430,6 +371,9 @@ subroutine xml_read_substitutions(std, errNo) call xml_open_file(unitXML, XML_SUBSTITUTIONS, fileName, errNo, forReading) if (errNo/=0) return + call html_comment('xml_read_substitutions('//trim(filename)//')') + + lenSubst = Student(std)%Reqd(0,0) ! how many records so far ! examine the file line by line do read(unitXML, AFORMAT, iostat=eof) line @@ -444,51 +388,29 @@ subroutine xml_read_substitutions(std, errNo) select case (trim(tag)) case ('Substitution') - call check_array_bound (lenTCG+1, MAX_LEN_STUDENT_RECORD, 'MAX_LEN_STUDENT_RECORD @ '//fileName) + call check_array_bound (lenSubst+1, MAX_SUBJECTS_IN_CURRICULUM/3, & + 'MAX_SUBJECTS_IN_CURRICULUM/3 @ '//fileName) case ('Year') ! value is one of FIRST, SECOND, THIRD, FOURTH, ... tYear = adjustl(value) - TCG(lenTCG+1)%Year = index_to_year(tYear) + Student(std)%Reqd(-1,lenSubst+1) = index_to_year(tYear) case ('Term') ! value is one of FIRST, SECOND, SUMMER tTerm = adjustl(value) - TCG(lenTCG+1)%Term = index_to_term(tTerm) + idx = index_to_term(tTerm) + if (Student(std)%Reqd(-1,lenSubst+1)>0 .and. idx>0) then + Student(std)%Reqd(-1,lenSubst+1) = 3*(Student(std)%Reqd(-1,lenSubst+1)-1)+idx + end if case ('Required') ! value is comma-separated list of subjects - call tokenize_subjects(value, ',', 5, TCG(lenTCG+1)%Reqd(0), TCG(lenTCG+1)%Reqd(1:), eof) - !write(*,*) 'Required=', TCG(lenTCG+1)%Reqd(0) + call tokenize_subjects(value, ',', 5, Student(std)%Reqd(0,lenSubst+1), Student(std)%Reqd(1:,lenSubst+1), eof) case ('Replacement') ! value is comma-separated list of subjects - call tokenize_subjects(value, ',', 5, TCG(lenTCG+1)%Subst(0), TCG(lenTCG+1)%Subst(1:), eof) - !write(*,*) 'Replacement=', TCG(lenTCG+1)%Subst(0) + call tokenize_subjects(value, ',', 5, Student(std)%Subst(0,lenSubst+1), Student(std)%Subst(1:,lenSubst+1), eof) case ('/Substitution') - ! PlanOfCoursework,Year,Term,Reqd(1),Reqd(2),...,Reqd(m),Subst(1),Subst(2),...,Subst(n) - lenTCG = lenTCG+1 - line = SPACE - do idx=TCG(lenTCG)%Subst(0),1,-1 - line = COMMA//trim(Subject(TCG(lenTCG)%Subst(idx))%Name)//line - end do - !write(*,*) 'Replacement='//trim(line(2:)) - do idx=TCG(lenTCG)%Reqd(0),1,-1 - line = COMMA//trim(Subject(TCG(lenTCG)%Reqd(idx))%Name)//line - end do - !write(*,*) 'Required='//trim(line(2:)) - if (TCG(lenTCG)%Term>=0 .and. TCG(lenTCG)%Term<=8) then - tTerm = txtSemester(TCG(lenTCG)%Term) - else - tTerm = SPACE - end if - line = COMMA//trim(tTerm)//line - - if (TCG(lenTCG)%Year>0 .and. TCG(lenTCG)%Year<18) then - tYear = txtYear(TCG(lenTCG)%Year) - else - tYear = SPACE - end if - TCG(lenTCG)%txtLine = 'PlanOfCoursework,'//trim(tYear)//line - TCG(lenTCG)%Code = 1 - TCG(lenTCG)%Used = .false. + lenSubst = lenSubst+1 + Student(std)%Reqd(0,0) = lenSubst case default @@ -497,33 +419,96 @@ subroutine xml_read_substitutions(std, errNo) end do call xml_close_file(unitXML) - return end subroutine xml_read_substitutions - subroutine read_student_records (std, DoNotRename) + subroutine read_student_records (std) integer, intent (in) :: std - logical, optional, intent (in) :: DoNotRename - integer :: i, j, k, tdx, ierr +#if defined UPLB + logical :: DoNotRename = .true. +#endif + integer :: ierr TCG = TYPE_STUDENT_RECORD (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, .false., SPACE, SPACE) lenTCG = 0 ! retrieve record of substitutions - call xml_read_substitutions(std, ierr) - if (ierr/=0) then - call custom_read_substitutions (std, DoNotRename) - call xml_write_substitutions(std) + if (Student(std)%Reqd(0,0)==0) then + call xml_read_substitutions(std, ierr) +#if defined UPLB + if (ierr/=0) then + call custom_read_substitutions (std, DoNotRename) + call xml_write_substitutions(std) + end if +#endif end if ! retrieve record of grades - call xml_read_student_grades(std, ierr) - if (ierr/=0) then - call custom_read_student_grades (std, DoNotRename) - call xml_write_student_grades(std) + if (Student(std)%Record(1,0)==0) then ! not yet retrieved + call xml_read_student_grades(std, ierr) +#if defined UPLB + if (ierr/=0) then + call custom_read_student_grades (std, DoNotRename) + call xml_write_student_grades(std) + end if +#endif end if + end subroutine read_student_records + + + + subroutine parse_student_records (std) + integer, intent (in) :: std + + integer :: i, j, k, idx, tdx + + ! add substitutions to TCG + do tdx=1,Student(std)%Reqd(0,0) + ! PlanOfCoursework,Year,Term,Reqd(1),Reqd(2),...,Reqd(m),Subst(1),Subst(2),...,Subst(n) + lenTCG = lenTCG+1 + line = SPACE + do idx=Student(std)%Subst(0,tdx),1,-1 + line = COMMA//trim(Subject(Student(std)%Subst(idx,tdx))%Name)//line + end do + !write(*,*) 'Replacement='//trim(line(2:)) + do idx=Student(std)%Reqd(0,tdx),1,-1 + line = COMMA//trim(Subject(Student(std)%Reqd(idx,tdx))%Name)//line + end do + if (Student(std)%Reqd(-1,tdx)>0) then + call rank_to_year_term(Student(std)%Reqd(-1,tdx), i, j) + TCG(lenTCG)%Year = i + TCG(lenTCG)%Term = j + TCG(lenTCG)%txtLine = 'PlanOfCoursework,'//trim(txtYear(i))//COMMA//trim(txtSemester(j))//line + else + TCG(lenTCG)%txtLine = 'PlanOfCoursework,,'//line + end if + TCG(lenTCG)%Reqd(0:5) = Student(std)%Reqd(0:5,tdx) + TCG(lenTCG)%Subst(0:5) = Student(std)%Subst(0:5,tdx) + TCG(lenTCG)%Code = 1 + TCG(lenTCG)%Used = .false. + end do + + ! add grades to TCG + do idx=1,Student(std)%Record(1,0) ! Record(i,:) 1=type,2=year,3=term,4=subject,5=grade + lenTCG = lenTCG + 1 + !Grade,Year,Term,Subject,Section,Units,Grade + TCG(lenTCG)%txtLine = 'Grade,'// & + trim(itoa(Student(std)%Record(2,idx)))//COMMA// & + trim(txtSemester(Student(std)%Record(3,idx)))//COMMA// & + trim(Subject(Student(std)%Record(4,idx))%Name)//COMMA// & + trim(txtGradeType(Student(std)%Record(1,idx)))//COMMA// & + trim(ftoa(Subject(Student(std)%Record(4,idx))%Units,1))//COMMA// & + txtGrade(pGrade(Student(std)%Record(5,idx))) + TCG(lenTCG)%Code = 2 ! grade + TCG(lenTCG)%Year = Student(std)%Record(2,idx) + TCG(lenTCG)%Term = Student(std)%Record(3,idx) + TCG(lenTCG)%Subject = Student(std)%Record(4,idx) + TCG(lenTCG)%Grade = Student(std)%Record(5,idx) + TCG(lenTCG)%Used = .false. + end do + ! compute when grades were received relative to baseYear do tdx=1,lenTCG if (TCG(tdx)%Code/=2) cycle @@ -555,630 +540,7 @@ subroutine read_student_records (std, DoNotRename) end do TCG(k) = TCG(k+1) - return - end subroutine read_student_records - - - subroutine custom_read_student_grades (std, DoNotRename) - integer, intent (in) :: std - logical, optional, intent (in) :: DoNotRename - character (len=MAX_LEN_TEXT_YEAR) :: tYear - character (len=MAX_LEN_TEXT_SEMESTER) :: tTerm - !type (TYPE_CURRICULUM) :: tCheckList - character (len=MAX_LEN_SUBJECT_CODE) :: tSubject, token - character (len=MAX_LEN_CURRICULUM_CODE) :: stdCurriculum - character (len=10) :: tSection - character (len=4) :: tGrade!, tUnits - integer :: idxCURR - integer :: i, j, k, cdx, eof, gdx, tdx - logical :: fileOK - - idxCURR = Student(std)%CurriculumIdx - StdNoYearLen = year_prefix(Student(std)) - fileTCG = trim(dirRAW)//'checklists'//DIRSEP//Student(std)%StdNo(1:StdNoYearLen)//DIRSEP//Student(std)%StdNo - - inquire (file=fileTCG, exist=fileOK) - if (fileOK) then - open(200, file=fileTCG, form='formatted', status='old') - - ! first line will indicate updated student info - read (200, AFORMAT, iostat = eof) line - call index_to_delimiters(COMMA, line, ndels, pos) - stdCurriculum = line(pos(5)+1:pos(6)-1) - idxCURR = index_to_curriculum(stdCurriculum) - if (stdCurriculum==SPACE .or. idxCURR==0) then ! first line does not contain student info - if (line(1:5)=='Grade') then - lenTCG = lenTCG + 1 - call check_array_bound (lenTCG, MAX_LEN_STUDENT_RECORD, 'MAX_LEN_STUDENT_RECORD @ '//fileTCG) - TCG(lenTCG)%txtLine = line - TCG(lenTCG)%Code = 0 - end if - else if (idxCURR<=0) then - idxCURR = -idxCURR - end if - if (idxCURR>0 .and. idxCURR/=Student(std)%CurriculumIdx) then - Student(std)%CurriculumIdx = idxCURR - isDirtySTUDENTS = .true. - write (unitLOG,AFORMAT) 'UPDATE: '//trim(line) - else ! revert - idxCURR = Student(std)%CurriculumIdx - end if - do - read (200, AFORMAT, iostat = eof) line - if (eof<0) exit - if (line(1:5)=='Grade') then - lenTCG = lenTCG + 1 - call check_array_bound (lenTCG, MAX_LEN_STUDENT_RECORD, 'MAX_LEN_STUDENT_RECORD @ '//fileTCG) - TCG(lenTCG)%txtLine = line - end if - end do - close(200) - - end if - - ! parse TCG; assume initial good academic standing, copy TCG to Record() - Student(std)%Record(1,0) = 0 - !tCheckList = Curriculum(idxCURR) - loop_tcg: & - do tdx=1,lenTCG - line = TCG(tdx)%txtLine - TCG(tdx)%Used = .false. - - i = index(line, '0A') - if (i>0) then - line(i+1:i+1) = 'a' - TCG(tdx)%txtLine(i+1:i+1) = 'a' - end if - - !write(*,*) trim(line) - - if (line(1:5)=='Grade') then - TCG(tdx)%Code = 2 - call index_to_delimiters(COMMA, line, ndels, pos) - !Grade,Year,Term,Subject,Section,Units,Grade - ! 1 2 3 4 5 6 7 - if (ndels<7) then - TCG(tdx)%ErrorCode = 5 - TCG(tdx)%errLine = ' ERROR : ' - TCG(tdx)%errLine(pos(ndels+1):) = ' ^ missing token(s)' - !write(*,AFORMAT) trim(TCG(tdx)%txtLine), trim(TCG(tdx)%errLine) - cycle loop_tcg - end if - tSection = adjustl(line(pos(5)+1:pos(6)-1)) - !tUnits = adjustl(line(pos(6)+1:pos(7)-1)) - tGrade = adjustl(line(pos(7)+1:pos(8)-1)) - tYear = adjustl(line(pos(2)+1:pos(3)-1)) - tTerm = adjustl(line(pos(3)+1:pos(4)-1)) - tSubject = adjustl(line(pos(4)+1:pos(5)-1)) - - !write(*,*) tYear, tTerm, tSubject, tSection, tUnits, tGrade - gdx = index_to_grade(tGrade) - !! exclude REGD subjects (i.e. "current")? - !if (gdx<0 .or. (gdx==gdxREGD .and. excludeREGD)) then - ! TCG(tdx)%ErrorCode = 16 - ! TCG(tdx)%errLine = ' ERROR : ' - ! TCG(tdx)%errLine(pos(7):) = ' ^ grade not valid, or REGD subjects excluded on purpose' - ! !write(*,AFORMAT) trim(TCG(tdx)%txtLine), trim(TCG(tdx)%errLine) - ! cycle loop_tcg - !end if - ! exclude invalid grades - if (gdx<=0) then - TCG(tdx)%ErrorCode = 16 - TCG(tdx)%errLine = ' ERROR : ' - TCG(tdx)%errLine(pos(7):) = ' ^ grade not valid' - !write(*,AFORMAT) trim(TCG(tdx)%txtLine), trim(TCG(tdx)%errLine) - cycle loop_tcg - end if - - ! check subject - cdx = index_to_subject(tSubject) - if (cdx==0) then - TCG(tdx)%ErrorCode = 18 - TCG(tdx)%errLine = ' ERROR : ' - TCG(tdx)%errLine(pos(4):) = ' ^ not in catalog' - !write(*,AFORMAT) trim(TCG(tdx)%txtLine), trim(TCG(tdx)%errLine) - cycle loop_tcg - end if - ! Gender-specific PE? Add M or F - - i = index(tSection, DASH) - if ( (tSubject(1:4)=='PE 2' .or. tSubject(1:4)=='PE 3') .and. & - i>0) then - tSubject = tSubject(1:4)//DASH//tSection(:i-1) - if (tSubject=='PE 2-BB' .or. tSubject=='PE 2-BS' .or. & - tSubject=='PE 2-JD' .or. tSubject=='PE 2-SF' .or. & - tSubject=='PE 2-SO' .or. tSubject=='PE 2-SW' .or. & - tSubject=='PE 2-FUT' .or. & - tSubject=='PE 2-VB' .or. tSubject=='PE 2-BD') then - tSubject = 'PE 2-'//Student(std)%Gender//tSubject(6:) - end if - k = index_to_subject(tSubject) - cdx = max(cdx, k) - end if - - ! Called from HTMLTranscripts? Do not renamed subject! - if (.not. present(DoNotRename)) then - k = index_to_new_subject(cdx) - if (k/=cdx) then - !write(*,*) trim(line)//' - subject taken as '//tSubject// & - ! ' renamed '//Subject(k)%Name - cdx = k - end if - end if - j = atoi(tYear) - k = index_to_term(tTerm) - if (k==3) j = j-1 ! make summer the end of the school year - - ! exclude future grades - if ( j>currentYear .or. (j==currentYear .and. k>currentTerm) ) cycle - - TCG(tdx)%Subject = cdx - TCG(tdx)%Grade = gdx - TCG(tdx)%Year = j - TCG(tdx)%Term = k - !write(*,*) trim(line)//' : ', j, k, cdx, gdx - - ! copy to RECORD() - i = Student(std)%Record(1,0) + 1 - Student(std)%Record(1,0) = i - Student(std)%Record(2,i) = j - Student(std)%Record(3,i) = k - Student(std)%Record(4,i) = cdx - Student(std)%Record(5,i) = gdx - ! record type - if (index(TCG(tdx)%txtLine, 'APE')>0) then - Student(std)%Record(1,i) = 0 - elseif (index(TCG(tdx)%txtLine, 'REMOVAL')>0) then - Student(std)%Record(1,i) = 2 - elseif (index(TCG(tdx)%txtLine, 'COMPLETION')>0) then - Student(std)%Record(1,i) = 3 - else - Student(std)%Record(1,i) = 1 - end if - - ! check for duplicates - do i=tdx-1,1,-1 - if (TCG(i)%Code/=2) cycle - if (TCG(i)%Subject/=cdx) cycle - if (TCG(i)%Grade/=gdx) cycle - if (TCG(i)%Year/=j) cycle - if (TCG(i)%Term/=k) cycle - ! duplicate: same subject, same grade, same semester - TCG(tdx)%Code = 0 - TCG(tdx)%ErrorCode = 15 - TCG(tdx)%errLine = ' ERROR : ' - TCG(tdx)%errLine(pos(2):) = ' ^ duplicate grade?' - !write(*,AFORMAT) trim(TCG(tdx)%txtLine), trim(TCG(tdx)%errLine) - ! erase from Record() - Student(std)%Record(1,0) = Student(std)%Record(1,0) - 1 - Student(std)%Record(:,Student(std)%Record(1,0)) = 0 - exit - end do - - end if - end do loop_tcg - ! match COMPLETIONS & REMOVALS with original grades - do tdx=1,lenTCG - if (TCG(tdx)%Code/=2) cycle - cdx = TCG(tdx)%Subject - if (index(TCG(tdx)%txtLine, 'REMOVAL')>0) then - k = 0 - if (Subject(cdx)%Name(1:4)/='PE 2' .and. Subject(cdx)%Name(1:4)/='PE 3') then - do j=lenTCG,1,-1 - if (TCG(j)%Code/=2) cycle - if (TCG(j)%Subject/=TCG(tdx)%Subject) cycle - if (TCG(j)%Grade/=gdx4) cycle - k = j - exit - end do - else - do j=lenTCG,1,-1 - if (TCG(j)%Code/=2) cycle - if (Subject(TCG(j)%Subject)%Name(1:4)/=Subject(cdx)%Name(1:4)) cycle - if (TCG(j)%Grade/=gdx4) cycle - k = j - exit - end do - end if - if (k>0) then - TCG(k)%ReExam = TCG(tdx)%Grade - ! WARNING: Uncommenting next line will cause errors in forecasting demand - ! TCG(tdx)%Code = -1 - else - write(unitLOG,AFORMAT) 'Original grade of 4 not found: '// & - Student(std)%StdNo//SPACE//trim(TCG(tdx)%txtLine) - end if - else if (index(TCG(tdx)%txtLine, 'COMPLETION')>0) then - k = 0 - if (Subject(cdx)%Name(1:4)/='PE 2' .and. Subject(cdx)%Name(1:4)/='PE 3') then - do j=lenTCG,1,-1 - if (TCG(j)%Code/=2) cycle - if (TCG(j)%Subject/=TCG(tdx)%Subject) cycle - if (TCG(j)%Grade/=gdxINC) cycle - k = j - exit - end do - else - do j=lenTCG,1,-1 - if (TCG(j)%Code/=2) cycle - if (Subject(TCG(j)%Subject)%Name(1:4)/=Subject(cdx)%Name(1:4)) cycle - if (TCG(j)%Grade/=gdxINC) cycle - k = j - exit - end do - end if - if (k>0) then - TCG(k)%ReExam = TCG(tdx)%Grade - ! WARNING: Uncommenting next line will cause errors in forecasting demand - ! TCG(tdx)%Code = -1 - else - write(unitLOG,AFORMAT) 'Original grade of INC not found: '// & - Student(std)%StdNo//SPACE//trim(TCG(tdx)%txtLine) - end if - end if - end do - - ! remove grade for "CHEM XX" subjects if grade for "CHEM XX.0" and/or "CHEM XX.1" are available - do tdx=1,lenTCG - tSubject = Subject(TCG(tdx)%Subject)%Name - if (tSubject == 'CHEM 40' .or. & - tSubject == 'CHEM 32' .or. & - tSubject == 'CHEM 17' .or. & - tSubject == 'CHEM 15' .or. & - tSubject == 'CHEM 16' .or. & - tSubject == 'CHEM 43' .or. & - tSubject == 'CHEM 44') then - - ! find "CHEM XX.0 and/or "CHEM XX.1" - token = trim(tSubject)//'.0' - cdx = index_to_subject(token) - token = trim(tSubject)//'.1' - gdx = index_to_subject(token) - j = 0 - do i=1,lenTCG - if (TCG(i)%Code/=2) cycle ! not a grade - if (TCG(i)%Subject/=cdx .and. TCG(i)%Subject/=gdx) cycle ! not CHEM XX.0 nor CHEM XX.1 - if (TCG(i)%Taken/=TCG(tdx)%Taken) cycle ! grade not in the same semester - j = i - exit - end do - if (j>0) then ! found - TCG(tdx)%Code = -1 - !write(*,*) 'Mistake : '//Student(std)%StdNo//DASH//trim(TCG(tdx)%txtLine) - end if - end if - end do - - return - end subroutine custom_read_student_grades - - - subroutine custom_read_substitutions (std, DoNotRename) - integer, intent (in) :: std - logical, optional, intent (in) :: DoNotRename - character (len=MAX_LEN_TEXT_YEAR) :: tYear - character (len=MAX_LEN_TEXT_SEMESTER) :: tTerm - type (TYPE_CURRICULUM) :: tCheckList - character (len=MAX_LEN_SUBJECT_CODE) :: token - integer :: q(MAX_LEN_STUDENT_RECORD) - integer :: idxCURR, pocw - integer :: i, j, k, cdx, eof, tdx - - idxCURR = Student(std)%CurriculumIdx - StdNoYearLen = year_prefix(Student(std)) - fileTCG = trim(dirRAW)//'checklists'//DIRSEP//Student(std)%StdNo(1:StdNoYearLen)//DIRSEP//Student(std)%StdNo - pocw = 0 ! no. of PlanOfStudy entries - - open(200, file=fileTCG, form='formatted', status='old', iostat=eof) - if (eof==0) then - do - read (200, AFORMAT, iostat=eof) line - if (eof<0) exit - if (line(1:16)=='PlanOfCoursework') then - lenTCG = lenTCG + 1 - pocw = pocw + 1 - call check_array_bound (lenTCG, MAX_LEN_STUDENT_RECORD, 'MAX_LEN_STUDENT_RECORD @ '//fileTCG) - if (line(17:22)==',PE 2,') line = line(1:16)//',,'//line(17:) - TCG(lenTCG)%txtLine = line - end if - end do - close(200) - end if - - if (pocw==0) then ! get default GE - fileTCG = trim(dirRAW)//trim(pathToYear)//'defaultGE' - !write(*,*) 'Looking into '//trim(fileTCG) - open(200, file=fileTCG, form='formatted', status='old', iostat=eof) - if (eof==0) then - do - read (200, AFORMAT, iostat = eof) line - if (eof<0) exit - if (line(1:1)=='#' .or. line(1:1)==SPACE) cycle - call index_to_delimiters(COMMA, line, ndels, pos) - if (line(1:pos(2)-1)/=trim(CurrProgCode(idxCURR))) cycle - lenTCG = lenTCG + 1 - call check_array_bound (lenTCG, MAX_LEN_STUDENT_RECORD, 'MAX_LEN_STUDENT_RECORD @ '//fileTCG) - TCG(lenTCG)%txtLine = line(pos(2)+1:) - !write(*,*) trim(TCG(lenTCG)%txtLine) - end do - close(200) - end if - end if - - ! parse TCG; assume initial good academic standing - tCheckList = Curriculum(idxCURR) - loop_tcg: & - do tdx=1,lenTCG - line = TCG(tdx)%txtLine - TCG(tdx)%Used = .false. - - i = index(line, '0A') - if (i>0) then - line(i+1:i+1) = 'a' - TCG(tdx)%txtLine(i+1:i+1) = 'a' - end if - - if (line(1:16)=='PlanOfCoursework') then - !write(*,*) tdx, trim(line) - ! PlanOfCoursework,Year,Term,Reqd(1),Reqd(2),...,Reqd(m),Subst(1),Subst(2),...,Subst(n) - !1 2 3 4 5 - call index_to_delimiters(COMMA, line, ndels, pos) - if (ndels<5) then - TCG(tdx)%ErrorCode = 25 - TCG(tdx)%errLine = ' ERROR : ' - TCG(tdx)%errLine(pos(ndels+1):) = ' ^ missing token(s)' - !write(*,AFORMAT) trim(TCG(tdx)%txtLine), trim(TCG(tdx)%errLine) - cycle loop_tcg - end if - tYear = line(pos(2)+1:pos(3)-1) - tTerm = line(pos(3)+1:pos(4)-1) - i = index_to_term(tTerm) - j = index_to_year(tYear) - if (i<0 .or. j==0) then - TCG(tdx)%ErrorCode = 1 - TCG(tdx)%errLine = ' WARNING : ' - TCG(tdx)%errLine(pos(3):) = ' ^ error in YEAR or TERM' - TCG(tdx)%Term = tCheckList%NumTerms ! last semester - else - TCG(tdx)%Term = (j-1)*3 + i - end if - ! check validity of tokens - q = 0 - do k=4,ndels - token = line(pos(k)+1:pos(k+1)-1) - - ! add gender to certain PE 2 activities - if (token=='PE 2-BB' .or. token=='PE 2-BS' .or. & - token=='PE 2-JD' .or. token=='PE 2-SF' .or. & - token=='PE 2-SO' .or. token=='PE 2-SW' .or. & - token=='PE 2-FUT' .or. & - token=='PE 2-VB' .or. token=='PE 2-BD') then - token = 'PE 2-'//Student(std)%Gender//token(6:) - end if - - i = index_to_subject(token) - if (i/=0) then - if (.not. present(DoNotRename)) then - j = index_to_new_subject(i) - if (j/=i) then - ! write(*,*) Student(std)%StdNo//' - in plan of study: '//token// & - ! ' renamed '//Subject(j)%Name - i = j - end if - q(k) = i - end if - else - TCG(tdx)%ErrorCode = 30 - TCG(tdx)%errLine = ' ERROR : ' - TCG(tdx)%errLine(pos(k):) = ' ^ not in catalog' - !write(*,AFORMAT) trim(TCG(tdx)%txtLine), trim(TCG(tdx)%errLine) - cycle loop_tcg - end if - end do - - ! determine which are required, which are not - do j=4,ndels - token = Subject(q(j))%Name - if (token=='ADDITIONAL') then - i = TCG(tdx)%Reqd(0) + 1 - TCG(tdx)%Reqd(0) = i - TCG(tdx)%Reqd(i) = q(j) - else - k = index_of_subject_in_curriculum(tCheckList, q(j)) - if (k==0) then ! not in curriculum - if (q(j)<0) then ! dummy subject that is not in curriculum - TCG(tdx)%ErrorCode = 40 - TCG(tdx)%errLine = ' ERROR : ' - TCG(tdx)%errLine(pos(j):) = ' ^ not in curriculum; extra dummy?' - - !write(*,AFORMAT) trim(TCG(tdx)%txtLine), trim(TCG(tdx)%errLine) - cycle loop_tcg - !else if (token(1:4)=='PE 2') then ! extra PE 2 choice - ! i = TCG(tdx)%Reqd(0) + 1 - ! TCG(tdx)%Reqd(0) = i - ! TCG(tdx)%Reqd(i) = q(j) - else ! other named subject that is not in curriculum - i = TCG(tdx)%Subst(0) + 1 - TCG(tdx)%Subst(0) = i - TCG(tdx)%Subst(i) = q(j) - - !write(*,*) token//' - other named subject that is not in curriculum' - end if - else ! required in curriculum - ! check if prior token is dummy - if (j>4 .and. q(j-1)<0) then ! PlanOfStudy,Year,Term,dummy,Reqd (added previously) - i = TCG(tdx)%Subst(0) + 1 - TCG(tdx)%Subst(0) = i - TCG(tdx)%Subst(i) = q(j) - - !write(*,*) token//' - named subject for a dummy in curriculum' - else ! j=4 .or. previous is not a dummy (therefore, substitution?) - i = TCG(tdx)%Reqd(0) + 1 - TCG(tdx)%Reqd(0) = i - TCG(tdx)%Reqd(i) = q(j) - - !write(*,*) token//' - named subject/dummy that is in curriculum' - end if - - end if - end if - end do - - ! if (m==0 or n==0) then - ! ERROR - if (TCG(tdx)%Reqd(0)==0) then - TCG(tdx)%ErrorCode = 50 - TCG(tdx)%errLine = ' ERROR : ' - TCG(tdx)%errLine(pos(4):) = ' ^ required subject is missing or is extra?' - - !write(*,AFORMAT) trim(TCG(tdx)%txtLine), trim(TCG(tdx)%errLine) - cycle loop_tcg - else if (TCG(tdx)%Reqd(0)*TCG(tdx)%Subst(0)==0) then - TCG(tdx)%ErrorCode = 50 - TCG(tdx)%errLine = ' ERROR : ' - TCG(tdx)%errLine(pos(5):) = ' ^ subject is missing or is a duplicate?' - - !write(*,AFORMAT) trim(TCG(tdx)%txtLine), trim(TCG(tdx)%errLine) - cycle loop_tcg - end if - ! else if (m==1) then - ! if (Reqd(1)==ADDITIONAL) then - ! ADD Subst(1) to Year,Term in curriculum - if (TCG(tdx)%Reqd(0)==1) then - token = Subject(TCG(tdx)%Reqd(1))%Name - if (token=='ADDITIONAL') then - i = tCheckList%NSubjects - do j = 1,TCG(tdx)%Subst(0) - tCheckList%NSubjects = i+j - tCheckList%SubjectTerm(i+j) = TCG(tdx)%Term - tCheckList%SubjectIdx(i+j) = TCG(tdx)%Subst(j) - end do - ! else if (Reqd(1) is a dummy subject) then - ! REPLACE Reqd(1) in Year,Term of curriculum with Subst(1) - else if (TCG(tdx)%Reqd(1)<0) then - k = 0 - do i=1,tCheckList%NSubjects - if (tCheckList%SubjectTerm(i)==TCG(tdx)%Term .and. & - tCheckList%SubjectIdx(i)==TCG(tdx)%Reqd(1)) then - k = i - exit - end if - end do - if (k>0) then ! found exact position in curriculum - tCheckList%SubjectIdx(k) = TCG(tdx)%Subst(1) - else ! find a similar dummy not in specified term - do i=1,tCheckList%NSubjects - if (tCheckList%SubjectIdx(i)==TCG(tdx)%Reqd(1)) then - k = i - exit - end if - end do - if (k>0) then ! found one similar dummy - tCheckList%SubjectIdx(k) = TCG(tdx)%Subst(1) - TCG(tdx)%ErrorCode = 1 - TCG(tdx)%errLine = ' WARNING : ' - TCG(tdx)%errLine(pos(3):) = ' ^ error in YEAR or TERM' - else ! none found - TCG(tdx)%ErrorCode = 1 - TCG(tdx)%errLine = ' WARNING : ' - TCG(tdx)%errLine(pos(4):) = ' ^ not used; extra dummy?' - end if - end if - ! else if (Reqd(1) is a named subject) then - ! REPLACE Reqd(1) with Subst(1..n) - ! end if - else ! if (TCG(tdx)%Reqd(1)>0) then - k = 0 - do i=1,tCheckList%NSubjects - if (tCheckList%SubjectIdx(i)==TCG(tdx)%Reqd(1)) then - k = i - exit - end if - end do - if (k>0) then ! found exact position in curriculum - tCheckList%SubjectIdx(k) = TCG(tdx)%Subst(1) - i = tCheckList%NSubjects - do j = 2,TCG(tdx)%Subst(0) - tCheckList%NSubjects = i+j-1 - tCheckList%SubjectTerm(i+j-1) = tCheckList%SubjectTerm(k) - tCheckList%SubjectIdx(i+j-1) = TCG(tdx)%Subst(j) - end do - else ! not found - TCG(tdx)%ErrorCode = 1 - TCG(tdx)%errLine = ' WARNING : ' - TCG(tdx)%errLine(pos(4):) = ' ^ not used; duplicate entry?' - end if - end if - ! else {group substitution} - else - ! do i=1,min(m,n) - ! REPLACE Reqd(i) with Susbt(i) - ! end do - do cdx=1,min( TCG(tdx)%Reqd(0), TCG(tdx)%Subst(0) ) - k = 0 - do i=1,tCheckList%NSubjects - if (tCheckList%SubjectIdx(i)==TCG(tdx)%Reqd(cdx)) then - k = i - exit - end if - end do - if (k>0) then ! found exact position in curriculum - tCheckList%SubjectIdx(k) = TCG(tdx)%Subst(cdx) - else ! not found - TCG(tdx)%ErrorCode = 1 - TCG(tdx)%errLine = ' WARNING : ' - TCG(tdx)%errLine(pos(4):) = ' ^ not used; duplicate entry?' - end if - end do - ! do i=min(m,n)+1,m - ! REMOVE Reqd(i) - ! end do - do cdx=min( TCG(tdx)%Reqd(0), TCG(tdx)%Subst(0) )+1, TCG(tdx)%Reqd(0) - k = 0 - do i=1,tCheckList%NSubjects - if (tCheckList%SubjectIdx(i)==TCG(tdx)%Reqd(cdx)) then - k = i - exit - end if - end do - if (k>0) then ! found exact position in curriculum - tCheckList%SubjectIdx(k) = 0 - end if - end do - ! do i=min(m,n)+1,n - ! ADD Subst(i) to Year,Term in curriculum - ! end do - do cdx=min( TCG(tdx)%Reqd(0), TCG(tdx)%Subst(0) )+1, TCG(tdx)%Subst(0) - i = tCheckList%NSubjects+1 - tCheckList%NSubjects = i - tCheckList%SubjectTerm(i) = TCG(tdx)%Term - tCheckList%SubjectIdx(i) = TCG(tdx)%Subst(cdx) - end do - ! end if - - end if - - TCG(tdx)%Code = 1 - ! copy to Student(std) - i = Student(std)%Reqd(0,0) + 1 - Student(std)%Reqd(0,0) = i - Student(std)%Reqd(-1,i) = TCG(tdx)%Term - Student(std)%Reqd(0:5,i) = TCG(tdx)%Reqd(0:5) - Student(std)%Subst(0:5,i) = TCG(tdx)%Subst(0:5) - - !write(*,*) 'custom_read_substitution: Required=', TCG(tdx)%Reqd(0) - !do cdx=1,TCG(tdx)%Reqd(0) - ! write(*,*) Subject(TCG(tdx)%Reqd(cdx))%Name - !end do - !write(*,*) 'custom_read_substitution: Replacement=', TCG(tdx)%Subst(0) - !do cdx=1,TCG(tdx)%Subst(0) - ! write(*,*) Subject(TCG(tdx)%Subst(cdx))%Name - !end do - end if - end do loop_tcg - - return - end subroutine custom_read_substitutions + end subroutine parse_student_records subroutine remake_student_records (std, DoNotRename) @@ -1230,7 +592,7 @@ subroutine remake_student_records (std, DoNotRename) ! rewrite call xml_write_student_grades(std) - return end subroutine remake_student_records + end module CHECKLISTS diff --git a/COLLEGES.F90 b/COLLEGES.F90 index 6f24673..fcb3479 100644 --- a/COLLEGES.F90 +++ b/COLLEGES.F90 @@ -73,7 +73,6 @@ subroutine initialize_college (wrkCollege, tCode, tName, tDean) wrkCollege = TYPE_COLLEGE(SPACE, SPACE, 'Firstname MI Lastname, Ph.D.', .false.) end if - return end subroutine initialize_college @@ -93,7 +92,6 @@ function index_to_college (tCode) end if end do - return end function index_to_college @@ -124,7 +122,6 @@ subroutine read_colleges(path, errNo) ! write the COLLEGES file in XML? if (noXML ) call xml_write_colleges(path) - return end subroutine read_colleges @@ -136,7 +133,7 @@ subroutine xml_read_colleges(path, errNo) type(TYPE_COLLEGE) :: wrkCollege ! open file, return on any error - fileName = trim(dirXML)//trim(path)//'COLLEGES.XML' + fileName = trim(dirDATA)//trim(path)//'COLLEGES.XML' call xml_open_file(unitXML, XML_ROOT_COLLEGES, fileName, errNo, forReading) if (errNo/=0) return @@ -178,7 +175,6 @@ subroutine xml_read_colleges(path, errNo) call xml_close_file(unitXML) call file_log_message (itoa(NumColleges)//' entries in '//fileName) - return end subroutine xml_read_colleges @@ -194,7 +190,7 @@ subroutine xml_write_colleges(path, dirOPT) if (present(dirOPT)) then fileName = trim(dirOPT)//trim(path)//'COLLEGES.XML' else - fileName = trim(dirXML)//trim(path)//'COLLEGES.XML' + fileName = trim(dirDATA)//trim(path)//'COLLEGES.XML' endif call xml_open_file(unitXML, XML_ROOT_COLLEGES, fileName, ldx) @@ -218,7 +214,6 @@ subroutine xml_write_colleges(path, dirOPT) call xml_close_file(unitXML, XML_ROOT_COLLEGES) - return end subroutine xml_write_colleges diff --git a/CURRICULA.F90 b/CURRICULA.F90 index b3543c7..cfaf03a 100644 --- a/CURRICULA.F90 +++ b/CURRICULA.F90 @@ -95,7 +95,7 @@ subroutine xml_write_curricula(path, dirOPT) if (present(dirOPT)) then fileName = trim(dirOPT)//trim(path)//'CURRICULA.XML' else - fileName = trim(dirXML)//trim(path)//'CURRICULA.XML' + fileName = trim(dirDATA)//trim(path)//'CURRICULA.XML' endif call xml_open_file(unitXML, XML_ROOT_CURRICULA, fileName, idx) @@ -181,7 +181,7 @@ subroutine xml_write_curricula(path, dirOPT) end do call xml_close_file(unitXML, XML_ROOT_CURRICULA) - return + end subroutine xml_write_curricula @@ -202,7 +202,7 @@ subroutine xml_read_curricula(path, errNo) integer :: nLoad, loadArray(MAX_SUBJECTS_PER_TERM) ! open file, return on any error - fileName = trim(dirXML)//trim(path)//'CURRICULA.XML' + fileName = trim(dirDATA)//trim(path)//'CURRICULA.XML' call xml_open_file(unitXML, XML_ROOT_CURRICULA, fileName, errNo, forReading) if (errNo/=0) return @@ -319,7 +319,7 @@ subroutine xml_read_curricula(path, errNo) call xml_close_file(unitXML) call file_log_message (itoa(NumCurricula)//' entries in '//fileName) - return + end subroutine xml_read_curricula @@ -336,7 +336,7 @@ subroutine xml_write_equivalencies(path, dirOPT) if (present(dirOPT)) then fileName = trim(dirOPT)//trim(path)//'EQUIVALENCIES.XML' else - fileName = trim(dirXML)//trim(path)//'EQUIVALENCIES.XML' + fileName = trim(dirDATA)//trim(path)//'EQUIVALENCIES.XML' endif call xml_open_file(unitXML, XML_ROOT_EQUIVALENCIES, fileName, idx) write(unitXML,AFORMAT) & @@ -359,7 +359,7 @@ subroutine xml_write_equivalencies(path, dirOPT) call xml_close_file(unitXML, XML_ROOT_EQUIVALENCIES) - return + end subroutine xml_write_equivalencies @@ -379,7 +379,7 @@ subroutine xml_read_equivalencies(path, errNo) ptrS = 0 ! substitutions ! open CURRICULUM file, return on any error - fileName = trim(dirXML)//trim(path)//'CURRICULA.XML' + fileName = trim(dirDATA)//trim(path)//'CURRICULA.XML' call xml_open_file(unitXML, XML_ROOT_CURRICULA, fileName, errNo, forReading) if (errNo/=0) return @@ -414,7 +414,7 @@ subroutine xml_read_equivalencies(path, errNo) call xml_close_file(unitXML) ! open EQUIVALENCIES file, return on any error - fileName = trim(dirXML)//trim(path)//'EQUIVALENCIES.XML' + fileName = trim(dirDATA)//trim(path)//'EQUIVALENCIES.XML' call xml_open_file(unitXML, XML_ROOT_EQUIVALENCIES, fileName, errNo, forReading) if (errNo/=0) return @@ -445,7 +445,7 @@ subroutine xml_read_equivalencies(path, errNo) SubstIdx(NumSubst+1) = ptrS+1 call xml_close_file(unitXML) - return + end subroutine xml_read_equivalencies @@ -508,7 +508,7 @@ subroutine read_curricula(path, errNo) call make_curriculum_groups() - return + end subroutine read_curricula @@ -518,7 +518,7 @@ subroutine make_curriculum_groups CurrProgNum = 0 CurrProgCode = SPACE k = 0 - do idx=1,NumCurricula-1 + do idx=1,NumCurricula if (CurrProgNum(idx)==0) then k = k+1 CurrProgNum(idx) = k @@ -530,7 +530,7 @@ subroutine make_curriculum_groups j = j-1 end if CurrProgCode(idx) = Curriculum(idx)%Code(1:j) - do i = idx+1,NumCurricula-1 + do i = idx+1,NumCurricula if (Curriculum(idx)%CollegeIdx==Curriculum(i)%CollegeIdx .and. & Curriculum(idx)%Code(1:j)==Curriculum(i)%Code(1:j) .and. & (Curriculum(i)%Code(j+1:j+1)==SPACE .or. & @@ -542,7 +542,7 @@ subroutine make_curriculum_groups end if end do CurrProgNum(0) = k - return + end subroutine make_curriculum_groups @@ -591,7 +591,7 @@ function index_to_curriculum (token) index_to_curriculum = -i end if end do - return + end function index_to_curriculum @@ -609,7 +609,7 @@ function index_of_subject_in_curriculum (tCurriculum, crse) exit end if end do - return + end function index_of_subject_in_curriculum @@ -619,7 +619,7 @@ function is_used_in_college_subject (college_idx, subject_idx) integer, intent (in) :: college_idx, subject_idx integer :: i found = .false. - do i=1,NumCurricula-1 + do i=1,NumCurricula if (Curriculum(i)%CollegeIdx/=college_idx) cycle if (index_of_subject_in_curriculum(Curriculum(i), subject_idx)>0) then found = .true. @@ -627,7 +627,7 @@ function is_used_in_college_subject (college_idx, subject_idx) end if end do is_used_in_college_subject = found - return + end function is_used_in_college_subject @@ -645,7 +645,7 @@ function is_used_in_curriculum_subject_area (tCurriculum, area) end if end do is_used_in_curriculum_subject_area = found - return + end function is_used_in_curriculum_subject_area @@ -656,7 +656,9 @@ function text_prerequisite_in_curriculum(crse,tCurriculum) type (TYPE_CURRICULUM), intent (in), optional :: tCurriculum character (len=MAX_LEN_SUBJECT_CODE) :: tSubject character (len=255) :: str127(MAX_ALL_SUBJECT_PREREQ) - integer :: i, j, k + integer :: i, j, k, idxCURR + logical :: satisfiable + ! corequisite displayStr = SPACE str127 = SPACE @@ -721,7 +723,10 @@ function text_prerequisite_in_curriculum(crse,tCurriculum) end if end if str127 = SPACE + satisfiable = .true. if (present(tCurriculum)) then + idxCURR = index_to_curriculum(tCurriculum%Code) + satisfiable = is_prerequisite_satisfiable_in_curriculum(crse, idxCURR) do j=Subject(crse)%lenPreq,1,-1 k = Subject(crse)%Prerequisite(j) tSubject = Subject(k)%Name @@ -749,9 +754,13 @@ function text_prerequisite_in_curriculum(crse,tCurriculum) if (k>0) then i = index_of_subject_in_curriculum(tCurriculum, k) if (i>0) then - str127(j) = tSubject + if (satisfiable) then + str127(j) = tSubject + else + str127(j) = red//trim(tSubject)//black + end if else - str127(j) = trim(tSubject)//'*' + str127(j) = red//trim(tSubject)//black//'*' end if else str127(j) = tSubject @@ -782,7 +791,7 @@ function text_prerequisite_in_curriculum(crse,tCurriculum) end if end if text_prerequisite_in_curriculum = displayStr - return + end function text_prerequisite_in_curriculum @@ -839,7 +848,7 @@ function is_prerequisite_satisfiable_in_curriculum(crse, curr) end if end do is_prerequisite_satisfiable_in_curriculum = tmpPreq(1)>0 - return + end function is_prerequisite_satisfiable_in_curriculum @@ -857,7 +866,7 @@ function text_curriculum_info(idxCURR) tmp = trim(Curriculum(idxCURR)%Code)//SPACE//DASH//SPACE// & trim(Curriculum(idxCURR)%Title)//tmp text_curriculum_info = tmp - return + end function text_curriculum_info @@ -869,7 +878,7 @@ subroutine xml_write_intake(path) ! training only? if (noWrites) return - fileName = trim(dirXML)//trim(path)//'INTAKE.XML' + fileName = trim(dirDATA)//trim(path)//'INTAKE.XML' call xml_open_file(unitXML, XML_INTAKE, fileName, idxCURR) @@ -880,7 +889,7 @@ subroutine xml_write_intake(path) ' Intake - curriculum,count', & ' ' - do idxCURR=1,NumCurricula-1 + do idxCURR=1,NumCurricula if (NFintake(idxCURR)==0) cycle call xml_write_character(unitXML, indent0, 'Intake', & trim(Curriculum(idxCURR)%Code)//COMMA//itoa(NFintake(idxCURR)) ) @@ -888,7 +897,7 @@ subroutine xml_write_intake(path) call xml_close_file(unitXML, XML_INTAKE) - return + end subroutine xml_write_intake @@ -903,7 +912,7 @@ subroutine xml_read_intake(path, errNo) character(len=MAX_LEN_XML_TAG) :: tag ! open file, return on any error - fileName = trim(dirXML)//trim(path)//'INTAKE.XML' + fileName = trim(dirDATA)//trim(path)//'INTAKE.XML' call xml_open_file(unitXML, XML_INTAKE, fileName, errNo, forReading) if (errNo/=0) return @@ -937,7 +946,7 @@ subroutine xml_read_intake(path, errNo) call xml_close_file(unitXML) - return + end subroutine xml_read_intake @@ -980,7 +989,7 @@ subroutine set_term_offered_accg_to_curricula(Offering) Subject(subj)%TermOffered = 7 end do - return + end subroutine set_term_offered_accg_to_curricula diff --git a/CUSTOM/custom_advising.F90 b/CUSTOM/custom_advising.F90 index 2879c04..505cda6 100644 --- a/CUSTOM/custom_advising.F90 +++ b/CUSTOM/custom_advising.F90 @@ -42,14 +42,19 @@ subroutine advise_student (std, UseClasses, Offering, WaiverCOI, Advice, Missing UnitsEarned, StdClassification, StdTerm, StdYear integer:: UnitsPaid, UnitsDropped, UnitsPassed, Standing + + call html_comment('advise_student()') + call initialize_pre_enlistment(Advice) + idxCURR = Student(std)%CurriculumIdx idxCOLL = Curriculum(idxCURR)%CollegeIdx WaiverUnits = 0 do idx=1,WaiverCOI%lenSubject WaiverUnits = WaiverUnits + Subject(WaiverCOI%Subject(idx))%Units end do - if (College(idxCOLL)%Code == ADMINISTRATION) then + + if (Curriculum(idxCURR)%NSubjects==0) then ! no subjects specified in curriculum CheckList = Curriculum(idxCURR) CLExt = TYPE_CHECKLIST_EXTENSION (0, 0, 0, 0, 0.0, .false., .false., .false., & @@ -72,13 +77,11 @@ subroutine advise_student (std, UseClasses, Offering, WaiverCOI, Advice, Missing return end if - !call read_student_records (std) - CheckList = Curriculum(idxCURR) CLExt = TYPE_CHECKLIST_EXTENSION (0, 0, 0, 0, 0.0, .false., .false., .false., & SPACE, SPACE, SPACE, SPACE, SPACE, SPACE, SPACE) - call get_scholastic_three_terms (cTm1Year, cTm1, UnitsPaid, UnitsDropped, UnitsPassed, Standing) + call get_scholastic_three_terms (std, cTm1Year, cTm1, UnitsPaid, UnitsDropped, UnitsPassed, Standing) call analyze_checklist (std, UseClasses, Offering, WaiverCOI, Standing, & UnitsEarned, StdClassification, StdTerm, StdYear, MissingPOCW, & @@ -120,6 +123,7 @@ subroutine advise_student (std, UseClasses, Offering, WaiverCOI, Advice, Missing !write(unitLOG,*) idx, Subject(Advice%Subject(idx))%Name ! update from waiver-coi +#if defined UPLB if (WaiverUnits>0) then ! set in custom_read_waivers(); get subjects from WaiverCOI Advice%AllowedLoad = WaiverUnits @@ -136,6 +140,7 @@ subroutine advise_student (std, UseClasses, Offering, WaiverCOI, Advice, Missing NRemaining = 0 end if Advice%lenSubject = Advice%NPriority+Advice%NAlternates+Advice%NCurrent +#endif return end subroutine advise_student @@ -197,6 +202,10 @@ subroutine analyze_checklist (std, UseClasses, Offering, WaiverCOI, stdScholasti character (len=MAX_LEN_SUBJECT_CODE) :: tNote #endif + call html_comment('analyze_checklist()') + + call parse_student_records (std) + now = 3*(CurrentYear - BaseYear + 1) + CurrentTerm idxCURR = Student(std)%CurriculumIdx AllowedLoad = 0 @@ -229,7 +238,7 @@ subroutine analyze_checklist (std, UseClasses, Offering, WaiverCOI, stdScholasti crse = TCG(tdx)%Subject tSubject = Subject(crse)%Name if ( (tSubject(1:3) == 'PE ') .and. & - is_grade_numeric_pass(TCG(tdx)%Grade) ) then + is_grade_numeric_pass(TCG(tdx)%Grade) ) then ! (is_grade_numeric_pass(TCG(tdx)%Grade) .or. is_grade_conditional(TCG(tdx)%Grade) ) ) then do kdx=1,CheckList%NSubjects tSubject = Subject(CheckList%SubjectIdx(kdx))%Name @@ -249,7 +258,7 @@ subroutine analyze_checklist (std, UseClasses, Offering, WaiverCOI, stdScholasti end if call blank_to_underscore(Subject(crse)%Name, input_name2) CLExt(kdx)%Disp_Input_Grade = '' + trim(CLExt(kdx)%Disp_Grade)//'">' TCG(tdx)%Used = .true. exit @@ -407,8 +416,9 @@ subroutine analyze_checklist (std, UseClasses, Offering, WaiverCOI, stdScholasti #endif else ! not found; duplicate entry? - - !write(unitLOG,*) ' (not found, or duplicate)' +#ifdef DBsubst + write(unitLOG,*) ' (not found, or duplicate)' +#endif end if end if @@ -589,7 +599,7 @@ subroutine analyze_checklist (std, UseClasses, Offering, WaiverCOI, stdScholasti if (is_grade_passing(CLExt(idx)%Grade)) cycle ! consider earned crse = CheckList%SubjectIdx(idx) #ifdef DBsubst - write(unitLOG,*) crse, Subject(crse)%Name//' not yet earned?' + call html_comment(Subject(crse)%Name//' not yet earned?') #endif loop_subst : & do i=1,NumSubst @@ -600,26 +610,26 @@ subroutine analyze_checklist (std, UseClasses, Offering, WaiverCOI, stdScholasti do j=k+2, SubstIdx(i+1)-1 OKSubst = .false. #ifdef DBsubst - write(unitLOG,*) ' substitute is '//Subject(Substitution(j))%Name + call html_comment(' substitute is '//Subject(Substitution(j))%Name) #endif do l=1,lenTCG if (TCG(l)%Code /= 2) cycle if (TCG(l)%Subject == Substitution(j) .and. & - !is_grade_numeric_pass(TCG(l)%Grade) ) then - is_grade_passing(TCG(l)%Grade,advisingPeriod) & + is_grade_numeric_pass(TCG(l)%Grade) & + !is_grade_passing(TCG(l)%Grade,advisingPeriod) & .and. (.not. TCG(l)%Used) ) then p(j-k) = l gdx = TCG(l)%Grade OKSubst = .true. #ifdef DBsubst - write(unitLOG,*) ' grade in '//Subject(Substitution(j))%Name//' is '//txtGrade(pGrade(gdx)) + call html_comment(' grade in '//Subject(Substitution(j))%Name//' is '//txtGrade(pGrade(gdx))) #endif exit end if end do if (.not. OKSubst) then #ifdef DBsubst - write(unitLOG,*) ' '//Subject(Substitution(j))%Name//' not yet earned; substitution not valid' + call html_comment(' '//Subject(Substitution(j))%Name//' not yet earned; substitution not valid') #endif cycle loop_subst end if @@ -661,6 +671,8 @@ subroutine analyze_checklist (std, UseClasses, Offering, WaiverCOI, stdScholasti if (advisingPeriod) then UnitsExpected = UnitsExpected + k*Failrate(CheckList%SubjectIdx(idx),cTm1) UnitsEarned = UnitsEarned + k ! optimistic units earned + !else ! assume fail + ! UnitsEarned = UnitsEarned + k end if else if (is_grade_passing(CLExt(idx)%Grade) ) then UnitsEarned = UnitsEarned + k @@ -689,15 +701,15 @@ subroutine analyze_checklist (std, UseClasses, Offering, WaiverCOI, stdScholasti if (index(TCG(idx)%txtLine, 'REMOVAL')>0) cycle ! not enrolled if (index(TCG(idx)%txtLine, 'COMPLETION')>0) cycle ! not enrolled if (TCG(idx)%Grade==gdxDRP .or. & - TCG(idx)%Grade==gdxLOA .or. & - TCG(idx)%Grade==gdxREGD) cycle ! do not count + TCG(idx)%Grade==gdxLOA .or. & + (TCG(idx)%Grade==gdxREGD .and. isActionAdvising) ) cycle ! do not count crse = TCG(idx)%Subject credit = Subject(crse)%Units gdx = TCG(idx)%Grade ! count towards units enrolled PERFUnitsEnrolled = PERFUnitsEnrolled + credit ! count towards units earned - if (is_grade_passing(gdx,advisingPeriod)) then + if (is_grade_passing(gdx)) then ! ,advisingPeriod)) then PERFUnitsEarned = PERFUnitsEarned + credit else if (is_grade_conditional(gdx) .and. is_grade_passing(TCG(idx)%ReExam)) then PERFUnitsEarned = PERFUnitsEarned + credit @@ -738,9 +750,15 @@ subroutine analyze_checklist (std, UseClasses, Offering, WaiverCOI, stdScholasti ! special case for new freshmen entering 2nd semester if (UnitsEarned < TermUnits(1)) StdTerm = 1 end if - StdYear = min(StdTerm,Curriculum(idxCURR)%NumTerms)/3 + StdYear = min(StdTerm,Curriculum(idxCURR)%NumTerms)/3 + 1 AllowedLoad = TermUnits(min(StdTerm,Curriculum(idxCURR)%NumTerms)) - if (AllowedLoad == 0) AllowedLoad = 18 + if (AllowedLoad == 0) then + if (nextTerm==3) then + AllowedLoad = 9 + else + AllowedLoad = 21 + end if + end if ! compute classification PercentEarned = (100.0*UnitsEarned)/UnitsTarget + 0.55 @@ -754,15 +772,16 @@ subroutine analyze_checklist (std, UseClasses, Offering, WaiverCOI, stdScholasti StdClassification = 1 end if -#ifdef DBunits - write(unitLOG,*) 'Target=', UnitsTarget, & - 'Earned=', UnitsEarned, & - ', % earned=', (100.0*UnitsEarned)/UnitsTarget, & - ', StdClassification=', StdClassification, & - ', StdTerm=', StdTerm, & - ', StdYear=', Stdyear, & - ', Allowed=', AllowedLoad -#endif + + call html_comment( & + 'Target='//itoa(UnitsTarget), & + 'Earned='//itoa(UnitsEarned), & + '% earned='//ftoa((100.0*UnitsEarned)/UnitsTarget,1) ) + call html_comment( & + 'StdClassification='//itoa(StdClassification), & + 'StdTerm='//itoa(StdTerm), & + 'StdYear='//itoa(Stdyear), & + 'Allowed='//itoa(AllowedLoad)) ! collect prerequisites; simplify ANDs and ORs CLPreq = 0 @@ -904,7 +923,7 @@ subroutine analyze_checklist (std, UseClasses, Offering, WaiverCOI, stdScholasti Slack = 0 do idx=1,CheckList%NSubjects gdx = CLExt(idx)%Grade - if (gdx==0 .or. is_grade_failing(gdx) .or. (.not. advisingPeriod .and. gdx==gdxREGD) ) EarlyTime(idx) = 1 + if (gdx==0 .or. is_grade_failing(gdx) .or. (isActionClasslists .and. gdx==gdxREGD) ) EarlyTime(idx) = 1 end do Latest = 0 do ! loop while an EarlyTime() changed @@ -998,7 +1017,7 @@ subroutine analyze_checklist (std, UseClasses, Offering, WaiverCOI, stdScholasti CLExt(idx)%Disp_Units = ftoa(Subject(crse)%Units,1) if (.not. isRoleChair) then ! Adviser or REGISTRAR CLExt(idx)%Disp_Grade = txtGrade(pGrade(CLExt(idx)%Grade)) - elseif (is_grade_passing(CLExt(idx)%Grade,advisingPeriod)) then ! Dept. Chair + elseif (is_grade_passing(CLExt(idx)%Grade)) then ! ,advisingPeriod)) then ! Dept. Chair CLExt(idx)%Disp_Grade = 'PASS' else CLExt(idx)%Disp_Grade = txtGrade(pGrade(CLExt(idx)%Grade)) @@ -1021,7 +1040,8 @@ subroutine analyze_checklist (std, UseClasses, Offering, WaiverCOI, stdScholasti if (advisingPeriod) then prob(j) = 1.0-Failrate(CheckList%SubjectIdx(jdx),cTm1) tmpPreq(j) = 1 - else + else ! enlistment period + ! REGD == No grade == fail tmpPreq(j) = 0 prob(j) = 0.0 end if @@ -1190,7 +1210,7 @@ subroutine analyze_checklist (std, UseClasses, Offering, WaiverCOI, stdScholasti do k=1,lenTCG if (TCG(k)%Code /= 2) cycle if (-TCG(k)%Subject == jdx-NumDummySubjects .and. & - is_grade_passing(TCG(k)%Grade,advisingPeriod) ) then + is_grade_passing(TCG(k)%Grade)) then !,advisingPeriod) ) then prob(j) = 1.0 tmpPreq(j) = 1 #ifdef DBprereq @@ -1234,7 +1254,11 @@ subroutine analyze_checklist (std, UseClasses, Offering, WaiverCOI, stdScholasti ! problem with records? if (CLExt(idx)%Grade==gdxREGD) then !write(token, '(f5.2)') 1.0-Failrate(crse,cTm1) - if (.not. advisingPeriod) CLExt(idx)%Disp_Grade = '(NG)' + if (isActionAdvising) then + CLExt(idx)%Disp_Grade = 'REGD' + else + CLExt(idx)%Disp_Grade = '(NG)' + end if CLExt(idx)%Disp_Remarks = SPACE else if (is_grade_passing(CLExt(idx)%Grade) ) then CLExt(idx)%Disp_Remarks = SPACE @@ -1271,7 +1295,7 @@ subroutine analyze_checklist (std, UseClasses, Offering, WaiverCOI, stdScholasti !r = 0.0 do idx=1,CheckList%NSubjects gdx = CLExt(idx)%Grade - if ( gdx==0 .or. is_grade_failing(gdx) .or. (gdx==gdxREGD .and. .not. advisingPeriod) ) then ! no grade or failed + if ( gdx==0 .or. is_grade_failing(gdx) .or. (gdx==gdxREGD .and. isActionClasslists) ) then ! no grade or failed if (CLExt(idx)%OKPreq .and. CheckList%SubjectIdx(idx) > 0) then ! named subject, not passed, prereq is satisfied FlagIsUp = .true. ! by default, add to list of subjects with satisfied prereqs @@ -1288,7 +1312,7 @@ subroutine analyze_checklist (std, UseClasses, Offering, WaiverCOI, stdScholasti #endif kdx = index_of_subject_in_curriculum(CheckList, cdx) if (kdx>0) then ! found in checklist; should be passed, or at least, prereq is satisfied - if (is_grade_passing(CLExt(kdx)%Grade,advisingPeriod)) then ! co-req is passed + if (is_grade_passing(CLExt(kdx)%Grade) ) then !,advisingPeriod)) then ! co-req is passed #ifdef DBcoreq write(unitLOG,*) ' - which is a required subject already passed; ADD.' #endif @@ -1324,7 +1348,7 @@ subroutine analyze_checklist (std, UseClasses, Offering, WaiverCOI, stdScholasti #endif kdx = index_of_subject_in_curriculum(CheckList, cdx) if (kdx>0) then ! found in checklist; should be passed, or at least, prereq is satisfied - if (is_grade_passing(CLExt(kdx)%Grade,advisingPeriod)) then ! conc. pre-req is passed + if (is_grade_passing(CLExt(kdx)%Grade)) then ! ,advisingPeriod)) then ! conc. pre-req is passed #ifdef DBconcpreq write(unitLOG,*) ' - which is a required subject already passed; ADD.' #endif @@ -1404,17 +1428,19 @@ subroutine analyze_checklist (std, UseClasses, Offering, WaiverCOI, stdScholasti end do ! add currently enrolled subjects as alternates - do idx=1,CheckList%NSubjects - crse = CheckList%SubjectIdx(idx) - if (crse<=0) cycle ! subject not specified in PlanOfStudy - if (CLExt(idx)%Grade==gdxREGD .and. advisingPeriod .and. & - (is_offered(crse,nextTerm) .or. Offering(crse)%NSections>0)) then - CLExt(idx)%Contrib = Failrate(crse,cTm1) ! CHANGE THIS LATER TO CONDITIONAL PROBABILITY - ! list as alternate; contribute failure rate to forecast - NCurrent = NCurrent + 1 - CLExt(NPriority+NAlternates+NCurrent)%PriorityRank = idx - end if - end do + if (advisingPeriod) then + do idx=1,CheckList%NSubjects + crse = CheckList%SubjectIdx(idx) + if (crse<=0) cycle ! subject not specified in PlanOfStudy + if (CLExt(idx)%Grade==gdxREGD .and. & + (is_offered(crse,nextTerm) .or. Offering(crse)%NSections>0)) then + CLExt(idx)%Contrib = Failrate(crse,cTm1) ! CHANGE THIS LATER TO CONDITIONAL PROBABILITY + ! list as alternate; contribute failure rate to forecast + NCurrent = NCurrent + 1 + CLExt(NPriority+NAlternates+NCurrent)%PriorityRank = idx + end if + end do + end if return end if @@ -1935,17 +1961,19 @@ subroutine analyze_checklist (std, UseClasses, Offering, WaiverCOI, stdScholasti n = 0 p = 0 prob = 0 - do idx=1,CheckList%NSubjects - crse = CheckList%SubjectIdx(idx) - if (crse<=0) cycle ! subject not specified in PlanOfStudy - if (CLExt(idx)%Grade==gdxREGD .and. advisingPeriod .and. & - (is_offered(crse,nextTerm) .or. Offering(crse)%NSections>0)) then - n = n+1 - p(n) = idx - prob(n) = Failrate(crse,cTm1) - !write(unitLOG,*) n, Subject(crse)%Name, prob(n) - end if - end do + if (advisingPeriod) then + do idx=1,CheckList%NSubjects + crse = CheckList%SubjectIdx(idx) + if (crse<=0) cycle ! subject not specified in PlanOfStudy + if (CLExt(idx)%Grade==gdxREGD .and. & + (is_offered(crse,nextTerm) .or. Offering(crse)%NSections>0)) then + n = n+1 + p(n) = idx + prob(n) = Failrate(crse,cTm1) + !write(unitLOG,*) n, Subject(crse)%Name, prob(n) + end if + end do + end if ! sort according to decreasing failrate do i=1,n-1 do j=i+1,n diff --git a/CUSTOM/custom_checklists.F90 b/CUSTOM/custom_checklists.F90 index dc75901..0f2881b 100644 --- a/CUSTOM/custom_checklists.F90 +++ b/CUSTOM/custom_checklists.F90 @@ -37,7 +37,7 @@ subroutine extract_student_grades() character (len=4) :: dirYear character (len=1) :: ch integer :: idxYear, idxTerm, idxGrd, idxCurr - integer :: cdx, fdx, gdx, idx, std, ier, i, j + integer :: cdx, fdx, gdx, idx, std, ier, i, j, k integer, dimension(MAX_ALL_SUBJECTS,2,1:3) :: GrandTotal GrandTotal = 0 ! grade counter @@ -47,7 +47,7 @@ subroutine extract_student_grades() do idxTerm = 1,3 do idxGrd = 1,1 ! 0,3 - fileName = trim(dirRAW)//dirYEAR//DIRSEP//trim(txtSemester(idxTerm))//DIRSEP// & + fileName = trim(dirDATA)//dirYEAR//DIRSEP//trim(txtSemester(idxTerm))//DIRSEP// & trim(txtGradeType(idxGrd))//'.CSV' open(unit=unitRAW,file=fileName,status='old', iostat=ier) @@ -114,9 +114,40 @@ subroutine extract_student_grades() tSubject = adjustl(line(pos(idx)+1:pos(idx+1)-1)) cdx = index_to_subject(tSubject) if (cdx<=0) then - call file_log_message (trim(wrkStudent%Name)//' - "'//trim(tSubject)// & - '" not in catalog') - cycle + !call file_log_message (trim(wrkStudent%Name)//' - "'//trim(tSubject)// & + ! '" not in catalog') + !cycle + NumAdditionalSubjects = NumAdditionalSubjects+1 + cdx = NumSubjects + NumAdditionalSubjects + + Subject(cdx)%Name = tSubject + Subject(cdx)%Title = tSubject + Subject(cdx)%DeptIdx = NumDepartments + Subject(cdx)%Units = 3.0 + + Subject(cdx)%TermOffered = 7 + Subject(cdx)%LectHours = 3.0 + Subject(cdx)%MinLectSize = 50 + Subject(cdx)%MaxLectSize = 50 + Subject(cdx)%LectLoad = 0.0 + Subject(cdx)%LabHours = 0.0 + Subject(cdx)%MinLabSize = 50 + Subject(cdx)%MaxLabSize = 50 + Subject(cdx)%LabLoad = 0.0 + + k = 1 + Subject(cdx)%lenPreq = k + Subject(cdx)%Prerequisite(k) = INDEX_TO_NONE + Subject(cdx)%lenCoreq = k + Subject(cdx)%Corequisite = INDEX_TO_NONE + Subject(cdx)%lenConc = k + Subject(cdx)%Concurrent = INDEX_TO_NONE + Subject(cdx)%lenConcPreq = k + Subject(cdx)%ConcPrerequisite= INDEX_TO_NONE + + Subject(cdx)%LabFee = 0.0 + Subject(cdx)%Tuition = 0.0 + end if tGrade = adjustl(line(pos(idx+2)+1:pos(idx+3)-1)) if (tGrade==SPACE) then @@ -157,3 +188,22 @@ subroutine extract_student_grades() return end subroutine extract_student_grades + + +subroutine custom_read_student_grades (std, DoNotRename) + integer, intent (in) :: std + logical, optional, intent (in) :: DoNotRename + + + return +end subroutine custom_read_student_grades + + +subroutine custom_read_substitutions (std, DoNotRename) + integer, intent (in) :: std + logical, optional, intent (in) :: DoNotRename + + + return +end subroutine custom_read_substitutions + diff --git a/CUSTOM/custom_read_colleges.F90 b/CUSTOM/custom_read_colleges.F90 index 84721ea..4682e8c 100644 --- a/CUSTOM/custom_read_colleges.F90 +++ b/CUSTOM/custom_read_colleges.F90 @@ -36,7 +36,7 @@ subroutine custom_read_colleges(path, errNo) character(len=*), intent(in) :: path integer, intent(out) :: errNo - fileName = trim(dirRAW)//trim(path)//'COLLEGES.CSV' + fileName = trim(dirDATA)//trim(path)//'COLLEGES.CSV' open (unit=unitRAW, file=fileName, status='old', iostat=errNo) if (errNo/=0) return diff --git a/CUSTOM/custom_read_curricula.F90 b/CUSTOM/custom_read_curricula.F90 index fd9ae38..1a33afc 100644 --- a/CUSTOM/custom_read_curricula.F90 +++ b/CUSTOM/custom_read_curricula.F90 @@ -44,7 +44,7 @@ subroutine custom_read_curricula(path, errNo) character (len=MAX_LEN_FILE_PATH) :: currFile character (len=1) :: ch - fileName = trim(dirRAW)//trim(path)//'CURRICULA.CSV' + fileName = trim(dirDATA)//trim(path)//'CURRICULA.CSV' open (unit=unitRAW, file=fileName, status='old', iostat=errNo) if (errNo/=0) return @@ -78,12 +78,12 @@ subroutine custom_read_curricula(path, errNo) cycle end if - currFile = trim(dirRAW)//trim(path)//line(pos(2)+1:pos(3)-1)//'.CSV' + currFile = trim(dirDATA)//trim(path)//line(pos(2)+1:pos(3)-1)//'.CSV' inquire(file=currFile, exist=FlagIsUp) if (.not. FlagIsUp) then !write(*,*) 'File not found: '//trim(currFile) if (ndels>=8 .and. pos(9)-pos(8)>1) then - currFile =trim(dirRAW)//trim(path)//line(pos(8)+1:pos(9)-1) + currFile =trim(dirDATA)//trim(path)//line(pos(8)+1:pos(9)-1) inquire(file=currFile, exist=FlagIsUp) !if (.not. FlagIsUp) then ! write(*,*) 'File not found: '//trim(currFile) diff --git a/CUSTOM/custom_read_departments.F90 b/CUSTOM/custom_read_departments.F90 index 10fa0d3..3afea60 100644 --- a/CUSTOM/custom_read_departments.F90 +++ b/CUSTOM/custom_read_departments.F90 @@ -38,7 +38,7 @@ subroutine custom_read_departments (path, errNo) character (len=MAX_LEN_COLLEGE_CODE) :: tCollege character (len=MAX_LEN_DEPARTMENT_CODE) :: tDepartment - fileName = trim(dirRAW)//trim(path)//'DEPARTMENTS.CSV' + fileName = trim(dirDATA)//trim(path)//'DEPARTMENTS.CSV' open (unit=unitRAW, file=fileName, status='old', iostat=errNo) if (errNo/=0) return diff --git a/CUSTOM/custom_read_pre_enlistment.F90 b/CUSTOM/custom_read_pre_enlistment.F90 new file mode 100644 index 0000000..99e97fe --- /dev/null +++ b/CUSTOM/custom_read_pre_enlistment.F90 @@ -0,0 +1,121 @@ +!====================================================================== +! +! HEEDS (Higher Education Enrollment Decision Support) - A program +! to create enrollment scenarios for 'next term' in a university +! Copyright (C) 2012, 2013 Ricolindo L. Carino +! +! This file is part of the HEEDS program. +! +! HEEDS is free software: you can redistribute it and/or modify +! it under the terms of the GNU General Public License as published by +! the Free Software Foundation, either version 3 of the License, or +! (at your option) any later version. +! +! HEEDS is distributed in the hope that it will be useful, +! but WITHOUT ANY WARRANTY; without even the implied warranty of +! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +! GNU General Public License for more details. +! +! You should have received a copy of the GNU General Public License +! along with this program (see the file COPYING.TXT). If not, see +! . +! +! Send inquiries about HEEDS to: +! Ricolindo L Carino +! E-mail: Ricolindo.Carino@AcademicForecasts.com +! Address: 600 Cruise St., Starkville, MS 39759, U.S.A. +! +!====================================================================== + + +subroutine custom_read_pre_enlistment(path, basename, NumSections, Section, cList, numEntries, ier) + character(len=*), intent(in) :: path, basename + type (TYPE_SECTION), intent(in out) :: Section(0:) + type (TYPE_PRE_ENLISTMENT), intent(out) :: cList(0:) + integer, intent (in) :: NumSections + integer, intent (out) :: numEntries, ier + + character (len=MAX_LEN_STUDENT_CODE) :: tStdNo + character (len=MAX_LEN_SUBJECT_CODE) :: tSubject + character (len=MAX_LEN_CLASS_ID) :: tSection + integer :: cdx, k, sdx, std + + numEntries = 0 + fileName = trim(dirDATA)//trim(path)//basename//'.CSV' + open(unit=unitRAW, file=fileName, form='formatted', status='old', iostat=ier) + if (ier/=0) return + + call file_log_message ('Retrieving '//fileName) + + loop_WRITEIN : & + do + read (unitRAW, AFORMAT, iostat = eof) line + if (eof<0) exit loop_WRITEIN + if (line(1:1)=='#' .or. line(1:3)==' ') cycle loop_WRITEIN + + !#STUDNO,SUBJECT CODE,CLASS CODE,SutdName,Course,TERM,COLLEGE,TEACHER,SECTION + !1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 + !08-09517,EM 218,G007,"Abbariao, Cristopher Adolfo",MAED-SS,13-S,GS,To Be Assigned,GS + !08-09517,MA 204,G022,"Abbariao, Cristopher Adolfo",MAED-SS,13-S,GS,To Be Assigned,GS + !08-09517,SOC SCI 218A,G052,"Abbariao, Cristopher Adolfo",MAED-SS,13-S,GS,To Be Assigned,GS + !08-09517,SS 217,G053,"Abbariao, Cristopher Adolfo",MAED-SS,13-S,GS,To Be Assigned,GS + !06-00593,BA 72,B120,"Accad, Leonard Andrew Bramaje",BSENT,13-S,CBEA,"Gonzaga, Jeremiah",BSENT-3C + !06-00593,BA 66,B128,"Accad, Leonard Andrew Bramaje",BSENT,13-S,CBEA,"Singson, Marcial",BSENT-3C + !08-02956,ENG 13,E028,"Adviento, Baby Jane Concepcion",BSED-FIL,13-S,CTE,"Clemente, Beatriz",BSED 1K + ! + call index_to_delimiters(COMMA, line, ndels, pos) + + ! student + tStdNo = line(1:pos(2)-1) + std = index_to_student(tStdNo) + if (std==0) then + call file_log_message('Student not in list: '//line) + cycle loop_WRITEIN + end if + + ! subject + tSubject = line(pos(2)+1:pos(3)-1) + cdx = index_to_subject(tSubject) + if (cdx<=0) then + call file_log_message(tSubject//' - subject not in catalog: '//line) + cycle loop_WRITEIN + end if + + ! section + tSection = adjustl(line(pos(3)+1:pos(4)-1)) + if (len_trim(tSection)==0) then ! not accommodated + sdx = 0 + else + tSection = trim(tSubject)//SPACE//tSection + sdx = index_to_section(tSection, NumSections, Section) + if (sdx==0) then + call file_log_message (tSection//' - no such section: - '//line) + else ! try lab section + if (is_lecture_lab_subject(cdx)) then + tSection = trim(tSection)//DASH//'1L' + k = index_to_section(tSection, NumSections, Section) + if (k>0) sdx = k + end if + end if + end if + k = cList(std)%NPriority + 1 + call check_array_bound (k, MAX_SUBJECTS_PER_TERM, 'MAX_SUBJECTS_PER_TERM') + + cList(std)%Subject(k) = cdx + cList(std)%Section(k) = sdx + cList(std)%Grade(k) = gdxREGD + cList(std)%NPriority = k + cList(std)%AllowedLoad = cList(std)%AllowedLoad + Subject(cdx)%Units + cList(std)%lenSubject = k + + numEntries = numEntries + 1 + + !write(*,*) std, tStdno, cList(std)%lenSubject, tSubject, tSection + + end do loop_WRITEIN + close(unitRAW) + call file_log_message (itoa(numEntries)//' entries in '//fileName) + + return +end subroutine custom_read_pre_enlistment + diff --git a/CUSTOM/custom_read_rooms.F90 b/CUSTOM/custom_read_rooms.F90 index dab5386..1a42192 100644 --- a/CUSTOM/custom_read_rooms.F90 +++ b/CUSTOM/custom_read_rooms.F90 @@ -37,7 +37,7 @@ subroutine custom_read_rooms(path, errNo) integer :: i, j, k, locx, seats character (len=MAX_LEN_DEPARTMENT_CODE) :: tDepartment - fileName = trim(dirRAW)//trim(path)//'ROOMS.CSV' + fileName = trim(dirDATA)//trim(path)//'ROOMS.CSV' open (unit=unitRAW, file=fileName, status='old', iostat=errNo) if (errNo/=0) return call file_log_message('Retrieving room codes from '//fileName) diff --git a/CUSTOM/custom_read_students.F90 b/CUSTOM/custom_read_students.F90 index 49ed031..7050033 100644 --- a/CUSTOM/custom_read_students.F90 +++ b/CUSTOM/custom_read_students.F90 @@ -52,7 +52,7 @@ subroutine SIAS_read_students (filePath, numEntries, ier) integer :: idxCURR, i, j, indexLoc numEntries = 0 - fileName = trim(dirRAW)//trim(filePath)//'.CSV' + fileName = trim(dirDATA)//trim(filePath)//'.CSV' open(unit=unitRAW, file=fileName, status='old', iostat=ier) if (ier/=0) return @@ -140,7 +140,7 @@ subroutine SIAS_read_students (filePath, numEntries, ier) j = 0 do i=pos(4)+1,pos(5)-1 ch = line(i:i) - if (ch==COMMA .or. index(SPECIAL,ch)>0) cycle + if (index(SPECIAL,ch)>0) cycle j = j+1 wrkStudent%Name(j:j) = ch end do @@ -172,7 +172,7 @@ subroutine SIAS_read_students_from_enlistment (filePath, numEntries, ier) integer :: idxCURR, i, j, indexLoc numEntries = 0 - fileName = trim(dirRAW)//trim(filePath)//'.CSV' + fileName = trim(dirDATA)//trim(filePath)//'.CSV' open(unit=unitRAW, file=fileName, status='old', iostat=ier) if (ier/=0) return @@ -211,7 +211,7 @@ subroutine SIAS_read_students_from_enlistment (filePath, numEntries, ier) j = 0 do i=pos(4)+1,pos(5)-1 ch = line(i:i) - if (index(SPECIAL,ch)>0 .or. ch==COMMA) cycle + if (index(SPECIAL,ch)>0) cycle j = j+1 if (j>MAX_LEN_PERSON_NAME) cycle wrkStudent%Name(j:j) = ch diff --git a/CUSTOM/custom_read_subjects.F90 b/CUSTOM/custom_read_subjects.F90 index 57490f5..44a8297 100644 --- a/CUSTOM/custom_read_subjects.F90 +++ b/CUSTOM/custom_read_subjects.F90 @@ -116,7 +116,7 @@ subroutine SIAS_read_subjects(path, errNo) NumDummySubjects = -19 INDEX_TO_NONE = -13 ! index to NONE (the prerequisite of "No prerequisite" subjects) - fileName = trim(dirRAW)//trim(path)//'SUBJECTS.CSV' + fileName = trim(dirDATA)//trim(path)//'SUBJECTS.CSV' open (unit=unitRAW, file=fileName, status='old', iostat=errNo) if (errNo/=0) return @@ -233,7 +233,7 @@ subroutine SIAS_read_assessment(path, errNo) character :: tType real :: tFee - fileName = trim(dirRAW)//trim(path)//'ASSESSMENT.CSV' + fileName = trim(dirDATA)//trim(path)//'ASSESSMENT.CSV' open (unit=unitRAW, file=fileName, status='old', iostat=errNo) if (errNo/=0) return @@ -281,7 +281,7 @@ subroutine custom_read_subjects_prerequisites(path, errNo) character (len=MAX_LEN_SUBJECT_CODE) :: tSubject integer :: cdx - fileName = trim(dirRAW)//trim(path)//'SUBJECTS-PREREQUISITES' + fileName = trim(dirDATA)//trim(path)//'SUBJECTS-PREREQUISITES' open (unit=unitRAW, file=fileName, status='old', iostat=errNo) if (errNo/=0) return @@ -323,7 +323,7 @@ subroutine custom_read_prerequisites(path, errNo) character (len=MAX_LEN_SUBJECT_CODE) :: tSubject, preq1, preq2, preq3, coreq1, coreq2 integer :: cdx, pdx1, pdx2, pdx3, rdx1, rdx2 - fileName = trim(dirRAW)//trim(path)//'PREREQUISITES.CSV' + fileName = trim(dirDATA)//trim(path)//'PREREQUISITES.CSV' open (unit=unitRAW, file=fileName, status='old', iostat=errNo) if (errNo/=0) return diff --git a/CUSTOM/custom_read_teachers.F90 b/CUSTOM/custom_read_teachers.F90 index 2989c93..b2dc1d6 100644 --- a/CUSTOM/custom_read_teachers.F90 +++ b/CUSTOM/custom_read_teachers.F90 @@ -39,7 +39,7 @@ subroutine custom_read_teachers(path, errNo) character (len=1) :: ch type(TYPE_TEACHER) :: wrkTeacher - fileName = trim(dirRAW)//trim(path)//'TEACHERS.CSV' + fileName = trim(dirDATA)//trim(path)//'TEACHERS.CSV' open (unit=unitRAW, file=fileName, status='old', iostat=errNo) if (errNo/=0) return @@ -69,7 +69,7 @@ subroutine custom_read_teachers(path, errNo) j = 0 do i=pos(4)+1,pos(5)-1 ch = line(i:i) - if (index(SPECIAL,ch)>0 .or. ch==COMMA) cycle + if (index(SPECIAL,ch)>0) cycle !if ((ch>='A' .and. ch<='Z') .or. (ch>='a' .and. ch<='z') .or. ch==SPACE .or. ch==DASH) then j = j+1 tTeacher(j:j) = ch diff --git a/CUSTOM/custom_read_university.F90 b/CUSTOM/custom_read_university.F90 index 5162743..6731608 100644 --- a/CUSTOM/custom_read_university.F90 +++ b/CUSTOM/custom_read_university.F90 @@ -33,7 +33,7 @@ subroutine custom_read_university(path, errNo) character(len=*), intent(in) :: path integer, intent(out) :: errNo - fileName = trim(dirRAW)//trim(path)//'UNIVERSITY' + fileName = trim(dirDATA)//trim(path)//'UNIVERSITY' open (unit=unitRAW, file=fileName, status='old', iostat=errNo) if (errNo/=0) return diff --git a/CUSTOM/custom_reports.F90 b/CUSTOM/custom_reports.F90 index 92a3653..57578b8 100644 --- a/CUSTOM/custom_reports.F90 +++ b/CUSTOM/custom_reports.F90 @@ -62,10 +62,12 @@ subroutine student_performance (device, mesg) ! end if ! !write(*,*) 'Performance of '//trim(text_student_info(targetStudent)) - call html_write_header(device, text_student_curriculum(targetStudent), mesg) + call html_write_header(device, trim(Student(targetStudent)%StdNo)//SPACE//trim(Student(targetStudent)%Name)// & + '
'//text_curriculum_info(targetCurriculum), mesg) ! read checklist call read_student_records (targetStudent) + call parse_student_records (targetStudent) write(device,AFORMAT) '
UNOFFICIAL Copy of Grades and Weighted Average by Term' write(device,AFORMAT) begintr//'
'//endtd//endtr, & @@ -106,12 +108,13 @@ subroutine student_performance (device, mesg) if (TCG(tdx)%Term==3) then write(device,AFORMAT) & begintr//tdnbspendtd//'		SUMMER, '// & - trim(itoa(TCG(tdx)%Year))//endtd//''//nbsp//endtd//endtr + trim(itoa(TCG(tdx)%Year))//DASH//trim(itoa(TCG(tdx)%Year+1))//endtd// & + ''//nbsp//endtd//endtr else write(device,AFORMAT) & begintr//tdnbspendtd, & ''//trim(txtSemester(TCG(tdx)%Term))// & - termQualifier(TCG(tdx)%Term)//COMMA//trim(itoa(TCG(tdx)%Year))//DASH// & + trim(termQualifier(TCG(tdx)%Term))//COMMA//SPACE//trim(itoa(TCG(tdx)%Year))//DASH// & trim(itoa(TCG(tdx)%Year+1))//endtd// & ''//nbsp//endtd//endtr end if diff --git a/DEMAND.F90 b/DEMAND.F90 index 25ab357..e3b42e7 100644 --- a/DEMAND.F90 +++ b/DEMAND.F90 @@ -68,7 +68,7 @@ subroutine demand_by_new_freshmen(device, Offering) else ! extract from QUERY_STRING ! INTAKE - do idxCURR=1,NumCurricula-1 + do idxCURR=1,NumCurricula call cgi_get_named_integer(QUERY_STRING, trim(Curriculum(idxCURR)%Code), nstd, ierr) if (ierr==0) then write(*,*) Curriculum(idxCURR)%Code, nstd, ierr @@ -105,7 +105,7 @@ subroutine demand_by_new_freshmen(device, Offering) call html_write_header(device, 'Demand for subjects by New Freshmen entering ') ! count demand for 1st sem subjects of each specified curriculum - do idxCURR=1,NumCurricula-1 + do idxCURR=1,NumCurricula if (NFintake(idxCURR)==0) cycle do j=1,Curriculum(idxCURR)%NSubjects if (Curriculum(idxCURR)%SubjectTerm(j) /= 1) cycle @@ -115,7 +115,7 @@ subroutine demand_by_new_freshmen(device, Offering) end do ! enable edit call make_form_start(device, fnUpdateDemandFreshmen, tCollege) - do idxCURR=1,NumCurricula-1 + do idxCURR=1,NumCurricula if (NFintake(idxCURR)/=0) then write(device,AFORMAT) '' @@ -124,7 +124,7 @@ subroutine demand_by_new_freshmen(device, Offering) write(device,AFORMAT) & 'Change count for

E
X
C
E
S
S

'//endtd//& !'

A
V
A
I
L

'//endtd//& '

D
E
M
A
N
D

'//endtd - do idxCURR=1,NumCurricula-1 + do idxCURR=1,NumCurricula if (NFintake(idxCURR)==0) cycle tCurriculum = Curriculum(idxCURR)%Code l = len_trim(tCurriculum) @@ -153,7 +153,7 @@ subroutine demand_by_new_freshmen(device, Offering) end do ! approximate blocks write(device,AFORMAT) endtr//begintr//'		BLOCKS'//endtd//tdnbspendtd - do idxCURR=1,NumCurricula-1 + do idxCURR=1,NumCurricula if (NFintake(idxCURR)==0) cycle write(device,AFORMAT) tdalignright//trim(itoa((1+NFintake(idxCURR))/25))//endtd end do @@ -165,7 +165,7 @@ subroutine demand_by_new_freshmen(device, Offering) !'tdalignright//trim(itoabz(-Offering(crse)%Demand+Offering(crse)%TotalSlots))//endtd, & !'tdalignright//trim(itoabz(Offering(crse)%TotalSlots))//endtd, & tdalignright//trim(itoabz(Offering(crse)%Demand))//endtd - do idxCURR=1,NumCurricula-1 + do idxCURR=1,NumCurricula if (NFintake(idxCURR)==0) cycle j = index_of_subject_in_curriculum (Curriculum(idxCURR), crse) if (j==0) then ! crse not in curriculum @@ -182,7 +182,7 @@ subroutine demand_by_new_freshmen(device, Offering) end do write(device,AFORMAT) '
' - return + end subroutine demand_by_new_freshmen diff --git a/DEPARTMENTS.F90 b/DEPARTMENTS.F90 index 00c5ed8..5020cf0 100644 --- a/DEPARTMENTS.F90 +++ b/DEPARTMENTS.F90 @@ -91,7 +91,7 @@ subroutine read_departments(path, errNo) ! write the XML DEPARTMENTS file? if (noXML) call xml_write_departments(path) - return + end subroutine read_departments @@ -107,7 +107,7 @@ subroutine initialize_department (wrkDepartment, tCode, tName, tPrefix, iCollege wrkDepartment = typeDEPARTMENT(SPACE, SPACE, SPACE, 0, .false.) end if - return + end subroutine initialize_department @@ -127,7 +127,7 @@ function index_to_dept(token) end if end do - return + end function index_to_dept @@ -143,7 +143,7 @@ subroutine xml_write_departments(path, dirOPT) if (present(dirOPT)) then fileName = trim(dirOPT)//trim(path)//'DEPARTMENTS.XML' else - fileName = trim(dirXML)//trim(path)//'DEPARTMENTS.XML' + fileName = trim(dirDATA)//trim(path)//'DEPARTMENTS.XML' endif call xml_open_file(unitXML, XML_ROOT_DEPARTMENTS, fileName, ldx) @@ -169,7 +169,7 @@ subroutine xml_write_departments(path, dirOPT) call xml_close_file(unitXML, XML_ROOT_DEPARTMENTS) - return + end subroutine xml_write_departments @@ -185,7 +185,7 @@ subroutine xml_read_departments(path, errNo) character (len=MAX_LEN_COLLEGE_CODE) :: tColl ! open file, return on any error - fileName = trim(dirXML)//trim(path)//'DEPARTMENTS.XML' + fileName = trim(dirDATA)//trim(path)//'DEPARTMENTS.XML' call xml_open_file(unitXML, XML_ROOT_DEPARTMENTS, fileName, errNo, forReading) if (errNo/=0) return @@ -235,7 +235,7 @@ subroutine xml_read_departments(path, errNo) call xml_close_file(unitXML) call file_log_message (itoa(NumDepartments)//' entries in '//fileName) - return + end subroutine xml_read_departments diff --git a/EditBLOCKS.F90 b/EditBLOCKS.F90 index 82ec1e6..3970c3c 100644 --- a/EditBLOCKS.F90 +++ b/EditBLOCKS.F90 @@ -353,10 +353,8 @@ subroutine block_show_schedule(device, NumSections, Section, Offering, NumBlocks end select end select -#if defined PRODUCTION -#else - write(device,AFORMAT) '' -#endif + + call html_comment('targetBlock='//trim(Block(targetBlock)%BlockID)//'@'//itoa(targetBlock)) if (updateBLOCKS) then call sort_alphabetical_blocks(NumBlocks, Block) @@ -364,7 +362,7 @@ subroutine block_show_schedule(device, NumSections, Section, Offering, NumBlocks targetBlock = index_to_block(tBlock, NumBlocks, Block) call xml_write_blocks(pathToTerm, NumBlocks, Block, Section, 0) -! call xml_write_blocks(UPDATES//pathToTerm, NumBlocks, Block, Section, targetDepartment) +! call xml_write_blocks(pathToTerm, NumBlocks, Block, Section, targetDepartment) if (fn==fnBlockDeleteAll .or. fn==fnBlockDeleteName) then call html_college_links(device, targetCollege, mesg) @@ -374,7 +372,7 @@ subroutine block_show_schedule(device, NumSections, Section, Offering, NumBlocks if (updateCLASSES) then call offerings_summarize(NumSections, Section, Offering) call xml_write_sections(pathToTerm, NumSections, Section, 0) -! call xml_write_sections(UPDATES//pathToTerm, NumSections, Section, targetDepartment) +! call xml_write_sections(pathToTerm, NumSections, Section, targetDepartment) end if call html_write_header(device, 'Block schedule '//tBlock, mesg) @@ -612,7 +610,7 @@ subroutine block_show_schedule(device, NumSections, Section, Offering, NumBlocks write(device,AFORMAT) '
' - return + end subroutine block_show_schedule @@ -624,10 +622,7 @@ subroutine block_select_curriculum_year(device, NumSections, Section, NumBlocks, integer :: ierr, ldx character(len=MAX_LEN_COLLEGE_CODE) :: tCollege -#if defined PRODUCTION -#else - write(device,AFORMAT) '' -#endif + call html_comment('block_select_curriculum_year()') call cgi_get_named_string(QUERY_STRING, 'A1', tCollege, ierr) targetCollege = index_to_college(tCollege) @@ -669,7 +664,7 @@ subroutine block_select_curriculum_year(device, NumSections, Section, NumBlocks, nbsp//nbsp//nbsp//nbsp//'', & '
' - return + end subroutine block_select_curriculum_year @@ -687,12 +682,8 @@ subroutine block_add(device, Term, NumSections, Section, Offering, NumBlocks, Bl character (len=50) :: tAction logical :: inputError, createClasses character(len=MAX_LEN_DEPARTMENT_CODE) :: tDepartment - !character (len=MAX_LEN_CLASS_ID) :: tClassId -#if defined PRODUCTION -#else - write(device,AFORMAT) '' -#endif + call html_comment('block_add()') inputError = .false. @@ -805,20 +796,20 @@ subroutine block_add(device, Term, NumSections, Section, Offering, NumBlocks, Bl call sort_alphabetical_blocks(NumBlocks, Block) call xml_write_blocks(pathToTerm, NumBlocks, Block, Section, 0) -! call xml_write_blocks(UPDATES//pathToTerm, NumBlocks, Block, Section, targetDepartment) +! call xml_write_blocks(pathToTerm, NumBlocks, Block, Section, targetDepartment) if (createClasses) then call offerings_summarize(NumSections, Section, Offering) call xml_write_sections(pathToTerm, NumSections, Section, 0) -! call xml_write_sections(UPDATES//pathToTerm, NumSections, Section, targetDepartment) +! call xml_write_sections(pathToTerm, NumSections, Section, targetDepartment) end if call html_college_links(device, targetCollege, 'Added block(s) in '//trim(tCurriculum)) - return + end subroutine block_add @@ -829,10 +820,7 @@ subroutine block_add_and_create_sections (block_idx, Term, NumBlocks, Block, Nu type (TYPE_BLOCK), dimension(0:), intent(in out) :: Block integer :: crse, idx -#if defined PRODUCTION -#else - write(unitHTML,AFORMAT) '' -#endif + call html_comment('block_add_and_create_sections()') do idx=1,Block(block_idx)%NumClasses crse = Block(block_idx)%Subject(idx) @@ -843,7 +831,7 @@ subroutine block_add_and_create_sections (block_idx, Term, NumBlocks, Block, Nu end do - return + end subroutine block_add_and_create_sections @@ -854,15 +842,13 @@ subroutine create_section_for_block (crse, block_idx, Term, NumBlocks, Block, N type (TYPE_BLOCK), dimension(0:), intent(in out) :: Block integer :: dept, kdx -#if defined PRODUCTION -#else - write(unitHTML,AFORMAT) '' -#endif - dept = Block(block_idx)%DeptIdx kdx = ScheduleCount(Term,dept) + 1 ! new section in department ScheduleCount(Term,dept) = kdx + call html_comment('create_section_for_block()', 'block='//Block(block_idx)%BlockID, & + 'term='//itoa(Term), 'dept='//Department(dept)%Code, 'nsect='//itoa(kdx)) + if (Subject(crse)%LectHours>0) then NumSections = NumSections + 1 Section(NumSections)%SubjectIdx = crse @@ -899,7 +885,7 @@ subroutine create_section_for_block (crse, block_idx, Term, NumBlocks, Block, N Section(NumSections)%BlockID = Block(block_idx)%BlockID - return + end subroutine create_section_for_block @@ -912,10 +898,7 @@ subroutine block_get_all_from_CLASSES(Term, NumSections, Section, NumBlocks, Blo integer :: copy, crse, sect, idx, Year character (len=MAX_LEN_CURRICULUM_CODE) :: tCurriculum -#if defined PRODUCTION -#else - write(unitHTML,AFORMAT) '' -#endif + call html_comment('block_get_all_from_CLASSES()') NumBlocks = 0 call initialize_block(Block(0)) @@ -969,7 +952,7 @@ subroutine block_get_all_from_CLASSES(Term, NumSections, Section, NumBlocks, Blo end do ! sort call sort_alphabetical_blocks(NumBlocks, Block) - return + end subroutine block_get_all_from_CLASSES @@ -1035,7 +1018,7 @@ subroutine timetable_meetings_of_block(NumSections, Section, block_index, Block, list(len_list+1) = 0 list(len_list+2) = 0 list(len_list+3) = 0 - return + end subroutine timetable_meetings_of_block @@ -1048,15 +1031,12 @@ subroutine block_list_all(device, NumBlocks, Block) character(len=MAX_LEN_COLLEGE_CODE) :: tCollege character (len=MAX_LEN_CURRICULUM_CODE) :: tCurriculum -#if defined PRODUCTION -#else - write(device,AFORMAT) '' -#endif + call html_comment('block_list_all()') ! which program ? call cgi_get_named_string(QUERY_STRING, 'A1', tCurriculum, ierr) targetCurriculum = 0 - do ldx=1,NumCurricula + do ldx=1,NumCurricula-1 if (CurrProgCode(ldx) /= tCurriculum) cycle targetCurriculum = ldx exit @@ -1079,7 +1059,7 @@ subroutine block_list_all(device, NumBlocks, Block) end do write(device,AFORMAT) '
' - return + end subroutine block_list_all diff --git a/EditCURRICULA.F90 b/EditCURRICULA.F90 index 80f5d16..1c99038 100644 --- a/EditCURRICULA.F90 +++ b/EditCURRICULA.F90 @@ -56,24 +56,17 @@ subroutine curriculum_list_all(device, fn) targetCurriculum = index_to_curriculum(tCurriculum) case default - do ldx=1,NumCurricula + do ldx=1,NumCurricula-1 if (CurrProgCode(ldx) /= tCurriculum) cycle targetCurriculum = ldx exit end do - do ldx=1,NumCurricula + do ldx=1,NumCurricula-1 if (CurrProgCode(ldx) /= tCurriculum) cycle ncurr = ncurr + 1 end do end select - - if (ierr/=0 .or. targetCurriculum<=0) then - write(device,AFORMAT) '
'//red//'Curriculum "'//tCurriculum//'" not found.'//black//'
' - targetCollege = CollegeIdxUser - return - end if - targetCollege = Curriculum(targetCurriculum)%CollegeIdx ! if ony one curriculum, display the curriculum @@ -105,7 +98,7 @@ subroutine curriculum_list_all(device, fn) ! collect curricula write(device,AFORMAT) '
    ' - do ldx=1,NumCurricula + do ldx=1,NumCurricula-1 if (CurrProgCode(ldx) /= tCurriculum) cycle @@ -128,9 +121,9 @@ subroutine curriculum_list_all(device, fn) if (isRoleAdmin) then write(device,AFORMAT) trim(make_href(fnAction, tAction, A1=Curriculum(ldx)%Code, & - pre=nbsp//'', post=nbsp)) + pre=nbsp//'', post=nbsp, alt=SPACE)) write(device,AFORMAT) trim(make_href(fnEditCurriculum, 'Edit', A1=Curriculum(ldx)%Code, & - pre=nbsp, post='')) + pre=nbsp, post='', alt=SPACE)) end if write(device,AFORMAT) '' @@ -138,7 +131,7 @@ subroutine curriculum_list_all(device, fn) end do write(device,AFORMAT) '
' - return + end subroutine curriculum_list_all @@ -181,12 +174,16 @@ subroutine curriculum_display(device, given) write(device,AFORMAT) nbsp//' '//tStatus//''//nbsp if (isRoleAdmin) then write(device,AFORMAT) trim(make_href(fnAction, tAction, A1=Curriculum(targetCurriculum)%Code, & - pre=nbsp//'', post=nbsp)) + pre=nbsp//'', post=nbsp, alt=SPACE)) write(device,AFORMAT) trim(make_href(fnEditCurriculum, 'Edit', A1=Curriculum(targetCurriculum)%Code, & - pre=nbsp, post='')) + pre=nbsp, post='', alt=SPACE)) end if - write(device,AFORMAT) '
' + write(device,AFORMAT) '
Note: A '//red//'SUBJECT'//black//' in column Prerequisite ', & + ' indicates an inconsistency. '//red//'Said SUBJECT'//black// & + ' is not be present in the curriculum, or is not taken in a prior term, ', & + ' or the prerequisite expression should be "SUBJECT1 OR SUBJECT2" where either one is taken in a prior term.', & + '
' cumulative = 0 do tdx=1,Curriculum(targetCurriculum)%NumTerms @@ -239,7 +236,7 @@ subroutine curriculum_display(device, given) write(device,AFORMAT) '
' - return + end subroutine curriculum_display @@ -251,7 +248,7 @@ subroutine curriculum_edit(device, given) character(len=MAX_LEN_COLLEGE_CODE) :: tCollege character(len=10) :: tStatus ! (ACTIVE)/(INACTIVE) - character (len=255) :: mesg, remark + character (len=255) :: mesg, remark, tokenizeErr type (TYPE_CURRICULUM) :: wrk logical :: changed integer, dimension(MAX_SECTION_MEETINGS) :: subjectList @@ -356,18 +353,17 @@ subroutine curriculum_edit(device, given) cycle end if - call tokenize_subjects(mesg, COMMA, MAX_SECTION_MEETINGS, m, subjectList, ierr) - if (ierr==0) then - write(unitLOG,*) 'TOKENIZE TERM: ierr=',ierr, ('; '//trim(Subject(subjectList(i))%Name),i=1,m) + call tokenize_subjects(mesg, COMMA, MAX_SECTION_MEETINGS, m, subjectList, ierr, tokenizeErr) + if (len_trim(tokenizeErr)>0) remark = trim(remark)//' : '//tokenizeErr + if (m>0) then + write(unitLOG,*) 'TOKENIZE TERM: m=',m, ('; '//trim(Subject(subjectList(i))%Name),i=1,m) do i=1,m if (subjectList(i)==INDEX_TO_NONE) cycle idx = wrk%NSubjects + i wrk%SubjectIdx(idx) = subjectList(i) wrk%SubjectTerm(idx) = tdx - if (wrk%SubjectIdx(idx)/=Curriculum(targetCurriculum)%SubjectIdx(idx) .or. & - wrk%SubjectTerm(idx)/=Curriculum(targetCurriculum)%SubjectTerm(idx)) then + if (index_of_subject_in_curriculum (Curriculum(targetCurriculum), wrk%SubjectIdx(idx))==0) then j = j + 1 - write(unitLOG,*) j, ':', txtYear(Year), ', ', txtSemester(Term), ', ', Subject(subjectList(i))%Name end if end do wrk%NSubjects = wrk%NSubjects + m @@ -422,9 +418,12 @@ subroutine curriculum_edit(device, given) if (Substitution(k) == NumCurricula+1) Substitution(k) = NumCurricula+2 end do + ! bump OTHER Curriculum(NumCurricula+1) = Curriculum(NumCurricula) + ! add new curriculum Curriculum(NumCurricula) = wrk targetCurriculum = NumCurricula + NumCurricula = NumCurricula+1 targetCollege = wrk%CollegeIdx tCurriculum = wrk%Code @@ -455,7 +454,7 @@ subroutine curriculum_edit(device, given) call html_write_header(device, 'Edit curriculum '//tCurriculum, remark(3:)) write(device,AFORMAT) trim(make_href(fnCurriculumList, CurrProgCode(targetCurriculum), & A1=CurrProgCode(targetCurriculum), & - pre='Edit other'//nbsp, post=' option
')) + pre='Edit other'//nbsp, post=' option', alt=SPACE))//'
' call make_form_start(device, fnEditCurriculum, tCurriculum) write(device,AFORMAT) '', & @@ -546,7 +545,7 @@ subroutine curriculum_edit(device, given) !'NOTE: Subjects for a term are specified by COMMA-separated subjects codes.', & '
' - return + end subroutine curriculum_edit diff --git a/EditENLISTMENT.F90 b/EditENLISTMENT.F90 index 85303e2..cc183da 100644 --- a/EditENLISTMENT.F90 +++ b/EditENLISTMENT.F90 @@ -30,486 +30,581 @@ module EditENLISTMENT - use HTML + use HTML - implicit none + implicit none contains - - - - subroutine enlistment_grades (device, NumSections, Section) - integer, intent (in) :: device - integer, intent (in) :: NumSections - type (TYPE_SECTION), intent(in) :: Section(0:) - integer :: ldx, n_count, tdx, std, ierr, ncol, sect, crse, idx_select - character(len=MAX_LEN_CLASS_ID) :: tClassId - logical :: isDirtyFORM5 - - ! which section? - call cgi_get_named_string(QUERY_STRING, 'A1', tClassId, ierr) - targetSection = index_to_section(tClassId, NumSections, Section) - targetDepartment = Section(targetSection)%DeptIdx - targetCollege = Department(targetDepartment)%CollegeIdx - crse = Section(targetSection)%SubjectIdx - - ! collect students - n_count = 0 - isDirtyFORM5 = .false. - do tdx=1,NumStudents - std = StdRank(tdx) - do ncol=1,Preenlisted(std)%lenSubject - sect = Preenlisted(std)%Section(ncol) - if (sect==0) cycle - if (targetSection == sect) then - call cgi_get_named_integer(QUERY_STRING, trim(Student(std)%StdNo), idx_select, ierr) - if (ierr==0) then - isDirtyFORM5 = .true. - Preenlisted(std)%Grade(ncol) = idx_select - end if - tArray(n_count+1) = std - tArray(n_count+2) = Preenlisted(std)%Grade(ncol) - n_count = n_count+2 - exit - elseif (Preenlisted(std)%Subject(ncol)==crse .and. is_lecture_lab_subject(crse)) then - ldx = index(Section(sect)%ClassId,DASH) - if (ldx>0) then ! student is accommodated in a lab section - if (trim(tClassId)==Section(sect)%ClassId(:ldx-1)) then ! lab of lecture - call cgi_get_named_integer(QUERY_STRING, trim(Student(std)%StdNo), idx_select, ierr) - if (ierr==0) then - isDirtyFORM5 = .true. - Preenlisted(std)%Grade(ncol) = idx_select - end if - tArray(n_count+1) = std - tArray(n_count+2) = Preenlisted(std)%Grade(ncol) - n_count = n_count+2 - end if + + + subroutine enlistment_grades (device, NumSections, Section) + + integer, intent (in) :: device, NumSections + type (TYPE_SECTION), intent(in) :: Section(0:) + + integer :: gdx, ldx, n_count, tdx, std, ierr, sect, ncol, crse, idx_select + character(len=MAX_LEN_CLASS_ID) :: tClassId, tAction + character (len=MAX_LEN_TEXT_GRADE) :: tGrade + character(len=255) :: header + logical :: isDirtyFORM5 + integer :: specialGrade(4) = (/ gdxREGD, gdxNFE, gdxINC, gdxDRP /) + + call html_comment('enlistment_grades()') + + ! which section? + call cgi_get_named_string(QUERY_STRING, 'A1', tClassId, ierr) + call cgi_get_named_string(QUERY_STRING, 'action', tAction, ierr) + targetSection = index_to_section(tClassId, NumSections, Section) + crse = Section(targetSection)%SubjectIdx +#if defined UPLB + targetDepartment = Subject(crse)%DeptIdx +#else + targetDepartment = Section(targetSection)%DeptIdx +#endif + targetCollege = Department(targetDepartment)%CollegeIdx + + ! collect students + n_count = 0 + do tdx=1,NumStudents + std = StdRank(tdx) + do ncol=1,Preenlisted(std)%lenSubject + sect = Preenlisted(std)%Section(ncol) + if (sect==0) cycle + if (targetSection == sect) then + if (trim(tAction)=='Submit') then + call cgi_get_named_string(QUERY_STRING, trim(Student(std)%StdNo), tGrade, ierr) + if (ierr==0) then + isDirtyFORM5 = .true. + Preenlisted(std)%Grade(ncol) = index_to_grade(tGrade) + end if + end if + tArray(n_count+1) = std + tArray(n_count+2) = Preenlisted(std)%Grade(ncol) + n_count = n_count+2 + exit + elseif (Preenlisted(std)%Subject(ncol)==crse .and. is_lecture_lab_subject(crse)) then + ldx = index(Section(sect)%ClassId,DASH) + if (ldx>0) then ! student is accommodated in a lab section + if (trim(tClassId)==Section(sect)%ClassId(:ldx-1)) then ! lab of lecture + if (trim(tAction)=='Submit') then + call cgi_get_named_string(QUERY_STRING, trim(Student(std)%StdNo), tGrade, ierr) + if (ierr==0) then + isDirtyFORM5 = .true. + Preenlisted(std)%Grade(ncol) = index_to_grade(tGrade) + end if + tArray(n_count+1) = std + tArray(n_count+2) = Preenlisted(std)%Grade(ncol) + n_count = n_count+2 + exit + end if + end if + end if end if - end if + end do end do - end do - if (isDirtyFORM5) call xml_write_pre_enlistment(pathToTerm, 'ENLISTMENT', Preenlisted, Section) + if (isDirtyFORM5) call xml_write_pre_enlistment(pathToTerm, 'ENLISTMENT', Preenlisted, Section) - call html_write_header(device,'Gradesheet for '//tClassId) - - if (n_count == 0) then - write(device,AFORMAT) 'No students in this section?' - else - call make_form_start(device, fnGradeSheet, tClassId) - write(device,AFORMAT) '
' - do tdx=1,n_count,2 - std = tArray(tdx) - ldx = Student(std)%CurriculumIdx - write(device,AFORMAT) & - begintr//begintd//trim(itoa((tdx+1)/2))//'.'//endtd// & - begintd//trim(Student(std)%StdNo)//endtd, & - begintd//trim(Student(std)%Name)//endtd// & - begintd//Curriculum(ldx)%Code//endtd//begintd - - write(device,AFORMAT) ''//endtd//endtr - end do - write(device,AFORMAT) begintr//tdnbspendtd//tdnbspendtd//tdnbspendtd//tdnbspendtd//begintd, & - ''//endtd//endtr//'
' - - end if - write(device,AFORMAT) '
' - - return - end subroutine enlistment_grades - - - subroutine enlistment_edit (device, NumSections, Section, NumBlocks, Block) - integer, intent (in) :: device - integer, intent (in out) :: NumBlocks, NumSections - type (TYPE_SECTION), intent(in out) :: Section(0:) - type (TYPE_BLOCK), intent(in out) :: Block(0:) - character(len=MAX_LEN_STUDENT_CODE) :: tStdNo - character(len=MAX_LEN_BLOCK_CODE) :: tBlock - character(len=MAX_LEN_CLASS_ID) :: tClassId - character(len=3*MAX_LEN_SUBJECT_CODE) :: tAction, search_string - character(len=MAX_LEN_SUBJECT_CODE) :: tSubject - integer :: bdx, blk, fdx, mdx, crse, lect, sect, ierr, tLen1, tLen2, pos, n_opts, idx_opt - integer, dimension(60,6) :: TimeTable - logical :: conflicted, matched - character(len=255) :: mesg - logical :: isDirtyFORM5, allowed_to_edit - - type (TYPE_PRE_ENLISTMENT) :: Advice - - ! which student? - call cgi_get_named_string(QUERY_STRING, 'A1', tStdNo, ierr) - targetStudent = index_to_student(tStdNo) - targetCurriculum = Student(targetStudent)%CurriculumIdx - allowed_to_edit = isRoleAdmin .or. (isRoleSRE .and. & - CurrProgCode(CurriculumIdxUser)==CurrProgCode(targetCurriculum)) - - call recalculate_available_seats(Section) - isDirtyFORM5 = .false. - - ! check for other arguments - mesg = SPACE - call cgi_get_named_string(QUERY_STRING, 'A2', tAction, ierr) - select case (trim(tAction)) - - case ('Add') - call cgi_get_named_string(QUERY_STRING, 'A3', tClassId, ierr) - sect = index_to_section(tClassId, NumSections, Section) - if (sect>0) then ! target of action is indexed by sect - if (Section(sect)%RemSlots>0) then - crse = Section(sect)%SubjectIdx - do fdx=1,Preenlisted(targetStudent)%lenSubject - if (Preenlisted(targetStudent)%Subject(fdx)==crse) then - Preenlisted(targetStudent)%Section(fdx) = sect - Preenlisted(targetStudent)%Grade(fdx) = gdxREGD - Section(sect)%RemSlots = Section(sect)%RemSlots - 1 - exit - end if - end do - mesg = 'Added '//tClassId - isDirtyFORM5 = .true. - else - mesg = 'NOT added, already full: '//tClassId - end if - end if + tArray(ncol+1) = 0 + tArray(ncol+2) = 0 + tArray(ncol+3) = 0 - case ('Block') - call cgi_get_named_string(QUERY_STRING, 'A3', tBlock, ierr) - blk = index_to_block(tBlock, NumBlocks, Block) - if (blk>0) then ! target block found + call html_write_header(device, SPACE) + call list_sections_to_edit(device, Section, ncol-n_count, tArray(n_count+1:), & + fnTeacherClasses, SPACE, 'Other classes', .true., & + 'GRADESHEET for '//trim(Subject(crse)%Name)//' - '//trim(header)//'

') - do bdx=1,Block(blk)%NumClasses - crse = Block(blk)%Subject(bdx) - sect = Block(blk)%Section(bdx) - if (sect==0) then ! section not specified in block - mesg = 'NOT added (no section): '//trim(Subject(crse)%Name)//'; '//mesg - cycle - end if - tClassId = Section(sect)%ClassId - matched = .false. - do fdx=1,Preenlisted(targetStudent)%lenSubject - if (crse/=Preenlisted(targetStudent)%Subject(fdx)) cycle - matched = .true. - exit + if (n_count == 0) then + write(device,AFORMAT) '
(No students in this section?)' + else + call make_form_start(device, fnGradeSheet, tClassId) + write(device,AFORMAT) '
', & + begintr//thalignleft//'#'//endth//thalignleft//'Student No.'//endth, & + thalignleft//'Student Name'//endth//thalignleft//'Curriculum'//endth, & + thalignleft//'Grade'//endth//endtr + + do tdx=1,n_count, 2 + std = tArray(tdx) + gdx = tArray(tdx+1) + ldx = Student(std)%CurriculumIdx + ierr = (tdx+1)/2 + write(device,AFORMAT) ''// & + begintd//trim(itoa(ierr))//'.'//endtd, & + begintd//Student(std)%StdNo//endtd, & + begintd//trim(Student(std)%Name)//endtd, & + begintd//trim(Curriculum(ldx)%Code)//endtd, & + begintd//''//endtd//endtr + end do + write(device,AFORMAT) begintr//tdnbspendtd//tdnbspendtd//tdnbspendtd//tdnbspendtd//begintd, & + ''//endtd//endtr//'
' + end if + write(device,AFORMAT) '
' + + + end subroutine enlistment_grades + + + subroutine enlistment_edit (device, NumSections, Section, NumBlocks, Block) + integer, intent (in) :: device + integer, intent (in out) :: NumBlocks, NumSections + type (TYPE_SECTION), intent(in out) :: Section(0:) + type (TYPE_BLOCK), intent(in out) :: Block(0:) + character(len=MAX_LEN_STUDENT_CODE) :: tStdNo + character(len=MAX_LEN_BLOCK_CODE) :: tBlock + character(len=MAX_LEN_CLASS_ID) :: tClassId + character(len=3*MAX_LEN_SUBJECT_CODE) :: tAction + character(len=MAX_LEN_SUBJECT_CODE) :: tSubject + integer :: bdx, blk, fdx, mdx, crse, lect, sect, ierr, tLen1, tLen2, pos, n_opts, idx_opt + integer :: n_changes + integer, dimension(60,6) :: TimeTable + logical :: conflicted, matched + character(len=255) :: mesg + logical :: isDirtyFORM5, allowed_to_edit + + type (TYPE_PRE_ENLISTMENT) :: Advice + + ! which student? + call cgi_get_named_string(QUERY_STRING, 'A1', tStdNo, ierr) + targetStudent = index_to_student(tStdNo) + targetCurriculum = Student(targetStudent)%CurriculumIdx + allowed_to_edit = isRoleAdmin .or. (isRoleSRE .and. & + CurrProgCode(CurriculumIdxUser)==CurrProgCode(targetCurriculum)) + + call recalculate_available_seats(Section) + isDirtyFORM5 = .false. + + ! check for other arguments + mesg = SPACE + call cgi_get_named_string(QUERY_STRING, 'A2', tAction, ierr) + select case (trim(tAction)) + + case ('Add') + call cgi_get_named_string(QUERY_STRING, 'A3', tClassId, ierr) + sect = index_to_section(tClassId, NumSections, Section) + if (sect>0) then ! target of action is indexed by sect + if (Section(sect)%RemSlots>0) then + crse = Section(sect)%SubjectIdx + do fdx=1,Preenlisted(targetStudent)%lenSubject + if (Preenlisted(targetStudent)%Subject(fdx)==crse) then + Preenlisted(targetStudent)%Section(fdx) = sect + Preenlisted(targetStudent)%Grade(fdx) = gdxREGD + Section(sect)%RemSlots = Section(sect)%RemSlots - 1 + exit + end if + end do + mesg = 'Added '//tClassId + isDirtyFORM5 = .true. + else + mesg = 'NOT added, already full: '//tClassId + end if end if - end do + case ('Block') + call cgi_get_named_string(QUERY_STRING, 'A3', tBlock, ierr) + blk = index_to_block(tBlock, NumBlocks, Block) + if (blk>0) then ! target block found + + do bdx=1,Block(blk)%NumClasses + crse = Block(blk)%Subject(bdx) + sect = Block(blk)%Section(bdx) + if (sect==0) then ! section not specified in block + mesg = 'NOT added (no section): '//trim(Subject(crse)%Name)//'; '//mesg + cycle + end if + tClassId = Section(sect)%ClassId + matched = .false. + do fdx=1,Preenlisted(targetStudent)%lenSubject + if (crse/=Preenlisted(targetStudent)%Subject(fdx)) cycle + matched = .true. + exit + end do + if (matched) then ! indexed by bdx/fdx + + if (Section(sect)%RemSlots>0) then + do fdx=1,Preenlisted(targetStudent)%lenSubject + if (Preenlisted(targetStudent)%Subject(fdx)/=crse) cycle + Preenlisted(targetStudent)%Section(fdx) = sect + Preenlisted(targetStudent)%Grade(fdx) = gdxREGD + Section(sect)%RemSlots = Section(sect)%RemSlots - 1 + exit + end do + mesg = 'Added '//trim(tClassId)//'; '//mesg + isDirtyFORM5 = .true. + else + mesg = 'NOT added '//trim(tClassId)//' (full); '//mesg + end if - else - mesg = 'Block "'//trim(tBlock)//'" not found' - end if + else + mesg = 'NOT advised '//trim(Subject(crse)%Name)//'; '//mesg + end if - case ('Prerog') - call cgi_get_named_string(QUERY_STRING, 'A3', tClassId, ierr) - sect = index_to_section(tClassId, NumSections, Section) - if (sect>0) then ! target of action is indexed by sect - if (Section(sect)%RemSlots>0) then - crse = Section(sect)%SubjectIdx - do fdx=1,Preenlisted(targetStudent)%lenSubject - if (Preenlisted(targetStudent)%Subject(fdx)==crse) then - Preenlisted(targetStudent)%Section(fdx) = sect - Preenlisted(targetStudent)%Grade(fdx) = gdxREGD - Section(sect)%RemSlots = Section(sect)%RemSlots - 1 - exit - end if - end do - mesg = 'Added '//tClassId - isDirtyFORM5 = .true. - else - crse = Section(sect)%SubjectIdx - do fdx=1,Preenlisted(targetStudent)%lenSubject - if (Preenlisted(targetStudent)%Subject(fdx)==crse) then - Preenlisted(targetStudent)%Section(fdx) = sect - Preenlisted(targetStudent)%Grade(fdx) = gdxREGD - Section(sect)%Slots = Section(sect)%Slots + 1 - exit - end if end do - mesg = 'Enlisted by teacher''s prerogative in '//tClassId - isDirtyFORM5 = .true. - end if - end if - case ('Del') - call cgi_get_named_string(QUERY_STRING, 'A3', tClassId, ierr) - sect = index_to_section(tClassId, NumSections, Section) - if (sect>0) then ! target of action is indexed by sect + else + mesg = 'Block "'//trim(tBlock)//'" not found' + end if + + case ('Prerog') + call cgi_get_named_string(QUERY_STRING, 'A3', tClassId, ierr) + sect = index_to_section(tClassId, NumSections, Section) + if (sect>0) then ! target of action is indexed by sect + if (Section(sect)%RemSlots>0) then + crse = Section(sect)%SubjectIdx + do fdx=1,Preenlisted(targetStudent)%lenSubject + if (Preenlisted(targetStudent)%Subject(fdx)==crse) then + Preenlisted(targetStudent)%Section(fdx) = sect + Preenlisted(targetStudent)%Grade(fdx) = gdxREGD + Section(sect)%RemSlots = Section(sect)%RemSlots - 1 + exit + end if + end do + mesg = 'Added '//tClassId + isDirtyFORM5 = .true. + else + crse = Section(sect)%SubjectIdx + do fdx=1,Preenlisted(targetStudent)%lenSubject + if (Preenlisted(targetStudent)%Subject(fdx)==crse) then + Preenlisted(targetStudent)%Section(fdx) = sect + Preenlisted(targetStudent)%Grade(fdx) = gdxREGD + Section(sect)%Slots = Section(sect)%Slots + 1 + exit + end if + end do + mesg = 'Enlisted by teacher''s prerogative in '//tClassId + isDirtyFORM5 = .true. + end if + end if + + case ('Del') + call cgi_get_named_string(QUERY_STRING, 'A3', tClassId, ierr) + sect = index_to_section(tClassId, NumSections, Section) + if (sect>0) then ! target of action is indexed by sect do fdx=1,Preenlisted(targetStudent)%lenSubject - if (sect==Preenlisted(targetStudent)%Section(fdx)) then - Preenlisted(targetStudent)%Section(fdx) = 0 - Preenlisted(targetStudent)%Grade(fdx) = 0 - Section(sect)%RemSlots = Section(sect)%RemSlots + 1 - exit - end if + if (sect==Preenlisted(targetStudent)%Section(fdx)) then + Preenlisted(targetStudent)%Section(fdx) = 0 + Preenlisted(targetStudent)%Grade(fdx) = 0 + Section(sect)%RemSlots = Section(sect)%RemSlots + 1 + exit + end if end do mesg = 'Deleted '//tClassId isDirtyFORM5 = .true. - end if + end if + + case ('Switch') + + call collect_advice(Advice, n_changes, mesg) + mesg = 'Update ADVICE'//mesg + + Advice%lenSubject = Advice%NPriority+Advice%NAlternates+Advice%NCurrent + do fdx=1,Advice%lenSubject - case ('Switch') - call initialize_pre_enlistment(Advice) - - call cgi_get_named_integer(QUERY_STRING, 'earned', Advice%UnitsEarned, ierr) - call cgi_get_named_integer(QUERY_STRING, 'classification', Advice%StdClassification, ierr) - call cgi_get_named_integer(QUERY_STRING, 'year', Advice%StdYear, ierr) - !write(*,*) Advice%UnitsEarned, Advice%StdClassification, Advice%StdYear - - call cgi_get_named_integer(QUERY_STRING, 'allowed', Advice%AllowedLoad, ierr) - call cgi_get_named_integer(QUERY_STRING, 'group', Advice%StdPriority, ierr) - call cgi_get_named_integer(QUERY_STRING, 'priority', Advice%NPriority, ierr) - call cgi_get_named_integer(QUERY_STRING, 'alternate', Advice%NAlternates, ierr) - call cgi_get_named_integer(QUERY_STRING, 'current', Advice%NCurrent, ierr) - !write(*,*) Advice%AllowedLoad, Advice%StdPriority, Advice%NPriority, Advice%NAlternates - - Advice%lenSubject = Advice%NPriority+Advice%NAlternates+Advice%NCurrent - do fdx=1,Advice%lenSubject - call cgi_get_named_string(QUERY_STRING, 'pri'//itoa(fdx), search_string, ierr) - pos = index(search_string,COMMA) - tSubject = search_string(pos+1:) - read(tSubject,'(f6.4)') Advice%Contrib(fdx) - tSubject = search_string(1:pos-1) - crse = index_to_subject(tSubject) - !write(*,*) crse, tSubject - Advice%Subject(fdx) = crse - ! check if already enlisted - do mdx=1,Preenlisted(targetStudent)%lenSubject - if (Preenlisted(targetStudent)%Subject(mdx)==crse) then + crse = Advice%Subject(fdx) + tSubject = Subject(crse)%Name + ! check if already enlisted + do mdx=1,Preenlisted(targetStudent)%lenSubject + if (Preenlisted(targetStudent)%Subject(mdx)/=crse) cycle if (Preenlisted(targetStudent)%Section(mdx)>0) then - write(*,*) 'Retained section '//Section(Preenlisted(targetStudent)%Section(mdx))%Classid + call html_comment('Retained section '// & + Section(Preenlisted(targetStudent)%Section(mdx))%Classid) else - write(*,*) 'Retained subject '//tSubject + call html_comment('Retained subject '//tSubject) end if Advice%Section(fdx) = Preenlisted(targetStudent)%Section(mdx) Advice%Grade(fdx) = gdxREGD Preenlisted(targetStudent)%Section(mdx) = 0 ! remove section exit - end if - end do - end do - ! free slots for deleted sections - do fdx=1,Preenlisted(targetStudent)%lenSubject - sect = Preenlisted(targetStudent)%Section(fdx) - if (sect>0) then - Section(sect)%RemSlots = Section(sect)%RemSlots + 1 - write(*,*) 'Freed a seat in '//Section(sect)%ClassId - end if - end do - ! update Preenlisted() - Preenlisted(targetStudent) = Advice - isDirtyFORM5 = .true. - - end select - - if (isDirtyFORM5) then - isDirtyPreenlisted = .true. - call xml_write_pre_enlistment(pathToTerm, 'ENLISTMENT', Preenlisted, Section, & - Student(targetStudent)%CurriculumIdx) - end if - - call html_write_header(device, trim(Student(targetStudent)%StdNo)//SPACE//trim(Student(targetStudent)%Name)// & - '
'//text_curriculum_info(Student(targetStudent)%CurriculumIdx), mesg) + end do - ! collect classes for student - call timetable_meetings_of_student(NumSections, Section, targetStudent, Preenlisted, 0, tLen1, tArray, TimeTable, conflicted) - !! - !call enlistment_fees(device, targetStudent, NumSections, Section, '
Estimated fees') - !write(device,AFORMAT) '
' - - call list_sections_to_edit(device, Section, tLen1, tArray, fnChangeMatriculation, tStdNo, 'Del', allowed_to_edit, & - 'Enlisted subjects '//nbsp//trim(make_href(fnPrintableSchedule, 'Printable', & - A1=tStdNo, pre='(', post=')')) ) - if (tLen1>0) call timetable_display(device, Section, TimeTable) - - ! make list of available sections for alternate subjects that fit the schedule of student - tLen2 = 0 - do fdx=1,Preenlisted(targetStudent)%lenSubject - if (Preenlisted(targetStudent)%Section(fdx)/=0) cycle ! already enlisted - tLen2 = tLen2 + 1 - end do - if (tLen2>0) then - mdx = 0 - write(device,AFORMAT) '
Other subjects that may be enlisted: ' - do fdx=1,Preenlisted(targetStudent)%lenSubject - if (Preenlisted(targetStudent)%Section(fdx)==0) then - mdx = mdx+1 - tSubject = Subject(Preenlisted(targetStudent)%Subject(fdx))%Name - write(device,AFORMAT) nbsp//nbsp//trim(itoa(mdx))//'). '//trim(tSubject)//'' + end do + + ! free slots for deleted sections + do fdx=1,Preenlisted(targetStudent)%lenSubject + sect = Preenlisted(targetStudent)%Section(fdx) + if (sect>0) then + Section(sect)%RemSlots = Section(sect)%RemSlots + 1 + call html_comment('Freed a seat in '//Section(sect)%ClassId) + end if + end do + ! update Preenlisted() + Preenlisted(targetStudent) = Advice + isDirtyFORM5 = .true. + + end select + + if (isDirtyFORM5) then + isDirtyPreenlisted = .true. + call xml_write_pre_enlistment(pathToTerm, 'ENLISTMENT', Preenlisted, Section, & + Student(targetStudent)%CurriculumIdx) end if - end do - write(device,AFORMAT) '
' - do fdx=1,Preenlisted(targetStudent)%lenSubject - if (Preenlisted(targetStudent)%Section(fdx)/=0) cycle ! already enlisted - crse = Preenlisted(targetStudent)%Subject(fdx) ! index to subject - tSubject = Subject(crse)%Name - !write(*,*) 'Alternate subject - '//tSubject - !tLen2 = 0 - n_opts = 0 - - do sect=1,NumSections - if (crse/=Section(sect)%SubjectIdx) cycle ! not the right subject - ! add lecture class if a lab class is selected - if (is_lecture_lab_subject(crse) .and. is_lecture_class(sect, Section)) then - cycle - end if - ! check for conflict - if (is_conflict_timetable_with_section(NumSections, Section, sect, TimeTable)) then - !write(*,*) ' Available, but schedule conflict - '//Section(sect)%ClassId - cycle - end if - ! lab section of lect+lab subject or lab-only subject, or section of lect-only subject, is OK - ! if lab section of lect+lab subject, check if lecture schedule also fits - - ! place options at end of Section() array - idx_opt = NumSections + n_opts + 1 - Section(idx_opt) = Section(sect) - if (is_lecture_lab_subject(crse)) then ! find the lecture section - pos = index(Section(sect)%ClassId, DASH) - tClassId = Section(sect)%ClassId(:pos-1) - lect = index_to_section(tClassId, NumSections, Section) - if (is_conflict_timetable_with_section(NumSections, Section, lect, TimeTable)) then ! lecture class is not OK - !write(*,*) ' Available, but lecture class schedule conflict - '//Section(lect)%ClassId - cycle - end if - !write(*,*) 'OPTION IS - '//tClassId - ! add lecture schedule to lab schedule - do mdx=1,Section(lect)%NMeets - pos = Section(idx_opt)%NMeets + 1 - Section(idx_opt)%DayIdx(pos) = Section(lect)%DayIdx(mdx) - Section(idx_opt)%bTimeIdx(pos) = Section(lect)%bTimeIdx(mdx) - Section(idx_opt)%eTimeIdx(pos) = Section(lect)%eTimeIdx(mdx) - Section(idx_opt)%RoomIdx(pos) = Section(lect)%RoomIdx(mdx) - Section(idx_opt)%TeacherIdx(pos) = Section(lect)%TeacherIdx(mdx) - Section(idx_opt)%NMeets = pos - end do ! mdx=1,Section(lect)%NMeets - end if - n_opts = n_opts + 1 - - end do ! sect=1,NumSections - - call timetable_undesirability(n_opts, NumSections, Section, TimeTable) - - ! available sections that fit schedule - can be added + + call html_write_header(device, trim(Student(targetStudent)%StdNo)//SPACE//trim(Student(targetStudent)%Name)// & + '
'//text_curriculum_info(Student(targetStudent)%CurriculumIdx), mesg) + + ! collect classes for student + call timetable_meetings_of_student(NumSections, Section, targetStudent, Preenlisted, 0, tLen1, tArray, TimeTable, & + conflicted) + !! + !call enlistment_fees(device, targetStudent, NumSections, Section, '
Estimated fees') + !write(device,AFORMAT) '
' + + call list_sections_to_edit(device, Section, tLen1, tArray, fnChangeMatriculation, tStdNo, 'Del', allowed_to_edit, & + 'Enlisted subjects '//nbsp//trim(make_href(fnPrintableSchedule, 'Printable', & + A1=tStdNo, pre='(', post=')', alt=SPACE)) ) + if (tLen1>0) call timetable_display(device, Section, TimeTable) + + ! make list of available sections for alternate subjects that fit the schedule of student tLen2 = 0 - do sect=1,n_opts - idx_opt = UndesirabilityRank(sect) - if (Section(NumSections+idx_opt)%RemSlots==0) cycle ! section not available - !write(*,*) sect, idx_opt, Section(NumSections+idx_opt)%ClassId, -Undesirability(idx_opt) - do mdx=1,Section(NumSections+idx_opt)%NMeets - tArray(tLen1+tLen2+1) = NumSections+idx_opt - tArray(tLen1+tLen2+2) = mdx - tArray(tLen1+tLen2+3) = -Undesirability(idx_opt) - tLen2 = tLen2+3 - end do ! mdx=1,Section(sect)%NMeets + do fdx=1,Preenlisted(targetStudent)%lenSubject + if (Preenlisted(targetStudent)%Section(fdx)/=0) cycle ! already enlisted + tLen2 = tLen2 + 1 end do - if (tLen2>0) then ! there are sections that can be added - ! end of list markers - tArray(tLen1+tLen2+1) = 0 - tArray(tLen1+tLen2+2) = 0 - tArray(tLen1+tLen2+3) = 0 - call list_sections_to_edit(device, Section, tLen2, tArray(tLen1+1), & - fnChangeMatriculation, tStdNo, 'Add', allowed_to_edit, & - '
Available sections in '//trim(tSubject)// & - ' that fit existing schedule, sorted by undesirability.') - else ! sections suitable for 'prerog' - do sect=1,n_opts - idx_opt = UndesirabilityRank(sect) - if (Section(NumSections+idx_opt)%RemSlots>0) cycle ! no need to pre-rog here - !write(*,*) sect, idx_opt, Section(NumSections+idx_opt)%ClassId, -Undesirability(idx_opt) - do mdx=1,Section(NumSections+idx_opt)%NMeets - tArray(tLen1+tLen2+1) = NumSections+idx_opt - tArray(tLen1+tLen2+2) = mdx - tArray(tLen1+tLen2+3) = -Undesirability(idx_opt) - tLen2 = tLen2+3 - end do ! mdx=1,Section(sect)%NMeets - end do - ! end of list markers - tArray(tLen1+tLen2+1) = 0 - tArray(tLen1+tLen2+2) = 0 - tArray(tLen1+tLen2+3) = 0 - call list_sections_to_edit(device, Section, tLen2, tArray(tLen1+1), fnChangeMatriculation, tStdNo, 'Prerog', & - allowed_to_edit, '
"TEACHER''S PREROGATIVE" sections in '// & - trim(tSubject)//' that fit existing schedule, sorted by undesirability.') - write(device,AFORMAT) trim(make_href(fnScheduleOfClasses, & - 'here', A1=Department(Subject(crse)%DeptIdx)%Code, & - pre='(The '//trim(tSubject)//' sections are ', post=')
', anchor=tSubject)) + if (tLen2>0) then + mdx = 0 + write(device,AFORMAT) '
Alternate subjects:' + do fdx=1,Preenlisted(targetStudent)%lenSubject + if (Preenlisted(targetStudent)%Section(fdx)==0) then + mdx = mdx+1 + tSubject = Subject(Preenlisted(targetStudent)%Subject(fdx))%Name + write(device,AFORMAT) '
'//trim(itoa(mdx))//'). '//trim(tSubject)//' - '// & + trim(Subject(Preenlisted(targetStudent)%Subject(fdx))%Title) + end if + end do + write(device,AFORMAT) '
' + do fdx=1,Preenlisted(targetStudent)%lenSubject + if (Preenlisted(targetStudent)%Section(fdx)/=0) cycle ! already enlisted + crse = Preenlisted(targetStudent)%Subject(fdx) ! index to subject + tSubject = Subject(crse)%Name + !write(*,*) 'Alternate subject - '//tSubject + !tLen2 = 0 + n_opts = 0 + + do sect=1,NumSections + if (crse/=Section(sect)%SubjectIdx) cycle ! not the right subject + ! add lecture class if a lab class is selected + if (is_lecture_lab_subject(crse) .and. is_lecture_class(sect, Section)) then + cycle + end if + ! check for conflict + if (is_conflict_timetable_with_section(NumSections, Section, sect, TimeTable)) then + !write(*,*) ' Available, but schedule conflict - '//Section(sect)%ClassId + cycle + end if + ! lab section of lect+lab subject or lab-only subject, or section of lect-only subject, is OK + ! if lab section of lect+lab subject, check if lecture schedule also fits + + ! place options at end of Section() array + idx_opt = NumSections + n_opts + 1 + Section(idx_opt) = Section(sect) + if (is_lecture_lab_subject(crse)) then ! find the lecture section + pos = index(Section(sect)%ClassId, DASH) + tClassId = Section(sect)%ClassId(:pos-1) + lect = index_to_section(tClassId, NumSections, Section) + if (is_conflict_timetable_with_section(NumSections, Section, lect, TimeTable)) then ! lecture class is not OK + !write(*,*) ' Available, but lecture class schedule conflict - '//Section(lect)%ClassId + cycle + end if + !write(*,*) 'OPTION IS - '//tClassId + ! add lecture schedule to lab schedule + do mdx=1,Section(lect)%NMeets + pos = Section(idx_opt)%NMeets + 1 + Section(idx_opt)%DayIdx(pos) = Section(lect)%DayIdx(mdx) + Section(idx_opt)%bTimeIdx(pos) = Section(lect)%bTimeIdx(mdx) + Section(idx_opt)%eTimeIdx(pos) = Section(lect)%eTimeIdx(mdx) + Section(idx_opt)%RoomIdx(pos) = Section(lect)%RoomIdx(mdx) + Section(idx_opt)%TeacherIdx(pos) = Section(lect)%TeacherIdx(mdx) + Section(idx_opt)%NMeets = pos + end do ! mdx=1,Section(lect)%NMeets + end if + n_opts = n_opts + 1 + + end do ! sect=1,NumSections + + call timetable_undesirability(n_opts, NumSections, Section, TimeTable) + + ! available sections that fit schedule - can be added + tLen2 = 0 + do sect=1,n_opts + idx_opt = UndesirabilityRank(sect) + if (Section(NumSections+idx_opt)%RemSlots<=0) cycle ! section not available + !write(*,*) sect, idx_opt, Section(NumSections+idx_opt)%ClassId, -Undesirability(idx_opt) + do mdx=1,Section(NumSections+idx_opt)%NMeets + tArray(tLen1+tLen2+1) = NumSections+idx_opt + tArray(tLen1+tLen2+2) = mdx + tArray(tLen1+tLen2+3) = -Undesirability(idx_opt) + tLen2 = tLen2+3 + end do ! mdx=1,Section(sect)%NMeets + end do + if (tLen2>0) then ! there are sections that can be added + ! end of list markers + tArray(tLen1+tLen2+1) = 0 + tArray(tLen1+tLen2+2) = 0 + tArray(tLen1+tLen2+3) = 0 + call list_sections_to_edit(device, Section, tLen2, tArray(tLen1+1), & + fnChangeMatriculation, tStdNo, 'Add', allowed_to_edit, & + '
'// & + green//'AVAILABLE sections'//black//' in '//trim(tSubject)// & + ' that fit existing schedule, sorted by undesirability.') + else ! sections suitable for 'prerog' + do sect=1,n_opts + idx_opt = UndesirabilityRank(sect) + if (Section(NumSections+idx_opt)%RemSlots>0) cycle ! no need to pre-rog here + !write(*,*) sect, idx_opt, Section(NumSections+idx_opt)%ClassId, -Undesirability(idx_opt) + do mdx=1,Section(NumSections+idx_opt)%NMeets + tArray(tLen1+tLen2+1) = NumSections+idx_opt + tArray(tLen1+tLen2+2) = mdx + tArray(tLen1+tLen2+3) = -Undesirability(idx_opt) + tLen2 = tLen2+3 + end do ! mdx=1,Section(sect)%NMeets + end do + ! end of list markers + tArray(tLen1+tLen2+1) = 0 + tArray(tLen1+tLen2+2) = 0 + tArray(tLen1+tLen2+3) = 0 + call list_sections_to_edit(device, Section, tLen2, tArray(tLen1+1), fnChangeMatriculation, tStdNo, 'Prerog', & + allowed_to_edit, '
'// & + red//'"TEACHER''S PREROGATIVE" sections'//black//' in '// & + trim(tSubject)//' that fit existing schedule, sorted by undesirability.') + write(device,AFORMAT) trim(make_href(fnScheduleOfClasses, & + 'here', A1=Department(Subject(crse)%DeptIdx)%Code, & + pre='(The '//trim(tSubject)//' sections are ', post=')
', anchor=tSubject)) + + end if + + end do ! fdx=1,Preenlisted(targetStudent)%lenSubject end if - - end do ! fdx=1,Preenlisted(targetStudent)%lenSubject - - end if - write(device,AFORMAT) '
' - return - end subroutine enlistment_edit - - - subroutine enlistment_fees(device, std, NumSections, Section, heading) - integer, intent(in) :: device, std - integer, intent (in) :: NumSections - type (TYPE_SECTION), intent(in) :: Section(0:) - character (len=*), intent(in), optional :: heading - integer :: idx, sect, crse - real :: mult, totalUnits, totalA, totalB, totalC, totalD, totalE, totalGraduate, totalLabFee - - ! Tuition fees by bracket - real, parameter :: & - TuitionA = 1500.0, & - TuitionB = 1000.0, & - TuitionC = 600.0, & - TuitionD = 300.0, & - TuitionE = 0.0, & - TuitionGraduate = 1000.0, & - NSTPA = 2250.0, & - NSTPB = 1500.0, & - NSTPC = 900.0, & - NSTPD = 450.0, & - NSTPE = 0.0, & - MiscellaneousA = 2000.0, & - MiscellaneousB = 2000.0, & - MiscellaneousC = 2000.0, & - MiscellaneousD = 0.0, & - MiscellaneousE = 0.0, & - MiscellaneousGraduate = 1065.0, & - StudentFund = 45.5, & - EntranceFee = 30.0, & - DepositFee = 100.0, & - IDFee = 130.0, & - EducationDevelopment = 0.0 - - if (present(heading)) write(device,AFORMAT) heading - - write(device,AFORMAT) ''//begintr, & + write(device,AFORMAT) '
' + + end subroutine enlistment_edit + + + subroutine enlistment_fees(device, std, NumSections, Section, heading) + integer, intent(in) :: device, std + integer, intent (in) :: NumSections + type (TYPE_SECTION), intent(in) :: Section(0:) + character (len=*), intent(in), optional :: heading + integer :: idx, sect, crse + real :: mult, totalUnits, totalA, totalB, totalC, totalD, totalE, totalGraduate, totalLabFee + + ! Tuition fees by bracket + real, parameter :: & + TuitionA = 1500.0, & + TuitionB = 1000.0, & + TuitionC = 600.0, & + TuitionD = 300.0, & + TuitionE = 0.0, & + TuitionGraduate = 1000.0, & + NSTPA = 2250.0, & + NSTPB = 1500.0, & + NSTPC = 900.0, & + NSTPD = 450.0, & + NSTPE = 0.0, & + MiscellaneousA = 2000.0, & + MiscellaneousB = 2000.0, & + MiscellaneousC = 2000.0, & + MiscellaneousD = 0.0, & + MiscellaneousE = 0.0, & + MiscellaneousGraduate = 1065.0, & + StudentFund = 45.5, & + EntranceFee = 30.0, & + DepositFee = 100.0, & + IDFee = 130.0, & + EducationDevelopment = 0.0 + + if (present(heading)) write(device,AFORMAT) heading + + write(device,AFORMAT) '
'//begintr, & thalignleft//'Subject'//endth// & thalignleft//'Section'//endth// & thalignright//'Units'//endth//& @@ -521,328 +616,330 @@ subroutine enlistment_fees(device, std, NumSections, Section, heading) thalignright//'Graduate'//endth// & thalignright//'Lab/Other'//endth//endtr - totalUnits = 0.0 - totalA = 0.0 - totalB = 0.0 - totalC = 0.0 - totalD = 0.0 - totalE = 0.0 - totalGraduate = 0.0 - totalLabFee = 0.0 - do idx=1,Preenlisted(std)%lenSubject ! loop over all entries in Preenlisted() for student - sect = Preenlisted(std)%Section(idx) - if (sect==0) cycle ! not enlisted - crse = Preenlisted(std)%Subject(idx) - mult = Subject(crse)%Units - totalUnits = totalUnits + mult - write(device,AFORMAT) begintr//begintd//trim(Subject(crse)%Name)//endtd// & ! subject - begintd//trim(Section(sect)%Code)//endtd ! code - - ! NSTP ? - if (index(Subject(crse)%Name, 'CWTS') + index(Subject(crse)%Name, 'LTS')>0) then + totalUnits = 0.0 + totalA = 0.0 + totalB = 0.0 + totalC = 0.0 + totalD = 0.0 + totalE = 0.0 + totalGraduate = 0.0 + totalLabFee = 0.0 + do idx=1,Preenlisted(std)%lenSubject ! loop over all entries in Preenlisted() for student + sect = Preenlisted(std)%Section(idx) + if (sect==0) cycle ! not enlisted + crse = Preenlisted(std)%Subject(idx) + mult = Subject(crse)%Units + totalUnits = totalUnits + mult + write(device,AFORMAT) begintr//begintd//trim(Subject(crse)%Name)//endtd// & ! subject + begintd//trim(Section(sect)%Code)//endtd ! code + + ! NSTP ? + if (index(Subject(crse)%Name, 'CWTS') + index(Subject(crse)%Name, 'LTS')>0) then write(device,'(a,f9.1,a)') & - tdnbspendtd// & ! units - tdalignright, NSTPA, endtd, & ! NSTP A - tdalignright, NSTPB, endtd, & ! NSTP B - tdalignright, NSTPC, endtd, & ! NSTP C - tdalignright, NSTPD, endtd, & ! NSTP D - tdalignright, NSTPE, endtd, & ! NSTP E - tdnbspendtd ! NSTP Graduate + tdnbspendtd// & ! units + tdalignright, NSTPA, endtd, & ! NSTP A + tdalignright, NSTPB, endtd, & ! NSTP B + tdalignright, NSTPC, endtd, & ! NSTP C + tdalignright, NSTPD, endtd, & ! NSTP D + tdalignright, NSTPE, endtd, & ! NSTP E + tdnbspendtd ! NSTP Graduate totalA = totalA + NSTPA totalB = totalB + NSTPB totalC = totalC + NSTPC totalD = totalD + NSTPD totalE = totalE + NSTPE - else ! lecture class of a lect-lab/recit subject, lecture-only, lab-only + else ! lecture class of a lect-lab/recit subject, lecture-only, lab-only ! compute tuition here write(device,'(a,f9.1,a)') & - tdalignright, mult, endtd, & ! units - tdalignright, TuitionA*mult, endtd, & ! Tuition A - tdalignright, TuitionB*mult, endtd, & ! Tuition B - tdalignright, TuitionC*mult, endtd, & ! Tuition C - tdalignright, TuitionD*mult, endtd, & ! Tuition D - tdalignright, TuitionE*mult, endtd, & ! Tuition E - tdalignright, TuitionGraduate*mult, endtd ! Tuition Graduate + tdalignright, mult, endtd, & ! units + tdalignright, TuitionA*mult, endtd, & ! Tuition A + tdalignright, TuitionB*mult, endtd, & ! Tuition B + tdalignright, TuitionC*mult, endtd, & ! Tuition C + tdalignright, TuitionD*mult, endtd, & ! Tuition D + tdalignright, TuitionE*mult, endtd, & ! Tuition E + tdalignright, TuitionGraduate*mult, endtd ! Tuition Graduate totalA = totalA + TuitionA*mult totalB = totalB + TuitionB*mult totalC = totalC + TuitionC*mult totalD = totalD + TuitionD*mult totalE = totalE + TuitionE*mult totalGraduate = totalGraduate + TuitionGraduate*mult - end if - if (Subject(crse)%LabFee>0.0) then ! subject has additional fee + end if + if (Subject(crse)%LabFee>0.0) then ! subject has additional fee write(device,'(a,f9.1,a)') & tdalignright, Subject(crse)%LabFee, endtd//endtr totalLabFee = totalLabFee + Subject(crse)%LabFee - else + else write(device,AFORMAT) tdnbspendtd//endtr - end if - end do - - ! sub totals - write(device,AFORMAT) & - begintr//'
'//endtd//endtr, & - begintr//'		Tuition Subtotal'//endtd - write(device,'(a,f9.1,a)') & - tdalignright, totalUnits, endtd, & ! units - tdalignright, totalA, endtd, & ! Total A - tdalignright, totalB, endtd, & ! Total B - tdalignright, totalC, endtd, & ! Total C - tdalignright, totalD, endtd, & ! Total D - tdalignright, totalE, endtd, & ! Total E - tdalignright, totalGraduate, endtd, & ! Total Graduate - tdalignright, totalLabFee, endtd//endtr, & ! Total Lab - begintr//'
'//endtd//endtr - - ! miscellaneous - write(device,AFORMAT) begintr//'		Miscellaneous'//endtd//tdnbspendtd - write(device,'(a,f9.1,a)') & - tdalignright, MiscellaneousA, endtd, & ! Misc A - tdalignright, MiscellaneousB, endtd, & ! Misc B - tdalignright, MiscellaneousC, endtd, & ! Misc C - tdalignright, MiscellaneousD, endtd, & ! Misc D - tdalignright, MiscellaneousE, endtd, & ! Misc E - tdalignright, MiscellaneousGraduate, endtd, & ! Misc Graduate - tdnbspendtd//endtr ! Lab - totalA = totalA + MiscellaneousA - totalB = totalB + MiscellaneousB - totalC = totalC + MiscellaneousC - totalD = totalD + MiscellaneousD - totalE = totalE + MiscellaneousE - totalGraduate = totalGraduate + MiscellaneousGraduate - ! StudentFund - write(device,AFORMAT) begintr//'Student Fund'//endtd//tdnbspendtd - write(device,'(a,f9.1,a)') & - tdalignright, StudentFund, endtd, & ! A - tdalignright, StudentFund, endtd, & ! B - tdalignright, StudentFund, endtd, & ! C - tdalignright, StudentFund, endtd, & ! D - tdalignright, StudentFund, endtd, & ! E - tdalignright, StudentFund, endtd, & ! Graduate - tdnbspendtd//endtr ! Lab - totalA = totalA + StudentFund - totalB = totalB + StudentFund - totalC = totalC + StudentFund - totalD = totalD + StudentFund - totalE = totalE + StudentFund - totalGraduate = totalGraduate + StudentFund - ! EntranceFee - write(device,AFORMAT) begintr//'Entrance Fee'//endtd//tdnbspendtd - write(device,'(a,f9.1,a)') & - tdalignright, EntranceFee, endtd, & ! A - tdalignright, EntranceFee, endtd, & ! B - tdalignright, EntranceFee, endtd, & ! C - tdalignright, EntranceFee, endtd, & ! D - tdalignright, EntranceFee, endtd, & ! E - tdalignright, EntranceFee, endtd, & ! Graduate - tdnbspendtd//endtr ! Lab - totalA = totalA + EntranceFee - totalB = totalB + EntranceFee - totalC = totalC + EntranceFee - totalD = totalD + EntranceFee - totalE = totalE + EntranceFee - totalGraduate = totalGraduate + EntranceFee - ! DepositFee - write(device,AFORMAT) begintr//'Deposit'//endtd//tdnbspendtd - write(device,'(a,f9.1,a)') & - tdalignright, DepositFee, endtd, & ! A - tdalignright, DepositFee, endtd, & ! B - tdalignright, DepositFee, endtd, & ! C - tdalignright, DepositFee, endtd, & ! D - tdalignright, DepositFee, endtd, & ! E - tdalignright, DepositFee, endtd, & ! Graduate - tdnbspendtd//endtr ! Lab - totalA = totalA + DepositFee - totalB = totalB + DepositFee - totalC = totalC + DepositFee - totalD = totalD + DepositFee - totalE = totalE + DepositFee - totalGraduate = totalGraduate + DepositFee - ! IDFee - write(device,AFORMAT) begintr//'ID Fee'//endtd//tdnbspendtd - write(device,'(a,f9.1,a)') & - tdalignright, IDFee, endtd, & ! A - tdalignright, IDFee, endtd, & ! B - tdalignright, IDFee, endtd, & ! C - tdalignright, IDFee, endtd, & ! D - tdalignright, IDFee, endtd, & ! E - tdalignright, IDFee, endtd, & ! Graduate - tdnbspendtd//endtr ! Lab - totalA = totalA + IDFee - totalB = totalB + IDFee - totalC = totalC + IDFee - totalD = totalD + IDFee - totalE = totalE + IDFee - totalGraduate = totalGraduate + IDFee - - ! EducationDevelopment - write(device,AFORMAT) begintr//'Education Development'//endtd//tdnbspendtd - write(device,'(a,f9.1,a)') & - ''//nbsp//endtd//tdalignright, EducationDevelopment, endtd//endtr ! Lab - totalLabFee = totalLabFee+ EducationDevelopment - - ! totals - write(device,AFORMAT) & - begintr//'
'//endtd//endtr, & - begintr//'		TOTAL'//endth - write(device,'(a,f9.1,a)') & - thalignright, totalA, endth, & ! Total A - thalignright, totalB, endth, & ! Total B - thalignright, totalC, endth, & ! Total C - thalignright, totalD, endth, & ! Total D - thalignright, totalE, endth, & ! Total E - thalignright, totalGraduate, endth, & ! Total Graduate - thalignright, totalLabFee, endth//endtr ! Total Lab - - write(device,AFORMAT) '
' - - return - end subroutine enlistment_fees - - - subroutine enlistment_printable (device, NumSections, Section) - integer, intent (in) :: device - integer, intent (in out) :: NumSections - type (TYPE_SECTION), intent(in out) :: Section(0:) - character(len=MAX_LEN_STUDENT_CODE) :: tStdNo - integer :: ierr, tLen1 - integer, dimension(60,6) :: TimeTable - logical :: conflicted - - ! which student? - call cgi_get_named_string(QUERY_STRING, 'A1', tStdNo, ierr) - targetStudent = index_to_student(tStdNo) - targetCurriculum = Student(targetStudent)%CurriculumIdx - - call timetable_meetings_of_student(NumSections, Section, targetStudent, Preenlisted, 0, tLen1, tArray, TimeTable, conflicted) - call enlistment_class_schedule(device, targetStudent, NumSections, Section, tLen1, tArray) - !call timetable_display(device, Section, TimeTable) - - write(device,AFORMAT) '
' - return - end subroutine enlistment_printable - - - subroutine enlistment_find_block(device, NumSections, Section, NumBlocks, Block) - integer, intent (in) :: device - integer, intent (in out) :: NumBlocks, NumSections - type (TYPE_SECTION), intent(in out) :: Section(0:) - type (TYPE_BLOCK), intent(in out) :: Block(0:) - character(len=MAX_LEN_STUDENT_CODE) :: tStdNo - integer :: ierr, crse, sect, seats - integer :: bdx, fdx, blk, n_blks, n_matches - logical :: matched - !character(len=MAX_LEN_DEPARTMENT_CODE) :: tDepartment - !character(len=3*MAX_LEN_SUBJECT_CODE) :: tAction, search_string - !character(len=MAX_LEN_SUBJECT_CODE) :: tSubject - !character(len=127) :: mesg - !logical :: allowed_to_edit - - - ! which student? - call cgi_get_named_string(QUERY_STRING, 'A1', tStdNo, ierr) - targetStudent = index_to_student(tStdNo) - targetCurriculum = Student(targetStudent)%CurriculumIdx - targetCollege = Curriculum(targetCurriculum)%CollegeIdx - !tDepartment = College(targetCollege)%Code - !targetDepartment = index_to_dept(tDepartment) - !allowed_to_edit = isRoleAdmin .or. (isRoleSRE .and. CurrProgCode(CurriculumIdxUser)==CurrProgCode(targetCurriculum)) - - call recalculate_available_seats(Section) - - call html_write_header(device, trim(Student(targetStudent)%StdNo)//SPACE//trim(Student(targetStudent)%Name)// & - SPACE//DASH//SPACE//trim(Curriculum(targetCurriculum)%Code)) - - write(device,AFORMAT) ''//begintr, & + end if + end do + + ! sub totals + write(device,AFORMAT) & + begintr//'
'//endtd//endtr, & + begintr//'		Tuition Subtotal'//endtd + write(device,'(a,f9.1,a)') & + tdalignright, totalUnits, endtd, & ! units + tdalignright, totalA, endtd, & ! Total A + tdalignright, totalB, endtd, & ! Total B + tdalignright, totalC, endtd, & ! Total C + tdalignright, totalD, endtd, & ! Total D + tdalignright, totalE, endtd, & ! Total E + tdalignright, totalGraduate, endtd, & ! Total Graduate + tdalignright, totalLabFee, endtd//endtr, & ! Total Lab + begintr//'
'//endtd//endtr + + ! miscellaneous + write(device,AFORMAT) begintr//'		Miscellaneous'//endtd//tdnbspendtd + write(device,'(a,f9.1,a)') & + tdalignright, MiscellaneousA, endtd, & ! Misc A + tdalignright, MiscellaneousB, endtd, & ! Misc B + tdalignright, MiscellaneousC, endtd, & ! Misc C + tdalignright, MiscellaneousD, endtd, & ! Misc D + tdalignright, MiscellaneousE, endtd, & ! Misc E + tdalignright, MiscellaneousGraduate, endtd, & ! Misc Graduate + tdnbspendtd//endtr ! Lab + totalA = totalA + MiscellaneousA + totalB = totalB + MiscellaneousB + totalC = totalC + MiscellaneousC + totalD = totalD + MiscellaneousD + totalE = totalE + MiscellaneousE + totalGraduate = totalGraduate + MiscellaneousGraduate + ! StudentFund + write(device,AFORMAT) begintr//'Student Fund'//endtd//tdnbspendtd + write(device,'(a,f9.1,a)') & + tdalignright, StudentFund, endtd, & ! A + tdalignright, StudentFund, endtd, & ! B + tdalignright, StudentFund, endtd, & ! C + tdalignright, StudentFund, endtd, & ! D + tdalignright, StudentFund, endtd, & ! E + tdalignright, StudentFund, endtd, & ! Graduate + tdnbspendtd//endtr ! Lab + totalA = totalA + StudentFund + totalB = totalB + StudentFund + totalC = totalC + StudentFund + totalD = totalD + StudentFund + totalE = totalE + StudentFund + totalGraduate = totalGraduate + StudentFund + ! EntranceFee + write(device,AFORMAT) begintr//'Entrance Fee'//endtd//tdnbspendtd + write(device,'(a,f9.1,a)') & + tdalignright, EntranceFee, endtd, & ! A + tdalignright, EntranceFee, endtd, & ! B + tdalignright, EntranceFee, endtd, & ! C + tdalignright, EntranceFee, endtd, & ! D + tdalignright, EntranceFee, endtd, & ! E + tdalignright, EntranceFee, endtd, & ! Graduate + tdnbspendtd//endtr ! Lab + totalA = totalA + EntranceFee + totalB = totalB + EntranceFee + totalC = totalC + EntranceFee + totalD = totalD + EntranceFee + totalE = totalE + EntranceFee + totalGraduate = totalGraduate + EntranceFee + ! DepositFee + write(device,AFORMAT) begintr//'Deposit'//endtd//tdnbspendtd + write(device,'(a,f9.1,a)') & + tdalignright, DepositFee, endtd, & ! A + tdalignright, DepositFee, endtd, & ! B + tdalignright, DepositFee, endtd, & ! C + tdalignright, DepositFee, endtd, & ! D + tdalignright, DepositFee, endtd, & ! E + tdalignright, DepositFee, endtd, & ! Graduate + tdnbspendtd//endtr ! Lab + totalA = totalA + DepositFee + totalB = totalB + DepositFee + totalC = totalC + DepositFee + totalD = totalD + DepositFee + totalE = totalE + DepositFee + totalGraduate = totalGraduate + DepositFee + ! IDFee + write(device,AFORMAT) begintr//'ID Fee'//endtd//tdnbspendtd + write(device,'(a,f9.1,a)') & + tdalignright, IDFee, endtd, & ! A + tdalignright, IDFee, endtd, & ! B + tdalignright, IDFee, endtd, & ! C + tdalignright, IDFee, endtd, & ! D + tdalignright, IDFee, endtd, & ! E + tdalignright, IDFee, endtd, & ! Graduate + tdnbspendtd//endtr ! Lab + totalA = totalA + IDFee + totalB = totalB + IDFee + totalC = totalC + IDFee + totalD = totalD + IDFee + totalE = totalE + IDFee + totalGraduate = totalGraduate + IDFee + + ! EducationDevelopment + write(device,AFORMAT) begintr//'Education Development'//endtd//tdnbspendtd + write(device,'(a,f9.1,a)') & + ''//nbsp//endtd//tdalignright, EducationDevelopment, endtd//endtr ! Lab + totalLabFee = totalLabFee+ EducationDevelopment + + ! totals + write(device,AFORMAT) & + begintr//'
'//endtd//endtr, & + begintr//'		TOTAL'//endth + write(device,'(a,f9.1,a)') & + thalignright, totalA, endth, & ! Total A + thalignright, totalB, endth, & ! Total B + thalignright, totalC, endth, & ! Total C + thalignright, totalD, endth, & ! Total D + thalignright, totalE, endth, & ! Total E + thalignright, totalGraduate, endth, & ! Total Graduate + thalignright, totalLabFee, endth//endtr ! Total Lab + + write(device,AFORMAT) '
' + + + end subroutine enlistment_fees + + + subroutine enlistment_printable (device, NumSections, Section) + integer, intent (in) :: device + integer, intent (in out) :: NumSections + type (TYPE_SECTION), intent(in out) :: Section(0:) + character(len=MAX_LEN_STUDENT_CODE) :: tStdNo + integer :: ierr, tLen1 + integer, dimension(60,6) :: TimeTable + logical :: conflicted + + ! which student? + call cgi_get_named_string(QUERY_STRING, 'A1', tStdNo, ierr) + targetStudent = index_to_student(tStdNo) + targetCurriculum = Student(targetStudent)%CurriculumIdx + + call timetable_meetings_of_student(NumSections, Section, targetStudent, Preenlisted, 0, tLen1, tArray, & + TimeTable, conflicted) + call enlistment_class_schedule(device, targetStudent, NumSections, Section, tLen1, tArray) + !call timetable_display(device, Section, TimeTable) + + write(device,AFORMAT) '
' + + end subroutine enlistment_printable + + + subroutine enlistment_find_block(device, NumSections, Section, NumBlocks, Block) + integer, intent (in) :: device + integer, intent (in out) :: NumBlocks, NumSections + type (TYPE_SECTION), intent(in out) :: Section(0:) + type (TYPE_BLOCK), intent(in out) :: Block(0:) + character(len=MAX_LEN_STUDENT_CODE) :: tStdNo + integer :: ierr, crse, sect, seats + integer :: bdx, fdx, blk, n_blks, n_matches + logical :: matched + !character(len=MAX_LEN_DEPARTMENT_CODE) :: tDepartment + !character(len=3*MAX_LEN_SUBJECT_CODE) :: tAction, search_string + !character(len=MAX_LEN_SUBJECT_CODE) :: tSubject + !character(len=127) :: mesg + !logical :: allowed_to_edit + + + ! which student? + call cgi_get_named_string(QUERY_STRING, 'A1', tStdNo, ierr) + targetStudent = index_to_student(tStdNo) + targetCurriculum = Student(targetStudent)%CurriculumIdx + targetCollege = Curriculum(targetCurriculum)%CollegeIdx + !tDepartment = College(targetCollege)%Code + !targetDepartment = index_to_dept(tDepartment) + !allowed_to_edit = isRoleAdmin .or. (isRoleSRE .and. CurrProgCode(CurriculumIdxUser)==CurrProgCode(targetCurriculum)) + + call recalculate_available_seats(Section) + + call html_write_header(device, trim(Student(targetStudent)%StdNo)//SPACE//trim(Student(targetStudent)%Name)// & + SPACE//DASH//SPACE//trim(Curriculum(targetCurriculum)%Code)) + + write(device,AFORMAT) ''//begintr, & thalignleft//'Block ID'//endth// & thalignleft//'# Matches'//endth// & thalignleft//'Class ID (seats)'//endth//endtr - n_blks = 0 - do blk=1,NumBlocks - if (CurrProgCode(Block(blk)%CurriculumIdx)/=CurrProgCode(targetCurriculum)) cycle ! not this curriculum - ! count how many subjects in this block match the predicted subjects of the student - n_matches = 0 - do bdx=1,Block(blk)%NumClasses - crse = Block(blk)%Subject(bdx) - do fdx=1,Preenlisted(targetStudent)%lenSubject - if (crse/=Preenlisted(targetStudent)%Subject(fdx)) cycle - n_matches = n_matches+1 - exit - end do - end do - if (n_matches==0) cycle - n_blks = n_blks + 1 - !write(device,'(a,3(i3,a))') '
'//Block(blk)%BlockID//' :', & - ! n_matches, '/'(blk)%NumClasses, ' matches, from ', & - ! Preenlisted(targetStudent)%lenSubject, ' feasible subjects of '//Student(targetStudent)%StdNo - write(device,AFORMAT) begintr// & - begintd//trim(make_href(fnBlockSchedule, Block(blk)%BlockID, A1=Block(blk)%BlockID))//endtd// & - begintd//trim(itoa(n_matches))//SPACE//FSLASH//SPACE//trim(itoa(Block(blk)%NumClasses))//endtd// & - begintd - matched = .false. - do bdx=1,Block(blk)%NumClasses - crse = Block(blk)%Subject(bdx) - do fdx=1,Preenlisted(targetStudent)%lenSubject - if (crse/=Preenlisted(targetStudent)%Subject(fdx)) cycle - matched = .true. - exit - end do - if (.not. matched) cycle - sect = Block(blk)%Section(bdx) - if (sect/=0) then - seats = Section(sect)%RemSlots - if (seats>0) then - write(device,AFORMAT) green//trim(Section(sect)%ClassId)//' ('// & - trim(itoa(seats))//') '//black//' /'//nbsp + n_blks = 0 + do blk=1,NumBlocks + if (CurrProgCode(Block(blk)%CurriculumIdx)/=CurrProgCode(targetCurriculum)) cycle ! not this curriculum + ! count how many subjects in this block match the predicted subjects of the student + n_matches = 0 + do bdx=1,Block(blk)%NumClasses + crse = Block(blk)%Subject(bdx) + do fdx=1,Preenlisted(targetStudent)%lenSubject + if (crse/=Preenlisted(targetStudent)%Subject(fdx)) cycle + n_matches = n_matches+1 + exit + end do + end do + if (n_matches==0) cycle + n_blks = n_blks + 1 + !write(device,'(a,3(i3,a))') '
'//Block(blk)%BlockID//' :', & + ! n_matches, '/'(blk)%NumClasses, ' matches, from ', & + ! Preenlisted(targetStudent)%lenSubject, ' feasible subjects of '//Student(targetStudent)%StdNo + write(device,AFORMAT) begintr// & + begintd//trim(make_href(fnBlockSchedule, Block(blk)%BlockID, A1=Block(blk)%BlockID))//endtd// & + begintd//trim(itoa(n_matches))//SPACE//FSLASH//SPACE//trim(itoa(Block(blk)%NumClasses))//endtd// & + begintd + matched = .false. + do bdx=1,Block(blk)%NumClasses + crse = Block(blk)%Subject(bdx) + do fdx=1,Preenlisted(targetStudent)%lenSubject + if (crse/=Preenlisted(targetStudent)%Subject(fdx)) cycle + matched = .true. + exit + end do + if (.not. matched) cycle + sect = Block(blk)%Section(bdx) + if (sect/=0) then + seats = Section(sect)%RemSlots + if (seats>0) then + write(device,AFORMAT) ''//green//trim(Section(sect)%ClassId)//' ('// & + trim(itoa(seats))//') '//black//' /'//nbsp + else + write(device,AFORMAT) ''//green//trim(Section(sect)%ClassId)//black//red//' ('// & + trim(itoa(seats))//') '//black//' /'//nbsp + end if else - write(device,AFORMAT) green//trim(Section(sect)%ClassId)//black//red//' ('// & - trim(itoa(seats))//') '//black//' /'//nbsp + write(device,AFORMAT) ''//red//trim(Subject(crse)%Name)//black//' /'//nbsp end if - else - write(device,AFORMAT) red//trim(Subject(crse)%Name)//black//' /'//nbsp - end if - if (mod(bdx,4)==0 .and. Block(blk)%NumClasses>4) then - write(device,AFORMAT) endtd//endtr// & ! end row - begintr//tdnbspendtd//tdnbspendtd//begintd ! new row with first 2 columns empty - end if - end do - write(device,AFORMAT) trim(make_href(fnChangeMatriculation, 'Enlist', A1=tStdNo, A2='Block', & - A3=Block(blk)%BlockID, pre=nbsp, post=endtd//endtr)) - end do - if (n_blks==0) then + if (mod(bdx,4)==0 .and. Block(blk)%NumClasses>4) then + write(device,AFORMAT) endtd//endtr// & ! end row + begintr//tdnbspendtd//tdnbspendtd//begintd ! new row with first 2 columns empty + end if + end do + write(device,AFORMAT) trim(make_href(fnChangeMatriculation, 'Enlist', A1=tStdNo, A2='Block', & + A3=Block(blk)%BlockID, pre=nbsp, post=endtd//endtr, alt=SPACE)) + end do + if (n_blks==0) then write(device,AFORMAT) begintr//'
No suitable blocks for this student?'//endtd//endtr - end if - write(device,AFORMAT) '
', & - '
NOTES : A '//green//'Class ID (seats)'//black//' is open. A '//green//'Class ID '//black, & - red//'(0)'//black//' is NOT available. A '//red//'SUBJECT'//black//' is NOT assigned to a section.', & - ' "Enlist" will enlist the student ONLY in the open sections of a block.', & - '
' - return - end subroutine enlistment_find_block - - - subroutine enlistment_class_schedule(device, std, NumSections, Section, lenSL, SectionList) - integer, intent(in) :: device, std, NumSections, lenSL, SectionList(3*lenSL+3) - type (TYPE_SECTION), intent(in) :: Section(0:) - integer :: crse, idx, mdx, sect, previous, conflict - real :: totalUnits, classUnits, totalHours, classHours, totalTuition, classTuition, totalLabFee, classLabFee - - write(device,AFORMAT) ''//trim(Student(std)%StdNo)//SPACE//trim(Student(std)%Name)// & + end if + write(device,AFORMAT) '', & + '
NOTES : A '//green//'Class ID (seats)'//black//' is open. A '//green//'Class ID '//black, & + red//'(0)'//black//' is NOT available. A '//red//'SUBJECT'//black//' is NOT assigned to a section.', & + '
"Enlist" will add the student ONLY to the open sections of a block.', & + '
Seats in an open section may be taken while you are reading this.', & + '
' + + end subroutine enlistment_find_block + + + subroutine enlistment_class_schedule(device, std, NumSections, Section, lenSL, SectionList) + integer, intent(in) :: device, std, NumSections, lenSL, SectionList(3*lenSL+3) + type (TYPE_SECTION), intent(in) :: Section(0:) + integer :: crse, idx, mdx, sect, previous, conflict + real :: totalUnits, classUnits, totalHours, classHours, totalTuition, classTuition, totalLabFee, classLabFee + + write(device,AFORMAT) ''//trim(Student(std)%StdNo)//SPACE//trim(Student(std)%Name)// & '
'//text_curriculum_info(Student(std)%CurriculumIdx)//'
'// & - trim(txtSemester(currentTerm+3))//' Term, '//text_school_year(currentYear)//'
' + trim(txtSemester(currentTerm+3))//' Term, '//text_school_year(currentYear)//'
' - if (lenSL < 3) then - write(device,AFORMAT) '
Not pre-registered in any class?
' - return - end if + if (lenSL < 3) then + write(device,AFORMAT) '
Not pre-registered in any class?
' + return + end if - totalUnits = 0.0 - totalHours = 0.0 - totalTuition = 0.0 - totalLabFee = 0.0 + totalUnits = 0.0 + totalHours = 0.0 + totalTuition = 0.0 + totalLabFee = 0.0 - write(device,AFORMAT) ''//begintr, & + write(device,AFORMAT) '
'//begintr, & thalignleft//'Subject'//endth// & thalignleft//'Section'//endth//& thalignleft//'Units'//endth// & @@ -853,112 +950,112 @@ subroutine enlistment_class_schedule(device, std, NumSections, Section, lenSL, S thalignleft//'Day'//endth//& thalignleft//'Room'//endth//endtr - previous = 0 - do idx=1,lenSL,3 - sect=SectionList(idx) - !mdx=SectionList(idx+1) - conflict=SectionList(idx+2) - crse = Section(sect)%SubjectIdx - - !new section ? - if (sect/=previous) then ! include subject, section, units/blockname, seats/hours, time, day - - if (is_lecture_lab_subject(crse)) then - if (is_lecture_class(sect, Section)) then ! lecture of lecture-lab + previous = 0 + do idx=1,lenSL,3 + sect=SectionList(idx) + !mdx=SectionList(idx+1) + conflict=SectionList(idx+2) + crse = Section(sect)%SubjectIdx + + !new section ? + if (sect/=previous) then ! include subject, section, units/blockname, seats/hours, time, day + + if (is_lecture_lab_subject(crse)) then + if (is_lecture_class(sect, Section)) then ! lecture of lecture-lab classUnits = Subject(crse)%Units classHours = Subject(crse)%LectHours classTuition = Subject(crse)%Tuition classLabFee = 0.0 - else ! lab of lecture-lab + else ! lab of lecture-lab classUnits = 0.0 classHours = Subject(crse)%LabHours classTuition = 0.0 classLabFee = Subject(crse)%LabFee + end if + else if (Subject(crse)%LectHours>0.0) then ! lecture-only + classUnits = Subject(crse)%Units + classHours = Subject(crse)%LectHours + classTuition = Subject(crse)%Tuition + classLabFee = 0.0 + else if (Subject(crse)%LabHours>0.0) then ! lab-only + classUnits = Subject(crse)%Units + classHours = Subject(crse)%LabHours + classTuition = Subject(crse)%Tuition + classLabFee = Subject(crse)%LabFee end if - else if (Subject(crse)%LectHours>0.0) then ! lecture-only - classUnits = Subject(crse)%Units - classHours = Subject(crse)%LectHours - classTuition = Subject(crse)%Tuition - classLabFee = 0.0 - else if (Subject(crse)%LabHours>0.0) then ! lab-only - classUnits = Subject(crse)%Units - classHours = Subject(crse)%LabHours - classTuition = Subject(crse)%Tuition - classLabFee = Subject(crse)%LabFee - end if - totalHours = totalHours + classHours - totalUnits = totalUnits + classUnits - totalTuition = totalTuition + classTuition - totalLabFee = totalLabFee + classLabFee + totalHours = totalHours + classHours + totalUnits = totalUnits + classUnits + totalTuition = totalTuition + classTuition + totalLabFee = totalLabFee + classLabFee - previous = sect - write(device,AFORMAT) & - begintr//begintd//trim(Subject(crse)%Name)//endtd, & ! subject - begintd//trim(Section(sect)%Code)//endtd ! code + previous = sect + write(device,AFORMAT) & + begintr//begintd//trim(Subject(crse)%Name)//endtd, & ! subject + begintd//trim(Section(sect)%Code)//endtd ! code - if (classUnits>0.0) then - write(device,AFORMAT) begintd//trim(ftoa(classUnits,1))//endtd - else - write(device,AFORMAT) tdnbspendtd ! units - end if + if (classUnits>0.0) then + write(device,AFORMAT) begintd//trim(ftoa(classUnits,1))//endtd + else + write(device,AFORMAT) tdnbspendtd ! units + end if - if (classHours>0.0) then - write(device,AFORMAT) begintd//trim(ftoa(classHours,2))//endtd ! hours - else - write(device,AFORMAT) tdnbspendtd ! hours - end if + if (classHours>0.0) then + write(device,AFORMAT) begintd//trim(ftoa(classHours,2))//endtd ! hours + else + write(device,AFORMAT) tdnbspendtd ! hours + end if - if (classTuition>0.0) then - write(device,AFORMAT) begintd//trim(ftoa(classTuition,2))//endtd - else - write(device,AFORMAT) tdnbspendtd - end if + if (classTuition>0.0) then + write(device,AFORMAT) begintd//trim(ftoa(classTuition,2))//endtd + else + write(device,AFORMAT) tdnbspendtd + end if - if (classLabFee>0.0) then - write(device,AFORMAT) begintd//trim(ftoa(classLabFee,2))//endtd - else - write(device,AFORMAT) tdnbspendtd - end if + if (classLabFee>0.0) then + write(device,AFORMAT) begintd//trim(ftoa(classLabFee,2))//endtd + else + write(device,AFORMAT) tdnbspendtd + end if -! -!------------------------------------------------- + ! + !------------------------------------------------- - if (is_regular_schedule(sect, Section)) then - write(device,AFORMAT) & - begintd//trim(text_time_period(Section(sect)%bTimeIdx(1), Section(sect)%eTimeIdx(1)))//endtd// & - begintd//trim(text_days_of_section(sect, NumSections, Section))//endtd// & - begintd//trim(Room(Section(sect)%RoomIdx(1))%Code)//endtd//endtr - else - mdx = 1 - write(device,AFORMAT) & - begintd//trim(text_time_period(Section(sect)%bTimeIdx(mdx), Section(sect)%eTimeIdx(mdx)))//endtd// & - begintd//trim(txtDay(Section(sect)%DayIdx(mdx)))//endtd// & - begintd//trim(Room(Section(sect)%RoomIdx(mdx))%Code)//endtd//endtr - do mdx=2,Section(sect)%NMeets - write(device,AFORMAT) begintr//'
'//nbsp//endtd// & + if (is_regular_schedule(sect, Section)) then + write(device,AFORMAT) & + begintd//trim(text_time_period(Section(sect)%bTimeIdx(1), Section(sect)%eTimeIdx(1)))//endtd// & + begintd//trim(text_days_of_section(sect, NumSections, Section))//endtd// & + begintd//trim(Room(Section(sect)%RoomIdx(1))%Code)//endtd//endtr + else + mdx = 1 + write(device,AFORMAT) & begintd//trim(text_time_period(Section(sect)%bTimeIdx(mdx), Section(sect)%eTimeIdx(mdx)))//endtd// & begintd//trim(txtDay(Section(sect)%DayIdx(mdx)))//endtd// & begintd//trim(Room(Section(sect)%RoomIdx(mdx))%Code)//endtd//endtr - end do - end if - if (conflict>0) write(device,AFORMAT) & + do mdx=2,Section(sect)%NMeets + write(device,AFORMAT) begintr//''//nbsp//endtd// & + begintd//trim(text_time_period(Section(sect)%bTimeIdx(mdx), Section(sect)%eTimeIdx(mdx)))//endtd// & + begintd//trim(txtDay(Section(sect)%DayIdx(mdx)))//endtd// & + begintd//trim(Room(Section(sect)%RoomIdx(mdx))%Code)//endtd//endtr + end do + end if + if (conflict>0) write(device,AFORMAT) & begintr//''//red//'CONFLICT between '//trim(Section(sect)%ClassId)//' and '// & trim(Section(conflict)%ClassId)//black//endtd//endtr - end if + end if - end do - write(device,AFORMAT) begintr//'
'//endtd//endtr, & + end do + write(device,AFORMAT) begintr//'
'//endtd//endtr, & begintr//tdnbspendtd//begintd//'Totals : '//endtd// & ! code begintd//trim(ftoa(totalUnits,1))//endtd//begintd//trim(ftoa(totalHours,2))//endtd// & ! hours begintd//trim(ftoa(totalTuition,2))//endtd//begintd//trim(ftoa(totalLabFee,2))//endtd// & ! fees tdnbspendtd// tdnbspendtd// tdnbspendtd//endtr, & '
' - return - end subroutine enlistment_class_schedule + + end subroutine enlistment_class_schedule subroutine timetable_meetings_of_student(NumSections, Section, iStd, eList, to_skip, & @@ -1023,7 +1120,7 @@ subroutine timetable_meetings_of_student(NumSections, Section, iStd, eList, to_s list(len_list+1) = 0 list(len_list+2) = 0 list(len_list+3) = 0 - return + end subroutine timetable_meetings_of_student diff --git a/EditPREDICTIONS.F90 b/EditPREDICTIONS.F90 index f15545d..c56215d 100644 --- a/EditPREDICTIONS.F90 +++ b/EditPREDICTIONS.F90 @@ -34,54 +34,60 @@ module EditPREDICTIONS implicit none + type (TYPE_STUDENT), private :: wrkStudent + integer, private :: lenGrade, lenPlan + contains - subroutine checklist_edit (device, UseClasses, Section, Offering) + subroutine checklist_edit (device, UseClasses, Section, Offering, path) implicit none integer, intent (in) :: device logical, intent (in) :: UseClasses type (TYPE_OFFERED_SUBJECTS), intent(in), dimension (MAX_ALL_DUMMY_SUBJECTS:MAX_ALL_SUBJECTS) :: Offering type (TYPE_SECTION), intent(in) :: Section(0:) + character(len=*), intent(in) :: path character(len=MAX_LEN_STUDENT_CODE) :: tStdNo character(len=MAX_LEN_SUBJECT_CODE) :: tSubject, input_name1, input_name2, input_value, currentSubject, update - character(len=3*MAX_LEN_SUBJECT_CODE) :: tAction, search_string + character(len=3*MAX_LEN_SUBJECT_CODE) :: tAction character (len=MAX_LEN_TEXT_YEAR) :: tYear character (len=MAX_LEN_TEXT_SEMESTER) :: tTerm character (len=MAX_LEN_TEXT_GRADE) :: tGrade character(len=MAX_LEN_CURRICULUM_CODE) :: tCurriculum character(len=127) :: mesg, TCGline - logical :: FlagIsUp, isDirtyMCL + logical :: FlagIsUp, isDirtyPlan, isDirtyGrade integer :: crse, year, term, nsubs, nreqs, n_changes integer :: crse_required, crse_current, crse_update, rank integer :: cdx, gdx, idx, jdx, ierr, i, j, k, l type (TYPE_PRE_ENLISTMENT) :: Advice -#if defined PRODUCTION -#else - write(device,AFORMAT) '' -#endif - - ! which student? + ! which student, action? call cgi_get_named_string(QUERY_STRING, 'A1', tStdNo, ierr) + call cgi_get_named_string(QUERY_STRING, 'action', tAction, ierr) + targetStudent = index_to_student(tStdNo) targetCurriculum = Student(targetStudent)%CurriculumIdx targetCollege = Curriculum(targetCurriculum)%CollegeIdx + call html_comment('checklist_edit('//tStdNo//trim(tAction)//')') + ! read checklist call read_student_records (targetStudent) + wrkStudent = Student(targetStudent) + lenGrade = wrkStudent%Record(1,0) + lenPlan = wrkStudent%Reqd(0,0) + + call html_comment('# grades='//itoa(lenGrade), '# plans='//itoa(lenPlan)) - isDirtyMCL = .false. ! no changes yet + isDirtyPlan = .false. ! no changes yet + isDirtyGrade = .false. ! no changes yet isDirtyPREDICTIONS = .false. ! no changes yet isDirtyWAIVERCOI = .false. ! no changes yet TCGline = SPACE - - ! check for other arguments mesg = SPACE - call cgi_get_named_string(QUERY_STRING, 'action', tAction, ierr) select case (trim(tAction)) case ('Change CURRICULUM') @@ -113,20 +119,23 @@ subroutine checklist_edit (device, UseClasses, Section, Offering) year = index_to_year(tYear) if (crse<=0 .or. term<0 .or. year<=0) then mesg = trim(tAction)//' : Year or Term or Subject" not valid?' - else ! add ADDITIONAL subject to TCG + else ! add ADDITIONAL subject to Reqd() mesg = trim(tAction)//' : '//trim(tYear)//COMMA//trim(tTerm)//COMMA//tSubject - isDirtyMCL = .true. + isDirtyPlan = .true. input_name1 = 'ADDITIONAL' crse_required = index_to_subject(input_name1) - lenTCG = lenTCG + 1 - TCG(lenTCG)%Code = 1 ! substitution - TCG(lenTCG)%Year = year - TCG(lenTCG)%Term = term - TCG(lenTCG)%Reqd(0) = 1 - TCG(lenTCG)%Reqd(1) = crse_required ! ADDITIONAL - TCG(lenTCG)%Subst(0) = 1 - TCG(lenTCG)%Subst(1) = crse ! actual + + lenPlan = lenPlan + 1 + wrkStudent%Reqd(0,0) = lenPlan + wrkStudent%Reqd(-1,lenPlan) = 3*(year-1) + term + wrkStudent%Reqd(0,lenPlan) = 1 + wrkStudent%Reqd(1,lenPlan) = crse_required + wrkStudent%Subst(0,lenPlan) = 1 + wrkStudent%Subst(1,lenPlan) = crse + + Student(targetStudent)%Reqd = wrkStudent%Reqd + Student(targetStudent)%Subst = wrkStudent%Subst end if end if @@ -146,15 +155,33 @@ subroutine checklist_edit (device, UseClasses, Section, Offering) ! check TCG for specified ADDITIONAL subject input_name1 = 'ADDITIONAL' crse_required = index_to_subject(input_name1) - do l=1,lenTCG - if (TCG(l)%Code/=1) cycle ! not Substitution - if (TCG(l)%Reqd(1)/=crse_required) cycle ! not ADDITIONAL - if (crse/=TCG(l)%Subst(1)) cycle ! ADDITIONAL subject not the one to be deleted - TCG(l)%Code = 0 ! erase - isDirtyMCL = .true. - mesg = tAction//tSubject - exit + + FlagIsUp = .false. ! not found + do k=1,lenPlan + if (wrkStudent%Reqd(1,k)==crse_required .and. & + wrkStudent%Subst(1,k)==crse) then + FlagIsUp = .true. ! found + exit + end if end do + if (FlagIsUp) then ! shift-erase + do i=k+1,lenPlan + wrkStudent%Reqd(:,i-1) = wrkStudent%Reqd(:,i) + wrkStudent%Subst(:,i-1) = wrkStudent%Subst(:,i) + end do + ! re-initialize previous last location + wrkStudent%Reqd(:,lenPlan) = 0 + wrkStudent%Subst(:,lenPlan) = 0 + lenPlan = lenPlan - 1 + wrkStudent%Reqd(0,0) = lenPlan ! reset last location + + isDirtyPlan = .true. + mesg = tAction//tSubject + + Student(targetStudent)%Reqd = wrkStudent%Reqd + Student(targetStudent)%Subst = wrkStudent%Subst + end if + end if end if @@ -182,8 +209,8 @@ subroutine checklist_edit (device, UseClasses, Section, Offering) else TCGline = COMMA//trim(tSubject)//TCGline nsubs = nsubs + 1 - TCG(lenTCG+1)%Subst(0) = nsubs - TCG(lenTCG+1)%Subst(nsubs) = crse + wrkStudent%Subst(0,lenPlan+1) = nsubs + wrkStudent%Subst(nsubs,lenPlan+1) = crse end if end if end do @@ -198,14 +225,29 @@ subroutine checklist_edit (device, UseClasses, Section, Offering) else j = index_of_subject_in_curriculum(Curriculum(targetCurriculum), crse) if (j>0) then ! a required subject - rank = Curriculum(targetCurriculum)%SubjectTerm(j) - call rank_to_year_term(rank, Year, Term) - TCGline = COMMA//trim(tSubject)//TCGline - nreqs = nreqs + 1 - TCG(lenTCG+1)%Year = Year - TCG(lenTCG+1)%Term = Term - TCG(lenTCG+1)%Reqd(0) = nreqs - TCG(lenTCG+1)%Reqd(nreqs) = crse + ! check if already required in another substitution rule + FlagIsUp = .false. + do k=1,lenPlan + do l=1,wrkStudent%Reqd(0,k) + if (crse==wrkStudent%Reqd(l,k)) then + FlagIsUp = .true. + exit + end if + end do + if (FlagIsUp) exit + end do + if (.not. FlagIsUp) then + TCGline = COMMA//trim(tSubject)//TCGline + nreqs = nreqs + 1 + wrkStudent%Reqd(-1,lenPlan+1) = Curriculum(targetCurriculum)%SubjectTerm(j) + wrkStudent%Reqd(0,lenPlan+1) = nreqs + wrkStudent%Reqd(nsubs,lenPlan+1) = crse + else + mesg = trim(tAction)//' : '//tSubject// & + '- required subject already used in another substitution.' + nreqs = 0 + exit + end if else mesg = trim(tAction)//' : '//tSubject//'- required subject not in curriculum?' nreqs = 0 @@ -216,42 +258,62 @@ subroutine checklist_edit (device, UseClasses, Section, Offering) if (nsubs*nreqs>0) then mesg = trim(tAction)//' : '//TCGline(2:) - lenTCG = lenTCG + 1 - TCG(lenTCG)%Code = 1 + lenPlan = lenPlan + 1 + wrkStudent%Reqd(0,0) = lenPlan if (nreqs>1) then ! group substitution; no year/term - TCG(lenTCG)%Year = 0 - TCG(lenTCG)%Term = 0 + wrkStudent%Reqd(-1,lenPlan) = 0 end if - isDirtyMCL = .true. + ! copy to Student(std) + Student(targetStudent)%Reqd = wrkStudent%Reqd + Student(targetStudent)%Subst = wrkStudent%Subst + + isDirtyPlan = .true. end if case ('Cancel SUBSTITUTION') + call cgi_get_named_string(QUERY_STRING, 'subject', tSubject, crse) + if (crse/=0) then ! a name was not specified? mesg = trim(tAction)//' : subject not spelled correctly?' + else if (tSubject==SPACE) then ! a value was not specified? mesg = trim(tAction)//' : required subject not specified?' - else + + else ! some subject was specified crse = index_to_subject(tSubject) - if (crse<=0) then + if (crse<=0) then ! not a named subject mesg = trim(tAction)//' : subject not valid?' else mesg = trim(tAction)//' : rule not found in checklist - '//tSubject - ! check TCG for specified SUBSTITUTION - do l=1,lenTCG - if (TCG(l)%Code/=1) cycle ! not PlanOfStudy - isDirtyMCL = .false. - do i=1,TCG(l)%Reqd(0) - if (TCG(l)%Reqd(i)==crse) then - isDirtyMCL = .true. + ! check Student(std)%Reqd() for specified SUBSTITUTION + idx = 0 + do k=1,lenPlan + do i=1,wrkStudent%Reqd(0,k) + if (wrkStudent%Reqd(i,k)==crse) then + isDirtyPlan = .true. + idx = k exit end if end do - if (.not. isDirtyMCL) cycle ! required subject not found - TCG(l)%Code = 0 ! erase substitution - mesg = trim(tAction)//' for '//tSubject - exit + if (isDirtyPlan) exit end do + if (isDirtyPlan) then ! required subject found + ! shift substitutions down + do k=idx+1,lenPlan + wrkStudent%Reqd(:,k-1) = wrkStudent%Reqd(:,k) + wrkStudent%Subst(:,k-1) = wrkStudent%Subst(:,k) + end do + ! re-initialize previous last location + wrkStudent%Reqd(:,lenPlan) = 0 + wrkStudent%Subst(:,lenPlan) = 0 + lenPlan = lenPlan - 1 ! decrease counter + wrkStudent%Reqd(0,0) = lenPlan + mesg = trim(tAction)//' for '//tSubject + ! copy to Student(std) + Student(targetStudent)%Reqd = wrkStudent%Reqd + Student(targetStudent)%Subst = wrkStudent%Subst + end if end if end if @@ -278,6 +340,7 @@ subroutine checklist_edit (device, UseClasses, Section, Offering) crse_current = index_to_subject(currentSubject) if (update/=SPACE) then ! something in update + crse_update = index_to_subject(update) if (crse_update <= 0) then !mesg = trim(tAction)//' : '//update//'- code not valid?' @@ -285,6 +348,7 @@ subroutine checklist_edit (device, UseClasses, Section, Offering) !write(*,*) trim(tAction)//' : '//update//'- code not valid?' cycle end if + jdx = index_of_subject_in_curriculum(Curriculum(targetCurriculum), crse_update) if (jdx>0) then ! a required subject !mesg = trim(tAction)//' : '//update//'- already required?' @@ -292,61 +356,76 @@ subroutine checklist_edit (device, UseClasses, Section, Offering) !write(*,*) trim(tAction)//' : '//update//'- already required?' cycle end if + if (currentSubject == update) then ! no change !mesg = trim(tAction)//' : No change to '//currentSubject !write(*,*) trim(mesg) !write(*,*) trim(tAction)//' : No change to '//currentSubject cycle end if + ! make change if (crse_current>0) then ! previously specified FlagIsUp = .true. - do k=1,lenTCG - if (TCG(k)%Code/=1) cycle ! not Substitution - if (TCG(k)%Reqd(1)==crse_required .and. TCG(k)%Subst(1)==crse_current) then ! found + do k=1,lenPlan + if (wrkStudent%Reqd(1,k)==crse_required .and. & + wrkStudent%Subst(1,k)==crse_current) then + wrkStudent%Subst(1,k) = crse_update FlagIsUp = .false. - TCG(k)%Subst(1) = crse_update mesg = trim(mesg)//', '//trim(Subject(crse_update)%Name) exit end if end do if (FlagIsUp) then ! make new entry - lenTCG = lenTCG + 1 + lenPlan = lenPlan + 1 + wrkStudent%Reqd(0,0) = lenPlan + wrkStudent%Reqd(-1,lenPlan) = rank + wrkStudent%Reqd(0,lenPlan) = 1 + wrkStudent%Reqd(1,lenPlan) = crse_required + wrkStudent%Subst(0,lenPlan) = 1 + wrkStudent%Subst(1,lenPlan) = crse_update mesg = trim(mesg)//', '//trim(Subject(crse_update)%Name) - TCG(lenTCG)%Code = 1 ! substitution - TCG(lenTCG)%Year = Year - TCG(lenTCG)%Term = Term - TCG(lenTCG)%Reqd(0) = 1 - TCG(lenTCG)%Reqd(1) = crse_required - TCG(lenTCG)%Subst(0) = 1 - TCG(lenTCG)%Subst(1) = crse_update + end if else ! make new entry in TCG - lenTCG = lenTCG + 1 - TCG(lenTCG)%Code = 1 + lenPlan = lenPlan + 1 + wrkStudent%Reqd(0,0) = lenPlan + wrkStudent%Reqd(-1,lenPlan) = rank + wrkStudent%Reqd(0,lenPlan) = 1 + wrkStudent%Reqd(1,lenPlan) = crse_required + wrkStudent%Subst(0,lenPlan) = 1 + wrkStudent%Subst(1,lenPlan) = crse_update mesg = trim(mesg)//', '//trim(Subject(crse_update)%Name) - TCG(lenTCG)%Year = Year - TCG(lenTCG)%Term = Term - TCG(lenTCG)%Reqd(0) = 1 - TCG(lenTCG)%Reqd(1) = crse_required - TCG(lenTCG)%Subst(0) = 1 - TCG(lenTCG)%Subst(1) = crse_update + end if n_changes = n_changes + 1 - else ! update is blank? remove current elective? + else ! update is blank? remove current elective if (crse_current>0) then ! previously specified + FlagIsUp = .false. - do k=1,lenTCG - if (TCG(k)%Code/=1) cycle ! not Substitution - if (TCG(k)%Reqd(1)==crse_required .and. TCG(k)%Subst(1)==crse_current) then ! found + do k=1,lenPlan + if (wrkStudent%Reqd(1,k)==crse_required .and. & + wrkStudent%Subst(1,k)==crse_current) then FlagIsUp = .true. - TCG(k)%Code = 0 + exit end if end do - if (FlagIsUp) n_changes = n_changes + 1 + if (FlagIsUp) then + do i=k+1,lenPlan + wrkStudent%Reqd(:,i-1) = wrkStudent%Reqd(:,i) + wrkStudent%Subst(:,i-1) = wrkStudent%Subst(:,i) + end do + ! re-initialize previous last location + wrkStudent%Reqd(:,lenPlan) = 0 + wrkStudent%Subst(:,lenPlan) = 0 + lenPlan = lenPlan - 1 + wrkStudent%Reqd(0,0) = lenPlan ! reset last location + n_changes = n_changes + 1 + end if + end if end if @@ -355,8 +434,11 @@ subroutine checklist_edit (device, UseClasses, Section, Offering) if (n_changes==0) then mesg = trim(tAction)//' : Nothing to update?' else + ! copy to Student(std) + Student(targetStudent)%Reqd = wrkStudent%Reqd + Student(targetStudent)%Subst = wrkStudent%Subst mesg = trim(tAction)//mesg - isDirtyMCL = .true. + isDirtyPlan = .true. end if @@ -364,6 +446,7 @@ subroutine checklist_edit (device, UseClasses, Section, Offering) n_changes = 0 input_name1 = 'GRADE:' + loop_GRADES: & do while (.true.) call cgi_get_wild_name_value(QUERY_STRING, input_name1, input_name2, input_value, ierr) if (ierr/=0) exit ! no more GRADE: in QUERY @@ -386,202 +469,106 @@ subroutine checklist_edit (device, UseClasses, Section, Offering) cycle end if - ! subject+grade in TCG() + ! subject+grade in Record()? FlagIsUp = .false. - do k=lenTCG,1,-1 - if (TCG(k)%Code/=2) cycle ! not Grade - if (TCG(k)%Subject/=crse) cycle ! not the subject - FlagIsUp = .true. ! subject matched - if (gdx==TCG(k)%Grade) exit ! same grade - TCG(k)%Grade = gdx ! make change + do k=lenGrade,1,-1 + if (wrkStudent%Record(4,k)/=crse) cycle ! not the subject + if (gdx==wrkStudent%Record(5,k)) cycle loop_GRADES ! same grade + FlagIsUp = .true. ! subject matched, w/ diff grade + wrkStudent%Record(5,k) = gdx ! make change n_changes = n_changes + 1 mesg = ' : '//trim(Subject(crse)%Name)//mesg - exit + cycle loop_GRADES end do - if (.not. FlagIsUp) then ! not in Record(); add an entry - lenTCG = lenTCG + 1 - !Grade,Year,Term,Subject,Section,Units,Grade - TCG(lenTCG)%txtLine = 'Grade,'// & - trim(itoa(currentYear))//COMMA// & - trim(txtSemester(currentTerm))//COMMA// & - trim(tSubject)//COMMA// & - trim(txtGradeType(1))//COMMA// & - trim(ftoa(Subject(crse)%Units,1))//COMMA// & - tGrade - TCG(lenTCG)%Code = 2 ! grade - TCG(lenTCG)%Year = currentYear - TCG(lenTCG)%Term = currentTerm - TCG(lenTCG)%Subject = crse - TCG(lenTCG)%Grade = gdx - n_changes = n_changes + 1 + if (.not. FlagIsUp) then ! not found; add an entry + + lenGrade = lenGrade + 1 + wrkStudent%Record(1,0) = lenGrade + wrkStudent%Record(1,lenGrade) = 1 + wrkStudent%Record(2,lenGrade) = currentYear + wrkStudent%Record(3,lenGrade) = currentTerm + wrkStudent%Record(4,lenGrade) = crse + wrkStudent%Record(5,lenGrade) = gdx mesg = ' : '//trim(Subject(crse)%Name)//', to '//tGrade//mesg + n_changes = n_changes + 1 + end if else ! grade is empty (to indicate 'Remove grade') - do k=lenTCG,1,-1 - if (TCG(k)%Code/=2) cycle ! not Grade - if (TCG(k)%Subject/=crse) cycle ! not the subject + FlagIsUp = .false. ! subject found? + do k=lenGrade,1,-1 + if (wrkStudent%Record(4,k)/=crse) cycle ! not the subject FlagIsUp = .true. - TCG(k)%Code = 0 ! remove - n_changes = n_changes + 1 - mesg = ' : Removed grade in '//trim(Subject(crse)%Name)//mesg exit end do + if (FlagIsUp) then + do i=k+1,lenGrade ! shift down + wrkStudent%Record(:,i-1) = wrkStudent%Record(:,i) + end do + wrkStudent%Record(:,lenGrade) = 0 + lenGrade = lenGrade - 1 + wrkStudent%Record(1,0) = lenGrade + n_changes = n_changes + 1 + mesg = ' : Removed grade in '//trim(Subject(crse)%Name)//mesg + end if end if - end do + end do loop_GRADES if (n_changes==0) then mesg = trim(tAction)//' : Nothing to update?' else mesg = trim(tAction)//mesg - isDirtyMCL = .true. + Student(targetStudent)%Record = wrkStudent%Record + isDirtyGrade = .true. end if - case ('Revise PREDICTION', 'For PREDICTION') - - !write(device,AFORMAT) '' - case default end select - if (isDirtyMCL) then + if (isDirtyPlan) then call xml_write_substitutions(targetStudent) end if + if (isDirtyGrade) then + call xml_write_student_grades(targetStudent) + end if + if (isDirtyWAIVERCOI) then - call xml_write_waivers(pathToTerm, Section) + call xml_write_waivers(path, Section) end if if (isDirtyPREDICTIONS) then - call xml_write_pre_enlistment(pathToTerm, 'PREDICTIONS-'//CurrProgCode(targetCurriculum), & - Advised, Section, targetCurriculum) + call xml_write_pre_enlistment(path, 'PREDICTIONS', Advised, Section, targetCurriculum) end if - call checklist_write_menu (device, UseClasses, isDirtyMCL, Offering, mesg) + call checklist_write_menu (device, UseClasses, isDirtyPlan .or. isDirtyGrade, Offering, mesg) + - return end subroutine checklist_edit @@ -592,36 +579,35 @@ subroutine checklist_write_menu (device, UseClasses, isDirtyMCL, Offering, mesg) character(len=*), intent (in) :: mesg character(len=6) :: tProb - type (TYPE_PRE_ENLISTMENT) :: Advice - integer :: j, k, l, MissingPOCW, NRemaining, lenSubject, notSpecified ! , checklistout + type (TYPE_PRE_ENLISTMENT) :: Advice, prevAdvice + integer :: idxCurr, j, k, l, MissingPOCW, NRemaining, lenSubject, notSpecified ! , checklistout -#if defined PRODUCTION -#else - write(device,AFORMAT) '' -#endif + call html_comment('checklist_write_menu()') ! Plan of Study - l = Student(targetStudent)%CurriculumIdx + idxCurr = Student(targetStudent)%CurriculumIdx notSpecified = 0 ! how many entries in plan for this curriculum? - do k=1,Curriculum(l)%NSubjects - if (Curriculum(l)%SubjectIdx(k)<0) then + do k=1,Curriculum(idxCurr)%NSubjects + if (Curriculum(idxCurr)%SubjectIdx(k)<0) then notSpecified = notSpecified + 1 exit end if end do call html_write_header(device, Student(targetStudent)%StdNo//nbsp// & - trim(Student(targetStudent)%Name), mesg) + trim(Student(targetStudent)%Name)// & + trim(make_href(fnCurriculum, Curriculum(idxCurr)%Code, A1=Curriculum(idxCurr)%Code, & + pre=' (', post=' ) ')), mesg) if (isRoleAdmin .or. (isRoleSRE .and. CurrProgCode(CurriculumIdxUser)==CurrProgCode(targetCurriculum) ) ) then ! change curriculum form call make_form_start(device, fnEditCheckList, Student(targetStudent)%StdNo) write(device,AFORMAT) & '', & - nbsp//nbsp//'', & - '' + write(device,AFORMAT) '', & + nbsp//nbsp//'' + else - write(device,AFORMAT) trim(text_curriculum_info(l)) + + write(device,AFORMAT) trim(text_curriculum_info(idxCurr))//'
' + end if - call checklist_page_links(device, .true.) + + !call checklist_page_links(device, .true.) call advise_student (targetStudent, UseClasses, Offering, WaiverCOI(targetStudent), Advice, MissingPOCW, NRemaining) lenSubject = Advice%NPriority+Advice%NAlternates+Advice%NCurrent call checklist_display (device, targetStudent, Advice, MissingPOCW, NRemaining) + ! offer Advice for PREDICTION or ENLISTMENT depending on period if (isRoleAdmin .or. (isRoleSRE .and. CurrProgCode(CurriculumIdxUser)==CurrProgCode(targetCurriculum) ) ) then if (lenSubject>0) then - if (currentTerm==nextTerm) then ! change mat; switch to subjects from new analysis - call make_form_start(device, fnChangeMatriculation, Student(targetStudent)%StdNo, 'Switch') - else ! not enlistment period + if (advisingPeriod) then call make_form_start(device, fnEditCheckList, Student(targetStudent)%StdNo) + else + call make_form_start(device, fnChangeMatriculation, Student(targetStudent)%StdNo, 'Switch') end if write(device,AFORMAT) & '', & @@ -665,68 +654,46 @@ subroutine checklist_write_menu (device, UseClasses, isDirtyMCL, Offering, mesg) '' end do - - -! if (currentTerm==nextTerm) then ! change mat; switch to subjects from new analysis -! -! write(device,AFORMAT) & -! '
Use above FEASIBLE subjects '// & -! '' -! -! else ! not enlistment period -! -! write(device,AFORMAT) & -! '
Use above FEASIBLE subjects '// & -! '' -! -! end if - - write(device,AFORMAT) '
Use the subjects '//nbsp//nbsp - - if (currentTerm==nextTerm) then - write(device,AFORMAT) & - '
' - else - write(device,AFORMAT) & - '
' - end if - - - call checklist_page_links(device) !, .true.) - + write(device,AFORMAT) '
Use FEASIBLE subjects '//nbsp, & + '' end if + write(device,AFORMAT) '
' else return end if - ! revise previous predictions - lenSubject = Advised(targetStudent)%NPriority+Advised(targetStudent)%NAlternates+Advised(targetStudent)%NCurrent - if (lenSubject>0) then + write(device,AFORMAT) & + '
UPDATE SUBJECTS for '//txtSemester(nextTerm+6)// & + ' Semester, '//text_school_year(nextYear)//'' - Advice = Advised(targetStudent) + if (advisingPeriod) then - write(device,AFORMAT) '
'// & - trim(text_student_curriculum(targetStudent))// & - '
REVISE PREDICTION for '//txtSemester(nextTerm+6)// & - ' Semester, '//text_school_year(nextYear)//'' call make_form_start(device, fnEditCheckList, Student(targetStudent)%StdNo) + prevAdvice = Advised(targetStudent) + lenSubject = prevAdvice%NPriority + prevAdvice%NAlternates + prevAdvice%NCurrent + write(device,AFORMAT) & '
Allowed load '//nbsp//' '// & + trim(itoa(prevAdvice%AllowedLoad))//'">', & nbsp//nbsp//' Priority group '//nbsp//' (1=New freshman, 2=Graduating, '// & + trim(itoa(prevAdvice%StdPriority))//'"> (1=New freshman, 2=Graduating, '// & '3=Good standing, 4=Warning, 5=Probation, 6=dismissed/PD)', & - '' - write(device,AFORMAT) & + '', & + '', & + '', & + '', & + '', & + '' + + do l=1,lenSubject + k = prevAdvice%Subject(l) + write(tProb, '(f6.4)') prevAdvice%Contrib(l) + write(device,AFORMAT) & + '' + end do + + write(device,AFORMAT) '
', & begintr//thaligncenter//'Action'//endth// & tdnbspendtd// & thalignleft//'Subject'//endth// & @@ -737,8 +704,9 @@ subroutine checklist_write_menu (device, UseClasses, isDirtyMCL, Offering, mesg) begintd//''//endtd// & tdnbspendtd// & begintd//'(Approved COI or WAIVER of prerequisite)'//endtd//endtr - do l=1,Advice%NPriority+Advice%NAlternates - k = Advice%Subject(l) + + do l=1,prevAdvice%NPriority+prevAdvice%NAlternates + k = prevAdvice%Subject(l) write(device,AFORMAT) & begintr//tdaligncenter//'Del '//trim(itoa(l))//''//endtd// & tdaligncenter//''//endtd// & @@ -747,35 +715,17 @@ subroutine checklist_write_menu (device, UseClasses, isDirtyMCL, Offering, mesg) begintd//trim(Subject(k)%Title)//endtd//endtr end do - !if (Advice%NAlternates>0) then - ! write(device,AFORMAT) & - ! begintr//thaligncenter//'Alt'//endth// & - ! thalignleft//'Contrib'//endth// & - ! thalignleft//'Subject'//endth// & - ! thaligncenter//'Credit'//endth// & - ! thalignleft//'Title'//endth//endtr - ! do l=Advice%NPriority+1,Advice%NPriority+Advice%NAlternates - ! k = Advice%Subject(l) - ! write(tProb, '(f6.4)') Advice%Contrib(l) - ! write(device,AFORMAT) & - ! begintr//tdaligncenter//trim(itoa(l))//endtd// & - ! begintd//tProb//endtd// & - ! begintd//trim(Subject(k)%Name)//endtd// & - ! tdaligncenter//trim(ftoa(Subject(k)%Units))//endtd// & - ! begintd//trim(Subject(k)%Title)//endtd//endtr - ! end do - !end if - - if (Advice%NCurrent>0) then + if (prevAdvice%NCurrent>0) then write(device,AFORMAT) & begintr//thaligncenter//'Fail'//endth// & thalignleft//'Contrib'//endth// & thalignleft//'Subject'//endth// & thaligncenter//'Credit'//endth// & thalignleft//'Title'//endth//endtr - do l=Advice%NPriority+Advice%NAlternates+1,Advice%NPriority+Advice%NAlternates+Advice%NCurrent - k = Advice%Subject(l) - write(tProb, '(f6.4)') Advice%Contrib(l) + do l=prevAdvice%NPriority+prevAdvice%NAlternates+1, & + prevAdvice%NPriority+prevAdvice%NAlternates+prevAdvice%NCurrent + k = prevAdvice%Subject(l) + write(tProb, '(f6.4)') prevAdvice%Contrib(l) write(device,AFORMAT) & begintr//tdaligncenter//trim(itoa(l))//endtd// & begintd//tProb//endtd// & @@ -784,40 +734,68 @@ subroutine checklist_write_menu (device, UseClasses, isDirtyMCL, Offering, mesg) begintd//trim(Subject(k)%Title)//endtd//endtr end do end if - write(device,AFORMAT) '
'! // & - !'Notes: Pri=Priority, Alt=Alternate, Fail="if failed", Contrib=contribution to subject demand.' + write(device,AFORMAT) '
', & + '', & + '
' + + else ! (.not. advisingPeriod) then + + call make_form_start(device, fnChangeMatriculation, Student(targetStudent)%StdNo, 'Switch') + prevAdvice = Preenlisted(targetStudent) + lenSubject = prevAdvice%NPriority + prevAdvice%NAlternates write(device,AFORMAT) & - '', & - '', & - '', & - '', & - '', & - '' + '
Allowed load '//nbsp//' ', & + '', & + '', & + '', & + '', & + '' + do l=1,lenSubject - k = Advice%Subject(l) - write(tProb, '(f6.4)') Advice%Contrib(l) + k = prevAdvice%Subject(l) + write(tProb, '(f6.4)') prevAdvice%Contrib(l) write(device,AFORMAT) & '' end do - write(device,AFORMAT) & - '
', & - '
' - call checklist_page_links(device) !, .true.) - end if + write(device,AFORMAT) '
', & + begintr//thaligncenter//'Action'//endth// & + tdnbspendtd// & + thalignleft//'Subject'//endth// & + thaligncenter//'Credit'//endth// & + thalignleft//'Title'//endth//endtr, & + begintr//tdaligncenter//'Add'//endtd// & + tdnbspendtd// & + begintd//''//endtd// & + tdnbspendtd// & + begintd//'(Approved COI or WAIVER of prerequisite)'//endtd//endtr + do l=1,lenSubject + k = prevAdvice%Subject(l) + write(device,AFORMAT) & + begintr//tdaligncenter//'Del '//trim(itoa(l))//''//endtd// & + tdaligncenter//''//endtd// & + begintd//trim(Subject(k)%Name)//endtd// & + tdaligncenter//trim(ftoa(Subject(k)%Units,1))//endtd// & + begintd//trim(Subject(k)%Title)//endtd//endtr + end do + + write(device,AFORMAT) '

', & + '', & + '
' + end if if (notSpecified>0) then call substitution_form(device,targetStudent, & Advice%UnitsEarned, Advice%StdClassification, Advice%StdYear, MissingPOCW, & Advice%AllowedLoad, Advice%StdPriority, Advice%NPriority, Advice%NAlternates, Advice%NCurrent, NRemaining) - call checklist_page_links(device) !, .true.) end if ! ChangeOfGrade call change_grade_form(device,targetStudent) - call checklist_page_links(device) !, .true.) ! ! additional subject ! write(device,AFORMAT) & @@ -849,53 +827,37 @@ subroutine checklist_write_menu (device, UseClasses, isDirtyMCL, Offering, mesg) ! call checklist_page_links(device) !, .true.) ! subject substitution - write(device,AFORMAT) '
'// & - trim(text_student_curriculum(targetStudent)) call make_form_start(device, fnEditCheckList, Student(targetStudent)%StdNo) write(device,AFORMAT) & - 'Subject SUBSTITUTION: Enter the required and substitute subjects'// & + '
Subject SUBSTITUTION: Enter the required and substitute subjects
'// & ''// & - begintr//begintd//'Required :'//endtd// & - begintd//''//endtd// & - begintd//''//endtd// & - begintd//''//endtd// & - begintd//''//endtd// & - begintd//''//endtd//endtr, & - begintr//begintd//'Substitute :'//endtd// & - begintd//''//endtd// & - begintd//''//endtd// & - begintd//''//endtd// & - begintd//''//endtd// & - begintd//''//endtd//endtr, & - '
'// & + begintr//begintd//'Required :'//endtd//begintd// & + '', & + '', & + '', & + '', & + ''//endtd//endtr, & + begintr//begintd//'Substitute :'//endtd//begintd// & + '', & + '', & + '', & + '', & + ''//endtd//endtr, & + '
'// & '', & '
' - call checklist_page_links(device) !, .true.) - ! cancel subject substitution - write(device,AFORMAT) '
'// & - trim(text_student_curriculum(targetStudent)) call make_form_start(device, fnEditCheckList, Student(targetStudent)%StdNo) write(device,AFORMAT) & - 'Cancel SUBSTITUTION for subject '//nbsp//' '//nbsp, & - nbsp//nbsp//'', & + '
Cancel SUBSTITUTION: Enter required subject in which credit is earned through substitution
', & + ''//begintr// & + begintd//'Required :'//endtd// & + begintd//''//endtd// & + endtr//'

', & + '', & '
' - call checklist_page_links(device) !, .true.) - ! ! change grade - ! write(device,AFORMAT) '
', & - !'', & - ! ''// & - ! '', & - ! 'Change grade: '//nbsp//' Subject '//nbsp//, & - ! ' Grade '//nbsp//, & - ! ' Year earned: '//nbsp//, & - ! ' Term '//nbsp, & - ! '
Note: Grade=(numeric, S, INC, PASS, REGD), Year=(19XX,2XXX), Term=(SUMMER,FIRST,SECOND)', & - ! '
', & - ! '
' - return end subroutine checklist_write_menu @@ -904,12 +866,12 @@ subroutine change_grade_form(device, std) integer :: idx, tdx, Year, Term, m, n, rank integer, dimension(MAX_LEN_STUDENT_RECORD) :: p, q - write(device,AFORMAT) '
' +! write(device,AFORMAT) '
' call make_form_start(device, fnEditCheckList, Student(std)%StdNo) write(device,AFORMAT) & - 'TEMPORARY CHANGE OF GRADE for advising purposes. '// & - red//'Student''s actual record will NOT be changed.'//black//'
'// & - trim(text_student_curriculum(std)), & + '
TEMPORARY CHANGE OF GRADE for advising purposes. '// & + red//'Student''s actual record will NOT be changed.'//black// & + !'
'//trim(text_student_curriculum(std)), & '
Enter or modify contents of the edit boxes below, then click "Change GRADE"', & '' do tdx=1,CheckList%NumTerms,3 @@ -985,7 +947,7 @@ subroutine change_grade_form(device, std) end do write(device,AFORMAT) '
', & '
' - return + end subroutine change_grade_form @@ -998,10 +960,9 @@ subroutine substitution_form(device, std, & integer :: idx, tdx, Year, Term, m, n, rank integer, dimension(MAX_LEN_STUDENT_RECORD) :: p, q - write(device,AFORMAT) '
' +! write(device,AFORMAT) '
' call make_form_start(device, fnEditCheckList, Student(std)%StdNo) - write(device,AFORMAT) & - 'PLAN OF STUDY update form for '// trim(text_student_curriculum(std)), & + write(device,AFORMAT) '
PLAN OF STUDY update form', & '
Enter or modify contents of the edit boxes below, then click "Update ELECTIVE"'// & '' do tdx=1,CheckList%NumTerms,3 @@ -1077,7 +1038,7 @@ subroutine substitution_form(device, std, & end do write(device,AFORMAT) '
', & '
' - return + end subroutine substitution_form @@ -1106,7 +1067,7 @@ subroutine checklist_page_links(device, first) !'[ Update ELECTIVE ] ', & !'[ Update ELECTIVE ] ', & end if - return + end subroutine checklist_page_links @@ -1118,11 +1079,13 @@ subroutine checklist_display (device, std, Advice, MissingPOCW, NRemaining) integer:: UnitsPaid, UnitsDropped, UnitsPassed, Standing character(len=6) :: tProb + call html_comment('checklist_display()') + idxCURR = Student(std)%CurriculumIdx k = Curriculum(idxCURR)%NumTerms n = SpecifiedUnits(k) - write(device,AFORMAT) '
Units to earn classifications', & + write(device,AFORMAT) 'Units to earn classifications', & (': '//nbsp//trim(txtStanding(l))//'<='//trim(itoa(int((0.25*l)*n))), l=1,4) write(device,AFORMAT) '
Units to achieve YEAR', & (': '//nbsp//trim(txtYear(l))//'<'//trim(itoa(SpecifiedUnits(3*l))), l=1,(k+2)/3) @@ -1224,7 +1187,7 @@ subroutine checklist_display (device, std, Advice, MissingPOCW, NRemaining) '
'//nbsp//' PASS - credit earned/exempted;'//nbsp//' REGD - currently registered;', & nbsp//' PriN - Nth priority subject;'//nbsp//' AltK - Kth alternate subject' - call get_scholastic_three_terms (cTm3Year, cTm3, UnitsPaid, UnitsDropped, UnitsPassed, Standing) + call get_scholastic_three_terms (std, cTm3Year, cTm3, UnitsPaid, UnitsDropped, UnitsPassed, Standing) write(device,AFORMAT) '

SUMMARY for '//txtSemester(cTm3+6)// & ' Semester '//trim(itoa(cTm3Year))//DASH//trim(itoa(cTm3Year+1)), & ': Units registered='//trim(itoa(UnitsPaid)), & @@ -1232,7 +1195,7 @@ subroutine checklist_display (device, std, Advice, MissingPOCW, NRemaining) ': '//nbsp//' Earned='//trim(itoa(UnitsPassed)), & ': '//nbsp//' Scholastic standing='//trim(txtScholastic(Standing)) - call get_scholastic_three_terms (cTm2Year, cTm2, UnitsPaid, UnitsDropped, UnitsPassed, Standing) + call get_scholastic_three_terms (std, cTm2Year, cTm2, UnitsPaid, UnitsDropped, UnitsPassed, Standing) write(device,AFORMAT) '
SUMMARY for '//txtSemester(cTm2+6)// & ' Semester '//trim(itoa(cTm2Year))//DASH//trim(itoa(cTm2Year+1)), & ': Units registered='//trim(itoa(UnitsPaid)), & @@ -1240,7 +1203,7 @@ subroutine checklist_display (device, std, Advice, MissingPOCW, NRemaining) ': '//nbsp//' Earned='//trim(itoa(UnitsPassed)), & ': '//nbsp//' Scholastic standing='//trim(txtScholastic(Standing)) - call get_scholastic_three_terms (cTm1Year, cTm1, UnitsPaid, UnitsDropped, UnitsPassed, Standing) + call get_scholastic_three_terms (std, cTm1Year, cTm1, UnitsPaid, UnitsDropped, UnitsPassed, Standing) write(device,AFORMAT) '
SUMMARY for '//txtSemester(cTm1+6)// & ' Semester '//trim(itoa(cTm1Year))//DASH//trim(itoa(cTm1Year+1)), & ': Units registered='//trim(itoa(UnitsPaid)), & @@ -1250,7 +1213,7 @@ subroutine checklist_display (device, std, Advice, MissingPOCW, NRemaining) if (nextTerm/=currentTerm) then - call get_scholastic_three_terms (currentYear, currentTerm, UnitsPaid, UnitsDropped, UnitsPassed, Standing) + call get_scholastic_three_terms (std, currentYear, currentTerm, UnitsPaid, UnitsDropped, UnitsPassed, Standing) write(device,AFORMAT) '
SUMMARY for '//txtSemester(currentTerm+6)// & ' Semester '//trim(itoa(currentYear))//DASH//trim(itoa(currentYear+1)), & ': Units registered='//trim(itoa(UnitsPaid)), & @@ -1264,6 +1227,23 @@ subroutine checklist_display (device, std, Advice, MissingPOCW, NRemaining) trim(itoa(MissingPOCW))//''//black end if + ! extra subjects + n = 0 + q = 0 + do idx=1,lenTCG + if (TCG(idx)%Code /= 2 .or. TCG(idx)%Used) cycle + if (TCG(idx)%Subject /= 0 .and. is_grade_passing(TCG(idx)%Grade)) then + n = n+1 + q(n) = idx + end if + end do + if (n > 0) then + write(device,AFORMAT) '

EXTRA subjects, or subjects not specified in Plan Of Study' + do m=1,n + write(device,AFORMAT) ' : '//Subject(TCG(q(m))%Subject)%Name//DASH//txtGrade(pGrade(TCG(q(m))%Grade)) + end do + end if + if (advisingPeriod) then ! not enlistment period write(device,AFORMAT) '

ASSUMPTION at the end of '//txtSemester(currentTerm+6)// & ' Semester '//trim(itoa(currentYear))//DASH//trim(itoa(currentYear+1)), & @@ -1279,7 +1259,7 @@ subroutine checklist_display (device, std, Advice, MissingPOCW, NRemaining) case (9) write(device,AFORMAT) & - '

NO FEASIBLE SUBJECTS ?. PREREQUISITES NOT SATISFIED or PLAN OF STUDY IS INCOMPLETE', & + '

NO FEASIBLE SUBJECTS? PREREQUISITES NOT SATISFIED or PLAN OF STUDY IS INCOMPLETE', & '
Some remaining subject are : ', & begintr//thalignleft//'Subject'//endth// & thaligncenter//'Credit'//endth// & @@ -1307,25 +1287,25 @@ subroutine checklist_display (device, std, Advice, MissingPOCW, NRemaining) case default - ! extra subjects - n = 0 - q = 0 - do idx=1,lenTCG - if (TCG(idx)%Code /= 2 .or. TCG(idx)%Used) cycle - if (TCG(idx)%Subject /= 0 .and. is_grade_passing(TCG(idx)%Grade)) then - n = n+1 - q(n) = idx - end if - end do - if (n > 0) then - write(device,AFORMAT) '

EXTRA subjects, or subjects not specified in Plan Of Study' - do m=1,n - write(device,AFORMAT) ' : '//Subject(TCG(q(m))%Subject)%Name//DASH//txtGrade(pGrade(TCG(q(m))%Grade)) - end do - write(device,AFORMAT) '
' - end if +! ! extra subjects +! n = 0 +! q = 0 +! do idx=1,lenTCG +! if (TCG(idx)%Code /= 2 .or. TCG(idx)%Used) cycle +! if (TCG(idx)%Subject /= 0 .and. is_grade_passing(TCG(idx)%Grade)) then +! n = n+1 +! q(n) = idx +! end if +! end do +! if (n > 0) then +! write(device,AFORMAT) '

EXTRA subjects, or subjects not specified in Plan Of Study' +! do m=1,n +! write(device,AFORMAT) ' : '//Subject(TCG(q(m))%Subject)%Name//DASH//txtGrade(pGrade(TCG(q(m))%Grade)) +! end do +! write(device,AFORMAT) '
' +! end if - write(device,AFORMAT) '
FEASIBLE subjects for '//txtSemester(nextTerm+6)// & + write(device,AFORMAT) '

FEASIBLE subjects for '//txtSemester(nextTerm+6)// & ' Term, '//text_school_year(nextYear), & ' (ALLOWED load = '//trim(itoa(Advice%AllowedLoad))//')
' if (Advice%NPriority>0) then @@ -1387,14 +1367,13 @@ subroutine checklist_display (device, std, Advice, MissingPOCW, NRemaining) begintd//trim(Subject(idx)%Title)//endtd//endtr end do end if - write(device,AFORMAT) '
'// & - 'Notes: Pri=Priority, Alt=Alternate, Fail="if failed", Contrib=contribution to demand for subject.' - + write(device,AFORMAT) '
Note: '// & + 'Pri=Priority, Alt=Alternate, Fail="if failed", '// & + 'Contrib=contribution to demand for subject.' end select - !write(device,AFORMAT) '
' - return + end subroutine checklist_display diff --git a/EditROOMS.F90 b/EditROOMS.F90 index f577c8a..4a5c211 100644 --- a/EditROOMS.F90 +++ b/EditROOMS.F90 @@ -53,10 +53,7 @@ subroutine room_list_all (device) ! which dept ? call cgi_get_named_string(QUERY_STRING, 'A1', tDepartment, ierr) -#if defined PRODUCTION -#else - write(device,AFORMAT) '' -#endif + call html_comment('room_list_all('//trim(tDepartment)//')') targetDepartment = index_to_dept(tDepartment) do rdx=1,NumRooms+NumAdditionalRooms @@ -70,7 +67,13 @@ subroutine room_list_all (device) call html_write_header(device, mesg) if (n_count == 0) then - write(device,AFORMAT) '(None?)' + write(device,AFORMAT) '', & + begintr//begintd//'(None?)'//endtd//tdalignright + if (isRoleAdmin) then + write(device,AFORMAT) trim(make_href(fnEditRoom, 'Add room', & + A1='TBA', pre='('//nbsp, post=' )', alt=SPACE)) + end if + write(device,AFORMAT) endtd//endtr//'
' else ! sort rooms do tdx=1,n_count-1 @@ -83,7 +86,13 @@ subroutine room_list_all (device) end do end do - write(device,AFORMAT) ''//& + if (isRoleAdmin) then + write(device,AFORMAT) trim(make_href(fnEditRoom, 'Add room', & + A1='TBA', pre='('//nbsp, post=' )', alt=SPACE))//'
' + end if + + write(device,AFORMAT) 'Note: Number under Term links to classes in the room.
', & + '
'//& begintr//thalignleft//'Code'//endth// & thaligncenter//'Cluster'//endth, & thaligncenter//'Capacity'//endth @@ -125,7 +134,7 @@ subroutine room_list_all (device) write(device,AFORMAT) begintr//begintd//trim(Room(rdx)%Code) if (isRoleAdmin .or. (isRoleChair .and. Room(rdx)%DeptIdx==DeptIdxUser)) then write(device,AFORMAT) trim(make_href(fnEditRoom, 'Edit', & - A1=QUERY_put, pre=nbsp//'', post='')) + A1=QUERY_put, pre=nbsp//'', post='', alt=SPACE)) end if write(device,AFORMAT) & endtd//tdaligncenter//trim(itoa(Room(rdx)%Cluster))//endtd// & @@ -144,7 +153,7 @@ subroutine room_list_all (device) end if write(device,AFORMAT) '
' - return + end subroutine room_list_all @@ -165,10 +174,7 @@ subroutine room_conflicts (device, NumSections, Section) ! which college call cgi_get_named_string(QUERY_STRING, 'A1', tCollege, ierr) -#if defined PRODUCTION -#else - write(device,AFORMAT) '' -#endif + call html_comment('room_conflicts('//trim(tCollege)//')') targetCollege = index_to_college(tCollege) do rdx=1,NumRooms+NumAdditionalRooms @@ -241,7 +247,7 @@ subroutine room_conflicts (device, NumSections, Section) write(device,AFORMAT) begintr//begintd//trim(Room(rdx)%Code) if (isRoleAdmin .or. (isRoleChair .and. Room(rdx)%DeptIdx==DeptIdxUser)) then write(device,AFORMAT) trim(make_href(fnEditRoom, 'Edit', & - A1=QUERY_put, pre=nbsp//'', post='')) + A1=QUERY_put, pre=nbsp//'', post='', alt=SPACE)) end if write(device,AFORMAT) & endtd//tdaligncenter//trim(itoa(Room(rdx)%Cluster))//endtd// & @@ -258,7 +264,7 @@ subroutine room_conflicts (device, NumSections, Section) end if write(device,AFORMAT) '
' - return + end subroutine room_conflicts @@ -277,10 +283,7 @@ subroutine room_schedule(device, NumSections, Section, LoadSource) call cgi_get_named_string(QUERY_STRING, 'A1', tRoom, ierr) -#if defined PRODUCTION -#else - write(device,AFORMAT) '' -#endif + call html_comment('room_schedule('//trim(tRoom)//')') targetRoom = index_to_room(tRoom) targetDepartment = Room(targetRoom)%DeptIdx @@ -316,8 +319,10 @@ subroutine room_schedule(device, NumSections, Section, LoadSource) ! collect classes in room rdx call timetable_meetings_in_room(NumSections, Section, targetRoom, 0, tLen1, tArray, TimeTable, conflicted) - if (tLen1>0) call timetable_display(device, Section, TimeTable) + call list_sections_to_edit(device, Section, tLen1, tArray, fnRoomSchedule, tRoom, 'Del', allowed_to_edit) + + if (tLen1>0) call timetable_display(device, Section, TimeTable) write(device,AFORMAT) '
' ! make list of TBA sections LoadSource that fit the schedule of room @@ -375,7 +380,7 @@ subroutine room_schedule(device, NumSections, Section, LoadSource) end do write(device,AFORMAT) ''//nbsp//'
' - return + end subroutine room_schedule @@ -383,110 +388,146 @@ subroutine room_edit(device) integer, intent(in) :: device character(len=MAX_LEN_ROOM_CODE) :: tRoom, tAction character(len=MAX_LEN_DEPARTMENT_CODE) :: tDepartment - integer :: ierr, rdx, i, j + integer :: ierr, rdx, j character (len=255) :: mesg, remark type (TYPE_ROOM) :: wrk logical :: isDirtyROOMS ! which subject ? call cgi_get_named_string(QUERY_STRING, 'A1', tRoom, rdx) + if (rdx/=0) tRoom = 'TBA' -#if defined PRODUCTION -#else - write(device,AFORMAT) '' -#endif + call html_comment('room_edit('//trim(tRoom)//') ') rdx = index_to_room(tRoom) - wrk = Room(rdx) ! make a working copy + targetDepartment = Room(rdx)%DeptIdx + targetCollege = Department(targetDepartment)%CollegeIdx - ! check for other arguments - call cgi_get_named_string(QUERY_STRING, 'action', tAction, ierr) - !write(*,*) 'ierr=', ierr, ', action=', tAction + wrk = Room(rdx) ! make a working copy isDirtyROOMS = .false. remark = SPACE + mesg = SPACE - select case (trim(tAction)) + ! check for requested action + call cgi_get_named_string(QUERY_STRING, 'action', tAction, ierr) - case ('Update') + if (ierr/=0 .or. tAction==SPACE) then ! no action; display existing info - call cgi_get_named_integer(QUERY_STRING, 'MaxCapacity', wrk%MaxCapacity, ierr) - !write(*,*) 'ierr=', ierr, ', MaxCapacity=', wrk%MaxCapacity - if (ierr/=0) wrk%MaxCapacity = Room(rdx)%MaxCapacity + if (trim(tRoom)=='TBA') then + mesg = 'Add new room' + tAction = 'Add' + else + mesg = 'Edit info for room '//tRoom + tAction = 'Update' + end if - call cgi_get_named_integer(QUERY_STRING, 'Cluster', wrk%Cluster, ierr) - !write(*,*) 'ierr=', ierr, ', Cluster=', wrk%Cluster - if (ierr/=0) wrk%Cluster = Room(rdx)%Cluster + call room_info(device, wrk, mesg, remark, tAction) - call cgi_get_named_string(QUERY_STRING, 'Code', mesg, ierr) - wrk%Code = trim(mesg) - !write(*,*) 'ierr=', ierr, ', Code=', wrk%Code - if (ierr/=0) wrk%Code = Room(rdx)%Code + else ! action is Add or Update; collect changes - call cgi_get_named_string(QUERY_STRING, 'Department', tDepartment, ierr) - wrk%DeptIdx = index_to_dept(tDepartment) - !write(*,*) 'ierr=', ierr, ', DeptIdx=', wrk%DeptIdx - if (ierr/=0 .or. wrk%DeptIdx<=0) wrk%DeptIdx = Room(rdx)%DeptIdx - if (wrk%Code /= Room(rdx)%Code) then - isDirtyROOMS = .true. - remark = trim(remark)//': Code changed to '//wrk%Code - end if + call cgi_get_named_integer(QUERY_STRING, 'MaxCapacity', wrk%MaxCapacity, ierr) + !write(*,*) 'ierr=', ierr, ', MaxCapacity=', wrk%MaxCapacity + if (ierr/=0) wrk%MaxCapacity = Room(rdx)%MaxCapacity - if (wrk%DeptIdx /= Room(rdx)%DeptIdx) then - isDirtyROOMS = .true. - remark = trim(remark)//': Department changed to '//Department(wrk%DeptIdx)%Code - end if + call cgi_get_named_integer(QUERY_STRING, 'Cluster', wrk%Cluster, ierr) + !write(*,*) 'ierr=', ierr, ', Cluster=', wrk%Cluster + if (ierr/=0) wrk%Cluster = Room(rdx)%Cluster - if ( wrk%MaxCapacity /= Room(rdx)%MaxCapacity) then - isDirtyROOMS = .true. - remark = trim(remark)//': Max seating capacity changed to '//itoa(wrk%MaxCapacity) - end if + call cgi_get_named_string(QUERY_STRING, 'Code', mesg, ierr) + wrk%Code = trim(mesg) + !write(*,*) 'ierr=', ierr, ', Code=', wrk%Code + if (ierr/=0) wrk%Code = Room(rdx)%Code - if ( wrk%Cluster /= Room(rdx)%Cluster) then - isDirtyROOMS = .true. - remark = trim(remark)//': Cluster changed to '//itoa(wrk%Cluster) - end if + call cgi_get_named_string(QUERY_STRING, 'Department', tDepartment, ierr) + wrk%DeptIdx = index_to_dept(tDepartment) + !write(*,*) 'ierr=', ierr, ', DeptIdx=', wrk%DeptIdx + if (ierr/=0 .or. wrk%DeptIdx<=0) wrk%DeptIdx = Room(rdx)%DeptIdx - if (isDirtyROOMS) then - if ( wrk%Code /= Room(rdx)%Code) then - ! add new subject? - j = index_to_room(wrk%Code) - if (j==0) then + if (wrk%Code /= Room(rdx)%Code) then + isDirtyROOMS = .true. + remark = trim(remark)//': Code changed to '//wrk%Code + end if + + if (wrk%DeptIdx /= Room(rdx)%DeptIdx) then + isDirtyROOMS = .true. + remark = trim(remark)//': Department changed to '//Department(wrk%DeptIdx)%Code + end if + + if ( wrk%MaxCapacity /= Room(rdx)%MaxCapacity) then + isDirtyROOMS = .true. + remark = trim(remark)//': Max seating capacity changed to '//itoa(wrk%MaxCapacity) + end if + + if ( wrk%Cluster /= Room(rdx)%Cluster) then + isDirtyROOMS = .true. + remark = trim(remark)//': Cluster changed to '//itoa(wrk%Cluster) + end if + + if (isDirtyROOMS) then ! some changes + + if (wrk%Code /= Room(rdx)%Code) then ! new code; check if room already exists + + j = index_to_room(wrk%Code) + if (j==0) then ! not used + + if (trim(tAction)=='Add') then NumAdditionalRooms = NumAdditionalRooms+1 Room(NumRooms+NumAdditionalRooms) = wrk rdx = NumRooms+NumAdditionalRooms tRoom = wrk%Code remark = ': Added new room '//wrk%Code else - remark = ': Add new room failed; "'//trim(wrk%Code)//'" already exists.' - isDirtyROOMS = .false. + ! update existing + Room(rdx) = wrk end if + else - ! update existing - Room(rdx) = wrk + + remark = ': Add/edit room failed; "'//trim(wrk%Code)//'" already exists.' + isDirtyROOMS = .false. + end if + else + ! same code; update other fields + Room(rdx) = wrk end if - case default - !write(*,*) 'Unknown action: '//tAction + if (isDirtyROOMS) call xml_write_rooms(pathToYear) + + else ! Add or Update clicked, but no changes made + remark = ': No changes made?' + end if - end select + call html_college_links(device, Department(wrk%DeptIdx)%CollegeIdx, & + trim(tRoom)//remark) - if (isDirtyROOMS) then - call xml_write_rooms(pathToYear) - call html_college_links(device, Department(wrk%DeptIdx)%CollegeIdx, trim(tRoom)//remark) - return end if - targetDepartment = Room(rdx)%DeptIdx + end subroutine room_edit + + + subroutine room_info(device, wrk, header, remark, tAction) + integer, intent(in) :: device + type (TYPE_ROOM), intent(in) :: wrk + character (len=*), intent(in) :: header, remark, tAction + character(len=MAX_LEN_ROOM_CODE) :: tRoom + integer :: i, j + + tRoom = wrk%Code + targetDepartment = wrk%DeptIdx + targetCollege = Department(targetDepartment)%CollegeIdx + + call html_write_header(device, header, remark) - call html_write_header(device, 'Edit room '//tRoom, remark(3:)) call make_form_start(device, fnEditRoom, tRoom) - write(device,AFORMAT) '
', & - begintr//begintd//'Room code'//endtd//begintd//' (A new room will be created if this is changed)'//endtd//endtr + + write(device,AFORMAT) '
', & + begintr//begintd//'Room code'//endtd//begintd//''//endtd//endtr + write(device,AFORMAT) & - begintr//begintd//'Responsible department'//endtd//begintd//'' do i=2,NumDepartments if (i/=targetDepartment) then j=0 @@ -497,17 +538,18 @@ subroutine room_edit(device) trim(Department(i)%Name) end do write(device,AFORMAT) ''//endtd//endtr, & - begintr//begintd//'Maximum seating capacity'//endtd//begintd//''//endtd//endtr, & - begintr//begintd//'Cluster'//endtd//begintd//''//endtd//endtr + begintr//begintd//'Maximum seating capacity'//endtd//begintd//''//endtd//endtr, & + begintr//begintd//'Cluster'//endtd//begintd//''//endtd//endtr - write(device,AFORMAT) '

'//nbsp//'
', &
-        'NOTE: Rooms that are located in buildings within walking distance of each other must belong to the same cluster.', &
-        '
' + write(device,AFORMAT) '
'//nbsp// & + '
', &
+            'NOTE: Rooms that are within walking distance of each other must belong to the same cluster.', &
+            '
' - return - end subroutine room_edit + + end subroutine room_info end module EditROOMS diff --git a/EditSECTIONS.F90 b/EditSECTIONS.F90 index 0352fdb..4bb2e94 100644 --- a/EditSECTIONS.F90 +++ b/EditSECTIONS.F90 @@ -98,7 +98,7 @@ subroutine teacher_search_given_time(device, NumSections, Section, wrk, to_skip, end do if (skip) cycle ! done with this teacher teacher_count = teacher_count+1 - write(device,AFORMAT) trim(make_href(fnTeacherSchedule, Teacher(tdx)%Name, & + write(device,AFORMAT) trim(make_href(fnTeacherEditSchedule, Teacher(tdx)%Name, & A1=Teacher(tdx)%TeacherID, & pre=begintr//begintd, & post=endtd//begintd//'['//trim(itoa(ncol))//']')) @@ -111,7 +111,7 @@ subroutine teacher_search_given_time(device, NumSections, Section, wrk, to_skip, begintr//'(No teachers available during specified times, or time not specified)'//endtd//endtr write(device,AFORMAT) '' - return + end subroutine teacher_search_given_time @@ -190,7 +190,7 @@ subroutine room_search_given_time(device, NumSections, Section, wrk, to_skip, ro begintr//'(No rooms available during specified times, or time not specified)'//endtd//endtr write(device,AFORMAT) '' - return + end subroutine room_search_given_time @@ -211,7 +211,9 @@ subroutine section_list_all (device, NumSections, Section, Offering, NumBlocks, character (len=MAX_LEN_SUBJECT_CODE) :: tSubject, tSeats, searchString character(len=MAX_LEN_DEPARTMENT_CODE) :: tDepartment character(len=MAX_LEN_COLLEGE_CODE) :: tCollege - logical :: isLecture, okToAdd + character(len=MAX_LEN_TEACHER_CODE) :: tTeacher + logical :: isLecture, okToAdd, conflicted, isUserTeacher + integer, dimension(60,6) :: TimeTable targetDepartment = DeptIdxUser targetCollege = CollegeIdxUser @@ -255,6 +257,14 @@ subroutine section_list_all (device, NumSections, Section, Offering, NumBlocks, tDepartment = tCollege targetDepartment = index_to_dept(tDepartment) #endif + + case (fnTeacherClasses) + call cgi_get_named_string(QUERY_STRING, 'A1', tTeacher, i) + targetTeacher = index_to_teacher(tTeacher) + targetDepartment = Teacher(targetTeacher)%DeptIdx + targetCollege = Department(targetDepartment)%CollegeIdx + header = 'Classes of '//Teacher(targetTeacher)%Name + end select if (present(mesg)) then @@ -298,6 +308,13 @@ subroutine section_list_all (device, NumSections, Section, Offering, NumBlocks, okToAdd = i>0 end if + case (fnTeacherClasses) + i = 0 + do ncol=1,Section(sdx)%NMeets + if (Section(sdx)%TeacherIdx(ncol)==targetTeacher) i = i+1 + end do + okToAdd = i>0 + end select if (okToAdd) then @@ -307,7 +324,12 @@ subroutine section_list_all (device, NumSections, Section, Offering, NumBlocks, end do ! sdx=1,NumSections if (nsections==0) then - write(device,AFORMAT) '
(None)
' + if (fn==fnTeacherClasses) then + write(device,AFORMAT) trim(make_href(fnTeacherEditSchedule, 'Add', & + A1=tTeacher, pre='
( ', post=' )
')) + else + write(device,AFORMAT) '
( None )
' + end if return end if @@ -336,30 +358,33 @@ subroutine section_list_all (device, NumSections, Section, Offering, NumBlocks, end do !write(*,*) nopen, ' subjects' - ! write shortcut to subjects - write(device,AFORMAT) '' - ncol = 0 - do idx=1,nopen - tSubject = Subject(tArray(nsections+idx))%Name - i = index(tSubject, DASH) - if (tSubject(1:3) /= 'PE ' .and. i > 0) cycle - ncol = ncol + 1 - if (ncol == 1) then - write(device,AFORMAT) begintr//begintd//''//trim(tSubject)//''//endtd - else if (ncol == maxcol) then - write(device,AFORMAT) begintd//''//trim(tSubject)//''//endtd//endtr - ncol = 0 - else - write(device,AFORMAT) begintd//''//trim(tSubject)//''//endtd - end if - end do - if (ncol /= 0) then - do i=ncol+1,maxcol - write(device,AFORMAT) tdnbspendtd + if (fn/=fnTeacherClasses) then + ! write shortcut to subjects + write(device,AFORMAT) '
' + ncol = 0 + do idx=1,nopen + tSubject = Subject(tArray(nsections+idx))%Name + i = index(tSubject, DASH) + if (tSubject(1:3) /= 'PE ' .and. i > 0) cycle + ncol = ncol + 1 + if (ncol == 1) then + write(device,AFORMAT) begintr//begintd//''//trim(tSubject)//''//endtd + else if (ncol == maxcol) then + write(device,AFORMAT) begintd//''//trim(tSubject)//''//endtd//endtr + ncol = 0 + else + write(device,AFORMAT) begintd//''//trim(tSubject)//''//endtd + end if end do - write(device,AFORMAT) endtr + if (ncol /= 0) then + do i=ncol+1,maxcol + write(device,AFORMAT) tdnbspendtd + end do + write(device,AFORMAT) endtr + end if + write(device,AFORMAT) '
' end if - write(device,AFORMAT) '' + nclosed = 0 ! make list of closed subjects here, starting at tArray(nsections+nopen+1) @@ -380,22 +405,25 @@ subroutine section_list_all (device, NumSections, Section, Offering, NumBlocks, end do #endif - ! offer to open sections - if (fnAvailable(fnScheduleOfferSubject) .and. & - nclosed>0 .and. (isRoleAdmin .or. (isRoleChair .and. DeptIdxUser==targetDepartment))) then - call make_form_start(device, fnScheduleOfferSubject, A2=Department(targetDepartment)%Code) - write(device,AFORMAT) & - ''//begintr//'
', & - 'Open a section in '//nbsp//nbsp//' '// & - endtd//endtr//'
' + if (fn/=fnTeacherClasses) then + ! offer to open sections + if (fnAvailable(fnScheduleOfferSubject) .and. & + nclosed>0 .and. (isRoleAdmin .or. (isRoleChair .and. DeptIdxUser==targetDepartment))) then + call make_form_start(device, fnScheduleOfferSubject, A2=Department(targetDepartment)%Code) + write(device,AFORMAT) & + ''//begintr//'
', & + 'Open a section in '//nbsp//nbsp//' '// & + endtd//endtr//'
' + end if + write(device,AFORMAT) '

' end if - write(device,AFORMAT) '

', & + write(device,AFORMAT) & 'Note: If the hyperlinks are active, the section code links to the gradesheet,', & ' the block name links to the block schedule, and the no. of seats links to the classlist. ', & ' Deleting a lecture section automatically deletes the associated laboratory or recitation sections. ', & @@ -442,7 +470,7 @@ subroutine section_list_all (device, NumSections, Section, Offering, NumBlocks, write(device,AFORMAT) '('//trim(text_term_offered_separated(Subject(cdx)%TermOffered))//')' if (isRoleAdmin) then write(device,AFORMAT) trim(make_href(fnEditSubject, 'Edit', A1=Subject(cdx)%Name, & - pre=nbsp//'[ ', post=' ]')) + pre=nbsp//'[ ', post=' ]', alt=SPACE)) end if write(device,AFORMAT) endtd//endtr, & begintr//tdnbspendtd//''//nbsp//'Pr. '//trim(text_prerequisite_of_subject(cdx,0))//endtd @@ -454,7 +482,7 @@ subroutine section_list_all (device, NumSections, Section, Offering, NumBlocks, okToAdd = isRoleAdmin .or. (isRoleChair .and. DeptIdxUser==targetDepartment) #endif - if (fnAvailable(fnScheduleOfferSubject) .and. okToAdd) then + if (fn/=fnTeacherClasses .and. okToAdd) then write(device,AFORMAT) begintd//'', & trim(make_href(fnScheduleOfferSubject, 'Add '//tDepartment, & A1=QUERY_put, A2=Department(targetDepartment)%Code, & @@ -468,6 +496,12 @@ subroutine section_list_all (device, NumSections, Section, Offering, NumBlocks, sdx = tArray(jdx) if (Section(sdx)%SubjectIdx/=cdx) cycle + ! does USER teach the section? + isUserTeacher = .false. + do i=1,Section(sdx)%NMeets + if (Section(sdx)%TeacherIdx(i)==targetLogin) isUserTeacher = .true. + end do + owner_dept = Section(sdx)%DeptIdx owner_coll = Department(owner_dept)%CollegeIdx @@ -483,8 +517,8 @@ subroutine section_list_all (device, NumSections, Section, Offering, NumBlocks, write(device,AFORMAT) begintr//tdnbspendtd ! section code, link to gradesheet entry form - if (fnAvailable(fnGradeSheet) .and. & - (isRoleAdmin .or. (isRoleChair .and. DeptIdxUser==owner_dept))) then + if ( (isRoleAdmin .or. (isRoleChair .and. DeptIdxUser==owner_dept) .or. & + isUserTeacher) ) then write(device,AFORMAT) trim(make_href(fnGradeSheet, trim(Section(sdx)%Code), & A1=QUERY_PUT, pre=begintd, post=endtd)) else @@ -497,12 +531,8 @@ subroutine section_list_all (device, NumSections, Section, Offering, NumBlocks, write(device,AFORMAT) endtd ! seats, link to classlist - if (fnAvailable(fnClassList)) then - write(device,AFORMAT) trim(make_href(fnClassList, tSeats, & - A1=QUERY_PUT, pre=begintd, post=endtd)) - else - write(device,AFORMAT) begintd//trim(tSeats)//endtd - end if + write(device,AFORMAT) trim(make_href(fnClassList, tSeats, & + A1=QUERY_PUT, pre=begintd, post=endtd)) ! time, day, room, teacher if (is_regular_schedule(sdx, Section)) then @@ -512,12 +542,22 @@ subroutine section_list_all (device, NumSections, Section, Offering, NumBlocks, begintd//trim(text_days_of_section(sdx, NumSections, Section))//endtd// & begintd//trim(text_time_period(Section(sdx)%bTimeIdx(1), Section(sdx)%eTimeIdx(1)))//endtd if (rdx/=0) then - write(device,AFORMAT) begintd//trim(Room(rdx)%Code)//endtd + if (fn==fnRoomSchedule) then + write(device,AFORMAT) begintd//trim(Room(rdx)%Code)//endtd + else + write(device,AFORMAT) trim(make_href(fnRoomSchedule, Room(rdx)%Code, & + A1=Room(rdx)%Code, pre=begintd, post=endtd)) + end if else write(device,AFORMAT) begintd//red//trim(Room(rdx)%Code)//black//endtd end if if (tdx/=0) then - write(device,AFORMAT) begintd//trim(Teacher(tdx)%Name)//endtd + if (fn==fnTeacherClasses) then + write(device,AFORMAT) begintd//trim(Teacher(tdx)%Name)//endtd + else + write(device,AFORMAT) trim(make_href(fnTeacherClasses, Teacher(tdx)%Name, & + A1=Teacher(tdx)%TeacherID, pre=begintd, post=endtd)) + end if else write(device,AFORMAT) begintd//red//trim(Teacher(tdx)%Name)//black//endtd end if @@ -531,12 +571,22 @@ subroutine section_list_all (device, NumSections, Section, Offering, NumBlocks, begintd//txtDay(Section(sdx)%DayIdx(ncol))//endtd// & begintd//trim(text_time_period(Section(sdx)%bTimeIdx(ncol), Section(sdx)%eTimeIdx(ncol)))//endtd if (rdx/=0) then - write(device,AFORMAT) begintd//trim(Room(rdx)%Code)//endtd + if (fn==fnRoomSchedule) then + write(device,AFORMAT) begintd//trim(Room(rdx)%Code)//endtd + else + write(device,AFORMAT) trim(make_href(fnRoomSchedule, Room(rdx)%Code, & + A1=Room(rdx)%Code, pre=begintd)) + end if else write(device,AFORMAT) begintd//red//trim(Room(rdx)%Code)//black//endtd end if if (tdx/=0) then - write(device,AFORMAT) begintd//trim(Teacher(tdx)%Name) + if (fn==fnTeacherClasses) then + write(device,AFORMAT) begintd//trim(Teacher(tdx)%Name) + else + write(device,AFORMAT) trim(make_href(fnTeacherClasses, Teacher(tdx)%Name, & + A1=Teacher(tdx)%TeacherID, pre=begintd)) + end if else write(device,AFORMAT) begintd//red//trim(Teacher(tdx)%Name)//black end if @@ -550,8 +600,7 @@ subroutine section_list_all (device, NumSections, Section, Offering, NumBlocks, end if write(device,AFORMAT) begintd//'' - if (fnAvailable(fnScheduleEdit) .and. & - isRoleAdmin .or. (isRoleChair .and. DeptIdxUser==owner_dept)) then + if (isRoleAdmin .or. (isRoleChair .and. DeptIdxUser==owner_dept)) then write(device,AFORMAT) trim(make_href(fnScheduleEdit, ' Edit', & A1=QUERY_put)) write(device,AFORMAT) trim(make_href(fnScheduleDelete, ' Del', & @@ -579,9 +628,14 @@ subroutine section_list_all (device, NumSections, Section, Offering, NumBlocks, end do end do - write(device,AFORMAT) '
' + write(device,AFORMAT) '
' + if (fn==fnTeacherClasses) then + call timetable_meetings_of_teacher(NumSections, Section, targetTeacher, 0, nsections, tArray, TimeTable, conflicted) + if (nsections>0) call timetable_display(device, Section, TimeTable) + end if + write(device,AFORMAT) '
' + - return end subroutine section_list_all @@ -652,7 +706,7 @@ subroutine section_offer_subject(device, NumSections, Section, Offering, NumBloc call section_list_all (device, NumSections, Section, Offering, NumBlocks, Block, & fnScheduleOfClasses, dept, 'Opened a section in '//tSubject) - return + end subroutine section_offer_subject @@ -697,7 +751,7 @@ subroutine section_add_laboratory(device, NumSections, Section, Offering, NumBlo call section_list_all (device, NumSections, Section, Offering, NumBlocks, Block, & fnScheduleOfClasses, dept, 'Opened new section '//trim(Subject(crse)%Name)//' '//tSection) - return + end subroutine section_add_laboratory @@ -760,7 +814,7 @@ subroutine section_delete(device, NumSections, Section, Offering, NumBlocks, Blo call section_list_all (device, NumSections, Section, Offering, NumBlocks, Block, & fnScheduleOfClasses, dept, trim(mesg)) - return + end subroutine section_delete @@ -785,7 +839,7 @@ subroutine section_edit(device, NumSections, Section, NumBlocks, Block) call section_validation_form(device, NumSections, Section, NumBlocks, Block, & 1, sect, Section(sect), targetDepartment, targetDepartment) - return + end subroutine section_edit @@ -924,7 +978,7 @@ subroutine section_write_edit_form(device, NumSections, Section, NumBlocks, Bloc write(device,AFORMAT) '', & '
If you made a change above,   ', & '
' - return + end subroutine section_write_edit_form @@ -985,7 +1039,7 @@ subroutine section_build_from_query (NumSections, Section, section_index, tSecti ! trim(Room(tSection%RoomIdx(idx))%Code)//SPACE, & ! trim(Teacher(tSection%TeacherIdx(idx))%TeacherID), idx=1,idx_meet) - return + end subroutine section_build_from_query @@ -1053,7 +1107,7 @@ subroutine section_validate_inputs(device, NumSections, Section, Offering, NumBl call html_write_header(device, 'Proposed changes to section '//tClassId) call section_validation_form(device, NumSections, Section, NumBlocks, Block, & action_index, sect, wrk, teacher_dept, room_dept) - return + end subroutine section_validate_inputs @@ -1168,7 +1222,12 @@ subroutine section_validation_form(device, NumSections, Section, NumBlocks, Bloc write(device,AFORMAT) & ''// & '' + tLen = 0 do idx=1,wrk%NMeets + tArray(tLen+1) = sect + tArray(tLen+2) = idx + tArray(tLen+3) = 0 + tLen = tLen+3 write(device,AFORMAT) & '', & '', & @@ -1176,11 +1235,14 @@ subroutine section_validation_form(device, NumSections, Section, NumBlocks, Bloc '', & '' end do + tArray(tLen+1) = 0 + tArray(tLen+2) = 0 + tArray(tLen+3) = 0 if (ierr==0 .and. REQUEST==fnScheduleValidate) then ! nothing wrong? - write(device,AFORMAT) ''//begintr// & - tdalignright//'changes.', & - endtd//endtr//'
' + call list_sections_to_edit(device, Section, tLen, tArray, 0, SPACE, SPACE, .false.) + write(device,AFORMAT) 'No fatal error in section. '// & + '
' end if if (conflict_room .or. action_index==3) then ! tAction=='Find rooms') then @@ -1372,7 +1434,7 @@ subroutine section_validation_form(device, NumSections, Section, NumBlocks, Bloc write(device,AFORMAT) '' - return + end subroutine section_validation_form diff --git a/EditSUBJECTS.F90 b/EditSUBJECTS.F90 index 4346207..ba6970e 100644 --- a/EditSUBJECTS.F90 +++ b/EditSUBJECTS.F90 @@ -158,7 +158,7 @@ subroutine subject_list_all (device) end if write(device,AFORMAT) '
' - return + end subroutine subject_list_all @@ -400,8 +400,8 @@ subroutine subject_edit(device) j = index(tSubject,SPACE) if ( j
' - return + end subroutine subject_edit diff --git a/EditTEACHERS.F90 b/EditTEACHERS.F90 index 4853a51..b6dfb02 100644 --- a/EditTEACHERS.F90 +++ b/EditTEACHERS.F90 @@ -100,7 +100,7 @@ subroutine teacher_list_all (device, fn) begintr//begintd//'(None?)'//endtd//tdalignright if (isRoleAdmin) then write(device,AFORMAT) trim(make_href(fnEditTeacher, 'Add teacher', & - A1='Guest', pre='('//nbsp, post=' )')) + A1='Guest', pre='('//nbsp, post=' )', alt=SPACE)) end if write(device,AFORMAT) endtd//endtr//'' else @@ -116,11 +116,11 @@ subroutine teacher_list_all (device, fn) end do write(device,AFORMAT) '', begintr//begintd// & - '(Numbers per term are: No. of classes / Lect hrs / Lab hrs / Teaching load)', & + '(Numbers per term are: # classes / Lect hrs / Lab hrs)', & endtd//tdalignright if (isRoleAdmin) then write(device,AFORMAT) trim(make_href(fnEditTeacher, 'Add teacher', & - A1='Guest', pre='('//nbsp, post=' )')) + A1='Guest', pre='('//nbsp, post=' )', alt=SPACE)) end if write(device,AFORMAT) endtd//endtr//'
' @@ -179,7 +179,7 @@ subroutine teacher_list_all (device, fn) if (isRoleAdmin .or. (isRoleChair .and. DeptIdxUser==Teacher(fac)%DeptIdx) ) then write(device,AFORMAT) trim(make_href(fnEditTeacher, 'Edit', & - A1=QUERY_put, pre=nbsp//'', post='')) + A1=QUERY_put, pre=nbsp//'( ', post=' )', alt=SPACE)) end if write(device,AFORMAT) endtd @@ -188,10 +188,10 @@ subroutine teacher_list_all (device, fn) do term=termBegin,termEnd call qualify_term (term, tYear, targetTerm, tDesc) - write(stats,'(i2,3(a,f5.1))') & + write(stats,'(i2,2(a,f5.1))') & nsect(targetTerm), SPACE//FSLASH//SPACE, totalLect(targetTerm), SPACE//FSLASH//SPACE, & - totalLab(targetTerm), SPACE//FSLASH//SPACE, totalUnits(targetTerm) - write(device,AFORMAT) trim(make_href(fnTeacherSchedule, stats, & + totalLab(targetTerm) ! , SPACE//FSLASH//SPACE, totalUnits(targetTerm) + write(device,AFORMAT) trim(make_href(fnTeacherClasses, stats, & A1=QUERY_put, pre=tdaligncenter//nbsp, post=nbsp//endtd)) end do @@ -204,7 +204,7 @@ subroutine teacher_list_all (device, fn) end if write(device,AFORMAT) '
' - return + end subroutine teacher_list_all @@ -313,17 +313,17 @@ subroutine teacher_conflicts (device, NumSections, Section) ' ('//trim(Teacher(fac)%Specialization)//')' if (isRoleAdmin .or. (isRoleChair .and. DeptIdxUser==Teacher(fac)%DeptIdx) ) then write(device,AFORMAT) trim(make_href(fnEditTeacher, 'Edit', & - A1=QUERY_put, pre=nbsp//'', post='')) + A1=QUERY_put, pre=nbsp//'', post='', alt=SPACE)) end if write(device,AFORMAT) endtd//tdaligncenter//trim(Teacher(fac)%Role)//endtd, & - tdaligncenter//itoa(nsect)//trim(make_href(fnTeacherSchedule, 'Edit', & - A1=QUERY_put, pre=' ', post='')) + tdaligncenter//itoa(nsect)//trim(make_href(fnTeacherEditSchedule, 'Edit', & + A1=QUERY_put, pre=' ', post='', alt=SPACE)) write(device,'(2(a,f5.1), a,f5.2,a)') endtd//tdaligncenter, totalLect, & endtd//tdaligncenter, totalLab, & endtd//tdaligncenter, totalUnits, & '/'//trim(itoa(Teacher(fac)%MaxLoad))// & trim(make_href(fnPrintableWorkload, 'Printable', & - A1=QUERY_put, pre=nbsp//'', post=''))//endtd// & + A1=QUERY_put, pre=nbsp//'', post='', alt=SPACE))//endtd// & tdaligncenter//trim(mesg)//endtd//endtr end do write(device,AFORMAT) '' @@ -331,7 +331,7 @@ subroutine teacher_conflicts (device, NumSections, Section) end if write(device,AFORMAT) '
' - return + end subroutine teacher_conflicts @@ -351,12 +351,6 @@ subroutine teacher_schedule(device, NumSections, Section, LoadSource) ! which teacher? call cgi_get_named_string(QUERY_STRING, 'A1', tTeacher, ierr) targetTeacher = index_to_teacher(tTeacher) - if (ierr/=0 .or. targetTeacher==0) then - targetCollege = CollegeIdxUser - targetDepartment = DeptIdxUser - call html_write_header(device, 'Teacher schedule', '
Teacher "'//tTeacher//'" not found') - return - end if targetDepartment = Teacher(targetTeacher)%DeptIdx targetCollege = Department(targetDepartment)%CollegeIdx allowed_to_edit = isRoleAdmin .or. (isRoleChair .and. targetDepartment==DeptIdxUser) @@ -387,15 +381,13 @@ subroutine teacher_schedule(device, NumSections, Section, LoadSource) end if end if - call html_write_header(device, make_href(fnPrintableWorkload, 'printable', & - A1=tTeacher, pre='Teaching schedule of '//trim(Teacher(targetTeacher)%Name)//' (', & - post=')'), mesg) + call html_write_header(device, 'Teaching schedule of '//trim(Teacher(targetTeacher)%Name), mesg) ! collect meetings of teacher targetTeacher call timetable_meetings_of_teacher(NumSections, Section, targetTeacher, 0, tLen1, tArray, TimeTable, conflicted) !write(*, '(3i6)') (tArray(mdx), mdx=1,tLen1) !if (conflicted) write(*,*) 'Conflict in schedule '//trim(Teacher(targetTeacher)%Name) - call list_sections_to_edit(device, Section, tLen1, tArray, fnTeacherSchedule, tTeacher, 'Del', allowed_to_edit) + call list_sections_to_edit(device, Section, tLen1, tArray, fnTeacherEditSchedule, tTeacher, 'Del', allowed_to_edit) !write(*, '(3i6)') (tArray(mdx), mdx=1,tLen1) if (tLen1>0) call timetable_display(device, Section, TimeTable) @@ -436,14 +428,14 @@ subroutine teacher_schedule(device, NumSections, Section, LoadSource) tArray(tLen1+tLen2+2) = 0 tArray(tLen1+tLen2+3) = 0 if (tLen2>0) then - call list_sections_to_edit(device, Section, tLen2, tArray(tLen1+1), fnTeacherSchedule, tTeacher, 'Add', & + call list_sections_to_edit(device, Section, tLen2, tArray(tLen1+1), fnTeacherEditSchedule, tTeacher, 'Add', & allowed_to_edit, & 'Classes with TBA teachers in '//trim(Department(LoadFromDept)%Code)// & ' that fit the schedule of '//trim(Teacher(targetTeacher)%Name)//'') end if ! search for feasible classes in another department? - call make_form_start(device, fnTeacherSchedule, tTeacher) + call make_form_start(device, fnTeacherEditSchedule, tTeacher) write(device,AFORMAT) '
Search for feasible classes in : '//nbsp//'
' - return + end subroutine teacher_schedule @@ -578,7 +570,7 @@ subroutine teacher_info(device, wrk, header, remark, tAction, tdx) write(device,AFORMAT) & '
'//nbsp//'
' - return + end subroutine teacher_info @@ -602,6 +594,10 @@ subroutine teacher_edit(device) tdx = index_to_teacher(tTeacher) wrk = Teacher(tdx) + targetTeacher = tdx + targetDepartment = Teacher(targetTeacher)%DeptIdx + targetCollege = Department(targetDepartment)%CollegeIdx + ! check for requested action call cgi_get_named_string(QUERY_STRING, 'action', tAction, ierr) @@ -741,7 +737,11 @@ subroutine teacher_edit(device) Teacher(tdx) = wrk end if - header = trim(tAction)//' teacher' + if (trim(tAction)=='Add') then + header = 'Add new teacher' + else + header = 'Edit info for teacher '//tTeacher + end if call teacher_info(device, wrk, header, remark(3:), tAction, tdx) if (isDirtyTEACHERS) call xml_write_teachers(pathToYear) @@ -754,7 +754,7 @@ subroutine teacher_edit(device) end if - return + end subroutine teacher_edit @@ -772,12 +772,6 @@ subroutine teacher_schedule_printable(device, NumSections, Section, NumBlocks, B ! which teacher? call cgi_get_named_string(QUERY_STRING, 'A1', tTeacher, ierr) targetTeacher = index_to_teacher(tTeacher) - if (ierr/=0 .or. targetTeacher==0) then - targetCollege = CollegeIdxUser - targetDepartment = DeptIdxUser - call html_write_header(device, 'Teacher schedule', '
Teacher "'//tTeacher//'" not found') - return - end if ! collect meetings of teacher targetTeacher call timetable_meetings_of_teacher(NumSections, Section, targetTeacher, 0, tLen1, tArray, TimeTable, conflicted) @@ -853,7 +847,7 @@ subroutine teacher_schedule_printable(device, NumSections, Section, NumBlocks, B '
'//trim(titleUniversityPresident)//endtd//endtr write(device,AFORMAT) '' - return + end subroutine teacher_schedule_printable @@ -985,7 +979,7 @@ subroutine teacher_workload(device, Section, lenSL, SectionList, NumBlocks, Bloc write(device,AFORMAT) '' - return + end subroutine teacher_workload @@ -1044,7 +1038,7 @@ subroutine class_hours_and_load(mdx, sdx, Section, meetingUnits, lectHours, labH end if end if - return + end subroutine class_hours_and_load @@ -1121,7 +1115,7 @@ subroutine change_current_password(device) '

', & '
' - return + end subroutine change_current_password @@ -1176,7 +1170,7 @@ subroutine regenerate_all_passwords() Teacher(i)%Specialization = 'Advising' call set_password(Teacher(i)%Password) - do i = k+1,NumCurricula + do i = k+1,NumCurricula-1 if (CurrProgCode(k)==CurrProgCode(i)) done(i) = .true. end do end do @@ -1210,7 +1204,7 @@ subroutine regenerate_all_passwords() Teacher(i)%Role = REGISTRAR call set_password(Teacher(i)%Password) - return + end subroutine regenerate_all_passwords @@ -1228,7 +1222,7 @@ subroutine generate_password(device) call teacher_info(device, Teacher(tdx), 'Edit info for teacher '//tTeacher, & SPACE, 'Update', tdx) - return + end subroutine generate_password diff --git a/EditUNIVERSITY.F90 b/EditUNIVERSITY.F90 index a03712e..3406558 100644 --- a/EditUNIVERSITY.F90 +++ b/EditUNIVERSITY.F90 @@ -88,7 +88,7 @@ subroutine display_signatories(device) write(device,AFORMAT) & '
'//nbsp//'
' - return + end subroutine display_signatories @@ -198,7 +198,7 @@ subroutine edit_signatories(device) call display_signatories(device) - return + end subroutine edit_signatories diff --git a/GRADES.F90 b/GRADES.F90 index cb3f91b..9c42cf5 100644 --- a/GRADES.F90 +++ b/GRADES.F90 @@ -64,7 +64,7 @@ module GRADES 'LOA ', 'LOA.', 'Loa ', 'Loa.', & ! 17, 42-45 'REGD', & ! 18, 46 'FAIL', 'Fail', & ! 19, 47-48 - '****', & ! 20, 49 + 'NFE ', & ! 20, 49 (' ', iTmp=1,100) /) ! pointer to grade @@ -74,10 +74,10 @@ module GRADES (0, iTmp=21,ZERO_PERCENT_GRADE+100) /) ! shorcuts to certain grades - integer :: & + integer, parameter :: & gdx4 = 10, gdxINC = 11, gdx5 = 12, gdxDRP = 13, & gdxS = 14, gdxU = 15, gdxPASS = 16, gdxLOA = 17, & - gdxREGD = 18, gdxFAIL = 19, gdxRECOM = 20 + gdxREGD = 18, gdxFAIL = 19, gdxNFE = 20 real, dimension(0:ZERO_PERCENT_GRADE+100) :: fGrade = (/ & ! float value for grades 0.00, & ! error @@ -115,8 +115,8 @@ function is_grade_numeric_pass(GradeIdx, checkREGD) end if is_grade_numeric_pass = GradeIdx>=(ZERO_PERCENT_GRADE+75) .or. & (GradeIdx>0 .and. GradeIdx<10) .or. & - GradeIdx==gdxPASS .or. (GradeIdx==18 .and. includeREGD) - return + GradeIdx==gdxPASS .or. (GradeIdx==gdxREGD .and. includeREGD) + end function is_grade_numeric_pass @@ -133,18 +133,18 @@ function is_grade_passing(GradeIdx, checkREGD) is_grade_passing = GradeIdx>=(ZERO_PERCENT_GRADE+75) .or. & GradeIdx==gdxS .or. & (GradeIdx>0 .and. GradeIdx<10) .or. & - GradeIdx==gdxPASS .or. (GradeIdx==18 .and. includeREGD) - return + GradeIdx==gdxPASS .or. (GradeIdx==gdxREGD .and. includeREGD) + end function is_grade_passing function is_grade_failing(GradeIdx) logical :: is_grade_failing integer, intent (in) :: GradeIdx - is_grade_failing = GradeIdx==gdx5 .or. GradeIdx==gdxU .or. & + is_grade_failing = GradeIdx==gdx5 .or. GradeIdx==gdxU .or. GradeIdx==gdxNFE .or. & GradeIdx==gdxDRP .or. GradeIdx==gdxLOA .or. GradeIdx==gdxFAIL .or. & (GradeIdx>ZERO_PERCENT_GRADE .and. GradeIdx<(ZERO_PERCENT_GRADE+75)) - return + end function is_grade_failing @@ -152,7 +152,7 @@ function is_grade_conditional(GradeIdx) logical :: is_grade_conditional integer, intent (in) :: GradeIdx is_grade_conditional = GradeIdx==gdx4 .or. GradeIdx==gdxINC - return + end function is_grade_conditional @@ -165,7 +165,7 @@ function index_to_grade (Token) Idx = Idx+ZERO_PERCENT_GRADE else Idx = -99 - do i = 0, 19 + do i = 0, 20 do j=pGrade(i), pGrade(i+1)-1 if (txtGrade(j)==Token) then Idx = i @@ -201,7 +201,7 @@ function index_to_grade (Token) end if end if index_to_grade = Idx - return + end function index_to_grade diff --git a/HEEDS.bat b/HEEDS.bat new file mode 100644 index 0000000..247b5a8 --- /dev/null +++ b/HEEDS.bat @@ -0,0 +1,121 @@ +@echo off + +SETLOCAL ENABLEEXTENSIONS +SETLOCAL DISABLEDELAYEDEXPANSION + +rem +rem ======================================= +rem There must be at least 4 arguments: UNIV YEAR TERM ACTION +rem ======================================= +rem +set ERRMSG=ERROR: There must be at least 4 arguments +if "z%4"=="z" goto usage + +rem ======================================= +rem check UNIV +rem ======================================= +set ERRMSG=ERROR: UNIV '%1' not recognized. + +if NOT "z%1"=="zUPLB" goto notUPLB +set HEEDS_Base=.\HEEDS_MSWIN_UPLB +goto checkACTION + + +:notUPLB +if NOT "z%1"=="zCSU" goto notCSU +set HEEDS_Base=.\HEEDS_MSWIN_SIAS +goto checkACTION + + +:notCSU +if NOT "z%1"=="zISU" goto usage +set HEEDS_Base=.\HEEDS_MSWIN_SIAS +goto checkACTION + +rem ======================================= +:checkACTION +set ERRMSG=ERROR: ACTION '%4' not recognized. +rem ======================================= + +if NOT "z%4"=="zClasslists" goto notClasslists +set Port_Number=60000 +goto spawnFCGI + + +:notClasslists +if NOT "z%4"=="zAdvising" goto notAdvising +set Port_Number=60010 +goto spawnFCGI + + +:notAdvising +if NOT "z%4"=="zResetpasswords" goto notResetpasswords +goto runEXE + + +:notResetpasswords +if NOT "z%4"=="zChecklists" goto notChecklists +goto runEXE + + +:notChecklists +if NOT "z%4"=="zPredict" goto notPredict +goto runEXE + + +:notPredict +if NOT "z%4"=="zPreenlist" goto usage +goto runEXE + + +rem ======================================= +:usage +rem ======================================= +echo. +echo USAGE: %0 UNIV ACTION YEAR TERM (Note: Arguments are case-sensitive!) +echo UNIV is one of: UPLB, CSU, ISU +echo ACTION is one of: Resetpasswords, Checklists, Predict, Preenlist, Classlists, Advising +echo YEAR is the year when the current School Year started (ex. 2012 for SY 2012-13) +echo TERM is one of: 1, 2, S (1=First Semester, 2=Second Semester, S=Summer Term) +echo. +echo %ERRMSG% +goto quit + + +rem ======================================= +:runEXE +rem ======================================= +set HEEDS_Executable=%HEEDS_Base%_BATCH.EXE +if exist %HEEDS_Executable% ( + %HEEDS_Executable% %* +) else ( + goto noEXE +) +goto quit + + +rem ======================================= +:spawnFCGI +rem ======================================= +set HEEDS_Executable=%HEEDS_Base%_SERVER.EXE +if exist %HEEDS_Executable% ( + echo spawn-fcgi -a 127.0.0.1 -p %Port_Number% -f "%HEEDS_Executable% %*" + spawn-fcgi -a 127.0.0.1 -p %Port_Number% -f "%HEEDS_Executable% %*" +) else ( + goto noEXE +) +goto quit + + +rem ======================================= +:noEXE +rem ======================================= +echo ERROR: %HEEDS_Executable% not found! +goto quit + + +rem ======================================= +:quit +rem ======================================= +echo. + diff --git a/HTML.F90 b/HTML.F90 index 0ba6a36..b91938a 100644 --- a/HTML.F90 +++ b/HTML.F90 @@ -76,15 +76,16 @@ module HTML fnScheduleValidate = 35, & ! check correctness of edit inputs fnTeachersByDept = 36, & ! view list teachers belonging to a college fnTeachersByName = 37, & ! view alphabetical list of teachers in a college - fnTeacherSchedule = 38, & ! view weekly schedule of a teacher - fnRoomList = 39, & ! view list rooms administered by a college - fnRoomSchedule = 40, & ! view weekly schedule of a room - fnRoomConflicts = 41, & ! view list of rooms with conflicts - fnTeacherConflicts = 42, & ! view list of teachers with conflicts - fnTBARooms = 43, & ! view list of sections with TBA rooms - fnTBATeachers = 44, & ! view list of sections with TBA teachers - fnPrintableWorkload = 45, & ! printable teaching load - fnScheduleByArea = 46, & ! display schedule of classes for editing, by area + fnTeacherClasses = 38, & ! view classes of a teacher + fnTeacherEditSchedule = 39, & ! edit weekly schedule of a teacher + fnRoomList = 40, & ! view list rooms administered by a college + fnRoomSchedule = 41, & ! view weekly schedule of a room + fnRoomConflicts = 42, & ! view list of rooms with conflicts + fnTeacherConflicts = 43, & ! view list of teachers with conflicts + fnTBARooms = 44, & ! view list of sections with TBA rooms + fnTBATeachers = 45, & ! view list of sections with TBA teachers + fnPrintableWorkload = 46, & ! printable teaching load + fnScheduleByArea = 47, & ! display schedule of classes for editing, by area ! fnBlockSchedule = 50, & ! display schedule of block section fnBlockEditName = 51, & ! edit name of block section @@ -114,15 +115,12 @@ module HTML fnUnderloadSummary = 74, & ! summary of underloading fnUnderloadedStudents = 75, & ! underloaded students fnClassList = 76, & ! view list of students in a class - fnGradeSheet = 77, & ! enter grades + fnGradeSheet = 77, & ! enter grades fnDownloadXML = 78 ! download XML data file ! the requested server function integer :: REQUEST - ! argument 'ACTION' from command line - character (len=20) :: ACTION - ! the target of the fucntion integer :: targetCollege, targetDepartment, targetSubject, targetRoom, targetTeacher, & targetCurriculum, targetStudent, targetBlock, targetSection, targetLogin @@ -251,8 +249,11 @@ function fnDescription (fn) case (fnTeachersByName ) fnDescription = 'view alphabetical list of teachers in a college' - case (fnTeacherSchedule ) - fnDescription = 'view weekly schedule of a teacher' + case (fnTeacherClasses ) + fnDescription = 'view classes of a teacher' + + case (fnTeacherEditSchedule ) + fnDescription = 'edit weekly schedule of a teacher' case (fnRoomList ) fnDescription = 'view list rooms administered by a college' @@ -354,7 +355,7 @@ function fnDescription (fn) fnDescription = 'download XML data file' end select - return + end function fnDescription @@ -392,7 +393,7 @@ function fnAvailable (fn) fnAvailable = .true. case (fnEditSubject ) - fnAvailable = .true. + fnAvailable = isActionAdvising case (fnCurriculumList ) fnAvailable = .true. @@ -401,19 +402,19 @@ function fnAvailable (fn) fnAvailable = .true. case (fnEditCurriculum ) - fnAvailable = .true. + fnAvailable = isActionAdvising case (fnActivateCurriculum ) - fnAvailable = .true. + fnAvailable = isActionAdvising case (fnDeactivateCurriculum ) - fnAvailable = .true. + fnAvailable = isActionAdvising case (fnEditRoom ) - fnAvailable = .true. + fnAvailable = isActionAdvising case (fnEditTeacher ) - fnAvailable = .true. + fnAvailable = isActionAdvising case (fnStudentsByProgram ) fnAvailable = .true. @@ -440,34 +441,34 @@ function fnAvailable (fn) fnAvailable = .true. case (fnEditCheckList ) - fnAvailable = advisingPeriod + fnAvailable = .true. case (fnChangeMatriculation ) - fnAvailable = currentTerm==nextTerm + fnAvailable = isActionClasslists case (fnFindBlock ) - fnAvailable = currentTerm==nextTerm + fnAvailable = isActionClasslists case (fnSelectSubjects) - fnAvailable = currentTerm==nextTerm + fnAvailable = isActionClasslists case (fnScheduleOfClasses ) fnAvailable = .true. case (fnScheduleOfferSubject ) - fnAvailable = advisingPeriod + fnAvailable = .true. case (fnScheduleAddLab ) - fnAvailable = advisingPeriod + fnAvailable = .true. case (fnScheduleDelete ) - fnAvailable = advisingPeriod + fnAvailable = .true. case (fnScheduleEdit ) - fnAvailable = advisingPeriod + fnAvailable = .true. case (fnScheduleValidate ) - fnAvailable = advisingPeriod + fnAvailable = .true. case (fnTeachersByDept ) fnAvailable = .true. @@ -475,7 +476,10 @@ function fnAvailable (fn) case (fnTeachersByName ) fnAvailable = .true. - case (fnTeacherSchedule ) + case (fnTeacherClasses ) + fnAvailable = .true. + + case (fnTeacherEditSchedule ) fnAvailable = .true. case (fnRoomList ) @@ -500,31 +504,31 @@ function fnAvailable (fn) fnAvailable = .true. case (fnBlockEditName ) - fnAvailable = advisingPeriod + fnAvailable = .true. case (fnBlockDeleteName ) - fnAvailable = advisingPeriod + fnAvailable = .true. case (fnBlockDeleteAll ) - fnAvailable = advisingPeriod + fnAvailable = .true. case (fnBlockNewSelect ) - fnAvailable = advisingPeriod + fnAvailable = .true. case (fnBlockNewAdd ) - fnAvailable = advisingPeriod + fnAvailable = .true. case (fnBlockCopy ) - fnAvailable = advisingPeriod + fnAvailable = .true. case (fnBlockList ) fnAvailable = .true. case (fnBlockEditSection ) - fnAvailable = advisingPeriod + fnAvailable = .true. case (fnBlockEditSubject ) - fnAvailable = advisingPeriod + fnAvailable = .true. case (fnScheduleByArea ) fnAvailable = .true. @@ -533,28 +537,28 @@ function fnAvailable (fn) fnAvailable = .true. case (fnEnlistmentSummary ) - fnAvailable = currentTerm==nextTerm + fnAvailable = isActionClasslists case (fnNotAccommodated ) - fnAvailable = currentTerm==nextTerm + fnAvailable = isActionClasslists case (fnBottleneck ) - fnAvailable = currentTerm==nextTerm + fnAvailable = isActionClasslists case (fnExtraSlots ) - fnAvailable = currentTerm==nextTerm + fnAvailable = isActionClasslists case (fnUnderloadSummary ) - fnAvailable = currentTerm==nextTerm + fnAvailable = isActionClasslists case (fnUnderloadedStudents ) - fnAvailable = currentTerm==nextTerm + fnAvailable = isActionClasslists case (fnClassList ) - fnAvailable = currentTerm==nextTerm + fnAvailable = isActionClasslists case (fnGradeSheet ) - fnAvailable = .false. !currentTerm==nextTerm + fnAvailable = isActionClasslists case (fnDemandFreshmen ) fnAvailable = .true. @@ -563,7 +567,7 @@ function fnAvailable (fn) fnAvailable = .true. case (fnPrintableSchedule ) - fnAvailable = currentTerm==nextTerm + fnAvailable = isActionClasslists case (fnDemandForSubjects ) fnAvailable = .true. @@ -578,15 +582,163 @@ function fnAvailable (fn) fnAvailable = .true. end select - return + end function fnAvailable + function make_href(fn, label, pre, post, A1, A2, A3, A4, A5, anchor, newtab, alt) + ! build HTML href, like: + ! prelabelpost + + integer, intent (in) :: fn + character(len=*), intent (in) :: label + character(len=*), intent (in), optional :: A1, A2, A3, A4, A5 + character(len=*), intent (in), optional :: pre, post, anchor, newtab, alt + + character(len=MAX_LEN_QUERY_STRING) :: make_href + character(len=MAX_CGI_WRK_LEN) :: cgi_wrk + +#if defined PRODUCTION + integer :: kStart + real :: harvest ! random number +#endif + + if (.not. fnAvailable(fn)) then + if (present(alt)) then + make_href = alt + else + make_href = pre//trim(label)//SPACE//post + end if + return + end if + + ! the function and user name + cipher = 'F='//trim(itoa(fn))//'&N='//USERNAME + ! the term if specified + if (targetTerm>0) then + cipher = trim(cipher)//'&A9='//itoa(targetTerm) + end if + + ! the arguments to the function + if (present(A1)) then + call cgi_url_encode(A1,cgi_wrk) + cipher = trim(cipher)//'&A1='//cgi_wrk + end if + if (present(A2)) then + call cgi_url_encode(A2,cgi_wrk) + cipher = trim(cipher)//'&A2='//cgi_wrk + end if + if (present(A3)) then + call cgi_url_encode(A3,cgi_wrk) + cipher = trim(cipher)//'&A3='//cgi_wrk + end if + if (present(A4)) then + call cgi_url_encode(A4,cgi_wrk) + cipher = trim(cipher)//'&A4='//cgi_wrk + end if + if (present(A5)) then + call cgi_url_encode(A5,cgi_wrk) + cipher = trim(cipher)//'&A5='//cgi_wrk + end if + +#if defined PRODUCTION + ! encrypt + call random_number(harvest) + kStart = MAX_LEN_QUERY_STRING/2 + int(harvest*MAX_LEN_QUERY_STRING/2) + call encrypt(queryEncryptionKey(:kStart), cipher) + cipher = ''//trim(label)//'' + + ! the text after the href + if (present(post)) cipher = trim(cipher)//post + + make_href = cipher + + + end function make_href + + + + subroutine make_form_start(device, fn, A1, A2, A3, A4, A5) + ! write to device the start an HTML form, like: + !
+ ! + ! + ! + + integer, intent (in) :: device, fn + character(len=*), intent (in), optional :: A1, A2, A3, A4, A5 + + character(len=MAX_CGI_WRK_LEN) :: cgi_wrk + +#if defined PRODUCTION + integer :: kStart + real :: harvest ! random number +#endif + + ! the function and user name + cipher = 'F='//trim(itoa(fn))//'&N='//USERNAME + ! the term if specified + if (targetTerm>0) then + cipher = trim(cipher)//'&A9='//itoa(targetTerm) + end if + + ! the arguments to the function + if (present(A1)) then + call cgi_url_encode(A1,cgi_wrk) + cipher = trim(cipher)//'&A1='//cgi_wrk + end if + if (present(A2)) then + call cgi_url_encode(A2,cgi_wrk) + cipher = trim(cipher)//'&A2='//cgi_wrk + end if + if (present(A3)) then + call cgi_url_encode(A3,cgi_wrk) + cipher = trim(cipher)//'&A3='//cgi_wrk + end if + if (present(A4)) then + call cgi_url_encode(A4,cgi_wrk) + cipher = trim(cipher)//'&A4='//cgi_wrk + end if + if (present(A5)) then + call cgi_url_encode(A5,cgi_wrk) + cipher = trim(cipher)//'&A5='//cgi_wrk + end if + +#if defined PRODUCTION + ! encrypt + call random_number(harvest) + kStart = MAX_LEN_QUERY_STRING/2 + int(harvest*MAX_LEN_QUERY_STRING/2) + call encrypt(queryEncryptionKey(:kStart), cipher) + write(device,AFORMAT) & + '', & + '' +#else + write(device,AFORMAT) & + '', & + '' +#endif + + end subroutine make_form_start + + subroutine html_copyright(device) integer, intent(in) :: device - write(device,AFORMAT) '' - write(device,AFORMAT) & ''//PROGNAME//nbsp//COPYRIGHT//'
', & 'This program comes with ABSOLUTELY NO WARRANTY; for details see the ', & @@ -598,7 +750,7 @@ subroutine html_copyright(device) WEB//'
', & CONTACT//'
' - return + end subroutine html_copyright @@ -606,6 +758,16 @@ subroutine html_landing_page(device, mesg) integer, intent(in) :: device character(len=*), intent(in) :: mesg integer :: j, k + character(len=MAX_LEN_TEACHER_CODE) :: tTeacher + character (len=MAX_LEN_PASSWD_VAR) :: tPassword + +#if defined PRODUCTION + tTeacher = GUEST +#else + tTeacher = PROGNAME +#endif + j = index_to_teacher(tTeacher) + call get_password(j, tPassword) write(device,AFORMAT) & ''//trim(UniversityCode)//SPACE//PROGNAME//'' @@ -618,17 +780,17 @@ subroutine html_landing_page(device, mesg) write(device,AFORMAT)'

Index' else ! Login page write(device,AFORMAT) & - '

Welcome to '//trim(UniversityCode)//SPACE//PROGNAME//FSLASH//trim(ACTION)// & + '

Welcome to '//trim(UniversityCode)//SPACE//trim(ACTION)// & ' for '//text_school_year(currentYear)//'

' write(device,AFORMAT) ''//begintr, & '
', & '', & '', & 'Username (case sensitive):
', & - '', & !OUR">', & ! + '', & '

', & 'Password:
', & - '', & !q">', & ! + '', & '

', & '' if (len_trim(loginCheckMessage)>0) write(device,AFORMAT) & @@ -639,7 +801,7 @@ subroutine html_landing_page(device, mesg) write(device,AFORMAT) & '
  • Curriculum advisers - view all data, modify records of students in curriculum ( TeacherID ' done = .false. - do k=1,NumCurricula-2 + do k=1,NumCurricula-1 if (done(k)) cycle write(device,AFORMAT) trim(CurrProgCode(k))//nbsp do j = k+1,NumCurricula-1 @@ -659,7 +821,7 @@ subroutine html_landing_page(device, mesg) end if - return + end subroutine html_landing_page @@ -672,7 +834,7 @@ subroutine html_login(fname, mesg) write(device,AFORMAT) '' close(device) - return + end subroutine html_login @@ -680,18 +842,22 @@ subroutine timetable_display(device, Section, TimeTable) integer, intent(in) :: device, TimeTable(60,6) type (TYPE_SECTION), intent(in) :: Section(0:) integer, parameter :: period = 2 ! no. of 15 minute intervals - integer :: i, color, ncol, sect, j, mcol + integer :: i, color, ncol, sect, j, mcol, minTime, maxTime character (len=1024) :: line integer :: colorIdx(60,6) - write(device,AFORMAT) '' + call html_comment('timetable_display()') + minTime = 56 + maxTime = 1 ! background colors colorIdx = 0 color = 0 do ncol=1,56,period do i=6,1,-1 if (TimeTable(ncol,i)<=0) cycle ! no class at this time + if (ncolmaxTime) maxTime = ncol if (colorIdx(ncol,i)/=0) cycle ! already has a color ! section not colored yet sect = TimeTable(ncol,i) @@ -710,7 +876,7 @@ subroutine timetable_display(device, Section, TimeTable) thaligncenter//'Mon'//endth//thaligncenter//'Tue'//endth//thaligncenter//'Wed'//endth//& thaligncenter//'Thu'//endth//thaligncenter//'Fri'//endth//thaligncenter//'Sat'//endth//& endtr - do ncol=1,56,period + do ncol=minTime,maxTime,period ! 1,56,period line = SPACE do i=6,1,-1 sect = TimeTable(ncol,i) @@ -727,7 +893,7 @@ subroutine timetable_display(device, Section, TimeTable) write (device,AFORMAT) begintr//trim(line)//endtr end do write(device,AFORMAT) '
    • ' - return + end subroutine timetable_display @@ -743,7 +909,7 @@ subroutine list_sections_to_edit(device, Section, lenSL, SectionList, & logical :: countUnits, sectionDone real :: totalUnits, meetingUnits, totalHours, meetingHours - write(device,AFORMAT) '' + call html_comment('list_sections_to_edit()') if (present(heading)) write(device,AFORMAT) heading if (lenSL < 3) then @@ -875,7 +1041,7 @@ subroutine list_sections_to_edit(device, Section, lenSL, SectionList, & write(device,AFORMAT) begintd//'TBA'//endtd end if - if (target_fn==fnRoomSchedule .or. target_fn==fnTeacherSchedule) then + if (target_fn==fnRoomSchedule .or. target_fn==fnTeacherEditSchedule) then if ( permitted ) then write(device,AFORMAT) trim(make_href(target_fn, target_action, & A1=target_name, A2=target_action, A3=QUERY_put, & @@ -883,6 +1049,14 @@ subroutine list_sections_to_edit(device, Section, lenSL, SectionList, & else write(device,AFORMAT) tdnbspendtd//endtr end if + elseif (target_fn==fnTeacherClasses) then + if ( permitted .and. tdx>0) then + write(device,AFORMAT) trim(make_href(target_fn, target_action, & + A1=Teacher(tdx)%TeacherID, & + pre=begintd//'', post=''//endtd//endtr)) + else + write(device,AFORMAT) tdnbspendtd//endtr + end if elseif (target_fn==fnChangeMatriculation .or. target_fn==fnBlockEditSection) then if ( permitted ) then ! operate on lab classes, not lecture classes @@ -946,7 +1120,7 @@ subroutine list_sections_to_edit(device, Section, lenSL, SectionList, & trim(Section(conflict)%ClassId)//black//endtd//endtr write(device,AFORMAT) begintr//begintd//endtd//begintd//endtd//begintd//endtd//begintd//endtd else - if (target_fn==fnRoomSchedule .or. target_fn==fnTeacherSchedule) then + if (target_fn==fnRoomSchedule .or. target_fn==fnTeacherEditSchedule) then if ( permitted ) then write(device,AFORMAT) trim(make_href(target_fn, target_action, & A1=target_name, A2=target_action, A3=QUERY_put, & @@ -982,7 +1156,7 @@ subroutine list_sections_to_edit(device, Section, lenSL, SectionList, & end if write(device,AFORMAT) '' - return + end subroutine list_sections_to_edit @@ -995,7 +1169,7 @@ subroutine links_to_students (device, fn) character(len=127) :: header character(len=1) :: ch - write(device,AFORMAT) '' + call html_comment('links_to_students()') ! collect students n_count = 0 @@ -1083,14 +1257,14 @@ subroutine links_to_students (device, fn) if (ncol>0) then write(device,AFORMAT) trim(make_href(fnChangeMatriculation, 'schedule', & A1=Student(std)%StdNo, & - pre=' [ ', post=' ]')) + pre=' [ ', post=' ]', alt=SPACE)) end if write(device,AFORMAT) trim(make_href(fnEditCheckList, 'checklist', & A1=Student(std)%StdNo, & - pre=' [ ', post=' ]')) + pre=' [ ', post=' ]', alt=SPACE)) write(device,AFORMAT) trim(make_href(fnStudentPerformance, 'performance', & A1=Student(std)%StdNo, & - pre=' [ ', post=' ]')) + pre=' [ ', post=' ]', alt=SPACE)) end if write(device,AFORMAT) endtd//endtr @@ -1099,7 +1273,7 @@ subroutine links_to_students (device, fn) end if write(device,AFORMAT) '
    ' - return + end subroutine links_to_students @@ -1109,7 +1283,7 @@ subroutine list_students(device, n_count, tArray, crse, Preenlisted) integer :: ldx, tdx, std, ncol character (len=MAX_LEN_SUBJECT_CODE) :: tNum - write(device,AFORMAT) '' + call html_comment('list_students()') if (n_count == 0) then write(device,AFORMAT) '
    None?
    ' @@ -1141,17 +1315,16 @@ subroutine list_students(device, n_count, tArray, crse, Preenlisted) if (isRoleGuest) then ! do not provide student info to Guest else - if (ncol>0 .and. fnAvailable(fnChangeMatriculation)) & + if (ncol>0) & write(device,AFORMAT) trim(make_href(fnChangeMatriculation, 'schedule', & A1=Student(std)%StdNo, & - pre=' [ ', post=' ]')) - if (fnAvailable(fnEditCheckList)) & - write(device,AFORMAT) trim(make_href(fnEditCheckList, 'checklist', & - A1=Student(std)%StdNo, & - pre=' [ ', post=' ]')) + pre=' [ ', post=' ]', alt=SPACE)) + write(device,AFORMAT) trim(make_href(fnEditCheckList, 'checklist', & + A1=Student(std)%StdNo, & + pre=' [ ', post=' ]', alt=SPACE)) write(device,AFORMAT) trim(make_href(fnStudentPerformance, 'performance', & A1=Student(std)%StdNo, & - pre=' [ ', post=' ]')) + pre=' [ ', post=' ]', alt=SPACE)) end if write(device,AFORMAT) endtd//endtr @@ -1159,26 +1332,31 @@ subroutine list_students(device, n_count, tArray, crse, Preenlisted) write(device,AFORMAT) '' end if - return + end subroutine list_students - subroutine class_list (device, NumSections, Section, Preenlisted) + subroutine class_list (device, NumSections, Section) integer, intent (in) :: device, NumSections type (TYPE_SECTION), intent(in) :: Section(0:) - type (TYPE_PRE_ENLISTMENT), intent(in) :: Preenlisted(0:) integer :: ldx, n_count, tdx, std, ierr, sect, ncol, crse character(len=MAX_LEN_CLASS_ID) :: tClassId + character(len=255) :: header - write(device,AFORMAT) '' + call html_comment('class_list()') ! which section? call cgi_get_named_string(QUERY_STRING, 'A1', tClassId, ierr) targetSection = index_to_section(tClassId, NumSections, Section) crse = Section(targetSection)%SubjectIdx +#if defined UPLB targetDepartment = Subject(crse)%DeptIdx +#else + targetDepartment = Section(targetSection)%DeptIdx +#endif + targetCollege = Department(targetDepartment)%CollegeIdx ! collect students n_count = 0 @@ -1203,12 +1381,44 @@ subroutine class_list (device, NumSections, Section, Preenlisted) end do end do - call html_write_header(device, 'Students in '//Section(targetSection)%ClassId) + if (is_lecture_lab_subject(crse)) then + header = trim(ftoa(Subject(crse)%LectHours+Subject(crse)%LabHours,2))//' hrs ('// & + trim(ftoa(Subject(crse)%LectHours,2))//' lect + '// & + trim(ftoa(Subject(crse)%LabHours,2))//' lab/recit).' + else if (Subject(crse)%LectHours > 0.0) then + header = trim(ftoa(Subject(crse)%LectHours,2))//' hrs lect.' + else if (Subject(crse)%LabHours > 0.0) then + header = trim(ftoa(Subject(crse)%LabHours,2))//' hrs lab/recit.' + end if + header = trim(Subject(crse)%Title)//'/ '//trim(ftoa(Subject(crse)%Units,1))//' units/ '//header + + ncol = n_count + do tdx=1,Section(targetSection)%NMeets + tArray(ncol+1) = targetSection + tArray(ncol+2) = tdx + tArray(ncol+3) = 0 + ncol = ncol+3 + end do + tArray(ncol+1) = 0 + tArray(ncol+2) = 0 + tArray(ncol+3) = 0 + + call html_write_header(device, SPACE) + call list_sections_to_edit(device, Section, ncol-n_count, tArray(n_count+1:), 0, SPACE, SPACE, .false., & + 'CLASSLIST for '//trim(Subject(crse)%Name)//' - '//trim(header)//'

    ') if (n_count == 0) then - write(device,AFORMAT) '(None?)' + write(device,AFORMAT) '
    (No students?)' else - write(device,AFORMAT) '' + write(device,AFORMAT) '
    ', & + begintr//thalignleft//'#'//endth//thalignleft//'Student No.'//endth, & + thalignleft//'Student Name'//endth//thalignleft//'Curriculum'//endth//thalignleft + if (isRoleGuest) then + else + write(device,AFORMAT) 'Links' + end if + write(device,AFORMAT) endth//endtr + do tdx=1,n_count std = tArray(tdx) ldx = Student(std)%CurriculumIdx @@ -1225,14 +1435,14 @@ subroutine class_list (device, NumSections, Section, Preenlisted) if (ncol>0) then write(device,AFORMAT) trim(make_href(fnChangeMatriculation, 'schedule', & A1=Student(std)%StdNo, & - pre=' [ ', post=' ]')) + pre=' [ ', post=' ]', alt=SPACE)) end if write(device,AFORMAT) trim(make_href(fnEditCheckList, 'checklist', & A1=Student(std)%StdNo, & - pre=' [ ', post=' ]')) + pre=' [ ', post=' ]', alt=SPACE)) write(device,AFORMAT) trim(make_href(fnStudentPerformance, 'performance', & A1=Student(std)%StdNo, & - pre=' [ ', post=' ]')) + pre=' [ ', post=' ]', alt=SPACE)) end if write(device,AFORMAT) endtd//endtr @@ -1241,7 +1451,7 @@ subroutine class_list (device, NumSections, Section, Preenlisted) end if write(device,AFORMAT) '
    ' - return + end subroutine class_list @@ -1252,10 +1462,10 @@ subroutine html_write_header(device, header, errmsg) character(len=MAX_LEN_COLLEGE_CODE) :: tCollege character(len=MAX_LEN_DEPARTMENT_CODE) :: tDepartment character(len=MAX_LEN_STUDENT_CODE) :: tStdNo - integer :: fdx, gdx, nItems !, cdx + integer :: fdx, gdx, nEnlisted, nAdvised character (len=80) :: description - write(device,AFORMAT) '' + call html_comment('html_write_header('//trim(header)//')') ! override text for TERM+YEAR ? if (termBegin==termEnd) then @@ -1274,7 +1484,7 @@ subroutine html_write_header(device, header, errmsg) ! banner line 1: user context & shortcuts write(device,AFORMAT) & '
    ', & - begintr//begintd//'

    '//trim(UniversityCode)//SPACE//PROGNAME//FSLASH//trim(ACTION)// & + begintr//begintd//'

    '//trim(UniversityCode)//SPACE//trim(ACTION)// & trim(description)//'

    '//endtd, & '
    User is ' @@ -1317,7 +1527,17 @@ subroutine html_write_header(device, header, errmsg) ! end of line 1 write(device,AFORMAT) ''//endtd//endtr - ! line 2 for banner: higher level context for selected function + ! line 2 for banner: colleges + write(device,AFORMAT) begintr//'[ Colleges:' + do gdx = 1,NumColleges + if (.not. College(gdx)%hasInfo) cycle + ! fnCollegeLinks requested already printed above? + write(device,AFORMAT) trim(make_href(fnCollegeLinks, College(gdx)%Code, & + A1=College(gdx)%Code, pre=nbsp)) + end do + write(device,AFORMAT) ' ]'//endtd//endtr + + ! line 3 for banner: higher level context for selected function write(device,AFORMAT) begintr//'' ! show student options ? @@ -1325,34 +1545,35 @@ subroutine html_write_header(device, header, errmsg) (IsRoleAdmin .or. & (IsRoleSRE .and. CurrProgCode(Student(targetStudent)%CurriculumIdx)==CurrProgCode(CurriculumIdxUser))) ) then - nItems = 0 ! how many enlisted subjects + nAdvised = 0 ! how many advised subjects + nEnlisted = 0 ! how many enlisted subjects do fdx=1,Preenlisted(targetStudent)%lenSubject - if (Preenlisted(targetStudent)%Section(fdx)>0) nItems=nItems+1 + if (Preenlisted(targetStudent)%Subject(fdx)>0) nAdvised=nAdvised+1 + if (Preenlisted(targetStudent)%Section(fdx)>0) nEnlisted=nEnlisted+1 end do tStdNo = Student(targetStudent)%StdNo write(device,AFORMAT) '[ '//trim(tStdNo)//'' - !if (NumEnlistmentRecords>0 .and. nItems==0 .and. REQUEST/=fnFindBlock) then - if (.not. advisingPeriod .and. nItems==0 .and. REQUEST/=fnFindBlock) then - write(device,AFORMAT) trim(make_href(fnFindBlock, 'Find block', & - A1=tStdNo, pre=nbsp)) - end if - - !if (NumEnlistmentRecords>0 .and. nItems>0 .and. REQUEST/=fnChangeMatriculation) then - if (.not. advisingPeriod .and. nItems>0 .and. REQUEST/=fnChangeMatriculation) then - write(device,AFORMAT) trim(make_href(fnChangeMatriculation, 'Schedule', & - A1=tStdNo, pre=nbsp)) + if (.not. advisingPeriod .and. nAdvised>0) then + if (nEnlisted==0 .and. REQUEST/=fnFindBlock) then + write(device,AFORMAT) trim(make_href(fnFindBlock, 'Find block', & + A1=tStdNo, pre=nbsp, alt=SPACE)) + end if + if (REQUEST/=fnChangeMatriculation) then + write(device,AFORMAT) trim(make_href(fnChangeMatriculation, 'Schedule', & + A1=tStdNo, pre=nbsp, alt=SPACE)) + end if end if if (REQUEST/=fnEditCheckList) then write(device,AFORMAT) trim(make_href(fnEditCheckList, 'Checklist', & - A1=tStdNo, pre=nbsp)) + A1=tStdNo, pre=nbsp, alt=SPACE)) end if if (REQUEST/=fnStudentPerformance) then write(device,AFORMAT) trim(make_href(fnStudentPerformance, 'Performance', & - A1=tStdNo, pre=nbsp)) + A1=tStdNo, pre=nbsp, alt=SPACE)) end if write(device,AFORMAT) ' ] '//nbsp @@ -1368,6 +1589,30 @@ subroutine html_write_header(device, header, errmsg) end if end if + + ! a teacher ? + if (targetTeacher>0) then + write(device,AFORMAT) '[ '//trim(Teacher(targetTeacher)%Name)//' ' + if (REQUEST/=fnEditTeacher .and. & + (isRoleAdmin .or. (isRoleChair .and. DeptIdxUser==Teacher(targetTeacher)%DeptIdx) ) ) then + write(device,AFORMAT) trim(make_href(fnEditTeacher, 'Info', & + A1=Teacher(targetTeacher)%TeacherID, pre=nbsp, alt=SPACE)) + end if + if (REQUEST/=fnTeacherClasses) then + write(device,AFORMAT) trim(make_href(fnTeacherClasses, 'Classes', & + A1=Teacher(targetTeacher)%TeacherID, pre=nbsp)) + end if + if (REQUEST/=fnTeacherEditSchedule) then + write(device,AFORMAT) trim(make_href(fnTeacherEditSchedule, 'Load', & + A1=Teacher(targetTeacher)%TeacherID, pre=nbsp)) + end if + if (REQUEST/=fnPrintableWorkload) then + write(device,AFORMAT) trim(make_href(fnPrintableWorkload, 'Form', & + A1=Teacher(targetTeacher)%TeacherID, pre=nbsp)) + end if + write(device,AFORMAT) ' ] '//nbsp + end if + ! show department options ? if (targetDepartment>0 .and. DeptIdxUser/=targetDepartment .and. REQUEST/=fnLogin) then tDepartment = Department(targetDepartment)%Code @@ -1376,17 +1621,17 @@ subroutine html_write_header(device, header, errmsg) write(device,AFORMAT) ' ] '//nbsp end if - write(device,AFORMAT) '[ Colleges:' - do gdx = 1,NumColleges - if (.not. College(gdx)%hasInfo) cycle - ! fnCollegeLinks requested already printed above? - if (REQUEST==fnCollegeLinks .and. gdx==targetCollege) cycle - write(device,AFORMAT) trim(make_href(fnCollegeLinks, College(gdx)%Code, & - A1=College(gdx)%Code, pre=nbsp)) - end do - write(device,AFORMAT) ' ]'//endtd//endtr +! write(device,AFORMAT) '[ Colleges:' +! do gdx = 1,NumColleges +! if (.not. College(gdx)%hasInfo) cycle +! ! fnCollegeLinks requested already printed above? +! if (REQUEST==fnCollegeLinks .and. gdx==targetCollege) cycle +! write(device,AFORMAT) trim(make_href(fnCollegeLinks, College(gdx)%Code, & +! A1=College(gdx)%Code, pre=nbsp)) +! end do + write(device,AFORMAT) ''//endtd//endtr - ! line 3 of banner, if any + ! line 4 of banner, if any if (present(errmsg)) then if (errmsg/=SPACE) write(device,AFORMAT) begintr//''// & red//''//trim(errmsg)//''//black//endtd//endtr @@ -1397,7 +1642,7 @@ subroutine html_write_header(device, header, errmsg) if (len_trim(header)>0) write(device,AFORMAT) '

    '//trim(header)// & trim(termDescription)//'

    ' - return + end subroutine html_write_header @@ -1407,7 +1652,7 @@ subroutine html_write_footer(device) if (REQUEST==fnDownloadXML) return - write(device,AFORMAT) '' + call html_comment('html_write_footer()') if (REQUEST/=fnStop .and. & REQUEST/=fnLogout .and. & @@ -1441,13 +1686,13 @@ subroutine html_write_footer(device) if (isSuspended) then write(device,AFORMAT) & ''//red//'The program is in suspend-mode. Non-''Admin'' roles are locked out.'// & - black//'' + black//'' end if end if - write(device,AFORMAT) '' + write(device,AFORMAT) '' + - return end subroutine html_write_footer @@ -1460,7 +1705,7 @@ subroutine html_college_links(device, given, mesg) integer :: cdx character (len=MAX_LEN_COLLEGE_CODE) :: tCollege - write(device,AFORMAT) '' + call html_comment('html_college_links()') if (present(given)) then targetCOLLEGE = given @@ -1486,7 +1731,7 @@ subroutine html_college_links(device, given, mesg) call html_college_info(device, targetCOLLEGE) end if - return + end subroutine html_college_links @@ -1495,7 +1740,7 @@ subroutine info_department(device, tDepartment) character(len=MAX_LEN_DEPARTMENT_CODE), intent (in) :: tDepartment - write(device,AFORMAT) '' + call html_comment('info_department()') if (REQUEST/=fnSubjectList) then write(device,AFORMAT) trim(make_href(fnSubjectList, 'Subjects', & @@ -1522,7 +1767,7 @@ subroutine info_department(device, tDepartment) A1=tDepartment, pre=nbsp)) end if - return + end subroutine info_department @@ -1537,7 +1782,7 @@ subroutine html_college_info(device, coll) character (len=80) :: description logical :: addHR - write(device,AFORMAT) '' + call html_comment('html_college_info()') tCollege = College(coll)%Code @@ -1576,7 +1821,7 @@ subroutine html_college_info(device, coll) write(device,AFORMAT) '
      ' if (coll==NumColleges .and. .not. isRoleGuest) then write(device,AFORMAT) '
    • Download .XML files. '//& - 'Right-click, then "Save Link As..." to '//trim(dirXML)//trim(pathToYear), & + 'Right-click, then "Save Link As..." to '//trim(dirDATA)//trim(pathToYear), & trim(make_href(fnDownloadXML, 'UNIVERSITY.XML', A1='UNIVERSITY.XML', pre='
      ')), & trim(make_href(fnDownloadXML, 'COLLEGES.XML', A1='COLLEGES.XML', pre=nbsp)), & trim(make_href(fnDownloadXML, 'DEPARTMENTS.XML', A1='DEPARTMENTS.XML', pre=nbsp)), & @@ -1651,7 +1896,7 @@ subroutine html_college_info(device, coll) write(device,AFORMAT) trim(make_href(fnCurriculumList, CurrProgCode(cdx), & A1=CurrProgCode(cdx), post='('//trim(itoa(n_count))//')'//nbsp)) - do ldx=cdx+1,NumCurricula + do ldx=cdx+1,NumCurricula-1 if (CurrProgCode(ldx) == CurrProgCode(cdx)) done(ldx) = .true. end do end do @@ -1672,8 +1917,10 @@ subroutine html_college_info(device, coll) end do addHR = n_count>0 if (addHR) then - write(device,AFORMAT) '', & - '
    • Teachers by department : ' + + call html_comment('teacher links()') + + write(device,AFORMAT) '
    • Teachers by department : ' do dept=2,NumDepartments if (Department(dept)%CollegeIdx /= coll) cycle n_count = 0 @@ -1713,8 +1960,10 @@ subroutine html_college_info(device, coll) end do if (n_count>0) then addHR = .true. - write(device,AFORMAT) '', & - '
    • Rooms by department : ' + + call html_comment('room links()') + + write(device,AFORMAT) '
    • Rooms by department : ' do dept=2,NumDepartments if (Department(dept)%CollegeIdx /= coll) cycle n_count = 0 @@ -1740,8 +1989,10 @@ subroutine html_college_info(device, coll) exit end do if (n_count>0) then - write(device,AFORMAT) '', & - '
    • Students by last name : ' + + call html_comment('student links()') + + write(device,AFORMAT) '
    • Students by last name : ' do cdx=iachar('A'), iachar('Z') ch = achar(cdx) n_count = 0 @@ -1817,7 +2068,7 @@ subroutine html_college_info(device, coll) if (coll==NumColleges .and. .not. isRoleGuest) then write(device,AFORMAT) & '
    • Download .XML files. Right-click, then "Save Link As..." to '// & - trim(dirXML)//trim(itoa(rdx))//DIRSEP//trim(txtSemester(targetTerm))//DIRSEP, & + trim(dirDATA)//trim(itoa(rdx))//DIRSEP//trim(txtSemester(targetTerm))//DIRSEP, & trim(make_href(fnDownloadXML, 'BLOCKS.XML', A1='BLOCKS.XML', pre='
      ')), & trim(make_href(fnDownloadXML, 'CLASSES.XML', A1='CLASSES.XML', pre=nbsp, & post='      ')) @@ -1845,7 +2096,7 @@ subroutine html_college_info(device, coll) targetTerm = cdx ! restore write(device,AFORMAT) '
    ' - return + end subroutine html_college_info @@ -1855,7 +2106,7 @@ subroutine links_to_depts(device, coll, fn, heading) integer :: dept, crse, n_count character(len=MAX_LEN_DEPARTMENT_CODE) :: tDepartment - write(device,AFORMAT) '' + call html_comment('links_to_depts()') write(device,AFORMAT) '
  • '//heading//' : ' do dept=2,NumDepartments @@ -1881,7 +2132,7 @@ subroutine links_to_depts(device, coll, fn, heading) end do write(device,AFORMAT) '
    • ' - return + end subroutine links_to_depts @@ -1894,7 +2145,7 @@ subroutine links_to_subjects(device, coll, numAreas, AreaList) if (numAreas==0) return - write(device,AFORMAT) '' + call html_comment('links_to_subjects()') write(device,AFORMAT) '
  • Subjects in :' do dept=2,NumDepartments @@ -1927,7 +2178,7 @@ subroutine links_to_subjects(device, coll, numAreas, AreaList) pre=nbsp, post='('//trim(itoa(n_count))//')')) end do write(device,AFORMAT) '
    • ' - return + end subroutine links_to_subjects @@ -1941,7 +2192,7 @@ subroutine links_to_sections(device, coll, numAreas, AreaList, term) if (numAreas==0) return - write(device,AFORMAT) '' + call html_comment('links_to_sections()') tCollege = College(coll)%Code @@ -2014,13 +2265,13 @@ subroutine links_to_sections(device, coll, numAreas, AreaList, term) QUERY_put = USERNAME write(device,AFORMAT) & - trim(make_href(fnTeacherSchedule, 'schedule', & + trim(make_href(fnTeacherClasses, 'classes', & A1=QUERY_put, pre=' ; My '//nbsp)), & trim(make_href(fnPrintableWorkload, 'form', & A1=QUERY_put, pre=nbsp//'and teaching load'//nbsp)) write(device,AFORMAT) '' - return + end subroutine links_to_sections @@ -2029,7 +2280,8 @@ subroutine links_to_blocks(device, coll, term) integer :: cdx, ldx, blk, ncurr character (len=MAX_LEN_COLLEGE_CODE) :: tCollege - write(device,AFORMAT) '' + call html_comment('links_to_blocks()') + ncurr = 0 tCollege = College(coll)%Code write(device,AFORMAT) '
  • Blocks : '//nbsp @@ -2046,7 +2298,7 @@ subroutine links_to_blocks(device, coll, term) ncurr = ncurr + 1 write(device,AFORMAT) trim(make_href(fnBlockList, CurrProgCode(cdx), & A1=CurrProgCode(cdx), post='('//trim(itoa(ldx))//')'//nbsp)) - do ldx=cdx+1,NumCurricula + do ldx=cdx+1,NumCurricula-1 if (CurrProgCode(ldx) == CurrProgCode(cdx)) done(ldx) = .true. end do end do @@ -2056,7 +2308,7 @@ subroutine links_to_blocks(device, coll, term) ! end if write(device,AFORMAT) '
    • ' - return + end subroutine links_to_blocks @@ -2076,140 +2328,131 @@ subroutine blocks_in_section(device, sect, fn, NumBlocks, Block) exit end do end do - return - end subroutine blocks_in_section - - - function make_href(fn, label, pre, post, A1, A2, A3, A4, A5, anchor, newtab) - ! build HTML href, like: - ! prelabelpost - integer, intent (in) :: fn - character(len=*), intent (in) :: label - character(len=*), intent (in), optional :: A1, A2, A3, A4, A5 - character(len=*), intent (in), optional :: pre, post, anchor, newtab - - character(len=MAX_LEN_QUERY_STRING) :: make_href - character(len=MAX_CGI_WRK_LEN) :: cgi_wrk - integer :: kStart - - ! random number - real :: harvest - - ! the function and user name - cipher = 'F='//trim(itoa(fn))//'&N='//USERNAME - ! the term if specified - if (targetTerm>0) then - cipher = trim(cipher)//'&A9='//itoa(targetTerm) - end if - - ! the arguments to the function - if (present(A1)) then - call cgi_url_encode(A1,cgi_wrk) - cipher = trim(cipher)//'&A1='//cgi_wrk - end if - if (present(A2)) then - call cgi_url_encode(A2,cgi_wrk) - cipher = trim(cipher)//'&A2='//cgi_wrk - end if - if (present(A3)) then - call cgi_url_encode(A3,cgi_wrk) - cipher = trim(cipher)//'&A3='//cgi_wrk - end if - if (present(A4)) then - call cgi_url_encode(A4,cgi_wrk) - cipher = trim(cipher)//'&A4='//cgi_wrk - end if - if (present(A5)) then - call cgi_url_encode(A5,cgi_wrk) - cipher = trim(cipher)//'&A5='//cgi_wrk - end if - - ! encrypt - call random_number(harvest) - kStart = MAX_LEN_QUERY_STRING/2 + int(harvest*MAX_LEN_QUERY_STRING/2) - call encrypt(queryEncryptionKey(:kStart), cipher) - - ! begin href - cipher = ''//trim(label)//'' - - ! the text after the href - if (present(post)) cipher = trim(cipher)//post - - make_href = cipher - - return - end function make_href - - - - subroutine make_form_start(device, fn, A1, A2, A3, A4, A5) - ! write to device the start an HTML form, like: - !
    - ! - ! - ! + end subroutine blocks_in_section - integer, intent (in) :: device, fn - character(len=*), intent (in), optional :: A1, A2, A3, A4, A5 - character(len=MAX_CGI_WRK_LEN) :: cgi_wrk - integer :: kStart - - ! random number - real :: harvest + subroutine collect_advice(Advice, n_changes, mesg) + + type (TYPE_PRE_ENLISTMENT), intent(out) :: Advice + character(len=*), intent (out) :: mesg + integer, intent (out) :: n_changes + + character(len=MAX_LEN_SUBJECT_CODE) :: tSubject + character(len=3*MAX_LEN_SUBJECT_CODE) :: search_string + + integer :: crse, idx, jdx, ierr, i, j, l + + call initialize_pre_enlistment(Advice) + mesg = SPACE + n_changes = 0 + + call cgi_get_named_integer(QUERY_STRING, 'earned', i, ierr) + if (ierr==0) Advice%UnitsEarned = i + call cgi_get_named_integer(QUERY_STRING, 'classification', i, ierr) + if (ierr==0) Advice%StdClassification = i + call cgi_get_named_integer(QUERY_STRING, 'year', i, ierr) + if (ierr==0) Advice%StdYear = i + call cgi_get_named_integer(QUERY_STRING, 'allowed', i, ierr) + if (ierr==0) Advice%AllowedLoad = i + call cgi_get_named_integer(QUERY_STRING, 'group', i, ierr) + if (ierr==0) Advice%StdPriority = i + call cgi_get_named_integer(QUERY_STRING, 'priority', i, ierr) + if (ierr==0) Advice%NPriority = i + call cgi_get_named_integer(QUERY_STRING, 'alternate', i, ierr) + if (ierr==0) Advice%NAlternates = i + call cgi_get_named_integer(QUERY_STRING, 'current', i, ierr) + if (ierr==0) Advice%NCurrent = i + + Advice%lenSubject = Advice%NPriority+Advice%NAlternates+Advice%NCurrent + do l=1,Advice%lenSubject + call cgi_get_named_string(QUERY_STRING, 'pri'//itoa(l), search_string, ierr) + j = index(search_string,COMMA) + tSubject = search_string(j+1:) + read(tSubject,'(f6.4)') Advice%Contrib(l) + tSubject = search_string(1:j-1) + crse = index_to_subject(tSubject) + Advice%Subject(l) = crse + end do - ! the function and user name - cipher = 'F='//trim(itoa(fn))//'&N='//USERNAME - ! the term if specified - if (targetTerm>0) then - cipher = trim(cipher)//'&A9='//itoa(targetTerm) + ! apply deletes + idx = Advice%NPriority + jdx = Advice%NAlternates + do l=1,Advice%lenSubject + call cgi_get_named_string(QUERY_STRING, 'del'//itoa(l), search_string, ierr) + if (ierr==-1) cycle ! not found + if (l<=Advice%NPriority) then + idx = idx-1 + elseif (l<=Advice%NPriority+Advice%NAlternates) then + jdx = jdx-1 + end if + crse = Advice%Subject(l) + mesg = trim(mesg)//' : Del '//Subject(crse)%Name + Advice%Contrib(l) = 0.0 + Advice%Subject(l) = 0 + n_changes = n_changes + 1 + isDirtyPREDICTIONS = .true. + call html_comment('Delete '//itoa(l)//SPACE//Subject(crse)%Name ) + + ! check if deleted subject is in WaiverCOI + i = 0 + do j=1,WaiverCOI(targetStudent)%lenSubject + if (WaiverCOI(targetStudent)%Subject(j)/=crse) cycle + i = j + exit + end do + if (i/=0) then ! remove from WaiverCOI() + do j=i,WaiverCOI(targetStudent)%lenSubject-1 + WaiverCOI(targetStudent)%Subject(j) = WaiverCOI(targetStudent)%Subject(j+1) + end do + WaiverCOI(targetStudent)%lenSubject = WaiverCOI(targetStudent)%lenSubject-1 + isDirtyWaiverCOI = .true. + !write(device,*) ' from WaiverCOI() also' + end if + end do + if (n_changes>0) then ! there were deletions + j = 0 + do l=1,Advice%lenSubject + if (Advice%Subject(l)>0) then + j = j+1 + Advice%Subject(j) = Advice%Subject(l) + Advice%Contrib(j) = Advice%Contrib(l) + end if + end do + Advice%NPriority = idx + Advice%NAlternates = jdx + Advice%lenSubject = Advice%lenSubject-n_changes ! n_changes = no. of deletions + isDirtyPREDICTIONS = .true. end if - ! the arguments to the function - if (present(A1)) then - call cgi_url_encode(A1,cgi_wrk) - cipher = trim(cipher)//'&A1='//cgi_wrk - end if - if (present(A2)) then - call cgi_url_encode(A2,cgi_wrk) - cipher = trim(cipher)//'&A2='//cgi_wrk - end if - if (present(A3)) then - call cgi_url_encode(A3,cgi_wrk) - cipher = trim(cipher)//'&A3='//cgi_wrk - end if - if (present(A4)) then - call cgi_url_encode(A4,cgi_wrk) - cipher = trim(cipher)//'&A4='//cgi_wrk - end if - if (present(A5)) then - call cgi_url_encode(A5,cgi_wrk) - cipher = trim(cipher)//'&A5='//cgi_wrk + ! check if subject added (COI, Waived prereq) + call cgi_get_named_string(QUERY_STRING, 'additional', search_string, ierr) + if (search_string/=SPACE) then ! something there + tSubject = search_string + crse = index_to_subject(tSubject) + if (crse>=0) then ! add + call html_comment('Add '//Subject(crse)%Name ) + mesg = trim(mesg)//' : Add '//tSubject + do l=Advice%lenSubject,1,-1 + Advice%Subject(l+1) = Advice%Subject(l) + Advice%Contrib(l+1) = Advice%Contrib(l) + end do + Advice%Subject(1) = crse + Advice%Contrib(1) = 1.0 + Advice%NPriority = 1+Advice%NPriority + Advice%lenSubject = 1+Advice%lenSubject + isDirtyPREDICTIONS = .true. + ! add to WaiverCOI + l = WaiverCOI(targetStudent)%lenSubject+1 + WaiverCOI(targetStudent)%lenSubject = l + WaiverCOI(targetStudent)%Subject(l) = crse + isDirtyWaiverCOI = .true. + n_changes = n_changes + 1 + end if end if - ! encrypt - call random_number(harvest) - kStart = MAX_LEN_QUERY_STRING/2 + int(harvest*MAX_LEN_QUERY_STRING/2) - call encrypt(queryEncryptionKey(:kStart), cipher) - write(device,AFORMAT) & - '', & - '' + end subroutine collect_advice - return - end subroutine make_form_start end module HTML diff --git a/MAIN.F90 b/MAIN.F90 index a44b208..5e0bf8f 100644 --- a/MAIN.F90 +++ b/MAIN.F90 @@ -1,6 +1,3 @@ -#if defined PRODUCTION -#else -#endif !====================================================================== ! ! HEEDS (Higher Education Enrollment Decision Support) - A program @@ -33,7 +30,17 @@ program MAIN - use WEBSERVER + use EditUNIVERSITY + use EditSUBJECTS + use EditROOMS + use EditTEACHERS + use EditSECTIONS + use EditBLOCKS + use EditCURRICULA + use EditPREDICTIONS + use EditENLISTMENT + use DEMAND + use REPORTS ! use SCHEDULING implicit none @@ -47,11 +54,6 @@ program MAIN call date_and_time (date=currentDate,time=currentTime) startDateTime = currentDate//DASH//currentTime(:6) -#if defined PRODUCTION -#else - write(*,*) 'Started '//startDateTime -#endif - ! initialize random seed call initialize_random_seed() @@ -66,31 +68,31 @@ program MAIN end if end do fileExecutable = fileExecutable(iTmp+1:) -#if defined PRODUCTION -#else - write(*,*) 'Executable is '//trim(fileExecutable) -#endif ! arguments are: UNIV YEAR TERM ACTION - numArgs = iargc() + numArgs = iargc() ! UNIV YEAR TERM ACTION if (numArgs<4) call usage('Error: Not enough command arguments') - ! get UNIV YEAR TERM ACTION - call getarg(1, UniversityCode) - - ! HEEDS root directory + ! user's HOME directory #if defined GLNX call get_environment_variable("HOME", dirHEEDS) #else call get_environment_variable("HOMEDRIVE", dirHEEDS) #endif - dirHEEDS = trim(dirHEEDS)//DIRSEP//'HEEDS'//DIRSEP//'dat'//DIRSEP//trim(UniversityCode)//DIRSEP + + ! University code + call getarg(1, UniversityCode) + + ! append University code to HOME directory + dirHEEDS = trim(dirHEEDS)//DIRSEP//'HEEDS'//DIRSEP//trim(UniversityCode)//DIRSEP inquire(file=trim(dirHEEDS), exist=pathExists) if (.not. pathExists) call usage('Error: directory '//trim(dirHEEDS)//' does not exist') + ! current YEAR call getarg(2, dataSource) currentYear = atoi(dataSource) + ! current TERM call getarg(3, dataSource) select case (trim(dataSource)) @@ -152,6 +154,8 @@ program MAIN ! show schedules for which terms ? termBegin = currentTerm termEnd = termBegin+2 + isActionAdvising = .false. + isActionClasslists = .false. ! allow files to be rewritten by default noWrites = .false. @@ -162,8 +166,6 @@ program MAIN select case (trim(ACTION)) -! case ('Randomize') - case ('Rename') termBegin = currentTerm termEnd = termBegin+2 @@ -181,7 +183,7 @@ program MAIN UseCLASSES = .false. end if - case ('Pre-enlist') ! get priority group + case ('Preenlist') ! get priority group idxGrp = -1 if (numArgs>4) then call getarg(5, dataSource) @@ -199,7 +201,7 @@ program MAIN if (maxAlternates<0) maxAlternates = 0 end if - case ('Classes') + case ('Schedules') termBegin = currentTerm termEnd = termBegin+2 if (numArgs>4) then @@ -216,8 +218,9 @@ program MAIN call lower_case(dataSource) noWrites = trim(dataSource)=='training' end if + isActionAdvising = .true. - case ('Enlistment') + case ('Classlists') nextYear = currentYear nextTerm = currentTerm termBegin = currentTerm @@ -227,6 +230,7 @@ program MAIN call lower_case(dataSource) noWrites = trim(dataSource)=='training' end if + isActionClasslists = .true. case default call usage('Error: ACTION "'//trim(ACTION)//'" is not recognized.') @@ -236,29 +240,29 @@ program MAIN ! count REGD grade as passing? advisingPeriod = currentTerm/=nextTerm - write(*,AFORMAT) & - 'Executable is : '//trim(fileExecutable)//SPACE//'('//VERSION//')', & - 'Arguments are : '//trim(UniversityCode)//SPACE//itoa(currentYear)//SPACE// & - txtSemester(currentTerm)//SPACE//trim(ACTION) - ! set up directories call make_heeds_directories() ! open the I/O log file - open(unit=unitLOG, file=trim(dirLOG)//trim(fileExecutable)//'.log', status='unknown') + open(unit=unitLOG, file=trim(dirBACKUP)//trim(fileExecutable)//'.log', status='unknown') call file_log_message( '-------', 'Begins '//currentDate//DASH//currentTime, '-------', & 'Executable is : '//trim(fileExecutable)//SPACE//DASH//SPACE//'( '//PROGNAME//VERSION//')', & 'Arguments are : '//trim(UniversityCode)//SPACE//itoa(currentYear)//SPACE// & txtSemester(currentTerm)//SPACE//trim(ACTION) ) ! open log for requests only - open(unit=unitREQ, file=trim(dirLOG)//'requests.log', status='unknown') + open(unit=unitREQ, file=trim(dirBACKUP)//'requests.log', status='unknown') + write(unitREQ,AFORMAT) '#-------', '#Begins '//currentDate//DASH//currentTime, '#-------', & + '#Executable is : '//trim(fileExecutable)//SPACE//DASH//SPACE//'( '//PROGNAME//VERSION//')', & + '#Arguments are : '//trim(UniversityCode)//SPACE//itoa(currentYear)//SPACE// & + txtSemester(currentTerm)//SPACE//trim(ACTION) + close(unitREQ) ! open a 'scratch' HTML response file #if defined PRODUCTION open(unit=unitHTML, form='formatted', status='scratch') #else - open(unit=unitHTML, file=trim(dirLOG)//'scratch.html', form='formatted', status='unknown') + open(unit=unitHTML, file=trim(dirBACKUP)//'scratch.html', form='formatted', status='unknown') #endif ! initialize data on classes @@ -301,22 +305,22 @@ program MAIN ! read the university-level data call read_university(pathToYear, errNo) if (errNo/=0) call terminate('Error in reading university info') - call xml_write_university(pathToYear, dirBAK) + call xml_write_university(pathToYear, dirBACKUP) ! read the colleges call read_colleges(pathToYear, errNo) if (errNo/=0) call terminate('Error in reading the list of colleges') - call xml_write_colleges(pathToYear, dirBAK) + call xml_write_colleges(pathToYear, dirBACKUP) ! read the departments call read_departments(pathToYear, errNo) if (errNo/=0) call terminate('Error in reading the list of departments') - call xml_write_departments(pathToYear, dirBAK) + call xml_write_departments(pathToYear, dirBACKUP) ! read the subjects call read_subjects(pathToYear, errNo) if (errNo/=0) call terminate('Error in reading the list of subjects') - call xml_write_subjects(pathToYear, dirBAK) + call xml_write_subjects(pathToYear, dirBACKUP) ! string representation of percentage grade, float value, reference do iTmp=1,100 @@ -327,7 +331,7 @@ program MAIN ! generate checklists only? if (trim(ACTION)=='Checklists') then - ! extract grades from FINALGRADE(.CSV) in dirRAW + ! extract grades from FINALGRADE(.CSV) in dirDATA call extract_student_grades() ! create student directories call make_student_directories() @@ -341,8 +345,8 @@ program MAIN ! read the curricular programs call read_curricula(pathToYear, errNo) if (errNo/=0) call terminate('Error in reading the list of curricular programs') - call xml_write_curricula(pathToYear, dirBAK) - call xml_write_equivalencies(pathToYear, dirBAK) + call xml_write_curricula(pathToYear, dirBACKUP) + call xml_write_equivalencies(pathToYear, dirBACKUP) #if defined UPLB ! no need to reset term offered of a subject @@ -375,7 +379,7 @@ program MAIN call xml_write_teachers(pathToYear) call write_password_file(pathToYear) end if - call xml_write_teachers(pathToYear, dirBAK) + call xml_write_teachers(pathToYear, dirBACKUP) ! reset passwords only? if (trim(ACTION)=='Resetpasswords') then @@ -387,7 +391,7 @@ program MAIN ! read the rooms call read_rooms(pathToYear, errNo) - call xml_write_rooms(pathToYear, dirBAK) + call xml_write_rooms(pathToYear, dirBACKUP) ! mark colleges with subject or curriculum information do targetDepartment=1,NumDepartments @@ -396,7 +400,7 @@ program MAIN end do ! preparing the schedule of classes ? - if (trim(ACTION)=='Classes') then + if (trim(ACTION)=='Schedules') then ! read schedules do kTmp=termBegin,termEnd @@ -409,8 +413,8 @@ program MAIN call read_blocks(pathToTerm, NumBlocks(jTmp), Block(jTmp,0:), NumSections(jTmp), Section(jTmp,0:), errNo) ! get no. of sections by dept call count_sections_by_dept(jTmp, NumSections(jTmp), Section(jTmp,0:)) - call xml_write_sections(pathToTerm, NumSections(jTmp), Section(jTmp,0:), 0, dirBAK) - call xml_write_blocks(pathToTerm, NumBlocks(jTmp), Block(jTmp,0:), Section(jTmp,0:), 0, dirBAK) + call xml_write_sections(pathToTerm, NumSections(jTmp), Section(jTmp,0:), 0, dirBACKUP) + call xml_write_blocks(pathToTerm, NumBlocks(jTmp), Block(jTmp,0:), Section(jTmp,0:), 0, dirBACKUP) end do ! start server-mode @@ -422,24 +426,11 @@ program MAIN ! read the list of students call read_students(pathToYear, errNo) if (errNo/=0) call terminate('Error in reading the list of students') - call xml_write_students(pathToYear, 0, dirBAK) + call xml_write_students(pathToYear, 0, dirBACKUP) ! create student directories call make_student_directories() -! ! randomize grades? -! if (trim(ACTION)=='Randomize') then -! write(*,*) 'Randomizing grades... please wait...' -! do iTmp = 1,NumStudents -! if (mod(iTmp,1000) == 0) then -! write(*,*) trim(itoa(iTmp))//' / '//itoa(NumStudents)//' done...' -! end if -! jTmp = StdRank(iTmp) -! call remake_student_records (jTmp) -! end do -! call terminate(trim(fileExecutable)//' completed '//ACTION) -! end if - ! predict for nextTerm? if (trim(ACTION)=='Predict') then @@ -451,6 +442,9 @@ program MAIN call read_blocks(pathToTerm, NumBlocks(nextTerm), Block(nextTerm,0:), & NumSections(nextTerm), Section(nextTerm,0:), errNo) + ! get no. of sections by dept + call count_sections_by_dept(nextTerm, NumSections(nextTerm), Section(nextTerm,0:)) + ! read waivers for next term call read_waivers(pathToTerm, NumSections(nextTerm), Section(nextTerm,0:), & Offering(nextTerm,MAX_ALL_DUMMY_SUBJECTS:), NumWaiverRecords, errNo) @@ -462,7 +456,7 @@ program MAIN call xml_write_pre_enlistment(pathToTerm, 'PREDICTIONS', Advised, Section(nextTerm,0:)) ! invalidate pre-enlistment by moving ENLISTMENT files to backup - dataSource = trim(dirXML)//trim(pathToTerm)//'ENLISTMENT' + dataSource = trim(dirDATA)//trim(pathToTerm)//'ENLISTMENT' call move_to_backup(trim(dataSource)//'.XML') ! the monolithic enlistment file @@ -485,6 +479,9 @@ program MAIN call read_blocks(pathToTerm, NumBlocks(nextTerm), Block(nextTerm,0:), & NumSections(nextTerm), Section(nextTerm,0:), errNo) + ! get no. of sections by dept + call count_sections_by_dept(nextTerm, NumSections(nextTerm), Section(nextTerm,0:)) + ! read waivers for next term call read_waivers(pathToTerm, NumSections(nextTerm), Section(nextTerm,0:), & Offering(nextTerm,MAX_ALL_DUMMY_SUBJECTS:), NumWaiverRecords, errNo) @@ -501,10 +498,10 @@ program MAIN end if call file_log_message('# incoming freshmen next term ='//trim(itoa(sum(NFintake)))//'?') - call xml_write_sections(pathToTerm, NumSections(nextTerm), Section(nextTerm,0:), 0, dirBAK) - call xml_write_blocks(pathToTerm, NumBlocks(nextTerm), Block(nextTerm,0:), Section(nextTerm,0:), 0, dirBAK) - call xml_write_waivers(pathToTerm, Section(nextTerm,0:), dirBAK) - call xml_write_pre_enlistment(pathToTerm, 'PREDICTIONS', Advised, Section(nextTerm,0:), 0, dirBAK) + call xml_write_sections(pathToTerm, NumSections(nextTerm), Section(nextTerm,0:), 0, dirBACKUP) + call xml_write_blocks(pathToTerm, NumBlocks(nextTerm), Block(nextTerm,0:), Section(nextTerm,0:), 0, dirBACKUP) + call xml_write_waivers(pathToTerm, Section(nextTerm,0:), dirBACKUP) + call xml_write_pre_enlistment(pathToTerm, 'PREDICTIONS', Advised, Section(nextTerm,0:), 0, dirBACKUP) ! start server-mode call server_start() @@ -512,15 +509,16 @@ program MAIN end if ! ! pre-enlist students? -! if (trim(ACTION)=='Pre-enlist') then +! if (trim(ACTION)=='Preenlist') then ! call generate_initial_schedules(idxGrp, maxAlternates) ! call terminate(trim(fileExecutable)//' completed '//ACTION) ! end if - if (trim(ACTION)=='Enlistment') then + if (trim(ACTION)=='Classlists') then - ! read classes for current term pathToTerm = trim(pathToYear)//trim(txtSemester(currentTerm))//DIRSEP + + ! read classes for current term call read_classes(pathToTerm, NumSections(currentTerm), Section(currentTerm,0:), & Offering(currentTerm,MAX_ALL_DUMMY_SUBJECTS:), errNo) @@ -528,13 +526,26 @@ program MAIN call read_blocks(pathToTerm, NumBlocks(currentTerm), Block(currentTerm,0:), & NumSections(currentTerm), Section(currentTerm,0:), errNo) + ! get no. of sections by dept + call count_sections_by_dept(currentTerm, NumSections(currentTerm), Section(currentTerm,0:)) + + ! add subjects, sections, students from ENLISTMENT + inquire(file=trim(dirDATA)//trim(pathToTerm)//'ENLISTMENT.XML', exist=pathExists) + if (.not. pathExists) then + call add_data_from_enlistment(pathToTerm, 'ENLISTMENT', NumSections(currentTerm), Section(currentTerm,0:)) + call offerings_sort(NumSections(currentTerm), Section(currentTerm,0:)) + call offerings_summarize(NumSections(currentTerm), Section(currentTerm,0:), & + Offering(currentTerm,MAX_ALL_DUMMY_SUBJECTS:), 0) + call sort_alphabetical_students() + end if + ! read enlistment files (if any) for currentTerm call read_pre_enlistment(pathToTerm, 'ENLISTMENT', 0, 6, & NumSections(currentTerm), Section(currentTerm,0:), Preenlisted, NumEnlistmentRecords, errNo) - call xml_write_sections(pathToTerm, NumSections(currentTerm), Section(currentTerm,0:), 0, dirBAK) - call xml_write_blocks(pathToTerm, NumBlocks(currentTerm), Block(currentTerm,0:), Section(currentTerm,0:), 0, dirBAK) - call xml_write_pre_enlistment(pathToTerm, 'ENLISTMENT', Advised, Section(currentTerm,0:), 0, dirBAK) + call xml_write_sections(pathToTerm, NumSections(currentTerm), Section(currentTerm,0:), 0, dirBACKUP) + call xml_write_blocks(pathToTerm, NumBlocks(currentTerm), Block(currentTerm,0:), Section(currentTerm,0:), 0, dirBACKUP) + call xml_write_pre_enlistment(pathToTerm, 'ENLISTMENT', Preenlisted, Section(currentTerm,0:), 0, dirBACKUP) call recalculate_available_seats(Section(currentTerm,0:)) @@ -557,7 +568,7 @@ subroutine usage(mesg) character(len=*), intent(in), optional :: mesg - write(*,AFORMAT) trim(fileExecutable)//' is version'//VERSION//' of '//PROGNAME + write(*,AFORMAT) trim(fileExecutable)//' ('//PROGNAME//VERSION//')' if (present(mesg)) write(*,AFORMAT) trim(mesg) write(*,AFORMAT) SPACE, & 'Non-interactive usage: '//trim(fileExecutable)//' UNIV YEAR TERM ACTION', & @@ -565,10 +576,10 @@ subroutine usage(mesg) ' YEAR - chronological year when the current School Year started', & ' TERM - current term: 1=1st Sem, 2=2nd Sem, S=summer', & ' ACTION - ', & - ' resetpasswords - reset passwords to usernames, based on TEACHERS.XML for current term', & - ' checklists - create enrollment records of students from raw grades', & - ' predict [use_classes] - predict subject demand for next term [use CLASSES.XML for subjects offered]', & - ' pre-enlist group maxalt - pre-enlist group, use max no. of alternate subjects, for next term', & + ' Resetpasswords - reset passwords to usernames, based on TEACHERS.XML for current term', & + ' Checklists - create enrollment records of students from raw grades', & + ' Predict [use_classes] - predict subject demand for next term [use CLASSES.XML for subjects offered]', & + ' Preenlist group maxalt - pre-enlist group, use max no. of alternate subjects, for next term', & SPACE #if defined GLNX write(*,AFORMAT) & @@ -581,104 +592,85 @@ subroutine usage(mesg) ' IP_ADDRESS, PORT_NUM - as specified by fastcgi_pass in nginx configuration', & ' UNIV, YEAR, TERM - same as above', & ' ACTION - ', & - ' classes - edit the schedule of classes, for the current and next two terms', & - ' advising - advise students, on their subjects next term', & - ' enlistment - finalize enlistment of students into classes, for the current term', SPACE + ' Classlists - edit classlists and enter grades for the current term', & + ' Advising - advise students, on their subjects next term', & + ' Schedules - edit the schedule of classes, for the next three terms', & + SPACE + stop + end subroutine usage subroutine make_heeds_directories() - ! directory for raw input data - dirRAW = trim(dirHEEDS)//'raw'//DIRSEP - - ! directory for the School Year + ! directory for start of School Year pathToYear = trim(itoa(currentYear))//DIRSEP - ! temporarily set pathToNextYear to absolute next year; reset before exit - pathToNextYear = trim(itoa(currentYear+1))//DIRSEP + ! directory for year of next term + pathToNextYear = trim(itoa(nextYear))//DIRSEP - ! directory for log files -#if defined PRODUCTION - dirLOG = trim(dirHEEDS)//'log'//DIRSEP//trim(startDateTime)//DIRSEP -#else - dirLOG = trim(dirHEEDS)//'log'//DIRSEP//'debug'//DIRSEP -#endif - call make_clean_directory( dirLOG, .true. ) + ! absolute next year + dataSource = trim(itoa(currentYear+1))//DIRSEP - ! directory for XML data - dirXML = trim(dirHEEDS)//'xml'//DIRSEP - call make_clean_directory( dirXML ) - lenDirXML = len_trim(dirXML) + ! data directory + dirDATA = trim(dirHEEDS)//'data'//DIRSEP + call make_directory( dirDATA ) + lenDirDAT = len_trim(dirDATA) - call make_clean_directory( trim(dirXML)//pathToYear ) - call make_clean_directory( trim(dirXML)//pathToNextYear ) + call make_directory( trim(dirDATA)//pathToYear ) + call make_directory( trim(dirDATA)//dataSource ) do iTmp=1,3 - call make_clean_directory( trim(dirXML)//trim(pathToYear)//trim(txtSemester(iTmp))//DIRSEP ) - call make_clean_directory( trim(dirXML)//trim(pathToNextYear)//trim(txtSemester(iTmp))//DIRSEP ) -! call make_clean_directory( trim(dirXML)//UPDATES//trim(pathToYear)//trim(txtSemester(iTmp))//DIRSEP ) -! call make_clean_directory( trim(dirXML)//UPDATES//trim(pathToNextYear)//trim(txtSemester(iTmp))//DIRSEP ) + call make_directory( trim(dirDATA)//trim(pathToYear)//trim(txtSemester(iTmp))//DIRSEP ) + call make_directory( trim(dirDATA)//trim(dataSource)//trim(txtSemester(iTmp))//DIRSEP ) end do - ! directory for backups + ! backup directory #if defined PRODUCTION - dirBAK = trim(dirHEEDS)//'bak'//DIRSEP//trim(startDateTime)//DIRSEP + dirBACKUP = trim(dirHEEDS)//'backup-'//trim(startDateTime)//DASH//trim(ACTION)//DIRSEP #else - dirBAK = trim(dirHEEDS)//'bak'//DIRSEP//'debug'//DIRSEP + dirBACKUP = trim(dirHEEDS)//'debug-'//trim(ACTION)//DIRSEP #endif - call make_clean_directory( dirBAK ) - call make_clean_directory( trim(dirBAK)//pathToYear ) - call make_clean_directory( trim(dirBAK)//pathToNextYear ) + call make_directory( dirBACKUP, .true. ) + call make_directory( trim(dirBACKUP)//pathToYear ) + call make_directory( trim(dirBACKUP)//dataSource ) do iTmp=1,3 - call make_clean_directory( trim(dirBAK)//trim(pathToYear)//trim(txtSemester(iTmp))//DIRSEP, .true.) - call make_clean_directory( trim(dirBAK)//trim(pathToNextYear)//trim(txtSemester(iTmp))//DIRSEP, .true.) -! call make_clean_directory( trim(dirBAK)//UPDATES//trim(pathToYear)//trim(txtSemester(iTmp))//DIRSEP, .true.) -! call make_clean_directory( trim(dirBAK)//UPDATES//trim(pathToNextYear)//trim(txtSemester(iTmp))//DIRSEP, .true.) + call make_directory( trim(dirBACKUP)//trim(pathToYear)//trim(txtSemester(iTmp))//DIRSEP, .true.) + call make_directory( trim(dirBACKUP)//trim(dataSource)//trim(txtSemester(iTmp))//DIRSEP, .true.) end do - ! reset pathToNextYear - pathToNextYear = trim(itoa(nextYear))//DIRSEP - - return end subroutine make_heeds_directories subroutine make_student_directories() ! create student directories - dirSUBSTITUTIONS = trim(dirXML)//'substitutions'//DIRSEP ! directory for input/UNEDITED checklists from Registrar - dirTRANSCRIPTS = trim(dirXML)//'transcripts'//DIRSEP ! directory for raw transcripts - dirEditedCHECKLISTS = trim(dirXML)//'edited-checklists'//DIRSEP ! for output/EDITED checklists from College Secretaries + dirSUBSTITUTIONS = trim(dirDATA)//'substitutions'//DIRSEP ! directory for input/UNEDITED checklists from Registrar + dirTRANSCRIPTS = trim(dirDATA)//'transcripts'//DIRSEP ! directory for raw transcripts - call make_clean_directory( dirTRANSCRIPTS ) - call make_clean_directory( dirSUBSTITUTIONS ) - call make_clean_directory( dirEditedCHECKLISTS ) + call make_directory( dirTRANSCRIPTS ) + call make_directory( dirSUBSTITUTIONS ) - call make_clean_directory( trim(dirBAK)//'transcripts' ) - call make_clean_directory( trim(dirBAK)//'substitutions' ) - call make_clean_directory( trim(dirBAK)//'edited-checklists' ) + call make_directory( trim(dirBACKUP)//'transcripts' ) + call make_directory( trim(dirBACKUP)//'substitutions' ) call collect_prefix_years() itmp = 1 do jtmp=2,len_trim(StdNoPrefix) if (StdNoPrefix(jtmp:jtmp)/=':') cycle - call make_clean_directory( trim(dirXML)//'transcripts'//DIRSEP//StdNoPrefix(itmp+1:jtmp-1) ) - call make_clean_directory( trim(dirXML)//'substitutions'//DIRSEP//StdNoPrefix(itmp+1:jtmp-1) ) - call make_clean_directory( trim(dirXML)//'edited-checklists'//DIRSEP//StdNoPrefix(itmp+1:jtmp-1) ) + call make_directory( trim(dirDATA)//'transcripts'//DIRSEP//StdNoPrefix(itmp+1:jtmp-1) ) + call make_directory( trim(dirDATA)//'substitutions'//DIRSEP//StdNoPrefix(itmp+1:jtmp-1) ) - call make_clean_directory( trim(dirBAK)//'transcripts'//DIRSEP//StdNoPrefix(itmp+1:jtmp-1) ) - call make_clean_directory( trim(dirBAK)//'substitutions'//DIRSEP//StdNoPrefix(itmp+1:jtmp-1) ) - call make_clean_directory( trim(dirBAK)//'edited-checklists'//DIRSEP//StdNoPrefix(itmp+1:jtmp-1) ) + call make_directory( trim(dirBACKUP)//'transcripts'//DIRSEP//StdNoPrefix(itmp+1:jtmp-1) ) + call make_directory( trim(dirBACKUP)//'substitutions'//DIRSEP//StdNoPrefix(itmp+1:jtmp-1) ) itmp = jtmp end do - return end subroutine make_student_directories - subroutine make_clean_directory(dirName, clean) + subroutine make_directory(dirName, clean) character(len=*), intent (in) :: dirName logical, intent (in), optional :: clean logical :: pathExists @@ -691,17 +683,784 @@ subroutine make_clean_directory(dirName, clean) call system(delCmd//trim(dirName)//'*', ierr) end if - return - end subroutine make_clean_directory + end subroutine make_directory + + + subroutine server_start() + + integer :: iTmp, kStart + character(len=MAX_LEN_TEACHER_CODE) :: tTeacher + character(len=MAX_LEN_FILE_PATH) :: logTeacher + logical :: logExists + real :: harvest ! random number + + ! initialize QUERY_STRING encryption key + do iTmp=1,MAX_LEN_QUERY_STRING + call random_number(harvest) + kStart = 1 + int(255*harvest) + queryEncryptionKey(iTmp:iTmp) = achar(kStart) + end do + + ! make "Stop!" page + call hostnm(QUERY_put, iTmp) + if (iTmp/=0) QUERY_put = 'localhost' +#if defined GLNX +#else + QUERY_put = trim(QUERY_put)//':82' +#endif + CGI_PATH = 'http://'//trim(QUERY_put)//FSLASH//ACTION + call html_login('Stop-'//trim(UniversityCode)//DASH//trim(ACTION)//'.html', & + trim(make_href(fnStop, 'Stop', post=nbsp//ACTION) ) ) + + ! reset CGI_PATH + CGI_PATH = FSLASH//ACTION + + ! notes + call file_log_message(trim(fileExecutable)//' started '//ACTION) + if (noWrites) then ! training mode + call file_log_message(trim(fileExecutable)//' is in training mode. '// & + 'Any made changes will be lost after the program exits.') + end if + + ! loop until killed/fnSTOP + do while (FCGI_Accept() >= 0) + + ! timestamp of request + call date_and_time (date=currentDate, time=currentTime) + + ! tell the webserver to expect text/html + iTmp = FCGI_puts ('Content-type: text/html'//CRLF//NUL) + + ! rewind the response file + rewind (unitHTML) + + ! Retrieve DOCUMENT_URI and QUERY_STRING/CONTENT + call FCGI_getquery(unitHTML) + +#if defined PRODUCTION + ! encrypted query ? + call cgi_get_named_string(QUERY_STRING, 'q', cipher, iTmp) + if (iTmp==0) then + iTmp = len_trim(cipher) + kStart = atoi( cipher(iTmp-3:iTmp) ) + if (kStart>MAX_LEN_QUERY_STRING/2 .and. kStart4) then ! no passwords + write(unitUSER,AFORMAT) trim(cipher) + write(unitREQ, AFORMAT) trim(cipher) + end if + + call html_comment(fnDescription(REQUEST)) + + ! compose response + call server_respond(unitHTML) + + ! send response to server + call FCGI_putfile(unitHTML) + + ! close user log file + close(unitREQ) + close(unitUSER) + + ! stop? + if (REQUEST==fnStop) exit + + end do ! while (FCGI_Accept() >= 0) + + ! remove "Stop" link + call unlink('Stop-'//trim(UniversityCode)//DASH//trim(ACTION)//'.html') + + ! terminate + call terminate(trim(fileExecutable)//' completed '//ACTION) + + end subroutine server_start + + + subroutine server_respond (device) + integer, intent (in) :: device + + integer :: tYear, tTerm + + call html_comment('server_respond()') + + ! target directory if files are to be modified + if (targetTerm>0) then + if (targetTermThe '//trim(UniversityCode)//SPACE//trim(REGISTRAR)//' has temporarily suspended '// & + PROGNAME//FSLASH//trim(Action)//'. Please try again later.
    ') + + case (fnStop) + if (isDirtySTUDENTS) then + call xml_write_students(pathToYear, 0) + end if + if (isDirtyPreenlisted) then + pathToTerm = trim(pathToYear)//trim(txtSemester(currentTerm))//DIRSEP + call xml_write_pre_enlistment(pathToTerm, 'ENLISTMENT', Preenlisted, Section(currentTerm,0:)) + endif + + call html_landing_page(device, 'The program will stop.') + + case (fnLogin) + Teacher(targetLogin)%Status = 1 + call html_college_links(device, CollegeIdxUser, mesg=loginCheckMessage) + + case (fnChangePassword) + Teacher(targetLogin)%Status = 1 + call change_current_password(device) + + case (fnGeneratePassword) + call generate_password(device) + + case (fnLogout) + Teacher(targetLogin)%Status = 0 + call html_landing_page(device, SPACE) + + case (fnSuspendProgram) + if (isRoleAdmin) then + if (isDirtySTUDENTS) then + call xml_write_students(pathToYear, 0) + end if + isSuspended = .not. isSuspended + call html_college_links(device, CollegeIdxUser, mesg='Toggled "Suspend" mode') + else + REQUEST = fnLogout + Teacher(targetLogin)%Status = 0 + call html_landing_page(device, SPACE) + end if + + case (fnToggleTrainingMode) + noWrites = .not. noWrites + call html_college_links(device, CollegeIdxUser, mesg='Toggled "Training" mode') + + case (fnEditSignatories) + call edit_signatories(device) + + case (fnDownloadXML) + call download_xml(device) + + ! college info + case (fnCollegeLinks) + call html_college_links(device) + + + ! subject info + case (fnSubjectList) + call subject_list_all (device) + + case (fnEditSubject) + call subject_edit (device) + + + ! curriculum info + case (fnCurriculumList, fnActivateCurriculum, fnDeactivateCurriculum) + call curriculum_list_all(device, REQUEST) + + case (fnCurriculum) + call curriculum_display(device) + + case (fnEditCurriculum) + call curriculum_edit (device) + + + ! room info + case (fnRoomList) + call room_list_all (device) + + case (fnEditRoom) + call room_edit (device) + + + ! teacher info + case (fnTeachersByDept, fnTeachersByName) + call teacher_list_all (device, REQUEST) + + case (fnEditTeacher) + call teacher_edit (device) + + + ! blocks + case (fnBlockList) + call block_list_all(device, NumBlocks(targetTerm), Block(targetTerm,0:)) + + case (fnBlockSchedule, fnBlockDeleteName, fnBlockEditName, fnBlockCopy, fnBlockDeleteAll, & + fnBlockEditSection, fnBlockEditSubject) + call block_show_schedule(device, NumSections(targetTerm), Section(targetTerm,0:), & + Offering(targetTerm,MAX_ALL_DUMMY_SUBJECTS:), & + NumBlocks(targetTerm), Block(targetTerm,0:), REQUEST) + + case (fnBlockNewSelect) + call block_select_curriculum_year(device, NumSections(targetTerm), Section(targetTerm,0:), & + NumBlocks(targetTerm), Block(targetTerm,0:) ) + + case (fnBlockNewAdd) + call block_add(device, targetTerm, NumSections(targetTerm), Section(targetTerm,0:), & + Offering(targetTerm,MAX_ALL_DUMMY_SUBJECTS:), NumBlocks(targetTerm), Block(targetTerm,0:) ) + + + ! schedule of classes + case (fnScheduleOfClasses, fnScheduleByArea, fnTBARooms, fnTBATeachers, fnTeacherClasses) + call section_list_all (device, NumSections(targetTerm), Section(targetTerm,0:), & + Offering(targetTerm,MAX_ALL_DUMMY_SUBJECTS:), & + NumBlocks(targetTerm), Block(targetTerm,0:), REQUEST) + + case (fnScheduleOfferSubject) + call section_offer_subject (device, NumSections(targetTerm), Section(targetTerm,0:), & + Offering(targetTerm,MAX_ALL_DUMMY_SUBJECTS:), & + NumBlocks(targetTerm), Block(targetTerm,0:) ) + + case (fnScheduleDelete) + call section_delete(device, NumSections(targetTerm), Section(targetTerm,0:), & + Offering(targetTerm,MAX_ALL_DUMMY_SUBJECTS:), & + NumBlocks(targetTerm), Block(targetTerm,0:) ) + + case (fnScheduleAddLab) + call section_add_laboratory(device, NumSections(targetTerm), Section(targetTerm,0:), & + Offering(targetTerm,MAX_ALL_DUMMY_SUBJECTS:), & + NumBlocks(targetTerm), Block(targetTerm,0:) ) + + case (fnScheduleEdit) + call section_edit(device, NumSections(targetTerm), Section(targetTerm,0:), & + NumBlocks(targetTerm), Block(targetTerm,0:) ) + + case (fnScheduleValidate) + call section_validate_inputs (device, NumSections(targetTerm), Section(targetTerm,0:), & + Offering(targetTerm,MAX_ALL_DUMMY_SUBJECTS:), & + NumBlocks(targetTerm), Block(targetTerm,0:) ) + + ! schedule conflicts + case (fnRoomConflicts) + call room_conflicts (device, NumSections(targetTerm), Section(targetTerm,0:)) + + case (fnRoomSchedule) + call room_schedule(device, NumSections(targetTerm), Section(targetTerm,0:) ) + + case (fnTeacherConflicts) + call teacher_conflicts (device, NumSections(targetTerm), Section(targetTerm,0:)) + + case (fnTeacherEditSchedule) + call teacher_schedule(device, NumSections(targetTerm), Section(targetTerm,0:) ) + + case (fnPrintableWorkload) + call teacher_schedule_printable(device, NumSections(targetTerm), Section(targetTerm,0:), & + NumBlocks(targetTerm), Block(targetTerm,0:) ) + +! ! students +! case (fnStudentAddPrompt) +! call student_prompt_add(device) +! +! case (fnStudentAdd) +! call student_add(device) + + case (fnStudentsDistribution) + call student_distribution(device) + + case (fnStudentsByCurriculum,fnStudentsByname,fnStudentsByYear,fnStudentsByProgram) + call links_to_students(device, REQUEST) + + case (fnStudentPerformance) + call student_performance(device) + + case (fnEditCheckList) + call checklist_edit(device, .not. advisingPeriod, & + Section(nextTerm,0:), Offering(nextTerm,MAX_ALL_DUMMY_SUBJECTS:), & + trim(pathToNextYear)//trim(txtSemester(nextTerm))//DIRSEP) + + ! cases for next semester's predicted demand for subjects + case (fnDemandFreshmen,fnUpdateDemandFreshmen) + call demand_by_new_freshmen(device, Offering(nextTerm,MAX_ALL_DUMMY_SUBJECTS:)) + + case (fnDemandForSubjects) + call demand_for_subjects(device, NumSections(nextTerm), Section(nextTerm,0:), & + Offering(nextTerm,MAX_ALL_DUMMY_SUBJECTS:)) + + case (fnPotentialStudents) + call list_potential_students(device) + + + ! cases for current semester enlistment + case (fnEnlistmentSummary, fnBottleneck, fnExtraSlots, fnUnderloadSummary, fnUnderloadedStudents) + call enlistment_summarize(device, NumSections(currentTerm), Section(currentTerm,0:), & + Offering(currentTerm,MAX_ALL_DUMMY_SUBJECTS:), Preenlisted, REQUEST) + + case (fnNotAccommodated) + call enlistment_not_accommodated(device, Preenlisted) + + case (fnGradeSheet) + call enlistment_grades(device, NumSections(currentTerm), Section(currentTerm,0:)) + + case (fnClassList) + call class_list(device, NumSections(currentTerm), Section(currentTerm,0:)) + + case (fnChangeMatriculation) + call enlistment_edit(device, NumSections(currentTerm), Section(currentTerm,0:), & + NumBlocks(currentTerm), Block(currentTerm,0:) ) + + case (fnFindBlock) + call enlistment_find_block(device, NumSections(currentTerm), Section(currentTerm,0:), & + NumBlocks(currentTerm), Block(currentTerm,0:) ) + + case (fnPrintableSchedule) + call enlistment_printable(device, NumSections(currentTerm), Section(currentTerm,0:)) + + case default + targetCollege = CollegeIdxUser + targetDepartment = DeptIdxUser + termDescription = SPACE + call html_write_header(device, SPACE, & + '
    The functionality "'//trim(fnDescription(REQUEST))// & + '" is not activated in '//PROGNAME//VERSION) + + end select + + call html_write_footer(device) + + end subroutine server_respond + + + subroutine terminate(msg) + + character(len=*), intent (in) :: msg + + call file_log_message(msg, 'Ends '//currentDate//DASH//currentTime ) + + close(unitHTML) + close(unitLOG) + + stop + end subroutine terminate + + + subroutine student_prompt_add(device) + integer, intent (in) :: device + integer :: ldx + + call html_write_header(device, 'Add a student') + call make_form_start(device, fnStudentAdd) + write(device,AFORMAT) & + '', & + begintr//begintd//'Student Number:'//endtd//begintd// & ! student number + ''//endtd//endtr, & ! name + begintr//begintd//'Lastname Firstname MI:'//endtd//begintd// & + ''//endtd//endtr, & ! gender + begintr//begintd//'Gender:'//endtd//begintd//''//endtd//endtr, & ! country index + begintr//begintd//'Country:'//endtd//begintd//''//endtd//endtr, & ! curriculum + begintr//begintd//'Curriculum:'//endtd//begintd//''//endtd//endtr + ! classification + write(device,AFORMAT) & + begintr//begintd//'Year level:'//endtd//begintd//''//endtd//endtr + ! Add button + write(device,AFORMAT) & + '

    ', & + '
    ' + + end subroutine student_prompt_add + + + subroutine student_add(device) + integer, intent (in) :: device + + character(len=MAX_LEN_STUDENT_CODE) :: tStdNo + character (len=MAX_LEN_TEXT_YEAR) :: tYear + character(len=MAX_LEN_CURRICULUM_CODE) :: tCurriculum + type (TYPE_STUDENT) :: wrk + integer :: ierr + + ! student exists? + call cgi_get_named_string(QUERY_STRING, 'StdNo', tStdNo, ierr) + targetStudent = index_to_student(tStdNo) + + if (ierr/=0 .or. tStdNo==SPACE) then + call html_college_links(device, CollegeIdxUser, 'Add student: student number not specified?') + return + else if (targetStudent/=0) then + call html_college_links(device, CollegeIdxUser, 'Add student: student "'//tStdNo//'" already on record.') + return + end if + wrk%StdNo = tStdNo + + call cgi_get_named_string(QUERY_STRING, 'Name', wrk%Name, ierr) + call cgi_get_named_string(QUERY_STRING, 'Gender', wrk%Gender, ierr) + + call cgi_get_named_string(QUERY_STRING, 'CurriculumIdx', tCurriculum, ierr) + wrk%CurriculumIdx = index_to_curriculum(tCurriculum) + call cgi_get_named_string(QUERY_STRING, 'Classification', tYear, ierr) + wrk%Classification = index_to_year(tYear) + call cgi_get_named_integer(QUERY_STRING, 'CountryIdx', wrk%CountryIdx, ierr) + + targetStudent = NumStudents + do while (tStdNo0) then + ROLE = Teacher(targetLogin)%Role + else ! not in Teachers(); assume Guest + USERNAME = GUEST + ROLE = GUEST + end if + + if (trim(ROLE)==GUEST) then ! Guest + isRoleGuest = .true. + if (trim(USERNAME)/=GUEST) then + DeptIdxUser = Teacher(targetLogin)%DeptIdx + CollegeIdxUser = Department(DeptIdxUser)%CollegeIdx + end if + elseif (trim(ROLE)==REGISTRAR) then ! Administrator + isRoleAdmin = .true. + DeptIdxUser = NumDepartments + CollegeIdxUser = Department(DeptIdxUser)%CollegeIdx + else ! Chair or Adviser ? + tDepartment = ROLE + targetDepartment = index_to_dept(tDepartment) + if (targetDepartment/=0) then ! Chair + isRoleChair = .true. + DeptIdxUser = targetDepartment + CollegeIdxUser = Department(targetDepartment)%CollegeIdx + else + tCurriculum = ROLE + targetCurriculum = abs(index_to_curriculum(tCurriculum)) + if (targetCurriculum/=0) then ! adviser + isRoleSRE = .true. + ROLE = CurrProgCode(targetCurriculum) + CurriculumIdxUser = targetCurriculum + CollegeIdxUser = Curriculum(targetCurriculum)%CollegeIdx + DeptIdxUser = 0 + else + isRoleGuest = .true. + end if + end if + end if + + ! Establish REQUESTed function if any, else return the landing page + call cgi_get_named_integer(QUERY_STRING, 'F', REQUEST, ierr) + if (ierr==-1) then + REQUEST = fnLogout + return + end if + + ! Establish TERM if required + if (REQUEST>=fnScheduleOfClasses) then + call cgi_get_named_integer(QUERY_STRING, 'A9', targetTerm, ierr) + end if + + if (REQUEST/=fnLogin) then ! not logging in + ! previously logged out? force user to login + if (Teacher(targetLogin)%Status==0 .and. .not. isRoleGuest) REQUEST = fnLogout + return + end if + ! request is login; validate POSTed data + + ! Always allow Guest account + if (trim(USERNAME)==GUEST) then ! Guest + loginCheckMessage = & + ' You are logged in as Guest. Contact the '//REGISTRAR//' to obtain an account.' + return + end if + + ! password provided ? + call cgi_get_named_string(QUERY_STRING, 'P', tPassword, ierr) + if (ierr==-1) then ! no password + REQUEST = fnLogout + loginCheckMessage = 'Username and/or Password not valid.' + else ! password provided + if (is_password(targetLogin,tPassword) ) then ! password matched + loginCheckMessage = 'Successful login for '//USERNAME + else ! return login page + REQUEST = fnLogout + loginCheckMessage = 'Username and/or Password not valid.' + end if + end if + + end subroutine get_user_request + + + subroutine download_xml(device) + integer, intent(in) :: device + + character (len=MAX_LEN_FILE_PATH) :: XMLfile, fileName + character (len=MAX_LEN_XML_LINE) :: line + integer :: ierr, eof + logical :: fileExists + + call cgi_get_named_string(QUERY_STRING, 'A1', XMLfile, ierr) + + fileName = trim(dirDATA)//trim(pathToYear)//XMLfile + inquire(file=fileName, exist=fileExists) + if (.not. fileExists) then + fileName = trim(dirDATA)//trim(pathToTerm)//XMLfile + inquire(file=fileName, exist=fileExists) + end if + if (fileExists) then + write(device,AFORMAT) '', & + 'Save as '//trim(fileName), '' + open(unit=unitXML, file=fileName, form='formatted', status='old') + do + read(unitXML, AFORMAT, iostat=eof) line + if (eof<0) exit + write(device,AFORMAT) trim(line) + end do + close(unitXML) + else + targetCollege = CollegeIdxUser + targetDepartment = DeptIdxUser + termDescription = SPACE + call html_write_header(device, SPACE, '
    File not found "'//trim(fileName)) + REQUEST = 0 + end if + + end subroutine download_xml + + + subroutine execute_log() + + integer :: unitREPLAY=990, errNo, eof + character(len=MAX_LEN_TEACHER_CODE) :: tTeacher + character(len=MAX_LEN_FILE_PATH) :: logTeacher, fileName + logical :: logExists + + ! disallow xml_write_*() for now + !noWrites = .true. + + REMOTE_ADDR = SPACE + DOCUMENT_URI = SPACE + + ! reset CGI_PATH + CGI_PATH = FSLASH//trim(ACTION)//FSLASH//UniversityCode + + ! notes + call file_log_message(trim(fileExecutable)//' started '//ACTION//' execute_log()') + if (noWrites) then ! training mode + call file_log_message(trim(fileExecutable)//' is in training mode. '// & + 'Any made changes will be lost after the program exits.') + end if + + fileName = 'requests.log' + open(unit=unitREPLAY, file=fileName, form='formatted', status='old', iostat=errNo) + if (errNo/=0) return + + ! loop until EOF/fnSTOP + do + + read(unitREPLAY, AFORMAT, iostat=eof) QUERY_STRING + if (eof<0) exit + if (QUERY_STRING(1:1)=='#') cycle + + ! timestamp of request + call date_and_time (date=currentDate, time=currentTime) + + ! rewind the response file + rewind (unitHTML) + + ! make copy of QUERY_STRING + cipher = QUERY_STRING + + ! initialize index to target object of REQUEST + targetSubject = 0 + targetSection = 0 + targetDepartment = 0 + targetCurriculum = 0 + targetCollege = 0 + targetRoom = 0 + targetTeacher = 0 + targetBlock = 0 + targetTerm = 0 + targetLogin = 0 + targetStudent = 0 + + ! force everyone to be logged in + do eof=1,NumTeachers + Teacher(eof)%Status = 1 + end do + + ! Establish USERNAME/ROLE and REQUEST + loginCheckMessage = SPACE + call get_user_request() + + ! override targetTerm + if (isActionClasslists) then + targetTerm = currentTerm + elseif (isActionAdvising) then + targetTerm = nextTerm + end if + + + ! open user's log file, create if necessary + call blank_to_underscore(USERNAME, tTeacher) + logTeacher = trim(dirBACKUP)//trim(tTeacher)//'.log' + inquire(file=trim(logTeacher), exist=logExists) + if (.not. logExists) then + open(unit=unitUSER, file=trim(logTeacher), status='new') + else + open(unit=unitUSER, file=trim(logTeacher), status='old', position='append') + end if + + ! append query to user log file + write(unitUSER,AFORMAT) SPACE, & + REMOTE_ADDR//' : '//currentDate//DASH//currentTime//' : '// & + fnDescription(REQUEST) + if (REQUEST>4) then ! no passwords + write(unitUSER,AFORMAT) trim(cipher) + write(unitREQ, AFORMAT) trim(cipher) + end if + + call html_comment(fnDescription(REQUEST)) + + ! compose response + call server_respond(unitHTML) + +! ! send response to server +! call FCGI_putfile(unitHTML) + + ! close user log file + close(unitUSER) + + ! stop? + if (REQUEST==fnStop) exit + + end do + + close(unitREPLAY) + + ! terminate + call terminate(trim(fileExecutable)//' completed '//ACTION) + + end subroutine execute_log subroutine rename_university() character (len=MAX_LEN_SUBJECT_CODE) :: tSubject character (len=MAX_LEN_CURRICULUM_CODE) :: tCurriculum + character (len=MAX_LEN_FILE_PATH) :: dataSource !character(len=MAX_LEN_STUDENT_CODE) :: tStdNo real :: harvest - integer :: lTmp + integer :: iTmp, jTmp, kTmp, lTmp, errNo ! read schedules do kTmp=termBegin,termEnd @@ -901,9 +1660,144 @@ subroutine rename_university() call xml_write_teachers(pathToYear) call write_password_file(pathToYear) - return - end subroutine rename_university + subroutine add_data_from_enlistment(path, basename, NumSections, Section) + character(len=*), intent(in) :: path, basename + integer, intent (in out) :: NumSections + type (TYPE_SECTION), intent(in out) :: Section(0:) + + character (len=MAX_LEN_STUDENT_CODE) :: tStdNo + character (len=MAX_LEN_SUBJECT_CODE) :: tSubject + character (len=MAX_LEN_CLASS_ID) :: tSection + character(len=MAX_LEN_CURRICULUM_CODE) :: tCurriculum + integer :: cdx, k, sdx, std, ier, nSubj, nSect, nStd + type (TYPE_STUDENT) :: wrk + + character (len=MAX_LEN_FILE_PATH) :: fileName + character (len=MAX_LEN_XML_LINE) :: line + integer :: eof, ndels, pos(60) + + fileName = trim(dirDATA)//trim(path)//basename//'.CSV' + open(unit=unitRAW, file=fileName, form='formatted', status='old', iostat=ier) + if (ier/=0) return + + call file_log_message ('Retrieving additional info from '//fileName) + + nSubj = 0 + nSect =0 + nStd = 0 + + loop_ENLISTMENT : & + do + read (unitRAW, AFORMAT, iostat = eof) line + if (eof<0) exit loop_ENLISTMENT + if (line(1:1)=='#' .or. line(1:3)==' ') cycle loop_ENLISTMENT + + !#STUDNO,SUBJECT CODE,CLASS CODE,SutdName,Course,TERM,COLLEGE,TEACHER,SECTION + !1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 + !08-09517,EM 218,G007,"Abbariao, Cristopher Adolfo",MAED-SS,13-S,GS,To Be Assigned,GS + !08-09517,MA 204,G022,"Abbariao, Cristopher Adolfo",MAED-SS,13-S,GS,To Be Assigned,GS + !08-09517,SOC SCI 218A,G052,"Abbariao, Cristopher Adolfo",MAED-SS,13-S,GS,To Be Assigned,GS + !08-09517,SS 217,G053,"Abbariao, Cristopher Adolfo",MAED-SS,13-S,GS,To Be Assigned,GS + !06-00593,BA 72,B120,"Accad, Leonard Andrew Bramaje",BSENT,13-S,CBEA,"Gonzaga, Jeremiah",BSENT-3C + !06-00593,BA 66,B128,"Accad, Leonard Andrew Bramaje",BSENT,13-S,CBEA,"Singson, Marcial",BSENT-3C + !08-02956,ENG 13,E028,"Adviento, Baby Jane Concepcion",BSED-FIL,13-S,CTE,"Clemente, Beatriz",BSED 1K + ! + call index_to_delimiters(COMMA, line, ndels, pos) + + ! subject + tSubject = line(pos(2)+1:pos(3)-1) + cdx = index_to_subject(tSubject) + if (cdx<=0) then ! add it + NumAdditionalSubjects = NumAdditionalSubjects+1 + cdx = NumSubjects + NumAdditionalSubjects + + Subject(cdx)%Name = tSubject + Subject(cdx)%Title = tSubject + Subject(cdx)%DeptIdx = NumDepartments + Subject(cdx)%Units = 3.0 + + Subject(cdx)%TermOffered = 7 + Subject(cdx)%LectHours = 3.0 + Subject(cdx)%MinLectSize = 50 + Subject(cdx)%MaxLectSize = 50 + Subject(cdx)%LectLoad = 0.0 + Subject(cdx)%LabHours = 0.0 + Subject(cdx)%MinLabSize = 50 + Subject(cdx)%MaxLabSize = 50 + Subject(cdx)%LabLoad = 0.0 + + k = 1 + Subject(cdx)%lenPreq = k + Subject(cdx)%Prerequisite(k) = INDEX_TO_NONE + Subject(cdx)%lenCoreq = k + Subject(cdx)%Corequisite = INDEX_TO_NONE + Subject(cdx)%lenConc = k + Subject(cdx)%Concurrent = INDEX_TO_NONE + Subject(cdx)%lenConcPreq = k + Subject(cdx)%ConcPrerequisite= INDEX_TO_NONE + + Subject(cdx)%LabFee = 0.0 + Subject(cdx)%Tuition = 0.0 + + nSubj = nSubj + 1 + call file_log_message ('Added subject '//tSubject) + + end if + + ! section + tSection = trim(tSubject)//SPACE//line(pos(3)+1:pos(4)-1) + sdx = index_to_section(tSection, NumSections, Section) + if (sdx==0 .and. (pos(3)+1/=pos(4)) ) then + do k=1,NumDepartments + if (Department(k)%SectionPrefix==line(poS(3)+1:pos(3)+1) ) exit + end do + NumSections = NumSections+1 + Section(NumSections) = TYPE_SECTION (tSection, line(pos(3)+1:pos(4)-1), SPACE, & + k, cdx, Subject(cdx)%MaxLectSize, Subject(cdx)%MaxLectSize, 1, 0, 0, 0, 0, 0) + nSect = nSect + 1 + call file_log_message ('Added section '//tSection) + end if + + ! student + tStdNo = line(1:pos(2)-1) + std = index_to_student(tStdNo) + if (std==0) then + !#STUDNO,SUBJECT CODE,CLASS CODE,SutdName,Course,TERM,COLLEGE,TEACHER,SECTION + !1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 + !08-09517,EM 218,G007,"Abbariao, Cristopher Adolfo",MAED-SS,13-S,GS,To Be Assigned,GS + !08-09517,MA 204,G022,"Abbariao, Cristopher Adolfo",MAED-SS,13-S,GS,To Be Assigned,GS + k = index(line, '",') + call initialize_student(wrk) + wrk%StdNo = tStdNo + wrk%Name = line(pos(4)+2:k-1) + tCurriculum = line(k+2:) + k = index(tCurriculum, COMMA) + tCurriculum(k:) = SPACE + k = index_to_curriculum(tCurriculum) + if (k<0) then + k = -k + elseif (k==0) then + k = NumCurricula + end if + wrk%CurriculumIdx = k + call update_student_info(wrk, k) + if (k<0) call file_log_message ('Added '//tStdNo//trim(tCurriculum)//' - '// & + trim(text_student_curriculum(-k)) ) + nStd = nStd + 1 + + end if + + end do loop_ENLISTMENT + close(unitRAW) + + if (nSubj>0) call xml_write_subjects(pathToYear) + if (nSect>0) call xml_write_sections(path, NumSections, Section, 0) + if (nStd>0) call xml_write_students(pathToYear, 0) + + end subroutine add_data_from_enlistment + + end program MAIN diff --git a/PRE_ENLISTMENT.F90 b/PRE_ENLISTMENT.F90 index 346d8d8..afc880f 100644 --- a/PRE_ENLISTMENT.F90 +++ b/PRE_ENLISTMENT.F90 @@ -57,6 +57,9 @@ module PRE_ENLISTMENT contains +#include "custom_read_pre_enlistment.F90" + + subroutine recalculate_available_seats(Section) type (TYPE_SECTION), intent(in out) :: Section(0:) integer :: i, j, std @@ -71,14 +74,14 @@ subroutine recalculate_available_seats(Section) end do end do - return + end subroutine recalculate_available_seats subroutine initialize_pre_enlistment(eList) type (TYPE_PRE_ENLISTMENT) :: eList eList = TYPE_PRE_ENLISTMENT (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1.0) - return + end subroutine initialize_pre_enlistment @@ -90,7 +93,7 @@ subroutine delete_students_of_curriculum_from_enlistment(eList, currIndex) if (CurrProgCode(Student(std)%CurriculumIdx)/=CurrProgCode(currIndex)) cycle call initialize_pre_enlistment(eList(std)) end do - return + end subroutine delete_students_of_curriculum_from_enlistment @@ -101,7 +104,7 @@ subroutine xml_write_pre_enlistment(path, basename, eList, Section, curriculumFi integer, intent (in), optional :: curriculumFilter character(len=*), intent(in), optional :: dirOPT - integer :: std, sect, i, lenRecord, filter + integer :: std, sect, i, lenRecord, filter, gdx ! training only? if (noWrites) return @@ -116,7 +119,7 @@ subroutine xml_write_pre_enlistment(path, basename, eList, Section, curriculumFi if (present(dirOPT)) then fileName = trim(dirOPT)//trim(path)//basename else - fileName = trim(dirXML)//trim(path)//basename + fileName = trim(dirDATA)//trim(path)//basename endif if (filter>0) then fileName = trim(fileName)//DASH//trim(CurrProgCode(filter))//'.XML' @@ -166,12 +169,19 @@ subroutine xml_write_pre_enlistment(path, basename, eList, Section, curriculumFi ! student info start call xml_write_character(unitXML, indent0, 'Student') call xml_write_character(unitXML, indent1, 'StdNo', Student(std)%StdNo) - call xml_write_integer (unitXML, indent1, 'UnitsEarned', eList(std)%UnitsEarned) - call xml_write_integer (unitXML, indent1, 'StdYear', eList(std)%StdYear) - call xml_write_integer (unitXML, indent1, 'StdClassification', eList(std)%StdClassification) - call xml_write_integer (unitXML, indent1, 'AllowedLoad', eList(std)%AllowedLoad) - call xml_write_integer (unitXML, indent1, 'StdPriority', eList(std)%StdPriority) - call xml_write_integer (unitXML, indent1, 'NPriority', eList(std)%NPriority) + call xml_write_character(unitXML, indent1, 'Name', Student(std)%Name) + if (eList(std)%UnitsEarned/=0) & + call xml_write_integer (unitXML, indent1, 'UnitsEarned', eList(std)%UnitsEarned) + if (eList(std)%StdYear/=0) & + call xml_write_integer (unitXML, indent1, 'StdYear', eList(std)%StdYear) + if (eList(std)%StdClassification/=0) & + call xml_write_integer (unitXML, indent1, 'StdClassification', eList(std)%StdClassification) + if (eList(std)%AllowedLoad/=0) & + call xml_write_integer (unitXML, indent1, 'AllowedLoad', eList(std)%AllowedLoad) + if (eList(std)%StdPriority/=0) & + call xml_write_integer (unitXML, indent1, 'StdPriority', eList(std)%StdPriority) + if (eList(std)%NPriority/=0) & + call xml_write_integer (unitXML, indent1, 'NPriority', eList(std)%NPriority) if (eList(std)%NAlternates/=0) & call xml_write_integer (unitXML, indent1, 'NAlternates', eList(std)%NAlternates) if (eList(std)%NCurrent/=0) & @@ -180,8 +190,15 @@ subroutine xml_write_pre_enlistment(path, basename, eList, Section, curriculumFi do i=1,lenRecord sect = eList(std)%Section(i) if (sect>0) then - call xml_write_character(unitXML, indent1, 'Enlisted', & - trim(Subject(Section(sect)%SubjectIdx)%Name)//SPACE//Section(sect)%Code ) + gdx = eList(std)%Grade(i) + if (gdx>0) then + call xml_write_character(unitXML, indent1, 'Graded', & + trim(Subject(Section(sect)%SubjectIdx)%Name)//SPACE//trim(Section(sect)%Code)//COMMA// & + txtGrade(pGrade(gdx)) ) + else + call xml_write_character(unitXML, indent1, 'Enlisted', & + trim(Subject(Section(sect)%SubjectIdx)%Name)//SPACE//Section(sect)%Code ) + end if elseif (eList(std)%Subject(i)>0) then if (eList(std)%Contrib(i)>0.0) then call xml_write_character(unitXML, indent1, 'Predicted', & @@ -198,7 +215,7 @@ subroutine xml_write_pre_enlistment(path, basename, eList, Section, curriculumFi ! close file call xml_close_file(unitXML, XML_ROOT_ENLISTMENT) - return + end subroutine xml_write_pre_enlistment @@ -216,11 +233,12 @@ subroutine xml_read_pre_enlistment(path, basename, NumSections, Section, eList, character (len=MAX_LEN_SUBJECT_CODE) :: tSubject character (len=MAX_LEN_CLASS_ID) :: tClass character (len=MAX_LEN_STUDENT_CODE) :: tStdNo - integer :: cdx, idx, sdx, std + character (len = MAX_LEN_TEXT_GRADE) :: tGrade + integer :: cdx, idx, sdx, std,gdx numEntries = 0 ! open file, return on any error - fileName = trim(dirXML)//trim(path)//trim(basename)//'.XML' + fileName = trim(dirDATA)//trim(path)//trim(basename)//'.XML' call xml_open_file(unitXML, XML_ROOT_ENLISTMENT, fileName, errNo, forReading) if (errNo/=0) return @@ -319,6 +337,19 @@ subroutine xml_read_pre_enlistment(path, basename, NumSections, Section, eList, wrk%Subject(wrk%lenSubject) = cdx wrk%Contrib(wrk%lenSubject) = 0.0 + + case ('Graded') + idx = index(value, COMMA) + tClass = adjustl(value(:idx-1)) + tGrade = adjustl(value(idx+1:)) + sdx = index_to_section(tClass, NumSections, Section) + gdx = index_to_grade(tGrade) + call check_array_bound (wrk%lenSubject+1, MAX_SUBJECTS_PER_TERM, 'MAX_SUBJECTS_PER_TERM') + wrk%lenSubject = wrk%lenSubject + 1 + wrk%Section(wrk%lenSubject) = sdx + wrk%Subject(wrk%lenSubject) = Section(sdx)%SubjectIdx + wrk%Grade(wrk%lenSubject) = gdx + case ('/Student') if (std/=0) then eList(std) = wrk @@ -336,7 +367,7 @@ subroutine xml_read_pre_enlistment(path, basename, NumSections, Section, eList, call xml_close_file(unitXML) call file_log_message (itoa(numEntries)//' entries in '//fileName) - return + end subroutine xml_read_pre_enlistment @@ -365,21 +396,21 @@ subroutine read_pre_enlistment(path, basename, firstGrp, lastGrp, NumSections, S partialEntries, ierr) numEntries = numEntries + partialEntries if (partialEntries>0) then ! not empty; move to backup - call move_to_backup(trim(dirXML)//trim(path)//trim(basename)//DASH//itoa(grp)) + call move_to_backup(trim(dirDATA)//trim(path)//trim(basename)//DASH//trim(itoa(grp))//'.XML') end if end do noXML = numEntries==0 ! group enlistment files not available? end if if (.not. noXML) then ! get curriculum group enlistment done = .false. - do grp=1,NumCurricula-1 + do grp=1,NumCurricula if (done(grp)) cycle call xml_read_pre_enlistment(path, trim(basename)//DASH//trim(CurrProgCode(grp)), NumSections, Section, eList, & partialEntries, ierr) if (partialEntries>0) then ! not empty; move to backup - call move_to_backup(trim(dirXML)//trim(path)//trim(basename)//DASH//trim(CurrProgCode(grp))) + call move_to_backup(trim(dirDATA)//trim(path)//trim(basename)//DASH//trim(CurrProgCode(grp))//'.XML') end if - do ierr=grp,NumCurricula-1 + do ierr=grp,NumCurricula done(ierr) = CurrProgCode(grp)==CurrProgCode(ierr) end do end do @@ -400,154 +431,8 @@ subroutine read_pre_enlistment(path, basename, firstGrp, lastGrp, NumSections, S call xml_write_pre_enlistment(path, basename, eList, Section) end if - return - end subroutine read_pre_enlistment - - - subroutine custom_read_pre_enlistment(path, basename, NumSections, Section, cList, numEntries, ier) - character(len=*), intent(in) :: path, basename - type (TYPE_SECTION), intent(in out) :: Section(0:) - type (TYPE_PRE_ENLISTMENT), intent(out) :: cList(0:) - integer, intent (in) :: NumSections - integer, intent (out) :: numEntries, ier - - integer :: std - character (len=MAX_LEN_STUDENT_CODE) :: tStdNo - character (len=MAX_LEN_CURRICULUM_CODE) :: tCurriculum - - numEntries = 0 - fileName = trim(dirRAW)//trim(path)//basename - open(unit=unitRAW, file=fileName, form='formatted', status='old', iostat=ier) - if (ier/=0) return - - call file_log_message ('Retrieving '//fileName) - loop_WRITEIN : & - do - read (unitRAW, AFORMAT, iostat = eof) line - if (eof<0) exit loop_WRITEIN - if (line(1:1)=='#' .or. line(1:3)==' ') cycle loop_WRITEIN - - call index_to_delimiters(COMMA, line, ndels, pos) - tStdNo = line(1:pos(2)-1) - std = index_to_student(tStdNo) - ! get updated curriculum - tCurriculum = line(pos(5)+1:pos(6)-1) - Student(std)%CurriculumIdx = abs(index_to_curriculum(tCurriculum)) - ! retrieve rest of record - call GetEnlistment(unitRAW, NumSections, Section, line, cList(0)) - if (std==0) then - !call file_log_message('Student not in list: '//line) - cycle loop_WRITEIN - else if (cList(0)%lenSubject<0) then - ier = 1 - exit loop_WRITEIN - end if - - ! student is in list - numEntries = numEntries + 1 - cList(std) = cList(0) - - end do loop_WRITEIN - close(unitRAW) - call file_log_message (itoa(numEntries)//' entries in '//fileName) - - return - end subroutine custom_read_pre_enlistment - - - - subroutine GetEnlistment(iUnit, NumSections, Section, header, preRegistered) - integer, intent(in) :: iUnit - type (TYPE_SECTION), intent(in) :: Section(0:) - integer, intent (in) :: NumSections - character(len=127), intent(in) :: header - type (TYPE_PRE_ENLISTMENT), intent (out) :: preRegistered - integer :: cdx, gdx, k, ndels, pos(30), sdx - character (len=4) :: tGrade - character (len=MAX_LEN_SUBJECT_CODE) :: tSubject - character (len=MAX_LEN_CLASS_ID) :: tSection - character(len=255) :: line - - call initialize_pre_enlistment(preRegistered) - ! - !1977-92165,2010,FIRST,CED 291,VW,2,REGD - !1977-92165,2010,FIRST,CED 299,CD,1,REGD - !1977-92165,2010,FIRST,DM 220,WY,3,REGD - !1 2 3 4 5 6 7 - ! Line 1: STDNO,NAME,GENDER,COUNTRY,CURRICULUM,SCHOLAR,COLLEGE,EARNED,CLASSIF,YEARLEVEL,ALLOWED,GROUP,NPRIORITY,NALTERNATES,NCURRENT - ! 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 - - - call index_to_delimiters(COMMA, header, ndels, pos) - if (ndels<=8) then ! old format: signal error - preRegistered%lenSubject = -1 - return - !elseif (ndels<=12) then - ! preRegistered%AllowedLoad = atoi(header(pos(7)+1:pos(8)-1)) - ! preRegistered%StdPriority = atoi(header(pos(8)+1:pos(9)-1)) - ! preRegistered%NPriority = atoi(header(pos(9)+1:pos(10)-1)) - ! preRegistered%NAlternates = atoi(header(pos(10)+1:pos(11)-1)) - ! preRegistered%NCurrent = atoi(header(pos(11)+1:pos(12)-1)) - else - preRegistered%UnitsEarned = atoi(header(pos(8)+1:pos(9)-1)) - preRegistered%StdClassification = atoi(header(pos(9)+1:pos(10)-1)) - preRegistered%StdYear = atoi(header(pos(10)+1:pos(11)-1)) - preRegistered%AllowedLoad = atoi(header(pos(11)+1:pos(12)-1)) - preRegistered%StdPriority = atoi(header(pos(12)+1:pos(13)-1)) - preRegistered%NPriority = atoi(header(pos(13)+1:pos(14)-1)) - preRegistered%NAlternates = atoi(header(pos(14)+1:pos(15)-1)) - preRegistered%NCurrent = atoi(header(pos(15)+1:pos(16)-1)) - end if - preRegistered%lenSubject = preRegistered%NPriority+preRegistered%NAlternates+preRegistered%NCurrent - !write(*,*) trim(header), ', expected entries = ', preRegistered%lenSubject - do k=1,preRegistered%lenSubject - read (iUnit, AFORMAT) line - - !write(*,*) k, trim(line) - - call index_to_delimiters(COMMA, line, ndels, pos) - ! Line 2: STDNO,YEAR,TERM,COURSE,SECTION,UNITS,GRADE,COURSERANK,CONTRIB - ! 1 2 3 4 5 6 7 8 9 10 - ! subject - tSubject = line(pos(4)+1:pos(5)-1) - cdx = index_to_subject(tSubject) - !write(*,*) k, tSubject, cdx - if (cdx<=0) cycle - call check_array_bound (k, MAX_SUBJECTS_PER_TERM, 'MAX_SUBJECTS_PER_TERM') - preRegistered%Subject(k) = cdx - ! section - tSection = adjustl(line(pos(5)+1:pos(6)-1)) - if (tSection==SPACE) then ! not accommodated - sdx = 0 - else - tSection = trim(tSubject)//SPACE//tSection - sdx = index_to_section(tSection, NumSections, Section) - if (sdx==0) then - call file_log_message ('No such class; ignored - '//line) - end if - end if - preRegistered%Section(k) = sdx - ! grade - tGrade = line(pos(7)+1:pos(8)-1) - if (tGrade==SPACE) then ! not forced - gdx = 0 - else - gdx = index_to_grade(tGrade) - if (gdx<0) then - call file_log_message ('Invalid grade - '//line) - gdx = gdxREGD - end if - end if - preRegistered%Grade(k) = gdx - ! contribution to demand - if (ndels>8) then - tSubject = line(pos(9)+1:pos(10)-1) - read(tSubject,'(f6.4)') preRegistered%Contrib(k) - end if - end do - return - end subroutine GetEnlistment + end subroutine read_pre_enlistment subroutine read_predictions(path, NumSections, Section, eList, numEntries, errNo) @@ -578,7 +463,7 @@ subroutine read_predictions(path, NumSections, Section, eList, numEntries, errNo call xml_write_pre_enlistment(path, 'PREDICTIONS', eList, Section) end if - return + end subroutine read_predictions diff --git a/REPORTS.F90 b/REPORTS.F90 index 5c87075..9c11917 100644 --- a/REPORTS.F90 +++ b/REPORTS.F90 @@ -270,7 +270,7 @@ subroutine student_distribution(device) end if write(device,AFORMAT) '
    ' - return + end subroutine student_distribution @@ -304,7 +304,7 @@ subroutine enlistment_not_accommodated(device, Preenlisted) call list_students(device, n_count, tArray, targetSubject, Preenlisted) write(device,AFORMAT) '
    ' - return + end subroutine enlistment_not_accommodated @@ -527,23 +527,16 @@ subroutine enlistment_summarize (device, NumSections, Section, Offering, Preenli begintd//trim(Student(std)%Name)//endtd// & begintd//trim(Curriculum(Student(std)%CurriculumIdx)%Code)//endtd//begintd - if (fnAvailable(fnChangeMatriculation) ) then - write(device,AFORMAT) trim(make_href(fnChangeMatriculation, 'schedule', & - A1=Student(std)%StdNo, & - pre=' [ ', post=' ]')) - end if - if (fnAvailable(fnEditCheckList) ) then - write(device,AFORMAT) trim(make_href(fnEditCheckList, 'checklist', & - A1=Student(std)%StdNo, & - pre=' [ ', post=' ]')) - end if - if (fnAvailable(fnStudentPerformance) ) then - write(device,AFORMAT) trim(make_href(fnStudentPerformance, 'performance', & - A1=Student(std)%StdNo, & - pre=' [ ', post=' ]')) - end if + write(device,AFORMAT) trim(make_href(fnChangeMatriculation, 'schedule', & + A1=Student(std)%StdNo, & + pre=' [ ', post=' ]', alt=SPACE)) - !end if + write(device,AFORMAT) trim(make_href(fnEditCheckList, 'checklist', & + A1=Student(std)%StdNo, & + pre=' [ ', post=' ]', alt=SPACE)) + write(device,AFORMAT) trim(make_href(fnStudentPerformance, 'performance', & + A1=Student(std)%StdNo, & + pre=' [ ', post=' ]', alt=SPACE)) write(device,AFORMAT) endtd//endtr end do @@ -552,7 +545,7 @@ subroutine enlistment_summarize (device, NumSections, Section, Offering, Preenli end select - return + end subroutine enlistment_summarize diff --git a/ROOMS.F90 b/ROOMS.F90 index 0c4d062..03a0623 100644 --- a/ROOMS.F90 +++ b/ROOMS.F90 @@ -84,7 +84,7 @@ subroutine read_rooms(path, errNo) call initialize_room(Room(NumRooms), trim(Department(iDept)%Code)//' Room', & iDept, 0, 0) end do - call sort_rooms() + !call sort_rooms() noXML = .true. errNo = 0 end if @@ -93,7 +93,7 @@ subroutine read_rooms(path, errNo) if (noXML) call xml_write_rooms(path) call file_log_message (itoa(NumRooms)//' rooms') - return + end subroutine read_rooms @@ -110,7 +110,7 @@ subroutine initialize_room (wrkRoom, tCode, iDept, iCluster, iCapacity) wrkRoom = TYPE_ROOM(SPACE, NumDepartments, 0, 0) end if - return + end subroutine initialize_room @@ -119,62 +119,65 @@ function index_to_room (tRoom) integer :: index_to_room character (len=MAX_LEN_ROOM_CODE), intent (in) :: tRoom - integer :: i, j, rdx + integer :: rdx ! i, j, + + index_to_room = 0 ! try the newly added rooms - do rdx=NumRooms+1,NumRooms+NumAdditionalRooms + !do rdx=NumRooms+1,NumRooms+NumAdditionalRooms + do rdx=1,NumRooms+NumAdditionalRooms if (tRoom==Room(rdx)%Code) then index_to_room = rdx return end if end do - ! try the orignal rooms - i = 1 - j = NumRooms - do - if (i>j) then - rdx = 0 - exit - else - rdx = (i + j)/2 - if (tRoom==Room(rdx)%Code) then - exit - else if (tRoomRoom(j)%Code) then +! ! try the orignal rooms +! i = 1 +! j = NumRooms +! do +! if (i>j) then +! rdx = 0 +! exit +! else +! rdx = (i + j)/2 +! if (tRoom==Room(rdx)%Code) then +! exit +! else if (tRoomRoom(j)%Code) then +! +! wrkRoom = Room(i) +! Room(i) = Room(j) +! Room(j) = wrkRoom +! +! end if +! end do +! +! end do +! +! +! end subroutine sort_rooms subroutine xml_write_rooms(path, dirOPT) @@ -189,7 +192,7 @@ subroutine xml_write_rooms(path, dirOPT) if (present(dirOPT)) then fileName = trim(dirOPT)//trim(path)//'ROOMS.XML' else - fileName = trim(dirXML)//trim(path)//'ROOMS.XML' + fileName = trim(dirDATA)//trim(path)//'ROOMS.XML' endif call xml_open_file(unitXML, XML_ROOT_ROOMS, fileName, ldx) @@ -214,7 +217,7 @@ subroutine xml_write_rooms(path, dirOPT) call xml_close_file(unitXML, XML_ROOT_ROOMS) - return + end subroutine xml_write_rooms @@ -230,7 +233,7 @@ subroutine xml_read_rooms(path, errNo) character (len=MAX_LEN_DEPARTMENT_CODE) :: tDept ! open file, return on any error - fileName = trim(dirXML)//trim(path)//'ROOMS.XML' + fileName = trim(dirDATA)//trim(path)//'ROOMS.XML' call xml_open_file(unitXML, XML_ROOT_ROOMS, fileName, errNo, forReading) if (errNo/=0) return @@ -279,9 +282,9 @@ subroutine xml_read_rooms(path, errNo) end do call xml_close_file(unitXML) - call sort_rooms() + !call sort_rooms() + - return end subroutine xml_read_rooms diff --git a/SECTIONS.F90 b/SECTIONS.F90 index 188897d..ef205a8 100644 --- a/SECTIONS.F90 +++ b/SECTIONS.F90 @@ -71,7 +71,7 @@ module SECTIONS subroutine initialize_section(S) type (TYPE_SECTION) :: S S = TYPE_SECTION (SPACE, SPACE, SPACE, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0) - return + end subroutine initialize_section @@ -88,7 +88,7 @@ function index_to_section(tSection, NumSections, Section) exit end do index_to_section = sdx - return + end function index_to_section @@ -99,7 +99,7 @@ function is_lecture_class(sect, Section) ! returns true if sect is a lecture class (no DASH in section code) is_lecture_class = index(Section(sect)%Code,DASH)==0 .or. & Subject(Section(sect)%SubjectIdx)%Name(1:3)=='PE ' - return + end function is_lecture_class @@ -133,7 +133,7 @@ function text_days_of_section(sect, NumSections, Section) line = 'TBA' end if text_days_of_section = line - return + end function text_days_of_section @@ -151,7 +151,7 @@ subroutine offerings_sort(NumSections, Section) end do end do call initialize_section(Section(0)) - return + end subroutine offerings_sort @@ -187,7 +187,7 @@ subroutine offerings_summarize(NumSections, Section, Offering, DeptIdx) end if end if end do - return + end subroutine offerings_summarize @@ -211,7 +211,7 @@ subroutine count_sections_by_dept(Term, NumSections, Section) ScheduleCount(Term,dept) = max(atoi(Section(sect)%Code(2:)), ScheduleCount(Term,dept)) end do #endif - return + end subroutine count_sections_by_dept @@ -221,14 +221,14 @@ subroutine delete_sections_of_dept(NumSections, Section, DeptIdx) integer, intent (in) :: DeptIdx integer :: sect - write(*,*) 'Removing classes in '//Department(DeptIdx)%Code + write(unitLOG,*) 'Removing classes in '//Department(DeptIdx)%Code do sect=1,NumSections if (Section(sect)%SubjectIdx==0) cycle if (DeptIdx==Section(sect)%DeptIdx) then call initialize_section(Section(sect)) end if end do - return + end subroutine delete_sections_of_dept @@ -250,13 +250,13 @@ subroutine xml_write_sections(path, NumSections, Section, iDept, dirOPT) if (present(dirOPT)) then fileName = trim(dirOPT)//trim(path)//'CLASSES-'//trim(Department(iDept)%Code)//'.XML' else - fileName = trim(dirXML)//trim(path)//'CLASSES-'//trim(Department(iDept)%Code)//'.XML' + fileName = trim(dirDATA)//trim(path)//'CLASSES-'//trim(Department(iDept)%Code)//'.XML' endif else if (present(dirOPT)) then fileName = trim(dirOPT)//trim(path)//'CLASSES.XML' else - fileName = trim(dirXML)//trim(path)//'CLASSES.XML' + fileName = trim(dirDATA)//trim(path)//'CLASSES.XML' endif end if call xml_open_file(unitXML, XML_ROOT_SECTIONS, fileName, sdx) @@ -327,7 +327,7 @@ subroutine xml_write_sections(path, NumSections, Section, iDept, dirOPT) call xml_close_file(unitXML, XML_ROOT_SECTIONS) - return + end subroutine xml_write_sections @@ -339,19 +339,19 @@ subroutine read_classes(path, NumSections, Section, Offering, errNo) type (TYPE_OFFERED_SUBJECTS), intent (in out), dimension (MAX_ALL_DUMMY_SUBJECTS:MAX_ALL_SUBJECTS) :: Offering integer, intent (out) :: errNo - integer :: ddx, ierr, mainEntries, numUpdates, partialEntries, numEntries + integer :: ierr, mainEntries, numUpdates, numEntries !, ddx, partialEntries logical :: noXML errNo = 0 ! 0 is OK; there might be no classes entered yet - fileName = trim(dirXML)//trim(path)//'CLASSES.XML' + fileName = trim(dirDATA)//trim(path)//'CLASSES.XML' call xml_read_classes(fileName, NumSections, Section, ierr) noXML = NumSections==0 mainEntries = NumSections numEntries = NumSections ! ! check for classes edited by departments ! do ddx=2,NumDepartments-1 -! fileName = trim(dirXML)//UPDATES//trim(path)//'CLASSES-'//trim(Department(ddx)%Code)//'.XML' +! fileName = trim(dirDATA)//trim(path)//'CLASSES-'//trim(Department(ddx)%Code)//'.XML' ! call xml_read_classes(fileName, NumSections, Section, ierr) ! partialEntries = NumSections - numEntries ! numEntries = NumSections @@ -362,7 +362,7 @@ subroutine read_classes(path, NumSections, Section, Offering, errNo) ! end do numUpdates = NumSections - mainEntries if (NumSections==0) then ! try the custom format - fileName = trim(dirRAW)//trim(path)//'CLASSES' + fileName = trim(dirDATA)//trim(path)//'CLASSES' call custom_read_classes(fileName, NumSections, Section, ierr) numUpdates = 0 end if @@ -375,7 +375,7 @@ subroutine read_classes(path, NumSections, Section, Offering, errNo) if ( (noXML .and. NumSections>0) .or. numUpdates>0 ) & call xml_write_sections(path, NumSections, Section, 0) - return + end subroutine read_classes @@ -492,7 +492,7 @@ subroutine xml_read_classes(fName, NumSections, Section, errNo) if (iidx>0) then ndays = ndays+1 if (ndays>6) then - write(*,*) 'Too many days: '//trim(value) + write(unitLOG,*) 'Too many days: '//trim(value) ndays = 1 ! force to be TBA dayidx = 0 btime = 0 @@ -576,7 +576,7 @@ subroutine xml_read_classes(fName, NumSections, Section, errNo) call xml_close_file(unitXML) call file_log_message (itoa(NumSections)//' sections after reading '//fName) - return + end subroutine xml_read_classes @@ -599,7 +599,7 @@ function is_regular_schedule(sect, Section) end do is_regular_schedule = sameTime .and. sameRoom .and. sameTeacher - return + end function is_regular_schedule diff --git a/STUDENTS.F90 b/STUDENTS.F90 index a146f37..cbd0349 100644 --- a/STUDENTS.F90 +++ b/STUDENTS.F90 @@ -34,8 +34,13 @@ module STUDENTS implicit none - integer, parameter :: & - MAX_ALL_STUDENTS = 15000, & ! max no. of students +#if defined BATCH + integer, parameter :: MAX_ALL_STUDENTS = 30000 ! max no. of students +#else + integer, parameter :: MAX_ALL_STUDENTS = 13000 ! max no. of students +#endif + + integer, parameter :: & ! year-curriculum-number MAX_LEN_STUDENT_CODE = 13 ! length of student numbers: YYYY-PPP-SSSS type :: TYPE_STUDENT @@ -88,11 +93,11 @@ subroutine read_students(path, errNo) ! check for students added by program advisers numUpdates = 0 done = .false. - do iCurr=1,NumCurricula-1 + do iCurr=1,NumCurricula if (done(iCurr)) cycle call xml_read_students (path, iCurr, partialEntries, ierr) numUpdates = numUpdates + partialEntries - do i = iCurr+1,NumCurricula-1 + do i = iCurr+1,NumCurricula if (CurrProgCode(iCurr)==CurrProgCode(i)) done(i) = .true. end do end do @@ -108,7 +113,7 @@ subroutine read_students(path, errNo) call xml_write_students(path, 0) end if - return + end subroutine read_students @@ -122,7 +127,7 @@ function year_prefix(S) if (StdNoYearLen<=0) StdNoYearLen = StdNoChars year_prefix = StdNoYearLen - return + end function year_prefix @@ -137,7 +142,7 @@ subroutine collect_prefix_years() if (jdx==0) StdNoPrefix = trim(StdNoPrefix)//Student(std)%StdNo(:idx)//':' end do !write(*,*) trim(StdNoPrefix) - return + end subroutine collect_prefix_years @@ -145,7 +150,7 @@ end subroutine collect_prefix_years subroutine initialize_student(S) type (TYPE_STUDENT) :: S S = TYPE_STUDENT ('####-#####', '(not in directory)', SPACE, 1, 0, -1, 0, 0, 0) - return + end subroutine initialize_student @@ -162,7 +167,7 @@ subroutine insert_student(S, loc) end do Student(loc) = S !write(*,*) 'INSerted '//S%StdNo, ' to ', loc, '/', NumStudents - return + end subroutine insert_student @@ -179,20 +184,20 @@ subroutine update_student_info(S, idx) Student(idx) = S !write(*,*) 'UPDated '//S%StdNo, ' at ', idx, '/', NumStudents end if - return + end subroutine update_student_info subroutine sort_alphabetical_students() integer :: i, j, k - write (*,*) 'Sorting students alphabetically... please wait...' + !write (*,*) 'Sorting students alphabetically... please wait...' StdRank = 0 do i=1,NumStudents StdRank(i) = i end do do i=1,NumStudents-1 - if (mod(i,1000)==0) write(*,*) i, ' students sorted...' + if (mod(i,1000)==0) write(unitLOG,*) i, ' students sorted...' do j=i+1,NumStudents if (Student(StdRank(i))%Name>Student(StdRank(j))%Name) then k = StdRank(i) @@ -201,7 +206,7 @@ subroutine sort_alphabetical_students() end if end do end do - return + end subroutine sort_alphabetical_students @@ -232,7 +237,7 @@ function index_to_student(StdNum) end if end do index_to_student = sdx - return + end function index_to_student @@ -247,7 +252,7 @@ function text_student_info (std) trim(itoa(Student(std)%CountryIdx))//COMMA// & trim(Curriculum(idxCURR)%Code)//COMMA// & College(Curriculum(idxCURR)%CollegeIdx)%Code - return + end function text_student_info @@ -264,7 +269,7 @@ function text_student_curriculum(std) text_student_curriculum = trim(Student(std)%StdNo)//SPACE//trim(Student(std)%Name)//COMMA//SPACE// & text_curriculum_info(idxCURR) - return + end function text_student_curriculum @@ -284,13 +289,13 @@ subroutine xml_write_students(path, iCurr, dirOPT) if (present(dirOPT)) then fileName = trim(dirOPT)//trim(path)//'STUDENTS-'//trim(CurrProgCode(iCurr))//'.XML' else - fileName = trim(dirXML)//trim(path)//'STUDENTS-'//trim(CurrProgCode(iCurr))//'.XML' + fileName = trim(dirDATA)//trim(path)//'STUDENTS-'//trim(CurrProgCode(iCurr))//'.XML' endif else if (present(dirOPT)) then fileName = trim(dirOPT)//trim(path)//'STUDENTS.XML' else - fileName = trim(dirXML)//trim(path)//'STUDENTS.XML' + fileName = trim(dirDATA)//trim(path)//'STUDENTS.XML' endif end if @@ -328,7 +333,7 @@ subroutine xml_write_students(path, iCurr, dirOPT) call xml_write_character(unitXML, indent0, '/Student') end do call xml_close_file(unitXML, XML_ROOT_STUDENTS) - return + end subroutine xml_write_students @@ -346,9 +351,9 @@ subroutine xml_read_students(path, iCurr, numEntries, errNo) ! generate file name if (iCurr>0) then - fileName = trim(dirXML)//trim(path)//'STUDENTS-'//trim(CurrProgCode(iCurr))//'.XML' + fileName = trim(dirDATA)//trim(path)//'STUDENTS-'//trim(CurrProgCode(iCurr))//'.XML' else - fileName = trim(dirXML)//trim(path)//'STUDENTS.XML' + fileName = trim(dirDATA)//trim(path)//'STUDENTS.XML' end if ! open file, return on any error @@ -406,7 +411,7 @@ subroutine xml_read_students(path, iCurr, numEntries, errNo) call xml_close_file(unitXML) call file_log_message (itoa(numEntries)//' entries in '//fileName) - return + end subroutine xml_read_students diff --git a/SUBJECTS.F90 b/SUBJECTS.F90 index 3208405..54349e4 100644 --- a/SUBJECTS.F90 +++ b/SUBJECTS.F90 @@ -130,7 +130,7 @@ subroutine initialize_subject (wrkSubject) 1, INDEX_TO_NONE, & ! lenConc, Concurrent(MAX_ALL_SUBJECT_CONCURRENT), & 1, INDEX_TO_NONE) ! lenConcPreq, ConcPrerequisite(MAX_ALL_SUBJECT_CONCPREQ) - return + end subroutine initialize_subject @@ -148,7 +148,7 @@ subroutine xml_write_subjects(path, dirOPT) if (present(dirOPT)) then fileName = trim(dirOPT)//trim(path)//'SUBJECTS.XML' else - fileName = trim(dirXML)//trim(path)//'SUBJECTS.XML' + fileName = trim(dirDATA)//trim(path)//'SUBJECTS.XML' endif call xml_open_file(unitXML, XML_ROOT_SUBJECTS, fileName, i) @@ -247,7 +247,7 @@ subroutine xml_write_subjects(path, dirOPT) call xml_close_file(unitXML, XML_ROOT_SUBJECTS) - return + end subroutine xml_write_subjects @@ -312,7 +312,7 @@ subroutine read_subjects(path, errNo) call custom_read_failrates(path, eof) end if - return + end subroutine read_subjects @@ -329,7 +329,7 @@ subroutine xml_read_subjects(path, errNo) character (len=MAX_LEN_SUBJECT_CODE) :: token ! open file for basic info on subjects, return on any error - fileName = trim(dirXML)//trim(path)//'SUBJECTS.XML' + fileName = trim(dirDATA)//trim(path)//'SUBJECTS.XML' call xml_open_file(unitXML, XML_ROOT_SUBJECTS, fileName, errNo, forReading) if (errNo/=0) return @@ -505,7 +505,7 @@ subroutine xml_read_subjects(path, errNo) call xml_close_file(unitETC) call file_log_message (itoa(NumSubjects)//' subjects in '//fileName) - return + end subroutine xml_read_subjects @@ -521,7 +521,7 @@ subroutine xml_read_subjects_other(path, errNo) ! additional subject info errNo = 0 - fileName = trim(dirXML)//trim(path)//'SUBJECTS-OTHER.XML' + fileName = trim(dirDATA)//trim(path)//'SUBJECTS-OTHER.XML' call xml_open_file(unitETC, XML_ROOT_SUBJECTS, fileName, errNo, forReading) if (errNo/=0) return @@ -564,7 +564,7 @@ subroutine xml_read_subjects_other(path, errNo) wrkSubject%lenCoreq, wrkSubject%Corequisite, eof) if (eof>0) exit if (wrkSubject%lenCoreq>0 .and. Subject(wrkSubject%Corequisite(1))%Name/='NONE') then - write(*,*) trim(wrkSubject%Name)//' has co-requisite ', & + write(unitLOG,*) trim(wrkSubject%Name)//' has co-requisite ', & (Subject(wrkSubject%Corequisite(j))%Name, j=1,wrkSubject%lenCoreq) end if @@ -572,7 +572,7 @@ subroutine xml_read_subjects_other(path, errNo) call tokenize_subjects(value, '+', MAX_ALL_SUBJECT_CONCURRENT, wrkSubject%lenConc, wrkSubject%Concurrent, eof) if (eof>0) exit if (wrkSubject%lenConc>0 .and. Subject(wrkSubject%Concurrent(1))%Name/='NONE') then - write(*,*) trim(wrkSubject%Name)//' is concurrent with ', & + write(unitLOG,*) trim(wrkSubject%Name)//' is concurrent with ', & (Subject(wrkSubject%Concurrent(j))%Name, j=1,wrkSubject%lenConc) end if @@ -581,7 +581,7 @@ subroutine xml_read_subjects_other(path, errNo) wrkSubject%ConcPrerequisite, eof) if (eof>0) exit if (wrkSubject%lenConcPreq>0 .and. Subject(wrkSubject%ConcPrerequisite(1))%Name/='NONE') then - write(*,*) trim(wrkSubject%Name)//' has pre-req that can be concurrent: ', & + write(unitLOG,*) trim(wrkSubject%Name)//' has pre-req that can be concurrent: ', & (Subject(wrkSubject%ConcPrerequisite(j))%Name, j=1,wrkSubject%lenConcPreq) end if @@ -598,7 +598,7 @@ subroutine xml_read_subjects_other(path, errNo) call xml_close_file(unitETC) - return + end subroutine xml_read_subjects_other @@ -646,7 +646,7 @@ function index_to_subject(token) end if end do index_to_subject = cdx - return + end function index_to_subject @@ -673,36 +673,44 @@ function index_to_new_subject(subj) end if end do index_to_new_subject = cdx - return + end function index_to_new_subject - subroutine tokenize_subjects(subline, symbol, maxTokens, nTokens, tokenArray, ier) + subroutine tokenize_subjects(subline, symbol, maxTokens, nTokens, tokenArray, ier, mesg) integer, intent (in) :: maxTokens integer, intent (out) :: nTokens, tokenArray(maxTokens), ier character, intent (in) :: symbol ! delimiter character(len=*), intent (in) :: subline + character(len=*), intent (out), optional :: mesg integer :: i, j, k, ndelsub, posub(30) character (len=MAX_LEN_SUBJECT_CODE) :: token + character (len=MAX_LEN_FILE_PATH) :: errMsg !write(*,*) 'String is : '//subline + errMsg = SPACE ier = 0 k = 0 call index_to_delimiters(symbol, subline, ndelsub, posub) do j=1,ndelsub token = adjustl(subline(posub(j)+1:posub(j+1)-1)) i = index_to_subject(token) - !write(*,*) i, token if (i==0) then - ier = 113 ! not listed - call file_log_message ('Tokenize(): '//subline, trim(token)//' is not in catalog?') - else - k = k+1 - tokenArray(k) = i + errMsg = ', '//token + cycle end if + k = k+1 + tokenArray(k) = i end do - nTokens = ndelsub - return + nTokens = k + if (present(mesg)) then + if (len_trim(errMsg)>0) then + mesg = 'Not found -'//errMsg(2:) + else + mesg = SPACE + end if + end if + end subroutine tokenize_subjects @@ -724,7 +732,7 @@ function is_graduate_level_subject(subj) tSubject = tSubject(f:l) num = atoi(tSubject) is_graduate_level_subject = num>200 - return + end function is_graduate_level_subject @@ -740,7 +748,7 @@ function is_offered(subj, term) (term==1 .and. mod(j,2)==1) .or. & ! offered 1,12,1S (term==2 .and. (j==2 .or. j==3 .or. j==6) ) .or. & ! offered 2,12,2S (term==3 .and. (j>3) ) ! offered S,1S,2S - return + end function is_offered @@ -749,7 +757,7 @@ function is_lecture_lab_subject(subj) logical :: is_lecture_lab_subject ! returns true if subj is a lecture-lab/recit subject is_lecture_lab_subject = Subject(subj)%LectHours*Subject(subj)%LabHours/=0.0 - return + end function is_lecture_lab_subject @@ -867,7 +875,7 @@ function text_prerequisite_of_subject(subj,href) end if end if text_prerequisite_of_subject = displayStr - return + end function text_prerequisite_of_subject @@ -879,7 +887,7 @@ subroutine custom_read_failrates(path, eof) integer :: cdx, i, j, k, l character (len=MAX_LEN_SUBJECT_CODE) :: token - fileName = trim(dirRAW)//trim(path)//'FAILRATES' + fileName = trim(dirDATA)//trim(path)//'FAILRATES' open (unit=unitRAW, file=fileName, form='formatted', status='old', iostat=eof) if (eof/=0) return @@ -918,7 +926,7 @@ subroutine custom_read_failrates(path, eof) ! success eof = 0 - return + end subroutine custom_read_failrates @@ -933,7 +941,7 @@ subroutine xml_read_failrates(path, eof) character(len=MAX_LEN_XML_TAG) :: tag ! open file, return on any error - fileName = trim(dirXML)//trim(path)//'FAILRATES.XML' + fileName = trim(dirDATA)//trim(path)//'FAILRATES.XML' call xml_open_file(unitXML, XML_FAILRATES, fileName, eof, forReading) if (eof/=0) return @@ -970,7 +978,7 @@ subroutine xml_read_failrates(path, eof) end do call xml_close_file(unitXML) - return + end subroutine xml_read_failrates @@ -984,7 +992,7 @@ subroutine xml_write_failrates(path, GrandTotal) ! training only? if (noWrites) return - fileName = trim(dirXML)//trim(path)//'FAILRATES.XML' + fileName = trim(dirDATA)//trim(path)//'FAILRATES.XML' call xml_open_file(unitXML, XML_FAILRATES, fileName, cdx) write(unitXML,AFORMAT) & ' ', & @@ -1007,7 +1015,7 @@ subroutine xml_write_failrates(path, GrandTotal) end do call xml_close_file(unitXML, XML_FAILRATES) - return + end subroutine xml_write_failrates diff --git a/TEACHERS.F90 b/TEACHERS.F90 index c429215..fb690ef 100644 --- a/TEACHERS.F90 +++ b/TEACHERS.F90 @@ -128,7 +128,7 @@ subroutine read_teachers(path, errNo) ! write the XML TEACHERS file? if (noXML .and. NumTeachers>0) call xml_write_teachers(path) - return + end subroutine read_teachers @@ -139,7 +139,7 @@ subroutine initialize_teacher (wrkTeacher) wrkTeacher = TYPE_TEACHER(SPACE, SPACE, NumDepartments, 0, 0, 0, SPACE, SPACE, SPACE, SPACE, & SPACE, GUEST, 0) - return + end subroutine initialize_teacher @@ -191,7 +191,7 @@ function index_to_teacher (token) ! end do ! index_to_teacher = tdx - return + end function index_to_teacher @@ -210,7 +210,7 @@ subroutine sort_teachers end do end do - return + end subroutine sort_teachers @@ -236,7 +236,7 @@ subroutine sort_alphabetical_teachers() end do - return + end subroutine sort_alphabetical_teachers @@ -253,7 +253,7 @@ subroutine xml_write_teachers(path, dirOPT) if (present(dirOPT)) then fileName = trim(dirOPT)//trim(path)//'TEACHERS.XML' else - fileName = trim(dirXML)//trim(path)//'TEACHERS.XML' + fileName = trim(dirDATA)//trim(path)//'TEACHERS.XML' endif call xml_open_file(unitXML, XML_ROOT_TEACHERS, fileName, ldx) @@ -297,7 +297,7 @@ subroutine xml_write_teachers(path, dirOPT) call xml_close_file(unitXML, XML_ROOT_TEACHERS) - return + end subroutine xml_write_teachers @@ -315,7 +315,7 @@ subroutine xml_read_teachers(path, errNo) character (len=MAX_LEN_ACADEMIC_RANK) :: tRank ! open file, return on any error - fileName = trim(dirXML)//trim(path)//'TEACHERS.XML' + fileName = trim(dirDATA)//trim(path)//'TEACHERS.XML' call xml_open_file(unitXML, XML_ROOT_TEACHERS, fileName, errNo, forReading) if (errNo/=0) return @@ -418,7 +418,7 @@ subroutine xml_read_teachers(path, errNo) call sort_teachers() - return + end subroutine xml_read_teachers @@ -436,7 +436,7 @@ subroutine xml_read_teachers_other(path, errNo) ! open file, return on any error errNo = 0 - fileName = trim(dirXML)//trim(path)//'TEACHERS-OTHER.XML' + fileName = trim(dirDATA)//trim(path)//'TEACHERS-OTHER.XML' call xml_open_file(unitETC, XML_ROOT_TEACHERS, fileName, eof, forReading) if (eof/=0) return @@ -513,7 +513,7 @@ subroutine xml_read_teachers_other(path, errNo) call xml_close_file(unitETC) - return + end subroutine xml_read_teachers_other @@ -553,7 +553,7 @@ subroutine set_password(Password, forcedPassword) !write(*,*) lenS, Password(:lenS), lenP, Password(lenS+1:)!, lenS+lenP, Password ! encrypt salted password call encrypt(passwordEncryptionKey, Password) - return + end subroutine set_password @@ -565,7 +565,7 @@ subroutine get_password(tdx, Password) call decrypt(passwordEncryptionKey, Password) Password = Password(lenPasswordEncryptionKey-atoi(Password(3:4))+1:) - return + end subroutine get_password @@ -578,7 +578,7 @@ function is_password(tdx, Password) call get_password(tdx, tPassword) is_password = tPassword(:MAX_LEN_PASSWORD)==Password(:MAX_LEN_PASSWORD) - return + end function is_password @@ -588,7 +588,7 @@ subroutine write_password_file(path) character (len=MAX_LEN_PASSWD_VAR) :: Password ! write CSV password file - open(unit=unitETC, file=trim(dirXML)//trim(path)//'PASSWORDS.CSV', form='formatted', status='unknown') + open(unit=unitETC, file=trim(dirDATA)//trim(path)//'PASSWORDS.CSV', form='formatted', status='unknown') write(unitETC,AFORMAT) & '#', & '# !!!!!!!!! FOR THE REGISTRAR''S EYES ONLY !!!!!!!!! ', & @@ -612,13 +612,13 @@ subroutine write_password_file(path) '"'//Teacher(i)%Name//'","'// & Department(Teacher(i)%DeptIdx)%Code//'","'// & Teacher(i)%TeacherId//'","'// & - Password//'","'// & + '(Ask the Registrar)","'// & !Password//'","'// & Teacher(i)%Role//'"' ! end if end do close (unitETC) - return + end subroutine write_password_file diff --git a/TIMES.F90 b/TIMES.F90 index 2d3fa0b..68069d9 100644 --- a/TIMES.F90 +++ b/TIMES.F90 @@ -95,16 +95,19 @@ function index_to_year (tYear) ! returns index of tYear in the list of Years integer :: index_to_year character (len=MAX_LEN_TEXT_YEAR), intent (in) :: tYear - integer :: i - index_to_year = 0 + integer :: i, idx + + idx = 0 do i=1,17 if (tYear==txtYear(i)) then - index_to_year = i + idx = i exit end if end do - if (index_to_year>9) index_to_year =index_to_year-9 - return + if (idx>9) idx = idx-9 + index_to_year = idx + + end function index_to_year @@ -118,7 +121,7 @@ function text_time_period(startime, endtime) !call file_log_message('Error in time index. Aborting...') !stop end if - return + end function text_time_period @@ -134,7 +137,7 @@ function index_to_time(tTime) end if end do index_to_time = hdx - return + end function index_to_time @@ -153,7 +156,7 @@ function index_to_term (tTerm) end do if (index_to_term>6) index_to_term = index_to_term - 3 if (index_to_term>3) index_to_term = index_to_term - 3 - return + end function index_to_term @@ -165,7 +168,7 @@ subroutine rank_to_year_term (rank, Year, Term) integer, intent(out) :: Year, Term Year = (rank+2)/3 Term = rank-3*(Year-1) - return + end subroutine rank_to_year_term @@ -186,7 +189,7 @@ subroutine qualify_term (plusCurrent, Year, Term, description) else description = 'Summer Term, '//text_school_year(Year) end if - return + end subroutine qualify_term @@ -216,7 +219,7 @@ function text_term_offered (num) if (i==1) term = '1'//term text_term_offered = term - return + end function text_term_offered @@ -252,7 +255,7 @@ function text_term_offered_separated (num) text_term_offered_separated = term - return + end function text_term_offered_separated @@ -264,7 +267,7 @@ function text_school_year (year) text_school_year = 'SY '//trim(itoa(year))//dash//itoa2bz(mod(year+1,1000)) - return + end function text_school_year diff --git a/TIMETABLES.F90 b/TIMETABLES.F90 index 8cacea6..0affdfe 100644 --- a/TIMETABLES.F90 +++ b/TIMETABLES.F90 @@ -57,7 +57,7 @@ subroutine timetable_clear(TimeTable) TimeTable = 0 TimeTable(59,1:6) = 60 ! earliest time TimeTable(60,1:6) = 1 ! latest time - return + end subroutine timetable_clear @@ -83,7 +83,7 @@ function is_conflict_timetable_with_section(NumSections, Section, sect, TimeTabl end do end do loop_meets end if - return + end function is_conflict_timetable_with_section @@ -130,7 +130,7 @@ subroutine timetable_add_section(NumSections, Section, sect, TimeTable, loc) else if (sect<0) then write(unitLOG,*) 'Invalid section', sect, ' in timetable_add_section(); called from', loc end if - return + end subroutine timetable_add_section @@ -157,7 +157,7 @@ function is_conflict_timetable_with_section_meetings(NumSections, Section, sect, end do end do loop_meets end if - return + end function is_conflict_timetable_with_section_meetings @@ -199,7 +199,7 @@ subroutine timetable_add_meetings_of_section(NumSections, Section, sect, n_meeti TimeTable(60,jdx) = Section(sect)%eTimeIdx(mdx) end if end do - return + end subroutine timetable_add_meetings_of_section @@ -222,7 +222,7 @@ function is_conflict_timetable_with_struct_section(Section, m_first, m_last, Tim end if end do end do loop_meets - return + end function is_conflict_timetable_with_struct_section @@ -258,7 +258,7 @@ subroutine timetable_add_struct_section(Section, TimeTable, loc) TimeTable(60,jdx) = Section%eTimeIdx(mdx) end if end do - return + end subroutine timetable_add_struct_section @@ -303,7 +303,7 @@ subroutine timetable_remove_section(NumSections, Section, sect, TimeTable, loc) TimeTable(60,jdx) = idx end do end if - return + end subroutine timetable_remove_section @@ -336,7 +336,7 @@ function is_consistent_section_hours_with_subject_defn(tSection) SectionHours = Subject(idx)%LabHours end if is_consistent_section_hours_with_subject_defn = 4.0*SectionHours==n15 - return + end function is_consistent_section_hours_with_subject_defn @@ -371,7 +371,7 @@ function is_conflict_free_section_hours(tSection, NumSections, Section) end if end if is_conflict_free_section_hours = tDetermination - return + end function is_conflict_free_section_hours @@ -504,7 +504,7 @@ subroutine sections_compound(NumSections, Section, nconflicts, ignoreMismatch) if (.not. ignore) nconflicts = nconflicts + 1 end if end do - return + end subroutine sections_compound @@ -522,7 +522,7 @@ subroutine meetings_of_section_by_teacher(NumSections, Section, section_index, t meetings(n_meetings) = i end if end do - return + end subroutine meetings_of_section_by_teacher @@ -540,7 +540,7 @@ subroutine meetings_of_section_in_room(NumSections, Section, section_index, room meetings(n_meetings) = i end if end do - return + end subroutine meetings_of_section_in_room @@ -553,6 +553,7 @@ subroutine timetable_meetings_of_teacher(NumSections, Section, teacher_index, to logical, intent(out) :: conflicted integer :: n_meetings, meetings(MAX_SECTION_MEETINGS) integer :: idx, conflict_loc, sdx + len_list = 0 ! initialize list call timetable_clear(TimeTable) ! initialize weekly schedule conflicted = .false. @@ -579,7 +580,8 @@ subroutine timetable_meetings_of_teacher(NumSections, Section, teacher_index, to list(len_list+1) = 0 list(len_list+2) = 0 list(len_list+3) = 0 - return + + end subroutine timetable_meetings_of_teacher @@ -618,7 +620,7 @@ subroutine timetable_meetings_in_room(NumSections, Section, room_index, to_skip, list(len_list+1) = 0 list(len_list+2) = 0 list(len_list+3) = 0 - return + end subroutine timetable_meetings_in_room @@ -772,7 +774,7 @@ subroutine timetable_undesirability(ns, NumSections, Section, TimeTable) end if end do end do - return + end subroutine timetable_undesirability end module TIMETABLES diff --git a/UNIVERSITY.F90 b/UNIVERSITY.F90 index 1c29c3f..7e74f44 100644 --- a/UNIVERSITY.F90 +++ b/UNIVERSITY.F90 @@ -95,7 +95,7 @@ subroutine read_university(path, errNo) ! write the UNIVERSITY file in XML? if (noXML) call xml_write_university(path) - return + end subroutine read_university @@ -105,7 +105,7 @@ subroutine xml_read_university(path, errNo) integer, intent (out) :: errNo ! open file, return on any error - fileName = trim(dirXML)//trim(path)//'UNIVERSITY.XML' + fileName = trim(dirDATA)//trim(path)//'UNIVERSITY.XML' call xml_open_file(unitXML, XML_ROOT_UNIVERSITY, fileName, errNo, forReading) if (errNo/=0) return @@ -156,7 +156,7 @@ subroutine xml_read_university(path, errNo) call xml_close_file(unitXML) call file_log_message(trim(UniversityName)//' @ '//UniversityAddress) - return + end subroutine xml_read_university @@ -171,7 +171,7 @@ subroutine xml_write_university(path, dirOPT) if (present(dirOPT)) then fileName = trim(dirOPT)//trim(path)//'UNIVERSITY.XML' else - fileName = trim(dirXML)//trim(path)//'UNIVERSITY.XML' + fileName = trim(dirDATA)//trim(path)//'UNIVERSITY.XML' endif call xml_open_file(unitXML, XML_ROOT_UNIVERSITY, fileName, eof) @@ -193,7 +193,7 @@ subroutine xml_write_university(path, dirOPT) call xml_close_file(unitXML, XML_ROOT_UNIVERSITY) - return + end subroutine xml_write_university diff --git a/WAIVERS.F90 b/WAIVERS.F90 index 19b35a4..7929599 100644 --- a/WAIVERS.F90 +++ b/WAIVERS.F90 @@ -55,7 +55,7 @@ module WAIVERS subroutine initialize_waiver(W) type (TYPE_WAIVER) :: W W = TYPE_WAIVER (0, 0, 0) - return + end subroutine initialize_waiver @@ -73,7 +73,7 @@ subroutine xml_write_waivers(path, Section, dirOPT) if (present(dirOPT)) then fileName = trim(dirOPT)//trim(path)//'WAIVER-COI.XML' else - fileName = trim(dirXML)//trim(path)//'WAIVER-COI.XML' + fileName = trim(dirDATA)//trim(path)//'WAIVER-COI.XML' endif call xml_open_file(unitXML, XML_ROOT_WAIVERS, fileName, eof) write(unitXML,AFORMAT) & @@ -103,7 +103,7 @@ subroutine xml_write_waivers(path, Section, dirOPT) ! close file call xml_close_file(unitXML, XML_ROOT_WAIVERS) - return + end subroutine xml_write_waivers @@ -124,7 +124,7 @@ subroutine xml_read_waivers(path, NumSections, Section, numEntries, errNo) numEntries = 0 ! open file, return on any error - fileName = trim(dirXML)//trim(path)//'WAIVER-COI.XML' + fileName = trim(dirDATA)//trim(path)//'WAIVER-COI.XML' call xml_open_file(unitXML, XML_ROOT_WAIVERS, fileName, errNo, forReading) if (errNo/=0) return @@ -200,7 +200,7 @@ subroutine xml_read_waivers(path, NumSections, Section, numEntries, errNo) call xml_close_file(unitXML) call file_log_message (itoa(numEntries)//' entries in '//fileName) - return + end subroutine xml_read_waivers @@ -222,7 +222,7 @@ subroutine read_waivers(path, NumSections, Section, Offering, numEntries, errNo) call xml_read_waivers(path, NumSections, Section, numEntries, ierr) noXML = numEntries==0 if (numEntries==0) then ! no XML entries - call custom_read_waivers (trim(dirRAW)//trim(path)//'WAIVER-COI', & + call custom_read_waivers (trim(dirDATA)//trim(path)//'WAIVER-COI', & NumSections, Section, Offering, WaiverCOI, numEntries, ierr) end if @@ -230,7 +230,7 @@ subroutine read_waivers(path, NumSections, Section, Offering, numEntries, errNo) call xml_write_waivers(path, Section) end if - return + end subroutine read_waivers @@ -357,7 +357,7 @@ subroutine custom_read_waivers (filePath, NumSections, Section, Offering, cList, numEntries = numEntries + 1 end do loop_waiver close(unitRAW) - return + end subroutine custom_read_waivers diff --git a/WEBSERVER.F90 b/WEBSERVER.F90 index c6adc7a..a2dc05c 100644 --- a/WEBSERVER.F90 +++ b/WEBSERVER.F90 @@ -69,12 +69,12 @@ subroutine server_start() #else QUERY_put = trim(QUERY_put)//':82' #endif - CGI_PATH = 'http://'//trim(QUERY_put)//FSLASH//trim(UniversityCode)//FSLASH//ACTION + CGI_PATH = 'http://'//trim(QUERY_put)//FSLASH//ACTION call html_login('Stop-'//trim(UniversityCode)//DASH//trim(ACTION)//'.html', & - trim(make_href(fnStop, 'Stop', post=nbsp//trim(UniversityCode)//FSLASH//ACTION))) + trim(make_href(fnStop, 'Stop', post=nbsp//ACTION) ) ) ! reset CGI_PATH - CGI_PATH = FSLASH//trim(UniversityCode)//FSLASH//ACTION + CGI_PATH = FSLASH//ACTION ! notes call file_log_message(trim(fileExecutable)//' started '//ACTION) @@ -137,7 +137,7 @@ subroutine server_start() ! open user's log file, create if necessary call blank_to_underscore(USERNAME, tTeacher) - logTeacher = trim(dirLOG)//trim(tTeacher)//'.log' + logTeacher = trim(dirBACKUP)//trim(tTeacher)//'.log' inquire(file=trim(logTeacher), exist=logExists) if (.not. logExists) then open(unit=unitUSER, file=trim(logTeacher), status='new') @@ -153,10 +153,8 @@ subroutine server_start() write(unitUSER,AFORMAT) trim(cipher) write(unitREQ, AFORMAT) trim(cipher) end if -#if defined PRODUCTION -#else - write(unitHTML,AFORMAT) '' -#endif + + call html_comment(fnDescription(REQUEST)) ! compose response call server_respond(unitHTML) @@ -178,8 +176,6 @@ subroutine server_start() ! terminate call terminate(trim(fileExecutable)//' completed '//ACTION) - return - end subroutine server_start @@ -188,10 +184,8 @@ subroutine server_respond (device) integer :: tYear, tTerm -#if defined PRODUCTION -#else - write(unitHTML,AFORMAT) '' -#endif + call html_comment('server_respond()') + ! target directory if files are to be modified if (targetTerm>0) then if (targetTerm'//endtd//endtr, & ! curriculum begintr//begintd//'Curriculum:'//endtd//begintd//'

    ', & '
    ' - return end subroutine student_prompt_add @@ -546,7 +539,7 @@ subroutine student_add(device) targetStudent = index_to_student(tStdNo) call html_college_links(device, CollegeIdxUser, 'Added '//trim(text_student_info(targetStudent))) - return + end subroutine student_add @@ -650,7 +643,6 @@ subroutine get_user_request() end if end if - return end subroutine get_user_request @@ -664,10 +656,10 @@ subroutine download_xml(device) call cgi_get_named_string(QUERY_STRING, 'A1', XMLfile, ierr) - fileName = trim(dirXML)//trim(pathToYear)//XMLfile + fileName = trim(dirDATA)//trim(pathToYear)//XMLfile inquire(file=fileName, exist=fileExists) if (.not. fileExists) then - fileName = trim(dirXML)//trim(pathToTerm)//XMLfile + fileName = trim(dirDATA)//trim(pathToTerm)//XMLfile inquire(file=fileName, exist=fileExists) end if if (fileExists) then @@ -688,7 +680,6 @@ subroutine download_xml(device) REQUEST = 0 end if - return end subroutine download_xml @@ -706,7 +697,7 @@ subroutine execute_log() DOCUMENT_URI = SPACE ! reset CGI_PATH - CGI_PATH = FSLASH//trim(UniversityCode)//FSLASH//ACTION + CGI_PATH = FSLASH//trim(ACTION)//FSLASH//UniversityCode ! notes call file_log_message(trim(fileExecutable)//' started '//ACTION//' execute_log()') @@ -762,7 +753,7 @@ subroutine execute_log() ! open user's log file, create if necessary call blank_to_underscore(USERNAME, tTeacher) - logTeacher = trim(dirLOG)//trim(tTeacher)//'.log' + logTeacher = trim(dirBACKUP)//trim(tTeacher)//'.log' inquire(file=trim(logTeacher), exist=logExists) if (.not. logExists) then open(unit=unitUSER, file=trim(logTeacher), status='new') @@ -778,10 +769,8 @@ subroutine execute_log() write(unitUSER,AFORMAT) trim(cipher) write(unitREQ, AFORMAT) trim(cipher) end if -#if defined PRODUCTION -#else - write(unitHTML,AFORMAT) '' -#endif + + call html_comment(fnDescription(REQUEST)) ! compose response call server_respond(unitHTML) @@ -802,9 +791,354 @@ subroutine execute_log() ! terminate call terminate(trim(fileExecutable)//' completed '//ACTION) - return - end subroutine execute_log + subroutine rename_university() + + character (len=MAX_LEN_SUBJECT_CODE) :: tSubject + character (len=MAX_LEN_CURRICULUM_CODE) :: tCurriculum + character (len=MAX_LEN_FILE_PATH) :: dataSource + !character(len=MAX_LEN_STUDENT_CODE) :: tStdNo + real :: harvest + integer :: iTmp, jTmp, kTmp, lTmp, errNo + + ! read schedules + do kTmp=termBegin,termEnd + call qualify_term (kTmp, iTmp, jTmp, dataSource) + pathToTerm = trim(itoa(iTmp))//DIRSEP//trim(txtSemester(jTmp))//DIRSEP + ! read the classes + call read_classes(pathToTerm, NumSections(jTmp), Section(jTmp,0:), & + Offering(jTmp,MAX_ALL_DUMMY_SUBJECTS:), errNo) + ! read the blocks + call read_blocks(pathToTerm, NumBlocks(jTmp), Block(jTmp,0:), NumSections(jTmp), Section(jTmp,0:), errNo) + ! get no. of sections by dept + call count_sections_by_dept(jTmp, NumSections(jTmp), Section(jTmp,0:)) + end do + + ! student records + do iTmp = 1,NumStudents + if (mod(iTmp,1000) == 0) then + write(*,*) trim(itoa(iTmp))//' / '//itoa(NumStudents)//' done reading ...' + end if + TCG = TYPE_STUDENT_RECORD (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, .false., SPACE, SPACE) + lenTCG = 0 + call custom_read_substitutions (iTmp) + call custom_read_student_grades (iTmp) + end do + + ! read waivers for next term + pathToTerm = trim(pathToNextYear)//trim(txtSemester(nextTerm))//DIRSEP + call read_waivers(pathToTerm, NumSections(nextTerm), Section(nextTerm,0:), & + Offering(nextTerm,MAX_ALL_DUMMY_SUBJECTS:), NumWaiverRecords, errNo) + + ! read predictions for next term + call read_predictions(pathToTerm, NumSections(nextTerm), Section(nextTerm,0:), & + Advised, NumPredictionRecords, errNo) + + ! read enlistment files (if any) + call read_pre_enlistment(pathToTerm, 'ENLISTMENT', 0, 6, & + NumSections(nextTerm), Section(nextTerm,0:), Preenlisted, NumEnlistmentRecords, errNo) + + ! rename University + UniversityName = 'DEMO University' + UniversityAddress = '(University Address)' + UniversityPresident = 'Firstname MI. Lastname, Ph.D.' + DeanOfInstruction = 'Firstname MI. Lastname, Ph.D.' + VPAcademicAffairs = 'Firstname MI. Lastname, Ph.D.' + DeanOfCampus = 'Firstname MI. Lastname, Ph.D.' + REGISTRAR = 'Registrar' + call xml_write_university(pathToYear) + +! ! rename colleges +! do jTmp=1,NumColleges-1 +! College(jTmp)%Code = 'COLL'//itoa2bz(jTmp) +! College(jTmp)%Name = 'College '//itoa2bz(jTmp) +! College(jTmp)%Dean = 'Dean of College '//itoa2bz(jTmp) +! end do + jTmp = NumColleges + College(jTmp)%Code = ADMINISTRATION + College(jTmp)%Name = trim(UniversityName)//SPACE//ADMINISTRATION + College(jTmp)%Dean = VPAcademicAffairs + call xml_write_colleges(pathToYear) + +! ! rename departments +! do iTmp=2,NumDepartments-1 +! Department(iTmp)%Code = 'DEPT'//itoa2bz(iTmp) +! Department(iTmp)%Name = 'Department '//itoa2bz(iTmp)//' in '//College(Department(iTmp)%CollegeIdx)%Name +! end do + iTmp = NumDepartments + REGISTRAR = 'Registrar' + Department(iTmp)%Code = 'Registrar' + Department(iTmp)%Name = trim(UniversityName)//SPACE//REGISTRAR + Department(iTmp)%SectionPrefix = SPACE + call xml_write_departments(pathToYear) + + ! rename rooms + do jTmp=1,NumDepartments + kTmp = 0 + do iTmp=1,NumRooms+NumAdditionalRooms + if (jTmp/=Room(iTmp)%DeptIdx) cycle + kTmp = kTmp + 1 + Room(iTmp)%Code = trim(Department(jTmp)%Code)//' Rm'//itoa2bz(kTmp) + end do + end do + call xml_write_rooms(pathToYear) + +! ! rename teachers +! do jTmp=1,NumDepartments +! kTmp = 0 +! do iTmp=1,NumTeachers+NumAdditionalTeachers +! if (jTmp/=Teacher(iTmp)%DeptIdx) cycle +! kTmp = kTmp + 1 +! Teacher(iTmp)%TeacherID = 'T'//itoa2bz(kTmp)//'D'//itoa2bz(jTmp) +! Teacher(iTmp)%Name = itoa2bz(kTmp)//'TeacherID in '//Department(jTmp)%Code +! end do +! end do + + ! rename subjects + tSubject(1:) = 'X' + iTmp = 0 ! area number + kTmp = 0 ! topic number in area + do jTmp=1,NumSubjects + errNo = index(Subject(jTmp)%Name, SPACE) + if (tSubject(:errNo)==Subject(jTmp)%Name(:errNo)) then ! same as previous area + kTmp = kTmp + 1 + else ! new area + iTmp = iTmp+1 + kTmp = 1 + tSubject = Subject(jTmp)%Name(:errNo) + end if + Subject(jTmp)%Name = Subject(jTmp)%Name(:errNo)//itoa3bz(kTmp) + !Subject(jTmp)%Name = 'A'//itoa3bz(iTmp)//SPACE//itoa3bz(kTmp) + !Subject(jTmp)%Title = 'Subject area '//itoa3bz(iTmp)//', Topic '//itoa3bz(kTmp) + end do + + iTmp = 0 ! area number for (Must be in Plan Of Study) + kTmp = 0 ! topic number in area + do jTmp=NumDummySubjects,0 + if (trim(Subject(jTmp)%Title)/='(Must be in Plan Of Study)') cycle + kTmp = kTmp + 1 + Subject(jTmp)%Name = 'ELEC '//itoa3bz(kTmp) + Subject(jTmp)%Title = 'Elective type '//itoa3bz(kTmp)//' - Must be in Plan Of Study ' + end do + call xml_write_subjects(pathToYear) + + ! rename curricular programs + done = .false. + lTmp = 0 + do jTmp=1,NumCurricula + if (done(jTmp)) cycle + lTmp = lTmp+1 + kTmp = 0 + tCurriculum = CurrProgCode(jTmp) + do iTmp=jTmp,NumCurricula + if (CurrProgCode(iTmp)/=tCurriculum) cycle + kTmp = kTmp+1 +! Curriculum(iTmp)%Code = 'P'//itoa3bz(lTmp)//DASH//'V'//itoa2bz(kTmp) +! Curriculum(iTmp)%Title = 'Program '//itoa3bz(lTmp) +! Curriculum(iTmp)%Specialization = 'Variant '//itoa2bz(kTmp) +! Curriculum(iTmp)%Remark = SPACE +! CurrProgCode(iTmp) = 'P'//itoa3bz(lTmp) + Curriculum(iTmp)%Code = trim(CurrProgCode(iTmp))//'-V'//itoa2bz(kTmp) + done(iTmp) = .true. + end do + end do + call xml_write_curricula(pathToYear) + call xml_write_equivalencies(pathToYear) + + ! rewrite classes + do kTmp=termBegin,termEnd + call qualify_term (kTmp, iTmp, jTmp, dataSource) + pathToTerm = trim(itoa(iTmp))//DIRSEP//trim(txtSemester(jTmp))//DIRSEP + call xml_write_sections(pathToTerm, NumSections(jTmp), Section(jTmp,0:), 0) + call xml_write_blocks(pathToTerm, NumBlocks(jTmp), Block(jTmp,0:), Section(jTmp,0:), 0) + end do + + pathToTerm = trim(pathToNextYear)//trim(txtSemester(nextTerm))//DIRSEP + ! rewrite waivers for next term + call xml_write_waivers(pathToTerm, Section(nextTerm,0:) ) + ! rewrite predictions for next term + call xml_write_pre_enlistment(pathToTerm, 'PREDICTIONS', Advised, Section(nextTerm,0:) ) + ! rewrite enlistment for next term + call xml_write_pre_enlistment(pathToTerm, 'ENLISTMENT', Preenlisted, Section(nextTerm,0:) ) + + ! ! rename student + ! tArray = 0 ! count for each curriculum + ! do lTmp = 1,NumStudents + ! kTmp = Student(lTmp)%CurriculumIdx + ! iTmp = tArray(kTmp)+1 + ! tArray(kTmp) = iTmp + ! Student(lTmp)%StdNo = Student(lTmp)%StdNo(:5)//itoa3bz(kTmp)//DASH//itoa3bz(iTmp)//'0' + ! Student(lTmp)%Name = itoa3bz(iTmp)//'Student of Program '//trim(Curriculum(kTmp)%Code) + ! end do + call xml_write_students(pathToYear, 0) + do lTmp = 1,NumStudents + if (mod(lTmp,1000) == 0) then + write(*,*) trim(itoa(lTmp))//' / '//itoa(NumStudents)//' done writing...' + end if + + ! generate random passing grades + do iTmp=1,Student(lTmp)%Record(1,0) + if (Student(lTmp)%Record(4,iTmp)<=0) cycle + jTmp = Student(lTmp)%Record(5,iTmp) + kTmp = jTmp + if (jTmp>0 .and. jTmp<10) then ! numeric pass + do while (kTmp==jTmp .or. kTmp==0) + call random_number(harvest) + kTmp = int(harvest*10.0) + end do + end if + Student(lTmp)%Record(5,iTmp) = kTmp + end do + call xml_write_student_grades(lTmp) + + call xml_write_substitutions(lTmp) + end do + + ! teachers + call regenerate_all_passwords() + call xml_write_teachers(pathToYear) + call write_password_file(pathToYear) + + end subroutine rename_university + + + subroutine add_data_from_enlistment(path, basename, NumSections, Section) + character(len=*), intent(in) :: path, basename + integer, intent (in out) :: NumSections + type (TYPE_SECTION), intent(in out) :: Section(0:) + + character (len=MAX_LEN_STUDENT_CODE) :: tStdNo + character (len=MAX_LEN_SUBJECT_CODE) :: tSubject + character (len=MAX_LEN_CLASS_ID) :: tSection + character(len=MAX_LEN_CURRICULUM_CODE) :: tCurriculum + integer :: cdx, k, sdx, std, ier, nSubj, nSect, nStd + type (TYPE_STUDENT) :: wrk + + character (len=MAX_LEN_FILE_PATH) :: fileName + character (len=MAX_LEN_XML_LINE) :: line + integer :: eof, ndels, pos(60) + + fileName = trim(dirDATA)//trim(path)//basename//'.CSV' + open(unit=unitRAW, file=fileName, form='formatted', status='old', iostat=ier) + if (ier/=0) return + + call file_log_message ('Retrieving additional info from '//fileName) + + nSubj = 0 + nSect =0 + nStd = 0 + + loop_ENLISTMENT : & + do + read (unitRAW, AFORMAT, iostat = eof) line + if (eof<0) exit loop_ENLISTMENT + if (line(1:1)=='#' .or. line(1:3)==' ') cycle loop_ENLISTMENT + + !#STUDNO,SUBJECT CODE,CLASS CODE,SutdName,Course,TERM,COLLEGE,TEACHER,SECTION + !1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 + !08-09517,EM 218,G007,"Abbariao, Cristopher Adolfo",MAED-SS,13-S,GS,To Be Assigned,GS + !08-09517,MA 204,G022,"Abbariao, Cristopher Adolfo",MAED-SS,13-S,GS,To Be Assigned,GS + !08-09517,SOC SCI 218A,G052,"Abbariao, Cristopher Adolfo",MAED-SS,13-S,GS,To Be Assigned,GS + !08-09517,SS 217,G053,"Abbariao, Cristopher Adolfo",MAED-SS,13-S,GS,To Be Assigned,GS + !06-00593,BA 72,B120,"Accad, Leonard Andrew Bramaje",BSENT,13-S,CBEA,"Gonzaga, Jeremiah",BSENT-3C + !06-00593,BA 66,B128,"Accad, Leonard Andrew Bramaje",BSENT,13-S,CBEA,"Singson, Marcial",BSENT-3C + !08-02956,ENG 13,E028,"Adviento, Baby Jane Concepcion",BSED-FIL,13-S,CTE,"Clemente, Beatriz",BSED 1K + ! + call index_to_delimiters(COMMA, line, ndels, pos) + + ! subject + tSubject = line(pos(2)+1:pos(3)-1) + cdx = index_to_subject(tSubject) + if (cdx<=0) then ! add it + NumAdditionalSubjects = NumAdditionalSubjects+1 + cdx = NumSubjects + NumAdditionalSubjects + + Subject(cdx)%Name = tSubject + Subject(cdx)%Title = tSubject + Subject(cdx)%DeptIdx = NumDepartments + Subject(cdx)%Units = 3.0 + + Subject(cdx)%TermOffered = 7 + Subject(cdx)%LectHours = 3.0 + Subject(cdx)%MinLectSize = 50 + Subject(cdx)%MaxLectSize = 50 + Subject(cdx)%LectLoad = 0.0 + Subject(cdx)%LabHours = 0.0 + Subject(cdx)%MinLabSize = 50 + Subject(cdx)%MaxLabSize = 50 + Subject(cdx)%LabLoad = 0.0 + + k = 1 + Subject(cdx)%lenPreq = k + Subject(cdx)%Prerequisite(k) = INDEX_TO_NONE + Subject(cdx)%lenCoreq = k + Subject(cdx)%Corequisite = INDEX_TO_NONE + Subject(cdx)%lenConc = k + Subject(cdx)%Concurrent = INDEX_TO_NONE + Subject(cdx)%lenConcPreq = k + Subject(cdx)%ConcPrerequisite= INDEX_TO_NONE + + Subject(cdx)%LabFee = 0.0 + Subject(cdx)%Tuition = 0.0 + + nSubj = nSubj + 1 + call file_log_message ('Added subject '//tSubject) + + end if + + ! section + tSection = trim(tSubject)//SPACE//line(pos(3)+1:pos(4)-1) + sdx = index_to_section(tSection, NumSections, Section) + if (sdx==0 .and. (pos(3)+1/=pos(4)) ) then + do k=1,NumDepartments + if (Department(k)%SectionPrefix==line(poS(3)+1:pos(3)+1) ) exit + end do + NumSections = NumSections+1 + Section(NumSections) = TYPE_SECTION (tSection, line(pos(3)+1:pos(4)-1), SPACE, & + k, cdx, Subject(cdx)%MaxLectSize, Subject(cdx)%MaxLectSize, 1, 0, 0, 0, 0, 0) + nSect = nSect + 1 + call file_log_message ('Added section '//tSection) + end if + + ! student + tStdNo = line(1:pos(2)-1) + std = index_to_student(tStdNo) + if (std==0) then + !#STUDNO,SUBJECT CODE,CLASS CODE,SutdName,Course,TERM,COLLEGE,TEACHER,SECTION + !1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 + !08-09517,EM 218,G007,"Abbariao, Cristopher Adolfo",MAED-SS,13-S,GS,To Be Assigned,GS + !08-09517,MA 204,G022,"Abbariao, Cristopher Adolfo",MAED-SS,13-S,GS,To Be Assigned,GS + k = index(line, '",') + call initialize_student(wrk) + wrk%StdNo = tStdNo + wrk%Name = line(pos(4)+2:k-1) + tCurriculum = line(k+2:) + k = index(tCurriculum, COMMA) + tCurriculum(k:) = SPACE + k = index_to_curriculum(tCurriculum) + if (k<0) then + k = -k + elseif (k==0) then + k = NumCurricula + end if + wrk%CurriculumIdx = k + call update_student_info(wrk, k) + if (k<0) call file_log_message ('Added '//tStdNo//trim(tCurriculum)//' - '// & + trim(text_student_curriculum(-k)) ) + nStd = nStd + 1 + + end if + + end do loop_ENLISTMENT + close(unitRAW) + + if (nSubj>0) call xml_write_subjects(pathToYear) + if (nSect>0) call xml_write_sections(path, NumSections, Section, 0) + if (nStd>0) call xml_write_students(pathToYear, 0) + + end subroutine add_data_from_enlistment + + end module WEBSERVER diff --git a/XML.F90 b/XML.F90 index de7740b..bfc57ff 100644 --- a/XML.F90 +++ b/XML.F90 @@ -52,7 +52,6 @@ module XML character(len=21), parameter :: XML_ROOT_EQUIVALENCIES = 'LIST_OF_EQUIVALENCIES' character(len=14), parameter :: XML_ROOT_BLOCKS = 'LIST_OF_BLOCKS' character(len=16), parameter :: XML_ROOT_STUDENTS = 'LIST_OF_STUDENTS' - character(len=13), parameter :: XML_ROOT_LOGIN = 'LIST_OF_LOGINS' character(len=11), parameter :: XML_ROOT_PREDICTIONS = 'PREDICTIONS' character(len=11), parameter :: XML_ROOT_WAIVERS = 'WAIVERS_COI' character(len=10), parameter :: XML_ROOT_ENLISTMENT = 'ENLISTMENT' @@ -128,7 +127,7 @@ subroutine xml_open_file(device, rootName, fileName, errNo, readOnly) end if end if end if - return + end subroutine xml_open_file @@ -137,7 +136,7 @@ subroutine xml_close_file(device, rootName) character (len=*), intent (in), optional :: rootName if (present(rootName)) write(device,AFORMAT) '' close(device) - return + end subroutine xml_close_file @@ -160,7 +159,7 @@ subroutine xml_write_character(device, indent, tag, value) else write(device, AFORMAT) indentation(:indent)//'<'//trim(tag)//'>' end if - return + end subroutine xml_write_character @@ -169,7 +168,7 @@ subroutine xml_write_integer(device, indent, tag, value) character (len=*), intent (in) :: tag integer, intent (in) :: value call xml_write_character(device, indent, tag, itoa(value)) - return + end subroutine xml_write_integer @@ -180,7 +179,7 @@ subroutine xml_write_float(device, indent, tag, value, dadp) integer, intent (in), optional :: dadp call xml_write_character(device, indent, tag, ftoa(value,dadp)) - return + end subroutine xml_write_float @@ -230,65 +229,65 @@ subroutine xml_parse_line(line, tag, value, errNo) value = line(pos(1,2)+1:pos(2,1)-1) end if - return - end subroutine xml_parse_line - - - subroutine pma_xml_begin_row(device, indent, name) - integer, intent (in) :: device, indent - character (len=*), intent (in) :: name - write(device, AFORMAT) indentation(:indent)//'' - return - end subroutine pma_xml_begin_row - - subroutine pma_xml_end_row(device, indent) - integer, intent (in) :: device, indent - write(device, AFORMAT) indentation(:indent)//'
    ' - return - end subroutine pma_xml_end_row - - subroutine pma_xml_column(device, indent, tag, value) - integer, intent (in) :: device, indent - character (len=*), intent (in) :: tag, value - if (len_trim(value)>0) then - write(device, AFORMAT) indentation(:indent)// & - ''//trim(value)//'' - else - write(device, AFORMAT) indentation(:indent)// & - '('//tag//')' - end if - return - end subroutine pma_xml_column + end subroutine xml_parse_line - subroutine pma_xml_parse_line(line, name, value) - character(len=MAX_LEN_XML_LINE), intent (in out) :: line - character(len=MAX_LEN_XML_TAG), intent (out) :: name - character(len=MAX_LEN_XML_LINE), intent (out) :: value - ! locals - integer :: nL, nR ! positions of "> and ' +! +! end subroutine pma_xml_begin_row +! +! subroutine pma_xml_end_row(device, indent) +! integer, intent (in) :: device, indent +! write(device, AFORMAT) indentation(:indent)//'' +! +! end subroutine pma_xml_end_row +! +! subroutine pma_xml_column(device, indent, tag, value) +! integer, intent (in) :: device, indent +! character (len=*), intent (in) :: tag, value +! if (len_trim(value)>0) then +! write(device, AFORMAT) indentation(:indent)// & +! ''//trim(value)//'' +! else +! write(device, AFORMAT) indentation(:indent)// & +! '('//tag//')' +! end if +! +! end subroutine pma_xml_column +! +! +! subroutine pma_xml_parse_line(line, name, value) +! character(len=MAX_LEN_XML_LINE), intent (in out) :: line +! character(len=MAX_LEN_XML_TAG), intent (out) :: name +! character(len=MAX_LEN_XML_LINE), intent (out) :: value +! ! locals +! integer :: nL, nR ! positions of "> and !value !1234567890123456 ! - if (index(line, '') ! end of name - nR = index(line, ' 0) then ! start of row - name = line(14:len_trim(line)-2) - elseif (index(line, '') > 0) then ! end of row - name = '/table' - end if - - return - end subroutine pma_xml_parse_line +! if (index(line, '') ! end of name +! nR = index(line, ' 0) then ! start of row +! name = line(14:len_trim(line)-2) +! elseif (index(line, '') > 0) then ! end of row +! name = '/table' +! end if +! +! +! end subroutine pma_xml_parse_line end module XML