15 USE stel_kinds,
only: rprec
35 CHARACTER (len=data_short_name_length) :: s_name
37 CHARACTER (len=data_name_length) :: l_name
39 CHARACTER (len=data_short_name_length) :: units
41 REAL (rprec) :: observed
43 REAL (rprec) :: observed_sigma
45 REAL (rprec) :: weight
47 REAL (rprec),
DIMENSION(4) :: modeled
49 REAL (rprec),
DIMENSION(4) :: modeled_sigma
51 INTEGER :: scale_index
53 INTEGER :: offset_index
60 & get_modeled_signal => get_modeled_signal_cache,
61 & get_modeled_signal_last
81 & get_gp => get_gp_i, get_gp_s, get_gp_x
143 & observed, sigma, weight, s_index, &
150 CHARACTER(len=*),
INTENT(in) :: s_name
151 CHARACTER(len=*),
INTENT(in) :: l_name
152 CHARACTER(len=*),
INTENT(in) :: units
153 REAL(rprec),
INTENT(in) :: observed
154 REAL(rprec),
INTENT(in) :: sigma
155 REAL(rprec),
INTENT(in) :: weight
156 INTEGER,
INTENT(in) :: s_index
157 INTEGER,
INTENT(in) :: o_index
160 REAL (rprec) :: start_time
163 start_time = profiler_get_start_time()
166 IF (sigma .eq. 0.0)
THEN
167 WRITE (*,1000) trim(s_name)
173 this%observed = observed
174 this%observed_sigma = sigma
177 this%modeled_sigma = 0.0
178 this%scale_index = s_index
179 this%offset_index = o_index
181 CALL profiler_set_stop_time(
'signal_construct_new', start_time)
183 1000
FORMAT(
'Warning: sigma for ',a,
' is zero.')
212 INTEGER,
INTENT(in) :: mdsig_iou
213 REAL(rprec),
INTENT(in) :: observed
214 REAL(rprec),
INTENT(in) :: sigma
215 REAL(rprec),
INTENT(in) :: weight
216 INTEGER,
INTENT(in) :: s_index
217 INTEGER,
INTENT(in) :: o_index
220 CHARACTER (len=data_short_name_length) :: s_name
221 CHARACTER (len=data_name_length) :: l_name
222 CHARACTER (len=data_short_name_length) :: units
223 REAL (rprec) :: start_time
226 start_time = profiler_get_start_time()
228 CALL cdf_read(mdsig_iou,
'diagnostic_desc_s_name', s_name)
229 CALL cdf_read(mdsig_iou,
'diagnostic_desc_l_name', l_name)
230 CALL cdf_read(mdsig_iou,
'diagnostic_desc_units', units)
233 & sigma, weight, s_index, o_index)
235 CALL profiler_set_stop_time(
'signal_construct_diagnostic_netcdf',
255 TYPE (signal_class),
INTENT(inout) :: this
262 this%observed_sigma = 0.0
265 this%modeled_sigma = 0.0
267 WRITE (*,*)
'Destruct'
290 & use_cache, last_value)
298 REAL (rprec),
DIMENSION(:),
INTENT(out) :: sigma
299 LOGICAL,
INTENT(in) :: use_cache
300 REAL (rprec),
DIMENSION(4),
INTENT(in) :: last_value
303 REAL (rprec) :: start_time
306 start_time = profiler_get_start_time()
308 IF (.not.use_cache)
THEN
309 this%modeled = this%get_modeled_signal(a_model,
310 & this%modeled_sigma,
314 sigma = this%modeled_sigma
317 CALL profiler_set_stop_time(
'signal_get_modeled_signal_cache',
361 REAL (rprec),
DIMENSION(4),
INTENT(out) :: sigma
362 REAL (rprec),
DIMENSION(4),
INTENT(in) :: last_value
365 REAL (rprec) :: start_time
368 CALL assert(.false.,
'get_modeled_signal_last not over written' //
369 &
' for ' // this%get_type())
397 REAL (rprec) :: start_time
400 start_time = profiler_get_start_time()
404 CALL profiler_set_stop_time(
'signal_get_observed_signal',
430 LOGICAL,
INTENT(in) :: use_cache
431 REAL (rprec),
DIMENSION(4),
INTENT(in) :: last_value
434 REAL (rprec) :: start_time
437 start_time = profiler_get_start_time()
440 signal_get_g2 = this%get_e(a_model, use_cache, last_value)**2.0
442 CALL profiler_set_stop_time(
'signal_get_g2', start_time)
459 FUNCTION signal_get_e(this, a_model, use_cache, last_value)
467 LOGICAL,
INTENT(in) :: use_cache
468 REAL (rprec),
DIMENSION(4),
INTENT(in) :: last_value
471 REAL (rprec),
DIMENSION(4) :: modeled_signal
472 REAL (rprec),
DIMENSION(4) :: modeled_sigma
473 REAL (rprec) :: observed_signal
474 REAL (rprec) :: start_time
477 start_time = profiler_get_start_time()
479 observed_signal = this%get_observed_signal(a_model)
481 modeled_signal = this%get_modeled_signal(a_model, modeled_sigma,
482 & use_cache, last_value)
488 IF (this%weight .eq. 0.0)
THEN
492 & * sqrt(this%weight/this%get_sigma2())
495 CALL profiler_set_stop_time(
'signal_get_e', start_time)
519 REAL (rprec) :: start_time
522 start_time = profiler_get_start_time()
526 & + this%modeled_sigma(1)**2.0
528 CALL profiler_set_stop_time(
'signal_get_sigma2', start_time)
564 REAL (rprec) :: start_time
567 CALL assert(.false.,
'signal_get_type not over written for ' //
596 CHARACTER (len=data_name_length),
DIMENSION(7),
INTENT(inout) ::
600 REAL (rprec) :: start_time
603 start_time = profiler_get_start_time()
606 header(4) =
'model_sig(1)'
607 header(5) =
'model_sig(2)'
608 header(6) =
'model_sig(3)'
609 header(7) =
'model_sig(4)'
611 CALL profiler_set_stop_time(
'signal_get_header', start_time)
643 INTEGER,
INTENT(in) :: i
644 INTEGER,
INTENT(in) :: flags
647 REAL (rprec) :: scale_factor
648 REAL (rprec) :: start_time
651 CALL assert(.false.,
'signal_get_gp_i not over written for ' //
686 INTEGER,
INTENT(in) :: flags
689 CALL assert(.false.,
'signal_get_gp_s not over written for ' //
722 REAL (rprec),
DIMENSION(3),
INTENT(in) :: x_cart
723 INTEGER,
INTENT(in) :: flags
726 CALL assert(.false.,
'signal_get_gp_x not over written for ' //
745 TYPE (model_class),
INTENT(in) :: a_model
746 REAL (rprec),
INTENT(inout) :: value
749 REAL (rprec) :: scale_factor
750 REAL (rprec) :: offset_factor
751 REAL (rprec) :: start_time
754 start_time = profiler_get_start_time()
760 value =
value*scale_factor + offset_factor
780 CHARACTER (len=*),
INTENT(in) :: name
781 INTEGER,
INTENT(in) :: index
784 REAL (rprec) :: start_time
787 start_time = profiler_get_start_time()
790 IF (index .lt. 10)
THEN
792 ELSE IF (index .lt. 100)
THEN
794 ELSE IF (index .lt. 1000)
THEN
800 CALL profiler_set_stop_time(
'signal_make_short_name', start_time)
825 INTEGER,
INTENT(in) :: iou
826 INTEGER,
INTENT(in) :: index
827 TYPE (model_class),
POINTER :: a_model
830 REAL (rprec),
DIMENSION(4) :: modeled_signal
831 REAL (rprec),
DIMENSION(4) :: modeled_sigma
832 REAL (rprec) :: start_time
835 REAL (rprec),
DIMENSION(4),
PARAMETER :: dummy_value = 0.0
838 start_time = profiler_get_start_time()
842 modeled_signal = this%get_modeled_signal(a_model, modeled_sigma,
843 & .true., dummy_value)
845 WRITE (iou,1000) index, this%get_type(), this%s_name,
846 & this%get_g2(a_model, .true., modeled_signal),
847 & this%weight, this%get_observed_signal(a_model),
848 & this%observed_sigma, modeled_signal,
851 CALL profiler_set_stop_time(
'signal_write', start_time)
853 1000
FORMAT(i4,2x,a23,2x,a20,12(2x,es12.5))
873 INTEGER,
INTENT(in) :: iou
876 CHARACTER (len=data_name_length),
DIMENSION(7) :: header
877 REAL (rprec) :: start_time
880 start_time = profiler_get_start_time()
882 CALL this%get_header(header)
884 WRITE (iou,1000) header
886 CALL profiler_set_stop_time(
'signal_write_header', start_time)
888 1000
FORMAT(3x,
'#',2x,
'type',21x,
's_name',16x,
'g^2',11x,
'weight',8x,
889 &
'observed',6x,
'sigma', 9x,
'model',7x,2(2x,a12),7(2x,a12))
916 INTEGER,
INTENT(in) :: iou
917 INTEGER,
INTENT(in) :: index
918 TYPE (model_class),
INTENT(in) :: a_model
921 REAL (rprec) :: start_time
924 start_time = profiler_get_start_time()
925 CALL profiler_set_stop_time(
'signals_write_auxiliary', start_time)
949 & current_step, index, &
950 & signal_model_value_id, &
951 & signal_sigma_value_id)
959 TYPE (model_class),
POINTER :: a_model
960 INTEGER,
INTENT(in) :: result_ncid
961 INTEGER,
INTENT(in) :: current_step
962 INTEGER,
INTENT(in) :: index
963 INTEGER,
INTENT(in) :: signal_model_value_id
964 INTEGER,
INTENT(in) :: signal_sigma_value_id
969 REAL (rprec),
DIMENSION(4) :: modeled_sigma
970 REAL (rprec),
DIMENSION(4) :: modeled_signal
971 REAL (rprec) :: start_time
974 REAL (rprec),
DIMENSION(4),
PARAMETER :: dummy_value = 0.0
977 start_time = profiler_get_start_time()
981 modeled_signal = this%get_modeled_signal(a_model, modeled_sigma,
982 & .true., dummy_value)
984 status = nf_put_vara_double(result_ncid, signal_model_value_id,
985 & (/ 1, index, current_step /),
986 & (/ 4, 1, 1 /), modeled_signal)
987 CALL assert_eq(status, nf_noerr, nf_strerror(status))
989 status = nf_put_var1_double(result_ncid, signal_sigma_value_id,
990 & (/ index, current_step /),
991 & sqrt(this%get_sigma2()))
992 CALL assert_eq(status, nf_noerr, nf_strerror(status))
999 SELECT CASE(this%type)
1001 CASE (signal_feedback_type)
1002 status = nf_inq_varid(result_ncid,
'signal_observed_value',
1004 CALL assert_eq(status, nf_noerr, nf_strerror(status))
1007 & nf_put_var1_double(result_ncid, varid, index,
1008 & this%get_observed_signal(a_model))
1009 CALL assert_eq(status, nf_noerr, nf_strerror(status))
1013 CALL profiler_set_stop_time(
'signal_write_step_data', start_time)
1036 INTEGER,
INTENT(in) :: index
1037 INTEGER,
INTENT(in) :: recon_comm
1039 #if defined(MPI_OPT)
1043 REAL (rprec) :: start_time
1046 start_time = profiler_get_start_time()
1048 CALL mpi_comm_rank(recon_comm, mpi_rank, error)
1050 IF (mpi_rank .eq. index)
THEN
1051 CALL mpi_ssend(this%modeled, 4, mpi_real8, 0, mpi_rank,
1052 & recon_comm, error)
1053 CALL mpi_ssend(this%modeled_sigma, 4, mpi_real8, 0, mpi_rank,
1054 & recon_comm, error)
1055 ELSE IF (mpi_rank .eq. 0)
THEN
1056 CALL mpi_recv(this%modeled, 4, mpi_real8, index, index,
1057 & recon_comm, mpi_status_ignore, error)
1058 CALL mpi_recv(this%modeled_sigma, 4, mpi_real8, index, index,
1059 & recon_comm, mpi_status_ignore, error)
1062 CALL profiler_set_stop_time(
'signal_sync_child', start_time)