- Timestamp:
- 2016-10-20T15:19:01+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_r6522_SIMPLIF_3/NEMOGCM/NEMO/OPA_SRC/BDY/bdylib.F90
r6862 r7058 5 5 !!====================================================================== 6 6 !! History : 3.6 ! 2013 (D. Storkey) original code 7 !! 4.0 ! 2014 (T. Lovato) Generalize OBC structure 7 8 !!---------------------------------------------------------------------- 8 9 !!---------------------------------------------------------------------- … … 22 23 PRIVATE 23 24 24 PUBLIC bdy_orlanski_2d ! routine called where? 25 PUBLIC bdy_orlanski_3d ! routine called where? 25 PUBLIC bdy_frs, bdy_spe, bdy_nmn, bdy_orl 26 PUBLIC bdy_orlanski_2d 27 PUBLIC bdy_orlanski_3d 26 28 27 29 !!---------------------------------------------------------------------- 28 !! NEMO/OPA 3.3 , NEMO Consortium (2010)30 !! NEMO/OPA 4.0 , NEMO Consortium (2016) 29 31 !! $Id$ 30 32 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 31 33 !!---------------------------------------------------------------------- 32 34 CONTAINS 35 36 SUBROUTINE bdy_frs( idx, pta, dta ) 37 !!---------------------------------------------------------------------- 38 !! *** SUBROUTINE bdy_frs *** 39 !! 40 !! ** Purpose : Apply the Flow Relaxation Scheme for tracers at open boundaries. 41 !! 42 !! Reference : Engedahl H., 1995, Tellus, 365-382. 43 !!---------------------------------------------------------------------- 44 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 45 REAL(wp), DIMENSION(:,:), INTENT(in) :: dta ! OBC external data 46 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pta ! tracer trend 47 !! 48 REAL(wp) :: zwgt ! boundary weight 49 INTEGER :: ib, ik, igrd ! dummy loop indices 50 INTEGER :: ii, ij ! 2D addresses 51 !!---------------------------------------------------------------------- 52 ! 53 IF( nn_timing == 1 ) CALL timing_start('bdy_frs') 54 ! 55 igrd = 1 ! Everything is at T-points here 56 DO ib = 1, idx%nblen(igrd) 57 DO ik = 1, jpkm1 58 ii = idx%nbi(ib,igrd) 59 ij = idx%nbj(ib,igrd) 60 zwgt = idx%nbw(ib,igrd) 61 pta(ii,ij,ik) = ( pta(ii,ij,ik) + zwgt * (dta(ib,ik) - pta(ii,ij,ik) ) ) * tmask(ii,ij,ik) 62 END DO 63 END DO 64 ! 65 IF( nn_timing == 1 ) CALL timing_stop('bdy_frs') 66 ! 67 END SUBROUTINE bdy_frs 68 69 SUBROUTINE bdy_spe( idx, pta, dta ) 70 !!---------------------------------------------------------------------- 71 !! *** SUBROUTINE bdy_spe *** 72 !! 73 !! ** Purpose : Apply a specified value for tracers at open boundaries. 74 !! 75 !!---------------------------------------------------------------------- 76 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 77 REAL(wp), DIMENSION(:,:), INTENT(in) :: dta ! OBC external data 78 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pta ! tracer trend 79 !! 80 REAL(wp) :: zwgt ! boundary weight 81 INTEGER :: ib, ik, igrd ! dummy loop indices 82 INTEGER :: ii, ij ! 2D addresses 83 !!---------------------------------------------------------------------- 84 ! 85 IF( nn_timing == 1 ) CALL timing_start('bdy_spe') 86 ! 87 igrd = 1 ! Everything is at T-points here 88 DO ib = 1, idx%nblenrim(igrd) 89 ii = idx%nbi(ib,igrd) 90 ij = idx%nbj(ib,igrd) 91 DO ik = 1, jpkm1 92 pta(ii,ij,ik) = dta(ib,ik) * tmask(ii,ij,ik) 93 END DO 94 END DO 95 ! 96 IF( nn_timing == 1 ) CALL timing_stop('bdy_spe') 97 ! 98 END SUBROUTINE bdy_spe 99 100 SUBROUTINE bdy_nmn( idx, pta ) 101 !!---------------------------------------------------------------------- 102 !! *** SUBROUTINE bdy_nmn *** 103 !! 104 !! ** Purpose : Duplicate the value for tracers at open boundaries. 105 !! 106 !!---------------------------------------------------------------------- 107 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 108 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pta ! tracer trend 109 !! 110 REAL(wp) :: zwgt ! boundary weight 111 INTEGER :: ib, ik, igrd ! dummy loop indices 112 INTEGER :: ii, ij, zcoef, zcoef1, zcoef2, ip, jp ! 2D addresses 113 !!---------------------------------------------------------------------- 114 ! 115 IF( nn_timing == 1 ) CALL timing_start('bdy_nmn') 116 ! 117 igrd = 1 ! Everything is at T-points here 118 DO ib = 1, idx%nblenrim(igrd) 119 ii = idx%nbi(ib,igrd) 120 ij = idx%nbj(ib,igrd) 121 DO ik = 1, jpkm1 122 ! search the sense of the gradient 123 zcoef1 = bdytmask(ii-1,ij ) + bdytmask(ii+1,ij ) 124 zcoef2 = bdytmask(ii ,ij-1) + bdytmask(ii ,ij+1) 125 IF ( zcoef1+zcoef2 == 0) THEN 126 ! corner 127 zcoef = tmask(ii-1,ij,ik) + tmask(ii+1,ij,ik) + tmask(ii,ij-1,ik) + tmask(ii,ij+1,ik) 128 pta(ii,ij,ik) = pta(ii-1,ij ,ik) * tmask(ii-1,ij ,ik) + & 129 & pta(ii+1,ij ,ik) * tmask(ii+1,ij ,ik) + & 130 & pta(ii ,ij-1,ik) * tmask(ii ,ij-1,ik) + & 131 & pta(ii ,ij+1,ik) * tmask(ii ,ij+1,ik) 132 pta(ii,ij,ik) = ( pta(ii,ij,ik) / MAX( 1, zcoef) ) * tmask(ii,ij,ik) 133 ELSE 134 ip = bdytmask(ii+1,ij ) - bdytmask(ii-1,ij ) 135 jp = bdytmask(ii ,ij+1) - bdytmask(ii ,ij-1) 136 pta(ii,ij,ik) = pta(ii+ip,ij+jp,ik) * tmask(ii+ip,ij+jp,ik) 137 ENDIF 138 END DO 139 END DO 140 ! 141 IF( nn_timing == 1 ) CALL timing_stop('bdy_nmn') 142 ! 143 END SUBROUTINE bdy_nmn 144 145 SUBROUTINE bdy_orl( idx, ptb, pta, dta, ll_npo ) 146 !!---------------------------------------------------------------------- 147 !! *** SUBROUTINE bdy_orl *** 148 !! 149 !! ** Purpose : Apply Orlanski radiation for tracers at open boundaries. 150 !! This is a wrapper routine for bdy_orlanski_3d below 151 !! 152 !!---------------------------------------------------------------------- 153 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 154 REAL(wp), DIMENSION(:,:), INTENT(in) :: dta ! OBC external data 155 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: ptb ! before tracer field 156 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pta ! tracer trend 157 LOGICAL, INTENT(in) :: ll_npo ! switch for NPO version 158 !! 159 INTEGER :: igrd ! grid index 160 !!---------------------------------------------------------------------- 161 ! 162 IF( nn_timing == 1 ) CALL timing_start('bdy_orl') 163 ! 164 igrd = 1 ! Everything is at T-points here 165 ! 166 CALL bdy_orlanski_3d( idx, igrd, ptb(:,:,:), pta(:,:,:), dta, ll_npo ) 167 ! 168 IF( nn_timing == 1 ) CALL timing_stop('bdy_orl') 169 ! 170 END SUBROUTINE bdy_orl 33 171 34 172 SUBROUTINE bdy_orlanski_2d( idx, igrd, phib, phia, phi_ext, ll_npo )
Note: See TracChangeset
for help on using the changeset viewer.
