1subroutine m65a
2
3  use timer_module, only: timer
4  use timer_impl, only: init_timer !, limtrace
5  use, intrinsic :: iso_c_binding, only: C_NULL_CHAR
6  use FFTW3
7
8  interface
9     function address_m65()
10     integer*1, pointer :: address_m65
11     end function address_m65
12  end interface
13
14  integer*1 attach_m65
15  integer size_m65
16  integer*1, pointer :: p_m65
17  character*80 cwd
18  character wisfile*256
19  logical fileExists
20
21  call getcwd(cwd)
22  call ftninit(trim(cwd))
23  call init_timer (trim(cwd)//'/timer.out')
24
25  limtrace=0
26  lu=12
27  i1=attach_m65()
28
2910 inquire(file=trim(cwd)//'/.lock',exist=fileExists)
30  if(fileExists) then
31     call sleep_msec(100)
32     go to 10
33  endif
34
35  inquire(file=trim(cwd)//'/.quit',exist=fileExists)
36  if(fileExists) then
37     call timer('decode0 ',101)
38     i=detach_m65()
39     ! Save FFTW wisdom and free memory
40     wisfile=trim(cwd)//'/m65_wisdom.dat'// C_NULL_CHAR
41     if(len(trim(wisfile)).gt.0) iret=fftwf_export_wisdom_to_filename(wisfile)
42     call four2a(a,-1,1,1,1)
43     call filbig(a,-1,1,0.0,0,0,0,0,0) !used for FFT plans
44     call fftwf_cleanup_threads()
45     call fftwf_cleanup()
46     go to 999
47  endif
48
49  nbytes=size_m65()
50  if(nbytes.le.0) then
51     print*,'m65a: Shared memory mem_m65 does not exist.'
52     print*,'Program m65a should be started automatically from within map65.'
53     go to 999
54  endif
55  p_m65=>address_m65()
56  call m65b(p_m65,nbytes)
57  call sleep_msec(500)          ! wait for .lock to be recreated
58  go to 10
59
60999 return
61end subroutine m65a
62
63subroutine m65b(m65com,nbytes)
64  integer*1 m65com(0:nbytes-1)
65  kss=4*4*60*96000
66  ksavg=kss+4*4*322*32768
67  kfcenter=ksavg+4*4*32768
68 call m65c(m65com(0),m65com(kss),m65com(ksavg),m65com(kfcenter))
69  return
70end subroutine m65b
71
72subroutine m65c(dd,ss,savg,nparams0)
73
74  include 'njunk.f90'
75  real*4 dd(4,5760000),ss(4,322,32768),savg(4,32768)
76  real*8 fcenter
77  integer nparams0(NJUNK+2),nparams(NJUNK+2)
78  logical ldecoded
79  character*12 mycall,hiscall
80  character*6 mygrid,hisgrid
81  character*20 datetime
82  common/npar/fcenter,nutc,idphi,mousedf,mousefqso,nagain,              &
83       ndepth,ndiskdat,neme,newdat,nfa,nfb,nfcal,nfshift,               &
84       mcall3,nkeep,ntol,nxant,nrxlog,nfsample,nxpol,nmode,             &
85       nfast,nsave,max_drift,nhsym,mycall,mygrid,hiscall,hisgrid,       &
86       datetime,junk1,junk2
87  common/early/nhsym1,nhsym2,ldecoded(32768)
88  equivalence (nparams,fcenter)
89
90  nparams=nparams0                     !Copy parameters into common/npar/
91  npatience=1
92  if(nhsym.eq.nhsym1 .and. iand(nrxlog,1).ne.0) then
93     write(21,1000) datetime(:17)
941000 format(/'UTC Date: 'a17/78('-'))
95     flush(21)
96  endif
97  if(iand(nrxlog,2).ne.0) rewind(21)
98  if(iand(nrxlog,4).ne.0) then
99     if(nhsym.eq.nhsym1) rewind(26)
100     if(nhsym.eq.nhsym2) backspace(26)
101  endif
102
103  nstandalone=0
104  if(sum(nparams).ne.0) call decode0(dd,ss,savg,nstandalone)
105
106  return
107end subroutine m65c
108