Changeset 2715 for trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90
- Timestamp:
- 2011-03-30T17:58:35+02:00 (13 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90 (modified) (7 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90
r2561 r2715 24 24 USE ldftra_oce ! lateral diffusion coefficient on tracers 25 25 USE in_out_manager ! I/O manager 26 USE iom ! I/O module 26 27 USE prtctl ! Print control 27 USE iom28 USE lib_mpp ! MPP library 28 29 29 30 IMPLICIT NONE … … 32 33 PUBLIC tra_adv ! routine called by step module 33 34 PUBLIC tra_adv_init ! routine called by opa module 34 35 35 36 ! !!* Namelist namtra_adv * 36 37 LOGICAL :: ln_traadv_cen2 = .TRUE. ! 2nd order centered scheme flag … … 43 44 INTEGER :: nadv ! choice of the type of advection scheme 44 45 45 REAL(wp), DIMENSION(jpk) :: r2dt ! vertical profile time-step, = 2 rdttra except at nit000 (=rdttra) if neuler=046 47 46 !! * Substitutions 48 47 # include "domzgr_substitute.h90" … … 63 62 !! ** Method : - Update (ua,va) with the advection term following nadv 64 63 !!---------------------------------------------------------------------- 64 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 65 USE wrk_nemo, ONLY: zun => wrk_3d_1 , zvn => wrk_3d_2 , zwn => wrk_3d_3 ! 3D workspace 66 ! 65 67 INTEGER, INTENT( in ) :: kt ! ocean time-step index 66 68 ! 67 69 INTEGER :: jk ! dummy loop index 68 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zun, zvn, zwn ! 3D workspace: effective transport 69 !!---------------------------------------------------------------------- 70 !!---------------------------------------------------------------------- 71 ! 72 IF( wrk_in_use(3, 1,2,3) ) THEN 73 CALL ctl_stop('tra_adv: requested workspace arrays unavailable') ; RETURN 74 ENDIF 70 75 ! ! set time step 71 76 IF( neuler == 0 .AND. kt == nit000 ) THEN ! at nit000 72 r2dt (:) = rdttra(:) ! = rdtra (restarting with Euler time stepping)77 r2dtra(:) = rdttra(:) ! = rdtra (restarting with Euler time stepping) 73 78 ELSEIF( kt <= nit000 + 1) THEN ! at nit000 or nit000+1 74 r2dt (:) = 2. * rdttra(:)! = 2 rdttra (leapfrog)79 r2dtra(:) = 2._wp * rdttra(:) ! = 2 rdttra (leapfrog) 75 80 ENDIF 76 81 ! … … 95 100 96 101 SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==! 97 CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! 2nd order centered98 CASE ( 2 ) ; CALL tra_adv_tvd ( kt, 'TRA', r2dt , zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! TVD99 CASE ( 3 ) ; CALL tra_adv_muscl ( kt, 'TRA', r2dt , zun, zvn, zwn, tsb, tsa, jpts ) ! MUSCL100 CASE ( 4 ) ; CALL tra_adv_muscl2( kt, 'TRA', r2dt , zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! MUSCL2101 CASE ( 5 ) ; CALL tra_adv_ubs ( kt, 'TRA', r2dt , zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! UBS102 CASE ( 6 ) ; CALL tra_adv_qck ( kt, 'TRA', r2dt , zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! QUICKEST102 CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! 2nd order centered 103 CASE ( 2 ) ; CALL tra_adv_tvd ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! TVD 104 CASE ( 3 ) ; CALL tra_adv_muscl ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsa, jpts ) ! MUSCL 105 CASE ( 4 ) ; CALL tra_adv_muscl2( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! MUSCL2 106 CASE ( 5 ) ; CALL tra_adv_ubs ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! UBS 107 CASE ( 6 ) ; CALL tra_adv_qck ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! QUICKEST 103 108 ! 104 109 CASE (-1 ) !== esopa: test all possibility with control print ==! 105 CALL tra_adv_cen2 ( kt, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts )110 CALL tra_adv_cen2 ( kt, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) 106 111 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv0 - Ta: ', mask1=tmask, & 107 112 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 108 CALL tra_adv_tvd ( kt, 'TRA', r2dt , zun, zvn, zwn, tsb, tsn, tsa, jpts )113 CALL tra_adv_tvd ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) 109 114 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv1 - Ta: ', mask1=tmask, & 110 115 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 111 CALL tra_adv_muscl ( kt, 'TRA', r2dt , zun, zvn, zwn, tsb, tsa, jpts )116 CALL tra_adv_muscl ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsa, jpts ) 112 117 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv3 - Ta: ', mask1=tmask, & 113 118 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 114 CALL tra_adv_muscl2( kt, 'TRA', r2dt , zun, zvn, zwn, tsb, tsn, tsa, jpts )119 CALL tra_adv_muscl2( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) 115 120 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv4 - Ta: ', mask1=tmask, & 116 121 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 117 CALL tra_adv_ubs ( kt, 'TRA', r2dt , zun, zvn, zwn, tsb, tsn, tsa, jpts )122 CALL tra_adv_ubs ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) 118 123 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv5 - Ta: ', mask1=tmask, & 119 124 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 120 CALL tra_adv_qck ( kt, 'TRA', r2dt , zun, zvn, zwn, tsb, tsn, tsa, jpts )125 CALL tra_adv_qck ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) 121 126 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv6 - Ta: ', mask1=tmask, & 122 127 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) … … 126 131 IF(ln_ctl) CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv - Ta: ', mask1=tmask, & 127 132 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 133 ! 134 IF( wrk_not_released(3,1,2,3) ) CALL ctl_stop('tra_adv: failed to release workspace arrays') 128 135 ! 129 136 END SUBROUTINE tra_adv … … 144 151 !!---------------------------------------------------------------------- 145 152 146 REWIND ( numnam )! Read Namelist namtra_adv : tracer advection scheme147 READ 153 REWIND( numnam ) ! Read Namelist namtra_adv : tracer advection scheme 154 READ ( numnam, namtra_adv ) 148 155 149 156 IF(lwp) THEN ! Namelist print
Note: See TracChangeset
for help on using the changeset viewer.
