libsim Versione 7.1.11
|
◆ count_distinct_var()
conta gli elementi distinti in vect Definizione alla linea 649 del file vol7d_var_class.F90. 650! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
651! authors:
652! Davide Cesari <dcesari@arpa.emr.it>
653! Paolo Patruno <ppatruno@arpa.emr.it>
654
655! This program is free software; you can redistribute it and/or
656! modify it under the terms of the GNU General Public License as
657! published by the Free Software Foundation; either version 2 of
658! the License, or (at your option) any later version.
659
660! This program is distributed in the hope that it will be useful,
661! but WITHOUT ANY WARRANTY; without even the implied warranty of
662! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
663! GNU General Public License for more details.
664
665! You should have received a copy of the GNU General Public License
666! along with this program. If not, see <http://www.gnu.org/licenses/>.
667#include "config.h"
668
677IMPLICIT NONE
678
688 CHARACTER(len=10) :: btable=cmiss
689 CHARACTER(len=65) :: description=cmiss
690 CHARACTER(len=24) :: unit=cmiss
691 INTEGER :: scalefactor=imiss
692
693 INTEGER :: r=imiss
694 INTEGER :: d=imiss
695 INTEGER :: i=imiss
696 INTEGER :: b=imiss
697 INTEGER :: c=imiss
698 INTEGER :: gribhint(4)=imiss
700
702TYPE(vol7d_var),PARAMETER :: vol7d_var_miss= &
703 vol7d_var(cmiss,cmiss,cmiss,imiss,imiss,imiss,imiss,imiss,imiss, &
704 (/imiss,imiss,imiss,imiss/))
705
710 MODULE PROCEDURE vol7d_var_init
711END INTERFACE
712
716 MODULE PROCEDURE vol7d_var_delete
717END INTERFACE
718
724INTERFACE OPERATOR (==)
725 MODULE PROCEDURE vol7d_var_eq
726END INTERFACE
727
733INTERFACE OPERATOR (/=)
734 MODULE PROCEDURE vol7d_var_ne, vol7d_var_nesv
735END INTERFACE
736
739 MODULE PROCEDURE vol7d_var_c_e
740END INTERFACE
741
742#define VOL7D_POLY_TYPE TYPE(vol7d_var)
743#define VOL7D_POLY_TYPES _var
744#include "array_utilities_pre.F90"
745
748 MODULE PROCEDURE display_var, display_var_vect
749END INTERFACE
750
751
752TYPE vol7d_var_features
753 TYPE(vol7d_var) :: var
754 REAL :: posdef
755 INTEGER :: vartype
756END TYPE vol7d_var_features
757
758TYPE(vol7d_var_features),ALLOCATABLE :: var_features(:)
759
760! constants for vol7d_vartype
761INTEGER,PARAMETER :: var_ord=0
762INTEGER,PARAMETER :: var_dir360=1
763INTEGER,PARAMETER :: var_press=2
764INTEGER,PARAMETER :: var_ucomp=3
765INTEGER,PARAMETER :: var_vcomp=4
766INTEGER,PARAMETER :: var_wcomp=5
767
768
769CONTAINS
770
776elemental SUBROUTINE vol7d_var_init(this, btable, description, unit, scalefactor)
777TYPE(vol7d_var),INTENT(INOUT) :: this
778CHARACTER(len=*),INTENT(in),OPTIONAL :: btable
779CHARACTER(len=*),INTENT(in),OPTIONAL :: description
780CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
781INTEGER,INTENT(in),OPTIONAL :: scalefactor
782
783IF (PRESENT(btable)) THEN
784 this%btable = btable
785ELSE
786 this%btable = cmiss
787 this%description = cmiss
788 this%unit = cmiss
789 this%scalefactor = imiss
790 RETURN
791ENDIF
792IF (PRESENT(description)) THEN
793 this%description = description
794ELSE
795 this%description = cmiss
796ENDIF
797IF (PRESENT(unit)) THEN
798 this%unit = unit
799ELSE
800 this%unit = cmiss
801ENDIF
802if (present(scalefactor)) then
803 this%scalefactor = scalefactor
804else
805 this%scalefactor = imiss
806endif
807
808this%r = -1
809this%d = -1
810this%i = -1
811this%b = -1
812this%c = -1
813
814END SUBROUTINE vol7d_var_init
815
816
817ELEMENTAL FUNCTION vol7d_var_new(btable, description, unit, scalefactor) RESULT(this)
818CHARACTER(len=*),INTENT(in),OPTIONAL :: btable
819CHARACTER(len=*),INTENT(in),OPTIONAL :: description
820CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
821INTEGER,INTENT(in),OPTIONAL :: scalefactor
822
823TYPE(vol7d_var) :: this
824
826
827END FUNCTION vol7d_var_new
828
829
831elemental SUBROUTINE vol7d_var_delete(this)
832TYPE(vol7d_var),INTENT(INOUT) :: this
833
834this%btable = cmiss
835this%description = cmiss
836this%unit = cmiss
837this%scalefactor = imiss
838
839END SUBROUTINE vol7d_var_delete
840
841
842ELEMENTAL FUNCTION vol7d_var_eq(this, that) RESULT(res)
843TYPE(vol7d_var),INTENT(IN) :: this, that
844LOGICAL :: res
845
846res = this%btable == that%btable
847
848END FUNCTION vol7d_var_eq
849
850
851ELEMENTAL FUNCTION vol7d_var_ne(this, that) RESULT(res)
852TYPE(vol7d_var),INTENT(IN) :: this, that
853LOGICAL :: res
854
855res = .NOT.(this == that)
856
857END FUNCTION vol7d_var_ne
858
859
860FUNCTION vol7d_var_nesv(this, that) RESULT(res)
861TYPE(vol7d_var),INTENT(IN) :: this, that(:)
862LOGICAL :: res(SIZE(that))
863
864INTEGER :: i
865
866DO i = 1, SIZE(that)
867 res(i) = .NOT.(this == that(i))
868ENDDO
869
870END FUNCTION vol7d_var_nesv
871
872
873
875subroutine display_var(this)
876
877TYPE(vol7d_var),INTENT(in) :: this
878
879print*,"VOL7DVAR: ",this%btable,trim(this%description)," : ",this%unit,&
880 " scale factor",this%scalefactor
881
882end subroutine display_var
883
884
886subroutine display_var_vect(this)
887
888TYPE(vol7d_var),INTENT(in) :: this(:)
889integer :: i
890
891do i=1,size(this)
892 call display_var(this(i))
893end do
894
895end subroutine display_var_vect
896
897FUNCTION vol7d_var_c_e(this) RESULT(c_e)
898TYPE(vol7d_var),INTENT(IN) :: this
899LOGICAL :: c_e
900c_e = this /= vol7d_var_miss
901END FUNCTION vol7d_var_c_e
902
903
912SUBROUTINE vol7d_var_features_init()
913INTEGER :: un, i, n
914TYPE(csv_record) :: csv
915CHARACTER(len=1024) :: line
916
917IF (ALLOCATED(var_features)) RETURN
918
919un = open_package_file('varbufr.csv', filetype_data)
920n=0
921DO WHILE(.true.)
922 READ(un,*,END=100)
923 n = n + 1
924ENDDO
925
926100 CONTINUE
927
928rewind(un)
929ALLOCATE(var_features(n))
930
931DO i = 1, n
932 READ(un,'(A)',END=200)line
934 CALL csv_record_getfield(csv, var_features(i)%var%btable)
935 CALL csv_record_getfield(csv)
936 CALL csv_record_getfield(csv)
937 CALL csv_record_getfield(csv, var_features(i)%posdef)
938 CALL csv_record_getfield(csv, var_features(i)%vartype)
940ENDDO
941
942200 CONTINUE
943CLOSE(un)
944
945END SUBROUTINE vol7d_var_features_init
946
947
951SUBROUTINE vol7d_var_features_delete()
952IF (ALLOCATED(var_features)) DEALLOCATE(var_features)
953END SUBROUTINE vol7d_var_features_delete
954
955
962ELEMENTAL FUNCTION vol7d_var_features_vartype(this) RESULT(vartype)
963TYPE(vol7d_var),INTENT(in) :: this
964INTEGER :: vartype
965
966INTEGER :: i
967
968vartype = imiss
969
970IF (ALLOCATED(var_features)) THEN
971 DO i = 1, SIZE(var_features)
972 IF (this == var_features(i)%var) THEN
973 vartype = var_features(i)%vartype
974 RETURN
975 ENDIF
976 ENDDO
977ENDIF
978
979END FUNCTION vol7d_var_features_vartype
980
981
992ELEMENTAL SUBROUTINE vol7d_var_features_posdef_apply(this, val)
993TYPE(vol7d_var),INTENT(in) :: this
994REAL,INTENT(inout) :: val
995
996INTEGER :: i
997
998IF (ALLOCATED(var_features)) THEN
999 DO i = 1, SIZE(var_features)
1000 IF (this == var_features(i)%var) THEN
1002 RETURN
1003 ENDIF
1004 ENDDO
1005ENDIF
1006
1007END SUBROUTINE vol7d_var_features_posdef_apply
1008
1009
1014ELEMENTAL FUNCTION vol7d_vartype(this) RESULT(vartype)
1015TYPE(vol7d_var),INTENT(in) :: this
1016
1017INTEGER :: vartype
1018
1019vartype = var_ord
1020SELECT CASE(this%btable)
1021CASE('B01012', 'B11001', 'B11043', 'B22001') ! direction, degree true
1022 vartype = var_dir360
1023CASE('B07004', 'B10004', 'B10051', 'B10060') ! pressure, Pa
1024 vartype = var_press
1025CASE('B11003', 'B11200') ! u-component
1026 vartype = var_ucomp
1027CASE('B11004', 'B11201') ! v-component
1028 vartype = var_vcomp
1029CASE('B11005', 'B11006') ! w-component
1030 vartype = var_wcomp
1031END SELECT
1032
1033END FUNCTION vol7d_vartype
1034
1035
1036#include "array_utilities_inc.F90"
1037
1038
display on the screen a brief content of object Definition: vol7d_var_class.F90:334 Definition of constants to be used for declaring variables of a desired type. Definition: kinds.F90:251 Definitions of constants and functions for working with missing values. Definition: missing_values.f90:50 Classe per la gestione delle variabili osservate da stazioni meteo e affini. Definition: vol7d_var_class.F90:218 Definisce una variabile meteorologica osservata o un suo attributo. Definition: vol7d_var_class.F90:232 |