libsim Versione 7.2.6

◆ 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
663!> Classe per la gestione delle variabili osservate da stazioni meteo e affini.
664!! Questo modulo definisce una classe per rappresentare variabili meteorologiche
665!! osservate, o attributi, aventi diversi tipi numerici o carattere.
666!! \ingroup vol7d
667MODULE vol7d_var_class
668USE kinds
671IMPLICIT NONE
672
673!> Definisce una variabile meteorologica osservata o un suo attributo.
674!! I membri \a r, \a d, \a i, \a b, \a c servono, internamente a vol7d,
675!! per associare le variabili agli attributi, e indicano
676!! a quale variabile, nel descrittore delle variabili, coincide
677!! la variabile corrente nel descrittore delle "variabili aventi attributo".
678!! I membri di \a vol7d_var sono pubblici e quindi liberamente
679!! accessibili e scrivibili, ma è comunque consigliato assegnarli tramite
680!! il costruttore ::init.
681TYPE vol7d_var
682 CHARACTER(len=10) :: btable=cmiss !< codice della variabile secondo la tabella B del WMO.
683 CHARACTER(len=65) :: description=cmiss !< descrizione testuale della variabile (opzionale)
684 CHARACTER(len=24) :: unit=cmiss !< descrizione testuale dell'unità di misura (opzionale)
685 INTEGER :: scalefactor=imiss !< numero di decimali nella rappresentazione intera o character (opzionale)
686
687 INTEGER :: r=imiss !< indice della variabile nel volume degli attributi reali
688 INTEGER :: d=imiss !< indice della variabile nel volume degli attributi double precision
689 INTEGER :: i=imiss !< indice della variabile nel volume degli attributi integer
690 INTEGER :: b=imiss !< indice della variabile nel volume degli attributi byte
691 INTEGER :: c=imiss !< indice della variabile nel volume degli attributi character
692 INTEGER :: gribhint(4)=imiss !< hint for conversion from/to grib when btable is not found
693END TYPE vol7d_var
694
695!> Valore mancante per vol7d_var.
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
700!> Costruttore per la classe vol7d_var.
701!! Deve essere richiamato
702!! per tutti gli oggetti di questo tipo definiti in un programma.
703INTERFACE init
704 MODULE PROCEDURE vol7d_var_init
705END INTERFACE
706
707!> Distruttore per la classe vol7d_var.
708!! Distrugge l'oggetto in maniera pulita, assegnandogli un valore mancante.
709INTERFACE delete
710 MODULE PROCEDURE vol7d_var_delete
711END INTERFACE
712
713!> Operatore logico di uguaglianza tra oggetti della classe vol7d_var.
714!! Funziona anche per
715!! confronti di tipo array-array (qualsiasi n. di dimensioni) e di tipo
716!! scalare-vettore(1-d) (ma non vettore(1-d)-scalare o tra array con più
717!! di 1 dimensione e scalari).
718INTERFACE OPERATOR (==)
719 MODULE PROCEDURE vol7d_var_eq
720END INTERFACE
721
722!> Operatore logico di disuguaglianza tra oggetti della classe vol7d_var.
723!! Funziona anche per
724!! confronti di tipo array-array (qualsiasi n. di dimensioni) e di tipo
725!! scalare-vettore(1-d) (ma non vettore(1-d)-scalare o tra array con più
726!! di 1 dimensione e scalari).
727INTERFACE OPERATOR (/=)
728 MODULE PROCEDURE vol7d_var_ne, vol7d_var_nesv
729END INTERFACE
730
731!> to be documented
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
740!> \brief display on the screen a brief content of object
741INTERFACE display
742 MODULE PROCEDURE display_var, display_var_vect
743END INTERFACE
744
745
746TYPE vol7d_var_features
747 TYPE(vol7d_var) :: var !< the variable (only btable is relevant)
748 REAL :: posdef !< if not missing, minimum physically reasonable value for the variable
749 INTEGER :: vartype !< type of variable, one of the var_* constants
750END TYPE vol7d_var_features
751
752TYPE(vol7d_var_features),ALLOCATABLE :: var_features(:)
753
754! constants for vol7d_vartype
755INTEGER,PARAMETER :: var_ord=0 !< unclassified variable (vol7d_vartype function)
756INTEGER,PARAMETER :: var_dir360=1 !< direction in degrees (vol7d_vartype function)
757INTEGER,PARAMETER :: var_press=2 !< pressure in Pa (vol7d_vartype function)
758INTEGER,PARAMETER :: var_ucomp=3 !< u component of a vector field (vol7d_vartype function)
759INTEGER,PARAMETER :: var_vcomp=4 !< v component of a vector field (vol7d_vartype function)
760INTEGER,PARAMETER :: var_wcomp=5 !< w component of a vector field (vol7d_vartype function)
761
762
763CONTAINS
764
765!> Inizializza un oggetto \a vol7d_var con i parametri opzionali forniti.
766!! Se non viene passato nessun parametro opzionale l'oggetto è
767!! inizializzato a valore mancante.
768!! I membri \a r, \a d, \a i, \a b, \a c non possono essere assegnati
769!! tramite costruttore, ma solo direttamente.
770elemental SUBROUTINE vol7d_var_init(this, btable, description, unit, scalefactor)
771TYPE(vol7d_var),INTENT(INOUT) :: this !< oggetto da inizializzare
772CHARACTER(len=*),INTENT(in),OPTIONAL :: btable !< codice della variabile
773CHARACTER(len=*),INTENT(in),OPTIONAL :: description !< descrizione della variabile
774CHARACTER(len=*),INTENT(in),OPTIONAL :: unit !< unità di misura
775INTEGER,INTENT(in),OPTIONAL :: scalefactor !< decimali nella rappresentazione intera e character
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 !< codice della variabile
813CHARACTER(len=*),INTENT(in),OPTIONAL :: description !< descrizione della variabile
814CHARACTER(len=*),INTENT(in),OPTIONAL :: unit !< unità di misura
815INTEGER,INTENT(in),OPTIONAL :: scalefactor !< decimali nella rappresentazione intera e character
816
817TYPE(vol7d_var) :: this
818
819CALL init(this, btable, description, unit, scalefactor)
820
821END FUNCTION vol7d_var_new
822
823
824!> Distrugge l'oggetto in maniera pulita, assegnandogli un valore mancante.
825elemental SUBROUTINE vol7d_var_delete(this)
826TYPE(vol7d_var),INTENT(INOUT) :: this !< oggetto da distruggre
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
868!> \brief display on the screen a brief content of vol7d_var object
869subroutine display_var(this)
870
871TYPE(vol7d_var),INTENT(in) :: this !< vol7d_var object to display
872
873print*,"VOL7DVAR: ",this%btable,trim(this%description)," : ",this%unit,&
874 " scale factor",this%scalefactor
875
876end subroutine display_var
877
878
879!> \brief display on the screen a brief content of vector of vol7d_var object
880subroutine display_var_vect(this)
881
882TYPE(vol7d_var),INTENT(in) :: this(:) !< vol7d_var vector object to display
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
898!> Initialise the global table of variable features.
899!! This subroutine reads the table of variable features from an
900!! external file and stores it in a global array. It has to be called
901!! once at the beginning of the program. At the moment it gives access
902!! to the information about type of variable and positive
903!! definitness. The table is based on the unique bufr-like variable
904!! table. The table is contained in the csv file `vargrib.csv`.
905!! It is not harmful to call this subroutine multiple times.
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
942!> Deallocate the global table of variable features.
943!! This subroutine deallocates the table of variable features
944!! allocated in the `vol7d_var_features_init` subroutine.
945SUBROUTINE vol7d_var_features_delete()
946IF (ALLOCATED(var_features)) DEALLOCATE(var_features)
947END SUBROUTINE vol7d_var_features_delete
948
949
950!> Return the physical type of the variable.
951!! Returns a rough classification of the variable depending on the
952!! physical parameter it represents. The result is one of the
953!! constants vartype_* defined in the module. To be extended.
954!! In order for this to work, the subroutine \a
955!! vol7d_var_features_init has to be preliminary called.
956ELEMENTAL FUNCTION vol7d_var_features_vartype(this) RESULT(vartype)
957TYPE(vol7d_var),INTENT(in) :: this !< vol7d_var object to be tested
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
976!> Apply a positive definite flag to a variable.
977!! This subroutine resets the value of a variable depending on its
978!! positive definite flag defined in the associated \a c_func object.
979!! The \a c_func object can be obtained for example by the \a convert
980!! (interfaced to vargrib2varbufr_convert) function. The value is
981!! reset to the maximum between the value itsel and and 0 (or the
982!! value set in \a c_func%posdef. These values are set from the
983!! vargrib2bufr.csv file.
984!! In order for this to work, the subroutine \a
985!! vol7d_var_features_init has to be preliminary called.
986ELEMENTAL SUBROUTINE vol7d_var_features_posdef_apply(this, val)
987TYPE(vol7d_var),INTENT(in) :: this !< vol7d_var object to be reset
988REAL,INTENT(inout) :: val !< value to be reset, it is reset in place
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
1004!> Return the physical type of the variable.
1005!! Returns a rough classification of the variable depending on the
1006!! physical parameter it represents. The result is one of the
1007!! constants vartype_* defined in the module. To be extended.
1008ELEMENTAL FUNCTION vol7d_vartype(this) RESULT(vartype)
1009TYPE(vol7d_var),INTENT(in) :: this !< vol7d_var object to be tested
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.