Universitatea Tehnic Gheorghe Asachi din IaiFacultatea de Construcii i Instalaii Master Inginerie Structural

LUCRAREA NR.2 Portofoliu de programe n limbaj Fortran

Masterand: Ivan Oana Diana

Iai 2011

Problema nr.1: Calculul ariei unui triunghi cu ajutorul formulei lui Heron1. Enunul problemei S se calculeze aria unui triunghi cunoscnd laturile sale. 2. Analiza problemei Date de intrare: laturile triunghiului: a, b, c Date de ieire : aria triunghiului: S Metoda de calcul: Formula lui Heron relaia (1) = Unde p este semiperimetrul calculat cu relaia (2) = 3. Programarea problemei Pentru rezolvarea problemei s-a folosit limbajul Fortran -90 implementarea Intel versiunea 11 sub mediul de dezvoltare Microsoft Visual Studio 2008. Fereastra sistemului de dezvoltare MSVS 2008 arata astfel:

(1) (2)

Figura1.1 Fereastrasistemului MSVS 2008

Program Fortranprogram calcarie ! Program de calcul al ariei unui triunghi implicit none ! Declaratii real a,b,c,p,s ! Afisare titlu

write(*,*) 'Calculul ariei unui triunghi' write(*,*) ! Date de intrare write(*,*) 'a=' read (*,*) a write(*,*) 'b=' read (*,*) b write(*,*) 'c=' read (*,*) c ! Verificare write(*,*) 'a,b,c sunt:',a,b,c ! Semiperimetrul p=(a+b+c)/2. write(*,*) 'Semiperimetrul este:',p ! Aria S=sqrt(p*(p-a)*(p-b)*(p-c)) write(*,*) 'Aria este:',S read* end program calcarie

4. Rezultate S-au dat urmtoarele valori ale datelor de intrare: a=2,b=3,c=10, care nu sunt laturile unui triunghi i, ca urmare s-a obinut valoarea NaN (not a number) pentru arie.

Figura1.2. Rezultate pentru primul set de valori

Pentru urmtoarele valori: a=2,b=3,c=3 obinem urmtorul rezultat:

Figura1.3. Rezultate pentru primul set de valori

Problema nr.2: Calculul unui moment de inerie I1. Enunul problemei Sa se calculeze momentul de inerie pentru un triunghi sau pentru un dreptunghi 2. Analiza problemei Date de intrare: tip,laimea b,nlimea h Date de ieire : momentul de inerie Metoda de calcul: Dac tip=1:

= Unde I este momentul de inerie al unui triunghi. Dac tip1:

(1)

= Unde I este momentul de inerie al unui dreptunghi. 3. Programarea problemei

(2)

Pentru rezolvarea problemei s-a folosit limbajul Fortran -90 implementarea Intel versiunea 11 sub mediul de dezvoltare Microsoft Visual Studio 2008. Program Fortranprogram aplicatie_2 ! program de calcul al momentelor de inertie implicit none ! declaratii real tip,b,h,I write(*,*)'Calculul momentelor de inertie' write(*,*) !date de intrare write(*,1) 1 format('tip=',$) read(*,*)tip write(*,2) 2 format('b=',$) read(*,*)b write(*,3) 3 format('h=',$) read(*,*)h write(*,*)'tip,b,h sunt:' ,tip,b,h if ((b0.0) .or. (b0, x1,2= a0 , d=b2-4ac

d=0, x1=x2=x= d0.0) .or. (a0.0) then x1=((-b)-sqrt(d))/(2*a) x2=((-b)+sqrt(d))/(2*a) write(12,*) 'Solutiile ecuatiei sunt:' write(12,*) 'x1=',x1 write(12,*) 'x2=',x2 else if (d==0) then x=(-b)/(2*a) write(12,*) 'Solutia ecuatiei este:' write(12,*) 'x1=x2=x=',x else write(12,*) 'Delta este negativ-->solutii complexe' endif endif else if ((b>0.0) .or. (b=abs(eps)) t=-t*x/(2.*i)*x/(2.*i+1.) s=s+t write(*,*) ' i=',i, ' t=',t,' s=',s i=i+1 enddo write(*,*) ' s=' ,s write(*,*) ' sinus din calculator=' ,sin(x) print *, 'Program terminat' read* end program series2

4. Rezultate

Figura 5.2

Problema nr.5: Rezolvarea funciei sinus prin descompunere n serie

Varianta nr.31. Enunul problemei S se calculeze funcia sinus(x) prin descompunere de serie. 2. Analiza problemei Date de intrare: x, n; Date de iesire: s (sin(x)). Metoda de calcul: Descompunerea funciei se realizeaz cu ajutorul urmtoarei serii:

sin

=

=

!

+

!

+ + 1

!

(1) (2)

Problema se va rezolva n simpl precizie cu un numr finit de cicluri. 3. Programarea problemei

Pentru rezolvarea problemei s-a folosit limbajul Fortran -90 implementarea Intel versiunea 11 sub mediul de dezvoltare Microsoft Visual Studio 2008. Programarea problemei s-a realizat cu numr finit cunoscut de cicluri, cu ajutorul funciei do . Program Fortranprogram series3 ! calculul functiei sinus prin descompunere in serie ! cu numar finit cunoscut de cicluri implicit none ! declaratii de tip real x,t,s integer n,i write(*,*)' Calculul functiei sinus prin descompunere in serie' ! date de intrare write(*,1) 1 format(' x=',$) read(*,*) x write(*,2) 2 format(' n=',$) read(*,*) n ! valori initiale s=x t=x ! ciclari do i=1,n !t=-t*x**2/(2*i*(2*i+1)) !t=-t*x*x/2./i/(2.*i+1.) t=-t*x/(2.*i)*x/(2.*i+1.) s=s+t write(*,*) ' i=',i, ' t=',t,' s=',s enddo write(*,*) ' s=' ,s write(*,*) ' sinus din calculator=' ,sin(x) print *, 'Program terminat' read* end program series3

4. Rezultate

Figura 5.3

Problema nr.5: Rezolvarea funciei sinus prin descompunere n serie

Varianta nr.41. Enunul problemei S se calculeze funcia sinus(x) prin descompunere de serie. 3. Analiza problemei Date de intrare: x, n; Date de iesire: s (sin(x)). Metoda de calcul: Descompunerea funciei se realizeaz cu ajutorul urmtoarei serii:

sin

=

=

!

+

!

+ + 1

!

(1) (2)

Problema se va rezolva n simpl precizie cu un numr finit de cicluri. 3. Programarea problemei Pentru rezolvarea problemei s-a folosit limbajul Fortran -90 implementarea Intel versiunea 11 sub mediul de dezvoltare Microsoft Visual Studio 2008. Programarea problemei s-a realizat cu numr finit cunoscut de cicluri,dubl precizie, cu ajutorul funciei do . Program Fortranprogram series4 ! Calculul functiei sinus prin descompunere in serie ! Cu numar finit cunoscut de cicluri ! Varianta dubla precizie implicit none ! Declaratii de tip real*8 x,t,s integer n,i write(*,*)' Calculul functiei sinus prin descompunere in serie' ! Date de intrare write(*,1) 1 format(' x=',$) read(*,*) x write(*,2) 2 format(' n=',$) read(*,*) n ! Valori initiale s=x t=x ! Ciclari do i=1,n !t=-t*x**2/(2*i*(2*i+1)) !t=-t*x*x/2./i/(2.*i+1.) t=-t*x/(2.d0*i)*x/(2.d0*i+1.d0)

s=s+t write(*,*) ' i=',i, ' t=',t,' s=',s enddo write(*,*) ' s=' ,s write(*,*) ' sinus din calculator=' ,dsin(x) print *, ' Program terminat' read* end program series4

4. Rezultate

Figura 5.4

Problema nr.5: Rezolvarea funciei sinus prin descompunere n serie

Varianta nr.51. Enunul problemei S se calculeze funcia sinus(x) prin descompunere de serie. 2. Analiza problemei Date de intrare: x, n; Date de iesire: s (sin(x)). Metoda de calcul: Descompunerea funciei se realizeaz cu ajutorul urmtoarei serii:

sin

=

=

!

+

!

+ + 1

!

(1) (2)

Problema se va rezolva n simpl precizie cu un numr finit de cicluri. 3. Programarea problemei Pentru rezolvarea problemei s-a folosit limbajul Fortran -90 implementarea Intel versiunea 11 sub mediul de dezvoltare Microsoft Visual Studio 2008.

Programarea problemei s-a realizat cu numr finit necunoscut de cicluri,dubl precizie, cu ajutorul funciei do while . Program Fortranprogram series5 ! Calculul functiei sinus prin descompunere in serie ! Cu numar finit necunoscut de cicluri ! Varianta dubla precizie implicit none ! Declaratii de tip real*8 x,t,s,eps integer i write(*,*)' Calculul functiei sinus prin descompunere in serie' ! Date de intrare write(*,1) 1 format(' x=',$) read(*,*) x write(*,2) 2 format(' epsilon=',$) read(*,*) eps ! Valori initiale s=x t=x ! Ciclari i=1 !t=-t*x**2/(2*i*(2*i+1)) !t=-t*x*x/2./i/(2.*i+1.) do while(dabs(t)>=dabs(eps)) t=-t*x/(2.d0*i)*x/(2.d0*i+1.d0) s=s+t write(*,*) ' i=',i, ' t=',t,' s=',s i=i+1 enddo write(*,*) ' s=' ,s write(*,*) ' sinus din calculator=' ,dsin(x) print *, 'Program terminat' read* end program series5

4. Rezultate

Figura 5.5

Problema nr.6: Calculul logaritmului natural folosind fereastra de dialog

1. Enunul problemei S se calculeze logaritmul natural al unui numr folosind fereastra de dialog. 2. Analiza problemei Date de intrare: xDate de ieire : ln(x) valoarea logaritmului natural.

3. Programarea problemei Pentru rezolvarea problemei s-a folosit limbajul Fortran -90 implementarea Intel versiunea 11 sub mediul de dezvoltare Microsoft Visual Studio 2008. Program Fortranprogram fered1 use iflogm implicit none include 'resource.fd' type(dialog) din logical rtr character*20 text real x,vl integer rer rtr=dlginit(ferjoi,din) rtr=dlgmodal(din) rtr=dlgget(din,xf,text) write(*,*)'S-a preluat din fereastra textul ', text read(text,*,iostat=rer) x if(rer==0) then write(*,*) 'Numarul citit este: ',x vl=alog(x) write(text,*) vl rtr=dlgset(din,lnx,text) ! rtr=dlgmodal(din) rtr=dlgset(din,msj,'Valoarea lui x este corecta.') else write(*,*) 'Eroare la valoarea lui x ' rtr=dlgset(din,msj,'Eroare la valoarea lui x.') endif rtr=dlgmodal(din) call dlguninit(din) print *, 'Sfarsit program' read* end program fered1

4. Rezultate

Figura 6.1

Figura 6.2

Problema nr.7: Calculul ariei unui triunghi cu ajutorul ferestrei de dialog1. Enunul problemei S se calculeze aria unui triunghi cunoscnd laturile sale. 2. Analiza problemei Date de intrare: laturile triunghiului: a, b, c Date de ieire : aria triunghiului: S Metoda de calcul: Formula lui Heron relaia (1)

= Unde p este semiperimetrul calculat cu relaia (2) =3. Programarea problemei

(1) (2)

Pentru rezolvarea problemei s-a folosit limbajul Fortran -90 implementarea Intel versiunea 11 sub mediul de dezvoltare Microsoft Visual Studio 2008. Program Fortranprogram CalculArieCuFereastra use iflogm implicit none include 'resource.fd' external suba type(dialog) din logical rtr rtr=dlginit(fereastra,din) rtr=dlgsetsub(din,vala,suba) rtr=dlgsetsub(din,valb,suba) rtr=dlgsetsub(din,valc,suba) rtr=dlgmodal(din) print *, 'Programul s-a incheiat' read * call dlguninit(din) end program CalculArieCuFereastra subroutine suba(din,valx,ce) use iflogm implicit none include 'resource.fd' type(dialog) din logical rtr character*20 ch,text real a,b,c,p,S integer valx,ce,rer rtr=dlgget(din,vala,text) read(text,*,iostat=rer) a if (rer==0) then read (text,*)ch if ((ch=='f').or.(ch=='t').or.(ch=='F').or.(ch=='T')) then write(*,*) 'Eroare la variabila a' rtr=dlgset(din,mesaj1,'Eroare ') else rtr=dlgset(din,mesaj1,'OK') endif else rtr=dlgset(din,mesaj1,'Eroare la variabila a') write(*,*) 'Eroare la variabila a' endif

rtr=dlgget(din,valb,text) read(text,*,iostat=rer) b if (rer==0) then read (text,*)ch if ((ch=='f').or.(ch=='t').or.(ch=='F').or.(ch=='T')) then write(*,*) 'Eroare la variabila b' rtr=dlgset(din,mesaj2,'Eroare la variabila b') else

rtr=dlgset(din,mesaj2,'OK') endif else write(*,*) 'Eroare la variabila b' rtr=dlgset(din,mesaj2,'Eroare la variabila b') endif rtr=dlgget(din,valc,text) read(text,*,iostat=rer) c if (rer==0) then read (text,*)ch if ((ch=='f').or.(ch=='t').or.(ch=='F').or.(ch=='T')) then write(*,*) 'Eroare la variabila c' rtr=dlgset(din,mesaj3,'Eroare la variabila c') else rtr=dlgset(din,mesaj3,'OK') endif else rtr=dlgset(din,mesaj3,'Eroare la variabila c') endif p=(a+b+c)/2 write(ch,*)p if ((a>0.).and.(b>0.).and.(c>0.).and.((a+b)>c).and.((b+c)>a).and.((c+a)>b)) then !ramura de adevar !calculul ariei S=sqrt(p*(p-a)*(p-b)*(p-c)) write(ch,*)S !calculul si afisarea ariei in subrutina rtr=dlgset(din,valS,ch) rtr=dlgget(din,valS,ch) read(ch,*) S Write(*,*) 'Aria triunghiului este',S rtr=dlgset(din,mesaj4,'Datele de intrare sunt introduse corect') else !ramura de fals Write(*,*) 'aria triunghiului nu poate fi calculata' rtr=dlgset(din,mesaj4,'Datele de intrare nu sunt corecte') end if !inchiderea subrutinei write(*,*) end subroutine suba

4. Rezultate

Figura 7.1

Problema nr.8: Calculul caracteristicilor dinamice ale unui sistem cu 1 GLD1. Enunul problemei S se calculeze caracteristicile dinamice ale unui sistem cu 1 GLD . 2. Analiza problemei Date de intrare: b,h (dimensiunile seciunii),l (lungimea barei), E (modulul de elasticitate al materialului) Date de ieire : I (momentul de inerie), (flexibilitatea), (pulsaia), T (perioada), f (frecvena);= = 12

l 3EI 1

= = =

1 1 T

3. Programarea problemei Pentru rezolvarea problemei s-a folosit limbajul Fortran -90 implementarea Intel versiunea 11 sub mediul de dezvoltare Microsoft Visual Studio 2008. Program Fortranprogram callb1 use iflogm implicit none include 'resource.fd' type(dialog) din logical rtr character*20 text external subgld

rtr=dlginit(ferjoi,din) rtr=dlgsetsub(din,bsdia,subgld) rtr=dlgsetsub(din,hsdia,subgld) rtr=dlgsetsub(din,Edia,subgld) rtr=dlgsetsub(din,hdia,subgld) rtr=dlgsetsub(din,mdia,subgld) rtr=dlgmodal(din)

print *, 'Program terminat' read * end program callb1

subroutine subgld(din,var,ce) use iflogm implicit none include 'resource.fd' type(dialog) din logical rtr,rer character*20 text character*1 ch integer var,ce real bs,hs,E,h,m real omega,T,f,delta,I !select case (var) !case(bsdia) ! write(*,*) 'bsdia' !case(hsdia) ! write(*,*) 'hsdia' !case(Edia) ! write(*,*) 'Edia' !case(hdia) ! write(*,*) 'hdia' !case(mdia) ! write(*,*) 'mdia' !case default !write(*,*) '????' !end select

!preluare date din dialog !bs rtr=dlgget(din,bsdia,text) if(text/='') then read(text,*) ch read(text,*,iostat=rer) bs if((rer==0).and.(ch/='f').and.(ch/='F').and.(ch/='t').and.(ch/='T')) then rtr=dlgset(din,msj,'') else rtr=dlgset(din,msj,'eroare la datele de intrare') return endif else rtr=dlgset(din,msj,'eroare la datele de intrare') return endif write(*,*)bs !hs rtr=dlgget(din,hsdia,text) if(text/='') then read(text,*) ch read(text,*,iostat=rer) hs if((rer==0).and.(ch/='f').and.(ch/='F').and.(ch/='t').and.(ch/='T')) then rtr=dlgset(din,msj,'') else

rtr=dlgset(din,msj,'eroare la datele de intrare') return endif else rtr=dlgset(din,msj,'eroare la datele de intrare') return endif write(*,*)hs !E rtr=dlgget(din,Edia,text) if(text/='') then read(text,*) ch read(text,*,iostat=rer) E if((rer==0).and.(ch/='f').and.(ch/='F').and.(ch/='t').and.(ch/='T')) then rtr=dlgset(din,msj,'') else rtr=dlgset(din,msj,'eroare la datele de intrare') return endif else rtr=dlgset(din,msj,'eroare la datele de intrare') return endif write(*,*)E !h rtr=dlgget(din,hdia,text) if(text/='') then read(text,*) ch read(text,*,iostat=rer) h if((rer==0).and.(ch/='f').and.(ch/='F').and.(ch/='t').and.(ch/='T')) then rtr=dlgset(din,msj,'') else rtr=dlgset(din,msj,'eroare la datele de intrare') return endif else rtr=dlgset(din,msj,'eroare la datele de intrare') return endif write(*,*)h !m rtr=dlgget(din,mdia,text) if(text/='') then read(text,*) ch read(text,*,iostat=rer) m if((rer==0).and.(ch/='f').and.(ch/='F').and.(ch/='t').and.(ch/='T')) then rtr=dlgset(din,msj,'') else rtr=dlgset(din,msj,'eroare la datele de intrare') return endif else rtr=dlgset(din,msj,'eroare la datele de intrare') return endif write(*,*)m

!calculul caracteristicilor dinamice I=bs*hs**3/12

delta=h**3/(3*I*E) omega=sqrt(1/delta) write(text,*) omega rtr=dlgset(din,a,text)

T=2*3.14/omega write(text,*) T rtr=dlgset(din,b,text) f=1/T write(text,*) f rtr=dlgset(din,c,text)

end subroutine subgld

4. Rezultate

Figura 8.1

Problema nr.9: Trasarea graficului sinus1. Enunul problemei S se traseze graficul funciei sinus. 2. Analiza problemei Se furnizeaz lui i valori ntre 1 si 1000,se introduc legile de variaie ale funciei pe cele 2 axe i se ruleaz programul. 3. Programarea problemei

Pentru rezolvarea problemei s-a folosit limbajul Fortran -90 implementarea Intel versiunea 11 sub mediul de dezvoltare Microsoft Visual Studio 2008. Program Fortranprogram graf1 use avfrt use avobjmod implicit none real px(1000),py(1000) real pi integer i,st,vid,hroot,hg pi=3.141593 do i=1,1000 px(i)=i*pi/100. py(i)=sin(px(i)) enddo call avstartwatch(loc(px),1,shape(px),av_real4,'px',st) call avstartwatch(loc(py),1,shape(py),av_real4,'py',st) call avnewviewer(vid) hroot=avgetobject('/') call avcreategraph2dobj(avgraphs(hroot),'sin1|plot:xyplot,xsource:/px,ysource:/py',hg ) call avvisible(vid,1,st) call avsaveimage('sin.jpg','graph:/sin1',1200,1600,72,st) print *, 'sfarsit' read * end program graf1

4. Rezultate

Figura 9.1

Figura 9.2

Problema nr.10: Trasarea diagramelor unei grinzi1. Enunul problemei S se traseze diagramele de for tieoare i moment pentru grinda din figura.

Figura 10.1

2. Analiza problemei Date de intrare: a, b, c, d, q, P; Date de ieire : V(x), M(x). 3. Programarea problemei Pentru rezolvarea problemei s-a folosit limbajul Fortran -90 implementarea Intel versiunea 11 sub mediul de dezvoltare Microsoft Visual Studio 2008. Program Fortran

program gsr1 use iflogm implicit none include 'resource.fd' type (dialog) dia integer rtr external sdate,calcul real a,b,c,d,q,P common a,b,c,d,q,P,idi integer idi idi=1 rtr=dlginit(dg,dia) rtr=dlgsetsub(dia,aa,sdate) rtr=dlgsetsub(dia,bb,sdate) rtr=dlgsetsub(dia,cc,sdate) rtr=dlgsetsub(dia,dd,sdate) rtr=dlgsetsub(dia,qq,sdate) rtr=dlgsetsub(dia,pp,sdate) rtr=dlgsetsub(dia,tras,calcul) rtr=dlgmodal(dia) print *, 'Sfarsit' read* end program gsr1 subroutine sdate(dia,ce,de) use iflogm implicit none include 'resource.fd' type (dialog) dia integer rtr,ce,de,rer,idi character*20 text character*1 ch real a,b,c,d,q,P common a,b,c,d,q,P,idi idi=1 rtr=dlgget(dia,aa,text) if (text/='') then read (text,*) ch read(text,*,iostat=rer) a if((rer==0).and.(ch/='f').and.(ch/='F').and.(ch/='t').and.(ch/='T')) then else rtr=dlgset(dia,msj,'Eroare la datele de intrare') return endif else rtr=dlgset(dia,msj,'Eroare la datele de intrare') endif rtr=dlgget(dia,bb,text) if (text/='') then read (text,*) ch read(text,*,iostat=rer) b if((rer==0).and.(ch/='f').and.(ch/='F').and.(ch/='t').and.(ch/='T')) then else rtr=dlgset(dia,msj,'Eroare la datele de intrare') return endif else rtr=dlgset(dia,msj,'Eroare la datele de intrare') endif

rtr=dlgget(dia,cc,text) if (text/='') then read (text,*) ch read(text,*,iostat=rer) c if((rer==0).and.(ch/='f').and.(ch/='F').and.(ch/='t').and.(ch/='T')) then else rtr=dlgset(dia,msj,'Eroare la datele de intrare') return endif else rtr=dlgset(dia,msj,'Eroare la datele de intrare') endif rtr=dlgget(dia,dd,text) if (text/='') then read (text,*) ch read(text,*,iostat=rer) d if((rer==0).and.(ch/='f').and.(ch/='F').and.(ch/='t').and.(ch/='T')) then else rtr=dlgset(dia,msj,'Eroare la datele de intrare') return endif else rtr=dlgset(dia,msj,'Eroare la datele de intrare') endif rtr=dlgget(dia,qq,text) if (text/='') then read (text,*) ch read(text,*,iostat=rer) q if((rer==0).and.(ch/='f').and.(ch/='F').and.(ch/='t').and.(ch/='T')) then else rtr=dlgset(dia,msj,'Eroare la datele de intrare') return endif else rtr=dlgset(dia,msj,'Eroare la datele de intrare') endif rtr=dlgget(dia,pp,text) if (text/='') then read (text,*) ch read(text,*,iostat=rer) P if((rer==0).and.(ch/='f').and.(ch/='F').and.(ch/='t').and.(ch/='T')) then else rtr=dlgset(dia,msj,'Eroare la datele de intrare') return endif else rtr=dlgset(dia,msj,'Eroare la datele de intrare') endif rtr=dlgset(dia,msj,'date ok') idi=0 write (*,*) 'Se lucreaza',text write(*,*) a,b,c,d,q,P end subroutine sdate

subroutine calcul(dia,ce,de) use iflogm use avfrt use avobjmod !atentie: in properties la proiect(F solution explorer) !la Linker, Input - Additonal Dependencies se trec: !avfrt.lib ole32.lib oleaut32.lib implicit none include 'resource.fd' type (dialog) dia integer rtr,ce,de,rer,idi,i integer st,vid,hroot,hg real a,b,c,d,q,P,VA,VB,verif,L parameter nrint=1000 real xx(nrint+1),Vx(nrint+1),Mx(nrint+1) common a,b,c,d,q,P,idi

if(idi==0) then write(*,*) 'trasare posibila' L=a+b+c+d VA=(q*b*(b/2+c+d)+P*d)/L VB=(q*b*(a+b/2)+P*(a+b+c))/L verif=VA+VB-q*b-P write(*,*) 'verif=', verif xx(1)=0. Vx(1)=VA Mx(1)=0. xx(nrint+1)=L Vx(nrint+1)=-VB Mx(nrint+1)=0 do i=2,nrint

xx(i)=xx(i-1)+L/nrint if (xx(i)