var/da/da_verif_obs/da_verif_obs_init.f90

   1 MODULE da_verif_obs_init
   2 !----------------------------------------------------------------------------
   3 ! History:
   4 !
   5 !  Abstract:
   6 !   Main module for
   7 !   initializing various arrays
   8 !
   9 !  Author:   Syed RH Rizvi     NCAR/MMM         05/30/2006
  10 !----------------------------------------------------------------------------
  11    USE da_verif_obs_control
  12
  13 CONTAINS
  14
  15    subroutine da_advance_cymdh( start_date, dh, end_date )
  16
  17    implicit none
  18
  19    character (len=10), intent(in)  :: start_date ! In date (ccyymmddhh).
  20    integer, intent(in)             :: dh         ! Period to advance (-ve for past).
  21    character (len=10), intent(out) :: end_date   ! Out date (ccyymmddhh).
  22
  23    integer :: ccyy, mm, dd, hh
  24
  25    read(start_date(1:10), fmt='(i4, 3i2)')  ccyy, mm, dd, hh
  26
  27    hh = hh + dh
  28
  29    do while (hh < 0)
  30       hh = hh + 24
  31       call da_change_date ( ccyy, mm, dd, -1 )
  32    end do
  33
  34    do while (hh > 23)
  35       hh = hh - 24
  36       call da_change_date ( ccyy, mm, dd, 1 )
  37    end do
  38
  39    write(UNIT=end_date(1:10), fmt='(i4, 3i2.2)')  ccyy, mm, dd, hh
  40
  41 end subroutine da_advance_cymdh
  42 subroutine da_change_date( ccyy, mm, dd, delta )
  43
  44    implicit none
  45
  46    integer, intent(inout) :: ccyy, mm, dd
  47    integer, intent(in)    :: delta
  48
  49    integer, dimension(12) :: mmday
  50
  51    mmday = (/31,28,31,30,31,30,31,31,30,31,30,31/)
  52
  53    mmday(2) = 28
  54    if (mod(ccyy,4) == 0) then
  55       mmday(2) = 29
  56
  57       if ( mod(ccyy,100) == 0) then
  58          mmday(2) = 28
  59       endif
  60
  61       if(mod(ccyy,400) == 0) then
  62          mmday(2) = 29
  63       end if
  64    endif
  65
  66    dd = dd + delta
  67
  68    if(dd == 0) then
  69       mm = mm - 1
  70
  71       if(mm == 0) then
  72          mm = 12
  73          ccyy = ccyy - 1
  74       endif
  75
  76       dd = mmday(mm)
  77    elseif ( dd .gt. mmday(mm) ) then
  78       dd = 1
  79       mm = mm + 1
  80       if(mm > 12 ) then
  81          mm = 1
  82          ccyy = ccyy + 1
  83       end if
  84    end if
  85 end subroutine da_change_date
  86    subroutine initialize_surface_type(surface)
  87    type(surface_type), intent(inout)    :: surface
  88 !
  89    call initialize_stats_type(surface%uomb,surface%uoma)
  90    call initialize_stats_type(surface%vomb,surface%voma)
  91    call initialize_stats_type(surface%tomb,surface%toma)
  92    call initialize_stats_type(surface%pomb,surface%poma)
  93    call initialize_stats_type(surface%qomb,surface%qoma)
  94
  95    end subroutine initialize_surface_type
  96 !
  97    subroutine initialize_upr_type(upr)
  98    type(upr_type), intent(inout)    :: upr
  99 !
 100    integer    :: k
 101 !
 102    do k = 1, nstd
 103    call initialize_stats_type(upr%uomb(k),upr%uoma(k))
 104    call initialize_stats_type(upr%vomb(k),upr%voma(k))
 105    call initialize_stats_type(upr%tomb(k),upr%toma(k))
 106    call initialize_stats_type(upr%qomb(k),upr%qoma(k))
 107    enddo
 108
 109    end subroutine initialize_upr_type
 110 !
 111    subroutine initialize_gpspw_type(gpspw)
 112    type(gpspw_type), intent(inout)    ::  gpspw
 113 !
 114       call initialize_stats_type(gpspw%tpwomb,gpspw%tpwoma)
 115    end subroutine initialize_gpspw_type
 116 !
 117    subroutine initialize_gpsref_type(gpsref)
 118    type(gpsref_type), intent(inout)    ::  gpsref
 119    integer     :: k
 120
 121 !
 122    do k = 1, nstdh
 123    call initialize_stats_type(gpsref%refomb(k),gpsref%refoma(k))
 124    enddo
 125    end subroutine initialize_gpsref_type
 126 !
 127    subroutine initialize_stats_type(omb, oma)
 128    type(stats_value), intent(inout)    :: omb, oma
 129    omb%num   = 0 ; oma%num   = 0
 130    omb%bias  = 0 ; oma%bias  = 0
 131    omb%abias = 0 ; oma%abias = 0
 132    omb%rmse  = 0 ; oma%rmse  = 0
 133    end subroutine initialize_stats_type
 134 !
 135    subroutine initialize_t_tab
 136    implicit none
 137    integer :: i
 138
 139  !
 140   ! Initalize Student t table for alpha=0.025
 141   !
 142
 143   ! Degrees of freedom
 144    do i=1,30
 145     alpha(i,1) = i
 146    end do
 147    alpha(31,1) = 40.
 148    alpha(32,1) = 60.
 149    alpha(33,1) = 120.
 150    alpha(34,1) = 400.
 151
 152    ! Critical t value
 153    alpha(1,2) = 12.706
 154    alpha(2,2) = 4.303
 155    alpha(3,2) = 3.182
 156    alpha(4,2) = 2.776
 157    alpha(5,2) = 2.571
 158    alpha(6,2) = 2.447
 159    alpha(7,2) = 2.365
 160    alpha(8,2) = 2.306
 161    alpha(9,2) = 2.262
 162    alpha(10,2) = 2.228
 163    alpha(11,2) = 2.201
 164    alpha(12,2) = 2.179
 165    alpha(13,2) = 2.160
 166    alpha(14,2) = 2.145
 167    alpha(15,2) = 2.131
 168    alpha(16,2) = 2.120
 169    alpha(17,2) = 2.110
 170    alpha(18,2) = 2.101
 171    alpha(19,2) = 2.093
 172    alpha(20,2) = 2.086
 173    alpha(21,2) = 2.080
 174    alpha(22,2) = 2.074
 175    alpha(23,2) = 2.069
 176    alpha(24,2) = 2.064
 177    alpha(25,2) = 2.060
 178    alpha(26,2) = 2.056
 179    alpha(27,2) = 2.052
 180    alpha(28,2) = 2.048
 181    alpha(29,2) = 2.045
 182    alpha(30,2) = 2.042
 183    alpha(31,2) = 2.021
 184    alpha(32,2) = 2.000
 185    alpha(33,2) = 1.980
 186    alpha(34,2) = 1.960
 187
 188    end subroutine initialize_t_tab
 189
 190 !-------------------------------------------------
 191 end MODULE da_verif_obs_init