libsim Versione 7.2.6

◆ map_distinct_var()

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

map distinct

Definizione alla linea 870 del file vol7d_var_class.F90.

871! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
872! authors:
873! Davide Cesari <dcesari@arpa.emr.it>
874! Paolo Patruno <ppatruno@arpa.emr.it>
875
876! This program is free software; you can redistribute it and/or
877! modify it under the terms of the GNU General Public License as
878! published by the Free Software Foundation; either version 2 of
879! the License, or (at your option) any later version.
880
881! This program is distributed in the hope that it will be useful,
882! but WITHOUT ANY WARRANTY; without even the implied warranty of
883! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
884! GNU General Public License for more details.
885
886! You should have received a copy of the GNU General Public License
887! along with this program. If not, see <http://www.gnu.org/licenses/>.
888#include "config.h"
889
890!> Classe per la gestione delle variabili osservate da stazioni meteo e affini.
891!! Questo modulo definisce una classe per rappresentare variabili meteorologiche
892!! osservate, o attributi, aventi diversi tipi numerici o carattere.
893!! \ingroup vol7d
894MODULE vol7d_var_class
895USE kinds
898IMPLICIT NONE
899
900!> Definisce una variabile meteorologica osservata o un suo attributo.
901!! I membri \a r, \a d, \a i, \a b, \a c servono, internamente a vol7d,
902!! per associare le variabili agli attributi, e indicano
903!! a quale variabile, nel descrittore delle variabili, coincide
904!! la variabile corrente nel descrittore delle "variabili aventi attributo".
905!! I membri di \a vol7d_var sono pubblici e quindi liberamente
906!! accessibili e scrivibili, ma è comunque consigliato assegnarli tramite
907!! il costruttore ::init.
908TYPE vol7d_var
909 CHARACTER(len=10) :: btable=cmiss !< codice della variabile secondo la tabella B del WMO.
910 CHARACTER(len=65) :: description=cmiss !< descrizione testuale della variabile (opzionale)
911 CHARACTER(len=24) :: unit=cmiss !< descrizione testuale dell'unità di misura (opzionale)
912 INTEGER :: scalefactor=imiss !< numero di decimali nella rappresentazione intera o character (opzionale)
913
914 INTEGER :: r=imiss !< indice della variabile nel volume degli attributi reali
915 INTEGER :: d=imiss !< indice della variabile nel volume degli attributi double precision
916 INTEGER :: i=imiss !< indice della variabile nel volume degli attributi integer
917 INTEGER :: b=imiss !< indice della variabile nel volume degli attributi byte
918 INTEGER :: c=imiss !< indice della variabile nel volume degli attributi character
919 INTEGER :: gribhint(4)=imiss !< hint for conversion from/to grib when btable is not found
920END TYPE vol7d_var
921
922!> Valore mancante per vol7d_var.
923TYPE(vol7d_var),PARAMETER :: vol7d_var_miss= &
924 vol7d_var(cmiss,cmiss,cmiss,imiss,imiss,imiss,imiss,imiss,imiss, &
925 (/imiss,imiss,imiss,imiss/))
926
927!> Costruttore per la classe vol7d_var.
928!! Deve essere richiamato
929!! per tutti gli oggetti di questo tipo definiti in un programma.
930INTERFACE init
931 MODULE PROCEDURE vol7d_var_init
932END INTERFACE
933
934!> Distruttore per la classe vol7d_var.
935!! Distrugge l'oggetto in maniera pulita, assegnandogli un valore mancante.
936INTERFACE delete
937 MODULE PROCEDURE vol7d_var_delete
938END INTERFACE
939
940!> Operatore logico di uguaglianza tra oggetti della classe vol7d_var.
941!! Funziona anche per
942!! confronti di tipo array-array (qualsiasi n. di dimensioni) e di tipo
943!! scalare-vettore(1-d) (ma non vettore(1-d)-scalare o tra array con più
944!! di 1 dimensione e scalari).
945INTERFACE OPERATOR (==)
946 MODULE PROCEDURE vol7d_var_eq
947END INTERFACE
948
949!> Operatore logico di disuguaglianza tra oggetti della classe vol7d_var.
950!! Funziona anche per
951!! confronti di tipo array-array (qualsiasi n. di dimensioni) e di tipo
952!! scalare-vettore(1-d) (ma non vettore(1-d)-scalare o tra array con più
953!! di 1 dimensione e scalari).
954INTERFACE OPERATOR (/=)
955 MODULE PROCEDURE vol7d_var_ne, vol7d_var_nesv
956END INTERFACE
957
958!> to be documented
959INTERFACE c_e
960 MODULE PROCEDURE vol7d_var_c_e
961END INTERFACE
962
963#define VOL7D_POLY_TYPE TYPE(vol7d_var)
964#define VOL7D_POLY_TYPES _var
965#include "array_utilities_pre.F90"
966
967!> \brief display on the screen a brief content of object
968INTERFACE display
969 MODULE PROCEDURE display_var, display_var_vect
970END INTERFACE
971
972
973TYPE vol7d_var_features
974 TYPE(vol7d_var) :: var !< the variable (only btable is relevant)
975 REAL :: posdef !< if not missing, minimum physically reasonable value for the variable
976 INTEGER :: vartype !< type of variable, one of the var_* constants
977END TYPE vol7d_var_features
978
979TYPE(vol7d_var_features),ALLOCATABLE :: var_features(:)
980
981! constants for vol7d_vartype
982INTEGER,PARAMETER :: var_ord=0 !< unclassified variable (vol7d_vartype function)
983INTEGER,PARAMETER :: var_dir360=1 !< direction in degrees (vol7d_vartype function)
984INTEGER,PARAMETER :: var_press=2 !< pressure in Pa (vol7d_vartype function)
985INTEGER,PARAMETER :: var_ucomp=3 !< u component of a vector field (vol7d_vartype function)
986INTEGER,PARAMETER :: var_vcomp=4 !< v component of a vector field (vol7d_vartype function)
987INTEGER,PARAMETER :: var_wcomp=5 !< w component of a vector field (vol7d_vartype function)
988
989
990CONTAINS
991
992!> Inizializza un oggetto \a vol7d_var con i parametri opzionali forniti.
993!! Se non viene passato nessun parametro opzionale l'oggetto è
994!! inizializzato a valore mancante.
995!! I membri \a r, \a d, \a i, \a b, \a c non possono essere assegnati
996!! tramite costruttore, ma solo direttamente.
997elemental SUBROUTINE vol7d_var_init(this, btable, description, unit, scalefactor)
998TYPE(vol7d_var),INTENT(INOUT) :: this !< oggetto da inizializzare
999CHARACTER(len=*),INTENT(in),OPTIONAL :: btable !< codice della variabile
1000CHARACTER(len=*),INTENT(in),OPTIONAL :: description !< descrizione della variabile
1001CHARACTER(len=*),INTENT(in),OPTIONAL :: unit !< unità di misura
1002INTEGER,INTENT(in),OPTIONAL :: scalefactor !< decimali nella rappresentazione intera e character
1003
1004IF (PRESENT(btable)) THEN
1005 this%btable = btable
1006ELSE
1007 this%btable = cmiss
1008 this%description = cmiss
1009 this%unit = cmiss
1010 this%scalefactor = imiss
1011 RETURN
1012ENDIF
1013IF (PRESENT(description)) THEN
1014 this%description = description
1015ELSE
1016 this%description = cmiss
1017ENDIF
1018IF (PRESENT(unit)) THEN
1019 this%unit = unit
1020ELSE
1021 this%unit = cmiss
1022ENDIF
1023if (present(scalefactor)) then
1024 this%scalefactor = scalefactor
1025else
1026 this%scalefactor = imiss
1027endif
1028
1029this%r = -1
1030this%d = -1
1031this%i = -1
1032this%b = -1
1033this%c = -1
1034
1035END SUBROUTINE vol7d_var_init
1036
1037
1038ELEMENTAL FUNCTION vol7d_var_new(btable, description, unit, scalefactor) RESULT(this)
1039CHARACTER(len=*),INTENT(in),OPTIONAL :: btable !< codice della variabile
1040CHARACTER(len=*),INTENT(in),OPTIONAL :: description !< descrizione della variabile
1041CHARACTER(len=*),INTENT(in),OPTIONAL :: unit !< unità di misura
1042INTEGER,INTENT(in),OPTIONAL :: scalefactor !< decimali nella rappresentazione intera e character
1043
1044TYPE(vol7d_var) :: this
1045
1046CALL init(this, btable, description, unit, scalefactor)
1047
1048END FUNCTION vol7d_var_new
1049
1050
1051!> Distrugge l'oggetto in maniera pulita, assegnandogli un valore mancante.
1052elemental SUBROUTINE vol7d_var_delete(this)
1053TYPE(vol7d_var),INTENT(INOUT) :: this !< oggetto da distruggre
1054
1055this%btable = cmiss
1056this%description = cmiss
1057this%unit = cmiss
1058this%scalefactor = imiss
1059
1060END SUBROUTINE vol7d_var_delete
1061
1062
1063ELEMENTAL FUNCTION vol7d_var_eq(this, that) RESULT(res)
1064TYPE(vol7d_var),INTENT(IN) :: this, that
1065LOGICAL :: res
1066
1067res = this%btable == that%btable
1068
1069END FUNCTION vol7d_var_eq
1070
1071
1072ELEMENTAL FUNCTION vol7d_var_ne(this, that) RESULT(res)
1073TYPE(vol7d_var),INTENT(IN) :: this, that
1074LOGICAL :: res
1075
1076res = .NOT.(this == that)
1077
1078END FUNCTION vol7d_var_ne
1079
1080
1081FUNCTION vol7d_var_nesv(this, that) RESULT(res)
1082TYPE(vol7d_var),INTENT(IN) :: this, that(:)
1083LOGICAL :: res(SIZE(that))
1084
1085INTEGER :: i
1086
1087DO i = 1, SIZE(that)
1088 res(i) = .NOT.(this == that(i))
1089ENDDO
1090
1091END FUNCTION vol7d_var_nesv
1092
1093
1094
1095!> \brief display on the screen a brief content of vol7d_var object
1096subroutine display_var(this)
1097
1098TYPE(vol7d_var),INTENT(in) :: this !< vol7d_var object to display
1099
1100print*,"VOL7DVAR: ",this%btable,trim(this%description)," : ",this%unit,&
1101 " scale factor",this%scalefactor
1102
1103end subroutine display_var
1104
1105
1106!> \brief display on the screen a brief content of vector of vol7d_var object
1107subroutine display_var_vect(this)
1108
1109TYPE(vol7d_var),INTENT(in) :: this(:) !< vol7d_var vector object to display
1110integer :: i
1111
1112do i=1,size(this)
1113 call display_var(this(i))
1114end do
1115
1116end subroutine display_var_vect
1117
1118FUNCTION vol7d_var_c_e(this) RESULT(c_e)
1119TYPE(vol7d_var),INTENT(IN) :: this
1120LOGICAL :: c_e
1121c_e = this /= vol7d_var_miss
1122END FUNCTION vol7d_var_c_e
1123
1124
1125!> Initialise the global table of variable features.
1126!! This subroutine reads the table of variable features from an
1127!! external file and stores it in a global array. It has to be called
1128!! once at the beginning of the program. At the moment it gives access
1129!! to the information about type of variable and positive
1130!! definitness. The table is based on the unique bufr-like variable
1131!! table. The table is contained in the csv file `vargrib.csv`.
1132!! It is not harmful to call this subroutine multiple times.
1133SUBROUTINE vol7d_var_features_init()
1134INTEGER :: un, i, n
1135TYPE(csv_record) :: csv
1136CHARACTER(len=1024) :: line
1137
1138IF (ALLOCATED(var_features)) RETURN
1139
1140un = open_package_file('varbufr.csv', filetype_data)
1141n=0
1142DO WHILE(.true.)
1143 READ(un,*,END=100)
1144 n = n + 1
1145ENDDO
1146
1147100 CONTINUE
1148
1149rewind(un)
1150ALLOCATE(var_features(n))
1151
1152DO i = 1, n
1153 READ(un,'(A)',END=200)line
1154 CALL init(csv, line)
1155 CALL csv_record_getfield(csv, var_features(i)%var%btable)
1156 CALL csv_record_getfield(csv)
1157 CALL csv_record_getfield(csv)
1158 CALL csv_record_getfield(csv, var_features(i)%posdef)
1159 CALL csv_record_getfield(csv, var_features(i)%vartype)
1160 CALL delete(csv)
1161ENDDO
1162
1163200 CONTINUE
1164CLOSE(un)
1165
1166END SUBROUTINE vol7d_var_features_init
1167
1168
1169!> Deallocate the global table of variable features.
1170!! This subroutine deallocates the table of variable features
1171!! allocated in the `vol7d_var_features_init` subroutine.
1172SUBROUTINE vol7d_var_features_delete()
1173IF (ALLOCATED(var_features)) DEALLOCATE(var_features)
1174END SUBROUTINE vol7d_var_features_delete
1175
1176
1177!> Return the physical type of the variable.
1178!! Returns a rough classification of the variable depending on the
1179!! physical parameter it represents. The result is one of the
1180!! constants vartype_* defined in the module. To be extended.
1181!! In order for this to work, the subroutine \a
1182!! vol7d_var_features_init has to be preliminary called.
1183ELEMENTAL FUNCTION vol7d_var_features_vartype(this) RESULT(vartype)
1184TYPE(vol7d_var),INTENT(in) :: this !< vol7d_var object to be tested
1185INTEGER :: vartype
1186
1187INTEGER :: i
1188
1189vartype = imiss
1190
1191IF (ALLOCATED(var_features)) THEN
1192 DO i = 1, SIZE(var_features)
1193 IF (this == var_features(i)%var) THEN
1194 vartype = var_features(i)%vartype
1195 RETURN
1196 ENDIF
1197 ENDDO
1198ENDIF
1199
1200END FUNCTION vol7d_var_features_vartype
1201
1202
1203!> Apply a positive definite flag to a variable.
1204!! This subroutine resets the value of a variable depending on its
1205!! positive definite flag defined in the associated \a c_func object.
1206!! The \a c_func object can be obtained for example by the \a convert
1207!! (interfaced to vargrib2varbufr_convert) function. The value is
1208!! reset to the maximum between the value itsel and and 0 (or the
1209!! value set in \a c_func%posdef. These values are set from the
1210!! vargrib2bufr.csv file.
1211!! In order for this to work, the subroutine \a
1212!! vol7d_var_features_init has to be preliminary called.
1213ELEMENTAL SUBROUTINE vol7d_var_features_posdef_apply(this, val)
1214TYPE(vol7d_var),INTENT(in) :: this !< vol7d_var object to be reset
1215REAL,INTENT(inout) :: val !< value to be reset, it is reset in place
1216
1217INTEGER :: i
1218
1219IF (ALLOCATED(var_features)) THEN
1220 DO i = 1, SIZE(var_features)
1221 IF (this == var_features(i)%var) THEN
1222 IF (c_e(var_features(i)%posdef)) val = max(var_features(i)%posdef, val)
1223 RETURN
1224 ENDIF
1225 ENDDO
1226ENDIF
1227
1228END SUBROUTINE vol7d_var_features_posdef_apply
1229
1230
1231!> Return the physical type of the variable.
1232!! Returns a rough classification of the variable depending on the
1233!! physical parameter it represents. The result is one of the
1234!! constants vartype_* defined in the module. To be extended.
1235ELEMENTAL FUNCTION vol7d_vartype(this) RESULT(vartype)
1236TYPE(vol7d_var),INTENT(in) :: this !< vol7d_var object to be tested
1237
1238INTEGER :: vartype
1239
1240vartype = var_ord
1241SELECT CASE(this%btable)
1242CASE('B01012', 'B11001', 'B11043', 'B22001') ! direction, degree true
1243 vartype = var_dir360
1244CASE('B07004', 'B10004', 'B10051', 'B10060') ! pressure, Pa
1245 vartype = var_press
1246CASE('B11003', 'B11200') ! u-component
1247 vartype = var_ucomp
1248CASE('B11004', 'B11201') ! v-component
1249 vartype = var_vcomp
1250CASE('B11005', 'B11006') ! w-component
1251 vartype = var_wcomp
1252END SELECT
1253
1254END FUNCTION vol7d_vartype
1255
1256
1257#include "array_utilities_inc.F90"
1258
1259
1260END 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.