SUBROUTINE W3FB12(XI,XJ,ALAT1,ELON1,DX,ELONV,ALATAN,ALAT,ELON, & IERR) C$$$ SUBPROGRAM DOCUMENTATION BLOCK C C SUBPROGRAM: W3FB12 LAMBERT(I,J) TO LAT/LON FOR GRIB C PRGMMR: STACKPOLE ORG: NMC42 DATE:88-11-28 C C ABSTRACT: CONVERTS THE COORDINATES OF A LOCATION ON EARTH GIVEN IN A C GRID COORDINATE SYSTEM OVERLAID ON A LAMBERT CONFORMAL TANGENT C CONE PROJECTION TRUE AT A GIVEN N OR S LATITUDE TO THE C NATURAL COORDINATE SYSTEM OF LATITUDE/LONGITUDE C W3FB12 IS THE REVERSE OF W3FB11. C USES GRIB SPECIFICATION OF THE LOCATION OF THE GRID C C PROGRAM HISTORY LOG: C 88-11-25 ORIGINAL AUTHOR: STACKPOLE, W/NMC42 C 90-04-12 R.E.JONES CONVERT TO CFT77 FORTRAN C 94-04-28 R.E.JONES ADD SAVE STATEMENT C C USAGE: CALL W3FB12(XI,XJ,ALAT1,ELON1,DX,ELONV,ALATAN,ALAT,ELON,IERR, C IERR) C INPUT ARGUMENT LIST: C XI - I COORDINATE OF THE POINT REAL*4 C XJ - J COORDINATE OF THE POINT REAL*4 C ALAT1 - LATITUDE OF LOWER LEFT POINT OF GRID (POINT 1,1) C LATITUDE <0 FOR SOUTHERN HEMISPHERE; REAL*4 C ELON1 - LONGITUDE OF LOWER LEFT POINT OF GRID (POINT 1,1) C EAST LONGITUDE USED THROUGHOUT; REAL*4 C DX - MESH LENGTH OF GRID IN METERS AT TANGENT LATITUDE C ELONV - THE ORIENTATION OF THE GRID. I.E., C THE EAST LONGITUDE VALUE OF THE VERTICAL MERIDIAN C WHICH IS PARALLEL TO THE Y-AXIS (OR COLUMNS OF C THE GRID) ALONG WHICH LATITUDE INCREASES AS C THE Y-COORDINATE INCREASES. REAL*4 C THIS IS ALSO THE MERIDIAN (ON THE OTHER SIDE OF THE C TANGENT CONE) ALONG WHICH THE CUT IS MADE TO LAY C THE CONE FLAT. C ALATAN - THE LATITUDE AT WHICH THE LAMBERT CONE IS TANGENT TO C (TOUCHES OR OSCULATES) THE SPHERICAL EARTH. C SET NEGATIVE TO INDICATE A C SOUTHERN HEMISPHERE PROJECTION; REAL*4 C C OUTPUT ARGUMENT LIST: C ALAT - LATITUDE IN DEGREES (NEGATIVE IN SOUTHERN HEMI.) C ELON - EAST LONGITUDE IN DEGREES, REAL*4 C IERR - .EQ. 0 IF NO PROBLEM C .GE. 1 IF THE REQUESTED XI,XJ POINT IS IN THE C FORBIDDEN ZONE, I.E. OFF THE LAMBERT MAP C IN THE OPEN SPACE WHERE THE CONE IS CUT. C IF IERR.GE.1 THEN ALAT=999. AND ELON=999. C C REMARKS: FORMULAE AND NOTATION LOOSELY BASED ON HOKE, HAYES, C AND RENNINGER'S "MAP PROJECTIONS AND GRID SYSTEMS...", MARCH 1981 C AFGWC/TN-79/003 C C ATTRIBUTES: C LANGUAGE: CRAY CFT77 FORTRAN C MACHINE: CRAY C916-128, CRAY Y-MP8/864, CRAY Y-MP EL2/256 C C$$$ C LOGICAL NEWMAP C SAVE C C ================================= RCS keyword statements ========== CHARACTER*68 RCSKW1,RCSKW2 DATA RCSKW1,RCSKW2 / ' .$Source: /fs/hseb/ob72/wfo_rfc/precip_proc/source/gribit/src/RCS/w3fb12.f,v $ . $', ' .$Id: w3fb12.f,v 1.1 2006/05/03 13:44:00 gsood Exp $ . $' / C =================================================================== C C DATA RERTH /6.3712E+6/, PI/3.14159/, OLDRML/99999./ C C PRELIMINARY VARIABLES AND REDIFINITIONS C C H = 1 FOR NORTHERN HEMISPHERE; = -1 FOR SOUTHERN C IF (ALATAN.GT.0) THEN H = 1. ELSE H = -1. ENDIF C PIBY2 = PI / 2.0 RADPD = PI / 180.0 DEGPRD = 1.0 / RADPD REBYDX = RERTH / DX ALATN1 = ALATAN * RADPD AN = H * SIN(ALATN1) COSLTN = COS(ALATN1) C C MAKE SURE THAT INPUT LONGITUDE DOES NOT PASS THROUGH C THE CUT ZONE (FORBIDDEN TERRITORY) OF THE FLAT MAP C AS MEASURED FROM THE VERTICAL (REFERENCE) LONGITUDE C ELON1L = ELON1 IF ((ELON1-ELONV).GT.180.) & ELON1L = ELON1 - 360. IF ((ELON1-ELONV).LT.(-180.)) & ELON1L = ELON1 + 360. C ELONVR = ELONV * RADPD C C RADIUS TO LOWER LEFT HAND (LL) CORNER C ALA1 = ALAT1 * RADPD RMLL = REBYDX * ((COSLTN**(1.-AN))*(1.+AN)**AN) * & (((COS(ALA1))/(1.+H*SIN(ALA1)))**AN)/AN C C USE RMLL TO TEST IF MAP AND GRID UNCHANGED FROM PREVIOUS C CALL TO THIS CODE. THUS AVOID UNNEEDED RECOMPUTATIONS. C IF (RMLL.EQ.OLDRML) THEN NEWMAP = .FALSE. ELSE NEWMAP = .TRUE. OLDRML = RMLL C C USE LL POINT INFO TO LOCATE POLE POINT C ELO1 = ELON1L * RADPD ARG = AN * (ELO1-ELONVR) POLEI = 1. - H * RMLL * SIN(ARG) POLEJ = 1. + RMLL * COS(ARG) ENDIF C C RADIUS TO THE I,J POINT (IN GRID UNITS) C YY REVERSED SO POSITIVE IS DOWN C XX = XI - POLEI YY = POLEJ - XJ R2 = XX**2 + YY**2 C C CHECK THAT THE REQUESTED I,J IS NOT IN THE FORBIDDEN ZONE C YY MUST BE POSITIVE UP FOR THIS TEST C THETA = PI*(1.-AN) BETA = ABS(ATAN2(XX,-YY)) IERR = 0 IF (BETA.LE.THETA) THEN IERR = 1 ALAT = 999. ELON = 999. IF (.NOT.NEWMAP) RETURN ENDIF C C NOW THE MAGIC FORMULAE C IF (R2.EQ.0) THEN ALAT = H * 90.0 ELON = ELONV ELSE C C FIRST THE LONGITUDE C ELON = ELONV + DEGPRD * ATAN2(H*XX,YY)/AN ELON = AMOD(ELON+360., 360.) C C NOW THE LATITUDE C RECALCULATE THE THING ONLY IF MAP IS NEW SINCE LAST TIME C IF (NEWMAP) THEN ANINV = 1./AN ANINV2 = ANINV/2. THING = ((AN/REBYDX) ** ANINV)/ & ((COSLTN**((1.-AN)*ANINV))*(1.+ AN)) ENDIF ALAT = H*(PIBY2 - 2.*ATAN(THING*(R2**ANINV2)))*DEGPRD ENDIF C C FOLLOWING TO ASSURE ERROR VALUES IF FIRST TIME THRU C IS OFF THE MAP C IF (IERR.NE.0) THEN ALAT = 999. ELON = 999. IERR = 2 ENDIF RETURN END