- Timestamp:
- 2015-01-09T15:40:20+01:00 (9 years ago)
- Location:
- branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM
- Files:
-
- 33 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/CONFIG/AMM12/EXP00/namelist_cfg
r4839 r5023 391 391 / 392 392 !----------------------------------------------------------------------- 393 &namptr ! Poleward Transport Diagnostic394 !-----------------------------------------------------------------------395 ln_diaznl = .false. ! Add zonal means and meridional stream functions396 ln_subbas = .false. ! Atlantic/Pacific/Indian basins computation (T) or not397 ! (orca configuration only, need input basins mask file named "subbasins.nc"398 ln_ptrcomp = .false. ! Add decomposition : overturning399 /400 !-----------------------------------------------------------------------401 393 &namhsb ! Heat and salt budgets 402 394 !----------------------------------------------------------------------- -
branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/CONFIG/C1D_PAPA/EXP00/namelist_cfg
r4667 r5023 330 330 / 331 331 !----------------------------------------------------------------------- 332 &namptr ! Poleward Transport Diagnostic333 !-----------------------------------------------------------------------334 /335 !-----------------------------------------------------------------------336 332 &namhsb ! Heat and salt budgets 337 333 !----------------------------------------------------------------------- -
branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/CONFIG/GYRE/EXP00/namelist_cfg
r4990 r5023 350 350 / 351 351 !----------------------------------------------------------------------- 352 &namptr ! Poleward Transport Diagnostic353 !-----------------------------------------------------------------------354 /355 !-----------------------------------------------------------------------356 352 &namhsb ! Heat and salt budgets 357 353 !----------------------------------------------------------------------- -
branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist_cfg
r4990 r5023 332 332 / 333 333 !----------------------------------------------------------------------- 334 &namptr ! Poleward Transport Diagnostic335 !-----------------------------------------------------------------------336 /337 !-----------------------------------------------------------------------338 334 &namhsb ! Heat and salt budgets 339 335 !----------------------------------------------------------------------- -
branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/CONFIG/GYRE_PISCES/EXP00/namelist_cfg
r4990 r5023 206 206 / 207 207 !----------------------------------------------------------------------- 208 &namptr ! Poleward Transport Diagnostic209 !-----------------------------------------------------------------------210 /211 !-----------------------------------------------------------------------212 208 &namhsb ! Heat and salt budgets 213 209 !----------------------------------------------------------------------- -
branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/CONFIG/GYRE_XIOS/EXP00/namelist_cfg
r4373 r5023 304 304 / 305 305 !----------------------------------------------------------------------- 306 &namptr ! Poleward Transport Diagnostic307 !-----------------------------------------------------------------------308 /309 !-----------------------------------------------------------------------310 306 &namhsb ! Heat and salt budgets 311 307 !----------------------------------------------------------------------- -
branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/CONFIG/ISOMIP/EXP00/namelist_cfg
r4924 r5023 598 598 !! namtrd dynamics and/or tracer trends ("key_trddyn","key_trdtra","key_trdmld") 599 599 !! namflo float parameters ("key_float") 600 !! namptr Poleward Transport Diagnostics601 600 !! namhsb Heat and salt budgets 602 601 !!====================================================================== … … 623 622 / 624 623 !----------------------------------------------------------------------- 625 &namptr ! Poleward Transport Diagnostic626 !-----------------------------------------------------------------------627 /628 !-----------------------------------------------------------------------629 624 &namhsb ! Heat and salt budgets 630 625 !----------------------------------------------------------------------- -
branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist_cfg
r4990 r5023 177 177 / 178 178 !----------------------------------------------------------------------- 179 &namptr ! Poleward Transport Diagnostic180 !-----------------------------------------------------------------------181 /182 !-----------------------------------------------------------------------183 179 &namhsb ! Heat and salt budgets 184 180 !----------------------------------------------------------------------- -
branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/CONFIG/ORCA2_LIM3/EXP00/namelist_cfg
r4995 r5023 180 180 / 181 181 !----------------------------------------------------------------------- 182 &namptr ! Poleward Transport Diagnostic183 !-----------------------------------------------------------------------184 /185 !-----------------------------------------------------------------------186 182 &namhsb ! Heat and salt budgets 187 183 !----------------------------------------------------------------------- -
branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/namelist_cfg
r4370 r5023 264 264 / 265 265 !----------------------------------------------------------------------- 266 &namptr ! Poleward Transport Diagnostic267 !-----------------------------------------------------------------------268 /269 !-----------------------------------------------------------------------270 266 &namhsb ! Heat and salt budgets 271 267 !----------------------------------------------------------------------- -
branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist_cfg
r4370 r5023 177 177 / 178 178 !----------------------------------------------------------------------- 179 &namptr ! Poleward Transport Diagnostic180 !-----------------------------------------------------------------------181 /182 !-----------------------------------------------------------------------183 179 &namhsb ! Heat and salt budgets 184 180 !----------------------------------------------------------------------- -
branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/CONFIG/SHARED/domain_def.xml
r4690 r5023 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" /> -
branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/CONFIG/SHARED/field_def.xml
r4996 r5023 511 511 </field_group> 512 512 513 <!-- Poleward transport : ptr --> 514 <field_group id="diaptr" domain_ref="ptr" > 515 <field id="zomsfglo" long_name="Meridional Stream-Function: Global" unit="Sv" grid_ref="grid_W_3D" /> 516 <field id="zomsfatl" long_name="Meridional Stream-Function: Atlantic" unit="Sv" grid_ref="grid_W_3D" /> 517 <field id="zomsfpac" long_name="Meridional Stream-Function: Pacific" unit="Sv" grid_ref="grid_W_3D" /> 518 <field id="zomsfind" long_name="Meridional Stream-Function: Indian" unit="Sv" grid_ref="grid_W_3D" /> 519 <field id="zomsfipc" long_name="Meridional Stream-Function: Pacific+Indian" unit="Sv" grid_ref="grid_W_3D" /> 520 <field id="zotemglo" long_name="Zonal Mean Temperature : Global" unit="C" grid_ref="grid_T_3D" /> 521 <field id="zotematl" long_name="Zonal Mean Temperature : Atlantic" unit="C" grid_ref="grid_T_3D" /> 522 <field id="zotempac" long_name="Zonal Mean Temperature : Pacific" unit="C" grid_ref="grid_T_3D" /> 523 <field id="zotemind" long_name="Zonal Mean Temperature : Indian" unit="C" grid_ref="grid_T_3D" /> 524 <field id="zotemipc" long_name="Zonal Mean Temperature : Pacific+Indian" unit="C" grid_ref="grid_T_3D" /> 525 <field id="zosalglo" long_name="Zonal Mean Salinity : Global" unit="PSU" grid_ref="grid_T_3D" /> 526 <field id="zosalatl" long_name="Zonal Mean Salinity : Atlantic" unit="PSU" grid_ref="grid_T_3D" /> 527 <field id="zosalpac" long_name="Zonal Mean Salinity : Pacific" unit="PSU" grid_ref="grid_T_3D" /> 528 <field id="zosalind" long_name="Zonal Mean Salinity : Indian" unit="PSU" grid_ref="grid_T_3D" /> 529 <field id="zosalipc" long_name="Zonal Mean Salinity : Pacific+Indian" unit="PSU" grid_ref="grid_T_3D" /> 530 <field id="zosrfglo" long_name="Zonal Mean Surface" unit="m2" grid_ref="grid_T_3D" /> 531 <field id="zosrfatl" long_name="Zonal Mean Surface : Atlantic" unit="m2" grid_ref="grid_T_3D" /> 532 <field id="zosrfpac" long_name="Zonal Mean Surface : Pacific" unit="m2" grid_ref="grid_T_3D" /> 533 <field id="zosrfind" long_name="Zonal Mean Surface : Indian" unit="m2" grid_ref="grid_T_3D" /> 534 <field id="zosrfipc" long_name="Zonal Mean Surface : Pacific+Indian" unit="m2" grid_ref="grid_T_3D" /> 535 <field id="sophtadv" long_name="Advective Heat Transport" unit="PW" grid_ref="grid_T_2D" /> 536 <field id="sophtldf" long_name="Diffusive Heat Transport" unit="PW" grid_ref="grid_T_2D" /> 537 <field id="sopstadv" long_name="Advective Salt Transport" unit="Giga g/s" grid_ref="grid_T_2D" /> 538 <field id="sopstldf" long_name="Diffusive Salt Transport" unit="Giga g/s" grid_ref="grid_T_2D" /> 539 </field_group> 540 541 513 542 <!-- ptrc on T grid --> 514 543 -
branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/CONFIG/SHARED/namelist_ref
r4990 r5023 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) … … 1072 1072 !! namtrd dynamics and/or tracer trends 1073 1073 !! namflo float parameters ("key_float") 1074 !! namptr Poleward Transport Diagnostics1075 1074 !! namhsb Heat and salt budgets 1076 1075 !!====================================================================== … … 1121 1120 ln_ariane = .true. ! Input with Ariane tool convention(T) 1122 1121 ln_flo_ascii = .true. ! Output with Ariane tool netcdf convention(F) or ascii file (T) 1123 /1124 !-----------------------------------------------------------------------1125 &namptr ! Poleward Transport Diagnostic1126 !-----------------------------------------------------------------------1127 ln_diaptr = .false. ! Poleward heat and salt transport (T) or not (F)1128 ln_diaznl = .true. ! Add zonal means and meridional stream functions1129 ln_subbas = .true. ! Atlantic/Pacific/Indian basins computation (T) or not1130 ! (orca configuration only, need input basins mask file named "subbasins.nc"1131 ln_ptrcomp = .true. ! Add decomposition : overturning1132 nn_fptr = 1 ! Frequency of ptr computation [time step]1133 nn_fwri = 15 ! Frequency of ptr outputs [time step]1134 1122 / 1135 1123 !----------------------------------------------------------------------- -
branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/CONFIG/cfg.txt
r4990 r5023 12 12 ORCA2_LIM3 OPA_SRC LIM_SRC_3 NST_SRC 13 13 ORCA2_LIM OPA_SRC LIM_SRC_2 NST_SRC 14 ORCA2_LIM_PTR OPA_SRC LIM_SRC_2 NST_SRC -
branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90
r4990 r5023 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 22 USE domngb 23 23 USE phycst ! physical constants 24 USE ldftra_oce ! ocean active tracers: lateral physics 25 USE dianam ! 24 ! 26 25 USE iom ! IOM library 27 USE ioipsl ! IO-IPSL library28 26 USE in_out_manager ! I/O manager 29 27 USE lib_mpp ! MPP library 30 USE lbclnk ! lateral boundary condition - processor exchanges31 28 USE timing ! preformance summary 32 USE wrk_nemo ! working arrays33 29 34 30 IMPLICIT NONE 35 31 PRIVATE 36 32 37 INTERFACE ptr_ vj38 MODULE PROCEDURE ptr_ vj_3d, ptr_vj_2d33 INTERFACE ptr_sj 34 MODULE PROCEDURE ptr_sj_3d, ptr_sj_2d 39 35 END INTERFACE 40 36 41 PUBLIC dia_ptr_init ! call in opa module 37 PUBLIC ptr_sj ! call by tra_ldf & tra_adv routines 38 PUBLIC ptr_sjk ! 39 PUBLIC dia_ptr_alloc ! call in opa module 42 40 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 41 46 42 ! !!** 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.) 43 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:) :: htr_adv, htr_ldf !: Heat TRansports (adv, diff, overturn.) 44 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:) :: str_adv, str_ldf !: Salt TRansports (adv, diff, overturn.) 56 45 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) 46 47 LOGICAL, PUBLIC :: l_diaptr = .TRUE. ! Poleward transport flag (T) or not (F) 48 LOGICAL :: l_subbas = .FALSE. ! Atlantic/Pacific/Indian basins calculation 49 LOGICAL :: linit = .TRUE. ! initialization flag (set to false after the 1st call) 50 INTEGER :: nptr ! = 1 (l_subbas=F) or = 5 (glo, atl, pac, ind, ipc) (l_subbas=T) 51 INTEGER :: nx, ny 70 52 71 53 REAL(wp) :: rc_sv = 1.e-6_wp ! conversion from m3/s to Sverdrup … … 73 55 REAL(wp) :: rc_ggram = 1.e-6_wp ! conversion from g to Pg 74 56 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 57 CHARACTER(len=3), ALLOCATABLE, SAVE, DIMENSION(:) :: clsubb 58 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: btmsk ! T-point basin interior masks 59 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: btm30 ! mask out Southern Ocean (=0 south of 30°S) 60 61 REAL(wp), TARGET, ALLOCATABLE, SAVE, DIMENSION(:) :: p_fval1d 62 REAL(wp), TARGET, ALLOCATABLE, SAVE, DIMENSION(:,:) :: p_fval2d 63 83 64 84 65 !! * Substitutions … … 92 73 CONTAINS 93 74 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) 75 SUBROUTINE dia_ptr( pvtr ) 76 !!---------------------------------------------------------------------- 77 !! *** ROUTINE dia_ptr *** 78 !!---------------------------------------------------------------------- 79 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: pvtr ! j-effective transport 80 ! 81 INTEGER :: ji, jj, jk, jn ! dummy loop indices 82 REAL(wp) :: zv, zsfc ! local scalar 83 REAL(wp), DIMENSION(jpi,jpj) :: z2d ! 2D workspace 84 REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3d ! 3D workspace 85 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask ! 3D workspace 86 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: zts ! 3D workspace 87 CHARACTER( len = 10 ) :: cl1 88 !!---------------------------------------------------------------------- 89 ! 90 IF( nn_timing == 1 ) CALL timing_start('dia_ptr') 91 92 IF( linit ) THEN 93 CALL dia_ptr_init 94 linit = .FALSE. 95 ENDIF 96 ! 97 IF( PRESENT( pvtr ) ) THEN 98 IF( iom_use("zomsfglo") ) THEN ! effective MSF 99 z3d(nx,:,:) = ptr_sjk( pvtr(:,:,:) ) ! zonal cumulative effective transport 100 DO jk = 2, jpkm1 101 z3d(nx,:,jk) = z3d(nx,:,jk-1) + z3d(nx,:,jk) ! effective j-Stream-Function (MSF) 102 END DO 103 cl1 = TRIM('zomsf'//clsubb(1) ) 104 CALL iom_put( cl1, z3d * rc_sv ) 105 DO jn = 2, nptr ! by sub-basins 106 z3d(nx,:,:) = ptr_sjk( pvtr(:,:,:), btmsk(:,:,jn)*btm30(:,:) ) 107 DO jk = 2, jpkm1 108 z3d(nx,:,jk) = z3d(nx,:,jk-1) + z3d(nx,:,jk) ! effective j-Stream-Function (MSF) 247 109 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 110 cl1 = TRIM('zomsf'//clsubb(jn) ) 111 CALL iom_put( cl1, z3d * rc_sv ) 112 END DO 113 ENDIF 114 ! 115 ELSE 116 ! 117 IF( iom_use("zotemglo") ) THEN ! i-mean i-k-surface 118 DO jk = 1, jpkm1 119 DO jj = 1, jpj 377 120 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 121 zsfc = e1t(ji,jj) * fse3t(ji,jj,jk) 122 zmask(ji,jj,jk) = tmask(ji,jj,jk) * zsfc 123 zts(ji,jj,jk,jp_tem) = tsn(ji,jj,jk,jp_tem) * zsfc 124 zts(ji,jj,jk,jp_sal) = tsn(ji,jj,jk,jp_sal) * zsfc 125 ENDDO 126 ENDDO 127 ENDDO 416 128 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 129 zmask(1,:,:) = ptr_sjk( zmask(:,:,:), btmsk(:,:,jn) ) 130 cl1 = TRIM('zosrf'//clsubb(jn) ) 131 CALL iom_put( cl1, zmask ) 132 ! 133 z3d(nx,:,:) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) & 134 & / MAX( zmask(1,:,:), 10.e-15 ) 135 cl1 = TRIM('zotem'//clsubb(jn) ) 136 CALL iom_put( cl1, z3d ) 137 ! 138 z3d(nx,:,:) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) & 139 & / MAX( zmask(1,:,:), 10.e-15 ) 140 cl1 = TRIM('zosal'//clsubb(jn) ) 141 CALL iom_put( cl1, z3d ) 142 END DO 143 ENDIF 144 ! 145 ! ! Advective and diffusive heat and salt transport 146 IF( iom_use("sophtadv") .OR. iom_use("sopstadv") ) THEN 147 z2d(nx,:) = htr_adv(:) * rc_pwatt ! (conversion in PW) 148 cl1 = 'sophtadv' 149 CALL iom_put( TRIM(cl1), z2d ) 150 z2d(nx,:) = str_adv(:) * rc_ggram ! (conversion in Gg) 151 cl1 = 'sopstadv' 152 CALL iom_put( TRIM(cl1), z2d ) 153 ENDIF 154 ! 155 IF( iom_use("sophtldf") .OR. iom_use("sopstldf") ) THEN 156 z2d(nx,:) = htr_ldf(:) * rc_pwatt ! (conversion in PW) 157 cl1 = 'sophtldf' 158 CALL iom_put( TRIM(cl1), z2d ) 159 z2d(nx,:) = str_ldf(:) * rc_ggram ! (conversion in Gg) 160 cl1 = 'sopstldf' 161 CALL iom_put( TRIM(cl1), z2d ) 162 ENDIF 432 163 ! 433 164 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 165 ! 441 166 IF( nn_timing == 1 ) CALL timing_stop('dia_ptr') … … 450 175 !! ** Purpose : Initialization, namelist read 451 176 !!---------------------------------------------------------------------- 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 460 !!---------------------------------------------------------------------- 461 462 REWIND( numnam_ref ) ! Namelist namptr in reference namelist : Poleward transport 463 READ ( numnam_ref, namptr, IOSTAT = ios, ERR = 901) 464 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namptr in reference namelist', lwp ) 465 466 REWIND( numnam_cfg ) ! Namelist namptr in configuration namelist : Poleward transport 467 READ ( numnam_cfg, namptr, IOSTAT = ios, ERR = 902 ) 468 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namptr in configuration namelist', lwp ) 469 IF(lwm) WRITE ( numond, namptr ) 470 177 INTEGER :: jn, inum ! local integers 178 !!---------------------------------------------------------------------- 179 180 l_diaptr = iom_use("zomsfglo") .OR. iom_use("zotemglo") .OR. iom_use("sophtadv") .OR. iom_use("sophtldf") 181 CALL iom_open( 'subbasins', inum, ldstop = .FALSE. ) 182 IF( inum > 0 ) l_subbas = .TRUE. 183 471 184 IF(lwp) THEN ! Control print 472 185 WRITE(numout,*) … … 474 187 WRITE(numout,*) '~~~~~~~~~~~~' 475 188 WRITE(numout,*) ' Namelist namptr : set ptr parameters' 476 WRITE(numout,*) ' Poleward heat & salt transport (T) or not (F) ln_diaptr = ', ln_diaptr 477 WRITE(numout,*) ' Overturning heat & salt transport ln_ptrcomp = ', ln_ptrcomp 478 WRITE(numout,*) ' T & S zonal mean and meridional stream function ln_diaznl = ', ln_diaznl 479 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_fptr 481 WRITE(numout,*) ' Frequency of outputs nn_fwri = ', nn_fwri 189 WRITE(numout,*) ' Poleward heat & salt transport (T) or not (F) l_diaptr = ', l_diaptr 190 WRITE(numout,*) ' Global (F) or glo/Atl/Pac/Ind/Indo-Pac basins l_subbas = ', l_subbas 482 191 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 192 193 IF( l_diaptr ) THEN 194 ! 195 CALL dom_ngb( 180., 90., nx, ny, 'T' ) ! i-line that passes near the North Pole : Reference latitude (used in plots) 196 ! 197 IF( l_subbas ) THEN 198 nptr = 5 ! Global, Atlantic, Pacific, Indian, Indo-Pacific 199 ALLOCATE( clsubb(nptr) ) 200 clsubb(1) = 'glo' ; clsubb(2) = 'atl' ; clsubb(3) = 'pac' ; clsubb(4) = 'ind' ; clsubb(5) = 'ipc' 201 ELSE 202 nptr = 1 ! Global only 203 ALLOCATE( clsubb(nptr) ) 204 clsubb(1) = 'glo' 490 205 ENDIF 491 206 … … 493 208 IF( dia_ptr_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_ptr_init : unable to allocate arrays' ) 494 209 495 rc_pwatt = rc_pwatt * rau0 *rcp ! conversion from K.s-1 to PetaWatt210 rc_pwatt = rc_pwatt * rau0_rcp ! conversion from K.s-1 to PetaWatt 496 211 497 212 IF( lk_mpp ) CALL mpp_ini_znl( numout ) ! Define MPI communicator for zonal sum 498 213 499 IF( ln_subbas ) THEN ! load sub-basin mask 500 CALL iom_open( 'subbasins', inum ) 214 IF( l_subbas ) THEN ! load sub-basin mask 501 215 CALL iom_get( inum, jpdom_data, 'atlmsk', btmsk(:,:,2) ) ! Atlantic basin 502 216 CALL iom_get( inum, jpdom_data, 'pacmsk', btmsk(:,:,3) ) ! Pacific basin … … 508 222 END WHERE 509 223 ENDIF 224 510 225 btmsk(:,:,1) = tmask_i(:,:) ! global ocean 511 226 … … 513 228 btmsk(:,:,jn) = btmsk(:,:,jn) * tmask_i(:,:) ! interior domain only 514 229 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 ! 230 231 ! Initialise arrays to zero because diatpr is called before they are first calculated 232 ! Note that this means diagnostics will not be exactly correct when model run is restarted. 233 htr_adv(:) = 0._wp ; str_adv(:) = 0._wp 234 htr_ldf(:) = 0._wp ; str_ldf(:) = 0._wp 235 ! 543 236 ENDIF 544 237 ! … … 546 239 547 240 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 241 FUNCTION dia_ptr_alloc() 242 !!---------------------------------------------------------------------- 243 !! *** ROUTINE dia_ptr_alloc *** 244 !!---------------------------------------------------------------------- 245 INTEGER :: dia_ptr_alloc ! return value 246 INTEGER, DIMENSION(3) :: ierr 247 !!---------------------------------------------------------------------- 248 ierr(:) = 0 249 ! 250 ALLOCATE( btmsk(jpi,jpj,nptr) , & 251 & htr_adv(jpj) , str_adv(jpj) , & 252 & htr_ldf(jpj) , str_ldf(jpj) , STAT=ierr(1) ) 253 ! 254 ALLOCATE( p_fval1d(jpj), p_fval2d(jpj,jpk), Stat=ierr(2)) 255 ! 256 ALLOCATE( btm30(jpi,jpj), STAT=ierr(3) ) 257 258 ! 259 dia_ptr_alloc = MAXVAL( ierr ) 260 IF(lk_mpp) CALL mpp_sum( dia_ptr_alloc ) 261 ! 262 END FUNCTION dia_ptr_alloc 263 264 265 FUNCTION ptr_sj_3d( pva, pmsk ) RESULT ( p_fval ) 266 !!---------------------------------------------------------------------- 267 !! *** ROUTINE ptr_sj_3d *** 268 !! 269 !! ** Purpose : i-k sum computation of a j-flux array 270 !! 271 !! ** Method : - i-k sum of pva using the interior 2D vmask (vmask_i). 272 !! pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v) 273 !! 274 !! ** Action : - p_fval: i-k-mean poleward flux of pva 275 !!---------------------------------------------------------------------- 276 REAL(wp), INTENT(in), DIMENSION(jpi,jpj,jpk) :: pva ! mask flux array at V-point 277 REAL(wp), INTENT(in), DIMENSION(jpi,jpj), OPTIONAL :: pmsk ! Optional 2D basin mask 278 ! 279 INTEGER :: ji, jj, jk ! dummy loop arguments 280 INTEGER :: ijpj ! ??? 281 REAL(wp), POINTER, DIMENSION(:) :: p_fval ! function value 282 !!-------------------------------------------------------------------- 283 ! 284 p_fval => p_fval1d 285 286 ijpj = jpj 287 p_fval(:) = 0._wp 288 IF( PRESENT( pmsk ) ) THEN 289 DO jk = 1, jpkm1 290 DO jj = 2, jpjm1 291 DO ji = fs_2, fs_jpim1 ! Vector opt. 292 p_fval(jj) = p_fval(jj) + pva(ji,jj,jk) * tmask_i(ji,jj) * pmsk(ji,jj) 293 END DO 294 END DO 295 END DO 296 ELSE 297 DO jk = 1, jpkm1 298 DO jj = 2, jpjm1 299 DO ji = fs_2, fs_jpim1 ! Vector opt. 300 p_fval(jj) = p_fval(jj) + pva(ji,jj,jk) * tmask_i(ji,jj) 301 END DO 302 END DO 303 END DO 304 ENDIF 305 #if defined key_mpp_mpi 306 IF(lk_mpp) CALL mpp_sum( p_fval, ijpj, ncomm_znl) 568 307 #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 308 ! 309 END FUNCTION ptr_sj_3d 310 311 312 FUNCTION ptr_sj_2d( pva, pmsk ) RESULT ( p_fval ) 313 !!---------------------------------------------------------------------- 314 !! *** ROUTINE ptr_sj_2d *** 315 !! 316 !! ** Purpose : "zonal" and vertical sum computation of a i-flux array 317 !! 318 !! ** Method : - i-k sum of pva using the interior 2D vmask (vmask_i). 319 !! pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v) 320 !! 321 !! ** Action : - p_fval: i-k-mean poleward flux of pva 322 !!---------------------------------------------------------------------- 323 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) :: pva ! mask flux array at V-point 324 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj), OPTIONAL :: pmsk ! Optional 2D basin mask 325 ! 326 INTEGER :: ji,jj ! dummy loop arguments 327 INTEGER :: ijpj ! ??? 328 REAL(wp), POINTER, DIMENSION(:) :: p_fval ! function value 329 !!-------------------------------------------------------------------- 330 ! 331 p_fval => p_fval1d 332 333 ijpj = jpj 334 p_fval(:) = 0._wp 335 IF( PRESENT( pmsk ) ) THEN 336 DO jj = 2, jpjm1 337 DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ? 338 p_fval(jj) = p_fval(jj) + pva(ji,jj) * tmask_i(ji,jj) * pmsk(ji,jj) 339 END DO 340 END DO 341 ELSE 342 DO jj = 2, jpjm1 343 DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ? 344 p_fval(jj) = p_fval(jj) + pva(ji,jj) * tmask_i(ji,jj) 345 END DO 346 END DO 347 ENDIF 625 348 #if defined key_mpp_mpi 626 CALL mpp_sum( zphi, jpj, ncomm_znl )349 CALL mpp_sum( p_fval, ijpj, ncomm_znl ) 627 350 #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) 351 ! 352 END FUNCTION ptr_sj_2d 353 354 355 FUNCTION ptr_sjk( pta, pmsk ) RESULT ( p_fval ) 356 !!---------------------------------------------------------------------- 357 !! *** ROUTINE ptr_sjk *** 358 !! 359 !! ** Purpose : i-sum computation of an array 360 !! 361 !! ** Method : - i-sum of pva using the interior 2D vmask (vmask_i). 362 !! 363 !! ** Action : - p_fval: i-mean poleward flux of pva 364 !!---------------------------------------------------------------------- 365 !! 366 IMPLICIT none 367 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) :: pta ! mask flux array at V-point 368 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) , OPTIONAL :: pmsk ! Optional 2D basin mask 369 !! 370 INTEGER :: ji, jj, jk ! dummy loop arguments 371 REAL(wp), POINTER, DIMENSION(:,:) :: p_fval ! return function value 636 372 #if defined key_mpp_mpi 637 IF( l_znl_root ) THEN 373 INTEGER, DIMENSION(1) :: ish 374 INTEGER, DIMENSION(2) :: ish2 375 INTEGER :: ijpjjpk 376 REAL(wp), DIMENSION(jpj*jpk) :: zwork ! mask flux array at V-point 638 377 #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 378 !!-------------------------------------------------------------------- 379 ! 380 p_fval => p_fval2d 381 382 p_fval(:,:) = 0._wp 383 ! 384 IF( PRESENT( pmsk ) ) THEN 385 DO jk = 1, jpkm1 386 DO jj = 2, jpjm1 387 !!gm here, use of tmask_i ==> no need of loop over nldi, nlei.... 388 DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ? 389 p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * pmsk(ji,jj) 390 END DO 391 END DO 392 END DO 393 ELSE 394 DO jk = 1, jpkm1 395 DO jj = 2, jpjm1 396 DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ? 397 p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * tmask_i(ji,jj) 398 END DO 399 END DO 400 END DO 401 END IF 402 ! 403 #if defined key_mpp_mpi 404 ijpjjpk = jpj*jpk 405 ish(1) = ijpjjpk ; ish2(1) = jpj ; ish2(2) = jpk 406 zwork(1:ijpjjpk) = RESHAPE( p_fval, ish ) 407 CALL mpp_sum( zwork, ijpjjpk, ncomm_znl ) 408 p_fval(:,:) = RESHAPE( zwork, ish2 ) 666 409 #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 410 ! 411 END FUNCTION ptr_sjk 412 894 413 895 414 !!====================================================================== -
branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90
r4990 r5023 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 -
branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r5003 r5023 1240 1240 CHARACTER(len=256) :: clsuff ! suffix name 1241 1241 CHARACTER(len=1) :: cl1 ! 1 character 1242 CHARACTER(len=2) :: cl2 ! 2 characters1242 CHARACTER(len=2) :: cl2 ! 1 character 1243 1243 CHARACTER(len=3) :: cl3 ! 3 characters 1244 1244 INTEGER :: ji, jg ! loop counters … … 1296 1296 zlatpira = (/ -19.0, -14.0, -8.0, 0.0, 4.0, 8.0, 12.0, 15.0, 20.0 /) 1297 1297 CALL set_mooring( zlonpira, zlatpira ) 1298 1299 ! diaptr : zonal mean 1300 CALL dom_ngb( 180., 90., ix, iy, 'T' ) ! i-line that passes near the North Pole : Reference latitude (used in plots) 1301 CALL iom_set_domain_attr ('ptr', zoom_ibegin=ix, zoom_nj=jpjglo) 1302 CALL iom_update_file_name('ptr') 1303 ! 1298 1304 1299 1305 END SUBROUTINE set_xmlatt -
branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90
r4990 r5023 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 ! -
branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90
r4990 r5023 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( l_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 ==! -
branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90
r4990 r5023 279 279 END IF 280 280 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 281 IF( cdtype == 'TRA' .AND. l n_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. l_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 ! -
branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90
r4990 r5023 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. l n_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. l_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 -
branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90
r4990 r5023 200 200 201 201 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 202 IF( cdtype == 'TRA' .AND. l n_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. l_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 -
branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90
r4990 r5023 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. l n_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. l_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 ! -
branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90
r4990 r5023 184 184 END IF 185 185 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 186 IF( cdtype == 'TRA' .AND. l n_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 )) THEN187 IF( jn == jp_tem ) htr_adv(:) = ptr_ vj( zwy(:,:,:) )188 IF( jn == jp_sal ) str_adv(:) = ptr_ vj( zwy(:,:,:) )186 IF( cdtype == 'TRA' .AND. l_diaptr ) THEN 187 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 188 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 189 189 ENDIF 190 190 … … 250 250 END IF 251 251 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 252 IF( cdtype == 'TRA' .AND. l n_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 )) THEN253 IF( jn == jp_tem ) htr_adv(:) = ptr_ vj( zwy(:,:,:) ) + htr_adv(:)254 IF( jn == jp_sal ) str_adv(:) = ptr_ vj( zwy(:,:,:) ) + str_adv(:)252 IF( cdtype == 'TRA' .AND. l_diaptr ) THEN 253 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) + htr_adv(:) 254 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) + str_adv(:) 255 255 ENDIF 256 256 ! … … 398 398 END IF 399 399 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 400 IF( cdtype == 'TRA' .AND. l n_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 )) THEN401 IF( jn == jp_tem ) htr_adv(:) = ptr_ vj( zwy(:,:,:) )402 IF( jn == jp_sal ) str_adv(:) = ptr_ vj( zwy(:,:,:) )400 IF( cdtype == 'TRA' .AND. l_diaptr ) THEN 401 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 402 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 403 403 ENDIF 404 404 … … 524 524 END IF 525 525 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 526 IF( cdtype == 'TRA' .AND. l n_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 )) THEN527 IF( jn == jp_tem ) htr_adv(:) = ptr_ vj( zwy(:,:,:) ) + htr_adv(:)528 IF( jn == jp_sal ) str_adv(:) = ptr_ vj( zwy(:,:,:) ) + str_adv(:)526 IF( cdtype == 'TRA' .AND. l_diaptr ) THEN 527 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) + htr_adv(:) 528 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) + str_adv(:) 529 529 ENDIF 530 530 ! -
branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90
r4990 r5023 177 177 END IF 178 178 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 179 IF( cdtype == 'TRA' .AND. l n_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. l_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 -
branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90
r4990 r5023 166 166 ! 167 167 ! "zonal" mean lateral diffusive heat and salt transport 168 IF( cdtype == 'TRA' .AND. l n_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 )) THEN169 IF( jn == jp_tem ) htr_ldf(:) = ptr_ vj( ztv(:,:,:) )170 IF( jn == jp_sal ) str_ldf(:) = ptr_ vj( ztv(:,:,:) )168 IF( cdtype == 'TRA' .AND. l_diaptr ) THEN 169 IF( jn == jp_tem ) htr_ldf(:) = ptr_sj( ztv(:,:,:) ) 170 IF( jn == jp_sal ) str_ldf(:) = ptr_sj( ztv(:,:,:) ) 171 171 ENDIF 172 172 ! ! =========== -
branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90
r4292 r5023 247 247 ! ! =============== 248 248 ! "Poleward" diffusive heat or salt transport 249 IF( cdtype == 'TRA' .AND. l n_diaptr .AND. ( kaht == 2 ) .AND. ( MOD( kt, nn_fptr ) == 0) ) THEN249 IF( cdtype == 'TRA' .AND. l_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 -
branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
r4990 r5023 109 109 REAL(wp) :: zmskv, zabe2, zcof2, zcoef4 ! - - 110 110 REAL(wp) :: zcoef0, zbtr, ztra ! - - 111 #if defined key_diaar5112 REAL(wp) :: zztmp ! local scalar113 #endif114 111 REAL(wp), POINTER, DIMENSION(:,: ) :: z2d 115 112 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdkt, zdk1t, zdit, zdjt, ztfw … … 225 222 ! 226 223 ! "Poleward" diffusive heat or salt transports (T-S case only) 227 IF( cdtype == 'TRA' .AND. l n_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 )) THEN224 IF( cdtype == 'TRA' .AND. l_diaptr ) THEN 228 225 ! note sign is reversed to give down-gradient diffusive transports (#1043) 229 IF( jn == jp_tem) htr_ldf(:) = ptr_ vj( -zftv(:,:,:) )230 IF( jn == jp_sal) str_ldf(:) = ptr_ vj( -zftv(:,:,:) )226 IF( jn == jp_tem) htr_ldf(:) = ptr_sj( -zftv(:,:,:) ) 227 IF( jn == jp_sal) str_ldf(:) = ptr_sj( -zftv(:,:,:) ) 231 228 ENDIF 232 229 233 #if defined key_diaar5 234 IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN235 z2d(:,:) = 0._wp236 ! note sign is reversed to give down-gradient diffusive transports (#1043)237 zztmp = -1.0_wp * rau0 * rcp238 DO jk = 1, jpkm1239 DO jj = 2, jpjm1240 DO ji = fs_2, fs_jpim1 ! vector opt.241 z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk)230 IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN 231 ! 232 IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN 233 z2d(:,:) = 0._wp 234 DO jk = 1, jpkm1 235 DO jj = 2, jpjm1 236 DO ji = fs_2, fs_jpim1 ! vector opt. 237 z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk) 238 END DO 242 239 END DO 243 240 END DO 244 END DO 245 z2d(:,:) = zztmp * z2d(:,:) 246 CALL lbc_lnk( z2d, 'U', -1. ) 247 CALL iom_put( "udiff_heattr", z2d ) ! heat transport in i-direction 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) + zftv(ji,jj,jk) 241 z2d(:,:) = - rau0_rcp * z2d(:,:) ! note sign is reversed to give down-gradient diffusive transports (#1043) 242 CALL lbc_lnk( z2d, 'U', -1. ) 243 CALL iom_put( "udiff_heattr", z2d ) ! heat transport in i-direction 244 ! 245 z2d(:,:) = 0._wp 246 DO jk = 1, jpkm1 247 DO jj = 2, jpjm1 248 DO ji = fs_2, fs_jpim1 ! vector opt. 249 z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk) 250 END DO 253 251 END DO 254 252 END DO 255 END DO256 z2d(:,:) = zztmp * z2d(:,:)257 CALL lbc_lnk( z2d, 'V', -1. )258 CALL iom_put( "vdiff_heattr", z2d ) ! heat transport in i-direction259 END IF260 #endif 253 z2d(:,:) = - rau0_rcp * z2d(:,:) ! note sign is reversed to give down-gradient diffusive transports (#1043) 254 CALL lbc_lnk( z2d, 'V', -1. ) 255 CALL iom_put( "vdiff_heattr", z2d ) ! heat transport in i-direction 256 END IF 257 ! 258 ENDIF 261 259 262 260 !!---------------------------------------------------------------------- -
branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90
r4990 r5023 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. l n_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. l_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 -
branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90
r4990 r5023 148 148 ! 149 149 ! "Poleward" diffusive heat or salt transports 150 IF( cdtype == 'TRA' .AND. l n_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 )) THEN151 IF( jn == jp_tem) htr_ldf(:) = ptr_ vj( ztv(:,:,:) )152 IF( jn == jp_sal) str_ldf(:) = ptr_ vj( ztv(:,:,:) )150 IF( cdtype == 'TRA' .AND. l_diaptr ) THEN 151 IF( jn == jp_tem) htr_ldf(:) = ptr_sj( ztv(:,:,:) ) 152 IF( jn == jp_sal) str_ldf(:) = ptr_sj( ztv(:,:,:) ) 153 153 ENDIF 154 154 ! ! ================== -
branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r4990 r5023 61 61 USE asminc ! assimilation increments 62 62 USE asmbkg ! writing out state trajectory 63 USE diaptr ! poleward transports (dia_ptr_init routine)64 63 USE diadct ! sections transports (dia_dct_init routine) 65 64 USE diaobs ! Observation diagnostics (dia_obs_init routine) … … 439 438 IF( lk_floats ) CALL flo_init ! drifting Floats 440 439 IF( lk_diaar5 ) CALL dia_ar5_init ! ar5 diag 441 CALL dia_ptr_init ! Poleward TRansports initialization442 440 IF( lk_diadct ) CALL dia_dct_init ! Sections tranports 443 441 CALL dia_hsb_init ! heat content, salt content and volume budgets -
branches/2015/dev_r5020_CNRS_DIAPTR/NEMOGCM/NEMO/OPA_SRC/step.F90
r5012 r5023 211 211 IF( lk_diahth ) CALL dia_hth( kstp ) ! Thermocline depth (20 degres isotherm depth) 212 212 IF( .NOT. lk_cpl ) CALL dia_fwb( kstp ) ! Fresh water budget diagnostics 213 IF( ln_diaptr ) CALL dia_ptr( kstp ) ! Poleward TRansports diagnostics214 213 IF( lk_diadct ) CALL dia_dct( kstp ) ! Transports 215 214 IF( lk_diaar5 ) CALL dia_ar5( kstp ) ! ar5 diag … … 244 243 IF( lk_zdfkpp ) CALL tra_kpp ( kstp ) ! KPP non-local tracer fluxes 245 244 CALL tra_ldf ( kstp ) ! lateral mixing 245 246 IF( l_diaptr ) CALL dia_ptr ! Poleward adv/ldf TRansports diagnostics 247 246 248 #if defined key_agrif 247 249 IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_tra ! tracers sponge … … 320 322 ENDIF 321 323 IF( kstp == nit000 ) THEN 322 CALL iom_close( numror ) ! close input ocean restart file323 IF( lwm)CALL FLUSH ( numond ) ! flush output namelist oce324 IF( lwm .AND.numoni /= -1 ) CALL FLUSH ( numoni ) ! flush output namelist ice324 CALL iom_close( numror ) ! close input ocean restart file 325 IF( lwm ) CALL FLUSH ( numond ) ! flush output namelist oce 326 IF( lwm .AND. numoni /= -1 ) CALL FLUSH ( numoni ) ! flush output namelist ice 325 327 ENDIF 326 328 IF( lrst_oce ) CALL rst_write ( kstp ) ! write output ocean restart file
Note: See TracChangeset
for help on using the changeset viewer.