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

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

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

revision 1.1 by heimbach, Fri May 23 16:18:57 2003 UTC revision 1.2 by heimbach, Fri May 23 18:37:31 2003 UTC
# Line 0  Line 1 
1    #include "EXF_CPPOPTIONS.h"
2    
3          subroutine exf_set_gen(
4         &     genfile, genstartdate, genperiod, exf_inscal_gen,
5         &     genfld, gen0, gen1, genmask,
6         &     mycurrenttime, mycurrentiter, mythid )
7    
8    c     ==================================================================
9    c     SUBROUTINE exf_set_gen
10    c     ==================================================================
11    c
12    c     o set external forcing gen
13    c
14    c     started: Ralf.Giering@FastOpt.de 25-Mai-2000
15    c     changed: heimbach@mit.edu 10-Jan-2002
16    c              mods for pkg/seaice: menemenlis@jpl.nasa.gov 20-Dec-2002
17    c              heimbach@mit.edu: totally re-organized exf_set_...
18    c              replaced all routines by one generic routine
19    
20    c     ==================================================================
21    c     SUBROUTINE exf_set_gen
22    c     ==================================================================
23    
24          implicit none
25    
26    c     == global variables ==
27    
28    #include "EEPARAMS.h"
29    #include "SIZE.h"
30    #include "GRID.h"
31    
32    #include "exf_param.h"
33    #include "exf_constants.h"
34    
35    c     == routine arguments ==
36    
37          integer genstartdate(4)
38          _RL     genperiod
39          _RL     exf_inscal_gen
40          _RL     genfld(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
41          _RL     gen0  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
42          _RL     gen1  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
43          character*1 genmask
44          character*(128) genfile
45          _RL     mycurrenttime
46          integer mycurrentiter
47          integer mythid
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          if ( genfile .NE. ' ' ) then
61    
62    c     get record numbers and interpolation factor for gen
63             call exf_GetFFieldRec(
64         I        genstartdate, genperiod
65         O        , fac, first, changed
66         O        , count0, count1
67         I        , mycurrenttime, mycurrentiter, mythid
68         &        )
69    
70             if ( first ) then
71                call mdsreadfield( genfile, exf_iprec, exf_yftype, 1
72         &           , gen1, count0, mythid
73         &           )
74    
75                if (exf_yftype .eq. 'RL') then
76                   call exf_filter_rl( gen1, genmask, mythid )
77                else
78                   call exf_filter_rs( gen1, genmask, mythid )
79                end if
80             endif
81    
82             if (( first ) .or. ( changed )) then
83                call exf_SwapFFields( gen0, gen1, mythid )
84                
85                call mdsreadfield( genfile, exf_iprec, exf_yftype, 1
86         &           , gen1, count1, mythid
87         &           )
88    
89                if (exf_yftype .eq. 'RL') then
90                   call exf_filter_rl( gen1, genmask, mythid )
91                else
92                   call exf_filter_rs( gen1, genmask, mythid )
93                end if
94             endif
95    
96    c     Loop over tiles.
97             do bj = mybylo(mythid),mybyhi(mythid)
98                do bi = mybxlo(mythid),mybxhi(mythid)
99                   do j = 1,sny
100                      do i = 1,snx
101    
102    c     Interpolate linearly onto the current time.
103    
104                         genfld(i,j,bi,bj) = exf_inscal_gen * (
105         &                                fac * gen0(i,j,bi,bj) +
106         &                    (exf_one - fac) * gen1(i,j,bi,bj) )
107    
108                      enddo
109                   enddo
110                enddo
111             enddo
112    
113          endif
114    
115          end
116    
117    
118    
119          subroutine exf_init_gen (
120         &     genconst, genfld, gen0, gen1, mythid )
121    
122    c     ==================================================================
123    c     SUBROUTINE exf_init_gen
124    c     ==================================================================
125    c
126    c     o
127    c
128    c     started: Ralf.Giering@FastOpt.de 25-Mai-2000
129    c     changed: heimbach@mit.edu 10-Jan-2002
130    c              heimbach@mit.edu: totally re-organized exf_set_...
131    c              replaced all routines by one generic routine
132    c
133    c     ==================================================================
134    c     SUBROUTINE exf_init_gen
135    c     ==================================================================
136    
137          implicit none
138    
139    c     == global variables ==
140    
141    #include "EEPARAMS.h"
142    #include "SIZE.h"
143    
144    #include "exf_param.h"
145    
146    c     == routine arguments ==
147    
148          _RL genconst
149          _RL genfld(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
150          _RL gen0  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
151          _RL gen1  (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
152          integer mythid
153    
154    c     == local variables ==
155    
156          integer bi, bj
157          integer i, j
158    
159    c     == end of interface ==
160    
161          do bj = mybylo(mythid), mybyhi(mythid)
162            do bi = mybxlo(mythid), mybxhi(mythid)
163              do j = 1, sny
164                do i = 1, snx
165                  genfld(i,j,bi,bj)  = genconst
166                  gen0(i,j,bi,bj)    = 0. _d 0
167                  gen1(i,j,bi,bj)    = 0. _d 0
168                enddo
169              enddo
170            enddo
171          enddo
172    
173          end
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22