** 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: Fri, 18 Sep 2025 05:09:21 GMT
Content-Type: text/html; charset=utf-8
MITgcm/MITgcm/pkg/generic_advdiff/gad_pqm_flx_y.F
File indexing completed on 2018-11-23 06:10:13 UTC
view on github raw file Latest commit 83ddf5a6 on 2018-11-23 00:26:56 UTC
8e4c181d69 Jean* 0001 # include "GAD_OPTIONS.h "
0002
0003 SUBROUTINE GAD_PQM_FLX_Y (bi ,bj ,kk ,ix ,
0004 & calc_CFL ,delT ,vvel ,
0005 & vfac ,fhat ,flux ,myThid )
0006
0007
0008
0009
0010 implicit none
0011
0012
0013 # include "SIZE.h "
0014 # include "GRID.h "
0015 # include "GAD.h "
0016
0017
0018
0019
0020
0021
0022
0023
0024
0025
0026
0027
0028
0029 integer bi ,bj ,kk ,ix
0030 logical calc_CFL
0031 _RL delT
0032 _RL vvel (1-OLx :sNx +OLx ,
0033 & 1-OLy :sNy +OLy )
0034 _RL vfac (1-OLx :sNx +OLx ,
0035 & 1-OLy :sNy +OLy )
0036 _RL fhat (1:5,
0037 & 1-OLy :sNy +OLy )
0038 _RL flux (1-OLx :sNx +OLx ,
0039 & 1-OLy :sNy +OLy )
0040 integer myThid
0041
0042
0043
0044
0045
0046
0047
0048
0049 integer iy
0050 _RL vCFL ,intF
0051 _RL ss11 ,ss22
0052 _RL ivec (1:5)
0053
0054
0055
0056
0057
0058
0059
0060
0061
0062
0063 do iy = 1-OLy +4, sNy +OLy -3
0064
0065 if (vvel (ix ,iy ) .eq. 0. _d 0) then
0066
0067 flux (ix ,iy ) = 0. _d 0
0068
0069 else
0070
0071 if (vvel (ix ,iy ) .gt. 0. _d 0) then
0072
0073
0074 if ( calc_CFL ) then
0075 vCFL = vvel (ix ,iy ) * delT
0076 & * recip_dyF (ix ,iy -1,bi ,bj )
0077 & * recip_deepFacC (kk )
0078 else
0079 vCFL = vvel (ix ,iy )
0080 end if
0081
0082 ss11 = +1. _d 0 - 2. _d 0 * vCFL
0083 ss22 = +1. _d 0
0084
0085
0086 ivec (1) = ss22 - ss11
0087 ivec (2) =(ss22 ** 2
0088 & - ss11 ** 2)*(1. _d 0 / 2. _d 0)
0089 ivec (3) =(ss22 ** 3
0090 & - ss11 ** 3)*(1. _d 0 / 3. _d 0)
0091 ivec (4) =(ss22 ** 4
0092 & - ss11 ** 4)*(1. _d 0 / 4. _d 0)
0093 ivec (5) =(ss22 ** 5
0094 & - ss11 ** 5)*(1. _d 0 / 5. _d 0)
0095
0096 intF = ivec (1) * fhat (1,iy -1)
0097 & + ivec (2) * fhat (2,iy -1)
0098 & + ivec (3) * fhat (3,iy -1)
0099 & + ivec (4) * fhat (4,iy -1)
0100 & + ivec (5) * fhat (5,iy -1)
0101
83ddf5a6c6 Mart* 0102
8e4c181d69 Jean* 0103
0104 else
0105
0106
0107 if ( calc_CFL ) then
0108 vCFL = vvel (ix ,iy ) * delT
0109 & * recip_dyF (ix ,iy -0,bi ,bj )
0110 & * recip_deepFacC (kk )
0111 else
0112 vCFL = vvel (ix ,iy )
0113 end if
0114
0115 ss11 = -1. _d 0 - 2. _d 0 * vCFL
0116 ss22 = -1. _d 0
0117
0118
0119 ivec (1) = ss22 - ss11
0120 ivec (2) =(ss22 ** 2
0121 & - ss11 ** 2)*(1. _d 0 / 2. _d 0)
0122 ivec (3) =(ss22 ** 3
0123 & - ss11 ** 3)*(1. _d 0 / 3. _d 0)
0124 ivec (4) =(ss22 ** 4
0125 & - ss11 ** 4)*(1. _d 0 / 4. _d 0)
0126 ivec (5) =(ss22 ** 5
0127 & - ss11 ** 5)*(1. _d 0 / 5. _d 0)
0128
0129 intF = ivec (1) * fhat (1,iy -0)
0130 & + ivec (2) * fhat (2,iy -0)
0131 & + ivec (3) * fhat (3,iy -0)
0132 & + ivec (4) * fhat (4,iy -0)
0133 & + ivec (5) * fhat (5,iy -0)
0134
83ddf5a6c6 Mart* 0135
8e4c181d69 Jean* 0136
0137 end if
0138
83ddf5a6c6 Mart* 0139
0140
0141 intF = 0.5 _d 0 * intF / sign (max(abs(vCFL ),1.d -20),vCFL )
0142
8e4c181d69 Jean* 0143
0144 flux (ix ,iy ) = + vfac (ix ,iy ) * intF
0145
0146 end if
0147
0148 end do
0149
0150 return
0151
0152
0153 end