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                   SDA_HFX, SDA_QFX,                               & !fasdas
  13                   HFX_FDDA,                                       & !fasdas
  14                   u_ndg_old,v_ndg_old,t_ndg_old,ph_ndg_old,       &
  15                   q_ndg_old,mu_ndg_old,       &
  16                   u_ndg_new,v_ndg_new,t_ndg_new,ph_ndg_new,       &
  17                   q_ndg_new,mu_ndg_new,       &
  18                   u3d,v3d,th_phy,ph,rho,moist,                    &
  19                   p_phy,pi_phy,p8w,t_phy,dz8w,z,z_at_w,           &
  20                   grid,config_flags,DX,n_moist,                   &
  21                   STEPFG,                                         &
  22                   pblh,ht,regime,znt,                             &
  23                   ids,ide, jds,jde, kds,kde,                      &
  24                   ims,ime, jms,jme, kms,kme,                      &
  25                   i_start,i_end, j_start,j_end, kts,kte, num_tiles, &
  26                   u10, v10, th2, q2, &
  27                   u10_ndg_old, v10_ndg_old, t2_ndg_old, th2_ndg_old, q2_ndg_old,  &
  28                   rh_ndg_old, psl_ndg_old, ps_ndg_old, tob_ndg_old, odis_ndg_old, &
  29                   u10_ndg_new, v10_ndg_new, t2_ndg_new, th2_ndg_new, q2_ndg_new,  &
  30                   rh_ndg_new, psl_ndg_new, ps_ndg_new, tob_ndg_new, odis_ndg_new, &
  31                   ips,ipe,jps,jpe,kps,kpe,                          &
  32                   imsx,imex,jmsx,jmex,kmsx,kmex,                    &
  33                   ipsx,ipex,jpsx,jpex,kpsx,kpex,                    &
  34                   imsy,imey,jmsy,jmey,kmsy,kmey,                    &
  35                   ipsy,ipey,jpsy,jpey,kpsy,kpey                     )
  36 !------------------------------------------------------------------
  37    USE module_configure
  38    USE module_state_description
  39    USE module_model_constants
  40    USE module_domain, ONLY : domain
  41
  42 ! *** add new modules of schemes here
  43
  44    USE module_fdda_psufddagd
  45    USE module_fdda_spnudging
  46
  47 !------------------------------------------------------------------
  48    IMPLICIT NONE
  49 !======================================================================
  50 ! Grid structure in physics part of WRF
  51 !----------------------------------------------------------------------
  52 ! The horizontal velocities used in the physics are unstaggered
  53 ! relative to temperature/moisture variables. All predicted
  54 ! variables are carried at half levels except w, which is at full
  55 ! levels. Some arrays with names (*8w) are at w (full) levels.
  56 !
  57 !----------------------------------------------------------------------
  58 ! In WRF, kms (smallest number) is the bottom level and kme (largest
  59 ! number) is the top level.  In your scheme, if 1 is at the top level,
  60 ! then you have to reverse the order in the k direction.
  61 !
  62 !         kme      -   half level (no data at this level)
  63 !         kme    ----- full level
  64 !         kme-1    -   half level
  65 !         kme-1  ----- full level
  66 !         .
  67 !         .
  68 !         .
  69 !         kms+2    -   half level
  70 !         kms+2  ----- full level
  71 !         kms+1    -   half level
  72 !         kms+1  ----- full level
  73 !         kms      -   half level
  74 !         kms    ----- full level
  75 !
  76 !======================================================================
  77 !-- RUNDGDTEN       U tendency due to
  78 !                 FDDA analysis nudging (m/s^2)
  79 !-- RVNDGDTEN       V tendency due to
  80 !                 FDDA analysis nudging (m/s^2)
  81 !-- RTHNDGDTEN      Theta tendency due to
  82 !                 FDDA analysis nudging (K/s)
  83 !-- RPHNDGDTEN      Geopotential tendency due to
  84 !                 FDDA analysis nudging (m^2/s^3)
  85 !-- RQVNDGDTEN      Qv tendency due to
  86 !                 FDDA analysis nudging (kg/kg/s)
  87 !-- RMUNDGDTEN      mu tendency due to
  88 !                 FDDA analysis nudging (Pa/s)
  89 !-- itimestep     number of time steps
  90 !-- u3d           u-velocity staggered on u points (m/s)
  91 !-- v3d           v-velocity staggered on v points (m/s)
  92 !-- th_phy        potential temperature (K)
  93 !-- moist         moisture array (4D - last index is species) (kg/kg)
  94 !-- p_phy         pressure (Pa)
  95 !-- pi_phy        exner function (dimensionless)
  96 !-- p8w           pressure at full levels (Pa)
  97 !-- t_phy         temperature (K)
  98 !-- dz8w          dz between full levels (m)
  99 !-- z             height above sea level (m)
 100 !-- config_flags
 101 !-- DX            horizontal space interval (m)
 102 !-- DT            time step (second)
 103 !-- n_moist       number of moisture species
 104 !-- STEPFG        number of timesteps per FDDA re-calculation
 105 !-- KPBL          k-index of PBL top
 106 !-- ids           start index for i in domain
 107 !-- ide           end index for i in domain
 108 !-- jds           start index for j in domain
 109 !-- jde           end index for j in domain
 110 !-- kds           start index for k in domain
 111 !-- kde           end index for k in domain
 112 !-- ims           start index for i in memory
 113 !-- ime           end index for i in memory
 114 !-- jms           start index for j in memory
 115 !-- jme           end index for j in memory
 116 !-- kms           start index for k in memory
 117 !-- kme           end index for k in memory
 118 !-- jts           start index for j in tile
 119 !-- jte           end index for j in tile
 120 !-- kts           start index for k in tile
 121 !-- kte           end index for k in tile
 122 !
 123 !******************************************************************
 124 !------------------------------------------------------------------
 125    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 126    TYPE(domain) , TARGET          :: grid
 127 !
 128
 129    INTEGER , INTENT(IN)         ::     id
 130
 131    INTEGER,    INTENT(IN   )    ::     ids,ide, jds,jde, kds,kde, &
 132                                        ims,ime, jms,jme, kms,kme, &
 133                                        kts,kte, num_tiles,        &
 134                                        ips,ipe,jps,jpe,kps,kpe,   &
 135                                        imsx,imex,jmsx,jmex,kmsx,kmex,   &
 136                                        ipsx,ipex,jpsx,jpex,kpsx,kpex,   &
 137                                        imsy,imey,jmsy,jmey,kmsy,kmey,   &
 138                                        ipsy,ipey,jpsy,jpey,kpsy,kpey,   &
 139                                        n_moist
 140
 141    INTEGER, DIMENSION(num_tiles), INTENT(IN) ::                   &
 142   &                                    i_start,i_end,j_start,j_end
 143
 144    INTEGER,    INTENT(IN   )    ::     itimestep,STEPFG
 145 !
 146    REAL,       INTENT(IN   )    ::     DT,DX,XTIME
 147
 148
 149 !
 150    REAL,       DIMENSION( ims:ime, kms:kme, jms:jme ),            &
 151                INTENT(IN   )    ::                         p_phy, &
 152                                                           pi_phy, &
 153                                                              p8w, &
 154                                                              rho, &
 155                                                            t_phy, &
 156                                                              u3d, &
 157                                                              v3d, &
 158                                                               ph, &
 159                                                             dz8w, &
 160                                                                z, &
 161                                                           z_at_w, &
 162                                                           th_phy
 163 !
 164    REAL, DIMENSION( ims:ime, kms:kme, jms:jme, n_moist ),         &
 165          INTENT(IN ) ::                                    moist
 166 !
 167 !
 168 !
 169    REAL,       DIMENSION( ims:ime, kms:kme, jms:jme ),            &
 170                INTENT(INOUT)    ::                       RUNDGDTEN, &
 171                                                          RVNDGDTEN, &
 172                                                         RTHNDGDTEN, &
 173                                                         RPHNDGDTEN, &
 174                                                         RQVNDGDTEN
 175 !
 176 ! FASDAS
 177 !
 178    REAL,       DIMENSION( ims:ime, jms:jme ),            &
 179                INTENT(INOUT)    ::                       SDA_HFX, &
 180                                                          SDA_QFX
 181    REAL,       DIMENSION( ims:ime, kms:kme, jms:jme ),            &
 182                INTENT(INOUT)    ::                       HFX_FDDA
 183 !
 184 ! END FASDAS
 185 !
 186    REAL,       DIMENSION( ims:ime,  jms:jme ),            &
 187                INTENT(INOUT)    ::                      RMUNDGDTEN
 188
 189    REAL,       DIMENSION( ims:ime, kms:kme, jms:jme ),            &
 190                INTENT(INOUT)    ::                       u_ndg_old, &
 191                                                          v_ndg_old, &
 192                                                          t_ndg_old, &
 193                                                          ph_ndg_old,&
 194                                                          q_ndg_old, &
 195                                                          u_ndg_new, &
 196                                                          v_ndg_new, &
 197                                                          t_ndg_new, &
 198                                                          ph_ndg_new,&
 199                                                          q_ndg_new
 200    REAL,       DIMENSION( ims:ime,  jms:jme ),            &
 201                INTENT(INOUT)    ::                       mu_ndg_old, &
 202                                                          mu_ndg_new
 203
 204 !
 205    REAL,    DIMENSION( ims:ime , jms:jme ),     &
 206                INTENT(IN   ) ::           pblh, &
 207                                             ht, &
 208                                            znt
 209
 210    REAL,    DIMENSION( ims:ime , jms:jme ), INTENT(INOUT   ) :: regime
 211
 212    REAL,       DIMENSION( ims:ime, jms:jme ),            &
 213                INTENT(IN   )    ::                       u10, &
 214                                                          v10, &
 215                                                          th2, &
 216                                                          q2
 217
 218    REAL,       DIMENSION( ims:ime, jms:jme ),            &
 219                INTENT(IN)       ::                       u10_ndg_old,  &
 220                                                          v10_ndg_old,  &
 221                                                          t2_ndg_old,   &
 222                                                          th2_ndg_old,  &
 223                                                          q2_ndg_old,   &
 224                                                          rh_ndg_old,   &
 225                                                          psl_ndg_old,  &
 226                                                          ps_ndg_old,   &
 227                                                          odis_ndg_old,  &
 228                                                          u10_ndg_new,  &
 229                                                          v10_ndg_new,  &
 230                                                          t2_ndg_new,   &
 231                                                          th2_ndg_new,  &
 232                                                          q2_ndg_new,   &
 233                                                          rh_ndg_new,   &
 234                                                          psl_ndg_new,  &
 235                                                          ps_ndg_new,   &
 236                                                          odis_ndg_new
 237
 238    REAL,       DIMENSION( ims:ime, jms:jme ),            &
 239                INTENT(IN)       ::                       tob_ndg_old,  &
 240                                                          tob_ndg_new
 241
 242 !  LOCAL  VAR
 243
 244 !
 245    INTEGER :: i,J,K,NK,jj,ij
 246    CHARACTER (LEN=256) :: message
 247
 248 !------------------------------------------------------------------
 249 !
 250   if (config_flags%grid_fdda .eq. 0 .AND. config_flags%grid_sfdda .eq. 0) return
 251
 252   IF (itimestep == 1) THEN
 253
 254    IF( config_flags%grid_fdda .eq. 1 ) THEN
 255    !$OMP PARALLEL DO   &
 256    !$OMP PRIVATE ( ij,i,j,k )
 257    DO ij = 1 , num_tiles
 258       DO j=j_start(ij),j_end(ij)
 259       DO i=i_start(ij),i_end(ij)
 260
 261          DO k=kts,kte !min(kte+1,kde) !BSINGH(PNNL)- Undefined behavior at k=kte+1
 262             u_ndg_old(i,k,j) = u3d(i,k,j)
 263             v_ndg_old(i,k,j) = v3d(i,k,j)
 264             t_ndg_old(i,k,j) = th_phy(i,k,j) - 300.0
 265             ph_ndg_old(i,k,j) = ph(i,k,j)
 266             q_ndg_old(i,k,j) = moist(i,k,j,P_QV)
 267          ENDDO
 268          mu_ndg_old(i,j) = 0.0
 269
 270       ENDDO
 271       ENDDO
 272
 273    ENDDO
 274
 275 !  IF( config_flags%grid_sfdda .eq. 1 ) THEN
 276 !    DO ij = 1 , num_tiles
 277 !       DO j=j_start(ij),j_end(ij)
 278 !       DO i=i_start(ij),i_end(ij)
 279 !             u10_ndg_old(i,j) = u10(i,j)
 280 !             v10_ndg_old(i,j) = v10(i,j)
 281 !             th2_ndg_old(i,j) = th2(i,j) - 300.0
 282 !              q2_ndg_old(i,j) = q2(i,j)
 283 !       ENDDO
 284 !       ENDDO
 285
 286 !    ENDDO
 287 !  ENDIF
 288    !$OMP END PARALLEL DO
 289
 290    ENDIF
 291   ENDIF
 292
 293 !GMM if fgdtzero = 1, tendencies are zero in between calls
 294
 295   IF (mod(itimestep-1,STEPFG) .eq. 0 .and. config_flags%fgdtzero .eq. 1) THEN
 296
 297    !$OMP PARALLEL DO   &
 298    !$OMP PRIVATE ( ij,i,j,k )
 299    DO ij = 1 , num_tiles
 300       DO j=j_start(ij),j_end(ij)
 301       DO i=i_start(ij),i_end(ij)
 302
 303          DO k=kts,min(kte+1,kde)
 304             RTHNDGDTEN(I,K,J)=0.
 305             RUNDGDTEN(I,K,J)=0.
 306             RVNDGDTEN(I,K,J)=0.
 307             RPHNDGDTEN(I,K,J)=0.
 308             RQVNDGDTEN(I,K,J)=0.
 309          ENDDO
 310
 311          RMUNDGDTEN(I,J)=0.
 312
 313       ENDDO
 314       ENDDO
 315
 316    ENDDO
 317    !$OMP END PARALLEL DO
 318
 319    ENDIF
 320
 321   IF (itimestep .eq. 1 .or. mod(itimestep,STEPFG) .eq. 0) THEN
 322
 323    !$OMP PARALLEL DO   &
 324    !$OMP PRIVATE ( ij,i,j,k )
 325    DO ij = 1 , num_tiles
 326       DO j=j_start(ij),j_end(ij)
 327       DO i=i_start(ij),i_end(ij)
 328
 329          DO k=kts,min(kte+1,kde)
 330             RTHNDGDTEN(I,K,J)=0.
 331             RUNDGDTEN(I,K,J)=0.
 332             RVNDGDTEN(I,K,J)=0.
 333             RPHNDGDTEN(I,K,J)=0.
 334             RQVNDGDTEN(I,K,J)=0.
 335          ENDDO
 336
 337          RMUNDGDTEN(I,J)=0.
 338
 339       ENDDO
 340       ENDDO
 341
 342    ENDDO
 343    !$OMP END PARALLEL DO
 344
 345 !
 346    IF( config_flags%grid_fdda /= 0 ) THEN
 347    fdda_select: SELECT CASE(config_flags%grid_fdda)
 348
 349       CASE (PSUFDDAGD)
 350
 351       !BPR BEGIN
 352       !Add error checks to ensure that user does not use analysis nudging
 353       !options that WRF will read in but not fully utilize
 354       !3D Analysis nudging
 355
 356       !The begin time of analysis nudging must be the model start time
 357       !It appears the WRF code that reads analysis nudging files respects
 358       !the start time settings, but the actual nudging code does not.  This
 359       !leads one to nudge towards 0 in all fields (including potential
 360       !temperature [K]) since the nudging code applies analysis nudging but has
 361       !no data to nudge towards
 362       IF( config_flags%gfdda_begin_y /= 0 ) THEN
 363        WRITE( wrf_err_message , * ) 'WRF currently assumes analysis nudging starts at the model ',&
 364         'start time and so analysis nudging start time cannot be specified via gfdda_begin_y'
 365        CALL wrf_error_fatal ( wrf_err_message )
 366       ENDIF
 367       IF( config_flags%gfdda_begin_d /= 0 ) THEN
 368        WRITE( wrf_err_message , * ) 'WRF currently assumes analysis nudging starts at the model ',&
 369         'start time and so analysis nudging start time cannot be specified via gfdda_begin_d'
 370        CALL wrf_error_fatal ( wrf_err_message )
 371       ENDIF
 372       IF( config_flags%gfdda_begin_h /= 0 ) THEN
 373        WRITE( wrf_err_message , * ) 'WRF currently assumes analysis nudging starts at the model ',&
 374         'start time and so analysis nudging start time cannot be specified via gfdda_begin_h'
 375        CALL wrf_error_fatal ( wrf_err_message )
 376       ENDIF
 377       IF( config_flags%gfdda_begin_m /= 0 ) THEN
 378        WRITE( wrf_err_message , * ) 'WRF currently assumes analysis nudging starts at the model ',&
 379         'start time and so analysis nudging start time cannot be specified via gfdda_begin_m'
 380        CALL wrf_error_fatal ( wrf_err_message )
 381       ENDIF
 382       IF( config_flags%gfdda_begin_s /= 0 ) THEN
 383        WRITE( wrf_err_message , * ) 'WRF currently assumes analysis nudging starts at the model ',&
 384         'start time and so analysis nudging start time cannot be specified via gfdda_begin_s'
 385        CALL wrf_error_fatal ( wrf_err_message )
 386       ENDIF
 387
 388
 389       !The end time of analysis nudging relative to the model start must be
 390       !specified in hours
 391       IF( config_flags%gfdda_end_y /= 0 ) THEN
 392        WRITE( wrf_err_message , * ) 'The option gfdda_end_y is ignored, use gfdda_end_h instead'
 393        CALL wrf_error_fatal ( wrf_err_message )
 394       ENDIF
 395       IF( config_flags%gfdda_end_d /= 0 ) THEN
 396        WRITE( wrf_err_message , * ) 'The option gfdda_end_d is ignored, use gfdda_end_h instead'
 397        CALL wrf_error_fatal ( wrf_err_message )
 398       ENDIF
 399       IF( config_flags%gfdda_end_m /= 0 ) THEN
 400        WRITE( wrf_err_message , * ) 'The option gfdda_end_m is ignored, use gfdda_end_h instead'
 401        CALL wrf_error_fatal ( wrf_err_message )
 402       ENDIF
 403       IF( config_flags%gfdda_end_s /= 0 ) THEN
 404        WRITE( wrf_err_message , * ) 'The option gfdda_end_s is ignored, use gfdda_end_h instead'
 405        CALL wrf_error_fatal ( wrf_err_message )
 406       ENDIF
 407
 408       !The interval between analyses must be specified in minutes
 409       IF( config_flags%gfdda_interval_y /= 0 ) THEN
 410        WRITE( wrf_err_message , * ) 'The option gfdda_interval_y is ignored, use gfdda_interval_m instead'
 411        CALL wrf_error_fatal ( wrf_err_message )
 412       ENDIF
 413       IF( config_flags%gfdda_interval_d /= 0 ) THEN
 414        WRITE( wrf_err_message , * ) 'The option gfdda_interval_d is ignored, use gfdda_interval_m instead'
 415        CALL wrf_error_fatal ( wrf_err_message )
 416       ENDIF
 417       IF( config_flags%gfdda_interval_h /= 0 ) THEN
 418        WRITE( wrf_err_message , * ) 'The option gfdda_interval_h is ignored, use gfdda_interval_m instead'
 419        CALL wrf_error_fatal ( wrf_err_message )
 420       ENDIF
 421       IF( config_flags%gfdda_interval_s /= 0 ) THEN
 422        WRITE( wrf_err_message , * ) 'The option gfdda_interval_s is ignored, use gfdda_interval_m instead'
 423        CALL wrf_error_fatal ( wrf_err_message )
 424       ENDIF
 425
 426       !If surface analysis nudging chosen check analogous surface analysis
 427       !nudging namelist options
 428       IF( config_flags%grid_sfdda /= 0 ) THEN
 429
 430        !The begin time of analysis nudging must be the model start time
 431        !It appears the WRF code that reads analysis nudging files respects
 432        !the start time settings, but the actual nudging code does not.  This
 433        !leads one to nudge towards 0 in all fields (including potential
 434        !temperature [K]) since the nudging code applies analysis nudging but has
 435        !no data to nudge towards
 436        IF( config_flags%sgfdda_begin_y /= 0 ) THEN
 437         WRITE( wrf_err_message , * ) 'WRF currently assumes analysis nudging starts at the model ',&
 438          'start time and so analysis nudging start time cannot be specified via sgfdda_begin_y'
 439         CALL wrf_error_fatal ( wrf_err_message )
 440        ENDIF
 441        IF( config_flags%sgfdda_begin_d /= 0 ) THEN
 442         WRITE( wrf_err_message , * ) 'WRF currently assumes analysis nudging starts at the model ',&
 443          'start time and so analysis nudging start time cannot be specified via sgfdda_begin_d'
 444         CALL wrf_error_fatal ( wrf_err_message )
 445        ENDIF
 446        IF( config_flags%sgfdda_begin_h /= 0 ) THEN
 447         WRITE( wrf_err_message , * ) 'WRF currently assumes analysis nudging starts at the model ',&
 448          'start time and so analysis nudging start time cannot be specified via sgfdda_begin_h'
 449         CALL wrf_error_fatal ( wrf_err_message )
 450        ENDIF
 451        IF( config_flags%sgfdda_begin_m /= 0 ) THEN
 452         WRITE( wrf_err_message , * ) 'WRF currently assumes analysis nudging starts at the model ',&
 453          'start time and so analysis nudging start time cannot be specified via sgfdda_begin_m'
 454         CALL wrf_error_fatal ( wrf_err_message )
 455        ENDIF
 456        IF( config_flags%sgfdda_begin_s /= 0 ) THEN
 457         WRITE( wrf_err_message , * ) 'WRF currently assumes analysis nudging starts at the model ',&
 458          'start time and so analysis nudging start time cannot be specified via sgfdda_begin_s'
 459         CALL wrf_error_fatal ( wrf_err_message )
 460        ENDIF
 461
 462
 463        !The end time of analysis nudging relative to the model start must be
 464        !specified in hours
 465        IF( config_flags%sgfdda_end_y /= 0 ) THEN
 466         WRITE( wrf_err_message , * ) 'The option sgfdda_end_y is ignored, use sgfdda_end_h instead'
 467         CALL wrf_error_fatal ( wrf_err_message )
 468        ENDIF
 469        IF( config_flags%sgfdda_end_d /= 0 ) THEN
 470         WRITE( wrf_err_message , * ) 'The option sgfdda_end_d is ignored, use sgfdda_end_h instead'
 471         CALL wrf_error_fatal ( wrf_err_message )
 472        ENDIF
 473        IF( config_flags%sgfdda_end_m /= 0 ) THEN
 474         WRITE( wrf_err_message , * ) 'The option sgfdda_end_m is ignored, use sgfdda_end_h instead'
 475         CALL wrf_error_fatal ( wrf_err_message )
 476        ENDIF
 477        IF( config_flags%sgfdda_end_s /= 0 ) THEN
 478         WRITE( wrf_err_message , * ) 'The option sgfdda_end_s is ignored, use sgfdda_end_h instead'
 479         CALL wrf_error_fatal ( wrf_err_message )
 480        ENDIF
 481
 482        !The interval between analyses must be specified in minutes
 483        IF( config_flags%sgfdda_interval_y /= 0 ) THEN
 484         WRITE( wrf_err_message , * ) 'The option sgfdda_interval_y is ignored, use sgfdda_interval_m instead'
 485         CALL wrf_error_fatal ( wrf_err_message )
 486        ENDIF
 487        IF( config_flags%sgfdda_interval_d /= 0 ) THEN
 488         WRITE( wrf_err_message , * ) 'The option sgfdda_interval_d is ignored, use sgfdda_interval_m instead'
 489         CALL wrf_error_fatal ( wrf_err_message )
 490        ENDIF
 491        IF( config_flags%sgfdda_interval_h /= 0 ) THEN
 492         WRITE( wrf_err_message , * ) 'The option sgfdda_interval_h is ignored, use sgfdda_interval_m instead'
 493         CALL wrf_error_fatal ( wrf_err_message )
 494        ENDIF
 495        IF( config_flags%sgfdda_interval_s /= 0 ) THEN
 496         WRITE( wrf_err_message , * ) 'The option sgfdda_interval_s is ignored, use sgfdda_interval_m instead'
 497         CALL wrf_error_fatal ( wrf_err_message )
 498        ENDIF
 499
 500       ENDIF !IF surface analysis nudging is anabled
 501       !BPR END
 502
 503       !$OMP PARALLEL DO   &
 504       !$OMP PRIVATE ( ij, i,j,k )
 505        DO ij = 1 , num_tiles
 506         CALL wrf_debug(100,'in PSU FDDA scheme')
 507
 508            IF( config_flags%sf_sfclay_physics /= sfclayscheme &
 509          .AND. config_flags%sf_sfclay_physics /= mynnsfcscheme &
 510          .AND. config_flags%sf_sfclay_physics /= pxsfcscheme &
 511          .AND. config_flags%sf_sfclay_physics /= sfclayrevscheme ) THEN
 512              DO j=MAX(j_start(ij)-1,jds),j_end(ij)
 513              DO i=MAX(i_start(ij)-1,ids),i_end(ij)
 514                IF( pblh(i,j) > z_at_w(i,2,j)-ht(i,j) ) THEN
 515                  regime(i,j) = 4.0
 516                ELSE
 517                  regime(i,j) = 1.0
 518                ENDIF
 519              ENDDO
 520              ENDDO
 521            ENDIF
 522
 523            CALL FDDAGD(itimestep,dx,dt,xtime, &
 524                id, &
 525                config_flags%auxinput10_interval_m, &
 526                config_flags%auxinput10_end_h, &
 527                config_flags%if_no_pbl_nudging_uv, &
 528                config_flags%if_no_pbl_nudging_t, &
 529                config_flags%if_no_pbl_nudging_q, &
 530                config_flags%if_zfac_uv, &
 531                config_flags%k_zfac_uv, &
 532                config_flags%if_zfac_t, &
 533                config_flags%k_zfac_t, &
 534                config_flags%if_zfac_q, &
 535                config_flags%k_zfac_q, &
 536                config_flags%guv, &
 537                config_flags%gt, config_flags%gq, &
 538                config_flags%if_ramping, config_flags%dtramp_min, &
 539      config_flags%grid_sfdda, &
 540      config_flags%auxinput9_interval_m, &
 541      config_flags%auxinput9_end_h, &
 542      config_flags%guv_sfc, &
 543      config_flags%gt_sfc, config_flags%gq_sfc, config_flags%rinblw, &
 544                u3d,v3d,th_phy,t_phy,                 &
 545                moist(ims,kms,jms,P_QV),     &
 546                p_phy,pi_phy,                &
 547                u_ndg_old,v_ndg_old,t_ndg_old,q_ndg_old,mu_ndg_old,       &
 548                u_ndg_new,v_ndg_new,t_ndg_new,q_ndg_new,mu_ndg_new,       &
 549      u10_ndg_old, v10_ndg_old, t2_ndg_old, th2_ndg_old, q2_ndg_old, &
 550      rh_ndg_old, psl_ndg_old, ps_ndg_old, tob_ndg_old, odis_ndg_old,  &
 551      u10_ndg_new, v10_ndg_new, t2_ndg_new, th2_ndg_new, q2_ndg_new, &
 552      rh_ndg_new, psl_ndg_new, ps_ndg_new, tob_ndg_new, odis_ndg_new,  &
 553                RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN,RQVNDGDTEN,RMUNDGDTEN,&
 554 !
 555 ! FASDAS
 556 !
 557            config_flags%fasdas, SDA_HFX, SDA_QFX,           &
 558            HFX_FDDA,dz8w,       &
 559 !
 560 ! END FASDAS
 561 !
 562                pblh, ht, regime, znt, z, z_at_w,                             &
 563                ids,ide, jds,jde, kds,kde,                           &
 564                ims,ime, jms,jme, kms,kme,                           &
 565                i_start(ij),i_end(ij),j_start(ij),j_end(ij),kts,kte  )
 566
 567       ENDDO
 568      !$OMP END PARALLEL DO
 569
 570       CASE (SPNUDGING)
 571         CALL wrf_debug(100,'in SPECTRAL NUDGING scheme')
 572            CALL SPECTRAL_NUDGING(grid,itimestep,dt,xtime, &
 573                id, &
 574                config_flags%auxinput10_interval_m, &
 575                config_flags%auxinput10_end_h, &
 576                config_flags%if_no_pbl_nudging_uv, &
 577                config_flags%if_no_pbl_nudging_t, &
 578                config_flags%if_no_pbl_nudging_ph, &
 579                config_flags%if_no_pbl_nudging_q, &
 580                config_flags%if_zfac_uv, &
 581                config_flags%k_zfac_uv, &
 582                config_flags%dk_zfac_uv,  &
 583                config_flags%if_zfac_t, &
 584                config_flags%k_zfac_t, &
 585                config_flags%dk_zfac_t, &
 586                config_flags%if_zfac_ph, &
 587                config_flags%k_zfac_ph, &
 588                config_flags%dk_zfac_ph,  &
 589                config_flags%if_zfac_q, &
 590                config_flags%k_zfac_q, &
 591                config_flags%dk_zfac_q, &
 592                config_flags%ktrop, &
 593                config_flags%guv, &
 594                config_flags%gt,  &
 595                config_flags%gph,  &
 596                config_flags%gq,  &
 597                config_flags%if_ramping, config_flags%dtramp_min, &
 598                config_flags%xwavenum, config_flags%ywavenum, &
 599                u3d,v3d,th_phy,ph,moist(ims,kms,jms,P_QV),                &
 600                u_ndg_old,v_ndg_old,t_ndg_old,ph_ndg_old,q_ndg_old,       &
 601                u_ndg_new,v_ndg_new,t_ndg_new,ph_ndg_new,q_ndg_new,       &
 602                RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN,RPHNDGDTEN,RQVNDGDTEN,&
 603                pblh, ht, z, z_at_w,                             &
 604                ids,ide, jds,jde, kds,kde,                           &
 605                ims,ime, jms,jme, kms,kme,                           &
 606                i_start,i_end,j_start,j_end,kts,kte, num_tiles,      &
 607                ips,ipe,jps,jpe,kps,kpe,                       &
 608                imsx,imex,jmsx,jmex,kmsx,kmex,                       &
 609                ipsx,ipex,jpsx,jpex,kpsx,kpex,                       &
 610                imsy,imey,jmsy,jmey,kmsy,kmey,                       &
 611                ipsy,ipey,jpsy,jpey,kpsy,kpey                        )
 612
 613
 614      CASE DEFAULT
 615
 616        WRITE( wrf_err_message , * ) 'The fdda option does not exist: grid_fdda = ', config_flags%grid_fdda
 617        CALL wrf_error_fatal ( wrf_err_message )
 618
 619    END SELECT fdda_select
 620    ENDIF
 621
 622    ENDIF
 623
 624 !
 625    END SUBROUTINE fddagd_driver
 626 END MODULE module_fddagd_driver