!***************************************************************
! propcalcu        / 2001-09-12 / Vertex Systems Oy
!***************************************************************
!
! Calulates cross section properties
!
IdProp= 1
LidProp= 1
Lid= 2
IdPar= 2
Dir$= get("SECTPATH");
!
!
! Open Property Database
!
Path$= Dir$&"d_PROFDATA"
dbopen(IdProp) Path$,1
if dbvalid(IdProp) < 1 then
  dbclose(IdProp)
  message "Property database open failed",0
  exit
endif
!
! Open Parameters Database
!
Path$= Dir$&"d_PROFPAR"
dbopen(IdPar) Path$,1
if dbvalid(IdPar) < 1 then
  dbclose(IdProp)
  dbclose(IdPar)
  message "Parameter database open failed",0
  exit
endif
!
!
! Calculate properties
!
dbfind(LidProp) IdProp,0,""
Prop0= dblistnum(LidProp)
Ok1= 1
I= 1
loop Prop0
  RidProp= dblist(LidProp,I)
  Value$= dbgetf(IdProp,RidProp,"CODE")
  Where$= "where CODE = \""&Value$&"\""
  DBfind(Lid) IdPar,1,Where$
  Row0= dblistnum(Lid)
  if (Row0 == 1) then
    Rid= dblist(Lid,1)
    H$= dbgetf(IdPar,Rid,"C_HEIGHT")
    W$= dbgetf(IdPar,Rid,"C_WIDTH")
    T$= dbgetf(IdPar,Rid,"CT")
    dblclose(Lid)
    !
    PreH$= ""
    PreW$= ""
    PreT$=""
    Len= len(H$)
    if (Len == 1) then PreH$= "00"
    if (Len == 2) then PreH$= "0"
    Len= len(W$)
    if (Len == 1) then PreW$= "00"
    if (Len == 2) then PreW$= "0"
    Len= len(T$)
    if (Len == 1) then PreT$= "00"
    if (Len == 2) then PreT$= "0"

	  Order$= PreH$&H$&PreW$&W$&PreT$&T$
    dbputf(IdProp) RidProp,"ORDER",Order$

    Lhdy= 0
    H= H$
    if abs(H-75) < 0.1 then Lhdy= 16
    if abs(H-85) < 0.1 then Lhdy= 21
    if abs(H-100) < 0.1 then Lhdy= 28
    if abs(H-125) < 0.1 then Lhdy= 38
    if abs(H-150) < 0.1 then Lhdy= 53
    if Lhdy < 1 then
      Mess$= "Can't build LHDY parameters of "&Value$
      message Mess$,0
      Ok1= 0
    endif
    dbputf(IdProp) RidProp,"LHDY",Lhdy
  else
    dblclose(Lid)
    Mess$= "Can't get parameters of"&Value$
    message Mess$,0
    exitif 1
  endif
  I= I+1
endloop
if Ok1 then
  Mess$= "Settings done succesfully !"
else
  Mess$= "Check LHDY values !"
endif
message Mess$,2000
!
dbclose(IdProp)
dbclose(IdPar)
!
