ROMS
Loading...
Searching...
No Matches
ana_wtype.h
Go to the documentation of this file.
1!!
2 SUBROUTINE ana_wtype (ng, tile, model)
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
73 END SUBROUTINE ana_wtype
74!
75!***********************************************************************
76 SUBROUTINE ana_wtype_tile (ng, tile, model, &
77 & LBi, UBi, LBj, UBj, &
78 & IminS, ImaxS, JminS, JmaxS, &
79 & h, Jwtype)
80!***********************************************************************
81!
82 USE mod_param
83 USE mod_parallel
84 USE mod_ncparam
85 USE mod_iounits
86 USE mod_scalars
87!
89#ifdef DISTRIBUTE
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
184 END SUBROUTINE ana_wtype_tile
subroutine ana_wtype_tile(ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, h, jwtype)
Definition ana_wtype.h:80
subroutine ana_wtype(ng, tile, model)
Definition ana_wtype.h:3
subroutine exchange_r2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
type(t_grid), dimension(:), allocatable grid
Definition mod_grid.F:365
integer stdout
type(t_mixing), dimension(:), allocatable mixing
Definition mod_mixing.F:399
logical lanafile
character(len=256), dimension(39) ananame
integer, parameter inlm
Definition mod_param.F:662
integer nghostpoints
Definition mod_param.F:710
type(t_domain), dimension(:), allocatable domain
Definition mod_param.F:329
integer, parameter r2dvar
Definition mod_param.F:717
logical, dimension(:), allocatable ewperiodic
logical, dimension(:), allocatable nsperiodic
real(dp), parameter large
subroutine mp_exchange2d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, nghost, ew_periodic, ns_periodic, a, b, c, d)
subroutine, public stats_2dfld(ng, tile, model, gtype, s, extract_flag, lbi, ubi, lbj, ubj, f, fmask, debug)
Definition stats.F:47