27 module diag_integral_mod
31 use platform_mod,
only: i8_kind, fms_file_len
34 operator(+),
operator(-), &
35 operator(==),
operator(>=), &
37 use mpp_mod,
only: input_nml_file
44 use fms2_io_mod,
only: file_exists
45 use constants_mod,
only: radius, constants_init
48 use 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
141 character(len=8) :: &
144 character(len=FMS_FILE_LEN) :: &
153 namelist / diag_integral_nml / &
176 real(r8_kind),
allocatable,
dimension(:,:) ::
area
241 type (
time_type),
intent(in),
optional :: time_init
242 type (
time_type),
intent(in),
optional :: time
243 class(*),
dimension(:,:),
intent(in),
optional :: blon
244 class(*),
dimension(:,:),
intent(in),
optional :: blat
245 class(*),
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)
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
394 character(len=*),
intent(in) :: name
395 character(len=*),
intent(in) :: format
412 ' integral name too long', fatal)
422 'integral name already exists', fatal)
432 'too many fields initialized', fatal)
477 'module has not been initialized', fatal )
522 'module has not been initialized', fatal )
582 real(r8_kind),
intent(in) :: atime
583 character(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)
606 'Invalid units sent to set_axis_time', fatal)
640 character(len=*),
intent(in) :: name
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)
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)
819 integer,
intent(in),
optional :: nst_in
821 integer,
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
910 integer,
intent(in) :: nst_in
912 integer,
intent(in) :: nend_in
914 logical,
intent(in) :: use_exp_format
924 integer :: i, nc, nst, nend
931 if( use_exp_format )
then
989 character(len=*),
intent(in) :: units
990 real(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)
1068 real(r8_kind),
dimension (:,:,:),
intent(in) :: field_data
1069 real(r8_kind),
dimension (:,:,:),
intent(in) :: wt
1070 real(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
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)
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
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...
subroutine, public write_version_number(version, tag, unit)
Prints to the log file (or a specified unit) the version id string and tag name.
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...
subroutine, public error_mesg(routine, message, level)
Print notes, warnings and error messages; terminates program for warning and error messages....
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,...
integer function mpp_pe()
Returns processor 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.