Changeset 1345 for trunk/NEMO/OPA_SRC/DIA/diaptr.F90
- Timestamp:
- 2009-03-27T15:49:55+01:00 (15 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/DIA/diaptr.F90 (modified) (18 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/DIA/diaptr.F90
r1340 r1345 6 6 !! History : 9.0 ! 03-09 (C. Talandier, G. Madec) Original code 7 7 !! 9.0 ! 06-01 (A. Biastoch) Allow sub-basins computation 8 !! 9.0 ! 03-09 (O. Marti) Add fields 8 9 !!---------------------------------------------------------------------- 9 10 … … 43 44 LOGICAL , PUBLIC :: ln_diaptr = .FALSE. !: Poleward transport flag (T) or not (F) 44 45 LOGICAL , PUBLIC :: ln_subbas = .FALSE. !: Atlantic/Pacific/Indian basins calculation 45 LOGICAL , PUBLIC :: ln_diaznl !: Add zonal means and meridional stream functions 46 LOGICAL , PUBLIC :: ln_diaznl = .FALSE. !: Add zonal means and meridional stream functions 47 LOGICAL , PUBLIC :: ln_ptrcomp = .FALSE. !: Add decomposition : overturning (and gyre, soon ...) 46 48 INTEGER , PUBLIC :: nf_ptr = 15 !: frequency of ptr computation 47 49 INTEGER , PUBLIC :: nf_ptr_wri = 15 !: frequency of ptr outputs 48 50 49 REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_adv, pst_adv !: heat and salt poleward transport: advection 50 REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_ove, pst_ove !: heat and salt poleward transport: overturning 51 REAL(wp), DIMENSION(jpi,jpj), PUBLIC :: abasin, pbasin, ibasin, dbasin, sbasin !: Sub basin masks 52 53 REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_adv, pst_adv !: heat and salt poleward transport: advection 54 REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_ove_glo, pst_ove_glo, pht_ove_atl, pst_ove_atl, pht_ove_pac, pst_ove_pac, & 55 & pht_ove_ind, pst_ove_ind, pht_ove_ipc, pst_ove_ipc !: heat and salt poleward transport: overturning 51 56 REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_ldf, pst_ldf !: heat and salt poleward transport: lateral diffusion 52 57 #if defined key_diaeiv 53 REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_eiv, pst_eiv !: heat and salt poleward transport: bolus advection 58 REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_eiv_glo, pst_eiv_glo, pht_eiv_atl, pst_eiv_atl, pht_eiv_pac, pst_eiv_pac, & 59 & pht_eiv_ind, pst_eiv_ind, pht_eiv_ipc, pst_eiv_ipc !: heat and salt poleward transport: bolus advection 54 60 #endif 55 61 REAL(wp), PUBLIC, DIMENSION(jpj) :: ht_glo,ht_atl,ht_ind,ht_pac,ht_ipc !: heat 56 62 REAL(wp), PUBLIC, DIMENSION(jpj) :: st_glo,st_atl,st_ind,st_pac,st_ipc !: salt 57 63 58 INTEGER :: nidom_diaptr ! domain identifier for IOIPSL 64 INTEGER :: nidom_diaptr = FLIO_DOM_NONE ! domain identifier for IOIPSL 65 INTEGER :: niter 59 66 60 67 REAL(wp), DIMENSION(jpj,jpk) :: tn_jk_glo, sn_jk_glo, & !: "zonal" mean temperature and salinity … … 79 86 & surf_jk_r_ipc 80 87 #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 84 88 REAL(wp), DIMENSION(jpj,jpk) :: v_msf_eiv_glo, v_msf_eiv_atl, v_msf_eiv_pac, v_msf_eiv_ind, v_msf_eiv_ipc !: bolus "meridional" Stream-Function 89 #endif 90 85 91 !! * Substitutions 86 92 # include "domzgr_substitute.h90" … … 123 129 END DO 124 130 ! 125 IF( lk_mpp ) CALL mpp_sum( p_fval, ijpj 131 IF( lk_mpp ) CALL mpp_sum( p_fval, ijpj, ncomm_znl) !!bug I presume 126 132 ! 127 133 END FUNCTION ptr_vj_3d … … 150 156 p_fval(:) = 0.e0 151 157 DO jj = 2, jpjm1 152 DO ji = fs_2, fs_jpim1 ! Vector opt.158 DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ? 153 159 p_fval(jj) = p_fval(jj) + pva(ji,jj) * tmask_i(ji,jj+1) * tmask_i(ji,jj) 154 160 END DO 155 161 END DO 156 162 ! 157 IF( lk_mpp ) CALL mpp_sum( p_fval, ijpj ) !!bug I presume163 IF( lk_mpp ) CALL mpp_sum( p_fval, ijpj, ncomm_znl ) !!bug I presume 158 164 ! 159 165 END FUNCTION ptr_vj_2d … … 186 192 DO jk = 1, jpkm1 187 193 DO jj = 2, jpjm1 188 DO ji = fs_2, fs_jpim1194 DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ? 189 195 p_fval(jj,jk) = p_fval(jj,jk) + pva(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk) & 190 196 & * tmask_i(ji,jj+1) * tmask_i(ji,jj) & … … 196 202 DO jk = 1, jpkm1 197 203 DO jj = 2, jpjm1 198 DO ji = fs_2, fs_jpim1204 DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ? 199 205 p_fval(jj,jk) = p_fval(jj,jk) + pva(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk) & 200 206 & * tmask_i(ji,jj+1) * tmask_i(ji,jj) … … 207 213 ish(1) = jpj*jpk ; ish2(1) = jpj ; ish2(2) = jpk 208 214 zwork(:)= RESHAPE( p_fval, ish ) 209 CALL mpp_sum( zwork, jpj*jpk )215 CALL mpp_sum( zwork, jpj*jpk, ncomm_znl ) 210 216 p_fval(:,:)= RESHAPE( zwork, ish2 ) 211 217 END IF … … 239 245 DO jk = 1, jpkm1 240 246 DO jj = 2, jpjm1 241 DO ji = fs_2, fs_jpim1 ! Vector opt.247 DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ? 242 248 p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) & 243 249 & * e1t(ji,jj) * fse3t(ji,jj,jk) & … … 250 256 DO jk = 1, jpkm1 251 257 DO jj = 2, jpjm1 252 DO ji = fs_2, fs_jpim1 ! Vector opt.258 DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ? 253 259 p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) & 254 260 & * e1t(ji,jj) * fse3t(ji,jj,jk) & … … 262 268 ish(1) = jpj*jpk ; ish2(1) = jpj ; ish2(2) = jpk 263 269 zwork(:)= RESHAPE( p_fval, ish ) 264 CALL mpp_sum( zwork, jpj*jpk )270 CALL mpp_sum( zwork, jpj*jpk, ncomm_znl ) 265 271 p_fval(:,:)= RESHAPE(zwork,ish2) 266 272 END IF … … 284 290 IF( kt == nit000 .OR. MOD( kt, nf_ptr ) == 0 ) THEN 285 291 286 zsverdrup = 1.e-6 287 zpwatt = 1.e-15 288 zggram = 1.e-6 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 307 !-------------------------------------------------------- 308 ! overturning calculation: 309 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 292 IF ( MOD( kt, nf_ptr ) == 0 ) THEN 293 294 zsverdrup = 1.e-6 295 zpwatt = 1.e-15 296 zggram = 1.e-6 297 298 IF ( ln_diaznl ) THEN 299 ! "zonal" mean temperature and salinity at V-points 300 tn_jk_glo(:,:) = ptr_tjk( tn(:,:,:) ) * surf_jk_r_glo(:,:) 301 sn_jk_glo(:,:) = ptr_tjk( sn(:,:,:) ) * surf_jk_r_glo(:,:) 302 303 IF (ln_subbas) THEN 304 tn_jk_atl(:,:) = ptr_tjk( tn(:,:,:), abasin(:,:) ) * surf_jk_r_atl(:,:) 305 sn_jk_atl(:,:) = ptr_tjk( sn(:,:,:), abasin(:,:) ) * surf_jk_r_atl(:,:) 306 tn_jk_pac(:,:) = ptr_tjk( tn(:,:,:), pbasin(:,:) ) * surf_jk_r_pac(:,:) 307 sn_jk_pac(:,:) = ptr_tjk( sn(:,:,:), pbasin(:,:) ) * surf_jk_r_pac(:,:) 308 tn_jk_ind(:,:) = ptr_tjk( tn(:,:,:), ibasin(:,:) ) * surf_jk_r_ind(:,:) 309 sn_jk_ind(:,:) = ptr_tjk( sn(:,:,:), ibasin(:,:) ) * surf_jk_r_ind(:,:) 310 tn_jk_ipc(:,:) = ptr_tjk( tn(:,:,:), dbasin(:,:) ) * surf_jk_r_ipc(:,:) 311 sn_jk_ipc(:,:) = ptr_tjk( sn(:,:,:), dbasin(:,:) ) * surf_jk_r_ipc(:,:) 312 ENDIF 313 ENDIF 314 315 !-------------------------------------------------------- 316 ! overturning calculation: 317 318 ! horizontal integral and vertical dz 319 320 #if defined key_diaeiv 321 v_msf_glo(:,:) = ptr_vjk( vn(:,:,:)+v_eiv(:,:,:) ) 322 IF( ln_subbas .AND. ln_diaznl ) THEN 323 v_msf_atl(:,:) = ptr_vjk( vn (:,:,:)+v_eiv(:,:,:), abasin(:,:)*sbasin(:,:) ) 324 v_msf_pac(:,:) = ptr_vjk( vn (:,:,:)+v_eiv(:,:,:), pbasin(:,:)*sbasin(:,:) ) 325 v_msf_ind(:,:) = ptr_vjk( vn (:,:,:)+v_eiv(:,:,:), ibasin(:,:)*sbasin(:,:) ) 326 v_msf_ipc(:,:) = ptr_vjk( vn (:,:,:)+v_eiv(:,:,:), dbasin(:,:)*sbasin(:,:) ) 327 ENDIF 320 328 #else 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 330 #if defined key_diaeiv 331 v_msf_eiv(:,:) = ptr_vjk( v_eiv(:,:,:) ) 332 #endif 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 329 v_msf_glo(:,:) = ptr_vjk( vn(:,:,:) ) 330 IF( ln_subbas .AND. ln_diaznl ) THEN 331 v_msf_atl(:,:) = ptr_vjk( vn (:,:,:), abasin(:,:)*sbasin(:,:) ) 332 v_msf_pac(:,:) = ptr_vjk( vn (:,:,:), pbasin(:,:)*sbasin(:,:) ) 333 v_msf_ind(:,:) = ptr_vjk( vn (:,:,:), ibasin(:,:)*sbasin(:,:) ) 334 v_msf_ipc(:,:) = ptr_vjk( vn (:,:,:), dbasin(:,:)*sbasin(:,:) ) 335 ENDIF 336 #endif 337 338 #if defined key_diaeiv 339 v_msf_eiv_glo(:,:) = ptr_vjk( v_eiv(:,:,:) ) 340 IF (ln_subbas ) THEN 341 v_msf_eiv_atl(:,:) = ptr_vjk( v_eiv(:,:,:), abasin(:,:)*sbasin(:,:) ) 342 v_msf_eiv_pac(:,:) = ptr_vjk( v_eiv(:,:,:), pbasin(:,:)*sbasin(:,:) ) 343 v_msf_eiv_ind(:,:) = ptr_vjk( v_eiv(:,:,:), ibasin(:,:)*sbasin(:,:) ) 344 v_msf_eiv_ipc(:,:) = ptr_vjk( v_eiv(:,:,:), dbasin(:,:)*sbasin(:,:) ) 345 END IF 346 #endif 347 348 ! "Meridional" Stream-Function 348 349 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) 350 v_msf_glo(:,jk) = v_msf_glo(:,jk-1) + v_msf_glo(:,jk) 353 351 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) 352 v_msf_glo(:,:) = v_msf_glo(:,:) * zsverdrup 353 #if defined key_diaeiv 354 ! Bolus "Meridional" Stream-Function 355 DO jk = 2,jpk 356 v_msf_eiv_glo(:,jk) = v_msf_eiv_glo(:,jk-1) + v_msf_eiv_glo(:,jk) 357 END DO 358 v_msf_eiv_glo(:,:) = v_msf_eiv_glo(:,:) * zsverdrup 359 IF ( ln_subbas ) THEN 360 DO jk = 2,jpk 361 v_msf_eiv_atl(:,jk) = v_msf_eiv_atl(:,jk-1) + v_msf_eiv_atl(:,jk) 362 v_msf_eiv_pac(:,jk) = v_msf_eiv_pac(:,jk-1) + v_msf_eiv_pac(:,jk) 363 v_msf_eiv_ind(:,jk) = v_msf_eiv_ind(:,jk-1) + v_msf_eiv_ind(:,jk) 364 v_msf_eiv_ipc(:,jk) = v_msf_eiv_ipc(:,jk-1) + v_msf_eiv_ipc(:,jk) 365 END DO 366 ENDIF 367 #endif 368 ! 369 IF( ln_subbas .AND. ln_diaznl ) THEN 370 DO jk = 2,jpk 371 v_msf_atl(:,jk) = v_msf_atl(:,jk-1) + v_msf_atl(:,jk) 372 v_msf_pac(:,jk) = v_msf_pac(:,jk-1) + v_msf_pac(:,jk) 373 v_msf_ind(:,jk) = v_msf_ind(:,jk-1) + v_msf_ind(:,jk) 374 v_msf_ipc(:,jk) = v_msf_ipc(:,jk-1) + v_msf_ipc(:,jk) 375 END DO 376 v_msf_atl(:,:) = v_msf_atl(:,:) * zsverdrup 377 v_msf_pac(:,:) = v_msf_pac(:,:) * zsverdrup 378 v_msf_ind(:,:) = v_msf_ind(:,:) * zsverdrup 379 v_msf_ipc(:,:) = v_msf_ipc(:,:) * zsverdrup 380 ENDIF 381 382 ! Transports 383 ! T times V on T points (include bolus velocities) 362 384 #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 385 DO jj = 1, jpj 386 DO ji = 1, jpi 387 vt(ji,jj,:) = tn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) + u_eiv(ji,jj,:) + u_eiv(ji,jj-1,:) )*0.5 388 vs(ji,jj,:) = sn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) + v_eiv(ji,jj,:) + v_eiv(ji,jj-1,:) )*0.5 389 END DO 367 390 END DO 368 END DO369 391 #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 392 DO jj = 1, jpj 393 DO ji = 1, jpi 394 vt(ji,jj,:) = tn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) )*0.5 395 vs(ji,jj,:) = sn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) )*0.5 396 END DO 374 397 END DO 375 END DO376 398 #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 392 ! poleward tracer transports: 393 ! overturning components: 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 401 ! conversion in PW and G g 402 zpwatt = zpwatt * rau0 * rcp 403 pht_adv(:) = pht_adv(:) * zpwatt 404 pht_ove(:) = pht_ove(:) * zpwatt 405 pht_ldf(:) = pht_ldf(:) * zpwatt 406 pst_adv(:) = pst_adv(:) * zggram 407 pst_ove(:) = pst_ove(:) * zggram 408 pst_ldf(:) = pst_ldf(:) * zggram 409 #if defined key_diaeiv 410 pht_eiv(:) = pht_eiv(:) * zpwatt 411 pst_eiv(:) = pst_eiv(:) * zggram 412 #endif 413 IF( ln_subbas ) THEN 414 ht_atl(:) = ht_atl(:) * zpwatt 415 ht_pac(:) = ht_pac(:) * zpwatt 416 ht_ind(:) = ht_ind(:) * zpwatt 417 ht_ipc(:) = ht_ipc(:) * zpwatt 418 st_atl(:) = st_atl(:) * zggram 419 st_pac(:) = st_pac(:) * zggram 420 st_ind(:) = st_ind(:) * zggram 421 st_ipc(:) = st_ipc(:) * zggram 399 400 ht_glo(:) = SUM( ptr_vjk( vt(:,:,:)), 2 ) 401 st_glo(:) = SUM( ptr_vjk( vs(:,:,:)), 2 ) 402 403 IF ( ln_subbas ) THEN 404 ht_atl(:) = SUM( ptr_vjk( vt (:,:,:), abasin(:,:)*sbasin(:,:)), 2 ) 405 ht_pac(:) = SUM( ptr_vjk( vt (:,:,:), pbasin(:,:)*sbasin(:,:)), 2 ) 406 ht_ind(:) = SUM( ptr_vjk( vt (:,:,:), ibasin(:,:)*sbasin(:,:)), 2 ) 407 ht_ipc(:) = SUM( ptr_vjk( vt (:,:,:), dbasin(:,:)*sbasin(:,:)), 2 ) 408 st_atl(:) = SUM( ptr_vjk( vs (:,:,:), abasin(:,:)*sbasin(:,:)), 2 ) 409 st_pac(:) = SUM( ptr_vjk( vs (:,:,:), pbasin(:,:)*sbasin(:,:)), 2 ) 410 st_ind(:) = SUM( ptr_vjk( vs (:,:,:), ibasin(:,:)*sbasin(:,:)), 2 ) 411 st_ipc(:) = SUM( ptr_vjk( vs (:,:,:), dbasin(:,:)*sbasin(:,:)), 2 ) 412 ENDIF 413 414 ! poleward tracer transports: 415 ! overturning components: 416 IF ( ln_ptrcomp ) THEN 417 pht_ove_glo(:) = SUM( v_msf_glo(:,:) * tn_jk_glo(:,:), 2 ) ! SUM over jk 418 pst_ove_glo(:) = SUM( v_msf_glo(:,:) * sn_jk_glo(:,:), 2 ) 419 IF ( ln_subbas ) THEN 420 pht_ove_atl(:) = SUM( v_msf_atl(:,:) * tn_jk_atl(:,:), 2 ) ! SUM over jk 421 pst_ove_atl(:) = SUM( v_msf_atl(:,:) * sn_jk_atl(:,:), 2 ) 422 pht_ove_pac(:) = SUM( v_msf_pac(:,:) * tn_jk_pac(:,:), 2 ) ! SUM over jk 423 pst_ove_pac(:) = SUM( v_msf_pac(:,:) * sn_jk_pac(:,:), 2 ) 424 pht_ove_ind(:) = SUM( v_msf_ind(:,:) * tn_jk_ind(:,:), 2 ) ! SUM over jk 425 pst_ove_ind(:) = SUM( v_msf_ind(:,:) * sn_jk_ind(:,:), 2 ) 426 pht_ove_ipc(:) = SUM( v_msf_ipc(:,:) * tn_jk_ipc(:,:), 2 ) ! SUM over jk 427 pst_ove_ipc(:) = SUM( v_msf_ipc(:,:) * sn_jk_ipc(:,:), 2 ) 428 END IF 429 END IF 430 431 ! Bolus component 432 #if defined key_diaeiv 433 pht_eiv_glo(:) = SUM( v_msf_eiv_glo(:,:) * tn_jk_glo(:,:), 2 ) ! SUM over jk 434 pst_eiv_glo(:) = SUM( v_msf_eiv_glo(:,:) * sn_jk_glo(:,:), 2 ) ! SUM over jk 435 IF ( ln_subbas ) THEN 436 pht_eiv_atl(:) = SUM( v_msf_eiv_glo(:,:) * tn_jk_atl(:,:), 2 ) ! SUM over jk 437 pst_eiv_atl(:) = SUM( v_msf_eiv_glo(:,:) * sn_jk_atl(:,:), 2 ) ! SUM over jk 438 pht_eiv_pac(:) = SUM( v_msf_eiv_pac(:,:) * tn_jk_pac(:,:), 2 ) ! SUM over jk 439 pst_eiv_pac(:) = SUM( v_msf_eiv_pac(:,:) * sn_jk_pac(:,:), 2 ) ! SUM over jk 440 pht_eiv_ind(:) = SUM( v_msf_eiv_ind(:,:) * tn_jk_ind(:,:), 2 ) ! SUM over jk 441 pst_eiv_ind(:) = SUM( v_msf_eiv_ind(:,:) * sn_jk_ind(:,:), 2 ) ! SUM over jk 442 pht_eiv_ipc(:) = SUM( v_msf_eiv_ipc(:,:) * tn_jk_ipc(:,:), 2 ) ! SUM over jk 443 pst_eiv_ipc(:) = SUM( v_msf_eiv_ipc(:,:) * sn_jk_ipc(:,:), 2 ) ! SUM over jk 444 ENDIF 445 #endif 446 447 ! conversion in PW and G g 448 zpwatt = zpwatt * rau0 * rcp 449 pht_adv(:) = pht_adv(:) * zpwatt 450 pht_ldf(:) = pht_ldf(:) * zpwatt 451 pst_adv(:) = pst_adv(:) * zggram 452 pst_ldf(:) = pst_ldf(:) * zggram 453 IF ( ln_ptrcomp ) THEN 454 pht_ove_glo(:) = pht_ove_glo(:) * zpwatt 455 pst_ove_glo(:) = pst_ove_glo(:) * zggram 456 END IF 457 #if defined key_diaeiv 458 pht_eiv_glo(:) = pht_eiv_glo(:) * zpwatt 459 pst_eiv_glo(:) = pst_eiv_glo(:) * zggram 460 #endif 461 IF( ln_subbas ) THEN 462 ht_atl(:) = ht_atl(:) * zpwatt 463 ht_pac(:) = ht_pac(:) * zpwatt 464 ht_ind(:) = ht_ind(:) * zpwatt 465 ht_ipc(:) = ht_ipc(:) * zpwatt 466 st_atl(:) = st_atl(:) * zggram 467 st_pac(:) = st_pac(:) * zggram 468 st_ind(:) = st_ind(:) * zggram 469 st_ipc(:) = st_ipc(:) * zggram 470 ENDIF 422 471 ENDIF 423 472 … … 439 488 !! ** Purpose : Initialization, namelist read 440 489 !!---------------------------------------------------------------------- 441 NAMELIST/namptr/ ln_diaptr, ln_diaznl, ln_subbas, nf_ptr, nf_ptr_wri442 INTEGER :: 490 NAMELIST/namptr/ ln_diaptr, ln_diaznl, ln_subbas, ln_ptrcomp, nf_ptr, nf_ptr_wri 491 INTEGER :: inum ! temporary logical unit 443 492 INTEGER, DIMENSION (1) :: iglo, iloc, iabsf, iabsl, ihals, ihale, idid 444 493 !!---------------------------------------------------------------------- … … 458 507 WRITE(numout,*) ' Frequency of computation nf_ptr = ', nf_ptr 459 508 WRITE(numout,*) ' Frequency of outputs nf_ptr_wri = ', nf_ptr_wri 509 ENDIF 510 511 ! 512 ! Define MPI communicator for zonal sum 513 ! 514 IF( lk_mpp ) THEN 515 CALL mpp_ini_znl 460 516 ENDIF 461 517 … … 505 561 idid (1) = 2 506 562 507 IF(lwp) THEN508 WRITE(numout,*)509 WRITE(numout,*) 'diaptr_init : iloc = ', iloc510 WRITE(numout,*) '~~~~~~~~~~~ iabsf = ', iabsf511 WRITE(numout,*) 'ihals = ', ihals512 WRITE(numout,*) 'ihale = ', ihale513 ENDIF 514 515 CALL flio_dom_set ( jpn ij, nproc, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom_diaptr)563 !-$$ IF(lwp) THEN 564 !-$$ WRITE(numout,*) 565 !-$$ WRITE(numout,*) 'dia_ptr_init : iloc = ', iloc 566 !-$$ WRITE(numout,*) '~~~~~~~~~~~~ iabsf = ', iabsf 567 !-$$ WRITE(numout,*) ' ihals = ', ihals 568 !-$$ WRITE(numout,*) ' ihale = ', ihale 569 !-$$ ENDIF 570 571 CALL flio_dom_set ( jpnj, nproc/jpni, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom_diaptr) 516 572 517 573 END SUBROUTINE dia_ptr_init … … 544 600 545 601 ! define time axis 546 it = kt 602 it = kt / nf_ptr 547 603 itmod = kt - nit000 + 1 604 605 !-$$ IF(lwp) THEN 606 !-$$ WRITE(numout,*) 607 !-$$ WRITE(numout,*) 'dia_ptr_wri : kt = ', kt, 'it = ', it, ' itmod = ', itmod, ' niter = ', niter 608 !-$$ WRITE(numout,*) '~~~~~~~~~~~~' 609 !-$$ ENDIF 548 610 549 611 ! Initialization 550 612 ! -------------- 551 613 IF( kt == nit000 ) THEN 614 615 niter = (nit000 - 1) / nf_ptr 616 617 !-$$ IF(lwp) THEN 618 !-$$ WRITE(numout,*) 619 !-$$ WRITE(numout,*) 'dia_ptr_wri : poleward transport and msf writing: initialization , niter = ', niter 620 !-$$ WRITE(numout,*) '~~~~~~~~~~~~' 621 !-$$ ENDIF 552 622 553 623 zdt = rdt … … 562 632 IF( jp_cfg == 05 ) iline = 192 ! i-line that passes near the North Pole 563 633 IF( jp_cfg == 025 ) iline = 384 ! i-line that passes near the North Pole 634 IF( jp_cfg == 1 ) iline = 96 ! i-line that passes near the North Pole 564 635 IF( jp_cfg == 2 ) iline = 48 ! i-line that passes near the North Pole 565 636 IF( jp_cfg == 4 ) iline = 24 ! i-line that passes near the North Pole 566 zphi(:) = -9999.9999e0637 zphi(:) = 0.e0 567 638 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)571 639 zphi(:) = gphiv(ji,:) ! if iline is in the local domain 572 640 ! Correct highest latitude for some configurations - will work if domain is parallelized in J ? 573 641 IF( jp_cfg == 05 ) THEN 574 642 DO jj = mj0(jpjdta), mj1(jpjdta) 575 zphi( jj ) = zphi( jpjdta-1) + (zphi(jpjdta-1)-zphi(jpjdta-2))/2.643 zphi( jj ) = zphi(mj0(jpjdta-1)) + (zphi(mj0(jpjdta-1))-zphi(mj0(jpjdta-2)))/2. 576 644 zphi( jj ) = MIN( zphi(jj), 90.) 577 645 END DO 578 646 END IF 579 IF( jp_cfg == 2 .OR. jp_cfg == 4 ) THEN647 IF( jp_cfg == 1 .OR. jp_cfg == 2 .OR. jp_cfg == 4 ) THEN 580 648 DO jj = mj0(jpjdta-1), mj1(jpjdta-1) 581 649 zphi( jj ) = 88.5e0 … … 587 655 END DO 588 656 ! 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 593 IF( lk_mpp ) CALL mpp_sum( zphi, jpj ) 657 IF( lk_mpp ) CALL mpp_sum( zphi, jpj, ncomm_znl ) 594 658 595 659 ! ! ======================= 596 660 ELSE ! OTHER configurations zjulian = zjulian - adatrj 597 661 ! set calendar origin to the beginning of the experiment 598 662 ! ! ======================= 599 663 zphi(:) = gphiv(1,:) ! assume lat/lon coordinate, select the first i-line 600 664 ! 601 665 ENDIF 602 DO jj = 1, jpj603 WRITE(numout,*) 'diaptr(2) ', nproc, jj, mjg(jj), zphi(jj), '--'604 CALL flush (numout)605 ENDDO606 607 ! OPEN netcdf file608 ! ----------------609 ! Define frequency of output and means610 zsto = nf_ptr * zdt611 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 ENDIF618 619 zout = nf_ptr_wri * zdt620 zfoo(:) = 0.e0621 622 ! Compute julian date from starting date of the run623 624 CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian )625 zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment626 627 CALL dia_nam( clhstnam, nf_ptr_wri, 'diaptr' )628 IF(lwp)WRITE( numout,*)" Name of diaptr NETCDF file ",clhstnam629 630 ! Horizontal grid : zphi()631 CALL histbeg(clhstnam, 1, zfoo, jpj, zphi, &632 1, 1, 1, jpj, nit000-1, zjulian, zdt, nhoridz, numptr, domain_id=nidom_diaptr )633 ! Vertical grids : gdept_0, gdepw_0634 CALL histvert( numptr, "deptht", "Vertical T levels", &635 "m", jpk, gdept_0, ndepidzt, "down" )636 CALL histvert( numptr, "depthw", "Vertical W levels", &637 "m", jpk, gdepw_0, ndepidzw, "down" )638 639 666 ! 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)' 667 ! Work only on westmost processor (will not work if mppini2 is used) 668 IF ( l_znl_root ) THEN 669 ! 670 ! OPEN netcdf file 671 ! ---------------- 672 ! Define frequency of output and means 673 zsto = nf_ptr * zdt 674 IF( ln_mskland ) THEN ! put 1.e+20 on land (very expensive!!) 675 clop = "ave(only(x))" 676 clop_once = "once(only(x))" 677 ELSE ! no use of the mask value (require less cpu time) 678 clop = "ave(x)" 679 clop_once = "once" 680 ENDIF 681 682 zout = nf_ptr_wri * zdt 683 zfoo(:) = 0.e0 684 685 ! Compute julian date from starting date of the run 686 687 CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian ) 688 zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment 689 690 CALL dia_nam( clhstnam, nf_ptr_wri, 'diaptr' ) 691 IF(lwp)WRITE( numout,*)" Name of diaptr NETCDF file : ", clhstnam 692 693 ! Horizontal grid : zphi() 694 CALL histbeg(clhstnam, 1, zfoo, jpj, zphi, & 695 1, 1, 1, jpj, niter, zjulian, zdt*nf_ptr, nhoridz, numptr, domain_id=nidom_diaptr ) 696 ! Vertical grids : gdept_0, gdepw_0 697 CALL histvert( numptr, "deptht", "Vertical T levels", & 698 "m", jpk, gdept_0, ndepidzt, "down" ) 699 CALL histvert( numptr, "depthw", "Vertical W levels", & 700 "m", jpk, gdepw_0, ndepidzw, "down" ) 701 702 ! 703 CALL wheneq ( jpj*jpk, MIN(surf_jk_glo(:,:), 1.e0), 1, 1., ndex , ndim ) ! Lat-Depth 704 CALL wheneq ( jpj , MIN(surf_jk_glo(:,1), 1.e0), 1, 1., ndex_h, ndim_h ) ! Lat 705 706 IF (ln_subbas) THEN 707 z_1 (:,1) = 1.0e0 708 WHERE ( gphit (jpi/2,:) .LT. -30 ) z_1 (:,1) = 0.e0 709 DO jk = 2, jpk 710 z_1 (:,jk) = z_1 (:,1) 711 END DO 712 713 CALL wheneq ( jpj*jpk, MIN(surf_jk_atl(:,:) , 1.e0), 1, 1., ndex_atl , ndim_atl ) ! Lat-Depth 714 CALL wheneq ( jpj*jpk, MIN(surf_jk_atl(:,:)*z_1(:,:), 1.e0), 1, 1., ndex_atl_30 , ndim_atl_30 ) ! Lat-Depth 715 CALL wheneq ( jpj , MIN(surf_jk_atl(:,1)*z_1(:,1), 1.e0), 1, 1., ndex_h_atl_30, ndim_h_atl_30 ) ! Lat 716 717 CALL wheneq ( jpj*jpk, MIN(surf_jk_pac(:,:) , 1.e0), 1, 1., ndex_pac , ndim_pac ) ! Lat-Depth 718 CALL wheneq ( jpj*jpk, MIN(surf_jk_pac(:,:)*z_1(:,:), 1.e0), 1, 1., ndex_pac_30 , ndim_pac_30 ) ! Lat-Depth 719 CALL wheneq ( jpj , MIN(surf_jk_pac(:,1)*z_1(:,1), 1.e0), 1, 1., ndex_h_pac_30, ndim_h_pac_30 ) ! Lat 720 721 CALL wheneq ( jpj*jpk, MIN(surf_jk_ind(:,:) , 1.e0), 1, 1., ndex_ind , ndim_ind ) ! Lat-Depth 722 CALL wheneq ( jpj*jpk, MIN(surf_jk_ind(:,:)*z_1(:,:), 1.e0), 1, 1., ndex_ind_30 , ndim_ind_30 ) ! Lat-Depth 723 CALL wheneq ( jpj , MIN(surf_jk_ind(:,1)*z_1(:,1), 1.e0), 1, 1., ndex_h_ind_30, ndim_h_ind_30 ) ! Lat 724 725 CALL wheneq ( jpj*jpk, MIN(surf_jk_ipc(:,:) , 1.e0), 1, 1., ndex_ipc , ndim_ipc ) ! Lat-Depth 726 CALL wheneq ( jpj*jpk, MIN(surf_jk_ipc(:,:)*z_1(:,:), 1.e0), 1, 1., ndex_ipc_30 , ndim_ipc_30 ) ! Lat-Depth 727 CALL wheneq ( jpj , MIN(surf_jk_ipc(:,1)*z_1(:,1), 1.e0), 1, 1., ndex_h_ipc_30, ndim_h_ipc_30 ) ! Lat 728 729 ENDIF 730 731 ! 732 #if defined key_diaeiv 733 cl_comment = ' (Bolus part included)' 671 734 #else 672 cl_comment = ' ' 673 #endif 674 ! Zonal mean T and S 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 ) 735 cl_comment = ' ' 736 #endif 737 ! Zonal mean T and S 738 739 IF ( ln_diaznl ) THEN 740 CALL histdef( numptr, "zotemglo", "Zonal Mean Temperature","C" , & 741 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 742 CALL histdef( numptr, "zosalglo", "Zonal Mean Salinity","PSU" , & 743 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 744 745 CALL histdef( numptr, "zosrfglo", "Zonal Mean Surface","m^2" , & 746 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout ) 747 748 IF (ln_subbas) THEN 749 CALL histdef( numptr, "zotematl", "Zonal Mean Temperature: Atlantic","C" , & 750 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 751 CALL histdef( numptr, "zosalatl", "Zonal Mean Salinity: Atlantic","PSU" , & 752 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 753 CALL histdef( numptr, "zosrfatl", "Zonal Mean Surface: Atlantic","m^2" , & 754 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout ) 755 756 CALL histdef( numptr, "zotempac", "Zonal Mean Temperature: Pacific","C" , & 757 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 758 CALL histdef( numptr, "zosalpac", "Zonal Mean Salinity: Pacific","PSU" , & 759 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 760 CALL histdef( numptr, "zosrfpac", "Zonal Mean Surface: Pacific","m^2" , & 761 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout ) 762 763 CALL histdef( numptr, "zotemind", "Zonal Mean Temperature: Indian","C" , & 764 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 765 CALL histdef( numptr, "zosalind", "Zonal Mean Salinity: Indian","PSU" , & 766 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 767 CALL histdef( numptr, "zosrfind", "Zonal Mean Surface: Indian","m^2" , & 768 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout ) 769 770 CALL histdef( numptr, "zotemipc", "Zonal Mean Temperature: Pacific+Indian","C" , & 771 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 772 CALL histdef( numptr, "zosalipc", "Zonal Mean Salinity: Pacific+Indian","PSU" , & 773 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 774 CALL histdef( numptr, "zosrfipc", "Zonal Mean Surface: Pacific+Indian","m^2" , & 775 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout ) 776 ENDIF 777 778 ENDIF 779 780 ! Meridional Stream-Function (Eulerian and Bolus) 781 782 CALL histdef( numptr, "zomsfglo", "Meridional Stream-Function: Global"//TRIM(cl_comment),"Sv" , & 783 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 784 IF( ln_subbas .AND. ln_diaznl ) THEN 785 CALL histdef( numptr, "zomsfatl", "Meridional Stream-Function: Atlantic"//TRIM(cl_comment),"Sv" , & 786 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 787 CALL histdef( numptr, "zomsfpac", "Meridional Stream-Function: Pacific"//TRIM(cl_comment),"Sv" , & 788 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 789 CALL histdef( numptr, "zomsfind", "Meridional Stream-Function: Indian"//TRIM(cl_comment),"Sv" , & 790 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 791 CALL histdef( numptr, "zomsfipc", "Meridional Stream-Function: Indo-Pacific"//TRIM(cl_comment),"Sv" ,& 792 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 793 ENDIF 794 795 ! Heat transport 796 797 CALL histdef( numptr, "sophtadv", "Advective Heat Transport" , & 798 "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 799 CALL histdef( numptr, "sophtldf", "Diffusive Heat Transport" , & 800 "PW",1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 801 IF ( ln_ptrcomp ) THEN 802 CALL histdef( numptr, "sophtove", "Overturning Heat Transport" , & 803 "PW",1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 804 END IF 805 IF( ln_subbas ) THEN 806 CALL histdef( numptr, "sohtatl", "Heat Transport Atlantic"//TRIM(cl_comment), & 807 "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 808 CALL histdef( numptr, "sohtpac", "Heat Transport Pacific"//TRIM(cl_comment) , & 809 "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 810 CALL histdef( numptr, "sohtind", "Heat Transport Indian"//TRIM(cl_comment) , & 811 "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 812 CALL histdef( numptr, "sohtipc", "Heat Transport Pacific+Indian"//TRIM(cl_comment), & 813 "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 814 ENDIF 815 816 817 ! Salt transport 818 819 CALL histdef( numptr, "sopstadv", "Advective Salt Transport" , & 820 "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 821 CALL histdef( numptr, "sopstldf", "Diffusive Salt Transport" , & 822 "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 823 IF ( ln_ptrcomp ) THEN 824 CALL histdef( numptr, "sopstove", "Overturning Salt Transport" , & 825 "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 826 END IF 827 #if defined key_diaeiv 828 ! Eddy induced velocity 829 CALL histdef( numptr, "zomsfeiv", "Bolus Meridional Stream-Function: global", & 830 "Sv" , 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 831 CALL histdef( numptr, "sophteiv", "Bolus Advective Heat Transport", & 832 "PW" , 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 833 CALL histdef( numptr, "sopsteiv", "Bolus Advective Salt Transport", & 834 "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 835 #endif 836 IF( ln_subbas ) THEN 837 CALL histdef( numptr, "sostatl", "Salt Transport Atlantic"//TRIM(cl_comment) , & 838 "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 839 CALL histdef( numptr, "sostpac", "Salt Transport Pacific"//TRIM(cl_comment) , & 840 "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 841 CALL histdef( numptr, "sostind", "Salt Transport Indian"//TRIM(cl_comment) , & 842 "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 843 CALL histdef( numptr, "sostipc", "Salt Transport Pacific+Indian"//TRIM(cl_comment), & 844 "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 845 ENDIF 846 847 CALL histend( numptr ) 848 849 END IF 850 END IF 851 852 IF( MOD( itmod, nf_ptr ) == 0 .AND. l_znl_root ) THEN 853 854 niter = niter + 1 855 856 !-$$ IF(lwp) THEN 857 !-$$ WRITE(numout,*) 858 !-$$ WRITE(numout,*) 'dia_ptr_wri : write Poleward Transports at time-step : kt = ', kt, & 859 !-$$ & 'it = ', it, ' itmod = ', itmod, ' niter = ', niter 860 !-$$ WRITE(numout,*) '~~~~~~~~~~' 861 !-$$ WRITE(numout,*) 862 !-$$ ENDIF 863 864 IF (ln_diaznl ) THEN 865 CALL histwrite( numptr, "zosrfglo", niter, surf_jk_glo , ndim, ndex ) 866 CALL histwrite( numptr, "zotemglo", niter, tn_jk_glo , ndim, ndex ) 867 CALL histwrite( numptr, "zosalglo", niter, sn_jk_glo , ndim, ndex ) 684 868 685 869 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" , & 720 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 721 IF( ln_subbas .AND. ln_diaznl ) THEN 722 CALL histdef( numptr, "zomsfatl", "Meridional Stream-Function: Atlantic"//TRIM(cl_comment),"Sv" , & 723 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 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" ,& 729 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 730 ENDIF 731 732 ! Heat transport 733 734 CALL histdef( numptr, "sophtadv", "Advective Heat Transport" , & 735 "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 736 CALL histdef( numptr, "sophtldf", "Diffusive Heat Transport" , & 737 "PW",1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 738 CALL histdef( numptr, "sophtove", "Overturning Heat Transport" , & 739 "PW",1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 740 IF( ln_subbas ) THEN 741 CALL histdef( numptr, "sohtatl", "Heat Transport Atlantic"//TRIM(cl_comment), & 742 "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 743 CALL histdef( numptr, "sohtpac", "Heat Transport Pacific"//TRIM(cl_comment) , & 744 "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 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), & 748 "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 749 ENDIF 750 751 752 ! Salt transport 753 754 CALL histdef( numptr, "sopstadv", "Advective Salt Transport" , & 755 "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 756 CALL histdef( numptr, "sopstldf", "Diffusive Salt Transport" , & 757 "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 758 CALL histdef( numptr, "sopstove", "Overturning Salt Transport" , & 759 "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 760 761 #if defined key_diaeiv 762 ! Eddy induced velocity 763 CALL histdef( numptr, "zomsfeiv", "Bolus Meridional Stream-Function: global", & 764 "Sv" , 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 765 CALL histdef( numptr, "sophteiv", "Bolus Advective Heat Transport", & 766 "PW" , 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 767 CALL histdef( numptr, "sopsteiv", "Bolus Advective Salt Transport", & 768 "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 769 #endif 770 IF( ln_subbas ) THEN 771 CALL histdef( numptr, "sostatl", "Salt Transport Atlantic"//TRIM(cl_comment) , & 772 "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 773 CALL histdef( numptr, "sostpac", "Salt Transport Pacific"//TRIM(cl_comment) , & 774 "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 775 CALL histdef( numptr, "sostind", "Salt Transport Indian"//TRIM(cl_comment) , & 776 "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 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 781 CALL histend( numptr ) 782 783 ENDIF 784 785 IF( MOD( itmod, nf_ptr ) == 0 ) THEN 786 787 IF(lwp) THEN 788 WRITE(numout,*) 789 WRITE(numout,*) 'dia_ptr : compute Poleward Transports at time-step : ', kt 790 WRITE(numout,*) '~~~~~~~~' 791 WRITE(numout,*) 792 ENDIF 793 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 ) 870 CALL histwrite( numptr, "zosrfatl", niter, surf_jk_atl, ndim_atl, ndex_atl ) 871 CALL histwrite( numptr, "zosrfpac", niter, surf_jk_pac, ndim_pac, ndex_pac ) 872 CALL histwrite( numptr, "zosrfind", niter, surf_jk_ind, ndim_ind, ndex_ind ) 873 CALL histwrite( numptr, "zosrfipc", niter, surf_jk_ipc, ndim_ipc, ndex_ipc ) 874 875 CALL histwrite( numptr, "zotematl", niter, tn_jk_atl , ndim_atl, ndex_atl ) 876 CALL histwrite( numptr, "zosalatl", niter, sn_jk_atl , ndim_atl, ndex_atl ) 877 CALL histwrite( numptr, "zotempac", niter, tn_jk_pac , ndim_pac, ndex_pac ) 878 CALL histwrite( numptr, "zosalpac", niter, sn_jk_pac , ndim_pac, ndex_pac ) 879 CALL histwrite( numptr, "zotemind", niter, tn_jk_ind , ndim_ind, ndex_ind ) 880 CALL histwrite( numptr, "zosalind", niter, sn_jk_ind , ndim_ind, ndex_ind ) 881 CALL histwrite( numptr, "zotemipc", niter, tn_jk_ipc , ndim_ipc, ndex_ipc ) 882 CALL histwrite( numptr, "zosalipc", niter, sn_jk_ipc , ndim_ipc, ndex_ipc ) 813 883 END IF 814 884 ENDIF 815 885 816 886 ! overturning outputs: 817 CALL histwrite( numptr, "zomsfglo", it, v_msf_glo, ndim, ndex )887 CALL histwrite( numptr, "zomsfglo", niter, v_msf_glo, ndim, ndex ) 818 888 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 )889 CALL histwrite( numptr, "zomsfatl", niter, v_msf_atl , ndim_atl_30, ndex_atl_30 ) 890 CALL histwrite( numptr, "zomsfpac", niter, v_msf_pac , ndim_pac_30, ndex_pac_30 ) 891 CALL histwrite( numptr, "zomsfind", niter, v_msf_ind , ndim_ind_30, ndex_ind_30 ) 892 CALL histwrite( numptr, "zomsfipc", niter, v_msf_ipc , ndim_ipc_30, ndex_ipc_30 ) 823 893 ENDIF 824 894 #if defined key_diaeiv 825 CALL histwrite( numptr, "zomsfeiv", it, v_msf_eiv, ndim , ndex ) 826 #endif 827 895 CALL histwrite( numptr, "zomsfeiv", niter, v_msf_eiv_glo, ndim , ndex ) 896 #endif 897 898 899 ! heat transport outputs: 900 IF( ln_subbas ) THEN 901 CALL histwrite( numptr, "sohtatl", niter, ht_atl , ndim_h_atl_30, ndex_h_atl_30 ) 902 CALL histwrite( numptr, "sohtpac", niter, ht_pac , ndim_h_pac_30, ndex_h_pac_30 ) 903 CALL histwrite( numptr, "sohtind", niter, ht_ind , ndim_h_ind_30, ndex_h_ind_30 ) 904 CALL histwrite( numptr, "sohtipc", niter, ht_ipc , ndim_h_ipc_30, ndex_h_ipc_30 ) 905 CALL histwrite( numptr, "sostatl", niter, st_atl , ndim_h_atl_30, ndex_h_atl_30 ) 906 CALL histwrite( numptr, "sostpac", niter, st_pac , ndim_h_pac_30, ndex_h_pac_30 ) 907 CALL histwrite( numptr, "sostind", niter, st_ind , ndim_h_ind_30, ndex_h_ind_30 ) 908 CALL histwrite( numptr, "sostipc", niter, st_ipc , ndim_h_ipc_30, ndex_h_ipc_30 ) 909 ENDIF 910 911 CALL histwrite( numptr, "sophtadv", niter, pht_adv , ndim_h, ndex_h ) 912 CALL histwrite( numptr, "sophtldf", niter, pht_ldf , ndim_h, ndex_h ) 913 CALL histwrite( numptr, "sopstadv", niter, pst_adv , ndim_h, ndex_h ) 914 CALL histwrite( numptr, "sopstldf", niter, pst_ldf , ndim_h, ndex_h ) 915 IF ( ln_ptrcomp ) THEN 916 CALL histwrite( numptr, "sopstove", niter, pst_ove_glo , ndim_h, ndex_h ) 917 CALL histwrite( numptr, "sophtove", niter, pht_ove_glo , ndim_h, ndex_h ) 918 ENDIF 919 #if defined key_diaeiv 920 CALL histwrite( numptr, "sophteiv", niter, pht_eiv_glo , ndim_h, ndex_h ) 921 CALL histwrite( numptr, "sopsteiv", niter, pst_eiv_glo , ndim_h, ndex_h ) 922 #endif 923 ! 828 924 ENDIF 829 830 ! heat transport outputs:831 IF( ln_subbas ) THEN832 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 ENDIF841 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_diaeiv849 CALL histwrite( numptr, "sophteiv", it, pht_eiv , ndim_h, ndex_h )850 CALL histwrite( numptr, "sopsteiv", it, pst_eiv , ndim_h, ndex_h )851 #endif852 853 925 ! 854 926 END SUBROUTINE dia_ptr_wri
Note: See TracChangeset
for help on using the changeset viewer.
