Changeset 2399
- Timestamp:
- 2010-11-17T10:09:35+01:00 (14 years ago)
- Location:
- branches/nemo_v3_3_beta/NEMOGCM
- Files:
-
- 22 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/nemo_v3_3_beta/NEMOGCM/CONFIG/GYRE/EXP00/namelist
r2396 r2399 719 719 ln_subbas = .false. ! Atlantic/Pacific/Indian basins computation (T) or not 720 720 ! (orca configuration only, need input basins mask file named "subbasins.nc" 721 n f_ptr= 1 ! Frequency of ptr computation [time step]722 n f_ptr_wri = 15 ! Frequency of ptr outputs721 nn_fptr = 1 ! Frequency of ptr computation [time step] 722 nn_fwri = 15 ! Frequency of ptr outputs [time step] 723 723 / 724 724 !----------------------------------------------------------------------- -
branches/nemo_v3_3_beta/NEMOGCM/CONFIG/GYRE_LOBSTER/EXP00/namelist
r2396 r2399 719 719 ln_subbas = .false. ! Atlantic/Pacific/Indian basins computation (T) or not 720 720 ! (orca configuration only, need input basins mask file named "subbasins.nc" 721 nf_ptr = 1 ! Frequency of ptr computation [time step] 722 nf_ptr_wri = 15 ! Frequency of ptr outputs 721 ln_ptrcomp = .false. ! Add decomposition : overturning 722 nn_fptr = 1 ! Frequency of ptr computation [time step] 723 nn_fwri = 15 ! Frequency of ptr outputs [time step] 723 724 / 724 725 !----------------------------------------------------------------------- -
branches/nemo_v3_3_beta/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/1_namelist
r2396 r2399 727 727 ln_subbas = .false. ! Atlantic/Pacific/Indian basins computation (T) or not 728 728 ! (orca configuration only, need input basins mask file named "subbasins.nc" 729 nf_ptr = 1 ! Frequency of ptr computation [time step] 730 nf_ptr_wri = 15 ! Frequency of ptr outputs 729 ln_ptrcomp = .false. ! Add decomposition : overturning 730 nn_fptr = 1 ! Frequency of ptr computation [time step] 731 nn_fwri = 15 ! Frequency of ptr outputs [time step] 731 732 / 732 733 !----------------------------------------------------------------------- -
branches/nemo_v3_3_beta/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist
r2396 r2399 765 765 ! (orca configuration only, need input basins mask file named "subbasins.nc" 766 766 ln_ptrcomp = .true. ! Add decomposition : overturning 767 n f_ptr= 1 ! Frequency of ptr computation [time step]768 n f_ptr_wri = 15 ! Frequency of ptr outputs767 nn_fptr = 1 ! Frequency of ptr computation [time step] 768 nn_fwri = 15 ! Frequency of ptr outputs [time step] 769 769 / 770 770 !----------------------------------------------------------------------- -
branches/nemo_v3_3_beta/NEMOGCM/CONFIG/ORCA2_LIM/cpp_ORCA2_LIM.fcm
r2370 r2399 1 bld::tool::fppkeys key_trabbl key_vectopt_loop key_orca_r2 key_lim2 key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_dtatem key_dtasal key_tradmp key_zdftke key_zdfddm key_iomput key_nproci=1 key_nprocj=11 bld::tool::fppkeys key_trabbl key_vectopt_loop key_dynspg_flt key_diaeiv key_ldfslp key_traldf_c2d key_traldf_eiv key_dynldf_c3d key_dtatem key_dtasal key_tradmp key_zdftke key_zdfddm key_iomput key_nproci=1 key_nprocj=1 -
branches/nemo_v3_3_beta/NEMOGCM/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist
r2396 r2399 765 765 ! (orca configuration only, need input basins mask file named "subbasins.nc" 766 766 ln_ptrcomp = .true. ! Add decomposition : overturning 767 n f_ptr= 1 ! Frequency of ptr computation [time step]768 n f_ptr_wri = 15 ! Frequency of ptr outputs767 nn_fptr = 1 ! Frequency of ptr computation [time step] 768 nn_fwri = 15 ! Frequency of ptr outputs [time step] 769 769 / 770 770 !----------------------------------------------------------------------- -
branches/nemo_v3_3_beta/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist
r2375 r2399 749 749 &namptr ! Poleward Transport Diagnostic 750 750 !----------------------------------------------------------------------- 751 ln_diaptr = .false. 752 ln_diaznl = . true.! Add zonal means and meridional stream functions753 ln_subbas = . true.! Atlantic/Pacific/Indian basins computation (T) or not751 ln_diaptr = .false. ! Poleward heat and salt transport (T) or not (F) 752 ln_diaznl = .false. ! Add zonal means and meridional stream functions 753 ln_subbas = .false. ! Atlantic/Pacific/Indian basins computation (T) or not 754 754 ! (orca configuration only, need input basins mask file named "subbasins.nc" 755 ln_ptrcomp = . true.! Add decomposition : overturning756 n f_ptr= 1 ! Frequency of ptr computation [time step]757 n f_ptr_wri = 15 ! Frequency of ptr outputs755 ln_ptrcomp = .false. ! Add decomposition : overturning 756 nn_fptr = 1 ! Frequency of ptr computation [time step] 757 nn_fwri = 15 ! Frequency of ptr outputs [time step] 758 758 / 759 759 !----------------------------------------------------------------------- -
branches/nemo_v3_3_beta/NEMOGCM/CONFIG/POMME/EXP00/namelist
r2371 r2399 760 760 ln_subbas = .false. ! Atlantic/Pacific/Indian basins computation (T) or not 761 761 ! (orca configuration only, need input basins mask file named "subbasins.nc" 762 nf_ptr = 1 ! Frequency of ptr computation [time step] 763 nf_ptr_wri = 15 ! Frequency of ptr outputs 762 ln_ptrcomp = .false. ! Add decomposition : overturning 763 nn_fptr = 1 ! Frequency of ptr computation [time step] 764 nn_fwri = 15 ! Frequency of ptr outputs [time step] 764 765 / 765 766 !----------------------------------------------------------------------- -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/ASM/asmtrj.F90
r2287 r2399 2 2 !!====================================================================== 3 3 !! *** MODULE asmtrj *** 4 !! Assimilation trajectory interface: Write to file the background state 5 !! and the model state trajectory 4 !! Assimilation trajectory interface: Write to file the background state and the model state trajectory 6 5 !!====================================================================== 6 !! History : ! 2007-03 (M. Martin) Met. Office version 7 !! ! 2007-04 (A. Weaver) asm_trj_wri, original code 8 !! ! 2007-03 (K. Mogensen) Adapt to NEMOVAR and use IOM instead of IOIPSL 9 !! ! 2007-04 (A. Weaver) Name change (formally asmbkg.F90). Distinguish 10 !! background states in Jb term and at analysis time. 11 !! Include state trajectory routine (currently empty) 12 !! ! 2007-07 (A. Weaver) Add tke_rst and flt_rst for case nitbkg=0 13 !! ! 2009-03 (F. Vigilant) Add hmlp (zdfmxl) for no tracer nmldp=2 14 !! ! 2009-06 (F. Vigilant) asm_trj_wri: special case when kt=nit000-1 15 !! ! 2009-07 (F. Vigilant) asm_trj_wri: add computation of eiv at restart 16 !!---------------------------------------------------------------------- 7 17 8 18 !!---------------------------------------------------------------------- … … 12 22 !! asm_trj_wri : Write out the model state trajectory (used with 4D-Var) 13 23 !!---------------------------------------------------------------------- 14 !! * Modules used15 24 USE oce ! Dynamics and active tracers defined in memory 16 25 USE sbc_oce ! Ocean surface boundary conditions … … 20 29 USE ldfslp ! Slopes of neutral surfaces 21 30 USE tradmp ! Tracer damping 22 23 31 #if defined key_zdftke 24 32 USE zdftke ! TKE vertical physics … … 26 34 USE eosbn2 ! Equation of state (eos_bn2 routine) 27 35 USE zdfmxl ! Mixed layer depth 28 USE sol_oce, ONLY : & ! Solver variables defined in memory 29 & gcx 30 USE in_out_manager, ONLY : & ! I/O manager 31 & lwp, & 32 & numout 33 USE dom_oce, ONLY : & 34 & ndastp 35 USE iom ! I/O module 36 USE asmpar ! Parameters for the assmilation interface 37 USE zdfmxl, ONLY : & ! mixed layer depth 38 & hmlp 36 USE dom_oce, ONLY : ndastp 37 USE sol_oce, ONLY : gcx ! Solver variables defined in memory 38 USE in_out_manager ! I/O manager 39 USE iom ! I/O module 40 USE asmpar ! Parameters for the assmilation interface 41 USE zdfmxl ! mixed layer depth 39 42 #if defined key_traldf_c2d 40 USE ldfeiv ! eddy induced velocity coef. (ldf_eiv routine)43 USE ldfeiv ! eddy induced velocity coef. (ldf_eiv routine) 41 44 #endif 42 45 43 46 IMPLICIT NONE 44 45 !! * Routine accessibility46 47 PRIVATE 47 PUBLIC asm_bkg_wri, & !: Write out the background state 48 & asm_trj_wri !: Write out the background state 48 49 PUBLIC asm_bkg_wri !: Write out the background state 50 PUBLIC asm_trj_wri !: Write out the background state 49 51 50 52 !!---------------------------------------------------------------------- 51 53 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 52 54 !! $Id$ 53 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 54 !!---------------------------------------------------------------------- 55 55 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 56 !!---------------------------------------------------------------------- 56 57 CONTAINS 57 58 58 59 SUBROUTINE asm_bkg_wri( kt ) 59 60 !!----------------------------------------------------------------------- 60 !!61 61 !! *** ROUTINE asm_bkg_wri *** 62 62 !! … … 68 68 !! in the cost function and for use with direct initialization 69 69 !! at analysis time. 70 !! 71 !! ** Action : 72 !! 73 !! References : 74 !! 75 !! History : 76 !! ! 07-03 (M. Martin) Met. Office version 77 !! ! 07-03 (K. Mogensen) Adapt to NEMOVAR and use IOM instead of IOIPSL 78 !! ! 07-04 (A. Weaver) Name change (formally asmbkg.F90). Distinguish 79 !! background states in Jb term and at analysis time. 80 !! Include state trajectory routine (currently empty) 81 !! ! 07-07 (A. Weaver) Add tke_rst and flt_rst for case nitbkg=0 82 !!----------------------------------------------------------------------- 83 84 !! * Arguments 70 !!----------------------------------------------------------------------- 85 71 INTEGER, INTENT( IN ) :: kt ! Current time-step 86 87 !! * Local declarations 72 ! 88 73 CHARACTER (LEN=50) :: cl_asmbkg 89 74 CHARACTER (LEN=50) :: cl_asmdin … … 91 76 INTEGER :: inum ! File unit number 92 77 REAL(wp) :: zdate ! Date 93 94 !-------------------------------------------------------------------- 95 ! Write out background at time step nitbkg_r or nitdin_r 96 !-------------------------------------------------------------------- 97 98 IF ( kt == nitbkg_r ) THEN 99 78 !!----------------------------------------------------------------------- 79 80 ! !------------------------------------------- 81 IF( kt == nitbkg_r ) THEN ! Write out background at time step nitbkg_r 82 ! !-----------------------------------======== 83 ! 100 84 WRITE(cl_asmbkg, FMT='(A,".nc")' ) TRIM( c_asmbkg ) 101 85 cl_asmbkg = TRIM( cl_asmbkg ) 102 103 86 INQUIRE( FILE = cl_asmbkg, EXIST = llok ) 104 87 ! 105 88 IF( .NOT. llok ) THEN 106 IF(lwp) WRITE(numout,*) ' Setting up assimilation background file '// & 107 & TRIM( c_asmbkg ) 108 109 ! Define the output file 89 IF(lwp) WRITE(numout,*) ' Setting up assimilation background file '// TRIM( c_asmbkg ) 90 ! 91 ! ! Define the output file 110 92 CALL iom_open( c_asmbkg, inum, ldwrt = .TRUE., kiolib = jprstlib) 111 112 ! Treat special case when nitbkg = 0113 IF ( nitbkg_r == nit000 - 1 ) THEN114 zdate = REAL( ndastp ) 115 #if defined key_zdftke 93 ! 94 IF( nitbkg_r == nit000 - 1 ) THEN ! Treat special case when nitbkg = 0 95 zdate = REAL( ndastp ) 96 #if defined key_zdftke 97 ! lk_zdftke=T : Read turbulent kinetic energy ( en ) 116 98 IF(lwp) WRITE(numout,*) ' Reading TKE (en) from restart...' 117 !Read turbulent kinetic energy ( en )118 CALL tke_rst( nit000, 'READ' ) 99 CALL tke_rst( nit000, 'READ' ) ! lk_zdftke=T : Read turbulent kinetic energy ( en ) 100 119 101 #endif 120 102 ELSE 121 103 zdate = REAL( ndastp ) 122 104 ENDIF 123 124 ! Write the information105 ! 106 ! ! Write the information 125 107 CALL iom_rstput( kt, nitbkg_r, inum, 'rdastp' , zdate ) 126 108 CALL iom_rstput( kt, nitbkg_r, inum, 'un' , un ) … … 133 115 #endif 134 116 CALL iom_rstput( kt, nitbkg_r, inum, 'gcx' , gcx ) 135 117 ! 136 118 CALL iom_close( inum ) 137 138 119 ENDIF 139 120 ! 140 121 ENDIF 141 122 142 IF ( kt == nitdin_r ) THEN 143 123 ! !------------------------------------------- 124 IF( kt == nitdin_r ) THEN ! Write out background at time step nitdin_r 125 ! !-----------------------------------======== 126 ! 144 127 WRITE(cl_asmdin, FMT='(A,".nc")' ) TRIM( c_asmdin ) 145 128 cl_asmdin = TRIM( cl_asmdin ) 146 147 129 INQUIRE( FILE = cl_asmdin, EXIST = llok ) 148 130 ! 149 131 IF( .NOT. llok ) THEN 150 IF(lwp) WRITE(numout,*) ' Setting up assimilation background file '// & 151 & TRIM( c_asmdin ) 152 153 ! Define the output file 132 IF(lwp) WRITE(numout,*) ' Setting up assimilation background file '// TRIM( c_asmdin ) 133 ! 134 ! ! Define the output file 154 135 CALL iom_open( c_asmdin, inum, ldwrt = .TRUE., kiolib = jprstlib) 155 156 ! Treat special case when nitbkg = 0157 IF ( nitdin_r == nit000 - 1) THEN 136 ! 137 IF( nitdin_r == nit000 - 1 ) THEN ! Treat special case when nitbkg = 0 138 158 139 zdate = REAL( ndastp ) 159 140 ELSE 160 141 zdate = REAL( ndastp ) 161 142 ENDIF 162 163 ! Write the information143 ! 144 ! ! Write the information 164 145 CALL iom_rstput( kt, nitdin_r, inum, 'rdastp' , zdate ) 165 146 CALL iom_rstput( kt, nitdin_r, inum, 'un' , un ) … … 168 149 CALL iom_rstput( kt, nitdin_r, inum, 'sn' , sn ) 169 150 CALL iom_rstput( kt, nitdin_r, inum, 'sshn' , sshn ) 170 151 ! 171 152 CALL iom_close( inum ) 172 173 153 ENDIF 174 154 ! 175 155 ENDIF 176 156 ! 177 157 END SUBROUTINE asm_bkg_wri 178 158 159 179 160 SUBROUTINE asm_trj_wri( kt ) 180 161 !!----------------------------------------------------------------------- 181 !!182 162 !! *** ROUTINE asm_trj_wri *** 183 163 !! 184 !! ** Purpose : Write to file the model state trajectory for use with 185 !! 4D-Var. 186 !! 187 !! ** Method : 188 !! 189 !! ** Action : 190 !! 191 !! References : 192 !! 193 !! History : 194 !! ! 07-04 (A. Weaver) 195 !! ! 09-03 (F. Vigilant) Add hmlp (zdfmxl) for no tracer nmldp=2 196 !! ! 09-06 (F. Vigilant) special case when kt=nit000-1 197 !! ! 09-07 (F. Vigilant) add computation of eiv at restart 198 !!----------------------------------------------------------------------- 199 200 !! * Arguments 164 !! ** Purpose : Write to file the model state trajectory for use with 4D-Var. 165 !!----------------------------------------------------------------------- 201 166 INTEGER, INTENT( IN ) :: kt ! Current time-step 202 203 !! * Local declarations 167 ! 204 168 INTEGER :: inum ! File unit number 205 169 INTEGER :: it 206 170 CHARACTER (LEN=50) :: cl_asmtrj 207 171 REAL(wp) :: zdate ! Date 172 !!----------------------------------------------------------------------- 208 173 209 174 !------------------------------------------------------------------------ 210 175 ! Write a single file for each trajectory time step 211 176 !------------------------------------------------------------------------ 212 IF ( ( MOD( kt - nit000 + 1, nittrjfrq ) == 0 ) .OR. & 213 & ( kt == nitend ) ) THEN 177 IF( ( MOD( kt - nit000 + 1, nittrjfrq ) == 0 ) .OR. ( kt == nitend ) ) THEN 214 178 215 ! Treat special case when kt = nit000-1216 IF ( kt == nit000 - 1 ) THEN179 IF( kt == nit000 - 1 ) THEN ! Treat special case when kt = nit000-1 180 ! 217 181 #if defined key_zdftke 218 182 IF(lwp) WRITE(numout,*) ' Computing zdf_tke coeff. form restart...' … … 238 202 IF( lk_traldf_eiv ) CALL ldf_eiv( nit000 ) 239 203 #endif 240 ENDIF 241 242 204 ENDIF 205 ! 243 206 it = kt - nit000 + 1 244 245 ! Define the output file207 ! 208 ! ! Define the output file 246 209 WRITE(cl_asmtrj, FMT='(A,A,I5.5)' ) TRIM( c_asmtrj ), '_', it 247 210 cl_asmtrj = TRIM( cl_asmtrj ) 248 211 CALL iom_open( cl_asmtrj, inum, ldwrt = .TRUE., kiolib = jprstlib) 249 250 ! Output trajectory fields212 ! 213 ! ! Output trajectory fields 251 214 CALL iom_rstput( it, it, inum, 'emp' , emp ) 252 215 CALL iom_rstput( it, it, inum, 'emps' , emps ) … … 278 241 CALL iom_rstput( it, it, inum, 'aeiv' , aeiv ) 279 242 CALL iom_rstput( it, it, inum, 'aeiw' , aeiw ) 280 243 ! 281 244 CALL iom_close( inum ) 282 283 245 ENDIF 284 246 ! 285 247 END SUBROUTINE asm_trj_wri 286 248 249 !!====================================================================== 287 250 END MODULE asmtrj -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90
r2364 r2399 6 6 !! History : 1.0 ! 2003-09 (C. Talandier, G. Madec) Original code 7 7 !! 2.0 ! 2006-01 (A. Biastoch) Allow sub-basins computation 8 !! 3.2 ! 2003-03 (O. Marti, S. Flavoni) Add fields 8 !! 3.2 ! 2010-03 (O. Marti, S. Flavoni) Add fields 9 !! 3.3 ! 2010-10 (G. Madec) dynamical allocation 9 10 !!---------------------------------------------------------------------- 10 11 … … 15 16 !! ptr_vjk : "zonal" sum computation of a "meridional" flux array 16 17 !! ptr_tjk : "zonal" mean computation of a tracer field 17 !! ptr_vj : "zonal" and vertical sum computation of a "meridional" 18 !! : flux array; Generic interface: ptr_vj_3d, ptr_vj_2d18 !! ptr_vj : "zonal" and vertical sum computation of a "meridional" flux array 19 !! (Generic interface to ptr_vj_3d, ptr_vj_2d) 19 20 !!---------------------------------------------------------------------- 20 USE oce ! ocean dynamics and active tracers21 USE dom_oce ! ocean space and time domain22 USE phycst ! physical constants23 USE ldftra_oce ! ocean active tracers: lateral physics24 USE dianam 25 USE iom 26 USE ioipsl 27 USE in_out_manager 28 USE lib_mpp 29 USE lbclnk 21 USE oce ! ocean dynamics and active tracers 22 USE dom_oce ! ocean space and time domain 23 USE phycst ! physical constants 24 USE ldftra_oce ! ocean active tracers: lateral physics 25 USE dianam ! 26 USE iom ! IOM library 27 USE ioipsl ! IO-IPSL library 28 USE in_out_manager ! I/O manager 29 USE lib_mpp ! MPP library 30 USE lbclnk ! lateral boundary condition - processor exchanges 30 31 31 32 IMPLICIT NONE … … 46 47 LOGICAL , PUBLIC :: ln_diaznl = .FALSE. !: Add zonal means and meridional stream functions 47 48 LOGICAL , PUBLIC :: ln_ptrcomp = .FALSE. !: Add decomposition : overturning (and gyre, soon ...) 48 INTEGER , PUBLIC :: nf_ptr = 15 !: frequency of ptr computation 49 INTEGER , PUBLIC :: nf_ptr_wri = 15 !: frequency of ptr outputs 50 51 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: abasin, pbasin, ibasin, dbasin, sbasin !: Sub basin masks 52 53 ! !!! poleward heat and salt transport 54 REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_adv , pst_adv !: advection 55 REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_ldf , pst_ldf !: lateral diffusion 56 REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_ove_glo, pst_ove_glo !: global overturning 57 REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_ove_atl, pst_ove_atl !: Atlantic overturning 58 REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_ove_pac, pst_ove_pac !: Pacific overturning 59 REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_ove_ind, pst_ove_ind !: Indian overturning 60 REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_ove_ipc, pst_ove_ipc !: Indo-Pacific overturning 61 REAL(wp), PUBLIC, DIMENSION(jpj) :: ht_glo, ht_atl, ht_ind, ht_pac, ht_ipc !: heat 62 REAL(wp), PUBLIC, DIMENSION(jpj) :: st_glo, st_atl, st_ind, st_pac, st_ipc !: salt 63 64 INTEGER :: niter 65 INTEGER :: nidom_ptr 66 INTEGER :: numptr !: logical unit for Poleward TRansports 67 68 REAL(wp), DIMENSION(jpj,jpk) :: tn_jk_glo , sn_jk_glo ! global i-mean temperature and salinity 69 REAL(wp), DIMENSION(jpj,jpk) :: tn_jk_atl , sn_jk_atl ! Atlantic - - 70 REAL(wp), DIMENSION(jpj,jpk) :: tn_jk_pac , sn_jk_pac ! Pacific - - 71 REAL(wp), DIMENSION(jpj,jpk) :: tn_jk_ind , sn_jk_ind ! Indian - - 72 REAL(wp), DIMENSION(jpj,jpk) :: tn_jk_ipc , sn_jk_ipc ! Indo-Pacific - - 73 REAL(wp), DIMENSION(jpj,jpk) :: v_msf_glo ! global "meridional" Stream-Function 74 REAL(wp), DIMENSION(jpj,jpk) :: v_msf_atl ! Atlantic - - 75 REAL(wp), DIMENSION(jpj,jpk) :: v_msf_pac ! Pacific - - 76 REAL(wp), DIMENSION(jpj,jpk) :: v_msf_ind ! Indian - - 77 REAL(wp), DIMENSION(jpj,jpk) :: v_msf_ipc ! Indo-Pacific - - 78 REAL(wp), DIMENSION(jpj,jpk) :: surf_jk_glo, surf_jk_r_glo ! surface of global i-section and its inverse 79 REAL(wp), DIMENSION(jpj,jpk) :: surf_jk_atl, surf_jk_r_atl ! surface of Atlantic - - 80 REAL(wp), DIMENSION(jpj,jpk) :: surf_jk_pac, surf_jk_r_pac ! surface of Pacific - - 81 REAL(wp), DIMENSION(jpj,jpk) :: surf_jk_ind, surf_jk_r_ind ! surface of Indian - - 82 REAL(wp), DIMENSION(jpj,jpk) :: surf_jk_ipc, surf_jk_r_ipc ! surface of Indo-Pacific - - 83 #if defined key_diaeiv 84 ! !!! eddy induced velocity (bolus) 85 REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_eiv_glo, pst_eiv_glo !: global poleward heat and salt bolus advection 86 REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_eiv_atl, pst_eiv_atl !: Atlantic - - 87 REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_eiv_pac, pst_eiv_pac !: Pacific - - 88 REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_eiv_ind, pst_eiv_ind !: Indian - - 89 REAL(wp), PUBLIC, DIMENSION(jpj) :: pht_eiv_ipc, pst_eiv_ipc !: Indo-Pacific - - 90 91 REAL(wp), DIMENSION(jpj,jpk) :: v_msf_eiv_glo ! global "meridional" bolus Stream-Function 92 REAL(wp), DIMENSION(jpj,jpk) :: v_msf_eiv_atl ! Atlantic - - 93 REAL(wp), DIMENSION(jpj,jpk) :: v_msf_eiv_pac ! Pacific - - 94 REAL(wp), DIMENSION(jpj,jpk) :: v_msf_eiv_ind ! Indian - - 95 REAL(wp), DIMENSION(jpj,jpk) :: v_msf_eiv_ipc ! Indo-Pacific - - 96 #endif 97 49 INTEGER , PUBLIC :: nn_fptr = 15 !: frequency of ptr computation [time step] 50 INTEGER , PUBLIC :: nn_fwri = 15 !: frequency of ptr outputs [time step] 51 52 REAL(wp), PUBLIC, DIMENSION(:), ALLOCATABLE :: htr_adv, htr_ldf, htr_ove !: Heat TRansports (adv, diff, overturn.) 53 REAL(wp), PUBLIC, DIMENSION(:), ALLOCATABLE :: str_adv, str_ldf, str_ove !: Salt TRansports (adv, diff, overturn.) 54 55 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: btmsk ! T-point basin interior masks 56 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: btm30 ! mask out Southern Ocean (=0 south of 30°S) 57 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: htr , str ! adv heat and salt transports (approx) 58 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tn_jk, sn_jk , v_msf ! i-mean T and S, j-Stream-Function 59 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: sjk , r1_sjk ! i-mean i-k-surface and its inverse 60 #if defined key_diaeiv 61 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: htr_eiv, str_eiv ! bolus adv heat ans salt transports ('key_diaeiv') 62 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: v_msf_eiv ! bolus j-streamfuction ('key_diaeiv') 63 #endif 64 65 INTEGER :: niter ! 66 INTEGER :: nidom_ptr ! 67 INTEGER :: numptr ! logical unit for Poleward TRansports 68 INTEGER :: nptr ! = 1 (ln_subbas=F) or = 5 (glo, atl, pac, ind, ipc) (ln_subbas=T) 69 70 REAL(wp) :: rc_sv = 1.e-6_wp ! conversion from m3/s to Sverdrup 71 REAL(wp) :: rc_pwatt = 1.e-15_wp ! conversion from W to PW (further x rau0 x Cp) 72 REAL(wp) :: rc_ggram = 1.e-6_wp ! conversion from g to Pg 73 98 74 !! * Substitutions 99 75 # include "domzgr_substitute.h90" … … 102 78 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 103 79 !! $Id$ 104 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)80 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 105 81 !!---------------------------------------------------------------------- 106 107 82 CONTAINS 108 83 … … 111 86 !! *** ROUTINE ptr_vj_3d *** 112 87 !! 113 !! ** Purpose : "zonal" and vertical sum computation of a "meridional" 114 !! flux array 88 !! ** Purpose : i-k sum computation of a j-flux array 115 89 !! 116 90 !! ** Method : - i-k sum of pva using the interior 2D vmask (vmask_i). … … 127 101 ! 128 102 ijpj = jpj 129 p_fval(:) = 0. e0103 p_fval(:) = 0._wp 130 104 DO jk = 1, jpkm1 131 105 DO jj = 2, jpjm1 … … 137 111 ! 138 112 #if defined key_mpp_mpi 139 CALL mpp_sum( p_fval, ijpj, ncomm_znl) !!bug I presume113 CALL mpp_sum( p_fval, ijpj, ncomm_znl) 140 114 #endif 141 115 ! … … 147 121 !! *** ROUTINE ptr_vj_2d *** 148 122 !! 149 !! ** Purpose : "zonal" and vertical sum computation of a "meridional" 150 !! flux array 123 !! ** Purpose : "zonal" and vertical sum computation of a i-flux array 151 124 !! 152 125 !! ** Method : - i-k sum of pva using the interior 2D vmask (vmask_i). … … 163 136 ! 164 137 ijpj = jpj 165 p_fval(:) = 0. e0138 p_fval(:) = 0._wp 166 139 DO jj = 2, jpjm1 167 140 DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ? … … 171 144 ! 172 145 #if defined key_mpp_mpi 173 CALL mpp_sum( p_fval, ijpj, ncomm_znl ) !!bug I presume146 CALL mpp_sum( p_fval, ijpj, ncomm_znl ) 174 147 #endif 175 148 ! … … 177 150 178 151 179 FUNCTION ptr_vjk( pva, bmask ) RESULT ( p_fval )152 FUNCTION ptr_vjk( pva, pmsk ) RESULT ( p_fval ) 180 153 !!---------------------------------------------------------------------- 181 154 !! *** ROUTINE ptr_vjk *** 182 155 !! 183 !! ** Purpose : "zonal" sum computation of a "meridional" fluxarray156 !! ** Purpose : i-sum computation of a j-velocity array 184 157 !! 185 158 !! ** Method : - i-sum of pva using the interior 2D vmask (vmask_i). 186 !! pva is supposed to be a masked flux (i.e. * vmask*e1v*e3v)187 !! 188 !! ** Action : - p_fval: i- k-mean poleward flux of pva189 !!---------------------------------------------------------------------- 190 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) :: pva 191 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) , OPTIONAL :: bmask ! Optional 2D basin mask159 !! pva is supposed to be a masked flux (i.e. * vmask) 160 !! 161 !! ** Action : - p_fval: i-mean poleward flux of pva 162 !!---------------------------------------------------------------------- 163 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) :: pva ! mask flux array at V-point 164 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) , OPTIONAL :: pmsk ! Optional 2D basin mask 192 165 !! 193 166 INTEGER :: ji, jj, jk ! dummy loop arguments … … 200 173 !!-------------------------------------------------------------------- 201 174 ! 202 p_fval(:,:) = 0. e0203 ! 204 IF( PRESENT( bmask ) ) THEN175 p_fval(:,:) = 0._wp 176 ! 177 IF( PRESENT( pmsk ) ) THEN 205 178 DO jk = 1, jpkm1 206 179 DO jj = 2, jpjm1 207 180 !!gm here, use of tmask_i ==> no need of loop over nldi, nlei.... 208 181 DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ? 209 p_fval(jj,jk) = p_fval(jj,jk) + pva(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk) & 210 & * tmask_i(ji,jj) * bmask(ji,jj) 182 p_fval(jj,jk) = p_fval(jj,jk) + pva(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk) * pmsk(ji,jj) 211 183 END DO 212 184 END DO … … 216 188 DO jj = 2, jpjm1 217 189 DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ? 218 p_fval(jj,jk) = p_fval(jj,jk) + pva(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk) & 219 & * tmask_i(ji,jj) 190 p_fval(jj,jk) = p_fval(jj,jk) + pva(ji,jj,jk) * e1v(ji,jj) * fse3v(ji,jj,jk) * tmask_i(ji,jj) 220 191 END DO 221 192 END DO … … 233 204 234 205 235 FUNCTION ptr_tjk( pta, bmask ) RESULT ( p_fval )206 FUNCTION ptr_tjk( pta, pmsk ) RESULT ( p_fval ) 236 207 !!---------------------------------------------------------------------- 237 208 !! *** ROUTINE ptr_tjk *** 238 209 !! 239 !! ** Purpose : "zonal" mean computation ofa tracer field210 !! ** Purpose : i-sum computation of e1t*e3t * a tracer field 240 211 !! 241 212 !! ** Method : - i-sum of mj(pta) using tmask 242 !! multiplied by the inverse of the surface of the "zonal" ocean 243 !! section 244 !! 245 !! ** Action : - p_fval: i-k-mean poleward flux of pta 213 !! 214 !! ** Action : - p_fval: i-sum of e1t*e3t*pta 246 215 !!---------------------------------------------------------------------- 247 216 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj,jpk) :: pta ! tracer flux array at T-point 248 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) , OPTIONAL :: bmask! Optional 2D basin mask217 REAL(wp) , INTENT(in), DIMENSION(jpi,jpj) :: pmsk ! Optional 2D basin mask 249 218 !! 250 219 INTEGER :: ji, jj, jk ! dummy loop arguments … … 257 226 !!-------------------------------------------------------------------- 258 227 ! 259 p_fval(:,:) = 0.e0 260 IF (PRESENT (bmask)) THEN 261 DO jk = 1, jpkm1 262 DO jj = 2, jpjm1 263 DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ? 264 p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) & 265 & * e1t(ji,jj) * fse3t(ji,jj,jk) & 266 & * tmask_i(ji,jj) & 267 & * bmask(ji,jj) 268 END DO 228 p_fval(:,:) = 0._wp 229 DO jk = 1, jpkm1 230 DO jj = 2, jpjm1 231 DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ? 232 p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) * e1t(ji,jj) * fse3t(ji,jj,jk) * pmsk(ji,jj) 269 233 END DO 270 234 END DO 271 ELSE 272 DO jk = 1, jpkm1 273 DO jj = 2, jpjm1 274 DO ji = nldi, nlei ! No vector optimisation here. Better use a mask ? 275 p_fval(jj,jk) = p_fval(jj,jk) + pta(ji,jj,jk) & 276 & * e1t(ji,jj) * fse3t(ji,jj,jk) & 277 & * tmask_i(ji,jj) 278 END DO 279 END DO 280 END DO 281 END IF 282 p_fval(:,:) = p_fval(:,:) * 0.5 235 END DO 283 236 #if defined key_mpp_mpi 284 237 ish(1) = jpj*jpk ; ish2(1) = jpj ; ish2(2) = jpk 285 238 zwork(:)= RESHAPE( p_fval, ish ) 286 239 CALL mpp_sum( zwork, jpj*jpk, ncomm_znl ) 287 p_fval(:,:)= RESHAPE( zwork,ish2)240 p_fval(:,:)= RESHAPE( zwork, ish2 ) 288 241 #endif 289 242 ! … … 295 248 !! *** ROUTINE dia_ptr *** 296 249 !!---------------------------------------------------------------------- 250 USE oce, vt => ua ! use ua as workspace 251 USE oce, vs => ua ! use ua as workspace 252 !! 297 253 INTEGER, INTENT(in) :: kt ! ocean time step index 298 !! 299 INTEGER :: jk, jj, ji ! dummy loop 300 REAL(wp) :: zsverdrup ! conversion from m3/s to Sverdrup 301 REAL(wp) :: zpwatt ! conversion from W to PW 302 REAL(wp) :: zggram ! conversion from g to Pg 303 REAL(wp), DIMENSION(jpi,jpj,jpk) :: vt, vs ! 3D workspace 304 !!---------------------------------------------------------------------- 305 306 IF( kt == nit000 .OR. MOD( kt, nf_ptr ) == 0 ) THEN 307 308 IF ( MOD( kt, nf_ptr ) == 0 ) THEN 309 310 zsverdrup = 1.e-6 311 zpwatt = 1.e-15 312 zggram = 1.e-6 313 314 IF ( ln_diaznl ) THEN 315 ! "zonal" mean temperature and salinity at V-points 316 tn_jk_glo(:,:) = ptr_tjk( tn(:,:,:) ) * surf_jk_r_glo(:,:) 317 sn_jk_glo(:,:) = ptr_tjk( sn(:,:,:) ) * surf_jk_r_glo(:,:) 318 319 IF (ln_subbas) THEN 320 tn_jk_atl(:,:) = ptr_tjk( tn(:,:,:), abasin(:,:) ) * surf_jk_r_atl(:,:) 321 sn_jk_atl(:,:) = ptr_tjk( sn(:,:,:), abasin(:,:) ) * surf_jk_r_atl(:,:) 322 tn_jk_pac(:,:) = ptr_tjk( tn(:,:,:), pbasin(:,:) ) * surf_jk_r_pac(:,:) 323 sn_jk_pac(:,:) = ptr_tjk( sn(:,:,:), pbasin(:,:) ) * surf_jk_r_pac(:,:) 324 tn_jk_ind(:,:) = ptr_tjk( tn(:,:,:), ibasin(:,:) ) * surf_jk_r_ind(:,:) 325 sn_jk_ind(:,:) = ptr_tjk( sn(:,:,:), ibasin(:,:) ) * surf_jk_r_ind(:,:) 326 tn_jk_ipc(:,:) = ptr_tjk( tn(:,:,:), dbasin(:,:) ) * surf_jk_r_ipc(:,:) 327 sn_jk_ipc(:,:) = ptr_tjk( sn(:,:,:), dbasin(:,:) ) * surf_jk_r_ipc(:,:) 328 ENDIF 329 ENDIF 330 331 !-------------------------------------------------------- 332 ! overturning calculation: 333 334 ! horizontal integral and vertical dz 335 336 #if defined key_diaeiv 337 v_msf_glo(:,:) = ptr_vjk( vn(:,:,:)+v_eiv(:,:,:) ) 338 IF( ln_subbas .AND. ln_diaznl ) THEN 339 v_msf_atl(:,:) = ptr_vjk( vn(:,:,:)+v_eiv(:,:,:), abasin(:,:)*sbasin(:,:) ) 340 v_msf_pac(:,:) = ptr_vjk( vn(:,:,:)+v_eiv(:,:,:), pbasin(:,:)*sbasin(:,:) ) 341 v_msf_ind(:,:) = ptr_vjk( vn(:,:,:)+v_eiv(:,:,:), ibasin(:,:)*sbasin(:,:) ) 342 v_msf_ipc(:,:) = ptr_vjk( vn(:,:,:)+v_eiv(:,:,:), dbasin(:,:)*sbasin(:,:) ) 343 ENDIF 344 #else 345 v_msf_glo(:,:) = ptr_vjk( vn(:,:,:) ) 346 IF( ln_subbas .AND. ln_diaznl ) THEN 347 v_msf_atl(:,:) = ptr_vjk( vn(:,:,:), abasin(:,:)*sbasin(:,:) ) 348 v_msf_pac(:,:) = ptr_vjk( vn(:,:,:), pbasin(:,:)*sbasin(:,:) ) 349 v_msf_ind(:,:) = ptr_vjk( vn(:,:,:), ibasin(:,:)*sbasin(:,:) ) 350 v_msf_ipc(:,:) = ptr_vjk( vn(:,:,:), dbasin(:,:)*sbasin(:,:) ) 351 ENDIF 352 #endif 353 354 #if defined key_diaeiv 355 v_msf_eiv_glo(:,:) = ptr_vjk( v_eiv(:,:,:) ) 356 IF (ln_subbas ) THEN 357 v_msf_eiv_atl(:,:) = ptr_vjk( v_eiv(:,:,:), abasin(:,:)*sbasin(:,:) ) 358 v_msf_eiv_pac(:,:) = ptr_vjk( v_eiv(:,:,:), pbasin(:,:)*sbasin(:,:) ) 359 v_msf_eiv_ind(:,:) = ptr_vjk( v_eiv(:,:,:), ibasin(:,:)*sbasin(:,:) ) 360 v_msf_eiv_ipc(:,:) = ptr_vjk( v_eiv(:,:,:), dbasin(:,:)*sbasin(:,:) ) 361 END IF 362 #endif 363 364 ! Transports 365 ! T times V on T points (include bolus velocities) 366 #if defined key_diaeiv 367 DO jj = 2, jpj 368 DO ji = 1, jpi 369 vt(ji,jj,:) = tn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) + u_eiv(ji,jj,:) + u_eiv(ji,jj-1,:) )*0.5 370 vs(ji,jj,:) = sn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) + v_eiv(ji,jj,:) + v_eiv(ji,jj-1,:) )*0.5 371 END DO 372 END DO 373 #else 374 DO jj = 2, jpj 375 DO ji = 1, jpi 376 vt(ji,jj,:) = tn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) )*0.5 377 vs(ji,jj,:) = sn(ji,jj,:) * ( vn(ji,jj,:) + vn(ji,jj-1,:) )*0.5 378 END DO 379 END DO 380 #endif 381 CALL lbc_lnk( vs, 'V', -1. ) ; CALL lbc_lnk( vt, 'V', -1. ) 382 383 ht_glo(:) = SUM( ptr_vjk( vt(:,:,:)), 2 ) 384 st_glo(:) = SUM( ptr_vjk( vs(:,:,:)), 2 ) 385 386 IF ( ln_subbas ) THEN 387 ht_atl(:) = SUM( ptr_vjk( vt (:,:,:), abasin(:,:)*sbasin(:,:)), 2 ) 388 ht_pac(:) = SUM( ptr_vjk( vt (:,:,:), pbasin(:,:)*sbasin(:,:)), 2 ) 389 ht_ind(:) = SUM( ptr_vjk( vt (:,:,:), ibasin(:,:)*sbasin(:,:)), 2 ) 390 ht_ipc(:) = SUM( ptr_vjk( vt (:,:,:), dbasin(:,:)*sbasin(:,:)), 2 ) 391 st_atl(:) = SUM( ptr_vjk( vs (:,:,:), abasin(:,:)*sbasin(:,:)), 2 ) 392 st_pac(:) = SUM( ptr_vjk( vs (:,:,:), pbasin(:,:)*sbasin(:,:)), 2 ) 393 st_ind(:) = SUM( ptr_vjk( vs (:,:,:), ibasin(:,:)*sbasin(:,:)), 2 ) 394 st_ipc(:) = SUM( ptr_vjk( vs (:,:,:), dbasin(:,:)*sbasin(:,:)), 2 ) 395 ENDIF 396 397 ! poleward tracer transports: 398 ! overturning components: 399 IF ( ln_ptrcomp ) THEN 400 pht_ove_glo(:) = SUM( v_msf_glo(:,:) * tn_jk_glo(:,:), 2 ) ! SUM over jk 401 pst_ove_glo(:) = SUM( v_msf_glo(:,:) * sn_jk_glo(:,:), 2 ) 402 IF ( ln_subbas ) THEN 403 pht_ove_atl(:) = SUM( v_msf_atl(:,:) * tn_jk_atl(:,:), 2 ) ! SUM over jk 404 pst_ove_atl(:) = SUM( v_msf_atl(:,:) * sn_jk_atl(:,:), 2 ) 405 pht_ove_pac(:) = SUM( v_msf_pac(:,:) * tn_jk_pac(:,:), 2 ) ! SUM over jk 406 pst_ove_pac(:) = SUM( v_msf_pac(:,:) * sn_jk_pac(:,:), 2 ) 407 pht_ove_ind(:) = SUM( v_msf_ind(:,:) * tn_jk_ind(:,:), 2 ) ! SUM over jk 408 pst_ove_ind(:) = SUM( v_msf_ind(:,:) * sn_jk_ind(:,:), 2 ) 409 pht_ove_ipc(:) = SUM( v_msf_ipc(:,:) * tn_jk_ipc(:,:), 2 ) ! SUM over jk 410 pst_ove_ipc(:) = SUM( v_msf_ipc(:,:) * sn_jk_ipc(:,:), 2 ) 411 END IF 412 END IF 413 414 ! Bolus component 415 #if defined key_diaeiv 416 pht_eiv_glo(:) = SUM( v_msf_eiv_glo(:,:) * tn_jk_glo(:,:), 2 ) ! SUM over jk 417 pst_eiv_glo(:) = SUM( v_msf_eiv_glo(:,:) * sn_jk_glo(:,:), 2 ) ! SUM over jk 418 IF ( ln_subbas ) THEN 419 pht_eiv_atl(:) = SUM( v_msf_eiv_glo(:,:) * tn_jk_atl(:,:), 2 ) ! SUM over jk 420 pst_eiv_atl(:) = SUM( v_msf_eiv_glo(:,:) * sn_jk_atl(:,:), 2 ) ! SUM over jk 421 pht_eiv_pac(:) = SUM( v_msf_eiv_pac(:,:) * tn_jk_pac(:,:), 2 ) ! SUM over jk 422 pst_eiv_pac(:) = SUM( v_msf_eiv_pac(:,:) * sn_jk_pac(:,:), 2 ) ! SUM over jk 423 pht_eiv_ind(:) = SUM( v_msf_eiv_ind(:,:) * tn_jk_ind(:,:), 2 ) ! SUM over jk 424 pst_eiv_ind(:) = SUM( v_msf_eiv_ind(:,:) * sn_jk_ind(:,:), 2 ) ! SUM over jk 425 pht_eiv_ipc(:) = SUM( v_msf_eiv_ipc(:,:) * tn_jk_ipc(:,:), 2 ) ! SUM over jk 426 pst_eiv_ipc(:) = SUM( v_msf_eiv_ipc(:,:) * sn_jk_ipc(:,:), 2 ) ! SUM over jk 427 ENDIF 428 #endif 429 430 ! conversion in PW and G g 431 zpwatt = zpwatt * rau0 * rcp 432 pht_adv(:) = pht_adv(:) * zpwatt 433 pht_ldf(:) = pht_ldf(:) * zpwatt 434 pst_adv(:) = pst_adv(:) * zggram 435 pst_ldf(:) = pst_ldf(:) * zggram 436 IF ( ln_ptrcomp ) THEN 437 pht_ove_glo(:) = pht_ove_glo(:) * zpwatt 438 pst_ove_glo(:) = pst_ove_glo(:) * zggram 439 END IF 440 #if defined key_diaeiv 441 pht_eiv_glo(:) = pht_eiv_glo(:) * zpwatt 442 pst_eiv_glo(:) = pst_eiv_glo(:) * zggram 443 #endif 444 IF( ln_subbas ) THEN 445 ht_atl(:) = ht_atl(:) * zpwatt 446 ht_pac(:) = ht_pac(:) * zpwatt 447 ht_ind(:) = ht_ind(:) * zpwatt 448 ht_ipc(:) = ht_ipc(:) * zpwatt 449 st_atl(:) = st_atl(:) * zggram 450 st_pac(:) = st_pac(:) * zggram 451 st_ind(:) = st_ind(:) * zggram 452 st_ipc(:) = st_ipc(:) * zggram 453 ENDIF 454 455 ! "Meridional" Stream-Function 456 DO jk = 2,jpk 457 v_msf_glo(:,jk) = v_msf_glo(:,jk-1) + v_msf_glo(:,jk) 458 END DO 459 v_msf_glo(:,:) = v_msf_glo(:,:) * zsverdrup 460 #if defined key_diaeiv 461 ! Bolus "Meridional" Stream-Function 462 DO jk = 2,jpk 463 v_msf_eiv_glo(:,jk) = v_msf_eiv_glo(:,jk-1) + v_msf_eiv_glo(:,jk) 464 END DO 465 v_msf_eiv_glo(:,:) = v_msf_eiv_glo(:,:) * zsverdrup 466 IF ( ln_subbas ) THEN 467 DO jk = 2,jpk 468 v_msf_eiv_atl(:,jk) = v_msf_eiv_atl(:,jk-1) + v_msf_eiv_atl(:,jk) 469 v_msf_eiv_pac(:,jk) = v_msf_eiv_pac(:,jk-1) + v_msf_eiv_pac(:,jk) 470 v_msf_eiv_ind(:,jk) = v_msf_eiv_ind(:,jk-1) + v_msf_eiv_ind(:,jk) 471 v_msf_eiv_ipc(:,jk) = v_msf_eiv_ipc(:,jk-1) + v_msf_eiv_ipc(:,jk) 254 ! 255 INTEGER :: ji, jj, jk, jn ! dummy loop indices 256 REAL(wp) :: zv ! local scalar 257 !!---------------------------------------------------------------------- 258 ! 259 IF( kt == nit000 .OR. MOD( kt, nn_fptr ) == 0 ) THEN 260 ! 261 IF( MOD( kt, nn_fptr ) == 0 ) THEN 262 ! 263 IF( ln_diaznl ) THEN ! i-mean temperature and salinity 264 DO jn = 1, nptr 265 tn_jk(:,:,jn) = ptr_tjk( tn(:,:,:), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 472 266 END DO 473 267 ENDIF 474 #endif475 268 ! 476 IF( ln_subbas .AND. ln_diaznl ) THEN 477 DO jk = 2,jpk 478 v_msf_atl(:,jk) = v_msf_atl(:,jk-1) + v_msf_atl(:,jk) 479 v_msf_pac(:,jk) = v_msf_pac(:,jk-1) + v_msf_pac(:,jk) 480 v_msf_ind(:,jk) = v_msf_ind(:,jk-1) + v_msf_ind(:,jk) 481 v_msf_ipc(:,jk) = v_msf_ipc(:,jk-1) + v_msf_ipc(:,jk) 269 ! ! horizontal integral and vertical dz 270 ! ! eulerian velocity 271 v_msf(:,:,1) = ptr_vjk( vn(:,:,:) ) 272 DO jn = 2, nptr 273 v_msf(:,:,jn) = ptr_vjk( vn(:,:,:), btmsk(:,:,jn)*btm30(:,:) ) 274 END DO 275 #if defined key_diaeiv 276 DO jn = 1, nptr ! bolus velocity 277 v_msf_eiv(:,:,jn) = ptr_vjk( v_eiv(:,:,:), btmsk(:,:,jn) ) ! here no btm30 for MSFeiv 278 END DO 279 ! ! add bolus stream-function to the eulerian one 280 v_msf(:,:,:) = v_msf(:,:,:) + v_msf_eiv(:,:,:) 281 #endif 282 ! 283 ! ! Transports 284 ! ! local heat & salt transports at T-points ( tn*mj[vn+v_eiv] ) 285 vt(:,:,jpk) = 0._wp ; vs(:,:,jpk) = 0._wp 286 DO jk= 1, jpkm1 287 DO jj = 2, jpj 288 DO ji = 1, jpi 289 #if defined key_diaeiv 290 zv = ( vn(ji,jj,jk) + vn(ji,jj-1,jk) + u_eiv(ji,jj,jk) + u_eiv(ji,jj-1,jk) ) * 0.5_wp 291 #else 292 zv = ( vn(ji,jj,jk) + vn(ji,jj-1,jk) ) * 0.5_wp 293 #endif 294 vt(:,jj,jk) = zv * tn(:,jj,jk) 295 vs(:,jj,jk) = zv * sn(:,jj,jk) 296 END DO 482 297 END DO 483 v_msf_atl(:,:) = v_msf_atl(:,:) * zsverdrup 484 v_msf_pac(:,:) = v_msf_pac(:,:) * zsverdrup 485 v_msf_ind(:,:) = v_msf_ind(:,:) * zsverdrup 486 v_msf_ipc(:,:) = v_msf_ipc(:,:) * zsverdrup 487 ENDIF 298 END DO 299 !!gm useless as overlap areas are not used in ptr_vjk 300 CALL lbc_lnk( vs, 'V', -1. ) ; CALL lbc_lnk( vt, 'V', -1. ) 301 !!gm 302 ! ! heat & salt advective transports (approximation) 303 htr(:,1) = SUM( ptr_vjk( vt(:,:,:) ) , 2 ) * rc_pwatt ! SUM over jk + conversion 304 str(:,1) = SUM( ptr_vjk( vs(:,:,:) ) , 2 ) * rc_ggram 305 DO jn = 2, nptr 306 htr(:,jn) = SUM( ptr_vjk( vt(:,:,:), btmsk(:,:,jn)*btm30(:,:) ) , 2 ) * rc_pwatt ! mask Southern Ocean 307 str(:,jn) = SUM( ptr_vjk( vs(:,:,:), btmsk(:,:,jn)*btm30(:,:) ) , 2 ) * rc_ggram ! mask Southern Ocean 308 END DO 309 310 IF( ln_ptrcomp ) THEN ! overturning transport 311 htr_ove(:) = SUM( v_msf(:,:,1) * tn_jk(:,:,1), 2 ) * rc_pwatt ! SUM over jk + conversion 312 str_ove(:) = SUM( v_msf(:,:,1) * sn_jk(:,:,1), 2 ) * rc_ggram 313 END IF 314 ! ! Advective and diffusive transport 315 htr_adv(:) = htr_adv(:) * rc_pwatt ! these are computed in tra_adv... and tra_ldf... routines 316 htr_ldf(:) = htr_ldf(:) * rc_pwatt ! here just the conversion in PW and Gg 317 str_adv(:) = str_adv(:) * rc_ggram 318 str_ldf(:) = str_ldf(:) * rc_ggram 319 320 #if defined key_diaeiv 321 DO jn = 1, nptr ! Bolus component 322 htr_eiv(:,jn) = SUM( v_msf_eiv(:,:,jn) * tn_jk(:,:,jn), 2 ) * rc_pwatt ! SUM over jk 323 str_eiv(:,jn) = SUM( v_msf_eiv(:,:,jn) * sn_jk(:,:,jn), 2 ) * rc_ggram ! SUM over jk 324 END DO 325 #endif 326 ! ! "Meridional" Stream-Function 327 DO jn = 1, nptr 328 DO jk = 2, jpk 329 v_msf (:,jk,jn) = v_msf (:,jk-1,jn) + v_msf (:,jk,jn) ! Eulerian j-Stream-Function 330 #if defined key_diaeiv 331 v_msf_eiv(:,jk,jn) = v_msf_eiv(:,jk-1,jn) + v_msf_eiv(:,jk,jn) ! Bolus j-Stream-Function 332 333 #endif 334 END DO 335 END DO 336 v_msf (:,:,:) = v_msf (:,:,:) * rc_sv ! converte in Sverdrups 337 #if defined key_diaeiv 338 v_msf_eiv(:,:,:) = v_msf_eiv(:,:,:) * rc_sv 339 #endif 488 340 ENDIF 489 341 ! … … 503 355 !! ** Purpose : Initialization, namelist read 504 356 !!---------------------------------------------------------------------- 505 INTEGER :: inum ! temporary logical unit 357 INTEGER :: jn ! dummy loop indices 358 INTEGER :: inum, ierr ! local integers 506 359 #if defined key_mpp_mpi 507 360 INTEGER, DIMENSION(1) :: iglo, iloc, iabsf, iabsl, ihals, ihale, idid 508 361 #endif 509 362 !! 510 NAMELIST/namptr/ ln_diaptr, ln_diaznl, ln_subbas, ln_ptrcomp, n f_ptr, nf_ptr_wri511 !!---------------------------------------------------------------------- 512 513 REWIND ( numnam )! Read Namelist namptr : poleward transport parameters514 READ 515 516 IF(lwp) THEN ! Control print363 NAMELIST/namptr/ ln_diaptr, ln_diaznl, ln_subbas, ln_ptrcomp, nn_fptr, nn_fwri 364 !!---------------------------------------------------------------------- 365 366 REWIND( numnam ) ! Read Namelist namptr : poleward transport parameters 367 READ ( numnam, namptr ) 368 369 IF(lwp) THEN ! Control print 517 370 WRITE(numout,*) 518 371 WRITE(numout,*) 'dia_ptr_init : poleward transport and msf initialization' 519 372 WRITE(numout,*) '~~~~~~~~~~~~' 520 373 WRITE(numout,*) ' Namelist namptr : set ptr parameters' 521 WRITE(numout,*) ' Switch for ptr diagnostic (T) or not (F) ln_diaptr = ', ln_diaptr 522 WRITE(numout,*) ' Atl/Pac/Ind basins computation ln_subbas = ', ln_subbas 523 WRITE(numout,*) ' Frequency of computation nf_ptr = ', nf_ptr 524 WRITE(numout,*) ' Frequency of outputs nf_ptr_wri = ', nf_ptr_wri 374 WRITE(numout,*) ' Poleward heat & salt transport (T) or not (F) ln_diaptr = ', ln_diaptr 375 WRITE(numout,*) ' Overturning heat & salt transport ln_ptrcomp = ', ln_ptrcomp 376 WRITE(numout,*) ' T & S zonal mean and meridional stream function ln_diaznl = ', ln_diaznl 377 WRITE(numout,*) ' Global (F) or glo/Atl/Pac/Ind/Indo-Pac basins ln_subbas = ', ln_subbas 378 WRITE(numout,*) ' Frequency of computation nn_fptr = ', nn_fptr 379 WRITE(numout,*) ' Frequency of outputs nn_fwri = ', nn_fwri 525 380 ENDIF 526 381 527 IF( .NOT. ln_diaptr ) RETURN 528 529 IF( lk_mpp ) CALL mpp_ini_znl ! Define MPI communicator for zonal sum 530 531 IF( ln_subbas ) THEN ! load sub-basin mask 532 CALL iom_open( 'subbasins', inum ) 533 CALL iom_get( inum, jpdom_data, 'atlmsk', abasin ) ! Atlantic basin 534 CALL iom_get( inum, jpdom_data, 'pacmsk', pbasin ) ! Pacific basin 535 CALL iom_get( inum, jpdom_data, 'indmsk', ibasin ) ! Indian basin 536 CALL iom_close( inum ) 537 dbasin(:,:) = MAX ( pbasin(:,:), ibasin(:,:) ) 538 sbasin(:,:) = tmask (:,:,1) 539 WHERE ( gphit (:,:) < -30.e0) sbasin(:,:) = 0.e0 382 IF( ln_subbas ) THEN ; nptr = 5 ! Global, Atlantic, Pacific, Indian, Indo-Pacific 383 ELSE ; nptr = 1 ! Global only 384 ENDIF 385 386 rc_pwatt = rc_pwatt * rau0 * rcp ! conversion from K.s-1 to PetaWatt 387 388 IF( .NOT. ln_diaptr ) THEN ! diaptr not used 389 RETURN 390 ELSE ! Allocate the diaptr arrays 391 ALLOCATE( btmsk(jpi,jpj,nptr) , & 392 & htr_adv(jpj) , str_adv(jpj) , htr_ldf(jpj) , str_ldf(jpj) , htr_ove(jpj) , str_ove(jpj), & 393 & htr(jpj,nptr) , str(jpj,nptr) , & 394 & tn_jk(jpj,jpk,nptr) , sn_jk (jpj,jpk,nptr) , v_msf(jpj,jpk,nptr) , & 395 & sjk (jpj,jpk,nptr) , r1_sjk(jpj,jpk,nptr) , STAT=ierr ) 396 ! 397 IF( ierr > 0 ) THEN 398 CALL ctl_stop( 'dia_ptr_init : unable to allocate standard arrays' ) ; RETURN 399 ENDIF 400 #if defined key_diaeiv 401 !! IF( lk_diaeiv ) & ! eddy induced velocity arrays 402 ALLOCATE( htr_eiv(jpj,nptr) , str_eiv(jpj,nptr) , v_msf_eiv(jpj,jpk,nptr) , STAT=ierr ) 403 ! 404 IF( ierr > 0 ) THEN 405 CALL ctl_stop( 'dia_ptr_init : unable to allocate eiv arrays' ) ; RETURN 406 ENDIF 407 #endif 540 408 ENDIF 541 409 542 !!gm CAUTION : this is only valid in fixed volume case ! 543 544 ! inverse of the ocean "zonal" v-point section 545 surf_jk_glo(:,:) = ptr_tjk( tmask(:,:,:) ) 546 surf_jk_r_glo(:,:) = 0.e0 547 WHERE( surf_jk_glo(:,:) /= 0.e0 ) surf_jk_r_glo(:,:) = 1.e0 / surf_jk_glo(:,:) 410 IF( lk_mpp ) CALL mpp_ini_znl ! Define MPI communicator for zonal sum 411 412 IF( ln_subbas ) THEN ! load sub-basin mask 413 CALL iom_open( 'subbasins', inum ) 414 CALL iom_get( inum, jpdom_data, 'atlmsk', btmsk(:,:,2) ) ! Atlantic basin 415 CALL iom_get( inum, jpdom_data, 'pacmsk', btmsk(:,:,3) ) ! Pacific basin 416 CALL iom_get( inum, jpdom_data, 'indmsk', btmsk(:,:,4) ) ! Indian basin 417 CALL iom_close( inum ) 418 btmsk(:,:,5) = MAX ( btmsk(:,:,3), btmsk(:,:,4) ) ! Indo-Pacific basin 419 WHERE( gphit(:,:) < -30._wp) ; btm30(:,:) = 0._wp ! mask out Southern Ocean 420 ELSE WHERE ; btm30(:,:) = tmask(:,:,1) 421 END WHERE 422 ENDIF 423 btmsk(:,:,1) = tmask_i(:,:) ! global ocean 548 424 549 IF (ln_subbas) THEN 550 surf_jk_atl(:,:) = ptr_tjk( tmask (:,:,:), abasin(:,:) ) 551 surf_jk_r_atl(:,:) = 0.e0 552 WHERE( surf_jk_atl(:,:) /= 0.e0 ) surf_jk_r_atl(:,:) = 1.e0 / surf_jk_atl(:,:) 553 ! 554 surf_jk_pac(:,:) = ptr_tjk( tmask (:,:,:), pbasin(:,:) ) 555 surf_jk_r_pac(:,:) = 0.e0 556 WHERE( surf_jk_pac(:,:) /= 0.e0 ) surf_jk_r_pac(:,:) = 1.e0 / surf_jk_pac(:,:) 557 ! 558 surf_jk_ind(:,:) = ptr_tjk( tmask (:,:,:), ibasin(:,:) ) 559 surf_jk_r_ind(:,:) = 0.e0 560 WHERE( surf_jk_ind(:,:) /= 0.e0 ) surf_jk_r_ind(:,:) = 1.e0 / surf_jk_ind(:,:) 561 ! 562 surf_jk_ipc(:,:) = ptr_tjk( tmask (:,:,:), dbasin(:,:) ) 563 surf_jk_r_ipc(:,:) = 0.e0 564 WHERE( surf_jk_ipc(:,:) /= 0.e0 ) surf_jk_r_ipc(:,:) = 1.e0 / surf_jk_ipc(:,:) 565 END IF 566 425 DO jn = 1, nptr 426 btmsk(:,:,jn) = btmsk(:,:,jn) * tmask_i(:,:) ! interior domain only 427 END DO 567 428 568 !!---------------------------------------------------------------------- 429 IF( lk_vvl ) CALL ctl_stop( 'diaptr: error in vvl case as constant i-mean surface is used' ) 430 431 ! ! i-sum of e1v*e3v surface and its inverse 432 DO jn = 1, nptr 433 sjk(:,:,jn) = ptr_tjk( tmask(:,:,:), btmsk(:,:,jn) ) 434 r1_sjk(:,:,jn) = 0._wp 435 WHERE( sjk(:,:,jn) /= 0._wp ) r1_sjk(:,:,jn) = 1._wp / sjk(:,:,jn) 436 END DO 569 437 570 438 #if defined key_mpp_mpi 571 iglo (1) = jpjglo 439 iglo (1) = jpjglo ! MPP case using MPI ('key_mpp_mpi') 572 440 iloc (1) = nlcj 573 441 iabsf(1) = njmppt(narea) … … 576 444 ihale(1) = nlcj - nlej 577 445 idid (1) = 2 578 579 !-$$ IF(lwp) THEN 580 !-$$ WRITE(numout,*) 581 !-$$ WRITE(numout,*) 'dia_ptr_init : iloc = ', iloc 582 !-$$ WRITE(numout,*) '~~~~~~~~~~~~ iabsf = ', iabsf 583 !-$$ WRITE(numout,*) ' ihals = ', ihals 584 !-$$ WRITE(numout,*) ' ihale = ', ihale 585 !-$$ ENDIF 586 587 CALL flio_dom_set ( jpnj, nproc/jpni, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom_ptr) 446 CALL flio_dom_set( jpnj, nproc/jpni, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom_ptr ) 588 447 #else 589 448 nidom_ptr = FLIO_DOM_NONE … … 610 469 INTEGER, SAVE, DIMENSION (jpj*jpk) :: ndex_atl_30 , ndex_pac_30 , ndex_ind_30 , ndex_ipc_30 611 470 INTEGER, SAVE, DIMENSION (jpj) :: ndex_h, ndex_h_atl_30, ndex_h_pac_30, ndex_h_ind_30, ndex_h_ipc_30 612 471 !! 613 472 CHARACTER (len=40) :: clhstnam, clop, clop_once, cl_comment ! temporary names 614 473 INTEGER :: iline, it, itmod, ji, jj, jk ! … … 622 481 623 482 ! define time axis 624 it = kt / n f_ptr483 it = kt / nn_fptr 625 484 itmod = kt - nit000 + 1 626 485 627 !-$$ IF(lwp) THEN628 !-$$ WRITE(numout,*)629 !-$$ WRITE(numout,*) 'dia_ptr_wri : kt = ', kt, 'it = ', it, ' itmod = ', itmod, ' niter = ', niter630 !-$$ WRITE(numout,*) '~~~~~~~~~~~~'631 !-$$ ENDIF632 633 486 ! Initialization 634 487 ! -------------- 635 488 IF( kt == nit000 ) THEN 636 637 niter = (nit000 - 1) / nf_ptr 638 639 !-$$ IF(lwp) THEN 640 !-$$ WRITE(numout,*) 641 !-$$ WRITE(numout,*) 'dia_ptr_wri : poleward transport and msf writing: initialization , niter = ', niter 642 !-$$ WRITE(numout,*) '~~~~~~~~~~~~' 643 !-$$ ENDIF 644 489 niter = ( nit000 - 1 ) / nn_fptr 645 490 zdt = rdt 646 491 IF( nacc == 1 ) zdt = rdtmin 647 648 ! Reference latitude 492 ! 493 IF(lwp) THEN 494 WRITE(numout,*) 495 WRITE(numout,*) 'dia_ptr_wri : poleward transport and msf writing: initialization , niter = ', niter 496 WRITE(numout,*) '~~~~~~~~~~~~' 497 ENDIF 498 499 ! Reference latitude (used in plots) 649 500 ! ------------------ 650 501 ! ! ======================= 651 502 IF( cp_cfg == "orca" ) THEN ! ORCA configurations 652 503 ! ! ======================= 653 654 504 IF( jp_cfg == 05 ) iline = 192 ! i-line that passes near the North Pole 655 505 IF( jp_cfg == 025 ) iline = 384 ! i-line that passes near the North Pole … … 657 507 IF( jp_cfg == 2 ) iline = 48 ! i-line that passes near the North Pole 658 508 IF( jp_cfg == 4 ) iline = 24 ! i-line that passes near the North Pole 659 zphi(:) = 0. e0509 zphi(:) = 0._wp 660 510 DO ji = mi0(iline), mi1(iline) 661 511 zphi(:) = gphiv(ji,:) ! if iline is in the local domain … … 663 513 IF( jp_cfg == 05 ) THEN 664 514 DO jj = mj0(jpjdta), mj1(jpjdta) 665 zphi( jj ) = zphi(mj0(jpjdta-1)) + ( zphi(mj0(jpjdta-1))-zphi(mj0(jpjdta-2)))/2.666 zphi( jj ) = MIN( zphi(jj), 90. )515 zphi( jj ) = zphi(mj0(jpjdta-1)) + ( zphi(mj0(jpjdta-1))-zphi(mj0(jpjdta-2)) ) * 0.5_wp 516 zphi( jj ) = MIN( zphi(jj), 90._wp ) 667 517 END DO 668 518 END IF 669 519 IF( jp_cfg == 1 .OR. jp_cfg == 2 .OR. jp_cfg == 4 ) THEN 670 520 DO jj = mj0(jpjdta-1), mj1(jpjdta-1) 671 zphi( jj ) = 88.5 e0521 zphi( jj ) = 88.5_wp 672 522 END DO 673 523 DO jj = mj0(jpjdta ), mj1(jpjdta ) 674 zphi( jj ) = 89.5 e0524 zphi( jj ) = 89.5_wp 675 525 END DO 676 526 END IF … … 680 530 CALL mpp_sum( zphi, jpj, ncomm_znl ) 681 531 #endif 682 683 532 ! ! ======================= 684 533 ELSE ! OTHER configurations … … 690 539 ! Work only on westmost processor (will not work if mppini2 is used) 691 540 #if defined key_mpp_mpi 692 IF 541 IF( l_znl_root ) THEN 693 542 #endif 694 543 ! … … 696 545 ! ---------------- 697 546 ! Define frequency of output and means 698 zsto = n f_ptr * zdt547 zsto = nn_fptr * zdt 699 548 IF( ln_mskland ) THEN ! put 1.e+20 on land (very expensive!!) 700 549 clop = "ave(only(x))" … … 705 554 ENDIF 706 555 707 zout = n f_ptr_wri * zdt708 zfoo(:) = 0. e0556 zout = nn_fwri * zdt 557 zfoo(:) = 0._wp 709 558 710 559 ! Compute julian date from starting date of the run … … 716 565 ! Requested by IPSL people, use by their postpro... 717 566 IF(lwp) THEN 718 CALL dia_nam( clhstnam, n f_ptr_wri,' ' )567 CALL dia_nam( clhstnam, nn_fwri,' ' ) 719 568 CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 720 569 WRITE(inum,*) clhstnam … … 723 572 #endif 724 573 725 CALL dia_nam( clhstnam, n f_ptr_wri, 'diaptr' )574 CALL dia_nam( clhstnam, nn_fwri, 'diaptr' ) 726 575 IF(lwp)WRITE( numout,*)" Name of diaptr NETCDF file : ", clhstnam 727 576 728 577 ! Horizontal grid : zphi() 729 578 CALL histbeg(clhstnam, 1, zfoo, jpj, zphi, & 730 1, 1, 1, jpj, niter, zjulian, zdt*n f_ptr, nhoridz, numptr, domain_id=nidom_ptr, snc4chunks=snc4set)579 1, 1, 1, jpj, niter, zjulian, zdt*nn_fptr, nhoridz, numptr, domain_id=nidom_ptr) 731 580 ! Vertical grids : gdept_0, gdepw_0 732 581 CALL histvert( numptr, "deptht", "Vertical T levels", & 733 "m", jpk, gdept_0, ndepidzt, "down" )582 & "m", jpk, gdept_0, ndepidzt, "down" ) 734 583 CALL histvert( numptr, "depthw", "Vertical W levels", & 735 "m", jpk, gdepw_0, ndepidzw, "down" )584 & "m", jpk, gdepw_0, ndepidzw, "down" ) 736 585 737 586 ! 738 CALL wheneq ( jpj*jpk, MIN(s urf_jk_glo(:,:), 1.e0), 1, 1., ndex , ndim ) ! Lat-Depth739 CALL wheneq ( jpj , MIN(s urf_jk_glo(:,1), 1.e0), 1, 1., ndex_h, ndim_h ) ! Lat740 741 IF (ln_subbas) THEN742 z_1 (:,1) = 1.0e0743 WHERE ( gphit (jpi/2,:) .LT. -30 ) z_1 (:,1) = 0.e0587 CALL wheneq ( jpj*jpk, MIN(sjk(:,:,1), 1._wp), 1, 1., ndex , ndim ) ! Lat-Depth 588 CALL wheneq ( jpj , MIN(sjk(:,1,1), 1._wp), 1, 1., ndex_h, ndim_h ) ! Lat 589 590 IF( ln_subbas ) THEN 591 z_1(:,1) = 1._wp 592 WHERE ( gphit(jpi/2,:) < -30._wp ) z_1(:,1) = 0._wp 744 593 DO jk = 2, jpk 745 z_1 (:,jk) = z_1(:,1)594 z_1(:,jk) = z_1(:,1) 746 595 END DO 747 748 CALL wheneq ( jpj*jpk, MIN(surf_jk_atl(:,:) , 1.e0), 1, 1., ndex_atl , ndim_atl ) ! Lat-Depth 749 CALL wheneq ( jpj*jpk, MIN(surf_jk_atl(:,:)*z_1(:,:), 1.e0), 1, 1., ndex_atl_30 , ndim_atl_30 ) ! Lat-Depth 750 CALL wheneq ( jpj , MIN(surf_jk_atl(:,1)*z_1(:,1), 1.e0), 1, 1., ndex_h_atl_30, ndim_h_atl_30 ) ! Lat 751 752 CALL wheneq ( jpj*jpk, MIN(surf_jk_pac(:,:) , 1.e0), 1, 1., ndex_pac , ndim_pac ) ! Lat-Depth 753 CALL wheneq ( jpj*jpk, MIN(surf_jk_pac(:,:)*z_1(:,:), 1.e0), 1, 1., ndex_pac_30 , ndim_pac_30 ) ! Lat-Depth 754 CALL wheneq ( jpj , MIN(surf_jk_pac(:,1)*z_1(:,1), 1.e0), 1, 1., ndex_h_pac_30, ndim_h_pac_30 ) ! Lat 755 756 CALL wheneq ( jpj*jpk, MIN(surf_jk_ind(:,:) , 1.e0), 1, 1., ndex_ind , ndim_ind ) ! Lat-Depth 757 CALL wheneq ( jpj*jpk, MIN(surf_jk_ind(:,:)*z_1(:,:), 1.e0), 1, 1., ndex_ind_30 , ndim_ind_30 ) ! Lat-Depth 758 CALL wheneq ( jpj , MIN(surf_jk_ind(:,1)*z_1(:,1), 1.e0), 1, 1., ndex_h_ind_30, ndim_h_ind_30 ) ! Lat 759 760 CALL wheneq ( jpj*jpk, MIN(surf_jk_ipc(:,:) , 1.e0), 1, 1., ndex_ipc , ndim_ipc ) ! Lat-Depth 761 CALL wheneq ( jpj*jpk, MIN(surf_jk_ipc(:,:)*z_1(:,:), 1.e0), 1, 1., ndex_ipc_30 , ndim_ipc_30 ) ! Lat-Depth 762 CALL wheneq ( jpj , MIN(surf_jk_ipc(:,1)*z_1(:,1), 1.e0), 1, 1., ndex_h_ipc_30, ndim_h_ipc_30 ) ! Lat 763 596 ! ! Atlantic (jn=2) 597 CALL wheneq ( jpj*jpk, MIN(sjk(:,:,2) , 1._wp), 1, 1., ndex_atl , ndim_atl ) ! Lat-Depth 598 CALL wheneq ( jpj*jpk, MIN(sjk(:,:,2)*z_1(:,:), 1._wp), 1, 1., ndex_atl_30 , ndim_atl_30 ) ! Lat-Depth 599 CALL wheneq ( jpj , MIN(sjk(:,1,2)*z_1(:,1), 1._wp), 1, 1., ndex_h_atl_30, ndim_h_atl_30 ) ! Lat 600 ! ! Pacific (jn=3) 601 CALL wheneq ( jpj*jpk, MIN(sjk(:,:,3) , 1._wp), 1, 1., ndex_pac , ndim_pac ) ! Lat-Depth 602 CALL wheneq ( jpj*jpk, MIN(sjk(:,:,3)*z_1(:,:), 1._wp), 1, 1., ndex_pac_30 , ndim_pac_30 ) ! Lat-Depth 603 CALL wheneq ( jpj , MIN(sjk(:,1,3)*z_1(:,1), 1._wp), 1, 1., ndex_h_pac_30, ndim_h_pac_30 ) ! Lat 604 ! ! Indian (jn=4) 605 CALL wheneq ( jpj*jpk, MIN(sjk(:,:,4) , 1._wp), 1, 1., ndex_ind , ndim_ind ) ! Lat-Depth 606 CALL wheneq ( jpj*jpk, MIN(sjk(:,:,4)*z_1(:,:), 1._wp), 1, 1., ndex_ind_30 , ndim_ind_30 ) ! Lat-Depth 607 CALL wheneq ( jpj , MIN(sjk(:,1,4)*z_1(:,1), 1._wp), 1, 1., ndex_h_ind_30, ndim_h_ind_30 ) ! Lat 608 ! ! Indo-Pacific (jn=5) 609 CALL wheneq ( jpj*jpk, MIN(sjk(:,:,5) , 1._wp), 1, 1., ndex_ipc , ndim_ipc ) ! Lat-Depth 610 CALL wheneq ( jpj*jpk, MIN(sjk(:,:,5)*z_1(:,:), 1._wp), 1, 1., ndex_ipc_30 , ndim_ipc_30 ) ! Lat-Depth 611 CALL wheneq ( jpj , MIN(sjk(:,1,5)*z_1(:,1), 1._wp), 1, 1., ndex_h_ipc_30, ndim_h_ipc_30 ) ! Lat 764 612 ENDIF 765 766 613 ! 767 614 #if defined key_diaeiv … … 772 619 ! Zonal mean T and S 773 620 774 IF 621 IF( ln_diaznl ) THEN 775 622 CALL histdef( numptr, "zotemglo", "Zonal Mean Temperature","C" , & 776 623 1, jpj, nhoridz, jpk, 1, jpk, ndepidzt, 32, clop, zsto, zout ) … … 880 727 ENDIF 881 728 882 CALL histend( numptr , snc4set)729 CALL histend( numptr ) 883 730 884 731 END IF … … 888 735 889 736 #if defined key_mpp_mpi 890 IF( MOD( itmod, n f_ptr ) == 0 .AND. l_znl_root ) THEN737 IF( MOD( itmod, nn_fptr ) == 0 .AND. l_znl_root ) THEN 891 738 #else 892 IF( MOD( itmod, n f_ptr ) == 0 ) THEN739 IF( MOD( itmod, nn_fptr ) == 0 ) THEN 893 740 #endif 894 741 niter = niter + 1 895 742 896 !-$$ IF(lwp) THEN 897 !-$$ WRITE(numout,*) 898 !-$$ WRITE(numout,*) 'dia_ptr_wri : write Poleward Transports at time-step : kt = ', kt, & 899 !-$$ & 'it = ', it, ' itmod = ', itmod, ' niter = ', niter 900 !-$$ WRITE(numout,*) '~~~~~~~~~~' 901 !-$$ WRITE(numout,*) 902 !-$$ ENDIF 903 904 IF (ln_diaznl ) THEN 905 CALL histwrite( numptr, "zosrfglo", niter, surf_jk_glo , ndim, ndex ) 906 CALL histwrite( numptr, "zotemglo", niter, tn_jk_glo , ndim, ndex ) 907 CALL histwrite( numptr, "zosalglo", niter, sn_jk_glo , ndim, ndex ) 743 IF( ln_diaznl ) THEN 744 CALL histwrite( numptr, "zosrfglo", niter, sjk (:,:,1) , ndim, ndex ) 745 CALL histwrite( numptr, "zotemglo", niter, tn_jk(:,:,1) , ndim, ndex ) 746 CALL histwrite( numptr, "zosalglo", niter, sn_jk(:,:,1) , ndim, ndex ) 908 747 909 748 IF (ln_subbas) THEN 910 CALL histwrite( numptr, "zosrfatl", niter, s urf_jk_atl, ndim_atl, ndex_atl )911 CALL histwrite( numptr, "zosrfpac", niter, s urf_jk_pac, ndim_pac, ndex_pac )912 CALL histwrite( numptr, "zosrfind", niter, s urf_jk_ind, ndim_ind, ndex_ind )913 CALL histwrite( numptr, "zosrfipc", niter, s urf_jk_ipc, ndim_ipc, ndex_ipc )914 915 CALL histwrite( numptr, "zotematl", niter, tn_jk _atl, ndim_atl, ndex_atl )916 CALL histwrite( numptr, "zosalatl", niter, sn_jk _atl, ndim_atl, ndex_atl )917 CALL histwrite( numptr, "zotempac", niter, tn_jk _pac, ndim_pac, ndex_pac )918 CALL histwrite( numptr, "zosalpac", niter, sn_jk _pac, ndim_pac, ndex_pac )919 CALL histwrite( numptr, "zotemind", niter, tn_jk _ind, ndim_ind, ndex_ind )920 CALL histwrite( numptr, "zosalind", niter, sn_jk _ind, ndim_ind, ndex_ind )921 CALL histwrite( numptr, "zotemipc", niter, tn_jk _ipc, ndim_ipc, ndex_ipc )922 CALL histwrite( numptr, "zosalipc", niter, sn_jk _ipc, ndim_ipc, ndex_ipc )749 CALL histwrite( numptr, "zosrfatl", niter, sjk(:,:,2), ndim_atl, ndex_atl ) 750 CALL histwrite( numptr, "zosrfpac", niter, sjk(:,:,3), ndim_pac, ndex_pac ) 751 CALL histwrite( numptr, "zosrfind", niter, sjk(:,:,4), ndim_ind, ndex_ind ) 752 CALL histwrite( numptr, "zosrfipc", niter, sjk(:,:,5), ndim_ipc, ndex_ipc ) 753 754 CALL histwrite( numptr, "zotematl", niter, tn_jk(:,:,2) , ndim_atl, ndex_atl ) 755 CALL histwrite( numptr, "zosalatl", niter, sn_jk(:,:,2) , ndim_atl, ndex_atl ) 756 CALL histwrite( numptr, "zotempac", niter, tn_jk(:,:,3) , ndim_pac, ndex_pac ) 757 CALL histwrite( numptr, "zosalpac", niter, sn_jk(:,:,3) , ndim_pac, ndex_pac ) 758 CALL histwrite( numptr, "zotemind", niter, tn_jk(:,:,4) , ndim_ind, ndex_ind ) 759 CALL histwrite( numptr, "zosalind", niter, sn_jk(:,:,4) , ndim_ind, ndex_ind ) 760 CALL histwrite( numptr, "zotemipc", niter, tn_jk(:,:,5) , ndim_ipc, ndex_ipc ) 761 CALL histwrite( numptr, "zosalipc", niter, sn_jk(:,:,5) , ndim_ipc, ndex_ipc ) 923 762 END IF 924 763 ENDIF 925 764 926 765 ! overturning outputs: 927 CALL histwrite( numptr, "zomsfglo", niter, v_msf _glo, ndim, ndex )766 CALL histwrite( numptr, "zomsfglo", niter, v_msf(:,:,1), ndim, ndex ) 928 767 IF( ln_subbas .AND. ln_diaznl ) THEN 929 CALL histwrite( numptr, "zomsfatl", niter, v_msf _atl, ndim_atl_30, ndex_atl_30 )930 CALL histwrite( numptr, "zomsfpac", niter, v_msf _pac, ndim_pac_30, ndex_pac_30 )931 CALL histwrite( numptr, "zomsfind", niter, v_msf _ind, ndim_ind_30, ndex_ind_30 )932 CALL histwrite( numptr, "zomsfipc", niter, v_msf _ipc, ndim_ipc_30, ndex_ipc_30 )768 CALL histwrite( numptr, "zomsfatl", niter, v_msf(:,:,2) , ndim_atl_30, ndex_atl_30 ) 769 CALL histwrite( numptr, "zomsfpac", niter, v_msf(:,:,3) , ndim_pac_30, ndex_pac_30 ) 770 CALL histwrite( numptr, "zomsfind", niter, v_msf(:,:,4) , ndim_ind_30, ndex_ind_30 ) 771 CALL histwrite( numptr, "zomsfipc", niter, v_msf(:,:,5) , ndim_ipc_30, ndex_ipc_30 ) 933 772 ENDIF 934 773 #if defined key_diaeiv 935 CALL histwrite( numptr, "zomsfeiv", niter, v_msf_eiv_glo, ndim , ndex ) 936 #endif 937 774 CALL histwrite( numptr, "zomsfeiv", niter, v_msf_eiv(:,:,1), ndim , ndex ) 775 #endif 938 776 939 777 ! heat transport outputs: 940 778 IF( ln_subbas ) THEN 941 CALL histwrite( numptr, "sohtatl", niter, ht _atl, ndim_h_atl_30, ndex_h_atl_30 )942 CALL histwrite( numptr, "sohtpac", niter, ht _pac, ndim_h_pac_30, ndex_h_pac_30 )943 CALL histwrite( numptr, "sohtind", niter, ht _ind, ndim_h_ind_30, ndex_h_ind_30 )944 CALL histwrite( numptr, "sohtipc", niter, ht _ipc, ndim_h_ipc_30, ndex_h_ipc_30 )945 CALL histwrite( numptr, "sostatl", niter, st _atl, ndim_h_atl_30, ndex_h_atl_30 )946 CALL histwrite( numptr, "sostpac", niter, st _pac, ndim_h_pac_30, ndex_h_pac_30 )947 CALL histwrite( numptr, "sostind", niter, st _ind, ndim_h_ind_30, ndex_h_ind_30 )948 CALL histwrite( numptr, "sostipc", niter, st _ipc, ndim_h_ipc_30, ndex_h_ipc_30 )779 CALL histwrite( numptr, "sohtatl", niter, htr(:,2) , ndim_h_atl_30, ndex_h_atl_30 ) 780 CALL histwrite( numptr, "sohtpac", niter, htr(:,3) , ndim_h_pac_30, ndex_h_pac_30 ) 781 CALL histwrite( numptr, "sohtind", niter, htr(:,4) , ndim_h_ind_30, ndex_h_ind_30 ) 782 CALL histwrite( numptr, "sohtipc", niter, htr(:,5) , ndim_h_ipc_30, ndex_h_ipc_30 ) 783 CALL histwrite( numptr, "sostatl", niter, str(:,2) , ndim_h_atl_30, ndex_h_atl_30 ) 784 CALL histwrite( numptr, "sostpac", niter, str(:,3) , ndim_h_pac_30, ndex_h_pac_30 ) 785 CALL histwrite( numptr, "sostind", niter, str(:,4) , ndim_h_ind_30, ndex_h_ind_30 ) 786 CALL histwrite( numptr, "sostipc", niter, str(:,5) , ndim_h_ipc_30, ndex_h_ipc_30 ) 949 787 ENDIF 950 788 951 CALL histwrite( numptr, "sophtadv", niter, pht_adv , ndim_h, ndex_h )952 CALL histwrite( numptr, "sophtldf", niter, pht_ldf , ndim_h, ndex_h )953 CALL histwrite( numptr, "sopstadv", niter, pst_adv , ndim_h, ndex_h )954 CALL histwrite( numptr, "sopstldf", niter, pst_ldf , ndim_h, ndex_h )955 IF 956 CALL histwrite( numptr, "sopstove", niter, pst_ove_glo, ndim_h, ndex_h )957 CALL histwrite( numptr, "sophtove", niter, pht_ove_glo, ndim_h, ndex_h )789 CALL histwrite( numptr, "sophtadv", niter, htr_adv , ndim_h, ndex_h ) 790 CALL histwrite( numptr, "sophtldf", niter, htr_ldf , ndim_h, ndex_h ) 791 CALL histwrite( numptr, "sopstadv", niter, str_adv , ndim_h, ndex_h ) 792 CALL histwrite( numptr, "sopstldf", niter, str_ldf , ndim_h, ndex_h ) 793 IF( ln_ptrcomp ) THEN 794 CALL histwrite( numptr, "sopstove", niter, str_ove(:) , ndim_h, ndex_h ) 795 CALL histwrite( numptr, "sophtove", niter, htr_ove(:) , ndim_h, ndex_h ) 958 796 ENDIF 959 797 #if defined key_diaeiv 960 CALL histwrite( numptr, "sophteiv", niter, pht_eiv_glo, ndim_h, ndex_h )961 CALL histwrite( numptr, "sopsteiv", niter, pst_eiv_glo, ndim_h, ndex_h )798 CALL histwrite( numptr, "sophteiv", niter, htr_eiv(:,1) , ndim_h, ndex_h ) 799 CALL histwrite( numptr, "sopsteiv", niter, str_eiv(:,1) , ndim_h, ndex_h ) 962 800 #endif 963 801 ! -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90
r2287 r2399 48 48 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 49 49 !! $Id$ 50 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 51 !!---------------------------------------------------------------------- 52 50 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 51 !!---------------------------------------------------------------------- 53 52 CONTAINS 54 53 55 SUBROUTINE tra_adv_cen2( kt, cdtype, pun, pvn, pwn, &54 SUBROUTINE tra_adv_cen2( kt, cdtype, pun, pvn, pwn, & 56 55 & ptb, ptn, pta, kjpt ) 57 56 !!---------------------------------------------------------------------- … … 257 256 END IF 258 257 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 259 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, n f_ptr ) == 0 ) ) THEN260 IF( jn == jp_tem ) pht_adv(:) = ptr_vj( zwy(:,:,:) )261 IF( jn == jp_sal ) pst_adv(:) = ptr_vj( zwy(:,:,:) )258 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 259 IF( jn == jp_tem ) htr_adv(:) = ptr_vj( zwy(:,:,:) ) 260 IF( jn == jp_sal ) str_adv(:) = ptr_vj( zwy(:,:,:) ) 262 261 ENDIF 263 262 ! -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90
r2333 r2399 40 40 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 41 41 !! $Id$ 42 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 43 !!---------------------------------------------------------------------- 44 42 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 43 !!---------------------------------------------------------------------- 45 44 CONTAINS 46 45 47 46 SUBROUTINE tra_adv_muscl( kt, cdtype, p2dt, pun, pvn, pwn, & 48 & ptb, pta, kjpt 47 & ptb, pta, kjpt ) 49 48 !!---------------------------------------------------------------------- 50 49 !! *** ROUTINE tra_adv_muscl *** … … 179 178 END IF 180 179 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 181 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, n f_ptr ) == 0 ) ) THEN182 IF( jn == jp_tem ) pht_adv(:) = ptr_vj( zwy(:,:,:) )183 IF( jn == jp_sal ) pst_adv(:) = ptr_vj( zwy(:,:,:) )180 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 181 IF( jn == jp_tem ) htr_adv(:) = ptr_vj( zwy(:,:,:) ) 182 IF( jn == jp_sal ) str_adv(:) = ptr_vj( zwy(:,:,:) ) 184 183 ENDIF 185 184 -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90
r2333 r2399 38 38 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 39 39 !! $Id$ 40 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 41 !!---------------------------------------------------------------------- 42 40 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 41 !!---------------------------------------------------------------------- 43 42 CONTAINS 44 43 45 SUBROUTINE tra_adv_muscl2( kt, cdtype, p2dt, pun, pvn, pwn, &46 & ptb, ptn, pta, kjpt 44 SUBROUTINE tra_adv_muscl2( kt, cdtype, p2dt, pun, pvn, pwn, & 45 & ptb, ptn, pta, kjpt ) 47 46 !!---------------------------------------------------------------------- 48 47 !! *** ROUTINE tra_adv_muscl2 *** … … 201 200 202 201 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 203 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, n f_ptr ) == 0 ) ) THEN204 IF( jn == jp_tem ) pht_adv(:) = ptr_vj( zwy(:,:,:) )205 IF( jn == jp_sal ) pst_adv(:) = ptr_vj( zwy(:,:,:) )202 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 203 IF( jn == jp_tem ) htr_adv(:) = ptr_vj( zwy(:,:,:) ) 204 IF( jn == jp_sal ) str_adv(:) = ptr_vj( zwy(:,:,:) ) 206 205 ENDIF 207 206 -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90
r2287 r2399 41 41 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 42 42 !! $Id$ 43 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)43 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 44 44 !!---------------------------------------------------------------------- 45 46 45 CONTAINS 47 46 48 SUBROUTINE tra_adv_qck ( kt, cdtype, p2dt, pun, pvn, pwn, &49 & ptb, ptn, pta, kjpt 47 SUBROUTINE tra_adv_qck ( kt, cdtype, p2dt, pun, pvn, pwn, & 48 & ptb, ptn, pta, kjpt ) 50 49 !!---------------------------------------------------------------------- 51 50 !! *** ROUTINE tra_adv_qck *** … … 82 81 !! ** Reference : Leonard (1979, 1991) 83 82 !!---------------------------------------------------------------------- 84 !!85 83 INTEGER , INTENT(in ) :: kt ! ocean time-step index 86 84 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) … … 112 110 113 111 114 SUBROUTINE tra_adv_qck_i( kt, cdtype, p2dt, pun, &112 SUBROUTINE tra_adv_qck_i( kt, cdtype, p2dt, pun, & 115 113 & ptb, ptn, pta, kjpt ) 116 114 !!---------------------------------------------------------------------- … … 152 150 END DO 153 151 CALL lbc_lnk( zfc(:,:,:), 'T', 1. ) ; CALL lbc_lnk( zfd(:,:,:), 'T', 1. ) ! Lateral boundary conditions 154 155 152 156 153 ! … … 231 228 232 229 233 SUBROUTINE tra_adv_qck_j( kt, cdtype, p2dt, pvn, & 234 & ptb, ptn, pta, kjpt ) 235 !!---------------------------------------------------------------------- 236 !! 237 !!---------------------------------------------------------------------- 238 !! 230 SUBROUTINE tra_adv_qck_j( kt, cdtype, p2dt, pvn, & 231 & ptb, ptn, pta, kjpt ) 232 !!---------------------------------------------------------------------- 233 !! 234 !!---------------------------------------------------------------------- 239 235 USE oce , zwy => ua ! use ua as workspace 240 236 !! … … 312 308 DO ji = fs_2, fs_jpim1 ! vector opt. 313 309 zfu(ji,jj,jk) = tmask(ji,jj-1,jk) + tmask(ji,jj,jk) + tmask(ji,jj+1,jk) - 2. 314 END DO310 END DO 315 311 END DO 316 312 END DO … … 347 343 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jptra_trd_yad, zwy, pvn, ptn(:,:,:,jn) ) 348 344 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 349 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, n f_ptr ) == 0 ) ) THEN350 IF( jn == jp_tem ) pht_adv(:) = ptr_vj( zwy(:,:,:) )351 IF( jn == jp_sal ) pst_adv(:) = ptr_vj( zwy(:,:,:) )345 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 346 IF( jn == jp_tem ) htr_adv(:) = ptr_vj( zwy(:,:,:) ) 347 IF( jn == jp_sal ) str_adv(:) = ptr_vj( zwy(:,:,:) ) 352 348 ENDIF 353 349 ! … … 357 353 358 354 359 SUBROUTINE tra_adv_cen2_k( kt, cdtype, pwn, &355 SUBROUTINE tra_adv_cen2_k( kt, cdtype, pwn, & 360 356 & ptn, pta, kjpt ) 361 357 !!---------------------------------------------------------------------- -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90
r2333 r2399 47 47 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 48 48 !! $Id$ 49 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 50 !!---------------------------------------------------------------------- 51 49 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 50 !!---------------------------------------------------------------------- 52 51 CONTAINS 53 52 54 SUBROUTINE tra_adv_tvd ( kt, cdtype, p2dt, pun, pvn, pwn, &55 & ptb, ptn, pta, kjpt 53 SUBROUTINE tra_adv_tvd ( kt, cdtype, p2dt, pun, pvn, pwn, & 54 & ptb, ptn, pta, kjpt ) 56 55 !!---------------------------------------------------------------------- 57 56 !! *** ROUTINE tra_adv_tvd *** … … 169 168 END IF 170 169 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 171 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, n f_ptr ) == 0 ) ) THEN172 IF( jn == jp_tem ) pht_adv(:) = ptr_vj( zwy(:,:,:) )173 IF( jn == jp_sal ) pst_adv(:) = ptr_vj( zwy(:,:,:) )170 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 171 IF( jn == jp_tem ) htr_adv(:) = ptr_vj( zwy(:,:,:) ) 172 IF( jn == jp_sal ) str_adv(:) = ptr_vj( zwy(:,:,:) ) 174 173 ENDIF 175 174 … … 231 230 END IF 232 231 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 233 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, n f_ptr ) == 0 ) ) THEN234 IF( jn == jp_tem ) pht_adv(:) = ptr_vj( zwy(:,:,:) ) + pht_adv(:)235 IF( jn == jp_sal ) pst_adv(:) = ptr_vj( zwy(:,:,:) ) + pst_adv(:)232 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 233 IF( jn == jp_tem ) htr_adv(:) = ptr_vj( zwy(:,:,:) ) + htr_adv(:) 234 IF( jn == jp_sal ) str_adv(:) = ptr_vj( zwy(:,:,:) ) + str_adv(:) 236 235 ENDIF 237 236 ! -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90
r2287 r2399 36 36 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 37 37 !! $Id$ 38 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 39 !!---------------------------------------------------------------------- 40 38 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 39 !!---------------------------------------------------------------------- 41 40 CONTAINS 42 41 43 SUBROUTINE tra_adv_ubs ( kt, cdtype, p2dt, pun, pvn, pwn, &44 & ptb, ptn, pta, kjpt 42 SUBROUTINE tra_adv_ubs ( kt, cdtype, p2dt, pun, pvn, pwn, & 43 & ptb, ptn, pta, kjpt ) 45 44 !!---------------------------------------------------------------------- 46 45 !! *** ROUTINE tra_adv_ubs *** … … 183 182 END IF 184 183 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 185 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, n f_ptr ) == 0 ) ) THEN186 IF( jn == jp_tem ) pht_adv(:) = ptr_vj( zwy(:,:,:) )187 IF( jn == jp_sal ) pst_adv(:) = ptr_vj( zwy(:,:,:) )184 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 185 IF( jn == jp_tem ) htr_adv(:) = ptr_vj( zwy(:,:,:) ) 186 IF( jn == jp_sal ) str_adv(:) = ptr_vj( zwy(:,:,:) ) 188 187 ENDIF 189 188 -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90
r2371 r2399 47 47 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 48 48 !! $Id$ 49 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 50 !!---------------------------------------------------------------------- 51 49 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 50 !!---------------------------------------------------------------------- 52 51 CONTAINS 53 52 … … 57 56 !! 58 57 !! ** Purpose : compute the lateral ocean tracer physics. 59 !!60 58 !!---------------------------------------------------------------------- 61 59 INTEGER, INTENT( in ) :: kt ! ocean time-step index … … 70 68 71 69 SELECT CASE ( nldf ) ! compute lateral mixing trend and add it to the general trend 72 CASE ( 0 ) ; CALL tra_ldf_lap ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts ) ! iso-level laplacian 73 CASE ( 1 ) 74 IF ( ln_traldf_grif ) THEN 75 76 CALL tra_ldf_iso_grif ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 ) ! Griffies quarter-cell formulation 77 ELSE 78 CALL tra_ldf_iso ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 ) ! rotated laplacian 79 ENDIF 80 CASE ( 2 ) ; CALL tra_ldf_bilap ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts ) ! iso-level bilaplacian 81 CASE ( 3 ) ; CALL tra_ldf_bilapg( kt, 'TRA', tsb, tsa, jpts ) ! s-coord. horizontal bilap. 70 CASE ( 0 ) ; CALL tra_ldf_lap ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts ) ! iso-level laplacian 71 CASE ( 1 ) ! rotated laplacian 72 IF( ln_traldf_grif ) THEN 73 CALL tra_ldf_iso_grif( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 ) ! Griffies operator 74 ELSE 75 CALL tra_ldf_iso ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 ) ! Madec operator 76 ENDIF 77 CASE ( 2 ) ; CALL tra_ldf_bilap ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts ) ! iso-level bilaplacian 78 CASE ( 3 ) ; CALL tra_ldf_bilapg ( kt, 'TRA', tsb, tsa, jpts ) ! s-coord. geopot. bilap. 82 79 ! 83 CASE ( -1 ) 80 CASE ( -1 ) ! esopa: test all possibility with control print 84 81 CALL tra_ldf_lap ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts ) 85 82 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf0 - Ta: ', mask1=tmask, & 86 83 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 87 IF 88 CALL tra_ldf_iso_grif ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0)84 IF( ln_traldf_grif ) THEN 85 CALL tra_ldf_iso_grif( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 ) 89 86 ELSE 90 CALL tra_ldf_iso ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 )87 CALL tra_ldf_iso ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 ) 91 88 ENDIF 92 89 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf1 - Ta: ', mask1=tmask, & -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90
r2287 r2399 42 42 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 43 43 !! $Id$ 44 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)44 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 45 45 !!---------------------------------------------------------------------- 46 47 46 CONTAINS 48 47 49 SUBROUTINE tra_ldf_bilap( kt, cdtype, pgu, pgv, &48 SUBROUTINE tra_ldf_bilap( kt, cdtype, pgu, pgv, & 50 49 & ptb, pta, kjpt ) 51 50 !!---------------------------------------------------------------------- … … 74 73 !! biharmonic mixing trend. 75 74 !!---------------------------------------------------------------------- 76 !!77 75 USE oce , ztu => ua ! use ua as workspace 78 76 USE oce , ztv => va ! use va as workspace … … 159 157 ! 160 158 ! "zonal" mean lateral diffusive heat and salt transport 161 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, n f_ptr ) == 0 ) ) THEN162 IF( jn == jp_tem ) pht_ldf(:) = ptr_vj( ztv(:,:,:) )163 IF( jn == jp_sal ) pst_ldf(:) = ptr_vj( ztv(:,:,:) )159 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 160 IF( jn == jp_tem ) htr_ldf(:) = ptr_vj( ztv(:,:,:) ) 161 IF( jn == jp_sal ) str_ldf(:) = ptr_vj( ztv(:,:,:) ) 164 162 ENDIF 165 163 ! ! =========== -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90
r2287 r2399 4 4 !! Ocean tracers: horizontal component of the lateral tracer mixing trend 5 5 !!============================================================================== 6 !! History : 8.0 ! 7 !! NEMO !2002-08 (G. Madec) F90: Free form and module8 !! 3.3 ! 6 !! History : 8.0 ! 1997-07 (G. Madec) Original code 7 !! NEMO 1.0 ! 2002-08 (G. Madec) F90: Free form and module 8 !! 3.3 ! 2010-06 (C. Ethe, G. Madec) Merge TRA-TRC 9 9 !!============================================================================== 10 10 #if defined key_ldfslp || defined key_esopa … … 37 37 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 38 38 !! $Id$ 39 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 40 !!---------------------------------------------------------------------- 41 39 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 40 !!---------------------------------------------------------------------- 42 41 CONTAINS 43 42 … … 66 65 !! biharmonic mixing trend. 67 66 !!---------------------------------------------------------------------- 68 INTEGER , INTENT(in ) :: kt! ocean time-step index69 CHARACTER(len=3), INTENT(in ) :: cdtype! =TRA or TRC (tracer indicator)70 INTEGER , INTENT(in ) :: kjpt! number of tracers71 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb 72 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta 67 INTEGER , INTENT(in ) :: kt ! ocean time-step index 68 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 69 INTEGER , INTENT(in ) :: kjpt ! number of tracers 70 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields 71 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 73 72 !! 74 73 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 81 80 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~' 82 81 ENDIF 83 !84 !85 82 86 83 ! 1. Laplacian of ptb * aht … … 100 97 ! 3. Update the tracer trends (j-slab : 2, jpj-1) 101 98 ! --------------------------- 102 !103 99 DO jn = 1, kjpt 104 ! ! =============== 105 DO jj = 2, jpjm1 ! Vertical slab 106 ! ! =============== 100 DO jj = 2, jpjm1 107 101 DO jk = 1, jpkm1 108 102 DO ji = 2, jpim1 … … 111 105 END DO 112 106 END DO 113 ! ! =============== 114 END DO ! End of slab 115 ! ! =============== 107 END DO 116 108 END DO 117 109 ! 118 110 END SUBROUTINE tra_ldf_bilapg 119 111 … … 238 230 ! ! =============== 239 231 ! "Poleward" diffusive heat or salt transport 240 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( kaht == 2 ) .AND. ( MOD( kt, n f_ptr ) == 0 ) ) THEN241 IF( jn == jp_tem) pht_ldf(:) = ptr_vj( zftv(:,:,:) )242 IF( jn == jp_sal) pst_ldf(:) = ptr_vj( zftv(:,:,:) )232 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( kaht == 2 ) .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 233 IF( jn == jp_tem) htr_ldf(:) = ptr_vj( zftv(:,:,:) ) 234 IF( jn == jp_sal) str_ldf(:) = ptr_vj( zftv(:,:,:) ) 243 235 ENDIF 244 236 -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
r2287 r2399 45 45 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 46 46 !! $Id$ 47 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 48 !!---------------------------------------------------------------------- 49 47 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 48 !!---------------------------------------------------------------------- 50 49 CONTAINS 51 50 52 SUBROUTINE tra_ldf_iso( kt, cdtype, pgu, pgv, &51 SUBROUTINE tra_ldf_iso( kt, cdtype, pgu, pgv, & 53 52 & ptb, pta, kjpt, pahtb0 ) 54 53 !!---------------------------------------------------------------------- … … 209 208 ! 210 209 ! "Poleward" diffusive heat or salt transports (T-S case only) 211 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, n f_ptr ) == 0 ) ) THEN212 IF( jn == jp_tem) pht_ldf(:) = ptr_vj( zftv(:,:,:) )213 IF( jn == jp_sal) pst_ldf(:) = ptr_vj( zftv(:,:,:) )210 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 211 IF( jn == jp_tem) htr_ldf(:) = ptr_vj( zftv(:,:,:) ) 212 IF( jn == jp_sal) str_ldf(:) = ptr_vj( zftv(:,:,:) ) 214 213 ENDIF 215 214 -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso_grif.F90
r2371 r2399 47 47 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 48 48 !! $Id$ 49 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 50 !!---------------------------------------------------------------------- 51 49 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 50 !!---------------------------------------------------------------------- 52 51 CONTAINS 53 52 54 SUBROUTINE tra_ldf_iso_grif( kt, cdtype, pgu, pgv, &55 & ptb, pta, kjpt, pahtb0 )53 SUBROUTINE tra_ldf_iso_grif( kt, cdtype, pgu, pgv, & 54 & ptb, pta, kjpt, pahtb0 ) 56 55 !!---------------------------------------------------------------------- 57 56 !! *** ROUTINE tra_ldf_iso_grif *** … … 316 315 ! 317 316 ! ! "Poleward" diffusive heat or salt transports (T-S case only) 318 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, n f_ptr ) == 0 ) ) THEN319 IF( jn == jp_tem) pht_ldf(:) = ptr_vj( zftv(:,:,:) ) ! 3.3 names320 IF( jn == jp_sal) pst_ldf(:) = ptr_vj( zftv(:,:,:) )317 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 318 IF( jn == jp_tem) htr_ldf(:) = ptr_vj( zftv(:,:,:) ) ! 3.3 names 319 IF( jn == jp_sal) str_ldf(:) = ptr_vj( zftv(:,:,:) ) 321 320 ENDIF 322 321 -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90
r2287 r2399 39 39 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 40 40 !! $Id$ 41 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)41 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 42 42 !!---------------------------------------------------------------------- 43 44 43 CONTAINS 45 44 46 SUBROUTINE tra_ldf_lap( kt, cdtype, pgu, pgv, &45 SUBROUTINE tra_ldf_lap( kt, cdtype, pgu, pgv, & 47 46 & ptb, pta, kjpt ) 48 47 !!---------------------------------------------------------------------- … … 134 133 ! 135 134 ! "Poleward" diffusive heat or salt transports 136 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, n f_ptr ) == 0 ) ) THEN137 IF( jn == jp_tem) pht_ldf(:) = ptr_vj( ztv(:,:,:) )138 IF( jn == jp_sal) pst_ldf(:) = ptr_vj( ztv(:,:,:) )135 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN 136 IF( jn == jp_tem) htr_ldf(:) = ptr_vj( ztv(:,:,:) ) 137 IF( jn == jp_sal) str_ldf(:) = ptr_vj( ztv(:,:,:) ) 139 138 ENDIF 140 139 ! ! ==================
Note: See TracChangeset
for help on using the changeset viewer.