libsim Versione 7.2.1
|
◆ map_inv_distinct_var()
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
995IMPLICIT NONE
996
1006 CHARACTER(len=10) :: btable=cmiss
1007 CHARACTER(len=65) :: description=cmiss
1008 CHARACTER(len=24) :: unit=cmiss
1009 INTEGER :: scalefactor=imiss
1010
1011 INTEGER :: r=imiss
1012 INTEGER :: d=imiss
1013 INTEGER :: i=imiss
1014 INTEGER :: b=imiss
1015 INTEGER :: c=imiss
1016 INTEGER :: gribhint(4)=imiss
1018
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
1028 MODULE PROCEDURE vol7d_var_init
1029END INTERFACE
1030
1034 MODULE PROCEDURE vol7d_var_delete
1035END INTERFACE
1036
1042INTERFACE OPERATOR (==)
1043 MODULE PROCEDURE vol7d_var_eq
1044END INTERFACE
1045
1051INTERFACE OPERATOR (/=)
1052 MODULE PROCEDURE vol7d_var_ne, vol7d_var_nesv
1053END INTERFACE
1054
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
1066 MODULE PROCEDURE display_var, display_var_vect
1067END INTERFACE
1068
1069
1070TYPE vol7d_var_features
1071 TYPE(vol7d_var) :: var
1072 REAL :: posdef
1073 INTEGER :: vartype
1074END TYPE vol7d_var_features
1075
1076TYPE(vol7d_var_features),ALLOCATABLE :: var_features(:)
1077
1078! constants for vol7d_vartype
1079INTEGER,PARAMETER :: var_ord=0
1080INTEGER,PARAMETER :: var_dir360=1
1081INTEGER,PARAMETER :: var_press=2
1082INTEGER,PARAMETER :: var_ucomp=3
1083INTEGER,PARAMETER :: var_vcomp=4
1084INTEGER,PARAMETER :: var_wcomp=5
1085
1086
1087CONTAINS
1088
1094elemental SUBROUTINE vol7d_var_init(this, btable, description, unit, scalefactor)
1095TYPE(vol7d_var),INTENT(INOUT) :: this
1096CHARACTER(len=*),INTENT(in),OPTIONAL :: btable
1097CHARACTER(len=*),INTENT(in),OPTIONAL :: description
1098CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
1099INTEGER,INTENT(in),OPTIONAL :: scalefactor
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
1137CHARACTER(len=*),INTENT(in),OPTIONAL :: description
1138CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
1139INTEGER,INTENT(in),OPTIONAL :: scalefactor
1140
1141TYPE(vol7d_var) :: this
1142
1144
1145END FUNCTION vol7d_var_new
1146
1147
1149elemental SUBROUTINE vol7d_var_delete(this)
1150TYPE(vol7d_var),INTENT(INOUT) :: this
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
1193subroutine display_var(this)
1194
1195TYPE(vol7d_var),INTENT(in) :: this
1196
1197print*,"VOL7DVAR: ",this%btable,trim(this%description)," : ",this%unit,&
1198 " scale factor",this%scalefactor
1199
1200end subroutine display_var
1201
1202
1204subroutine display_var_vect(this)
1205
1206TYPE(vol7d_var),INTENT(in) :: this(:)
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
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
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)
1258ENDDO
1259
1260200 CONTINUE
1261CLOSE(un)
1262
1263END SUBROUTINE vol7d_var_features_init
1264
1265
1269SUBROUTINE vol7d_var_features_delete()
1270IF (ALLOCATED(var_features)) DEALLOCATE(var_features)
1271END SUBROUTINE vol7d_var_features_delete
1272
1273
1280ELEMENTAL FUNCTION vol7d_var_features_vartype(this) RESULT(vartype)
1281TYPE(vol7d_var),INTENT(in) :: this
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
1310ELEMENTAL SUBROUTINE vol7d_var_features_posdef_apply(this, val)
1311TYPE(vol7d_var),INTENT(in) :: this
1312REAL,INTENT(inout) :: val
1313
1314INTEGER :: i
1315
1316IF (ALLOCATED(var_features)) THEN
1317 DO i = 1, SIZE(var_features)
1318 IF (this == var_features(i)%var) THEN
1320 RETURN
1321 ENDIF
1322 ENDDO
1323ENDIF
1324
1325END SUBROUTINE vol7d_var_features_posdef_apply
1326
1327
1332ELEMENTAL FUNCTION vol7d_vartype(this) RESULT(vartype)
1333TYPE(vol7d_var),INTENT(in) :: this
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
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 |