49 50 Ver6.09.hp Geodesic distance & Earth Euclidean distance calculator, bearing
|
03-19-2021, 10:03 AM
Post: #24
|
|||
|
|||
RE: HP49-50G Geodesic distance calculator
RE: HP49-50G
Geodesic distance calculator Version 4.4 New Very slight, "cosmetical" changes. The main one is a DOERR instruction for nearly antipodal points distance calculation (with program P1P2—>s). I thought nice to introduce such a case, in order for the program to stop after 10 unsuccessful iterations and delete by itself the intermediary, useless variables. The full, new code for this variable-program P1P2—>s : \<< "\[] 2 Complex Arg: (lat1,lon1)(lat2,lon2) or 4 Arg: lat1 lon1 lat2 lon2 \[] all GeoDetic [\^o.'s] \[] S < 0 W < 0 Vincenty fails for nearly antipode pts \[]To change a, b, INV.f \-> run af\->b before! " DROP STD DUP TYPE 1 == IF THEN OBJ\-> END 'lon2' STO 'lat2' STO DUP TYPE 1 == IF THEN OBJ\-> END 'lon1' STO 'lat1' STO lat1 "lat1 D.mmss" \->TAG lon1 "lon1 D.mmss" \->TAG lat2 "lat2 D.mmss" \->TAG lon2 "lon2 D.mmss" \->TAG RAD lat1 D\->RAD lon1 D\->RAD lat2 D\->RAD lon2 D\->RAD \-> lat1 lon1 lat2 lon2 \<< lon2 lon1 - DUP '\Gl' STO 'l' STO 2 \pi * \->NUM '\Gl\180' STO 'ATAN((1-f)*TAN(lat1))' \->NUM 'u1' STO 'ATAN((1-f)*TAN(lat2))' \->NUM 'u2' STO 0 'SUM' STO WHILE \Gl \Gl\180 - ABS .000000000001 > REPEAT 1 'SUM' STO+ '\v/((COS(u2)*SIN(\Gl))^2+(COS(u1)*SIN(u2)-SIN(u1)*COS(u2)*COS(\Gl))^2)' \->NUM 'SIN.\Gs' STO 'SIN(u1)*SIN(u2)+COS(u1)*COS(u2)*COS(\Gl)' \->NUM 'COS.\Gs' STO COS.\Gs SIN.\Gs R\->C ARG '\Gs' STO 'COS(u1)*COS(u2)*SIN(\Gl)/SIN(\Gs)' EVAL 'SIN.\Ga' STO 1 SIN.\Ga SQ - 'COS\178.\Ga' STO IF COS\178.\Ga 0 \=/ THEN 'COS.\Gs-2*SIN(u1)*SIN(u2)/COS\178.\Ga' EVAL ELSE 0 END 'COS.2\Gsm' STO 'f/16*COS\178.\Ga*(4+f*(4-3*COS\178.\Ga))' \->NUM 'C' STO \Gl '\Gl\180' STO 'l+(1-C)*f*SIN.\Ga*(\Gs+C*SIN.\Gs*(COS.2\Gsm+C*COS.\Gs*(-1+2*SQ(COS.2\Gsm))))' \->NUM '\Gl' STO SUM 10 == IF THEN { SUM \GD\Gs B A u\178 C COS.2\Gsm COS\178.\Ga SIN.\Ga \Gs COS.\Gs SIN.\Gs u2 u1 \Gl\180 l \Gl } PURGE "2 nearly antipodal points: as expected Vincenty's algor.failed!" DOERR END END 'COS\178.\Ga*(a^2-b^2)/b^2' EVAL 'u\178' STO '1+u\178/16384*(4096+u\178*(-768+u\178*(320-175*u\178)))' \->NUM 'A' STO 'u\178/1024*(256+u\178*(-128+u\178*(74-47*u\178)))' \->NUM 'B' STO 'B*SIN.\Gs*(COS.2\Gsm+B/4*(COS.\Gs*(-1+2*COS.2\Gsm^2)-B/6*COS.2\Gsm*(-3+4*SIN.\Gs^2)*(-3+4*COS.2\Gsm^2)))' \->NUM '\GD\Gs' STO 'b*A*(\Gs-\GD\Gs)' \->NUM 's' STO s 1000 / "s km" \->TAG 'COS(u1)*SIN(u2)-SIN(u1)*COS(u2)*COS(\Gl)' \->NUM 'COS(u2)*SIN(\Gl)' \->NUM R\->C ARG \->NUM RAD\->D HMS\-> 360 MOD 360 MOD \->HMS DUP '\Ga1' STO "\Ga1 D.mmss\166 \|^\-> +90" \->TAG '-SIN(u1)*COS(u2)+COS(u1)*SIN(u2)*COS(\Gl)' \->NUM 'COS(u1)*SIN(\Gl)' \->NUM R\->C ARG \pi + \->NUM RAD\->D HMS\-> 360 MOD 360 MOD \->HMS DUP '\Ga2' STO "\Ga2 D.mmss\166 \|^\-> +90" \->TAG { SUM \GD\Gs B A u\178 C COS.2\Gsm COS\178.\Ga SIN.\Ga \Gs COS.\Gs SIN.\Gs u2 u1 \Gl\180 l \Gl } PURGE \>> 0 0 h12\->s.h12 s.0 s > IF THEN DROP END DROP 6 ROLLD 3 DROPN s.0 s > IF THEN "s.0:" s.0 + " >? s:" + s + END \>> Attached here, as always, the full Directory with its ordered variables and programs. Regards, Gil |
|||
« Next Oldest | Next Newest »
|
User(s) browsing this thread: 1 Guest(s)