chem/optical_driver.F

   1 !**********************************************************************************
   2 ! This computer software was prepared by Battelle Memorial Institute, hereinafter
   3 ! the Contractor, under Contract No. DE-AC05-76RL0 1830 with the Department of
   4 ! Energy (DOE). NEITHER THE GOVERNMENT NOR THE CONTRACTOR MAKES ANY WARRANTY,
   5 ! EXPRESS OR IMPLIED, OR ASSUMES ANY LIABILITY FOR THE USE OF THIS SOFTWARE.
   6 !
   7 ! MOSAIC module: see module_mosaic_driver.F for references and terms of use
   8 !**********************************************************************************
   9 !
  10 ! WRF-chem V3.0 : Original version of optical_driver written by Jerome Fast (PNNL)
  11 !                 and James Barnard (PNNL)
  12 !
  13 !WRF:MODEL_LAYER:CHEMISTRY
  14 !
  15       SUBROUTINE optical_driver(id,curr_secs,dtstep,config_flags,haveaer,&
  16                chem,dz8w,alt,relhum,                                     &
  17                h2oai,h2oaj,                                              &
  18                tauaer1,tauaer2,tauaer3,tauaer4,                          &
  19                !czhao
  20                extaer1,extaer2,extaer3,extaer4,                          &
  21                gaer1,gaer2,gaer3,gaer4,                                  &
  22                waer1,waer2,waer3,waer4,                                  &
  23                bscoef1,bscoef2,bscoef3,bscoef4,                          &
  24                l2aer,l3aer,l4aer,l5aer,l6aer,l7aer,                      &
  25                totoa_a01,totoa_a02,totoa_a03,totoa_a04,                  &
  26                totoa_a05,totoa_a06,totoa_a07,totoa_a08,                  &
  27                extaerlw1,extaerlw2,extaerlw3,extaerlw4,extaerlw5,extaerlw6, &
  28                extaerlw7,extaerlw8,extaerlw9,extaerlw10,extaerlw11,extaerlw12, &
  29                extaerlw13,extaerlw14,extaerlw15,extaerlw16,  &
  30                tauaerlw1,tauaerlw2,tauaerlw3,tauaerlw4,tauaerlw5,tauaerlw6, &
  31                tauaerlw7,tauaerlw8,tauaerlw9,tauaerlw10,tauaerlw11,tauaerlw12, &
  32                tauaerlw13,tauaerlw14,tauaerlw15,tauaerlw16,  &
  33                ids,ide, jds,jde, kds,kde,                                &
  34                ims,ime, jms,jme, kms,kme,                                &
  35                its,ite, jts,jte, kts,kte                                 )
  36
  37 !------------------------------------------------------------------------
  38    USE module_configure
  39    USE module_state_description
  40    USE module_model_constants
  41    USE module_optical_averaging
  42    USE module_data_mosaic_therm, only: nbin_a
  43    USE module_data_rrtmgaeropt, only: nswbands,nlwbands
  44    USE module_peg_util, only:  peg_error_fatal, peg_message
  45    use infnan,                 only: inf
  46    IMPLICIT NONE
  47    INTEGER,      INTENT(IN   ) :: id,                                  &
  48                                   ids,ide, jds,jde, kds,kde,           &
  49                                   ims,ime, jms,jme, kms,kme,           &
  50                                   its,ite, jts,jte, kts,kte
  51    REAL(KIND=8), INTENT(IN   ) :: curr_secs
  52    REAL,         INTENT(IN   ) :: dtstep
  53 !
  54 ! array that holds all advected chemical species
  55 !
  56    REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ),             &
  57          INTENT(IN ) ::  chem
  58 !
  59    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                       &
  60          INTENT(IN ) ::  relhum, dz8w, alt, h2oai, h2oaj,              &
  61                          totoa_a01, totoa_a02, totoa_a03, totoa_a04,   &
  62                          totoa_a05,totoa_a06,totoa_a07,totoa_a08
  63 !
  64 ! arrays that hold the aerosol optical properties
  65 !
  66    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                       &
  67          INTENT(INOUT ) ::                                             &
  68            tauaer1, tauaer2, tauaer3, tauaer4,                         &
  69            !czhao
  70            extaer1, extaer2, extaer3, extaer4,                         &
  71            gaer1, gaer2, gaer3, gaer4,                                 &
  72            waer1, waer2, waer3, waer4,                                 &
  73            bscoef1, bscoef2, bscoef3, bscoef4
  74    !for rrtmg shortwave and longwave --czhao
  75    REAL, DIMENSION( ims:ime, kms:kme, jms:jme),                &
  76          INTENT(INOUT ) :: extaerlw1,extaerlw2,extaerlw3,extaerlw4,extaerlw5, &
  77                            extaerlw6,extaerlw7,extaerlw8,extaerlw9,extaerlw10, &
  78                            extaerlw11,extaerlw12,extaerlw13,extaerlw14,extaerlw15, &
  79                            extaerlw16,   &
  80                            tauaerlw1,tauaerlw2,tauaerlw3,tauaerlw4,tauaerlw5, &
  81                            tauaerlw6,tauaerlw7,tauaerlw8,tauaerlw9,tauaerlw10, &
  82                            tauaerlw11,tauaerlw12,tauaerlw13,tauaerlw14,tauaerlw15, &
  83                            tauaerlw16
  84    REAL, DIMENSION( ims:ime, kms:kme, jms:jme,1:4) ::  &
  85          tauaersw,extaersw,gaersw,waersw,bscoefsw
  86    REAL, DIMENSION( ims:ime, kms:kme, jms:jme, 1:4 ),                  &
  87          INTENT(INOUT ) ::                                             &
  88            l2aer, l3aer, l4aer, l5aer, l6aer, l7aer
  89
  90    REAL, DIMENSION( ims:ime, kms:kme, jms:jme,1:nlwbands) ::  &
  91          extaerlw,tauaerlw
  92
  93    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
  94
  95    character*100 msg
  96    integer lunerr
  97
  98    LOGICAL, INTENT(IN) :: haveaer
  99 !
 100 ! local variables
 101 !
 102       logical processingAerosols
 103       integer nbin_o
 104       integer option_method, option_mie
 105
 106 !-----------------------------------------------------------------
 107 ! compute only if simulating aerosols and aer_ra_feedback=1
 108
 109 !  IF (config_flags%aer_ra_feedback .eq. 0) THEN
 110 !        call wrf_debug(15,'no feedback, return from optical driver')
 111 !    return
 112 !  ENDIF
 113    select case (config_flags%chem_opt)
 114    case ( RADM2SORG,           RADM2SORG_KPP,      RADM2SORG_AQ, RADM2SORG_AQCHEM, &
 115           GOCART_SIMPLE,       RACMSORG_KPP,       RACMSORG_AQ,  RACMSORG_AQCHEM_KPP, &
 116           RACM_ESRLSORG_AQCHEM_KPP, RACM_SOA_VBS_KPP, RACM_SOA_VBS_AQCHEM_KPP,        &
 117           RACM_SOA_VBS_HET_KPP,        &
 118           GOCARTRACM_KPP,      GOCARTRADM2,  &
 119           RACM_ESRLSORG_KPP,   MOZCART_KPP,        T1_MOZCART_KPP,  &
 120           CBMZ_MOSAIC_4BIN,    CBMZ_MOSAIC_8BIN, CBMZ_MOSAIC_KPP,   &
 121           CBMZ_MOSAIC_4BIN_AQ, CBMZ_MOSAIC_8BIN_AQ, CBMZSORG, CBMZSORG_AQ, &
 122           CBMZ_MOSAIC_DMS_4BIN,    CBMZ_MOSAIC_DMS_8BIN,   &
 123           CBMZ_MOSAIC_DMS_4BIN_AQ, CBMZ_MOSAIC_DMS_8BIN_AQ, &
 124           SAPRC99_MOSAIC_4BIN_VBS2_KPP, &
 125           MOZART_MOSAIC_4BIN_KPP , MOZART_MOSAIC_4BIN_AQ_KPP, &
 126           CBMZ_CAM_MAM3_NOAQ,CBMZ_CAM_MAM7_NOAQ,  CBMZ_CAM_MAM3_AQ,  &
 127           CBMZ_CAM_MAM7_AQ, CRI_MOSAIC_8BIN_AQ_KPP, CRI_MOSAIC_4BIN_AQ_KPP, &
 128           SAPRC99_MOSAIC_8BIN_VBS2_AQ_KPP, SAPRC99_MOSAIC_8BIN_VBS2_KPP,  &
 129           CB05_SORG_AQ_KPP, CB05_SORG_VBS_AQ_KPP )
 130       processingAerosols = .true.
 131       call wrf_debug(15,'optical driver: process aerosols true')
 132    case default
 133       processingAerosols = .false.
 134       call wrf_debug(15,'optical driver: process aerosols false')
 135    end select
 136
 137   if( processingAerosols ) then
 138 !
 139 ! select aerosol optical property option
 140 ! VOLUME: volume averaging of refractive indicies
 141 ! * for MADE/SORGAM, assume same 8 size bins as MOSAIC by default
 142 ! SHELL: shell-core approach, placeholder
 143 !
 144    select case (config_flags%chem_opt)
 145    case ( RADM2SORG, RACM_ESRLSORG_KPP, RADM2SORG_KPP, RADM2SORG_AQ, RADM2SORG_AQCHEM, &
 146           GOCARTRACM_KPP,      GOCARTRADM2,      &
 147           GOCART_SIMPLE,       RACMSORG_KPP,       RACMSORG_AQ,      RACMSORG_AQCHEM_KPP, &
 148           RACM_ESRLSORG_AQCHEM_KPP, RACM_SOA_VBS_KPP, RACM_SOA_VBS_AQCHEM_KPP,            &
 149           RACM_SOA_VBS_HET_KPP, CBMZSORG, CBMZSORG_AQ, MOZCART_KPP, T1_MOZCART_KPP,     &
 150           CBMZ_CAM_MAM3_NOAQ,  CBMZ_CAM_MAM7_NOAQ,  CBMZ_CAM_MAM3_AQ,  CBMZ_CAM_MAM7_AQ, &
 151           CB05_SORG_AQ_KPP, CB05_SORG_VBS_AQ_KPP )
 152      nbin_o = 8
 153    case (CBMZ_MOSAIC_4BIN,    CBMZ_MOSAIC_8BIN, CBMZ_MOSAIC_KPP,  &
 154          CBMZ_MOSAIC_4BIN_AQ, CBMZ_MOSAIC_8BIN_AQ, &
 155          CBMZ_MOSAIC_DMS_4BIN,    CBMZ_MOSAIC_DMS_8BIN,   &
 156          CBMZ_MOSAIC_DMS_4BIN_AQ, CBMZ_MOSAIC_DMS_8BIN_AQ, &
 157          SAPRC99_MOSAIC_4BIN_VBS2_KPP, &
 158          MOZART_MOSAIC_4BIN_KPP, MOZART_MOSAIC_4BIN_AQ_KPP, &
 159          CRI_MOSAIC_8BIN_AQ_KPP, CRI_MOSAIC_4BIN_AQ_KPP, &
 160          SAPRC99_MOSAIC_8BIN_VBS2_AQ_KPP, SAPRC99_MOSAIC_8BIN_VBS2_KPP )!BSINGH(12/05/2013): Added for SAPRC 8 bin vbs and added non-aq on 04/03/2014
 161      nbin_o = nbin_a
 162    end select
 163 !
 164      call wrf_debug(15,'optical averaging')
 165      aer_op_opt_select: SELECT CASE(config_flags%aer_op_opt)
 166      CASE (VOLUME_APPROX)
 167        option_method=1
 168        option_mie=1
 169      CASE (MAXWELL_APPROX)
 170        option_method=2
 171        option_mie=1
 172      CASE (VOLUME_EXACT)
 173        option_method=1
 174        option_mie=2
 175      CASE (MAXWELL_EXACT)
 176        option_method=2
 177        option_mie=2
 178      CASE (SHELL_EXACT)
 179        option_method=3
 180        option_mie=2
 181      CASE DEFAULT
 182         if( config_flags%aer_op_opt > 0 ) then
 183            call wrf_message('WARNING: Invalid aer_op_opt. Defaulting to VOLUME_APPROX.')
 184            option_method=1
 185            option_mie=1
 186         end if
 187      END SELECT aer_op_opt_select
 188
 189      if( config_flags%aer_op_opt > 0 ) then
 190         call wrf_debug(15,'optical driver: call optical averaging')
 191 !        lunerr=-1
 192 !        write( msg, '(a, 6i4)' )       &
 193 !                 'jdf ', ids, ide, jds, jde, kds, kde
 194 !                 call peg_message( lunerr, msg )
 195 !        write( msg, '(a, 6i4)' )       &
 196 !                 'jdf ', ims, ime, jms, jme, kms, kme
 197 !                 call peg_message( lunerr, msg )
 198 !        write( msg, '(a, 6i4)' )       &
 199 !                 'jdf ', its, ite, jts, jte, kts, kte
 200 !                 call peg_message( lunerr, msg )
 201
 202         !BSINGH(PNNL)- The followingvariables had an undefined behavior at the boundaries.
 203         tauaersw(:,:,:,:) = inf
 204         extaersw(:,:,:,:) = inf
 205         gaersw(:,:,:,:)   = inf
 206         waersw(:,:,:,:)   = inf
 207         bscoefsw(:,:,:,:) = inf
 208         !long wave
 209         extaerlw(:,:,:,:) = inf
 210         tauaerlw(:,:,:,:) = inf
 211
 212         call optical_averaging(id,curr_secs,dtstep,config_flags,     &
 213              nbin_o,haveaer,option_method,option_mie,chem,dz8w,alt,  &
 214              relhum,h2oai,h2oaj,                                     &
 215 !czhao       tauaer1,tauaer2,tauaer3,tauaer4,                        &
 216 !            gaer1,gaer2,gaer3,gaer4,                                &
 217 !            waer1,waer2,waer3,waer4,                                &
 218 !            bscoef1,bscoef2,bscoef3,bscoef4,                        &
 219              tauaersw,extaersw,gaersw,waersw,bscoefsw,               &
 220              l2aer,l3aer,l4aer,l5aer,l6aer,l7aer,                    &
 221              totoa_a01,totoa_a02,totoa_a03,totoa_a04,                &
 222              totoa_a05,totoa_a06,totoa_a07,totoa_a08,                &
 223              tauaerlw,extaerlw,                                      &
 224              ids,ide, jds,jde, kds,kde,                              &
 225              ims,ime, jms,jme, kms,kme,                              &
 226              its,ite, jts,jte, kts,kte                               )
 227              !short wave
 228              tauaer1=tauaersw(:,:,:,1)
 229              tauaer2=tauaersw(:,:,:,2)
 230              tauaer3=tauaersw(:,:,:,3)
 231              tauaer4=tauaersw(:,:,:,4)
 232              extaer1=extaersw(:,:,:,1)
 233              extaer2=extaersw(:,:,:,2)
 234              extaer3=extaersw(:,:,:,3)
 235              extaer4=extaersw(:,:,:,4)
 236              gaer1=gaersw(:,:,:,1)
 237              gaer2=gaersw(:,:,:,2)
 238              gaer3=gaersw(:,:,:,3)
 239              gaer4=gaersw(:,:,:,4)
 240              waer1=waersw(:,:,:,1)
 241              waer2=waersw(:,:,:,2)
 242              waer3=waersw(:,:,:,3)
 243              waer4=waersw(:,:,:,4)
 244              bscoef1=bscoefsw(:,:,:,1)
 245              bscoef2=bscoefsw(:,:,:,2)
 246              bscoef3=bscoefsw(:,:,:,3)
 247              bscoef4=bscoefsw(:,:,:,4)
 248              !long wave
 249              extaerlw1=extaerlw(:,:,:,1)
 250              extaerlw2=extaerlw(:,:,:,2)
 251              extaerlw3=extaerlw(:,:,:,3)
 252              extaerlw4=extaerlw(:,:,:,4)
 253              extaerlw5=extaerlw(:,:,:,5)
 254              extaerlw6=extaerlw(:,:,:,6)
 255              extaerlw7=extaerlw(:,:,:,7)
 256              extaerlw8=extaerlw(:,:,:,8)
 257              extaerlw9=extaerlw(:,:,:,9)
 258              extaerlw10=extaerlw(:,:,:,10)
 259              extaerlw11=extaerlw(:,:,:,11)
 260              extaerlw12=extaerlw(:,:,:,12)
 261              extaerlw13=extaerlw(:,:,:,13)
 262              extaerlw14=extaerlw(:,:,:,14)
 263              extaerlw15=extaerlw(:,:,:,15)
 264              extaerlw16=extaerlw(:,:,:,16)
 265              tauaerlw1=tauaerlw(:,:,:,1)
 266              tauaerlw2=tauaerlw(:,:,:,2)
 267              tauaerlw3=tauaerlw(:,:,:,3)
 268              tauaerlw4=tauaerlw(:,:,:,4)
 269              tauaerlw5=tauaerlw(:,:,:,5)
 270              tauaerlw6=tauaerlw(:,:,:,6)
 271              tauaerlw7=tauaerlw(:,:,:,7)
 272              tauaerlw8=tauaerlw(:,:,:,8)
 273              tauaerlw9=tauaerlw(:,:,:,9)
 274              tauaerlw10=tauaerlw(:,:,:,10)
 275              tauaerlw11=tauaerlw(:,:,:,11)
 276              tauaerlw12=tauaerlw(:,:,:,12)
 277              tauaerlw13=tauaerlw(:,:,:,13)
 278              tauaerlw14=tauaerlw(:,:,:,14)
 279              tauaerlw15=tauaerlw(:,:,:,15)
 280              tauaerlw16=tauaerlw(:,:,:,16)
 281         call wrf_debug(15,'optical driver: after call optical averaging')
 282      else
 283         !If aer_op_opt==0 then the optical arrays are already set to
 284         !zero in chemics_init so there will not be a problem if the
 285         !user has selected aer_ra_feedback=1.
 286      end if
 287 !
 288    endif
 289    return
 290
 291 END SUBROUTINE optical_driver