- Timestamp:
- 2020-09-14T17:40:34+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/TRA/traldf_lap_blp.F90 (modified) (10 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEADext/AGRIF5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 9 # SETTE 10 ^/utils/CI/sette@13382 sette
-
- Property svn:externals
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/TRA/traldf_lap_blp.F90
r10425 r13463 37 37 38 38 !! * Substitutions 39 # include "vectopt_loop_substitute.h90" 39 # include "do_loop_substitute.h90" 40 # include "domzgr_substitute.h90" 40 41 !!---------------------------------------------------------------------- 41 42 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 45 46 CONTAINS 46 47 47 SUBROUTINE tra_ldf_lap( kt, kit000, cdtype, pahu, pahv, pgu , pgv ,&48 & 49 & ptb , pta, kjpt, kpass )48 SUBROUTINE tra_ldf_lap( kt, Kmm, kit000, cdtype, pahu, pahv , & 49 & pgu , pgv , pgui, pgvi, & 50 & pt , pt_rhs, kjpt, kpass ) 50 51 !!---------------------------------------------------------------------- 51 52 !! *** ROUTINE tra_ldf_lap *** … … 59 60 !! difft = 1/(e1e2t*e3t) { di-1[ pahu e2u*e3u/e1u di(tb) ] 60 61 !! + dj-1[ pahv e1v*e3v/e2v dj(tb) ] } 61 !! Add this trend to the general tracer trend pt a:62 !! pt a = pta+ difft63 !! 64 !! ** Action : - Update pt aarrays with the before iso-level62 !! Add this trend to the general tracer trend pt_rhs : 63 !! pt_rhs = pt_rhs + difft 64 !! 65 !! ** Action : - Update pt_rhs arrays with the before iso-level 65 66 !! harmonic mixing trend. 66 67 !!---------------------------------------------------------------------- … … 70 71 INTEGER , INTENT(in ) :: kjpt ! number of tracers 71 72 INTEGER , INTENT(in ) :: kpass ! =1/2 first or second passage 73 INTEGER , INTENT(in ) :: Kmm ! ocean time level index 72 74 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: pahu, pahv ! eddy diffusivity at u- and v-points [m2/s] 73 75 REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgu, pgv ! tracer gradient at pstep levels 74 76 REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT(in ) :: pgui, pgvi ! tracer gradient at top levels 75 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pt b ! before and nowtracer fields76 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pt a! tracer trend77 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pt ! before tracer fields 78 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pt_rhs ! tracer trend 77 79 ! 78 80 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 89 91 l_hst = .FALSE. 90 92 l_ptr = .FALSE. 91 IF( cdtype == 'TRA' .AND. ln_diaptr ) l_ptr = .TRUE.93 IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) ) ) l_ptr = .TRUE. 92 94 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 93 95 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. … … 97 99 ELSE ; zsign = -1._wp 98 100 ENDIF 99 DO jk = 1, jpkm1 100 DO jj = 1, jpjm1 101 DO ji = 1, fs_jpim1 ! vector opt. 102 zaheeu(ji,jj,jk) = zsign * pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk) !!gm * umask(ji,jj,jk) pah masked! 103 zaheev(ji,jj,jk) = zsign * pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk) !!gm * vmask(ji,jj,jk) 104 END DO 105 END DO 106 END DO 101 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 102 zaheeu(ji,jj,jk) = zsign * pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm) !!gm * umask(ji,jj,jk) pah masked! 103 zaheev(ji,jj,jk) = zsign * pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm) !!gm * vmask(ji,jj,jk) 104 END_3D 107 105 ! 108 106 ! ! =========== ! … … 110 108 ! ! =========== ! 111 109 ! 112 DO jk = 1, jpkm1 !== First derivative (gradient) ==! 113 DO jj = 1, jpjm1 114 DO ji = 1, fs_jpim1 115 ztu(ji,jj,jk) = zaheeu(ji,jj,jk) * ( ptb(ji+1,jj ,jk,jn) - ptb(ji,jj,jk,jn) ) 116 ztv(ji,jj,jk) = zaheev(ji,jj,jk) * ( ptb(ji ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) 117 END DO 118 END DO 119 END DO 110 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 111 ztu(ji,jj,jk) = zaheeu(ji,jj,jk) * ( pt(ji+1,jj ,jk,jn) - pt(ji,jj,jk,jn) ) 112 ztv(ji,jj,jk) = zaheev(ji,jj,jk) * ( pt(ji ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) 113 END_3D 120 114 IF( ln_zps ) THEN ! set gradient at bottom/top ocean level 121 DO jj = 1, jpjm1 ! bottom 122 DO ji = 1, fs_jpim1 123 ztu(ji,jj,mbku(ji,jj)) = zaheeu(ji,jj,mbku(ji,jj)) * pgu(ji,jj,jn) 124 ztv(ji,jj,mbkv(ji,jj)) = zaheev(ji,jj,mbkv(ji,jj)) * pgv(ji,jj,jn) 125 END DO 126 END DO 115 DO_2D( 1, 0, 1, 0 ) 116 ztu(ji,jj,mbku(ji,jj)) = zaheeu(ji,jj,mbku(ji,jj)) * pgu(ji,jj,jn) 117 ztv(ji,jj,mbkv(ji,jj)) = zaheev(ji,jj,mbkv(ji,jj)) * pgv(ji,jj,jn) 118 END_2D 127 119 IF( ln_isfcav ) THEN ! top in ocean cavities only 128 DO jj = 1, jpjm1 129 DO ji = 1, fs_jpim1 ! vector opt. 130 IF( miku(ji,jj) > 1 ) ztu(ji,jj,miku(ji,jj)) = zaheeu(ji,jj,miku(ji,jj)) * pgui(ji,jj,jn) 131 IF( mikv(ji,jj) > 1 ) ztv(ji,jj,mikv(ji,jj)) = zaheev(ji,jj,mikv(ji,jj)) * pgvi(ji,jj,jn) 132 END DO 133 END DO 120 DO_2D( 1, 0, 1, 0 ) 121 IF( miku(ji,jj) > 1 ) ztu(ji,jj,miku(ji,jj)) = zaheeu(ji,jj,miku(ji,jj)) * pgui(ji,jj,jn) 122 IF( mikv(ji,jj) > 1 ) ztv(ji,jj,mikv(ji,jj)) = zaheev(ji,jj,mikv(ji,jj)) * pgvi(ji,jj,jn) 123 END_2D 134 124 ENDIF 135 125 ENDIF 136 126 ! 137 DO jk = 1, jpkm1 !== Second derivative (divergence) added to the general tracer trends ==! 138 DO jj = 2, jpjm1 139 DO ji = fs_2, fs_jpim1 140 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) & 141 & + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) & 142 & / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 143 END DO 144 END DO 145 END DO 127 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 128 pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) & 129 & + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) & 130 & / ( e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) ) 131 END_3D 146 132 ! 147 133 ! !== "Poleward" diffusive heat or salt transports ==! … … 159 145 160 146 161 SUBROUTINE tra_ldf_blp( kt, kit000, cdtype, pahu, pahv, pgu , pgv ,&162 & pgui, pgvi,&163 & ptb , pta, kjpt, kldf )147 SUBROUTINE tra_ldf_blp( kt, Kmm, kit000, cdtype, pahu, pahv , & 148 & pgu , pgv , pgui, pgvi, & 149 & pt , pt_rhs, kjpt, kldf ) 164 150 !!---------------------------------------------------------------------- 165 151 !! *** ROUTINE tra_ldf_blp *** … … 179 165 INTEGER , INTENT(in ) :: kjpt ! number of tracers 180 166 INTEGER , INTENT(in ) :: kldf ! type of operator used 167 INTEGER , INTENT(in ) :: Kmm ! ocean time level indices 181 168 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: pahu, pahv ! eddy diffusivity at u- and v-points [m2/s] 182 169 REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgu, pgv ! tracer gradient at pstep levels 183 170 REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT(in ) :: pgui, pgvi ! tracer gradient at top levels 184 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pt b! before and now tracer fields185 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pt a! tracer trend171 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pt ! before and now tracer fields 172 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pt_rhs ! tracer trend 186 173 ! 187 174 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 203 190 zlap(:,:,:,:) = 0._wp 204 191 ! 205 SELECT CASE ( kldf ) !== 1st laplacian applied to pt b(output in zlap) ==!192 SELECT CASE ( kldf ) !== 1st laplacian applied to pt (output in zlap) ==! 206 193 ! 207 194 CASE ( np_blp ) ! iso-level bilaplacian 208 CALL tra_ldf_lap ( kt, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, ptb,zlap, kjpt, 1 )195 CALL tra_ldf_lap ( kt, Kmm, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, pt, zlap, kjpt, 1 ) 209 196 CASE ( np_blp_i ) ! rotated bilaplacian : standard operator (Madec) 210 CALL tra_ldf_iso ( kt, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, ptb, ptb, zlap, kjpt, 1 )197 CALL tra_ldf_iso ( kt, Kmm, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, pt, pt, zlap, kjpt, 1 ) 211 198 CASE ( np_blp_it ) ! rotated bilaplacian : triad operator (griffies) 212 CALL tra_ldf_triad( kt, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, ptb, ptb, zlap, kjpt, 1 )199 CALL tra_ldf_triad( kt, Kmm, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, pt, pt, zlap, kjpt, 1 ) 213 200 END SELECT 214 201 ! 215 CALL lbc_lnk( 'traldf_lap_blp', zlap(:,:,:,:) , 'T', 1. ) ! Lateral boundary conditions (unchanged sign)202 CALL lbc_lnk( 'traldf_lap_blp', zlap(:,:,:,:) , 'T', 1.0_wp ) ! Lateral boundary conditions (unchanged sign) 216 203 ! ! Partial top/bottom cell: GRADh( zlap ) 217 IF( ln_isfcav .AND. ln_zps ) THEN ; CALL zps_hde_isf( kt, kjpt, zlap, zglu, zglv, zgui, zgvi ) ! both top & bottom218 ELSEIF( ln_zps ) THEN ; CALL zps_hde ( kt, kjpt, zlap, zglu, zglv ) ! only bottom219 ENDIF 220 ! 221 SELECT CASE ( kldf ) !== 2nd laplacian applied to zlap (output in pt a) ==!204 IF( ln_isfcav .AND. ln_zps ) THEN ; CALL zps_hde_isf( kt, Kmm, kjpt, zlap, zglu, zglv, zgui, zgvi ) ! both top & bottom 205 ELSEIF( ln_zps ) THEN ; CALL zps_hde ( kt, Kmm, kjpt, zlap, zglu, zglv ) ! only bottom 206 ENDIF 207 ! 208 SELECT CASE ( kldf ) !== 2nd laplacian applied to zlap (output in pt_rhs) ==! 222 209 ! 223 210 CASE ( np_blp ) ! iso-level bilaplacian 224 CALL tra_ldf_lap ( kt, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, pta,kjpt, 2 )211 CALL tra_ldf_lap ( kt, Kmm, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, pt_rhs, kjpt, 2 ) 225 212 CASE ( np_blp_i ) ! rotated bilaplacian : standard operator (Madec) 226 CALL tra_ldf_iso ( kt, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, ptb, pta, kjpt, 2 )213 CALL tra_ldf_iso ( kt, Kmm, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, pt , pt_rhs, kjpt, 2 ) 227 214 CASE ( np_blp_it ) ! rotated bilaplacian : triad operator (griffies) 228 CALL tra_ldf_triad( kt, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, ptb, pta, kjpt, 2 )215 CALL tra_ldf_triad( kt, Kmm, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, pt , pt_rhs, kjpt, 2 ) 229 216 END SELECT 230 217 !
Note: See TracChangeset
for help on using the changeset viewer.
