var/convertor/average_be/rd_be_cv_5.F

   1 subroutine rd_be_cv_5(be_fname, be)
   2
   3    use be_type
   4
   5    IMPLICIT NONE
   6
   7    character (len=256) :: be_fname
   8    type (be_dat) :: be
   9
  10    integer :: ni, nj, nk, nk_2d, j, b
  11    integer :: be_unit, istatus
  12
  13
  14    be_unit = 10
  15    open (be_unit, file=trim(be_fname), status='old', form='unformatted',iostat=istatus)
  16
  17    read(be_unit) be%ni, be%nj, be%nk
  18    ni = be%ni
  19    nj = be%nj
  20    nk = be%nk
  21
  22    allocate( be%bin(1:ni,1:nj,1:nk) )
  23    allocate( be%bin2d(1:ni,1:nj) )
  24
  25    read(be_unit) be%bin_type
  26    read(be_unit) be%lat_min, be%lat_max, be%binwidth_lat
  27    read(be_unit) be%hgt_min, be%hgt_max, be%binwidth_hgt
  28    read(be_unit) be%num_bins, be%num_bins2d
  29    read(be_unit) be%bin(1:ni,1:nj,1:nk)
  30    read(be_unit) be%bin2d(1:ni,1:nj)
  31
  32 !  1.1 Read in regression coefficients
  33
  34    allocate (be%regcoeff1(1:be%num_bins))
  35    allocate (be%regcoeff2(1:nk,1:be%num_bins2d))
  36    allocate (be%regcoeff3(1:nk,1:nk,1:be%num_bins2d))
  37    read(be_unit) be%regcoeff1
  38    read(be_unit) be%regcoeff2
  39    read(be_unit) be%regcoeff3
  40
  41 !  2.0 Load the eigenvector and eigenvalue
  42
  43    allocate ( be%be1_eval_loc (1:nj,1:nk) )
  44    allocate ( be%be2_eval_loc (1:nj,1:nk) )
  45    allocate ( be%be3_eval_loc (1:nj,1:nk) )
  46    allocate ( be%be4_eval_loc (1:nj,1:nk) )
  47    allocate ( be%be5_eval_loc (1:nj,1:1 ) )
  48
  49    allocate ( be%be1_eval_glo(1:nk) )
  50    allocate ( be%be2_eval_glo(1:nk) )
  51    allocate ( be%be3_eval_glo(1:nk) )
  52    allocate ( be%be4_eval_glo(1:nk) )
  53    allocate ( be%be5_eval_glo(1:1) )
  54
  55    allocate ( be%be1_evec_loc(1:nj,1:nk,1:nk))
  56    allocate ( be%be2_evec_loc(1:nj,1:nk,1:nk))
  57    allocate ( be%be3_evec_loc(1:nj,1:nk,1:nk))
  58    allocate ( be%be4_evec_loc(1:nj,1:nk,1:nk))
  59    allocate ( be%be5_evec_loc(1:nj,1: 1,1: 1))
  60
  61    allocate ( be%be1_evec_glo(1:nk,1:nk) )
  62    allocate ( be%be2_evec_glo(1:nk,1:nk) )
  63    allocate ( be%be3_evec_glo(1:nk,1:nk) )
  64    allocate ( be%be4_evec_glo(1:nk,1:nk) )
  65    allocate ( be%be5_evec_glo(1:1,1:1) )
  66
  67 ! 2.2.1 Control variable 1 (psi)
  68
  69    read(be_unit) be%variable(1)
  70    read(be_unit) be%nk, be%num_bins2d
  71    nk = be%nk
  72    read(be_unit)  be%be1_evec_glo
  73    read(be_unit)  be%be1_eval_glo
  74    allocate( be%evec_loc(1:nk,1:nk,1:be%num_bins2d) )
  75    allocate( be%eval_loc(1:nk,     1:be%num_bins2d) )
  76    read(be_unit)  be%evec_loc
  77    read(be_unit)  be%eval_loc
  78    if( be%variable(1)(1:3) /= 'psi') then
  79       print*,' Variable mismatch while transfering eigen values from BE file '
  80       print*,' Expected psi but got ',be%variable
  81       stop
  82    endif
  83    do j=1,nj
  84       b = be%bin2d(1,j)
  85       be%be1_evec_loc(j,1:nk,1:nk) = be%evec_loc(1:nk,1:nk,b)
  86       be%be1_eval_loc(j,1:nk     ) = be%eval_loc(1:nk,b)
  87    enddo
  88
  89 ! 2.2.2 Control variable 2 (chi_u)
  90    read(be_unit) be%variable(2)
  91    read(be_unit) be%nk, be%num_bins2d
  92    nk = be%nk
  93    read(be_unit)  be%be2_evec_glo
  94    read(be_unit)  be%be2_eval_glo
  95    read(be_unit)  be%evec_loc
  96    read(be_unit)  be%eval_loc
  97    if( be%variable(2)(1:5) /= 'chi_u') then
  98       print*,' Variable mismatch while transfering eigen values from BE file '
  99       print*,' Expected chi_u but got ',be%variable
 100       stop
 101    endif
 102    do j=1,nj
 103       b = be%bin2d(1,j)
 104       be%be2_evec_loc(j,1:nk,1:nk) = be%evec_loc(1:nk,1:nk,b)
 105       be%be2_eval_loc(j,1:nk     ) = be%eval_loc(1:nk,b)
 106    enddo
 107
 108 ! 2.2.3 Control variable 3 (t_u)
 109    read(be_unit) be%variable(3)
 110    read(be_unit) be%nk, be%num_bins2d
 111    nk = be%nk
 112    read(be_unit)  be%be3_evec_glo
 113    read(be_unit)  be%be3_eval_glo
 114    read(be_unit)  be%evec_loc
 115    read(be_unit)  be%eval_loc
 116    if( be%variable(3)(1:3) /= 't_u') then
 117       print*,' Variable mismatch while transfering eigen values from BE file '
 118       print*,' Expected t_u but got ',be%variable
 119       stop
 120    endif
 121    do j=1,nj
 122       b = be%bin2d(1,j)
 123       be%be3_evec_loc(j,1:nk,1:nk) = be%evec_loc(1:nk,1:nk,b)
 124       be%be3_eval_loc(j,1:nk     ) = be%eval_loc(1:nk,b)
 125    enddo
 126
 127 ! 2.2.4 Control variable 4 (q/qsg)
 128    read(be_unit) be%variable(4)
 129    read(be_unit) be%nk, be%num_bins2d
 130    nk = be%nk
 131    read(be_unit)  be%be4_evec_glo
 132    read(be_unit)  be%be4_eval_glo
 133    read(be_unit)  be%evec_loc
 134    read(be_unit)  be%eval_loc
 135    if( be%variable(4)(1:3) /= 'rh') then
 136       print*,' Variable mismatch while transfering eigen values from BE file '
 137       print*,' Expected rh but got ',be%variable
 138       stop
 139    endif
 140    do j=1,nj
 141       b = be%bin2d(1,j)
 142       be%be4_evec_loc(j,1:nk,1:nk) = be%evec_loc(1:nk,1:nk,b)
 143       be%be4_eval_loc(j,1:nk     ) = be%eval_loc(1:nk,b)
 144    enddo
 145
 146    deallocate ( be%evec_loc )
 147    deallocate ( be%eval_loc )
 148
 149 ! 2.2.5 Control variable ps_u
 150    read(be_unit) be%variable(5)
 151    read(be_unit) be%nk_2d, be%num_bins2d
 152    nk_2d = be%nk_2d
 153    allocate( be%evec_loc(1:nk_2d,1:nk_2d,1:be%num_bins2d) )
 154    allocate( be%eval_loc(1:nk_2d,        1:be%num_bins2d) )
 155    read(be_unit)  be%be5_evec_glo
 156    read(be_unit)  be%be5_eval_glo
 157    read(be_unit)  be%evec_loc
 158    read(be_unit)  be%eval_loc
 159    if( be%variable(5)(1:4) /= 'ps_u') then
 160       print*,' Variable mismatch while transfering eigen values from BE file '
 161       print*,' Expected ps_u but got ',be%variable
 162       stop
 163    endif
 164    do j=1,nj
 165       b = be%bin2d(1,j)
 166       be%be5_evec_loc(j,1:nk_2d,1:nk_2d) = be%evec_loc(1:nk_2d,1:nk_2d,b)
 167       be%be5_eval_loc(j,1:nk_2d    )     = be%eval_loc(1:nk_2d,b)
 168    enddo
 169
 170    deallocate ( be%evec_loc )
 171    deallocate ( be%eval_loc )
 172
 173
 174 ! 5.0 Load the scale lengths
 175 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~
 176
 177 ! 5.1 Allocate the array for scale lengths
 178
 179    allocate ( be%be1_rf_lengthscale(1:nk) )
 180    allocate ( be%be2_rf_lengthscale(1:nk) )
 181    allocate ( be%be3_rf_lengthscale(1:nk) )
 182    allocate ( be%be4_rf_lengthscale(1:nk) )
 183    allocate ( be%be5_rf_lengthscale(1:nk) )
 184
 185 ! 5.2 read in the scale lengths
 186
 187    read(be_unit) be%variable(1)
 188    read(be_unit) be%be1_rf_lengthscale
 189
 190    read(be_unit) be%variable(2)
 191    read(be_unit) be%be2_rf_lengthscale
 192
 193    read(be_unit) be%variable(3)
 194    read(be_unit) be%be3_rf_lengthscale
 195
 196    read(be_unit) be%variable(4)
 197    read(be_unit) be%be4_rf_lengthscale
 198
 199    read(be_unit) be%variable(5)
 200    read(be_unit) be%be5_rf_lengthscale(1:1)
 201
 202 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! FOR TESTING PURPOSES !!!!!!!!!!!!!!!!!!!!!!!
 203    allocate(be%znu(39))
 204    be%znu = (/ 0.9965, 0.988, 0.9765, 0.962, 0.944, 0.9215, 0.8945, 0.8613333, 0.824, &
 205     0.7866668, 0.7493334, 0.6973798, 0.6332842, 0.5739912, 0.5192013,                &
 206     0.4686304, 0.4220099, 0.3790851, 0.3396154, 0.3033731, 0.2701429,                &
 207     0.2397217, 0.2119173, 0.1865487, 0.1634448, 0.1424445, 0.123396,                 &
 208     0.106156, 0.09059004, 0.07657114, 0.06397995, 0.05270405, 0.04263748,            &
 209     0.03368013, 0.02573696, 0.0187168, 0.01253016, 0.007084141, 0.002267124 /)
 210    be%ptop = 1000.
 211    be%psfc = 101300.
 212
 213    close(be_unit)
 214
 215 end subroutine rd_be_cv_5