libsim Versione 7.1.11
|
◆ pack_distinct_ana()
compatta gli elementi distinti di vect in un array Definizione alla linea 751 del file vol7d_ana_class.F90. 753! Copyright (C) 2010 ARPA-SIM <urpsim@smr.arpa.emr.it>
754! authors:
755! Davide Cesari <dcesari@arpa.emr.it>
756! Paolo Patruno <ppatruno@arpa.emr.it>
757
758! This program is free software; you can redistribute it and/or
759! modify it under the terms of the GNU General Public License as
760! published by the Free Software Foundation; either version 2 of
761! the License, or (at your option) any later version.
762
763! This program is distributed in the hope that it will be useful,
764! but WITHOUT ANY WARRANTY; without even the implied warranty of
765! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
766! GNU General Public License for more details.
767
768! You should have received a copy of the GNU General Public License
769! along with this program. If not, see <http://www.gnu.org/licenses/>.
770#include "config.h"
771
780IMPLICIT NONE
781
783INTEGER,PARAMETER :: vol7d_ana_lenident=20
784
790 TYPE(geo_coord) :: coord
791 CHARACTER(len=vol7d_ana_lenident) :: ident
793
796
801 MODULE PROCEDURE vol7d_ana_init
802END INTERFACE
803
807 MODULE PROCEDURE vol7d_ana_delete
808END INTERFACE
809
813INTERFACE OPERATOR (==)
814 MODULE PROCEDURE vol7d_ana_eq
815END INTERFACE
816
820INTERFACE OPERATOR (/=)
821 MODULE PROCEDURE vol7d_ana_ne
822END INTERFACE
823
824
829INTERFACE OPERATOR (>)
830 MODULE PROCEDURE vol7d_ana_gt
831END INTERFACE
832
837INTERFACE OPERATOR (<)
838 MODULE PROCEDURE vol7d_ana_lt
839END INTERFACE
840
845INTERFACE OPERATOR (>=)
846 MODULE PROCEDURE vol7d_ana_ge
847END INTERFACE
848
853INTERFACE OPERATOR (<=)
854 MODULE PROCEDURE vol7d_ana_le
855END INTERFACE
856
857
860 MODULE PROCEDURE vol7d_ana_c_e
861END INTERFACE
862
866 MODULE PROCEDURE vol7d_ana_read_unit, vol7d_ana_vect_read_unit
867END INTERFACE
868
872 MODULE PROCEDURE vol7d_ana_write_unit, vol7d_ana_vect_write_unit
873END INTERFACE
874
875#define VOL7D_POLY_TYPE TYPE(vol7d_ana)
876#define VOL7D_POLY_TYPES _ana
877#define ENABLE_SORT
878#include "array_utilities_pre.F90"
879
882 MODULE PROCEDURE to_char_ana
883END INTERFACE
884
887 MODULE PROCEDURE display_ana
888END INTERFACE
889
890CONTAINS
891
895SUBROUTINE vol7d_ana_init(this, lon, lat, ident, ilon, ilat)
896TYPE(vol7d_ana),INTENT(INOUT) :: this
897REAL(kind=fp_geo),INTENT(in),OPTIONAL :: lon
898REAL(kind=fp_geo),INTENT(in),OPTIONAL :: lat
899CHARACTER(len=*),INTENT(in),OPTIONAL :: ident
900INTEGER(kind=int_l),INTENT(in),OPTIONAL :: ilon
901INTEGER(kind=int_l),INTENT(in),OPTIONAL :: ilat
902
904IF (PRESENT(ident)) THEN
905 this%ident = ident
906ELSE
907 this%ident = cmiss
908ENDIF
909
910END SUBROUTINE vol7d_ana_init
911
912
914SUBROUTINE vol7d_ana_delete(this)
915TYPE(vol7d_ana),INTENT(INOUT) :: this
916
918this%ident = cmiss
919
920END SUBROUTINE vol7d_ana_delete
921
922
923
924character(len=80) function to_char_ana(this)
925
926TYPE(vol7d_ana),INTENT(in) :: this
927
928to_char_ana="ANA: "//&
931 t2c(this%ident,miss="Missing ident")
932
933return
934
935end function to_char_ana
936
937
938subroutine display_ana(this)
939
940TYPE(vol7d_ana),INTENT(in) :: this
941
942print*, trim(to_char(this))
943
944end subroutine display_ana
945
946
947ELEMENTAL FUNCTION vol7d_ana_eq(this, that) RESULT(res)
948TYPE(vol7d_ana),INTENT(IN) :: this, that
949LOGICAL :: res
950
951res = this%coord == that%coord .AND. this%ident == that%ident
952
953END FUNCTION vol7d_ana_eq
954
955
956ELEMENTAL FUNCTION vol7d_ana_ne(this, that) RESULT(res)
957TYPE(vol7d_ana),INTENT(IN) :: this, that
958LOGICAL :: res
959
960res = .NOT.(this == that)
961
962END FUNCTION vol7d_ana_ne
963
964
965ELEMENTAL FUNCTION vol7d_ana_gt(this, that) RESULT(res)
966TYPE(vol7d_ana),INTENT(IN) :: this, that
967LOGICAL :: res
968
969res = this%ident > that%ident
970
971if ( this%ident == that%ident) then
972 res =this%coord > that%coord
973end if
974
975END FUNCTION vol7d_ana_gt
976
977
978ELEMENTAL FUNCTION vol7d_ana_ge(this, that) RESULT(res)
979TYPE(vol7d_ana),INTENT(IN) :: this, that
980LOGICAL :: res
981
982res = .not. this < that
983
984END FUNCTION vol7d_ana_ge
985
986
987ELEMENTAL FUNCTION vol7d_ana_lt(this, that) RESULT(res)
988TYPE(vol7d_ana),INTENT(IN) :: this, that
989LOGICAL :: res
990
991res = this%ident < that%ident
992
993if ( this%ident == that%ident) then
994 res = this%coord < that%coord
995end if
996
997END FUNCTION vol7d_ana_lt
998
999
1000ELEMENTAL FUNCTION vol7d_ana_le(this, that) RESULT(res)
1001TYPE(vol7d_ana),INTENT(IN) :: this, that
1002LOGICAL :: res
1003
1004res = .not. (this > that)
1005
1006END FUNCTION vol7d_ana_le
1007
1008
1009
1010ELEMENTAL FUNCTION vol7d_ana_c_e(this) RESULT(c_e)
1011TYPE(vol7d_ana),INTENT(IN) :: this
1012LOGICAL :: c_e
1013c_e = this /= vol7d_ana_miss
1014END FUNCTION vol7d_ana_c_e
1015
1016
1021SUBROUTINE vol7d_ana_read_unit(this, unit)
1022TYPE(vol7d_ana),INTENT(out) :: this
1023INTEGER, INTENT(in) :: unit
1024
1025CALL vol7d_ana_vect_read_unit((/this/), unit)
1026
1027END SUBROUTINE vol7d_ana_read_unit
1028
1029
1034SUBROUTINE vol7d_ana_vect_read_unit(this, unit)
1035TYPE(vol7d_ana) :: this(:)
1036INTEGER, INTENT(in) :: unit
1037
1038CHARACTER(len=40) :: form
1039
1041INQUIRE(unit, form=form)
1042IF (form == 'FORMATTED') THEN
1043 READ(unit,'(A)')this(:)%ident
1044ELSE
1045 READ(unit)this(:)%ident
1046ENDIF
1047
1048END SUBROUTINE vol7d_ana_vect_read_unit
1049
1050
1055SUBROUTINE vol7d_ana_write_unit(this, unit)
1056TYPE(vol7d_ana),INTENT(in) :: this
1057INTEGER, INTENT(in) :: unit
1058
1059CALL vol7d_ana_vect_write_unit((/this/), unit)
1060
1061END SUBROUTINE vol7d_ana_write_unit
1062
1063
1068SUBROUTINE vol7d_ana_vect_write_unit(this, unit)
1069TYPE(vol7d_ana),INTENT(in) :: this(:)
1070INTEGER, INTENT(in) :: unit
1071
1072CHARACTER(len=40) :: form
1073
1075INQUIRE(unit, form=form)
1076IF (form == 'FORMATTED') THEN
1077 WRITE(unit,'(A)')this(:)%ident
1078ELSE
1079 WRITE(unit)this(:)%ident
1080ENDIF
1081
1082END SUBROUTINE vol7d_ana_vect_write_unit
1083
1084
1085#include "array_utilities_inc.F90"
1086
1087
Legge un oggetto vol7d_ana o un vettore di oggetti vol7d_ana da un file FORMATTED o UNFORMATTED. Definition: vol7d_ana_class.F90:307 Scrive un oggetto vol7d_ana o un vettore di oggetti vol7d_ana su un file FORMATTED o UNFORMATTED. Definition: vol7d_ana_class.F90:313 Classes for handling georeferenced sparse points in geographical corodinates. Definition: geo_coord_class.F90:222 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 dell'anagrafica di stazioni meteo e affini. Definition: vol7d_ana_class.F90:218 Definisce l'anagrafica di una stazione. Definition: vol7d_ana_class.F90:231 |