Subversion Repositories pvinversion.ecmwf

Compare Revisions

Ignore whitespace Rev 2 → Rev 3

/trunk/lib/libgm2em.f
0,0 → 1,229
REAL FUNCTION PHTOPHS (PHI, LAM, POLPHI, POLLAM)
C
C%Z% Modul %M%, V%I% vom %G%, extrahiert am %H%
C
C**** PHTOPHS - FC:UMRECHNUNG DER WAHREN GEOGRAPHISCHEN BREITE PHI
C**** AUF EINEM PUNKT MIT DEN KOORDINATEN (PHIS, LAMS)
C**** IM ROTIERTEN SYSTEM. DER NORDPOL DES SYSTEMS HAT
C**** DIE WAHREN KOORDINATEN (POLPHI, POLLAM)
C** AUFRUF : PHI = PHTOPHS (PHI, LAM, POLPHI, POLLAM)
C** ENTRIES : KEINE
C** ZWECK : UMRECHNUNG DER WAHREN GEOGRAPHISCHEN BREITE PHI AUF
C** EINEM PUNKT MIT DEN KOORDINATEN (PHIS, LAMS) IM
C** ROTIERTEN SYSTEM. DER NORDPOL DIESES SYSTEMS HAT
C** DIE WAHREN KOORDINATEN (POLPHI, POLLAM)
C** VERSIONS-
C** DATUM : 03.05.90
C**
C** EXTERNALS: KEINE
C** EINGABE-
C** PARAMETER: PHI REAL BREITE DES PUNKTES IM GEOGR. SYSTEM
C** LAM REAL LAENGE DES PUNKTES IM GEOGR. SYSTEM
C** POLPHI REAL GEOGR.BREITE DES N-POLS DES ROT. SYSTEMS
C** POLLAM REAL GEOGR.LAENGE DES N-POLS DES ROT. SYSTEMS
C** AUSGABE-
C** PARAMETER: ROTIERTE BREITE PHIS ALS WERT DER FUNKTION
C** ALLE WINKEL IN GRAD (NORDEN>0, OSTEN>0)
C**
C** COMMON-
C** BLOECKE : KEINE
C**
C** FEHLERBE-
C** HANDLUNG : KEINE
C** VERFASSER: G. DE MORSIER
REAL LAM,PHI,POLPHI,POLLAM
DATA ZRPI18 , ZPIR18 / 57.2957795 , 0.0174532925 /
ZSINPOL = SIN(ZPIR18*POLPHI)
ZCOSPOL = COS(ZPIR18*POLPHI)
ZLAMPOL = ZPIR18*POLLAM
ZPHI = ZPIR18*PHI
ZLAM = LAM
IF(ZLAM.GT.180.0) ZLAM = ZLAM - 360.0
ZLAM = ZPIR18*ZLAM
ZARG = ZCOSPOL*COS(ZPHI)*COS(ZLAM-ZLAMPOL) + ZSINPOL*SIN(ZPHI)
PHTOPHS = ZRPI18*ASIN(ZARG)
RETURN
END
REAL FUNCTION PHSTOPH (PHIS, LAMS, POLPHI, POLLAM)
C
C%Z% Modul %M%, V%I% vom %G%, extrahiert am %H%
C
C**** PHSTOPH - FC:BERECHNUNG DER WAHREN GEOGRAPHISCHEN BREITE FUER
C**** EINEN PUNKT MIT DEN KOORDINATEN (PHIS, LAMS) IM
C**** ROTIERTEN SYSTEM. DER NORDPOL DIESES SYSTEMS HAT
C**** DIE WAHREN KOORDINATEN (POLPHI, POLLAM)
C** AUFRUF : PHI = PHSTOPH (PHIS, LAMS, POLPHI, POLLAM)
C** ENTRIES : KEINE
C** ZWECK : BERECHNUNG DER WAHREN GEOGRAPHISCHEN BREITE FUER
C** EINEN PUNKT MIT DEN KOORDINATEN (PHIS, LAMS) IM
C** ROTIERTEN SYSTEM. DER NORDPOL DIESES SYSTEMS HAT
C** DIE WAHREN KOORDINATEN (POLPHI, POLLAM)
C** VERSIONS-
C** DATUM : 03.05.90
C**
C** EXTERNALS: KEINE
C** EINGABE-
C** PARAMETER: PHIS REAL GEOGR. BREITE DES PUNKTES IM ROT.SYS.
C** LAMS REAL GEOGR. LAENGE DES PUNKTES IM ROT.SYS.
C** POLPHI REAL WAHRE GEOGR. BREITE DES NORDPOLS
C** POLLAM REAL WAHRE GEOGR. LAENGE DES NORDPOLS
C** AUSGABE-
C** PARAMETER: WAHRE GEOGRAPHISCHE BREITE ALS WERT DER FUNKTION
C** ALLE WINKEL IN GRAD (NORDEN>0, OSTEN>0)
C**
C** COMMON-
C** BLOECKE : KEINE
C**
C** FEHLERBE-
C** HANDLUNG : KEINE
C** VERFASSER: D.MAJEWSKI
REAL LAMS,PHIS,POLPHI,POLLAM
DATA ZRPI18 , ZPIR18 / 57.2957795 , 0.0174532925 /
SINPOL = SIN(ZPIR18*POLPHI)
COSPOL = COS(ZPIR18*POLPHI)
ZPHIS = ZPIR18*PHIS
ZLAMS = LAMS
IF(ZLAMS.GT.180.0) ZLAMS = ZLAMS - 360.0
ZLAMS = ZPIR18*ZLAMS
ARG = COSPOL*COS(ZPHIS)*COS(ZLAMS) + SINPOL*SIN(ZPHIS)
PHSTOPH = ZRPI18*ASIN(ARG)
RETURN
END
REAL FUNCTION LMTOLMS (PHI, LAM, POLPHI, POLLAM)
C
C%Z% Modul %M%, V%I% vom %G%, extrahiert am %H%
C
C**** LMTOLMS - FC:UMRECHNUNG DER WAHREN GEOGRAPHISCHEN LAENGE LAM
C**** AUF EINEM PUNKT MIT DEN KOORDINATEN (PHIS, LAMS)
C**** IM ROTIERTEN SYSTEM. DER NORDPOL DES SYSTEMS HAT
C**** DIE WAHREN KOORDINATEN (POLPHI, POLLAM)
C** AUFRUF : LAM = LMTOLMS (PHI, LAM, POLPHI, POLLAM)
C** ENTRIES : KEINE
C** ZWECK : UMRECHNUNG DER WAHREN GEOGRAPHISCHEN LAENGE LAM AUF
C** EINEM PUNKT MIT DEN KOORDINATEN (PHIS, LAMS) IM
C** ROTIERTEN SYSTEM. DER NORDPOL DIESES SYSTEMS HAT
C** DIE WAHREN KOORDINATEN (POLPHI, POLLAM)
C** VERSIONS-
C** DATUM : 03.05.90
C**
C** EXTERNALS: KEINE
C** EINGABE-
C** PARAMETER: PHI REAL BREITE DES PUNKTES IM GEOGR. SYSTEM
C** LAM REAL LAENGE DES PUNKTES IM GEOGR. SYSTEM
C** POLPHI REAL GEOGR.BREITE DES N-POLS DES ROT. SYSTEMS
C** POLLAM REAL GEOGR.LAENGE DES N-POLS DES ROT. SYSTEMS
C** AUSGABE-
C** PARAMETER: WAHRE GEOGRAPHISCHE LAENGE ALS WERT DER FUNKTION
C** ALLE WINKEL IN GRAD (NORDEN>0, OSTEN>0)
C**
C** COMMON-
C** BLOECKE : KEINE
C**
C** FEHLERBE-
C** HANDLUNG : KEINE
C** VERFASSER: G. DE MORSIER
REAL LAM,PHI,POLPHI,POLLAM
DATA ZRPI18 , ZPIR18 / 57.2957795 , 0.0174532925 /
ZSINPOL = SIN(ZPIR18*POLPHI)
ZCOSPOL = COS(ZPIR18*POLPHI)
ZLAMPOL = ZPIR18*POLLAM
ZPHI = ZPIR18*PHI
ZLAM = LAM
IF(ZLAM.GT.180.0) ZLAM = ZLAM - 360.0
ZLAM = ZPIR18*ZLAM
ZARG1 = - SIN(ZLAM-ZLAMPOL)*COS(ZPHI)
ZARG2 = - ZSINPOL*COS(ZPHI)*COS(ZLAM-ZLAMPOL)+ZCOSPOL*SIN(ZPHI)
IF (ABS(ZARG2).LT.1.E-30) THEN
IF (ABS(ZARG1).LT.1.E-30) THEN
LMTOLMS = 0.0
ELSEIF (ZARG1.GT.0.) THEN
LMTOLMS = 90.0
ELSE
LMTOLMS = -90.0
ENDIF
ELSE
LMTOLMS = ZRPI18*ATAN2(ZARG1,ZARG2)
ENDIF
RETURN
END
REAL FUNCTION LMSTOLM (PHIS, LAMS, POLPHI, POLLAM)
C
C%Z% Modul %M%, V%I% vom %G%, extrahiert am %H%
C
C**** LMSTOLM - FC:BERECHNUNG DER WAHREN GEOGRAPHISCHEN LAENGE FUER
C**** EINEN PUNKT MIT DEN KOORDINATEN (PHIS, LAMS)
C**** IM ROTIERTEN SYSTEM. DER NORDPOL DES SYSTEMS HAT
C**** DIE WAHREN KOORDINATEN (POLPHI, POLLAM)
C** AUFRUF : LAM = LMSTOLM (PHIS, LAMS, POLPHI, POLLAM)
C** ENTRIES : KEINE
C** ZWECK : BERECHNUNG DER WAHREN GEOGRAPHISCHEN LAENGE FUER
C** EINEN PUNKT MIT DEN KOORDINATEN (PHIS, LAMS)
C** IM ROTIERTEN SYSTEM. DER NORDPOL DIESES SYSTEMS HAT
C** DIE WAHREN KOORDINATEN (POLPHI, POLLAM)
C** VERSIONS-
C** DATUM : 03.05.90
C**
C** EXTERNALS: KEINE
C** EINGABE-
C** PARAMETER: PHIS REAL GEOGR. BREITE DES PUNKTES IM ROT.SYS.
C** LAMS REAL GEOGR. LAENGE DES PUNKTES IM ROT.SYS.
C** POLPHI REAL WAHRE GEOGR. BREITE DES NORDPOLS
C** POLLAM REAL WAHRE GEOGR. LAENGE DES NORDPOLS
C** AUSGABE-
C** PARAMETER: WAHRE GEOGRAPHISCHE LAENGE ALS WERT DER FUNKTION
C** ALLE WINKEL IN GRAD (NORDEN>0, OSTEN>0)
C**
C** COMMON-
C** BLOECKE : KEINE
C**
C** FEHLERBE-
C** HANDLUNG : KEINE
C** VERFASSER: D.MAJEWSKI
REAL LAMS,PHIS,POLPHI,POLLAM
DATA ZRPI18 , ZPIR18 / 57.2957795 , 0.0174532925 /
ZSINPOL = SIN(ZPIR18*POLPHI)
ZCOSPOL = COS(ZPIR18*POLPHI)
ZLAMPOL = ZPIR18*POLLAM
ZPHIS = ZPIR18*PHIS
ZLAMS = LAMS
IF(ZLAMS.GT.180.0) ZLAMS = ZLAMS - 360.0
ZLAMS = ZPIR18*ZLAMS
ZARG1 = SIN(ZLAMPOL)*(- ZSINPOL*COS(ZLAMS)*COS(ZPHIS) +
1 ZCOSPOL* SIN(ZPHIS)) -
2 COS(ZLAMPOL)* SIN(ZLAMS)*COS(ZPHIS)
ZARG2 = COS(ZLAMPOL)*(- ZSINPOL*COS(ZLAMS)*COS(ZPHIS) +
1 ZCOSPOL* SIN(ZPHIS)) +
2 SIN(ZLAMPOL)* SIN(ZLAMS)*COS(ZPHIS)
IF (ABS(ZARG2).LT.1.E-30) THEN
IF (ABS(ZARG1).LT.1.E-30) THEN
LMSTOLM = 0.0
ELSEIF (ZARG1.GT.0.) THEN
LMSTOLAM = 90.0
ELSE
LMSTOLAM = -90.0
ENDIF
ELSE
LMSTOLM = ZRPI18*ATAN2(ZARG1,ZARG2)
ENDIF
RETURN
END