copyright (C) 2001 MSC-RPN COMM %%%MC2%%% ***s/r out_sgrid *subroutine out_sgrid 8 implicit none * *AUTHOR Michel Desgagne September 2003 * *REVISION * *ARGUMENTS * NAMES I/O TYPE DESCRIPTION * #include "lcldim.cdk"
#include "partopo.cdk"
#include "grd.cdk"
#include "sor.cdk"
* integer bnd_w,bnd_e,bnd_s,bnd_n real*8 v2,v3,zero,c1 parameter (zero=0.d0, c1=2040.d0) ** *---------------------------------------------------------------------- * bnd_w = 1 - b_west *hx bnd_e = b_ni + b_east *hx bnd_s = 1 - b_south*hy bnd_n = b_nj + b_north*hy out_idl = max(g_id - glb_pos(1) + 1, bnd_w) out_ifl = min(g_if - glb_pos(1) + 1, bnd_e) out_jdl = max(g_jd - glb_pos(3) + 1, bnd_s) out_jfl = min(g_jf - glb_pos(3) + 1, bnd_n) * out_doout = .false. out_nisg = 0 out_njsg = 0 out_nisl = 0 out_njsl = 0 if ((out_idl.le.bnd_e).and.(out_ifl.ge.bnd_w).and. $ (out_jdl.le.bnd_n).and.(out_jfl.ge.bnd_s) ) then out_idg = out_idl + glb_pos(1) - g_id out_ifg = out_ifl + glb_pos(1) - g_id out_jdg = out_jdl + glb_pos(3) - g_jd out_jfg = out_jfl + glb_pos(3) - g_jd out_doout = .true. out_nisg = (g_if - g_id) / g_reduc + 1 out_njsg = (g_jf - g_jd) / g_reduc + 1 out_nisl = (out_ifg - out_idg) / g_reduc + 1 out_njsl = (out_jfg - out_jdg) / g_reduc + 1 endif * if ((out_nisl.gt.0).and.(out_njsl.gt.0)) then * if (out_nisg.lt.1000) then v2 = 2. * out_nisg else if (out_nisg.lt.10000.) then v2 = .2 * out_nisg else v2 = .02 * out_nisg endif if (out_njsg.lt.1000) then v3 = 2. * out_njsg else if (out_njsg.lt.10000.) then v3 = .2 * out_njsg else v3 = .02 * out_njsg endif v2 = min(c1,max(zero,v2)) v3 = min(c1,max(zero,v3)) * Grd_ig1 = (ogrd_v1 + v2 + v3 + ogrd_v2) / 3. Grd_ig2 = ((igs(1)+igs(2)+igs(3)/321.+igs(4)/321.)/4.+ogrd_v1+v2) $ / 3. Grd_ig3 = out_idg Grd_ig4 = out_jdg * v2 = dble(g_id)/dble(Grd_ni) + dble(g_if)/dble(Grd_ni) v3 = dble(g_id)/dble(Grd_nj) + dble(g_jf)/dble(Grd_nj) Grd_ig1 = Grd_ig1 + 10.d0*v2 + 100.d0*v3 Grd_ig2 = Grd_ig2 + (100.d0*v2 + 10.d0*v3) / 2.d0 * endif * *---------------------------------------------------------------------- return end