C PROGRAMMA PER L'ANALISI DI IMMAGINI TERMOGRAFICHE c c Questo programma permette l'analisi c di zone di una termografia infrarosso c INCLUDE 'FGRAPH.FI' INCLUDE 'FGRAPH.FD' RECORD/RCCOORD/CURPOS parameter (ZM=20) parameter (noimm=50) integer datiim(256,200),c0,c1,c2,contrasto,lmax,lmin INTEGER nozone,ASCISI(zm),ASCISF(zm),px,py integer*2 STATUS integer ORDINI(zm),ORDINF(zm),contat,zona,I,ris,nmax(zm,noimm) integer xmax(zm,noimm),ymax(zm,noimm),xmin(zm,noimm) integer ymin(zm,noimm),imm,nmin(zm,noimm),n(zm) real tbianc,tnero,temmax(zm,noimm),temmin(zm,noimm) real temmed(zm,noimm),devtme(zm,noimm) character file*7,rispos*1,nomefile*26,label*2,nomesequenza*26 character*5 fole character*7 passaggio,ctemmed(zm),cdevtme(zm) character*7 ctemmax(zm),ctemmin(zm) INTEGER*4 RGB c scelta del file da analizzare 1 lmax=0 lmin=256 call clearscreen ($gclearscreen) write(*,*)' TERMOSELECT ''99' write(*,*) write(*,*)'Questo programma permette di selezionare ed analizzare *fino a 20 zone rettango-' write(*,*)'lari di una termografia o di una sequenza di termografi *e infrarosso.' WRITE(*,*) write(*,*)'Vuoi analizzare un''immagine singola (1) o una sequenza * (2) ? ' ris=0 read(*,*)ris if (ris.eq.1) goto 98 if (ris.eq.2) then call sequenza(fole,datiim,lmax,lmin,px,py,*70) goto 3 endif goto 1 98 call clearscreen($gclearscreen) write(*,*) write(*,*) write(*,*)'Il file deve essere in formato .RAW e deve essere' write(*,*)'nel percorso c:\lab98\termo\' write(*,*) write(*,*)'Introdurre il nome del file da analizzare (7lettere).' read(*,'(A7)')file nomefile='c:\lab98\termo\'//file//'.raw' c dimensionamento immagine singola call dimensionamento(px,py) c caricamento dell'immagine call clearscreen ($gclearscreen) do contat=1,12 write(*,*) enddo write(*,*)'Prelevamento immagine in corso...' call prelev (nomefile,datiim,lmax,lmin,ris,px,py,*98) c selezione modalit… grafica a 16 colori, 640 x 480 pixel 3 call clearscreen ($gclearscreen) STATUS=SETVIDEOMODE($VRES16COLOR) C Selezione paletta a 16 tonalit… di grigio DO I=2,62,4 RGB=ISHL(ISHL(I,8).OR.I,8).OR.I STATUS=REMAPPALETTE(I/4,RGB) ENDDO c Inserimento del contrasto 45 call puliscischermo lmin=255 lmax=0 c0=0 c1=0 c2=0 call settextposition(3,1,curpos) call outtext('Inserisci il contrasto con cui visualizzare l''immag *ine (1-16) ') read(*,*)contrasto if ((contrasto.lt.1).or.(contrasto.gt.16)) goto 45 c2=14*(17-contrasto) c1=28*(contrasto-1) c0=15+contrasto c visualizzazione dell'immagine 450 call visual (datiim,c0,c1,c2,lmax,lmin,1,px,1,py,px,py) c richiesta di modifica del contrasto 46 call puliscischermo call settextposition(3,1,curpos) call outtext('Vuoi cambiare il contrasto (s/n) ? ') read (*,'(a1)') rispos if ((rispos.eq.'s').or.(rispos.eq.'S')) goto 45 if ((rispos.ne.'n').and.(rispos.ne.'N')) goto 46 c inserimento del range di temperature call puliscischermo 10 CALL SETTEXTPOSITION(3,1,CURPOS) STATUS= SETTEXTCOLOR(14) CALL OUTTEXT('Immettere la temperatura corrispondente al nero ') read(*,*)tnero if ((tnero.lt.-999.99).or.(tnero.gt.999.98)) goto 10 2020 CALL PULISCISCHERMO call settextposition(3,1,curpos) call outtext('Immettere la temperatura corrispondente al bianco ') read(*,*)tbianc if ((tbianc.lt.-999.98).or.(tbianc.gt.999.99)) goto 2020 if (tbianc.le.tnero) then CALL PULISCISCHERMO call settextposition(1,1,curpos) call outtext('La temperatura del nero deve essere minore di quella * del bianco.') goto 10 endif c visualizzazione griglia 8 call PULISCISCHERMO call grigli(1,px,1,py,px,py) c selezione aree da analizzare 4 call puliscischermo CALL SETTEXTPOSITION(2,1,CURPOS) CALL OUTTEXT('Quante zone vuoi analizzare (max 20) ? ') nozone=0 read(*,*)nozone if ((nozone.eq.0).or.(nozone.gt.zm)) goto 4 do zona=1,nozone 5 call puliscischermo 57 call SETTEXTPOSITION(3,1,CURPOS) write(*,2000)zona 2000 format (' Inserire le ascisse e le ordinate della zona ',i2) read(*,*)ascisi(zona),ascisf(zona),ordini(zona),ordinf(zona) 1111 if (((ascisi(zona).gt.px).or.(ascisi(zona).lt.1)).and.((ascisf(z *ona).gt.px).or.(ascisf(zona).lt.1))) then call puliscischermo call settextposition(1,1,curpos) call outtext('ASCISSE FUORI RANGE, reinserirle ') read(*,*) ascisi(zona),ascisf(zona) goto 1111 endif 1112 if ((ascisi(zona).gt.px).or.(ascisi(zona).lt.1)) then call puliscischermo call settextposition(1,1,curpos) call outtext('ASCISSA INIZIALE FUORI RANGE, reinserirla ') read(*,*) ascisi(zona) GOTO 1112 ENDIF 1113 IF ((ascisf(zona).gt.px).or.(ascisf(zona).lt.1)) then call puliscischermo call settextposition(1,1,curpos) call outtext('ASCISSA FINALE FUORI RANGE, reinserirla ') read(*,*) ascisf(zona) goto 1113 endif if (ascisf(zona).lt.ascisi(zona)) then b=ascisf(zona) ascisf(zona)=ascisi(zona) ascisi(zona)=b endif 1114 if (((ordini(zona).gt.py).or.(ordini(zona).lt.1)).and.((ordinf(z *ona).gt.px).or.(ordinf(zona).lt.1))) then call puliscischermo call settextposition(1,1,curpos) call outtext('ORDINATE FUORI RANGE, reinserirle ') read(*,*) ordini(zona),ordinf(zona) goto 1114 endif 1115 if ((ordini(zona).gt.py).or.(ordini(zona).lt.1)) then call puliscischermo call settextposition(1,1,curpos) call outtext('ORDINATA INIZIALE FUORI RANGE, reinserirla ') read(*,*) ordini(zona) goto 1115 endif 1116 if ((ordinf(zona).gt.py).or.(ordinf(zona).lt.1)) then call puliscischermo call settextposition(1,1,curpos) call outtext('ORDINATA FINALE FUORI RANGE, reinserirla ') read(*,*) ordinf(zona) goto 1116 endif call puliscischermo if (ordinf(zona).lt.ordini(zona)) then b=ordinf(zona) ordinf(zona)=ordini(zona) ordini(zona)=b endif c Evidenziazione della zona 2222 call puliscischermo status=setcolor(0) STATUS=rectangle($gborder,2*ascisi(zona)+int((640-px*2)/2+0.5)-1 *,2*ordini(zona)+(480-py*2-1),2*ascisf(zona)+int((640-px*2)/2+0.5)- *1,2*ordinf(zona)+(480-py*2-1)) call settextposition(2,1,curpos) status=setcolor(14) call outtext('E'' l''area giusta (s/n) ? ') read(*,'(a1)')rispos if ((rispos.eq.'n').or.(rispos.eq.'N')) then call visual(datiim,c0,c1,c2,lmx,lmin,ascisi(zona),ascisf(zona) *,ordini(zona),ordinf(zona),px,py) call grigli(ascisi(zona),ascisf(zona),ordini(zona),ordinf(zona) *,px,py) call vsaree(ascisi,ascisf,ordini,ordinf,zona-1,px,py) goto 5 else if ((rispos.ne.'s').and.(rispos.ne.'S')) then goto 2222 else status=setcolor(15) status=rectangle($gborder,2*ascisi(zona)+int((640-px*2)/2 *+0.5)-1,2*ordini(zona)+480-py*2-1,2*ascisf(zona)+int((640-px*2)/2+ *0.5)-1,2*ordinf(zona)+480-py*2-1) endif c Calcolo del numero dei punti della zona n(zona)=(ordinf(zona)+1-ordini(zona))*(ascisf(zona)+1-ascisi(zon *a)) enddo if (ris.eq.2) go to 128 status=setvideomode($defaultmode) c elaborazione dati call puliscischermo CALL SETTEXTPOSITION(2,1,CURPOS) CALL OUTTEXT('Elaborando i dati...') CALL SETTEXTPOSITION(3,1,CURPOS) CALL OUTTEXT('mumble mumble...') imm=1 call elabor (nozone,ordini,ordinf,ascisi,ascisf,tbianc,tnero,datii *m,n,temmax,temmin,xmax,ymax,xmin,ymin,temmed,devtme,nmax,nmin,imm) c output call output (nozone,ascisi,ascisf,ordini,ordinf,temmed,devtme,temm *ax,xmax,ymax,temmin,xmin,ymin,nmax,nmin) c termine goto 9 c elaborazioni sequenze 128 status=setvideomode($defaultmode) call clearscreen($gclearscreen) write(*,*) write(*,*)'Elaborando i dati...' write(*,*)'mumble mumble...' do imm=1,99 c etichette trattate con il codice ASCII if (imm.le.9) then label='0'//char(imm+48) else if (imm.le.19) then label='1'//char(imm+38) else if (imm.le.29) then label='2'//char(imm+28) else if (imm.le.39) then label='3'//char(imm+18) else if (imm.le.49) then label='4'//char(imm+8) else if (imm.le.59) then label='5'//char(imm-2) else if (imm.le.69) then label='6'//char(imm-12) else if (imm.le.79) then label='7'//char(imm-22) else if (imm.le.89) then label='8'//char(imm-32) else label='9'//char(imm-42) endif c Lettura delle immagini nomesequenza='c:\lab98\termo\'//fole//label//'.raw' call prelev(nomesequenza,datiim,lmax,lmin,ris,px,py,*129) c Elaborazione delle sequenze call elabor(nozone,ordini,ordinf,ascisi,ascisf,tbianc,tnero,datiim *,n,temmax,temmin,xmax,ymax,xmin,ymin,temmed,devtme,nmax,nmin,imm) enddo if (imm.gt.99) imm=99 c Scrittura del file con i dati 129 open(1,file='c:\lab98\termo\'//fole//'.dat',status='new',err=130) 150 write(1,202) do i=1,imm-1 c conversione cifre-caratteri do j=1,nozone write(passaggio,'(f7.2)')temmed(j,i)+0.005 ctemmed(j)=passaggio(1:4)//','//passaggio(6:7) write(passaggio,'(f7.2)')devtme(j,i)+0.005 cdevtme(j)=passaggio(1:4)//','//passaggio(6:7) write(passaggio,'(f7.2)')temmax(j,i)+0.005 ctemmax(j)=passaggio(1:4)//','//passaggio(6:7) write(passaggio,'(f7.2)')temmin(j,i)+0.005 ctemmin(j)=passaggio(1:4)//','//passaggio(6:7) enddo c scrittura sul file .DAT write(1,201)i,(ctemmed(j),cdevtme(j),ctemmax(j),nmax(j,i),ctemm *in(j),nmin(j,i),j=1,nozone) enddo close (1) 202 format (2x,'IMMAG.',20(2x,'\\\\\\\\\\\\\\\',2x,' MEDIA ',2x,' DEV *. ',2x,'MASSIMA',2x,'PUNTI',2x,'MINIMA ',2x,'PUNTI')) 201 format (2x,i6,20(2x,'\\\\\\\\\\\\\\\',2x,a7,2x,a7,2x,a7,2x,i5,2x,a *7,2x,i5)) c chiede se rieseguire il programma 9 CALL CLEARSCREEN($GCLEARSCREEN) 70 write(*,*)'Altra analisi (s/n) ? ' rispos=' ' read(*,'(A1)')rispos if ((rispos.eq.'s').or.(rispos.eq.'S')) goto 1 if ((rispos.ne.'n').and.(rispos.ne.'N')) goto 9 stop c Nuovo file 130 close (1) print *,' ' print *,fole,'.dat Š gi… esistente.' print *,'Lo sovrascrivo (s/n) ? ' read(*,'(a1)')rispos if ((rispos.eq.'s').or.(rispos.eq.'S')) then open(1,file='c:\lab98\termo\'//fole//'.dat',status='old') goto 150 endif if ((rispos.ne.'n').and.(rispos.ne.'N').and.(rispos.ne.'s.').and.( *rispos.ne.'S')) goto 130 open(1,file='c:\lab98\temp\'//fole//'.dat',status='new',err=501) 505 write(*,*) write(*,*) write(*,*)'ATTENZIONE' write(*,*)'Il file si trova nel percorso c:\lab98\temp\.' write(*,*)'E'' consigliato trasferirlo in un''altra directory' write(*,*)'perchŠ qui sar… sovrascritto senza richiesta di' write(*,*)'conferma.' write(*,*) write(*,*)'Premi INVIO per continuare' read (*,*) goto 150 501 open(1,file='c:\lab98\temp\'//fole//'.dat',status='old') goto505 end c----------------------------------------------------------------------- c carica l'immagine subroutine prelev (nomefile,datiim,lmax,lmin,ris,px,py,*) character rispos*1,riga*256,nomefile*26 integer px,py,i,j,datiim(256,200),lmax,lmin,ris c apertura del file open (unit=1,file=nomefile,STATUS='OLD',err=100,access='direct',re *cl=px) c prelevamento della matrice dati do i=1,py read (1,rec=i) riga(1:px) do j=1,px c conversione da carattere ad ascii corrispondente datiim(j,i)=ichar(riga(j:j)) lmax=max(lmax,datiim(j,i)) lmin=min(lmin,datiim(j,i)) enddo enddo close (1) return c in caso di errore 100 call clearscreen ($gclearscreen) close (1) if (ris.eq.2) then return 1 endif write(*,*)'File inesistente o inaccessibile.' write(*,*)'Controllare che il file esista e sia nel percorso giust *o.' write(*,*) write(*,*)'Vuoi riprovare (s/n) ?' rispos=' ' read(*,'(a1)')rispos if ((rispos.eq.'n').or.(rispos.eq.'N')) goto 101 if ((rispos.ne.'s').and.(rispos.ne.'S')) goto 100 return 1 101 stop end c----------------------------------------------------------------------- c subroutine elaborazione output subroutine elabor (nozone,ordini,ordinf,ascisi,ascisf,tbianc,tnero *,datiim,n,temmax,temmin,xmax,ymax,xmin,ymin,temmed,devtme,nmax,nmi *n,imm) parameter (zm=20) parameter (noimm=50) integer zona,i,j,nozone,colmax(zm),colmin(zm) integer ordini(zm),ordinf(zm),ascisi(zm),ascisf(zm) integer n(zm),nmax(zm,noimm),nmin(zm,noimm) integer datiim(256,200),imm integer xmax(zm,noimm),ymax(zm,noimm) integer xmin(zm,noimm),ymin(zm,noimm) real temmed(zm,noimm),tbianc,tnero,kappa(zm) real devtme(zm,noimm),coltot(zm) real temmax(zm,noimm),temmin(zm,noimm),tempim(256,200) c ciclo su tutte le zone do zona=1,nozone c inizializzazione coltot(zona)=0 colmax(zona)=0 colmin(zona)=255 nmax(zona,imm)=0 nmin(zona,imm)=0 c totalizzatore, massimi e minimi do i=ordini(zona),ordinf(zona) do j=ascisi(zona),ascisf(zona) tempim(j,i)=(tbianc-tnero)/256*datiim(j,i)+tnero coltot(zona)=coltot(zona)+tempim(j,i) if (datiim(j,i).eq.colmax(zona)) nmax(zona,imm)=nmax(zona,im *m)+1 if (datiim(j,i).gt.colmax(zona)) then colmax(zona)=datiim(j,i) xmax(zona,imm)=j ymax(zona,imm)=i nmax(zona,imm)=1 endif if (datiim(j,i).eq.colmin(zona)) nmin(zona,imm)=nmin(zona,im *m)+1 if (datiim(j,i).lt.colmin(zona)) then colmin(zona)=datiim(j,i) xmin(zona,imm)=j ymin(zona,imm)=i nmin(zona,imm)=1 endif enddo enddo c calcolo valor medio temmed(zona,imm)=coltot(zona)/n(zona) c calcolo dev.stand. e dev.stand. della media kappa(zona)=0 do i=ordini(zona),ordinf(zona) do j=ascisi(zona),ascisf(zona) kappa(zona)=kappa(zona)+(tempim(j,i)-temmed(zona,imm))**2 enddo enddo devtme(zona,imm)=sqrt(kappa(zona)/n(zona))/sqrt(n(zona)) temmax(zona,imm)=(tbianc-tnero)/256*colmax(zona)+tnero temmin(zona,imm)=(tbianc-tnero)/256*colmin(zona)+tnero enddo end c----------------------------------------------------------------------- c subroutine visualizzazione output singola immagine subroutine output (nozone,ascisi,ascisf,ordini,ordinf,temmed,devtm *e,temmax,xmax,ymax,temmin,xmin,ymin,nmax,nmin) parameter (zm=20) integer zona,nozone,ascisi(zm),ascisf(zm),ordini(zm),ordinf(zm) integer xmax(zm,1),ymax(zm,1),xmin(zm,1),ymin(zm,1) integer nmax(zm,1),nmin(zm,1) real temmed(zm,1),devtme(zm,1),temmax(zm,1),temmin(zm,1) do zona=1,nozone call clearscreen ($GCLEARSCREEN) write(*,60)zona write(*,50)ascisi(zona),ascisf(zona),ordini(zona),ordinf(zona) write(*,*) write(*,10)temmed(zona,1) write(*,*) write(*,20)devtme(zona,1) write(*,*) write(*,30)temmax(zona,1) write(*,80)xmax(zona,1),ymax(zona,1) if (nmax(zona,1)-1.eq.0) write(*,*)'ed in nussun altro punto.' if (nmax(zona,1)-1.eq.1) then write(*,*)'ed in un solo altro punto.' else if ((nmax(zona,1).ne.0).and.(nmax(zona,1).ne.1)) write(*,*)'ed * in altri ',(nmax(zona,1)-1),' punti.' endif write(*,*) write(*,40)temmin(zona,1) write(*,70)xmin(zona,1),ymin(zona,1) if (nmin(zona,1)-1.eq.0) write(*,*)'ed in nussun altro punto.' if (nmin(zona,1)-1.eq.1) then write(*,*)'ed in un solo altro punto.' else if ((nmin(zona,1).ne.0).and.(nmin(zona,1).ne.1)) write(*,*)'ed i *n altri ',(nmin(zona,1)-1),' punti.' endif write(*,*) if (zona.ne.nozone) then write(*,*)'Premi INVIO per passare alla zona successiva' read(*,*) endif enddo write(*,*)'Premi INVIO per andare avanti' read(*,*) return 10 format (' La temperatura media e'' ',f7.2,' gradi') 20 format (' La deviazione standard della media e'' ',f7.2,' gradi') 30 format (' La temperatura massima e'' ',f7.2,' gradi') 40 format (' La temperatura minima e'' ',f7.2,' gradi') 50 format (' coordinate X(',i3,',',i3,'),Y(',i3,',',i3,')') 60 format (' Zona ',i2) 70 format (' ed e'' stata misurata nel punto di coordinate (',i3,',', *i3,')') 80 format (' ed e'' stata misurata nel punto di coordinate (',i3,',', *i3,')') end c----------------------------------------------------------------------- c visualizza l'immagine subroutine visual (datiim,c0,c1,c2,lmax,lmin,px,pxx,py,pyy,x,y) INCLUDE 'FGRAPH.FD' real k integer*2 status integer i,j,c0,c1,c2,lmax,lmin,l,px,py,pxx,pyy,x,y integer datiim(256,200) integer*4 ncolor lmax=0 lmin=256 l=0 do i=py,pyy do j=px,pxx k=(datiim(j,i)-lmin)/float(lmax-lmin) l=(c2*k*k+c1*k+c0)/c0 ncolor=17-l status=setcolor(ncolor) status=setpixel(2*j+(int((640-x*2)/2+0.5)-1),2*i+(480-y*2-1)) status=setpixel(2*j+(int((640-x*2)/2+0.5)),2*i+(480-y*2)) status=setpixel(2*j+(int((640-x*2)/2+0.5)),2*i+(480-y*2-1)) status=setpixel(2*j+(int((640-x*2)/2+0.5)-1),2*i+(480-y*2)) enddo enddo return END c----------------------------------------------------------------------- c visualizza la griglia subroutine grigli(px,pxx,py,pyy,x,y) INCLUDE 'FGRAPH.FD' integer*2 status INTEGER I,J,pxx,pyy,px,py,x,y DO I=py,pyy DO J=px,pxx IF ((I/50.EQ.I/50.).OR.(J/50.EQ.J/50.)) THEN STATUS=SETCOLOR(0) STATUS=SETPIXEL(2*J+int((640-x*2)/2+0.5)-1,2*I+(480-y*2-1)) ELSE IF ((I/10.EQ.I/10.).OR.(J/10.EQ.J/10.)) THEN STATUS=SETCOLOR(15) STATUS=SETPIXEL(2*J+int((640-x*2)/2+0.5)-1,2*I+(480-y*2- *1)) ENDIF ENDDO ENDDO return END c----------------------------------------------------------------------- c visualizza aree selezionate subroutine vsaree (ascisi,ascisf,ordini,ordinf,nozone,px,py) INCLUDE 'FGRAPH.FD' parameter (zm=20) integer zona,nozone,ascisi(zm),ascisf(zm),ordini(zm),ordinf(zm) integer px,py integer*4 ncolor integer*2 status ncolor=15 status=setcolor(ncolor) do zona=1,nozone STATUS=rectangle($gborder,2*ascisi(zona)+int((640-px*2)/2+0.5)-1 *,2*ordini(zona)+(480-py*2-1),2*ascisf(zona)+int((640-px*2)/2+0.5)- *1,2*ordinf(zona)+(480-py*2-1)) enddo return end c----------------------------------------------------------------------- C PULITURA DELLO SCHERMO SUBROUTINE PULISCISCHERMO INCLUDE 'FGRAPH.FD' RECORD/RCCOORD/CURPOS INTEGER I DO I=1,4 CALL SETTEXTPOSITION(I,1,CURPOS) CALL OUTTEXT(' * *') ENDDO do i=5,20 call settextposition(i,1,curpos) call outtext(' ') enddo END c----------------------------------------------------------------------- c input sequenza subroutine sequenza(fole,datiim,lmax,lmin,px,py,*) include 'fgraph.fd' character fole*5,nomesequenza*26 integer lmax,lmin,px,py,datiim(256,200),ris 1 call clearscreen($gclearscreen) write(*,*) write(*,*) write(*,*)'La sequenza deve essere composta da file in formato .RA *W, con nome' write(*,*)'composto da 5 lettere pi— due cifre che ne danno l''ord *ine. Deve' write(*,*)'essere, inoltre, nel percorso c:\lab98\termo\.' write(*,*) write(*,*)'Introdurre il nome dei file (5 lettere)' read(*,'(a5)')fole if (fole.eq.'muoni') then call clearscreen ($gclearscreen) write(*,*) write(*,*) write(*,*)'Questo programma Š stato scritto da' write(*,*)'Maurizio Antonelli' write(*,*)'Nø di matricola 537810' write(*,*)' * 1999' write(*,*) write(*,*) return 1 endif nomesequenza='c:\lab98\termo\'//fole//'01.raw' c dimensionamento immagini della sequenza call dimensionamento(px,py) call prelev(nomesequenza,datiim,lmax,lmin,ris,px,py,*1) return end c----------------------------------------------------------------------- c subroutine dimensioni delle immagini subroutine dimensionamento(px,py) integer px,py,a,b,c,d,e,f character formato*7 1000 call clearscreen($gclearscreen) write(*,*) write(*,*)'Inserisci il formato dell''immagine (max = 256x200 , mi *n = 100x100) ' write(*,*)'Premi solo INVIO per scegliere il formato massimo. ' write(*,*) read(*,'(a7)')formato if (formato.eq.' ') then px=256 py=200 goto 1001 endif a=ichar(formato(1:1))-48 b=ichar(formato(2:2))-48 c=ichar(formato(3:3))-48 d=ichar(formato(5:5))-48 e=ichar(formato(6:6))-48 f=ichar(formato(7:7))-48 if (a.lt.0) goto 1000 if (a.gt.9) goto 1000 if (b.lt.0) goto 1000 if (b.gt.9) goto 1000 if (c.lt.0) goto 1000 if (c.gt.9) goto 1000 if ((formato(4:4).ne.'x').and.(formato(4:4).ne.'X')) goto 1000 if (d.lt.0) goto 1000 if (d.gt.9) goto 1000 if (e.lt.0) goto 1000 if (e.gt.9) goto 1000 if (f.lt.0) goto 1000 if (f.gt.9) goto 1000 px=a*100+b*10+c py=d*100+e*10+f if((px.lt.100).or.(px.gt.256).or.(py.lt.100).or.(py.gt.200)) goto *1000 1001 return end