Merge pull request #17 from RobertPincus/develop

New coefficient files including many more minor gas absorption coefficients.

examples/rfmip-clear-sky/mo_rfmip_io.F90

@@ -239,7 +239,7 @@ subroutine read_and_block_gases_ty(fileName, blocksize, gas_names, gas_conc_arra
     real(wp), dimension(:),     allocatable :: gas_conc_temp_1d
     real(wp), dimension(:,:,:), allocatable :: gas_conc_temp_3d
     character(len=32)                       :: gas_name_in_file
-    character(len=32), dimension(10) :: &
+    character(len=32), dimension(11) :: &
       chem_name = ['co   ', &
                    'ch4  ', &
         				   'o2   ', &
@@ -249,7 +249,8 @@ subroutine read_and_block_gases_ty(fileName, blocksize, gas_names, gas_conc_arra
         				   'CCl4 ', &
         				   'ch4  ', &
         				   'CH3Br', &
-   			           'CH3Cl'], &
+   			           'CH3Cl', &
+                   'cfc22'], &
       desc_name = ['carbon_monoxide     ', &
                    'methane             ', &
                    'oxygen              ', &
@@ -259,7 +260,8 @@ subroutine read_and_block_gases_ty(fileName, blocksize, gas_names, gas_conc_arra
         				   'carbon_tetrachloride', &
         				   'methane             ', &
         				   'methyl_bromide      ', &
-        				   'methyl_chloride     ']
+        				   'methyl_chloride     ', &
+                   'hcfc22              ']
     ! ---------------------------
     if(any([ncol_l, nlay_l, nexp_l]  == 0)) &
       call stop_on_err("read_and_block_lw_bc: Haven't read problem size yet.")
@@ -292,7 +294,10 @@ subroutine read_and_block_gases_ty(fileName, blocksize, gas_names, gas_conc_arra
     !
     do g = 1, size(gas_names)
       gas_name_in_file = trim(lower_case(gas_names(g)))
-      if(gas_name_in_file == 'h2o' .or. gas_name_in_file == 'o3') cycle
+      !
+      ! RRTMGP gas optics include NO2; RFMIP doesn't have this
+      !
+      if(gas_name_in_file == 'h2o' .or. gas_name_in_file == 'o3' .or. gas_name_in_file == 'no2') cycle
       !
       ! Use a mapping between chemical formula and name if it exists
       !
@@ -303,17 +308,17 @@ subroutine read_and_block_gases_ty(fileName, blocksize, gas_names, gas_conc_arra
       ! Read the values as a function of experiment
       gas_conc_temp_1d = read_field(ncid, gas_name_in_file, nexp_l) * read_scaling(ncid, gas_name_in_file)
 
-	  do b = 1, nblocks
-        ! Does every value in this block belong to the same experiment?
-	    if(all(exp_num(1,b) == exp_num(2:,b))) then
-	      ! Provide a scalar value
-		    call stop_on_err(gas_conc_array(b)%set_vmr(gas_names(g), gas_conc_temp_1d(exp_num(1,b))))
-		  else
-		  ! Create 2D field, blocksize x nlay, with scalar values from each experiment
-		  call stop_on_err(gas_conc_array(b)%set_vmr(gas_names(g), &
-		                                             spread(gas_conc_temp_1d(exp_num(:,b)), 2, ncopies = nlay_l)))
-		  end if
-	  end do
+  	  do b = 1, nblocks
+          ! Does every value in this block belong to the same experiment?
+  	    if(all(exp_num(1,b) == exp_num(2:,b))) then
+  	      ! Provide a scalar value
+  		    call stop_on_err(gas_conc_array(b)%set_vmr(gas_names(g), gas_conc_temp_1d(exp_num(1,b))))
+  		  else
+  		  ! Create 2D field, blocksize x nlay, with scalar values from each experiment
+  		  call stop_on_err(gas_conc_array(b)%set_vmr(gas_names(g), &
+  		                                             spread(gas_conc_temp_1d(exp_num(:,b)), 2, ncopies = nlay_l)))
+  		  end if
+  	  end do
 
     end do
     ncid = nf90_close(ncid)

rte/mo_optical_props.F90

@@ -619,9 +619,9 @@ function validate_nstream(this) result(err_message)
       err_message = "validate: tau values out of range"
     if(any_vals_outside  (varSizes(1), varSizes(2), varSizes(3), this%ssa,  0._wp, 1._wp)) &
       err_message = "validate: ssa values out of range"
-    if(any_vals_outside  (varSizes(1), varSizes(2), varSizes(3), this%p(2,:,:,:),  &
+    if(any_vals_outside  (varSizes(1), varSizes(2), varSizes(3), this%p(1,:,:,:),  &
                                                                            -1._wp, 1._wp)) &
-      err_message = "validate: p(2,:,:,:)  = g values out of range"
+      err_message = "validate: p(1,:,:,:)  = g values out of range"
 
     if(len_trim(err_message) > 0 .and. len_trim(this%get_name()) > 0) &
         err_message = trim(this%get_name()) // ': ' // trim(err_message)