libsim Versione 7.1.11

◆ 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 972 del file vol7d_var_class.F90.

974! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
975! authors:
976! Davide Cesari <dcesari@arpa.emr.it>
977! Paolo Patruno <ppatruno@arpa.emr.it>
978
979! This program is free software; you can redistribute it and/or
980! modify it under the terms of the GNU General Public License as
981! published by the Free Software Foundation; either version 2 of
982! the License, or (at your option) any later version.
983
984! This program is distributed in the hope that it will be useful,
985! but WITHOUT ANY WARRANTY; without even the implied warranty of
986! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
987! GNU General Public License for more details.
988
989! You should have received a copy of the GNU General Public License
990! along with this program. If not, see <http://www.gnu.org/licenses/>.
991#include "config.h"
992
997MODULE vol7d_var_class
998USE kinds
1001IMPLICIT NONE
1002
1011TYPE vol7d_var
1012 CHARACTER(len=10) :: btable=cmiss
1013 CHARACTER(len=65) :: description=cmiss
1014 CHARACTER(len=24) :: unit=cmiss
1015 INTEGER :: scalefactor=imiss
1016
1017 INTEGER :: r=imiss
1018 INTEGER :: d=imiss
1019 INTEGER :: i=imiss
1020 INTEGER :: b=imiss
1021 INTEGER :: c=imiss
1022 INTEGER :: gribhint(4)=imiss
1023END TYPE vol7d_var
1024
1026TYPE(vol7d_var),PARAMETER :: vol7d_var_miss= &
1027 vol7d_var(cmiss,cmiss,cmiss,imiss,imiss,imiss,imiss,imiss,imiss, &
1028 (/imiss,imiss,imiss,imiss/))
1029
1033INTERFACE init
1034 MODULE PROCEDURE vol7d_var_init
1035END INTERFACE
1036
1039INTERFACE delete
1040 MODULE PROCEDURE vol7d_var_delete
1041END INTERFACE
1042
1048INTERFACE OPERATOR (==)
1049 MODULE PROCEDURE vol7d_var_eq
1050END INTERFACE
1051
1057INTERFACE OPERATOR (/=)
1058 MODULE PROCEDURE vol7d_var_ne, vol7d_var_nesv
1059END INTERFACE
1060
1062INTERFACE c_e
1063 MODULE PROCEDURE vol7d_var_c_e
1064END INTERFACE
1065
1066#define VOL7D_POLY_TYPE TYPE(vol7d_var)
1067#define VOL7D_POLY_TYPES _var
1068#include "array_utilities_pre.F90"
1069
1071INTERFACE display
1072 MODULE PROCEDURE display_var, display_var_vect
1073END INTERFACE
1074
1075
1076TYPE vol7d_var_features
1077 TYPE(vol7d_var) :: var
1078 REAL :: posdef
1079 INTEGER :: vartype
1080END TYPE vol7d_var_features
1081
1082TYPE(vol7d_var_features),ALLOCATABLE :: var_features(:)
1083
1084! constants for vol7d_vartype
1085INTEGER,PARAMETER :: var_ord=0
1086INTEGER,PARAMETER :: var_dir360=1
1087INTEGER,PARAMETER :: var_press=2
1088INTEGER,PARAMETER :: var_ucomp=3
1089INTEGER,PARAMETER :: var_vcomp=4
1090INTEGER,PARAMETER :: var_wcomp=5
1091
1092
1093CONTAINS
1094
1100elemental SUBROUTINE vol7d_var_init(this, btable, description, unit, scalefactor)
1101TYPE(vol7d_var),INTENT(INOUT) :: this
1102CHARACTER(len=*),INTENT(in),OPTIONAL :: btable
1103CHARACTER(len=*),INTENT(in),OPTIONAL :: description
1104CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
1105INTEGER,INTENT(in),OPTIONAL :: scalefactor
1106
1107IF (PRESENT(btable)) THEN
1108 this%btable = btable
1109ELSE
1110 this%btable = cmiss
1111 this%description = cmiss
1112 this%unit = cmiss
1113 this%scalefactor = imiss
1114 RETURN
1115ENDIF
1116IF (PRESENT(description)) THEN
1117 this%description = description
1118ELSE
1119 this%description = cmiss
1120ENDIF
1121IF (PRESENT(unit)) THEN
1122 this%unit = unit
1123ELSE
1124 this%unit = cmiss
1125ENDIF
1126if (present(scalefactor)) then
1127 this%scalefactor = scalefactor
1128else
1129 this%scalefactor = imiss
1130endif
1131
1132this%r = -1
1133this%d = -1
1134this%i = -1
1135this%b = -1
1136this%c = -1
1137
1138END SUBROUTINE vol7d_var_init
1139
1140
1141ELEMENTAL FUNCTION vol7d_var_new(btable, description, unit, scalefactor) RESULT(this)
1142CHARACTER(len=*),INTENT(in),OPTIONAL :: btable
1143CHARACTER(len=*),INTENT(in),OPTIONAL :: description
1144CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
1145INTEGER,INTENT(in),OPTIONAL :: scalefactor
1146
1147TYPE(vol7d_var) :: this
1148
1149CALL init(this, btable, description, unit, scalefactor)
1150
1151END FUNCTION vol7d_var_new
1152
1153
1155elemental SUBROUTINE vol7d_var_delete(this)
1156TYPE(vol7d_var),INTENT(INOUT) :: this
1157
1158this%btable = cmiss
1159this%description = cmiss
1160this%unit = cmiss
1161this%scalefactor = imiss
1162
1163END SUBROUTINE vol7d_var_delete
1164
1165
1166ELEMENTAL FUNCTION vol7d_var_eq(this, that) RESULT(res)
1167TYPE(vol7d_var),INTENT(IN) :: this, that
1168LOGICAL :: res
1169
1170res = this%btable == that%btable
1171
1172END FUNCTION vol7d_var_eq
1173
1174
1175ELEMENTAL FUNCTION vol7d_var_ne(this, that) RESULT(res)
1176TYPE(vol7d_var),INTENT(IN) :: this, that
1177LOGICAL :: res
1178
1179res = .NOT.(this == that)
1180
1181END FUNCTION vol7d_var_ne
1182
1183
1184FUNCTION vol7d_var_nesv(this, that) RESULT(res)
1185TYPE(vol7d_var),INTENT(IN) :: this, that(:)
1186LOGICAL :: res(SIZE(that))
1187
1188INTEGER :: i
1189
1190DO i = 1, SIZE(that)
1191 res(i) = .NOT.(this == that(i))
1192ENDDO
1193
1194END FUNCTION vol7d_var_nesv
1195
1196
1197
1199subroutine display_var(this)
1200
1201TYPE(vol7d_var),INTENT(in) :: this
1202
1203print*,"VOL7DVAR: ",this%btable,trim(this%description)," : ",this%unit,&
1204 " scale factor",this%scalefactor
1205
1206end subroutine display_var
1207
1208
1210subroutine display_var_vect(this)
1211
1212TYPE(vol7d_var),INTENT(in) :: this(:)
1213integer :: i
1214
1215do i=1,size(this)
1216 call display_var(this(i))
1217end do
1218
1219end subroutine display_var_vect
1220
1221FUNCTION vol7d_var_c_e(this) RESULT(c_e)
1222TYPE(vol7d_var),INTENT(IN) :: this
1223LOGICAL :: c_e
1224c_e = this /= vol7d_var_miss
1225END FUNCTION vol7d_var_c_e
1226
1227
1236SUBROUTINE vol7d_var_features_init()
1237INTEGER :: un, i, n
1238TYPE(csv_record) :: csv
1239CHARACTER(len=1024) :: line
1240
1241IF (ALLOCATED(var_features)) RETURN
1242
1243un = open_package_file('varbufr.csv', filetype_data)
1244n=0
1245DO WHILE(.true.)
1246 READ(un,*,END=100)
1247 n = n + 1
1248ENDDO
1249
1250100 CONTINUE
1251
1252rewind(un)
1253ALLOCATE(var_features(n))
1254
1255DO i = 1, n
1256 READ(un,'(A)',END=200)line
1257 CALL init(csv, line)
1258 CALL csv_record_getfield(csv, var_features(i)%var%btable)
1259 CALL csv_record_getfield(csv)
1260 CALL csv_record_getfield(csv)
1261 CALL csv_record_getfield(csv, var_features(i)%posdef)
1262 CALL csv_record_getfield(csv, var_features(i)%vartype)
1263 CALL delete(csv)
1264ENDDO
1265
1266200 CONTINUE
1267CLOSE(un)
1268
1269END SUBROUTINE vol7d_var_features_init
1270
1271
1275SUBROUTINE vol7d_var_features_delete()
1276IF (ALLOCATED(var_features)) DEALLOCATE(var_features)
1277END SUBROUTINE vol7d_var_features_delete
1278
1279
1286ELEMENTAL FUNCTION vol7d_var_features_vartype(this) RESULT(vartype)
1287TYPE(vol7d_var),INTENT(in) :: this
1288INTEGER :: vartype
1289
1290INTEGER :: i
1291
1292vartype = imiss
1293
1294IF (ALLOCATED(var_features)) THEN
1295 DO i = 1, SIZE(var_features)
1296 IF (this == var_features(i)%var) THEN
1297 vartype = var_features(i)%vartype
1298 RETURN
1299 ENDIF
1300 ENDDO
1301ENDIF
1302
1303END FUNCTION vol7d_var_features_vartype
1304
1305
1316ELEMENTAL SUBROUTINE vol7d_var_features_posdef_apply(this, val)
1317TYPE(vol7d_var),INTENT(in) :: this
1318REAL,INTENT(inout) :: val
1319
1320INTEGER :: i
1321
1322IF (ALLOCATED(var_features)) THEN
1323 DO i = 1, SIZE(var_features)
1324 IF (this == var_features(i)%var) THEN
1325 IF (c_e(var_features(i)%posdef)) val = max(var_features(i)%posdef, val)
1326 RETURN
1327 ENDIF
1328 ENDDO
1329ENDIF
1330
1331END SUBROUTINE vol7d_var_features_posdef_apply
1332
1333
1338ELEMENTAL FUNCTION vol7d_vartype(this) RESULT(vartype)
1339TYPE(vol7d_var),INTENT(in) :: this
1340
1341INTEGER :: vartype
1342
1343vartype = var_ord
1344SELECT CASE(this%btable)
1345CASE('B01012', 'B11001', 'B11043', 'B22001') ! direction, degree true
1346 vartype = var_dir360
1347CASE('B07004', 'B10004', 'B10051', 'B10060') ! pressure, Pa
1348 vartype = var_press
1349CASE('B11003', 'B11200') ! u-component
1350 vartype = var_ucomp
1351CASE('B11004', 'B11201') ! v-component
1352 vartype = var_vcomp
1353CASE('B11005', 'B11006') ! w-component
1354 vartype = var_wcomp
1355END SELECT
1356
1357END FUNCTION vol7d_vartype
1358
1359
1360#include "array_utilities_inc.F90"
1361
1362
1363END 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:251
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.