FMS 2025.01-dev
Flexible Modeling System
Loading...
Searching...
No Matches
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
27module diag_integral_mod
28
29!###############################################################################
30
31use platform_mod, only: i8_kind, fms_file_len
32use time_manager_mod, only: time_type, get_time, set_time, &
34 operator(+), operator(-), &
35 operator(==), operator(>=), &
36 operator(/=)
37use mpp_mod, only: input_nml_file
38use fms_mod, only: error_mesg, &
39 check_nml_error, &
40 fms_init, &
41 mpp_pe, mpp_root_pe,&
42 fatal, write_version_number, &
43 stdlog, string
44use fms2_io_mod, only: file_exists
45use constants_mod, only: radius, constants_init
46use mpp_mod, only: mpp_sum, mpp_init
47use ensemble_manager_mod, only : get_ensemble_id, get_ensemble_size
48use platform_mod, only: r4_kind, r8_kind
49
50!-------------------------------------------------------------------------------
51
52implicit none
53private
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
63public &
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
108end interface sum_diag_integral_field
109
110!> @addtogroup diag_integral_mod
111!> @{
112
113private &
114
115! from diag_integral_init:
117
118! from diag_integral_field_init and sum_diag_integral_field:
120
121! from diag_integral_output and diag_integral_end:
123
124! from write_field_averages:
127
128! from diag_integral_output:
130
131! from sum_diag_integral_field:
133
134
135!-------------------------------------------------------------------------------
136!------ namelist -------
137
138real(r8_kind) :: &
139 output_interval = -1.0_r8_kind !< time interval at which integrals
140 !! are to be output
141character(len=8) :: &
142 time_units = 'hours' !< time units associated with
143 !! output_interval
144character(len=FMS_FILE_LEN) :: &
145 file_name = ' ' !< optional integrals output file name
146logical :: &
147 print_header = .true. !< print a header for the integrals
148 !! file ?
149integer :: &
150 fields_per_print_line = 4 !< number of fields to write per line
151 !! of output
152
153namelist / 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!-------------------------------------------------------------------------------
165type (time_type) :: next_alarm_time !< next time at which integrals are to be written
166type (time_type) :: alarm_interval !< time interval between writing integrals
167type (time_type) :: zero_time !< time_type variable set to (0,0); used as
168 !! flag to indicate integrals are not being output
169type (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!-------------------------------------------------------------------------------
176real(r8_kind), allocatable, dimension(:,:) :: area !< area of each grid box
177integer :: idim !< x dimension of grid on local processor
178integer :: jdim !< y dimension of grid on local processor
179integer :: field_size !< number of columns on global domain
180real(r8_kind) :: sum_area !< surface area of globe
181
182!-------------------------------------------------------------------------------
183! variables used to define the integral fields:
184!-------------------------------------------------------------------------------
185integer, parameter :: max_len_name = 12 !< maximum length of name associated with integral
186integer, parameter :: max_num_field = 32 !< maximum number of integrals allowed
187integer :: num_field = 0 !< number of integrals that have been activated
188character(len=max_len_name) :: field_name (max_num_field) !< name associated with integral i
189character(len=16) :: field_format (max_num_field) !< output format for integral i
190real(r8_kind) :: field_sum (max_num_field) !< integrand for integral i
191integer :: field_count (max_num_field) !< number of values in integrand i
192
193!-------------------------------------------------------------------------------
194! variables defining output formats.
195!-------------------------------------------------------------------------------
196character(len=160) :: format_text !< format statement for header
197character(len=160) :: format_data !< format statement for data output
198integer :: nd !< number of characters in data format statement
199integer :: nt !< number of characters in text format statement
200
201!-------------------------------------------------------------------------------
202! miscellaneous variables.
203!-------------------------------------------------------------------------------
204integer :: diag_unit = 0 !< unit number for output file
205logical :: 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!!
239subroutine diag_integral_init (Time_init, Time, blon, blat, area_in)
240
241type (time_type), intent(in), optional :: time_init !< Initial time to start the integral
242type (time_type), intent(in), optional :: time !< current time
243class(*),dimension(:,:), intent(in), optional :: blon !< array of model latitudes at cell boundaries [radians]
244class(*),dimension(:,:), intent(in), optional :: blat !< array of model longitudes at cell boundaries [radians]
245class(*),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
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
369end 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!!
392subroutine diag_integral_field_init (name, format)
393
394character(len=*), intent(in) :: name !< Name of the field to be integrated
395character(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
445end 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!!
468subroutine diag_integral_output (Time)
469
470type (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
492end 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!!
513subroutine diag_integral_end (Time)
514
515type (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
547end 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!!
580function set_axis_time (atime, units) result (Time)
581
582real(r8_kind), intent(in) :: atime !< integral time stamp at the current time
583character(len=*), intent(in) :: units !< input units, not used
584type(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
614end 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!!
638function get_field_index (name) result (index)
639
640character(len=*), intent(in) :: name !< Name associated with an integral
641integer :: 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
669end 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!!
691subroutine write_field_averages (Time)
692
693type (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
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
794end 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!!
817subroutine format_text_init (nst_in, nend_in)
818
819integer, intent(in), optional :: nst_in !< starting/ending integral index which will be
820 !! included in this format statement
821integer, 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
883end 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!!
908subroutine format_data_init (nst_in, nend_in, use_exp_format)
909
910integer, intent(in) :: nst_in !< starting/ending integral index which will be
911 !! included in this format statement
912integer, intent(in) :: nend_in !< starting/ending integral index which will be
913 !! included in this format statement
914logical, 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
960end 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
986function get_axis_time (Time, units) result (atime)
987
988type(time_type), intent(in) :: time !< integral time stamp
989character(len=*), intent(in) :: units !< input units of time_type
990real(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
1008end 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
1033function diag_integral_alarm (Time) result (answer)
1034
1035type (time_type), intent(in) :: time !< current time
1036logical :: answer
1037
1038 answer = .false.
1039 if (alarm_interval == zero_time) return
1040 if (time >= next_alarm_time) answer = .true.
1041
1042end 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
1067function vert_diag_integral (field_data, wt) result (data2)
1068real(r8_kind), dimension (:,:,:), intent(in) :: field_data !< integral field data arrays
1069real(r8_kind), dimension (:,:,:), intent(in) :: wt !< integral field weighting functions
1070real(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
1086end function vert_diag_integral
1087
1088!> @brief Adds .ens_## to the diag_integral.out file name
1089!! @return character array updated_file_name
1090function 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)
1123end 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
real(r8_kind) sum_area
surface area of globe
subroutine, public diag_integral_init(time_init, time, blon, blat, area_in)
diag_integral_init is the constructor for diag_integral_mod.
character(len=fms_file_len) file_name
optional integrals output file name
character(len=fms_file_len) function ensemble_file_name(fname)
Adds .ens_## to the diag_integral.out file name.
subroutine, public diag_integral_field_init(name, format)
diag_integral_field_init registers and intializes an integral field
type(time_type) zero_time
time_type variable set to (0,0); used as flag to indicate integrals are not being output
integer num_field
number of integrals that have been activated
integer diag_unit
unit number for output file
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.
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
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
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.
integer, parameter max_num_field
maximum number of integrals allowed
integer function, private get_field_index(name)
get_field_index returns returns the index associated with an integral 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_end(time)
diag_integral_end is the destructor for diag_integral_mod.
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
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.
character(len=160) format_data
format statement for data output
character(len=8) time_units
time units associated with
subroutine, private write_field_averages(time)
Subroutine to sum multiple fields, average them and then write the result to an output file.
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
logical function, private diag_integral_alarm(time)
Function to check if it is time to write integrals. if not writing integrals, return.
subroutine, public diag_integral_output(time)
diag_integral_output determines if this is a timestep on which integrals are to be written....
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
type(time_type) function, private set_axis_time(atime, units)
Function to convert input time to a time_type.
integer nd
number of characters in data format statement
logical print_header
print a header for the integrals
Perform a summation of the named integral field.
integer function, dimension(6), public get_ensemble_size()
Returns ensemble size integer array.
integer function, public get_ensemble_id()
Getter function for ensemble_id.
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.