soil_db_read.f90 Source File


This file depends on

sourcefile~~soil_db_read.f90~~EfferentGraph sourcefile~soil_db_read.f90 soil_db_read.f90 sourcefile~input_file_module.f90 input_file_module.f90 sourcefile~soil_db_read.f90->sourcefile~input_file_module.f90 sourcefile~maximum_data_module.f90 maximum_data_module.f90 sourcefile~soil_db_read.f90->sourcefile~maximum_data_module.f90 sourcefile~soil_data_module.f90 soil_data_module.f90 sourcefile~soil_db_read.f90->sourcefile~soil_data_module.f90

Source Code

      subroutine soil_db_read
      
      use input_file_module
      use maximum_data_module
      use soil_data_module
      
      implicit none
      
      character (len=80) :: titldum = ""!           |title of file
      character (len=80) :: header = "" !           |header of file
      integer :: eof = 0              !           |end of file
      integer :: imax = 0             !none       |determine max number for array (imax) and total number in file
      logical :: i_exist              !none       |check to determine if file exists
      integer :: j = 0                !none       |hru            
      integer :: nlyr = 0             !           |
      integer :: lyr = 0              !none       |counter
      integer :: mlyr = 0             !           |
      integer :: isol = 0             !none       |counter
 
      eof = 0
      imax = 0

      inquire (file=in_sol%soils_sol,exist=i_exist)
      if (.not. i_exist .or. in_sol%soils_sol == "null") then
        allocate (soildb(0:0))
        allocate (soildb(0)%ly(0:0))
      else
        do  
          open (107,file=in_sol%soils_sol)
          read (107,*,iostat=eof) titldum
          if (eof < 0) exit
          read (107,*,iostat=eof) header
          if (eof < 0) exit
          
          !! determine max number for array (imax) and total number in file
            do while (eof == 0)
              read (107,*,iostat=eof) titldum, nlyr 
              if (eof < 0) exit
                do lyr = 1, nlyr
                  read (107,*,iostat=eof) titldum
                  if (eof < 0) exit
                end do 
                imax = imax + 1
            end do
            
          db_mx%soil = imax 
          
          allocate (soildb(0:imax))
          
        rewind (107)
        read (107,*,iostat=eof) titldum
        if (eof < 0) exit
        read (107,*,iostat=eof) header
        if (eof < 0) exit
              
        do isol = 1, db_mx%soil
            
         read (107,*,iostat=eof) soildb(isol)%s%snam, soildb(isol)%s%nly
         if (eof < 0) exit
         mlyr = soildb(isol)%s%nly
      
         allocate (soildb(isol)%ly(mlyr))
       
         backspace 107
         read (107,*,iostat=eof) soildb(isol)%s%snam, soildb(isol)%s%nly,  &
          soildb(isol)%s%hydgrp, soildb(isol)%s%zmx,                       &           
          soildb(isol)%s%anion_excl, soildb(isol)%s%crk,                   &           
          soildb(isol)%s%texture
         if (eof < 0) exit
          do j = 1, mlyr
            read (107,*,iostat=eof) soildb(isol)%ly(j)%z, soildb(isol)%ly(j)%bd,             &
                soildb(isol)%ly(j)%awc, soildb(isol)%ly(j)%k, soildb(isol)%ly(j)%cbn,        &           
                soildb(isol)%ly(j)%clay, soildb(isol)%ly(j)%silt, soildb(isol)%ly(j)%sand,   &
                soildb(isol)%ly(j)%rock, soildb(isol)%ly(j)%alb, soildb(isol)%ly(j)%usle_k,  &           
                soildb(isol)%ly(j)%ec, soildb(isol)%ly(j)%cal, soildb(isol)%ly(j)%ph
            if (eof < 0) exit
          end do
          !! if the first layer is less than 20 cm, adjust to 20 cm if only one layer or second layer is greater than 20 cm
          if (soildb(isol)%ly(1)%z < 20.) then
            if (soildb(isol)%s%nly == 1 .or. soildb(isol)%ly(2)%z > 20.) then
                soildb(isol)%ly(1)%z = 20.
            end if
          end if
        end do
        exit
        enddo
        endif
      
        close (107)
        
      return
      end subroutine soil_db_read