PROGRAM DRAG;

{THIS PROGRAM PRETENDS TO PREDICT DRAG COEFFICIENT IN THE SAME WAY THE
 USAF PRETENDED TO PREDICT IT IN 1977: DATCOM}

TYPE
NAMETYPE=STRING[40];

CONST
RCRIT1=5E5;
NU:REAL=1.495E-5;
DLUG1:REAL=0.4;
MISSING:REAL=-9E9;
XPOS:INTEGER=60;
XPOS1:INTEGER=20;

VAR

ROOT,LTOT,DLUG,VWORK,RCRIT:REAL;
A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,A11,A12,A13:REAL;
Ax,RL_B,RL_F,WORK,V,DM,DM1,LN1,LT,DB,C,T,NUMFINS:REAL;
SPAN,B,L,CF_B,CB,C0_B,C0FB,CC_B,CF_F,LNDM,LB:        REAL;
SSSMNOSE,SSSMBODY,SSSMTAIL,SSSM,SF,SM,SFSM:REAL;
CD0_FB,CDF_F,CDF_B,CDF_BL,CDF_BT:REAL;
UTILCHAR,NOSE:CHAR;
NOSE1:STRING[1];
FIRST,COLOR:BOOLEAN;
IWORK:INTEGER;
TITLE:NAMETYPE;
{============================================================================}
PROCEDURE GETVAL(VAR REALVAR:REAL;FRAC,POSX,POSY:INTEGER);
VAR
CODE:INTEGER;
STRBUF:STRING[12];
REALBUF:REAL;

BEGIN
STR(REALVAR,STRBUF);
REALBUF:=REALVAR;

REPEAT

GOTOXY(POSX,POSY);
IF REALVAR<>MISSING THEN
BEGIN
  WRITE(REALVAR:9:FRAC);
  GOTOXY(POSX,POSY);
END;

READ(STRBUF);
VAL(COPY(STRBUF,1,LENGTH(STRBUF)),REALBUF,CODE);

IF((CODE<>0)OR(REALBUF=MISSING)OR(REALBUF<0))THEN
BEGIN
  SOUND(440);
  DELAY(500);
  NOSOUND;
END;

UNTIL((CODE=0)AND(REALBUF<>MISSING)AND(REALBUF>=0));

REALVAR:=REALBUF;
GOTOXY(POSX,POSY);
WRITELN(REALVAR:9:FRAC);

END;

{============================================================================}
PROCEDURE GETSTR(VAR STRVAR:NAMETYPE;POSX,POSY:INTEGER);
{$V+}
VAR
STRBUF1:NAMETYPE;
II:INTEGER;

BEGIN

REPEAT

STRBUF1:=STRVAR;

GOTOXY(POSX,POSY);
IF STRVAR<>' ' THEN
BEGIN
  WRITE(STRVAR:40);
  GOTOXY(POSX,POSY);
END;

READ(STRBUF1);

IF STRBUF1='' THEN STRBUF1:=STRVAR;

IF((STRBUF1=' '))THEN
BEGIN
  SOUND(440);
  DELAY(500);
  NOSOUND;
END;

UNTIL((STRBUF1<>' '));

STRVAR:=STRBUF1;
GOTOXY(POSX,POSY);
WRITE(' ':40);
GOTOXY(POSX,POSY);
II:=(80-LENGTH(STRVAR))DIV 2;

WRITELN(' ':II-5,STRVAR:LENGTH(STRVAR));

END;

{============================================================================}
PROCEDURE MENU(VAR UTILCHAR:CHAR);
BEGIN

CLRSCR;


  GOTOXY(18,12);
  WRITE('PRESS ''Q'' TO QUIT OR ANYTHING ELSE TO REPEAT  ');
  READ(KBD,UTILCHAR);
  UTILCHAR:=UPCASE(UTILCHAR);


END;

{============================================================================}
PROCEDURE SUMDRAG(VAR CD0_FB:REAL;CF_B,CF_F:REAL);

VAR
WORK,CDF_B,CDB,CD0_B,CD0_F:REAL;

BEGIN
WORK:=L/DM;
CDF_B:=CF_B*(1.0+60.0/(SQR(WORK)*WORK)+0.0025*WORK)*SSSM;
{WRITELN('CF_B= ',CF_B,' CF_F= ',CF_F)};{*********}
WORK:=DB/DM;
CDB:=0.029*SQR(WORK)*WORK/SQRT(CDF_B);

CD0_B:=CDF_B+CDB;
CD0_F:=2*CF_F*(1.0+2.0*T/C);
CD0_FB:=CD0_F*SFSM+CD0_B;

END;
{============================================================================}
PROCEDURE INIT;
BEGIN
TITLE:='';
NOSE:='O';
NOSE1:='O';
A1:=MISSING;
A2:=MISSING;
A3:=MISSING;
A4:=0;
A5:=MISSING;
A6:=MISSING;
A7:=MISSING;
A8:=MISSING;
A9:=MISSING;
A10:=MISSING;
A11:=MISSING;
A12:=60;
A13:=DLUG1;
RCRIT:=RCRIT1;
END;
{============================================================================}
PROCEDURE READIN;

BEGIN
CLRSCR;

WRITE('TITLE');
GETSTR(TITLE,7,WHEREY);
WRITELN;
WRITE('AIR SPEED IN M/SEC');
GETVAL(A12,0,XPOS,WHEREY);
VWORK:=A12;

WRITE('CRITICAL REYNOLDS NUMBER ');
GETVAL(RCRIT,0,XPOS,WHEREY);


WRITE('BODY TUBE DIAMETER IN CM');
GETVAL(A1,4,XPOS,WHEREY);
DM:=A1;
DM:=DM/100.0;
DM1:=DM;

WRITE('OVERALL LENGTH IN CM');
{READLN(LB);}
GETVAL(A2,4,XPOS,WHEREY);
LTOT:=A2/100.0;

WRITE('LENGTH OF NOSE CONE IN CM');
{READLN(LN1);}
GETVAL(A3,4,XPOS,WHEREY);
LN1:=A3/100;
LB:=LTOT-LN1;

WRITE('LENGTH OF BOAT TAIL IN CM');
{READLN(LT);}
GETVAL(A4,4,XPOS,WHEREY);
LT:=A4;
LT:=LT/100.0;

IF LT>0 THEN
BEGIN
  WRITE('DIAMETER AT BASE IN CM');
{  READLN(DB);}
   GETVAL(A5,4,XPOS,WHEREY);
   DB:=A5;
  DB:=DB/100.0;
END
ELSE DB:=DM;

WRITE('AVERAGE FIN CHORD IN CM');
{READLN(C);}
GETVAL(A6,4,XPOS,WHEREY);
C:=A6;
C:=C/100.0;

WRITE('VERTICLE FIN WIDTH IN CM');
{READLN(SPAN);}
GETVAL(A7,4,XPOS,WHEREY);
SPAN:=A7;
SPAN:=SPAN/100.0;

WRITE('ROOT CHORD IN CM');
{READLN(SF);}
GETVAL(A8,4,XPOS,WHEREY);
ROOT:=A8/100.0;

SF:=C*SPAN+ROOT*DM*0.5;

WRITE('MAXIMUM FIN THICKNESS IN CM');
{READLN(T);}
GETVAL(A9,4,XPOS,WHEREY);
T:=A9;
T:=T/100.0;

WRITE('NUMBER OF FINS ');
{READLN(NUMFINS);}
GETVAL(A10,4,XPOS,WHEREY);
NUMFINS:=A10;

WRITE('LAUNCH LUG DIAMETER IN CM');
GETVAL(A13,4,XPOS,WHEREY);
DLUG:=A13;
DLUG:=DLUG/100.0;

IWORK:=WHEREY;
FIRST:=TRUE;

REPEAT

  IF NOT FIRST THEN
  BEGIN
    SOUND(440);
    DELAY(500);
    NOSOUND;
  END
  ELSE FIRST:=FALSE;

  GOTOXY(XPOS+3,IWORK);
  WRITE('          ');
  GOTOXY(1,IWORK);
  WRITE('NOSE TYPE ');
  WRITE('O=OGIVE C=CONE E=ELLIPSE ');
  GOTOXY(XPOS+3,IWORK);
  WRITE(NOSE);
  GOTOXY(XPOS+3,IWORK);
  READLN(NOSE1);
  IF NOSE1<>'' THEN NOSE:=UPCASE(NOSE1);

UNTIL NOSE IN['O','C','E','0'];

IF NOSE='0' THEN NOSE:='O';

{IF NOSE='E' THEN
BEGIN
  WRITE('MAXIMUM NOSE THICKNESS IN CM');
  GETVAL(A11,4,XPOS,WHEREY);
  DM:=A11;
  DM:=DM/100.0;
  IF DM<DM1 THEN DM:=DM1;
END;} {******* CONSIDER ONLY TANGENT ELLIPSES ******}

END;

{============================================================================}
PROCEDURE GETCOLOR(VAR COLOR:BOOLEAN);
VAR
UTILCHAR:CHAR;

BEGIN
CLRSCR;
REPEAT
  GOTOXY(15,10);
  WRITE  ('IF YOU HAVE A COLOR MONITOR THEN ENTER      C');
  GOTOXY(15,12);
  WRITELN('IF YOU HAVE A MONOCHROME MONITOR ENTER      M');
  READ(KBD,UTILCHAR);
UNTIL(UTILCHAR IN ['c','C','m','M']);

IF (UPCASE(UTILCHAR)='C')THEN COLOR:=TRUE
ELSE COLOR:=FALSE;

END;
{============================================================================}
PROCEDURE GETCDF(VAR CDF,RL:REAL; LEN,RCRIT:REAL);

VAR CDF_L,CDF_T:REAL;

BEGIN

RL:=VWORK*LEN/NU;
CDF_L:=1.328/SQRT(RL);
WORK:=LN(RL)*0.2;
CDF_T:=0.074/EXP(WORK);

IF RL<RCRIT THEN CDF:=CDF_L
ELSE IF RCRIT=0 THEN CDF:=CDF_T
ELSE
BEGIN
  B:=RCRIT*(CDF_T-CDF_L);
  CDF:=CDF_T-B/(RL);
END;
END;
{============================================================================}
PROCEDURE EXEC;

BEGIN

CLRSCR;
READIN;

AX:=3.14159*DM*DM/4.0;

LNDM:=LN1/DM;
IF NOSE='O' THEN SSSMNOSE:=2.67*LNDM
ELSE IF NOSE='C' THEN  SSSMNOSE := 2.0*SQRT(0.25+SQR(LNDM))
ELSE
BEGIN
  SSSMNOSE:=1.0+2*LNDM/SQRT(1.0+SQR(LNDM));
  WORK:=SQRT(1.0-SQR(1.0/(2*LNDM)));
  WORK:=ARCTAN(WORK/SQRT(1.0-SQR(WORK)));
  SSSMNOSE:=SSSMNOSE*WORK;
END;

SSSMBODY:=4.0*LB/DM1;

IF LT>0 THEN SSSMTAIL:=2.0*(DM1-DB)*LT*SQRT(1.0+SQR(DM1-DB)/(2.0*LT))/
                       SQR(DM1)

ELSE SSSMTAIL:=0.0;


L:=LB+LN1+LT;
SSSM:=SSSMNOSE+SSSMBODY+SSSMTAIL;

SFSM:=NUMFINS*SF/AX; {** I THINK IT SHOULD BE TWICE THIS **}

GETCDF(CDF_F,RL_F,C,RCRIT);

IF NOSE='C' THEN GETCDF(CDF_B,RL_B,L,0.0)
ELSE GETCDF(CDF_B,RL_B,L,RCRIT);


SUMDRAG(CD0_FB,CDF_B,CDF_F);
WRITELN;WRITELN;
GOTOXY(XPOS1,WHEREY);
WRITELN('DRAG COEFFICIENT     = ',CD0_FB:7:4);
WRITELN;
GOTOXY(XPOS1,WHEREY);
WRITELN('WITH LUG AT CENTER   = ',CD0_FB+5.75*SQR(DLUG/DM):7:4);
WRITELN;
GOTOXY(XPOS1,WHEREY);
WRITELN('WITH LUG IN JOINT    = ',CD0_FB+3.45*SQR(DLUG/DM):7:4);
WRITELN;
GOTOXY(XPOS1,WHEREY);
WRITELN('CROSS SECTIONAL AREA =',AX*10000:7:3);

END;

{============================================================================}

BEGIN

INIT;

GETCOLOR(COLOR);

IF COLOR THEN
BEGIN
  TEXTMODE(C80);
  TEXTCOLOR(WHITE);
  TEXTBACKGROUND(BLUE);
END
ELSE TEXTMODE(BW80);



REPEAT





  EXEC;

  READ(KBD,UTILCHAR);

  MENU(UTILCHAR);

UNTIL UTILCHAR='Q';

TEXTMODE;
CLRSCR;

END.