Please note, this is a STATIC archive of website www.tutorialspoint.com from 11 May 2019, cach3.com does not collect or store any user information, there is no "phishing" involved.
program main
integer:: i,j
integer:: creciente
integer:: n
logical::esPrimo
integer, allocatable :: U(:)
write(*,*) 'Escribe un numero'
read(*,*) n
do i=2,n !hasta n ya que me dice los primos menores que n
j=0
creciente=2
esPrimo=.true.
do while((esPrimo) .AND. (creciente < i))
if (mod(i,creciente)==0) then
esPrimo=.false.
else
creciente=creciente+1
end if
end do
if ((esPrimo).eqv.(.true.))then !si la condicion de esprimo sigue siendo verdadero, imprime q ese numero es primo
j=j+1
write(*,*) i, 'es primo'
end if
end do
allocate (U(j))
do i=2,n
j=0
creciente=2
esPrimo=.true.
do while((esPrimo) .AND. (creciente < i))
if (mod(i,creciente)==0) then
esPrimo=.false.
else
creciente=creciente+1
end if
end do
if ((esPrimo).eqv.(.true.))then
j=j+1
U(j)=i
end if
esPrimo=.true.
end do
write(*,*) U
deallocate (U)
end program main
program ackermann
integer :: ack
write(*,*) ack(3, 12)
end program ackermann
recursive function ack(m, n) result(a)
integer, intent(in) :: m,n
integer :: a
if (m == 0) then
a=n+1
else if (n == 0) then
a=ack(m-1,1)
else
a=ack(m-1, ack(m, n-1))
end if
end function ack
program Arrays
integer :: B(3),C(3)
character :: D(5)
integer :: E(3,3)
data A/1/B/1,2,3/C/3*0/D/'T','e','s','t','.'/
data E(3,3)/1,2,3/
write (*,*) A,B
write (*,*) B
write (*,*) C
write (*,*) D
end program Arrays
PROGRAM PILEDISP
!**************************************************************
!** THIS PROGRAM IS USED TO CALCULATE THE PILE DISPLACEMENT **
!** IN BOTH NORMAL AND EARTHQUAKE SITUATIONS **
!** AUTHOR : S.F.TUNG **
!** PRACTICE PROGRAM (2017/10/11) 01 **
!**************************************************************
IMPLICIT NONE
REAL :: N, D, BH, ALPHA, E0, KH0, KH, BETA, H0, EC
REAL :: IPILE, FC, MPIlE, VPILE, DELTAC, DELTA, STA10, STA15
INTEGER :: CASEUA
OPEN (UNIT=10, FILE="PILEDISP.INP")
READ(10,*) CASEUA, N, D, BH, MPILE, VPILE, FC
IF (CASEUA == 1) THEN
ALPHA = 1.0
ELSE
ALPHA = 2.0
END IF
STA10 = 1.00
STA15 = 1.50
E0 = 2.5*N
KH0 = E0*ALPHA/30.0
BH = 0.8*D
KH = KH0*(BH/30.0)**(-0.75)
EC = 15000.0*(FC)**0.5
IPILE = (3.1415926*(D)**4)/64.0
BETA = ((KH*D)/(4.0*EC*IPILE))**0.25
H0 = MPILE/VPILE
DELTA = (VPILE*(1.0+BETA*H0))/(2.0*EC*IPILE*BETA**3)
OPEN (UNIT=11, FILE="PILEDISP.OUT")
WRITE(11,*) "THIS PROGRAM IS USED TO BE CALED THE PILE DISPLACEMENT"
WRITE(11,*) "N VALUE OF THE LAYER, ", N
WRITE(11,*) "THE PILE DIAMETER, D =", D, "CM"
WRITE(11,*) "EFFECTIVE WIDTH OF PILE, BH =", BH, "CM"
WRITE(11,*) "EARTHEQUAKE FACTOR, ALPHA =", ALPHA
WRITE(11,*) "STIFFINESS OF PILE, E0 =", E0, "KGF/CM2"
WRITE(11,*) "HORIZONTAL STIFFINESS FACTOR OF GROUND, KH =", KH, "KGF/CM2"
WRITE(11,*) "BETA = ((KH*D)/(4.0*EC*IPILE))**0.25, BETA =", BETA
WRITE(11,*) "PILE EXPOSED LENGTH H0 =", H0, "CM"
WRITE(11,*) "STIFFINESS OF CONCRETE, EC =", EC, "KGF/CM2"
WRITE(11,*) "I VALUE OF PILE = (PI()*(D)**4)/64.0, IPILE =", IPILE, "CM4"
WRITE(11,*) "DISPLACEMENT OF PILE, DELTA =", IPILE, "CM4"
IF (CASEUA == 1) THEN
IF(ABS(DELTA)-STA10 <= 0 ) THEN
WRITE(11,*) "ACCORDING TO CODE, THE DISP OF PILE IS OK"
ELSE
WRITE(11,*) "ACCORDING TO CODE, THE DISP OF PILE IS NG"
END IF
ELSE
IF(ABS(DELTA)-STA15 <= 0 ) THEN
WRITE(11,*) "ACCORDING TO CODE, THE DISP OF PILE IS OK"
ELSE
WRITE(11,*) "ACCORDING TO CODE, THE DISP OF PILE IS NG"
END IF
END IF
ENDPROGRAM
program IntlWrite
implicit none
character(len=120) str
integer i,j
real x(10),t1,t2
data x/7.569e-1,5.556e-1,-1.640e-1,9.362e-1,1.057e-1,-2.385e-1, &
-9.541e-1,1.449e-1,-7.885e-1,-1.108e-1/
call cpu_time(t1)
do i=1,10
x(i) = (2*x(i)-1)*1e-4
end do
do j=1,1000000
write (str,'(1P,10E12.3)') x
if (mod(j,200000).eq.0) write (*,10) j, str
end do
call cpu_time(t2)
print *,'Elapsed time: ',t2-t1
!pause
10 format(1x,I7,2x,A)
end
program esep
integer n,i,j,k
real a(10,10),b(10,10),c(10,10),d(10),x(10),y(10),sum,sum1
print*, "Enter the size of matrix"
read*,n
do i=1,n
print*," Enter the first matrix row by row"
read*, (a(i,j), j=1,n)
end do
do i=1,n
do j=1,n
b(i,j)=0
c(i,j)=0
end do
end do
do i=1,n
b(i,1)=a(i,1)
c(i,i)=1
end do
do j=1,n
c(1,j)=a(1,j)/b(1,1)
end do
do i=1,n
do j=1,n
if(i>=j .and. j>1) then
sum=0
do k=1,j-1
sum=sum+(b(i,k)*c(k,j))
end do
b(i,j)=a(i,j)-sum
end if
if(i>1 .and. i<j) then
sum1=0
do k=1,i-1
sum1=sum1+(b(i,k)*c(k,j))
end do
c(i,j)=(a(i,j)-sum1)/(b(i,i))
end if
end do
end do
do i=1,n
end do
do i=1,n
end do
print*, "Enter the coefficients"
do i=1,n
read*, d(i)
end do
y(1)=d(1)/b(1,1)
do i=2,n
sum=0
do k=1,i-1
sum=sum+(b(i,k)*y(k))
end do
y(i)=(d(i)-sum)/(b(i,i))
end do
x(n)=y(n)
do i=n-1,1,-1
sum1=0
do k=i+1,n
sum1=sum1+(c(i,k)*x(k))
end do
x(i)=y(i)-sum1
end do
do i=1,n
print*,"x is ",(x(i))
end do
end program esep
program ex2
integer i, j, n, r
integer, dimension (6)
i =
j =
n = 6
r = 0
do i = 1, n
read *, a(i)
end do
do i = 1, n-1
do j = i+1, n, 1
if (a(j) == a(i)) then
igual = .true.
end if
end do
if (igual) then
r = r+1
end if
igual = .false.
end do
print *,a
print *, n-r
pause
end program ex2
program trans
implicit none
real, dimension(:,:), allocatable:: A
real, dimension(:), allocatable:: B
real, dimension(:), allocatable:: X
integer:: erro, i, j, k, r
real::m, s
!========================================================
print*,"Entre com os coeficientes da matriz A escrevendo linha por linha"
do i=1,4,1
read*, (A(i,j), j=1,4,1)
end do
print*,'==================================================='
print*,'A matriz digitada foi:'
do i=1,4,1
print*,(A(i,j), j=1,4,1)
end do
print*, 'Se a matriz digitada está certa, digite 0, caso contrário, digite 1!'
read*, r
if(r==1) then
else if (r==0) then
print*,"Entre com a matriz dos termos independentes"
read*,(B(i), i=1,4,1)
print*,'==================================================='
print*,'Os valores digitados foram:'
do i=1,4,1
print*,B(i)
end do
!O processo de impressão da matriz foi utilizado para confirmar se os dados !digitados estão corretos. Caso não esteja, há a opção de digitá-los novamente
!==============================================================
!Processo de triangulação ou eliminação
do k=1,3,1
do i=k+1,4
do j=k+1,4
m=(A(i,k))/(A(K,K))
A(i,k)=0
A(i,j)=A(i,j)-m*(A(k,j))
B(i)=B(i)-m*(B(i))
end do
end do
end do
!Processo de resolução do sistema
X(4)=B(4)/(A(4,4))
do k=k-1,1,-1
s=0
do j=k+1,4,1
s=s+(A(k,j))*(X(j))
X(k)=((B(k))-s)/(A(k,k))
end do
end do
print*, '======================================================'
print*, 'Os valores das temperatura são:'
do i=1,4,1
print*, 'temperatura',i,'=', X(i)
end do
else
print*, 'O valor digitado não corresponde ao requerido'
end if
deallocate(A,B,X)
stop
end program trans
program IOStatTest
Implicit none
integer :: LineCount=0, IOResult=0
character (length=90) ::LineRead
character (length=90) ::Filename="trajectory.txt"
open (10,file=FileName, action 'read')
read (10, "(A)")LineRead
print "(A)", LineRead
read (10, "(A)")LineRead
print "(A)", LineRead
do
read (10, "(A)",IOSTAT=IOResult)LineRead
if (IOResult<0)EXIT
LineCount=LineCount+1
end do
close (10)
print (A,A,A,IO,A) 'Our file <',FileName,'>had', LineCount,'lines'
end program IOStatTest
