MODULE nf_fread3d_mod ! !svn $Id: nf_fread3d.F 394 2009-09-04 20:26:15Z arango $ !================================================== Hernan G. Arango === ! Copyright (c) 2002-2009 The ROMS/TOMS Group ! ! Licensed under a MIT/X style license ! ! See License_ROMS.txt ! !======================================================================= ! ! ! This function reads in a generic floating point 3D array from an ! ! input NetCDF file. ! ! ! ! On Input: ! ! ! ! ng Nested grid number (integer) ! ! model Calling model identifier (integer) ! ! ncname NetCDF file name (string) ! ! ncid NetCDF file ID (integer) ! ! ncvname NetCDF variable name (string) ! ! ncvarid NetCDF variable ID (integer) ! ! tindex NetCDF time record index to read (integer) ! ! gtype C-grid type (integer) ! ! Vsize Variable dimensions in NetCDF file (integer 1D array) ! ! LBi I-dimension Lower bound (integer) ! ! UBi I-dimension Upper bound (integer) ! ! LBj J-dimension Lower bound (integer) ! ! UBj J-dimension Upper bound (integer) ! ! LBk K-dimension Lower bound (integer) ! ! UBk K-dimension Upper bound (integer) ! ! Ascl Factor to scale field after reading (real). ! ! Amask Land/Sea mask, if any (real 3D array) ! ! ! ! On Output: ! ! ! ! Amin Field minimum value (real) ! ! Amax Field maximum value (real) ! ! A Field to read in (real 3D array) ! ! nf_fread3d Error flag (integer) ! ! ! !======================================================================= ! implicit none CONTAINS ! !*********************************************************************** FUNCTION nf_fread3d (ng, model, ncname, ncid, & & ncvname, ncvarid, & & tindex, gtype, Vsize, & & LBi, UBi, LBj, UBj, LBk, UBk, & & Ascl, Amin, Amax, & & Amask, & & A) !*********************************************************************** ! USE mod_param USE mod_parallel USE mod_iounits USE mod_ncparam USE mod_netcdf USE mod_scalars ! USE distribute_mod, ONLY : mp_bcasti USE distribute_mod, ONLY : mp_scatter3d ! implicit none ! ! Imported variable declarations. ! integer, intent(in) :: ng, model, ncid, ncvarid, tindex, gtype integer, intent(in) :: LBi, UBi, LBj, UBj, LBk, UBk integer, intent(in) :: Vsize(4) real(r8), intent(in) :: Ascl real(r8), intent(out) :: Amin real(r8), intent(out) :: Amax character (len=*), intent(in) :: ncname character (len=*), intent(in) :: ncvname real(r8), intent(in) :: Amask(LBi:,LBj:) real(r8), intent(out) :: A(LBi:,LBj:,LBk:) ! ! Local variable declarations. ! logical, dimension(3) :: foundit integer :: i, j, k, ic, Npts, NWpts, status, wtype integer :: Imin, Imax, Jmin, Jmax, Koff integer :: Ilen, Jlen, Klen, IJlen, MyType integer :: Nghost integer, dimension(4) :: start, total integer :: nf_fread3d real(r8) :: Afactor, Aoffset, Aspval real(r8), dimension(3) :: AttValue real(r8), dimension(2+(Lm(ng)+2)*(Mm(ng)+2)*(UBk-LBk+1)) :: wrk character (len=12), dimension(3) :: AttName ! !----------------------------------------------------------------------- ! Set starting and ending indices to process. !----------------------------------------------------------------------- ! ! Set first and last grid point according to staggered C-grid ! classification. Set loops offsets. ! MyType=gtype SELECT CASE (ABS(MyType)) CASE (p2dvar, p3dvar) Imin=IOBOUNDS(ng)%ILB_psi Imax=IOBOUNDS(ng)%IUB_psi Jmin=IOBOUNDS(ng)%JLB_psi Jmax=IOBOUNDS(ng)%JUB_psi CASE (r2dvar, r3dvar, w3dvar) Imin=IOBOUNDS(ng)%ILB_rho Imax=IOBOUNDS(ng)%IUB_rho Jmin=IOBOUNDS(ng)%JLB_rho Jmax=IOBOUNDS(ng)%JUB_rho CASE (u2dvar, u3dvar) Imin=IOBOUNDS(ng)%ILB_u Imax=IOBOUNDS(ng)%IUB_u Jmin=IOBOUNDS(ng)%JLB_u Jmax=IOBOUNDS(ng)%JUB_u CASE (v2dvar, v3dvar) Imin=IOBOUNDS(ng)%ILB_v Imax=IOBOUNDS(ng)%IUB_v Jmin=IOBOUNDS(ng)%JLB_v Jmax=IOBOUNDS(ng)%JUB_v CASE DEFAULT Imin=IOBOUNDS(ng)%ILB_rho Imax=IOBOUNDS(ng)%IUB_rho Jmin=IOBOUNDS(ng)%JLB_rho Jmax=IOBOUNDS(ng)%JUB_rho END SELECT Ilen=Imax-Imin+1 Jlen=Jmax-Jmin+1 Klen=UBk-LBk+1 IJlen=Ilen*Jlen IF (LBk.eq.0) THEN Koff=0 ELSE Koff=1 END IF ! ! Check if the following attributes: "scale_factor", "add_offset", and ! "_FillValue" are present in the input NetCDF variable: ! ! If the "scale_value" attribute is present, the data is multiplied by ! this factor after reading. ! If the "add_offset" attribute is present, this value is added to the ! data after reading. ! If both "scale_factor" and "add_offset" attributes are present, the ! data are first scaled before the offset is added. ! If the "_FillValue" attribute is present, the data having this value ! is treated a missing and it is replaced with zero. This feature it is ! usually related with the land/sea masking. ! AttName(1)='scale_factor' AttName(2)='add_offset ' AttName(3)='_FillValue ' CALL netcdf_get_fatt (ng, model, ncname, ncvarid, AttName, & & AttValue, foundit, & & ncid = ncid) IF (exit_flag.ne.NoError) THEN nf_fread3d=ioerror RETURN END IF IF (.not.foundit(1)) THEN Afactor=1.0_r8 ELSE Afactor=AttValue(1) END IF IF (.not.foundit(2)) THEN Aoffset=0.0_r8 ELSE Aoffset=AttValue(2) END IF IF (.not.foundit(3)) THEN Aspval=spval_check ELSE Aspval=AttValue(3) END IF ! ! Set the number of tile ghost points, Nghost, to scatter in ! distributed-memory applications. If Nghost=0, the ghost points ! are not processed. They will be processed elsewhere by the ! appropriate call to any of the routines in "mp_exchange.F". ! IF (model.eq.iADM) THEN Nghost=0 ELSE Nghost=3 END IF ! ! Set NetCDF dimension counters for processing requested field. ! IF (MyType.gt.0) THEN start(1)=1 total(1)=Ilen start(2)=1 total(2)=Jlen start(3)=1 total(3)=Klen start(4)=tindex total(4)=1 Npts=IJlen Npts=Npts*Klen END IF ! ! Initialize local array to avoid denormalized numbers. This ! facilitates processing and debugging. ! wrk=0.0_r8 ! !----------------------------------------------------------------------- ! Serial I/O: Read in requested field and scale it. !----------------------------------------------------------------------- ! Amin=spval Amax=-spval status=nf90_noerr IF (InpThread) THEN status=nf90_get_var(ncid, ncvarid, wrk, start, total) IF (status.eq.nf90_noerr) THEN DO i=1,Npts IF (ABS(wrk(i)).ge.ABS(Aspval)) THEN wrk(i)=0.0_r8 ! masked with _FillValue ELSE wrk(i)=Ascl*(Afactor*wrk(i)+Aoffset) Amin=MIN(Amin,wrk(i)) Amax=MAX(Amax,wrk(i)) END IF END DO END IF END IF CALL mp_bcasti (ng, model, status) IF (status.ne.nf90_noerr) THEN exit_flag=2 ioerror=status nf_fread3d=status RETURN END IF ! !----------------------------------------------------------------------- ! Serial I/O: Unpack read field. !----------------------------------------------------------------------- ! CALL mp_scatter3d (ng, model, LBi, UBi, LBj, UBj, LBk, UBk, & & Nghost, MyType, Amin, Amax, & & Npts, wrk, A) nf_fread3d=status RETURN END FUNCTION nf_fread3d END MODULE nf_fread3d_mod