!oporniki

MODULE oporniki
! dodawanie oporow 
! a.rowno.b    - rownolegle
! a.szereg.b   - szeregowo
! Zadanie. DOPISAC czesc zwiazana z zamiana jednostek.

  TYPE opornik
     REAL wartosc
     CHARACTER*4 miano
  END TYPE opornik

  INTERFACE OPERATOR (.SZEREG.) 
     MODULE PROCEDURE SZ
  END INTERFACE
  INTERFACE OPERATOR (.ROWNO.) 
     MODULE PROCEDURE RO
  END INTERFACE

CONTAINS

  FUNCTION SZ(a, b) RESULT(res)
    TYPE(opornik), INTENT(IN) :: a, b
    TYPE(opornik) res
    res%wartosc=a%wartosc+b%wartosc
    IF (a%miano==b%miano) THEN
       res%miano=a%miano
    ELSE
       res%miano="?"
    END IF
  END FUNCTION SZ
  FUNCTION RO(a, b) RESULT(res)
    TYPE(opornik), INTENT(IN) :: a, b
    TYPE(opornik) res
    REAL r
    r=1.0/a%wartosc+1.0/b%wartosc
    res%wartosc=1.0/r
    IF (a%miano==b%miano) THEN
       res%miano=a%miano
    ELSE
       res%miano="?"
    END IF
  END FUNCTION RO

END MODULE OPORNIKI

program d
  use oporniki
  TYPE(opornik) a, b, c

  a%wartosc=21.0; a%miano="om"
  b%wartosc=87.0; b%miano="om"

  c = a.ROWNO.b
  write(*,*) 'rowno : ', c%wartosc, c%miano

  c = a.SZEREG.b
  write(*,*) 'szereg: ', c%wartosc, c%miano

end program d
