libsim Versione 7.2.6

◆ vol7d_var_features_delete()

subroutine vol7d_var_features_delete

Deallocate the global table of variable features.

This subroutine deallocates the table of variable features allocated in the vol7d_var_features_init subroutine.

Definizione alla linea 532 del file vol7d_var_class.F90.

533! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
534! authors:
535! Davide Cesari <dcesari@arpa.emr.it>
536! Paolo Patruno <ppatruno@arpa.emr.it>
537
538! This program is free software; you can redistribute it and/or
539! modify it under the terms of the GNU General Public License as
540! published by the Free Software Foundation; either version 2 of
541! the License, or (at your option) any later version.
542
543! This program is distributed in the hope that it will be useful,
544! but WITHOUT ANY WARRANTY; without even the implied warranty of
545! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
546! GNU General Public License for more details.
547
548! You should have received a copy of the GNU General Public License
549! along with this program. If not, see <http://www.gnu.org/licenses/>.
550#include "config.h"
551
552!> Classe per la gestione delle variabili osservate da stazioni meteo e affini.
553!! Questo modulo definisce una classe per rappresentare variabili meteorologiche
554!! osservate, o attributi, aventi diversi tipi numerici o carattere.
555!! \ingroup vol7d
556MODULE vol7d_var_class
557USE kinds
560IMPLICIT NONE
561
562!> Definisce una variabile meteorologica osservata o un suo attributo.
563!! I membri \a r, \a d, \a i, \a b, \a c servono, internamente a vol7d,
564!! per associare le variabili agli attributi, e indicano
565!! a quale variabile, nel descrittore delle variabili, coincide
566!! la variabile corrente nel descrittore delle "variabili aventi attributo".
567!! I membri di \a vol7d_var sono pubblici e quindi liberamente
568!! accessibili e scrivibili, ma è comunque consigliato assegnarli tramite
569!! il costruttore ::init.
570TYPE vol7d_var
571 CHARACTER(len=10) :: btable=cmiss !< codice della variabile secondo la tabella B del WMO.
572 CHARACTER(len=65) :: description=cmiss !< descrizione testuale della variabile (opzionale)
573 CHARACTER(len=24) :: unit=cmiss !< descrizione testuale dell'unità di misura (opzionale)
574 INTEGER :: scalefactor=imiss !< numero di decimali nella rappresentazione intera o character (opzionale)
575
576 INTEGER :: r=imiss !< indice della variabile nel volume degli attributi reali
577 INTEGER :: d=imiss !< indice della variabile nel volume degli attributi double precision
578 INTEGER :: i=imiss !< indice della variabile nel volume degli attributi integer
579 INTEGER :: b=imiss !< indice della variabile nel volume degli attributi byte
580 INTEGER :: c=imiss !< indice della variabile nel volume degli attributi character
581 INTEGER :: gribhint(4)=imiss !< hint for conversion from/to grib when btable is not found
582END TYPE vol7d_var
583
584!> Valore mancante per vol7d_var.
585TYPE(vol7d_var),PARAMETER :: vol7d_var_miss= &
586 vol7d_var(cmiss,cmiss,cmiss,imiss,imiss,imiss,imiss,imiss,imiss, &
587 (/imiss,imiss,imiss,imiss/))
588
589!> Costruttore per la classe vol7d_var.
590!! Deve essere richiamato
591!! per tutti gli oggetti di questo tipo definiti in un programma.
592INTERFACE init
593 MODULE PROCEDURE vol7d_var_init
594END INTERFACE
595
596!> Distruttore per la classe vol7d_var.
597!! Distrugge l'oggetto in maniera pulita, assegnandogli un valore mancante.
598INTERFACE delete
599 MODULE PROCEDURE vol7d_var_delete
600END INTERFACE
601
602!> Operatore logico di uguaglianza tra oggetti della classe vol7d_var.
603!! Funziona anche per
604!! confronti di tipo array-array (qualsiasi n. di dimensioni) e di tipo
605!! scalare-vettore(1-d) (ma non vettore(1-d)-scalare o tra array con più
606!! di 1 dimensione e scalari).
607INTERFACE OPERATOR (==)
608 MODULE PROCEDURE vol7d_var_eq
609END INTERFACE
610
611!> Operatore logico di disuguaglianza tra oggetti della classe vol7d_var.
612!! Funziona anche per
613!! confronti di tipo array-array (qualsiasi n. di dimensioni) e di tipo
614!! scalare-vettore(1-d) (ma non vettore(1-d)-scalare o tra array con più
615!! di 1 dimensione e scalari).
616INTERFACE OPERATOR (/=)
617 MODULE PROCEDURE vol7d_var_ne, vol7d_var_nesv
618END INTERFACE
619
620!> to be documented
621INTERFACE c_e
622 MODULE PROCEDURE vol7d_var_c_e
623END INTERFACE
624
625#define VOL7D_POLY_TYPE TYPE(vol7d_var)
626#define VOL7D_POLY_TYPES _var
627#include "array_utilities_pre.F90"
628
629!> \brief display on the screen a brief content of object
630INTERFACE display
631 MODULE PROCEDURE display_var, display_var_vect
632END INTERFACE
633
634
635TYPE vol7d_var_features
636 TYPE(vol7d_var) :: var !< the variable (only btable is relevant)
637 REAL :: posdef !< if not missing, minimum physically reasonable value for the variable
638 INTEGER :: vartype !< type of variable, one of the var_* constants
639END TYPE vol7d_var_features
640
641TYPE(vol7d_var_features),ALLOCATABLE :: var_features(:)
642
643! constants for vol7d_vartype
644INTEGER,PARAMETER :: var_ord=0 !< unclassified variable (vol7d_vartype function)
645INTEGER,PARAMETER :: var_dir360=1 !< direction in degrees (vol7d_vartype function)
646INTEGER,PARAMETER :: var_press=2 !< pressure in Pa (vol7d_vartype function)
647INTEGER,PARAMETER :: var_ucomp=3 !< u component of a vector field (vol7d_vartype function)
648INTEGER,PARAMETER :: var_vcomp=4 !< v component of a vector field (vol7d_vartype function)
649INTEGER,PARAMETER :: var_wcomp=5 !< w component of a vector field (vol7d_vartype function)
650
651
652CONTAINS
653
654!> Inizializza un oggetto \a vol7d_var con i parametri opzionali forniti.
655!! Se non viene passato nessun parametro opzionale l'oggetto è
656!! inizializzato a valore mancante.
657!! I membri \a r, \a d, \a i, \a b, \a c non possono essere assegnati
658!! tramite costruttore, ma solo direttamente.
659elemental SUBROUTINE vol7d_var_init(this, btable, description, unit, scalefactor)
660TYPE(vol7d_var),INTENT(INOUT) :: this !< oggetto da inizializzare
661CHARACTER(len=*),INTENT(in),OPTIONAL :: btable !< codice della variabile
662CHARACTER(len=*),INTENT(in),OPTIONAL :: description !< descrizione della variabile
663CHARACTER(len=*),INTENT(in),OPTIONAL :: unit !< unità di misura
664INTEGER,INTENT(in),OPTIONAL :: scalefactor !< decimali nella rappresentazione intera e character
665
666IF (PRESENT(btable)) THEN
667 this%btable = btable
668ELSE
669 this%btable = cmiss
670 this%description = cmiss
671 this%unit = cmiss
672 this%scalefactor = imiss
673 RETURN
674ENDIF
675IF (PRESENT(description)) THEN
676 this%description = description
677ELSE
678 this%description = cmiss
679ENDIF
680IF (PRESENT(unit)) THEN
681 this%unit = unit
682ELSE
683 this%unit = cmiss
684ENDIF
685if (present(scalefactor)) then
686 this%scalefactor = scalefactor
687else
688 this%scalefactor = imiss
689endif
690
691this%r = -1
692this%d = -1
693this%i = -1
694this%b = -1
695this%c = -1
696
697END SUBROUTINE vol7d_var_init
698
699
700ELEMENTAL FUNCTION vol7d_var_new(btable, description, unit, scalefactor) RESULT(this)
701CHARACTER(len=*),INTENT(in),OPTIONAL :: btable !< codice della variabile
702CHARACTER(len=*),INTENT(in),OPTIONAL :: description !< descrizione della variabile
703CHARACTER(len=*),INTENT(in),OPTIONAL :: unit !< unità di misura
704INTEGER,INTENT(in),OPTIONAL :: scalefactor !< decimali nella rappresentazione intera e character
705
706TYPE(vol7d_var) :: this
707
708CALL init(this, btable, description, unit, scalefactor)
709
710END FUNCTION vol7d_var_new
711
712
713!> Distrugge l'oggetto in maniera pulita, assegnandogli un valore mancante.
714elemental SUBROUTINE vol7d_var_delete(this)
715TYPE(vol7d_var),INTENT(INOUT) :: this !< oggetto da distruggre
716
717this%btable = cmiss
718this%description = cmiss
719this%unit = cmiss
720this%scalefactor = imiss
721
722END SUBROUTINE vol7d_var_delete
723
724
725ELEMENTAL FUNCTION vol7d_var_eq(this, that) RESULT(res)
726TYPE(vol7d_var),INTENT(IN) :: this, that
727LOGICAL :: res
728
729res = this%btable == that%btable
730
731END FUNCTION vol7d_var_eq
732
733
734ELEMENTAL FUNCTION vol7d_var_ne(this, that) RESULT(res)
735TYPE(vol7d_var),INTENT(IN) :: this, that
736LOGICAL :: res
737
738res = .NOT.(this == that)
739
740END FUNCTION vol7d_var_ne
741
742
743FUNCTION vol7d_var_nesv(this, that) RESULT(res)
744TYPE(vol7d_var),INTENT(IN) :: this, that(:)
745LOGICAL :: res(SIZE(that))
746
747INTEGER :: i
748
749DO i = 1, SIZE(that)
750 res(i) = .NOT.(this == that(i))
751ENDDO
752
753END FUNCTION vol7d_var_nesv
754
755
756
757!> \brief display on the screen a brief content of vol7d_var object
758subroutine display_var(this)
759
760TYPE(vol7d_var),INTENT(in) :: this !< vol7d_var object to display
761
762print*,"VOL7DVAR: ",this%btable,trim(this%description)," : ",this%unit,&
763 " scale factor",this%scalefactor
764
765end subroutine display_var
766
767
768!> \brief display on the screen a brief content of vector of vol7d_var object
769subroutine display_var_vect(this)
770
771TYPE(vol7d_var),INTENT(in) :: this(:) !< vol7d_var vector object to display
772integer :: i
773
774do i=1,size(this)
775 call display_var(this(i))
776end do
777
778end subroutine display_var_vect
779
780FUNCTION vol7d_var_c_e(this) RESULT(c_e)
781TYPE(vol7d_var),INTENT(IN) :: this
782LOGICAL :: c_e
783c_e = this /= vol7d_var_miss
784END FUNCTION vol7d_var_c_e
785
786
787!> Initialise the global table of variable features.
788!! This subroutine reads the table of variable features from an
789!! external file and stores it in a global array. It has to be called
790!! once at the beginning of the program. At the moment it gives access
791!! to the information about type of variable and positive
792!! definitness. The table is based on the unique bufr-like variable
793!! table. The table is contained in the csv file `vargrib.csv`.
794!! It is not harmful to call this subroutine multiple times.
795SUBROUTINE vol7d_var_features_init()
796INTEGER :: un, i, n
797TYPE(csv_record) :: csv
798CHARACTER(len=1024) :: line
799
800IF (ALLOCATED(var_features)) RETURN
801
802un = open_package_file('varbufr.csv', filetype_data)
803n=0
804DO WHILE(.true.)
805 READ(un,*,END=100)
806 n = n + 1
807ENDDO
808
809100 CONTINUE
810
811rewind(un)
812ALLOCATE(var_features(n))
813
814DO i = 1, n
815 READ(un,'(A)',END=200)line
816 CALL init(csv, line)
817 CALL csv_record_getfield(csv, var_features(i)%var%btable)
818 CALL csv_record_getfield(csv)
819 CALL csv_record_getfield(csv)
820 CALL csv_record_getfield(csv, var_features(i)%posdef)
821 CALL csv_record_getfield(csv, var_features(i)%vartype)
822 CALL delete(csv)
823ENDDO
824
825200 CONTINUE
826CLOSE(un)
827
828END SUBROUTINE vol7d_var_features_init
829
830
831!> Deallocate the global table of variable features.
832!! This subroutine deallocates the table of variable features
833!! allocated in the `vol7d_var_features_init` subroutine.
834SUBROUTINE vol7d_var_features_delete()
835IF (ALLOCATED(var_features)) DEALLOCATE(var_features)
836END SUBROUTINE vol7d_var_features_delete
837
838
839!> Return the physical type of the variable.
840!! Returns a rough classification of the variable depending on the
841!! physical parameter it represents. The result is one of the
842!! constants vartype_* defined in the module. To be extended.
843!! In order for this to work, the subroutine \a
844!! vol7d_var_features_init has to be preliminary called.
845ELEMENTAL FUNCTION vol7d_var_features_vartype(this) RESULT(vartype)
846TYPE(vol7d_var),INTENT(in) :: this !< vol7d_var object to be tested
847INTEGER :: vartype
848
849INTEGER :: i
850
851vartype = imiss
852
853IF (ALLOCATED(var_features)) THEN
854 DO i = 1, SIZE(var_features)
855 IF (this == var_features(i)%var) THEN
856 vartype = var_features(i)%vartype
857 RETURN
858 ENDIF
859 ENDDO
860ENDIF
861
862END FUNCTION vol7d_var_features_vartype
863
864
865!> Apply a positive definite flag to a variable.
866!! This subroutine resets the value of a variable depending on its
867!! positive definite flag defined in the associated \a c_func object.
868!! The \a c_func object can be obtained for example by the \a convert
869!! (interfaced to vargrib2varbufr_convert) function. The value is
870!! reset to the maximum between the value itsel and and 0 (or the
871!! value set in \a c_func%posdef. These values are set from the
872!! vargrib2bufr.csv file.
873!! In order for this to work, the subroutine \a
874!! vol7d_var_features_init has to be preliminary called.
875ELEMENTAL SUBROUTINE vol7d_var_features_posdef_apply(this, val)
876TYPE(vol7d_var),INTENT(in) :: this !< vol7d_var object to be reset
877REAL,INTENT(inout) :: val !< value to be reset, it is reset in place
878
879INTEGER :: i
880
881IF (ALLOCATED(var_features)) THEN
882 DO i = 1, SIZE(var_features)
883 IF (this == var_features(i)%var) THEN
884 IF (c_e(var_features(i)%posdef)) val = max(var_features(i)%posdef, val)
885 RETURN
886 ENDIF
887 ENDDO
888ENDIF
889
890END SUBROUTINE vol7d_var_features_posdef_apply
891
892
893!> Return the physical type of the variable.
894!! Returns a rough classification of the variable depending on the
895!! physical parameter it represents. The result is one of the
896!! constants vartype_* defined in the module. To be extended.
897ELEMENTAL FUNCTION vol7d_vartype(this) RESULT(vartype)
898TYPE(vol7d_var),INTENT(in) :: this !< vol7d_var object to be tested
899
900INTEGER :: vartype
901
902vartype = var_ord
903SELECT CASE(this%btable)
904CASE('B01012', 'B11001', 'B11043', 'B22001') ! direction, degree true
905 vartype = var_dir360
906CASE('B07004', 'B10004', 'B10051', 'B10060') ! pressure, Pa
907 vartype = var_press
908CASE('B11003', 'B11200') ! u-component
909 vartype = var_ucomp
910CASE('B11004', 'B11201') ! v-component
911 vartype = var_vcomp
912CASE('B11005', 'B11006') ! w-component
913 vartype = var_wcomp
914END SELECT
915
916END FUNCTION vol7d_vartype
917
918
919#include "array_utilities_inc.F90"
920
921
922END 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.