libsim Versione 7.2.4
|
◆ pack_distinct_sorted_ana()
compatta gli elementi distinti di vect in un sorted array Definizione alla linea 712 del file vol7d_ana_class.F90. 714! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
715! authors:
716! Davide Cesari <dcesari@arpa.emr.it>
717! Paolo Patruno <ppatruno@arpa.emr.it>
718
719! This program is free software; you can redistribute it and/or
720! modify it under the terms of the GNU General Public License as
721! published by the Free Software Foundation; either version 2 of
722! the License, or (at your option) any later version.
723
724! This program is distributed in the hope that it will be useful,
725! but WITHOUT ANY WARRANTY; without even the implied warranty of
726! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
727! GNU General Public License for more details.
728
729! You should have received a copy of the GNU General Public License
730! along with this program. If not, see <http://www.gnu.org/licenses/>.
731#include "config.h"
732
741IMPLICIT NONE
742
744INTEGER,PARAMETER :: vol7d_ana_lenident=20
745
751 TYPE(geo_coord) :: coord
752 CHARACTER(len=vol7d_ana_lenident) :: ident
754
757
762 MODULE PROCEDURE vol7d_ana_init
763END INTERFACE
764
768 MODULE PROCEDURE vol7d_ana_delete
769END INTERFACE
770
774INTERFACE OPERATOR (==)
775 MODULE PROCEDURE vol7d_ana_eq
776END INTERFACE
777
781INTERFACE OPERATOR (/=)
782 MODULE PROCEDURE vol7d_ana_ne
783END INTERFACE
784
785
790INTERFACE OPERATOR (>)
791 MODULE PROCEDURE vol7d_ana_gt
792END INTERFACE
793
798INTERFACE OPERATOR (<)
799 MODULE PROCEDURE vol7d_ana_lt
800END INTERFACE
801
806INTERFACE OPERATOR (>=)
807 MODULE PROCEDURE vol7d_ana_ge
808END INTERFACE
809
814INTERFACE OPERATOR (<=)
815 MODULE PROCEDURE vol7d_ana_le
816END INTERFACE
817
818
821 MODULE PROCEDURE vol7d_ana_c_e
822END INTERFACE
823
827 MODULE PROCEDURE vol7d_ana_read_unit, vol7d_ana_vect_read_unit
828END INTERFACE
829
833 MODULE PROCEDURE vol7d_ana_write_unit, vol7d_ana_vect_write_unit
834END INTERFACE
835
836#define VOL7D_POLY_TYPE TYPE(vol7d_ana)
837#define VOL7D_POLY_TYPES _ana
838#define ENABLE_SORT
839#include "array_utilities_pre.F90"
840
843 MODULE PROCEDURE to_char_ana
844END INTERFACE
845
848 MODULE PROCEDURE display_ana
849END INTERFACE
850
851CONTAINS
852
856SUBROUTINE vol7d_ana_init(this, lon, lat, ident, ilon, ilat)
857TYPE(vol7d_ana),INTENT(INOUT) :: this
858REAL(kind=fp_geo),INTENT(in),OPTIONAL :: lon
859REAL(kind=fp_geo),INTENT(in),OPTIONAL :: lat
860CHARACTER(len=*),INTENT(in),OPTIONAL :: ident
861INTEGER(kind=int_l),INTENT(in),OPTIONAL :: ilon
862INTEGER(kind=int_l),INTENT(in),OPTIONAL :: ilat
863
865IF (PRESENT(ident)) THEN
866 this%ident = ident
867ELSE
868 this%ident = cmiss
869ENDIF
870
871END SUBROUTINE vol7d_ana_init
872
873
875SUBROUTINE vol7d_ana_delete(this)
876TYPE(vol7d_ana),INTENT(INOUT) :: this
877
879this%ident = cmiss
880
881END SUBROUTINE vol7d_ana_delete
882
883
884
885character(len=80) function to_char_ana(this)
886
887TYPE(vol7d_ana),INTENT(in) :: this
888
889to_char_ana="ANA: "//&
892 t2c(this%ident,miss="Missing ident")
893
894return
895
896end function to_char_ana
897
898
899subroutine display_ana(this)
900
901TYPE(vol7d_ana),INTENT(in) :: this
902
903print*, trim(to_char(this))
904
905end subroutine display_ana
906
907
908ELEMENTAL FUNCTION vol7d_ana_eq(this, that) RESULT(res)
909TYPE(vol7d_ana),INTENT(IN) :: this, that
910LOGICAL :: res
911
912res = this%coord == that%coord .AND. this%ident == that%ident
913
914END FUNCTION vol7d_ana_eq
915
916
917ELEMENTAL FUNCTION vol7d_ana_ne(this, that) RESULT(res)
918TYPE(vol7d_ana),INTENT(IN) :: this, that
919LOGICAL :: res
920
921res = .NOT.(this == that)
922
923END FUNCTION vol7d_ana_ne
924
925
926ELEMENTAL FUNCTION vol7d_ana_gt(this, that) RESULT(res)
927TYPE(vol7d_ana),INTENT(IN) :: this, that
928LOGICAL :: res
929
930res = this%ident > that%ident
931
932if ( this%ident == that%ident) then
933 res =this%coord > that%coord
934end if
935
936END FUNCTION vol7d_ana_gt
937
938
939ELEMENTAL FUNCTION vol7d_ana_ge(this, that) RESULT(res)
940TYPE(vol7d_ana),INTENT(IN) :: this, that
941LOGICAL :: res
942
943res = .not. this < that
944
945END FUNCTION vol7d_ana_ge
946
947
948ELEMENTAL FUNCTION vol7d_ana_lt(this, that) RESULT(res)
949TYPE(vol7d_ana),INTENT(IN) :: this, that
950LOGICAL :: res
951
952res = this%ident < that%ident
953
954if ( this%ident == that%ident) then
955 res = this%coord < that%coord
956end if
957
958END FUNCTION vol7d_ana_lt
959
960
961ELEMENTAL FUNCTION vol7d_ana_le(this, that) RESULT(res)
962TYPE(vol7d_ana),INTENT(IN) :: this, that
963LOGICAL :: res
964
965res = .not. (this > that)
966
967END FUNCTION vol7d_ana_le
968
969
970
971ELEMENTAL FUNCTION vol7d_ana_c_e(this) RESULT(c_e)
972TYPE(vol7d_ana),INTENT(IN) :: this
973LOGICAL :: c_e
974c_e = this /= vol7d_ana_miss
975END FUNCTION vol7d_ana_c_e
976
977
982SUBROUTINE vol7d_ana_read_unit(this, unit)
983TYPE(vol7d_ana),INTENT(out) :: this
984INTEGER, INTENT(in) :: unit
985
986CALL vol7d_ana_vect_read_unit((/this/), unit)
987
988END SUBROUTINE vol7d_ana_read_unit
989
990
995SUBROUTINE vol7d_ana_vect_read_unit(this, unit)
996TYPE(vol7d_ana) :: this(:)
997INTEGER, INTENT(in) :: unit
998
999CHARACTER(len=40) :: form
1000
1002INQUIRE(unit, form=form)
1003IF (form == 'FORMATTED') THEN
1004 READ(unit,'(A)')this(:)%ident
1005ELSE
1006 READ(unit)this(:)%ident
1007ENDIF
1008
1009END SUBROUTINE vol7d_ana_vect_read_unit
1010
1011
1016SUBROUTINE vol7d_ana_write_unit(this, unit)
1017TYPE(vol7d_ana),INTENT(in) :: this
1018INTEGER, INTENT(in) :: unit
1019
1020CALL vol7d_ana_vect_write_unit((/this/), unit)
1021
1022END SUBROUTINE vol7d_ana_write_unit
1023
1024
1029SUBROUTINE vol7d_ana_vect_write_unit(this, unit)
1030TYPE(vol7d_ana),INTENT(in) :: this(:)
1031INTEGER, INTENT(in) :: unit
1032
1033CHARACTER(len=40) :: form
1034
1036INQUIRE(unit, form=form)
1037IF (form == 'FORMATTED') THEN
1038 WRITE(unit,'(A)')this(:)%ident
1039ELSE
1040 WRITE(unit)this(:)%ident
1041ENDIF
1042
1043END SUBROUTINE vol7d_ana_vect_write_unit
1044
1045
1046#include "array_utilities_inc.F90"
1047
1048
Legge un oggetto vol7d_ana o un vettore di oggetti vol7d_ana da un file FORMATTED o UNFORMATTED. Definition vol7d_ana_class.F90:301 Scrive un oggetto vol7d_ana o un vettore di oggetti vol7d_ana su un file FORMATTED o UNFORMATTED. Definition vol7d_ana_class.F90:307 Classes for handling georeferenced sparse points in geographical corodinates. Definition geo_coord_class.F90:216 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 dell'anagrafica di stazioni meteo e affini. Definition vol7d_ana_class.F90:212 |