!Model: PrimerSig
!File: C:\ORMSware\PrimerModels\PrimerSig.F95
!Stamp: 20030208 091548.628
!-------------------------------------------------------------------------

MODULE DefNet
USE Kinds
USE NmodExposures
IMPLICIT NONE
INTEGER:: intLnkMsg,intNetMsg
!----- Table declaration(s) deduced by network translator
REAL(KIND=dbl),DIMENSION(:,:),POINTER:: dblCostPerPieceInputs
REAL(KIND=dbl),DIMENSION(:,:),POINTER:: dblLaborCosts
!-----
TYPE UserDefGlbProps
  REAL(KIND=dbl)         :: dblCostPerPiece               !&D.CostPerPiece
  LOGICAL                :: logCurveBuild                 !&L.CurveBuild
  INTEGER(KIND=big)      :: bigCustomer                   !&B.Customer
  INTEGER(KIND=big)      :: bigPiecesIncrement            !&B.PiecesIncrement
  INTEGER(KIND=big)      :: bigPiecesLim                  !&B.PiecesLim
  REAL(KIND=dbl)         :: dblTemp                       !&D.Temp
  REAL(KIND=sng)         :: sngWearCoeff                  !&S.WearCoeff
  REAL(KIND=sng)         :: sngWearExpon                  !&S.WearExpon
END TYPE UserDefGlbProps
!-----
TYPE UserDefCstProps
  INTEGER(KIND=big)      :: bigAnswerRow                  !#B.AnswerRow
  REAL(KIND=sng)         :: sngCostPerHour                !#S.CostPerHour
  REAL(KIND=sng)         :: sngLaborCostPerHour           !#S.LaborCostPerHour
  REAL(KIND=sng)         :: sngMachineCostPerHour         !#S.MachineCostPerHour
  LOGICAL                :: logMatch                      !#L.Match
  REAL(KIND=dbl)         :: dblPiecesPerHour              !#D.PiecesPerHour
  INTEGER(KIND=big)      :: bigProdApieces                !#B.ProdApieces
  INTEGER(KIND=big)      :: bigProdBpieces                !#B.ProdBpieces
END TYPE UserDefCstProps
!-----
TYPE UserDefSurProps
  REAL(KIND=sng)         :: sngCostPerHour                !@S.CostPerHour
  REAL(KIND=dbl)         :: dblDepartureTime              !@D.DepartureTime
  REAL(KIND=dbl)         :: dblPiecesPerHour              !@D.PiecesPerHour
END TYPE UserDefSurProps
!-----
TYPE(SurArray),POINTER:: surP
TYPE(TknArray),POINTER:: tknP
TYPE(UserDefSurProps),DIMENSION(:),POINTER:: udsP
TYPE(UserDefCstProps),DIMENSION(:),POINTER:: udcP
TYPE(UserDefGlbProps),POINTER:: udgp
END MODULE DefNet
!-------------------------------------------------------------------------

SUBROUTINE CopyUsrDefCstProps(bigTknFrom,bigTknTo)
USE DefNet
IMPLICIT NONE
INTEGER(KIND=big):: bigTknFrom,bigTknTo
udcP(bigTknTo)=udcP(bigTknFrom)
END SUBROUTINE CopyUsrDefCstProps
!-------------------------------------------------------------------------

SUBROUTINE CopyUsrDefSurProps(bigSurFrom,bigSurTo)
USE DefNet
IMPLICIT NONE
INTEGER(KIND=big):: bigSurFrom,bigSurTo
udsP(bigSurTo)=udsP(bigSurFrom)
END SUBROUTINE CopyUsrDefSurProps
!-------------------------------------------------------------------------

SUBROUTINE DeallocProps
USE DefNet
IMPLICIT NONE
DEALLOCATE(udgP)
DEALLOCATE(udcP)
DEALLOCATE(udsP)
END SUBROUTINE DeallocProps
!-------------------------------------------------------------------------

SUBROUTINE ErrMsg(intFile,intLev,strErrMsg)
USE DefNet
IMPLICIT NONE
INTEGER:: intFile,intLev
CHARACTER(len=*):: strErrMsg
regErrs=regErrs+1
WRITE(intFile,*)regErrs,"DefNet: "//trim(strErrMsg)
WRITE(6,*)regErrs,"DNt: "//trim(strErrMsg)
IF(intLev<1)THEN
  WRITE(6,*)"Fatal error. See end of execution feedback in: " &
  //mod%strORMSwarePath(:mod%intORMSwarePathLen)//"Nmod.TXT"
  STOP
ENDIF
END SUBROUTINE ErrMsg
!-------------------------------------------------------------------------

SUBROUTINE udcP_Ext
USE DefNet
IMPLICIT NONE
TYPE(UserDefCstProps),DIMENSION(:),POINTER:: Temp
Temp=>udcP
NULLIFY(udcP)
ALLOCATE(udcP(ent%tkn%bigCurSize),stat=intAlStat)
IF(intAlStat/=0)CALL ErrMsg(9,0,"***Error incrementing memory size for " &
//"user-defined customer token properties")
udcP(1:ent%tkn%bigCurSize-ent%tkn%regIncSize)= &
Temp(1:ent%tkn%bigCurSize-ent%tkn%regIncSize)
END SUBROUTINE udcP_Ext
!-------------------------------------------------------------------------

SUBROUTINE udsP_Ext
USE DefNet
IMPLICIT NONE
TYPE(UserDefSurProps),DIMENSION(:),POINTER:: Temp
Temp=>udsP
NULLIFY(udsP)
ALLOCATE(udsP(ent%sur%bigCurSize),stat=intAlStat)
IF(intAlStat/=0)CALL ErrMsg(9,0,"***Error incrementing memory for " &
//"user-defined surrogate properties")
udsP(1:ent%sur%bigCurSize-ent%sur%regIncSize)= &
Temp(1:ent%sur%bigCurSize-ent%sur%regIncSize)
END SUBROUTINE udsP_Ext
!-------------------------------------------------------------------------

SUBROUTINE udcP_Init
USE DefNet
IMPLICIT NONE
!Intialize memory for user-defined customer token props
ALLOCATE(udcP(0:ent%tkn%bigCurSize),STAT=intAlStat)
IF(intAlStat/=0)CALL ErrMsg(9,0,"***Error allocating initial memory for " &
//"user-defined customer token properties")
END SUBROUTINE udcP_Init
!-------------------------------------------------------------------------

SUBROUTINE udgP_Init
USE DefNet
IMPLICIT NONE
!Allocate memory for user-defined global props
ALLOCATE(udgP,STAT=intAlStat)
IF(intAlStat/=0)CALL ErrMsg(9,0,"***Error allocating initial memory for " &
//"user-defined global properties")
END SUBROUTINE udgP_Init
!-------------------------------------------------------------------------

SUBROUTINE udsP_Init
USE DefNet
IMPLICIT NONE
!Intialize memory for user-defined surrogate props
ALLOCATE(udsP(ent%sur%bigCurSize),STAT=intAlStat)
IF(intAlStat/=0)CALL ErrMsg(9,0,"***Error allocating initial memory for " &
//"user-defined surrogate properties")
END SUBROUTINE udsP_Init
!-------------------------------------------------------------------------

SUBROUTINE SyncCheck(strDateTime)
!Verify that translated model files have been compiled and linked
USE DefNet
IMPLICIT NONE
CHARACTER(len=19):: strDateTime
CHARACTER(len=19):: strDateTimeRef
strDateTimeRef="20030208 091548.628"
IF(strDateTime/=strDateTimeRef)then
  WRITE(6,*)"Translated network has not been compiled and linked..."
  WRITE(9,*)"Translated network has not been compiled and linked..."
!-----
  WRITE(6,*)"Network model translation time: "//strDateTime(1:4)//"-" &
  //strDateTime(5:6)//"-"//strDateTime(7:9)//strDateTime(10:11)//":" &
  //strDateTime(12:13)//":"//strDateTime(14:15)//strDateTime(16:19)
!
  WRITE(9,*)"Network model translation time: "//strDateTime(1:4)//"-" &
  //strDateTime(5:6)//"-"//strDateTime(7:9)//strDateTime(10:11)//":" &
  //strDateTime(12:13)//":"//strDateTime(14:15)//strDateTime(16:19)
!-----
  WRITE(6,*)"Network model compilation time: "//strDateTimeRef(1:4)//"-" &
  //strDateTimeRef(5:6)//"-"//strDateTimeRef(7:9)//strDateTimeRef(10:11)//":" &
  //strDateTimeRef(12:13)//":"//strDateTimeRef(14:15)//strDateTimeRef(16:19)
!
  WRITE(9,*)"Network model compilation time: "//strDateTimeRef(1:4)//"-" &
  //strDateTimeRef(5:6)//"-"//strDateTimeRef(7:9)//strDateTimeRef(10:11)//":" &
  //strDateTimeRef(12:13)//":"//strDateTimeRef(14:15)//strDateTimeRef(16:19)
!-----
  CALL ErrMsg(9,0,"***Error: Please compile and link translated model files")
ENDIF
END SUBROUTINE SyncCheck