PROBLEMAS RESUELTOS DE VECTORES EN FORTRAN 90
Código program sum_vect integer,dimension(10)::A integer::suma=0 print*,"Ingrese print*,"Ingrese 10 elementos al vector" read*,(A(i),i=1,10) !Calculando la suma de elementos del vector do i=1,10 suma=suma+A(i) end do !Imprimiendo !Imprimiendo la suma print*,"" print*,"La suma del vector es=",suma end program sum_vect
1
Código program informacion character(len=100),dimension(100)::nomb real,dimension(100)::prom integer::i,n,m integer::max,aux1 character(len=100)::aux2 print*,"Ingrese cantidad de alumnos" read*,n print*,"Ingrese nombres de los alumnos" read*,(nomb(i),i=1,n) print*,"Ingrese promedio de general de los alumnos" read*,(prom(i),i=1,n) m=i-1 !Proceso repetitivo do i=1,m-1 max=prom(i) index=i !Busqueda del mayor valor e indice respectivo do j=i+1,m if(prom(j)>max) then max=prom(j) index=j end if end do aux1=prom(i) aux2=nomb(i) prom(i)=prom(index) nomb(i)=nomb(index) prom(index)=aux1 nomb(index)=aux2 end do print 2 2 format(5x,"Promedio",4x,"Nombres",f2.1,A30) do i=1,n print*,prom(i),nomb(i) end do end program información
2
3.
Código program problema3 integer::i integer,dimension(10)::a,b,c do i=1,10 print*,"ingrese cantidad del producto ",i," en stock" read*,a(i) print*,"ingrese cantidad de productos pedidos por el cliente" read*,b(i) end do do i=1,10 if (a(i)==b(i))then c(i)=a(i) else if (b(i)>a(i))then c(i)=(b(i)-a(i))*2 else c(i)=b(i) end if end if end do do i=1,10 print*,c(i) end do end program problema3
3
Código PROGRAM PROB_4 REAL,DIMENSION(1:6)::A INTEGER::I PRINT*,"VALORES DEL VECTOR " READ*,(A(I),I=1,6) PRINT*,"VECTOR A" DO I=1,6 PRINT*,A(I) CALL POSICION(A) END DO END PROGRAM PROB_4 SUBROUTINE POSICION(X) REAL,DIMENSION(1:6)::X REAL::B INTEGER::I PRINT*,"UNA POSICION A LA DERECHA DEL VECTOR" DO I=1,6 B=X(I) X(I)=X(6) X(6)=B END DO DO I=1,6 PRINT*,X(I) 4
END DO END SUBROUTINE POSICION
Código program problema_5 implicit none integer::i,j,m,n real,dimension(100,100)::A,B,TA,TB print*,"Ingrese filas para A y B" read*,m print*,"Ingrese columnas para A y B" read*,n print*,"Ingrese datos a la matriz A" read*,((A(i,j),j=1,n),i=1,n) print* print*,"Ingrese datos a la matriz B" read*,((B(i,j),j=1,n),i=1,n) print* do i=1,n do j=1,m TA(i,j)=A(j,i) end do end do do i=1,n do j=1,m TB(i,j)=B(j,i) end do end do print*,"La transpuesta de la matriz A es" do i=1,n print*,(TA(i,j),j=1,m) end do print*,"La transpuesta de la matriz B es" do i=1,n print*,(TB(i,j),j=1,m) end do end program problema_5
Código 5
PROGRAM BUSQUEDA_NUMERO INTEGER::X,I,CONTROL=0 INTEGER, DIMENSION(6)::V=(/12,5,8,6,7,4/) PRINT*,"INGRESE NUMERO A BUSCAR" READ*,X DO I=1,6 IF(X==V(I)) THEN PRINT*,"VALOR ENCONTRADO EN LA POSICION",I CONTROL=1 END IF END DO IF(CONTROL==0) THEN PRINT*,"EL VALOR NO SE ENCONTRO" END IF END PROGRAM BUSQUEDA_NUMERO
Código Program Transpuesta integer,dimension(100,100)::A integer::m,n ! m=filas n=columnas integer::i,j print*,"Ingrese numero de filas y columnas" read*,m,n print*,"Ingrese datos a la matriz" Do i=1,m read*,(A(i,j),j=1,n) end Do !Hallando la transpuesta print*,"" print*,"La matriz transpuesta es" Do j=1,n print*,(A(i,j),i=1,m) end Do End program Transpuesta
6
Código PROGRAM MULTIP_2 INTEGER, DIMENSION(100,100)::A,B,C INTEGER::M,N,P,Q INTEGER::I,J,K PRINT*,"INGRESE FILAS Y COLUMNAS DE [A]" READ*,M,N PRINT*,"INGRESE FILAS Y COLUMNAS DE [B]" READ*,P,Q IF (N/=Q)THEN PRINT*,"NO SE PUEDE MULTIPLICAR [A]X[B]" STOP "FIN" ELSE PRINT*,"INGRESE DATOS DE A" READ*,((A(I,J),J=1,N),I=1,M) PRINT*,"INGRESE DATOS DE B" READ*,((B(I,J),J=1,Q),I=1,P) END IF !MULTIPICACION DE MATRICES DO I=1,M DO J=1,Q C(I,J)=0 DO K=1,N C(I,J)=C(I,J)+A(I,J)*B(I,J) END DO END DO END DO PRINT*,"C=A*B" ! VUALIZACION DE LA MATRIZ C DO I=1,M PRINT*,(C(I,J),J=1,Q) END DO END PROGRAM MULTIP_2
7
Código program diag_princ integer,dimension(:,:),allocatable::A integer::m,n,suma=0 print*,"Ingrese numero de filas y columnas" read*,m,n allocate(A(m,n)) if (m/=n) then print*,"La matriz no tiene diagonal principal" print*,"FIN" else print*,"Ingrese datos a la matriz" do i=1,m read*,(A(i,j),j=1,n) end do !Suma de diagonal principal do i=1,m do j=1,n if (i==j) then suma=suma+A(i,j) end if end do end do !Imprimiendo suma print*,"" print*,"Suma de diagonal principal=",suma end if end program diag_princ
8
Código program resta integer,dimension(100,100)::A,B,C integer::i,j integer::m,n !Filas y columnas print*,"Ingrese numero de filas y columnas de [A] y [B]" read*,m,n !Creando matrices A y B print*,"Ingrese datos a [A]" do i=1,m read*,(A(i,j),j=1,n) end do print*,"Ingrese datos a [B]" do i=1,m read*,(B(i,j),j=1,n) end do !Creando resta de matrices do i=1,m do j=1,n C(i,j)=A(i,j)-B(i,j) end do end do !Imprimiendo [C] print*,"La matriz [A]-[B] es" do i=1,m print*,(C(i,j),j=1,n) end do end program resta
9
10