NADCON5-ng  0.0.2
NADCON5 Next Generation Documentation
NADCON5 Core Library

Programs and Functions which are responsible for computing the grid transformations used to build NADCON5. More...

Directories

directory BinSource
 Folder containing NADCON5 Core Library Programs.
 
directory Subs
 Folder containing NADCON5 Core Library Subroutines.
 

Programs, Functions, and Subroutines

program addem
 Part of the NADCON5 NADCON5 Core Library , adds one grid to another. More...
 
program b2xyz
 Part of the NADCON5 NADCON5 Core Library , converts *.b grid to xyz More...
 
program convlv
 Part of the NADCON5 NADCON5 Core Library , Convolves two grids. More...
 
program decimate
 Part of the NADCON5 NADCON5 Core Library , Extract a reduced (1 of n) dataset. More...
 
program gabs
 Part of the NADCON5 NADCON5 Core Library , Convert values in a *.b grid to absolute value. More...
 
program gscale
 Part of the NADCON5 NADCON5 Core Library , Scales a grid by a factor. More...
 
program gsqr
 Part of the NADCON5 NADCON5 Core Library , Squares values in a *.b grid. More...
 
program gsqrt
 Part of the NADCON5 NADCON5 Core Library , Square Root of values in a *.b grid. More...
 
program regrd2
 Part of the NADCON5 NADCON5 Core Library , regrid data. More...
 
program subtrc
 Part of the NADCON5 NADCON5 Core Library , Subtract one grid from another. More...
 
program xyz2b
 Part of the NADCON5 NADCON5 Core Library , Converts GMT *.grd to a *.b NADCON style grid file. More...
 
subroutine bicubic (z, glamn, glomn, dla, dlo, nla, nlo, maxla, maxlo, xla, xlo, val)
 Subroutine to perform a 2-D cubic ("bicubic") interpolation. More...
 
subroutine bilin (data, glamn, glomn, dla, dlo, nla, nlo, maxla, maxlo, xla, xlo, val)
 Subroutine to perform bilinear interpolation. More...
 
subroutine biquad (z, glamn, glomn, dla, dlo, nla, nlo, maxla, maxlo, xla, xlo, val)
 Subroutine to perform a 2-D quadratic ("biquadratic") interpolation. More...
 
subroutine bwplotcv (ele, fname, bw, be, bs, bn, jm, b1, b2, maxplots, olddtm, newdtm, region, elecap, ij, igridsec, fn)
 Subroutine to make GMT calls to do a B/W coverage plot. More...
 
subroutine bwplotvc (ele, fname, bw, be, bs, bn, jm, b1, b2, maxplots, olddtm, newdtm, region, elecap, ij, xvlon, xvlat, xllon, xllat, lorvog, lorvopc, igridsec, fn)
 Subroutine to make GMT calls to do a B/W vector plot. More...
 
subroutine coplot (ele, fname, bw, be, bs, bn, jm, b1, b2, maxplots, olddtm, newdtm, region, elecap, ij, cptlo, cpthi, cptin6, suffixused, igridsec, fn)
 Subroutine to make GMT calls to do Color Raster Rendering of Gridded Data. More...
 
subroutine coplotwcv (ele, fname, bw, be, bs, bn, jm, b1, b2, maxplots, olddtm, newdtm, region, elecap, ij, cptlo, cpthi, cptin6, suffixused, igridsec, fn, cvfname)
 Subroutine to make GMT calls to do a color raster rendering of gridded data, with coverage overlaid. More...
 
subroutine cpt (ave, std, csm, xlo, xhi, xin)
 This subroutine generates the color pallette variables for a GMT color plot. More...
 
subroutine cpt2 (med, csm, xlo, xhi, xin)
 This subroutine generates the color pallette variables for a GMT color plot. More...
 
real function cubterp (x, f0, f1, f2, f3)
 This function fits a cubic function through four points. More...
 
subroutine getgridbounds (region, xn, xs, xw, xe)
 Subroutine to collect up the GRID boundaries for use in creating NADCON 5. More...
 
subroutine getmag (x, ix)
 Subroutine to return the magnitude of a double precision value. More...
 
subroutine getmapbounds (mapflag, maxplots, region, nplots, olddtm, newdtm, bw, be, bs, bn, jm, b1, b2, fn, lrv, rv0x, rv0y, rl0y)
 Subroutine to collect up the MAP boundaries for use in creating NADCON 5. More...
 
subroutine gridstats (fname, ave, std, med)
 Subroutine to print grid statistics to stdout. More...
 
subroutine indexxd (n, nd, arr, indx)
 Subroutine to perform ?? indexing on floating point data (double precision) More...
 
subroutine indexxi (n, nd, arr, indx)
 Subroutine to perform ?? indexing on integer data. More...
 
integer *2 function iselect2 (k, n, arr, nmax)
 Function to select an element of a partially filled, but packed multi dimensional array, integer*2 More...
 
real *4 function onzd (x)
 Function to round a digit to one significant figure (one non zero digit), single precision. More...
 
real *8 function onzd2 (x)
 Function to round a digit to one significant figure (one non zero digit), double precision. More...
 
subroutine plotcoast (region, ifnum)
 Subroutine to write GMT-based commands to create a shoreline Write GMT-based commands to create a shoreline based on region. More...
 
real function qterp (x, f0, f1, f2)
 This function fits a quadratic function through 3 points. More...
 
real *8 function select2 (k, n, arr, nmax)
 Function to select an element of a partially filled, but packed multi dimensional array, double precision. More...
 
real *4 function select2 (k, n, arr, nmax)
 Function to select an element of a partially filled, but packed multi dimensional array, single precision. More...
 
subroutine vecstats (fname, n)
 Subroutine to tell us how many thinned vectors were used to make a grid. More...
 

Detailed Description

Programs and Functions which are responsible for computing the grid transformations used to build NADCON5.

The programs here can be considered "Library" Programs, or functions, which do the raw work of computing various transformations and conversions from *.b NADCON binary grid to a GMT style *.grd

Function Documentation

program addem ( )

Part of the NADCON5 NADCON5 Core Library , adds one grid to another.

Program arguments

Arguments are newline terminated and read from standard input

When run from the command line, the program prints a prompt for each argument

They are enumerated here

Parameters
infileAFirst Input File Name
infileBSecond Input File Name
outfileOutput File Name of A+B

Program Inputs:

  • lin1 Input File A
  • lin2 Input File B
  • lout Output File to Write A+B

Definition at line 24 of file addem.f.

program b2xyz ( )

Part of the NADCON5 NADCON5 Core Library , converts *.b grid to xyz

Program to convert standard "*.b" grid formatted data to a binary xyz (lon, lat, value) list, which can then be used by GMT for various things (like running the GMT routine "xyz2grd", to get a "*.grd" file, which is useful for plotting, etc)

Program arguments

Arguments are newline terminated and read from standard input

When run from the command line, the program prints a prompt for each argument

They are enumerated here

Parameters
infileInput File Name

Program Inputs:

  • Input File defined by infile

Program Outputs:

  • temp.xyz

Definition at line 31 of file b2xyz.f.

subroutine bicubic ( real*4, dimension(maxla,maxlo)  z,
  glamn,
  glomn,
  dla,
  dlo,
  nla,
  nlo,
  maxla,
  maxlo,
  xla,
  xlo,
  val 
)

Subroutine to perform a 2-D cubic ("bicubic") interpolation.

Performs interpolation at location "xla,xlo" off of grid "z", whose header information is the standard ".b" header information with additional inputs

Parameters
[in]zInput Grid
[in]glamnminimum latitude (real*8 decimal degrees)
[in]glomnminimum longitude (real*8 decimal degrees)
[in]dlalatitude spacing (real*8 decimal degrees)
[in]dlolongitude spacing (real*8 decimal degrees)
[in]nlanumber of lat rows (integer*4)
[in]nlonumber of lon cols (integer*4)
[in]maxlaactual dimensioned size of "z" in rows
[in]maxloactual dimensioned size of "z" in cols
[in]xlalat of pt for interpolation (real*8 dec. deg)
[in]xlolon of pt for interpolation (real*8 dec. deg)
[out]valinterpolated value (real*8)

Method:

Fit a 4x4 window over the random point. Unless the point is less than one grid spacing from the edge of the grid, it will fall in the inner 2x2 cell, and the 4x4 cell will be centered upon that.

Thus, if our point of interest is the asterisk, the window will look like this:

       .  .  .  .
       .  .  .  .
       .  .* .  . 
       .  .  .  .

Definition at line 41 of file bicubic.f.

Referenced by checkgrid().

41 
42 c - Data is assumed real*4
43  implicit real*8 (a-h,o-z)
44  real*4 z(maxla,maxlo)
45 
46 c - Internal use
47  real*4 x,y,fx0,fx1,fx2,fx3,cubterp
48 
49 c - Find which row should be LEAST when fitting
50 c - a 4x4 window around xla.
51  difla = (xla - glamn)
52  ratla = difla / dla
53  jla = int(ratla)
54 c - Fix any edge overlaps
55  if(jla.lt.1)jla = 1
56  if(jla.gt.nla-3)jla = nla-3
57 
58 c - Find which column should be LEAST when fitting
59 c - a 4x4 window around xlo.
60  diflo = (xlo - glomn)
61  ratlo = diflo / dlo
62  jlo = int(ratlo)
63 c - Fix any edge overlaps
64  if(jlo.lt.1)jlo = 1
65  if(jlo.gt.nlo-3)jlo = nlo-3
66 
67 c - In the range of 0(westernmost) to
68 c - 3(easternmost) col, where is our
69 c - random lon value? That is, x must
70 c - be real and fall between 0 and 3.
71 c - (Note, unless it is near an edge,
72 c - it will always be between 1 and 2)
73 
74  x=(xlo-dlo*(jlo-1)-glomn)/dlo
75 
76  if(x.lt.0.0)then
77  write(6,100)x
78  stop
79  endif
80  100 format(
81  *'FATAL in bicubic: x<0 : ',f20.10)
82 
83  if(x.gt.3.0)then
84  write(6,101)x
85  stop
86  endif
87  101 format(
88  *'FATAL in bicubic: x>3 : ',f20.10)
89 
90 c - In the range of 0(southernmost) to
91 c - 3(northernmost) row, where is our
92 c - random lat value? That is, x must
93 c - be real and fall between 0 and 3.
94 c - (Note, unless it is near an edge,
95 c - it will always be between 1 and 2)
96 
97  y=(xla-dla*(jla-1)-glamn)/dla
98 
99  if(y.lt.0.0)then
100  write(6,102)y
101  stop
102  endif
103  102 format(
104  *'FATAL in bicubic: y<0 : ',f20.10)
105 
106  if(y.gt.3.0)then
107  write(6,103)y
108  stop
109  endif
110  103 format(
111  *'FATAL in bicubic: y>3 : ',f20.10)
112 
113 c - Now do the interpolation. First, build a 1-D cubic function
114 c - east-west in the southermost row and interpolate to longitude
115 c - "xlo" (at "x" for 0<x<3). Then do it in the 2nd row,
116 c - then again in the 3rd, and finally the 4th and most northern row.
117 c - The last step is to fit a 1-D cubic function north-south at the
118 c - four previous interpolations, but this time to interpolate to
119 c - latitude "xla" (at "y" for 0<y<3). Obviously we
120 c - could reverse the order, doing 4 north-south cubics
121 c - followed by one east-east and we'd get the same answer.
122 
123 
124  fx0=cubterp(x,z(jla ,jlo ),z(jla ,jlo+1),
125  * z(jla ,jlo+2),z(jla ,jlo+3))
126 
127  fx1=cubterp(x,z(jla+1,jlo ),z(jla+1,jlo+1),
128  * z(jla+1,jlo+2),z(jla+1,jlo+3))
129 
130  fx2=cubterp(x,z(jla+2,jlo ),z(jla+2,jlo+1),
131  * z(jla+2,jlo+2),z(jla+2,jlo+3))
132 
133  fx3=cubterp(x,z(jla+3,jlo ),z(jla+3,jlo+1),
134  * z(jla+3,jlo+2),z(jla+3,jlo+3))
135 
136  val=dble(cubterp(y,fx0,fx1,fx2,fx3))
137 
138 
139 c write(6,1001)glamn,xla,jla,y
140 c write(6,1002)glomn,xlo,jlo,x
141 c write(6,1003)z(jla+3,jlo ),z(jla+3,jlo+1),
142 c * z(jla+3,jlo+2),z(jla+3,jlo+3)
143 c write(6,1003)z(jla+2,jlo ),z(jla+2,jlo+1),
144 c * z(jla+2,jlo+2),z(jla+2,jlo+3)
145 c write(6,1003)z(jla+1,jlo ),z(jla+1,jlo+1),
146 c * z(jla+1,jlo+2),z(jla+1,jlo+3)
147 c write(6,1003)z(jla ,jlo ),z(jla ,jlo+1),
148 c * z(jla ,jlo+2),z(jla ,jlo+3)
149 c write(6,1004)fx0,fx1,fx2,fx3,val
150 c pause
151 
152  1001 format(f14.10,1x,f14.10,1x,i8,1x,f8.5)
153  1002 format(f14.10,1x,f14.10,1x,i8,1x,f8.5)
154  1003 format(4(f15.8,1x))
155  1004 format(
156  *'fx0 = ',f15.8,/,
157  *'fx1 = ',f15.8,/,
158  *'fx2 = ',f15.8,/,
159  *'fx3 = ',f15.8,/,
160  *'val = ',f15.8)
161 
162 
163 
164  return
real function cubterp(x, f0, f1, f2, f3)
This function fits a cubic function through four points.
Definition: cubterp.f:52

+ Here is the caller graph for this function:

subroutine bilin ( real*4, dimension(maxla,maxlo)  data,
  glamn,
  glomn,
  dla,
  dlo,
  nla,
  nlo,
  maxla,
  maxlo,
  xla,
  xlo,
  val 
)

Subroutine to perform bilinear interpolation.

Performs a bilinear interpolation at location xla,xlo off of grid data, whose header information is the standard .b header information

Parameters
[in]dataInput Data assumed to be real*4
[in]glamnminimum latitude (real*8 decimal degrees) *.b
[in]glomnminimum longitude (real*8 decimal degrees) *.b
[in]dlalatitude spacing (real*8 decimal degrees) *.b
[in]dlolongitude spacing (real*8 decimal degrees) *.b
[in]nlanumber of lat rows (integer*4) *.b
[in]nlonumber of lon cols (integer*4) *.b
[in]maxlaactual dimensioned size of "data" in rows *.b
[in]maxloactual dimensioned size of "data" in cols *.b
[in]xlalat of pt for interpolation (real*8 dec. def)
[in]xlolon of pt for interpolation (real*8 dec. def)
[out]valinterpolated value (real*8)

Definition at line 27 of file bilin.f.

Referenced by checkgrid().

27 c - Subroutine to perform a bilinear interpolation
28 c - at location "xla,xlo" off of grid "data", whose
29 c - header information is the standard ".b" header
30 c - information of
31 c - glamn = minimum latitude (real*8 decimal degrees)
32 c - glomn = minimum longitude (real*8 decimal degrees)
33 c - dla = latitude spacing (real*8 decimal degrees)
34 c - dlo = longitude spacing (real*8 decimal degrees)
35 c - nla = number of lat rows (integer*4)
36 c - nlo = number of lon cols (integer*4)
37 c - maxla = actual dimensioned size of "data" in rows
38 c - maxlo = actual dimensioned size of "data" in cols
39 
40 c - data is assumed real*4
41  implicit real*8 (a-h,o-z)
42  real*4 data(maxla,maxlo)
43  logical onedlat,onedlon
44 
45 c - HACK
46 c do 8787 i=1,nla
47 c do 8788 j=1,nlo
48 c write(6,8789)i,j,data(i,j)
49 c8788 continue
50 c8787 continue
51 c8789 format(i5,1x,i5,1x,f20.10)
52 
53 c - Find the row of xla
54  difla = (xla - glamn)
55  ratla = difla / dla
56  ila = int(ratla)+1
57  gla0 = glamn + (ila-1)*dla
58 
59 c - Find the col of xlo
60  diflo = (xlo - glomn)
61  ratlo = diflo / dlo
62  ilo = int(ratlo)+1
63  glo0 = glomn + (ilo-1)*dlo
64 
65 
66 c - Do the interpolation.
67  t=(xlo-glo0)/dlo
68  u=(xla-gla0)/dla
69 
70  val = (1.d0-t)*(1.d0-u)*data(ila ,ilo )
71  * + ( t)*(1.d0-u)*data(ila ,ilo+1)
72  * + ( t)*( u)*data(ila+1,ilo+1)
73  * + (1.d0-t)*( u)*data(ila+1,ilo )
74 
75 c - HACK
76  return
77  write(6,198)xla,xlo
78  write(6,200)ila,ilo,gla0,glo0
79  write(6,199)xla-gla0,xlo-glo0
80  write(6,201)ila,ilo,gla0,glo0,
81  *data(ila,ilo)
82  write(6,201)ila,ilo+1,gla0,glo0+dlo,
83  *data(ila,ilo+1)
84  write(6,201)ila+1,ilo,gla0+dla,glo0,
85  *data(ila+1,ilo)
86  write(6,201)ila+1,ilo+1,gla0+dla,glo0+dlo,
87  *data(ila+1,ilo+1)
88  write(6,202)'SW',(1.d0-t)*(1.d0-u)
89  write(6,202)'SE',( t)*(1.d0-u)
90  write(6,202)'NW',( t)*( u)
91  write(6,202)'NE',(1.d0-t)*( u)
92  202 format(
93  *'Weight to ',a,' corner = ',f20.15)
94 
95  198 format(
96  *6x,'bilin.f: lat/lon = ',f10.6,1x,f10.6)
97  199 format(
98  *6x,'bilin.f: diff from SW corner of cell = ',f10.6,1x,f10.6)
99  200 format(
100  *6x,'bilin.f: SW corner: ',i6,1x,i6,1x,f10.6,1x,f10.6)
101  201 format(
102  *6x,2(i6,1x),2(f10.6,1x),f20.15)
103 
104 
105 c write(6,801)xla,xlo,ila,ilo,gla0,glo0,t,u,val
106  801 format(f15.8,1x,f15.8,1x,i6,1x,i6,1x,
107  *f15.8,1x,f15.8,1x,f8.6,1x,f8.6,1x,f20.10)
108 
109 c write(6,802)data(ila ,ilo ),
110 c *data(ila ,ilo+1),data(ila+1,ilo+1),
111 c *data(ila+1,ilo )
112  802 format(4(f15.8,1x))
113 
114  return

+ Here is the caller graph for this function:

subroutine biquad ( real*4, dimension(maxla,maxlo)  z,
  glamn,
  glomn,
  dla,
  dlo,
  nla,
  nlo,
  maxla,
  maxlo,
  xla,
  xlo,
  val 
)

Subroutine to perform a 2-D quadratic ("biquadratic") interpolation.

Performs a biquadratic interpolation at location xla,xlo off of grid z, whose header information is the standard ".b" header information

Parameters
[in]zInput Grid
[in]glamnminimum latitude (real*8 decimal degrees)
[in]glomnminimum longitude (real*8 decimal degrees)
[in]dlalatitude spacing (real*8 decimal degrees)
[in]dlolongitude spacing (real*8 decimal degrees)
[in]nlanumber of lat rows (integer*4)
[in]nlonumber of lon cols (integer*4)
[in]maxlaactual dimensioned size of "z" in rows
[in]maxloactual dimensioned size of "z" in cols
[in]xlalat of pt for interpolation (real*8 dec. deg)
[in]xlolon of pt for interpolation (real*8 dec. deg)
[out]valinterpolated value (real*8)

Method:

Fit a 3x3 window over the random point. The closest 2x2 points will surround the point. But based on which quadrant of that 2x2 cell in which the point falls, the 3x3 window could extend NW, NE, SW or SE from the 2x2 cell.

Definition at line 33 of file biquad.f.

Referenced by checkgrid().

33 
34 c - Subroutine to perform a 2-D quadratic ("biquadratic")
35 c - interpolation at location "xla,xlo" off of grid "z", whose
36 c - header information is the standard ".b" header
37 c - information of
38 c - glamn = minimum latitude (real*8 decimal degrees)
39 c - glomn = minimum longitude (real*8 decimal degrees)
40 c - dla = latitude spacing (real*8 decimal degrees)
41 c - dlo = longitude spacing (real*8 decimal degrees)
42 c - nla = number of lat rows (integer*4)
43 c - nlo = number of lon cols (integer*4)
44 c - maxla = actual dimensioned size of "z" in rows
45 c - maxlo = actual dimensioned size of "z" in cols
46 c - Further input:
47 c - xla = lat of pt for interpolation (real*8 dec. deg)
48 c - xlo = lon of pt for interpolation (real*8 dec. deg)
49 c - Output:
50 c - val = interpolated value (real*8)
51 c -
52 c - Method:
53 c - Fit a 3x3 window over the random point. The closest
54 c - 2x2 points will surround the point. But based on which
55 c - quadrant of that 2x2 cell in which the point falls, the
56 c - 3x3 window could extend NW, NE, SW or SE from the 2x2 cell.
57 
58 c - Data is assumed real*4
59  implicit real*8 (a-h,o-z)
60  real*4 z(maxla,maxlo)
61 
62 c - Internal use
63  real*4 x,y,fx0,fx1,fx2,qterp
64 
65 c - Find which row should be LEAST when fitting
66 c - a 3x3 window around xla.
67  difla = (xla - glamn)
68  ratla = difla / (dla/2.d0)
69  ila = int(ratla)+1
70  if(mod(ila,2).ne.0)then
71  jla = (ila+1)/2 - 1
72  else
73  jla = (ila )/2
74  endif
75 c - Fix any edge overlaps
76  if(jla.lt.1)jla = 1
77  if(jla.gt.nla-2)jla = nla-2
78 
79 c - Find which column should be LEAST when fitting
80 c - a 3x3 window around xlo.
81  diflo = (xlo - glomn)
82  ratlo = diflo / (dlo/2.d0)
83  ilo = int(ratlo)+1
84  if(mod(ilo,2).ne.0)then
85  jlo = (ilo+1)/2 - 1
86  else
87  jlo = (ilo )/2
88  endif
89 c - Fix any edge overlaps
90  if(jlo.lt.1)jlo = 1
91  if(jlo.gt.nlo-2)jlo = nlo-2
92 
93 c - In the range of 0(westernmost) to
94 c - 2(easternmost) col, where is our
95 c - random lon value? That is, x must
96 c - be real and fall between 0 and 2.
97 
98  x=(xlo-dlo*(jlo-1)-glomn)/dlo
99 
100  if(x.lt.0.0)then
101  val = 1.d30
102  write(6,100)x,val
103 c stop
104  return
105  endif
106  100 format(
107  *'FATAL in biquad: x<0 : ',f20.10,/,
108  *' --> Returning with val = ',f40.1)
109 
110  if(x.gt.2.0)then
111  val = 1.d30
112  write(6,101)x,val
113 c stop
114  return
115  endif
116  101 format(
117  *'FATAL in biquad: x>2 : ',f20.10,/,
118  *' --> Returning with val = ',f40.1)
119 
120 c - In the range of 0(southernmost) to
121 c - 2(northernmost) row, where is our
122 c - random lat value? That is, x must
123 c - be real and fall between 0 and 2.
124 
125  y=(xla-dla*(jla-1)-glamn)/dla
126 
127  if(y.lt.0.0)then
128  val = 1.d30
129  write(6,102)y,val
130 c stop
131  return
132  endif
133  102 format(
134  *'FATAL in biquad: y<0 : ',f20.10,/,
135  *' --> Returning with val = ',f40.1)
136 
137  if(y.gt.2.0)then
138  val = 1.d30
139  write(6,103)y,val
140 c stop
141  return
142  endif
143  103 format(
144  *'FATAL in biquad: y>2 : ',f20.10,/,
145  *' --> Returning with val = ',f40.1)
146 
147 c - Now do the interpolation. First, build a paraboloa
148 c - east-west the southermost row and interpolate to longitude
149 c - "xlo" (at "x" for 0<x<2). Then do it in the middle
150 c - row, then finally the northern row. The last step
151 c - is to fit a parabola north-south at the three previous
152 c - interpolations, but this time to interpolate to
153 c - latitude "xla" (at "y" for 0<y<2). Obviously we
154 c - could reverse the order, doing 3 north-south parabolas
155 c - followed by one east-east and we'd get the same answer.
156 
157  fx0=qterp(x,z(jla ,jlo),z(jla ,jlo+1),z(jla ,jlo+2))
158  fx1=qterp(x,z(jla+1,jlo),z(jla+1,jlo+1),z(jla+1,jlo+2))
159  fx2=qterp(x,z(jla+2,jlo),z(jla+2,jlo+1),z(jla+2,jlo+2))
160  val=dble(qterp(y,fx0,fx1,fx2))
161 
162 c goto 888
163 
164 c write(6,*) ' '
165 c write(6,*) ' ---------------------------------'
166 c write(6,*) ' Inside biquad.f'
167 c write(6,*) ' '
168 
169 c write(6,*) ' Southern Row of 3x3 window: '
170 c write(6,*) ' jla ,jlo ,z(jla ,jlo ) = ',
171 c *jla ,jlo ,z(jla ,jlo )
172 c write(6,*) ' jla ,jlo+1,z(jla ,jlo+1) = ',
173 c *jla ,jlo+1,z(jla ,jlo+1)
174 c write(6,*) ' jla ,jlo+2,z(jla ,jlo+2) = ',
175 c *jla ,jlo+2,z(jla ,jlo+2)
176 c write(6,*) ' fx0 = ',fx0
177 
178 c write(6,*) ' Middle Row of 3x3 window: '
179 c write(6,*) ' jla+1,jlo ,z(jla+1,jlo ) = ',
180 c *jla+1,jlo ,z(jla+1,jlo )
181 c write(6,*) ' jla+1,jlo+1,z(jla+1,jlo+1) = ',
182 c *jla+1,jlo+1,z(jla+1,jlo+1)
183 c write(6,*) ' jla+1,jlo+2,z(jla+1,jlo+2) = ',
184 c *jla+1,jlo+2,z(jla+1,jlo+2)
185 c write(6,*) ' fx1 = ',fx1
186 
187 c write(6,*) ' Northern Row of 3x3 window: '
188 c write(6,*) ' jla+2,jlo ,z(jla+2,jlo ) = ',
189 c *jla+2,jlo ,z(jla+2,jlo )
190 c write(6,*) ' jla+2,jlo+1,z(jla+2,jlo+1) = ',
191 c *jla+2,jlo+1,z(jla+2,jlo+1)
192 c write(6,*) ' jla+2,jlo+2,z(jla+2,jlo+2) = ',
193 c *jla+2,jlo+2,z(jla+2,jlo+2)
194 c write(6,*) ' fx2 = ',fx2
195 
196 c write(6,*) ' Final interpolated value = ',val
197 
198 c 888 continue
199 
200 
201  return
real function qterp(x, f0, f1, f2)
This function fits a quadratic function through 3 points.
Definition: qterp.f:51

+ Here is the caller graph for this function:

subroutine bwplotcv ( character*3  ele,
character*200  fname,
real*8, dimension(maxplots)  bw,
real*8, dimension(maxplots)  be,
real*8, dimension(maxplots)  bs,
real*8, dimension(maxplots)  bn,
real*4, dimension(maxplots)  jm,
real*4, dimension(maxplots)  b1,
real*4, dimension(maxplots)  b2,
integer*4  maxplots,
character*10  olddtm,
character*10  newdtm,
character*10  region,
character*3  elecap,
  ij,
  igridsec,
character*10, dimension(maxplots)  fn 
)

Subroutine to make GMT calls to do a B/W coverage plot.

Changelog

2016 08 29:

Updated the -R and -B initial calls to 6 decimal places

2016 08 25:

.gmtdefaults4 has been changed so X_ORIGIN is equal to 0.0 Center the plot with "-Xc" at first "psxy" call Remove all "-JM**i+" references, and just use the actual width (jm) that came out of the "getmapbounds" routine and was sent here.

2016 07 21:

Modified use of JM command based on new forced sizes.

2015 02 15:

Updated to allow this subroutine to work earlier (in makeplotfiles01()), before igridsec was defined. See DRU-11, p. 139

Definition at line 30 of file bwplotcv.f.

References plotcoast().

Referenced by makeplotfiles01(), makeplotfiles02(), and makeplotfiles03().

30 
31 c - 2016 08 29:
32 c Updated the -R and -B initial calls to 6 decimal places
33 
34 c - 2016 08 25:
35 c .gmtdefaults4 has been changed so X_ORIGIN is equal to 0.0
36 c Center the plot with "-Xc" at first "psxy" call
37 c Remove all "-JM**i+" references, and just use the actual
38 c width (jm) that came out of the "getmapbounds" routine and
39 c was sent here.
40 
41 c - 2016 07 21:
42 c - Modified use of JM command based on new forced sizes.
43 
44 c - Subroutine to make GMT calls to do a B/W coverage plot
45 
46 c - Updated 10/2/2015 to allow this subroutine to work
47 c - earlier (in makeplotfiles01.f), before "igridsec" was defined.
48 c - See DRU-11, p. 139
49 
50  integer*4 maxplots
51  character*3 ele,elecap
52  character*200 fname
53  character*10 olddtm,newdtm,region
54  real*8 bw(maxplots),be(maxplots),bs(maxplots),bn(maxplots)
55  real*4 jm(maxplots)
56  real*4 b1(maxplots),b2(maxplots)
57  character*10 fn(maxplots)
58  character*5 extra
59  character*20 gridnote
60 
61 c ----------------------------------------------------
62 c - All coverage type files begin with "cv".
63 c - The 3rd element tells me all, thinned, dropped or RMS
64 c - The 4th/5th elements tell me if these are coordinate
65 c - differneces or double differences. Elements 6,7,8
66 c - tell me what data we're plotting.
67 c ----------------------------------------------------
68 
69 
70 c ----------------------------------------------------
71 c - FAILSAFES: BEGIN
72 c ----------------------------------------------------
73  if(fname(3:3).eq.'t')then
74  extra='-thin'
75  elseif(fname(3:3).eq.'d')then
76  extra='-drop'
77  elseif(fname(3:3).eq.'a')then
78  extra='-all '
79  elseif(fname(3:3).eq.'r')then
80  extra='-RMSd'
81  else
82  write(6,1)trim(fname)
83  stop
84  endif
85  1 format('FATAL in bwplotcv. Bad character in spot 3: ',a)
86 
87  if(fname(1:2).ne.'cv')then
88  write(6,2)trim(fname)
89  stop
90  endif
91  2 format('FATAL in bwplotcv. Bad character in spots 1-2: ',a)
92 
93  if(.not.(fname(4:5).eq.'cd' .or. fname(4:5).eq.'dd'))then
94  write(6,3)trim(fname)
95  stop
96  endif
97  3 format('FATAL in bwplotcv. Bad character in spots 4-5: ',a)
98 
99  if(fname(6:8).ne.ele)then
100  write(6,4)trim(fname),ele
101  stop
102  endif
103  4 format('FATAL in bwplotcv. Bad match of fname / ele: ',a,1x,a)
104 
105 c - Just in case we forgot to set "igridsec" to be -1
106 c - when we came here from makeplotfiles01:
107  if(fname(1:3).eq.'cvacd')then
108  igridsec = -1
109  endif
110 
111  if(igridsec.le.0)then
112  gridnote = ''
113  else
114  write(gridnote,10)igridsec
115  endif
116  10 format('(',i0,' sec)')
117 
118 
119 
120 c ----------------------------------------------------
121 c - FAILSAFES: END
122 c ----------------------------------------------------
123 
124 
125 
126 c ----------------------------------------------
127 c - GMT COMMANDS: BEGIN
128 c ----------------------------------------------
129 
130 c - Header of commands/echoes:
131  write(99,991)ele,extra,trim(region),trim(fn(ij)),
132  *ele,extra,trim(region),trim(fn(ij))
133 
134 c - Write out the actual dots, and the title, with PSXY command
135  write(99,904)trim(fname),bw(ij),be(ij),bs(ij),bn(ij),
136  *jm(ij),b1(ij),b2(ij),trim(newdtm),trim(olddtm),elecap,
137  *extra,trim(gridnote),trim(region),trim(fn(ij))
138 
139 c - ALWAYS plot the coast last, as it closes the PS file
140  call plotcoast(region,99)
141 
142 c - Convert PS to JPG
143  write(99,905)
144 
145 c - Rename the JPG to my naming scheme
146  write(99,910)trim(fname),trim(fn(ij))
147 c ----------------------------------------------
148 c - GMT COMMANDS: END
149 c ----------------------------------------------
150 
151 
152 
153  991 format(
154  *'# -----------------------------------------------------',/,
155  *'# coverage in ',a,a,1x,a,1x,a,/,
156  *'# -----------------------------------------------------',/,
157  *'echo ...coverage in ',a,a,1x,a,1x,a)
158 
159 
160 c - Plot the actual coverage points
161 c - 2016 08 29
162  904 format('psxy ',a,' -Xc -R',f0.6,'/',f0.6,'/',sp,f0.6,'/',f0.6,
163  * ss,' -JM',f3.1,'i -B',f0.6,'/',f0.6,':."',
164  * 'NADCON v5.0 ',a,' minus ',a,' ',a3,a5,a,
165  * 1x,a,'-',a,
166  * '": -Sc0.02i ',
167  * '-Gblack -K > plot.ps')
168 
169 
170 
171 c - 2016 08 25:
172 c 904 format('psxy ',a,' -Xc -R',f0.2,'/',f0.2,'/',sp,f0.2,'/',f0.2,
173 c * ss,' -JM',f3.1,'i -B',f0.2,'/',f0.2,':."',
174 c * 'NADCON v5.0 ',a,' minus ',a,' ',a3,a5,a,
175 c * 1x,a,'-',a,
176 c * '": -Sc0.02i ',
177 c * '-Gblack -K > plot.ps')
178 c - 2016 07 21
179 c 904 format('psxy ',a,' -R',f0.2,'/',f0.2,'/',sp,f0.2,'/',f0.2,
180 c * ss,' -JM',f3.1,'i -B',f0.2,'/',f0.2,':."',
181 c * 'NADCON v5.0 ',a,' minus ',a,' ',a3,a5,a,
182 c * 1x,a,'-',a,
183 c * '": -Sc0.02i ',
184 c * '-Gblack -K > plot.ps')
185 c 904 format('psxy ',a,' -R',f0.2,'/',f0.2,'/',sp,f0.2,'/',f0.2,
186 c * ss,' -JM',f3.1,'i+ -B',f0.2,'/',f0.2,':."',
187 c * 'NADCON v5.0 ',a,' minus ',a,' ',a3,a5,a,
188 c * 1x,a,'-',a,
189 c * '": -Sc0.02i ',
190 c * '-Gblack -K > plot.ps')
191 
192 c - 905 = Convert PS to JPG
193  905 format('ps2raster plot.ps -Tj -P -A ')
194 
195 
196 c - Renaming
197  910 format('mv -f plot.jpg ',a,'.',a,'.jpg',/,
198  *'rm -f plot.ps')
199 c 910 format('mv -f plot.jpg cv',a1,a3,'.',a,'.',a,'.',a,
200 c *'.',i0,'.',a,'.jpg',/,'rm -f plot.ps')
201  1910 format('mv -f plot.jpg cv',a3,'.',a,'.',a,'.',a,
202  *'.',a,'.jpg',/,'rm -f plot.ps')
203 
204  return
subroutine plotcoast(region, ifnum)
Subroutine to write GMT-based commands to create a shoreline Write GMT-based commands to create a sho...
Definition: plotcoast.f:44

+ Here is the call graph for this function:

+ Here is the caller graph for this function:

subroutine bwplotvc ( character*3  ele,
character*200  fname,
real*8, dimension(maxplots)  bw,
real*8, dimension(maxplots)  be,
real*8, dimension(maxplots)  bs,
real*8, dimension(maxplots)  bn,
real*4, dimension(maxplots)  jm,
real*4, dimension(maxplots)  b1,
real*4, dimension(maxplots)  b2,
integer*4  maxplots,
character*10  olddtm,
character*10  newdtm,
character*10  region,
character*3  elecap,
  ij,
  xvlon,
  xvlat,
  xllon,
  xllat,
real*8  lorvog,
real*8  lorvopc,
  igridsec,
character*10, dimension(maxplots)  fn 
)

Subroutine to make GMT calls to do a B/W vector plot.

Changelog

2016 08 29:

Expanded the refence vector calls to be 6 decimal places, as well as the initial -R call for S/N/W/E and also the -B part of that call

2016 08 25:

.gmtdefaults4 has been changed so X_ORIGIN is equal to 0.0 Center the plot with "-Xc" at first "psxy" call Remove all "-JM**i+" references, and just use the actual width (jm) that came out of the "getmapbounds" routine and was sent here.

2016 07 29:

Updated the reference vector call to have the "-N" option, so it'll plot outside the map

2016 07 21:

Modified use of JM command based on new forced sizes.

2015 02 15:

Updated to allow this subroutine to work earlier (in makeplotfiles01()), before igridsec was defined. See DRU-11, p. 139

Definition at line 37 of file bwplotvc.f.

References plotcoast().

Referenced by checkgrid(), makeplotfiles01(), makeplotfiles02(), and makeplotfiles03().

37 
38 c - 2016 08 29:
39 c Expanded the refence vector calls to be 6 decimal places, as well
40 c as the initial -R call for S/N/W/E
41 c and also the -B part of that call
42 
43 c - 2016 08 25:
44 c .gmtdefaults4 has been changed so X_ORIGIN is equal to 0.0
45 c Center the plot with "-Xc" at first "psxy" call
46 c Remove all "-JM**i+" references, and just use the actual
47 c width (jm) that came out of the "getmapbounds" routine and
48 c was sent here.
49 
50 
51 c - 2016 07 29: Updated the reference vector call to
52 c - have the "-N" option, so it'll plot outside the map
53 
54 c - 2016 07 21: Updated JM usage for new forced sizes
55 
56 c subroutine bwplotvc(ele,fname,bw,be,bs,bn,jm,b1,b2,maxplots,
57 c *olddtm,newdtm,region,elecap,ij,xvlon,xvlat,xllon,xllat,ncm,
58 c *q1,igridsec,fn)
59 c - Subroutine to make GMT calls to do a B/W vector plot
60 
61 c - Updated 10/2/2015 to allow this subroutine to work
62 c - earlier (in makeplotfiles01.f), before "igridsec" was defined.
63 c - See DRU-11, p. 139
64 
65  implicit real*8(a-h,o-z)
66  integer*4 maxplots
67  character*3 ele,elecap
68  character*200 fname
69  character*10 olddtm,newdtm,region
70  real*8 bw(maxplots),be(maxplots),bs(maxplots),bn(maxplots)
71  real*4 jm(maxplots)
72  real*4 b1(maxplots),b2(maxplots)
73  character*10 fn(maxplots)
74  character*5 extra
75  character*20 units
76  character*20 gridnote
77  character*20 gridnote2
78 
79  real*8 lorvopc,lorvog
80 
81 c ----------------------------------------------------
82 c - All vector type files begin with either "vm"
83 c - (meters) or "vs" (arcseconds).
84 c - The 3rd element tells me all, thinned, dropped or RMS
85 c - The 4th/5th elements tell me if these are coordinate
86 c - differnces or double differences. Elements 6,7,8
87 c - tell me what data we're plotting.
88 c ----------------------------------------------------
89 
90 
91 c ----------------------------------------------------
92 c - FAILSAFES: BEGIN
93 c ----------------------------------------------------
94  if(fname(3:3).eq.'t')then
95  extra='-thin'
96  elseif(fname(3:3).eq.'d')then
97  extra='-drop'
98  elseif(fname(3:3).eq.'a')then
99  extra='-all '
100  elseif(fname(3:3).eq.'r')then
101  extra='-RMSd'
102  else
103  write(6,1)trim(fname)
104  stop
105  endif
106  1 format('FATAL in bwplotvc. Bad character in spot 3: ',a)
107 
108  if(.not.(fname(1:2).eq.'vm'.or.fname(1:2).eq.'vs'))then
109  write(6,2)trim(fname)
110  stop
111  endif
112  2 format('FATAL in bwplotvc. Bad character in spots 1-2: ',a)
113 
114  if(.not.(fname(4:5).eq.'cd' .or. fname(4:5).eq.'dd' .or.
115  * fname(4:5).eq.'gi'))then
116  write(6,3)trim(fname)
117  stop
118  endif
119  3 format('FATAL in bwplotvc. Bad character in spots 4-5: ',a)
120 
121  if(fname(6:8).ne.ele)then
122  write(6,4)trim(fname),ele
123  stop
124  endif
125  4 format('FATAL in bwplotvc. Bad match of fname / ele: ',a,1x,a)
126 
127 c - Just in case we forgot to set "igridsec" to be -1
128 c - when we came here from makeplotfiles01:
129  if(fname(1:3).eq.'vmacd' .or. fname(1:3).eq.'vsacd')then
130  igridsec = -1
131  endif
132 
133  if (fname(2:2).eq.'m')then
134  units='meters'
135  elseif(fname(2:2).eq.'s')then
136  units='arcseconds'
137  else
138  write(6,5)trim(fname)
139  stop
140  endif
141  5 format('FATAL in bwplotvc. Bad units in name: ',a)
142 
143  if(igridsec.le.0)then
144  gridnote = ''
145  gridnote2 = ''
146  else
147  write(gridnote,10)igridsec
148  write(gridnote2,11)igridsec
149  endif
150  10 format('(',i0,' sec)')
151  11 format(i0,'.')
152 
153 c ----------------------------------------------------
154 c - FAILSAFES: END
155 c ----------------------------------------------------
156 
157 
158 c ----------------------------------------------
159 c - GMT COMMANDS: BEGIN
160 c ----------------------------------------------
161 
162 c - Header of commands/echoes:
163  write(99,991)ele,extra,trim(units),trim(region),trim(fn(ij)),
164  *ele,extra,trim(units),trim(region),trim(fn(ij))
165 
166 c - Plot the actual vectors, and the title, with PSXY command
167  write(99,903)trim(fname),bw(ij),be(ij),bs(ij),bn(ij),
168  *jm(ij),b1(ij),b2(ij),trim(newdtm),trim(olddtm),elecap,
169  *extra,trim(gridnote),trim(region),trim(fn(ij)),fname(2:5)
170 
171 
172 
173 c - Plot the reference vector
174  write(99,908)xvlon,xvlat,90.d0,lorvopc
175 c write(99,908)xvlon,xvlat,90.d0,q1
176 
177 c - Label the reference vector
178 c - HACK
179 c write(6,807)trim(fname),trim(units)
180 c 807 format('File: ',a,/,'Units: ',a)
181  if (trim(units).eq.'arcseconds')then
182  write(99,1909)xllon,xllat,lorvog,trim(units)
183  elseif(trim(units).eq.'meters')then
184  write(99, 909)xllon,xllat,lorvog,trim(units)
185  endif
186 
187 c - ALWAYS plot the coast last, as it closes the PS file
188  call plotcoast(region,99)
189 
190 c - Convert PS to JPG
191  write(99,905)
192 
193 c - Rename the JPG to my naming scheme
194 c write(99,906)trim(fname),trim(gridnote2),trim(fn(ij))
195  write(99,906)trim(fname),trim(fn(ij))
196 
197 c ----------------------------------------------
198 c - GMT COMMANDS: END
199 c ----------------------------------------------
200 
201  991 format(
202  *'# -----------------------------------------------------',/,
203  *'# vectors in ',a,a,1x,a,1x,a,1x,a,/,
204  *'# -----------------------------------------------------',/,
205  *'echo ...vectors in ',a,a,1x,a,1x,a,1x,a)
206 
207 c - Plot the actual vectors
208 c - 2016 08 29
209  903 format('psxy ',a,' -Xc -R',f0.6,'/',f0.6,'/',sp,f0.6,'/',f0.6,
210  * ss,' -JM',f3.1,'i -B',f0.6,'/',f0.6,':."',
211  * 'NADCON v5.0 ',a,' minus ',a,' ',a3,a5,a,
212  * 1x,a,'-',a,1x,a,
213  *'": -SV0.0001i/0.02i/0.02i ',
214  * '-Gblack -K > plot.ps')
215 c - 2016 08 25:
216 c 903 format('psxy ',a,' -Xc -R',f0.2,'/',f0.2,'/',sp,f0.2,'/',f0.2,
217 c * ss,' -JM',f3.1,'i -B',f0.2,'/',f0.2,':."',
218 c * 'NADCON v5.0 ',a,' minus ',a,' ',a3,a5,a,
219 c * 1x,a,'-',a,1x,a,
220 c *'": -SV0.0001i/0.02i/0.02i ',
221 c * '-Gblack -K > plot.ps')
222 
223 c 903 format('psxy ',a,' -R',f0.2,'/',f0.2,'/',sp,f0.2,'/',f0.2,
224 c * ss,' -JM',f3.1,'i -B',f0.2,'/',f0.2,':."',
225 c * 'NADCON v5.0 ',a,' minus ',a,' ',a3,a5,a,
226 c * 1x,a,'-',a,1x,a,
227 c *'": -SV0.0001i/0.02i/0.02i ',
228 c * '-Gblack -K > plot.ps')
229 c 903 format('psxy ',a,' -R',f0.2,'/',f0.2,'/',sp,f0.2,'/',f0.2,
230 c * ss,' -JM',f3.1,'i+ -B',f0.2,'/',f0.2,':."',
231 c * 'NADCON v5.0 ',a,' minus ',a,' ',a3,a5,a,
232 c * 1x,a,'-',a,1x,a,
233 c *'": -SV0.0001i/0.02i/0.02i ',
234 c * '-Gblack -K > plot.ps')
235 
236 c - 908 = Plot a REFERENCE vector
237 c - 2016 08 29: More decimal places
238  908 format('psxy -SV0.0001i/0.02i/0.02i -N -R -O -K -JM',
239  * ' -Gred >> plot.ps << !',/,
240  * f10.6,1x,f10.6,1x,f5.1,1x,f9.1,/,
241  * '!')
242 c - 2016 07 29: Make reference vector appear outside of map
243 c 908 format('psxy -SV0.0001i/0.02i/0.02i -N -R -O -K -JM',
244 c * ' -Gred >> plot.ps << !',/,
245 c * f6.2,1x,f6.2,1x,f5.1,1x,f9.1,/,
246 c * '!')
247 c 908 format('psxy -SV0.0001i/0.02i/0.02i -R -O -K -JM',
248 c * ' -Gred >> plot.ps << !',/,
249 c * f6.2,1x,f6.2,1x,f5.1,1x,f9.1,/,
250 c * '!')
251 
252 c - 909 = Label the REFERENCE vector
253 c - 2016 08 29: More decimal places
254  909 format('pstext -N -O -K -R -JM -Gred >> plot.ps << !',/,
255  * f10.6,1x,f10.6,1x,'12 0 1 TL ',f10.3,1x,a,/,
256  * '!')
257 c - 2016 07 29: Use -N to plot it outside
258 c 909 format('pstext -N -O -K -R -JM -Gred >> plot.ps << !',/,
259 c * f6.2,1x,f6.2,1x,'12 0 1 TL ',f10.3,1x,a,/,
260 c * '!')
261 c - 2016 08 29: More decimal places
262  1909 format('pstext -N -O -K -R -JM -Gred >> plot.ps << !',/,
263  * f10.6,1x,f10.6,1x,'12 0 1 TL ',f10.6,1x,a,/,
264  * '!')
265 c1909 format('pstext -N -O -K -R -JM -Gred >> plot.ps << !',/,
266 c * f6.2,1x,f6.2,1x,'12 0 1 TL ',f10.6,1x,a,/,
267 c * '!')
268 c 909 format('pstext -O -K -R -JM -Gred >> plot.ps << !',/,
269 c * f6.2,1x,f6.2,1x,'12 0 1 TL ',f10.3,1x,a,/,
270 c * '!')
271 c1909 format('pstext -O -K -R -JM -Gred >> plot.ps << !',/,
272 c * f6.2,1x,f6.2,1x,'12 0 1 TL ',f10.6,1x,a,/,
273 c * '!')
274 
275 c 909 format('pstext -O -K -R -JM -Gred >> plot.ps << !',/,
276 c * f6.2,1x,f6.2,1x,'12 0 1 TL ',i6,' cm',/,
277 c * '!')
278 
279 c - 905 = Convert PS to JPG
280  905 format('ps2raster plot.ps -Tj -P -A ')
281 
282 c - Rename to our naming scheme
283 c 906 format('mv -f plot.jpg ',a,
284 c *'.',a,a,'.jpg',/,'rm -f plot.ps')
285  906 format('mv -f plot.jpg ',a,
286  *'.',a,'.jpg',/,'rm -f plot.ps')
287 
288  return
subroutine plotcoast(region, ifnum)
Subroutine to write GMT-based commands to create a shoreline Write GMT-based commands to create a sho...
Definition: plotcoast.f:44

+ Here is the call graph for this function:

+ Here is the caller graph for this function:

program convlv ( )

Part of the NADCON5 NADCON5 Core Library , Convolves two grids.

Convolves one grid against another

\[ c(i,j) = a(i,j) * b(i,j) \]

Program arguments

Arguments are newline terminated and read from standard input

When run from the command line, the program prints a prompt for each argument

They are enumerated here

Parameters
infileAFirst Input File Name
infileBSecond Input File Name
outfileOutput File Name of A*B

Program Inputs:

  • lin1 Input File A
  • lin2 Input File B
  • lout Output File to Write A+B

Definition at line 29 of file convlv.f.

subroutine coplot ( character*3  ele,
character*200  fname,
real*8, dimension(maxplots)  bw,
real*8, dimension(maxplots)  be,
real*8, dimension(maxplots)  bs,
real*8, dimension(maxplots)  bn,
real*4, dimension(maxplots)  jm,
real*4, dimension(maxplots)  b1,
real*4, dimension(maxplots)  b2,
integer*4  maxplots,
character*10  olddtm,
character*10  newdtm,
character*10  region,
character*3  elecap,
  ij,
  cptlo,
  cpthi,
  cptin6,
character*200  suffixused,
  igridsec,
character*10, dimension(maxplots)  fn 
)

Subroutine to make GMT calls to do Color Raster Rendering of Gridded Data.

Changelog

2016 09 08:

Had to up the D_FORMAT default to %.3G because tight scalebar ranges with the newly allowed "more free" average values were showing repeating values when only 2 digits could be shown.

2016 09 07:

Had to add lines pre/post "makecpt" to change the D_FORMAT. This is because I had been forcing the "scave" in cpt.f to be ONZD. But that yielded bad values sometimes, so I switched it. With that switch, the scave could have lots of digits. Well, that means the newly adopted "D_FORMAT" of %.2G was insufficient for the CPT table. Who knew that D_FORMAT affected that! Anyway, so change "D_FORMAT" pre/post all makecpt calls.

2016 08 30:

See item #39 in Google ToDo list Changed "grdcontour" to have a blank "-R" call so it'll mimic whatever decimal places are in the "grdimage" call that came before it.

2016 08 29:

Updated the initial -R and -B calls to 6 decimal places

2016 08 25:

-.gmtdefaults4 has been changed so X_ORIGIN is equal to 0.0

  • Center the plot with "-Xc" at grdimage
  • Center the scalebar by setting its Xcoordinate, which runs in "plot frame" coordinates (0/0 at lower left) , to be equal to "jm/2"
  • Force the scale bar to be exactly 4 inches wide, always
  • Change the format for "makecpt" from 0.6 to 0.10

2016 07 29:

Update to put more data into comment/echo

Also,

  • forced the -Ctemp.cpt option in "grdcontour" to make the contours line up with the color palette
  • For d3 plots, to drop all contours
  • For d3 plots to only use "coverage" part only if "ij" is not "1"
  • Same for "09" and "ete" grids

2016 07 21:

  • Set the "JM" code in "grdcontour" to just be "-JM" and let it therefore run with whatever JM size is used in "grdimage"
  • Set the "A" code in "grdcontour" to be "-A-" which should turn off the labels on all contours
  • Fixed size of scale bar

2016 03 01:

  1. Changed to a continuous color plot
    • Get rid of "-Z" in "makecpt"
  2. Changed to an 8 color, from 6 color, plot (without changing the RANGE yet...see DRU-12, p. 19)
    • Change varible that comes in from "cptin" to "cptin6"
    • Compute cptin = cptin6 * 0.75d0 immediately

Update 2016 02 29:

  1. Removed all shading from color plots
    • Get rid of "grdgradient" call
    • Remove from "grdimage" the "-Itempi.grd" part
    • Remove the "rm -f tempi.grd" line

Definition at line 74 of file coplot.f.

References plotcoast().

Referenced by makeplotfiles02(), and makeplotfiles03().

74 
75 c - 2016 09 08
76 c Had to up the D_FORMAT default to %.3G because tight scalebar ranges
77 c with the newly allowed "more free" average values were showing
78 c repeating values when only 2 digits could be shown.
79 
80 c - 2016 09 07
81 c Had to add lines pre/post "makecpt" to change the D_FORMAT. This is because
82 c I *had* been forcing the "scave" in cpt.f to be ONZD. But that yielded
83 c bad values sometimes, so I switched it. With that switch, the scave could
84 c have lots of digits. Well, that means the newly adopted "D_FORMAT" of %.2G
85 c was insufficient for the CPT table. Who knew that D_FORMAT affected that!
86 c Anyway, so change "D_FORMAT" pre/post all makecpt calls.
87 
88 c - 2016 08 30: See item #39 in Google ToDo list
89 c Changed "grdcontour" to have a blank "-R" call so it'll mimic whatever
90 c decimal places are in the "grdimage" call that came before it.
91 
92 c - 2016 08 29:
93 c Updated the initial -R and -B calls to 6 decimal places
94 
95 c - 2016 08 25:
96 c .gmtdefaults4 has been changed so X_ORIGIN is equal to 0.0
97 c Center the plot with "-Xc" at grdimage
98 c Center the scalebar by setting its Xcoordinate, which runs in "plot frame"
99 c coordinates (0/0 at lower left) , to be equal to "jm/2"
100 c Force the scale bar to be exactly 4 inches wide, always
101 c Change the format for "makecpt" from 0.6 to 0.10
102 
103 c - 2016 07 29:
104 c Update to put more data into comment/echo
105 c Also forced the -Ctemp.cpt option in "grdcontour" to make the contours line up with the color palette
106 
107 c For d3 plots, to drop all contours
108 c For d3 plots to only use "coverage" part *only* if "ij" is not "1"
109 c Same for "09" and "ete" grids
110 
111 
112 c subroutine coplot(ele,fname,bw,be,bs,bn,jm,b1,b2,maxplots,
113 c *olddtm,newdtm,region,elecap,ij,cptlo,cpthi,cptin,suffixused,
114 c *igridsec,fn)
115 
116 c - Update 2016 07 21:
117 c - Set the "JM" code in "grdcontour" to just be "-JM" and let it therefore
118 c run with whatever JM size is used in "grdimage"
119 c - Set the "A" code in "grdcontour" to be "-A-" which should turn off
120 c the labels on all contours
121 c - Fixed size of scale bar
122 
123 c - Update 2016 03 01:
124 c - 1) Changed to a continuous color plot
125 c * Get rid of "-Z" in "makecpt"
126 c 2) Changed to an 8 color, from 6 color, plot (without changing the RANGE yet...see DRU-12, p. 19)
127 c * Change varible that comes in from "cptin" to "cptin6"
128 c * Compute cptin = cptin6 * 0.75d0 immediately
129 
130 c - Update 2016 02 29:
131 c - 1) Removed all shading from color plots
132 c * Get rid of "grdgradient" call
133 c * Remove from "grdimage" the "-Itempi.grd" part
134 c * Remove the "rm -f tempi.grd" line
135 
136 
137 c subroutine coplot(ele,fname,bw,be,bs,bn,jm,b1,b2,maxplots,
138 c *olddtm,newdtm,region,elecap,ij,cptlo,cpthi,cptin,suffix2,
139 c *igridsec,fn)
140 
141 c subroutine coplot(ele,fname,bw,be,bs,bn,jm,b1,b2,maxplots,
142 c *olddtm,newdtm,region,elecap,ij,ave,std,suffix2,igridsec,fn)
143 
144  implicit real*8(a-h,o-z)
145 
146 c - Subroutine to make GMT calls to do a color raster rendering
147 c - of gridded data
148 
149  integer*4 maxplots
150  character*3 ele,elecap
151  character*200 fname
152  character*10 olddtm,newdtm,region
153  real*8 bw(maxplots),be(maxplots),bs(maxplots),bn(maxplots)
154  real*4 jm(maxplots)
155  real*4 b1(maxplots),b2(maxplots)
156  character*10 fn(maxplots)
157  real*8 ave,std
158  character*200 suffixused
159  character*20 units
160  character*20 gridnote
161  character*20 gridnote2
162 
163 c ----------------------------------------------------
164 c - FAILSAFES: BEGIN
165 c ----------------------------------------------------
166  if(.not.(fname(1:3).eq.'vmt'.or.fname(1:3).eq.'vst' .or.
167  * fname(1:3).eq.'vmr'.or.fname(1:3).eq.'vsr' .or.
168  * fname(1:3).eq.'vme'.or.fname(1:3).eq.'vse'))then
169  write(6,2)trim(fname)
170  stop
171  endif
172  2 format('FATAL in coplot. Bad character in spots 1-3: ',a)
173 
174  if(.not.(fname(4:5).eq.'cd' .or. fname(4:5).eq.'dd' .or.
175  * fname(4:5).eq.'te' ))then
176  write(6,3)trim(fname)
177  stop
178  endif
179  3 format('FATAL in coplot. Bad character in spots 4-5: ',a)
180 
181  if(fname(6:8).ne.ele)then
182  write(6,4)trim(fname),ele
183  stop
184  endif
185  4 format('FATAL in coplot. Bad match of fname / ele: ',a,1x,a)
186 
187  if(fname(2:2).eq.'m')then
188  units='meters'
189  elseif(fname(2:2).eq.'s')then
190  units='arcseconds'
191  else
192  write(6,5)trim(fname)
193  stop
194  endif
195  5 format('FATAL in coplot. Bad units in name: ',a)
196 
197  if(igridsec.le.0)then
198  write(6,6)igridsec
199  else
200  write(gridnote,10)igridsec
201  write(gridnote2,11)igridsec
202  endif
203  6 format('FATAL in coplot. Bad igridsec: ',i0)
204  10 format('(',i0,' sec)')
205  11 format(i0,'.')
206 
207 c ----------------------------------------------------
208 c - FAILSAFES: END
209 c ----------------------------------------------------
210 
211 c ------------------------------------------------------------------
212 c - Contour interval and labeling
213 c ------------------------------------------------------------------
214 c - 2016 07 29: Just use cptin6 as it came in
215  cptin = cptin6
216 c - Begin 2016 03 01
217 c cptin = cptin6 * 0.75d0
218 c - End 2016 03 01
219 
220  conin = cptin
221  conlb = conin / 2.d0
222 
223 c ----------------------------------------------
224 c - GMT COMMANDS: BEGIN
225 c ----------------------------------------------
226 
227 
228 c - Header of commands/echoes:
229 c - 2016 07 29:
230  write(99,991)ele,trim(units),trim(region),trim(fn(ij)),
231  *trim(suffixused),
232  *ele,trim(units),trim(region),trim(fn(ij)),
233  *trim(suffixused)
234 c write(99,991)ele,trim(units),trim(region),trim(fn(ij)),
235 c *ele,trim(units),trim(region),trim(fn(ij))
236 
237 c - GMT call to create the color palette:
238 c - Store the palette as file "temp.cpt", to be
239 c - deleted later.
240  write(99,901)cptlo,cpthi,cptin
241 
242 c - Begin 2016 03 01:
243 c 901 format(
244 c *'makecpt -Crainbow -T',f0.6,'/',f0.6,'/',f0.6,
245 c *' -Z > temp.cpt')
246 c 901 format(
247 c *'makecpt -Crainbow -T',f0.6,'/',f0.6,'/',f0.6,
248 c *' > temp.cpt')
249 c - 2016 08 25
250 c 901 format(
251 c *'makecpt -Crainbow -T',f0.10,'/',f0.10,'/',f0.10,
252 c *' > temp.cpt')
253 c - 2016 09 07
254 c 901 format(
255 c *'gmtset D_FORMAT %.12G',/,
256 c *'makecpt -Crainbow -T',f0.10,'/',f0.10,'/',f0.10,
257 c *' > temp.cpt',/,
258 c *'gmtset D_FORMAT %.2G')
259 c - 2016 09 08
260  901 format(
261  *'gmtset D_FORMAT %.12G',/,
262  *'makecpt -Crainbow -T',f0.10,'/',f0.10,'/',f0.10,
263  *' > temp.cpt',/,
264  *'gmtset D_FORMAT %.3G')
265 
266 c - GMT call to create the gradient file from
267 c - the "grd" formatted version of our input grid.
268 c - Store the gradients as file "tempi.grd" to be
269 c - deleted later.
270 
271 c - Updated 2016 02 29:
272 c write(99,902)fname(1:8),trim(suffixused)
273  902 format(
274  *'grdgradient ',a,'.',a,
275  *'.grd -N4.8 -A90 -M -Gtempi.grd')
276 c - Until here 2016 02 29
277 
278 c - GMT call to create the color render of the
279 c - gridded data. Store as file "plot.ps"
280 c - to be deleted later.
281 
282  write(99,903)fname(1:8),trim(suffixused),
283  *bw(ij),be(ij),bs(ij),bn(ij),
284  *jm(ij),b1(ij),b2(ij),
285  *trim(newdtm),trim(olddtm),elecap,igridsec,
286  *trim(region),trim(fn(ij)),fname(2:5)
287 
288 
289 c - Commented this out for 2016 03 01:
290 c 903 format(
291 c *'grdimage ',a,'.',a,'.grd',
292 c *' -Ei -Itempi.grd',
293 c *' -R',f0.2,'/',f0.2,'/',f0.2,'/',f0.2,
294 c *' -JM',f3.1,'i -B',f0.2,'/',f0.2,
295 c *':."NADCON v5.0 ',a,' minus ',a,' ',a3,
296 c *'(',i0,' sec)',
297 c *1x,a,'-',a,1x,a,
298 c *':" -Ctemp.cpt -K > plot.ps')
299 c 903 format(
300 c *'grdimage ',a,'.',a,'.grd',
301 c *' -Ei ',
302 c *' -R',f0.2,'/',f0.2,'/',f0.2,'/',f0.2,
303 c *' -JM',f3.1,'i -B',f0.2,'/',f0.2,
304 c *':."NADCON v5.0 ',a,' minus ',a,' ',a3,
305 c *'(',i0,' sec)',
306 c *1x,a,'-',a,1x,a,
307 c *':" -Ctemp.cpt -K > plot.ps')
308 c - Below for 2016 08 25:
309 c 903 format(
310 c *'grdimage ',a,'.',a,'.grd',
311 c *' -Ei -Xc',
312 c *' -R',f0.2,'/',f0.2,'/',f0.2,'/',f0.2,
313 c *' -JM',f3.1,'i -B',f0.2,'/',f0.2,
314 c *':."NADCON v5.0 ',a,' minus ',a,' ',a3,
315 c *'(',i0,' sec)',
316 c *1x,a,'-',a,1x,a,
317 c *':" -Ctemp.cpt -K > plot.ps')
318 c - 2016 08 29:
319  903 format(
320  *'grdimage ',a,'.',a,'.grd',
321  *' -Ei -Xc',
322  *' -R',f0.6,'/',f0.6,'/',f0.6,'/',f0.6,
323  *' -JM',f3.1,'i -B',f0.6,'/',f0.6,
324  *':."NADCON v5.0 ',a,' minus ',a,' ',a3,
325  *'(',i0,' sec)',
326  *1x,a,'-',a,1x,a,
327  *':" -Ctemp.cpt -K > plot.ps')
328 
329 c - GMT call to put a color scale on the map. Add it
330 c - to file "plot.ps".
331 
332 c - 2016 07 21
333 c write(99,904)trim(units)
334 c qqa = jm(ij) - 1.d0
335 c qqb = qqa / 2.d0
336 c write(99,904)qqb,qqa,trim(units)
337 c - 2016 08 25
338  qqa = jm(ij)/2
339  write(99,904)qqa,trim(units)
340 
341  904 format(
342  *'psscale -D',f3.1,'i/-0.4i/4.0i/0.2ih',
343  *' -Ctemp.cpt -I0.4 -B/:',a,
344  *': -O -K >> plot.ps')
345 
346 c 904 format(
347 c *'psscale -D4i/-0.4i/8i/0.2ih -Ctemp.cpt -I0.4 -B/:',a,
348 c *': -O -K >> plot.ps')
349 
350 
351 
352 c - GMT call to put contours on the map.
353 c - 2016 07 29
354 c - 2016 07 21
355 
356 c 2016 07 29: skip contours if this is a d3, 09 or "ete" plot
357  ll = len(trim(suffixused))
358  if(suffixused(ll-1:ll).eq.'d3')goto 807
359  if(suffixused(ll-1:ll).eq.'09')goto 807
360  if(fname(3:5).eq.'ete')goto 807
361 
362 
363 
364  write(99,908)fname(1:8),trim(suffixused)
365 
366 c write(99,908)fname(1:8),trim(suffixused),
367 c *bw(ij),be(ij),bs(ij),bn(ij)
368 c write(99,908)fname(1:8),trim(suffixused),conin,
369 c *bw(ij),be(ij),bs(ij),bn(ij)
370 c write(99,908)fname(1:8),trim(suffixused),conin,
371 c *bw(ij),be(ij),bs(ij),bn(ij),
372 c *jm(ij),conlb
373 
374 c - 2016 08 30:
375  908 format(
376  *'grdcontour ',a,'.',a,'.grd',
377  *' -Ctemp.cpt',
378  *' -R',
379  *' -JM -Wthin',
380  *' -A- -O -K >> plot.ps')
381 c - 2016 07 29
382 c 908 format(
383 c *'grdcontour ',a,'.',a,'.grd',
384 c *' -Ctemp.cpt',
385 c *' -R',f0.2,'/',f0.2,'/',f0.2,'/',f0.2,
386 c *' -JM -Wthin',
387 c *' -A- -O -K >> plot.ps')
388 c - 2016 07 21
389 c 908 format(
390 c *'grdcontour ',a,'.',a,'.grd',
391 c *' -C',f0.5,
392 c *' -R',f0.2,'/',f0.2,'/',f0.2,'/',f0.2,
393 c *' -JM -Wthin',
394 c *' -A- -O -K >> plot.ps')
395 c 908 format(
396 c *'grdcontour ',a,'.',a,'.grd',
397 c *' -C',f0.5,
398 c *' -R',f0.2,'/',f0.2,'/',f0.2,'/',f0.2,
399 c *' -JM',f3.1,'i -Wthin',
400 c *' -A',f0.5,' -O -K >> plot.ps')
401 
402 c - 2016 07 28 - Skip to here (skipping contours) for d3, 09 or "ete" plots
403  807 continue
404 
405 c - GMT call to create the shoreline. Add it to
406 c - file "plot.ps".
407 c - ALWAYS plot the coast last, as it closes the PS file
408  call plotcoast(region,99)
409 
410 c - GMT call to convert the plot.ps file to plot.jpg.
411  write(99,905)
412  905 format(
413  *'ps2raster plot.ps -Tj -P -A')
414 
415 c - Change name of JPG to its final name:
416  write(99,906)fname(2:8),trim(suffixused),trim(fn(ij))
417  906 format('mv plot.jpg c',a,'.',a,'.',a,'.jpg')
418 
419 c - Remove all the temporary files
420  write(99,907)
421 
422 c - Update 2016 02 29:
423 c 907 format(
424 c *'rm -f temp.cpt',/,
425 c *'rm -f tempi.grd',/,
426 c *'rm -f plot.ps')
427  907 format(
428  *'rm -f temp.cpt',/,
429  *'rm -f plot.ps')
430 c - Until here 2016 02 29
431 
432 
433 c - 2016 07 29:
434  991 format(
435  *'# -----------------------------------------------------',/,
436  *'# color plots in ',a,1x,a,1x,a,1x,a,1x,' Grid:',a /,
437  *'# -----------------------------------------------------',/,
438  *'echo ...color plots in ',a,1x,a,1x,a,1x,a,1x,' Grid:',a)
439 c 991 format(
440 c *'# -----------------------------------------------------',/,
441 c *'# color plots in ',a,1x,a,1x,a,1x,a,/,
442 c *'# -----------------------------------------------------',/,
443 c *'echo ...color plots in ',a,1x,a,1x,a,1x,a)
444 
445  return
subroutine plotcoast(region, ifnum)
Subroutine to write GMT-based commands to create a shoreline Write GMT-based commands to create a sho...
Definition: plotcoast.f:44

+ Here is the call graph for this function:

+ Here is the caller graph for this function:

subroutine coplotwcv ( character*3  ele,
character*200  fname,
real*8, dimension(maxplots)  bw,
real*8, dimension(maxplots)  be,
real*8, dimension(maxplots)  bs,
real*8, dimension(maxplots)  bn,
real*4, dimension(maxplots)  jm,
real*4, dimension(maxplots)  b1,
real*4, dimension(maxplots)  b2,
integer*4  maxplots,
character*10  olddtm,
character*10  newdtm,
character*10  region,
character*3  elecap,
  ij,
  cptlo,
  cpthi,
  cptin6,
character*200  suffixused,
  igridsec,
character*10, dimension(maxplots)  fn,
character*200  cvfname 
)

Subroutine to make GMT calls to do a color raster rendering of gridded data, with coverage overlaid.

Changelog

2016 09 08:

Had to up the D_FORMAT default to %.3G because tight scalebar ranges with the newly allowed "more free" average values were showing repeating values when only 2 digits could be shown.

2016 09 07:

Had to add lines pre/post "makecpt" to change the D_FORMAT. This is because I had been forcing the "scave" in cpt.f to be ONZD. But that yielded bad values sometimes, so I switched it. With that switch, the scave could have lots of digits. Well, that means the newly adopted "D_FORMAT" of %.2G was insufficient for the CPT table. Who knew that D_FORMAT affected that! Anyway, so change "D_FORMAT" pre/post all makecpt calls.

2016 08 30:

See item #39 in Google ToDo list Changed "grdcontour" to have a blank "-R" call so it'll mimic whatever decimal places are in the "grdimage" call that came before it.

2016 08 29:

Updated the initial -R and -B calls to 6 decimal places

2016 08 25:

  • .gmtdefaults4 has been changed so X_ORIGIN is equal to 0.0
  • Center the plot with "-Xc" at grdimage
  • Center the scalebar by setting its Xcoordinate, which runs in "plot frame" coordinates (0/0 at lower left) , to be equal to "jm/2"
  • Force the scale bar to be exactly 4 inches wide, always
  • Change the format for "makecpt" from 0.6 to 0.10

2016 07 29:

  • Update to put more data into comment/echo
  • Forced grdcontour with -Ctemp.cpt to align contours with color palette

2016 07 28:

  • For d3 plots, to drop all contours
  • For d3 plots to only use "coverage" part only if "ij" is not "1"
  • Same for "09" and "ete" grids

2016 07 21:

  • Set the "JM" code in "grdcontour" to just be "-JM" and let it therefore run with whatever JM size is used in "grdimage"
  • Set the "A" code in "grdcontour" to be "-A-" which should turn off the labels on all contours
  • Fixed the size of the scale bar

2016 03 01:

  1. Changed to a continuous color plot
    • Get rid of "-Z" in "makecpt"
  2. Changed to an 8 color, from 6 color, plot (without changing the RANGE yet...see DRU-12, p. 19)
    • Change varible that comes in from "cptin" to "cptin6"
    • Compute cptin = cptin6 * 0.75d0 immediately

2016 02 29:

  1. Removed all shading from color plots
    • Get rid of "grdgradient" call
    • Remove from "grdimage" the "-Itempi.grd" part
    • Remove the "rm -f tempi.grd" line

Definition at line 72 of file coplotwcv.f.

References plotcoast().

Referenced by makeplotfiles02().

72 
73 c - 2016 09 08
74 c Had to up the D_FORMAT default to %.3G because tight scalebar ranges
75 c with the newly allowed "more free" average values were showing
76 c repeating values when only 2 digits could be shown.
77 
78 c - 2016 09 07
79 c Had to add lines pre/post "makecpt" to change the D_FORMAT. This is because
80 c I *had* been forcing the "scave" in cpt.f to be ONZD. But that yielded
81 c bad values sometimes, so I switched it. With that switch, the scave could
82 c have lots of digits. Well, that means the newly adopted "D_FORMAT" of %.2G
83 c was insufficient for the CPT table. Who knew that D_FORMAT affected that!
84 c Anyway, so change "D_FORMAT" pre/post all makecpt calls.
85 
86 c - 2016 08 30: See item #39 in Google ToDo list
87 c Changed "grdcontour" to have a blank "-R" call so it'll mimic whatever
88 c decimal places are in the "grdimage" call that came before it.
89 
90 c - 2016 08 29:
91 c Updated the initial -R and -B calls to 6 decimal places
92 
93 c - 2016 08 25:
94 c .gmtdefaults4 has been changed so X_ORIGIN is equal to 0.0
95 c Center the plot with "-Xc" at grdimage
96 c Center the scalebar by setting its Xcoordinate, which runs in "plot frame"
97 c coordinates (0/0 at lower left) , to be equal to "jm/2"
98 c Force the scale bar to be exactly 4 inches wide, always
99 c Change the format for "makecpt" from 0.6 to 0.10
100 
101 
102 c - 2016 07 29:
103 c Update to put more data into comment/echo
104 c - Forced grdcontour with -Ctemp.cpt to align contours with color palette
105 
106 c - Update 2016 07 28 to:
107 c For d3 plots, to drop all contours
108 c For d3 plots to only use "coverage" part *only* if "ij" is not "1"
109 c Same for "09" and "ete" grids
110 
111 c subroutine coplotwcv(ele,fname,bw,be,bs,bn,jm,b1,b2,maxplots,
112 c *olddtm,newdtm,region,elecap,ij,cptlo,cpthi,cptin,suffixused,
113 c *igridsec,fn,cvfname)
114 
115 c - Update 2016 07 21:
116 c - Set the "JM" code in "grdcontour" to just be "-JM" and let it therefore
117 c run with whatever JM size is used in "grdimage"
118 c - Set the "A" code in "grdcontour" to be "-A-" which should turn off
119 c the labels on all contours
120 c - Fixed the size of the scale bar
121 
122 
123 c - Update 2016 03 01:
124 c - 1) Changed to a continuous color plot
125 c * Get rid of "-Z" in "makecpt"
126 c 2) Changed to an 8 color, from 6 color, plot (without changing the RANGE yet...see DRU-12, p. 19)
127 c * Change varible that comes in from "cptin" to "cptin6"
128 c * Compute cptin = cptin6 * 0.75d0 immediately
129 
130 
131 c - Update 2016 02 29:
132 c - 1) Removed all shading from color plots
133 c * Get rid of "grdgradient" call
134 c * Remove from "grdimage" the "-Itempi.grd" part
135 c * Remove the "rm -f tempi.grd" line
136 c
137 
138  implicit real*8(a-h,o-z)
139 
140 c - Subroutine to make GMT calls to do a color raster rendering
141 c - of gridded data, with coverage overlaid.
142 
143  integer*4 maxplots
144  character*3 ele,elecap
145  character*200 fname,cvfname
146  character*10 olddtm,newdtm,region
147  real*8 bw(maxplots),be(maxplots),bs(maxplots),bn(maxplots)
148  real*4 jm(maxplots)
149  real*4 b1(maxplots),b2(maxplots)
150  character*10 fn(maxplots)
151  real*8 ave,std
152  character*200 suffixused
153  character*20 units
154  character*20 gridnote
155  character*20 gridnote2
156 
157 c ----------------------------------------------------
158 c - FAILSAFES: BEGIN
159 c ----------------------------------------------------
160  if(.not.(fname(1:3).eq.'vmt'.or.fname(1:3).eq.'vst' .or.
161  * fname(1:3).eq.'vmr'.or.fname(1:3).eq.'vsr'))then
162  write(6,2)trim(fname)
163  stop
164  endif
165  2 format('FATAL in coplotwcv. Bad character in spots 1-3: ',a)
166 
167  if(.not.(fname(4:5).eq.'cd' .or. fname(4:5).eq.'dd'))then
168  write(6,3)trim(fname)
169  stop
170  endif
171  3 format('FATAL in coplotwcv. Bad character in spots 4-5: ',a)
172 
173  if(fname(6:8).ne.ele)then
174  write(6,4)trim(fname),ele
175  stop
176  endif
177  4 format('FATAL in coplotwcv. Bad match of fname / ele: ',a,1x,a)
178 
179  if(fname(2:2).eq.'m')then
180  units='meters'
181  elseif(fname(2:2).eq.'s')then
182  units='arcseconds'
183  else
184  write(6,5)trim(fname)
185  stop
186  endif
187  5 format('FATAL in coplotwcv. Bad units in name: ',a)
188 
189  if(igridsec.le.0)then
190  write(6,6)igridsec
191  else
192  write(gridnote,10)igridsec
193  write(gridnote2,11)igridsec
194  endif
195  6 format('FATAL in coplotwcv. Bad igridsec: ',i0)
196  10 format('(',i0,' sec)')
197  11 format(i0,'.')
198 
199 c ----------------------------------------------------
200 c - FAILSAFES: END
201 c ----------------------------------------------------
202 
203 c ------------------------------------------------------------------
204 c - Contour interval and labeling
205 c ------------------------------------------------------------------
206 c - 2016 07 28: Scrapped the whole thing about scaling cptin.
207 c - Just bring in the interval for an 8 color spread, period.
208  cptin = cptin6
209 
210 c - 2016 03 01:
211 c cptin = cptin6 * 0.75d0
212 c - End 2016 03 01
213 
214  conin = cptin
215  conlb = conin / 2.d0
216 
217 c ----------------------------------------------
218 c - GMT COMMANDS: BEGIN
219 c ----------------------------------------------
220 
221 
222 c - Header of commands/echoes:
223 c - 2016 07 29:
224  write(99,991)ele,trim(units),trim(region),trim(fn(ij)),
225  *trim(suffixused),
226  *ele,trim(units),trim(region),trim(fn(ij)),
227  *trim(suffixused)
228 c write(99,991)ele,trim(units),trim(region),trim(fn(ij)),
229 c *ele,trim(units),trim(region),trim(fn(ij))
230 
231 
232 c - GMT call to create the color palette:
233 c - Store the palette as file "temp.cpt", to be
234 c - deleted later.
235  write(99,901)cptlo,cpthi,cptin
236 
237 c - Begin 2016 03 01:
238 c 901 format(
239 c *'makecpt -Crainbow -T',f0.6,'/',f0.6,'/',f0.6,
240 c *' -Z > temp.cpt')
241 c 901 format(
242 c *'makecpt -Crainbow -T',f0.6,'/',f0.6,'/',f0.6,
243 c *' > temp.cpt')
244 c - 2016 08 25
245 c 901 format(
246 c *'makecpt -Crainbow -T',f0.10,'/',f0.10,'/',f0.10,
247 c *' > temp.cpt')
248 c - 2016 09 07
249 c 901 format(
250 c *'gmtset D_FORMAT %.12G',/,
251 c *'makecpt -Crainbow -T',f0.10,'/',f0.10,'/',f0.10,
252 c *' > temp.cpt',/,
253 c *'gmtset D_FORMAT %.2G')
254 c - 2016 09 07
255  901 format(
256  *'gmtset D_FORMAT %.12G',/,
257  *'makecpt -Crainbow -T',f0.10,'/',f0.10,'/',f0.10,
258  *' > temp.cpt',/,
259  *'gmtset D_FORMAT %.3G')
260 
261 
262 c - GMT call to create the gradient file from
263 c - the "grd" formatted version of our input grid.
264 c - Store the gradients as file "tempi.grd" to be
265 c - deleted later.
266 
267 c - Updated 2016 02 29:
268 c write(99,902)fname(1:8),trim(suffixused)
269  902 format(
270  *'grdgradient ',a,'.',a,
271  *'.grd -N4.8 -A90 -M -Gtempi.grd')
272 c - Until here 2016 02 29
273 
274 c - GMT call to create the color render of the
275 c - gridded data. Store as file "plot.ps"
276 c - to be deleted later.
277 
278  write(99,903)fname(1:8),trim(suffixused),
279  *bw(ij),be(ij),bs(ij),bn(ij),
280  *jm(ij),b1(ij),b2(ij),
281  *trim(newdtm),trim(olddtm),elecap,igridsec,
282  *trim(region),trim(fn(ij)),'method noise'
283 
284 
285 c - Commented out for 2016 02 29:
286 c 903 format(
287 c *'grdimage ',a,'.',a,'.grd',
288 c *' -Ei -Itempi.grd',
289 c *' -R',f0.2,'/',f0.2,'/',f0.2,'/',f0.2,
290 c *' -JM',f3.1,'i -B',f0.2,'/',f0.2,
291 c *':."NADCON v5.0 ',a,' minus ',a,' ',a3,
292 c *'(',i0,' sec)',
293 c *1x,a,'-',a,1x,a,
294 c *':" -Ctemp.cpt -K > plot.ps')
295 c - Commented out for 2016 03 01:
296 c 903 format(
297 c *'grdimage ',a,'.',a,'.grd',
298 c *' -Ei ',
299 c *' -R',f0.2,'/',f0.2,'/',f0.2,'/',f0.2,
300 c *' -JM',f3.1,'i -B',f0.2,'/',f0.2,
301 c *':."NADCON v5.0 ',a,' minus ',a,' ',a3,
302 c *'(',i0,' sec)',
303 c *1x,a,'-',a,1x,a,
304 c *':" -Ctemp.cpt -K > plot.ps')
305 c - Below for 2016 08 25:
306 c 903 format(
307 c *'grdimage ',a,'.',a,'.grd',
308 c *' -Ei -Xc',
309 c *' -R',f0.2,'/',f0.2,'/',f0.2,'/',f0.2,
310 c *' -JM',f3.1,'i -B',f0.2,'/',f0.2,
311 c *':."NADCON v5.0 ',a,' minus ',a,' ',a3,
312 c *'(',i0,' sec)',
313 c *1x,a,'-',a,1x,a,
314 c *':" -Ctemp.cpt -K > plot.ps')
315 c - 2016 08 29:
316  903 format(
317  *'grdimage ',a,'.',a,'.grd',
318  *' -Ei -Xc',
319  *' -R',f0.6,'/',f0.6,'/',f0.6,'/',f0.6,
320  *' -JM',f3.1,'i -B',f0.6,'/',f0.6,
321  *':."NADCON v5.0 ',a,' minus ',a,' ',a3,
322  *'(',i0,' sec)',
323  *1x,a,'-',a,1x,a,
324  *':" -Ctemp.cpt -K > plot.ps')
325 
326 c - GMT call to put a color scale on the map. Add it
327 c - to file "plot.ps".
328 
329 c - 2016 07 21:
330 c qqa = jm(ij) - 1.d0
331 c qqb = qqa / 2.d0
332 c write(99,904)qqb,qqa,trim(units)
333 c - 2016 08 25
334  qqa = jm(ij)/2
335  write(99,904)qqa,trim(units)
336 
337  904 format(
338  *'psscale -D',f3.1,'i/-0.4i/4.0i/0.2ih',
339  *' -Ctemp.cpt -I0.4 -B/:',a,
340  *': -O -K >> plot.ps')
341 
342 c write(99,904)trim(units)
343 c 904 format(
344 c *'psscale -D4i/-0.4i/8i/0.2ih -Ctemp.cpt -I0.4 -B/:',a,
345 c *': -O -K >> plot.ps')
346 
347 c - GMT call to put contours on the map.
348 
349 c - 2016 07 28...skip contours if this is a d3, 09 or "ete" plot
350  ll = len(trim(suffixused))
351  if(suffixused(ll-1:ll).eq.'d3')goto 807
352  if(suffixused(ll-1:ll).eq.'09')goto 807
353  if(fname(3:5).eq.'ete')goto 807
354 
355 c - 2016 08 30:
356  write(99,908)fname(1:8),trim(suffixused)
357 c - 2016 07 29:
358 c write(99,908)fname(1:8),trim(suffixused),
359 c *bw(ij),be(ij),bs(ij),bn(ij)
360 c - 2016 07 21:
361 c write(99,908)fname(1:8),trim(suffixused),conin,
362 c *bw(ij),be(ij),bs(ij),bn(ij)
363 c write(99,908)fname(1:8),trim(suffixused),conin,
364 c *bw(ij),be(ij),bs(ij),bn(ij),
365 c *jm(ij),conlb
366 
367 c - 2016 08 30
368  908 format(
369  *'grdcontour ',a,'.',a,'.grd',
370  *' -Ctemp.cpt',
371  *' -R',
372  *' -JM -Wthin',
373  *' -A- -O -K >> plot.ps')
374 c - 2016 07 29:
375 c 908 format(
376 c *'grdcontour ',a,'.',a,'.grd',
377 c *' -Ctemp.cpt',
378 c *' -R',f0.2,'/',f0.2,'/',f0.2,'/',f0.2,
379 c *' -JM -Wthin',
380 c *' -A- -O -K >> plot.ps')
381 c - 2016 07 21:
382 c 908 format(
383 c *'grdcontour ',a,'.',a,'.grd',
384 c *' -C',f0.5,
385 c *' -R',f0.2,'/',f0.2,'/',f0.2,'/',f0.2,
386 c *' -JM -Wthin',
387 c *' -A- -O -K >> plot.ps')
388 c 908 format(
389 c *'grdcontour ',a,'.',a,'.grd',
390 c *' -C',f0.5,
391 c *' -R',f0.2,'/',f0.2,'/',f0.2,'/',f0.2,
392 c *' -JM',f3.1,'i -Wthin',
393 c *' -A',f0.5,' -O -K >> plot.ps')
394 
395 c - 2016 07 28 - Skip to here (skipping contours) for d3, 09 or "ete" plots
396  807 continue
397 
398 c - 2016 07 28 - Skip the coverage if this is a "d3" plot, 09 plot or "ete" plot *and*
399 c - we are at the overall map level of 1 ("entire")
400  if(suffixused(ll-1:ll).eq.'d3' .and. ij.eq.1)goto 808
401  if(suffixused(ll-1:ll).eq.'09' .and. ij.eq.1)goto 808
402  if(fname(3:5).eq.'ete' .and. ij.eq.1)goto 808
403 
404 c - GMT call to overlay the coverage
405  write(99,909)trim(cvfname)
406 
407  909 format(
408  *'psxy ',a,' -R -J -Sc0.02i -Gblack -O -K >> plot.ps')
409 
410  808 continue
411 
412 c - GMT call to create the shoreline. Add it to
413 c - file "plot.ps".
414 c - ALWAYS plot the coast last, as it closes the PS file
415  call plotcoast(region,99)
416 
417 c - GMT call to convert the plot.ps file to plot.jpg.
418  write(99,905)
419  905 format(
420  *'ps2raster plot.ps -Tj -P -A')
421 
422 c - Change name of JPG to its final name:
423  write(99,906)fname(2:8),trim(suffixused),trim(fn(ij))
424  906 format('mv plot.jpg c',a,'.',a,'.',a,'.jpg')
425 
426 c - Remove all the temporary files
427  write(99,907)
428 
429 c - Updated 2016 02 29:
430 c 907 format(
431 c *'rm -f temp.cpt',/,
432 c *'rm -f tempi.grd',/,
433 c *'rm -f plot.ps')
434  907 format(
435  *'rm -f temp.cpt',/,
436  *'rm -f plot.ps')
437 c - Until here 2016 02 29
438 
439 
440  991 format(
441  *'# -----------------------------------------------------',/,
442  *'# color plots with coverage in ',a,1x,a,1x,a,1x,a,
443  * 1x,' Grid:',a/,
444  *'# -----------------------------------------------------',/,
445  *'echo ...color plots with coverage in ',a,1x,a,1x,a,1x,a,
446  * 1x,' Grid:',a)
447 c 991 format(
448 c *'# -----------------------------------------------------',/,
449 c *'# color plots with coverage in ',a,1x,a,1x,a,1x,a,/,
450 c *'# -----------------------------------------------------',/,
451 c *'echo ...color plots with coverage in ',a,1x,a,1x,a,1x,a)
452 
453  return
subroutine plotcoast(region, ifnum)
Subroutine to write GMT-based commands to create a shoreline Write GMT-based commands to create a sho...
Definition: plotcoast.f:44

+ Here is the call graph for this function:

+ Here is the caller graph for this function:

subroutine cpt ( real*8  ave,
real*8  std,
real*8  csm,
real*8  xlo,
real*8  xhi,
real*8  xin 
)

This subroutine generates the color pallette variables for a GMT color plot.

Parameters
[in]aveAverage of the gridded data
[in]stdStandard deviation of the gridded data
[in]csmColor Sigma Multiplier (how many sigmas on each side of the average do you want the colors to range?)
[out]xloLow value
[out]xhiHigh value
[out]xinInterval

Changelog

2016 09 06:

Modified because the forcing of "scave" to be one non zero digit was throwing off the scalebar so far in Guam that the data in Guam wasn't even plotting. Change to make the interval still be one non zero digit, but then a simpler formula for the scaled average was put in.

2016 07 29:

Modified from original version to reflect "new math" invented this week that helps shrink the color bar and/or widen the color bar (see issues 14 and 15 in DRU-12, p. 48)

Definition at line 32 of file cpt.f.

Referenced by makeplotfiles02().

32 
33 c - 2016 09 06
34 c Modified because the forcing of "scave" to be one non zero
35 c digit was throwing off the scalebar so far in Guam that
36 c the data in Guam wasn't even plotting. Change to make
37 c the interval still be one non zero digit, but then a
38 c simpler formula for the scaled average was put in.
39 
40 c - 2016 07 29
41 c Modified from original version to reflect "new math" invented
42 c this week that helps shrink the color bar and/or widen the
43 c color bar (see issues 14 and 15 in DRU-12, p. 48)
44 
45  implicit none
46  real*8 ave,std,csm,xlo,xhi,xin
47  real*8 qv,qq,scave
48  integer*4 iv,iq
49  real*8 spread8,onzd2
50 c - This subroutine generates the color pallette variables
51 c - for a GMT color plot
52 c
53 c - Input:
54 c ave = Average of the gridded data
55 c std = Standard deviation of the gridded data
56 c csm = Color Sigma Multiplier (how many sigmas on each
57 c side of the average do you want the colors to range?)
58 c - Output:
59 c xlo = Low value
60 c xhi = High value
61 c xin = Interval
62 
63  spread8 = 2 * csm * std / 8.d0
64  xin = onzd2(spread8)
65 
66 c iv = floor(dlog10(std))
67 c qv = 10.d0**iv
68 c qq = std / qv
69 c iq = nint(qq)
70 
71 c - 2016 09 06
72 c write(6,*) ' cpt: ave (pre onzd2) = ',ave
73 c scave = onzd2(ave)
74 c write(6,*) ' cpt: ave (post onzd2) = ',ave
75  scave = xin * nint(ave / xin)
76 
77 c xin = iq * qv
78 c scave = qv * nint(ave/qv)
79 
80 c xlo = scave - csm*xin
81 c xhi = scave + csm*xin
82 
83  xlo = scave - 4*xin
84  xhi = scave + 4*xin
85 
86  write(6,*) ' ---------------------'
87  write(6,*) 'cpt: ave = ',ave
88  write(6,*) 'cpt: std = ',std
89  write(6,*) 'cpt: csm = ',csm
90  write(6,*) 'cpt: spread8 = ',spread8
91  write(6,*) 'cpt: targ low = ',ave-csm*std
92  write(6,*) 'cpt: targ high= ',ave+csm*std
93  write(6,*) ' '
94  write(6,*) 'cpt: xin = ',xin
95  write(6,*) 'cpt: scave = ',scave
96  write(6,*) 'cpt: xlo = ',xlo
97  write(6,*) 'cpt: xhi = ',xhi
98 
99  return
real *8 function onzd2(x)
Function to round a digit to one significant figure (one non zero digit), double precision.
Definition: onzd2.f:36

+ Here is the caller graph for this function:

subroutine cpt2 ( real*8  med,
real*8  csm,
real*8  xlo,
real*8  xhi,
real*8  xin 
)

This subroutine generates the color pallette variables for a GMT color plot.

This particular routine is best for data that are all positive, but cluster near a small value while having a lot of outliers to the high-side. The color plot uses the MEDIAN (and a multiplier) to set the upper limit, while forcing the lower limit to be ZERO.

Parameters
[in]medMedian of the gridded data
[in]csmColor Sigma Multiplier (The maximum color range will be based on csm*med. The minimum color range will be zero)
[out]xloLow value
[out]xhiHigh value
[out]xinInterval

Definition at line 25 of file cpt2.f.

Referenced by makeplotfiles02(), and makeplotfiles03().

25  implicit none
26  real*8 med,csm,xlo,xhi,xin
27  real*8 qv,qq,spread,std
28  integer*4 iv,iq
29 c - This subroutine generates the color pallette variables
30 c - for a GMT color plot. This particular routine is best
31 c - for data that are all positive, but cluster near a small
32 c - value while having a lot of outliers to the high-side.
33 c - The color plot uses the MEDIAN (and a multiplier)
34 c - to set the upper limit, while forcing the lower limit
35 c - to be ZERO.
36 c
37 c - Input:
38 c med = Median of the gridded data
39 c csm = Color Sigma Multiplier (The maximum color range will
40 c be based on csm*med. The minimum color range will
41 c be zero)
42 c - Output:
43 c xlo = Low value
44 c xhi = High value
45 c xin = Interval
46 
47  spread = csm*med
48  std = spread/8.d0
49 
50  iv = floor(dlog10(std))
51  qv = 10.d0**iv
52  qq = std / qv
53  iq = nint(qq)
54 
55  xin = iq * qv
56 
57  xlo = 0.d0
58  xhi = 8 * xin
59  return

+ Here is the caller graph for this function:

real function cubterp (   x,
  f0,
  f1,
  f2,
  f3 
)

This function fits a cubic function through four points.

This function fits a cubic function through four equally spaced points along the x-axis at indices 0, 1, 2 and 3. The spacing along the x-axis is "dx"

Thus:

\begin{eqnarray*} f0 = f_0 &= y(x_0) \\ f1 = f_1 &= y(x_1) \\ f2 = f_2 &= y(x_2) \\ f3 = f_3 &= y(x_3) \end{eqnarray*}

Where:

\begin{eqnarray*} x_1 &= x_0 + dx \\ x_2 &= x_1 + dx \\ x_3 &= x_2 + dx \end{eqnarray*}

The input value is some value of "x" that falls between 0 and 3. The output value (cubterp) is the cubic function at x.

Parameters
[in]xCompute Interpolation at this positon, a value between 0 and 3 it is scaled relative to x_0 x_3 and dx. For example, a value of 1.5 is x_0 + 1.5*dx which falls between x1 and x2
[in]f0y value at x_0
[in]f1y value at x_1 = x_0 + dx
[in]f2y value at x_2 = x_0 + dx
[in]f3y value at x_3 = x_0 + dx`

This function uses Newton-Gregory forward polynomial

\begin{eqnarray*} \nabla f_0 &=& f_1 -f_0 \\ \nabla f_1 &=& f_2 -f_1 \\ \nabla^2 f_0 &=& \nabla f_1 - \nabla f_0 \\ cubterp(x, f_0, f_1, f_2, f_3) &=& f_0 + x \nabla f_0 + 0.5 x \left( x-1.0 \right) \nabla^2 f_0 \end{eqnarray*}

Definition at line 52 of file cubterp.f.

52 
53 c - x = real*4
54 c - f0,f1,f2,f3 = real*4
55 
56 c - This function fits a cubic function through
57 c - four points, *equally* spaced along the x-axis
58 c - at indices 0, 1, 2 and 3. The spacing along the
59 c - x-axis is "dx"
60 c - Thus:
61 c -
62 c - f0 = y(x(0))
63 c - f1 = y(x(1))
64 c - f2 = y(x(2))
65 c - f3 = y(x(3))
66 c - Where
67 c - x(1) = x(0) + dx
68 c - x(2) = x(1) + dx
69 c - x(3) = x(2) + dx
70 
71 c - The input value is some value of "x" that falls
72 c - between 0 and 3. The output value (cubterp) is
73 c - the cubic function at x.
74 c -
75 c - This function uses Newton-Gregory forward polynomial
76 
77 c df0 =f1 -f0
78 c df1 =f2 -f1
79 c d2f0=df1-df0
80 
81 c qterp=f0 + x*df0 + 0.5*x*(x-1.0)*d2f0
82 
83  df0 = f1 - f0
84  df1 = f2 - f1
85  df2 = f3 - f2
86 
87  d2f0 = df1 - df0
88  d2f1 = df2 - df1
89 
90  d3f0 = d2f1 - d2f0
91 
92  cubterp=f0 + x*df0 + 0.5*x*(x-1.0)*d2f0
93  * +(1.0/6.0)*d3f0*x*(x-1.0)*(x-2.0)
94 
95  return
real function cubterp(x, f0, f1, f2, f3)
This function fits a cubic function through four points.
Definition: cubterp.f:52
program decimate ( )

Part of the NADCON5 NADCON5 Core Library , Extract a reduced (1 of n) dataset.

Decimate - Extract 1 of every n points

Program arguments

Arguments are newline terminated and read from standard input

When run from the command line, the program prints a prompt for each argument

They are enumerated here

Parameters
infileInput File Name
outfileOutput File Name
nyLatitude Decimation Ratio 1:ny
nxLongitude Decimation Ratio 1:nx

Program Inputs:

  • lin Input File A

Program Outputs:

  • lout Output File to Write Decimated File

Definition at line 29 of file decimate.f.

References inouti(), and inoutr().

+ Here is the call graph for this function:

program gabs ( )

Part of the NADCON5 NADCON5 Core Library , Convert values in a *.b grid to absolute value.

Belongs to the suite of ".b" file manipulators

This program will convert every value in a ".b" grid to its absolute value.

Program arguments

Arguments are newline terminated and read from standard input

When run from the command line, the program prints a prompt for each argument

They are enumerated here

Parameters
infileInput File Name
outfileOutput File Name

Program Inputs:

  • lin Input File (*.b grid)

Program Outputs:

  • lout Output File (*.b grid)

Definition at line 30 of file gabs.f.

subroutine getgridbounds ( character*10  region,
real*8  xn,
real*8  xs,
real*8  xw,
real*8  xe 
)

Subroutine to collect up the GRID boundaries for use in creating NADCON 5.

This CAN BE different than the MAP boundaries as such:

GRID boundaries will be just four values (n/s/w/e) for any region

MAP boundaries will allow multiple maps to be made and may or may not align with the GRID boundaries. Used to allow for more "close up" maps and such, without the need to screw up the MAP boundaries.

Parameters
[in]regionRegion Name
[out]xnnorth boundary for this region
[out]xssouth boundary for this region
[out]xwwest boundary for this region
[out]xeeast boundary for this region

Subroutine Input Files:

  • `Data/grid.parameters

Definition at line 30 of file getgridbounds.f.

Referenced by checkgrid(), makework(), mymedian5(), and myrms().

30 c
31 c - Subroutine to collect up the GRID boundaries
32 c - for use in creating NADCON 5
33 c
34 c - This CAN BE different than the MAP boundaries
35 c - as such:
36 c
37 c - GRID boundaries will be just four values (n/s/w/e) for any region
38 c
39 c - MAP boundaries will allow multiple maps to be made and may or may
40 c - not align with the GRID boundaries. Used to allow for more
41 c - "close up" maps and such, without the need to screw up the
42 c - MAP boundaries.
43 
44 c - Input:
45 c region
46 c - Output:
47 c xn,xs,xw,xe = N/S/W/E boundaries of the grid to be
48 c created for this region
49 
50  character*10 region
51  real*8 xn,xs,xw,xe
52  character*80 card
53 
54  ifile = 3
55 
56  open(ifile,
57  *file='Data/grid.parameters',
58  *status='old',form='formatted')
59 
60 c - Read 2 header lines
61  read(ifile,'(a)')card
62  read(ifile,'(a)')card
63 
64 c - Now loop and find our region
65  1 read(ifile,'(a)',end=2)card
66  if(trim(card(1:10)).eq.trim(region))then
67  read(card(14:23),*)xn
68  read(card(27:36),*)xs
69  read(card(40:49),*)xw
70  read(card(53:62),*)xe
71  close(ifile)
72  return
73  endif
74  goto 1
75 
76 c - If we get here, the region sent to this subroutine wasn't found
77 c - in our file /Data/grid.parameters. Crash and burn.
78  2 write(6,100)trim(region)
79  stop 10001
80  100 format(6x,'FATAL Subroutine getgridbounds: Unknown region: ',a)
81 

+ Here is the caller graph for this function:

subroutine getmag (   x,
  ix 
)

Subroutine to return the magnitude of a double precision value.

Parameters
[out]xresult, magnitude of ix
[in]ixinput douple precision

Definition at line 13 of file getmag.f.

13 c - Subroutine to return the magnitude of a double precision
14 c - value.
15  implicit real*8 (a-h,o-z)
16  y = dlog10(x)
17  ix = floor(y)
18  write(6,*) ' getmag: x,y,ix = ',x,y,ix
19  return
subroutine getmapbounds ( character*1  mapflag,
  maxplots,
character*10  region,
  nplots,
character*10  olddtm,
character*10  newdtm,
real*8, dimension(maxplots)  bw,
real*8, dimension(maxplots)  be,
real*8, dimension(maxplots)  bs,
real*8, dimension(maxplots)  bn,
real*4, dimension(maxplots)  jm,
real*4, dimension(maxplots)  b1,
real*4, dimension(maxplots)  b2,
character*10, dimension(maxplots)  fn,
logical, dimension(maxplots)  lrv,
real*8, dimension(maxplots)  rv0x,
real*8, dimension(maxplots)  rv0y,
real*8, dimension(maxplots)  rl0y 
)

Subroutine to collect up the MAP boundaries for use in creating NADCON 5.

This CAN BE different than the GRID boundaries as such:

GRID boundaries will be just four values (n/s/w/e) for any region

MAP boundaries will allow multiple maps to be made and may or may not align with the GRID boundaries. Used to allow for more "close up" maps and such, without the need to screw up the MAP boundaries.

Parameters
[in]mapflagMap Generation Flag
[in]maxplots
[in]regionregion to get map bounds
[out]nplotsnumber of plots generated
[in]olddtmsource datum
[in]newdtmtarget datum
[out]bwwestern bound of plot (Array of length maxplots)
[out]beeastern bound of plot (Array of length maxplots)
[out]bssouthern bound of plot (Array of length maxplots)
[out]bnnorthern bound of plot (Array of length maxplots)
[out]jm(Array of length maxplots)
[out]b1(Array of length maxplots)
[out]b2(Array of length maxplots)
[out]fn(Array of length maxplots)
[out]lrv(Array of length maxplots)
[out]rv0x(Array of length maxplots)
[out]rv0y(Array of length maxplots)
[out]rl0y(Array of length maxplots)

Version for NADCON 5 Built upon the original version used in GEOCON v2.0 Do not use with GEOCON v2.0

Broken down into sub-subroutines to make it easier to swap out when I make different choices.

Changelog

2016 08 29:

Taking in olddtm and newdtm now, and adding code to use that to filter out "Saint" regions in Alaska when plotting transformations not supported in those regions.

2016 08 26:

Used actual mercator projection math to compute the exact reference vector and label locations 1/2 inch and 3/4 inch respectively below the S/W corner of the plot.

2016 07 21:

Two new columns added to "map.parameters", which have the location of the reference vector. Return a logical "lrv" as true if there is an optional special location for the reverence vector. Return as false if not. If true, return lon/lat coords of ref vector origin in rv0x/rv0y. If false, return zeros in those fields.

Also, compute "jm" on the fly, ignoring what is in the table. All plots will now be forced PORTRAIT and forced no wider than 6" and no taller than 8", while maintaining proper X/Y ratios in a Mercator projection. That means, make the biggest plot possible, with the right ratio, that is neither wider than 6" nor taller than 8" and then, whatever the width of that largest plot is – return that width in the "jm" field.

Definition at line 77 of file getmapbounds.f.

Referenced by checkgrid(), makeplotfiles01(), makeplotfiles02(), and makeplotfiles03().

77 
78 c - 2016 08 29: Taking in olddtm and newdtm now, and adding
79 c - code to use that to filter out "Saint" regions in Alaska
80 c - when plotting transformations not supported in those regions.
81 
82 c - 2016 08 26: Used actual mercator projection math to compute
83 c - the exact reference vector and label locations 1/2 inch and
84 c - 3/4 inch respectively below the S/W corner of the plot.
85 
86 c - Updated 2016 07 21: Two new columns added to "map.parameters", which
87 c - have the location of the reference vector. Return a logical "lrv"
88 c - as true if there is an optional special location for the reverence vector.
89 c - Return as false if not. If true, return lon/lat coords of ref vector
90 c - origin in rv0x/rv0y. If false, return zeros in those fields.
91 c -
92 c - Also, compute "jm" on the fly, ignoring what is in the table. All plots
93 c - will now be forced PORTRAIT and forced no wider than 6" and no taller
94 c - than 8", while maintaining proper X/Y ratios in a Mercator projection.
95 c - That means, make the biggest plot possible, with the right ratio, that
96 c - is neither wider than 6" nor taller than 8" and then, whatever the width
97 c - of that largest plot is -- return that width in the "jm" field.
98 
99 c
100 c - Subroutine to collect up the MAP boundaries
101 c - for use in creating NADCON 5
102 c
103 c - This CAN BE different than the GRID boundaries
104 c - as such:
105 c
106 c - GRID boundaries will be just four values (n/s/w/e) for any region
107 c
108 c - MAP boundaries will allow multiple maps to be made and may or may
109 c - not align with the GRID boundaries. Used to allow for more
110 c - "close up" maps and such, without the need to screw up the
111 c - MAP boundaries.
112 
113 c - Input:
114 c region, maxplots, mapflag
115 c olddtm, newdtm
116 c - Output:
117 c number of plots, their bounds, their GMT scales and
118 c label deltas
119 
120 c - Version for NADCON 5
121 c - Built upon the original version used in GEOCON v2.0
122 c - Do not use with GEOCON v2.0
123 
124 c - Broken down into sub-subroutines to make it easier
125 c - to swap out when I make different choices.
126 
127  character*10 region,olddtm,newdtm
128  real*8 bw(maxplots),be(maxplots),bs(maxplots),bn(maxplots)
129  real*4 jm(maxplots)
130  real*4 b1(maxplots),b2(maxplots)
131  character*10 fn(maxplots)
132  character*1 mapflag
133 
134 
135 c - 2016 07 21:
136  logical lrv(maxplots)
137  real*8 rv0x(maxplots),rv0y(maxplots),rl0y(maxplots)
138  character*3 c3x,c3y
139  character*2 c2x,c2y
140  real*8 pi,d2r
141 
142  character*200 card
143 
144 
145  pi = 2.d0*dasin(1.d0)
146  d2r = pi/180.d0
147 
148  ifile = 3
149 
150  open(ifile,
151  *file='Data/map.parameters',
152  *status='old',form='formatted')
153 
154 c - Get numerical version of mapflag
155  read(mapflag,*)iflag
156 
157 c - Get the header out of the way
158  read(ifile,'(a)')card
159  read(ifile,'(a)')card
160 
161 c - Loop over all map parameters, finding the ones relevant to
162 c - our region and mapflag.
163  i = 0
164  1 read(ifile,'(a)',end=2)card
165  if(card( 1:10).ne.region)goto 1
166  read(card(14:14),*)iflag0
167  if(iflag0.gt.iflag)goto 1
168 
169 c - 2016 08 29:
170 c - Specific to the case where we are looking at region=alaska,
171 c - and NOT region=<some saint island>, then for the specific
172 c - case of transforming from NAD 27 forward, let's skip
173 c - the <saint islands>
174  if(region.eq.'alaska' .and.
175  * iflag.eq.2 .and.
176  * iflag0.eq.2 .and.
177  * (card(16:25).eq.'stpaul' .or.
178  * card(16:25).eq.'stgeorge' .or.
179  * card(16:25).eq.'stlawrence' .or.
180  * card(16:25).eq.'stmatthew') .and.
181  * olddtm.eq.'nad27' )goto 1
182 
183  i = i + 1
184  fn(i) = trim(card( 16: 25))
185  read(card( 27: 30),*)iwd
186  read(card( 32: 33),*)iwm
187  read(card( 35: 38),*)ied
188  read(card( 40: 41),*)iem
189  read(card( 43: 45),*)isd
190  read(card( 47: 48),*)ism
191  read(card( 50: 52),*)ind
192  read(card( 54: 55),*)inm
193  read(card( 57: 60),*)xjm
194  read(card( 62: 64),*)ib1d
195  read(card( 66: 67),*)ib1m
196  read(card( 69: 71),*)ib2d
197  read(card( 73: 74),*)ib2m
198 c - 2016 07 21:
199  read(card( 76: 78),'(a3)')c3x
200  read(card( 80: 81),'(a2)')c2x
201  read(card( 83: 85),'(a3)')c3y
202  read(card( 87: 88),'(a2)')c2y
203 
204  bw(i) = dble(iwd) + dble(iwm)/60.d0
205  be(i) = dble(ied) + dble(iem)/60.d0
206  if(ind.lt.0)inm = -inm
207  if(isd.lt.0)ism = -ism
208  bn(i) = dble(ind) + dble(inm)/60.d0
209  bs(i) = dble(isd) + dble(ism)/60.d0
210  jm(i) = xjm
211  b1(i) = dble(ib1d) + dble(ib1m)/60.d0
212  b2(i) = dble(ib2d) + dble(ib2m)/60.d0
213 
214 c - 2016 07 21 (Optional reference vector locations):
215  if(c3x.eq.'---')then
216  lrv(i) = .false.
217  rv0x(i) = 0
218  rv0y(i) = 0
219  else
220  lrv(i) = .true.
221  read(c3x,*)rv0xd
222  read(c2x,*)rv0xm
223  read(c3y,*)rv0yd
224  read(c2y,*)rv0ym
225  rv0x(i) = dble(rv0xd) + dble(rv0xm)/60.d0
226  rv0y(i) = dble(rv0yd) + dble(rv0ym)/60.d0
227  endif
228 
229 c - 2016 07 21 (Forcing the map to keep its proper Mercator-projected X/Y ratio,
230 c - while filling the maximum space that does not exceed 6" wide nor 8" high)
231  dx = (be(i) - bw(i)) * d2r
232 
233  q1 = dtan(bn(i)*d2r)
234  q2 = 1.d0 / dcos(bn(i)*d2r) ! Secant
235  yn = log(q1 + q2)
236 
237  q1 = dtan(bs(i)*d2r)
238  q2 = 1.d0 / dcos(bs(i)*d2r) ! Secant
239  ys = log(q1 + q2)
240 
241  dy = yn - ys
242 
243  ratio = dx/dy
244 
245 c - Max height and width
246 c xmxht = 8
247  xmxht = 6
248  xmxwd = 6
249 
250  if(xmxht*ratio .gt. xmxwd)then
251  jm(i) = xmxwd
252 c - And height = xmxwd / ratio...
253  else
254  jm(i) = xmxht*ratio
255 c - And height = xmxht
256  endif
257 
258 c - 2016 08 26
259 c See DRU-12, p. 56-57
260 c - dy/dphi is linear for latitudes south of 65. All of our plots
261 c - have at most a 65 degree south border. So I can use that for
262 c - a pretty good approximation to compute the latitude of the
263 c - reference vector, in degrees, to send back as "rv0y".
264 
265 c First, get the ratio of dx/dy in the lower left part of the
266 c - plot. Use 1% of the E/W span and apply that both ways.
267  ddum = 0.01d0*(be(i) - bw(i))
268  ydum = bs(i) + ddum
269  xdum = bw(i) + ddum
270 
271  xw = bw(i) * d2r
272  xe = xdum * d2r
273 
274  dx = (xe - xw)
275 
276  q1 = dtan(ydum*d2r)
277  q2 = 1.d0 / dcos(ydum*d2r) ! Secant
278  yn = log(q1 + q2)
279 
280  q1 = dtan(bs(i)*d2r)
281  q2 = 1.d0 / dcos(bs(i)*d2r) ! Secant
282  ys = log(q1 + q2)
283 
284 c - dy is in radians
285  dy = yn - ys
286 
287 c - Now I have a new "dx" and "dy" representing the lower left 1% of the plot,
288 c - in radians/radians. Compute the new ratio for this part.
289  ratio = dx/dy
290 
291 c - Since radians to inches does NOT change in the E/W direction, and since
292 c - I know exactly how wide the plot is, I can compute a radians/inch conversion
293 c - in E/W, for 1% of the width of the plot.
294  r2iew = (0.01d0 * jm(i)) / dx
295 
296 c - The ratio of dx/dy, is going to be identical to the ratio of r2iew/r2ins:
297  r2ins = r2iew / ratio
298 
299 c - Convert r2ins into degrees-to-inches
300  d2ins = r2ins * d2r
301 
302 c - Now, the south edge is known in degrees. I want the reference vector
303 c - to be 1/2 inch below that. I want the reference vector label to
304 c - be an additional 1/4 inches down.
305  rv0y(i) = bs(i) - (0.50d0)/d2ins
306  rl0y(i) = bs(i) - (0.65d0)/d2ins
307 
308 c - And set the reference vector's left edge to equal the left edge of the plot
309  rv0x(i) = bw(i)
310 
311 c - Flags for debugging
312  write(6,8) trim(fn(i))
313  8 format('***************************',/,
314  * 'Reference Vector Computations for',
315  * 'Sub-Region: ',a)
316 
317  write(6,*) ' yn,ys,dy = ',yn,ys,dy
318  write(6,*) ' xe,xw,dx = ',xe,xw,dx
319  write(6,*) ' E/W width (jm) = ',jm(i)
320  write(6,*) ' SW ratio = ',ratio
321  write(6,*) ' SW bounds,Lat = ',ydum,bs(i)
322  write(6,*) ' SW bounds,Lon = ',xdum,bw(i)
323  write(6,*) ' r2i E/W = ',r2iew
324  write(6,*) ' r2i N/S = ',r2ins
325  write(6,*) ' d2i N/S = ',d2ins
326  write(6,*) ' Southwest corner = ',bs(i),bw(i)
327  write(6,*) ' Ref Vector = ',rv0y(i),rv0x(i)
328  write(6,*) ' Ref Label = ',rl0y(i),rv0x(i)
329 
330  goto 1
331 
332  2 nplots = i
333 
334  close(ifile)
335 
336  if(nplots.eq.0)then
337  write(6,100)trim(region)
338  stop 10001
339  endif
340  100 format(6x,'FATAL Subroutine getmapbounds: Unknown region: ',a)
341  return

+ Here is the caller graph for this function:

subroutine gridstats ( character*200  fname,
  ave,
  std,
real*8  med 
)

Subroutine to print grid statistics to stdout.

Parameters
[in]fnamename of grid stat file
[out]aveaverage
[out]stdstandard deviatio
[out]median

Definition at line 14 of file gridstats.f.

Referenced by makeplotfiles02(), and makeplotfiles03().

14  implicit real*8(a-h,o-z)
15  parameter(nmax = 1561*3541)
16  real*8 med
17  real*4 data(5000),s1,select2,arr(nmax)
18  integer*4 nla,nlo,ikind
19  character*200 fname
20  open(11,file=fname,status='old',form='unformatted')
21 
22  ave = 0.d0
23  rms = 0.d0
24 
25  read(11)glamn,glomn,dla,dlo,nla,nlo,ikind
26  if(ikind.eq.0)stop 20304
27 
28  ikt = 0
29  do 1 i=1,nla
30  if(ikind.eq.1)read(11)(data(j),j=1,nlo)
31  do 3 j=1,nlo
32  ikt = ikt + 1
33  arr(ikt) = data(j)
34  3 continue
35  do 2 j=1,nlo
36  ave = ave + dble(data(j))
37  rms = rms + dble(data(j))**2
38  2 continue
39  1 continue
40  fact = dble(nla*nlo) / dble(nla*nlo - 1)
41 
42  ave = ave / dble(nla*nlo)
43  rms = sqrt(rms / dble(nla*nlo))
44  std = dsqrt(fact*(rms**2 - ave**2))
45 
46  npts = ikt
47  nmed = 1+ ikt/2
48 
49  write(6,*) ' IN gridstats, npts = ',npts
50  write(6,*) ' IN gridstats, nmed = ',nmed
51 
52 c nmed = ikt/3
53  s1 = select2(nmed,npts,arr,nmax)
54 
55  write(6,*) ' IN gridstats, s1 = ',s1
56  med = s1
57  write(6,*) ' IN gridstats, med = ',med
58 
59  write(6,100)trim(fname),ave,std,med
60  100 format('gridstats for ',a,' = ',3f20.10)
61 
62  close(11)
63 
64  return
real *8 function select2(k, n, arr, nmax)
Function to select an element of a partially filled, but packed multi dimensional array...
Definition: select2_dbl.for:22

+ Here is the caller graph for this function:

program gscale ( )

Part of the NADCON5 NADCON5 Core Library , Scales a grid by a factor.

Program arguments

Arguments are newline terminated and read from standard input

When run from the command line, the program prints a prompt for each argument

They are enumerated here

Parameters
infileInput File Name
factorScaling Factor
outfileOutput File Name

Program Inputs:

  • lin1 Input File

Program Outputs:

  • lout Output File

Definition at line 27 of file gscale.f.

program gsqr ( )

Part of the NADCON5 NADCON5 Core Library , Squares values in a *.b grid.

Belongs to the suite of ".b" file manipulators

This program will convert every value in a ".b" grid to its squared value.

Program arguments

Arguments are newline terminated and read from standard input

When run from the command line, the program prints a prompt for each argument

They are enumerated here

Parameters
infileInput File Name
outfileOutput File Name

Program Inputs:

  • lin Input File (*.b grid)

Program Outputs:

  • lout Output File (*.b grid)

Definition at line 30 of file gsqr.f.

program gsqrt ( )

Part of the NADCON5 NADCON5 Core Library , Square Root of values in a *.b grid.

Belongs to the suite of ".b" file manipulators

This program will convert every value in a ".b" grid to its square-root value.

Program arguments

Arguments are newline terminated and read from standard input

When run from the command line, the program prints a prompt for each argument

They are enumerated here

Parameters
infileInput File Name
outfileOutput File Name

Program Inputs:

  • lin Input File (*.b grid)

Program Outputs:

  • lout Output File (*.b grid)

Definition at line 30 of file gsqrt.f.

subroutine indexxd ( integer  n,
integer  nd,
real*8, dimension(nd)  arr,
integer, dimension(nd)  indx 
)

Subroutine to perform ?? indexing on floating point data (double precision)

Parameters
[in]nnumber of iterations (rows?)
[in]ndarray and index dimensions
[in]arrinput data array
[out]indxindex out

Changelog

1/8/2004:

Modified to allow indx and arr to be DIMENSIONED differently than the number of good values they contain

11/7/2003

Modified to REAL*8 by D. Smith,

Definition at line 24 of file indexxd.for.

Referenced by getmedian().

24 c - Modified to REAL*8 by D. Smith, 11/7/2003
25 c - Further modified 1/8/2004 to allow indx and arr to
26 c - be DIMENSIONED differently than the number of good
27 c - values they contain
28 
29  integer nd
30  INTEGER n,indx(nd),m,nstack
31  REAL*8 arr(nd)
32  parameter(m=7,nstack=50)
33  INTEGER i,indxt,ir,itemp,j,jstack,k,l,istack(nstack)
34  REAL*8 a
35  do 11 j=1,n
36  indx(j)=j
37 11 continue
38  jstack=0
39  l=1
40  ir=n
41 1 if(ir-l.lt.m)then
42  do 13 j=l+1,ir
43  indxt=indx(j)
44  a=arr(indxt)
45  do 12 i=j-1,1,-1
46  if(arr(indx(i)).le.a)goto 2
47  indx(i+1)=indx(i)
48 12 continue
49  i=0
50 2 indx(i+1)=indxt
51 13 continue
52  if(jstack.eq.0)return
53  ir=istack(jstack)
54  l=istack(jstack-1)
55  jstack=jstack-2
56  else
57  k=(l+ir)/2
58  itemp=indx(k)
59  indx(k)=indx(l+1)
60  indx(l+1)=itemp
61  if(arr(indx(l+1)).gt.arr(indx(ir)))then
62  itemp=indx(l+1)
63  indx(l+1)=indx(ir)
64  indx(ir)=itemp
65  endif
66  if(arr(indx(l)).gt.arr(indx(ir)))then
67  itemp=indx(l)
68  indx(l)=indx(ir)
69  indx(ir)=itemp
70  endif
71  if(arr(indx(l+1)).gt.arr(indx(l)))then
72  itemp=indx(l+1)
73  indx(l+1)=indx(l)
74  indx(l)=itemp
75  endif
76  i=l+1
77  j=ir
78  indxt=indx(l)
79  a=arr(indxt)
80 3 continue
81  i=i+1
82  if(arr(indx(i)).lt.a)goto 3
83 4 continue
84  j=j-1
85  if(arr(indx(j)).gt.a)goto 4
86  if(j.lt.i)goto 5
87  itemp=indx(i)
88  indx(i)=indx(j)
89  indx(j)=itemp
90  goto 3
91 5 indx(l)=indx(j)
92  indx(j)=indxt
93  jstack=jstack+2
94  if(jstack.gt.nstack)pause 'NSTACK too small in indexx'
95  if(ir-i+1.ge.j-l)then
96  istack(jstack)=ir
97  istack(jstack-1)=i
98  ir=j-1
99  else
100  istack(jstack)=j-1
101  istack(jstack-1)=l
102  l=i
103  endif
104  endif
105  goto 1

+ Here is the caller graph for this function:

subroutine indexxi ( integer  n,
integer  nd,
integer*4, dimension(nd)  arr,
integer, dimension(nd)  indx 
)

Subroutine to perform ?? indexing on integer data.

Parameters
[in]nnumber of iterations (rows?)
[in]ndarray and index dimensions
[in]arrinput data array
[out]indxindex out

Changelog

2/5/2013:

Modified by D. Smith. Arr has been changed to integer*4. And like other versions of "indexx" which I've modified, I allow indx and arr to be DIMENSIONED differently than the number of good values they contain

Parameters
ndModified by D. Smith, 2/5/2013 . Arr has been changed to integer*4. And like other versions of "indexx" which I've modified, I allow indx and arr to be DIMENSIONED differently than the number of good values they contain

Definition at line 24 of file indexxi.for.

Referenced by mymedian5(), and myrms().

24 
25 c> Modified by D. Smith, 2/5/2013 . Arr has been
26 c> changed to integer*4. And like other versions
27 c> of "indexx" which I've modified,
28 c> I allow indx and arr to
29 c> be DIMENSIONED differently than the number of good
30 c> values they contain
31 
32  integer nd
33  INTEGER n,indx(nd),m,nstack
34 cDAS REAL*4 arr(nd)
35  integer*4 arr(nd)
36  parameter(m=7,nstack=50)
37  INTEGER i,indxt,ir,itemp,j,jstack,k,l,istack(nstack)
38 cDAS REAL*4 a
39  integer*4 a
40 
41  do 11 j=1,n
42  indx(j)=j
43 11 continue
44  jstack=0
45  l=1
46  ir=n
47 1 if(ir-l.lt.m)then
48  do 13 j=l+1,ir
49  indxt=indx(j)
50  a=arr(indxt)
51  do 12 i=j-1,1,-1
52  if(arr(indx(i)).le.a)goto 2
53  indx(i+1)=indx(i)
54 12 continue
55  i=0
56 2 indx(i+1)=indxt
57 13 continue
58  if(jstack.eq.0)return
59  ir=istack(jstack)
60  l=istack(jstack-1)
61  jstack=jstack-2
62  else
63  k=(l+ir)/2
64  itemp=indx(k)
65  indx(k)=indx(l+1)
66  indx(l+1)=itemp
67  if(arr(indx(l+1)).gt.arr(indx(ir)))then
68  itemp=indx(l+1)
69  indx(l+1)=indx(ir)
70  indx(ir)=itemp
71  endif
72  if(arr(indx(l)).gt.arr(indx(ir)))then
73  itemp=indx(l)
74  indx(l)=indx(ir)
75  indx(ir)=itemp
76  endif
77  if(arr(indx(l+1)).gt.arr(indx(l)))then
78  itemp=indx(l+1)
79  indx(l+1)=indx(l)
80  indx(l)=itemp
81  endif
82  i=l+1
83  j=ir
84  indxt=indx(l)
85  a=arr(indxt)
86 3 continue
87  i=i+1
88  if(arr(indx(i)).lt.a)goto 3
89 4 continue
90  j=j-1
91  if(arr(indx(j)).gt.a)goto 4
92  if(j.lt.i)goto 5
93  itemp=indx(i)
94  indx(i)=indx(j)
95  indx(j)=itemp
96  goto 3
97 5 indx(l)=indx(j)
98  indx(j)=indxt
99  jstack=jstack+2
100  if(jstack.gt.nstack)pause 'NSTACK too small in indexx'
101  if(ir-i+1.ge.j-l)then
102  istack(jstack)=ir
103  istack(jstack-1)=i
104  ir=j-1
105  else
106  istack(jstack)=j-1
107  istack(jstack-1)=l
108  l=i
109  endif
110  endif
111  goto 1

+ Here is the caller graph for this function:

integer*2 function iselect2 ( integer  k,
integer  n,
integer*2, dimension(nmax)  arr,
integer  nmax 
)

Function to select an element of a partially filled, but packed multi dimensional array, integer*2

Finds the "kth" element of an array, "arr", which is dimensioned to be "nmax" values long, but which only has data in the first "n" cells.

Changelog

1/14/2016:

Like "select2" but modified by D. Smith to allow an "nmax" array given, but which only has values in elements 1-n, and to have "arr" be Integer*2

Definition at line 22 of file iselect2.for.

22 
23 c - Like "select2" but modified by D. Smith on 1/14/2016
24 c - to allow an "nmax" array given, but which only
25 c - has values in elements 1-n, and to have "arr"
26 c - be Integer*2
27 
28  INTEGER k,n,nmax
29 c REAL*8 select,arr(nmax)
30  integer*2 iselect2,arr(nmax)
31  INTEGER i,ir,j,l,mid
32 c REAL*8 a,temp
33  integer*2 a,temp
34  l=1
35  ir=n
36 1 if(ir-l.le.1)then
37  if(ir-l.eq.1)then
38  if(arr(ir).lt.arr(l))then
39  temp=arr(l)
40  arr(l)=arr(ir)
41  arr(ir)=temp
42  endif
43  endif
44  iselect2=arr(k)
45  return
46  else
47  mid=(l+ir)/2
48  temp=arr(mid)
49  arr(mid)=arr(l+1)
50  arr(l+1)=temp
51  if(arr(l+1).gt.arr(ir))then
52  temp=arr(l+1)
53  arr(l+1)=arr(ir)
54  arr(ir)=temp
55  endif
56  if(arr(l).gt.arr(ir))then
57  temp=arr(l)
58  arr(l)=arr(ir)
59  arr(ir)=temp
60  endif
61  if(arr(l+1).gt.arr(l))then
62  temp=arr(l+1)
63  arr(l+1)=arr(l)
64  arr(l)=temp
65  endif
66  i=l+1
67  j=ir
68  a=arr(l)
69 3 continue
70  i=i+1
71  if(arr(i).lt.a)goto 3
72 4 continue
73  j=j-1
74  if(arr(j).gt.a)goto 4
75  if(j.lt.i)goto 5
76  temp=arr(i)
77  arr(i)=arr(j)
78  arr(j)=temp
79  goto 3
80 5 arr(l)=arr(j)
81  arr(j)=a
82  if(j.ge.k)ir=j-1
83  if(j.le.k)l=i
84  endif
85  goto 1
integer *2 function iselect2(k, n, arr, nmax)
Function to select an element of a partially filled, but packed multi dimensional array...
Definition: iselect2.for:22
real*4 function onzd ( real*4  x)

Function to round a digit to one significant figure (one non zero digit), single precision.

Function "onzd" stands for "One Non Zero Digit"

It takes a Real*4 number as input, and rounds that number to the closest number containing only 1 non-zero digit. The list of such numbers is infifinite, but contain these, in order:

0.7 , 0.8 , 0.9 , 1 , 2 , 3 , 4 , 5 , 6 , 7 , 8 , 9, 10 , 20 , 30 , etc etc
Parameters
[in]xinput value
Returns
real*4 rounded value of x to one non zero digit

Examples of input/output are:

   0.000019      =>    0.000020
   0.007432      =>    0.007000
   1.7           =>    2.000000
   9.143         =>    9.000000
  17.4           =>   20.000000
 947.3           =>  900.000000
 987.432         => 1000.000000
1014.8           => 1000.000000
1502.7           => 2000.000000

Definition at line 33 of file onzd.f.

33  implicit none
34  real*4 onzd,x,y
35  real*8 q,qten
36  integer*4 imag,iq,isign
37 
38 c - Function "onzd" stands for "One Non Zero Digit"
39 
40 c - It takes a Real*4 number as input, and rounds that
41 c - number to the closest number containing only 1 non-zero digit.
42 c - The list of such numbers is infifinite, but contain
43 c - these, in order:
44 c - 0.7 , 0.8 , 0.9 , 1 , 2 , 3 , 4 , 5 , 6 , 7 , 8 , 9, 10 , 20 , 30 , etc etc
45 c -
46 c - Examples of input/output are:
47 c - 0.000019 => 0.000020
48 c - 0.007432 => 0.007000
49 c - 1.7 => 2.000000
50 c - 9.143 => 9.000000
51 c - 17.4 => 20.000000
52 c - 947.3 => 900.000000
53 c - 987.432 => 1000.000000
54 c - 1014.8 => 1000.000000
55 c - 1502.7 => 2000.000000
56 
57  isign = +1
58  y = x
59  if(x.lt.0)then
60  isign = -1
61  y = -x
62  endif
63 
64 c - 1) Determine magnitude of x, in terms of integer exponent of ten
65  imag = floor(log10(y))
66 
67 c - 1a) Get the multiplier
68  qten = (10.d0**imag)
69 
70 c - 2) Get into a range between 0.0 and 10.0
71  q = dble(y) / qten
72 
73 c - 3) Round to the closest integer (0 through 10)
74  iq = nint(q)
75 
76 c - 4) Scale back to the original size
77  onzd = isign * dble(iq) * qten
78 
79 c write(6,100)x,imag,qten,q,iq,onzd
80 c 100 format(f30.15,1x,i10,1x,f30.15,1x,f30.15,1x,i10,1x,f30.15)
81 
82  return
real *4 function onzd(x)
Function to round a digit to one significant figure (one non zero digit), single precision.
Definition: onzd.f:33
real*8 function onzd2 ( real*8  x)

Function to round a digit to one significant figure (one non zero digit), double precision.

Function "onzd" stands for "One Non Zero Digit"

Version 2 operates just like version 1 (onzd()), only the input and output will be real*8 values, not real*4.

It takes a Real*8 number as input, and rounds that number to the closest number containing only 1 non-zero digit. The list of such numbers is infifinite, but contain these, in order:

0.7 , 0.8 , 0.9 , 1 , 2 , 3 , 4 , 5 , 6 , 7 , 8 , 9, 10 , 20 , 30 , etc etc
Parameters
[in]xinput value
Returns
real*8 rounded value of x to one non zero digit

Examples of input/output are:

   0.000019      =>    0.000020
   0.007432      =>    0.007000
   1.7           =>    2.000000
   9.143         =>    9.000000
  17.4           =>   20.000000
 947.3           =>  900.000000
 987.432         => 1000.000000
1014.8           => 1000.000000
1502.7           => 2000.000000

Definition at line 36 of file onzd2.f.

Referenced by checkgrid(), makeplotfiles01(), makeplotfiles02(), makeplotfiles03(), and myrms().

36  implicit none
37  real*8 onzd2,x,y
38  real*8 q,qten
39  integer*4 imag,iq,isign
40 
41 c - Function "onzd2" stands for "One Non Zero Digit, version 2"
42 
43 c - Version 2 operates just like version 1 (onzd.f), only the input
44 c - and output will be real*8 values, not real*4.
45 
46 c - It takes a Real*8 number as input, and rounds that
47 c - number to the closest number containing only 1 non-zero digit.
48 c - The list of such numbers is infifinite, but contain
49 c - these, in order:
50 c - 0.7 , 0.8 , 0.9 , 1 , 2 , 3 , 4 , 5 , 6 , 7 , 8 , 9, 10 , 20 , 30 , etc etc
51 c -
52 c - Examples of input/output are:
53 c - 0.000019 => 0.000020
54 c - 0.007432 => 0.007000
55 c - 1.7 => 2.000000
56 c - 9.143 => 9.000000
57 c - 17.4 => 20.000000
58 c - 947.3 => 900.000000
59 c - 987.432 => 1000.000000
60 c - 1014.8 => 1000.000000
61 c - 1502.7 => 2000.000000
62 
63  y = x
64  isign = +1
65  if(x.lt.0)then
66  isign = -1
67  y = -x
68  endif
69 
70 c - 1) Determine magnitude of x, in terms of integer exponent of ten
71  imag = floor(dlog10(y))
72 
73 c - 1a) Get the multiplier
74  qten = (10.d0**imag)
75 
76 c - 2) Get into a range between 0.0 and 10.0
77  q = dble(y) / qten
78 
79 c - 3) Round to the closest integer (0 through 10)
80  iq = nint(q)
81 
82 c - 4) Scale back to the original size
83  onzd2 = isign * dble(iq) * qten
84 
85 c write(6,100)x,imag,qten,q,iq,onzd2
86 c 100 format(f30.15,1x,i10,1x,f30.15,1x,f30.15,1x,i10,1x,f30.15)
87 
88  return
real *8 function onzd2(x)
Function to round a digit to one significant figure (one non zero digit), double precision.
Definition: onzd2.f:36

+ Here is the caller graph for this function:

subroutine plotcoast ( character*10  region,
  ifnum 
)

Subroutine to write GMT-based commands to create a shoreline Write GMT-based commands to create a shoreline based on region.

Use GMT-default coastline for:

  • conus
  • alaska

Use Dru's custome coastline for:

  • hawaii
  • prvi
  • as
  • guamcnmi
  • stlawrence
  • stmatthew
  • stgeorge
  • stpaul
Parameters
[in]regionThe Region to create coastline for
[in]ifnumthe file descriptor of the output file to write GMT commands to

Changelog

2016 01 07:

Forced the Alaska region to plot the islands of St. George, St. Matthew and St. Paul (St. Lawrence is already plotted), as well as 35 missing Aleutian Islands

2015 09 23:

Added four new regions:

  • St. Lawrence Island, Alaska
  • St. Matthew Island, Alaska
  • St. George Island, Alaska
  • St. Paul Island, Alaska

Definition at line 44 of file plotcoast.f.

Referenced by bwplotcv(), bwplotvc(), coplot(), and coplotwcv().

44 
45 c - 2016 01 07
46 c Forced the Alaska region to plot the
47 c islands of St. George, St. Matthew and St. Paul
48 c (St. Lawrence is already plotted), as well
49 c as 35 missing Aleutian Islands
50 
51 c - 2015 09 23: Added four new regions:
52 c St. Lawrence Island, Alaska
53 c St. Matthew Island, Alaska
54 c St. George Island, Alaska
55 c St. Paul Island, Alaska
56 
57  character*10 region
58 
59 c - Write GMT-based commands to create a shoreline
60 c - based on region.
61 c - Use GMT-default coastline for:
62 c conus
63 c alaska
64 c - Use Dru's custome coastline for:
65 c hawaii
66 c prvi
67 c as
68 c guamcnmi
69 c stlawrence
70 c stmatthew
71 c stgeorge
72 c stpaul
73 
74 
75  if (trim(region).eq.'conus')then
76  write(ifnum,100)
77  elseif(trim(region).eq.'alaska')then
78  write(ifnum,109)
79  elseif(trim(region).eq.'hawaii')then
80  write(ifnum,101)
81  elseif(trim(region).eq.'prvi')then
82  write(ifnum,102)
83  elseif(trim(region).eq.'guamcnmi')then
84  write(ifnum,103)
85  elseif(trim(region).eq.'as')then
86  write(ifnum,104)
87  elseif(trim(region).eq.'stlawrence')then
88  write(ifnum,105)
89  elseif(trim(region).eq.'stmatthew')then
90  write(ifnum,106)
91  elseif(trim(region).eq.'stgeorge')then
92  write(ifnum,107)
93  elseif(trim(region).eq.'stpaul')then
94  write(ifnum,108)
95 
96  else
97  write(6,200)region
98  stop 10001
99  endif
100  return
101 
102  200 format('FATAL in plotcoast.f: Unknown region: ',a10)
103 
104 c - CONUS
105  100 format(
106  *'pscoast -Df -R -JM -W0.25p -N1 -N2 -A1200 -O >> plot.ps')
107 
108 c - HAWAII
109  101 format(
110  *'psxy Boundaries/HI_Hawaii.gmt -R -JM -B -O -K',
111  *' >> plot.ps',/,
112  *'psxy Boundaries/HI_Kahoolawe.gmt -R -JM -B -O -K ',
113  *' >> plot.ps',/,
114  *'psxy Boundaries/HI_Kauai.gmt -R -JM -B -O -K ',
115  *' >> plot.ps',/,
116  *'psxy Boundaries/HI_Lanai.gmt -R -JM -B -O -K ',
117  *' >> plot.ps',/,
118  *'psxy Boundaries/HI_Maui.gmt -R -JM -B -O -K ',
119  *' >> plot.ps',/,
120  *'psxy Boundaries/HI_Molokai.gmt -R -JM -B -O -K ',
121  *' >> plot.ps',/,
122  *'psxy Boundaries/HI_Nihau.gmt -R -JM -B -O -K ',
123  *' >> plot.ps',/,
124  *'psxy Boundaries/HI_Oahu.gmt -R -JM -B -O ',
125  *' >> plot.ps')
126 
127 c - PRVI
128  102 format(
129  *'psxy Boundaries/VQ_StCroix.gmt -R -JM -B -O -K',
130  *' >> plot.ps',/,
131  *'psxy Boundaries/VQ_StJohn.gmt -R -JM -B -O -K ',
132  *' >> plot.ps',/,
133  *'psxy Boundaries/VQ_StThomas.gmt -R -JM -B -O -K ',
134  *' >> plot.ps',/,
135  *'psxy Boundaries/PR_Culebra.gmt -R -JM -B -O -K ',
136  *' >> plot.ps',/,
137  *'psxy Boundaries/PR_Desecheo.gmt -R -JM -B -O -K ',
138  *' >> plot.ps',/,
139  *'psxy Boundaries/PR_Mona.gmt -R -JM -B -O -K ',
140  *' >> plot.ps',/,
141  *'psxy Boundaries/PR_Viequez.gmt -R -JM -B -O -K ',
142  *' >> plot.ps',/,
143  *'psxy Boundaries/PR_PuertoRico.gmt -R -JM -B -O ',
144  *' >> plot.ps')
145 
146 c - GUAM/CNMI
147  103 format(
148  *'psxy Boundaries/GQ_Guam.gmt -R -JM -B -O -K',
149  *' >> plot.ps',/,
150  *'psxy Boundaries/CQ_Rota.gmt -R -JM -B -O -K ',
151  *' >> plot.ps',/,
152  *'psxy Boundaries/CQ_Saipan.gmt -R -JM -B -O -K ',
153  *' >> plot.ps',/,
154  *'psxy Boundaries/CQ_Tinian.gmt -R -JM -B -O -K ',
155  *' >> plot.ps',/,
156  *'psxy Boundaries/CQ_Anatahan.gmt -R -JM -B -O -K ',
157  *' >> plot.ps',/,
158  *'psxy Boundaries/CQ_Sarigan.gmt -R -JM -B -O -K ',
159  *' >> plot.ps',/,
160  *'psxy Boundaries/CQ_Guguan.gmt -R -JM -B -O -K ',
161  *' >> plot.ps',/,
162  *'psxy Boundaries/CQ_Alamagan.gmt -R -JM -B -O -K ',
163  *' >> plot.ps',/,
164  *'psxy Boundaries/CQ_Pagan.gmt -R -JM -B -O -K ',
165  *' >> plot.ps',/,
166  *'psxy Boundaries/CQ_Agrihan.gmt -R -JM -B -O -K ',
167  *' >> plot.ps',/,
168  *'psxy Boundaries/CQ_Asuncion.gmt -R -JM -B -O -K ',
169  *' >> plot.ps',/,
170  *'psxy Boundaries/CQ_MaugWest.gmt -R -JM -B -O -K ',
171  *' >> plot.ps',/,
172  *'psxy Boundaries/CQ_MaugEast.gmt -R -JM -B -O -K ',
173  *' >> plot.ps',/,
174  *'psxy Boundaries/CQ_MaugNorth.gmt -R -JM -B -O -K ',
175  *' >> plot.ps',/,
176  *'psxy Boundaries/CQ_Pajaros.gmt -R -JM -B -O',
177  *' >> plot.ps')
178 
179 c - AS
180  104 format(
181  *'psxy Boundaries/AS_Aunuu.gmt -R -JM -B -O -K',
182  *' >> plot.ps',/,
183  *'psxy Boundaries/AS_Nuutele.gmt -R -JM -B -O -K ',
184  *' >> plot.ps',/,
185  *'psxy Boundaries/AS_Ofu.gmt -R -JM -B -O -K ',
186  *' >> plot.ps',/,
187  *'psxy Boundaries/AS_Olosega.gmt -R -JM -B -O -K ',
188  *' >> plot.ps',/,
189  *'psxy Boundaries/AS_Rose.gmt -R -JM -B -O -K ',
190  *' >> plot.ps',/,
191  *'psxy Boundaries/AS_Swains.gmt -R -JM -B -O -K ',
192  *' >> plot.ps',/,
193  *'psxy Boundaries/AS_Tau.gmt -R -JM -B -O -K ',
194  *' >> plot.ps',/,
195  *'psxy Boundaries/AS_Tutila.gmt -R -JM -B -O ',
196  *' >> plot.ps')
197 
198 c - St. Lawrence Island, Alaska
199  105 format(
200  *'psxy Boundaries/AK_StLawrence.gmt -R -JM -B -O -K',
201  *' >> plot.ps',/,
202  *'psxy Boundaries/AK_NorthPunuk.gmt -R -JM -B -O -K ',
203  *' >> plot.ps',/,
204  *'psxy Boundaries/AK_MiddlePunuk.gmt -R -JM -B -O -K ',
205  *' >> plot.ps',/,
206  *'psxy Boundaries/AK_SouthPunuk.gmt -R -JM -B -O ',
207  *' >> plot.ps')
208 
209 c - St. Matthew Island, Alaska
210  106 format(
211  *'psxy Boundaries/AK_StMatthew.gmt -R -JM -B -O -K',
212  *' >> plot.ps',/,
213  *'psxy Boundaries/AK_Hall.gmt -R -JM -B -O -K ',
214  *' >> plot.ps',/,
215  *'psxy Boundaries/AK_Pinnacle.gmt -R -JM -B -O ',
216  *' >> plot.ps')
217 
218 c - St. George Island, Alaska
219  107 format(
220  *'psxy Boundaries/AK_StGeorge.gmt -R -JM -B -O',
221  *' >> plot.ps')
222 
223 c - St. Paul Island, Alaska
224  108 format(
225  *'psxy Boundaries/AK_StPaul.gmt -R -JM -B -O -K',
226  *' >> plot.ps',/,
227  *'psxy Boundaries/AK_Otter.gmt -R -JM -B -O -K ',
228  *' >> plot.ps',/,
229  *'psxy Boundaries/AK_Walrus.gmt -R -JM -B -O ',
230  *' >> plot.ps')
231 
232 c - ALASKA
233  109 format(
234  *'pscoast -Df -R -JM -W0.25p -N1 -N2 -A1200 -O -K ',
235  *' >> plot.ps',/,
236  *'psxy Boundaries/AK_NorthPunuk.gmt -R -JM -B -O -K ',
237  *' >> plot.ps',/,
238  *'psxy Boundaries/AK_MiddlePunuk.gmt -R -JM -B -O -K ',
239  *' >> plot.ps',/,
240  *'psxy Boundaries/AK_SouthPunuk.gmt -R -JM -B -O -K ',
241  *' >> plot.ps',/,
242  *'psxy Boundaries/AK_StMatthew.gmt -R -JM -B -O -K',
243  *' >> plot.ps',/,
244  *'psxy Boundaries/AK_Hall.gmt -R -JM -B -O -K ',
245  *' >> plot.ps',/,
246  *'psxy Boundaries/AK_Pinnacle.gmt -R -JM -B -O -K ',
247  *' >> plot.ps',/,
248  *'psxy Boundaries/AK_StGeorge.gmt -R -JM -B -O -K',
249  *' >> plot.ps',/,
250  *'psxy Boundaries/AK_StPaul.gmt -R -JM -B -O -K',
251  *' >> plot.ps',/,
252  *'psxy Boundaries/AK_Otter.gmt -R -JM -B -O -K ',
253  *' >> plot.ps',/,
254  *'psxy Boundaries/AK_Walrus.gmt -R -JM -B -O -K ',
255  *' >> plot.ps',/,
256  *'psxy Boundaries/AK_Adak.gmt -R -JM -B -O -K ',
257  *' >> plot.ps',/,
258  *'psxy Boundaries/AK_Agattu.gmt -R -JM -B -O -K ',
259  *' >> plot.ps',/,
260  *'psxy Boundaries/AK_Amchitka.gmt -R -JM -B -O -K ',
261  *' >> plot.ps',/,
262  *'psxy Boundaries/AK_Amlia.gmt -R -JM -B -O -K ',
263  *' >> plot.ps',/,
264  *'psxy Boundaries/AK_Amukta.gmt -R -JM -B -O -K ',
265  *' >> plot.ps',/,
266  *'psxy Boundaries/AK_Andreanof.gmt -R -JM -B -O -K ',
267  *' >> plot.ps',/,
268  *'psxy Boundaries/AK_Atka.gmt -R -JM -B -O -K ',
269  *' >> plot.ps',/,
270  *'psxy Boundaries/AK_Attu.gmt -R -JM -B -O -K ',
271  *' >> plot.ps',/,
272  *'psxy Boundaries/AK_Buldir.gmt -R -JM -B -O -K ',
273  *' >> plot.ps',/,
274  *'psxy Boundaries/AK_Carlisle.gmt -R -JM -B -O -K ',
275  *' >> plot.ps',/,
276  *'psxy Boundaries/AK_Chagulak.gmt -R -JM -B -O -K ',
277  *' >> plot.ps',/,
278  *'psxy Boundaries/AK_Chugul.gmt -R -JM -B -O -K ',
279  *' >> plot.ps',/,
280  *'psxy Boundaries/AK_Fenimore.gmt -R -JM -B -O -K ',
281  *' >> plot.ps',/,
282  *'psxy Boundaries/AK_FourMountains.gmt -R -JM -B -O -K ',
283  *' >> plot.ps',/,
284  *'psxy Boundaries/AK_GreatSitkin.gmt -R -JM -B -O -K ',
285  *' >> plot.ps',/,
286  *'psxy Boundaries/AK_Herbert.gmt -R -JM -B -O -K ',
287  *' >> plot.ps',/,
288  *'psxy Boundaries/AK_Igitkin.gmt -R -JM -B -O -K ',
289  *' >> plot.ps',/,
290  *'psxy Boundaries/AK_Ikiginak.gmt -R -JM -B -O -K ',
291  *' >> plot.ps',/,
292  *'psxy Boundaries/AK_Kagalaska.gmt -R -JM -B -O -K ',
293  *' >> plot.ps',/,
294  *'psxy Boundaries/AK_Kagami.gmt -R -JM -B -O -K ',
295  *' >> plot.ps',/,
296  *'psxy Boundaries/AK_Kanaga.gmt -R -JM -B -O -K ',
297  *' >> plot.ps',/,
298  *'psxy Boundaries/AK_Kasatochi.gmt -R -JM -B -O -K ',
299  *' >> plot.ps',/,
300  *'psxy Boundaries/AK_Kiska.gmt -R -JM -B -O -K ',
301  *' >> plot.ps',/,
302  *'psxy Boundaries/AK_Koniuji.gmt -R -JM -B -O -K ',
303  *' >> plot.ps',/,
304  *'psxy Boundaries/AK_Oglodak.gmt -R -JM -B -O -K ',
305  *' >> plot.ps',/,
306  *'psxy Boundaries/AK_Seguam.gmt -R -JM -B -O -K ',
307  *' >> plot.ps',/,
308  *'psxy Boundaries/AK_Semichi.gmt -R -JM -B -O -K ',
309  *' >> plot.ps',/,
310  *'psxy Boundaries/AK_Semisopochnoi.gmt -R -JM -B -O -K ',
311  *' >> plot.ps',/,
312  *'psxy Boundaries/AK_Shemya.gmt -R -JM -B -O -K ',
313  *' >> plot.ps',/,
314  *'psxy Boundaries/AK_Tagalak.gmt -R -JM -B -O -K ',
315  *' >> plot.ps',/,
316  *'psxy Boundaries/AK_Tanaga.gmt -R -JM -B -O -K ',
317  *' >> plot.ps',/,
318  *'psxy Boundaries/AK_Ulak.gmt -R -JM -B -O -K ',
319  *' >> plot.ps',/,
320  *'psxy Boundaries/AK_Uliaga.gmt -R -JM -B -O -K ',
321  *' >> plot.ps',/,
322  *'psxy Boundaries/AK_Umak.gmt -R -JM -B -O -K ',
323  *' >> plot.ps',/,
324  *'psxy Boundaries/AK_Yunaska.gmt -R -JM -B -O ',
325  *' >> plot.ps')
326 

+ Here is the caller graph for this function:

real function qterp (   x,
  f0,
  f1,
  f2 
)

This function fits a quadratic function through 3 points.

This function fits a parabola (quadratic) function through three equally spaced points along the x-axis at indices 0, 1, and 2. The spacing along the x-axis is "dx"

Thus:

\begin{eqnarray*} f0 = f_0 &= y(x_0) \\ f1 = f_1 &= y(x_1) \\ f2 = f_2 &= y(x_2) \end{eqnarray*}

Where:

\begin{eqnarray*} x_1 &= x_0 + dx \\ x_2 &= x_1 + dx \\ x_3 &= x_2 + dx \end{eqnarray*}

The input value is some value of "x" that falls between 0 and 2. The output value (qterp) is the quadratic function at x.

Parameters
[in]xCompute Interpolation at this positon, a value between 0 and 3 it is scaled relative to x_0 x_2 and dx. For example, the value of 1.5 is x_0 + 1.5*dx which falls between x1 and x2
[in]f0y value at x_0
[in]f1y value at x_1 = x_0 + dx
[in]f2y value at x_2 = x_0 + dx
Returns
real quadratically interpolated value of f(x*) where x* = x_0 + x*dxx

This function uses Newton-Gregory forward polynomial

\begin{eqnarray*} \nabla f_0 &=& f_1 -f_0 \\ \nabla f_1 &=& f_2 -f_1 \\ \nabla^2 f_0 &=& \nabla f_1 - \nabla f_0 \\ qterp(x, f_0, f_1, f_2) &=& f_0 + x \nabla f_0 + 0.5 x \left( x-1.0 \right) \nabla^2 f_0 \end{eqnarray*}

Definition at line 51 of file qterp.f.

51 
52 c - x = real*4
53 c - f0,f1,f2 = real*4
54 
55 c - This function fits a parabola (quadratic) through
56 c - three points, *equally* spaced along the x-axis
57 c - at indices 0, 1 and 2. The spacing along the
58 c - x-axis is "dx"
59 c - Thus:
60 c -
61 c - f0 = y(x(0))
62 c - f1 = y(x(1))
63 c - f2 = y(x(2))
64 c - Where
65 c - x(1) = x(0) + dx
66 c - x(2) = x(1) + dx
67 
68 c - The input value is some value of "x" that falls
69 c - between 0 and 2. The output value (qterp2) is
70 c - the parabolic function at x.
71 c -
72 c - This function uses Newton-Gregory forward polynomial
73 
74  df0 =f1 -f0
75  df1 =f2 -f1
76  d2f0=df1-df0
77 
78  qterp=f0 + x*df0 + 0.5*x*(x-1.0)*d2f0
79 
80  return
real function qterp(x, f0, f1, f2)
This function fits a quadratic function through 3 points.
Definition: qterp.f:51
program regrd2 ( )

Part of the NADCON5 NADCON5 Core Library , regrid data.

Regrid gridded data using biquadratic interpolation

Program arguments

Arguments are newline terminated and read from standard input

When run from the command line, the program prints a prompt for each argument

They are enumerated here

Parameters
infileInput Master Grid File Name
outfileOutput Regrid File Name
nrowNumber of rows in new Grid (Lat)
ncolNumber of cols in new Grid (Lon)

Program Inputs:

  • lin Input File

Program Outputs:

  • lout Output File

Definition at line 29 of file regrd2.f.

References bquad1(), bquad2(), r1(), and r2().

+ Here is the call graph for this function:

real*8 function select2 ( integer  k,
integer  n,
real*8, dimension(nmax)  arr,
integer  nmax 
)

Function to select an element of a partially filled, but packed multi dimensional array, double precision.

Finds the "kth" element of an array, "arr", which is dimensioned to be "nmax" values long, but which only has data in the first "n" cells.

Changelog

7/17/2008:

Like "select2" but modified by D. Smith to allow an "nmax" array given, but which only has values in elements 1-n, and to have "arr" be Integer*2

Definition at line 22 of file select2_dbl.for.

22 
23 c - Like "select" but modified by D. Smith on 7/17/2008
24 c - to allow an "nmax" array given, but which only
25 c - has values in elements 1-n
26 
27  INTEGER k,n,nmax
28  REAL*8 select2,arr(nmax)
29  INTEGER i,ir,j,l,mid
30  REAL*8 a,temp
31  l=1
32  ir=n
33 1 if(ir-l.le.1)then
34  if(ir-l.eq.1)then
35  if(arr(ir).lt.arr(l))then
36  temp=arr(l)
37  arr(l)=arr(ir)
38  arr(ir)=temp
39  endif
40  endif
41  select2=arr(k)
42  return
43  else
44  mid=(l+ir)/2
45  temp=arr(mid)
46  arr(mid)=arr(l+1)
47  arr(l+1)=temp
48  if(arr(l+1).gt.arr(ir))then
49  temp=arr(l+1)
50  arr(l+1)=arr(ir)
51  arr(ir)=temp
52  endif
53  if(arr(l).gt.arr(ir))then
54  temp=arr(l)
55  arr(l)=arr(ir)
56  arr(ir)=temp
57  endif
58  if(arr(l+1).gt.arr(l))then
59  temp=arr(l+1)
60  arr(l+1)=arr(l)
61  arr(l)=temp
62  endif
63  i=l+1
64  j=ir
65  a=arr(l)
66 3 continue
67  i=i+1
68  if(arr(i).lt.a)goto 3
69 4 continue
70  j=j-1
71  if(arr(j).gt.a)goto 4
72  if(j.lt.i)goto 5
73  temp=arr(i)
74  arr(i)=arr(j)
75  arr(j)=temp
76  goto 3
77 5 arr(l)=arr(j)
78  arr(j)=a
79  if(j.ge.k)ir=j-1
80  if(j.le.k)l=i
81  endif
82  goto 1
real *8 function select2(k, n, arr, nmax)
Function to select an element of a partially filled, but packed multi dimensional array...
Definition: select2_dbl.for:22
real*4 function select2 ( integer  k,
integer  n,
real*4, dimension(nmax)  arr,
integer  nmax 
)

Function to select an element of a partially filled, but packed multi dimensional array, single precision.

Finds the "kth" element of an array, "arr", which is dimensioned to be "nmax" values long, but which only has data in the first "n" cells.

Changelog

7/17/2008:

Like "select2" but modified by D. Smith to allow an "nmax" array given, but which only has values in elements 1-n, and to have "arr" be Integer*2

Definition at line 22 of file select2_mod.for.

22 c - Like "select" but modified by D. Smith on 7/17/2008
23 c - to allow an "nmax" array given, but which only
24 c - has values in elements 1-n. Maintain the Real*4 nature of arr.
25 
26 c - Finds the "kth" element of an array, "arr", which
27 c - is dimensioned to be "nmax" values long, but which
28 c - only has data in the first "n" cells.
29 
30  INTEGER k,n,nmax
31  REAL*4 select2,arr(nmax)
32  INTEGER i,ir,j,l,mid
33  REAL*4 a,temp
34  l=1
35  ir=n
36 1 if(ir-l.le.1)then
37  if(ir-l.eq.1)then
38  if(arr(ir).lt.arr(l))then
39  temp=arr(l)
40  arr(l)=arr(ir)
41  arr(ir)=temp
42  endif
43  endif
44  select2=arr(k)
45  return
46  else
47  mid=(l+ir)/2
48  temp=arr(mid)
49  arr(mid)=arr(l+1)
50  arr(l+1)=temp
51  if(arr(l+1).gt.arr(ir))then
52  temp=arr(l+1)
53  arr(l+1)=arr(ir)
54  arr(ir)=temp
55  endif
56  if(arr(l).gt.arr(ir))then
57  temp=arr(l)
58  arr(l)=arr(ir)
59  arr(ir)=temp
60  endif
61  if(arr(l+1).gt.arr(l))then
62  temp=arr(l+1)
63  arr(l+1)=arr(l)
64  arr(l)=temp
65  endif
66  i=l+1
67  j=ir
68  a=arr(l)
69 3 continue
70  i=i+1
71  if(arr(i).lt.a)goto 3
72 4 continue
73  j=j-1
74  if(arr(j).gt.a)goto 4
75  if(j.lt.i)goto 5
76  temp=arr(i)
77  arr(i)=arr(j)
78  arr(j)=temp
79  goto 3
80 5 arr(l)=arr(j)
81  arr(j)=a
82  if(j.ge.k)ir=j-1
83  if(j.le.k)l=i
84  endif
85  goto 1
real *8 function select2(k, n, arr, nmax)
Function to select an element of a partially filled, but packed multi dimensional array...
Definition: select2_dbl.for:22
program subtrc ( )

Part of the NADCON5 NADCON5 Core Library , Subtract one grid from another.

Program arguments

Arguments are newline terminated and read from standard input

When run from the command line, the program prints a prompt for each argument

They are enumerated here

Parameters
infileAFirst Input File Name
infileBSecond Input File Name
outfileOutput File Name of A*B

Program Inputs:

  • lin1 Input File A
  • lin2 Input File B
  • lout Output File to Write A-B

Definition at line 25 of file subtrc.f.

subroutine vecstats ( character*200  fname,
integer*4  n 
)

Subroutine to tell us how many thinned vectors were used to make a grid.

Parameters
[in]fnamevector filename to read
[out]nnumber of thinned vectors

Definition at line 12 of file vecstats.f.

Referenced by makeplotfiles02().

12 c - Subroutine to tell us how many thinned vectors were
13 c - used to make a grid
14  character*200 fname
15  integer*4 n
16  character*80 card
17  open(90,file=fname,status='old',form='formatted')
18  n = 0
19  1 read(90,'(a)',end=2)card
20  n = n + 1
21  goto 1
22  2 return

+ Here is the caller graph for this function:

program xyz2b ( )

Part of the NADCON5 NADCON5 Core Library , Converts GMT *.grd to a *.b NADCON style grid file.

Turn gmt/netcdf grd dump into my grid file (real number version) assumes grd dump is longitude/latitude/real (binary s.p.)

Program arguments

Arguments are newline terminated and read from standard input

When run from the command line, the program prints a prompt for each argument

They are enumerated here

Parameters
infileInput File Name
outfileOutput File Name

Program Inputs:

  • lin Input File (*.grd)

Program Outputs:

  • lout Output File (*.b)

Definition at line 29 of file xyz2b.f.

References put1(), put2(), w1(), and w2().

+ Here is the call graph for this function: