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

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

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

revision 1.2 by heimbach, Thu Feb 7 20:00:09 2002 UTC revision 1.6 by heimbach, Thu Mar 6 00:47:33 2003 UTC
# Line 4  c $Header$ Line 4  c $Header$
4    
5    
6        subroutine exf_set_climsst(        subroutine exf_set_climsst(
7       O                            climsst       O                            mycurrenttime
      I                          , mycurrenttime  
8       I                          , mycurrentiter       I                          , mycurrentiter
9       I                          , mythid       I                          , mythid
10       &                         )       &                         )
# Line 15  c     SUBROUTINE exf_set_climsst Line 14  c     SUBROUTINE exf_set_climsst
14  c     ==================================================================  c     ==================================================================
15  c  c
16  c     o  Get the current climatological sea surface salinity field.  c     o  Get the current climatological sea surface salinity field.
 c  
17  c     started: Christian Eckert eckert@mit.edu 27-Aug-1999  c     started: Christian Eckert eckert@mit.edu 27-Aug-1999
 c  
18  c     changed: Christian Eckert eckert@mit.edu 11-Jan-2000  c     changed: Christian Eckert eckert@mit.edu 11-Jan-2000
 c  
19  c              - Restructured the code in order to create a package  c              - Restructured the code in order to create a package
20  c                for the MITgcmUV.  c                for the MITgcmUV.
 c  
21  c              Christian Eckert eckert@mit.edu 12-Feb-2000  c              Christian Eckert eckert@mit.edu 12-Feb-2000
 c  
22  c              - Changed Routine names (package prefix: exf_)  c              - Changed Routine names (package prefix: exf_)
23    c     changed: heimbach@mit.edu 08-Feb-2002
24    c     mods for pkg/seaice: menemenlis@jpl.nasa.gov 20-Dec-2002
25  c  c
26  c     ==================================================================  c     ==================================================================
27  c     SUBROUTINE exf_set_climsst  c     SUBROUTINE exf_set_climsst
# Line 40  c     ================================== Line 36  c     ==================================
36  #include "exf_param.h"  #include "exf_param.h"
37  #include "exf_constants.h"  #include "exf_constants.h"
38  #include "exf_clim_param.h"  #include "exf_clim_param.h"
39    #include "exf_clim_fields.h"
40    
41  c     == routine arguments ==  c     == routine arguments ==
42    
       _RL     climsst(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)  
43        _RL     mycurrenttime        _RL     mycurrenttime
44        integer mycurrentiter        integer mycurrentiter
45        integer mythid        integer mythid
# Line 52  c     == routine arguments == Line 48  c     == routine arguments ==
48    
49  c     == local variables ==  c     == local variables ==
50    
       common /exf_csst_r/ climsst0, climsst1  
       _RL climsst0(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)  
       _RL climsst1(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)  
   
51        logical first, changed        logical first, changed
52        integer count0, count1        integer count0, count1
53        _RL     fac        _RL     fac
# Line 65  c     == local variables == Line 57  c     == local variables ==
57    
58  c     == end of interface ==  c     == end of interface ==
59    
60          if ( climsstfile .NE. ' ' ) then
61    
62  #ifdef ALLOW_CLIM_CYCLIC  #ifdef ALLOW_CLIM_CYCLIC
63  c     record numbers are assumed 1 to 12 corresponding to  c     record numbers are assumed 1 to 12 corresponding to
64  c     Jan. through Dec.  c     Jan. through Dec.
65        call cal_GetMonthsRec(           call cal_GetMonthsRec(
66       O                       fac, first, changed,       O        fac, first, changed,
67       O                       count0, count1,       O        count0, count1,
68       I                       mycurrenttime, mycurrentiter, mythid       I        mycurrenttime, mycurrentiter, mythid
69       &                     )       &        )
70  #else  #else
71  c     get record numbers and interpolation factor for climsst  c     get record numbers and interpolation factor for climsst
72        call exf_GetFFieldRec(           call exf_GetFFieldRec(
73       I                       climsststartdate, climsstperiod       I        climsststartdate, climsstperiod
74       O                     , fac, first, changed       O        , fac, first, changed
75       O                     , count0, count1       O        , count0, count1
76       I                     , mycurrenttime, mycurrentiter, mythid       I        , mycurrenttime, mycurrentiter, mythid
77       &                     )       &        )
78  #endif  #endif
79    
80  #ifndef ALLOW_AUTODIFF_TAMC           if ( first ) then
81        if ( first ) then              call mdsreadfield( climsstfile, exf_clim_iprec
82  #endif       &           , exf_clim_yftype, 1
83          call mdsreadfield( climsstfile, exf_clim_iprec       &           , climsst1, count0, mythid
84       &                   , exf_clim_yftype, 1       &           )
85       &                   , climsst1, count0, mythid              if (exf_clim_yftype .eq. 'RL') then
86       &                   )                 call exf_filter_rl( climsst1, climsstmask, mythid )
87          if (exf_clim_yftype .eq. 'RL') then              else
88             call exf_filter_rl( climsst1, climsstmask, mythid )                 call exf_filter_rs( climsst1, climsstmask, mythid )
89          else              end if
90             call exf_filter_rs( climsst1, climsstmask, mythid )           endif
91          end if  
92  #ifndef ALLOW_AUTODIFF_TAMC           if (( first ) .or. ( changed )) then
93        endif              call exf_SwapFFields( climsst0, climsst1, mythid )
94  #endif              call mdsreadfield( climsstfile, exf_clim_iprec
95         &           , exf_clim_yftype, 1
96  #ifndef ALLOW_AUTODIFF_TAMC       &           , climsst1, count1, mythid
97        if (( first ) .or. ( changed )) then       &           )
98  #endif              if (exf_clim_yftype .eq. 'RL') then
99          call exf_SwapFFields( climsst0, climsst1, mythid )                 call exf_filter_rl( climsst1, climsstmask, mythid )
100                else
101          call mdsreadfield( climsstfile, exf_clim_iprec                 call exf_filter_rs( climsst1, climsstmask, mythid )
102       &                   , exf_clim_yftype, 1              end if
103       &                   , 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  
 #ifndef ALLOW_AUTODIFF_TAMC  
       endif  
 #endif  
104    
105  c     Loop over tiles.  c     Loop over tiles.
106        do bj = mybylo(mythid),mybyhi(mythid)           do bj = mybylo(mythid),mybyhi(mythid)
107          do bi = mybxlo(mythid),mybxhi(mythid)              do bi = mybxlo(mythid),mybxhi(mythid)
108            do j = 1-oly,sny+oly                 do j = 1,sny
109              do i = 1-olx,snx+olx                    do i = 1,snx
110    
111  c             Set to freezing temperature if less  c     Set to freezing temperature if less
112                if (climsst0(i,j,bi,bj) .lt. climtempfreeze) then                       if (climsst0(i,j,bi,bj) .lt. climtempfreeze) then
113                  climsst0(i,j,bi,bj) = climtempfreeze                          climsst0(i,j,bi,bj) = climtempfreeze
114                endif                       endif
115                if (climsst1(i,j,bi,bj) .lt. climtempfreeze) then                       if (climsst1(i,j,bi,bj) .lt. climtempfreeze) then
116                  climsst1(i,j,bi,bj) = climtempfreeze                          climsst1(i,j,bi,bj) = climtempfreeze
117                endif                       endif
118    
119  c             Interpolate linearly onto the current time.  c     Interpolate linearly onto the current time.
120                climsst(i,j,bi,bj) = fac          *climsst0(i,j,bi,bj)+                       climsst(i,j,bi,bj) = exf_inscal_sst * (
121       &                          (exf_one - fac) *climsst1(i,j,bi,bj)       &                                fac * climsst0(i,j,bi,bj) +
122         &                    (exf_one - fac) * climsst1(i,j,bi,bj) )
123    
124                      enddo
125                   enddo
126              enddo              enddo
127            enddo           enddo
128          enddo  
129        enddo        endif
130    
131  #endif /* ALLOW_CLIMSST_RELAXATION */  #endif /* ALLOW_CLIMSST_RELAXATION */
132    
# Line 181  c     == routine arguments == Line 169  c     == routine arguments ==
169    
170  c     == local variables ==  c     == local variables ==
171    
       common /exf_csst_r/ climsst0, climsst1  
       _RL climsst0(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)  
       _RL climsst1(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)  
   
172        integer bi, bj        integer bi, bj
173        integer i, j        integer i, j
174    
# Line 194  c     == end of interface == Line 178  c     == end of interface ==
178          do bi = mybxlo(mythid), mybxhi(mythid)          do bi = mybxlo(mythid), mybxhi(mythid)
179            do j = 1, sny            do j = 1, sny
180              do i = 1, snx              do i = 1, snx
181                climsst (i,j,bi,bj) = 0. _d 0                climsst (i,j,bi,bj) = climsstconst
182                climsst0(i,j,bi,bj) = 0. _d 0                climsst0(i,j,bi,bj) = 0. _d 0
183                climsst1(i,j,bi,bj) = 0. _d 0                climsst1(i,j,bi,bj) = 0. _d 0
184              enddo              enddo
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.6
  ViewVC Help
Powered by ViewVC 1.1.22