wrfv2_fire/phys/util_test_main.F

   1 module util_test
   2 contains
   3 subroutine util_test_sub
   4 use module_fr_sfire_util
   5 implicit none
   6 call test(sum_2d_cells,'sum_2d_cells',0,0, &
   7     0,1,0,1,-1,2,0,2,      &
   8     1,1,1,1,0,3,0,3)
   9 call testn2n(2,2,1,1,1,1,     &
  10     1,2,1,2,1,2,1,2,      &
  11     1,3,1,3,1,3,1,3)
  12 call testn2n(2,2,1,1,1,1,     &
  13     1,2,1,3,1,2,1,3,      &
  14     1,3,1,5,1,3,1,5)
  15 call testn2n(2,3,1,1,2,2,     &
  16     1,2,1,3,1,5,1,4,      &
  17     1,3,1,10,1,3,1,10)
  18 call testn2n(2,3,1,1,2,2,     &
  19     1,2,1,3,-1,5,1,4,      &
  20     1,3,2,6,1,3,1,8)
  21 !call test(interpolate_2d_cells2cells,'interpolate_2d_cells2cells',0,0,  &
  22 !    1,2,1,2,1,2,1,2,      &
  23 !    1,4,1,4,1,4,1,4)
  24 !call test(interpolate_2d_cells2cells,'interpolate_2d_cells2cells',0,0,  &
  25 !    1,2,1,2,1,2,1,2,      &
  26 !    1,6,1,6,1,6,1,6)
  27 !call test(interpolate_2d_cells2nodes,'interpolate_2d_cells2nodes',0,1,  &
  28 !    1,2,1,2,1,2,1,2,      &
  29 !    1,4,1,4,1,5,1,5)
  30 !call test(interpolate_2d_cells2nodes,'interpolate_2d_cells2nodes',0,1,  &
  31 !    1,2,1,2,1,2,1,2,      &
  32 !    1,6,1,6,1,7,1,7)
  33 end subroutine util_test_sub
  34
  35
  36 subroutine test(sub,s,n1,n2,              &
  37        ids1,ide1,jds1,jde1,ims1,ime1,jms1,jme1, &
  38        ids2,ide2,jds2,jde2,ims2,ime2,jms2,jme2)
  39 use module_fr_sfire_util
  40 implicit none
  41
  42 external sub
  43 character(len=*)s
  44 integer:: n1,n2 ! 0 if cell based, 1 if node based
  45 integer, intent(in)::ids1,ide1,jds1,jde1,ims1,ime1,jms1,jme1
  46 real::v1(ims1:ime1,jms1:jme1)
  47 integer, intent(in)::ids2,ide2,jds2,jde2,ims2,ime2,jms2,jme2
  48 real::v2(ims2:ime2,jms2:jme2)
  49 integer:: i,j,k
  50
  51 write(*,'(a,a)')'test ',s
  52 write(*,2)'mesh 1 size',ids1,ide1,jds1,jde1
  53 k=0
  54 do i=ids1,ide1+n1
  55     do j=jds1,jde1+n1
  56        k=k+1
  57        v1(i,j)=k
  58     enddo
  59     write(*,1)(v1(i,j),j=jds1,jde1+n1)
  60 enddo
  61 1 format(20f7.3)
  62 2 format(a,i4,':',i4,' by ',i4,':',i4)
  63 call sub(      &
  64        ims1,ime1,jms1,jme1,ids1,ide1,jds1,jde1,v1, &
  65        ims2,ime2,jms2,jme2,ids2,ide2,jds2,jde2,v2)
  66 write(*,2)'mesh 2, interpolated, size',ids2,ide2,jds2,jde2
  67 do i=ids2,ide2+n2
  68     write(*,1)(v2(i,j),j=jds2,jde2+n2)
  69 enddo
  70 end subroutine test
  71
  72 subroutine testn2n(ir,jr,ip1,jp1,ip2,jp2,       &
  73        ids1,ide1,jds1,jde1,ims1,ime1,jms1,jme1, &
  74        ids2,ide2,jds2,jde2,ims2,ime2,jms2,jme2)
  75 use module_fr_sfire_util
  76 implicit none
  77
  78 integer, intent(in):: ir,jr ! refinement ratios
  79 integer, intent(in):: ip1,jp1,ip2,jp2 ! offset of start of 2 in 1
  80 integer, intent(in)::ids1,ide1,jds1,jde1,ims1,ime1,jms1,jme1
  81 real::v1(ims1:ime1,jms1:jme1)
  82 integer, intent(in)::ids2,ide2,jds2,jde2,ims2,ime2,jms2,jme2
  83 real::v2(ims2:ime2,jms2:jme2)
  84 integer:: i,j,k
  85
  86 write(*,'(a)')'test interpolate_2d_nodes2nodes'
  87 write(*,2)'mesh 1 size',ids1,ide1,jds1,jde1
  88 k=0
  89 do i=ids1,ide1
  90     do j=jds1,jde1
  91        k=k+1
  92        v1(i,j)=k
  93     enddo
  94     write(*,1)(v1(i,j),j=jds1,jde1)
  95 enddo
  96 v2=-1
  97 1 format(20f7.3)
  98 2 format(a,i4,':',i4,' by ',i4,':',i4)
  99
 100 call interpolate_2d_nodes2nodes(  &
 101     ims1,ime1,jms1,jme1, & ! array coarse grid
 102     ids1,ide1,jds1,jde1, & ! dimensions fine grid
 103     ims2,ime2,jms2,jme2, & ! array coarse grid
 104     ids2,ide2,jds2,jde2, & ! dimensions coarse grid
 105     ir,jr,               & ! refinement ration
 106     ip1,jp1,ip2,jp2,     & !
 107     v1,                  & ! in coarse grid
 108     v2  )                  ! out fine grid
 109
 110 write(*,2)'mesh 2, interpolated, size',ids2,ide2,jds2,jde2
 111 do i=ids2,ide2
 112     write(*,1)(v2(i,j),j=jds2,jde2)
 113 enddo
 114 end subroutine testn2n
 115
 116 end module util_test
 117
 118 program main
 119 use util_test
 120 call util_test_sub
 121 end program main