!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
module movie 5,14
!BOP
! !MODULE: movie
! !DESCRIPTION:
! This module contains data types and routines for computing running
! time-averages of selected fields and writing this data to files.
!
! !REVISION HISTORY:
! CVS:$Id: movie.F90 21830 2010-03-19 23:24:01Z njn01 $
! CVS:$Name: $
! !USES:
use POP_IOUnitsMod
use kinds_mod
use blocks
use distribution
use domain
use constants
use prognostic
use grid
use time_management
use registry
use global_reductions
use broadcast
use io
use exit_mod
implicit none
private
save
! !PUBLIC MEMBER FUNCTIONS:
public :: init_movie, &
define_movie_field, &
update_movie_field, &
movie_requested, &
write_movie
! !PUBLIC DATA MEMBERS:
logical (log_kind), public :: &
lmovie_on = .false. ! movie file output wanted
!EOP
!BOC
!-----------------------------------------------------------------------
!
! movie field descriptor data type and array of such types
!
!-----------------------------------------------------------------------
type :: movie_field_desc
character(char_len) :: short_name ! short name for field
character(char_len) :: long_name ! long descriptive name
character(char_len) :: units ! units
character(4) :: grid_loc ! location in grid
real (r4) :: missing_value ! value on land pts
real (r4), dimension(2) :: valid_range ! min/max
integer (int_kind) :: buf_loc ! location in buffer
integer (int_kind) :: field_loc ! grid location and field
integer (int_kind) :: field_type ! type for io, ghost cells
integer (r4) :: field_depth_index ! depth index of 2d slice
end type
integer (int_kind), parameter :: &
max_avail_movie_fields = (4+nt)*km+50 ! limit on available fields - can
! be pushed as high as necessary
integer (int_kind) :: &
num_avail_movie_fields = 0, &! current number of defined fields
num_requested_movie_fields, &! number of fields requested
movie_flag ! time flag for writing movie files
type (movie_field_desc), dimension(max_avail_movie_fields) :: &
avail_movie_fields
!-----------------------------------------------------------------------
!
! buffers for holding running movie variables
!
!-----------------------------------------------------------------------
integer (int_kind) :: &
movie_bufsize_2d ! size of buffer for 2d fields
real (r4), dimension(:,:,:,:), allocatable :: &
MOVIE_BUF_2D ! buffer for holding movie fields
!-----------------------------------------------------------------------
!
! variables for writing data
!
!-----------------------------------------------------------------------
integer (int_kind) :: &
movie_freq_iopt, &! frequency option for writing movie
movie_freq ! frequency of movie output
character (char_len) :: &
movie_outfile, & ! root filename for movie output
movie_fmt ! format (nc or bin) for writing
type (datafile) :: movie_file_desc ! IO file descriptor
type (io_field_desc), target :: &
MOVIE_iodesc ! io descriptor for movie fields
!-----------------------------------------------------------------------
!
! ccsm variables
!
!-----------------------------------------------------------------------
logical (log_kind) :: &
lccsm
!EOC
!***********************************************************************
contains
!***********************************************************************
!EOP
! !IROUTINE: init_movie
! !INTERFACE:
subroutine init_movie 1,20
! !DESCRIPTION:
! This routine initializes movie options and reads in contents file to
! determine which fields for which the user wants 2D snapshot data.
!
! !REVISION HISTORY:
! same as module
!EOP
!BOC
!-----------------------------------------------------------------------
!
! local variables
!
!-----------------------------------------------------------------------
integer (int_kind) :: &
n, &! dummy index
k, &! depth index
iblock, &! local block index
loc, &! location of field in buffer
nu, &! unit for contents input file
cindex, &! character index for manipulating strings
nml_error, &! namelist i/o error flag
contents_error ! error flag for contents file read
character (char_len) :: &
movie_freq_opt, &! choice for frequency of movie output
movie_contents, &! filename for choosing fields for output
char_temp ! temporary for manipulating fields
character (34), parameter :: &
freq_fmt = "('movie diagnostics every ',i6,a8)"
namelist /movie_nml/ movie_freq_opt, movie_freq, &
movie_outfile, movie_contents, movie_fmt
!-----------------------------------------------------------------------
!
! read movie file output frequency and filenames from namelist
!
!-----------------------------------------------------------------------
if (my_task == master_task) then
write(stdout,delim_fmt)
write(stdout,blank_fmt)
write(stdout,'(a12)') 'Movie options'
write(stdout,blank_fmt)
write(stdout,delim_fmt)
endif
movie_freq_iopt = freq_opt_never
movie_freq = 100000
movie_outfile = 't'
movie_contents = 'unknown_movie_contents'
if (my_task == master_task) then
open (nml_in, file=nml_filename, status='old',iostat=nml_error)
if (nml_error /= 0) then
nml_error = -1
else
nml_error = 1
endif
do while (nml_error > 0)
read(nml_in, nml=movie_nml,iostat=nml_error)
end do
if (nml_error == 0) close(nml_in)
endif
call broadcast_scalar(nml_error, master_task)
if (nml_error /= 0) then
call exit_POP(sigAbort,'ERROR reading movie_nml')
endif
if (my_task == master_task) then
write(stdout,blank_fmt)
write(stdout,ndelim_fmt)
write(stdout,blank_fmt)
write(stdout,*) ' Movie:'
write(stdout,blank_fmt)
write(stdout,*) ' movie_nml namelist settings:'
write(stdout,blank_fmt)
write(stdout,movie_nml)
write(stdout,blank_fmt)
call POP_IOUnitsFlush(stdout)
endif
if (my_task == master_task) then
select case (movie_freq_opt)
case ('never')
movie_freq_iopt = freq_opt_never
write(stdout,'(a21)') 'movie diagnostics off'
case ('nyear')
movie_freq_iopt = freq_opt_nyear
write(stdout,freq_fmt) movie_freq,' years '
case ('nmonth')
movie_freq_iopt = freq_opt_nmonth
write(stdout,freq_fmt) movie_freq,' months '
case ('nday')
movie_freq_iopt = freq_opt_nday
write(stdout,freq_fmt) movie_freq,' days '
case ('nhour')
movie_freq_iopt = freq_opt_nhour
write(stdout,freq_fmt) movie_freq,' hours '
case ('nsecond')
movie_freq_iopt = freq_opt_nsecond
write(stdout,freq_fmt) movie_freq,' seconds'
case ('nstep')
movie_freq_iopt = freq_opt_nstep
write(stdout,freq_fmt) movie_freq,' steps '
case default
movie_freq_iopt = -1000
end select
endif
call POP_IOUnitsFlush(stdout)
call broadcast_scalar(movie_freq_iopt, master_task)
if (movie_freq_iopt == -1000) then
call exit_POP(sigAbort,'unknown option for movie file frequency')
else if (movie_freq_iopt /= freq_opt_never) then
call broadcast_scalar(movie_freq, master_task)
call broadcast_scalar(movie_outfile, master_task)
call broadcast_scalar(movie_contents, master_task)
call broadcast_scalar(movie_fmt , master_task)
endif
!-----------------------------------------------------------------------
!
! initialize time flag for writing movie files
!
!-----------------------------------------------------------------------
call init_time_flag('movie',movie_flag, default=.false., &
owner = 'init_movie', &
freq_opt = movie_freq_iopt, &
freq = movie_freq)
!-----------------------------------------------------------------------
!
! read contents file to determine which fields to dump
!
!-----------------------------------------------------------------------
if (movie_freq_iopt /= freq_opt_never) then
movie_bufsize_2d = 0
call get_unit(nu)
if (my_task == master_task) then
open(nu, file=movie_contents, status='old')
read(nu,*) num_requested_movie_fields
write(stdout,'(a38)') 'movie diagnostics requested for fields:'
endif
call broadcast_scalar(num_requested_movie_fields, master_task)
contents_error = 0
do n=1,num_requested_movie_fields
if (my_task == master_task) then
read(nu,'(i3,a80)',iostat=contents_error) k, char_temp
char_temp = adjustl(char_temp)
cindex = index(char_temp,' ')
char_temp(cindex:) = ' '
write(stdout,*) ' ',trim(char_temp),' at level ',k
endif
call broadcast_scalar(contents_error, master_task)
if (contents_error /= 0) then
call exit_POP(sigAbort,'error reading movie contents')
endif
call broadcast_scalar(char_temp, master_task)
call broadcast_scalar(k , master_task)
call request_movie_field(trim(char_temp), k)
end do
call release_unit(nu)
!*** allocate and initialize running movie buffers
allocate( &
MOVIE_BUF_2D(nx_block,ny_block, nblocks_clinic,movie_bufsize_2d) )
lmovie_on = .true.
endif
!-----------------------------------------------------------------------
!
! determine if this is a ccsm coupled run
!
!-----------------------------------------------------------------------
lccsm = registry_match('lcoupled')
!-----------------------------------------------------------------------
!EOC
end subroutine init_movie
!***********************************************************************
!BOP
! !IROUTINE: write_movie
! !INTERFACE:
subroutine write_movie 1,18
! !DESCRIPTION:
! This routine writes requested movie fields to a file.
!
! !REVISION HISTORY:
! same as module
! !INPUT PARAMETERS:
!EOP
!BOC
!-----------------------------------------------------------------------
!
! local variables
!
!-----------------------------------------------------------------------
integer (int_kind) :: &
nu, &! i/o unit for output file
iblock, &! dummy block index
nfield, &! dummy field index
loc, &! buffer location for field
io_phase !'define' or 'write'
character (char_len) :: &
file_suffix, &! suffix to append to movie file name
hist_string, &! string containing file history
movie_filename ! filename for movie data
character (8) :: &
date_created ! string with (real) date this file created
character (10) :: &
time_created ! string with (real) date this file created
type (io_field_desc), dimension(:), allocatable :: &
movie_fields
type (io_dim) :: &
i_dim, j_dim ! dimension descriptors for horiz dims
logical (log_kind) :: &
lmovie_write ! time to write a file
!-----------------------------------------------------------------------
!
! is it time to write a file - if yes, create a file suffix
!
!-----------------------------------------------------------------------
lmovie_write = .false.
if (lmovie_on) then
lmovie_write = check_time_flag(movie_flag)
endif
if (lmovie_write) then
file_suffix = char_blank
if (lccsm) then
call create_suffix_movie_ccsm(file_suffix)
else
call create_suffix_movie(file_suffix)
endif
!-----------------------------------------------------------------------
!
! create data file descriptor
!
!-----------------------------------------------------------------------
call date_and_time(date=date_created, time=time_created)
hist_string = char_blank
write(hist_string,'(a24,a8,1x,a10)') &
'POP MOVIE file created: ',date_created,time_created
movie_file_desc = construct_file(movie_fmt, &
root_name = trim(movie_outfile), &
file_suffix= trim(file_suffix), &
title ='POP MOVIE file', &
conventions='POP MOVIE conventions', &
history = trim(hist_string), &
record_length = rec_type_real, &
recl_words=nx_global*ny_global)
!-----------------------------------------------------------------------
!
! add scalar fields to file as file attributes
!
!-----------------------------------------------------------------------
call add_attrib_file(movie_file_desc, 'nsteps_total', nsteps_total)
call add_attrib_file(movie_file_desc, 'tday' , tday)
call add_attrib_file(movie_file_desc, 'iyear' , iyear)
call add_attrib_file(movie_file_desc, 'imonth' , imonth)
call add_attrib_file(movie_file_desc, 'iday' , iday)
!-----------------------------------------------------------------------
!
! open output file
!
!-----------------------------------------------------------------------
call data_set (movie_file_desc, 'open')
!-----------------------------------------------------------------------
!
! write fields to file - this requires two phases
! in this first phase, we define all the fields to be written
!
!-----------------------------------------------------------------------
!*** define dimensions
i_dim = construct_io_dim('i',nx_global)
j_dim = construct_io_dim('j',ny_global)
allocate(movie_fields(num_avail_movie_fields))
do nfield = 1,num_avail_movie_fields ! check all available fields
loc = avail_movie_fields(nfield)%buf_loc ! locate field in buffer
if (loc > 0) then ! field is actually requested and in buffer
!*** construct io_field descriptors for each field
movie_fields(nfield) = construct_io_field( &
avail_movie_fields(nfield)%short_name, &
i_dim, j_dim, &
long_name=avail_movie_fields(nfield)%long_name, &
units =avail_movie_fields(nfield)%units , &
grid_loc =avail_movie_fields(nfield)%grid_loc , &
field_loc =avail_movie_fields(nfield)%field_loc, &
field_type =avail_movie_fields(nfield)%field_type, &
missing_value=avail_movie_fields(nfield)%missing_value, &
valid_range=avail_movie_fields(nfield)%valid_range, &
r2d_array =MOVIE_BUF_2D(:,:,:,loc) )
call data_set (movie_file_desc, 'define', movie_fields(nfield))
endif
end do
!-----------------------------------------------------------------------
!
! write fields to file
! in this second phase, we actually write the data for all the fields
! after writing a field, the field descriptor is destroyed and the
! file can be closed
!
!-----------------------------------------------------------------------
do nfield = 1,num_avail_movie_fields ! check all available fields
loc = avail_movie_fields(nfield)%buf_loc ! locate field in buffer
if (loc > 0) then ! field is actually requested and in buffer
call data_set (movie_file_desc, 'write', movie_fields(nfield))
call destroy_io_field(movie_fields(nfield))
endif
end do
deallocate(movie_fields)
call data_set (movie_file_desc, 'close')
if (my_task == master_task) then
write(stdout,blank_fmt)
write(stdout,*) 'Wrote file: ', trim(movie_file_desc%full_name)
endif
!-----------------------------------------------------------------------
!
! get rid of file descriptor
!
!-----------------------------------------------------------------------
call destroy_file(movie_file_desc)
endif ! lwrite_movie
!-----------------------------------------------------------------------
!EOC
end subroutine write_movie
!***********************************************************************
!BOP
! !IROUTINE: movie_global
! !INTERFACE:
subroutine movie_global
! !DESCRIPTION:
! Calculates and print global integrals of time average fields
!
! !REVISION HISTORY:
! same as module
!EOP
!BOC
!-----------------------------------------------------------------------
!
! local variables
!
!-----------------------------------------------------------------------
integer (int_kind) :: &
k, & ! vertical level index
ifield, & ! field identifier
iblock, & ! block index
nfield, & ! dummy field index
field_loc, & ! field location (center,Nface,Eface,NEcorner)
field_type ! field type (scalar, vector, angle)
real (r8) :: &
movie_field_sum, & ! sum of movie field
movie_norm ! normalization for average
real (r8), dimension (:,:,:), allocatable :: &
WORK ! temp for holding area_weighted field
real (r8), dimension (:,:), allocatable :: &
RMASK ! topography mask for global sum
!-----------------------------------------------------------------------
!
! calculate globally-integrated time average of each chosen 2d field
!
!-----------------------------------------------------------------------
allocate (RMASK(nx_block,ny_block), &
WORK (nx_block,ny_block,nblocks_clinic))
if (my_task == master_task) then
write (stdout,blank_fmt)
write (stdout,'(a22)') 'Global Time Averages: '
endif
do nfield=1,num_avail_movie_fields
ifield = avail_movie_fields(nfield)%buf_loc
if (ifield > 0) then
field_loc = avail_movie_fields(nfield)%field_loc
field_type = avail_movie_fields(nfield)%field_type
!$OMP PARALLEL DO PRIVATE(iblock)
do iblock = 1,nblocks_clinic
select case(field_loc)
case(field_loc_center)
WORK(:,:,iblock) = MOVIE_BUF_2D(:,:,iblock,ifield)* &
TAREA(:,:,iblock)*RCALCT(:,:,iblock)
case(field_loc_NEcorner)
WORK(:,:,iblock) = MOVIE_BUF_2D(:,:,iblock,ifield)* &
UAREA(:,:,iblock)*RCALCU(:,:,iblock)
case default ! make U cell the default for all other cases
WORK(:,:,iblock) = MOVIE_BUF_2D(:,:,iblock,ifield)* &
UAREA(:,:,iblock)*RCALCU(:,:,iblock)
end select
end do
!$OMP END PARALLEL DO
movie_field_sum = global_sum(WORK, distrb_clinic, field_loc)
select case(field_loc)
case(field_loc_center)
movie_field_sum = movie_field_sum/(area_t)
case(field_loc_NEcorner)
movie_field_sum = movie_field_sum/(area_u)
case default ! make U cell the default for all other cases
movie_field_sum = movie_field_sum/(area_u)
end select
if (my_task == master_task) then
write (stdout,*) trim(avail_movie_fields(nfield)%short_name), &
': ', movie_field_sum
endif
endif
end do
deallocate (RMASK, WORK)
!-----------------------------------------------------------------------
!EOC
end subroutine movie_global
!***********************************************************************
!BOP
! !IROUTINE: update_movie_field
! !INTERFACE:
subroutine update_movie_field(ARRAY,field_id,block,k) 12,1
! !DESCRIPTION:
! This routine updates a movie field to the current value.
!
! !REVISION HISTORY:
! same as module
! !INPUT PARAMETERS:
integer (int_kind), intent(in) :: &
block, &! local block address (in baroclinic distribution)
k, &! vertical level
field_id ! index into available fields for movie field info
real (r8), dimension(nx_block,ny_block), intent(in) :: &
ARRAY ! array of data for this block update movie buffer
!EOP
!BOC
!-----------------------------------------------------------------------
!
! local variables
!
!-----------------------------------------------------------------------
integer (int_kind) :: &
bufloc ! location of field in movie buffer
!-----------------------------------------------------------------------
!
! get buffer location and field info from avail_movie_field array
!
!-----------------------------------------------------------------------
bufloc = avail_movie_fields(field_id)%buf_loc
if (bufloc <= 0) &
call exit_POP(sigAbort, &
'movie: attempt to update bad movie field')
!-----------------------------------------------------------------------
!
! update the field into the movie buffer
!
!-----------------------------------------------------------------------
MOVIE_BUF_2D(:,:,block,bufloc) = ARRAY
!-----------------------------------------------------------------------
!EOC
end subroutine update_movie_field
!***********************************************************************
!BOP
! !IROUTINE: define_movie_field
! !INTERFACE:
subroutine define_movie_field(id, short_name, depth_index, & 12,1
long_name, units, &
grid_loc, missing_value, valid_range, &
field_loc, field_type)
! !DESCRIPTION:
! Initializes description of an available field and returns location
! in the available fields array for use in later movie calls.
!
! !REVISION HISTORY:
! same as module
! !OUTPUT PARAMETERS:
integer (int_kind), intent(out) :: &
id ! location in avail_fields array for use in
! later movie routines
! !INPUT PARAMETERS:
character(*), intent(in) :: &
short_name ! short name for field
integer (int_kind), intent(in), optional :: &
field_loc, &! location in grid
field_type, &! type of field (scalar, vector, angle)
depth_index ! depth index of 2d slice
character(*), intent(in), optional :: &
long_name, &! long descriptive name for field
units ! physical units for field
character(4), intent(in), optional :: &
grid_loc ! location in grid (in 4-digit code)
real (r4), intent(in), optional :: &
missing_value ! value on land pts
real (r4), dimension(2), intent(in), optional :: &
valid_range ! min/max
!-----------------------------------------------------------------------
!
! local variables
!
!-----------------------------------------------------------------------
character (char_len) :: &
appended_long_name, & ! long name with depth appended
appended_short_name ! short name with depth appended
character (len = 5) :: char_depth ! character version of the depth of a 2d slice
integer (int_kind) :: &
cbegin, clen, cindx, & ! character indices
nearest_integer_depth ! integer version of the depth of a 2d slice
real (r4) :: &
field_depth ! floating point version of the depth of a 2d slice
!EOP
!BOC
!-----------------------------------------------------------------------
!
! increment the number of defined fields and make sure it does not
! exceed the maximum
! return the id as the current number
!
!-----------------------------------------------------------------------
num_avail_movie_fields = num_avail_movie_fields + 1
if (num_avail_movie_fields > max_avail_movie_fields) then
call exit_POP(sigAbort, &
'movie: defined movie fields > max allowed')
endif
id = num_avail_movie_fields
!-----------------------------------------------------------------------
!
! now fill the field descriptor
!
!-----------------------------------------------------------------------
avail_movie_fields(id)%buf_loc = 0 ! will be reset later
!-----------------------------------------------------------------------
!
! now check the depth index since we will modify short and long field
! names if not at surface (depth_index = 0)
!
! for example, if we want TEMP for k=5 which corresponds to, say, 63 meters
! depth, then the short_name becomes TEMP_63m
! if long_name is defined, do a similar thing except replace _ with at
! and m with meters
!
!-----------------------------------------------------------------------
if (present(depth_index)) then
avail_movie_fields(id)%field_depth_index = depth_index
else
avail_movie_fields(id)%field_depth_index = 0
endif
if (present(long_name) .and. avail_movie_fields(id)%field_depth_index <= 0) then
avail_movie_fields(id)%long_name = long_name
else
avail_movie_fields(id)%long_name = char_blank
endif
if (avail_movie_fields(id)%field_depth_index > 0) then
field_depth = zt(depth_index)*mpercm ! assume mid-cell and convert to meters
nearest_integer_depth = nint(field_depth)
write(char_depth,'(i5)') 10000 + nearest_integer_depth
if (nearest_integer_depth < 10) then
cbegin = 5
else if (nearest_integer_depth >= 10 .and. nearest_integer_depth < 100) then
cbegin = 4
else if (nearest_integer_depth >= 100 .and. nearest_integer_depth < 1000) then
cbegin = 3
else if (nearest_integer_depth >= 1000 .and. nearest_integer_depth < 10000) then
cbegin = 2
else
cbegin = 1
endif
clen = 6 - cbegin
appended_short_name = short_name
cindx = len_trim(appended_short_name)
cindx = cindx + 1
appended_short_name(cindx:cindx) = '_'
cindx = cindx + 1
appended_short_name(cindx:cindx+clen-1) = &
char_depth(cbegin:cbegin+clen-1)
cindx = cindx + clen
appended_short_name(cindx:cindx) = 'm' ! meters
avail_movie_fields(id)%short_name = appended_short_name
if (present(long_name)) then
appended_long_name = long_name
cindx = len_trim(appended_long_name)
cindx = cindx + 1
appended_long_name(cindx:cindx+3) = ' at '
cindx = cindx + 4
appended_long_name(cindx:cindx+clen-1) = &
char_depth(cbegin:cbegin+clen-1)
cindx = cindx + clen
appended_long_name(cindx:cindx+6) = ' meters' ! meters
avail_movie_fields(id)%long_name = appended_long_name
endif ! long_name is present
else
avail_movie_fields(id)%short_name = short_name
endif
if (present(units)) then
avail_movie_fields(id)%units = units
else
avail_movie_fields(id)%units = char_blank
endif
if (present(grid_loc)) then
avail_movie_fields(id)%grid_loc = grid_loc
else
avail_movie_fields(id)%grid_loc = ' '
endif
if (present(missing_value)) then
avail_movie_fields(id)%missing_value = missing_value
else
avail_movie_fields(id)%missing_value = undefined
endif
if (present(valid_range)) then
avail_movie_fields(id)%valid_range = valid_range
else
avail_movie_fields(id)%valid_range = undefined
endif
!*** set field location, field type used by i/o, ghost cell update
!*** and other communication routines. because ghost cells for movie
!*** fields are not typically used, the default is field_xxx_noupdate
if (present(field_loc)) then
avail_movie_fields(id)%field_loc = field_loc
else
!*** try to decode field location from grid_loc
if (grid_loc(2:2) == '1' .and. grid_loc(3:3) == '1') then
avail_movie_fields(id)%field_loc = field_loc_center
else if (grid_loc(2:2) == '2' .and. grid_loc(3:3) == '2') then
avail_movie_fields(id)%field_loc = field_loc_NEcorner
else if (grid_loc(2:2) == '1' .and. grid_loc(3:3) == '2') then
avail_movie_fields(id)%field_loc = field_loc_Nface
else if (grid_loc(2:2) == '2' .and. grid_loc(3:3) == '1') then
avail_movie_fields(id)%field_loc = field_loc_Eface
else
avail_movie_fields(id)%field_loc = field_loc_noupdate
endif
endif
if (present(field_type)) then
avail_movie_fields(id)%field_type = field_type
else
avail_movie_fields(id)%field_type = field_type_noupdate
endif
!-----------------------------------------------------------------------
!EOC
end subroutine define_movie_field
!***********************************************************************
!BOP
! !IROUTINE: request_movie_field
! !INTERFACE:
subroutine request_movie_field(short_name,k) 1,1
! !DESCRIPTION:
! This field marks an available field as requested and computes
! the location in the movie buffer array.
!
! !REVISION HISTORY:
! same as module
! !INPUT PARAMETERS:
character (*), intent(in) :: &
short_name ! the short name of the field
integer (int_kind), intent(in) :: &
k ! depth index
!EOP
!BOC
!-----------------------------------------------------------------------
!
! local variables
!
!-----------------------------------------------------------------------
integer (int_kind) :: &
n, &! loop index
id ! location of field in avail_fields array
character (char_len) :: &
appended_short_name ! short name with depth appended
character (len = 5) :: char_depth ! character version of the depth of a 2d slice
integer (int_kind) :: &
cbegin, clen, cindx, & ! character indices
nearest_integer_depth ! integer version of the depth of a 2d slice
real (r4) :: &
field_depth ! floating point version of the depth of a 2d slice
!-----------------------------------------------------------------------
!
! search for field with same name
!
!-----------------------------------------------------------------------
if ( k > 0 .and. k <= km) then
field_depth = zt(k)*mpercm ! assume mid-cell and convert to meters
nearest_integer_depth = nint(field_depth)
write(char_depth,'(i5)') 10000 + nearest_integer_depth
if (nearest_integer_depth < 10) then
cbegin = 5
else if (nearest_integer_depth >= 10 .and. nearest_integer_depth < 100) then
cbegin = 4
else if (nearest_integer_depth >= 100 .and. nearest_integer_depth < 1000) then
cbegin = 3
else if (nearest_integer_depth >= 1000 .and. nearest_integer_depth < 10000) then
cbegin = 2
else
cbegin = 1
endif
clen = 6 - cbegin
appended_short_name = short_name
cindx = len_trim(appended_short_name)
cindx = cindx + 1
appended_short_name(cindx:cindx) = '_'
cindx = cindx + 1
appended_short_name(cindx:cindx+clen-1) = &
char_depth(cbegin:cbegin+clen-1)
cindx = cindx + clen
appended_short_name(cindx:cindx) = 'm' ! meters
else
appended_short_name = short_name
endif
id = 0
srch_loop: do n=1,num_avail_movie_fields
if (trim(avail_movie_fields(n)%short_name) == trim(appended_short_name)) then
id = n
exit srch_loop
endif
end do srch_loop
if (id == 0) then
if (my_task == master_task) write(stdout,*) 'Requested ', &
trim(appended_short_name)
call exit_POP(sigAbort,'movie: requested field unknown')
endif
!-----------------------------------------------------------------------
!
! set the position in the buffer and advance the buffer position
! for the next field
!
!-----------------------------------------------------------------------
movie_bufsize_2d = movie_bufsize_2d + 1
avail_movie_fields(id)%buf_loc = movie_bufsize_2d
!-----------------------------------------------------------------------
!EOC
end subroutine request_movie_field
!***********************************************************************
!BOP
! !IROUTINE: movie_requested
! !INTERFACE:
function movie_requested(id) 12,1
! !DESCRIPTION:
! This function determines whether an available (defined) movie field
! has been requested by a user (through the input contents file) and
! returns true if it has. Note that if movie has been turned off,
! the function will always return false.
!
! !REVISION HISTORY:
! same as module
! !INPUT PARAMETERS:
integer (int_kind), intent(in) :: &
id ! id returned by the define function which
! gives the location of the field
! !OUTPUT PARAMETERS:
logical (log_kind) :: &
movie_requested ! result of checking whether the field has
! been requested
!EOP
!BOC
!-----------------------------------------------------------------------
!
! check the buffer location - if zero, the field has not been
! requested
!
!-----------------------------------------------------------------------
if (id < 1 .or. id > num_avail_movie_fields) then
call exit_POP(sigAbort,'movie_requested: invalid movie id')
endif
if (avail_movie_fields(id)%buf_loc > 0) then
movie_requested = .true.
else
movie_requested = .false.
endif
!-----------------------------------------------------------------------
!EOC
end function movie_requested
!***********************************************************************
!BOP
! !IROUTINE: create_suffix_movie
! !INTERFACE:
subroutine create_suffix_movie(file_suffix) 1,1
! !DESCRIPTION:
! Creates a suffix to append to output filename based on frequency
! option and averaging interval.
!
! !REVISION HISTORY:
! same as module
! !OUTPUT PARAMETERS:
character (char_len), intent(out) :: &
file_suffix ! suffix to append to root filename
!EOP
!BOC
!-----------------------------------------------------------------------
!
! local variable
!
!-----------------------------------------------------------------------
integer (int_kind) :: &
cindx1, cindx2, &! indices into character strings
len_date ! length of date string
character (char_len) :: &
char_temp ! temp character space (for removing spaces)
character (10) :: &
cstep_beg, &! beginning step of this particular average
cstep_end, &! ending step of this particular average
cdate ! character string with yyyymmdd and optional
! separator (eg yyyy-mm-dd)
character (4) :: &
cyear_beg, &! beginning year of this particular average
cyear_end ! end year of this particular average
character (2) :: &
cmonth_beg, &! beginning month of this particular average
cmonth_end, &! end month of this particular average
cday_beg, &! beginning day of this particular average
cday_end ! end day of this particular average
!-----------------------------------------------------------------------
!
! start suffix with runid
!
!-----------------------------------------------------------------------
file_suffix = char_blank
cindx2 = len_trim(runid) + 1
file_suffix(1:cindx2) = trim(runid)/&
&/'.'
cindx1 = cindx2 + 1
!-----------------------------------------------------------------------
!
! extract beginning year, month, day or time step from beg_date
! and determine end date
!
!-----------------------------------------------------------------------
!***
!*** use step numbers if movie freq option is nstep
!***
write(cstep_end,'(i10)') nsteps_total - 1
cdate = adjustl(cstep_end)
cstep_end = trim(cdate)
call time_stamp('last', 'ymd', date_string=cdate) ! last date
if (date_separator == ' ') then ! no date separator
cyear_end = cdate(1:4)
cmonth_end = cdate(5:6)
cday_end = cdate(7:8)
else
cyear_end = cdate(1:4)
cmonth_end = cdate(6:7)
cday_end = cdate(9:10)
endif
!-----------------------------------------------------------------------
!
! create time portion of suffix based on frequency option
! note that concatenation operator split across lines to avoid
! problems with some cpp preprocessors
!
!-----------------------------------------------------------------------
select case (movie_freq_iopt)
case (freq_opt_nyear, freq_opt_nmonth, freq_opt_nday)
cindx2 = cindx1 + 7
file_suffix(cindx1:cindx2) = cyear_end/&
&/cmonth_end/&
&/cday_end
case (freq_opt_nstep)
cindx2 = cindx1 + len_trim(cstep_end) - 1
file_suffix(cindx1:cindx2) = trim(cstep_end)
case default ! use nstep for other options
cindx2 = cindx1 + len_trim(cstep_end) - 1
file_suffix(cindx1:cindx2) = trim(cstep_end)
end select
!-----------------------------------------------------------------------
!EOC
end subroutine create_suffix_movie
!***********************************************************************
!BOP
! !IROUTINE: create_suffix_movie_ccsm
! !INTERFACE:
subroutine create_suffix_movie_ccsm(file_suffix) 1,1
! !DESCRIPTION:
! Creates a suffix to append to output filename based on frequency
! option and averaging interval. Suffix conforms to CCSM output
! file file-naming conventions.
!
! !REVISION HISTORY:
! same as module
! !OUTPUT PARAMETERS:
character (char_len), intent(out) :: &
file_suffix ! suffix to append to root filename
!EOP
!BOC
!-----------------------------------------------------------------------
!
! local variables
!
!-----------------------------------------------------------------------
character (char_len) :: &
char_temp, &! temp character space
ccsm_date_string
!-----------------------------------------------------------------------
!
! clear character strings
!
!-----------------------------------------------------------------------
file_suffix = char_blank
char_temp = char_blank
!-----------------------------------------------------------------------
!
! for a ccsm movie file, append a date/time string to the root name
!
!-----------------------------------------------------------------------
select case (movie_freq_iopt)
case (freq_opt_nyear)
char_temp = 'y'
case (freq_opt_nmonth)
char_temp = 'ym'
case (freq_opt_nday)
char_temp = 'ymd'
case (freq_opt_nhour)
char_temp = 'ymds'
case (freq_opt_nsecond)
char_temp = 'ymds'
case (freq_opt_nstep)
char_temp = 'ymds'
case default
char_temp = 'ymds'
end select
call ccsm_date_stamp (ccsm_date_string, char_temp)
file_suffix = trim(ccsm_date_string)
!-----------------------------------------------------------------------
!EOC
end subroutine create_suffix_movie_ccsm
!***********************************************************************
end module movie
!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||