libsim Versione 7.2.0

◆ vol7d_var_features_vartype()

elemental integer function vol7d_var_features_vartype ( type(vol7d_var), intent(in)  this)

Return the physical type of the variable.

Returns a rough classification of the variable depending on the physical parameter it represents. The result is one of the constants vartype_* defined in the module. To be extended. In order for this to work, the subroutine vol7d_var_features_init has to be preliminary called.

Parametri
[in]thisvol7d_var object to be tested

Definizione alla linea 543 del file vol7d_var_class.F90.

544! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
545! authors:
546! Davide Cesari <dcesari@arpa.emr.it>
547! Paolo Patruno <ppatruno@arpa.emr.it>
548
549! This program is free software; you can redistribute it and/or
550! modify it under the terms of the GNU General Public License as
551! published by the Free Software Foundation; either version 2 of
552! the License, or (at your option) any later version.
553
554! This program is distributed in the hope that it will be useful,
555! but WITHOUT ANY WARRANTY; without even the implied warranty of
556! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
557! GNU General Public License for more details.
558
559! You should have received a copy of the GNU General Public License
560! along with this program. If not, see <http://www.gnu.org/licenses/>.
561#include "config.h"
562
567MODULE vol7d_var_class
568USE kinds
571IMPLICIT NONE
572
581TYPE vol7d_var
582 CHARACTER(len=10) :: btable=cmiss
583 CHARACTER(len=65) :: description=cmiss
584 CHARACTER(len=24) :: unit=cmiss
585 INTEGER :: scalefactor=imiss
586
587 INTEGER :: r=imiss
588 INTEGER :: d=imiss
589 INTEGER :: i=imiss
590 INTEGER :: b=imiss
591 INTEGER :: c=imiss
592 INTEGER :: gribhint(4)=imiss
593END TYPE vol7d_var
594
596TYPE(vol7d_var),PARAMETER :: vol7d_var_miss= &
597 vol7d_var(cmiss,cmiss,cmiss,imiss,imiss,imiss,imiss,imiss,imiss, &
598 (/imiss,imiss,imiss,imiss/))
599
603INTERFACE init
604 MODULE PROCEDURE vol7d_var_init
605END INTERFACE
606
609INTERFACE delete
610 MODULE PROCEDURE vol7d_var_delete
611END INTERFACE
612
618INTERFACE OPERATOR (==)
619 MODULE PROCEDURE vol7d_var_eq
620END INTERFACE
621
627INTERFACE OPERATOR (/=)
628 MODULE PROCEDURE vol7d_var_ne, vol7d_var_nesv
629END INTERFACE
630
632INTERFACE c_e
633 MODULE PROCEDURE vol7d_var_c_e
634END INTERFACE
635
636#define VOL7D_POLY_TYPE TYPE(vol7d_var)
637#define VOL7D_POLY_TYPES _var
638#include "array_utilities_pre.F90"
639
641INTERFACE display
642 MODULE PROCEDURE display_var, display_var_vect
643END INTERFACE
644
645
646TYPE vol7d_var_features
647 TYPE(vol7d_var) :: var
648 REAL :: posdef
649 INTEGER :: vartype
650END TYPE vol7d_var_features
651
652TYPE(vol7d_var_features),ALLOCATABLE :: var_features(:)
653
654! constants for vol7d_vartype
655INTEGER,PARAMETER :: var_ord=0
656INTEGER,PARAMETER :: var_dir360=1
657INTEGER,PARAMETER :: var_press=2
658INTEGER,PARAMETER :: var_ucomp=3
659INTEGER,PARAMETER :: var_vcomp=4
660INTEGER,PARAMETER :: var_wcomp=5
661
662
663CONTAINS
664
670elemental SUBROUTINE vol7d_var_init(this, btable, description, unit, scalefactor)
671TYPE(vol7d_var),INTENT(INOUT) :: this
672CHARACTER(len=*),INTENT(in),OPTIONAL :: btable
673CHARACTER(len=*),INTENT(in),OPTIONAL :: description
674CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
675INTEGER,INTENT(in),OPTIONAL :: scalefactor
676
677IF (PRESENT(btable)) THEN
678 this%btable = btable
679ELSE
680 this%btable = cmiss
681 this%description = cmiss
682 this%unit = cmiss
683 this%scalefactor = imiss
684 RETURN
685ENDIF
686IF (PRESENT(description)) THEN
687 this%description = description
688ELSE
689 this%description = cmiss
690ENDIF
691IF (PRESENT(unit)) THEN
692 this%unit = unit
693ELSE
694 this%unit = cmiss
695ENDIF
696if (present(scalefactor)) then
697 this%scalefactor = scalefactor
698else
699 this%scalefactor = imiss
700endif
701
702this%r = -1
703this%d = -1
704this%i = -1
705this%b = -1
706this%c = -1
707
708END SUBROUTINE vol7d_var_init
709
710
711ELEMENTAL FUNCTION vol7d_var_new(btable, description, unit, scalefactor) RESULT(this)
712CHARACTER(len=*),INTENT(in),OPTIONAL :: btable
713CHARACTER(len=*),INTENT(in),OPTIONAL :: description
714CHARACTER(len=*),INTENT(in),OPTIONAL :: unit
715INTEGER,INTENT(in),OPTIONAL :: scalefactor
716
717TYPE(vol7d_var) :: this
718
719CALL init(this, btable, description, unit, scalefactor)
720
721END FUNCTION vol7d_var_new
722
723
725elemental SUBROUTINE vol7d_var_delete(this)
726TYPE(vol7d_var),INTENT(INOUT) :: this
727
728this%btable = cmiss
729this%description = cmiss
730this%unit = cmiss
731this%scalefactor = imiss
732
733END SUBROUTINE vol7d_var_delete
734
735
736ELEMENTAL FUNCTION vol7d_var_eq(this, that) RESULT(res)
737TYPE(vol7d_var),INTENT(IN) :: this, that
738LOGICAL :: res
739
740res = this%btable == that%btable
741
742END FUNCTION vol7d_var_eq
743
744
745ELEMENTAL FUNCTION vol7d_var_ne(this, that) RESULT(res)
746TYPE(vol7d_var),INTENT(IN) :: this, that
747LOGICAL :: res
748
749res = .NOT.(this == that)
750
751END FUNCTION vol7d_var_ne
752
753
754FUNCTION vol7d_var_nesv(this, that) RESULT(res)
755TYPE(vol7d_var),INTENT(IN) :: this, that(:)
756LOGICAL :: res(SIZE(that))
757
758INTEGER :: i
759
760DO i = 1, SIZE(that)
761 res(i) = .NOT.(this == that(i))
762ENDDO
763
764END FUNCTION vol7d_var_nesv
765
766
767
769subroutine display_var(this)
770
771TYPE(vol7d_var),INTENT(in) :: this
772
773print*,"VOL7DVAR: ",this%btable,trim(this%description)," : ",this%unit,&
774 " scale factor",this%scalefactor
775
776end subroutine display_var
777
778
780subroutine display_var_vect(this)
781
782TYPE(vol7d_var),INTENT(in) :: this(:)
783integer :: i
784
785do i=1,size(this)
786 call display_var(this(i))
787end do
788
789end subroutine display_var_vect
790
791FUNCTION vol7d_var_c_e(this) RESULT(c_e)
792TYPE(vol7d_var),INTENT(IN) :: this
793LOGICAL :: c_e
794c_e = this /= vol7d_var_miss
795END FUNCTION vol7d_var_c_e
796
797
806SUBROUTINE vol7d_var_features_init()
807INTEGER :: un, i, n
808TYPE(csv_record) :: csv
809CHARACTER(len=1024) :: line
810
811IF (ALLOCATED(var_features)) RETURN
812
813un = open_package_file('varbufr.csv', filetype_data)
814n=0
815DO WHILE(.true.)
816 READ(un,*,END=100)
817 n = n + 1
818ENDDO
819
820100 CONTINUE
821
822rewind(un)
823ALLOCATE(var_features(n))
824
825DO i = 1, n
826 READ(un,'(A)',END=200)line
827 CALL init(csv, line)
828 CALL csv_record_getfield(csv, var_features(i)%var%btable)
829 CALL csv_record_getfield(csv)
830 CALL csv_record_getfield(csv)
831 CALL csv_record_getfield(csv, var_features(i)%posdef)
832 CALL csv_record_getfield(csv, var_features(i)%vartype)
833 CALL delete(csv)
834ENDDO
835
836200 CONTINUE
837CLOSE(un)
838
839END SUBROUTINE vol7d_var_features_init
840
841
845SUBROUTINE vol7d_var_features_delete()
846IF (ALLOCATED(var_features)) DEALLOCATE(var_features)
847END SUBROUTINE vol7d_var_features_delete
848
849
856ELEMENTAL FUNCTION vol7d_var_features_vartype(this) RESULT(vartype)
857TYPE(vol7d_var),INTENT(in) :: this
858INTEGER :: vartype
859
860INTEGER :: i
861
862vartype = imiss
863
864IF (ALLOCATED(var_features)) THEN
865 DO i = 1, SIZE(var_features)
866 IF (this == var_features(i)%var) THEN
867 vartype = var_features(i)%vartype
868 RETURN
869 ENDIF
870 ENDDO
871ENDIF
872
873END FUNCTION vol7d_var_features_vartype
874
875
886ELEMENTAL SUBROUTINE vol7d_var_features_posdef_apply(this, val)
887TYPE(vol7d_var),INTENT(in) :: this
888REAL,INTENT(inout) :: val
889
890INTEGER :: i
891
892IF (ALLOCATED(var_features)) THEN
893 DO i = 1, SIZE(var_features)
894 IF (this == var_features(i)%var) THEN
895 IF (c_e(var_features(i)%posdef)) val = max(var_features(i)%posdef, val)
896 RETURN
897 ENDIF
898 ENDDO
899ENDIF
900
901END SUBROUTINE vol7d_var_features_posdef_apply
902
903
908ELEMENTAL FUNCTION vol7d_vartype(this) RESULT(vartype)
909TYPE(vol7d_var),INTENT(in) :: this
910
911INTEGER :: vartype
912
913vartype = var_ord
914SELECT CASE(this%btable)
915CASE('B01012', 'B11001', 'B11043', 'B22001') ! direction, degree true
916 vartype = var_dir360
917CASE('B07004', 'B10004', 'B10051', 'B10060') ! pressure, Pa
918 vartype = var_press
919CASE('B11003', 'B11200') ! u-component
920 vartype = var_ucomp
921CASE('B11004', 'B11201') ! v-component
922 vartype = var_vcomp
923CASE('B11005', 'B11006') ! w-component
924 vartype = var_wcomp
925END SELECT
926
927END FUNCTION vol7d_vartype
928
929
930#include "array_utilities_inc.F90"
931
932
933END 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.