!-------------------------------BEGIN ADD---------------------------------
!Insert model-level declarations here, if any

INTEGER(big)                :: bigRecord
INTEGER(big)                :: bigDC
INTEGER(big)                :: bigDCbyID
INTEGER(big)                :: bigStore
INTEGER(big)                :: bigStoreByID
INTEGER(big)                :: bigFlowLink
INTEGER                     :: intErr

LOGICAL,DIMENSION(:,:),ALLOCATABLE :: logVisited

TYPE(Queue),POINTER         :: queDCrecords
TYPE(Queue),POINTER         :: queStoreRecords
TYPE(Queue),POINTER         :: queDCs
TYPE(Queue),POINTER         :: queStores
TYPE(Queue),POINTER         :: queShortage
TYPE(Queue),POINTER         :: queUnused
TYPE(Queue),POINTER         :: queMajorIteration
TYPE(Queue),POINTER         :: queBestCostToDCs

TYPE(QueueElements),POINTER :: qelDCrecordsP
TYPE(QueueElements),POINTER :: qelStoreRecordsP
TYPE(QueueElements),POINTER :: qelDCsP
TYPE(QueueElements),POINTER :: qelStoresP
TYPE(QueueElements),POINTER :: qelShortageP
TYPE(QueueElements),POINTER :: qelUnusedP

TYPE RecordRange
  INTEGER(big):: bigBeg
  INTEGER(big):: bigEnd
END TYPE RecordRange

TYPE Link
  INTEGER(reg) :: regDCseq
  INTEGER(reg) :: regStoreSeq
  REAL(dbl)    :: dblCost
  INTEGER(big) :: bigFlow
  INTEGER(big) :: bigPrevFlow
END TYPE Link

TYPE(Link),DIMENSION(:),TARGET,ALLOCATABLE :: lnkInfo
TYPE(Link),DIMENSION(:,:),ALLOCATABLE :: lnkDCsP

TYPE RetailStore
  INTEGER(reg)                :: regID
  INTEGER(big)                :: bigDemand
  INTEGER(big)                :: bigRemDemand
  INTEGER(reg)                :: regDCs !Number of DCs allowed to supply a given Retail Store
  REAL(dbl)                   :: dblBestCost !Lowest trading cost up to this Retail Store from originating excess supply DC
  INTEGER(big)                :: bigBestLink
  LOGICAL                     :: logRemDemand
  INTEGER(big),DIMENSION(:),ALLOCATABLE:: bigLinkSeq !Record numbers of each link connecting a given Retail Store to its DCs
END TYPE RetailStore

TYPE(RetailStore),DIMENSION(:),TARGET,ALLOCATABLE :: rtsStore
TYPE(RetailStore),POINTER :: rtsP

TYPE DC
  INTEGER(reg)                :: regID
  INTEGER(big)                :: bigCapacity
  INTEGER(big)                :: bigRemCapacity
  INTEGER(reg)                :: regStores !Number of Retail Stores a given DC is allowed to supply
  INTEGER                     :: intShortStores
  REAL(dbl)                   :: dblBestCost !Best cost up to a given DC from originating excess supply DC
  INTEGER(big)                :: bigBestLink
  LOGICAL                     :: logRemCapacity
  LOGICAL                     :: logShortStores
  LOGICAL                     :: logBestCostFound
  LOGICAL                     :: logInCostMatrix
  INTEGER(big),DIMENSION(:),ALLOCATABLE:: bigLinkSeq !Record numbers of each link connecting a given DC to its Retail Stores
  INTEGER(big),DIMENSION(:),ALLOCATABLE:: regDeficientSeq !Record numbers of each link connecting a given DC to its Retail Stores
END TYPE DC

TYPE(DC),DIMENSION(:),TARGET,ALLOCATABLE :: dcDC
TYPE(DC),DIMENSION(:),ALLOCATABLE :: dcP

INTERFACE DCid
  MODULE PROCEDURE DCid_big
  MODULE PROCEDURE DCid_reg
END INTERFACE DCid

INTERFACE StoreID
  MODULE PROCEDURE StoreID_big
  MODULE PROCEDURE StoreID_reg
END INTERFACE StoreID

!-------------------------------------------------------------------------
CONTAINS !the following procedures...
!-------------------------------------------------------------------------
!Insert procedures here, if any

FUNCTION DCid_big(bigSeq)
  INTEGER(big) :: DCid_Big,bigSeq
  DCid_big = dcDC(bigSeq)%regID
END FUNCTION DCid_big
!-------------------------------------------------------------------------

FUNCTION DCid_reg(regSeq)
  INTEGER(reg) :: regSeq
  INTEGER(big) :: DCid_reg
  DCid_reg = dcDC(regSeq)%regID
END FUNCTION DCid_reg
!-------------------------------------------------------------------------

FUNCTION BigDcSeqIndx(bigSur,bigStoreSeq,bigIndx)
  !Given current store bigStoreSeq, find the sequence of its bigIndx'th connected DC
  INTEGER(big) :: bigSur,bigIndx,bigStoreSeq,BigDcSeqIndx
  @B.Record = rtsStore(bigStoreSeq)%bigLinkSeq(bigIndx)
  BigDcSeqIndx = lnkInfo(@B.Record)%regDCseq
END FUNCTION BigDcSeqIndx
!-------------------------------------------------------------------------

SUBROUTINE Initializations

!CALL AddLinkToChain(

&R.Model = 0
&R.SystemInfo = 1000

IF (&R.Model == 0) THEN
  CALL SystemCommand("CALL C:\ORMSware\Examples\TransportDataDemo.BAT")
ELSE
  CALL SystemCommand("CALL C:\ORMSware\Examples\TransportDataLarge.BAT")
END IF

&R.DCidColumn = 1
&R.SupplyColumn = 4 !2
&R.StoreIDcolumn = 5
&R.CostIJcolumn = 6
&R.DemandColumn = 7

CALL OpenForWriting(&I.Scratch,WithPath("Scratch.TXT"),"sDSL","Transporation.ADD-211")

WRITE(&I.Scratch,*)"Optimal DCs-to-Stores Transportation Flows Model"
CALL WriteAuthorSignature(&I.Scratch)

CALL GetTable(WithPath("TransportData.HTM"),{Table.D}DistTranspData ) !WithPath prefixes file with model's path
&B.Records = UBOUND({t.D}DistTranspData,1)
{?|&B.Records}

ALLOCATE(lnkInfo(0:&B.Records))
lnkInfo(:)%bigFlow = 0
lnkInfo(:)%bigPrevFlow = 0
lnkInfo(:)%dblCost = 0_dbl

CALL CreateQueue(queDCrecords,"[queDCrecords Distribution Centers (DCs) index]",logDrain = logNo) !List of raw DC records
CALL CreateQueue(queStoreRecords,"[queStoreRecords Retail Stores (RSs) index]",logDrain = logNo) !List of raw retail stores records
CALL CreateQueue(queDCs,"[queDCs DC index]",logDrain = logNo)
CALL CreateQueue(queStores,"[queStores RS index]",logDrain = logNo)
CALL CreateQueue(queShortage,"[queShortage Unfulfilled demand by RS sequence]",logDrain = logNo) !List of retail stores with shortage
CALL CreateQueue(queUnused,"[queUnused Unused supply by DC sequence]",logDrain = logNo)
CALL CreateQueue(queBestCostToDCs,"[queBestCostToDCs SurplusDCs->AllUsedDCs BestCosts]",logDrain = logYes,strEntity = "Sur")
CALL CreateQueue(queMajorIteration,"[queMajorIteration Major Iteration Launch]",logDrain = logYes,strEntity = "Sur")

END SUBROUTINE Initializations
!-------------------------------------------------------------------------

FUNCTION StoreID_big(bigSeq)
  INTEGER(big) :: StoreID_big,bigSeq
  StoreID_big = rtsStore(bigSeq)%regID
END FUNCTION StoreID_big
!-------------------------------------------------------------------------

FUNCTION StoreID_reg(regSeq)
  INTEGER(reg) :: regSeq
  INTEGER(big) :: StoreID_reg
  StoreID_reg = rtsStore(regSeq)%regID
END FUNCTION StoreID_reg
!-------------------------------------------------------------------------

FUNCTION BigStoreSeqIndx(bigSur,bigDCseq,bigIndx)
  !Given current DC bigDCseq, find the sequence of its bigIndx'th connected Store
  INTEGER(big) :: bigSur,bigDCseq,bigIndx,BigStoreSeqIndx
  @B.Record = dcDC(bigDCseq)%bigLinkSeq(bigIndx)
  BigStoreSeqIndx = lnkInfo(@B.Record)%regStoreSeq
END FUNCTION BigStoreSeqIndx
!-------------------------------------------------------------------------

SUBROUTINE WriteAuthorSignature(intFile)
  INTEGER :: intFile

  WRITE(intFile,*)"Author: Reginald Joules"
  WRITE(intFile,*)"Ushar Enterprises Inc"
  WRITE(intFile,*)"Colorado, USA"
  WRITE(intFile,*)"www.ushar.com 303-731-3213"
END SUBROUTINE WriteAuthorSignature
!-------------------------------------------------------------------------

SUBROUTINE WriteDCtoDCcostTable()
  INTEGER(big) :: bigDCseq,bigSur

  WRITE($I.LOG,*)"Best Costs from Unused Supply DCs to Other DCs"
  WRITE($I.LOG,*)
  WRITE($I.LOG,*)"      DC Seq  DC Id    DC Seq  DC Id   Best Cost"
  dcDC(1:)%logBestCostFound = logNo
  qelDCsP => queBestCostToDCs%Head !Points to DC at the head of DC records queue

  DO bigDCseq = 1,QueueLength(queBestCostToDCs)
    bigSur = qelDCsP%bigEntId
    IF (.NOT. dcDC(@B.DCseq)%logBestCostFound) THEN
      dcDC(@B.DCseq)%logBestCostFound = logYes
      WRITE($I.LOG,"(4I8,F10.3)")@B.SourceDCseq,dcDC(@B.SourceDCseq)%regID,@B.DCseq,dcDC(@B.DCseq)%regID,qelDCsP%dblRank
    END IF
    IF (ASSOCIATED(qelDCsP%qelAft)) qelDCsP => qelDCsP%qelAft
  END DO
END SUBROUTINE WriteDCtoDCcostTable
!-------------------------------------------------------------------------

SUBROUTINE LinkProperties(bigLink,logEcho)
  INTEGER(big) :: bigLink
  LOGICAL,OPTIONAL :: logEcho

  &R.DCseq = lnkInfo(bigLink)%regDCseq
  &R.DCid = dcDC(&R.DCseq)%regID
  &D.BestDCcost = dcDC(&R.DCseq)%dblBestCost
  &R.StoreSeq = lnkInfo(bigLink)%regStoreSeq
  &R.StoreID = rtsStore(&R.StoreSeq)%regID
  &D.BestStoreCost = rtsStore(&R.StoreSeq)%dblBestCost
  &B.Flow = lnkInfo(bigLink)%bigFlow
  &D.Cost = lnkInfo(bigLink)%dblCost

  IF (PRESENT(logEcho)) THEN
    IF (logEcho) THEN
      {?|bigLink}
      {?|&D.Cost}
      {?|&B.Flow}
      {?|&R.DCseq}
      {?|&R.DCid}
      {?|&D.BestDCcost}
      {?|&R.StoreSeq}
      {?|&R.StoreID}
      {?|&D.BestStoreCost}
    END IF
  END IF
END SUBROUTINE LinkProperties
!-------------------------------------------------------------------------

SUBROUTINE WriteLinksInSolution(intLinksF)
  INTEGER :: intLinksF,intBasicVars
  CHARACTER(LEN=9) :: strBasicVar

  WRITE(intLinksF,*) &
  "BasicVar   LinkSeq     DCseq      DCid  StoreSeq   StoreID  UnitCost      Flow   TransCost  PrevFlow      Diff   Diff Cost"
  intBasicVars = 0

  DO bigRecord = 1, &B.Records
    !Surrogate will carry properties link/arc number and per unit transportation cost along the arc
    !(i.e. bigRecord and lnkInfo(bigRecord)%dblCost)
    IF (lnkInfo(bigRecord)%bigFlow /= 0 .OR. lnkInfo(bigRecord)%bigPrevFlow /= 0) THEN
      IF (lnkInfo(bigRecord)%bigFlow /= 0) THEN
        intBasicVars = intBasicVars + 1
        WRITE(strBasicVar,"(I9)")intBasicVars
      ELSE
        strBasicVar = ""
      END IF
      WRITE(intLinksF,"(A,5I10,F10.3,I10,F12.3,I10,I10,F12.3)") &
      strBasicVar,bigRecord,lnkInfo(bigRecord)%regDCseq,dcDC(lnkInfo(bigRecord)%regDCseq)%regID, &
      lnkInfo(bigRecord)%regStoreSeq,rtsStore(lnkInfo(bigRecord)%regStoreSeq)%regID,lnkInfo(bigRecord)%dblCost, &
      lnkInfo(bigRecord)%bigFlow,lnkInfo(bigRecord)%dblCost * lnkInfo(bigRecord)%bigFlow, &
      lnkInfo(bigRecord)%bigPrevFlow,lnkInfo(bigRecord)%bigFlow - lnkInfo(bigRecord)%bigPrevFlow, &
      lnkInfo(bigRecord)%dblCost * (lnkInfo(bigRecord)%bigFlow - lnkInfo(bigRecord)%bigPrevFlow)
    END IF
  ENDDO
  WRITE(intLinksF,"(T96,A,F12.3)")"Total diff cost:",SUM(lnkInfo(1:)%dblCost * (lnkInfo(1:)%bigFlow - lnkInfo(1:)%bigPrevFlow))
END SUBROUTINE WriteLinksInSolution
!-------------------------------------------------------------------------

SUBROUTINE WriteRemDCcapcitiesToSysLOG(bigSur)
  INTEGER(big) :: bigIndx,bigSur
  IF ($L.W) THEN
    WRITE($I.LOG,*)
    WRITE($I.LOG,*)"Remaining capacities at DCs, latest flow change, Source:", &
    SUM(dcDC(1:)%bigRemCapacity),@B.FlowChange,@B.SourceDCseq,rtsStore(@B.SourceDCseq)%regID
    WRITE($I.LOG,*)"DCs with unused supply"

    DO bigIndx = 1,&R.TotalDCs
      IF (dcDC(bigIndx)%logRemCapacity) &
      WRITE($I.LOG,*)bigIndx,dcDC(bigIndx)%regID,dcDC(bigIndx)%bigRemCapacity
    END DO
  END IF
END SUBROUTINE WriteRemDCcapcitiesToSysLOG
!-------------------------------------------------------------------------

SUBROUTINE WriteRemDemandsAtStoresToSysLOG(bigSur)
  INTEGER(big) :: bigIndx,bigSur
  IF ($L.W) THEN
    WRITE($I.LOG,*)
    WRITE($I.LOG,*)"Remaining unfulfilled demands at stores, latest flow change, Store:", &
    SUM(rtsStore(1:)%bigRemDemand),@B.FlowChange,@B.StoreSeq,rtsStore(@B.StoreSeq)%regID
    WRITE($I.LOG,*)"Stores with unfulfilled demand"

    DO bigIndx = 1,&R.TotalStores
      IF (rtsStore(bigIndx)%logRemDemand) &
      WRITE($I.LOG,*)bigIndx,rtsStore(bigIndx)%regID,rtsStore(bigIndx)%bigRemDemand
    END DO
  END IF
END SUBROUTINE WriteRemDemandsAtStoresToSysLOG
!-------------------------------------------------------------------------

SUBROUTINE WriteSummaryResults(strMarker)
  CHARACTER(LEN=*) :: strMarker
  IF ($L.W) THEN
    WRITE($I.LOG,*)
    WRITE($I.LOG,*)"WriteSummaryResults - " // strMarker

    WRITE($I.LOG,'(A,T35,F12.3,F12.3)')" Total cost:", &
    &D.GrandTotal ,SUM(lnkInfo(1:&B.Records)%bigFlow * lnkInfo(1:&B.Records)%dblCost)

    WRITE($I.LOG,'(A,T35,I12)')" Total capacity:", &
    SUM(dcDC(1:)%bigCapacity)

    WRITE($I.LOG,'(A,T35,I12)')" Total allocated capacity:", &
    SUM(dcDC(1:)%bigCapacity - dcDC(1:)%bigRemCapacity)

    WRITE($I.LOG,'(A,T35,I12)')" Total unused capacity:", &
    &B.SUMofRemCapacity

    WRITE($I.LOG,'(A,T35,I12)')" Total demand:", &
    SUM(rtsStore(1:)%bigDemand)

    &B.SUMofRemDemand = SUM(rtsStore(1:)%bigRemDemand)

    WRITE($I.LOG,'(A,T35,I12)')" Total fulfilled demand:", &
    SUM(rtsStore(1:)%bigDemand) - &B.SUMofRemDemand

    WRITE($I.LOG,'(A,T35,I12)')" Total unfulfilled demand:", &
    &B.SUMofRemDemand

    WRITE($I.LOG,'(A,T35,I12)')" Capacity surplus/-deficiency:", &
    SUM(dcDC(1:)%bigRemCapacity) - SUM(rtsStore(1:)%bigRemDemand)
    WRITE($I.LOG,*)" "
  END IF
END SUBROUTINE WriteSummaryResults
!-------------------------------------------------------------------------

SUBROUTINE WriteShortageQueuePtr(qelP)
  TYPE(QueueElements),POINTER :: qelP
  WRITE($I.LOG,*)"WriteShortageQueuePtr",qelP%bigEntID
  WRITE($I.LOG,*)"WriteShortageQueuePtrAft",qelP%qelAft%bigEntID
END SUBROUTINE WriteShortageQueuePtr
!-------------------------------------------------------------------------

SUBROUTINE WriteShortageQueue(strCallLocation)
  CHARACTER(LEN=*) :: strCallLocation
  INTEGER :: intIndx,intIndy

  WRITE($I.LOG,*)"WriteShortageQueue from " // strCallLocation
  &B.QueueLength = QueueLength(queShortage)
  IF (ALLOCATED(lnkDCsP)) DEALLOCATE(lnkDCsP)
  ALLOCATE(lnkDCsP(1:&B.QueueLength,1:3))

  qelShortageP => queShortage%Head

  DO intIndx = 1, &B.QueueLength
    bigStore = qelShortageP%bigEntID
    rtsP => rtsStore(bigStore)
    !WRITE($I.LOG,*)"942~bigStore",bigStore
    !WRITE($I.LOG,*)"942~rtsStore(bigStore)%regDCs",rtsStore(bigStore)%regDCs
    !WRITE($I.LOG,*)"943~rtsP%regDCs",rtsP%regDCs
    !WRITE($I.LOG,*)"944~rtsP%bigLinkSeq(1,rtsP%regDCs)",rtsP%bigLinkSeq(1),rtsP%bigLinkSeq(rtsP%regDCs)
    lnkDCsP(intIndx,1:rtsP%regDCs) = lnkInfo(rtsP%bigLinkSeq(1:rtsP%regDCs))
    dcP(1:rtsP%regDCs) = dcDC(lnkDCsP(intIndx,1:rtsP%regDCs)%regDCseq)
    WRITE($I.LOG,'(I10,I12,I12,I12,A,3(2I10,F10.3,A))')intIndx,bigStore,rtsStore(bigStore)%regID, &
    rtsStore(bigStore)%bigRemDemand," |", &
    (lnkDCsP(intIndx,intIndy)%regDCseq,dcP(intIndy)%regID,lnkDCsP(intIndx,intIndy)%dblCost," |",intIndy = 1,rtsP%regDCs)

    qelShortageP => qelShortageP%qelAft
  ENDDO
  WRITE($I.LOG,*)"End WriteShortageQueue from " // strCallLocation
END SUBROUTINE WriteShortageQueue

!--------------------------------END ADD----------------------------------