LCOV - code coverage report
Current view: | top level - physics/clubb/src/CLUBB_core - input_reader.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 0 | 176 | 0.0 %
Date: | 2024-12-17 17:57:11 |  | Functions: | 0 | 15 | 0.0 %

              Line data    Source code
           1             : !-----------------------------------------------------------------------
           2             : !$Id$
           3             : !===============================================================================
           4             : module input_reader
           5             :
           6             : ! Description:
           7             : !  This module is respondsible for the procedures and structures necessary to
           8             : !  read in "SAM-Like" case specific files. Currently only the
           9             : !  <casename>_sounding.in file is formatted to be used by this module.
          10             : !
          11             : ! References:
          12             : !   None
          13             : !---------------------------------------------------------------------------------------------------
          14             :
          15             :   use clubb_precision, only: &
          16             :     core_rknd ! Variable(s)
          17             :
          18             :   implicit none
          19             :
          20             :   private
          21             :
          22             :   public :: one_dim_read_var, &
          23             :             read_one_dim_file, &
          24             :             two_dim_read_var, &
          25             :             read_two_dim_file, &
          26             :             fill_blanks_one_dim_vars, &
          27             :             fill_blanks_two_dim_vars, &
          28             :             deallocate_one_dim_vars, &
          29             :             deallocate_two_dim_vars, &
          30             :             read_x_table, &
          31             :             read_x_profile, &
          32             :             get_target_index, &
          33             :             count_columns
          34             :
          35             :   ! Derived type for representing a rank 1 variable that has been read in by one
          36             :   ! of the procedures.
          37             :   type one_dim_read_var
          38             :
          39             :     character(len=30) :: name               ! Name of the variable
          40             :
          41             :     character(len=30) :: dim_name           ! Name of the dimension that the
          42             :     !                                         variable varies along
          43             :
          44             :     real( kind = core_rknd ), dimension(:), allocatable :: values   ! Values of that variable
          45             :
          46             :   end type one_dim_read_var
          47             :
          48             :   ! Derived type for representing a rank 2 variable that has been read in by one
          49             :   ! of the procedures.
          50             :   type two_dim_read_var
          51             :
          52             :     character(len=30) :: name                ! Name of the variable
          53             :
          54             :     character(len=30) :: dim1_name           ! Name of one of the dimensions
          55             :     !                                          that the variable varies along
          56             :
          57             :     character(len=30) :: dim2_name           ! Name of the other variable that
          58             :     !                                          the variable varies along
          59             :
          60             :     real( kind = core_rknd ), dimension(:,:), allocatable :: values  ! Values of that variable
          61             :
          62             :   end type two_dim_read_var
          63             :
          64             :
          65             :   ! Constant Parameter(s)
          66             :   real( kind = core_rknd ), parameter, private :: &
          67             :     blank_value = -999.9_core_rknd ! Used to denote if a value is missing from the file
          68             :
          69             :   contains
          70             :
          71             :   !-------------------------------------------------------------------------------------------------
          72           0 :   subroutine read_two_dim_file( iunit, nCol, filename, read_vars, other_dim )
          73             :     !
          74             :     ! Description: This subroutine reads from a file containing data that varies
          75             :     !              in two dimensions. These are dimensions are typically height
          76             :     !              and time.
          77             :     !
          78             :     !-----------------------------------------------------------------------------------------------
          79             :     use constants_clubb, only: &
          80             :         fstderr ! Constant(s)
          81             :
          82             :     use input_names, only: &
          83             :         time_name ! Constant(s)
          84             :
          85             :     use clubb_precision, only: &
          86             :         core_rknd ! Variable(s)
          87             :
          88             :     implicit none
          89             :
          90             :     ! External
          91             :     intrinsic :: trim, index
          92             :
          93             :     ! Input Variable(s)
          94             :
          95             :     integer, intent(in) :: iunit ! File I/O unit
          96             :
          97             :     integer, intent(in) :: nCol ! Number of columns expected in the data file
          98             :
          99             :
         100             :     character(len=*), intent(in) :: filename ! Name of the file being read from
         101             :
         102             :     ! Output Variable(s)
         103             :     type (two_dim_read_var), dimension(nCol),intent(out) :: read_vars ! Structured information
         104             :     !                                                                   from the file
         105             :
         106             :     type (one_dim_read_var), intent(out) :: other_dim  ! Structured information
         107             :     !                                                    on the dimesion not stored in read_vars
         108             :
         109             :     ! Local Variables
         110           0 :     character(len=30),dimension(nCol) :: names ! Names of variables
         111             :
         112             :     integer nRowI ! Inner row
         113             :
         114             :     integer nRowO ! Outer row
         115             :
         116             :     integer :: k, j, i
         117             :
         118             :     logical :: isComment
         119             :
         120             :     character(len=200) :: tmpline
         121             :
         122           0 :     real( kind = core_rknd ), dimension(nCol) :: tmp
         123             :
         124             :     integer :: input_status ! The status of a read statement
         125             :
         126             :     ! ---- Begin Code ----
         127             :
         128             :     ! First run through, take names and determine how large the data file is.
         129           0 :     open(unit=iunit, file=trim( filename ), status = 'old', action='read' )
         130             :
         131           0 :     isComment = .true.
         132             :
         133             :     ! Skip all the comments at the top of the file
         134             :     do while ( isComment )
         135           0 :       read(iunit,fmt='(A)') tmpline
         136           0 :       k = index( tmpline, "!" )
         137           0 :       isComment = .false.
         138           0 :       if ( k > 0 ) then
         139             :         isComment = .true.
         140             :       end if
         141             :     end do
         142             :
         143             :     ! Go back to the line that wasn't a comment.
         144           0 :     backspace(iunit)
         145             :
         146           0 :     read(iunit, fmt=*) names
         147             :
         148           0 :     nRowO = 0
         149           0 :     do while(.true.)
         150           0 :       read(iunit, *, iostat=input_status) tmp(1), nRowI
         151             :
         152             :       ! If input_status shows an end of data, then exit the loop
         153           0 :       if( input_status < 0 ) then
         154             :         exit
         155           0 :       else if ( input_status > 0 ) then
         156           0 :         write(fstderr,*) "Error reading data from file: " //trim( filename )
         157           0 :         error stop "Fatal error input_reader"
         158             :       end if
         159             :
         160           0 :       if( nRowI < 1 ) then
         161             :         error stop &
         162           0 :               "Number of elements must be an integer and greater than zero in two-dim input file."
         163             :       end if
         164             :
         165           0 :       do k =1, nRowI
         166           0 :         read(iunit, *) tmp
         167             :       end do
         168           0 :       nRowO = nRowO + 1
         169             :     end do
         170             :
         171           0 :     do i=1, nRowO
         172             :
         173           0 :       backspace(iunit)
         174             :
         175           0 :       do j=1, nRowI
         176             :
         177           0 :         backspace(iunit)
         178             :
         179             :       end do
         180             :
         181             :     end do
         182             :
         183           0 :     backspace(iunit)
         184             :
         185             :     ! Store the names into the structure and allocate accordingly
         186           0 :     do k =1, nCol
         187           0 :       read_vars(k)%name = names(k)
         188           0 :       read_vars(k)%dim1_name = time_name
         189           0 :       read_vars(k)%dim2_name = names(1)
         190             :
         191           0 :       allocate( read_vars(k)%values(nRowI, nRowO) )
         192             :     end do
         193             :
         194           0 :     other_dim%name = time_name
         195           0 :     other_dim%dim_name = time_name
         196             :
         197           0 :     allocate( other_dim%values(nRowO) )
         198             :
         199             :     ! Read in the data again to the newly allocated arrays
         200           0 :     do k=1, nRowO
         201           0 :       read(iunit,*) other_dim%values(k)
         202           0 :       do j=1, nRowI
         203           0 :         read(iunit,*) ( read_vars(i)%values(j,k), i=1, nCol)
         204             :       end do
         205             :     end do
         206             :
         207           0 :     close(iunit)
         208             :
         209             :     ! Eliminate a compiler warning
         210             :     if ( .false. ) print *, tmp
         211             :
         212           0 :     return
         213             :   end subroutine read_two_dim_file
         214             :
         215             :   !------------------------------------------------------------------------------------------------
         216           0 :   subroutine read_one_dim_file( iunit, nCol, filename, &
         217           0 :                                 read_vars )
         218             :     !
         219             :     ! Description:
         220             :     !   This subroutine reads from a file containing data that varies
         221             :     !   in one dimension. The dimension is typically time.
         222             :     !
         223             :     ! References:
         224             :     !   None
         225             :     !----------------------------------------------------------------------------------------------
         226             :
         227             :     use clubb_precision, only: &
         228             :         core_rknd ! Variable(s)
         229             :
         230             :     implicit none
         231             :
         232             :     ! External
         233             :
         234             :     intrinsic :: trim, index
         235             :
         236             :     ! Input Variable(s)
         237             :
         238             :     integer, intent(in) :: iunit ! I/O unit
         239             :
         240             :     integer, intent(in) :: nCol ! Number of columns expected in the data file
         241             :
         242             :     character(len=*), intent(in)  :: filename ! Name of the file being read from
         243             :
         244             :     ! Output Variable(s)
         245             :
         246             :     type (one_dim_read_var), dimension(nCol),intent(out) :: &
         247             :       read_vars ! Structured information from the file
         248             :
         249             :     ! Local Variable(s)
         250           0 :     character(len=30),dimension(nCol) :: names
         251             :
         252             :     character(len=200) :: tmpline
         253             :
         254             :     integer nRow
         255             :
         256             :     integer :: k, j
         257             :
         258           0 :     real( kind = core_rknd ), dimension(nCol) :: tmp
         259             :
         260             :     logical :: isComment
         261             :
         262             :     integer :: input_status ! The status of a read statement
         263             :
         264             :     ! ---- Begin Code ----
         265             :
         266           0 :     isComment = .true.
         267             :
         268             :     ! First run through, take names and determine how large the data file is.
         269           0 :     open(unit=iunit, file=trim( filename ), status = 'old' )
         270             :
         271             :     ! Skip all the comments at the top of the file
         272             :     do while(isComment)
         273           0 :       read(iunit,fmt='(A)') tmpline
         274           0 :       k = index( tmpline, "!" )
         275           0 :       isComment = .false.
         276           0 :       if(k > 0) then
         277             :         isComment = .true.
         278             :       end if
         279             :     end do
         280             :
         281             :     ! Go back to the line that wasn't a comment.
         282           0 :     backspace(iunit)
         283             :
         284           0 :     read(iunit, fmt=*) names
         285             :
         286             :     ! Count up the number of rows
         287           0 :     nRow = 0
         288           0 :     do while(.true.)
         289           0 :       read(iunit, *, iostat=input_status) tmp
         290             :
         291             :       ! If input_status shows an end of file, exit the loop
         292           0 :       if( input_status < 0 ) then
         293             :         exit
         294             :       end if
         295             :
         296           0 :       nRow = nRow+1
         297             :     end do
         298             :
         299             :     ! Rewind that many rows
         300           0 :     do k = 0, nRow
         301           0 :       backspace(iunit)
         302             :     end do
         303             :
         304             :     ! Store the names into the structure and allocate accordingly
         305           0 :     do k = 1, nCol
         306           0 :       read_vars(k)%name = names(k)
         307           0 :       read_vars(k)%dim_name = names(1)
         308           0 :       allocate( read_vars(k)%values(nRow) )
         309             :     end do
         310             :
         311             :     ! Read in the data again to the newly allocated arrays
         312           0 :     do k=1, nRow
         313           0 :       read(iunit,*) ( read_vars(j)%values(k), j=1, nCol)
         314             :     end do
         315             :
         316           0 :     close(iunit)
         317             :
         318             :     ! Avoiding compiler warning
         319             :     if ( .false. ) print *, tmp
         320             :
         321           0 :     return
         322             :
         323             :   end subroutine read_one_dim_file
         324             :
         325             :   !------------------------------------------------------------------------------------------------
         326           0 :   subroutine fill_blanks_one_dim_vars( num_vars, one_dim_vars )
         327             :     !
         328             :     ! Description:
         329             :     !   This subroutine fills in the blank spots (signified by constant blank_value)
         330             :     !   with values linearly interpolated using the first element of the array as a
         331             :     !   guide.
         332             :     !
         333             :     ! References:
         334             :     !   None
         335             :     !----------------------------------------------------------------------------------------------
         336             :
         337             :     use clubb_precision, only: &
         338             :         core_rknd ! Variable(s)
         339             :
         340             :     implicit none
         341             :
         342             :     ! External
         343             :     intrinsic :: size
         344             :
         345             :     ! Input Variable(s)
         346             :     integer, intent(in) :: num_vars ! Number of elements in one_dim_vars
         347             :
         348             :     ! Input/Output Variable(s)
         349             :     type(one_dim_read_var), dimension(num_vars), intent(inout) :: &
         350             :       one_dim_vars ! Read data that may have gaps.
         351             :
         352             :     ! Local variable(s)
         353             :     integer :: i
         354             :
         355             :     ! ---- Begin Code ----
         356             :
         357           0 :     do i=1, num_vars
         358           0 :       one_dim_vars(i)%values = linear_fill_blanks( size( one_dim_vars(i)%values ), &
         359           0 :                                                    one_dim_vars(1)%values, one_dim_vars(i)%values, &
         360           0 :                                                    0.0_core_rknd )
         361             :     end do
         362             :
         363           0 :     return
         364             :
         365             :   end subroutine fill_blanks_one_dim_vars
         366             :
         367             :   !------------------------------------------------------------------------------------------------
         368           0 :   subroutine fill_blanks_two_dim_vars( num_vars, other_dim, two_dim_vars )
         369             :     !
         370             :     ! Description:
         371             :     !   This subroutine fills in the blank spots (signified by the
         372             :     !   constant blank_value with values linearly interpolated using the first
         373             :     !   element of the array and the values in the other_dim argument as a guide.
         374             :     !
         375             :     !   This is a two step process. First we assume that the other_dim values
         376             :     !   have no holes, but there are blanks for that variable across that
         377             :     !   dimension. Then we fill holes across the dimension whose values are first
         378             :     !   in the array of two_dim_vars.
         379             :     !
         380             :     !   Ex. Time is the 'other_dim' and Height in meters is the first element in
         381             :     !   two_dim_vars.
         382             :     !
         383             :     ! References:
         384             :     !   None
         385             :     !----------------------------------------------------------------------------------------------
         386             :
         387             :     implicit none
         388             :
         389             :     ! External
         390             :     intrinsic :: size
         391             :
         392             :     ! Input Variable(s)
         393             :     integer, intent(in) :: num_vars ! Number of elements in one_dim_vars
         394             :
         395             :     ! Input/Output Variable(s)
         396             :     type(one_dim_read_var), intent(in) :: other_dim ! Read data
         397             :
         398             :     type(two_dim_read_var), dimension(num_vars), intent(inout) ::  &
         399             :       two_dim_vars ! Read data that may have gaps.
         400             :
         401             :     ! Local variables
         402             :     integer :: i,j ! Loop iterators
         403             :
         404             :     integer :: &
         405             :       dim_size, &    ! 1st dimension size
         406             :       other_dim_size ! 2nd dimension size
         407             :
         408             :     ! ---- Begin Code ----
         409             :
         410           0 :     dim_size = size( two_dim_vars(1)%values, 1 )
         411             :
         412           0 :     other_dim_size = size( other_dim%values )
         413             :
         414           0 :     do i=2, num_vars
         415             :       ! Interpolate along main dim
         416           0 :       do j=1, other_dim_size
         417           0 :         two_dim_vars(i)%values(:,j) = linear_fill_blanks( dim_size, &
         418             :                                         two_dim_vars(1)%values(:,j), &
         419           0 :                                         two_dim_vars(i)%values(:,j), blank_value )
         420             :       end do ! j = 1 .. other_dim_size
         421             :
         422             :       ! Interpolate along other dim
         423           0 :       do j=1, dim_size
         424           0 :         two_dim_vars(i)%values(j,:) = linear_fill_blanks( other_dim_size, &
         425             :                                         other_dim%values, &
         426           0 :                                         two_dim_vars(i)%values(j,:), blank_value )
         427             :       end do ! j = 1 .. dim_size
         428             :
         429             :     end do ! i = 2 .. num_vars
         430             :
         431           0 :     return
         432             :
         433             :   end subroutine fill_blanks_two_dim_vars
         434             :
         435             :
         436             :   !------------------------------------------------------------------------------------------------
         437           0 :   function linear_fill_blanks( dim_grid, grid, var, default_value ) &
         438           0 :     result( var_out )
         439             :   !
         440             :   ! Description:
         441             :   !   This function fills blanks in array var using the grid
         442             :   !   as a guide. Blank values in var are signified by being
         443             :   !   less than or equal to the constant blank_value.
         444             :   !
         445             :   ! References:
         446             :   !   None
         447             :   !-----------------------------------------------------------------------------------------------
         448             :
         449             :     use interpolation, only: zlinterp_fnc
         450             :
         451             :     use clubb_precision, only: &
         452             :         core_rknd ! Variable(s)
         453             :
         454             :     implicit none
         455             :
         456             :     ! Input Variable(s)
         457             :     integer, intent(in) :: dim_grid ! Size of grid
         458             :
         459             :     real( kind = core_rknd ), dimension(dim_grid), intent(in) :: &
         460             :       grid ! Array that var is being interpolated to.
         461             :
         462             :     real( kind = core_rknd ), dimension(dim_grid), intent(in) :: &
         463             :       var ! Array that may contain gaps.
         464             :
         465             :     real( kind = core_rknd ), intent(in) :: &
         466             :       default_value ! Default value if entire profile == blank_value
         467             :
         468             :     ! Output Variable(s)
         469             :     real( kind = core_rknd ), dimension(dim_grid) :: &
         470             :       var_out ! Return variable
         471             :
         472             :     ! Local Variables
         473           0 :     real( kind = core_rknd ), dimension(dim_grid) :: temp_grid
         474           0 :     real( kind = core_rknd ), dimension(dim_grid) :: temp_var
         475             :
         476             :     integer :: i
         477             :     integer :: amt
         478             :
         479             :     logical :: reversed
         480             :
         481             :     ! ---- Begin Code ----
         482             :
         483           0 :     reversed = .false.
         484             :
         485             :     ! Essentially this code leverages the previously written zlinterp function.
         486             :     ! A smaller temporary grid and var variable are being created to pass to
         487             :     ! zlinterp. zlinterp then performs the work of taking the temporary var
         488             :     ! array and interpolating it to the actual grid array.
         489             :
         490           0 :     amt = 0
         491           0 :     do i=1, dim_grid
         492           0 :       if ( var(i) > blank_value ) then
         493           0 :         amt = amt + 1
         494           0 :         temp_var(amt) = var(i)
         495           0 :         temp_grid(amt) = grid(i)
         496             :       end if
         497           0 :       if ( i > 1 ) then
         498           0 :         if ( grid(i) < grid(i-1) ) then
         499           0 :           reversed = .true.
         500             :         end if
         501             :       end if
         502             :     end do
         503             :
         504             :
         505           0 :     if ( amt == 0 ) then
         506           0 :       var_out = default_value
         507           0 :     else if (amt < dim_grid) then
         508           0 :       if ( reversed ) then
         509           0 :         var_out = zlinterp_fnc( dim_grid, amt, -grid, -temp_grid(1:amt), temp_var(1:amt) )
         510             :       else
         511           0 :         var_out = zlinterp_fnc( dim_grid, amt, grid, temp_grid(1:amt), temp_var(1:amt) )
         512             :       end if
         513             :     else
         514           0 :       var_out = var
         515             :     end if
         516             :
         517           0 :     return
         518           0 :   end function linear_fill_blanks
         519             :   !----------------------------------------------------------------------------
         520           0 :   subroutine deallocate_one_dim_vars( num_vars, &
         521           0 :                                       one_dim_vars )
         522             :     !
         523             :     !  Description:
         524             :     !    This subroutine deallocates the pointer stored in
         525             :     !    one_dim_vars%value for the whole array.
         526             :     !
         527             :     !------------------------------------------------------------------------------
         528             :     implicit none
         529             :
         530             :     ! External functions
         531             :     intrinsic :: allocated
         532             :
         533             :     ! Input Variable(s)
         534             :     integer, intent(in) :: num_vars ! Number of elements in one_dim_vars
         535             :
         536             :     type(one_dim_read_var), dimension(num_vars), intent(inout) :: &
         537             :       one_dim_vars ! Read data that may have gaps.
         538             :
         539             :     ! Local Variable(s)
         540             :     integer :: i
         541             :
         542             :     ! Begin Code
         543             :
         544           0 :     do i=1, num_vars
         545             :
         546           0 :       if ( allocated( one_dim_vars(i)%values ) ) then
         547             :
         548           0 :         deallocate( one_dim_vars(i)%values )
         549             :
         550             :       end if
         551             :
         552             :     end do ! 1 .. num_vars
         553             :
         554           0 :     return
         555             :   end subroutine deallocate_one_dim_vars
         556             :
         557             :   !------------------------------------------------------------------------------------------------
         558           0 :   subroutine deallocate_two_dim_vars( num_vars, two_dim_vars, other_dim )
         559             :     !
         560             :     ! Description:
         561             :     !   This subroutine deallocates the pointer stored in
         562             :     !   two_dim_vars%value for the whole array
         563             :     !
         564             :     ! References:
         565             :     !   None
         566             :     !----------------------------------------------------------------------------------------------
         567             :     implicit none
         568             :
         569             :     ! External Functions
         570             :     intrinsic :: allocated
         571             :
         572             :     ! Input Variable(s)
         573             :     integer, intent(in) :: num_vars ! Number of elements in one_dim_vars
         574             :
         575             :     ! Input/Output Variables
         576             :     type(one_dim_read_var), intent(inout) :: other_dim
         577             :
         578             :     type(two_dim_read_var), dimension(num_vars), intent(inout) :: &
         579             :        two_dim_vars ! Read data that may have gaps.
         580             :
         581             :     ! Local Variable(s)
         582             :     integer :: i
         583             :
         584             :     ! ---- Begin Code ----
         585             :
         586           0 :     do i=1, num_vars
         587             :
         588           0 :       if ( allocated( two_dim_vars(i)%values ) ) then
         589             :
         590           0 :         deallocate(two_dim_vars(i)%values)
         591             :
         592             :       end if
         593             :
         594             :     end do
         595             :
         596           0 :     if ( allocated( other_dim%values ) ) then
         597             :
         598           0 :       deallocate(other_dim%values)
         599             :
         600             :     end if
         601             :
         602           0 :     return
         603             :   end subroutine deallocate_two_dim_vars
         604             :   !------------------------------------------------------------------------------------------------
         605           0 :   function read_x_table( nvar, xdim, ydim, target_name, retVars ) result( x )
         606             :     !
         607             :     ! Description:
         608             :     !   Searches for the variable specified by target_name in the
         609             :     !   collection of retVars. If the function finds the variable then it returns
         610             :     !   it. If it does not the program using this function will exit gracefully
         611             :     !   with a warning message.
         612             :     !
         613             :     ! References:
         614             :     !   None
         615             :     !-----------------------------------------------------------------------------------------------
         616             :
         617             :     use clubb_precision, only: &
         618             :         core_rknd ! Variable(s)
         619             :
         620             :     use constants_clubb, only: &
         621             :         fstderr ! Constant(s)
         622             :
         623             :     implicit none
         624             :
         625             :     ! External Functions
         626             :     intrinsic :: trim
         627             :
         628             :     ! Input Variable(s)
         629             :     integer, intent(in) :: nvar ! Number of variables in retVars
         630             :
         631             :     integer, intent(in) :: xdim, ydim
         632             :
         633             :     character(len=*), intent(in) :: &
         634             :       target_name ! Name of the variable that is being searched for
         635             :
         636             :     type(two_dim_read_var), dimension(nvar), intent(in) :: &
         637             :       retVars ! Collection of data being searched through
         638             :
         639             :     ! Output Variable(s)
         640             :     real( kind = core_rknd ), dimension( xdim, ydim ) :: x
         641             :
         642             :     ! Local Variables
         643             :     integer :: i ! Loop iterator
         644             :
         645             :     logical :: l_found
         646             :
         647             :     ! ---- Begin Code ----
         648             :
         649           0 :     l_found = .false.
         650             :
         651           0 :     i = 1
         652             :
         653           0 :     do while( i <= nvar .and. .not. l_found)
         654             :
         655           0 :       if( retVars(i)%name == target_name ) then
         656             :
         657           0 :         l_found = .true.
         658             :
         659           0 :         x = retVars(i)%values
         660             :
         661             :       end if
         662             :
         663           0 :       i=i+1
         664             :
         665             :     end do ! i <= nvar .and. not l_found
         666             :
         667           0 :     if ( .not. l_found ) then
         668             :
         669           0 :       write(fstderr,*) trim( target_name )//" could not be found."
         670             :
         671           0 :       error stop "Fatal error in function read_x_table"
         672             :
         673             :     end if
         674             :
         675           0 :     return
         676             :
         677           0 :   end function read_x_table
         678             :
         679             :
         680             :   !------------------------------------------------------------------------------------------------
         681           0 :   function read_x_profile( nvar, dim_size, target_name, retVars, &
         682           0 :                            input_file ) result( x )
         683             :     !
         684             :     !  Description:
         685             :     !    Searches for the variable specified by target_name in the
         686             :     !    collection of retVars. If the function finds the variable then it returns
         687             :     !    it. If it does not the program using this function will exit gracefully
         688             :     !    with a warning message.
         689             :     !
         690             :     ! Modified by Cavyn, June 2010
         691             :     !----------------------------------------------------------------------------------------------
         692             :
         693             :     use constants_clubb, only: &
         694             :         fstderr  ! Variable for writing to error stream
         695             :
         696             :     use clubb_precision, only: &
         697             :         core_rknd ! Variable(s)
         698             :
         699             :     implicit none
         700             :
         701             :     ! External Functions
         702             :     intrinsic :: present, size, trim
         703             :
         704             :     ! Input Variable(s)
         705             :     integer, intent(in) :: &
         706             :       nvar,  & ! Number of variables in retVars
         707             :       dim_size ! Size of the array returned
         708             :
         709             :     character(len=*), intent(in) :: &
         710             :       target_name  ! Name of the variable that is being searched for
         711             :
         712             :     type(one_dim_read_var), dimension(nvar), intent(in) :: &
         713             :       retVars ! Collection being searched
         714             :
         715             :     character(len=*), optional, intent(in) :: &
         716             :       input_file ! Name of the input file containing the variables
         717             :
         718             :     ! Output Variable(s)
         719             :     real( kind = core_rknd ), dimension(dim_size) :: x
         720             :
         721             :     ! Local Variables
         722             :     integer :: i
         723             :
         724             :     ! ---- Begin Code ----
         725             :
         726           0 :     i = get_target_index( nvar, target_name, retVars )
         727             :
         728           0 :     if ( i > 0 ) then
         729           0 :         x(1:size(retVars(i)%values)) = retVars(i)%values
         730             :
         731             :     else
         732           0 :       if( present( input_file ) ) then
         733           0 :         write(fstderr,*) trim( target_name ), ' could not be found. Check the file ', input_file
         734             :       else
         735           0 :         write(fstderr,*) trim( target_name ), ' could not be found. Check your sounding.in file.'
         736             :       end if ! present( input_file )
         737           0 :       error stop "Fatal error in read_x_profile"
         738             :
         739             :     end if ! target_exists_in_array
         740             :
         741           0 :     return
         742             :
         743           0 :   end function read_x_profile
         744             :
         745             :   !------------------------------------------------------------------------------
         746           0 :   function get_target_index( nvar, target_name, retVars) result( i )
         747             :     !
         748             :     ! Description:
         749             :     !   Returns the index of the variable specified by target_name in the
         750             :     !   collection of retVars. Returns -1 if variable does not exist in retVars
         751             :     !
         752             :     ! References:
         753             :     !   None
         754             :     !
         755             :     ! Created by Cavyn, July 2010
         756             :     !----------------------------------------------------------------------------------------------
         757             :
         758             :     implicit none
         759             :
         760             :     ! Input Variable(s)
         761             :     integer, intent(in) :: nvar                    ! Number of variables in retVars
         762             :     character(len=*), intent(in) :: target_name           ! Variable being searched for
         763             :     type(one_dim_read_var), dimension(nvar), intent(in) :: retVars ! Collection being searched
         764             :
         765             :     ! Output Variable
         766             :     integer :: i
         767             :
         768             :     ! Local Variable(s)
         769             :     logical :: l_found
         770             :
         771             :     !----------------BEGIN CODE------------------
         772             :
         773           0 :     l_found = .false.
         774             :
         775           0 :     i = 0
         776           0 :     do while ( i < nvar .and. .not. l_found )
         777           0 :       i = i+1
         778           0 :       if( retVars(i)%name == target_name ) then
         779           0 :         l_found = .true.
         780             :       end if
         781             :     end do
         782             :
         783           0 :     if( .not. l_found ) then
         784           0 :       i = -1
         785             :     end if
         786             :
         787             :     return
         788             :
         789             :   end function get_target_index
         790             :
         791             :   !=============================================================================
         792           0 :   function count_columns( iunit, filename ) result( nCols )
         793             :   ! Description:
         794             :   !   This function counts the number of columns in a file, assuming that the
         795             :   !   first line of the file contains only column headers. (Comments are OK)
         796             :
         797             :   ! References:
         798             :   !   None
         799             :
         800             :   ! Created by Cavyn, July 2010
         801             :   !-----------------------------------------------------------------------------
         802             :
         803             :     implicit none
         804             :
         805             :     ! External
         806             :     intrinsic :: index, trim, size
         807             :
         808             :     ! Input Variables
         809             :     integer, intent(in) :: iunit ! I/O unit
         810             :     character(len=*), intent(in) :: filename ! Name of the file being read from
         811             :
         812             :     ! Output Variable
         813             :     integer :: nCols ! The number of data columns in the selected file
         814             :
         815             :     ! Local Variables
         816             :     integer :: i, k                               ! Loop Counter
         817             :     character(len=200) :: tmp                     ! Temporary char buffer
         818             :     character(len=200), dimension(50) :: colArray ! Max of 50 columns
         819             :     logical :: isComment
         820             :     integer :: status_var ! IO status for read statement
         821             :
         822             :
         823             :     ! -------------------------BEGIN CODE-------------------------------------
         824             :
         825           0 :     isComment = .true.
         826             :
         827           0 :     open(unit=iunit, file=trim( filename ), status = 'old' )
         828             :
         829             :     ! Skip all the comments at the top of the file
         830             :     do while(isComment)
         831           0 :       read(iunit,fmt='(A)') tmp
         832           0 :       k = index( tmp, "!" )
         833           0 :       isComment = .false.
         834           0 :       if(k > 0) then
         835             :         isComment = .true.
         836             :       end if
         837             :     end do
         838             :
         839             :     ! Go back to the line that wasn't a comment.
         840           0 :     backspace(iunit)
         841             :
         842             :     ! Count the number of columns
         843           0 :     nCols = 0
         844           0 :     colArray = ""
         845           0 :     read(iunit,fmt='(A)',iostat=status_var) tmp
         846             :     ! Only continue if there was no IO error or end of data
         847           0 :     if( status_var == 0 ) then
         848             :       ! Move all words into an array
         849           0 :       read(tmp,*,iostat=status_var) (colArray(i), i=1,size( colArray ))
         850             :
         851           0 :     else if ( status_var > 0 ) then
         852             :       ! Handle the case where we have an error before the EOF marker is found
         853           0 :       error stop "Fatal error reading data in time_dependent_input function count_columns"
         854             :
         855             :     end if
         856             :
         857           0 :     do i=1,size( colArray )
         858           0 :       if( colArray(i) /= "" ) then ! Increment number of columns until array is blank
         859           0 :         nCols = nCols+1
         860             :       end if
         861             :     end do
         862             :
         863           0 :     close(iunit)
         864             :
         865           0 :   end function count_columns
         866             :
         867             : !------------------------------------------------------------------------------
         868           0 : end module input_reader

Generated by: LCOV version 1.14