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