libsim Versione 7.2.0

◆ 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
894MODULE vol7d_var_class
895USE kinds
898IMPLICIT NONE
899
908TYPE vol7d_var
909 CHARACTER(len=10) :: btable=cmiss
910 CHARACTER(len=65) :: description=cmiss
911 CHARACTER(len=24) :: unit=cmiss
912 INTEGER :: scalefactor=imiss
913
914 INTEGER :: r=imiss
915 INTEGER :: d=imiss
916 INTEGER :: i=imiss
917 INTEGER :: b=imiss
918 INTEGER :: c=imiss
919 INTEGER :: gribhint(4)=imiss
920END TYPE vol7d_var
921
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
930INTERFACE init
931 MODULE PROCEDURE vol7d_var_init
932END INTERFACE
933
936INTERFACE delete
937 MODULE PROCEDURE vol7d_var_delete
938END INTERFACE
939
945INTERFACE OPERATOR (==)
946 MODULE PROCEDURE vol7d_var_eq
947END INTERFACE
948
954INTERFACE OPERATOR (/=)
955 MODULE PROCEDURE vol7d_var_ne, vol7d_var_nesv
956END INTERFACE
957
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
968INTERFACE display
969 MODULE PROCEDURE display_var, display_var_vect
970END INTERFACE
971
972
973TYPE vol7d_var_features
974 TYPE(vol7d_var) :: var
975 REAL :: posdef
976 INTEGER :: vartype
977END TYPE vol7d_var_features
978
979TYPE(vol7d_var_features),ALLOCATABLE :: var_features(:)
980
981! constants for vol7d_vartype
982INTEGER,PARAMETER :: var_ord=0
983INTEGER,PARAMETER :: var_dir360=1
984INTEGER,PARAMETER :: var_press=2
985INTEGER,PARAMETER :: var_ucomp=3
986INTEGER,PARAMETER :: var_vcomp=4
987INTEGER,PARAMETER :: var_wcomp=5
988
989
990CONTAINS
991
997elemental SUBROUTINE vol7d_var_init(this, btable, description, unit, scalefactor)
998TYPE(vol7d_var),INTENT(INOUT) :: this
999CHARACTER(len=*),INTENT(in),OPTIONAL :: btable
1000CHARACTER(len=*),INTENT(in),OPTIONAL :: description
1001CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
1002INTEGER,INTENT(in),OPTIONAL :: scalefactor
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
1040CHARACTER(len=*),INTENT(in),OPTIONAL :: description
1041CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
1042INTEGER,INTENT(in),OPTIONAL :: scalefactor
1043
1044TYPE(vol7d_var) :: this
1045
1046CALL init(this, btable, description, unit, scalefactor)
1047
1048END FUNCTION vol7d_var_new
1049
1050
1052elemental SUBROUTINE vol7d_var_delete(this)
1053TYPE(vol7d_var),INTENT(INOUT) :: this
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
1096subroutine display_var(this)
1097
1098TYPE(vol7d_var),INTENT(in) :: this
1099
1100print*,"VOL7DVAR: ",this%btable,trim(this%description)," : ",this%unit,&
1101 " scale factor",this%scalefactor
1102
1103end subroutine display_var
1104
1105
1107subroutine display_var_vect(this)
1108
1109TYPE(vol7d_var),INTENT(in) :: this(:)
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
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
1172SUBROUTINE vol7d_var_features_delete()
1173IF (ALLOCATED(var_features)) DEALLOCATE(var_features)
1174END SUBROUTINE vol7d_var_features_delete
1175
1176
1183ELEMENTAL FUNCTION vol7d_var_features_vartype(this) RESULT(vartype)
1184TYPE(vol7d_var),INTENT(in) :: this
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
1213ELEMENTAL SUBROUTINE vol7d_var_features_posdef_apply(this, val)
1214TYPE(vol7d_var),INTENT(in) :: this
1215REAL,INTENT(inout) :: val
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
1235ELEMENTAL FUNCTION vol7d_vartype(this) RESULT(vartype)
1236TYPE(vol7d_var),INTENT(in) :: this
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.