/[MITgcm]/MITgcm/pkg/exf/exf_set_swflux.F
ViewVC logotype

Contents of /MITgcm/pkg/exf/exf_set_swflux.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph

Revision 1.4 - (show annotations) (download)
Tue Feb 18 05:33:54 2003 UTC (21 years, 4 months ago) by dimitri
Branch: MAIN
CVS Tags: checkpoint48f_post, checkpoint48i_post, checkpoint48h_post, checkpoint48g_post
Changes since 1.3: +50 -46 lines 
Merging from release1_p12:
o Modifications for using pkg/exf with pkg/seaice
  - improved description of the various forcing configurations
  - added basic radiation bulk formulae to pkg/exf
  - units/sign fix for evap computation in exf_getffields.F
  - updated verification/global_with_exf/results/output.txt
o Added pkg/sbo for computing IERS Special Bureau for the Oceans
  (SBO) core products, including oceanic mass, center-of-mass,
  angular, and bottom pressure (see pkg/sbo/README.sbo).
o Lower bound for viscosity/diffusivity in pkg/kpp/kpp_routines.F
  to avoid negative values in shallow regions.
  - updated verification/natl_box/results/output.txt
  - updated verification/lab_sea/results/output.txt
o MPI gather, scatter: eesupp/src/gather_2d.F and scatter_2d.F
o Added useSingleCpuIO option (see PARAMS.h).
o Updated useSingleCpuIO option in mdsio_writefield.F to
  work with multi-field files, e.g., for single-file pickup.
o pkg/seaice:
  - bug fix in growth.F: QNET for no shortwave case
  - added HeffFile for specifying initial sea-ice thickness
  - changed SEAICE_EXTERNAL_FLUXES wind stress implementation
o Added missing /* */ to CPP comments in pkg/seaice, pkg/exf,
  kpp_transport_t.F, forward_step.F, and the_main_loop.F
o pkg/seaice:
  - adjoint-friendly modifications
  - added a SEAICE_WRITE_PICKUP at end of the_model_main.F
1 #include "EXF_CPPOPTIONS.h"
2
3 subroutine exf_set_swflux(mycurrenttime, mycurrentiter, mythid )
4
5 c ==================================================================
6 c SUBROUTINE exf_set_swflux
7 c ==================================================================
8 c
9 c o set external forcing swflux
10 c
11 c started: Ralf.Giering@FastOpt.de 25-Mai-2000
12 c changed: heimbach@mit.edu 10-Jan-2002
13 c mods for pkg/seaice: menemenlis@jpl.nasa.gov 20-Dec-2002
14
15 c ==================================================================
16 c SUBROUTINE exf_set_swflux
17 c ==================================================================
18
19 implicit none
20
21 c == global variables ==
22
23 #include "EEPARAMS.h"
24 #include "SIZE.h"
25 #include "GRID.h"
26
27 #include "exf_param.h"
28 #include "exf_constants.h"
29 #include "exf_fields.h"
30
31 c == routine arguments ==
32
33 _RL mycurrenttime
34 integer mycurrentiter
35 integer mythid
36
37 #if defined(ALLOW_ATM_TEMP) || defined(SHORTWAVE_HEATING)
38 c == local variables ==
39
40 logical first, changed
41 integer count0, count1
42 _RL fac
43
44 integer bi, bj
45 integer i, j
46
47 c == end of interface ==
48
49 if ( swfluxfile .NE. ' ' ) then
50
51 c get record numbers and interpolation factor for swflux
52 call exf_GetFFieldRec(
53 I swfluxstartdate, swfluxperiod
54 O , fac, first, changed
55 O , count0, count1
56 I , mycurrenttime, mycurrentiter, mythid
57 & )
58
59 if ( first ) then
60 call mdsreadfield( swfluxfile, exf_iprec, exf_yftype, 1
61 & , swflux1, count0, mythid
62 & )
63 if (exf_yftype .eq. 'RL') then
64 call exf_filter_rl( swflux1, swfluxmask, mythid )
65 else
66 call exf_filter_rs( swflux1, swfluxmask, mythid )
67 end if
68 endif
69
70 if (( first ) .or. ( changed )) then
71 call exf_SwapFFields( swflux0, swflux1, mythid )
72
73 call mdsreadfield( swfluxfile, exf_iprec, exf_yftype, 1
74 & , swflux1, count1, mythid
75 & )
76 if (exf_yftype .eq. 'RL') then
77 call exf_filter_rl( swflux1, swfluxmask, mythid )
78 else
79 call exf_filter_rs( swflux1, swfluxmask, mythid )
80 end if
81 endif
82
83 c Loop over tiles.
84 do bj = mybylo(mythid),mybyhi(mythid)
85 do bi = mybxlo(mythid),mybxhi(mythid)
86 do j = 1,sny
87 do i = 1,snx
88
89 c Interpolate linearly onto the current time.
90
91 swflux(i,j,bi,bj) = exf_inscal_swf * (
92 & fac * swflux0(i,j,bi,bj) +
93 & (exf_one - fac) * swflux1(i,j,bi,bj) )
94
95 enddo
96 enddo
97 enddo
98 enddo
99
100 endif
101
102 #endif
103
104 end
105
106
107
108 subroutine exf_init_swflux( mythid )
109
110 c ==================================================================
111 c SUBROUTINE exf_init_swflux
112 c ==================================================================
113 c
114 c o
115 c
116 c started: Ralf.Giering@FastOpt.de 25-Mai-2000
117 c changed: heimbach@mit.edu 10-Jan-2002
118 c
119 c ==================================================================
120 c SUBROUTINE exf_init_swflux
121 c ==================================================================
122
123 implicit none
124
125 c == global variables ==
126
127 #include "EEPARAMS.h"
128 #include "SIZE.h"
129
130 #include "exf_param.h"
131 #include "exf_fields.h"
132
133 c == routine arguments ==
134
135 integer mythid
136
137 #if defined(ALLOW_ATM_TEMP) || defined(SHORTWAVE_HEATING)
138 c == local variables ==
139
140 integer bi, bj
141 integer i, j
142
143 c == end of interface ==
144
145 do bj = mybylo(mythid), mybyhi(mythid)
146 do bi = mybxlo(mythid), mybxhi(mythid)
147 do j = 1, sny
148 do i = 1, snx
149 swflux(i,j,bi,bj) = 0. _d 0
150 swflux0(i,j,bi,bj) = 0. _d 0
151 swflux1(i,j,bi,bj) = 0. _d 0
152 enddo
153 enddo
154 enddo
155 enddo
156
157 #endif
158
159 end
  ViewVC Help
Powered by ViewVC 1.1.22