ROMS
Loading...
Searching...
No Matches
ana_btflux.h
Go to the documentation of this file.
1!!
2 SUBROUTINE ana_btflux (ng, tile, model, itrc)
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
48 END SUBROUTINE ana_btflux
49!
50!***********************************************************************
51 SUBROUTINE ana_btflux_tile (ng, tile, model, itrc, &
52 & LBi, UBi, LBj, UBj, &
53 & IminS, ImaxS, JminS, JmaxS, &
54 & btflux)
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
115 END SUBROUTINE ana_btflux_tile
subroutine ana_btflux_tile(ng, tile, model, itrc, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, btflux)
Definition ana_btflux.h:55
subroutine ana_btflux(ng, tile, model, itrc)
Definition ana_btflux.h:3
type(t_forces), dimension(:), allocatable forces
Definition mod_forces.F:554
logical lanafile
character(len=256), dimension(39) ananame
integer isalt
integer itemp