Changeset 2528 for trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90
- Timestamp:
- 2010-12-27T18:33:53+01:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90
- Property svn:eol-style deleted
r1601 r2528 4 4 !! Ocean active tracers: advection trend 5 5 !!============================================================================== 6 !! History : 2.0 ! 05-11 (G. Madec) Original code 6 !! History : 2.0 ! 2005-11 (G. Madec) Original code 7 !! 3.3 ! 2010-09 (C. Ethe, G. Madec) merge TRC-TRA + switch from velocity to transport 7 8 !!---------------------------------------------------------------------- 8 9 … … 18 19 USE traadv_muscl2 ! MUSCL2 scheme (tra_adv_muscl2 routine) 19 20 USE traadv_ubs ! UBS scheme (tra_adv_ubs routine) 20 USE traadv_qck !! QUICKEST scheme (tra_adv_qck routine)21 USE traadv_qck ! QUICKEST scheme (tra_adv_qck routine) 21 22 USE traadv_eiv ! eddy induced velocity (tra_adv_eiv routine) 22 USE trabbl ! tracers: bottom boundary layer23 USE cla ! cross land advection (cla_traadv routine) 23 24 USE ldftra_oce ! lateral diffusion coefficient on tracers 24 25 USE in_out_manager ! I/O manager … … 29 30 PRIVATE 30 31 31 PUBLIC tra_adv ! routine called by step module 32 PUBLIC tra_adv ! routine called by step module 33 PUBLIC tra_adv_init ! routine called by opa module 32 34 33 ! 34 LOGICAL , PUBLIC :: ln_traadv_cen2 = .TRUE.! 2nd order centered scheme flag35 LOGICAL , PUBLIC :: ln_traadv_tvd = .FALSE.! TVD scheme flag36 LOGICAL , PUBLIC :: ln_traadv_muscl = .FALSE.! MUSCL scheme flag37 LOGICAL , PUBLIC :: ln_traadv_muscl2 = .FALSE.! MUSCL2 scheme flag38 LOGICAL , PUBLIC :: ln_traadv_ubs = .FALSE.! UBS scheme flag39 LOGICAL , PUBLIC :: ln_traadv_qck = .FALSE.! QUICKEST scheme flag35 ! !!* Namelist namtra_adv * 36 LOGICAL :: ln_traadv_cen2 = .TRUE. ! 2nd order centered scheme flag 37 LOGICAL :: ln_traadv_tvd = .FALSE. ! TVD scheme flag 38 LOGICAL :: ln_traadv_muscl = .FALSE. ! MUSCL scheme flag 39 LOGICAL :: ln_traadv_muscl2 = .FALSE. ! MUSCL2 scheme flag 40 LOGICAL :: ln_traadv_ubs = .FALSE. ! UBS scheme flag 41 LOGICAL :: ln_traadv_qck = .FALSE. ! QUICKEST scheme flag 40 42 41 43 INTEGER :: nadv ! choice of the type of advection scheme 44 45 REAL(wp), DIMENSION(jpk) :: r2dt ! vertical profile time-step, = 2 rdttra except at nit000 (=rdttra) if neuler=0 42 46 43 47 !! * Substitutions … … 45 49 # include "vectopt_loop_substitute.h90" 46 50 !!---------------------------------------------------------------------- 47 !! NEMO/OPA 3. 2 , LOCEAN-IPSL (2009)48 !! $Id$ 49 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)51 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 52 !! $Id$ 53 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 50 54 !!---------------------------------------------------------------------- 51 52 55 CONTAINS 53 56 … … 60 63 !! ** Method : - Update (ua,va) with the advection term following nadv 61 64 !!---------------------------------------------------------------------- 62 #if ( defined key_trabbl_adv || defined key_traldf_eiv )63 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zun, zvn, zwn ! effective velocity64 #else65 USE oce, ONLY : zun => un ! the effective velocity is the66 USE oce, ONLY : zvn => vn ! Eulerian velocity67 USE oce, ONLY : zwn => wn !68 #endif69 !!70 65 INTEGER, INTENT( in ) :: kt ! ocean time-step index 66 ! 67 INTEGER :: jk ! dummy loop index 68 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zun, zvn, zwn ! 3D workspace: effective transport 71 69 !!---------------------------------------------------------------------- 70 ! ! set time step 71 IF( neuler == 0 .AND. kt == nit000 ) THEN ! at nit000 72 r2dt(:) = rdttra(:) ! = rdtra (restarting with Euler time stepping) 73 ELSEIF( kt <= nit000 + 1) THEN ! at nit000 or nit000+1 74 r2dt(:) = 2. * rdttra(:) ! = 2 rdttra (leapfrog) 75 ENDIF 76 ! 77 IF( nn_cla == 1 ) CALL cla_traadv( kt ) !== Cross Land Advection ==! (hor. advection) 78 ! 79 ! !== effective transport ==! 80 DO jk = 1, jpkm1 81 zun(:,:,jk) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk) ! eulerian transport only 82 zvn(:,:,jk) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk) 83 zwn(:,:,jk) = e1t(:,:) * e2t(:,:) * wn(:,:,jk) 84 END DO 85 zwn(:,:,jpk) = 0.e0 ! no transport trough the bottom 86 ! 87 IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif ) & 88 & CALL tra_adv_eiv( kt, zun, zvn, zwn, 'TRA' ) ! add the eiv transport (if necessary) 89 ! 90 CALL iom_put( "uoce_eff", zun ) ! output effective transport 91 CALL iom_put( "voce_eff", zvn ) 92 CALL iom_put( "woce_eff", zwn ) 72 93 73 IF( kt == nit000 ) CALL tra_adv_ctl ! initialisation & control of options 74 75 #if defined key_trabbl_adv 76 zun(:,:,:) = un(:,:,:) - u_bbl(:,:,:) ! add the bbl velocity 77 zvn(:,:,:) = vn(:,:,:) - v_bbl(:,:,:) 78 zwn(:,:,:) = wn(:,:,:) + w_bbl(:,:,:) 79 #endif 80 IF( lk_traldf_eiv ) THEN ! commpute and add the eiv velocity 81 IF( .NOT. lk_trabbl_adv ) THEN 82 zun(:,:,:) = un(:,:,:) 83 zvn(:,:,:) = vn(:,:,:) 84 zwn(:,:,:) = wn(:,:,:) 85 ENDIF 86 CALL tra_adv_eiv( kt, zun, zvn, zwn ) 87 ENDIF 88 89 SELECT CASE ( nadv ) ! compute advection trend and add it to general trend 90 CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, zun, zvn, zwn ) ! 2nd order centered scheme 91 CASE ( 2 ) ; CALL tra_adv_tvd ( kt, zun, zvn, zwn ) ! TVD scheme 92 CASE ( 3 ) ; CALL tra_adv_muscl ( kt, zun, zvn, zwn ) ! MUSCL scheme 93 CASE ( 4 ) ; CALL tra_adv_muscl2 ( kt, zun, zvn, zwn ) ! MUSCL2 scheme 94 CASE ( 5 ) ; CALL tra_adv_ubs ( kt, zun, zvn, zwn ) ! UBS scheme 95 CASE ( 6 ) ; CALL tra_adv_qck ( kt, zun, zvn, zwn ) ! QUICKEST scheme 94 SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==! 95 CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! 2nd order centered 96 CASE ( 2 ) ; CALL tra_adv_tvd ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! TVD 97 CASE ( 3 ) ; CALL tra_adv_muscl ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsa, jpts ) ! MUSCL 98 CASE ( 4 ) ; CALL tra_adv_muscl2( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! MUSCL2 99 CASE ( 5 ) ; CALL tra_adv_ubs ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! UBS 100 CASE ( 6 ) ; CALL tra_adv_qck ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! QUICKEST 96 101 ! 97 CASE (-1 ) ! esopa: test all possibility with control print98 CALL tra_adv_cen2 ( kt, zun, zvn, zwn )99 CALL prt_ctl( tab3d_1=ta, clinfo1=' adv0 - Ta: ', mask1=tmask, &100 & tab3d_2=sa, clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )101 CALL tra_adv_tvd ( kt, zun, zvn, zwn )102 CALL prt_ctl( tab3d_1=ta, clinfo1=' adv2- Ta: ', mask1=tmask, &103 & tab3d_2=sa, clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )104 CALL tra_adv_muscl ( kt, zun, zvn, zwn )105 CALL prt_ctl( tab3d_1=ta, clinfo1=' adv3 - Ta: ', mask1=tmask, &106 & tab3d_2=sa, clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )107 CALL tra_adv_muscl2 ( kt, zun, zvn, zwn )108 CALL prt_ctl( tab3d_1=ta, clinfo1=' adv4 - Ta: ', mask1=tmask, &109 & tab3d_2=sa, clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )110 CALL tra_adv_ubs ( kt, zun, zvn, zwn )111 CALL prt_ctl( tab3d_1=ta, clinfo1=' adv5 - Ta: ', mask1=tmask, &112 & tab3d_2=sa, clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )113 CALL tra_adv_qck ( kt, zun, zvn, zwn )114 CALL prt_ctl( tab3d_1=ta, clinfo1=' adv6 - Ta: ', mask1=tmask, &115 & tab3d_2=sa, clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )102 CASE (-1 ) !== esopa: test all possibility with control print ==! 103 CALL tra_adv_cen2 ( kt, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) 104 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv0 - Ta: ', mask1=tmask, & 105 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 106 CALL tra_adv_tvd ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts ) 107 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv1 - Ta: ', mask1=tmask, & 108 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 109 CALL tra_adv_muscl ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsa, jpts ) 110 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv3 - Ta: ', mask1=tmask, & 111 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 112 CALL tra_adv_muscl2( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts ) 113 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv4 - Ta: ', mask1=tmask, & 114 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 115 CALL tra_adv_ubs ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts ) 116 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv5 - Ta: ', mask1=tmask, & 117 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 118 CALL tra_adv_qck ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts ) 119 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv6 - Ta: ', mask1=tmask, & 120 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 116 121 END SELECT 117 118 CALL iom_put( "uoce_eff", zun ) ! effective i-current 119 CALL iom_put( "voce_eff", zvn ) ! effective j-current 120 CALL iom_put( "woce_eff", zwn ) ! effective vert. current 121 122 ! 122 123 ! ! print mean trends (used for debugging) 123 IF(ln_ctl) CALL prt_ctl( tab3d_1=t a, clinfo1=' adv - Ta: ', mask1=tmask, &124 & tab3d_2= sa, clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )124 IF(ln_ctl) CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv - Ta: ', mask1=tmask, & 125 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 125 126 ! 126 127 END SUBROUTINE tra_adv 127 128 128 129 129 SUBROUTINE tra_adv_ ctl130 SUBROUTINE tra_adv_init 130 131 !!--------------------------------------------------------------------- 131 !! *** ROUTINE tra_adv_ ctl***132 !! *** ROUTINE tra_adv_init *** 132 133 !! 133 134 !! ** Purpose : Control the consistency between namelist options for … … 135 136 !!---------------------------------------------------------------------- 136 137 INTEGER :: ioptio 137 138 NAMELIST/namtra_adv/ ln_traadv_cen2 , ln_traadv_tvd, &139 & ln_traadv_muscl, ln_traadv_muscl2, &138 !! 139 NAMELIST/namtra_adv/ ln_traadv_cen2 , ln_traadv_tvd, & 140 & ln_traadv_muscl, ln_traadv_muscl2, & 140 141 & ln_traadv_ubs , ln_traadv_qck 141 142 !!---------------------------------------------------------------------- … … 146 147 IF(lwp) THEN ! Namelist print 147 148 WRITE(numout,*) 148 WRITE(numout,*) 'tra_adv_ ctl: choice/control of the tracer advection scheme'149 WRITE(numout,*) 'tra_adv_init : choice/control of the tracer advection scheme' 149 150 WRITE(numout,*) '~~~~~~~~~~~' 150 151 WRITE(numout,*) ' Namelist namtra_adv : chose a advection scheme for tracers' … … 155 156 WRITE(numout,*) ' UBS advection scheme ln_traadv_ubs = ', ln_traadv_ubs 156 157 WRITE(numout,*) ' QUICKEST advection scheme ln_traadv_qck = ', ln_traadv_qck 157 ENDIF158 ENDIF 158 159 159 160 ioptio = 0 ! Parameter control … … 167 168 168 169 IF( ioptio /= 1 ) CALL ctl_stop( 'Choose ONE advection scheme in namelist namtra_adv' ) 169 170 IF( n_cla == 1 .AND. .NOT. ln_traadv_cen2 ) &171 & CALL ctl_stop( 'cross-land advection only with 2nd order advection scheme' )172 170 173 171 ! ! Set nadv … … 191 189 ENDIF 192 190 ! 193 END SUBROUTINE tra_adv_ ctl191 END SUBROUTINE tra_adv_init 194 192 195 193 !!======================================================================
Note: See TracChangeset
for help on using the changeset viewer.
