wrfv2_fire/phys/module_fddagd_driver.F

   1 !WRF:MEDIATION_LAYER:PHYSICS
   2 !
   3
   4 MODULE module_fddagd_driver
   5 CONTAINS
   6
   7 !------------------------------------------------------------------
   8    SUBROUTINE fddagd_driver(itimestep,dt,xtime,                   &
   9                   id,  &
  10                   RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN,                 &
  11                   RPHNDGDTEN,RQVNDGDTEN,RMUNDGDTEN,               &
  12                   u_ndg_old,v_ndg_old,t_ndg_old,ph_ndg_old,       &
  13                   q_ndg_old,mu_ndg_old,       &
  14                   u_ndg_new,v_ndg_new,t_ndg_new,ph_ndg_new,       &
  15                   q_ndg_new,mu_ndg_new,       &
  16                   u3d,v3d,th_phy,ph,rho,moist,                    &
  17                   p_phy,pi_phy,p8w,t_phy,dz8w,z,z_at_w,           &
  18                   grid,config_flags,DX,n_moist,                   &
  19                   STEPFG,                                         &
  20                   pblh,ht,regime,znt,                             &
  21                   ids,ide, jds,jde, kds,kde,                      &
  22                   ims,ime, jms,jme, kms,kme,                      &
  23                   i_start,i_end, j_start,j_end, kts,kte, num_tiles, &
  24                   u10, v10, th2, q2, &
  25                   u10_ndg_old, v10_ndg_old, t2_ndg_old, th2_ndg_old, q2_ndg_old,  &
  26                   rh_ndg_old, psl_ndg_old, ps_ndg_old, tob_ndg_old, odis_ndg_old, &
  27                   u10_ndg_new, v10_ndg_new, t2_ndg_new, th2_ndg_new, q2_ndg_new,  &
  28                   rh_ndg_new, psl_ndg_new, ps_ndg_new, tob_ndg_new, odis_ndg_new, &
  29                   ips,ipe,jps,jpe,kps,kpe,                          &
  30                   imsx,imex,jmsx,jmex,kmsx,kmex,                    &
  31                   ipsx,ipex,jpsx,jpex,kpsx,kpex,                    &
  32                   imsy,imey,jmsy,jmey,kmsy,kmey,                    &
  33                   ipsy,ipey,jpsy,jpey,kpsy,kpey                     )
  34 !------------------------------------------------------------------
  35    USE module_configure
  36    USE module_state_description
  37    USE module_model_constants
  38    USE module_domain, ONLY : domain
  39
  40 ! *** add new modules of schemes here
  41
  42    USE module_fdda_psufddagd
  43    USE module_fdda_spnudging
  44
  45 !------------------------------------------------------------------
  46    IMPLICIT NONE
  47 !======================================================================
  48 ! Grid structure in physics part of WRF
  49 !----------------------------------------------------------------------
  50 ! The horizontal velocities used in the physics are unstaggered
  51 ! relative to temperature/moisture variables. All predicted
  52 ! variables are carried at half levels except w, which is at full
  53 ! levels. Some arrays with names (*8w) are at w (full) levels.
  54 !
  55 !----------------------------------------------------------------------
  56 ! In WRF, kms (smallest number) is the bottom level and kme (largest
  57 ! number) is the top level.  In your scheme, if 1 is at the top level,
  58 ! then you have to reverse the order in the k direction.
  59 !
  60 !         kme      -   half level (no data at this level)
  61 !         kme    ----- full level
  62 !         kme-1    -   half level
  63 !         kme-1  ----- full level
  64 !         .
  65 !         .
  66 !         .
  67 !         kms+2    -   half level
  68 !         kms+2  ----- full level
  69 !         kms+1    -   half level
  70 !         kms+1  ----- full level
  71 !         kms      -   half level
  72 !         kms    ----- full level
  73 !
  74 !======================================================================
  75 !-- RUNDGDTEN       U tendency due to
  76 !                 FDDA analysis nudging (m/s^2)
  77 !-- RVNDGDTEN       V tendency due to
  78 !                 FDDA analysis nudging (m/s^2)
  79 !-- RTHNDGDTEN      Theta tendency due to
  80 !                 FDDA analysis nudging (K/s)
  81 !-- RPHNDGDTEN      Geopotential tendency due to
  82 !                 FDDA analysis nudging (m^2/s^3)
  83 !-- RQVNDGDTEN      Qv tendency due to
  84 !                 FDDA analysis nudging (kg/kg/s)
  85 !-- RMUNDGDTEN      mu tendency due to
  86 !                 FDDA analysis nudging (Pa/s)
  87 !-- itimestep     number of time steps
  88 !-- u3d           u-velocity staggered on u points (m/s)
  89 !-- v3d           v-velocity staggered on v points (m/s)
  90 !-- th_phy        potential temperature (K)
  91 !-- moist         moisture array (4D - last index is species) (kg/kg)
  92 !-- p_phy         pressure (Pa)
  93 !-- pi_phy        exner function (dimensionless)
  94 !-- p8w           pressure at full levels (Pa)
  95 !-- t_phy         temperature (K)
  96 !-- dz8w          dz between full levels (m)
  97 !-- z             height above sea level (m)
  98 !-- config_flags
  99 !-- DX            horizontal space interval (m)
 100 !-- DT            time step (second)
 101 !-- n_moist       number of moisture species
 102 !-- STEPFG        number of timesteps per FDDA re-calculation
 103 !-- KPBL          k-index of PBL top
 104 !-- ids           start index for i in domain
 105 !-- ide           end index for i in domain
 106 !-- jds           start index for j in domain
 107 !-- jde           end index for j in domain
 108 !-- kds           start index for k in domain
 109 !-- kde           end index for k in domain
 110 !-- ims           start index for i in memory
 111 !-- ime           end index for i in memory
 112 !-- jms           start index for j in memory
 113 !-- jme           end index for j in memory
 114 !-- kms           start index for k in memory
 115 !-- kme           end index for k in memory
 116 !-- jts           start index for j in tile
 117 !-- jte           end index for j in tile
 118 !-- kts           start index for k in tile
 119 !-- kte           end index for k in tile
 120 !
 121 !******************************************************************
 122 !------------------------------------------------------------------
 123    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 124    TYPE(domain) , TARGET          :: grid
 125 !
 126
 127    INTEGER , INTENT(IN)         ::     id
 128
 129    INTEGER,    INTENT(IN   )    ::     ids,ide, jds,jde, kds,kde, &
 130                                        ims,ime, jms,jme, kms,kme, &
 131                                        kts,kte, num_tiles,        &
 132                                        ips,ipe,jps,jpe,kps,kpe,   &
 133                                        imsx,imex,jmsx,jmex,kmsx,kmex,   &
 134                                        ipsx,ipex,jpsx,jpex,kpsx,kpex,   &
 135                                        imsy,imey,jmsy,jmey,kmsy,kmey,   &
 136                                        ipsy,ipey,jpsy,jpey,kpsy,kpey,   &
 137                                        n_moist
 138
 139    INTEGER, DIMENSION(num_tiles), INTENT(IN) ::                   &
 140   &                                    i_start,i_end,j_start,j_end
 141
 142    INTEGER,    INTENT(IN   )    ::     itimestep,STEPFG
 143 !
 144    REAL,       INTENT(IN   )    ::     DT,DX,XTIME
 145
 146
 147 !
 148    REAL,       DIMENSION( ims:ime, kms:kme, jms:jme ),            &
 149                INTENT(IN   )    ::                         p_phy, &
 150                                                           pi_phy, &
 151                                                              p8w, &
 152                                                              rho, &
 153                                                            t_phy, &
 154                                                              u3d, &
 155                                                              v3d, &
 156                                                               ph, &
 157                                                             dz8w, &
 158                                                                z, &
 159                                                           z_at_w, &
 160                                                           th_phy
 161 !
 162    REAL, DIMENSION( ims:ime, kms:kme, jms:jme, n_moist ),         &
 163          INTENT(IN ) ::                                    moist
 164 !
 165 !
 166 !
 167    REAL,       DIMENSION( ims:ime, kms:kme, jms:jme ),            &
 168                INTENT(INOUT)    ::                       RUNDGDTEN, &
 169                                                          RVNDGDTEN, &
 170                                                         RTHNDGDTEN, &
 171                                                         RPHNDGDTEN, &
 172                                                         RQVNDGDTEN
 173
 174    REAL,       DIMENSION( ims:ime,  jms:jme ),            &
 175                INTENT(INOUT)    ::                      RMUNDGDTEN
 176
 177    REAL,       DIMENSION( ims:ime, kms:kme, jms:jme ),            &
 178                INTENT(INOUT)    ::                       u_ndg_old, &
 179                                                          v_ndg_old, &
 180                                                          t_ndg_old, &
 181                                                          ph_ndg_old,&
 182                                                          q_ndg_old, &
 183                                                          u_ndg_new, &
 184                                                          v_ndg_new, &
 185                                                          t_ndg_new, &
 186                                                          ph_ndg_new,&
 187                                                          q_ndg_new
 188    REAL,       DIMENSION( ims:ime,  jms:jme ),            &
 189                INTENT(INOUT)    ::                       mu_ndg_old, &
 190                                                          mu_ndg_new
 191
 192 !
 193    REAL,    DIMENSION( ims:ime , jms:jme ),     &
 194                INTENT(IN   ) ::           pblh, &
 195                                             ht, &
 196                                            znt
 197
 198    REAL,    DIMENSION( ims:ime , jms:jme ), INTENT(INOUT   ) :: regime
 199
 200    REAL,       DIMENSION( ims:ime, jms:jme ),            &
 201                INTENT(IN   )    ::                       u10, &
 202                                                          v10, &
 203                                                          th2, &
 204                                                          q2
 205
 206    REAL,       DIMENSION( ims:ime, jms:jme ),            &
 207                INTENT(IN)       ::                       u10_ndg_old,  &
 208                                                          v10_ndg_old,  &
 209                                                          t2_ndg_old,   &
 210                                                          th2_ndg_old,  &
 211                                                          q2_ndg_old,   &
 212                                                          rh_ndg_old,   &
 213                                                          psl_ndg_old,  &
 214                                                          ps_ndg_old,   &
 215                                                          odis_ndg_old,  &
 216                                                          u10_ndg_new,  &
 217                                                          v10_ndg_new,  &
 218                                                          t2_ndg_new,   &
 219                                                          th2_ndg_new,  &
 220                                                          q2_ndg_new,   &
 221                                                          rh_ndg_new,   &
 222                                                          psl_ndg_new,  &
 223                                                          ps_ndg_new,   &
 224                                                          odis_ndg_new
 225
 226    REAL,       DIMENSION( ims:ime, jms:jme ),            &
 227                INTENT(IN)       ::                       tob_ndg_old,  &
 228                                                          tob_ndg_new
 229
 230 !  LOCAL  VAR
 231
 232 !
 233    INTEGER :: i,J,K,NK,jj,ij
 234    CHARACTER (LEN=256) :: message
 235
 236 !------------------------------------------------------------------
 237 !
 238 #if  ! ( NMM_CORE == 1 )
 239   if (config_flags%grid_fdda .eq. 0 .AND. config_flags%grid_sfdda .eq. 0) return
 240
 241   IF (itimestep == 1) THEN
 242
 243    IF( config_flags%grid_fdda .eq. 1 ) THEN
 244    !$OMP PARALLEL DO   &
 245    !$OMP PRIVATE ( ij,i,j,k )
 246    DO ij = 1 , num_tiles
 247       DO j=j_start(ij),j_end(ij)
 248       DO i=i_start(ij),i_end(ij)
 249
 250          DO k=kts,min(kte+1,kde)
 251             u_ndg_old(i,k,j) = u3d(i,k,j)
 252             v_ndg_old(i,k,j) = v3d(i,k,j)
 253             t_ndg_old(i,k,j) = th_phy(i,k,j) - 300.0
 254             ph_ndg_old(i,k,j) = ph(i,k,j)
 255             q_ndg_old(i,k,j) = moist(i,k,j,P_QV)
 256          ENDDO
 257          mu_ndg_old(i,j) = 0.0
 258
 259       ENDDO
 260       ENDDO
 261
 262    ENDDO
 263
 264 !  IF( config_flags%grid_sfdda .eq. 1 ) THEN
 265 !    DO ij = 1 , num_tiles
 266 !       DO j=j_start(ij),j_end(ij)
 267 !       DO i=i_start(ij),i_end(ij)
 268 !             u10_ndg_old(i,j) = u10(i,j)
 269 !             v10_ndg_old(i,j) = v10(i,j)
 270 !             th2_ndg_old(i,j) = th2(i,j) - 300.0
 271 !              q2_ndg_old(i,j) = q2(i,j)
 272 !       ENDDO
 273 !       ENDDO
 274
 275 !    ENDDO
 276 !  ENDIF
 277    !$OMP END PARALLEL DO
 278
 279    ENDIF
 280   ENDIF
 281
 282 !GMM if fgdtzero = 1, tendencies are zero in between calls
 283
 284   IF (mod(itimestep-1,STEPFG) .eq. 0 .and. config_flags%fgdtzero .eq. 1) THEN
 285
 286    !$OMP PARALLEL DO   &
 287    !$OMP PRIVATE ( ij,i,j,k )
 288    DO ij = 1 , num_tiles
 289       DO j=j_start(ij),j_end(ij)
 290       DO i=i_start(ij),i_end(ij)
 291
 292          DO k=kts,min(kte+1,kde)
 293             RTHNDGDTEN(I,K,J)=0.
 294             RUNDGDTEN(I,K,J)=0.
 295             RVNDGDTEN(I,K,J)=0.
 296             RPHNDGDTEN(I,K,J)=0.
 297             RQVNDGDTEN(I,K,J)=0.
 298          ENDDO
 299
 300          RMUNDGDTEN(I,J)=0.
 301
 302       ENDDO
 303       ENDDO
 304
 305    ENDDO
 306    !$OMP END PARALLEL DO
 307
 308    ENDIF
 309
 310   IF (itimestep .eq. 1 .or. mod(itimestep,STEPFG) .eq. 0) THEN
 311
 312    !$OMP PARALLEL DO   &
 313    !$OMP PRIVATE ( ij,i,j,k )
 314    DO ij = 1 , num_tiles
 315       DO j=j_start(ij),j_end(ij)
 316       DO i=i_start(ij),i_end(ij)
 317
 318          DO k=kts,min(kte+1,kde)
 319             RTHNDGDTEN(I,K,J)=0.
 320             RUNDGDTEN(I,K,J)=0.
 321             RVNDGDTEN(I,K,J)=0.
 322             RPHNDGDTEN(I,K,J)=0.
 323             RQVNDGDTEN(I,K,J)=0.
 324          ENDDO
 325
 326          RMUNDGDTEN(I,J)=0.
 327
 328       ENDDO
 329       ENDDO
 330
 331    ENDDO
 332    !$OMP END PARALLEL DO
 333
 334 !
 335    IF( config_flags%grid_fdda /= 0 ) THEN
 336    fdda_select: SELECT CASE(config_flags%grid_fdda)
 337
 338       CASE (PSUFDDAGD)
 339
 340       !$OMP PARALLEL DO   &
 341       !$OMP PRIVATE ( ij, i,j,k )
 342        DO ij = 1 , num_tiles
 343         CALL wrf_debug(100,'in PSU FDDA scheme')
 344
 345            IF( config_flags%bl_pbl_physics /= 1 &
 346          .AND. config_flags%bl_pbl_physics /= 5 &
 347          .AND. config_flags%bl_pbl_physics /= 6 &
 348          .AND. config_flags%bl_pbl_physics /= 7 &
 349          .AND. config_flags%bl_pbl_physics /= 99 ) THEN
 350              DO j=MAX(j_start(ij)-1,jds),j_end(ij)
 351              DO i=MAX(i_start(ij)-1,ids),i_end(ij)
 352                IF( pblh(i,j) > z_at_w(i,1,j)-ht(i,j) ) THEN
 353                  regime(i,j) = 4.0
 354                ELSE
 355                  regime(i,j) = 1.0
 356                ENDIF
 357              ENDDO
 358              ENDDO
 359            ENDIF
 360
 361            CALL FDDAGD(itimestep,dx,dt,xtime, &
 362                id, &
 363                config_flags%auxinput10_interval_m, &
 364                config_flags%auxinput10_end_h, &
 365                config_flags%if_no_pbl_nudging_uv, &
 366                config_flags%if_no_pbl_nudging_t, &
 367                config_flags%if_no_pbl_nudging_q, &
 368                config_flags%if_zfac_uv, &
 369                config_flags%k_zfac_uv, &
 370                config_flags%if_zfac_t, &
 371                config_flags%k_zfac_t, &
 372                config_flags%if_zfac_q, &
 373                config_flags%k_zfac_q, &
 374                config_flags%guv, &
 375                config_flags%gt, config_flags%gq, &
 376                config_flags%if_ramping, config_flags%dtramp_min, &
 377      config_flags%grid_sfdda, &
 378      config_flags%auxinput10_interval_m, &
 379      config_flags%auxinput10_end_h, &
 380      config_flags%guv_sfc, &
 381      config_flags%gt_sfc, config_flags%gq_sfc, config_flags%rinblw, &
 382                u3d,v3d,th_phy,t_phy,                 &
 383                moist(ims,kms,jms,P_QV),     &
 384                p_phy,pi_phy,                &
 385                u_ndg_old,v_ndg_old,t_ndg_old,q_ndg_old,mu_ndg_old,       &
 386                u_ndg_new,v_ndg_new,t_ndg_new,q_ndg_new,mu_ndg_new,       &
 387      u10_ndg_old, v10_ndg_old, t2_ndg_old, th2_ndg_old, q2_ndg_old, &
 388      rh_ndg_old, psl_ndg_old, ps_ndg_old, tob_ndg_old, odis_ndg_old,  &
 389      u10_ndg_new, v10_ndg_new, t2_ndg_new, th2_ndg_new, q2_ndg_new, &
 390      rh_ndg_new, psl_ndg_new, ps_ndg_new, tob_ndg_new, odis_ndg_new,  &
 391                RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN,RQVNDGDTEN,RMUNDGDTEN,&
 392                pblh, ht, regime, znt, z, z_at_w,                             &
 393                ids,ide, jds,jde, kds,kde,                           &
 394                ims,ime, jms,jme, kms,kme,                           &
 395                i_start(ij),i_end(ij),j_start(ij),j_end(ij),kts,kte  )
 396
 397       ENDDO
 398      !$OMP END PARALLEL DO
 399
 400       CASE (SPNUDGING)
 401         CALL wrf_debug(100,'in SPECTRAL NUDGING scheme')
 402            CALL SPECTRAL_NUDGING(grid,itimestep,dt,xtime, &
 403                id, &
 404                config_flags%auxinput10_interval_m, &
 405                config_flags%auxinput10_end_h, &
 406                config_flags%if_no_pbl_nudging_uv, &
 407                config_flags%if_no_pbl_nudging_t, &
 408                config_flags%if_no_pbl_nudging_ph, &
 409                config_flags%if_zfac_uv, &
 410                config_flags%k_zfac_uv, &
 411                config_flags%dk_zfac_uv,  &
 412                config_flags%if_zfac_t, &
 413                config_flags%k_zfac_t, &
 414                config_flags%dk_zfac_t, &
 415                config_flags%if_zfac_ph, &
 416                config_flags%k_zfac_ph, &
 417                config_flags%dk_zfac_ph,  &
 418                config_flags%guv, &
 419                config_flags%gt,  &
 420                config_flags%gph,  &
 421                config_flags%if_ramping, config_flags%dtramp_min, &
 422                config_flags%xwavenum, config_flags%ywavenum, &
 423                u3d,v3d,th_phy,ph,                 &
 424                u_ndg_old,v_ndg_old,t_ndg_old,ph_ndg_old,       &
 425                u_ndg_new,v_ndg_new,t_ndg_new,ph_ndg_new,       &
 426                RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN,RPHNDGDTEN,&
 427                pblh, ht, z, z_at_w,                             &
 428                ids,ide, jds,jde, kds,kde,                           &
 429                ims,ime, jms,jme, kms,kme,                           &
 430                i_start,i_end,j_start,j_end,kts,kte, num_tiles,      &
 431                ips,ipe,jps,jpe,kps,kpe,                       &
 432                imsx,imex,jmsx,jmex,kmsx,kmex,                       &
 433                ipsx,ipex,jpsx,jpex,kpsx,kpex,                       &
 434                imsy,imey,jmsy,jmey,kmsy,kmey,                       &
 435                ipsy,ipey,jpsy,jpey,kpsy,kpey                        )
 436
 437
 438      CASE DEFAULT
 439
 440        WRITE( wrf_err_message , * ) 'The fdda option does not exist: grid_fdda = ', config_flags%grid_fdda
 441        CALL wrf_error_fatal ( wrf_err_message )
 442
 443    END SELECT fdda_select
 444    ENDIF
 445
 446    ENDIF
 447
 448 #endif
 449 !
 450    END SUBROUTINE fddagd_driver
 451 END MODULE module_fddagd_driver