libsim Versione 7.1.11
|
◆ vol7d_var_features_posdef_apply()
Apply a positive definite flag to a variable. This subroutine resets the value of a variable depending on its positive definite flag defined in the associated c_func object. The c_func object can be obtained for example by the convert (interfaced to vargrib2varbufr_convert) function. The value is reset to the maximum between the value itsel and and 0 (or the value set in c_funcposdef. These values are set from the vargrib2bufr.csv file. In order for this to work, the subroutine vol7d_var_features_init has to be preliminary called.
Definizione alla linea 579 del file vol7d_var_class.F90. 580! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
581! authors:
582! Davide Cesari <dcesari@arpa.emr.it>
583! Paolo Patruno <ppatruno@arpa.emr.it>
584
585! This program is free software; you can redistribute it and/or
586! modify it under the terms of the GNU General Public License as
587! published by the Free Software Foundation; either version 2 of
588! the License, or (at your option) any later version.
589
590! This program is distributed in the hope that it will be useful,
591! but WITHOUT ANY WARRANTY; without even the implied warranty of
592! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
593! GNU General Public License for more details.
594
595! You should have received a copy of the GNU General Public License
596! along with this program. If not, see <http://www.gnu.org/licenses/>.
597#include "config.h"
598
607IMPLICIT NONE
608
618 CHARACTER(len=10) :: btable=cmiss
619 CHARACTER(len=65) :: description=cmiss
620 CHARACTER(len=24) :: unit=cmiss
621 INTEGER :: scalefactor=imiss
622
623 INTEGER :: r=imiss
624 INTEGER :: d=imiss
625 INTEGER :: i=imiss
626 INTEGER :: b=imiss
627 INTEGER :: c=imiss
628 INTEGER :: gribhint(4)=imiss
630
632TYPE(vol7d_var),PARAMETER :: vol7d_var_miss= &
633 vol7d_var(cmiss,cmiss,cmiss,imiss,imiss,imiss,imiss,imiss,imiss, &
634 (/imiss,imiss,imiss,imiss/))
635
640 MODULE PROCEDURE vol7d_var_init
641END INTERFACE
642
646 MODULE PROCEDURE vol7d_var_delete
647END INTERFACE
648
654INTERFACE OPERATOR (==)
655 MODULE PROCEDURE vol7d_var_eq
656END INTERFACE
657
663INTERFACE OPERATOR (/=)
664 MODULE PROCEDURE vol7d_var_ne, vol7d_var_nesv
665END INTERFACE
666
669 MODULE PROCEDURE vol7d_var_c_e
670END INTERFACE
671
672#define VOL7D_POLY_TYPE TYPE(vol7d_var)
673#define VOL7D_POLY_TYPES _var
674#include "array_utilities_pre.F90"
675
678 MODULE PROCEDURE display_var, display_var_vect
679END INTERFACE
680
681
682TYPE vol7d_var_features
683 TYPE(vol7d_var) :: var
684 REAL :: posdef
685 INTEGER :: vartype
686END TYPE vol7d_var_features
687
688TYPE(vol7d_var_features),ALLOCATABLE :: var_features(:)
689
690! constants for vol7d_vartype
691INTEGER,PARAMETER :: var_ord=0
692INTEGER,PARAMETER :: var_dir360=1
693INTEGER,PARAMETER :: var_press=2
694INTEGER,PARAMETER :: var_ucomp=3
695INTEGER,PARAMETER :: var_vcomp=4
696INTEGER,PARAMETER :: var_wcomp=5
697
698
699CONTAINS
700
706elemental SUBROUTINE vol7d_var_init(this, btable, description, unit, scalefactor)
707TYPE(vol7d_var),INTENT(INOUT) :: this
708CHARACTER(len=*),INTENT(in),OPTIONAL :: btable
709CHARACTER(len=*),INTENT(in),OPTIONAL :: description
710CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
711INTEGER,INTENT(in),OPTIONAL :: scalefactor
712
713IF (PRESENT(btable)) THEN
714 this%btable = btable
715ELSE
716 this%btable = cmiss
717 this%description = cmiss
718 this%unit = cmiss
719 this%scalefactor = imiss
720 RETURN
721ENDIF
722IF (PRESENT(description)) THEN
723 this%description = description
724ELSE
725 this%description = cmiss
726ENDIF
727IF (PRESENT(unit)) THEN
728 this%unit = unit
729ELSE
730 this%unit = cmiss
731ENDIF
732if (present(scalefactor)) then
733 this%scalefactor = scalefactor
734else
735 this%scalefactor = imiss
736endif
737
738this%r = -1
739this%d = -1
740this%i = -1
741this%b = -1
742this%c = -1
743
744END SUBROUTINE vol7d_var_init
745
746
747ELEMENTAL FUNCTION vol7d_var_new(btable, description, unit, scalefactor) RESULT(this)
748CHARACTER(len=*),INTENT(in),OPTIONAL :: btable
749CHARACTER(len=*),INTENT(in),OPTIONAL :: description
750CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
751INTEGER,INTENT(in),OPTIONAL :: scalefactor
752
753TYPE(vol7d_var) :: this
754
756
757END FUNCTION vol7d_var_new
758
759
761elemental SUBROUTINE vol7d_var_delete(this)
762TYPE(vol7d_var),INTENT(INOUT) :: this
763
764this%btable = cmiss
765this%description = cmiss
766this%unit = cmiss
767this%scalefactor = imiss
768
769END SUBROUTINE vol7d_var_delete
770
771
772ELEMENTAL FUNCTION vol7d_var_eq(this, that) RESULT(res)
773TYPE(vol7d_var),INTENT(IN) :: this, that
774LOGICAL :: res
775
776res = this%btable == that%btable
777
778END FUNCTION vol7d_var_eq
779
780
781ELEMENTAL FUNCTION vol7d_var_ne(this, that) RESULT(res)
782TYPE(vol7d_var),INTENT(IN) :: this, that
783LOGICAL :: res
784
785res = .NOT.(this == that)
786
787END FUNCTION vol7d_var_ne
788
789
790FUNCTION vol7d_var_nesv(this, that) RESULT(res)
791TYPE(vol7d_var),INTENT(IN) :: this, that(:)
792LOGICAL :: res(SIZE(that))
793
794INTEGER :: i
795
796DO i = 1, SIZE(that)
797 res(i) = .NOT.(this == that(i))
798ENDDO
799
800END FUNCTION vol7d_var_nesv
801
802
803
805subroutine display_var(this)
806
807TYPE(vol7d_var),INTENT(in) :: this
808
809print*,"VOL7DVAR: ",this%btable,trim(this%description)," : ",this%unit,&
810 " scale factor",this%scalefactor
811
812end subroutine display_var
813
814
816subroutine display_var_vect(this)
817
818TYPE(vol7d_var),INTENT(in) :: this(:)
819integer :: i
820
821do i=1,size(this)
822 call display_var(this(i))
823end do
824
825end subroutine display_var_vect
826
827FUNCTION vol7d_var_c_e(this) RESULT(c_e)
828TYPE(vol7d_var),INTENT(IN) :: this
829LOGICAL :: c_e
830c_e = this /= vol7d_var_miss
831END FUNCTION vol7d_var_c_e
832
833
842SUBROUTINE vol7d_var_features_init()
843INTEGER :: un, i, n
844TYPE(csv_record) :: csv
845CHARACTER(len=1024) :: line
846
847IF (ALLOCATED(var_features)) RETURN
848
849un = open_package_file('varbufr.csv', filetype_data)
850n=0
851DO WHILE(.true.)
852 READ(un,*,END=100)
853 n = n + 1
854ENDDO
855
856100 CONTINUE
857
858rewind(un)
859ALLOCATE(var_features(n))
860
861DO i = 1, n
862 READ(un,'(A)',END=200)line
864 CALL csv_record_getfield(csv, var_features(i)%var%btable)
865 CALL csv_record_getfield(csv)
866 CALL csv_record_getfield(csv)
867 CALL csv_record_getfield(csv, var_features(i)%posdef)
868 CALL csv_record_getfield(csv, var_features(i)%vartype)
870ENDDO
871
872200 CONTINUE
873CLOSE(un)
874
875END SUBROUTINE vol7d_var_features_init
876
877
881SUBROUTINE vol7d_var_features_delete()
882IF (ALLOCATED(var_features)) DEALLOCATE(var_features)
883END SUBROUTINE vol7d_var_features_delete
884
885
892ELEMENTAL FUNCTION vol7d_var_features_vartype(this) RESULT(vartype)
893TYPE(vol7d_var),INTENT(in) :: this
894INTEGER :: vartype
895
896INTEGER :: i
897
898vartype = imiss
899
900IF (ALLOCATED(var_features)) THEN
901 DO i = 1, SIZE(var_features)
902 IF (this == var_features(i)%var) THEN
903 vartype = var_features(i)%vartype
904 RETURN
905 ENDIF
906 ENDDO
907ENDIF
908
909END FUNCTION vol7d_var_features_vartype
910
911
922ELEMENTAL SUBROUTINE vol7d_var_features_posdef_apply(this, val)
923TYPE(vol7d_var),INTENT(in) :: this
924REAL,INTENT(inout) :: val
925
926INTEGER :: i
927
928IF (ALLOCATED(var_features)) THEN
929 DO i = 1, SIZE(var_features)
930 IF (this == var_features(i)%var) THEN
932 RETURN
933 ENDIF
934 ENDDO
935ENDIF
936
937END SUBROUTINE vol7d_var_features_posdef_apply
938
939
944ELEMENTAL FUNCTION vol7d_vartype(this) RESULT(vartype)
945TYPE(vol7d_var),INTENT(in) :: this
946
947INTEGER :: vartype
948
949vartype = var_ord
950SELECT CASE(this%btable)
951CASE('B01012', 'B11001', 'B11043', 'B22001') ! direction, degree true
952 vartype = var_dir360
953CASE('B07004', 'B10004', 'B10051', 'B10060') ! pressure, Pa
954 vartype = var_press
955CASE('B11003', 'B11200') ! u-component
956 vartype = var_ucomp
957CASE('B11004', 'B11201') ! v-component
958 vartype = var_vcomp
959CASE('B11005', 'B11006') ! w-component
960 vartype = var_wcomp
961END SELECT
962
963END FUNCTION vol7d_vartype
964
965
966#include "array_utilities_inc.F90"
967
968
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 |