libsim Versione 7.2.6

◆ map_inv_distinct_var()

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

map inv distinct

Definizione alla linea 966 del file vol7d_var_class.F90.

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