Статистика, картография и ГИС!

Об авторе сайта Статистика, картография и ГИС!

Комментарии

Программа

*Программа для расчета Zc (коэффициент сумм. геохим. загрязнения)
*без автозамены содержаний < кларка, расчитывает кларки концентраций и Zc - формулу см. выше
*требуется наряду с основным файл эталонов - кларков в тех же единицах что и основной
*например 10-4% (ppm), при расчете Zc учитывает значения Кк только выше единицы
*Автор алгоритма и программы В.Д.Брусницын
PROCEDURE zc
SET TALK OFF
SET ECHO OFF
CLOSE DATA
CLEAR
IF ALLTRIM(DBF(1))==""
DEFINE POPUP obj_fil PROMPT FILES LIKE *.DBF;
   MESSAGE "ВЫБРАТЬ ФАЙЛ ДЛЯ РАСЧЕТА Zc";
   TITLE "ВЫБРАТЬ ФАЙЛ ДЛЯ РАСЧЕТА Zc"
ON SELECTION POPUP obj_fil DEACTIVATE POPUP obj_fil
ACTIVATE POPUP obj_fil
SELECT 1
USE PROMPT() NOUPDATE
ENDIF
SELECT 1
vorname = DBF(1)
vorname = SUBSTR(vorname,1,LEN(vorname)-6)
imia = "Zc"
viv_file =vorname+ALLTRIM(imia)+'.dbf'
COPY TO &viv_file AS 1251
CLEAR
IF ALLTRIM(DBF(2))==""
DEFINE POPUP obj_fil PROMPT FILES LIKE *.DBF;
   MESSAGE "ВЫБРАТЬ ФАЙЛ ЭТАЛОНОВ ДЛЯ РАСЧЕТА Zc";
   TITLE "ВЫБРАТЬ ФАЙЛ ЭТАЛОНОВ ДЛЯ РАСЧЕТА Zc"
ON SELECTION POPUP obj_fil DEACTIVATE POPUP obj_fil
ACTIVATE POPUP obj_fil
SELECT 2
USE PROMPT() NOUPDATE
ENDIF
SELECT 2
DEFINE POPUP obj_fiel PROMPT FIELD EVAL(FIELD(1));
   MESSAGE "ВЫБРАТЬ ЭТАЛОН ДЛЯ РАСЧЕТА Kk И Zc";
   TITLE "ВЫБРАТЬ ЭТАЛОН ДЛЯ РАСЧЕТА Kk И Zc"
ON SELECTION POPUP obj_fiel DEACTIVATE POPUP obj_fiel
ACTIVATE POPUP obj_fiel
SCATTER MEMVAR
USE &viv_file
beg = f_fiel()
konec = FCOUNT()
FOR i = beg TO konec
   pii = FIELD(i)
   pii1 = pii+"_k"
   REPLACE ALL &pii WITH &pii/m.&pii
   ALTER TABLE &viv_file RENAME COLUMN &pii TO &pii1
ENDFOR
ALTER TABLE &viv_file ADD COLUMN "Zc" N(10,2)
GO TOP
DO WHILE !EOF()
   sum_Kk = 0
   kol = 0
   FOR j = beg TO konec
      jj = ALLTRIM(STR(j))
      pj = FIELD(j)
      IF &pj>=1
         sum_Kk = sum_Kk + &pj
         kol = kol + 1
      ENDIF
   ENDFOR
   REPL Zc WITH sum_Kk-(kol-1)
   SKIP
ENDDO
CLOSE DATA
На главную страницу

Сайт управляется системой uCoz