copyright (C) 2001 MSC-RPN COMM %%%MC2%%% ***s/r inibuso *subroutine inibuso (stepno,sizebus_o) 2,1 implicit none * integer stepno,sizebus_o * *AUTHOR Michel Desgagne September 2003 * *REVISION * *OBJECT * *ARGUMENTS * NAMES I/O TYPE DESCRIPTION * stepno I I current step number * sizebus_o O I output bus size * #include "lesbus.cdk"
#include "physnml.cdk"
#include "grd.cdk"
#include "sor.cdk"
* logical out_step,dejala external out_step integer i,j,k,gthid(phyotop),step_id,indx * ** *---------------------------------------------------------------------- * bus_ospc = 0 bus_otop = 0 varp_nset = 0 do i=1,varoutp_set step_id = varoutp_p(3,i) if (out_step
(stepno,stepout(1,step_id),stepout_typ(step_id), $ stepout_ns(step_id))) then varp_nset = varp_nset + 1 varp_set(varp_nset) = i do j=1,varoutp_nvar(i) do k=1,nvarphy indx = k if (phyonm(k,1).eq.varoutp_S(j,i)) goto 5 end do 5 dejala = .false. do k=1,bus_otop if (gthid(k).eq.indx) dejala=.true. end do if (.not.dejala) then bus_otop = bus_otop + 1 gthid(bus_otop) = indx endif end do endif end do * out_ontimec = .false. if ((stepno.ge.Grdc_start).and.(.not.Grdc_initsfc_L)) then if ( Grdc_ndt.ge.0 ) then if ( Grdc_ndt.eq.0 ) then if (stepno.eq.0) out_ontimec = .true. else out_ontimec = (mod(stepno,Grdc_ndt).eq.0) endif endif endif * if (out_ontimec) then do j=1,nvp_casc do k=1,nvarphy indx = k if (phyonm(k,1).eq.upolistc(j)) goto 7 end do 7 dejala = .false. do k=1,bus_otop if (gthid(k).eq.indx) dejala=.true. end do if (.not.dejala) then bus_otop = bus_otop + 1 gthid(bus_otop) = indx endif end do if (Grdc_bcs_L) Grdc_initsfc_L = .true. endif * do i=1,bus_otop bus_oname(i,1) = phyonm (gthid(i),1) bus_oname(i,2) = phyonm (gthid(i),2) bus_oname(i,3) = phyonm (gthid(i),3) bus_opar (i,1) = bus_ospc + 1 bus_opar (i,2) = phyopar(gthid(i),2) bus_opar (i,3) = phyopar(gthid(i),3) bus_opar (i,4) = phyopar(gthid(i),4) bus_opar (i,5) = phyopar(gthid(i),5) bus_opar (i,6) = phyopar(gthid(i),6) bus_ospc = bus_opar(i,1) + bus_opar(i,2) - 1 end do * sizebus_o = bus_ospc * *---------------------------------------------------------------------- return end