Changeset 3718 for branches/2012/dev_MERGE_2012/NEMOGCM/NEMO
- Timestamp:
- 2012-11-30T16:15:07+01:00 (12 years ago)
- Location:
- branches/2012/dev_MERGE_2012/NEMOGCM/NEMO
- Files:
-
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90
r3680 r3718 44 44 LOGICAL :: ln_traadv_ubs = .FALSE. ! UBS scheme flag 45 45 LOGICAL :: ln_traadv_qck = .FALSE. ! QUICKEST scheme flag 46 LOGICAL :: ln_traadv_msc_ups= .FALSE. ! use upstream scheme within muscl 46 47 47 48 … … 105 106 CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, nit000, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! 2nd order centered 106 107 CASE ( 2 ) ; CALL tra_adv_tvd ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! TVD 107 CASE ( 3 ) ; CALL tra_adv_muscl ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsa, jpts ) ! MUSCL108 CASE ( 3 ) ; CALL tra_adv_muscl ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsa, jpts, ln_traadv_msc_ups ) ! MUSCL 108 109 CASE ( 4 ) ; CALL tra_adv_muscl2( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! MUSCL2 109 110 CASE ( 5 ) ; CALL tra_adv_ubs ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! UBS … … 117 118 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv1 - Ta: ', mask1=tmask, & 118 119 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 119 CALL tra_adv_muscl ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsa, jpts )120 CALL tra_adv_muscl ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsa, jpts, ln_traadv_msc_ups ) 120 121 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv3 - Ta: ', mask1=tmask, & 121 122 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) … … 165 166 WRITE(numout,*) '~~~~~~~~~~~' 166 167 WRITE(numout,*) ' Namelist namtra_adv : chose a advection scheme for tracers' 167 WRITE(numout,*) ' 2nd order advection scheme ln_traadv_cen2 = ', ln_traadv_cen2168 WRITE(numout,*) ' TVD advection scheme ln_traadv_tvd = ', ln_traadv_tvd169 WRITE(numout,*) ' MUSCL advection scheme ln_traadv_muscl = ', ln_traadv_muscl170 WRITE(numout,*) ' MUSCL2 advection scheme ln_traadv_muscl2 = ', ln_traadv_muscl2171 WRITE(numout,*) ' UBS advection scheme ln_traadv_ubs = ', ln_traadv_ubs172 WRITE(numout,*) ' QUICKEST advection scheme ln_traadv_qck = ', ln_traadv_qck173 WRITE(numout,*) ' upstream scheme within muscl ln_traadv_msc_ups = ', ln_traadv_msc_ups168 WRITE(numout,*) ' 2nd order advection scheme ln_traadv_cen2 = ', ln_traadv_cen2 169 WRITE(numout,*) ' TVD advection scheme ln_traadv_tvd = ', ln_traadv_tvd 170 WRITE(numout,*) ' MUSCL advection scheme ln_traadv_muscl = ', ln_traadv_muscl 171 WRITE(numout,*) ' MUSCL2 advection scheme ln_traadv_muscl2 = ', ln_traadv_muscl2 172 WRITE(numout,*) ' UBS advection scheme ln_traadv_ubs = ', ln_traadv_ubs 173 WRITE(numout,*) ' QUICKEST advection scheme ln_traadv_qck = ', ln_traadv_qck 174 WRITE(numout,*) ' upstream scheme within muscl ln_traadv_msc_ups = ', ln_traadv_msc_ups 174 175 ENDIF 175 176 -
branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90
r3680 r3718 144 144 IF(lwp) WRITE(numout,*) 145 145 ! 146 IF ( .not. ALLOCATED(upsmsk))THEN146 IF ( .NOT. ALLOCATED( upsmsk ) ) THEN 147 147 ALLOCATE( upsmsk(jpi,jpj), STAT=ierr ) 148 148 IF( ierr /= 0 ) CALL ctl_stop('STOP', 'tra_adv_cen2: unable to allocate array') -
branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90
r3680 r3718 38 38 39 39 LOGICAL :: l_trd ! flag to compute trends 40 LOGICAL, PUBLIC :: ln_traadv_msc_ups= .FALSE. ! use upstream scheme within muscl 41 42 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: upsmsk !: mixed upstream/centered scheme near some straits 40 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: upsmsk !: mixed upstream/centered scheme near some straits 43 41 ! ! and in closed seas (orca 2 and 4 configurations) 44 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: zind !: mixed upstream/centered index42 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xind !: mixed upstream/centered index 45 43 !! * Substitutions 46 44 # include "domzgr_substitute.h90" … … 54 52 55 53 SUBROUTINE tra_adv_muscl( kt, kit000, cdtype, p2dt, pun, pvn, pwn, & 56 & ptb, pta, kjpt )54 & ptb, pta, kjpt, ld_msc_ups ) 57 55 !!---------------------------------------------------------------------- 58 56 !! *** ROUTINE tra_adv_muscl *** … … 76 74 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 77 75 INTEGER , INTENT(in ) :: kjpt ! number of tracers 76 LOGICAL , INTENT(in ) :: ld_msc_ups ! use upstream scheme within muscl 78 77 REAL(wp), DIMENSION( jpk ), INTENT(in ) :: p2dt ! vertical profile of tracer time-step 79 78 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pun, pvn, pwn ! 3 ocean velocity components 80 79 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before tracer field 81 80 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 81 82 82 ! 83 83 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 97 97 IF(lwp) WRITE(numout,*) 98 98 IF(lwp) WRITE(numout,*) 'tra_adv : MUSCL advection scheme on ', cdtype 99 IF(lwp) WRITE(numout,*) ' : xed up-stream ' , ln_traadv_msc_ups99 IF(lwp) WRITE(numout,*) ' : mixed up-stream ', ld_msc_ups 100 100 IF(lwp) WRITE(numout,*) '~~~~~~~' 101 101 IF(lwp) WRITE(numout,*) 102 102 ! 103 103 ! 104 IF( ln_traadv_msc_ups) THEN105 IF (.not. ALLOCATED(upsmsk))THEN106 ALLOCATE( upsmsk(jpi,jpj), STAT=ierr )107 IF( ierr /= 0 ) CALL ctl_stop('STOP', 'tra_adv_muscl: unable to allocate upsmsk array')108 ENDIF109 upsmsk(:,:) = 0._wp ! not upstream by default104 IF( ld_msc_ups ) THEN 105 IF( .NOT. ALLOCATED( upsmsk ) ) THEN 106 ALLOCATE( upsmsk(jpi,jpj), STAT=ierr ) 107 IF( ierr /= 0 ) CALL ctl_stop('STOP', 'tra_adv_muscl: unable to allocate upsmsk array') 108 ENDIF 109 upsmsk(:,:) = 0._wp ! not upstream by default 110 110 ENDIF 111 111 112 IF (.not. ALLOCATED(zind))THEN113 ALLOCATE( zind(jpi,jpj,jpk), STAT=ierr )112 IF( .NOT. ALLOCATED( xind ) ) THEN 113 ALLOCATE( xind(jpi,jpj,jpk), STAT=ierr ) 114 114 IF( ierr /= 0 ) CALL ctl_stop('STOP', 'tra_adv_muscl: unable to allocate zind array') 115 115 ENDIF … … 119 119 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 120 120 121 !122 ! Upstream / centered scheme indicator123 ! ------------------------------------124 zind(:,:,:) = 1._wp ! set equal to 0 where up-stream isneeded125 126 IF( ln_traadv_msc_ups)THEN127 DO jk = 1, jpk128 DO jj = 1, jpj129 DO ji = 1, jpi130 zind(ji,jj,jk) = 1 - MAX ( &131 rnfmsk(ji,jj) * rnfmsk_z(jk), & ! near runoff mouths (& closed sea outflows)132 upsmsk(ji,jj) ) * tmask(ji,jj,jk) ! some of some straits133 END DO134 END DO135 END DO121 ! 122 ! Upstream / centered scheme indicator 123 ! ------------------------------------ 124 xind(:,:,:) = 1._wp ! set equal to 1 where up-stream is not needed 125 ! 126 IF( ld_msc_ups ) THEN 127 DO jk = 1, jpk 128 DO jj = 1, jpj 129 DO ji = 1, jpi 130 xind(ji,jj,jk) = 1 - MAX ( & 131 rnfmsk(ji,jj) * rnfmsk_z(jk), & ! near runoff mouths (& closed sea outflows) 132 upsmsk(ji,jj) ) * tmask(ji,jj,jk) ! some of some straits 133 END DO 134 END DO 135 END DO 136 136 ENDIF 137 !138 ENDIF ! end kit000137 ! 138 ENDIF 139 139 ! ! =========== 140 140 DO jn = 1, kjpt ! tracer loop … … 191 191 zalpha = 0.5 - z0u 192 192 zu = z0u - 0.5 * pun(ji,jj,jk) * zdt / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) ) 193 zzwx = ptb(ji+1,jj,jk,jn) + zind(ji,jj,jk) * (zu * zslpx(ji+1,jj,jk))194 zzwy = ptb(ji ,jj,jk,jn) + zind(ji,jj,jk) * (zu * zslpx(ji ,jj,jk))193 zzwx = ptb(ji+1,jj,jk,jn) + xind(ji,jj,jk) * (zu * zslpx(ji+1,jj,jk)) 194 zzwy = ptb(ji ,jj,jk,jn) + xind(ji,jj,jk) * (zu * zslpx(ji ,jj,jk)) 195 195 zwx(ji,jj,jk) = pun(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 196 196 ! … … 198 198 zalpha = 0.5 - z0v 199 199 zv = z0v - 0.5 * pvn(ji,jj,jk) * zdt / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) ) 200 zzwx = ptb(ji,jj+1,jk,jn) + zind(ji,jj,jk) * (zv * zslpy(ji,jj+1,jk))201 zzwy = ptb(ji,jj ,jk,jn) + zind(ji,jj,jk) * (zv * zslpy(ji,jj ,jk))200 zzwx = ptb(ji,jj+1,jk,jn) + xind(ji,jj,jk) * (zv * zslpy(ji,jj+1,jk)) 201 zzwy = ptb(ji,jj ,jk,jn) + xind(ji,jj,jk) * (zv * zslpy(ji,jj ,jk)) 202 202 zwy(ji,jj,jk) = pvn(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 203 203 END DO … … 273 273 zalpha = 0.5 + z0w 274 274 zw = z0w - 0.5 * pwn(ji,jj,jk+1) * zdt * zbtr 275 zzwx = ptb(ji,jj,jk+1,jn) + zind(ji,jj,jk) * (zw * zslpx(ji,jj,jk+1))276 zzwy = ptb(ji,jj,jk ,jn) + zind(ji,jj,jk) * (zw * zslpx(ji,jj,jk ))275 zzwx = ptb(ji,jj,jk+1,jn) + xind(ji,jj,jk) * (zw * zslpx(ji,jj,jk+1)) 276 zzwy = ptb(ji,jj,jk ,jn) + xind(ji,jj,jk) * (zw * zslpx(ji,jj,jk )) 277 277 zwx(ji,jj,jk+1) = pwn(ji,jj,jk+1) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 278 278 END DO -
branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90
r3680 r3718 108 108 CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, nittrc000, 'TRC', zun, zvn, zwn, trb, trn, tra, jptra ) ! 2nd order centered 109 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 ) ! MUSCL110 CASE ( 3 ) ; CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, tra, jptra, ln_trcadv_msc_ups ) ! MUSCL 111 111 CASE ( 4 ) ; CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) ! MUSCL2 112 112 CASE ( 5 ) ; CALL tra_adv_ubs ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) ! UBS … … 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, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, tra, jptra )122 CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, tra, jptra, ln_trcadv_msc_ups ) 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') -
branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/TOP_SRC/TRP/trcnam_trp.F90
r3680 r3718 28 28 LOGICAL , PUBLIC :: ln_trcadv_ubs = .FALSE. ! UBS scheme flag 29 29 LOGICAL , PUBLIC :: ln_trcadv_qck = .FALSE. ! QUICKEST scheme flag 30 LOGICAL , PUBLIC :: ln_trcadv_msc_ups= .FALSE. ! use upstream scheme within muscl 31 30 32 31 33 ! !!: ** lateral mixing namelist (nam_trcldf) ** … … 73 75 NAMELIST/namtrc_adv/ ln_trcadv_cen2 , ln_trcadv_tvd , & 74 76 & ln_trcadv_muscl, ln_trcadv_muscl2, & 75 & ln_trcadv_ubs , ln_trcadv_qck 77 & ln_trcadv_ubs , ln_trcadv_qck, ln_trcadv_msc_ups 76 78 77 79 NAMELIST/namtrc_ldf/ ln_trcldf_diff , ln_trcldf_lap , &
Note: See TracChangeset
for help on using the changeset viewer.