Back to home page

MITgcm
 
 

    

File indexing completed on 2024-10-09 05:10:44 UTC

view on githubraw file Latest commit 4c91ca28 on 2024-10-08 14:20:22 UTC
8f7d13d0c9 Jean*0001 #include "ECCO_OPTIONS.h"
27f56e97bb Gael*0002 #ifdef ALLOW_SEAICE
                0003 # include "SEAICE_OPTIONS.h"
                0004 #endif
9aeddbf372 Gael*0005 #ifdef ALLOW_EXF
                0006 # include "EXF_OPTIONS.h"
                0007 #endif
                0008 #ifdef ALLOW_CTRL
                0009 # include "CTRL_OPTIONS.h"
                0010 #endif
37a2578dc5 Gael*0011 #ifdef ALLOW_GMREDI
                0012 # include "GMREDI_OPTIONS.h"
                0013 #endif
8c157ed454 Patr*0014 
4c91ca28d5 Ou W*0015 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0016 CBOP
                0017 C !ROUTINE: COST_GENCOST_CUSTOMIZE
8f7d13d0c9 Jean*0018 
4c91ca28d5 Ou W*0019 C !INTERFACE:
                0020       SUBROUTINE COST_GENCOST_CUSTOMIZE( myThid )
8c157ed454 Patr*0021 
4c91ca28d5 Ou W*0022 C     !DESCRIPTION:
                0023 C     Customize various costs
8c157ed454 Patr*0024 
4c91ca28d5 Ou W*0025 C     !USES:
                0026       IMPLICIT NONE
                0027 C     == Global variables ===
8c157ed454 Patr*0028 #include "EEPARAMS.h"
                0029 #include "SIZE.h"
27f56e97bb Gael*0030 #include "GRID.h"
8c157ed454 Patr*0031 #include "PARAMS.h"
                0032 #include "DYNVARS.h"
                0033 #include "FFIELDS.h"
f09238ab8f Gael*0034 #ifdef ALLOW_ECCO
13d362b8c1 Ou W*0035 # include "ECCO_SIZE.h"
                0036 # include "ECCO.h"
f09238ab8f Gael*0037 #endif
27f56e97bb Gael*0038 #ifdef ALLOW_SEAICE
                0039 #  include "SEAICE_SIZE.h"
                0040 #  include "SEAICE.h"
                0041 #endif
f09238ab8f Gael*0042 #ifdef ALLOW_EXF
                0043 # include "EXF_FIELDS.h"
                0044 #endif
9aeddbf372 Gael*0045 #ifdef ALLOW_CTRL
                0046 # include "CTRL_FIELDS.h"
                0047 #endif
94a8024bbe Jean*0048 #ifdef ALLOW_GMREDI
                0049 # include "GMREDI.h"
                0050 #endif
81e05fa829 Gael*0051 #ifdef ALLOW_PTRACERS
                0052 # include "PTRACERS_SIZE.h"
                0053 # include "PTRACERS_FIELDS.h"
                0054 #endif
8c157ed454 Patr*0055 
4c91ca28d5 Ou W*0056 C !INPUT PARAMETERS: ===================================================
                0057 C myThid    :: my Thread Id number
                0058       INTEGER myThid
8c157ed454 Patr*0059 
4c91ca28d5 Ou W*0060 C !OUTPUT PARAMETERS: ==================================================
8c157ed454 Patr*0061 
                0062 #ifdef ALLOW_GENCOST_CONTRIBUTION
4c91ca28d5 Ou W*0063 C !LOCAL VARIABLES: ====================================================
                0064       INTEGER bi,bj
                0065       INTEGER i,j,k
5cce2b5d76 Gael*0066 #ifdef ALLOW_GENCOST3D
4c91ca28d5 Ou W*0067       INTEGER k2,kk
                0068       INTEGER itr
5cce2b5d76 Gael*0069 #endif
4c91ca28d5 Ou W*0070       INTEGER kLev
5efdcaef73 Gael*0071 #ifdef ALLOW_EXF
                0072       _RL uBarC, vBarC
4c91ca28d5 Ou W*0073       _RL zontau  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0074       _RL mertau  (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0075       _RL zonwind (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0076       _RL merwind (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
5efdcaef73 Gael*0077 #endif
4c91ca28d5 Ou W*0078       INTEGER jMin,jMax
                0079       INTEGER iMin,iMax
                0080 CEOP
8c157ed454 Patr*0081 
4c91ca28d5 Ou W*0082       jMin = 1
                0083       jMax = sNy
                0084       iMin = 1
                0085       iMax = sNx
69f8f4c84c Patr*0086 
5efdcaef73 Gael*0087 #ifdef ALLOW_EXF
                0088 c rotated to EW/NS tracer point
4c91ca28d5 Ou W*0089         do bj = myByLo(myThid),myByHi(myThid)
                0090           do bi = myBxLo(myThid),myBxHi(myThid)
                0091             do j = jMin,jMax
                0092               do i = iMin,iMax
5efdcaef73 Gael*0093                 uBarC = 0.5 _d 0
                0094      &           *(ustress(i,j,bi,bj)+ustress(i+1,j,bi,bj))
                0095                 vBarC = 0.5 _d 0
                0096      &           *(vstress(i,j,bi,bj)+vstress(i,j+1,bi,bj))
9aeddbf372 Gael*0097                 zontau(i,j,bi,bj) = angleCosC(i,j,bi,bj)*uBarC
5efdcaef73 Gael*0098      &                           -angleSinC(i,j,bi,bj)*vBarC
9aeddbf372 Gael*0099                 mertau(i,j,bi,bj) = angleSinC(i,j,bi,bj)*uBarC
5efdcaef73 Gael*0100      &                           +angleCosC(i,j,bi,bj)*vBarC
                0101               enddo
                0102             enddo
                0103           enddo
                0104         enddo
                0105 
9aeddbf372 Gael*0106 c the following should be identical to the above
                0107 c     CALL ROTATE_UV2EN_RL(ustress,vstress,zontau,mertau,
                0108 c    &     .TRUE.,.TRUE.,.TRUE.,1,myThid)
5efdcaef73 Gael*0109 
9aeddbf372 Gael*0110       CALL ROTATE_UV2EN_RL(uwind,vwind,zonwind,merwind,
                0111      &     .TRUE.,.FALSE.,.TRUE.,1,myThid)
                0112 #endif
5efdcaef73 Gael*0113 
f09238ab8f Gael*0114       do k=1,NGENCOST
81e05fa829 Gael*0115       itr=gencost_itracer(k)
13d362b8c1 Ou W*0116       kLev = MAX( 1, MIN( Nr, gencost_kLev_select(k) ) )
4c91ca28d5 Ou W*0117       do bj = myByLo(myThid),myByHi(myThid)
                0118        do bi = myBxLo(myThid),myBxHi(myThid)
                0119         do j = jMin,jMax
                0120          do i =  iMin,iMax
f09238ab8f Gael*0121 
13d362b8c1 Ou W*0122          if (gencost_barfile(k)(1:5).EQ.'m_eta' .and.
                0123      &       gencost_barfile(k)(1:9).NE.'m_eta_dyn') then
                0124            gencost_modfld(i,j,bi,bj,k) =
556841ad42 Gael*0125      &      m_eta(i,j,bi,bj)*maskC(i,j,1,bi,bj)
bdae1843b8 Gael*0126          elseif (gencost_barfile(k)(1:9).EQ.'m_boxmean') then
13d362b8c1 Ou W*0127            gencost_modfld(i,j,bi,bj,k) =
bdae1843b8 Gael*0128      &      gencost_storefld(i,j,bi,bj,k)
447bdc4b79 Gael*0129          elseif (gencost_barfile(k)(1:9).EQ.'m_horflux') then
13d362b8c1 Ou W*0130            gencost_modfld(i,j,bi,bj,k) =
447bdc4b79 Gael*0131      &      gencost_storefld(i,j,bi,bj,k)
985662a3b3 Gael*0132          elseif (gencost_barfile(k)(1:5).EQ.'m_sst') then
13d362b8c1 Ou W*0133            gencost_modfld(i,j,bi,bj,k) =
f09238ab8f Gael*0134      &      THETA(i,j,1,bi,bj)*maskC(i,j,1,bi,bj)
985662a3b3 Gael*0135          elseif (gencost_barfile(k)(1:5).EQ.'m_sss') then
13d362b8c1 Ou W*0136            gencost_modfld(i,j,bi,bj,k) =
f09238ab8f Gael*0137      &      SALT(i,j,1,bi,bj)*maskC(i,j,1,bi,bj)
13d362b8c1 Ou W*0138          elseif (gencost_barfile(k)(1:11).EQ.'m_drifterUE') then
                0139            gencost_modfld(i,j,bi,bj,k) =
                0140      &      m_UE(i,j,kLev,bi,bj)*maskC(i,j,kLev,bi,bj)
                0141          elseif (gencost_barfile(k)(1:11).EQ.'m_drifterVN') then
                0142            gencost_modfld(i,j,bi,bj,k) =
                0143      &      m_VN(i,j,kLev,bi,bj)*maskC(i,j,kLev,bi,bj)
                0144          elseif (gencost_barfile(k)(1:4).EQ.'m_bp' .and.
                0145      &           gencost_barfile(k)(1:12).NE.'m_bp_nopabar') then
                0146            gencost_modfld(i,j,bi,bj,k) =
                0147      &      m_bp(i,j,bi,bj)*maskC(i,j,1,bi,bj)
                0148 #ifdef ATMOSPHERIC_LOADING
                0149 #ifdef ALLOW_IB_CORR
                0150          elseif (gencost_barfile(k)(1:9).EQ.'m_eta_dyn') then
                0151            gencost_modfld(i,j,bi,bj,k) =
                0152      &      m_eta_dyn(i,j,bi,bj)*maskC(i,j,1,bi,bj)
                0153          elseif (gencost_barfile(k)(1:12).EQ.'m_bp_nopabar') then
                0154            gencost_modfld(i,j,bi,bj,k) =
                0155      &      m_bp_nopabar(i,j,bi,bj)*maskC(i,j,1,bi,bj)
                0156 #endif
6b2230d510 Ou W*0157 #endif
9aeddbf372 Gael*0158 #ifdef ALLOW_GEOTHERMAL_FLUX
                0159          elseif (gencost_barfile(k)(1:16).EQ.'m_geothermalflux') then
                0160            gencost_modfld(i,j,bi,bj,k) =
                0161      &      geothermalFlux(i,j,bi,bj)*maskC(i,j,1,bi,bj)
                0162 #endif
                0163 #ifdef ALLOW_EXF
                0164          elseif (gencost_barfile(k)(1:9).EQ.'m_ustress') then
13d362b8c1 Ou W*0165            gencost_modfld(i,j,bi,bj,k) =
9aeddbf372 Gael*0166      &      zontau(i,j,bi,bj)*maskC(i,j,1,bi,bj)
                0167          elseif (gencost_barfile(k)(1:9).EQ.'m_vstress') then
13d362b8c1 Ou W*0168            gencost_modfld(i,j,bi,bj,k) =
9aeddbf372 Gael*0169      &      mertau(i,j,bi,bj)*maskC(i,j,1,bi,bj)
c2222c60b2 An T*0170          elseif (gencost_barfile(k)(1:7).EQ.'m_uwind') then
9aeddbf372 Gael*0171            gencost_modfld(i,j,bi,bj,k) =
                0172      &      zonwind(i,j,bi,bj)*maskC(i,j,1,bi,bj)
c2222c60b2 An T*0173          elseif (gencost_barfile(k)(1:7).EQ.'m_vwind') then
9aeddbf372 Gael*0174            gencost_modfld(i,j,bi,bj,k) =
                0175      &      merwind(i,j,bi,bj)*maskC(i,j,1,bi,bj)
b939965590 Gael*0176 #ifdef ALLOW_ATM_TEMP
9aeddbf372 Gael*0177          elseif (gencost_barfile(k)(1:7).EQ.'m_atemp') then
                0178            gencost_modfld(i,j,bi,bj,k) =
                0179      &      atemp(i,j,bi,bj)*maskC(i,j,1,bi,bj)
                0180          elseif (gencost_barfile(k)(1:5).EQ.'m_aqh') then
                0181            gencost_modfld(i,j,bi,bj,k) =
                0182      &      aqh(i,j,bi,bj)*maskC(i,j,1,bi,bj)
                0183          elseif (gencost_barfile(k)(1:8).EQ.'m_precip') then
                0184            gencost_modfld(i,j,bi,bj,k) =
                0185      &      precip(i,j,bi,bj)*maskC(i,j,1,bi,bj)
b939965590 Gael*0186 #endif
                0187 #ifdef ALLOW_DOWNWARD_RADIATION
9aeddbf372 Gael*0188          elseif (gencost_barfile(k)(1:8).EQ.'m_swdown') then
                0189            gencost_modfld(i,j,bi,bj,k) =
                0190      &      swdown(i,j,bi,bj)*maskC(i,j,1,bi,bj)
                0191          elseif (gencost_barfile(k)(1:8).EQ.'m_lwdown') then
                0192            gencost_modfld(i,j,bi,bj,k) =
                0193      &      lwdown(i,j,bi,bj)*maskC(i,j,1,bi,bj)
b939965590 Gael*0194 #endif
9aeddbf372 Gael*0195          elseif (gencost_barfile(k)(1:8).EQ.'m_wspeed') then
                0196            gencost_modfld(i,j,bi,bj,k) =
                0197      &      wspeed(i,j,bi,bj)*maskC(i,j,1,bi,bj)
94a8024bbe Jean*0198 #endif /* ALLOW_EXF */
9aeddbf372 Gael*0199 #ifdef ALLOW_CTRL
                0200 #ifdef ALLOW_BOTTOMDRAG_CONTROL
c2222c60b2 An T*0201          elseif (gencost_barfile(k)(1:12).EQ.'m_bottomdrag') then
9aeddbf372 Gael*0202            gencost_modfld(i,j,bi,bj,k) =
                0203      &      bottomDragFld(i,j,bi,bj)*maskC(i,j,1,bi,bj)
                0204 #endif
                0205 #endif
f09238ab8f Gael*0206 #ifdef ALLOW_SEAICE
9aeddbf372 Gael*0207          elseif ( (gencost_name(k).EQ.'siv4-conc').OR.
f172f192aa Gael*0208      &            (gencost_barfile(k)(1:8).EQ.'m_siarea') ) then
13d362b8c1 Ou W*0209            gencost_modfld(i,j,bi,bj,k) =
                0210      &      area(i,j,bi,bj)*maskC(i,j,1,bi,bj)
f09238ab8f Gael*0211          elseif (gencost_name(k).EQ.'siv4-deconc') then
13d362b8c1 Ou W*0212            gencost_modfld(i,j,bi,bj,k) =
f09238ab8f Gael*0213      &      theta(i,j,1,bi,bj)*maskC(i,j,1,bi,bj)
9aeddbf372 Gael*0214          elseif ( (gencost_name(k).EQ.'siv4-exconc').OR.
13d362b8c1 Ou W*0215      &            (gencost_barfile(k)(1:8).EQ.'m_siheff') ) then
                0216            gencost_modfld(i,j,bi,bj,k) =
f09238ab8f Gael*0217      &      heff(i,j,bi,bj)*maskC(i,j,1,bi,bj)
f172f192aa Gael*0218          elseif (gencost_barfile(k)(1:9).EQ.'m_sihsnow') then
9aeddbf372 Gael*0219            gencost_modfld(i,j,bi,bj,k) =
                0220      &      hsnow(i,j,bi,bj)*maskC(i,j,1,bi,bj)
4c91ca28d5 Ou W*0221          elseif (gencost_barfile(k)(1:11).EQ.'m_freeboard') then
                0222            gencost_modfld(i,j,bi,bj,k) =
                0223      &      gencost_storefld(i,j,bi,bj,k)*maskC(i,j,1,bi,bj)
f09238ab8f Gael*0224 #endif
5cce2b5d76 Gael*0225 #ifdef ALLOW_GENCOST3D
985662a3b3 Gael*0226          elseif (gencost_barfile(k)(1:7).EQ.'m_theta') then
5cce2b5d76 Gael*0227            kk=gencost_pointer3d(k)
4c91ca28d5 Ou W*0228            do k2=1,Nr
5cce2b5d76 Gael*0229             gencost_mod3d(i,j,k2,bi,bj,kk) =
                0230      &       theta(i,j,k2,bi,bj)*maskC(i,j,k2,bi,bj)
                0231            enddo
985662a3b3 Gael*0232          elseif (gencost_barfile(k)(1:6).EQ.'m_salt') then
5cce2b5d76 Gael*0233            kk=gencost_pointer3d(k)
4c91ca28d5 Ou W*0234            do k2=1,Nr
5cce2b5d76 Gael*0235             gencost_mod3d(i,j,k2,bi,bj,kk) =
                0236      &       salt(i,j,k2,bi,bj)*maskC(i,j,k2,bi,bj)
                0237            enddo
81e05fa829 Gael*0238 #ifdef ALLOW_PTRACERS
                0239          elseif (gencost_barfile(k)(1:9).EQ.'m_ptracer') then
                0240            kk=gencost_pointer3d(k)
4c91ca28d5 Ou W*0241            do k2=1,Nr
81e05fa829 Gael*0242             gencost_mod3d(i,j,k2,bi,bj,kk) =
                0243      &       pTracer(i,j,k2,bi,bj,itr)*maskC(i,j,k2,bi,bj)
                0244            enddo
                0245 #endif
c2222c60b2 An T*0246          elseif (gencost_barfile(k)(1:4).EQ.'m_UE') then
556841ad42 Gael*0247            kk=gencost_pointer3d(k)
4c91ca28d5 Ou W*0248            do k2=1,Nr
556841ad42 Gael*0249             gencost_mod3d(i,j,k2,bi,bj,kk) =
                0250      &       m_UE(i,j,k2,bi,bj)*maskC(i,j,k2,bi,bj)
                0251            enddo
c2222c60b2 An T*0252          elseif (gencost_barfile(k)(1:4).EQ.'m_VN') then
556841ad42 Gael*0253            kk=gencost_pointer3d(k)
4c91ca28d5 Ou W*0254            do k2=1,Nr
556841ad42 Gael*0255             gencost_mod3d(i,j,k2,bi,bj,kk) =
                0256      &       m_VN(i,j,k2,bi,bj)*maskC(i,j,k2,bi,bj)
                0257            enddo
0761692d75 An T*0258          elseif (gencost_barfile(k)(1:7).EQ.'m_trVol') then
                0259            kk=gencost_pointer3d(k)
4c91ca28d5 Ou W*0260            do k2=1,Nr
fce41e6d01 An T*0261              gencost_mod3d(i,j,k2,bi,bj,kk) = trVol(i,j,k2,bi,bj)
0761692d75 An T*0262            enddo
                0263          elseif (gencost_barfile(k)(1:8).EQ.'m_trHeat') then
                0264            kk=gencost_pointer3d(k)
4c91ca28d5 Ou W*0265            do k2=1,Nr
fce41e6d01 An T*0266              gencost_mod3d(i,j,k2,bi,bj,kk) = trHeat(i,j,k2,bi,bj)
0761692d75 An T*0267            enddo
                0268          elseif (gencost_barfile(k)(1:8).EQ.'m_trSalt') then
                0269            kk=gencost_pointer3d(k)
4c91ca28d5 Ou W*0270            do k2=1,Nr
ba67a799b1 An T*0271              gencost_mod3d(i,j,k2,bi,bj,kk) = trSalt(i,j,k2,bi,bj)
0761692d75 An T*0272            enddo
9aeddbf372 Gael*0273 #if (defined (ALLOW_3D_DIFFKR) || defined (ALLOW_DIFFKR_CONTROL))
                0274          elseif (gencost_barfile(k)(1:8).EQ.'m_diffkr') then
                0275            kk=gencost_pointer3d(k)
4c91ca28d5 Ou W*0276            do k2=1,Nr
9aeddbf372 Gael*0277             gencost_mod3d(i,j,k2,bi,bj,kk) =
                0278      &       diffkr(i,j,k2,bi,bj)*maskC(i,j,k2,bi,bj)
                0279            enddo
                0280 #endif
                0281 #ifdef ALLOW_CTRL
94a8024bbe Jean*0282 #if ( defined ALLOW_KAPGM_CONTROL && defined GM_READ_K3D_GM )
9aeddbf372 Gael*0283          elseif (gencost_barfile(k)(1:7).EQ.'m_kapgm') then
                0284            kk=gencost_pointer3d(k)
4c91ca28d5 Ou W*0285            do k2=1,Nr
9aeddbf372 Gael*0286             gencost_mod3d(i,j,k2,bi,bj,kk) =
94a8024bbe Jean*0287      &       GM_inpK3dGM(i,j,k2,bi,bj)*maskC(i,j,k2,bi,bj)
9aeddbf372 Gael*0288            enddo
                0289 #endif
94a8024bbe Jean*0290 #if ( defined ALLOW_KAPREDI_CONTROL && defined GM_READ_K3D_REDI )
9aeddbf372 Gael*0291          elseif (gencost_barfile(k)(1:9).EQ.'m_kapredi') then
                0292            kk=gencost_pointer3d(k)
4c91ca28d5 Ou W*0293            do k2=1,Nr
9aeddbf372 Gael*0294             gencost_mod3d(i,j,k2,bi,bj,kk) =
94a8024bbe Jean*0295      &       GM_inpK3dRedi(i,j,k2,bi,bj)*maskC(i,j,k2,bi,bj)
9aeddbf372 Gael*0296            enddo
                0297 #endif
                0298 #endif
94a8024bbe Jean*0299 #endif /* ALLOW_GENCOST3D */
5cce2b5d76 Gael*0300          endif
27f56e97bb Gael*0301 
8c157ed454 Patr*0302          enddo
                0303         enddo
                0304        enddo
                0305       enddo
f09238ab8f Gael*0306       enddo
8c157ed454 Patr*0307 
                0308 #endif /* ALLOW_GENCOST_CONTRIBUTION */
                0309 
13d362b8c1 Ou W*0310       RETURN
                0311       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!