NADCON5-ng  0.0.2
NADCON5 Next Generation Documentation
subtrc.f
Go to the documentation of this file.
1 c> \ingroup core
2 c> \if MANPAGE
3 c> \page subtrc
4 c> \endif
5 c>
6 c> Part of the NADCON5 \ref core , Subtract one grid from another
7 c>
8 c>
9 c> ### Program arguments
10 c> Arguments are newline terminated and read from standard input
11 c>
12 c> When run from the command line, the program prints a prompt for each argument
13 c>
14 c> They are enumerated here
15 c> \param infileA First Input File Name
16 c> \param infileB Second Input File Name
17 c> \param outfile Output File Name of A*B
18 c>
19 c> ### Program Inputs:
20 c>
21 c> - `lin1` Input File A
22 c> - `lin2` Input File B
23 c> - `lout` Output File to Write A-B
24 c>
25  program subtrc
26 
27 *** subtract one grid from another
28 
29  implicit double precision(a-h,o-z)
30  character*188 fname
31  integer hrec1(9999),hrec2(9999)
32  real*4 zrec1(9999),zrec2(9999)
33  equivalence(hrec1(1),zrec1(1))
34  equivalence(hrec2(1),zrec2(1))
35 
36  lin1=1
37  lin2=2
38  lout=3
39 
40  write(6,*) 'program subtrc'
41 
42  write(6,3)
43  3 format('Enter "plus" input file: ',$)
44  read(5,1) fname
45  1 format(a)
46  open(lin1,file=fname,status='old',form='unformatted')
47 
48  write(6,4)
49  4 format('Enter "minus" input file: ',$)
50  read(5,1) fname
51  open(lin2,file=fname,status='old',form='unformatted')
52 
53  write(6,2)
54  2 format('Enter "a-b" output file: ',$)
55  read(5,1) fname
56  open(lout,file=fname,status='new',form='unformatted')
57 
58  read(lin1) glamn1,glomn1,dgla1,dglo1,nla1,nlo1,ikind1
59  read(lin2) glamn2,glomn2,dgla2,dglo2,nla2,nlo2,ikind2
60 
61 *** check compatability
62 
63  if(dabs(glomn1-glomn2).gt.1.d-7) stop 1
64  if(dabs(glamn1-glamn2).gt.1.d-7) stop 6
65  if(dabs(dgla1 -dgla2 ).gt.1.d-7) stop 2
66  if(dabs(dglo1 -dglo2 ).gt.1.d-7) stop 3
67  if(nlo1 .ne.nlo2 ) stop 4
68  if(nla1 .ne.nla2 ) stop 7
69  if(ikind1.eq.0.and.ikind2.ne.0.or.
70  * ikind2.eq.0.and.ikind1.ne.0) stop 5
71 
72  write(lout) glamn1,glomn1,dgla1,dglo1,nla1,nlo1,ikind1
73  if(ikind1.eq.0) then
74  do 10 irow=1,nla1
75  read (lin1) (hrec1(i),i=1,nlo1)
76  read (lin2) (hrec2(i),i=1,nlo1)
77  do 11 i=1,nlo1
78  11 hrec1(i)=hrec1(i)-hrec2(i)
79  10 write(lout) (hrec1(i),i=1,nlo1)
80  else
81  do 20 irow=1,nla1
82  read (lin1) (zrec1(i),i=1,nlo1)
83  read (lin2) (zrec2(i),i=1,nlo1)
84  do 21 i=1,nlo1
85  21 zrec1(i)=zrec1(i)-zrec2(i)
86  20 write(lout) (zrec1(i),i=1,nlo1)
87  endif
88 
89  stop
90  end
program subtrc
Part of the NADCON5 NADCON5 Core Library , Subtract one grid from another.
Definition: subtrc.f:25