SCALE-RM
Data Types | Functions/Subroutines
scale_history Module Reference

module HISTORY More...

Functions/Subroutines

subroutine, public hist_setup
 Setup. More...
 
subroutine, public hist_switch (switch)
 set switch More...
 
subroutine, public hist_setpres (PRES, SFC_PRES)
 set interpolation factor for pressure coordinate More...
 
subroutine, public hist_reg (itemid, item, desc, unit, ndim, xdim, ydim, zdim)
 Register/Append variable to history file. More...
 
subroutine, public hist_query (itemid, answer)
 Check time to putting data. More...
 
subroutine hist_put_0d (itemid, var)
 Put 1D data to history buffer. More...
 
subroutine hist_put_1d (itemid, var)
 Put 1D data to history buffer. More...
 
subroutine hist_put_2d (itemid, var, nohalo)
 Put 2D data to history buffer. More...
 
subroutine hist_put_3d (itemid, var, xdim, ydim, zdim, nohalo)
 Put 3D data to history buffer. More...
 
subroutine hist_in_0d (var, item, desc, unit)
 Wrapper routine of HIST_reg+HIST_put 0D. More...
 
subroutine hist_get_2d (var, basename, varname, step, allow_missing)
 Get 2D data from file. More...
 
subroutine hist_get_3d (var, basename, varname, step, allow_missing)
 Get 3D data from file. More...
 
subroutine, public hist_write
 Flush history buffer to file. More...
 

Detailed Description

module HISTORY

Description
History output module
Author
Team SCALE
History
  • 2011-12-05 (H.Yashiro) [new]
  • 2012-03-23 (H.Yashiro) [mod] Explicit index parameter inclusion
  • 2012-06-11 (S.Nishizawa) [mod] use gtool_history
NAMELIST
  • PARAM_HIST
    nametypedefault valuecomment
    HIST_PRES_NLAYER integer -1 Number of pressure layer
    HIST_PRES real(RP), dimension(HIST_PRES_NLIM) 0.0_RP pressure level to output [hPa]
    HIST_BND logical .false.

History Output
No history output

Function/Subroutine Documentation

◆ hist_setup()

subroutine, public scale_history::hist_setup ( )

Setup.

Definition at line 103 of file scale_history.F90.

References scale_const::const_d2r, scale_grid::grid_cbfx, scale_grid::grid_cbfxg, scale_grid::grid_cbfy, scale_grid::grid_cbfyg, scale_grid::grid_cbfz, scale_grid::grid_cdx, scale_grid::grid_cdxg, scale_grid::grid_cdy, scale_grid::grid_cdyg, scale_grid::grid_cdz, scale_grid::grid_cx, scale_grid::grid_cxg, scale_grid::grid_cy, scale_grid::grid_cyg, scale_grid::grid_cz, scale_grid::grid_fbfx, scale_grid::grid_fbfxg, scale_grid::grid_fbfy, scale_grid::grid_fbfyg, scale_grid::grid_fbfz, scale_grid::grid_fdx, scale_grid::grid_fdxg, scale_grid::grid_fdy, scale_grid::grid_fdyg, scale_grid::grid_fdz, scale_grid::grid_fx, scale_grid::grid_fxg, scale_grid::grid_fy, scale_grid::grid_fyg, scale_grid::grid_fz, scale_land_grid::grid_lcdz, scale_land_grid::grid_lcz, scale_land_grid::grid_lfz, scale_urban_grid::grid_ucdz, scale_urban_grid::grid_ucz, scale_urban_grid::grid_ufz, scale_stdio::h_institute, scale_stdio::h_source, gtool_history::historyinit(), scale_grid_index::ia, scale_grid_index::iag, scale_grid_index::iagb, scale_grid_index::ie, scale_grid_index::ieb, scale_grid_index::imax, scale_grid_index::imaxb, scale_grid_index::imaxg, scale_interpolation::interp_setup_pres(), scale_stdio::io_aggregate, scale_stdio::io_fid_conf, scale_stdio::io_fid_log, scale_stdio::io_fid_nml, scale_stdio::io_l, scale_stdio::io_nml, scale_grid_index::is, scale_grid_index::isb, scale_grid_index::isgb, scale_grid_index::ja, scale_grid_index::jag, scale_grid_index::jagb, scale_grid_index::je, scale_grid_index::jeb, scale_grid_index::jmax, scale_grid_index::jmaxb, scale_grid_index::jmaxg, scale_grid_index::js, scale_grid_index::jsb, scale_grid_index::jsgb, scale_grid_index::ka, scale_grid_index::ke, scale_grid_index::kmax, scale_grid_index::ks, scale_landuse::landuse_frac_land, scale_land_grid_index::lke, scale_land_grid_index::lkmax, scale_land_grid_index::lks, scale_rm_process::prc_2drank, scale_process::prc_masterrank, scale_process::prc_mpistop(), scale_process::prc_myrank, scale_rm_process::prc_num_x, scale_rm_process::prc_num_y, scale_prof::prof_rapend(), scale_prof::prof_rapstart(), scale_grid_real::real_cz, scale_grid_real::real_fz, scale_grid_real::real_lat, scale_grid_real::real_latx, scale_grid_real::real_latxy, scale_grid_real::real_laty, scale_grid_real::real_lon, scale_grid_real::real_lonx, scale_grid_real::real_lonxy, scale_grid_real::real_lony, scale_time::time_dtsec, scale_time::time_nowdate, scale_time::time_nowms, scale_time::time_startdaysec, scale_topography::topo_zsfc, scale_urban_grid_index::uke, scale_urban_grid_index::ukmax, and scale_urban_grid_index::uks.

Referenced by mod_rm_driver::scalerm(), and mod_rm_prep::scalerm_prep().

103  use gtool_history, only: &
105  use scale_process, only: &
106  prc_mpistop, &
107  prc_masterrank, &
108  prc_myrank
109  use scale_rm_process, only: &
110  prc_2drank, &
111  prc_num_x, &
112  prc_num_y
113  use scale_time, only: &
114  time_nowdate, &
115  time_nowms, &
116  time_dtsec, &
118  use scale_interpolation, only: &
120  implicit none
121 
122  character(len=H_MID) :: HISTORY_H_TITLE = 'SCALE-RM HISTORY OUTPUT'
123  character(len=H_MID) :: HISTORY_T_SINCE
124 
125  real(RP) :: HIST_PRES(HIST_PRES_nlim) = 0.0_rp
126 
127  namelist / param_hist / &
128  hist_pres_nlayer, &
129  hist_pres, &
130  hist_bnd
131 
132  integer :: HIST_variant_limit
133 
134  real(DP) :: start_daysec
135  integer :: rankidx(2)
136  integer :: ierr
137  integer :: k
138  !---------------------------------------------------------------------------
139 
140  if( io_l ) write(io_fid_log,*)
141  if( io_l ) write(io_fid_log,*) '++++++ Module[HISTORY] / Categ[ATMOS-RM IO] / Origin[SCALElib]'
142 
143  !--- read namelist
144  rewind(io_fid_conf)
145  read(io_fid_conf,nml=param_hist,iostat=ierr)
146  if( ierr < 0 ) then !--- missing
147  if( io_l ) write(io_fid_log,*) '*** Not found namelist. Default used.'
148  elseif( ierr > 0 ) then !--- fatal error
149  write(*,*) 'xxx Not appropriate names in namelist PARAM_HIST. Check!'
150  call prc_mpistop
151  endif
152  if( io_nml ) write(io_fid_nml,nml=param_hist)
153 
154  ! check pressure coordinate
155  if ( hist_pres_nlayer > 0 ) then
156  if ( hist_pres_nlayer > 100 ) then
157  write(*,*) 'xxx number of layers of pressure is larger the KMAX'
158  call prc_mpistop
159  end if
160 
161  do k = 1, hist_pres_nlayer
162  if ( hist_pres(k) <= 0.0_rp ) then
163  write(*,*) 'xxx Invalid value found in pressure coordinate! (k,value)=', k, hist_pres(k)
164  call prc_mpistop
165  elseif ( hist_pres(k+1) >= hist_pres(k) ) then
166  write(*,*) 'xxx The value of pressure coordinate must be descending order! ', &
167  '(k,value[k],value[k+1])=', k, hist_pres(k), hist_pres(k+1)
168  call prc_mpistop
169  endif
170  enddo
171  else
172  if( io_l ) write(io_fid_log,*)
173  if( io_l ) write(io_fid_log,*) '*** HIST_PRES_nlayer is not set.'
174  if( io_l ) write(io_fid_log,*) '*** Output with pressure coordinate is disabled'
175  endif
176 
177  call prof_rapstart('FILE_O_NetCDF', 2)
178 
179  rankidx(1) = prc_2drank(prc_myrank,1)
180  rankidx(2) = prc_2drank(prc_myrank,2)
181 
182  start_daysec = time_startdaysec
183  if ( time_nowdate(1) > 0 ) then
184  write(history_t_since,'(I4.4,5(A1,I2.2))') time_nowdate(1), &
185  '-', time_nowdate(2), &
186  '-', time_nowdate(3), &
187  ' ', time_nowdate(4), &
188  ':', time_nowdate(5), &
189  ':', time_nowdate(6)
190  start_daysec = time_nowms
191  else
192  history_t_since = ''
193  endif
194 
195  if ( hist_bnd ) then
196  im = imaxb
197  jm = jmaxb
198  ims = isb
199  ime = ieb
200  jms = jsb
201  jme = jeb
202  else
203  im = imax
204  jm = jmax
205  ims = is
206  ime = ie
207  jms = js
208  jme = je
209  end if
210 
211  km = max( lkmax, ukmax, kmax )
212 
213  call historyinit( hist_item_limit, & ! [OUT]
214  hist_variant_limit, & ! [OUT]
215  im, jm, km, & ! [IN]
216  prc_masterrank, & ! [IN]
217  prc_myrank, & ! [IN]
218  rankidx(:), & ! [IN]
219  history_h_title, & ! [IN]
220  h_source, & ! [IN]
221  h_institute, & ! [IN]
222  time_start = start_daysec, & ! [IN]
223  time_interval = time_dtsec, & ! [IN]
224  time_since = history_t_since, & ! [IN]
225  default_zcoord = 'model', & ! [IN]
226  namelist_fid = io_fid_conf ) ! [IN]
227 
228  hist_item_count = 0
229  if ( hist_item_limit > 0 ) then
230  allocate( hist_item(hist_item_limit) )
231  allocate( hist_variant(hist_item_limit) )
232  allocate( hist_zcoord(hist_item_limit,hist_variant_limit) )
233  hist_item(:) = ''
234  hist_variant(:) = 0
235  hist_zcoord(:,:) = 0
236  endif
237 
238  if ( hist_pres_nlayer > 0 ) then
239  allocate( hist_pres_val(hist_pres_nlayer) )
240 
241  do k = 1, hist_pres_nlayer
242  hist_pres_val(k) = hist_pres(k) * 100.0_rp ! [hPa->Pa]
243  enddo
244 
245  call interp_setup_pres( hist_pres_nlayer ) ! [IN]
246  endif
247 
248  call hist_put_axes
249 
250  enabled = .true.
251 
252  call prof_rapend ('FILE_O_NetCDF', 2)
253 
254  return
integer, public prc_num_x
x length of 2D processor topology
subroutine, public prc_mpistop
Abort MPI.
real(dp), public time_nowms
subsecond part of current time [millisec]
Definition: scale_time.F90:66
real(dp), public time_startdaysec
second of start time [sec]
Definition: scale_time.F90:74
module Gtool_History
integer, public prc_num_y
y length of 2D processor topology
real(dp), public time_dtsec
time interval of model [sec]
Definition: scale_time.F90:36
subroutine, public interp_setup_pres(Kpres)
Reset random seed.
module TIME
Definition: scale_time.F90:15
module PROCESS
integer, parameter, public prc_masterrank
master process in each communicator
integer, public prc_myrank
process num in local communicator
module RM PROCESS
integer, dimension(:,:), allocatable, public prc_2drank
node index in 2D topology
integer, dimension(6), public time_nowdate
current time [YYYY MM DD HH MM SS]
Definition: scale_time.F90:65
integer, public io_fid_conf
Config file ID.
Definition: scale_stdio.F90:55
subroutine, public historyinit(item_count, variant_count, isize, jsize, ksize, master, myrank, rankidx, title, source, institution, time_start, time_interval, time_units, time_since, default_basename, default_zcoord, default_tinterval, default_tunit, default_taverage, default_datatype, namelist_filename, namelist_fid)
module INTERPOLATION
Here is the call graph for this function:
Here is the caller graph for this function:

◆ hist_switch()

subroutine, public scale_history::hist_switch ( logical, intent(in)  switch)

set switch

Definition at line 673 of file scale_history.F90.

673  implicit none
674 
675  logical, intent(in) :: switch
676  !---------------------------------------------------------------------------
677 
678  enabled = switch
679 
680  return

◆ hist_setpres()

subroutine, public scale_history::hist_setpres ( real(rp), dimension (ka,ia,ja), intent(in)  PRES,
real(rp), dimension( ia,ja), intent(in)  SFC_PRES 
)

set interpolation factor for pressure coordinate

Definition at line 688 of file scale_history.F90.

References scale_interpolation::interp_update_pres().

Referenced by mod_atmos_vars::atmos_vars_history_setpres().

688  use scale_interpolation, only: &
690  implicit none
691 
692  real(RP), intent(in) :: PRES (KA,IA,JA) ! pressure in Xi coordinate [Pa]
693  real(RP), intent(in) :: SFC_PRES( IA,JA) ! surface pressure [Pa]
694  !---------------------------------------------------------------------------
695 
696  if ( hist_pres_nlayer > 0 ) then
697  call interp_update_pres( hist_pres_nlayer, & ! [IN]
698  pres(:,:,:), & ! [IN]
699  sfc_pres(:,:) , & ! [IN]
700  hist_pres_val(:) ) ! [IN]
701  endif
702 
703  return
subroutine, public interp_update_pres(Kpres, PRES, SFC_PRES, Paxis)
module INTERPOLATION
Here is the call graph for this function:
Here is the caller graph for this function:

◆ hist_reg()

subroutine, public scale_history::hist_reg ( integer, intent(out)  itemid,
character(len=*), intent(in)  item,
character(len=*), intent(in)  desc,
character(len=*), intent(in)  unit,
integer, intent(in)  ndim,
character(len=*), intent(in), optional  xdim,
character(len=*), intent(in), optional  ydim,
character(len=*), intent(in), optional  zdim 
)

Register/Append variable to history file.

Parameters
[out]itemidindex number of the item
[in]itemname of the item
[in]descdescription of the item
[in]unitunit of the item
[in]ndimdimension of the item

Definition at line 717 of file scale_history.F90.

References scale_stdio::h_short, gtool_history::historyaddvariable(), gtool_history::historycheck(), scale_grid_index::imax, scale_grid_index::imaxb, scale_stdio::io_aggregate, scale_grid_index::isgb, scale_grid_index::jmax, scale_grid_index::jmaxb, scale_grid_index::jsgb, scale_grid_index::kmax, scale_land_grid_index::lkmax, scale_rm_process::prc_2drank, scale_process::prc_local_comm_world, scale_process::prc_mpistop(), scale_process::prc_myrank, scale_rm_process::prc_num_x, scale_rm_process::prc_num_y, scale_prof::prof_rapend(), scale_prof::prof_rapstart(), scale_time::time_nowstep, and scale_urban_grid_index::ukmax.

Referenced by mod_atmos_vars::atmos_vars_setup(), and hist_in_0d().

717  use mpi, only: &
718  mpi_comm_null
719  use gtool_history, only: &
722  use scale_time, only: &
723  nowstep => time_nowstep
724  use scale_process, only: &
725  prc_mpistop, &
726  prc_myrank, &
728  use scale_rm_process, only: &
729  prc_2drank, &
730  prc_num_x, &
731  prc_num_y
732  implicit none
733 
734  integer, intent(out) :: itemid
735  character(len=*), intent(in) :: item
736  character(len=*), intent(in) :: desc
737  character(len=*), intent(in) :: unit
738  integer, intent(in) :: ndim
739  character(len=*), intent(in), optional :: xdim
740  character(len=*), intent(in), optional :: ydim
741  character(len=*), intent(in), optional :: zdim
742 
743  logical :: flag_half_x
744  logical :: flag_half_y
745  logical :: flag_half_z
746 
747  character(len=H_SHORT) :: dims(3)
748 
749  integer :: nvariant1, nvariant2, nvariant3
750  integer :: v, id
751  logical :: atom
752 
753  integer :: rankidx(2)
754  integer :: start(4), count(4)
755  integer :: comm
756  !---------------------------------------------------------------------------
757 
758  itemid = -1
759 
760  if( .NOT. enabled ) return
761 
762  if( hist_item_limit == 0 ) return
763 
764  do id = 1, hist_item_count
765  if ( item == hist_item(id) ) then ! item exists
766  itemid = id
767  return
768  endif
769  enddo
770 
771  call prof_rapstart('FILE_O_NetCDF', 2)
772 
773  ! Try to add new item
774 
775  if ( len_trim(item) >= h_short ) then
776  write(*,'(1x,A,I2,A,A)') 'xxx Length of history name should be <= ', h_short-1 ,' chars. STOP', trim(item)
777  call prc_mpistop
778  endif
779 
780  atom = .true.
781 
782  rankidx(1) = prc_2drank(prc_myrank,1)
783  rankidx(2) = prc_2drank(prc_myrank,2)
784 
785  start = 0
786  count = 0
787 
788  if ( ndim == 1 ) then
789 
790  ! check half/full level for vertical
791  dims(1) = "z"
792  if ( present(zdim) ) then
793  if ( zdim == 'half' ) then
794  dims(1) = "zh"
795  endif
796  endif
797 
798  ! for shared-file parallel I/O, only rank 0 writes variables with only Z dimension
799  start(1) = 1
800  count(1) = kmax
801  if ( prc_myrank .GT. 0 ) count(1) = 0
802 
803  elseif ( ndim == 2 ) then
804 
805  ! check half/full level for horizontal
806  flag_half_x = .false.
807  if ( present(xdim) ) then
808  if( xdim == 'half' ) flag_half_x = .true.
809  endif
810 
811  flag_half_y = .false.
812  if ( present(ydim) ) then
813  if( ydim == 'half' ) flag_half_y = .true.
814  endif
815 
816  if ( flag_half_x .AND. flag_half_y ) then
817  dims(1) = 'lon_uv'
818  dims(2) = 'lat_uv'
819  elseif( flag_half_x ) then
820  dims(1) = 'lon_uy'
821  dims(2) = 'lat_uy'
822  elseif( flag_half_y ) then
823  dims(1) = 'lon_xv'
824  dims(2) = 'lat_xv'
825  else
826  dims(1) = 'lon'
827  dims(2) = 'lat'
828  endif
829 
830  elseif ( ndim == 3 ) then
831 
832  ! check half/full level for vertical/horizontal
833  flag_half_x = .false.
834 
835  if ( present(xdim) ) then
836  if( xdim == 'half' ) flag_half_x = .true.
837  endif
838 
839  flag_half_y = .false.
840  if ( present(ydim) ) then
841  if( ydim == 'half' ) flag_half_y = .true.
842  endif
843 
844  flag_half_z = .false.
845  if ( present(zdim) ) then
846  if( zdim == 'half' ) flag_half_z = .true.
847  endif
848 
849  if ( flag_half_x .AND. flag_half_y ) then
850  dims(1) = 'lon_uv'
851  dims(2) = 'lat_uv'
852  if ( flag_half_z ) then
853  dims(3) = 'height_uvw'
854  else
855  dims(3) = 'height_uvz'
856  endif
857  elseif( flag_half_x ) then
858  dims(1) = 'lon_uy'
859  dims(2) = 'lat_uy'
860  if ( flag_half_z ) then
861  dims(3) = 'height_uyw'
862  else
863  dims(3) = 'height_uyz'
864  endif
865  elseif( flag_half_y ) then
866  dims(1) = 'lon_xv'
867  dims(2) = 'lat_xv'
868  if ( flag_half_z ) then
869  dims(3) = 'height_xvw'
870  else
871  dims(3) = 'height_xvz'
872  endif
873  else
874  dims(1) = 'lon'
875  dims(2) = 'lat'
876  if ( flag_half_z ) then
877  dims(3) = 'height_xyw'
878  else
879  dims(3) = 'height'
880  endif
881  endif
882 
883  ! start and count will be used by PnetCDF I/O
884  start(3) = 1
885  count(3) = kmax
886 
887  if ( present(zdim) ) then
888  if ( zdim == 'land' ) then
889  dims(3) = 'lz'
890  count(3) = lkmax
891  atom = .false.
892  elseif( zdim == 'landhalf' ) then
893  dims(3) = 'lzh'
894  count(3) = lkmax
895  atom = .false.
896  elseif( zdim == 'urban' ) then
897  dims(3) = 'uz'
898  count(3) = ukmax
899  atom = .false.
900  elseif( zdim == 'urbanhalf' ) then
901  dims(3) = 'uzh'
902  count(3) = ukmax
903  atom = .false.
904  endif
905 
906  endif
907 
908  endif
909 
910  if ( ndim >= 2 ) then
911  ! start and count will be used by PnetCDF I/O
912  if ( hist_bnd ) then
913  start(1) = isgb
914  start(2) = jsgb
915  count(1) = imaxb
916  count(2) = jmaxb
917  else
918  ! for the case the shared-file contains no halos
919  start(1) = 1 + prc_2drank(prc_myrank,1) * imax ! no IHALO
920  start(2) = 1 + prc_2drank(prc_myrank,2) * jmax ! no JHALO
921  count(1) = imax
922  count(2) = jmax
923  end if
924  end if
925 
926 
927  if ( io_aggregate ) then ! user input parameter indicates to do PnetCDF I/O
928  comm = prc_local_comm_world
929  else
930  comm = mpi_comm_null
931  end if
932 
933  if ( atom ) then
934 
935  ! model coordinate (terrain following coordinate)
936  call historyaddvariable( nvariant1, & ! [OUT]
937  item, & ! [IN]
938  dims(1:ndim), & ! [IN]
939  desc, & ! [IN]
940  unit, & ! [IN]
941  nowstep, & ! [IN]
942  'model', & ! [IN]
943  start=start, & ! [IN]
944  count=count, & ! [IN]
945  comm=comm ) ! [IN]
946 
947  ! absolute height coordinate
948  dims(3) = 'z'
949  call historyaddvariable( nvariant2, & ! [OUT]
950  item, & ! [IN]
951  dims(1:ndim), & ! [IN]
952  desc, & ! [IN]
953  unit, & ! [IN]
954  nowstep, & ! [IN]
955  'z', & ! [IN]
956  start=start, & ! [IN]
957  count=count, & ! [IN]
958  comm=comm ) ! [IN]
959 
960  ! pressure coordinate
961  if ( hist_pres_nlayer > 0 ) then
962 
963  dims(3) = 'pressure'
964  call historyaddvariable( nvariant3, & ! [OUT]
965  item, & ! [IN]
966  dims(1:ndim), & ! [IN]
967  desc, & ! [IN]
968  unit, & ! [IN]
969  nowstep, & ! [IN]
970  'pressure', & ! [IN]
971  start=start, & ! [IN]
972  count=count, & ! [IN]
973  comm=comm ) ! [IN]
974 
975  else
976  nvariant3 = 0
977  endif
978 
979  else
980 
981  call historyaddvariable( nvariant1, & ! [OUT]
982  item, & ! [IN]
983  dims(1:ndim), & ! [IN]
984  desc, & ! [IN]
985  unit, & ! [IN]
986  nowstep, & ! [IN]
987  start=start, & ! [IN]
988  count=count, & ! [IN]
989  comm=comm ) ! [IN]
990 
991  nvariant2 = 0
992  nvariant3 = 0
993  endif
994 
995  if ( nvariant1 + nvariant2 + nvariant3 > 0 ) then
996  hist_item_count = hist_item_count + 1
997  itemid = hist_item_count
998  hist_item(itemid) = item
999 
1000  do v = 1, nvariant1
1001  hist_variant(itemid) = hist_variant(itemid) + 1
1002  hist_zcoord(itemid,hist_variant(itemid)) = i_model
1003  enddo
1004 
1005  do v = 1, nvariant2
1006  hist_variant(itemid) = hist_variant(itemid) + 1
1007  hist_zcoord(itemid,hist_variant(itemid)) = i_z
1008  enddo
1009 
1010  do v = 1, nvariant3
1011  hist_variant(itemid) = hist_variant(itemid) + 1
1012  hist_zcoord(itemid,hist_variant(itemid)) = i_pres
1013  enddo
1014  endif
1015 
1016  call prof_rapend ('FILE_O_NetCDF', 2)
1017 
1018  return
integer, public time_nowstep
current step [number]
Definition: scale_time.F90:70
integer, public prc_num_x
x length of 2D processor topology
integer, public prc_local_comm_world
local communicator
subroutine, public prc_mpistop
Abort MPI.
subroutine, public historyaddvariable(nregist, item, dims, desc, units, now_step, zcoord, options, start, count, comm)
subroutine, public historycheck(existed, item, zcoord)
module Gtool_History
integer, public prc_num_y
y length of 2D processor topology
module TIME
Definition: scale_time.F90:15
module PROCESS
integer, public prc_myrank
process num in local communicator
module RM PROCESS
integer, dimension(:,:), allocatable, public prc_2drank
node index in 2D topology
Here is the call graph for this function:
Here is the caller graph for this function:

◆ hist_query()

subroutine, public scale_history::hist_query ( integer, intent(in)  itemid,
logical, intent(out)  answer 
)

Check time to putting data.

Parameters
[in]itemidname of the item
[out]answeris it time to store?

Definition at line 1026 of file scale_history.F90.

References gtool_history::historyquery(), scale_prof::prof_rapend(), scale_prof::prof_rapstart(), and scale_time::time_nowstep.

Referenced by hist_in_0d().

1026  use gtool_history, only: &
1027  historyquery
1028  use scale_time, only: &
1029  time_nowstep
1030  implicit none
1031 
1032  integer, intent(in) :: itemid
1033  logical, intent(out) :: answer
1034  !---------------------------------------------------------------------------
1035 
1036  answer = .false.
1037 
1038  if( .NOT. enabled ) return
1039 
1040  if( itemid < 0 ) return
1041 
1042  call prof_rapstart('FILE_O_NetCDF', 2)
1043 
1044  call historyquery( hist_item(itemid), & ! [IN]
1045  time_nowstep, & ! [IN]
1046  answer ) ! [OUT]
1047 
1048  call prof_rapend ('FILE_O_NetCDF', 2)
1049 
1050  return
integer, public time_nowstep
current step [number]
Definition: scale_time.F90:70
module Gtool_History
module TIME
Definition: scale_time.F90:15
subroutine, public historyquery(item, step_now, answer)
Here is the call graph for this function:
Here is the caller graph for this function:

◆ hist_put_0d()

subroutine scale_history::hist_put_0d ( integer, intent(in)  itemid,
real(rp), intent(in)  var 
)

Put 1D data to history buffer.

Parameters
[in]itemidname of the item
[in]varvalue

Definition at line 1058 of file scale_history.F90.

References scale_prof::prof_rapend(), scale_prof::prof_rapstart(), and scale_time::time_nowstep.

1058  use gtool_history, only: &
1059  historyput
1060  use scale_time, only: &
1061  time_nowstep
1062  implicit none
1063 
1064  integer, intent(in) :: itemid
1065  real(RP), intent(in) :: var
1066 
1067  integer :: n, v, id
1068  !---------------------------------------------------------------------------
1069 
1070  if( .NOT. enabled ) return
1071 
1072  if( itemid < 0 ) return
1073 
1074  call prof_rapstart('FILE_O_NetCDF', 2)
1075 
1076  id = 0
1077  do n = 1, itemid-1
1078  id = id + hist_variant(n)
1079  enddo
1080 
1081  do v = 1, hist_variant(itemid)
1082  id = id + 1
1083 
1084  call historyput( id, & ! [IN]
1085  time_nowstep, & ! [IN]
1086  var ) ! [IN]
1087  enddo
1088 
1089  call prof_rapend ('FILE_O_NetCDF', 2)
1090 
1091  return
integer, public time_nowstep
current step [number]
Definition: scale_time.F90:70
module Gtool_History
module TIME
Definition: scale_time.F90:15
Here is the call graph for this function:

◆ hist_put_1d()

subroutine scale_history::hist_put_1d ( integer, intent(in)  itemid,
real(rp), dimension(:), intent(in)  var 
)

Put 1D data to history buffer.

Parameters
[in]itemidname of the item
[in]varvalue

Definition at line 1099 of file scale_history.F90.

References scale_grid_index::ks, scale_prof::prof_rapend(), scale_prof::prof_rapstart(), and scale_time::time_nowstep.

1099  use gtool_history, only: &
1100  historyput
1101  use scale_time, only: &
1102  time_nowstep
1103  implicit none
1104 
1105  integer, intent(in) :: itemid
1106  real(RP), intent(in) :: var(:)
1107 
1108  real(RP) :: var_trim(KMAX)
1109 
1110  integer :: n, v, id
1111  integer :: k
1112  !---------------------------------------------------------------------------
1113 
1114  if( .NOT. enabled ) return
1115 
1116  if( itemid < 0 ) return
1117 
1118  call prof_rapstart('FILE_O_NetCDF', 2)
1119 
1120  do k = 1, kmax
1121  var_trim(k) = var(ks+k-1)
1122  enddo
1123 
1124  id = 0
1125  do n = 1, itemid-1
1126  id = id + hist_variant(n)
1127  enddo
1128 
1129  do v = 1, hist_variant(itemid)
1130  id = id + 1
1131 
1132  call historyput( id, & ! [IN]
1133  time_nowstep, & ! [IN]
1134  var_trim(:) ) ! [IN]
1135  enddo
1136 
1137  call prof_rapend ('FILE_O_NetCDF', 2)
1138 
1139  return
integer, public time_nowstep
current step [number]
Definition: scale_time.F90:70
module Gtool_History
module TIME
Definition: scale_time.F90:15
Here is the call graph for this function:

◆ hist_put_2d()

subroutine scale_history::hist_put_2d ( integer, intent(in)  itemid,
real(rp), dimension(:,:), intent(in)  var,
logical, intent(in), optional  nohalo 
)

Put 2D data to history buffer.

Parameters
[in]itemidname of the item
[in]varvalue

Definition at line 1148 of file scale_history.F90.

References scale_grid_index::ie, scale_grid_index::is, scale_grid_index::je, scale_grid_index::js, scale_prof::prof_rapend(), scale_prof::prof_rapstart(), gtool_file::rmiss, and scale_time::time_nowstep.

1148  use gtool_file, only: &
1149  rmiss
1150  use gtool_history, only: &
1151  historyput
1152  use scale_time, only: &
1153  time_nowstep
1154  implicit none
1155 
1156  integer, intent(in) :: itemid
1157  real(RP), intent(in) :: var(:,:)
1158  logical, intent(in), optional :: nohalo
1159 
1160  real(RP) :: var_trim(im*jm)
1161  logical :: nohalo_
1162 
1163  integer :: n, v, id
1164  integer :: i, j
1165  !---------------------------------------------------------------------------
1166 
1167  if( .NOT. enabled ) return
1168 
1169  if( itemid < 0 ) return
1170 
1171  call prof_rapstart('FILE_O_NetCDF', 2)
1172 
1173  do j = 1, jm
1174  do i = 1, im
1175  var_trim((j-1)*im+i) = var(ims+i-1,jms+j-1)
1176  enddo
1177  enddo
1178 
1179  nohalo_ = .false.
1180  if( present(nohalo) ) nohalo_ = nohalo
1181 
1182  if ( nohalo_ ) then
1183  ! W halo
1184  do j = 1, jm
1185  do i = 1, is-ims
1186  var_trim((j-1)*im+i) = rmiss
1187  enddo
1188  enddo
1189  ! E halo
1190  do j = 1, jm
1191  do i = ie-ims+2, ime-ims+1
1192  var_trim((j-1)*im+i) = rmiss
1193  enddo
1194  enddo
1195  ! S halo
1196  do j = 1, js-jms
1197  do i = 1, im
1198  var_trim((j-1)*im+i) = rmiss
1199  enddo
1200  enddo
1201  ! N halo
1202  do j = je-jms+2, jme-jms+1
1203  do i = 1, im
1204  var_trim((j-1)*im+i) = rmiss
1205  enddo
1206  enddo
1207  endif
1208 
1209  id = 0
1210  do n = 1, itemid-1
1211  id = id + hist_variant(n)
1212  enddo
1213 
1214  do v = 1, hist_variant(itemid)
1215  id = id + 1
1216 
1217  call historyput( id, & ! [IN]
1218  time_nowstep, & ! [IN]
1219  var_trim(:) ) ! [IN]
1220  enddo
1221 
1222  call prof_rapend ('FILE_O_NetCDF', 2)
1223 
1224  return
integer, public time_nowstep
current step [number]
Definition: scale_time.F90:70
module GTOOL_FILE
Definition: gtool_file.f90:17
real(dp), parameter, public rmiss
Definition: gtool_file.f90:150
module Gtool_History
module TIME
Definition: scale_time.F90:15
Here is the call graph for this function:

◆ hist_put_3d()

subroutine scale_history::hist_put_3d ( integer, intent(in)  itemid,
real(rp), dimension(:,:,:), intent(in)  var,
character(len=*), intent(in), optional  xdim,
character(len=*), intent(in), optional  ydim,
character(len=*), intent(in), optional  zdim,
logical, intent(in), optional  nohalo 
)

Put 3D data to history buffer.

Parameters
[in]itemidname of the item
[in]varvalue

Definition at line 1236 of file scale_history.F90.

References scale_grid_index::ie, scale_interpolation::interp_available, scale_interpolation::interp_vertical_xi2p(), scale_interpolation::interp_vertical_xi2z(), scale_grid_index::is, scale_grid_index::je, scale_grid_index::js, scale_grid_index::kmax, scale_grid_index::ks, scale_land_grid_index::lkmax, scale_land_grid_index::lks, scale_prof::prof_rapend(), scale_prof::prof_rapstart(), gtool_file::rmiss, scale_time::time_nowstep, scale_urban_grid_index::ukmax, and scale_urban_grid_index::uks.

1236  use gtool_file, only: &
1237  rmiss
1238  use gtool_history, only: &
1239  historyput
1240  use scale_time, only: &
1241  time_nowstep
1242  use scale_interpolation, only: &
1246  implicit none
1247 
1248  integer, intent(in) :: itemid
1249  real(RP), intent(in) :: var(:,:,:)
1250  character(len=*), intent(in), optional :: xdim
1251  character(len=*), intent(in), optional :: ydim
1252  character(len=*), intent(in), optional :: zdim
1253  logical, intent(in), optional :: nohalo
1254 
1255  character(len=H_SHORT) :: xd, yd, zd
1256  integer :: isize, jsize, ksize
1257  integer :: istart, jstart, kstart
1258 
1259  real(RP) :: var_Z(KA ,IA,JA)
1260  real(RP) :: var_P(HIST_PRES_nlayer,IA,JA)
1261 
1262  real(RP) :: var_trim(km*im*jm)
1263  logical :: nohalo_
1264  integer :: s(3)
1265 
1266  integer :: n, v, id
1267  integer :: i, j, k
1268 
1269  intrinsic shape
1270  !---------------------------------------------------------------------------
1271 
1272  if( .NOT. enabled ) return
1273 
1274  if( itemid < 0 ) return
1275 
1276  call prof_rapstart('FILE_O_NetCDF', 2)
1277 
1278  xd = ''
1279  yd = ''
1280  zd = ''
1281  if( present(xdim) ) xd = xdim
1282  if( present(ydim) ) yd = ydim
1283  if( present(zdim) ) zd = zdim
1284 
1285  nohalo_ = .false.
1286  if( present(nohalo) ) nohalo_ = nohalo
1287 
1288  ! select dimension
1289  select case( xd )
1290  case('half')
1291  isize = im
1292  istart = ims
1293  case default
1294  isize = im
1295  istart = ims
1296  end select
1297 
1298  select case( yd )
1299  case('half')
1300  jsize = jm
1301  jstart = jms
1302  case default
1303  jsize = jm
1304  jstart = jms
1305  end select
1306 
1307  select case( zd )
1308  case('land')
1309  ksize = lkmax
1310  kstart = lks
1311  case('landhalf')
1312  ksize = lkmax
1313  kstart = lks
1314  case('urban')
1315  ksize = ukmax
1316  kstart = uks
1317  case('urbanhalf')
1318  ksize = ukmax
1319  kstart = uks
1320  case('half')
1321  ksize = kmax
1322  kstart = ks
1323  case default
1324  ksize = kmax
1325  kstart = ks
1326  end select
1327 
1328  s(:) = shape(var)
1329 
1330  id = 0
1331  do n = 1, itemid-1
1332  id = id + hist_variant(n)
1333  enddo
1334 
1335  do v = 1, hist_variant(itemid)
1336 
1337  if ( s(1) == ka &
1338  .AND. ksize == kmax &
1339  .AND. hist_zcoord(itemid,v) == i_z &
1340  .AND. interp_available ) then ! z*->z interpolation
1341 
1342  call prof_rapstart('FILE_O_interp', 2)
1343  call interp_vertical_xi2z( var(:,:,:), & ! [IN]
1344  var_z(:,:,:) ) ! [OUT]
1345  call prof_rapend ('FILE_O_interp', 2)
1346 
1347  do k = 1, ksize
1348  do j = 1, jsize
1349  do i = 1, isize
1350  var_trim((k-1)*jsize*isize+(j-1)*isize+i) = var_z(kstart+k-1,istart+i-1,jstart+j-1)
1351  enddo
1352  enddo
1353  enddo
1354 
1355  elseif( s(1) == ka &
1356  .AND. ksize == kmax &
1357  .AND. hist_zcoord(itemid,v) == i_pres ) then ! z*->p interpolation
1358 
1359  ksize = hist_pres_nlayer
1360 
1361  call prof_rapstart('FILE_O_interp', 2)
1362  call interp_vertical_xi2p( hist_pres_nlayer, & ! [IN]
1363  var(:,:,:), & ! [IN]
1364  var_p(:,:,:) ) ! [OUT]
1365  call prof_rapend ('FILE_O_interp', 2)
1366 
1367  do k = 1, ksize
1368  do j = 1, jsize
1369  do i = 1, isize
1370  var_trim((k-1)*jsize*isize+(j-1)*isize+i) = var_p(k,istart+i-1,jstart+j-1)
1371  enddo
1372  enddo
1373  enddo
1374 
1375  else ! no interpolation
1376 
1377  do k = 1, ksize
1378  do j = 1, jsize
1379  do i = 1, isize
1380  var_trim((k-1)*jsize*isize+(j-1)*isize+i) = var(kstart+k-1,istart+i-1,jstart+j-1)
1381  enddo
1382  enddo
1383  enddo
1384 
1385  endif
1386 
1387  if ( nohalo_ ) then
1388  ! W halo
1389  do k = 1, ksize
1390  do j = 1, jsize
1391  do i = 1, is-istart
1392  var_trim((k-1)*jsize*isize+(j-1)*isize+i) = rmiss
1393  enddo
1394  enddo
1395  enddo
1396  ! E halo
1397  do k = 1, ksize
1398  do j = 1, jsize
1399  do i = ie-istart+2, ime-istart+1
1400  var_trim((k-1)*jsize*isize+(j-1)*isize+i) = rmiss
1401  enddo
1402  enddo
1403  enddo
1404  ! S halo
1405  do k = 1, ksize
1406  do j = 1, js-jstart
1407  do i = 1, isize
1408  var_trim((k-1)*jsize*isize+(j-1)*isize+i) = rmiss
1409  enddo
1410  enddo
1411  enddo
1412  ! N halo
1413  do k = 1, ksize
1414  do j = je-jstart+2, jme-jstart+1
1415  do i = 1, isize
1416  var_trim((k-1)*jsize*isize+(j-1)*isize+i) = rmiss
1417  enddo
1418  enddo
1419  enddo
1420  endif
1421 
1422  id = id + 1
1423 
1424  call historyput( id, & ! [IN]
1425  time_nowstep, & ! [IN]
1426  var_trim(1:isize*jsize*ksize) ) ! [IN]
1427  enddo
1428 
1429  call prof_rapend ('FILE_O_NetCDF', 2)
1430 
1431  return
integer, public time_nowstep
current step [number]
Definition: scale_time.F90:70
module GTOOL_FILE
Definition: gtool_file.f90:17
subroutine, public interp_vertical_xi2p(Kpres, var, var_P)
real(dp), parameter, public rmiss
Definition: gtool_file.f90:150
subroutine, public interp_vertical_xi2z(var, var_Z)
module Gtool_History
module TIME
Definition: scale_time.F90:15
logical, public interp_available
topography exists & vertical interpolation has meaning?
module INTERPOLATION
Here is the call graph for this function:

◆ hist_in_0d()

subroutine scale_history::hist_in_0d ( real(rp), intent(in)  var,
character(len=*), intent(in)  item,
character(len=*), intent(in)  desc,
character(len=*), intent(in)  unit 
)

Wrapper routine of HIST_reg+HIST_put 0D.

Definition at line 1441 of file scale_history.F90.

References hist_query(), hist_reg(), scale_prof::prof_rapend(), and scale_prof::prof_rapstart().

1441  implicit none
1442 
1443  real(RP), intent(in) :: var
1444  character(len=*), intent(in) :: item
1445  character(len=*), intent(in) :: desc
1446  character(len=*), intent(in) :: unit
1447 
1448  integer :: itemid
1449  logical :: do_put
1450  !---------------------------------------------------------------------------
1451 
1452  if( .NOT. enabled ) return
1453 
1454  ! Check whether the item has been already registered
1455  call hist_reg ( itemid, & ! [OUT]
1456  item, & ! [IN]
1457  desc, & ! [IN]
1458  unit, & ! [IN]
1459  0 ) ! [IN]
1460 
1461  ! Check whether it is time to input the item
1462  call hist_query( itemid, & ! [IN]
1463  do_put ) ! [OUT]
1464 
1465  if ( do_put ) then
1466  call hist_put( itemid, & ! [IN]
1467  var ) ! [IN]
1468  endif
1469 
1470  return
Here is the call graph for this function:

◆ hist_get_2d()

subroutine scale_history::hist_get_2d ( real(rp), dimension(:,:), intent(out)  var,
character(len=*), intent(in)  basename,
character(len=*), intent(in)  varname,
integer, intent(in)  step,
logical, intent(in), optional  allow_missing 
)

Get 2D data from file.

Parameters
[out]varvalue
[in]basenamebasename of the file
[in]varnamename of the variable
[in]stepstep number
[in]allow_missingallow data is missing?

Definition at line 1683 of file scale_history.F90.

References scale_prof::prof_rapend(), and scale_prof::prof_rapstart().

1683  use gtool_history, only: &
1684  historyget
1685  implicit none
1686 
1687  real(RP), intent(out) :: var(:,:)
1688  character(len=*), intent(in) :: basename
1689  character(len=*), intent(in) :: varname
1690  integer, intent(in) :: step
1691  logical, intent(in), optional :: allow_missing
1692 
1693  logical :: am
1694  !---------------------------------------------------------------------------
1695 
1696  call prof_rapstart('FILE_I_NetCDF', 2)
1697 
1698  am = .false.
1699  if( present(allow_missing) ) am = allow_missing
1700 
1701  call historyget( var(:,:), & ! [OUT]
1702  basename, & ! [IN]
1703  varname, & ! [IN]
1704  step, & ! [IN]
1705  allow_missing=am ) ! [IN]
1706 
1707  call prof_rapend ('FILE_I_NetCDF', 2)
1708 
1709  return
module Gtool_History
Here is the call graph for this function:

◆ hist_get_3d()

subroutine scale_history::hist_get_3d ( real(rp), dimension(:,:,:), intent(out)  var,
character(len=*), intent(in)  basename,
character(len=*), intent(in)  varname,
integer, intent(in)  step,
logical, intent(in), optional  allow_missing 
)

Get 3D data from file.

Parameters
[out]varvalue
[in]basenamebasename of the file
[in]varnamename of the variable
[in]stepstep number
[in]allow_missingallow data is missing?

Definition at line 1720 of file scale_history.F90.

References scale_prof::prof_rapend(), and scale_prof::prof_rapstart().

1720  use gtool_history, only: &
1721  historyget
1722  implicit none
1723 
1724  real(RP), intent(out) :: var(:,:,:)
1725  character(len=*), intent(in) :: basename
1726  character(len=*), intent(in) :: varname
1727  integer, intent(in) :: step
1728  logical, intent(in), optional :: allow_missing
1729 
1730  logical :: am
1731  !---------------------------------------------------------------------------
1732 
1733  call prof_rapstart('FILE_I_NetCDF', 2)
1734 
1735  am = .false.
1736  if( present(allow_missing) ) am = allow_missing
1737 
1738  call historyget( var(:,:,:), & ! [OUT]
1739  basename, & ! [IN]
1740  varname, & ! [IN]
1741  step, & ! [IN]
1742  allow_missing=am ) ! [IN]
1743 
1744  call prof_rapend ('FILE_I_NetCDF', 2)
1745 
1746  return
module Gtool_History
Here is the call graph for this function:

◆ hist_write()

subroutine, public scale_history::hist_write ( )

Flush history buffer to file.

Definition at line 1752 of file scale_history.F90.

References gtool_history::historywriteall(), scale_prof::prof_rapend(), scale_prof::prof_rapstart(), and scale_time::time_nowstep.

Referenced by mod_rm_driver::scalerm().

1752  use gtool_history, only: &
1754  use scale_time, only: &
1755  time_nowstep
1756  implicit none
1757  !---------------------------------------------------------------------------
1758 
1759  call prof_rapstart('FILE_O_NetCDF', 2)
1760 
1761  call historywriteall( time_nowstep ) ![IN]
1762 
1763  call prof_rapend ('FILE_O_NetCDF', 2)
1764 
1765  return
integer, public time_nowstep
current step [number]
Definition: scale_time.F90:70
module Gtool_History
module TIME
Definition: scale_time.F90:15
subroutine, public historywriteall(step_now)
Here is the call graph for this function:
Here is the caller graph for this function: