libsim Versione 7.1.11

◆ 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 485 del file vol7d_level_class.F90.

486! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
487! authors:
488! Davide Cesari <dcesari@arpa.emr.it>
489! Paolo Patruno <ppatruno@arpa.emr.it>
490
491! This program is free software; you can redistribute it and/or
492! modify it under the terms of the GNU General Public License as
493! published by the Free Software Foundation; either version 2 of
494! the License, or (at your option) any later version.
495
496! This program is distributed in the hope that it will be useful,
497! but WITHOUT ANY WARRANTY; without even the implied warranty of
498! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
499! GNU General Public License for more details.
500
501! You should have received a copy of the GNU General Public License
502! along with this program. If not, see <http://www.gnu.org/licenses/>.
503#include "config.h"
504
511USE kinds
514IMPLICIT NONE
515
520TYPE vol7d_level
521 INTEGER :: level1
522 INTEGER :: l1
523 INTEGER :: level2
524 INTEGER :: l2
525END TYPE vol7d_level
526
528TYPE(vol7d_level),PARAMETER :: vol7d_level_miss=vol7d_level(imiss,imiss,imiss,imiss)
529
533INTERFACE init
534 MODULE PROCEDURE vol7d_level_init
535END INTERFACE
536
539INTERFACE delete
540 MODULE PROCEDURE vol7d_level_delete
541END INTERFACE
542
546INTERFACE OPERATOR (==)
547 MODULE PROCEDURE vol7d_level_eq
548END INTERFACE
549
553INTERFACE OPERATOR (/=)
554 MODULE PROCEDURE vol7d_level_ne
555END INTERFACE
556
562INTERFACE OPERATOR (>)
563 MODULE PROCEDURE vol7d_level_gt
564END INTERFACE
565
571INTERFACE OPERATOR (<)
572 MODULE PROCEDURE vol7d_level_lt
573END INTERFACE
574
580INTERFACE OPERATOR (>=)
581 MODULE PROCEDURE vol7d_level_ge
582END INTERFACE
583
589INTERFACE OPERATOR (<=)
590 MODULE PROCEDURE vol7d_level_le
591END INTERFACE
592
596INTERFACE OPERATOR (.almosteq.)
597 MODULE PROCEDURE vol7d_level_almost_eq
598END INTERFACE
599
600
601! da documentare in inglese assieme al resto
603INTERFACE c_e
604 MODULE PROCEDURE vol7d_level_c_e
605END INTERFACE
606
607#define VOL7D_POLY_TYPE TYPE(vol7d_level)
608#define VOL7D_POLY_TYPES _level
609#define ENABLE_SORT
610#include "array_utilities_pre.F90"
611
613INTERFACE display
614 MODULE PROCEDURE display_level
615END INTERFACE
616
618INTERFACE to_char
619 MODULE PROCEDURE to_char_level
620END INTERFACE
621
623INTERFACE vol7d_level_to_var
624 MODULE PROCEDURE vol7d_level_to_var_int, vol7d_level_to_var_lev
625END INTERFACE vol7d_level_to_var
626
629 MODULE PROCEDURE vol7d_level_to_var_factor_int, vol7d_level_to_var_factor_lev
630END INTERFACE vol7d_level_to_var_factor
631
634 MODULE PROCEDURE vol7d_level_to_var_log10_int, vol7d_level_to_var_log10_lev
635END INTERFACE vol7d_level_to_var_log10
636
637type(vol7d_level) :: almost_equal_levels(3)=(/&
638 vol7d_level( 1,imiss,imiss,imiss),&
639 vol7d_level(103,imiss,imiss,imiss),&
640 vol7d_level(106,imiss,imiss,imiss)/)
641
642! levels requiring conversion from internal to physical representation
643INTEGER, PARAMETER :: &
644 height_level(6) = (/102,103,106,117,160,161/), & ! 10**-3
645 thermo_level(3) = (/20,107,235/), & ! 10**-1
646 sigma_level(2) = (/104,111/) ! 10**-4
647
648TYPE level_var
649 INTEGER :: level
650 CHARACTER(len=10) :: btable
651END TYPE level_var
652
653! Conversion table from GRIB2 vertical level codes to corresponding
654! BUFR B table variables
655TYPE(level_var),PARAMETER :: level_var_converter(7) = (/ &
656 level_var(20, 'B12101'), & ! isothermal (K)
657 level_var(100, 'B10004'), & ! isobaric (Pa)
658 level_var(102, 'B10007'), & ! height over sea level (m)
659 level_var(103, 'B10007'), & ! height over surface (m) (special treatment needed!)
660 level_var(107, 'B12192'), & ! isentropical (K)
661 level_var(108, 'B10004'), & ! pressure difference from surface (Pa) (special treatment needed!)
662 level_var(161, 'B22195') /) ! depth below sea surface
663
664PRIVATE level_var, level_var_converter
665
666CONTAINS
667
673FUNCTION vol7d_level_new(level1, l1, level2, l2) RESULT(this)
674INTEGER,INTENT(IN),OPTIONAL :: level1
675INTEGER,INTENT(IN),OPTIONAL :: l1
676INTEGER,INTENT(IN),OPTIONAL :: level2
677INTEGER,INTENT(IN),OPTIONAL :: l2
678
679TYPE(vol7d_level) :: this
680
681CALL init(this, level1, l1, level2, l2)
682
683END FUNCTION vol7d_level_new
684
685
689SUBROUTINE vol7d_level_init(this, level1, l1, level2, l2)
690TYPE(vol7d_level),INTENT(INOUT) :: this
691INTEGER,INTENT(IN),OPTIONAL :: level1
692INTEGER,INTENT(IN),OPTIONAL :: l1
693INTEGER,INTENT(IN),OPTIONAL :: level2
694INTEGER,INTENT(IN),OPTIONAL :: l2
695
696this%level1 = imiss
697this%l1 = imiss
698this%level2 = imiss
699this%l2 = imiss
700
701IF (PRESENT(level1)) THEN
702 this%level1 = level1
703ELSE
704 RETURN
705END IF
706
707IF (PRESENT(l1)) this%l1 = l1
708
709IF (PRESENT(level2)) THEN
710 this%level2 = level2
711ELSE
712 RETURN
713END IF
714
715IF (PRESENT(l2)) this%l2 = l2
716
717END SUBROUTINE vol7d_level_init
718
719
721SUBROUTINE vol7d_level_delete(this)
722TYPE(vol7d_level),INTENT(INOUT) :: this
723
724this%level1 = imiss
725this%l1 = imiss
726this%level2 = imiss
727this%l2 = imiss
728
729END SUBROUTINE vol7d_level_delete
730
731
732SUBROUTINE display_level(this)
733TYPE(vol7d_level),INTENT(in) :: this
734
735print*,trim(to_char(this))
736
737END SUBROUTINE display_level
738
739
740FUNCTION to_char_level(this)
741#ifdef HAVE_DBALLE
742USE dballef
743#endif
744TYPE(vol7d_level),INTENT(in) :: this
745CHARACTER(len=255) :: to_char_level
746
747#ifdef HAVE_DBALLE
748INTEGER :: handle, ier
749
750handle = 0
751ier = idba_messaggi(handle,"/dev/null", "w", "BUFR")
752ier = idba_spiegal(handle,this%level1,this%l1,this%level2,this%l2,to_char_level)
753ier = idba_fatto(handle)
754
755to_char_level="LEVEL: "//to_char_level
756
757#else
758
759to_char_level="LEVEL: "//&
760 " typelev1:"//trim(to_char(this%level1))//" L1:"//trim(to_char(this%l1))//&
761 " typelev2:"//trim(to_char(this%level2))//" L2:"//trim(to_char(this%l2))
762
763#endif
764
765END FUNCTION to_char_level
766
767
768ELEMENTAL FUNCTION vol7d_level_eq(this, that) RESULT(res)
769TYPE(vol7d_level),INTENT(IN) :: this, that
770LOGICAL :: res
771
772res = &
773 this%level1 == that%level1 .AND. &
774 this%level2 == that%level2 .AND. &
775 this%l1 == that%l1 .AND. this%l2 == that%l2
776
777END FUNCTION vol7d_level_eq
778
779
780ELEMENTAL FUNCTION vol7d_level_ne(this, that) RESULT(res)
781TYPE(vol7d_level),INTENT(IN) :: this, that
782LOGICAL :: res
783
784res = .NOT.(this == that)
785
786END FUNCTION vol7d_level_ne
787
788
789ELEMENTAL FUNCTION vol7d_level_almost_eq(this, that) RESULT(res)
790TYPE(vol7d_level),INTENT(IN) :: this, that
791LOGICAL :: res
792
793IF ( .not. c_e(this%level1) .or. .not. c_e(that%level1) .or. this%level1 == that%level1 .AND. &
794 .not. c_e(this%level2) .or. .not. c_e(that%level2) .or. this%level2 == that%level2 .AND. &
795 .not. c_e(this%l1) .or. .not. c_e(that%l1) .or. this%l1 == that%l1 .AND. &
796 .not. c_e(this%l2) .or. .not. c_e(that%l2) .or. this%l2 == that%l2) THEN
797 res = .true.
798ELSE
799 res = .false.
800ENDIF
801
802END FUNCTION vol7d_level_almost_eq
803
804
805ELEMENTAL FUNCTION vol7d_level_gt(this, that) RESULT(res)
806TYPE(vol7d_level),INTENT(IN) :: this, that
807LOGICAL :: res
808
809IF (&
810 this%level1 > that%level1 .OR. &
811 (this%level1 == that%level1 .AND. this%l1 > that%l1) .OR. &
812 (this%level1 == that%level1 .AND. this%l1 == that%l1 .AND. &
813 (&
814 this%level2 > that%level2 .OR. &
815 (this%level2 == that%level2 .AND. this%l2 > that%l2) &
816 ))) THEN
817 res = .true.
818ELSE
819 res = .false.
820ENDIF
821
822END FUNCTION vol7d_level_gt
823
824
825ELEMENTAL FUNCTION vol7d_level_lt(this, that) RESULT(res)
826TYPE(vol7d_level),INTENT(IN) :: this, that
827LOGICAL :: res
828
829IF (&
830 this%level1 < that%level1 .OR. &
831 (this%level1 == that%level1 .AND. this%l1 < that%l1) .OR. &
832 (this%level1 == that%level1 .AND. this%l1 == that%l1 .AND. &
833 (&
834 this%level2 < that%level2 .OR. &
835 (this%level2 == that%level2 .AND. this%l2 < that%l2) &
836 ))) THEN
837 res = .true.
838ELSE
839 res = .false.
840ENDIF
841
842END FUNCTION vol7d_level_lt
843
844
845ELEMENTAL FUNCTION vol7d_level_ge(this, that) RESULT(res)
846TYPE(vol7d_level),INTENT(IN) :: this, that
847LOGICAL :: res
848
849IF (this == that) THEN
850 res = .true.
851ELSE IF (this > that) THEN
852 res = .true.
853ELSE
854 res = .false.
855ENDIF
856
857END FUNCTION vol7d_level_ge
858
859
860ELEMENTAL FUNCTION vol7d_level_le(this, that) RESULT(res)
861TYPE(vol7d_level),INTENT(IN) :: this, that
862LOGICAL :: res
863
864IF (this == that) THEN
865 res = .true.
866ELSE IF (this < that) THEN
867 res = .true.
868ELSE
869 res = .false.
870ENDIF
871
872END FUNCTION vol7d_level_le
873
874
875ELEMENTAL FUNCTION vol7d_level_c_e(this) RESULT(c_e)
876TYPE(vol7d_level),INTENT(IN) :: this
877LOGICAL :: c_e
878c_e = this /= vol7d_level_miss
879END FUNCTION vol7d_level_c_e
880
881
882#include "array_utilities_inc.F90"
883
884
885FUNCTION vol7d_level_to_var_lev(level) RESULT(btable)
886TYPE(vol7d_level),INTENT(in) :: level
887CHARACTER(len=10) :: btable
888
889btable = vol7d_level_to_var_int(level%level1)
890
891END FUNCTION vol7d_level_to_var_lev
892
893FUNCTION vol7d_level_to_var_int(level) RESULT(btable)
894INTEGER,INTENT(in) :: level
895CHARACTER(len=10) :: btable
896
897INTEGER :: i
898
899DO i = 1, SIZE(level_var_converter)
900 IF (level_var_converter(i)%level == level) THEN
901 btable = level_var_converter(i)%btable
902 RETURN
903 ENDIF
904ENDDO
905
906btable = cmiss
907
908END FUNCTION vol7d_level_to_var_int
909
910
911FUNCTION vol7d_level_to_var_factor_lev(level) RESULT(factor)
912TYPE(vol7d_level),INTENT(in) :: level
913REAL :: factor
914
915factor = vol7d_level_to_var_factor_int(level%level1)
916
917END FUNCTION vol7d_level_to_var_factor_lev
918
919FUNCTION vol7d_level_to_var_factor_int(level) RESULT(factor)
920INTEGER,INTENT(in) :: level
921REAL :: factor
922
923factor = 1.
924IF (any(level == height_level)) THEN
925 factor = 1.e-3
926ELSE IF (any(level == thermo_level)) THEN
927 factor = 1.e-1
928ELSE IF (any(level == sigma_level)) THEN
929 factor = 1.e-4
930ENDIF
931
932END FUNCTION vol7d_level_to_var_factor_int
933
934
935FUNCTION vol7d_level_to_var_log10_lev(level) RESULT(log10)
936TYPE(vol7d_level),INTENT(in) :: level
937REAL :: log10
938
939log10 = vol7d_level_to_var_log10_int(level%level1)
940
941END FUNCTION vol7d_level_to_var_log10_lev
942
943FUNCTION vol7d_level_to_var_log10_int(level) RESULT(log10)
944INTEGER,INTENT(in) :: level
945REAL :: log10
946
947log10 = 0.
948IF (any(level == height_level)) THEN
949 log10 = -3.
950ELSE IF (any(level == thermo_level)) THEN
951 log10 = -1.
952ELSE IF (any(level == sigma_level)) THEN
953 log10 = -4.
954ENDIF
955
956END FUNCTION vol7d_level_to_var_log10_int
957
958END 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:251
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.