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

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

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

revision 1.1 by heimbach, Mon May 14 22:08:41 2001 UTC revision 1.1.4.5 by dimitri, Sun Feb 9 16:27:56 2003 UTC
# Line 4  c $Header$ Line 4  c $Header$
4    
5    
6        subroutine exf_set_climtemp(        subroutine exf_set_climtemp(
7       O                            climtemp       O                            mycurrenttime
      I                          , mycurrenttime  
8       I                          , mycurrentiter       I                          , mycurrentiter
9       I                          , mythid       I                          , mythid
10       &                         )       &                         )
# Line 17  c Line 16  c
16  c     o  Get the current climatological sea surface salinity field.  c     o  Get the current climatological sea surface salinity field.
17  c  c
18  c     started: Christian Eckert eckert@mit.edu 27-Aug-1999  c     started: Christian Eckert eckert@mit.edu 27-Aug-1999
 c  
19  c     changed: Christian Eckert eckert@mit.edu 11-Jan-2000  c     changed: Christian Eckert eckert@mit.edu 11-Jan-2000
 c  
20  c              - Restructured the code in order to create a package  c              - Restructured the code in order to create a package
21  c                for the MITgcmUV.  c                for the MITgcmUV.
 c  
22  c              Christian Eckert eckert@mit.edu 12-Feb-2000  c              Christian Eckert eckert@mit.edu 12-Feb-2000
 c  
23  c              - Changed Routine names (package prefix: exf_)  c              - Changed Routine names (package prefix: exf_)
24    c     changed: heimbach@mit.edu 08-Feb-2002
25    c     mods for pkg/seaice: menemenlis@jpl.nasa.gov 20-Dec-2002
26  c  c
27  c     ==================================================================  c     ==================================================================
28  c     SUBROUTINE exf_set_climtemp  c     SUBROUTINE exf_set_climtemp
# Line 40  c     ================================== Line 37  c     ==================================
37  #include "exf_param.h"  #include "exf_param.h"
38  #include "exf_constants.h"  #include "exf_constants.h"
39  #include "exf_clim_param.h"  #include "exf_clim_param.h"
40    #include "exf_clim_fields.h"
41    
42  c     == routine arguments ==  c     == routine arguments ==
43    
       _RL     climtemp(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy)  
44        _RL     mycurrenttime        _RL     mycurrenttime
45        integer mycurrentiter        integer mycurrentiter
46        integer mythid        integer mythid
# Line 52  c     == routine arguments == Line 49  c     == routine arguments ==
49    
50  c     == local variables ==  c     == local variables ==
51    
       common /exf_ctemp_r/ climtemp0, climtemp1  
       _RL climtemp0(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy)  
       _RL climtemp1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy)  
   
52        logical first, changed        logical first, changed
53        integer count0, count1        integer count0, count1
54        _RL     fac        _RL     fac
# Line 65  c     == local variables == Line 58  c     == local variables ==
58    
59  c     == end of interface ==  c     == end of interface ==
60    
61  c     get record numbers and interpolation factor for climtemp        if ( climtempfile .NE. ' ' ) then
       call exf_GetFFieldRec(  
      I                       climtempstartdate, climtempperiod  
      O                     , fac, first, changed  
      O                     , count0, count1  
      I                     , mycurrenttime, mycurrentiter, mythid  
      &                     )  
   
       if ( first ) then  
         call mdsreadfield( climtempfile, exf_clim_iprec  
      &                   , exf_clim_yftype, nr  
      &                   , climtemp1, count0, mythid  
      &                   )  
         if (exf_clim_yftype .eq. 'RL') then  
            call exf_filter_rl( climtemp1, climtempmask, mythid )  
         else  
            call exf_filter_rs( climtemp1, climtempmask, mythid )  
         end if  
       endif  
62    
63        if (( first ) .or. ( changed )) then  #ifdef ALLOW_CLIM_CYCLIC
64          call exf_SwapFFields_3d( climtemp0, climtemp1, mythid )  c     record numbers are assumed 1 to 12 corresponding to
65    c     Jan. through Dec.
66          call mdsreadfield( climtempfile, exf_clim_iprec           call cal_GetMonthsRec(
67       &                   , exf_clim_yftype, nr       O        fac, first, changed,
68       &                   , climtemp1, count1, mythid       O        count0, count1,
69       &                   )       I        mycurrenttime, mycurrentiter, mythid
70          if (exf_clim_yftype .eq. 'RL') then       &        )
71             call exf_filter_rl( climtemp1, climtempmask, mythid )  #else
72          else  c     get record numbers and interpolation factor for climtemp
73             call exf_filter_rs( climtemp1, climtempmask, mythid )           call exf_GetFFieldRec(
74          end if       I        climtempstartdate, climtempperiod
75        endif       O        , fac, first, changed
76         O        , count0, count1
77         I        , mycurrenttime, mycurrentiter, mythid
78         &        )
79    #endif
80    
81             if ( first ) then
82                call mdsreadfield( climtempfile, exf_clim_iprec
83         &           , exf_clim_yftype, nr
84         &           , climtemp1, count0, mythid
85         &           )
86                if (exf_clim_yftype .eq. 'RL') then
87                   call exf_filter_rl( climtemp1, climtempmask, mythid )
88                else
89                   call exf_filter_rs( climtemp1, climtempmask, mythid )
90                end if
91             endif
92    
93             if (( first ) .or. ( changed )) then
94                call exf_SwapFFields_3d( climtemp0, climtemp1, mythid )
95    
96                call mdsreadfield( climtempfile, exf_clim_iprec
97         &           , exf_clim_yftype, nr
98         &           , climtemp1, count1, mythid
99         &           )
100                if (exf_clim_yftype .eq. 'RL') then
101                   call exf_filter_rl( climtemp1, climtempmask, mythid )
102                else
103                   call exf_filter_rs( climtemp1, climtempmask, mythid )
104                end if
105             endif
106    
107  c     Loop over tiles.  c     Loop over tiles.
108        do bj = mybylo(mythid),mybyhi(mythid)           do bj = mybylo(mythid),mybyhi(mythid)
109          do bi = mybxlo(mythid),mybxhi(mythid)              do bi = mybxlo(mythid),mybxhi(mythid)
110            do k = 1,nr                 do k = 1,nr
111              do j = 1-oly,sny+oly                    do j = 1,sny
112                do i = 1-olx,snx+olx                       do i = 1,snx
113    
114  c             Set to freezing temperature if less  c     Set to freezing temperature if less
115                if (climtemp0(i,j,bi,bj) .lt. climtempfreeze) then                          if (climtemp0(i,j,k,bi,bj) .lt. climtempfreeze)
116                  climtemp0(i,j,bi,bj) = climtempfreeze       &                       climtemp0(i,j,k,bi,bj) = climtempfreeze
117                endif                          if (climtemp1(i,j,k,bi,bj) .lt. climtempfreeze)
118                if (climtemp1(i,j,bi,bj) .lt. climtempfreeze) then       &                       climtemp1(i,j,k,bi,bj) = climtempfreeze
119                  climtemp1(i,j,bi,bj) = climtempfreeze  
120                endif  c     Interpolate linearly onto the current time.
121                            climtemp(i,j,k,bi,bj) =
122  c             Interpolate linearly onto the current time.       &                       fac * climtemp0(i,j,k,bi,bj) +
123                climtemp(i,j,k,bi,bj) =       &                       (exf_one - fac) * climtemp1(i,j,k,bi,bj)
124       &             fac             *climtemp0(i,j,k,bi,bj)+  
125       &             (exf_one - fac) *climtemp1(i,j,k,bi,bj)                       enddo
126                      enddo
127                enddo                 enddo
128              enddo              enddo
129            enddo           enddo
130          enddo  
131        enddo        endif
132                    
133  #endif /* ALLOW_CLIMTEMP_RELAXATION */  #endif /* ALLOW_CLIMTEMP_RELAXATION */
134    
# Line 165  c     == routine arguments == Line 170  c     == routine arguments ==
170    
171  c     == local variables ==  c     == local variables ==
172    
       common /exf_ctemp_r/ climtemp0, climtemp1  
       _RL climtemp0(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy)  
       _RL climtemp1(1-olx:snx+olx,1-oly:sny+oly,nr,nsx,nsy)  
   
173        integer bi, bj        integer bi, bj
174        integer i, j, k        integer i, j, k
175    
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.1.4.5
  ViewVC Help
Powered by ViewVC 1.1.22