libsim Versione 7.2.1

◆ pack_distinct_var()

type(vol7d_var) function, dimension(dim) pack_distinct_var ( type(vol7d_var), dimension(:), intent(in) vect,
integer, intent(in) dim,
logical, dimension(:), intent(in), optional mask,
logical, intent(in), optional back )

compatta gli elementi distinti di vect in un array

Definizione alla linea 721 del file vol7d_var_class.F90.

723! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
724! authors:
725! Davide Cesari <dcesari@arpa.emr.it>
726! Paolo Patruno <ppatruno@arpa.emr.it>
727
728! This program is free software; you can redistribute it and/or
729! modify it under the terms of the GNU General Public License as
730! published by the Free Software Foundation; either version 2 of
731! the License, or (at your option) any later version.
732
733! This program is distributed in the hope that it will be useful,
734! but WITHOUT ANY WARRANTY; without even the implied warranty of
735! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
736! GNU General Public License for more details.
737
738! You should have received a copy of the GNU General Public License
739! along with this program. If not, see <http://www.gnu.org/licenses/>.
740#include "config.h"
741
746MODULE vol7d_var_class
747USE kinds
750IMPLICIT NONE
751
760TYPE vol7d_var
761 CHARACTER(len=10) :: btable=cmiss
762 CHARACTER(len=65) :: description=cmiss
763 CHARACTER(len=24) :: unit=cmiss
764 INTEGER :: scalefactor=imiss
765
766 INTEGER :: r=imiss
767 INTEGER :: d=imiss
768 INTEGER :: i=imiss
769 INTEGER :: b=imiss
770 INTEGER :: c=imiss
771 INTEGER :: gribhint(4)=imiss
772END TYPE vol7d_var
773
775TYPE(vol7d_var),PARAMETER :: vol7d_var_miss= &
776 vol7d_var(cmiss,cmiss,cmiss,imiss,imiss,imiss,imiss,imiss,imiss, &
777 (/imiss,imiss,imiss,imiss/))
778
782INTERFACE init
783 MODULE PROCEDURE vol7d_var_init
784END INTERFACE
785
788INTERFACE delete
789 MODULE PROCEDURE vol7d_var_delete
790END INTERFACE
791
797INTERFACE OPERATOR (==)
798 MODULE PROCEDURE vol7d_var_eq
799END INTERFACE
800
806INTERFACE OPERATOR (/=)
807 MODULE PROCEDURE vol7d_var_ne, vol7d_var_nesv
808END INTERFACE
809
811INTERFACE c_e
812 MODULE PROCEDURE vol7d_var_c_e
813END INTERFACE
814
815#define VOL7D_POLY_TYPE TYPE(vol7d_var)
816#define VOL7D_POLY_TYPES _var
817#include "array_utilities_pre.F90"
818
820INTERFACE display
821 MODULE PROCEDURE display_var, display_var_vect
822END INTERFACE
823
824
825TYPE vol7d_var_features
826 TYPE(vol7d_var) :: var
827 REAL :: posdef
828 INTEGER :: vartype
829END TYPE vol7d_var_features
830
831TYPE(vol7d_var_features),ALLOCATABLE :: var_features(:)
832
833! constants for vol7d_vartype
834INTEGER,PARAMETER :: var_ord=0
835INTEGER,PARAMETER :: var_dir360=1
836INTEGER,PARAMETER :: var_press=2
837INTEGER,PARAMETER :: var_ucomp=3
838INTEGER,PARAMETER :: var_vcomp=4
839INTEGER,PARAMETER :: var_wcomp=5
840
841
842CONTAINS
843
849elemental SUBROUTINE vol7d_var_init(this, btable, description, unit, scalefactor)
850TYPE(vol7d_var),INTENT(INOUT) :: this
851CHARACTER(len=*),INTENT(in),OPTIONAL :: btable
852CHARACTER(len=*),INTENT(in),OPTIONAL :: description
853CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
854INTEGER,INTENT(in),OPTIONAL :: scalefactor
855
856IF (PRESENT(btable)) THEN
857 this%btable = btable
858ELSE
859 this%btable = cmiss
860 this%description = cmiss
861 this%unit = cmiss
862 this%scalefactor = imiss
863 RETURN
864ENDIF
865IF (PRESENT(description)) THEN
866 this%description = description
867ELSE
868 this%description = cmiss
869ENDIF
870IF (PRESENT(unit)) THEN
871 this%unit = unit
872ELSE
873 this%unit = cmiss
874ENDIF
875if (present(scalefactor)) then
876 this%scalefactor = scalefactor
877else
878 this%scalefactor = imiss
879endif
880
881this%r = -1
882this%d = -1
883this%i = -1
884this%b = -1
885this%c = -1
886
887END SUBROUTINE vol7d_var_init
888
889
890ELEMENTAL FUNCTION vol7d_var_new(btable, description, unit, scalefactor) RESULT(this)
891CHARACTER(len=*),INTENT(in),OPTIONAL :: btable
892CHARACTER(len=*),INTENT(in),OPTIONAL :: description
893CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
894INTEGER,INTENT(in),OPTIONAL :: scalefactor
895
896TYPE(vol7d_var) :: this
897
898CALL init(this, btable, description, unit, scalefactor)
899
900END FUNCTION vol7d_var_new
901
902
904elemental SUBROUTINE vol7d_var_delete(this)
905TYPE(vol7d_var),INTENT(INOUT) :: this
906
907this%btable = cmiss
908this%description = cmiss
909this%unit = cmiss
910this%scalefactor = imiss
911
912END SUBROUTINE vol7d_var_delete
913
914
915ELEMENTAL FUNCTION vol7d_var_eq(this, that) RESULT(res)
916TYPE(vol7d_var),INTENT(IN) :: this, that
917LOGICAL :: res
918
919res = this%btable == that%btable
920
921END FUNCTION vol7d_var_eq
922
923
924ELEMENTAL FUNCTION vol7d_var_ne(this, that) RESULT(res)
925TYPE(vol7d_var),INTENT(IN) :: this, that
926LOGICAL :: res
927
928res = .NOT.(this == that)
929
930END FUNCTION vol7d_var_ne
931
932
933FUNCTION vol7d_var_nesv(this, that) RESULT(res)
934TYPE(vol7d_var),INTENT(IN) :: this, that(:)
935LOGICAL :: res(SIZE(that))
936
937INTEGER :: i
938
939DO i = 1, SIZE(that)
940 res(i) = .NOT.(this == that(i))
941ENDDO
942
943END FUNCTION vol7d_var_nesv
944
945
946
948subroutine display_var(this)
949
950TYPE(vol7d_var),INTENT(in) :: this
951
952print*,"VOL7DVAR: ",this%btable,trim(this%description)," : ",this%unit,&
953 " scale factor",this%scalefactor
954
955end subroutine display_var
956
957
959subroutine display_var_vect(this)
960
961TYPE(vol7d_var),INTENT(in) :: this(:)
962integer :: i
963
964do i=1,size(this)
965 call display_var(this(i))
966end do
967
968end subroutine display_var_vect
969
970FUNCTION vol7d_var_c_e(this) RESULT(c_e)
971TYPE(vol7d_var),INTENT(IN) :: this
972LOGICAL :: c_e
973c_e = this /= vol7d_var_miss
974END FUNCTION vol7d_var_c_e
975
976
985SUBROUTINE vol7d_var_features_init()
986INTEGER :: un, i, n
987TYPE(csv_record) :: csv
988CHARACTER(len=1024) :: line
989
990IF (ALLOCATED(var_features)) RETURN
991
992un = open_package_file('varbufr.csv', filetype_data)
993n=0
994DO WHILE(.true.)
995 READ(un,*,END=100)
996 n = n + 1
997ENDDO
998
999100 CONTINUE
1000
1001rewind(un)
1002ALLOCATE(var_features(n))
1003
1004DO i = 1, n
1005 READ(un,'(A)',END=200)line
1006 CALL init(csv, line)
1007 CALL csv_record_getfield(csv, var_features(i)%var%btable)
1008 CALL csv_record_getfield(csv)
1009 CALL csv_record_getfield(csv)
1010 CALL csv_record_getfield(csv, var_features(i)%posdef)
1011 CALL csv_record_getfield(csv, var_features(i)%vartype)
1012 CALL delete(csv)
1013ENDDO
1014
1015200 CONTINUE
1016CLOSE(un)
1017
1018END SUBROUTINE vol7d_var_features_init
1019
1020
1024SUBROUTINE vol7d_var_features_delete()
1025IF (ALLOCATED(var_features)) DEALLOCATE(var_features)
1026END SUBROUTINE vol7d_var_features_delete
1027
1028
1035ELEMENTAL FUNCTION vol7d_var_features_vartype(this) RESULT(vartype)
1036TYPE(vol7d_var),INTENT(in) :: this
1037INTEGER :: vartype
1038
1039INTEGER :: i
1040
1041vartype = imiss
1042
1043IF (ALLOCATED(var_features)) THEN
1044 DO i = 1, SIZE(var_features)
1045 IF (this == var_features(i)%var) THEN
1046 vartype = var_features(i)%vartype
1047 RETURN
1048 ENDIF
1049 ENDDO
1050ENDIF
1051
1052END FUNCTION vol7d_var_features_vartype
1053
1054
1065ELEMENTAL SUBROUTINE vol7d_var_features_posdef_apply(this, val)
1066TYPE(vol7d_var),INTENT(in) :: this
1067REAL,INTENT(inout) :: val
1068
1069INTEGER :: i
1070
1071IF (ALLOCATED(var_features)) THEN
1072 DO i = 1, SIZE(var_features)
1073 IF (this == var_features(i)%var) THEN
1074 IF (c_e(var_features(i)%posdef)) val = max(var_features(i)%posdef, val)
1075 RETURN
1076 ENDIF
1077 ENDDO
1078ENDIF
1079
1080END SUBROUTINE vol7d_var_features_posdef_apply
1081
1082
1087ELEMENTAL FUNCTION vol7d_vartype(this) RESULT(vartype)
1088TYPE(vol7d_var),INTENT(in) :: this
1089
1090INTEGER :: vartype
1091
1092vartype = var_ord
1093SELECT CASE(this%btable)
1094CASE('B01012', 'B11001', 'B11043', 'B22001') ! direction, degree true
1095 vartype = var_dir360
1096CASE('B07004', 'B10004', 'B10051', 'B10060') ! pressure, Pa
1097 vartype = var_press
1098CASE('B11003', 'B11200') ! u-component
1099 vartype = var_ucomp
1100CASE('B11004', 'B11201') ! v-component
1101 vartype = var_vcomp
1102CASE('B11005', 'B11006') ! w-component
1103 vartype = var_wcomp
1104END SELECT
1105
1106END FUNCTION vol7d_vartype
1107
1108
1109#include "array_utilities_inc.F90"
1110
1111
1112END 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.