phys/module_bl_gwdo.F

   1 !=================================================================================================================
   2  module module_bl_gwdo
   3  use ccpp_kind_types,only: kind_phys
   4
   5  use bl_gwdo,only: bl_gwdo_run
   6
   7
   8  implicit none
   9  private
  10  public:: gwdo
  11
  12
  13  contains
  14
  15
  16 !=================================================================================================================
  17  subroutine gwdo(u3d,v3d,t3d,qv3d,p3d,p3di,pi3d,z,                            &
  18                  rublten,rvblten,                                             &
  19                  dtaux3d,dtauy3d,dusfcg,dvsfcg,                               &
  20                  var2d,oc12d,oa2d1,oa2d2,oa2d3,oa2d4,ol2d1,ol2d2,ol2d3,ol2d4, &
  21                  sina,cosa,znu,znw,p_top,                                     &
  22                  cp,g,rd,rv,ep1,pi,                                           &
  23                  dt,dx,kpbl2d,itimestep,                                      &
  24                  ids,ide, jds,jde, kds,kde,                                   &
  25                  ims,ime, jms,jme, kms,kme,                                   &
  26                  its,ite, jts,jte, kts,kte,                                   &
  27                  errmsg,errflg                                                &
  28                 )
  29 !=================================================================================================================
  30 !
  31 !-- u3d         3d u-velocity interpolated to theta points (m/s)
  32 !-- v3d         3d v-velocity interpolated to theta points (m/s)
  33 !-- t3d         temperature (k)
  34 !-- qv3d        3d water vapor mixing ratio (kg/kg)
  35 !-- p3d         3d pressure (pa)
  36 !-- p3di        3d pressure (pa) at interface level
  37 !-- pi3d        3d exner function (dimensionless)
  38 !-- rublten     u tendency due to pbl parameterization (m/s/s)
  39 !-- rvblten     v tendency due to pbl parameterization (m/s/s)
  40 !-- sina        sine rotation angle
  41 !-- cosa        cosine rotation angle
  42 !-- znu         eta values (sigma values)
  43 !-- cp          heat capacity at constant pressure for dry air (j/kg/k)
  44 !-- g           acceleration due to gravity (m/s^2)
  45 !-- rd          gas constant for dry air (j/kg/k)
  46 !-- z           height above sea level (m)
  47 !-- rv          gas constant for water vapor (j/kg/k)
  48 !-- dt          time step (s)
  49 !-- dx          model grid interval (m)
  50 !-- ep1         constant for virtual temperature (r_v/r_d - 1) (dimensionless)
  51 !-- ids         start index for i in domain
  52 !-- ide         end index for i in domain
  53 !-- jds         start index for j in domain
  54 !-- jde         end index for j in domain
  55 !-- kds         start index for k in domain
  56 !-- kde         end index for k in domain
  57 !-- ims         start index for i in memory
  58 !-- ime         end index for i in memory
  59 !-- jms         start index for j in memory
  60 !-- jme         end index for j in memory
  61 !-- kms         start index for k in memory
  62 !-- kme         end index for k in memory
  63 !-- its         start index for i in tile
  64 !-- ite         end index for i in tile
  65 !-- jts         start index for j in tile
  66 !-- jte         end index for j in tile
  67 !-- kts         start index for k in tile
  68 !-- kte         end index for k in tile
  69 !
  70 !=================================================================================================================
  71
  72 !--- input arguments:
  73  integer,intent(in):: ids,ide,jds,jde,kds,kde, &
  74                       ims,ime,jms,jme,kms,kme, &
  75                       its,ite,jts,jte,kts,kte
  76  integer,intent(in):: itimestep
  77
  78  integer,intent(in),dimension(ims:ime,jms:jme):: kpbl2d
  79
  80  real(kind=kind_phys),intent(in):: dt,cp,g,rd,rv,ep1,pi
  81  real(kind=kind_phys),intent(in),optional:: p_top
  82
  83  real(kind=kind_phys),intent(in),dimension(kms:kme),optional:: &
  84                                                                  znu, &
  85                                                                  znw
  86
  87  real(kind=kind_phys),intent(in),dimension(ims:ime,jms:jme):: &
  88                                                                   dx, &
  89                                                                var2d, &
  90                                                                oc12d, &
  91                                              oa2d1,oa2d2,oa2d3,oa2d4, &
  92                                              ol2d1,ol2d2,ol2d3,ol2d4, &
  93                                                            sina,cosa
  94
  95  real(kind=kind_phys),intent(in),dimension(ims:ime,kms:kme,jms:jme):: &
  96                                                                 qv3d, &
  97                                                                  p3d, &
  98                                                                 pi3d, &
  99                                                                  t3d, &
 100                                                                  u3d, &
 101                                                                  v3d, &
 102                                                                    z
 103
 104  real(kind=kind_phys),intent(in),dimension(ims:ime,kms:kme,jms:jme):: &
 105                                                                  p3di
 106
 107 !--- output arguments:
 108  character(len=*),intent(out)::  errmsg
 109
 110  integer,intent(out):: errflg
 111
 112  real(kind=kind_phys),intent(out),dimension(ims:ime,jms:jme):: &
 113                                                               dusfcg, &
 114                                                               dvsfcg
 115
 116  real(kind=kind_phys),intent(out),dimension(ims:ime,kms:kme,jms:jme ):: &
 117                                                              dtaux3d, &
 118                                                              dtauy3d
 119
 120 !--- inout arguments:
 121  real(kind=kind_phys),intent(inout),dimension(ims:ime,kms:kme,jms:jme):: &
 122                                                              rublten, &
 123                                                              rvblten
 124
 125 !--- local variables and arrays:
 126  integer:: i,j,k
 127
 128  real(kind=kind_phys),dimension(its:ite):: &
 129     var2d_hv,oc12d_hv,dx_hv,sina_hv,cosa_hv
 130  real(kind=kind_phys),dimension(its:ite):: &
 131     oa2d1_hv,oa2d2_hv,oa2d3_hv,oa2d4_hv,ol2d1_hv,ol2d2_hv,ol2d3_hv,ol2d4_hv
 132  real(kind=kind_phys),dimension(its:ite):: &
 133     dusfcg_hv,dvsfcg_hv
 134
 135  real(kind=kind_phys),dimension(its:ite,kts:kte):: &
 136      u3d_hv,v3d_hv,t3d_hv,qv3d_hv,pi3d_hv,p3d_hv,z_hv
 137
 138  real(kind=kind_phys),dimension(its:ite,kts:kte):: &
 139      rublten_hv,rvblten_hv,dtaux3d_hv,dtauy3d_hv
 140
 141  real(kind=kind_phys),dimension(its:ite,kms:kme):: &
 142      p3di_hv
 143
 144 !-----------------------------------------------------------------------------------------------------------------
 145
 146 !  Outer j-loop. Allows consistency between WRF and MPAS in the driver.
 147
 148  do j = jts,jte
 149
 150     !  All variables for gwdo2d are tile-sized and have only a single
 151     !  horizontal dimension. The _hv suffix refers to "horizontal vertical",
 152     !  a reminder that there is a single horizontal index. Yes, we know that
 153     !  variables that have only a horizontal index are not *really* _hv.
 154
 155     !  All of the following 3d and 2d variables are declared intent(in) in the
 156     !  gwdo2d subroutine, so there is no need to put the updated values back
 157     !  from the temporary arrays back into the original arrays.
 158
 159     !  Variables that are INTENT(IN) or INTENT(INOUT)
 160
 161     !  3d, interface levels:
 162     do k = kts,kte+1
 163        do i = its,ite
 164           p3di_hv(i,k) = p3di(i,k,j)
 165        enddo
 166     enddo
 167
 168     !  3d, layers:
 169     do k = kts,kte
 170        do i = its,ite
 171           rublten_hv(i,k) = rublten(i,k,j)
 172           rvblten_hv(i,k) = rvblten(i,k,j)
 173               u3d_hv(i,k) =     u3d(i,k,j)
 174               v3d_hv(i,k) =     v3d(i,k,j)
 175               t3d_hv(i,k) =     t3d(i,k,j)
 176              qv3d_hv(i,k) =    qv3d(i,k,j)
 177               p3d_hv(i,k) =     p3d(i,k,j)
 178              pi3d_hv(i,k) =    pi3d(i,k,j)
 179                 z_hv(i,k) =       z(i,k,j)
 180        enddo
 181     enddo
 182
 183     !  2d:
 184     do i = its,ite
 185           dx_hv(i) =    dx(i,j)
 186        var2d_hv(i) = var2d(i,j)
 187        oc12d_hv(i) = oc12d(i,j)
 188         sina_hv(i) =  sina(i,j)
 189         cosa_hv(i) =  cosa(i,j)
 190        oa2d1_hv(i) = oa2d1(i,j)
 191        oa2d2_hv(i) = oa2d2(i,j)
 192        oa2d3_hv(i) = oa2d3(i,j)
 193        oa2d4_hv(i) = oa2d4(i,j)
 194        ol2d1_hv(i) = ol2d1(i,j)
 195        ol2d2_hv(i) = ol2d2(i,j)
 196        ol2d3_hv(i) = ol2d3(i,j)
 197        ol2d4_hv(i) = ol2d4(i,j)
 198     enddo
 199
 200     call bl_gwdo_run(sina=sina_hv,cosa=cosa_hv                &
 201                     ,rublten=rublten_hv,rvblten=rvblten_hv    &
 202                     ,dtaux3d=dtaux3d_hv,dtauy3d=dtauy3d_hv    &
 203                     ,dusfcg=dusfcg_hv,dvsfcg=dvsfcg_hv        &
 204                     ,uproj=u3d_hv,vproj=v3d_hv                &
 205                     ,t1=t3d_hv,q1=qv3d_hv                     &
 206                     ,prsi=p3di_hv                             &
 207                     ,prsl=p3d_hv,prslk=pi3d_hv                &
 208                     ,zl=z_hv                                  &
 209                     ,var=var2d_hv,oc1=oc12d_hv                &
 210                     ,oa2d1=oa2d1_hv, oa2d2=oa2d2_hv           &
 211                     ,oa2d3=oa2d3_hv, oa2d4=oa2d4_hv           &
 212                     ,ol2d1=ol2d1_hv, ol2d2=ol2d2_hv           &
 213                     ,ol2d3=ol2d3_hv, ol2d4=ol2d4_hv           &
 214                     ,g_=g,cp_=cp,rd_=rd,rv_=rv,fv_=ep1,pi_=pi &
 215                     ,dxmeter=dx_hv,deltim=dt                  &
 216                     ,its=its,ite=ite,kte=kte,kme=kte+1        &
 217                     ,errmsg=errmsg,errflg=errflg)
 218
 219     !  Variables that are INTENT(OUT) or INTENT(INOUT):
 220
 221     !  3d, layers:
 222     do k = kts,kte
 223        do i = its,ite
 224           rublten(i,k,j) = rublten_hv(i,k)
 225           rvblten(i,k,j) = rvblten_hv(i,k)
 226           dtaux3d(i,k,j) = dtaux3d_hv(i,k)
 227           dtauy3d(i,k,j) = dtauy3d_hv(i,k)
 228        enddo
 229     enddo
 230
 231     !  2d:
 232     do i = its,ite
 233        dusfcg(i,j) = dusfcg_hv(i)
 234        dvsfcg(i,j) = dvsfcg_hv(i)
 235     enddo
 236
 237  enddo ! Outer J-loop
 238
 239  end subroutine gwdo
 240
 241 !=================================================================================================================
 242 end module module_bl_gwdo
 243 !=================================================================================================================