libsim Versione 7.2.6

◆ vol7d_var_features_posdef_apply()

elemental subroutine vol7d_var_features_posdef_apply ( type(vol7d_var), intent(in) this,
real, intent(inout) val )

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.

Parametri
[in]thisvol7d_var object to be reset
[in,out]valvalue to be reset, it is reset in place

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
593!> Classe per la gestione delle variabili osservate da stazioni meteo e affini.
594!! Questo modulo definisce una classe per rappresentare variabili meteorologiche
595!! osservate, o attributi, aventi diversi tipi numerici o carattere.
596!! \ingroup vol7d
597MODULE vol7d_var_class
598USE kinds
601IMPLICIT NONE
602
603!> Definisce una variabile meteorologica osservata o un suo attributo.
604!! I membri \a r, \a d, \a i, \a b, \a c servono, internamente a vol7d,
605!! per associare le variabili agli attributi, e indicano
606!! a quale variabile, nel descrittore delle variabili, coincide
607!! la variabile corrente nel descrittore delle "variabili aventi attributo".
608!! I membri di \a vol7d_var sono pubblici e quindi liberamente
609!! accessibili e scrivibili, ma è comunque consigliato assegnarli tramite
610!! il costruttore ::init.
611TYPE vol7d_var
612 CHARACTER(len=10) :: btable=cmiss !< codice della variabile secondo la tabella B del WMO.
613 CHARACTER(len=65) :: description=cmiss !< descrizione testuale della variabile (opzionale)
614 CHARACTER(len=24) :: unit=cmiss !< descrizione testuale dell'unità di misura (opzionale)
615 INTEGER :: scalefactor=imiss !< numero di decimali nella rappresentazione intera o character (opzionale)
616
617 INTEGER :: r=imiss !< indice della variabile nel volume degli attributi reali
618 INTEGER :: d=imiss !< indice della variabile nel volume degli attributi double precision
619 INTEGER :: i=imiss !< indice della variabile nel volume degli attributi integer
620 INTEGER :: b=imiss !< indice della variabile nel volume degli attributi byte
621 INTEGER :: c=imiss !< indice della variabile nel volume degli attributi character
622 INTEGER :: gribhint(4)=imiss !< hint for conversion from/to grib when btable is not found
623END TYPE vol7d_var
624
625!> Valore mancante per vol7d_var.
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
630!> Costruttore per la classe vol7d_var.
631!! Deve essere richiamato
632!! per tutti gli oggetti di questo tipo definiti in un programma.
633INTERFACE init
634 MODULE PROCEDURE vol7d_var_init
635END INTERFACE
636
637!> Distruttore per la classe vol7d_var.
638!! Distrugge l'oggetto in maniera pulita, assegnandogli un valore mancante.
639INTERFACE delete
640 MODULE PROCEDURE vol7d_var_delete
641END INTERFACE
642
643!> Operatore logico di uguaglianza tra oggetti della classe vol7d_var.
644!! Funziona anche per
645!! confronti di tipo array-array (qualsiasi n. di dimensioni) e di tipo
646!! scalare-vettore(1-d) (ma non vettore(1-d)-scalare o tra array con più
647!! di 1 dimensione e scalari).
648INTERFACE OPERATOR (==)
649 MODULE PROCEDURE vol7d_var_eq
650END INTERFACE
651
652!> Operatore logico di disuguaglianza tra oggetti della classe vol7d_var.
653!! Funziona anche per
654!! confronti di tipo array-array (qualsiasi n. di dimensioni) e di tipo
655!! scalare-vettore(1-d) (ma non vettore(1-d)-scalare o tra array con più
656!! di 1 dimensione e scalari).
657INTERFACE OPERATOR (/=)
658 MODULE PROCEDURE vol7d_var_ne, vol7d_var_nesv
659END INTERFACE
660
661!> to be documented
662INTERFACE c_e
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
670!> \brief display on the screen a brief content of object
671INTERFACE display
672 MODULE PROCEDURE display_var, display_var_vect
673END INTERFACE
674
675
676TYPE vol7d_var_features
677 TYPE(vol7d_var) :: var !< the variable (only btable is relevant)
678 REAL :: posdef !< if not missing, minimum physically reasonable value for the variable
679 INTEGER :: vartype !< type of variable, one of the var_* constants
680END TYPE vol7d_var_features
681
682TYPE(vol7d_var_features),ALLOCATABLE :: var_features(:)
683
684! constants for vol7d_vartype
685INTEGER,PARAMETER :: var_ord=0 !< unclassified variable (vol7d_vartype function)
686INTEGER,PARAMETER :: var_dir360=1 !< direction in degrees (vol7d_vartype function)
687INTEGER,PARAMETER :: var_press=2 !< pressure in Pa (vol7d_vartype function)
688INTEGER,PARAMETER :: var_ucomp=3 !< u component of a vector field (vol7d_vartype function)
689INTEGER,PARAMETER :: var_vcomp=4 !< v component of a vector field (vol7d_vartype function)
690INTEGER,PARAMETER :: var_wcomp=5 !< w component of a vector field (vol7d_vartype function)
691
692
693CONTAINS
694
695!> Inizializza un oggetto \a vol7d_var con i parametri opzionali forniti.
696!! Se non viene passato nessun parametro opzionale l'oggetto è
697!! inizializzato a valore mancante.
698!! I membri \a r, \a d, \a i, \a b, \a c non possono essere assegnati
699!! tramite costruttore, ma solo direttamente.
700elemental SUBROUTINE vol7d_var_init(this, btable, description, unit, scalefactor)
701TYPE(vol7d_var),INTENT(INOUT) :: this !< oggetto da inizializzare
702CHARACTER(len=*),INTENT(in),OPTIONAL :: btable !< codice della variabile
703CHARACTER(len=*),INTENT(in),OPTIONAL :: description !< descrizione della variabile
704CHARACTER(len=*),INTENT(in),OPTIONAL :: unit !< unità di misura
705INTEGER,INTENT(in),OPTIONAL :: scalefactor !< decimali nella rappresentazione intera e character
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 !< codice della variabile
743CHARACTER(len=*),INTENT(in),OPTIONAL :: description !< descrizione della variabile
744CHARACTER(len=*),INTENT(in),OPTIONAL :: unit !< unità di misura
745INTEGER,INTENT(in),OPTIONAL :: scalefactor !< decimali nella rappresentazione intera e character
746
747TYPE(vol7d_var) :: this
748
749CALL init(this, btable, description, unit, scalefactor)
750
751END FUNCTION vol7d_var_new
752
753
754!> Distrugge l'oggetto in maniera pulita, assegnandogli un valore mancante.
755elemental SUBROUTINE vol7d_var_delete(this)
756TYPE(vol7d_var),INTENT(INOUT) :: this !< oggetto da distruggre
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
798!> \brief display on the screen a brief content of vol7d_var object
799subroutine display_var(this)
800
801TYPE(vol7d_var),INTENT(in) :: this !< vol7d_var object to display
802
803print*,"VOL7DVAR: ",this%btable,trim(this%description)," : ",this%unit,&
804 " scale factor",this%scalefactor
805
806end subroutine display_var
807
808
809!> \brief display on the screen a brief content of vector of vol7d_var object
810subroutine display_var_vect(this)
811
812TYPE(vol7d_var),INTENT(in) :: this(:) !< vol7d_var vector object to display
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
828!> Initialise the global table of variable features.
829!! This subroutine reads the table of variable features from an
830!! external file and stores it in a global array. It has to be called
831!! once at the beginning of the program. At the moment it gives access
832!! to the information about type of variable and positive
833!! definitness. The table is based on the unique bufr-like variable
834!! table. The table is contained in the csv file `vargrib.csv`.
835!! It is not harmful to call this subroutine multiple times.
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
857 CALL init(csv, 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)
863 CALL delete(csv)
864ENDDO
865
866200 CONTINUE
867CLOSE(un)
868
869END SUBROUTINE vol7d_var_features_init
870
871
872!> Deallocate the global table of variable features.
873!! This subroutine deallocates the table of variable features
874!! allocated in the `vol7d_var_features_init` subroutine.
875SUBROUTINE vol7d_var_features_delete()
876IF (ALLOCATED(var_features)) DEALLOCATE(var_features)
877END SUBROUTINE vol7d_var_features_delete
878
879
880!> Return the physical type of the variable.
881!! Returns a rough classification of the variable depending on the
882!! physical parameter it represents. The result is one of the
883!! constants vartype_* defined in the module. To be extended.
884!! In order for this to work, the subroutine \a
885!! vol7d_var_features_init has to be preliminary called.
886ELEMENTAL FUNCTION vol7d_var_features_vartype(this) RESULT(vartype)
887TYPE(vol7d_var),INTENT(in) :: this !< vol7d_var object to be tested
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
906!> Apply a positive definite flag to a variable.
907!! This subroutine resets the value of a variable depending on its
908!! positive definite flag defined in the associated \a c_func object.
909!! The \a c_func object can be obtained for example by the \a convert
910!! (interfaced to vargrib2varbufr_convert) function. The value is
911!! reset to the maximum between the value itsel and and 0 (or the
912!! value set in \a c_func%posdef. These values are set from the
913!! vargrib2bufr.csv file.
914!! In order for this to work, the subroutine \a
915!! vol7d_var_features_init has to be preliminary called.
916ELEMENTAL SUBROUTINE vol7d_var_features_posdef_apply(this, val)
917TYPE(vol7d_var),INTENT(in) :: this !< vol7d_var object to be reset
918REAL,INTENT(inout) :: val !< value to be reset, it is reset in place
919
920INTEGER :: i
921
922IF (ALLOCATED(var_features)) THEN
923 DO i = 1, SIZE(var_features)
924 IF (this == var_features(i)%var) THEN
925 IF (c_e(var_features(i)%posdef)) val = max(var_features(i)%posdef, val)
926 RETURN
927 ENDIF
928 ENDDO
929ENDIF
930
931END SUBROUTINE vol7d_var_features_posdef_apply
932
933
934!> Return the physical type of the variable.
935!! Returns a rough classification of the variable depending on the
936!! physical parameter it represents. The result is one of the
937!! constants vartype_* defined in the module. To be extended.
938ELEMENTAL FUNCTION vol7d_vartype(this) RESULT(vartype)
939TYPE(vol7d_var),INTENT(in) :: this !< vol7d_var object to be tested
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
963END 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.