libsim Versione 7.2.6
|
◆ pack_distinct_var()
compatta gli elementi distinti di vect in un array Definizione alla linea 721 del file vol7d_var_class.F90. 723! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
724! authors:
725! Davide Cesari <dcesari@arpa.emr.it>
726! Paolo Patruno <ppatruno@arpa.emr.it>
727
728! This program is free software; you can redistribute it and/or
729! modify it under the terms of the GNU General Public License as
730! published by the Free Software Foundation; either version 2 of
731! the License, or (at your option) any later version.
732
733! This program is distributed in the hope that it will be useful,
734! but WITHOUT ANY WARRANTY; without even the implied warranty of
735! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
736! GNU General Public License for more details.
737
738! You should have received a copy of the GNU General Public License
739! along with this program. If not, see <http://www.gnu.org/licenses/>.
740#include "config.h"
741
742!> Classe per la gestione delle variabili osservate da stazioni meteo e affini.
743!! Questo modulo definisce una classe per rappresentare variabili meteorologiche
744!! osservate, o attributi, aventi diversi tipi numerici o carattere.
745!! \ingroup vol7d
750IMPLICIT NONE
751
752!> Definisce una variabile meteorologica osservata o un suo attributo.
753!! I membri \a r, \a d, \a i, \a b, \a c servono, internamente a vol7d,
754!! per associare le variabili agli attributi, e indicano
755!! a quale variabile, nel descrittore delle variabili, coincide
756!! la variabile corrente nel descrittore delle "variabili aventi attributo".
757!! I membri di \a vol7d_var sono pubblici e quindi liberamente
758!! accessibili e scrivibili, ma è comunque consigliato assegnarli tramite
759!! il costruttore ::init.
761 CHARACTER(len=10) :: btable=cmiss !< codice della variabile secondo la tabella B del WMO.
762 CHARACTER(len=65) :: description=cmiss !< descrizione testuale della variabile (opzionale)
763 CHARACTER(len=24) :: unit=cmiss !< descrizione testuale dell'unità di misura (opzionale)
764 INTEGER :: scalefactor=imiss !< numero di decimali nella rappresentazione intera o character (opzionale)
765
766 INTEGER :: r=imiss !< indice della variabile nel volume degli attributi reali
767 INTEGER :: d=imiss !< indice della variabile nel volume degli attributi double precision
768 INTEGER :: i=imiss !< indice della variabile nel volume degli attributi integer
769 INTEGER :: b=imiss !< indice della variabile nel volume degli attributi byte
770 INTEGER :: c=imiss !< indice della variabile nel volume degli attributi character
771 INTEGER :: gribhint(4)=imiss !< hint for conversion from/to grib when btable is not found
773
774!> Valore mancante per vol7d_var.
775TYPE(vol7d_var),PARAMETER :: vol7d_var_miss= &
776 vol7d_var(cmiss,cmiss,cmiss,imiss,imiss,imiss,imiss,imiss,imiss, &
777 (/imiss,imiss,imiss,imiss/))
778
779!> Costruttore per la classe vol7d_var.
780!! Deve essere richiamato
781!! per tutti gli oggetti di questo tipo definiti in un programma.
783 MODULE PROCEDURE vol7d_var_init
784END INTERFACE
785
786!> Distruttore per la classe vol7d_var.
787!! Distrugge l'oggetto in maniera pulita, assegnandogli un valore mancante.
789 MODULE PROCEDURE vol7d_var_delete
790END INTERFACE
791
792!> Operatore logico di uguaglianza tra oggetti della classe vol7d_var.
793!! Funziona anche per
794!! confronti di tipo array-array (qualsiasi n. di dimensioni) e di tipo
795!! scalare-vettore(1-d) (ma non vettore(1-d)-scalare o tra array con più
796!! di 1 dimensione e scalari).
797INTERFACE OPERATOR (==)
798 MODULE PROCEDURE vol7d_var_eq
799END INTERFACE
800
801!> Operatore logico di disuguaglianza tra oggetti della classe vol7d_var.
802!! Funziona anche per
803!! confronti di tipo array-array (qualsiasi n. di dimensioni) e di tipo
804!! scalare-vettore(1-d) (ma non vettore(1-d)-scalare o tra array con più
805!! di 1 dimensione e scalari).
806INTERFACE OPERATOR (/=)
807 MODULE PROCEDURE vol7d_var_ne, vol7d_var_nesv
808END INTERFACE
809
810!> to be documented
812 MODULE PROCEDURE vol7d_var_c_e
813END INTERFACE
814
815#define VOL7D_POLY_TYPE TYPE(vol7d_var)
816#define VOL7D_POLY_TYPES _var
817#include "array_utilities_pre.F90"
818
819!> \brief display on the screen a brief content of object
821 MODULE PROCEDURE display_var, display_var_vect
822END INTERFACE
823
824
825TYPE vol7d_var_features
826 TYPE(vol7d_var) :: var !< the variable (only btable is relevant)
827 REAL :: posdef !< if not missing, minimum physically reasonable value for the variable
828 INTEGER :: vartype !< type of variable, one of the var_* constants
829END TYPE vol7d_var_features
830
831TYPE(vol7d_var_features),ALLOCATABLE :: var_features(:)
832
833! constants for vol7d_vartype
834INTEGER,PARAMETER :: var_ord=0 !< unclassified variable (vol7d_vartype function)
835INTEGER,PARAMETER :: var_dir360=1 !< direction in degrees (vol7d_vartype function)
836INTEGER,PARAMETER :: var_press=2 !< pressure in Pa (vol7d_vartype function)
837INTEGER,PARAMETER :: var_ucomp=3 !< u component of a vector field (vol7d_vartype function)
838INTEGER,PARAMETER :: var_vcomp=4 !< v component of a vector field (vol7d_vartype function)
839INTEGER,PARAMETER :: var_wcomp=5 !< w component of a vector field (vol7d_vartype function)
840
841
842CONTAINS
843
844!> Inizializza un oggetto \a vol7d_var con i parametri opzionali forniti.
845!! Se non viene passato nessun parametro opzionale l'oggetto è
846!! inizializzato a valore mancante.
847!! I membri \a r, \a d, \a i, \a b, \a c non possono essere assegnati
848!! tramite costruttore, ma solo direttamente.
849elemental SUBROUTINE vol7d_var_init(this, btable, description, unit, scalefactor)
850TYPE(vol7d_var),INTENT(INOUT) :: this !< oggetto da inizializzare
851CHARACTER(len=*),INTENT(in),OPTIONAL :: btable !< codice della variabile
852CHARACTER(len=*),INTENT(in),OPTIONAL :: description !< descrizione della variabile
853CHARACTER(len=*),INTENT(in),OPTIONAL :: unit !< unità di misura
854INTEGER,INTENT(in),OPTIONAL :: scalefactor !< decimali nella rappresentazione intera e character
855
856IF (PRESENT(btable)) THEN
857 this%btable = btable
858ELSE
859 this%btable = cmiss
860 this%description = cmiss
861 this%unit = cmiss
862 this%scalefactor = imiss
863 RETURN
864ENDIF
865IF (PRESENT(description)) THEN
866 this%description = description
867ELSE
868 this%description = cmiss
869ENDIF
870IF (PRESENT(unit)) THEN
871 this%unit = unit
872ELSE
873 this%unit = cmiss
874ENDIF
875if (present(scalefactor)) then
876 this%scalefactor = scalefactor
877else
878 this%scalefactor = imiss
879endif
880
881this%r = -1
882this%d = -1
883this%i = -1
884this%b = -1
885this%c = -1
886
887END SUBROUTINE vol7d_var_init
888
889
890ELEMENTAL FUNCTION vol7d_var_new(btable, description, unit, scalefactor) RESULT(this)
891CHARACTER(len=*),INTENT(in),OPTIONAL :: btable !< codice della variabile
892CHARACTER(len=*),INTENT(in),OPTIONAL :: description !< descrizione della variabile
893CHARACTER(len=*),INTENT(in),OPTIONAL :: unit !< unità di misura
894INTEGER,INTENT(in),OPTIONAL :: scalefactor !< decimali nella rappresentazione intera e character
895
896TYPE(vol7d_var) :: this
897
899
900END FUNCTION vol7d_var_new
901
902
903!> Distrugge l'oggetto in maniera pulita, assegnandogli un valore mancante.
904elemental SUBROUTINE vol7d_var_delete(this)
905TYPE(vol7d_var),INTENT(INOUT) :: this !< oggetto da distruggre
906
907this%btable = cmiss
908this%description = cmiss
909this%unit = cmiss
910this%scalefactor = imiss
911
912END SUBROUTINE vol7d_var_delete
913
914
915ELEMENTAL FUNCTION vol7d_var_eq(this, that) RESULT(res)
916TYPE(vol7d_var),INTENT(IN) :: this, that
917LOGICAL :: res
918
919res = this%btable == that%btable
920
921END FUNCTION vol7d_var_eq
922
923
924ELEMENTAL FUNCTION vol7d_var_ne(this, that) RESULT(res)
925TYPE(vol7d_var),INTENT(IN) :: this, that
926LOGICAL :: res
927
928res = .NOT.(this == that)
929
930END FUNCTION vol7d_var_ne
931
932
933FUNCTION vol7d_var_nesv(this, that) RESULT(res)
934TYPE(vol7d_var),INTENT(IN) :: this, that(:)
935LOGICAL :: res(SIZE(that))
936
937INTEGER :: i
938
939DO i = 1, SIZE(that)
940 res(i) = .NOT.(this == that(i))
941ENDDO
942
943END FUNCTION vol7d_var_nesv
944
945
946
947!> \brief display on the screen a brief content of vol7d_var object
948subroutine display_var(this)
949
950TYPE(vol7d_var),INTENT(in) :: this !< vol7d_var object to display
951
952print*,"VOL7DVAR: ",this%btable,trim(this%description)," : ",this%unit,&
953 " scale factor",this%scalefactor
954
955end subroutine display_var
956
957
958!> \brief display on the screen a brief content of vector of vol7d_var object
959subroutine display_var_vect(this)
960
961TYPE(vol7d_var),INTENT(in) :: this(:) !< vol7d_var vector object to display
962integer :: i
963
964do i=1,size(this)
965 call display_var(this(i))
966end do
967
968end subroutine display_var_vect
969
970FUNCTION vol7d_var_c_e(this) RESULT(c_e)
971TYPE(vol7d_var),INTENT(IN) :: this
972LOGICAL :: c_e
973c_e = this /= vol7d_var_miss
974END FUNCTION vol7d_var_c_e
975
976
977!> Initialise the global table of variable features.
978!! This subroutine reads the table of variable features from an
979!! external file and stores it in a global array. It has to be called
980!! once at the beginning of the program. At the moment it gives access
981!! to the information about type of variable and positive
982!! definitness. The table is based on the unique bufr-like variable
983!! table. The table is contained in the csv file `vargrib.csv`.
984!! It is not harmful to call this subroutine multiple times.
985SUBROUTINE vol7d_var_features_init()
986INTEGER :: un, i, n
987TYPE(csv_record) :: csv
988CHARACTER(len=1024) :: line
989
990IF (ALLOCATED(var_features)) RETURN
991
992un = open_package_file('varbufr.csv', filetype_data)
993n=0
994DO WHILE(.true.)
995 READ(un,*,END=100)
996 n = n + 1
997ENDDO
998
999100 CONTINUE
1000
1001rewind(un)
1002ALLOCATE(var_features(n))
1003
1004DO i = 1, n
1005 READ(un,'(A)',END=200)line
1007 CALL csv_record_getfield(csv, var_features(i)%var%btable)
1008 CALL csv_record_getfield(csv)
1009 CALL csv_record_getfield(csv)
1010 CALL csv_record_getfield(csv, var_features(i)%posdef)
1011 CALL csv_record_getfield(csv, var_features(i)%vartype)
1013ENDDO
1014
1015200 CONTINUE
1016CLOSE(un)
1017
1018END SUBROUTINE vol7d_var_features_init
1019
1020
1021!> Deallocate the global table of variable features.
1022!! This subroutine deallocates the table of variable features
1023!! allocated in the `vol7d_var_features_init` subroutine.
1024SUBROUTINE vol7d_var_features_delete()
1025IF (ALLOCATED(var_features)) DEALLOCATE(var_features)
1026END SUBROUTINE vol7d_var_features_delete
1027
1028
1029!> Return the physical type of the variable.
1030!! Returns a rough classification of the variable depending on the
1031!! physical parameter it represents. The result is one of the
1032!! constants vartype_* defined in the module. To be extended.
1033!! In order for this to work, the subroutine \a
1034!! vol7d_var_features_init has to be preliminary called.
1035ELEMENTAL FUNCTION vol7d_var_features_vartype(this) RESULT(vartype)
1036TYPE(vol7d_var),INTENT(in) :: this !< vol7d_var object to be tested
1037INTEGER :: vartype
1038
1039INTEGER :: i
1040
1041vartype = imiss
1042
1043IF (ALLOCATED(var_features)) THEN
1044 DO i = 1, SIZE(var_features)
1045 IF (this == var_features(i)%var) THEN
1046 vartype = var_features(i)%vartype
1047 RETURN
1048 ENDIF
1049 ENDDO
1050ENDIF
1051
1052END FUNCTION vol7d_var_features_vartype
1053
1054
1055!> Apply a positive definite flag to a variable.
1056!! This subroutine resets the value of a variable depending on its
1057!! positive definite flag defined in the associated \a c_func object.
1058!! The \a c_func object can be obtained for example by the \a convert
1059!! (interfaced to vargrib2varbufr_convert) function. The value is
1060!! reset to the maximum between the value itsel and and 0 (or the
1061!! value set in \a c_func%posdef. These values are set from the
1062!! vargrib2bufr.csv file.
1063!! In order for this to work, the subroutine \a
1064!! vol7d_var_features_init has to be preliminary called.
1065ELEMENTAL SUBROUTINE vol7d_var_features_posdef_apply(this, val)
1066TYPE(vol7d_var),INTENT(in) :: this !< vol7d_var object to be reset
1067REAL,INTENT(inout) :: val !< value to be reset, it is reset in place
1068
1069INTEGER :: i
1070
1071IF (ALLOCATED(var_features)) THEN
1072 DO i = 1, SIZE(var_features)
1073 IF (this == var_features(i)%var) THEN
1075 RETURN
1076 ENDIF
1077 ENDDO
1078ENDIF
1079
1080END SUBROUTINE vol7d_var_features_posdef_apply
1081
1082
1083!> Return the physical type of the variable.
1084!! Returns a rough classification of the variable depending on the
1085!! physical parameter it represents. The result is one of the
1086!! constants vartype_* defined in the module. To be extended.
1087ELEMENTAL FUNCTION vol7d_vartype(this) RESULT(vartype)
1088TYPE(vol7d_var),INTENT(in) :: this !< vol7d_var object to be tested
1089
1090INTEGER :: vartype
1091
1092vartype = var_ord
1093SELECT CASE(this%btable)
1094CASE('B01012', 'B11001', 'B11043', 'B22001') ! direction, degree true
1095 vartype = var_dir360
1096CASE('B07004', 'B10004', 'B10051', 'B10060') ! pressure, Pa
1097 vartype = var_press
1098CASE('B11003', 'B11200') ! u-component
1099 vartype = var_ucomp
1100CASE('B11004', 'B11201') ! v-component
1101 vartype = var_vcomp
1102CASE('B11005', 'B11006') ! w-component
1103 vartype = var_wcomp
1104END SELECT
1105
1106END FUNCTION vol7d_vartype
1107
1108
1109#include "array_utilities_inc.F90"
1110
1111
display on the screen a brief content of object Definition vol7d_var_class.F90:328 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. Definition missing_values.f90:50 Classe per la gestione delle variabili osservate da stazioni meteo e affini. Definition vol7d_var_class.F90:212 Definisce una variabile meteorologica osservata o un suo attributo. Definition vol7d_var_class.F90:226 |