histfilemod.f90

来自「CCSM Research Tools: Community Atmospher」· F90 代码 · 共 1,643 行 · 第 1/5 页

         'snow height', .true., histfld)

    call histfldini(nflds, 'SNOWAGE ', 'unitless', nsing, naver,  &
         'snow age', .true., histfld)

! soil time invariant properties (note that lake levels and
! depths do not appear in the fields DZSOI and ZSOI)

    call histfldini(nflds, 'WATSAT  ', 'mm3/mm3 ', nsoil, ncnst,  &
         'saturated soil water content (porosity)', .true., histfld)

    call histfldini(nflds, 'SUCSAT  ', 'mm      ', nsoil, ncnst,  &
         'saturated soil matric potential', .true., histfld) 

    call histfldini(nflds, 'BSW     ', 'unitless', nsoil, ncnst,  &
         'slope of soil water retention curve', .true., histfld) 

    call histfldini(nflds, 'ZSOI    ', 'm       ', nsoil, ncnst,  &
         'soil depth', .true., histfld)

    call histfldini(nflds, 'DZSOI   ', 'm       ', nsoil, ncnst,  &
         'soil thickness', .true., histfld) 

! temperatures

    call histfldini(nflds, 'TSA     ', 'K       ', nsing, naver,  &
         '2 m air temperature', .true., histfld)

    call histfldini(nflds, 'TV      ', 'K       ', nsing, naver,  &
         'vegetation temperature', .true., histfld)

    call histfldini(nflds, 'TG      ', 'K       ', nsing, naver,  &
         'ground temperature', .true., histfld)

    call histfldini(nflds, 'TSOI    ', 'K       ', nsoil, naver,  &  
         'soil temperature', .true., histfld)

    call histfldini(nflds, 'TLAKE   ', 'K       ', nsoil, naver,  &  
         'lake temperature', .true., histfld)

    call histfldini(nflds, 'TSNOW   ', 'K       ', nsing, naver,  &
        'snow temperature', .true., histfld)

! surface radiation                                          

    call histfldini(nflds, 'FSA     ', 'watt/m^2', nsing, naver,  &
         'absorbed solar radiation', .true., histfld)

    call histfldini(nflds, 'FSR     ', 'watt/m^2', nsing, naver,  &
         'reflected solar radiation', .true., histfld)

    call histfldini(nflds, 'NDVI    ', 'unitless', nsing, naver,  &
         'surface ndvi',     .true., histfld)

    call histfldini(nflds, 'FIRA    ', 'watt/m^2', nsing, naver,  &
         'net infrared (longwave) radiation', .true., histfld)

    call histfldini(nflds, 'FIRE    ', 'watt/m^2', nsing, naver,  &
         'emitted infrared (longwave) radiation',.true., histfld)

! surface energy fluxes                                      

    call histfldini(nflds, 'FCTR    ', 'watt/m^2', nsing, naver,  &
         'canopy transpiration',  .true., histfld)

    call histfldini(nflds, 'FCEV    ', 'watt/m^2', nsing, naver,  &
         'canopy evaporation',  .true., histfld)

    call histfldini(nflds, 'FGEV    ', 'watt/m^2', nsing, naver,  &
         'ground evaporation',  .true., histfld)

    call histfldini(nflds, 'FSH     ', 'watt/m^2', nsing, naver,  &
         'sensible heat',  .true., histfld)

    call histfldini(nflds, 'FGR     ', 'watt/m^2', nsing, naver,  &
         'heat flux into soil',  .true., histfld)

    call histfldini(nflds, 'FSM     ', 'watt/m^2', nsing, naver,  &
         'snow melt heat flux',  .true., histfld)

    call histfldini(nflds, 'TAUX    ', 'kg/m/s^2', nsing, naver,  &
         'zonal surface stress',      .true., histfld)

    call histfldini(nflds, 'TAUY    ', 'kg/m/s^2', nsing, naver,  &
         'meridional surface stress',      .true., histfld)

! vegetation phenology                                       

    call histfldini(nflds, 'ELAI    ', 'm^2/m^2 ', nsing, naver,  &
         'exposed one-sided leaf area index',  .true., histfld)

    call histfldini(nflds, 'ESAI    ', 'm^2/m^2 ', nsing, naver,  &
         'exposed one-sided stem area index',  .true., histfld)

! canopy physiology                                          

    call histfldini(nflds, 'RSSUN   ', 's/m     ', nsing, nmini,  &
         'sunlit leaf stomatal resistance',  .true., histfld)

    call histfldini(nflds, 'RSSHA   ', 's/m     ', nsing, nmini,  &
         'shaded leaf stomatal resistance',  .true., histfld)

    call histfldini(nflds, 'BTRAN   ', 'unitless', nsing, naver,  &
         'transpiration beta factor', .true., histfld)       

    call histfldini(nflds, 'FPSN    ', 'umol/m2s', nsing, naver,  &
         'photosynthesis',  .true., histfld)

! hydrology

    call histfldini(nflds, 'H2OSOI  ', 'mm3/mm3 ', nsoil, naver,  &
         'volumetric soil water', .true., histfld)           

    call histfldini(nflds, 'H2OSNO  ', 'mm      ', nsing, naver,  &
         'snow depth (liquid water)', .true., histfld)       

    call histfldini(nflds, 'H2OCAN  ', 'mm      ', nsing, naver,  &
         'intercepted water', .true., histfld)               

    call histfldini(nflds, 'SOILLIQ', 'kg/m2    ', nsoil, naver,  &
        'soil liquid water', .true., histfld)

    call histfldini(nflds, 'SOILICE', 'kg/m2    ', nsoil, naver,  &
        'soil ice', .true., histfld)

    call histfldini(nflds, 'SNOWLIQ', 'kg/m2    ', nsing, naver,  &
        'snow liquid water', .true., histfld)

    call histfldini(nflds, 'SNOWICE', 'kg/m2    ', nsing, naver,  &
        'snow ice', .true., histfld)

    call histfldini(nflds, 'QINFL   ', 'mm/S    ', nsing, naver,  &
         'infiltration', .true., histfld)                    

    call histfldini(nflds, 'QOVER   ', 'mm/S    ', nsing, naver,  &
         'surface runoff', .true., histfld)                  

    call histfldini(nflds, 'QRGWL   ', 'mm/S    ', nsing, naver,  &
         'surf runoff at glaciers, wetlands, lakes', .true., histfld)

    call histfldini(nflds, 'QDRAI   ', 'mm/S    ', nsing, naver,  &
         'sub-surface drainage', .true., histfld)

    call histfldini(nflds, 'QINTR   ', 'mm/S    ', nsing, naver,  &
         'interception',      .true., histfld)        

    call histfldini(nflds, 'QDRIP   ', 'mm/S    ', nsing, naver,  &
         'throughfall',      .true., histfld)         

    call histfldini(nflds, 'QMELT   ', 'mm/S    ', nsing, naver,  &
         'snow melt',      .true., histfld)            

    call histfldini(nflds, 'QSOIL   ', 'mm/S    ', nsing, naver,  &
         'ground evaporation',      .true., histfld)   

    call histfldini(nflds, 'QVEGE   ', 'mm/S    ', nsing, naver,  &
         'canopy evaporation',      .true., histfld)   

    call histfldini(nflds, 'QVEGT   ', 'mm/S    ', nsing, naver,  &
         'canopy transpiration',      .true., histfld) 

#ifdef RTM
    call histfldini(nflds, 'QCHOCNR ', 'm3/s    ', nsing, naver,  &
         'RTM river discharge into ocean', .true., histfld)

    call histfldini(nflds, 'QCHANR  ', 'M3/S    ', nsing, naver,  &
         'RTM river flow (maximum subgrid flow)', .true., histfld)     
#endif

! water and energy balance checks

    call histfldini(nflds, 'ERRSOI  ', 'watt/m^2', nsing, naver,  &
         'soil/lake energy conservation error', .true., histfld)

    call histfldini(nflds, 'ERRSEB  ', 'watt/m^2', nsing, naver,  &
         'surface energy conservation error',  .true., histfld)

    call histfldini(nflds, 'ERRSEBMX', 'watt/m^2', nsing, nmaxi,  &
         'maximum of surface energy conservation error',  .true., histfld)

    call histfldini(nflds, 'ERRSOL  ', 'watt/m^2', nsing, naver,  &
         'solar radiation conservation error',  .true., histfld)

    call histfldini(nflds, 'ERRH2O  ', 'mm      ', nsing, naver,  &
         'total water conservation error',  .true., histfld)

! atmospheric forcing                                

    call histfldini(nflds, 'RAIN    ', 'mm/S    ', nsing, naver,  &
         'rain',      .true., histfld)

    call histfldini(nflds, 'SNOW    ', 'mm/S    ', nsing, naver,  &
         'snow',      .true., histfld)

    call histfldini(nflds, 'TBOT    ', 'K       ', nsing, naver,  &
         'atmospheric air temperature',  .true., histfld)

    call histfldini(nflds, 'WIND    ', 'm/s     ', nsing, naver,  &
         'atmospheric wind velocity magnitude',  .true., histfld)

    call histfldini(nflds, 'THBOT   ', 'K       ', nsing, naver,  &
         'atmospheric air potential temperature',  .true., histfld)

    call histfldini(nflds, 'QBOT    ', 'kg/kg   ', nsing, naver,  &
         'atmospheric specific humidity',  .true., histfld)

    call histfldini(nflds, 'ZBOT    ', 'M       ', nsing, naver,  &
         'atmospheric reference height',  .true., histfld)

    call histfldini(nflds, 'FLDS    ', 'watt/m^2', nsing, naver,  &
         'incident longwave radiation',  .true., histfld)

    call histfldini(nflds, 'FSDS    ', 'watt/m^2', nsing, naver,  &
         'incident solar radiation',  .true., histfld)

#if (defined OFFLINE)
! accumulation variables                             

    call histfldini(nflds, 'TDA     ', 'K       ', nsing, ninst,  &
         'daily average 2-m temperature', .false., histfld)

    call histfldini(nflds, 'T15     ', 'K       ', nsing, ninst,  &
         '15-day running mean of 2-m temperature', .false., histfld)

    call histfldini(nflds, 'AGDD0   ', 'K       ', nsing, ninst,  &
         'growing degree-days base 0C', .false., histfld)

    call histfldini(nflds, 'AGDD5   ', 'K       ', nsing, ninst,  &
         'growing degree-days base 5C', .false., histfld)

#endif

! use namelist variable [hist_chntyp] to override default [histfld%type] variable 

    do i = 1, nflds
       do j = 1, maxalflds
          if (histfld%name(i) == hist_chntyp(1,j)) then
             if (hist_chntyp(2,j)==naver .or. hist_chntyp(2,j)==nmaxi .or. &
                 hist_chntyp(2,j)==nmini .or. hist_chntyp(2,j)==ninst) then
                histfld%type(i) = hist_chntyp(2,j)
             else
                write(6,*) 'HISTLST error: attempting to change', &
                     ' field type for field = ',histfld%name(i) 
                write(6,*) 'to inaccurate type = ',hist_chntyp(2,j), &
                     '. valid types are: ',naver,nmaxi,nmini,ninst
                call endrun
             end if
          end if
       end do
    end do

! use namelist variable [hist_fldadd] to add to default active fields

    do i = 1, nflds
       do j = 1, maxalflds
          if (histfld%name(i) == hist_fldadd(j)) then
             histfld%active(i) = .true.
          endif
       end do
    end do

! number of active fields (nacti <= nflds) and pointer (1 to nflds)

    nacti = 0
    do i = 1, nflds
       if (histfld%active(i)) then
          nacti = nacti + 1
          ind(nacti) = i
       end if
    end do

! re-order fields from 1 -> nflds to 1 -> nacti

    do i = 1, nacti
       tempfld%name(i)   = histfld%name(ind(i))
       tempfld%unit(i)   = histfld%unit(ind(i))
       tempfld%levl(i)   = histfld%levl(ind(i))
       tempfld%type(i)   = histfld%type(ind(i))
       tempfld%desc(i)   = histfld%desc(ind(i))
    end do
    do i = 1, nacti
       histfld%name(i)   = tempfld%name(i) 
       histfld%unit(i)   = tempfld%unit(i) 
       histfld%levl(i)   = tempfld%levl(i) 
       histfld%type(i)   = tempfld%type(i) 
       histfld%desc(i)   = tempfld%desc(i)   
    end do

! separate single-level and multi-level fields for primary history files

    slfld%num(1) = 0
    mlsoifld%num(1) = 0
    do i = 1, nacti
       if (histfld%levl(i) == nsing) then
          slfld%num(1) = slfld%num(1) + 1
          n = slfld%num(1)
          slfld%nam(n,1) = histfld%name(i)
          slfld%uni(n,1) = histfld%unit(i)
          slfld%typ(n,1) = histfld%type(i)
          slfld%des(n,1) = histfld%desc(i)
       else if (histfld%levl(i) == nsoil) then
          mlsoifld%num(1) = mlsoifld%num(1) + 1
          n = mlsoifld%num(1)
          mlsoifld%nam(n,1) = histfld%name(i)
          mlsoifld%uni(n,1) = histfld%unit(i)
          mlsoifld%typ(n,1) = histfld%type(i)
          mlsoifld%des(n,1) = histfld%desc(i)
       end if
    end do
    if (slfld%num(1) > max_slevflds) then
       write(6,*) 'HISTLST error: number single-level fields', &
            ' for primary files > parameter max_slevflds'
       call endrun
    endif
    if (mlsoifld%num(1) > max_mlevflds) then
       write(6,*) 'HISTLST error: number multi-level soil fields', &
            ' for primary files > parameter max_mlevflds'
       call endrun
    endif

! now make list of single-level and multi-level fields for auxillary files

    slfld%num(2:nhist) = 0
    mlsoifld%num(2:nhist) = 0
    do k = 2, nhist
       do j = 1, nacti
          do i = 1, slfld%num(1)
             if (fldaux(j,k-1) == slfld%nam(i,1)) then
                slfld%num(k) = slfld%num(k) + 1