libsim Versione 7.2.6

◆ vol7d_var_delete()

elemental subroutine vol7d_var_delete ( type(vol7d_var), intent(inout) this)

Distrugge l'oggetto in maniera pulita, assegnandogli un valore mancante.

Parametri
[in,out]thisoggetto da distruggre

Definizione alla linea 412 del file vol7d_var_class.F90.

413! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
414! authors:
415! Davide Cesari <dcesari@arpa.emr.it>
416! Paolo Patruno <ppatruno@arpa.emr.it>
417
418! This program is free software; you can redistribute it and/or
419! modify it under the terms of the GNU General Public License as
420! published by the Free Software Foundation; either version 2 of
421! the License, or (at your option) any later version.
422
423! This program is distributed in the hope that it will be useful,
424! but WITHOUT ANY WARRANTY; without even the implied warranty of
425! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
426! GNU General Public License for more details.
427
428! You should have received a copy of the GNU General Public License
429! along with this program. If not, see <http://www.gnu.org/licenses/>.
430#include "config.h"
431
432!> Classe per la gestione delle variabili osservate da stazioni meteo e affini.
433!! Questo modulo definisce una classe per rappresentare variabili meteorologiche
434!! osservate, o attributi, aventi diversi tipi numerici o carattere.
435!! \ingroup vol7d
436MODULE vol7d_var_class
437USE kinds
440IMPLICIT NONE
441
442!> Definisce una variabile meteorologica osservata o un suo attributo.
443!! I membri \a r, \a d, \a i, \a b, \a c servono, internamente a vol7d,
444!! per associare le variabili agli attributi, e indicano
445!! a quale variabile, nel descrittore delle variabili, coincide
446!! la variabile corrente nel descrittore delle "variabili aventi attributo".
447!! I membri di \a vol7d_var sono pubblici e quindi liberamente
448!! accessibili e scrivibili, ma è comunque consigliato assegnarli tramite
449!! il costruttore ::init.
450TYPE vol7d_var
451 CHARACTER(len=10) :: btable=cmiss !< codice della variabile secondo la tabella B del WMO.
452 CHARACTER(len=65) :: description=cmiss !< descrizione testuale della variabile (opzionale)
453 CHARACTER(len=24) :: unit=cmiss !< descrizione testuale dell'unità di misura (opzionale)
454 INTEGER :: scalefactor=imiss !< numero di decimali nella rappresentazione intera o character (opzionale)
455
456 INTEGER :: r=imiss !< indice della variabile nel volume degli attributi reali
457 INTEGER :: d=imiss !< indice della variabile nel volume degli attributi double precision
458 INTEGER :: i=imiss !< indice della variabile nel volume degli attributi integer
459 INTEGER :: b=imiss !< indice della variabile nel volume degli attributi byte
460 INTEGER :: c=imiss !< indice della variabile nel volume degli attributi character
461 INTEGER :: gribhint(4)=imiss !< hint for conversion from/to grib when btable is not found
462END TYPE vol7d_var
463
464!> Valore mancante per vol7d_var.
465TYPE(vol7d_var),PARAMETER :: vol7d_var_miss= &
466 vol7d_var(cmiss,cmiss,cmiss,imiss,imiss,imiss,imiss,imiss,imiss, &
467 (/imiss,imiss,imiss,imiss/))
468
469!> Costruttore per la classe vol7d_var.
470!! Deve essere richiamato
471!! per tutti gli oggetti di questo tipo definiti in un programma.
472INTERFACE init
473 MODULE PROCEDURE vol7d_var_init
474END INTERFACE
475
476!> Distruttore per la classe vol7d_var.
477!! Distrugge l'oggetto in maniera pulita, assegnandogli un valore mancante.
478INTERFACE delete
479 MODULE PROCEDURE vol7d_var_delete
480END INTERFACE
481
482!> Operatore logico di uguaglianza tra oggetti della classe vol7d_var.
483!! Funziona anche per
484!! confronti di tipo array-array (qualsiasi n. di dimensioni) e di tipo
485!! scalare-vettore(1-d) (ma non vettore(1-d)-scalare o tra array con più
486!! di 1 dimensione e scalari).
487INTERFACE OPERATOR (==)
488 MODULE PROCEDURE vol7d_var_eq
489END INTERFACE
490
491!> Operatore logico di disuguaglianza tra oggetti della classe vol7d_var.
492!! Funziona anche per
493!! confronti di tipo array-array (qualsiasi n. di dimensioni) e di tipo
494!! scalare-vettore(1-d) (ma non vettore(1-d)-scalare o tra array con più
495!! di 1 dimensione e scalari).
496INTERFACE OPERATOR (/=)
497 MODULE PROCEDURE vol7d_var_ne, vol7d_var_nesv
498END INTERFACE
499
500!> to be documented
501INTERFACE c_e
502 MODULE PROCEDURE vol7d_var_c_e
503END INTERFACE
504
505#define VOL7D_POLY_TYPE TYPE(vol7d_var)
506#define VOL7D_POLY_TYPES _var
507#include "array_utilities_pre.F90"
508
509!> \brief display on the screen a brief content of object
510INTERFACE display
511 MODULE PROCEDURE display_var, display_var_vect
512END INTERFACE
513
514
515TYPE vol7d_var_features
516 TYPE(vol7d_var) :: var !< the variable (only btable is relevant)
517 REAL :: posdef !< if not missing, minimum physically reasonable value for the variable
518 INTEGER :: vartype !< type of variable, one of the var_* constants
519END TYPE vol7d_var_features
520
521TYPE(vol7d_var_features),ALLOCATABLE :: var_features(:)
522
523! constants for vol7d_vartype
524INTEGER,PARAMETER :: var_ord=0 !< unclassified variable (vol7d_vartype function)
525INTEGER,PARAMETER :: var_dir360=1 !< direction in degrees (vol7d_vartype function)
526INTEGER,PARAMETER :: var_press=2 !< pressure in Pa (vol7d_vartype function)
527INTEGER,PARAMETER :: var_ucomp=3 !< u component of a vector field (vol7d_vartype function)
528INTEGER,PARAMETER :: var_vcomp=4 !< v component of a vector field (vol7d_vartype function)
529INTEGER,PARAMETER :: var_wcomp=5 !< w component of a vector field (vol7d_vartype function)
530
531
532CONTAINS
533
534!> Inizializza un oggetto \a vol7d_var con i parametri opzionali forniti.
535!! Se non viene passato nessun parametro opzionale l'oggetto è
536!! inizializzato a valore mancante.
537!! I membri \a r, \a d, \a i, \a b, \a c non possono essere assegnati
538!! tramite costruttore, ma solo direttamente.
539elemental SUBROUTINE vol7d_var_init(this, btable, description, unit, scalefactor)
540TYPE(vol7d_var),INTENT(INOUT) :: this !< oggetto da inizializzare
541CHARACTER(len=*),INTENT(in),OPTIONAL :: btable !< codice della variabile
542CHARACTER(len=*),INTENT(in),OPTIONAL :: description !< descrizione della variabile
543CHARACTER(len=*),INTENT(in),OPTIONAL :: unit !< unità di misura
544INTEGER,INTENT(in),OPTIONAL :: scalefactor !< decimali nella rappresentazione intera e character
545
546IF (PRESENT(btable)) THEN
547 this%btable = btable
548ELSE
549 this%btable = cmiss
550 this%description = cmiss
551 this%unit = cmiss
552 this%scalefactor = imiss
553 RETURN
554ENDIF
555IF (PRESENT(description)) THEN
556 this%description = description
557ELSE
558 this%description = cmiss
559ENDIF
560IF (PRESENT(unit)) THEN
561 this%unit = unit
562ELSE
563 this%unit = cmiss
564ENDIF
565if (present(scalefactor)) then
566 this%scalefactor = scalefactor
567else
568 this%scalefactor = imiss
569endif
570
571this%r = -1
572this%d = -1
573this%i = -1
574this%b = -1
575this%c = -1
576
577END SUBROUTINE vol7d_var_init
578
579
580ELEMENTAL FUNCTION vol7d_var_new(btable, description, unit, scalefactor) RESULT(this)
581CHARACTER(len=*),INTENT(in),OPTIONAL :: btable !< codice della variabile
582CHARACTER(len=*),INTENT(in),OPTIONAL :: description !< descrizione della variabile
583CHARACTER(len=*),INTENT(in),OPTIONAL :: unit !< unità di misura
584INTEGER,INTENT(in),OPTIONAL :: scalefactor !< decimali nella rappresentazione intera e character
585
586TYPE(vol7d_var) :: this
587
588CALL init(this, btable, description, unit, scalefactor)
589
590END FUNCTION vol7d_var_new
591
592
593!> Distrugge l'oggetto in maniera pulita, assegnandogli un valore mancante.
594elemental SUBROUTINE vol7d_var_delete(this)
595TYPE(vol7d_var),INTENT(INOUT) :: this !< oggetto da distruggre
596
597this%btable = cmiss
598this%description = cmiss
599this%unit = cmiss
600this%scalefactor = imiss
601
602END SUBROUTINE vol7d_var_delete
603
604
605ELEMENTAL FUNCTION vol7d_var_eq(this, that) RESULT(res)
606TYPE(vol7d_var),INTENT(IN) :: this, that
607LOGICAL :: res
608
609res = this%btable == that%btable
610
611END FUNCTION vol7d_var_eq
612
613
614ELEMENTAL FUNCTION vol7d_var_ne(this, that) RESULT(res)
615TYPE(vol7d_var),INTENT(IN) :: this, that
616LOGICAL :: res
617
618res = .NOT.(this == that)
619
620END FUNCTION vol7d_var_ne
621
622
623FUNCTION vol7d_var_nesv(this, that) RESULT(res)
624TYPE(vol7d_var),INTENT(IN) :: this, that(:)
625LOGICAL :: res(SIZE(that))
626
627INTEGER :: i
628
629DO i = 1, SIZE(that)
630 res(i) = .NOT.(this == that(i))
631ENDDO
632
633END FUNCTION vol7d_var_nesv
634
635
636
637!> \brief display on the screen a brief content of vol7d_var object
638subroutine display_var(this)
639
640TYPE(vol7d_var),INTENT(in) :: this !< vol7d_var object to display
641
642print*,"VOL7DVAR: ",this%btable,trim(this%description)," : ",this%unit,&
643 " scale factor",this%scalefactor
644
645end subroutine display_var
646
647
648!> \brief display on the screen a brief content of vector of vol7d_var object
649subroutine display_var_vect(this)
650
651TYPE(vol7d_var),INTENT(in) :: this(:) !< vol7d_var vector object to display
652integer :: i
653
654do i=1,size(this)
655 call display_var(this(i))
656end do
657
658end subroutine display_var_vect
659
660FUNCTION vol7d_var_c_e(this) RESULT(c_e)
661TYPE(vol7d_var),INTENT(IN) :: this
662LOGICAL :: c_e
663c_e = this /= vol7d_var_miss
664END FUNCTION vol7d_var_c_e
665
666
667!> Initialise the global table of variable features.
668!! This subroutine reads the table of variable features from an
669!! external file and stores it in a global array. It has to be called
670!! once at the beginning of the program. At the moment it gives access
671!! to the information about type of variable and positive
672!! definitness. The table is based on the unique bufr-like variable
673!! table. The table is contained in the csv file `vargrib.csv`.
674!! It is not harmful to call this subroutine multiple times.
675SUBROUTINE vol7d_var_features_init()
676INTEGER :: un, i, n
677TYPE(csv_record) :: csv
678CHARACTER(len=1024) :: line
679
680IF (ALLOCATED(var_features)) RETURN
681
682un = open_package_file('varbufr.csv', filetype_data)
683n=0
684DO WHILE(.true.)
685 READ(un,*,END=100)
686 n = n + 1
687ENDDO
688
689100 CONTINUE
690
691rewind(un)
692ALLOCATE(var_features(n))
693
694DO i = 1, n
695 READ(un,'(A)',END=200)line
696 CALL init(csv, line)
697 CALL csv_record_getfield(csv, var_features(i)%var%btable)
698 CALL csv_record_getfield(csv)
699 CALL csv_record_getfield(csv)
700 CALL csv_record_getfield(csv, var_features(i)%posdef)
701 CALL csv_record_getfield(csv, var_features(i)%vartype)
702 CALL delete(csv)
703ENDDO
704
705200 CONTINUE
706CLOSE(un)
707
708END SUBROUTINE vol7d_var_features_init
709
710
711!> Deallocate the global table of variable features.
712!! This subroutine deallocates the table of variable features
713!! allocated in the `vol7d_var_features_init` subroutine.
714SUBROUTINE vol7d_var_features_delete()
715IF (ALLOCATED(var_features)) DEALLOCATE(var_features)
716END SUBROUTINE vol7d_var_features_delete
717
718
719!> Return the physical type of the variable.
720!! Returns a rough classification of the variable depending on the
721!! physical parameter it represents. The result is one of the
722!! constants vartype_* defined in the module. To be extended.
723!! In order for this to work, the subroutine \a
724!! vol7d_var_features_init has to be preliminary called.
725ELEMENTAL FUNCTION vol7d_var_features_vartype(this) RESULT(vartype)
726TYPE(vol7d_var),INTENT(in) :: this !< vol7d_var object to be tested
727INTEGER :: vartype
728
729INTEGER :: i
730
731vartype = imiss
732
733IF (ALLOCATED(var_features)) THEN
734 DO i = 1, SIZE(var_features)
735 IF (this == var_features(i)%var) THEN
736 vartype = var_features(i)%vartype
737 RETURN
738 ENDIF
739 ENDDO
740ENDIF
741
742END FUNCTION vol7d_var_features_vartype
743
744
745!> Apply a positive definite flag to a variable.
746!! This subroutine resets the value of a variable depending on its
747!! positive definite flag defined in the associated \a c_func object.
748!! The \a c_func object can be obtained for example by the \a convert
749!! (interfaced to vargrib2varbufr_convert) function. The value is
750!! reset to the maximum between the value itsel and and 0 (or the
751!! value set in \a c_func%posdef. These values are set from the
752!! vargrib2bufr.csv file.
753!! In order for this to work, the subroutine \a
754!! vol7d_var_features_init has to be preliminary called.
755ELEMENTAL SUBROUTINE vol7d_var_features_posdef_apply(this, val)
756TYPE(vol7d_var),INTENT(in) :: this !< vol7d_var object to be reset
757REAL,INTENT(inout) :: val !< value to be reset, it is reset in place
758
759INTEGER :: i
760
761IF (ALLOCATED(var_features)) THEN
762 DO i = 1, SIZE(var_features)
763 IF (this == var_features(i)%var) THEN
764 IF (c_e(var_features(i)%posdef)) val = max(var_features(i)%posdef, val)
765 RETURN
766 ENDIF
767 ENDDO
768ENDIF
769
770END SUBROUTINE vol7d_var_features_posdef_apply
771
772
773!> Return the physical type of the variable.
774!! Returns a rough classification of the variable depending on the
775!! physical parameter it represents. The result is one of the
776!! constants vartype_* defined in the module. To be extended.
777ELEMENTAL FUNCTION vol7d_vartype(this) RESULT(vartype)
778TYPE(vol7d_var),INTENT(in) :: this !< vol7d_var object to be tested
779
780INTEGER :: vartype
781
782vartype = var_ord
783SELECT CASE(this%btable)
784CASE('B01012', 'B11001', 'B11043', 'B22001') ! direction, degree true
785 vartype = var_dir360
786CASE('B07004', 'B10004', 'B10051', 'B10060') ! pressure, Pa
787 vartype = var_press
788CASE('B11003', 'B11200') ! u-component
789 vartype = var_ucomp
790CASE('B11004', 'B11201') ! v-component
791 vartype = var_vcomp
792CASE('B11005', 'B11006') ! w-component
793 vartype = var_wcomp
794END SELECT
795
796END FUNCTION vol7d_vartype
797
798
799#include "array_utilities_inc.F90"
800
801
802END 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.