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

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

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


Revision 1.1 - (hide annotations) (download)
Mon May 14 22:08:41 2001 UTC (23 years ago) by heimbach
Branch: MAIN
CVS Tags: release1-branch_tutorials, checkpoint40pre1, checkpoint43a-release1mods, chkpt44a_pre, release1-branch-end, checkpoint44, checkpoint40pre2, checkpoint40pre5, checkpoint40pre6, checkpoint40pre8, release1_b1, checkpoint42, checkpoint43, chkpt44a_post, checkpoint44b_pre, checkpoint40pre4, ecco-branch-mod1, checkpoint40pre3, checkpoint40pre9, ecco-branch-mod2, ecco-branch-mod3, release1_beta1, release1-branch_branchpoint, checkpoint40pre7, checkpoint40, checkpoint39, checkpoint41
Branch point for: ecco-branch, release1_coupled, release1-branch, release1
Added external forcing package.
Not presently supported by mitgcm, i.e. disabled by default.

1 heimbach 1.1 c $Header: /u/gcmpack/development/heimbach/ecco_env/pkg/exf/exf_set_climtemp.F,v 1.1 2001/02/02 19:43:48 heimbach Exp $
2    
3     #include "EXF_CPPOPTIONS.h"
4    
5    
6     subroutine exf_set_climtemp(
7     O climtemp
8     I , mycurrenttime
9     I , mycurrentiter
10     I , mythid
11     & )
12    
13     c ==================================================================
14     c SUBROUTINE exf_set_climtemp
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_climtemp
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 climtemp(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy)
47     _RL mycurrenttime
48     integer mycurrentiter
49     integer mythid
50    
51     #ifdef ALLOW_CLIMTEMP_RELAXATION
52    
53     c == local variables ==
54    
55     common /exf_ctemp_r/ climtemp0, climtemp1
56     _RL climtemp0(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy)
57     _RL climtemp1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy)
58    
59     logical first, changed
60     integer count0, count1
61     _RL fac
62    
63     integer bi, bj
64     integer i, j, k
65    
66     c == end of interface ==
67    
68     c get record numbers and interpolation factor for climtemp
69     call exf_GetFFieldRec(
70     I climtempstartdate, climtempperiod
71     O , fac, first, changed
72     O , count0, count1
73     I , mycurrenttime, mycurrentiter, mythid
74     & )
75    
76     if ( first ) then
77     call mdsreadfield( climtempfile, exf_clim_iprec
78     & , exf_clim_yftype, nr
79     & , climtemp1, count0, mythid
80     & )
81     if (exf_clim_yftype .eq. 'RL') then
82     call exf_filter_rl( climtemp1, climtempmask, mythid )
83     else
84     call exf_filter_rs( climtemp1, climtempmask, mythid )
85     end if
86     endif
87    
88     if (( first ) .or. ( changed )) then
89     call exf_SwapFFields_3d( climtemp0, climtemp1, mythid )
90    
91     call mdsreadfield( climtempfile, exf_clim_iprec
92     & , exf_clim_yftype, nr
93     & , climtemp1, count1, mythid
94     & )
95     if (exf_clim_yftype .eq. 'RL') then
96     call exf_filter_rl( climtemp1, climtempmask, mythid )
97     else
98     call exf_filter_rs( climtemp1, climtempmask, mythid )
99     end if
100     endif
101    
102     c Loop over tiles.
103     do bj = mybylo(mythid),mybyhi(mythid)
104     do bi = mybxlo(mythid),mybxhi(mythid)
105     do k = 1,nr
106     do j = 1-oly,sny+oly
107     do i = 1-olx,snx+olx
108    
109     c Set to freezing temperature if less
110     if (climtemp0(i,j,bi,bj) .lt. climtempfreeze) then
111     climtemp0(i,j,bi,bj) = climtempfreeze
112     endif
113     if (climtemp1(i,j,bi,bj) .lt. climtempfreeze) then
114     climtemp1(i,j,bi,bj) = climtempfreeze
115     endif
116    
117     c Interpolate linearly onto the current time.
118     climtemp(i,j,k,bi,bj) =
119     & fac *climtemp0(i,j,k,bi,bj)+
120     & (exf_one - fac) *climtemp1(i,j,k,bi,bj)
121    
122     enddo
123     enddo
124     enddo
125     enddo
126     enddo
127    
128     #endif /* ALLOW_CLIMTEMP_RELAXATION */
129    
130     end
131    
132    
133     subroutine exf_init_climtemp(
134     I mythid
135     & )
136    
137     c ==================================================================
138     c SUBROUTINE exf_init_climtemp
139     c ==================================================================
140     c
141     c o
142     c
143     c started: Ralf.Giering@FastOpt.de 25-Mai-2000
144     c
145     c ==================================================================
146     c SUBROUTINE exf_init_climtemp
147     c ==================================================================
148    
149     implicit none
150    
151     c == global variables ==
152    
153     #include "EEPARAMS.h"
154     #include "SIZE.h"
155    
156     #include "exf_fields.h"
157     #include "exf_param.h"
158     #include "exf_clim_fields.h"
159    
160     c == routine arguments ==
161    
162     integer mythid
163    
164     #ifdef ALLOW_CLIMTEMP_RELAXATION
165    
166     c == local variables ==
167    
168     common /exf_ctemp_r/ climtemp0, climtemp1
169     _RL climtemp0(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy)
170     _RL climtemp1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy)
171    
172     integer bi, bj
173     integer i, j, k
174    
175     c == end of interface ==
176    
177     do bj = mybylo(mythid), mybyhi(mythid)
178     do bi = mybxlo(mythid), mybxhi(mythid)
179     do k=1,nr
180     do j = 1, sny
181     do i = 1, snx
182     climtemp (i,j,k,bi,bj) = 0. _d 0
183     climtemp0(i,j,k,bi,bj) = 0. _d 0
184     climtemp1(i,j,k,bi,bj) = 0. _d 0
185     enddo
186     enddo
187     enddo
188     enddo
189     enddo
190    
191     #endif /* ALLOW_CLIMTEMP_RELAXATION */
192    
193     end

  ViewVC Help
Powered by ViewVC 1.1.22