Changeset 1340
- Timestamp:
- 2009-03-13T15:31:06+01:00 (15 years ago)
- Location:
- trunk
- Files:
-
- 3 edited
-
CONFIG/ORCA2_LIM/EXP00/namelist (modified) (1 diff)
-
CONFIG/ORCA2_LIM_PISCES/EXP00/namelist (modified) (1 diff)
-
NEMO/OPA_SRC/DIA/diaptr.F90 (modified) (24 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/CONFIG/ORCA2_LIM/EXP00/namelist
r1317 r1340 680 680 &namptr ! Poleward Transport Diagnostic 681 681 !----------------------------------------------------------------------- 682 ln_diaptr = .false. ! Poleward heat and salt transport (T) or not (F) 683 ln_subbas = .false. ! Atlantic/Pacific/Indian basins computation (T) or not 682 ln_diaptr = .false. ! Poleward heat and salt transport (T) or not (F) 683 ln_diaznl = .false. ! Add zonal means and meridional stream functions 684 ln_subbas = .false. ! Atlantic/Pacific/Indian basins computation (T) or not 684 685 ! (orca configuration only, need input basins mask file named "subbasins.nc" 685 nf_ptr = 15 ! Frequency of ptr computation [time step] 686 / 686 nf_ptr = 1 ! Frequency of ptr computation [time step] 687 nf_ptr_wri = 15 ! Frequency of ptr outputs 688 / -
trunk/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist
r1317 r1340 680 680 &namptr ! Poleward Transport Diagnostic 681 681 !----------------------------------------------------------------------- 682 ln_diaptr = .false. ! Poleward heat and salt transport (T) or not (F) 683 ln_subbas = .false. ! Atlantic/Pacific/Indian basins computation (T) or not 682 ln_diaptr = .false. ! Poleward heat and salt transport (T) or not (F) 683 ln_diaznl = .false. ! Add zonal means and meridional stream functions 684 ln_subbas = .false. ! Atlantic/Pacific/Indian basins computation (T) or not 684 685 ! (orca configuration only, need input basins mask file named "subbasins.nc" 685 nf_ptr = 15 ! Frequency of ptr computation [time step] 686 / 686 nf_ptr = 1 ! Frequency of ptr computation [time step] 687 nf_ptr_wri = 15 ! Frequency of ptr outputs 688 / -
trunk/NEMO/OPA_SRC/DIA/diaptr.F90
r1334 r1340 2 2 !!====================================================================== 3 3 !! *** MODULE diaptr *** 4 !! Ocean physics: brief description of the purpose of the module 5 !! (please no more than 2 lines) 4 !! Ocean physics: Computes meridonal transports and zonal means 6 5 !!===================================================================== 7 !! History : 9.0 ! 03-09 (C. Talandi r, G. Madec) Original code6 !! History : 9.0 ! 03-09 (C. Talandier, G. Madec) Original code 8 7 !! 9.0 ! 06-01 (A. Biastoch) Allow sub-basins computation 9 8 !!---------------------------------------------------------------------- … … 14 13 !! dia_ptr_wri : Output of poleward fluxes 15 14 !! ptr_vjk : "zonal" sum computation of a "meridional" flux array 16 !! ptr_ vtjk: "zonal" mean computation of a tracer field15 !! ptr_tjk : "zonal" mean computation of a tracer field 17 16 !! ptr_vj : "zonal" and vertical sum computation of a "meridional" 18 17 !! : flux array; Generic interface: ptr_vj_3d, ptr_vj_2d … … 20 19 USE oce ! ocean dynamics and active tracers 21 20 USE dom_oce ! ocean space and time domain 22 USE ldftra_oce ! ???21 USE ldftra_oce ! ocean active tracers: lateral physics 23 22 USE lib_mpp 24 23 USE in_out_manager … … 41 40 PUBLIC ptr_vjk ! call by tra_ldf & tra_adv routines 42 41 43 42 !!! ** init namelist (namptr) 44 43 LOGICAL , PUBLIC :: ln_diaptr = .FALSE. !: Poleward transport flag (T) or not (F) 45 44 LOGICAL , PUBLIC :: ln_subbas = .FALSE. !: Atlantic/Pacific/Indian basins calculation 45 LOGICAL , PUBLIC :: ln_diaznl !: Add zonal means and meridional stream functions 46 46 INTEGER , PUBLIC :: nf_ptr = 15 !: frequency of ptr computation 47 INTEGER , PUBLIC :: nf_ptr_wri = 15 !: frequency of ptr outputs 47 48 48 49 REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_adv, pst_adv !: heat and salt poleward transport: advection … … 52 53 REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_eiv, pst_eiv !: heat and salt poleward transport: bolus advection 53 54 #endif 54 REAL(wp), PUBLIC, DIMENSION(jpj) :: ht_atl,ht_ind,ht_pac !: heat 55 REAL(wp), PUBLIC, DIMENSION(jpj) :: st_atl,st_ind,st_pac !: salt 56 57 58 59 REAL(wp), DIMENSION(jpj,jpk) :: tn_jk , sn_jk , & !: "zonal" mean temperature and salinity 60 & v_msf_atl , & !: "meridional" Stream-Function 55 REAL(wp), PUBLIC, DIMENSION(jpj) :: ht_glo,ht_atl,ht_ind,ht_pac,ht_ipc !: heat 56 REAL(wp), PUBLIC, DIMENSION(jpj) :: st_glo,st_atl,st_ind,st_pac,st_ipc !: salt 57 58 INTEGER :: nidom_diaptr ! domain identifier for IOIPSL 59 60 REAL(wp), DIMENSION(jpj,jpk) :: tn_jk_glo, sn_jk_glo, & !: "zonal" mean temperature and salinity 61 & tn_jk_atl, sn_jk_atl, & 62 & tn_jk_pac, sn_jk_pac, & 63 & tn_jk_ind, sn_jk_ind, & 64 & tn_jk_ipc, sn_jk_ipc, & 61 65 & v_msf_glo , & !: "meridional" Stream-Function 62 & v_msf_ipc , & !: "meridional" Stream-Function 63 & surf_jk_r !: inverse of the ocean "zonal" section surface 64 #if defined key_diaeiv 65 REAL(wp), DIMENSION(jpj,jpk) :: v_msf_eiv !: bolus "meridional" Stream-Function 66 #endif 67 REAL(wp), DIMENSION(jpi,jpj) :: abasin, pbasin, ibasin !: return function value 66 & v_msf_atl , & 67 & v_msf_pac , & 68 & v_msf_ind , & 69 & v_msf_ipc , & 70 & surf_jk_glo , & !: Ocean "zonal" section surface 71 & surf_jk_atl , & 72 & surf_jk_pac , & 73 & surf_jk_ind , & 74 & surf_jk_ipc , & 75 & surf_jk_r_glo , & !: inverse of the ocean "zonal" section surface 76 & surf_jk_r_atl , & 77 & surf_jk_r_pac , & 78 & surf_jk_r_ind , & 79 & surf_jk_r_ipc 80 #if defined key_diaeiv 81 REAL(wp), DIMENSION(jpj,jpk) :: v_msf_eiv !: bolus "meridional" Stream-Function 82 #endif 83 REAL(wp), DIMENSION(jpi,jpj) :: abasin, pbasin, ibasin, dbasin, sbasin !: Sub basin masks 68 84 69 85 !! * Substitutions … … 144 160 145 161 146 FUNCTION ptr_vjk( pva ) RESULT ( p_fval )162 FUNCTION ptr_vjk( pva, bmask ) RESULT ( p_fval ) 147 163 !!---------------------------------------------------------------------- 148 164 !! *** ROUTINE ptr_vjk *** … … 156 172 !!---------------------------------------------------------------------- 157 173 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) :: pva ! mask flux array at V-point 174 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj), OPTIONAL :: bmask ! Optional 2D basin mask 158 175 !! 159 176 INTEGER :: ji, jj, jk ! dummy loop arguments … … 166 183 p_fval(:,:) = 0.e0 167 184 ! 168 DO jk = 1, jpkm1 169 DO jj = 2, jpjm1 170 DO ji = fs_2, fs_jpim1 171 p_fval(jj,jk) = p_fval(jj,jk) + pva(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk) & 172 & * tmask_i(ji,jj+1) * tmask_i(ji,jj) 173 END DO 174 END DO 175 END DO 185 IF (PRESENT (bmask)) THEN 186 DO jk = 1, jpkm1 187 DO jj = 2, jpjm1 188 DO ji = fs_2, fs_jpim1 189 p_fval(jj,jk) = p_fval(jj,jk) + pva(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk) & 190 & * tmask_i(ji,jj+1) * tmask_i(ji,jj) & 191 & * bmask(ji,jj) 192 END DO 193 END DO 194 END DO 195 ELSE 196 DO jk = 1, jpkm1 197 DO jj = 2, jpjm1 198 DO ji = fs_2, fs_jpim1 199 p_fval(jj,jk) = p_fval(jj,jk) + pva(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk) & 200 & * tmask_i(ji,jj+1) * tmask_i(ji,jj) 201 END DO 202 END DO 203 END DO 204 END IF 176 205 ! 177 206 IF(lk_mpp) THEN … … 184 213 END FUNCTION ptr_vjk 185 214 186 187 FUNCTION ptr_vtjk( pva ) RESULT ( p_fval ) 188 !!---------------------------------------------------------------------- 189 !! *** ROUTINE ptr_vtjk *** 215 FUNCTION ptr_tjk( pta, bmask ) RESULT ( p_fval ) 216 !!---------------------------------------------------------------------- 217 !! *** ROUTINE ptr_tjk *** 190 218 !! 191 219 !! ** Purpose : "zonal" mean computation of a tracer field 192 220 !! 193 !! ** Method : - i-sum of mj(p va) using the interior 2D vmask (vmask_i)221 !! ** Method : - i-sum of mj(pta) using tmask 194 222 !! multiplied by the inverse of the surface of the "zonal" ocean 195 223 !! section 196 224 !! 197 !! ** Action : - p_fval: i-k-mean poleward flux of pva 198 !!---------------------------------------------------------------------- 199 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) :: pva ! mask flux array at V-point 225 !! ** Action : - p_fval: i-k-mean poleward flux of pta 226 !!---------------------------------------------------------------------- 227 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) :: pta ! tracer flux array at T-point 228 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj), OPTIONAL :: bmask ! Optional 2D basin mask 200 229 !! 201 230 INTEGER :: ji, jj, jk ! dummy loop arguments … … 207 236 ! 208 237 p_fval(:,:) = 0.e0 209 DO jk = 1, jpkm1 210 DO jj = 2, jpjm1 211 DO ji = fs_2, fs_jpim1 ! Vector opt. 212 p_fval(jj,jk) = p_fval(jj,jk) + ( pva(ji,jj,jk) + pva(ji,jj+1,jk) ) & 213 & * e1v(ji,jj) * fse3v(ji,jj,jk) * vmask(ji,jj,jk) & 214 & * tmask_i(ji,jj+1) * tmask_i(ji,jj) 215 END DO 216 END DO 217 END DO 238 IF (PRESENT (bmask)) THEN 239 DO jk = 1, jpkm1 240 DO jj = 2, jpjm1 241 DO ji = fs_2, fs_jpim1 ! Vector opt. 242 p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) & 243 & * e1t(ji,jj) * fse3t(ji,jj,jk) & 244 & * tmask_i(ji,jj) & 245 & * bmask(ji,jj) 246 END DO 247 END DO 248 END DO 249 ELSE 250 DO jk = 1, jpkm1 251 DO jj = 2, jpjm1 252 DO ji = fs_2, fs_jpim1 ! Vector opt. 253 p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) & 254 & * e1t(ji,jj) * fse3t(ji,jj,jk) & 255 & * tmask_i(ji,jj) 256 END DO 257 END DO 258 END DO 259 END IF 218 260 p_fval(:,:) = p_fval(:,:) * 0.5 219 261 IF(lk_mpp) THEN … … 224 266 END IF 225 267 ! 226 END FUNCTION ptr_ vtjk268 END FUNCTION ptr_tjk 227 269 228 270 … … 237 279 & zpwatt, & ! conversion from W to PW 238 280 & zggram ! conversion from g to Pg 239 240 REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 241 v_atl , v_ipc, & 242 vt_atl, vt_pac, vt_ind, & 243 vs_atl, vs_pac, vs_ind 244 INTEGER :: inum ! temporary logical unit 245 !!---------------------------------------------------------------------- 246 247 IF( kt == nit000 .OR. MOD( kt - nit000 + 1, nf_ptr ) == 0 ) THEN 281 REAL(wp), DIMENSION(jpi,jpj,jpk) :: vt, vs 282 !!---------------------------------------------------------------------- 283 284 IF( kt == nit000 .OR. MOD( kt, nf_ptr ) == 0 ) THEN 248 285 249 286 zsverdrup = 1.e-6 250 287 zpwatt = 1.e-15 251 288 zggram = 1.e-6 252 253 ! "zonal" mean temperature and salinity at V-points 254 tn_jk(:,:) = ptr_vtjk( tn(:,:,:) ) * surf_jk_r(:,:) 255 sn_jk(:,:) = ptr_vtjk( sn(:,:,:) ) * surf_jk_r(:,:) 256 289 290 IF ( ln_diaznl ) THEN 291 ! "zonal" mean temperature and salinity at V-points 292 tn_jk_glo(:,:) = ptr_tjk( tn(:,:,:) ) * surf_jk_r_glo(:,:) 293 sn_jk_glo(:,:) = ptr_tjk( sn(:,:,:) ) * surf_jk_r_glo(:,:) 294 295 IF (ln_subbas) THEN 296 tn_jk_atl(:,:) = ptr_tjk( tn(:,:,:), abasin(:,:) ) * surf_jk_r_atl(:,:) 297 sn_jk_atl(:,:) = ptr_tjk( sn(:,:,:), abasin(:,:) ) * surf_jk_r_atl(:,:) 298 tn_jk_pac(:,:) = ptr_tjk( tn(:,:,:), pbasin(:,:) ) * surf_jk_r_pac(:,:) 299 sn_jk_pac(:,:) = ptr_tjk( sn(:,:,:), pbasin(:,:) ) * surf_jk_r_pac(:,:) 300 tn_jk_ind(:,:) = ptr_tjk( tn(:,:,:), ibasin(:,:) ) * surf_jk_r_ind(:,:) 301 sn_jk_ind(:,:) = ptr_tjk( sn(:,:,:), ibasin(:,:) ) * surf_jk_r_ind(:,:) 302 tn_jk_ipc(:,:) = ptr_tjk( tn(:,:,:), dbasin(:,:) ) * surf_jk_r_ipc(:,:) 303 sn_jk_ipc(:,:) = ptr_tjk( sn(:,:,:), dbasin(:,:) ) * surf_jk_r_ipc(:,:) 304 ENDIF 305 ENDIF 306 257 307 !-------------------------------------------------------- 258 308 ! overturning calculation: 259 260 IF( ln_subbas ) THEN ! Basins computation 261 262 IF( kt == nit000 ) THEN ! load sub-basin mask 263 CALL iom_open( 'subbasins', inum ) 264 CALL iom_get( inum, jpdom_data, 'atlmsk', abasin ) ! Atlantic basin 265 CALL iom_get( inum, jpdom_data, 'pacmsk', pbasin ) ! Pacific basin 266 CALL iom_get( inum, jpdom_data, 'indmsk', ibasin ) ! Indian basin 267 CALL iom_close( inum ) 268 ENDIF 269 270 ! basin separation: 271 DO jj = 1, jpj 272 DO ji = 1, jpi 273 ! basin separated velocity 274 v_atl(ji,jj,:) = vn(ji,jj,:)*abasin(ji,jj) 275 v_ipc(ji,jj,:) = vn(ji,jj,:)*(pbasin(ji,jj)+ibasin(ji,jj)) 276 277 ! basin separated T times V on T points 278 vt_ind(ji,jj,:) = tn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) )*0.5 279 vt_atl(ji,jj,:) = vt_ind(ji,jj,:) * abasin(ji,jj) 280 vt_pac(ji,jj,:) = vt_ind(ji,jj,:) * pbasin(ji,jj) 281 vt_ind(ji,jj,:) = vt_ind(ji,jj,:) * ibasin(ji,jj) 282 283 ! basin separated S times V on T points 284 vs_ind(ji,jj,:) = sn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) )*0.5 285 vs_atl(ji,jj,:) = vs_ind(ji,jj,:) * abasin(ji,jj) 286 vs_pac(ji,jj,:) = vs_ind(ji,jj,:) * pbasin(ji,jj) 287 vs_ind(ji,jj,:) = vs_ind(ji,jj,:) * ibasin(ji,jj) 288 END DO 289 END DO 290 291 ENDIF 292 309 293 310 ! horizontal integral and vertical dz 311 312 #if defined key_diaeiv 313 v_msf_glo(:,:) = ptr_vjk( vn(:,:,:)+v_eiv(:,:,:) ) 314 IF( ln_subbas .AND. ln_diaznl ) THEN 315 v_msf_atl(:,:) = ptr_vjk( vn (:,:,:)+v_eiv(:,:,:), abasin(:,:)*sbasin(:,:) ) 316 v_msf_pac(:,:) = ptr_vjk( vn (:,:,:)+v_eiv(:,:,:), pbasin(:,:)*sbasin(:,:) ) 317 v_msf_ind(:,:) = ptr_vjk( vn (:,:,:)+v_eiv(:,:,:), ibasin(:,:)*sbasin(:,:) ) 318 v_msf_ipc(:,:) = ptr_vjk( vn (:,:,:)+v_eiv(:,:,:), dbasin(:,:)*sbasin(:,:) ) 319 ENDIF 320 #else 294 321 v_msf_glo(:,:) = ptr_vjk( vn(:,:,:) ) 322 IF( ln_subbas .AND. ln_diaznl ) THEN 323 v_msf_atl(:,:) = ptr_vjk( vn (:,:,:), abasin(:,:)*sbasin(:,:) ) 324 v_msf_pac(:,:) = ptr_vjk( vn (:,:,:), pbasin(:,:)*sbasin(:,:) ) 325 v_msf_ind(:,:) = ptr_vjk( vn (:,:,:), ibasin(:,:)*sbasin(:,:) ) 326 v_msf_ipc(:,:) = ptr_vjk( vn (:,:,:), dbasin(:,:)*sbasin(:,:) ) 327 ENDIF 328 #endif 329 295 330 #if defined key_diaeiv 296 331 v_msf_eiv(:,:) = ptr_vjk( v_eiv(:,:,:) ) 297 332 #endif 298 IF( ln_subbas ) THEN 299 v_msf_atl(:,:) = ptr_vjk( v_atl (:,:,:) ) 300 v_msf_ipc(:,:) = ptr_vjk( v_ipc (:,:,:) ) 301 ht_atl(:) = SUM( ptr_vjk( vt_atl(:,:,:)), 2 ) 302 ht_pac(:) = SUM( ptr_vjk( vt_pac(:,:,:)), 2 ) 303 ht_ind(:) = SUM( ptr_vjk( vt_ind(:,:,:)), 2 ) 304 st_atl(:) = SUM( ptr_vjk( vs_atl(:,:,:)), 2 ) 305 st_pac(:) = SUM( ptr_vjk( vs_pac(:,:,:)), 2 ) 306 st_ind(:) = SUM( ptr_vjk( vs_ind(:,:,:)), 2 ) 307 ENDIF 308 333 334 ! "Meridional" Stream-Function 335 DO jk = 2,jpk 336 v_msf_glo(:,jk) = v_msf_glo(:,jk-1) + v_msf_glo(:,jk) 337 END DO 338 v_msf_glo(:,:) = v_msf_glo(:,:) * zsverdrup 339 #if defined key_diaeiv 340 ! Bolus "Meridional" Stream-Function 341 DO jk = 2,jpk 342 v_msf_eiv(:,jk) = v_msf_eiv(:,jk-1) + v_msf_eiv(:,jk) 343 END DO 344 v_msf_eiv(:,:) = v_msf_eiv(:,:) * zsverdrup 345 #endif 346 ! 347 IF( ln_subbas .AND. ln_diaznl ) THEN 348 DO jk = 2,jpk 349 v_msf_atl(:,jk) = v_msf_atl(:,jk-1) + v_msf_atl(:,jk) 350 v_msf_pac(:,jk) = v_msf_pac(:,jk-1) + v_msf_pac(:,jk) 351 v_msf_ind(:,jk) = v_msf_ind(:,jk-1) + v_msf_ind(:,jk) 352 v_msf_ipc(:,jk) = v_msf_ipc(:,jk-1) + v_msf_ipc(:,jk) 353 END DO 354 v_msf_atl(:,:) = v_msf_atl(:,:) * zsverdrup 355 v_msf_pac(:,:) = v_msf_pac(:,:) * zsverdrup 356 v_msf_ind(:,:) = v_msf_ind(:,:) * zsverdrup 357 v_msf_ipc(:,:) = v_msf_ipc(:,:) * zsverdrup 358 ENDIF 359 360 ! Transports 361 ! T times V on T points (include bolus velocities) 362 #if defined key_diaeiv 363 DO jj = 1, jpj 364 DO ji = 1, jpi 365 vt(ji,jj,:) = tn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) + u_eiv(ji,jj,:) + u_eiv(ji,jj-1,:) )*0.5 366 vs(ji,jj,:) = sn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) + v_eiv(ji,jj,:) + v_eiv(ji,jj-1,:) )*0.5 367 END DO 368 END DO 369 #else 370 DO jj = 1, jpj 371 DO ji = 1, jpi 372 vt(ji,jj,:) = tn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) )*0.5 373 vs(ji,jj,:) = sn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) )*0.5 374 END DO 375 END DO 376 #endif 377 378 ht_glo(:) = SUM( ptr_vjk( vt(:,:,:)), 2 ) 379 st_glo(:) = SUM( ptr_vjk( vs(:,:,:)), 2 ) 380 381 IF ( ln_subbas ) THEN 382 ht_atl(:) = SUM( ptr_vjk( vt (:,:,:), abasin(:,:)*sbasin(:,:)), 2 ) 383 ht_pac(:) = SUM( ptr_vjk( vt (:,:,:), pbasin(:,:)*sbasin(:,:)), 2 ) 384 ht_ind(:) = SUM( ptr_vjk( vt (:,:,:), ibasin(:,:)*sbasin(:,:)), 2 ) 385 ht_ipc(:) = SUM( ptr_vjk( vt (:,:,:), dbasin(:,:)*sbasin(:,:)), 2 ) 386 st_atl(:) = SUM( ptr_vjk( vs (:,:,:), abasin(:,:)*sbasin(:,:)), 2 ) 387 st_pac(:) = SUM( ptr_vjk( vs (:,:,:), pbasin(:,:)*sbasin(:,:)), 2 ) 388 st_ind(:) = SUM( ptr_vjk( vs (:,:,:), ibasin(:,:)*sbasin(:,:)), 2 ) 389 st_ipc(:) = SUM( ptr_vjk( vs (:,:,:), dbasin(:,:)*sbasin(:,:)), 2 ) 390 ENDIF 391 309 392 ! poleward tracer transports: 310 393 ! overturning components: 311 pht_ove(:) = SUM( v_msf_glo(:,:) * tn_jk (:,:), 2 ) ! SUM over jk312 pst_ove(:) = SUM( v_msf_glo(:,:) * sn_jk (:,:), 2 ) ! SUM over jk313 #if defined key_diaeiv 314 pht_eiv(:) = SUM( v_msf_eiv(:,:) * tn_jk (:,:), 2 ) ! SUM over jk315 pst_eiv(:) = SUM( v_msf_eiv(:,:) * sn_jk (:,:), 2 ) ! SUM over jk316 #endif 317 394 pht_ove(:) = SUM( v_msf_glo(:,:) * tn_jk_glo(:,:), 2 ) ! SUM over jk 395 pst_ove(:) = SUM( v_msf_glo(:,:) * sn_jk_glo(:,:), 2 ) ! SUM over jk 396 #if defined key_diaeiv 397 pht_eiv(:) = SUM( v_msf_eiv(:,:) * tn_jk_glo(:,:), 2 ) ! SUM over jk 398 pst_eiv(:) = SUM( v_msf_eiv(:,:) * sn_jk_glo(:,:), 2 ) ! SUM over jk 399 #endif 400 318 401 ! conversion in PW and G g 319 402 zpwatt = zpwatt * rau0 * rcp … … 332 415 ht_pac(:) = ht_pac(:) * zpwatt 333 416 ht_ind(:) = ht_ind(:) * zpwatt 417 ht_ipc(:) = ht_ipc(:) * zpwatt 334 418 st_atl(:) = st_atl(:) * zggram 335 419 st_pac(:) = st_pac(:) * zggram 336 420 st_ind(:) = st_ind(:) * zggram 337 ENDIF 338 339 ! "Meridional" Stream-Function 340 DO jk = 2,jpk 341 v_msf_glo(:,jk) = v_msf_glo(:,jk-1) + v_msf_glo(:,jk) 342 END DO 343 v_msf_glo(:,:) = v_msf_glo(:,:) * zsverdrup 344 345 #if defined key_diaeiv 346 ! Bolus "Meridional" Stream-Function 347 DO jk = 2,jpk 348 v_msf_eiv(:,jk) = v_msf_eiv(:,jk-1) + v_msf_eiv(:,jk) 349 END DO 350 v_msf_eiv(:,:) = v_msf_eiv(:,:) * zsverdrup 351 #endif 352 353 IF( ln_subbas ) THEN 354 DO jk = 2,jpk 355 v_msf_atl(:,jk) = v_msf_atl(:,jk-1) + v_msf_atl(:,jk) 356 v_msf_ipc(:,jk) = v_msf_ipc(:,jk-1) + v_msf_ipc(:,jk) 357 END DO 358 v_msf_atl(:,:) = v_msf_atl(:,:) * zsverdrup 359 v_msf_ipc(:,:) = v_msf_ipc(:,:) * zsverdrup 421 st_ipc(:) = st_ipc(:) * zggram 360 422 ENDIF 361 423 … … 377 439 !! ** Purpose : Initialization, namelist read 378 440 !!---------------------------------------------------------------------- 379 REAL(wp), DIMENSION(jpi,jpj,jpk) :: z_1 ! temporary workspace380 381 NAMELIST/namptr/ ln_diaptr, ln_subbas, nf_ptr441 NAMELIST/namptr/ ln_diaptr, ln_diaznl, ln_subbas, nf_ptr, nf_ptr_wri 442 INTEGER :: inum ! temporary logical unit 443 INTEGER, DIMENSION (1) :: iglo, iloc, iabsf, iabsl, ihals, ihale, idid 382 444 !!---------------------------------------------------------------------- 383 445 … … 395 457 WRITE(numout,*) ' Atla/Paci/Ind basins computation ln_subbas = ', ln_subbas 396 458 WRITE(numout,*) ' Frequency of computation nf_ptr = ', nf_ptr 459 WRITE(numout,*) ' Frequency of outputs nf_ptr_wri = ', nf_ptr_wri 397 460 ENDIF 398 461 462 IF( ln_subbas ) THEN ! load sub-basin mask 463 CALL iom_open( 'subbasins', inum ) 464 CALL iom_get( inum, jpdom_data, 'atlmsk', abasin ) ! Atlantic basin 465 CALL iom_get( inum, jpdom_data, 'pacmsk', pbasin ) ! Pacific basin 466 CALL iom_get( inum, jpdom_data, 'indmsk', ibasin ) ! Indian basin 467 CALL iom_close( inum ) 468 dbasin(:,:) = MAX ( pbasin(:,:), ibasin(:,:) ) 469 sbasin(:,:) = tmask (:,:,1) 470 WHERE ( gphit (:,:) < -30.e0) sbasin(:,:) = 0.e0 471 ENDIF 472 399 473 ! inverse of the ocean "zonal" v-point section 400 z_1(:,:,:) = 1.e0 401 surf_jk_r(:,:) = ptr_vtjk( z_1(:,:,:) ) 402 WHERE( surf_jk_r(:,:) /= 0.e0 ) surf_jk_r(:,:) = 1.e0 / surf_jk_r(:,:) 403 474 surf_jk_glo(:,:) = ptr_tjk( tmask(:,:,:) ) 475 surf_jk_r_glo(:,:) = 0.e0 476 WHERE( surf_jk_glo(:,:) /= 0.e0 ) surf_jk_r_glo(:,:) = 1.e0 / surf_jk_glo(:,:) 477 478 IF (ln_subbas) THEN 479 surf_jk_atl(:,:) = ptr_tjk( tmask (:,:,:), abasin(:,:) ) 480 surf_jk_r_atl(:,:) = 0.e0 481 WHERE( surf_jk_atl(:,:) /= 0.e0 ) surf_jk_r_atl(:,:) = 1.e0 / surf_jk_atl(:,:) 482 ! 483 surf_jk_pac(:,:) = ptr_tjk( tmask (:,:,:), pbasin(:,:) ) 484 surf_jk_r_pac(:,:) = 0.e0 485 WHERE( surf_jk_pac(:,:) /= 0.e0 ) surf_jk_r_pac(:,:) = 1.e0 / surf_jk_pac(:,:) 486 ! 487 surf_jk_ind(:,:) = ptr_tjk( tmask (:,:,:), ibasin(:,:) ) 488 surf_jk_r_ind(:,:) = 0.e0 489 WHERE( surf_jk_ind(:,:) /= 0.e0 ) surf_jk_r_ind(:,:) = 1.e0 / surf_jk_ind(:,:) 490 ! 491 surf_jk_ipc(:,:) = ptr_tjk( tmask (:,:,:), dbasin(:,:) ) 492 surf_jk_r_ipc(:,:) = 0.e0 493 WHERE( surf_jk_ipc(:,:) /= 0.e0 ) surf_jk_r_ipc(:,:) = 1.e0 / surf_jk_ipc(:,:) 494 END IF 495 496 497 !!---------------------------------------------------------------------- 498 499 iglo (1) = jpjglo 500 iloc (1) = nlcj 501 iabsf(1) = njmppt(narea) 502 iabsl(:) = iabsf(:) + iloc(:) - 1 503 ihals(1) = nldj - 1 504 ihale(1) = nlcj - nlej 505 idid (1) = 2 506 507 IF(lwp) THEN 508 WRITE(numout,*) 509 WRITE(numout,*) 'diaptr_init : iloc = ', iloc 510 WRITE(numout,*) '~~~~~~~~~~~ iabsf = ', iabsf 511 WRITE(numout,*) ' ihals = ', ihals 512 WRITE(numout,*) ' ihale = ', ihale 513 ENDIF 514 515 CALL flio_dom_set ( jpnij, nproc, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom_diaptr) 516 404 517 END SUBROUTINE dia_ptr_init 405 518 … … 415 528 INTEGER, INTENT(in) :: kt ! ocean time-step index 416 529 !! 417 INTEGER, SAVE :: nhoridz, ndepidzt, ndepidzw, ndex(1) 418 419 CHARACTER (len=40) :: clhstnam, clop ! temporary names 420 INTEGER :: iline, it, ji, itmod ! 530 INTEGER, SAVE :: nhoridz, ndepidzt, ndepidzw 531 INTEGER, SAVE :: ndim , ndim_atl , ndim_pac , ndim_ind , ndim_ipc 532 INTEGER, SAVE :: ndim_atl_30 , ndim_pac_30 , ndim_ind_30 , ndim_ipc_30 533 INTEGER, SAVE :: ndim_h, ndim_h_atl_30, ndim_h_pac_30, ndim_h_ind_30, ndim_h_ipc_30 534 INTEGER, SAVE, DIMENSION (jpj*jpk) :: ndex , ndex_atl , ndex_pac , ndex_ind , ndex_ipc 535 INTEGER, SAVE, DIMENSION (jpj*jpk) :: ndex_atl_30 , ndex_pac_30 , ndex_ind_30 , ndex_ipc_30 536 INTEGER, SAVE, DIMENSION (jpj) :: ndex_h, ndex_h_atl_30, ndex_h_pac_30, ndex_h_ind_30, ndex_h_ipc_30 537 538 CHARACTER (len=40) :: clhstnam, clop, clop_once, cl_comment ! temporary names 539 INTEGER :: iline, it, itmod, ji, jj, jk ! 421 540 REAL(wp) :: zsto, zout, zdt, zjulian ! temporary scalars 422 541 REAL(wp), DIMENSION(jpj) :: zphi, zfoo 423 !!---------------------------------------------------------------------- 424 542 REAL(wp), DIMENSION(jpj,jpk) :: z_1 543 !!---------------------------------------------------------------------- 544 425 545 ! define time axis 426 it = kt546 it = kt 427 547 itmod = kt - nit000 + 1 428 548 … … 430 550 ! -------------- 431 551 IF( kt == nit000 ) THEN 432 552 433 553 zdt = rdt 434 554 IF( nacc == 1 ) zdt = rdtmin … … 444 564 IF( jp_cfg == 2 ) iline = 48 ! i-line that passes near the North Pole 445 565 IF( jp_cfg == 4 ) iline = 24 ! i-line that passes near the North Pole 446 zphi(:) = 0.e0566 zphi(:) = -9999.9999e0 447 567 DO ji = mi0(iline), mi1(iline) 568 WRITE(numout,*) 'diaptr : ', nproc, narea, iline, ji, mi0(iline), mi1(iline), & 569 & mj0(jpjdta-1), mj1(jpjdta-1), mj0(jpjdta), mj1(jpjdta), '--' 570 CALL flush (numout) 448 571 zphi(:) = gphiv(ji,:) ! if iline is in the local domain 449 ! correct highest latitude for ORCA05 450 IF( jp_cfg == 05 ) zphi(jpj) = zphi(jpjm1) + (zphi(jpjm1)-zphi(jpj-2))/2. 451 IF( jp_cfg == 05 ) zphi(jpj) = MIN( zphi(jpj), 90.) 452 572 ! Correct highest latitude for some configurations - will work if domain is parallelized in J ? 573 IF( jp_cfg == 05 ) THEN 574 DO jj = mj0(jpjdta), mj1(jpjdta) 575 zphi( jj ) = zphi(jpjdta-1) + (zphi(jpjdta-1)-zphi(jpjdta-2))/2. 576 zphi( jj ) = MIN( zphi(jj), 90.) 577 END DO 578 END IF 579 IF( jp_cfg == 2 .OR. jp_cfg == 4 ) THEN 580 DO jj = mj0(jpjdta-1), mj1(jpjdta-1) 581 zphi( jj ) = 88.5e0 582 END DO 583 DO jj = mj0(jpjdta ), mj1(jpjdta ) 584 zphi( jj ) = 89.5e0 585 END DO 586 END IF 453 587 END DO 454 588 ! provide the correct zphi to all local domains 589 DO jj = 1, jpj 590 WRITE(numout,*) 'diaptr(1) ', nproc, jj, mjg(jj), zphi(jj), '--' 591 CALL flush (numout) 592 ENDDO 455 593 IF( lk_mpp ) CALL mpp_sum( zphi, jpj ) 456 594 457 595 ! ! ======================= 458 ELSE ! OTHER configurations 596 ELSE ! OTHER configurations zjulian = zjulian - adatrj 597 ! set calendar origin to the beginning of the experiment 459 598 ! ! ======================= 460 599 zphi(:) = gphiv(1,:) ! assume lat/lon coordinate, select the first i-line 461 600 ! 462 601 ENDIF 602 DO jj = 1, jpj 603 WRITE(numout,*) 'diaptr(2) ', nproc, jj, mjg(jj), zphi(jj), '--' 604 CALL flush (numout) 605 ENDDO 463 606 464 607 ! OPEN netcdf file … … 466 609 ! Define frequency of output and means 467 610 zsto = nf_ptr * zdt 468 IF( ln_mskland ) THEN ; clop = "ave(only(x))" ! put 1.e+20 on land (very expensive!!) 469 ELSE ; clop = "ave(x)" ! no use of the mask value (require less cpu time) 470 ENDIF 471 zout = nf_ptr * zdt 611 IF( ln_mskland ) THEN ! put 1.e+20 on land (very expensive!!) 612 clop = "ave(only(x))" 613 clop_once = "once(only(x))" 614 ELSE ! no use of the mask value (require less cpu time) 615 clop = "ave(x)" 616 clop_once = "once" 617 ENDIF 618 619 zout = nf_ptr_wri * zdt 472 620 zfoo(:) = 0.e0 473 621 … … 477 625 zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment 478 626 479 CALL dia_nam( clhstnam, nf_ptr , 'diaptr' )627 CALL dia_nam( clhstnam, nf_ptr_wri, 'diaptr' ) 480 628 IF(lwp)WRITE( numout,*)" Name of diaptr NETCDF file ",clhstnam 481 629 482 630 ! Horizontal grid : zphi() 483 631 CALL histbeg(clhstnam, 1, zfoo, jpj, zphi, & 484 1, 1, 1, jpj, nit000-1, zjulian, zdt, nhoridz, numptr, domain_id=nidom )632 1, 1, 1, jpj, nit000-1, zjulian, zdt, nhoridz, numptr, domain_id=nidom_diaptr ) 485 633 ! Vertical grids : gdept_0, gdepw_0 486 634 CALL histvert( numptr, "deptht", "Vertical T levels", & … … 488 636 CALL histvert( numptr, "depthw", "Vertical W levels", & 489 637 "m", jpk, gdepw_0, ndepidzw, "down" ) 490 638 639 ! 640 CALL wheneq ( jpj*jpk, MIN(surf_jk_glo(:,:), 1.e0), 1, 1., ndex , ndim ) ! Lat-Depth 641 CALL wheneq ( jpj , MIN(surf_jk_glo(:,1), 1.e0), 1, 1., ndex_h, ndim_h ) ! Lat 642 643 IF (ln_subbas) THEN 644 z_1 (:,1) = 1.0e0 645 WHERE ( gphit (jpi/2,:) .LT. -30 ) z_1 (:,1) = 0.e0 646 DO jk = 2, jpk 647 z_1 (:,jk) = z_1 (:,1) 648 END DO 649 650 CALL wheneq ( jpj*jpk, MIN(surf_jk_atl(:,:) , 1.e0), 1, 1., ndex_atl , ndim_atl ) ! Lat-Depth 651 CALL wheneq ( jpj*jpk, MIN(surf_jk_atl(:,:)*z_1(:,:), 1.e0), 1, 1., ndex_atl_30 , ndim_atl_30 ) ! Lat-Depth 652 CALL wheneq ( jpj , MIN(surf_jk_atl(:,1)*z_1(:,1), 1.e0), 1, 1., ndex_h_atl_30, ndim_h_atl_30 ) ! Lat 653 654 CALL wheneq ( jpj*jpk, MIN(surf_jk_pac(:,:) , 1.e0), 1, 1., ndex_pac , ndim_pac ) ! Lat-Depth 655 CALL wheneq ( jpj*jpk, MIN(surf_jk_pac(:,:)*z_1(:,:), 1.e0), 1, 1., ndex_pac_30 , ndim_pac_30 ) ! Lat-Depth 656 CALL wheneq ( jpj , MIN(surf_jk_pac(:,1)*z_1(:,1), 1.e0), 1, 1., ndex_h_pac_30, ndim_h_pac_30 ) ! Lat 657 658 CALL wheneq ( jpj*jpk, MIN(surf_jk_ind(:,:) , 1.e0), 1, 1., ndex_ind , ndim_ind ) ! Lat-Depth 659 CALL wheneq ( jpj*jpk, MIN(surf_jk_ind(:,:)*z_1(:,:), 1.e0), 1, 1., ndex_ind_30 , ndim_ind_30 ) ! Lat-Depth 660 CALL wheneq ( jpj , MIN(surf_jk_ind(:,1)*z_1(:,1), 1.e0), 1, 1., ndex_h_ind_30, ndim_h_ind_30 ) ! Lat 661 662 CALL wheneq ( jpj*jpk, MIN(surf_jk_ipc(:,:) , 1.e0), 1, 1., ndex_ipc , ndim_ipc ) ! Lat-Depth 663 CALL wheneq ( jpj*jpk, MIN(surf_jk_ipc(:,:)*z_1(:,:), 1.e0), 1, 1., ndex_ipc_30 , ndim_ipc_30 ) ! Lat-Depth 664 CALL wheneq ( jpj , MIN(surf_jk_ipc(:,1)*z_1(:,1), 1.e0), 1, 1., ndex_h_ipc_30, ndim_h_ipc_30 ) ! Lat 665 666 ENDIF 667 668 ! 669 #if defined key_diaeiv 670 cl_comment = ' (Bolus part included)' 671 #else 672 cl_comment = ' ' 673 #endif 491 674 ! Zonal mean T and S 492 493 CALL histdef( numptr, "zotemglo", "Zonal Mean Temperature","C" , & 494 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 495 CALL histdef( numptr, "zosalglo", "Zonal Mean Salinity","PSU" , & 496 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 497 498 ! Meridional Stream-Function (eulerian and bolus) 499 500 CALL histdef( numptr, "zomsfglo", "Meridional Stream-Function: Global","Sv" , & 675 676 IF ( ln_diaznl ) THEN 677 CALL histdef( numptr, "zotemglo", "Zonal Mean Temperature","C" , & 678 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 679 CALL histdef( numptr, "zosalglo", "Zonal Mean Salinity","PSU" , & 680 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 681 682 CALL histdef( numptr, "zosrfglo", "Zonal Mean Surface","m^2" , & 683 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout ) 684 685 IF (ln_subbas) THEN 686 CALL histdef( numptr, "zotematl", "Zonal Mean Temperature: Atlantic","C" , & 687 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 688 CALL histdef( numptr, "zosalatl", "Zonal Mean Salinity: Atlantic","PSU" , & 689 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 690 CALL histdef( numptr, "zosrfatl", "Zonal Mean Surface: Atlantic","m^2" , & 691 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout ) 692 693 CALL histdef( numptr, "zotempac", "Zonal Mean Temperature: Pacific","C" , & 694 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 695 CALL histdef( numptr, "zosalpac", "Zonal Mean Salinity: Pacific","PSU" , & 696 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 697 CALL histdef( numptr, "zosrfpac", "Zonal Mean Surface: Pacific","m^2" , & 698 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout ) 699 700 CALL histdef( numptr, "zotemind", "Zonal Mean Temperature: Indian","C" , & 701 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 702 CALL histdef( numptr, "zosalind", "Zonal Mean Salinity: Indian","PSU" , & 703 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 704 CALL histdef( numptr, "zosrfind", "Zonal Mean Surface: Indian","m^2" , & 705 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout ) 706 707 CALL histdef( numptr, "zotemipc", "Zonal Mean Temperature: Pacific+Indian","C" , & 708 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 709 CALL histdef( numptr, "zosalipc", "Zonal Mean Salinity: Pacific+Indian","PSU" , & 710 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 711 CALL histdef( numptr, "zosrfipc", "Zonal Mean Surface: Pacific+Indian","m^2" , & 712 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout ) 713 ENDIF 714 715 ENDIF 716 717 ! Meridional Stream-Function (Eulerian and Bolus) 718 719 CALL histdef( numptr, "zomsfglo", "Meridional Stream-Function: Global"//TRIM(cl_comment),"Sv" , & 501 720 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 502 IF( ln_subbas ) THEN503 CALL histdef( numptr, "zomsfatl", "Meridional Stream-Function: Atlantic" ,"Sv" , &721 IF( ln_subbas .AND. ln_diaznl ) THEN 722 CALL histdef( numptr, "zomsfatl", "Meridional Stream-Function: Atlantic"//TRIM(cl_comment),"Sv" , & 504 723 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 505 CALL histdef( numptr, "zomsfipc", "Meridional Stream-Function: Indo-Pacific","Sv" ,& 724 CALL histdef( numptr, "zomsfpac", "Meridional Stream-Function: Pacific"//TRIM(cl_comment),"Sv" , & 725 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 726 CALL histdef( numptr, "zomsfind", "Meridional Stream-Function: Indian"//TRIM(cl_comment),"Sv" , & 727 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 728 CALL histdef( numptr, "zomsfipc", "Meridional Stream-Function: Indo-Pacific"//TRIM(cl_comment),"Sv" ,& 506 729 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 507 730 ENDIF … … 516 739 "PW",1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 517 740 IF( ln_subbas ) THEN 518 CALL histdef( numptr, "sohtatl", "Heat Transport Atlantic" 741 CALL histdef( numptr, "sohtatl", "Heat Transport Atlantic"//TRIM(cl_comment), & 519 742 "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 520 CALL histdef( numptr, "sohtpac", "Heat Transport Pacific" ,&743 CALL histdef( numptr, "sohtpac", "Heat Transport Pacific"//TRIM(cl_comment) , & 521 744 "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 522 CALL histdef( numptr, "sohtind", "Heat Transport Indic" , & 745 CALL histdef( numptr, "sohtind", "Heat Transport Indian"//TRIM(cl_comment) , & 746 "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 747 CALL histdef( numptr, "sohtipc", "Heat Transport Pacific+Indian"//TRIM(cl_comment), & 523 748 "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 524 749 ENDIF … … 544 769 #endif 545 770 IF( ln_subbas ) THEN 546 CALL histdef( numptr, "sostatl", "Salt Transport Atlantic" ,&771 CALL histdef( numptr, "sostatl", "Salt Transport Atlantic"//TRIM(cl_comment) , & 547 772 "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 548 CALL histdef( numptr, "sostpac", "Salt Transport Pacific" ,&773 CALL histdef( numptr, "sostpac", "Salt Transport Pacific"//TRIM(cl_comment) , & 549 774 "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 550 CALL histdef( numptr, "sostind", "Salt Transport Indi c" ,&775 CALL histdef( numptr, "sostind", "Salt Transport Indian"//TRIM(cl_comment) , & 551 776 "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 552 ENDIF 553 777 CALL histdef( numptr, "sostipc", "Salt Transport Pacific+Indian"//TRIM(cl_comment), & 778 "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 779 ENDIF 780 554 781 CALL histend( numptr ) 555 782 … … 560 787 IF(lwp) THEN 561 788 WRITE(numout,*) 562 WRITE(numout,*) 'dia_ptr : write Poleward Transports at time-step : ', kt789 WRITE(numout,*) 'dia_ptr : compute Poleward Transports at time-step : ', kt 563 790 WRITE(numout,*) '~~~~~~~~' 564 791 WRITE(numout,*) 565 792 ENDIF 566 793 567 ndex(1) = 0 568 CALL histwrite( numptr, "zotemglo", it, tn_jk , jpj*jpk, ndex ) 569 CALL histwrite( numptr, "zosalglo", it, sn_jk , jpj*jpk, ndex ) 794 IF (ln_diaznl ) THEN 795 CALL histwrite( numptr, "zosrfglo", it, surf_jk_glo , ndim, ndex ) 796 CALL histwrite( numptr, "zotemglo", it, tn_jk_glo , ndim, ndex ) 797 CALL histwrite( numptr, "zosalglo", it, sn_jk_glo , ndim, ndex ) 798 799 IF (ln_subbas) THEN 800 CALL histwrite( numptr, "zosrfatl", it, surf_jk_atl, ndim_atl, ndex_atl ) 801 CALL histwrite( numptr, "zosrfpac", it, surf_jk_pac, ndim_pac, ndex_pac ) 802 CALL histwrite( numptr, "zosrfind", it, surf_jk_ind, ndim_ind, ndex_ind ) 803 CALL histwrite( numptr, "zosrfipc", it, surf_jk_ipc, ndim_ipc, ndex_ipc ) 804 805 CALL histwrite( numptr, "zotematl", it, tn_jk_atl , ndim_atl, ndex_atl ) 806 CALL histwrite( numptr, "zosalatl", it, sn_jk_atl , ndim_atl, ndex_atl ) 807 CALL histwrite( numptr, "zotempac", it, tn_jk_pac , ndim_pac, ndex_pac ) 808 CALL histwrite( numptr, "zosalpac", it, sn_jk_pac , ndim_pac, ndex_pac ) 809 CALL histwrite( numptr, "zotemind", it, tn_jk_ind , ndim_ind, ndex_ind ) 810 CALL histwrite( numptr, "zosalind", it, sn_jk_ind , ndim_ind, ndex_ind ) 811 CALL histwrite( numptr, "zotemipc", it, tn_jk_ipc , ndim_ipc, ndex_ipc ) 812 CALL histwrite( numptr, "zosalipc", it, sn_jk_ipc , ndim_ipc, ndex_ipc ) 813 END IF 814 ENDIF 815 570 816 ! overturning outputs: 571 CALL histwrite( numptr, "zomsfglo", it, v_msf_glo , jpj*jpk, ndex ) 572 IF( ln_subbas ) THEN 573 CALL histwrite( numptr, "zomsfatl", it, v_msf_atl , jpj*jpk, ndex ) 574 CALL histwrite( numptr, "zomsfipc", it, v_msf_ipc , jpj*jpk, ndex ) 575 ENDIF 576 ! heat transport outputs: 577 IF( ln_subbas ) THEN 578 CALL histwrite( numptr, "sohtatl", it, ht_atl , jpj, ndex ) 579 CALL histwrite( numptr, "sohtpac", it, ht_pac , jpj, ndex ) 580 CALL histwrite( numptr, "sohtind", it, ht_ind , jpj, ndex ) 581 CALL histwrite( numptr, "sostatl", it, st_atl , jpj, ndex ) 582 CALL histwrite( numptr, "sostpac", it, st_pac , jpj, ndex ) 583 CALL histwrite( numptr, "sostind", it, st_ind , jpj, ndex ) 584 ENDIF 585 586 CALL histwrite( numptr, "sophtadv", it, pht_adv , jpj, ndex ) 587 CALL histwrite( numptr, "sophtldf", it, pht_ldf , jpj, ndex ) 588 CALL histwrite( numptr, "sophtove", it, pht_ove , jpj, ndex ) 589 CALL histwrite( numptr, "sopstadv", it, pst_adv , jpj, ndex ) 590 CALL histwrite( numptr, "sopstldf", it, pst_ldf , jpj, ndex ) 591 CALL histwrite( numptr, "sopstove", it, pst_ove , jpj, ndex ) 592 #if defined key_diaeiv 593 CALL histwrite( numptr, "zomsfeiv", it, v_msf_eiv, jpj*jpk, ndex ) 594 CALL histwrite( numptr, "sophteiv", it, pht_eiv , jpj , ndex ) 595 CALL histwrite( numptr, "sopsteiv", it, pst_eiv , jpj , ndex ) 596 #endif 597 817 CALL histwrite( numptr, "zomsfglo", it, v_msf_glo, ndim, ndex ) 818 IF( ln_subbas .AND. ln_diaznl ) THEN 819 CALL histwrite( numptr, "zomsfatl", it, v_msf_atl , ndim_atl_30, ndex_atl_30 ) 820 CALL histwrite( numptr, "zomsfpac", it, v_msf_pac , ndim_pac_30, ndex_pac_30 ) 821 CALL histwrite( numptr, "zomsfind", it, v_msf_ind , ndim_ind_30, ndex_ind_30 ) 822 CALL histwrite( numptr, "zomsfipc", it, v_msf_ipc , ndim_ipc_30, ndex_ipc_30 ) 823 ENDIF 824 #if defined key_diaeiv 825 CALL histwrite( numptr, "zomsfeiv", it, v_msf_eiv, ndim , ndex ) 826 #endif 827 598 828 ENDIF 829 830 ! heat transport outputs: 831 IF( ln_subbas ) THEN 832 CALL histwrite( numptr, "sohtatl", it, ht_atl , ndim_h_atl_30, ndex_h_atl_30 ) 833 CALL histwrite( numptr, "sohtpac", it, ht_pac , ndim_h_pac_30, ndex_h_pac_30 ) 834 CALL histwrite( numptr, "sohtind", it, ht_ind , ndim_h_ind_30, ndex_h_ind_30 ) 835 CALL histwrite( numptr, "sohtipc", it, ht_ipc , ndim_h_ipc_30, ndex_h_ipc_30 ) 836 CALL histwrite( numptr, "sostatl", it, st_atl , ndim_h_atl_30, ndex_h_atl_30 ) 837 CALL histwrite( numptr, "sostpac", it, st_pac , ndim_h_pac_30, ndex_h_pac_30 ) 838 CALL histwrite( numptr, "sostind", it, st_ind , ndim_h_ind_30, ndex_h_ind_30 ) 839 CALL histwrite( numptr, "sostipc", it, st_ipc , ndim_h_ipc_30, ndex_h_ipc_30 ) 840 ENDIF 841 842 CALL histwrite( numptr, "sophtadv", it, pht_adv , ndim_h, ndex_h ) 843 CALL histwrite( numptr, "sophtldf", it, pht_ldf , ndim_h, ndex_h ) 844 CALL histwrite( numptr, "sophtove", it, pht_ove , ndim_h, ndex_h ) 845 CALL histwrite( numptr, "sopstadv", it, pst_adv , ndim_h, ndex_h ) 846 CALL histwrite( numptr, "sopstldf", it, pst_ldf , ndim_h, ndex_h ) 847 CALL histwrite( numptr, "sopstove", it, pst_ove , ndim_h, ndex_h ) 848 #if defined key_diaeiv 849 CALL histwrite( numptr, "sophteiv", it, pht_eiv , ndim_h, ndex_h ) 850 CALL histwrite( numptr, "sopsteiv", it, pst_eiv , ndim_h, ndex_h ) 851 #endif 852 599 853 ! 600 854 END SUBROUTINE dia_ptr_wri
Note: See TracChangeset
for help on using the changeset viewer.
