copyright (C) 2001 MSC-RPN COMM %%%MC2%%% ***s/r out_step *logical function out_step (stepno,stepout,stepout_typ,stepout_ns) 3 implicit none * character*1 stepout_typ integer stepno,stepout(*),stepout_ns * *AUTHOR Michel Desgagne September 2003 * *REVISION * *ARGUMENTS * NAMES I/O TYPE DESCRIPTION * sizebus_o O I output bus size * #include "yomdyn1.cdk"
integer j real*8 hh,mm,ss,nsh,nsm,eps parameter (nsh=3600.d0, nsm=60.d0, eps=1.0d-12) * ** *---------------------------------------------------------------------- * out_step = .false. if (stepout(1).gt.0) then ! INTERVAL if (stepout_typ.eq.'H') then hh=dble(grdt)*dble(stepno)/nsh if ((hh.ge.dble(stepout(2))-eps) .and. $ (hh.le.dble(stepout(3))+eps) .and. $ (mod(hh-dble(stepout(2)),dble(stepout(4))).le.eps)) $ out_step = .true. else if (stepout_typ.eq.'M') then mm=dble(grdt)*dble(stepno)/nsm if ((mm.ge.dble(stepout(2))-eps) .and. $ (mm.le.dble(stepout(3))+eps) .and. $ (mod(mm-dble(stepout(2)),dble(stepout(4))).le.eps)) $ out_step = .true. else if (stepout_typ.eq.'S') then ss=dble(grdt)*dble(stepno) if ((ss.ge.dble(stepout(2))-eps) .and. $ (ss.le.dble(stepout(3))+eps) .and. $ (mod(ss-dble(stepout(2)),dble(stepout(4))).le.eps)) $ out_step = .true. else if (stepout_typ.eq.'P') then if ((stepno.ge.stepout(2)) .and. $ (stepno.le.stepout(3)) .and. $ (mod(stepno-stepout(2),stepout(4)).eq.0)) $ out_step = .true. endif else if (stepout_typ.eq.'H') then hh=dble(grdt)*dble(stepno)/nsh else if (stepout_typ.eq.'M') then hh=dble(grdt)*dble(stepno)/nsm else if (stepout_typ.eq.'S') then hh=dble(grdt)*dble(stepno) else if (stepout_typ.eq.'P') then hh=dble(stepno) if (stepout(2).lt.0) out_step = .true. endif do j=1,stepout_ns if ((hh.ge.dble(stepout(j+1))-eps) .and. $ (hh.le.dble(stepout(j+1))+eps) ) $ out_step = .true. end do endif * *---------------------------------------------------------------------- return end