pkg/exf/exf_set_climsst.F

c $Header: /u/gcmpack/MITgcm/pkg/exf/exf_set_climsst.F,v 1.7 2003/08/04 22:53:42 dimitri Exp $

#include "EXF_CPPOPTIONS.h"


      subroutine exf_set_climsst( 
     O                            mycurrenttime
     I                          , mycurrentiter
     I                          , mythid
     &                         )

c     ==================================================================
c     SUBROUTINE exf_set_climsst
c     ==================================================================
c
c     o  Get the current climatological sea surface salinity field.
c     started: Christian Eckert eckert@mit.edu 27-Aug-1999
c     changed: Christian Eckert eckert@mit.edu 11-Jan-2000
c              - Restructured the code in order to create a package
c                for the MITgcmUV.
c              Christian Eckert eckert@mit.edu 12-Feb-2000
c              - Changed Routine names (package prefix: exf_)
c     changed: heimbach@mit.edu 08-Feb-2002
c     mods for pkg/seaice: menemenlis@jpl.nasa.gov 20-Dec-2002
c
c     ==================================================================
c     SUBROUTINE exf_set_climsst
c     ==================================================================

      implicit none

#include "EEPARAMS.h"
#include "SIZE.h"
#include "GRID.h"

#include "exf_param.h"
#include "exf_constants.h"
#include "exf_clim_param.h"
#include "exf_clim_fields.h"

c     == routine arguments ==

      _RL     mycurrenttime
      integer mycurrentiter
      integer mythid

#ifdef ALLOW_CLIMSST_RELAXATION

c     == local variables ==

      logical first, changed
      integer count0, count1
      _RL     fac

      integer bi, bj
      integer i, j

c     == end of interface ==

      if ( climsstfile .NE. ' ' ) then

#ifdef ALLOW_CLIM_CYCLIC
c     record numbers are assumed 1 to 12 corresponding to
c     Jan. through Dec.
         call cal_GetMonthsRec(
     O        fac, first, changed,
     O        count0, count1,
     I        mycurrenttime, mycurrentiter, mythid
     &        )
#else 
c     get record numbers and interpolation factor for climsst
         call exf_GetFFieldRec(
     I        climsststartdate, climsstperiod
     O        , fac, first, changed
     O        , count0, count1
     I        , mycurrenttime, mycurrentiter, mythid
     &        )
#endif

         if ( first ) then
#ifdef USE_EXF_INTERPOLATION
          call exf_interp(
     &    climsstfile, exf_clim_iprec
     &  , climsst1, count0, xC, yC
     &  ,climsst_lon0,climsst_lon_inc
     &  ,climsst_lat0,climsst_lat_inc
     &  ,climsst_nlon,climsst_nlat,mythid )
#else
            call mdsreadfield( climsstfile, exf_clim_iprec
     &           , exf_clim_yftype, 1
     &           , climsst1, count0, mythid
     &           )
#endif
            if (exf_clim_yftype .eq. 'RL') then
               call exf_filter_rl( climsst1, climsstmask, mythid )
            else
               call exf_filter_rs( climsst1, climsstmask, mythid )
            end if
         endif

         if (( first ) .or. ( changed )) then
            call exf_SwapFFields( climsst0, climsst1, mythid )
            
#ifdef USE_EXF_INTERPOLATION
          call exf_interp(
     &    climsstfile, exf_iprec
     &  , climsst1, count1, xC, yC
     &  ,climsst_lon0,climsst_lon_inc
     &  ,climsst_lat0,climsst_lat_inc
     &  ,climsst_nlon,climsst_nlat,mythid )
#else
            call mdsreadfield( climsstfile, exf_clim_iprec
     &           , exf_clim_yftype, 1
     &           , climsst1, count1, mythid
     &           )
#endif
            if (exf_clim_yftype .eq. 'RL') then
               call exf_filter_rl( climsst1, climsstmask, mythid )
            else
               call exf_filter_rs( climsst1, climsstmask, mythid )
            end if
         endif

c     Loop over tiles.
         do bj = mybylo(mythid),mybyhi(mythid)
            do bi = mybxlo(mythid),mybxhi(mythid)
               do j = 1,sny
                  do i = 1,snx

c     Set to freezing temperature if less
                     if (climsst0(i,j,bi,bj) .lt. climtempfreeze) then
                        climsst0(i,j,bi,bj) = climtempfreeze
                     endif
                     if (climsst1(i,j,bi,bj) .lt. climtempfreeze) then
                        climsst1(i,j,bi,bj) = climtempfreeze
                     endif

c     Interpolate linearly onto the current time.
                     climsst(i,j,bi,bj) = exf_inscal_sst * (
     &                                fac * climsst0(i,j,bi,bj) +
     &                    (exf_one - fac) * climsst1(i,j,bi,bj) )

                  enddo
               enddo
            enddo
         enddo

      endif

#endif /* ALLOW_CLIMSST_RELAXATION */

      end


      subroutine exf_init_climsst(
     I                             mythid
     &                           )

c     ==================================================================
c     SUBROUTINE exf_init_climsst
c     ==================================================================
c
c     o 
c
c     started: Ralf.Giering@FastOpt.de 25-Mai-2000
c
c     ==================================================================
c     SUBROUTINE exf_init_climsst
c     ==================================================================

      implicit none

c     == global variables ==

#include "EEPARAMS.h"
#include "SIZE.h"

#include "exf_fields.h"
#include "exf_param.h"
#include "exf_clim_param.h"
#include "exf_clim_fields.h"

c     == routine arguments ==

      integer mythid

#ifdef ALLOW_CLIMSST_RELAXATION

c     == local variables ==

      integer bi, bj
      integer i, j

c     == end of interface ==

      do bj = mybylo(mythid), mybyhi(mythid)
        do bi = mybxlo(mythid), mybxhi(mythid)
          do j = 1, sny
            do i = 1, snx
              climsst (i,j,bi,bj) = climsstconst
              climsst0(i,j,bi,bj) = 0. _d 0
              climsst1(i,j,bi,bj) = 0. _d 0
            enddo
          enddo
        enddo
      enddo

#endif /* ALLOW_CLIMSSST_RELAXATION */

      end
1	dimitri	1.8	c $Header: /u/gcmpack/MITgcm/pkg/exf/exf_set_climsst.F,v 1.7 2003/08/04 22:53:42 dimitri Exp $
2	heimbach	1.1
3			#include "EXF_CPPOPTIONS.h"
4
5
6			subroutine exf_set_climsst(
7	heimbach	1.3	O mycurrenttime
8	heimbach	1.1	I , mycurrentiter
9			I , mythid
10			& )
11
12			c ==================================================================
13			c SUBROUTINE exf_set_climsst
14			c ==================================================================
15			c
16			c o Get the current climatological sea surface salinity field.
17			c started: Christian Eckert eckert@mit.edu 27-Aug-1999
18			c changed: Christian Eckert eckert@mit.edu 11-Jan-2000
19			c - Restructured the code in order to create a package
20			c for the MITgcmUV.
21			c Christian Eckert eckert@mit.edu 12-Feb-2000
22			c - Changed Routine names (package prefix: exf_)
23	heimbach	1.3	c changed: heimbach@mit.edu 08-Feb-2002
24	dimitri	1.5	c mods for pkg/seaice: menemenlis@jpl.nasa.gov 20-Dec-2002
25	heimbach	1.1	c
26			c ==================================================================
27			c SUBROUTINE exf_set_climsst
28			c ==================================================================
29
30			implicit none
31
32			#include "EEPARAMS.h"
33			#include "SIZE.h"
34			#include "GRID.h"
35
36			#include "exf_param.h"
37			#include "exf_constants.h"
38			#include "exf_clim_param.h"
39	heimbach	1.3	#include "exf_clim_fields.h"
40	heimbach	1.1
41			c == routine arguments ==
42
43			_RL mycurrenttime
44			integer mycurrentiter
45			integer mythid
46
47			#ifdef ALLOW_CLIMSST_RELAXATION
48
49			c == local variables ==
50
51			logical first, changed
52			integer count0, count1
53			_RL fac
54
55			integer bi, bj
56			integer i, j
57
58			c == end of interface ==
59
60	dimitri	1.5	if ( climsstfile .NE. ' ' ) then
61
62	heimbach	1.2	#ifdef ALLOW_CLIM_CYCLIC
63			c record numbers are assumed 1 to 12 corresponding to
64			c Jan. through Dec.
65	dimitri	1.5	call cal_GetMonthsRec(
66			O fac, first, changed,
67			O count0, count1,
68			I mycurrenttime, mycurrentiter, mythid
69			& )
70			#else
71	heimbach	1.1	c get record numbers and interpolation factor for climsst
72	dimitri	1.5	call exf_GetFFieldRec(
73			I climsststartdate, climsstperiod
74			O , fac, first, changed
75			O , count0, count1
76			I , mycurrenttime, mycurrentiter, mythid
77			& )
78	heimbach	1.2	#endif
79	heimbach	1.1
80	dimitri	1.5	if ( first ) then
81	dimitri	1.7	#ifdef USE_EXF_INTERPOLATION
82	dimitri	1.8	call exf_interp(
83	dimitri	1.7	& climsstfile, exf_clim_iprec
84			& , climsst1, count0, xC, yC
85			& ,climsst_lon0,climsst_lon_inc
86			& ,climsst_lat0,climsst_lat_inc
87			& ,climsst_nlon,climsst_nlat,mythid )
88			#else
89	dimitri	1.5	call mdsreadfield( climsstfile, exf_clim_iprec
90			& , exf_clim_yftype, 1
91			& , climsst1, count0, mythid
92			& )
93	dimitri	1.7	#endif
94	dimitri	1.5	if (exf_clim_yftype .eq. 'RL') then
95			call exf_filter_rl( climsst1, climsstmask, mythid )
96			else
97			call exf_filter_rs( climsst1, climsstmask, mythid )
98			end if
99			endif
100
101			if (( first ) .or. ( changed )) then
102			call exf_SwapFFields( climsst0, climsst1, mythid )
103	dimitri	1.7
104			#ifdef USE_EXF_INTERPOLATION
105	dimitri	1.8	call exf_interp(
106	dimitri	1.7	& climsstfile, exf_iprec
107			& , climsst1, count1, xC, yC
108			& ,climsst_lon0,climsst_lon_inc
109			& ,climsst_lat0,climsst_lat_inc
110			& ,climsst_nlon,climsst_nlat,mythid )
111			#else
112	dimitri	1.5	call mdsreadfield( climsstfile, exf_clim_iprec
113			& , exf_clim_yftype, 1
114			& , climsst1, count1, mythid
115			& )
116	dimitri	1.7	#endif
117	dimitri	1.5	if (exf_clim_yftype .eq. 'RL') then
118			call exf_filter_rl( climsst1, climsstmask, mythid )
119			else
120			call exf_filter_rs( climsst1, climsstmask, mythid )
121			end if
122			endif
123	heimbach	1.1
124			c Loop over tiles.
125	dimitri	1.5	do bj = mybylo(mythid),mybyhi(mythid)
126			do bi = mybxlo(mythid),mybxhi(mythid)
127			do j = 1,sny
128			do i = 1,snx
129
130			c Set to freezing temperature if less
131			if (climsst0(i,j,bi,bj) .lt. climtempfreeze) then
132			climsst0(i,j,bi,bj) = climtempfreeze
133			endif
134			if (climsst1(i,j,bi,bj) .lt. climtempfreeze) then
135			climsst1(i,j,bi,bj) = climtempfreeze
136			endif
137
138			c Interpolate linearly onto the current time.
139			climsst(i,j,bi,bj) = exf_inscal_sst * (
140			& fac * climsst0(i,j,bi,bj) +
141			& (exf_one - fac) * climsst1(i,j,bi,bj) )
142	heimbach	1.1
143	dimitri	1.5	enddo
144			enddo
145	heimbach	1.1	enddo
146	dimitri	1.5	enddo
147
148			endif
149	heimbach	1.1
150			#endif /* ALLOW_CLIMSST_RELAXATION */
151
152			end
153
154
155			subroutine exf_init_climsst(
156			I mythid
157			& )
158
159			c ==================================================================
160			c SUBROUTINE exf_init_climsst
161			c ==================================================================
162			c
163			c o
164			c
165			c started: Ralf.Giering@FastOpt.de 25-Mai-2000
166			c
167			c ==================================================================
168			c SUBROUTINE exf_init_climsst
169			c ==================================================================
170
171			implicit none
172
173			c == global variables ==
174
175			#include "EEPARAMS.h"
176			#include "SIZE.h"
177
178			#include "exf_fields.h"
179			#include "exf_param.h"
180			#include "exf_clim_param.h"
181			#include "exf_clim_fields.h"
182
183			c == routine arguments ==
184
185			integer mythid
186
187			#ifdef ALLOW_CLIMSST_RELAXATION
188
189			c == local variables ==
190
191			integer bi, bj
192			integer i, j
193
194			c == end of interface ==
195
196			do bj = mybylo(mythid), mybyhi(mythid)
197			do bi = mybxlo(mythid), mybxhi(mythid)
198			do j = 1, sny
199			do i = 1, snx
200	heimbach	1.6	climsst (i,j,bi,bj) = climsstconst
201	heimbach	1.1	climsst0(i,j,bi,bj) = 0. _d 0
202			climsst1(i,j,bi,bj) = 0. _d 0
203			enddo
204			enddo
205			enddo
206			enddo
207
208			#endif /* ALLOW_CLIMSSST_RELAXATION */
209
210			end