c c terzo programma c input i files prodotti da cre_tstx e un file con estensione c .RIS con lo stesso nome del file di output *.tex fatto da cre_tstx c in cui sono contenuti i nomi degli studenti e le loro risposte. c c output *.OUT c C FILE DI CORREZIONE C C PROGRAM Cor_Tst PARAMETER (Max_Len=100,Max_Que=500,Max_Ris=Max_Len/2) PARAMETER (Max_Dom=255,Max_Fil=64) CHARACTER*100 Ans_Chk(Max_Que) CHARACTER*100 Dom_Chk(Max_Que) C C 30 x Stud + 10 x Matr + 3 x i_Que + 4 x Scuola + 3 x Voto Maturita' C + 50 x Lin_Ris = 100 Caratteri C CHARACTER*93 Ind_Ris(Max_Que) CHARACTER*100 String CHARACTER*100 Lin_Dom, Lin_Chk, Lin_Giu, Lin_Sta CHARACTER*50 Lin_Ris CHARACTER Ans*2,Str_Ris*100,Sep*10 CHARACTER*40 Fil_Chk,Fil_Ris,Fil_Out CHARACTER Stud*30,Matr*10,Scuola*4 COMMON /Sta_COM/ kSta_Dom(Max_Dom,Max_Fil,2),Num_Fil,k_Sta ^ ,kFil_Dom(Max_Fil) C C Leggi il File di Input C OPEN(UNIT=20,FILE='test.inp',STATUS='OLD') READ(20,'(A)') String READ(20,*) Num_Fil READ(20,'(A)') String DO i=1,Num_Fil READ(20,'(A)') String ENDDO C numero di questionari READ(20,'(A)') String READ(20,*) Num_Que C numero di domande READ(20,'(A)') String READ(20,*) Num_Ask Num_Ask=Num_Ask*Num_Fil C nomi dei File di Controllo e delle Risposte READ(20,'(A)') String READ(20,'(A)') String WRITE (Fil_Chk,'(A)') String(:JLEN(String))//'.chk' WRITE (Fil_Ris,'(A)') String(:JLEN(String))//'.ris' WRITE (Fil_Out,'(A)') String(:JLEN(String))//'.out' CLOSE(20) C Leggi il File di Controllo OPEN(UNIT=20,FILE=Fil_Chk,STATUS='OLD') k_Sta=1 DO i_Que=1,Num_Que READ(20,'(A)') Dom_Chk(i_Que) READ(20,'(A)') Ans_Chk(i_Que) ENDDO CLOSE(20) C Controlla il File dei Risultati iErr=0 OPEN(UNIT=20,FILE=Fil_Ris,STATUS='OLD') READ(20,*) Num_Cor i_Lin=1 IF (Num_Cor.GT.Num_Que) THEN WRITE (*,*) '**Err. Linea ',i_Lin, * ': Num. Quest. > Num. Quest. Generati' iErr=1 ENDIF C i_Lin=i_Lin+1 DO i_Cor=1,Num_Cor C Controllo Separatore READ(20,'(A)') Sep IF (INDEX(Sep,'%').NE.1) THEN WRITE (*,*) '**Err. Linea ',i_Lin, * ': Separatore Errato' iErr=1 ENDIF i_Lin=i_Lin+1 C Controllo Indice Questionario READ(20,*) Ind_Que IF (Ind_Que.GT.Num_Que) THEN WRITE (*,*) '**Err. Linea ',i_Lin, * ': Ind. Quest. > Num. Quest. Generati' Ind_Que=1 iErr=1 ENDIF i_Lin=i_Lin+1 C Lettura Cognome e Nome e Matricola READ(20,'(A)') Stud READ(20,'(A)') Matr i_Lin=i_Lin+2 C Lettura Scuola READ(20,'(A)') Scuola i_Lin=i_Lin+1 C Lettura voto Maturita' READ(20,*) ivoto_mat i_Lin=i_Lin+1 C Lettura Stringa dei Risultati READ(20,'(A)') Lin_Ris C write(*,*) i_cor,Lin_ris Lin_Chk=Ans_Chk(Ind_Que) Lin_Dom=Dom_Chk(Ind_Que) kErr=0 CALL Val_Ris(Lin_Chk,Lin_Dom,Lin_Ris,Num_Ask,Score,Score1, ^ Iscore,kErr,i_Lin) IF (kErr.NE.0) iErr=kErr i_Lin=i_Lin+1 ENDDO CLOSE(20) k_Sta=0 C Fine Controllo File dei Risultati c IF (iErr.EQ.1) STOP C Leggi il File dei Risultati e genera il vettore da ordinare iErr=0 OPEN(UNIT=20,FILE=Fil_Ris,STATUS='OLD') READ(20,*) Num_Cor DO i_Cor=1,Num_Cor C Leggi il Separatore READ(20,'(A)') Sep C Leggi l'indice del Questionario READ(20,*) Ind_Que WRITE(String(41:43),'(I3)') Ind_Que C Leggi Cognome e Nome e Matricola READ(20,'(A)') Stud WRITE(String(1:30),'(A)') Stud(:30) READ(20,'(A)') Matr WRITE(String(31:40),'(A)') Matr(:10) C Leggi Scuola e Voto maturita' READ(20,'(A)') Scuola WRITE(String(44:47),'(A)') Scuola(:4) READ(20,*) ivoto_mat WRITE(String(48:50),'(I3)') ivoto_mat C Leggi la Stringa dei Risultati READ(20,'(A)') Lin_Ris WRITE(String(51:),'(A)') Lin_Ris(:Max_Ris) Ind_Ris(i_Cor)=String ENDDO CLOSE(20) C OPEN(UNIT=30,FILE=Fil_Out,STATUS='UNKNOWN') CLOSE(30,STATUS='DELETE') OPEN(UNIT=30,FILE=Fil_Out,STATUS='NEW') C write(30,*) num_cor,' numero questionari corretti' CALL SORT(Num_Cor,Ind_Ris) DO i_Cor=1,Num_Cor String=Ind_Ris(i_Cor) c write(*,*) i_cor,string READ(String(41:43),'(I3)') Ind_Que READ(String(51:),'(A)') Lin_Ris(:Max_Ris) Lin_Chk=Ans_Chk(Ind_Que) Lin_Dom=Dom_Chk(Ind_Que) CALL Val_Ris(Lin_Chk,Lin_Dom,Lin_Ris,Num_Ask,Score,Score1 ^ ,Iscore,kErr,i_Lin) C c write(30,'(1X,A,1X,I4)') c ^ string(:40),Iscore c write(30,'(1X,A,1X,A,1X,F7.3,1X,I4,1X,f7.3)') ^ string(:40),string(44:50),SCORE,Iscore,Score1 C CALL Lin_Exa(Lin_Chk,Lin_Giu,Num_Ask) C write(*,*) Num_ask write(30,1000) Lin_Ris(:num_ask) write(30,1001) Lin_Giu(:num_ask) C CALL Sta_Lin(Lin_Dom,Lin_Sta,Num_Ask) C write(30,1002) Lin_Sta(:num_ask) C C IF (MOD(i_Cor,20).EQ.0) READ(*,*) ENDDO c write (30,*) '---------------' write (30,*) 'Statistiche' do j=1,Num_Fil write (30,*) 'File ',j write (30,*) 'Domanda Totale risposte Risposte esatte' DO i=1,kFil_Dom(j) write (30,1003) i,kSta_Dom(i,j,2), kSta_Dom(i,j,1) enddo enddo C STOP 1000 FORMAT (1X,'risposte date ',24X,A) 1001 FORMAT (1X,'risposte corrette',24X,A) 1002 FORMAT (1X,'statistica ',24X,A) 1003 FORMAT (1x,i4,12x,i4,13x,i4) END C------------------------------------------------------------------------ SUBROUTINE Lin_Exa(Lin_Chk,Lin_Giu,Num_Ask) CHARACTER*(*) Lin_Chk,Lin_Giu DO i=1,Num_Ask j1=i+i j=j1-1 WRITE(Lin_Giu(i:i),'(A)') Lin_Chk(j:j) ENDDO RETURN END SUBROUTINE Sta_Lin(Lin_Dom,Lin_Sta,Num_Ask) PARAMETER (Max_Dom=255,Max_Fil=64) CHARACTER*(*) Lin_Dom,Lin_Sta CHARACTER*1 Dom COMMON /Sta_COM/ kSta_Dom(Max_Dom,Max_Fil,2),Num_Fil,k_Sta ^ ,kFil_Dom(Max_Fil) c DO i=1,Num_Ask j1=i+i j=j1-1 READ(Lin_Dom(j:j1),'(Z2)') iDom i_Fil=MOD(i-1,Num_Fil)+1 nTot=kSta_Dom(iDom,i_Fil,2) nGiu=kSta_Dom(iDom,i_Fil,1) if(iDom.gt.kFil_Dom(i_Fil)) kFil_Dom(i_Fil)=iDom c x=FLOAT(nGiu*10)/nTot ix=INT(x) IF(ix.EQ.10) THEN WRITE(Lin_Sta(i:i),'(A)') 'T' ELSE WRITE(Lin_Sta(i:i),'(I1)') ix ENDIF ENDDO RETURN END SUBROUTINE * Val_Ris(Lin_Chk,Lin_Dom,Lin_Ris,Num_Ask,Score,Score1,Iscore, * kErr,i_Lin) C Correggi il questionario C la SOUBROUTINE e` chiamata 2 volte C La prima volta con k_Sta=1, per controllare la correttezza sintattica C del file contenete i risultati e per caricare la matrice kSta_Dom C con la statistica delle domande e delle risposte C La seconda volta con k_Sta=0, per attribuire il punteggio. Il C contenuto di kSta_Dom puo` essere utilizzato per l'attribuzione del C punteggio PARAMETER (Max_Dom=255,Max_Fil=64) CHARACTER*(*) Lin_Chk,Lin_Dom,Lin_Ris CHARACTER*1 X_Chk,X_Max,X_Ris,UCASE COMMON /Sta_COM/ kSta_Dom(Max_Dom,Max_Fil,2),Num_Fil,k_Sta ^ ,kFil_Dom(Max_Fil) C Controllo Lunghezza Lin_Ris IF (JLEN(Lin_Ris).NE.Num_Ask) THEN WRITE (*,*) '**Err. Linea ',i_Lin, * ': Numero Risposte Errato' kErr=1 ENDIF Score=0. Iscore=0 SCORE1=0. DO i=1,Num_Ask j1=i+i j=j1-1 READ(Lin_Dom(j:j1),'(Z2)') i_Dom i_Fil=MOD(i-1,Num_Fil)+1 IF (k_Sta.EQ.1) kSta_Dom(i_Dom,i_Fil,2)= * kSta_Dom(i_Dom,i_Fil,2)+1 c write (*,*) 'domanda ',i_dom, ' File ', i_Fil c read (*,*) X_Ris=UCASE(Lin_Ris(i:i)) X_Chk=UCASE(Lin_Chk(j:j)) X_Max=UCASE(Lin_Chk(j1:j1)) i_Ris=ICHAR(X_Ris) i_Chk=ICHAR(X_Chk) i_Max=ICHAR(X_Max) C Se non e` X IF (i_Ris.NE.88) THEN IF (i_Ris.LT.65 .OR. i_Ris.GT.i_Max) THEN WRITE (*,*) '**Err. Linea ',i_Lin, * ': Risposta ',i,' Fuori Intervallo' kErr=1 ELSE Add=-1./(i_Max-65) PG=kSta_Dom(i_Dom,i_Fil,1)/kSta_Dom(i_Dom,i_Fil,2) Add_ave=PG+Add*(1.0-PG) Iadd=0 IF (i_Ris.EQ.i_Chk) THEN Add=1. Iadd=1 IF (k_Sta.EQ.1) kSta_Dom(i_Dom,i_Fil,1)= * kSta_Dom(i_Dom,i_Fil,1)+1 ENDIF Score=Score+Add Iscore=Iscore+Iadd Add1=Add-Add_ave Score1=Score1+Add1 ENDIF ENDIF ENDDO RETURN END C FUNCTION UCASE(X) CHARACTER*1 UCASE,X i=ICHAR(X) IF (i.GT.96 .AND. i.LT. 123) i=i-32 UCASE=CHAR(i) RETURN END C----------------------------------------------------------------------------- C FUNCTION JLEN C C CALCOLO DELLA LUNGHEZZA DI UNA VARIABILE ALFANUMERICA C Line VARIABILE ALFANUMERICA C JLEN NUMERO DEI CARATTERI C----------------------------------------------------------------------------- FUNCTION JLEN(Line) CHARACTER *(*) Line DO 15 L=LEN(Line),0,-1 LL=L IF (Line(L:L).GT.' ') GOTO 20 15 CONTINUE 20 JLEN=LL RETURN END SUBROUTINE SORT(N,RA) CHARACTER*93 RA(N) CHARACTER*93 RRA L=N/2+1 IR=N 10 CONTINUE IF(L.GT.1)THEN L=L-1 RRA=RA(L) ELSE RRA=RA(IR) RA(IR)=RA(1) IR=IR-1 IF(IR.EQ.1)THEN RA(1)=RRA RETURN ENDIF ENDIF I=L J=L+L 20 IF(J.LE.IR)THEN IF(J.LT.IR) THEN IF(RA(J).LT.RA(J+1)) J=J+1 ENDIF C IF(RRA.LT.RA(J))THEN RA(I)=RA(J) I=J J=J+J ELSE J=IR+1 ENDIF GO TO 20 ENDIF RA(I)=RRA GO TO 10 END