libsim Versione 7.2.4

◆ count_distinct_var()

integer function count_distinct_var ( type(vol7d_var), dimension(:), intent(in) vect,
logical, dimension(:), intent(in), optional mask,
logical, intent(in), optional back )

conta gli elementi distinti in vect

Definizione alla linea 643 del file vol7d_var_class.F90.

644! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
645! authors:
646! Davide Cesari <dcesari@arpa.emr.it>
647! Paolo Patruno <ppatruno@arpa.emr.it>
648
649! This program is free software; you can redistribute it and/or
650! modify it under the terms of the GNU General Public License as
651! published by the Free Software Foundation; either version 2 of
652! the License, or (at your option) any later version.
653
654! This program is distributed in the hope that it will be useful,
655! but WITHOUT ANY WARRANTY; without even the implied warranty of
656! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
657! GNU General Public License for more details.
658
659! You should have received a copy of the GNU General Public License
660! along with this program. If not, see <http://www.gnu.org/licenses/>.
661#include "config.h"
662
667MODULE vol7d_var_class
668USE kinds
671IMPLICIT NONE
672
681TYPE vol7d_var
682 CHARACTER(len=10) :: btable=cmiss
683 CHARACTER(len=65) :: description=cmiss
684 CHARACTER(len=24) :: unit=cmiss
685 INTEGER :: scalefactor=imiss
686
687 INTEGER :: r=imiss
688 INTEGER :: d=imiss
689 INTEGER :: i=imiss
690 INTEGER :: b=imiss
691 INTEGER :: c=imiss
692 INTEGER :: gribhint(4)=imiss
693END TYPE vol7d_var
694
696TYPE(vol7d_var),PARAMETER :: vol7d_var_miss= &
697 vol7d_var(cmiss,cmiss,cmiss,imiss,imiss,imiss,imiss,imiss,imiss, &
698 (/imiss,imiss,imiss,imiss/))
699
703INTERFACE init
704 MODULE PROCEDURE vol7d_var_init
705END INTERFACE
706
709INTERFACE delete
710 MODULE PROCEDURE vol7d_var_delete
711END INTERFACE
712
718INTERFACE OPERATOR (==)
719 MODULE PROCEDURE vol7d_var_eq
720END INTERFACE
721
727INTERFACE OPERATOR (/=)
728 MODULE PROCEDURE vol7d_var_ne, vol7d_var_nesv
729END INTERFACE
730
732INTERFACE c_e
733 MODULE PROCEDURE vol7d_var_c_e
734END INTERFACE
735
736#define VOL7D_POLY_TYPE TYPE(vol7d_var)
737#define VOL7D_POLY_TYPES _var
738#include "array_utilities_pre.F90"
739
741INTERFACE display
742 MODULE PROCEDURE display_var, display_var_vect
743END INTERFACE
744
745
746TYPE vol7d_var_features
747 TYPE(vol7d_var) :: var
748 REAL :: posdef
749 INTEGER :: vartype
750END TYPE vol7d_var_features
751
752TYPE(vol7d_var_features),ALLOCATABLE :: var_features(:)
753
754! constants for vol7d_vartype
755INTEGER,PARAMETER :: var_ord=0
756INTEGER,PARAMETER :: var_dir360=1
757INTEGER,PARAMETER :: var_press=2
758INTEGER,PARAMETER :: var_ucomp=3
759INTEGER,PARAMETER :: var_vcomp=4
760INTEGER,PARAMETER :: var_wcomp=5
761
762
763CONTAINS
764
770elemental SUBROUTINE vol7d_var_init(this, btable, description, unit, scalefactor)
771TYPE(vol7d_var),INTENT(INOUT) :: this
772CHARACTER(len=*),INTENT(in),OPTIONAL :: btable
773CHARACTER(len=*),INTENT(in),OPTIONAL :: description
774CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
775INTEGER,INTENT(in),OPTIONAL :: scalefactor
776
777IF (PRESENT(btable)) THEN
778 this%btable = btable
779ELSE
780 this%btable = cmiss
781 this%description = cmiss
782 this%unit = cmiss
783 this%scalefactor = imiss
784 RETURN
785ENDIF
786IF (PRESENT(description)) THEN
787 this%description = description
788ELSE
789 this%description = cmiss
790ENDIF
791IF (PRESENT(unit)) THEN
792 this%unit = unit
793ELSE
794 this%unit = cmiss
795ENDIF
796if (present(scalefactor)) then
797 this%scalefactor = scalefactor
798else
799 this%scalefactor = imiss
800endif
801
802this%r = -1
803this%d = -1
804this%i = -1
805this%b = -1
806this%c = -1
807
808END SUBROUTINE vol7d_var_init
809
810
811ELEMENTAL FUNCTION vol7d_var_new(btable, description, unit, scalefactor) RESULT(this)
812CHARACTER(len=*),INTENT(in),OPTIONAL :: btable
813CHARACTER(len=*),INTENT(in),OPTIONAL :: description
814CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
815INTEGER,INTENT(in),OPTIONAL :: scalefactor
816
817TYPE(vol7d_var) :: this
818
819CALL init(this, btable, description, unit, scalefactor)
820
821END FUNCTION vol7d_var_new
822
823
825elemental SUBROUTINE vol7d_var_delete(this)
826TYPE(vol7d_var),INTENT(INOUT) :: this
827
828this%btable = cmiss
829this%description = cmiss
830this%unit = cmiss
831this%scalefactor = imiss
832
833END SUBROUTINE vol7d_var_delete
834
835
836ELEMENTAL FUNCTION vol7d_var_eq(this, that) RESULT(res)
837TYPE(vol7d_var),INTENT(IN) :: this, that
838LOGICAL :: res
839
840res = this%btable == that%btable
841
842END FUNCTION vol7d_var_eq
843
844
845ELEMENTAL FUNCTION vol7d_var_ne(this, that) RESULT(res)
846TYPE(vol7d_var),INTENT(IN) :: this, that
847LOGICAL :: res
848
849res = .NOT.(this == that)
850
851END FUNCTION vol7d_var_ne
852
853
854FUNCTION vol7d_var_nesv(this, that) RESULT(res)
855TYPE(vol7d_var),INTENT(IN) :: this, that(:)
856LOGICAL :: res(SIZE(that))
857
858INTEGER :: i
859
860DO i = 1, SIZE(that)
861 res(i) = .NOT.(this == that(i))
862ENDDO
863
864END FUNCTION vol7d_var_nesv
865
866
867
869subroutine display_var(this)
870
871TYPE(vol7d_var),INTENT(in) :: this
872
873print*,"VOL7DVAR: ",this%btable,trim(this%description)," : ",this%unit,&
874 " scale factor",this%scalefactor
875
876end subroutine display_var
877
878
880subroutine display_var_vect(this)
881
882TYPE(vol7d_var),INTENT(in) :: this(:)
883integer :: i
884
885do i=1,size(this)
886 call display_var(this(i))
887end do
888
889end subroutine display_var_vect
890
891FUNCTION vol7d_var_c_e(this) RESULT(c_e)
892TYPE(vol7d_var),INTENT(IN) :: this
893LOGICAL :: c_e
894c_e = this /= vol7d_var_miss
895END FUNCTION vol7d_var_c_e
896
897
906SUBROUTINE vol7d_var_features_init()
907INTEGER :: un, i, n
908TYPE(csv_record) :: csv
909CHARACTER(len=1024) :: line
910
911IF (ALLOCATED(var_features)) RETURN
912
913un = open_package_file('varbufr.csv', filetype_data)
914n=0
915DO WHILE(.true.)
916 READ(un,*,END=100)
917 n = n + 1
918ENDDO
919
920100 CONTINUE
921
922rewind(un)
923ALLOCATE(var_features(n))
924
925DO i = 1, n
926 READ(un,'(A)',END=200)line
927 CALL init(csv, line)
928 CALL csv_record_getfield(csv, var_features(i)%var%btable)
929 CALL csv_record_getfield(csv)
930 CALL csv_record_getfield(csv)
931 CALL csv_record_getfield(csv, var_features(i)%posdef)
932 CALL csv_record_getfield(csv, var_features(i)%vartype)
933 CALL delete(csv)
934ENDDO
935
936200 CONTINUE
937CLOSE(un)
938
939END SUBROUTINE vol7d_var_features_init
940
941
945SUBROUTINE vol7d_var_features_delete()
946IF (ALLOCATED(var_features)) DEALLOCATE(var_features)
947END SUBROUTINE vol7d_var_features_delete
948
949
956ELEMENTAL FUNCTION vol7d_var_features_vartype(this) RESULT(vartype)
957TYPE(vol7d_var),INTENT(in) :: this
958INTEGER :: vartype
959
960INTEGER :: i
961
962vartype = imiss
963
964IF (ALLOCATED(var_features)) THEN
965 DO i = 1, SIZE(var_features)
966 IF (this == var_features(i)%var) THEN
967 vartype = var_features(i)%vartype
968 RETURN
969 ENDIF
970 ENDDO
971ENDIF
972
973END FUNCTION vol7d_var_features_vartype
974
975
986ELEMENTAL SUBROUTINE vol7d_var_features_posdef_apply(this, val)
987TYPE(vol7d_var),INTENT(in) :: this
988REAL,INTENT(inout) :: val
989
990INTEGER :: i
991
992IF (ALLOCATED(var_features)) THEN
993 DO i = 1, SIZE(var_features)
994 IF (this == var_features(i)%var) THEN
995 IF (c_e(var_features(i)%posdef)) val = max(var_features(i)%posdef, val)
996 RETURN
997 ENDIF
998 ENDDO
999ENDIF
1000
1001END SUBROUTINE vol7d_var_features_posdef_apply
1002
1003
1008ELEMENTAL FUNCTION vol7d_vartype(this) RESULT(vartype)
1009TYPE(vol7d_var),INTENT(in) :: this
1010
1011INTEGER :: vartype
1012
1013vartype = var_ord
1014SELECT CASE(this%btable)
1015CASE('B01012', 'B11001', 'B11043', 'B22001') ! direction, degree true
1016 vartype = var_dir360
1017CASE('B07004', 'B10004', 'B10051', 'B10060') ! pressure, Pa
1018 vartype = var_press
1019CASE('B11003', 'B11200') ! u-component
1020 vartype = var_ucomp
1021CASE('B11004', 'B11201') ! v-component
1022 vartype = var_vcomp
1023CASE('B11005', 'B11006') ! w-component
1024 vartype = var_wcomp
1025END SELECT
1026
1027END FUNCTION vol7d_vartype
1028
1029
1030#include "array_utilities_inc.F90"
1031
1032
1033END MODULE vol7d_var_class
Distruttore per la classe vol7d_var.
display on the screen a brief content of object
Costruttore per la classe vol7d_var.
Utilities for managing files.
Definition of constants to be used for declaring variables of a desired type.
Definition kinds.F90:245
Definitions of constants and functions for working with missing values.
Classe per la gestione delle variabili osservate da stazioni meteo e affini.
Definisce una variabile meteorologica osservata o un suo attributo.

Generated with Doxygen.