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

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

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

Revision 1.2 - (hide annotations) (download)
Thu Feb 7 20:00:09 2002 UTC (22 years, 4 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint46b_post, checkpoint46k_post, checkpoint46c_pre, checkpoint45d_post, checkpoint44h_pre, checkpoint46j_post, checkpoint44f_pre, checkpoint45a_post, checkpoint46f_post, checkpoint46a_post, checkpoint46d_pre, checkpoint46e_post, checkpoint45b_post, checkpoint44g_post, checkpoint46h_pre, checkpoint45c_post, checkpoint44h_post, chkpt44c_post, checkpoint44e_post, checkpoint46e_pre, checkpoint46l_pre, checkpoint46j_pre, checkpoint46b_pre, checkpoint46l_post, release1_final_v1, checkpoint46, checkpoint44f_post, checkpoint44b_post, chkpt44d_post, checkpoint46m_post, checkpoint46g_pre, checkpoint46a_pre, checkpoint44e_pre, chkpt44c_pre, checkpoint46d_post, checkpoint46g_post, checkpoint46i_post, checkpoint46c_post, checkpoint45, checkpoint46h_post
Branch point for: release1_final
Changes since 1.1: +19 -16 lines 
o merge of relevant stuff from the ecco-branch:
  - genmake: removed $S64 overwrite for case SunOS
  - pkg/exf: update and corrections for field swapping and obcs
  - pkg/ecco: parameter lists for the_model_main, the_main_loop
              harmonized between ECCO and MITgcm
  - pkg/autodiff: added flow directives for obcs, mdsio_gl_slice
                  updated checkpointing_lev... lists for obcs
  - model/src: minor changes in forward_step, plot_field
               added directive for divided adjoint in the_main_loop
  - pkg/mdsio: added mdsio_gl_slice
1 heimbach 1.2 c $Header: /u/gcmpack/MITgcm/pkg/exf/exf_set_climsst.F,v 1.1.6.1 2002/02/06 23:18:54 heimbach Exp $
2 heimbach 1.1
3     #include "EXF_CPPOPTIONS.h"
4    
5    
6     subroutine exf_set_climsst(
7     O climsst
8     I , mycurrenttime
9     I , mycurrentiter
10     I , mythid
11     & )
12    
13     c ==================================================================
14     c SUBROUTINE exf_set_climsst
15     c ==================================================================
16     c
17     c o Get the current climatological sea surface salinity field.
18     c
19     c started: Christian Eckert eckert@mit.edu 27-Aug-1999
20     c
21     c changed: Christian Eckert eckert@mit.edu 11-Jan-2000
22     c
23     c - Restructured the code in order to create a package
24     c for the MITgcmUV.
25     c
26     c Christian Eckert eckert@mit.edu 12-Feb-2000
27     c
28     c - Changed Routine names (package prefix: exf_)
29     c
30     c ==================================================================
31     c SUBROUTINE exf_set_climsst
32     c ==================================================================
33    
34     implicit none
35    
36     #include "EEPARAMS.h"
37     #include "SIZE.h"
38     #include "GRID.h"
39    
40     #include "exf_param.h"
41     #include "exf_constants.h"
42     #include "exf_clim_param.h"
43    
44     c == routine arguments ==
45    
46     _RL climsst(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
47     _RL mycurrenttime
48     integer mycurrentiter
49     integer mythid
50    
51     #ifdef ALLOW_CLIMSST_RELAXATION
52    
53     c == local variables ==
54    
55     common /exf_csst_r/ climsst0, climsst1
56     _RL climsst0(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
57     _RL climsst1(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
58    
59     logical first, changed
60     integer count0, count1
61     _RL fac
62    
63     integer bi, bj
64     integer i, j
65    
66     c == end of interface ==
67    
68 heimbach 1.2 #ifdef ALLOW_CLIM_CYCLIC
69     c record numbers are assumed 1 to 12 corresponding to
70     c Jan. through Dec.
71     call cal_GetMonthsRec(
72     O fac, first, changed,
73     O count0, count1,
74     I mycurrenttime, mycurrentiter, mythid
75     & )
76     #else
77 heimbach 1.1 c get record numbers and interpolation factor for climsst
78     call exf_GetFFieldRec(
79     I climsststartdate, climsstperiod
80     O , fac, first, changed
81     O , count0, count1
82     I , mycurrenttime, mycurrentiter, mythid
83     & )
84 heimbach 1.2 #endif
85 heimbach 1.1
86 heimbach 1.2 #ifndef ALLOW_AUTODIFF_TAMC
87 heimbach 1.1 if ( first ) then
88 heimbach 1.2 #endif
89 heimbach 1.1 call mdsreadfield( climsstfile, exf_clim_iprec
90     & , exf_clim_yftype, 1
91     & , climsst1, count0, mythid
92     & )
93     if (exf_clim_yftype .eq. 'RL') then
94     call exf_filter_rl( climsst1, climsstmask, mythid )
95     else
96     call exf_filter_rs( climsst1, climsstmask, mythid )
97     end if
98 heimbach 1.2 #ifndef ALLOW_AUTODIFF_TAMC
99 heimbach 1.1 endif
100 heimbach 1.2 #endif
101 heimbach 1.1
102 heimbach 1.2 #ifndef ALLOW_AUTODIFF_TAMC
103 heimbach 1.1 if (( first ) .or. ( changed )) then
104 heimbach 1.2 #endif
105 heimbach 1.1 call exf_SwapFFields( climsst0, climsst1, mythid )
106    
107     call mdsreadfield( climsstfile, exf_clim_iprec
108     & , exf_clim_yftype, 1
109     & , climsst1, count1, mythid
110     & )
111     if (exf_clim_yftype .eq. 'RL') then
112     call exf_filter_rl( climsst1, climsstmask, mythid )
113     else
114     call exf_filter_rs( climsst1, climsstmask, mythid )
115     end if
116 heimbach 1.2 #ifndef ALLOW_AUTODIFF_TAMC
117 heimbach 1.1 endif
118 heimbach 1.2 #endif
119 heimbach 1.1
120     c Loop over tiles.
121     do bj = mybylo(mythid),mybyhi(mythid)
122     do bi = mybxlo(mythid),mybxhi(mythid)
123     do j = 1-oly,sny+oly
124     do i = 1-olx,snx+olx
125    
126     c Set to freezing temperature if less
127     if (climsst0(i,j,bi,bj) .lt. climtempfreeze) then
128     climsst0(i,j,bi,bj) = climtempfreeze
129     endif
130     if (climsst1(i,j,bi,bj) .lt. climtempfreeze) then
131     climsst1(i,j,bi,bj) = climtempfreeze
132     endif
133    
134     c Interpolate linearly onto the current time.
135     climsst(i,j,bi,bj) = fac *climsst0(i,j,bi,bj)+
136     & (exf_one - fac) *climsst1(i,j,bi,bj)
137    
138     enddo
139     enddo
140     enddo
141     enddo
142    
143     #endif /* ALLOW_CLIMSST_RELAXATION */
144    
145     end
146    
147    
148     subroutine exf_init_climsst(
149     I mythid
150     & )
151    
152     c ==================================================================
153     c SUBROUTINE exf_init_climsst
154     c ==================================================================
155     c
156     c o
157     c
158     c started: Ralf.Giering@FastOpt.de 25-Mai-2000
159     c
160     c ==================================================================
161     c SUBROUTINE exf_init_climsst
162     c ==================================================================
163    
164     implicit none
165    
166     c == global variables ==
167    
168     #include "EEPARAMS.h"
169     #include "SIZE.h"
170    
171     #include "exf_fields.h"
172     #include "exf_param.h"
173     #include "exf_clim_param.h"
174     #include "exf_clim_fields.h"
175    
176     c == routine arguments ==
177    
178     integer mythid
179    
180     #ifdef ALLOW_CLIMSST_RELAXATION
181    
182     c == local variables ==
183    
184     common /exf_csst_r/ climsst0, climsst1
185     _RL climsst0(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
186     _RL climsst1(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
187    
188     integer bi, bj
189     integer i, j
190    
191     c == end of interface ==
192    
193     do bj = mybylo(mythid), mybyhi(mythid)
194     do bi = mybxlo(mythid), mybxhi(mythid)
195     do j = 1, sny
196     do i = 1, snx
197     climsst (i,j,bi,bj) = 0. _d 0
198     climsst0(i,j,bi,bj) = 0. _d 0
199     climsst1(i,j,bi,bj) = 0. _d 0
200     enddo
201     enddo
202     enddo
203     enddo
204    
205     #endif /* ALLOW_CLIMSSST_RELAXATION */
206    
207     end
  ViewVC Help
Powered by ViewVC 1.1.22