libsim Versione 7.2.4
|
◆ vol7d_level_delete()
Distrugge l'oggetto in maniera pulita, assegnandogli un valore mancante.
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
508IMPLICIT NONE
509
515 INTEGER :: level1
516 INTEGER :: l1
517 INTEGER :: level2
518 INTEGER :: l2
520
523
528 MODULE PROCEDURE vol7d_level_init
529END INTERFACE
530
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
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
608 MODULE PROCEDURE display_level
609END INTERFACE
610
613 MODULE PROCEDURE to_char_level
614END INTERFACE
615
618 MODULE PROCEDURE vol7d_level_to_var_int, vol7d_level_to_var_lev
620
623 MODULE PROCEDURE vol7d_level_to_var_factor_int, vol7d_level_to_var_factor_lev
625
628 MODULE PROCEDURE vol7d_level_to_var_log10_int, vol7d_level_to_var_log10_lev
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
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: "//&
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
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
Represent level object in a pretty string. Definition vol7d_level_class.F90:376 Return the conversion factor for multiplying the level value when converting to variable. Definition vol7d_level_class.F90:386 Return the scale value (base 10 log of conversion factor) for multiplying the level value when conver... Definition vol7d_level_class.F90:391 Convert a level type to a physical variable. Definition vol7d_level_class.F90:381 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. Definition missing_values.f90:50 Classe per la gestione dei livelli verticali in osservazioni meteo e affini. Definition vol7d_level_class.F90:213 Definisce il livello verticale di un'osservazione. Definition vol7d_level_class.F90:223 |