PROGRAM PrimerSig ! 0000001 PGM0000001 USE Optimization ! 0000002 PGM0000002 CALL InitOptimization ! 0000003 PGM0000003 CALL GoldenSection(WithPath("PrimerSigTables.HTM"), & ! 0000004 PGM0000004 "{Table.D}PrimerOptPieces") ! 0000005 PGM0000004 END PROGRAM PrimerSig ! 0000006 PGM0000005 !------------------------------------------------------------------------- MODULE Client !Host module containing customization logic and code created for this model USE Kinds USE NmodExposures USE DefNet IMPLICIT NONE !-------------------------------BEGIN ADD--------------------------------- !An ADD file has declarations, derived type definitions, etc. to be included at... !the top of the Client Module, followed by CONTAINS statement and then all of ... !the procedures developed by the analyst to include in the Client Module of a ... !given model. !----- !Insert model-level declarations here, if any CHARACTER(len=25),DIMENSION(0:20,2):: strResults ! 0000023 ADD0000008 !----- CONTAINS ! 0000025 ADD0000010 !----- !Insert procedures here, if any FUNCTION dblfSignalDelay(bigCustomer) ! 0000029 ADD0000014 INTEGER(KIND=big):: bigCustomer ! 0000030 ADD0000015 REAL(KIND=dbl):: dblfSignalDelay ! 0000031 ADD0000016 !----- !strResults is a model level array; and this function is a model level procedure... !Since this function is hosted in the Client Module and strResults is declared... !at the top of Client Module, strResults is available to this function through... !"host association." It is also available to the calling network object through... !host association, because all network object subroutines are housed in Client... !Module, too. !----- !The following have no real-world meaning. They are just numbers. udgp%bigCustomer = bigCustomer ! 0000042 ADD0000027 !Also, since system, global, customer and surrogate properties are components ... !of data structures, they cannot be used as dummy arguments in subroutine and... !function statements. That is why we used bigCustomer as dummy argument in Func statement !----- !Internal reading of a number from a character variable (strResults array)... READ ( strResults(udgp%bigCustomer,1), * ) dblfSignalDelay ! 0000050 ADD0000035 !----- !Since ORMSware notation in ADD file is translated just as the contents of NET... !file are, we can use all of the notations permitted in NET file here as well END FUNCTION dblfSignalDelay ! 0000056 ADD0000041 !--------------------------------END ADD---------------------------------- !CostPerPiece.[1]WearParameters SUBROUTINE Obj_1_1(bigSur,bigTkn,bigSeq,regNwObj,tnyNwoType,tnyPropCode) INTEGER(KIND=big):: bigSur,bigTkn INTEGER(KIND=big),INTENT(IN):: bigSeq INTEGER(KIND=reg),INTENT(IN):: regNwObj INTEGER(KIND=tny),INTENT(IN):: tnyNwoType,tnyPropCode !----- SELECT CASE(tnyPropCode) CASE(tnyTransCode) udgp%sngWearCoeff = 0.1; udgp%sngWearExpon = 1.8 ! 0000068 NET0000006 END SELECT END SUBROUTINE Obj_1_1 !------------------------------------------------------------------------- !CostPerPiece.[2]PiecesPerHour SUBROUTINE Obj_1_2(bigSur,bigTkn,bigSeq,regNwObj,tnyNwoType,tnyPropCode) INTEGER(KIND=big):: bigSur,bigTkn INTEGER(KIND=big),INTENT(IN):: bigSeq INTEGER(KIND=reg),INTENT(IN):: regNwObj INTEGER(KIND=tny),INTENT(IN):: tnyNwoType,tnyPropCode !----- SELECT CASE(tnyPropCode) CASE(tnyTransCode) udcP(bigTkn)%dblPiecesPerHour = udsP(bigSur)%dblPiecesPerHour ! 0000082 NET0000013 CASE(tnySignalTargetCode) IF(CustomerID() <= 1)THEN ! 0000084 NET0000016 CALL Signal(bigSur,bigTkn,bigSeq,regNwObj,tnyNwoType, & ! 0000085 NET0000017 1_reg) ! 0000086 NET0000017 ENDIF ! 0000087 NET0000018 END SELECT END SUBROUTINE Obj_1_2 !------------------------------------------------------------------------- !CostPerPiece.[3]MachineCostPerHour SUBROUTINE Obj_1_3(bigSur,bigTkn,bigSeq,regNwObj,tnyNwoType,tnyPropCode) INTEGER(KIND=big):: bigSur,bigTkn INTEGER(KIND=big),INTENT(IN):: bigSeq INTEGER(KIND=reg),INTENT(IN):: regNwObj INTEGER(KIND=tny),INTENT(IN):: tnyNwoType,tnyPropCode !----- SELECT CASE(tnyPropCode) CASE(tnyTransCode) udcP(bigTkn)%sngMachineCostPerHour = udgp%sngWearCoeff * udcP( & ! 0000101 NET0000025 bigTkn)%dblPiecesPerHour ** udgp%sngWearExpon ! 0000102 NET0000025 udsP(bigSur)%sngCostPerHour = udcP(bigTkn) & ! 0000103 NET0000026 %sngMachineCostPerHour ! 0000104 NET0000026 WRITE(9,*)"MachineCostPerHour =",udcP(bigTkn) & ! 0000105 NET0000027 %sngMachineCostPerHour ! 0000106 NET0000027 END SELECT END SUBROUTINE Obj_1_3 !------------------------------------------------------------------------- !CostPerPiece.[4]LaborCostPerHour SUBROUTINE Obj_1_4(bigSur,bigTkn,bigSeq,regNwObj,tnyNwoType,tnyPropCode) INTEGER(KIND=big):: bigSur,bigTkn INTEGER(KIND=big),INTENT(IN):: bigSeq INTEGER(KIND=reg),INTENT(IN):: regNwObj INTEGER(KIND=tny),INTENT(IN):: tnyNwoType,tnyPropCode !----- SELECT CASE(tnyPropCode) CASE(tnyTransCode) udgp%dblTemp = udcP(bigTkn)%dblPiecesPerHour ! 0000120 NET0000034 udcP(bigTkn)%sngLaborCostPerHour = LookUp(dblLaborCosts, & ! 0000121 NET0000035 udgp%dblTemp,1, & ! 0000122 NET0000035 logEqual=udcP(bigTkn)%logMatch,bigRow=udcP(bigTkn) & ! 0000123 NET0000036 %bigAnswerRow) ! 0000124 NET0000036 udsP(bigSur)%sngCostPerHour = udcP(bigTkn) & ! 0000125 NET0000037 %sngLaborCostPerHour ! 0000126 NET0000037 WRITE(9,*)"{cp.D}PiecesPerHour,#S.LaborCostPerHour",udcP( & ! 0000127 NET0000038 bigTkn)%dblPiecesPerHour, & ! 0000128 NET0000038 udcP(bigTkn)%sngLaborCostPerHour,udcP(bigTkn)%bigAnswerRow, & ! 0000129 NET0000039 udcP(bigTkn)%logMatch ! 0000130 NET0000039 END SELECT END SUBROUTINE Obj_1_4 !------------------------------------------------------------------------- !CostPerPiece.[5]CostPerPiece SUBROUTINE Obj_1_5(bigSur,bigTkn,bigSeq,regNwObj,tnyNwoType,tnyPropCode) INTEGER(KIND=big):: bigSur,bigTkn INTEGER(KIND=big),INTENT(IN):: bigSeq INTEGER(KIND=reg),INTENT(IN):: regNwObj INTEGER(KIND=tny),INTENT(IN):: tnyNwoType,tnyPropCode !----- INTEGER:: intIndx,intCol ! 0000142 NET0000045 INTEGER(KIND=big),SAVE:: bigCustomer ! 0000143 NET0000046 LOGICAL:: logBranch ! 0000144 NET0000047 SELECT CASE(tnyPropCode) CASE(tnyMergingCode) IF(MergeInitFlag())THEN ! 0000147 NET0000050 udcP(bigTkn)%sngCostPerHour = udsP(bigSur) & ! 0000148 NET0000051 %sngCostPerHour ! 0000149 NET0000051 WRITE(9,*)"Merging initialization logic: CostPerHour "// & ! 0000150 NET0000052 "sum=",udcP(bigTkn)%sngCostPerHour ! 0000151 NET0000052 ELSE ! 0000152 NET0000053 udcP(bigTkn)%sngCostPerHour = udcP(bigTkn) & ! 0000153 NET0000054 %sngCostPerHour + udsP(bigSur)%sngCostPerHour ! 0000154 NET0000054 WRITE(9,*)"Merging logic: #S.CostPerHour=",udcP(bigTkn) & ! 0000155 NET0000055 %sngCostPerHour ! 0000156 NET0000055 IF(LastMergeOut()) WRITE(9,*)"Final merging logic: Cost "// & ! 0000157 NET0000056 "per piece=", & ! 0000158 NET0000056 udcP(bigTkn)%sngCostPerHour / udcP(bigTkn) & ! 0000159 NET0000057 %dblPiecesPerHour ! 0000160 NET0000057 ENDIF ! 0000161 NET0000058 CASE(tnyTransCode) udgp%dblCostPerPiece = (udcP(bigTkn)%sngMachineCostPerHour + udcP( & ! 0000163 NET0000062 bigTkn)%sngLaborCostPerHour) / udcP(bigTkn)%dblPiecesPerHour ! 0000164 NET0000062 WRITE(9,*)"PiecesPerHour =",udcP(bigTkn)%dblPiecesPerHour ! 0000165 NET0000064 WRITE(9,*)"MachineCostPerHour =",udcP(bigTkn) & ! 0000166 NET0000065 %sngMachineCostPerHour ! 0000167 NET0000065 WRITE(9,*)"LaborCostPerHour =",udcP(bigTkn) & ! 0000168 NET0000066 %sngLaborCostPerHour ! 0000169 NET0000066 WRITE(9,*)"CostPerPiece =",udgp%dblCostPerPiece ! 0000170 NET0000067 CALL OptimizationResponse(udgp%dblCostPerPiece,"Pieces per "// & ! 0000171 NET0000069 "hour, cost per piece:") ! 0000172 NET0000069 IF(udgp%logCurveBuild)THEN ! 0000173 NET0000072 WRITE(strResults(CustomerID(),1),*)udcP(bigTkn) & ! 0000174 NET0000074 %dblPiecesPerHour ! 0000175 NET0000074 WRITE(strResults(CustomerID(),2),*)udgp%dblCostPerPiece ! 0000176 NET0000075 ENDIF ! 0000177 NET0000076 udsP(bigSur)%dblPiecesPerHour = udcP(bigTkn) & ! 0000178 NET0000078 %dblPiecesPerHour ! 0000179 NET0000078 CASE(tnySignalTargetCode) logBranch = udgp%logCurveBuild .AND. udsP(bigSur) & ! 0000181 NET0000083 %dblPiecesPerHour < udgp%bigPiecesLim ! 0000182 NET0000083 WRITE(9,*)"@D.PiecesPerHour < &B.PiecesLim,logBranch:", & ! 0000183 NET0000086 udsP(bigSur)%dblPiecesPerHour,udgp%bigPiecesLim,logBranch ! 0000184 NET0000087 udsP(bigSur)%dblDepartureTime = Time() ! 0000185 NET0000088 IF(logBranch)THEN ! 0000186 NET0000090 udsP(bigSur)%dblPiecesPerHour = udsP(bigSur) & ! 0000187 NET0000091 %dblPiecesPerHour + udgp%bigPiecesIncrement ! 0000188 NET0000091 sys%dblSignalDuration = dblfSignalDelay(bigCustomer) ! 0000189 NET0000093 WRITE(9,*)"Duration of signal traversal:", & ! 0000190 NET0000094 sys%dblSignalDuration ! 0000191 NET0000094 CALL Signal(bigSur,bigTkn,bigSeq,regNwObj,tnyNwoType, & ! 0000192 NET0000095 2_reg) ! 0000193 NET0000095 ELSE IF(udgp%logCurveBuild)THEN ! 0000194 NET0000096 WRITE(9,*)REPEAT("-",30) ! 0000195 NET0000097 DO intIndx = 0, bigCustomer ! 0000196 NET0000099 WRITE(9,*)(strResults(intIndx,intCol),intCol=1,2) ! 0000197 NET0000101 END DO ! 0000198 NET0000102 WRITE(9,*)REPEAT("-",30) ! 0000199 NET0000103 ENDIF ! 0000200 NET0000104 END SELECT END SUBROUTINE Obj_1_5 !------------------------------------------------------------------------- !CostPerPiece.[6]Initializations SUBROUTINE Obj_1_6(bigSur,bigTkn,bigSeq,regNwObj,tnyNwoType,tnyPropCode) INTEGER(KIND=big):: bigSur,bigTkn INTEGER(KIND=big),INTENT(IN):: bigSeq INTEGER(KIND=reg),INTENT(IN):: regNwObj INTEGER(KIND=tny),INTENT(IN):: tnyNwoType,tnyPropCode !----- SELECT CASE(tnyPropCode) CASE(tnyTransCode) CALL OpenTableFile(21,WithPath("PrimerSigTables.HTM")) ! 0000214 NET0000113 CALL GetTable(21,"{Table.D}CostPerPieceInputs", & ! 0000215 NET0000114 dblCostPerPieceInputs) ! 0000216 NET0000114 CALL GetTable(21,"{Table.D}LaborCosts",dblLaborCosts) ! 0000217 NET0000115 CLOSE(21) ! 0000218 NET0000116 udsP(bigSur)%dblPiecesPerHour = dblCostPerPieceInputs(1,1) ! 0000219 NET0000118 udgp%bigPiecesIncrement = dblCostPerPieceInputs(2,1) ! 0000220 NET0000119 udgp%bigPiecesLim = dblCostPerPieceInputs(3,1) ! 0000221 NET0000120 CALL OptimizationStimulus(udsP(bigSur)%dblPiecesPerHour) ! 0000222 NET0000122 udgp%logCurveBuild = & ! 0000223 NET0000124 NodeType( 2_reg ) == tnyArrival ! 0000224 NET0000125 WRITE(9,*)"&L.CurveBuild",udgp%logCurveBuild ! 0000225 NET0000126 WRITE(strResults(0,1),'(A)')"Pieces/hour" ! 0000226 NET0000128 WRITE(strResults(0,2),'(A)')"Cost/piece" ! 0000227 NET0000129 udsP(bigSur)%dblDepartureTime = 0. ! 0000228 NET0000131 CASE(tnySignalTargetCode) CALL Signal(bigSur,bigTkn,bigSeq,regNwObj,tnyNwoType,2_reg) ! 0000230 NET0000135 END SELECT END SUBROUTINE Obj_1_6 !------------------------------------------------------------------------- !CostPerPiece.[8]PiecesPerHour-->>|MachineCostPerHour SUBROUTINE Obj_1_8(bigSur,bigTkn,bigSeq,regNwObj,tnyNwoType,tnyPropCode) INTEGER(KIND=big):: bigSur,bigTkn INTEGER(KIND=big),INTENT(IN):: bigSeq INTEGER(KIND=reg),INTENT(IN):: regNwObj INTEGER(KIND=tny),INTENT(IN):: tnyNwoType,tnyPropCode !----- SELECT CASE(tnyPropCode) CASE(tnySignalTargetCode) IF(CustomerID() > 1)THEN ! 0000244 NET0000142 CALL Signal(bigSur,bigTkn,bigSeq,regNwObj,tnyNwoType, & ! 0000245 NET0000143 9_reg) ! 0000246 NET0000143 ENDIF ! 0000247 NET0000144 END SELECT END SUBROUTINE Obj_1_8 !------------------------------------------------------------------------- !PiecesPerHour.[1]Product A SUBROUTINE Obj_2_1(bigSur,bigTkn,bigSeq,regNwObj,tnyNwoType,tnyPropCode) INTEGER(KIND=big):: bigSur,bigTkn INTEGER(KIND=big),INTENT(IN):: bigSeq INTEGER(KIND=reg),INTENT(IN):: regNwObj INTEGER(KIND=tny),INTENT(IN):: tnyNwoType,tnyPropCode !----- SELECT CASE(tnyPropCode) CASE(tnyTransCode) udcP(bigTkn)%bigProdApieces = 10 ! 0000261 NET0000155 END SELECT END SUBROUTINE Obj_2_1 !------------------------------------------------------------------------- !PiecesPerHour.[2]Product B SUBROUTINE Obj_2_2(bigSur,bigTkn,bigSeq,regNwObj,tnyNwoType,tnyPropCode) INTEGER(KIND=big):: bigSur,bigTkn INTEGER(KIND=big),INTENT(IN):: bigSeq INTEGER(KIND=reg),INTENT(IN):: regNwObj INTEGER(KIND=tny),INTENT(IN):: tnyNwoType,tnyPropCode !----- SELECT CASE(tnyPropCode) CASE(tnyTransCode) udcP(bigTkn)%bigProdBpieces = 20 ! 0000275 NET0000162 END SELECT END SUBROUTINE Obj_2_2 !------------------------------------------------------------------------- !PiecesPerHour.[4]PiecesPerHour SUBROUTINE Obj_2_4(bigSur,bigTkn,bigSeq,regNwObj,tnyNwoType,tnyPropCode) INTEGER(KIND=big):: bigSur,bigTkn INTEGER(KIND=big),INTENT(IN):: bigSeq INTEGER(KIND=reg),INTENT(IN):: regNwObj INTEGER(KIND=tny),INTENT(IN):: tnyNwoType,tnyPropCode !----- SELECT CASE(tnyPropCode) CASE(tnyTransCode) udsP(bigSur)%dblPiecesPerHour = udcP(bigTkn)%bigProdApieces + & ! 0000289 NET0000169 udcP(bigTkn)%bigProdBpieces ! 0000290 NET0000169 END SELECT END SUBROUTINE Obj_2_4 !------------------------------------------------------------------------- END MODULE client !------------------------------------------------------------------------- SUBROUTINE NetAndEntProcsAndProps(bigSur,bigTkn,bigSeq,regNwObj,tnyNwoType, & tnyPropCode) USE Client IMPLICIT NONE !----| INTEGER(KIND=big):: bigSur,bigTkn INTEGER(KIND=big),INTENT(IN):: bigSeq INTEGER(KIND=reg),INTENT(IN):: regNwObj INTEGER(KIND=tny),INTENT(IN):: tnyNwoType,tnyPropCode !----- surP=>surSur(bigSur) tknP=>tknTkn(bigTkn) !----- !WRITE(9,*)"NAEPAP:bigSur,bigTkn,bigSeq,regPage,regNwObj,tnyPropCode",bigSur, & !bigTkn,bigSeq,regPage,regNwObj,tnyPropCode !WRITE(9,*)"3:nop%dblDuration",nop%dblDuration !=====-------------------------------------------------------------------- SELECT CASE(regPage) CASE(1) !CostPerPiece SELECT CASE(regNwObj) CASE(1) !CostPerPiece.[1]WearParameters CALL Obj_1_1(bigSur,bigTkn,bigSeq,regNwObj,tnyNwoType,tnyPropCode) CASE(2) !CostPerPiece.[2]PiecesPerHour CALL Obj_1_2(bigSur,bigTkn,bigSeq,regNwObj,tnyNwoType,tnyPropCode) CASE(3) !CostPerPiece.[3]MachineCostPerHour CALL Obj_1_3(bigSur,bigTkn,bigSeq,regNwObj,tnyNwoType,tnyPropCode) CASE(4) !CostPerPiece.[4]LaborCostPerHour CALL Obj_1_4(bigSur,bigTkn,bigSeq,regNwObj,tnyNwoType,tnyPropCode) CASE(5) !CostPerPiece.[5]CostPerPiece CALL Obj_1_5(bigSur,bigTkn,bigSeq,regNwObj,tnyNwoType,tnyPropCode) CASE(6) !CostPerPiece.[6]Initializations CALL Obj_1_6(bigSur,bigTkn,bigSeq,regNwObj,tnyNwoType,tnyPropCode) CASE(8) !CostPerPiece.[8]PiecesPerHour-->>|MachineCostPerHour CALL Obj_1_8(bigSur,bigTkn,bigSeq,regNwObj,tnyNwoType,tnyPropCode) END SELECT CASE(2) !PiecesPerHour SELECT CASE(regNwObj) CASE(1) !PiecesPerHour.[1]Product A CALL Obj_2_1(bigSur,bigTkn,bigSeq,regNwObj,tnyNwoType,tnyPropCode) CASE(2) !PiecesPerHour.[2]Product B CALL Obj_2_2(bigSur,bigTkn,bigSeq,regNwObj,tnyNwoType,tnyPropCode) CASE(4) !PiecesPerHour.[4]PiecesPerHour CALL Obj_2_4(bigSur,bigTkn,bigSeq,regNwObj,tnyNwoType,tnyPropCode) END SELECT END SELECT END SUBROUTINE NetAndEntProcsAndProps