libsim Versione 7.1.11
|
◆ pack_distinct_var()
compatta gli elementi distinti di vect in un array Definizione alla linea 727 del file vol7d_var_class.F90. 729! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
730! authors:
731! Davide Cesari <dcesari@arpa.emr.it>
732! Paolo Patruno <ppatruno@arpa.emr.it>
733
734! This program is free software; you can redistribute it and/or
735! modify it under the terms of the GNU General Public License as
736! published by the Free Software Foundation; either version 2 of
737! the License, or (at your option) any later version.
738
739! This program is distributed in the hope that it will be useful,
740! but WITHOUT ANY WARRANTY; without even the implied warranty of
741! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
742! GNU General Public License for more details.
743
744! You should have received a copy of the GNU General Public License
745! along with this program. If not, see <http://www.gnu.org/licenses/>.
746#include "config.h"
747
756IMPLICIT NONE
757
767 CHARACTER(len=10) :: btable=cmiss
768 CHARACTER(len=65) :: description=cmiss
769 CHARACTER(len=24) :: unit=cmiss
770 INTEGER :: scalefactor=imiss
771
772 INTEGER :: r=imiss
773 INTEGER :: d=imiss
774 INTEGER :: i=imiss
775 INTEGER :: b=imiss
776 INTEGER :: c=imiss
777 INTEGER :: gribhint(4)=imiss
779
781TYPE(vol7d_var),PARAMETER :: vol7d_var_miss= &
782 vol7d_var(cmiss,cmiss,cmiss,imiss,imiss,imiss,imiss,imiss,imiss, &
783 (/imiss,imiss,imiss,imiss/))
784
789 MODULE PROCEDURE vol7d_var_init
790END INTERFACE
791
795 MODULE PROCEDURE vol7d_var_delete
796END INTERFACE
797
803INTERFACE OPERATOR (==)
804 MODULE PROCEDURE vol7d_var_eq
805END INTERFACE
806
812INTERFACE OPERATOR (/=)
813 MODULE PROCEDURE vol7d_var_ne, vol7d_var_nesv
814END INTERFACE
815
818 MODULE PROCEDURE vol7d_var_c_e
819END INTERFACE
820
821#define VOL7D_POLY_TYPE TYPE(vol7d_var)
822#define VOL7D_POLY_TYPES _var
823#include "array_utilities_pre.F90"
824
827 MODULE PROCEDURE display_var, display_var_vect
828END INTERFACE
829
830
831TYPE vol7d_var_features
832 TYPE(vol7d_var) :: var
833 REAL :: posdef
834 INTEGER :: vartype
835END TYPE vol7d_var_features
836
837TYPE(vol7d_var_features),ALLOCATABLE :: var_features(:)
838
839! constants for vol7d_vartype
840INTEGER,PARAMETER :: var_ord=0
841INTEGER,PARAMETER :: var_dir360=1
842INTEGER,PARAMETER :: var_press=2
843INTEGER,PARAMETER :: var_ucomp=3
844INTEGER,PARAMETER :: var_vcomp=4
845INTEGER,PARAMETER :: var_wcomp=5
846
847
848CONTAINS
849
855elemental SUBROUTINE vol7d_var_init(this, btable, description, unit, scalefactor)
856TYPE(vol7d_var),INTENT(INOUT) :: this
857CHARACTER(len=*),INTENT(in),OPTIONAL :: btable
858CHARACTER(len=*),INTENT(in),OPTIONAL :: description
859CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
860INTEGER,INTENT(in),OPTIONAL :: scalefactor
861
862IF (PRESENT(btable)) THEN
863 this%btable = btable
864ELSE
865 this%btable = cmiss
866 this%description = cmiss
867 this%unit = cmiss
868 this%scalefactor = imiss
869 RETURN
870ENDIF
871IF (PRESENT(description)) THEN
872 this%description = description
873ELSE
874 this%description = cmiss
875ENDIF
876IF (PRESENT(unit)) THEN
877 this%unit = unit
878ELSE
879 this%unit = cmiss
880ENDIF
881if (present(scalefactor)) then
882 this%scalefactor = scalefactor
883else
884 this%scalefactor = imiss
885endif
886
887this%r = -1
888this%d = -1
889this%i = -1
890this%b = -1
891this%c = -1
892
893END SUBROUTINE vol7d_var_init
894
895
896ELEMENTAL FUNCTION vol7d_var_new(btable, description, unit, scalefactor) RESULT(this)
897CHARACTER(len=*),INTENT(in),OPTIONAL :: btable
898CHARACTER(len=*),INTENT(in),OPTIONAL :: description
899CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
900INTEGER,INTENT(in),OPTIONAL :: scalefactor
901
902TYPE(vol7d_var) :: this
903
905
906END FUNCTION vol7d_var_new
907
908
910elemental SUBROUTINE vol7d_var_delete(this)
911TYPE(vol7d_var),INTENT(INOUT) :: this
912
913this%btable = cmiss
914this%description = cmiss
915this%unit = cmiss
916this%scalefactor = imiss
917
918END SUBROUTINE vol7d_var_delete
919
920
921ELEMENTAL FUNCTION vol7d_var_eq(this, that) RESULT(res)
922TYPE(vol7d_var),INTENT(IN) :: this, that
923LOGICAL :: res
924
925res = this%btable == that%btable
926
927END FUNCTION vol7d_var_eq
928
929
930ELEMENTAL FUNCTION vol7d_var_ne(this, that) RESULT(res)
931TYPE(vol7d_var),INTENT(IN) :: this, that
932LOGICAL :: res
933
934res = .NOT.(this == that)
935
936END FUNCTION vol7d_var_ne
937
938
939FUNCTION vol7d_var_nesv(this, that) RESULT(res)
940TYPE(vol7d_var),INTENT(IN) :: this, that(:)
941LOGICAL :: res(SIZE(that))
942
943INTEGER :: i
944
945DO i = 1, SIZE(that)
946 res(i) = .NOT.(this == that(i))
947ENDDO
948
949END FUNCTION vol7d_var_nesv
950
951
952
954subroutine display_var(this)
955
956TYPE(vol7d_var),INTENT(in) :: this
957
958print*,"VOL7DVAR: ",this%btable,trim(this%description)," : ",this%unit,&
959 " scale factor",this%scalefactor
960
961end subroutine display_var
962
963
965subroutine display_var_vect(this)
966
967TYPE(vol7d_var),INTENT(in) :: this(:)
968integer :: i
969
970do i=1,size(this)
971 call display_var(this(i))
972end do
973
974end subroutine display_var_vect
975
976FUNCTION vol7d_var_c_e(this) RESULT(c_e)
977TYPE(vol7d_var),INTENT(IN) :: this
978LOGICAL :: c_e
979c_e = this /= vol7d_var_miss
980END FUNCTION vol7d_var_c_e
981
982
991SUBROUTINE vol7d_var_features_init()
992INTEGER :: un, i, n
993TYPE(csv_record) :: csv
994CHARACTER(len=1024) :: line
995
996IF (ALLOCATED(var_features)) RETURN
997
998un = open_package_file('varbufr.csv', filetype_data)
999n=0
1000DO WHILE(.true.)
1001 READ(un,*,END=100)
1002 n = n + 1
1003ENDDO
1004
1005100 CONTINUE
1006
1007rewind(un)
1008ALLOCATE(var_features(n))
1009
1010DO i = 1, n
1011 READ(un,'(A)',END=200)line
1013 CALL csv_record_getfield(csv, var_features(i)%var%btable)
1014 CALL csv_record_getfield(csv)
1015 CALL csv_record_getfield(csv)
1016 CALL csv_record_getfield(csv, var_features(i)%posdef)
1017 CALL csv_record_getfield(csv, var_features(i)%vartype)
1019ENDDO
1020
1021200 CONTINUE
1022CLOSE(un)
1023
1024END SUBROUTINE vol7d_var_features_init
1025
1026
1030SUBROUTINE vol7d_var_features_delete()
1031IF (ALLOCATED(var_features)) DEALLOCATE(var_features)
1032END SUBROUTINE vol7d_var_features_delete
1033
1034
1041ELEMENTAL FUNCTION vol7d_var_features_vartype(this) RESULT(vartype)
1042TYPE(vol7d_var),INTENT(in) :: this
1043INTEGER :: vartype
1044
1045INTEGER :: i
1046
1047vartype = imiss
1048
1049IF (ALLOCATED(var_features)) THEN
1050 DO i = 1, SIZE(var_features)
1051 IF (this == var_features(i)%var) THEN
1052 vartype = var_features(i)%vartype
1053 RETURN
1054 ENDIF
1055 ENDDO
1056ENDIF
1057
1058END FUNCTION vol7d_var_features_vartype
1059
1060
1071ELEMENTAL SUBROUTINE vol7d_var_features_posdef_apply(this, val)
1072TYPE(vol7d_var),INTENT(in) :: this
1073REAL,INTENT(inout) :: val
1074
1075INTEGER :: i
1076
1077IF (ALLOCATED(var_features)) THEN
1078 DO i = 1, SIZE(var_features)
1079 IF (this == var_features(i)%var) THEN
1081 RETURN
1082 ENDIF
1083 ENDDO
1084ENDIF
1085
1086END SUBROUTINE vol7d_var_features_posdef_apply
1087
1088
1093ELEMENTAL FUNCTION vol7d_vartype(this) RESULT(vartype)
1094TYPE(vol7d_var),INTENT(in) :: this
1095
1096INTEGER :: vartype
1097
1098vartype = var_ord
1099SELECT CASE(this%btable)
1100CASE('B01012', 'B11001', 'B11043', 'B22001') ! direction, degree true
1101 vartype = var_dir360
1102CASE('B07004', 'B10004', 'B10051', 'B10060') ! pressure, Pa
1103 vartype = var_press
1104CASE('B11003', 'B11200') ! u-component
1105 vartype = var_ucomp
1106CASE('B11004', 'B11201') ! v-component
1107 vartype = var_vcomp
1108CASE('B11005', 'B11006') ! w-component
1109 vartype = var_wcomp
1110END SELECT
1111
1112END FUNCTION vol7d_vartype
1113
1114
1115#include "array_utilities_inc.F90"
1116
1117
display on the screen a brief content of object Definition: vol7d_var_class.F90:334 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. Definition: missing_values.f90:50 Classe per la gestione delle variabili osservate da stazioni meteo e affini. Definition: vol7d_var_class.F90:218 Definisce una variabile meteorologica osservata o un suo attributo. Definition: vol7d_var_class.F90:232 |