FMS  2025.02.01
Flexible Modeling System
diag_integral.F90
1 !***********************************************************************
2 !* GNU Lesser General Public License
3 !*
4 !* This file is part of the GFDL Flexible Modeling System (FMS).
5 !*
6 !* FMS is free software: you can redistribute it and/or modify it under
7 !* the terms of the GNU Lesser General Public License as published by
8 !* the Free Software Foundation, either version 3 of the License, or (at
9 !* your option) any later version.
10 !*
11 !* FMS is distributed in the hope that it will be useful, but WITHOUT
12 !* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13 !* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
14 !* for more details.
15 !*
16 !* You should have received a copy of the GNU Lesser General Public
17 !* License along with FMS. If not, see <http://www.gnu.org/licenses/>.
18 !***********************************************************************
19 !> @defgroup diag_integral_mod diag_integral_mod
20 !> @ingroup diag_integral
21 !!
22 !! @author Fei Liu <Fei.Liu@noaa.gov>
23 !!
24 !! @brief This module computes and outputs global and / or hemispheric physics
25 !! integrals.
26 
27 module diag_integral_mod
28 
29 !###############################################################################
30 
31 use platform_mod, only: i8_kind, fms_file_len
32 use time_manager_mod, only: time_type, get_time, set_time, &
34  operator(+), operator(-), &
35  operator(==), operator(>=), &
36  operator(/=)
37 use mpp_mod, only: input_nml_file
38 use fms_mod, only: error_mesg, &
40  fms_init, &
41  mpp_pe, mpp_root_pe,&
42  fatal, write_version_number, &
43  stdlog, string
44 use fms2_io_mod, only: file_exists
45 use constants_mod, only: radius, constants_init
46 use mpp_mod, only: mpp_sum, mpp_init
47 use ensemble_manager_mod, only : get_ensemble_id, get_ensemble_size
48 use platform_mod, only: r4_kind, r8_kind
49 
50 !-------------------------------------------------------------------------------
51 
52 implicit none
53 private
54 
55 !-------------------------------------------------------------------------------
56 ! version number of this module
57 ! Include variable "version" to be written to log file.
58 #include<file_version.h>
59 
60 !-------------------------------------------------------------------------------
61 !------ interfaces ------
62 
63 public &
67 
68 
69 
70 !###############################################################################
71 !> Perform a summation of the named integral field
72 !!
73 !> This interface can be called in any one of three ways:
74 !!
75 !! @code{.f90}
76 !! call sum_diag_integral_field (name, data, is, js)
77 !! call sum_diag_integral_field (name, data, wt, is, js)
78 !! call sum_diag_integral_field (name, data, is, ie, js, je)
79 !! @endcode
80 !!
81 !! in the first option above, `data` may be either
82 !! @code{.f90}
83 !! real, intent(in) :: data(:,:) ![ sum_field_2d ]
84 !! real, intent(in) :: data(:,:,:) ![ sum_field_3d ]
85 !! @endcode
86 !!
87 !! <b> Parameters: </b>
88 !!
89 !! @code{.f90}
90 !! character(len=*), intent(in) :: name
91 !! real, intent(in) :: wt(:,:,:)
92 !! integer, optional, intent(in) :: is, ie, js, je
93 !! @endcode
94 !!
95 !! @param [in] <name> name associated with integral
96 !! @param [in] <data> field of integrands to be summed over
97 !! @param [in] <wt> vertical weighting factor to be applied to integrands
98 !! when summing
99 !! @param [in] <is, ie, js, je> starting/ending i,j indices over which summation
100 !! is to occur
101 !!
102 !! @ingroup diag_integral_mod
104  module procedure sum_field_2d_r4, sum_field_2d_r8
105  module procedure sum_field_2d_hemi_r4, sum_field_2d_hemi_r8
106  module procedure sum_field_3d_r4, sum_field_3d_r8
107  module procedure sum_field_wght_3d_r4, sum_field_wght_3d_r8
108 end interface sum_diag_integral_field
109 
110 !> @addtogroup diag_integral_mod
111 !> @{
112 
113 private &
114 
115 ! from diag_integral_init:
116  set_axis_time, &
117 
118 ! from diag_integral_field_init and sum_diag_integral_field:
119  get_field_index, &
120 
121 ! from diag_integral_output and diag_integral_end:
123 
124 ! from write_field_averages:
126  get_axis_time, &
127 
128 ! from diag_integral_output:
130 
131 ! from sum_diag_integral_field:
133 
134 
135 !-------------------------------------------------------------------------------
136 !------ namelist -------
137 
138 real(r8_kind) :: &
139  output_interval = -1.0_r8_kind !< time interval at which integrals
140  !! are to be output
141 character(len=8) :: &
142  time_units = 'hours' !< time units associated with
143  !! output_interval
144 character(len=FMS_FILE_LEN) :: &
145  file_name = ' ' !< optional integrals output file name
146 logical :: &
147  print_header = .true. !< print a header for the integrals
148  !! file ?
149 integer :: &
150  fields_per_print_line = 4 !< number of fields to write per line
151  !! of output
152 
153 namelist / diag_integral_nml / &
157 
158 !-------------------------------------------------------------------------------
159 !------- private data ------
160 
161 !-------------------------------------------------------------------------------
162 ! variables associated with the determination of when integrals
163 ! are to be written.
164 !-------------------------------------------------------------------------------
165 type (time_type) :: next_alarm_time !< next time at which integrals are to be written
166 type (time_type) :: alarm_interval !< time interval between writing integrals
167 type (time_type) :: zero_time !< time_type variable set to (0,0); used as
168  !! flag to indicate integrals are not being output
169 type (time_type) :: time_init_save !< initial time associated with experiment;
170  !! used as a base for defining time
171 
172 !-------------------------------------------------------------------------------
173 ! variables used in determining weights associated with each
174 ! contribution to the integrand.
175 !-------------------------------------------------------------------------------
176 real(r8_kind), allocatable, dimension(:,:) :: area !< area of each grid box
177 integer :: idim !< x dimension of grid on local processor
178 integer :: jdim !< y dimension of grid on local processor
179 integer :: field_size !< number of columns on global domain
180 real(r8_kind) :: sum_area !< surface area of globe
181 
182 !-------------------------------------------------------------------------------
183 ! variables used to define the integral fields:
184 !-------------------------------------------------------------------------------
185 integer, parameter :: max_len_name = 12 !< maximum length of name associated with integral
186 integer, parameter :: max_num_field = 32 !< maximum number of integrals allowed
187 integer :: num_field = 0 !< number of integrals that have been activated
188 character(len=max_len_name) :: field_name (max_num_field) !< name associated with integral i
189 character(len=16) :: field_format (max_num_field) !< output format for integral i
190 real(r8_kind) :: field_sum (max_num_field) !< integrand for integral i
191 integer :: field_count (max_num_field) !< number of values in integrand i
192 
193 !-------------------------------------------------------------------------------
194 ! variables defining output formats.
195 !-------------------------------------------------------------------------------
196 character(len=160) :: format_text !< format statement for header
197 character(len=160) :: format_data !< format statement for data output
198 integer :: nd !< number of characters in data format statement
199 integer :: nt !< number of characters in text format statement
200 
201 !-------------------------------------------------------------------------------
202 ! miscellaneous variables.
203 !-------------------------------------------------------------------------------
204 integer :: diag_unit = 0 !< unit number for output file
205 logical :: module_is_initialized = .false. !< module is initialized ?
206 
207 
208 
209  contains
210 
211 
212 
213 !###############################################################################
214 !
215 ! PUBLIC SUBROUTINES
216 !
217 !###############################################################################
218 
219 !> @brief diag_integral_init is the constructor for diag_integral_mod.
220 !!
221 !! <b> Template: </b>
222 !!
223 !! @code{.f90}
224 !! call diag_integral_init (Time_init, Time, blon, blat)
225 !! @endcode
226 !!
227 !! <b> Parameters: </b>
228 !!
229 !! @code{.f90}
230 !! type (time_type), intent(in), optional :: Time_init, Time
231 !! real,dimension(:,:), intent(in), optional :: blon, blat, area_in
232 !! @endcode
233 !!
234 !! @param [in] <Time_init> Initial time to start the integral
235 !! @param [in] <Time> current time
236 !! @param [in] <latb> array of model latitudes at cell boundaries [radians]
237 !! @param [in] <lonb> array of model longitudes at cell boundaries [radians]
238 !!
239 subroutine diag_integral_init (Time_init, Time, blon, blat, area_in)
240 
241 type (time_type), intent(in), optional :: time_init !< Initial time to start the integral
242 type (time_type), intent(in), optional :: time !< current time
243 class(*),dimension(:,:), intent(in), optional :: blon !< array of model latitudes at cell boundaries [radians]
244 class(*),dimension(:,:), intent(in), optional :: blat !< array of model longitudes at cell boundaries [radians]
245 class(*),dimension(:,:), intent(in), optional :: area_in
246 
247 !-------------------------------------------------------------------------------
248 ! local variables:
249 ! r2
250 ! rsize
251 ! unit
252 ! io
253 ! ierr
254 ! seconds
255 ! nc
256 ! i,j
257 !-------------------------------------------------------------------------------
258  real(r8_kind) :: rsize
259  integer :: io, ierr, nc, logunit
260  integer :: field_size_local
261  real(r8_kind) :: sum_area_local
262  integer :: ensemble_size(6)
263 !-------------------------------------------------------------------------------
264 ! if routine has already been executed, exit.
265 !-------------------------------------------------------------------------------
266  if (module_is_initialized) return
267 
268 !-------------------------------------------------------------------------------
269 ! verify that modules used by this module that are not called later
270 ! have already been initialized.
271 !-------------------------------------------------------------------------------
272  call fms_init
273  call mpp_init
274  call constants_init
275  call time_manager_init
276 
277 !-------------------------------------------------------------------------------
278 ! if this is the initialization call, proceed. if this was simply
279 ! a verification of previous initialization, return.
280 !-------------------------------------------------------------------------------
281  if (present(time_init) .and. present(time) .and. &
282  present(blon) .and. present(blat) ) then
283 
284 !-------------------------------------------------------------------------------
285 ! read namelist.
286 !-------------------------------------------------------------------------------
287  read (input_nml_file, nml=diag_integral_nml, iostat=io)
288  ierr = check_nml_error(io,'diag_integral_nml')
289 
290 !-------------------------------------------------------------------------------
291 ! write version number and namelist to logfile.
292 !-------------------------------------------------------------------------------
293  call write_version_number ('DIAG_INTEGRAL_MOD', version)
294  logunit = stdlog()
295  if (mpp_pe() == mpp_root_pe() ) &
296  write (logunit, nml=diag_integral_nml)
297 
298 !-------------------------------------------------------------------------------
299 ! save the initial time to time-stamp the integrals which will be
300 ! calculated.
301 !-------------------------------------------------------------------------------
302  time_init_save = time_init
303 
304 !-------------------------------------------------------------------------------
305 ! define the model grid sizes and the total number of columns on
306 ! the processor. sum over all processors and store the global
307 ! number of columns in field_size.
308 !-------------------------------------------------------------------------------
309  idim = size(blon,1) - 1
310  jdim = size(blon,2) - 1
311  field_size_local = idim*jdim
312  rsize = real(field_size_local,r8_kind)
313  call mpp_sum (rsize)
314  field_size = nint(rsize)
315 
316 !-------------------------------------------------------------------------------
317 ! define an array to hold the surface area of each grid column
318 ! so that the integrals may be weighted properly. sum over the
319 ! processor, and then over all processors, storing the total
320 ! global surface area in sum_area.
321 !-------------------------------------------------------------------------------
322  allocate (area(idim,jdim))
323 
324  select type(area_in)
325  type is (real(r4_kind)) ; area = real(area_in,r8_kind)
326  type is (real(r8_kind)) ; area = area_in
327  class default ; call error_mesg('diag_inetgral_mod::diag_integral_init', 'unknown area_in type', fatal)
328  end select
329 
330  sum_area_local = sum(area)
331  sum_area = sum_area_local
332  call mpp_sum (sum_area)
333 
334 !-------------------------------------------------------------------------------
335 ! if integral output is to go to a file, open the file on unit
336 ! diag_unit.
337 !-------------------------------------------------------------------------------
338  if (file_name(1:1) /= ' ' ) then
339  ensemble_size = get_ensemble_size()
340  if (ensemble_size(1) > 1) then
342  endif
343  nc = len_trim(file_name)
344  open(newunit=diag_unit, file=file_name(1:nc), action='write')
345  endif
346 
347 !-------------------------------------------------------------------------------
348 ! define the variables needed to control the time interval of
349 ! output. Zero time is a flag indicating that the alarm is not set,
350 ! i.e., integrals are not desired. otherwise set the next time to
351 ! output integrals to be at the value of nml variable
352 ! output_interval from now.
353 !-------------------------------------------------------------------------------
354  zero_time = set_time(0,0)
355  if (output_interval >= -0.01_r8_kind) then
358  else
360  endif
362 
363 !-------------------------------------------------------------------------------
364 ! deallocate the local array and mark the module as initialized.
365 !-------------------------------------------------------------------------------
366  module_is_initialized = .true.
367  endif ! (present optional arguments)
368 
369 end subroutine diag_integral_init
370 
371 
372 
373 
374 !###############################################################################
375 !> @brief diag_integral_field_init registers and intializes an integral field
376 !!
377 !! <b> Template: </b>
378 !!
379 !! @code{.f90}
380 !! call diag_integral_field_init (name, format)
381 !! @endcode
382 !!
383 !! <b> Parameters: </b>
384 !!
385 !! @code{.f90}
386 !! character(len=*), intent(in) :: name, format
387 !! @endcode
388 !!
389 !! @param [in] <name> Name of the field to be integrated
390 !! @param [in] <format> Output format of the field to be integrated
391 !!
392 subroutine diag_integral_field_init (name, format)
393 
394 character(len=*), intent(in) :: name !< Name of the field to be integrated
395 character(len=*), intent(in) :: format !< Output format of the field to be integrated
396 
397 !-------------------------------------------------------------------------------
398 ! local variables:
399 !-------------------------------------------------------------------------------
400  integer :: field !< index assigned to the current integral
401 
402 !-------------------------------------------------------------------------------
403 ! note: no initialization is required for this interface. all needed
404 ! variables are initialized in the source.
405 !-------------------------------------------------------------------------------
406 
407 !-------------------------------------------------------------------------------
408 ! make sure the integral name is not too long.
409 !-------------------------------------------------------------------------------
410  if (len(name) > max_len_name ) then
411  call error_mesg ('diag_integral_mod', &
412  ' integral name too long', fatal)
413  endif
414 
415 !-------------------------------------------------------------------------------
416 ! check to be sure the integral name has not already been
417 ! initialized.
418 !-------------------------------------------------------------------------------
419  field = get_field_index(name)
420  if (field /= 0) then
421  call error_mesg ('diag_integral_mod', &
422  'integral name already exists', fatal)
423  endif
424 
425 !-------------------------------------------------------------------------------
426 ! prepare to register the integral. make sure that there are not
427 ! more integrals registered than space was provided for; if so, exit.
428 !-------------------------------------------------------------------------------
429  num_field = num_field + 1
430  if (num_field > max_num_field) then
431  call error_mesg ('diag_integral_mod', &
432  'too many fields initialized', fatal)
433  endif
434 
435 !-------------------------------------------------------------------------------
436 ! register the name and output format desired for the given integral.
437 ! initialize its value and the number of grid points that have been
438 ! counted to zero.
439 !-------------------------------------------------------------------------------
440  field_name(num_field) = name
441  field_format(num_field) = format
442  field_sum(num_field) = 0.0_r8_kind
444 
445 end subroutine diag_integral_field_init
446 
447 
448 
449 !###############################################################################
450 !> @brief diag_integral_output determines if this is a timestep on which
451 !! integrals are to be written. if not, it returns; if so, it calls
452 !! write_field_averages.
453 !!
454 !! <b> Template: </b>
455 !!
456 !! @code{.f90}
457 !! call diag_integral_output (Time)
458 !! @endcode
459 !!
460 !! <b> Parameters: </b>
461 !!
462 !! @code{.f90}
463 !! type (time_type), intent(in) :: Time
464 !! @endcode
465 !!
466 !! @param [in] <Time> integral time stamp at the current time
467 !!
468 subroutine diag_integral_output (Time)
469 
470 type (time_type), intent(in) :: time
471 
472 !-------------------------------------------------------------------------------
473 ! be sure module has been initialized.
474 !-------------------------------------------------------------------------------
475  if (.not. module_is_initialized ) then
476  call error_mesg ('diag_integral_mod', &
477  'module has not been initialized', fatal )
478  endif
479 
480 !-------------------------------------------------------------------------------
481 ! see if integral output is desired at this time.
482 !-------------------------------------------------------------------------------
483  if ( diag_integral_alarm(time) ) then
484 !-------------------------------------------------------------------------------
485 ! write the integrals by calling write_field_averages. upon return
486 ! reset the alarm to the next diagnostics time.
487 !-------------------------------------------------------------------------------
488  call write_field_averages (time)
490  endif
491 
492 end subroutine diag_integral_output
493 
494 
495 
496 !###############################################################################
497 !> @brief diag_integral_end is the destructor for diag_integral_mod.
498 !!
499 !! <b> Template: </b>
500 !!
501 !! @code{.f90}
502 !! call diag_integral_end (Time)
503 !! @endcode
504 !!
505 !! <b> Parameters: </b>
506 !!
507 !! @code{.f90}
508 !! type (time_type), intent(in) :: Time
509 !! @endcode
510 !!
511 !! @param [in] <Time> integral time stamp at the current time
512 !!
513 subroutine diag_integral_end (Time)
514 
515 type (time_type), intent(in) :: time
516 
517 !-------------------------------------------------------------------------------
518 ! be sure module has been initialized.
519 !-------------------------------------------------------------------------------
520  if (.not. module_is_initialized ) then
521  call error_mesg ('diag_integral_mod', &
522  'module has not been initialized', fatal )
523  endif
524 
525 !-------------------------------------------------------------------------------
526 ! if the alarm interval was set to Zero_time (meaning no integral
527 ! output during the model run) call write_field_averages to output
528 ! the integrals valid over the entire period of integration.
529 !-------------------------------------------------------------------------------
530  if (alarm_interval == zero_time ) then
531 ! if (Alarm_interval /= Zero_time ) then
532 ! else
533  call write_field_averages (time)
534  endif
535 
536 !-------------------------------------------------------------------------------
537 ! deallocate module variables.
538 !-------------------------------------------------------------------------------
539  deallocate (area)
540  if (diag_unit /= 0) close(diag_unit)
541 
542 !-------------------------------------------------------------------------------
543 ! mark the module as uninitialized.
544 !-------------------------------------------------------------------------------
545  module_is_initialized = .false.
546 
547 end subroutine diag_integral_end
548 
549 
550 
551 !###############################################################################
552 !
553 ! PRIVATE SUBROUTINES
554 !
555 !###############################################################################
556 
557 
558 
559 !###############################################################################
560 !> @brief Function to convert input time to a time_type
561 !!
562 !! <b> Template: </b>
563 !!
564 !! @code{.f90}
565 !! time = set_axis_time (atime, units)
566 !! @endcode
567 !!
568 !! <b> Parameters: </b>
569 !!
570 !! @code{.f90}
571 !! real, intent(in) :: atime
572 !! character(len=*), intent(in) :: units
573 !! type(time_type) :: Time
574 !! @endcode
575 !!
576 !! @param [in] <atime> integral time stamp at the current time
577 !! @param [in] <units> input units, not used
578 !! @param [out] <Time>
579 !!
580 function set_axis_time (atime, units) result (Time)
581 
582 real(r8_kind), intent(in) :: atime !< integral time stamp at the current time
583 character(len=*), intent(in) :: units !< input units, not used
584 type(time_type) :: time
585 
586 !-------------------------------------------------------------------------------
587 ! local variables:
588 !-------------------------------------------------------------------------------
589  integer :: sec !< seconds corresponding to the input
590  !! variable atime
591  integer :: day = 0 !< day component of time_type variable
592 
593 !-------------------------------------------------------------------------------
594 ! convert the input time to seconds, regardless of input units.
595 !-------------------------------------------------------------------------------
596  if (units(1:3) == 'sec') then
597  sec = int(atime + 0.5)
598  else if (units(1:3) == 'min') then
599  sec = int(atime*60. + 0.5)
600  else if (units(1:3) == 'hou') then
601  sec = int(atime*3600. + 0.5)
602  else if (units(1:3) == 'day') then
603  sec = int(atime*86400. + 0.5)
604  else
605  call error_mesg('diag_integral_mod', &
606  'Invalid units sent to set_axis_time', fatal)
607  endif
608 
609 !-------------------------------------------------------------------------------
610 ! convert the time in seconds to a time_type variable.
611 !-------------------------------------------------------------------------------
612  time = set_time(sec, day)
613 
614 end function set_axis_time
615 
616 
617 
618 !###############################################################################
619 !> @brief get_field_index returns returns the index associated with an
620 !! integral name.
621 !!
622 !! <b> Template: </b>
623 !!
624 !! @code{.f90}
625 !! index = get_field_index (name)
626 !! @endcode
627 !!
628 !! <b> Parameters: </b>
629 !!
630 !! @code{.f90}
631 !! character(len=*), intent(in) :: name
632 !! integer :: index
633 !! @endcode
634 !!
635 !! @param [in] <name> Name associated with an integral
636 !! @param [out] <index>
637 !!
638 function get_field_index (name) result (index)
639 
640 character(len=*), intent(in) :: name !< Name associated with an integral
641 integer :: index
642 
643 !-------------------------------------------------------------------------------
644 ! local variables:
645 !-------------------------------------------------------------------------------
646  integer :: nc
647  integer :: i
648 
649  nc = len_trim(name)
650  if (nc > max_len_name) then
651  call error_mesg ('diag_integral_mod', &
652  'name too long', fatal)
653  endif
654 
655 !-------------------------------------------------------------------------------
656 ! search each field name for the current string. when found exit
657 ! with the index. if not found index will be 0 upon return, which
658 ! initiates error condition.
659 !-------------------------------------------------------------------------------
660  index = 0
661  do i = 1, num_field
662  if (name(1:nc) == &
663  field_name(i) (1:len_trim(field_name(i))) ) then
664  index = i
665  exit
666  endif
667  end do
668 
669 end function get_field_index
670 
671 
672 
673 !###############################################################################
674 !> @brief Subroutine to sum multiple fields, average them and then write the
675 !! result to an output file.
676 !!
677 !! <b> Template: </b>
678 !!
679 !! @code{.f90}
680 !! call write_field_averages (Time)
681 !! @endcode
682 !!
683 !! <b> Parameters: </b>
684 !!
685 !! @code{.f90}
686 !! type (time_type), intent(in) :: Time
687 !! @endcode
688 !!
689 !! @param [in] <Time> integral time stamp at the current time
690 !!
691 subroutine write_field_averages (Time)
692 
693 type (time_type), intent(in) :: time !< integral time stamp at the current time
694 
695 !-------------------------------------------------------------------------------
696 ! local variables:
697 ! field_avg
698 ! xtime
699 ! rcount
700 ! nn
701 ! ninc
702 ! nst
703 ! nend
704 ! fields_to_print
705 ! i
706 ! kount
707 !-------------------------------------------------------------------------------
708  real(r8_kind) :: field_avg(max_num_field)
709  real(r8_kind) :: xtime, rcount
710  integer :: nn, ninc, nst, nend, fields_to_print
711  integer :: i, kount
712  integer(i8_kind) :: icount
713  character(len=128) :: xtime_str
714  logical :: use_exp_format
715 
716 !-------------------------------------------------------------------------------
717 ! each header and data format may be different and must be generated
718 ! as needed.
719 !-------------------------------------------------------------------------------
720  fields_to_print = 0
721  do i = 1, num_field
722 
723 !-------------------------------------------------------------------------------
724 ! increment the fields_to_print counter. sum the integrand and the
725 ! number of data points contributing to it over all processors.
726 !-------------------------------------------------------------------------------
727  fields_to_print = fields_to_print + 1
728  rcount = real(field_count(i),r8_kind)
729  call mpp_sum (rcount)
730  call mpp_sum (field_sum(i))
731  icount = int(rcount, i8_kind)
732 
733 !-------------------------------------------------------------------------------
734 ! verify that all the data expected for an integral has been
735 ! obtained.
736 !-------------------------------------------------------------------------------
737  if (icount == 0 ) call error_mesg &
738  ('diag_integral_mod', &
739  'field_count equals zero for field_name ' // &
740  field_name(i)(1:len_trim(field_name(i))), fatal )
741  kount = int(icount/field_size)
742  if ((field_size)*kount /= icount) then
743  print*,"name,pe,kount,field_size,icount,rcount=",trim(field_name(i)),mpp_pe(),kount,field_size,icount,rcount
744  call error_mesg &
745  ('diag_integral_mod', &
746  'field_count not a multiple of field_size', fatal )
747  endif
748 !-------------------------------------------------------------------------------
749 ! define the global integral for field i. reinitialize the point
750 ! and data accumulators.
751 !-------------------------------------------------------------------------------
752  field_avg(fields_to_print) = field_sum(i)/ &
753  (sum_area*real(kount,r8_kind))
754  field_sum(i) = 0.0_r8_kind
755  field_count(i) = 0
756  end do
757 
758 !-------------------------------------------------------------------------------
759 ! only the root pe will write out data.
760 !-------------------------------------------------------------------------------
761  if ( mpp_pe() /= mpp_root_pe() ) return
762 
763 !-------------------------------------------------------------------------------
764 ! define the time associated with the integrals just calculated.
765 !-------------------------------------------------------------------------------
767 
768 !-------------------------------------------------------------------------------
769 ! check if the time value is too long for decimal output
770 !-------------------------------------------------------------------------------
771  xtime_str = trim(string(xtime))
772  use_exp_format = len_trim(xtime_str(1:index(xtime_str, "."))) .ge. 9
773 
774 !-------------------------------------------------------------------------------
775 ! generate the new header and data formats.
776 !-------------------------------------------------------------------------------
777  nst = 1
778  nend = fields_per_print_line
779  ninc = (num_field-1)/fields_per_print_line + 1
780  do nn=1, ninc
781  nst = 1 + (nn-1)*fields_per_print_line
782  nend = min(nn*fields_per_print_line, num_field)
783  if (print_header) call format_text_init (nst, nend)
784  call format_data_init (nst, nend, use_exp_format)
785  if (diag_unit /= 0) then
786  write (diag_unit,format_data(1:nd)) &
787  xtime, (field_avg(i),i=nst,nend)
788  else
789  write (*, format_data(1:nd)) &
790  xtime, (field_avg(i),i=nst,nend)
791  endif
792  end do
793 
794 end subroutine write_field_averages
795 
796 
797 
798 !###############################################################################
799 !> @brief format_text_init generates the header records to be output in the
800 !! integrals file.
801 !!
802 !! <b> Template: </b>
803 !!
804 !! @code{.f90}
805 !! call format_text_init (nst_in, nend_in)
806 !! @endcode
807 !!
808 !! <b> Parameters: </b>
809 !!
810 !! @code{.f90}
811 !! integer, intent(in), optional :: nst_in, nend_in
812 !! @endcode
813 !!
814 !! @param [in] <nst_in, nend_in> starting/ending integral index which will be
815 !! included in this format statement
816 !!
817 subroutine format_text_init (nst_in, nend_in)
818 
819 integer, intent(in), optional :: nst_in !< starting/ending integral index which will be
820  !! included in this format statement
821 integer, intent(in), optional :: nend_in !< starting/ending integral index which will be
822  !! included in this format statement
823 
824 !-------------------------------------------------------------------------------
825 ! local variables:
826 ! i
827 ! nc
828 ! nst
829 ! nend
830 !-------------------------------------------------------------------------------
831  integer :: i, nc, nst, nend
832 
833 !-------------------------------------------------------------------------------
834 ! only the root pe need execute this routine, since only it will
835 ! be outputting integrals.
836 !-------------------------------------------------------------------------------
837  if (mpp_pe() /= mpp_root_pe()) return
838 
839 !-------------------------------------------------------------------------------
840 ! define the starting and ending integral indices that will be
841 ! included in this format statement.
842 !-------------------------------------------------------------------------------
843  if (present (nst_in) ) then
844  nst = nst_in
845  nend = nend_in
846  else
847  nst = 1
848  nend = num_field
849  endif
850 
851 !-------------------------------------------------------------------------------
852 ! define the first 11 characters in the format statement.
853 !-------------------------------------------------------------------------------
854  nt = 11
855  format_text(1:nt) = "('# time"
856 
857 !-------------------------------------------------------------------------------
858 ! generate the rest of the format statement, which will cover
859 ! integral indices nst to nend. if satndard printout is desired,
860 ! cycle through the loop.
861 !-------------------------------------------------------------------------------
862  do i=nst,nend
863  nc = len_trim(field_name(i))
864  format_text(nt+1:nt+nc+5) = ' ' // field_name(i)(1:nc)
865  nt = nt+nc+5
866  end do
867 
868 !-------------------------------------------------------------------------------
869 ! include the end of the format statement.
870 !-------------------------------------------------------------------------------
871  format_text(nt+1:nt+2) = "')"
872  nt = nt+2
873 
874 !-------------------------------------------------------------------------------
875 ! write the format statement to either an output file or to stdout.
876 !-------------------------------------------------------------------------------
877  if (diag_unit /= 0) then
878  write (diag_unit, format_text(1:nt))
879  else
880  write (*, format_text(1:nt))
881  endif
882 
883 end subroutine format_text_init
884 
885 
886 
887 !###############################################################################
888 !> @brief format_text_init generates the format to be output in the
889 !! integrals file.
890 !!
891 !! <b> Template: </b>
892 !!
893 !! @code{.f90}
894 !! call format_data_init (nst_in, nend_in)
895 !! @endcode
896 !!
897 !! <b> Parameters: </b>
898 !!
899 !! @code{.f90}
900 !! integer, intent(in) :: nst_in, nend_in
901 !! @endcode
902 !!
903 !! @param [in] <nst_in, nend_in> starting/ending integral index which will be
904 !! included in this format statement
905 !! @param [in] <use_exp_format> if true, uses exponent notation for the first format code
906 !! to avoid overflow with larger time values
907 !!
908 subroutine format_data_init (nst_in, nend_in, use_exp_format)
909 
910 integer, intent(in) :: nst_in !< starting/ending integral index which will be
911  !! included in this format statement
912 integer, intent(in) :: nend_in !< starting/ending integral index which will be
913  !! included in this format statement
914 logical, intent(in) :: use_exp_format !< if true, uses exponent notation for the first format code
915  !! to avoid overflow with larger time values
916 
917 !-------------------------------------------------------------------------------
918 ! local variables:
919 ! i
920 ! nc
921 ! nst
922 ! nend
923 !-------------------------------------------------------------------------------
924  integer :: i, nc, nst, nend
925 
926 !-------------------------------------------------------------------------------
927 ! define the start of the format, which covers the time stamp of the
928 ! integrals. this section is 9 characters long.
929 !-------------------------------------------------------------------------------
930  nd = 9
931  if( use_exp_format ) then
932  format_data(1:nd) = '(1x,e10.2'
933  else
934  format_data(1:nd) = '(1x,f10.2'
935  endif
936 
937 !-------------------------------------------------------------------------------
938 ! define the indices of the integrals that are to be written by this
939 ! format statement.
940 !-------------------------------------------------------------------------------
941  nst = nst_in
942  nend = nend_in
943 
944 !-------------------------------------------------------------------------------
945 ! complete the data format. use the format defined for the
946 ! particular integral in setting up the format statement.
947 !-------------------------------------------------------------------------------
948  do i=nst,nend
949  nc = len_trim(field_format(i))
950  format_data(nd+1:nd+nc+4) = ',1x,' // field_format(i)(1:nc)
951  nd = nd+nc+4
952  end do
953 
954 !-------------------------------------------------------------------------------
955 ! close the format statement.
956 !-------------------------------------------------------------------------------
957  format_data(nd+1:nd+1) = ')'
958  nd = nd + 1
959 
960 end subroutine format_data_init
961 
962 
963 !###############################################################################
964 !> @brief Function to convert the time_type input variable into units of
965 !! units and returns it in atime.
966 !!
967 !! <b> Template: </b>
968 !!
969 !! @code{.f90}
970 !! atime = get_axis_time (Time, units)
971 !! @endcode
972 !!
973 !! <b> Parameters: </b>
974 !!
975 !! @code{.f90}
976 !! type(time_type), intent(in) :: Time
977 !! character(len=*), intent(in) :: units
978 !! real :: atime
979 !! @endcode
980 !!
981 !! @param [in] <Time> integral time stamp
982 !! @param [in] <units> input units of time_type
983 !! @param [out] <atime>
984 !!
985 !! @return real atime
986 function get_axis_time (Time, units) result (atime)
987 
988 type(time_type), intent(in) :: time !< integral time stamp
989 character(len=*), intent(in) :: units !< input units of time_type
990 real(r8_kind) :: atime
991 
992 !-------------------------------------------------------------------------------
993 ! local variables:
994 !-------------------------------------------------------------------------------
995  integer :: sec, day ! components of time_type variable
996 
997  call get_time (time, sec, day)
998  if (units(1:3) == 'sec') then
999  atime = real(sec,r8_kind) + 86400._r8_kind*real(day,r8_kind)
1000  else if (units(1:3) == 'min') then
1001  atime = real(sec,r8_kind)/60._r8_kind + 1440._r8_kind*real(day,r8_kind)
1002  else if (units(1:3) == 'hou') then
1003  atime = real(sec,r8_kind)/3600._r8_kind + 24._r8_kind*real(day,r8_kind)
1004  else if (units(1:3) == 'day') then
1005  atime = real(sec,r8_kind)/86400._r8_kind + real(day,r8_kind)
1006  endif
1007 
1008 end function get_axis_time
1009 
1010 
1011 
1012 !###############################################################################
1013 !> @brief Function to check if it is time to write integrals.
1014 !! if not writing integrals, return.
1015 !!
1016 !! <b> Template: </b>
1017 !!
1018 !! @code{.f90}
1019 !! result = diag_integral_alarm (Time)
1020 !! @endcode
1021 !!
1022 !! <b> Parameters: </b>
1023 !!
1024 !! @code{.f90}
1025 !! type (time_type), intent(in) :: Time
1026 !! logical :: answer
1027 !! @endcode
1028 !!
1029 !! @param [in] <Time> current time
1030 !! @param [out] <answer>
1031 !!
1032 !! @return logical answer
1033 function diag_integral_alarm (Time) result (answer)
1034 
1035 type (time_type), intent(in) :: time !< current time
1036 logical :: answer
1037 
1038  answer = .false.
1039  if (alarm_interval == zero_time) return
1040  if (time >= next_alarm_time) answer = .true.
1041 
1042 end function diag_integral_alarm
1043 
1044 
1045 
1046 !###############################################################################
1047 !> @brief Function to perform a weighted integral in the vertical
1048 !! direction of a 3d data field
1049 !!
1050 !! <b> Template: </b>
1051 !!
1052 !! @code{.f90}
1053 !! data2 = vert_diag_integral (field_data, wt)
1054 !! @endcode
1055 !!
1056 !! <b> Parameters: </b>
1057 !!
1058 !! @code{.f90}
1059 !! real, dimension (:,:,:), intent(in) :: field_data, wt
1060 !! real, dimension (size(field_data,1),size(field_data,2)) :: data2
1061 !! @endcode
1062 !!
1063 !! @param [in] <field_data> integral field data arrays
1064 !! @param [in] <wt> integral field weighting functions
1065 !! @param [out] <data2>
1066 !! @return real array data2
1067 function vert_diag_integral (field_data, wt) result (data2)
1068 real(r8_kind), dimension (:,:,:), intent(in) :: field_data !< integral field data arrays
1069 real(r8_kind), dimension (:,:,:), intent(in) :: wt !< integral field weighting functions
1070 real(r8_kind), dimension (size(field_data,1),size(field_data,2)) :: data2
1071 
1072 !-------------------------------------------------------------------------------
1073 ! local variables:
1074 ! wt2
1075 !-------------------------------------------------------------------------------
1076  real, dimension(size(field_data,1),size(field_data,2)) :: wt2
1077 
1078 !-------------------------------------------------------------------------------
1079  wt2 = sum(wt,3)
1080  if (count(wt2 == 0._r8_kind) > 0) then
1081  call error_mesg ('diag_integral_mod', &
1082  'vert sum of weights equals zero', fatal)
1083  endif
1084  data2 = sum(field_data*wt,3) / wt2
1085 
1086 end function vert_diag_integral
1087 
1088 !> @brief Adds .ens_## to the diag_integral.out file name
1089 !! @return character array updated_file_name
1090 function ensemble_file_name(fname) result(updated_file_name)
1091  character (len=*), intent(inout) :: fname
1092  character (len=FMS_FILE_LEN) :: updated_file_name
1093  integer :: ensemble_id_int
1094  character(len=7) :: ensemble_suffix
1095  character(len=2) :: ensemble_id_char
1096  integer :: i
1097  !> Make sure the file name short enough to handle adding the ensemble number
1098  if (len(trim(fname)) > fms_file_len-7) call error_mesg ('diag_integral_mod :: ensemble_file_name', &
1099  trim(fname)//" is too long and can not support adding ens_XX. Please shorten the "//&
1100  "file_name in the diag_integral_nml", fatal)
1101  !> Get the ensemble ID and convert it to a string
1102  ensemble_id_int = get_ensemble_id()
1103  write(ensemble_id_char,"(I0)") ensemble_id_int
1104  !> Add a 0 if the ensemble is less than 10 (2 digit)
1105  if (ensemble_id_int < 10) then
1106  ensemble_suffix = ".ens_0"//trim(ensemble_id_char)
1107  elseif (ensemble_id_int >= 10 .and. ensemble_id_int < 100) then
1108  ensemble_suffix = ".ens_"//trim(ensemble_id_char)
1109  else
1110  call error_mesg ('diag_integral_mod', &
1111  ' Does not support ensemble sizes over 99.', fatal)
1112  endif
1113  !> Insert the ens_ string in the correct location
1114  !> Loop through to find the last period
1115  do i=len(trim(fname)),2,-1
1116  if (fname(i:i) == ".") then
1117  updated_file_name = fname(1:i-1)//trim(ensemble_suffix)//fname(i:len(fname))
1118  return
1119  endif
1120  enddo
1121  !> Add to the end if there is no period in the file name
1122  updated_file_name = trim(fname)//trim(ensemble_suffix)
1123 end function ensemble_file_name
1124 
1125 #include "diag_integral_r4.fh"
1126 #include "diag_integral_r8.fh"
1127 
1128  end module diag_integral_mod
1129 !> @}
1130 ! close documentation grouping
type(time_type) function, private set_axis_time(atime, units)
Function to convert input time to a time_type.
real(r8_kind) sum_area
surface area of globe
character(len=fms_file_len) file_name
optional integrals output file name
real(r8_kind) function, dimension(size(field_data, 1), size(field_data, 2)), private vert_diag_integral(field_data, wt)
Function to perform a weighted integral in the vertical direction of a 3d data field.
type(time_type) zero_time
time_type variable set to (0,0); used as flag to indicate integrals are not being output
subroutine, public diag_integral_output(Time)
diag_integral_output determines if this is a timestep on which integrals are to be written....
subroutine, public diag_integral_field_init(name, format)
diag_integral_field_init registers and intializes an integral field
integer num_field
number of integrals that have been activated
integer diag_unit
unit number for output file
real(r8_kind) function, private get_axis_time(Time, units)
Function to convert the time_type input variable into units of units and returns it in atime.
integer idim
x dimension of grid on local processor
integer fields_per_print_line
number of fields to write per line
integer nt
number of characters in text format statement
integer jdim
y dimension of grid on local processor
subroutine, private format_data_init(nst_in, nend_in, use_exp_format)
format_text_init generates the format to be output in the integrals file.
character(len=16), dimension(max_num_field) field_format
output format for integral i
real(r8_kind), dimension(:,:), allocatable area
area of each grid box
real(r8_kind) output_interval
time interval at which integrals
integer, parameter max_num_field
maximum number of integrals allowed
character(len=fms_file_len) function ensemble_file_name(fname)
Adds .ens_## to the diag_integral.out file name.
subroutine, private format_text_init(nst_in, nend_in)
format_text_init generates the header records to be output in the integrals file.
type(time_type) time_init_save
initial time associated with experiment; used as a base for defining time
subroutine, public diag_integral_init(Time_init, Time, blon, blat, area_in)
diag_integral_init is the constructor for diag_integral_mod.
integer function, private get_field_index(name)
get_field_index returns returns the index associated with an integral name.
type(time_type) alarm_interval
time interval between writing integrals
integer, parameter max_len_name
maximum length of name associated with integral
character(len=max_len_name), dimension(max_num_field) field_name
name associated with integral i
subroutine, private write_field_averages(Time)
Subroutine to sum multiple fields, average them and then write the result to an output file.
character(len=160) format_data
format statement for data output
character(len=8) time_units
time units associated with
type(time_type) next_alarm_time
next time at which integrals are to be written
logical module_is_initialized
module is initialized ?
integer field_size
number of columns on global domain
character(len=160) format_text
format statement for header
subroutine, public diag_integral_end(Time)
diag_integral_end is the destructor for diag_integral_mod.
real(r8_kind), dimension(max_num_field) field_sum
integrand for integral i
integer, dimension(max_num_field) field_count
number of values in integrand i
integer nd
number of characters in data format statement
logical print_header
print a header for the integrals
logical function, private diag_integral_alarm(Time)
Function to check if it is time to write integrals. if not writing integrals, return.
Perform a summation of the named integral field.
integer function, public get_ensemble_id()
Getter function for ensemble_id.
integer function, dimension(6), public get_ensemble_size()
Returns ensemble size integer array.
integer function, public check_nml_error(IOSTAT, NML_NAME)
Checks the iostat argument that is returned after reading a namelist and determines if the error code...
Definition: fms.F90:580
subroutine, public write_version_number(version, tag, unit)
Prints to the log file (or a specified unit) the version id string and tag name.
Definition: fms.F90:758
subroutine, public fms_init(localcomm, alt_input_nml_path)
Initializes the FMS module and also calls the initialization routines for all modules in the MPP pack...
Definition: fms.F90:332
subroutine, public error_mesg(routine, message, level)
Print notes, warnings and error messages; terminates program for warning and error messages....
Definition: fms.F90:498
subroutine mpp_init(flags, localcomm, test_level, alt_input_nml_path)
Initialize the mpp_mod module. Must be called before any usage.
integer function stdlog()
This function returns the current standard fortran unit numbers for log messages. Log messages,...
Definition: mpp_util.inc:59
integer function mpp_pe()
Returns processor ID.
Definition: mpp_util.inc:407
Reduction operation.
Definition: mpp.F90:597
subroutine, public get_time(Time, seconds, days, ticks, err_msg)
Returns days and seconds ( < 86400 ) corresponding to a time. err_msg should be checked for any error...
subroutine, public time_manager_init()
Initialization routine. Writes the version information to the log file.
Given some number of seconds and days, returns the corresponding time_type.
Type to represent amounts of time. Implemented as seconds and days to allow for larger intervals.