Программа определения места повреждения на воздушной линии электропередачи, страница 13

      write (Msg,'(a,i3,1h.)')  &

        'При формировании матрицы Y повреждённой ЛЭП не исключается внутренняя фаза №',j

      call AbortDlg(Msg)

      ier=11; exit

    end if

    F(1,1)=j

   Исключаем висячую фазу

   call Iskl1 (Y,NPh,NPh,1,1,F,F,Phase,Phase)

    NPh=NPh-1

  end do

Восстановим испорченные характеристики пакетов разъёмов

99 CocPack(1,1:2) = Arc(:2)  

    PlugPack(1:2) = Arc(3:4) 

Освобождаем память:   

if(Allocated(Phase)) Deallocate(Phase)

  if (Y1Ptr/=0) call Free(Y1Ptr)

  if (Y2Ptr/=0) call Free(Y2Ptr)

  if (YFPtr/=0) call Free(YFPtr)

2.2.5 Процедура формирования матрицы Y начального или конечного участка ЛЭП без учета разъемов

subroutine BuildYSect(Part,Y)

Входным параметром является доля длины участка к общей длине линии Part. Выходным параметром является матрица  узловых проводимостей Y началь­ного или конечного участка

real::  &

    Part, &   -  Доля длины участка к общей длине линии

    Part_     -  Скорректированная доля

  complex:: Y(NPh1PL,2,NPh1PL,2) – четырехмерная матрица Y

  Part_=Max(0.0001,Part)  - Чтобы не было деления на ноль при очень корот­ком участке

  Y(:,1,:,2) = B/Part_ 

  Y(:,1,:,1) = C*Part_ - Y(:,1,:,2)

  Y(:,2,:,1) = Y(:,1,:,2)

  Y(:,2,:,2) = Y(:,1,:,1)

end subroutine

2.2.6 Процедура формирования матрицы Y одного из двухполюсников, смежных с точкой повреждения

logical*4 function BuildYMP(ConType,ConUN,NPhPI,Yi,YePtr,NPhPE)

  character*(*):: ConType  - 'начально', 'конечно', 'повреждающе'

  integer*2:: &

    ConUN(2), & - Вектор пользовательских номеров внутренних разъёмов

    ier,      & - Код ошибки

    NPhPE(2), & - Числа внешних фаз по полюсам

    NPhPI(2), & - Числа внутренних фаз по полюсам

    NPhE,     & - Общее число внешних фаз

    p  - Номер полюса

  complex::   &

    Ye(16), & - Матрица Y после подключения разъёмов

    Yi(16)    - Она же до их подключения

  pointer(YePtr,Ye)

  BuildYMP = .false.

 Временно формируем пакет разъёмов с внутренним №1, сохраняя сущест­вующий.

  CocPack(1,1) = -1 - Пользовательский номер пакета

  CocPack(1,2) = 1; - Адрес в массиве PlugPack вектора разъёмов для пакета №1.

Перебираем полюса многополюсника 

do p=1,2

    PlugPack(p) = IndTra(ConUN(p)) -  2-й полюс подключён к разъёму ConUN

    if(PlugPack(p)<0) then

      write (Msg,'(2(a,i3))') &

        'Разъём №',ConUN(p),' для полюса №',p,' '//ConType//'го МП ЛЭП не описан.'

      call AbortDlg(Msg);

      ier=-1

      return

    end if

  end do

 Определяем числа фаз снаружи разъёма NPhE

  call KFPKFP(1,NPhPI,2,NPhPE,NPhE,12,ier) 

  if(ier/=0) then

    do p=1,2

      if (NPhPE(p)<0) then

        write (Msg,'(3(i3,a))') &

          NPhPI(p),'-фазный полюс №',p,' присоединяется к', &

          -NPhPE(p),'-фазному разъёму.'    

              exit

      end if

    end do

    call AbortDlg('Несоответствие чисел фаз при подключении '//ConType//'го МП ЛЭП:'// Char(13)//Char(10)//Trim(Msg))

    return

  end if

Выделяем память процедурой Malloc для матрицы Yeptr с учетом разъемов

  YePtr = MAlloc(NPhE*NPhE*8)

  if (YePtr==0) then

    write (Msg,'(a,i3,1h.)')  'Матрица Y '//ConType// &

      'го МП для повреждённой ЛЭП имеет чересчур высокий порядок -',NPhE

    call NoMemory(Msg)

    return

  end if

  call MaskYMP(1,2,NPhPE,Yi,Ye,ier) ! Учёт разъёмов

  BuildYMP = ier==0

end function

end subroutine

2.2.7  Процедура коррекции матрицы узловых проводимостей сборки при подключении к ней еще одного многополюсника

subroutine AddYMP (YMPPtr,NPhMP,Y,NPh,Cxema)

 YMPPtr - указатель на матрицу Y MП

 NPhMP - число фаз в МП

 Y - квадратная матрица Y сборки

 NPh - число фаз в сборке

 Cxema - сквозной номер фазы сборки, к которому подключена очередная фаза MП

  integer*2:: i,j,iMP,jMP,NPhMP,NPh, Cxema(NPhMP)

  complex:: Y(NPh,NPh),YMP(NPhMP,NPhMP)

   pointer(YMPPtr,YMP)

  do jMP=1,NPhMP      - Цикл по столбцам

     j=Cxema(jMP)