var/convertor/kma_netcdf/module_netcdf2kma_interface.f90

   1 MODULE module_netcdf2kma_interface
   2
   3    use module_wave2grid_kma
   4 !  implicit none
   5
   6 CONTAINS
   7
   8 SUBROUTINE netcdf2kma_interface ( grid, config_flags )
   9
  10    USE module_domain
  11    USE module_timing
  12    USE module_driver_constants
  13    USE module_configure
  14
  15 !  IMPLICIT NONE
  16    real,allocatable    :: DPSE(:,:),DUE(:,:,:),DVE(:,:,:),DTE(:,:,:),DQE(:,:,:)
  17    real,allocatable    :: PSB (:,:), UB(:,:,:), VB(:,:,:), TB(:,:,:), QB(:,:,:)
  18    real,allocatable    :: PSG (:,:), UG(:,:,:), VG(:,:,:), TG(:,:,:), QG(:,:,:)
  19    integer :: i,j,k      !shcimsi
  20    real,allocatable    :: dum(:,:,:)  !shcimsi
  21
  22 !--Input data.
  23
  24    TYPE(domain) , INTENT(INOUT)  :: grid
  25    TYPE (grid_config_rec_type)   :: config_flags
  26    integer                       :: USE_INCREMENT      !shc
  27    integer     :: incre,back,ID(5),KT,IM,JM,KM         !shc
  28    integer     :: IMAXE,JMAXE,IMAX,JMAX,KMAX,IDIM,JDIM,MEND1,ISST,JSST,ISNW,JSNW,MAXJZ,IVAR
  29    integer :: JMAXHF, MNWAV, IMX
  30
  31 ! we have to convert in equal lat/lon data
  32 !           to Gaussian latitude
  33 !
  34 !   First the Equal lat/lon data
  35 ! set Field as per KMA order (North top South and 0 to 360 east)
  36
  37    NAMELIST /netcdf2kma_parm/ IMAXE,JMAXE,IMAX,JMAX,KMAX,IDIM,JDIM,MEND1,ISST,JSST,ISNW,JSNW,MAXJZ,IVAR
  38 !
  39       READ  (111, NML = netcdf2kma_parm, ERR = 8000)
  40       close (111)
  41       print*,' netcdf2kma_parm namelist data read are as follows:'
  42       print*,' IMAXE= ',IMAXE
  43       print*,' JMAXE= ',JMAXE
  44       print*,' MEND1= ',MEND1
  45       print*,' ISST = ',ISST
  46       print*,' JSST = ',JSST
  47       print*,' MAXJZ= ',MAXJZ
  48       print*,' IVAR = ',IVAR
  49
  50       JMAXHF=JMAX/2
  51       MNWAV=MEND1*(MEND1+1)/2
  52       IMX=IMAX+2
  53
  54    allocate(DPSE(imaxe,jmaxe))
  55    allocate(DUE(imaxe,jmaxe,kmax),DVE(imaxe,jmaxe,kmax))
  56    allocate(DTE(imaxe,jmaxe,kmax),DQE(imaxe,jmaxe,kmax))
  57    allocate(PSB(imax,jmax))
  58    allocate(UB(imax,jmax,kmax),VB(imax,jmax,kmax))
  59    allocate(TB(imax,jmax,kmax),QB(imax,jmax,kmax))
  60    allocate(PSG(imax,jmax))
  61    allocate(UG(imax,jmax,kmax),VG(imax,jmax,kmax))
  62    allocate(TG(imax,jmax,kmax),QG(imax,jmax,kmax))
  63    allocate(dum(imax,jmax,kmax))  !shcimsi
  64
  65 !shc-wei start
  66 !  back = 102                    !shc start
  67    back = 48                     !shc start
  68 !shc-wei end
  69    read(back) ID,KT,IM,JM,KM
  70    read(back)       !topo
  71    read(back) PSB
  72    read(back)       !psea
  73    read(back) TB
  74    read(back) UB
  75    read(back) VB
  76    read(back) QB
  77    read(back)       !rh
  78    read(back)       !z           !shc end
  79    USE_INCREMENT=1     !shc start
  80    if (USE_INCREMENT.eq.1) then
  81 !shc-wei start
  82 !  incre = 101
  83    incre = 47
  84 !shc-wei end
  85    read(incre) DPSE
  86    read(incre) DUE
  87    read(incre) DVE
  88    read(incre) DTE
  89    read(incre) DQE     !shc end
  90 !  DPSE=20.0; DUE=3.0; DVE=3.0; DTE=5.0;  DQE=0.001    !shcimsi
  91 !  imaxe=grid%ed31-grid%sd31                    !shc start
  92 !  jmaxe=grid%ed32-grid%sd32
  93 !  kmaxe=grid%ed33-grid%sd33
  94 !  imaxg=imaxe;  jmaxg=jmaxe-1; kmaxg=kmaxe
  95    call reorder_for_kma(DPSE,imaxe,jmaxe,1)
  96    call reorder_for_kma(DUE,imaxe,jmaxe,kmax)
  97    call reorder_for_kma(DVE,imaxe,jmaxe,kmax)
  98    call reorder_for_kma(DTE,imaxe,jmaxe,kmax)
  99    call reorder_for_kma(DQE,imaxe,jmaxe,kmax)  !shc end
 100    DPSE=DPSE*0.01                              !shchPa
 101    call Einc_to_Ganl(DPSE,DUE,DVE,DTE,DQE,&    !shc start
 102                       PSB, UB, VB, TB, QB,&
 103                       PSG, UG, VG, TG, QG,&
 104                       IMAX,JMAX,IMAXE,JMAXE,KMAX,MAXJZ)
 105 9001 format(10e15.7)     !shcimsi start
 106 !modified by shc nk start
 107 !modified by shc nk end
 108
 109    call PREGSM1(PSG,TG,UG,VG,QG,PSB,TB,UB,VB,QB,IMAXE,JMAXE,ISST,JSST,MAXJZ,IVAR, &
 110                 IMAX,JMAX,KMAX,IDIM,JDIM,MEND1,MEND1,MEND1,ISNW,JSNW,JMAXHF,MNWAV,IMX ) !shc end
 111
 112    else          !shc
 113
 114    call reorder_for_kma(grid%ht(grid%sd31:grid%ed31-1,grid%sd32:grid%ed32-1),&
 115                          grid%ed31-grid%sd31  ,grid%ed32-grid%sd32,1)
 116    call reorder_for_kma(grid%psfc(grid%sd31:grid%ed31-1,grid%sd32:grid%ed32-1),&
 117                            grid%ed31-grid%sd31  ,grid%ed32-grid%sd32,1)
 118    call reorder_for_kma(grid%u_2(grid%sd31:grid%ed31-1,grid%sd32:grid%ed32-1,&
 119                              grid%sd33:grid%ed33-1),&
 120                              grid%ed31-grid%sd31  ,grid%ed32-grid%sd32   ,&
 121                              grid%ed33-grid%sd33)
 122    call reorder_for_kma(grid%v_2(grid%sd31:grid%ed31-1,grid%sd32:grid%ed32-1,&
 123                              grid%sd33:grid%ed33-1),&
 124                              grid%ed31-grid%sd31  ,grid%ed32-grid%sd32   ,&
 125                              grid%ed33-grid%sd33)
 126    call reorder_for_kma(grid%t_2(grid%sd31:grid%ed31-1,grid%sd32:grid%ed32-1,&
 127                              grid%sd33:grid%ed33-1),&
 128                              grid%ed31-grid%sd31  ,grid%ed32-grid%sd32   ,&
 129                              grid%ed33-grid%sd33)
 130    call reorder_for_kma(grid%moist(grid%sd31:grid%ed31-1,grid%sd32:grid%ed32-1,&
 131                              grid%sd33:grid%ed33-1,P_qv:P_qv),&
 132                              grid%ed31-grid%sd31  ,grid%ed32-grid%sd32   ,&
 133                              grid%ed33-grid%sd33)
 134 !
 135 ! convert xb-psfc pressure in hPa
 136   grid%psfc(grid%sd31:grid%ed31-1,grid%sd32:grid%ed32-1) = 0.01 *  &
 137   grid%psfc(grid%sd31:grid%ed31-1,grid%sd32:grid%ed32-1)
 138   write(*,*) 'shcimsi num of gird',grid%ed31,grid%ed32,grid%ed33
 139   write(*,*) 'shcimsi grid',grid%ed31-grid%sd31,grid%ed32-grid%sd32,&
 140              grid%ed33-grid%sd33
 141
 142   CALL PREGSM(grid%psfc(grid%sd31:grid%ed31-1,grid%sd32:grid%ed32-1),&
 143         grid%t_2(grid%sd31:grid%ed31-1,grid%sd32:grid%ed32-1,grid%sd33:grid%ed33-1),&
 144         grid%u_2(grid%sd31:grid%ed31-1,grid%sd32:grid%ed32-1,grid%sd33:grid%ed33-1),&
 145         grid%v_2(grid%sd31:grid%ed31-1,grid%sd32:grid%ed32-1,grid%sd33:grid%ed33-1),&
 146     grid%moist(grid%sd31:grid%ed31-1,grid%sd32:grid%ed32-1,grid%sd33:grid%ed33-1,P_qv),&                   !shc
 147     PSB,TB,UB,VB,QB,IMAXE,JMAXE,ISST,JSST,MAXJZ,IVAR, &
 148                 IMAX,JMAX,KMAX,IDIM,JDIM,MEND1,MEND1,MEND1,ISNW,JSNW,JMAXHF,MNWAV,IMX)         !shc
 149
 150     endif         !shc
 151
 152    deallocate(DPSE,DUE,DVE,DTE,DQE)
 153    deallocate(PSB , UB, VB, TB, QB)
 154    deallocate(PSG , UG, VG, TG, QG, dum)
 155
 156 8000  print*,' read error on namelist unit 111'
 157       stop
 158
 159 END SUBROUTINE netcdf2kma_interface
 160
 161
 162 SUBROUTINE reorder_for_kma(wrf,n1,n2,n3)
 163
 164 !IMPLICIT none
 165  integer, intent(in) :: n1,n2,n3
 166  real, intent(inout) :: wrf(n1,n2,n3)
 167
 168  real, dimension(n1,n2,n3)   :: kma
 169  integer                     :: i,j,k, n1half
 170 !
 171     n1half = n1/2 + 0.5
 172     do k=1,n3
 173       do j= 1,n2
 174         do i=1,n1
 175          if( i <= n1half)then
 176          kma(n1half+i,n2-j+1,k) = wrf(i,j,k)
 177          else
 178          kma(i-n1half,n2-j+1,k) = wrf(i,j,k)
 179          end if
 180         end do
 181       end do
 182     end do
 183       wrf = kma
 184 END SUBROUTINE reorder_for_kma
 185
 186 END MODULE module_netcdf2kma_interface
 187