getlvls.f

     subroutine getlvls(param,ithfld,ifld,found_fld,kpv,pv)
!
!   03_10_2015  Lin Gan  - Using flat file data
!
 
      use xml_perl_data,   only : param_t
      use ctlblk_mod,      only : lsm, spl, nsoil, isf_surface_physics, &
                                  me, nfd, htfd, nbnd, petabnd
      use rqstfld_mod,     only : lvls, lvlsxml, mxlvl, lvls, iget, ident, &
                                  iavblfld
      use soil,            only : sldpth,sllevel
      implicit none
!
      type(param_t),intent(in) :: param
      integer, intent(in)      :: ithfld,kpv
      integer, intent(inout)   :: ifld
      logical, intent(inout)   :: found_fld
      real,intent(in)          :: pv(1:kpv)
!
      real,parameter :: small=1.e-5
      real,parameter :: small1=1.e-3
      real,parameter :: small2=1
      integer i,j,nlevel,scalef,lvlcape,lvlcin
      logical :: lincfld
!
      lincfld=.false.
      nlevel=size(param%level)
!
      if(trim(param%fixed_sfc1_type)=='isobaric_sfc') then
        do j=1, nlevel
        iloop:  do i=1, lsm
         
             if(abs(param%level(j)-spl(i))<small1)then
              lvls(i,ifld)=1
              lvlsxml(i,ifld)=j
              exit iloop
             endif
           enddo  iloop
        enddo
      endif
!
      if(trim(param%fixed_sfc1_type)=='hybrid_lvl') then
        do j=1, nlevel
        iloop1:  do i=1, mxlvl
             if(nint(param%level(j))==i)then
              lvls(i,ifld)=1
              lvlsxml(i,ifld)=j
              exit iloop1
             endif
           enddo iloop1
        enddo
      endif
!
      if(trim(param%fixed_sfc1_type)=='depth_bel_land_sfc'.and. &
          trim(param%fixed_sfc2_type)=='depth_bel_land_sfc' ) then
!         if(me==0)print *,'nsoil=',nsoil,'iSF_SURFACE_PHYSICS=',iSF_SURFACE_PHYSICS, &
!          'level=',param%level,'sldpth=',SLDPTH(1:nsoil),'sum=',sum(SLDPTH(1:nsoil))*100.
         do j=1, nlevel
           iloop2: do i=1, nsoil
            if(isf_surface_physics  ==3) then
              if(nint(param%level(j))==nint(sllevel(i)*100.)) then
                lvls(i,ifld)=1
                lvlsxml(i,ifld)=j
                exit iloop2
              endif
            else
              if(nint(param%level2(j))==nint(sum(sldpth(1:i))*100.) ) then
                lvls(i,ifld)=1
                lvlsxml(i,ifld)=j
                exit iloop2
              endif
            endif
           enddo iloop2
         enddo
         if(trim(param%pname)=='TSOIL') then
           iget(116)=ifld
           ident(ifld) = 116
           iavblfld(ifld)=ithfld
           found_fld=.true.
         elseif(trim(param%pname)=='TMP') then
           iget(574)=ifld
           ident(ifld) = 574
           iavblfld(ifld)=ithfld
           found_fld=.true.
         endif
!      elseif(trim(param%fixed_sfc1_type)=='depth_bel_land_sfc'.and. &
!        trim(param%fixed_sfc2_type)==''.and.(trim(param%pname)=='TSOIL' &
!        .or.trim(param%pname)=='TMP')) then
!         iget(115)=ifld
!         IDENT(IFLD) = 115
!         IAVBLFLD(IFLD)=ithfld
!         FOUND_FLD=.true.
!         LVLS(1,ifld)=1
!         LVLSXML(1,ifld)=1
      endif
!
!for sigma level, need to check iget
      if(trim(param%pname)=='RH'.and.trim(param%fixed_sfc1_type)=='sigma_lvl'.and.  &
          trim(param%fixed_sfc2_type)=='sigma_lvl') then
         do j=1, nlevel
           if(abs(param%level(j)-33)<small.and.abs(param%level2(j)-100)<small)then
            lvls(1,ifld)=j
            lvlsxml(1,ifld)=j
            iget(066)=ifld
            ident(ifld) = 066
            iavblfld(ifld)=ithfld
            found_fld=.true.
            ifld=ifld+1
           else if(abs(param%level(j)-67)<small.and.abs(param%level2(j)-100)<small)then
            lvls(1,ifld)=j
            lvlsxml(1,ifld)=j
            iget(081)=ifld
            ident(ifld) = 081
            iavblfld(ifld)=ithfld
            found_fld=.true.
            ifld=ifld+1
           else if(abs(param%level(j)-33)<small.and.abs(param%level2(j)-67)<small)then
            lvls(1,ifld)=j
            lvlsxml(1,ifld)=j
            iget(082)=ifld
            ident(ifld) = 082
            iavblfld(ifld)=ithfld
            found_fld=.true.
            ifld=ifld+1
           else if(abs(param%level(j)-47)<small.and.abs(param%level2(j)-100)<small)then
            lvls(1,ifld)=j
            lvlsxml(1,ifld)=j
            iget(099)=ifld
            ident(ifld) = 099
            iavblfld(ifld)=ithfld
            found_fld=.true.
            ifld=ifld+1
           else if(abs(param%level(j)-47)<small.and.abs(param%level2(j)-96)<small)then
            lvls(1,ifld)=j
            lvlsxml(1,ifld)=j
            iget(100)=ifld
            ident(ifld) = 100
            iavblfld(ifld)=ithfld
            found_fld=.true.
            ifld=ifld+1
           else if(abs(param%level(j)-18)<small.and.abs(param%level2(j)-47)<small)then
            lvls(1,ifld)=j
            lvlsxml(1,ifld)=j
            iget(101)=ifld
            ident(ifld) = 101
            iavblfld(ifld)=ithfld
            found_fld=.true.
            ifld=ifld+1
           else if(abs(param%level(j)-84)<small.and.abs(param%level2(j)-98)<small)then
            lvls(1,ifld)=j
            lvlsxml(1,ifld)=j
            iget(102)=ifld
            ident(ifld) = 102
            iavblfld(ifld)=ithfld
            found_fld=.true.
            ifld=ifld+1
           else if(abs(param%level(j)-44)<small.and.abs(param%level2(j)-100)<small)then
            lvls(1,ifld)=j
            lvlsxml(1,ifld)=j
            iget(318)=ifld
            ident(ifld) = 318
            iavblfld(ifld)=ithfld
            found_fld=.true.
            ifld=ifld+1
           else if(abs(param%level(j)-44)<small.and.abs(param%level2(j)-72)<small)then
            lvls(1,ifld)=j
            lvlsxml(1,ifld)=j
            iget(320)=ifld
            ident(ifld) = 320
            iavblfld(ifld)=ithfld
            found_fld=.true.
            ifld=ifld+1
           else if(abs(param%level(j)-72)<small.and.abs(param%level2(j)-94)<small)then
            lvls(1,ifld)=j
            lvlsxml(1,ifld)=j
            iget(319)=ifld
            ident(ifld) = 319
            iavblfld(ifld)=ithfld
            found_fld=.true.
            ifld=ifld+1
           endif
!          print *,'n getlvls,RH_sigma_lvl,ifld=',ifld-1,'ident(ifld)=',IDENT(IFLD-1), &
!           'iget=',iget(IDENT(IFLD-1)),'IAVBLFLD(IFLD-1)=',IAVBLFLD(IFLD-1),'lvl=',lvls(1,ifld-1), &
!           'iget(66)=',iget(66)
         enddo
         ifld=ifld-1
      endif
!
      if(trim(param%pname)=='RH'.and.trim(param%fixed_sfc1_type)=='sigma_lvl'.and.  &
          trim(param%fixed_sfc2_type)=='') then
         do j=1, nlevel
           if(abs(param%level(j)-9823)<small)then
            lvls(1,ifld)=j
            lvlsxml(1,ifld)=j
            iget(094)=ifld
            ident(ifld) = 094
            iavblfld(ifld)=ithfld
            found_fld=.true.
            ifld=ifld+1
           else if(abs(param%level(j)-9950)<small)then
            lvls(1,ifld)=j
            lvlsxml(1,ifld)=j
            iget(323)=ifld
            ident(ifld) = 323
            iavblfld(ifld)=ithfld
            found_fld=.true.
            ifld=ifld+1
           endif
!          print *,'in getlvls,RH_sigma_lvl,1 lvl,ifld=',ifld-1,'ident(ifld)=',IDENT(IFLD-1), &
!           'iget=',iget(IDENT(IFLD-1)),'IAVBLFLD(IFLD-1)=',IAVBLFLD(IFLD-1),'lvl=',lvls(1,ifld-1), &
!           'iget(66)=',iget(66)
         enddo
         ifld=ifld-1
      endif
!
      if(trim(param%fixed_sfc1_type)=='sigma_lvl'.and.trim(param%pname)=='PRES') then
         do j=1, nlevel
           if(abs(param%level(j)-98230)<small)then
            lvls(1,ifld)=1
            lvlsxml(1,ifld)=j
            iget(091)=ifld
            ident(ifld) = 091
            iavblfld(ifld)=ithfld
            found_fld=.true.
           endif
         enddo
      endif
!
      if(trim(param%fixed_sfc1_type)=='sigma_lvl'.and.trim(param%pname)=='TMP') then
         do j=1, nlevel
           if(abs(param%level(j)-9823)<small1)then
            lvls(1,ifld)=1
            lvlsxml(1,ifld)=j
            iget(092)=ifld
            ident(ifld) = 092
            iavblfld(ifld)=ithfld
            found_fld=.true.
            lincfld=.true.
            ifld=ifld+1
           else if(abs(param%level(j)-8967)<small1)then
            lvls(1,ifld)=1
            lvlsxml(1,ifld)=j
            iget(097)=ifld
            ident(ifld) = 097
            iavblfld(ifld)=ithfld
            found_fld=.true.
            lincfld=.true.
            ifld=ifld+1
           else if(abs(param%level(j)-7848)<small1)then
            if(me==0)print *,'indie tmp sigma 7848'
            lvls(1,ifld)=1
            lvlsxml(1,ifld)=j
            iget(098)=ifld
            ident(ifld) = 098
            iavblfld(ifld)=ithfld
            found_fld=.true.
            lincfld=.true.
            ifld=ifld+1
           else if(abs(param%level(j)-9950)<small1)then
            lvls(1,ifld)=1
            lvlsxml(1,ifld)=j
            iget(321)=ifld
            ident(ifld) = 321
            iavblfld(ifld)=ithfld
            found_fld=.true.
            lincfld=.true.
            ifld=ifld+1
           endif
         enddo
         if(lincfld) ifld=ifld-1
         do j=1, nlevel
           if(abs(param%level(j)-7000)<small1.or. abs(param%level(j)-7500)<small1 &
            .or. abs(param%level(j)-8000)<small1 .or. abs(param%level(j)-8500)<small1 &
            .or. abs(param%level(j)-9000)<small )then
            iget(296)=ifld
            ident(ifld) = 296
            iavblfld(ifld)=ithfld
            found_fld=.true.
            if(abs(param%level(j)-7000)<small1)then
              lvls(1,ifld)=1
              lvlsxml(1,ifld)=j
            else if(abs(param%level(j)-7500)<small1)then
              lvls(2,ifld)=1
              lvlsxml(2,ifld)=j
            else if(abs(param%level(j)-8000)<small1)then
              lvls(3,ifld)=1
              lvlsxml(3,ifld)=j
            else if(abs(param%level(j)-8500)<small1)then
              lvls(4,ifld)=1
              lvlsxml(4,ifld)=j
            else if(abs(param%level(j)-9000)<small1)then
              lvls(5,ifld)=1
              lvlsxml(5,ifld)=j
            endif
           endif
         enddo
      endif
!
!
      if(trim(param%fixed_sfc1_type)=='sigma_lvl'.and.trim(param%pname)=='SPF_H') then
         do j=1, nlevel
           if(abs(param%level(j)-98230)<small)then
            lvls(1,ifld)=1
            lvlsxml(1,ifld)=j
            iget(093)=ifld
            ident(ifld) = 093
            iavblfld(ifld)=ithfld
            found_fld=.true.
           endif
         enddo
      endif
!
      if(trim(param%fixed_sfc1_type)=='sigma_lvl'.and.trim(param%pname)=='U_GRD') then
         do j=1, nlevel
           if(abs(param%level(j)-98230)<small)then
            lvls(1,ifld)=1
            lvlsxml(1,ifld)=j
            iget(095)=ifld
            ident(ifld) = 095
            iavblfld(ifld)=ithfld
            found_fld=.true.
            ifld=ifld+1
           else if(abs(param%level(j)-9950)<small)then
            lvls(1,ifld)=1
            lvlsxml(1,ifld)=j
            iget(324)=ifld
            ident(ifld) = 324
            iavblfld(ifld)=ithfld
            found_fld=.true.
            ifld=ifld+1
           endif
         enddo
         ifld=ifld-1
      endif
!
      if(trim(param%fixed_sfc1_type)=='sigma_lvl'.and.trim(param%pname)=='V_GRD') then
         do j=1, nlevel
           if(abs(param%level(j)-98230)<small)then
            lvls(1,ifld)=1
            lvlsxml(1,ifld)=j
            iget(096)=ifld
            ident(ifld) = 096
            iavblfld(ifld)=ithfld
            found_fld=.true.
            ifld=ifld+1
           else if(abs(param%level(j)-9950)<small)then
            lvls(1,ifld)=1
            lvlsxml(1,ifld)=j
            iget(325)=ifld
            ident(ifld) = 325
            iavblfld(ifld)=ithfld
            found_fld=.true.
            ifld=ifld+1
           endif
         enddo
         ifld=ifld-1
      endif
!
      if(trim(param%fixed_sfc1_type)=='sigma_lvl'.and.trim(param%pname)=='PWAT') then
         do j=1, nlevel
           if(abs(param%level(j)-33)<small.and.abs(param%level2(j)-100)<small)then
            lvls(1,ifld)=1
            lvlsxml(1,ifld)=j
            iget(104)=ifld
           endif
         enddo
      endif
      if(trim(param%fixed_sfc1_type)=='sigma_lvl'.and.trim(param%pname)=='MCONV') then
         do j=1, nlevel
           if(abs(param%level(j)-85)<small.and.abs(param%level2(j)-100)<small)then
            lvls(1,ifld)=1
            lvlsxml(1,ifld)=j
            iget(103)=ifld
           endif
         enddo
      endif
      if(trim(param%fixed_sfc1_type)=='sigma_lvl'.and.trim(param%pname)=='V_VEL') then
         do j=1, nlevel
           if(abs(param%level(j)-9950)<small)then
            lvls(1,ifld)=1
            lvlsxml(1,ifld)=j
            iget(326)=ifld
           endif
         enddo
      endif
!
!for CAPE
      if(trim(param%pname)=='CAPE') then
        if(trim(param%fixed_sfc1_type)=='surface') then
          iget(032)=ifld
          lvls(1,ifld)=ifld
          lvlsxml(1,ifld)=j
          ident(ifld) = 032
          iavblfld(ifld)=ithfld
        elseif (trim(param%fixed_sfc1_type)=='spec_pres_above_grnd'.and.   &
          trim(param%fixed_sfc2_type)=='spec_pres_above_grnd' ) then
          do j=1, nlevel
            if(abs(param%level(j)-18000.)<small1.and.abs(param%level2(j)-0.)<small1)then
              iget(566)=ifld
              lvls(1,ifld)=1
              lvlsxml(1,ifld)=j
              ident(ifld) = 566
              iavblfld(ifld)=ithfld
!jw            elseif(abs(param%level(j)-9000.)<small1.and.abs(param%level2(j)-0.)<small1)then
!jw              LVLS(2,IFLD)=1
!jw              LVLSXML(2,ifld)=j
!jw            elseif(abs(param%level(j)-25500.)<small1.and.abs(param%level2(j)-0.)<small1)then
!jw              LVLS(3,IFLD)=1
!jw              LVLSXML(3,ifld)=j
            endif
          enddo
        endif
        return
      endif
!
!
!for CIN
      if(trim(param%pname)=='CIN') then
        if(trim(param%fixed_sfc1_type)=='surface') then
          iget(107)=ifld
          lvls(1,ifld)=ifld
          ident(ifld) = 107
          iavblfld(ifld)=ithfld
        elseif (trim(param%fixed_sfc1_type)=='spec_pres_above_grnd'.and.   &
          trim(param%fixed_sfc2_type)=='spec_pres_above_grnd' ) then
          do j=1, nlevel
            if(abs(param%level(j)-18000.)<small1.and.abs(param%level2(j)-0.)<small1)then
              iget(567)=ifld
              lvls(1,ifld)=1
              lvlsxml(1,ifld)=j
              ident(ifld) = 567
              iavblfld(ifld)=ithfld
            endif
          enddo
        endif
        return
      endif
!
!for pv sfc
      if(trim(param%fixed_sfc1_type)=='pot_vort_sfc') then
         do j=1, nlevel
           scalef=param%scale_fact_fixed_sfc1(j)-6
           if(param%scale_fact_fixed_sfc1(j)<6) scalef=0
        iloop3:  do i=1, kpv
           if(pv(i)/=0.and.abs(param%level(j)*10.**(-1*scalef)-pv(i))<=1.e-5) then
            lvls(i,ifld)=1
            lvlsxml(i,ifld)=j
            exit iloop3
           endif
         enddo iloop3
         enddo
!        print *,'for level type pv,nlevel=',nlevel,'level=',  &
!          param%level(1:nlevel)*10.**(-1*scalef), &
!          'pv=',pv(1:kpv),lvls1(1:kpv),'ifld=',ifld,'var=',trim(param%pname), &
!          'lvl type=',trim(param%fixed_sfc1_type)
      endif
!
      if(trim(param%fixed_sfc1_type)=='spec_alt_above_mean_sea_lvl') then
         do j=1, nlevel
        iloop4:  do i=1, nfd
           if(nint(param%level(j))==nint(htfd(i)) )then
            if(htfd(i)>300.) then
              lvls(i,ifld)=1
            else
              lvls(i,ifld)=2
            endif
            lvlsxml(i,ifld)=j
            exit iloop4
           endif
         enddo iloop4
         enddo
      endif
!
      if(trim(param%fixed_sfc1_type)=='spec_pres_above_grnd') then
         do j=1, nlevel
        iloop5:  do i=1, nbnd
           if(nint(param%level(j)/100.)==nint(petabnd(i)+15.))then
            lvls(i,ifld)=1
            lvlsxml(i,ifld)=j
            exit iloop5
           endif
         enddo iloop5
         if(nint(param%level(j)/100.)==255) then
           lvls(nbnd+1,ifld)=1
           lvlsxml(nbnd+1,ifld)=j
     endif
         enddo
      endif
!
      if(trim(param%fixed_sfc1_type)=='spec_hgt_lvl_above_grnd') then
         do j=1, nlevel
            lvls(j,ifld)=1
            lvlsxml(j,ifld)=j
         enddo
      endif
!     
      end