** Warning **

Issuing rollback() due to DESTROY without explicit disconnect() of DBD::mysql::db handle dbname=MITgcm at /usr/local/share/lxr/lib/LXR/Common.pm line 1224.

Last-Modified: Thu, 15 May 2024 05:11:27 GMT Content-Type: text/html; charset=utf-8 MITgcm/MITgcm/verification/hs94.128x64x5/code/external_forcing.F
Back to home page

MITgcm
 
 

    

File indexing completed on 2018-03-02 18:45:36 UTC

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
42c525bfb4 Alis*0001 #include "CPP_OPTIONS.h"
                0002 
b4656da4c6 Jean*0003 CBOP
                0004 C     !ROUTINE: EXTERNAL_FORCING_U
                0005 C     !INTERFACE:
42c525bfb4 Alis*0006       SUBROUTINE EXTERNAL_FORCING_U(
b4656da4c6 Jean*0007      I           iMin,iMax, jMin,jMax, bi,bj, kLev,
                0008      I           myTime, myThid )
                0009 C     !DESCRIPTION: \bv
                0010 C     *==========================================================*
                0011 C     | S/R EXTERNAL_FORCING_U
                0012 C     | o Contains problem specific forcing for zonal velocity.
                0013 C     *==========================================================*
                0014 C     | Adds terms to gU for forcing by external sources
                0015 C     | e.g. wind stress, bottom friction etc ...
                0016 C     *==========================================================*
                0017 C     \ev
42c525bfb4 Alis*0018 
b4656da4c6 Jean*0019 C     !USES:
                0020       IMPLICIT NONE
42c525bfb4 Alis*0021 C     == Global data ==
                0022 #include "SIZE.h"
                0023 #include "EEPARAMS.h"
                0024 #include "PARAMS.h"
                0025 #include "GRID.h"
                0026 #include "DYNVARS.h"
                0027 #include "FFIELDS.h"
                0028 
b4656da4c6 Jean*0029 C     !INPUT/OUTPUT PARAMETERS:
42c525bfb4 Alis*0030 C     == Routine arguments ==
b4656da4c6 Jean*0031 C     iMin,iMax :: Working range of x-index for applying forcing.
                0032 C     jMin,jMax :: Working range of y-index for applying forcing.
                0033 C     bi,bj     :: Current tile indices
                0034 C     kLev      :: Current vertical level index
                0035 C     myTime    :: Current time in simulation
                0036 C     myThid    :: Thread Id number
42c525bfb4 Alis*0037       INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
b4656da4c6 Jean*0038       _RL myTime
42c525bfb4 Alis*0039       INTEGER myThid
                0040 
b4656da4c6 Jean*0041 C     !LOCAL VARIABLES:
42c525bfb4 Alis*0042 C     == Local variables ==
b4656da4c6 Jean*0043 C     i,j       :: Loop counters
                0044       INTEGER i, j
                0045 CEOP
                0046       _RL recip_P0g, termP, kV, kF, sigma_b
42c525bfb4 Alis*0047 
aea29c8517 Alis*0048 C--   Forcing term(s)
aea360aa02 Jean*0049       kF=1. _d 0/86400. _d 0
                0050       sigma_b = 0.7 _d 0
b4656da4c6 Jean*0051 c     DO j=1,sNy
                0052 C-jmc: Without CD-scheme, this is OK ; but with CD-scheme, needs to cover [0:sNy+1]
                0053       DO j=0,sNy+1
                0054        DO i=1,sNx+1
aea360aa02 Jean*0055         IF ( hFacW(i,j,kLev,bi,bj) .GT. 0. ) THEN
b4656da4c6 Jean*0056          recip_P0g=MAX(recip_Rcol(i,j,bi,bj),recip_Rcol(i-1,j,bi,bj))
aea360aa02 Jean*0057          termP=0.5 _d 0*( MIN(rF(kLev)*recip_P0g,1. _d 0)
                0058      &                   +rF(kLev+1)*recip_P0g )
b4656da4c6 Jean*0059 c        termP=0.5 _d 0*( rF(kLev) + rF(kLev+1) )*recip_P0g
aea360aa02 Jean*0060          kV=kF*MAX( 0. _d 0, (termP-sigma_b)/(1. _d 0-sigma_b) )
42c525bfb4 Alis*0061          gU(i,j,kLev,bi,bj)=gU(i,j,kLev,bi,bj)
b4656da4c6 Jean*0062      &                     -kV*uVel(i,j,kLev,bi,bj)
42c525bfb4 Alis*0063         ENDIF
                0064        ENDDO
                0065       ENDDO
                0066 
                0067       RETURN
                0068       END
b4656da4c6 Jean*0069 
                0070 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0071 CBOP
                0072 C     !ROUTINE: EXTERNAL_FORCING_V
                0073 C     !INTERFACE:
42c525bfb4 Alis*0074       SUBROUTINE EXTERNAL_FORCING_V(
b4656da4c6 Jean*0075      I           iMin,iMax, jMin,jMax, bi,bj, kLev,
                0076      I           myTime, myThid )
                0077 C     !DESCRIPTION: \bv
                0078 C     *==========================================================*
                0079 C     | S/R EXTERNAL_FORCING_V
                0080 C     | o Contains problem specific forcing for merid velocity.
                0081 C     *==========================================================*
                0082 C     | Adds terms to gV for forcing by external sources
                0083 C     | e.g. wind stress, bottom friction etc ...
                0084 C     *==========================================================*
                0085 C     \ev
42c525bfb4 Alis*0086 
b4656da4c6 Jean*0087 C     !USES:
                0088       IMPLICIT NONE
42c525bfb4 Alis*0089 C     == Global data ==
                0090 #include "SIZE.h"
                0091 #include "EEPARAMS.h"
                0092 #include "PARAMS.h"
                0093 #include "GRID.h"
                0094 #include "DYNVARS.h"
                0095 #include "FFIELDS.h"
                0096 
b4656da4c6 Jean*0097 C     !INPUT/OUTPUT PARAMETERS:
42c525bfb4 Alis*0098 C     == Routine arguments ==
b4656da4c6 Jean*0099 C     iMin,iMax :: Working range of x-index for applying forcing.
                0100 C     jMin,jMax :: Working range of y-index for applying forcing.
                0101 C     bi,bj     :: Current tile indices
                0102 C     kLev      :: Current vertical level index
                0103 C     myTime    :: Current time in simulation
                0104 C     myThid    :: Thread Id number
42c525bfb4 Alis*0105       INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
b4656da4c6 Jean*0106       _RL myTime
42c525bfb4 Alis*0107       INTEGER myThid
b4656da4c6 Jean*0108 
                0109 C     !LOCAL VARIABLES:
42c525bfb4 Alis*0110 C     == Local variables ==
b4656da4c6 Jean*0111 C     i,j       :: Loop counters
                0112       INTEGER i, j
                0113 CEOP
                0114       _RL recip_P0g, termP, kV, kF, sigma_b
42c525bfb4 Alis*0115 
aea29c8517 Alis*0116 C--   Forcing term(s)
aea360aa02 Jean*0117       kF=1. _d 0/86400. _d 0
                0118       sigma_b = 0.7 _d 0
b4656da4c6 Jean*0119       DO j=1,sNy+1
                0120 c      DO i=1,sNx
                0121 C-jmc: Without CD-scheme, this is OK ; but with CD-scheme, needs to cover [0:sNx+1]
                0122        DO i=0,sNx+1
aea360aa02 Jean*0123         IF ( hFacS(i,j,kLev,bi,bj) .GT. 0. ) THEN
b4656da4c6 Jean*0124          recip_P0g=MAX(recip_Rcol(i,j,bi,bj),recip_Rcol(i,j-1,bi,bj))
aea360aa02 Jean*0125          termP=0.5 _d 0*( MIN(rF(kLev)*recip_P0g,1. _d 0)
                0126      &                   +rF(kLev+1)*recip_P0g )
b4656da4c6 Jean*0127 c        termP=0.5 _d 0*( rF(kLev) + rF(kLev+1) )*recip_P0g
aea360aa02 Jean*0128          kV=kF*MAX( 0. _d 0, (termP-sigma_b)/(1. _d 0-sigma_b) )
42c525bfb4 Alis*0129          gV(i,j,kLev,bi,bj)=gV(i,j,kLev,bi,bj)
                0130      &                      -kV*vVel(i,j,kLev,bi,bj)
                0131         ENDIF
                0132        ENDDO
                0133       ENDDO
                0134 
                0135       RETURN
                0136       END
b4656da4c6 Jean*0137 
                0138 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0139 CBOP
                0140 C     !ROUTINE: EXTERNAL_FORCING_T
                0141 C     !INTERFACE:
42c525bfb4 Alis*0142       SUBROUTINE EXTERNAL_FORCING_T(
b4656da4c6 Jean*0143      I           iMin,iMax, jMin,jMax, bi,bj, kLev,
                0144      I           myTime, myThid )
                0145 C     !DESCRIPTION: \bv
                0146 C     *==========================================================*
                0147 C     | S/R EXTERNAL_FORCING_T
                0148 C     | o Contains problem specific forcing for temperature.
                0149 C     *==========================================================*
                0150 C     | Adds terms to gT for forcing by external sources
                0151 C     | e.g. heat flux, climatalogical relaxation, etc ...
                0152 C     *==========================================================*
                0153 C     \ev
42c525bfb4 Alis*0154 
b4656da4c6 Jean*0155 C     !USES:
                0156       IMPLICIT NONE
42c525bfb4 Alis*0157 C     == Global data ==
                0158 #include "SIZE.h"
                0159 #include "EEPARAMS.h"
                0160 #include "PARAMS.h"
                0161 #include "GRID.h"
                0162 #include "DYNVARS.h"
                0163 #include "FFIELDS.h"
                0164 
b4656da4c6 Jean*0165 C     !INPUT/OUTPUT PARAMETERS:
42c525bfb4 Alis*0166 C     == Routine arguments ==
b4656da4c6 Jean*0167 C     iMin,iMax :: Working range of x-index for applying forcing.
                0168 C     jMin,jMax :: Working range of y-index for applying forcing.
                0169 C     bi,bj     :: Current tile indices
                0170 C     kLev      :: Current vertical level index
                0171 C     myTime    :: Current time in simulation
                0172 C     myThid    :: Thread Id number
42c525bfb4 Alis*0173       INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
b4656da4c6 Jean*0174       _RL myTime
42c525bfb4 Alis*0175       INTEGER myThid
                0176 
b4656da4c6 Jean*0177 C     !LOCAL VARIABLES:
42c525bfb4 Alis*0178 C     == Local variables ==
b4656da4c6 Jean*0179 C     i,j       :: Loop counters
                0180       INTEGER i, j
                0181 CEOP
aea360aa02 Jean*0182       _RL thetaLim,kT,ka,ks,sigma_b,term1,term2,thetaEq,termP
42c525bfb4 Alis*0183 
aea29c8517 Alis*0184 C--   Forcing term(s)
0b7f1f1573 Alis*0185       ka=1. _d 0/(40. _d 0*86400. _d 0)
                0186       ks=1. _d 0/(4. _d 0 *86400. _d 0)
aea360aa02 Jean*0187       sigma_b = 0.7 _d 0
b4656da4c6 Jean*0188       DO j=1,sNy
                0189        DO i=1,sNx
                0190          term1=60. _d 0*(SIN(yC(i,j,bi,bj)*deg2rad)**2)
aea360aa02 Jean*0191          termP=0.5 _d 0*( rF(kLev) + rF(kLev+1) )
b4656da4c6 Jean*0192          term2=10. _d 0*LOG(termP/atm_po)
                0193      &            *(COS(yC(i,j,bi,bj)*deg2rad)**2)
aea360aa02 Jean*0194          thetaLim = 200. _d 0/ ((termP/atm_po)**atm_kappa)
                0195          thetaEq=315. _d 0-term1-term2
                0196          thetaEq=MAX(thetaLim,thetaEq)
b4656da4c6 Jean*0197          termP=0.5 _d 0*( MIN(rF(kLev),Ro_surf(i,j,bi,bj))+rF(kLev+1) )
aea360aa02 Jean*0198          kT=ka+(ks-ka)
                0199      &     *MAX(0. _d 0,
b4656da4c6 Jean*0200      &       (termP*recip_Rcol(i,j,bi,bj)-sigma_b)/(1. _d 0-sigma_b) )
                0201      &     *COS((yC(i,j,bi,bj)*deg2rad))**4
42c525bfb4 Alis*0202          gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
b4656da4c6 Jean*0203      &        - kT*( theta(i,j,kLev,bi,bj)-thetaEq )
aea29c8517 Alis*0204      &            *maskC(i,j,kLev,bi,bj)
42c525bfb4 Alis*0205        ENDDO
                0206       ENDDO
                0207 
                0208       RETURN
                0209       END
b4656da4c6 Jean*0210 
                0211 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0212 CBOP
                0213 C     !ROUTINE: EXTERNAL_FORCING_S
                0214 C     !INTERFACE:
42c525bfb4 Alis*0215       SUBROUTINE EXTERNAL_FORCING_S(
b4656da4c6 Jean*0216      I           iMin,iMax, jMin,jMax, bi,bj, kLev,
                0217      I           myTime, myThid )
                0218 
                0219 C     !DESCRIPTION: \bv
                0220 C     *==========================================================*
                0221 C     | S/R EXTERNAL_FORCING_S
                0222 C     | o Contains problem specific forcing for merid velocity.
                0223 C     *==========================================================*
                0224 C     | Adds terms to gS for forcing by external sources
                0225 C     | e.g. fresh-water flux, climatalogical relaxation, etc ...
                0226 C     *==========================================================*
                0227 C     \ev
42c525bfb4 Alis*0228 
b4656da4c6 Jean*0229 C     !USES:
                0230       IMPLICIT NONE
42c525bfb4 Alis*0231 C     == Global data ==
                0232 #include "SIZE.h"
                0233 #include "EEPARAMS.h"
                0234 #include "PARAMS.h"
                0235 #include "GRID.h"
                0236 #include "DYNVARS.h"
                0237 #include "FFIELDS.h"
                0238 
b4656da4c6 Jean*0239 C     !INPUT/OUTPUT PARAMETERS:
42c525bfb4 Alis*0240 C     == Routine arguments ==
b4656da4c6 Jean*0241 C     iMin,iMax :: Working range of x-index for applying forcing.
                0242 C     jMin,jMax :: Working range of y-index for applying forcing.
                0243 C     bi,bj     :: Current tile indices
                0244 C     kLev      :: Current vertical level index
                0245 C     myTime    :: Current time in simulation
                0246 C     myThid    :: Thread Id number
42c525bfb4 Alis*0247       INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
b4656da4c6 Jean*0248       _RL myTime
42c525bfb4 Alis*0249       INTEGER myThid
                0250 
b4656da4c6 Jean*0251 C     !LOCAL VARIABLES:
42c525bfb4 Alis*0252 C     == Local variables ==
b4656da4c6 Jean*0253 C     i,j       :: Loop counters
                0254 c     INTEGER i, j
                0255 CEOP
42c525bfb4 Alis*0256 
aea29c8517 Alis*0257 C--   Forcing term(s)
42c525bfb4 Alis*0258 
                0259       RETURN
                0260       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!