ROMS
Loading...
Searching...
No Matches
ana_sst.h
Go to the documentation of this file.
1!!
2 SUBROUTINE ana_sst (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 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
50 END SUBROUTINE ana_sst
51!
52!***********************************************************************
53 SUBROUTINE ana_sst_tile (ng, tile, model, &
54 & LBi, UBi, LBj, UBj, &
55 & IminS, ImaxS, JminS, JmaxS, &
56 & sst)
57!***********************************************************************
58!
59 USE mod_param
60 USE mod_scalars
61!
63#ifdef DISTRIBUTE
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
112 END SUBROUTINE ana_sst_tile
subroutine ana_sst(ng, tile, model)
Definition ana_sst.h:3
subroutine ana_sst_tile(ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, sst)
Definition ana_sst.h:57
subroutine exchange_r2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
type(t_forces), dimension(:), allocatable forces
Definition mod_forces.F:554
logical lanafile
character(len=256), dimension(39) ananame
integer nghostpoints
Definition mod_param.F:710
logical, dimension(:), allocatable ewperiodic
logical, dimension(:), allocatable nsperiodic
subroutine mp_exchange2d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, nghost, ew_periodic, ns_periodic, a, b, c, d)