c c secondo programma c gli inputs sono prodotti da cre_tstx c Crea i questionari nel file *_que.tex che produce i questionari. c c PROGRAM Mak_Tst PARAMETER (Max_Fil=64,Max_Rec=1000,Max_Ask=50) DIMENSION Ind_Vec(Max_Rec,Max_Fil),Num_Rec(Max_Fil) DIMENSION Ind_Ask(Max_Ask,Max_Fil) CHARACTER*2 Ans_Vec(Max_Rec,Max_Fil) CHARACTER*40 Fil_Dbf(Max_Fil),Fil_Ndx(Max_Fil) CHARACTER*40 Fil_Chk,Fil_Que CHARACTER*1 BSL CHARACTER Tst_Lin*80,Ans*2,String*80,Str_Ris*100,Str_Dom*100 INTEGER*2 i_hr,i_mi,i_se,i_th C BSL=CHAR(92) 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 WRITE (Fil_Dbf(i),'(A)') String(:JLEN(String))//'.dbf' WRITE (Fil_Ndx(i),'(A)') String(:JLEN(String))//'.ndx' ENDDO C numero di questionari READ(20,'(A)') String READ(20,*) n_Que C numero di domande READ(20,'(A)') String READ(20,*) n_Ask n_Ask=n_Ask*Num_Fil C nomi dei File dei Questionari e delle Domande READ(20,'(A)') String READ(20,'(A)') String WRITE (Fil_Que,'(A)') String(:JLEN(String))//'_que.tex' WRITE (Fil_Chk,'(A)') String(:JLEN(String))//'.chk' CLOSE(20) C Leggi i File indice e apri i File dati DO i_Fil=1,Num_Fil i_Dat=30+i_Fil OPEN(UNIT=20,FILE=Fil_Ndx(i_Fil),STATUS='OLD') READ(20,'(I5)') Num_Rec(i_Fil) DO i_Rec=1,Num_Rec(i_Fil) READ(20,'(I5,A2)') Ind_Vec(i_Rec,i_Fil),Ans_Vec(i_Rec,i_Fil) ENDDO CLOSE(20) C OPEN(UNIT=i_Dat,FILE=Fil_Dbf(i_Fil),ACCESS='DIRECT',RECL=80, * FORM='FORMATTED',STATUS='OLD') ENDDO C Apertura del File dei risultati OPEN(UNIT=8,FILE=Fil_Chk,STATUS='OLD',ERR=200) CLOSE(8,STATUS='DELETE') 200 OPEN(UNIT=8,FILE=Fil_Chk,STATUS='NEW',ERR=10) C Apertura del File di output OPEN(UNIT=10,FILE=Fil_Que,STATUS='OLD',ERR=10) CLOSE(10,STATUS='DELETE') 10 OPEN(UNIT=10,FILE=Fil_Que,STATUS='NEW',ERR=10) C icount=0 WRITE (10,'(A)') bsl//'documentstyle[a4]{article}' WRITE (10,'(A)') bsl//'topmargin-30pt' WRITE (10,'(A)') bsl//'textheight 23.0cm ' WRITE (10,'(A)') bsl//'textwidth 13.5cm' WRITE (10,'(A)') bsl//'evensidemargin -7.6mm' WRITE (10,'(A)') bsl//'oddsidemargin 2.6mm' WRITE (10,'(A)') bsl//'parindent=0cm' WRITE (10,'(A)') bsl//'begin{document}' DO i_Que=1,n_Que icount=icount+1 iseed=secnds(0.)*100*icount WRITE (10,'(A)') bsl//'input{intes.tst}' WRITE (10,'(A)') bsl//'begin{center}' WRITE (10,'(a,i5,a)') '{'//bsl//'bf Questionario ',i_Que,'}' WRITE (10,'(A)') bsl//'end{center}' WRITE (10,*) WRITE (10,'(A)') bsl//'medskip' CALL Sel_Ask(iseed,Ind_Ask,Num_Rec,n_Ask,Num_Fil) Num_Mar=1 j_Ask=n_Ask/Num_Fil jj=0 DO i_Ask=1,j_Ask DO i_Fil=1,Num_Fil i_Dat=30+i_Fil k_Ask=Ind_Ask(i_Ask,i_Fil) Ans=Ans_Vec(k_Ask,i_Fil) WRITE (*,*) 'DOMANDA ',k_Ask,' RISPOSTA ',ANS kk=jj+jj+1 WRITE (Str_Dom(kk:kk+1),'(Z2)') k_Ask WRITE (Str_Ris(kk:kk+1),'(A)') ANS jj=jj+1 WRITE (10,'(A,i5,A)') bsl//'hspace{-1.cm}' * //bsl//'makebox[.6cm][r]' * //'{'//bsl//'bf ',Num_Mar,')} '//bsl//'hspace{.4cm}' WRITE (10,'(A)') bsl//'marginpar{' * //bsl//'vspace{.01 mm}{'//bsl//'Huge $'//bsl//'Box$}}' Num_Mar=Num_Mar+1 i_end=Ind_Vec(k_Ask,i_Fil)-1 i_str=1 IF(k_Ask.GT.1) i_str=Ind_Vec(k_Ask-1,i_Fil) DO j=i_str,i_end READ(i_Dat,'(A)',REC=j) Tst_Lin WRITE (10,*) Tst_lin(:JLEN(Tst_Lin)) ENDDO WRITE (10,'(A)') bsl//'medskip' ENDDO ENDDO WRITE (8,'(A)') Str_Dom(:JLEN(Str_Dom)) WRITE (8,'(A)') Str_Ris(:JLEN(Str_Ris)) WRITE (10,*) WRITE (10,*) bsl//'newpage' WRITE (10,*) bsl//'setcounter{page}{1}' ENDDO WRITE (10,*) bsl//'end{document}' CLOSE(10) CLOSE(8) DO i_Fil=1,Num_Fil i_Dat=10+i_Fil CLOSE(i_Dat) ENDDO STOP END C SUBROUTINE Sel_Ask(iseed,Ind_Ask,Num_Rec,n_Ask,Num_Fil) PARAMETER (Max_Fil=64,Max_Rec=1000,Max_Ask=50) DIMENSION Num_Rec(Max_Fil) DIMENSION Ind_Ask(Max_Ask,Max_Fil) k_Ask=n_Ask/Num_Fil iseed=-abs(iseed) write(*,*) iseed DO i_Fil=1,Num_Fil DO i_Ask=1,k_Ask n_Fnd=0 DO WHILE (n_Fnd.EQ.0) xx=RANDY(iseed) i_Try=INT(Num_Rec(i_Fil)*xx)+1 n_Fnd=1 IF (i_Ask.GT.1) THEN DO i=1,i_Ask-1 IF (Ind_Ask(i,i_Fil).EQ.i_Try) n_Fnd=0 ENDDO ENDIF ENDDO Ind_Ask(i_Ask,i_Fil)=i_Try ENDDO ENDDO 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 C----------------------------------------------------------------------------- C FUNCTION RANDY(IDUM) C C PRODUCE NUMERI CASUALI C IDUM < 0 C----------------------------------------------------------------------------- FUNCTION RANDY(IDUM) PARAMETER (MBIG=1000000000,MSEED=161803398,MZ=0,FAC=1./MBIG) DIMENSION MA(55) SAVE IFF,INEXT,INEXTP,MA DATA IFF /0/ IF(IDUM.LT.0.OR.IFF.EQ.0)THEN IFF=1 MJ=MSEED-IABS(IDUM) MJ=MOD(MJ,MBIG) MA(55)=MJ MK=1 DO I=1,54 II=MOD(21*I,55) MA(II)=MK MK=MJ-MK IF(MK.LT.MZ)MK=MK+MBIG MJ=MA(II) ENDDO DO K=1,4 DO I=1,55 MA(I)=MA(I)-MA(1+MOD(I+30,55)) IF(MA(I).LT.MZ)MA(I)=MA(I)+MBIG ENDDO ENDDO INEXT=0 INEXTP=31 IDUM=1 ENDIF INEXT=INEXT+1 IF(INEXT.EQ.56)INEXT=1 INEXTP=INEXTP+1 IF(INEXTP.EQ.56)INEXTP=1 MJ=MA(INEXT)-MA(INEXTP) IF(MJ.LT.MZ)MJ=MJ+MBIG MA(INEXT)=MJ RANDY=MJ*FAC RETURN END