libsim Versione 7.2.4

◆ 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
505USE kinds
508IMPLICIT NONE
509
514TYPE vol7d_level
515 INTEGER :: level1
516 INTEGER :: l1
517 INTEGER :: level2
518 INTEGER :: l2
519END TYPE vol7d_level
520
522TYPE(vol7d_level),PARAMETER :: vol7d_level_miss=vol7d_level(imiss,imiss,imiss,imiss)
523
527INTERFACE init
528 MODULE PROCEDURE vol7d_level_init
529END INTERFACE
530
533INTERFACE delete
534 MODULE PROCEDURE vol7d_level_delete
535END INTERFACE
536
540INTERFACE OPERATOR (==)
541 MODULE PROCEDURE vol7d_level_eq
542END INTERFACE
543
547INTERFACE OPERATOR (/=)
548 MODULE PROCEDURE vol7d_level_ne
549END INTERFACE
550
556INTERFACE OPERATOR (>)
557 MODULE PROCEDURE vol7d_level_gt
558END INTERFACE
559
565INTERFACE OPERATOR (<)
566 MODULE PROCEDURE vol7d_level_lt
567END INTERFACE
568
574INTERFACE OPERATOR (>=)
575 MODULE PROCEDURE vol7d_level_ge
576END INTERFACE
577
583INTERFACE OPERATOR (<=)
584 MODULE PROCEDURE vol7d_level_le
585END INTERFACE
586
590INTERFACE OPERATOR (.almosteq.)
591 MODULE PROCEDURE vol7d_level_almost_eq
592END INTERFACE
593
594
595! da documentare in inglese assieme al resto
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
607INTERFACE display
608 MODULE PROCEDURE display_level
609END INTERFACE
610
612INTERFACE to_char
613 MODULE PROCEDURE to_char_level
614END INTERFACE
615
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
623 MODULE PROCEDURE vol7d_level_to_var_factor_int, vol7d_level_to_var_factor_lev
624END INTERFACE vol7d_level_to_var_factor
625
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
667FUNCTION vol7d_level_new(level1, l1, level2, l2) RESULT(this)
668INTEGER,INTENT(IN),OPTIONAL :: level1
669INTEGER,INTENT(IN),OPTIONAL :: l1
670INTEGER,INTENT(IN),OPTIONAL :: level2
671INTEGER,INTENT(IN),OPTIONAL :: l2
672
673TYPE(vol7d_level) :: this
674
675CALL init(this, level1, l1, level2, l2)
676
677END FUNCTION vol7d_level_new
678
679
683SUBROUTINE vol7d_level_init(this, level1, l1, level2, l2)
684TYPE(vol7d_level),INTENT(INOUT) :: this
685INTEGER,INTENT(IN),OPTIONAL :: level1
686INTEGER,INTENT(IN),OPTIONAL :: l1
687INTEGER,INTENT(IN),OPTIONAL :: level2
688INTEGER,INTENT(IN),OPTIONAL :: l2
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
715SUBROUTINE vol7d_level_delete(this)
716TYPE(vol7d_level),INTENT(INOUT) :: this
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.