var/da/da_grid_definitions/da_ffdduv.inc

   1 subroutine da_ffdduv (F,D,U,V,YLON,ID)
   2
   3    !-------------------------------------------------------------------------
   4    ! Purpose: TBD
   5    ! When ID =  1
   6    ! Convert wind speed (F in m/s) and direction (D in degree 0-360) into
   7    ! wind (U-V in m/s) components
   8    !
   9    ! When ID = -1
  10    ! Convert wind (U-V in m/s) components into wind speed (F in m/s) and
  11    ! direction (D in degree 0-360)
  12    !
  13    ! Need map projection parameters from module da_control
  14    !
  15    ! PHIC:  Central latitude
  16    ! XLONC: Central longitude
  17    ! XN:    Cone projection
  18    ! CONV:  180/Pi
  19    !
  20    !-------------------------------------------------------------------------
  21
  22    implicit none
  23
  24    real,    intent (inout) :: f,d
  25    real,    intent (inout) :: u, v
  26    real,    intent (in)    :: ylon
  27    integer, intent (in)    :: id
  28
  29    real :: aearth, uearth, vearth
  30    real :: xlonrt, ang, conv
  31
  32    if (trace_use_frequent) call da_trace_entry("da_ffdduv")
  33
  34    conv = 180.0 / pi
  35
  36    select case (ID)
  37
  38       case (convert_fd2uv);
  39
  40          ! convert wind module/direction into u/v wind components on earth,
  41          ! then convert u/v wind components on earth into lambert conformal or
  42          ! polar stereographic projection u/v wind components.
  43
  44          ! projections change requires only a change of the cone constant, xn
  45          ! equations remain the same.
  46
  47          AEARTH = D/CONV
  48
  49          UEARTH = -F*Sin(AEARTH)
  50          VEARTH = -F*COS(AEARTH)
  51
  52          ! for conversion to grid coordinates,
  53          ! see program datamap, subr vect, and
  54          ! ANTHES METEO. 597 NOTES, EQUA. 2.23, 2.25, 2.28.
  55
  56          XLONRT = XLONC-YLON
  57
  58          if (XLONRT .GT. 180.0) XLONRT=XLONRT-360.0
  59          if (XLONRT .LT.-180.0) XLONRT=XLONRT+360.0
  60
  61          ANG=XLONRT*CONE_FACTOR/CONV
  62
  63          ! for mercator projection, the winds are as in earth coordinates
  64
  65          if (map_projection.EQ.3) ANG=0.0
  66
  67          if (PHIC.LT.0.0) ANG=-ANG
  68
  69          U = VEARTH*Sin(ANG) + UEARTH*COS(ANG)
  70          V = VEARTH*COS(ANG) - UEARTH*Sin(ANG)
  71
  72
  73          ! CONVERT LAMBERT CONFORMAL OR POLAR STEREOGRAPHIC PROJECTION U/V
  74          ! WinD COMPONENTS inTO U/V WinD COMPONENTS ON EART
  75          ! then CONVERT U/V WinD COMPONENTS ON EARTH inTO WinD module/DIRECTION
  76
  77          ! PROJECTIONS CHANGE REQUIRES ONLY A CHANGE OF THE CONE_FACTOR
  78
  79       case (convert_uv2fd);
  80
  81          XLONRT = XLONC-YLON
  82
  83          if (XLONRT .GT. 180.0) XLONRT=XLONRT-360.0
  84          if (XLONRT .LT.-180.0) XLONRT=XLONRT+360.0
  85
  86          ANG=XLONRT*CONE_FACTOR/CONV
  87
  88          ! FOR MERCATOR PROJECTION, THE WinDS ARE AS in EARTH COORDinATES
  89
  90          if (map_projection .EQ.  3) ANG = 0.0
  91          if (PHIC  .LT. 0.0) ANG = -ANG
  92
  93          UEARTH = U*COS(ANG) - V*Sin(ANG)
  94          VEARTH = U*Sin(ANG) + V*COS(ANG)
  95
  96          F = sqrt(UEARTH*UEARTH + VEARTH*VEARTH)
  97
  98          if (F .EQ. 0.0) then
  99             D = 0.0
 100             if (trace_use_frequent) call da_trace_exit("da_ffdduv")
 101             return
 102          end if
 103
 104          if (VEARTH .EQ. 0.0) then
 105             if (UEARTH .GT. 0.0) D = 270.0
 106             if (UEARTH .LT. 0.0) D =  90.0
 107          else
 108             AEARTH = ATAN (UEARTH/VEARTH)*CONV
 109
 110             if (UEARTH .LE. 0.0 .AND. VEARTH .LE. 0.0) D = AEARTH
 111             if (UEARTH .LE. 0.0 .AND. VEARTH .GE. 0.0) D = AEARTH + 180.0
 112             if (UEARTH .GE. 0.0 .AND. VEARTH .GE. 0.0) D = AEARTH + 180.0
 113             if (UEARTH .GE. 0.0 .AND. VEARTH .LE. 0.0) D = AEARTH + 360.0
 114
 115          end if
 116
 117       case default
 118          write(unit=message(1),fmt='(A,I2)') ' UNKNOWN OPTION ',ID
 119          call da_error(__FILE__,__LINE__,message(1:1))
 120
 121    end select
 122
 123    if (trace_use_frequent) call da_trace_exit("da_ffdduv")
 124
 125 end subroutine da_ffdduv
 126
 127