libsim Versione 7.2.0
|
◆ 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 573 del file vol7d_var_class.F90. 574! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
575! authors:
576! Davide Cesari <dcesari@arpa.emr.it>
577! Paolo Patruno <ppatruno@arpa.emr.it>
578
579! This program is free software; you can redistribute it and/or
580! modify it under the terms of the GNU General Public License as
581! published by the Free Software Foundation; either version 2 of
582! the License, or (at your option) any later version.
583
584! This program is distributed in the hope that it will be useful,
585! but WITHOUT ANY WARRANTY; without even the implied warranty of
586! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
587! GNU General Public License for more details.
588
589! You should have received a copy of the GNU General Public License
590! along with this program. If not, see <http://www.gnu.org/licenses/>.
591#include "config.h"
592
601IMPLICIT NONE
602
612 CHARACTER(len=10) :: btable=cmiss
613 CHARACTER(len=65) :: description=cmiss
614 CHARACTER(len=24) :: unit=cmiss
615 INTEGER :: scalefactor=imiss
616
617 INTEGER :: r=imiss
618 INTEGER :: d=imiss
619 INTEGER :: i=imiss
620 INTEGER :: b=imiss
621 INTEGER :: c=imiss
622 INTEGER :: gribhint(4)=imiss
624
626TYPE(vol7d_var),PARAMETER :: vol7d_var_miss= &
627 vol7d_var(cmiss,cmiss,cmiss,imiss,imiss,imiss,imiss,imiss,imiss, &
628 (/imiss,imiss,imiss,imiss/))
629
634 MODULE PROCEDURE vol7d_var_init
635END INTERFACE
636
640 MODULE PROCEDURE vol7d_var_delete
641END INTERFACE
642
648INTERFACE OPERATOR (==)
649 MODULE PROCEDURE vol7d_var_eq
650END INTERFACE
651
657INTERFACE OPERATOR (/=)
658 MODULE PROCEDURE vol7d_var_ne, vol7d_var_nesv
659END INTERFACE
660
663 MODULE PROCEDURE vol7d_var_c_e
664END INTERFACE
665
666#define VOL7D_POLY_TYPE TYPE(vol7d_var)
667#define VOL7D_POLY_TYPES _var
668#include "array_utilities_pre.F90"
669
672 MODULE PROCEDURE display_var, display_var_vect
673END INTERFACE
674
675
676TYPE vol7d_var_features
677 TYPE(vol7d_var) :: var
678 REAL :: posdef
679 INTEGER :: vartype
680END TYPE vol7d_var_features
681
682TYPE(vol7d_var_features),ALLOCATABLE :: var_features(:)
683
684! constants for vol7d_vartype
685INTEGER,PARAMETER :: var_ord=0
686INTEGER,PARAMETER :: var_dir360=1
687INTEGER,PARAMETER :: var_press=2
688INTEGER,PARAMETER :: var_ucomp=3
689INTEGER,PARAMETER :: var_vcomp=4
690INTEGER,PARAMETER :: var_wcomp=5
691
692
693CONTAINS
694
700elemental SUBROUTINE vol7d_var_init(this, btable, description, unit, scalefactor)
701TYPE(vol7d_var),INTENT(INOUT) :: this
702CHARACTER(len=*),INTENT(in),OPTIONAL :: btable
703CHARACTER(len=*),INTENT(in),OPTIONAL :: description
704CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
705INTEGER,INTENT(in),OPTIONAL :: scalefactor
706
707IF (PRESENT(btable)) THEN
708 this%btable = btable
709ELSE
710 this%btable = cmiss
711 this%description = cmiss
712 this%unit = cmiss
713 this%scalefactor = imiss
714 RETURN
715ENDIF
716IF (PRESENT(description)) THEN
717 this%description = description
718ELSE
719 this%description = cmiss
720ENDIF
721IF (PRESENT(unit)) THEN
722 this%unit = unit
723ELSE
724 this%unit = cmiss
725ENDIF
726if (present(scalefactor)) then
727 this%scalefactor = scalefactor
728else
729 this%scalefactor = imiss
730endif
731
732this%r = -1
733this%d = -1
734this%i = -1
735this%b = -1
736this%c = -1
737
738END SUBROUTINE vol7d_var_init
739
740
741ELEMENTAL FUNCTION vol7d_var_new(btable, description, unit, scalefactor) RESULT(this)
742CHARACTER(len=*),INTENT(in),OPTIONAL :: btable
743CHARACTER(len=*),INTENT(in),OPTIONAL :: description
744CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
745INTEGER,INTENT(in),OPTIONAL :: scalefactor
746
747TYPE(vol7d_var) :: this
748
750
751END FUNCTION vol7d_var_new
752
753
755elemental SUBROUTINE vol7d_var_delete(this)
756TYPE(vol7d_var),INTENT(INOUT) :: this
757
758this%btable = cmiss
759this%description = cmiss
760this%unit = cmiss
761this%scalefactor = imiss
762
763END SUBROUTINE vol7d_var_delete
764
765
766ELEMENTAL FUNCTION vol7d_var_eq(this, that) RESULT(res)
767TYPE(vol7d_var),INTENT(IN) :: this, that
768LOGICAL :: res
769
770res = this%btable == that%btable
771
772END FUNCTION vol7d_var_eq
773
774
775ELEMENTAL FUNCTION vol7d_var_ne(this, that) RESULT(res)
776TYPE(vol7d_var),INTENT(IN) :: this, that
777LOGICAL :: res
778
779res = .NOT.(this == that)
780
781END FUNCTION vol7d_var_ne
782
783
784FUNCTION vol7d_var_nesv(this, that) RESULT(res)
785TYPE(vol7d_var),INTENT(IN) :: this, that(:)
786LOGICAL :: res(SIZE(that))
787
788INTEGER :: i
789
790DO i = 1, SIZE(that)
791 res(i) = .NOT.(this == that(i))
792ENDDO
793
794END FUNCTION vol7d_var_nesv
795
796
797
799subroutine display_var(this)
800
801TYPE(vol7d_var),INTENT(in) :: this
802
803print*,"VOL7DVAR: ",this%btable,trim(this%description)," : ",this%unit,&
804 " scale factor",this%scalefactor
805
806end subroutine display_var
807
808
810subroutine display_var_vect(this)
811
812TYPE(vol7d_var),INTENT(in) :: this(:)
813integer :: i
814
815do i=1,size(this)
816 call display_var(this(i))
817end do
818
819end subroutine display_var_vect
820
821FUNCTION vol7d_var_c_e(this) RESULT(c_e)
822TYPE(vol7d_var),INTENT(IN) :: this
823LOGICAL :: c_e
824c_e = this /= vol7d_var_miss
825END FUNCTION vol7d_var_c_e
826
827
836SUBROUTINE vol7d_var_features_init()
837INTEGER :: un, i, n
838TYPE(csv_record) :: csv
839CHARACTER(len=1024) :: line
840
841IF (ALLOCATED(var_features)) RETURN
842
843un = open_package_file('varbufr.csv', filetype_data)
844n=0
845DO WHILE(.true.)
846 READ(un,*,END=100)
847 n = n + 1
848ENDDO
849
850100 CONTINUE
851
852rewind(un)
853ALLOCATE(var_features(n))
854
855DO i = 1, n
856 READ(un,'(A)',END=200)line
858 CALL csv_record_getfield(csv, var_features(i)%var%btable)
859 CALL csv_record_getfield(csv)
860 CALL csv_record_getfield(csv)
861 CALL csv_record_getfield(csv, var_features(i)%posdef)
862 CALL csv_record_getfield(csv, var_features(i)%vartype)
864ENDDO
865
866200 CONTINUE
867CLOSE(un)
868
869END SUBROUTINE vol7d_var_features_init
870
871
875SUBROUTINE vol7d_var_features_delete()
876IF (ALLOCATED(var_features)) DEALLOCATE(var_features)
877END SUBROUTINE vol7d_var_features_delete
878
879
886ELEMENTAL FUNCTION vol7d_var_features_vartype(this) RESULT(vartype)
887TYPE(vol7d_var),INTENT(in) :: this
888INTEGER :: vartype
889
890INTEGER :: i
891
892vartype = imiss
893
894IF (ALLOCATED(var_features)) THEN
895 DO i = 1, SIZE(var_features)
896 IF (this == var_features(i)%var) THEN
897 vartype = var_features(i)%vartype
898 RETURN
899 ENDIF
900 ENDDO
901ENDIF
902
903END FUNCTION vol7d_var_features_vartype
904
905
916ELEMENTAL SUBROUTINE vol7d_var_features_posdef_apply(this, val)
917TYPE(vol7d_var),INTENT(in) :: this
918REAL,INTENT(inout) :: val
919
920INTEGER :: i
921
922IF (ALLOCATED(var_features)) THEN
923 DO i = 1, SIZE(var_features)
924 IF (this == var_features(i)%var) THEN
926 RETURN
927 ENDIF
928 ENDDO
929ENDIF
930
931END SUBROUTINE vol7d_var_features_posdef_apply
932
933
938ELEMENTAL FUNCTION vol7d_vartype(this) RESULT(vartype)
939TYPE(vol7d_var),INTENT(in) :: this
940
941INTEGER :: vartype
942
943vartype = var_ord
944SELECT CASE(this%btable)
945CASE('B01012', 'B11001', 'B11043', 'B22001') ! direction, degree true
946 vartype = var_dir360
947CASE('B07004', 'B10004', 'B10051', 'B10060') ! pressure, Pa
948 vartype = var_press
949CASE('B11003', 'B11200') ! u-component
950 vartype = var_ucomp
951CASE('B11004', 'B11201') ! v-component
952 vartype = var_vcomp
953CASE('B11005', 'B11006') ! w-component
954 vartype = var_wcomp
955END SELECT
956
957END FUNCTION vol7d_vartype
958
959
960#include "array_utilities_inc.F90"
961
962
display on the screen a brief content of object Definition: vol7d_var_class.F90:328 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. Definition: missing_values.f90:50 Classe per la gestione delle variabili osservate da stazioni meteo e affini. Definition: vol7d_var_class.F90:212 Definisce una variabile meteorologica osservata o un suo attributo. Definition: vol7d_var_class.F90:226 |