1 subroutine solveGradV( rmass, qres, iBC, iper, ilwork ) 2c--------------------------------------------------------------------- 3c 4c This routine satisfies the periodic boundary conditions 5c on the diffusive flux residual and mass matrix 6c 7c input: 8c rmass (nshg) : mass matrix 9c qres (nshg,(nflow-1)*nsd) : diffusive flux vector 10c 11c output: modified qres and rmass 12c--------------------------------------------------------------------- 13 include "common.h" 14 15 dimension rmass(nshg), qres(nshg,nsdsq), 16 & iBC(nshg), iper(nshg) 17c 18c 19c.... compute qi for node A, i.e., qres <-- qres/rmass 20c 21 if (numpe > 1) then 22 call commu (qres , ilwork, nsdsq , 'in ') 23 endif 24c 25c take care of periodic boundary conditions 26c but not on surface tension terms in qres(:,10-12) 27c that are used to compute normal vector 28c 29 !write(*,*) 'nflow, nsd, idflx, idflow:',nflow,nsd,idflx,idflow 30 !idflow = (nflow-1)*nsd 31 do j= 1,nshg 32 if ((btest(iBC(j),10))) then 33 i = iper(j) 34c qres(i,:) = qres(i,:) + qres(j,:) 35! qres(i,1:idflow) = qres(i,1:idflow) + qres(j,1:idflow) 36 qres(i,1:nsdsq) = qres(i,1:nsdsq) + qres(j,1:nsdsq) 37 endif 38 enddo 39 40 do j= 1,nshg 41 if ((btest(iBC(j),10))) then 42 i = iper(j) 43c qres(j,:) = qres(i,:) 44! qres(j,1:idflow) = qres(i,1:idflow) 45 qres(j,1:nsdsq) = qres(i,1:nsdsq) 46 endif 47 enddo 48 49 ! rmass has already been computed and inversed in qpbc.f 50 do i=1, nsdsq 51 qres(:,i) = rmass*qres(:,i) 52 enddo 53 54 if(numpe > 1) then 55 call commu (qres, ilwork, nsdsq, 'out') 56 endif 57 58c 59c.... return 60c 61 return 62 end 63 64