Line data    Source code

       1             : module savefield_waccm
       2             :   use shr_kind_mod,only: r8 => shr_kind_r8 ! 8-byte reals
       3             :   use cam_history ,only: hist_fld_active,outfld  ! Routine to output fields to history files
       4             : !
       5             : ! Save fields to WACCM output history file.
       6             : !
       7             :   implicit none
       8             :   private
       9             :   public :: savefld_waccm
      10             : 
      11             : contains
      12             : !-----------------------------------------------------------------------
      13      204288 :   subroutine savefld_waccm(f,name,nlev,i0,i1,j0,j1)
      14             : !
      15             : ! Save field to WACCM history. 
      16             : ! Call to addfld must be made in edyn_init for each field to be saved.
      17             : ! Field names must be in user_nl_cam to be written to the file. 
      18             : !
      19             : ! Args:
      20             :     integer,intent(in) :: nlev,i0,i1,j0,j1
      21             :     real(r8),dimension(nlev,i0:i1,j0:j1),intent(in) :: f
      22             :     character(len=*),intent(in) :: name
      23             : !
      24             : ! Local:
      25             :     integer :: i,j,k
      26      204288 :     real(r8) :: diag_ik(i0:i1,nlev)
      27             : !
      28      204288 :     if (.not.hist_fld_active(name)) return
      29             : 
      30           0 :     if (nlev /= 1) then
      31           0 :       do j=j0,j1
      32           0 :         do i=i0,i1
      33           0 :           do k=1,nlev
      34           0 :             diag_ik(i,k) = f(nlev-k+1,i,j)
      35             :           enddo
      36             :         enddo
      37           0 :         call outfld(name,diag_ik,i1-i0+1,j)
      38             :       enddo
      39             :     else
      40           0 :       do j=j0,j1
      41           0 :         do i=i0,i1
      42           0 :           diag_ik(i,1) = f(1,i,j)
      43             :         enddo
      44           0 :         call outfld(name,diag_ik,i1-i0+1,j)
      45             :       enddo
      46             :     endif
      47             :   end subroutine savefld_waccm
      48             : 
      49             : end module savefield_waccm