pkg/ecco/cost_gencost_customize.F

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
                0015       subroutine cost_gencost_customize( mythid )
8f7d13d0c9 Jean*0016
8c157ed454 Patr*0017 c     ==================================================================
e7d9258ace Gael*0018 c     SUBROUTINE cost_gencost_customize
8c157ed454 Patr*0019 c     ==================================================================
                0020
                0021       implicit none
                0022
                0023 c     == global variables ==
                0024
                0025 #include "EEPARAMS.h"
                0026 #include "SIZE.h"
27f56e97bb Gael*0027 #include "GRID.h"
8c157ed454 Patr*0028 #include "PARAMS.h"
                0029 #include "DYNVARS.h"
                0030 #include "FFIELDS.h"
f09238ab8f Gael*0031 #ifdef ALLOW_ECCO
13d362b8c1 Ou W*0032 # include "ECCO_SIZE.h"
                0033 # include "ECCO.h"
f09238ab8f Gael*0034 #endif
27f56e97bb Gael*0035 #ifdef ALLOW_SEAICE
                0036 #  include "SEAICE_SIZE.h"
                0037 #  include "SEAICE.h"
                0038 #endif
f09238ab8f Gael*0039 #ifdef ALLOW_EXF
                0040 # include "EXF_FIELDS.h"
                0041 #endif
9aeddbf372 Gael*0042 #ifdef ALLOW_CTRL
                0043 # include "CTRL_FIELDS.h"
                0044 #endif
94a8024bbe Jean*0045 #ifdef ALLOW_GMREDI
                0046 # include "GMREDI.h"
                0047 #endif
81e05fa829 Gael*0048 #ifdef ALLOW_PTRACERS
                0049 # include "PTRACERS_SIZE.h"
                0050 # include "PTRACERS_FIELDS.h"
                0051 #endif
8c157ed454 Patr*0052
                0053 c     == routine arguments ==
                0054
                0055       integer mythid
                0056
                0057 #ifdef ALLOW_GENCOST_CONTRIBUTION
                0058 c     == local variables ==
                0059
                0060       integer bi,bj
27f56e97bb Gael*0061       integer i,j,k
5cce2b5d76 Gael*0062 #ifdef ALLOW_GENCOST3D
                0063       integer k2,kk
81e05fa829 Gael*0064       integer itr
5cce2b5d76 Gael*0065 #endif
13d362b8c1 Ou W*0066       integer kLev
5efdcaef73 Gael*0067 #ifdef ALLOW_EXF
                0068       _RL uBarC, vBarC
9aeddbf372 Gael*0069       _RL zontau        (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
                0070       _RL mertau        (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
                0071       _RL zonwind        (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
                0072       _RL merwind        (1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
5efdcaef73 Gael*0073 #endif
8c157ed454 Patr*0074       integer itlo,ithi
                0075       integer jtlo,jthi
                0076       integer jmin,jmax
                0077       integer imin,imax
                0078
                0079 c     == end of interface ==
                0080
69f8f4c84c Patr*0081       jtlo = mybylo(mythid)
                0082       jthi = mybyhi(mythid)
                0083       itlo = mybxlo(mythid)
                0084       ithi = mybxhi(mythid)
                0085       jmin = 1
                0086       jmax = sny
                0087       imin = 1
                0088       imax = snx
                0089
5efdcaef73 Gael*0090 #ifdef ALLOW_EXF
                0091 c rotated to EW/NS tracer point
                0092         do bj = jtlo,jthi
                0093           do bi = itlo,ithi
                0094             do j = jmin,jmax
                0095               do i = imin,imax
                0096                 uBarC = 0.5 _d 0
                0097      &           *(ustress(i,j,bi,bj)+ustress(i+1,j,bi,bj))
                0098                 vBarC = 0.5 _d 0
                0099      &           *(vstress(i,j,bi,bj)+vstress(i,j+1,bi,bj))
9aeddbf372 Gael*0100                 zontau(i,j,bi,bj) = angleCosC(i,j,bi,bj)*uBarC
5efdcaef73 Gael*0101      &                           -angleSinC(i,j,bi,bj)*vBarC
9aeddbf372 Gael*0102                 mertau(i,j,bi,bj) = angleSinC(i,j,bi,bj)*uBarC
5efdcaef73 Gael*0103      &                           +angleCosC(i,j,bi,bj)*vBarC
                0104               enddo
                0105             enddo
                0106           enddo
                0107         enddo
                0108
9aeddbf372 Gael*0109 c the following should be identical to the above
                0110 c     CALL ROTATE_UV2EN_RL(ustress,vstress,zontau,mertau,
                0111 c    &     .TRUE.,.TRUE.,.TRUE.,1,myThid)
5efdcaef73 Gael*0112
9aeddbf372 Gael*0113       CALL ROTATE_UV2EN_RL(uwind,vwind,zonwind,merwind,
                0114      &     .TRUE.,.FALSE.,.TRUE.,1,myThid)
                0115 #endif
5efdcaef73 Gael*0116
f09238ab8f Gael*0117       do k=1,NGENCOST
81e05fa829 Gael*0118       itr=gencost_itracer(k)
13d362b8c1 Ou W*0119       kLev = MAX( 1, MIN( Nr, gencost_kLev_select(k) ) )
8c157ed454 Patr*0120       do bj = jtlo,jthi
                0121        do bi = itlo,ithi
                0122         do j = jmin,jmax
                0123          do i =  imin,imax
f09238ab8f Gael*0124
13d362b8c1 Ou W*0125          if (gencost_barfile(k)(1:5).EQ.'m_eta' .and.
                0126      &       gencost_barfile(k)(1:9).NE.'m_eta_dyn') then
                0127            gencost_modfld(i,j,bi,bj,k) =
556841ad42 Gael*0128      &      m_eta(i,j,bi,bj)*maskC(i,j,1,bi,bj)
bdae1843b8 Gael*0129          elseif (gencost_barfile(k)(1:9).EQ.'m_boxmean') then
13d362b8c1 Ou W*0130            gencost_modfld(i,j,bi,bj,k) =
bdae1843b8 Gael*0131      &      gencost_storefld(i,j,bi,bj,k)
447bdc4b79 Gael*0132          elseif (gencost_barfile(k)(1:9).EQ.'m_horflux') then
13d362b8c1 Ou W*0133            gencost_modfld(i,j,bi,bj,k) =
447bdc4b79 Gael*0134      &      gencost_storefld(i,j,bi,bj,k)
985662a3b3 Gael*0135          elseif (gencost_barfile(k)(1:5).EQ.'m_sst') then
13d362b8c1 Ou W*0136            gencost_modfld(i,j,bi,bj,k) =
f09238ab8f Gael*0137      &      THETA(i,j,1,bi,bj)*maskC(i,j,1,bi,bj)
985662a3b3 Gael*0138          elseif (gencost_barfile(k)(1:5).EQ.'m_sss') then
13d362b8c1 Ou W*0139            gencost_modfld(i,j,bi,bj,k) =
f09238ab8f Gael*0140      &      SALT(i,j,1,bi,bj)*maskC(i,j,1,bi,bj)
13d362b8c1 Ou W*0141          elseif (gencost_barfile(k)(1:11).EQ.'m_drifterUE') then
                0142            gencost_modfld(i,j,bi,bj,k) =
                0143      &      m_UE(i,j,kLev,bi,bj)*maskC(i,j,kLev,bi,bj)
                0144          elseif (gencost_barfile(k)(1:11).EQ.'m_drifterVN') then
                0145            gencost_modfld(i,j,bi,bj,k) =
                0146      &      m_VN(i,j,kLev,bi,bj)*maskC(i,j,kLev,bi,bj)
                0147          elseif (gencost_barfile(k)(1:4).EQ.'m_bp' .and.
                0148      &           gencost_barfile(k)(1:12).NE.'m_bp_nopabar') then
                0149            gencost_modfld(i,j,bi,bj,k) =
                0150      &      m_bp(i,j,bi,bj)*maskC(i,j,1,bi,bj)
                0151 #ifdef ATMOSPHERIC_LOADING
                0152 #ifdef ALLOW_IB_CORR
                0153          elseif (gencost_barfile(k)(1:9).EQ.'m_eta_dyn') then
                0154            gencost_modfld(i,j,bi,bj,k) =
                0155      &      m_eta_dyn(i,j,bi,bj)*maskC(i,j,1,bi,bj)
                0156          elseif (gencost_barfile(k)(1:12).EQ.'m_bp_nopabar') then
                0157            gencost_modfld(i,j,bi,bj,k) =
                0158      &      m_bp_nopabar(i,j,bi,bj)*maskC(i,j,1,bi,bj)
                0159 #endif
6b2230d510 Ou W*0160 #endif
9aeddbf372 Gael*0161 #ifdef ALLOW_GEOTHERMAL_FLUX
                0162          elseif (gencost_barfile(k)(1:16).EQ.'m_geothermalflux') then
                0163            gencost_modfld(i,j,bi,bj,k) =
                0164      &      geothermalFlux(i,j,bi,bj)*maskC(i,j,1,bi,bj)
                0165 #endif
                0166 #ifdef ALLOW_EXF
                0167          elseif (gencost_barfile(k)(1:9).EQ.'m_ustress') then
13d362b8c1 Ou W*0168            gencost_modfld(i,j,bi,bj,k) =
9aeddbf372 Gael*0169      &      zontau(i,j,bi,bj)*maskC(i,j,1,bi,bj)
                0170          elseif (gencost_barfile(k)(1:9).EQ.'m_vstress') then
13d362b8c1 Ou W*0171            gencost_modfld(i,j,bi,bj,k) =
9aeddbf372 Gael*0172      &      mertau(i,j,bi,bj)*maskC(i,j,1,bi,bj)
c2222c60b2 An T*0173          elseif (gencost_barfile(k)(1:7).EQ.'m_uwind') then
9aeddbf372 Gael*0174            gencost_modfld(i,j,bi,bj,k) =
                0175      &      zonwind(i,j,bi,bj)*maskC(i,j,1,bi,bj)
c2222c60b2 An T*0176          elseif (gencost_barfile(k)(1:7).EQ.'m_vwind') then
9aeddbf372 Gael*0177            gencost_modfld(i,j,bi,bj,k) =
                0178      &      merwind(i,j,bi,bj)*maskC(i,j,1,bi,bj)
b939965590 Gael*0179 #ifdef ALLOW_ATM_TEMP
9aeddbf372 Gael*0180          elseif (gencost_barfile(k)(1:7).EQ.'m_atemp') then
                0181            gencost_modfld(i,j,bi,bj,k) =
                0182      &      atemp(i,j,bi,bj)*maskC(i,j,1,bi,bj)
                0183          elseif (gencost_barfile(k)(1:5).EQ.'m_aqh') then
                0184            gencost_modfld(i,j,bi,bj,k) =
                0185      &      aqh(i,j,bi,bj)*maskC(i,j,1,bi,bj)
                0186          elseif (gencost_barfile(k)(1:8).EQ.'m_precip') then
                0187            gencost_modfld(i,j,bi,bj,k) =
                0188      &      precip(i,j,bi,bj)*maskC(i,j,1,bi,bj)
b939965590 Gael*0189 #endif
                0190 #ifdef ALLOW_DOWNWARD_RADIATION
9aeddbf372 Gael*0191          elseif (gencost_barfile(k)(1:8).EQ.'m_swdown') then
                0192            gencost_modfld(i,j,bi,bj,k) =
                0193      &      swdown(i,j,bi,bj)*maskC(i,j,1,bi,bj)
                0194          elseif (gencost_barfile(k)(1:8).EQ.'m_lwdown') then
                0195            gencost_modfld(i,j,bi,bj,k) =
                0196      &      lwdown(i,j,bi,bj)*maskC(i,j,1,bi,bj)
b939965590 Gael*0197 #endif
9aeddbf372 Gael*0198          elseif (gencost_barfile(k)(1:8).EQ.'m_wspeed') then
                0199            gencost_modfld(i,j,bi,bj,k) =
                0200      &      wspeed(i,j,bi,bj)*maskC(i,j,1,bi,bj)
94a8024bbe Jean*0201 #endif /* ALLOW_EXF */
9aeddbf372 Gael*0202 #ifdef ALLOW_CTRL
                0203 #ifdef ALLOW_BOTTOMDRAG_CONTROL
c2222c60b2 An T*0204          elseif (gencost_barfile(k)(1:12).EQ.'m_bottomdrag') then
9aeddbf372 Gael*0205            gencost_modfld(i,j,bi,bj,k) =
                0206      &      bottomDragFld(i,j,bi,bj)*maskC(i,j,1,bi,bj)
                0207 #endif
                0208 #endif
f09238ab8f Gael*0209 #ifdef ALLOW_SEAICE
9aeddbf372 Gael*0210          elseif ( (gencost_name(k).EQ.'siv4-conc').OR.
f172f192aa Gael*0211      &            (gencost_barfile(k)(1:8).EQ.'m_siarea') ) then
13d362b8c1 Ou W*0212            gencost_modfld(i,j,bi,bj,k) =
                0213      &      area(i,j,bi,bj)*maskC(i,j,1,bi,bj)
f09238ab8f Gael*0214          elseif (gencost_name(k).EQ.'siv4-deconc') then
13d362b8c1 Ou W*0215            gencost_modfld(i,j,bi,bj,k) =
f09238ab8f Gael*0216      &      theta(i,j,1,bi,bj)*maskC(i,j,1,bi,bj)
9aeddbf372 Gael*0217          elseif ( (gencost_name(k).EQ.'siv4-exconc').OR.
13d362b8c1 Ou W*0218      &            (gencost_barfile(k)(1:8).EQ.'m_siheff') ) then
                0219            gencost_modfld(i,j,bi,bj,k) =
f09238ab8f Gael*0220      &      heff(i,j,bi,bj)*maskC(i,j,1,bi,bj)
f172f192aa Gael*0221          elseif (gencost_barfile(k)(1:9).EQ.'m_sihsnow') then
9aeddbf372 Gael*0222            gencost_modfld(i,j,bi,bj,k) =
                0223      &      hsnow(i,j,bi,bj)*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)
                0228            do k2=1,nr
                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)
                0234            do k2=1,nr
                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)
                0241            do k2=1,nr
                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)
                0248            do k2=1,nr
                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)
                0254            do k2=1,nr
                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)
                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)
                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)
                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)
                0276            do k2=1,nr
                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)
                0285            do k2=1,nr
                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)
                0293            do k2=1,nr
                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