;
; URMAYEV CYLINDRICAL III
; =======================
;
; Name:           Urmayev Cylindrical III.
; Proj4:	  +proj=urm_3
;                 Libproj4, S. 37, 4.1.17. 
; Quelle:         Gerald I. Evenden. Libproj4: A Comprehensive Library if Cartographic Projection Functions, March 2004
; Richtung:       Inverse Transformation
;
; Das Programm übernimmt die Koordinaten eines Punktes (x/y) und transformiert
; diese in einen Punkt (x'/y').
;
; x/y sind ebene Zielpunktkoordinaten, x'/y' geben die geogr. Breite und Länge
; der Position auf der Quell-Erdkugel, auf der der Zielpunkt gelesen werden
; kann.
;
; Maßstab und Berührungspunkt werden abgefragt.
; Die Zielbildgeometrie wird dem Sekundäroperanden oder einem Fixbild entnommen.
; Der Berührungspunkt wird bildmittig gesetzt.
;
; Literatur:
; Wagner: Kartographische Netzentwürfe, Leipzig: Bibliographisches Institut 1949
; Gerald I. Evenden, USGS: Libproj4. A Comprehensive Library if Cartographic Projection Functions, March 2004
;
; Formelzeichen u. a. aus Wagner-Quellen

; (C) Rolf Böhm 2004

; Benutzte Variablen
; ==================
;
; Die Variablennamen entsprechen weitgehend denen von Karlheinz Wagner,

;
; Laufende Koordinaten
;
	_name	Urmayev~Cylindrical~III
	_var	phi		; Geographische Breite
	_var	lambda		; Geographische Länge
	_var	delta		; Poldistanz/geographisch, auch Schiefdistanz
;
; Adressen
;
	_var	call		; Unterprogrammadresse
	_var	return		; Rücksprungadresse
;
; Konstanten der Transformation
;
	_var	lambda0		; Geogr. Länge des Bildmittelpunktes
	_var	scale		; Kartenmaßstabszahl (also 1000000, nicht 1/1000000)
;
; x, y, x', y', Cx', Cy', °(, (°, pi, pi/2 etc. sind vordefinierte globale Konstanten
;
; Initialisierung
; ===============
;
	tstne	initial	077$
; Dialog
	input	scale	Urmayev~Cylindrical~III\\Maßstabszahl
	input	lambda0	Mittelpunktslänge~in~Grad
; Eingegebene Werte auf Min/Max bringen
	clip	scale	1	1E12
	clip	lambda0	-180	180
; Programm ist initialisiert
	mov	initial	1
077$:

;
; SIMD-Laufbereich
; ================

;
; Maßstab, Kartenmittelpunkt etc. einrechnen
; ------------------------------------------

	sub	x	Cx'		; Bildmittelpunkt
	div	x	Rx'		; Erdradius
	mul	x	scale		; Kartenmaßstab

	sub	y	Cy'
	div	y	Ry'
	mul	y	scale
;
; Eigentlicher Entwurf, dieser invers
; -----------------------------------
;
	mov	lambda	x		; Geographische Länge

	mov	.d	y		; Geographische Breite
	neg	.d
	mov	.c	0.92813411
	mov	.b	0
	mov	.a	1.11426959
	div	.a	3
	mov	return	$call_cardani
	jump	$cardani
$call_cardani:
	mov	phi	.radix	

;
; In Gradmaß umrechnen und Ausserhalbtest
; ---------------------------------------
	mul	phi	(°
	mul	lambda	(°
	cmplt	phi	-90	out
	cmpgt	phi	90	out
	cmplt	lambda	-180	out
	cmpgt	lambda	180	out

;
; Schlussarbeiten
; ---------------
;
	mov	x'	lambda
	add	x'	lambda0
	mov	y'	phi


	cmpgt	x'	-180	10$
	add	x'	360
10$:
	cmpgt	x'	-180	30$
	add	x'	360
30$:
	cmplt	x'	180	40$
	sub	x'	360
40$:
	cmplt	x'	180	50$
	sub	x'	360
50$:

	exit
out:
	mov	x'	-9999
	mov	y'	-9999
	exit

;
; UNTERPROGRAMME
; ==============
;
; CARDANISCHE FORMEL II
; ---------------------
;
; Die Cardanische Formel löst kubische Gleichungen.
;
; Eingabe: Es werden die 4 Koeffizienten der allgemeinen Form auf den Variablen
;          .a  .b  .c  und  .d  erwartet.
;          Das Programm springt am Ende auf die Adresse, die auf dem Wirtssymbol
;          return steht.
;
; Ausgabe: Die Lösung steht auf der Variablen .radix. 
;          Wenn .radix -9999 ist, so war das Programm nicht erfolgreich.
;          (Dies ist beim casus irreducibilis der Fall; den habe ich noch nicht 
;          programmiert.)
;
; Anmerkung: Cardani hat die Formel nur gestohlen. der Urheber war 
; Niccolo Tartaglia ca. 1500 bis 1557. Das Cardanische Gelenk hat er übrigens
; auch nur gemaust.
;
; (C) Rolf Böhm 2004
;
;	Koeffizienten der allgemeinen Form
	_var	.a
	_var 	.b
	_var	.c
	_var	.d
;	Koeffizienten den Normalform 
	_var	.r
	_var	.s
	_var	.t
;	Koeffizienten der reduzierten Form
	_var	.p
	_var	.q
;	Temporär
	_var	.t1
	_var	.t2
	_var	.radic	; Der Radikand (oder die Determinante D), der negativ in den casus irredublicus führt
	_var	.radix	; Die Lösung
;
; KUBISCHE GLEICHUNG LÖSEN
;
;	input	.d	Absolutglied
;	input	.c	Linearglied
;	input	.b	Quadratisches~Glied
;	input	.a	Kubisches~Glied
;
; Normalform 
;
$cardani:
	nop
	mov	.r	.b
	div	.r	.a
	mov	.s	.c
	div	.s	.a
	mov	.t	.d
	div	.t	.a
;
; Reduzierte Form 
;
	nop
	mov	.p	.s
	mov	.t1	.r
	power	.t1	2
	div	.t1	3
	sub	.p	.t1

	mov	.q	.r
	power	.q	3
	div	.q	27	
	mul	.q	2
	mov	.t1	.s
	mul	.t1	.r
	div	.t1	3
	sub	.q	.t1
	add	.q	.t
;
; Radikant (manchmal Determinante D genannt)
;
	nop
	mov	.radic	.q
	power	.radic	2
	div	.radic	4
	mov	.t1	.p
	power	.t1	3
	div	.t1	27
	add	.radic	.t1
	tstge	.radic	$cardani_f
	jump	$casus_irreducibilis
;
; Casus irreducibilis
;
; Den braucht man für Netzentwürfe nicht 
;
	output	Casus~irreducibilis	
	mov	.radix	-9999
	exit
;
; Cardanische Formel
;
$cardani_f:
	root	.radic	2	; Radicant computed
;
; Cardanische Formel
;
	nop
	mov	.t1	.q
	div	.t1	2
	neg	.t1
	
	mov	.t2	.t1
	add	.t2	.radic
	root	.t2	3
	mov	.radix	.t2
	
	mov	.t2	.t1
	sub	.t2	.radic
	root	.t2	3
	add	.radix	.t2
;
; Rücksubstitution reduziert --> Normalform
;
	mov	.t1	.r
	div	.t1	3
	sub	.radix	.t1
;
; Probe	
;
;	...
; (Die Lösung steht jetzt auf der Variablen .radix)
;
	jump	return
	_end