ROMS
Loading...
Searching...
No Matches
nrutil Module Reference

Data Types

interface  array_copy
 
interface  arth
 
interface  gasdev
 
interface  ran1
 
interface  reallocate
 

Functions/Subroutines

subroutine array_copy_r (src, dest, n_copied, n_not_copied)
 
subroutine array_copy_d (src, dest, n_copied, n_not_copied)
 
subroutine array_copy_i (src, dest, n_copied, n_not_copied)
 
real(r4) function, dimension(n) arth_r (first, increment, n)
 
real(dp) function, dimension(n) arth_d (first, increment, n)
 
integer(i8b) function, dimension(n) arth_i (first, increment, n)
 
subroutine nrerror (string)
 
real(r4) function, dimension(:), pointer reallocate_rv (p, n)
 
integer(i8b) function, dimension(:), pointer reallocate_iv (p, n)
 
character(len=1) function, dimension(:), pointer reallocate_hv (p, n)
 
real(r4) function, dimension(:,:), pointer reallocate_rm (p, n, m)
 
integer(i8b) function, dimension(:,:), pointer reallocate_im (p, n, m)
 

Variables

integer(i8b), parameter npar_arth = 16
 
integer(i8b), parameter npar2_arth = 8
 

Function/Subroutine Documentation

◆ array_copy_d()

subroutine nrutil::array_copy_d ( real(dp), dimension(:), intent(in) src,
real(dp), dimension(:), intent(out) dest,
integer(i8b), intent(out) n_copied,
integer(i8b), intent(out) n_not_copied )

Definition at line 96 of file nrutil.F.

97!
98!=======================================================================
99! !
100! Copy double precision array where size of source not known in !
101! advance. !
102! !
103!=======================================================================
104!
105! Imported variable declarations.
106!
107 real(dp), intent(in) :: src(:)
108 real(dp), intent(out) :: dest(:)
109
110 integer(i8b), intent(out) :: n_copied, n_not_copied
111!
112!-----------------------------------------------------------------------
113! Copy double precision array.
114!-----------------------------------------------------------------------
115!
116 n_copied=min(SIZE(src), SIZE(dest))
117 n_not_copied=size(src)-n_copied
118 dest(1:n_copied)=src(1:n_copied)
119
120 RETURN

◆ array_copy_i()

subroutine nrutil::array_copy_i ( integer(i8b), dimension(:), intent(in) src,
integer(i8b), dimension(:), intent(out) dest,
integer(i8b), intent(out) n_copied,
integer(i8b), intent(out) n_not_copied )

Definition at line 123 of file nrutil.F.

124!
125!=======================================================================
126! !
127! Copy integer array where size of source not known in advance. !
128! !
129!=======================================================================
130!
131! Imported variable declarations.
132!
133 integer(i8b), intent(in) :: src(:)
134 integer(i8b), intent(out) :: dest(:)
135
136 integer(i8b), intent(out) :: n_copied, n_not_copied
137!
138!-----------------------------------------------------------------------
139! Copy integer array.
140!-----------------------------------------------------------------------
141!
142 n_copied=min(size(src),size(dest))
143 n_not_copied=size(src)-n_copied
144 dest(1:n_copied)=src(1:n_copied)
145
146 RETURN

◆ array_copy_r()

subroutine nrutil::array_copy_r ( real(r4), dimension(:), intent(in) src,
real(r4), dimension(:), intent(out) dest,
integer(i8b), intent(out) n_copied,
integer(i8b), intent(out) n_not_copied )

Definition at line 69 of file nrutil.F.

70!
71!=======================================================================
72! !
73! Copy single precision array where size of source not known in !
74! advance. !
75! !
76!=======================================================================
77!
78! Imported variable declarations.
79!
80 real(r4), intent(in) :: src(:)
81 real(r4), intent(out) :: dest(:)
82
83 integer(i8b), intent(out) :: n_copied, n_not_copied
84!
85!-----------------------------------------------------------------------
86! Copy single precision array.
87!-----------------------------------------------------------------------
88!
89 n_copied=min(SIZE(src), SIZE(dest))
90 n_not_copied=SIZE(src)-n_copied
91 dest(1:n_copied)=src(1:n_copied)
92
93 RETURN

◆ arth_d()

real(dp) function, dimension(n) nrutil::arth_d ( real(dp), intent(in) first,
real(dp), intent(in) increment,
integer(i8b), intent(in) n )

Definition at line 198 of file nrutil.F.

199!
200!=======================================================================
201! !
202! Array function returning an arithmetic progression, double !
203! precision. !
204! !
205!=======================================================================
206!
207! Imported variable declarations.
208!
209 integer(i8b), intent(in) :: n
210
211 real(dp), intent(in) :: first, increment
212 real(dp), dimension(n) :: arth_d
213!
214! Local variable declarations.
215!
216 integer(i8b) :: k, k2
217
218 real(dp) :: temp
219!
220!----------------------------------------------------------------------
221! Set arithmetic progression.
222!----------------------------------------------------------------------
223!
224 IF (n.gt.0) arth_d(1)=first
225 IF (n.le.npar_arth) THEN
226 DO k=2,n
227 arth_d(k)=arth_d(k-1)+increment
228 END DO
229 ELSE
230 DO k=2,npar2_arth
231 arth_d(k)=arth_d(k-1)+increment
232 END DO
233 temp=increment*npar2_arth
234 k=npar2_arth
235 DO
236 IF (k.ge.n) EXIT
237 k2=k+k
238 arth_d(k+1:min(k2,n))=temp+arth_d(1:min(k,n-k))
239 temp=temp+temp
240 k=k2
241 END DO
242 END IF
243
244 RETURN

Referenced by nrutil::arth::arth_d().

Here is the caller graph for this function:

◆ arth_i()

integer(i8b) function, dimension(n) nrutil::arth_i ( integer(i8b), intent(in) first,
integer(i8b), intent(in) increment,
integer(i8b), intent(in) n )

Definition at line 247 of file nrutil.F.

248!
249!=======================================================================
250! !
251! Integer array function returning an arithmetic progression. !
252! !
253!=======================================================================
254!
255! Imported variable declarations.
256!
257 integer(i8b), intent(in) :: first, increment, n
258 integer(i8b), dimension(n) :: arth_i
259!
260! Local variable declarations.
261!
262 integer(i8b) :: k, k2, temp
263!
264!----------------------------------------------------------------------
265! Set arithmetic progression.
266!----------------------------------------------------------------------
267!
268 IF (n.gt.0) arth_i(1)=first
269 IF (n.le.npar_arth) THEN
270 DO k=2,n
271 arth_i(k)=arth_i(k-1)+increment
272 END DO
273 ELSE
274 DO k=2,npar2_arth
275 arth_i(k)=arth_i(k-1)+increment
276 END DO
277 temp=increment*npar2_arth
278 k=npar2_arth
279 DO
280 IF (k.ge.n) EXIT
281 k2=k+k
282 arth_i(k+1:min(k2,n))=temp+arth_i(1:min(k,n-k))
283 temp=temp+temp
284 k=k2
285 END DO
286 END IF
287
288 RETURN

Referenced by nrutil::arth::arth_i().

Here is the caller graph for this function:

◆ arth_r()

real(r4) function, dimension(n) nrutil::arth_r ( real(r4), intent(in) first,
real(r4), intent(in) increment,
integer(i8b), intent(in) n )

Definition at line 149 of file nrutil.F.

150!
151!=======================================================================
152! !
153! Array function returning an arithmetic progression, single !
154! precision. !
155! !
156!=======================================================================
157!
158! Imported variable declarations.
159!
160 integer(i8b), intent(in) :: n
161
162 real(r4), intent(in) :: first, increment
163 real(r4), dimension(n) :: arth_r
164!
165! Local variable declarations.
166!
167 integer(i8b) :: k, k2
168
169 real(r4) :: temp
170!
171!----------------------------------------------------------------------
172! Set arithmetic progression.
173!----------------------------------------------------------------------
174!
175 IF (n.gt.0) arth_r(1)=first
176 IF (n.le.npar_arth) THEN
177 DO k=2,n
178 arth_r(k)=arth_r(k-1)+increment
179 END DO
180 ELSE
181 DO k=2,npar2_arth
182 arth_r(k)=arth_r(k-1)+increment
183 END DO
184 temp=increment*npar2_arth
185 k=npar2_arth
186 DO
187 IF (k.ge.n) EXIT
188 k2=k+k
189 arth_r(k+1:min(k2,n))=temp+arth_r(1:min(k,n-k))
190 temp=temp+temp
191 k=k2
192 END DO
193 END IF
194
195 RETURN

Referenced by nrutil::arth::arth_r().

Here is the caller graph for this function:

◆ nrerror()

subroutine nrutil::nrerror ( character(len=*), intent(in) string)

Definition at line 291 of file nrutil.F.

292!
293!=======================================================================
294! !
295! Report an error message and the die. !
296! !
297!=======================================================================
298!
299 USE mod_iounits, ONLY : stdout
300!
301! Imported variable declarations.
302!
303 character(len=*), intent(in) :: string
304!
305!-----------------------------------------------------------------------
306! Report error message to standard output and terminate execution.
307!-----------------------------------------------------------------------
308!
309 WRITE (stdout,10) string, 'program terminated by NRERROR'
310 10 FORMAT (/,1x,a,/20x,a)
311 stop
312
integer stdout

References mod_iounits::stdout.

Referenced by ran_state::ran_init(), nrutil::reallocate::reallocate_hv(), nrutil::reallocate::reallocate_im(), nrutil::reallocate::reallocate_iv(), nrutil::reallocate::reallocate_rm(), and nrutil::reallocate::reallocate_rv().

Here is the caller graph for this function:

◆ reallocate_hv()

character (len=1) function, dimension(:), pointer nrutil::reallocate_hv ( character (len=1), dimension(:), pointer p,
integer(i8b), intent(in) n )

Definition at line 385 of file nrutil.F.

386!
387!=======================================================================
388! !
389! Reallocate a pointer of a character vector to a new size, !
390! preserving its previous content. !
391! !
392!=======================================================================
393!
394! Imported variable declarations.
395!
396 character (len=1), pointer :: p(:)
397 character (len=1), pointer :: reallocate_hv(:)
398
399 integer(i8b), intent(in) :: n
400!
401! Local variable declarations.
402!
403 integer(i8b) :: nold, ierr
404!
405!-----------------------------------------------------------------------
406! Reallocate pointer for a integer vector.
407!-----------------------------------------------------------------------
408!
409 ALLOCATE (reallocate_hv(n),stat=ierr)
410 IF (ierr.ne.0) &
411 & CALL nrerror ('REALLOCATE_HV: error while allocating memory')
412 IF (.not.ASSOCIATED(p)) RETURN
413 nold=SIZE(p)
414 reallocate_hv(1:min(nold,n))=p(1:min(nold,n))
415 DEALLOCATE (p)
416
417 RETURN

Referenced by nrutil::reallocate::reallocate_hv().

Here is the caller graph for this function:

◆ reallocate_im()

integer(i8b) function, dimension(:,:), pointer nrutil::reallocate_im ( integer(i8b), dimension(:,:), pointer p,
integer(i8b), intent(in) n,
integer(i8b), intent(in) m )

Definition at line 457 of file nrutil.F.

458!
459!=======================================================================
460! !
461! Reallocate a pointer of a integer matrix to a new size, preserving !
462! its previous content. !
463! !
464!=======================================================================
465!
466! Imported variable declarations.
467!
468 integer(i8b), pointer :: p(:,:)
469 integer(i8b), pointer :: reallocate_im(:,:)
470
471 integer(i8b), intent(in) :: n, m
472!
473! Local variable declarations.
474!
475 integer(i8b) :: nold, mold, ierr
476!
477!-----------------------------------------------------------------------
478! Reallocate pointer for a integer matrix.
479!-----------------------------------------------------------------------
480!
481 ALLOCATE (reallocate_im(n,m), stat=ierr)
482 IF (ierr.ne.0) &
483 & CALL nrerror ('REALLOCATE_IM: error while allocating memory')
484 IF (.not.ASSOCIATED(p)) RETURN
485 nold=SIZE(p,1)
486 mold=SIZE(p,2)
487 reallocate_im(1:min(nold,n),1:min(mold,m))= &
488 & p(1:min(nold,n),1:min(mold,m))
489 DEALLOCATE (p)
490
491 RETURN

Referenced by nrutil::reallocate::reallocate_im().

Here is the caller graph for this function:

◆ reallocate_iv()

integer(i8b) function, dimension(:), pointer nrutil::reallocate_iv ( integer(i8b), dimension(:), pointer p,
integer(i8b), intent(in) n )

Definition at line 350 of file nrutil.F.

351!
352!=======================================================================
353! !
354! Reallocate a pointer of a integer vector to a new size, preserving !
355! its previous content. !
356! !
357!=======================================================================
358!
359! Imported variable declarations.
360!
361 integer(i8b), pointer :: p(:)
362 integer(i8b), pointer :: reallocate_iv(:)
363
364 integer(i8b), intent(in) :: n
365!
366! Local variable declarations.
367!
368 integer(i8b) :: nold, ierr
369!
370!-----------------------------------------------------------------------
371! Reallocate pointer for a integer vector.
372!-----------------------------------------------------------------------
373!
374 ALLOCATE (reallocate_iv(n), stat=ierr)
375 IF (ierr.ne.0) &
376 & CALL nrerror ('REALLOCATE_IV: error while allocating memory')
377 IF (.not.ASSOCIATED(p)) RETURN
378 nold=SIZE(p)
379 reallocate_iv(1:min(nold,n))=p(1:min(nold,n))
380 DEALLOCATE (p)
381
382 RETURN

Referenced by nrutil::reallocate::reallocate_iv().

Here is the caller graph for this function:

◆ reallocate_rm()

real(r4) function, dimension(:,:), pointer nrutil::reallocate_rm ( real(r4), dimension(:,:), pointer p,
integer(i8b), intent(in) n,
integer(i8b), intent(in) m )

Definition at line 420 of file nrutil.F.

421!
422!=======================================================================
423! !
424! Reallocate a pointer of a single precision matrix to a new size, !
425! preserving its previous content. !
426! !
427!=======================================================================
428!
429! Imported variable declarations.
430!
431 real(r4), pointer :: p(:,:)
432 real(r4), pointer :: reallocate_rm(:,:)
433
434 integer(i8b), intent(in) :: n, m
435!
436! Local variable declarations.
437!
438 integer(i8b) :: nold, mold, ierr
439!
440!-----------------------------------------------------------------------
441! Reallocate pointer for a single precision matrix.
442!-----------------------------------------------------------------------
443!
444 ALLOCATE (reallocate_rm(n,m), stat=ierr)
445 IF (ierr.ne.0) &
446 & CALL nrerror ('REALLOCATE_RM: error while allocating memory')
447 IF (.not.ASSOCIATED(p)) RETURN
448 nold=SIZE(p,1)
449 mold=SIZE(p,2)
450 reallocate_rm(1:min(nold,n),1:min(mold,m))= &
451 & p(1:min(nold,n),1:min(mold,m))
452 DEALLOCATE (p)
453
454 RETURN

Referenced by nrutil::reallocate::reallocate_rm().

Here is the caller graph for this function:

◆ reallocate_rv()

real(r4) function, dimension(:), pointer nrutil::reallocate_rv ( real(r4), dimension(:), pointer p,
integer(i8b), intent(in) n )

Definition at line 315 of file nrutil.F.

316!
317!=======================================================================
318! !
319! Reallocate a pointer of a single precision vector to a new size, !
320! preserving its previous content. !
321! !
322!=======================================================================
323!
324! Imported variable declarations.
325!
326 real(r4), pointer :: p(:)
327 real(r4), pointer :: reallocate_rv(:)
328
329 integer(i8b), intent(in) :: n
330!
331! Local variable declarations.
332!
333 integer(i8b) :: nold, ierr
334!
335!-----------------------------------------------------------------------
336! Reallocate pointer for a single precision vector.
337!-----------------------------------------------------------------------
338!
339 ALLOCATE (reallocate_rv(n), stat=ierr)
340 IF (ierr.ne.0) &
341 & CALL nrerror ('REALLOCATE_RV: error while allocating memory')
342 IF (.not.ASSOCIATED(p)) RETURN
343 nold=SIZE(p)
344 reallocate_rv(1:min(nold,n))=p(1:min(nold,n))
345 DEALLOCATE (p)
346
347 RETURN

Referenced by nrutil::reallocate::reallocate_rv().

Here is the caller graph for this function:

Variable Documentation

◆ npar2_arth

integer(i8b), parameter nrutil::npar2_arth = 8

Definition at line 27 of file nrutil.F.

27 integer(i8b), parameter :: NPAR2_ARTH = 8

Referenced by nrutil::arth::arth_d(), nrutil::arth::arth_i(), and nrutil::arth::arth_r().

◆ npar_arth

integer(i8b), parameter nrutil::npar_arth = 16

Definition at line 26 of file nrutil.F.

26 integer(i8b), parameter :: NPAR_ARTH = 16

Referenced by nrutil::arth::arth_d(), nrutil::arth::arth_i(), and nrutil::arth::arth_r().