libsim Versione 7.2.1
|
◆ pack_distinct_ana()
compatta gli elementi distinti di vect in un array Definizione alla linea 745 del file vol7d_ana_class.F90. 747! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
748! authors:
749! Davide Cesari <dcesari@arpa.emr.it>
750! Paolo Patruno <ppatruno@arpa.emr.it>
751
752! This program is free software; you can redistribute it and/or
753! modify it under the terms of the GNU General Public License as
754! published by the Free Software Foundation; either version 2 of
755! the License, or (at your option) any later version.
756
757! This program is distributed in the hope that it will be useful,
758! but WITHOUT ANY WARRANTY; without even the implied warranty of
759! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
760! GNU General Public License for more details.
761
762! You should have received a copy of the GNU General Public License
763! along with this program. If not, see <http://www.gnu.org/licenses/>.
764#include "config.h"
765
774IMPLICIT NONE
775
777INTEGER,PARAMETER :: vol7d_ana_lenident=20
778
784 TYPE(geo_coord) :: coord
785 CHARACTER(len=vol7d_ana_lenident) :: ident
787
790
795 MODULE PROCEDURE vol7d_ana_init
796END INTERFACE
797
801 MODULE PROCEDURE vol7d_ana_delete
802END INTERFACE
803
807INTERFACE OPERATOR (==)
808 MODULE PROCEDURE vol7d_ana_eq
809END INTERFACE
810
814INTERFACE OPERATOR (/=)
815 MODULE PROCEDURE vol7d_ana_ne
816END INTERFACE
817
818
823INTERFACE OPERATOR (>)
824 MODULE PROCEDURE vol7d_ana_gt
825END INTERFACE
826
831INTERFACE OPERATOR (<)
832 MODULE PROCEDURE vol7d_ana_lt
833END INTERFACE
834
839INTERFACE OPERATOR (>=)
840 MODULE PROCEDURE vol7d_ana_ge
841END INTERFACE
842
847INTERFACE OPERATOR (<=)
848 MODULE PROCEDURE vol7d_ana_le
849END INTERFACE
850
851
854 MODULE PROCEDURE vol7d_ana_c_e
855END INTERFACE
856
860 MODULE PROCEDURE vol7d_ana_read_unit, vol7d_ana_vect_read_unit
861END INTERFACE
862
866 MODULE PROCEDURE vol7d_ana_write_unit, vol7d_ana_vect_write_unit
867END INTERFACE
868
869#define VOL7D_POLY_TYPE TYPE(vol7d_ana)
870#define VOL7D_POLY_TYPES _ana
871#define ENABLE_SORT
872#include "array_utilities_pre.F90"
873
876 MODULE PROCEDURE to_char_ana
877END INTERFACE
878
881 MODULE PROCEDURE display_ana
882END INTERFACE
883
884CONTAINS
885
889SUBROUTINE vol7d_ana_init(this, lon, lat, ident, ilon, ilat)
890TYPE(vol7d_ana),INTENT(INOUT) :: this
891REAL(kind=fp_geo),INTENT(in),OPTIONAL :: lon
892REAL(kind=fp_geo),INTENT(in),OPTIONAL :: lat
893CHARACTER(len=*),INTENT(in),OPTIONAL :: ident
894INTEGER(kind=int_l),INTENT(in),OPTIONAL :: ilon
895INTEGER(kind=int_l),INTENT(in),OPTIONAL :: ilat
896
898IF (PRESENT(ident)) THEN
899 this%ident = ident
900ELSE
901 this%ident = cmiss
902ENDIF
903
904END SUBROUTINE vol7d_ana_init
905
906
908SUBROUTINE vol7d_ana_delete(this)
909TYPE(vol7d_ana),INTENT(INOUT) :: this
910
912this%ident = cmiss
913
914END SUBROUTINE vol7d_ana_delete
915
916
917
918character(len=80) function to_char_ana(this)
919
920TYPE(vol7d_ana),INTENT(in) :: this
921
922to_char_ana="ANA: "//&
925 t2c(this%ident,miss="Missing ident")
926
927return
928
929end function to_char_ana
930
931
932subroutine display_ana(this)
933
934TYPE(vol7d_ana),INTENT(in) :: this
935
936print*, trim(to_char(this))
937
938end subroutine display_ana
939
940
941ELEMENTAL FUNCTION vol7d_ana_eq(this, that) RESULT(res)
942TYPE(vol7d_ana),INTENT(IN) :: this, that
943LOGICAL :: res
944
945res = this%coord == that%coord .AND. this%ident == that%ident
946
947END FUNCTION vol7d_ana_eq
948
949
950ELEMENTAL FUNCTION vol7d_ana_ne(this, that) RESULT(res)
951TYPE(vol7d_ana),INTENT(IN) :: this, that
952LOGICAL :: res
953
954res = .NOT.(this == that)
955
956END FUNCTION vol7d_ana_ne
957
958
959ELEMENTAL FUNCTION vol7d_ana_gt(this, that) RESULT(res)
960TYPE(vol7d_ana),INTENT(IN) :: this, that
961LOGICAL :: res
962
963res = this%ident > that%ident
964
965if ( this%ident == that%ident) then
966 res =this%coord > that%coord
967end if
968
969END FUNCTION vol7d_ana_gt
970
971
972ELEMENTAL FUNCTION vol7d_ana_ge(this, that) RESULT(res)
973TYPE(vol7d_ana),INTENT(IN) :: this, that
974LOGICAL :: res
975
976res = .not. this < that
977
978END FUNCTION vol7d_ana_ge
979
980
981ELEMENTAL FUNCTION vol7d_ana_lt(this, that) RESULT(res)
982TYPE(vol7d_ana),INTENT(IN) :: this, that
983LOGICAL :: res
984
985res = this%ident < that%ident
986
987if ( this%ident == that%ident) then
988 res = this%coord < that%coord
989end if
990
991END FUNCTION vol7d_ana_lt
992
993
994ELEMENTAL FUNCTION vol7d_ana_le(this, that) RESULT(res)
995TYPE(vol7d_ana),INTENT(IN) :: this, that
996LOGICAL :: res
997
998res = .not. (this > that)
999
1000END FUNCTION vol7d_ana_le
1001
1002
1003
1004ELEMENTAL FUNCTION vol7d_ana_c_e(this) RESULT(c_e)
1005TYPE(vol7d_ana),INTENT(IN) :: this
1006LOGICAL :: c_e
1007c_e = this /= vol7d_ana_miss
1008END FUNCTION vol7d_ana_c_e
1009
1010
1015SUBROUTINE vol7d_ana_read_unit(this, unit)
1016TYPE(vol7d_ana),INTENT(out) :: this
1017INTEGER, INTENT(in) :: unit
1018
1019CALL vol7d_ana_vect_read_unit((/this/), unit)
1020
1021END SUBROUTINE vol7d_ana_read_unit
1022
1023
1028SUBROUTINE vol7d_ana_vect_read_unit(this, unit)
1029TYPE(vol7d_ana) :: this(:)
1030INTEGER, INTENT(in) :: unit
1031
1032CHARACTER(len=40) :: form
1033
1035INQUIRE(unit, form=form)
1036IF (form == 'FORMATTED') THEN
1037 READ(unit,'(A)')this(:)%ident
1038ELSE
1039 READ(unit)this(:)%ident
1040ENDIF
1041
1042END SUBROUTINE vol7d_ana_vect_read_unit
1043
1044
1049SUBROUTINE vol7d_ana_write_unit(this, unit)
1050TYPE(vol7d_ana),INTENT(in) :: this
1051INTEGER, INTENT(in) :: unit
1052
1053CALL vol7d_ana_vect_write_unit((/this/), unit)
1054
1055END SUBROUTINE vol7d_ana_write_unit
1056
1057
1062SUBROUTINE vol7d_ana_vect_write_unit(this, unit)
1063TYPE(vol7d_ana),INTENT(in) :: this(:)
1064INTEGER, INTENT(in) :: unit
1065
1066CHARACTER(len=40) :: form
1067
1069INQUIRE(unit, form=form)
1070IF (form == 'FORMATTED') THEN
1071 WRITE(unit,'(A)')this(:)%ident
1072ELSE
1073 WRITE(unit)this(:)%ident
1074ENDIF
1075
1076END SUBROUTINE vol7d_ana_vect_write_unit
1077
1078
1079#include "array_utilities_inc.F90"
1080
1081
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 Definisce l'anagrafica di una stazione. Definition: vol7d_ana_class.F90:225 |