libsim Versione 7.2.6

◆ vol7d_level_delete()

subroutine vol7d_level_delete ( type(vol7d_level), intent(inout) this)

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

Parametri
[in,out]thisoggetto da distruggre

Definizione alla linea 479 del file vol7d_level_class.F90.

480! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
481! authors:
482! Davide Cesari <dcesari@arpa.emr.it>
483! Paolo Patruno <ppatruno@arpa.emr.it>
484
485! This program is free software; you can redistribute it and/or
486! modify it under the terms of the GNU General Public License as
487! published by the Free Software Foundation; either version 2 of
488! the License, or (at your option) any later version.
489
490! This program is distributed in the hope that it will be useful,
491! but WITHOUT ANY WARRANTY; without even the implied warranty of
492! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
493! GNU General Public License for more details.
494
495! You should have received a copy of the GNU General Public License
496! along with this program. If not, see <http://www.gnu.org/licenses/>.
497#include "config.h"
498
499!> Classe per la gestione dei livelli verticali in osservazioni meteo e affini.
500!! Questo modulo definisce una classe per rappresentare la localizzazione
501!! verticale di un'osservazione meteorologica, prendendo in prestito
502!! concetti dal formato grib.
503!! \ingroup vol7d
505USE kinds
508IMPLICIT NONE
509
510!> Definisce il livello verticale di un'osservazione.
511!! I membri di \a vol7d_level sono pubblici e quindi liberamente
512!! accessibili e scrivibili, ma è comunque consigliato assegnarli tramite
513!! il costruttore ::init.
514TYPE vol7d_level
515 INTEGER :: level1 !< tipo di livello o strato verticale (vedi tabella 4.5 formato grib2 WMO http://www.wmo.int/pages/prog/www/WMOCodes/WMO306_vI2/LatestVERSION/WMO306_vI2_GRIB2_CodeFlag_en.pdf)
516 INTEGER :: l1 !< valore numerico del primo livello, se previsto da \a level1
517 INTEGER :: level2 !< tipo di livello o strato verticale (vedi tabella 4.5 formato grib2 WMO http://www.wmo.int/pages/prog/www/WMOCodes/WMO306_vI2/LatestVERSION/WMO306_vI2_GRIB2_CodeFlag_en.pdf)
518 INTEGER :: l2 !< valore numerico del secondo livello, se previsto da \a level2
519END TYPE vol7d_level
520
521!> Valore mancante per vol7d_level.
522TYPE(vol7d_level),PARAMETER :: vol7d_level_miss=vol7d_level(imiss,imiss,imiss,imiss)
523
524!> Costruttore per la classe vol7d_level.
525!! Deve essere richiamato
526!! per tutti gli oggetti di questo tipo definiti in un programma.
527INTERFACE init
528 MODULE PROCEDURE vol7d_level_init
529END INTERFACE
530
531!> Distruttore per la classe vol7d_level.
532!! Distrugge l'oggetto in maniera pulita, assegnandogli un valore mancante.
533INTERFACE delete
534 MODULE PROCEDURE vol7d_level_delete
535END INTERFACE
536
537!> Logical equality operator for objects of \a vol7d_level class.
538!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
539!! of any shape.
540INTERFACE OPERATOR (==)
541 MODULE PROCEDURE vol7d_level_eq
542END INTERFACE
543
544!> Logical inequality operator for objects of \a vol7d_level class.
545!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
546!! of any shape.
547INTERFACE OPERATOR (/=)
548 MODULE PROCEDURE vol7d_level_ne
549END INTERFACE
550
551!> Logical greater-than operator for objects of \a vol7d_level class.
552!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
553!! of any shape.
554!! Comparison is performed first on \a level, then, then on \l1, then
555!! on \l2 if defined.
556INTERFACE OPERATOR (>)
557 MODULE PROCEDURE vol7d_level_gt
558END INTERFACE
559
560!> Logical less-than operator for objects of \a vol7d_level class.
561!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
562!! of any shape.
563!! Comparison is performed first on \a level, then, then on \l1, then
564!! on \l2 if defined.
565INTERFACE OPERATOR (<)
566 MODULE PROCEDURE vol7d_level_lt
567END INTERFACE
568
569!> Logical greater-equal operator for objects of \a vol7d_level class.
570!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
571!! of any shape.
572!! Comparison is performed first on \a level, then, then on \l1, then
573!! on \l2 if defined.
574INTERFACE OPERATOR (>=)
575 MODULE PROCEDURE vol7d_level_ge
576END INTERFACE
577
578!> Logical less-equal operator for objects of \a vol7d_level class.
579!! It is defined as \a ELEMENTAL thus it works also with conformal arrays
580!! of any shape.
581!! Comparison is performed first on \a level, then, then on \l1, then
582!! on \l2 if defined.
583INTERFACE OPERATOR (<=)
584 MODULE PROCEDURE vol7d_level_le
585END INTERFACE
586
587!> Logical almost equality operators for objects of the class \a
588!! vol7d_level
589!! If one component is missing it is not used in comparison
590INTERFACE OPERATOR (.almosteq.)
591 MODULE PROCEDURE vol7d_level_almost_eq
592END INTERFACE
593
594
595! da documentare in inglese assieme al resto
596!> to be documented
597INTERFACE c_e
598 MODULE PROCEDURE vol7d_level_c_e
599END INTERFACE
600
601#define VOL7D_POLY_TYPE TYPE(vol7d_level)
602#define VOL7D_POLY_TYPES _level
603#define ENABLE_SORT
604#include "array_utilities_pre.F90"
605
606!>Print object
607INTERFACE display
608 MODULE PROCEDURE display_level
609END INTERFACE
610
611!>Represent level object in a pretty string
612INTERFACE to_char
613 MODULE PROCEDURE to_char_level
614END INTERFACE
615
616!> Convert a level type to a physical variable
617INTERFACE vol7d_level_to_var
618 MODULE PROCEDURE vol7d_level_to_var_int, vol7d_level_to_var_lev
619END INTERFACE vol7d_level_to_var
620
621!> Return the conversion factor for multiplying the level value when converting to variable
623 MODULE PROCEDURE vol7d_level_to_var_factor_int, vol7d_level_to_var_factor_lev
624END INTERFACE vol7d_level_to_var_factor
625
626!> Return the scale value (base 10 log of conversion factor) for multiplying the level value when converting to variable
628 MODULE PROCEDURE vol7d_level_to_var_log10_int, vol7d_level_to_var_log10_lev
629END INTERFACE vol7d_level_to_var_log10
630
631type(vol7d_level) :: almost_equal_levels(3)=(/&
632 vol7d_level( 1,imiss,imiss,imiss),&
633 vol7d_level(103,imiss,imiss,imiss),&
634 vol7d_level(106,imiss,imiss,imiss)/)
635
636! levels requiring conversion from internal to physical representation
637INTEGER, PARAMETER :: &
638 height_level(6) = (/102,103,106,117,160,161/), & ! 10**-3
639 thermo_level(3) = (/20,107,235/), & ! 10**-1
640 sigma_level(2) = (/104,111/) ! 10**-4
641
642TYPE level_var
643 INTEGER :: level
644 CHARACTER(len=10) :: btable
645END TYPE level_var
646
647! Conversion table from GRIB2 vertical level codes to corresponding
648! BUFR B table variables
649TYPE(level_var),PARAMETER :: level_var_converter(7) = (/ &
650 level_var(20, 'B12101'), & ! isothermal (K)
651 level_var(100, 'B10004'), & ! isobaric (Pa)
652 level_var(102, 'B10007'), & ! height over sea level (m)
653 level_var(103, 'B10007'), & ! height over surface (m) (special treatment needed!)
654 level_var(107, 'B12192'), & ! isentropical (K)
655 level_var(108, 'B10004'), & ! pressure difference from surface (Pa) (special treatment needed!)
656 level_var(161, 'B22195') /) ! depth below sea surface
657
658PRIVATE level_var, level_var_converter
659
660CONTAINS
661
662!> Inizializza un oggetto \a vol7d_level con i parametri opzionali forniti.
663!! Questa è la versione \c FUNCTION, in stile F2003, del costruttore, da preferire
664!! rispetto alla versione \c SUBROUTINE \c init.
665!! Se non viene passato nessun parametro opzionale l'oggetto è
666!! inizializzato a valore mancante.
667FUNCTION vol7d_level_new(level1, l1, level2, l2) RESULT(this)
668INTEGER,INTENT(IN),OPTIONAL :: level1 !< type for level 1
669INTEGER,INTENT(IN),OPTIONAL :: l1 !< value for level 1
670INTEGER,INTENT(IN),OPTIONAL :: level2 !< type for level 2
671INTEGER,INTENT(IN),OPTIONAL :: l2 !< value for level 2
672
673TYPE(vol7d_level) :: this !< object to initialize
674
675CALL init(this, level1, l1, level2, l2)
676
677END FUNCTION vol7d_level_new
678
679
680!> Inizializza un oggetto \a vol7d_level con i parametri opzionali forniti.
681!! Se non viene passato nessun parametro opzionale l'oggetto è
682!! inizializzato a valore mancante.
683SUBROUTINE vol7d_level_init(this, level1, l1, level2, l2)
684TYPE(vol7d_level),INTENT(INOUT) :: this !< oggetto da inizializzare
685INTEGER,INTENT(IN),OPTIONAL :: level1 !< type for level 1
686INTEGER,INTENT(IN),OPTIONAL :: l1 !< value for level 1
687INTEGER,INTENT(IN),OPTIONAL :: level2 !< type for level 2
688INTEGER,INTENT(IN),OPTIONAL :: l2 !< value for level 2
689
690this%level1 = imiss
691this%l1 = imiss
692this%level2 = imiss
693this%l2 = imiss
694
695IF (PRESENT(level1)) THEN
696 this%level1 = level1
697ELSE
698 RETURN
699END IF
700
701IF (PRESENT(l1)) this%l1 = l1
702
703IF (PRESENT(level2)) THEN
704 this%level2 = level2
705ELSE
706 RETURN
707END IF
708
709IF (PRESENT(l2)) this%l2 = l2
710
711END SUBROUTINE vol7d_level_init
712
713
714!> Distrugge l'oggetto in maniera pulita, assegnandogli un valore mancante.
715SUBROUTINE vol7d_level_delete(this)
716TYPE(vol7d_level),INTENT(INOUT) :: this !< oggetto da distruggre
717
718this%level1 = imiss
719this%l1 = imiss
720this%level2 = imiss
721this%l2 = imiss
722
723END SUBROUTINE vol7d_level_delete
724
725
726SUBROUTINE display_level(this)
727TYPE(vol7d_level),INTENT(in) :: this
728
729print*,trim(to_char(this))
730
731END SUBROUTINE display_level
732
733
734FUNCTION to_char_level(this)
735#ifdef HAVE_DBALLE
736USE dballef
737#endif
738TYPE(vol7d_level),INTENT(in) :: this
739CHARACTER(len=255) :: to_char_level
740
741#ifdef HAVE_DBALLE
742INTEGER :: handle, ier
743
744handle = 0
745ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
746ier = idba_spiegal(handle,this%level1,this%l1,this%level2,this%l2,to_char_level)
747ier = idba_fatto(handle)
748
749to_char_level="LEVEL: "//to_char_level
750
751#else
752
753to_char_level="LEVEL: "//&
754 " typelev1:"//trim(to_char(this%level1))//" L1:"//trim(to_char(this%l1))//&
755 " typelev2:"//trim(to_char(this%level2))//" L2:"//trim(to_char(this%l2))
756
757#endif
758
759END FUNCTION to_char_level
760
761
762ELEMENTAL FUNCTION vol7d_level_eq(this, that) RESULT(res)
763TYPE(vol7d_level),INTENT(IN) :: this, that
764LOGICAL :: res
765
766res = &
767 this%level1 == that%level1 .AND. &
768 this%level2 == that%level2 .AND. &
769 this%l1 == that%l1 .AND. this%l2 == that%l2
770
771END FUNCTION vol7d_level_eq
772
773
774ELEMENTAL FUNCTION vol7d_level_ne(this, that) RESULT(res)
775TYPE(vol7d_level),INTENT(IN) :: this, that
776LOGICAL :: res
777
778res = .NOT.(this == that)
779
780END FUNCTION vol7d_level_ne
781
782
783ELEMENTAL FUNCTION vol7d_level_almost_eq(this, that) RESULT(res)
784TYPE(vol7d_level),INTENT(IN) :: this, that
785LOGICAL :: res
786
787IF ( .not. c_e(this%level1) .or. .not. c_e(that%level1) .or. this%level1 == that%level1 .AND. &
788 .not. c_e(this%level2) .or. .not. c_e(that%level2) .or. this%level2 == that%level2 .AND. &
789 .not. c_e(this%l1) .or. .not. c_e(that%l1) .or. this%l1 == that%l1 .AND. &
790 .not. c_e(this%l2) .or. .not. c_e(that%l2) .or. this%l2 == that%l2) THEN
791 res = .true.
792ELSE
793 res = .false.
794ENDIF
795
796END FUNCTION vol7d_level_almost_eq
797
798
799ELEMENTAL FUNCTION vol7d_level_gt(this, that) RESULT(res)
800TYPE(vol7d_level),INTENT(IN) :: this, that
801LOGICAL :: res
802
803IF (&
804 this%level1 > that%level1 .OR. &
805 (this%level1 == that%level1 .AND. this%l1 > that%l1) .OR. &
806 (this%level1 == that%level1 .AND. this%l1 == that%l1 .AND. &
807 (&
808 this%level2 > that%level2 .OR. &
809 (this%level2 == that%level2 .AND. this%l2 > that%l2) &
810 ))) THEN
811 res = .true.
812ELSE
813 res = .false.
814ENDIF
815
816END FUNCTION vol7d_level_gt
817
818
819ELEMENTAL FUNCTION vol7d_level_lt(this, that) RESULT(res)
820TYPE(vol7d_level),INTENT(IN) :: this, that
821LOGICAL :: res
822
823IF (&
824 this%level1 < that%level1 .OR. &
825 (this%level1 == that%level1 .AND. this%l1 < that%l1) .OR. &
826 (this%level1 == that%level1 .AND. this%l1 == that%l1 .AND. &
827 (&
828 this%level2 < that%level2 .OR. &
829 (this%level2 == that%level2 .AND. this%l2 < that%l2) &
830 ))) THEN
831 res = .true.
832ELSE
833 res = .false.
834ENDIF
835
836END FUNCTION vol7d_level_lt
837
838
839ELEMENTAL FUNCTION vol7d_level_ge(this, that) RESULT(res)
840TYPE(vol7d_level),INTENT(IN) :: this, that
841LOGICAL :: res
842
843IF (this == that) THEN
844 res = .true.
845ELSE IF (this > that) THEN
846 res = .true.
847ELSE
848 res = .false.
849ENDIF
850
851END FUNCTION vol7d_level_ge
852
853
854ELEMENTAL FUNCTION vol7d_level_le(this, that) RESULT(res)
855TYPE(vol7d_level),INTENT(IN) :: this, that
856LOGICAL :: res
857
858IF (this == that) THEN
859 res = .true.
860ELSE IF (this < that) THEN
861 res = .true.
862ELSE
863 res = .false.
864ENDIF
865
866END FUNCTION vol7d_level_le
867
868
869ELEMENTAL FUNCTION vol7d_level_c_e(this) RESULT(c_e)
870TYPE(vol7d_level),INTENT(IN) :: this
871LOGICAL :: c_e
872c_e = this /= vol7d_level_miss
873END FUNCTION vol7d_level_c_e
874
875
876#include "array_utilities_inc.F90"
877
878
879FUNCTION vol7d_level_to_var_lev(level) RESULT(btable)
880TYPE(vol7d_level),INTENT(in) :: level
881CHARACTER(len=10) :: btable
882
883btable = vol7d_level_to_var_int(level%level1)
884
885END FUNCTION vol7d_level_to_var_lev
886
887FUNCTION vol7d_level_to_var_int(level) RESULT(btable)
888INTEGER,INTENT(in) :: level
889CHARACTER(len=10) :: btable
890
891INTEGER :: i
892
893DO i = 1, SIZE(level_var_converter)
894 IF (level_var_converter(i)%level == level) THEN
895 btable = level_var_converter(i)%btable
896 RETURN
897 ENDIF
898ENDDO
899
900btable = cmiss
901
902END FUNCTION vol7d_level_to_var_int
903
904
905FUNCTION vol7d_level_to_var_factor_lev(level) RESULT(factor)
906TYPE(vol7d_level),INTENT(in) :: level
907REAL :: factor
908
909factor = vol7d_level_to_var_factor_int(level%level1)
910
911END FUNCTION vol7d_level_to_var_factor_lev
912
913FUNCTION vol7d_level_to_var_factor_int(level) RESULT(factor)
914INTEGER,INTENT(in) :: level
915REAL :: factor
916
917factor = 1.
918IF (any(level == height_level)) THEN
919 factor = 1.e-3
920ELSE IF (any(level == thermo_level)) THEN
921 factor = 1.e-1
922ELSE IF (any(level == sigma_level)) THEN
923 factor = 1.e-4
924ENDIF
925
926END FUNCTION vol7d_level_to_var_factor_int
927
928
929FUNCTION vol7d_level_to_var_log10_lev(level) RESULT(log10)
930TYPE(vol7d_level),INTENT(in) :: level
931REAL :: log10
932
933log10 = vol7d_level_to_var_log10_int(level%level1)
934
935END FUNCTION vol7d_level_to_var_log10_lev
936
937FUNCTION vol7d_level_to_var_log10_int(level) RESULT(log10)
938INTEGER,INTENT(in) :: level
939REAL :: log10
940
941log10 = 0.
942IF (any(level == height_level)) THEN
943 log10 = -3.
944ELSE IF (any(level == thermo_level)) THEN
945 log10 = -1.
946ELSE IF (any(level == sigma_level)) THEN
947 log10 = -4.
948ENDIF
949
950END FUNCTION vol7d_level_to_var_log10_int
951
952END MODULE vol7d_level_class
Distruttore per la classe vol7d_level.
Costruttore per la classe vol7d_level.
Represent level object in a pretty string.
Return the conversion factor for multiplying the level value when converting to variable.
Return the scale value (base 10 log of conversion factor) for multiplying the level value when conver...
Convert a level type to a physical variable.
Utilities for CHARACTER variables.
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 dei livelli verticali in osservazioni meteo e affini.
Definisce il livello verticale di un'osservazione.

Generated with Doxygen.