- Timestamp:
- 2019-12-11T17:15:54+01:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DIA/diaptr.F90
r11960 r12193 10 10 !! 3.6 ! 2014-12 (C. Ethe) use of IOM 11 11 !! 3.6 ! 2016-06 (T. Graham) Addition of diagnostics for CMIP6 12 !! 4.0 ! 2010-08 ( C. Ethe, J. Deshayes ) Improvment 12 13 !!---------------------------------------------------------------------- 13 14 … … 42 43 43 44 ! !!** namelist namptr ** 44 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) :: htr_adv, htr_ldf, htr_eiv !: Heat TRansports (adv, diff, Bolus.) 45 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) :: str_adv, str_ldf, str_eiv !: Salt TRansports (adv, diff, Bolus.) 46 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) :: htr_ove, str_ove !: heat Salt TRansports ( overturn.) 47 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) :: htr_btr, str_btr !: heat Salt TRansports ( barotropic ) 48 49 LOGICAL, PUBLIC :: ln_diaptr ! Poleward transport flag (T) or not (F) 50 LOGICAL, PUBLIC :: ln_subbas ! Atlantic/Pacific/Indian basins calculation 51 INTEGER, PUBLIC :: nptr ! = 1 (l_subbas=F) or = 5 (glo, atl, pac, ind, ipc) (l_subbas=T) 45 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hstr_adv, hstr_ldf, hstr_eiv !: Heat/Salt TRansports(adv, diff, Bolus.) 46 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hstr_ove, hstr_btr, hstr_vtr !: heat Salt TRansports(overturn, baro, merional) 47 48 LOGICAL , PUBLIC :: l_diaptr !: tracers trend flag (set from namelist in trdini) 49 INTEGER, PARAMETER, PUBLIC :: nptr = 5 ! (glo, atl, pac, ind, ipc) 52 50 53 51 REAL(wp) :: rc_sv = 1.e-6_wp ! conversion from m3/s to Sverdrup 54 52 REAL(wp) :: rc_pwatt = 1.e-15_wp ! conversion from W to PW (further x rau0 x Cp) 55 REAL(wp) :: rc_ggram = 1.e- 6_wp ! conversion from g to Pg56 57 CHARACTER(len=3), ALLOCATABLE, SAVE, DIMENSION(:) :: clsubb58 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: btmsk ! T-point basin interior masks59 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: btm30 ! mask out Southern Ocean (=0 south of 30°S) 60 61 REAL(wp), TARGET, ALLOCATABLE, SAVE, DIMENSION(: ) :: p_fval1d62 REAL(wp), TARGET, ALLOCATABLE, SAVE, DIMENSION(:,:) :: p_fval2d 63 53 REAL(wp) :: rc_ggram = 1.e-9_wp ! conversion from g to Gg (further x rau0) 54 55 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: btmsk ! T-point basin interior masks 56 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: btmsk34 ! mask out Southern Ocean (=0 south of 34°S) 57 58 REAL(wp), TARGET, ALLOCATABLE, SAVE, DIMENSION(:) :: p_fval1d 59 REAL(wp), TARGET, ALLOCATABLE, SAVE, DIMENSION(:,:) :: p_fval2d 60 61 LOGICAL :: ll_init = .TRUE. !: tracers trend flag (set from namelist in trdini) 64 62 !! * Substitutions 65 63 # include "vectopt_loop_substitute.h90" … … 71 69 CONTAINS 72 70 73 SUBROUTINE dia_ptr( Kmm, pvtr )71 SUBROUTINE dia_ptr( kt, Kmm, pvtr ) 74 72 !!---------------------------------------------------------------------- 75 73 !! *** ROUTINE dia_ptr *** 76 74 !!---------------------------------------------------------------------- 75 INTEGER , INTENT(in) :: kt ! ocean time-step index 77 76 INTEGER , INTENT(in) :: Kmm ! time level index 78 77 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: pvtr ! j-effective transport … … 81 80 REAL(wp) :: zsfc,zvfc ! local scalar 82 81 REAL(wp), DIMENSION(jpi,jpj) :: z2d ! 2D workspace 83 REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3d ! 3D workspace84 82 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask ! 3D workspace 83 REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3d ! 3D workspace 85 84 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: zts ! 3D workspace 86 REAL(wp), DIMENSION(jpj) :: vsum ! 1D workspace 87 REAL(wp), DIMENSION(jpj,jpts) :: tssum ! 1D workspace 88 85 REAL(wp), DIMENSION(jpj) :: zvsum, ztsum, zssum ! 1D workspace 89 86 ! 90 87 !overturning calculation 91 REAL(wp), DIMENSION(jpj,jpk,nptr) :: sjk , r1_sjk ! i-mean i-k-surface and its inverse 92 REAL(wp), DIMENSION(jpj,jpk,nptr) :: v_msf, sn_jk , tn_jk ! i-mean T and S, j-Stream-Function 93 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvv ! 3D workspace 94 95 96 CHARACTER( len = 12 ) :: cl1 88 REAL(wp), DIMENSION(jpj,jpk,nptr) :: sjk, r1_sjk, v_msf ! i-mean i-k-surface and its inverse 89 REAL(wp), DIMENSION(jpj,jpk,nptr) :: zt_jk, zs_jk ! i-mean T and S, j-Stream-Function 90 91 REAL(wp), DIMENSION(jpi,jpj,jpk,nptr) :: z4d1, z4d2 92 REAL(wp), DIMENSION(jpi,jpj,nptr) :: z3dtr ! i-mean T and S, j-Stream-Function 97 93 !!---------------------------------------------------------------------- 98 94 ! 99 95 IF( ln_timing ) CALL timing_start('dia_ptr') 100 96 101 ! 97 IF( kt == nit000 .AND. ll_init ) CALL dia_ptr_init 98 ! 99 IF( .NOT. l_diaptr ) RETURN 100 102 101 IF( PRESENT( pvtr ) ) THEN 103 IF( iom_use("zomsfglo") ) THEN ! effective MSF 104 z3d(1,:,:) = ptr_sjk( pvtr(:,:,:) ) ! zonal cumulative effective transport 105 DO jk = 2, jpkm1 106 z3d(1,:,jk) = z3d(1,:,jk-1) + z3d(1,:,jk) ! effective j-Stream-Function (MSF) 102 IF( iom_use( 'zomsf' ) ) THEN ! effective MSF 103 DO jn = 1, nptr ! by sub-basins 104 z4d1(1,:,:,jn) = ptr_sjk( pvtr(:,:,:), btmsk34(:,:,jn) ) ! zonal cumulative effective transport excluding closed seas 105 DO jk = jpkm1, 1, -1 106 z4d1(1,:,jk,jn) = z4d1(1,:,jk+1,jn) - z4d1(1,:,jk,jn) ! effective j-Stream-Function (MSF) 107 END DO 108 DO ji = 1, jpi 109 z4d1(ji,:,:,jn) = z4d1(1,:,:,jn) 110 ENDDO 107 111 END DO 108 DO ji = 1, jpi 109 z3d(ji,:,:) = z3d(1,:,:) 110 ENDDO 111 cl1 = TRIM('zomsf'//clsubb(1) ) 112 CALL iom_put( cl1, z3d * rc_sv ) 113 DO jn = 2, nptr ! by sub-basins 114 z3d(1,:,:) = ptr_sjk( pvtr(:,:,:), btmsk(:,:,jn)*btm30(:,:) ) 115 DO jk = 2, jpkm1 116 z3d(1,:,jk) = z3d(1,:,jk-1) + z3d(1,:,jk) ! effective j-Stream-Function (MSF) 117 END DO 118 DO ji = 1, jpi 119 z3d(ji,:,:) = z3d(1,:,:) 120 ENDDO 121 cl1 = TRIM('zomsf'//clsubb(jn) ) 122 CALL iom_put( cl1, z3d * rc_sv ) 123 END DO 124 ENDIF 125 IF( iom_use("sopstove") .OR. iom_use("sophtove") .OR. iom_use("sopstbtr") .OR. iom_use("sophtbtr") ) THEN 112 CALL iom_put( 'zomsf', z4d1 * rc_sv ) 113 ENDIF 114 IF( iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) .OR. & 115 & iom_use( 'sopstbtr' ) .OR. iom_use( 'sophtbtr' ) ) THEN 126 116 ! define fields multiplied by scalar 127 117 zmask(:,:,:) = 0._wp 128 118 zts(:,:,:,:) = 0._wp 129 zvv(:,:,:) = 0._wp130 119 DO jk = 1, jpkm1 131 120 DO jj = 1, jpjm1 … … 135 124 zts(ji,jj,jk,jp_tem) = (ts(ji,jj,jk,jp_tem,Kmm)+ts(ji,jj+1,jk,jp_tem,Kmm)) * 0.5 * zvfc !Tracers averaged onto V grid 136 125 zts(ji,jj,jk,jp_sal) = (ts(ji,jj,jk,jp_sal,Kmm)+ts(ji,jj+1,jk,jp_sal,Kmm)) * 0.5 * zvfc 137 zvv(ji,jj,jk) = vv(ji,jj,jk,Kmm) * zvfc138 126 ENDDO 139 127 ENDDO 140 128 ENDDO 141 129 ENDIF 142 IF( iom_use("sopstove") .OR. iom_use("sophtove") ) THEN 143 sjk(:,:,1) = ptr_sjk( zmask(:,:,:), btmsk(:,:,1) ) 144 r1_sjk(:,:,1) = 0._wp 145 WHERE( sjk(:,:,1) /= 0._wp ) r1_sjk(:,:,1) = 1._wp / sjk(:,:,1) 146 147 ! i-mean T and S, j-Stream-Function, global 148 tn_jk(:,:,1) = ptr_sjk( zts(:,:,:,jp_tem) ) * r1_sjk(:,:,1) 149 sn_jk(:,:,1) = ptr_sjk( zts(:,:,:,jp_sal) ) * r1_sjk(:,:,1) 150 v_msf(:,:,1) = ptr_sjk( zvv(:,:,:) ) 151 152 htr_ove(:,1) = SUM( v_msf(:,:,1)*tn_jk(:,:,1) ,2 ) 153 str_ove(:,1) = SUM( v_msf(:,:,1)*sn_jk(:,:,1) ,2 ) 154 155 z2d(1,:) = htr_ove(:,1) * rc_pwatt ! (conversion in PW) 156 DO ji = 1, jpi 157 z2d(ji,:) = z2d(1,:) 158 ENDDO 159 cl1 = 'sophtove' 160 CALL iom_put( TRIM(cl1), z2d ) 161 z2d(1,:) = str_ove(:,1) * rc_ggram ! (conversion in Gg) 162 DO ji = 1, jpi 163 z2d(ji,:) = z2d(1,:) 164 ENDDO 165 cl1 = 'sopstove' 166 CALL iom_put( TRIM(cl1), z2d ) 167 IF( ln_subbas ) THEN 168 DO jn = 2, nptr 169 sjk(:,:,jn) = ptr_sjk( zmask(:,:,:), btmsk(:,:,jn) ) 170 r1_sjk(:,:,jn) = 0._wp 171 WHERE( sjk(:,:,jn) /= 0._wp ) r1_sjk(:,:,jn) = 1._wp / sjk(:,:,jn) 172 173 ! i-mean T and S, j-Stream-Function, basin 174 tn_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 175 sn_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 176 v_msf(:,:,jn) = ptr_sjk( zvv(:,:,:), btmsk(:,:,jn) ) 177 htr_ove(:,jn) = SUM( v_msf(:,:,jn)*tn_jk(:,:,jn) ,2 ) 178 str_ove(:,jn) = SUM( v_msf(:,:,jn)*sn_jk(:,:,jn) ,2 ) 179 180 z2d(1,:) = htr_ove(:,jn) * rc_pwatt ! (conversion in PW) 181 DO ji = 1, jpi 182 z2d(ji,:) = z2d(1,:) 183 ENDDO 184 cl1 = TRIM('sophtove_'//clsubb(jn)) 185 CALL iom_put( cl1, z2d ) 186 z2d(1,:) = str_ove(:,jn) * rc_ggram ! (conversion in Gg) 187 DO ji = 1, jpi 188 z2d(ji,:) = z2d(1,:) 189 ENDDO 190 cl1 = TRIM('sopstove_'//clsubb(jn)) 191 CALL iom_put( cl1, z2d ) 192 END DO 193 ENDIF 194 ENDIF 195 IF( iom_use("sopstbtr") .OR. iom_use("sophtbtr") ) THEN 196 ! Calculate barotropic heat and salt transport here 197 sjk(:,1,1) = ptr_sj( zmask(:,:,:), btmsk(:,:,1) ) 198 r1_sjk(:,1,1) = 0._wp 199 WHERE( sjk(:,1,1) /= 0._wp ) r1_sjk(:,1,1) = 1._wp / sjk(:,1,1) 200 201 vsum = ptr_sj( zvv(:,:,:), btmsk(:,:,1)) 202 tssum(:,jp_tem) = ptr_sj( zts(:,:,:,jp_tem), btmsk(:,:,1) ) 203 tssum(:,jp_sal) = ptr_sj( zts(:,:,:,jp_sal), btmsk(:,:,1) ) 204 htr_btr(:,1) = vsum * tssum(:,jp_tem) * r1_sjk(:,1,1) 205 str_btr(:,1) = vsum * tssum(:,jp_sal) * r1_sjk(:,1,1) 206 z2d(1,:) = htr_btr(:,1) * rc_pwatt ! (conversion in PW) 207 DO ji = 2, jpi 208 z2d(ji,:) = z2d(1,:) 209 ENDDO 210 cl1 = 'sophtbtr' 211 CALL iom_put( TRIM(cl1), z2d ) 212 z2d(1,:) = str_btr(:,1) * rc_ggram ! (conversion in Gg) 213 DO ji = 2, jpi 214 z2d(ji,:) = z2d(1,:) 215 ENDDO 216 cl1 = 'sopstbtr' 217 CALL iom_put( TRIM(cl1), z2d ) 218 IF( ln_subbas ) THEN 219 DO jn = 2, nptr 220 sjk(:,1,jn) = ptr_sj( zmask(:,:,:), btmsk(:,:,jn) ) 221 r1_sjk(:,1,jn) = 0._wp 222 WHERE( sjk(:,1,jn) /= 0._wp ) r1_sjk(:,1,jn) = 1._wp / sjk(:,1,jn) 223 vsum = ptr_sj( zvv(:,:,:), btmsk(:,:,jn)) 224 tssum(:,jp_tem) = ptr_sj( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) 225 tssum(:,jp_sal) = ptr_sj( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) 226 htr_btr(:,jn) = vsum * tssum(:,jp_tem) * r1_sjk(:,1,jn) 227 str_btr(:,jn) = vsum * tssum(:,jp_sal) * r1_sjk(:,1,jn) 228 z2d(1,:) = htr_btr(:,jn) * rc_pwatt ! (conversion in PW) 229 DO ji = 1, jpi 230 z2d(ji,:) = z2d(1,:) 231 ENDDO 232 cl1 = TRIM('sophtbtr_'//clsubb(jn)) 233 CALL iom_put( cl1, z2d ) 234 z2d(1,:) = str_btr(:,jn) * rc_ggram ! (conversion in Gg) 235 DO ji = 1, jpi 236 z2d(ji,:) = z2d(1,:) 237 ENDDO 238 cl1 = TRIM('sopstbtr_'//clsubb(jn)) 239 CALL iom_put( cl1, z2d ) 240 ENDDO 241 ENDIF !ln_subbas 242 ENDIF !iom_use("sopstbtr....) 130 IF( iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) ) THEN 131 DO jn = 1, nptr 132 sjk(:,:,jn) = ptr_sjk( zmask(:,:,:), btmsk(:,:,jn) ) 133 r1_sjk(:,:,jn) = 0._wp 134 WHERE( sjk(:,:,jn) /= 0._wp ) r1_sjk(:,:,jn) = 1._wp / sjk(:,:,jn) 135 ! i-mean T and S, j-Stream-Function, basin 136 zt_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 137 zs_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 138 v_msf(:,:,jn) = ptr_sjk( pvtr(:,:,:), btmsk34(:,:,jn) ) 139 hstr_ove(:,jp_tem,jn) = SUM( v_msf(:,:,jn)*zt_jk(:,:,jn), 2 ) 140 hstr_ove(:,jp_sal,jn) = SUM( v_msf(:,:,jn)*zs_jk(:,:,jn), 2 ) 141 ! 142 ENDDO 143 DO jn = 1, nptr 144 z3dtr(1,:,jn) = hstr_ove(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 145 DO ji = 1, jpi 146 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 147 ENDDO 148 ENDDO 149 CALL iom_put( 'sophtove', z3dtr ) 150 DO jn = 1, nptr 151 z3dtr(1,:,jn) = hstr_ove(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 152 DO ji = 1, jpi 153 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 154 ENDDO 155 ENDDO 156 CALL iom_put( 'sopstove', z3dtr ) 157 ENDIF 158 159 IF( iom_use( 'sopstbtr' ) .OR. iom_use( 'sophtbtr' ) ) THEN 160 ! Calculate barotropic heat and salt transport here 161 DO jn = 1, nptr 162 sjk(:,1,jn) = ptr_sj( zmask(:,:,:), btmsk(:,:,jn) ) 163 r1_sjk(:,1,jn) = 0._wp 164 WHERE( sjk(:,1,jn) /= 0._wp ) r1_sjk(:,1,jn) = 1._wp / sjk(:,1,jn) 165 ! 166 zvsum(:) = ptr_sj( pvtr(:,:,:), btmsk34(:,:,jn) ) 167 ztsum(:) = ptr_sj( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) 168 zssum(:) = ptr_sj( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) 169 hstr_btr(:,jp_tem,jn) = zvsum(:) * ztsum(:) * r1_sjk(:,1,jn) 170 hstr_btr(:,jp_sal,jn) = zvsum(:) * zssum(:) * r1_sjk(:,1,jn) 171 ! 172 ENDDO 173 DO jn = 1, nptr 174 z3dtr(1,:,jn) = hstr_btr(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 175 DO ji = 1, jpi 176 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 177 ENDDO 178 ENDDO 179 CALL iom_put( 'sophtbtr', z3dtr ) 180 DO jn = 1, nptr 181 z3dtr(1,:,jn) = hstr_btr(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 182 DO ji = 1, jpi 183 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 184 ENDDO 185 ENDDO 186 CALL iom_put( 'sopstbtr', z3dtr ) 187 ENDIF 243 188 ! 244 189 ELSE 245 190 ! 246 IF( iom_use("zotemglo") ) THEN ! i-mean i-k-surface 191 zmask(:,:,:) = 0._wp 192 zts(:,:,:,:) = 0._wp 193 IF( iom_use( 'zotem' ) .OR. iom_use( 'zosal' ) .OR. iom_use( 'zosrf' ) ) THEN ! i-mean i-k-surface 247 194 DO jk = 1, jpkm1 248 195 DO jj = 1, jpj … … 255 202 END DO 256 203 END DO 204 ! 257 205 DO jn = 1, nptr 258 206 zmask(1,:,:) = ptr_sjk( zmask(:,:,:), btmsk(:,:,jn) ) 259 cl1 = TRIM('zosrf'//clsubb(jn) ) 260 CALL iom_put( cl1, zmask ) 261 ! 262 z3d(1,:,:) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) & 263 & / MAX( zmask(1,:,:), 10.e-15 ) 264 DO ji = 1, jpi 265 z3d(ji,:,:) = z3d(1,:,:) 266 ENDDO 267 cl1 = TRIM('zotem'//clsubb(jn) ) 268 CALL iom_put( cl1, z3d ) 269 ! 270 z3d(1,:,:) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) & 271 & / MAX( zmask(1,:,:), 10.e-15 ) 272 DO ji = 1, jpi 273 z3d(ji,:,:) = z3d(1,:,:) 274 ENDDO 275 cl1 = TRIM('zosal'//clsubb(jn) ) 276 CALL iom_put( cl1, z3d ) 277 END DO 207 z4d1(:,:,:,jn) = zmask(:,:,:) 208 ENDDO 209 CALL iom_put( 'zosrf', z4d1 ) 210 ! 211 DO jn = 1, nptr 212 z4d2(1,:,:,jn) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) & 213 & / MAX( z4d1(1,:,:,jn), 10.e-15 ) 214 DO ji = 1, jpi 215 z4d2(ji,:,:,jn) = z4d2(1,:,:,jn) 216 ENDDO 217 ENDDO 218 CALL iom_put( 'zotem', z4d2 ) 219 ! 220 DO jn = 1, nptr 221 z4d2(1,:,:,jn) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) & 222 & / MAX( z4d1(1,:,:,jn), 10.e-15 ) 223 DO ji = 1, jpi 224 z4d2(ji,:,:,jn) = z4d2(1,:,:,jn) 225 ENDDO 226 ENDDO 227 CALL iom_put( 'zosal', z4d2 ) 228 ! 278 229 ENDIF 279 230 ! 280 231 ! ! Advective and diffusive heat and salt transport 281 IF( iom_use("sophtadv") .OR. iom_use("sopstadv") ) THEN 282 z2d(1,:) = htr_adv(:,1) * rc_pwatt ! (conversion in PW) 283 DO ji = 1, jpi 284 z2d(ji,:) = z2d(1,:) 285 ENDDO 286 cl1 = 'sophtadv' 287 CALL iom_put( TRIM(cl1), z2d ) 288 z2d(1,:) = str_adv(:,1) * rc_ggram ! (conversion in Gg) 289 DO ji = 1, jpi 290 z2d(ji,:) = z2d(1,:) 291 ENDDO 292 cl1 = 'sopstadv' 293 CALL iom_put( TRIM(cl1), z2d ) 294 IF( ln_subbas ) THEN 295 DO jn=2,nptr 296 z2d(1,:) = htr_adv(:,jn) * rc_pwatt ! (conversion in PW) 297 DO ji = 1, jpi 298 z2d(ji,:) = z2d(1,:) 299 ENDDO 300 cl1 = TRIM('sophtadv_'//clsubb(jn)) 301 CALL iom_put( cl1, z2d ) 302 z2d(1,:) = str_adv(:,jn) * rc_ggram ! (conversion in Gg) 303 DO ji = 1, jpi 304 z2d(ji,:) = z2d(1,:) 305 ENDDO 306 cl1 = TRIM('sopstadv_'//clsubb(jn)) 307 CALL iom_put( cl1, z2d ) 308 ENDDO 309 ENDIF 310 ENDIF 311 ! 312 IF( iom_use("sophtldf") .OR. iom_use("sopstldf") ) THEN 313 z2d(1,:) = htr_ldf(:,1) * rc_pwatt ! (conversion in PW) 314 DO ji = 1, jpi 315 z2d(ji,:) = z2d(1,:) 316 ENDDO 317 cl1 = 'sophtldf' 318 CALL iom_put( TRIM(cl1), z2d ) 319 z2d(1,:) = str_ldf(:,1) * rc_ggram ! (conversion in Gg) 320 DO ji = 1, jpi 321 z2d(ji,:) = z2d(1,:) 322 ENDDO 323 cl1 = 'sopstldf' 324 CALL iom_put( TRIM(cl1), z2d ) 325 IF( ln_subbas ) THEN 326 DO jn=2,nptr 327 z2d(1,:) = htr_ldf(:,jn) * rc_pwatt ! (conversion in PW) 328 DO ji = 1, jpi 329 z2d(ji,:) = z2d(1,:) 330 ENDDO 331 cl1 = TRIM('sophtldf_'//clsubb(jn)) 332 CALL iom_put( cl1, z2d ) 333 z2d(1,:) = str_ldf(:,jn) * rc_ggram ! (conversion in Gg) 334 DO ji = 1, jpi 335 z2d(ji,:) = z2d(1,:) 336 ENDDO 337 cl1 = TRIM('sopstldf_'//clsubb(jn)) 338 CALL iom_put( cl1, z2d ) 339 ENDDO 340 ENDIF 341 ENDIF 342 343 IF( iom_use("sophteiv") .OR. iom_use("sopsteiv") ) THEN 344 z2d(1,:) = htr_eiv(:,1) * rc_pwatt ! (conversion in PW) 345 DO ji = 1, jpi 346 z2d(ji,:) = z2d(1,:) 347 ENDDO 348 cl1 = 'sophteiv' 349 CALL iom_put( TRIM(cl1), z2d ) 350 z2d(1,:) = str_eiv(:,1) * rc_ggram ! (conversion in Gg) 351 DO ji = 1, jpi 352 z2d(ji,:) = z2d(1,:) 353 ENDDO 354 cl1 = 'sopsteiv' 355 CALL iom_put( TRIM(cl1), z2d ) 356 IF( ln_subbas ) THEN 357 DO jn=2,nptr 358 z2d(1,:) = htr_eiv(:,jn) * rc_pwatt ! (conversion in PW) 232 IF( iom_use( 'sophtadv' ) .OR. iom_use( 'sopstadv' ) ) THEN 233 ! 234 DO jn = 1, nptr 235 z3dtr(1,:,jn) = hstr_adv(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 236 DO ji = 1, jpi 237 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 238 ENDDO 239 ENDDO 240 CALL iom_put( 'sophtadv', z3dtr ) 241 DO jn = 1, nptr 242 z3dtr(1,:,jn) = hstr_adv(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 243 DO ji = 1, jpi 244 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 245 ENDDO 246 ENDDO 247 CALL iom_put( 'sopstadv', z3dtr ) 248 ENDIF 249 ! 250 IF( iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) ) THEN 251 ! 252 DO jn = 1, nptr 253 z3dtr(1,:,jn) = hstr_ldf(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 254 DO ji = 1, jpi 255 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 256 ENDDO 257 ENDDO 258 CALL iom_put( 'sophtldf', z3dtr ) 259 DO jn = 1, nptr 260 z3dtr(1,:,jn) = hstr_ldf(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 261 DO ji = 1, jpi 262 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 263 ENDDO 264 ENDDO 265 CALL iom_put( 'sopstldf', z3dtr ) 266 ENDIF 267 ! 268 IF( iom_use( 'sophteiv' ) .OR. iom_use( 'sopsteiv' ) ) THEN 269 ! 270 DO jn = 1, nptr 271 z3dtr(1,:,jn) = hstr_eiv(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 272 DO ji = 1, jpi 273 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 274 ENDDO 275 ENDDO 276 CALL iom_put( 'sophteiv', z3dtr ) 277 DO jn = 1, nptr 278 z3dtr(1,:,jn) = hstr_eiv(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 279 DO ji = 1, jpi 280 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 281 ENDDO 282 ENDDO 283 CALL iom_put( 'sopsteiv', z3dtr ) 284 ENDIF 285 ! 286 IF( iom_use( 'sopstvtr' ) .OR. iom_use( 'sophtvtr' ) ) THEN 287 zts(:,:,:,:) = 0._wp 288 DO jk = 1, jpkm1 289 DO jj = 1, jpjm1 359 290 DO ji = 1, jpi 360 z2d(ji,:) = z2d(1,:) 291 zvfc = e1v(ji,jj) * e3v(ji,jj,jk,Kmm) 292 zts(ji,jj,jk,jp_tem) = (ts(ji,jj,jk,jp_tem,Kmm)+ts(ji,jj+1,jk,jp_tem,Kmm)) * 0.5 * zvfc !Tracers averaged onto V grid 293 zts(ji,jj,jk,jp_sal) = (ts(ji,jj,jk,jp_sal,Kmm)+ts(ji,jj+1,jk,jp_sal,Kmm)) * 0.5 * zvfc 361 294 ENDDO 362 cl1 = TRIM('sophteiv_'//clsubb(jn)) 363 CALL iom_put( cl1, z2d ) 364 z2d(1,:) = str_eiv(:,jn) * rc_ggram ! (conversion in Gg) 365 DO ji = 1, jpi 366 z2d(ji,:) = z2d(1,:) 367 ENDDO 368 cl1 = TRIM('sopsteiv_'//clsubb(jn)) 369 CALL iom_put( cl1, z2d ) 370 ENDDO 371 ENDIF 295 ENDDO 296 ENDDO 297 CALL dia_ptr_hst( jp_tem, 'vtr', zts(:,:,:,jp_tem) ) 298 CALL dia_ptr_hst( jp_sal, 'vtr', zts(:,:,:,jp_sal) ) 299 DO jn = 1, nptr 300 z3dtr(1,:,jn) = hstr_vtr(:,jp_tem,jn) * rc_pwatt ! (conversion in PW) 301 DO ji = 1, jpi 302 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 303 ENDDO 304 ENDDO 305 CALL iom_put( 'sophtvtr', z3dtr ) 306 DO jn = 1, nptr 307 z3dtr(1,:,jn) = hstr_vtr(:,jp_sal,jn) * rc_ggram ! (conversion in Gg) 308 DO ji = 1, jpi 309 z3dtr(ji,:,jn) = z3dtr(1,:,jn) 310 ENDDO 311 ENDDO 312 CALL iom_put( 'sopstvtr', z3dtr ) 313 ENDIF 314 ! 315 IF( iom_use( 'uocetr_vsum_cumul' ) ) THEN 316 CALL iom_get_var( 'uocetr_vsum_op', z2d ) ! get uocetr_vsum_op from xml 317 z2d(:,:) = ptr_ci_2d( z2d(:,:) ) 318 CALL iom_put( 'uocetr_vsum_cumul', z2d ) 372 319 ENDIF 373 320 ! … … 385 332 !! ** Purpose : Initialization, namelist read 386 333 !!---------------------------------------------------------------------- 387 INTEGER :: jn ! local integers388 INTEGER :: inum, ierr ! local integers389 INTEGER :: ios ! Local integer output status for namelist read390 !! 391 NAMELIST/namptr/ ln_diaptr, ln_subbas 392 !!----------------------------------------------------------------------393 394 READ ( numnam_ref, namptr, IOSTAT = ios, ERR = 901)395 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namptr in reference namelist' ) 396 397 READ ( numnam_cfg, namptr, IOSTAT = ios, ERR = 902 )398 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namptr in configuration namelist' ) 399 IF(lwm) WRITE ( numond, namptr ) 400 334 INTEGER :: inum, jn ! local integers 335 !! 336 REAL(wp), DIMENSION(jpi,jpj) :: zmsk 337 !!---------------------------------------------------------------------- 338 339 l_diaptr = .FALSE. 340 IF( iom_use( 'zomsf' ) .OR. iom_use( 'zotem' ) .OR. iom_use( 'zosal' ) .OR. & 341 & iom_use( 'zosrf' ) .OR. iom_use( 'sopstove' ) .OR. iom_use( 'sophtove' ) .OR. & 342 & iom_use( 'sopstbtr' ) .OR. iom_use( 'sophtbtr' ) .OR. iom_use( 'sophtadv' ) .OR. & 343 & iom_use( 'sopstadv' ) .OR. iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) .OR. & 344 & iom_use( 'sophteiv' ) .OR. iom_use( 'sopsteiv' ) .OR. iom_use( 'sopstvtr' ) .OR. & 345 & iom_use( 'sophtvtr' ) .OR. iom_use( 'uocetr_vsum_cumul' ) ) l_diaptr = .TRUE. 346 347 401 348 IF(lwp) THEN ! Control print 402 349 WRITE(numout,*) … … 404 351 WRITE(numout,*) '~~~~~~~~~~~~' 405 352 WRITE(numout,*) ' Namelist namptr : set ptr parameters' 406 WRITE(numout,*) ' Poleward heat & salt transport (T) or not (F) ln_diaptr = ', ln_diaptr 407 WRITE(numout,*) ' Global (F) or glo/Atl/Pac/Ind/Indo-Pac basins ln_subbas = ', ln_subbas 353 WRITE(numout,*) ' Poleward heat & salt transport (T) or not (F) l_diaptr = ', l_diaptr 408 354 ENDIF 409 355 410 IF( ln_diaptr ) THEN 411 ! 412 IF( ln_subbas ) THEN 413 nptr = 5 ! Global, Atlantic, Pacific, Indian, Indo-Pacific 414 ALLOCATE( clsubb(nptr) ) 415 clsubb(1) = 'glo' ; clsubb(2) = 'atl' ; clsubb(3) = 'pac' ; clsubb(4) = 'ind' ; clsubb(5) = 'ipc' 416 ELSE 417 nptr = 1 ! Global only 418 ALLOCATE( clsubb(nptr) ) 419 clsubb(1) = 'glo' 420 ENDIF 421 422 ! ! allocate dia_ptr arrays 356 IF( l_diaptr ) THEN 357 ! 423 358 IF( dia_ptr_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_ptr_init : unable to allocate arrays' ) 424 359 425 360 rc_pwatt = rc_pwatt * rau0_rcp ! conversion from K.s-1 to PetaWatt 361 rc_ggram = rc_ggram * rau0 ! conversion from m3/s to Gg/s 426 362 427 363 IF( lk_mpp ) CALL mpp_ini_znl( numout ) ! Define MPI communicator for zonal sum 428 364 429 IF( ln_subbas ) THEN ! load sub-basin mask 430 CALL iom_open( 'subbasins', inum, ldstop = .FALSE. ) 431 CALL iom_get( inum, jpdom_data, 'atlmsk', btmsk(:,:,2) ) ! Atlantic basin 432 CALL iom_get( inum, jpdom_data, 'pacmsk', btmsk(:,:,3) ) ! Pacific basin 433 CALL iom_get( inum, jpdom_data, 'indmsk', btmsk(:,:,4) ) ! Indian basin 434 CALL iom_close( inum ) 435 btmsk(:,:,5) = MAX ( btmsk(:,:,3), btmsk(:,:,4) ) ! Indo-Pacific basin 436 WHERE( gphit(:,:) < -30._wp) ; btm30(:,:) = 0._wp ! mask out Southern Ocean 437 ELSE WHERE ; btm30(:,:) = ssmask(:,:) 438 END WHERE 439 ENDIF 440 441 btmsk(:,:,1) = tmask_i(:,:) ! global ocean 442 443 DO jn = 1, nptr 365 btmsk(:,:,1) = tmask_i(:,:) 366 CALL iom_open( 'subbasins', inum, ldstop = .FALSE. ) 367 CALL iom_get( inum, jpdom_data, 'atlmsk', btmsk(:,:,2) ) ! Atlantic basin 368 CALL iom_get( inum, jpdom_data, 'pacmsk', btmsk(:,:,3) ) ! Pacific basin 369 CALL iom_get( inum, jpdom_data, 'indmsk', btmsk(:,:,4) ) ! Indian basin 370 CALL iom_close( inum ) 371 btmsk(:,:,5) = MAX ( btmsk(:,:,3), btmsk(:,:,4) ) ! Indo-Pacific basin 372 DO jn = 2, nptr 444 373 btmsk(:,:,jn) = btmsk(:,:,jn) * tmask_i(:,:) ! interior domain only 445 374 END DO 375 ! JD : modification so that overturning streamfunction is available in Atlantic at 34S to compare with observations 376 WHERE( gphit(:,:)*tmask_i(:,:) < -34._wp) 377 zmsk(:,:) = 0._wp ! mask out Southern Ocean 378 ELSE WHERE 379 zmsk(:,:) = ssmask(:,:) 380 END WHERE 381 btmsk34(:,:,1) = btmsk(:,:,1) 382 DO jn = 2, nptr 383 btmsk34(:,:,jn) = btmsk(:,:,jn) * zmsk(:,:) ! interior domain only 384 ENDDO 446 385 447 386 ! Initialise arrays to zero because diatpr is called before they are first calculated 448 387 ! Note that this means diagnostics will not be exactly correct when model run is restarted. 449 htr_adv(:,:) = 0._wp ; str_adv(:,:) = 0._wp 450 htr_ldf(:,:) = 0._wp ; str_ldf(:,:) = 0._wp 451 htr_eiv(:,:) = 0._wp ; str_eiv(:,:) = 0._wp 452 htr_ove(:,:) = 0._wp ; str_ove(:,:) = 0._wp 453 htr_btr(:,:) = 0._wp ; str_btr(:,:) = 0._wp 388 hstr_adv(:,:,:) = 0._wp 389 hstr_ldf(:,:,:) = 0._wp 390 hstr_eiv(:,:,:) = 0._wp 391 hstr_ove(:,:,:) = 0._wp 392 hstr_btr(:,:,:) = 0._wp ! 393 hstr_vtr(:,:,:) = 0._wp ! 394 ! 395 ll_init = .FALSE. 454 396 ! 455 397 ENDIF … … 470 412 INTEGER :: jn ! 471 413 414 ! 472 415 IF( cptr == 'adv' ) THEN 473 IF( ktra == jp_tem ) htr_adv(:,1) = ptr_sj( pvflx ) 474 IF( ktra == jp_sal ) str_adv(:,1) = ptr_sj( pvflx ) 416 IF( ktra == jp_tem ) THEN 417 DO jn = 1, nptr 418 hstr_adv(:,jp_tem,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 419 ENDDO 420 ENDIF 421 IF( ktra == jp_sal ) THEN 422 DO jn = 1, nptr 423 hstr_adv(:,jp_sal,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 424 ENDDO 425 ENDIF 475 426 ENDIF 427 ! 476 428 IF( cptr == 'ldf' ) THEN 477 IF( ktra == jp_tem ) htr_ldf(:,1) = ptr_sj( pvflx ) 478 IF( ktra == jp_sal ) str_ldf(:,1) = ptr_sj( pvflx ) 429 IF( ktra == jp_tem ) THEN 430 DO jn = 1, nptr 431 hstr_ldf(:,jp_tem,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 432 ENDDO 433 ENDIF 434 IF( ktra == jp_sal ) THEN 435 DO jn = 1, nptr 436 hstr_ldf(:,jp_sal,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 437 ENDDO 438 ENDIF 479 439 ENDIF 440 ! 480 441 IF( cptr == 'eiv' ) THEN 481 IF( ktra == jp_tem ) htr_eiv(:,1) = ptr_sj( pvflx ) 482 IF( ktra == jp_sal ) str_eiv(:,1) = ptr_sj( pvflx ) 442 IF( ktra == jp_tem ) THEN 443 DO jn = 1, nptr 444 hstr_eiv(:,jp_tem,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 445 ENDDO 446 ENDIF 447 IF( ktra == jp_sal ) THEN 448 DO jn = 1, nptr 449 hstr_eiv(:,jp_sal,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 450 ENDDO 451 ENDIF 483 452 ENDIF 484 453 ! 485 IF( ln_subbas ) THEN 486 ! 487 IF( cptr == 'adv' ) THEN 488 IF( ktra == jp_tem ) THEN 489 DO jn = 2, nptr 490 htr_adv(:,jn) = ptr_sj( pvflx, btmsk(:,:,jn) ) 491 END DO 492 ENDIF 493 IF( ktra == jp_sal ) THEN 494 DO jn = 2, nptr 495 str_adv(:,jn) = ptr_sj( pvflx, btmsk(:,:,jn) ) 496 END DO 497 ENDIF 498 ENDIF 499 IF( cptr == 'ldf' ) THEN 500 IF( ktra == jp_tem ) THEN 501 DO jn = 2, nptr 502 htr_ldf(:,jn) = ptr_sj( pvflx, btmsk(:,:,jn) ) 503 END DO 504 ENDIF 505 IF( ktra == jp_sal ) THEN 506 DO jn = 2, nptr 507 str_ldf(:,jn) = ptr_sj( pvflx, btmsk(:,:,jn) ) 508 END DO 509 ENDIF 510 ENDIF 511 IF( cptr == 'eiv' ) THEN 512 IF( ktra == jp_tem ) THEN 513 DO jn = 2, nptr 514 htr_eiv(:,jn) = ptr_sj( pvflx, btmsk(:,:,jn) ) 515 END DO 516 ENDIF 517 IF( ktra == jp_sal ) THEN 518 DO jn = 2, nptr 519 str_eiv(:,jn) = ptr_sj( pvflx, btmsk(:,:,jn) ) 520 END DO 521 ENDIF 522 ENDIF 523 ! 454 IF( cptr == 'vtr' ) THEN 455 IF( ktra == jp_tem ) THEN 456 DO jn = 1, nptr 457 hstr_vtr(:,jp_tem,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 458 ENDDO 459 ENDIF 460 IF( ktra == jp_sal ) THEN 461 DO jn = 1, nptr 462 hstr_vtr(:,jp_sal,jn) = ptr_sj( pvflx(:,:,:), btmsk(:,:,jn) ) 463 ENDDO 464 ENDIF 524 465 ENDIF 466 ! 525 467 END SUBROUTINE dia_ptr_hst 526 468 … … 535 477 ierr(:) = 0 536 478 ! 537 ALLOCATE( btmsk(jpi,jpj,nptr) , & 538 & htr_adv(jpj,nptr) , str_adv(jpj,nptr) , & 539 & htr_eiv(jpj,nptr) , str_eiv(jpj,nptr) , & 540 & htr_ove(jpj,nptr) , str_ove(jpj,nptr) , & 541 & htr_btr(jpj,nptr) , str_btr(jpj,nptr) , & 542 & htr_ldf(jpj,nptr) , str_ldf(jpj,nptr) , STAT=ierr(1) ) 543 ! 544 ALLOCATE( p_fval1d(jpj), p_fval2d(jpj,jpk), Stat=ierr(2)) 545 ! 546 ALLOCATE( btm30(jpi,jpj), STAT=ierr(3) ) 547 548 ! 549 dia_ptr_alloc = MAXVAL( ierr ) 550 CALL mpp_sum( 'diaptr', dia_ptr_alloc ) 479 IF( .NOT. ALLOCATED( btmsk ) ) THEN 480 ALLOCATE( btmsk(jpi,jpj,nptr) , btmsk34(jpi,jpj,nptr), & 481 & hstr_adv(jpj,jpts,nptr), hstr_eiv(jpj,jpts,nptr), & 482 & hstr_ove(jpj,jpts,nptr), hstr_btr(jpj,jpts,nptr), & 483 & hstr_ldf(jpj,jpts,nptr), hstr_vtr(jpj,jpts,nptr), STAT=ierr(1) ) 484 ! 485 ALLOCATE( p_fval1d(jpj), p_fval2d(jpj,jpk), Stat=ierr(2)) 486 ! 487 dia_ptr_alloc = MAXVAL( ierr ) 488 CALL mpp_sum( 'diaptr', dia_ptr_alloc ) 489 ENDIF 551 490 ! 552 491 END FUNCTION dia_ptr_alloc … … 564 503 !! ** Action : - p_fval: i-k-mean poleward flux of pvflx 565 504 !!---------------------------------------------------------------------- 566 REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) :: pvflx! mask flux array at V-point567 REAL(wp), INTENT(in), DIMENSION(jpi,jpj) , OPTIONAL:: pmsk ! Optional 2D basin mask505 REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) :: pvflx ! mask flux array at V-point 506 REAL(wp), INTENT(in), DIMENSION(jpi,jpj) :: pmsk ! Optional 2D basin mask 568 507 ! 569 508 INTEGER :: ji, jj, jk ! dummy loop arguments … … 576 515 ijpj = jpj 577 516 p_fval(:) = 0._wp 578 IF( PRESENT( pmsk ) ) THEN 579 DO jk = 1, jpkm1 580 DO jj = 2, jpjm1 581 DO ji = fs_2, fs_jpim1 ! Vector opt. 582 p_fval(jj) = p_fval(jj) + pvflx(ji,jj,jk) * tmask_i(ji,jj) * pmsk(ji,jj) 583 END DO 517 DO jk = 1, jpkm1 518 DO jj = 2, jpjm1 519 DO ji = fs_2, fs_jpim1 ! Vector opt. 520 p_fval(jj) = p_fval(jj) + pvflx(ji,jj,jk) * pmsk(ji,jj) * tmask_i(ji,jj) 584 521 END DO 585 522 END DO 586 ELSE 587 DO jk = 1, jpkm1 588 DO jj = 2, jpjm1 589 DO ji = fs_2, fs_jpim1 ! Vector opt. 590 p_fval(jj) = p_fval(jj) + pvflx(ji,jj,jk) * tmask_i(ji,jj) 591 END DO 592 END DO 593 END DO 594 ENDIF 523 END DO 595 524 #if defined key_mpp_mpi 596 525 CALL mpp_sum( 'diaptr', p_fval, ijpj, ncomm_znl) … … 611 540 !! ** Action : - p_fval: i-k-mean poleward flux of pvflx 612 541 !!---------------------------------------------------------------------- 613 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) :: pvflx! mask flux array at V-point614 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) , OPTIONAL:: pmsk ! Optional 2D basin mask542 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) :: pvflx ! mask flux array at V-point 543 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) :: pmsk ! Optional 2D basin mask 615 544 ! 616 545 INTEGER :: ji,jj ! dummy loop arguments … … 623 552 ijpj = jpj 624 553 p_fval(:) = 0._wp 625 IF( PRESENT( pmsk ) ) THEN 626 DO jj = 2, jpjm1 627 DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ? 628 p_fval(jj) = p_fval(jj) + pvflx(ji,jj) * tmask_i(ji,jj) * pmsk(ji,jj) 629 END DO 554 DO jj = 2, jpjm1 555 DO ji = fs_2, fs_jpim1 ! Vector opt. 556 p_fval(jj) = p_fval(jj) + pvflx(ji,jj) * pmsk(ji,jj) * tmask_i(ji,jj) 630 557 END DO 631 ELSE 632 DO jj = 2, jpjm1 633 DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ? 634 p_fval(jj) = p_fval(jj) + pvflx(ji,jj) * tmask_i(ji,jj) 635 END DO 636 END DO 637 ENDIF 558 END DO 638 559 #if defined key_mpp_mpi 639 560 CALL mpp_sum( 'diaptr', p_fval, ijpj, ncomm_znl ) … … 642 563 END FUNCTION ptr_sj_2d 643 564 644 645 FUNCTION ptr_sjk( pfld, pmsk ) RESULT ( p_fval ) 565 FUNCTION ptr_ci_2d( pva ) RESULT ( p_fval ) 566 !!---------------------------------------------------------------------- 567 !! *** ROUTINE ptr_ci_2d *** 568 !! 569 !! ** Purpose : "meridional" cumulated sum computation of a j-flux array 570 !! 571 !! ** Method : - j cumulated sum of pva using the interior 2D vmask (umask_i). 572 !! 573 !! ** Action : - p_fval: j-cumulated sum of pva 574 !!---------------------------------------------------------------------- 575 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) :: pva ! mask flux array at V-point 576 ! 577 INTEGER :: ji,jj,jc ! dummy loop arguments 578 INTEGER :: ijpj ! ??? 579 REAL(wp), DIMENSION(jpi,jpj) :: p_fval ! function value 580 !!-------------------------------------------------------------------- 581 ! 582 ijpj = jpj ! ??? 583 p_fval(:,:) = 0._wp 584 DO jc = 1, jpnj ! looping over all processors in j axis 585 DO jj = 2, jpjm1 586 DO ji = fs_2, fs_jpim1 ! Vector opt. 587 p_fval(ji,jj) = p_fval(ji,jj-1) + pva(ji,jj) * tmask_i(ji,jj) 588 END DO 589 END DO 590 CALL lbc_lnk( 'diaptr', p_fval, 'U', -1. ) 591 END DO 592 ! 593 END FUNCTION ptr_ci_2d 594 595 596 597 FUNCTION ptr_sjk( pta, pmsk ) RESULT ( p_fval ) 646 598 !!---------------------------------------------------------------------- 647 599 !! *** ROUTINE ptr_sjk *** … … 655 607 !! 656 608 IMPLICIT none 657 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) :: pfld ! input field to be summed658 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) , OPTIONAL:: pmsk ! Optional 2D basin mask609 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) :: pta ! mask flux array at V-point 610 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) :: pmsk ! Optional 2D basin mask 659 611 !! 660 612 INTEGER :: ji, jj, jk ! dummy loop arguments … … 672 624 p_fval(:,:) = 0._wp 673 625 ! 674 IF( PRESENT( pmsk ) ) THEN 675 DO jk = 1, jpkm1 676 DO jj = 2, jpjm1 677 !!gm here, use of tmask_i ==> no need of loop over nldi, nlei.... 678 DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ? 679 p_fval(jj,jk) = p_fval(jj,jk) + pfld(ji,jj,jk) * pmsk(ji,jj) 680 END DO 626 DO jk = 1, jpkm1 627 DO jj = 2, jpjm1 628 DO ji = fs_2, fs_jpim1 ! Vector opt. 629 p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * pmsk(ji,jj) * tmask_i(ji,jj) 681 630 END DO 682 631 END DO 683 ELSE 684 DO jk = 1, jpkm1 685 DO jj = 2, jpjm1 686 DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ? 687 p_fval(jj,jk) = p_fval(jj,jk) + pfld(ji,jj,jk) * tmask_i(ji,jj) 688 END DO 689 END DO 690 END DO 691 END IF 632 END DO 692 633 ! 693 634 #if defined key_mpp_mpi
Note: See TracChangeset
for help on using the changeset viewer.
