%μ VAX-11 Librarian V03-00 ›*£Ε“‹ΰοpΚ“‹”J• Ζ ΐADDQUOTADECLARE ζDFTQUOTA$”HLPQUOTA(ςINTQUOTA7ΆIOSQUOTA=VLISQUOTARΤMADQUOTAmΈMODQUOTAuœRMVQUOTA}¬SHOQUOTAUPDATE†ώUPDQUOTA­‚¨Ε“‹cAc *************************************************************** c * *c * QUOTA declarations * c * *Ac ***************************************************************c common /control_c/control_c* logical*4 control_c ! CONTROL-C interrupt external CANCELc/ common /units/input,output,command,update,list+ integer*4 input,output,command,update,listc common /modify/modified,modify logical*4 modified integer*4 modifyc character*9 commands(8) data commands(1)/'ADD'/ data commands(2)/'DEFAULT'/ data commands(3)/'EXIT'/ data commands(4)/'HELP'/ data commands(5)/'MODIFY'/ data commands(6)/'REMOVE'/ data commands(7)/'SHOW'/* data commands(8)/'LIST'/ ! show aliasc logical*4 continue integer*4 length,status,error integer*4 TRIM character*9 SCAN,word character*80 msg,range,linec" include 'LIB:QUOTA(UPDATE)/list'c common /copy$/ copy_default character*12 copy_defaultc common /mad/mad_ans integer*4 mad_ans(39)c" integer*4 mad_n/39/,mad_typ(2,39). integer*4 mad_pos(39)/39*0/,mad_siz(39)/39*0/ character*9 mad_key(2,39)' data mad_typ(1,1)/0/,mad_key(1,1)/' '/' data mad_typ(2,1)/0/,mad_key(2,1)/' '/) data mad_typ(1,2)/2/,mad_key(1,2)/'UIC'/' data mad_typ(2,2)/0/,mad_key(2,2)/' '/+ data mad_typ(1,3)/2/,mad_key(1,3)/'OWNER'/' data mad_typ(2,3)/0/,mad_key(2,3)/' '/- data mad_typ(1,4)/2/,mad_key(1,4)/'ADDRESS'/' data mad_typ(2,4)/0/,mad_key(2,4)/' '/+ dat a mad_typ(1,5)/2/,mad_key(1,5)/'BLDG#'/' data mad_typ(2,5)/0/,mad_key(2,5)/' '/, data mad_typ(1,6)/2/,mad_key(1,6)/'PHONE#'/' data mad_typ(2,6)/0/,mad_key(2,6)/' '/. data mad_typ(1,7)/2/,mad_key(1,7)/'COLLEGE#'/' data mad_typ(2,7)/0/,mad_key(2,7)/' '/+ data mad_typ(1,8)/2/,mad_key(1,8)/'DEPT#'/' data mad_typ(2,8)/0/,mad_key(2,8)/' '/. data mad_typ(1,9)/2/,mad_key(1,9)/'DEPTNAME'/' data mad_typ(2,9)/0/,mad_key(2,9)/' '/, data mad_typ(1,10)/2/,mad_key(1,10)/'MASK'/) data mad_typ(2,10)/ 0/,mad_key(2,10)/' '/. data mad_typ(1,11)/2/,mad_key(1,11)/'STATUS'/) data mad_typ(2,11)/0/,mad_key(2,11)/' '// data mad_typ(1,12)/2/,mad_key(1,12)/'ISUPRIV'/) data mad_typ(2,12)/0/,mad_key(2,12)/' '/- data mad_typ(1,13)/2/,mad_key(1,13)/'PKPLM'/) data mad_typ(2,13)/0/,mad_key(2,13)/' '/1 data mad_typ(1,14)/2/,mad_key(1,14)/'AUTHORIZE'/) data mad_typ(2,14)/0/,mad_key(2,14)/' '/. data mad_typ(1,15)/2/,mad_key(1,15)/'EXPIRE'/) data mad_typ(2,15)/0/,mad_key(2,15)/' '/- data mad_typ(1, 16)/2/,mad_key(1,16)/'LOGIN'/) data mad_typ(2,16)/0/,mad_key(2,16)/' '/. data mad_typ(1,17)/2/,mad_key(1,17)/'LOGOUT'/) data mad_typ(2,17)/0/,mad_key(2,17)/' '/. data mad_typ(1,18)/2/,mad_key(1,18)/'UPDATE'/) data mad_typ(2,18)/0/,mad_key(2,18)/' '/. data mad_typ(1,19)/2/,mad_key(1,19)/'NLOGIN'/) data mad_typ(2,19)/0/,mad_key(2,19)/' '// data mad_typ(1,20)/2/,mad_key(1,20)/'NLOGOUT'/) data mad_typ(2,20)/0/,mad_key(2,20)/' '/- data mad_typ(1,21)/1/,mad_key(1,21)/'QUOTA'/) data mad_ty p(2,21)/0/,mad_key(2,21)/' '/- data mad_typ(1,22)/1/,mad_key(1,22)/'COSTS'/) data mad_typ(2,22)/0/,mad_key(2,22)/' '/- data mad_typ(1,23)/1/,mad_key(1,23)/'USAGE'/) data mad_typ(2,23)/0/,mad_key(2,23)/' '// data mad_typ(1,24)/2/,mad_key(1,24)/'DOLLM '/) data mad_typ(2,24)/0/,mad_key(2,24)/' '// data mad_typ(1,25)/2/,mad_key(1,25)/'CPUTIME'/) data mad_typ(2,25)/0/,mad_key(2,25)/' '/- data mad_typ(1,26)/2/,mad_key(1,26)/'CPULM'/) data mad_typ(2,26)/0/,mad_key(2,26)/' '// data mad_ typ(1,27)/2/,mad_key(1,27)/'TRMTIME'/) data mad_typ(2,27)/0/,mad_key(2,27)/' '/- data mad_typ(1,28)/2/,mad_key(1,28)/'TRMLM'/) data mad_typ(2,28)/0/,mad_key(2,28)/' '/0 data mad_typ(1,29)/2/,mad_key(1,29)/'DSKSPACE'/) data mad_typ(2,29)/0/,mad_key(2,29)/' '/- data mad_typ(1,30)/2/,mad_key(1,30)/'DSKLM'/) data mad_typ(2,30)/0/,mad_key(2,30)/' '/0 data mad_typ(1,31)/2/,mad_key(1,31)/'PRTPAGES'/) data mad_typ(2,31)/0/,mad_key(2,31)/' '/- data mad_typ(1,32)/2/,mad_key(1,32)/'PRTLM'/) d ata mad_typ(2,32)/0/,mad_key(2,32)/' '/- data mad_typ(1,33)/2/,mad_key(1,33)/'NCSLM'/) data mad_typ(2,33)/0/,mad_key(2,33)/' '/- data mad_typ(1,34)/2/,mad_key(1,34)/'DIOS '/) data mad_typ(2,34)/0/,mad_key(2,34)/' '/0 data mad_typ(1,35)/2/,mad_key(1,35)/'SEMESTER'/) data mad_typ(2,35)/0/,mad_key(2,35)/' '/0 data mad_typ(1,36)/1/,mad_key(1,36)/'ACTIVATE'/) data mad_typ(2,36)/0/,mad_key(2,36)/' '/. data mad_typ(1,37)/1/,mad_key(1,37)/'CANCEL'/) data mad_typ(2,37)/0/,mad_key(2,37)/' '/,  data mad_typ(1,38)/2/,mad_key(1,38)/'COPY'/) data mad_typ(2,38)/0/,mad_key(2,38)/' '// data mad_typ(1,39)/0/,mad_key(1,39)/'FORWARD'/) data mad_typ(2,39)/0/,mad_key(2,39)/' '/c0 integer*4 sho_n/4/,sho_typ(2,4),sho_ans(4)/4*0/* integer*4 sho_pos(4)/4*0/,sho_siz(4)/4*0/ character*9 sho_key(2,4)' data sho_typ(1,1)/0/,sho_key(1,1)/' '/' data sho_typ(2,1)/0/,sho_key(2,1)/' '/* data sho_typ(1,2)/1/,sho_key(1,2)/'FULL'/+ data sho_typ(2,2)/1/,sho_key(2,2)/'BRIEF'/, data sho_typ(1,3)/2/,sho_key(1,3)/'OUTPUT'/' data sho_typ(2,3)/0/,sho_key(2,3)/' '/+ data sho_typ(1,4)/1/,sho_key(1,4)/'USAGE'/+ data sho_typ(2,4)/1/,sho_key(2,4)/'COSTS'/c- common /show/show_type,show_output,show_flag* integer*4 show_type,show_output,show_flagc common /show$/show_file character*80 show_filec1 format (1x,a,$)2 format (q,a)3 format (1x,a)cAc ***************************************************************cwwΊ« ώͺ¨Ε“‹ D005003 DECLAREΊ«€ά+«Ε“‹ D005003 UPDATEΊ«{ ΘΚ“‹  A005003 ADDQUOTADFTQUOTAHLPQUOTAINTQUOTAIOSQUOTALISQUOTAMADQUOTAMODQUOTARMVQUOTASHOQUOTAUPDQUOTA­ΰΩ—ͺΕ“‹cAc *************************************************************** c * *!c * Quota update definition * c * *Ac ***************************************************************c: common /update/update_member,update_group,update_purkeep,, 1 update_mask,update_status,update_isupriv, 2 update_login,update_nlogin, 3 update_logout,update_nlogout,* 4 update_quota,update_costs,update_usage," 5 update_authorize,update_expire, 6 update_create,update_update, 7 update_flagc% integer*2 update_member,update_group integer*2 update_purkeep3 integer*4 update_mask,update_status,update_isupriv' integer*4 update_nlogin,update_nlogout integer*4 update_create(2) integer*4 update_authorize(2) integer*4 update_expire(2)+ integer*4 update_login(2),update_logout(2) integer*4 update_update(2) integer*4 update_quota(20) real*4 update_costs(16) integer*4 update_usage(20) integer*4 update_flagcc update quota fieldsc real*4 update_quota_dollm1 equivalence (update_quota_dollm,update_quota(1))c integer*4 update_quota_cputime integer*4 update_quota_cpulm3 equivalence (update_quota_cputime,update_quota(2))1 equivalence (update_quota_cpulm,update_quota(3))c integer*4 update_quota_trmtime integer*4 update_quota_trmlm3 equivalence (update_quota_trmtime,update_quota(4))1 equivalence (update_quota_trmlm,update_quota(5))c integer*4 update_quota_dskspace integer*4 update_quota_dsklm4 equivalence (update_quota_dskspace,update_quota(6))1 equivalence (update_quota_dsklm,update_quota(7))c integer*4 update_quota_prtpages integer*4 update_quota_prtlm4 equivalence (update_quota_prtpages,update_quota(8))1 equivalence (update_quota_prtlm,update_quota(9))c.c update_quota(10) - update_quota(15) not usedc integer*4 update_quota_ncslm2 equivalence (update_quota_ncslm,update_quota(16))cc update_quota(17) not usedc integer*4 update_quota_diolm2 equivalence (update_quota_diolm,update_quota(18))c.c update_quota(19) - update_quota(20) not usedcc update costs fieldscc update_costs(1) not usedc real*4 update_costs_cpulm1 equivalence (update_costs_cpulm,update_costs(2))c real*4 update_costs_diolm1 equivalence (update_costs_diolm,update_costs(3))c,c update_costs(4) - update_costs(5) not usedc real*4 update_costs_prtlm1 equivalence (update_costs_prtlm,update_costs(6))c real*4 update_costs_trmlm1 equivalence (update_costs_trmlm,update_costs(7))c-c update_costs(8) - update_costs(16) not usedcc update usage fieldsc real*4 update_usage_dollm1 equivalence (update_usage_dollm,update_usage(1))c integer*4 update_usage_cputime integer*4 update_usage_cpulm3 equivalence (update_usage_cputime,update_usage(2))1 equivalence (update_usage_cpulm,update_usage(3))c integer*4 update_usage_trmtime integer*4 update_usage_trmlm3 equivalence (update_usage_trmtime,update_usage(4))1 equivalence (update_usage_trmlm,update_usage(5))c integer*4 update_usage_dskspace integer*4 update_usage_dsklm4 equivalence (update_usage_dskspace,update_usage(6))1 equivalence (update_usage_dsklm,update_usage(7))c integer*4 update_usage_prtpages integer*4 update_usage_prtlm4 equivalence (update_usage_prtpages,update_usage(8))1 equivalence (update_usage_prtlm,update_usage(9))c.c update_usage(10) - update_usage(15) not usedc integer*4 update_usage_ncslm2 equivalence (update_usage_ncslm,update_usage(16))cc update_usage(17) not usedc integer*4 update_usage_diolm2 equivalence (update_usage_diolm,update_usage(18))c.c update_usage(19) - update_usage(20) not usedc> common /update$/update_collnum,update_bldgnum,update_deptnum,. 1 update_owner,update_address,update_phonnum," 2 update_deptname,update_semesterc+ character*1 update_collnum,update_semester character*2 update_bldgnum character*3 update_deptnum character*10 update_phonnum character*20 update_deptname) character*30 update_owner,update_addresscAc ***************************************************************cww­ΰ¬=Κ“‹ subroutine ADDQUOTAcc Iowa State University&c Computation Center Accounting Officec Rodrick A Eldridgecc Add user recordc implicit integer (A-Z)c" include 'LIB:ISUDEF(QUOTA)/list'% include 'LIB:ISUDEF(DFTQUOTA)/list'! include 'LIB:ISUDEF(USER)/list'c- include 'SYS$LIBRARY:FORSYSDEF($FORIOSDEF)'c common /control_c/control_c logical*4 control_cc/ common /units/input,output,command,update,list+ integer*4 input,output,command,update,listc common /modify/modified,modify logical*4 modified integer*4 modifyc common /vax/vax character*1 vaxc common/copy$/ copy_default character*12 copy_defaultc# integer*4 option,status,msg_length logical*4 error! character*3 chr_group,chr_member character*80 msg integer*4 TRIMc1 format (1x,a,$)2 format (q,a)3 format (1x,a) 4 format (o3)cc move default values to recordc. if (copy_default .ne. dftquota_username) then# dftquota_username  = copy_default option = -1' call IOSQUOTA (update,option,status) unlock (unit=update)* if (status .eq. FOR$IOS_SPERECLOC) then? write (unit=output,fmt=3) 'The COPY record is locked \' //5 1 dftquota_username(:TRIM(dftquota_username)) // '\' elseif (status .ne. 0) then? write (unit=output,fmt=3) 'Unable to obtain COPY record /'8 1 // dftquota_username(:TRIM(dftquota_username)) // '\' call ERRSNS (,,,,status)( call GETMSG (status,msg,msg_length)/ write (unit=output,fmt=3) msg(:msg_length) endif if (status .ne. 0) then dftquota_username = ' ' goto 999 endif endif quota_record = dftquota_recordcc move username to recordc if (from_flag .ne. 0) then% write (chr_group,fmt=4) from_group' write (chr_member,fmt=4) from_member do i = 1,26 if (chr_group(i:i) .eq. ' ') chr_group(i:i) = '0'8 if (chr_member(i:i) .eq. ' ') chr_member(i:i) = '0' enddo from_flag = 01 from_username = vax // chr_group // chr_member quota_group = from_group quota_member = from_member endif quota_username = from_usernamec%c check if user record already existsc option = 1% call IOSQUOTA (update,option,status) unlock (unit=update)( if (status .ne. FOR$IOS_ATTACCNON) then= if (status .eq. 0 .or. status .eq. FOR$IOS_SPERECLOC) then@ write (unit=output,fmt=3) 'User record already exists \' /// 1 quota_username(:TRIM(quota_username)) // '\' else? write (un it=output,fmt=3) 'Unable to add user record \' /// 1 quota_username(:TRIM(quota_username)) // '\' call ERRSNS (,,,,status)( call GETMSG (status,msg,msg_length)/ write (unit=output,fmt=3) msg(:msg_length) endif goto 999 endifcc move update values to recordc call UPDQUOTAcc update creation datec call SYS$GETTIM (quota_create)cc add record to quota filec option = 5% call IOSQUOTA (update,option,status) unlock (unit=update) if (control!_c) then goto 999 elseif (status .ne. 0) then= write (unit=output,fmt=3) 'Unable to add user record \' /// 1 quota_username(:TRIM(quota_username)) // '\' call ERRSNS (,,,,status)& call GETMSG (status,msg,msg_length)- write (unit=output,fmt=3) msg(:msg_length) else? write (unit=output,fmt=3) 'User record successfully added \'2 1 // quota_username(:TRIM(quota_username)) // '\' modified = .true. endifc 999 continue return endww­@ ηΚ“‹ subro"utine DFTQUOTAcc Iowa State University&c Computation Center Accounting Officec Rodrick A Eldridgecc Update DEFAULT recordc implicit integer (A-Z)c" include 'LIB:ISUDEF(QUOTA)/list'% include 'LIB:ISUDEF(DFTQUOTA)/list'c- include 'SYS$LIBRARY:FORSYSDEF($FORIOSDEF)'c common /control_c/control_c logical*4 control_cc/ common /units/input,output,command,update,list+ integer*4 input,output,command,update,listc common /modify/modified,modify logical*4 m#odified integer*4 modifyc# integer*4 option,status,msg_length logical*4 error character*80 msg integer*4 TRIMc1 format (1x,a,$)2 format (q,a)3 format (1x,a)cc read DEFAULT recordc# dftquota_username = 'DEFAULT ' option = -1% call IOSQUOTA (update,option,status) if (status .ne. 0) then* if (status .eq. FOR$IOS_SPERECLOC) then) msg = 'The DEFAULT record is locked' msg_length = TRIM (msg) else call ERRSNS (,,,,status)( call $GETMSG (status,msg,msg_length)@ write (unit=output,fmt=3) 'Unable to obtain DEFAULT record' endif- write (unit=output,fmt=3) msg(:msg_length) goto 999 endifcc move update values to recordc quota_record = dftquota_record call UPDQUOTA dftquota_record = quota_recordcc rewrite record to quota filec option = 4% call IOSQUOTA (update,option,status) unlock (unit=update) if (status .ne. 0) then* if (status .eq. FOR$IOS_SPERECLOC) then) msg = 'The %DEFAULT record is locked' msg_length = TRIM (msg) else@ write (unit=output,fmt=3) 'Unable to update DEFAULT record' call ERRSNS (,,,,status)( call GETMSG (status,msg,msg_length) endif- write (unit=output,fmt=3) msg(:msg_length) else5 write (unit=output,fmt=3) 'DEFAULT record updated' modified = .true. endifc 999 continue return endww­ 6„Κ“‹ subroutine HLPQUOTA (line)cc Iowa State University&c Computation Center Account&ing Officec Rodrick A Eldridgecc Helpc implicit integer (A-Z)c common /control_c/control_c logical*4 control_cc common /units/input,output integer*4 input,outputc external PUTHELP+ integer*4 indx,func/'0001'x/,help/'0003'x/ integer*4 status,msg_length! character*80 msg,topic,qualifier integer*4 TRIMc1 format (1x,a,$)2 format (q,a)3 format (1x,a)cc initialize help libraryc* status = LBR$INI_CONTROL (indx,func,help) if (.not. status) got'o 200cc open the help libraryc, status = LBR$OPEN (indx,%DESCR ('HLPQUAX')) if (.not. status) goto 200cc display helpc i = 1 call GETWORD (line,i,topic) call GETWORD (line,i,qualifier)' if (topic(:TRIM(topic)) .eq. ' ') then1 status = LBR$GET_HELP (indx,80,PUTHELP,output) if (.not. status) goto 3003 elseif (qualifier(:TRIM(qualifier)) .eq. ' ') then1 status = LBR$GET_HELP (indx,80,PUTHELP,output, 1 topic(:TRIM(topic))) if (.not. status) goto 300 e(lse100 if (control_c) goto 9991 status = LBR$GET_HELP (indx,80,PUTHELP,output,3 1 topic(:TRIM(topic)),qualifier(:TRIM(qualifier))) if (.not. status) goto 300" call GETWORD (line,i,qualifier)# if (qualifier .ne. ' ') goto 100 endifcc close help libraryc status = LBR$CLOSE (indx) goto 999cc unable to open help filec'200 call GETMSG (status,msg,msg_length)5 write (unit=output,fmt=3) 'Unable to open help file'+ write (unit=output,fmt=3) msg(:msg_length)) goto 999cc unable to complete HELP topicc'300 call GETMSG (status,msg,msg_length)4 write (unit=output,fmt=3) 'Unable to complete HELP'+ write (unit=output,fmt=3) msg(:msg_length)c 999 continue return endww­ΰτ%Κ“‹ subroutine INTQUOTA (error)cc Iowa State University&c Computation Center Accounting Officec Rodrick A Eldridgec c Initalizec implicit integer (A-Z)c" include 'LIB:ISUDEF(QUOTA)/list'% include 'LIB:ISUDEF(DFTQUOTA)/list'*c- include 'SYS$LIBRARY:FORSYSDEF($FORIOSDEF)'c common /control_c/control_c logical*4 control_c external CANCELc/ common /units/input,output,command,update,list+ integer*4 input,output,command,update,listc common /modify/modified,modify logical*4 modified integer*4 modifyc common /vax/vax character*1 vaxc$ common /dept/deptnum,deptmax,ncdnum! integer*4 deptnum,deptmax,ncdnumc common /dept$/collnum,deptname character*1 collnum(199) character*20 de+ptname(199)c common /bldg$/bldgmin,bldgmax character*2 bldgmin,bldgmax/ integer*4 dept,length,option,status,msg_length character*3 answer character*7 node character*80 msgc integer*4 TRIMc1 format (1x,a,$)2 format (q,a)3 format (1x,a)4 format (i3,1x,i3,1x,a2,1x,a2)5 format (a1,3x,a20)c dept = 1& update = 2 ! read/write/rewrite unit list = 3 ! SHOW output unit+ command = 4 ! terminal write with no ! input = 5 ! terminal input unit# output ,= 6 ! terminal output unit) modified = .false. ! modified quota file modify = 0c'c open command, input, and output unitsc9 open (unit=command,file='SYS$COMMAND:',status='UNKNOWN')5 open (unit=input,file='SYS$INPUT:',status='UNKNOWN')7 open (unit=output,file='SYS$OUTPUT:',status='UNKNOWN')cc establish interruptc* control_c = .false. ! CONTROL-C interrupt call CTRLC (CANCEL,control_c)cc get vax machinec& call SYS$TRNLOG ('SYS$NODE',,node,,,) if (node -.eq. 'LOCAL ') then=100 write (unit=command,fmt=1) 'DECNET is unavailable, ' //& 1 'please enter VAX machine number: '5 read (unit=input,fmt=2,end=900,err=100) length,vax if (control_c) then goto 900 elseif (length .ne. 1) then goto 100 else( call STR$UPCASE (vax,node(:length)) endif else vax = node(5:5) endifcc open quota filec9 open (unit=update,access='KEYED',organization='INDEXED', 1 name='ISUQUAX',shared,! 2 status='OLD',form='.FORMATTED', 3 iostat=status)( if (status .eq. FOR$IOS_FILNOTFOU) then 200 write (unit=command,fmt=1)0 1 'Do you want to create a new file? (Y or N):'8 read (unit=input,fmt=2,end=900,err=200) length,answer if (control_c) then goto 900 elseif (length .eq. 0) then goto 200 else( call STR$UPCASE (answer,answer(:1)) endifcc create quota filec if (answer(:1) .eq. 'Y') then= open (unit=update,access='KEYED',organization='INDEXED', 1 name='I/SUQUAX',shared,4 2 key=(1:12:CHARACTER,13:16:INTEGER,15:16:INTEGER),6 3 status='NEW',form='FORMATTED',recl=482,blocksize=1,( 4 carriagecontrol='NONE',iostat=status)cc unable to create quota filec if (status .ne. 0) then call ERRSNS (,,,,status)& call GETMSG (status,msg,length)> write (unit=output,fmt=3) 'Unable to create quota file'- write (unit=output,fmt=3) msg(:length) goto 900 endifcc initalize default recordc do i = 0,0481 quota_def(i) = 0 enddo$ quota_username = 'DEFAULT ' quota_group = 0 quota_member = 0 quota_owner = ' ' quota_address = ' ' quota_bldgnum = '00'! quota_phonnum = '5152940000' quota_collnum = '0' quota_deptnum = '000' quota_deptname = ' ' quota_mask = 'FFFFFFFF'x quota_status = 'FFFFFFFF'x quota_isupriv = '00000000'x quota_purkeep = 1 quota_semester = '0'# call SYS$GETTIM (quota_cr1eate) do i = 1,2 quota_authorize(i) = 0 quota_expire(i) = 0 quota_login(i) = 0 quota_logout(i) = 0 quota_update(i) = 0 enddo quota_nlogin = 0 quota_nlogout = 0 do i = 1,20 quota_quota(i) = 0 quota_usage(i) = 0 enddo do i = 1, 16 quota_costs(i) = 0 enddo; quota_cputime = 12000 ! cputime /session - 120.00 secs7 quota_cpulm = 720000 ! cputime /limit - 2.00 hrs4 quota2_trmtime = 7200 ! trmtime /session - 2 hrs6 quota_trmlm = 360000 ! trmtime /limit - 100 hrs8 quota_prtpages = 20 ! prtpages/session - 100 pages6 quota_prtlm = 300 ! prtpages/limit - 300 pages; quota_dskspace = 5000 ! dskspace/dynamic - 5000 blocks7 quota_dsklm = 300 ! dskspace/static - 300 blocks+ quota_ncslm = 1 ! concurrent sessionsc# dftquota_record = quota_recordcc create default recordc# quota_record = dftquota_record option 3= 5) call IOSQUOTA (update,option,status) if (status .eq. 0) then9 write (unit=output,fmt=3) 'DEFAULT record created' modified = .true.c!c unable to create DEFAULT recordc else. if (status .eq. FOR$IOS_SPERECLOC) then+ msg = 'The DEFAULT record already exists' msg_length = TRIM (msg) else call ERRSNS (,,,,status)% call GETMSG (status,msg,msg_length) write (unit=output,fmt=3)& 1 'Unable to create DEFAULT record' end4if1 write (unit=output,fmt=3) msg(:msg_length) goto 900 endifcc do not create quota filec$ elseif (answer(:1) .eq. 'N') then goto 900cc invalid responsec else write (unit=output,fmt=3), 1 'Invalid response \' // answer(:1) // '\' goto 200 endifcc unable to open quota filec elseif (status .ne. 0) then call ERRSNS (,,,,status)" call GETMSG (status,msg,length)8 write (unit=output,fmt=3) 'Unable to open quota fil5e') write (unit=output,fmt=3) msg(:length) goto 900 endifcc read DEFAULT recordc# dftquota_username = 'DEFAULT ' option = -1% call IOSQUOTA (update,option,status) unlock (unit=update)c!c unable to obtain DEFAULT recordc if (status .ne. 0) then* if (status .eq. FOR$IOS_SPERECLOC) then) msg = 'The DEFAULT record is locked' msg_length = TRIM (msg) else call ERRSNS (,,,,status)( call GETMSG (status,msg,msg_length)@ write (unit6=output,fmt=3) 'Unable to obtain DEFAULT record' endif- write (unit=output,fmt=3) msg(:msg_length) goto 900 endifcc initalize DEPTNAME filec3 open (unit=dept,name='DEPT',status='OLD',readonly, 1 iostat=status)c%c unable to open department name filec if (status .ne. 0) then call ERRSNS (,,,,status)& call GETMSG (status,msg,msg_length) write (unit=output,fmt=3)( 1 'Unable to open Department Name file'- write (unit=output,fmt=3) msg(:msg_length) 7 goto 900 endifcc initalize department namesc% read (unit=dept,fmt=4,iostat=status)! 1 deptmax,ncdnum,bldgmin,bldgmax do deptnum = 1,deptmaxc$c Error reading department name filec if (status .ne. 0) then call ERRSNS (,,,,status)( call GETMSG (status,msg,msg_length) write (unit=output,fmt=3)' 1 'Error reading Department Name file'/ write (unit=output,fmt=3) msg(:msg_length) goto 900 endif' read (unit=dept,fmt=5,iostat=status)% 1 col 8lnum(deptnum),deptname(deptnum) enddoc close (unit=dept)c error = .false. goto 999cc errorc900 error = .true.c 999 continue return endww­ ΪΚ“‹) subroutine IOSQUOTA (unit,option,status)cc Iowa State University&c Computation Center Accounting Officec Rodrick A Eldridgecc Read user recordc implicit integer (A-Z)c" include 'LIB:ISUDEF(QUOTA)/list'% include 'LIB:ISUDEF(DFTQUOTA)/list'! include 'LIB:ISUDEF(USER)/list'c-9 include 'SYS$LIBRARY:FORSYSDEF($FORIOSDEF)'c common /control_c/control_c logical*4 control_cc integer*4 unit,option,status integer*4 locked real*8 ten_seconds/-10.0d0/c1 format (a482)c locked = 0 status = 0c100 if (control_c) goto 999c!c option -1 - read DEFAULT recordc if (option .eq. -1) then9 read (unit=unit,fmt=1,keyeq=dftquota_username,keyid=0,) 1 err=200,iostat=status) dftquota_recordcc option 0 - sequential readc elseif (opt:ion .eq. 0) then< read (unit=unit,fmt=1,err=200,iostat=status) quota_record! from_username = quota_username from_uic = quota_uicc!c option 1 - indexed read (KEYEQ)c elseif (option .eq. 1) then if (from_flag .eq. 0) then7 read (unit=unit,fmt=1,keyeq=from_username,keyid=0,& 1 err=200,iostat=status) quota_record! elseif (from_flag .gt. 0) then2 read (unit=unit,fmt=1,keyeq=from_uic,keyid=1,& 1 err=200,iostat=status) quota_record! elseif (from_flag .lt. 0) the;n4 read (unit=unit,fmt=1,keyeq=from_group,keyid=2,& 1 err=200,iostat=status) quota_record endif! from_username = quota_username from_uic = quota_uicc!c option 2 - indexed read (KEYGT)c elseif (option .eq. 2) then if (from_flag .eq. 0) then7 read (unit=unit,fmt=1,keygt=from_username,keyid=0,& 1 err=200,iostat=status) quota_record! elseif (from_flag .gt. 0) then2 read (unit=unit,fmt=1,keygt=from_uic,keyid=1,& 1 err=200,iostat=status) quota_record! e<lseif (from_flag .lt. 0) then4 read (unit=unit,fmt=1,keygt=from_group,keyid=2,& 1 err=200,iostat=status) quota_record endif! from_username = quota_username from_uic = quota_uicc!c option 3 - indexed read (KEYGE)c elseif (option .eq. 3) then if (from_flag .eq. 0) then7 read (unit=unit,fmt=1,keyge=from_username,keyid=0,& 1 err=200,iostat=status) quota_record! elseif (from_flag .gt. 0) then2 read (unit=unit,fmt=1,keyge=from_uic,keyid=1,& 1 err=200,iosta=t=status) quota_record! elseif (from_flag .lt. 0) then4 read (unit=unit,fmt=1,keyge=from_group,keyid=2,& 1 err=200,iostat=status) quota_record endif! from_username = quota_username from_uic = quota_uiccc option 4 - rewitec elseif (option .eq. 4) then? rewrite (unit=unit,fmt=1,err=200,iostat=status) quota_recordcc option 5 - writec elseif (option .eq. 5) then= write (unit=unit,fmt=1,err=200,iostat=status) quota_recordcc option 6 - deletec e>lseif (option .eq. 6) then+ delete (unit=unit,err=200,iostat=status)c endifc c i/o errorc+200 if (status .eq. FOR$IOS_SPERECLOC) then locked = locked + 1 if (locked .gt. 25) then goto 999 endif call WAIT (ten_seconds) goto 100 endifcc returnc 999 continue return endww­@nΚ“‹+ subroutine LISQUOTA (output,option,status)cc Iowa State University&c Computation Center Accounting Officec Rodrick A Eldridgec implici?t integer (A-Z)c common /control_c/control_c logical*4 control_cc" include 'LIB:ISUDEF(QUOTA)/list'c integer*4 output,option,status integer*4 hmsh(4) logical*4 first_time/.true./ save first_time character*1 cr/13/,lf/10/ character*3 chr3a,chr3b character*7 chr7a,chr7b,chr7c character*8 chr8a,chr8b" character*14 chr14a,chr14b,chr14c character*23 chr23a,chr23bc1 format (1x,a,$)2 format (q,a)3 format (1x,a) 4 format (i3) 5 format (i5) 6 format (i2)@ 7 format (i7) 8 format (z8) 9 format (o3)10 format (f13.2)c status = 0cc brief listingc if (option .eq. 0) then if (first_time) then first_time = .false.< write (unit=output,fmt=100,err=999,iostat=status) cr,lf=100 format (1x,' Owner Username',/ 1 ' UIC Authorize Expire',a1,a1) endif" write (chr3a,fmt=9) quota_group# write (chr3b,fmt=9) quota_member do i = 1,2. if (chr3a(i:i) .eq. ' ') chr3a(Ai:i) = '0'. if (chr3b(i:i) .eq. ' ') chr3b(i:i) = '0' enddo- call SYS$ASCTIM (,chr23a,quota_authorize,)* call SYS$ASCTIM (,chr23b,quota_expire,)4 write (unit=output,fmt=101,err=999,iostat=status)* 1 quota_owner,quota_username,chr3a,chr3b,) 2 chr23a(:11),chr23b(:11),quota_semesterD101 format (1x,a30,' ',a12,' [',a3,',',a3,'] ',a11,' ',a11,' ',a1)cc full listingc0 elseif (option .eq. -1 .or. option .eq. 1) then" write (chr3a,fmt=9) quota_group# write (chr3b,fmt=9) B quota_member do i = 1,2. if (chr3a(i:i) .eq. ' ') chr3a(i:i) = '0'. if (chr3b(i:i) .eq. ' ') chr3b(i:i) = '0' enddo4 write (unit=output,fmt=103,err=999,iostat=status) 1 quota_username,chr3a,chr3bA103 format (1x,'Username: ',a12,21x,'UIC: [',a3,',',a3,']') if (control_c) goto 999A write (unit=output,fmt=105,err=999,iostat=status) quota_owner,9 1 quota_phonnum(:3),quota_phonnum(4:6),quota_phonnum(7:)B105 format (1x,'Owner: ',a30,3x,'Phone#: ',a3,'-',a3C,'-',a4) if (control_c) goto 9994 write (unit=output,fmt=107,err=999,iostat=status) 1 quota_address,quota_bldgnum4107 format (1x,'Address: ',a30,3x,'Bldg#: ',a2) if (control_c) goto 9994 write (unit=output,fmt=109,err=999,iostat=status)- 1 quota_collnum,quota_deptnum,quota_deptname2109 format (1x,'College#: ',a1,' Dept#: ',a3, 1 9x,'Deptname: ',a20) if (control_c) goto 9996 write (unit=output,fmt=3,err=999,iostat=status) ' ' if (control_c) goto 999* call DSYS$ASCTIM (,chr23a,quota_create,)) call SYS$ASCTIM (,chr23b,quota_login,)4 write (unit=output,fmt=111,err=999,iostat=status) 1 chr23a,chr23b6111 format (1x,'Create: ',a23,3x,'Login: ',a23) if (control_c) goto 999- call SYS$ASCTIM (,chr23a,quota_authorize,)* call SYS$ASCTIM (,chr23b,quota_logout,)4 write (unit=output,fmt=113,err=999,iostat=status) 1 chr23a,chr23b6113 format (1x,'Authorize: ',a23,3x,'Logout: ',a23) if (control_c) goto 999* call SYS$ASCTIM (,cEhr23a,quota_expire,)* call SYS$ASCTIM (,chr23b,quota_update,)4 write (unit=output,fmt=115,err=999,iostat=status) 1 chr23a,chr23b6115 format (1x,'Expire: ',a23,3x,'Update: ',a23) if (control_c) goto 9996 write (unit=output,fmt=3,err=999,iostat=status) ' ' if (control_c) goto 999# write (chr8a,fmt=8) quota_status$ write (chr8b,fmt=8) quota_isupriv do i = 1,7. if (chr8a(i:i) .eq. ' ') chr8a(i:i) = '0'. if (chr8b(i:i) .eq. ' ') chr8b(i:i) = '0' enddo# F write (chr7a,fmt=7) quota_nlogin$ write (chr3a,fmt=4) quota_purkeep4 write (unit=output,fmt=117,err=999,iostat=status) 1 chr8a,chr8b,chr7a,chr3a6117 format (1x,'Status: ',a8,3x,'ISUPriv: ',a8,3x,! 1 'Login: ',a7,3x,'PKPLM: ',a3) if (control_c) goto 999! write (chr8a,fmt=8) quota_mask do i = 1,7. if (chr8a(i:i) .eq. ' ') chr8a(i:i) = '0' enddo$ write (chr7a,fmt=7) quota_nlogout" write (chr3a,fmt=4) quota_ncslm4 write (unit=output,fmt=119,err=999,iostat=s Gtatus)# 1 chr8a,quota_semester,chr7a,chr3a7119 format (1x,'Mask: ',a8,3x,'Semester: ',a1,10x,! 1 'Logout: ',a7,3x,'NCSLM: ',a3) if (control_c) goto 9996 write (unit=output,fmt=3,err=999,iostat=status) ' ' if (control_c) goto 999 if (option .eq. -1) then> write (unit=output,fmt=121,err=999,iostat=status) 'Costs' elseif (option .eq. 1) then> write (unit=output,fmt=121,err=999,iostat=status) 'Usage' endifC121 format (1x,'Session Quotas: CumulatHive Quotas:', 1 ' Cumulative ',a5,':') if (control_c) goto 999 chr14a = ' '( write (chr14b(2:),fmt=10) quota_dollm chr14b(:1) = '$'( write (chr14c(2:),fmt=10) usage_dollm chr14c(:1) = '$'4 write (unit=output,fmt=123,err=999,iostat=status) 1 chr14a,chr14b,chr14c6123 format (1x,' ',a14,' DOLLM: ',a14, 1 ' ',a14)! if (quota_cputime .eq. 0) then chr14a = ' 0:00:00.00' else& call HMSHTIM (quota_cputime,hmsh) chr14a I= ' : : . '& write (chr14a(1:5),fmt=5) hmsh(1)& write (chr14a(7:8),fmt=6) hmsh(2)0 if (chr14a(7:7) .eq. ' ') chr14a(7:7) = '0'( write (chr14a(10:11),fmt=6) hmsh(3)4 if (chr14a(10:10) .eq. ' ') chr14a(10:10) = '0'( write (chr14a(13:14),fmt=6) hmsh(4)4 if (chr14a(13:13) .eq. ' ') chr14a(13:13) = '0' endif if (quota_cpulm .eq. 0) then chr14b = ' 0:00:00.00' else$ call HMSHTIM (quota_cpulm,hmsh) chr14b = ' : : . '& wriJte (chr14b(1:5),fmt=5) hmsh(1)& write (chr14b(7:8),fmt=6) hmsh(2)0 if (chr14b(7:7) .eq. ' ') chr14b(7:7) = '0'( write (chr14b(10:11),fmt=6) hmsh(3)4 if (chr14b(10:10) .eq. ' ') chr14b(10:10) = '0'( write (chr14b(13:14),fmt=6) hmsh(4)4 if (chr14b(13:13) .eq. ' ') chr14b(13:13) = '0' endif if (option .eq. -1) then* write (chr14c(2:),fmt=10) costs_cpulm chr14c(:1) = '$' elseif (option .eq. 1) then! if (usage_cpulm .eq. 0) then chr14c = K' 0:00:00.00' else& call HMSHTIM (usage_cpulm,hmsh) chr14c = ' : : . '( write (chr14c(1:5),fmt=5) hmsh(1)( write (chr14c(7:8),fmt=6) hmsh(2)2 if (chr14c(7:7) .eq. ' ') chr14c(7:7) = '0'* write (chr14c(10:11),fmt=6) hmsh(3)6 if (chr14c(10:10) .eq. ' ') chr14c(10:10) = '0'* write (chr14c(13:14),fmt=6) hmsh(4)6 if (chr14c(13:13) .eq. ' ') chr14c(13:13) = '0' endif endif4 write (unit=output,fmt=125,err=999,iostatL=status) 1 chr14a,chr14b,chr14c6125 format (1x,' CPUTIME: ',a14,' CPULM: ',a14, 1 ' ',a14) if (control_c) goto 999! if (quota_trmtime .eq. 0) then chr14a = ' 0:00:00.00' else, call HMSHTIM (quota_trmtime * 100,hmsh) chr14a = ' : : . '& write (chr14a(1:5),fmt=5) hmsh(1)& write (chr14a(7:8),fmt=6) hmsh(2)0 if (chr14a(7:7) .eq. ' ') chr14a(7:7) = '0'( write (chr14a(10:11),fmt=6) hmsh(3)4 if (chr14a(10:10) .eq. ' ') chr14a(10M:10) = '0'( write (chr14a(13:14),fmt=6) hmsh(4)4 if (chr14a(13:13) .eq. ' ') chr14a(13:13) = '0' endif if (quota_trmlm .eq. 0) then chr14b = ' 0:00:00.00' else* call HMSHTIM (quota_trmlm * 100,hmsh) chr14b = ' : : . '& write (chr14b(1:5),fmt=5) hmsh(1)& write (chr14b(7:8),fmt=6) hmsh(2)0 if (chr14b(7:7) .eq. ' ') chr14b(7:7) = '0'( write (chr14b(10:11),fmt=6) hmsh(3)4 if (chr14b(10:10) .eq. ' ') chr14b(10:10) = '0'( writeN (chr14b(13:14),fmt=6) hmsh(4)4 if (chr14b(13:13) .eq. ' ') chr14b(13:13) = '0' endif if (option .eq. -1) then* write (chr14c(2:),fmt=10) costs_trmlm chr14c(:1) = '$' elseif (option .eq. 1) then! if (usage_trmlm .eq. 0) then chr14c = ' 0:00:00.00' else, call HMSHTIM (usage_trmlm * 100,hmsh) chr14c = ' : : . '( write (chr14c(1:5),fmt=5) hmsh(1)( write (chr14c(7:8),fmt=6) hmsh(2)2 if (chr14c(7:7) .eq. ' ') cOhr14c(7:7) = '0'* write (chr14c(10:11),fmt=6) hmsh(3)6 if (chr14c(10:10) .eq. ' ') chr14c(10:10) = '0'* write (chr14c(13:14),fmt=6) hmsh(4)6 if (chr14c(13:13) .eq. ' ') chr14c(13:13) = '0' endif endif4 write (unit=output,fmt=127,err=999,iostat=status) 1 chr14a,chr14b,chr14c6127 format (1x,' TRMTIME: ',a14,' TRMLM: ',a14, 1 ' ',a14) if (control_c) goto 999% write (chr7a,fmt=7) quota_dskspace" write (chr7b,fmt=7) quota_dsklm if (optPion .eq. -1) then6 write (unit=output,fmt=129,err=999,iostat=status) 1 chr7a,chr7b=129 format (1x,' DSKSPACE: ',a7,' Blocks DSKLM: ',a7, 1 ' Blocks') elseif (option .eq. 1) then$ write (chr7c,fmt=7) usage_dsklm6 write (unit=output,fmt=131,err=999,iostat=status) 1 chr7a,chr7b,chr7c=131 format (1x,' DSKSPACE: ',a7,' Blocks DSKLM: ',a7, 1 ' Blocks ',a7,' Blocks') endif if (control_c) goto 999% write (chr7a,fmt=7) quota_prtpages" write (chQr7b,fmt=7) quota_prtlm if (option .eq. -1) then* write (chr14c(2:),fmt=10) costs_prtlm chr14c(:1) = '$'6 write (unit=output,fmt=133,err=999,iostat=status) 1 chr7a,chr7b,chr14c=133 format (1x,' PRTPAGES: ',a7,' Pages PRTLM: ',a7, 1 ' Pages ',a14) elseif (option .eq. 1) then$ write (chr7c,fmt=7) usage_prtlm6 write (unit=output,fmt=135,err=999,iostat=status) 1 chr7a,chr7b,chr7c=135 format (1x,' PRTPAGES: ',a7,' Pages PRTLM: ',a7, 1 'R Pages ',a7,' Pages') endif if (control_c) goto 999 chr7a = ' '" write (chr7b,fmt=7) quota_diolm if (option .eq. -1) then* write (chr14c(2:),fmt=10) costs_diolm chr14c(:1) = '$'6 write (unit=output,fmt=137,err=999,iostat=status) 1 chr7a,chr7b,chr14c=137 format (1x,' ',a7,' DIOS: ',a7, 1 ' IOs ',a14) elseif (option .eq. 1) then$ write (chr7c,fmt=7) usage_diolm6 write (unit=output,fmt=139,err=999,iostat=statuSs) 1 chr7a,chr7b,chr7c=139 format (1x,' ',a7,' DIOS: ',a7, 1 ' IOs ',a7,' IOs') endif if (control_c) goto 999 endifcc returnc 999 return endww­@U1Κ“‹) subroutine MADQUOTA (line,pos,siz,error)cc Iowa State University&c Computation Center Accounting Officec Rodrick A Eldridgecc Mod, Add, and Default routinec implicit integer (A-Z)c integer*4 length,error integer*4 pos(39),siz(39)5 integer*4 TRIM,VETRIFY,INDEX,SYS$BINTIM,VAXDAT,VAXTIM integer*4 units real*4 costs real*8 double character*(*) line character*80 date,time,valc# common /units/input,output,command integer*4 input,output,commandc common /modify/modified,modify logical*4 modified integer*4 modifyc common /mad/ans integer*4 ans(39)c" include 'LIB:QUOTA(UPDATE)/list'c common/copy$/ copy_default character*12 copy_defaultc1 format (1x,a,$)2 format (q,a)3 format (1x,a)4 formUat (o)5 format (z)6 format (i)7 format (f.2)c" if (ans(2) .eq. 1) then ! uic val = line (pos(2):siz(2)) l = TRIM (val) i = INDEX (val(:l),',') if (i .eq. 0) goto 100 length = i - 1. read (val(:i-1),fmt=4,err=100) update_group< if (update_group .gt. '377'O .or. update_group .lt. '0'O) 1 goto 100 length = l - i0 read (val(i+1:l),fmt=4,err=100) update_member> if (update_member .gt. '377'O .or. update_member .lt. '0'VO) 1 goto 100 ans(2) = -1 endif$ if (ans(3) .eq. 1) then ! owner val = line (pos(3):siz(3)) length = TRIM (val) if (length .gt. 30) goto 200 update_owner = val(:length) ans(3) = -1 endif& if (ans(4) .eq. 1) then ! address val = line (pos(4):siz(4)) length = TRIM (val) if (length .gt. 30) goto 200 update_address = val(:length) ans(4) = -1 endif$ if (ans(5) .eq. 1) then ! bldg# val = line (pos(5):siz(5)) length = TRIM (val)W if (length .ne. 2) goto 300$ n = VERIFY (val(:2),'0123456789') if (n .gt. 0) goto 300 update_bldgnum = val(:2) ans(5) = -1 endif% if (ans(6) .eq. 1) then ! phone# val = line (pos(6):siz(6)) length = TRIM (val) if (length .gt. 10) goto 200& n = VERIFY (val(:10),'0123456789-') if (n .gt. 0) goto 300 update_phonnum = val(:10) ans(6) = -1 endif' if (ans(7) .eq. 1) then ! college# val = line (pos(7):siz(7)) length = TRIM (val) X if (length .ne. 1) goto 300$ n = VERIFY (val(:1),'0123456789') if (n .gt. 0) goto 300 update_collnum = val(:1) ans(7) = -1 endif$ if (ans(8) .eq. 1) then ! dept# val = line (pos(8):siz(8)) length = TRIM (val) if (length .ne. 3) goto 200$ n = VERIFY (val(:3),'0123456789') if (n .gt. 0) goto 200 update_deptnum = val(:3) ans(8) = -1 endif' if (ans(9) .eq. 1) then ! deptname val = line (pos(9):siz(9)) length = TRIM (val) if (lengtYh .gt. 20) goto 200! update_deptname = val(:length) ans(9) = -1 endif# if (ans(10) .eq. 1) then ! mask val = line (pos(10):siz(10)) length = TRIM (val) if (length .ne. 8) goto 300+ read (val(:8),fmt=5,err=300) update_mask ans(10) = -1 endif% if (ans(11) .eq. 1) then ! status val = line (pos(11):siz(11)) length = TRIM (val) if (length .ne. 8) goto 300- read (val(:8),fmt=5,err=300) update_status ans(11) = -1 endif& if (ans(12) .eq. 1)Z then ! isupriv val = line (pos(12):siz(12)) length = TRIM (val) if (length .ne. 8) goto 300. read (val(:8),fmt=5,err=300) update_isupriv ans(12) = -1 endif$ if (ans(13) .eq. 1) then ! pkplm val = line (pos(13):siz(13)) length = TRIM (val)3 read (val(:length),fmt=6,err=300) update_purkeep& if (update_purkeep .lt. 0) goto 300 ans(13) = -1 endif( if (ans(14) .eq. 1) then ! authorize val = line (pos(14):siz(14)) length = TRIM (val) n =[ INDEX (val(:length),':') if (n .eq. 0) then time = '00:00:00.00' n = length + 1 else6 if (.not. VAXTIM (val(n+1:length),time)) goto 500& if (TRIM (time) .ne. 11) goto 500 endif. if (.not. VAXDAT (val(:n-1),date)) goto 500& val = date(:11) // ' ' // time(:11)8 if (.not. SYS$BINTIM (val,update_authorize)) goto 500 ans(14) = -1 endif% if (ans(15) .eq. 1) then ! expire val = line (pos(15):siz(15)) length = TRIM (val) n = INDEX (val(\:length),':') if (n .eq. 0) then time = '23:59:59.99' n = length + 1 else6 if (.not. VAXTIM (val(n+1:length),time)) goto 500& if (TRIM (time) .ne. 11) goto 500 endif. if (.not. VAXDAT (val(:n-1),date)) goto 500& val = date(:11) // ' ' // time(:11)5 if (.not. SYS$BINTIM (val,update_expire)) goto 500 ans(15) = -1 endif$ if (ans(16) .eq. 1) then ! login val = line (pos(16):siz(16)) length = TRIM (val) n = INDEX (val(:length),':')] if (n .eq. 0) then goto 500 else6 if (.not. VAXTIM (val(n+1:length),time)) goto 500& if (TRIM (time) .ne. 11) goto 500 endif. if (.not. VAXDAT (val(:n-1),date)) goto 500& val = date(:11) // ' ' // time(:11)4 if (.not. SYS$BINTIM (val,update_login)) goto 500 ans(16) = -1 endif% if (ans(17) .eq. 1) then ! logout val = line (pos(17):siz(17)) length = TRIM (val) n = INDEX (val(:length),':') if (n .eq. 0) then goto 500 else6^ if (.not. VAXTIM (val(n+1:length),time)) goto 500& if (TRIM (time) .ne. 11) goto 500 endif. if (.not. VAXDAT (val(:n-1),date)) goto 500& val = date(:11) // ' ' // time(:11)5 if (.not. SYS$BINTIM (val,update_logout)) goto 500 ans(17) = -1 endif% if (ans(18) .eq. 1) then ! update val = line (pos(18):siz(18)) length = TRIM (val) n = INDEX (val(:length),':') if (n .eq. 0) then goto 500 else6 if (.not. VAXTIM (val(n+1:length),time)) go_to 500& if (TRIM (time) .ne. 11) goto 500 endif. if (.not. VAXDAT (val(:n-1),date)) goto 500& val = date(:11) // ' ' // time(:11)5 if (.not. SYS$BINTIM (val,update_update)) goto 500 ans(18) = -1 endif% if (ans(19) .eq. 1) then ! nlogin val = line (pos(19):siz(19)) length = TRIM (val)2 read (val(:length),fmt=6,err=300) update_nlogin% if (update_nlogin .lt. 0) goto 300 ans(19) = -1 endif& if (ans(20) .eq. 1) then ! nlogout val = line (pos(20)`:siz(20)) length = TRIM (val)3 read (val(:length),fmt=6,err=300) update_nlogout& if (update_nlogout .lt. 0) goto 300 ans(20) = -1 endif$ if (ans(21) .eq. 1) then ! quota update_flag = 0 ans(21) = -1 endif$ if (ans(22) .eq. 1) then ! costs update_flag = -1 ans(22) = -1 endif$ if (ans(23) .eq. 1) then ! usage update_flag = 1 ans(23) = -1 endif$ if (ans(24) .eq. 1) then ! dollm val = line (pos(24):siz(24)) length = TRIM (val)*a read (val(:length),fmt=7,err=300) costs if (costs .lt. 0) goto 300 if (quota_flag .lt. 0) then update_costs_dollm = costs" elseif (quota_flag .gt. 0) then update_usage_dollm = costs endif ans(24) = -1 endif& if (ans(25) .eq. 1) then ! cputime val = line (pos(25):siz(25)) length = TRIM (val) if (quota_flag .ge. 0) then3 if (.not. VAXTIM (val(:length),time)) goto 400" if (TRIM (time) .eq. 11) then val = '0 ' // time(:11) eblse val = time endif, if (.not. BINTIM (val,double)) goto 400 if (quota_flag .eq. 0) then update_quota_cputime =) 1 INT (ABS (double / 10000000.d0) * 100)$ elseif (quota_flag .gt. 0) then update_usage_cputime =) 1 INT (ABS (double / 10000000.d0) * 100) endif endif ans(25) = -1 endif$ if (ans(26) .eq. 1) then ! cpulm val = line (pos(26):siz(26)) length = TRIM (val) if (quota_flag .ge. 0) then3 if (.not. VAXTIM c(val(:length),time)) goto 400" if (TRIM (time) .eq. 11) then val = '0 ' // time(:11) else val = time endif, if (.not. BINTIM (val,double)) goto 400 if (quota_flag .eq. 0) then update_quota_cpulm =) 1 INT (ABS (double / 10000000.d0) * 100)$ elseif (quota_flag .gt. 0) then update_usage_cpulm =) 1 INT (ABS (double / 10000000.d0) * 100) endif" elseif (quota_flag .lt. 0) then, read (val(:length),fmt=7,err=300) costs d if (costs .lt. 0) goto 300 update_costs_cpulm = costs endif ans(26) = -1 endif& if (ans(27) .eq. 1) then ! trmtime val = line (pos(27):siz(27)) length = TRIM (val) if (quota_flag .ge. 0) then3 if (.not. VAXTIM (val(:length),time)) goto 400" if (TRIM (time) .eq. 11) then val = '0 ' // time(:11) else val = time endif, if (.not. BINTIM (val,double)) goto 400 if (quota_flag .eq. 0) then update_quota_trmtime e=# 1 INT (ABS (double / 10000000.d0))$ elseif (quota_flag .gt. 0) then update_usage_trmtime =# 1 INT (ABS (double / 10000000.d0)) endif endif ans(27) = -1 endif$ if (ans(28) .eq. 1) then ! trmlm val = line (pos(28):siz(28)) length = TRIM (val) if (quota_flag .ge. 0) then3 if (.not. VAXTIM (val(:length),time)) goto 400" if (TRIM (time) .eq. 11) then val = '0 ' // time(:11) else val = time endif, if (.not.f BINTIM (val,double)) goto 400 if (quota_flag .eq. 0) then update_quota_trmlm =# 1 INT (ABS (double / 10000000.d0))$ elseif (quota_flag .gt. 0) then update_usage_trmlm =# 1 INT (ABS (double / 10000000.d0)) endif" elseif (quota_flag .lt. 0) then, read (val(:length),fmt=7,err=300) costs if (costs .lt. 0) goto 300 update_costs_trmlm = costs endif ans(28) = -1 endif' if (ans(29) .eq. 1) then ! dskspace val = line (pos(29):sizg(29)) length = TRIM (val)* read (val(:length),fmt=6,err=300) units if (units .lt. 0) goto 300 if (quota_flag .eq. 0) then" update_quota_dskspace = units endif ans(29) = -1 endif$ if (ans(30) .eq. 1) then ! dsklm val = line (pos(30):siz(30)) length = TRIM (val)* read (val(:length),fmt=6,err=300) units if (units .lt. 0) goto 300 if (quota_flag .eq. 0) then update_quota_dsklm = units" elseif (quota_flag .gt. 0) then update_usage_dshklm = units endif ans(30) = -1 endif' if (ans(31) .eq. 1) then ! prtpages val = line (pos(31):siz(31)) length = TRIM (val)* read (val(:length),fmt=6,err=300) units if (units .lt. 0) goto 300 if (quota_flag .eq. 0) then" update_quota_prtpages = units endif ans(31) = -1 endif$ if (ans(32) .eq. 1) then ! prtlm val = line (pos(32):siz(32)) length = TRIM (val) if (quota_flag .ge. 0) then, read (val(:length),fmt=6,err=300) units i if (units .lt. 0) goto 300 if (quota_flag .eq. 0) then! update_quota_prtlm = units$ elseif (quota_flag .gt. 0) then! update_usage_prtlm = units endif" elseif (quota_flag .lt. 0) then, read (val(:length),fmt=7,err=300) costs if (costs .lt. 0) goto 300 update_costs_prtlm = costs endif ans(32) = -1 endif$ if (ans(33) .eq. 1) then ! ncslm val = line (pos(33):siz(33)) length = TRIM (val)* read (val(:length),fmt=6,err=300)j units if (units .lt. 0) goto 300 if (quota_flag .eq. 0) then update_quota_ncslm = units" elseif (quota_flag .gt. 0) then update_usage_ncslm = 0 endif ans(33) = -1 endif$ if (ans(34) .eq. 1) then ! diolm val = line (pos(34):siz(34)) length = TRIM (val) if (quota_flag .ge. 0) then, read (val(:length),fmt=6,err=300) units if (units .lt. 0) goto 300 if (quota_flag .eq. 0) then" update_quota_diocnt = units$ elseif (quota_fklag .gt. 0) then" update_usage_diocnt = units endif" elseif (quota_flag .lt. 0) then, read (val(:length),fmt=7,err=300) costs if (costs .lt. 0) goto 300 update_costs_diocnt = 0 endif ans(34) = -1 endif' if (ans(35) .eq. 1) then ! semester val = line (pos(35):siz(35)) length = TRIM (val) if (length .gt. 1) goto 2007 if (val(:1) .lt. '0' .or. val(:1) .gt. '3') goto 300 update_semester = val(:1) ans(35) = -1 endif' if (ans(36)l .eq. 1) then ! activate ans(36) = -1 modify = 1 endif% if (ans(37) .eq. 1) then ! cancel" call SYS$GETTIM (update_expire) ans(37) = -1 modify = -1 endif# if (ans(38) .eq. 1) then ! copy val = line (pos(38):siz(38)) length = TRIM (val) if (length .gt. 12) goto 200 copy_default = val(:length) ans(38) = -1 endif if (ans(39) .eq. 1) then ! not implemented ans(39) = -1 endifc error = .false. goto 999c c invalid uicmc0100 write (unit=output,fmt=3) 'Invalid uic \' // 1 val(:TRIM(val)) // '\' goto 600cc string too long for fieldc>200 write (unit=output,fmt=3) 'String too long for field \' // 1 val(:TRIM(val)) // '\' goto 600cc error in valuec3300 write (unit=output,fmt=3) 'Error in value \' // 1 val(:TRIM(val)) // '\' goto 600cc error in time valuec>400 write (unit=output,fmt=3) 'Error in delta time value \' // 1 val(:TRIM(val)) // '\' goto 600cc error nin date valuecA500 write (unit=output,fmt=3) 'Error in absolute time value \' // 1 val(:TRIM(val)) // '\'c600 error = .true.c 999 continue return endww­@DΚ“‹ subroutine MODQUOTAcc Iowa State University&c Computation Center Accounting Officec Rodrick A Eldridgecc Modify user recordc implicit integer (A-Z)c" include 'LIB:ISUDEF(QUOTA)/list'! include 'LIB:ISUDEF(USER)/list'c- include 'SYS$LIBRARY:FORSYSDEF($FORIOSDEF)'c commoon /control_c/control_c logical*4 control_cc/ common /units/input,output,command,update,list+ integer*4 input,output,command,update,listc common /modify/modified,modify logical*4 modified integer*4 modifyc integer*2 group,member# integer*4 option,status,msg_length logical*4 error! character*3 chr_group,chr_member character*12 username character*80 msg integer*4 TRIMc1 format (1x,a,$)2 format (q,a)3 format (1x,a) 4 format (o3)c first_flag = .trupe.cc read first userc username = from_username group = from_group member = from_member option = 3% call IOSQUOTA (update,option,status) if (status .ne. 0) goto 300 goto 200cc read next userc100 if (control_c) goto 999 username = from_username group = from_group member = from_group option = 0% call IOSQUOTA (update,option,status) if (status .ne. 0) goto 300c*c check for user past last user to be readc200 if (to_flag .eq. 0) then9 length q= MIN (TRIM (from_username),TRIM (to_username))8 if (from_username(:length) .gt. to_username(:length)) 1 goto 500 elseif (to_flag .gt. 0) then% if (from_uic .gt. to_uic) goto 500 elseif (to_flag .lt. 0) then) if (from_group .gt. to_group) goto 500 endifcc check if DEFAULT recordc- if (quota_username .eq. 'DEFAULT ') then unlock (unit=update) write (unit=output,fmt=3)* 1 'The DEFAULT record can not be updated' write (unit=output,fmt=3)9 1 'Use the DErFAULT command to update the DEFAULT record' goto 100 endifcc move update values to recordc call UPDQUOTAcc rewrite record to quota filec option = 4% call IOSQUOTA (update,option,status) unlock (unit=update) if (control_c) then goto 999 elseif (status .ne. 0) then goto 400 elseif (modify .lt. 0) then9 write (unit=output,fmt=3) 'User record cancelled \' /// 1 quota_username(:TRIM(quota_username)) // '\' elseif (modify .gt. 0) then9 write (units=output,fmt=3) 'User record activated \' /// 1 quota_username(:TRIM(quota_username)) // '\' else7 write (unit=output,fmt=3) 'User record updated \' /// 1 quota_username(:TRIM(quota_username)) // '\' endif first_flag = .false. modified = .true. goto 100c c read statusc+300 if (status .eq. FOR$IOS_SPERECLOC) then goto 600, elseif (status .eq. FOR$IOS_ATTACCNON) then goto 500 elseif (status .lt. 0) then goto 500 else' msg = 'Unable to update user retcord' goto 700 endifcc rewrite statusc+400 if (status .eq. FOR$IOS_SPERECLOC) then goto 600 else' msg = 'Unable to update user record' goto 700 endifc,c check that at least one record was updatedc500 if (first_flag) then status = FOR$IOS_SPERECLOC% msg = 'User record does not exist' goto 700 else goto 999 endifcc user record is lockedc!600 msg = 'User record is locked'cc write error messagec700 if (from_flag .euq. 0) then$ msg = msg(:TRIM(msg)) // ' \' //# 1 username(:TRIM(username)) // '\' elseif (from_flag .gt. 0) then write (chr_group,fmt=4) group" write (chr_member,fmt=4) member do i = 1,26 if (chr_group(i:i) .eq. ' ') chr_group(i:i) = '0'8 if (chr_member(i:i) .eq. ' ') chr_member(i:i) = '0' enddo$ msg = msg(:TRIM(msg)) // ' \[' //) 1 chr_group // ',' // chr_member // ']\' elseif (from_flag .lt. 0) then write (chr_group,fmt=4) group do i = 1,26 if v(chr_group(i:i) .eq. ' ') chr_group(i:i) = '0' enddo$ msg = msg(:TRIM(msg)) // ' \[' // 1 chr_group // ',*]\' endif msg_length = TRIM (msg)+ write (unit=output,fmt=3) msg(:msg_length)( if (status .ne. FOR$IOS_SPERECLOC) then call ERRSNS (,,,,status)& call GETMSG (status,msg,msg_length)- write (unit=output,fmt=3) msg(:msg_length) endifc 999 continue return endww­@*ΔΚ“‹ subroutine RMVQUOTAcc Iowa State University&c Computation Center Accountwing Officec Rodrick A Eldridgecc Modify user recordc implicit integer (A-Z)c" include 'LIB:ISUDEF(QUOTA)/list'! include 'LIB:ISUDEF(USER)/list'c- include 'SYS$LIBRARY:FORSYSDEF($FORIOSDEF)'c common /control_c/control_c logical*4 control_cc/ common /units/input,output,command,update,list+ integer*4 input,output,command,update,listc common /modify/modified,modify logical*4 modified integer*4 modifyc integer*2 group,member# integer*4 option,statxus,msg_length logical*4 error! character*3 chr_group,chr_member character*12 username character*80 msg integer*4 TRIMc1 format (1x,a,$)2 format (q,a)3 format (1x,a) 4 format (o3)c first_flag = .true.cc read first userc username = from_username group = from_group member = from_member option = 3% call IOSQUOTA (update,option,status) if (status .ne. 0) goto 300 goto 200cc read next userc100 if (control_c) goto 999 username = from_useyrname group = from_group member = from_member option = 0% call IOSQUOTA (update,option,status) if (status .ne. 0) goto 300c*c check for user past last user to be readc200 if (to_flag .eq. 0) then9 length = MIN (TRIM (from_username),TRIM (to_username))8 if (from_username(:length) .gt. to_username(:length)) 1 goto 500 elseif (to_flag .gt. 0) then% if (from_uic .gt. to_uic) goto 500 elseif (to_flag .lt. 0) then) if (from_group .gt. to_group) goto 500 endifzcc check if DEFAULT recordc- if (quota_username .eq. 'DEFAULT ') then unlock (unit=update) write (unit=output,fmt=3)* 1 'The DEFAULT record can not be removed' goto 100 endifcc delete record to quota filec option = 6% call IOSQUOTA (update,option,status) unlock (unit=update) if (control_c) then goto 999 else7 write (unit=output,fmt=3) 'User record removed \' /// 1 quota_username(:TRIM(quota_username)) // '\' endif first_flag = .false{. modified = .true. goto 100c c read statusc+300 if (status .eq. FOR$IOS_SPERECLOC) then goto 600, elseif (status .eq. FOR$IOS_ATTACCNON) then goto 500 elseif (status .lt. 0) then goto 500 else' msg = 'Unable to remove user record' goto 700 endifcc rewrite statusc+400 if (status .eq. FOR$IOS_SPERECLOC) then goto 600 else' msg = 'Unable to remove user record' goto 700 endifc,c check that at least one record was removedc|500 if (first_flag) then status = FOR$IOS_SPERECLOC% msg = 'User record does not exist' goto 700 else goto 999 endifcc user record is lockedc!600 msg = 'User record is locked'cc write error messagec700 if (from_flag .eq. 0) then$ msg = msg(:TRIM(msg)) // ' \' //# 1 username(:TRIM(username)) // '\' elseif (from_flag .gt. 0) then write (chr_group,fmt=4) group" write (chr_member,fmt=4) member do i = 1,26 if (chr_group(i:i) .eq. ' '}) chr_group(i:i) = '0'8 if (chr_member(i:i) .eq. ' ') chr_member(i:i) = '0' enddo$ msg = msg(:TRIM(msg)) // ' \[' //) 1 chr_group // ',' // chr_member // ']\' elseif (from_flag .lt. 0) then write (chr_group,fmt=4) group do i = 1,26 if (chr_group(i:i) .eq. ' ') chr_group(i:i) = '0' enddo$ msg = msg(:TRIM(msg)) // ' \[' // 1 chr_group // ',*]\' endif msg_length = TRIM (msg)+ write (unit=output,fmt=3) msg(:msg_length)( if (status .ne. FOR$IOS_SPERECLOC) then~ call ERRSNS (,,,,status)& call GETMSG (status,msg,msg_length)- write (unit=output,fmt=3) msg(:msg_length) endifc 999 continue return endww­ΰŸ­Κ“‹ subroutine SHOQUOTAcc Iowa State University&c Computation Center Accounting Officec Rodrick A Eldridgecc Show user recordc implicit integer (A-Z)c" include 'LIB:ISUDEF(QUOTA)/list'! include 'LIB:ISUDEF(USER)/list'c- include 'SYS$LIBRARY:FORSYSDEF($FORIOSDEF)'c common /control_c/control_c logical*4 control_cc/ common /units/input,output,command,update,list+ integer*4 input,output,command,update,listc- common /show/show_type,show_output,show_flag* integer*4 show_type,show_output,show_flagc common /show$/show_file character*80 show_filec integer*2 group,member< integer*4 show,status,option,msg_length,hmsh(4),list_option real*8 doubleword logical*4 first_flag byte cr/13/,lf/10/! character*3 chr_group,chr_member character*4 chr4% cha€racter*8 chr8,chr_status,chr_mask character*12 username* character*14 chr_time,chr_quota,chr_limit character*23 chr23 character*80 msg,line,filec1 format (1x,a,$)2 format (q,a)3 format (1x,a) 4 format (o3) 5 format (z8) 6 format (z4) 7 format (i2) 8 format (i5)cc open output filec if (show_output .eq. 1) then show = list3 open (unit=show,file=show_file,status='UNKNOWN',5 1 defaultfile='QUOTA.lis',carriagecontrol='FORTRAN', 2 err=900) else show = output endifc inquire (unit=show,name=file)c first_flag = .true. if (show_type .eq. 1) then if (show_flag .eq. 1) then list_option = 1! elseif (show_flag .eq. 2) then list_option = -1 endif elseif (show_type .eq. 2) then list_option = 0 endifcc read first userc username = from_username group = from_group member = from_member option = 3% call IOSQUOTA (update,option,status) if (status .ne. 0) goto 400 goto 200cc re‚ad next userc100 if (control_c) goto 999 username = from_username group = from_group member = from_member option = 0% call IOSQUOTA (update,option,status) if (status .ne. 0) goto 400c*c check for user past last user to be readc200 if (to_flag .eq. 0) then9 length = MIN (TRIM (from_username),TRIM (to_username))8 if (from_username(:length) .gt. to_username(:length)) 1 goto 600 elseif (to_flag .gt. 0) then% if (from_uic .gt. to_uic) goto 600 elseif (to_flƒag .lt. 0) then) if (from_group .gt. to_group) goto 600 endifcc display user recordc if (first_flag) then first_flag = .false. write (unit=output,fmt=3) ' ' else6 if (show_type .eq. 1) write (unit=output,fmt=3) ' ' endif( call LISQUOTA (show,list_option,status) goto 100c c read statusc+400 if (status .eq. FOR$IOS_SPERECLOC) then goto 700, elseif (status .eq. FOR$IOS_ATTACCNON) then goto 600 elseif (status .lt. 0) then goto 600 else„% msg = 'Unable to show user record' goto 800 endifcc error generating listing filec500 if (show .eq. list) then call ERRSNS (,,,,status)& call GETMSG (status,msg,msg_length)A write (unit=output,fmt=3) 'Error generating listing file \' // 1 file(:TRIM(file)) // '\'- write (unit=output,fmt=3) msg(:msg_length) endif goto 999c*c check that at least one record was shownc600 if (first_flag) then status = FOR$IOS_SPERECLOC% msg = 'User record do…es not exist' goto 800 else goto 999 endifcc user record is lockedc!700 msg = 'User record is locked'cc write error messagec800 if (from_flag .eq. 0) then$ msg = msg(:TRIM(msg)) // ' \' //# 1 username(:TRIM(username)) // '\' elseif (from_flag .gt. 0) then write (chr_group,fmt=4) group" write (chr_member,fmt=4) member do i = 1,26 if (chr_group(i:i) .eq. ' ') chr_group(i:i) = '0'8 if (chr_member(i:i) .eq. ' ') chr_member(i:i) = '0' † enddo$ msg = msg(:TRIM(msg)) // ' \[' //) 1 chr_group // ',' // chr_member // ']\' elseif (from_flag .lt. 0) then write (chr_group,fmt=4) group do i = 1,26 if (chr_group(i:i) .eq. ' ') chr_group(i:i) = '0' enddo$ msg = msg(:TRIM(msg)) // ' \[' // 1 chr_group // ',*]\' endif msg_length = TRIM (msg)+ write (unit=output,fmt=3) msg(:msg_length)( if (status .ne. FOR$IOS_SPERECLOC) then call ERRSNS (,,,,status)& call GETMSG (status,msg,msg_length)- write (un‡it=output,fmt=3) msg(:msg_length) endifc goto 999cc Unable to open output filec900 call ERRSNS (,,,,status)$ call GETMSG (status,msg,msg_length)< write (unit=output,fmt=3) 'Unable to open output file \' // 1 file(:TRIM(file)) // '\'cc close output filec7999 if (.not. first_flag .and. show_output .eq. 1) then if (control_c) then' close (unit=show,dispose='DELETE') else% close (unit=show,dispose='KEEP') endif endifc return endwwˆ­ΰοpΚ“‹ subroutine UPDQUOTAcc Iowa State University&c Computation Center Accounting Officec Rodrick A Eldridgecc Update user recordc implicit integer (A-Z)c" include 'LIB:ISUDEF(QUOTA)/list'% include 'LIB:ISUDEF(DFTQUOTA)/list'c common /control_c/control_c logical*4 control_cc# common /units/input,output,command integer*4 input,output,commandc common /mad/ans integer*4 ans(39)c$ common /dept/deptnum,deptmax,ncdnum! integer*4 deptnum,dep‰tmax,ncdnumc common /dept$/collnum,deptname character*1 collnum(199) character*20 deptname(199)c common /bldg$/bldgmin,bldgmax character*2 bldgmin,bldgmaxc" include 'LIB:QUOTA(UPDATE)/list'c1 format (1x,a,$)2 format (q,a)3 format (1x,a) 4 format (i3)c" if (ans(2) .eq. -1) then ! uic quota_group = update_group quota_member = update_member endif$ if (ans(3) .eq. -1) then ! owner quota_owner = update_owner endif& if (ans(4) .eq. -1) theŠn ! address! quota_address = update_address endif$ if (ans(5) .eq. -1) then ! bldg#! quota_bldgnum = update_bldgnum endif% if (ans(6) .eq. -1) then ! phone#! quota_phonnum = update_phonnum endif' if (ans(7) .eq. -1) then ! college#! quota_collnum = update_collnum endif$ if (ans(8) .eq. -1) then ! dept#! quota_deptnum = update_deptnum endif' if (ans(9) .eq. -1) then ! deptname# quota_deptname = update_deptname endif# if (ans(10) .eq. -1) th‹en ! mask quota_mask = update_mask endif% if (ans(11) .eq. -1) then ! status quota_status = update_status endif( if (ans(12) .eq. -1) then ! privilege! quota_isupriv = update_isupriv endif$ if (ans(13) .eq. -1) then ! pkplm! quota_purkeep = update_purkeep endif( if (ans(14) .eq. -1) then ! authorize+ quota_authorize(1) = update_authorize(1)+ quota_authorize(2) = update_authorize(2) endif% if (ans(15) .eq. -1) then ! expire% quota_expire(1) = uŒpdate_expire(1)% quota_expire(2) = update_expire(2) endif$ if (ans(16) .eq. -1) then ! login# quota_login(1) = update_login(1)# quota_login(2) = update_login(2) endif% if (ans(17) .eq. -1) then ! logout% quota_logout(1) = update_logout(1)% quota_logout(2) = update_logout(2) endif% if (ans(18) .eq. -1) then ! update% quota_update(1) = update_update(1)% quota_update(2) = update_update(2) endif% if (ans(19) .eq. -1) then ! nlogin quota_nlogin = update_nlogin endif& if (ans(20) .eq. -1) then ! nlogout! quota_nlogout = update_nlogout endif$ if (ans(24) .eq. -1) then ! dollm if (update_flag .eq. 0) then% quota_dollm = update_quota_dollm# elseif (update_flag .gt. 0) then% usage_dollm = update_usage_dollm endif endif& if (ans(25) .eq. -1) then ! cputime if (update_flag .eq. 0) then) quota_cputime = update_quota_cputime# elseif (update_flag .gt. 0) then) usage_cputime = update_usage_cputŽime endif endif# if (ans(26) .lt. 0) then ! cpulm if (update_flag .lt. 0) then% costs_cpulm = update_costs_cpulm# elseif (update_flag .eq. 0) then% quota_cpulm = update_quota_cpulm# elseif (update_flag .gt. 0) then% usage_cpulm = update_usage_cpulm endif endif% if (ans(27) .lt. 0) then ! trmtime if (update_flag .eq. 0) then) quota_trmtime = update_quota_trmtime# elseif (update_flag .gt. 0) then) usage_trmtime = update_usage_trmtime endif endif# if (ans(28) .lt. 0) then ! trmlm if (update_flag .lt. 0) then% costs_trmlm = update_costs_trmlm# elseif (update_flag .eq. 0) then% quota_trmlm = update_quota_trmlm# elseif (update_flag .gt. 0) then% usage_trmlm = update_usage_trmlm endif endif& if (ans(29) .lt. 0) then ! dskspace if (update_flag .eq. 0) then+ quota_dskspace = update_quota_dskspace# elseif (update_flag .gt. 0) then+ usage_dskspace = update_usage_dskspace endif endif# if (ans(30) .lt. 0) then ! dsklm if (update_flag .eq. 0) then% quota_dsklm = update_quota_dsklm# elseif (update_flag .gt. 0) then% usage_dsklm = update_usage_dsklm endif endif& if (ans(31) .lt. 0) then ! prtpages if (update_flag .eq. 0) then+ quota_prtpages = update_quota_prtpages# elseif (update_flag .gt. 0) then+ usage_prtpages = update_usage_prtpages endif endif# if (ans(32) .lt. 0) then ! prtlm if (update_‘flag .lt. 0) then% costs_prtlm = update_costs_prtlm# elseif (update_flag .eq. 0) then% quota_prtlm = update_quota_prtlm# elseif (update_flag .gt. 0) then% usage_prtlm = update_usage_prtlm endif endif" if (ans(33) .eq. -1) then ! ncslm if (update_flag .eq. 0) then% quota_ncslm = update_quota_ncslm# elseif (update_flag .gt. 0) then% usage_ncslm = update_usage_ncslm endif endif# if (ans(34) .lt. 0) then ! diolm if (update_flag .lt. 0) t’hen% costs_diolm = update_costs_diolm# elseif (update_flag .eq. 0) then% quota_diolm = update_quota_diolm# elseif (update_flag .gt. 0) then% usage_diolm = update_usage_diolm endif endif/ if (ans(35) .lt. 0) then ! semester flag# quota_semester = update_semester endif& if (ans(36) .lt. 0) then ! activate' quota_expire(1) = dftquota_expire(1)' quota_expire(2) = dftquota_expire(2) endif$ if (ans(37) .lt. 0) then ! cancel% quota_expire(1) =“ update_expire(1)% quota_expire(2) = update_expire(2) endifcAc bypass check if DEFAULT record and COLLEGE# = 0 and DEPT# = 000c- if (quota_username .eq. 'DEFAULT ') then= if (quota_deptnum .eq. '000' .and. quota_collnum .eq. '0') 1 goto 999 endifcc check college# and dept#c# read (quota_deptnum,fmt=4) deptnum if (deptnum .le. 0) then goto 100# elseif (deptnum .gt. deptmax) then goto 100 endif2 if (collnum(deptnum) .ne. quota_collnum) goto 200” if (deptnum .ne. ncdnum) then% quota_deptname = deptname(deptnum) else( if (quota_deptname .eq. ' ') goto 300 endif goto 999cc Invalid dept#c;100 write (unit=output,fmt=3) 'Warning: invalid DEPT# \' // 1 quota_deptnum // '\' goto 999cc Invalid college# for dept#c>200 write (unit=output,fmt=3) 'Warning: invalid COLLEGE# \' //7 1 quota_collnum // '\ for DEPT# \' // quota_deptnum // 2 '\' goto 999cc Invalid deptnamec9300 write (unit=output,fmt=3) 'Warning: invalid DEPTNAME'c 999 continue return endww