ROMS
Loading...
Searching...
No Matches
Functions/Subroutines
analytical_mod Module Reference

Functions/Subroutines

subroutine ana_biology (ng, tile, model)
 
subroutine ana_biology_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, t)
 
subroutine ana_btflux (ng, tile, model, itrc)
 
subroutine ana_btflux_tile (ng, tile, model, itrc, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, btflux)
 
subroutine ana_cloud (ng, tile, model)
 
subroutine ana_cloud_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, cloud)
 
subroutine ana_diag (ng, tile, model)
 
subroutine ana_diag_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, u, v, ubar, vbar)
 
subroutine ana_dqdsst (ng, tile, model)
 
subroutine ana_dqdsst_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, hz, dqdt)
 
subroutine ana_drag (ng, tile, model)
 
subroutine ana_drag_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, bottom, zobot)
 
subroutine ana_fsobc (ng, tile, model)
 
subroutine ana_fsobc_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs)
 
subroutine ana_sponge (ng, tile, model)
 
subroutine ana_sponge_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs)
 
subroutine ana_humid (ng, tile, model)
 
subroutine ana_humid_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, hair)
 
subroutine ana_initial (ng, tile, model)
 
subroutine ana_nlminitial_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, h, lonr, latr, xr, yr, z_r, u, v, t, ubar, vbar, zeta)
 
subroutine ana_tlminitial_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, kstp, nstp, tl_u, tl_v, tl_t, tl_ubar, tl_vbar, tl_zeta)
 
subroutine ana_adminitial_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, knew, nstp, ad_u, ad_v, ad_t, ad_ubar, ad_vbar, ad_zeta)
 
subroutine ana_m2clima (ng, tile, model)
 
subroutine ana_m2clima_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs)
 
subroutine ana_m2obc (ng, tile, model)
 
subroutine ana_m2obc_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, knew, angler, h, pm, pn, on_u, umask, zeta)
 
subroutine ana_m3clima (ng, tile, model)
 
subroutine ana_m3clima_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs)
 
subroutine ana_m3obc (ng, tile, model)
 
subroutine ana_m3obc_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs)
 
subroutine ana_mask (ng, tile, model)
 
subroutine ana_mask_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, pmask, rmask, umask, vmask)
 
subroutine ana_nudgcoef (ng, tile, model)
 
subroutine ana_nudgcoef_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs)
 
subroutine ana_pair (ng, tile, model)
 
subroutine ana_pair_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, pair)
 
subroutine ana_passive (ng, tile, model)
 
subroutine ana_passive_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, t)
 
subroutine ana_perturb (ng, tile, model)
 
subroutine ana_perturb_tile (ng, tile, model, lbi, ubi, lbj, ubj, lbij, ubij, imins, imaxs, jmins, jmaxs, kstp, krhs, knew, nstp, nrhs, nnew, ad_t_obc, ad_u_obc, ad_v_obc, ad_ubar_obc, ad_vbar_obc, ad_zeta_obc, ad_ustr, ad_vstr, ad_tflux, ad_t, ad_u, ad_v, ad_ubar, ad_vbar, ad_zeta, tl_t_obc, tl_u_obc, tl_v_obc, tl_ubar_obc, tl_vbar_obc, tl_zeta_obc, tl_ustr, tl_vstr, tl_tflux, tl_t, tl_u, tl_v, tl_ubar, tl_vbar, tl_zeta)
 
subroutine ana_psource (ng, tile, model)
 
subroutine ana_psource_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, nnew, knew, zeta, ubar, vbar, u, v, z_w, h, on_u, om_v)
 
subroutine ana_rain (ng, tile, model)
 
subroutine ana_rain_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, rain)
 
subroutine ana_respiration (ng, tile, model)
 
subroutine ana_respiration_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, respiration)
 
subroutine ana_scope (ng, tile, model)
 
subroutine ana_scope_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, rmask, umask, vmask, rscope, uscope, vscope)
 
subroutine ana_sediment (ng, tile, model)
 
subroutine ana_sediment_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, pm, pn, xr, yr, rho, t, bed, bed_frac, bed_mass, bottom)
 
subroutine ana_smflux (ng, tile, model)
 
subroutine ana_smflux_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, angler, lonr, latr, xr, yr, tl_sustr, tl_svstr, sustr, svstr)
 
subroutine ana_specir (ng, tile, model)
 
subroutine ana_specir_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, lonr, latr, cloud, hair, tair, pair, uwind, vwind, specir, avcos)
 
subroutine ana_spinning (ng, tile, model)
 
subroutine ana_spinning_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, lonr, latr xr, yr, f, omn, fomn)
 
subroutine ana_srflux (ng, tile, model)
 
subroutine ana_srflux_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, lonr, latr, cloud, hair, tair, pair, srflx)
 
subroutine ana_ssh (ng, tile, model)
 
subroutine ana_ssh_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs)
 
subroutine ana_sss (ng, tile, model)
 
subroutine ana_sss_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, sss)
 
subroutine ana_sst (ng, tile, model)
 
subroutine ana_sst_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, sst)
 
subroutine ana_stflux (ng, tile, model, itrc)
 
subroutine ana_stflux_tile (ng, tile, model, itrc, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, srflx, stflux)
 
subroutine ana_tair (ng, tile, model)
 
subroutine ana_tair_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, tair)
 
subroutine ana_tclima (ng, tile, model)
 
subroutine ana_tclima_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs)
 
subroutine ana_tobc (ng, tile, model)
 
subroutine ana_tobc_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, nstp, z_r, t)
 
subroutine ana_vmix (ng, tile, model)
 
subroutine ana_vmix_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, knew, h, z_r, z_w, zeta, akv, akt)
 
subroutine ana_winds (ng, tile, model)
 
subroutine ana_winds_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, lonr, latr, xr, yr, uwind, vwind)
 
subroutine ana_wtype (ng, tile, model)
 
subroutine ana_wtype_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, h, jwtype)
 
subroutine ana_wwave (ng, tile, model)
 
subroutine ana_wwave_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, dwave, hwave, lwave, pwave_top, pwave_bot, uwave_rms, angler, h)
 

Function/Subroutine Documentation

◆ ana_adminitial_tile()

subroutine analytical_mod::ana_adminitial_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
integer, intent(in) knew,
integer, intent(in) nstp,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),2), intent(out) ad_u,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),2), intent(out) ad_v,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),3,nt(ng)), intent(out) ad_t,
real(r8), dimension(lbi:ubi,lbj:ubj,:), intent(out) ad_ubar,
real(r8), dimension(lbi:ubi,lbj:ubj,:), intent(out) ad_vbar,
real(r8), dimension(lbi:ubi,lbj:ubj,:), intent(out) ad_zeta )

Definition at line 1011 of file ana_initial.h.

1020!***********************************************************************
1021!
1022 USE mod_param
1023 USE mod_scalars
1024!
1025! Imported variable declarations.
1026!
1027 integer, intent(in) :: ng, tile, model
1028 integer, intent(in) :: LBi, UBi, LBj, UBj
1029 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
1030 integer, intent(in) :: knew
1031# ifdef SOLVE3D
1032 integer, intent(in) :: nstp
1033# endif
1034!
1035# ifdef ASSUMED_SHAPE
1036# ifdef SOLVE3D
1037 real(r8), intent(out) :: ad_u(LBi:,LBj:,:,:)
1038 real(r8), intent(out) :: ad_v(LBi:,LBj:,:,:)
1039 real(r8), intent(out) :: ad_t(LBi:,LBj:,:,:,:)
1040# endif
1041 real(r8), intent(out) :: ad_ubar(LBi:,LBj:,:)
1042 real(r8), intent(out) :: ad_vbar(LBi:,LBj:,:)
1043 real(r8), intent(out) :: ad_zeta(LBi:,LBj:,:)
1044# else
1045# ifdef SOLVE3D
1046 real(r8), intent(out) :: ad_u(LBi:UBi,LBj:UBj,N(ng),2)
1047 real(r8), intent(out) :: ad_v(LBi:UBi,LBj:UBj,N(ng),2)
1048 real(r8), intent(out) :: ad_t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
1049# endif
1050 real(r8), intent(out) :: ad_ubar(LBi:UBi,LBj:UBj,:)
1051 real(r8), intent(out) :: ad_vbar(LBi:UBi,LBj:UBj,:)
1052 real(r8), intent(out) :: ad_zeta(LBi:UBi,LBj:UBj,:)
1053# endif
1054!
1055! Local variable declarations.
1056!
1057 integer :: i, itrc, j, k
1058
1059# include "set_bounds.h"
1060!
1061!-----------------------------------------------------------------------
1062! Initial conditions for adjoint 2D momentum (s/m) components.
1063!-----------------------------------------------------------------------
1064!
1065 DO j=jstrt,jendt
1066 DO i=istrp,iendt
1067 ad_ubar(i,j,knew)=0.0_r8
1068 END DO
1069 END DO
1070 DO j=jstrp,jendt
1071 DO i=istrt,iendt
1072 ad_vbar(i,j,knew)=0.0_r8
1073 END DO
1074 END DO
1075!
1076!-----------------------------------------------------------------------
1077! Initial conditions for adjoint free-surface (1/m).
1078!-----------------------------------------------------------------------
1079!
1080 DO j=jstrt,jendt
1081 DO i=istrt,iendt
1082 ad_zeta(i,j,knew)=0.0_r8
1083 END DO
1084 END DO
1085# ifdef SOLVE3D
1086!
1087!-----------------------------------------------------------------------
1088! Initial conditions for adjoint 3D momentum components (s/m).
1089!-----------------------------------------------------------------------
1090!
1091 DO k=1,n(ng)
1092 DO j=jstrt,jendt
1093 DO i=istrp,iendt
1094 ad_u(i,j,k,nstp)=0.0_r8
1095 END DO
1096 END DO
1097 DO j=jstrp,jendt
1098 DO i=istrt,iendt
1099 ad_v(i,j,k,nstp)=0.0_r8
1100 END DO
1101 END DO
1102 END DO
1103!
1104!-----------------------------------------------------------------------
1105! Initial conditions for adjoint active tracers (1/Tunits).
1106!-----------------------------------------------------------------------
1107!
1108 DO itrc=1,nat
1109 DO k=1,n(ng)
1110 DO j=jstrt,jendt
1111 DO i=istrt,iendt
1112 ad_t(i,j,k,nstp,itrc)=0.0_r8
1113 END DO
1114 END DO
1115 END DO
1116 END DO
1117# endif
1118!
1119 RETURN
mod_param
Definition mod_param.F:2
mod_param::nat
integer nat
Definition mod_param.F:499
mod_param::n
integer, dimension(:), allocatable n
Definition mod_param.F:479
mod_scalars
Definition mod_scalars.F:2

References mod_param::nat.

Referenced by ana_initial().

Here is the caller graph for this function:

◆ ana_biology()

subroutine analytical_mod::ana_biology ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 2 of file ana_biology.h.

3!
4!! git $Id$
5!!======================================================================
6!! Copyright (c) 2002-2025 The ROMS Group !
7!! Licensed under a MIT/X style license !
8!! See License_ROMS.md !
9!=======================================================================
10! !
11! This routine sets initial conditions for biological tracer fields !
12! using analytical expressions. !
13! !
14!=======================================================================
15!
16 USE mod_param
17 USE mod_ncparam
18 USE mod_ocean
19!
20! Imported variable declarations.
21!
22 integer, intent(in) :: ng, tile, model
23!
24! Local variable declarations.
25!
26 character (len=*), parameter :: MyFile = &
27 & __FILE__
28!
29#include "tile.h"
30!
31 CALL ana_biology_tile (ng, tile, model, &
32 & lbi, ubi, lbj, ubj, &
33 & imins, imaxs, jmins, jmaxs, &
34 & ocean(ng) % t)
35!
36! Set analytical header file name used.
37!
38#ifdef DISTRIBUTE
39 IF (lanafile) THEN
40#else
41 IF (lanafile.and.(tile.eq.0)) THEN
42#endif
43 ananame( 1)=myfile
44 END IF
45!
46 RETURN
mod_ncparam
Definition mod_ncparam.F:2
mod_ncparam::lanafile
logical lanafile
Definition mod_ncparam.F:602
mod_ncparam::ananame
character(len=256), dimension(39) ananame
Definition mod_ncparam.F:604
mod_ocean
Definition mod_ocean.F:2
mod_ocean::ocean
type(t_ocean), dimension(:), allocatable ocean
Definition mod_ocean.F:351

References ana_biology_tile(), mod_ncparam::ananame, mod_ncparam::lanafile, and mod_ocean::ocean.

Referenced by ad_initial(), initial(), rp_initial(), and tl_initial().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_biology_tile()

subroutine analytical_mod::ana_biology_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),3,nt(ng)), intent(inout) t )

Definition at line 50 of file ana_biology.h.

54!***********************************************************************
55!
56 USE mod_param
57 USE mod_parallel
58 USE mod_biology
59 USE mod_ncparam
60 USE mod_iounits
61 USE mod_scalars
62!
63 USE stats_mod, ONLY : stats_3dfld
64!
65! Imported variable declarations.
66!
67 integer, intent(in) :: ng, tile, model
68 integer, intent(in) :: LBi, UBi, LBj, UBj
69 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
70!
71#ifdef ASSUMED_SHAPE
72 real(r8), intent(inout) :: t(LBi:,LBj:,:,:,:)
73#else
74 real(r8), intent(inout) :: t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
75#endif
76!
77! Local variable declarations.
78!
79 logical, save :: first = .true.
80
81 integer :: i, is, itrc, j, k
82
83#if defined BIO_FENNEL || defined NEMURO
84 real(r8) :: SiO4, cff1, cff2, temp
85#elif defined ECOSIM
86 real(r8) :: cff1, cff2, cff3, cff4, cff5, cff6, cff7, cff8, cff9
87 real(r8) :: cff10, cff11, cff12, cff13, cff14, cff15
88 real(r8) :: salt, sftm, temp
89#endif
90!
91! Maximum 80 biological tracers consider for field statistics.
92!
93 TYPE (T_STATS), save :: Stats(80)
94
95#include "set_bounds.h"
96!
97!-----------------------------------------------------------------------
98! Initialize field statistics structure.
99!-----------------------------------------------------------------------
100!
101 IF (first) THEN
102 first=.false.
103 DO i=1,SIZE(stats,1)
104 stats(i) % checksum=0_i8b
105 stats(i) % count=0.0_r8
106 stats(i) % min=large
107 stats(i) % max=-large
108 stats(i) % avg=0.0_r8
109 stats(i) % rms=0.0_r8
110 END DO
111 END IF
112
113#if defined BIO_FENNEL
114!
115!-----------------------------------------------------------------------
116! Fennel et al. (2006), nitrogen-based biology model.
117!-----------------------------------------------------------------------
118!
119 cff1=20.0_r8/3.0_r8
120 cff2= 2.0_r8/3.0_r8
121 DO k=1,n(ng)
122 DO j=jstrt,jendt
123 DO i=istrt,iendt
124 temp=t(i,j,k,1,itemp)
125 IF (temp.lt.8.0_r8) THEN
126 sio4=30.0_r8
127 ELSE IF ((temp.ge.8.0_r8).and.(temp.le.11.0_r8)) THEN
128 sio4=30.0_r8-((temp-8.0_r8)*cff1)
129 ELSE IF ((temp.gt.11.0_r8).and.(temp.le.13.0_r8)) THEN
130 sio4=10.0_r8-((temp-11.0_r8)*4.0_r8)
131 ELSE IF ((temp.gt.13.0_r8).and.(temp.le.16.0_r8)) THEN
132 sio4=2.0_r8-((temp-13.0_r8)*cff2)
133 ELSE IF (temp.gt.16.0_r8) THEN
134 sio4=0.0_r8
135 END IF
136 t(i,j,k,1,ino3_)=1.67_r8+0.5873_r8*sio4+ &
137 & 0.0144_r8*sio4**2+ &
138 & 0.0003099_r8*sio4**3
139 t(i,j,k,1,iphyt)=0.08_r8
140 t(i,j,k,1,izoop)=0.06_r8
141 t(i,j,k,1,inh4_)=0.1_r8
142 t(i,j,k,1,ilden)=0.02_r8
143 t(i,j,k,1,isden)=0.04_r8
144 t(i,j,k,1,ichlo)=0.02_r8
145#ifdef CARBON
146 t(i,j,k,1,itic_)=2100.0_r8
147 t(i,j,k,1,italk)=2350.0_r8
148 t(i,j,k,1,ildec)=0.002_r8
149 t(i,j,k,1,isdec)=0.06_r8
150#endif
151#ifdef OXYGEN
152 t(i,j,k,1,ioxyg)=10.0_r8/0.02241_r8
153#endif
154 END DO
155 END DO
156 END DO
157
158#elif defined NEMURO
159!
160!-----------------------------------------------------------------------
161! Nemuro lower trophic level ecosystem model.
162!-----------------------------------------------------------------------
163!
164 cff1=20.0_r8/3.0_r8
165 cff2= 2.0_r8/3.0_r8
166 DO k=1,n(ng)
167 DO j=jstrt,jendt
168 DO i=istrt,iendt
169 temp=t(i,j,k,1,itemp)
170 IF (temp.lt.8.0_r8) THEN
171 sio4=30.0_r8
172 ELSE IF ((temp.ge.8.0_r8).and.(temp.le.11.0_r8)) THEN
173 sio4=30.0_r8-((temp-8.0_r8)*cff1)
174 ELSE IF ((temp.gt.11.0_r8).and.(temp.le.13.0_r8)) THEN
175 sio4=10.0_r8-((temp-11.0_r8)*4.0_r8)
176 ELSE IF ((temp.gt.13.0_r8).and.(temp.le.16.0_r8)) THEN
177 sio4=2.0_r8-((temp-13.0_r8)*cff2)
178 ELSE IF (temp.gt.16.0_r8) THEN
179 sio4=0.0_r8
180 END IF
181 t(i,j,k,1,ino3_)=1.67_r8+0.5873_r8*sio4+ &
182 & 0.0144_r8*sio4**2+ &
183 & 0.0003099_r8*sio4**3
184 t(i,j,k,1,isphy)=0.06_r8
185 t(i,j,k,1,ilphy)=0.06_r8
186 t(i,j,k,1,iszoo)=0.05_r8
187 t(i,j,k,1,ilzoo)=0.05_r8
188 t(i,j,k,1,ipzoo)=0.05_r8
189 t(i,j,k,1,inh4_)=0.1_r8
190 t(i,j,k,1,ipon_)=0.001_r8
191 t(i,j,k,1,idon_)=0.001_r8
192 t(i,j,k,1,isioh)=sio4
193 t(i,j,k,1,iopal)=0.001_r8
194 END DO
195 END DO
196 END DO
197
198#elif defined NPZD_FRANKS || defined NPZD_POWELL
199!
200!-----------------------------------------------------------------------
201! NPZD biology model.
202!-----------------------------------------------------------------------
203!
204 DO k=1,n(ng)
205 DO j=jstrt,jendt
206 DO i=istrt,iendt
207 t(i,j,k,1,ino3_)=bioini(ino3_,ng)
208 t(i,j,k,1,iphyt)=bioini(iphyt,ng)
209 t(i,j,k,1,izoop)=bioini(izoop,ng)
210 t(i,j,k,1,isdet)=bioini(isdet,ng)
211 END DO
212 END DO
213 END DO
214
215#elif defined NPZD_IRON
216!
217!-----------------------------------------------------------------------
218! NPZD biology model with or without iron limitation on phytoplankton
219! growth.
220!-----------------------------------------------------------------------
221!
222 DO k=1,n(ng)
223 DO j=jstrt,jendt
224 DO i=istrt,iendt
225 t(i,j,k,1,ino3_)=bioini(ino3_,ng)
226 t(i,j,k,1,iphyt)=bioini(iphyt,ng)
227 t(i,j,k,1,izoop)=bioini(izoop,ng)
228 t(i,j,k,1,isdet)=bioini(isdet,ng)
229# ifdef IRON_LIMIT
230 t(i,j,k,1,ifphy)=bioini(ifphy,ng)
231 t(i,j,k,1,ifdis)=bioini(ifdis,ng)
232# endif
233 END DO
234 END DO
235 END DO
236
237#elif defined ECOSIM
238!
239!---------------------------------------------------------------------
240! EcoSim initial fields.
241!---------------------------------------------------------------------
242!
243! Assumed maximum temperature gradient.
244!
245 cff3=1.0_r8/14.0_r8
246 cff4=1.0_r8/16.0_r8
247 cff5=32.0_r8
248 cff7=1.0_r8/0.0157_r8
249 cff8=1.0_r8/6.625_r8
250 cff9=1.0_r8/16.0_r8
251 cff10=1.0_r8/15.0_r8
252 cff11=1.0_r8/8.0_r8
253 cff12=1.0_r8/128.0_r8
254 cff13=1.0_r8/1000.0_r8
255 cff14=1.0_r8/12.0_r8
256 cff15=cff5*cff8*cff14 ! mole N : gram Chl
257
258 DO k=n(ng),1,-1
259 DO j=jstrt,jendt
260 DO i=istrt,iendt
261!
262! Initialization of surface chlorophyll.
263!
264 sftm=t(i,j,n(ng),1,itemp)
265 temp=t(i,j,k,1,itemp)
266# ifdef SALINITY
267 salt=t(i,j,k,1,isalt)
268# endif
269 cff1=-0.0827_r8*sftm+2.6386_r8
270 cff2=max(0.00001_r8,cff1*(1.0_r8-(sftm-temp)*cff3))
271!
272! Initialization of nutrients.
273!
274 t(i,j,k,1,inh4_)=0.053_r8*temp+0.7990_r8
275 t(i,j,k,1,ino3_)=8.5_r8-cff2*cff15-t(i,j,k,1,inh4_)
276 t(i,j,k,1,ipo4_)=(t(i,j,k,1,inh4_)+t(i,j,k,1,ino3_))*cff4
277 t(i,j,k,1,ifeo_)=1.0_r8
278!
279! Assuming diatoms are 75% of initialized chlorophyll.
280!
281 t(i,j,k,1,isio_)=5.5_r8-(cff2*0.75_r8)*cff15*1.20_r8
282 t(i,j,k,1,idic_)=2000.0_r8
283!
284! Bacteria Initialization.
285!
286 DO is=1,nbac
287 t(i,j,k,1,ibacc(is))=0.85_r8
288 t(i,j,k,1,ibacn(is))=t(i,j,k,1,ibacc(is))*n2cbac(ng)
289 t(i,j,k,1,ibacp(is))=t(i,j,k,1,ibacc(is))*p2cbac(ng)
290 t(i,j,k,1,ibacf(is))=t(i,j,k,1,ibacc(is))*fe2cbac(ng)
291 END DO
292!
293! Initialize phytoplankton populations.
294!
295 t(i,j,k,1,iphyc(1))=max(0.02_r8, &
296 & 0.75_r8*0.75_r8*cff5*cff2*cff14)
297 t(i,j,k,1,iphyc(2))=max(0.02_r8, &
298 & 0.75_r8*0.25_r8*cff5*cff2*cff14)
299 t(i,j,k,1,iphyc(3))=max(0.02_r8, &
300 & 0.125_r8*cff5*cff2*cff14)
301 t(i,j,k,1,iphyc(4))=t(i,j,k,1,iphyc(3))
302 DO is=1,nphy
303 t(i,j,k,1,iphyn(is))=t(i,j,k,1,iphyc(is))*cff8
304 t(i,j,k,1,iphyp(is))=t(i,j,k,1,iphyn(is))*cff4
305 t(i,j,k,1,iphyf(is))=t(i,j,k,1,iphyc(is))*cff13
306 IF (iphys(is).gt.0) THEN
307 t(i,j,k,1,iphys(is))=t(i,j,k,1,iphyn(is))*1.20_r8
308 END IF
309!
310! Initialize Pigments in ugrams/liter (not umole/liter).
311! Chlorophyll-a
312!
313 cff6=12.0_r8/cff5
314 t(i,j,k,1,ipigs(is,1))=cff6*t(i,j,k,1,iphyc(is))
315!
316! Chlorophyll-b.
317!
318 cff6=cff5-b_c2cl(is,ng)
319 IF (ipigs(is,2).gt.0) THEN
320 t(i,j,k,1,ipigs(is,2))=t(i,j,k,1,ipigs(is,1))* &
321 & (b_chlb(is,ng)+ &
322 & mxchlb(is,ng)*cff6)
323 END IF
324!
325! Chlorophyll-c.
326!
327 IF (ipigs(is,3).gt.0) THEN
328 t(i,j,k,1,ipigs(is,3))=t(i,j,k,1,ipigs(is,1))* &
329 & (b_chlc(is,ng)+ &
330 & mxchlc(is,ng)*cff6)
331 END IF
332!
333! Photosynthetic Carotenoids.
334!
335 IF (ipigs(is,4).gt.0) THEN
336 t(i,j,k,1,ipigs(is,4))=t(i,j,k,1,ipigs(is,1))* &
337 & (b_psc(is,ng)+ &
338 & mxpsc(is,ng)*cff6)
339 END IF
340!
341! Photoprotective Carotenoids.
342!
343 IF (ipigs(is,5).gt.0) THEN
344 t(i,j,k,1,ipigs(is,5))=t(i,j,k,1,ipigs(is,1))* &
345 & (b_ppc(is,ng)+ &
346 & mxppc(is,ng)*cff6)
347 END IF
348!
349! Low Urobilin Phycoeurythin Carotenoids.
350!
351 IF (ipigs(is,6).gt.0) THEN
352 t(i,j,k,1,ipigs(is,6))=t(i,j,k,1,ipigs(is,1))* &
353 & (b_lpub(is,ng)+ &
354 & mxlpub(is,ng)*cff6)
355 END IF
356!
357! High Urobilin Phycoeurythin Carotenoids.
358!
359 IF (ipigs(is,7).gt.0) THEN
360 t(i,j,k,1,ipigs(is,7))=t(i,j,k,1,ipigs(is,1))* &
361 & (b_hpub(is,ng)+ &
362 & mxhpub(is,ng)*cff6)
363 END IF
364 END DO
365!
366! DOC initialization.
367!
368# ifdef SALINITY
369 cff6=max(0.001_r8,-0.9833_r8*salt+33.411_r8)
370# else
371 cff6=0.0_r8
372# endif
373 t(i,j,k,1,idomc(1))=0.1_r8
374 t(i,j,k,1,idomn(1))=t(i,j,k,1,idomc(1))*cff8
375 t(i,j,k,1,idomp(1))=t(i,j,k,1,idomn(1))*cff9
376 t(i,j,k,1,icdmc(1))=t(i,j,k,1,idomc(1))*cdocfrac_c(1,ng)
377 t(i,j,k,1,idomc(2))=15.254_r8*cff6+70.0_r8
378 t(i,j,k,1,idomn(2))=t(i,j,k,1,idomc(2))*cff10
379 t(i,j,k,1,idomp(2))=0.0_r8
380 t(i,j,k,1,icdmc(2))=(0.243_r8*cff6+0.055_r8)*cff7
381!
382! Fecal Initialization.
383!
384 DO is=1,nfec
385 t(i,j,k,1,ifecc(is))=0.002_r8
386 t(i,j,k,1,ifecn(is))=t(i,j,k,1,ifecc(is))*cff11
387 t(i,j,k,1,ifecp(is))=t(i,j,k,1,ifecc(is))*cff12
388 t(i,j,k,1,ifecf(is))=t(i,j,k,1,ifecc(is))*cff13
389 t(i,j,k,1,ifecs(is))=t(i,j,k,1,ifecc(is))*cff11
390 END DO
391 END DO
392 END DO
393 END DO
394#endif
395!
396! Report statistics.
397!
398 DO itrc=1,nbt
399 i=idbio(itrc)
400 CALL stats_3dfld (ng, tile, inlm, r3dvar, stats(itrc), 0, &
401 & lbi, ubi, lbj, ubj, 1, n(ng), t(:,:,:,1,i))
402 IF (domain(ng)%NorthEast_Corner(tile)) THEN
403 WRITE (stdout,10) trim(vname(2,idtvar(i)))//': '// &
404 & trim(vname(1,idtvar(i))), &
405 & ng, stats(itrc)%min, stats(itrc)%max
406 END IF
407 END DO
408!
409 10 FORMAT (3x,' ANA_BIOLOGY - ',a,/,19x, &
410 & '(Grid = ',i2.2,', Min = ',1p,e15.8,0p, &
411 & ' Max = ',1p,e15.8,0p,')')
412!
413 RETURN
mod_biology
Definition ecosim_mod.h:1
mod_biology::isden
integer isden
Definition fennel_mod.h:84
mod_biology::iphyn
integer, dimension(nphy) iphyn
Definition ecosim_mod.h:272
mod_biology::b_c2cl
real(r8), dimension(:,:), allocatable b_c2cl
Definition ecosim_mod.h:380
mod_biology::isioh
integer isioh
Definition nemuro_mod.h:187
mod_biology::mxppc
real(r8), dimension(:,:), allocatable mxppc
Definition ecosim_mod.h:391
mod_biology::mxchlc
real(r8), dimension(:,:), allocatable mxchlc
Definition ecosim_mod.h:387
mod_biology::ipzoo
integer ipzoo
Definition nemuro_mod.h:182
mod_biology::nfec
integer, parameter nfec
Definition ecosim_mod.h:204
mod_biology::mxpsc
real(r8), dimension(:,:), allocatable mxpsc
Definition ecosim_mod.h:389
mod_biology::ifphy
integer ifphy
Definition npzd_iron_mod.h:68
mod_biology::nbac
integer, parameter nbac
Definition ecosim_mod.h:202
mod_biology::b_chlc
real(r8), dimension(:,:), allocatable b_chlc
Definition ecosim_mod.h:388
mod_biology::ipon_
integer ipon_
Definition nemuro_mod.h:185
mod_biology::ibacc
integer, dimension(nbac) ibacc
Definition ecosim_mod.h:258
mod_biology::itic_
integer itic_
Definition fennel_mod.h:91
mod_biology::isdet
integer isdet
Definition npzd_Franks_mod.h:42
mod_biology::ilphy
integer ilphy
Definition nemuro_mod.h:178
mod_biology::mxchlb
real(r8), dimension(:,:), allocatable mxchlb
Definition ecosim_mod.h:385
mod_biology::ilden
integer ilden
Definition fennel_mod.h:83
mod_biology::b_psc
real(r8), dimension(:,:), allocatable b_psc
Definition ecosim_mod.h:390
mod_biology::ifecf
integer, dimension(nfec) ifecf
Definition ecosim_mod.h:269
mod_biology::idomn
integer, dimension(ndom) idomn
Definition ecosim_mod.h:264
mod_biology::ibacp
integer, dimension(nbac) ibacp
Definition ecosim_mod.h:260
mod_biology::ifecp
integer, dimension(nfec) ifecp
Definition ecosim_mod.h:268
mod_biology::ifecc
integer, dimension(nfec) ifecc
Definition ecosim_mod.h:266
mod_biology::isdec
integer isdec
Definition fennel_mod.h:90
mod_biology::bioini
real(r8), dimension(:,:), allocatable bioini
Definition npzd_Franks_mod.h:49
mod_biology::ino3_
integer ino3_
Definition ecosim_mod.h:277
mod_biology::iphyp
integer, dimension(nphy) iphyp
Definition ecosim_mod.h:273
mod_biology::iszoo
integer iszoo
Definition nemuro_mod.h:181
mod_biology::ipo4_
integer ipo4_
Definition ecosim_mod.h:279
mod_biology::p2cbac
real(r8), dimension(:), allocatable p2cbac
Definition ecosim_mod.h:480
mod_biology::ifecs
integer, dimension(nfec) ifecs
Definition ecosim_mod.h:270
mod_biology::italk
integer italk
Definition fennel_mod.h:92
mod_biology::icdmc
integer, dimension(ndom) icdmc
Definition ecosim_mod.h:262
mod_biology::b_hpub
real(r8), dimension(:,:), allocatable b_hpub
Definition ecosim_mod.h:396
mod_biology::ifdis
integer ifdis
Definition npzd_iron_mod.h:69
mod_biology::n2cbac
real(r8), dimension(:), allocatable n2cbac
Definition ecosim_mod.h:479
mod_biology::mxlpub
real(r8), dimension(:,:), allocatable mxlpub
Definition ecosim_mod.h:393
mod_biology::b_chlb
real(r8), dimension(:,:), allocatable b_chlb
Definition ecosim_mod.h:386
mod_biology::iphyt
integer iphyt
Definition fennel_mod.h:81
mod_biology::iphyc
integer, dimension(nphy) iphyc
Definition ecosim_mod.h:271
mod_biology::mxhpub
real(r8), dimension(:,:), allocatable mxhpub
Definition ecosim_mod.h:395
mod_biology::ibacf
integer, dimension(nbac) ibacf
Definition ecosim_mod.h:261
mod_biology::isphy
integer isphy
Definition nemuro_mod.h:179
mod_biology::b_ppc
real(r8), dimension(:,:), allocatable b_ppc
Definition ecosim_mod.h:392
mod_biology::ipigs
integer, dimension(nphy, npig) ipigs
Definition ecosim_mod.h:276
mod_biology::inh4_
integer inh4_
Definition ecosim_mod.h:278
mod_biology::idbio
integer, dimension(:), allocatable idbio
Definition ecosim_mod.h:256
mod_biology::idomp
integer, dimension(ndom) idomp
Definition ecosim_mod.h:265
mod_biology::ioxyg
integer ioxyg
Definition fennel_mod.h:98
mod_biology::nphy
integer, parameter nphy
Definition ecosim_mod.h:205
mod_biology::cdocfrac_c
real(r8), dimension(:,:), allocatable cdocfrac_c
Definition ecosim_mod.h:432
mod_biology::ibacn
integer, dimension(nbac) ibacn
Definition ecosim_mod.h:259
mod_biology::idic_
integer idic_
Definition ecosim_mod.h:282
mod_biology::idomc
integer, dimension(ndom) idomc
Definition ecosim_mod.h:263
mod_biology::b_lpub
real(r8), dimension(:,:), allocatable b_lpub
Definition ecosim_mod.h:394
mod_biology::iphyf
integer, dimension(nphy) iphyf
Definition ecosim_mod.h:274
mod_biology::ifeo_
integer ifeo_
Definition ecosim_mod.h:280
mod_biology::iphys
integer, dimension(nphy) iphys
Definition ecosim_mod.h:275
mod_biology::ifecn
integer, dimension(nfec) ifecn
Definition ecosim_mod.h:267
mod_biology::iopal
integer iopal
Definition nemuro_mod.h:188
mod_biology::izoop
integer izoop
Definition fennel_mod.h:82
mod_biology::fe2cbac
real(r8), dimension(:), allocatable fe2cbac
Definition ecosim_mod.h:481
mod_biology::ildec
integer ildec
Definition fennel_mod.h:89
mod_biology::idon_
integer idon_
Definition nemuro_mod.h:186
mod_biology::ichlo
integer ichlo
Definition fennel_mod.h:80
mod_biology::isio_
integer isio_
Definition ecosim_mod.h:281
mod_biology::ilzoo
integer ilzoo
Definition nemuro_mod.h:180
mod_iounits
Definition mod_iounits.F:2
mod_iounits::stdout
integer stdout
Definition mod_iounits.F:195
mod_ncparam::idtvar
integer, dimension(:), allocatable idtvar
Definition mod_ncparam.F:568
mod_ncparam::vname
character(len=maxlen), dimension(6, 0:nv) vname
Definition mod_ncparam.F:591
mod_parallel
Definition mod_parallel.F:2
mod_param::inlm
integer, parameter inlm
Definition mod_param.F:662
mod_param::r3dvar
integer, parameter r3dvar
Definition mod_param.F:721
mod_param::nbt
integer nbt
Definition mod_param.F:509
mod_param::domain
type(t_domain), dimension(:), allocatable domain
Definition mod_param.F:329
mod_scalars::large
real(dp), parameter large
Definition mod_scalars.F:823
mod_scalars::isalt
integer isalt
Definition mod_scalars.F:127
mod_scalars::itemp
integer itemp
Definition mod_scalars.F:126
stats_mod
Definition stats.F:2
stats_mod::stats_3dfld
subroutine, public stats_3dfld(ng, tile, model, gtype, s, extract_flag, lbi, ubi, lbj, ubj, lbk, ubk, f, fmask, debug)
Definition stats.F:342

References mod_biology::b_c2cl, mod_biology::b_chlb, mod_biology::b_chlc, mod_biology::b_hpub, mod_biology::b_lpub, mod_biology::b_ppc, mod_biology::b_psc, mod_biology::bioini, mod_biology::cdocfrac_c, mod_param::domain, mod_biology::fe2cbac, mod_biology::ibacc, mod_biology::ibacf, mod_biology::ibacn, mod_biology::ibacp, mod_biology::icdmc, mod_biology::ichlo, mod_biology::idbio, mod_biology::idic_, mod_biology::idomc, mod_biology::idomn, mod_biology::idomp, mod_biology::idon_, mod_ncparam::idtvar, mod_biology::ifdis, mod_biology::ifecc, mod_biology::ifecf, mod_biology::ifecn, mod_biology::ifecp, mod_biology::ifecs, mod_biology::ifeo_, mod_biology::ifphy, mod_biology::ildec, mod_biology::ilden, mod_biology::ilphy, mod_biology::ilzoo, mod_biology::inh4_, mod_param::inlm, mod_biology::ino3_, mod_biology::iopal, mod_biology::ioxyg, mod_biology::iphyc, mod_biology::iphyf, mod_biology::iphyn, mod_biology::iphyp, mod_biology::iphys, mod_biology::iphyt, mod_biology::ipigs, mod_biology::ipo4_, mod_biology::ipon_, mod_biology::ipzoo, mod_scalars::isalt, mod_biology::isdec, mod_biology::isden, mod_biology::isdet, mod_biology::isio_, mod_biology::isioh, mod_biology::isphy, mod_biology::iszoo, mod_biology::italk, mod_scalars::itemp, mod_biology::itic_, mod_biology::izoop, mod_scalars::large, mod_biology::mxchlb, mod_biology::mxchlc, mod_biology::mxhpub, mod_biology::mxlpub, mod_biology::mxppc, mod_biology::mxpsc, mod_biology::n2cbac, mod_biology::nbac, mod_param::nbt, mod_biology::nfec, mod_biology::nphy, mod_biology::p2cbac, mod_param::r3dvar, stats_mod::stats_3dfld(), mod_iounits::stdout, and mod_ncparam::vname.

Referenced by ana_biology().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_btflux()

subroutine analytical_mod::ana_btflux ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) itrc )

Definition at line 2 of file ana_btflux.h.

3!
4!! git $Id$
5!!======================================================================
6!! Copyright (c) 2002-2025 The ROMS Group !
7!! Licensed under a MIT/X style license !
8!! See License_ROMS.md !
9!=======================================================================
10! !
11! Sets bottom flux of tracer type variables btflux(:,:,itrc) using !
12! analytical expressions (TracerUnits m/s). The surface fluxes are !
13! processed and loaded to state variable "btflx" in "set_vbc". !
14! !
15!=======================================================================
16!
17 USE mod_param
18 USE mod_forces
19 USE mod_ncparam
20!
21! Imported variable declarations.
22!
23 integer, intent(in) :: ng, tile, model, itrc
24!
25! Local variable declarations.
26!
27 character (len=*), parameter :: MyFile = &
28 & __FILE__
29!
30#include "tile.h"
31!
32 CALL ana_btflux_tile (ng, tile, model, itrc, &
33 & lbi, ubi, lbj, ubj, &
34 & imins, imaxs, jmins, jmaxs, &
35 & forces(ng) % btflux)
36!
37! Set analytical header file name used.
38!
39#ifdef DISTRIBUTE
40 IF (lanafile) THEN
41#else
42 IF (lanafile.and.(tile.eq.0)) THEN
43#endif
44 ananame( 3)=myfile
45 END IF
46!
47 RETURN
mod_forces
Definition mod_forces.F:2
mod_forces::forces
type(t_forces), dimension(:), allocatable forces
Definition mod_forces.F:554

References ana_btflux_tile(), mod_ncparam::ananame, mod_forces::forces, and mod_ncparam::lanafile.

Referenced by ad_set_data_tile(), rp_set_data_tile(), set_data_tile(), and tl_set_data_tile().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_btflux_tile()

subroutine analytical_mod::ana_btflux_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) itrc,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
real(r8), dimension(lbi:ubi,lbj:ubj,nt(ng)), intent(inout) btflux )

Definition at line 51 of file ana_btflux.h.

55!***********************************************************************
56!
57 USE mod_param
58 USE mod_scalars
59!
60! Imported variable declarations.
61!
62 integer, intent(in) :: ng, tile, model, itrc
63 integer, intent(in) :: LBi, UBi, LBj, UBj
64 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
65!
66#ifdef ASSUMED_SHAPE
67 real(r8), intent(inout) :: btflux(LBi:,LBj:,:)
68#else
69 real(r8), intent(inout) :: btflux(LBi:UBi,LBj:UBj,NT(ng))
70#endif
71!
72! Local variable declarations.
73!
74 integer :: i, j
75
76#include "set_bounds.h"
77!
78!-----------------------------------------------------------------------
79! Set bottom heat flux (degC m/s) at horizontal RHO-points.
80!-----------------------------------------------------------------------
81!
82 IF (itrc.eq.itemp) THEN
83 DO j=jstrt,jendt
84 DO i=istrt,iendt
85 btflux(i,j,itrc)=0.0_r8
86 END DO
87 END DO
88!
89!-----------------------------------------------------------------------
90! Set bottom salt flux (m/s) at horizontal RHO-points. The scaling
91! by bottom salinity is done in "set_vbc".
92!-----------------------------------------------------------------------
93!
94 ELSE IF (itrc.eq.isalt) THEN
95 DO j=jstrt,jendt
96 DO i=istrt,iendt
97 btflux(i,j,itrc)=0.0_r8
98 END DO
99 END DO
100!
101!-----------------------------------------------------------------------
102! Set bottom flux (Tunits m/s) of passive tracers at RHO-point,
103! if any.
104!-----------------------------------------------------------------------
105!
106 ELSE
107 DO j=jstrt,jendt
108 DO i=istrt,iendt
109 btflux(i,j,itrc)=0.0_r8
110 END DO
111 END DO
112 END IF
113!
114 RETURN

References mod_scalars::isalt, and mod_scalars::itemp.

Referenced by ana_btflux().

Here is the caller graph for this function:

◆ ana_cloud()

subroutine analytical_mod::ana_cloud ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 2 of file ana_cloud.h.

3!
4!! git $Id$
5!!======================================================================
6!! Copyright (c) 2002-2025 The ROMS Group !
7!! Licensed under a MIT/X style license !
8!! See License_ROMS.md !
9!=======================================================================
10! !
11! This routine sets cloud fraction using an analytical expression. !
12! !
13!=======================================================================
14!
15 USE mod_param
16 USE mod_forces
17 USE mod_ncparam
18!
19! Imported variable declarations.
20!
21 integer, intent(in) :: ng, tile, model
22!
23! Local variable declarations.
24!
25 character (len=*), parameter :: MyFile = &
26 & __FILE__
27!
28#include "tile.h"
29!
30 CALL ana_cloud_tile (ng, tile, model, &
31 & lbi, ubi, lbj, ubj, &
32 & imins, imaxs, jmins, jmaxs, &
33 & forces(ng) % cloud)
34!
35! Set analytical header file name used.
36!
37#ifdef DISTRIBUTE
38 IF (lanafile) THEN
39#else
40 IF (lanafile.and.(tile.eq.0)) THEN
41#endif
42 ananame( 4)=myfile
43 END IF
44!
45 RETURN

References ana_cloud_tile(), mod_ncparam::ananame, mod_forces::forces, and mod_ncparam::lanafile.

Referenced by ad_set_data_tile(), rp_set_data_tile(), set_data_tile(), and tl_set_data_tile().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_cloud_tile()

subroutine analytical_mod::ana_cloud_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) cloud )

Definition at line 49 of file ana_cloud.h.

53!***********************************************************************
54!
55 USE mod_param
56 USE mod_scalars
57!
58#ifdef PAPA_CLM
59 USE dateclock_mod, ONLY : caldate
60#endif
61 USE exchange_2d_mod, ONLY : exchange_r2d_tile
62#ifdef DISTRIBUTE
63 USE mp_exchange_mod, ONLY : mp_exchange2d
64#endif
65!
66! Imported variable declarations.
67!
68 integer, intent(in) :: ng, tile, model
69 integer, intent(in) :: LBi, UBi, LBj, UBj
70 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
71!
72#ifdef ASSUMED_SHAPE
73 real(r8), intent(out) :: cloud(LBi:,LBj:)
74#else
75 real(r8), intent(out) :: cloud(LBi:UBi,LBj:UBj)
76#endif
77!
78! Local variable declarations.
79!
80 integer :: i, j
81!
82 real(r8) :: Cval
83 real(dp) :: yday
84
85#ifdef PAPA_CLM
86!
87 real(dp), dimension(14) :: Coktas = &
88 & (/ 6.29_r8, 6.26_r8, 6.31_r8, 6.31_r8, 6.32_r8, &
89 & 6.70_r8, 7.12_r8, 7.26_r8, 6.93_r8, 6.25_r8, &
90 & 6.19_r8, 6.23_r8, 6.31_r8, 6.29_r8 /)
91
92 real(dp), dimension(14) :: Cyday = &
93 & (/ 0.0_dp, 16.0_dp, 46.0_dp, 75.0_dp, 105.0_dp, &
94 & 136.0_dp, 166.0_dp, 197.0_dp, 228.0_dp, 258.0_dp, &
95 & 289.0_dp, 319.0_dp, 350.0_dp, 365.0_dp /)
96#endif
97
98#include "set_bounds.h"
99!
100!-----------------------------------------------------------------------
101! Set analytical cloud fraction (%/100): 0=clear sky, 1:overcast sky.
102!-----------------------------------------------------------------------
103!
104#if defined PAPA_CLM
105
106! OWS Papa cloud climatology.
107!
108 CALL caldate (tdays(ng), yd_dp=yday)
109 DO i=1,13
110 IF ((yday.ge.cyday(i)).and.(yday.le.cyday(i+1))) THEN
111 cval=0.125_r8*(coktas(i )*(cyday(i+1)-yday)+ &
112 & coktas(i+1)*(yday-cyday(i)))/ &
113 & (cyday(i+1)-cyday(i))
114 END IF
115 END DO
116#elif defined BENCHMARK
117 cval=0.6_r8
118#elif defined NJ_BIGHT
119 cval=0.3_r8
120#else
121 cval=0.0_r8
122#endif
123
124 DO j=jstrt,jendt
125 DO i=istrt,iendt
126 cloud(i,j)=cval
127 END DO
128 END DO
129!
130! Exchange boundary data.
131!
132 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
133 CALL exchange_r2d_tile (ng, tile, &
134 & lbi, ubi, lbj, ubj, &
135 & cloud)
136 END IF
137
138#ifdef DISTRIBUTE
139 CALL mp_exchange2d (ng, tile, model, 1, &
140 & lbi, ubi, lbj, ubj, &
141 & nghostpoints, &
142 & ewperiodic(ng), nsperiodic(ng), &
143 & cloud)
144#endif
145!
146 RETURN
dateclock_mod
Definition dateclock.F:2
dateclock_mod::caldate
subroutine, public caldate(currenttime, yy_i, yd_i, mm_i, dd_i, h_i, m_i, s_i, yd_dp, dd_dp, h_dp, m_dp, s_dp)
Definition dateclock.F:76
exchange_2d_mod
Definition exchange_2d.F:2
exchange_2d_mod::exchange_r2d_tile
subroutine exchange_r2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
Definition exchange_2d.F:253
mod_param::nghostpoints
integer nghostpoints
Definition mod_param.F:710
mod_scalars::ewperiodic
logical, dimension(:), allocatable ewperiodic
Definition mod_scalars.F:510
mod_scalars::nsperiodic
logical, dimension(:), allocatable nsperiodic
Definition mod_scalars.F:511
mod_scalars::tdays
real(dp), dimension(:), allocatable tdays
Definition mod_scalars.F:261
mp_exchange_mod
Definition mp_exchange.F:2
mp_exchange_mod::mp_exchange2d
subroutine mp_exchange2d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, nghost, ew_periodic, ns_periodic, a, b, c, d)
Definition mp_exchange.F:294

References dateclock_mod::caldate(), mod_scalars::ewperiodic, exchange_2d_mod::exchange_r2d_tile(), mp_exchange_mod::mp_exchange2d(), mod_param::nghostpoints, mod_scalars::nsperiodic, and mod_scalars::tdays.

Referenced by ana_cloud().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_diag()

subroutine analytical_mod::ana_diag ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 2 of file ana_diag.h.

3!
4!! git $Id$
5!!======================================================================
6!! Copyright (c) 2002-2025 The ROMS Group !
7!! Licensed under a MIT/X style license !
8!! See License_ROMS.md !
9!=======================================================================
10! !
11! This routine is provided so the USER can compute any specialized !
12! diagnostics. If activated, this routine is call at end of every !
13! 3D-equations timestep. !
14! !
15!=======================================================================
16!
17 USE mod_param
18 USE mod_ncparam
19 USE mod_ocean
20!
21! Imported variable declarations.
22!
23 integer, intent(in) :: ng, tile, model
24!
25! Local variable declarations.
26!
27 character (len=*), parameter :: MyFile = &
28 & __FILE__
29!
30#include "tile.h"
31!
32 CALL ana_diag_tile (ng, tile, model, &
33 & lbi, ubi, lbj, ubj, &
34 & imins, imaxs, jmins, jmaxs, &
35#ifdef SOLVE3D
36 & ocean(ng) % u, &
37 & ocean(ng) % v, &
38#endif
39 & ocean(ng) % ubar, &
40 & ocean(ng) % vbar)
41!
42! Set analytical header file name used.
43!
44#ifdef DISTRIBUTE
45 IF (lanafile) THEN
46#else
47 IF (lanafile.and.(tile.eq.0)) THEN
48#endif
49 ananame( 5)=myfile
50 END IF
51!
52 RETURN

References ana_diag_tile(), mod_ncparam::ananame, mod_ncparam::lanafile, and mod_ocean::ocean.

Referenced by diag_mod::diag().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_diag_tile()

subroutine analytical_mod::ana_diag_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),2), intent(in) u,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),2), intent(in) v,
real(r8), dimension(lbi:ubi,lbj:ubj,:), intent(in) ubar,
real(r8), dimension(lbi:ubi,lbj:ubj,:), intent(in) vbar )

Definition at line 56 of file ana_diag.h.

63!***********************************************************************
64!
65 USE mod_param
66 USE mod_iounits
67 USE mod_scalars
68#ifdef SEAMOUNT
69 USE mod_stepping
70#endif
71!
72! Imported variable declarations.
73!
74 integer, intent(in) :: ng, tile, model
75 integer, intent(in) :: LBi, UBi, LBj, UBj
76 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
77!
78#ifdef ASSUMED_SHAPE
79# ifdef SOLVE3D
80 real(r8), intent(in) :: u(LBi:,LBj:,:,:)
81 real(r8), intent(in) :: v(LBi:,LBj:,:,:)
82# endif
83 real(r8), intent(in) :: ubar(LBi:,LBj:,:)
84 real(r8), intent(in) :: vbar(LBi:,LBj:,:)
85#else
86# ifdef SOLVE3D
87 real(r8), intent(in) :: u(LBi:UBi,LBj:UBj,N(ng),2)
88 real(r8), intent(in) :: v(LBi:UBi,LBj:UBj,N(ng),2)
89# endif
90 real(r8), intent(in) :: ubar(LBi:UBi,LBj:UBj,:)
91 real(r8), intent(in) :: vbar(LBi:UBi,LBj:UBj,:)
92#endif
93!
94! Local variable declarations.
95!
96 integer :: i, io_error, j, k
97!
98 real(r8) :: umax, ubarmax, vmax, vbarmax
99!
100 character (len=256) :: io_errmsg
101
102#include "set_bounds.h"
103!
104!-----------------------------------------------------------------------
105! Compute user diagnostics.
106!-----------------------------------------------------------------------
107!
108#ifdef SEAMOUNT
109
110! Open USER file.
111!
112 IF (iic(ng).eq.ntstart(ng)) THEN
113 OPEN (usrout,file=usrname,form='formatted',status='unknown', &
114 & iostat=io_err, iomsg=io_errmsg)
115 IF (io_err.ne.0) THEN
116 WRITE (stdout,10) usrname, trim(io_errmsg)
117 exit_flag=5
118 RETURN
119 10 FORMAT (' ANA_DIAG - unable to open output file: ',a, &
120 /12x,'ERROR: ',a)
121 END IF
122 END IF
123!
124! Write out maximum values of velocity.
125!
126 umax=0.0_r8
127 vmax=0.0_r8
128 ubarmax=0.0_r8
129 vbarmax=0.0_r8
130 DO k=1,n(ng)
131 DO j=0,mm(ng)+1
132 DO i=1,lm(ng)+1
133 umax=max(umax,u(i,j,k,nnew(ng)))
134 END DO
135 END DO
136 DO j=1,mm(ng)+1
137 DO i=0,lm(ng)+1
138 vmax=max(vmax,v(i,j,k,nnew(ng)))
139 END DO
140 END DO
141 END DO
142 DO j=0,mm(ng)+1
143 DO i=1,lm(ng)+1
144 ubarmax=max(ubarmax,ubar(i,j,knew(ng)))
145 END DO
146 END DO
147 DO j=1,mm(ng)+1
148 DO i=0,lm(ng)+1
149 vbarmax=max(vbarmax,vbar(i,j,knew(ng)))
150 END DO
151 END DO
152!
153! Write out maximum values on velocity.
154!
155 WRITE (usrout,20) tdays(ng), ubarmax, vbarmax, umax, vmax
156 20 FORMAT (2x,f13.6,2x,1pe13.6,2x,1pe13.6,2x,1pe13.6,2x,1pe13.6)
157#endif
158!
159 RETURN
mod_iounits::usrout
integer usrout
Definition mod_iounits.F:196
mod_iounits::usrname
character(len=256) usrname
Definition mod_iounits.F:301
mod_param::lm
integer, dimension(:), allocatable lm
Definition mod_param.F:455
mod_param::mm
integer, dimension(:), allocatable mm
Definition mod_param.F:456
mod_scalars::iic
integer, dimension(:), allocatable iic
Definition mod_scalars.F:249
mod_scalars::exit_flag
integer exit_flag
Definition mod_scalars.F:559
mod_scalars::ntstart
integer, dimension(:), allocatable ntstart
Definition mod_scalars.F:378
mod_stepping
Definition mod_stepping.F:2
mod_stepping::knew
integer, dimension(:), allocatable knew
Definition mod_stepping.F:64
mod_stepping::nnew
integer, dimension(:), allocatable nnew
Definition mod_stepping.F:69

References mod_scalars::exit_flag, mod_scalars::iic, mod_stepping::knew, mod_param::lm, mod_param::mm, mod_stepping::nnew, mod_scalars::ntstart, mod_iounits::stdout, mod_scalars::tdays, mod_iounits::usrname, and mod_iounits::usrout.

Referenced by ana_diag().

Here is the caller graph for this function:

◆ ana_dqdsst()

subroutine analytical_mod::ana_dqdsst ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 2 of file ana_dqdsst.h.

3!
4!! git $Id$
5!!======================================================================
6!! Copyright (c) 2002-2025 The ROMS Group !
7!! Licensed under a MIT/X style license !
8!! See License_ROMS.md !
9!=======================================================================
10! !
11! This subroutine sets surface net heat flux sensitivity dQdSTT to !
12! SST using analytical expressions. The forcing dQdSTT is usually !
13! computed in units of (Watts/m2/degC). It needs to be scaled to !
14! (m/s/degC) by dividing by rho0*Cp. This field is used when the !
15! surface heat flux correction is activated: !
16! !
17! Q_model ~ Q + dQdSST * (T_model - SST) !
18! !
19!=======================================================================
20!
21 USE mod_param
22 USE mod_forces
23 USE mod_grid
24 USE mod_ncparam
25!
26! Imported variable declarations.
27!
28 integer, intent(in) :: ng, tile, model
29!
30! Local variable declarations.
31!
32 character (len=*), parameter :: MyFile = &
33 & __FILE__
34!
35#include "tile.h"
36!
37 CALL ana_dqdsst_tile (ng, tile, model, &
38 & lbi, ubi, lbj, ubj, &
39 & imins, imaxs, jmins, jmaxs, &
40 & grid(ng) % Hz, &
41 & forces(ng) % dqdt)
42!
43! Set analytical header file name used.
44!
45#ifdef DISTRIBUTE
46 IF (lanafile) THEN
47#else
48 IF (lanafile.and.(tile.eq.0)) THEN
49#endif
50 ananame(38)=myfile
51 END IF
52!
53 RETURN
mod_grid
Definition mod_grid.F:2
mod_grid::grid
type(t_grid), dimension(:), allocatable grid
Definition mod_grid.F:365

References ana_dqdsst_tile(), mod_ncparam::ananame, mod_forces::forces, mod_grid::grid, and mod_ncparam::lanafile.

Referenced by ad_set_data_tile(), rp_set_data_tile(), set_data_tile(), and tl_set_data_tile().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_dqdsst_tile()

subroutine analytical_mod::ana_dqdsst_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
real(r8), dimension(lbi:ubi,lbj:ubj,1:n(ng)), intent(in) hz,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) dqdt )

Definition at line 57 of file ana_dqdsst.h.

61!***********************************************************************
62!
63 USE mod_param
64 USE mod_grid
65 USE mod_scalars
66!
67 USE exchange_2d_mod, ONLY : exchange_r2d_tile
68#ifdef DISTRIBUTE
69 USE mp_exchange_mod, ONLY : mp_exchange2d
70#endif
71!
72! Imported variable declarations.
73!
74 integer, intent(in) :: ng, tile, model
75 integer, intent(in) :: LBi, UBi, LBj, UBj
76 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
77!
78#ifdef ASSUMED_SHAPE
79 real(r8), intent(in) :: Hz(LBi:,LBj:,:)
80 real(r8), intent(out) :: dqdt(LBi:,LBj:)
81#else
82 real(r8), intent(in) :: Hz(LBi:UBi,LBj:UBj,1:N(ng))
83 real(r8), intent(out) :: dqdt(LBi:UBi,LBj:UBj)
84#endif
85!
86! Local variable declarations.
87!
88 integer :: i, j
89!
90 real(r8) :: fac
91
92#include "set_bounds.h"
93!
94!-----------------------------------------------------------------------
95! Set surface heat flux sensitivity to SST (m/s/degC).
96!-----------------------------------------------------------------------
97!
98#ifdef MY_APPLICATION
99 fac=day2sec/30.0_r8 ! 30 day relaxation scale 1/s/decC
100 DO j=jstrt,jendt
101 DO i=istrt,iendt
102 dqdt(i,j)=fac*hz(i,j,n(ng))
103 END DO
104 END DO
105#else
106 DO j=jstrt,jendt
107 DO i=istrt,iendt
108 dqdt(i,j)=???
109 END DO
110 END DO
111#endif
112!
113! Exchange boundary data.
114!
115 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
116 CALL exchange_r2d_tile (ng, tile, &
117 & lbi, ubi, lbj, ubj, &
118 & dqdt)
119 END IF
120
121#ifdef DISTRIBUTE
122 CALL mp_exchange2d (ng, tile, model, 1, &
123 & lbi, ubi, lbj, ubj, &
124 & nghostpoints, &
125 & ewperiodic(ng), nsperiodic(ng), &
126 & dqdt)
127#endif
128!
129 RETURN
mod_scalars::day2sec
real(dp), parameter day2sec
Definition mod_scalars.F:816

References mod_scalars::day2sec, mod_scalars::ewperiodic, exchange_2d_mod::exchange_r2d_tile(), mp_exchange_mod::mp_exchange2d(), mod_param::nghostpoints, and mod_scalars::nsperiodic.

Referenced by ana_dqdsst().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_drag()

subroutine analytical_mod::ana_drag ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 2 of file ana_drag.h.

3!
4!! git $Id$
5!!======================================================================
6!! Copyright (c) 2002-2025 The ROMS Group !
7!! Licensed under a MIT/X style license !
8!! See License_ROMS.md !
9!=======================================================================
10! !
11! This routine sets analytical, spatially varying bottom roughness !
12! length (m), or linear drag coefficients (m/s), or quadratic drag !
13! coefficients (nondimensional) at RHO-points. It depends on the !
14! activated bottom stress formulation. !
15! !
16! There are many ways to compute spatially varying drag parameters: !
17! !
18! * Partition the grid into different provinces with different !
19! with different values (regimes). !
20! * A piecewise value that depends on the water depth. !
21! * Empirical formulas in terms of water depth (Chezy formula) !
22! * Inverse techniques using adjoint parameter estimation, but !
23! it is beyond the scope of this routine. !
24! !
25! The User should experiment to get the appropriate distribution !
26! for their application. !
27! !
28!=======================================================================
29!
30 USE mod_param
31 USE mod_grid
32 USE mod_ncparam
33!
34! Imported variable declarations.
35!
36 integer, intent(in) :: ng, tile, model
37!
38! Local variable declarations.
39!
40 character (len=*), parameter :: MyFile = &
41 & __FILE__
42!
43#include "tile.h"
44!
45 CALL ana_drag_tile (ng, tile, model, &
46 & lbi, ubi, lbj, ubj, &
47 & imins, imaxs, jmins, jmaxs, &
48#if defined SEDIMENT || defined BBL_MODEL
49 & sedbed(ng) % bottom, &
50#endif
51#if defined UV_LOGDRAG
52 & grid(ng) % ZoBot)
53#elif defined UV_LDRAG
54 & grid(ng) % rdrag)
55#elif defined UV_QDRAG
56 & grid(ng) % rdrag2)
57#endif
58!
59! Set analytical header file name used.
60!
61#ifdef DISTRIBUTE
62 IF (lanafile) THEN
63#else
64 IF (lanafile.and.(tile.eq.0)) THEN
65#endif
66 ananame( 2)=myfile
67 END IF
68!
69 RETURN

References ana_drag_tile(), mod_ncparam::ananame, mod_grid::grid, and mod_ncparam::lanafile.

Referenced by ad_initial(), roms_kernel_mod::adm_initial(), initial(), roms_kernel_mod::nlm_initial(), rp_initial(), tl_initial(), and roms_kernel_mod::tlm_initial().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_drag_tile()

subroutine analytical_mod::ana_drag_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
real(r8), dimension(lbi:ubi,lbj:ubj,mbotp), intent(out) bottom,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) zobot )

Definition at line 73 of file ana_drag.h.

81#elif defined UV_LDRAG
82 & rdrag)
83#elif defined UV_QDRAG
84 & rdrag2)
85#endif
86!***********************************************************************
87!
88 USE mod_param
89 USE mod_parallel
90 USE mod_grid
91 USE mod_ncparam
92 USE mod_iounits
93 USE mod_scalars
94#if defined SEDIMENT || defined BBL_MODEL
95 USE mod_sediment
96#endif
97!
98 USE exchange_2d_mod, ONLY : exchange_r2d_tile
99#ifdef DISTRIBUTE
100 USE mp_exchange_mod, ONLY : mp_exchange2d
101#endif
102 USE stats_mod, ONLY : stats_2dfld
103!
104! Imported variable declarations.
105!
106 integer, intent(in) :: ng, tile, model
107 integer, intent(in) :: LBi, UBi, LBj, UBj
108 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
109!
110#ifdef ASSUMED_SHAPE
111# if defined SEDIMENT || defined BBL_MODEL
112 real(r8), intent(out) :: bottom(LBi:,LBj:,:)
113# endif
114# if defined UV_LOGDRAG
115 real(r8), intent(out) :: ZoBot(LBi:,LBj:)
116# elif defined UV_LDRAG
117 real(r8), intent(out) :: rdrag(LBi:,LBj:)
118# elif defined UV_QDRAG
119 real(r8), intent(out) :: rdrag2(LBi:,LBj:)
120# endif
121
122#else
123
124# if defined SEDIMENT || defined BBL_MODEL
125 real(r8), intent(out) :: bottom(LBi:UBi,LBj:UBj,MBOTP)
126# endif
127# if defined UV_LOGDRAG
128 real(r8), intent(out) :: ZoBot(LBi:UBi,LBj:UBj)
129# elif defined UV_LDRAG
130 real(r8), intent(out) :: rdrag(LBi:UBi,LBj:UBj)
131# elif defined UV_QDRAG
132 real(r8), intent(out) :: rdrag2(LBi:UBi,LBj:UBj)
133# endif
134#endif
135!
136! Local variable declarations.
137!
138 logical, save :: first = .true.
139!
140 integer :: i, j
141!
142 real(r8) :: cff
143!
144 TYPE (T_STATS), save :: Stats
145
146#include "set_bounds.h"
147!
148!-----------------------------------------------------------------------
149! Initialize field statistics structure.
150!-----------------------------------------------------------------------
151!
152 IF (first) THEN
153 first=.false.
154 stats % checksum=0_i8b
155 stats % count=0
156 stats % min=large
157 stats % max=-large
158 stats % avg=0.0_r8
159 stats % rms=0.0_r8
160 END IF
161!
162!-----------------------------------------------------------------------
163#if defined UV_LOGDRAG
164! Set spatially varying bottom roughness length (m).
165#elif defined UV_LDRAG
166! Set spatially varying linear drag coefficient (m/s).
167#elif defined UV_QDRAG
168! Set spatially varying quadratic drag coefficient (nondimensional)
169#endif
170!-----------------------------------------------------------------------
171!
172#if defined UPWELLING
173# if defined UV_LOGDRAG
174 DO j=jstrt,jendt
175 DO i=istrt,iendt
176 zobot(i,j)=0.05_r8*(1.0_r8+tanh(grid(ng)%h(i,j)/50.0_r8))
177 END DO
178 END DO
179# elif defined UV_LDRAG
180 DO j=jstrt,jendt
181 DO i=istrt,iendt
182 rdrag(i,j)=0.002_r8*(1.0_r8-tanh(grid(ng)%h(i,j)/150.0_r8))
183 END DO
184 END DO
185# elif defined UV_QDRAG
186 DO j=jstrt,jendt ! based on Chezy coefficient (g/c^2)
187 DO i=istrt,iendt
188 cff=1.8_r8*grid(ng)%h(i,j)*log(grid(ng)%h(i,j))
189 rdrag2(i,j)=g/(cff*cff)
190 END DO
191 END DO
192# endif
193#else
194# if defined UV_LOGDRAG
195 DO j=jstrt,jendt
196 DO i=istrt,iendt
197 zobot(i,j)=???
198 END DO
199 END DO
200# elif defined UV_LDRAG
201 DO j=jstrt,jendt
202 DO i=istrt,iendt
203 rdrag(i,j)=???
204 END DO
205 END DO
206# elif defined UV_QDRAG
207 DO j=jstrt,jendt
208 DO i=istrt,iendt
209 rdrag2(i,j)=???
210 END DO
211 END DO
212# endif
213#endif
214!
215! Report statistics.
216!
217#if defined UV_LOGDRAG
218 CALL stats_2dfld (ng, tile, inlm, r2dvar, stats, 0, &
219 & lbi, ubi, lbj, ubj, zobot)
220 IF (domain(ng)%NorthEast_Corner(tile)) THEN
221 WRITE (stdout,10) 'time invariant, bottom roughness '// &
222 & 'length scale: ZoBot', &
223 & ng, stats%min, stats%max
224 END IF
225#elif defined UV_LDRAG
226 CALL stats_2dfld (ng, tile, inlm, r2dvar, stats, 0, &
227 & lbi, ubi, lbj, ubj, rdrag)
228 IF (domain(ng)%NorthEast_Corner(tile)) THEN
229 WRITE (stdout,10) 'linear bottom drag coefficient: rdrag', &
230 & ng, stats%min, stats%max
231 END IF
232#elif defined UV_QDRAG
233 CALL stats_2dfld (ng, tile, inlm, r2dvar, stats, 0, &
234 & lbi, ubi, lbj, ubj, rdrag2)
235 IF (domain(ng)%NorthEast_Corner(tile)) THEN
236 WRITE (stdout,10) 'quadratic bottom drag coefficient: rdrag2', &
237 & ng, stats%min, stats%max
238 END IF
239#endif
240!
241! Exchange boundary data.
242!
243 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
244 CALL exchange_r2d_tile (ng, tile, &
245 & lbi, ubi, lbj, ubj, &
246#if defined UV_LOGDRAG
247 & zobot)
248#elif defined UV_LDRAG
249 & rdrag)
250#elif defined UV_QDRAG
251 & rdrag2)
252#endif
253 END IF
254
255#ifdef DISTRIBUTE
256 CALL mp_exchange2d (ng, tile, model, 1, &
257 & lbi, ubi, lbj, ubj, &
258 & nghostpoints, &
259 & ewperiodic(ng), nsperiodic(ng), &
260# if defined UV_LOGDRAG
261 & zobot)
262# elif defined UV_LDRAG
263 & rdrag)
264# elif defined UV_QDRAG
265 & rdrag2)
266# endif
267#endif
268
269#if defined UV_LOGDRAG && (defined SEDIMENT || defined BBL_MODEL)
270!
271!-----------------------------------------------------------------------
272! Load bottom roughness length into bottom properties array.
273!-----------------------------------------------------------------------
274!
275 DO j=jstrt,jendt
276 DO i=istrt,iendt
277 bottom(i,j,izdef)=zobot(i,j)
278 END DO
279 END DO
280#endif
281!
282 10 FORMAT (3x,' ANA_DRAG - ',a,/,19x, &
283 & '(Grid = ',i2.2,', Min = ',1p,e15.8,0p, &
284 & ' Max = ',1p,e15.8,0p,')')
285!
286 RETURN
mod_param::r2dvar
integer, parameter r2dvar
Definition mod_param.F:717
mod_scalars::g
real(dp) g
Definition mod_scalars.F:464
mod_sediment
Definition sediment_mod.h:1
mod_sediment::izdef
integer, parameter izdef
Definition sediment_mod.h:131
stats_mod::stats_2dfld
subroutine, public stats_2dfld(ng, tile, model, gtype, s, extract_flag, lbi, ubi, lbj, ubj, f, fmask, debug)
Definition stats.F:47

References mod_param::domain, mod_scalars::ewperiodic, exchange_2d_mod::exchange_r2d_tile(), mod_scalars::g, mod_grid::grid, mod_param::inlm, mod_sediment::izdef, mod_scalars::large, mp_exchange_mod::mp_exchange2d(), mod_param::nghostpoints, mod_scalars::nsperiodic, mod_param::r2dvar, stats_mod::stats_2dfld(), and mod_iounits::stdout.

Referenced by ana_drag().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_fsobc()

subroutine analytical_mod::ana_fsobc ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 2 of file ana_fsobc.h.

3!
4!! git $Id$
5!!======================================================================
6!! Copyright (c) 2002-2025 The ROMS Group !
7!! Licensed under a MIT/X style license !
8!! See License_ROMS.md !
9!=======================================================================
10! !
11! This routine sets free-surface open boundary conditions using !
12! analytical expressions. !
13! !
14!=======================================================================
15!
16 USE mod_param
17 USE mod_ncparam
18!
19! Imported variable declarations.
20!
21 integer, intent(in) :: ng, tile, model
22!
23! Local variable declarations.
24!
25 character (len=*), parameter :: MyFile = &
26 & __FILE__
27!
28#include "tile.h"
29!
30 CALL ana_fsobc_tile (ng, tile, model, &
31 & lbi, ubi, lbj, ubj, &
32 & imins, imaxs, jmins, jmaxs)
33!
34! Set analytical header file name used.
35!
36#ifdef DISTRIBUTE
37 IF (lanafile) THEN
38#else
39 IF (lanafile.and.(tile.eq.0)) THEN
40#endif
41 ananame( 6)=myfile
42 END IF
43!
44 RETURN

References ana_fsobc_tile(), mod_ncparam::ananame, and mod_ncparam::lanafile.

Referenced by ad_set_data_tile(), rp_set_data_tile(), set_data_tile(), and tl_set_data_tile().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_fsobc_tile()

subroutine analytical_mod::ana_fsobc_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs )

Definition at line 48 of file ana_fsobc.h.

51!***********************************************************************
52!
53 USE mod_param
54 USE mod_boundary
55 USE mod_grid
56 USE mod_ncparam
57 USE mod_scalars
58!
59! Imported variable declarations.
60!
61 integer, intent(in) :: ng, tile, model
62 integer, intent(in) :: LBi, UBi, LBj, UBj
63 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
64!
65! Local variable declarations.
66!
67 integer :: i, j
68!
69 real(r8) :: cff, fac, omega, phase, val
70
71#include "set_bounds.h"
72!
73!-----------------------------------------------------------------------
74! Free-surface open boundary conditions.
75!-----------------------------------------------------------------------
76!
77#if defined INLET_TEST
78 IF (lbc(inorth,isfsur,ng)%acquire.and. &
79 & domain(ng)%Northern_Edge(tile)) THEN
80 cff=-1.0_r8*sin(2.0_r8*pi*time(ng)/(12.0_r8*3600.0_r8))
81 DO i=istrt,iendt
82 boundary(ng)%zeta_north(i)=cff
83 END DO
84 END IF
85#elif defined KELVIN
86 fac=1.0_r8 ! zeta0
87 omega=2.0_r8*pi/(12.42_r8*3600.0_r8) ! M2 Tide period
88 IF (lbc(iwest,isfsur,ng)%acquire.and. &
89 & domain(ng)%Western_Edge(tile)) THEN
90 DO j=jstrt,jendt
91 val=fac*exp(-grid(ng)%f(istr-1,j)*grid(ng)%yp(istr-1,j)/ &
92 & sqrt(g*grid(ng)%h(istr-1,j)))
93 boundary(ng)%zeta_west(j)=val*cos(omega*time(ng))
94 END DO
95 END IF
96
97 IF (lbc(ieast,isfsur,ng)%acquire.and. &
98 & domain(ng)%Eastern_Edge(tile)) THEN
99 DO j=jstrt,jendt
100 cff=1.0_r8/sqrt(g*grid(ng)%h(istr-1,j))
101 val=fac*exp(-grid(ng)%f(istr-1,j)*grid(ng)%yp(iend,j)*cff)
102 boundary(ng)%zeta_east(j)=val*cos(omega*grid(ng)%xp(iend,j)* &
103 & cff-omega*time(ng))
104 END DO
105 END IF
106#elif defined ESTUARY_TEST
107 IF (lbc(iwest,isfsur,ng)%acquire.and. &
108 & domain(ng)%Western_Edge(tile)) THEN
109 cff=1.0_r8*sin(2.0_r8*pi*time(ng)/(12.0_r8*3600.0_r8))
110 DO j=jstrt,jendt
111 boundary(ng)%zeta_west(j)=cff
112 END DO
113 END IF
114#elif defined SED_TEST1
115 IF (lbc(iwest,isfsur,ng)%acquire.and. &
116 & domain(ng)%Western_Edge(tile)) THEN
117 fac=100.0_r8
118 DO j=jstrt,jendt
119 boundary(ng)%zeta_west(j)=9.0e-06_r8*fac
120 END DO
121 END IF
122
123 IF (lbc(ieast,isfsur,ng)%acquire.and. &
124 & domain(ng)%Eastern_Edge(tile)) THEN
125 fac=100.0_r8
126 DO j=jstrt,jendt
127 boundary(ng)%zeta_east(j)=9.0e-06_r8*real(iend+1,r8)*fac
128 END DO
129 END IF
130#elif defined SHOREFACE
131 IF (lbc(iwest,isfsur,ng)%acquire.and. &
132 & domain(ng)%Western_Edge(tile)) THEN
133!! cff=-1.0_r8*SIN(2.0_r8*pi*time(ng)/(12.0_r8*3600.0_r8))
134 cff=0.0_r8
135 DO j=jstrt,jendt
136 boundary(ng)%zeta_west(j)=cff
137 END DO
138 END IF
139#elif defined TEST_CHAN
140 IF (lbc(iwest,isfsur,ng)%acquire.and. &
141 & domain(ng)%Western_Edge(tile)) THEN
142 cff=0.0_r8
143 DO j=jstrt,jendt
144 boundary(ng)%zeta_west(j)=cff
145 END DO
146 END IF
147
148 IF (lbc(ieast,isfsur,ng)%acquire.and. &
149 & domain(ng)%Eastern_Edge(tile)) THEN
150 cff=-0.4040_r8*min(time(ng)/150000.0_r8,1.0_r8)
151 DO j=jstrt,jendt
152 boundary(ng)%zeta_east(j)=cff
153 END DO
154 END IF
155#elif defined WEDDELL
156 IF (lbc(iwest,isfsur,ng)%acquire.and. &
157 & domain(ng)%Western_Edge(tile)) THEN
158 fac=tanh((tdays(ng)-dstart)/1.0_r8)
159 omega=2.0_r8*pi*time(ng)/(12.42_r8*3600.0_r8) ! M2 Tide period
160 val=0.53_r8+(0.53_r8-0.48_r8)/real(iend+1,r8)
161 phase=(277.0_r8+(277.0_r8-240.0_r8)/real(iend+1,r8))*deg2rad
162 DO j=jstrt,jendt
163 boundary(ng)%zeta_west(j)=fac*val*cos(omega-phase)
164 END DO
165 END IF
166
167 IF (lbc(ieast,isfsur,ng)%acquire.and. &
168 & domain(ng)%Eastern_Edge(tile)) THEN
169 fac=tanh((tdays(ng)-dstart)/1.0_r8)
170 omega=2.0_r8*pi*time(ng)/(12.42_r8*3600.0_r8) ! M2 Tide period
171 val=0.53_r8+(0.53_r8-0.48_r8)
172 phase=(277.0_r8+(277.0_r8-240.0_r8))*deg2rad
173 DO j=jstrt,jendt
174 boundary(ng)%zeta_east(j)=fac*val*cos(omega-phase)
175 END DO
176 END IF
177#else
178 IF (lbc(ieast,isfsur,ng)%acquire.and. &
179 & domain(ng)%Eastern_Edge(tile)) THEN
180 DO j=jstrt,jendt
181 boundary(ng)%zeta_east(j)=0.0_r8
182 END DO
183 END IF
184
185 IF (lbc(iwest,isfsur,ng)%acquire.and. &
186 & domain(ng)%Western_Edge(tile)) THEN
187 DO j=jstrt,jendt
188 boundary(ng)%zeta_west(j)=0.0_r8
189 END DO
190 END IF
191
192 IF (lbc(isouth,isfsur,ng)%acquire.and. &
193 & domain(ng)%Southern_Edge(tile)) THEN
194 DO i=istrt,iendt
195 boundary(ng)%zeta_south(i)=0.0_r8
196 END DO
197 END IF
198
199 IF (lbc(inorth,isfsur,ng)%acquire.and. &
200 & domain(ng)%Northern_Edge(tile)) THEN
201 DO i=istrt,iendt
202 boundary(ng)%zeta_north(i)=0.0_r8
203 END DO
204 END IF
205#endif
206!
207 RETURN
mod_boundary
Definition mod_boundary.F:2
mod_boundary::boundary
type(t_boundary), dimension(:), allocatable boundary
Definition mod_boundary.F:746
mod_ncparam::isfsur
integer isfsur
Definition mod_ncparam.F:503
mod_param::lbc
type(t_lbc), dimension(:,:,:), allocatable lbc
Definition mod_param.F:375
mod_scalars::iwest
integer, parameter iwest
Definition mod_scalars.F:1432
mod_scalars::dstart
real(dp) dstart
Definition mod_scalars.F:281
mod_scalars::deg2rad
real(dp), parameter deg2rad
Definition mod_scalars.F:814
mod_scalars::isouth
integer, parameter isouth
Definition mod_scalars.F:1433
mod_scalars::ieast
integer, parameter ieast
Definition mod_scalars.F:1434
mod_scalars::time
real(dp), dimension(:), allocatable time
Definition mod_scalars.F:262
mod_scalars::inorth
integer, parameter inorth
Definition mod_scalars.F:1435
mod_scalars::pi
real(dp), parameter pi
Definition mod_scalars.F:813

References mod_boundary::boundary, mod_scalars::deg2rad, mod_param::domain, mod_scalars::dstart, mod_scalars::g, mod_grid::grid, mod_scalars::ieast, mod_scalars::inorth, mod_ncparam::isfsur, mod_scalars::isouth, mod_scalars::iwest, mod_param::lbc, mod_scalars::pi, mod_scalars::tdays, and mod_scalars::time.

Referenced by ana_fsobc().

Here is the caller graph for this function:

◆ ana_humid()

subroutine analytical_mod::ana_humid ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 2 of file ana_humid.h.

3!
4!! git $Id$
5!!======================================================================
6!! Copyright (c) 2002-2025 The ROMS Group !
7!! Licensed under a MIT/X style license !
8!! See License_ROMS.md !
9!=======================================================================
10! !
11! This routine sets surface air humidity (moisture) using an !
12! analytical expression. There three types of humidity: !
13! !
14! 1) Absolute humidity: density of water vapor. !
15! 2) Specific humidity: ratio of the mass of water vapor to !
16! the mass of moist air cointaining the vapor (g/kg) !
17! 3) Relative humidity: ratio of the actual mixing ratio to !
18! saturation mixing ratio of the air at given temperature !
19! and pressure (percentage). !
20! !
21!=======================================================================
22!
23 USE mod_param
24 USE mod_forces
25 USE mod_ncparam
26!
27! Imported variable declarations.
28!
29 integer, intent(in) :: ng, tile, model
30!
31! Local variable declarations.
32!
33 character (len=*), parameter :: MyFile = &
34 & __FILE__
35!
36#include "tile.h"
37!
38 CALL ana_humid_tile (ng, tile, model, &
39 & lbi, ubi, lbj, ubj, &
40 & imins, imaxs, jmins, jmaxs, &
41 & forces(ng) % Hair)
42!
43! Set analytical header file name used.
44!
45#ifdef DISTRIBUTE
46 IF (lanafile) THEN
47#else
48 IF (lanafile.and.(tile.eq.0)) THEN
49#endif
50 ananame( 9)=myfile
51 END IF
52!
53 RETURN

References ana_humid_tile(), mod_ncparam::ananame, mod_forces::forces, and mod_ncparam::lanafile.

Referenced by ad_set_data_tile(), rp_set_data_tile(), set_data_tile(), and tl_set_data_tile().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_humid_tile()

subroutine analytical_mod::ana_humid_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) hair )

Definition at line 57 of file ana_humid.h.

61!***********************************************************************
62!
63 USE mod_param
64 USE mod_scalars
65!
66 USE exchange_2d_mod, ONLY : exchange_r2d_tile
67#ifdef DISTRIBUTE
68 USE mp_exchange_mod, ONLY : mp_exchange2d
69#endif
70!
71! Imported variable declarations.
72!
73 integer, intent(in) :: ng, tile, model
74 integer, intent(in) :: LBi, UBi, LBj, UBj
75 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
76!
77#ifdef ASSUMED_SHAPE
78 real(r8), intent(out) :: Hair(LBi:,LBj:)
79#else
80 real(r8), intent(out) :: Hair(LBi:UBi,LBj:UBj)
81#endif
82!
83! Local variable declarations.
84!
85 integer :: i, j
86
87#include "set_bounds.h"
88!
89!-----------------------------------------------------------------------
90! Set analytical surface air humidity.
91!-----------------------------------------------------------------------
92!
93#if defined BENCHMARK
94 DO j=jstrt,jendt
95 DO i=istrt,iendt
96 hair(i,j)=0.8_r8
97 END DO
98 END DO
99#elif defined BL_TEST
100 DO j=jstrt,jendt
101 DO i=istrt,iendt
102 hair(i,j)=0.776_r8
103 END DO
104 END DO
105#else
106 ana_humidity.h: no values provided for hair.
107#endif
108!
109! Exchange boundary data.
110!
111 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
112 CALL exchange_r2d_tile (ng, tile, &
113 & lbi, ubi, lbj, ubj, &
114 & hair)
115 END IF
116
117#ifdef DISTRIBUTE
118 CALL mp_exchange2d (ng, tile, model, 1, &
119 & lbi, ubi, lbj, ubj, &
120 & nghostpoints, &
121 & ewperiodic(ng), nsperiodic(ng), &
122 & hair)
123#endif
124!
125 RETURN

References mod_scalars::ewperiodic, exchange_2d_mod::exchange_r2d_tile(), mp_exchange_mod::mp_exchange2d(), mod_param::nghostpoints, and mod_scalars::nsperiodic.

Referenced by ana_humid().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_initial()

subroutine analytical_mod::ana_initial ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 2 of file ana_initial.h.

3!
4!! git $Id$
5!!======================================================================
6!! Copyright (c) 2002-2025 The ROMS Group !
7!! Licensed under a MIT/X style license !
8!! See License_ROMS.md !
9!=======================================================================
10! !
11! This subroutine sets initial conditions for momentum and tracer !
12! type variables using analytical expressions. !
13! !
14!=======================================================================
15!
16 USE mod_param
17 USE mod_grid
18 USE mod_ncparam
19 USE mod_ocean
20 USE mod_stepping
21!
22! Imported variable declarations.
23!
24 integer, intent(in) :: ng, tile, model
25!
26! Local variable declarations.
27!
28 character (len=*), parameter :: MyFile = &
29 & __FILE__
30!
31#include "tile.h"
32!
33 IF (model.eq.inlm) THEN
34 CALL ana_nlminitial_tile (ng, tile, model, &
35 & lbi, ubi, lbj, ubj, &
36 & imins, imaxs, jmins, jmaxs, &
37 & grid(ng) % h, &
38#ifdef SPHERICAL
39 & grid(ng) % lonr, &
40 & grid(ng) % latr, &
41#else
42 & grid(ng) % xr, &
43 & grid(ng) % yr, &
44#endif
45#ifdef SOLVE3D
46 & grid(ng) % z_r, &
47 & ocean(ng) % u, &
48 & ocean(ng) % v, &
49 & ocean(ng) % t, &
50#endif
51 & ocean(ng) % ubar, &
52 & ocean(ng) % vbar, &
53 & ocean(ng) % zeta)
54#ifdef TANGENT
55 ELSE IF ((model.eq.itlm).or.(model.eq.irpm)) THEN
56 CALL ana_tlminitial_tile (ng, tile, model, &
57 & lbi, ubi, lbj, ubj, &
58 & imins, imaxs, jmins, jmaxs, &
59 & kstp(ng), &
60# ifdef SOLVE3D
61 & nstp(ng), &
62 & ocean(ng) % tl_u, &
63 & ocean(ng) % tl_v, &
64 & ocean(ng) % tl_t, &
65# endif
66 & ocean(ng) % tl_ubar, &
67 & ocean(ng) % tl_vbar, &
68 & ocean(ng) % tl_zeta)
69#endif
70#ifdef ADJOINT
71 ELSE IF (model.eq.iadm) THEN
72 CALL ana_adminitial_tile (ng, tile, model, &
73 & lbi, ubi, lbj, ubj, &
74 & imins, imaxs, jmins, jmaxs, &
75 & knew(ng), &
76# ifdef SOLVE3D
77 & nstp(ng), &
78 & ocean(ng) % ad_u, &
79 & ocean(ng) % ad_v, &
80 & ocean(ng) % ad_t, &
81# endif
82 & ocean(ng) % ad_ubar, &
83 & ocean(ng) % ad_vbar, &
84 & ocean(ng) % ad_zeta)
85#endif
86 END IF
87!
88! Set analytical header file name used.
89!
90#ifdef DISTRIBUTE
91 IF (lanafile) THEN
92#else
93 IF (lanafile.and.(tile.eq.0)) THEN
94#endif
95 ananame(10)=myfile
96 END IF
97!
98 RETURN
mod_param::irpm
integer, parameter irpm
Definition mod_param.F:664
mod_param::iadm
integer, parameter iadm
Definition mod_param.F:665
mod_param::itlm
integer, parameter itlm
Definition mod_param.F:663
mod_stepping::kstp
integer, dimension(:), allocatable kstp
Definition mod_stepping.F:66
mod_stepping::nstp
integer, dimension(:), allocatable nstp
Definition mod_stepping.F:71

References ana_adminitial_tile(), ana_nlminitial_tile(), ana_tlminitial_tile(), mod_ncparam::ananame, mod_grid::grid, mod_param::iadm, mod_param::inlm, mod_param::irpm, mod_param::itlm, mod_stepping::knew, mod_stepping::kstp, mod_ncparam::lanafile, mod_stepping::nstp, and mod_ocean::ocean.

Referenced by ad_initial(), initial(), rp_initial(), and tl_initial().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_m2clima()

subroutine analytical_mod::ana_m2clima ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 2 of file ana_m2clima.h.

3!
4!! git $Id$
5!!======================================================================
6!! Copyright (c) 2002-2025 The ROMS Group !
7!! Licensed under a MIT/X style license !
8!! See License_ROMS.md !
9!=======================================================================
10! !
11! This routine sets analytical 2D momentum climatology fields. !
12! !
13!=======================================================================
14!
15 USE mod_param
16 USE mod_ncparam
17!
18! Imported variable declarations.
19!
20 integer, intent(in) :: ng, tile, model
21!
22! Local variable declarations.
23!
24 character (len=*), parameter :: MyFile = &
25 & __FILE__
26!
27#include "tile.h"
28!
29 CALL ana_m2clima_tile (ng, tile, model, &
30 & lbi, ubi, lbj, ubj, &
31 & imins, imaxs, jmins, jmaxs)
32!
33! Set analytical header file name used.
34!
35#ifdef DISTRIBUTE
36 IF (lanafile) THEN
37#else
38 IF (lanafile.and.(tile.eq.0)) THEN
39#endif
40 ananame(11)=myfile
41 END IF
42!
43 RETURN

References ana_m2clima_tile(), mod_ncparam::ananame, and mod_ncparam::lanafile.

Referenced by ad_set_data_tile(), rp_set_data_tile(), set_data_tile(), and tl_set_data_tile().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_m2clima_tile()

subroutine analytical_mod::ana_m2clima_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs )

Definition at line 47 of file ana_m2clima.h.

50!***********************************************************************
51!
52 USE mod_param
53 USE mod_clima
54 USE mod_scalars
55!
56 USE exchange_2d_mod
57#ifdef DISTRIBUTE
58 USE mp_exchange_mod, ONLY : mp_exchange2d
59#endif
60!
61! Imported variable declarations.
62!
63 integer, intent(in) :: ng, tile, model
64 integer, intent(in) :: LBi, UBi, LBj, UBj
65 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
66!
67! Local variable declarations.
68!
69 integer :: i, j
70
71#include "set_bounds.h"
72!
73!-----------------------------------------------------------------------
74! Set 2D momentum climatology.
75!-----------------------------------------------------------------------
76!
77 IF (lm2clm(ng)) THEN
78 DO j=jstrt,jendt
79 DO i=istrp,iendt
80 clima(ng)%ubarclm(i,j)=???
81 END DO
82 END DO
83 DO j=jstrp,jendt
84 DO i=istrt,iendt
85 clima(ng)%vbarclm(i,j)=???
86 END DO
87 END DO
88!
89! Exchange boundary data.
90!
91 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
92 CALL exchange_u2d_tile (ng, tile, &
93 & lbi, ubi, lbj, ubj, &
94 & clima(ng) % ubarclm)
95 CALL exchange_v2d_tile (ng, tile, &
96 & lbi, ubi, lbj, ubj, &
97 & clima(ng) % vbarclm)
98 END IF
99
100#ifdef DISTRIBUTE
101 CALL mp_exchange2d (ng, tile, model, 2, &
102 & lbi, ubi, lbj, ubj, &
103 & nghostpoints, &
104 & ewperiodic(ng), nsperiodic(ng), &
105 & clima(ng) % ubarclm, &
106 % CLIMA(ng) % vbarclm)
107#endif
108 END IF
109!
110 RETURN
exchange_2d_mod::exchange_u2d_tile
subroutine exchange_u2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
Definition exchange_2d.F:440
exchange_2d_mod::exchange_v2d_tile
subroutine exchange_v2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
Definition exchange_2d.F:627
mod_clima
Definition mod_clima.F:2
mod_clima::clima
type(t_clima), dimension(:), allocatable clima
Definition mod_clima.F:153
mod_scalars::lm2clm
logical, dimension(:), allocatable lm2clm
Definition mod_scalars.F:526

References mod_clima::clima, mod_scalars::ewperiodic, exchange_2d_mod::exchange_u2d_tile(), exchange_2d_mod::exchange_v2d_tile(), mod_scalars::lm2clm, mp_exchange_mod::mp_exchange2d(), mod_param::nghostpoints, and mod_scalars::nsperiodic.

Referenced by ana_m2clima().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_m2obc()

subroutine analytical_mod::ana_m2obc ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 2 of file ana_m2obc.h.

3!
4!! git $Id$
5!!======================================================================
6!! Copyright (c) 2002-2025 The ROMS Group !
7!! Licensed under a MIT/X style license !
8!! See License_ROMS.md !
9!=======================================================================
10! !
11! This routine sets 2D momentum open boundary conditions using !
12! analytical expressions. !
13! !
14!=======================================================================
15!
16 USE mod_param
17 USE mod_grid
18 USE mod_ncparam
19 USE mod_ocean
20 USE mod_stepping
21!
22! Imported variable declarations.
23!
24 integer, intent(in) :: ng, tile, model
25!
26! Local variable declarations.
27!
28 character (len=*), parameter :: MyFile = &
29 & __FILE__
30!
31#include "tile.h"
32!
33 CALL ana_m2obc_tile (ng, tile, model, &
34 & lbi, ubi, lbj, ubj, &
35 & imins, imaxs, jmins, jmaxs, &
36 & knew(ng), &
37 & grid(ng) % angler, &
38 & grid(ng) % h, &
39 & grid(ng) % pm, &
40 & grid(ng) % pn, &
41 & grid(ng) % on_u, &
42#ifdef MASKING
43 & grid(ng) % umask, &
44#endif
45 & ocean(ng) % zeta)
46!
47! Set analytical header file name used.
48!
49#ifdef DISTRIBUTE
50 IF (lanafile) THEN
51#else
52 IF (lanafile.and.(tile.eq.0)) THEN
53#endif
54 ananame(12)=myfile
55 END IF
56!
57 RETURN

References ana_m2obc_tile(), mod_ncparam::ananame, mod_grid::grid, mod_stepping::knew, mod_ncparam::lanafile, and mod_ocean::ocean.

Referenced by ad_set_data_tile(), rp_set_data_tile(), set_data_tile(), and tl_set_data_tile().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_m2obc_tile()

subroutine analytical_mod::ana_m2obc_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
integer, intent(in) knew,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) angler,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) h,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) pm,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) pn,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) on_u,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) umask,
real(r8), dimension(lbi:ubi,lbj:ubj,:), intent(in) zeta )

Definition at line 61 of file ana_m2obc.h.

70!***********************************************************************
71!
72 USE mod_param
73 USE mod_boundary
74 USE mod_grid
75 USE mod_ncparam
76 USE mod_scalars
77!
78! Imported variable declarations.
79!
80 integer, intent(in) :: ng, tile, model
81 integer, intent(in) :: LBi, UBi, LBj, UBj
82 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
83 integer, intent(in) :: knew
84!
85#ifdef ASSUMED_SHAPE
86 real(r8), intent(in) :: angler(LBi:,LBj:)
87 real(r8), intent(in) :: h(LBi:,LBj:)
88 real(r8), intent(in) :: pm(LBi:,LBj:)
89 real(r8), intent(in) :: pn(LBi:,LBj:)
90 real(r8), intent(in) :: on_u(LBi:,LBj:)
91# ifdef MASKING
92 real(r8), intent(in) :: umask(LBi:,LBj:)
93# endif
94 real(r8), intent(in) :: zeta(LBi:,LBj:,:)
95#else
96 real(r8), intent(in) :: angler(LBi:UBi,LBj:UBj)
97 real(r8), intent(in) :: h(LBi:UBi,LBj:UBj)
98 real(r8), intent(in) :: pm(LBi:UBi,LBj:UBj)
99 real(r8), intent(in) :: pn(LBi:UBi,LBj:UBj)
100 real(r8), intent(in) :: on_u(LBi:UBi,LBj:UBj)
101# ifdef MASKING
102 real(r8), intent(in) :: umask(LBi:UBi,LBj:UBj)
103# endif
104 real(r8), intent(in) :: zeta(LBi:UBi,LBj:UBj,:)
105#endif
106!
107! Local variable declarations.
108!
109 integer :: i, j
110!
111 real(r8) :: angle, cff, fac, major, minor, omega, phase, val
112 real(r8) :: ramp
113#if defined ESTUARY_TEST || defined INLET_TEST
114 real(r8) :: my_area, my_flux, tid_flow, riv_flow, cff1, cff2, &
115 & model_flux
116#endif
117#if defined TEST_CHAN
118 real(r8) :: my_area, my_width
119#endif
120
121#include "set_bounds.h"
122!
123!-----------------------------------------------------------------------
124! 2D momentum open boundary conditions.
125!-----------------------------------------------------------------------
126!
127#if defined ESTUARY_TEST
128 IF (lbc(iwest,isubar,ng)%acquire.and. &
129 & lbc(iwest,isvbar,ng)%acquire.and. &
130 & domain(ng)%Western_Edge(tile)) THEN
131 cff1=0.40_r8 ! west end
132 cff2=0.08_r8
133 riv_flow=cff2*300.0_r8*5.0_r8
134 tid_flow=cff1*300.0_r8*10.0_r8
135 my_area=0.0_r8
136 my_flux=0.0_r8
137 DO j=jstrp,jendp
138 cff=0.5_r8*(zeta(istr ,j,knew)+h(istr ,j)+ &
139 & zeta(istr-1,j,knew)+h(istr-1,j))/pn(istr,j)
140 my_area=my_area+cff
141 END DO
142 my_flux=-tid_flow*sin(2.0_r8*pi*time(ng)/ &
143 & (12.0_r8*3600.0_r8))-riv_flow
144 DO j=jstrp,jendp
145 boundary(ng)%ubar_west(j)=my_flux/my_area
146 boundary(ng)%vbar_west(j)=0.0_r8
147 END DO
148 END IF
149
150 IF (lbc(ieast,isubar,ng)%acquire.and. &
151 & lbc(ieast,isvbar,ng)%acquire.and. &
152 & domain(ng)%Eastern_Edge(tile)) THEN
153 cff2=0.08_r8 ! east end
154 riv_flow=cff2*300.0_r8*5.0_r8
155 my_area=0.0_r8
156 my_flux=0.0_r8
157 DO j=jstrp,jendp
158 cff=0.5_r8*(zeta(iend ,j,knew)+h(iend ,j)+ &
159 & zeta(iend+1,j,knew)+h(iend+1,j))/pn(iend,j)
160 my_area=my_area+cff
161 END DO
162 my_flux=-riv_flow
163 DO j=jstrp,jendp
164 boundary(ng)%ubar_east(j)=my_flux/my_area
165 boundary(ng)%vbar_east(j)=0.0_r8
166 END DO
167 END IF
168
169#elif defined KELVIN
170 fac=1.0_r8 ! zeta0
171 omega=2.0_r8*pi/(12.42_r8*3600.0_r8) ! M2 Tide period
172 val=fac*sin(omega*time(ng))
173 IF (lbc(iwest,isubar,ng)%acquire.and. &
174 & lbc(iwest,isvbar,ng)%acquire.and. &
175 & domain(ng)%Western_Edge(tile)) THEN
176 DO j=jstrt,jendt
177 cff=sqrt(g*grid(ng)%h(istr-1,j))
178 boundary(ng)%ubar_west(j)=(val*cff/grid(ng)%h(istr-1,j))* &
179 & exp(-grid(ng)%f(istr-1,j)* &
180 & grid(ng)%yp(istr-1,j)/cff)
181 END DO
182 DO j=jstrp,jendt
183 boundary(ng)%vbar_west(j)=0.0_r8
184 END DO
185 END IF
186
187 IF (lbc(ieast,isubar,ng)%acquire.and. &
188 & lbc(ieast,isvbar,ng)%acquire.and. &
189 & domain(ng)%Eastern_Edge(tile)) THEN
190 DO j=jstrt,jendt
191 cff=sqrt(g*grid(ng)%h(iend,j))
192 val=fac*exp(-grid(ng)%f(iend,j)*grid(ng)%yp(istr-1,j)/cff)
193 boundary(ng)%ubar_east(j)=(val*cff/grid(ng)%h(iend,j))* &
194 & sin(omega*grid(ng)%xp(iend,j)/cff- &
195 & omega*time(ng))
196 END DO
197 DO j=jstrp,jendt
198 boundary(ng)%vbar_east(j)=0.0_r8
199 END DO
200 END IF
201
202#elif defined SED_TEST1
203 IF (lbc(iwest,isubar,ng)%acquire.and. &
204 & lbc(iwest,isvbar,ng)%acquire.and. &
205 & domain(ng)%Western_Edge(tile)) THEN
206 DO j=jstrt,jendt
207 val=0.5_r8*(zeta(istr-1,j,knew)+h(istr-1,j)+ &
208 & zeta(istr ,j,knew)+h(istr ,j))
209 boundary(ng)%ubar_west(j)=-10.0_r8/val
210 END DO
211 DO j=jstrp,jendt
212 boundary(ng)%vbar_west(j)=0.0_r8
213 END DO
214 END IF
215
216 IF (lbc(ieast,isubar,ng)%acquire.and. &
217 & lbc(ieast,isvbar,ng)%acquire.and. &
218 & domain(ng)%Eastern_Edge(tile)) THEN
219 DO j=jstrt,jendt
220 val=0.5_r8*(zeta(iend ,j,knew)+h(iend ,j)+ &
221 & zeta(iend+1,j,knew)+h(iend+1,j))
222 boundary(ng)%ubar_east(j)=-10.0_r8/val
223 END DO
224 DO j=jstrp,jendt
225 boundary(ng)%vbar_east(j)=0.0_r8
226 END DO
227 END IF
228
229#elif defined TEST_CHAN
230 ramp=min(time(ng)/150000.0_r8,1.0_r8)
231 IF (lbc(iwest,isubar,ng)%acquire.and. &
232 & lbc(iwest,isvbar,ng)%acquire.and. &
233 & domain(ng)%Western_Edge(tile)) THEN
234 my_area =0.0_r8
235 my_width=0.0_r8
236 DO j=jstr,jend
237 my_area=my_area+0.5_r8*(zeta(istr-1,j,knew)+h(istr-1,j)+ &
238 & zeta(istr ,j,knew)+h(istr ,j))* &
239 & on_u(istr,j)
240 my_width=my_width+on_u(istr,j)
241 END DO
242 fac=my_width*10.0_r8*1.0_r8*ramp !(width depth ubar)
243 DO j=jstr,jend
244 boundary(ng)%ubar_west(j)=fac/my_area
245 END DO
246 END IF
247
248 IF (lbc(ieast,isubar,ng)%acquire.and. &
249 & lbc(ieast,isvbar,ng)%acquire.and. &
250 & domain(ng)%Eastern_Edge(tile)) THEN
251 my_area =0.0_r8
252 my_width=0.0_r8
253 DO j=jstr,jend
254 my_area=my_area+0.5_r8*(zeta(iend+1,j,knew)+h(iend+1,j)+ &
255 & zeta(iend ,j,knew)+h(iend ,j))* &
256 & on_u(iend,j)
257 my_width=my_width+on_u(iend,j)
258 END DO
259 fac=my_width*10.0_r8*1.0_r8*ramp !(width depth ubar)
260 DO j=jstr,jend
261 boundary(ng)%ubar_east(j)=fac/my_area
262 END DO
263 END IF
264
265#elif defined TRENCH
266 IF (lbc(iwest,isubar,ng)%acquire.and. &
267 & lbc(iwest,isvbar,ng)%acquire.and. &
268 & domain(ng)%Western_Edge(tile)) THEN
269 my_area=0.0_r8
270 my_width=0.0_r8
271 DO j=jstr,jend
272 my_area=my_area+0.5_r8*(zeta(istr-1,j,knew)+h(istr-1,j)+ &
273 & zeta(istr ,j,knew)+h(istr ,j))* &
274 & on_u(istr,j)
275 my_width=my_width+on_u(istr,j)
276 END DO
277 fac=my_width*0.39_r8*0.51_r8 !(width depth ubar)
278 DO j=jstr,jend
279 boundary(ng)%ubar_west(j)=fac/my_area
280 END DO
281 END IF
282
283 IF (lbc(ieast,isubar,ng)%acquire.and. &
284 & lbc(ieast,isvbar,ng)%acquire.and. &
285 & domain(ng)%Eastern_Edge(tile)) THEN
286 my_area=0.0_r8
287 my_width=0.0_r8
288 DO j=jstr,jend
289 my_area=my_area+0.5_r8*(zeta(iend+1,j,knew)+h(iend+1,j)+ &
290 & zeta(iend ,j,knew)+h(iend ,j))* &
291 & on_u(iend,j)
292 my_width=my_width+on_u(iend,j)
293 END DO
294 fac=my_width*0.39_r8*0.51_r8 !(width depth ubar)
295 DO j=jstr,jend
296 boundary(ng)%ubar_east(j)=fac/my_area
297 END DO
298 END IF
299
300#elif defined WEDDELL
301 IF (lbc(iwest,isubar,ng)%acquire.and. &
302 & lbc(iwest,isvbar,ng)%acquire.and. &
303 & domain(ng)%Western_Edge(tile)) THEN
304 fac=tanh((tdays(ng)-dstart)/1.0_r8)
305 omega=2.0_r8*pi*time(ng)/(12.42_r8*3600.0_r8) ! M2 Tide period
306 minor=0.0143_r8+(0.0143_r8+0.010_r8)/real(iend+1,r8)
307 major=0.1144_r8+(0.1144_r8-0.013_r8)/real(iend+1,r8)
308 phase=(318.0_r8+(318.0_r8-355.0_r8)/real(iend+1,r8))*deg2rad
309 angle=(125.0_r8+(125.0_r8- 25.0_r8)/real(iend+1,r8))*deg2rad
310 DO j=jstrt,jendt
311 val=0.5_r8*(angler(istr-1,j)+angler(istr,j))
312 boundary(ng)%ubar_west(j)=fac*(major*cos(angle-val)* &
313 & cos(omega-phase)- &
314 & minor*sin(angle-val)* &
315 & sin(omega-phase))
316 END DO
317 DO j=jstrp,jendt
318 val=0.5_r8*(angler(istr-1,j-1)+angler(istr-1,j))
319 boundary(ng)%vbar_west(j)=fac*(major*sin(angle-val)* &
320 & cos(omega-phase)- &
321 & minor*sin(angle-val)* &
322 & cos(omega-phase))
323 END DO
324 END IF
325
326 IF (lbc(ieast,isubar,ng)%acquire.and. &
327 & lbc(ieast,isvbar,ng)%acquire.and. &
328 & domain(ng)%Eastern_Edge(tile)) THEN
329 fac=tanh((tdays(ng)-dstart)/1.0_r8)
330 omega=2.0_r8*pi*time(ng)/(12.42_r8*3600.0_r8) ! M2 Tide period
331 minor=0.0143_r8+(0.0143_r8+0.010_r8)
332 major=0.1144_r8+(0.1144_r8-0.013_r8)
333 phase=(318.0_r8+(318.0_r8-355.0_r8))*deg2rad
334 angle=(125.0_r8+(125.0_r8- 25.0_r8))*deg2rad
335 DO j=jstrt,jendt
336 val=0.5_r8*(angler(iend,j)+angler(iend+1,j))
337 boundary(ng)%ubar_east(j)=fac*(major*cos(angle-val)* &
338 & cos(omega-phase)- &
339 & minor*sin(angle-val)* &
340 & sin(omega-phase))
341 END DO
342 DO j=jstrp,jendt
343 val=0.5_r8*(angler(iend+1,j-1)+angler(iend+1,j))
344 boundary(ng)%vbar_east(j)=fac*(major*sin(angle-val)* &
345 & cos(omega-phase)- &
346 & minor*sin(angle-val)* &
347 & cos(omega-phase))
348 END DO
349 END IF
350#else
351 IF (lbc(ieast,isubar,ng)%acquire.and. &
352 & lbc(ieast,isvbar,ng)%acquire.and. &
353 & domain(ng)%Eastern_Edge(tile)) THEN
354 DO j=jstrt,jendt
355 boundary(ng)%ubar_east(j)=0.0_r8
356 END DO
357 DO j=jstrp,jendt
358 boundary(ng)%vbar_east(j)=0.0_r8
359 END DO
360 END IF
361
362 IF (lbc(iwest,isubar,ng)%acquire.and. &
363 & lbc(iwest,isvbar,ng)%acquire.and. &
364 & domain(ng)%Western_Edge(tile)) THEN
365 DO j=jstrt,jendt
366 boundary(ng)%ubar_west(j)=0.0_r8
367 END DO
368 DO j=jstrp,jendt
369 boundary(ng)%vbar_west(j)=0.0_r8
370 END DO
371 END IF
372
373 IF (lbc(isouth,isubar,ng)%acquire.and. &
374 & lbc(isouth,isvbar,ng)%acquire.and. &
375 & domain(ng)%Southern_Edge(tile)) THEN
376 DO i=istrp,iendt
377 boundary(ng)%ubar_south(i)=0.0_r8
378 END DO
379 DO i=istrt,iendt
380 boundary(ng)%vbar_south(i)=0.0_r8
381 END DO
382 END IF
383
384 IF (lbc(inorth,isubar,ng)%acquire.and. &
385 & lbc(inorth,isvbar,ng)%acquire.and. &
386 & domain(ng)%Northern_Edge(tile)) THEN
387 DO i=istrp,iendt
388 boundary(ng)%ubar_north(i)=0.0_r8
389 END DO
390 DO i=istrt,iendt
391 boundary(ng)%vbar_north(i)=0.0_r8
392 END DO
393 END IF
394#endif
395!
396 RETURN
mod_ncparam::isvbar
integer isvbar
Definition mod_ncparam.F:505
mod_ncparam::isubar
integer isubar
Definition mod_ncparam.F:504

References mod_boundary::boundary, mod_scalars::deg2rad, mod_param::domain, mod_scalars::dstart, mod_scalars::g, mod_grid::grid, mod_scalars::ieast, mod_scalars::inorth, mod_scalars::isouth, mod_ncparam::isubar, mod_ncparam::isvbar, mod_scalars::iwest, mod_param::lbc, mod_scalars::pi, mod_scalars::tdays, and mod_scalars::time.

Referenced by ana_m2obc().

Here is the caller graph for this function:

◆ ana_m3clima()

subroutine analytical_mod::ana_m3clima ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 2 of file ana_m3clima.h.

3!
4!! git $Id$
5!!======================================================================
6!! Copyright (c) 2002-2025 The ROMS Group !
7!! Licensed under a MIT/X style license !
8!! See License_ROMS.md !
9!=======================================================================
10! !
11! This routine sets analytical 3D momentum climatology fields. !
12! !
13!=======================================================================
14!
15 USE mod_param
16 USE mod_ncparam
17!
18! Imported variable declarations.
19!
20 integer, intent(in) :: ng, tile, model
21!
22! Local variable declarations.
23!
24 character (len=*), parameter :: MyFile = &
25 & __FILE__
26!
27#include "tile.h"
28!
29 CALL ana_m3clima_tile (ng, tile, model, &
30 & lbi, ubi, lbj, ubj, &
31 & imins, imaxs, jmins, jmaxs)
32!
33! Set analytical header file name used.
34!
35#ifdef DISTRIBUTE
36 IF (lanafile) THEN
37#else
38 IF (lanafile.and.(tile.eq.0)) THEN
39#endif
40 ananame(13)=myfile
41 END IF
42!
43 RETURN

References ana_m3clima_tile(), mod_ncparam::ananame, and mod_ncparam::lanafile.

Referenced by ad_set_data_tile(), rp_set_data_tile(), set_data_tile(), and tl_set_data_tile().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_m3clima_tile()

subroutine analytical_mod::ana_m3clima_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs )

Definition at line 47 of file ana_m3clima.h.

50!***********************************************************************
51!
52 USE mod_param
53 USE mod_clima
54 USE mod_scalars
55!
56 USE exchange_3d_mod
57#ifdef DISTRIBUTE
58 USE mp_exchange_mod, ONLY : mp_exchange3d
59#endif
60!
61! Imported variable declarations.
62!
63 integer, intent(in) :: ng, tile, model
64 integer, intent(in) :: LBi, UBi, LBj, UBj
65 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
66!
67! Local variable declarations.
68!
69 integer :: i, j, k
70
71#include "set_bounds.h"
72!
73!-----------------------------------------------------------------------
74! Set 3D momentum climatology.
75!-----------------------------------------------------------------------
76!
77 IF (lm3clm(ng)) THEN
78 DO k=1,n(ng)
79 DO j=jstrt,jendt
80 DO i=istrp,iendt
81 clima(ng)%uclm(i,j,k)=???
82 END DO
83 END DO
84 DO j=jstrp,jendt
85 DO i=istrt,iendt
86 clima(ng)%vclm(i,j,k)=???
87 END DO
88 END DO
89 END DO
90!
91! Exchange boundary data.
92!
93 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
94 CALL exchange_u3d_tile (ng, tile, &
95 & lbi, ubi, lbj, ubj, 1, n(ng), &
96 & clima(ng) % uclm)
97 CALL exchange_v3d_tile (ng, tile, &
98 & lbi, ubi, lbj, ubj, 1, n(ng), &
99 & clima(ng) % vclm)
100 END IF
101
102#ifdef DISTRIBUTE
103 CALL mp_exchange3d (ng, tile, model, 2, &
104 & lbi, ubi, lbj, ubj, 1, n(ng), &
105 & nghostpoints, &
106 & ewperiodic(ng), nsperiodic(ng), &
107 & clima(ng) % uclm, &
108 & clima(ng) % vclm)
109#endif
110 END IF
111!
112 RETURN
exchange_3d_mod
Definition exchange_3d.F:2
exchange_3d_mod::exchange_u3d_tile
subroutine exchange_u3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, a)
Definition exchange_3d.F:495
exchange_3d_mod::exchange_v3d_tile
subroutine exchange_v3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, a)
Definition exchange_3d.F:707
mod_scalars::lm3clm
logical, dimension(:), allocatable lm3clm
Definition mod_scalars.F:527
mp_exchange_mod::mp_exchange3d
subroutine mp_exchange3d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, lbk, ubk, nghost, ew_periodic, ns_periodic, a, b, c, d)
Definition mp_exchange.F:2037

References mod_clima::clima, mod_scalars::ewperiodic, exchange_3d_mod::exchange_u3d_tile(), exchange_3d_mod::exchange_v3d_tile(), mod_scalars::lm3clm, mp_exchange_mod::mp_exchange3d(), mod_param::n, mod_param::nghostpoints, and mod_scalars::nsperiodic.

Referenced by ana_m3clima().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_m3obc()

subroutine analytical_mod::ana_m3obc ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 2 of file ana_m3obc.h.

3!
4!! git $Id$
5!!======================================================================
6!! Copyright (c) 2002-2025 The ROMS Group !
7!! Licensed under a MIT/X style license !
8!! See License_ROMS.md !
9!=======================================================================
10! !
11! This routine sets 3D momentum open boundary conditions using !
12! analytical expressions. !
13! !
14!=======================================================================
15!
16 USE mod_param
17 USE mod_boundary
18 USE mod_ncparam
19!
20! Imported variable declarations.
21!
22 integer, intent(in) :: ng, tile, model
23!
24! Local variable declarations.
25!
26 character (len=*), parameter :: MyFile = &
27 & __FILE__
28!
29#include "tile.h"
30!
31 CALL ana_m3obc_tile (ng, tile, model, &
32 & lbi, ubi, lbj, ubj, &
33 & imins, imaxs, jmins, jmaxs)
34!
35! Set analytical header file name used.
36!
37#ifdef DISTRIBUTE
38 IF (lanafile) THEN
39#else
40 IF (lanafile.and.(tile.eq.0)) THEN
41#endif
42 ananame(14)=myfile
43 END IF
44!
45 RETURN

References ana_m3obc_tile(), mod_ncparam::ananame, and mod_ncparam::lanafile.

Referenced by ad_set_data_tile(), rp_set_data_tile(), set_data_tile(), and tl_set_data_tile().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_m3obc_tile()

subroutine analytical_mod::ana_m3obc_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs )

Definition at line 49 of file ana_m3obc.h.

52!***********************************************************************
53!
54 USE mod_param
55 USE mod_boundary
56 USE mod_grid
57 USE mod_ncparam
58 USE mod_ocean
59 USE mod_scalars
60!
61! Imported variable declarations.
62!
63 integer, intent(in) :: ng, tile, model
64 integer, intent(in) :: LBi, UBi, LBj, UBj
65 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
66!
67! Local variable declarations.
68!
69 integer :: i, j, k
70!
71 real(r8) :: fac, val
72
73#include "set_bounds.h"
74!
75!-----------------------------------------------------------------------
76! 3D momentum open boundary conditions.
77!-----------------------------------------------------------------------
78!
79#if defined SED_TEST1
80 IF (lbc(iwest,isuvel,ng)%acquire.and. &
81 & lbc(iwest,isvvel,ng)%acquire.and. &
82 & domain(ng)%Western_Edge(tile)) THEN
83 fac=5.0e-06_r8
84 DO k=1,n(ng)
85 DO j=jstrt,jendt
86 val=0.5_r8*(ocean(ng)%zeta(0 ,j,knew)+ &
87 & grid(ng)%h(0 ,j)+ &
88 & ocean(ng)%zeta(1 ,j,knew)+ &
89 & grid(ng)%h(1 ,j))
90 boundary(ng)%u_west(j,k)=-log((val+0.5*
91 % (grid(ng)%z_r(istr-1,j,k)+ &
92 & grid(ng)%z_r(istr ,j,k)))/ &
93 & fac)/ &
94 & (log(val/fac)-1.0_r8+fac/val)
95 END DO
96 DO j=jstrp,jendt
97 boundary(ng)%v_west(j,k)=0.0_r8
98 END DO
99 END DO
100 END IF
101
102 IF (lbc(ieast,isuvel,ng)%acquire.and. &
103 & lbc(ieast,isvvel,ng)%acquire.and. &
104 & domain(ng)%Eastern_Edge(tile)) THEN
105 fac=5.0e-06_r8
106 DO k=1,n(ng)
107 DO j=jstrt,jendt
108 val=0.5_r8*(ocean(ng)%zeta(iend ,j,knew)+ &
109 & grid(ng)%h(iend ,j)+ &
110 & ocean(ng)%zeta(iend+1,j,knew)+ &
111 % GRID(ng)%h(iend+1,j))
112 boundary(ng)%u_east(j,k)=-log((val+0.5*
113 & (grid(ng)%z_r(iend ,j,k)+ &
114 & grid(ng)%z_r(iend+1,j,k)))/ &
115 & fac)/ &
116 & (log(val/fac)-1.0_r8+fac/val)
117 END DO
118 DO j=jstrp,jendt
119 boundary(ng)%v_east(j,k)=0.0_r8
120 END DO
121 END DO
122 END IF
123#else
124 IF (lbc(ieast,isuvel,ng)%acquire.and. &
125 & lbc(ieast,isvvel,ng)%acquire.and. &
126 & domain(ng)%Eastern_Edge(tile)) THEN
127 DO k=1,n(ng)
128 DO j=jstrt,jendt
129 boundary(ng)%u_east(j,k)=0.0_r8
130 END DO
131 DO j=jstrp,jendt
132 boundary(ng)%v_east(j,k)=0.0_r8
133 END DO
134 END DO
135 END IF
136
137 IF (lbc(iwest,isuvel,ng)%acquire.and. &
138 & lbc(iwest,isvvel,ng)%acquire.and. &
139 & domain(ng)%Western_Edge(tile)) THEN
140 DO k=1,n(ng)
141 DO j=jstrt,jendt
142 boundary(ng)%u_west(j,k)=0.0_r8
143 END DO
144 DO j=jstrp,jendt
145 boundary(ng)%v_west(j,k)=0.0_r8
146 END DO
147 END DO
148 END IF
149
150 IF (lbc(isouth,isuvel,ng)%acquire.and. &
151 & lbc(isouth,isvvel,ng)%acquire.and. &
152 & domain(ng)%Southern_Edge(tile)) THEN
153 DO k=1,n(ng)
154 DO i=istrp,iendt
155 boundary(ng)%u_south(i,k)=0.0_r8
156 END DO
157 DO i=istrt,iendt
158 boundary(ng)%v_south(i,k)=0.0_r8
159 END DO
160 END DO
161 END IF
162
163 IF (lbc(inorth,isuvel,ng)%acquire.and. &
164 & lbc(inorth,isvvel,ng)%acquire.and. &
165 & domain(ng)%Northern_Edge(tile)) THEN
166 DO k=1,n(ng)
167 DO i=istrp,iendt
168 boundary(ng)%u_north(i,k)=0.0_r8
169 END DO
170 DO i=istrt,iendt
171 boundary(ng)%v_north(i,k)=0.0_r8
172 END DO
173 END DO
174 END IF
175#endif
176!
177 RETURN
mod_ncparam::isvvel
integer isvvel
Definition mod_ncparam.F:507
mod_ncparam::isuvel
integer isuvel
Definition mod_ncparam.F:506

References mod_boundary::boundary, mod_param::domain, mod_grid::grid, mod_scalars::ieast, mod_scalars::inorth, mod_scalars::isouth, mod_ncparam::isuvel, mod_ncparam::isvvel, mod_scalars::iwest, mod_param::lbc, mod_param::n, and mod_ocean::ocean.

Referenced by ana_m3obc().

Here is the caller graph for this function:

◆ ana_mask()

subroutine analytical_mod::ana_mask ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 2 of file ana_mask.h.

3!
4!! git $Id$
5!!======================================================================
6!! Copyright (c) 2002-2025 The ROMS Group !
7!! Licensed under a MIT/X style license !
8!! See License_ROMS.md !
9!=======================================================================
10! !
11! This subroutine sets analytical Land/Sea masking. !
12! !
13!=======================================================================
14!
15 USE mod_param
16 USE mod_grid
17 USE mod_ncparam
18!
19! Imported variable declarations.
20!
21 integer, intent(in) :: ng, tile, model
22!
23! Local variable declarations.
24!
25 character (len=*), parameter :: MyFile = &
26 & __FILE__
27!
28#include "tile.h"
29!
30 CALL ana_mask_tile (ng, tile, model, &
31 & lbi, ubi, lbj, ubj, &
32 & imins, imaxs, jmins, jmaxs, &
33 & grid(ng) % pmask, &
34 & grid(ng) % rmask, &
35 & grid(ng) % umask, &
36 & grid(ng) % vmask)
37!
38! Set analytical header file name used.
39!
40#ifdef DISTRIBUTE
41 IF (lanafile) THEN
42#else
43 IF (lanafile.and.(tile.eq.0)) THEN
44#endif
45 ananame(15)=myfile
46 END IF
47!
48 RETURN

References ana_mask_tile(), mod_ncparam::ananame, mod_grid::grid, and mod_ncparam::lanafile.

Referenced by ana_mask_tile(), and set_grid().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_mask_tile()

subroutine analytical_mod::ana_mask_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) pmask,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) rmask,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) umask,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) vmask )

Definition at line 52 of file ana_mask.h.

56!***********************************************************************
57!
58 USE mod_param
59 USE mod_parallel
60 USE mod_ncparam
61 USE mod_iounits
62 USE mod_scalars
63!
64 USE exchange_2d_mod
65#ifdef DISTRIBUTE
66 USE mp_exchange_mod, ONLY : mp_exchange2d
67#endif
68 USE stats_mod, ONLY : stats_2dfld
69!
70! Imported variable declarations.
71!
72 integer, intent(in) :: ng, tile, model
73 integer, intent(in) :: LBi, UBi, LBj, UBj
74 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
75!
76#ifdef ASSUMED_SHAPE
77 real(r8), intent(out) :: pmask(LBi:,LBj:)
78 real(r8), intent(out) :: rmask(LBi:,LBj:)
79 real(r8), intent(out) :: umask(LBi:,LBj:)
80 real(r8), intent(out) :: vmask(LBi:,LBj:)
81#else
82 real(r8), intent(out) :: pmask(LBi:UBi,LBj:UBj)
83 real(r8), intent(out) :: rmask(LBi:UBi,LBj:UBj)
84 real(r8), intent(out) :: umask(LBi:UBi,LBj:UBj)
85 real(r8), intent(out) :: vmask(LBi:UBi,LBj:UBj)
86#endif
87!
88! Local variable declarations.
89!
90 logical, save :: first = .true.
91!
92 integer :: Imin, Imax, Jmin, Jmax
93 integer :: i, j
94!
95 real(r8) :: mask(IminS:ImaxS,JminS:JmaxS)
96!
97 TYPE (T_STATS), save :: Stats(4)
98
99#include "set_bounds.h"
100!
101!-----------------------------------------------------------------------
102! Initialize field statictics structure.
103!-----------------------------------------------------------------------
104!
105 IF (first) THEN
106 first=.false.
107 DO i=1,SIZE(stats,1)
108 stats(i) % checksum=0_i8b
109 stats(i) % count=0
110 stats(i) % min=large
111 stats(i) % max=-large
112 stats(i) % avg=0.0_r8
113 stats(i) % rms=0.0_r8
114 END DO
115 END IF
116!
117!-----------------------------------------------------------------------
118! Set Land/Sea mask of RHO-points: Land=0, Sea=1.
119!-----------------------------------------------------------------------
120!
121! Notice that private scratch array "mask" is used to allow
122! computation within a parallel loop.
123!
124#ifdef DOUBLE_GYRE
125 imin=-2+(lm(ng)+1)/2
126 imax=imin+2
127 jmin=-2+(mm(ng)+1)/2
128 jmax=jmin+2
129 DO j=jstrm2,jendp2
130 DO i=istrm2,iendp2
131 mask(i,j)=1.0_r8
132 IF (((imin.le.i).and.(i.le.imax)).and. &
133 & ((jmin.le.j).and.(j.le.jmax))) THEN
134 mask(i,j)=0.0_r8
135 END IF
136 END DO
137 END DO
138#elif defined FLT_TEST
139 DO j=jstrm2,jendp2
140 DO i=istrm2,iendp2
141 mask(i,j)=1.0_r8
142 IF (j.eq.1 ) mask(i,j)=0.0_r8
143 IF (j.eq.mm(ng)) mask(i,j)=0.0_r8
144 IF ((i.ge.((lm(ng)+1)/2)).and. &
145 & (i.le.((lm(ng)+1)/2+1)).and. &
146 & (j.ge.((mm(ng)+1)/2)).and. &
147 & (j.le.((mm(ng)+1)/2+1))) mask(i,j)=0.0_r8
148 END DO
149 END DO
150#elif defined LAKE_SIGNELL
151 DO j=jstrm2,jendp2
152 DO i=istrm2,iendp2
153 mask(i,j)=1.0_r8
154 END DO
155 END DO
156 IF (domain(ng)%Western_Edge(tile)) THEN
157 DO j=jstrm1,jendp1
158 mask(istr-1,j)=0.0_r8
159 END DO
160 END IF
161 IF (domain(ng)%Eastern_Edge(tile)) THEN
162 DO j=jstrm1,jendp1
163 mask(iend+1,j)=0.0_r8
164 END DO
165 END IF
166 IF (domain(ng)%Southern_Edge(tile)) THEN
167 DO i=istrm1,iendp1
168 mask(i,jstr-1)=0.0_r8
169 END DO
170 END IF
171 IF (domain(ng)%Northern_Edge(tile)) THEN
172 DO i=istrm1,iendp1
173 mask(i,jend+1)=0.0_r8
174 END DO
175 END IF
176#elif defined RIVERPLUME1
177 DO j=jstrm2,jendp2
178 DO i=istrm2,iendp2
179 mask(i,j)=1.0_r8
180 END DO
181 END DO
182 DO i=istrm2,min(5,iendp2)
183 DO j=jstrm2,min(mm(ng)-18,jendp2)
184 mask(i,j)=0.0_r8
185 END DO
186 DO j=max(jstrm2,mm(ng)-16),jendp2
187 mask(i,j)=0.0_r8
188 END DO
189 END DO
190#elif defined RIVERPLUME2
191 DO j=jstrm2,jendp2
192 DO i=istrm2,iendp2
193 mask(i,j)=1.0_r8
194 END DO
195 END DO
196 DO i=istrm2,min(5,iendp2)
197 DO j=jstrm2,min(mm(ng)-11,jendp2)
198 mask(i,j)=0.0_r8
199 END DO
200 DO j=max(jstrm2,mm(ng)-9),jendp2
201 mask(i,j)=0.0_r8
202 END DO
203 END DO
204#elif defined SHOREFACE
205 DO j=jstrm2,jendp2
206 DO i=istrm2,iendp2
207 mask(i,j)=1.0_r8
208 END DO
209 END DO
210#else
211 ana_mask.h: no values provided for mask.
212#endif
213!
214 DO j=jstrt,jendt
215 DO i=istrt,iendt
216 rmask(i,j)=mask(i,j)
217 END DO
218 END DO
219!
220!-----------------------------------------------------------------------
221! Compute Land/Sea mask of U- and V-points.
222!-----------------------------------------------------------------------
223!
224 DO j=jstrt,jendt
225 DO i=istrp,iendt
226 umask(i,j)=mask(i-1,j)*mask(i,j)
227 END DO
228 END DO
229 DO j=jstrp,jendt
230 DO i=istrt,iendt
231 vmask(i,j)=mask(i,j-1)*mask(i,j)
232 END DO
233 END DO
234!
235!-----------------------------------------------------------------------
236! Compute Land/Sea mask of PSI-points.
237!-----------------------------------------------------------------------
238!
239 DO j=jstrp,jendt
240 DO i=istrp,iendt
241 pmask(i,j)=mask(i-1,j-1)*mask(i,j-1)* &
242 & mask(i-1,j )*mask(i,j )
243 END DO
244 END DO
245!
246!-----------------------------------------------------------------------
247! Report statitics.
248!-----------------------------------------------------------------------
249!
250 CALL stats_2dfld (ng, tile, inlm, p2dvar, stats(1), 0, &
251 & lbi, ubi, lbj, ubj, pmask)
252 IF (domain(ng)%NorthEast_Corner(tile)) THEN
253 WRITE (stdout,10) 'mask on PSI-points: mask_psi', &
254 & ng, stats(1)%min, stats(1)%max
255 END IF
256 CALL stats_2dfld (ng, tile, inlm, r2dvar, stats(2), 0, &
257 & lbi, ubi, lbj, ubj, rmask)
258 IF (domain(ng)%NorthEast_Corner(tile)) THEN
259 WRITE (stdout,10) 'mask on RHO-points: mask_rho', &
260 & ng, stats(2)%min, stats(2)%max
261 END IF
262 CALL stats_2dfld (ng, tile, inlm, u2dvar, stats(3), 0, &
263 & lbi, ubi, lbj, ubj, umask)
264 IF (domain(ng)%NorthEast_Corner(tile)) THEN
265 WRITE (stdout,10) 'mask on U-points: mask_u', &
266 & ng, stats(3)%min, stats(3)%max
267 END IF
268 CALL stats_2dfld (ng, tile, inlm, v2dvar, stats(4), 0, &
269 & lbi, ubi, lbj, ubj, vmask)
270 IF (domain(ng)%NorthEast_Corner(tile)) THEN
271 WRITE (stdout,10) 'mask on V-points: mask_v', &
272 & ng, stats(4)%min, stats(4)%max
273 END IF
274!
275!-----------------------------------------------------------------------
276! Exchange boundary data.
277!-----------------------------------------------------------------------
278!
279 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
280 CALL exchange_r2d_tile (ng, tile, &
281 & lbi, ubi, lbj, ubj, &
282 & rmask)
283 CALL exchange_p2d_tile (ng, tile, &
284 & lbi, ubi, lbj, ubj, &
285 & pmask)
286 CALL exchange_u2d_tile (ng, tile, &
287 & lbi, ubi, lbj, ubj, &
288 & umask)
289 CALL exchange_v2d_tile (ng, tile, &
290 & lbi, ubi, lbj, ubj, &
291 & vmask)
292 END IF
293
294#ifdef DISTRIBUTE
295 CALL mp_exchange2d (ng, tile, model, 4, &
296 & lbi, ubi, lbj, ubj, &
297 & nghostpoints, &
298 & ewperiodic(ng), nsperiodic(ng), &
299 & rmask, pmask, umask, vmask)
300#endif
301!
302 10 FORMAT (3x,' ANA_MASK - ',a,/,19x, &
303 & '(Grid = ',i2.2,', Min = ',1p,e15.8,0p, &
304 & ' Max = ',1p,e15.8,0p,')')
305!
306 RETURN
exchange_2d_mod::exchange_p2d_tile
subroutine exchange_p2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
Definition exchange_2d.F:66
mod_param::u2dvar
integer, parameter u2dvar
Definition mod_param.F:718
mod_param::p2dvar
integer, parameter p2dvar
Definition mod_param.F:716
mod_param::v2dvar
integer, parameter v2dvar
Definition mod_param.F:719

References ana_mask(), mod_param::domain, mod_scalars::ewperiodic, exchange_2d_mod::exchange_p2d_tile(), exchange_2d_mod::exchange_r2d_tile(), exchange_2d_mod::exchange_u2d_tile(), exchange_2d_mod::exchange_v2d_tile(), mod_param::inlm, mod_scalars::large, mod_param::lm, mod_param::mm, mp_exchange_mod::mp_exchange2d(), mod_param::nghostpoints, mod_scalars::nsperiodic, mod_param::p2dvar, mod_param::r2dvar, stats_mod::stats_2dfld(), mod_iounits::stdout, mod_param::u2dvar, and mod_param::v2dvar.

Referenced by ana_mask().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_nlminitial_tile()

subroutine analytical_mod::ana_nlminitial_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) h,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) lonr,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) latr,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) xr,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) yr,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng)), intent(in) z_r,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),2), intent(out) u,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),2), intent(out) v,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),3,nt(ng)), intent(out) t,
real(r8), dimension(lbi:ubi,lbj:ubj,:), intent(out) ubar,
real(r8), dimension(lbi:ubi,lbj:ubj,:), intent(out) vbar,
real(r8), dimension(lbi:ubi,lbj:ubj,:), intent(out) zeta )

Definition at line 102 of file ana_initial.h.

116!***********************************************************************
117!
118 USE mod_param
119 USE mod_parallel
120 USE mod_grid
121 USE mod_ncparam
122 USE mod_iounits
123 USE mod_scalars
124!
125#ifdef CHANNEL
126# ifdef DISTRIBUTE
127 USE distribute_mod, ONLY : mp_bcasti
128# endif
129 USE erf_mod, ONLY : erf
130#endif
131 USE stats_mod, ONLY : stats_2dfld
132#ifdef SOLVE3D
133 USE stats_mod, ONLY : stats_3dfld
134#endif
135!
136! Imported variable declarations.
137!
138 integer, intent(in) :: ng, tile, model
139 integer, intent(in) :: LBi, UBi, LBj, UBj
140 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
141!
142#ifdef ASSUMED_SHAPE
143 real(r8), intent(in) :: h(LBi:,LBj:)
144# ifdef SPHERICAL
145 real(r8), intent(in) :: lonr(LBi:,LBj:)
146 real(r8), intent(in) :: latr(LBi:,LBj:)
147# else
148 real(r8), intent(in) :: xr(LBi:,LBj:)
149 real(r8), intent(in) :: yr(LBi:,LBj:)
150# endif
151# ifdef SOLVE3D
152 real(r8), intent(in) :: z_r(LBi:,LBj:,:)
153
154 real(r8), intent(out) :: u(LBi:,LBj:,:,:)
155 real(r8), intent(out) :: v(LBi:,LBj:,:,:)
156 real(r8), intent(out) :: t(LBi:,LBj:,:,:,:)
157# endif
158 real(r8), intent(out) :: ubar(LBi:,LBj:,:)
159 real(r8), intent(out) :: vbar(LBi:,LBj:,:)
160 real(r8), intent(out) :: zeta(LBi:,LBj:,:)
161#else
162# ifdef SPHERICAL
163 real(r8), intent(in) :: lonr(LBi:UBi,LBj:UBj)
164 real(r8), intent(in) :: latr(LBi:UBi,LBj:UBj)
165# else
166 real(r8), intent(in) :: xr(LBi:UBi,LBj:UBj)
167 real(r8), intent(in) :: yr(LBi:UBi,LBj:UBj)
168# endif
169 real(r8), intent(in) :: h(LBi:UBi,LBj:UBj)
170# ifdef SOLVE3D
171 real(r8), intent(in) :: z_r(LBi:UBi,LBj:UBj,N(ng))
172
173 real(r8), intent(out) :: u(LBi:UBi,LBj:UBj,N(ng),2)
174 real(r8), intent(out) :: v(LBi:UBi,LBj:UBj,N(ng),2)
175 real(r8), intent(out) :: t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
176# endif
177 real(r8), intent(out) :: ubar(LBi:UBi,LBj:UBj,:)
178 real(r8), intent(out) :: vbar(LBi:UBi,LBj:UBj,:)
179 real(r8), intent(out) :: zeta(LBi:UBi,LBj:UBj,:)
180#endif
181!
182! Local variable declarations.
183!
184 logical, save :: first = .true.
185!
186 integer :: Iless, Iplus, i, itrc, j, k
187!
188#ifdef CHANNEL
189 real(r8), parameter :: guscale = 40.0e+03_r8
190 real(r8), parameter :: u0 = 1.6_r8
191#endif
192 real(r8) :: depth, dx, val1, val2, val3, val4, x, x0, y, y0
193!
194 TYPE (T_STATS), save :: Stats(7) ! ubar, vbar, zeta, u, v, t, s
195
196#include "set_bounds.h"
197!
198!-----------------------------------------------------------------------
199! Initialize field statistics structure.
200!-----------------------------------------------------------------------
201!
202 IF (first) THEN
203 first=.false.
204 DO i=1,SIZE(stats,1)
205 stats(i) % checksum=0_i8b
206 stats(i) % count=0
207 stats(i) % min=large
208 stats(i) % max=-large
209 stats(i) % avg=0.0_r8
210 stats(i) % rms=0.0_r8
211 END DO
212 END IF
213!
214!-----------------------------------------------------------------------
215! Initial conditions for 2D momentum (m/s) components.
216!-----------------------------------------------------------------------
217!
218#if defined CHANNEL && !defined ONLY_TS_IC
219 y0=0.5_r8*el(ng)
220 DO j=jstrt,jendt
221 DO i=istrp,iendt
222 val1=(grid(ng)%yu(i,j)-y0)/guscale
223 ubar(i,j,1)=u0*exp(-val1*val1)/6.0_r8
224 END DO
225 END DO
226 DO j=jstrp,jendt
227 DO i=istrt,iendt
228 vbar(i,j,1)=0.0_r8
229 END DO
230 END DO
231#elif defined SOLITON
232 x0=2.0_r8*xl(ng)/3.0_r8
233 y0=0.5_r8*el(ng)
234 val1=0.395_r8
235 val2=0.771_r8*(val1*val1)
236 IF (ng.eq.1) THEN
237 DO j=jstrt,jendt
238 DO i=istrp,iendt
239 x=0.5_r8*(xr(i-1,j)+xr(i,j))-x0
240 y=0.5_r8*(yr(i-1,j)+yr(i,j))-y0
241 val3=exp(-val1*x)
242 val4=val2*((2.0_r8*val3/(1.0_r8+(val3*val3)))**2)
243 ubar(i,j,1)=0.25_r8*val4*(6.0_r8*y*y-9.0_r8)* &
244 & exp(-0.5_r8*y*y)
245 END DO
246 END DO
247 DO j=jstrp,jendt
248 DO i=istrt,iendt
249 x=0.5_r8*(xr(i,j-1)+xr(i,j))-x0
250 y=0.5_r8*(yr(i,j-1)+yr(i,j))-y0
251 val3=exp(-val1*x)
252 val4=val2*((2.0_r8*val3/(1.0_r8+(val3*val3)))**2)
253 vbar(i,j,1)=2.0_r8*val4*y*(-2.0_r8*val1*tanh(val1*x))* &
254 & exp(-0.5_r8*y*y)
255 END DO
256 END DO
257 ELSE
258 DO j=jstrt,jendt
259 DO i=istrp,iendt
260 ubar(i,j,1)=0.0_r8
261 END DO
262 END DO
263 DO j=jstrp,jendt
264 DO i=istrt,iendt
265 vbar(i,j,1)=0.0_r8
266 END DO
267 END DO
268 END IF
269#elif defined RIVERPLUME2
270 DO j=jstrt,jendt
271 DO i=istrp,iendt
272 ubar(i,j,1)=0.0_r8
273 END DO
274 END DO
275 DO j=jstrp,jendt
276 DO i=istrt,iendt
277 vbar(i,j,1)=-0.05_r8
278 END DO
279 END DO
280#elif defined SED_TEST1
281 val1=100.0_r8
282 DO j=jstrt,jendt
283 DO i=istrp,iendt
284 ubar(i,j,1)=-10.0_r8/(10.0_r8+9.0e-06_r8*real(i,r8)*val1)
285 END DO
286 END DO
287 DO j=jstrp,jendt
288 DO i=istrt,iendt
289 vbar(i,j,1)=0.0_r8
290 END DO
291 END DO
292#elif defined SED_TOY
293 DO j=jstrt,jendt
294 DO i=istrp,iendt
295 ubar(i,j,1)=0.0_r8
296 END DO
297 END DO
298 DO j=jstrp,jendt
299 DO i=istrt,iendt
300 vbar(i,j,1)=0.0_r8
301 END DO
302 END DO
303#elif defined TEST_CHAN
304 val1=100.0_r8
305 DO j=jstrt,jendt
306 DO i=istrp,iendt
307 ubar(i,j,1)=0.0_r8
308 END DO
309 END DO
310 DO j=jstrp,jendt
311 DO i=istrt,iendt
312 vbar(i,j,1)=0.0_r8
313 END DO
314 END DO
315#else
316 DO j=jstrt,jendt
317 DO i=istrp,iendt
318 ubar(i,j,1)=0.0_r8
319 END DO
320 END DO
321 DO j=jstrp,jendt
322 DO i=istrt,iendt
323 vbar(i,j,1)=0.0_r8
324 END DO
325 END DO
326#endif
327!
328! Report statistics.
329!
330 CALL stats_2dfld (ng, tile, inlm, u2dvar, stats(1), 0, &
331 & lbi, ubi, lbj, ubj, ubar(:,:,1))
332 IF (domain(ng)%NorthEast_Corner(tile)) THEN
333 WRITE (stdout,10) trim(vname(2,idubar))//': '// &
334 & trim(vname(1,idubar)), &
335 & ng, stats(1)%min, stats(1)%max
336 END IF
337 CALL stats_2dfld (ng, tile, inlm, v2dvar, stats(2), 0, &
338 & lbi, ubi, lbj, ubj, vbar(:,:,1))
339 IF (domain(ng)%NorthEast_Corner(tile)) THEN
340 WRITE (stdout,10) trim(vname(2,idvbar))//': '// &
341 & trim(vname(1,idvbar)), &
342 & ng, stats(2)%min, stats(2)%max
343 END IF
344!
345!-----------------------------------------------------------------------
346! Initial conditions for free-surface (m).
347!-----------------------------------------------------------------------
348!
349#if defined CHANNEL && !defined ONLY_TS_IC
350 y0=0.5_r8*el(ng)
351# ifdef SOLVE3D
352 DO j=jstrt,jendt
353 DO i=istrt,iendt
354 val1=(yr(i,j)-y0)/guscale
355 val2=-u0*guscale*grid(ng)%f(i,j)*sqrt(pi)/(12.0_r8*g)
356 zeta(i,j,1)=val2*erf(val1)
357 END DO
358 END DO
359# else
360 DO j=jstrt,jendt
361 DO i=istrt,iendt
362 val1=(yr(i,j)-y0)/guscale
363 val2=-0.5_r8*u0*guscale*grid(ng)%f(i,j)*sqrt(pi)/g
364 zeta(i,j,1)=val2*erf(val1)
365 END DO
366 END DO
367# endif
368# ifdef DISTRIBUTE
369 CALL mp_bcasti (ng, model, exit_flag) ! in case of error in ERF
370# endif
371#elif defined KELVIN
372!! val1=1.0_r8 ! zeta0
373!! val2=2.0_r8*pi/(12.42_r8*3600.0_r8) ! M2 Tide period
374 DO j=jstrt,jendt
375 DO i=istrt,iendt
376!! zeta(i,j,1)=val1* &
377!! & EXP(-GRID(ng)%f(i,j)*GRID(ng)%yp(i,j)/ &
378!! & SQRT(g*GRID(ng)%h(i,j)))* &
379!! & COS(val2*GRID(ng)%xp(i,j)/ &
380!! & SQRT(g*GRID(ng)%h(i,j)))
381 zeta(i,j,1)=0.0_r8
382 END DO
383 END DO
384#elif defined SOLITON
385 IF (ng.eq.1) THEN
386 x0=2.0_r8*xl(ng)/3.0_r8
387 y0=0.5_r8*el(ng)
388 val1=0.395_r8
389 val2=0.771_r8*(val1*val1)
390 DO j=jstrt,jendt
391 DO i=istrt,iendt
392 x=xr(i,j)-x0
393 y=yr(i,j)-y0
394 val3=exp(-val1*x)
395 val4=val2*((2.0_r8*val3/(1.0_r8+(val3*val3)))**2)
396 zeta(i,j,1)=0.25_r8*val4*(6.0_r8*y*y+3.0_r8)* &
397 & exp(-0.5_r8*y*y)
398 END DO
399 END DO
400 ELSE
401 DO j=jstrt,jendt
402 DO i=istrt,iendt
403 zeta(i,j,1)=0.0_r8
404 END DO
405 END DO
406 END IF
407#elif defined SED_TEST1
408 val1=100.0_r8
409 DO j=jstrt,jendt
410 DO i=istrt,iendt
411 zeta(i,j,1)=9.0e-06_r8*real(i,r8)*val1
412 END DO
413 END DO
414#elif defined TEST_CHAN
415 DO j=jstrt,jendt
416 DO i=istrt,iendt
417 zeta(i,j,1)=-0.4040_r8*real(i,r8)/real(lm(ng)+1,r8)
418 END DO
419 END DO
420#else
421 DO j=jstrt,jendt
422 DO i=istrt,iendt
423 zeta(i,j,1)=0.0_r8
424 END DO
425 END DO
426#endif
427!
428! Report statistics.
429!
430 CALL stats_2dfld (ng, tile, inlm, r2dvar, stats(3), 0, &
431 & lbi, ubi, lbj, ubj, zeta(:,:,1))
432 IF (domain(ng)%NorthEast_Corner(tile)) THEN
433 WRITE (stdout,10) trim(vname(2,idfsur))//': '// &
434 & trim(vname(1,idfsur)), &
435 & ng, stats(3)%min, stats(3)%max
436 END IF
437
438#ifdef SOLVE3D
439!
440!-----------------------------------------------------------------------
441! Initial conditions for 3D momentum components (m/s).
442!-----------------------------------------------------------------------
443!
444# if defined CHANNEL && !defined ONLY_TS_IC
445 y0=0.5_r8*el(ng)
446 DO k=1,n(ng)
447 DO j=jstrt,jendt
448 DO i=istrp,iendt
449 val1=(grid(ng)%yu(i,j)-y0)/guscale
450 val2=(z_r(i,j,k)+z_r(i-1,j,k))/(h(i,j)+h(i-1,j))
451 val3=u0*(0.5_r8+val2+(0.5_r8*val2*val2))*exp(-val1*val1)
452 u(i,j,k,1)=val3
453 END DO
454 END DO
455 END DO
456 DO k=1,n(ng)
457 DO j=jstrp,jendt
458 DO i=istrt,iendt
459 v(i,j,k,1)=0.0_r8
460 END DO
461 END DO
462 END DO
463# elif defined RIVERPLUME2
464 DO k=1,n(ng)
465 DO j=jstrt,jendt
466 DO i=istrp,iendt
467 u(i,j,k,1)=0.0_r8
468 END DO
469 END DO
470 DO j=jstrp,jendt
471 DO i=istrt,iendt
472 v(i,j,k,1)=-0.05_r8*log((h(i,j)+z_r(i,j,k))/zob(ng))/ &
473 & (log(h(i,j)/zob(ng))-1.0_r8+zob(ng)/h(i,j))
474 END DO
475 END DO
476 END DO
477# elif defined SED_TEST1
478 DO k=1,n(ng)
479 DO j=jstrt,jendt
480 DO i=istrp,iendt
481 u(i,j,k,1)=-1.0_r8*log((h(i,j)+z_r(i,j,k))/zob(ng))/ &
482 & (log(h(i,j)/zob(ng))-1.0_r8+zob(ng)/h(i,j))
483 END DO
484 END DO
485 DO j=jstrp,jendt
486 DO i=istrt,iendt
487 v(i,j,k,1)=0.0_r8
488 END DO
489 END DO
490 END DO
491# elif defined SED_TOY
492 DO k=1,n(ng)
493 DO j=jstrt,jendt
494 DO i=istrp,iendt
495 u(i,j,k,1)=1.0_r8
496!! u(i,j,k,1)=-1.0_r8
497!! u(i,j,k,1)=0.0_r8
498 END DO
499 END DO
500 DO j=jstrp,jendt
501 DO i=istrt,iendt
502 v(i,j,k,1)=0.0_r8
503 END DO
504 END DO
505 END DO
506# else
507 DO k=1,n(ng)
508 DO j=jstrt,jendt
509 DO i=istrp,iendt
510 u(i,j,k,1)=0.0_r8
511 END DO
512 END DO
513 DO j=jstrp,jendt
514 DO i=istrt,iendt
515 v(i,j,k,1)=0.0_r8
516 END DO
517 END DO
518 END DO
519# endif
520!
521! Report statistics.
522!
523 CALL stats_3dfld (ng, tile, inlm, u3dvar, stats(4), 0, &
524 & lbi, ubi, lbj, ubj, 1, n(ng), u(:,:,:,1))
525 IF (domain(ng)%NorthEast_Corner(tile)) THEN
526 WRITE (stdout,10) trim(vname(2,iduvel))//': '// &
527 & trim(vname(1,iduvel)), &
528 & ng, stats(4)%min, stats(4)%max
529 END IF
530 CALL stats_3dfld (ng, tile, inlm, v3dvar, stats(5), 0, &
531 & lbi, ubi, lbj, ubj, 1, n(ng), v(:,:,:,1))
532 IF (domain(ng)%NorthEast_Corner(tile)) THEN
533 WRITE (stdout,10) trim(vname(2,idvvel))//': '// &
534 & trim(vname(1,idvvel)), &
535 & ng, stats(5)%min, stats(5)%max
536 END IF
537!
538!-----------------------------------------------------------------------
539! Initial conditions for tracer type variables.
540!-----------------------------------------------------------------------
541!
542! Set initial conditions for potential temperature (Celsius) and
543! salinity (PSU).
544!
545# if defined BENCHMARK
546 val1=(44.69_r8/39.382_r8)**2
547 val2=val1*(rho0*800.0_r8/g)*(5.0e-05_r8/((42.689_r8/44.69_r8)**2))
548 DO k=1,n(ng)
549 DO j=jstrt,jendt
550 DO i=istrt,iendt
551 t(i,j,k,1,itemp)=val2*exp(z_r(i,j,k)/800.0_r8)* &
552 & (0.6_r8-0.4_r8*tanh(z_r(i,j,k)/800.0_r8))
553# ifdef SALINITY
554 t(i,j,k,1,isalt)=35.0_r8
555# endif
556 END DO
557 END DO
558 END DO
559# elif defined BASIN
560 val1=(44.69_r8/39.382_r8)**2
561 val2=val1*(rho0*800.0_r8/g)*(5.0e-05_r8/((42.689_r8/44.69_r8)**2))
562 DO k=1,n(ng)
563 DO j=jstrt,jendt
564 DO i=istrt,iendt
565 t(i,j,k,1,itemp)=val2*exp(z_r(i,j,k)/800.0_r8)* &
566 & (0.6_r8-0.4_r8*tanh(z_r(i,j,k)/800.0_r8))
567 END DO
568 END DO
569 END DO
570# elif defined BL_TEST
571 DO k=1,n(ng)
572 DO j=jstrt,jendt
573 DO i=istrt,iendt
574 val1=tanh(1.1_r8*z_r(i,j,k)+11.0_r8)
575 t(i,j,k,1,itemp)=t0(ng)+6.25_r8*val1
576# ifdef SALINITY
577 t(i,j,k,1,isalt)=s0(ng)-0.75_r8*val1
578# endif
579 END DO
580 END DO
581 END DO
582# elif defined CHANNEL
583 y0=0.5_r8*el(ng)
584 DO k=1,n(ng)
585 DO j=jstrt,jendt
586 DO i=istrt,iendt
587 val1=(yr(i,j)-y0)/guscale
588 val2=-0.5_r8*u0*guscale*grid(ng)%f(i,j)*sqrt(pi)/ &
589 & (tcoef(ng)*g*h(i,j))
590 val3=(val2*erf(val1)+t0(ng))*(1.0_r8+z_r(i,j,k)/h(i,j))
591 t(i,j,k,1,itemp)=val3
592 END DO
593 END DO
594 END DO
595# ifdef DISTRIBUTE
596 CALL mp_bcasti (ng, model, exit_flag) ! in case of error in ERF
597# endif
598# elif defined CANYON
599 DO k=1,n(ng)
600 DO j=jstrt,jendt
601 DO i=istrt,iendt
602 t(i,j,k,1,itemp)=3.488_r8*exp(z_r(i,j,k)/800.0_r8)* &
603 & (1.0_r8-(2.0_r8/3.0_r8)* &
604 & tanh(z_r(i,j,k)/800.0_r8))
605 END DO
606 END DO
607 END DO
608# elif defined CHANNEL_NECK
609 DO k=1,n(ng)
610 DO j=jstrt,jendt
611 DO i=istrt,iendt
612 t(i,j,k,1,itemp)=20.0_r8
613!! t(i,j,k,1,itemp)=14.0_r8+8.0_r8*EXP(z_r(i,j,k)/50.0_r8)
614 END DO
615 END DO
616 END DO
617# elif defined COUPLING_TEST
618 val1=40.0_r8
619 DO k=1,n(ng)
620 DO j=jstrt,jendt
621 DO i=istrt,iendt
622 t(i,j,k,1,itemp)=val1*exp(z_r(i,j,k)/800.0_r8)* &
623 & (0.6_r8-0.4_r8*tanh(z_r(i,j,k)/800.0_r8))+ &
624 & 1.5_r8
625# ifdef SALINITY
626 t(i,j,k,1,isalt)=35.0_r8
627# endif
628 END DO
629 END DO
630 END DO
631# elif defined DOUBLE_GYRE
632 val1=(44.69_r8/39.382_r8)**2
633 val2=val1*(rho0*100.0_r8/g)*(5.0e-5_r8/((42.689_r8/44.69_r8)**2))
634 DO k=1,n(ng)
635 DO j=jstrt,jendt
636 DO i=istrt,iendt
637 val3=t0(ng)+val2*exp(z_r(i,j,k)/100.0_r8)* &
638 & (10.0_r8-0.4_r8*tanh(z_r(i,j,k)/100.0_r8))
639 val4=yr(i,j)/el(ng)
640 t(i,j,k,1,itemp)=val3-3.0_r8*val4
641# ifdef SALINITY
642 t(i,j,k,1,isalt)=34.5_r8-0.001_r8*z_r(i,j,k)-val4
643# endif
644 END DO
645 END DO
646 END DO
647# elif defined ESTUARY_TEST
648 DO k=1,n(ng)
649 DO j=jstrt,jendt
650 DO i=istrt,iendt
651 t(i,j,k,1,itemp)=10.0_r8
652# ifdef SALINITY
653 IF (xr(i,j).le.30000.0_r8) then
654 t(i,j,k,1,isalt)=30.0_r8
655 ELSEIF (xr(i,j).le.80000.0_r8) then
656 t(i,j,k,1,isalt)=(80000.0_r8-xr(i,j))/50000.0_r8*30.0_r8
657 ELSE
658 t(i,j,k,1,isalt)=0.0_r8
659 END IF
660# endif
661 END DO
662 END DO
663 END DO
664# elif defined FLT_TEST
665 DO k=1,n(ng)
666 DO j=jstrt,jendt
667 DO i=istrt,iendt
668 t(i,j,k,1,itemp)=t0(ng)
669 END DO
670 END DO
671 END DO
672# elif defined GRAV_ADJ
673 DO k=1,n(ng)
674 DO j=jstrt,jendt
675 DO i=istrt,min((lm(ng)+1)/2,iendt)
676 t(i,j,k,1,itemp)=t0(ng)+5.0_r8
677# ifdef SALINITY
678 t(i,j,k,1,isalt)=0.0_r8
679# endif
680 END DO
681 DO i=max((lm(ng)+1)/2+1,istrt),iendt
682 t(i,j,k,1,itemp)=t0(ng)
683# ifdef SALINITY
684 t(i,j,k,1,isalt)=s0(ng)
685# endif
686 END DO
687!! DO i=IstrT,IendT
688!! IF (i.lt.Lm(ng)/2) THEN
689!! t(i,j,k,1,itemp)=T0(ng)+5.0_r8
690!! ELSE IF (i.eq.Lm(ng)/2) THEN
691!! t(i,j,k,1,itemp)=T0(ng)+4.0_r8
692!! ELSE IF (i.eq.Lm(ng)/2+1) THEN
693!! t(i,j,k,1,itemp)=T0(ng)+1.0_r8
694!! ELSE
695!! t(i,j,k,1,itemp)=T0(ng)
696!! END IF
697!! END DO
698 END DO
699 END DO
700# elif defined LAB_CANYON
701 DO k=1,n(ng)
702 DO j=jstrt,jendt
703 DO i=istrt,iendt
704 t(i,j,k,1,itemp)=-659.34183_r8*z_r(i,j,k)
705 END DO
706 END DO
707 END DO
708# elif defined LAKE_SIGNELL
709 DO k=1,n(ng)
710 DO j=jstrt,jendt
711 DO i=istrt,iendt
712 t(i,j,k,1,itemp)=10.0_r8
713# ifdef SALINITY
714 t(i,j,k,1,isalt)=30.0_r8
715# endif
716 END DO
717 END DO
718 END DO
719# elif defined LMD_TEST
720 DO k=1,n(ng)
721 DO j=jstrt,jendt
722 DO i=istrt,iendt
723 t(i,j,k,1,itemp)=min(13.0_r8, &
724 & 7.0_r8+0.2_r8*(z_r(i,j,k)+50.0_r8))
725# ifdef SALINITY
726 t(i,j,k,1,isalt)=35.0_r8
727# endif
728 END DO
729 END DO
730 END DO
731# elif defined MIXED_LAYER
732 DO k=1,n(ng)
733 DO j=jstrt,jendt
734 DO i=istrt,iendt
735 t(i,j,k,1,itemp)=10.0_r8+3.0_r8*(z_r(i,j,k)+h(i,j))/ &
736 & h(i,j)
737# ifdef SALINITY
738 t(i,j,k,1,isalt)=s0(ng)
739# endif
740 END DO
741 END DO
742 END DO
743# elif defined NJ_BIGHT
744 DO k=1,n(ng)
745 DO j=jstrt,jendt
746 DO i=istrt,iendt
747 depth=z_r(i,j,k)
748 IF (depth.ge.-15.0_r8) THEN
749 t(i,j,k,1,itemp)= 2.049264257728403e+01_r8-depth* &
750 & (2.640850848793918e-01_r8+depth* &
751 & (2.751125328535212e-01_r8+depth* &
752 & (9.207489761648872e-02_r8+depth* &
753 & (1.449075725742839e-02_r8+depth* &
754 & (1.078215685912076e-03_r8+depth* &
755 & (3.240318053903974e-05_r8+ &
756 & 1.262826857690271e-07_r8*depth))))))
757# ifdef SALINITY
758 t(i,j,k,1,isalt)= 3.066489149193135e+01_r8-depth* &
759 & (1.476725262946735e-01_r8+depth* &
760 & (1.126455760313399e-01_r8+depth* &
761 & (3.900923281871022e-02_r8+depth* &
762 & (6.939014937447098e-03_r8+depth* &
763 & (6.604436696792939e-04_r8+depth* &
764 & (3.191792361954220e-05_r8+ &
765 & 6.177352634409320e-07_r8*depth))))))
766# endif
767 ELSE
768 t(i,j,k,1,itemp)=14.6_r8+ &
769 & 6.70_r8*tanh(1.1_r8*depth+15.9_r8)
770# ifdef SALINITY
771 t(i,j,k,1,isalt)=31.3_r8- &
772 & 0.55_r8*tanh(1.1_r8*depth+15.9_r8)
773# endif
774 END IF
775 END DO
776 END DO
777 END DO
778# elif defined OVERFLOW
779 DO k=1,n(ng)
780 DO j=jstrt,jendt
781 DO i=istrt,iendt
782 t(i,j,k,1,itemp)=t0(ng)-0.5_r8*t0(ng)*(1.0_r8+ &
783 & tanh((yr(i,j)-60000.0_r8)/2000.0_r8))
784 END DO
785 END DO
786 END DO
787# elif defined RIVERPLUME1
788 DO k=1,n(ng)
789 DO j=jstrt,jendt
790 DO i=istrt,iendt
791 t(i,j,k,1,itemp)=t0(ng)+0.01_r8*real(k,r8)
792# ifdef SALINITY
793 t(i,j,k,1,isalt)=s0(ng)
794# endif
795 END DO
796 END DO
797 END DO
798# elif defined RIVERPLUME2
799 DO k=1,n(ng)
800 DO j=jstrt,jendt
801 DO i=istrt,iendt
802 t(i,j,k,1,itemp)=t0(ng)
803# ifdef SALINITY
804 t(i,j,k,1,isalt)=s0(ng)
805# endif
806 END DO
807 END DO
808 END DO
809# elif defined SEAMOUNT
810 DO k=1,n(ng)
811 DO j=jstrt,jendt
812 DO i=istrt,iendt
813 t(i,j,k,1,itemp)=t0(ng)+7.5_r8*exp(z_r(i,j,k)/1000.0_r8)
814 END DO
815 END DO
816 END DO
817# elif defined SED_TEST1
818 DO k=1,n(ng)
819 DO j=jstrt,jendt
820 DO i=istrt,iendt
821 t(i,j,k,1,itemp)=20.0_r8
822# ifdef SALINITY
823 t(i,j,k,1,isalt)=0.0_r8
824# endif
825 END DO
826 END DO
827 END DO
828# elif defined UPWELLING
829 DO k=1,n(ng)
830 DO j=jstrt,jendt
831 DO i=istrt,iendt
832 t(i,j,k,1,itemp)=t0(ng)+8.0_r8*exp(z_r(i,j,k)/50.0_r8)
833!! t(i,j,k,1,itemp)=T0(ng)+(z_r(i,j,k)+75.0_r8)/150.0_r8+
834!! & 4.0_r8*(1.0_r8+TANH((z_r(i,j,k)+35.0_r8)/
835!! & 6.5_r8))
836# ifdef SALINITY
837!! t(i,j,k,1,isalt)=1.0E-04_r8*yr(i,j)-S0(ng)
838 t(i,j,k,1,isalt)=s0(ng)
839!! IF (j.lt.Mm(ng)/2) THEN
840!! t(i,j,k,1,isalt)=0.0_r8
841!! ELSE IF (j.eq.Mm(ng)/2) THEN
842!! t(i,j,k,1,isalt)=0.5_r8
843!! ELSE IF (j.gt.Mm(ng)/2) THEN
844!! t(i,j,k,1,isalt)=1.0_r8
845!! END IF
846# endif
847 END DO
848 END DO
849 END DO
850# elif defined WINDBASIN
851 DO k=1,n(ng)
852 DO j=jstrt,jendt
853 DO i=istrt,iendt
854 t(i,j,k,1,itemp)=20.0_r8 ! homogeneous
855!! t(i,j,k,1,itemp)=14.0_r8+8.0_r8*EXP(z_r(i,j,k)/50.0_r8)- &
856!! & T0(ng) ! stratified
857 END DO
858 END DO
859 END DO
860# else
861 DO k=1,n(ng)
862 DO j=jstrt,jendt
863 DO i=istrt,iendt
864 t(i,j,k,1,itemp)=t0(ng)
865# ifdef SALINITY
866 t(i,j,k,1,isalt)=s0(ng)
867# endif
868 END DO
869 END DO
870 END DO
871# endif
872!
873! Report statistics.
874!
875 DO itrc=1,nat
876 CALL stats_3dfld (ng, tile, inlm, r3dvar, stats(itrc+5), 0, &
877 & lbi, ubi, lbj, ubj, 1, n(ng), t(:,:,:,1,itrc))
878 IF (domain(ng)%NorthEast_Corner(tile)) THEN
879 WRITE (stdout,10) trim(vname(2,idtvar(itrc)))//': '// &
880 & trim(vname(1,idtvar(itrc))), &
881 & ng, stats(itrc+5)%min, stats(itrc+5)%max
882 END IF
883 END DO
884#endif
885!
886 10 FORMAT (3x,' ANA_INITIAL - ',a,/,19x, &
887 & '(Grid = ',i2.2,', Min = ',1p,e15.8,0p, &
888 & ' Max = ',1p,e15.8,0p,')')
889!
890 RETURN
distribute_mod::mp_bcasti
Definition distribute.F:95
distribute_mod
Definition distribute.F:3
erf_mod
Definition erf.F:2
erf_mod::erf
real(r8) function, public erf(x)
Definition erf.F:43
mod_ncparam::idubar
integer idubar
Definition mod_ncparam.F:325
mod_ncparam::idvvel
integer idvvel
Definition mod_ncparam.F:381
mod_ncparam::idfsur
integer idfsur
Definition mod_ncparam.F:206
mod_ncparam::iduvel
integer iduvel
Definition mod_ncparam.F:343
mod_ncparam::idvbar
integer idvbar
Definition mod_ncparam.F:360
mod_param::u3dvar
integer, parameter u3dvar
Definition mod_param.F:722
mod_param::v3dvar
integer, parameter v3dvar
Definition mod_param.F:723
mod_scalars::t0
real(r8), dimension(:), allocatable t0
Definition mod_scalars.F:738
mod_scalars::el
real(r8), dimension(:), allocatable el
Definition mod_scalars.F:636
mod_scalars::s0
real(r8), dimension(:), allocatable s0
Definition mod_scalars.F:739
mod_scalars::tcoef
real(r8), dimension(:), allocatable tcoef
Definition mod_scalars.F:732
mod_scalars::zob
real(r8), dimension(:), allocatable zob
Definition mod_scalars.F:778
mod_scalars::xl
real(r8), dimension(:), allocatable xl
Definition mod_scalars.F:635
mod_scalars::rho0
real(dp) rho0
Definition mod_scalars.F:787

References mod_param::domain, mod_scalars::el, erf_mod::erf(), mod_scalars::exit_flag, mod_scalars::g, mod_grid::grid, mod_ncparam::idfsur, mod_ncparam::idtvar, mod_ncparam::idubar, mod_ncparam::iduvel, mod_ncparam::idvbar, mod_ncparam::idvvel, mod_param::inlm, mod_scalars::isalt, mod_scalars::itemp, mod_scalars::large, mod_param::lm, mod_param::nat, mod_scalars::pi, mod_param::r2dvar, mod_param::r3dvar, mod_scalars::rho0, mod_scalars::s0, stats_mod::stats_2dfld(), stats_mod::stats_3dfld(), mod_iounits::stdout, mod_scalars::t0, mod_scalars::tcoef, mod_param::u2dvar, mod_param::u3dvar, mod_param::v2dvar, mod_param::v3dvar, mod_ncparam::vname, mod_scalars::xl, and mod_scalars::zob.

Referenced by ana_initial().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_nudgcoef()

subroutine analytical_mod::ana_nudgcoef ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 2 of file ana_nudgcoef.h.

3!
4!! git $Id$
5!!================================================= Hernan G. Arango ===
6!! Copyright (c) 2002-2025 The ROMS Group !
7!! Licensed under a MIT/X style license !
8!! See License_ROMS.md !
9!=======================================================================
10! !
11! This routine sets spatially varying nudging coefficients time- !
12! scales (1/s). They are used for nuding to climatology in the !
13! governing equations. !
14! !
15! It is HIGHLY recommended to write these nudging coefficients into !
16! input NetCDF NUDNAME instead of using analytical expressions !
17! below. It is very easy to introduce parallel bugs. Also, Users !
18! can plot their spatial distribution and fine tune their values !
19! during the pre-proccessing stage for a particular application. !
20! !
21! REMARK: Nudging of free-surface in the vertically integrated !
22! ====== continuity equation is NOT allowed because it VIOLATES !
23! mass/volume conservation. If such nudging effects are required, !
24! it needs to be specified on the momentum equations for (u,v) !
25! and/or (ubar,vbar). If done on (u,v) only, its effects enter !
26! the 2D momentum equations via the residual vertically integrated !
27! forcing term. !
28! !
29!=======================================================================
30!
31 USE mod_param
32 USE mod_ncparam
33!
34! Imported variable declarations.
35!
36 integer, intent(in) :: ng, tile, model
37!
38! Local variable declarations.
39!
40 character (len=*), parameter :: MyFile = &
41 & __FILE__
42!
43#include "tile.h"
44!
45 CALL ana_nudgcoef_tile (ng, tile, model, &
46 & lbi, ubi, lbj, ubj, &
47 & imins, imaxs, jmins, jmaxs)
48!
49! Set analytical header file name used.
50!
51#ifdef DISTRIBUTE
52 IF (lanafile) THEN
53#else
54 IF (lanafile.and.(tile.eq.0)) THEN
55#endif
56 ananame(16)=myfile
57 END IF
58!
59 RETURN

References ana_nudgcoef_tile(), mod_ncparam::ananame, and mod_ncparam::lanafile.

Referenced by set_grid().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_nudgcoef_tile()

subroutine analytical_mod::ana_nudgcoef_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs )

Definition at line 63 of file ana_nudgcoef.h.

66!***********************************************************************
67!
68 USE mod_param
69 USE mod_parallel
70 USE mod_clima
71 USE mod_grid
72 USE mod_ncparam
73 USE mod_scalars
74#ifdef DISTRIBUTE
75!
76 USE distribute_mod, ONLY : mp_collect
77 USE mp_exchange_mod, ONLY : mp_exchange2d
78# ifdef SOLVE3D
79 USE mp_exchange_mod, ONLY : mp_exchange3d
80 USE mp_exchange_mod, ONLY : mp_exchange4d
81# endif
82#endif
83!
84 implicit none
85!
86! Imported variable declarations.
87!
88 integer, intent(in) :: ng, tile, model
89 integer, intent(in) :: LBi, UBi, LBj, UBj
90 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
91!
92! Local variable declarations.
93!
94 integer :: Iwrk, i, itrc, j, k
95!
96 real(r8) :: cff1, cff2, cff3
97!
98 real(r8), parameter :: IniVal = 0.0_r8
99!
100 real(r8), dimension(IminS:ImaxS,JminS:JmaxS) :: wrk
101
102#include "set_bounds.h"
103!
104!-----------------------------------------------------------------------
105! Set up nudging towards data time-scale coefficients (1/s).
106!-----------------------------------------------------------------------
107!
108! Initialize.
109!
110 DO j=jstrt,jendt
111 DO i=istrt,iendt
112 wrk(i,j)=0.0_r8
113 END DO
114 END DO
115
116#if defined ADRIA02
117!
118! Set tracer nudging coefficients in the southern edges from a three
119! days time scale at the boundary point to decrease linearly to 30 days
120! six grids points away from the boundary.
121!
122 cff1=1.0_r8/(3.0_r8*86400.0_r8)
123 cff2=1.0_r8/(30.0_r8*86400.0_r8)
124 DO j=jstrt,min(6,jendt)
125 DO i=istrt,iendt
126 wrk(i,j)=cff2+real(6-j,r8)*(cff1-cff2)/6.0_r8
127 END DO
128 END DO
129
130 IF (any(lnudgetclm(:,ng))) THEN
131 DO itrc=1,ntclm(ng)
132 DO k=1,n(ng)
133 DO j=jstrt,jendt
134 DO i=istrt,iendt
135 clima(ng)%Tnudgcof(i,j,k,itrc)=wrk(i,j)
136 END DO
137 END DO
138 END DO
139 END DO
140 END IF
141
142#elif defined DAMEE_4
143!
144! Set tracer nudging coefficients in the southern and northern edges
145! from a five days time scale at the boundary point to decrease
146! linearly to 60 days seven grids points away from the boundary.
147!
148 cff1=1.0_r8/(5.0_r8*86400.0_r8)
149 cff2=1.0_r8/(60.0_r8*86400.0_r8)
150 cff3=(7.0_r8*cff1-cff2)/6.0_r8
151 DO j=jstrt,min(8,jendt)
152 DO i=istrt,iendt
153 wrk(i,j)=cff2+real(8-j,r8)*(cff1-cff2)/7.0_r8
154 END DO
155 END DO
156
157 DO j=max(jstrt,mm(ng)-7),jendt
158 DO i=istrt,iendt
159 wrk(i,j)=cff1+real(mm(ng)-j,r8)*(cff2-cff1)/7.0_r8
160 END DO
161 END DO
162
163 DO j=max(jstrt,74),min(80,jendt)
164 DO i=max(istrt,102),min(108,iendt)
165 cff1=sqrt(real((i-109)*(i-109)+(j-77)*(j-77),r8))
166 wrk(i,j)=max(0.0_r8,(cff3+cff1*(cff2-cff3)/6.0_r8))
167 END DO
168 END DO
169
170 IF (any(lnudgetclm(:,ng))) THEN
171 DO itrc=1,ntclm(ng)
172 DO k=1,n(ng)
173 DO j=jstrt,jendt
174 DO i=istrt,iendt
175 clima(ng)%Tnudgcof(i,j,k,itrc)=wrk(i,j)
176 END DO
177 END DO
178 END DO
179 END DO
180 END IF
181
182#else
183!
184! Default nudging coefficients. Set nudging coefficients uniformly to
185! the values specified in the standard input file.
186!
187 IF (lnudgem2clm(ng)) THEN
188 DO j=jstrt,jendt
189 DO i=istrt,iendt
190 clima(ng)%M2nudgcof(i,j)=m2nudg(ng)
191 END DO
192 END DO
193 END IF
194
195# ifdef SOLVE3D
196!
197 IF (lnudgem3clm(ng)) THEN
198 DO k=1,n(ng)
199 DO j=jstrt,jendt
200 DO i=istrt,iendt
201 clima(ng)%M3nudgcof(i,j,k)=m3nudg(ng)
202 END DO
203 END DO
204 END DO
205 END IF
206!
207 IF (any(lnudgetclm(:,ng))) THEN
208 DO itrc=1,ntclm(ng)
209 DO k=1,n(ng)
210 DO j=jstrt,jendt
211 DO i=istrt,iendt
212 clima(ng)%Tnudgcof(i,j,k,itrc)=tnudg(itrc,ng)
213 END DO
214 END DO
215 END DO
216 END DO
217 END IF
218# endif
219#endif
220#ifdef DISTRIBUTE
221!
222!-----------------------------------------------------------------------
223! Exchage nudging coefficients information.
224!-----------------------------------------------------------------------
225!
226 IF (lnudgem2clm(ng)) THEN
227 CALL mp_exchange2d (ng, tile, model, 1, &
228 & lbi, ubi, lbj, ubj, &
229 & nghostpoints, .false., .false., &
230 & clima(ng)%M2nudgcof)
231 END IF
232
233# ifdef SOLVE3D
234!
235 IF (lnudgem3clm(ng)) THEN
236 CALL mp_exchange3d (ng, tile, model, 1, &
237 & lbi, ubi, lbj, ubj, 1, n(ng), &
238 & nghostpoints, .false., .false., &
239 & clima(ng)%M3nudgcof)
240 END IF
241!
242 IF (any(lnudgetclm(:,ng))) THEN
243 CALL mp_exchange4d (ng, tile, model, 1, &
244 & lbi, ubi, lbj, ubj, 1, n(ng), 1, ntclm(ng), &
245 & nghostpoints, .false., .false., &
246 & clima(ng)%Tnudgcof)
247 END IF
248# endif
249#endif
250!
251 RETURN
distribute_mod::mp_collect
Definition distribute.F:108
mod_param::ntclm
integer, dimension(:), allocatable ntclm
Definition mod_param.F:494
mod_scalars::lnudgem2clm
logical, dimension(:), allocatable lnudgem2clm
Definition mod_scalars.F:533
mod_scalars::m2nudg
real(dp), dimension(:), allocatable m2nudg
Definition mod_scalars.F:1453
mod_scalars::tnudg
real(dp), dimension(:,:), allocatable tnudg
Definition mod_scalars.F:1455
mod_scalars::lnudgem3clm
logical, dimension(:), allocatable lnudgem3clm
Definition mod_scalars.F:534
mod_scalars::m3nudg
real(dp), dimension(:), allocatable m3nudg
Definition mod_scalars.F:1454
mod_scalars::lnudgetclm
logical, dimension(:,:), allocatable lnudgetclm
Definition mod_scalars.F:535
mp_exchange_mod::mp_exchange4d
subroutine mp_exchange4d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, lbk, ubk, lbt, ubt, nghost, ew_periodic, ns_periodic, a, b, c)
Definition mp_exchange.F:3377

References mod_clima::clima, mod_scalars::lnudgem2clm, mod_scalars::lnudgem3clm, mod_scalars::lnudgetclm, mod_scalars::m2nudg, mod_scalars::m3nudg, mod_param::mm, mp_exchange_mod::mp_exchange2d(), mp_exchange_mod::mp_exchange3d(), mp_exchange_mod::mp_exchange4d(), mod_param::n, mod_param::nghostpoints, mod_param::ntclm, and mod_scalars::tnudg.

Referenced by ana_nudgcoef().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_pair()

subroutine analytical_mod::ana_pair ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 2 of file ana_pair.h.

3!
4!! git $Id$
5!!======================================================================
6!! Copyright (c) 2002-2025 The ROMS Group !
7!! Licensed under a MIT/X style license !
8!! See License_ROMS.md !
9!=======================================================================
10! !
11! This routine sets surface air pressure (mb) using an analytical !
12! expression. !
13! !
14!=======================================================================
15!
16 USE mod_param
17 USE mod_forces
18 USE mod_ncparam
19!
20! Imported variable declarations.
21!
22 integer, intent(in) :: ng, tile, model
23!
24! Local variable declarations.
25!
26 character (len=*), parameter :: MyFile = &
27 & __FILE__
28!
29#include "tile.h"
30!
31 CALL ana_pair_tile (ng, tile, model, &
32 & lbi, ubi, lbj, ubj, &
33 & imins, imaxs, jmins, jmaxs, &
34 & forces(ng) % Pair)
35!
36! Set analytical header file name used.
37!
38#ifdef DISTRIBUTE
39 IF (lanafile) THEN
40#else
41 IF (lanafile.and.(tile.eq.0)) THEN
42#endif
43 ananame(17)=myfile
44 END IF
45!
46 RETURN

References ana_pair_tile(), mod_ncparam::ananame, mod_forces::forces, and mod_ncparam::lanafile.

Referenced by ad_set_data_tile(), ana_pair_tile(), rp_set_data_tile(), set_data_tile(), and tl_set_data_tile().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_pair_tile()

subroutine analytical_mod::ana_pair_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) pair )

Definition at line 50 of file ana_pair.h.

54!***********************************************************************
55!
56 USE mod_param
57 USE mod_scalars
58!
59 USE exchange_2d_mod, ONLY : exchange_r2d_tile
60#ifdef DISTRIBUTE
61 USE mp_exchange_mod, ONLY : mp_exchange2d
62#endif
63!
64! Imported variable declarations.
65!
66 integer, intent(in) :: ng, tile, model
67 integer, intent(in) :: LBi, UBi, LBj, UBj
68 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
69!
70#ifdef ASSUMED_SHAPE
71 real(r8), intent(out) :: Pair(LBi:,LBj:)
72#else
73 real(r8), intent(out) :: Pair(LBi:UBi,LBj:UBj)
74#endif
75!
76! Local variable declarations.
77!
78 integer :: i, j
79
80#include "set_bounds.h"
81!
82!-----------------------------------------------------------------------
83! Set analytical surface air pressure (mb).
84! (1 mb = 100 Pa = 1 hPa, 1 bar = 1.0e+5 N/m2 = 1.0e+5 dynes/cm2).
85!-----------------------------------------------------------------------
86!
87#if defined BENCHMARK
88 DO j=jstrt,jendt
89 DO i=istrt,iendt
90 pair(i,j)=1025.0_r8
91 END DO
92 END DO
93#elif defined BL_TEST
94 DO j=jstrt,jendt
95 DO i=istrt,iendt
96 pair(i,j)=1013.48_r8
97 END DO
98 END DO
99#else
100 ana_pair.h: no values provided for pair.
101#endif
102!
103! Exchange boundary data.
104!
105 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
106 CALL exchange_r2d_tile (ng, tile, &
107 & lbi, ubi, lbj, ubj, &
108 & pair)
109 END IF
110
111#ifdef DISTRIBUTE
112 CALL mp_exchange2d (ng, tile, model, 1, &
113 & lbi, ubi, lbj, ubj, &
114 & nghostpoints, &
115 & ewperiodic(ng), nsperiodic(ng), &
116 & pair)
117#endif
118!
119 RETURN

References ana_pair(), mod_scalars::ewperiodic, exchange_2d_mod::exchange_r2d_tile(), mp_exchange_mod::mp_exchange2d(), mod_param::nghostpoints, and mod_scalars::nsperiodic.

Referenced by ana_pair().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_passive()

subroutine analytical_mod::ana_passive ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 2 of file ana_passive.h.

3!
4!! git $Id$
5!!======================================================================
6!! Copyright (c) 2002-2025 The ROMS Group !
7!! Licensed under a MIT/X style license !
8!! See License_ROMS.md !
9!=======================================================================
10! !
11! This routine sets initial conditions for passive inert tracers !
12! using analytical expressions. !
13! !
14!=======================================================================
15!
16 USE mod_param
17 USE mod_ncparam
18 USE mod_ocean
19!
20! Imported variable declarations.
21!
22 integer, intent(in) :: ng, tile, model
23!
24! Local variable declarations.
25!
26 character (len=*), parameter :: MyFile = &
27 & __FILE__
28!
29#include "tile.h"
30!
31 CALL ana_passive_tile (ng, tile, model, &
32 & lbi, ubi, lbj, ubj, &
33 & imins, imaxs, jmins, jmaxs, &
34 & ocean(ng) % t)
35!
36! Set analytical header file name used.
37!
38#ifdef DISTRIBUTE
39 IF (lanafile) THEN
40#else
41 IF (lanafile.and.(tile.eq.0)) THEN
42#endif
43 ananame(18)=myfile
44 END IF
45!
46 RETURN

References ana_passive_tile(), mod_ncparam::ananame, mod_ncparam::lanafile, and mod_ocean::ocean.

Referenced by ad_initial(), ana_passive_tile(), initial(), rp_initial(), and tl_initial().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_passive_tile()

subroutine analytical_mod::ana_passive_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),3,nt(ng)), intent(out) t )

Definition at line 50 of file ana_passive.h.

54!***********************************************************************
55!
56 USE mod_param
57 USE mod_scalars
58!
59! Imported variable declarations.
60!
61 integer, intent(in) :: ng, tile, model
62 integer, intent(in) :: LBi, UBi, LBj, UBj
63 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
64!
65#ifdef ASSUMED_SHAPE
66 real(r8), intent(out) :: t(LBi:,LBj:,:,:,:)
67#else
68 real(r8), intent(out) :: t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
69#endif
70!
71! Local variable declarations.
72!
73 integer :: i, iage, ip, itrc, j, k
74
75#include "set_bounds.h"
76!
77!-----------------------------------------------------------------------
78! Set analytical initial conditions for passive inert tracers.
79!-----------------------------------------------------------------------
80!
81#if defined MY_APPLICATION
82# ifdef AGE_MEAN
83 DO ip=1,npt,2
84 itrc=inert(ip)
85 iage=inert(ip+1)
86 DO k=1,n(ng)
87 DO j=jstrt,jendt
88 DO i=istrt,iendt
89 t(i,j,k,1,itrc)=???
90 t(i,j,k,2,itrc)=t(i,j,k,1,itrc)
91 t(i,j,k,1,iage)=0.0_r8
92 t(i,j,k,2,iage)=t(i,j,k,1,iage)
93 END DO
94 END DO
95 END DO
96 END DO
97# else
98 DO ip=1,npt
99 itrc=inert(ip)
100 DO k=1,n(ng)
101 DO j=jstrt,jendt
102 DO i=istrt,iendt
103 t(i,j,k,1,itrc)=???
104 t(i,j,k,2,itrc)=t(i,j,k,1,itrc)
105 END DO
106 END DO
107 END DO
108 END DO
109# endif
110#else
111 ana_passive.h: no values provided for t(:,:,:,1,inert(itrc))
112#endif
113!
114 RETURN
mod_param::npt
integer npt
Definition mod_param.F:505
mod_scalars::inert
integer, dimension(:), pointer inert
Definition mod_scalars.F:129

References ana_passive(), mod_scalars::inert, and mod_param::npt.

Referenced by ana_passive().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_perturb()

subroutine analytical_mod::ana_perturb ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 2 of file ana_perturb.h.

3!
4!! git $Id$
5!!======================================================================
6!! Copyright (c) 2002-2025 The ROMS Group !
7!! Licensed under a MIT/X style license !
8!! See License_ROMS.md !
9!=======================================================================
10! !
11! This routine perturbs initial conditions for momentum and tracers !
12! type variables using analytical expressions. !
13! !
14! It is also used to perturb the tangent linear and adjoint models !
15! at specified state variable and spatial (i,j,k) point to verify !
16! the correctness of these algorithms. This is activated with the !
17! SANITY_CHECK CPP switch. !
18! !
19! If each interior point is perturbed at one time, the resulting !
20! tangent linear (T) and adjoint (A) M-by-N matrices yield: !
21! !
22! T - tranpose(A) = 0 within round off !
23! !
24! That is, their inner product give a symmetric matrix. Here, M is !
25! the number of state points and N is the number of perturbations. !
26! In realistic applications, it is awkward to perturb all interior !
27! points for each state variable. Alternatively, random check at a !
28! specified points is inexpensive. The standard input "User" array !
29! is used to specify such point: !
30! !
31! INT(user(1)) => state variable to perturb !
32! INT(user(2)) => I-index to perturb !
33! INT(user(3)) => J-index to perturb !
34! INT(user(4)) => K-index to perturb (3D state fields) !
35! !
36!=======================================================================
37!
38 USE mod_param
39 USE mod_ncparam
40#ifdef ADJUST_BOUNDARY
41 USE mod_boundary
42#endif
43 USE mod_ocean
44#if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
45 USE mod_forces
46#endif
47 USE mod_stepping
48!
49! Imported variable declarations.
50!
51 integer, intent(in) :: ng, tile, model
52!
53! Local variable declarations.
54!
55 character (len=*), parameter :: MyFile = &
56 & __FILE__
57!
58#include "tile.h"
59!
60 CALL ana_perturb_tile (ng, tile, model, &
61 & lbi, ubi, lbj, ubj, lbij, ubij, &
62 & imins, imaxs, jmins, jmaxs, &
63 & kstp(ng), krhs(ng), knew(ng), &
64#ifdef SOLVE3D
65 & nstp(ng), nrhs(ng), nnew(ng), &
66#endif
67#ifdef ADJUST_BOUNDARY
68# ifdef SOLVE3D
69 & boundary(ng) % ad_t_obc, &
70 & boundary(ng) % ad_u_obc, &
71 & boundary(ng) % ad_v_obc, &
72# endif
73 & boundary(ng) % ad_ubar_obc, &
74 & boundary(ng) % ad_vbar_obc, &
75 & boundary(ng) % ad_zeta_obc, &
76#endif
77#ifdef ADJUST_WSTRESS
78 & forces(ng) % ad_ustr, &
79 & forces(ng) % ad_vstr, &
80#endif
81#if defined ADJUST_STFLUX && defined SOLVE3D
82 & forces(ng) % ad_tflux, &
83#endif
84#ifdef SOLVE3D
85 & ocean(ng) % ad_t, &
86 & ocean(ng) % ad_u, &
87 & ocean(ng) % ad_v, &
88#endif
89 & ocean(ng) % ad_ubar, &
90 & ocean(ng) % ad_vbar, &
91 & ocean(ng) % ad_zeta, &
92#ifdef ADJUST_BOUNDARY
93# ifdef SOLVE3D
94 & boundary(ng) % tl_t_obc, &
95 & boundary(ng) % tl_u_obc, &
96 & boundary(ng) % tl_v_obc, &
97# endif
98 & boundary(ng) % tl_ubar_obc, &
99 & boundary(ng) % tl_vbar_obc, &
100 & boundary(ng) % tl_zeta_obc, &
101#endif
102#ifdef ADJUST_WSTRESS
103 & forces(ng) % tl_ustr, &
104 & forces(ng) % tl_vstr, &
105#endif
106#if defined ADJUST_STFLUX && defined SOLVE3D
107 & forces(ng) % tl_tflux, &
108#endif
109#ifdef SOLVE3D
110 & ocean(ng) % tl_t, &
111 & ocean(ng) % tl_u, &
112 & ocean(ng) % tl_v, &
113#endif
114 & ocean(ng) % tl_ubar, &
115 & ocean(ng) % tl_vbar, &
116 & ocean(ng) % tl_zeta)
117!
118! Set analytical header file name used.
119!
120#ifdef DISTRIBUTE
121 IF (lanafile) THEN
122#else
123 IF (lanafile.and.(tile.eq.0)) THEN
124#endif
125 ananame(19)=myfile
126 END IF
127!
128 RETURN
mod_stepping::nrhs
integer, dimension(:), allocatable nrhs
Definition mod_stepping.F:70
mod_stepping::krhs
integer, dimension(:), allocatable krhs
Definition mod_stepping.F:65

References ana_perturb_tile(), mod_ncparam::ananame, mod_boundary::boundary, mod_forces::forces, mod_stepping::knew, mod_stepping::krhs, mod_stepping::kstp, mod_ncparam::lanafile, mod_stepping::nnew, mod_stepping::nrhs, mod_stepping::nstp, and mod_ocean::ocean.

Referenced by ad_initial(), rp_initial(), and tl_initial().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_perturb_tile()

subroutine analytical_mod::ana_perturb_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) lbij,
integer, intent(in) ubij,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
integer, intent(in) kstp,
integer, intent(in) krhs,
integer, intent(in) knew,
integer, intent(in) nstp,
integer, intent(in) nrhs,
integer, intent(in) nnew,
real(r8), dimension(lbij:ubij,n(ng),4, nbrec(ng),2,nt(ng)), intent(inout) ad_t_obc,
real(r8), dimension(lbij:ubij,n(ng),4,nbrec(ng),2), intent(inout) ad_u_obc,
real(r8), dimension(lbij:ubij,n(ng),4,nbrec(ng),2), intent(inout) ad_v_obc,
real(r8), dimension(lbij:ubij,4,nbrec(ng),2), intent(inout) ad_ubar_obc,
real(r8), dimension(lbij:ubij,4,nbrec(ng),2), intent(inout) ad_vbar_obc,
real(r8), dimension(lbij:ubij,4,nbrec(ng),2), intent(inout) ad_zeta_obc,
real(r8), dimension(lbi:ubi,lbj:ubj,nfrec(ng),2), intent(inout) ad_ustr,
real(r8), dimension(lbi:ubi,lbj:ubj,nfrec(ng),2), intent(inout) ad_vstr,
real(r8), dimension(lbi:ubi,lbj:ubj, nfrec(ng),2,nt(ng)), intent(inout) ad_tflux,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),2,nt(ng)), intent(inout) ad_t,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),2), intent(inout) ad_u,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),2), intent(inout) ad_v,
real(r8), dimension(lbi:ubi,lbj:ubj,:), intent(inout) ad_ubar,
real(r8), dimension(lbi:ubi,lbj:ubj,:), intent(inout) ad_vbar,
real(r8), dimension(lbi:ubi,lbj:ubj,:), intent(inout) ad_zeta,
real(r8), dimension(lbij:ubij,n(ng),4, nbrec(ng),2,nt(ng)), intent(inout) tl_t_obc,
real(r8), dimension(lbij:ubij,n(ng),4,nbrec(ng),2), intent(inout) tl_u_obc,
real(r8), dimension(lbij:ubij,n(ng),4,nbrec(ng),2), intent(inout) tl_v_obc,
real(r8), dimension(lbij:ubij,4,nbrec(ng),2), intent(inout) tl_ubar_obc,
real(r8), dimension(lbij:ubij,4,nbrec(ng),2), intent(inout) tl_vbar_obc,
real(r8), dimension(lbij:ubij,4,nbrec(ng),2), intent(inout) tl_zeta_obc,
real(r8), dimension(lbi:ubi,lbj:ubj,nfrec(ng),2), intent(inout) tl_ustr,
real(r8), dimension(lbi:ubi,lbj:ubj,nfrec(ng),2), intent(inout) tl_vstr,
real(r8), dimension(lbi:ubi,lbj:ubj, nfrec(ng),2,nt(ng)), intent(inout) tl_tflux,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),3,nt(ng)), intent(inout) tl_t,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),2), intent(inout) tl_u,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),2), intent(inout) tl_v,
real(r8), dimension(lbi:ubi,lbj:ubj,:), intent(inout) tl_ubar,
real(r8), dimension(lbi:ubi,lbj:ubj,:), intent(inout) tl_vbar,
real(r8), dimension(lbi:ubi,lbj:ubj,:), intent(inout) tl_zeta )

Definition at line 132 of file ana_perturb.h.

175!***********************************************************************
176!
177 USE mod_param
178 USE mod_parallel
179 USE mod_iounits
180 USE mod_ncparam
181 USE mod_scalars
182!
183! Imported variable declarations.
184!
185 integer, intent(in) :: ng, tile, model
186 integer, intent(in) :: LBi, UBi, LBj, UBj, LBij, UBij
187 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
188 integer, intent(in) :: kstp, krhs, knew
189#ifdef SOLVE3D
190 integer, intent(in) :: nstp, nrhs, nnew
191#endif
192!
193#ifdef ASSUMED_SHAPE
194# ifdef ADJUST_BOUNDARY
195# ifdef SOLVE3D
196 real(r8), intent(inout) :: ad_t_obc(LBij:,:,:,:,:,:)
197 real(r8), intent(inout) :: ad_u_obc(LBij:,:,:,:,:)
198 real(r8), intent(inout) :: ad_v_obc(LBij:,:,:,:,:)
199# endif
200 real(r8), intent(inout) :: ad_ubar_obc(LBij:,:,:,:)
201 real(r8), intent(inout) :: ad_vbar_obc(LBij:,:,:,:)
202 real(r8), intent(inout) :: ad_zeta_obc(LBij:,:,:,:)
203# endif
204# ifdef ADJUST_WSTRESS
205 real(r8), intent(inout) :: ad_ustr(LBi:,LBj:,:,:)
206 real(r8), intent(inout) :: ad_vstr(LBi:,LBj:,:,:)
207# endif
208# if defined ADJUST_STFLUX && defined SOLVE3D
209 real(r8), intent(inout) :: ad_tflux(LBi:,LBj:,:,:,:)
210# endif
211# ifdef SOLVE3D
212 real(r8), intent(inout) :: ad_t(LBi:,LBj:,:,:,:)
213 real(r8), intent(inout) :: ad_u(LBi:,LBj:,:,:)
214 real(r8), intent(inout) :: ad_v(LBi:,LBj:,:,:)
215# endif
216 real(r8), intent(inout) :: ad_ubar(LBi:,LBj:,:)
217 real(r8), intent(inout) :: ad_vbar(LBi:,LBj:,:)
218 real(r8), intent(inout) :: ad_zeta(LBi:,LBj:,:)
219# ifdef ADJUST_BOUNDARY
220# ifdef SOLVE3D
221 real(r8), intent(inout) :: tl_t_obc(LBij:,:,:,:,:,:)
222 real(r8), intent(inout) :: tl_u_obc(LBij:,:,:,:,:)
223 real(r8), intent(inout) :: tl_v_obc(LBij:,:,:,:,:)
224# endif
225 real(r8), intent(inout) :: tl_ubar_obc(LBij:,:,:,:)
226 real(r8), intent(inout) :: tl_vbar_obc(LBij:,:,:,:)
227 real(r8), intent(inout) :: tl_zeta_obc(LBij:,:,:,:)
228# endif
229# ifdef ADJUST_WSTRESS
230 real(r8), intent(inout) :: tl_ustr(LBi:,LBj:,:,:)
231 real(r8), intent(inout) :: tl_vstr(LBi:,LBj:,:,:)
232# endif
233# if defined ADJUST_STFLUX && defined SOLVE3D
234 real(r8), intent(inout) :: tl_tflux(LBi:,LBj:,:,:,:)
235# endif
236# ifdef SOLVE3D
237 real(r8), intent(inout) :: tl_t(LBi:,LBj:,:,:,:)
238 real(r8), intent(inout) :: tl_u(LBi:,LBj:,:,:)
239 real(r8), intent(inout) :: tl_v(LBi:,LBj:,:,:)
240# endif
241 real(r8), intent(inout) :: tl_ubar(LBi:,LBj:,:)
242 real(r8), intent(inout) :: tl_vbar(LBi:,LBj:,:)
243 real(r8), intent(inout) :: tl_zeta(LBi:,LBj:,:)
244
245#else
246
247# ifdef ADJUST_BOUNDARY
248# ifdef SOLVE3D
249 real(r8), intent(inout) :: ad_t_obc(LBij:UBij,N(ng),4, &
250 & Nbrec(ng),2,NT(ng))
251 real(r8), intent(inout) :: ad_u_obc(LBij:UBij,N(ng),4,Nbrec(ng),2)
252 real(r8), intent(inout) :: ad_v_obc(LBij:UBij,N(ng),4,Nbrec(ng),2)
253# endif
254 real(r8), intent(inout) :: ad_ubar_obc(LBij:UBij,4,Nbrec(ng),2)
255 real(r8), intent(inout) :: ad_vbar_obc(LBij:UBij,4,Nbrec(ng),2)
256 real(r8), intent(inout) :: ad_zeta_obc(LBij:UBij,4,Nbrec(ng),2)
257# endif
258# ifdef ADJUST_WSTRESS
259 real(r8), intent(inout) :: ad_ustr(LBi:UBi,LBj:UBj,Nfrec(ng),2)
260 real(r8), intent(inout) :: ad_vstr(LBi:UBi,LBj:UBj,Nfrec(ng),2)
261# endif
262# if defined ADJUST_STFLUX && defined SOLVE3D
263 real(r8), intent(inout) :: ad_tflux(LBi:UBi,LBj:UBj, &
264 & Nfrec(ng),2,NT(ng))
265# endif
266# ifdef SOLVE3D
267 real(r8), intent(inout) :: ad_t(LBi:UBI,LBj:UBj,N(ng),2,NT(ng))
268 real(r8), intent(inout) :: ad_u(LBi:UBi,LBj:UBj,N(ng),2)
269 real(r8), intent(inout) :: ad_v(LBi:UBi,LBj:UBj,N(ng),2)
270# endif
271 real(r8), intent(inout) :: ad_ubar(LBi:UBi,LBj:UBj,:)
272 real(r8), intent(inout) :: ad_vbar(LBi:UBi,LBj:UBj,:)
273 real(r8), intent(inout) :: ad_zeta(LBi:UBi,LBj:UBj,:)
274# ifdef ADJUST_BOUNDARY
275# ifdef SOLVE3D
276 real(r8), intent(inout) :: tl_t_obc(LBij:UBij,N(ng),4, &
277 & Nbrec(ng),2,NT(ng))
278 real(r8), intent(inout) :: tl_u_obc(LBij:UBij,N(ng),4,Nbrec(ng),2)
279 real(r8), intent(inout) :: tl_v_obc(LBij:UBij,N(ng),4,Nbrec(ng),2)
280# endif
281 real(r8), intent(inout) :: tl_ubar_obc(LBij:UBij,4,Nbrec(ng),2)
282 real(r8), intent(inout) :: tl_vbar_obc(LBij:UBij,4,Nbrec(ng),2)
283 real(r8), intent(inout) :: tl_zeta_obc(LBij:UBij,4,Nbrec(ng),2)
284# endif
285# ifdef ADJUST_WSTRESS
286 real(r8), intent(inout) :: tl_ustr(LBi:UBi,LBj:UBj,Nfrec(ng),2)
287 real(r8), intent(inout) :: tl_vstr(LBi:UBi,LBj:UBj,Nfrec(ng),2)
288# endif
289# if defined ADJUST_STFLUX && defined SOLVE3D
290 real(r8), intent(inout) :: tl_tflux(LBi:UBi,LBj:UBj, &
291 & Nfrec(ng),2,NT(ng))
292# endif
293# ifdef SOLVE3D
294 real(r8), intent(inout) :: tl_u(LBi:UBi,LBj:UBj,N(ng),2)
295 real(r8), intent(inout) :: tl_v(LBi:UBi,LBj:UBj,N(ng),2)
296 real(r8), intent(inout) :: tl_t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
297# endif
298 real(r8), intent(inout) :: tl_ubar(LBi:UBi,LBj:UBj,:)
299 real(r8), intent(inout) :: tl_vbar(LBi:UBi,LBj:UBj,:)
300 real(r8), intent(inout) :: tl_zeta(LBi:UBi,LBj:UBj,:)
301#endif
302!
303! Local variable declarations.
304!
305#ifdef ADJUST_BOUNDARY
306 logical :: Lperturb(4)
307!
308#endif
309 integer :: IperAD, JperAD, KperAD, ivarAD
310 integer :: IperTL, JperTL, KperTL, ivarTL
311 integer :: i, ib, ir, itrc, j, k
312
313#include "set_bounds.h"
314!
315!-----------------------------------------------------------------------
316! Set tangent and adjoint variable and random point to perturb.
317!-----------------------------------------------------------------------
318!
319 ivartl=int(user(1))
320 ivarad=int(user(2))
321 ipertl=int(user(3))
322 iperad=int(user(4))
323 jpertl=int(user(5))
324 jperad=int(user(6))
325#ifdef SOLVE3D
326 kpertl=int(user(7))
327 kperad=int(user(8))
328#endif
329 IF (master) THEN
330 IF (tlmodel) THEN
331 IF (ivartl.eq.isubar) THEN
332 WRITE (stdout,10) 'tl_ubar perturbed at (i,j) = ', &
333 & ipertl, jpertl
334 ELSE IF (ivartl.eq.isvbar) THEN
335 WRITE (stdout,10) 'tl_vbar perturbed at (i,j) = ', &
336 & ipertl, jpertl
337 ELSE IF (ivartl.eq.isfsur) THEN
338 WRITE (stdout,10) 'tl_zeta perturbed at (i,j) = ', &
339 & ipertl, jpertl
340#ifdef ADJUST_WSTRESS
341 ELSE IF (ivartl.eq.isustr) THEN
342 WRITE (stdout,10) 'tl_ustr perturbed at (i,j) = ', &
343 & ipertl, jpertl
344 ELSE IF (ivartl.eq.isvstr) THEN
345 WRITE (stdout,10) 'tl_vstr perturbed at (i,j) = ', &
346 & ipertl, jpertl
347#endif
348#ifdef SOLVE3D
349 ELSE IF (ivartl.eq.isuvel) THEN
350 WRITE (stdout,20) 'tl_u perturbed at (i,j,k) = ', &
351 & ipertl, jpertl, kpertl
352 ELSE IF (ivartl.eq.isvvel) THEN
353 WRITE (stdout,20) 'tl_v perturbed at (i,j,k) = ', &
354 & ipertl, jpertl, kpertl
355#endif
356 END IF
357#ifdef SOLVE3D
358 DO itrc=1,nt(ng)
359 IF (ivartl.eq.istvar(itrc)) THEN
360 WRITE (stdout,30) 'tl_t perturbed at (i,j,k,itrc) = ', &
361 & ipertl, jpertl, kpertl, itrc
362# ifdef ADJUST_STFLUX
363 ELSE IF (ivartl.eq.istsur(itrc)) THEN
364 WRITE (stdout,20) 'tl_tflux perturbed at (i,j,k,itrc) = ',&
365 & ipertl, jpertl, kpertl, itrc
366# endif
367 END IF
368 END DO
369#endif
370#ifdef ADJUST_BOUNDARY
371 IF (ivartl.eq.isubar) THEN
372 WRITE (stdout,10) 'tl_ubar_obc (S/N) perturbed at (i) = ', &
373 & ipertl
374 WRITE (stdout,10) 'tl_ubar_obc (E/W) perturbed at (j) = ', &
375 & jpertl
376 ELSE IF (ivartl.eq.isvbar) THEN
377 WRITE (stdout,10) 'tl_vbar_obc (S/N) perturbed at (i) = ', &
378 & ipertl
379 WRITE (stdout,10) 'tl_vbar_obc (E/W) perturbed at (j) = ', &
380 & jpertl
381 ELSE IF (ivartl.eq.isfsur) THEN
382 WRITE (stdout,10) 'tl_zeta_obc (S/N) perturbed at (i) = ', &
383 & ipertl
384 WRITE (stdout,10) 'tl_zeta_obc (E/W) perturbed at (j) = ', &
385 & jpertl
386# ifdef SOLVE3D
387 ELSE IF (ivartl.eq.isuvel) THEN
388 WRITE (stdout,10) 'tl_u_obc (S/N) perturbed at (i,k) = ', &
389 & ipertl, kpertl
390 WRITE (stdout,10) 'tl_u_obc (E/W) perturbed at (j,k) = ', &
391 & jpertl, kpertl
392 ELSE IF (ivartl.eq.isuvel) THEN
393 WRITE (stdout,10) 'tl_u_obc (S/N) perturbed at (i,k) = ', &
394 & ipertl, kpertl
395 WRITE (stdout,10) 'tl_u_obc (E/W) perturbed at (j,k) = ', &
396 & jpertl, kpertl
397# endif
398 END IF
399# ifdef SOLVE3D
400 DO itrc=1,nt(ng)
401 IF (ivartl.eq.istvar(itrc)) THEN
402 WRITE (stdout,20) 'tl_t_obc perturbed at (i,k,itrc) = ', &
403 & ipertl, kpertl, itrc
404 WRITE (stdout,20) 'tl_t_obc perturbed at (j,k,itrc) = ', &
405 & jpertl, kpertl, itrc
406 END IF
407 END DO
408# endif
409#endif
410 END IF
411 IF (admodel) THEN
412 IF (ivarad.eq.isubar) THEN
413 WRITE (stdout,40) 'ad_ubar perturbed at (i,j) = ', &
414 & iperad, jperad
415 ELSE IF (ivarad.eq.isvbar) THEN
416 WRITE (stdout,40) 'ad_vbar perturbed at (i,j) = ', &
417 & iperad, jperad
418 ELSE IF (ivarad.eq.isfsur) THEN
419 WRITE (stdout,40) 'ad_zeta perturbed at (i,j) = ', &
420 & iperad, jperad
421#ifdef ADJUST_WSTRESS
422 ELSE IF (ivarad.eq.isustr) THEN
423 WRITE (stdout,40) 'ad_ustr perturbed at (i,j,k) = ', &
424 & iperad, jperad
425 ELSE IF (ivarad.eq.isvstr) THEN
426 WRITE (stdout,40) 'ad_vstr perturbed at (i,j,k) = ', &
427 & iperad, jperad
428#endif
429#ifdef SOLVE3D
430 ELSE IF (ivarad.eq.isuvel) THEN
431 WRITE (stdout,50) 'ad_u perturbed at (i,j,k) = ', &
432 & iperad, jperad, kperad
433 ELSE IF (ivarad.eq.isvvel) THEN
434 WRITE (stdout,50) 'ad_v perturbed at (i,j,k) = ', &
435 & iperad, jperad, kperad
436#endif
437 END IF
438#ifdef SOLVE3D
439 DO itrc=1,nt(ng)
440 IF (ivarad.eq.istvar(itrc)) THEN
441 WRITE (stdout,60) 'ad_t perturbed at (i,j,k,itrc) = ', &
442 & iperad, jperad, kperad, itrc
443# ifdef ADJUST_STFLUX
444 ELSE IF (ivarad.eq.istsur(itrc)) THEN
445 WRITE (stdout,50) 'ad_tflux perturbed at (i,j,k,itrc) = ',&
446 & iperad, jperad, kperad, itrc
447# endif
448 END IF
449 END DO
450#endif
451#ifdef ADJUST_BOUNDARY
452 IF (ivarad.eq.isubar) THEN
453 WRITE (stdout,40) 'ad_ubar_obc (S/N) perturbed at (i) = ', &
454 & iperad
455 WRITE (stdout,40) 'ad_ubar_obc (E/W) perturbed at (j) = ', &
456 & jperad
457 ELSE IF (ivarad.eq.isvbar) THEN
458 WRITE (stdout,40) 'ad_vbar_obc (S/N) perturbed at (i) = ', &
459 & iperad
460 WRITE (stdout,40) 'ad_vbar_obc (E/W) perturbed at (j) = ', &
461 & jperad
462 ELSE IF (ivarad.eq.isfsur) THEN
463 WRITE (stdout,40) 'ad_zeta_obc (S/N) perturbed at (i) = ', &
464 & iperad
465 WRITE (stdout,40) 'ad_zeta_obc (E/W) perturbed at (j) = ', &
466 & jperad
467# ifdef SOLVE3D
468 ELSE IF (ivarad.eq.isuvel) THEN
469 WRITE (stdout,40) 'ad_u_obc (S/N) perturbed at (i,k) = ', &
470 & iperad, kperad
471 WRITE (stdout,40) 'ad_u_obc (E/W) perturbed at (j,k) = ', &
472 & jperad, kperad
473 ELSE IF (ivarad.eq.isuvel) THEN
474 WRITE (stdout,40) 'ad_u_obc (S/N) perturbed at (i,k) = ', &
475 & iperad, kperad
476 WRITE (stdout,40) 'ad_u_obc (E/W) perturbed at (j,k) = ', &
477 & jperad, kperad
478# endif
479 END IF
480# ifdef SOLVE3D
481 DO itrc=1,nt(ng)
482 IF (ivarad.eq.istvar(itrc)) THEN
483 WRITE (stdout,50) 'ad_t_obc perturbed at (i,k,itrc) = ', &
484 & iperad, kperad, itrc
485 WRITE (stdout,50) 'ad_t_obc perturbed at (j,k,itrc) = ', &
486 & jperad, kperad, itrc
487 END IF
488 END DO
489# endif
490#endif
491 END IF
492 END IF
493!
494!-----------------------------------------------------------------------
495! Peturb initial conditions for 2D momentum (m/s) components.
496!-----------------------------------------------------------------------
497!
498 IF (tlmodel) THEN
499 DO j=jstrt,jendt
500 DO i=istrp,iendt
501 IF ((ivartl.eq.isubar).and. &
502 & (i.eq.ipertl).and.(j.eq.jpertl)) THEN
503 tl_ubar(i,j,kstp)=1.0_r8
504 ELSE
505 tl_ubar(i,j,kstp)=0.0_r8
506 END IF
507 END DO
508 END DO
509 DO j=jstrp,jendt
510 DO i=istrt,iendt
511 IF ((ivartl.eq.isvbar).and. &
512 & (i.eq.ipertl).and.(j.eq.jpertl)) THEN
513 tl_vbar(i,j,kstp)=1.0_r8
514 ELSE
515 tl_vbar(i,j,kstp)=0.0_r8
516 END IF
517 END DO
518 END DO
519 END IF
520!
521 IF (admodel) THEN
522 DO j=jstrt,jendt
523 DO i=istrp,iendt
524 IF ((ivarad.eq.isubar).and. &
525 & (i.eq.iperad).and.(j.eq.jperad)) THEN
526 ad_ubar(i,j,knew)=1.0_r8
527 ELSE
528 ad_ubar(i,j,knew)=0.0_r8
529 END IF
530 END DO
531 END DO
532 DO j=jstrp,jendt
533 DO i=istrt,iendt
534 IF ((ivarad.eq.isvbar).and. &
535 & (i.eq.iperad).and.(j.eq.jperad)) THEN
536 ad_vbar(i,j,knew)=1.0_r8
537 ELSE
538 ad_vbar(i,j,knew)=0.0_r8
539 END IF
540 END DO
541 END DO
542 END IF
543#ifdef ADJUST_WSTRESS
544!
545!-----------------------------------------------------------------------
546! Peturb initial conditions for surface momentum stress (UNIT ????).
547!-----------------------------------------------------------------------
548!
549 IF (tlmodel) THEN
550 DO ir=1,nfrec(ng)
551 DO j=jstrt,jendt
552 DO i=istrp,iendt
553 IF ((ivartl.eq.isustr).and. &
554 & (i.eq.ipertl).and.(j.eq.jpertl).and. &
555 & (ir.eq.kpertl)) THEN
556 tl_ustr(i,j,ir,kstp)=1.0_r8
557 ELSE
558 tl_ustr(i,j,ir,kstp)=0.0_r8
559 END IF
560 END DO
561 END DO
562 DO j=jstrp,jendt
563 DO i=istrt,iendt
564 IF ((ivartl.eq.isvstr).and. &
565 & (i.eq.ipertl).and.(j.eq.jpertl).and. &
566 & (ir.eq.kpertl)) THEN
567 tl_vstr(i,j,ir,kstp)=1.0_r8
568 ELSE
569 tl_vstr(i,j,ir,kstp)=0.0_r8
570 END IF
571 END DO
572 END DO
573 END DO
574 END IF
575!
576 IF (admodel) THEN
577 DO ir=1,nfrec(ng)
578 DO j=jstrt,jendt
579 DO i=istrp,iendt
580 IF ((ivarad.eq.isustr).and. &
581 & (i.eq.iperad).and.(j.eq.jperad).and. &
582 & (ir.eq.kperad)) THEN
583 ad_ustr(i,j,ir,knew)=1.0_r8
584 ELSE
585 ad_ustr(i,j,ir,knew)=0.0_r8
586 END IF
587 END DO
588 END DO
589 DO j=jstrp,jendt
590 DO i=istrt,iendt
591 IF ((ivarad.eq.isvstr).and. &
592 & (i.eq.iperad).and.(j.eq.jperad).and. &
593 & (ir.eq.kperad)) THEN
594 ad_vstr(i,j,ir,knew)=1.0_r8
595 ELSE
596 ad_vstr(i,j,ir,knew)=0.0_r8
597 END IF
598 END DO
599 END DO
600 END DO
601 END IF
602#endif
603!
604!-----------------------------------------------------------------------
605! Perturb initial conditions for free-surface (m).
606!-----------------------------------------------------------------------
607!
608 IF (tlmodel) THEN
609 DO j=jstrt,jendt
610 DO i=istrt,iendt
611 IF ((ivartl.eq.isfsur).and. &
612 & (i.eq.ipertl).and.(j.eq.jpertl)) THEN
613 tl_zeta(i,j,kstp)=1.0_r8
614 ELSE
615 tl_zeta(i,j,kstp)=0.0_r8
616 END IF
617 END DO
618 END DO
619 END IF
620!
621 IF (admodel) THEN
622 DO j=jstrt,jendt
623 DO i=istrt,iendt
624 IF ((ivarad.eq.isfsur).and. &
625 & (i.eq.iperad).and.(j.eq.jperad)) THEN
626 ad_zeta(i,j,knew)=1.0_r8
627 ELSE
628 ad_zeta(i,j,knew)=0.0_r8
629 END IF
630 END DO
631 END DO
632 END IF
633
634#ifdef SOLVE3D
635!
636!-----------------------------------------------------------------------
637! Initial conditions for 3D momentum components (m/s).
638!-----------------------------------------------------------------------
639!
640 IF (tlmodel) THEN
641 DO k=1,n(ng)
642 DO j=jstrt,jendt
643 DO i=istrp,iendt
644 IF ((ivartl.eq.isuvel).and. &
645 & (i.eq.ipertl).and.(j.eq.jpertl).and. &
646 & (k.eq.kpertl)) THEN
647 tl_u(i,j,k,nstp)=1.0_r8
648 ELSE
649 tl_u(i,j,k,nstp)=0.0_r8
650 END IF
651 END DO
652 END DO
653 DO j=jstrp,jendt
654 DO i=istrt,iendt
655 IF ((ivartl.eq.isvvel).and. &
656 & (i.eq.ipertl).and.(j.eq.jpertl).and. &
657 & (k.eq.kpertl)) THEN
658 tl_v(i,j,k,nstp)=1.0_r8
659 ELSE
660 tl_v(i,j,k,nstp)=0.0_r8
661 END IF
662 END DO
663 END DO
664 END DO
665 END IF
666!
667 IF (admodel) THEN
668 DO k=1,n(ng)
669 DO j=jstrt,jendt
670 DO i=istrp,iendt
671 IF ((ivarad.eq.isuvel).and. &
672 & (i.eq.iperad).and.(j.eq.jperad).and. &
673 & (k.eq.kperad)) THEN
674 ad_u(i,j,k,nstp)=1.0_r8
675 ELSE
676 ad_u(i,j,k,nstp)=0.0_r8
677 END IF
678 END DO
679 END DO
680 DO j=jstrp,jendt
681 DO i=istrt,iendt
682 IF ((ivarad.eq.isvvel).and. &
683 & (i.eq.iperad).and.(j.eq.jperad).and. &
684 & (k.eq.kperad)) THEN
685 ad_v(i,j,k,nstp)=1.0_r8
686 ELSE
687 ad_v(i,j,k,nstp)=0.0_r8
688 END IF
689 END DO
690 END DO
691 END DO
692 END IF
693!
694!-----------------------------------------------------------------------
695! Perturb initial conditions for tracer type variables.
696!-----------------------------------------------------------------------
697!
698 IF (tlmodel) THEN
699 DO itrc=1,nt(ng)
700 DO k=1,n(ng)
701 DO j=jstrt,jendt
702 DO i=istrt,iendt
703 IF ((ivartl.eq.istvar(itrc)).and. &
704 & (i.eq.ipertl).and.(j.eq.jpertl).and. &
705 & (k.eq.kpertl)) THEN
706 tl_t(i,j,k,nstp,itrc)=1.0_r8
707 ELSE
708 tl_t(i,j,k,nstp,itrc)=0.0_r8
709 END IF
710 END DO
711 END DO
712 END DO
713 END DO
714 END IF
715!
716 IF (admodel) THEN
717 DO itrc=1,nt(ng)
718 DO k=1,n(ng)
719 DO j=jstrt,jendt
720 DO i=istrt,iendt
721 IF ((ivarad.eq.istvar(itrc)).and. &
722 & (i.eq.iperad).and.(j.eq.jperad).and. &
723 & (k.eq.kperad)) THEN
724 ad_t(i,j,k,nstp,itrc)=1.0_r8
725 ELSE
726 ad_t(i,j,k,nstp,itrc)=0.0_r8
727 END IF
728 END DO
729 END DO
730 END DO
731 END DO
732 END IF
733# ifdef ADJUST_STFLUX
734!
735!-----------------------------------------------------------------------
736! Perturb initial conditions for surface tracer flux.
737!-----------------------------------------------------------------------
738!
739 IF (tlmodel) THEN
740 DO itrc=1,nt(ng)
741 DO ir=1,nfrec(ng)
742 DO j=jstrt,jendt
743 DO i=istrt,iendt
744 IF ((ivartl.eq.istsur(itrc)).and. &
745 & (i.eq.ipertl).and.(j.eq.jpertl).and. &
746 & (ir.eq.kpertl)) THEN
747 tl_tflux(i,j,ir,nstp,itrc)=1.0_r8
748 ELSE
749 tl_tflux(i,j,ir,nstp,itrc)=0.0_r8
750 END IF
751 END DO
752 END DO
753 END DO
754 END DO
755 END IF
756!
757 IF (admodel) THEN
758 DO itrc=1,nt(ng)
759 DO ir=1,nfrec(ng)
760 DO j=jstrt,jendt
761 DO i=istrt,iendt
762 IF ((ivarad.eq.istsur(itrc)).and. &
763 & (i.eq.iperad).and.(j.eq.jperad).and. &
764 & (ir.eq.kperad)) THEN
765 ad_tflux(i,j,ir,nstp,itrc)=1.0_r8
766 ELSE
767 ad_tflux(i,j,ir,nstp,itrc)=0.0_r8
768 END IF
769 END DO
770 END DO
771 END DO
772 END DO
773 END IF
774# endif
775# ifdef ADJUST_BOUNDARY
776!
777!-----------------------------------------------------------------------
778! Perturb open boundary conditions.
779!-----------------------------------------------------------------------
780!
781 lperturb(iwest )=domain(ng)%Western_Edge (tile)
782 lperturb(ieast )=domain(ng)%Eastern_Edge (tile)
783 lperturb(isouth)=domain(ng)%Southern_Edge(tile)
784 lperturb(inorth)=domain(ng)%Northern_Edge(tile)
785
786 DO ir=1,nbrec(ng)
787 DO ib=1,4
788!
789! Perturb free-surface open boundaries.
790!
791 IF (lperturb(ib).and.lobc(ib,isfsur,ng)) THEN
792 IF ((ib.eq.iwest).or.(ib.eq.ieast)) THEN
793 IF (tlmodel.and.(ivartl.eq.isfsur)) THEN
794 DO j=jstr,jend
795 IF (j.eq.jpertl) THEN
796 tl_zeta_obc(j,ib,ir,1)=1.0_r8
797 ELSE
798 tl_zeta_obc(j,ib,ir,1)=0.0_r8
799 END IF
800 END DO
801 ELSE IF (admodel.and.(ivarad.eq.isfsur)) THEN
802 DO j=jstr,jend
803 IF (j.eq.jperad) THEN
804 ad_zeta_obc(j,ib,ir,1)=1.0_r8
805 ELSE
806 ad_zeta_obc(j,ib,ir,1)=0.0_r8
807 END IF
808 END DO
809 END IF
810 ELSE IF ((ib.eq.isouth).or.(ib.eq.inorth)) THEN
811 IF (tlmodel.and.(ivartl.eq.isfsur)) THEN
812 DO i=istr,iend
813 IF (i.eq.ipertl) THEN
814 tl_zeta_obc(i,ib,ir,1)=1.0_r8
815 ELSE
816 tl_zeta_obc(i,ib,ir,1)=0.0_r8
817 END IF
818 END DO
819 ELSE IF (admodel.and.(ivarad.eq.isfsur)) THEN
820 DO i=istr,iend
821 IF (i.eq.iperad) THEN
822 ad_zeta_obc(i,ib,ir,1)=1.0_r8
823 ELSE
824 ad_zeta_obc(i,ib,ir,1)=0.0_r8
825 END IF
826 END DO
827 END IF
828 END IF
829 END IF
830!
831! Perturb 2D U-momentum open boundaries.
832!
833 IF (lperturb(ib).and.lobc(ib,isubar,ng)) THEN
834 IF ((ib.eq.iwest).or.(ib.eq.ieast)) THEN
835 IF (tlmodel.and.(ivartl.eq.isubar)) THEN
836 DO j=jstr,jend
837 IF (j.eq.jpertl) THEN
838 tl_ubar_obc(j,ib,ir,1)=1.0_r8
839 ELSE
840 tl_ubar_obc(j,ib,ir,1)=0.0_r8
841 END IF
842 END DO
843 ELSE IF (admodel.and.(ivarad.eq.isubar)) THEN
844 DO j=jstr,jend
845 IF (j.eq.jperad) THEN
846 ad_ubar_obc(j,ib,ir,1)=1.0_r8
847 ELSE
848 ad_ubar_obc(j,ib,ir,1)=0.0_r8
849 END IF
850 END DO
851 END IF
852 ELSE IF ((ib.eq.isouth).or.(ib.eq.inorth)) THEN
853 IF (tlmodel.and.(ivartl.eq.isubar)) THEN
854 DO i=istru,iend
855 IF (i.eq.ipertl) THEN
856 tl_ubar_obc(i,ib,ir,1)=1.0_r8
857 ELSE
858 tl_ubar_obc(i,ib,ir,1)=0.0_r8
859 END IF
860 END DO
861 ELSE IF (admodel.and.(ivarad.eq.isubar)) THEN
862 DO i=istru,iend
863 IF (i.eq.iperad) THEN
864 ad_ubar_obc(i,ib,ir,1)=1.0_r8
865 ELSE
866 ad_ubar_obc(i,ib,ir,1)=0.0_r8
867 END IF
868 END DO
869 END IF
870 END IF
871 END IF
872!
873! Perturb 2D V-momentum open boundaries.
874!
875 IF (lperturb(ib).and.lobc(ib,isvbar,ng)) THEN
876 IF ((ib.eq.iwest).or.(ib.eq.ieast)) THEN
877 IF (tlmodel.and.(ivartl.eq.isvbar)) THEN
878 DO j=jstrv,jend
879 IF (j.eq.jpertl) THEN
880 tl_vbar_obc(j,ib,ir,1)=1.0_r8
881 ELSE
882 tl_vbar_obc(j,ib,ir,1)=0.0_r8
883 END IF
884 END DO
885 ELSE IF (admodel.and.(ivarad.eq.isvbar)) THEN
886 DO j=jstrv,jend
887 IF (j.eq.jperad) THEN
888 ad_vbar_obc(j,ib,ir,1)=1.0_r8
889 ELSE
890 ad_vbar_obc(j,ib,ir,1)=0.0_r8
891 END IF
892 END DO
893 END IF
894 ELSE IF ((ib.eq.isouth).or.(ib.eq.inorth)) THEN
895 IF (tlmodel.and.(ivartl.eq.isvbar)) THEN
896 DO i=istr,iend
897 IF (i.eq.ipertl) THEN
898 tl_vbar_obc(i,ib,ir,1)=1.0_r8
899 ELSE
900 tl_vbar_obc(i,ib,ir,1)=0.0_r8
901 END IF
902 END DO
903 ELSE IF (admodel.and.(ivarad.eq.isvbar)) THEN
904 DO i=istr,iend
905 IF (i.eq.iperad) THEN
906 ad_vbar_obc(i,ib,ir,1)=1.0_r8
907 ELSE
908 ad_vbar_obc(i,ib,ir,1)=0.0_r8
909 END IF
910 END DO
911 END IF
912 END IF
913 END IF
914
915# ifdef SOLVE3D
916!
917! Perturb 3D U-momentum open boundaries.
918!
919 IF (lperturb(ib).and.lobc(ib,isuvel,ng)) THEN
920 IF ((ib.eq.iwest).or.(ib.eq.ieast)) THEN
921 IF (tlmodel.and.(ivartl.eq.isuvel)) THEN
922 DO k=1,n(ng)
923 DO j=jstr,jend
924 IF ((j.eq.jpertl).and.(k.eq.kpertl)) THEN
925 tl_u_obc(j,k,ib,ir,1)=1.0_r8
926 ELSE
927 tl_u_obc(j,k,ib,ir,1)=0.0_r8
928 END IF
929 END DO
930 END DO
931 ELSE IF (admodel.and.(ivarad.eq.isuvel)) THEN
932 DO k=1,n(ng)
933 DO j=jstr,jend
934 IF ((j.eq.jperad).and.(k.eq.kperad)) THEN
935 ad_u_obc(j,k,ib,ir,1)=1.0_r8
936 ELSE
937 ad_u_obc(j,k,ib,ir,1)=0.0_r8
938 END IF
939 END DO
940 END DO
941 END IF
942 ELSE IF ((ib.eq.isouth).or.(ib.eq.inorth)) THEN
943 IF (tlmodel.and.(ivartl.eq.isuvel)) THEN
944 DO k=1,n(ng)
945 DO i=istru,iend
946 IF ((i.eq.ipertl).and.(k.eq.kpertl)) THEN
947 tl_u_obc(i,k,ib,ir,1)=1.0_r8
948 ELSE
949 tl_u_obc(i,k,ib,ir,1)=0.0_r8
950 END IF
951 END DO
952 END DO
953 ELSE IF (admodel.and.(ivarad.eq.isuvel)) THEN
954 DO k=1,n(ng)
955 DO i=istru,iend
956 IF ((i.eq.iperad).and.(k.eq.kperad)) THEN
957 ad_u_obc(i,k,ib,ir,1)=1.0_r8
958 ELSE
959 ad_u_obc(i,k,ib,ir,1)=0.0_r8
960 END IF
961 END DO
962 END DO
963 END IF
964 END IF
965 END IF
966!
967! Perturb 3D V-momentum open boundaries.
968!
969 IF (lperturb(ib).and.lobc(ib,isvvel,ng)) THEN
970 IF ((ib.eq.iwest).or.(ib.eq.ieast)) THEN
971 IF (tlmodel.and.(ivartl.eq.isvvel)) THEN
972 DO k=1,n(ng)
973 DO j=jstrv,jend
974 IF ((j.eq.jpertl).and.(k.eq.kpertl)) THEN
975 tl_v_obc(j,k,ib,ir,1)=1.0_r8
976 ELSE
977 tl_v_obc(j,k,ib,ir,1)=0.0_r8
978 END IF
979 END DO
980 END DO
981 ELSE IF (admodel.and.(ivarad.eq.isvvel)) THEN
982 DO k=1,n(ng)
983 DO j=jstrv,jend
984 IF ((j.eq.jperad).and.(k.eq.kperad)) THEN
985 ad_v_obc(j,k,ib,ir,1)=1.0_r8
986 ELSE
987 ad_v_obc(j,k,ib,ir,1)=0.0_r8
988 END IF
989 END DO
990 END DO
991 END IF
992 ELSE IF ((ib.eq.isouth).or.(ib.eq.inorth)) THEN
993 IF (tlmodel.and.(ivartl.eq.isvvel)) THEN
994 DO k=1,n(ng)
995 DO i=istr,iend
996 IF ((i.eq.ipertl).and.(k.eq.kpertl)) THEN
997 tl_v_obc(i,k,ib,ir,1)=1.0_r8
998 ELSE
999 tl_v_obc(i,k,ib,ir,1)=0.0_r8
1000 END IF
1001 END DO
1002 END DO
1003 ELSE IF (admodel.and.(ivarad.eq.isvvel)) THEN
1004 DO k=1,n(ng)
1005 DO i=istr,iend
1006 IF ((i.eq.iperad).and.(k.eq.kperad)) THEN
1007 ad_v_obc(i,k,ib,ir,1)=1.0_r8
1008 ELSE
1009 ad_v_obc(i,k,ib,ir,1)=0.0_r8
1010 END IF
1011 END DO
1012 END DO
1013 END IF
1014 END IF
1015 END IF
1016!
1017! Perturb tracers open boundaries.
1018!
1019 DO itrc=1,nt(ng)
1020 IF (lperturb(ib).and.lobc(ib,istvar(itrc),ng)) THEN
1021 IF ((ib.eq.iwest).or.(ib.eq.ieast)) THEN
1022 IF (tlmodel.and.(ivartl.eq.istvar(itrc))) THEN
1023 DO k=1,n(ng)
1024 DO j=jstr,jend
1025 IF ((j.eq.jpertl).and.(k.eq.kpertl)) THEN
1026 tl_t_obc(j,k,ib,ir,1,itrc)=1.0_r8
1027 ELSE
1028 tl_t_obc(j,k,ib,ir,1,itrc)=0.0_r8
1029 END IF
1030 END DO
1031 END DO
1032 ELSE IF (admodel.and.(ivarad.eq.istvar(itrc))) THEN
1033 DO k=1,n(ng)
1034 DO j=jstr,jend
1035 IF ((j.eq.jperad).and.(k.eq.kperad)) THEN
1036 ad_t_obc(j,k,ib,ir,1,itrc)=1.0_r8
1037 ELSE
1038 ad_t_obc(j,k,ib,ir,1,itrc)=0.0_r8
1039 END IF
1040 END DO
1041 END DO
1042 END IF
1043 ELSE IF ((ib.eq.isouth).or.(ib.eq.inorth)) THEN
1044 IF (tlmodel.and.(ivartl.eq.istvar(itrc))) THEN
1045 DO k=1,n(ng)
1046 DO i=istr,iend
1047 IF ((i.eq.ipertl).and.(k.eq.kpertl)) THEN
1048 tl_t_obc(i,k,ib,ir,1,itrc)=1.0_r8
1049 ELSE
1050 tl_t_obc(i,k,ib,ir,1,itrc)=0.0_r8
1051 END IF
1052 END DO
1053 END DO
1054 ELSE IF (admodel.and.(ivarad.eq.istvar(itrc))) THEN
1055 DO k=1,n(ng)
1056 DO i=istr,iend
1057 IF ((i.eq.iperad).and.(k.eq.kperad)) THEN
1058 ad_t_obc(i,k,ib,ir,1,itrc)=1.0_r8
1059 ELSE
1060 ad_t_obc(i,k,ib,ir,1,itrc)=0.0_r8
1061 END IF
1062 END DO
1063 END DO
1064 END IF
1065 END IF
1066 END IF
1067 END DO
1068# endif
1069 END DO
1070 END DO
1071# endif
1072#endif
1073!
1074 10 FORMAT (/,' ANA_PERTURB - Tangent ', a, 2i4,/)
1075#ifdef SOLVE3D
1076 20 FORMAT (/,' ANA_PERTURB - Tangent ', a, 3i4,/)
1077 30 FORMAT (/,' ANA_PERTURB - Tangent ', a, 4i4,/)
1078#endif
1079 40 FORMAT (/,' ANA_PERTURB - Adjoint ', a, 2i4,/)
1080#ifdef SOLVE3D
1081 50 FORMAT (/,' ANA_PERTURB - Adjoint ', a, 3i4,/)
1082 60 FORMAT (/,' ANA_PERTURB - Adjoint ', a, 4i4,/)
1083#endif
1084!
1085 RETURN
mod_ncparam::isvstr
integer isvstr
Definition mod_ncparam.F:511
mod_ncparam::istvar
integer, dimension(:), allocatable istvar
Definition mod_ncparam.F:520
mod_ncparam::isustr
integer isustr
Definition mod_ncparam.F:510
mod_ncparam::istsur
integer, dimension(:), allocatable istsur
Definition mod_ncparam.F:519
mod_parallel::master
logical master
Definition mod_parallel.F:40
mod_param::nt
integer, dimension(:), allocatable nt
Definition mod_param.F:489
mod_scalars::tlmodel
logical tlmodel
Definition mod_scalars.F:1895
mod_scalars::lobc
logical, dimension(:,:,:), allocatable lobc
Definition mod_scalars.F:1127
mod_scalars::user
real(r8), dimension(:), allocatable user
Definition mod_scalars.F:805
mod_scalars::nfrec
integer, dimension(:), allocatable nfrec
Definition mod_scalars.F:1148
mod_scalars::admodel
logical admodel
Definition mod_scalars.F:1896
mod_scalars::nbrec
integer, dimension(:), allocatable nbrec
Definition mod_scalars.F:1119

References mod_scalars::admodel, mod_param::domain, mod_scalars::ieast, mod_scalars::inorth, mod_ncparam::isfsur, mod_scalars::isouth, mod_ncparam::istsur, mod_ncparam::istvar, mod_ncparam::isubar, mod_ncparam::isustr, mod_ncparam::isuvel, mod_ncparam::isvbar, mod_ncparam::isvstr, mod_ncparam::isvvel, mod_scalars::iwest, mod_scalars::lobc, mod_parallel::master, mod_iounits::stdout, mod_scalars::tlmodel, and mod_scalars::user.

Referenced by ana_perturb().

Here is the caller graph for this function:

◆ ana_psource()

subroutine analytical_mod::ana_psource ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 2 of file ana_psource.h.

3!
4!! git $Id$
5!!======================================================================
6!! Copyright (c) 2002-2025 The ROMS Group !
7!! Licensed under a MIT/X style license !
8!! See License_ROMS.md !
9!=======================================================================
10! !
11! This subroutine sets analytical tracer and mass point Sources !
12! and/or Sinks. River runoff can be consider as a point source. !
13! !
14!=======================================================================
15!
16 USE mod_param
17 USE mod_grid
18 USE mod_ncparam
19 USE mod_ocean
20 USE mod_stepping
21!
22! Imported variable declarations
23!
24 integer, intent(in) :: ng, tile, model
25!
26! Local variable declarations.
27!
28 character (len=*), parameter :: MyFile = &
29 & __FILE__
30!
31#include "tile.h"
32!
33 CALL ana_psource_tile (ng, tile, model, &
34 & lbi, ubi, lbj, ubj, &
35 & imins, imaxs, jmins, jmaxs, &
36 & nnew(ng), knew(ng), &
37 & ocean(ng) % zeta, &
38 & ocean(ng) % ubar, &
39 & ocean(ng) % vbar, &
40#ifdef SOLVE3D
41 & ocean(ng) % u, &
42 & ocean(ng) % v, &
43 & grid(ng) % z_w, &
44#endif
45 & grid(ng) % h, &
46 & grid(ng) % on_u, &
47 & grid(ng) % om_v)
48!
49! Set analytical header file name used.
50!
51#ifdef DISTRIBUTE
52 IF (lanafile) THEN
53#else
54 IF (lanafile.and.(tile.eq.0)) THEN
55#endif
56 ananame(20)=myfile
57 END IF
58!
59 RETURN

References ana_psource_tile(), mod_ncparam::ananame, mod_grid::grid, mod_stepping::knew, mod_ncparam::lanafile, mod_stepping::nnew, and mod_ocean::ocean.

Referenced by ad_initial(), ad_set_data_tile(), ana_psource_tile(), initial(), roms_kernel_mod::nlm_initial(), rp_initial(), rp_set_data_tile(), set_data_tile(), tl_initial(), and tl_set_data_tile().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_psource_tile()

subroutine analytical_mod::ana_psource_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
integer, intent(in) nnew,
integer, intent(in) knew,
real(r8), dimension(lbi:ubi,lbj:ubj,:), intent(in) zeta,
real(r8), dimension(lbi:ubi,lbj:ubj,:), intent(in) ubar,
real(r8), dimension(lbi:ubi,lbj:ubj,:), intent(in) vbar,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),2), intent(in) u,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),2), intent(in) v,
real(r8), dimension(lbi:ubi,lbj:ubj,0:n(ng)), intent(in) z_w,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) h,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) on_u,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) om_v )

Definition at line 63 of file ana_psource.h.

72!***********************************************************************
73!
74 USE mod_param
75 USE mod_parallel
76 USE mod_scalars
77#ifdef SEDIMENT
78 USE mod_sediment
79#endif
80 USE mod_sources
81
82#ifdef DISTRIBUTE
83!
84 USE distribute_mod, ONLY : mp_bcastf, mp_bcasti
85 USE distribute_mod, ONLY : mp_collect, mp_reduce
86#endif
87!
88! Imported variable declarations.
89!
90 integer, intent(in) :: ng, tile, model
91 integer, intent(in) :: LBi, UBi, LBj, UBj
92 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
93 integer, intent(in) :: nnew, knew
94!
95#ifdef ASSUMED_SHAPE
96 real(r8), intent(in) :: zeta(LBi:,LBj:,:)
97 real(r8), intent(in) :: ubar(LBi:,LBj:,:)
98 real(r8), intent(in) :: vbar(LBi:,LBj:,:)
99# ifdef SOLVE3D
100 real(r8), intent(in) :: u(LBi:,LBj:,:,:)
101 real(r8), intent(in) :: v(LBi:,LBj:,:,:)
102 real(r8), intent(in) :: z_w(LBi:,LBj:,0:)
103# endif
104 real(r8), intent(in) :: h(LBi:,LBj:)
105 real(r8), intent(in) :: on_u(LBi:,LBj:)
106 real(r8), intent(in) :: om_v(LBi:,LBj:)
107#else
108 real(r8), intent(in) :: zeta(LBi:UBi,LBj:UBj,:)
109 real(r8), intent(in) :: ubar(LBi:UBi,LBj:UBj,:)
110 real(r8), intent(in) :: vbar(LBi:UBi,LBj:UBj,:)
111# ifdef SOLVE3D
112 real(r8), intent(in) :: u(LBi:UBi,LBj:UBj,N(ng),2)
113 real(r8), intent(in) :: v(LBi:UBi,LBj:UBj,N(ng),2)
114 real(r8), intent(in) :: z_w(LBi:UBi,LBj:UBj,0:N(ng))
115# endif
116 real(r8), intent(in) :: h(LBi:UBi,LBj:UBj)
117 real(r8), intent(in) :: on_u(LBi:UBi,LBj:UBj)
118 real(r8), intent(in) :: om_v(LBi:UBi,LBj:UBj)
119#endif
120!
121! Local variable declarations.
122!
123 integer :: Npts, NSUB, is, i, j, k, ised
124!
125 real(r8) :: Pspv = 0.0_r8
126 real(r8), save :: area_east, area_west
127 real(r8) :: cff, fac, my_area_east, my_area_west
128
129#if defined DISTRIBUTE && defined SOLVE3D
130 real(r8), dimension(Msrc(ng)*N(ng)) :: Pwrk
131#endif
132#if defined DISTRIBUTE
133 real(r8), dimension(2) :: rbuffer
134!
135 character (len=3), dimension(2) :: io_handle
136#endif
137
138#include "set_bounds.h"
139!
140!-----------------------------------------------------------------------
141! If initialization, set point Sources and/or Sinks locations.
142!-----------------------------------------------------------------------
143!
144 IF ((iic(ng).eq.ntstart(ng)).or.(iic(ng).eq.0)) THEN
145!
146! Set-up point Sources/Sink number (Nsrc), direction (Dsrc), I- and
147! J-grid locations (Isrc,Jsrc). Currently, the direction can be along
148! XI-direction (Dsrc=0) or along ETA-direction (Dsrc=1). The
149! mass sources are located at U- or V-points so the grid locations
150! should range from 1 =< Isrc =< L and 1 =< Jsrc =< M.
151!
152! Vertical mass sources can be added my setting a W-direction (Dsrc=2)
153! and mass sources are located at Rho-points so the grid locations
154! should range from 0 =< Isrc =< L and 0 =< Jsrc =< M.
155!
156#if defined RIVERPLUME1
157 IF (master.and.domain(ng)%SouthWest_Test(tile)) THEN
158 nsrc(ng)=1
159 sources(ng)%Dsrc(nsrc(ng))=0.0_r8 ! horizontal, LuvSrc=T
160 sources(ng)%Isrc(nsrc(ng))=2 ! i = 2
161 sources(ng)%Jsrc(nsrc(ng))=50 ! j = 50
162!
163 nsrc(ng)=nsrc(ng)+10 ! Add rainfall location
164 DO is=2,6
165 sources(ng)%Dsrc(is)=2.0_r8 ! vertical influx, LwSrc=T
166 sources(ng)%Isrc(is)=6 ! i = 6
167 sources(ng)%Jsrc(is)=is+25 ! j = 27 to 31
168 END DO
169 DO is=7,11
170 sources(ng)%Dsrc(is)=2.0_r8 ! vertical inclux, LwSrc=T
171 sources(ng)%Isrc(is)=7 ! i = 7
172 sources(ng)%Jsrc(is)=is+20 ! j = 27 to 31
173 END DO
174 END IF
175#elif defined RIVERPLUME2
176 IF (master.and.domain(ng)%SouthWest_Test(tile)) THEN
177 nsrc(ng)=1+lm(ng)*2
178 DO is=1,(nsrc(ng)-1)/2
179 sources(ng)%Dsrc(is)=1.0_r8
180 sources(ng)%Isrc(is)=is
181 sources(ng)%Jsrc(is)=1
182 END DO
183 DO is=(nsrc(ng)-1)/2+1,nsrc(ng)-1
184 sources(ng)%Dsrc(is)=1.0_r8
185 sources(ng)%Isrc(is)=is-lm(ng)
186 sources(ng)%Jsrc(is)=mm(ng)+1
187 END DO
188 sources(ng)%Dsrc(nsrc(ng))=0.0_r8
189 sources(ng)%Isrc(nsrc(ng))=1
190 sources(ng)%Jsrc(nsrc(ng))=60
191 END IF
192#elif defined SED_TEST1
193 IF (master.and.domain(ng)%SouthWest_Test(tile)) THEN
194 nsrc(ng)=mm(ng)*2
195 DO is=1,nsrc(ng)/2
196 sources(ng)%Dsrc(is)=0.0_r8
197 sources(ng)%Isrc(is)=1
198 sources(ng)%Jsrc(is)=is
199 END DO
200 DO is=nsrc(ng)/2+1,nsrc(ng)
201 sources(ng)%Dsrc(is)=0.0_r8
202 sources(ng)%Isrc(is)=lm(ng)+1
203 sources(ng)%Jsrc(is)=is-mm(ng)
204 END DO
205 END IF
206#else
207 ana_psource.h: no values provided for nsrc, dsrc, isrc, jsrc.
208#endif
209
210#ifdef DISTRIBUTE
211!
212! Broadcast point sources/sinks information to all nodes.
213!
214 CALL mp_bcasti (ng, inlm, nsrc(ng))
215 CALL mp_bcasti (ng, inlm, sources(ng)%Isrc)
216 CALL mp_bcasti (ng, inlm, sources(ng)%Jsrc)
217 CALL mp_bcastf (ng, inlm, sources(ng)%Dsrc)
218#endif
219 END IF
220!
221!-----------------------------------------------------------------------
222! Set momentum point Sources and/or Sinks.
223!-----------------------------------------------------------------------
224!
225 momentum : IF (luvsrc(ng).or.lwsrc(ng)) THEN
226
227#ifdef SOLVE3D
228!
229! If appropriate, set-up nondimensional shape function to distribute
230! mass point sources/sinks vertically. It must add to unity!!.
231!
232# ifdef DISTRIBUTE
233 sources(ng)%Qshape=pspv
234# endif
235 npts=msrc(ng)*n(ng)
236
237!$OMP BARRIER
238
239# if defined SED_TEST1
240 DO k=1,n(ng)
241 DO is=1,nsrc(ng)
242 i=sources(ng)%Isrc(is)
243 j=sources(ng)%Jsrc(is)
244 IF (((istrt.le.i).and.(i.le.iendt)).and. &
245 & ((jstrt.le.j).and.(j.le.jendt))) THEN
246 IF (ubar(i,j,knew).ne.0.0_r8) THEN
247 cff=abs(u(i,j,k,nnew)/ubar(i,j,knew))
248 ELSE
249 cff=1.0_r8
250 END IF
251 sources(ng)%Qshape(is,k)=cff* &
252 & (z_w(i-1,j,k )- &
253 & z_w(i-1,j,k-1 )+ &
254 & z_w(i ,j,k )- &
255 & z_w(i ,j,k-1 ))/ &
256 & (z_w(i-1,j,n(ng))- &
257 & z_w(i-1,j,0 )+ &
258 & z_w(i ,j,n(ng))- &
259 & z_w(i ,j,0 ))
260 END IF
261 END DO
262 END DO
263# ifdef DISTRIBUTE
264 pwrk=reshape(sources(ng)%Qshape,(/npts/))
265 CALL mp_collect (ng, inlm, npts, pspv, pwrk)
266 sources(ng)%Qshape=reshape(pwrk,(/msrc(ng),n(ng)/))
267# endif
268
269# elif defined RIVERPLUME1
270
271 IF (domain(ng)%NorthEast_Test(tile)) THEN
272 DO k=1,n(ng)
273 DO is=1,nsrc(ng)
274 sources(ng)%Qshape(is,k)=1.0_r8/real(n(ng),r8)
275 END DO
276 END DO
277 END IF
278
279# elif defined RIVERPLUME2
280 DO k=1,n(ng)
281 DO is=1,nsrc(ng)-1
282 i=sources(ng)%Isrc(is)
283 j=sources(ng)%Jsrc(is)
284 IF (((istrt.le.i).and.(i.le.iendt)).and. &
285 & ((jstrt.le.j).and.(j.le.jendt))) THEN
286 IF (vbar(i,j,knew).ne.0.0_r8) THEN
287 cff=abs(v(i,j,k,nnew)/vbar(i,j,knew))
288 ELSE
289 cff=1.0_r8
290 END IF
291 sources(ng)%Qshape(is,k)=cff* &
292 & (z_w(i,j-1,k )- &
293 & z_w(i,j-1,k-1 )+ &
294 & z_w(i,j ,k )- &
295 & z_w(i,j ,k-1 ))/ &
296 & (z_w(i,j-1,n(ng))- &
297 & z_w(i,j-1,0 )+ &
298 & z_w(i,j ,n(ng))- &
299 & z_w(i,j ,0 ))
300 END IF
301 END DO
302 END DO
303 IF (master.and.domain(ng)%SouthWest_Test(tile)) THEN
304 DO k=1,n(ng)
305 sources(ng)%Qshape(nsrc(ng),k)=1.0_r8/real(n(ng),r8)
306 END DO
307 END IF
308# ifdef DISTRIBUTE
309 pwrk=reshape(sources(ng)%Qshape,(/npts/))
310 CALL mp_collect (ng, inlm, npts, pspv, pwrk)
311 sources(ng)%Qshape=reshape(pwrk,(/msrc(ng),n(ng)/))
312# endif
313
314# else
315!!
316!! Notice that there is not need for distributed-memory communications
317!! here since the computation below does not have a parallel tile
318!! dependency. All the nodes are computing this simple statement.
319!!
320 IF (domain(ng)%NorthEast_Test(tile)) THEN
321 DO k=1,n(ng)
322 DO is=1,nsrc(ng)
323 sources(ng)%Qshape(is,k)=1.0_r8/real(n(ng),r8)
324 END DO
325 END DO
326 END IF
327# endif
328#endif
329!
330! Set-up vertically integrated mass transport (m3/s) of point
331! Sources/Sinks (positive in the positive U- or V-direction and
332! viceversa).
333!
334#ifdef DISTRIBUTE
335 sources(ng)%Qbar=pspv
336#endif
337
338!$OMP BARRIER
339
340#if defined RIVERPLUME1
341 IF ((tdays(ng)-dstart).lt.0.5_r8) THEN
342 fac=1.0_r8+tanh((time(ng)-43200.0_r8)/43200.0_r8)
343 ELSE
344 fac=1.0_r8
345 END IF
346 DO is=1,1 ! horizontal influx only
347 sources(ng)%Qbar(is)=fac*1500.0_r8
348 END DO
349!
350! Rainfall is 10 cm/hour.
351!
352! Qbar = 3000m * 1500m * 0.10 m/hr * 1hr/3600s = 125 m3/s
353!
354 DO is=2,nsrc(ng)
355 sources(ng)%Qbar(is)=125.0_r8
356 END DO
357
358#elif defined RIVERPLUME2
359 DO is=1,(nsrc(ng)-1)/2 ! North end
360 i=sources(ng)%Isrc(is)
361 j=sources(ng)%Jsrc(is)
362 IF (((istrt.le.i).and.(i.le.iendt)).and. &
363 & ((jstrt.le.j).and.(j.le.jendt))) THEN
364 sources(ng)%Qbar(is)=-0.05_r8*om_v(i,j)* &
365 & (0.5_r8*(zeta(i,j-1,knew)+h(i,j-1)+ &
366 & zeta(i ,j,knew)+h(i ,j)))
367 END IF
368 END DO
369 DO is=(nsrc(ng)-1)/2+1,nsrc(ng)-1 ! South end
370 i=sources(ng)%Isrc(is)
371 j=sources(ng)%Jsrc(is)
372 IF (((istrt.le.i).and.(i.le.iendt)).and. &
373 & ((jstrt.le.j).and.(j.le.jendt))) THEN
374 sources(ng)%Qbar(is)=-0.05_r8*om_v(i,j)* &
375 & (0.5_r8*(zeta(i,j-1,knew)+h(i,j-1)+ &
376 & zeta(i ,j,knew)+h(i ,j)))
377 END IF
378 END DO
379 IF (master.and.domain(ng)%SouthWest_Test(tile)) THEN
380 sources(ng)%Qbar(nsrc(ng))=1500.0_r8 ! West wall
381 END IF
382# ifdef DISTRIBUTE
383 CALL mp_collect (ng, inlm, msrc(ng), pspv, sources(ng)%Qbar)
384# endif
385
386#elif defined SED_TEST1
387 my_area_west=0.0_r8 ! West end
388 fac=-36.0_r8*10.0_r8*1.0_r8
389 DO is=1,nsrc(ng)/2
390 i=sources(ng)%Isrc(is)
391 j=sources(ng)%Jsrc(is)
392 IF (((istrt.le.i).and.(i.le.iendt)).and. &
393 & ((jstrt.le.j).and.(j.le.jendt))) THEN
394 cff=0.5_r8*(zeta(i-1,j,knew)+h(i-1,j)+ &
395 & zeta(i ,j,knew)+h(i ,j))*on_u(i,j)
396 sources(ng)%Qbar(is)=fac*cff
397 my_area_west=my_area_west+cff
398 END IF
399 END DO
400!
401 my_area_east=0.0_r8 ! East end
402 fac=-36.0_r8*10.0_r8*1.0_r8
403 DO is=nsrc(ng)/2+1,nsrc(ng)
404 i=sources(ng)%Isrc(is)
405 j=sources(ng)%Jsrc(is)
406 IF (((istrt.le.i).and.(i.le.iendt)).and. &
407 & ((jstrt.le.j).and.(j.le.jendt))) THEN
408 cff=0.5_r8*(zeta(i-1,j,knew)+h(i-1,j)+ &
409 & zeta(i ,j,knew)+h(i ,j))*on_u(i,j)
410 sources(ng)%Qbar(is)=fac*cff
411 my_area_east=my_area_east+cff
412 END IF
413 END DO
414!
415# ifdef DISTRIBUTE
416 nsub=1 ! distributed-memory
417# else
418 IF (domain(ng)%SouthWest_Corner(tile).and. &
419 & domain(ng)%NorthEast_Corner(tile)) THEN
420 nsub=1 ! non-tiled application
421 ELSE
422 nsub=ntilex(ng)*ntilee(ng) ! tiled application
423 END IF
424# endif
425!$OMP CRITICAL (PSOURCE)
426 IF (tile_count.eq.0) THEN
427 area_west=0.0_r8
428 area_east=0.0_r8
429 END IF
430 area_west=area_west+my_area_west
431 area_east=area_east+my_area_east
432 tile_count=tile_count+1
433 IF (tile_count.eq.nsub) THEN
434 tile_count=0
435# ifdef DISTRIBUTE
436 rbuffer(1)=area_west
437 rbuffer(2)=area_east
438 io_handle(1)='SUM'
439 io_handle(2)='SUM'
440 CALL mp_reduce (ng, inlm, 2, rbuffer, io_handle)
441 area_west=rbuffer(1)
442 area_east=rbuffer(1)
443# endif
444 DO is=1,nsrc(ng)/2
445 sources(ng)%Qbar(is)=sources(ng)%Qbar(is)/area_west
446 END DO
447 DO is=nsrc(ng)/2+1,nsrc(ng)
448 sources(ng)%Qbar(is)=sources(ng)%Qbar(is)/area_east
449 END DO
450 END IF
451!$OMP END CRITICAL (PSOURCE)
452
453# ifdef DISTRIBUTE
454 CALL mp_collect (ng, inlm, msrc(ng), pspv, sources(ng)%Qbar)
455# endif
456#else
457 ana_psource.h: no values provided for qbar.
458#endif
459
460#ifdef SOLVE3D
461!
462! Set-up mass transport profile (m3/s) of point Sources/Sinks.
463!
464!$OMP BARRIER
465
466 IF (domain(ng)%NorthEast_Test(tile)) THEN
467 DO k=1,n(ng)
468 DO is=1,nsrc(ng)
469 sources(ng)%Qsrc(is,k)=sources(ng)%Qbar(is)* &
470 & sources(ng)%Qshape(is,k)
471 END DO
472 END DO
473 END IF
474#endif
475 END IF momentum
476
477#ifdef SOLVE3D
478!
479!-----------------------------------------------------------------------
480! Set tracers point Sources and/or Sinks.
481!-----------------------------------------------------------------------
482!
483 tracers : IF (any(ltracersrc(:,ng))) THEN
484 sources(ng)%Tsrc=0.0_r8 ! initialize
485!
486! Set-up tracer (tracer units) point Sources/Sinks.
487!
488# if defined RIVERPLUME1
489 IF (domain(ng)%NorthEast_Test(tile)) THEN
490 DO k=1,n(ng)
491 DO is=1,nsrc(ng)
492 IF (is.eq.1) THEN
493 sources(ng)%Tsrc(is,k,itemp)=10.0_r8
494 ELSE
495 sources(ng)%Tsrc(is,k,itemp)=t0(ng)
496 END IF
497# ifdef SALINITY
498 IF (is.eq.1) THEN
499 sources(ng)%Tsrc(is,k,isalt)=0.0_r8
500 ELSE
501 sources(ng)%Tsrc(is,k,isalt)=s0(ng)
502 END IF
503# endif
504 END DO
505 END DO
506 END IF
507
508# elif defined RIVERPLUME2
509 IF (domain(ng)%NorthEast_Test(tile)) THEN
510 DO k=1,n(ng)
511 DO is=1,nsrc(ng)-1
512 sources(ng)%Tsrc(is,k,itemp)=t0(ng)
513# ifdef SALINITY
514 sources(ng)%Tsrc(is,k,isalt)=s0(ng)
515# endif
516 END DO
517 sources(ng)%Tsrc(nsrc(ng),k,itemp)=t0(ng)
518# ifdef SALINITY
519 sources(ng)%Tsrc(nsrc(ng),k,isalt)=s0(ng)
520# endif
521 END DO
522 END IF
523
524# elif defined SED_TEST1
525!
526! No tracers point sources.
527!
528# else
529 ana_psource.h: no values provided for tsrc.
530# endif
531 END IF tracers
532#endif
533!
534 RETURN
distribute_mod::mp_bcastf
Definition distribute.F:75
distribute_mod::mp_reduce
Definition distribute.F:113
mod_parallel::tile_count
integer tile_count
Definition mod_parallel.F:89
mod_param::ntilex
integer, dimension(:), allocatable ntilex
Definition mod_param.F:685
mod_param::ntilee
integer, dimension(:), allocatable ntilee
Definition mod_param.F:686
mod_scalars::luvsrc
logical, dimension(:), allocatable luvsrc
Definition mod_scalars.F:542
mod_scalars::ltracersrc
logical, dimension(:,:), allocatable ltracersrc
Definition mod_scalars.F:544
mod_scalars::lwsrc
logical, dimension(:), allocatable lwsrc
Definition mod_scalars.F:543
mod_sources
Definition mod_sources.F:2
mod_sources::sources
type(t_sources), dimension(:), allocatable sources
Definition mod_sources.F:90
mod_sources::nsrc
integer, dimension(:), allocatable nsrc
Definition mod_sources.F:97
mod_sources::msrc
integer, dimension(:), allocatable msrc
Definition mod_sources.F:96

References ana_psource(), mod_param::domain, mod_scalars::dstart, mod_scalars::iic, mod_param::inlm, mod_scalars::isalt, mod_scalars::itemp, mod_param::lm, mod_scalars::ltracersrc, mod_scalars::luvsrc, mod_scalars::lwsrc, mod_parallel::master, mod_param::mm, mod_sources::msrc, mod_sources::nsrc, mod_param::ntilee, mod_param::ntilex, mod_scalars::ntstart, mod_scalars::s0, mod_sources::sources, mod_scalars::t0, mod_scalars::tdays, mod_parallel::tile_count, and mod_scalars::time.

Referenced by ana_psource().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_rain()

subroutine analytical_mod::ana_rain ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 2 of file ana_rain.h.

3!
4!! git $Id$
5!!======================================================================
6!! Copyright (c) 2002-2025 The ROMS Group !
7!! Licensed under a MIT/X style license !
8!! See License_ROMS.md !
9!=======================================================================
10! !
11! This routine sets precipitation rate (kg/m2/s) using an !
12! analytical expression. !
13! !
14!=======================================================================
15!
16 USE mod_param
17 USE mod_forces
18 USE mod_ncparam
19!
20! Imported variable declarations.
21!
22 integer, intent(in) :: ng, tile, model
23!
24! Local variable declarations.
25!
26 character (len=*), parameter :: MyFile = &
27 & __FILE__
28!
29#include "tile.h"
30!
31 CALL ana_rain_tile (ng, tile, model, &
32 & lbi, ubi, lbj, ubj, &
33 & imins, imaxs, jmins, jmaxs, &
34 & forces(ng) % rain)
35!
36! Set analytical header file name used.
37!
38#ifdef DISTRIBUTE
39 IF (lanafile) THEN
40#else
41 IF (lanafile.and.(tile.eq.0)) THEN
42#endif
43 ananame(21)=myfile
44 END IF
45!
46 RETURN

References ana_rain_tile(), mod_ncparam::ananame, mod_forces::forces, and mod_ncparam::lanafile.

Referenced by ad_set_data_tile(), rp_set_data_tile(), set_data_tile(), and tl_set_data_tile().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_rain_tile()

subroutine analytical_mod::ana_rain_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) rain )

Definition at line 50 of file ana_rain.h.

54!***********************************************************************
55!
56 USE mod_param
57 USE mod_ncparam
58 USE mod_scalars
59!
60 USE exchange_2d_mod, ONLY : exchange_r2d_tile
61#ifdef DISTRIBUTE
62 USE mp_exchange_mod, ONLY : mp_exchange2d
63#endif
64!
65! Imported variable declarations.
66!
67 integer, intent(in) :: ng, tile, model
68 integer, intent(in) :: LBi, UBi, LBj, UBj
69 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
70!
71#ifdef ASSUMED_SHAPE
72 real(r8), intent(out) :: rain(LBi:,LBj:)
73#else
74 real(r8), intent(out) :: rain(LBi:UBi,LBj:UBj)
75#endif
76!
77! Local variable declarations.
78!
79 integer :: i, j
80
81#include "set_bounds.h"
82!
83!-----------------------------------------------------------------------
84! Set analytical precipitation rate (kg/m2/s).
85!-----------------------------------------------------------------------
86!
87 DO j=jstrt,jendt
88 DO i=istrt,iendt
89 rain(i,j)=0.0_r8
90 END DO
91 END DO
92!
93! Exchange boundary data.
94!
95 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
96 CALL exchange_r2d_tile (ng, tile, &
97 & lbi, ubi, lbj, ubj, &
98 & rain)
99 END IF
100
101#ifdef DISTRIBUTE
102 CALL mp_exchange2d (ng, tile, model, 1, &
103 & lbi, ubi, lbj, ubj, &
104 & nghostpoints, &
105 & ewperiodic(ng), nsperiodic(ng), &
106 & rain)
107#endif
108!
109 RETURN

References mod_scalars::ewperiodic, exchange_2d_mod::exchange_r2d_tile(), mp_exchange_mod::mp_exchange2d(), mod_param::nghostpoints, and mod_scalars::nsperiodic.

Referenced by ana_rain().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_respiration()

subroutine analytical_mod::ana_respiration ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 2 of file ana_respiration.h.

3!
4!! git $Id$
5!!======================================================================
6!! Copyright (c) 2002-2025 The ROMS Group !
7!! Licensed under a MIT/X style license !
8!! See License_ROMS.md !
9!=======================================================================
10! !
11! This subroutine sets respiration rate for hypoxia using analytical !
12! expressions. !
13! !
14!=======================================================================
15!
16 USE mod_param
17 USE mod_ncparam
18 USE mod_ocean
19!
20! Imported variable declarations.
21!
22 integer, intent(in) :: ng, tile, model
23!
24! Local variable declarations.
25!
26 character (len=*), parameter :: MyFile = &
27 & __FILE__
28!
29#include "tile.h"
30!
31 CALL ana_respiration_tile (ng, tile, model, &
32 & lbi, ubi, lbj, ubj, &
33 & imins, imaxs, jmins, jmaxs, &
34 & ocean(ng) % respiration)
35!
36! Set analytical header file name used.
37!
38#ifdef DISTRIBUTE
39 IF (lanafile) THEN
40#else
41 IF (lanafile.and.(tile.eq.0)) THEN
42#endif
43 ananame(30)=myfile
44 END IF
45!
46 RETURN

References ana_respiration_tile(), mod_ncparam::ananame, mod_ncparam::lanafile, and mod_ocean::ocean.

Referenced by set_data_tile().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_respiration_tile()

subroutine analytical_mod::ana_respiration_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng)), intent(out) respiration )

Definition at line 50 of file ana_respiration.h.

54!***********************************************************************
55!
56 USE mod_param
57 USE mod_scalars
58 USE mod_biology
59!
60 USE exchange_3d_mod, ONLY : exchange_r3d_tile
61#ifdef DISTRIBUTE
62 USE mp_exchange_mod, ONLY : mp_exchange3d
63#endif
64!
65! Imported variable declarations.
66!
67 integer, intent(in) :: ng, tile, model
68 integer, intent(in) :: LBi, UBi, LBj, UBj
69 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
70!
71#ifdef ASSUMED_SHAPE
72 real(r8), intent(out) :: respiration(LBi:,LBj:,:)
73#else
74 real(r8), intent(out) :: respiration(LBi:UBi,LBj:UBj,N(ng))
75#endif
76!
77! Local variable declarations.
78!
79 integer :: i, j, k
80
81#include "set_bounds.h"
82!
83!-----------------------------------------------------------------------
84! Set respiration rate (1/day).
85!-----------------------------------------------------------------------
86!
87#if defined CHESAPEAKE_1TERM
88 DO k=1,n(ng)
89 DO j=jstrt,jendt
90 DO i=istrt,iendt
91 respiration(i,j,k)=resrate(ng)
92 IF (((i.ge.72).and.(j.le.35)).or. &
93 & (((i.ge.61).and.(i.le.71)).and. &
94 & ((j.ge. 6).and.(j.le.26)))) THEN
95 respiration(i,j,k)=0.0_r8
96 END IF
97 END DO
98 END DO
99 END DO
100#else
101 DO k=1,n(ng)
102 DO j=jstrt,jendt
103 DO i=istrt,iendt
104 respiration(i,j,k)=resrate(ng)
105 END DO
106 END DO
107 END DO
108#endif
109!
110! Exchange boundary data.
111!
112 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
113 CALL exchange_r3d_tile (ng, tile, &
114 & lbi, ubi, lbj, ubj, 1, n(ng), &
115 & respiration)
116 END IF
117
118#ifdef DISTRIBUTE
119 CALL mp_exchange3d (ng, tile, model, 1, &
120 & lbi, ubi, lbj, ubj, 1, n(ng), &
121 & nghostpoints, &
122 & ewperiodic(ng), nsperiodic(ng), &
123 & respiration)
124#endif
125!
126 RETURN
exchange_3d_mod::exchange_r3d_tile
subroutine exchange_r3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, a)
Definition exchange_3d.F:283
mod_biology::resrate
real(r8), dimension(:), allocatable resrate
Definition hypoxia_srm_mod.h:33

References mod_scalars::ewperiodic, exchange_3d_mod::exchange_r3d_tile(), mp_exchange_mod::mp_exchange3d(), mod_param::nghostpoints, mod_scalars::nsperiodic, and mod_biology::resrate.

Referenced by ana_respiration().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_scope()

subroutine analytical_mod::ana_scope ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 2 of file ana_scope.h.

3!
4!! git $Id$
5!!======================================================================
6!! Copyright (c) 2002-2025 The ROMS Group !
7!! Licensed under a MIT/X style license !
8!! See License_ROMS.md !
9!=======================================================================
10! !
11! This subroutine sets analytical adjoint sensitivity spatial scope !
12! masking arrays. !
13! !
14!=======================================================================
15!
16 USE mod_param
17 USE mod_grid
18 USE mod_ncparam
19!
20! Imported variable declarations.
21!
22 integer, intent(in) :: ng, tile, model
23!
24! Local variable declarations.
25!
26 character (len=*), parameter :: MyFile = &
27 & __FILE__
28!
29#include "tile.h"
30!
31 CALL ana_scope_tile (ng, tile, model, &
32 & lbi, ubi, lbj, ubj, &
33 & imins, imaxs, jmins, jmaxs, &
34#ifdef MASKING
35 & grid(ng) % rmask, &
36 & grid(ng) % umask, &
37 & grid(ng) % vmask, &
38#endif
39 & grid(ng) % Rscope, &
40 & grid(ng) % Uscope, &
41 & grid(ng) % Vscope)
42!
43! Set analytical header file name used.
44!
45#ifdef DISTRIBUTE
46 IF (lanafile) THEN
47#else
48 IF (lanafile.and.(tile.eq.0)) THEN
49#endif
50 ananame(22)=myfile
51 END IF
52!
53 RETURN

References ana_scope_tile(), mod_ncparam::ananame, mod_grid::grid, and mod_ncparam::lanafile.

Referenced by ana_scope_tile(), and set_grid().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_scope_tile()

subroutine analytical_mod::ana_scope_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) rmask,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) umask,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) vmask,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) rscope,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) uscope,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) vscope )

Definition at line 57 of file ana_scope.h.

64!***********************************************************************
65!
66 USE mod_param
67 USE mod_scalars
68!
69 USE exchange_2d_mod
70#ifdef DISTRIBUTE
71 USE mp_exchange_mod, ONLY : mp_exchange2d
72#endif
73!
74! Imported variable declarations.
75!
76 integer, intent(in) :: ng, tile, model
77 integer, intent(in) :: LBi, UBi, LBj, UBj
78 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
79!
80#ifdef ASSUMED_SHAPE
81# ifdef MASKING
82 real(r8), intent(in) :: rmask(LBi:,LBj:)
83 real(r8), intent(in) :: umask(LBi:,LBj:)
84 real(r8), intent(in) :: vmask(LBi:,LBj:)
85# endif
86 real(r8), intent(out) :: Rscope(LBi:,LBj:)
87 real(r8), intent(out) :: Uscope(LBi:,LBj:)
88 real(r8), intent(out) :: Vscope(LBi:,LBj:)
89#else
90# ifdef MASKING
91 real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj)
92 real(r8), intent(in) :: umask(LBi:UBi,LBj:UBj)
93 real(r8), intent(in) :: vmask(LBi:UBi,LBj:UBj)
94# endif
95 real(r8), intent(out) :: Rscope(LBi:UBi,LBj:UBj)
96 real(r8), intent(out) :: Uscope(LBi:UBi,LBj:UBj)
97 real(r8), intent(out) :: Vscope(LBi:UBi,LBj:UBj)
98#endif
99!
100! Local variable declarations.
101!
102 integer :: Imin, Imax, Jmin, Jmax, i, j
103!
104 real(r8) :: scope(IminS:ImaxS,JminS:JmaxS)
105
106#include "set_bounds.h"
107!
108!-----------------------------------------------------------------------
109! Set Land/Sea mask of RHO-points: Land=0, Sea=1.
110!-----------------------------------------------------------------------
111!
112! Notice that private scratch array "mask" is used to allow
113! computation within a parallel loop.
114!
115#ifdef DOUBLE_GYRE
116 imin=-5+(lm(ng)+1)/2
117 imax=imin+10
118 jmin=-5+(mm(ng)+1)/2
119 jmax=jmin+10
120
121 DO j=jstrm2,jendp2
122 DO i=istrm2,iendp2
123 scope(i,j)=0.0_r8
124 IF (((imin.le.i).and.(i.le.imax)).and. &
125 & ((jmin.le.j).and.(j.le.jmax))) THEN
126 scope(i,j)=1.0_r8
127 END IF
128 END DO
129 END DO
130#else
131 ana_scope.h: no values provided for spatial scope masking.
132#endif
133!
134 DO j=jstrt,jendt
135 DO i=istrt,iendt
136 rscope(i,j)=scope(i,j)
137#ifdef MASKING
138 rscope(i,j)=rscope(i,j)*rmask(i,j)
139#endif
140 END DO
141 END DO
142!
143!-----------------------------------------------------------------------
144! Compute Land/Sea mask of U- and V-points.
145!-----------------------------------------------------------------------
146!
147 DO j=jstrt,jendt
148 DO i=istrp,iendt
149 uscope(i,j)=scope(i-1,j)*scope(i,j)
150#ifdef MASKING
151 uscope(i,j)=uscope(i,j)*umask(i,j)
152#endif
153 END DO
154 END DO
155 DO j=jstrp,jendt
156 DO i=istrt,iendt
157 vscope(i,j)=scope(i,j-1)*scope(i,j)
158#ifdef MASKING
159 vscope(i,j)=vscope(i,j)*vmask(i,j)
160#endif
161 END DO
162 END DO
163!
164!-----------------------------------------------------------------------
165! Exchange boundary edges.
166!-----------------------------------------------------------------------
167!
168 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
169 CALL exchange_r2d_tile (ng, tile, &
170 & lbi, ubi, lbj, ubj, &
171 & rscope)
172 CALL exchange_u2d_tile (ng, tile, &
173 & lbi, ubi, lbj, ubj, &
174 & uscope)
175 CALL exchange_v2d_tile (ng, tile, &
176 & lbi, ubi, lbj, ubj, &
177 & vscope)
178 END IF
179
180#ifdef DISTRIBUTE
181 CALL mp_exchange2d (ng, tile, model, 3, &
182 & lbi, ubi, lbj, ubj, &
183 & nghostpoints, &
184 & ewperiodic(ng), nsperiodic(ng), &
185 & rscope, uscope, vscope)
186#endif
187!
188 RETURN

References ana_scope(), mod_scalars::ewperiodic, exchange_2d_mod::exchange_r2d_tile(), exchange_2d_mod::exchange_u2d_tile(), exchange_2d_mod::exchange_v2d_tile(), mod_param::lm, mod_param::mm, mp_exchange_mod::mp_exchange2d(), mod_param::nghostpoints, and mod_scalars::nsperiodic.

Referenced by ana_scope().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_sediment()

subroutine analytical_mod::ana_sediment ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 2 of file ana_sediment.h.

3!
4!! git $Id$
5!!======================================================================
6!! Copyright (c) 2002-2025 The ROMS Group !
7!! Licensed under a MIT/X style license !
8!! See License_ROMS.md !
9!=======================================================================
10! !
11! This routine sets initial conditions for sedimen t tracer fields !
12! concentrations (kg/m3) using analytical expressions for sediment !
13! and/or bottom boundary layer configurations. It also sets initial !
14! bed conditions in each sediment layer. !
15! !
16!=======================================================================
17!
18 USE mod_param
19 USE mod_grid
20 USE mod_ncparam
21 USE mod_ocean
22 USE mod_sedbed
23!
24! Imported variable declarations.
25!
26 integer, intent(in) :: ng, tile, model
27!
28! Local variable declarations.
29!
30 character (len=*), parameter :: MyFile = &
31 & __FILE__
32!
33#include "tile.h"
34!
35 CALL ana_sediment_tile (ng, tile, model, &
36 & lbi, ubi, lbj, ubj, &
37 & imins, imaxs, jmins, jmaxs, &
38 & grid(ng) % pm, &
39 & grid(ng) % pn, &
40 & grid(ng) % xr, &
41 & grid(ng) % yr, &
42#if defined BBL_MODEL && (defined MB_BBL || defined SSW_BBL)
43 & ocean(ng) % rho, &
44#endif
45#ifdef SEDIMENT
46 & ocean(ng) % t, &
47 & sedbed(ng) % bed, &
48 & sedbed(ng) % bed_frac, &
49 & sedbed(ng) % bed_mass, &
50#endif
51 & sedbed(ng) % bottom)
52!
53! Set analytical header file name used.
54!
55#ifdef DISTRIBUTE
56 IF (lanafile) THEN
57#else
58 IF (lanafile.and.(tile.eq.0)) THEN
59#endif
60 ananame(23)=myfile
61 END IF
62!
63 RETURN
mod_sedbed
Definition sedbed_mod.h:1
mod_sedbed::sedbed
type(t_sedbed), dimension(:), allocatable sedbed
Definition sedbed_mod.h:157

References ana_sediment_tile(), mod_ncparam::ananame, mod_grid::grid, mod_ncparam::lanafile, mod_ocean::ocean, and mod_sedbed::sedbed.

Referenced by ad_initial(), ana_sediment_tile(), initial(), rp_initial(), and tl_initial().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_sediment_tile()

subroutine analytical_mod::ana_sediment_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) pm,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) pn,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) xr,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) yr,
real(r8), dimension(lbi:,lbj:,:), intent(in) rho,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),3,nt(ng)), intent(inout) t,
real(r8), dimension(lbi:ubi,lbj:ubj,nbed,mbedp), intent(out) bed,
real(r8), dimension(lbi:ubi,lbj:ubj,nbed,nst), intent(out) bed_frac,
real(r8), dimension(lbi:ubi,lbj:ubj,nbed,2,nst), intent(out) bed_mass,
real(r8), dimension(lbi:ubi,lbj:ubj,mbotp), intent(inout) bottom )

Definition at line 67 of file ana_sediment.h.

80!***********************************************************************
81!
82 USE mod_param
83 USE mod_ncparam
84 USE mod_scalars
85 USE mod_sediment
86!
87! Imported variable declarations.
88!
89 integer, intent(in) :: ng, tile, model
90 integer, intent(in) :: LBi, UBi, LBj, UBj
91 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
92!
93#ifdef ASSUMED_SHAPE
94 real(r8), intent(in) :: pm(LBi:,LBj:)
95 real(r8), intent(in) :: pn(LBi:,LBj:)
96 real(r8), intent(in) :: xr(LBi:,LBj:)
97 real(r8), intent(in) :: yr(LBi:,LBj:)
98# if defined BBL_MODEL && (defined MB_BBL || defined SSW_BBL)
99 real(r8), intent(in) :: rho(LBi:,LBj:,:)
100# endif
101# ifdef SEDIMENT
102 real(r8), intent(inout) :: t(LBi:,LBj:,:,:,:)
103 real(r8), intent(out) :: bed(LBi:,LBj:,:,:)
104 real(r8), intent(out) :: bed_frac(LBi:,LBj:,:,:)
105 real(r8), intent(out) :: bed_mass(LBi:,LBj:,:,:,:)
106# endif
107 real(r8), intent(inout) :: bottom(LBi:,LBj:,:)
108#else
109 real(r8), intent(in) :: pm(LBi:UBi,LBj:UBj)
110 real(r8), intent(in) :: pn(LBi:UBi,LBj:UBj)
111 real(r8), intent(in) :: xr(LBi:UBi,LBj:UBj)
112 real(r8), intent(in) :: yr(LBi:UBi,LBj:UBj)
113# if defined BBL_MODEL && (defined MB_BBL || defined SSW_BBL)
114 real(r8), intent(in) :: rho(LBi:,LBj:,:)
115# endif
116# ifdef SEDIMENT
117 real(r8), intent(inout) :: t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
118 real(r8), intent(out) :: bed(LBi:UBi,LBj:UBj,Nbed,MBEDP)
119 real(r8), intent(out) :: bed_frac(LBi:UBi,LBj:UBj,Nbed,NST)
120 real(r8), intent(out) :: bed_mass(LBi:UBi,LBj:UBj,Nbed,2,NST)
121# endif
122 real(r8), intent(inout) :: bottom(LBi:UBi,LBj:UBj,MBOTP)
123#endif
124!
125! Local variable declarations.
126!
127#ifdef DISTRIBUTE
128 integer :: Tstr, Tend
129#endif
130 integer :: i, ised, j, k
131!
132 real(r8) :: cff1, cff2, cff3, cff4, Kvisc, phinot
133
134#include "set_bounds.h"
135
136#if defined BBL_MODEL && !defined SEDIMENT
137!
138!-----------------------------------------------------------------------
139! If only bottom boundary layer and not sediment model, set bottom
140! sediment grain diameter (m) and density (kg/m3).
141!-----------------------------------------------------------------------
142!
143# if defined BL_TEST || defined NJ_BIGHT
144 DO j=jstrt,jendt
145 DO i=istrt,iendt
146 bottom(i,j,isd50)=0.0005_r8
147 bottom(i,j,idens)=2650.0_r8
148 END DO
149 END DO
150# elif defined LAKE_SIGNELL || defined ADRIA02
151 DO j=jstrt,jendt
152 DO i=istrt,iendt
153 bottom(i,j,isd50)=0.000150_r8 ! 150 microns
154 bottom(i,j,idens)=2650.0_r8
155 END DO
156 END DO
157# elif defined SED_TOY
158 DO j=jstrt,jendt
159 DO i=istrt,iendt
160 bottom(i,j,isd50)=0.0005_r8
161 bottom(i,j,idens)=2650.0_r8
162 END DO
163 END DO
164# else
165 ana_sediment.h: no values provided for bottom(:,:,isd50) and
166 bottom(:,:,idens)
167# endif
168
169# if defined MB_BBL || defined SSW_BBL
170# undef YALIN
171!
172!-----------------------------------------------------------------------
173! If only Blass bottom boundary layer and not sediment model, set
174! set critical (threshold) bedload stress (m2/s2).
175!-----------------------------------------------------------------------
176!
177# ifdef YALIN
178
179! For more accurate estime of critical bedload stress, consider the
180! Yalin method (Miller et. al, 1977).
181!
182 kvisc=0.0013_r8/rho0
183 DO j=jstrt,jendt
184 DO i=istrt,iendt
185 rhowater=rho(i,j,1)+1000.0_r8
186 cff=sqrt((bottom(i,j,idens)-rhowater)* &
187 & g*bottom(i,j,isd50)*bottom(i,j,isd50)* &
188 & bottom(i,j,isd50)/rhowater)/kvisc
189!! D=bottom(i,j,isd50)*g* &
190!! & ((bottom(i,j,idens)/rho0-1.0_r8)/Kvisk)**(1.0_r8/3.0_r8)
191!! theta_cr=0.3_r8./(1.0_r8+1.2_r8*D)+ &
192!! & 0.055_r8*(1.0_r8-EXP(-0.02_r8*D))
193 IF (cff.lt.100.0_r8) THEN
194 theta_cb=0.041_r8*(log(cff)**2)-0.356_r8*log(cff)-0.977_r8
195!! theta_cb=10**theta_cr
196 ELSE IF (cff.gt.3000.0_r8) THEN
197 theta_cb=0.045_r8
198 ELSE
199 theta_cb=0.132_r8*log(cff)-1.804_r8
200!! theta_cb=10.0_r8**theta_cr
201 ENDIF
202 bottom(i,j,itauc)=(bottom(i,j,idens)-rho0)*g* &
203 & bottom(i,j,isd50)*theta_cb/rho0
204 END DO
205 END DO
206# else
207 DO j=jstrt,jendt
208 DO i=istrt,iendt
209 bottom(i,j,itauc)=0.15_r8/rho0
210 END DO
211 END DO
212# endif
213!
214!-----------------------------------------------------------------------
215! If only Blass bottom boundary layer and not sediment model, set
216! sediment settling velocity (m/s).
217!-----------------------------------------------------------------------
218!
219 kvisc=0.0013_r8/rho0
220 DO j=jstrt,jendt
221 DO i=istrt,iendt
222 bottom(i,j,iwsed)=0.02_r8
223!!
224!! Consider Souslby (1997) estimate of settling velocity.
225!!
226!! D=bottom(i,j,isd50)*g* &
227!! & ((bottom(i,j,idens)/rho0-1.0)/Kvisk)**(1.0_r8/3.0_r8)
228!! bottom(i,j,iwsed)=Kvisc*(SQRT(10.36_r8*10.36_r8+
229!! & 1.049_r8*D*D*D)-10.36_r8)/bottom(i,j,isd50)
230 END DO
231 END DO
232# endif
233#endif
234
235#ifdef SEDIMENT
236!
237!-----------------------------------------------------------------------
238! Initial sediment concentrations in the water column.
239!-----------------------------------------------------------------------
240!
241 DO ised=1,nst
242 DO k=1,n(ng)
243 DO j=jstrt,jendt
244 DO i=istrt,iendt
245 t(i,j,k,1,idsed(ised))=csed(ised,ng)
246 END DO
247 END DO
248 END DO
249 END DO
250!
251!-----------------------------------------------------------------------
252! Initial sediment bed layer properties of age, thickness, porosity,
253! and initialize sediment bottom properites of ripple length, ripple
254! height, and default Zob.
255!-----------------------------------------------------------------------
256!
257# if defined LAKE_SIGNELL || defined ADRIA02
258 DO j=jstrt,jendt
259 DO i=istrt,iendt
260!
261! Set bed layer properties.
262!
263 DO k=1,nbed
264 bed(i,j,k,iaged)=time(ng)
265 bed(i,j,k,ithck)=0.10_r8
266 bed(i,j,k,iporo)=0.90_r8
267 DO ised=1,nst
268 bed_frac(i,j,k,ised)=1.0_r8/real(nst,r8)
269 END DO
270 END DO
271!
272! Set exposed sediment layer properties.
273!
274 bottom(i,j,irlen)=0.10_r8
275 bottom(i,j,irhgt)=0.01_r8
276 bottom(i,j,izdef)=zob(ng)
277 END DO
278 END DO
279# elif defined ESTUARY_TEST
280 DO j=jstrt,jendt
281 DO i=istrt,iendt
282!
283! Set bed layer properties.
284!
285 DO k=1,nbed
286 bed(i,j,k,iaged)=time(ng)
287 bed(i,j,k,ithck)=0.001_r8
288 bed(i,j,k,iporo)=0.90_r8
289 DO ised=1,nst
290 bed_frac(i,j,k,ised)=1.0_r8/real(nst,r8)
291 END DO
292 END DO
293!
294! Set exposed sediment layer properties.
295!
296 bottom(i,j,irlen)=0.10_r8
297 bottom(i,j,irhgt)=0.01_r8
298 bottom(i,j,izdef)=zob(ng)
299 END DO
300 END DO
301# elif defined INLET_TEST
302 DO j=jstrt,jendt
303 DO i=istrt,iendt
304!
305! Set bed layer properties.
306!
307 DO k=1,nbed
308 bed(i,j,k,iaged)=time(ng)
309 bed(i,j,k,ithck)=10.0_r8
310 bed(i,j,k,iporo)=0.50_r8
311 DO ised=1,nst
312 bed_frac(i,j,k,ised)=1.0_r8/real(nst,r8)
313 ENDDO
314 END DO
315!
316! Set exposed sediment layer properties.
317!
318 bottom(i,j,irlen)=0.10_r8
319 bottom(i,j,irhgt)=0.01_r8
320 bottom(i,j,izdef)=zob(ng)
321 END DO
322 END DO
323# elif defined SED_TOY
324 DO j=jstrt,jendt
325 DO i=istrt,iendt
326!
327! Set bed layer properties.
328!
329 DO k=1,nbed
330 bed(i,j,k,iaged)=time(ng)
331 bed(i,j,k,ithck)=0.01_r8
332 bed(i,j,k,iporo)=0.30_r8
333!! DO ised=1,NST
334!! bed_frac(i,j,k,ised)=1.0_r8/REAL(NST,r8)
335!! END DO
336 bed_frac(i,j,k,1)=1.0_r8
337 bed_frac(i,j,k,2)=0.0_r8
338 END DO
339!
340! Set exposed sediment layer properties.
341!
342 bottom(i,j,irlen)=0.10_r8
343 bottom(i,j,irhgt)=0.01_r8
344 bottom(i,j,izdef)=zob(ng)
345 END DO
346 END DO
347 DO j=jstrt,jendt
348 DO i=istrt,iendt
349 END DO
350 END DO
351# elif defined SED_TEST1
352 DO j=jstrt,jendt
353 DO i=istrt,iendt
354!
355! Set bed layer properties.
356!
357 DO k=1,nbed
358 bed(i,j,k,iaged)=time(ng)
359 bed(i,j,k,ithck)=15.00_r8
360 bed(i,j,k,iporo)=0.50_r8
361 DO ised=1,nst
362 bed_frac(i,j,k,ised)=1.0_r8/real(nst,r8)
363 END DO
364 END DO
365!
366! Set exposed sediment layer properties.
367!
368 bottom(i,j,irlen)=0.10_r8
369 bottom(i,j,irhgt)=0.01_r8
370 bottom(i,j,izdef)=zob(ng)
371 END DO
372 END DO
373# elif defined SHOREFACE
374 DO j=jstrt,jendt
375 DO i=istrt,iendt
376!
377! Set bed layer properties.
378!
379 DO k=1,nbed
380 bed(i,j,k,iaged)=time(ng)
381 bed(i,j,k,ithck)=5.0_r8
382 bed(i,j,k,iporo)=0.50_r8
383 DO ised=1,nst
384 bed_frac(i,j,k,ised)=1.0_r8/real(nst,r8)
385 END DO
386 END DO
387!
388! Set exposed sediment layer properties.
389!
390 bottom(i,j,irlen)=0.10_r8
391 bottom(i,j,irhgt)=0.01_r8
392 bottom(i,j,izdef)=zob(ng)
393 END DO
394 END DO
395# elif defined TEST_CHAN
396 DO j=jstrt,jendt
397 DO i=istrt,iendt
398!
399! Set bed layer properties.
400!
401 DO k=1,nbed
402 bed(i,j,k,iaged)=time(ng)
403 bed(i,j,k,ithck)=1.0_r8
404 bed(i,j,k,iporo)=0.90_r8
405 DO ised=1,nst
406 bed_frac(i,j,k,ised)=1.0_r8/real(nst,r8)
407 END DO
408 END DO
409!
410! Set exposed sediment layer properties.
411!
412 bottom(i,j,irlen)=0.0_r8
413 bottom(i,j,irhgt)=0.0_r8
414 bottom(i,j,izdef)=zob(ng)
415 END DO
416 END DO
417# else
418 ana_sediment.h: no values provided for bed, bed_mass, bottom.
419# endif
420!
421!-----------------------------------------------------------------------
422! Initial sediment bed_mass and surface layer properties.
423! Same for all applications.
424!-----------------------------------------------------------------------
425!
426 DO k=1,nbed
427 DO j=jstrt,jendt
428 DO i=istrt,iendt
429!
430! Calculate mass so it is consistent with density, thickness, and
431! porosity.
432!
433 DO ised=1,nst
434 bed_mass(i,j,k,1,ised)=bed(i,j,k,ithck)* &
435 & srho(ised,ng)* &
436 & (1.0_r8-bed(i,j,k,iporo))* &
437 & bed_frac(i,j,k,ised)
438 END DO
439 END DO
440 END DO
441 END DO
442!
443! Set exposed sediment layer properties.
444!
445 DO j=jstrt,jendt
446 DO i=istrt,iendt
447 cff1=1.0_r8
448 cff2=1.0_r8
449 cff3=1.0_r8
450 cff4=1.0_r8
451 DO ised=1,nst
452 cff1=cff1*sd50(ised,ng)**bed_frac(i,j,1,ised)
453 cff2=cff2*srho(ised,ng)**bed_frac(i,j,1,ised)
454 cff3=cff3*wsed(ised,ng)**bed_frac(i,j,1,ised)
455 cff4=cff4*tau_ce(ised,ng)**bed_frac(i,j,1,ised)
456 END DO
457 bottom(i,j,isd50)=cff1
458 bottom(i,j,idens)=cff2
459 bottom(i,j,iwsed)=cff3
460 bottom(i,j,itauc)=cff4
461# ifdef SED_BIODIFF
462 bottom(i,j,idoff)=0.0_r8
463 bottom(i,j,idslp)=0.0_r8
464 bottom(i,j,idtim)=0.0_r8
465 bottom(i,j,idbmx)=0.0_r8
466 bottom(i,j,idbmm)=0.0_r8
467 bottom(i,j,idbzs)=0.0_r8
468 bottom(i,j,idbzm)=0.0_r8
469 bottom(i,j,idbzp)=0.0_r8
470# endif
471 END DO
472 END DO
473#endif
474!
475 RETURN
mod_param::nbed
integer nbed
Definition mod_param.F:517
mod_param::nst
integer nst
Definition mod_param.F:521
mod_sediment::iwsed
integer, parameter iwsed
Definition sediment_mod.h:126
mod_sediment::irlen
integer, parameter irlen
Definition sediment_mod.h:128
mod_sediment::idbzs
integer, parameter idbzs
Definition sediment_mod.h:148
mod_sediment::irhgt
integer, parameter irhgt
Definition sediment_mod.h:129
mod_sediment::iaged
integer, parameter iaged
Definition sediment_mod.h:117
mod_sediment::srho
real(r8), dimension(:,:), allocatable srho
Definition sediment_mod.h:174
mod_sediment::idbmx
integer, parameter idbmx
Definition sediment_mod.h:146
mod_sediment::idsed
integer, dimension(:), allocatable idsed
Definition sediment_mod.h:88
mod_sediment::iporo
integer, parameter iporo
Definition sediment_mod.h:118
mod_sediment::idslp
integer, parameter idslp
Definition sediment_mod.h:144
mod_sediment::idens
integer, parameter idens
Definition sediment_mod.h:125
mod_sediment::isd50
integer, parameter isd50
Definition sediment_mod.h:124
mod_sediment::idtim
integer, parameter idtim
Definition sediment_mod.h:145
mod_sediment::idbzp
integer, parameter idbzp
Definition sediment_mod.h:150
mod_sediment::sd50
real(r8), dimension(:,:), allocatable sd50
Definition sediment_mod.h:173
mod_sediment::wsed
real(r8), dimension(:,:), allocatable wsed
Definition sediment_mod.h:175
mod_sediment::idoff
integer, parameter idoff
Definition sediment_mod.h:143
mod_sediment::itauc
integer, parameter itauc
Definition sediment_mod.h:127
mod_sediment::ithck
integer, parameter ithck
Definition sediment_mod.h:116
mod_sediment::idbzm
integer, parameter idbzm
Definition sediment_mod.h:149
mod_sediment::tau_ce
real(r8), dimension(:,:), allocatable tau_ce
Definition sediment_mod.h:177
mod_sediment::idbmm
integer, parameter idbmm
Definition sediment_mod.h:147
mod_sediment::csed
real(r8), dimension(:,:), allocatable csed
Definition sediment_mod.h:171

References ana_sediment(), mod_sediment::csed, mod_scalars::g, mod_sediment::iaged, mod_sediment::idbmm, mod_sediment::idbmx, mod_sediment::idbzm, mod_sediment::idbzp, mod_sediment::idbzs, mod_sediment::idens, mod_sediment::idoff, mod_sediment::idsed, mod_sediment::idslp, mod_sediment::idtim, mod_sediment::iporo, mod_sediment::irhgt, mod_sediment::irlen, mod_sediment::isd50, mod_sediment::itauc, mod_sediment::ithck, mod_sediment::iwsed, mod_sediment::izdef, mod_scalars::rho0, mod_sediment::sd50, mod_sediment::srho, mod_sediment::tau_ce, mod_scalars::time, mod_sediment::wsed, and mod_scalars::zob.

Referenced by ana_sediment().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_smflux()

subroutine analytical_mod::ana_smflux ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 2 of file ana_smflux.h.

3!
4!! git $Id$
5!!======================================================================
6!! Copyright (c) 2002-2025 The ROMS Group !
7!! Licensed under a MIT/X style license !
8!! See License_ROMS.md !
9!=======================================================================
10! !
11! This routine sets kinematic surface momentum flux (wind stress) !
12! "sustr" and "svstr" (m2/s2) using an analytical expression. !
13! !
14!=======================================================================
15!
16 USE mod_param
17 USE mod_forces
18 USE mod_grid
19 USE mod_ncparam
20!
21! Imported variable declarations.
22!
23 integer, intent(in) :: ng, tile, model
24!
25! Local variable declarations.
26!
27 character (len=*), parameter :: MyFile = &
28 & __FILE__
29!
30#include "tile.h"
31!
32 CALL ana_smflux_tile (ng, tile, model, &
33 & lbi, ubi, lbj, ubj, &
34 & imins, imaxs, jmins, jmaxs, &
35 & grid(ng) % angler, &
36#ifdef SPHERICAL
37 & grid(ng) % lonr, &
38 & grid(ng) % latr, &
39#else
40 & grid(ng) % xr, &
41 & grid(ng) % yr, &
42#endif
43#ifdef TL_IOMS
44 & forces(ng) % tl_sustr, &
45 & forces(ng) % tl_svstr, &
46#endif
47 & forces(ng) % sustr, &
48 & forces(ng) % svstr)
49!
50! Set analytical header file name used.
51!
52#ifdef DISTRIBUTE
53 IF (lanafile) THEN
54#else
55 IF (lanafile.and.(tile.eq.0)) THEN
56#endif
57 ananame(24)=myfile
58 END IF
59!
60 RETURN

References ana_smflux_tile(), mod_ncparam::ananame, mod_forces::forces, mod_grid::grid, and mod_ncparam::lanafile.

Referenced by ad_set_data_tile(), rp_set_data_tile(), set_data_tile(), and tl_set_data_tile().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_smflux_tile()

subroutine analytical_mod::ana_smflux_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) angler,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) lonr,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) latr,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) xr,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) yr,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) tl_sustr,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) tl_svstr,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) sustr,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) svstr )

Definition at line 64 of file ana_smflux.h.

77!***********************************************************************
78!
79 USE mod_param
80 USE mod_scalars
81!
82 USE exchange_2d_mod
83#ifdef DISTRIBUTE
84 USE mp_exchange_mod, ONLY : mp_exchange2d
85#endif
86!
87! Imported variable declarations.
88!
89 integer, intent(in) :: ng, tile, model
90 integer, intent(in) :: LBi, UBi, LBj, UBj
91 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
92!
93#ifdef ASSUMED_SHAPE
94 real(r8), intent(in) :: angler(LBi:,LBj:)
95# ifdef SPHERICAL
96 real(r8), intent(in) :: lonr(LBi:,LBj:)
97 real(r8), intent(in) :: latr(LBi:,LBj:)
98# else
99 real(r8), intent(in) :: xr(LBi:,LBj:)
100 real(r8), intent(in) :: yr(LBi:,LBj:)
101# endif
102 real(r8), intent(out) :: sustr(LBi:,LBj:)
103 real(r8), intent(out) :: svstr(LBi:,LBj:)
104# ifdef TL_IOMS
105 real(r8), intent(out) :: tl_sustr(LBi:,LBj:)
106 real(r8), intent(out) :: tl_svstr(LBi:,LBj:)
107# endif
108#else
109 real(r8), intent(in) :: angler(LBi:UBi,LBj:UBj)
110# ifdef SPHERICAL
111 real(r8), intent(in) :: lonr(LBi:UBi,LBj:UBj)
112 real(r8), intent(in) :: latr(LBi:UBi,LBj:UBj)
113# else
114 real(r8), intent(in) :: xr(LBi:UBi,LBj:UBj)
115 real(r8), intent(in) :: yr(LBi:UBi,LBj:UBj)
116# endif
117 real(r8), intent(out) :: sustr(LBi:UBi,LBj:UBj)
118 real(r8), intent(out) :: svstr(LBi:UBi,LBj:UBj)
119# ifdef TL_IOMS
120 real(r8), intent(out) :: tl_sustr(LBi:UBi,LBj:UBj)
121 real(r8), intent(out) :: tl_svstr(LBi:UBi,LBj:UBj)
122# endif
123#endif
124!
125! Local variable declarations.
126!
127 integer :: i, j
128!
129 real(r8) :: Ewind, Nwind, cff, val1, val2, windamp, winddir
130#if defined LAKE_SIGNELL
131 real(r8) :: cff1, mxst, ramp_u, ramp_time, ramp_d
132#endif
133
134#include "set_bounds.h"
135!
136!-----------------------------------------------------------------------
137! Set kinematic surface momentum flux (wind stress) component in the
138! XI-direction (m2/s2) at horizontal U-points.
139!-----------------------------------------------------------------------
140!
141#ifdef BASIN
142 val1=5.0e-05_r8*(1.0_r8+tanh((time(ng)-6.0_r8*86400.0_r8)/ &
143 & (3.0_r8*86400.0_r8)))
144 val2=2.0_r8*pi/el(ng)
145 DO j=jstrt,jendt
146 DO i=istrp,iendt
147 sustr(i,j)=-val1*cos(val2*yr(i,j))
148# ifdef TL_IOMS
149 tl_sustr(i,j)=-val1*cos(val2*yr(i,j))
150# endif
151 END DO
152 END DO
153#elif defined BL_TEST
154 ewind=0.0_r8/rho0
155 nwind=0.3_r8/rho0
156 DO j=jstrt,jendt
157 DO i=istrt,iendt
158 sustr(i,j)=ewind
159# ifdef TL_IOMS
160 tl_sustr(i,j)=ewind
161# endif
162 END DO
163 END DO
164#elif defined CANYON
165 DO j=jstrt,jendt
166 DO i=istrp,iendt
167 sustr(i,j)=5.0e-05_r8*sin(2.0_r8*pi*tdays(ng)/10.0_r8)* &
168 & (1.0_r8-tanh((yr(i,j)-0.5_r8*el(ng))/10000.0_r8))
169# ifdef TL_IOMS
170 tl_sustr(i,j)=5.0e-05_r8*sin(2.0_r8*pi*tdays(ng)/10.0_r8)* &
171 & (1.0_r8-tanh((yr(i,j)-0.5_r8*el(ng))/10000.0_r8))
172# endif
173 END DO
174 END DO
175#elif defined CHANNEL_NECK
176!! IF ((tdays(ng)-dstart).le.4.0_r8) THEN
177!! windamp=-0.01_r8*SIN(pi*(tdays(ng)-dstart)/8.0_r8)/rho0
178!! ELSE
179 windamp=-0.01_r8/rho0
180!! END IF
181 DO j=jstrt,jendt
182 DO i=istrp,iendt
183 sustr(i,j)=windamp
184# ifdef TL_IOMS
185 tl_sustr(i,j)=windamp
186# endif
187 END DO
188 END DO
189#elif defined MIXED_LAYER
190 DO j=jstrt,jendt
191 DO i=istrp,iendt
192 sustr(i,j)=0.0001_r8 ! m2/s2
193# ifdef TL_IOMS
194 tl_sustr(i,j)=0.0001_r8 ! m2/s2
195# endif
196 END DO
197 END DO
198#elif defined DOUBLE_GYRE
199!! windamp=user(1)/rho0
200 windamp=-0.05_r8/rho0
201 val1=2.0_r8*pi/el(ng)
202 DO j=jstrt,jendt
203 DO i=istrp,iendt
204 sustr(i,j)=windamp*cos(val1*yr(i,j))
205# ifdef TL_IOMS
206 tl_sustr(i,j)=windamp*cos(val1*yr(i,j))
207# endif
208 END DO
209 END DO
210#elif defined FLT_TEST
211 DO j=jstrt,jendt
212 DO i=istrp,iendt
213 sustr(i,j)=1.0e-03_r8
214# ifdef TL_IOMS
215 tl_sustr(i,j)=1.0e-03_r8
216# endif
217 END DO
218 END DO
219#elif defined LAKE_SIGNELL
220 mxst=0.2500_r8 ! N/m2
221 ramp_u=15.0_r8 ! start ramp UP at RAMP_UP hours
222 ramp_time=10.0_r8 ! ramp from 0 to 1 over RAMP_TIME hours
223 ramp_d=50.0_r8 ! start ramp DOWN at RAMP_DOWN hours
224 DO j=jstrt,jendt
225 DO i=istrp,iendt
226 cff1=min((0.5_r8*(tanh((time(ng)/3600.0_r8-ramp_u)/ &
227 & (ramp_time/5.0_r8))+1.0_r8)), &
228 & (1.0_r8-(0.5_r8*(tanh((time(ng)/3600.0_r8-ramp_d)/ &
229 & (ramp_time/5.0_r8))+1.0_r8))))
230 sustr(i,j)=mxst/rho0*cff1
231# ifdef TL_IOMS
232 tl_sustr(i,j)=mxst/rho0*cff1
233# endif
234 END DO
235 END DO
236#elif defined LMD_TEST
237 IF (time(ng).le.57600.0_r8) THEN
238 windamp=-0.6_r8*sin(pi*time(ng)/57600.0_r8)* &
239 & sin(2.0_r8*pi*time(ng)/57600.0_r8)/rho0
240 ELSE
241 windamp=0.0_r8
242 END IF
243 DO j=jstrt,jendt
244 DO i=istrp,iendt
245 sustr(i,j)=windamp
246# ifdef TL_IOMS
247 tl_sustr(i,j)=windamp
248# endif
249 END DO
250 END DO
251#elif defined NJ_BIGHT
252!! windamp=0.086824313_r8
253!! winddir=0.5714286_r8
254!! if ((tdays(ng)-dstart).le.0.5_r8) then
255!! Ewind=windamp*winddir*SIN(pi*(tdays(ng)-dstart))/rho0
256!! Nwind=windamp*SIN(pi*(tdays(ng)-dstart))/rho0
257!! else
258!! Ewind=windamp*winddir/rho0
259!! Nwind=windamp/rho0
260!! endif
261 IF ((tdays(ng)-dstart).le.3.0_r8) THEN
262 winddir=60.0_r8
263 windamp=0.1_r8
264 ELSE IF (((tdays(ng)-dstart).gt.3.0_r8).and. &
265 & ((tdays(ng)-dstart).le.4.0_r8)) THEN
266 winddir= 60.0_r8*((tdays(ng)-dstart)-2.0_r8)- &
267 & 120.0_r8*((tdays(ng)-dstart)-2.0_r8)
268 windamp=0.0_r8
269 ELSE
270 winddir=-120.0_r8
271 windamp=0.0_r8
272 END IF
273 ewind=windamp*cos(pi*winddir/180.0_r8)/rho0
274 nwind=windamp*sin(pi*winddir/180.0_r8)/rho0
275 DO j=jstrt,jendt
276 DO i=istrp,iendt
277 val1=0.5_r8*(angler(i-1,j)+angler(i,j))
278 sustr(i,j)=ewind*cos(val1)+nwind*sin(val1)
279# ifdef TL_IOMS
280 tl_sustr(i,j)=ewind*cos(val1)+nwind*sin(val1)
281# endif
282 END DO
283 END DO
284#elif defined SED_TOY
285 DO j=jstrt,jendt
286 DO i=istrp,iendt
287 cff=0.0001_r8
288 IF (time(ng).gt.3000.0_r8) THEN
289 cff=0.0_r8
290 END IF
291 sustr(i,j)=cff
292# ifdef TL_IOMS
293 tl_sustr(i,j)=cff
294# endif
295 END DO
296 END DO
297#elif defined SHOREFACE
298 DO j=jstrt,jendt
299 DO i=istrp,iendt
300 sustr(i,j)=0.0_r8
301# ifdef TL_IOMS
302 tl_sustr(i,j)=0.0_r8
303# endif
304 END DO
305 END DO
306#elif defined UPWELLING
307 IF (nsperiodic(ng)) THEN
308 DO j=jstrt,jendt
309 DO i=istrp,iendt
310 sustr(i,j)=0.0_r8
311# ifdef TL_IOMS
312 tl_sustr(i,j)=0.0_r8
313# endif
314 END DO
315 END DO
316 ELSE IF (ewperiodic(ng)) THEN
317 IF ((tdays(ng)-dstart).le.2.0_r8) THEN
318 windamp=-0.1_r8*sin(pi*(tdays(ng)-dstart)/4.0_r8)/rho0
319 ELSE
320 windamp=-0.1_r8/rho0
321 END IF
322 DO j=jstrt,jendt
323 DO i=istrp,iendt
324 sustr(i,j)=windamp
325# ifdef TL_IOMS
326 tl_sustr(i,j)=windamp
327# endif
328 END DO
329 END DO
330 END IF
331#elif defined WINDBASIN
332 IF ((tdays(ng)-dstart).le.2.0_r8) THEN
333 windamp=-0.1_r8*sin(pi*(tdays(ng)-dstart)/4.0_r8)/rho0
334 ELSE
335 windamp=-0.1_r8/rho0
336 END IF
337 DO j=jstrt,jendt
338 DO i=istrp,iendt
339 sustr(i,j)=windamp
340# ifdef TL_IOMS
341 tl_sustr(i,j)=windamp
342# endif
343 END DO
344 END DO
345#else
346 DO j=jstrt,jendt
347 DO i=istrp,iendt
348 sustr(i,j)=0.0_r8
349# ifdef TL_IOMS
350 tl_sustr(i,j)=0.0_r8
351# endif
352 END DO
353 END DO
354#endif
355!
356!-----------------------------------------------------------------------
357! Set kinematic surface momentum flux (wind stress) component in the
358! ETA-direction (m2/s2) at horizontal V-points.
359!-----------------------------------------------------------------------
360!
361#if defined BL_TEST
362 DO j=jstrt,jendt
363 DO i=istrt,iendt
364 svstr(i,j)=nwind
365# ifdef TL_IOMS
366 tl_svstr(i,j)=nwind
367# endif
368 END DO
369 END DO
370#elif defined LMD_TEST
371 IF (time(ng).le.57600.0_r8) THEN
372 windamp=-0.6_r8*sin(pi*time(ng)/57600.0_r8)* &
373 & cos(2.0_r8*pi*time(ng)/57600.0_r8)/rho0
374 ELSE
375 windamp=0.0_r8
376 END IF
377 DO j=jstrp,jendt
378 DO i=istrt,iendt
379 svstr(i,j)=windamp
380# ifdef TL_IOMS
381 tl_svstr(i,j)=windamp
382# endif
383 END DO
384 END DO
385#elif defined NJ_BIGHT
386 DO j=jstrp,jendt
387 DO i=istrt,iendt
388 val1=0.5_r8*(angler(i,j)+angler(i,j-1))
389 svstr(i,j)=-ewind*sin(val1)+nwind*cos(val1)
390# ifdef TL_IOMS
391 tl_svstr(i,j)=-ewind*sin(val1)+nwind*cos(val1)
392# endif
393 END DO
394 END DO
395#elif defined SED_TOY
396 DO j=jstrp,jendt
397 DO i=istrt,iendt
398 svstr(i,j)=0.0_r8
399# ifdef TL_IOMS
400 tl_svstr(i,j)=0.0_r8
401# endif
402 END DO
403 END DO
404#elif defined SHOREFACE
405 DO j=jstrp,jendt
406 DO i=istrt,iendt
407 svstr(i,j)=0.0_r8
408# ifdef TL_IOMS
409 tl_svstr(i,j)=0.0_r8
410# endif
411 END DO
412 END DO
413#elif defined UPWELLING
414 IF (nsperiodic(ng)) THEN
415 IF ((tdays(ng)-dstart).le.2.0_r8) THEN
416 windamp=-0.1_r8*sin(pi*(tdays(ng)-dstart)/4.0_r8)/rho0
417 ELSE
418 windamp=-0.1_r8/rho0
419 END IF
420 DO j=jstrp,jendt
421 DO i=istrt,iendt
422 svstr(i,j)=windamp
423# ifdef TL_IOMS
424 tl_svstr(i,j)=windamp
425# endif
426 END DO
427 END DO
428 ELSE IF (ewperiodic(ng)) THEN
429 DO j=jstrp,jendt
430 DO i=istrt,iendt
431 svstr(i,j)=0.0_r8
432# ifdef TL_IOMS
433 tl_svstr(i,j)=0.0_r8
434# endif
435 END DO
436 END DO
437 END IF
438#else
439 DO j=jstrp,jendt
440 DO i=istrt,iendt
441 svstr(i,j)=0.0_r8
442# ifdef TL_IOMS
443 tl_svstr(i,j)=0.0_r8
444# endif
445 END DO
446 END DO
447#endif
448!
449! Exchange boundary data.
450!
451 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
452 CALL exchange_u2d_tile (ng, tile, &
453 & lbi, ubi, lbj, ubj, &
454 & sustr)
455#ifdef TL_IOMS
456 CALL exchange_u2d_tile (ng, tile, &
457 & lbi, ubi, lbj, ubj, &
458 & tl_sustr)
459#endif
460 CALL exchange_v2d_tile (ng, tile, &
461 & lbi, ubi, lbj, ubj, &
462 & svstr)
463#ifdef TL_IOMS
464 CALL exchange_v2d_tile (ng, tile, &
465 & lbi, ubi, lbj, ubj, &
466 & tl_svstr)
467#endif
468 END IF
469
470#ifdef DISTRIBUTE
471 CALL mp_exchange2d (ng, tile, model, 2, &
472 & lbi, ubi, lbj, ubj, &
473 & nghostpoints, &
474 & ewperiodic(ng), nsperiodic(ng), &
475 & sustr, svstr)
476# ifdef TL_IOMS
477 CALL mp_exchange2d (ng, tile, model, 2, &
478 & lbi, ubi, lbj, ubj, &
479 & nghostpoints, &
480 & ewperiodic(ng), nsperiodic(ng), &
481 & tl_sustr, tl_svstr)
482# endif
483#endif
484!
485 RETURN

References mod_scalars::dstart, mod_scalars::el, mod_scalars::ewperiodic, exchange_2d_mod::exchange_u2d_tile(), exchange_2d_mod::exchange_v2d_tile(), mp_exchange_mod::mp_exchange2d(), mod_param::nghostpoints, mod_scalars::nsperiodic, mod_scalars::pi, mod_scalars::rho0, mod_scalars::tdays, and mod_scalars::time.

Referenced by ana_smflux().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_specir()

subroutine analytical_mod::ana_specir ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 2 of file ana_specir.h.

3!
4!! git $Id$
5!!======================================================================
6!! Copyright (c) 2002-2025 The ROMS Group !
7!! Licensed under a MIT/X style license !
8!! See License_ROMS.md !
9!=======================================================================
10! !
11! This subroutine sets surface solar downwelling spectral irradiance !
12! at just beneath the sea surface, Ed(lambda,0-), in micromol quanta !
13! per meter squared per second. !
14! !
15! Reference: !
16! !
17! Gregg, W.W. and K.L. Carder, 1990: A simple spectral solar !
18! irradiance model for cloudless maritime atmospheres, !
19! Limmol. Oceanogr., 35(8), 1657-1675. !
20! !
21!=======================================================================
22!
23 USE mod_param
24 USE mod_forces
25 USE mod_grid
26 USE mod_ncparam
27!
28! Imported variable declarations.
29!
30 integer, intent(in) :: ng, tile, model
31!
32! Local variable declarations.
33!
34 character (len=*), parameter :: MyFile = &
35 & __FILE__
36!
37#include "tile.h"
38!
39 CALL ana_specir_tile (ng, tile, model, &
40 & lbi, ubi, lbj, ubj, &
41 & imins, imaxs, jmins, jmaxs, &
42 & grid(ng) % lonr, &
43 & grid(ng) % latr, &
44 & forces(ng) % cloud, &
45 & forces(ng) % Hair, &
46 & forces(ng) % Tair, &
47 & forces(ng) % Pair, &
48 & forces(ng) % Uwind, &
49 & forces(ng) % Vwind, &
50 & forces(ng) % SpecIr, &
51 & forces(ng) % avcos)
52!
53! Set analytical header file name used.
54!
55#ifdef DISTRIBUTE
56 IF (lanafile) THEN
57#else
58 IF (lanafile.and.(tile.eq.0)) THEN
59#endif
60 ananame(25)=myfile
61 END IF
62!
63 RETURN

References ana_specir_tile(), mod_ncparam::ananame, mod_forces::forces, mod_grid::grid, and mod_ncparam::lanafile.

Referenced by ad_set_data_tile(), rp_set_data_tile(), set_data_tile(), and tl_set_data_tile().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_specir_tile()

subroutine analytical_mod::ana_specir_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) lonr,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) latr,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) cloud,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) hair,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) tair,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) pair,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) uwind,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) vwind,
real(r8), dimension(lbi:ubi,lbj:ubj,nbands), intent(out) specir,
real(r8), dimension(lbi:ubi,lbj:ubj,nbands), intent(out) avcos )

Definition at line 67 of file ana_specir.h.

74!***********************************************************************
75!
76 USE mod_param
77 USE mod_eclight
78 USE mod_iounits
79 USE mod_scalars
80!
81 USE dateclock_mod, ONLY : caldate
82 USE exchange_3d_mod, ONLY : exchange_r3d_tile
83#ifdef DISTRIBUTE
84 USE mp_exchange_mod, ONLY : mp_exchange3d
85#endif
86!
87 implicit none
88!
89! Imported variable declarations.
90!
91 integer, intent(in) :: ng, tile, model
92 integer, intent(in) :: LBi, UBi, LBj, UBj
93 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
94!
95#ifdef ASSUMED_SHAPE
96 real(r8), intent(in) :: lonr(LBi:,LBj:)
97 real(r8), intent(in) :: latr(LBi:,LBj:)
98 real(r8), intent(in) :: cloud(LBi:,LBj:)
99 real(r8), intent(in) :: Hair(LBi:,LBj:)
100 real(r8), intent(in) :: Tair(LBi:,LBj:)
101 real(r8), intent(in) :: Pair(LBi:,LBj:)
102 real(r8), intent(in) :: Uwind(LBi:,LBj:)
103 real(r8), intent(in) :: Vwind(LBi:,LBj:)
104 real(r8), intent(out) :: SpecIr(LBi:,LBj:,:)
105 real(r8), intent(out) :: avcos(LBi:,LBj:,:)
106#else
107 real(r8), intent(in) :: lonr(LBi:UBi,LBj:UBj)
108 real(r8), intent(in) :: latr(LBi:UBi,LBj:UBj)
109 real(r8), intent(in) :: cloud(LBi:UBi,LBj:UBj)
110 real(r8), intent(in) :: Hair(LBi:UBi,LBj:UBj)
111 real(r8), intent(in) :: Tair(LBi:UBi,LBj:UBj)
112 real(r8), intent(in) :: Pair(LBi:UBi,LBj:UBj)
113 real(r8), intent(in) :: UWind(LBi:UBi,LBj:UBj)
114 real(r8), intent(in) :: Vwind(LBi:UBi,LBj:UBj)
115 real(r8), intent(out) :: SpecIr(LBi:UBi,LBj:UBj,NBands)
116 real(r8), intent(out) :: avcos(LBi:UBi,LBj:UBj,NBands)
117#endif
118!
119! Local constant declarations.
120!
121 real(r8) :: am = 1.0_r8 ! Aerosol type 1-10: ocean to land
122 real(r8) :: betalam = 0.55_r8
123 real(r8) :: p0 = 29.92_r8 ! Standard pressure (inches of Hg)
124 real(r8) :: rex = -1.6364_r8
125 real(r8) :: roair = 1200.0_r8 ! Density of air (g/m3)
126 real(r8) :: rn = 1.341_r8 ! Index of refraction of pure seawater
127 real(r8) :: vis = 15.0_r8 ! Visibility (km)
128 real(r8) :: wv = 1.5_r8 ! Precipitable water (cm): water vapor
129!
130! Local variable declarations.
131!
132 integer :: i, iband, ic, j, nc
133!
134 real(dp) :: hour, yday
135 real(r8) :: Dangle, Hangle, LatRad, LonRad
136 real(r8) :: cff, cff1, cff2
137 real(r8) :: alpha, beta, gamma, theta, rtheta, rthetar
138 real(r8) :: atra, gtra, otra, rtra, wtra
139 real(r8) :: alg, arg, asymp, cosunz, Fa
140 real(r8) :: frh, rh, rlam, rlogc
141 real(r8) :: rm, rmin, rmo, rmp, rod, rof
142 real(r8) :: ros, rospd, rosps, rpls
143 real(r8) :: sumx, sumx2, sumxy, sumy
144 real(r8) :: taa, tas, to3, wa, wspeed, zenith
145!
146 real(r8), dimension(NBands) :: Fo, Edir, Edif, Ed, qlam
147!
148 real(r8), dimension(3) :: a_arr, dndr
149 real(r8), dimension(3) :: ro = (/ 0.03_r8, 0.24_r8, 2.00_r8 /)
150 real(r8), dimension(3) :: r_arr = (/ 0.10_r8, 1.00_r8, 10.0_r8 /)
151!
152#include "set_bounds.h"
153!
154!-----------------------------------------------------------------------
155! Compute spectral irradiance: Using RADTRAN formulations.
156!-----------------------------------------------------------------------
157!
158! Get time clock day-of-year and hour.
159!
160 CALL caldate (tdays(ng), yd_dp=yday, h_dp=hour)
161!
162! Estimate solar declination angle (radians).
163!
164 dangle=23.44_dp*cos((172.0_dp-yday)*2.0_dp*pi/365.25_dp)
165 dangle=dangle*deg2rad
166!
167! Compute hour angle (radians).
168!
169 hangle=(12.0_r8-hour)*pi/12.0_r8
170!
171! Conversion constant from E to micromol quanta.
172! 1/(Plank*c*(avos#*1.0e6).
173!
174 cff=1.0e-9_r8/(6.6256e-34_r8*2.998e8_r8*6.023e17_r8)
175 DO iband=1,nbands
176 qlam(iband)=ec_wave_ab(iband)*cff
177 END DO
178!
179! Correct solar constant for Earth-Sun distance.
180!
181 cff=(1.0_dp+0.0167_dp*cos(2.0_dp*pi*(yday-3.0_dp)/365.0_dp))**2
182 DO iband=1,nbands
183 fo(iband)=ec_fobar(iband)*cff
184 END DO
185!
186! Compute spectral irradiance.
187!
188 DO j=jstrt,jendt
189 DO i=istrt,iendt
190
191 latrad=latr(i,j)*deg2rad
192 lonrad=lonr(i,j)*deg2rad
193!
194! Compute Climatological Ozone.
195!
196 to3=(235.0_r8+(150.0_r8+40.0_r8* &
197 & sin(0.9865_dp*(yday-30.0_dp)*deg2rad)+ &
198 & 20.0_r8*sin(3.0_r8*lonrad))* &
199 & sin(1.28_r8*latrad)*sin(1.28_r8*latrad))* &
200 & 0.001_r8 ! sco3 conversion
201!
202! Local daylight is a function of the declination (Dangle) and hour
203! angle adjusted for the local meridian (Hangle-lonr(i,j)*deg2rad).
204!
205 cosunz=sin(latrad)*sin(dangle)+ &
206 & cos(latrad)*cos(dangle)*cos(hangle-lonr(i,j)*deg2rad)
207 zenith=acos(cosunz)
208 theta=zenith*rad2deg
209!
210! Model for atmospheric transmittance of solar irradiance through
211! a maritime atmosphere. Computes direct and diffuse separately.
212! Includes water vapor and oxygen absorption.
213!
214! Compute atmospheric path lengths (air mass); pressure-corrected
215!
216 IF ((theta.ge.0.0_r8).and.(theta.le.90.0_r8)) THEN
217!
218! Modified March, 1994 according to Kasten and Young 1989.
219!
220 rm=1.0_r8/(cosunz+0.50572_r8*(96.07995_r8-theta)**rex)
221 rmp=rm*(pair(i,j)*0.02952756_r8)/p0
222 rmo=(1.0_r8+22.0_r8/6370.0_r8)/ &
223 & sqrt(cosunz*cosunz+44.0_r8/6370.0_r8)
224!
225! Computes aerosol parameters according to a simplified version
226! of the Navy marine aerosol model.
227!
228! Compute wind speed (24 hour mean is equal to current wind).
229!
230 wspeed=sqrt(uwind(i,j)*uwind(i,j)+vwind(i,j)*vwind(i,j))
231!
232! Relative humidity factor, frh.
233!
234 rh=hair(i,j)
235 IF (rh.ge.100.0_r8) rh=99.9_r8
236 frh=((2.0_r8-rh*0.01_r8)/ &
237 (6.0_r8*(1.0_r8-rh*0.01_r8)))**0.333_r8
238!
239! Size distribution amplitude components.
240!
241 a_arr(1)=2000.0_r8*am*am
242 a_arr(2)=5.866_r8*(wspeed-2.2_r8)
243 a_arr(3)=0.01527_r8*(wspeed-2.2_r8)*0.05_r8 !from Hughes 1987
244 IF (a_arr(2).lt.0.5_r8) a_arr(2)=0.5_r8
245 IF (a_arr(3).lt.0.000014_r8) a_arr(3)=0.000014_r8
246!
247! Compute size distribution at three selected radii according to
248! Navy method.
249!
250 cff=1.0_r8/frh
251 DO nc=1,3
252 dndr(nc)=0.0_r8
253 DO ic=1,3
254 arg=log(r_arr(nc)/(frh*ro(ic)))
255 dndr(nc)=dndr(nc)+a_arr(ic)*exp(-arg*arg)*cff
256 END DO
257 END DO
258!
259! Least squares approximation
260!
261 sumx=0.0_r8
262 sumy=0.0_r8
263 sumxy=0.0_r8
264 sumx2=0.0_r8
265 DO ic=1,3
266 cff1=log10(r_arr(ic))
267 cff2=log10(dndr(ic))
268 sumx=sumx+cff1
269 sumy=sumy+cff2
270 sumxy=sumxy+cff1*cff2
271 sumx2=sumx2+cff1*cff1
272 END DO
273 gamma=sumxy/sumx2
274 rlogc=sumy/3.0_r8-gamma*sumx/3.0_r8 ! no used
275 alpha=-(gamma+3.0_r8)
276!
277! Compute aerosol turbity coefficient, beta.
278!
279 beta=(3.91_r8/vis)*betalam**alpha
280!
281! Compute asymmetry parameter -- a function of alpha.
282!
283 IF (alpha.gt.1.2_r8) THEN
284 asymp=0.65_r8
285 ELSE IF (alpha .lt. 0.0_r8) THEN
286 asymp=0.82_r8
287 ELSE
288 asymp=-0.14167_r8*alpha+0.82_r8
289 END IF
290!
291! Single scattering albedo at 550; function of RH.
292!
293 wa=(-0.0032_r8*am+0.972_r8)*exp(0.000306_r8*rh)
294!
295! Forward scattering probability.
296!
297 alg=log(1.0_r8-asymp)
298 fa=1.0_r8-0.5_r8* &
299 & exp((alg*(1.459_r8+alg*(0.1595_r8+alg*0.4129_r8))+ &
300 & alg*(0.0783_r8+alg*(-0.3824_r8-alg*0.5874_r8))* &
301 & cosunz)*cosunz)
302!
303! Compute surface reflectance for direct (rod) and diffuse (ros)
304! components separately, as a function of theta, wind speed or
305! stress.
306!
307! Foam and diffuse reflectance
308!
309 IF (wspeed.gt.4.0_r8) THEN
310 IF (wspeed.le.7.0_r8) THEN
311 rof=roair*(0.00062_r8+0.00156_r8/wspeed)* &
312 & 0.000022_r8*wspeed*wspeed-0.00040_r8
313 ELSE
314 rof=(roair*(0.00049_r8+0.000065_r8*wspeed)* &
315 & 0.000045_r8-0.000040_r8)*wspeed*wspeed
316 END IF
317 rosps=0.057_r8
318 ELSE
319 rof=0.0_r8
320 rosps=0.066_r8
321 END IF
322!
323! Direct Fresnel reflectance for theta < 40, wspeed < 2 m/s.
324!
325 IF ((theta.lt.40.0_r8).or.(wspeed.lt.2.0_r8)) THEN
326 IF (theta.eq.0.0_r8) THEN
327 rospd=0.0211_r8
328 ELSE
329 rtheta=zenith
330 rthetar=asin(sin(rtheta)/rn)
331 rmin=rtheta-rthetar
332 rpls=rtheta+rthetar
333 rospd=0.5_r8*((sin(rmin)*sin(rmin))/ &
334 & (sin(rpls)*sin(rpls))+ &
335 & (tan(rmin)*tan(rmin))/ &
336 & (tan(rpls)*tan(rpls)))
337 END IF
338!
339! Empirical fit otherwise.
340!
341 ELSE
342 rospd=0.0253_r8*exp((-0.000714_r8*wspeed+0.0618_r8)* &
343 & (theta-40.0_r8))
344 END IF
345!
346! Reflectance totals.
347!
348 rod=rospd+rof
349 ros=rosps+rof
350!
351! Compute spectral irradiance for selected spectral bands.
352!
353 DO iband=1,nbands
354 rlam=ec_wave_ab(iband)*0.001_r8
355!
356! Transmittance, Rayleigh, by the method of Bird.
357!
358 rtra=exp(-rmp/(115.6406_r8*rlam**4-1.335_r8*rlam**2))
359!
360! Ozone.
361!
362 otra=exp(-ec_aoz(iband)*to3*rmo)
363!
364! Aerosols.
365!
366 arg=beta*rm*rlam**(-alpha)
367 atra=exp(-arg)
368 taa=exp(-(1.0_r8-wa)*arg)
369 tas=exp(-wa*arg)
370!
371! Oxygen/gases.
372!
373 gtra=exp((-1.41_r8*ec_ag(iband)*rmp)/ &
374 & ((1.0_r8+118.3_r8*ec_ag(iband)*rmp)**0.45_r8))
375!
376! Water Vapor.
377!
378 wtra=exp((-0.2385_r8*ec_aw(iband)*wv*rm)/ &
379 & ((1.0_r8+20.07_r8*ec_aw(iband)*wv*rm)**0.45_r8))
380!
381! Direct irradiance.
382!
383 edir(iband)=fo(iband)*cosunz*rtra*otra*atra*gtra* &
384 & wtra*(1.0_r8-rod)
385!
386! Total diffuse irradiance.
387!
388 edif(iband)=(1.0_r8-ros)* &
389 & fo(iband)*cosunz*gtra*wtra*otra* &
390 & (taa*0.5_r8*(1.0_r8-rtra**0.95_r8)+ &
391 & taa*fa*(1.0_r8-tas)*rtra**1.5_r8)
392!
393! Cloud effects approximations, Kasten and Czeplak (1980).
394! (See Hydrolight Technical Notes).
395!
396 IF (cloud(i,j).gt.0.25_r8) THEN
397 ed(iband)=(edir(iband)+edif(iband))* &
398 & (1.0_r8-0.75_r8*cloud(i,j)**3.4_r8)
399 edif(iband)=ed(iband)* &
400 & (0.3_r8+0.7_r8*cloud(i,j)**2.0_r8)
401 ELSE
402 ed(iband)=edir(iband)+edif(iband)
403 END IF
404!
405! Convert from W/cm/um to micromole quanta/m2/s.
406!
407 specir(i,j,iband)=ed(iband)*10.0_r8*qlam(iband)
408!
409! Correction of zenith angle after crossing air/sea interface.
410!
411 cff1=cos(asin((sin(zenith))/rn))
412 cff2=edif(iband)/ed(iband)
413 avcos(i,j,iband)=cff1*(1.0_r8-cff2)+0.86_r8*cff2
414 END DO
415 ELSE
416 DO iband=1,nbands
417 specir(i,j,iband)=0.0_r8
418 avcos(i,j,iband)=0.66564_r8
419 END DO
420 END IF
421 END DO
422 END DO
423!
424! Exchange boundary data.
425!
426 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
427 CALL exchange_r3d_tile (ng, tile, &
428 & lbi, ubi, lbj, ubj, 1, nbands, &
429 & specir)
430 CALL exchange_r3d_tile (ng, tile, &
431 & lbi, ubi, lbj, ubj, 1, nbands, &
432 & avcos)
433 END IF
434
435#ifdef DISTRIBUTE
436 CALL mp_exchange3d (ng, tile, model, 2, &
437 & lbi, ubi, lbj, ubj, 1, nbands, &
438 & nghostpoints, &
439 & ewperiodic(ng), nsperiodic(ng), &
440 & specir, avcos)
441#endif
442!
443 RETURN
mod_eclight
Definition mod_eclight.F:2
mod_scalars::rad2deg
real(dp), parameter rad2deg
Definition mod_scalars.F:815

References dateclock_mod::caldate(), mod_scalars::deg2rad, mod_scalars::ewperiodic, exchange_3d_mod::exchange_r3d_tile(), mp_exchange_mod::mp_exchange3d(), mod_param::nghostpoints, mod_scalars::nsperiodic, mod_scalars::pi, mod_scalars::rad2deg, and mod_scalars::tdays.

Referenced by ana_specir().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_spinning()

subroutine analytical_mod::ana_spinning ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 2 of file ana_spinning.h.

3!
4!! git $Id$
5!!======================================================================
6!! Copyright (c) 2002-2025 The ROMS Group !
7!! Licensed under a MIT/X style license !
8!! See License_ROMS.md !
9!=======================================================================
10! !
11! This subroutine sets time-variable rotation force as the sum of !
12! Coriolis and Centripetal accelerations. This is used in polar !
13! coordinate applications (annulus grid). !
14! !
15!=======================================================================
16!
17 USE mod_param
18 USE mod_grid
19 USE mod_ncparam
20!
21! Imported variable declarations.
22!
23 integer, intent(in) :: ng, tile, model
24!
25! Local variable declarations.
26!
27 character (len=*), parameter :: MyFile = &
28 & __FILE__
29!
30#include "tile.h"
31!
32 CALL ana_spinning_tile (ng, tile, model, &
33 & lbi, ubi, lbj, ubj, &
34 & imins, imaxs, jmins, jmaxs, &
35#ifdef SPHERICAL
36 & grid(ng) % lonr, &
37 & grid(ng) % latr, &
38#else
39 & grid(ng) % xr, &
40 & grid(ng) % yr, &
41#endif
42 & grid(ng) % f, &
43 & grid(ng) % omn, &
44 & grid(ng) % fomn)
45!
46! Set analytical header file name used.
47!
48#ifdef DISTRIBUTE
49 IF (lanafile) THEN
50#else
51 IF (lanafile.and.(tile.eq.0)) THEN
52#endif
53 ananame(26)=myfile
54 END IF
55!
56 RETURN

References ana_spinning_tile(), mod_ncparam::ananame, mod_grid::grid, and mod_ncparam::lanafile.

Referenced by ad_set_data_tile(), rp_set_data_tile(), set_data_tile(), and tl_set_data_tile().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_spinning_tile()

subroutine analytical_mod::ana_spinning_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) lonr,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) latr,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) xr,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) yr,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) f,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) omn,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) fomn )

Definition at line 60 of file ana_spinning.h.

69!***********************************************************************
70!
71 USE mod_param
72 USE mod_scalars
73!
74! Imported variable declarations.
75!
76 integer, intent(in) :: ng, tile, model
77 integer, intent(in) :: LBi, UBi, LBj, UBj
78 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
79!
80#ifdef ASSUMED_SHAPE
81 real(r8), intent(in) :: f(LBi:,LBj:)
82 real(r8), intent(in) :: omn(LBi:,LBj:)
83# ifdef SPHERICAL
84 real(r8), intent(in) :: lonr(LBi:,LBj:)
85 real(r8), intent(in) :: latr(LBi:,LBj:)
86# else
87 real(r8), intent(in) :: xr(LBi:,LBj:)
88 real(r8), intent(in) :: yr(LBi:,LBj:)
89# endif
90 real(r8), intent(out) :: fomn(LBi:,LBj:)
91#else
92 real(r8), intent(in) :: f(LBi:UBi,LBj:UBj)
93 real(r8), intent(in) :: omn(LBi:UBi,LBj:UBj)
94# ifdef SPHERICAL
95 real(r8), intent(in) :: lonr(LBi:UBi,LBj:UBj)
96 real(r8), intent(in) :: latr(LBi:UBi,LBj:UBj)
97# else
98 real(r8), intent(in) :: xr(LBi:UBi,LBj:UBj)
99 real(r8), intent(in) :: yr(LBi:UBi,LBj:UBj)
100# endif
101 real(r8), intent(out) :: fomn(LBi:UBi,LBj:UBj)
102#endif
103!
104! Local variable declarations.
105!
106#ifdef LAB_CANYON
107 real(r8), parameter :: Omega0 = 2.0_r8*pi/25.0_r8
108 real(r8), parameter :: Width = 0.20_r8
109 real(r8), parameter :: Ro = 0.10_r8
110 real(r8), parameter :: Rs = 0.55_r8
111 real(r8), parameter :: little_omega = 2.0_r8*pi/24.0_r8
112 real(r8), parameter :: Bu = 10.0_r8
113 real(r8), parameter :: hd = 0.125_r8
114
115 real(r8) :: Omega1, Omega1_of_t, Ro_t
116 real(r8) :: fcor, d_rho_dz, d_Omega1_dt, time_fac
117#endif
118
119#include "set_bounds.h"
120!
121!-----------------------------------------------------------------------
122! Compute time-varying rotation force: Coriolis plus Centripetal
123! accelerations.
124!-----------------------------------------------------------------------
125!
126#ifdef LAB_CANYON
127 fcor=2.0_r8*omega0
128 omega1=fcor*width*ro/rs
129 ro_t=little_omega/fcor
130 d_rho_dz=(1000.0_r8*bu/g)*(fcor*width/hd)**2
131 time_fac=1.0_r8+(omega1/omega0)*sin(little_omega*time(ng))
132 omega1_of_t=omega1*sin(little_omega*time(ng))
133 d_omega1_dt=omega1*little_omega*cos(little_omega*time(ng))
134!
135 DO j=jstrt,jendt
136 DO i=istrt,iendt
137 fomn(i,j)=(f(i,j)*time_fac+ &
138 & sqrt(xr(i,j)*xr(i,j)+yr(i,j)*yr(i,j))* &
139 & ((2.0_r8*omega0+omega1_of_t)*omega1_of_t))* &
140 & omn(i,j)
141 END DO
142 END DO
143#endif
144!
145 RETURN

References mod_scalars::g, mod_scalars::pi, and mod_scalars::time.

Referenced by ana_spinning().

Here is the caller graph for this function:

◆ ana_sponge()

subroutine analytical_mod::ana_sponge ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 2 of file ana_hmixcoef.h.

3!
4!! git $Id$
5!!================================================= Hernan G. Arango ===
6!! Copyright (c) 2002-2025 The ROMS Group !
7!! Licensed under a MIT/X style license !
8!! See License_ROMS.md !
9!=======================================================================
10! !
11! This routine rescales horizontal mixing coefficients according !
12! to the grid size. Also, if applicable, increases horizontal !
13! in sponge areas. !
14! !
15! WARNING: All biharmonic coefficients are assumed to have the !
16! square root taken and have m^2 s^-1/2 units. This !
17! will allow multiplying the biharmonic coefficient !
18! to harmonic operator. !
19! !
20!=======================================================================
21!
22 USE mod_param
23!
24! Imported variable declarations.
25!
26 integer, intent(in) :: ng, tile, model
27!
28! Local variable declarations.
29!
30 character (len=*), parameter :: MyFile = &
31 & __FILE__
32!
33#include "tile.h"
34!
35 CALL ana_sponge_tile (ng, tile, model, &
36 & lbi, ubi, lbj, ubj, &
37 & imins, imaxs, jmins, jmaxs)
38!
39! Set analytical header file name used.
40!
41#ifdef DISTRIBUTE
42 IF (lanafile) THEN
43#else
44 IF (lanafile.and.(tile.eq.0)) THEN
45#endif
46 ananame( 8)=myfile
47 END IF
48!
49 RETURN

References ana_sponge_tile().

Referenced by ad_initial(), roms_kernel_mod::adm_initial(), initial(), roms_kernel_mod::nlm_initial(), rp_initial(), tl_initial(), and roms_kernel_mod::tlm_initial().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_sponge_tile()

subroutine analytical_mod::ana_sponge_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs )

Definition at line 53 of file ana_hmixcoef.h.

56!***********************************************************************
57!
58 USE mod_param
59 USE mod_grid
60 USE mod_mixing
61 USE mod_scalars
62!
63 USE exchange_2d_mod
64#ifdef DISTRIBUTE
65 USE mp_exchange_mod, ONLY : mp_exchange2d
66# ifdef SOLVE3D
67 USE mp_exchange_mod, ONLY : mp_exchange3d
68# endif
69#endif
70!
71! Imported variable declarations.
72!
73 integer, intent(in) :: ng, tile, model
74 integer, intent(in) :: LBi, UBi, LBj, UBj
75 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
76!
77! Local variable declarations.
78!
79 integer :: Iwrk, i, itrc, j
80!
81 real(r8) :: cff, cff1, cff2, fac
82#ifdef WC13
83 real(r8) :: cff_t, cff_s, cff1_t, cff2_t, cff1_s, cff2_s
84#endif
85
86#include "set_bounds.h"
87!
88!-----------------------------------------------------------------------
89! Increase horizontal mixing in the sponge areas.
90!-----------------------------------------------------------------------
91
92#if defined ADRIA02
93!
94! Adriatic Sea southern sponge areas.
95!
96 fac=4.0_r8
97# if defined UV_VIS2
98 DO i=istrt,iendt
99 DO j=jstrt,min(6,jendt)
100 cff=visc2(ng)+real(6-j,r8)*(fac*visc2(ng)-visc2(ng))/6.0_r8
101 mixing(ng) % visc2_r(i,j)=cff
102 mixing(ng) % visc2_p(i,j)=cff
103 END DO
104 DO j=max(jstrt,7),jendt
105 mixing(ng) % visc2_r(i,j)=0.0_r8
106 mixing(ng) % visc2_p(i,j)=0.0_r8
107 END DO
108 END DO
109# endif
110
111# if defined TS_DIF2
112 DO itrc=1,nat
113 DO i=istrt,iendt
114 DO j=jstrt,min(6,jendt)
115 cff=tnu2(itrc,ng)+ &
116 & real(6-j,r8)*(fac*tnu2(itemp,ng)-tnu2(itemp,ng))/6.0_r8
117 mixing(ng) % diff2(i,j,itrc)=cff
118 END DO
119 DO j=max(jstrt,7),jendt
120 mixing(ng) % diff2(i,j,itrc)=0.0_r8
121 END DO
122 END DO
123 END DO
124# endif
125
126#elif defined WC13
127!
128! US West Coast sponge areas.
129!
130 iwrk=int(user(1)) ! same for sponge and nudging layers
131
132# if defined UV_VIS2
133!
134! Momentum sponge regions: sponge viscosities as in Marchesiello
135! et al 2003.
136!
137 cff1=visc2(ng)
138 cff2=100.0_r8
139!
140! Southern edge.
141!
142 DO j=jstrt,min(iwrk,jendt)
143 cff=cff1+real(iwrk-j,r8)*(cff2-cff1)/real(iwrk,r8)
144 DO i=istrt,iendt
145 mixing(ng)%visc2_r(i,j)=max(min(cff,cff2),cff1)
146 mixing(ng)%visc2_p(i,j)=max(min(cff,cff2),cff1)
147 END DO
148 END DO
149!
150! Northern edge.
151!
152 DO j=max(jstrt,mm(ng)+1-iwrk),jendt
153 cff=cff2-real(mm(ng)+1-j,r8)*(cff2-cff1)/real(iwrk,r8)
154 DO i=istrt,iendt
155 mixing(ng) % visc2_r(i,j)=max(min(cff,cff2),cff1)
156 mixing(ng) % visc2_p(i,j)=max(min(cff,cff2),cff1)
157 END DO
158 END DO
159!
160! Western edge.
161!
162 DO i=istrt,min(iwrk,iendt)
163 DO j=max(jstrt,i),min(mm(ng)+1-i,jendt)
164 cff=cff1+real(iwrk-i,r8)*(cff2-cff1)/real(iwrk,r8)
165 mixing(ng) % visc2_r(i,j)=max(min(cff,cff2),cff1)
166 mixing(ng) % visc2_p(i,j)=max(min(cff,cff2),cff1)
167 END DO
168 END DO
169# endif
170
171# if defined TS_DIF2
172!
173! Tracer sponge regions: sponge diffusivities as in Marchesiello
174! et al 2003.
175!
176 cff1_t=tnu2(itemp,ng)
177# ifdef SALINITY
178 cff1_s=tnu2(isalt,ng)
179# endif
180 cff2_t=50.0_r8
181 cff2_s=50.0_r8
182!
183! Southern edge.
184!
185 DO j=jstrt,min(iwrk,jendt)
186 cff_t=cff1_t+real(iwrk-j,r8)*(cff2_t-cff1_t)/real(iwrk,r8)
187# ifdef SALINITY
188 cff_s=cff1_s+real(iwrk-j,r8)*(cff2_s-cff1_s)/real(iwrk,r8)
189# endif
190 DO i=istrt,iendt
191 mixing(ng) % diff2(i,j,itemp)=max(min(cff_t,cff2_t),cff1_t)
192# ifdef SALINITY
193 mixing(ng) % diff2(i,j,isalt)=max(min(cff_s,cff2_s),cff1_s)
194# endif
195 END DO
196 END DO
197!
198! Northern edge.
199!
200 DO j=max(jstrt,mm(ng)+1-iwrk),jendt
201 cff_t=cff2_t-real(mm(ng)+1-j,r8)*(cff2_t-cff1_t)/real(iwrk,r8)
202# ifdef SALINITY
203 cff_s=cff2_s-real(mm(ng)+1-j,r8)*(cff2_s-cff1_s)/real(iwrk,r8)
204# endif
205 DO i=istrt,iendt
206 mixing(ng) % diff2(i,j,itemp)=max(min(cff_t,cff2_t),cff1_t)
207# ifdef SALINITY
208 mixing(ng) % diff2(i,j,isalt)=max(min(cff_s,cff2_s),cff1_s)
209# endif
210 END DO
211 END DO
212!
213! Western edge.
214!
215 DO i=istrt,min(iwrk,iendt)
216 DO j=max(jstrt,i),min(mm(ng)+1-i,jendt)
217 cff_t=cff1_t+real(iwrk-i,r8)*(cff2_t-cff1_t)/real(iwrk,r8)
218# ifdef SALINITY
219 cff_s=cff1_s+real(iwrk-i,r8)*(cff2_s-cff1_s)/real(iwrk,r8)
220# endif
221 mixing(ng) % diff2(i,j,itemp)=max(min(cff_t,cff2_t),cff1_t)
222# ifdef SALINITY
223 mixing(ng) % diff2(i,j,isalt)=max(min(cff_s,cff2_s),cff1_s)
224# endif
225 END DO
226 END DO
227# endif
228#endif
229!
230!-----------------------------------------------------------------------
231! Exchange boundary data.
232!-----------------------------------------------------------------------
233!
234!! WARNING: This section is generic for all applications. Please do not
235!! change the code below.
236!!
237#ifdef UV_VIS2
238 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
239 CALL exchange_r2d_tile (ng, tile, &
240 & lbi, ubi, lbj, ubj, &
241 & mixing(ng) % visc2_r)
242 CALL exchange_p2d_tile (ng, tile, &
243 & lbi, ubi, lbj, ubj, &
244 & mixing(ng) % visc2_p)
245 END IF
246#endif
247
248#ifdef UV_VIS4
249 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
250 CALL exchange_r2d_tile (ng, tile, &
251 & lbi, ubi, lbj, ubj, &
252 & mixing(ng) % visc4_r)
253 CALL exchange_p2d_tile (ng, tile, &
254 & lbi, ubi, lbj, ubj, &
255 & mixing(ng) % visc4_p)
256 END IF
257#endif
258
259#ifdef SOLVE3D
260# ifdef TS_DIF2
261 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
262 DO itrc=1,nt(ng)
263 CALL exchange_r2d_tile (ng, tile, &
264 & lbi, ubi, lbj, ubj, &
265 & mixing(ng) % diff2(:,:,itrc))
266 END DO
267 END IF
268# endif
269
270# ifdef TS_DIF4
271 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
272 DO itrc=1,nt(ng)
273 CALL exchange_r2d_tile (ng, tile, &
274 & lbi, ubi, lbj, ubj, &
275 & mixing(ng) % diff4(:,:,itrc))
276 END DO
277 END IF
278# endif
279#endif
280
281#ifdef DISTRIBUTE
282!
283# ifdef UV_VIS2
284 CALL mp_exchange2d (ng, tile, model, 2, &
285 & lbi, ubi, lbj, ubj, &
286 & nghostpoints, &
287 & ewperiodic(ng), nsperiodic(ng), &
288 & mixing(ng) % visc2_r, &
289 & mixing(ng) % visc2_p)
290# endif
291
292# ifdef UV_VIS4
293 CALL mp_exchange2d (ng, tile, model, 2, &
294 & lbi, ubi, lbj, ubj, &
295 & nghostpoints, &
296 & ewperiodic(ng), nsperiodic(ng), &
297 & mixing(ng) % visc4_r, &
298 & mixing(ng) % visc4_p)
299# endif
300
301# ifdef SOLVE3D
302# ifdef TS_DIF2
303 CALL mp_exchange3d (ng, tile, model, 1, &
304 & lbi, ubi, lbj, ubj, 1, nt(ng), &
305 & nghostpoints, &
306 & ewperiodic(ng), nsperiodic(ng), &
307 & mixing(ng) % diff2)
308# endif
309
310# ifdef TS_DIF4
311 CALL mp_exchange3d (ng, tile, model, 1, &
312 & lbi, ubi, lbj, ubj, 1, nt(ng), &
313 & nghostpoints, &
314 & ewperiodic(ng), nsperiodic(ng), &
315 & mixing(ng) % diff4)
316# endif
317# endif
318#endif
319!
320 RETURN
mod_mixing
Definition mod_mixing.F:2
mod_mixing::mixing
type(t_mixing), dimension(:), allocatable mixing
Definition mod_mixing.F:399
mod_scalars::tnu2
real(r8), dimension(:,:), allocatable tnu2
Definition mod_scalars.F:914
mod_scalars::visc2
real(r8), dimension(:), allocatable visc2
Definition mod_scalars.F:897

References mod_scalars::ewperiodic, exchange_2d_mod::exchange_p2d_tile(), exchange_2d_mod::exchange_r2d_tile(), mod_scalars::isalt, mod_scalars::itemp, mod_mixing::mixing, mod_param::mm, mp_exchange_mod::mp_exchange2d(), mp_exchange_mod::mp_exchange3d(), mod_param::nat, mod_param::nghostpoints, mod_scalars::nsperiodic, mod_param::nt, mod_scalars::tnu2, mod_scalars::user, and mod_scalars::visc2.

Referenced by ana_sponge().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_srflux()

subroutine analytical_mod::ana_srflux ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 2 of file ana_srflux.h.

3!
4!! git $Id$
5!!======================================================================
6!! Copyright (c) 2002-2025 The ROMS Group !
7!! Licensed under a MIT/X style license !
8!! See License_ROMS.md !
9!=======================================================================
10! !
11! This subroutine sets kinematic surface solar shortwave radiation !
12! flux "srflx" (degC m/s) using an analytical expression. !
13! !
14!=======================================================================
15!
16 USE mod_param
17 USE mod_forces
18 USE mod_grid
19 USE mod_ncparam
20!
21! Imported variable declarations.
22!
23 integer, intent(in) :: ng, tile, model
24!
25! Local variable declarations.
26!
27 character (len=*), parameter :: MyFile = &
28 & __FILE__
29!
30#include "tile.h"
31!
32 CALL ana_srflux_tile (ng, tile, model, &
33 & lbi, ubi, lbj, ubj, &
34 & imins, imaxs, jmins, jmaxs, &
35 & grid(ng) % lonr, &
36 & grid(ng) % latr, &
37#ifdef ALBEDO
38 & forces(ng) % cloud, &
39 & forces(ng) % Hair, &
40 & forces(ng) % Tair, &
41 & forces(ng) % Pair, &
42#endif
43 & forces(ng) % srflx)
44!
45! Set analytical header file name used.
46!
47#ifdef DISTRIBUTE
48 IF (lanafile) THEN
49#else
50 IF (lanafile.and.(tile.eq.0)) THEN
51#endif
52 ananame(27)=myfile
53 END IF
54!
55 RETURN

References ana_srflux_tile(), mod_ncparam::ananame, mod_forces::forces, mod_grid::grid, and mod_ncparam::lanafile.

Referenced by ad_set_data_tile(), rp_set_data_tile(), set_data_tile(), and tl_set_data_tile().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_srflux_tile()

subroutine analytical_mod::ana_srflux_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) lonr,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) latr,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) cloud,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) hair,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) tair,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) pair,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) srflx )

Definition at line 59 of file ana_srflux.h.

67!***********************************************************************
68!
69 USE mod_param
70 USE mod_scalars
71!
72 USE dateclock_mod, ONLY : caldate
73 USE exchange_2d_mod, ONLY : exchange_r2d_tile
74#ifdef DISTRIBUTE
75 USE mp_exchange_mod, ONLY : mp_exchange2d
76#endif
77!
78! Imported variable declarations.
79!
80 integer, intent(in) :: ng, tile, model
81 integer, intent(in) :: LBi, UBi, LBj, UBj
82 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
83!
84#ifdef ASSUMED_SHAPE
85 real(r8), intent(in) :: lonr(LBi:,LBj:)
86 real(r8), intent(in) :: latr(LBi:,LBj:)
87# ifdef ALBEDO
88 real(r8), intent(in) :: cloud(LBi:,LBj:)
89 real(r8), intent(in) :: Hair(LBi:,LBj:)
90 real(r8), intent(in) :: Tair(LBi:,LBj:)
91 real(r8), intent(in) :: Pair(LBi:,LBj:)
92# endif
93 real(r8), intent(out) :: srflx(LBi:,LBj:)
94#else
95 real(r8), intent(in) :: lonr(LBi:UBi,LBj:UBj)
96 real(r8), intent(in) :: latr(LBi:UBi,LBj:UBj)
97# ifdef ALBEDO
98 real(r8), intent(in) :: cloud(LBi:UBi,LBj:UBj)
99 real(r8), intent(in) :: Hair(LBi:UBi,LBj:UBj)
100 real(r8), intent(in) :: Tair(LBi:UBi,LBj:UBj)
101 real(r8), intent(in) :: Pair(LBi:UBi,LBj:UBj)
102# endif
103 real(r8), intent(out) :: srflx(LBi:UBi,LBj:UBj)
104#endif
105!
106! Local variable declarations.
107!
108 integer :: i, j
109!
110#if defined ALBEDO || defined DIURNAL_SRFLUX
111 real(dp) :: hour, yday
112 real(r8) :: Dangle, Hangle, LatRad
113 real(r8) :: cff1, cff2
114# ifdef ALBEDO
115 real(r8) :: Rsolar, e_sat, vap_p, zenith
116# endif
117#endif
118 real(r8) :: cff
119!
120 real(r8), parameter :: alb_w=0.06_r8
121
122#include "set_bounds.h"
123
124#if defined ALBEDO || defined DIURNAL_SRFLUX
125!
126!-----------------------------------------------------------------------
127! Compute shortwave radiation (degC m/s):
128!
129! ALBEDO option: Compute shortwave radiation flux using the Laevastu
130! cloud correction to the Zillman equation for cloudless
131! radiation (Parkinson and Washington 1979, JGR, 84, 311-337). Notice
132! that flux is scaled from W/m2 to degC m/s by dividing by (rho0*Cp).
133!
134! DIURNAL_SRFLUX option: Modulate shortwave radiation SRFLX (which
135! read and interpolated elsewhere) by the local
136! diurnal cycle (a function of longitude, latitude and day-of-year).
137! This option is provided for cases where SRFLX computed by SET_DATA is
138! an average over >= 24 hours. For "diurnal_srflux" to work ana_srflux
139! must be undefined. If you want a strictly analytical diurnal cycle
140! enter it explicitly at the end of this subroutine or use the "albedo"
141! option.
142!
143! For a review of shortwave radiation formulations check:
144!
145! Niemela, S., P. Raisanen, and H. Savijarvi, 2001: Comparison of
146! surface radiative flux parameterizations, Part II, Shortwave
147! radiation, Atmos. Res., 58, 141-154.
148!
149!-----------------------------------------------------------------------
150!
151! Get time clock day-of-year and hour.
152!
153 CALL caldate (tdays(ng), yd_dp=yday, h_dp=hour)
154!
155! Estimate solar declination angle (radians).
156!
157 dangle=23.44_dp*cos((172.0_dp-yday)*2.0_dp*pi/365.2425_dp)
158 dangle=dangle*deg2rad
159!
160! Compute hour angle (radians).
161!
162 hangle=(12.0_r8-hour)*pi/12.0_r8
163!
164# ifdef ALBEDO
165 rsolar=csolar/(rho0*cp)
166# endif
167 DO j=jstrt,jendt
168 DO i=istrt,iendt
169!
170! Local daylight, GMT time zone, is a function of the declination
171! (Dangle) and hour angle adjusted for the local meridian
172! (Hangle-lonr(i,j)*deg2rad).
173!
174 latrad=latr(i,j)*deg2rad
175 cff1=sin(latrad)*sin(dangle)
176 cff2=cos(latrad)*cos(dangle)
177# if defined ALBEDO
178!
179! Estimate variation in optical thickness of the atmosphere over
180! the course of a day under cloudless skies (Zillman, 1972). To
181! obtain incoming shortwave radiation multiply by (1.0-0.6*c**3),
182! where c is the fractional cloud cover.
183!
184! The equation for saturation vapor pressure is from Gill (Atmosphere-
185! Ocean Dynamics, pp 606).
186!!
187!! If specific humidity in kg/kg.
188!!
189!! vap_p=Pair(i,j)*Hair(i,j)/(0.62197_r8+0.378_r8*Hair(i,j))
190!!
191!
192 srflx(i,j)=0.0_r8
193 zenith=cff1+cff2*cos(hangle-lonr(i,j)*deg2rad)
194 IF (zenith.gt.0.0_r8) THEN
195 cff=(0.7859_r8+0.03477_r8*tair(i,j))/ &
196 & (1.0_r8+0.00412_r8*tair(i,j))
197 e_sat=10.0_r8**cff ! saturation vapor pressure (hPa=mbar)
198 vap_p=e_sat*hair(i,j) ! water vapor pressure (hPa=mbar)
199 srflx(i,j)=rsolar*zenith*zenith* &
200 & (1.0_r8-0.6_r8*cloud(i,j)**3)/ &
201 & ((zenith+2.7_r8)*vap_p*1.0e-3_r8+ &
202 & 1.085_r8*zenith+0.1_r8)
203 END IF
204!
205! Add correction for ocean albedo. Notice that the correction is not
206! needed below because it is assumed that the input (>=24h-average)
207! and 'srflx' is NET downward shortwave radiation.
208!
209 srflx(i,j)=(1.0_r8-alb_w)*srflx(i,j)
210
211# elif defined DIURNAL_SRFLUX
212!
213! SRFLX is reset on each time step in subroutine SET_DATA which
214! interpolates values in the forcing file to the current date.
215! This DIURNAL_SRFLUX option is provided so that SRFLX values
216! corresponding to a greater or equal daily average can be modulated
217! by the local length of day to produce a diurnal cycle with the
218! same daily average as the original data. This approach assumes
219! the net effect of clouds is incorporated into the SRFLX data.
220!
221! Normalization = (1/2*pi)*INTEGRAL{ABS(a+b*COS(t)) dt} from 0 to 2*pi
222! = (a*ARCCOS(-a/b)+SQRT(b**2-a**2))/pi for |a| < |b|
223!
224 IF (abs(cff1).gt.abs(cff2)) THEN
225 IF (cff1*cff2.gt.0.0_r8) THEN
226 cff=cff1 ! All day case
227 srflx(i,j)=max(0.0_r8, &
228 & srflx(i,j)/cff* &
229 & (cff1+cff2*cos(hangle-lonr(i,j)*deg2rad)))
230 ELSE
231 srflx(i,j)=0.0_r8 ! All night case
232 END IF
233 ELSE
234 cff=(cff1*acos(-cff1/cff2)+sqrt(cff2*cff2-cff1*cff1))/pi
235 srflx(i,j)=max(0.0_r8, &
236 & srflx(i,j)/cff* &
237 & (cff1+cff2*cos(hangle-lonr(i,j)*deg2rad)))
238 END IF
239# endif
240 END DO
241 END DO
242#else
243!
244!-----------------------------------------------------------------------
245! Set incoming solar shortwave radiation (degC m/s). Usually, the
246! shortwave radiation from input files is Watts/m2 and then converted
247! to degC m/s by multiplying by conversion factor 1/(rho0*Cp) during
248! reading (Fscale). However, we are already inside ROMS kernel here
249! and all the fluxes are kinematic so shortwave radiation units need
250! to be degC m/s.
251!-----------------------------------------------------------------------
252!
253 cff=1.0_r8/(rho0*cp)
254# if defined UPWELLING
255 DO j=jstrt,jendt
256 DO i=istrt,iendt
257 srflx(i,j)=cff*150.0_r8
258 END DO
259 END DO
260# else
261 DO j=jstrt,jendt
262 DO i=istrt,iendt
263 srflx(i,j)=0.0_r8
264 END DO
265 END DO
266# endif
267#endif
268!
269! Exchange boundary data.
270!
271 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
272 CALL exchange_r2d_tile (ng, tile, &
273 & lbi, ubi, lbj, ubj, &
274 & srflx)
275 END IF
276
277#ifdef DISTRIBUTE
278 CALL mp_exchange2d (ng, tile, model, 1, &
279 & lbi, ubi, lbj, ubj, &
280 & nghostpoints, &
281 & ewperiodic(ng), nsperiodic(ng), &
282 & srflx)
283#endif
284!
285 RETURN
mod_scalars::cp
real(dp) cp
Definition mod_scalars.F:456
mod_scalars::csolar
real(dp) csolar
Definition mod_scalars.F:457

References dateclock_mod::caldate(), mod_scalars::cp, mod_scalars::csolar, mod_scalars::deg2rad, mod_scalars::ewperiodic, exchange_2d_mod::exchange_r2d_tile(), mp_exchange_mod::mp_exchange2d(), mod_param::nghostpoints, mod_scalars::nsperiodic, mod_scalars::pi, mod_scalars::rho0, and mod_scalars::tdays.

Referenced by ana_srflux().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_ssh()

subroutine analytical_mod::ana_ssh ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 2 of file ana_ssh.h.

3!
4!! git $Id$
5!!======================================================================
6!! Copyright (c) 2002-2025 The ROMS Group !
7!! Licensed under a MIT/X style license !
8!! See License_ROMS.md !
9!=======================================================================
10! !
11! This routine sets analytical sea surface height climatology. !
12! !
13!=======================================================================
14!
15 USE mod_param
16 USE mod_ncparam
17!
18! Imported variable declarations.
19!
20 integer, intent(in) :: ng, tile, model
21!
22! Local variable declarations.
23!
24 character (len=*), parameter :: MyFile = &
25 & __FILE__
26!
27#include "tile.h"
28!
29 CALL ana_ssh_tile (ng, tile, model, &
30 & lbi, ubi, lbj, ubj, &
31 & imins, imaxs, jmins, jmaxs)
32!
33! Set analytical header file name used.
34!
35#ifdef DISTRIBUTE
36 IF (lanafile) THEN
37#else
38 IF (lanafile.and.(tile.eq.0)) THEN
39#endif
40 ananame(28)=myfile
41 END IF
42!
43 RETURN

References ana_ssh_tile(), mod_ncparam::ananame, and mod_ncparam::lanafile.

Referenced by ad_set_data_tile(), rp_set_data_tile(), set_data_tile(), and tl_set_data_tile().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_ssh_tile()

subroutine analytical_mod::ana_ssh_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs )

Definition at line 47 of file ana_ssh.h.

50!***********************************************************************
51!
52 USE mod_param
53 USE mod_clima
54 USE mod_scalars
55!
56 USE exchange_2d_mod, ONLY : exchange_r2d_tile
57#ifdef DISTRIBUTE
58 USE mp_exchange_mod, ONLY : mp_exchange2d
59#endif
60!
61! Imported variable declarations.
62!
63 integer, intent(in) :: ng, tile, model
64 integer, intent(in) :: LBi, UBi, LBj, UBj
65 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
66!
67! Local variable declarations.
68!
69 integer :: i, j
70
71#include "set_bounds.h"
72!
73!-----------------------------------------------------------------------
74! Set sea surface height (meters).
75!-----------------------------------------------------------------------
76!
77 IF (lsshclm(ng)) THEN
78 DO j=jstrt,jendt
79 DO i=istrt,iendt
80 clima(ng)%ssh(i,j)=???
81 END DO
82 END DO
83!
84! Exchange boundary data.
85!
86 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
87 CALL exchange_r2d_tile (ng, tile, &
88 & lbi, ubi, lbj, ubj, &
89 & clima(ng) % ssh)
90 END IF
91
92#ifdef DISTRIBUTE
93 CALL mp_exchange2d (ng, tile, model, 1, &
94 & lbi, ubi, lbj, ubj, &
95 & nghostpoints, &
96 & ewperiodic(ng), nsperiodic(ng), &
97 & clima(ng) % ssh)
98#endif
99 END IF
100!
101 RETURN
mod_scalars::lsshclm
logical, dimension(:), allocatable lsshclm
Definition mod_scalars.F:525

References mod_clima::clima, mod_scalars::ewperiodic, exchange_2d_mod::exchange_r2d_tile(), mod_scalars::lsshclm, mp_exchange_mod::mp_exchange2d(), mod_param::nghostpoints, and mod_scalars::nsperiodic.

Referenced by ana_ssh().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_sss()

subroutine analytical_mod::ana_sss ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 2 of file ana_sss.h.

3!
4!! git $Id$
5!!======================================================================
6!! Copyright (c) 2002-2025 The ROMS Group !
7!! Licensed under a MIT/X style license !
8!! See License_ROMS.md !
9!=======================================================================
10! !
11! This subroutine sets sea surface salinity SST (PSU) which is !
12! used for surface water flux correction. !
13! !
14!=======================================================================
15!
16 USE mod_param
17 USE mod_forces
18 USE mod_ncparam
19!
20! Imported variable declarations.
21!
22 integer, intent(in) :: ng, tile, model
23!
24! Local variable declarations.
25!
26 character (len=*), parameter :: MyFile = &
27 & __FILE__
28!
29#include "tile.h"
30!
31 CALL ana_sss_tile (ng, tile, model, &
32 & lbi, ubi, lbj, ubj, &
33 & imins, imaxs, jmins, jmaxs, &
34 & forces(ng) % sss)
35!
36! Set analytical header file name used.
37!
38#ifdef DISTRIBUTE
39 IF (lanafile) THEN
40#else
41 IF (lanafile.and.(tile.eq.0)) THEN
42#endif
43 ananame(29)=myfile
44 END IF
45!
46 RETURN

References ana_sss_tile(), mod_ncparam::ananame, mod_forces::forces, and mod_ncparam::lanafile.

Referenced by ad_set_data_tile(), rp_set_data_tile(), set_data_tile(), and tl_set_data_tile().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_sss_tile()

subroutine analytical_mod::ana_sss_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) sss )

Definition at line 50 of file ana_sss.h.

54!***********************************************************************
55!
56 USE mod_param
57 USE mod_scalars
58!
59 USE exchange_2d_mod, ONLY : exchange_r2d_tile
60#ifdef DISTRIBUTE
61 USE mp_exchange_mod, ONLY : mp_exchange2d
62#endif
63!
64! Imported variable declarations.
65!
66 integer, intent(in) :: ng, tile, model
67 integer, intent(in) :: LBi, UBi, LBj, UBj
68 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
69!
70#ifdef ASSUMED_SHAPE
71 real(r8), intent(out) :: sss(LBi:,LBj:)
72#else
73 real(r8), intent(out) :: sss(LBi:UBi,LBj:UBj)
74#endif
75!
76! Local variable declarations.
77!
78 integer :: i, j
79
80#include "set_bounds.h"
81!
82!-----------------------------------------------------------------------
83! Set sea surface salinity (PSU).
84!-----------------------------------------------------------------------
85!
86 DO j=jstrt,jendt
87 DO i=istrt,iendt
88 sss(i,j)=???
89 END DO
90 END DO
91!
92! Exchange boundary data.
93!
94 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
95 CALL exchange_r2d_tile (ng, tile, &
96 & lbi, ubi, lbj, ubj, &
97 & sss)
98 END IF
99
100#ifdef DISTRIBUTE
101 CALL mp_exchange2d (ng, tile, model, 1, &
102 & lbi, ubi, lbj, ubj, &
103 & nghostpoints, &
104 & ewperiodic(ng), nsperiodic(ng), &
105 & sss)
106#endif
107!
108 RETURN

References mod_scalars::ewperiodic, exchange_2d_mod::exchange_r2d_tile(), mp_exchange_mod::mp_exchange2d(), mod_param::nghostpoints, and mod_scalars::nsperiodic.

Referenced by ana_sss().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_sst()

subroutine analytical_mod::ana_sst ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 2 of file ana_sst.h.

3!
4!! git $Id$
5!!======================================================================
6!! Copyright (c) 2002-2025 The ROMS Group !
7!! Licensed under a MIT/X style license !
8!! See License_ROMS.md !
9!=======================================================================
10! !
11! This subroutine sets sea surface temperature SST (Celsius) using !
12! analytical expressions. This field is used when surface heat flux !
13! correction is activated: !
14! !
15! Q_model ~ Q + dQdSST * (T_model - SST) !
16! !
17!=======================================================================
18!
19 USE mod_param
20 USE mod_forces
21 USE mod_ncparam
22!
23! Imported variable declarations.
24!
25 integer, intent(in) :: ng, tile, model
26!
27! Local variable declarations.
28!
29 character (len=*), parameter :: MyFile = &
30 & __FILE__
31!
32#include "tile.h"
33!
34 CALL ana_sst_tile (ng, tile, model, &
35 & lbi, ubi, lbj, ubj, &
36 & imins, imaxs, jmins, jmaxs, &
37 & forces(ng) % sst)
38!
39! Set analytical header file name used.
40!
41#ifdef DISTRIBUTE
42 IF (lanafile) THEN
43#else
44 IF (lanafile.and.(tile.eq.0)) THEN
45#endif
46 ananame(30)=myfile
47 END IF
48!
49 RETURN

References ana_sst_tile(), mod_ncparam::ananame, mod_forces::forces, and mod_ncparam::lanafile.

Referenced by ad_set_data_tile(), rp_set_data_tile(), set_data_tile(), and tl_set_data_tile().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_sst_tile()

subroutine analytical_mod::ana_sst_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) sst )

Definition at line 53 of file ana_sst.h.

57!***********************************************************************
58!
59 USE mod_param
60 USE mod_scalars
61!
62 USE exchange_2d_mod, ONLY : exchange_r2d_tile
63#ifdef DISTRIBUTE
64 USE mp_exchange_mod, ONLY : mp_exchange2d
65#endif
66!
67! Imported variable declarations.
68!
69 integer, intent(in) :: ng, tile, model
70 integer, intent(in) :: LBi, UBi, LBj, UBj
71 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
72!
73#ifdef ASSUMED_SHAPE
74 real(r8), intent(out) :: sst(LBi:,LBj:)
75#else
76 real(r8), intent(out) :: sst(LBi:UBi,LBj:UBj)
77#endif
78!
79! Local variable declarations.
80!
81 integer :: i, j
82
83#include "set_bounds.h"
84!
85!-----------------------------------------------------------------------
86! Set sea surface temperature SST (Celsius).
87!-----------------------------------------------------------------------
88!
89 DO j=jstrt,jendt
90 DO i=istrt,iendt
91 sst(i,j)=???
92 END DO
93 END DO
94!
95! Exchange boundary data.
96!
97 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
98 CALL exchange_r2d_tile (ng, tile, &
99 & lbi, ubi, lbj, ubj, &
100 & sst)
101 END IF
102
103#ifdef DISTRIBUTE
104 CALL mp_exchange2d (ng, tile, model, 1, &
105 & lbi, ubi, lbj, ubj, &
106 & nghostpoints, &
107 & ewperiodic(ng), nsperiodic(ng), &
108 & sst)
109#endif
110!
111 RETURN

References mod_scalars::ewperiodic, exchange_2d_mod::exchange_r2d_tile(), mp_exchange_mod::mp_exchange2d(), mod_param::nghostpoints, and mod_scalars::nsperiodic.

Referenced by ana_sst().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_stflux()

subroutine analytical_mod::ana_stflux ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) itrc )

Definition at line 2 of file ana_stflux.h.

3!
4!! git $Id$
5!!======================================================================
6!! Copyright (c) 2002-2025 The ROMS Group !
7!! Licensed under a MIT/X style license !
8!! See License_ROMS.md !
9!=======================================================================
10! !
11! Sets surface flux of tracer type variables stflux(:,:,itrc) using !
12! analytical expressions (TracerUnits m/s). The surface fluxes are !
13! processed and loaded to state variable "stflx" in "set_vbc". !
14! !
15!=======================================================================
16!
17 USE mod_param
18 USE mod_forces
19 USE mod_ncparam
20!
21! Imported variable declarations.
22!
23 integer, intent(in) :: ng, tile, model, itrc
24!
25! Local variable declarations.
26!
27 character (len=*), parameter :: MyFile = &
28 & __FILE__
29!
30#include "tile.h"
31!
32 CALL ana_stflux_tile (ng, tile, model, itrc, &
33 & lbi, ubi, lbj, ubj, &
34 & imins, imaxs, jmins, jmaxs, &
35#ifdef SHORTWAVE
36 & forces(ng) % srflx, &
37#endif
38 & forces(ng) % stflux)
39!
40! Set analytical header file name used.
41!
42#ifdef DISTRIBUTE
43 IF (lanafile) THEN
44#else
45 IF (lanafile.and.(tile.eq.0)) THEN
46#endif
47 ananame(31)=myfile
48 END IF
49!
50 RETURN

References ana_stflux_tile(), mod_ncparam::ananame, mod_forces::forces, and mod_ncparam::lanafile.

Referenced by ad_set_data_tile(), rp_set_data_tile(), set_data_tile(), and tl_set_data_tile().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_stflux_tile()

subroutine analytical_mod::ana_stflux_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) itrc,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) srflx,
real(r8), dimension(lbi:ubi,lbj:ubj,nt(ng)), intent(inout) stflux )

Definition at line 54 of file ana_stflux.h.

61!***********************************************************************
62!
63 USE mod_param
64 USE mod_scalars
65!
66 USE exchange_2d_mod, ONLY : exchange_r2d_tile
67#ifdef DISTRIBUTE
68 USE mp_exchange_mod, ONLY : mp_exchange2d
69#endif
70!
71! Imported variable declarations.
72!
73 integer, intent(in) :: ng, tile, model, itrc
74 integer, intent(in) :: LBi, UBi, LBj, UBj
75 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
76!
77#ifdef ASSUMED_SHAPE
78# ifdef SHORTWAVE
79 real(r8), intent(in) :: srflx(LBi:,LBj:)
80# endif
81 real(r8), intent(inout) :: stflux(LBi:,LBj:,:)
82#else
83# ifdef SHORTWAVE
84 real(r8), intent(in) :: srflx(LBi:UBi,LBj:UBj)
85# endif
86 real(r8), intent(inout) :: stflux(LBi:UBi,LBj:UBj,NT(ng))
87#endif
88!
89! Local variable declarations.
90!
91 integer :: i, j
92
93#include "set_bounds.h"
94!
95!-----------------------------------------------------------------------
96! Set surface net heat flux (degC m/s) at horizontal RHO-points.
97!-----------------------------------------------------------------------
98!
99 IF (itrc.eq.itemp) THEN
100 DO j=jstrt,jendt
101 DO i=istrt,iendt
102#ifdef BL_TEST
103 stflux(i,j,itrc)=srflx(i,j)
104#else
105 stflux(i,j,itrc)=0.0_r8
106#endif
107 END DO
108 END DO
109!
110!-----------------------------------------------------------------------
111! Set surface freshwater flux (m/s) at horizontal RHO-points. The
112! scaling by surface salinity is done in "set_vbc".
113!-----------------------------------------------------------------------
114!
115 ELSE IF (itrc.eq.isalt) THEN
116 DO j=jstrt,jendt
117 DO i=istrt,iendt
118 stflux(i,j,itrc)=0.0_r8
119 END DO
120 END DO
121!
122!-----------------------------------------------------------------------
123! Set surface flux (Tunits m/s) of passive tracers at RHO-points,
124! if any.
125!-----------------------------------------------------------------------
126!
127 ELSE
128 DO j=jstrt,jendt
129 DO i=istrt,iendt
130 stflux(i,j,itrc)=0.0_r8
131 END DO
132 END DO
133 END IF
134!
135! Exchange boundary data.
136!
137 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
138 CALL exchange_r2d_tile (ng, tile, &
139 & lbi, ubi, lbj, ubj, &
140 & stflux(:,:,itrc))
141 END IF
142
143#ifdef DISTRIBUTE
144!
145 CALL mp_exchange2d (ng, tile, model, 1, &
146 & lbi, ubi, lbj, ubj, &
147 & nghostpoints, &
148 & ewperiodic(ng), nsperiodic(ng), &
149 & stflux(:,:,itrc))
150#endif
151!
152 RETURN

References mod_scalars::ewperiodic, exchange_2d_mod::exchange_r2d_tile(), mod_scalars::isalt, mod_scalars::itemp, mp_exchange_mod::mp_exchange2d(), mod_param::nghostpoints, and mod_scalars::nsperiodic.

Referenced by ana_stflux().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_tair()

subroutine analytical_mod::ana_tair ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 2 of file ana_tair.h.

3!
4!! git $Id$
5!!======================================================================
6!! Copyright (c) 2002-2025 The ROMS Group !
7!! Licensed under a MIT/X style license !
8!! See License_ROMS.md !
9!=======================================================================
10! !
11! This routine sets surface air temperature (degC) using an !
12! analytical expression. !
13! !
14!=======================================================================
15!
16 USE mod_param
17 USE mod_forces
18 USE mod_ncparam
19!
20! Imported variable declarations.
21!
22 integer, intent(in) :: ng, tile, model
23!
24! Local variable declarations.
25!
26 character (len=*), parameter :: MyFile = &
27 & __FILE__
28!
29#include "tile.h"
30!
31 CALL ana_tair_tile (ng, tile, model, &
32 & lbi, ubi, lbj, ubj, &
33 & imins, imaxs, jmins, jmaxs, &
34 & forces(ng) % Tair)
35!
36! Set analytical header file name used.
37!
38#ifdef DISTRIBUTE
39 IF (lanafile) THEN
40#else
41 IF (lanafile.and.(tile.eq.0)) THEN
42#endif
43 ananame(32)=myfile
44 END IF
45!
46 RETURN

References ana_tair_tile(), mod_ncparam::ananame, mod_forces::forces, and mod_ncparam::lanafile.

Referenced by ad_set_data_tile(), ana_tair_tile(), rp_set_data_tile(), set_data_tile(), and tl_set_data_tile().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_tair_tile()

subroutine analytical_mod::ana_tair_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) tair )

Definition at line 50 of file ana_tair.h.

54!***********************************************************************
55!
56 USE mod_param
57 USE mod_scalars
58!
59 USE exchange_2d_mod, ONLY : exchange_r2d_tile
60#ifdef DISTRIBUTE
61 USE mp_exchange_mod, ONLY : mp_exchange2d
62#endif
63!
64! Imported variable declarations.
65!
66 integer, intent(in) :: ng, tile, model
67 integer, intent(in) :: LBi, UBi, LBj, UBj
68 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
69!
70#ifdef ASSUMED_SHAPE
71 real(r8), intent(out) :: Tair(LBi:,LBj:)
72#else
73 real(r8), intent(out) :: Tair(LBi:UBi,LBj:UBj)
74#endif
75!
76! Local variable declarations.
77!
78 integer :: i, j
79
80#include "set_bounds.h"
81!
82!-----------------------------------------------------------------------
83! Set analytical surface air temperature (degC).
84!-----------------------------------------------------------------------
85!
86#if defined BENCHMARK
87 DO j=jstrt,jendt
88 DO i=istrt,iendt
89 tair(i,j)=4.0_r8
90 END DO
91 END DO
92#elif defined BL_TEST
93 DO j=jstrt,jendt
94 DO i=istrt,iendt
95 tair(i,j)=23.567_r8
96 END DO
97 END DO
98#else
99 ana_tair.h: no values provided for tair.
100#endif
101!
102! Exchange boundary data.
103!
104 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
105 CALL exchange_r2d_tile (ng, tile, &
106 & lbi, ubi, lbj, ubj, &
107 & tair)
108 END IF
109
110#ifdef DISTRIBUTE
111 CALL mp_exchange2d (ng, tile, model, 1, &
112 & lbi, ubi, lbj, ubj, &
113 & nghostpoints, &
114 & ewperiodic(ng), nsperiodic(ng), &
115 & tair)
116#endif
117!
118 RETURN

References ana_tair(), mod_scalars::ewperiodic, exchange_2d_mod::exchange_r2d_tile(), mp_exchange_mod::mp_exchange2d(), mod_param::nghostpoints, and mod_scalars::nsperiodic.

Referenced by ana_tair().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_tclima()

subroutine analytical_mod::ana_tclima ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 2 of file ana_tclima.h.

3!
4!! git $Id$
5!!======================================================================
6!! Copyright (c) 2002-2025 The ROMS Group !
7!! Licensed under a MIT/X style license !
8!! See License_ROMS.md !
9!=======================================================================
10! !
11! This routine sets analytical tracer climatology fields. !
12! !
13!=======================================================================
14!
15 USE mod_param
16 USE mod_ncparam
17!
18! Imported variable declarations.
19!
20 integer, intent(in) :: ng, tile, model
21!
22! Local variable declarations.
23!
24 character (len=*), parameter :: MyFile = &
25 & __FILE__
26!
27#include "tile.h"
28!
29 CALL ana_tclima_tile (ng, tile, model, &
30 & lbi, ubi, lbj, ubj, &
31 & imins, imaxs, jmins, jmaxs)
32!
33! Set analytical header file name used.
34!
35#ifdef DISTRIBUTE
36 IF (lanafile) THEN
37#else
38 IF (lanafile.and.(tile.eq.0)) THEN
39#endif
40 ananame(33)=myfile
41 END IF
42!
43 RETURN

References ana_tclima_tile(), mod_ncparam::ananame, and mod_ncparam::lanafile.

Referenced by ad_set_data_tile(), rp_set_data_tile(), set_data_tile(), and tl_set_data_tile().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_tclima_tile()

subroutine analytical_mod::ana_tclima_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs )

Definition at line 47 of file ana_tclima.h.

50!***********************************************************************
51!
52 USE mod_param
53 USE mod_clima
54 USE mod_grid
55 USE mod_scalars
56!
57 USE exchange_3d_mod, ONLY : exchange_r3d_tile
58#ifdef DISTRIBUTE
59 USE mp_exchange_mod, ONLY : mp_exchange4d
60#endif
61!
62! Imported variable declarations.
63!
64 integer, intent(in) :: ng, tile, model
65 integer, intent(in) :: LBi, UBi, LBj, UBj
66 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
67!
68! Local variable declarations.
69!
70 integer :: i, itrc, j, k
71!
72 real(r8) :: val1, val2, val3, val4
73
74#include "set_bounds.h"
75!
76!-----------------------------------------------------------------------
77! Set tracer climatology.
78!-----------------------------------------------------------------------
79!
80 IF (any(ltracerclm(:,ng)).or.any(lnudgetclm(:,ng))) THEN
81#if defined DOUBLE_GYRE
82 val1=(44.69_r8/39.382_r8)**2
83 val2=val1*(rho0*100.0_r8/g)* &
84 & (5.0e-5_r8/((42.689_r8/44.69_r8)**2))
85 DO k=1,n(ng)
86 DO j=jstrt,jendt
87 DO i=istrt,iendt
88 val3=t0(ng)+val2*exp(grid(ng)%z_r(i,j,k)/100.0_r8)* &
89 & (10.0_r8-0.4_r8*tanh(grid(ng)%z_r(i,j,k)/100.0_r8))
90 val4=grid(ng)%yr(i,j)/el(ng)
91 clima(ng)%tclm(i,j,k,itemp)=val3-3.0_r8*val4
92# ifdef SALINITY
93 clima(ng)%tclm(i,j,k,isalt)=34.5_r8- &
94 & 0.001_r8*grid(ng)%z_r(i,j,k)- &
95 & val4
96# endif
97 END DO
98 END DO
99 END DO
100#else
101 DO k=1,n(ng)
102 DO j=jstrt,jendt
103 DO i=istrt,iendt
104 clima(ng)%tclm(i,j,k,itemp)=???
105# ifdef SALINITY
106 clima(ng)%tclm(i,j,k,isalt)=???
107# endif
108 END DO
109 END DO
110 END DO
111#endif
112!
113! Exchange boundary data.
114!
115 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
116 DO itrc=1,ntclm(ng)
117 CALL exchange_r3d_tile (ng, tile, &
118 & lbi, ubi, lbj, ubj, 1, n(ng), &
119 & clima(ng)%tclm(:,:,:,itrc))
120 END DO
121 END IF
122
123#ifdef DISTRIBUTE
124 CALL mp_exchange4d (ng, tile, model, 1, &
125 & lbi, ubi, lbj, ubj, 1, n(ng), 1, ntclm(ng), &
126 & nghostpoints, &
127 & ewperiodic(ng), nsperiodic(ng), &
128 & clima(ng) % tclm)
129#endif
130 END IF
131!
132 RETURN
mod_scalars::ltracerclm
logical, dimension(:,:), allocatable ltracerclm
Definition mod_scalars.F:528

References mod_clima::clima, mod_scalars::el, mod_scalars::ewperiodic, exchange_3d_mod::exchange_r3d_tile(), mod_scalars::g, mod_grid::grid, mod_scalars::isalt, mod_scalars::itemp, mod_scalars::lnudgetclm, mod_scalars::ltracerclm, mp_exchange_mod::mp_exchange4d(), mod_param::n, mod_param::nghostpoints, mod_scalars::nsperiodic, mod_param::ntclm, mod_scalars::rho0, and mod_scalars::t0.

Referenced by ana_tclima().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_tlminitial_tile()

subroutine analytical_mod::ana_tlminitial_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
integer, intent(in) kstp,
integer, intent(in) nstp,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),2), intent(out) tl_u,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),2), intent(out) tl_v,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),3,nt(ng)), intent(out) tl_t,
real(r8), dimension(lbi:ubi,lbj:ubj,:), intent(out) tl_ubar,
real(r8), dimension(lbi:ubi,lbj:ubj,:), intent(out) tl_vbar,
real(r8), dimension(lbi:ubi,lbj:ubj,:), intent(out) tl_zeta )

Definition at line 896 of file ana_initial.h.

905!***********************************************************************
906!
907 USE mod_param
908 USE mod_scalars
909!
910! Imported variable declarations.
911!
912 integer, intent(in) :: ng, tile, model
913 integer, intent(in) :: LBi, UBi, LBj, UBj
914 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
915 integer, intent(in) :: kstp
916# ifdef SOLVE3D
917 integer, intent(in) :: nstp
918# endif
919!
920# ifdef ASSUMED_SHAPE
921# ifdef SOLVE3D
922 real(r8), intent(out) :: tl_u(LBi:,LBj:,:,:)
923 real(r8), intent(out) :: tl_v(LBi:,LBj:,:,:)
924 real(r8), intent(out) :: tl_t(LBi:,LBj:,:,:,:)
925# endif
926 real(r8), intent(out) :: tl_ubar(LBi:,LBj:,:)
927 real(r8), intent(out) :: tl_vbar(LBi:,LBj:,:)
928 real(r8), intent(out) :: tl_zeta(LBi:,LBj:,:)
929# else
930# ifdef SOLVE3D
931 real(r8), intent(out) :: tl_u(LBi:UBi,LBj:UBj,N(ng),2)
932 real(r8), intent(out) :: tl_v(LBi:UBi,LBj:UBj,N(ng),2)
933 real(r8), intent(out) :: tl_t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
934# endif
935 real(r8), intent(out) :: tl_ubar(LBi:UBi,LBj:UBj,:)
936 real(r8), intent(out) :: tl_vbar(LBi:UBi,LBj:UBj,:)
937 real(r8), intent(out) :: tl_zeta(LBi:UBi,LBj:UBj,:)
938# endif
939!
940! Local variable declarations.
941!
942 integer :: i, itrc, j, k
943
944# include "set_bounds.h"
945!
946!-----------------------------------------------------------------------
947! Initial conditions for tangent linear 2D momentum (s/m) components.
948!-----------------------------------------------------------------------
949!
950 DO j=jstrt,jendt
951 DO i=istrp,iendt
952 tl_ubar(i,j,kstp)=0.0_r8
953 END DO
954 END DO
955 DO j=jstrp,jendt
956 DO i=istrt,iendt
957 tl_vbar(i,j,kstp)=0.0_r8
958 END DO
959 END DO
960!
961!-----------------------------------------------------------------------
962! Initial conditions for tangent linear free-surface (1/m).
963!-----------------------------------------------------------------------
964!
965 DO j=jstrt,jendt
966 DO i=istrt,iendt
967 tl_zeta(i,j,kstp)=0.0_r8
968 END DO
969 END DO
970# ifdef SOLVE3D
971!
972!-----------------------------------------------------------------------
973! Initial conditions for tangent linear 3D momentum components (s/m).
974!-----------------------------------------------------------------------
975!
976 DO k=1,n(ng)
977 DO j=jstrt,jendt
978 DO i=istrp,iendt
979 tl_u(i,j,k,nstp)=0.0_r8
980 END DO
981 END DO
982 DO j=jstrp,jendt
983 DO i=istrt,iendt
984 tl_v(i,j,k,nstp)=0.0_r8
985 END DO
986 END DO
987 END DO
988!
989!-----------------------------------------------------------------------
990! Initial conditions for tangent linear active tracers (1/Tunits).
991!-----------------------------------------------------------------------
992!
993 DO itrc=1,nat
994 DO k=1,n(ng)
995 DO j=jstrt,jendt
996 DO i=istrt,iendt
997 tl_t(i,j,k,nstp,itrc)=0.0_r8
998 END DO
999 END DO
1000 END DO
1001 END DO
1002# endif
1003!
1004 RETURN

References mod_param::nat.

Referenced by ana_initial().

Here is the caller graph for this function:

◆ ana_tobc()

subroutine analytical_mod::ana_tobc ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 2 of file ana_tobc.h.

3!
4!! git $Id$
5!!======================================================================
6!! Copyright (c) 2002-2025 The ROMS Group !
7!! Licensed under a MIT/X style license !
8!! See License_ROMS.md !
9!=======================================================================
10! !
11! This routine sets tracer-type variables open boundary conditions !
12! using analytical expressions. !
13! !
14!=======================================================================
15!
16 USE mod_param
17 USE mod_boundary
18 USE mod_grid
19 USE mod_ncparam
20 USE mod_ocean
21 USE mod_stepping
22!
23! Imported variable declarations.
24!
25 integer, intent(in) :: ng, tile, model
26!
27! Local variable declarations.
28!
29 character (len=*), parameter :: MyFile = &
30 & __FILE__
31!
32#include "tile.h"
33!
34 CALL ana_tobc_tile (ng, tile, model, &
35 & lbi, ubi, lbj, ubj, &
36 & imins, imaxs, jmins, jmaxs, &
37 & nstp(ng), &
38 & grid(ng) % z_r, &
39 & ocean(ng) % t)
40!
41! Set analytical header file name used.
42!
43#ifdef DISTRIBUTE
44 IF (lanafile) THEN
45#else
46 IF (lanafile.and.(tile.eq.0)) THEN
47#endif
48 ananame(34)=myfile
49 END IF
50!
51 RETURN

References ana_tobc_tile(), mod_ncparam::ananame, mod_grid::grid, mod_ncparam::lanafile, mod_stepping::nstp, and mod_ocean::ocean.

Referenced by ad_set_data_tile(), rp_set_data_tile(), set_data_tile(), and tl_set_data_tile().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_tobc_tile()

subroutine analytical_mod::ana_tobc_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
integer, intent(in) nstp,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng)), intent(in) z_r,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng),3,nt(ng)), intent(in) t )

Definition at line 55 of file ana_tobc.h.

60!***********************************************************************
61!
62 USE mod_param
63 USE mod_scalars
64 USE mod_boundary
65 USE mod_ncparam
66 USE mod_ocean
67#ifdef SEDIMENT
68 USE mod_sediment
69#endif
70!
71! Imported variable declarations.
72!
73 integer, intent(in) :: ng, tile, model
74 integer, intent(in) :: LBi, UBi, LBj, UBj
75 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
76 integer, intent(in) :: nstp
77
78#ifdef ASSUMED_SHAPE
79 real(r8), intent(in) :: z_r(LBi:,LBj:,:)
80 real(r8), intent(in) :: t(LBi:,LBj:,:,:,:)
81#else
82 real(r8), intent(in) :: z_r(LBi:UBi,LBj:UBj,N(ng))
83 real(r8), intent(in) :: t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
84#endif
85!
86! Local variable declarations.
87!
88 integer :: i, ised, itrc, j, k
89!
90 real(r8) :: cff
91
92#include "set_bounds.h"
93!
94!-----------------------------------------------------------------------
95! Tracers open boundary conditions.
96!-----------------------------------------------------------------------
97!
98#ifdef ESTUARY_TEST
99 IF (any(lbc(ieast,istvar(:),ng)%acquire).and. &
100 & domain(ng)%Eastern_Edge(tile)) THEN
101 DO k=1,n(ng)
102 DO j=jstrt,jendt
103 boundary(ng)%t_east(j,k,itemp)=t0(ng)
104# ifdef SALINITY
105 boundary(ng)%t_east(j,k,isalt)=0.0_r8
106# endif
107# ifdef SEDIMENT
108 DO ised=1,nst
109 boundary(ng)%t_east(j,k,idsed(ised))=0.0_r8
110 END DO
111# endif
112 END DO
113 END DO
114 END IF
115
116 IF (any(lbc(iwest,istvar(:),ng)%acquire).and. &
117 & domain(ng)%Western_Edge(tile)) THEN
118 DO k=1,n(ng)
119 DO j=jstrt,jendt
120 boundary(ng)%t_west(j,k,itemp)=t0(ng)
121# ifdef SALINITY
122 boundary(ng)%t_west(j,k,isalt)=30.0_r8
123# endif
124# ifdef SEDIMENT
125 DO ised=1,nst
126 boundary(ng)%t_west(j,k,idsed(ised))=0.0_r8
127 END DO
128# endif
129 END DO
130 END DO
131 END IF
132
133#elif defined NJ_BIGHT
134 IF (any(lbc(ieast,istvar(:),ng)%acquire).and. &
135 & domain(ng)%Eastern_Edge(tile)) THEN
136 DO k=1,n(ng)
137 DO j=jstrt,jendt
138 IF (z_r(iend+1,j,k).ge.-15.0_r8) THEN
139 boundary(ng)%t_east(j,k,itemp)=2.04926425772840e+01_r8- &
140 & z_r(iend+1,j,k)* &
141 & (2.64085084879392e-01_r8+ &
142 & z_r(iend+1,j,k)* &
143 & (2.75112532853521e-01_r8+ &
144 & z_r(iend+1,j,k)* &
145 & (9.20748976164887e-02_r8+ &
146 & z_r(iend+1,j,k)* &
147 & (1.44907572574284e-02_r8+ &
148 & z_r(iend+1,j,k)* &
149 & (1.07821568591208e-03_r8+ &
150 & z_r(iend+1,j,k)* &
151 & (3.24031805390397e-05_r8+ &
152 & 1.26282685769027e-07_r8*
153 & z_r(iend+1,j,k)))))))
154# ifdef SALINITY
155 boundary(ng)%t_east(j,k,isalt)=3.06648914919313e+01_r8- &
156 & z_r(iend+1,j,k)* &
157 & (1.47672526294673e-01_r8+ &
158 & z_r(iend+1,j,k)* &
159 & (1.12645576031340e-01_r8+ &
160 & z_r(iend+1,j,k)* &
161 & (3.90092328187102e-02_r8+ &
162 & z_r(iend+1,j,k)* &
163 & (6.93901493744710e-03_r8+ &
164 & z_r(iend+1,j,k)* &
165 & (6.60443669679294e-04_r8+ &
166 & z_r(iend+1,j,k)* &
167 & (3.19179236195422e-05_r8+ &
168 & 6.17735263440932e-07_r8*
169 & z_r(iend+1,j,k)))))))
170# endif
171 ELSE
172 cff=tanh(1.1_r8*z_r(iend+1,j,k)+15.9_r8)
173 t_east(j,k,itemp)=14.6_r8+6.70_r8*cff
174# ifdef SALINITY
175 t_east(j,k,isalt)=31.3_r8-0.55_r8*cff
176# endif
177 END IF
178 END DO
179 END DO
180 END IF
181
182 IF (any(lbc(isouth,istvar(:),ng)%acquire).and. &
183 & domain(ng)%Southern_Edge(tile)) THEN
184 DO k=1,n(ng)
185 DO i=istrt,iendt
186 IF (z_r(i,jstr-1,k).ge.-15.0_r8) THEN
187 boundary(ng)%t_south(i,k,itemp)=2.04926425772840e+01_r8- &
188 & z_r(i,jstr-1,k)* &
189 & (2.64085084879392e-01_r8+ &
190 & z_r(i,jstr-1,k)* &
191 & (2.75112532853521e-01_r8+&
192 & z_r(i,jstr-1,k)* &
193 & (9.20748976164887e-02_r8+&
194 & z_r(i,jstr-1,k)* &
195 & (1.44907572574284e-02_r8+&
196 & z_r(i,jstr-1,k)* &
197 & (1.07821568591208e-03_r8+&
198 & z_r(i,jstr-1,k)* &
199 & (3.24031805390397e-05_r8+&
200 & 1.26282685769027e-07_r8*
201 & z_r(i,jstr-1,k)))))))
202# ifdef SALINITY
203 boundary(ng)%t_south(i,k,isalt)=3.06648914919313e+01_r8- &
204 & z_r(i,jstr-1,k)* &
205 & (1.47672526294673e-01_r8+ &
206 & z_r(i,jstr-1,k)* &
207 & (1.12645576031340e-01_r8+&
208 & z_r(i,jstr-1,k)* &
209 & (3.90092328187102e-02_r8+&
210 & z_r(i,jstr-1,k)* &
211 & (6.93901493744710e-03_r8+&
212 & z_r(i,jstr-1,k)* &
213 & (6.60443669679294e-04_r8+&
214 & z_r(i,jstr-1,k)* &
215 & (3.19179236195422e-05_r8+&
216 & 6.17735263440932e-07_r8*
217 & z_r(i,jstr-1,k)))))))
218# endif
219 ELSE
220 cff=tanh(1.1_r8*depth+15.9_r8)
221 boundary(ng)%t_south(i,k,itemp)=14.6_r8+6.70_r8*cff
222# ifdef SALINITY
223 boundary(ng)%t_south(i,k,isalt)=31.3_r8-0.55_r8*cff
224# endif
225 END IF
226 END DO
227 END DO
228 END IF
229
230#elif defined SED_TEST1
231 IF (any(lbc(ieast,istvar(:),ng)%acquire).and. &
232 & domain(ng)%Eastern_Edge(tile)) THEN
233 DO k=1,n(ng)
234 DO j=jstrt,jendt
235 boundary(ng)%t_east(j,k,itemp)=20.0_r8
236# ifdef SALINITY
237 boundary(ng)%t_east(j,k,isalt)=0.0_r8
238# endif
239 END DO
240 END DO
241 END IF
242
243#else
244 IF (any(lbc(ieast,istvar(:),ng)%acquire).and. &
245 & domain(ng)%Eastern_Edge(tile)) THEN
246 DO itrc=1,nt(ng)
247 DO k=1,n(ng)
248 DO j=jstrt,jendt
249 boundary(ng)%t_east(j,k,itrc)=0.0_r8
250 END DO
251 END DO
252 END DO
253 END IF
254
255 IF (any(lbc(iwest,istvar(:),ng)%acquire).and. &
256 & domain(ng)%Western_Edge(tile)) THEN
257 DO itrc=1,nt(ng)
258 DO k=1,n(ng)
259 DO j=jstrt,jendt
260 boundary(ng)%t_west(j,k,itrc)=0.0_r8
261 END DO
262 END DO
263 END DO
264 END IF
265
266 IF (any(lbc(isouth,istvar(:),ng)%acquire).and. &
267 & domain(ng)%Southern_Edge(tile)) THEN
268 DO itrc=1,nt(ng)
269 DO k=1,n(ng)
270 DO i=istrt,iendt
271 boundary(ng)%t_south(i,k,itrc)=0.0_r8
272 END DO
273 END DO
274 END DO
275 END IF
276
277 IF (any(lbc(inorth,istvar(:),ng)%acquire).and. &
278 & domain(ng)%Northern_Edge(tile)) THEN
279 DO itrc=1,nt(ng)
280 DO k=1,n(ng)
281 DO i=istrt,iendt
282 boundary(ng)%t_north(i,k,itrc)=0.0_r8
283 END DO
284 END DO
285 END DO
286 END IF
287#endif
288!
289 RETURN

References mod_boundary::boundary, mod_param::domain, mod_sediment::idsed, mod_scalars::ieast, mod_scalars::inorth, mod_scalars::isalt, mod_scalars::isouth, mod_ncparam::istvar, mod_scalars::itemp, mod_scalars::iwest, mod_param::lbc, mod_param::nst, and mod_scalars::t0.

Referenced by ana_tobc().

Here is the caller graph for this function:

◆ ana_vmix()

subroutine analytical_mod::ana_vmix ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 2 of file ana_vmix.h.

3!
4!! git $Id$
5!!======================================================================
6!! Copyright (c) 2002-2025 The ROMS Group !
7!! Licensed under a MIT/X style license !
8!! See License_ROMS.md !
9!=======================================================================
10! !
11! This routine sets vertical mixing coefficients for momentum "Akv" !
12! and tracers "Akt" (m2/s) using analytical expressions. !
13! !
14!=======================================================================
15!
16 USE mod_param
17 USE mod_grid
18 USE mod_mixing
19 USE mod_ncparam
20 USE mod_ocean
21 USE mod_stepping
22!
23! Imported variable declarations.
24!
25 integer, intent(in) :: ng, tile, model
26!
27! Local variable declarations.
28!
29 character (len=*), parameter :: MyFile = &
30 & __FILE__
31!
32#include "tile.h"
33!
34 CALL ana_vmix_tile (ng, tile, model, &
35 & lbi, ubi, lbj, ubj, &
36 & imins, imaxs, jmins, jmaxs, &
37 & knew(ng), &
38 & grid(ng) % h, &
39 & grid(ng) % z_r, &
40 & grid(ng) % z_w, &
41 & ocean(ng) % zeta, &
42 & mixing(ng) % Akv, &
43 & mixing(ng) % Akt)
44!
45! Set analytical header file name used.
46!
47#ifdef DISTRIBUTE
48 IF (lanafile) THEN
49#else
50 IF (lanafile.and.(tile.eq.0)) THEN
51#endif
52 ananame(35)=myfile
53 END IF
54!
55 RETURN

References ana_vmix_tile(), mod_ncparam::ananame, mod_grid::grid, mod_stepping::knew, mod_ncparam::lanafile, mod_mixing::mixing, and mod_ocean::ocean.

Referenced by ad_main3d(), ana_vmix_tile(), main3d(), rp_main3d(), and tl_main3d().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_vmix_tile()

subroutine analytical_mod::ana_vmix_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
integer, intent(in) knew,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) h,
real(r8), dimension(lbi:ubi,lbj:ubj,n(ng)), intent(in) z_r,
real(r8), dimension(lbi:ubi,lbj:ubj,0:n(ng)), intent(in) z_w,
real(r8), dimension(lbi:ubi,lbj:ubj,:), intent(in) zeta,
real(r8), dimension(lbi:ubi,lbj:ubj,0:n(ng)), intent(out) akv,
real(r8), dimension(lbi:ubi,lbj:ubj,0:n(ng),nat), intent(out) akt )

Definition at line 59 of file ana_vmix.h.

64!***********************************************************************
65!
66 USE mod_param
67 USE mod_scalars
68!
69 USE exchange_3d_mod, ONLY : exchange_w3d_tile
70#ifdef DISTRIBUTE
71 USE mp_exchange_mod, ONLY : mp_exchange3d, mp_exchange4d
72#endif
73!
74! Imported variable declarations.
75!
76 integer, intent(in) :: ng, tile, model
77 integer, intent(in) :: LBi, UBi, LBj, UBj
78 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
79 integer, intent(in) :: knew
80!
81#ifdef ASSUMED_SHAPE
82 real(r8), intent(in) :: h(LBi:,LBj:)
83 real(r8), intent(in) :: z_r(LBi:,LBj:,:)
84 real(r8), intent(in) :: z_w(LBi:,LBj:,0:)
85 real(r8), intent(in) :: zeta(LBi:,LBj:,:)
86 real(r8), intent(out) :: Akv(LBi:,LBj:,0:)
87 real(r8), intent(out) :: Akt(LBi:,LBj:,0:,:)
88#else
89 real(r8), intent(in) :: h(LBi:UBi,LBj:UBj)
90 real(r8), intent(in) :: z_r(LBi:UBi,LBj:UBj,N(ng))
91 real(r8), intent(in) :: z_w(LBi:UBi,LBj:UBj,0:N(ng))
92 real(r8), intent(in) :: zeta(LBi:UBi,LBj:UBj,:)
93 real(r8), intent(out) :: Akv(LBi:UBi,LBj:UBj,0:N(ng))
94 real(r8), intent(out) :: Akt(LBi:UBi,LBj:UBj,0:N(ng),NAT)
95#endif
96!
97! Local variable declarations.
98!
99 integer :: i, itrc, j, k
100
101#include "set_bounds.h"
102!
103!-----------------------------------------------------------------------
104! Set vertical viscosity coefficient (m2/s).
105!-----------------------------------------------------------------------
106!
107#if defined CANYON
108 DO k=1,n(ng)-1
109 DO j=jstrt,jendt
110 DO i=istrt,iendt
111 akv(i,j,k)=1.0e-03_r8+95.0e-04_r8*exp(z_w(i,j,k)/50.0_r8)+ &
112 & 95.0e-04_r8*exp(-(z_w(i,j,k)+h(i,j))/50.0_r8)
113 END DO
114 END DO
115 END DO
116#elif defined CHANNEL_NECK
117 DO k=1,n(ng)-1
118 DO j=jstrt,jendt
119 DO i=istrt,iendt
120 akv(i,j,k)=2.0e-04_r8+8.0e-04_r8*exp(z_w(i,j,k)/5.0_r8)
121 END DO
122 END DO
123 END DO
124#elif defined COUPLING_TEST
125 DO k=1,n(ng)-1
126 DO j=jstrt,jendt
127 DO i=istrt,iendt
128 akv(i,j,k)=2.0e-03_r8+8.0e-03_r8*exp(z_w(i,j,k)/1500.0_r8)
129 END DO
130 END DO
131 END DO
132#elif defined ESTUARY_TEST
133 DO k=1,n(ng)-1
134 DO j=jstrt,jendt
135 DO i=istrt,iendt
136 akv(i,j,k)=0.002_r8
137 END DO
138 END DO
139 END DO
140#elif defined LAKE_SIGNELL
141 DO k=1,n(ng)-1
142 DO j=jstrt,jendt
143 DO i=istrt,iendt
144 akv(i,j,k)=0.0005_r8
145 END DO
146 END DO
147 END DO
148#elif defined NJ_BIGHT
149 DO k=1,n(ng)-1
150 DO j=jstrt,jendt
151 DO i=istrt,iendt
152 akv(i,j,k)=1.0e-03_r8+2.0e-04_r8*exp(z_r(i,j,k)/10.0_r8)
153 END DO
154 END DO
155 END DO
156#elif defined SED_TEST1
157 DO k=1,n(ng)-1 ! vonkar*ustar*z*(1-z/D)
158 DO j=jstrt,jendt
159 DO i=istrt,iendt
160 akv(i,j,k)=0.025_r8*(h(i,j)+z_w(i,j,k))* &
161 & (1.0_r8-(h(i,j)+z_w(i,j,k))/ &
162 & (h(i,j)+zeta(i,j,knew)))
163 akt(i,j,k,itemp)=akv(i,j,k)*0.49_r8/0.39_r8
164# ifdef SALINITY
165 akt(i,j,k,isalt)=akt(i,j,k,itemp)
166# endif
167 END DO
168 END DO
169 END DO
170#elif defined SED_TOY
171 DO k=1,n(ng)-1 ! vonkar*ustar*z*(1-z/D)
172 DO j=jstrt,jendt
173 DO i=istrt,iendt
174 akv(i,j,k)=0.41_r8*0.01_r8*(h(i,j)+z_w(i,j,k))* &
175 & (1.0_r8-(h(i,j)+z_w(i,j,k))/ &
176 & (h(i,j)+zeta(i,j,knew)))
177 END DO
178 END DO
179 END DO
180#elif defined SHOREFACE
181 DO k=1,n(ng)-1
182 DO j=jstrt,jendt
183 DO i=istrt,iendt
184 akv(i,j,k)=0.025_r8*(h(i,j)+z_w(i,j,k))* &
185 & (1.0_r8-(h(i,j)+z_w(i,j,k))/ &
186 & (h(i,j)+zeta(i,j,knew)))
187 END DO
188 END DO
189 END DO
190#elif defined TEST_CHAN
191 DO k=1,n(ng)-1 ! vonkar*ustar*z*(1-z/D)
192 DO j=jstrt,jendt
193 DO i=istrt,iendt
194 akv(i,j,k)=0.41_r8*0.0625_r8*(h(i,j)+z_w(i,j,k))* &
195 & (1.0_r8-(h(i,j)+z_w(i,j,k))/ &
196 & (h(i,j)+zeta(i,j,knew)))
197 END DO
198 END DO
199 END DO
200#elif defined UPWELLING
201 DO k=1,n(ng)-1
202 DO j=jstrt,jendt
203 DO i=istrt,iendt
204 akv(i,j,k)=2.0e-03_r8+8.0e-03_r8*exp(z_w(i,j,k)/150.0_r8)
205 END DO
206 END DO
207 END DO
208#else
209 ana_vmix.h: no values provided for akv.
210#endif
211!
212! Exchange boundary data.
213!
214 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
215 CALL exchange_w3d_tile (ng, tile, &
216 & lbi, ubi, lbj, ubj, 0, n(ng), &
217 & akv)
218 END IF
219
220#ifdef DISTRIBUTE
221 CALL mp_exchange3d (ng, tile, model, 1, &
222 & lbi, ubi, lbj, ubj, 0, n(ng), &
223 & nghostpoints, &
224 & ewperiodic(ng), nsperiodic(ng), &
225 & akv)
226#endif
227!
228!-----------------------------------------------------------------------
229! Set vertical diffusion coefficient (m2/s).
230!-----------------------------------------------------------------------
231!
232#if defined CANYON
233 DO k=1,n(ng)-1
234 DO j=jstrt,jendt
235 DO i=istrt,iendt
236 akt(i,j,k,itemp)=akt_bak(itemp,ng)
237 END DO
238 END DO
239 END DO
240#elif defined CHANNEL_NECK
241 DO k=1,n(ng)-1
242 DO j=jstrt,jendt
243 DO i=istrt,iendt
244 akt(i,j,k,itemp)=2.0e-06_r8+ &
245 & 8.0e-06_r8*exp(z_w(i,j,k)/5.0_r8)
246 END DO
247 END DO
248 END DO
249#elif defined COUPLING_TEST
250 DO k=1,n(ng)-1
251 DO j=jstrt,jendt
252 DO i=istrt,iendt
253 akt(i,j,k,itemp)=akt_bak(itemp,ng)
254# ifdef SALINITY
255 akt(i,j,k,isalt)=akt_bak(isalt,ng)
256# endif
257 END DO
258 END DO
259 END DO
260#elif defined ESTUARY_TEST
261 DO k=1,n(ng)-1
262 DO j=jstrt,jendt
263 DO i=istrt,iendt
264 akt(i,j,k,itemp)=akv(i,j,k)
265# ifdef SALINITY
266 akt(i,j,k,isalt)=akv(i,j,k)
267# endif
268 END DO
269 END DO
270 END DO
271#elif defined LAKE_SIGNELL
272 DO k=1,n(ng)-1
273 DO j=jstrt,jendt
274 DO i=istrt,iendt
275 akt(i,j,k,itemp)=akt_bak(itemp,ng)
276# ifdef SALINITY
277 akt(i,j,k,isalt)=akt_bak(isalt,ng)
278# endif
279 END DO
280 END DO
281 END DO
282#elif defined NJ_BIGHT
283 DO k=1,n(ng)-1
284 DO j=jstrt,jendt
285 DO i=istrt,iendt
286 akt(i,j,k,itemp)=1.0e-05_r8+ &
287 & 2.0e-06_r8*exp(z_r(i,j,k)/10.0_r8)
288# ifdef SALINITY
289 akt(i,j,k,isalt)=akt(i,j,k,itemp)
290# endif
291 END DO
292 END DO
293 END DO
294#elif defined SED_TOY
295 DO k=1,n(ng)-1 ! vonkar*ustar*z*(1-z/D)
296 DO j=jstrt,jendt
297 DO i=istrt,iendt
298 akt(i,j,k,itemp)=akv(i,j,k)
299# ifdef SALINITY
300 akt(i,j,k,isalt)=akv(i,j,k)
301# endif
302 END DO
303 END DO
304 END DO
305#elif defined SHOREFACE
306 DO k=1,n(ng)-1
307 DO j=jstrt,jendt
308 DO i=istrt,iendt
309 akt(i,j,k,itemp)=akv(i,j,k)
310# ifdef SALINITY
311 akt(i,j,k,isalt)=akv(i,j,k)
312# endif
313 END DO
314 END DO
315 END DO
316#elif defined TEST_CHAN
317 DO k=1,n(ng)-1
318 DO j=jstrt,jendt
319 DO i=istrt,iendt
320 akt(i,j,k,itemp)=akv(i,j,k)*0.49_r8/0.39_r8
321# ifdef SALINITY
322 akt(i,j,k,isalt)=akt(i,j,k,itemp)
323# endif
324 END DO
325 END DO
326 END DO
327#elif defined UPWELLING
328 DO k=1,n(ng)-1
329 DO j=jstrt,jendt
330 DO i=istrt,iendt
331 akt(i,j,k,itemp)=akt_bak(itemp,ng)
332# ifdef SALINITY
333 akt(i,j,k,isalt)=akt_bak(isalt,ng)
334# endif
335 END DO
336 END DO
337 END DO
338#else
339 ana_vmix.h: no values provided for akt.
340#endif
341!
342! Exchange boundary data.
343!
344 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
345 DO itrc=1,nat
346 CALL exchange_w3d_tile (ng, tile, &
347 & lbi, ubi, lbj, ubj, 0, n(ng), &
348 & akt(:,:,:,itrc))
349 END DO
350 END IF
351
352#ifdef DISTRIBUTE
353 CALL mp_exchange4d (ng, tile, model, 1, &
354 & lbi, ubi, lbj, ubj, 0, n(ng), 1, nat, &
355 & nghostpoints, &
356 & ewperiodic(ng), nsperiodic(ng), &
357 & akt)
358#endif
359!
360 RETURN
exchange_3d_mod::exchange_w3d_tile
subroutine exchange_w3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, a)
Definition exchange_3d.F:920
mod_scalars::akt_bak
real(r8), dimension(:,:), allocatable akt_bak
Definition mod_scalars.F:907

References mod_scalars::akt_bak, ana_vmix(), mod_scalars::ewperiodic, exchange_3d_mod::exchange_w3d_tile(), mod_scalars::isalt, mod_scalars::itemp, mp_exchange_mod::mp_exchange3d(), mp_exchange_mod::mp_exchange4d(), mod_param::nghostpoints, and mod_scalars::nsperiodic.

Referenced by ana_vmix().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_winds()

subroutine analytical_mod::ana_winds ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 2 of file ana_winds.h.

3!
4!! git $Id$
5!!======================================================================
6!! Copyright (c) 2002-2025 The ROMS Group !
7!! Licensed under a MIT/X style license !
8!! See License_ROMS.md !
9!=======================================================================
10! !
11! This routine sets surface wind components using an analytical !
12! expression. !
13! !
14!=======================================================================
15!
16 USE mod_param
17 USE mod_forces
18 USE mod_grid
19 USE mod_ncparam
20!
21! Imported variable declarations.
22!
23 integer, intent(in) :: ng, tile, model
24!
25! Local variable declarations.
26!
27 character (len=*), parameter :: MyFile = &
28 & __FILE__
29!
30#include "tile.h"
31!
32 CALL ana_winds_tile (ng, tile, model, &
33 & lbi, ubi, lbj, ubj, &
34 & imins, imaxs, jmins, jmaxs, &
35#ifdef SPHERICAL
36 & grid(ng) % lonr, &
37 & grid(ng) % latr, &
38#else
39 & grid(ng) % xr, &
40 & grid(ng) % yr, &
41#endif
42 & forces(ng) % Uwind, &
43 & forces(ng) % Vwind)
44!
45! Set analytical header file name used.
46!
47#ifdef DISTRIBUTE
48 IF (lanafile) THEN
49#else
50 IF (lanafile.and.(tile.eq.0)) THEN
51#endif
52 ananame(36)=myfile
53 END IF
54!
55 RETURN

References ana_winds_tile(), mod_ncparam::ananame, mod_forces::forces, mod_grid::grid, and mod_ncparam::lanafile.

Referenced by ad_set_data_tile(), ana_winds_tile(), rp_set_data_tile(), set_data_tile(), and tl_set_data_tile().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_winds_tile()

subroutine analytical_mod::ana_winds_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) lonr,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) latr,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) xr,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) yr,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) uwind,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) vwind )

Definition at line 59 of file ana_winds.h.

68!***********************************************************************
69!
70 USE mod_param
71 USE mod_scalars
72!
73 USE exchange_2d_mod, ONLY : exchange_r2d_tile
74#ifdef DISTRIBUTE
75 USE mp_exchange_mod, ONLY : mp_exchange2d
76#endif
77!
78! Imported variable declarations.
79!
80 integer, intent(in) :: ng, tile, model
81 integer, intent(in) :: LBi, UBi, LBj, UBj
82 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
83!
84#ifdef ASSUMED_SHAPE
85# ifdef SPHERICAL
86 real(r8), intent(in) :: lonr(LBi:,LBj:)
87 real(r8), intent(in) :: latr(LBi:,LBj:)
88# else
89 real(r8), intent(in) :: xr(LBi:,LBj:)
90 real(r8), intent(in) :: yr(LBi:,LBj:)
91# endif
92 real(r8), intent(out) :: Uwind(LBi:,LBj:)
93 real(r8), intent(out) :: Vwind(LBi:,LBj:)
94#else
95# ifdef SPHERICAL
96 real(r8), intent(in) :: lonr(LBi:UBi,LBj:UBj)
97 real(r8), intent(in) :: latr(LBi:UBi,LBj:UBj)
98# else
99 real(r8), intent(in) :: xr(LBi:UBi,LBj:UBj)
100 real(r8), intent(in) :: yr(LBi:UBi,LBj:UBj)
101# endif
102 real(r8), intent(out) :: Uwind(LBi:UBi,LBj:UBj)
103 real(r8), intent(out) :: Vwind(LBi:UBi,LBj:UBj)
104#endif
105!
106! Local variable declarations.
107!
108 integer :: i, j
109!
110 real(r8) :: Wdir, Wmag, cff, u_wind, v_wind
111
112#include "set_bounds.h"
113!
114!-----------------------------------------------------------------------
115! Set surface wind components (m/s) at RHO-points.
116!-----------------------------------------------------------------------
117!
118#if defined BENCHMARK
119 wmag=15.0_r8
120 DO j=jstrt,jendt
121 DO i=istrt,iendt
122 cff=0.2_r8*(60.0_r8+latr(i,j))
123 uwind(i,j)=wmag*exp(-cff*cff)
124 vwind(i,j)=0.0_r8
125 END DO
126 END DO
127#elif defined BL_TEST
128 IF ((tdays(ng)-dstart).le.6.0_r8) THEN
129 u_wind=0.0_r8
130!! v_wind=4.7936_r8
131 v_wind=10.0_r8
132 END IF
133 DO j=jstrt,jendt
134 DO i=istrt,iendt
135 uwind(i,j)=u_wind
136 vwind(i,j)=v_wind
137 END DO
138 END DO
139#else
140 ana_winds.h: no values provided for uwind and vwind.
141#endif
142!
143! Exchange boundary data.
144!
145 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
146 CALL exchange_r2d_tile (ng, tile, &
147 & lbi, ubi, lbj, ubj, &
148 & uwind)
149 CALL exchange_r2d_tile (ng, tile, &
150 & lbi, ubi, lbj, ubj, &
151 & vwind)
152 END IF
153
154#ifdef DISTRIBUTE
155 CALL mp_exchange2d (ng, tile, model, 2, &
156 & lbi, ubi, lbj, ubj, &
157 & nghostpoints, &
158 & ewperiodic(ng), nsperiodic(ng), &
159 & uwind, vwind)
160#endif
161!
162 RETURN

References ana_winds(), mod_scalars::dstart, mod_scalars::ewperiodic, exchange_2d_mod::exchange_r2d_tile(), mp_exchange_mod::mp_exchange2d(), mod_param::nghostpoints, mod_scalars::nsperiodic, and mod_scalars::tdays.

Referenced by ana_winds().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_wtype()

subroutine analytical_mod::ana_wtype ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 2 of file ana_wtype.h.

3!
4!! git $Id$
5!!======================================================================
6!! Copyright (c) 2002-2025 The ROMS Group !
7!! Licensed under a MIT/X style license !
8!! See License_ROMS.md !
9!=======================================================================
10! !
11! This subroutine sets spatially varying Jerlov water type index. !
12! It is used in 'lmd_swfrac' to compute the fraction of shortwave !
13! flux penetrating the water column (light absorption), modeled !
14! as a double exponential decay function in Jerlov water type. !
15! !
16! Currently, the following Jerlov water types are supported: !
17! !
18! Array Jerlov !
19! Index Water Type Examples !
20! ----- ---------- -------- !
21! !
22! 1 I Open Pacific !
23! 2 IA Eastern Mediterranean, Indian Ocean !
24! 3 IB Western Mediterranean, Open Atlantic !
25! 4 II Coastal waters, Azores !
26! 5 III Coastal waters, North Sea !
27! 6 1 Skagerrak Strait !
28! 7 3 Baltic !
29! 8 5 Black Sea !
30! 9 7 Coastal waters, dark !
31! !
32! The range of indices 1:9 are ordered by increasing absorption: !
33! from clear water (type I) to dark turbidity water (type 7). !
34! The indices correspond to the paramenters used to model the !
35! the light absorption into the water column using a double !
36! exponential fitting function of (Paulson and Simpson, 1997). !
37! !
38!=======================================================================
39!
40 USE mod_param
41 USE mod_grid
42 USE mod_mixing
43 USE mod_ncparam
44!
45! Imported variable declarations.
46!
47 integer, intent(in) :: ng, tile, model
48!
49! Local variable declarations.
50!
51 character (len=*), parameter :: MyFile = &
52 & __FILE__
53!
54#include "tile.h"
55!
56 CALL ana_wtype_tile (ng, tile, model, &
57 & lbi, ubi, lbj, ubj, &
58 & imins, imaxs, jmins, jmaxs, &
59 & grid(ng) % h, &
60 & mixing(ng) % Jwtype)
61!
62! Set analytical header file name used.
63!
64#ifdef DISTRIBUTE
65 IF (lanafile) THEN
66#else
67 IF (lanafile.and.(tile.eq.0)) THEN
68#endif
69 ananame(39)=myfile
70 END IF
71!
72 RETURN

References ana_wtype_tile(), mod_ncparam::ananame, mod_grid::grid, mod_ncparam::lanafile, and mod_mixing::mixing.

Referenced by set_grid().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_wtype_tile()

subroutine analytical_mod::ana_wtype_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) h,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(out) jwtype )

Definition at line 76 of file ana_wtype.h.

80!***********************************************************************
81!
82 USE mod_param
83 USE mod_parallel
84 USE mod_ncparam
85 USE mod_iounits
86 USE mod_scalars
87!
88 USE exchange_2d_mod, ONLY : exchange_r2d_tile
89#ifdef DISTRIBUTE
90 USE mp_exchange_mod, ONLY : mp_exchange2d
91#endif
92 USE stats_mod, ONLY : stats_2dfld
93!
94! Imported variable declarations.
95!
96 integer, intent(in) :: ng, tile, model
97 integer, intent(in) :: LBi, UBi, LBj, UBj
98 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
99!
100#ifdef ASSUMED_SHAPE
101 real(r8), intent(in) :: h(LBi:,LBj:)
102 real(r8), intent(out) :: Jwtype(LBi:,LBj:)
103#else
104 real(r8), intent(in) :: h(LBi:UBi,LBj:UBj)
105 real(r8), intent(out) :: Jwtype(LBi:UBi,LBj:UBj)
106#endif
107!
108! Local variable declarations.
109!
110 logical, save :: first = .true.
111!
112 integer :: i, j
113!
114 real(r8) :: fac
115!
116 TYPE (T_STATS), save :: Stats
117
118#include "set_bounds.h"
119!
120!-----------------------------------------------------------------------
121! Initialize field statistics structure.
122!-----------------------------------------------------------------------
123!
124 IF (first) THEN
125 first=.false.
126 stats % checksum=0_i8b
127 stats % count=0
128 stats % min=large
129 stats % max=-large
130 stats % avg=0.0_r8
131 stats % rms=0.0_r8
132 END IF
133!
134!-----------------------------------------------------------------------
135! Set Jerlov water type array indices (1 to 9, currently) for light
136! absorption.
137!-----------------------------------------------------------------------
138!
139#ifdef MY_APPLICATION
140 fac=1.0/1000.0_r8 ! Inverse bathymetry threshold
141 DO j=jstrt,jendt
142 DO i=istrt,iendt
143 jwtype(i,j)=anint(5.0_r8-4.5_r8*(tanh(h(i,j)*fac))) ! 1:5
144 END DO
145 END DO
146#else
147 DO j=jstrt,jendt
148 DO i=istrt,iendt
149 jwtype(i,j)=???
150 END DO
151 END DO
152#endif
153!
154! Report statistics.
155!
156 CALL stats_2dfld (ng, tile, inlm, r2dvar, stats, 0, &
157 & lbi, ubi, lbj, ubj, jwtype)
158 IF (domain(ng)%NorthEast_Corner(tile)) THEN
159 WRITE (stdout,10) 'Jerlov water type: wtype_grid', &
160 & ng, stats%min, stats%max
161 END IF
162!
163! Exchange boundary data.
164!
165 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
166 CALL exchange_r2d_tile (ng, tile, &
167 & lbi, ubi, lbj, ubj, &
168 & jwtype)
169 END IF
170
171#ifdef DISTRIBUTE
172 CALL mp_exchange2d (ng, tile, model, 1, &
173 & lbi, ubi, lbj, ubj, &
174 & nghostpoints, &
175 & ewperiodic(ng), nsperiodic(ng), &
176 & jwtype)
177#endif
178!
179 10 FORMAT (3x,' ANA_WTYPE - ',a,/,19x, &
180 & '(Grid = ',i2.2,', Min = ',1p,e15.8,0p, &
181 & ' Max = ',1p,e15.8,0p,')')
182!
183 RETURN

References mod_param::domain, mod_scalars::ewperiodic, exchange_2d_mod::exchange_r2d_tile(), mod_param::inlm, mod_scalars::large, mp_exchange_mod::mp_exchange2d(), mod_param::nghostpoints, mod_scalars::nsperiodic, mod_param::r2dvar, stats_mod::stats_2dfld(), and mod_iounits::stdout.

Referenced by ana_wtype().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_wwave()

subroutine analytical_mod::ana_wwave ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 2 of file ana_wwave.h.

3!
4!! git $Id$
5!!======================================================================
6!! Copyright (c) 2002-2025 The ROMS Group !
7!! Licensed under a MIT/X style license !
8!! See License_ROMS.md !
9!=======================================================================
10! !
11! This subroutine sets wind induced wave amplitude, direction and !
12! period to be used in the bottom boundary layer formulation. !
13! !
14!=======================================================================
15!
16 USE mod_param
17 USE mod_forces
18 USE mod_grid
19 USE mod_ncparam
20!
21! Imported variable declarations.
22!
23 integer, intent(in) :: ng, tile, model
24!
25! Local variable declarations.
26!
27 character (len=*), parameter :: MyFile = &
28 & __FILE__
29!
30#include "tile.h"
31!
32 CALL ana_wwave_tile (ng, tile, model, &
33 & lbi, ubi, lbj, ubj, &
34 & imins, imaxs, jmins, jmaxs, &
35#ifdef WAVES_DIR
36 & forces(ng) % Dwave, &
37#endif
38#ifdef WAVES_HEIGHT
39 & forces(ng) % Hwave, &
40#endif
41#ifdef WAVES_LENGTH
42 & forces(ng) % Lwave, &
43#endif
44#ifdef WAVES_TOP_PERIOD
45 & forces(ng) % Pwave_top, &
46#endif
47#ifdef WAVES_BOT_PERIOD
48 & forces(ng) % Pwave_bot, &
49#endif
50#ifdef WAVES_UB
51 & forces(ng) % Uwave_rms, &
52#endif
53 & grid(ng) % angler, &
54 & grid(ng) % h)
55!
56! Set analytical header file name used.
57!
58#ifdef DISTRIBUTE
59 IF (lanafile) THEN
60#else
61 IF (lanafile.and.(tile.eq.0)) THEN
62#endif
63 ananame(37)=myfile
64 END IF
65!
66 RETURN

References ana_wwave_tile(), mod_ncparam::ananame, mod_forces::forces, mod_grid::grid, and mod_ncparam::lanafile.

Referenced by ad_set_data_tile(), ana_wwave_tile(), rp_set_data_tile(), set_data_tile(), and tl_set_data_tile().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ana_wwave_tile()

subroutine analytical_mod::ana_wwave_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(inout) dwave,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(inout) hwave,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(inout) lwave,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(inout) pwave_top,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(inout) pwave_bot,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(inout) uwave_rms,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) angler,
real(r8), dimension(lbi:ubi,lbj:ubj), intent(in) h )

Definition at line 70 of file ana_wwave.h.

92!***********************************************************************
93!
94 USE mod_param
95 USE mod_scalars
96!
97 USE exchange_2d_mod, ONLY : exchange_r2d_tile
98#ifdef DISTRIBUTE
99 USE mp_exchange_mod, ONLY : mp_exchange2d
100#endif
101!
102! Imported variable declarations.
103!
104 integer, intent(in) :: ng, tile, model
105 integer, intent(in) :: LBi, UBi, LBj, UBj
106 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
107!
108#ifdef ASSUMED_SHAPE
109 real(r8), intent(in) :: angler(LBi:,LBj:)
110 real(r8), intent(in) :: h(LBi:,LBj:)
111# ifdef WAVES_DIR
112 real(r8), intent(inout) :: Dwave(LBi:,LBj:)
113# endif
114# ifdef WAVES_HEIGHT
115 real(r8), intent(inout) :: Hwave(LBi:,LBj:)
116# endif
117# ifdef WAVES_LENGTH
118 real(r8), intent(inout) :: Lwave(LBi:,LBj:)
119# endif
120# ifdef WAVES_TOP_PERIOD
121 real(r8), intent(inout) :: Pwave_top(LBi:,LBj:)
122# endif
123# ifdef WAVES_BOT_PERIOD
124 real(r8), intent(inout) :: Pwave_bot(LBi:,LBj:)
125# endif
126# ifdef WAVES_UB
127 real(r8), intent(inout) :: Uwave_rms(LBi:,LBj:)
128# endif
129
130#else
131
132 real(r8), intent(in) :: angler(LBi:UBi,LBj:UBj)
133 real(r8), intent(in) :: h(LBi:UBi,LBj:UBj)
134# ifdef WAVES_DIR
135 real(r8), intent(inout) :: Dwave(LBi:UBi,LBj:UBj)
136# endif
137# ifdef WAVES_HEIGHT
138 real(r8), intent(inout) :: Hwave(LBi:UBi,LBj:UBj)
139# endif
140# ifdef WAVES_LENGTH
141 real(r8), intent(inout) :: Lwave(LBi:UBi,LBj:UBj)
142# endif
143# ifdef WAVES_TOP_PERIOD
144 real(r8), intent(inout) :: Pwave_top(LBi:UBi,LBj:UBj)
145# endif
146# ifdef WAVES_BOT_PERIOD
147 real(r8), intent(inout) :: Pwave_bot(LBi:UBi,LBj:UBj)
148# endif
149# ifdef WAVES_UB
150 real(r8), intent(inout) :: Uwave_rms(LBi:UBi,LBj:UBj)
151# endif
152#endif
153!
154! Local variable declarations.
155!
156 integer :: i, j
157!
158 real(r8) :: cff, wdir
159#if defined LAKE_SIGNELL
160 real(r8) :: cff1, mxst, ramp_u, ramp_time, ramp_d
161#endif
162
163#include "set_bounds.h"
164!
165!-----------------------------------------------------------------------
166! Set wind induced wave amplitude (m), direction (radians) and
167! period (s) at RHO-points.
168!-----------------------------------------------------------------------
169!
170#if defined BL_TEST
171 wdir=210.0_r8*deg2rad
172 DO j=jstrt,jendt
173 DO i=istrt,iendt
174# ifdef WAVES_DIR
175 dwave(i,j)=wdir
176# endif
177# ifdef WAVES_HEIGHT
178 hwave(i,j)=0.5_r8
179# endif
180# ifdef WAVES_BOT_PERIOD
181 pwave_bot(i,j)=8.0_r8
182# endif
183 END DO
184 END DO
185#elif defined LAKE_SIGNELL
186 mxst=0.25_r8 ! Wave amplitude (1/2 wave height) (meters)
187 ramp_u=15.0_r8 ! start ramp UP at RAMP_UP (hours)
188 ramp_time=10.0_r8 ! ramp from 0 to 1 over RAMP_TIME (hours)
189 ramp_d=50.0_r8 ! start ramp DOWN at RAMP_DOWN (hours)
190 DO j=jstrt,jendt
191 DO i=istrt,iendt
192# ifdef WAVES_DIR
193 dwave(i,j)=270.0_r8*deg2rad
194# endif
195# ifdef WAVES_HEIGHT
196 hwave(i,j)=max((cff1*mxst),0.01_r8)
197# endif
198# ifdef WAVES_BOT_PERIOD
199 pwave_bot(i,j)=5.0_r8 ! wave period (seconds)
200 cff1=min((0.5_r8*(tanh((time(ng)/3600.0_r8-ramp_u)/ &
201 & (ramp_time/5.0_r8))+1.0_r8)), &
202 & (1.0_r8-(0.5_r8*(tanh((time(ng)/3600.0_r8-ramp_d)/ &
203 & (ramp_time/5.0_r8))+1.0_r8))))
204# endif
205 END DO
206 END DO
207#elif defined NJ_BIGHT
208!! wdir=210.0_r8*deg2rad
209 wdir=150.0_r8*deg2rad
210 IF ((tdays(ng)-dstart).lt.1.5_r8) THEN
211 cff=tanh(0.5_r8*(tdays(ng)-dstart))
212 cff=1.0_r8
213 ELSE
214 cff=1.0_r8
215 END IF
216 DO j=jstrt,jendt
217 DO i=istrt,iendt
218# ifdef WAVES_DIR
219 dwave(i,j)=wdir-angler(i,j)
220# endif
221# ifdef WAVES_HEIGHT
222 hwave(i,j)=0.12_r8
223# endif
224# ifdef WAVES_BOT_PERIOD
225 pwave_bot(i,j)=10.0_r8
226# endif
227 END DO
228 END DO
229#elif defined SED_TOY
230 DO j=jstrt,jendt
231 DO i=istrt,iendt
232# ifdef WAVES_DIR
233 dwave(i,j)=90.0_r8*deg2rad
234# endif
235# ifdef WAVES_HEIGHT
236 hwave(i,j)=2.0_r8
237# endif
238# ifdef WAVES_LENGTH
239 lwave(i,j)=20.0_r8
240# endif
241# ifdef WAVES_BOT_PERIOD
242 pwave_bot(i,j)=8.0_r8
243# endif
244 END DO
245 END DO
246#else
247 ana_wwave: no values provided for hwave, dwave, pwave, lwave.
248#endif
249!
250! Exchange boundary data.
251!
252#if defined WAVES_DIR
253 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
254 CALL exchange_r2d_tile (ng, tile, &
255 & lbi, ubi, lbj, ubj, &
256 & dwave)
257 END IF
258# ifdef DISTRIBUTE
259 CALL mp_exchange2d (ng, tile, model, 1, &
260 & lbi, ubi, lbj, ubj, &
261 & nghostpoints, &
262 & ewperiodic(ng), nsperiodic(ng), &
263 & dwave)
264# endif
265#endif
266
267#ifdef WAVES_HEIGHT
268 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
269 CALL exchange_r2d_tile (ng, tile, &
270 & lbi, ubi, lbj, ubj, &
271 & hwave)
272 END IF
273# ifdef DISTRIBUTE
274 CALL mp_exchange2d (ng, tile, model, 1, &
275 & lbi, ubi, lbj, ubj, &
276 & nghostpoints, &
277 & ewperiodic(ng), nsperiodic(ng), &
278 & hwave)
279# endif
280#endif
281
282#ifdef WAVES_LENGTH
283 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
284 CALL exchange_r2d_tile (ng, tile, &
285 & lbi, ubi, lbj, ubj, &
286 & lwave)
287 END IF
288# ifdef DISTRIBUTE
289 CALL mp_exchange2d (ng, tile, model, 1, &
290 & lbi, ubi, lbj, ubj, &
291 & nghostpoints, &
292 & ewperiodic(ng), nsperiodic(ng), &
293 & lwave)
294# endif
295#endif
296
297#ifdef WAVES_TOP_PERIOD
298 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
299 CALL exchange_r2d_tile (ng, tile, &
300 & lbi, ubi, lbj, ubj, &
301 & pwave_top)
302 END IF
303# ifdef DISTRIBUTE
304 CALL mp_exchange2d (ng, tile, model, 1, &
305 & lbi, ubi, lbj, ubj, &
306 & nghostpoints, &
307 & ewperiodic(ng), nsperiodic(ng), &
308 & pwave_top)
309# endif
310#endif
311
312#ifdef WAVES_BOT_PERIOD
313 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
314 CALL exchange_r2d_tile (ng, tile, &
315 & lbi, ubi, lbj, ubj, &
316 & pwave_bot)
317 END IF
318# ifdef DISTRIBUTE
319 CALL mp_exchange2d (ng, tile, model, 1, &
320 & lbi, ubi, lbj, ubj, &
321 & nghostpoints, &
322 & ewperiodic(ng), nsperiodic(ng), &
323 & pwave_bot)
324# endif
325#endif
326
327#ifdef WAVES_UB
328 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
329 CALL exchange_r2d_tile (ng, tile, &
330 & lbi, ubi, lbj, ubj, &
331 & uwave_rms)
332 END IF
333# ifdef DISTRIBUTE
334 CALL mp_exchange2d (ng, tile, model, 1, &
335 & lbi, ubi, lbj, ubj, &
336 & nghostpoints, &
337 & ewperiodic(ng), nsperiodic(ng), &
338 & uwave_rms)
339# endif
340#endif
341!
342 RETURN

References ana_wwave(), mod_scalars::deg2rad, mod_scalars::dstart, mod_scalars::ewperiodic, exchange_2d_mod::exchange_r2d_tile(), mp_exchange_mod::mp_exchange2d(), mod_param::nghostpoints, mod_scalars::nsperiodic, mod_scalars::tdays, and mod_scalars::time.

Referenced by ana_wwave().

Here is the call graph for this function:
Here is the caller graph for this function: