ROMS
Loading...
Searching...
No Matches
ana_cloud.h
Go to the documentation of this file.
1!!
2 SUBROUTINE ana_cloud (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 cloud fraction using an analytical expression. !
12! !
13!=======================================================================
14!
15 USE mod_param
16 USE mod_forces
17 USE mod_ncparam
18!
19! Imported variable declarations.
20!
21 integer, intent(in) :: ng, tile, model
22!
23! Local variable declarations.
24!
25 character (len=*), parameter :: MyFile = &
26 & __FILE__
27!
28#include "tile.h"
29!
30 CALL ana_cloud_tile (ng, tile, model, &
31 & lbi, ubi, lbj, ubj, &
32 & imins, imaxs, jmins, jmaxs, &
33 & forces(ng) % cloud)
34!
35! Set analytical header file name used.
36!
37#ifdef DISTRIBUTE
38 IF (lanafile) THEN
39#else
40 IF (lanafile.and.(tile.eq.0)) THEN
41#endif
42 ananame( 4)=myfile
43 END IF
44!
45 RETURN
46 END SUBROUTINE ana_cloud
47!
48!***********************************************************************
49 SUBROUTINE ana_cloud_tile (ng, tile, model, &
50 & LBi, UBi, LBj, UBj, &
51 & IminS, ImaxS, JminS, JmaxS, &
52 & cloud)
53!***********************************************************************
54!
55 USE mod_param
56 USE mod_scalars
57!
58#ifdef PAPA_CLM
59 USE dateclock_mod, ONLY : caldate
60#endif
62#ifdef DISTRIBUTE
64#endif
65!
66! Imported variable declarations.
67!
68 integer, intent(in) :: ng, tile, model
69 integer, intent(in) :: LBi, UBi, LBj, UBj
70 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
71!
72#ifdef ASSUMED_SHAPE
73 real(r8), intent(out) :: cloud(LBi:,LBj:)
74#else
75 real(r8), intent(out) :: cloud(LBi:UBi,LBj:UBj)
76#endif
77!
78! Local variable declarations.
79!
80 integer :: i, j
81!
82 real(r8) :: Cval
83 real(dp) :: yday
84
85#ifdef PAPA_CLM
86!
87 real(dp), dimension(14) :: Coktas = &
88 & (/ 6.29_r8, 6.26_r8, 6.31_r8, 6.31_r8, 6.32_r8, &
89 & 6.70_r8, 7.12_r8, 7.26_r8, 6.93_r8, 6.25_r8, &
90 & 6.19_r8, 6.23_r8, 6.31_r8, 6.29_r8 /)
91
92 real(dp), dimension(14) :: Cyday = &
93 & (/ 0.0_dp, 16.0_dp, 46.0_dp, 75.0_dp, 105.0_dp, &
94 & 136.0_dp, 166.0_dp, 197.0_dp, 228.0_dp, 258.0_dp, &
95 & 289.0_dp, 319.0_dp, 350.0_dp, 365.0_dp /)
96#endif
97
98#include "set_bounds.h"
99!
100!-----------------------------------------------------------------------
101! Set analytical cloud fraction (%/100): 0=clear sky, 1:overcast sky.
102!-----------------------------------------------------------------------
103!
104#if defined PAPA_CLM
105
106! OWS Papa cloud climatology.
107!
108 CALL caldate (tdays(ng), yd_dp=yday)
109 DO i=1,13
110 IF ((yday.ge.cyday(i)).and.(yday.le.cyday(i+1))) THEN
111 cval=0.125_r8*(coktas(i )*(cyday(i+1)-yday)+ &
112 & coktas(i+1)*(yday-cyday(i)))/ &
113 & (cyday(i+1)-cyday(i))
114 END IF
115 END DO
116#elif defined BENCHMARK
117 cval=0.6_r8
118#elif defined NJ_BIGHT
119 cval=0.3_r8
120#else
121 cval=0.0_r8
122#endif
123
124 DO j=jstrt,jendt
125 DO i=istrt,iendt
126 cloud(i,j)=cval
127 END DO
128 END DO
129!
130! Exchange boundary data.
131!
132 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
133 CALL exchange_r2d_tile (ng, tile, &
134 & lbi, ubi, lbj, ubj, &
135 & cloud)
136 END IF
137
138#ifdef DISTRIBUTE
139 CALL mp_exchange2d (ng, tile, model, 1, &
140 & lbi, ubi, lbj, ubj, &
141 & nghostpoints, &
142 & ewperiodic(ng), nsperiodic(ng), &
143 & cloud)
144#endif
145!
146 RETURN
147 END SUBROUTINE ana_cloud_tile
subroutine ana_cloud_tile(ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, cloud)
Definition ana_cloud.h:53
subroutine ana_cloud(ng, tile, model)
Definition ana_cloud.h:3
subroutine, public caldate(currenttime, yy_i, yd_i, mm_i, dd_i, h_i, m_i, s_i, yd_dp, dd_dp, h_dp, m_dp, s_dp)
Definition dateclock.F:76
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
real(dp), dimension(:), allocatable tdays
subroutine mp_exchange2d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, nghost, ew_periodic, ns_periodic, a, b, c, d)