femwind/fortran/f_assembly_test.f90

   1 program f_assembly_test
   2
   3 use module_f_assembly
   4 use module_utils
   5
   6 implicit none
   7
   8 real, pointer:: F(:,:,:),Xmat(:,:,:),Ymat(:,:,:),Zmat(:,:,:), &
   9                 Xu0mat(:,:,:), Yu0mat(:,:,:), Zu0mat(:,:,:)  ! fortran is not case sensitive
  10
  11 integer :: F_dim, x_dim(3),u_dim(3),                          &
  12     ifds, ifde, kfds, kfde, jfds, jfde,                       & ! fire domain bounds
  13     ifms, ifme, kfms, kfme, jfms, jfme,                       & ! fire memory bounds
  14     ifps, ifpe, kfps, kfpe, jfps, jfpe,                       & ! fire patch bounds
  15     ifts, ifte, kfts, kfte, jfts, jfte                          ! fire tile bounds
  16
  17 real, pointer:: A(:,:,:), X(:,:,:),Y(:,:,:),Z(:,:,:), &
  18                 Xu0(:,:,:), Yu0(:,:,:), Zu0(:,:,:),   &
  19                 Fm(:,:,:)    ! fortran is not case sensitive
  20 integer:: i, j, k
  21 integer:: fsize(3)
  22
  23 call read_array(A,'A')
  24 call read_array(X,'X')
  25 call read_array(Y,'Y')
  26 call read_array(Z,'Z')
  27 call read_array(Xu0, 'Xu0')
  28 call read_array(Yu0, 'Yu0')
  29 call read_array(Zu0, 'Zu0')
  30
  31 x_dim = shape(X)
  32 u_dim = shape(Xu0)
  33
  34 ifts = 1
  35 ifte = x_dim(1)-1
  36 jfts = 1
  37 jfte = x_dim(3)-1
  38 kfts = 1
  39 kfte = x_dim(2)-1
  40 ifms = ifts-1
  41 ifme = ifte+2
  42 jfms = jfts-1
  43 jfme = jfte+2
  44 kfms = kfts-1
  45 kfme = kfte+2
  46 ifds = ifts
  47 ifde = ifte
  48 jfds = jfts
  49 jfde = jfte
  50 kfds = kfts
  51 kfde = kfte
  52
  53
  54 allocate(Xmat(ifms:ifme,kfms:kfme,jfms:jfme))
  55 allocate(Ymat(ifms:ifme,kfms:kfme,jfms:jfme))
  56 allocate(Zmat(ifms:ifme,kfms:kfme,jfms:jfme))
  57 allocate(Xu0mat(ifms:ifme,kfms:kfme,jfms:jfme))
  58 allocate(Yu0mat(ifms:ifme,kfms:kfme,jfms:jfme))
  59 allocate(Zu0mat(ifms:ifme,kfms:kfme,jfms:jfme))
  60
  61 ! copy the input data to tile sized bounds
  62 ! X Y Z are corner based, upper bound larger by one
  63 do j=jfts,jfte+1
  64   do k=kfts,kfte+1
  65     do i=ifts,ifte+1
  66         Xmat(i,k,j) = X(i,k,j)
  67         Ymat(i,k,j) = Y(i,k,j)
  68         Zmat(i,k,j) = Z(i,k,j)
  69     enddo
  70   enddo
  71 enddo
  72
  73 ! u is midpoint based
  74 do j=jfts,jfte
  75   do k=kfts,kfte
  76     do i=ifts,ifte
  77         Xu0mat(i,k,j) = Xu0(i,k,j)
  78         Yu0mat(i,k,j) = Yu0(i,k,j)
  79         Zu0mat(i,k,j) = Zu0(i,k,j)
  80     enddo
  81   enddo
  82 enddo
  83
  84
  85
  86
  87 F_dim = x_dim(1)*x_dim(2)*x_dim(3)
  88 allocate(F(ifms:ifme, kfms:kfme, jfms:jfme))
  89 F = 0.
  90
  91 write(*,'(a)')'calling ndt_f_assembly'
  92 call f_assembly(  &
  93   ifds, ifde, kfds, kfde, jfds, jfde,                       & ! fire domain bounds
  94   ifms, ifme, kfms, kfme, jfms, jfme,                       & ! fire memory bounds
  95   ifps, ifpe, kfps, kfpe, jfps, jfpe,                       & ! fire patch bounds
  96   ifts, ifte, kfts, kfte, jfts,jfte,                        & ! fire tile bounds
  97   A, Xmat , Ymat, Zmat, Xu0mat, Yu0mat, Zu0mat,             &
  98   F)
  99
 100 ! write output as is in 3D but with tight dimensions
 101 call write_array(F(ifts:ifte+1,kfts:kfte+1,jfts:jfte+1),'F')
 102
 103 end program f_assembly_test