wtomo3d/zero.f at master · bakerb845/wtomo3d · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
c
      SUBROUTINE zero()

c***********************************************************************
c certain large arrays are zeroed.
c***********************************************************************
c 27 / 11 / 1991 updated by z.song, for 3d case.
c 27/4/1993 updated by z.song.
c 26/5/98 separated from initsub. rgp
c 1/20/10 moved precomp,precons,gp1,gs1 into first loop - baker
c 6/20/16 check if array is allocated and if so null it out - baker

      USE GRADIENTS_MODULE, ONLY : gp1, gs1
      USE PRECON_MODULE, ONLY : preconp, precons
      USE DEMUX_MODULE, ONLY : prof
      USE MAT_MODULE
      USE INTERFACE_MODULE, ONLY : zeroas
      IMPLICIT NONE
!     include 'dimension.inc'
!     include 'init.inc'
!     include 'common.inc'
!     include 'oxford.inc'
!     include 'demux.inc'
      COMPLEX, PARAMETER :: zzero = CMPLX(0.0, 0.0)
      REAL, PARAMETER :: rzero = 0.0

c_______________________________________________________________________

c executable code:

c-----------------------------------------------------------------------
c initialize certain arrays to zero:
c-----------------------------------------------------------------------
      IF (ALLOCATED(gp1)) gp1(:,:,:) = zzero
      IF (ALLOCATED(gs1)) gs1(:,:,:) = zzero
      IF (ALLOCATED(preconp)) preconp(:,:,:) = rzero
      IF (ALLOCATED(precons)) precons(:,:,:) = rzero
      IF (ALLOCATED(prof)) prof(:,:) = rzero

!       if (inverse) then
!         do iy = 1,ny
!         do ix = 1,nx
!           do iz = 1,nz
!             gp1(iz,ix,iy)=CMPLX(0.,0.)
!             gs1(iz,ix,iy)=CMPLX(0.,0.)
!           enddo
!         enddo
!         enddo
!         if (preconspatial.ne.0) then
!           do iy = 1,ny
!           do ix = 1,nx
!             do iz = 1,nz
!               preconp(iz,ix,iy)=0.
!               precons(iz,ix,iy)=0.
!             enddo
!           enddo
!           enddo
!         endif
!       endif

c-----nb: prof is a generic i/o file for profio
!       do j = 1,ng
!         do i = 1,nsam
!           prof(i,j)=0.
!         enddo
!       enddo
      CALL zeroas()

      return
      end