c *** ASGN.FOR *** include 'asgn.blk' open(1,file='asg_cntrl.par') read(1,*) iyr0,idate read(1,*) ith_obs close (1) itar_date=iyr0*10000+idate date=nart(idate) len=lentrim(date) do 10000 icases=1,2 f_wtlist='wtst0000.sta' f_wtlist(8-len+1:8)=date f_wtchk=f_wtlist f_wtchk(10:12)='chk' f_bthsta='brth0000.sta' f_bthsta(8-len+1:8)=date f_bthchk=f_bthsta f_bthchk(10:12)='chk' f_wtbak=f_wtlist f_wtbak(10:12)='bak' f_facsta='faccility.sta' f_facchk=f_facsta f_facchk(11:13)='chk' xtrshf=(extenhr-shfhr0(1))/24*nshifts+1 do 20 idy=1,400 do 20 jsf=1,nshifts ksf=nshifts*(idy-1)+jsf shifthr0(ksf)=24.*(idy-1)+shfhr0(jsf) shifthr9(ksf)=24.*(idy-1)+shfhr9(jsf) 20 continue open(1,file='bth.par') open(2,file='bth.chk') nberths=0 do 30 i=1,1000 read(1,39,end=31) m,bthname(m),bthtyp(m),bthgrp(m),bthlen(m) 1,bthdpth(m),bthcrns(m) write(2,39) m,bthname(m),bthtyp(m),bthgrp(m),bthlen(m) 1,bthdpth(m),bthcrns(m) mxbthgrp=max0(mxbthgrp,bthgrp(m)) nberths=nberths+1 39 format(i4,t6,a4,t12,a3,t18,i2,t21,2f7.1,t36,i4) 30 continue 31 close (1) close (2) open(1,file='vsl.par') open(2,file='vsl.chk') nvsltyp=0 do 40 i=1,1000 read(1,49,end=41) vsltyp(i),r_hndl(i),ava_facs0(i),nb_forvsl(i) 1,(b_forvsl(i,k),k=1,nb_forvsl(i)) write(2,49) vsltyp(i),r_hndl(i),ava_facs0(i),nb_forvsl(i) 1,(b_forvsl(i,k),k=1,nb_forvsl(i)) nvsltyp=nvsltyp+1 49 format(a3,t5,f5.0,i3,t14,i2,1x,20(1x,a4)) 40 continue 41 close (1) close (2) open(1,file='agent.par') open(2,file='agent.chk') nagent=0 do 50 i=1,1000 read(1,59,end=51) m,agent0(m),nb_agent(m),(b_agent(m,k) 1,k=1,nb_agent(m)) write(2,59) m,agent0(m),nb_agent(m),(b_agent(m,k) 1,k=1,nb_agent(m)) nagent=nagent+1 59 format(i3,t6,a5,t12,i2,1x,20(1x,a4)) 50 continue 51 close (1) close (2) c open(1,file=f_wtlist) open(2,file=f_wtchk) do 100 i=1,10000 read(1,109,end=101) m,asgn_bth0(i),shipname(i),shipcomp(i) 1,shiptyp(i),prio(i),shiplen(i),shipdrft(i),arvdate(i),arvtime(i) 2,vol0(i) write(2,109) m,asgn_bth0(i),shipname(i),shipcomp(i) 1,shiptyp(i),prio(i),shiplen(i),shipdrft(i),arvdate(i),arvtime(i) 2,vol0(i) maxpri=max0(maxpri,prio(i)) n_wtlist=i 109 format(i4,t6,a4,t13,a5,t24,a5,t32,a3,t38,i2,t41,f7.1,f6.1 1,i9,i5,i7) 100 continue 101 close (1) close (2) do 120 i=1,n_wtlist call hour(iyr0,arvdate(i),arvtime(i),arvhr(i)) 120 continue call sort(n_wtlist,arvhr,arvhr1,iarvhr) c open(1,file=f_bthsta) open(2,file=f_bthchk) do 200 i=1,10000 read(1,219,end=201) j,str,str,dum,dum 1,nbth_ocp(j),(ocp_ship(j,k),ocp_len(j,k),ocp_date(j,k),ocp_time 2(j,k),remnhr(j,k),k=ktmp(j),nbth_ocp(j)) 219 format(i4,t7,a4,t14,a3,t19,2f7.1,t35,i2,t38,a8,t49,f7.1,i9,i5,i6) write(2,219) j,bthname(j),bthtyp(j),bthlen(j),bthdpth(j) 1,nbth_ocp(j),(ocp_ship(j,k),ocp_len(j,k),ocp_date(j,k),ocp_time 2(j,k),remnhr(j,k),k=ktmp(j),nbth_ocp(j)) do 210 nv=ktmp(j),nbth_ocp(j) ival1=ocp_date(j,nv) ival2=ocp_time(j,nv) call hour(iyr0,ival1,ival2,bthing_tm(j,nv)) 210 continue ktmp(j)=ktmp(j)+1 200 continue 201 close (1) close (2) call hour(iyr0,itar_date,shfhr0(1),tar_hr0) itar_hr0=tar_hr0 idy=(itar_hr0-shfhr0(1))/24 hr=itar_hr0-idy*24 do 250 isf=1,nshifts if(hr.lt.shfhr9(isf)) go to 251 250 continue 251 ithshf=idy*nshifts+isf do 260 ib=1,nberths ing=bthgrp(ib) do 260 jh=itar_hr0,itar_hr0+extenhr kh=jh-itar_hr0+1 grp_len(ing,kh)=0. ava_len(ing,kh)=0. ava_1len(ib,kh)=0. ava_facs(ing,kh)=0. 260 continue do 270 ib=1,nberths ing=bthgrp(ib) if(ing.le.0) go to 270 do 280 jh=itar_hr0,itar_hr0+extenhr kh=jh-itar_hr0+1 grp_len(ing,kh)=grp_len(ing,kh)+bthlen(ib) ava_len(ing,kh)=grp_len(ing,kh) ava_1len(ib,kh)=bthlen(ib) ava_facs(ing,kh)=ava_facs(ing,kh)+bthcrns(ib) 280 continue 270 continue c open(1,file=f_facsta) open(2,file=f_facchk) nfacs=0 do 300 i=1,100000 read(1,'(i5,2a10,a3,i9,i5)',end=301) j,fac_typ(j),facloc(j) 1,fac_sta(j),fac_bakd(j),fac_bakh(j) write(2,'(i5,2a10,a3,i9,i5)') j,fac_typ(j),facloc(j) 1,fac_sta(j),fac_bakd(j),fac_bakh(j) nfacs=nfacs+1 300 continue 301 close (1) close (2) do 320 kfac=1,nfacs len1=lentrim(facloc(kfac)) do 330 l1=1,len1 if(facloc(kfac)(l1:l1).ne.' ') go to 331 330 continue 331 do 340 ib=1,nberths ing=bthgrp(ib) if(ing.le.0) go to 340 len2=lentrim(bthname(ib)) do 350 l2=1,len1 if(bthname(ib)(l2:l2).ne.' ') go to 351 350 continue 351 ld=l1-l2 do 360 l=l1,len1 if(facloc(kfac)(l:l).ne.bthname(ib)(l-ld:l-ld)) go to 340 360 continue call hour(iyr0,fac_bakd(kfac),fac_bakh(kfac),fac_back(kfac)) kfh=fac_back(kfac) kh=max0(itar_hr0,kfh) do 370 jh=kh,itar_hr0+extenhr kh=jh-itar_hr0+1 if(ing.le.0) go to 370 c ava_facs(ing,kh)=ava_facs(ing,kh)+1 370 continue go to 320 340 continue 320 continue do 600 ib=1,nberths do 600 jh=itar_hr0,itar_hr0+extenhr kh=jh-itar_hr0+1 ocp_bthr(ib,kh)=0 600 continue do 610 ib=1,nberths ing=bthgrp(ib) do 620 nv=1,nbth_ocp(ib) if(remnhr(ib,nv).le.0) go to 620 ocptm0(ib,nv)=itar_hr0 dumhr=remnhr(ib,nv) mxcrn=ocp_len(ib,nv)/60.+1 do 640 isf=ithshf,ithshf+xtrshf mcr=dumhr/11.+1 if(bthtyp(ib)(1:3).eq.'con') mfc=min0(mxcrn,mcr) if(bthtyp(ib)(1:3).ne.'con') mfc=mxcrn jh0=max0(shifthr0(isf),itar_hr0) do 650 jh=jh0,shifthr9(isf)-1 kh=jh-itar_hr0+1 mfc=min0(mfc,ava_facs(ing,kh)) ava_facs(ing,kh)=ava_facs(ing,kh)-mfc if(bthtyp(ib)(1:3).ne.'con') ava_facs(ing,kh)=mxcrn dumhr=dumhr-mfc ocptm9(ib,nv)=jh if(dumhr.le.0) go to 661 650 continue 640 continue go to 620 661 do 660 jh=ocptm0(ib,nv),ocptm9(ib,nv) kh=jh-itar_hr0+1 ava_len(ing,kh)=ava_len(ing,kh)-ocp_len(ib,nv) ava_1len(ib,kh)=ava_1len(ib,kh)-ocp_len(ib,nv) ocp_bthr(ib,kh)=ocp_bthr(ib,kh)+1 660 continue 620 continue 610 continue c open(1,file='basg0506.rec') nrecs=0 do 700 i=1,10000 read(1,709,end=701) j,shipname(j),basgned(j) 1,arvdate0(j),arvtime0(j),dptdate0(j),dpttime0(j),vol0(j) 709 format(i2,t5,a17,t23,a4,t28,i8,t37,i4,t42,i8,t51,i4,t56,i6) call hour(iyr0,arvdate0(j),arvtime0(j),arvhr0(j)) call hour(iyr0,dptdate0(j),dpttime0(j),dpthr0(j)) nrecs=nrecs+1 700 continue 701 close (1) do 680 ib=1,nberths do 680 ih=itar_hr0,itar_hr0+extenhr kh=ih-itar_hr0+1 do 680 itr=1,mxasgns cranes(ib,itr,kh)=0 680 continue open(2,file=f_wtbak) if(icases.eq.1) open(3,file='asgn.obs') if(icases.eq.2) open(3,file='asgn.out') irun=0. 702 irun=irun+1 do 1000 i=1,n_wtlist ith=iarvhr(i) itharv=arvhr(ith) if(irun.ne.prio(ith)) go to 1000 call typid(ith) if(ith_vsltyp.le.0) go to 1000 call seghrs(ith) if(ith_agent.le.1) crnhr0(ith)=vol0(ith)/(r_hndl(ith_vsltyp)*1.2) if(ith_agent.gt.1) crnhr0(ith)=vol0(ith)/r_hndl(ith_vsltyp) do 1020 ib=1,nberths if(ith.ne.ith_obs.or.nseg_hr(ib).le.0) go to 1020 write(8,'(a,2x,i4,10(1x,2i5))') ' Idle Time Periods ',ib 1,(seg_hr0(ib,m),seg_hr9(ib,m),m=1,nseg_hr(ib)) 1020 continue xdpt=huge do 1100 ib=1,nberths t0=arvhr(ith) icont(ib)=1 crnhr(ib,icont(ib))=crnhr0(ith) psu_dpt(ib,icont(ib))=huge if(icases.eq.2) go to 1101 if(basgned(ith)(1:4).eq.' ') go to 1101 if(basgned(ith)(1:4).ne.bthname(ib)(1:4)) go to 1100 1101 call trydpt(ith,ib,ib,t0) if(crnhr(ib,1).le.0) minbth(ib,1)=ib if(ith.ne.ith_obs.or.nseg_hr(ib).le.0) go to 1102 write(8,'(a,4i4,3f9.1)') ' In & Out Time ',ith,ib,icont(ib),ib 2,crnhr(ib,1),psu_btm(ib,1),psu_dpt(ib,1) 1102 if(crnhr(ib,icont(ib)).gt.0) go to 1100 if(psu_dpt(ib,icont(ib)).ge.xdpt) go to 1100 xdpt=psu_dpt(ib,icont(ib)) 1100 continue do 1200 ib=1,nberths 1201 if(crnhr(ib,icont(ib)).le.0) go to 1200 if(psu_dpt(ib,icont(ib)).ge.xdpt) go to 1200 t0=psu_dpt(ib,icont(ib)) hr0=crnhr(ib,icont(ib)) icont(ib)=icont(ib)+1 minbth(ib,icont(ib))=0 dptmin=huge if(icont(ib).gt.mxasgns) go to 1200 do 1220 kb=1,nberths if(nseg_hr(kb).le.0) go to 1220 crnhr(ib,icont(ib))=hr0 call trydpt(ith,ib,kb,t0) if(ith.ne.ith_obs.or.nseg_hr(ib).le.0) go to 1221 write(8,'(a,4i4,3f9.1)') ' In & Out Time ',ith,ib,icont(ib),kb 1,crnhr(ib,icont(ib)),psu_btm(ib,icont(ib)),psu_dpt(ib,icont(ib)) 1221 if(crnhr(ib,icont(ib)).gt.0) go to 1220 if(psu_dpt(ib,icont(ib)).ge.dptmin) go to 1220 dptmin=psu_dpt(ib,icont(ib)) minbth(ib,icont(ib))=kb 1220 continue if(minbth(ib,icont(ib)).eq.0) icont(ib)=icont(ib)-1 go to 1201 1200 continue xmin=huge minb0=0 do 1410 kb=1,nberths itr=icont(kb) if(ith.ne.ith_obs.or.nseg_hr(kb).le.0) go to 1411 write(8,'(9x,3i4,3f9.1)') ith,kb,itr,crnhr(kb,itr) 1,psu_btm(kb,itr),psu_dpt(kb,itr) 1411 if(crnhr(kb,itr).gt.0) go to 1410 if(psu_dpt(kb,itr).ge.xmin) go to 1410 xmin=psu_dpt(kb,itr) minb0=kb 1410 continue if(minb0.gt.0) go to 1414 do 1440 kb=1,nberths itr=icont(kb) write(4,'(1x,3i4,4f9.1,10i6)') ith,itr,kb,crnhr(kb,itr) 1,arvhr(ith),psu_btm(kb,itr),psu_dpt(kb,itr),nseg_hr(kb) 2,(seg_hr0(kb,m),seg_hr9(kb,m),m=1,nseg_hr(kb)) 1440 continue go to 1000 c1414 write(7,'(2(i4,a11,a))') ith,shipname(ith),' ===> ',minb0 c 1,bthname(minb0) 1414 twt=0. do 1600 ic=1,icont(minb0) minb=minbth(minb0,ic) tmp_bth(ith)=bthname(minb) if(minb.le.0) write(*,'(4i5)') ith,minb0,ic,minb mng=bthgrp(minb) if(mng.le.0) write(*,'(a,i4)') ' bthgrp MNG not defined! ',mng btm(ith)=psu_btm(minb0,ic) dpt(ith)=psu_dpt(minb0,ic) kh0=psu_btm(minb0,ic) kh9=wk_hr9(minb0,ic)+0.5 do 1420 mh=kh0,kh9 kh=mh-itar_hr0+1 ava_facs(mng,kh)=ava_facs(mng,kh)-cranes(minb0,ic,kh) ava_len(mng,kh)=ava_len(mng,kh)-shiplen(ith) ava_1len(minb,kh)=ava_1len(minb,kh)-shiplen(ith) ocp_bthr(minb,kh)=ocp_bthr(minb,kh)+1 1420 continue k=ith if(ic.eq.1) write(2,109) k,tmp_bth(k),shipname(k),shipcomp(k) 1,shiptyp(k),prio(k),shiplen(k),shipdrft(k),arvdate(k) 2,arvtime(k),vol0(k) if(ic.eq.1) wt=psu_btm(minb0,ic)-arvhr(k) if(ic.gt.1) wt=psu_btm(minb0,ic)-psu_dpt(minb0,ic-1) twt=twt+wt ptm=psu_dpt(minb0,icont(minb0))-arvhr(k) if(icont(minb0).gt.1.and.ic.eq.1) write(3,2009) k,shipname(k) 1(1:10),shipcomp(k),shiptyp(k),shiplen(k),shipdrft(k),prio(k) 2,crnhr0(k),tmp_bth(k),arvhr(k),psu_btm(minb0,1),psu_dpt(minb0,1) if(icont(minb0).gt.1.and.ic.gt.1) write(3,2019) bthname(minbth 1(minb0,ic)),psu_btm(minb0,ic),psu_dpt(minb0,ic),twt,ptm if(icont(minb0).eq.1) write(3,2009) k,shipname(k)(1:10),shipcomp 1(k),shiptyp(k),shiplen(k),shipdrft(k),prio(k),crnhr0(k),tmp_bth(k) 2,arvhr(k),psu_btm(minb0,1),psu_dpt(minb0,1),twt,ptm 2009 format(1x,i3,t6,a10,t17,a6,t23,a3,t28,2f7.1,t42,i4,t48,f6.1,t55 1,a4,t60,5f7.1) 2019 format(1x,t55,a4,t67,5f7.1) 1600 continue 1000 continue if(irun.lt.maxpri) go to 702 close (2) close (3) 10000 continue end c character*(*) function nart(num) character*10 temp,chnum write(temp,'(i10)') num read(temp,'(a)') chnum 10 if(chnum(1:1).ne.' ') go to 20 chnum=chnum(2:len(chnum)) go to 10 20 nart=chnum return end c subroutine hour(iyr0,date,hrmin,hours) integer date,hrmin,year,month,day,monday1(12),monday2(12) data monday1/0,31,59,90,120,151,181,212,243,273,304,334/ data monday2/0,31,60,91,121,152,182,213,244,274,305,335/ hours=0. if(date.le.0.and.hrmin.eq.0) return lpyr0=mod(iyr0,4) year=date/10000 lpyr=mod(year,4) month=(date-year*10000)/100 day=mod(date,100) if(lpyr.ne.0) days=monday1(month)+day if(lpyr.eq.0) days=monday2(month)+day hh=hrmin/100 min=hrmin-hh*100. hours=days*24.+hh+min/60. if(iyr0.eq.year) go to 999 if(iyr0.eq.0.and.year.gt.iyr0) hours=hours+(8760.+24.)*(year-iyr0) if(iyr0.ne.0.and.year.gt.iyr0) hours=hours+8760.*(year-iyr0) if(year.lt.iyr0) hours=hours-8760. 999 return end c SUBROUTINE SORT(N,YI,YO,IN) INTEGER IN(*) REAL YI(*),YO(*) IF(N.LE.1) RETURN DO 10 I=1,N YO(I)=YI(I) 10 IN(I)=I DO 20 I=1,N-1 IF(YO(I)-YO(I+1))20,20,21 21 DO 30 IA=I-1,1,-1 IF(YO(I+1)-YO(IA))30,31,31 30 CONTINUE IA=0 31 YC=YO(I+1) NC=IN(I+1) DO 40 IB=I+1,IA+2,-1 YO(IB)=YO(IB-1) 40 IN(IB)=IN(IB-1) YO(IA+1)=YC IN(IA+1)=NC 20 CONTINUE RETURN END c subroutine typid(ith) include 'asgn.blk' ith_vsltyp=0 ith_agent=0 lvtp=lentrim(shiptyp(ith)) lagnt=lentrim(shipcomp(ith)) do 100 kz=1,nvsltyp if(shiptyp(ith)(1:lvtp).eq.vsltyp(kz)(1:lvtp)) go to 101 100 continue go to 102 101 ith_vsltyp=kz 102 do 150 kz=1,nagent if(shipcomp(ith)(1:lagnt).eq.agent0(kz)(1:lagnt)) go to 151 150 continue go to 999 151 ith_agent=kz 999 return end c subroutine seghrs(ith) include 'asgn.blk' do 100 ib=1,nberths do 10 k=1,20 seg_hr0(ib,k)=0 seg_hr9(ib,k)=0 10 continue nseg_hr(ib)=0 if(shipdrft(ith).gt.bthdpth(ib)) go to 100 do 110 iz=1,nb_forvsl(ith_vsltyp) if(bthname(ib)(1:4).eq.b_forvsl(ith_vsltyp,iz)(1:4)) go to 111 110 continue go to 100 111 if(shiptyp(ith)(1:3).ne.'con'.or.ith_agent.le.0) go to 132 if(nb_agent(ith_agent).le.0) go to 132 do 130 kz=1,nb_agent(ith_agent) if(b_agent(ith_agent,kz)(1:4).eq.bthname(ib)(1:4)) go to 132 130 continue go to 100 132 ing=bthgrp(ib) do 180 itr=1,mxasgns psu_btm(ib,itr)=0. 180 continue if(ing.le.0) write(*,'(a,i4)') ' SEGHRS-bthgrp not defined! ',ib jhr=itar_hr0 wkhrs=0. wk1hrs=0. half=0.5*shiplen(ith) jh0=itar_hr0 do 150 jh=jh0,jh0+extenhr kh=jh-itar_hr0+1 blen(kh)=ava_len(ing,kh)-shiplen(ith) b1len(kh)=ava_1len(ib,kh)-shiplen(ith) bocp(kh)=ocp_bthr(ib,kh)+1 if(blen(kh).ge.-12.and.bocp(kh).le.1) wkhrs=wkhrs+1 if(b1len(kh).ge.-12.and.bocp(kh).le.1) wk1hrs=wk1hrs+1 150 continue next_tm0=jh0 last=jh0+extenhr 161 nseg_hr(ib)=nseg_hr(ib)+1 163 test=0 seg_hr0(ib,nseg_hr(ib))=next_tm0 do 160 mh=next_tm0,last kh=mh-itar_hr0+1 if(bocp(kh).gt.2) go to 162 if(blen(kh).lt.-12.) go to 162 if(b1len(kh).lt.-12.) go to 162 166 seg_hr9(ib,nseg_hr(ib))=mh test=test+1 160 continue 162 next_tm0=mh+1 if(test.ge.min_wkhr.and.next_tm0.lt.last) go to 161 if(test.lt.min_wkhr.and.next_tm0.lt.last) go to 163 dif=seg_hr9(ib,nseg_hr(ib))-seg_hr0(ib,nseg_hr(ib)) if(dif.le.0) nseg_hr(ib)=nseg_hr(ib)-1 100 continue return end c subroutine trydpt(ith,ib,kb,t0) include 'asgn.blk' itr=icont(ib) if(nseg_hr(kb).le.0) go to 999 ing=bthgrp(kb) iseg0=0 121 iseg0=iseg0+1 if(iseg0.gt.nseg_hr(kb)) go to 999 if(seg_hr9(kb,iseg0).le.t0) go to 121 do 120 iseg=iseg0,iseg0 xseghr=seg_hr0(kb,iseg) xt=amax1(xseghr,t0) wkhr=seg_hr9(kb,iseg)-xt if(wkhr.ge.crnhr(ib,itr)) go to 122 if(wkhr.lt.min_wkhr) go to 121 122 asgn_to(ib,itr)=kb do 130 isf=ithshf,ithshf+xtrshf if(xt.lt.shifthr9(isf)) go to 131 130 continue go to 999 131 isf0=isf kt=xt jhr0=max0(shifthr0(isf0),kt) psu_btm(ib,itr)=amax1(arvhr(ith),xt) do 140 isf=isf0,ithshf+xtrshf if(ith_vsltyp.le.2) mxcrn=shiplen(ith)/60. if(ith_vsltyp.eq.3) mxcrn=1 if(ith_vsltyp.gt.3) mxcrn=shiplen(ith)/50. if(ith_vsltyp.le.2) mfc=crnhr(ib,itr)/11.+1 if(ith_vsltyp.gt.3) mfc=mxcrn jh0=max0(shifthr0(isf),jhr0) wk_hr0(ib,itr)=jh0 do 150 jh=jh0,shifthr9(isf)-1 kh=jh-itar_hr0+1 if(jh.gt.seg_hr9(kb,iseg)) go to 120 if(bthtyp(kb)(1:3).ne.'con') ava_facs(ing,kh)=mxcrn mfc=min0(mfc,ava_facs(ing,kh),mxcrn,ava_facs0(ith_vsltyp)) if(mfc.le.0) h=1.0 if(mfc.gt.0) h=amin1(crnhr(ib,itr)/mfc,1.0) psu_dpt(ib,itr)=jh+h crnhr(ib,itr)=crnhr(ib,itr)-mfc cranes(ib,itr,kh)=mfc wk_hr9(ib,itr)=psu_dpt(ib,itr) if(crnhr(ib,itr).le.0) go to 120 150 continue 140 continue 120 continue 999 return end