source: branches/UKMO/r6232_tracer_advection/NEMOGCM/TOOLS/WEIGHTS/nocsutil/scrip.F90 @ 9295

Last change on this file since 9295 was 9295, checked in by jcastill, 3 years ago

Remove svn keywords

File size: 8.0 KB
Line 
1!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2!
3!     This routine is the driver for computing the addresses and weights
4!     for interpolating between two grids on a sphere.
5!
6!     Modified slightly to get name of namelist file from command line - sga 2/12/05
7!
8!-----------------------------------------------------------------------
9!
10!     CVS:$Id$
11!
12!     Copyright (c) 1997, 1998 the Regents of the University of
13!       California.
14!
15!     This software and ancillary information (herein called software)
16!     called SCRIP is made available under the terms described here. 
17!     The software has been approved for release with associated
18!     LA-CC Number 98-45.
19!
20!     Unless otherwise indicated, this software has been authored
21!     by an employee or employees of the University of California,
22!     operator of the Los Alamos National Laboratory under Contract
23!     No. W-7405-ENG-36 with the U.S. Department of Energy.  The U.S.
24!     Government has rights to use, reproduce, and distribute this
25!     software.  The public may copy and use this software without
26!     charge, provided that this Notice and any statement of authorship
27!     are reproduced on all copies.  Neither the Government nor the
28!     University makes any warranty, express or implied, or assumes
29!     any liability or responsibility for the use of this software.
30!
31!     If software is modified to produce derivative works, such modified
32!     software should be clearly marked, so as not to confuse it with
33!     the version available from Los Alamos National Laboratory.
34!
35!***********************************************************************
36
37      program scrip
38
39!-----------------------------------------------------------------------
40
41      use kinds_mod                  ! module defining data types
42      use constants                  ! module for common constants
43      use iounits                    ! I/O unit manager
44      use timers                     ! CPU timers
45      use grids                      ! module with grid information
46      use remap_vars                 ! common remapping variables
47      use remap_conservative         ! routines for conservative remap
48      use remap_distance_weight      ! routines for dist-weight remap
49      use remap_bilinear             ! routines for bilinear interp
50      use remap_bicubic              ! routines for bicubic  interp
51      use remap_write                ! routines for remap output
52
53      implicit none
54
55!-----------------------------------------------------------------------
56!
57!     input namelist variables
58!
59!-----------------------------------------------------------------------
60
61      character (char_len) :: &
62         grid1_file,       &  ! filename of grid file containing grid1
63         grid2_file,       &  ! filename of grid file containing grid2
64         interp_file1,     &  ! filename for output remap data (map1)
65         interp_file2,     &  ! filename for output remap data (map2)
66         map1_name,        &  ! name for mapping from grid1 to grid2
67         map2_name,        &  ! name for mapping from grid2 to grid1
68         map_method,       &  ! choice for mapping method
69         normalize_opt,    &  ! option for normalizing weights
70         output_opt           ! option for output conventions
71
72      integer (kind=int_kind) :: &
73         nmap                 ! number of mappings to compute (1 or 2)
74
75      namelist /remap_inputs/ grid1_file, grid2_file,  &
76         interp_file1, interp_file2,                   &
77         map1_name, map2_name, num_maps,               &
78         luse_grid1_area, luse_grid2_area,             &
79         map_method, normalize_opt, output_opt,        &
80         restrict_type, num_srch_bins
81
82!-----------------------------------------------------------------------
83!
84!     local variables
85!
86!-----------------------------------------------------------------------
87
88      integer (kind=int_kind) :: n,   &  ! dummy counter
89                                 iunit   ! unit number for namelist file
90
91      character (char_len) :: nm_in
92#if defined ARGC
93      integer :: iargc
94      external iargc
95
96      if (iargc() == 1) then
97        call getarg(1, nm_in)
98      else
99        write(6,*) 'need name of namelist file'
100        stop
101      endif
102#else
103      write(6,*) 'enter name for namelist file'
104      read(5,*) nm_in
105#endif
106
107!-----------------------------------------------------------------------
108!
109!     initialize timers
110!
111!-----------------------------------------------------------------------
112
113      call timers_init
114      do n=1,max_timers
115        call timer_clear(n)
116      end do
117
118!-----------------------------------------------------------------------
119!
120!     read input namelist
121!
122!-----------------------------------------------------------------------
123
124      grid1_file    = 'unknown'
125      grid2_file    = 'unknown'
126      interp_file1  = 'unknown'
127      interp_file2  = 'unknown'
128      map1_name     = 'unknown'
129      map2_name     = 'unknown'
130      luse_grid1_area = .false.
131      luse_grid2_area = .false.
132      num_maps      = 2
133      map_type      = 1
134      normalize_opt = 'fracarea'
135      output_opt    = 'scrip'
136      restrict_type = 'latitude'
137      num_srch_bins = 900
138
139      call get_unit(iunit)
140      open(iunit, file=nm_in, status='old', form='formatted')
141      read(iunit, nml=remap_inputs)
142      call release_unit(iunit)
143
144      select case(map_method)
145      case ('conservative')
146        map_type = map_type_conserv
147        luse_grid_centers = .false.
148      case ('bilinear')
149        map_type = map_type_bilinear
150        luse_grid_centers = .true.
151      case ('bicubic')
152        map_type = map_type_bicubic
153        luse_grid_centers = .true.
154      case ('distwgt')
155        map_type = map_type_distwgt
156        luse_grid_centers = .true.
157      case default
158        stop 'unknown mapping method'
159      end select
160
161      select case(normalize_opt(1:4))
162      case ('none')
163        norm_opt = norm_opt_none
164      case ('frac')
165        norm_opt = norm_opt_frcarea
166      case ('dest')
167        norm_opt = norm_opt_dstarea
168      case default
169        stop 'unknown normalization option'
170      end select
171
172!-----------------------------------------------------------------------
173!
174!     initialize grid information for both grids
175!
176!-----------------------------------------------------------------------
177
178      call grid_init(grid1_file, grid2_file)
179
180      write(stdout, *) ' Computing remappings between: ',grid1_name
181      write(stdout, *) '                          and  ',grid2_name
182
183!-----------------------------------------------------------------------
184!
185!     initialize some remapping variables.
186!
187!-----------------------------------------------------------------------
188
189      call init_remap_vars
190
191!-----------------------------------------------------------------------
192!
193!     call appropriate interpolation setup routine based on type of
194!     remapping requested.
195!
196!-----------------------------------------------------------------------
197
198      select case(map_type)
199      case(map_type_conserv)
200        call remap_conserv
201      case(map_type_bilinear)
202        call remap_bilin
203      case(map_type_distwgt)
204        call remap_distwgt
205      case(map_type_bicubic)
206        call remap_bicub
207      case default
208        stop 'Invalid Map Type'
209      end select
210
211!-----------------------------------------------------------------------
212!
213!     reduce size of remapping arrays and then write remapping info
214!     to a file.
215!
216!-----------------------------------------------------------------------
217
218      if (num_links_map1 /= max_links_map1) then
219        call resize_remap_vars(1, num_links_map1-max_links_map1)
220      endif
221      if ((num_maps > 1) .and. (num_links_map2 /= max_links_map2)) then
222        call resize_remap_vars(2, num_links_map2-max_links_map2)
223      endif
224
225      call write_remap(map1_name, map2_name, &
226                       interp_file1, interp_file2, output_opt)
227
228!-----------------------------------------------------------------------
229
230      end program scrip
231
232!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Note: See TracBrowser for help on using the repository browser.