output.F90 9.51 KB
Newer Older
1
#include "fabm_driver.h"
2
#include "fabm_0d.h"
3 4 5 6 7 8 9 10 11 12 13
!-----------------------------------------------------------------------
!BOP
!
! !MODULE: Output manager
!
! !INTERFACE:
   module output
!
! !DESCRIPTION:
! TODO
!
14
   ! From FABM
15 16
   use fabm
   use fabm_types
17
   use fabm_driver
18
   use fabm_properties
19

20
   ! From GOTM
21
   use time
22 23 24
   use field_manager
   use output_manager_core, only:output_manager_host=>host, type_output_manager_host=>type_host
   use output_manager
25 26 27 28 29 30 31

   use shared

   implicit none

   private

32 33 34 35 36 37 38 39 40 41 42
   public configure_output, init_output, do_output, clean_output

   public register_output_fields, fm

   type,extends(type_output_manager_host) :: type_fabm0d_host
   contains
      procedure :: julian_day    => fabm0d_host_julian_day
      procedure :: calendar_date => fabm0d_host_calendar_date
   end type

   type (type_field_manager), target :: fm
43

44 45
   integer, parameter :: ASCII_FMT  = 1
   integer, parameter :: NETCDF_FMT = 2
46

47
   character(len=PATH_MAX) :: output_file
48
   integer, public :: output_format
49 50 51 52
   logical :: add_environment
   logical :: add_conserved_quantities
   logical :: add_diagnostic_variables
   integer(timestepkind) :: nsave
53

Jorn Bruggeman's avatar
Jorn Bruggeman committed
54
   integer                    :: out_unit = -1
55 56 57 58 59 60 61

   character, parameter       :: separator = char(9)
!EOP
!-----------------------------------------------------------------------

   contains

62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80
!-----------------------------------------------------------------------
!BOP
! !IROUTINE: configure output from namelists or YAML
!
! !INTERFACE:
   subroutine configure_output(namlst)
!
! !DESCRIPTION:
! TODO
!
! !INPUT PARAMETERS:
   integer, intent(in) :: namlst
!
! !REVISION HISTORY:
!  Original author(s): Karsten Bolding
!
! !LOCAL PARAMETERS:
   namelist /output/ output_file,output_format,nsave,add_environment, &
                     add_diagnostic_variables, add_conserved_quantities
81
   integer :: ios
82 83 84 85 86 87 88 89 90 91 92 93
!
!EOP
!-----------------------------------------------------------------------
!BOC
   ! Read output namelist
   output_file = ''
   output_format = ASCII_FMT
   nsave = 1
   add_environment = .false.
   add_conserved_quantities = .false.
   add_diagnostic_variables = .false.

94 95
   read(namlst,nml=output,iostat=ios)
   if (ios/=0) call driver%fatal_error('configure_output','run.nml: I could not read the "output" namelist.')
96
   if (output_file=='') call driver%fatal_error('configure_output','run.nml: "output_file" must be set to a valid file path in "output" namelist.')
Knut's avatar
Knut committed
97

98 99 100
   end subroutine configure_output
!EOC

101 102 103 104 105
!-----------------------------------------------------------------------
!BOP
! !IROUTINE: prepare for output
!
! !INTERFACE:
106
   subroutine init_output(start)
107 108 109 110 111
!
! !DESCRIPTION:
! TODO
!
! !INPUT PARAMETERS:
112
   character(len=*), intent(in) :: start
113 114 115 116 117
!
! !REVISION HISTORY:
!  Original author(s): Karsten Bolding
!
! !LOCAL PARAMETERS:
Jorn Bruggeman's avatar
Jorn Bruggeman committed
118 119
   integer          :: i
   real(rk),pointer :: pdata
120 121 122
!EOP
!-----------------------------------------------------------------------
!BOC
Jorn Bruggeman's avatar
Jorn Bruggeman committed
123 124 125
   do i=1,size(model%interior_state_variables)
      pdata => model%get_data(model%get_interior_variable_id(model%interior_state_variables(i)%name))
      call fm%send_data(model%interior_state_variables(i)%name, pdata)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
126 127 128 129 130 131 132 133 134 135
   end do
   do i=1,size(model%bottom_state_variables)
      pdata => model%get_data(model%get_horizontal_variable_id(model%bottom_state_variables(i)%name))
      call fm%send_data(model%bottom_state_variables(i)%name, pdata)
   end do
   do i=1,size(model%surface_state_variables)
      pdata => model%get_data(model%get_horizontal_variable_id(model%surface_state_variables(i)%name))
      call fm%send_data(model%surface_state_variables(i)%name, pdata)
   end do

Jorn Bruggeman's avatar
Jorn Bruggeman committed
136 137
   do i=1,size(model%interior_diagnostic_variables)
      if (model%interior_diagnostic_variables(i)%save) then
Jorn Bruggeman's avatar
Jorn Bruggeman committed
138
         pdata => model%get_interior_diagnostic_data(i)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
139
         call fm%send_data(model%interior_diagnostic_variables(i)%name, pdata)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
140
      end if
Jorn Bruggeman's avatar
Jorn Bruggeman committed
141 142
   end do
   do i=1,size(model%horizontal_diagnostic_variables)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
143 144 145 146
      if (model%horizontal_diagnostic_variables(i)%save) then
         pdata => model%get_horizontal_diagnostic_data(i)
         call fm%send_data(model%horizontal_diagnostic_variables(i)%name, pdata)
      end if
Jorn Bruggeman's avatar
Jorn Bruggeman committed
147
   end do
148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170

   end subroutine init_output
!EOC

!-----------------------------------------------------------------------
!BOP
! !IROUTINE: do the output
!
! !INTERFACE:
   subroutine do_output(n)
!
! !DESCRIPTION:
! TODO
!
! !INPUT PARAMETERS:
   integer(timestepkind), intent(in) :: n
!
! !REVISION HISTORY:
!  Original author(s): Karsten Bolding
!
!EOP
!-----------------------------------------------------------------------
!BOC
Jorn Bruggeman's avatar
Jorn Bruggeman committed
171
   call output_manager_save(julianday,secondsofday,int(n))
172 173 174

   end subroutine do_output
!EOC
Knut's avatar
Knut committed
175

176 177 178 179 180 181
!-----------------------------------------------------------------------
!BOP
!
! !IROUTINE: Clean up.
!
! !INTERFACE:
182
   subroutine clean_output(ignore_errors)
183 184 185 186
!
! !DESCRIPTION:
! Close all open files.
!
187 188 189
! !INPUT PARAMETERS:
   logical, intent(in) :: ignore_errors
!
190 191 192 193 194 195 196 197
! !REVISION HISTORY:
!  Original author(s): Jorn Bruggeman
!
! !LOCAL PARAMETERS:
   integer :: iret
!EOP
!-----------------------------------------------------------------------
!BOC
Jorn Bruggeman's avatar
Jorn Bruggeman committed
198 199

   if (out_unit/=-1) close(out_unit)
200

201 202 203
   call output_manager_clean()
   call fm%finalize()

204 205 206
   end subroutine clean_output
!EOC

207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224
   subroutine register_output_fields()

   integer :: i
   logical :: in_output

   LEVEL1 'output_manager'
   allocate(type_fabm0d_host::output_manager_host)
   call output_manager_init(fm,title)

   LEVEL1 'field_manager'
   call fm%register_dimension('lon',1,id=id_dim_lon)
   call fm%register_dimension('lat',1,id=id_dim_lat)
   call fm%register_dimension('time',id=id_dim_time)
   call fm%initialize(prepend_by_default=(/id_dim_lon,id_dim_lat/),append_by_default=(/id_dim_time/))
   call fm%register('lon','degrees_east','longitude',dimensions=(/id_dim_lon/),no_default_dimensions=.true.,data0d=longitude,coordinate_dimension=id_dim_lon)
   call fm%register('lat','degrees_north','latitude',dimensions=(/id_dim_lat/),no_default_dimensions=.true.,data0d=latitude,coordinate_dimension=id_dim_lat)

   call fm%register('par','W/m^2','par',standard_name='downwelling_photosynthetic_radiative_flux',data0d=par)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
225 226
   call fm%register('temp','Celsius','temperature',standard_name='sea_water_temperature',data0d=temp%value)
   call fm%register('salt','1e-3','salinity',standard_name='sea_water_practical_salinity',data0d=salt%value)
227 228

   ! state variables
Jorn Bruggeman's avatar
Jorn Bruggeman committed
229 230
   do i=1,size(model%interior_state_variables)
      in_output = register(model%interior_state_variables(i))
231 232 233 234 235 236 237 238 239
   end do
   do i=1,size(model%bottom_state_variables)
      in_output = register(model%bottom_state_variables(i))
   end do
   do i=1,size(model%surface_state_variables)
      in_output = register(model%surface_state_variables(i))
   end do

   ! diagnostic variables
Jorn Bruggeman's avatar
Jorn Bruggeman committed
240 241
   do i=1,size(model%interior_diagnostic_variables)
      model%interior_diagnostic_variables(i)%save = register(model%interior_diagnostic_variables(i))
242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257
   end do
   do i=1,size(model%horizontal_diagnostic_variables)
      model%horizontal_diagnostic_variables(i)%save = register(model%horizontal_diagnostic_variables(i))
   end do

   ! conserved quantities
   do i=1,size(model%conserved_quantities)
      call fm%register('int_change_in_'//trim(model%conserved_quantities(i)%name), trim(model%conserved_quantities(i)%units)//'*m', 'integrated change in '//trim(model%conserved_quantities(i)%long_name), &
                        minimum=model%conserved_quantities(i)%minimum, maximum=model%conserved_quantities(i)%maximum, fill_value=model%conserved_quantities(i)%missing_value, &
                        category='fabm/conservation', output_level=output_level_default, used=in_output, data0d=int_change_in_totals(i))
      if (in_output) compute_conserved_quantities = .true.
   end do

   contains

   function register(variable) result(used)
Jorn Bruggeman's avatar
Jorn Bruggeman committed
258 259
      class (type_fabm_variable), intent(in) :: variable
      logical                                :: used
260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295

      integer                        :: output_level
      type (type_field),     pointer :: field
      class (type_property), pointer :: property

      output_level = output_level_default
      if (variable%output==output_none) output_level = output_level_debug
      call fm%register(variable%name, variable%units, variable%long_name, &
                       minimum=variable%minimum, maximum=variable%maximum, fill_value=variable%missing_value, &
                       category='fabm'//variable%target%owner%get_path(), output_level=output_level, used=used, field=field)
      property => variable%properties%first
      do while (associated(property))
         select type (property)
         class is (type_real_property)
            call field%set_attribute(property%name,property%value)
         end select
         property => property%next
      end do
   end function register

   end subroutine register_output_fields

   subroutine fabm0d_host_julian_day(self,yyyy,mm,dd,julian)
      class (type_fabm0d_host), intent(in) :: self
      integer, intent(in)  :: yyyy,mm,dd
      integer, intent(out) :: julian
      call julian_day(yyyy,mm,dd,julian)
   end subroutine

   subroutine fabm0d_host_calendar_date(self,julian,yyyy,mm,dd)
      class (type_fabm0d_host), intent(in) :: self
      integer, intent(in)  :: julian
      integer, intent(out) :: yyyy,mm,dd
      call calendar_date(julian,yyyy,mm,dd)
   end subroutine

296 297 298 299 300
!-----------------------------------------------------------------------

   end module output

!-----------------------------------------------------------------------
301
! Copyright Bolding & Bruggeman ApS - GNU Public License - www.gnu.org
302
!-----------------------------------------------------------------------