/[MITgcm]/MITgcm/pkg/ecco/cost_gencost_customize.F
ViewVC logotype

Diff of /MITgcm/pkg/ecco/cost_gencost_customize.F

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

revision 1.10 by gforget, Fri Oct 3 19:57:15 2014 UTC revision 1.18 by atn, Sun Nov 8 03:14:04 2015 UTC
# Line 5  C $Name$ Line 5  C $Name$
5  #ifdef ALLOW_SEAICE  #ifdef ALLOW_SEAICE
6  # include "SEAICE_OPTIONS.h"  # include "SEAICE_OPTIONS.h"
7  #endif  #endif
8    #ifdef ALLOW_EXF
9    # include "EXF_OPTIONS.h"
10    #endif
11    #ifdef ALLOW_CTRL
12    # include "CTRL_OPTIONS.h"
13    #endif
14    #ifdef ALLOW_GMREDI
15    # include "GMREDI_OPTIONS.h"
16    #endif
17    
18        subroutine cost_gencost_customize( mythid )        subroutine cost_gencost_customize( mythid )
19    
20  c     ==================================================================  c     ==================================================================
21  c     SUBROUTINE cost_gencost_assignperiod  c     SUBROUTINE cost_gencost_customize
22  c     ==================================================================  c     ==================================================================
23    
24        implicit none        implicit none
# Line 32  c     == global variables == Line 41  c     == global variables ==
41  #ifdef ALLOW_EXF  #ifdef ALLOW_EXF
42  # include "EXF_FIELDS.h"  # include "EXF_FIELDS.h"
43  #endif  #endif
44    #ifdef ALLOW_CTRL
45    # include "CTRL_FIELDS.h"
46    #endif
47    
48  c     == routine arguments ==  c     == routine arguments ==
49    
# Line 47  c     == local variables == Line 59  c     == local variables ==
59  #endif  #endif
60  #ifdef ALLOW_EXF  #ifdef ALLOW_EXF
61        _RL uBarC, vBarC        _RL uBarC, vBarC
62          _RL zontau        (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
63          _RL mertau        (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
64          _RL zonwind        (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
65          _RL merwind        (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
66  #endif  #endif
   
       _RL tauZonC        (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)  
       _RL tauMerC        (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)  
67        integer itlo,ithi        integer itlo,ithi
68        integer jtlo,jthi        integer jtlo,jthi
69        integer jmin,jmax        integer jmin,jmax
# Line 78  c rotated to EW/NS tracer point Line 91  c rotated to EW/NS tracer point
91       &           *(ustress(i,j,bi,bj)+ustress(i+1,j,bi,bj))       &           *(ustress(i,j,bi,bj)+ustress(i+1,j,bi,bj))
92                  vBarC = 0.5 _d 0                  vBarC = 0.5 _d 0
93       &           *(vstress(i,j,bi,bj)+vstress(i,j+1,bi,bj))       &           *(vstress(i,j,bi,bj)+vstress(i,j+1,bi,bj))
94                  tauZonC(i,j,bi,bj) = angleCosC(i,j,bi,bj)*uBarC                  zontau(i,j,bi,bj) = angleCosC(i,j,bi,bj)*uBarC
95       &                           -angleSinC(i,j,bi,bj)*vBarC       &                           -angleSinC(i,j,bi,bj)*vBarC
96                  tauMerC(i,j,bi,bj) = angleSinC(i,j,bi,bj)*uBarC                  mertau(i,j,bi,bj) = angleSinC(i,j,bi,bj)*uBarC
97       &                           +angleCosC(i,j,bi,bj)*vBarC       &                           +angleCosC(i,j,bi,bj)*vBarC
98                enddo                enddo
99              enddo              enddo
100            enddo            enddo
101          enddo          enddo
102    
103  #endif  c the following should be identical to the above
104    c     CALL ROTATE_UV2EN_RL(ustress,vstress,zontau,mertau,
105    c    &     .TRUE.,.TRUE.,.TRUE.,1,myThid)
106    
107          CALL ROTATE_UV2EN_RL(uwind,vwind,zonwind,merwind,
108         &     .TRUE.,.FALSE.,.TRUE.,1,myThid)
109    #endif
110    
111        do k=1,NGENCOST        do k=1,NGENCOST
112        do bj = jtlo,jthi        do bj = jtlo,jthi
# Line 97  c rotated to EW/NS tracer point Line 114  c rotated to EW/NS tracer point
114          do j = jmin,jmax          do j = jmin,jmax
115           do i =  imin,imax           do i =  imin,imax
116    
117           if (gencost_barfile(k)(1:3).EQ.'eta') then           if (gencost_barfile(k)(1:5).EQ.'m_eta') then
118             gencost_modfld(i,j,bi,bj,k) =             gencost_modfld(i,j,bi,bj,k) =
119       &      etanFull(i,j,bi,bj)*maskC(i,j,1,bi,bj)       &      m_eta(i,j,bi,bj)*maskC(i,j,1,bi,bj)
120           elseif (gencost_barfile(k)(1:3).EQ.'sst') then           elseif (gencost_barfile(k)(1:5).EQ.'m_sst') then
121             gencost_modfld(i,j,bi,bj,k) =             gencost_modfld(i,j,bi,bj,k) =
122       &      THETA(i,j,1,bi,bj)*maskC(i,j,1,bi,bj)       &      THETA(i,j,1,bi,bj)*maskC(i,j,1,bi,bj)
123           elseif (gencost_barfile(k)(1:3).EQ.'sss') then           elseif (gencost_barfile(k)(1:5).EQ.'m_sss') then
124             gencost_modfld(i,j,bi,bj,k) =             gencost_modfld(i,j,bi,bj,k) =
125       &      SALT(i,j,1,bi,bj)*maskC(i,j,1,bi,bj)       &      SALT(i,j,1,bi,bj)*maskC(i,j,1,bi,bj)
126           elseif (gencost_barfile(k)(1:2).EQ.'bp') then           elseif (gencost_barfile(k)(1:4).EQ.'m_bp') then
127             gencost_modfld(i,j,bi,bj,k) =             gencost_modfld(i,j,bi,bj,k) =
128       &      phiHydLow(i,j,bi,bj)*maskC(i,j,1,bi,bj)       &      phiHydLow(i,j,bi,bj)*maskC(i,j,1,bi,bj)
129           elseif (gencost_barfile(k)(1:6).EQ.'tauZon') then  #ifdef ALLOW_GEOTHERMAL_FLUX
130             elseif (gencost_barfile(k)(1:16).EQ.'m_geothermalflux') then
131               gencost_modfld(i,j,bi,bj,k) =
132         &      geothermalFlux(i,j,bi,bj)*maskC(i,j,1,bi,bj)
133    #endif
134    #ifdef ALLOW_EXF
135             elseif (gencost_barfile(k)(1:9).EQ.'m_ustress') then
136             gencost_modfld(i,j,bi,bj,k) =             gencost_modfld(i,j,bi,bj,k) =
137       &      tauZonC(i,j,bi,bj)*maskC(i,j,1,bi,bj)       &      zontau(i,j,bi,bj)*maskC(i,j,1,bi,bj)
138           elseif (gencost_barfile(k)(1:6).EQ.'tauMer') then           elseif (gencost_barfile(k)(1:9).EQ.'m_vstress') then
139             gencost_modfld(i,j,bi,bj,k) =             gencost_modfld(i,j,bi,bj,k) =
140       &      tauMerC(i,j,bi,bj)*maskC(i,j,1,bi,bj)       &      mertau(i,j,bi,bj)*maskC(i,j,1,bi,bj)
141             elseif (gencost_barfile(k)(1:7).EQ.'m_uwind') then
142               gencost_modfld(i,j,bi,bj,k) =
143         &      zonwind(i,j,bi,bj)*maskC(i,j,1,bi,bj)
144             elseif (gencost_barfile(k)(1:7).EQ.'m_vwind') then
145               gencost_modfld(i,j,bi,bj,k) =
146         &      merwind(i,j,bi,bj)*maskC(i,j,1,bi,bj)
147             elseif (gencost_barfile(k)(1:7).EQ.'m_atemp') then
148               gencost_modfld(i,j,bi,bj,k) =
149         &      atemp(i,j,bi,bj)*maskC(i,j,1,bi,bj)
150             elseif (gencost_barfile(k)(1:5).EQ.'m_aqh') then
151               gencost_modfld(i,j,bi,bj,k) =
152         &      aqh(i,j,bi,bj)*maskC(i,j,1,bi,bj)
153             elseif (gencost_barfile(k)(1:8).EQ.'m_precip') then
154               gencost_modfld(i,j,bi,bj,k) =
155         &      precip(i,j,bi,bj)*maskC(i,j,1,bi,bj)
156             elseif (gencost_barfile(k)(1:8).EQ.'m_swdown') then
157               gencost_modfld(i,j,bi,bj,k) =
158         &      swdown(i,j,bi,bj)*maskC(i,j,1,bi,bj)
159             elseif (gencost_barfile(k)(1:8).EQ.'m_lwdown') then
160               gencost_modfld(i,j,bi,bj,k) =
161         &      lwdown(i,j,bi,bj)*maskC(i,j,1,bi,bj)
162             elseif (gencost_barfile(k)(1:8).EQ.'m_wspeed') then
163               gencost_modfld(i,j,bi,bj,k) =
164         &      wspeed(i,j,bi,bj)*maskC(i,j,1,bi,bj)
165    #endif
166    #ifdef ALLOW_CTRL
167    #ifdef ALLOW_BOTTOMDRAG_CONTROL
168             elseif (gencost_barfile(k)(1:12).EQ.'m_bottomdrag') then
169               gencost_modfld(i,j,bi,bj,k) =
170         &      bottomDragFld(i,j,bi,bj)*maskC(i,j,1,bi,bj)
171    #endif
172    #endif
173  #ifdef ALLOW_SEAICE  #ifdef ALLOW_SEAICE
174           elseif (gencost_name(k).EQ.'siv4-conc') then           elseif ( (gencost_name(k).EQ.'siv4-conc').OR.
175         &            (gencost_barfile(k)(1:8).EQ.'m_siarea') ) then
176             gencost_modfld(i,j,bi,bj,k) =             gencost_modfld(i,j,bi,bj,k) =
177       &      area(i,j,bi,bj)*maskC(i,j,1,bi,bj)       &      area(i,j,bi,bj)*maskC(i,j,1,bi,bj)
178           elseif (gencost_name(k).EQ.'siv4-deconc') then           elseif (gencost_name(k).EQ.'siv4-deconc') then
179             gencost_modfld(i,j,bi,bj,k) =             gencost_modfld(i,j,bi,bj,k) =
180       &      theta(i,j,1,bi,bj)*maskC(i,j,1,bi,bj)       &      theta(i,j,1,bi,bj)*maskC(i,j,1,bi,bj)
181           elseif (gencost_name(k).EQ.'siv4-exconc') then             elseif ( (gencost_name(k).EQ.'siv4-exconc').OR.
182         &            (gencost_barfile(k)(1:8).EQ.'m_siheff') ) then  
183             gencost_modfld(i,j,bi,bj,k) =             gencost_modfld(i,j,bi,bj,k) =
184       &      heff(i,j,bi,bj)*maskC(i,j,1,bi,bj)       &      heff(i,j,bi,bj)*maskC(i,j,1,bi,bj)
185             elseif (gencost_barfile(k)(1:9).EQ.'m_sihsnow') then
186               gencost_modfld(i,j,bi,bj,k) =
187         &      hsnow(i,j,bi,bj)*maskC(i,j,1,bi,bj)
188  #endif  #endif
189  #ifdef ALLOW_GENCOST3D  #ifdef ALLOW_GENCOST3D
190           elseif (gencost_barfile(k)(1:5).EQ.'theta') then           elseif (gencost_barfile(k)(1:7).EQ.'m_theta') then
191             kk=gencost_pointer3d(k)             kk=gencost_pointer3d(k)
192             do k2=1,nr             do k2=1,nr
193              gencost_mod3d(i,j,k2,bi,bj,kk) =              gencost_mod3d(i,j,k2,bi,bj,kk) =
194       &       theta(i,j,k2,bi,bj)*maskC(i,j,k2,bi,bj)       &       theta(i,j,k2,bi,bj)*maskC(i,j,k2,bi,bj)
195             enddo             enddo
196           elseif (gencost_barfile(k)(1:4).EQ.'salt') then           elseif (gencost_barfile(k)(1:6).EQ.'m_salt') then
197             kk=gencost_pointer3d(k)             kk=gencost_pointer3d(k)
198             do k2=1,nr             do k2=1,nr
199              gencost_mod3d(i,j,k2,bi,bj,kk) =              gencost_mod3d(i,j,k2,bi,bj,kk) =
200       &       salt(i,j,k2,bi,bj)*maskC(i,j,k2,bi,bj)       &       salt(i,j,k2,bi,bj)*maskC(i,j,k2,bi,bj)
201             enddo             enddo
202             elseif (gencost_barfile(k)(1:4).EQ.'m_UE') then
203               kk=gencost_pointer3d(k)
204               do k2=1,nr
205                gencost_mod3d(i,j,k2,bi,bj,kk) =
206         &       m_UE(i,j,k2,bi,bj)*maskC(i,j,k2,bi,bj)
207               enddo
208             elseif (gencost_barfile(k)(1:4).EQ.'m_VN') then
209               kk=gencost_pointer3d(k)
210               do k2=1,nr
211                gencost_mod3d(i,j,k2,bi,bj,kk) =
212         &       m_VN(i,j,k2,bi,bj)*maskC(i,j,k2,bi,bj)
213               enddo
214    #if (defined (ALLOW_3D_DIFFKR) || defined (ALLOW_DIFFKR_CONTROL))
215             elseif (gencost_barfile(k)(1:8).EQ.'m_diffkr') then
216               kk=gencost_pointer3d(k)
217               do k2=1,nr
218                gencost_mod3d(i,j,k2,bi,bj,kk) =
219         &       diffkr(i,j,k2,bi,bj)*maskC(i,j,k2,bi,bj)
220               enddo
221    #endif
222    #ifdef ALLOW_CTRL
223    #ifdef ALLOW_KAPGM_CONTROL
224             elseif (gencost_barfile(k)(1:7).EQ.'m_kapgm') then
225               kk=gencost_pointer3d(k)
226               do k2=1,nr
227                gencost_mod3d(i,j,k2,bi,bj,kk) =
228         &       kapgm(i,j,k2,bi,bj)*maskC(i,j,k2,bi,bj)
229               enddo
230    #endif
231    #ifdef ALLOW_KAPREDI_CONTROL
232             elseif (gencost_barfile(k)(1:9).EQ.'m_kapredi') then
233               kk=gencost_pointer3d(k)
234               do k2=1,nr
235                gencost_mod3d(i,j,k2,bi,bj,kk) =
236         &       kapredi(i,j,k2,bi,bj)*maskC(i,j,k2,bi,bj)
237               enddo
238    #endif
239    #endif
240  #endif  #endif
241           endif           endif
242    
Legend:
Removed from v.1.10  
changed lines
  Added in v.1.18
  ViewVC Help
Powered by ViewVC 1.1.22