ROMS
Loading...
Searching...
No Matches
set_ngfldr.F
Go to the documentation of this file.
1#include "cppdefs.h"
2#ifdef ADJOINT
3 SUBROUTINE set_ngfldr (ng, model, ifield, &
4 & LBi, UBi, UBj, Istr, Iend, Jrec, &
5 & Finp, Fout, update)
6!
7!git $Id$
8!================================================== Hernan G. Arango ===
9! Copyright (c) 2002-2025 The ROMS Group !
10! Licensed under a MIT/X style license !
11! See License_ROMS.md !
12!=======================================================================
13! !
14! This subroutine time-interpolates backwards in time requested !
15! non-grided field from time snapshots of input data. !
16! !
17! On Input: !
18! !
19! ng Nested grid number. !
20! model Calling model identifier. !
21! ifield Field ID. !
22! LBi Finp/Fout 1st dimension lower-bound value. !
23! UBi Finp/Fout 1st dimension upper-bound value. !
24! UBj Finp/Fout 2nd dimension upper-bound value, if any. !
25! Otherwise, a value of one is expected. !
26! Istr Starting location to process in the 1st dimension. !
27! Iend Ending location to process in the 1st dimension. !
28! Jrec Number of records to process in the 2nd dimenision, !
29! if any, Otherwise, a value of one is expected. !
30! Finp Latest two-snapshopts of field to interpolate. !
31! !
32! On Output: !
33! !
34! Fout Interpolated field. !
35! update Switch indicating successful interpolation. !
36! !
37!=======================================================================
38!
39 USE mod_param
40 USE mod_parallel
41 USE mod_iounits
42 USE mod_ncparam
43 USE mod_scalars
44!
45 implicit none
46!
47! Imported variable declarations.
48!
49 logical, intent(out) :: update
50
51 integer, intent(in) :: ng, model, ifield
52 integer, intent(in) :: LBi, UBi, UBj, Istr, Iend, Jrec
53
54 real(r8), intent(in) :: Finp(LBi:UBi,UBj,2)
55
56 real(r8), intent(out) :: Fout(LBi:UBi,UBj)
57!
58! Local variable declarations.
59!
60 logical :: Lonerec
61
62 integer :: Tindex, i, it1, it2, j
63
64 real(dp) :: SecScale, fac, fac1, fac2
65!
66!----------------------------------------------------------------------
67! Set up requested field from data snapshots.
68!----------------------------------------------------------------------
69!
70! Get requested field information from global storage.
71!
72 lonerec=linfo(3,ifield,ng)
73 tindex=iinfo(8,ifield,ng)
74 update=.true.
75!
76! Set linear, time interpolation factors. Fractional seconds are
77! rounded to the nearest milliseconds integer towards zero in the
78! time interpolation weights.
79!
80 secscale=1000.0_dp ! seconds to milliseconds
81 it1=3-tindex
82 it2=tindex
83 fac1=anint((time(ng)-tintrp(it2,ifield,ng))*secscale,dp)
84 fac2=anint((tintrp(it1,ifield,ng)-time(ng))*secscale,dp)
85!
86! Load time-invariant data. Time interpolation is not necessary.
87!
88 IF (lonerec) THEN
89 DO j=1,jrec
90 DO i=istr,iend
91 fout(i,j)=finp(i,j,tindex)
92 END DO
93 END DO
94!
95! Time-interpolate.
96!
97 ELSE IF (((fac1*fac2).ge.0.0_dp).and.(fac1+fac2).gt.0.0_dp) THEN
98 fac=1.0_dp/(fac1+fac2)
99 fac1=fac*fac1 ! nondimensional
100 fac2=fac*fac2 ! nondimensional
101 DO j=1,jrec
102 DO i=istr,iend
103 fout(i,j)=fac1*finp(i,j,it1)+fac2*finp(i,j,it2)
104 END DO
105 END DO
106!
107! Activate synchronization flag if a new time record needs to be
108! read in at the next time step.
109!
110 IF ((time(ng)-dt(ng)).lt.tintrp(it2,ifield,ng)) THEN
111 synchro_flag(ng)=.true.
112 END IF
113!
114! Unable to interpolate field. Activate error flag to quit.
115!
116 ELSE
117 IF (master) THEN
118 WRITE (stdout,10) trim(vname(1,ifield)), tdays(ng), &
119 & finfo(1,ifield,ng), finfo(2,ifield,ng), &
120 & finfo(3,ifield,ng), finfo(4,ifield,ng), &
121 & tintrp(it1,ifield,ng)*sec2day, &
122 & tintrp(it2,ifield,ng)*sec2day, &
123 & fac1*sec2day/secscale, &
124 & fac2*sec2day/secscale
125 END IF
126 10 FORMAT (/,' SET_NGFLDR - current model time', &
127 & ' exceeds ending value for variable: ',a, &
128 & /,14x,'TDAYS = ',f15.4, &
129 & /,14x,'Data Tmin = ',f15.4,2x,'Data Tmax = ',f15.4, &
130 & /,14x,'Data Tstr = ',f15.4,2x,'Data Tend = ',f15.4, &
131 & /,14x,'TINTRP1 = ',f15.4,2x,'TINTRP2 = ',f15.4, &
132 & /,14x,'FAC1 = ',f15.4,2x,'FAC2 = ',f15.4)
133 exit_flag=2
134 update=.false.
135 END IF
136 RETURN
137 END SUBROUTINE set_ngfldr
138#else
139 SUBROUTINE set_ngfldr
140 RETURN
141 END SUBROUTINE set_ngfldr
142#endif
integer stdout
logical, dimension(:,:,:), allocatable linfo
real(dp), dimension(:,:,:), allocatable tintrp
real(dp), dimension(:,:,:), allocatable finfo
character(len=maxlen), dimension(6, 0:nv) vname
integer, dimension(:,:,:), allocatable iinfo
logical master
real(dp), dimension(:), allocatable dt
logical, dimension(:), allocatable synchro_flag
real(dp), dimension(:), allocatable tdays
real(dp), parameter sec2day
integer exit_flag
real(dp), dimension(:), allocatable time
subroutine set_ngfldr(ng, model, ifield, lbi, ubi, ubj, istr, iend, jrec, finp, fout, update)
Definition set_ngfldr.F:6