Skip to content

Commit e07c439

Browse files
billsacksbillsacks
committed
Extract subroutine to remove duplication in med_io_read_FB
1 parent 3da6da8 commit e07c439

1 file changed

Lines changed: 61 additions & 59 deletions

File tree

‎mediator/med_io_mod.F90‎

Lines changed: 61 additions & 59 deletions
Original file line numberDiff line numberDiff line change
@@ -41,6 +41,7 @@ module med_io_mod
4141
! private member functions
4242
private :: med_io_file_exists
4343
private :: med_io_def_var_with_atts
44+
private :: med_io_read_1d_var
4445

4546
! public data members:
4647
interface med_io_read
@@ -1499,11 +1500,10 @@ subroutine med_io_read_FB(filename, vm, FB, pre, frame, rc)
14991500
use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS
15001501
use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_FieldBundleGet
15011502
use ESMF , only : ESMF_FieldGet, ESMF_MeshGet, ESMF_DistGridGet
1502-
use pio , only : file_desc_T, var_desc_t, io_desc_t, pio_nowrite, pio_openfile
1503-
use pio , only : pio_noerr, PIO_BCAST_ERROR, PIO_INTERNAL_ERROR
1504-
use pio , only : pio_inq_varid
1505-
use pio , only : pio_double, pio_get_att, pio_seterrorhandling, pio_freedecomp, pio_closefile
1506-
use pio , only : pio_read_darray, pio_offset_kind, pio_setframe
1503+
use pio , only : file_desc_T, io_desc_t, pio_nowrite, pio_openfile
1504+
use pio , only : PIO_BCAST_ERROR, PIO_INTERNAL_ERROR
1505+
use pio , only : pio_seterrorhandling, pio_freedecomp, pio_closefile
1506+
use pio , only : pio_offset_kind
15071507

15081508
! input/output arguments
15091509
character(len=*) ,intent(in) :: filename
@@ -1517,14 +1517,12 @@ subroutine med_io_read_FB(filename, vm, FB, pre, frame, rc)
15171517
type(ESMF_Field) :: lfield
15181518
integer :: rcode
15191519
integer :: nf
1520-
integer :: k,n,n2,l
1520+
integer :: k,n,n2
15211521
type(file_desc_t) :: pioid
1522-
type(var_desc_t) :: varid
15231522
type(io_desc_t) :: iodesc
15241523
character(CL) :: itemc ! string converted to char
15251524
character(CL) :: name1 ! var name
15261525
character(CL) :: lpre ! local prefix
1527-
real(r8) :: lfillvalue
15281526
integer :: rank, lsize
15291527
real(r8), pointer :: fldptr1(:), fldptr1_tmp(:)
15301528
real(r8), pointer :: fldptr2(:,:)
@@ -1650,23 +1648,8 @@ subroutine med_io_read_FB(filename, vm, FB, pre, frame, rc)
16501648
write(cnumber,'(i0)') n
16511649
write(cnumber2,'(i0)') n2
16521650
name1 = trim(lpre)//'_'//trim(itemc)//trim(cnumber)//'_'//trim(cnumber2)
1653-
1654-
rcode = pio_inq_varid(pioid, trim(name1), varid)
1655-
if (rcode == pio_noerr) then
1656-
call ESMF_LogWrite(trim(subname)//' read field '//trim(name1), ESMF_LOGMSG_INFO)
1657-
if (chkerr(rc,__LINE__,u_FILE_u)) return
1658-
call pio_setframe(pioid, varid, lframe)
1659-
call pio_read_darray(pioid, varid, iodesc, fldptr1_tmp, rcode)
1660-
rcode = pio_get_att(pioid, varid, "_FillValue", lfillvalue)
1661-
if (rcode /= pio_noerr) then
1662-
lfillvalue = fillvalue
1663-
endif
1664-
do l = 1,size(fldptr1_tmp)
1665-
if (fldptr1_tmp(l) == lfillvalue) fldptr1_tmp(l) = 0.0_r8
1666-
enddo
1667-
else
1668-
fldptr1_tmp = 0.0_r8
1669-
endif
1651+
call med_io_read_1d_var(pioid, name1, iodesc, lframe, fldptr1_tmp, rc)
1652+
if (chkerr(rc,__LINE__,u_FILE_u)) return
16701653
fldptr3(n,n2,:) = fldptr1_tmp(:)
16711654
end do
16721655
end do
@@ -1694,23 +1677,8 @@ subroutine med_io_read_FB(filename, vm, FB, pre, frame, rc)
16941677
! ungridded dimension index of the field bundle 2d field
16951678
write(cnumber,'(i0)') n
16961679
name1 = trim(lpre)//'_'//trim(itemc)//trim(cnumber)
1697-
1698-
rcode = pio_inq_varid(pioid, trim(name1), varid)
1699-
if (rcode == pio_noerr) then
1700-
call ESMF_LogWrite(trim(subname)//' read field '//trim(name1), ESMF_LOGMSG_INFO)
1701-
if (chkerr(rc,__LINE__,u_FILE_u)) return
1702-
call pio_setframe(pioid, varid, lframe)
1703-
call pio_read_darray(pioid, varid, iodesc, fldptr1_tmp, rcode)
1704-
rcode = pio_get_att(pioid, varid, "_FillValue", lfillvalue)
1705-
if (rcode /= pio_noerr) then
1706-
lfillvalue = fillvalue
1707-
endif
1708-
do l = 1,size(fldptr1_tmp)
1709-
if (fldptr1_tmp(l) == lfillvalue) fldptr1_tmp(l) = 0.0_r8
1710-
enddo
1711-
else
1712-
fldptr1_tmp = 0.0_r8
1713-
endif
1680+
call med_io_read_1d_var(pioid, name1, iodesc, lframe, fldptr1_tmp, rc)
1681+
if (chkerr(rc,__LINE__,u_FILE_u)) return
17141682
if (gridToFieldMap(1) == 1) then
17151683
fldptr2(:,n) = fldptr1_tmp(:)
17161684
else if (gridToFieldMap(1) == 2) then
@@ -1722,23 +1690,8 @@ subroutine med_io_read_FB(filename, vm, FB, pre, frame, rc)
17221690

17231691
else if (rank == 1) then
17241692
name1 = trim(lpre)//'_'//trim(itemc)
1725-
1726-
rcode = pio_inq_varid(pioid, trim(name1), varid)
1727-
if (rcode == pio_noerr) then
1728-
call ESMF_LogWrite(trim(subname)//' read field '//trim(name1), ESMF_LOGMSG_INFO)
1729-
if (chkerr(rc,__LINE__,u_FILE_u)) return
1730-
call pio_setframe(pioid,varid,lframe)
1731-
call pio_read_darray(pioid, varid, iodesc, fldptr1, rcode)
1732-
rcode = pio_get_att(pioid,varid,"_FillValue",lfillvalue)
1733-
if (rcode /= pio_noerr) then
1734-
lfillvalue = fillvalue
1735-
endif
1736-
do n = 1,size(fldptr1)
1737-
if (fldptr1(n) == lfillvalue) fldptr1(n) = 0.0_r8
1738-
enddo
1739-
else
1740-
fldptr1 = 0.0_r8
1741-
endif
1693+
call med_io_read_1d_var(pioid, name1, iodesc, lframe, fldptr1, rc)
1694+
if (chkerr(rc,__LINE__,u_FILE_u)) return
17421695
end if
17431696

17441697
enddo ! end of loop over fields
@@ -2214,6 +2167,7 @@ subroutine med_io_ymd2date_long(year,month,day,date)
22142167
if (year < 0) date = -date
22152168
end subroutine med_io_ymd2date_long
22162169

2170+
!===============================================================================
22172171
subroutine med_io_def_var_with_atts(io_file, name1, itemc, dimid, luse_float, lfillvalue, ltavg, rc)
22182172

22192173
!---------------
@@ -2261,4 +2215,52 @@ subroutine med_io_def_var_with_atts(io_file, name1, itemc, dimid, luse_float, lf
22612215

22622216
end subroutine med_io_def_var_with_atts
22632217

2218+
!===============================================================================
2219+
subroutine med_io_read_1d_var(pioid, name1, iodesc, lframe, fldptr, rc)
2220+
2221+
!---------------
2222+
! Read a 1-d variable from a netcdf file, replacing fill values with 0.
2223+
! If the variable is not found, the array is zeroed.
2224+
!---------------
2225+
2226+
use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS
2227+
use pio , only : var_desc_t, io_desc_t, pio_noerr, pio_offset_kind
2228+
use pio , only : pio_inq_varid, pio_setframe, pio_read_darray, pio_get_att
2229+
2230+
! input/output variables
2231+
type(file_desc_t) , intent(inout) :: pioid
2232+
character(len=*) , intent(in) :: name1
2233+
type(io_desc_t) , intent(inout) :: iodesc
2234+
integer(kind=PIO_OFFSET_KIND) , intent(in) :: lframe
2235+
real(r8) , intent(inout) :: fldptr(:)
2236+
integer , intent(out) :: rc
2237+
2238+
! local variables
2239+
type(var_desc_t) :: varid
2240+
integer :: rcode, l
2241+
real(r8) :: lfillvalue
2242+
character(*),parameter :: subName = '(med_io_read_1d_var) '
2243+
!-------------------------------------------------------------------------------
2244+
2245+
rc = ESMF_SUCCESS
2246+
2247+
rcode = pio_inq_varid(pioid, trim(name1), varid)
2248+
if (rcode == pio_noerr) then
2249+
call ESMF_LogWrite(trim(subname)//' read field '//trim(name1), ESMF_LOGMSG_INFO)
2250+
if (chkerr(rc,__LINE__,u_FILE_u)) return
2251+
call pio_setframe(pioid, varid, lframe)
2252+
call pio_read_darray(pioid, varid, iodesc, fldptr, rcode)
2253+
rcode = pio_get_att(pioid, varid, "_FillValue", lfillvalue)
2254+
if (rcode /= pio_noerr) then
2255+
lfillvalue = fillvalue
2256+
endif
2257+
do l = 1,size(fldptr)
2258+
if (fldptr(l) == lfillvalue) fldptr(l) = 0.0_r8
2259+
enddo
2260+
else
2261+
fldptr = 0.0_r8
2262+
endif
2263+
2264+
end subroutine med_io_read_1d_var
2265+
22642266
end module med_io_mod

0 commit comments

Comments
 (0)