var/da/da_grid_definitions/da_ffdduv_model.inc

   1 subroutine da_ffdduv_model (F,D,U,V,ID)
   2
   3    !-------------------------------------------------------------------------
   4    ! Purpose: TBD
   5
   6    ! When ID =  1
   7    ! Convert wind speed (F in m/s) and direction (D in degree 0-360) into
   8    ! wind (U-V in m/s) components on grid coordinates
   9    !
  10    ! When ID = -1
  11    ! Convert wind (U-V in m/s) components into wind speed (F in m/s) and
  12    ! direction (D in degree 0-360) on grid coordinates
  13    !
  14    !-------------------------------------------------------------------------
  15
  16    implicit none
  17
  18    real,    intent (inout) :: F,D
  19    real,    intent (inout) :: U,V
  20    integer, intent (in)    :: ID
  21    real                    :: CONV,A
  22
  23    if (trace_use_frequent) call da_trace_entry("da_ffdduv_model")
  24
  25    CONV = 180.0 / pi
  26
  27    select case (ID)
  28
  29       case (convert_fd2uv);
  30
  31          U = -F*SIN(D/CONV)
  32          V = -F*COS(D/CONV)
  33
  34       case (convert_uv2fd);
  35
  36          F = sqrt(U*U + V*V)
  37
  38          if (F .EQ. 0.0) then
  39             D = 0.0
  40             if (trace_use_frequent) call da_trace_exit("da_ffdduv_model")
  41             return
  42          end if
  43
  44          if (V .EQ. 0.0) then
  45             if (U .GT. 0.0) D = 270.0
  46             if (U .LT. 0.0) D =  90.0
  47          else
  48             A = ATAN (U/V)*CONV
  49
  50             if (U .LE. 0.0 .AND. V .LE. 0.0) D = A
  51             if (U .LE. 0.0 .AND. V .GE. 0.0) D = A + 180.0
  52             if (U .GE. 0.0 .AND. V .GE. 0.0) D = A + 180.0
  53             if (U .GE. 0.0 .AND. V .LE. 0.0) D = A + 360.0
  54
  55          end if
  56
  57       case default
  58          write(unit=message(1),fmt='(A,I2)') ' UNKNOWN OPTION ',ID
  59          call da_error(__FILE__,__LINE__,message(1:1))
  60
  61    end select
  62
  63    if (trace_use_frequent) call da_trace_exit("da_ffdduv_model")
  64
  65 end subroutine da_ffdduv_model
  66
  67