ROMS
Loading...
Searching...
No Matches
ana_respiration.h
Go to the documentation of this file.
1!!
2 SUBROUTINE ana_respiration (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 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
47 END SUBROUTINE ana_respiration
48!
49!***********************************************************************
50 SUBROUTINE ana_respiration_tile (ng, tile, model, &
51 & LBi, UBi, LBj, UBj, &
52 & IminS, ImaxS, JminS, JmaxS, &
53 & respiration)
54!***********************************************************************
55!
56 USE mod_param
57 USE mod_scalars
58 USE mod_biology
59!
61#ifdef DISTRIBUTE
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
127 END SUBROUTINE ana_respiration_tile
subroutine ana_respiration_tile(ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, respiration)
subroutine ana_respiration(ng, tile, model)
subroutine exchange_r3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, a)
real(r8), dimension(:), allocatable resrate
logical lanafile
character(len=256), dimension(39) ananame
type(t_ocean), dimension(:), allocatable ocean
Definition mod_ocean.F:351
integer nghostpoints
Definition mod_param.F:710
logical, dimension(:), allocatable ewperiodic
logical, dimension(:), allocatable nsperiodic
subroutine mp_exchange3d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, lbk, ubk, nghost, ew_periodic, ns_periodic, a, b, c, d)