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
242 type (
time_type),
intent(in),
optional :: time_init
243 type (
time_type),
intent(in),
optional :: time
244 class(*),
dimension(:,:),
intent(in),
optional :: blon
245 class(*),
dimension(:,:),
intent(in),
optional :: blat
246 class(*),
dimension(:,:),
intent(in),
optional :: area_in
259 real(r8_kind) :: rsize
260 integer :: io, ierr, nc, logunit
261 integer :: field_size_local
262 real(r8_kind) :: sum_area_local
263 integer :: ensemble_size(6)
282 if (
present(time_init) .and.
present(time) .and. &
283 present(blon) .and.
present(blat) )
then
288 read (input_nml_file, nml=diag_integral_nml, iostat=io)
296 if (
mpp_pe() == mpp_root_pe() ) &
297 write (logunit, nml=diag_integral_nml)
310 idim =
size(blon,1) - 1
311 jdim =
size(blon,2) - 1
313 rsize = real(field_size_local,r8_kind)
326 type is (real(r4_kind)) ;
area = real(area_in,r8_kind)
327 type is (real(r8_kind)) ;
area = area_in
328 class default ;
call error_mesg(
'diag_inetgral_mod::diag_integral_init',
'unknown area_in type', fatal)
331 sum_area_local = sum(
area)
341 if (ensemble_size(1) > 1)
then
395 character(len=*),
intent(in) :: name
396 character(len=*),
intent(in) :: format
413 ' integral name too long', fatal)
423 'integral name already exists', fatal)
433 'too many fields initialized', fatal)
478 'module has not been initialized', fatal )
523 'module has not been initialized', fatal )
583 real(r8_kind),
intent(in) :: atime
584 character(len=*),
intent(in) :: units
597 if (units(1:3) ==
'sec')
then
598 sec = int(atime + 0.5)
599 else if (units(1:3) ==
'min')
then
600 sec = int(atime*60. + 0.5)
601 else if (units(1:3) ==
'hou')
then
602 sec = int(atime*3600. + 0.5)
603 else if (units(1:3) ==
'day')
then
604 sec = int(atime*86400. + 0.5)
607 'Invalid units sent to set_axis_time', fatal)
641 character(len=*),
intent(in) :: name
653 'name too long', fatal)
710 real(r8_kind) :: xtime, rcount
711 integer :: nn, ninc, nst, nend, fields_to_print
713 integer(i8_kind) :: icount
726 fields_to_print = fields_to_print + 1
730 icount = int(rcount, i8_kind)
737 (
'diag_integral_mod', &
738 'field_count equals zero for field_name ' // &
742 print*,
"name,pe,kount,field_size,icount,rcount=",trim(
field_name(i)),
mpp_pe(),kount,
field_size,icount,rcount
744 (
'diag_integral_mod', &
745 'field_count not a multiple of field_size', fatal )
751 field_avg(fields_to_print) =
field_sum(i)/ &
760 if (
mpp_pe() /= mpp_root_pe() )
return
780 xtime, (field_avg(i),i=nst,nend)
783 xtime, (field_avg(i),i=nst,nend)
812 integer,
intent(in),
optional :: nst_in
814 integer,
intent(in),
optional :: nend_in
824 integer :: i, nc, nst, nend
830 if (
mpp_pe() /= mpp_root_pe())
return
836 if (
present (nst_in) )
then
901 integer,
intent(in),
optional :: nst_in
903 integer,
intent(in),
optional :: nend_in
913 integer :: i, nc, nst, nend
926 if (
present (nst_in) )
then
979 character(len=*),
intent(in) :: units
980 real(r8_kind) :: atime
988 if (units(1:3) ==
'sec')
then
989 atime = real(sec,r8_kind) + 86400._r8_kind*real(day,r8_kind)
990 else if (units(1:3) ==
'min')
then
991 atime = real(sec,r8_kind)/60._r8_kind + 1440._r8_kind*real(day,r8_kind)
992 else if (units(1:3) ==
'hou')
then
993 atime = real(sec,r8_kind)/3600._r8_kind + 24._r8_kind*real(day,r8_kind)
994 else if (units(1:3) ==
'day')
then
995 atime = real(sec,r8_kind)/86400._r8_kind + real(day,r8_kind)
1058 real(r8_kind),
dimension (:,:,:),
intent(in) :: field_data
1059 real(r8_kind),
dimension (:,:,:),
intent(in) :: wt
1060 real(r8_kind),
dimension (size(field_data,1),size(field_data,2)) :: data2
1066 real,
dimension(size(field_data,1),size(field_data,2)) :: wt2
1070 if (count(wt2 == 0._r8_kind) > 0)
then
1072 'vert sum of weights equals zero', fatal)
1074 data2 = sum(field_data*wt,3) / wt2
1081 character (len=*),
intent(inout) :: fname
1082 character (len=FMS_FILE_LEN) :: updated_file_name
1083 integer :: ensemble_id_int
1084 character(len=7) :: ensemble_suffix
1085 character(len=2) :: ensemble_id_char
1088 if (len(trim(fname)) > fms_file_len-7)
call error_mesg (
'diag_integral_mod :: ensemble_file_name', &
1089 trim(fname)//
" is too long and can not support adding ens_XX. Please shorten the "//&
1090 "file_name in the diag_integral_nml", fatal)
1093 write(ensemble_id_char,
"(I0)") ensemble_id_int
1095 if (ensemble_id_int < 10)
then
1096 ensemble_suffix =
".ens_0"//trim(ensemble_id_char)
1097 elseif (ensemble_id_int >= 10 .and. ensemble_id_int < 100)
then
1098 ensemble_suffix =
".ens_"//trim(ensemble_id_char)
1101 ' Does not support ensemble sizes over 99.', fatal)
1105 do i=len(trim(fname)),2,-1
1106 if (fname(i:i) ==
".")
then
1107 updated_file_name = fname(1:i-1)//trim(ensemble_suffix)//fname(i:len(fname))
1112 updated_file_name = trim(fname)//trim(ensemble_suffix)
1115 #include "diag_integral_r4.fh"
1116 #include "diag_integral_r8.fh"
1118 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
subroutine, private format_data_init(nst_in, nend_in)
format_text_init generates the format to be output in the integrals file.
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
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
logical do_format_data
a data format needs to be generated ?
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.