- Timestamp:
- 2018-06-30T12:51:02+02:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2018/dev_r9838_ENHANCE04_MLF/src/OCE/DYN/dynspg_ts.F90
r9598 r9863 1 1 MODULE dynspg_ts 2 3 !! Includes ROMS wd scheme with diagnostic outputs ; un and ua updates are commented out !4 5 2 !!====================================================================== 6 3 !! *** MODULE dynspg_ts *** … … 35 32 USE sbcisf ! ice shelf variable (fwfisf) 36 33 USE sbcapr ! surface boundary condition: atmospheric pressure 37 USE dynadv , ONLY: ln_dynadv_vec34 USE dynadv , ONLY : ln_dynadv_vec 38 35 USE dynvor ! vortivity scheme indicators 39 36 USE phycst ! physical constants … … 85 82 REAL(wp) :: r1_2 = 0.5_wp ! 86 83 84 REAL(wp) :: r1_2dt_b, r2dt_bf ! local scalars 85 87 86 !! * Substitutions 88 87 # include "vectopt_loop_substitute.h90" … … 151 150 INTEGER :: ikbu, iktu, noffset ! local integers 152 151 INTEGER :: ikbv, iktv ! - - 153 REAL(wp) :: r1_2dt_b, z2dt_bf ! local scalars154 152 REAL(wp) :: zx1, zx2, zu_spg, zhura, z1_hu ! - - 155 153 REAL(wp) :: zy1, zy2, zv_spg, zhvra, z1_hv ! - - … … 182 180 ! zwdramp = 1._wp / (rn_wdmin2 - rn_wdmin1) ! more general ramp 183 181 ! ! reciprocal of baroclinic time step 184 IF( kt == nit000 .AND. neuler == 0 ) THEN ; z2dt_bf = rdt185 ELSE ; z2dt_bf = 2.0_wp * rdt186 ENDIF 187 r1_2dt_b = 1.0_wp / z2dt_bf182 IF( l_1st_euler ) THEN ; r2dt_bf = rdt 183 ELSE ; r2dt_bf = 2.0_wp * rdt 184 ENDIF 185 r1_2dt_b = 1.0_wp / r2dt_bf 188 186 ! 189 187 ll_init = ln_bt_av ! if no time averaging, then no specific restart … … 194 192 ENDIF 195 193 ! 196 IF( kt == nit000 ) THEN !* initialisation 194 IF( kt == nit000 ) THEN !* initialisation 1st time-step 197 195 ! 198 196 IF(lwp) WRITE(numout,*) … … 201 199 IF(lwp) WRITE(numout,*) 202 200 ! 203 IF( neuler == 0 ) ll_init=.TRUE.204 ! 205 IF( ln_bt_fw .OR. neuler == 0) THEN201 IF( l_1st_euler ) ll_init = .TRUE. 202 ! 203 IF( ln_bt_fw .OR. l_1st_euler ) THEN 206 204 ll_fw_start =.TRUE. 207 205 noffset = 0 … … 212 210 ! Set averaging weights and cycle length: 213 211 CALL ts_wgt( ln_bt_av, ll_fw_start, icycle, wgtbtp1, wgtbtp2 ) 212 ! 213 ELSEIF( kt == nit000 + 1 ) THEN !* initialisation 2nd time-step 214 ! 215 IF( .NOT.ln_bt_fw .AND. l_1st_euler ) THEN 216 ll_fw_start = .FALSE. 217 CALL ts_wgt( ln_bt_av, ll_fw_start, icycle, wgtbtp1, wgtbtp2 ) 218 ENDIF 214 219 ! 215 220 ENDIF … … 340 345 END SELECT 341 346 ENDIF 342 ! 343 ! If forward start at previous time step, and centered integration, 344 ! then update averaging weights: 345 IF (.NOT.ln_bt_fw .AND.( neuler==0 .AND. kt==nit000+1 ) ) THEN 346 ll_fw_start=.FALSE. 347 CALL ts_wgt( ln_bt_av, ll_fw_start, icycle, wgtbtp1, wgtbtp2 ) 348 ENDIF 349 347 ! 350 348 ! ----------------------------------------------------------------------------- 351 349 ! Phase 1 : Coupling between general trend and barotropic estimates (1st step) … … 1203 1201 zwx(:,:) = un_adv(:,:) 1204 1202 zwy(:,:) = vn_adv(:,:) 1205 IF( .NOT. ( kt == nit000 .AND. neuler==0 )) THEN1203 IF( .NOT.l_1st_euler ) THEN 1206 1204 un_adv(:,:) = r1_2 * ( ub2_b(:,:) + zwx(:,:) - atfp * un_bf(:,:) ) 1207 1205 vn_adv(:,:) = r1_2 * ( vb2_b(:,:) + zwy(:,:) - atfp * vn_bf(:,:) ) … … 1305 1303 !! ** Purpose : Set time-splitting weights for temporal averaging (or not) 1306 1304 !!---------------------------------------------------------------------- 1307 LOGICAL, INTENT(in) :: ll_av ! temporal averaging=.true. 1308 LOGICAL, INTENT(in) :: ll_fw ! forward time splitting =.true. 1309 INTEGER, INTENT(inout) :: jpit ! cycle length 1310 REAL(wp), DIMENSION(3*nn_baro), INTENT(inout) :: zwgt1, & ! Primary weights 1311 zwgt2 ! Secondary weights 1312 1305 LOGICAL , INTENT(in ) :: ll_av ! temporal averaging=.true. 1306 LOGICAL , INTENT(in ) :: ll_fw ! forward time splitting =.true. 1307 INTEGER , INTENT(inout) :: jpit ! cycle length 1308 REAL(wp), DIMENSION(3*nn_baro), INTENT(inout) :: zwgt1, zwgt2 ! Primary & Secondary weights 1309 ! 1313 1310 INTEGER :: jic, jn, ji ! temporary integers 1314 1311 REAL(wp) :: za1, za2 1315 1312 !!---------------------------------------------------------------------- 1316 1313 ! 1317 1314 zwgt1(:) = 0._wp 1318 1315 zwgt2(:) = 0._wp 1319 1316 ! 1320 1317 ! Set time index when averaged value is requested 1321 IF (ll_fw) THEN 1322 jic = nn_baro 1323 ELSE 1324 jic = 2 * nn_baro 1325 ENDIF 1326 1327 ! Set primary weights: 1328 IF (ll_av) THEN 1329 ! Define simple boxcar window for primary weights 1330 ! (width = nn_baro, centered around jic) 1318 IF ( ll_fw ) THEN ; jic = nn_baro 1319 ELSE ; jic = 2 * nn_baro 1320 ENDIF 1321 1322 ! !== Set primary weights ==! 1323 ! 1324 IF (ll_av) THEN !* Define simple boxcar window for primary weights 1325 ! ! (width = nn_baro, centered around jic) 1331 1326 SELECT CASE ( nn_bt_flt ) 1332 1333 1334 1335 1336 1337 1338 1339 IF (za1 < 0.5_wp) THEN1340 1341 1342 1343 ENDDO1344 1345 1346 1347 1348 IF (za1 < 1._wp) THEN1349 1350 1351 1352 ENDDO1353 1327 CASE( 0 ) ! No averaging 1328 zwgt1(jic) = 1._wp 1329 jpit = jic 1330 ! 1331 CASE( 1 ) ! Boxcar, width = nn_baro 1332 DO jn = 1, 3*nn_baro 1333 za1 = ABS(float(jn-jic))/float(nn_baro) 1334 IF ( za1 < 0.5_wp ) THEN 1335 zwgt1(jn) = 1._wp 1336 jpit = jn 1337 ENDIF 1338 END DO 1339 ! 1340 CASE( 2 ) ! Boxcar, width = 2 * nn_baro 1341 DO jn = 1, 3*nn_baro 1342 za1 = ABS(float(jn-jic))/float(nn_baro) 1343 IF ( za1 < 1._wp ) THEN 1344 zwgt1(jn) = 1._wp 1345 jpit = jn 1346 ENDIF 1347 END DO 1348 CASE DEFAULT ; CALL ctl_stop( 'unrecognised value for nn_bt_flt' ) 1354 1349 END SELECT 1355 1356 ELSE !No time averaging1350 ! 1351 ELSE !* No time averaging 1357 1352 zwgt1(jic) = 1._wp 1358 1353 jpit = jic 1359 1354 ENDIF 1360 1355 1361 ! Set secondary weights 1356 ! !== Set secondary weights ==! 1357 ! 1362 1358 DO jn = 1, jpit 1363 DO ji = jn, jpit1364 1365 END DO1359 DO ji = jn, jpit 1360 zwgt2(jn) = zwgt2(jn) + zwgt1(ji) 1361 END DO 1366 1362 END DO 1367 1363 1368 ! Normalize weigths: 1369 za1 = 1._wp / SUM(zwgt1(1:jpit)) 1370 za2 = 1._wp / SUM(zwgt2(1:jpit)) 1364 ! !== Normalize weights ==! 1365 ! 1366 za1 = 1._wp / SUM( zwgt1(1:jpit) ) 1367 za2 = 1._wp / SUM( zwgt2(1:jpit) ) 1371 1368 DO jn = 1, jpit 1372 zwgt1(jn) = zwgt1(jn) * za11373 zwgt2(jn) = zwgt2(jn) * za21369 zwgt1(jn) = zwgt1(jn) * za1 1370 zwgt2(jn) = zwgt2(jn) * za2 1374 1371 END DO 1375 1372 ! … … 1539 1536 ! 1540 1537 ! ! read restart when needed 1538 !!gm what's happen when starting with an euler time-step BUT not from rest ? 1539 !! this case correspond to a restart with only now time-step available... 1541 1540 CALL ts_rst( nit000, 'READ' ) 1542 1541 ! … … 1548 1547 CALL iom_set_rstw_var_active('vn_bf') 1549 1548 ! 1550 IF ( .NOT.ln_bt_av) THEN1549 IF ( .NOT.ln_bt_av ) THEN 1551 1550 CALL iom_set_rstw_var_active('sshbb_e') 1552 1551 CALL iom_set_rstw_var_active('ubb_e')
Note: See TracChangeset
for help on using the changeset viewer.
