Changeset 5147
- Timestamp:
- 2015-03-13T11:01:32+01:00 (10 years ago)
- Location:
- trunk/NEMOGCM
- Files:
-
- 21 edited
-
CONFIG/AMM12/EXP00/namelist_cfg (modified) (1 diff)
-
CONFIG/SHARED/domain_def.xml (modified) (1 diff)
-
CONFIG/SHARED/field_def.xml (modified) (1 diff)
-
CONFIG/SHARED/namelist_ref (modified) (3 diffs)
-
NEMO/OPA_SRC/DIA/diaptr.F90 (modified) (10 diffs)
-
NEMO/OPA_SRC/DOM/phycst.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/IOM/iom.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/TRA/eosbn2.F90 (modified) (2 diffs)
-
NEMO/OPA_SRC/TRA/traadv.F90 (modified) (3 diffs)
-
NEMO/OPA_SRC/TRA/traadv_cen2.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/TRA/traadv_muscl.F90 (modified) (2 diffs)
-
NEMO/OPA_SRC/TRA/traadv_muscl2.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/TRA/traadv_qck.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/TRA/traadv_tvd.F90 (modified) (4 diffs)
-
NEMO/OPA_SRC/TRA/traadv_ubs.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/TRA/traldf_bilap.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/TRA/traldf_bilapg.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/TRA/traldf_iso.F90 (modified) (2 diffs)
-
NEMO/OPA_SRC/TRA/traldf_iso_grif.F90 (modified) (3 diffs)
-
NEMO/OPA_SRC/TRA/traldf_lap.F90 (modified) (1 diff)
-
NEMO/OPA_SRC/step.F90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/CONFIG/AMM12/EXP00/namelist_cfg
r5109 r5147 394 394 &namptr ! Poleward Transport Diagnostic 395 395 !----------------------------------------------------------------------- 396 ln_diaznl = .false. ! Add zonal means and meridional stream functions 397 ln_subbas = .false. ! Atlantic/Pacific/Indian basins computation (T) or not 398 ! (orca configuration only, need input basins mask file named "subbasins.nc" 399 ln_ptrcomp = .false. ! Add decomposition : overturning 400 / 401 !----------------------------------------------------------------------- 396 / 402 397 &namhsb ! Heat and salt budgets 403 398 !----------------------------------------------------------------------- -
trunk/NEMOGCM/CONFIG/SHARED/domain_def.xml
r4690 r5147 6 6 <domain id="myzoom" zoom_ibegin="10" zoom_jbegin="10" zoom_ni="5" zoom_nj="5" /> 7 7 <domain id="1point" zoom_ibegin="10" zoom_jbegin="10" zoom_ni="1" zoom_nj="1" /> 8 <domain id="ptr" zoom_ibegin="0000" zoom_jbegin="1" zoom_ni="1" zoom_nj="0000" /> 8 9 <!-- Eq section --> 9 10 <domain id="EqT" zoom_ibegin="1" zoom_jbegin="0000" zoom_ni="0000" zoom_nj="1" /> -
trunk/NEMOGCM/CONFIG/SHARED/field_def.xml
r5129 r5147 540 540 </field_group> 541 541 542 <!-- Poleward transport : ptr --> 543 <field_group id="diaptr" domain_ref="ptr" > 544 <field id="zomsfglo" long_name="Meridional Stream-Function: Global" unit="Sv" grid_ref="grid_W_3D" /> 545 <field id="zomsfatl" long_name="Meridional Stream-Function: Atlantic" unit="Sv" grid_ref="grid_W_3D" /> 546 <field id="zomsfpac" long_name="Meridional Stream-Function: Pacific" unit="Sv" grid_ref="grid_W_3D" /> 547 <field id="zomsfind" long_name="Meridional Stream-Function: Indian" unit="Sv" grid_ref="grid_W_3D" /> 548 <field id="zomsfipc" long_name="Meridional Stream-Function: Pacific+Indian" unit="Sv" grid_ref="grid_W_3D" /> 549 <field id="zotemglo" long_name="Zonal Mean Temperature : Global" unit="C" grid_ref="grid_T_3D" /> 550 <field id="zotematl" long_name="Zonal Mean Temperature : Atlantic" unit="C" grid_ref="grid_T_3D" /> 551 <field id="zotempac" long_name="Zonal Mean Temperature : Pacific" unit="C" grid_ref="grid_T_3D" /> 552 <field id="zotemind" long_name="Zonal Mean Temperature : Indian" unit="C" grid_ref="grid_T_3D" /> 553 <field id="zotemipc" long_name="Zonal Mean Temperature : Pacific+Indian" unit="C" grid_ref="grid_T_3D" /> 554 <field id="zosalglo" long_name="Zonal Mean Salinity : Global" unit="PSU" grid_ref="grid_T_3D" /> 555 <field id="zosalatl" long_name="Zonal Mean Salinity : Atlantic" unit="PSU" grid_ref="grid_T_3D" /> 556 <field id="zosalpac" long_name="Zonal Mean Salinity : Pacific" unit="PSU" grid_ref="grid_T_3D" /> 557 <field id="zosalind" long_name="Zonal Mean Salinity : Indian" unit="PSU" grid_ref="grid_T_3D" /> 558 <field id="zosalipc" long_name="Zonal Mean Salinity : Pacific+Indian" unit="PSU" grid_ref="grid_T_3D" /> 559 <field id="zosrfglo" long_name="Zonal Mean Surface" unit="m2" grid_ref="grid_T_3D" /> 560 <field id="zosrfatl" long_name="Zonal Mean Surface : Atlantic" unit="m2" grid_ref="grid_T_3D" /> 561 <field id="zosrfpac" long_name="Zonal Mean Surface : Pacific" unit="m2" grid_ref="grid_T_3D" /> 562 <field id="zosrfind" long_name="Zonal Mean Surface : Indian" unit="m2" grid_ref="grid_T_3D" /> 563 <field id="zosrfipc" long_name="Zonal Mean Surface : Pacific+Indian" unit="m2" grid_ref="grid_T_3D" /> 564 <field id="sophtadv" long_name="Advective Heat Transport" unit="PW" grid_ref="grid_T_2D" /> 565 <field id="sophtldf" long_name="Diffusive Heat Transport" unit="PW" grid_ref="grid_T_2D" /> 566 <field id="sopstadv" long_name="Advective Salt Transport" unit="Giga g/s" grid_ref="grid_T_2D" /> 567 <field id="sopstldf" long_name="Diffusive Salt Transport" unit="Giga g/s" grid_ref="grid_T_2D" /> 568 </field_group> 569 570 542 571 <!-- ptrc on T grid --> 543 572 -
trunk/NEMOGCM/CONFIG/SHARED/namelist_ref
r5120 r5147 10 10 !! 7 - dynamics (namdyn_adv, namdyn_vor, namdyn_hpg, namdyn_spg, namdyn_ldf) 11 11 !! 8 - Verical physics (namzdf, namzdf_ric, namzdf_tke, namzdf_kpp, namzdf_ddm, namzdf_tmx) 12 !! 9 - diagnostics (namnc4, namtrd, namspr, namflo, nam ptr, namhsb)12 !! 9 - diagnostics (namnc4, namtrd, namspr, namflo, namhsb) 13 13 !! 10 - miscellaneous (namsol, nammpp, namctl) 14 14 !! 11 - Obs & Assim (namobs, nam_asminc) … … 1069 1069 !! namnc4 netcdf4 chunking and compression settings ("key_netcdf4") 1070 1070 !! namtrd dynamics and/or tracer trends 1071 !! namptr Poleward Transport Diagnostics 1071 1072 !! namflo float parameters ("key_float") 1072 !! namptr Poleward Transport Diagnostics1073 1073 !! namhsb Heat and salt budgets 1074 1074 !!====================================================================== … … 1124 1124 !----------------------------------------------------------------------- 1125 1125 ln_diaptr = .false. ! Poleward heat and salt transport (T) or not (F) 1126 ln_diaznl = .true. ! Add zonal means and meridional stream functions 1127 ln_subbas = .true. ! Atlantic/Pacific/Indian basins computation (T) or not 1128 ! (orca configuration only, need input basins mask file named "subbasins.nc" 1129 ln_ptrcomp = .true. ! Add decomposition : overturning 1130 nn_fptr = 1 ! Frequency of ptr computation [time step] 1131 nn_fwri = 15 ! Frequency of ptr outputs [time step] 1126 ln_subbas = .false. ! Atlantic/Pacific/Indian basins computation (T) or not 1132 1127 / 1133 1128 !----------------------------------------------------------------------- -
trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90
r4990 r5147 8 8 !! 3.2 ! 2010-03 (O. Marti, S. Flavoni) Add fields 9 9 !! 3.3 ! 2010-10 (G. Madec) dynamical allocation 10 !! 3.6 ! 2014-12 (C. Ethe) use of IOM 10 11 !!---------------------------------------------------------------------- 11 12 … … 13 14 !! dia_ptr : Poleward Transport Diagnostics module 14 15 !! dia_ptr_init : Initialization, namelist read 15 !! dia_ptr_wri : Output of poleward fluxes 16 !! ptr_vjk : "zonal" sum computation of a "meridional" flux array 17 !! ptr_tjk : "zonal" mean computation of a tracer field 18 !! ptr_vj : "zonal" and vertical sum computation of a "meridional" flux array 19 !! (Generic interface to ptr_vj_3d, ptr_vj_2d) 16 !! ptr_sjk : "zonal" mean computation of a field - tracer or flux array 17 !! ptr_sj : "zonal" and vertical sum computation of a "meridional" flux array 18 !! (Generic interface to ptr_sj_3d, ptr_sj_2d) 20 19 !!---------------------------------------------------------------------- 21 20 USE oce ! ocean dynamics and active tracers 22 21 USE dom_oce ! ocean space and time domain 23 22 USE phycst ! physical constants 24 USE ldftra_oce ! ocean active tracers: lateral physics 25 USE dianam ! 23 ! 26 24 USE iom ! IOM library 27 USE ioipsl ! IO-IPSL library28 25 USE in_out_manager ! I/O manager 29 26 USE lib_mpp ! MPP library 30 USE lbclnk ! lateral boundary condition - processor exchanges31 27 USE timing ! preformance summary 32 USE wrk_nemo ! working arrays33 28 34 29 IMPLICIT NONE 35 30 PRIVATE 36 31 37 INTERFACE ptr_ vj38 MODULE PROCEDURE ptr_ vj_3d, ptr_vj_2d32 INTERFACE ptr_sj 33 MODULE PROCEDURE ptr_sj_3d, ptr_sj_2d 39 34 END INTERFACE 40 35 41 PUBLIC dia_ptr_init ! call in opa module 36 PUBLIC ptr_sj ! call by tra_ldf & tra_adv routines 37 PUBLIC ptr_sjk ! 38 PUBLIC dia_ptr_init ! call in step module 42 39 PUBLIC dia_ptr ! call in step module 43 PUBLIC ptr_vj ! call by tra_ldf & tra_adv routines44 PUBLIC ptr_vjk ! call by tra_ldf & tra_adv routines45 40 46 41 ! !!** namelist namptr ** 47 LOGICAL , PUBLIC :: ln_diaptr !: Poleward transport flag (T) or not (F) 48 LOGICAL , PUBLIC :: ln_subbas !: Atlantic/Pacific/Indian basins calculation 49 LOGICAL , PUBLIC :: ln_diaznl !: Add zonal means and meridional stream functions 50 LOGICAL , PUBLIC :: ln_ptrcomp !: Add decomposition : overturning (and gyre, soon ...) 51 INTEGER , PUBLIC :: nn_fptr !: frequency of ptr computation [time step] 52 INTEGER , PUBLIC :: nn_fwri !: frequency of ptr outputs [time step] 53 54 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:) :: htr_adv, htr_ldf, htr_ove !: Heat TRansports (adv, diff, overturn.) 55 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:) :: str_adv, str_ldf, str_ove !: Salt TRansports (adv, diff, overturn.) 42 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:) :: htr_adv, htr_ldf !: Heat TRansports (adv, diff, overturn.) 43 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:) :: str_adv, str_ldf !: Salt TRansports (adv, diff, overturn.) 56 44 57 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: btmsk ! T-point basin interior masks 58 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: btm30 ! mask out Southern Ocean (=0 south of 30°S) 59 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: htr , str ! adv heat and salt transports (approx) 60 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tn_jk, sn_jk , v_msf ! i-mean T and S, j-Stream-Function 61 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sjk , r1_sjk ! i-mean i-k-surface and its inverse 62 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: htr_eiv, str_eiv ! bolus adv heat ans salt transports ('key_diaeiv') 63 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: v_msf_eiv ! bolus j-streamfuction ('key_diaeiv') 64 65 66 INTEGER :: niter ! 67 INTEGER :: nidom_ptr ! 68 INTEGER :: numptr ! logical unit for Poleward TRansports 69 INTEGER :: nptr ! = 1 (ln_subbas=F) or = 5 (glo, atl, pac, ind, ipc) (ln_subbas=T) 45 46 LOGICAL, PUBLIC :: ln_diaptr ! Poleward transport flag (T) or not (F) 47 LOGICAL, PUBLIC :: ln_subbas ! Atlantic/Pacific/Indian basins calculation 48 INTEGER :: nptr ! = 1 (l_subbas=F) or = 5 (glo, atl, pac, ind, ipc) (l_subbas=T) 70 49 71 50 REAL(wp) :: rc_sv = 1.e-6_wp ! conversion from m3/s to Sverdrup … … 73 52 REAL(wp) :: rc_ggram = 1.e-6_wp ! conversion from g to Pg 74 53 75 REAL(wp), TARGET, DIMENSION(:), ALLOCATABLE, SAVE :: p_fval1d 76 REAL(wp), TARGET, DIMENSION(:,:), ALLOCATABLE, SAVE :: p_fval2d 77 78 !! Integer, 1D workspace arrays. Not common enough to be implemented in 79 !! wrk_nemo module. 80 INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndex , ndex_atl , ndex_pac , ndex_ind , ndex_ipc 81 INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndex_atl_30 , ndex_pac_30 , ndex_ind_30 , ndex_ipc_30 82 INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndex_h, ndex_h_atl_30, ndex_h_pac_30, ndex_h_ind_30, ndex_h_ipc_30 54 CHARACTER(len=3), ALLOCATABLE, SAVE, DIMENSION(:) :: clsubb 55 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: btmsk ! T-point basin interior masks 56 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: btm30 ! mask out Southern Ocean (=0 south of 30°S) 57 58 REAL(wp), TARGET, ALLOCATABLE, SAVE, DIMENSION(:) :: p_fval1d 59 REAL(wp), TARGET, ALLOCATABLE, SAVE, DIMENSION(:,:) :: p_fval2d 60 83 61 84 62 !! * Substitutions … … 92 70 CONTAINS 93 71 94 FUNCTION dia_ptr_alloc() 95 !!---------------------------------------------------------------------- 96 !! *** ROUTINE dia_ptr_alloc *** 97 !!---------------------------------------------------------------------- 98 INTEGER :: dia_ptr_alloc ! return value 99 INTEGER, DIMENSION(6) :: ierr 100 !!---------------------------------------------------------------------- 101 ierr(:) = 0 102 ! 103 ALLOCATE( btmsk(jpi,jpj,nptr) , & 104 & htr_adv(jpj) , str_adv(jpj) , & 105 & htr_ldf(jpj) , str_ldf(jpj) , & 106 & htr_ove(jpj) , str_ove(jpj), & 107 & htr(jpj,nptr) , str(jpj,nptr) , & 108 & tn_jk(jpj,jpk,nptr) , sn_jk (jpj,jpk,nptr) , v_msf(jpj,jpk,nptr) , & 109 & sjk (jpj,jpk,nptr) , r1_sjk(jpj,jpk,nptr) , STAT=ierr(1) ) 110 ! 111 #if defined key_diaeiv 112 ALLOCATE( htr_eiv(jpj,nptr) , str_eiv(jpj,nptr) , & 113 & v_msf_eiv(jpj,jpk,nptr) , STAT=ierr(2) ) 114 #endif 115 ALLOCATE( p_fval1d(jpj), p_fval2d(jpj,jpk), Stat=ierr(3)) 116 ! 117 ALLOCATE(ndex(jpj*jpk), ndex_atl(jpj*jpk), ndex_pac(jpj*jpk), & 118 & ndex_ind(jpj*jpk), ndex_ipc(jpj*jpk), & 119 & ndex_atl_30(jpj*jpk), ndex_pac_30(jpj*jpk), Stat=ierr(4)) 120 121 ALLOCATE(ndex_ind_30(jpj*jpk), ndex_ipc_30(jpj*jpk), & 122 & ndex_h(jpj), ndex_h_atl_30(jpj), ndex_h_pac_30(jpj), & 123 & ndex_h_ind_30(jpj), ndex_h_ipc_30(jpj), Stat=ierr(5) ) 124 ! 125 ALLOCATE( btm30(jpi,jpj) , STAT=ierr(6) ) 126 ! 127 dia_ptr_alloc = MAXVAL( ierr ) 128 IF(lk_mpp) CALL mpp_sum( dia_ptr_alloc ) 129 ! 130 END FUNCTION dia_ptr_alloc 131 132 133 FUNCTION ptr_vj_3d( pva ) RESULT ( p_fval ) 134 !!---------------------------------------------------------------------- 135 !! *** ROUTINE ptr_vj_3d *** 136 !! 137 !! ** Purpose : i-k sum computation of a j-flux array 138 !! 139 !! ** Method : - i-k sum of pva using the interior 2D vmask (vmask_i). 140 !! pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v) 141 !! 142 !! ** Action : - p_fval: i-k-mean poleward flux of pva 143 !!---------------------------------------------------------------------- 144 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) :: pva ! mask flux array at V-point 145 !! 146 INTEGER :: ji, jj, jk ! dummy loop arguments 147 INTEGER :: ijpj ! ??? 148 REAL(wp), POINTER, DIMENSION(:) :: p_fval ! function value 149 !!-------------------------------------------------------------------- 150 ! 151 p_fval => p_fval1d 152 153 ijpj = jpj 154 p_fval(:) = 0._wp 155 DO jk = 1, jpkm1 156 DO jj = 2, jpjm1 157 DO ji = fs_2, fs_jpim1 ! Vector opt. 158 p_fval(jj) = p_fval(jj) + pva(ji,jj,jk) * tmask_i(ji,jj) 159 END DO 160 END DO 161 END DO 162 #if defined key_mpp_mpi 163 IF(lk_mpp) CALL mpp_sum( p_fval, ijpj, ncomm_znl) 164 #endif 165 ! 166 END FUNCTION ptr_vj_3d 167 168 169 FUNCTION ptr_vj_2d( pva ) RESULT ( p_fval ) 170 !!---------------------------------------------------------------------- 171 !! *** ROUTINE ptr_vj_2d *** 172 !! 173 !! ** Purpose : "zonal" and vertical sum computation of a i-flux array 174 !! 175 !! ** Method : - i-k sum of pva using the interior 2D vmask (vmask_i). 176 !! pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v) 177 !! 178 !! ** Action : - p_fval: i-k-mean poleward flux of pva 179 !!---------------------------------------------------------------------- 180 IMPLICIT none 181 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) :: pva ! mask flux array at V-point 182 !! 183 INTEGER :: ji,jj ! dummy loop arguments 184 INTEGER :: ijpj ! ??? 185 REAL(wp), POINTER, DIMENSION(:) :: p_fval ! function value 186 !!-------------------------------------------------------------------- 187 ! 188 p_fval => p_fval1d 189 190 ijpj = jpj 191 p_fval(:) = 0._wp 192 DO jj = 2, jpjm1 193 DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ? 194 p_fval(jj) = p_fval(jj) + pva(ji,jj) * tmask_i(ji,jj) 195 END DO 196 END DO 197 #if defined key_mpp_mpi 198 CALL mpp_sum( p_fval, ijpj, ncomm_znl ) 199 #endif 200 ! 201 END FUNCTION ptr_vj_2d 202 203 204 FUNCTION ptr_vjk( pva, pmsk ) RESULT ( p_fval ) 205 !!---------------------------------------------------------------------- 206 !! *** ROUTINE ptr_vjk *** 207 !! 208 !! ** Purpose : i-sum computation of a j-velocity array 209 !! 210 !! ** Method : - i-sum of pva using the interior 2D vmask (vmask_i). 211 !! pva is supposed to be a masked flux (i.e. * vmask) 212 !! 213 !! ** Action : - p_fval: i-mean poleward flux of pva 214 !!---------------------------------------------------------------------- 215 !! 216 IMPLICIT none 217 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) :: pva ! mask flux array at V-point 218 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) , OPTIONAL :: pmsk ! Optional 2D basin mask 219 !! 220 INTEGER :: ji, jj, jk ! dummy loop arguments 221 REAL(wp), POINTER, DIMENSION(:,:) :: p_fval ! return function value 222 #if defined key_mpp_mpi 223 INTEGER, DIMENSION(1) :: ish 224 INTEGER, DIMENSION(2) :: ish2 225 INTEGER :: ijpjjpk 226 #endif 227 #if defined key_mpp_mpi 228 REAL(wp), POINTER, DIMENSION(:) :: zwork ! mask flux array at V-point 229 #endif 230 !!-------------------------------------------------------------------- 231 ! 232 #if defined key_mpp_mpi 233 ijpjjpk = jpj*jpk 234 CALL wrk_alloc( jpj*jpk, zwork ) 235 #endif 236 237 p_fval => p_fval2d 238 239 p_fval(:,:) = 0._wp 240 ! 241 IF( PRESENT( pmsk ) ) THEN 242 DO jk = 1, jpkm1 243 DO jj = 2, jpjm1 244 !!gm here, use of tmask_i ==> no need of loop over nldi, nlei.... 245 DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ? 246 p_fval(jj,jk) = p_fval(jj,jk) + pva(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk) * pmsk(ji,jj) 72 SUBROUTINE dia_ptr( pvtr ) 73 !!---------------------------------------------------------------------- 74 !! *** ROUTINE dia_ptr *** 75 !!---------------------------------------------------------------------- 76 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: pvtr ! j-effective transport 77 ! 78 INTEGER :: ji, jj, jk, jn ! dummy loop indices 79 REAL(wp) :: zv, zsfc ! local scalar 80 REAL(wp), DIMENSION(jpi,jpj) :: z2d ! 2D workspace 81 REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3d ! 3D workspace 82 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask ! 3D workspace 83 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: zts ! 3D workspace 84 CHARACTER( len = 10 ) :: cl1 85 !!---------------------------------------------------------------------- 86 ! 87 IF( nn_timing == 1 ) CALL timing_start('dia_ptr') 88 89 ! 90 IF( PRESENT( pvtr ) ) THEN 91 IF( iom_use("zomsfglo") ) THEN ! effective MSF 92 z3d(1,:,:) = ptr_sjk( pvtr(:,:,:) ) ! zonal cumulative effective transport 93 DO jk = 2, jpkm1 94 z3d(1,:,jk) = z3d(1,:,jk-1) + z3d(1,:,jk) ! effective j-Stream-Function (MSF) 95 END DO 96 DO ji = 1, jpi 97 z3d(ji,:,:) = z3d(1,:,:) 98 ENDDO 99 cl1 = TRIM('zomsf'//clsubb(1) ) 100 CALL iom_put( cl1, z3d * rc_sv ) 101 DO jn = 2, nptr ! by sub-basins 102 z3d(1,:,:) = ptr_sjk( pvtr(:,:,:), btmsk(:,:,jn)*btm30(:,:) ) 103 DO jk = 2, jpkm1 104 z3d(1,:,jk) = z3d(1,:,jk-1) + z3d(1,:,jk) ! effective j-Stream-Function (MSF) 247 105 END DO 248 END DO 249 END DO 250 ELSE 251 DO jk = 1, jpkm1 252 DO jj = 2, jpjm1 253 DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ? 254 p_fval(jj,jk) = p_fval(jj,jk) + pva(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk) * tmask_i(ji,jj) 255 END DO 256 END DO 257 END DO 258 END IF 259 ! 260 #if defined key_mpp_mpi 261 ijpjjpk = jpj*jpk 262 ish(1) = ijpjjpk ; ish2(1) = jpj ; ish2(2) = jpk 263 zwork(1:ijpjjpk) = RESHAPE( p_fval, ish ) 264 CALL mpp_sum( zwork, ijpjjpk, ncomm_znl ) 265 p_fval(:,:) = RESHAPE( zwork, ish2 ) 266 #endif 267 ! 268 #if defined key_mpp_mpi 269 CALL wrk_dealloc( jpj*jpk, zwork ) 270 #endif 271 ! 272 END FUNCTION ptr_vjk 273 274 275 FUNCTION ptr_tjk( pta, pmsk ) RESULT ( p_fval ) 276 !!---------------------------------------------------------------------- 277 !! *** ROUTINE ptr_tjk *** 278 !! 279 !! ** Purpose : i-sum computation of e1t*e3t * a tracer field 280 !! 281 !! ** Method : - i-sum of mj(pta) using tmask 282 !! 283 !! ** Action : - p_fval: i-sum of e1t*e3t*pta 284 !!---------------------------------------------------------------------- 285 !! 286 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) :: pta ! tracer flux array at T-point 287 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) :: pmsk ! Optional 2D basin mask 288 !! 289 INTEGER :: ji, jj, jk ! dummy loop arguments 290 REAL(wp), POINTER, DIMENSION(:,:) :: p_fval ! return function value 291 #if defined key_mpp_mpi 292 INTEGER, DIMENSION(1) :: ish 293 INTEGER, DIMENSION(2) :: ish2 294 INTEGER :: ijpjjpk 295 #endif 296 #if defined key_mpp_mpi 297 REAL(wp), POINTER, DIMENSION(:) :: zwork ! mask flux array at V-point 298 #endif 299 !!-------------------------------------------------------------------- 300 ! 301 #if defined key_mpp_mpi 302 ijpjjpk = jpj*jpk 303 CALL wrk_alloc( jpj*jpk, zwork ) 304 #endif 305 306 p_fval => p_fval2d 307 308 p_fval(:,:) = 0._wp 309 DO jk = 1, jpkm1 310 DO jj = 2, jpjm1 311 DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ? 312 p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * e1t(ji,jj) * fse3t(ji,jj,jk) * pmsk(ji,jj) 313 END DO 314 END DO 315 END DO 316 #if defined key_mpp_mpi 317 ijpjjpk = jpj*jpk 318 ish(1) = jpj*jpk ; ish2(1) = jpj ; ish2(2) = jpk 319 zwork(1:ijpjjpk)= RESHAPE( p_fval, ish ) 320 CALL mpp_sum( zwork, ijpjjpk, ncomm_znl ) 321 p_fval(:,:)= RESHAPE( zwork, ish2 ) 322 #endif 323 ! 324 #if defined key_mpp_mpi 325 CALL wrk_dealloc( jpj*jpk, zwork ) 326 #endif 327 ! 328 END FUNCTION ptr_tjk 329 330 331 SUBROUTINE dia_ptr( kt ) 332 !!---------------------------------------------------------------------- 333 !! *** ROUTINE dia_ptr *** 334 !!---------------------------------------------------------------------- 335 USE oce, vt => ua ! use ua as workspace 336 USE oce, vs => va ! use va as workspace 337 IMPLICIT none 338 !! 339 INTEGER, INTENT(in) :: kt ! ocean time step index 340 ! 341 INTEGER :: ji, jj, jk, jn ! dummy loop indices 342 REAL(wp) :: zv ! local scalar 343 !!---------------------------------------------------------------------- 344 ! 345 IF( nn_timing == 1 ) CALL timing_start('dia_ptr') 346 ! 347 IF( kt == nit000 .OR. MOD( kt, nn_fptr ) == 0 ) THEN 348 ! 349 IF( MOD( kt, nn_fptr ) == 0 ) THEN 350 ! 351 IF( ln_diaznl ) THEN ! i-mean temperature and salinity 352 DO jn = 1, nptr 353 tn_jk(:,:,jn) = ptr_tjk( tsn(:,:,:,jp_tem), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 354 sn_jk(:,:,jn) = ptr_tjk( tsn(:,:,:,jp_sal), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 355 END DO 356 ENDIF 357 ! 358 ! ! horizontal integral and vertical dz 359 ! ! eulerian velocity 360 v_msf(:,:,1) = ptr_vjk( vn(:,:,:) ) 361 DO jn = 2, nptr 362 v_msf(:,:,jn) = ptr_vjk( vn(:,:,:), btmsk(:,:,jn)*btm30(:,:) ) 363 END DO 364 #if defined key_diaeiv 365 DO jn = 1, nptr ! bolus velocity 366 v_msf_eiv(:,:,jn) = ptr_vjk( v_eiv(:,:,:), btmsk(:,:,jn) ) ! here no btm30 for MSFeiv 367 END DO 368 ! ! add bolus stream-function to the eulerian one 369 v_msf(:,:,:) = v_msf(:,:,:) + v_msf_eiv(:,:,:) 370 #endif 371 ! 372 ! ! Transports 373 ! ! local heat & salt transports at T-points ( tsn*mj[vn+v_eiv] ) 374 vt(:,:,jpk) = 0._wp ; vs(:,:,jpk) = 0._wp 375 DO jk= 1, jpkm1 376 DO jj = 2, jpj 106 DO ji = 1, jpi 107 z3d(ji,:,:) = z3d(1,:,:) 108 ENDDO 109 cl1 = TRIM('zomsf'//clsubb(jn) ) 110 CALL iom_put( cl1, z3d * rc_sv ) 111 END DO 112 ENDIF 113 ! 114 ELSE 115 ! 116 IF( iom_use("zotemglo") ) THEN ! i-mean i-k-surface 117 DO jk = 1, jpkm1 118 DO jj = 1, jpj 377 119 DO ji = 1, jpi 378 #if defined key_diaeiv 379 zv = ( vn(ji,jj,jk) + vn(ji,jj-1,jk) + v_eiv(ji,jj,jk) + v_eiv(ji,jj-1,jk) ) * 0.5_wp 380 #else 381 zv = ( vn(ji,jj,jk) + vn(ji,jj-1,jk) ) * 0.5_wp 382 #endif 383 vt(ji,jj,jk) = zv * tsn(ji,jj,jk,jp_tem) 384 vs(ji,jj,jk) = zv * tsn(ji,jj,jk,jp_sal) 385 END DO 386 END DO 387 END DO 388 !!gm useless as overlap areas are not used in ptr_vjk 389 CALL lbc_lnk( vs, 'V', -1. ) ; CALL lbc_lnk( vt, 'V', -1. ) 390 !!gm 391 ! ! heat & salt advective transports (approximation) 392 htr(:,1) = SUM( ptr_vjk( vt(:,:,:) ) , 2 ) * rc_pwatt ! SUM over jk + conversion 393 str(:,1) = SUM( ptr_vjk( vs(:,:,:) ) , 2 ) * rc_ggram 394 DO jn = 2, nptr 395 htr(:,jn) = SUM( ptr_vjk( vt(:,:,:), btmsk(:,:,jn)*btm30(:,:) ) , 2 ) * rc_pwatt ! mask Southern Ocean 396 str(:,jn) = SUM( ptr_vjk( vs(:,:,:), btmsk(:,:,jn)*btm30(:,:) ) , 2 ) * rc_ggram ! mask Southern Ocean 397 END DO 398 399 IF( ln_ptrcomp ) THEN ! overturning transport 400 htr_ove(:) = SUM( v_msf(:,:,1) * tn_jk(:,:,1), 2 ) * rc_pwatt ! SUM over jk + conversion 401 str_ove(:) = SUM( v_msf(:,:,1) * sn_jk(:,:,1), 2 ) * rc_ggram 402 END IF 403 ! ! Advective and diffusive transport 404 htr_adv(:) = htr_adv(:) * rc_pwatt ! these are computed in tra_adv... and tra_ldf... routines 405 htr_ldf(:) = htr_ldf(:) * rc_pwatt ! here just the conversion in PW and Gg 406 str_adv(:) = str_adv(:) * rc_ggram 407 str_ldf(:) = str_ldf(:) * rc_ggram 408 409 #if defined key_diaeiv 410 DO jn = 1, nptr ! Bolus component 411 htr_eiv(:,jn) = SUM( v_msf_eiv(:,:,jn) * tn_jk(:,:,jn), 2 ) * rc_pwatt ! SUM over jk 412 str_eiv(:,jn) = SUM( v_msf_eiv(:,:,jn) * sn_jk(:,:,jn), 2 ) * rc_ggram ! SUM over jk 413 END DO 414 #endif 415 ! ! "Meridional" Stream-Function 120 zsfc = e1t(ji,jj) * fse3t(ji,jj,jk) 121 zmask(ji,jj,jk) = tmask(ji,jj,jk) * zsfc 122 zts(ji,jj,jk,jp_tem) = tsn(ji,jj,jk,jp_tem) * zsfc 123 zts(ji,jj,jk,jp_sal) = tsn(ji,jj,jk,jp_sal) * zsfc 124 ENDDO 125 ENDDO 126 ENDDO 416 127 DO jn = 1, nptr 417 DO jk = 2, jpk 418 v_msf (:,jk,jn) = v_msf (:,jk-1,jn) + v_msf (:,jk,jn) ! Eulerian j-Stream-Function 419 #if defined key_diaeiv 420 v_msf_eiv(:,jk,jn) = v_msf_eiv(:,jk-1,jn) + v_msf_eiv(:,jk,jn) ! Bolus j-Stream-Function 421 422 #endif 423 END DO 424 END DO 425 v_msf (:,:,:) = v_msf (:,:,:) * rc_sv ! converte in Sverdrups 426 #if defined key_diaeiv 427 v_msf_eiv(:,:,:) = v_msf_eiv(:,:,:) * rc_sv 428 #endif 429 ENDIF 430 ! 431 CALL dia_ptr_wri( kt ) ! outputs 128 zmask(1,:,:) = ptr_sjk( zmask(:,:,:), btmsk(:,:,jn) ) 129 cl1 = TRIM('zosrf'//clsubb(jn) ) 130 CALL iom_put( cl1, zmask ) 131 ! 132 z3d(1,:,:) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) & 133 & / MAX( zmask(1,:,:), 10.e-15 ) 134 DO ji = 1, jpi 135 z3d(ji,:,:) = z3d(1,:,:) 136 ENDDO 137 cl1 = TRIM('zotem'//clsubb(jn) ) 138 CALL iom_put( cl1, z3d ) 139 ! 140 z3d(1,:,:) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) & 141 & / MAX( zmask(1,:,:), 10.e-15 ) 142 DO ji = 1, jpi 143 z3d(ji,:,:) = z3d(1,:,:) 144 ENDDO 145 cl1 = TRIM('zosal'//clsubb(jn) ) 146 CALL iom_put( cl1, z3d ) 147 END DO 148 ENDIF 149 ! 150 ! ! Advective and diffusive heat and salt transport 151 IF( iom_use("sophtadv") .OR. iom_use("sopstadv") ) THEN 152 z2d(1,:) = htr_adv(:) * rc_pwatt ! (conversion in PW) 153 DO ji = 1, jpi 154 z2d(ji,:) = z2d(1,:) 155 ENDDO 156 cl1 = 'sophtadv' 157 CALL iom_put( TRIM(cl1), z2d ) 158 z2d(1,:) = str_adv(:) * rc_ggram ! (conversion in Gg) 159 DO ji = 1, jpi 160 z2d(ji,:) = z2d(1,:) 161 ENDDO 162 cl1 = 'sopstadv' 163 CALL iom_put( TRIM(cl1), z2d ) 164 ENDIF 165 ! 166 IF( iom_use("sophtldf") .OR. iom_use("sopstldf") ) THEN 167 z2d(1,:) = htr_ldf(:) * rc_pwatt ! (conversion in PW) 168 DO ji = 1, jpi 169 z2d(ji,:) = z2d(1,:) 170 ENDDO 171 cl1 = 'sophtldf' 172 CALL iom_put( TRIM(cl1), z2d ) 173 z2d(1,:) = str_ldf(:) * rc_ggram ! (conversion in Gg) 174 DO ji = 1, jpi 175 z2d(ji,:) = z2d(1,:) 176 ENDDO 177 cl1 = 'sopstldf' 178 CALL iom_put( TRIM(cl1), z2d ) 179 ENDIF 432 180 ! 433 181 ENDIF 434 !435 #if defined key_mpp_mpi436 IF( kt == nitend .AND. l_znl_root ) CALL histclo( numptr ) ! Close the file437 #else438 IF( kt == nitend ) CALL histclo( numptr ) ! Close the file439 #endif440 182 ! 441 183 IF( nn_timing == 1 ) CALL timing_stop('dia_ptr') … … 450 192 !! ** Purpose : Initialization, namelist read 451 193 !!---------------------------------------------------------------------- 452 INTEGER :: jn ! dummy loop indices 453 INTEGER :: inum, ierr ! local integers 454 INTEGER :: ios ! Local integer output status for namelist read 455 #if defined key_mpp_mpi 456 INTEGER, DIMENSION(1) :: iglo, iloc, iabsf, iabsl, ihals, ihale, idid 457 #endif 458 !! 459 NAMELIST/namptr/ ln_diaptr, ln_diaznl, ln_subbas, ln_ptrcomp, nn_fptr, nn_fwri 194 INTEGER :: jn ! local integers 195 INTEGER :: inum, ierr ! local integers 196 INTEGER :: ios ! Local integer output status for namelist read 197 !! 198 NAMELIST/namptr/ ln_diaptr, ln_subbas 460 199 !!---------------------------------------------------------------------- 461 200 … … 475 214 WRITE(numout,*) ' Namelist namptr : set ptr parameters' 476 215 WRITE(numout,*) ' Poleward heat & salt transport (T) or not (F) ln_diaptr = ', ln_diaptr 477 WRITE(numout,*) ' Overturning heat & salt transport ln_ptrcomp = ', ln_ptrcomp478 WRITE(numout,*) ' T & S zonal mean and meridional stream function ln_diaznl = ', ln_diaznl479 216 WRITE(numout,*) ' Global (F) or glo/Atl/Pac/Ind/Indo-Pac basins ln_subbas = ', ln_subbas 480 WRITE(numout,*) ' Frequency of computation nn_fptr = ', nn_fptr481 WRITE(numout,*) ' Frequency of outputs nn_fwri = ', nn_fwri482 217 ENDIF 483 484 IF( ln_diaptr) THEN 485 486 IF( nn_timing == 1 ) CALL timing_start('dia_ptr_init') 487 488 IF( ln_subbas ) THEN ; nptr = 5 ! Global, Atlantic, Pacific, Indian, Indo-Pacific 489 ELSE ; nptr = 1 ! Global only 218 219 IF( ln_diaptr ) THEN 220 ! 221 IF( ln_subbas ) THEN 222 nptr = 5 ! Global, Atlantic, Pacific, Indian, Indo-Pacific 223 ALLOCATE( clsubb(nptr) ) 224 clsubb(1) = 'glo' ; clsubb(2) = 'atl' ; clsubb(3) = 'pac' ; clsubb(4) = 'ind' ; clsubb(5) = 'ipc' 225 ELSE 226 nptr = 1 ! Global only 227 ALLOCATE( clsubb(nptr) ) 228 clsubb(1) = 'glo' 490 229 ENDIF 491 230 … … 493 232 IF( dia_ptr_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_ptr_init : unable to allocate arrays' ) 494 233 495 rc_pwatt = rc_pwatt * rau0 *rcp ! conversion from K.s-1 to PetaWatt234 rc_pwatt = rc_pwatt * rau0_rcp ! conversion from K.s-1 to PetaWatt 496 235 497 236 IF( lk_mpp ) CALL mpp_ini_znl( numout ) ! Define MPI communicator for zonal sum 498 237 499 238 IF( ln_subbas ) THEN ! load sub-basin mask 500 CALL iom_open( 'subbasins', inum )239 CALL iom_open( 'subbasins', inum, ldstop = .FALSE. ) 501 240 CALL iom_get( inum, jpdom_data, 'atlmsk', btmsk(:,:,2) ) ! Atlantic basin 502 241 CALL iom_get( inum, jpdom_data, 'pacmsk', btmsk(:,:,3) ) ! Pacific basin … … 508 247 END WHERE 509 248 ENDIF 249 510 250 btmsk(:,:,1) = tmask_i(:,:) ! global ocean 511 251 … … 513 253 btmsk(:,:,jn) = btmsk(:,:,jn) * tmask_i(:,:) ! interior domain only 514 254 END DO 515 516 IF( lk_vvl ) CALL ctl_stop( 'diaptr: error in vvl case as constant i-mean surface is used' ) 517 518 ! ! i-sum of e1v*e3v surface and its inverse 519 DO jn = 1, nptr 520 sjk(:,:,jn) = ptr_tjk( tmask(:,:,:), btmsk(:,:,jn) ) 521 r1_sjk(:,:,jn) = 0._wp 522 WHERE( sjk(:,:,jn) /= 0._wp ) r1_sjk(:,:,jn) = 1._wp / sjk(:,:,jn) 523 END DO 524 525 ! Initialise arrays to zero because diatpr is called before they are first calculated 526 ! Note that this means diagnostics will not be exactly correct when model run is restarted. 527 htr_adv(:) = 0._wp ; str_adv(:) = 0._wp ; htr_ldf(:) = 0._wp ; str_ldf(:) = 0._wp 528 529 #if defined key_mpp_mpi 530 iglo (1) = jpjglo ! MPP case using MPI ('key_mpp_mpi') 531 iloc (1) = nlcj 532 iabsf(1) = njmppt(narea) 533 iabsl(:) = iabsf(:) + iloc(:) - 1 534 ihals(1) = nldj - 1 535 ihale(1) = nlcj - nlej 536 idid (1) = 2 537 CALL flio_dom_set( jpnj, nproc/jpni, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom_ptr ) 538 #else 539 nidom_ptr = FLIO_DOM_NONE 540 #endif 541 IF( nn_timing == 1 ) CALL timing_stop('dia_ptr_init') 542 ! 255 256 ! Initialise arrays to zero because diatpr is called before they are first calculated 257 ! Note that this means diagnostics will not be exactly correct when model run is restarted. 258 htr_adv(:) = 0._wp ; str_adv(:) = 0._wp 259 htr_ldf(:) = 0._wp ; str_ldf(:) = 0._wp 260 ! 543 261 ENDIF 544 262 ! … … 546 264 547 265 548 SUBROUTINE dia_ptr_wri( kt ) 549 !!--------------------------------------------------------------------- 550 !! *** ROUTINE dia_ptr_wri *** 551 !! 552 !! ** Purpose : output of poleward fluxes 553 !! 554 !! ** Method : NetCDF file 555 !!---------------------------------------------------------------------- 556 !! 557 INTEGER, INTENT(in) :: kt ! ocean time-step index 558 !! 559 INTEGER, SAVE :: nhoridz, ndepidzt, ndepidzw 560 INTEGER, SAVE :: ndim , ndim_atl , ndim_pac , ndim_ind , ndim_ipc 561 INTEGER, SAVE :: ndim_atl_30 , ndim_pac_30 , ndim_ind_30 , ndim_ipc_30 562 INTEGER, SAVE :: ndim_h, ndim_h_atl_30, ndim_h_pac_30, ndim_h_ind_30, ndim_h_ipc_30 563 !! 564 CHARACTER (len=40) :: clhstnam, clop, clop_once, cl_comment ! temporary names 565 INTEGER :: iline, it, itmod, ji, jj, jk ! 566 #if defined key_iomput 567 INTEGER :: inum ! temporary logical unit 266 FUNCTION dia_ptr_alloc() 267 !!---------------------------------------------------------------------- 268 !! *** ROUTINE dia_ptr_alloc *** 269 !!---------------------------------------------------------------------- 270 INTEGER :: dia_ptr_alloc ! return value 271 INTEGER, DIMENSION(3) :: ierr 272 !!---------------------------------------------------------------------- 273 ierr(:) = 0 274 ! 275 ALLOCATE( btmsk(jpi,jpj,nptr) , & 276 & htr_adv(jpj) , str_adv(jpj) , & 277 & htr_ldf(jpj) , str_ldf(jpj) , STAT=ierr(1) ) 278 ! 279 ALLOCATE( p_fval1d(jpj), p_fval2d(jpj,jpk), Stat=ierr(2)) 280 ! 281 ALLOCATE( btm30(jpi,jpj), STAT=ierr(3) ) 282 283 ! 284 dia_ptr_alloc = MAXVAL( ierr ) 285 IF(lk_mpp) CALL mpp_sum( dia_ptr_alloc ) 286 ! 287 END FUNCTION dia_ptr_alloc 288 289 290 FUNCTION ptr_sj_3d( pva, pmsk ) RESULT ( p_fval ) 291 !!---------------------------------------------------------------------- 292 !! *** ROUTINE ptr_sj_3d *** 293 !! 294 !! ** Purpose : i-k sum computation of a j-flux array 295 !! 296 !! ** Method : - i-k sum of pva using the interior 2D vmask (vmask_i). 297 !! pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v) 298 !! 299 !! ** Action : - p_fval: i-k-mean poleward flux of pva 300 !!---------------------------------------------------------------------- 301 REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) :: pva ! mask flux array at V-point 302 REAL(wp), INTENT(in), DIMENSION(jpi,jpj), OPTIONAL :: pmsk ! Optional 2D basin mask 303 ! 304 INTEGER :: ji, jj, jk ! dummy loop arguments 305 INTEGER :: ijpj ! ??? 306 REAL(wp), POINTER, DIMENSION(:) :: p_fval ! function value 307 !!-------------------------------------------------------------------- 308 ! 309 p_fval => p_fval1d 310 311 ijpj = jpj 312 p_fval(:) = 0._wp 313 IF( PRESENT( pmsk ) ) THEN 314 DO jk = 1, jpkm1 315 DO jj = 2, jpjm1 316 DO ji = fs_2, fs_jpim1 ! Vector opt. 317 p_fval(jj) = p_fval(jj) + pva(ji,jj,jk) * tmask_i(ji,jj) * pmsk(ji,jj) 318 END DO 319 END DO 320 END DO 321 ELSE 322 DO jk = 1, jpkm1 323 DO jj = 2, jpjm1 324 DO ji = fs_2, fs_jpim1 ! Vector opt. 325 p_fval(jj) = p_fval(jj) + pva(ji,jj,jk) * tmask_i(ji,jj) 326 END DO 327 END DO 328 END DO 329 ENDIF 330 #if defined key_mpp_mpi 331 IF(lk_mpp) CALL mpp_sum( p_fval, ijpj, ncomm_znl) 568 332 #endif 569 REAL(wp) :: zsto, zout, zdt, zjulian ! temporary scalars 570 !! 571 REAL(wp), POINTER, DIMENSION(:) :: zphi, zfoo ! 1D workspace 572 REAL(wp), POINTER, DIMENSION(:,:) :: z_1 ! 2D workspace 573 !!-------------------------------------------------------------------- 574 ! 575 CALL wrk_alloc( jpj , zphi , zfoo ) 576 CALL wrk_alloc( jpj , jpk , z_1 ) 577 578 ! define time axis 579 it = kt / nn_fptr 580 itmod = kt - nit000 + 1 581 582 ! Initialization 583 ! -------------- 584 IF( kt == nit000 ) THEN 585 niter = ( nit000 - 1 ) / nn_fptr 586 zdt = rdt 587 IF( nacc == 1 ) zdt = rdtmin 588 ! 589 IF(lwp) THEN 590 WRITE(numout,*) 591 WRITE(numout,*) 'dia_ptr_wri : poleward transport and msf writing: initialization , niter = ', niter 592 WRITE(numout,*) '~~~~~~~~~~~~' 593 ENDIF 594 595 ! Reference latitude (used in plots) 596 ! ------------------ 597 ! ! ======================= 598 IF( cp_cfg == "orca" ) THEN ! ORCA configurations 599 ! ! ======================= 600 IF( jp_cfg == 05 ) iline = 192 ! i-line that passes near the North Pole 601 IF( jp_cfg == 025 ) iline = 384 ! i-line that passes near the North Pole 602 IF( jp_cfg == 1 ) iline = 96 ! i-line that passes near the North Pole 603 IF( jp_cfg == 2 ) iline = 48 ! i-line that passes near the North Pole 604 IF( jp_cfg == 4 ) iline = 24 ! i-line that passes near the North Pole 605 zphi(1:jpj) = 0._wp 606 DO ji = mi0(iline), mi1(iline) 607 zphi(1:jpj) = gphiv(ji,:) ! if iline is in the local domain 608 ! Correct highest latitude for some configurations - will work if domain is parallelized in J ? 609 IF( jp_cfg == 05 ) THEN 610 DO jj = mj0(jpjdta), mj1(jpjdta) 611 zphi( jj ) = zphi(mj0(jpjdta-1)) + ( zphi(mj0(jpjdta-1))-zphi(mj0(jpjdta-2)) ) * 0.5_wp 612 zphi( jj ) = MIN( zphi(jj), 90._wp ) 613 END DO 614 END IF 615 IF( jp_cfg == 1 .OR. jp_cfg == 2 .OR. jp_cfg == 4 ) THEN 616 DO jj = mj0(jpjdta-1), mj1(jpjdta-1) 617 zphi( jj ) = 88.5_wp 618 END DO 619 DO jj = mj0(jpjdta ), mj1(jpjdta ) 620 zphi( jj ) = 89.5_wp 621 END DO 622 END IF 623 END DO 624 ! provide the correct zphi to all local domains 333 ! 334 END FUNCTION ptr_sj_3d 335 336 337 FUNCTION ptr_sj_2d( pva, pmsk ) RESULT ( p_fval ) 338 !!---------------------------------------------------------------------- 339 !! *** ROUTINE ptr_sj_2d *** 340 !! 341 !! ** Purpose : "zonal" and vertical sum computation of a i-flux array 342 !! 343 !! ** Method : - i-k sum of pva using the interior 2D vmask (vmask_i). 344 !! pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v) 345 !! 346 !! ** Action : - p_fval: i-k-mean poleward flux of pva 347 !!---------------------------------------------------------------------- 348 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) :: pva ! mask flux array at V-point 349 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj), OPTIONAL :: pmsk ! Optional 2D basin mask 350 ! 351 INTEGER :: ji,jj ! dummy loop arguments 352 INTEGER :: ijpj ! ??? 353 REAL(wp), POINTER, DIMENSION(:) :: p_fval ! function value 354 !!-------------------------------------------------------------------- 355 ! 356 p_fval => p_fval1d 357 358 ijpj = jpj 359 p_fval(:) = 0._wp 360 IF( PRESENT( pmsk ) ) THEN 361 DO jj = 2, jpjm1 362 DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ? 363 p_fval(jj) = p_fval(jj) + pva(ji,jj) * tmask_i(ji,jj) * pmsk(ji,jj) 364 END DO 365 END DO 366 ELSE 367 DO jj = 2, jpjm1 368 DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ? 369 p_fval(jj) = p_fval(jj) + pva(ji,jj) * tmask_i(ji,jj) 370 END DO 371 END DO 372 ENDIF 625 373 #if defined key_mpp_mpi 626 CALL mpp_sum( zphi, jpj, ncomm_znl )374 CALL mpp_sum( p_fval, ijpj, ncomm_znl ) 627 375 #endif 628 ! ! ======================= 629 ELSE ! OTHER configurations 630 ! ! ======================= 631 zphi(1:jpj) = gphiv(1,:) ! assume lat/lon coordinate, select the first i-line 632 ! 633 ENDIF 634 ! 635 ! Work only on westmost processor (will not work if mppini2 is used) 376 ! 377 END FUNCTION ptr_sj_2d 378 379 380 FUNCTION ptr_sjk( pta, pmsk ) RESULT ( p_fval ) 381 !!---------------------------------------------------------------------- 382 !! *** ROUTINE ptr_sjk *** 383 !! 384 !! ** Purpose : i-sum computation of an array 385 !! 386 !! ** Method : - i-sum of pva using the interior 2D vmask (vmask_i). 387 !! 388 !! ** Action : - p_fval: i-mean poleward flux of pva 389 !!---------------------------------------------------------------------- 390 !! 391 IMPLICIT none 392 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) :: pta ! mask flux array at V-point 393 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) , OPTIONAL :: pmsk ! Optional 2D basin mask 394 !! 395 INTEGER :: ji, jj, jk ! dummy loop arguments 396 REAL(wp), POINTER, DIMENSION(:,:) :: p_fval ! return function value 636 397 #if defined key_mpp_mpi 637 IF( l_znl_root ) THEN 398 INTEGER, DIMENSION(1) :: ish 399 INTEGER, DIMENSION(2) :: ish2 400 INTEGER :: ijpjjpk 401 REAL(wp), DIMENSION(jpj*jpk) :: zwork ! mask flux array at V-point 638 402 #endif 639 ! 640 ! OPEN netcdf file 641 ! ---------------- 642 ! Define frequency of output and means 643 zsto = nn_fptr * zdt 644 IF( ln_mskland ) THEN ! put 1.e+20 on land (very expensive!!) 645 clop = "ave(only(x))" 646 clop_once = "once(only(x))" 647 ELSE ! no use of the mask value (require less cpu time) 648 clop = "ave(x)" 649 clop_once = "once" 650 ENDIF 651 652 zout = nn_fwri * zdt 653 zfoo(1:jpj) = 0._wp 654 655 CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian ) ! Compute julian date from starting date of the run 656 zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment 657 658 #if defined key_iomput 659 ! Requested by IPSL people, use by their postpro... 660 IF(lwp) THEN 661 CALL dia_nam( clhstnam, nn_fwri,' ' ) 662 CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 663 WRITE(inum,*) clhstnam 664 CLOSE(inum) 665 ENDIF 403 !!-------------------------------------------------------------------- 404 ! 405 p_fval => p_fval2d 406 407 p_fval(:,:) = 0._wp 408 ! 409 IF( PRESENT( pmsk ) ) THEN 410 DO jk = 1, jpkm1 411 DO jj = 2, jpjm1 412 !!gm here, use of tmask_i ==> no need of loop over nldi, nlei.... 413 DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ? 414 p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * pmsk(ji,jj) 415 END DO 416 END DO 417 END DO 418 ELSE 419 DO jk = 1, jpkm1 420 DO jj = 2, jpjm1 421 DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ? 422 p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * tmask_i(ji,jj) 423 END DO 424 END DO 425 END DO 426 END IF 427 ! 428 #if defined key_mpp_mpi 429 ijpjjpk = jpj*jpk 430 ish(1) = ijpjjpk ; ish2(1) = jpj ; ish2(2) = jpk 431 zwork(1:ijpjjpk) = RESHAPE( p_fval, ish ) 432 CALL mpp_sum( zwork, ijpjjpk, ncomm_znl ) 433 p_fval(:,:) = RESHAPE( zwork, ish2 ) 666 434 #endif 667 668 CALL dia_nam( clhstnam, nn_fwri, 'diaptr' ) 669 IF(lwp)WRITE( numout,*)" Name of diaptr NETCDF file : ", clhstnam 670 671 ! Horizontal grid : zphi() 672 CALL histbeg(clhstnam, 1, zfoo, jpj, zphi, & 673 1, 1, 1, jpj, niter, zjulian, zdt*nn_fptr, nhoridz, numptr, domain_id=nidom_ptr) 674 ! Vertical grids : gdept_1d, gdepw_1d 675 CALL histvert( numptr, "deptht", "Vertical T levels", & 676 & "m", jpk, gdept_1d, ndepidzt, "down" ) 677 CALL histvert( numptr, "depthw", "Vertical W levels", & 678 & "m", jpk, gdepw_1d, ndepidzw, "down" ) 679 ! 680 CALL wheneq ( jpj*jpk, MIN(sjk(:,:,1), 1._wp), 1, 1., ndex , ndim ) ! Lat-Depth 681 CALL wheneq ( jpj , MIN(sjk(:,1,1), 1._wp), 1, 1., ndex_h, ndim_h ) ! Lat 682 683 IF( ln_subbas ) THEN 684 z_1(:,1) = 1._wp 685 WHERE ( gphit(jpi/2,:) < -30._wp ) z_1(:,1) = 0._wp 686 DO jk = 2, jpk 687 z_1(:,jk) = z_1(:,1) 688 END DO 689 ! ! Atlantic (jn=2) 690 CALL wheneq ( jpj*jpk, MIN(sjk(:,:,2) , 1._wp), 1, 1., ndex_atl , ndim_atl ) ! Lat-Depth 691 CALL wheneq ( jpj*jpk, MIN(sjk(:,:,2)*z_1(:,:), 1._wp), 1, 1., ndex_atl_30 , ndim_atl_30 ) ! Lat-Depth 692 CALL wheneq ( jpj , MIN(sjk(:,1,2)*z_1(:,1), 1._wp), 1, 1., ndex_h_atl_30, ndim_h_atl_30 ) ! Lat 693 ! ! Pacific (jn=3) 694 CALL wheneq ( jpj*jpk, MIN(sjk(:,:,3) , 1._wp), 1, 1., ndex_pac , ndim_pac ) ! Lat-Depth 695 CALL wheneq ( jpj*jpk, MIN(sjk(:,:,3)*z_1(:,:), 1._wp), 1, 1., ndex_pac_30 , ndim_pac_30 ) ! Lat-Depth 696 CALL wheneq ( jpj , MIN(sjk(:,1,3)*z_1(:,1), 1._wp), 1, 1., ndex_h_pac_30, ndim_h_pac_30 ) ! Lat 697 ! ! Indian (jn=4) 698 CALL wheneq ( jpj*jpk, MIN(sjk(:,:,4) , 1._wp), 1, 1., ndex_ind , ndim_ind ) ! Lat-Depth 699 CALL wheneq ( jpj*jpk, MIN(sjk(:,:,4)*z_1(:,:), 1._wp), 1, 1., ndex_ind_30 , ndim_ind_30 ) ! Lat-Depth 700 CALL wheneq ( jpj , MIN(sjk(:,1,4)*z_1(:,1), 1._wp), 1, 1., ndex_h_ind_30, ndim_h_ind_30 ) ! Lat 701 ! ! Indo-Pacific (jn=5) 702 CALL wheneq ( jpj*jpk, MIN(sjk(:,:,5) , 1._wp), 1, 1., ndex_ipc , ndim_ipc ) ! Lat-Depth 703 CALL wheneq ( jpj*jpk, MIN(sjk(:,:,5)*z_1(:,:), 1._wp), 1, 1., ndex_ipc_30 , ndim_ipc_30 ) ! Lat-Depth 704 CALL wheneq ( jpj , MIN(sjk(:,1,5)*z_1(:,1), 1._wp), 1, 1., ndex_h_ipc_30, ndim_h_ipc_30 ) ! Lat 705 ENDIF 706 ! 707 #if defined key_diaeiv 708 cl_comment = ' (Bolus part included)' 709 #else 710 cl_comment = ' ' 711 #endif 712 IF( ln_diaznl ) THEN ! Zonal mean T and S 713 CALL histdef( numptr, "zotemglo", "Zonal Mean Temperature","C" , & 714 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 715 CALL histdef( numptr, "zosalglo", "Zonal Mean Salinity","PSU" , & 716 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 717 718 CALL histdef( numptr, "zosrfglo", "Zonal Mean Surface","m^2" , & 719 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout ) 720 ! 721 IF (ln_subbas) THEN 722 CALL histdef( numptr, "zotematl", "Zonal Mean Temperature: Atlantic","C" , & 723 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 724 CALL histdef( numptr, "zosalatl", "Zonal Mean Salinity: Atlantic","PSU" , & 725 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 726 CALL histdef( numptr, "zosrfatl", "Zonal Mean Surface: Atlantic","m^2" , & 727 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout ) 728 729 CALL histdef( numptr, "zotempac", "Zonal Mean Temperature: Pacific","C" , & 730 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 731 CALL histdef( numptr, "zosalpac", "Zonal Mean Salinity: Pacific","PSU" , & 732 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 733 CALL histdef( numptr, "zosrfpac", "Zonal Mean Surface: Pacific","m^2" , & 734 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout ) 735 736 CALL histdef( numptr, "zotemind", "Zonal Mean Temperature: Indian","C" , & 737 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 738 CALL histdef( numptr, "zosalind", "Zonal Mean Salinity: Indian","PSU" , & 739 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 740 CALL histdef( numptr, "zosrfind", "Zonal Mean Surface: Indian","m^2" , & 741 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout ) 742 743 CALL histdef( numptr, "zotemipc", "Zonal Mean Temperature: Pacific+Indian","C" , & 744 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 745 CALL histdef( numptr, "zosalipc", "Zonal Mean Salinity: Pacific+Indian","PSU" , & 746 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) 747 CALL histdef( numptr, "zosrfipc", "Zonal Mean Surface: Pacific+Indian","m^2" , & 748 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop_once, zsto, zout ) 749 ENDIF 750 ENDIF 751 ! 752 ! Meridional Stream-Function (Eulerian and Bolus) 753 CALL histdef( numptr, "zomsfglo", "Meridional Stream-Function: Global"//TRIM(cl_comment),"Sv" , & 754 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 755 IF( ln_subbas .AND. ln_diaznl ) THEN 756 CALL histdef( numptr, "zomsfatl", "Meridional Stream-Function: Atlantic"//TRIM(cl_comment),"Sv" , & 757 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 758 CALL histdef( numptr, "zomsfpac", "Meridional Stream-Function: Pacific"//TRIM(cl_comment),"Sv" , & 759 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 760 CALL histdef( numptr, "zomsfind", "Meridional Stream-Function: Indian"//TRIM(cl_comment),"Sv" , & 761 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 762 CALL histdef( numptr, "zomsfipc", "Meridional Stream-Function: Indo-Pacific"//TRIM(cl_comment),"Sv" ,& 763 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 764 ENDIF 765 ! 766 ! Heat transport 767 CALL histdef( numptr, "sophtadv", "Advective Heat Transport" , & 768 "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 769 CALL histdef( numptr, "sophtldf", "Diffusive Heat Transport" , & 770 "PW",1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 771 IF ( ln_ptrcomp ) THEN 772 CALL histdef( numptr, "sophtove", "Overturning Heat Transport" , & 773 "PW",1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 774 END IF 775 IF( ln_subbas ) THEN 776 CALL histdef( numptr, "sohtatl", "Heat Transport Atlantic"//TRIM(cl_comment), & 777 "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 778 CALL histdef( numptr, "sohtpac", "Heat Transport Pacific"//TRIM(cl_comment) , & 779 "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 780 CALL histdef( numptr, "sohtind", "Heat Transport Indian"//TRIM(cl_comment) , & 781 "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 782 CALL histdef( numptr, "sohtipc", "Heat Transport Pacific+Indian"//TRIM(cl_comment), & 783 "PW", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 784 ENDIF 785 ! 786 ! Salt transport 787 CALL histdef( numptr, "sopstadv", "Advective Salt Transport" , & 788 "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 789 CALL histdef( numptr, "sopstldf", "Diffusive Salt Transport" , & 790 "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 791 IF ( ln_ptrcomp ) THEN 792 CALL histdef( numptr, "sopstove", "Overturning Salt Transport" , & 793 "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 794 END IF 795 #if defined key_diaeiv 796 ! Eddy induced velocity 797 CALL histdef( numptr, "zomsfeiv", "Bolus Meridional Stream-Function: global", & 798 "Sv" , 1, jpj, nhoridz, jpk, 1, jpk, ndepidzw, 32, clop, zsto, zout ) 799 CALL histdef( numptr, "sophteiv", "Bolus Advective Heat Transport", & 800 "PW" , 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 801 CALL histdef( numptr, "sopsteiv", "Bolus Advective Salt Transport", & 802 "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 803 #endif 804 IF( ln_subbas ) THEN 805 CALL histdef( numptr, "sostatl", "Salt Transport Atlantic"//TRIM(cl_comment) , & 806 "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 807 CALL histdef( numptr, "sostpac", "Salt Transport Pacific"//TRIM(cl_comment) , & 808 "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 809 CALL histdef( numptr, "sostind", "Salt Transport Indian"//TRIM(cl_comment) , & 810 "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 811 CALL histdef( numptr, "sostipc", "Salt Transport Pacific+Indian"//TRIM(cl_comment), & 812 "Giga g/s", 1, jpj, nhoridz, 1, 1, 1, -99, 32, clop, zsto, zout ) 813 ENDIF 814 ! 815 CALL histend( numptr ) 816 ! 817 END IF 818 #if defined key_mpp_mpi 819 END IF 820 #endif 821 822 #if defined key_mpp_mpi 823 IF( MOD( itmod, nn_fptr ) == 0 .AND. l_znl_root ) THEN 824 #else 825 IF( MOD( itmod, nn_fptr ) == 0 ) THEN 826 #endif 827 niter = niter + 1 828 829 IF( ln_diaznl ) THEN 830 CALL histwrite( numptr, "zosrfglo", niter, sjk (:,:,1) , ndim, ndex ) 831 CALL histwrite( numptr, "zotemglo", niter, tn_jk(:,:,1) , ndim, ndex ) 832 CALL histwrite( numptr, "zosalglo", niter, sn_jk(:,:,1) , ndim, ndex ) 833 834 IF (ln_subbas) THEN 835 CALL histwrite( numptr, "zosrfatl", niter, sjk(:,:,2), ndim_atl, ndex_atl ) 836 CALL histwrite( numptr, "zosrfpac", niter, sjk(:,:,3), ndim_pac, ndex_pac ) 837 CALL histwrite( numptr, "zosrfind", niter, sjk(:,:,4), ndim_ind, ndex_ind ) 838 CALL histwrite( numptr, "zosrfipc", niter, sjk(:,:,5), ndim_ipc, ndex_ipc ) 839 840 CALL histwrite( numptr, "zotematl", niter, tn_jk(:,:,2) , ndim_atl, ndex_atl ) 841 CALL histwrite( numptr, "zosalatl", niter, sn_jk(:,:,2) , ndim_atl, ndex_atl ) 842 CALL histwrite( numptr, "zotempac", niter, tn_jk(:,:,3) , ndim_pac, ndex_pac ) 843 CALL histwrite( numptr, "zosalpac", niter, sn_jk(:,:,3) , ndim_pac, ndex_pac ) 844 CALL histwrite( numptr, "zotemind", niter, tn_jk(:,:,4) , ndim_ind, ndex_ind ) 845 CALL histwrite( numptr, "zosalind", niter, sn_jk(:,:,4) , ndim_ind, ndex_ind ) 846 CALL histwrite( numptr, "zotemipc", niter, tn_jk(:,:,5) , ndim_ipc, ndex_ipc ) 847 CALL histwrite( numptr, "zosalipc", niter, sn_jk(:,:,5) , ndim_ipc, ndex_ipc ) 848 END IF 849 ENDIF 850 851 ! overturning outputs: 852 CALL histwrite( numptr, "zomsfglo", niter, v_msf(:,:,1), ndim, ndex ) 853 IF( ln_subbas .AND. ln_diaznl ) THEN 854 CALL histwrite( numptr, "zomsfatl", niter, v_msf(:,:,2) , ndim_atl_30, ndex_atl_30 ) 855 CALL histwrite( numptr, "zomsfpac", niter, v_msf(:,:,3) , ndim_pac_30, ndex_pac_30 ) 856 CALL histwrite( numptr, "zomsfind", niter, v_msf(:,:,4) , ndim_ind_30, ndex_ind_30 ) 857 CALL histwrite( numptr, "zomsfipc", niter, v_msf(:,:,5) , ndim_ipc_30, ndex_ipc_30 ) 858 ENDIF 859 #if defined key_diaeiv 860 CALL histwrite( numptr, "zomsfeiv", niter, v_msf_eiv(:,:,1), ndim , ndex ) 861 #endif 862 863 ! heat transport outputs: 864 IF( ln_subbas ) THEN 865 CALL histwrite( numptr, "sohtatl", niter, htr(:,2) , ndim_h_atl_30, ndex_h_atl_30 ) 866 CALL histwrite( numptr, "sohtpac", niter, htr(:,3) , ndim_h_pac_30, ndex_h_pac_30 ) 867 CALL histwrite( numptr, "sohtind", niter, htr(:,4) , ndim_h_ind_30, ndex_h_ind_30 ) 868 CALL histwrite( numptr, "sohtipc", niter, htr(:,5) , ndim_h_ipc_30, ndex_h_ipc_30 ) 869 CALL histwrite( numptr, "sostatl", niter, str(:,2) , ndim_h_atl_30, ndex_h_atl_30 ) 870 CALL histwrite( numptr, "sostpac", niter, str(:,3) , ndim_h_pac_30, ndex_h_pac_30 ) 871 CALL histwrite( numptr, "sostind", niter, str(:,4) , ndim_h_ind_30, ndex_h_ind_30 ) 872 CALL histwrite( numptr, "sostipc", niter, str(:,5) , ndim_h_ipc_30, ndex_h_ipc_30 ) 873 ENDIF 874 875 CALL histwrite( numptr, "sophtadv", niter, htr_adv , ndim_h, ndex_h ) 876 CALL histwrite( numptr, "sophtldf", niter, htr_ldf , ndim_h, ndex_h ) 877 CALL histwrite( numptr, "sopstadv", niter, str_adv , ndim_h, ndex_h ) 878 CALL histwrite( numptr, "sopstldf", niter, str_ldf , ndim_h, ndex_h ) 879 IF( ln_ptrcomp ) THEN 880 CALL histwrite( numptr, "sopstove", niter, str_ove(:) , ndim_h, ndex_h ) 881 CALL histwrite( numptr, "sophtove", niter, htr_ove(:) , ndim_h, ndex_h ) 882 ENDIF 883 #if defined key_diaeiv 884 CALL histwrite( numptr, "sophteiv", niter, htr_eiv(:,1) , ndim_h, ndex_h ) 885 CALL histwrite( numptr, "sopsteiv", niter, str_eiv(:,1) , ndim_h, ndex_h ) 886 #endif 887 ! 888 ENDIF 889 ! 890 CALL wrk_dealloc( jpj , zphi , zfoo ) 891 CALL wrk_dealloc( jpj , jpk, z_1 ) 892 ! 893 END SUBROUTINE dia_ptr_wri 435 ! 436 END FUNCTION ptr_sjk 437 894 438 895 439 !!====================================================================== -
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90
r5123 r5147 51 51 REAL(wp), PUBLIC :: rcp !: ocean specific heat [J/Kelvin] 52 52 REAL(wp), PUBLIC :: r1_rcp !: = 1. / rcp [Kelvin/J] 53 REAL(wp), PUBLIC :: rau0_rcp !: = rau0 * rcp 53 54 REAL(wp), PUBLIC :: r1_rau0_rcp !: = 1. / ( rau0 * rcp ) 54 55 -
trunk/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r5123 r5147 1336 1336 zlatpira = (/ -19.0, -14.0, -8.0, 0.0, 4.0, 8.0, 12.0, 15.0, 20.0 /) 1337 1337 CALL set_mooring( zlonpira, zlatpira ) 1338 1339 ! diaptr : zonal mean 1340 CALL dom_ngb( 180., 90., ix, iy, 'T' ) ! i-line that passes near the North Pole : Reference latitude (used in plots) 1341 CALL iom_set_domain_attr ('ptr', zoom_ibegin=ix, zoom_nj=jpjglo) 1342 CALL iom_update_file_name('ptr') 1343 ! 1338 1344 1339 1345 END SUBROUTINE set_xmlatt -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90
r4990 r5147 1589 1589 END SELECT 1590 1590 ! 1591 rau0_rcp = rau0 * rcp 1591 1592 r1_rau0 = 1._wp / rau0 1592 1593 r1_rcp = 1._wp / rcp 1593 r1_rau0_rcp = 1._wp / ( rau0 * rcp )1594 r1_rau0_rcp = 1._wp / rau0_rcp 1594 1595 ! 1595 1596 IF(lwp) WRITE(numout,*) … … 1597 1598 IF(lwp) WRITE(numout,*) ' 1. / rau0 r1_rau0 = ', r1_rau0, ' m^3/kg' 1598 1599 IF(lwp) WRITE(numout,*) ' ocean specific heat rcp = ', rcp , ' J/Kelvin' 1600 IF(lwp) WRITE(numout,*) ' rau0 * rcp rau0_rcp = ', rau0_rcp 1599 1601 IF(lwp) WRITE(numout,*) ' 1. / ( rau0 * rcp ) r1_rau0_rcp = ', r1_rau0_rcp 1600 1602 ! -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90
r5130 r5147 26 26 USE cla ! cross land advection (cla_traadv routine) 27 27 USE ldftra_oce ! lateral diffusion coefficient on tracers 28 ! 28 29 USE in_out_manager ! I/O manager 29 30 USE iom ! I/O module … … 33 34 USE timing ! Timing 34 35 USE sbc_oce 36 USE diaptr ! Poleward heat transport 35 37 36 38 … … 111 113 ! 112 114 IF( ln_mle ) CALL tra_adv_mle( kt, nit000, zun, zvn, zwn, 'TRA' ) ! add the mle transport (if necessary) 115 ! 113 116 CALL iom_put( "uocetr_eff", zun ) ! output effective transport 114 117 CALL iom_put( "vocetr_eff", zvn ) 115 118 CALL iom_put( "wocetr_eff", zwn ) 116 119 ! 120 IF( ln_diaptr ) CALL dia_ptr( zvn ) ! diagnose the effective MSF 121 ! 122 117 123 SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==! 118 CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, nit000, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! 2nd order centered119 CASE ( 2 ) ; CALL tra_adv_tvd ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! TVD120 CASE ( 3 ) ; CALL tra_adv_muscl ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsa, jpts, ln_traadv_msc_ups ) ! MUSCL121 CASE ( 4 ) ; CALL tra_adv_muscl2 ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! MUSCL2122 CASE ( 5 ) ; CALL tra_adv_ubs ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! UBS123 CASE ( 6 ) ; CALL tra_adv_qck ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! QUICKEST124 CASE ( 7 ) ; CALL tra_adv_tvd_zts( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! TVD ZTS124 CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, nit000, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! 2nd order centered 125 CASE ( 2 ) ; CALL tra_adv_tvd ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! TVD 126 CASE ( 3 ) ; CALL tra_adv_muscl ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsa, jpts, ln_traadv_msc_ups ) ! MUSCL 127 CASE ( 4 ) ; CALL tra_adv_muscl2 ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! MUSCL2 128 CASE ( 5 ) ; CALL tra_adv_ubs ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! UBS 129 CASE ( 6 ) ; CALL tra_adv_qck ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! QUICKEST 130 CASE ( 7 ) ; CALL tra_adv_tvd_zts( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! TVD ZTS 125 131 ! 126 132 CASE (-1 ) !== esopa: test all possibility with control print ==! -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90
r4990 r5147 279 279 END IF 280 280 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 281 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 )) THEN282 IF( jn == jp_tem ) htr_adv(:) = ptr_ vj( zwy(:,:,:) )283 IF( jn == jp_sal ) str_adv(:) = ptr_ vj( zwy(:,:,:) )281 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 282 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 283 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 284 284 ENDIF 285 285 ! -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90
r4990 r5147 21 21 USE trdtra ! tracers trends manager 22 22 USE dynspg_oce ! choice/control of key cpp for surface pressure gradient 23 USE sbcrnf 23 USE sbcrnf ! river runoffs 24 24 USE diaptr ! poleward transport diagnostics 25 25 ! … … 219 219 END IF 220 220 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 221 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 )) THEN222 IF( jn == jp_tem ) htr_adv(:) = ptr_ vj( zwy(:,:,:) )223 IF( jn == jp_sal ) str_adv(:) = ptr_ vj( zwy(:,:,:) )221 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 222 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 223 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 224 224 ENDIF 225 225 -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90
r4990 r5147 200 200 201 201 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 202 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 )) THEN203 IF( jn == jp_tem ) htr_adv(:) = ptr_ vj( zwy(:,:,:) )204 IF( jn == jp_sal ) str_adv(:) = ptr_ vj( zwy(:,:,:) )202 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 203 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 204 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 205 205 ENDIF 206 206 -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90
r4990 r5147 355 355 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptn(:,:,:,jn) ) 356 356 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 357 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 )) THEN358 IF( jn == jp_tem ) htr_adv(:) = ptr_ vj( zwy(:,:,:) )359 IF( jn == jp_sal ) str_adv(:) = ptr_ vj( zwy(:,:,:) )357 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 358 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 359 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 360 360 ENDIF 361 361 ! -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90
r5120 r5147 193 193 END IF 194 194 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 195 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 )) THEN196 IF( jn == jp_tem ) htr_adv(:) = ptr_ vj( zwy(:,:,:) )197 IF( jn == jp_sal ) str_adv(:) = ptr_ vj( zwy(:,:,:) )195 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 196 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 197 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 198 198 ENDIF 199 199 … … 264 264 END IF 265 265 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 266 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 )) THEN267 IF( jn == jp_tem ) htr_adv(:) = ptr_ vj( zwy(:,:,:) ) + htr_adv(:)268 IF( jn == jp_sal ) str_adv(:) = ptr_ vj( zwy(:,:,:) ) + str_adv(:)266 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 267 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) + htr_adv(:) 268 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) + str_adv(:) 269 269 ENDIF 270 270 ! … … 430 430 END IF 431 431 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 432 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 )) THEN433 IF( jn == jp_tem ) htr_adv(:) = ptr_ vj( zwy(:,:,:) )434 IF( jn == jp_sal ) str_adv(:) = ptr_ vj( zwy(:,:,:) )432 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 433 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 434 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 435 435 ENDIF 436 436 … … 556 556 END IF 557 557 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 558 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 )) THEN559 IF( jn == jp_tem ) htr_adv(:) = ptr_ vj( zwy(:,:,:) ) + htr_adv(:)560 IF( jn == jp_sal ) str_adv(:) = ptr_ vj( zwy(:,:,:) ) + str_adv(:)558 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 559 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) + htr_adv(:) 560 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) + str_adv(:) 561 561 ENDIF 562 562 ! -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90
r4990 r5147 177 177 END IF 178 178 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 179 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 )) THEN180 IF( jn == jp_tem ) htr_adv(:) = ptr_ vj( ztv(:,:,:) )181 IF( jn == jp_sal ) str_adv(:) = ptr_ vj( ztv(:,:,:) )179 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 180 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( ztv(:,:,:) ) 181 IF( jn == jp_sal ) str_adv(:) = ptr_sj( ztv(:,:,:) ) 182 182 ENDIF 183 183 -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90
r5120 r5147 173 173 ! 174 174 ! "zonal" mean lateral diffusive heat and salt transport 175 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 )) THEN176 IF( jn == jp_tem ) htr_ldf(:) = ptr_ vj( ztv(:,:,:) )177 IF( jn == jp_sal ) str_ldf(:) = ptr_ vj( ztv(:,:,:) )175 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 176 IF( jn == jp_tem ) htr_ldf(:) = ptr_sj( ztv(:,:,:) ) 177 IF( jn == jp_sal ) str_ldf(:) = ptr_sj( ztv(:,:,:) ) 178 178 ENDIF 179 179 ! ! =========== -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90
r4292 r5147 247 247 ! ! =============== 248 248 ! "Poleward" diffusive heat or salt transport 249 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( kaht == 2 ) .AND. ( MOD( kt, nn_fptr ) == 0 )) THEN249 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( kaht == 2 ) ) THEN 250 250 ! note sign is reversed to give down-gradient diffusive transports (#1043) 251 IF( jn == jp_tem) htr_ldf(:) = ptr_ vj( -zftv(:,:,:) )252 IF( jn == jp_sal) str_ldf(:) = ptr_ vj( -zftv(:,:,:) )251 IF( jn == jp_tem) htr_ldf(:) = ptr_sj( -zftv(:,:,:) ) 252 IF( jn == jp_sal) str_ldf(:) = ptr_sj( -zftv(:,:,:) ) 253 253 ENDIF 254 254 -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
r5120 r5147 110 110 REAL(wp) :: zmskv, zabe2, zcof2, zcoef4 ! - - 111 111 REAL(wp) :: zcoef0, zbtr, ztra ! - - 112 #if defined key_diaar5113 REAL(wp) :: zztmp ! local scalar114 #endif115 112 REAL(wp), POINTER, DIMENSION(:,: ) :: z2d 116 113 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdkt, zdk1t, zdit, zdjt, ztfw … … 240 237 ! 241 238 ! "Poleward" diffusive heat or salt transports (T-S case only) 242 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 )) THEN239 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 243 240 ! note sign is reversed to give down-gradient diffusive transports (#1043) 244 IF( jn == jp_tem) htr_ldf(:) = ptr_ vj( -zftv(:,:,:) )245 IF( jn == jp_sal) str_ldf(:) = ptr_ vj( -zftv(:,:,:) )241 IF( jn == jp_tem) htr_ldf(:) = ptr_sj( -zftv(:,:,:) ) 242 IF( jn == jp_sal) str_ldf(:) = ptr_sj( -zftv(:,:,:) ) 246 243 ENDIF 247 244 248 #if defined key_diaar5 249 IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN250 z2d(:,:) = 0._wp251 ! note sign is reversed to give down-gradient diffusive transports (#1043)252 zztmp = -1.0_wp * rau0 * rcp253 DO jk = 1, jpkm1254 DO jj = 2, jpjm1255 DO ji = fs_2, fs_jpim1 ! vector opt.256 z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk)245 IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN 246 ! 247 IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN 248 z2d(:,:) = 0._wp 249 DO jk = 1, jpkm1 250 DO jj = 2, jpjm1 251 DO ji = fs_2, fs_jpim1 ! vector opt. 252 z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk) 253 END DO 257 254 END DO 258 255 END DO 259 END DO 260 z2d(:,:) = zztmp * z2d(:,:) 261 CALL lbc_lnk( z2d, 'U', -1. ) 262 CALL iom_put( "udiff_heattr", z2d ) ! heat transport in i-direction 263 z2d(:,:) = 0._wp 264 DO jk = 1, jpkm1 265 DO jj = 2, jpjm1 266 DO ji = fs_2, fs_jpim1 ! vector opt. 267 z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk) 256 z2d(:,:) = - rau0_rcp * z2d(:,:) ! note sign is reversed to give down-gradient diffusive transports (#1043) 257 CALL lbc_lnk( z2d, 'U', -1. ) 258 CALL iom_put( "udiff_heattr", z2d ) ! heat transport in i-direction 259 ! 260 z2d(:,:) = 0._wp 261 DO jk = 1, jpkm1 262 DO jj = 2, jpjm1 263 DO ji = fs_2, fs_jpim1 ! vector opt. 264 z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk) 265 END DO 268 266 END DO 269 267 END DO 270 END DO271 z2d(:,:) = zztmp * z2d(:,:)272 CALL lbc_lnk( z2d, 'V', -1. )273 CALL iom_put( "vdiff_heattr", z2d ) ! heat transport in i-direction274 END IF275 #endif 268 z2d(:,:) = - rau0_rcp * z2d(:,:) ! note sign is reversed to give down-gradient diffusive transports (#1043) 269 CALL lbc_lnk( z2d, 'V', -1. ) 270 CALL iom_put( "vdiff_heattr", z2d ) ! heat transport in i-direction 271 END IF 272 ! 273 ENDIF 276 274 277 275 !!---------------------------------------------------------------------- -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90
r4990 r5147 113 113 REAL(wp) :: ze1ur, zdxt, ze2vr, ze3wr, zdyt, zdzt 114 114 REAL(wp) :: zah, zah_slp, zaei_slp 115 #if defined key_diaar5116 REAL(wp) :: zztmp ! local scalar117 #endif118 115 REAL(wp), POINTER, DIMENSION(:,: ) :: z2d 119 116 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdit, zdjt, ztfw … … 207 204 END DO 208 205 ! 209 #if defined key_iomput 210 IF( ln_traldf_gdia .AND. cdtype == 'TRA' ) THEN 211 CALL wrk_alloc( jpi , jpj , jpk , zw3d ) 212 DO jk=1,jpkm1 213 zw3d(:,:,jk) = (psix_eiv(:,:,jk+1) - psix_eiv(:,:,jk))/fse3u(:,:,jk) ! u_eiv = -dpsix/dz 214 END DO 215 zw3d(:,:,jpk) = 0._wp 216 CALL iom_put( "uoce_eiv", zw3d ) ! i-eiv current 217 218 DO jk=1,jpk-1 219 zw3d(:,:,jk) = (psiy_eiv(:,:,jk+1) - psiy_eiv(:,:,jk))/fse3v(:,:,jk) ! v_eiv = -dpsiy/dz 220 END DO 221 zw3d(:,:,jpk) = 0._wp 222 CALL iom_put( "voce_eiv", zw3d ) ! j-eiv current 223 224 DO jk=1,jpk-1 225 DO jj = 2, jpjm1 226 DO ji = fs_2, fs_jpim1 ! vector opt. 227 zw3d(ji,jj,jk) = (psiy_eiv(ji,jj,jk) - psiy_eiv(ji,jj-1,jk))/e2t(ji,jj) + & 228 & (psix_eiv(ji,jj,jk) - psix_eiv(ji-1,jj,jk))/e1t(ji,jj) ! w_eiv = dpsiy/dy + dpsiy/dx 229 END DO 230 END DO 231 END DO 232 zw3d(:,:,jpk) = 0._wp 233 CALL iom_put( "woce_eiv", zw3d ) ! vert. eiv current 234 CALL wrk_dealloc( jpi , jpj , jpk , zw3d ) 206 IF( iom_use("uoce_eiv") .OR. iom_use("voce_eiv") .OR. iom_use("woce_eiv") ) THEN 207 ! 208 IF( ln_traldf_gdia .AND. cdtype == 'TRA' ) THEN 209 CALL wrk_alloc( jpi , jpj , jpk , zw3d ) 210 DO jk=1,jpkm1 211 zw3d(:,:,jk) = (psix_eiv(:,:,jk+1) - psix_eiv(:,:,jk))/fse3u(:,:,jk) ! u_eiv = -dpsix/dz 212 END DO 213 zw3d(:,:,jpk) = 0._wp 214 CALL iom_put( "uoce_eiv", zw3d ) ! i-eiv current 215 216 DO jk=1,jpk-1 217 zw3d(:,:,jk) = (psiy_eiv(:,:,jk+1) - psiy_eiv(:,:,jk))/fse3v(:,:,jk) ! v_eiv = -dpsiy/dz 218 END DO 219 zw3d(:,:,jpk) = 0._wp 220 CALL iom_put( "voce_eiv", zw3d ) ! j-eiv current 221 222 DO jk=1,jpk-1 223 DO jj = 2, jpjm1 224 DO ji = fs_2, fs_jpim1 ! vector opt. 225 zw3d(ji,jj,jk) = (psiy_eiv(ji,jj,jk) - psiy_eiv(ji,jj-1,jk))/e2t(ji,jj) + & 226 & (psix_eiv(ji,jj,jk) - psix_eiv(ji-1,jj,jk))/e1t(ji,jj) ! w_eiv = dpsiy/dy + dpsiy/dx 227 END DO 228 END DO 229 END DO 230 zw3d(:,:,jpk) = 0._wp 231 CALL iom_put( "woce_eiv", zw3d ) ! vert. eiv current 232 CALL wrk_dealloc( jpi , jpj , jpk , zw3d ) 233 ENDIF 234 ! 235 235 ENDIF 236 #endif237 236 ! ! =========== 238 237 DO jn = 1, kjpt ! tracer loop … … 387 386 ! 388 387 ! ! "Poleward" diffusive heat or salt transports (T-S case only) 389 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 )) THEN390 IF( jn == jp_tem) htr_ldf(:) = ptr_ vj( zftv(:,:,:) ) ! 3.3 names391 IF( jn == jp_sal) str_ldf(:) = ptr_ vj( zftv(:,:,:) )388 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 389 IF( jn == jp_tem) htr_ldf(:) = ptr_sj( zftv(:,:,:) ) ! 3.3 names 390 IF( jn == jp_sal) str_ldf(:) = ptr_sj( zftv(:,:,:) ) 392 391 ENDIF 393 392 394 #if defined key_diaar5 395 IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN 396 z2d(:,:) = 0._wp 397 zztmp = rau0 * rcp 398 DO jk = 1, jpkm1 399 DO jj = 2, jpjm1 400 DO ji = fs_2, fs_jpim1 ! vector opt. 401 z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk) 402 END DO 403 END DO 404 END DO 405 z2d(:,:) = zztmp * z2d(:,:) 406 CALL lbc_lnk( z2d, 'U', -1. ) 407 CALL iom_put( "udiff_heattr", z2d ) ! heat transport in i-direction 408 z2d(:,:) = 0._wp 409 DO jk = 1, jpkm1 410 DO jj = 2, jpjm1 411 DO ji = fs_2, fs_jpim1 ! vector opt. 412 z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk) 413 END DO 414 END DO 415 END DO 416 z2d(:,:) = zztmp * z2d(:,:) 417 CALL lbc_lnk( z2d, 'V', -1. ) 418 CALL iom_put( "vdiff_heattr", z2d ) ! heat transport in j-direction 419 END IF 420 #endif 393 IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN 394 ! 395 IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN 396 z2d(:,:) = 0._wp 397 DO jk = 1, jpkm1 398 DO jj = 2, jpjm1 399 DO ji = fs_2, fs_jpim1 ! vector opt. 400 z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk) 401 END DO 402 END DO 403 END DO 404 z2d(:,:) = rau0_rcp * z2d(:,:) 405 CALL lbc_lnk( z2d, 'U', -1. ) 406 CALL iom_put( "udiff_heattr", z2d ) ! heat transport in i-direction 407 ! 408 z2d(:,:) = 0._wp 409 DO jk = 1, jpkm1 410 DO jj = 2, jpjm1 411 DO ji = fs_2, fs_jpim1 ! vector opt. 412 z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk) 413 END DO 414 END DO 415 END DO 416 z2d(:,:) = rau0_rcp * z2d(:,:) 417 CALL lbc_lnk( z2d, 'V', -1. ) 418 CALL iom_put( "vdiff_heattr", z2d ) ! heat transport in i-direction 419 END IF 420 ! 421 ENDIF 421 422 ! 422 423 END DO -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90
r5120 r5147 154 154 ! 155 155 ! "Poleward" diffusive heat or salt transports 156 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 )) THEN157 IF( jn == jp_tem) htr_ldf(:) = ptr_ vj( ztv(:,:,:) )158 IF( jn == jp_sal) str_ldf(:) = ptr_ vj( ztv(:,:,:) )156 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 157 IF( jn == jp_tem) htr_ldf(:) = ptr_sj( ztv(:,:,:) ) 158 IF( jn == jp_sal) str_ldf(:) = ptr_sj( ztv(:,:,:) ) 159 159 ENDIF 160 160 ! ! ================== -
trunk/NEMOGCM/NEMO/OPA_SRC/step.F90
r5120 r5147 216 216 ! diagnostics and outputs (ua, va, tsa used as workspace) 217 217 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 218 IF( lk_floats ) CALL flo_stp( kstp ) ! drifting Floats 219 IF( lk_diahth ) CALL dia_hth( kstp ) ! Thermocline depth (20 degres isotherm depth) 220 IF( .NOT. lk_cpl ) CALL dia_fwb( kstp ) ! Fresh water budget diagnostics 221 IF( ln_diaptr ) CALL dia_ptr( kstp ) ! Poleward TRansports diagnostics 222 IF( lk_diadct ) CALL dia_dct( kstp ) ! Transports 223 IF( lk_diaar5 ) CALL dia_ar5( kstp ) ! ar5 diag 224 IF( lk_diaharm ) CALL dia_harm( kstp ) ! Tidal harmonic analysis 225 CALL dia_wri( kstp ) ! ocean model: outputs 226 ! 227 IF( ln_crs ) CALL crs_fld( kstp ) ! ocean model: online field coarsening & output 228 218 IF( lk_floats ) CALL flo_stp( kstp ) ! drifting Floats 219 IF( lk_diahth ) CALL dia_hth( kstp ) ! Thermocline depth (20 degres isotherm depth) 220 IF( .NOT. lk_cpl ) CALL dia_fwb( kstp ) ! Fresh water budget diagnostics 221 IF( lk_diadct ) CALL dia_dct( kstp ) ! Transports 222 IF( lk_diaar5 ) CALL dia_ar5( kstp ) ! ar5 diag 223 IF( lk_diaharm ) CALL dia_harm( kstp ) ! Tidal harmonic analysis 224 CALL dia_wri( kstp ) ! ocean model: outputs 225 ! 226 IF( ln_crs ) CALL crs_fld( kstp ) ! ocean model: online field coarsening & output 229 227 230 228 #if defined key_top … … 252 250 IF( lk_zdfkpp ) CALL tra_kpp ( kstp ) ! KPP non-local tracer fluxes 253 251 CALL tra_ldf ( kstp ) ! lateral mixing 252 253 IF( ln_diaptr ) CALL dia_ptr ! Poleward adv/ldf TRansports diagnostics 254 254 255 #if defined key_agrif 255 256 IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_tra ! tracers sponge … … 338 339 CALL iom_close( numror ) ! close input ocean restart file 339 340 IF(lwm) CALL FLUSH ( numond ) ! flush output namelist oce 340 IF( lwm.AND.numoni /= -1 ) CALL FLUSH ( numoni ) ! flush output namelist ice 341 IF( lwm.AND.numoni /= -1 ) CALL FLUSH ( numoni ) ! flush output namelist ice 341 342 ENDIF 342 343 IF( lrst_oce ) CALL rst_write ( kstp ) ! write output ocean restart file
Note: See TracChangeset
for help on using the changeset viewer.
