27module diag_integral_mod
31use platform_mod,
only: i8_kind, fms_file_len
34 operator(+),
operator(-), &
35 operator(==),
operator(>=), &
37use mpp_mod,
only: input_nml_file
38use fms_mod,
only: error_mesg, &
42 fatal, write_version_number, &
44use fms2_io_mod,
only: file_exists
45use constants_mod,
only: radius, constants_init
46use mpp_mod,
only:
mpp_sum, mpp_init
48use platform_mod,
only: r4_kind, r8_kind
58#include<file_version.h>
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
144character(len=FMS_FILE_LEN) :: &
153namelist / diag_integral_nml / &
176real(r8_kind),
allocatable,
dimension(:,:) ::
area
241type (
time_type),
intent(in),
optional :: time_init
242type (
time_type),
intent(in),
optional :: time
243class(*),
dimension(:,:),
intent(in),
optional :: blon
244class(*),
dimension(:,:),
intent(in),
optional :: blat
245class(*),
dimension(:,:),
intent(in),
optional :: area_in
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)
281 if (
present(time_init) .and.
present(time) .and. &
282 present(blon) .and.
present(blat) )
then
287 read (input_nml_file, nml=diag_integral_nml, iostat=io)
288 ierr = check_nml_error(io,
'diag_integral_nml')
293 call write_version_number (
'DIAG_INTEGRAL_MOD', version)
295 if (mpp_pe() == mpp_root_pe() ) &
296 write (logunit, nml=diag_integral_nml)
309 idim =
size(blon,1) - 1
310 jdim =
size(blon,2) - 1
312 rsize = real(field_size_local,r8_kind)
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)
330 sum_area_local = sum(
area)
340 if (ensemble_size(1) > 1)
then
394character(len=*),
intent(in) :: name
395character(len=*),
intent(in) :: format
411 call error_mesg (
'diag_integral_mod', &
412 ' integral name too long', fatal)
421 call error_mesg (
'diag_integral_mod', &
422 'integral name already exists', fatal)
431 call error_mesg (
'diag_integral_mod', &
432 'too many fields initialized', fatal)
476 call error_mesg (
'diag_integral_mod', &
477 'module has not been initialized', fatal )
521 call error_mesg (
'diag_integral_mod', &
522 'module has not been initialized', fatal )
582real(r8_kind),
intent(in) :: atime
583character(len=*),
intent(in) :: units
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)
605 call error_mesg(
'diag_integral_mod', &
606 'Invalid units sent to set_axis_time', fatal)
640character(len=*),
intent(in) :: name
651 call error_mesg (
'diag_integral_mod', &
652 'name too long', fatal)
709 real(r8_kind) :: xtime, rcount
710 integer :: nn, ninc, nst, nend, fields_to_print
712 integer(i8_kind) :: icount
713 character(len=128) :: xtime_str
714 logical :: use_exp_format
727 fields_to_print = fields_to_print + 1
731 icount = int(rcount, i8_kind)
737 if (icount == 0 )
call error_mesg &
738 (
'diag_integral_mod', &
739 'field_count equals zero for field_name ' // &
743 print*,
"name,pe,kount,field_size,icount,rcount=",trim(
field_name(i)),mpp_pe(),kount,
field_size,icount,rcount
745 (
'diag_integral_mod', &
746 'field_count not a multiple of field_size', fatal )
752 field_avg(fields_to_print) =
field_sum(i)/ &
761 if ( mpp_pe() /= mpp_root_pe() )
return
771 xtime_str = trim(string(xtime))
772 use_exp_format = len_trim(xtime_str(1:index(xtime_str,
"."))) .ge. 9
787 xtime, (field_avg(i),i=nst,nend)
790 xtime, (field_avg(i),i=nst,nend)
819integer,
intent(in),
optional :: nst_in
821integer,
intent(in),
optional :: nend_in
831 integer :: i, nc, nst, nend
837 if (mpp_pe() /= mpp_root_pe())
return
843 if (
present (nst_in) )
then
910integer,
intent(in) :: nst_in
912integer,
intent(in) :: nend_in
914logical,
intent(in) :: use_exp_format
924 integer :: i, nc, nst, nend
931 if( use_exp_format )
then
989character(len=*),
intent(in) :: units
990real(r8_kind) :: atime
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)
1068real(r8_kind),
dimension (:,:,:),
intent(in) :: field_data
1069real(r8_kind),
dimension (:,:,:),
intent(in) :: wt
1070real(r8_kind),
dimension (size(field_data,1),size(field_data,2)) :: data2
1076 real,
dimension(size(field_data,1),size(field_data,2)) :: wt2
1080 if (count(wt2 == 0._r8_kind) > 0)
then
1081 call error_mesg (
'diag_integral_mod', &
1082 'vert sum of weights equals zero', fatal)
1084 data2 = sum(field_data*wt,3) / wt2
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
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)
1103 write(ensemble_id_char,
"(I0)") ensemble_id_int
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)
1110 call error_mesg (
'diag_integral_mod', &
1111 ' Does not support ensemble sizes over 99.', fatal)
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))
1122 updated_file_name = trim(fname)//trim(ensemble_suffix)
1125#include "diag_integral_r4.fh"
1126#include "diag_integral_r8.fh"
1128 end module diag_integral_mod
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.
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.