- Timestamp:
- 2008-01-12T11:10:18+01:00 (16 years ago)
- Location:
- branches/dev_001_GM/NEMO
- Files:
-
- 17 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_001_GM/NEMO/OPA_SRC/DOM/dom_oce.F90
r719 r790 1 1 MODULE dom_oce 2 !!====================================================================== 3 !! *** MODULE dom_oce *** 4 !! ** Purpose : Define in memory all the ocean space domain variables 5 !!====================================================================== 6 !! History : 1.0 ! 05-10 (A. Beckmann, G. Madec) reactivate s-coordinate 2 7 !!---------------------------------------------------------------------- 3 !! *** MODULE dom_oce ***4 !! 5 !! ** Purpose : Define in memory all the ocean space domain variables8 !! NEMO/OPA 2.4 , LOCEAN-IPSL (2007) 9 !! $Id:$ 10 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 6 11 !!---------------------------------------------------------------------- 7 !! History :8 !! 9.0 ! 05-10 (A. Beckmann, G. Madec) reactivate s-coordinate9 !!----------------------------------------------------------------------10 !! OPA 9.0 , LOCEAN-IPSL (2006)11 !! $Header$12 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt13 !!----------------------------------------------------------------------14 !! * Modules used15 12 USE par_oce ! ocean parameters 16 13 … … 22 19 !! space domain parameters 23 20 !! ----------------------- 24 LOGICAL, PUBLIC :: & !: 25 lzoom = .FALSE. , & !: zoom flag 26 lzoom_e = .FALSE. , & !: East zoom type flag 27 lzoom_w = .FALSE. , & !: West zoom type flag 28 lzoom_s = .FALSE. , & !: South zoom type flag 29 lzoom_n = .FALSE. , & !: North zoom type flag 30 lzoom_arct = .FALSE. , & !: ORCA arctic zoom flag 31 lzoom_anta = .FALSE. !: ORCA antarctic zoom flag 21 LOGICAL, PUBLIC :: lzoom = .FALSE. !: zoom flag 22 LOGICAL, PUBLIC :: lzoom_e = .FALSE. !: East zoom type flag 23 LOGICAL, PUBLIC :: lzoom_w = .FALSE. !: West zoom type flag 24 LOGICAL, PUBLIC :: lzoom_s = .FALSE. !: South zoom type flag 25 LOGICAL, PUBLIC :: lzoom_n = .FALSE. !: North zoom type flag 26 LOGICAL, PUBLIC :: lzoom_arct = .FALSE. !: ORCA arctic zoom flag 27 LOGICAL, PUBLIC :: lzoom_anta = .FALSE. !: ORCA antarctic zoom flag 32 28 33 INTEGER, PUBLIC :: & !!:namdom : space domain (bathymetry, mesh)34 ntopo = 0 , &!: = 0/1 ,compute/read the bathymetry file35 ngrid = 0 , &!: = 0/1, compute/read the horizontal mesh file36 nmsh = 0!: = 1 create a mesh-mask file29 ! !!! namdom : space domain (bathymetry, mesh) 30 INTEGER, PUBLIC :: ntopo = 0 !: = 0/1 ,compute/read the bathymetry file 31 INTEGER, PUBLIC :: ngrid = 0 !: = 0/1, compute/read the horizontal mesh file 32 INTEGER, PUBLIC :: nmsh = 0 !: = 1 create a mesh-mask file 37 33 38 INTEGER, PUBLIC :: & !: 39 ! domain parameters linked to mpp 40 nperio, & !: type of lateral boundary condition 41 nimpp, njmpp, & !: i- & j-indexes for mpp-subdomain left bottom 42 nreci, nrecj, & !: overlap region in i and j 43 nproc, & !: number for local processor 44 narea, & !: number for local area 45 nbondi, nbondj, & !: mark of i- and j-direction local boundaries 46 npolj, & !: north fold mark (0, 3 or 4) 47 nlci, nlcj, & !: i- & j-dimensions of the local subdomain 48 nldi, nlei, & !: first and last indoor i- and j-indexes 49 nldj, nlej, & !: 50 noea, nowe, & !: index of the local neighboring processors in 51 noso, nono, & !: east, west, south and north directions 52 npne, npnw, & !: index of north east and north west processor 53 npse, npsw, & !: index of south east and south west processor 54 nbne, nbnw, & !: logical of north east & north west processor 55 nbse, nbsw, & !: logical of south east & south west processor 56 nidom !: ??? 34 ! !!! domain parameters linked to mpp 35 INTEGER, PUBLIC :: nperio !: type of lateral boundary condition 36 INTEGER, PUBLIC :: nimpp , njmpp !: i- & j-indexes for mpp-subdomain left bottom 37 INTEGER, PUBLIC :: nreci , nrecj !: overlap region in i and j 38 INTEGER, PUBLIC :: nproc !: number for local processor 39 INTEGER, PUBLIC :: narea !: number for local area 40 INTEGER, PUBLIC :: nbondi, nbondj !: mark of i- and j-direction local boundaries 41 INTEGER, PUBLIC :: npolj !: north fold mark (0, 3 or 4) 42 INTEGER, PUBLIC :: nlci , nlcj !: i- & j-dimensions of the local subdomain 43 INTEGER, PUBLIC :: nldi , nlei !: first and last indoor i- and j-indexes 44 INTEGER, PUBLIC :: nldj , nlej !: 45 INTEGER, PUBLIC :: noea , nowe !: index of the local neighboring processors in 46 INTEGER, PUBLIC :: noso , nono !: east, west, south and north directions 47 INTEGER, PUBLIC :: npne , npnw !: index of north east and north west processor 48 INTEGER, PUBLIC :: npse , npsw !: index of south east and south west processor 49 INTEGER, PUBLIC :: nbne , nbnw !: logical of north east & north west processor 50 INTEGER, PUBLIC :: nbse , nbsw !: logical of south east & south west processor 51 INTEGER, PUBLIC :: nidom !: ??? 57 52 58 INTEGER, PUBLIC, DIMENSION(jpi) :: & !: 59 mig !: local ==> global domain i-indice 60 INTEGER, PUBLIC, DIMENSION(jpj) :: & !: 61 mjg !: local ==> global domain j-indice 62 INTEGER, PUBLIC, DIMENSION( jpidta ) :: & !: !!bug ==> other solution? 63 mi0, mi1 !: global ==> local domain i-indice 64 ! ! (mi0=1 and mi1=0 if the global indice is not in the local domain) 65 INTEGER, PUBLIC, DIMENSION( jpjdta ) :: & !: 66 mj0, mj1 !: global ==> local domain j-indice 67 ! ! (mi0=1 and mi1=0 if the global indice is not in the local domain) 53 INTEGER, PUBLIC, DIMENSION(jpi) :: mig !: local ==> global domain i-indice 54 INTEGER, PUBLIC, DIMENSION(jpj) :: mjg !: local ==> global domain j-indice 55 INTEGER, PUBLIC, DIMENSION(jpidta) :: mi0, mi1 !: global ==> local domain i-indice (if the global indice is 56 ! ! not in the local domain then mi0=1 and mi1=0) 57 ! !!gm bug ==> other solution? 58 INTEGER, PUBLIC, DIMENSION(jpjdta) :: mj0, mj1 !: global ==> local domain j-indice (if the global indice is 59 ! ! not in the local domain then mj0=1 and mj1=0) 68 60 69 INTEGER, PUBLIC, DIMENSION(jpnij) :: & !: 70 nimppt, njmppt, & !: i-, j-indexes for each processor 71 ibonit, ibonjt, & !: i-, j- processor neighbour existence 72 nlcit , nlcjt, & !: dimensions of every subdomain 73 nldit , nldjt, & !: first, last indoor index for each i-domain 74 nleit , nlejt !: first, last indoor index for each j-domain 61 INTEGER, PUBLIC, DIMENSION(jpnij) :: nimppt, njmppt !: i-, j-indexes for each processor 62 INTEGER, PUBLIC, DIMENSION(jpnij) :: ibonit, ibonjt !: i-, j- processor neighbour existence 63 INTEGER, PUBLIC, DIMENSION(jpnij) :: nlcit , nlcjt !: dimensions of every subdomain 64 INTEGER, PUBLIC, DIMENSION(jpnij) :: nldit , nldjt !: first, last indoor index for each i-domain 65 INTEGER, PUBLIC, DIMENSION(jpnij) :: nleit , nlejt !: first, last indoor index for each j-domain 75 66 76 67 !!---------------------------------------------------------------------- … … 78 69 !! --------------------------------------------------------------------- 79 70 80 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & !: 81 glamt, glamu, & !: longitude of t-, u-, v- and f-points (degre) 82 glamv, glamf, & !: 83 gphit, gphiu, & !: latitude of t-, u-, v- and f-points (degre) 84 gphiv, gphif, & !: 85 e1t, e2t, & !: horizontal scale factors at t-point (m) 86 e1u, e2u, & !: horizontal scale factors at u-point (m) 87 e1v, e2v, & !: horizontal scale factors at v-point (m) 88 e1f, e2f, & !: horizontal scale factors at f-point (m) 89 ff !: coriolis factor (2.*omega*sin(yphi) ) (s-1) 71 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: glamt, glamu !: longitude of t-, u-, v- and f-points (degre) 72 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: glamv, glamf !: 73 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: gphit, gphiu !: latitude of t-, u-, v- and f-points (degre) 74 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: gphiv, gphif !: 75 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: e1t , e2t !: horizontal scale factors at t-point (m) 76 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: e1u , e2u !: horizontal scale factors at u-point (m) 77 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: e1v , e2v !: horizontal scale factors at v-point (m) 78 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: e1f , e2f !: horizontal scale factors at f-point (m) 79 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: ff !: coriolis factor (2.*omega*sin(yphi) ) (s-1) 90 80 91 81 !!---------------------------------------------------------------------- 92 82 !! vertical coordinate and scale factors 93 83 !! -------------------------------------- 94 95 LOGICAL, PUBLIC :: & !!: namzgr : vertical coordinate 96 ln_zco = .TRUE. , & !: z-coordinate - full step 97 ln_zps = .FALSE. , & !: z-coordinate - partial step 98 ln_sco = .FALSE. !: s-coordinate or hybrid z-s coordinate 99 84 ! !!* namzgr : vertical coordinate * 85 LOGICAL, PUBLIC :: ln_zco = .TRUE. !: z-coordinate - full step 86 LOGICAL, PUBLIC :: ln_zps = .FALSE. !: z-coordinate - partial step 87 LOGICAL, PUBLIC :: ln_sco = .FALSE. !: s-coordinate or hybrid z-s coordinate 100 88 #if defined key_zco 101 89 LOGICAL, PUBLIC, PARAMETER :: lk_zco = .TRUE. !: z-coordinate flag (1D arrays) … … 105 93 !! All coordinates 106 94 !! --------------- 107 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: & !: 108 gdep3w , & !: depth of T-points (sum of e3w) (m) 109 gdept , gdepw , & !: analytical depth at T-W points (m) 110 e3v , e3f , & !: analytical vertical scale factors at V--F 111 e3t , e3u , & !: T--U points (m) 112 e3vw , & !: analytical vertical scale factors at VW-- 113 e3w , e3uw !: W--UW points (m) 95 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: gdep3w !: depth of T-points (sum of e3w) (m) 96 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: gdept , gdepw !: depth at T-W points (m) 97 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: e3v , e3f !: vertical scale factors at V--F 98 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: e3t , e3u !: T--U points (m) 99 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: e3vw !: vertical scale factors at VW-- 100 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: e3w , e3uw !: W--UW points (m) 114 101 #endif 115 102 #if defined key_vvl … … 118 105 !! All coordinates 119 106 !! --------------- 120 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: & !: 121 gdep3w_1 , & !: depth of T-points (sum of e3w) (m) 122 gdept_1, gdepw_1, & !: analytical depth at T-W points (m) 123 e3v_1 , e3f_1 , & !: analytical vertical scale factors at V--F 124 e3t_1 , e3u_1 , & !: T--U points (m) 125 e3vw_1 , & !: analytical vertical scale factors at VW-- 126 e3w_1 , e3uw_1 !: W--UW points (m) 107 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: gdep3w_1 !: depth of T-points (sum of e3w) (m) 108 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: gdept_1, gdepw_1 !: depth at T-W points (m) 109 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: e3v_1 , e3f_1 !: vertical scale factors at V--F 110 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: e3t_1 , e3u_1 !: T--U points (m) 111 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: e3vw_1 !: vertical scale factors at VW-- 112 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: e3w_1 , e3uw_1 !: W--UW points (m) 127 113 #else 128 114 LOGICAL, PUBLIC, PARAMETER :: lk_vvl = .FALSE. !: fixed grid flag 129 115 #endif 130 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & !: 131 hur, hvr, & !: inverse of u and v-points ocean depth (1/m) 132 hu , hv !: depth at u- and v-points (meters) 116 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: hur, hvr !: inverse of u and v-points ocean depth (1/m) 117 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: hu , hv !: depth at u- and v-points (meters) 133 118 134 119 !! z-coordinate with full steps (also used in the other cases as reference z-coordinate) 135 120 !! =-----------------====------ 136 REAL(wp), PUBLIC, DIMENSION(jpk) :: & !: 137 gdept_0, gdepw_0, & !: reference depth of t- and w-points (m) 138 e3t_0 , e3w_0 !: reference vertical scale factors at T- and W-pts (m) 121 REAL(wp), PUBLIC, DIMENSION(jpk) :: gdept_0, gdepw_0 !: reference depth of t- and w-points (m) 122 REAL(wp), PUBLIC, DIMENSION(jpk) :: e3t_0 , e3w_0 !: reference vertical scale factors at T- & W-pts (m) 139 123 140 124 !! z-coordinate with partial steps 141 125 !! =-----------------=======------ 142 REAL(wp), PUBLIC :: &!!: * namelist namdom *143 e3zps_min = 5.0_wp, &!: miminum thickness for partial steps (meters)144 e3zps_rat = 0.1_wp !: minimum thickness ration for partial steps126 ! !!: * namelist namdom * 127 REAL(wp), PUBLIC :: e3zps_min = 5.0_wp !: miminum thickness for partial steps (meters) 128 REAL(wp), PUBLIC :: e3zps_rat = 0.1_wp !: minimum thickness ration for partial steps 145 129 146 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & !: 147 hdept, hdepw, e3tp, e3wp !: ??? 130 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: hdept, hdepw, e3tp, e3wp !: ??? 148 131 149 132 !! s-coordinate and hybrid z-s-coordinate 150 133 !! =----------------======--------------- 151 REAL(wp), PUBLIC, DIMENSION(jpk) :: & !: 152 gsigt, gsigw , & !: model level depth coefficient at t-, w-levels (analytic) 153 gsi3w , & !: model level depth coefficient at w-level (sum of gsigw) 154 esigt, esigw !: vertical scale factor coef. at t-, w-levels 134 REAL(wp), PUBLIC, DIMENSION(jpk) :: gsigt, gsigw !: model level depth coefficient at t-, w-levels (analytic) 135 REAL(wp), PUBLIC, DIMENSION(jpk) :: gsi3w !: model level depth coefficient at w-level (sum of gsigw) 136 REAL(wp), PUBLIC, DIMENSION(jpk) :: esigt, esigw !: vertical scale factor coef. at t-, w-levels 155 137 156 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & !:157 hbatv , hbatf , & !: ocean depth at the vertical of V--F158 hbatt , hbatu , & !: T--U points (m)159 scosrf, scobot, & !: ocean surface and bottom topographies(if deviating from coordinate surfaces in HYBRID)160 hifv , hiff , & !: interface depth between stretchingat V--F161 hift , hifu !: and quasi-uniform spacingT--U points (m)138 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: hbatv , hbatf !: ocean depth at the vertical of V--F 139 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: hbatt , hbatu !: T--U points (m) 140 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: scosrf, scobot !: ocean surface and bottom topographies 141 ! ! (if deviating from coordinate surfaces in HYBRID) 142 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: hifv , hiff !: interface depth between stretching at V--F 143 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: hift , hifu !: and quasi-uniform spacing T--U points (m) 162 144 163 145 !!---------------------------------------------------------------------- … … 165 147 !! ----------------- 166 148 167 INTEGER , PUBLIC, DIMENSION(jpi,jpj) :: & !: 168 mbathy !: number of ocean level (=0, 1, ... , jpk-1) 149 INTEGER , PUBLIC, DIMENSION(jpi,jpj) :: mbathy !: number of ocean level (=0, 1, ... , jpk-1) 150 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: bathy !: ocean depth (meters) 151 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: tmask_i !: interior domain T-point mask 152 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: bmask !: land/ocean mask of barotropic stream function 153 REAL(wp), PUBLIC, DIMENSION(jpiglo) :: tpol, fpol !: north fold mask (nperio= 3 or 4) 154 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: vmask, fmask !: land/ocean mask at V--F 155 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: tmask, umask !: and at V--U points 169 156 170 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & !:171 bathy , & !: ocean depth (meters)172 tmask_i, & !: interior domain T-point mask173 bmask !: land/ocean mask of barotropic stream function174 175 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: & !:176 tmask, umask, & !: land/ocean mask at T-, U-, V- and F-points177 vmask, fmask !:178 179 REAL(wp), PUBLIC, DIMENSION(jpiglo) :: & !:180 tpol, fpol !: north fold mask (nperio= 3 or 4)181 157 182 158 #if defined key_noslip_accurate 183 INTEGER, PUBLIC, DIMENSION(4,jpk) :: & !: 184 npcoa !: ??? 185 INTEGER, PUBLIC, DIMENSION(2*(jpi+jpj),4,jpk) :: & !: 186 nicoa, & !: ??? 187 njcoa !: ??? 159 INTEGER, PUBLIC, DIMENSION( 4,jpk) :: npcoa !: ??? 160 INTEGER, PUBLIC, DIMENSION(2*(jpi+jpj),4,jpk) :: nicoa, njcoa !: ??? 188 161 #endif 189 162 … … 191 164 !! time domain 192 165 !!---------------------------------------------------------------------- 193 INTEGER, PUBLIC :: & !!:* Namelist * ???194 nacc = 0 , &!: = 0/1 use of the acceleration of convergence technique195 neuler!: restart euler forward option (0=Euler)166 ! !!! * Namelist * ??? 167 INTEGER, PUBLIC :: nacc = 0 !: = 0/1 use of the acceleration of convergence technique 168 INTEGER, PUBLIC :: neuler !: restart euler forward option (0=Euler) 196 169 170 ! !!! * Namelist ??? * 171 REAL(wp), PUBLIC :: rdt = 3600._wp !: time step for the dynamics (and tracer if nacc=0) 172 REAL(wp), PUBLIC :: rdtmin = 3600._wp !: minimum time step on tracers 173 REAL(wp), PUBLIC :: rdtmax = 3600._wp !: maximum time step on tracers 174 REAL(wp), PUBLIC :: rdth = 800._wp !: depth variation of tracer step 175 REAL(wp), PUBLIC :: rdtbt = 90._wp !: barotropic time step for the dynamics (lk_dynspg_ts=T) 176 REAL(wp), PUBLIC :: atfp = 0.1_wp !: asselin time filter parameter 177 REAL(wp), PUBLIC :: atfp1 !: asselin time filter coeff. (atfp1= 1-2*atfp) 197 178 198 REAL(wp), PUBLIC :: & !!: * Namelist ??? * 199 rdt = 3600._wp , & !: time step for the dynamics (and tracer if nacc=0) 200 rdtmin = 3600._wp , & !: minimum time step on tracers 201 rdtmax = 3600._wp , & !: maximum time step on tracers 202 rdth = 800._wp , & !: depth variation of tracer step 203 rdtbt = 90._wp , & !: barotropic time step for the dynamics (lk_dynspg_ts=T) 204 atfp = 0.1_wp , & !: asselin time filter parameter 205 atfp1 !: asselin time filter coeff. (atfp1= 1-2*atfp) 206 207 REAL(wp), PUBLIC, DIMENSION(jpk) :: & !: 208 rdttra !: vertical profile of tracer time step 179 REAL(wp), PUBLIC, DIMENSION(jpk) :: rdttra !: vertical profile of tracer time step 209 180 210 181 !!---------------------------------------------------------------------- 211 182 !! cross land advection 212 183 !!---------------------------------------------------------------------- 213 214 INTEGER, PUBLIC :: & !!: namelist ??? 215 n_cla !: flag (0/1) for cross land advection to 216 ! ! parameterize exchanges through straits 184 ! !!! * Namelist ??? * 185 INTEGER, PUBLIC :: n_cla !: flag (0/1) for cross land advection to 186 ! ! parameterize exchanges through straits 217 187 218 188 #if defined key_agrif … … 221 191 !!---------------------------------------------------------------------- 222 192 LOGICAL, PUBLIC :: spongedoneT = .FALSE. !: ??? 223 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & 224 zspe1ur, zspe2vr ,zspbtr2 !: ??? 193 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: zspe1ur, zspe2vr ,zspbtr2 !: ??? 225 194 !!---------------------------------------------------------------------- 226 195 #endif 227 196 197 !!====================================================================== 228 198 END MODULE dom_oce -
branches/dev_001_GM/NEMO/OPA_SRC/DOM/domzgr.F90
r719 r790 1 1 MODULE domzgr 2 !!====================================================================== ========2 !!====================================================================== 3 3 !! *** MODULE domzgr *** 4 4 !! Ocean initialization : domain initialization 5 !!============================================================================== 5 !!====================================================================== 6 !! History : NEMO ! 03-08 (G. Madec) original code 7 !! 1.0 ! 05-10 (A. Beckmann) modifications for hybrid s-ccordinates 8 !! - ! 06-04 (R. Benshila, G. Madec) add zgr_zco routine 9 !!---------------------------------------------------------------------- 6 10 7 11 !!---------------------------------------------------------------------- … … 14 18 !! zgr_zps : z-coordinate with partial steps 15 19 !! zgr_sco : s-coordinate 16 !!--------------------------------------------------------------------- 17 !! * Modules used 20 !!---------------------------------------------------------------------- 18 21 USE oce ! ocean dynamics and tracers 19 22 USE dom_oce ! ocean space and time domain … … 28 31 PRIVATE 29 32 30 !! * Routine accessibility31 33 PUBLIC dom_zgr ! called by dom_init.F90 32 34 33 !! * Module variables 34 REAL(wp) :: & !!: Namelist nam_zgr_sco 35 sbot_min = 300. , & !: minimum depth of s-bottom surface (>0) (m) 36 sbot_max = 5250. , & !: maximum depth of s-bottom surface (= ocean depth) (>0) (m) 37 theta = 6.0 , & !: surface control parameter (0<=theta<=20) 38 thetb = 0.75, & !: bottom control parameter (0<=thetb<= 1) 39 r_max = 0.15 !: maximum cut-off r-value allowed (0<r_max<1) 40 41 35 ! !!! * Namelist nam_zgr_sco * 36 REAL(wp) :: sbot_min = 300. !: minimum depth of s-bottom surface (>0) (m) 37 REAL(wp) :: sbot_max = 5250. !: maximum depth of s-bottom surface (= ocean depth) (>0) (m) 38 REAL(wp) :: theta = 6.0 !: surface control parameter (0<=theta<=20) 39 REAL(wp) :: thetb = 0.75 !: bottom control parameter (0<=thetb<= 1) 40 REAL(wp) :: r_max = 0.15 !: maximum cut-off r-value allowed (0<r_max<1) 42 41 43 42 !! * Substitutions … … 45 44 # include "vectopt_loop_substitute.h90" 46 45 !!---------------------------------------------------------------------- 47 !! OPA 9.0 , LOCEAN-IPSL (2005) 46 !! NEMO/OPA 2.4 , LOCEAN-IPSL (2008) 47 !! $Id:$ 48 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 48 49 !!---------------------------------------------------------------------- 49 50 … … 58 59 !! 59 60 !! ** Method reference vertical coordinate 60 !!61 !! ** Action :62 !!63 !! History :64 !! 9.0 ! 03-08 (G. Madec) original code65 !! 9.0 ! 05-10 (A. Beckmann) modifications for hybrid s-ccordinates66 61 !!---------------------------------------------------------------------- 67 62 INTEGER :: ioptio = 0 ! temporary integer … … 70 65 !!---------------------------------------------------------------------- 71 66 72 ! Read Namelist nam_zgr : vertical coordinate' 73 ! --------------------- 74 REWIND ( numnam ) 67 REWIND ( numnam ) ! Read Namelist nam_zgr : vertical coordinate' 75 68 READ ( numnam, nam_zgr ) 76 69 77 ! Parameter control and print 78 ! --------------------------- 79 ! Control print 80 IF(lwp) THEN 70 IF(lwp) THEN ! Control print 81 71 WRITE(numout,*) 82 72 WRITE(numout,*) 'dom_zgr : vertical coordinate' … … 88 78 ENDIF 89 79 90 ! Check Vertical coordinate options80 ! ! Check Vertical coordinate options 91 81 ioptio = 0 92 82 IF( ln_zco ) ioptio = ioptio + 1 … … 131 121 ENDIF 132 122 !!!bug gm 133 123 ! 134 124 END SUBROUTINE dom_zgr 135 125 … … 154 144 !! - e3t_0, e3w_0 : scale factors at T- and W-levels (m) 155 145 !! 156 !! Reference : 157 !! Marti, Madec & Delecluse, 1992, JGR, 97, No8, 12,763-12,766. 158 !! 159 !! History : 160 !! 9.0 ! 03-08 (G. Madec) F90: Free form and module 161 !!---------------------------------------------------------------------- 162 !! * Local declarations 163 INTEGER :: jk ! dummy loop indices 164 REAL(wp) :: zt, zw ! temporary scalars 165 REAL(wp) :: & 166 zsur , za0, za1, zkth, zacr, & ! Values set from parameters in 167 zdzmin, zhmax ! par_CONFIG_Rxx.h90 146 !! Reference : Marti, Madec & Delecluse, 1992, JGR, 97, No8, 12,763-12,766. 147 !!---------------------------------------------------------------------- 148 INTEGER :: jk ! dummy loop indices 149 REAL(wp) :: zt, zw ! temporary scalars 150 REAL(wp) :: zsur , za0, za1 ! value set from parameters 151 REAL(wp) :: zkth, zacr, zdzmin, zhmax ! " " 168 152 !!---------------------------------------------------------------------- 169 153 … … 176 160 ! za0, za1, zsur are computed from ppdzmin , pphmax, ppkth, ppacr 177 161 ! 178 IF(ppa1 == pp_to_be_computed .AND. &162 IF( ppa1 == pp_to_be_computed .AND. & 179 163 & ppa0 == pp_to_be_computed .AND. & 180 164 & ppsur == pp_to_be_computed ) THEN … … 183 167 & * ( LOG( COSH( (jpk - ppkth) / ppacr) ) & 184 168 & - LOG( COSH( ( 1 - ppkth) / ppacr) ) ) ) 185 186 169 za0 = ppdzmin - za1 * TANH( (1-ppkth) / ppacr ) 187 170 zsur = - za0 - za1 * ppacr * LOG( COSH( (1-ppkth) / ppacr ) ) 188 189 ELSE 190 za1 = ppa1 ; za0 = ppa0 ; zsur = ppsur 191 ENDIF 192 193 194 ! Parameter print 195 ! --------------- 196 IF(lwp) THEN 171 ELSE 172 za1 = ppa1 ; za0 = ppa0 ; zsur = ppsur 173 ENDIF 174 175 IF(lwp) THEN ! control print 197 176 WRITE(numout,*) 198 177 WRITE(numout,*) ' zgr_z : Reference vertical z-coordinates' … … 220 199 ! Reference z-coordinate (depth - scale factor at T- and W-points) 221 200 ! ====================== 222 IF( ppkth == 0.e0 ) THEN ! uniform vertical grid 223 201 IF( ppkth == 0.e0 ) THEN ! uniform vertical grid 224 202 za1 = zhmax / FLOAT(jpk-1) 225 203 DO jk = 1, jpk … … 231 209 e3t_0 (jk) = za1 232 210 END DO 233 234 ELSE 235 211 ELSE ! stretched vertical grid 236 212 DO jk = 1, jpk 237 213 zw = FLOAT( jk ) … … 242 218 e3t_0 (jk) = za0 + za1 * TANH( (zt-zkth)/zacr ) 243 219 END DO 244 gdepw_0(1) = 0.e0 ! force first w-level to be exactly at zero 245 246 ENDIF 247 248 ! Control and print 249 ! ================== 250 251 IF(lwp) THEN 220 gdepw_0(1) = 0.e0 ! force first w-level to be exactly at zero 221 ENDIF 222 223 IF(lwp) THEN ! Control and print 252 224 WRITE(numout,*) 253 225 WRITE(numout,*) ' Reference z-coordinate depth and scale factors:' … … 255 227 WRITE(numout, "(10x, i4, 4f9.2)" ) ( jk, gdept_0(jk), gdepw_0(jk), e3t_0(jk), e3w_0(jk), jk = 1, jpk ) 256 228 ENDIF 257 229 ! 258 230 DO jk = 1, jpk 259 231 IF( e3w_0(jk) <= 0. .OR. e3t_0(jk) <= 0. ) CALL ctl_stop( ' e3w or e3t =< 0 ' ) 260 232 IF( gdepw_0(jk) < 0. .OR. gdept_0(jk) < 0. ) CALL ctl_stop( ' gdepw or gdept < 0 ' ) 261 233 END DO 262 234 ! 263 235 END SUBROUTINE zgr_z 264 236 … … 297 269 !! ** Action : - mbathy: level bathymetry (in level index) 298 270 !! - bathy : meter bathymetry (in meters) 299 !! 300 !! History : 301 !! 9.0 ! 03-08 (G. Madec) Original code 302 !! 9.0 ! 05-10 (A. Beckmann) modifications for s-ccordinates 303 !!---------------------------------------------------------------------- 304 !! * Modules used 271 !!---------------------------------------------------------------------- 305 272 USE iom 306 273 307 !! * Local declarations 308 INTEGER :: ji, jj, jl, jk ! dummy loop indices 309 INTEGER :: inum ! temporary logical unit 310 INTEGER :: & 311 ii_bump, ij_bump, ih ! bump center position 312 INTEGER , DIMENSION(jpidta,jpjdta) :: & 313 idta ! global domain integer data 314 REAL(wp) :: & 315 r_bump, h_bump, h_oce, & ! bump characteristics 316 zi, zj, zh ! temporary scalars 317 REAL(wp), DIMENSION(jpidta,jpjdta) :: & 318 zdta ! global domain scalar data 274 INTEGER :: ji, jj, jl, jk ! dummy loop indices 275 INTEGER :: inum ! temporary logical unit 276 INTEGER :: ii_bump, ij_bump, ih ! bump center position 277 REAL(wp) :: r_bump, h_bump, h_oce ! bump characteristics 278 REAL(wp) :: zi, zj, zh ! temporary scalars 279 INTEGER , DIMENSION(jpidta,jpjdta) :: idta ! global domain integer data 280 REAL(wp), DIMENSION(jpidta,jpjdta) :: zdta ! global domain scalar data 319 281 !!---------------------------------------------------------------------- 320 282 … … 331 293 332 294 IF( ntopo == 0 ) THEN ! flat basin 333 334 295 IF(lwp) WRITE(numout,*) 335 296 IF(lwp) WRITE(numout,*) ' bathymetry field: flat basin' 336 337 297 idta(:,:) = jpkm1 ! flat basin 338 298 zdta(:,:) = gdepw_0(jpk) 339 299 h_oce = gdepw_0(jpk) 340 300 ! 341 301 ELSE ! bump 342 302 IF(lwp) WRITE(numout,*) 343 303 IF(lwp) WRITE(numout,*) ' bathymetry field: flat basin with a bump' 344 345 304 ii_bump = jpidta / 2 ! i-index of the bump center 346 305 ij_bump = jpjdta / 2 ! j-index of the bump center … … 361 320 END DO 362 321 END DO 363 364 322 ! idta : 365 323 IF( ln_sco ) THEN ! s-coordinate (zsc ): idta()=jpk … … 478 436 !! 479 437 !! ** Action : - update mbathy: level bathymetry (in level index) 480 !! 481 !! History : 482 !! 9.0 ! 03-08 (G. Madec) Original code 483 !!---------------------------------------------------------------------- 484 !! * Local variables 438 !!---------------------------------------------------------------------- 485 439 INTEGER :: ii0, ii1, ij0, ij1 ! temporary integers 486 440 !!---------------------------------------------------------------------- … … 523 477 ! 524 478 ENDIF 525 479 ! 526 480 END SUBROUTINE zgr_bat_zoom 527 481 … … 548 502 !! ** Action : - update mbathy: level bathymetry (in level index) 549 503 !! - update bathy : meter bathymetry (in meters) 550 !! 551 !! History : 552 !! 9.0 ! 03-08 (G. Madec) Original code 553 !! 9.0 ! 05-10 (A. Beckmann) modifications for s-ccordinates 554 !!---------------------------------------------------------------------- 555 !! * Local declarations 556 INTEGER :: ji, jj, jl ! dummy loop indices 557 INTEGER :: & 558 icompt, ibtest, ikmax ! temporary integers 559 REAL(wp), DIMENSION(jpi,jpj) :: & 560 zbathy ! temporary workspace 504 !!---------------------------------------------------------------------- 505 INTEGER :: ji, jj, jl ! dummy loop indices 506 INTEGER :: icompt, ibtest, ikmax ! temporary integers 507 REAL(wp), DIMENSION(jpi,jpj) :: zbathy ! temporary workspace 561 508 !!---------------------------------------------------------------------- 562 509 … … 580 527 581 528 DO jl = 1, 2 582 583 529 IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN 584 530 mbathy( 1 ,:) = mbathy(jpim1,:) … … 597 543 END DO 598 544 END DO 599 600 END DO 601 IF( icompt == 0 ) THEN 602 IF(lwp) WRITE(numout,*)' no isolated ocean grid points' 603 ELSE 604 IF(lwp) WRITE(numout,*)' ',icompt,' ocean grid points suppressed' 545 END DO 546 ! 547 IF( icompt == 0 ) THEN ; IF(lwp) WRITE(numout,*)' no isolated ocean grid points' 548 ELSE ; IF(lwp) WRITE(numout,*)' ',icompt,' ocean grid points suppressed' 605 549 ENDIF 550 ! 606 551 IF( lk_mpp ) THEN 607 552 zbathy(:,:) = FLOAT( mbathy(:,:) ) … … 610 555 ENDIF 611 556 612 ! 3.2East-west cyclic boundary conditions557 ! East-west cyclic boundary conditions 613 558 614 559 IF( nperio == 0 ) THEN … … 661 606 mbathy(:,:) = INT( zbathy(:,:) ) 662 607 ENDIF 663 608 ! 664 609 ENDIF 665 610 ! 666 611 ENDIF 667 612 … … 674 619 END DO 675 620 END DO 676 !!! test a faire: ikmax = MAX( mbathy(:,:) ) ???621 !!gm !!! test a faire: ikmax = MAX( mbathy(:,:) ) ??? 677 622 678 623 IF( ikmax > jpkm1 ) THEN … … 694 639 WRITE(numout,*) 695 640 ENDIF 696 641 ! 697 642 END SUBROUTINE zgr_bat_ctl 698 643 … … 705 650 !! 706 651 !! ** Method : set 3D coord. arrays to reference 1D array if lk_zco=T 707 !!708 !! History :709 !! ! 06-04 (R. Benshila, G. Madec) Original code710 652 !!---------------------------------------------------------------------- 711 653 INTEGER :: jk 712 654 !!---------------------------------------------------------------------- 713 655 ! 714 656 IF( .NOT.lk_zco ) THEN 715 657 DO jk = 1, jpk … … 726 668 END DO 727 669 ENDIF 728 670 ! 729 671 END SUBROUTINE zgr_zco 730 731 672 732 673 … … 769 710 !! schemes. 770 711 !! 771 !! Reference : 772 !! Madec, Lott, Delecluse and Crepon, 1996. JPO, 26, 1393-1408. 773 !! 774 !! History : 775 !! ! 95-12 (G. Madec) Original code : s vertical coordinate 776 !! ! 97-07 (G. Madec) lbc_lnk call 777 !! ! 97-04 (J.-O. Beismann) 778 !! 8.5 ! 02-06 (G. Madec) F90: Free form and module 779 !! 9.0 ! 05-10 (A. Beckmann) new stretching function 780 !!---------------------------------------------------------------------- 781 !! * Local declarations 712 !! Reference : Madec, Lott, Delecluse and Crepon, 1996. JPO, 26, 1393-1408. 713 !!---------------------------------------------------------------------- 782 714 INTEGER :: ji, jj, jk, jl 783 REAL(wp) :: fssig , fsdsig, pfkk715 REAL(wp) :: fssigt, fssigw, pfkk 784 716 785 717 INTEGER :: iip1, ijp1, iim1, ijm1 786 REAL(wp) :: & 787 fssigt, fssigw, zcoeft, zcoefw, & 788 zrmax, ztaper 789 790 REAL(wp), DIMENSION(jpi,jpj) :: & 791 zenv, ztmp, zmsk, zri, zrj, zhbat 718 ! REAL(wp) :: zcoeft, zcoefw 719 REAL(wp) :: zrmax, ztaper 720 721 REAL(wp), DIMENSION(jpi,jpj) :: zenv, ztmp, zmsk, zri, zrj, zhbat 792 722 793 723 NAMELIST/nam_zgr_sco/ sbot_max, sbot_min, theta, thetb, r_max … … 1120 1050 END DO 1121 1051 1122 IF( nprint == 1 .AND. lwp ) WRITE(numout,*) ' MIN val mbathy h90 ', MINVAL( mbathy(:,:) ), ' MAX ', MAXVAL( mbathy(:,:) ) 1052 IF( nprint == 1 .AND. lwp ) WRITE(numout,*) ' MIN val mbathy h90 ', MINVAL( mbathy(:,:) ), & 1053 & ' MAX ' , MAXVAL( mbathy(:,:) ) 1123 1054 1124 1055 … … 1129 1060 IF( lzoom ) CALL zgr_bat_zoom 1130 1061 1131 ! 2.4 Control print 1132 1133 IF(lwp) THEN 1062 IF(lwp) THEN ! Control print 1134 1063 WRITE(numout,*) 1135 1064 WRITE(numout,*) ' domzgr: vertical coefficients for model level' … … 1202 1131 END DO 1203 1132 !!bug gm #endif 1204 1133 ! 1205 1134 END SUBROUTINE zgr_sco 1206 1135 -
branches/dev_001_GM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90
r719 r790 99 99 ua(ji,jj,jk) = ua(ji,jj,jk) + zua 100 100 va(ji,jj,jk) = va(ji,jj,jk) + zva 101 #if defined key_trddyn102 utrd(ji,jj,jk,1) = zua ! save the horizontal advective trend of momentum103 vtrd(ji,jj,jk,1) = zva104 #endif105 101 END DO 106 102 END DO … … 109 105 ! ! =============== 110 106 107 !!gm momentum trend diagnostics is missing 111 108 112 109 ! II. Vertical advection … … 158 155 END DO 159 156 END DO 157 !!gm momentum trend diagnostics is missing 160 158 161 159 END SUBROUTINE dyn_adv_cen2 -
branches/dev_001_GM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90
r719 r790 191 191 ua(ji,jj,jk) = ua(ji,jj,jk) + zua 192 192 va(ji,jj,jk) = va(ji,jj,jk) + zva 193 #if defined key_trddyn194 utrd(ji,jj,jk,1) = zua ! save the horizontal advective trend of momentum195 vtrd(ji,jj,jk,1) = zva196 #endif197 193 END DO 198 194 END DO … … 201 197 ! ! =============== 202 198 199 !!gm momentum trend diagnostics is missing 203 200 204 201 ! II. Vertical advection -
branches/dev_001_GM/NEMO/OPA_SRC/SBC/ocesbc.F90
r719 r790 4 4 !! Ocean surface boundary conditions 5 5 !!====================================================================== 6 !! History : - ! 00-10 (O. Marti) Original code 7 !! 1.0 ! 02-12 (G. Madec) F90: Free form and module 8 !! 2.0 ! 05-11 (V. Garnier) Surface pressure gradient organization 9 !! 2.4 ! 08-01 (G. Madec) suppress dmp (internal damping contribution) 10 !!---------------------------------------------------------------------- 6 11 7 12 !!---------------------------------------------------------------------- … … 9 14 !! oce_sbc_dmp : ??? 10 15 !!---------------------------------------------------------------------- 11 !! * Modules used12 16 USE oce ! dynamics and tracers variables 13 17 USE dom_oce ! ocean space domain variables … … 20 24 USE flxmod ! thermohaline fluxes 21 25 USE flxrnf ! runoffs forcing 22 USE tradmp ! damping salinity trend23 26 USE dtatem ! ocean temperature data 24 27 USE dtasal ! ocean salinity data … … 49 52 qrp , & !: heat flux damping (w/m2) 50 53 erp !: evaporation damping (kg/m2/s = mm/s) 51 #if ! defined key_dynspg_rl52 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & !:53 dmp !: internal dampind term54 #endif55 54 56 55 # include "domzgr_substitute.h90" … … 80 79 !! Louvain la Neuve Sea Ice Model in coupled mode 81 80 !! 82 !! History :83 !! 1.0 ! 00-10 (O. Marti) Original code84 !! 2.0 ! 02-12 (G. Madec) F90: Free form and module85 !! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization86 81 !!---------------------------------------------------------------------- 87 82 !! * Arguments … … 105 100 emps (:,:) = 0.e0 106 101 erp (:,:) = 0.e0 107 #if ! defined key_dynspg_rl108 dmp (:,:) = 0.e0109 #endif110 102 ENDIF 111 103 … … 143 135 144 136 ! total volume flux (use on sea-surface height) 145 emp (:,:) = fmass(:,:) - dmp(:,:)+ runoff(:,:) + erp(:,:)137 emp (:,:) = fmass(:,:) + runoff(:,:) + erp(:,:) 146 138 #else 147 139 ! Rigid-lid (emp=emps=E-P-R+Erp) … … 216 208 emps (:,:) = 0.e0 217 209 erp (:,:) = 0.e0 218 #if ! defined key_dynspg_rl219 dmp (:,:) = 0.e0220 #endif221 210 ENDIF 222 211 #if defined key_flx_core … … 243 232 244 233 ! total volume flux (use on sea-surface height) 245 emp (:,:) = fmass(:,:) - dmp(:,:)+ runoff(:,:) + erp(:,:) + empold234 emp (:,:) = fmass(:,:) + runoff(:,:) + erp(:,:) + empold 246 235 #else 247 236 ! Rigid-lid (emp=emps=E-P-R+Erp) … … 446 435 emps (:,:) = 0.e0 447 436 erp (:,:) = 0.e0 448 #if ! defined key_dynspg_rl449 dmp (:,:) = 0.e0450 #endif451 437 ENDIF 452 438 … … 537 523 538 524 ! Contribution to sea level: 539 ! net upward water flux emp() = e-p + runoff() + erp() + dmp +empold525 ! net upward water flux emp() = e-p + runoff() + erp() + empold 540 526 emp (:,:) = zemp(:,:) & ! e-p data 541 527 & + runoff(:,:) & ! runoff data 542 528 & + erp(:,:) & ! restoring term to SSS data 543 & + dmp(:,:) & ! freshwater flux associated with internal damping544 529 & + empold ! domain averaged annual mean correction 545 530 … … 809 794 REAL(wp) :: zerpplus(jpi,jpj), zerpminus(jpi,jpj) 810 795 REAL(wp) :: zplus, zminus, zadefi 811 # if defined key_tradmp812 INTEGER jk813 REAL(wp), DIMENSION(jpi,jpj) :: zstrdmp814 # endif815 796 #endif 816 797 !!---------------------------------------------------------------------- … … 838 819 ! Free-surface 839 820 840 ! Internal damping841 # if defined key_tradmp842 ! Vertical mean of dampind trend (computed in tradmp module)843 zstrdmp(:,:) = 0.e0844 DO jk = 1, jpk845 zstrdmp(:,:) = zstrdmp(:,:) + strdmp(:,:,jk) * fse3t(:,:,jk)846 END DO847 ! volume flux associated to internal damping to climatology848 dmp(:,:) = zstrdmp(:,:) * rauw / ( zsss(:,:) + 1.e-20 )849 # else850 dmp(:,:) = 0.e0 ! No internal damping851 # endif852 853 821 ! evaporation damping term ( Surface restoring ) 854 822 zerpplus (:,:) = 0.e0 -
branches/dev_001_GM/NEMO/OPA_SRC/TRA/trabbl.F90
r786 r790 152 152 ! ----------------------------------------------------------------- 153 153 ! mbathy= number of w-level, minimum value=1 (cf dommsk.F) 154 # if defined key_vectopt_loop && ! defined key_mpp_omp155 jj = 1156 DO ji = 1, jpij ! vector opt. (forced unrolling)154 # if defined key_vectopt_loop 155 DO jj = 1, 1 ! vector opt. 156 DO ji = 1, jpij ! forced the loop collapse 157 157 # else 158 158 DO jj = 1, jpj … … 165 165 zsbb(ji,jj) = sb(ji,jj,ik) * tmask(ji,jj,1) 166 166 zdep(ji,jj) = fsdept(ji,jj,ik) ! depth of the ocean bottom T-level 167 # if ! defined key_vectopt_loop || defined key_mpp_omp 168 END DO 169 # endif 167 END DO 170 168 END DO 171 169 172 170 IF( ln_zps ) THEN ! partial steps correction 173 # if defined key_vectopt_loop && ! defined key_mpp_omp174 jj = 1175 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling)171 # if defined key_vectopt_loop 172 DO jj = 1, 1 ! vector opt. 173 DO ji = 1, jpij-jpi ! forced the loop collapse 176 174 # else 177 175 DO jj = 1, jpjm1 … … 186 184 zahu(ji,jj) = atrbbl * e2u(ji,jj) * ze3u / e1u(ji,jj) * umask(ji,jj,1) 187 185 zahv(ji,jj) = atrbbl * e1v(ji,jj) * ze3v / e2v(ji,jj) * vmask(ji,jj,1) 188 # if ! defined key_vectopt_loop || defined key_mpp_omp189 186 END DO 190 # endif191 187 END DO 192 188 ELSE ! z-coordinate - full steps or s-coordinate 193 189 # if defined key_vectopt_loop && ! defined key_mpp_omp 194 jj = 1195 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling)190 DO jj = 1, 1 ! vector opt. 191 DO ji = 1, jpij-jpi ! forced the loop collapse 196 192 # else 197 193 DO jj = 1, jpjm1 … … 202 198 zahu(ji,jj) = atrbbl * e2u(ji,jj) * fse3u(ji,jj,iku) / e1u(ji,jj) * umask(ji,jj,1) 203 199 zahv(ji,jj) = atrbbl * e1v(ji,jj) * fse3v(ji,jj,ikv) / e2v(ji,jj) * vmask(ji,jj,1) 204 # if ! defined key_vectopt_loop || defined key_mpp_omp205 200 END DO 206 # endif207 201 END DO 208 202 ENDIF … … 218 212 219 213 # if defined key_vectopt_loop && ! defined key_mpp_omp 220 jj = 1221 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling)214 DO jj = 1, 1 ! vector opt. 215 DO ji = 1, jpij-jpi ! forced the loop collapse 222 216 # else 223 217 DO jj = 1, jpjm1 … … 236 230 zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 237 231 zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj) 238 # if ! defined key_vectopt_loop || defined key_mpp_omp 239 END DO 240 # endif 241 END DO 242 243 # if defined key_vectopt_loop && ! defined key_mpp_omp 244 jj = 1 245 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 232 END DO 233 END DO 234 235 # if defined key_vectopt_loop && ! defined key_mpp_omp 236 DO jj = 1, 1 ! vector opt. 237 DO ji = 1, jpij-jpi ! forced the loop collapse 246 238 # else 247 239 DO jj = 1, jpjm1 … … 260 252 zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 261 253 zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj) 262 # if ! defined key_vectopt_loop || defined key_mpp_omp 263 END DO 264 # endif 254 END DO 265 255 END DO 266 256 … … 268 258 ! 269 259 # if defined key_vectopt_loop && ! defined key_mpp_omp 270 jj = 1271 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling)260 DO jj = 1, 1 ! vector opt. 261 DO ji = 1, jpij-jpi ! forced the loop collapse 272 262 # else 273 263 DO jj = 1, jpjm1 … … 279 269 zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 280 270 zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj) 281 # if ! defined key_vectopt_loop || defined key_mpp_omp 282 END DO 283 # endif 284 END DO 285 286 # if defined key_vectopt_loop && ! defined key_mpp_omp 287 jj = 1 288 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 271 END DO 272 END DO 273 274 # if defined key_vectopt_loop && ! defined key_mpp_omp 275 DO jj = 1, 1 ! vector opt. 276 DO ji = 1, jpij-jpi ! forced the loop collapse 289 277 # else 290 278 DO jj = 1, jpjm1 … … 296 284 zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 297 285 zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj) 298 # if ! defined key_vectopt_loop || defined key_mpp_omp 299 END DO 300 # endif 286 END DO 301 287 END DO 302 288 … … 304 290 305 291 # if defined key_vectopt_loop && ! defined key_mpp_omp 306 jj = 1307 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling)292 DO jj = 1, 1 ! vector opt. 293 DO ji = 1, jpij-jpi ! forced the loop collapse 308 294 # else 309 295 DO jj = 1, jpjm1 … … 312 298 ! local density gradient along i-bathymetric slope 313 299 zgdrho = - ( rbeta*( zsnb(ji+1,jj) - zsnb(ji,jj) ) & 314 300 & - ralpha*( ztnb(ji+1,jj) - ztnb(ji,jj) ) ) 315 301 ! sign of local i-gradient of density multiplied by the i-slope 316 302 zsign = SIGN( 0.5, - zgdrho * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 317 303 zki(ji,jj) = ( 0.5 - zsign ) * zahu(ji,jj) 318 # if ! defined key_vectopt_loop || defined key_mpp_omp 319 END DO 320 # endif 321 END DO 322 323 # if defined key_vectopt_loop && ! defined key_mpp_omp 324 jj = 1 325 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 304 END DO 305 END DO 306 307 # if defined key_vectopt_loop && ! defined key_mpp_omp 308 DO jj = 1, 1 ! vector opt. 309 DO ji = 1, jpij-jpi ! forced the loop collapse 326 310 # else 327 311 DO jj = 1, jpjm1 … … 330 314 ! local density gradient along j-bathymetric slope 331 315 zgdrho = - ( rbeta*( zsnb(ji,jj+1) - zsnb(ji,jj) ) & 332 316 & - ralpha*( ztnb(ji,jj+1) - ztnb(ji,jj) ) ) 333 317 ! sign of local j-gradient of density multiplied by the j-slope 334 zsign = sign( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) )318 zsign = SIGN( 0.5, -zgdrho * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 335 319 zkj(ji,jj) = ( 0.5 - zsign ) * zahv(ji,jj) 336 # if ! defined key_vectopt_loop || defined key_mpp_omp 337 END DO 338 # endif 320 END DO 339 321 END DO 340 322 … … 351 333 ! first derivative (gradient) 352 334 # if defined key_vectopt_loop && ! defined key_mpp_omp 353 jj = 1354 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling)335 DO jj = 1, 1 ! vector opt. 336 DO ji = 1, jpij-jpi ! forced the loop collapse 355 337 # else 356 338 DO jj = 1, jpjm1 … … 362 344 zky(ji,jj) = zkj(ji,jj) * ( ztbb(ji,jj+1) - ztbb(ji,jj) ) 363 345 zkw(ji,jj) = zkj(ji,jj) * ( zsbb(ji,jj+1) - zsbb(ji,jj) ) 364 # if ! defined key_vectopt_loop || defined key_mpp_omp 365 END DO 366 # endif 346 END DO 367 347 END DO 368 348 … … 401 381 ! second derivative (divergence) and add to the general tracer trend 402 382 # if defined key_vectopt_loop && ! defined key_mpp_omp 403 jj = 1404 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling)383 DO jj = 1, 1 ! vector opt. 384 DO ji = jpi+2, jpij-jpi-1 ! forced the loop collapse 405 385 # else 406 386 DO jj = 2, jpjm1 … … 415 395 ta(ji,jj,ik) = ta(ji,jj,ik) + zta 416 396 sa(ji,jj,ik) = sa(ji,jj,ik) + zsa 417 # if ! defined key_vectopt_loop || defined key_mpp_omp 418 END DO 419 # endif 397 END DO 420 398 END DO 421 399 … … 441 419 !! Default option : NO advective bottom boundary layer 442 420 !!---------------------------------------------------------------------- 443 SUBROUTINE tra_bbl_adv (kt ) ! Empty routine444 INTEGER , INTENT(in):: kt421 SUBROUTINE tra_bbl_adv( kt ) ! Empty routine 422 INTEGER :: kt 445 423 WRITE(*,*) 'tra_bbl_adv: You should not have seen this print! error?', kt 446 424 END SUBROUTINE tra_bbl_adv -
branches/dev_001_GM/NEMO/OPA_SRC/TRA/trabbl_adv.h90
r719 r790 99 99 ! mbathy= number of w-level, minimum value=1 (cf dommsk.F) 100 100 101 #if defined key_vectopt_loop && ! defined key_mpp_omp102 jj =1103 DO ji = 1, jpij ! vector opt. (forced unrolling)101 #if defined key_vectopt_loop 102 DO jj = 1, 1 103 DO ji = 1, jpij ! vector opt. (forced unrolling) 104 104 #else 105 105 DO jj = 1, jpj … … 115 115 zunb(ji,jj) = un(ji,jj,mbku(ji,jj)) 116 116 zvnb(ji,jj) = vn(ji,jj,mbkv(ji,jj)) 117 #if ! defined key_vectopt_loop || defined key_mpp_omp 118 END DO 119 #endif 117 END DO 120 118 END DO 121 119 … … 224 222 225 223 ! ... is equal to zero but where bbl will work. 226 u_bbl(:,:,:) = 0.e0 227 v_bbl(:,:,:) = 0.e0 224 u_bbl(:,:,:) = 0.e0 ; v_bbl(:,:,:) = 0.e0 228 225 229 226 IF( ln_zps ) THEN ! partial steps correction 230 227 231 # if defined key_vectopt_loop && ! defined key_mpp_omp232 jj =1233 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling)228 # if defined key_vectopt_loop 229 DO jj = 1, 1 230 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 234 231 # else 235 232 DO jj = 1, jpjm1 … … 249 246 v_bbl(ji,jj,ikv) = zalphay(ji,jj) * vn(ji,jj,ikv) * ze3v / fse3v(ji,jj,ikv) 250 247 ENDIF 251 # if ! defined key_vectopt_loop || defined key_mpp_omp 252 END DO 253 # endif 248 END DO 254 249 END DO 255 250 … … 259 254 ELSE ! if not partial step loop over the whole domain no lbc call 260 255 261 #if defined key_vectopt_loop && ! defined key_mpp_omp262 jj =1263 DO ji = 1, jpij ! vector opt. (forced unrolling)256 #if defined key_vectopt_loop 257 DO jj = 1, 1 258 DO ji = 1, jpij ! vector opt. (forced unrolling) 264 259 #else 265 260 DO jj = 1, jpj … … 272 267 v_bbl(ji,jj,ikv) = zalphay(ji,jj) * vn(ji,jj,ikv) 273 268 ENDIF 274 #if ! defined key_vectopt_loop || defined key_mpp_omp 275 END DO 276 #endif 269 END DO 277 270 END DO 278 271 … … 284 277 ! ... Second order centered tracer flux at u and v-points 285 278 286 # if defined key_vectopt_loop && ! defined key_mpp_omp287 jj =1288 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling)279 # if defined key_vectopt_loop 280 DO jj = 1, 1 281 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 289 282 # else 290 283 DO jj = 1, jpjm1 … … 309 302 zwz(ji,jj) = ( ( zfvj + ABS( zfvj ) ) * zsbb(ji ,jj ) & 310 303 & +( zfvj - ABS( zfvj ) ) * zsbb(ji ,jj+1) ) * 0.5 311 #if ! defined key_vectopt_loop || defined key_mpp_omp 312 END DO 313 #endif 314 END DO 315 # if defined key_vectopt_loop && ! defined key_mpp_omp 316 jj = 1 317 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling) 304 END DO 305 END DO 306 # if defined key_vectopt_loop 307 DO jj = 1, 1 308 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling) 318 309 # else 319 310 DO jj = 2, jpjm1 … … 331 322 ta(ji,jj,ik) = ta(ji,jj,ik) + zta 332 323 sa(ji,jj,ik) = sa(ji,jj,ik) + zsa 333 #if ! defined key_vectopt_loop || defined key_mpp_omp 334 END DO 335 #endif 324 END DO 336 325 END DO 337 326 … … 365 354 IF( ln_zps ) THEN 366 355 367 # if defined key_vectopt_loop && ! defined key_mpp_omp368 jj =1369 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling)356 # if defined key_vectopt_loop 357 DO jj = 1, 1 358 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 370 359 # else 371 360 DO jj = 1, jpjm1 … … 383 372 zwu(ji,jj) = zalphax(ji,jj) * e2u(ji,jj) * ze3u 384 373 zwv(ji,jj) = zalphay(ji,jj) * e1v(ji,jj) * ze3v 385 #if ! defined key_vectopt_loop || defined key_mpp_omp 386 END DO 387 #endif 374 END DO 388 375 END DO 389 376 390 377 ELSE 391 378 392 # if defined key_vectopt_loop && ! defined key_mpp_omp393 jj =1394 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling)379 # if defined key_vectopt_loop 380 DO jj = 1, 1 381 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 395 382 # else 396 383 DO jj = 1, jpjm1 … … 401 388 zwu(ji,jj) = zalphax(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,iku) 402 389 zwv(ji,jj) = zalphay(ji,jj) * e1v(ji,jj) * fse3v(ji,jj,ikv) 403 #if ! defined key_vectopt_loop || defined key_mpp_omp 404 END DO 405 #endif 390 END DO 406 391 END DO 407 392 … … 409 394 410 395 411 # if defined key_vectopt_loop && ! defined key_mpp_omp412 jj =1413 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling)396 # if defined key_vectopt_loop 397 DO jj = 1, 1 398 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling) 414 399 # else 415 400 DO jj = 2, jpjm1 … … 425 410 & ) / zbt 426 411 427 # if ! defined key_vectopt_loop || defined key_mpp_omp 428 END DO 429 # endif 430 END DO 412 END DO 413 END DO 431 414 432 415 ! 7. compute additional vertical velocity to be used in t boxes -
branches/dev_001_GM/NEMO/OPA_SRC/TRD/trdicp.F90
r719 r790 36 36 37 37 INTERFACE trd_icp 38 MODULE PROCEDURE trd_2d, trd_3d 38 MODULE PROCEDURE trd_2d, trd_3d, trd_u2d, trd_u3d 39 39 END INTERFACE 40 40 … … 44 44 PUBLIC trd_icp_init ! called by opa.F90 45 45 46 !! Variables used for diagnostics 47 REAL(wp) :: tvolt !: volume of the whole ocean computed at t-points 48 REAL(wp) :: tvolu !: volume of the whole ocean computed at u-points 49 REAL(wp) :: tvolv !: volume of the whole ocean computed at v-points 50 51 !! Active Tracer trend diagnostics variables 52 REAL(wp), DIMENSION(jpt_trd,2) :: tsmo !: tracers trends average 53 REAL(wp), DIMENSION(jpt_trd,2) :: ts2 !: tracers square trends average 54 55 !! Momentum trends diagnostics variables 56 REAL(wp), DIMENSION(jptot_dyn) :: umo, vmo !: momentum trends average 57 REAL(wp), DIMENSION(jptot_dyn) :: hke !: momentum square trends average 58 REAL(wp) :: rpktrd !: potential to kinetic energy conversion 59 REAL(wp) :: peke !: conversion potential energy - kinetic energy trend 60 46 61 !! * Substitutions 47 62 # include "domzgr_substitute.h90" … … 55 70 CONTAINS 56 71 57 SUBROUTINE trd_2d( ptrd 2dx, ptrd2dy, ktrd , ctype, clpas )72 SUBROUTINE trd_2d( ptrd, ktra, ktrd , ctype, clpas ) 58 73 !!--------------------------------------------------------------------- 59 74 !! *** ROUTINE trd_2d *** … … 62 77 !! momentum equations at every time step frequency ntrd. 63 78 !!---------------------------------------------------------------------- 64 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: ptrd2dx ! Temperature or U trend65 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: ptrd2dy ! Salinity or V trend66 INTEGER , INTENT(in ) :: ktrd! tracer trend index67 CHARACTER(len=3) , INTENT(in ) :: ctype ! momentum ('DYN') or tracers ('TRA') trends79 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: ptrd ! tracer or u trend 80 INTEGER , INTENT(in ) :: ktra ! tracer index 81 INTEGER , INTENT(in ) :: ktrd ! tracer trend index 82 CHARACTER(len=3) , INTENT(in ) :: ctype ! tracer type (='TRA' or 'TRC') 68 83 CHARACTER(len=3) , INTENT(in ), OPTIONAL :: clpas ! number of passage 69 84 !! 70 INTEGER :: ji, jj ! loop indices 71 CHARACTER(len=3) :: cpas ! number of passage 72 REAL(wp) :: zmsku, zbtu, zbt ! temporary scalars 73 REAL(wp) :: zmskv, zbtv ! " " 74 !!---------------------------------------------------------------------- 75 76 ! Control of optional arguments 77 cpas = 'fst' 85 CHARACTER(len=3) :: cpas ! number of passage 86 REAL(wp) :: zsum ! temporary scalars 87 !!---------------------------------------------------------------------- 88 89 cpas = 'fst' ! Control of optional arguments 78 90 IF( PRESENT(clpas) ) cpas = clpas 91 92 ! 1. Mask volumic trends 93 ptrd(:,:) = e1t(:,:) * e2t(:,:) * fse3t(:,:,1) * ptrd(:,:) * tmask_i(:,:) 94 95 ! 2. Basin averaged tracer trends 96 SELECT CASE( ctype ) 97 CASE( 'TRA' ) ! Tracers 98 zsum = SUM( ptrd(:,:) ) 99 IF( cpas == 'fst' ) THEN ; tsmo(ktrd,ktra) = zsum 100 ELSE ; tsmo(ktrd,ktra) = tsmo(ktrd,ktra) + zsum 101 ENDIF 102 CASE( 'TRC' ) ! Passive tracers 103 ! .... to be done 104 END SELECT 105 106 ! 3. Basin averaged tracer square trends (i.e. trd * now tracer field) 107 SELECT CASE( ctype ) 108 CASE( 'TRA' ) ! Tracers 109 IF( ktra == jp_tem ) zsum = SUM( ptrd(:,:) * tn(:,:,1) ) 110 IF( ktra == jp_sal ) zsum = SUM( ptrd(:,:) * sn(:,:,1) ) 111 IF( cpas == 'fst' ) THEN ; ts2(ktrd,ktra) = zsum 112 ELSE ; ts2(ktrd,ktra) = ts2(ktrd,ktra) + zsum 113 ENDIF 114 CASE( 'TRC' ) ! Passive tracers 115 ! .... to be done 116 END SELECT 117 ! 118 END SUBROUTINE trd_2d 119 120 121 SUBROUTINE trd_3d( ptrd, ktra, ktrd , ctype, clpas ) 122 !!--------------------------------------------------------------------- 123 !! *** ROUTINE trd_3d *** 124 !! 125 !! ** Purpose : verify the basin averaged properties of tracers and/or 126 !! momentum equations at every time step frequency ntrd. 127 !!---------------------------------------------------------------------- 128 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: ptrd ! tracer or u trend 129 INTEGER , INTENT(in ) :: ktra ! tracer index 130 INTEGER , INTENT(in ) :: ktrd ! tracer trend index 131 CHARACTER(len=3) , INTENT(in ) :: ctype ! tracer type (='TRA' or 'TRC') 132 CHARACTER(len=3) , INTENT(in ), OPTIONAL :: clpas ! number of passage 133 !! 134 INTEGER :: jk ! dummy loop indices 135 CHARACTER(len=3) :: cpas ! number of passage 136 REAL(wp) :: zsum ! temporary scalars 137 REAL(wp), DIMENSION(jpi,jpj) :: zsurf ! 2D workspace array 138 !!---------------------------------------------------------------------- 139 140 cpas = 'fst' ! Control of optional arguments 141 IF( PRESENT(clpas) ) cpas = clpas 142 143 ! 1. Mask volumic trends 144 zsurf(:,:) = e1t(:,:) * e2t(:,:) * tmask_i(:,:) 145 DO jk = 1, jpk 146 ptrd(:,:,jk) = zsurf(:,:) * fse3t(:,:,jk) * ptrd(:,:,jk) * tmask(:,:,jk) 147 END DO 148 149 ! 2. Basin averaged tracer trends 150 SELECT CASE( ctype ) 151 CASE( 'TRA' ) ! Tracers 152 zsum = SUM( ptrd(:,:,:) ) 153 IF( cpas == 'fst' ) THEN ; tsmo(ktrd,ktra) = zsum 154 ELSE ; tsmo(ktrd,ktra) = tsmo(ktrd,ktra) + zsum 155 ENDIF 156 CASE( 'TRC' ) ! Passive tracers 157 ! .... to be done 158 END SELECT 159 160 ! 3. Basin averaged tracer square trends (i.e. trd * now tracer field) 161 SELECT CASE( ctype ) 162 CASE( 'TRA' ) ! Tracers 163 IF( ktra == jp_tem ) zsum = SUM( ptrd(:,:,:) * tn(:,:,:) ) 164 IF( ktra == jp_sal ) zsum = SUM( ptrd(:,:,:) * sn(:,:,:) ) 165 IF( cpas == 'fst' ) THEN ; ts2(ktrd,ktra) = zsum 166 ELSE ; ts2(ktrd,ktra) = ts2(ktrd,ktra) + zsum 167 ENDIF 168 CASE( 'TRC' ) ! Passive tracers 169 ! .... to be done 170 END SELECT 171 ! 172 END SUBROUTINE trd_3d 173 174 175 SUBROUTINE trd_u2d( ptrdu, ptrdv, ktrd , ctype, clpas ) 176 !!--------------------------------------------------------------------- 177 !! *** ROUTINE trd_2d *** 178 !! 179 !! ** Purpose : verify the basin averaged properties of tracers and/or 180 !! momentum equations at every time step frequency ntrd. 181 !!---------------------------------------------------------------------- 182 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: ptrdu, ptrdv ! U and V momentum trends 183 INTEGER , INTENT(in ) :: ktrd ! tracer trend index 184 CHARACTER(len=3) , INTENT(in ) :: ctype ! momentum ('DYN') 185 CHARACTER(len=3) , INTENT(in ), OPTIONAL :: clpas ! number of passage 186 !! 187 INTEGER :: ji, jj ! loop indices 188 CHARACTER(len=3) :: cpas ! number of passage 189 REAL(wp) :: zmsku, zbtu ! temporary scalars 190 REAL(wp) :: zmskv, zbtv ! " " 191 !!---------------------------------------------------------------------- 192 193 cpas = 'fst' ! Control of optional arguments 194 IF( PRESENT(clpas) ) cpas = clpas 195 196 SELECT CASE( ctype ) 197 ! 198 CASE( 'DYN' ) ! Momentum 79 199 80 200 ! 1. Mask trends 81 201 ! -------------- 82 83 SELECT CASE( ctype ) 84 ! 85 CASE( 'DYN' ) ! Momentum 86 DO jj = 1, jpjm1 87 DO ji = 1, jpim1 88 zmsku = tmask_i(ji+1,jj ) * tmask_i(ji,jj) * umask(ji,jj,1) 89 zmskv = tmask_i(ji ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,1) 90 ptrd2dx(ji,jj) = ptrd2dx(ji,jj) * zmsku 91 ptrd2dy(ji,jj) = ptrd2dy(ji,jj) * zmskv 92 END DO 93 END DO 94 ptrd2dx(jpi, : ) = 0.e0 ; ptrd2dy(jpi, : ) = 0.e0 95 ptrd2dx( : ,jpj) = 0.e0 ; ptrd2dy( : ,jpj) = 0.e0 96 ! 97 CASE( 'TRA' ) ! Tracers 98 ptrd2dx(:,:) = ptrd2dx(:,:) * tmask_i(:,:) 99 ptrd2dy(:,:) = ptrd2dy(:,:) * tmask_i(:,:) 100 ! 101 END SELECT 202 DO jj = 1, jpjm1 203 DO ji = 1, jpim1 204 zmsku = tmask_i(ji+1,jj ) * tmask_i(ji,jj) * umask(ji,jj,1) 205 zmskv = tmask_i(ji ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,1) 206 ptrdu(ji,jj) = ptrdu(ji,jj) * zmsku 207 ptrdv(ji,jj) = ptrdv(ji,jj) * zmskv 208 END DO 209 END DO 210 ptrdu(jpi, : ) = 0.e0 ; ptrdv(jpi, : ) = 0.e0 211 ptrdu( : ,jpj) = 0.e0 ; ptrdv( : ,jpj) = 0.e0 102 212 103 213 ! 2. Basin averaged tracer/momentum trends 104 214 ! ---------------------------------------- 105 106 SELECT CASE( ctype ) 107 ! 108 CASE( 'DYN' ) ! Momentum 109 umo(ktrd) = 0.e0 110 vmo(ktrd) = 0.e0 111 ! 112 SELECT CASE( ktrd ) 113 ! 114 CASE( jpdyn_trd_swf ) ! surface forcing 115 DO jj = 1, jpj 116 DO ji = 1, jpi 117 umo(ktrd) = umo(ktrd) + ptrd2dx(ji,jj) * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,1) 118 vmo(ktrd) = vmo(ktrd) + ptrd2dy(ji,jj) * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,1) 119 END DO 120 END DO 215 umo(ktrd) = 0.e0 216 vmo(ktrd) = 0.e0 217 ! 218 SELECT CASE( ktrd ) 219 ! 220 CASE( jpdyn_trd_swf ) ! surface forcing 221 DO jj = 1, jpj 222 DO ji = 1, jpi 223 umo(ktrd) = umo(ktrd) + ptrdu(ji,jj) * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,1) 224 vmo(ktrd) = vmo(ktrd) + ptrdv(ji,jj) * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,1) 225 END DO 226 END DO 121 227 ! 122 228 CASE( jpdyn_trd_bfr ) ! bottom friction fluxes 123 229 DO jj = 1, jpj 124 230 DO ji = 1, jpi 125 umo(ktrd) = umo(ktrd) + ptrd 2dx(ji,jj)126 vmo(ktrd) = vmo(ktrd) + ptrd 2dy(ji,jj)231 umo(ktrd) = umo(ktrd) + ptrdu(ji,jj) 232 vmo(ktrd) = vmo(ktrd) + ptrdv(ji,jj) 127 233 END DO 128 234 END DO 129 235 ! 130 END SELECT131 !132 CASE( 'TRA' ) ! Tracers133 IF( cpas == 'fst' ) THEN134 tmo(ktrd) = 0.e0135 smo(ktrd) = 0.e0136 ENDIF137 DO jj = 1, jpj138 DO ji = 1, jpi139 zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,1)140 tmo(ktrd) = tmo(ktrd) + ptrd2dx(ji,jj) * zbt141 smo(ktrd) = smo(ktrd) + ptrd2dy(ji,jj) * zbt142 END DO143 END DO144 !145 236 END SELECT 146 237 ! 147 238 ! 3. Basin averaged tracer/momentum square trends 148 239 ! ---------------------------------------------- 149 240 ! c a u t i o n: field now 150 241 151 SELECT CASE( ctype )152 !153 CASE( 'DYN' ) ! Momentum154 242 hke(ktrd) = 0.e0 155 243 DO jj = 1, jpj … … 157 245 zbtu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,1) 158 246 zbtv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,1) 159 hke(ktrd) = hke(ktrd) & 160 & + un(ji,jj,1) * ptrd2dx(ji,jj) * zbtu & 161 & + vn(ji,jj,1) * ptrd2dy(ji,jj) * zbtv 247 hke(ktrd) = hke(ktrd) + un(ji,jj,1) * ptrdu(ji,jj) * zbtu & 248 & + vn(ji,jj,1) * ptrdv(ji,jj) * zbtv 162 249 END DO 163 250 END DO 164 251 ! 165 CASE( 'TRA' ) ! Tracers166 IF( cpas == 'fst' ) THEN167 t2(ktrd) = 0.e0168 s2(ktrd) = 0.e0169 ENDIF170 DO jj = 1, jpj171 DO ji = 1, jpi172 zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,1)173 t2(ktrd) = t2(ktrd) + ptrd2dx(ji,jj) * zbt * tn(ji,jj,1)174 s2(ktrd) = s2(ktrd) + ptrd2dy(ji,jj) * zbt * sn(ji,jj,1)175 END DO176 END DO177 !178 252 END SELECT 179 253 ! 180 END SUBROUTINE trd_ 2d181 182 183 SUBROUTINE trd_ 3d( ptrd3dx, ptrd3dy, ktrd, ctype, clpas )254 END SUBROUTINE trd_u2d 255 256 257 SUBROUTINE trd_u3d( ptrdu, ptrdv, ktrd, ctype, clpas ) 184 258 !!--------------------------------------------------------------------- 185 259 !! *** ROUTINE trd_3d *** … … 188 262 !! momentum equations at every time step frequency ntrd. 189 263 !!---------------------------------------------------------------------- 190 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: ptrd3dx ! Temperature or U trend 191 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: ptrd3dy ! Salinity or V trend 192 INTEGER, INTENT(in ) :: ktrd ! momentum or tracer trend index 193 CHARACTER(len=3), INTENT(in ) :: ctype ! momentum ('DYN') or tracers ('TRA') trends 194 CHARACTER(len=3), INTENT(in ), OPTIONAL :: clpas ! number of passage 264 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: ptrdu, ptrdv ! U and V momentum trends 265 INTEGER, INTENT(in ) :: ktrd ! momentum trend index 266 CHARACTER(len=3), INTENT(in ) :: ctype ! momentum (='DYN') 267 CHARACTER(len=3), INTENT(in ), OPTIONAL :: clpas ! number of passage 195 268 !! 196 269 INTEGER :: ji, jj, jk 197 CHARACTER(len=3) :: cpas ! number of passage 198 REAL(wp) :: zbt, zbtu, zbtv, zmsku, zmskv ! temporary scalars 199 !!---------------------------------------------------------------------- 200 201 ! Control of optional arguments 202 cpas = 'fst' 270 CHARACTER(len=3) :: cpas ! number of passage 271 REAL(wp) :: zbtu, zbtv, zmsku, zmskv ! temporary scalars 272 !!---------------------------------------------------------------------- 273 274 cpas = 'fst' ! Control of optional arguments 203 275 IF( PRESENT(clpas) ) cpas = clpas 204 276 205 ! 1. Mask the trends206 ! ------------------207 208 277 SELECT CASE( ctype ) 209 278 ! 210 279 CASE( 'DYN' ) ! Momentum 280 281 ! 1. Mask the trends 282 ! ------------------ 211 283 DO jk = 1, jpk 212 284 DO jj = 1, jpjm1 … … 214 286 zmsku = tmask_i(ji+1,jj ) * tmask_i(ji,jj) * umask(ji,jj,jk) 215 287 zmskv = tmask_i(ji ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) 216 ptrd 3dx(ji,jj,jk) = ptrd3dx(ji,jj,jk) * zmsku217 ptrd 3dy(ji,jj,jk) = ptrd3dy(ji,jj,jk) * zmskv288 ptrdu(ji,jj,jk) = ptrdu(ji,jj,jk) * zmsku 289 ptrdv(ji,jj,jk) = ptrdv(ji,jj,jk) * zmskv 218 290 END DO 219 291 END DO 220 292 END DO 221 ptrd 3dx(jpi, : ,:) = 0.e0 ; ptrd3dy(jpi, : ,:) = 0.e0222 ptrd 3dx( : ,jpj,:) = 0.e0 ; ptrd3dy( : ,jpj,:) = 0.e0293 ptrdu(jpi, : ,:) = 0.e0 ; ptrdv(jpi, : ,:) = 0.e0 294 ptrdu( : ,jpj,:) = 0.e0 ; ptrdv( : ,jpj,:) = 0.e0 223 295 ! 224 CASE( 'TRA' ) ! Tracers225 DO jk = 1, jpk226 ptrd3dx(:,:,jk) = ptrd3dx(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:)227 ptrd3dy(:,:,jk) = ptrd3dy(:,:,jk) * tmask(:,:,jk) * tmask_i(:,:)228 END DO229 !230 END SELECT231 296 232 297 ! 2. Basin averaged tracer/momentum trends 233 298 ! ---------------------------------------- 234 299 235 SELECT CASE( ctype )236 !237 CASE( 'DYN' ) ! Momentum238 300 umo(ktrd) = 0.e0 239 301 vmo(ktrd) = 0.e0 … … 243 305 zbtu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) 244 306 zbtv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) 245 umo(ktrd) = umo(ktrd) + ptrd 3dx(ji,jj,jk) * zbtu246 vmo(ktrd) = vmo(ktrd) + ptrd 3dy(ji,jj,jk) * zbtv307 umo(ktrd) = umo(ktrd) + ptrdu(ji,jj,jk) * zbtu 308 vmo(ktrd) = vmo(ktrd) + ptrdv(ji,jj,jk) * zbtv 247 309 END DO 248 310 END DO 249 311 END DO 250 312 ! 251 CASE( 'TRA' ) ! Tracers252 IF( cpas == 'fst' ) THEN253 tmo(ktrd) = 0.e0254 smo(ktrd) = 0.e0255 ENDIF256 DO jk = 1, jpkm1257 DO jj = 1, jpj258 DO ji = 1, jpi259 zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk)260 tmo(ktrd) = tmo(ktrd) + ptrd3dx(ji,jj,jk) * zbt261 smo(ktrd) = smo(ktrd) + ptrd3dy(ji,jj,jk) * zbt262 END DO263 END DO264 END DO265 !266 END SELECT267 313 268 314 ! 3. Basin averaged tracer/momentum square trends … … 270 316 ! c a u t i o n: field now 271 317 272 SELECT CASE( ctype )273 !274 CASE( 'DYN' ) ! Momentum275 318 hke(ktrd) = 0.e0 276 319 DO jk = 1, jpk … … 279 322 zbtu = e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) 280 323 zbtv = e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) 281 hke(ktrd) = hke(ktrd) & 282 & + un(ji,jj,jk) * ptrd3dx(ji,jj,jk) * zbtu & 283 & + vn(ji,jj,jk) * ptrd3dy(ji,jj,jk) * zbtv 284 END DO 285 END DO 286 END DO 287 ! 288 CASE( 'TRA' ) ! Tracers 289 IF( cpas == 'fst' ) THEN 290 t2(ktrd) = 0.e0 291 s2(ktrd) = 0.e0 292 ENDIF 293 DO jk = 1, jpk 294 DO jj = 1, jpj 295 DO ji = 1, jpi 296 zbt = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) 297 t2(ktrd) = t2(ktrd) + ptrd3dx(ji,jj,jk) * zbt * tn(ji,jj,jk) 298 s2(ktrd) = s2(ktrd) + ptrd3dy(ji,jj,jk) * zbt * sn(ji,jj,jk) 324 hke(ktrd) = hke(ktrd) + un(ji,jj,jk) * ptrdu(ji,jj,jk) * zbtu & 325 & + vn(ji,jj,jk) * ptrdv(ji,jj,jk) * zbtv 299 326 END DO 300 327 END DO … … 303 330 END SELECT 304 331 ! 305 END SUBROUTINE trd_3d 306 332 END SUBROUTINE trd_u3d 307 333 308 334 … … 313 339 !! ** Purpose : Read the namtrd namelist 314 340 !!---------------------------------------------------------------------- 315 INTEGER :: ji, jj, jk 316 REAL(wp) :: zmskt 341 INTEGER :: jk 317 342 #if defined key_trddyn 343 INTEGER :: ji, jj 318 344 REAL(wp) :: zmsku, zmskv 319 345 #endif 346 REAL(wp), DIMENSION(jpi,jpj) :: zsurf ! 2D workspace array 320 347 !!---------------------------------------------------------------------- 321 348 … … 328 355 ! Total volume at t-points: 329 356 tvolt = 0.e0 357 zsurf(:,:) = e1t(:,:) * e2t(:,:) * tmask_i(:,:) 330 358 DO jk = 1, jpkm1 331 DO jj = 2, jpjm1 332 DO ji = fs_2, fs_jpim1 ! vector opt. 333 zmskt = tmask(ji,jj,jk) * tmask_i(ji,jj) 334 tvolt = tvolt + zmskt * e1t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) 335 END DO 336 END DO 359 tvolt = tvolt + SUM( tmask(:,:,jk) * zsurf(:,:) * fse3t(:,:,jk) ) 337 360 END DO 338 361 IF( lk_mpp ) CALL mpp_sum( tvolt ) ! sum over the global domain … … 379 402 !! 380 403 INTEGER :: ji, jj, jk 381 REAL(wp) :: ze1e2w, zcof, zbe1ru, zbe2rv, zbtr, ztz, zth ! " scalars 404 REAL(wp) :: zcof, zbe1ru, zbe2rv, zbtr, ztz, zth ! " scalars 405 REAL(wp), DIMENSION(jpi,jpj) :: zsurf ! 2D workspace array 382 406 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zkepe, zkx, zky, zkz ! temporary arrays 383 407 !!---------------------------------------------------------------------- … … 400 424 401 425 ! Density flux at w-point 426 zsurf(:,:) = 0.5 * e1t(:,:) * e2t(:,:) * tmask_i(:,:) /rau0 427 !!gm better use bn2.... 428 zkz(:,:,1) = 0.e0 402 429 DO jk = 2, jpk 403 DO jj = 1, jpj 404 DO ji = 1, jpi 405 ze1e2w = 0.5 * e1t(ji,jj) * e2t(ji,jj) * wn(ji,jj,jk) * tmask_i(ji,jj) 406 zkz(ji,jj,jk) = ze1e2w / rau0 * ( rhop(ji,jj,jk) + rhop(ji,jj,jk-1) ) 407 END DO 408 END DO 409 END DO 410 zkz(:,:,1) = 0.e0 430 zkz(:,:,jk) = zsurf(:,:) * wn(:,:,jk) * ( rhop(:,:,jk) + rhop(:,:,jk-1) ) 431 END DO 411 432 412 433 ! Density flux at u and v-points … … 588 609 ! ------------------------------- 589 610 IF( lk_mpp ) THEN 590 CALL mpp_sum( tmo, jptot_tra ) 591 CALL mpp_sum( smo, jptot_tra ) 592 CALL mpp_sum( t2 , jptot_tra ) 593 CALL mpp_sum( s2 , jptot_tra ) 611 CALL mpp_sum( tsmo, jpt_trd ) 612 CALL mpp_sum( ts2 , jpt_trd ) 594 613 ENDIF 595 614 … … 601 620 WRITE (numout,*) 602 621 WRITE (numout,9400) kt 603 WRITE (numout,9401) (tmo(jpicpt_xad)+tmo(jpicpt_yad))/ tvolt, (smo(jpicpt_xad)+smo(jpicpt_yad))/ tvolt 604 WRITE (numout,9402) tmo(jpicpt_zad) / tvolt, smo(jpicpt_zad) / tvolt 605 WRITE (numout,9403) tmo(jpicpt_ldf) / tvolt, smo(jpicpt_ldf) / tvolt 606 WRITE (numout,9404) tmo(jpicpt_zdf) / tvolt, smo(jpicpt_zdf) / tvolt 607 WRITE (numout,9405) tmo(jpicpt_npc) / tvolt, smo(jpicpt_npc) / tvolt 608 WRITE (numout,9406) tmo(jpicpt_dmp) / tvolt, smo(jpicpt_dmp) / tvolt 609 WRITE (numout,9407) tmo(jpicpt_qsr) / tvolt 610 WRITE (numout,9408) tmo(jpicpt_nsr) / tvolt, smo(jpicpt_nsr) / tvolt 622 WRITE (numout,9401) ( tsmo(jpt_trd_xad,jp_tem) + tsmo(jpt_trd_yad,jp_tem) ) / tvolt, & 623 & ( tsmo(jpt_trd_xad,jp_sal) + tsmo(jpt_trd_yad,jp_sal) ) / tvolt 624 WRITE (numout,9402) tsmo(jpt_trd_zad,jp_tem) / tvolt, tsmo(jpt_trd_zad,jp_sal) / tvolt 625 WRITE (numout,9403) tsmo(jpt_trd_ldf,jp_tem) / tvolt, tsmo(jpt_trd_ldf,jp_sal) / tvolt 626 WRITE (numout,9404) tsmo(jpt_trd_zdf,jp_tem) / tvolt, tsmo(jpt_trd_zdf,jp_sal) / tvolt 627 WRITE (numout,9405) tsmo(jpt_trd_npc,jp_tem) / tvolt, tsmo(jpt_trd_npc,jp_sal) / tvolt 628 WRITE (numout,9406) tsmo(jpt_trd_dmp,jp_tem) / tvolt, tsmo(jpt_trd_dmp,jp_sal) / tvolt 629 WRITE (numout,9407) tsmo(jpt_trd_qsr,jp_tem) / tvolt 630 WRITE (numout,9408) tsmo(jpt_trd_qns,jp_tem) / tvolt, tsmo(jpt_trd_qns,jp_sal) / tvolt 611 631 WRITE (numout,9409) 612 WRITE (numout,9410) ( tmo(jpicpt_xad) + tmo(jpicpt_yad) + tmo(jpicpt_zad) + tmo(jpicpt_ldf) + tmo(jpicpt_zdf) & 613 & + tmo(jpicpt_npc) + tmo(jpicpt_dmp) + tmo(jpicpt_qsr) + tmo(jpicpt_nsr) ) / tvolt, & 614 & ( smo(jpicpt_xad) + smo(jpicpt_yad) + smo(jpicpt_zad) + smo(jpicpt_ldf) + smo(jpicpt_zdf) & 615 & + smo(jpicpt_npc) + smo(jpicpt_dmp) + smo(jpicpt_nsr) ) / tvolt 616 ENDIF 617 618 9400 FORMAT(' tracer trend at it= ',i6,' : temperature', & 619 ' salinity',/' ============================') 632 WRITE (numout,9410) ( tsmo(jpt_trd_xad,jp_tem) + tsmo(jpt_trd_yad,jp_tem) + tsmo(jpt_trd_zad,jp_tem) & 633 & + tsmo(jpt_trd_ldf,jp_tem) + tsmo(jpt_trd_zdf,jp_tem) + tsmo(jpt_trd_npc,jp_tem) & 634 & + tsmo(jpt_trd_dmp,jp_tem) + tsmo(jpt_trd_qsr,jp_tem) + tsmo(jpt_trd_qns,jp_tem) ) & 635 & / tvolt, & 636 & ( tsmo(jpt_trd_xad,jp_sal) + tsmo(jpt_trd_yad,jp_sal) + tsmo(jpt_trd_zad,jp_sal) & 637 & + tsmo(jpt_trd_ldf,jp_sal) + tsmo(jpt_trd_zdf,jp_sal) + tsmo(jpt_trd_npc,jp_sal) & 638 & + tsmo(jpt_trd_dmp,jp_sal) + tsmo(jpt_trd_qns,jp_sal) ) & 639 & / tvolt 640 641 642 9400 FORMAT(' tracer trend at it= ',i6,' : temperature salinity', /, & 643 ' ============================') 620 644 9401 FORMAT(' horizontal advection ',e20.13,' ',e20.13) 621 645 9402 FORMAT(' vertical advection ',e20.13,' ',e20.13) … … 630 654 631 655 632 IF(lwp) THEN633 656 WRITE (numout,*) 634 657 WRITE (numout,*) 635 658 WRITE (numout,9420) kt 636 WRITE (numout,9421) ( t2(jpicpt_xad)+t2(jpicpt_yad) )/ tvolt, ( s2(jpicpt_xad)+s2(jpicpt_yad) )/ tvolt 637 WRITE (numout,9422) t2(jpicpt_zad) / tvolt, s2(jpicpt_zad) / tvolt 638 WRITE (numout,9423) t2(jpicpt_ldf) / tvolt, s2(jpicpt_ldf) / tvolt 639 WRITE (numout,9424) t2(jpicpt_zdf) / tvolt, s2(jpicpt_zdf) / tvolt 640 WRITE (numout,9425) t2(jpicpt_npc) / tvolt, s2(jpicpt_npc) / tvolt 641 WRITE (numout,9426) t2(jpicpt_dmp) / tvolt, s2(jpicpt_dmp) / tvolt 642 WRITE (numout,9427) t2(jpicpt_qsr) / tvolt 643 WRITE (numout,9428) t2(jpicpt_nsr) / tvolt, s2(jpicpt_nsr) / tvolt 659 WRITE (numout,9421) ( ts2(jpt_trd_xad,jp_tem) + ts2(jpt_trd_yad,jp_tem) ) / tvolt, & 660 & ( ts2(jpt_trd_xad,jp_sal) + ts2(jpt_trd_yad,jp_sal) ) / tvolt 661 WRITE (numout,9422) ts2(jpt_trd_zad,jp_tem) / tvolt, ts2(jpt_trd_zad,jp_sal) / tvolt 662 WRITE (numout,9423) ts2(jpt_trd_ldf,jp_tem) / tvolt, ts2(jpt_trd_ldf,jp_sal) / tvolt 663 WRITE (numout,9424) ts2(jpt_trd_zdf,jp_tem) / tvolt, ts2(jpt_trd_zdf,jp_sal) / tvolt 664 WRITE (numout,9425) ts2(jpt_trd_npc,jp_tem) / tvolt, ts2(jpt_trd_npc,jp_sal) / tvolt 665 WRITE (numout,9426) ts2(jpt_trd_dmp,jp_tem) / tvolt, ts2(jpt_trd_dmp,jp_sal) / tvolt 666 WRITE (numout,9427) ts2(jpt_trd_qsr,jp_tem) / tvolt 667 WRITE (numout,9428) ts2(jpt_trd_qns,jp_tem) / tvolt, ts2(jpt_trd_qns,jp_sal) / tvolt 644 668 WRITE (numout,9429) 645 WRITE (numout,9430) ( t2(jpicpt_xad) + t2(jpicpt_yad) + t2(jpicpt_zad) + t2(jpicpt_ldf) + t2(jpicpt_zdf) & 646 & + t2(jpicpt_npc) + t2(jpicpt_dmp) + t2(jpicpt_qsr) + t2(jpicpt_nsr) ) / tvolt, & 647 & ( s2(jpicpt_xad) + s2(jpicpt_yad) + s2(jpicpt_zad) + s2(jpicpt_ldf) + s2(jpicpt_zdf) & 648 & + s2(jpicpt_npc) + s2(jpicpt_dmp) + s2(jpicpt_nsr) ) / tvolt 649 ENDIF 650 651 9420 FORMAT(' tracer**2 trend at it= ', i6, ' : temperature', & 652 ' salinity', /, ' ===============================') 669 WRITE (numout,9430) ( ts2(jpt_trd_xad,jp_tem) + ts2(jpt_trd_yad,jp_tem) + ts2(jpt_trd_zad,jp_tem) & 670 & + ts2(jpt_trd_ldf,jp_tem) + ts2(jpt_trd_zdf,jp_tem) + ts2(jpt_trd_npc,jp_tem) & 671 & + ts2(jpt_trd_dmp,jp_tem) + ts2(jpt_trd_qsr,jp_tem) + ts2(jpt_trd_qns,jp_tem) ) & 672 & / tvolt, & 673 & ( ts2(jpt_trd_xad,jp_sal) + ts2(jpt_trd_yad,jp_sal) + ts2(jpt_trd_zad,jp_sal) & 674 & + ts2(jpt_trd_ldf,jp_sal) + ts2(jpt_trd_zdf,jp_sal) + ts2(jpt_trd_npc,jp_sal) & 675 & + ts2(jpt_trd_dmp,jp_sal) + ts2(jpt_trd_qns,jp_sal) ) & 676 & / tvolt 677 678 9420 FORMAT(' tracer**2 trend at it= ',i6,' : temperature salinity', /, & 679 ' ============================') 653 680 9421 FORMAT(' horizontal advection * t ', e20.13, ' ', e20.13) 654 681 9422 FORMAT(' vertical advection * t ', e20.13, ' ', e20.13) … … 663 690 664 691 665 IF(lwp) THEN666 692 WRITE (numout,*) 667 693 WRITE (numout,*) 668 694 WRITE (numout,9440) kt 669 WRITE (numout,9441) ( tmo(jpicpt_xad)+tmo(jpicpt_yad)+tmo(jpicpt_zad) )/tvolt, & 670 & ( smo(jpicpt_xad)+smo(jpicpt_yad)+smo(jpicpt_zad) )/tvolt 671 WRITE (numout,9442) tmo(jpicpt_zl1)/tvolt, smo(jpicpt_zl1)/tvolt 672 WRITE (numout,9443) tmo(jpicpt_ldf)/tvolt, smo(jpicpt_ldf)/tvolt 673 WRITE (numout,9444) tmo(jpicpt_zdf)/tvolt, smo(jpicpt_zdf)/tvolt 674 WRITE (numout,9445) tmo(jpicpt_npc)/tvolt, smo(jpicpt_npc)/tvolt 675 WRITE (numout,9446) ( t2(jpicpt_xad)+t2(jpicpt_yad)+t2(jpicpt_zad) )/tvolt, & 676 & ( s2(jpicpt_xad)+s2(jpicpt_yad)+s2(jpicpt_zad) )/tvolt 677 WRITE (numout,9447) t2(jpicpt_ldf)/tvolt, s2(jpicpt_ldf)/tvolt 678 WRITE (numout,9448) t2(jpicpt_zdf)/tvolt, s2(jpicpt_zdf)/tvolt 679 WRITE (numout,9449) t2(jpicpt_npc)/tvolt, s2(jpicpt_npc)/tvolt 680 ENDIF 681 682 9440 FORMAT(' tracer consistency at it= ',i6, & 683 ' : temperature',' salinity',/, & 684 ' ==================================') 695 WRITE (numout,9441) ( tsmo(jpt_trd_xad,jp_tem)+tsmo(jpt_trd_yad,jp_tem)+tsmo(jpt_trd_zad,jp_tem) )/tvolt, & 696 & ( tsmo(jpt_trd_xad,jp_sal)+tsmo(jpt_trd_yad,jp_sal)+tsmo(jpt_trd_zad,jp_sal) )/tvolt 697 WRITE (numout,9442) tsmo(jpt_trd_zl1,jp_tem)/tvolt, tsmo(jpt_trd_zl1,jp_sal)/tvolt 698 WRITE (numout,9443) tsmo(jpt_trd_ldf,jp_tem)/tvolt, tsmo(jpt_trd_ldf,jp_sal)/tvolt 699 WRITE (numout,9444) tsmo(jpt_trd_zdf,jp_tem)/tvolt, tsmo(jpt_trd_zdf,jp_sal)/tvolt 700 WRITE (numout,9445) tsmo(jpt_trd_npc,jp_tem)/tvolt, tsmo(jpt_trd_npc,jp_sal)/tvolt 701 WRITE (numout,9446) ( ts2(jpt_trd_xad,jp_tem)+ts2(jpt_trd_yad,jp_tem)+ts2(jpt_trd_zad,jp_tem) )/tvolt, & 702 & ( ts2(jpt_trd_xad,jp_sal)+ts2(jpt_trd_yad,jp_sal)+ts2(jpt_trd_zad,jp_sal) )/tvolt 703 WRITE (numout,9447) ts2(jpt_trd_ldf,jp_tem)/tvolt, ts2(jpt_trd_ldf,jp_sal)/tvolt 704 WRITE (numout,9448) ts2(jpt_trd_zdf,jp_tem)/tvolt, ts2(jpt_trd_zdf,jp_sal)/tvolt 705 WRITE (numout,9449) ts2(jpt_trd_npc,jp_tem)/tvolt, ts2(jpt_trd_npc,jp_sal)/tvolt 706 ENDIF 707 708 9440 FORMAT(' tracer consistency at it= ',i6, ' : temperature',' salinity', & 709 /, ' ==================================') 685 710 9441 FORMAT(' 0 = horizontal+vertical advection + ',e20.13,' ',e20.13) 686 711 9442 FORMAT(' 1st lev vertical advection ',e20.13,' ',e20.13) -
branches/dev_001_GM/NEMO/OPA_SRC/TRD/trdicp_oce.F90
r719 r790 14 14 PUBLIC 15 15 16 !! * Shared module variables17 #if defined key_trdtra && defined key_trddyn || defined key_esopa18 LOGICAL, PARAMETER :: lk_trdtra = .TRUE. !: tracers trend flag19 LOGICAL, PARAMETER :: lk_trddyn = .TRUE. !: momentum trend flag20 #elif defined key_trdtra21 LOGICAL, PARAMETER :: lk_trdtra = .TRUE. !: tracers trend flag22 LOGICAL, PARAMETER :: lk_trddyn = .FALSE. !: momentum trend flag23 #elif defined key_trddyn24 LOGICAL, PARAMETER :: lk_trdtra = .FALSE. !: tracers trend flag25 LOGICAL, PARAMETER :: lk_trddyn = .TRUE. !: momentum trend flag26 #else27 LOGICAL, PARAMETER :: lk_trdtra = .FALSE. !: tracers trend flag28 LOGICAL, PARAMETER :: lk_trddyn = .FALSE. !: momentum trend flag29 #endif30 31 !! Tracers trends diagnostics parameters32 !!---------------------------------------------------------------------33 INTEGER, PARAMETER :: & !: => tracer trends indexes <=34 jpicpt_xad = 1, & !: x- horizontal advection35 jpicpt_yad = 2, & !: y- horizontal advection36 jpicpt_zad = 3, & !: z- vertical advection37 jpicpt_ldf = 4, & !: lateral diffusion38 jpicpt_zdf = 5, & !: vertical diffusion (Kz)39 jpicpt_bbc = 6, & !: Bottom Boundary Condition (geoth. flux)40 jpicpt_bbl = 7, & !: Bottom Boundary Layer (diffusive/convective)41 jpicpt_npc = 8, & !: static instability mixing42 jpicpt_dmp = 9, & !: damping43 jpicpt_qsr = 10, & !: penetrative solar radiation44 jpicpt_nsr = 11, & !: non solar radiation45 jpicpt_zl1 = 12 !: first level vertical flux46 47 INTEGER, PARAMETER :: & !: => Total tracer trends indexes <=48 jptot_tra = 12 !: change it when adding/removing one indice above49 50 16 !! Momentum trends diagnostics parameters 51 17 !!--------------------------------------------------------------------- … … 66 32 jptot_dyn = 11 !: change it when adding/removing one indice above 67 33 68 #if defined key_trdtra || defined key_trddyn || defined key_esopa69 70 !! Variables used for diagnostics71 !!---------------------------------------------------------------------72 REAL(wp) :: tvolt !: volume of the whole ocean computed at t-points73 REAL(wp) :: tvolu !: volume of the whole ocean computed at u-points74 REAL(wp) :: tvolv !: volume of the whole ocean computed at v-points75 76 !! Tracers trends diagnostics variables77 !!---------------------------------------------------------------------78 REAL(wp), DIMENSION(jptot_tra) :: tmo, smo !: tracers trends average79 REAL(wp), DIMENSION(jptot_tra) :: t2, s2 !: tracers square trends average80 81 !! Momentum trends diagnostics variables82 !!---------------------------------------------------------------------83 REAL(wp), DIMENSION(jptot_dyn) :: umo, vmo !: momentum trends average84 REAL(wp), DIMENSION(jptot_dyn) :: hke !: momentum square trends average85 REAL(wp) :: rpktrd !: potential to kinetic energy conversion86 REAL(wp) :: peke !: conversion potential energy - kinetic energy trend87 88 #endif89 34 !!---------------------------------------------------------------------- 90 35 !! OPA 9.0 , LOCEAN-IPSL (2005) -
branches/dev_001_GM/NEMO/OPA_SRC/TRD/trdmod.F90
r719 r790 9 9 #if defined key_trdtra || defined key_trddyn || defined key_trdmld || defined key_trdvor || defined key_esopa 10 10 !!---------------------------------------------------------------------- 11 !! trd_mod : Call the trend to be computed 11 !! trd_tra : active tracer trend manager 12 !! trd_tra_adv : pre-treatment of the tracer advection trends 13 !! trd_mod : momentum trend manager 12 14 !! trd_mod_init : Initialization step 13 15 !!---------------------------------------------------------------------- … … 29 31 REAL(wp) :: r2dt ! time-step, = 2 rdttra except at nit000 (=rdttra) if neuler=0 30 32 31 PUBLIC trd_mod ! called by all dynXX or traXX modules 33 PUBLIC trd_tra ! called by all traXXX.F90 modules 34 PUBLIC trd_tra_adv ! called by all traadv_XXX.F90 modules 35 PUBLIC trd_mod ! called by all dynXXX.F90 modules 32 36 PUBLIC trd_mod_init ! called by opa.F90 module 33 37 … … 42 46 43 47 CONTAINS 48 49 SUBROUTINE trd_tra( kt, ktra, ktrd, ctype, ptrd2d, ptrd3d, cnbpas ) 50 !!--------------------------------------------------------------------- 51 !! *** ROUTINE trd_mod *** 52 !! 53 !! ** Purpose : Dispatch all trends computation, e.g. vorticity, mld or 54 !! integral constraints 55 !!---------------------------------------------------------------------- 56 INTEGER , INTENT(in ) :: kt ! time step 57 INTEGER , INTENT(in ) :: ktra ! tracer index 58 INTEGER , INTENT(in ) :: ktrd ! tracer trend index 59 CHARACTER(len=3), INTENT(in ) :: ctype ! tracers type 'TRA' or 'TRC' 60 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj) , OPTIONAL :: ptrd2d ! Temperature or U trend 61 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk), OPTIONAL :: ptrd3d ! Temperature or U trend 62 CHARACTER(len=3), INTENT(in ) , OPTIONAL :: cnbpas ! number of passage 63 !! 64 CHARACTER(len=3) :: ccpas ! number of passage 65 ! REAL(wp), DIMENSION(jpi,jpj) :: z2dx, z2dy ! workspace arrays 66 !!---------------------------------------------------------------------- 67 68 ccpas = 'fst' ! Control of optional arguments 69 IF( PRESENT(cnbpas) ) ccpas = cnbpas 70 71 IF( neuler == 0 .AND. kt == nit000 ) THEN ; r2dt = rdt ! = rdtra (restarting with Euler time stepping) 72 ELSEIF( kt <= nit000 + 1) THEN ; r2dt = 2. * rdt ! = 2 rdttra (leapfrog) 73 ENDIF 74 75 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 76 ! I. Integral Constraints Properties for momentum and/or tracers trends 77 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 78 79 IF( ( mod(kt,ntrd) == 0 .OR. kt == nit000 .OR. kt == nitend) ) THEN 80 ! 81 IF( lk_trdtra .AND. ctype == 'TRA' ) THEN ! active tracer trends 82 IF( PRESENT(ptrd2d) ) THEN ; CALL trd_icp( ptrd2d, ktra, ktrd, ctype, clpas=ccpas ) 83 ELSE ; CALL trd_icp( ptrd3d, ktra, ktrd, ctype, clpas=ccpas ) 84 ENDIF 85 ENDIF 86 ! SELECT CASE ( ktrd ) 87 ! CASE ( jptra_trd_ldf ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_ldf, ctype ) ! lateral diff 88 ! CASE ( jptra_trd_zdf ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_zdf, ctype ) ! vertical diff (Kz) 89 ! CASE ( jptra_trd_bbc ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_bbc, ctype ) ! bottom boundary cond 90 ! CASE ( jptra_trd_bbl ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_bbl, ctype ) ! bottom boundary layer 91 ! CASE ( jptra_trd_npc ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_npc, ctype ) ! static instability mixing 92 ! CASE ( jptra_trd_dmp ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_dmp, ctype ) ! damping 93 ! CASE ( jptra_trd_qsr ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_qsr, ctype ) ! penetrative solar radiat. 94 ! CASE ( jptra_trd_nsr ) 95 ! z2dx(:,:) = ptrdx(:,:,1) ; z2dy(:,:) = ptrdy(:,:,1) 96 ! CALL trd_icp( z2dx, z2dy, jpicpt_nsr, ctype ) ! non solar radiation 97 ! CASE ( jptra_trd_xad ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_xad, ctype ) ! x- horiz adv 98 ! CASE ( jptra_trd_yad ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_yad, ctype ) ! y- horiz adv 99 ! CASE ( jptra_trd_zad ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_zad, ctype, clpas=ccpas ) ! z- adv 100 ! CALL trd_icp( ptrdx, ptrdy, jpicpt_zad, ctype, clpas=ccpas ) 101 ! ! compute the surface flux condition wn(:,:,1)*tn(:,:,1) 102 ! z2dx(:,:) = wn(:,:,1)*tn(:,:,1)/fse3t(:,:,1) 103 ! z2dy(:,:) = wn(:,:,1)*sn(:,:,1)/fse3t(:,:,1) 104 ! CALL trd_icp( z2dx , z2dy , jpicpt_zl1, ctype ) ! 1st z- vertical adv 105 ! END SELECT 106 ! END IF 107 ! 108 END IF 109 110 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 111 ! III. Mixed layer trends for active tracers 112 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 113 114 IF( lk_trdmld .AND. ctype == 'TRA' ) THEN 115 116 !----------------------------------------------------------------------------------------------- 117 ! W.A.R.N.I.N.G : 118 ! jptra_trd_ldf : called by traldf.F90 119 ! at this stage we store: 120 ! - the lateral geopotential diffusion (here, lateral = horizontal) 121 ! - and the iso-neutral diffusion if activated 122 ! jptra_trd_zdf : called by trazdf.F90 123 ! * in case of iso-neutral diffusion we store the vertical diffusion component in the 124 ! lateral trend including the K_z contrib, which will be removed later (see trd_mld) 125 !----------------------------------------------------------------------------------------------- 126 127 ! SELECT CASE ( ktrd ) 128 ! CASE ( jpt_trd_zdf ) 129 ! IF( ln_traldf_iso ) THEN 130 ! CALL trd_mld_zint( ptrdx, ptrdy, jpmld_ldf, '3D' ) ! vertical diffusion (K_z) 131 ! ELSE 132 ! CALL trd_mld_zint( ptrdx, ptrdy, jpmld_zdf, '3D' ) ! vertical diffusion (K_z) 133 ! ENDIF 134 ! CASE ( jpt_trd_nsr ) 135 ! ptrdx(:,:,2:jpk) = 0.e0 ; ptrdy(:,:,2:jpk) = 0.e0 136 ! CALL trd_mld_zint( ptrdx, ptrdy, jpmld_for, '2D' ) ! air-sea : non solar flux 137 ! CASE ( jpt_trd_bbc ) ; CALL trd_mld_zint( ptrdx, ptrdy, jpmld_bbc, '3D' ) ! bbc (geothermal flux) 138 ! CASE DEFAULT 139 ! CALL trd_mld_zint( ptrdx, ptrdy, ktra , '3D' ) ! other 3D trends 140 ! END SELECT 141 142 ENDIF 143 144 END SUBROUTINE trd_tra 145 146 147 SUBROUTINE trd_tra_adv( kt, ktra, ktrd, ctype, pf, pun, ptn, cnbpas ) 148 !!--------------------------------------------------------------------- 149 !! *** ROUTINE trd_mod *** 150 !! 151 !! ** Purpose : transformed the i-advective flux into the i-advective trends 152 !! ** Method : i-advective trends = un. di[T] = di[fi] - tn di[un] 153 !!---------------------------------------------------------------------- 154 INTEGER , INTENT(in ) :: kt ! time step 155 INTEGER , INTENT(in ) :: ktra ! tracer index 156 INTEGER , INTENT(in ) :: ktrd ! tracer trend index 157 CHARACTER(len=3), INTENT(in ) :: ctype ! tracers type 'TRA' or 'TRC' 158 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk) :: pf ! advective flux in one direction 159 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk) :: pun ! now velocity in one direction 160 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk) :: ptn ! now or before tracer 161 CHARACTER(len=3), INTENT(in ) , OPTIONAL :: cnbpas ! number of passage 162 !! 163 INTEGER :: ji, jj, jk ! dummy loop indices 164 CHARACTER(len=3) :: ccpas ! number of passage 165 REAL(wp) :: zbtr, z_hdivn ! 166 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrdt ! 3D workspace 167 !!---------------------------------------------------------------------- 168 169 ccpas = 'fst' ! Control of optional arguments 170 IF( PRESENT(cnbpas) ) ccpas = cnbpas 171 172 ztrdt(:,:,:) = 0.e0 173 ! 174 IF( ccpas == 'fst' ) THEN ! first treatment : remove the divergence 175 SELECT CASE( ktrd ) 176 CASE( jpt_trd_xad ) ! i-advective trend 177 DO jk = 1, jpkm1 178 DO jj = 2, jpjm1 179 DO ji = fs_2, fs_jpim1 ! vector opt. 180 #if defined key_zco 181 zbtr = 1.e0 / ( e1t(ji,jj) * e2t(ji,jj) ) 182 z_hdivn = ( e2u(ji ,jj) * pun(ji ,jj,jk) & 183 & - e2u(ji-1,jj) * pun(ji-1,jj,jk) ) 184 #else 185 zbtr = 1.e0/ ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 186 z_hdivn = ( e2u(ji ,jj) * fse3u(ji ,jj,jk) * pun(ji ,jj,jk) & 187 & - e2u(ji-1,jj) * fse3u(ji-1,jj,jk) * pun(ji-1,jj,jk) ) 188 #endif 189 ztrdt(ji,jj,jk) = - zbtr * ( pf(ji,jj,jk) - pf(ji-1,jj,jk) - ptn(ji,jj,jk) * z_hdivn ) 190 END DO 191 END DO 192 END DO 193 ! 194 CASE( jpt_trd_yad ) ! j-advective trend 195 DO jk = 1, jpkm1 196 DO jj = 2, jpjm1 197 DO ji = fs_2, fs_jpim1 ! vector opt. 198 #if defined key_zco 199 zbtr = 1.e0 / ( e1t(ji,jj) * e2t(ji,jj) ) 200 z_hdivn = ( e1v(ji,jj ) * pun(ji,jj ,jk) & 201 & - e1v(ji,jj-1) * pun(ji,jj-1,jk) ) 202 #else 203 zbtr = 1.e0/ ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 204 z_hdivn = ( e1v(ji ,jj) * fse3v(ji,jj ,jk) * pun(ji,jj ,jk) & 205 & - e1v(ji-1,jj) * fse3v(ji,jj-1,jk) * pun(ji,jj-1,jk) ) 206 #endif 207 ztrdt(ji,jj,jk) = - zbtr * ( pf(ji,jj,jk) - pf(ji,jj-1,jk) - ptn(ji,jj,jk) * z_hdivn ) 208 END DO 209 END DO 210 END DO 211 ! 212 CASE( jpt_trd_zad ) ! z-advective trend 213 DO jk = 1, jpkm1 214 DO jj = 2, jpjm1 215 DO ji = fs_2, fs_jpim1 ! vector opt. 216 zbtr = 1.e0 / fse3t(ji,jj,jk) 217 z_hdivn = pun(ji,jj,jk) - pun(ji,jj,jk+1) 218 ztrdt(ji,jj,jk) = - zbtr * ( pf(ji,jj,jk) - pf(ji,jj,jk+1) - ptn(ji,jj,jk) * z_hdivn ) 219 END DO 220 END DO 221 END DO 222 ! 223 END SELECT 224 ! 225 ELSE ! second call : just compute the trend (TVD scheme) 226 SELECT CASE( ktrd ) 227 CASE( jpt_trd_xad ) ! i-advective trend 228 DO jk = 1, jpkm1 229 DO jj = 2, jpjm1 230 DO ji = fs_2, fs_jpim1 ! vector opt. 231 zbtr = 1.e0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 232 ztrdt(ji,jj,jk) = - zbtr * ( pf(ji,jj,jk) - pf(ji-1,jj,jk) ) 233 END DO 234 END DO 235 END DO 236 ! 237 CASE( jpt_trd_yad ) ! j-advective trend 238 DO jk = 1, jpkm1 239 DO jj = 2, jpjm1 240 DO ji = fs_2, fs_jpim1 ! vector opt. 241 zbtr = 1.e0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 242 ztrdt(ji,jj,jk) = - zbtr * ( pf(ji,jj,jk) - pf(ji,jj-1,jk) ) 243 END DO 244 END DO 245 END DO 246 ! 247 CASE( jpt_trd_zad ) ! z-advective trend 248 DO jk = 1, jpkm1 249 DO jj = 2, jpjm1 250 DO ji = fs_2, fs_jpim1 ! vector opt. 251 zbtr = 1.e0 / fse3t(ji,jj,jk) 252 ztrdt(ji,jj,jk) = - zbtr * ( pf(ji,jj,jk) - pf(ji,jj,jk+1) ) 253 END DO 254 END DO 255 END DO 256 ! 257 END SELECT 258 ! 259 ENDIF 260 ! 261 CALL trd_tra( kt, ktra, ktrd, ctype, ptrd3d=ztrdt) ! trend diagnostics 262 ! 263 END SUBROUTINE trd_tra_adv 264 44 265 45 266 SUBROUTINE trd_mod( ptrdx, ptrdy, ktrd, ctype, kt, cnbpas ) … … 50 271 !! integral constraints 51 272 !!---------------------------------------------------------------------- 52 INTEGER , INTENT( in ) :: kt! time step53 INTEGER , INTENT( in ) :: ktrd! tracer trend index54 CHARACTER(len=3), INTENT( in ) :: ctype ! momentum or tracers trends type 'DYN'/'TRA'55 CHARACTER(len=3), INTENT( in ), OPTIONAL :: cnbpas! number of passage56 REAL(wp) , DIMENSION(jpi,jpj,jpk), INTENT( inout ) :: ptrdx! Temperature or U trend57 REAL(wp) , DIMENSION(jpi,jpj,jpk), INTENT( inout ) :: ptrdy! Salinity or V trend273 INTEGER , INTENT(in ) :: kt ! time step 274 INTEGER , INTENT(in ) :: ktrd ! tracer trend index 275 CHARACTER(len=3), INTENT(in ) :: ctype ! momentum trends type ='DYN' 276 CHARACTER(len=3), INTENT(in ) , OPTIONAL :: cnbpas ! number of passage 277 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk) :: ptrdx ! Temperature or U trend 278 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk) :: ptrdy ! Salinity or V trend 58 279 !! 59 280 INTEGER :: ji, ikbu, ikbum1 … … 68 289 z2dx(:,:) = 0.e0 ; z2dy(:,:) = 0.e0 ! initialization of workspace arrays 69 290 70 ! Control of optional arguments 71 ccpas = 'fst' 291 ccpas = 'fst' ! Control of optional arguments 72 292 IF( PRESENT(cnbpas) ) ccpas = cnbpas 73 293 74 IF( neuler == 0 .AND. kt == nit000 ) THEN ; r2dt = rdt ! = rdtra ( restartingwith Euler time stepping)294 IF( neuler == 0 .AND. kt == nit000 ) THEN ; r2dt = rdt ! = rdtra (start with Euler time stepping) 75 295 ELSEIF( kt <= nit000 + 1) THEN ; r2dt = 2. * rdt ! = 2 rdttra (leapfrog) 76 296 ENDIF … … 82 302 IF( ( mod(kt,ntrd) == 0 .OR. kt == nit000 .OR. kt == nitend) ) THEN 83 303 ! 84 IF( lk_trdtra .AND. ctype == 'TRA' ) THEN ! active tracer trends85 SELECT CASE ( ktrd )86 CASE ( jptra_trd_ldf ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_ldf, ctype ) ! lateral diff87 CASE ( jptra_trd_zdf ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_zdf, ctype ) ! vertical diff (Kz)88 CASE ( jptra_trd_bbc ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_bbc, ctype ) ! bottom boundary cond89 CASE ( jptra_trd_bbl ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_bbl, ctype ) ! bottom boundary layer90 CASE ( jptra_trd_npc ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_npc, ctype ) ! static instability mixing91 CASE ( jptra_trd_dmp ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_dmp, ctype ) ! damping92 CASE ( jptra_trd_qsr ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_qsr, ctype ) ! penetrative solar radiat.93 CASE ( jptra_trd_nsr )94 z2dx(:,:) = ptrdx(:,:,1) ; z2dy(:,:) = ptrdy(:,:,1)95 CALL trd_icp( z2dx, z2dy, jpicpt_nsr, ctype ) ! non solar radiation96 CASE ( jptra_trd_xad ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_xad, ctype ) ! x- horiz adv97 CASE ( jptra_trd_yad ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_yad, ctype ) ! y- horiz adv98 CASE ( jptra_trd_zad ) ! z- vertical adv99 CALL trd_icp( ptrdx, ptrdy, jpicpt_zad, ctype, clpas=ccpas )100 ! compute the surface flux condition wn(:,:,1)*tn(:,:,1)101 z2dx(:,:) = wn(:,:,1)*tn(:,:,1)/fse3t(:,:,1)102 z2dy(:,:) = wn(:,:,1)*sn(:,:,1)/fse3t(:,:,1)103 CALL trd_icp( z2dx , z2dy , jpicpt_zl1, ctype ) ! 1st z- vertical adv104 END SELECT105 END IF106 107 304 IF( lk_trddyn .AND. ctype == 'DYN' ) THEN ! momentum trends 108 305 ! … … 200 397 ! 201 398 ENDIF 202 203 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 204 ! III. Mixed layer trends for active tracers 205 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 206 207 IF( lk_trdmld .AND. ctype == 'TRA' ) THEN 208 209 !----------------------------------------------------------------------------------------------- 210 ! W.A.R.N.I.N.G : 211 ! jptra_trd_ldf : called by traldf.F90 212 ! at this stage we store: 213 ! - the lateral geopotential diffusion (here, lateral = horizontal) 214 ! - and the iso-neutral diffusion if activated 215 ! jptra_trd_zdf : called by trazdf.F90 216 ! * in case of iso-neutral diffusion we store the vertical diffusion component in the 217 ! lateral trend including the K_z contrib, which will be removed later (see trd_mld) 218 !----------------------------------------------------------------------------------------------- 219 220 SELECT CASE ( ktrd ) 221 CASE ( jptra_trd_xad ) ; CALL trd_mld_zint( ptrdx, ptrdy, jpmld_xad, '3D' ) ! merid. advection 222 CASE ( jptra_trd_yad ) ; CALL trd_mld_zint( ptrdx, ptrdy, jpmld_yad, '3D' ) ! zonal advection 223 CASE ( jptra_trd_zad ) ; CALL trd_mld_zint( ptrdx, ptrdy, jpmld_zad, '3D' ) ! vertical advection 224 CASE ( jptra_trd_ldf ) ; CALL trd_mld_zint( ptrdx, ptrdy, jpmld_ldf, '3D' ) ! lateral diffusive 225 CASE ( jptra_trd_bbl ) ; CALL trd_mld_zint( ptrdx, ptrdy, jpmld_bbl, '3D' ) ! bottom boundary layer 226 CASE ( jptra_trd_zdf ) 227 IF( ln_traldf_iso ) THEN 228 CALL trd_mld_zint( ptrdx, ptrdy, jpmld_ldf, '3D' ) ! vertical diffusion (K_z) 229 ELSE 230 CALL trd_mld_zint( ptrdx, ptrdy, jpmld_zdf, '3D' ) ! vertical diffusion (K_z) 231 ENDIF 232 CASE ( jptra_trd_dmp ) ; CALL trd_mld_zint( ptrdx, ptrdy, jpmld_dmp, '3D' ) ! internal 3D restoring (tradmp) 233 CASE ( jptra_trd_qsr ) ; CALL trd_mld_zint( ptrdx, ptrdy, jpmld_for, '3D' ) ! air-sea : penetrative sol radiat 234 CASE ( jptra_trd_nsr ) 235 ptrdx(:,:,2:jpk) = 0.e0 ; ptrdy(:,:,2:jpk) = 0.e0 236 CALL trd_mld_zint( ptrdx, ptrdy, jpmld_for, '2D' ) ! air-sea : non penetr sol radiat 237 CASE ( jptra_trd_bbc ) ; CALL trd_mld_zint( ptrdx, ptrdy, jpmld_bbc, '3D' ) ! bottom bound cond (geoth flux) 238 CASE ( jptra_trd_atf ) ; CALL trd_mld_zint( ptrdx, ptrdy, jpmld_atf, '3D' ) ! asselin numerical 239 CASE ( jptra_trd_npc ) ; CALL trd_mld_zint( ptrdx, ptrdy, jpmld_npc, '3D' ) ! non penetr convect adjustment 240 END SELECT 241 242 ENDIF 243 399 ! 244 400 END SUBROUTINE trd_mod 245 401 … … 254 410 255 411 CONTAINS 412 413 SUBROUTINE trd_tra( kt, ktra, ktrd, ctype, ptrd2d, ptrd3d, cnbpas ) 414 INTEGER :: kt, ktra, ktrd 415 CHARACTER(len=3) :: ctype ! tracers type 'TRA' or 'TRC' 416 REAL, DIMENSION(:,:) , OPTIONAL :: ptrd2d ! Temperature or U trend 417 REAL, DIMENSION(:,:,:), OPTIONAL :: ptrd3d ! Temperature or U trend 418 CHARACTER(len=3) , OPTIONAL :: cnbpas ! number of passage 419 WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', kt, ktra, ktrd, ctype, & 420 & ptrd2d(1,1), ptrd3d(1,1,1), cnbpas 421 END SUBROUTINE trd_tra 422 423 SUBROUTINE trd_tra_adv( kt, ktra, ktrd, ctype, pf, pun, ptn, cnbpas ) 424 INTEGER :: kt, ktra, ktrd 425 CHARACTER(len=3) :: ctype 426 REAL, DIMENSION(:,:,:) :: pf, pun, ptn 427 CHARACTER(len=3), OPTIONAL :: cnbpas 428 WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', kt, ktra, ktrd, ctype, pf(1,1,1), & 429 & pun(1,1,1), ptn(1,1,1), cnbpas 430 END SUBROUTINE trd_tra_adv 431 256 432 SUBROUTINE trd_mod(ptrd3dx, ptrd3dy, ktrd , ctype, kt, cnbpas) ! Empty routine 257 REAL, DIMENSION(:,:,:), INTENT( in ) :: & 258 ptrd3dx, & ! Temperature or U trend 259 ptrd3dy ! Salinity or V trend 260 INTEGER, INTENT( in ) :: ktrd ! momentum or tracer trend index 261 INTEGER, INTENT( in ) :: kt ! Time step 433 REAL, DIMENSION(:,:,:) :: ptrd3dx, ptrd3dy 434 INTEGER :: ktrd, kt 262 435 CHARACTER(len=3), INTENT( in ) :: ctype ! momentum or tracers trends type 263 436 CHARACTER(len=3), INTENT( in ), OPTIONAL :: cnbpas ! number of passage -
branches/dev_001_GM/NEMO/OPA_SRC/TRD/trdmod_oce.F90
r719 r790 32 32 LOGICAL , PUBLIC :: l_trddyn = .FALSE. !: momentum trend flag 33 33 # endif 34 #if defined key_trdtra && defined key_trddyn || defined key_esopa 35 LOGICAL, PARAMETER :: lk_trdtra = .TRUE. !: tracers trend flag 36 LOGICAL, PARAMETER :: lk_trddyn = .TRUE. !: momentum trend flag 37 #elif defined key_trdtra 38 LOGICAL, PARAMETER :: lk_trdtra = .TRUE. !: tracers trend flag 39 LOGICAL, PARAMETER :: lk_trddyn = .FALSE. !: momentum trend flag 40 #elif defined key_trddyn 41 LOGICAL, PARAMETER :: lk_trdtra = .FALSE. !: tracers trend flag 42 LOGICAL, PARAMETER :: lk_trddyn = .TRUE. !: momentum trend flag 43 #else 44 LOGICAL, PARAMETER :: lk_trdtra = .FALSE. !: tracers trend flag 45 LOGICAL, PARAMETER :: lk_trddyn = .FALSE. !: momentum trend flag 46 #endif 47 34 48 35 49 !!* Active tracers trends indexes 36 INTEGER, PUBLIC, PARAMETER :: jptra_trd_xad = 1 !: x- horizontal advection 37 INTEGER, PUBLIC, PARAMETER :: jptra_trd_yad = 2 !: y- horizontal advection 38 INTEGER, PUBLIC, PARAMETER :: jptra_trd_zad = 3 !: z- vertical advection 39 INTEGER, PUBLIC, PARAMETER :: jptra_trd_ldf = 4 !: lateral diffusion 40 INTEGER, PUBLIC, PARAMETER :: jptra_trd_zdf = 5 !: vertical diffusion (Kz) 41 INTEGER, PUBLIC, PARAMETER :: jptra_trd_bbc = 6 !: Bottom Boundary Condition (geoth. flux) 42 INTEGER, PUBLIC, PARAMETER :: jptra_trd_bbl = 7 !: Bottom Boundary Layer (diffusive/convective) 43 INTEGER, PUBLIC, PARAMETER :: jptra_trd_npc = 8 !: static instability mixing 44 INTEGER, PUBLIC, PARAMETER :: jptra_trd_dmp = 9 !: damping 45 INTEGER, PUBLIC, PARAMETER :: jptra_trd_qsr = 10 !: penetrative solar radiation 46 INTEGER, PUBLIC, PARAMETER :: jptra_trd_nsr = 11 !: non solar radiation 47 INTEGER, PUBLIC, PARAMETER :: jptra_trd_atf = 12 !: Asselin correction 50 INTEGER, PUBLIC, PARAMETER :: jpt_trd = 13 !: change it when adding/removing one indice above 51 52 INTEGER, PUBLIC, PARAMETER :: jpt_trd_xad = 1 !: x- horizontal advection 53 INTEGER, PUBLIC, PARAMETER :: jpt_trd_yad = 2 !: y- horizontal advection 54 INTEGER, PUBLIC, PARAMETER :: jpt_trd_zad = 3 !: z- vertical advection 55 INTEGER, PUBLIC, PARAMETER :: jpt_trd_ldf = 4 !: lateral diffusion 56 INTEGER, PUBLIC, PARAMETER :: jpt_trd_zdf = 5 !: vertical diffusion (Kz) 57 INTEGER, PUBLIC, PARAMETER :: jpt_trd_bbc = 6 !: Bottom Boundary Condition (geoth. flux) 58 INTEGER, PUBLIC, PARAMETER :: jpt_trd_bbl = 7 !: Bottom Boundary Layer (diffusive/convective) 59 INTEGER, PUBLIC, PARAMETER :: jpt_trd_npc = 8 !: static instability mixing 60 INTEGER, PUBLIC, PARAMETER :: jpt_trd_dmp = 9 !: damping 61 INTEGER, PUBLIC, PARAMETER :: jpt_trd_qsr = 10 !: penetrative solar radiation 62 INTEGER, PUBLIC, PARAMETER :: jpt_trd_qns = 11 !: non solar heat flux 63 INTEGER, PUBLIC, PARAMETER :: jpt_trd_atf = 12 !: Asselin correction 64 INTEGER, PUBLIC, PARAMETER :: jpt_trd_zl1 = 13 !: first level vertical flux (lk_vvl=F) 65 48 66 49 67 !!* Momentum trends indexes -
branches/dev_001_GM/NEMO/OPA_SRC/TRD/trends_manager.F90
r772 r790 1 MODULE tr dmod1 MODULE trends_manager 2 2 !!====================================================================== 3 !! *** MODULE tr dmod***3 !! *** MODULE trends_manager *** 4 4 !! Ocean diagnostics: ocean tracers and dynamic trends 5 5 !!===================================================================== … … 8 8 !!---------------------------------------------------------------------- 9 9 #if defined key_trdtra || defined key_trddyn || defined key_trdmld || defined key_trdvor || defined key_esopa 10 !!----------------------------------------------------------------------11 !! trd_mod : Call the trend to be computed12 !! trd_mod_init : Initialization step13 !!----------------------------------------------------------------------14 USE phycst ! physical constants15 USE oce ! ocean dynamics and tracers variables16 USE dom_oce ! ocean space and time domain variables17 USE zdf_oce ! ocean vertical physics variables18 USE trdmod_oce ! ocean variables trends19 USE ldftra_oce ! ocean active tracers lateral physics20 USE trdvor ! ocean vorticity trends21 USE trdicp ! ocean bassin integral constraints properties22 USE trdmld ! ocean active mixed layer tracers trends23 USE in_out_manager ! I/O manager24 USE taumod ! surface ocean stress25 10 26 IMPLICIT NONE 27 PRIVATE 28 29 REAL(wp) :: r2dt ! time-step, = 2 rdttra except at nit000 (=rdttra) if neuler=0 30 31 PUBLIC trd_mod ! called by all dynXX or traXX modules 32 PUBLIC trd_mod_init ! called by opa.F90 module 33 34 !! * Substitutions 35 # include "domzgr_substitute.h90" 36 # include "vectopt_loop_substitute.h90" 37 !!---------------------------------------------------------------------- 38 !! OPA 9.0 , LOCEAN-IPSL (2005) 39 !! $Header$ 40 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 41 !!---------------------------------------------------------------------- 42 43 CONTAINS 44 45 SUBROUTINE trd_mod( ptrdx, ptrdy, ktrd, ctype, kt, cnbpas ) 46 !!--------------------------------------------------------------------- 47 !! *** ROUTINE trd_mod *** 48 !! 49 !! ** Purpose : Dispatch all trends computation, e.g. vorticity, mld or 50 !! integral constraints 51 !!---------------------------------------------------------------------- 52 INTEGER, INTENT( in ) :: kt ! time step 53 INTEGER, INTENT( in ) :: ktrd ! tracer trend index 54 CHARACTER(len=3), INTENT( in ) :: ctype ! momentum or tracers trends type 'DYN'/'TRA' 55 CHARACTER(len=3), INTENT( in ), OPTIONAL :: cnbpas ! number of passage 56 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) :: ptrdx ! Temperature or U trend 57 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) :: ptrdy ! Salinity or V trend 58 !! 59 INTEGER :: ji, ikbu, ikbum1 60 INTEGER :: jj, ikbv, ikbvm1 61 CHARACTER(len=3) :: ccpas ! number of passage 62 REAL(wp) :: zua, zva ! scalars 63 REAL(wp), DIMENSION(jpi,jpj) :: ztswu, ztswv ! 2D workspace 64 REAL(wp), DIMENSION(jpi,jpj) :: ztbfu, ztbfv ! 2D workspace 65 REAL(wp), DIMENSION(jpi,jpj) :: z2dx, z2dy ! workspace arrays 66 !!---------------------------------------------------------------------- 67 68 z2dx(:,:) = 0.e0 ; z2dy(:,:) = 0.e0 ! initialization of workspace arrays 69 70 ! Control of optional arguments 71 ccpas = 'fst' 72 IF( PRESENT(cnbpas) ) ccpas = cnbpas 73 74 IF( neuler == 0 .AND. kt == nit000 ) THEN ; r2dt = rdt ! = rdtra (restarting with Euler time stepping) 75 ELSEIF( kt <= nit000 + 1) THEN ; r2dt = 2. * rdt ! = 2 rdttra (leapfrog) 76 ENDIF 77 78 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 79 ! I. Integral Constraints Properties for momentum and/or tracers trends 80 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 81 82 IF( ( mod(kt,ntrd) == 0 .OR. kt == nit000 .OR. kt == nitend) ) THEN 83 ! 84 IF( lk_trdtra .AND. ctype == 'TRA' ) THEN ! active tracer trends 85 SELECT CASE ( ktrd ) 86 CASE ( jptra_trd_ldf ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_ldf, ctype ) ! lateral diff 87 CASE ( jptra_trd_zdf ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_zdf, ctype ) ! vertical diff (Kz) 88 CASE ( jptra_trd_bbc ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_bbc, ctype ) ! bottom boundary cond 89 CASE ( jptra_trd_bbl ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_bbl, ctype ) ! bottom boundary layer 90 CASE ( jptra_trd_npc ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_npc, ctype ) ! static instability mixing 91 CASE ( jptra_trd_dmp ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_dmp, ctype ) ! damping 92 CASE ( jptra_trd_qsr ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_qsr, ctype ) ! penetrative solar radiat. 93 CASE ( jptra_trd_nsr ) 94 z2dx(:,:) = ptrdx(:,:,1) ; z2dy(:,:) = ptrdy(:,:,1) 95 CALL trd_icp( z2dx, z2dy, jpicpt_nsr, ctype ) ! non solar radiation 96 CASE ( jptra_trd_xad ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_xad, ctype ) ! x- horiz adv 97 CASE ( jptra_trd_yad ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_yad, ctype ) ! y- horiz adv 98 CASE ( jptra_trd_zad ) ! z- vertical adv 99 CALL trd_icp( ptrdx, ptrdy, jpicpt_zad, ctype, clpas=ccpas ) 100 ! compute the surface flux condition wn(:,:,1)*tn(:,:,1) 101 z2dx(:,:) = wn(:,:,1)*tn(:,:,1)/fse3t(:,:,1) 102 z2dy(:,:) = wn(:,:,1)*sn(:,:,1)/fse3t(:,:,1) 103 CALL trd_icp( z2dx , z2dy , jpicpt_zl1, ctype ) ! 1st z- vertical adv 104 END SELECT 105 END IF 106 107 IF( lk_trddyn .AND. ctype == 'DYN' ) THEN ! momentum trends 108 ! 109 SELECT CASE ( ktrd ) 110 CASE ( jpdyn_trd_hpg ) ; CALL trd_icp( ptrdx, ptrdy, jpicpd_hpg, ctype ) ! hydrost. pressure grad 111 CASE ( jpdyn_trd_keg ) ; CALL trd_icp( ptrdx, ptrdy, jpicpd_keg, ctype ) ! KE gradient 112 CASE ( jpdyn_trd_rvo ) ; CALL trd_icp( ptrdx, ptrdy, jpicpd_rvo, ctype ) ! relative vorticity 113 CASE ( jpdyn_trd_pvo ) ; CALL trd_icp( ptrdx, ptrdy, jpicpd_pvo, ctype ) ! planetary vorticity 114 CASE ( jpdyn_trd_ldf ) ; CALL trd_icp( ptrdx, ptrdy, jpicpd_ldf, ctype ) ! lateral diffusion 115 CASE ( jpdyn_trd_zad ) ; CALL trd_icp( ptrdx, ptrdy, jpicpd_zad, ctype ) ! vertical advection 116 CASE ( jpdyn_trd_spg ) ; CALL trd_icp( ptrdx, ptrdy, jpicpd_spg, ctype ) ! surface pressure grad. 117 CASE ( jpdyn_trd_dat ) ; CALL trd_icp( ptrdx, ptrdy, jpicpd_dat, ctype ) ! damping term 118 CASE ( jpdyn_trd_zdf ) ! vertical diffusion 119 ! subtract surface forcing/bottom friction trends 120 ! from vertical diffusive momentum trends 121 ztswu(:,:) = 0.e0 ; ztswv(:,:) = 0.e0 122 ztbfu(:,:) = 0.e0 ; ztbfv(:,:) = 0.e0 123 DO jj = 2, jpjm1 124 DO ji = fs_2, fs_jpim1 ! vector opt. 125 ! save the surface forcing momentum fluxes 126 ztswu(ji,jj) = taux(ji,jj) / ( fse3u(ji,jj,1)*rau0 ) 127 ztswv(ji,jj) = tauy(ji,jj) / ( fse3v(ji,jj,1)*rau0 ) 128 ! save bottom friction momentum fluxes 129 ikbu = MIN( mbathy(ji+1,jj ), mbathy(ji,jj) ) 130 ikbv = MIN( mbathy(ji ,jj+1), mbathy(ji,jj) ) 131 ikbum1 = MAX( ikbu-1, 1 ) 132 ikbvm1 = MAX( ikbv-1, 1 ) 133 zua = ua(ji,jj,ikbum1) * r2dt + ub(ji,jj,ikbum1) 134 zva = va(ji,jj,ikbvm1) * r2dt + vb(ji,jj,ikbvm1) 135 ztbfu(ji,jj) = - avmu(ji,jj,ikbu) * zua / ( fse3u(ji,jj,ikbum1)*fse3uw(ji,jj,ikbu) ) 136 ztbfv(ji,jj) = - avmv(ji,jj,ikbv) * zva / ( fse3v(ji,jj,ikbvm1)*fse3vw(ji,jj,ikbv) ) 137 ! 138 ptrdx(ji,jj,1 ) = ptrdx(ji,jj,1 ) - ztswu(ji,jj) 139 ptrdy(ji,jj,1 ) = ptrdy(ji,jj,1 ) - ztswv(ji,jj) 140 ptrdx(ji,jj,ikbum1) = ptrdx(ji,jj,ikbum1) - ztbfu(ji,jj) 141 ptrdy(ji,jj,ikbvm1) = ptrdy(ji,jj,ikbvm1) - ztbfv(ji,jj) 142 END DO 143 END DO 144 ! 145 CALL trd_icp( ptrdx, ptrdy, jpicpd_zdf, ctype ) 146 CALL trd_icp( ztswu, ztswv, jpicpd_swf, ctype ) ! wind stress forcing term 147 CALL trd_icp( ztbfu, ztbfv, jpicpd_bfr, ctype ) ! bottom friction term 148 END SELECT 149 ! 150 END IF 151 ! 152 END IF 153 154 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 155 ! II. Vorticity trends 156 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 157 158 IF( lk_trdvor .AND. ctype == 'DYN' ) THEN 159 ! 160 SELECT CASE ( ktrd ) 161 CASE ( jpdyn_trd_hpg ) ; CALL trd_vor_zint( ptrdx, ptrdy, jpvor_prg ) ! Hydrostatique Pressure Gradient 162 CASE ( jpdyn_trd_keg ) ; CALL trd_vor_zint( ptrdx, ptrdy, jpvor_keg ) ! KE Gradient 163 CASE ( jpdyn_trd_rvo ) ; CALL trd_vor_zint( ptrdx, ptrdy, jpvor_rvo ) ! Relative Vorticity 164 CASE ( jpdyn_trd_pvo ) ; CALL trd_vor_zint( ptrdx, ptrdy, jpvor_pvo ) ! Planetary Vorticity Term 165 CASE ( jpdyn_trd_ldf ) ; CALL trd_vor_zint( ptrdx, ptrdy, jpvor_ldf ) ! Horizontal Diffusion 166 CASE ( jpdyn_trd_zad ) ; CALL trd_vor_zint( ptrdx, ptrdy, jpvor_zad ) ! Vertical Advection 167 CASE ( jpdyn_trd_spg ) ; CALL trd_vor_zint( ptrdx, ptrdy, jpvor_spg ) ! Surface Pressure Grad. 168 CASE ( jpdyn_trd_dat ) ; CALL trd_vor_zint( ptrdx, ptrdy, jpvor_bev ) ! Beta V 169 CASE ( jpdyn_trd_zdf ) ! Vertical Diffusion 170 ! subtract surface forcing/bottom friction trends 171 ! from vertical diffusive momentum trends 172 ztswu(:,:) = 0.e0 ; ztswv(:,:) = 0.e0 173 ztbfu(:,:) = 0.e0 ; ztbfv(:,:) = 0.e0 174 DO jj = 2, jpjm1 175 DO ji = fs_2, fs_jpim1 ! vector opt. 176 ! save the surface forcing momentum fluxes 177 ztswu(ji,jj) = taux(ji,jj) / ( fse3u(ji,jj,1)*rau0 ) 178 ztswv(ji,jj) = tauy(ji,jj) / ( fse3v(ji,jj,1)*rau0 ) 179 ! save bottom friction momentum fluxes 180 ikbu = MIN( mbathy(ji+1,jj ), mbathy(ji,jj) ) 181 ikbv = MIN( mbathy(ji ,jj+1), mbathy(ji,jj) ) 182 ikbum1 = MAX( ikbu-1, 1 ) 183 ikbvm1 = MAX( ikbv-1, 1 ) 184 zua = ua(ji,jj,ikbum1) * r2dt + ub(ji,jj,ikbum1) 185 zva = va(ji,jj,ikbvm1) * r2dt + vb(ji,jj,ikbvm1) 186 ztbfu(ji,jj) = - avmu(ji,jj,ikbu) * zua / ( fse3u(ji,jj,ikbum1)*fse3uw(ji,jj,ikbu) ) 187 ztbfv(ji,jj) = - avmv(ji,jj,ikbv) * zva / ( fse3v(ji,jj,ikbvm1)*fse3vw(ji,jj,ikbv) ) 188 ! 189 ptrdx(ji,jj,1 ) = ptrdx(ji,jj,1 ) - ztswu(ji,jj) 190 ptrdx(ji,jj,ikbum1) = ptrdx(ji,jj,ikbum1) - ztbfu(ji,jj) 191 ptrdy(ji,jj,1 ) = ptrdy(ji,jj,1 ) - ztswv(ji,jj) 192 ptrdy(ji,jj,ikbvm1) = ptrdy(ji,jj,ikbvm1) - ztbfv(ji,jj) 193 END DO 194 END DO 195 ! 196 CALL trd_vor_zint( ptrdx, ptrdy, jpvor_zdf ) 197 CALL trd_vor_zint( ztswu, ztswv, jpvor_swf ) ! Wind stress forcing term 198 CALL trd_vor_zint( ztbfu, ztbfv, jpvor_bfr ) ! Bottom friction term 199 END SELECT 200 ! 201 ENDIF 202 203 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 204 ! III. Mixed layer trends for active tracers 205 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 206 207 IF( lk_trdmld .AND. ctype == 'TRA' ) THEN 208 209 !----------------------------------------------------------------------------------------------- 210 ! W.A.R.N.I.N.G : 211 ! jptra_trd_ldf : called by traldf.F90 212 ! at this stage we store: 213 ! - the lateral geopotential diffusion (here, lateral = horizontal) 214 ! - and the iso-neutral diffusion if activated 215 ! jptra_trd_zdf : called by trazdf.F90 216 ! * in case of iso-neutral diffusion we store the vertical diffusion component in the 217 ! lateral trend including the K_z contrib, which will be removed later (see trd_mld) 218 !----------------------------------------------------------------------------------------------- 219 220 SELECT CASE ( ktrd ) 221 CASE ( jptra_trd_xad ) ; CALL trd_mld_zint( ptrdx, ptrdy, jpmld_xad, '3D' ) ! merid. advection 222 CASE ( jptra_trd_yad ) ; CALL trd_mld_zint( ptrdx, ptrdy, jpmld_yad, '3D' ) ! zonal advection 223 CASE ( jptra_trd_zad ) ; CALL trd_mld_zint( ptrdx, ptrdy, jpmld_zad, '3D' ) ! vertical advection 224 CASE ( jptra_trd_ldf ) ; CALL trd_mld_zint( ptrdx, ptrdy, jpmld_ldf, '3D' ) ! lateral diffusive 225 CASE ( jptra_trd_bbl ) ; CALL trd_mld_zint( ptrdx, ptrdy, jpmld_bbl, '3D' ) ! bottom boundary layer 226 CASE ( jptra_trd_zdf ) 227 IF( ln_traldf_iso ) THEN 228 CALL trd_mld_zint( ptrdx, ptrdy, jpmld_ldf, '3D' ) ! vertical diffusion (K_z) 229 ELSE 230 CALL trd_mld_zint( ptrdx, ptrdy, jpmld_zdf, '3D' ) ! vertical diffusion (K_z) 231 ENDIF 232 CASE ( jptra_trd_dmp ) ; CALL trd_mld_zint( ptrdx, ptrdy, jpmld_dmp, '3D' ) ! internal 3D restoring (tradmp) 233 CASE ( jptra_trd_qsr ) ; CALL trd_mld_zint( ptrdx, ptrdy, jpmld_for, '3D' ) ! air-sea : penetrative sol radiat 234 CASE ( jptra_trd_nsr ) 235 ptrdx(:,:,2:jpk) = 0.e0 ; ptrdy(:,:,2:jpk) = 0.e0 236 CALL trd_mld_zint( ptrdx, ptrdy, jpmld_for, '2D' ) ! air-sea : non penetr sol radiat 237 CASE ( jptra_trd_bbc ) ; CALL trd_mld_zint( ptrdx, ptrdy, jpmld_bbc, '3D' ) ! bottom bound cond (geoth flux) 238 CASE ( jptra_trd_atf ) ; CALL trd_mld_zint( ptrdx, ptrdy, jpmld_atf, '3D' ) ! asselin numerical 239 CASE ( jptra_trd_npc ) ; CALL trd_mld_zint( ptrdx, ptrdy, jpmld_npc, '3D' ) ! non penetr convect adjustment 240 END SELECT 241 242 ENDIF 243 244 END SUBROUTINE trd_mod 245 246 # else 247 !!---------------------------------------------------------------------- 248 !! Default case : Empty module 249 !!---------------------------------------------------------------------- 250 USE trdmod_oce ! ocean variables trends 251 USE trdvor ! ocean vorticity trends 252 USE trdicp ! ocean bassin integral constraints properties 253 USE trdmld ! ocean active mixed layer tracers trends 254 255 CONTAINS 256 SUBROUTINE trd_mod(ptrd3dx, ptrd3dy, ktrd , ctype, kt, cnbpas) ! Empty routine 257 REAL, DIMENSION(:,:,:), INTENT( in ) :: & 258 ptrd3dx, & ! Temperature or U trend 259 ptrd3dy ! Salinity or V trend 260 INTEGER, INTENT( in ) :: ktrd ! momentum or tracer trend index 261 INTEGER, INTENT( in ) :: kt ! Time step 262 CHARACTER(len=3), INTENT( in ) :: ctype ! momentum or tracers trends type 263 CHARACTER(len=3), INTENT( in ), OPTIONAL :: cnbpas ! number of passage 264 WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', ptrd3dx(1,1,1) 265 WRITE(*,*) ' " ": You should not have seen this print! error ?', ptrd3dy(1,1,1) 266 WRITE(*,*) ' " ": You should not have seen this print! error ?', ktrd 267 WRITE(*,*) ' " ": You should not have seen this print! error ?', ctype 268 WRITE(*,*) ' " ": You should not have seen this print! error ?', kt 269 WRITE(*,*) ' " ": You should not have seen this print! error ?', cnbpas 270 END SUBROUTINE trd_mod 271 # endif 272 273 SUBROUTINE trd_mod_init 274 !!---------------------------------------------------------------------- 275 !! *** ROUTINE trd_mod_init *** 276 !! 277 !! ** Purpose : Initialization of activated trends 278 !!---------------------------------------------------------------------- 279 USE in_out_manager ! I/O manager 280 281 NAMELIST/namtrd/ ntrd, nctls, ln_trdmld_restart, ucf, ln_trdmld_instant 282 !!---------------------------------------------------------------------- 283 284 IF( l_trdtra .OR. l_trddyn ) THEN 285 REWIND( numnam ) 286 READ ( numnam, namtrd ) ! namelist namtrd : trends diagnostic 287 288 IF(lwp) THEN 289 WRITE(numout,*) 290 WRITE(numout,*) ' trd_mod_init : Momentum/Tracers trends' 291 WRITE(numout,*) ' ~~~~~~~~~~~~~' 292 WRITE(numout,*) ' Namelist namtrd : set trends parameters' 293 WRITE(numout,*) ' * frequency of trends diagnostics ntrd = ', ntrd 294 WRITE(numout,*) ' * control surface type nctls = ', nctls 295 WRITE(numout,*) ' * restart for ML diagnostics ln_trdmld_restart = ', ln_trdmld_restart 296 WRITE(numout,*) ' * instantaneous or mean ML T/S ln_trdmld_instant = ', ln_trdmld_instant 297 WRITE(numout,*) ' * unit conversion factor ucf = ', ucf 298 ENDIF 299 ENDIF 300 ! 301 IF( lk_trddyn .OR. lk_trdtra ) CALL trd_icp_init ! integral constraints trends 302 IF( lk_trdmld ) CALL trd_mld_init ! mixed-layer trends (active tracers) 303 IF( lk_trdvor ) CALL trd_vor_init ! vorticity trends 304 ! 305 END SUBROUTINE trd_mod_init 11 #endif 306 12 307 13 !!====================================================================== 308 END MODULE tr dmod14 END MODULE trends_manager -
branches/dev_001_GM/NEMO/OPA_SRC/ZDF/zdfkpp.F90
r719 r790 1291 1291 ztrds(:,:,:) = sa(:,:,:) - ztrds(:,:,:) 1292 1292 !!bug gm jpttdzdf ==> jpttkpp 1293 CALL trd_mod(ztrdt, ztrds, jpt ra_trd_zdf, 'TRA', kt)1293 CALL trd_mod(ztrdt, ztrds, jpt_trd_zdf, 'TRA', kt) 1294 1294 ENDIF 1295 1295 -
branches/dev_001_GM/NEMO/OPA_SRC/oce.F90
r719 r790 4 4 !! Ocean : dynamics and active tracers defined in memory 5 5 !!====================================================================== 6 !! History : 7 !! 8.5 ! 02-11 (G. Madec) F90: Free form and module 8 !! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization 6 !! History : 1.0 ! 02-11 (G. Madec) F90: Free form and module 7 !! 2.0 ! 05-11 (V. Garnier) Surface pressure gradient organization 9 8 !!---------------------------------------------------------------------- 10 !! OPA 9.0 , LOCEAN-IPSL (2005)11 !! $ Header$12 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt9 !! NEMO/OPA 2.0 , LOCEAN-IPSL (2007) 10 !! $Id:$ 11 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 13 12 !!---------------------------------------------------------------------- 14 !! * Modules used15 13 USE par_oce ! ocean parameters 16 14 17 15 IMPLICIT NONE 18 16 PRIVATE 17 19 18 20 19 !! Physics and algorithm flags … … 23 22 INTEGER, PUBLIC :: nn_dynhpg_rst = 0 !: add dynhpg implicit variables in restart ot not 24 23 25 !! dynamics and tracer fields 26 !! -------------------------- 27 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: & !: 28 ! before ! now ! after ! ! the after trends becomes the fields 29 ! fields ! fields ! trends ! ! only in dyn(tra)_zdf and dyn(tra)_nxt 30 ub , un , ua , & !: i-horizontal velocity (m/s) 31 vb , vn , va , & !: j-horizontal velocity (m/s) 32 wn , & !: vertical velocity (m/s) 33 rotb , rotn , & !: relative vorticity (1/s) 34 hdivb , hdivn , & !: horizontal divergence (1/s) 35 tb , tn , ta , & !: potential temperature (celcius) 36 sb , sn , sa !: salinity (psu) 37 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: & !: 38 rhd , & !: in situ density anomalie rhd=(rho-rau0)/rau0 (no units) 39 rhop, & !: potential volumic mass (kg/m3) 40 rn2 !: brunt-vaisala frequency (1/s2) 24 !! dynamics and tracer fields ! before ! now ! after ! the after trends becomes the fields 25 !! -------------------------- ! fields ! fields ! trends ! only in dyn(tra)_zdf and dyn(tra)_nxt 26 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: ub , un , ua !: i-horizontal velocity (m/s) 27 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: vb , vn , va !: j-horizontal velocity (m/s) 28 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: wn !: vertical velocity (m/s) 29 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: rotb , rotn !: relative vorticity (1/s) 30 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: hdivb , hdivn !: horizontal divergence (1/s) 31 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: tb , tn , ta !: potential temperature (celcius) 32 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: sb , sn , sa !: salinity (psu) 33 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: rhd !: in situ density anomalie rhd=(rho-rau0)/rau0 34 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: rhop !: potential volumic mass (kg/m3) 35 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: rn2 !: brunt-vaisala frequency (1/s2) 41 36 42 37 !! advection scheme choice 43 38 !! ----------------------- 39 !!gm only for trcadv... be be suppressed 44 40 CHARACTER(len=3), PUBLIC :: l_adv !: 'ce2' centre scheme used 45 41 ! !: 'tvd' TVD scheme used … … 49 45 !! surface pressure gradient 50 46 !! ------------------------- 51 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & !: 52 spgu, spgv !: horizontal surface pressure gradient 47 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: spgu, spgv !: horizontal surface pressure gradient 53 48 54 49 !! interpolated gradient (only used in zps case) 55 50 !! --------------------- 56 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & !: 57 gtu, gsu, gru, & !: t-, s- and rd horizontal gradient at u- and 58 gtv, gsv, grv !: v-points at bottom ocean level 51 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: gtu, gsu, gru !: t-, s- and rd horizontal gradient at u- and 52 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: gtv, gsv, grv !: v-points at bottom ocean level 59 53 60 54 !! free surface 61 55 !! ------------ 62 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & !: 63 sshb , sshn , & !: before, now sea surface height (meters) 64 sshu , sshv , & !: sea surface height at u- and v- point 65 sshbb, ssha !: before before sea surface height at t-point 56 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: sshb , sshn !: before, now sea surface height (meters) 57 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: sshu , sshv !: sea surface height at u- and v- point 58 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: sshbb, ssha !: before before sea surface height at t-point 66 59 67 60 #if defined key_dynspg_rl || defined key_esopa 68 61 !! rigid-lid formulation 69 62 !! --------------------- 70 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & !: 71 bsfb, bsfn, & !: before, now barotropic streamfunction (m3/s) 72 bsfd !: now trend of barotropic streamfunction (m3/s2) 63 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: bsfb, bsfn !: before, now barotropic streamfunction [m3/s] 64 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: bsfd !: now barotropic streamfunction trend [m3/s2] 73 65 #endif 66 74 67 !!---------------------------------------------------------------------- 75 68 END MODULE oce -
branches/dev_001_GM/NEMO/OPA_SRC/par_oce.F90
r778 r790 9 9 !!---------------------------------------------------------------------- 10 10 !! NEMO/OPA 2.4 , LOCEAN-IPSL (2007) 11 !! $Id :$11 !! $Id$ 12 12 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 13 13 !!---------------------------------------------------------------------- … … 98 98 #endif 99 99 100 !!--------------------------------------------------------------------- 101 !! Temperature/salinity indices 102 !!--------------------------------------------------------------------- 103 104 INTEGER, PARAMETER :: jp_tem = 1 !: index of temperature in the tsb, tsns &, tsa arrays 105 INTEGER, PARAMETER :: jp_sal = 2 !: index of salinity in the tsb, tsns &, tsa arrays 106 107 100 108 !!====================================================================== 101 109 END MODULE par_oce -
branches/dev_001_GM/NEMO/OPA_SRC/prtctl.F90
r719 r790 1 1 MODULE prtctl 2 !!====================================================================== ========2 !!====================================================================== 3 3 !! *** MODULE prtctl *** 4 4 !! Ocean system : print all SUM trends for each processor domain 5 !!============================================================================== 5 !!====================================================================== 6 !! History : 2.0 ! 05-07 (C. Talandier) original code 7 !!---------------------------------------------------------------------- 6 8 USE dom_oce ! ocean space and time domain variables 7 9 USE in_out_manager ! I/O manager … … 11 13 PRIVATE 12 14 13 !! * Module declaration14 15 INTEGER, DIMENSION(:), ALLOCATABLE :: numid 15 INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: & !: 16 nlditl , nldjtl , & !: first, last indoor index for each i-domain 16 INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: nlditl , nldjtl , & !: first, last indoor index for each i-domain 17 17 nleitl , nlejtl , & !: first, last indoor index for each j-domain 18 18 nimpptl, njmpptl, & !: i-, j-indexes for each processor … … 20 20 ibonitl, ibonjtl 21 21 22 REAL(wp), DIMENSION(:), ALLOCATABLE :: & !: 23 t_ctll , s_ctll , & !: previous trend values 22 REAL(wp), DIMENSION(:), ALLOCATABLE :: t_ctll , s_ctll , & !: previous trend values 24 23 u_ctll , v_ctll 25 24 26 25 INTEGER :: ktime !: time step 27 26 28 !! * Routine accessibility29 27 PUBLIC prt_ctl ! called by all subroutines 30 28 PUBLIC prt_ctl_info ! called by all subroutines 31 29 PUBLIC prt_ctl_init ! called by opa.F90 30 32 31 !!---------------------------------------------------------------------- 33 !! OPA 9.0 , LOCEAN-IPSL (2005)34 !! $ Header$35 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt32 !! NEMO/OPA 2.4 , LOCEAN-IPSL (2008) 33 !! $Id:$ 34 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 36 35 !!---------------------------------------------------------------------- 37 36 … … 74 73 !! kdim : k- direction for 3D arrays 75 74 !! clinfo3 : additional information 76 !! 77 !! History : 78 !! 9.0 ! 05-07 (C. Talandier) original code 79 !!---------------------------------------------------------------------- 80 !! * Arguments 75 !!---------------------------------------------------------------------- 81 76 REAL(wp), DIMENSION(:,:) , INTENT(in), OPTIONAL :: tab2d_1 82 77 REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL :: tab3d_1 … … 90 85 INTEGER , INTENT(in), OPTIONAL :: kdim 91 86 CHARACTER (len=*) , INTENT(in), OPTIONAL :: clinfo3 92 93 !! * Local declarations 94 INTEGER :: overlap, jn, sind, eind, kdir,j_id 87 !! 95 88 CHARACTER (len=15) :: cl2 96 REAL(wp) :: zsum1, zsum2, zvctl1, zvctl2 89 INTEGER :: overlap, jn, sind, eind, kdir,j_id 90 REAL(wp) :: zsum1, zsum2, zvctl1, zvctl2 97 91 REAL(wp), DIMENSION(jpi,jpj) :: ztab2d_1, ztab2d_2 98 92 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask1, zmask2, ztab3d_1, ztab3d_2 … … 125 119 IF( PRESENT(mask2) ) zmask2 (:,:,:)= mask2 (:,:,:) 126 120 127 IF( lk_mpp ) THEN 128 ! processor number 121 IF( lk_mpp ) THEN ! processor number 129 122 sind = narea 130 123 eind = narea 131 ELSE 132 ! processors total number 124 ELSE ! processors total number 133 125 sind = 1 134 126 eind = ijsplt -
branches/dev_001_GM/NEMO/OPA_SRC/step.F90
r719 r790 4 4 !! Time-stepping : manager of the ocean, tracer and ice time stepping 5 5 !!====================================================================== 6 !! History : ! 91-03 () Original code 7 !! ! 91-11 (G. Madec) 8 !! ! 92-06 (M. Imbard) add a first output record 9 !! ! 96-04 (G. Madec) introduction of dynspg 10 !! ! 96-04 (M.A. Foujols) introduction of passive tracer 11 !! 8.0 ! 97-06 (G. Madec) new architecture of call 12 !! 8.2 ! 97-06 (G. Madec, M. Imbard, G. Roullet) free surface 13 !! 8.2 ! 99-02 (G. Madec, N. Grima) hpg implicit 14 !! 8.2 ! 00-07 (J-M Molines, M. Imbard) Open Bondary Conditions 15 !! 9.0 ! 02-06 (G. Madec) free form, suppress macro-tasking 16 !! " " ! 04-08 (C. Talandier) New trends organization 17 !! " " ! 05-01 (C. Ethe) Add the KPP closure scheme 18 !! " " ! 05-11 (V. Garnier) Surface pressure gradient organization 19 !! " " ! 05-11 (G. Madec) Reorganisation of tra and dyn calls 20 !! " " ! 06-01 (L. Debreu, C. Mazauric) Agrif implementation 21 !! " " ! 06-07 (S. Masson) restart using iom 6 !! History : ! 1991-03 () Original code 7 !! ! 1991-11 (G. Madec) 8 !! ! 1992-06 (M. Imbard) add a first output record 9 !! ! 1996-04 (G. Madec) introduction of dynspg 10 !! ! 1996-04 (M.A. Foujols) introduction of passive tracer 11 !! 8.0 ! 1997-06 (G. Madec) new architecture of call 12 !! 8.2 ! 1997-06 (G. Madec, M. Imbard, G. Roullet) free surface 13 !! 8.2 ! 1999-02 (G. Madec, N. Grima) hpg implicit 14 !! 8.2 ! 2000-07 (J-M Molines, M. Imbard) Open Bondary Conditions 15 !! NEMO 1.0 ! 2002-06 (G. Madec) free form, suppress macro-tasking 16 !! - ! 2004-08 (C. Talandier) New trends organization 17 !! - ! 2005-01 (C. Ethe) Add the KPP closure scheme 18 !! - ! 2005-11 (V. Garnier) Surface pressure gradient organization 19 !! - ! 2005-11 (G. Madec) Reorganisation of tra and dyn calls 20 !! 2.0 ! 2006-01 (L. Debreu, C. Mazauric) Agrif implementation 21 !! - ! 2006-07 (S. Masson) restart using iom 22 !! 2.4 ! 2008-01 (G. Madec) Merge TRA-TRC 22 23 !!---------------------------------------------------------------------- 23 24 !! stp : OPA system time-stepping … … 323 324 IF( lk_trabbl_adv ) CALL tra_bbl_adv( kstp ) ! advective (and/or diffusive) bottom boundary layer scheme 324 325 325 IF( lk_tradmp ) CALL tra_dmp ( kstp ) ! internal damping trends 326 IF( lk_tradmp ) THEN ! internal damping trends 327 CALL tra_dmp ( kstp, 'TRA', jp_tem, tb, ta ) ! temperature 328 CALL tra_dmp ( kstp, 'TRA', jp_sal, sb, sa ) ! salinity 329 ENDIF 326 330 327 331 CALL tra_adv ( kstp ) ! horizontal & vertical advection -
branches/dev_001_GM/NEMO/TOP_SRC/LOBSTER/trcsed.F90
r777 r790 28 28 !!---------------------------------------------------------------------- 29 29 !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007) 30 !! $Id :$30 !! $Id$ 31 31 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 32 32 !!---------------------------------------------------------------------- … … 90 90 # endif 91 91 # if defined key_trc_diaadd 92 !!gm bug introduced: no more mask below jpkb ! 92 93 trc2d(ji,jj,8) = trc2d(ji,jj,8) + ztra * fse3t(ji,jj,jk) * 86400. 93 94 # endif … … 97 98 98 99 #if defined key_trc_diabio 99 CALL lbc_lnk (trbio(:,:,1,8), 'T', 1. ) ! Lateral boundary conditions on trcbio100 CALL lbc_lnk( trbio(:,:,1,8), 'T', 1. ) ! Lateral boundary conditions on trcbio 100 101 #endif 101 102 #if defined key_trc_diaadd
Note: See TracChangeset
for help on using the changeset viewer.