da_llxy.inc

References to this file elsewhere.
1 subroutine da_llxy (xlati,xloni,x,y)
2 
3    !----------------------------------------------------------------------------
4    !
5    !                 routine llxy
6    !                **************
7    !
8    !
9    ! Purpose:  calculates the (x,y) location (dot) in the mesoscale grids
10    ! -------   from latitudes and longitudes
11    !
12    !           for global domain co-ordinates
13    !
14    !  input:
15    !  -----
16    !   xlat:    latitudes
17    !   xlon:    longitudes
18    !
19    ! output:
20    ! -----
21    !   x:        the coordinate in x (i)-direction.
22    !   y:        the coordinate in y (j)-direction.
23    !
24    !----------------------------------------------------------------------------
25    
26    implicit none
27    
28    real, intent(in)  :: xlati, xloni
29    real, intent(out) :: x, y
30 
31    real              :: dxlon
32    real              :: xlat, xlon
33    real              :: xx, yy, xc, yc
34    real              :: cell, psi0, psx, r, flp
35    real              :: centri, centrj
36    real              :: ratio
37    real              :: bb
38    real, parameter   :: conv = 180.0 / pi
39    
40    xlon = xloni
41    xlat = xlati
42 
43    xlat = max (xlat, -89.95)
44    xlat = min (xlat, +89.95)
45    
46    dxlon = xlon - xlonc
47    if (dxlon >  180) dxlon = dxlon - 360.
48    if (dxlon < -180) dxlon = dxlon + 360.
49    
50    if (map_projection == 3) then
51       xc = 0.0
52       yc = YCNTR
53 
54       cell = cos(xlat/conv)/(1.0+sin(xlat/conv))
55       yy = -c2*alog(cell)
56       xx = c2*dxlon/conv
57    else
58       psi0 = (pole - phic)/conv
59       xc = 0.0
60 
61       ! calculate x,y coords. relative to pole
62 
63       flp = cone_factor*dxlon/conv
64    
65       psx = (pole - xlat)/conv
66    
67       if (map_projection == 2) then
68          ! Polar stereographics:
69          bb = 2.0*(cos(psi1/2.0)**2)
70          yc = -earth_radius*bb*tan(psi0/2.0)
71           r = -earth_radius*bb*tan(psx/2.0)
72       else
73          ! Lambert conformal:
74          bb = -earth_radius/cone_factor*sin(psi1)
75          yc = bb*(tan(psi0/2.0)/tan(psi1/2.0))**cone_factor
76           r = bb*(tan(psx /2.0)/tan(psi1/2.0))**cone_factor
77       end if
78 
79       if (phic < 0.0) then
80          xx = r*sin(flp)
81          yy = r*cos(flp)
82       else
83          xx = -r*sin(flp)
84          yy =  r*cos(flp)
85       end if
86 
87    end if
88 
89    ! transform (1,1) to the origin
90    ! the location of the center in the coarse domain
91 
92    centri = real (coarse_ix + 1)/2.0  
93    centrj = real (coarse_jy + 1)/2.0  
94 
95    ! the (x,y) coordinates in the coarse domain
96 
97    x = (xx - xc)/coarse_ds + centri 
98    y = (yy - yc)/coarse_ds + centrj  
99 
100    ratio = coarse_ds / dsm
101 
102    ! only add 0.5 so that x/y is relative to first cross points:
103 
104    x = (x - start_x)*ratio + 0.5
105    y = (y - start_y)*ratio + 0.5
106 
107 end subroutine da_llxy
108 
109