http://fiscomp.if.ufrgs.br/index.php?action=history&feed=atom&title=C%C3%B3digo_3 2026-04-20T18:45:18Z Histórico de revisões para esta página neste wiki MediaWiki 1.39.4 http://fiscomp.if.ufrgs.br/index.php?title=C%C3%B3digo_3&diff=9368&oldid=prev 2023-02-06T02:40:14Z

<p>Criou página com &#039; MODULE globais IMPLICIT NONE INTEGER :: N,L END MODULE PROGRAM exemplo3_laplace USE globais IMPLICIT NONE INT...&#039;</p> <p><b>Página nova</b></p><div> MODULE globais<br /> IMPLICIT NONE<br /> INTEGER :: N,L <br /> END MODULE<br /> <br /> PROGRAM exemplo3_laplace<br /> USE globais<br /> IMPLICIT NONE<br /> INTEGER :: i,j,k,c,t,edge<br /> REAL :: dV<br /> INTEGER,DIMENSION(:,:),ALLOCATABLE :: masc<br /> REAL,DIMENSION(:,:),ALLOCATABLE :: V,V1,E1,E2,x,y <br /> <br /> N = 10<br /> edge = 20*N<br /> L = edge + 1<br /> <br /> ALLOCATE(V(L,L),V1(L,L),E1(L,L),E2(L,L),x(L,L),y(L,L),masc(L,L)) <br /> <br /> DO i=1,L<br /> DO j=1,L<br /> x(j,i) = -1.0 + (i-1)*0.1/N<br /> y(j,i) = -1.0 + (j-1)*0.1/N<br /> END DO<br /> END DO<br /> <br /> ! Calcula utilizando o algoritmo de Jacobi <br /> CALL inicia_zeros(E1)<br /> CALL inicia_zeros(E2)<br /> CALL initialize_V(V,masc)<br /> <br /> c = 0<br /> V1 = V<br /> <br /> CALL laplace_jacobi(V,V1,masc,dV,c)<br /> CALL electric_field(V,E1,E2)<br /> <br /> WRITE(*,*) 'Jacobi:',dV,c<br /> <br /> CALL dados(x,y,V,E1,E2)<br /> <br /> ! Calcula utilizando o algoritmo de Gauss-Siedel<br /> CALL inicia_zeros(E1)<br /> CALL inicia_zeros(E2)<br /> CALL initialize_V(V,masc)<br /> <br /> c = 0<br /> <br /> CALL laplace_gauss_siedel(V,masc,dV,c)<br /> CALL electric_field(V,E1,E2)<br /> <br /> WRITE(*,*) 'Gauss-Siedel:',dV,c<br /> <br /> CALL dados(x,y,V,E1,E2)<br /> <br /> END PROGRAM<br /> <br /> SUBROUTINE inicia_zeros(M)<br /> ! Inicializa uma matriz em zeros<br /> USE globais<br /> IMPLICIT NONE<br /> INTEGER :: i,j<br /> REAL,DIMENSION(L,L) :: M<br /> DO i=1,L<br /> DO j=1,L<br /> M(j,i) = 0.0<br /> END DO<br /> END DO<br /> END SUBROUTINE inicia_zeros<br /> <br /> SUBROUTINE initialize_V(V0,mascara)<br /> ! Inicialização do potencial<br /> USE globais<br /> IMPLICIT NONE<br /> INTEGER :: i,j,m,o,p,q<br /> INTEGER,DIMENSION(L,L) :: mascara<br /> REAL,DIMENSION(L,L) :: V0<br /> ! Inicializa a mascara em 0 <br /> DO m=1,L<br /> DO o=1,L<br /> mascara(o,m) = 0<br /> END DO<br /> END DO<br /> ! Escreve 1's e -1's onde o V=1.0 ou V=-1.0<br /> DO q=7*N+1,13*N+1<br /> mascara(q,71) = 1<br /> mascara(q,131) = -1<br /> END DO<br /> ! Escreve o potencial<br /> DO i=1,L<br /> DO j=1,L<br /> IF (mascara(j,i) == 1) THEN<br /> V0(j,i) = 1.0 <br /> ELSE IF (mascara(j,i) == -1) THEN<br /> V0(j,i) = -1.0 <br /> ELSE <br /> V0(j,i) = 0.0<br /> END IF <br /> END DO <br /> END DO <br /> END SUBROUTINE initialize_V<br /> <br /> SUBROUTINE update_V_jacobi(Vn,Vn1,mascara,deltaV)<br /> ! Calcula a atualização uma vez<br /> USE globais<br /> IMPLICIT NONE<br /> INTEGER :: i,j<br /> REAL :: deltaV<br /> INTEGER,DIMENSION(L,L) :: mascara <br /> REAL,DIMENSION(L,L) :: Vn,Vn1<br /> deltaV = 0.0 <br /> DO i=2,L-1<br /> DO j=2,L-1<br /> IF (mascara(j,i) == 0) THEN<br /> Vn1(j,i) = (Vn(j+1,i) + Vn(j-1,i) + Vn(j,i+1) + &amp;<br /> Vn(j,i-1))/4.0<br /> deltaV = deltaV + abs(Vn(j,i) - Vn1(j,i))<br /> END IF<br /> END DO<br /> END DO<br /> END SUBROUTINE update_V_jacobi <br /> <br /> SUBROUTINE laplace_jacobi(Vm,Vm1,mascara,delta_v,cont)<br /> ! Implementa o método de Jacobi<br /> USE globais<br /> IMPLICIT NONE<br /> INTEGER :: cont,x<br /> REAL :: delta_v,tol<br /> INTEGER,DIMENSION(L,L) :: mascara<br /> REAL,DIMENSION(L,L) :: Vm,Vm1<br /> tol = 1e-5*L*L <br /> delta_v = 41.0<br /> DO WHILE (delta_v .gt. tol)<br /> CALL update_V_jacobi(Vm,Vm1,mascara,delta_v)<br /> CALL update_V_jacobi(Vm1,Vm,mascara,delta_v)<br /> cont = cont+1<br /> END DO<br /> END SUBROUTINE laplace_jacobi<br /> <br /> SUBROUTINE update_V_gauss_siedel(Vn,mascara,deltaV)<br /> ! Calcula a atualização uma vez<br /> USE globais<br /> IMPLICIT NONE<br /> INTEGER :: i,j<br /> REAL :: deltaV,v1,v2<br /> INTEGER,DIMENSION(L,L) :: mascara<br /> REAL,DIMENSION(L,L) :: Vn<br /> deltaV = 0.0<br /> DO i=2,L-1<br /> DO j=2,L-1<br /> IF (mascara(j,i) == 0) THEN<br /> v1 = Vn(j,i)<br /> Vn(j,i) = (Vn(j+1,i) + Vn(j-1,i) + Vn(j,i+1) + &amp;<br /> Vn(j,i-1))/4.0<br /> v2 = Vn(j,i)<br /> deltaV = deltaV + abs(v2 - v1)<br /> END IF<br /> END DO<br /> END DO<br /> END SUBROUTINE update_V_gauss_siedel<br /> <br /> SUBROUTINE laplace_gauss_siedel(Vm,mascara,delta_v,cont)<br /> ! Implementa o método de Gauss_Siedel<br /> USE globais<br /> IMPLICIT NONE<br /> INTEGER :: cont<br /> REAL :: delta_v,tol<br /> INTEGER,DIMENSION(L,L) :: mascara<br /> REAL,DIMENSION(L,L) :: Vm<br /> tol = 1e-5*L*L<br /> delta_v = 10.0<br /> DO WHILE (delta_v .gt. tol)<br /> CALL update_V_gauss_siedel(Vm,mascara,delta_v)<br /> CALL update_V_gauss_siedel(Vm,mascara,delta_v)<br /> cont = cont+1<br /> END DO<br /> END SUBROUTINE laplace_gauss_siedel<br /> <br /> SUBROUTINE electric_field(Vk,Ex,Ey)<br /> ! Calcula o campo elétrico a partir do potencial <br /> USE globais<br /> IMPLICIT NONE<br /> INTEGER :: i,j<br /> REAL,DIMENSION(L,L) :: Vk,Ex,Ey<br /> ! Derivada para frente (bordas) <br /> DO i=1,L-1<br /> Ex(1,i) = - (Vk(1,i+1) - Vk(1,i)) <br /> Ex(L,i) = - (Vk(L,i+1) - Vk(L,i)) <br /> Ey(i,1) = - (Vk(i+1,1) - Vk(i,1)) <br /> Ey(i,L) = - (Vk(i+1,L) - Vk(i,L)) <br /> END DO<br /> ! Derivada para trás (bordas)<br /> Ex(1,L) = - (Vk(1,L) - Vk(1,L-1))<br /> Ex(L,L) = - (Vk(L,L) - Vk(L,L-1))<br /> Ey(L,1) = - (Vk(L,1) - Vk(L-1,1))<br /> Ey(L,L) = - (Vk(L,L) - Vk(L-1,L))<br /> ! Derivada centrada<br /> DO i=2,L-1<br /> DO j=2,L-1 <br /> Ex(j,i) = - (Vk(j,i+1) - Vk(j,i-1))/2.0 <br /> Ey(j,i) = - (Vk(j+1,i) - Vk(j-1,i))/2.0 <br /> END DO<br /> END DO<br /> END SUBROUTINE electric_field<br /> <br /> SUBROUTINE dados(x1,y1,Vk,Ex,Ey)<br /> ! Imprime os dados em arquivos<br /> USE globais<br /> IMPLICIT NONE<br /> INTEGER :: i,j,k<br /> REAL,DIMENSION(L,L) :: Vk,Ex,Ey,x1,y1<br /> CHARACTER(28),DIMENSION(2) :: a<br /> CHARACTER(27),DIMENSION(2) :: b<br /> CHARACTER(32),DIMENSION(2) :: c<br /> <br /> a(1) = 'potencial_laplace_jacob3.dat'<br /> a(2) = 'potencial_laplace_gauss3.dat'<br /> b(1) = 'electric_laplace_jacob3.dat'<br /> b(2) = 'electric_laplace_gauss3.dat'<br /> c(1) = 'equipotencial_laplace_jacob3.dat'<br /> c(2) = 'equipotencial_laplace_gauss3.dat'<br /> <br /> DO k=1,2<br /> OPEN(10,FILE=a(k),STATUS='unknown',ACTION='write')<br /> DO i=1,L<br /> DO j=1,L<br /> WRITE(10,*) x1(j,i),y1(j,i),Vk(j,i)<br /> END DO<br /> WRITE(10,*) ''<br /> END DO<br /> CLOSE(10)<br /> <br /> OPEN(20,FILE=b(k),STATUS='unknown',ACTION='write')<br /> DO i=1,L<br /> DO j=1,L<br /> WRITE(20,*) x1(j,i),y1(j,i),Ex(j,i),Ey(j,i)<br /> END DO<br /> WRITE(20,*) ''<br /> END DO<br /> CLOSE(20)<br /> <br /> OPEN(30,FILE=c(k),STATUS='unknown',ACTION='write')<br /> DO i=1,L<br /> DO j=1,L<br /> IF ((Vk(j,i) .lt. 0.96) .and. (Vk(j,i) .gt. 0.94 &amp;<br /> )) THEN<br /> WRITE(30,*) x1(j,i),y1(j,i)<br /> ELSE IF ((Vk(j,i) .lt. 0.76) .and. (Vk(j,i) .gt. &amp;<br /> 0.74 )) THEN<br /> WRITE(30,*) x1(j,i),y1(j,i)<br /> ELSE IF ((Vk(j,i) .lt. 0.56) .and. (Vk(j,i) .gt. &amp;<br /> 0.54 )) THEN<br /> WRITE(30,*) x1(j,i),y1(j,i)<br /> ELSE IF ((Vk(j,i) .lt. 0.36) .and. (Vk(j,i) .gt. &amp;<br /> 0.34 )) THEN<br /> WRITE(30,*) x1(j,i),y1(j,i)<br /> ELSE IF ((Vk(j,i) .lt. 0.16) .and. (Vk(j,i) .gt. &amp;<br /> 0.14 )) THEN<br /> WRITE(30,*) x1(j,i),y1(j,i)<br /> ELSE IF ((Vk(j,i) .gt. -0.96) .and. (Vk(j,i) .lt.&amp;<br /> -0.94 )) THEN<br /> WRITE(30,*) x1(j,i),y1(j,i)<br /> ELSE IF ((Vk(j,i) .gt. -0.76) .and. (Vk(j,i) .lt.&amp;<br /> -0.74 )) THEN<br /> WRITE(30,*) x1(j,i),y1(j,i)<br /> ELSE IF ((Vk(j,i) .gt. -0.56) .and. (Vk(j,i) .lt.&amp;<br /> -0.54 )) THEN<br /> WRITE(30,*) x1(j,i),y1(j,i)<br /> ELSE IF ((Vk(j,i) .gt. -0.36) .and. (Vk(j,i) .lt.&amp;<br /> -0.34 )) THEN<br /> WRITE(30,*) x1(j,i),y1(j,i)<br /> ELSE IF ((Vk(j,i) .gt. -0.16) .and. (Vk(j,i) .lt.&amp;<br /> -0.14 )) THEN<br /> WRITE(30,*) x1(j,i),y1(j,i)<br /> END IF<br /> END DO<br /> END DO<br /> CLOSE(30)<br /> END DO<br /> END SUBROUTINE dados</div>

Gustavobopsin