! ! Machine-dependent routines for: ! cpu-time measurement ! random number generation ! miscellaneous ! ! 1) cpu-time measurement ! ======================= ! !------------------------------------------------------------------------- subroutine tictac(i,j) !------------------------------------------------------------------------- ! TIME COUNTING SUBROUTINE ! I TIME OF SPECIFIC PART INDEXED BY I ! J IF J=0 START, IF J=1 STOP AND AVERAGE ! ! CRAY, NEC, IBM-RISC, DEC-ALPHA, SGI (32-bit), ORIGIN, T3E machines. ! use timex_mod implicit none integer i, j real(kind=8) time1(maxclock),time2(maxclock), tcpu, telaps integer k logical first save first, time1, time2 data first/.true./ ! ! The machine dependent declaration of the timing function ! #ifdef CRAYY real*8 & & second ! system function, returns the CPU time in sec. #endif #ifdef ORIGIN real*4 & & etime, &! system function, returns the CPU time in sec. & tarry(2) ! user and system times (not used) real*8 & & timef ! system function, returns elapsed time in msec. #endif #ifdef ABSOFT real*4 & & etime_, &! system function, returns the CPU time in sec. & tarry(2) ! user and system times (not used) integer time_ ! system function, returns elapsed time in sec. ! (an integer number: grossly inaccurate) #endif #ifdef AIX integer & & mclock ! system function, returns the time in sec./100. real*8 & & timef ! system function, returns elapsed time in msec. #endif #ifdef T3E real*8 & & tsecnd, &! system function, returns the CPU time in sec. & timef ! system function, returns elapsed time in msec. #endif #ifdef OSF1 real*4 & & etime, &! system function, returns the CPU time in sec. & tarry(2) ! user and system times (not used) real*4 & & time ! system function, returns elapsed time in msec. #endif if (i.lt.1.or.i.gt.maxclock) & & call error('tictac','wrong nombero of clocks',i) if (j.ne.0.and.j.ne.1) call error('tictac','wrong call',j) ! ! initialization ! if (first) then do k=1,maxclock cputime(k)=0.0 elapsed(k)=0.0 ntimes(k)=0 end do first=.false. end if ! ! Here we call the appropriate routine in each machine ! #ifdef CRAYY tcpu = second() telaps=0.0 #endif #ifdef ORIGIN tcpu = etime ( tarry ) telaps= timef ( )/1000. #endif #ifdef ABSOFT ! ! according to the manual, should be etime, not etime_ ... ! tcpu = etime_( tarry ) telaps= time_( ) #endif #ifdef NEC call clock(tcpu) telaps=0.0 #endif #ifdef AIX tcpu = mclock() / 100.d0 telaps=timef()/1000. #endif #ifdef T3E tcpu = tsecnd() telaps=timef()/1000. #endif #ifdef OSF1 tcpu = etime ( tarry ) telaps= time ( )/1000. #endif if (j.eq.0) then time1(i)=tcpu time2(i)=telaps else if (j.eq.1) then cputime(i)=cputime(i) + ( tcpu-time1(i)) elapsed(i)=elapsed(i) + (telaps-time2(i)) ntimes(i) =ntimes(i)+1 endif return end ! ! 2) random number generation ! =========================== ! !------------------------------------------------------------------------- real(kind=8) function randy() !------------------------------------------------------------------------- ! #ifdef CRAYY randy = ranf() #endif #if defined(NEC) || defined(OSF1) randy=random(0) #endif #ifdef AIX randy=rand() #endif #if defined(ABSOFT) || defined(T3E) || defined(ORIGIN) integer m, ia, ic, ntab real(kind=8) rm parameter (ntab=97,m=714025,ia=1366,ic=150889,rm=1.0/m) integer ir(ntab), iff, idum, j, iy data iff /0/, idum/0/ save iff, idum, iy, ir ! ! if(idum.lt.0.or.iff.eq.0) then iff=1 idum=mod(ic-idum,m) do j=1,ntab idum=mod(ia*idum+ic,m) ir(j)=idum end do idum=mod(ia*idum+ic,m) iy=idum endif j=1+(ntab*iy)/m if(j.gt.ntab.or.j.lt.1) call error('randy','j out of range',j) iy=ir(j) randy=iy*rm idum=mod(ia*idum+ic,m) ir(j)=idum #endif return end ! ! 3) miscellaneous ! ================ ! integer function good_fft_dimension(n) ! ! Determines the optimal maximum dimensions of fft arrays ! Useful on some machines to avoid memory conflicts ! integer n, nx ! ! this is the default: max dimension = fft dimension nx=n #if defined(ESSL) || defined(DXML) if ( n.eq. 8 .or. n.eq.16 .or. n.eq.32 .or. & & n.eq.64 .or. n.eq.128 .or. n.eq.256 ) nx=n+1 #endif #if defined(CRAYY) || defined(NEC) if ( mod(n,2).eq.0) nx=n+1 #endif good_fft_dimension=nx return end ! !----------------------------------------------------------------------- integer function good_fft_order(nr) !----------------------------------------------------------------------- ! ! Input : tentative order n of a fft ! Output: the same if n is a good number ! the closest higher number that is good ! an fft order is not good if not implemented (as on IBM with ESSL) ! or implemented but with awful performances (most other cases) ! implicit none integer nr ! integer factors(5), pwr(5), mr, i, fac, p, maxpwr, maxn parameter (maxn=1000) logical good data factors /2, 3, 5, 7, 11/ ! ! find the factors of the fft dimension ! 10 mr=nr do i=1,5 pwr(i)=0 end do do i=1,5 fac=factors(i) maxpwr = nint(log(float(mr))/log(float(fac)))+1 do p=1,maxpwr if (mr.eq.1) goto 20 if (mod (mr,fac).eq.0) then mr=mr/fac pwr(i)=pwr(i)+1 end if end do end do ! 20 if (nr .ne. mr * 2**pwr(1) * 3**pwr(2) * 5**pwr(3) * & & 7**pwr(4) *11**pwr(5) ) & & call error('good_fft_order','what ?!?',1) if (mr.ne.1) then ! fft dimension contains factors > 11 : no good in any case good=.false. else ! specific (machine- and library-dependent cases #ifdef ESSL ! ! IBM machines with essl libraries ! good=pwr(1).ge.1 .and. & & pwr(2).le.2 .and. & & pwr(3).le.1 .and. & & pwr(4).le.1 .and. & & pwr(5).le.1 .and. & & ((pwr(2).eq.0 .and. pwr(3)+pwr(4)+pwr(5).le.2) .or. & & (pwr(2).ne.0 .and. pwr(3)+pwr(4)+pwr(5).le.1) ) #endif ! #ifdef DXML ! ! Dec Alpha machines with dmxl libraries ! good=pwr(4).eq.0 .and. pwr(5).eq.0 #endif ! #if defined(CRAYY) || defined(NEC) || defined(EXEMPLAR) ! ! Cray and t3d machines with scilib libraries ! good=pwr(4).eq.0 .and. pwr(5).eq.0 #endif ! #ifdef FFTW good=pwr(5).eq.0 #endif end if if (.not.good) then nr=nr+1 if (nr.gt.maxn) & & call error('good_fft_order','tto large',maxn) go to 10 else good_fft_order=nr end if ! end