chem/module_input_chem_bioemiss.F

   1 !dis
   2 !dis    Open Source License/Disclaimer, Forecast Systems Laboratory
   3 !dis    NOAA/OAR/FSL, 325 Broadway Boulder, CO 80305
   4 !dis
   5 !dis    This software is distributed under the Open Source Definition,
   6 !dis    which may be found at http://www.opensource.org/osd.html.
   7 !dis
   8 !dis    In particular, redistribution and use in source and binary forms,
   9 !dis    with or without modification, are permitted provided that the
  10 !dis    following conditions are met:
  11 !dis
  12 !dis    - Redistributions of source code must retain this notice, this
  13 !dis    list of conditions and the following disclaimer.
  14 !dis
  15 !dis    - Redistributions in binary form must provide access to this
  16 !dis    notice, this list of conditions and the following disclaimer, and
  17 !dis    the underlying source code.
  18 !dis
  19 !dis    - All modifications to this software must be clearly documented,
  20 !dis    and are solely the responsibility of the agent making the
  21 !dis    modifications.
  22 !dis
  23 !dis    - If significant modifications or enhancements are made to this
  24 !dis    software, the FSL Software Policy Manager
  25 !dis    (softwaremgr@fsl.noaa.gov) should be notified.
  26 !dis
  27 !dis    THIS SOFTWARE AND ITS DOCUMENTATION ARE IN THE PUBLIC DOMAIN
  28 !dis    AND ARE FURNISHED "AS IS."  THE AUTHORS, THE UNITED STATES
  29 !dis    GOVERNMENT, ITS INSTRUMENTALITIES, OFFICERS, EMPLOYEES, AND
  30 !dis    AGENTS MAKE NO WARRANTY, EXPRESS OR IMPLIED, AS TO THE USEFULNESS
  31 !dis    OF THE SOFTWARE AND DOCUMENTATION FOR ANY PURPOSE.  THEY ASSUME
  32 !dis    NO RESPONSIBILITY (1) FOR THE USE OF THE SOFTWARE AND
  33 !dis    DOCUMENTATION; OR (2) TO PROVIDE TECHNICAL SUPPORT TO USERS.
  34 !dis
  35 !dis
  36
  37 !WRF:PACKAGE:IO
  38
  39 MODULE module_input_chem_bioemiss
  40
  41     USE module_io_domain
  42     USE module_domain
  43     USE module_driver_constants
  44     USE module_state_description
  45     USE module_configure
  46     USE module_date_time
  47     USE module_wrf_error
  48     USE module_timing
  49     USE module_data_radm2
  50     USE module_aerosols_sorgam
  51     USE module_get_file_names
  52
  53
  54 CONTAINS
  55 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  56
  57 SUBROUTINE input_ext_chem_beis3_file (grid)
  58 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  59
  60    IMPLICIT NONE
  61
  62    TYPE(domain)           ::  grid
  63
  64    INTEGER ::  i,j,n,numfil,status,system
  65
  66    INTEGER :: ids, ide, jds, jde, kds, kde,    &
  67               ims, ime, jms, jme, kms, kme,    &
  68               ips, ipe, jps, jpe, kps, kpe
  69
  70    REAL, ALLOCATABLE, DIMENSION(:,:) :: emiss
  71
  72
  73
  74 ! Number of reference emission and LAI files to open
  75       PARAMETER(numfil=19)
  76
  77    CHARACTER (LEN=80) :: message
  78
  79    TYPE (grid_config_rec_type)              :: config_flags
  80
  81 ! Normalized biogenic emissions for standard conditions (moles compound/km^2/hr)
  82 !     REAL, DIMENSION(i,j) ::                                     &
  83 !              sebio_iso,sebio_oli,sebio_api,sebio_lim,sebio_xyl,   &
  84 !              sebio_hc3,sebio_ete,sebio_olt,sebio_ket,sebio_ald,   &
  85 !              sebio_hcho,sebio_eth,sebio_ora2,sebio_co,sebio_nr,   &
  86 !              noag_grow,noag_nongrow,nononag
  87
  88 ! Leaf area index for isoprene
  89 !     REAL, DIMENSION(i,j) ::  slai
  90
  91 ! Filenames of reference emissions and LAI
  92       CHARACTER*100 onefil
  93       CHARACTER*12 emfil(numfil)
  94       DATA emfil/'ISO','OLI','API','LIM','XYL','HC3','ETE','OLT',  &
  95         'KET','ALD','HCHO','ETH','ORA2','CO','NR',                 &
  96         'NOAG_GROW','NOAG_NONGROW','NONONAG','ISOP'/
  97
  98 !!!!!-------------------------------------------------------------------
  99
 100        ! Get grid dimensions
 101        CALL get_ijk_from_grid (  grid ,                        &
 102                                  ids, ide, jds, jde, kds, kde,    &
 103                                  ims, ime, jms, jme, kms, kme,    &
 104                                  ips, ipe, jps, jpe, kps, kpe    )
 105
 106      WRITE( message , FMT='(A,4I5)' ) ' DIMS: ',ids,ide-1,jds,jde-1
 107      CALL  wrf_message ( message )
 108
 109      ALLOCATE( emiss(ids:ide-1,jds:jde-1) )
 110
 111
 112 ! Loop over the file names
 113       DO n=1,numfil
 114
 115 !   Remove scratch unzipped file
 116        status=system('rm -f scratem*')
 117
 118 !   All reference emissions except NO
 119        IF(n.LE.15)THEN
 120         onefil='../../run/BIOREF_'//             &
 121          TRIM(ADJUSTL(emfil(n)))//'.gz'
 122 !   NO reference emissions
 123        ELSE IF(n.GE.16.AND.n.LE.18)THEN
 124         onefil='../../run/AVG_'//                &
 125          TRIM(ADJUSTL(emfil(n)))//'.gz'
 126 !   LAI
 127        ELSE
 128         onefil='../../run/LAI_'//                &
 129          TRIM(ADJUSTL(emfil(n)))//'S.gz'
 130        ENDIF
 131
 132 !   Copy selected file to scratch
 133        status=system('cp '//TRIM(ADJUSTL(onefil))//' scratem.gz')
 134
 135 !   Unzip scratch
 136        status=system('gunzip scratem')
 137
 138 !   Open scratch and read into appropriate array
 139        OPEN(26,FILE='scratem',FORM='FORMATTED')
 140        IF(n.EQ. 1) then
 141              READ(26,'(12E9.2)') emiss
 142              grid%sebio_iso(ids:ide-1,jds:jde-1) = emiss
 143        ENDIF
 144        IF(n.EQ. 2)then
 145               READ(26,'(12E9.2)') emiss
 146               grid%sebio_oli(ids:ide-1,jds:jde-1) = emiss
 147        ENDIF
 148        IF(n.EQ. 3)then
 149               READ(26,'(12E9.2)') emiss
 150               grid%sebio_api(ids:ide-1,jds:jde-1) = emiss
 151        ENDIF
 152        IF(n.EQ. 4)then
 153               READ(26,'(12E9.2)') emiss
 154               grid%sebio_lim(ids:ide-1,jds:jde-1) = emiss
 155        ENDIF
 156        IF(n.EQ. 5)then
 157               READ(26,'(12E9.2)') emiss
 158               grid%sebio_xyl(ids:ide-1,jds:jde-1) = emiss
 159        ENDIF
 160        IF(n.EQ. 6)then
 161               READ(26,'(12E9.2)') emiss
 162               grid%sebio_hc3(ids:ide-1,jds:jde-1) = emiss
 163        ENDIF
 164        IF(n.EQ. 7)then
 165               READ(26,'(12E9.2)') emiss
 166               grid%sebio_ete(ids:ide-1,jds:jde-1) = emiss
 167        ENDIF
 168        IF(n.EQ. 8)then
 169               READ(26,'(12E9.2)') emiss
 170               grid%sebio_olt(ids:ide-1,jds:jde-1) = emiss
 171        ENDIF
 172        IF(n.EQ. 9)then
 173               READ(26,'(12E9.2)') emiss
 174               grid%sebio_ket(ids:ide-1,jds:jde-1) = emiss
 175        ENDIF
 176        IF(n.EQ.10)then
 177               READ(26,'(12E9.2)') emiss
 178               grid%sebio_ald(ids:ide-1,jds:jde-1) = emiss
 179        ENDIF
 180        IF(n.EQ.11)then
 181               READ(26,'(12E9.2)') emiss
 182               grid%sebio_hcho(ids:ide-1,jds:jde-1) = emiss
 183        ENDIF
 184        IF(n.EQ.12)then
 185               READ(26,'(12E9.2)') emiss
 186               grid%sebio_eth(ids:ide-1,jds:jde-1) = emiss
 187        ENDIF
 188        IF(n.EQ.13)then
 189               READ(26,'(12E9.2)') emiss
 190               grid%sebio_ora2(ids:ide-1,jds:jde-1) = emiss
 191        ENDIF
 192        IF(n.EQ.14)then
 193               READ(26,'(12E9.2)') emiss
 194               grid%sebio_co(ids:ide-1,jds:jde-1) = emiss
 195        ENDIF
 196        IF(n.EQ.15)then
 197               READ(26,'(12E9.2)') emiss
 198               grid%sebio_nr(ids:ide-1,jds:jde-1) = emiss
 199        ENDIF
 200        IF(n.EQ.16)then
 201               READ(26,'(12E9.2)') emiss
 202               grid%noag_grow(ids:ide-1,jds:jde-1) = emiss
 203        ENDIF
 204        IF(n.EQ.17)then
 205               READ(26,'(12E9.2)') emiss
 206               grid%noag_nongrow(ids:ide-1,jds:jde-1) = emiss
 207        ENDIF
 208        IF(n.EQ.18)then
 209               READ(26,'(12E9.2)') emiss
 210               grid%nononag(ids:ide-1,jds:jde-1) = emiss
 211        ENDIF
 212        IF(n.EQ.19)then
 213               READ(26,'(12E9.2)') emiss
 214               grid%slai(ids:ide-1,jds:jde-1) = emiss
 215        ENDIF
 216        CLOSE(26)
 217
 218       ENDDO
 219 ! End of loop over file names
 220
 221     DEALLOCATE( emiss )
 222
 223 END SUBROUTINE input_ext_chem_beis3_file
 224 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 225
 226 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 227 SUBROUTINE input_ext_chem_megan2_file (grid)
 228
 229   !
 230   !  This subroutine reads in an ASCII file of variables that are needed
 231   !  as input for biogenic emissions model MEGAN version 2. The
 232   !  variables are:
 233   !
 234   !      Isoprene emissions at referenece tempperature and
 235   !          light conditions [=] moles/km2/hr
 236   !      Leaf area index (one each month)
 237   !      Plant functional groups
 238   !       Broadleaf trees
 239   !       Needleleave trees
 240   !       Shrubs and Bushes
 241   !       Herbs
 242   !     "Climatological" variables:
 243   !        Monthly surface air temperature [=] K
 244   !        Monthly downward solar radiation [=] W/m2
 245   !
 246   !  April, 2007 Serena H. Chung and Christine Wiedinmyer
 247   !
 248
 249
 250
 251    IMPLICIT NONE
 252
 253    TYPE(domain)           ::  grid
 254
 255    INTEGER ::  i,j,v,status,system, itmp, jtmp
 256
 257    INTEGER :: ids, ide, jds, jde, kds, kde,    &
 258               ims, ime, jms, jme, kms, kme,    &
 259               ips, ipe, jps, jpe, kps, kpe
 260
 261    REAL, ALLOCATABLE, DIMENSION(:,:,:) :: emiss
 262
 263    CHARACTER (LEN=80) :: message
 264
 265    TYPE (grid_config_rec_type)              :: config_flags
 266
 267
 268    ! Variables "Pointers"
 269    ! The order must follow that of the ASCII input file
 270    integer, parameter :: n_mgnin = 41
 271    integer, parameter ::        & ! Pointer for :
 272         &  mgnin_isop     =  1  & !  isoprene reference emissions
 273         & ,mgnin_lai01    =  2  & !  Leaf area index for January
 274         & ,mgnin_lai02    =  3  & !                      February
 275         & ,mgnin_lai03    =  4  & !                      March
 276         & ,mgnin_lai04    =  5  & !                      April
 277         & ,mgnin_lai05    =  6  & !                      May
 278         & ,mgnin_lai06    =  7  & !                      June
 279         & ,mgnin_lai07    =  8  & !                      July
 280         & ,mgnin_lai08    =  9  & !                      August
 281         & ,mgnin_lai09    = 10  & !                      September
 282         & ,mgnin_lai10    = 11  & !                      October
 283         & ,mgnin_lai11    = 12  & !                      November
 284         & ,mgnin_lai12    = 13  & !                      December
 285         & ,mgnin_pftp_bt  = 14  & ! plant functional type % for broadleaf trees
 286         & ,mgnin_pftp_nt  = 15  & !                             needleleaf trees
 287         & ,mgnin_pftp_sb  = 16  & !                             shrubs and bushes
 288         & ,mgnin_pftp_hb  = 17  & !                             herbs
 289         & ,mgnin_tsa01    = 18  & ! monthly-mean surface air temperature for January
 290         & ,mgnin_tsa02    = 19  & !                                           February
 291         & ,mgnin_tsa03    = 20  & !                                           March
 292         & ,mgnin_tsa04    = 21  & !                                           April
 293         & ,mgnin_tsa05    = 22  & !                                           May
 294         & ,mgnin_tsa06    = 23  & !                                           June
 295         & ,mgnin_tsa07    = 24  & !                                           July
 296         & ,mgnin_tsa08    = 25  & !                                           August
 297         & ,mgnin_tsa09    = 26  & !                                           September
 298         & ,mgnin_tsa10    = 27  & !                                           October
 299         & ,mgnin_tsa11    = 28  & !                                           November
 300         & ,mgnin_tsa12    = 29  & !                                           December
 301         & ,mgnin_swdown01 = 30  & !  monthl-mean solar irradiance at surface for January
 302         & ,mgnin_swdown02 = 31  & !                                              February
 303         & ,mgnin_swdown03 = 32  & !                                              March
 304         & ,mgnin_swdown04 = 33  & !                                              April
 305         & ,mgnin_swdown05 = 34  & !                                              May
 306         & ,mgnin_swdown06 = 35  & !                                              June
 307         & ,mgnin_swdown07 = 36  & !                                              July
 308         & ,mgnin_swdown08 = 37  & !                                              August
 309         & ,mgnin_swdown09 = 38  & !                                              September
 310         & ,mgnin_swdown10 = 39  & !                                              October
 311         & ,mgnin_swdown11 = 40  & !                                              November
 312         & ,mgnin_swdown12 = 41    !                                              December
 313
 314       CHARACTER*100 onefil
 315
 316 !!!!!-------------------------------------------------------------------
 317
 318        ! Get grid dimensions
 319        CALL get_ijk_from_grid (  grid ,                           &
 320                                  ids, ide, jds, jde, kds, kde,    &
 321                                  ims, ime, jms, jme, kms, kme,    &
 322                                  ips, ipe, jps, jpe, kps, kpe    )
 323
 324      WRITE( message , FMT='(A,4I5)' ) ' in input_ext_chem_megan2_file, DIMS: ',ids,ide-1,jds,jde-1
 325      CALL  wrf_message ( message )
 326
 327      ALLOCATE( emiss(ids:ide-1,jds:jde-1,n_mgnin) )
 328
 329      ! Remove scratch file
 330 !    status=system('rm -f scratem*')
 331
 332
 333      !   Copy selected file to scratch
 334      onefil='MEGAN_input_WRFchem.txt'
 335 !    status=system('cp '//TRIM(ADJUSTL(onefil))//' scratem')
 336
 337      !   Open scratch and read into appropriate array
 338 !    OPEN(26,FILE='scratem',FORM='FORMATTED', status='old')
 339      OPEN(26,FILE=trim(onefil),FORM='FORMATTED', status='old')
 340
 341      ! The following follows the file format provided by Christine Wiedinmyer
 342
 343      do i = ids, ide-1
 344         do j = jds, jde-1
 345            read (26, FMT='(2(I5,1x),41(ES11.2,1x))') itmp, jtmp, (emiss(i,j,v),v=1,n_mgnin)
 346            ! redundant to be sure
 347            if ( (i /= itmp) .or. j /= jtmp ) then
 348               WRITE( message , FMT='(A,I3,I3,A,I3,I3)' ) 'Something is wrong (i,j) = ',i,j,"itmp, jtmp = ",itmp,jtmp
 349               call wrf_error_fatal(message)
 350            end if
 351         end do
 352      end do
 353
 354
 355      ! Isoprene emissions at standard conditions [=] mol/km2/hr
 356      grid%msebio_isop(ids:ide-1,jds:jde-1) = emiss(ids:ide-1,jds:jde-1,mgnin_isop)
 357      ! Leaf area index for each month
 358      grid%mlai    (ids:ide-1,jds:jde-1,01) = emiss(ids:ide-1,jds:jde-1,mgnin_lai01)
 359      grid%mlai    (ids:ide-1,jds:jde-1,02) = emiss(ids:ide-1,jds:jde-1,mgnin_lai02)
 360      grid%mlai    (ids:ide-1,jds:jde-1,03) = emiss(ids:ide-1,jds:jde-1,mgnin_lai03)
 361      grid%mlai    (ids:ide-1,jds:jde-1,04) = emiss(ids:ide-1,jds:jde-1,mgnin_lai04)
 362      grid%mlai    (ids:ide-1,jds:jde-1,05) = emiss(ids:ide-1,jds:jde-1,mgnin_lai05)
 363      grid%mlai    (ids:ide-1,jds:jde-1,06) = emiss(ids:ide-1,jds:jde-1,mgnin_lai06)
 364      grid%mlai    (ids:ide-1,jds:jde-1,07) = emiss(ids:ide-1,jds:jde-1,mgnin_lai07)
 365      grid%mlai    (ids:ide-1,jds:jde-1,08) = emiss(ids:ide-1,jds:jde-1,mgnin_lai08)
 366      grid%mlai    (ids:ide-1,jds:jde-1,09) = emiss(ids:ide-1,jds:jde-1,mgnin_lai09)
 367      grid%mlai    (ids:ide-1,jds:jde-1,10) = emiss(ids:ide-1,jds:jde-1,mgnin_lai10)
 368      grid%mlai    (ids:ide-1,jds:jde-1,11) = emiss(ids:ide-1,jds:jde-1,mgnin_lai11)
 369      grid%mlai    (ids:ide-1,jds:jde-1,12) = emiss(ids:ide-1,jds:jde-1,mgnin_lai12)
 370      ! Plant functional group percentage
 371      grid%pftp_bt  (ids:ide-1,jds:jde-1) = emiss(ids:ide-1,jds:jde-1,mgnin_pftp_bt)
 372      grid%pftp_nt  (ids:ide-1,jds:jde-1) = emiss(ids:ide-1,jds:jde-1,mgnin_pftp_nt)
 373      grid%pftp_sb  (ids:ide-1,jds:jde-1) = emiss(ids:ide-1,jds:jde-1,mgnin_pftp_sb)
 374      grid%pftp_hb  (ids:ide-1,jds:jde-1) = emiss(ids:ide-1,jds:jde-1,mgnin_pftp_hb)
 375      ! "Climatological" monthly mean surface air temperature [=] K
 376      ! (Note: The height of surface air temperature is not considered important;
 377      !        this is not needed if online 24-hour average values are used
 378      grid%mtsa    (ids:ide-1,jds:jde-1,01) = emiss(ids:ide-1,jds:jde-1,mgnin_tsa01)
 379      grid%mtsa    (ids:ide-1,jds:jde-1,02) = emiss(ids:ide-1,jds:jde-1,mgnin_tsa02)
 380      grid%mtsa    (ids:ide-1,jds:jde-1,03) = emiss(ids:ide-1,jds:jde-1,mgnin_tsa03)
 381      grid%mtsa    (ids:ide-1,jds:jde-1,04) = emiss(ids:ide-1,jds:jde-1,mgnin_tsa04)
 382      grid%mtsa    (ids:ide-1,jds:jde-1,05) = emiss(ids:ide-1,jds:jde-1,mgnin_tsa05)
 383      grid%mtsa    (ids:ide-1,jds:jde-1,06) = emiss(ids:ide-1,jds:jde-1,mgnin_tsa06)
 384      grid%mtsa    (ids:ide-1,jds:jde-1,07) = emiss(ids:ide-1,jds:jde-1,mgnin_tsa07)
 385      grid%mtsa    (ids:ide-1,jds:jde-1,08) = emiss(ids:ide-1,jds:jde-1,mgnin_tsa08)
 386      grid%mtsa    (ids:ide-1,jds:jde-1,09) = emiss(ids:ide-1,jds:jde-1,mgnin_tsa09)
 387      grid%mtsa    (ids:ide-1,jds:jde-1,10) = emiss(ids:ide-1,jds:jde-1,mgnin_tsa10)
 388      grid%mtsa    (ids:ide-1,jds:jde-1,11) = emiss(ids:ide-1,jds:jde-1,mgnin_tsa11)
 389      grid%mtsa    (ids:ide-1,jds:jde-1,12) = emiss(ids:ide-1,jds:jde-1,mgnin_tsa12)
 390      ! "Climatological" monthly mean downward irradiance at the surface [=] W/m2
 391      !  This is not needed if online 24-hour average values are used
 392      grid%mswdown (ids:ide-1,jds:jde-1,01) = emiss(ids:ide-1,jds:jde-1,mgnin_swdown01)
 393      grid%mswdown (ids:ide-1,jds:jde-1,02) = emiss(ids:ide-1,jds:jde-1,mgnin_swdown02)
 394      grid%mswdown (ids:ide-1,jds:jde-1,03) = emiss(ids:ide-1,jds:jde-1,mgnin_swdown03)
 395      grid%mswdown (ids:ide-1,jds:jde-1,04) = emiss(ids:ide-1,jds:jde-1,mgnin_swdown04)
 396      grid%mswdown (ids:ide-1,jds:jde-1,05) = emiss(ids:ide-1,jds:jde-1,mgnin_swdown05)
 397      grid%mswdown (ids:ide-1,jds:jde-1,06) = emiss(ids:ide-1,jds:jde-1,mgnin_swdown06)
 398      grid%mswdown (ids:ide-1,jds:jde-1,07) = emiss(ids:ide-1,jds:jde-1,mgnin_swdown07)
 399      grid%mswdown (ids:ide-1,jds:jde-1,08) = emiss(ids:ide-1,jds:jde-1,mgnin_swdown08)
 400      grid%mswdown (ids:ide-1,jds:jde-1,09) = emiss(ids:ide-1,jds:jde-1,mgnin_swdown09)
 401      grid%mswdown (ids:ide-1,jds:jde-1,10) = emiss(ids:ide-1,jds:jde-1,mgnin_swdown10)
 402      grid%mswdown (ids:ide-1,jds:jde-1,11) = emiss(ids:ide-1,jds:jde-1,mgnin_swdown11)
 403      grid%mswdown (ids:ide-1,jds:jde-1,12) = emiss(ids:ide-1,jds:jde-1,mgnin_swdown12)
 404
 405
 406
 407
 408     DEALLOCATE( emiss )
 409
 410   end SUBROUTINE input_ext_chem_megan2_file
 411
 412 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 413
 414
 415 END MODULE module_input_chem_bioemiss
 416