libsim Versione 7.1.11

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

877! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
878! authors:
879! Davide Cesari <dcesari@arpa.emr.it>
880! Paolo Patruno <ppatruno@arpa.emr.it>
881
882! This program is free software; you can redistribute it and/or
883! modify it under the terms of the GNU General Public License as
884! published by the Free Software Foundation; either version 2 of
885! the License, or (at your option) any later version.
886
887! This program is distributed in the hope that it will be useful,
888! but WITHOUT ANY WARRANTY; without even the implied warranty of
889! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
890! GNU General Public License for more details.
891
892! You should have received a copy of the GNU General Public License
893! along with this program. If not, see <http://www.gnu.org/licenses/>.
894#include "config.h"
895
900MODULE vol7d_var_class
901USE kinds
904IMPLICIT NONE
905
914TYPE vol7d_var
915 CHARACTER(len=10) :: btable=cmiss
916 CHARACTER(len=65) :: description=cmiss
917 CHARACTER(len=24) :: unit=cmiss
918 INTEGER :: scalefactor=imiss
919
920 INTEGER :: r=imiss
921 INTEGER :: d=imiss
922 INTEGER :: i=imiss
923 INTEGER :: b=imiss
924 INTEGER :: c=imiss
925 INTEGER :: gribhint(4)=imiss
926END TYPE vol7d_var
927
929TYPE(vol7d_var),PARAMETER :: vol7d_var_miss= &
930 vol7d_var(cmiss,cmiss,cmiss,imiss,imiss,imiss,imiss,imiss,imiss, &
931 (/imiss,imiss,imiss,imiss/))
932
936INTERFACE init
937 MODULE PROCEDURE vol7d_var_init
938END INTERFACE
939
942INTERFACE delete
943 MODULE PROCEDURE vol7d_var_delete
944END INTERFACE
945
951INTERFACE OPERATOR (==)
952 MODULE PROCEDURE vol7d_var_eq
953END INTERFACE
954
960INTERFACE OPERATOR (/=)
961 MODULE PROCEDURE vol7d_var_ne, vol7d_var_nesv
962END INTERFACE
963
965INTERFACE c_e
966 MODULE PROCEDURE vol7d_var_c_e
967END INTERFACE
968
969#define VOL7D_POLY_TYPE TYPE(vol7d_var)
970#define VOL7D_POLY_TYPES _var
971#include "array_utilities_pre.F90"
972
974INTERFACE display
975 MODULE PROCEDURE display_var, display_var_vect
976END INTERFACE
977
978
979TYPE vol7d_var_features
980 TYPE(vol7d_var) :: var
981 REAL :: posdef
982 INTEGER :: vartype
983END TYPE vol7d_var_features
984
985TYPE(vol7d_var_features),ALLOCATABLE :: var_features(:)
986
987! constants for vol7d_vartype
988INTEGER,PARAMETER :: var_ord=0
989INTEGER,PARAMETER :: var_dir360=1
990INTEGER,PARAMETER :: var_press=2
991INTEGER,PARAMETER :: var_ucomp=3
992INTEGER,PARAMETER :: var_vcomp=4
993INTEGER,PARAMETER :: var_wcomp=5
994
995
996CONTAINS
997
1003elemental SUBROUTINE vol7d_var_init(this, btable, description, unit, scalefactor)
1004TYPE(vol7d_var),INTENT(INOUT) :: this
1005CHARACTER(len=*),INTENT(in),OPTIONAL :: btable
1006CHARACTER(len=*),INTENT(in),OPTIONAL :: description
1007CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
1008INTEGER,INTENT(in),OPTIONAL :: scalefactor
1009
1010IF (PRESENT(btable)) THEN
1011 this%btable = btable
1012ELSE
1013 this%btable = cmiss
1014 this%description = cmiss
1015 this%unit = cmiss
1016 this%scalefactor = imiss
1017 RETURN
1018ENDIF
1019IF (PRESENT(description)) THEN
1020 this%description = description
1021ELSE
1022 this%description = cmiss
1023ENDIF
1024IF (PRESENT(unit)) THEN
1025 this%unit = unit
1026ELSE
1027 this%unit = cmiss
1028ENDIF
1029if (present(scalefactor)) then
1030 this%scalefactor = scalefactor
1031else
1032 this%scalefactor = imiss
1033endif
1034
1035this%r = -1
1036this%d = -1
1037this%i = -1
1038this%b = -1
1039this%c = -1
1040
1041END SUBROUTINE vol7d_var_init
1042
1043
1044ELEMENTAL FUNCTION vol7d_var_new(btable, description, unit, scalefactor) RESULT(this)
1045CHARACTER(len=*),INTENT(in),OPTIONAL :: btable
1046CHARACTER(len=*),INTENT(in),OPTIONAL :: description
1047CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
1048INTEGER,INTENT(in),OPTIONAL :: scalefactor
1049
1050TYPE(vol7d_var) :: this
1051
1052CALL init(this, btable, description, unit, scalefactor)
1053
1054END FUNCTION vol7d_var_new
1055
1056
1058elemental SUBROUTINE vol7d_var_delete(this)
1059TYPE(vol7d_var),INTENT(INOUT) :: this
1060
1061this%btable = cmiss
1062this%description = cmiss
1063this%unit = cmiss
1064this%scalefactor = imiss
1065
1066END SUBROUTINE vol7d_var_delete
1067
1068
1069ELEMENTAL FUNCTION vol7d_var_eq(this, that) RESULT(res)
1070TYPE(vol7d_var),INTENT(IN) :: this, that
1071LOGICAL :: res
1072
1073res = this%btable == that%btable
1074
1075END FUNCTION vol7d_var_eq
1076
1077
1078ELEMENTAL FUNCTION vol7d_var_ne(this, that) RESULT(res)
1079TYPE(vol7d_var),INTENT(IN) :: this, that
1080LOGICAL :: res
1081
1082res = .NOT.(this == that)
1083
1084END FUNCTION vol7d_var_ne
1085
1086
1087FUNCTION vol7d_var_nesv(this, that) RESULT(res)
1088TYPE(vol7d_var),INTENT(IN) :: this, that(:)
1089LOGICAL :: res(SIZE(that))
1090
1091INTEGER :: i
1092
1093DO i = 1, SIZE(that)
1094 res(i) = .NOT.(this == that(i))
1095ENDDO
1096
1097END FUNCTION vol7d_var_nesv
1098
1099
1100
1102subroutine display_var(this)
1103
1104TYPE(vol7d_var),INTENT(in) :: this
1105
1106print*,"VOL7DVAR: ",this%btable,trim(this%description)," : ",this%unit,&
1107 " scale factor",this%scalefactor
1108
1109end subroutine display_var
1110
1111
1113subroutine display_var_vect(this)
1114
1115TYPE(vol7d_var),INTENT(in) :: this(:)
1116integer :: i
1117
1118do i=1,size(this)
1119 call display_var(this(i))
1120end do
1121
1122end subroutine display_var_vect
1123
1124FUNCTION vol7d_var_c_e(this) RESULT(c_e)
1125TYPE(vol7d_var),INTENT(IN) :: this
1126LOGICAL :: c_e
1127c_e = this /= vol7d_var_miss
1128END FUNCTION vol7d_var_c_e
1129
1130
1139SUBROUTINE vol7d_var_features_init()
1140INTEGER :: un, i, n
1141TYPE(csv_record) :: csv
1142CHARACTER(len=1024) :: line
1143
1144IF (ALLOCATED(var_features)) RETURN
1145
1146un = open_package_file('varbufr.csv', filetype_data)
1147n=0
1148DO WHILE(.true.)
1149 READ(un,*,END=100)
1150 n = n + 1
1151ENDDO
1152
1153100 CONTINUE
1154
1155rewind(un)
1156ALLOCATE(var_features(n))
1157
1158DO i = 1, n
1159 READ(un,'(A)',END=200)line
1160 CALL init(csv, line)
1161 CALL csv_record_getfield(csv, var_features(i)%var%btable)
1162 CALL csv_record_getfield(csv)
1163 CALL csv_record_getfield(csv)
1164 CALL csv_record_getfield(csv, var_features(i)%posdef)
1165 CALL csv_record_getfield(csv, var_features(i)%vartype)
1166 CALL delete(csv)
1167ENDDO
1168
1169200 CONTINUE
1170CLOSE(un)
1171
1172END SUBROUTINE vol7d_var_features_init
1173
1174
1178SUBROUTINE vol7d_var_features_delete()
1179IF (ALLOCATED(var_features)) DEALLOCATE(var_features)
1180END SUBROUTINE vol7d_var_features_delete
1181
1182
1189ELEMENTAL FUNCTION vol7d_var_features_vartype(this) RESULT(vartype)
1190TYPE(vol7d_var),INTENT(in) :: this
1191INTEGER :: vartype
1192
1193INTEGER :: i
1194
1195vartype = imiss
1196
1197IF (ALLOCATED(var_features)) THEN
1198 DO i = 1, SIZE(var_features)
1199 IF (this == var_features(i)%var) THEN
1200 vartype = var_features(i)%vartype
1201 RETURN
1202 ENDIF
1203 ENDDO
1204ENDIF
1205
1206END FUNCTION vol7d_var_features_vartype
1207
1208
1219ELEMENTAL SUBROUTINE vol7d_var_features_posdef_apply(this, val)
1220TYPE(vol7d_var),INTENT(in) :: this
1221REAL,INTENT(inout) :: val
1222
1223INTEGER :: i
1224
1225IF (ALLOCATED(var_features)) THEN
1226 DO i = 1, SIZE(var_features)
1227 IF (this == var_features(i)%var) THEN
1228 IF (c_e(var_features(i)%posdef)) val = max(var_features(i)%posdef, val)
1229 RETURN
1230 ENDIF
1231 ENDDO
1232ENDIF
1233
1234END SUBROUTINE vol7d_var_features_posdef_apply
1235
1236
1241ELEMENTAL FUNCTION vol7d_vartype(this) RESULT(vartype)
1242TYPE(vol7d_var),INTENT(in) :: this
1243
1244INTEGER :: vartype
1245
1246vartype = var_ord
1247SELECT CASE(this%btable)
1248CASE('B01012', 'B11001', 'B11043', 'B22001') ! direction, degree true
1249 vartype = var_dir360
1250CASE('B07004', 'B10004', 'B10051', 'B10060') ! pressure, Pa
1251 vartype = var_press
1252CASE('B11003', 'B11200') ! u-component
1253 vartype = var_ucomp
1254CASE('B11004', 'B11201') ! v-component
1255 vartype = var_vcomp
1256CASE('B11005', 'B11006') ! w-component
1257 vartype = var_wcomp
1258END SELECT
1259
1260END FUNCTION vol7d_vartype
1261
1262
1263#include "array_utilities_inc.F90"
1264
1265
1266END 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.