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

Annotation of /MITgcm/pkg/exf/exf_set_obcs.F

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

Revision 1.4 - (hide 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 heimbach 1.1 #include "EXF_CPPOPTIONS.h"
2    
3     subroutine exf_set_obcs_xz (
4 heimbach 1.3 & obcs_fld_xz, obcs_xz_0, obcs_xz_1
5     I , obcs_file, obcsmask
6 heimbach 1.1 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 dimitri 1.4 c mods for pkg/seaice: menemenlis@jpl.nasa.gov 20-Dec-2002
18 heimbach 1.1
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 heimbach 1.3 _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 heimbach 1.1 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 heimbach 1.2 integer i, k
54    
55 heimbach 1.1 c == end of interface ==
56    
57 dimitri 1.4 if ( obcs_file .NE. ' ' ) then
58 heimbach 1.1
59 dimitri 1.4 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 heimbach 1.1
85     endif
86    
87     #endif
88    
89     end
90    
91     subroutine exf_set_obcs_yz (
92 heimbach 1.3 & obcs_fld_yz, obcs_yz_0, obcs_yz_1
93     I , obcs_file, obcsmask
94 heimbach 1.1 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 heimbach 1.3 _RL obcs_yz_0(1-oly:sny+oly,Nr,nsx,nsy)
124     _RL obcs_yz_1(1-oly:sny+oly,Nr,nsx,nsy)
125 heimbach 1.1 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 heimbach 1.2 integer j, k
140    
141 heimbach 1.1 c == end of interface ==
142    
143     if ( first ) then
144 heimbach 1.3 if ( obcs_file .NE. ' ' )
145     & call mdsreadfieldyz( obcs_file, exf_iprec, exf_yftype, Nr
146 heimbach 1.1 & , 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 heimbach 1.3 if ( obcs_file .NE. ' ' )
154     & call mdsreadfieldyz( obcs_file, exf_iprec, exf_yftype, Nr
155 heimbach 1.1 & , 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