V3FIT
signal.f
Go to the documentation of this file.
1 !*******************************************************************************
4 !
5 ! Note separating the Doxygen comment block here so detailed decription is
6 ! found in the Module not the file.
7 !
13 !*******************************************************************************
14  MODULE signal
15  USE stel_kinds, only: rprec
16  USE data_parameters
17  USE model
18 
19  IMPLICIT NONE
20 !*******************************************************************************
21 ! DERIVED-TYPE DECLARATIONS
22 ! 1) signal base class
23 ! 2) signal pointer type
24 !
25 !*******************************************************************************
26 !-------------------------------------------------------------------------------
32 !-------------------------------------------------------------------------------
33  TYPE :: signal_class
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
54  CONTAINS
55  PROCEDURE :: &
56  & get_modeled_signal_cache => signal_get_modeled_signal_cache
57  PROCEDURE :: &
58  & get_modeled_signal_last => signal_get_modeled_signal_last
59  generic :: &
60  & get_modeled_signal => get_modeled_signal_cache, &
61  & get_modeled_signal_last
62  PROCEDURE :: &
63  & get_observed_signal => signal_get_observed_signal
64  PROCEDURE :: &
65  & get_g2 => signal_get_g2
66  PROCEDURE :: &
67  & get_e => signal_get_e
68  PROCEDURE :: &
69  & get_sigma2 => signal_get_sigma2
70  PROCEDURE :: &
71  & get_type => signal_get_type
72  PROCEDURE :: &
73  & get_header => signal_get_header
74  PROCEDURE :: &
75  & get_gp_i => signal_get_gp_i
76  PROCEDURE :: &
77  & get_gp_s => signal_get_gp_s
78  PROCEDURE :: &
79  & get_gp_x => signal_get_gp_x
80  generic :: &
81  & get_gp => get_gp_i, get_gp_s, get_gp_x
82  PROCEDURE :: &
83  & scale_and_offset => signal_scale_and_offset
84  PROCEDURE :: &
85  & sync_child => signal_sync_child
86  PROCEDURE :: &
87  & write_header => signal_write_header
88  PROCEDURE :: write => signal_write
89  PROCEDURE :: &
90  & write_auxiliary => signals_write_auxiliary
91  PROCEDURE :: &
92  & write_step_data => signal_write_step_data
93  final :: signal_destruct
94  END TYPE signal_class
95 
96 !-------------------------------------------------------------------------------
99 !-------------------------------------------------------------------------------
100  TYPE signal_pointer
103  class(signal_class), POINTER :: p => null()
104  END TYPE
105 
106 !*******************************************************************************
107 ! INTERFACE BLOCKS
108 !*******************************************************************************
109 !-------------------------------------------------------------------------------
117 !-------------------------------------------------------------------------------
118  INTERFACE signal_construct
119  MODULE PROCEDURE signal_construct_new, &
120  & signal_construct_diagnostic_netcdf
121  END INTERFACE
122 
123  CONTAINS
124 !*******************************************************************************
125 ! CONSTRUCTION SUBROUTINES
126 !*******************************************************************************
127 !-------------------------------------------------------------------------------
141 !-------------------------------------------------------------------------------
142  SUBROUTINE signal_construct_new(this, s_name, l_name, units, &
143  & observed, sigma, weight, s_index, &
144  & o_index)
145 
146  IMPLICIT NONE
147 
148 ! Declare Arguments
149  class(signal_class), INTENT(inout) :: this
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
158 
159 ! local variables
160  REAL (rprec) :: start_time
161 
162 ! Start of executable code
163  start_time = profiler_get_start_time()
164 
165 ! Warn the user that the signal is missing a non zero sigma.
166  IF (sigma .eq. 0.0) THEN
167  WRITE (*,1000) trim(s_name)
168  END IF
169 
170  this%s_name = s_name
171  this%l_name = l_name
172  this%units = units
173  this%observed = observed
174  this%observed_sigma = sigma
175  this%weight = weight
176  this%modeled = 0.0
177  this%modeled_sigma = 0.0
178  this%scale_index = s_index
179  this%offset_index = o_index
180 
181  CALL profiler_set_stop_time('signal_construct_new', start_time)
182 
183 1000 FORMAT('Warning: sigma for ',a,' is zero.')
184 
185  END SUBROUTINE
186 
187 !-------------------------------------------------------------------------------
201 !-------------------------------------------------------------------------------
202  SUBROUTINE signal_construct_diagnostic_netcdf(this, mdsig_iou, &
203  & observed, sigma, &
204  & weight, s_index, &
205  & o_index)
206  USE ezcdf
207 
208  IMPLICIT NONE
209 
210 ! Declare Arguments
211  class(signal_class), INTENT(inout) :: this
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
218 
219 ! local variables
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
224 
225 ! Start of executable code
226  start_time = profiler_get_start_time()
227 
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)
231 
232  CALL signal_construct(this, s_name, l_name, units, observed, &
233  & sigma, weight, s_index, o_index)
234 
235  CALL profiler_set_stop_time('signal_construct_diagnostic_netcdf', &
236  & start_time)
237 
238  END SUBROUTINE
239 
240 !*******************************************************************************
241 ! DESTRUCTION SUBROUTINES
242 !*******************************************************************************
243 !-------------------------------------------------------------------------------
249 !-------------------------------------------------------------------------------
250  SUBROUTINE signal_destruct(this)
251 
252  IMPLICIT NONE
253 
254 ! Declare Arguments
255  TYPE (signal_class), INTENT(inout) :: this
256 
257 ! Start of executable code
258  this%s_name = ''
259  this%l_name = ''
260  this%units = ''
261  this%observed = 0.0
262  this%observed_sigma = 0.0
263  this%weight = 0.0
264  this%modeled = 0.0
265  this%modeled_sigma = 0.0
266 
267  WRITE (*,*) 'Destruct'
268 
269  END SUBROUTINE
270 
271 !*******************************************************************************
272 ! GETTER SUBROUTINES
273 !*******************************************************************************
274 !-------------------------------------------------------------------------------
288 !-------------------------------------------------------------------------------
289  FUNCTION signal_get_modeled_signal_cache(this, a_model, sigma, &
290  & use_cache, last_value)
291 
292  IMPLICIT NONE
293 
294 ! Declare Arguments
295  REAL (rprec), DIMENSION(4) :: signal_get_modeled_signal_cache
296  CLASS (signal_class), INTENT(inout) :: this
297  TYPE (model_class), POINTER :: a_model
298  REAL (rprec), DIMENSION(:), INTENT(out) :: sigma
299  LOGICAL, INTENT(in) :: use_cache
300  REAL (rprec), DIMENSION(4), INTENT(in) :: last_value
301 
302 ! local variables
303  REAL (rprec) :: start_time
304 
305 ! Start of executable code
306  start_time = profiler_get_start_time()
307 
308  IF (.not.use_cache) THEN
309  this%modeled = this%get_modeled_signal(a_model, &
310  & this%modeled_sigma, &
311  & last_value)
312  END IF
313 
314  sigma = this%modeled_sigma
315  signal_get_modeled_signal_cache = this%modeled
316 
317  CALL profiler_set_stop_time('signal_get_modeled_signal_cache', &
318  & start_time)
319 
320  END FUNCTION
321 
322 !-------------------------------------------------------------------------------
350 !-------------------------------------------------------------------------------
351  FUNCTION signal_get_modeled_signal_last(this, a_model, sigma, &
352  & last_value)
353  USE v3_utilities
354 
355  IMPLICIT NONE
356 
357 ! Declare Arguments
358  REAL (rprec), DIMENSION(4) :: signal_get_modeled_signal_last
359  CLASS (signal_class), INTENT(inout) :: this
360  TYPE (model_class), POINTER :: a_model
361  REAL (rprec), DIMENSION(4), INTENT(out) :: sigma
362  REAL (rprec), DIMENSION(4), INTENT(in) :: last_value
363 
364 ! local variables
365  REAL (rprec) :: start_time
366 
367 ! Start of executable code
368  CALL assert(.false., 'get_modeled_signal_last not over written' // &
369  & ' for ' // this%get_type())
370 
371  END FUNCTION
372 
373 !-------------------------------------------------------------------------------
386 !-------------------------------------------------------------------------------
387  FUNCTION signal_get_observed_signal(this, a_model)
388 
389  IMPLICIT NONE
390 
391 ! Declare Arguments
392  REAL (rprec) :: signal_get_observed_signal
393  CLASS (signal_class), INTENT(in) :: this
394  TYPE (model_class), INTENT(in) :: a_model
395 
396 ! local variables
397  REAL (rprec) :: start_time
398 
399 ! Start of executable code
400  start_time = profiler_get_start_time()
401 
402  signal_get_observed_signal = this%observed
403 
404  CALL profiler_set_stop_time('signal_get_observed_signal', &
405  & start_time)
406 
407  END FUNCTION
408 
409 !-------------------------------------------------------------------------------
421 !-------------------------------------------------------------------------------
422  FUNCTION signal_get_g2(this, a_model, use_cache, last_value)
423 
424  IMPLICIT NONE
425 
426 ! Declare Arguments
427  REAL (rprec) :: signal_get_g2
428  CLASS (signal_class), INTENT(inout) :: this
429  TYPE (model_class), POINTER :: a_model
430  LOGICAL, INTENT(in) :: use_cache
431  REAL (rprec), DIMENSION(4), INTENT(in) :: last_value
432 
433 ! local Variables
434  REAL (rprec) :: start_time
435 
436 ! Start of executable code
437  start_time = profiler_get_start_time()
438 
439 ! g^2 = W*(O - M)^2/(sigma_o^2 + sigma_m^2) = e*e
440  signal_get_g2 = this%get_e(a_model, use_cache, last_value)**2.0
441 
442  CALL profiler_set_stop_time('signal_get_g2', start_time)
443 
444  END FUNCTION
445 
446 !-------------------------------------------------------------------------------
458 !-------------------------------------------------------------------------------
459  FUNCTION signal_get_e(this, a_model, use_cache, last_value)
460 
461  IMPLICIT NONE
462 
463 ! Declare Arguments
464  REAL (rprec) :: signal_get_e
465  CLASS (signal_class), INTENT(inout) :: this
466  TYPE (model_class), POINTER :: a_model
467  LOGICAL, INTENT(in) :: use_cache
468  REAL (rprec), DIMENSION(4), INTENT(in) :: last_value
469 
470 ! local Variables
471  REAL (rprec), DIMENSION(4) :: modeled_signal
472  REAL (rprec), DIMENSION(4) :: modeled_sigma
473  REAL (rprec) :: observed_signal
474  REAL (rprec) :: start_time
475 
476 ! Start of executable code
477  start_time = profiler_get_start_time()
478 
479  observed_signal = this%get_observed_signal(a_model)
480 
481  modeled_signal = this%get_modeled_signal(a_model, modeled_sigma, &
482  & use_cache, last_value)
483 
484 ! e = SQRT(W)*(O - M)/SQRT(sigma_o^2 + sigma_m^2)
485 ! Users are can be lax when specifiying the sigma for signals weighted to zero.
486 ! Avoid a possible divide by zero by error checking the weight first. If the
487 ! weight is zero, set the error vector explicitly to zero.
488  IF (this%weight .eq. 0.0) THEN
489  signal_get_e = 0.0
490  ELSE
491  signal_get_e = (modeled_signal(1) - observed_signal) &
492  & * sqrt(this%weight/this%get_sigma2())
493  END IF
494 
495  CALL profiler_set_stop_time('signal_get_e', start_time)
496 
497  END FUNCTION
498 
499 !-------------------------------------------------------------------------------
509 !-------------------------------------------------------------------------------
510  FUNCTION signal_get_sigma2(this)
511 
512  IMPLICIT NONE
513 
514 ! Declare Arguments
515  REAL (rprec) :: signal_get_sigma2
516  CLASS (signal_class), INTENT(in) :: this
517 
518 ! local variables
519  REAL (rprec) :: start_time
520 
521 ! Start of executable code
522  start_time = profiler_get_start_time()
523 
524 ! sigma_o^2 + sigma_m^2)
525  signal_get_sigma2 = this%observed_sigma**2.0 &
526  & + this%modeled_sigma(1)**2.0
527 
528  CALL profiler_set_stop_time('signal_get_sigma2', start_time)
529 
530  END FUNCTION
531 
532 !-------------------------------------------------------------------------------
553 !-------------------------------------------------------------------------------
554  FUNCTION signal_get_type(this)
555  USE v3_utilities
556 
557  IMPLICIT NONE
558 
559 ! Declare Arguments
560  CHARACTER (len=data_name_length) :: signal_get_type
561  class(signal_class), INTENT(in) :: this
562 
563 ! local variables
564  REAL (rprec) :: start_time
565 
566 ! Start of executable code
567  CALL assert(.false., 'signal_get_type not over written for ' // &
568  & this%s_name)
569 
570  END FUNCTION
571 
572 !-------------------------------------------------------------------------------
589 !-------------------------------------------------------------------------------
590  SUBROUTINE signal_get_header(this, header)
591 
592  IMPLICIT NONE
593 
594 ! Declare Arguments
595  class(signal_class), INTENT(in) :: this
596  CHARACTER (len=data_name_length), DIMENSION(7), INTENT(inout) :: &
597  & header
598 
599 ! local variables
600  REAL (rprec) :: start_time
601 
602 ! Start of executable code
603  start_time = profiler_get_start_time()
604 
605  header(1:3) = 'N/A'
606  header(4) = 'model_sig(1)'
607  header(5) = 'model_sig(2)'
608  header(6) = 'model_sig(3)'
609  header(7) = 'model_sig(4)'
610 
611  CALL profiler_set_stop_time('signal_get_header', start_time)
612 
613  END SUBROUTINE
614 
615 !-------------------------------------------------------------------------------
633 !-------------------------------------------------------------------------------
634  FUNCTION signal_get_gp_i(this, a_model, i, flags)
635  USE v3_utilities
636 
637  IMPLICIT NONE
638 
639 ! Declare Arguments
640  REAL (rprec) :: signal_get_gp_i
641  class(signal_class), INTENT(in) :: this
642  TYPE (model_class), POINTER :: a_model
643  INTEGER, INTENT(in) :: i
644  INTEGER, INTENT(in) :: flags
645 
646 ! local variables
647  REAL (rprec) :: scale_factor
648  REAL (rprec) :: start_time
649 
650 ! Start of executable code
651  CALL assert(.false., 'signal_get_gp_i not over written for ' // &
652  & this%get_type())
653 
654  END FUNCTION
655 
656 !-------------------------------------------------------------------------------
675 !-------------------------------------------------------------------------------
676  FUNCTION signal_get_gp_s(this, a_model, signal, flags)
677  USE v3_utilities
678 
679  IMPLICIT NONE
680 
681 ! Declare Arguments
682  REAL (rprec) :: signal_get_gp_s
683  class(signal_class), INTENT(in) :: this
684  TYPE (model_class), POINTER :: a_model
685  CLASS (signal_class), POINTER :: signal
686  INTEGER, INTENT(in) :: flags
687 
688 ! Start of executable code
689  CALL assert(.false., 'signal_get_gp_s not over written for ' // &
690  & this%get_type())
691 
692  END FUNCTION
693 
694 !-------------------------------------------------------------------------------
712 !-------------------------------------------------------------------------------
713  FUNCTION signal_get_gp_x(this, a_model, x_cart, flags)
714  USE v3_utilities
715 
716  IMPLICIT NONE
717 
718 ! Declare Arguments
719  REAL (rprec) :: signal_get_gp_x
720  class(signal_class), INTENT(in) :: this
721  TYPE (model_class), POINTER :: a_model
722  REAL (rprec), DIMENSION(3), INTENT(in) :: x_cart
723  INTEGER, INTENT(in) :: flags
724 
725 ! Start of executable code
726  CALL assert(.false., 'signal_get_gp_x not over written for ' // &
727  & this%get_type())
728 
729  END FUNCTION
730 
731 !*******************************************************************************
732 ! UTILITY SUBROUTINES
733 !*******************************************************************************
734 !-------------------------------------------------------------------------------
742 !-------------------------------------------------------------------------------
743  SUBROUTINE signal_scale_and_offset(this, a_model, value)
744  class(signal_class), INTENT(in) :: this
745  TYPE (model_class), INTENT(in) :: a_model
746  REAL (rprec), INTENT(inout) :: value
747 
748 ! local variables
749  REAL (rprec) :: scale_factor
750  REAL (rprec) :: offset_factor
751  REAL (rprec) :: start_time
752 
753 ! Start of executable code
754  start_time = profiler_get_start_time()
755 
756  scale_factor = model_get_signal_factor(a_model, this%scale_index)
757  offset_factor = model_get_signal_offset(a_model, &
758  & this%offset_index)
759 
760  value = value*scale_factor + offset_factor
761 
762  END SUBROUTINE
763 
764 !-------------------------------------------------------------------------------
773 !-------------------------------------------------------------------------------
774  FUNCTION signal_make_short_name(name, index)
775 
776  IMPLICIT NONE
777 
778 ! Declare Arguments
779  CHARACTER (len=data_short_name_length) :: signal_make_short_name
780  CHARACTER (len=*), INTENT(in) :: name
781  INTEGER, INTENT(in) :: index
782 
783 ! local variables
784  REAL (rprec) :: start_time
785 
786 ! Start of executable code
787  start_time = profiler_get_start_time()
788 
789 ! Find the number of digits in the index
790  IF (index .lt. 10) THEN
791  WRITE (signal_make_short_name,'(a,i1)') trim(name), index
792  ELSE IF (index .lt. 100) THEN
793  WRITE (signal_make_short_name,'(a,i2)') trim(name), index
794  ELSE IF (index .lt. 1000) THEN
795  WRITE (signal_make_short_name,'(a,i3)') trim(name), index
796  ELSE
797  WRITE (signal_make_short_name,'(a,i4)') trim(name), index
798  END IF
799 
800  CALL profiler_set_stop_time('signal_make_short_name', start_time)
801 
802  END FUNCTION
803 
804 !-------------------------------------------------------------------------------
817 !-------------------------------------------------------------------------------
818  SUBROUTINE signal_write(this, iou, index, a_model)
819  USE model
820 
821  IMPLICIT NONE
822 
823 ! Declare Arguments
824  class(signal_class), INTENT(inout) :: this
825  INTEGER, INTENT(in) :: iou
826  INTEGER, INTENT(in) :: index
827  TYPE (model_class), POINTER :: a_model
828 
829 ! local variables
830  REAL (rprec), DIMENSION(4) :: modeled_signal
831  REAL (rprec), DIMENSION(4) :: modeled_sigma
832  REAL (rprec) :: start_time
833 
834 ! local paramaters
835  REAL (rprec), DIMENSION(4), PARAMETER :: dummy_value = 0.0
836 
837 ! Start of executable code
838  start_time = profiler_get_start_time()
839 
840 ! When reading from the signal cache, the signal is not recomputed so any value
841 ! can be used for the last_value arument.
842  modeled_signal = this%get_modeled_signal(a_model, modeled_sigma, &
843  & .true., dummy_value)
844 
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, &
849  & modeled_sigma
850 
851  CALL profiler_set_stop_time('signal_write', start_time)
852 
853 1000 FORMAT(i4,2x,a23,2x,a20,12(2x,es12.5))
854 
855  END SUBROUTINE
856 
857 !-------------------------------------------------------------------------------
866 !-------------------------------------------------------------------------------
867  SUBROUTINE signal_write_header(this, iou)
868 
869  IMPLICIT NONE
870 
871 ! Declare Arguments
872  class(signal_class), INTENT(in) :: this
873  INTEGER, INTENT(in) :: iou
874 
875 ! local variables
876  CHARACTER (len=data_name_length), DIMENSION(7) :: header
877  REAL (rprec) :: start_time
878 
879 ! Start of executable code
880  start_time = profiler_get_start_time()
881 
882  CALL this%get_header(header)
883  WRITE (iou,*)
884  WRITE (iou,1000) header
885 
886  CALL profiler_set_stop_time('signal_write_header', start_time)
887 
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))
890 
891  END SUBROUTINE
892 
893 !-------------------------------------------------------------------------------
909 !-------------------------------------------------------------------------------
910  SUBROUTINE signals_write_auxiliary(this, iou, index, a_model)
911 
912  IMPLICIT NONE
913 
914 ! Declare Arguments
915  class(signal_class), INTENT(in) :: this
916  INTEGER, INTENT(in) :: iou
917  INTEGER, INTENT(in) :: index
918  TYPE (model_class), INTENT(in) :: a_model
919 
920 ! local variables
921  REAL (rprec) :: start_time
922 
923 ! Start of executable code
924  start_time = profiler_get_start_time()
925  CALL profiler_set_stop_time('signals_write_auxiliary', start_time)
926 
927  END SUBROUTINE
928 
929 !*******************************************************************************
930 ! NETCDF SUBROUTINES
931 !*******************************************************************************
932 !-------------------------------------------------------------------------------
947 !-------------------------------------------------------------------------------
948  SUBROUTINE signal_write_step_data(this, a_model, result_ncid, &
949  & current_step, index, &
950  & signal_model_value_id, &
951  & signal_sigma_value_id)
952  USE model
953  USE ezcdf
954 
955  IMPLICIT NONE
956 
957 ! Declare Arguments
958  class(signal_class), INTENT(inout) :: this
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
965 
966 ! local variables
967  INTEGER :: status
968  INTEGER :: varid
969  REAL (rprec), DIMENSION(4) :: modeled_sigma
970  REAL (rprec), DIMENSION(4) :: modeled_signal
971  REAL (rprec) :: start_time
972 
973 ! local paramaters
974  REAL (rprec), DIMENSION(4), PARAMETER :: dummy_value = 0.0
975 
976 ! Start of executable code
977  start_time = profiler_get_start_time()
978 
979 ! When reading from the signal cache, the signal is not recomputed so any value
980 ! can be used for the last_value arument.
981  modeled_signal = this%get_modeled_signal(a_model, modeled_sigma, &
982  & .true., dummy_value)
983 
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))
988 
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))
993 
994 ! Feedback signals change the observed signal. Write the current observed
995 ! value at eash step.
996 #if 0
997 ! FIXME: Disable this for now until it is moved into the refactored feed
998 ! back class.
999  SELECT CASE(this%type)
1000 
1001  CASE (signal_feedback_type)
1002  status = nf_inq_varid(result_ncid, 'signal_observed_value', &
1003  & varid)
1004  CALL assert_eq(status, nf_noerr, nf_strerror(status))
1005 
1006  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))
1010 
1011  END SELECT
1012 #endif
1013  CALL profiler_set_stop_time('signal_write_step_data', start_time)
1014 
1015  END SUBROUTINE
1016 
1017 !*******************************************************************************
1018 ! MPI SUBROUTINES
1019 !*******************************************************************************
1020 !-------------------------------------------------------------------------------
1029 !-------------------------------------------------------------------------------
1030  SUBROUTINE signal_sync_child(this, index, recon_comm)
1031 
1032  IMPLICIT NONE
1033 
1034 ! Declare Arguments
1035  class(signal_class), INTENT(inout) :: this
1036  INTEGER, INTENT(in) :: index
1037  INTEGER, INTENT(in) :: recon_comm
1038 
1039 #if defined(MPI_OPT)
1040 ! local variables
1041  INTEGER :: error
1042  INTEGER :: mpi_rank
1043  REAL (rprec) :: start_time
1044 
1045 ! Start of executable code
1046  start_time = profiler_get_start_time()
1047 
1048  CALL mpi_comm_rank(recon_comm, mpi_rank, error)
1049 
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)
1060  END IF
1061 
1062  CALL profiler_set_stop_time('signal_sync_child', start_time)
1063 #endif
1064 
1065  END SUBROUTINE
1066 
1067  END MODULE
signal::signal_get_gp_x
real(rprec) function signal_get_gp_x(this, a_model, x_cart, flags)
Gets the guassian process kernel for a signal and cartesian position.
Definition: signal.f:714
signal::signal_sync_child
subroutine signal_sync_child(this, index, recon_comm)
Syncronize a child signal state to the parent.
Definition: signal.f:1031
model::model_get_signal_offset
real(rprec) function model_get_signal_offset(this, index)
Get the offset factor for a signal.
Definition: model.f:2565
signal::signal_scale_and_offset
subroutine signal_scale_and_offset(this, a_model, value)
Apply scale and offset to the value.
Definition: signal.f:744
signal::signal_get_gp_s
real(rprec) function signal_get_gp_s(this, a_model, signal, flags)
Gets the guassian process kernel for a signal and a signal.
Definition: signal.f:677
signal::signal_construct_diagnostic_netcdf
subroutine signal_construct_diagnostic_netcdf(this, mdsig_iou, observed, sigma, weight, s_index, o_index)
Construct a signal_class containing a diagnostic object.
Definition: signal.f:206
model
Defines the base class of the type model_class. The model contains information not specific to the eq...
Definition: model.f:59
signal::signal_get_observed_signal
real(rprec) function signal_get_observed_signal(this, a_model)
Calculates the observed signal.
Definition: signal.f:388
signal::signal_get_sigma2
real(rprec) function signal_get_sigma2(this)
Calculates the total sigma^2 of a signal.
Definition: signal.f:511
v3_utilities::assert
Definition: v3_utilities.f:55
signal::signal_get_gp_i
real(rprec) function signal_get_gp_i(this, a_model, i, flags)
Gets the guassian process kernel for a signal and a position.
Definition: signal.f:635
model::model_class
Base class representing a model.
Definition: model.f:141
signal::signal_get_type
character(len=data_name_length) function signal_get_type(this)
Gets a discription of the signal type.
Definition: signal.f:555
signal::signal_construct
Interface for the construction of signal_class types using signal_construct_magnetic,...
Definition: signal.f:118
model::model_get_signal_factor
real(rprec) function model_get_signal_factor(this, index)
Get the scale factor for a signal.
Definition: model.f:2531
signal::signals_write_auxiliary
subroutine signals_write_auxiliary(this, iou, index, a_model)
Write out any auxiliary signal information to an output file.
Definition: signal.f:911
signal::signal_get_g2
real(rprec) function signal_get_g2(this, a_model, use_cache, last_value)
Calculates the g^2 contribution of a signal.
Definition: signal.f:423
signal::signal_get_modeled_signal_last
real(rprec) function, dimension(4) signal_get_modeled_signal_last(this, a_model, sigma, last_value)
Calculates the modeled signal.
Definition: signal.f:353
signal::signal_write
subroutine signal_write(this, iou, index, a_model)
Write out the signal information to an output file.
Definition: signal.f:819
signal::signal_destruct
subroutine signal_destruct(this)
Deconstruct a signal_class object.
Definition: signal.f:251
data_parameters
This modules contains parameters used by equilibrium models.
Definition: data_parameters.f:10
signal::signal_get_header
subroutine signal_get_header(this, header)
Gets a discription of the model and model sigma array indices.
Definition: signal.f:591
signal::signal_get_modeled_signal_cache
real(rprec) function, dimension(4) signal_get_modeled_signal_cache(this, a_model, sigma, use_cache, last_value)
Calculates the modeled signal.
Definition: signal.f:291
signal::signal_pointer
Pointer to a signal object. Used for creating arrays of signal pointers. This is needed because fortr...
Definition: signal.f:100
signal::signal_construct_new
subroutine signal_construct_new(this, s_name, l_name, units, observed, sigma, weight, s_index, o_index)
Construct new signal_class object.
Definition: signal.f:145
signal::signal_class
Base class representing a signal.
Definition: signal.f:33
signal::signal_get_e
real(rprec) function signal_get_e(this, a_model, use_cache, last_value)
Calculates the e contribution of a signal.
Definition: signal.f:460
signal::signal_make_short_name
character(len=data_short_name_length) function signal_make_short_name(name, index)
Generate a short name by appending an index.
Definition: signal.f:775
signal
Defines the base class of the type signal_class.
Definition: signal.f:14
signal::signal_write_header
subroutine signal_write_header(this, iou)
Write out the signal header information to an output file.
Definition: signal.f:868
signal::signal_write_step_data
subroutine signal_write_step_data(this, a_model, result_ncid, current_step, index, signal_model_value_id, signal_sigma_value_id)
Write out the signal data for a step to the result netcdf file.
Definition: signal.f:952
Generated on Thu Mar 5 2020 15:49:26 for V3FIT by   doxygen 1.8.17