- Timestamp:
- 2016-07-19T10:38:35+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/NERC/dev_r5549_BDY_ZEROGRAD/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90
r6807 r6808 16 16 !! bdy_tra_frs : Apply Flow Relaxation Scheme 17 17 !!---------------------------------------------------------------------- 18 USE timing ! Timing19 USE oce ! ocean dynamics and tracers variables20 USE dom_oce ! ocean space and time domain variables21 USE bdy _oce ! ocean open boundary conditions22 USE bdy lib ! for orlanski library routines23 USE bdydta, ONLY: bf24 USE lbclnk ! ocean lateral boundary conditions (or mpp link)25 USE in_out_manager ! I/O manager26 18 USE oce ! ocean dynamics and tracers variables 19 USE dom_oce ! ocean space and time domain variables 20 USE bdy_oce ! ocean open boundary conditions 21 USE bdylib ! for orlanski library routines 22 USE bdydta , ONLY: bf ! 23 ! 24 USE in_out_manager ! I/O manager 25 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 26 USE timing ! Timing 27 27 28 28 IMPLICIT NONE 29 29 PRIVATE 30 30 31 PUBLIC bdy_tra ! routinecalled in tranxt.F9032 PUBLIC bdy_tra_dmp ! routinecalled in step.F9031 PUBLIC bdy_tra ! called in tranxt.F90 32 PUBLIC bdy_tra_dmp ! called in step.F90 33 33 34 34 !!---------------------------------------------------------------------- … … 46 46 !! 47 47 !!---------------------------------------------------------------------- 48 INTEGER, INTENT( in ) :: kt ! Main time step counter 49 !! 50 INTEGER :: ib_bdy ! Loop index 48 INTEGER, INTENT(in) :: kt ! Main time step counter 49 ! 50 INTEGER :: ib_bdy ! Loop index 51 !!---------------------------------------------------------------------- 51 52 52 53 DO ib_bdy=1, nb_bdy 53 54 ! 54 55 SELECT CASE( cn_tra(ib_bdy) ) 55 CASE('none') 56 CYCLE 57 CASE('frs') 58 CALL bdy_tra_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 59 CASE('specified') 60 CALL bdy_tra_spe( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 61 CASE('neumann') 62 CALL bdy_tra_nmn( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 63 CASE('orlanski') 64 CALL bdy_tra_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ll_npo=.false. ) 65 CASE('orlanski_npo') 66 CALL bdy_tra_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ll_npo=.true. ) 67 CASE('runoff') 68 CALL bdy_tra_rnf( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 69 CASE DEFAULT 70 CALL ctl_stop( 'bdy_tra : unrecognised option for open boundaries for T and S' ) 56 CASE('none' ) ; CYCLE 57 CASE('frs' ) ; CALL bdy_tra_frs ( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 58 CASE('specified' ) ; CALL bdy_tra_spe ( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 59 CASE('neumann' ) ; CALL bdy_tra_nmn ( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 60 CASE('orlanski' ) ; CALL bdy_tra_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ll_npo=.false. ) 61 CASE('orlanski_npo') ; CALL bdy_tra_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ll_npo=.true. ) 62 CASE('runoff' ) ; CALL bdy_tra_rnf ( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 63 CASE DEFAULT ; CALL ctl_stop( 'bdy_tra : unrecognised option for open boundaries for T and S' ) 71 64 END SELECT 72 65 ! Boundary points should be updated 73 66 CALL lbc_bdy_lnk( tsa(:,:,:,jp_tem), 'T', 1., ib_bdy ) 74 67 CALL lbc_bdy_lnk( tsa(:,:,:,jp_sal), 'T', 1., ib_bdy ) 75 ENDDO 76 ! 77 68 END DO 69 ! 78 70 END SUBROUTINE bdy_tra 79 71 72 80 73 SUBROUTINE bdy_tra_frs( idx, dta, kt ) 81 74 !!---------------------------------------------------------------------- … … 86 79 !! Reference : Engedahl H., 1995, Tellus, 365-382. 87 80 !!---------------------------------------------------------------------- 88 INTEGER, INTENT(in) :: kt 89 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices90 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data91 ! !81 INTEGER, INTENT(in) :: kt ! 82 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 83 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data 84 ! 92 85 REAL(wp) :: zwgt ! boundary weight 93 86 INTEGER :: ib, ik, igrd ! dummy loop indices … … 95 88 !!---------------------------------------------------------------------- 96 89 ! 97 IF( nn_timing == 1 ) CALL timing_start('bdy_tra_frs')90 IF( nn_timing == 1 ) CALL timing_start('bdy_tra_frs') 98 91 ! 99 92 igrd = 1 ! Everything is at T-points here … … 108 101 END DO 109 102 ! 110 IF( kt .eq. nit000 ) CLOSE( unit = 102 )111 ! 112 IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_frs')103 IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 104 ! 105 IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_frs') 113 106 ! 114 107 END SUBROUTINE bdy_tra_frs 115 108 109 116 110 SUBROUTINE bdy_tra_spe( idx, dta, kt ) 117 111 !!---------------------------------------------------------------------- … … 121 115 !! 122 116 !!---------------------------------------------------------------------- 123 INTEGER, INTENT(in) :: kt 124 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices125 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data126 ! !117 INTEGER, INTENT(in) :: kt ! 118 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 119 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data 120 ! 127 121 REAL(wp) :: zwgt ! boundary weight 128 122 INTEGER :: ib, ik, igrd ! dummy loop indices … … 142 136 END DO 143 137 ! 144 IF( kt .eq. nit000 )CLOSE( unit = 102 )145 ! 146 IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_spe')138 IF( kt == nit000 ) CLOSE( unit = 102 ) 139 ! 140 IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_spe') 147 141 ! 148 142 END SUBROUTINE bdy_tra_spe 149 143 144 150 145 SUBROUTINE bdy_tra_nmn( idx, dta, kt ) 151 146 !!---------------------------------------------------------------------- … … 155 150 !! 156 151 !!---------------------------------------------------------------------- 157 INTEGER, INTENT(in) :: kt 158 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices159 TYPE(OBC_DATA) , INTENT(in) :: dta! OBC external data160 ! !152 INTEGER, INTENT(in) :: kt ! 153 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 154 TYPE(OBC_DATA) , INTENT(in) :: dta ! OBC external data 155 ! 161 156 REAL(wp) :: zwgt ! boundary weight 162 157 REAL(wp) :: zcoef, zcoef1,zcoef2 … … 165 160 !!---------------------------------------------------------------------- 166 161 ! 167 IF( nn_timing == 1 ) CALL timing_start('bdy_tra_nmn')162 IF( nn_timing == 1 ) CALL timing_start('bdy_tra_nmn') 168 163 ! 169 164 igrd = 1 ! Everything is at T-points here … … 197 192 END DO 198 193 ! 199 IF( kt .eq. nit000 )CLOSE( unit = 102 )200 ! 201 IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_nmn')194 IF( kt == nit000 ) CLOSE( unit = 102 ) 195 ! 196 IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_nmn') 202 197 ! 203 198 END SUBROUTINE bdy_tra_nmn … … 214 209 !! References: Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001) 215 210 !!---------------------------------------------------------------------- 216 TYPE(OBC_INDEX), INTENT(in) :: idx! OBC indices217 TYPE(OBC_DATA) , INTENT(in) :: dta! OBC external data218 LOGICAL ,INTENT(in) :: ll_npo ! switch for NPO version219 211 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 212 TYPE(OBC_DATA) , INTENT(in) :: dta ! OBC external data 213 LOGICAL , INTENT(in) :: ll_npo ! switch for NPO version 214 ! 220 215 INTEGER :: igrd ! grid index 221 216 !!---------------------------------------------------------------------- 222 217 ! 223 218 IF( nn_timing == 1 ) CALL timing_start('bdy_tra_orlanski') 224 219 ! … … 231 226 CALL bdy_orlanski_3d( idx, igrd, tsb(:,:,:,jp_sal), tsa(:,:,:,jp_sal), dta%sal, ll_npo ) 232 227 ! 233 IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_orlanski') 234 ! 235 228 IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_orlanski') 229 ! 236 230 END SUBROUTINE bdy_tra_orlanski 237 231 … … 246 240 !! 247 241 !!---------------------------------------------------------------------- 248 INTEGER , INTENT(in) :: kt249 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices250 TYPE(OBC_DATA) , INTENT(in) :: dta! OBC external data251 ! !242 INTEGER , INTENT(in) :: kt ! 243 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 244 TYPE(OBC_DATA) , INTENT(in) :: dta ! OBC external data 245 ! 252 246 REAL(wp) :: zwgt ! boundary weight 253 247 INTEGER :: ib, ik, igrd ! dummy loop indices … … 255 249 !!---------------------------------------------------------------------- 256 250 ! 257 IF( nn_timing == 1 ) CALL timing_start('bdy_tra_rnf')251 IF( nn_timing == 1 ) CALL timing_start('bdy_tra_rnf') 258 252 ! 259 253 igrd = 1 ! Everything is at T-points here … … 269 263 END DO 270 264 ! 271 IF( kt .eq. nit000 )CLOSE( unit = 102 )272 ! 273 IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_rnf')265 IF( kt == nit000 ) CLOSE( unit = 102 ) 266 ! 267 IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_rnf') 274 268 ! 275 269 END SUBROUTINE bdy_tra_rnf 276 270 271 277 272 SUBROUTINE bdy_tra_dmp( kt ) 278 273 !!---------------------------------------------------------------------- … … 282 277 !! 283 278 !!---------------------------------------------------------------------- 284 INTEGER, INTENT(in) :: kt285 ! !279 INTEGER, INTENT(in) :: kt ! 280 ! 286 281 REAL(wp) :: zwgt ! boundary weight 287 282 REAL(wp) :: zta, zsa, ztime … … 291 286 !!---------------------------------------------------------------------- 292 287 ! 293 IF( nn_timing == 1 ) CALL timing_start('bdy_tra_dmp')294 ! 295 DO ib_bdy =1, nb_bdy296 IF 288 IF( nn_timing == 1 ) CALL timing_start('bdy_tra_dmp') 289 ! 290 DO ib_bdy = 1, nb_bdy 291 IF( ln_tra_dmp(ib_bdy) ) THEN 297 292 igrd = 1 ! Everything is at T-points here 298 293 DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) … … 308 303 END DO 309 304 ENDIF 310 END DO311 ! 312 IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_dmp')305 END DO 306 ! 307 IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_dmp') 313 308 ! 314 309 END SUBROUTINE bdy_tra_dmp … … 326 321 WRITE(*,*) 'bdy_tra_dmp: You should not have seen this print! error?', kt 327 322 END SUBROUTINE bdy_tra_dmp 328 329 323 #endif 330 324
Note: See TracChangeset
for help on using the changeset viewer.
