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

Contents of /MITgcm/pkg/exf/exf_set_obcs.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, 3 months ago) by dimitri
Branch: MAIN
CVS Tags: checkpoint50c_post, checkpoint50c_pre, checkpoint48i_post, checkpoint50, checkpoint50d_post, checkpoint50b_pre, checkpoint48f_post, checkpoint48h_post, checkpoint50f_post, checkpoint50a_post, checkpoint50f_pre, checkpoint50g_post, checkpoint50h_post, checkpoint50e_pre, checkpoint50i_post, checkpoint50e_post, checkpoint50d_pre, checkpoint49, checkpoint48g_post, checkpoint50b_post
Changes since 1.3: +27 -24 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_obcs_xz (
4 & obcs_fld_xz, obcs_xz_0, obcs_xz_1
5 I , obcs_file, obcsmask
6 I , fac, first, changed, count0, count1
7 I , mycurrenttime, mycurrentiter, mythid
8 & )
9
10 c ==================================================================
11 c SUBROUTINE exf_set_obcs_xz
12 c ==================================================================
13 c
14 c o set open boundary conditions
15 c
16 c started: heimbach@mit.edu 01-May-2001
17 c mods for pkg/seaice: menemenlis@jpl.nasa.gov 20-Dec-2002
18
19 c ==================================================================
20 c SUBROUTINE exf_set_obcs_xz
21 c ==================================================================
22
23 implicit none
24
25 c == global variables ==
26
27 #include "EEPARAMS.h"
28 #include "SIZE.h"
29 #include "GRID.h"
30 #include "exf_param.h"
31 #include "exf_constants.h"
32
33 c == routine arguments ==
34
35 _RL obcs_fld_xz(1-olx:snx+olx,Nr,nsx,nsy)
36 _RL obcs_xz_0(1-olx:snx+olx,Nr,nsx,nsy)
37 _RL obcs_xz_1(1-olx:snx+olx,Nr,nsx,nsy)
38
39 character*(128) obcs_file
40 character*1 obcsmask
41 logical first, changed
42 integer count0, count1
43 _RL fac
44 _RL mycurrenttime
45 integer mycurrentiter
46 integer mythid
47
48 #ifdef ALLOW_OBCS
49
50 c == local variables ==
51
52 integer bi, bj
53 integer i, k
54
55 c == end of interface ==
56
57 if ( obcs_file .NE. ' ' ) then
58
59 if ( first ) then
60 call mdsreadfieldxz( obcs_file, exf_iprec, exf_yftype, Nr
61 & , obcs_xz_1, count0, mythid
62 & )
63 endif
64
65 if (( first ) .or. ( changed )) then
66 call exf_swapffields_xz( obcs_xz_0, obcs_xz_1, mythid )
67
68 call mdsreadfieldxz( obcs_file, exf_iprec, exf_yftype, Nr
69 & , obcs_xz_1, count1, mythid
70 & )
71 endif
72
73 do bj = mybylo(mythid),mybyhi(mythid)
74 do bi = mybxlo(mythid),mybxhi(mythid)
75 do k = 1,Nr
76 do i = 1,snx
77 obcs_fld_xz(i,k,bi,bj) =
78 & fac * obcs_xz_0(i,k,bi,bj) +
79 & (exf_one - fac) * obcs_xz_1(i,k,bi,bj)
80 enddo
81 enddo
82 enddo
83 enddo
84
85 endif
86
87 #endif
88
89 end
90
91 subroutine exf_set_obcs_yz (
92 & obcs_fld_yz, obcs_yz_0, obcs_yz_1
93 I , obcs_file, obcsmask
94 I , fac, first, changed, count0, count1
95 I , mycurrenttime, mycurrentiter, mythid
96 & )
97
98 c ==================================================================
99 c SUBROUTINE exf_set_obcs_yz
100 c ==================================================================
101 c
102 c o set open boundary conditions
103 c
104 c started: heimbach@mit.edu 01-May-2001
105
106 c ==================================================================
107 c SUBROUTINE exf_set_obcs_yz
108 c ==================================================================
109
110 implicit none
111
112 c == global variables ==
113
114 #include "EEPARAMS.h"
115 #include "SIZE.h"
116 #include "GRID.h"
117 #include "exf_param.h"
118 #include "exf_constants.h"
119
120 c == routine arguments ==
121
122 _RL obcs_fld_yz(1-oly:sny+oly,Nr,nsx,nsy)
123 _RL obcs_yz_0(1-oly:sny+oly,Nr,nsx,nsy)
124 _RL obcs_yz_1(1-oly:sny+oly,Nr,nsx,nsy)
125 character*(MAX_LEN_FNAM) obcs_file
126 character*1 obcsmask
127 logical first, changed
128 integer count0, count1
129 _RL fac
130 _RL mycurrenttime
131 integer mycurrentiter
132 integer mythid
133
134 #ifdef ALLOW_OBCS
135
136 c == local variables ==
137
138 integer bi, bj
139 integer j, k
140
141 c == end of interface ==
142
143 if ( first ) then
144 if ( obcs_file .NE. ' ' )
145 & call mdsreadfieldyz( obcs_file, exf_iprec, exf_yftype, Nr
146 & , obcs_yz_1, count0, mythid
147 & )
148 endif
149
150 if (( first ) .or. ( changed )) then
151 call exf_swapffields_yz( obcs_yz_0, obcs_yz_1, mythid )
152
153 if ( obcs_file .NE. ' ' )
154 & call mdsreadfieldyz( obcs_file, exf_iprec, exf_yftype, Nr
155 & , obcs_yz_1, count1, mythid
156 & )
157 endif
158
159 do bj = mybylo(mythid),mybyhi(mythid)
160 do bi = mybxlo(mythid),mybxhi(mythid)
161 do k = 1,Nr
162 do j = 1,sny
163 obcs_fld_yz(j,k,bi,bj) =
164 & fac *obcs_yz_0(j,k,bi,bj) +
165 & (exf_one - fac) *obcs_yz_1(j,k,bi,bj)
166 enddo
167 enddo
168 enddo
169 enddo
170
171 #endif
172
173 end
  ViewVC Help
Powered by ViewVC 1.1.22