Changeset 3294 for trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90
- Timestamp:
- 2012-01-28T17:44:18+01:00 (12 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90 (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90
r2715 r3294 35 35 INTEGER :: nadv ! choice of the type of advection scheme 36 36 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: r2dt ! vertical profile time-step, = 2 rdttra 37 ! ! except at nit 000 (=rdttra) if neuler=037 ! ! except at nitrrc000 (=rdttra) if neuler=0 38 38 39 39 !! * Substitutions … … 67 67 !! ** Method : - Update the tracer with the advection term following nadv 68 68 !!---------------------------------------------------------------------- 69 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released70 USE wrk_nemo, ONLY: zun => wrk_3d_4, zvn => wrk_3d_5, zwn => wrk_3d_6 ! effective velocity71 69 !! 72 70 INTEGER, INTENT(in) :: kt ! ocean time-step index … … 74 72 INTEGER :: jk 75 73 CHARACTER (len=22) :: charout 76 !!---------------------------------------------------------------------- 77 ! 78 IF( wrk_in_use(3, 4,5,6) ) THEN 79 CALL ctl_stop('trc_adv : requested workspace arrays unavailable') ; RETURN 80 ENDIF 81 82 IF( kt == nit000 ) CALL trc_adv_ctl ! initialisation & control of options 74 REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn ! effective velocity 75 !!---------------------------------------------------------------------- 76 ! 77 IF( nn_timing == 1 ) CALL timing_start('trc_adv') 78 ! 79 CALL wrk_alloc( jpi, jpj, jpk, zun, zvn, zwn ) 80 ! 81 82 IF( kt == nittrc000 ) CALL trc_adv_ctl ! initialisation & control of options 83 83 84 84 #if ! defined key_pisces 85 IF( neuler == 0 .AND. kt == nit 000 ) THEN ! at nit00085 IF( neuler == 0 .AND. kt == nittrc000 ) THEN ! at nittrc000 86 86 r2dt(:) = rdttrc(:) ! = rdttrc (restarting with Euler time stepping) 87 ELSEIF( kt <= nit 000 + nn_dttrc ) THEN ! at nit000 or nit000+187 ELSEIF( kt <= nittrc000 + 1 ) THEN ! at nittrc000 or nittrc000+1 88 88 r2dt(:) = 2. * rdttrc(:) ! = 2 rdttrc (leapfrog) 89 89 ENDIF … … 102 102 zwn(:,:,jpk) = 0.e0 ! no transport trough the bottom 103 103 104 !! add the eiv transport (if necessary)105 IF( lk_traldf_eiv ) CALL tra_adv_eiv( kt, zun, zvn, zwn, 'TRC' )104 IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif ) & ! add the eiv transport (if necessary) 105 & CALL tra_adv_eiv( kt, nittrc000, zun, zvn, zwn, 'TRC' ) 106 106 ! 107 107 SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==! 108 CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, 'TRC', zun, zvn, zwn, trb, trn, tra, jptra ) ! 2nd order centered109 CASE ( 2 ) ; CALL tra_adv_tvd ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) ! TVD110 CASE ( 3 ) ; CALL tra_adv_muscl ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, tra, jptra ) ! MUSCL111 CASE ( 4 ) ; CALL tra_adv_muscl2( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) ! MUSCL2112 CASE ( 5 ) ; CALL tra_adv_ubs ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) ! UBS113 CASE ( 6 ) ; CALL tra_adv_qck ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) ! QUICKEST108 CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, nittrc000, 'TRC', zun, zvn, zwn, trb, trn, tra, jptra ) ! 2nd order centered 109 CASE ( 2 ) ; CALL tra_adv_tvd ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) ! TVD 110 CASE ( 3 ) ; CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, tra, jptra ) ! MUSCL 111 CASE ( 4 ) ; CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) ! MUSCL2 112 CASE ( 5 ) ; CALL tra_adv_ubs ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) ! UBS 113 CASE ( 6 ) ; CALL tra_adv_qck ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) ! QUICKEST 114 114 ! 115 115 CASE (-1 ) !== esopa: test all possibility with control print ==! 116 CALL tra_adv_cen2 ( kt, 'TRC', zun, zvn, zwn, trb, trn, tra, jptra )116 CALL tra_adv_cen2 ( kt, nittrc000, 'TRC', zun, zvn, zwn, trb, trn, tra, jptra ) 117 117 WRITE(charout, FMT="('adv1')") ; CALL prt_ctl_trc_info(charout) 118 118 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 119 CALL tra_adv_tvd ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )119 CALL tra_adv_tvd ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) 120 120 WRITE(charout, FMT="('adv2')") ; CALL prt_ctl_trc_info(charout) 121 121 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 122 CALL tra_adv_muscl ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, tra, jptra )122 CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, tra, jptra ) 123 123 WRITE(charout, FMT="('adv3')") ; CALL prt_ctl_trc_info(charout) 124 124 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 125 CALL tra_adv_muscl2( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )125 CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) 126 126 WRITE(charout, FMT="('adv4')") ; CALL prt_ctl_trc_info(charout) 127 127 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 128 CALL tra_adv_ubs ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )128 CALL tra_adv_ubs ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) 129 129 WRITE(charout, FMT="('adv5')") ; CALL prt_ctl_trc_info(charout) 130 130 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 131 CALL tra_adv_qck ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )131 CALL tra_adv_qck ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) 132 132 WRITE(charout, FMT="('adv6')") ; CALL prt_ctl_trc_info(charout) 133 133 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') … … 141 141 END IF 142 142 ! 143 IF( wrk_not_released(3, 4,5,6) ) CALL ctl_stop('trc_adv : failed to release workspace arrays.') 143 CALL wrk_dealloc( jpi, jpj, jpk, zun, zvn, zwn ) 144 ! 145 IF( nn_timing == 1 ) CALL timing_stop('trc_adv') 144 146 ! 145 147 END SUBROUTINE trc_adv
Note: See TracChangeset
for help on using the changeset viewer.
