libsim Versione 7.1.11
|
◆ vol7d_level_delete()
Distrugge l'oggetto in maniera pulita, assegnandogli un valore mancante.
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
514IMPLICIT NONE
515
521 INTEGER :: level1
522 INTEGER :: l1
523 INTEGER :: level2
524 INTEGER :: l2
526
529
534 MODULE PROCEDURE vol7d_level_init
535END INTERFACE
536
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
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
614 MODULE PROCEDURE display_level
615END INTERFACE
616
619 MODULE PROCEDURE to_char_level
620END INTERFACE
621
624 MODULE PROCEDURE vol7d_level_to_var_int, vol7d_level_to_var_lev
626
629 MODULE PROCEDURE vol7d_level_to_var_factor_int, vol7d_level_to_var_factor_lev
631
634 MODULE PROCEDURE vol7d_level_to_var_log10_int, vol7d_level_to_var_log10_lev
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
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: "//&
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
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
Distruttore per la classe vol7d_level. Definition: vol7d_level_class.F90:248 Represent level object in a pretty string. Definition: vol7d_level_class.F90:382 Return the conversion factor for multiplying the level value when converting to variable. Definition: vol7d_level_class.F90:392 Return the scale value (base 10 log of conversion factor) for multiplying the level value when conver... Definition: vol7d_level_class.F90:397 Convert a level type to a physical variable. Definition: vol7d_level_class.F90:387 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. Definition: missing_values.f90:50 Classe per la gestione dei livelli verticali in osservazioni meteo e affini. Definition: vol7d_level_class.F90:219 Definisce il livello verticale di un'osservazione. Definition: vol7d_level_class.F90:229 |