LCOV - code coverage report
Current view: | top level - unit_drivers - drv_input_data.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 0 | 97 | 0.0 %
Date: | 2024-12-17 22:39:59 |  | Functions: | 0 | 13 | 0.0 %

              Line data    Source code
           1             : !================================================================================
           2             : ! utility module for driver input data
           3             : !================================================================================
           4             : module drv_input_data
           5             :
           6             :   use shr_kind_mod,     only: r8=>SHR_KIND_R8, cl=>SHR_KIND_CL, cs=>SHR_KIND_CS
           7             :   use cam_abortutils,   only: endrun
           8             :   use spmd_utils,       only: masterproc
           9             :   use ppgrid,           only: pcols, pver, pverp, begchunk, endchunk
          10             :   use cam_logfile,      only: iulog
          11             :   use pio,              only: file_desc_t
          12             :   use time_manager,     only: get_step_size
          13             :
          14             :   implicit none
          15             :   private
          16             :   save
          17             :
          18             :   public :: drv_input_data_open
          19             :   public :: drv_input_data_read
          20             :   public :: drv_input_data_close
          21             :   public :: drv_input_data_freq
          22             :   public :: drv_input_data_t
          23             :   public :: drv_input_data_get
          24             :
          25             :   public :: drv_input_4d_t
          26             :   public :: drv_input_3d_t
          27             :   public :: drv_input_2d_t
          28             :   public :: drv_input_2di_t
          29             :
          30             :   interface drv_input_data_get
          31             :     module procedure get_data3d
          32             :     module procedure get_data2d
          33             :     module procedure get_idata2d
          34             :   end interface
          35             :
          36             :   real(r8) :: drv_input_data_freq != nan
          37             :
          38             :   type drv_input_data_t
          39             :      integer :: ntimes
          40             :      integer, allocatable :: dates(:)
          41             :      integer, allocatable :: secs(:)
          42             :      real(r8), allocatable :: times(:)
          43             :      type(file_desc_t) :: piofile
          44             :   endtype drv_input_data_t
          45             :
          46             :   type drv_input_4d_t
          47             :      real(r8), pointer :: array(:,:,:)
          48             :   endtype drv_input_4d_t
          49             :   type drv_input_3d_t
          50             :      real(r8), pointer :: array(:,:)
          51             :   endtype drv_input_3d_t
          52             :   type drv_input_2d_t
          53             :      real(r8), pointer :: array(:)
          54             :   endtype drv_input_2d_t
          55             :   type drv_input_2di_t
          56             :      integer, pointer :: array(:)
          57             :   endtype drv_input_2di_t
          58             :
          59             :   character(len=4) :: lonname = ' '
          60             :   character(len=4) :: latname = ' '
          61             :
          62             :   interface drv_input_data_read
          63             :     module procedure drv_input_data_read_2d
          64             :     module procedure drv_input_data_read_3d
          65             :   end interface
          66             :
          67             : contains
          68             :
          69             : !=================================================================================
          70             : !=================================================================================
          71           0 :   subroutine drv_input_data_open( infile, indata )
          72             :
          73             :     use cam_pio_utils, only: cam_pio_openfile
          74             :     use pio,           only: PIO_NOCLOBBER, pio_inq_dimid, pio_inq_dimlen
          75             :     use pio,           only: pio_inq_varid, pio_get_var
          76             :     use pio,           only: pio_seterrorhandling, PIO_INTERNAL_ERROR, PIO_BCAST_ERROR, PIO_NOERR
          77             :     use dyn_grid,      only: get_horiz_grid_dim_d
          78             :
          79             :     implicit none
          80             :
          81             :     character(len=*), intent(in) :: infile
          82             :     type(drv_input_data_t), intent(out) :: indata
          83             :
          84             :     integer :: id, ierr
          85             :     integer :: hdim1_d,hdim2_d, nlons
          86             :     integer :: dtime
          87             :     integer :: data_dtime
          88             :     character(len=*), parameter :: sub = 'drv_input_data_open: '
          89             :
          90           0 :     dtime = get_step_size()
          91             :
          92             :     ! open file and get fileid
          93             :     !
          94           0 :     call cam_pio_openfile( indata%piofile, infile, PIO_NOCLOBBER)
          95             :
          96           0 :     if(masterproc) write(iulog,*) sub // 'opened: ',trim(infile)
          97             :
          98             :     !
          99             :     ! check horizontal grid ...
         100             :     !
         101           0 :     call pio_seterrorhandling( indata%piofile, PIO_BCAST_ERROR)
         102           0 :     lonname = 'ncol'
         103           0 :     latname =  ' '
         104           0 :     ierr = pio_inq_dimid( indata%piofile, lonname, id )
         105           0 :     if (ierr/=PIO_NOERR) then
         106           0 :        lonname = 'lon'
         107           0 :        latname = 'lat'
         108             :     endif
         109             :
         110           0 :     ierr = pio_inq_dimid( indata%piofile, lonname, id )
         111           0 :     if (ierr/=PIO_NOERR) call endrun(sub//'failed to find dimid for lonname')
         112           0 :     ierr = pio_inq_dimlen( indata%piofile, id, nlons )
         113           0 :     if (ierr/=PIO_NOERR) call endrun(sub//'failed to find dimlen for lonname')
         114             :
         115           0 :     call get_horiz_grid_dim_d(hdim1_d,hdim2_d)
         116             :
         117           0 :     if (hdim1_d /= nlons) then
         118           0 :       call endrun('drv_input_data_open: input file has incorrect horizontal resolution')
         119             :     endif
         120             :
         121             :     !
         122             :     ! get time/date info ...
         123             :     !
         124           0 :     ierr = pio_inq_dimid( indata%piofile, 'time', id )
         125           0 :     if (ierr/=PIO_NOERR) call endrun(sub//'failed to find dimid for time')
         126           0 :     ierr = pio_inq_dimlen( indata%piofile, id, indata%ntimes )
         127           0 :     if (ierr/=PIO_NOERR) call endrun(sub//'failed to find dimlen for time')
         128             :
         129           0 :     allocate( indata%dates(indata%ntimes), indata%secs(indata%ntimes), indata%times(indata%ntimes) )
         130             :
         131           0 :     ierr = pio_inq_varid( indata%piofile, 'date',  id  )
         132           0 :     if (ierr/=PIO_NOERR) call endrun(sub//'failed to find varid for date')
         133           0 :     ierr = pio_get_var( indata%piofile, id, indata%dates )
         134           0 :     if (ierr/=PIO_NOERR) call endrun(sub//'failed to get values for date')
         135             :
         136           0 :     ierr = pio_inq_varid( indata%piofile, 'datesec',  id  )
         137           0 :     if (ierr/=PIO_NOERR) call endrun(sub//'failed to find varid for datesec')
         138           0 :     ierr = pio_get_var( indata%piofile, id, indata%secs )
         139           0 :     if (ierr/=PIO_NOERR) call endrun(sub//'failed to get values for datesec')
         140             :
         141           0 :     ierr = pio_inq_varid( indata%piofile, 'time',  id  )
         142           0 :     if (ierr/=PIO_NOERR) call endrun(sub//'failed to find varid for time')
         143           0 :     ierr = pio_get_var( indata%piofile, id, indata%times )
         144           0 :     if (ierr/=PIO_NOERR) call endrun(sub//'failed to get values for time')
         145             :
         146           0 :     ierr = pio_inq_varid( indata%piofile, 'mdt',  id  )
         147           0 :     if (ierr/=PIO_NOERR) call endrun(sub//'failed to find varid for mdt')
         148           0 :     ierr = pio_get_var( indata%piofile, id, data_dtime )
         149           0 :     if (ierr/=PIO_NOERR) call endrun(sub//'failed to get value for mdt')
         150             :
         151           0 :     call pio_seterrorhandling( indata%piofile, PIO_INTERNAL_ERROR)
         152             :
         153           0 :     if ( .not. (data_dtime == dtime)) then
         154           0 :        write( iulog, * )  sub//'data mdt does not match dtime... use dtime = ', data_dtime
         155           0 :        call endrun(sub//'data mdt does not match dtime.')
         156             :     endif
         157             :
         158           0 :   end subroutine drv_input_data_open
         159             :
         160             : !================================================================================================
         161             : !================================================================================================
         162           0 :   subroutine drv_input_data_close(indata)
         163           0 :     use pio, only: pio_closefile
         164             :     implicit none
         165             :
         166             :     type(drv_input_data_t), intent(inout) :: indata
         167             :
         168           0 :     deallocate( indata%dates, indata%secs, indata%times )
         169             :
         170           0 :     call pio_closefile( indata%piofile )
         171             :
         172           0 :   end subroutine drv_input_data_close
         173             :
         174             :   !=================================================================================
         175             :   !=================================================================================
         176           0 :   function drv_input_data_read_2d( indata, fldname, recno, abort ) result(field_array)
         177             :     use ncdio_atm,        only: infld
         178             :
         179             :     implicit none
         180             :
         181             :     type(drv_input_data_t), intent(inout) :: indata
         182             :     character(len=*), intent(in) :: fldname
         183             :     integer,          intent(in) :: recno
         184             :     logical, optional,intent(in) :: abort
         185             :
         186             :     logical  :: found, abort_run
         187             :     real(r8) :: field_array(pcols,begchunk:endchunk)
         188             :
         189           0 :     abort_run = .false.
         190           0 :     if (present(abort)) then
         191           0 :        abort_run = abort
         192             :     endif
         193             :
         194             :     call infld( fldname, indata%piofile, trim(lonname), trim(latname), 1,pcols, begchunk,endchunk, &
         195           0 :                 field_array, found, gridname='physgrid',timelevel=recno)
         196             :
         197           0 :     if (.not.found) then
         198           0 :        if ( abort_run ) then
         199           0 :           call endrun('drv_input_data_read_2d: did not find '// trim(fldname))
         200             :        else
         201           0 :           if (masterproc) write( iulog, * )  'drv_input_data_read_2d: ' // trim(fldname) // ' set to zero '
         202           0 :           field_array = 0._r8
         203             :        endif
         204             :     endif
         205             :
         206           0 :   endfunction drv_input_data_read_2d
         207             :
         208             :   !=================================================================================
         209             :   !=================================================================================
         210           0 :   function drv_input_data_read_3d( indata, fldname, vertname, vertsize, recno, abort ) result(field_array)
         211           0 :     use ncdio_atm,        only: infld
         212             :     implicit none
         213             :
         214             :     type(drv_input_data_t), intent(inout) :: indata
         215             :     character(len=*), intent(in) :: fldname
         216             :     character(len=*), intent(in) :: vertname
         217             :     integer,          intent(in) :: vertsize
         218             :     integer,          intent(in) :: recno
         219             :     logical, optional,intent(in) :: abort
         220             :
         221             :     logical  :: found, abort_run
         222             :     real(r8) :: field_array(pcols,vertsize,begchunk:endchunk)
         223             :
         224             :     real(r8), allocatable :: tmp_array(:,:,:)
         225             :
         226           0 :     abort_run = .false.
         227           0 :     if (present(abort)) then
         228           0 :        abort_run = abort
         229             :     endif
         230             :
         231             :     call infld( fldname, indata%piofile, lonname, vertname, latname, 1,pcols, 1,vertsize, begchunk,endchunk, &
         232           0 :                 field_array, found, gridname='physgrid',timelevel=recno)
         233             :
         234           0 :     if (.not.found) then
         235           0 :        if ( abort_run ) then
         236           0 :           call endrun('drv_input_data_read_3d: did not find '// trim(fldname))
         237             :        else
         238           0 :           if (masterproc) write( iulog, * )  'drv_input_data_read_3d: ' // trim(fldname) // ' set to zero '
         239           0 :           field_array = 0._r8
         240             :        endif
         241             :     endif
         242             :
         243           0 :   endfunction drv_input_data_read_3d
         244             :
         245             :   !================================================================================================
         246             :   !================================================================================================
         247           0 :   subroutine get_data3d(indata, infld_name, lev_name, nlev, recno, chunk_ptrs)
         248             :
         249             :     type(drv_input_data_t), intent(inout) :: indata
         250             :     character(len=*),       intent(in)    :: infld_name
         251             :     character(len=*),       intent(in)    :: lev_name
         252             :     integer,                intent(in)    :: nlev
         253             :     integer,                intent(in)    :: recno
         254             :     type(drv_input_3d_t),   intent(inout) :: chunk_ptrs(begchunk:endchunk)
         255             :
         256           0 :     real(r8), allocatable :: data (:,:,:)
         257             :
         258             :     integer :: c, ncol
         259             :
         260           0 :     allocate( data (pcols, nlev,  begchunk:endchunk) )
         261             :
         262           0 :     data = drv_input_data_read( indata, infld_name, lev_name, nlev, recno )
         263           0 :     do c=begchunk,endchunk
         264           0 :        chunk_ptrs(c)%array(:,:) = data(:,:,c)
         265             :     enddo
         266             :
         267           0 :     deallocate( data )
         268             :
         269           0 :   end subroutine get_data3d
         270             :
         271             :   !================================================================================================
         272             :   !================================================================================================
         273           0 :   subroutine get_data2d(indata, infld_name, recno, chunk_ptrs)
         274             :
         275             :     type(drv_input_data_t), intent(inout) :: indata
         276             :     character(len=*),       intent(in)    :: infld_name
         277             :     integer,                intent(in)    :: recno
         278             :     type(drv_input_2d_t),   intent(inout) :: chunk_ptrs(begchunk:endchunk)
         279             :
         280           0 :     real(r8), allocatable :: data (:,:)
         281             :
         282             :     integer :: c, ncol
         283             :
         284           0 :     allocate( data (pcols,  begchunk:endchunk) )
         285             :
         286           0 :     data = drv_input_data_read( indata, infld_name, recno )
         287           0 :     do c=begchunk,endchunk
         288           0 :        chunk_ptrs(c)%array(:) = data(:,c)
         289             :     enddo
         290             :
         291           0 :     deallocate( data )
         292             :
         293           0 :   end subroutine get_data2d
         294             :
         295             :   !================================================================================================
         296             :   !================================================================================================
         297           0 :   subroutine get_idata2d(indata, infld_name, recno, chunk_ptrs)
         298             :
         299             :     type(drv_input_data_t), intent(inout) :: indata
         300             :     character(len=*),       intent(in)    :: infld_name
         301             :     integer,                intent(in)    :: recno
         302             :     type(drv_input_2di_t),  intent(inout) :: chunk_ptrs(begchunk:endchunk)
         303             :
         304           0 :     real(r8), allocatable :: data (:,:)
         305             :
         306             :     integer :: c, ncol
         307             :
         308           0 :     allocate( data (pcols,  begchunk:endchunk) )
         309             :
         310           0 :     data = drv_input_data_read(indata,  infld_name, recno )
         311           0 :     do c=begchunk,endchunk
         312           0 :        chunk_ptrs(c)%array(:) = int(data(:,c))
         313             :     enddo
         314             :
         315           0 :     deallocate( data )
         316             :
         317           0 :   end subroutine get_idata2d
         318             :
         319           0 : end module drv_input_data

Generated by: LCOV version 1.14