!copyright (C) 2001 MSC-RPN COMM %%%RPNPHY%%% *** s/p fillaggsubroutine fillagg ( bus,bussiz,ptsurf,ptsurfsiz,indx_sfc,surflen) 5 #include "impnone.cdk"
* integer bussiz,indx_sfc, ptsurfsiz, surflen integer ptsurf(ptsurfsiz) real bus(bussiz) * * *Author * B. Bilodeau Spring 2001 * *Revisions * 001 B. Bilodeau (Feb 2004) - Revised logic to facilitate the * addition of new types of surface * *Object * To copy the fields FC, FV, TSURF, etc. * into the arrays that subroutine AGREGE * will use to calculate the aggregated * values. This subroutine needs to be called * 4 times * *Arguments * * - Input/Output - * BUS bus for the given surface scheme * * - Input - * BUSSIZ dimension of bus * PTSURF surface pointers * PTSURFSIZ dimension of ptsurf * INDX_SFC integer value (1-4) corresponding to each surface type * SURFLEN horizontal dimension (row length) of the gathered points * for the given surface type on the full model row * * *Implicites * *** * * #include "phy_macros_f.h"
* #include "nbvarsurf.cdk"
* #include "sfcbus.cdk"
* real champ_agg, champ_sfc pointer(ichamp_agg, champ_agg(1)) pointer(ichamp_sfc, champ_sfc(1)) * integer i,ik,j,k integer ptr, x * #include "dimsurf.cdk"
* #include "xptsurf.cdk"
* * do j=1,nvarsurf if (agg(j).eq.indx_agrege.and.mul(j).gt.1) then ichamp_agg = loc(bus(x(j,1,indx_agrege))) ichamp_sfc = loc(bus(x(j,1,indx_sfc ))) do k=1,niveaux(j) do i=1,surflen ik = (k-1)*surflen + i champ_agg(ik) = champ_sfc(ik) end do end do endif end do * return end