ROMS
Loading...
Searching...
No Matches
ana_m3clima.h
Go to the documentation of this file.
1!!
2 SUBROUTINE ana_m3clima (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 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
44 END SUBROUTINE ana_m3clima
45!
46!***********************************************************************
47 SUBROUTINE ana_m3clima_tile (ng, tile, model, &
48 & LBi, UBi, LBj, UBj, &
49 & IminS, ImaxS, JminS, JmaxS)
50!***********************************************************************
51!
52 USE mod_param
53 USE mod_clima
54 USE mod_scalars
55!
57#ifdef DISTRIBUTE
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
113 END SUBROUTINE ana_m3clima_tile
subroutine ana_m3clima(ng, tile, model)
Definition ana_m3clima.h:3
subroutine ana_m3clima_tile(ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs)
Definition ana_m3clima.h:50
subroutine exchange_u3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, a)
subroutine exchange_v3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, a)
type(t_clima), dimension(:), allocatable clima
Definition mod_clima.F:153
logical lanafile
character(len=256), dimension(39) ananame
integer, dimension(:), allocatable n
Definition mod_param.F:479
integer nghostpoints
Definition mod_param.F:710
logical, dimension(:), allocatable ewperiodic
logical, dimension(:), allocatable nsperiodic
logical, dimension(:), allocatable lm3clm
subroutine mp_exchange3d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, lbk, ubk, nghost, ew_periodic, ns_periodic, a, b, c, d)