Skip to content

Commit

Permalink
Merge pull request #34 from GEOS-ESM/feature/wjamieson/Mie_table_rc
Browse files Browse the repository at this point in the history 
Better chem Mie table error checking
  • Loading branch information
@gmao-esherman
gmao-esherman authored Mar 10, 2021
2 parents f1a2307 + 9d232db commit 4759aa0
Showing 1 changed file with 53 additions and 48 deletions.
101 changes: 53 additions & 48 deletions Process_Library/Chem_MieTableMod2G.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -205,8 +205,10 @@ SUBROUTINE Chem_MieTableRead ( this, nch, channels, rc, nmom )

real :: yerr
integer :: nmom_, imom, ipol
integer :: status

#define NF_VERIFY_(expr) rc = expr; if (rc /= 0) return
#define __NF_STAT__ stat=status); NF_VERIFY_(status

rc = 0

Expand All @@ -228,6 +230,7 @@ SUBROUTINE Chem_MieTableRead ( this, nch, channels, rc, nmom )
rc = nf_open(this%mietablename, NF_NOWRITE, ncid)
IF ( rc /= 0 ) THEN
print *, 'nf_open '//this%mietablename//' RETURN CODE=', rc
NF_VERIFY_(rc)
END IF

! RH
Expand All @@ -253,7 +256,7 @@ SUBROUTINE Chem_MieTableRead ( this, nch, channels, rc, nmom )
if ( nmom_ > nmom_table ) then
! rc = 99
print*,'Error: nmom_ > nmom_table, see:'//myname
return
NF_VERIFY_(1)
end if
NF_VERIFY_(nf_inq_dimid(ncid,'nPol',idimid))
NF_VERIFY_(nf_inq_dimlen(ncid,idimid,nPol_table))
Expand All @@ -267,24 +270,24 @@ SUBROUTINE Chem_MieTableRead ( this, nch, channels, rc, nmom )
! bbck_table(nch_table,nrh_table,nbin_table), &
! g_table(nch_table,nrh_table,nbin_table), stat = rc )

allocate(channels_table(nch_table),stat = rc )
allocate(rh_table(nrh_table),stat = rc )
allocate(reff_table(nrh_table,nbin_table),stat = rc )
allocate(bext_table(nch_table,nrh_table,nbin_table),stat = rc )
allocate(bsca_table(nch_table,nrh_table,nbin_table),stat = rc )
allocate(bbck_table(nch_table,nrh_table,nbin_table), stat = rc )
allocate(channels_table(nch_table), __NF_STAT__)
allocate(rh_table(nrh_table), __NF_STAT__)
allocate(reff_table(nrh_table,nbin_table), __NF_STAT__)
allocate(bext_table(nch_table,nrh_table,nbin_table), __NF_STAT__)
allocate(bsca_table(nch_table,nrh_table,nbin_table), __NF_STAT__)
allocate(bbck_table(nch_table,nrh_table,nbin_table), __NF_STAT__)
allocate(g_table(nch_table,nrh_table,nbin_table), stat = rc )
allocate(pback_table(nch_table,nrh_table,nbin_table,nPol_table), stat = rc )
allocate(gf_table(nrh_table,nbin_table),stat = rc )
allocate(rhop_table(nrh_table,nbin_table),stat = rc )
allocate(rhod_table(nrh_table,nbin_table),stat = rc )
allocate(vol_table(nrh_table,nbin_table),stat = rc )
allocate(area_table(nrh_table,nbin_table),stat = rc )
allocate(refr_table(nch_table,nrh_table,nbin_table), stat = rc )
allocate(refi_table(nch_table,nrh_table,nbin_table), stat = rc )
allocate(pback_table(nch_table,nrh_table,nbin_table,nPol_table), __NF_STAT__)
allocate(gf_table(nrh_table,nbin_table), __NF_STAT__)
allocate(rhop_table(nrh_table,nbin_table), __NF_STAT__)
allocate(rhod_table(nrh_table,nbin_table), __NF_STAT__)
allocate(vol_table(nrh_table,nbin_table), __NF_STAT__)
allocate(area_table(nrh_table,nbin_table), __NF_STAT__)
allocate(refr_table(nch_table,nrh_table,nbin_table), __NF_STAT__)
allocate(refi_table(nch_table,nrh_table,nbin_table), __NF_STAT__)

if ( nmom_ > 0 ) then
allocate(pmom_table(nch_table,nrh_table,nbin_table,nmom_table,nPol_table), stat = rc )
allocate(pmom_table(nch_table,nrh_table,nbin_table,nmom_table,nPol_table), __NF_STAT__)
end if
NF_VERIFY_(nf_inq_varid(ncid,'lambda',ivarid))
NF_VERIFY_(nf_get_var_double(ncid,ivarid,channels_table))
Expand All @@ -301,6 +304,7 @@ SUBROUTINE Chem_MieTableRead ( this, nch, channels, rc, nmom )
NF_VERIFY_(nf_inq_varid(ncid,'rh',ivarid))
NF_VERIFY_(nf_get_var_double(ncid,ivarid,rh_table))

! TODO: we need to look at these NF_NOERR checks
! Get the backscatter phase function values
rc = nf_inq_varid(ncid,'pback',ivarid)
if(rc .ne. NF_NOERR) then ! pback not in table, fill in dummy variable
Expand Down Expand Up @@ -390,24 +394,24 @@ SUBROUTINE Chem_MieTableRead ( this, nch, channels, rc, nmom )
! this%g(this%nLambda,this%nrh,this%nbin), &
! stat = rc )

allocate (this%lambda(this%nLambda),stat = rc )
allocate (this%rh(this%nrh),stat = rc )
allocate (this%reff(this%nrh,this%nbin),stat = rc )
allocate (this%bext(this%nrh,this%nLambda,this%nbin),stat = rc )
allocate (this%bsca(this%nrh,this%nLambda,this%nbin),stat = rc )
allocate (this%bbck(this%nrh,this%nLambda,this%nbin),stat = rc )
allocate (this%g(this%nrh,this%nLambda,this%nbin), stat = rc )
allocate (this%pback(this%nrh,this%nLambda,this%nbin,this%nPol), stat = rc )
allocate (this%lambda(this%nLambda), __NF_STAT__)
allocate (this%rh(this%nrh), __NF_STAT__)
allocate (this%reff(this%nrh,this%nbin), __NF_STAT__)
allocate (this%bext(this%nrh,this%nLambda,this%nbin), __NF_STAT__)
allocate (this%bsca(this%nrh,this%nLambda,this%nbin), __NF_STAT__)
allocate (this%bbck(this%nrh,this%nLambda,this%nbin), __NF_STAT__)
allocate (this%g(this%nrh,this%nLambda,this%nbin), __NF_STAT__)
allocate (this%pback(this%nrh,this%nLambda,this%nbin,this%nPol), __NF_STAT__)
if ( nmom_ > 0 ) then
allocate (this%pmom(this%nrh,this%nLambda,this%nbin,this%nMom,this%nPol), stat = rc )
allocate (this%pmom(this%nrh,this%nLambda,this%nbin,this%nMom,this%nPol), __NF_STAT__)
end if
allocate (this%gf(this%nrh,this%nbin), stat = rc )
allocate (this%rhop(this%nrh,this%nbin), stat = rc )
allocate (this%rhod(this%nrh,this%nbin), stat = rc )
allocate (this%vol(this%nrh,this%nbin), stat = rc )
allocate (this%area(this%nrh,this%nbin), stat = rc )
allocate (this%refr(this%nrh,this%nLambda,this%nbin),stat = rc )
allocate (this%refi(this%nrh,this%nLambda,this%nbin),stat = rc )
allocate (this%gf(this%nrh,this%nbin), __NF_STAT__)
allocate (this%rhop(this%nrh,this%nbin), __NF_STAT__)
allocate (this%rhod(this%nrh,this%nbin), __NF_STAT__)
allocate (this%vol(this%nrh,this%nbin), __NF_STAT__)
allocate (this%area(this%nrh,this%nbin), __NF_STAT__)
allocate (this%refr(this%nrh,this%nLambda,this%nbin), __NF_STAT__)
allocate (this%refi(this%nrh,this%nLambda,this%nbin), __NF_STAT__)

! Preserve the full RH structure of the input table
this%rh(:) = rh_table(:)
Expand Down Expand Up @@ -491,24 +495,24 @@ SUBROUTINE Chem_MieTableRead ( this, nch, channels, rc, nmom )
! deallocate (channels_table, rh_table, bext_table, bsca_table, &
! bbck_table, g_table, stat = rc )

deallocate (channels_table, stat = rc )
deallocate (rh_table, stat = rc )
deallocate (reff_table, stat = rc )
deallocate (bext_table, stat = rc )
deallocate (bsca_table, stat = rc )
deallocate (bbck_table, stat = rc )
deallocate (g_table, stat = rc )
deallocate (pback_table, stat = rc )
deallocate (channels_table, __NF_STAT__)
deallocate (rh_table, __NF_STAT__)
deallocate (reff_table, __NF_STAT__)
deallocate (bext_table, __NF_STAT__)
deallocate (bsca_table, __NF_STAT__)
deallocate (bbck_table, __NF_STAT__)
deallocate (g_table, __NF_STAT__)
deallocate (pback_table, __NF_STAT__)
if ( nmom_ > 0 ) then
deallocate (pmom_table, stat = rc )
deallocate (pmom_table, __NF_STAT__)
endif
deallocate (gf_table, stat = rc )
deallocate (rhop_table, stat = rc )
deallocate (rhod_table, stat = rc )
deallocate (vol_table, stat = rc )
deallocate (area_table, stat = rc )
deallocate (refr_table, stat = rc )
deallocate (refi_table, stat = rc )
deallocate (gf_table, __NF_STAT__)
deallocate (rhop_table, __NF_STAT__)
deallocate (rhod_table, __NF_STAT__)
deallocate (vol_table, __NF_STAT__)
deallocate (area_table, __NF_STAT__)
deallocate (refr_table, __NF_STAT__)
deallocate (refi_table, __NF_STAT__)

return

Expand Down Expand Up @@ -844,6 +848,7 @@ subroutine Chem_MieQueryByIntWithpmom ( this, idx, channel, q_mass, rh, &
tau, ssa, gasym, bext, bsca, bbck, &
reff, p11, p22, gf, rhop, rhod, &
vol, area, refr, refi, rc )
NF_VERIFY_(rc)

pmom(:,:) = TABLE%pmom(irh ,ichannel,TYPE,:,:) * (1.-arh) &
+ TABLE%pmom(irhp1,ichannel,TYPE,:,:) * arh
Expand Down

0 comments on commit 4759aa0

Please sign in to comment.