Changeset 2715 for trunk/NEMOGCM/NEMO/OPA_SRC/DOM
- Timestamp:
- 2011-03-30T17:58:35+02:00 (13 years ago)
- Location:
- trunk/NEMOGCM/NEMO/OPA_SRC/DOM
- Files:
-
- 12 edited
-
closea.F90 (modified) (3 diffs)
-
daymod.F90 (modified) (3 diffs)
-
dom_oce.F90 (modified) (9 diffs)
-
domcfg.F90 (modified) (1 diff)
-
domhgr.F90 (modified) (3 diffs)
-
dommsk.F90 (modified) (6 diffs)
-
domngb.F90 (modified) (3 diffs)
-
domstp.F90 (modified) (3 diffs)
-
domvvl.F90 (modified) (4 diffs)
-
domwri.F90 (modified) (7 diffs)
-
domzgr.F90 (modified) (16 diffs)
-
istate.F90 (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90
r2528 r2715 46 46 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 47 47 !! $Id$ 48 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 49 !!---------------------------------------------------------------------- 50 48 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 49 !!---------------------------------------------------------------------- 51 50 CONTAINS 52 51 … … 181 180 REAL(wp) :: zze2 182 181 REAL(wp), DIMENSION (jpncs) :: zfwf 183 184 182 !!---------------------------------------------------------------------- 185 183 ! … … 366 364 DO jj = ncsj1(jc), ncsj2(jc) 367 365 DO ji = ncsi1(jc), ncsi2(jc) 368 pbat(ji,jj) = 0. e0366 pbat(ji,jj) = 0._wp 369 367 kbat(ji,jj) = 0 370 368 END DO -
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90
r2528 r2715 46 46 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 47 47 !! $Id$ 48 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)48 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 49 49 !!---------------------------------------------------------------------- 50 51 50 CONTAINS 52 51 … … 68 67 !! - nmonth_len, nyear_len, nmonth_half, nmonth_end through day_mth 69 68 !!---------------------------------------------------------------------- 70 INTEGER ::inbday, idweek71 REAL(wp) :: zjul69 INTEGER :: inbday, idweek 70 REAL(wp) :: zjul 72 71 !!---------------------------------------------------------------------- 73 72 … … 129 128 CALL day( nit000 ) 130 129 131 132 130 END SUBROUTINE day_init 133 131 -
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
r2528 r2715 7 7 !! History : 1.0 ! 2005-10 (A. Beckmann, G. Madec) reactivate s-coordinate 8 8 !! 3.3 ! 2010-11 (G. Madec) add mbk. arrays associated to the deepest ocean level 9 !!---------------------------------------------------------------------- 10 USE par_oce ! ocean parameters 9 !! 4.0 ! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation 10 !!---------------------------------------------------------------------- 11 12 !!---------------------------------------------------------------------- 13 !! Agrif_Root : dummy function used when lk_agrif=F 14 !! Agrif_CFixed : dummy function used when lk_agrif=F 15 !! dom_oce_alloc : dynamical allocation of dom_oce arrays 16 !!---------------------------------------------------------------------- 17 USE par_oce ! ocean parameters 11 18 12 19 IMPLICIT NONE 13 PUBLIC ! allows the acces to par_oce when dom_oce is used 14 ! ! exception to coding rules... to be suppressed ??? 20 PUBLIC ! allows the acces to par_oce when dom_oce is used 21 ! ! exception to coding rules... to be suppressed ??? 22 23 PUBLIC dom_oce_alloc ! Called from nemogcm.F90 15 24 16 25 !!---------------------------------------------------------------------- … … 45 54 INTEGER , PUBLIC :: nclosea !: =0 suppress closed sea/lake from the ORCA domain or not (=1) 46 55 47 48 56 ! !!! associated variables 49 57 INTEGER , PUBLIC :: neuler = 0 !: restart euler forward option (0=Euler) 50 58 REAL(wp), PUBLIC :: atfp1 !: asselin time filter coeff. (atfp1= 1-2*atfp) 51 REAL(wp), PUBLIC, DIMENSION(jpk) :: rdttra !: vertical profile of tracer time step 59 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: rdttra !: vertical profile of tracer time step 60 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: r2dtra !: = 2*rdttra except at nit000 (=rdttra) if neuler=0 52 61 53 62 ! !!* Namelist namcla : cross land advection … … 83 92 INTEGER, PUBLIC :: nidom !: ??? 84 93 85 INTEGER, PUBLIC, DIMENSION(jpi):: mig !: local ==> global domain i-index86 INTEGER, PUBLIC, DIMENSION(jpj):: mjg !: local ==> global domain j-index87 INTEGER, PUBLIC, DIMENSION(jpidta) :: mi0, mi1 !: global ==> local domain i-index !!bug ==> other solution?94 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: mig !: local ==> global domain i-index 95 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: mjg !: local ==> global domain j-index 96 INTEGER, PUBLIC, DIMENSION(jpidta) :: mi0, mi1 !: global ==> local domain i-index !!bug ==> other solution? 88 97 ! ! (mi0=1 and mi1=0 if the global index is not in the local domain) 89 INTEGER, PUBLIC, DIMENSION(jpjdta) :: mj0, mj1 !: global ==> local domain j-index !!bug ==> other solution?98 INTEGER, PUBLIC, DIMENSION(jpjdta) :: mj0, mj1 !: global ==> local domain j-index !!bug ==> other solution? 90 99 ! ! (mi0=1 and mi1=0 if the global index is not in the local domain) 91 INTEGER, PUBLIC, DIMENSION(jpnij):: nimppt, njmppt !: i-, j-indexes for each processor92 INTEGER, PUBLIC, DIMENSION(jpnij):: ibonit, ibonjt !: i-, j- processor neighbour existence93 INTEGER, PUBLIC, DIMENSION(jpnij):: nlcit , nlcjt !: dimensions of every subdomain94 INTEGER, PUBLIC, DIMENSION(jpnij):: nldit , nldjt !: first, last indoor index for each i-domain95 INTEGER, PUBLIC, DIMENSION(jpnij):: nleit , nlejt !: first, last indoor index for each j-domain100 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: nimppt, njmppt !: i-, j-indexes for each processor 101 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ibonit, ibonjt !: i-, j- processor neighbour existence 102 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: nlcit , nlcjt !: dimensions of every subdomain 103 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: nldit , nldjt !: first, last indoor index for each i-domain 104 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: nleit , nlejt !: first, last indoor index for each j-domain 96 105 97 106 !!---------------------------------------------------------------------- 98 107 !! horizontal curvilinear coordinate and scale factors 99 108 !! --------------------------------------------------------------------- 100 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: glamt, glamu !: longitude of t-, u-, v- and f-points (degre) 101 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: glamv, glamf !: 102 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: gphit, gphiu !: latitude of t-, u-, v- and f-points (degre) 103 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: gphiv, gphif !: 104 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: e1t, e2t !: horizontal scale factors at t-point (m) 105 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: e1u, e2u !: horizontal scale factors at u-point (m) 106 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: e1v, e2v !: horizontal scale factors at v-point (m) 107 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: e1f, e2f !: horizontal scale factors at f-point (m) 108 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: ff !: coriolis factor (2.*omega*sin(yphi) ) (s-1) 109 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: glamt, glamu !: longitude of t-, u-, v- and f-points (degre) 110 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: glamv, glamf !: 111 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: gphit, gphiu !: latitude of t-, u-, v- and f-points (degre) 112 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: gphiv, gphif !: 113 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e1t, e2t !: horizontal scale factors at t-point (m) 114 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e1u, e2u !: horizontal scale factors at u-point (m) 115 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e1v, e2v !: horizontal scale factors at v-point (m) 116 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e1f, e2f !: horizontal scale factors at f-point (m) 117 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e1e2t !: surface at t-point (m2) 118 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ff !: coriolis factor (2.*omega*sin(yphi) ) (s-1) 109 119 110 120 !!---------------------------------------------------------------------- … … 118 128 !! All coordinates 119 129 !! --------------- 120 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: gdep3w !: depth of T-points (sum of e3w) (m)121 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: gdept , gdepw !: analytical depth at T-W points (m)122 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: e3v , e3f !: analytical vertical scale factors at V--F123 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: e3t , e3u !: T--U points (m)124 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: e3vw !: analytical vertical scale factors at VW--125 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: e3w , e3uw !: W--UW points (m)130 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdep3w !: depth of T-points (sum of e3w) (m) 131 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdept , gdepw !: analytical depth at T-W points (m) 132 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3v , e3f !: analytical vertical scale factors at V--F 133 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3t , e3u !: T--U points (m) 134 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3vw !: analytical vertical scale factors at VW-- 135 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3w , e3uw !: W--UW points (m) 126 136 #if defined key_vvl 127 137 LOGICAL, PUBLIC, PARAMETER :: lk_vvl = .TRUE. !: variable grid flag … … 129 139 !! All coordinates 130 140 !! --------------- 131 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: gdep3w_1 !: depth of T-points (sum of e3w) (m)132 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: gdept_1, gdepw_1 !: analytical depth at T-W points (m)133 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: e3v_1 , e3f_1 !: analytical vertical scale factors at V--F134 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: e3t_1 , e3u_1 !: T--U points (m)135 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: e3vw_1 !: analytical vertical scale factors at VW--136 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: e3w_1 , e3uw_1 !: W--UW points (m)137 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: e3t_b !: before - - - - T points (m)138 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: e3u_b , e3v_b !: - - - - - U--V points (m)141 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdep3w_1 !: depth of T-points (sum of e3w) (m) 142 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdept_1, gdepw_1 !: analytical depth at T-W points (m) 143 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3v_1 , e3f_1 !: analytical vertical scale factors at V--F 144 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3t_1 , e3u_1 !: T--U points (m) 145 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3vw_1 !: analytical vertical scale factors at VW-- 146 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3w_1 , e3uw_1 !: W--UW points (m) 147 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3t_b !: before - - - - T points (m) 148 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3u_b , e3v_b !: - - - - - U--V points (m) 139 149 #else 140 150 LOGICAL, PUBLIC, PARAMETER :: lk_vvl = .FALSE. !: fixed grid flag 141 151 #endif 142 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: hur , hvr !: inverse of u and v-points ocean depth (1/m)143 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: hu , hv !: depth at u- and v-points (meters)144 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: hu_0 , hv_0 !: refernce depth at u- and v-points (meters)152 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hur , hvr !: inverse of u and v-points ocean depth (1/m) 153 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu , hv !: depth at u- and v-points (meters) 154 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu_0 , hv_0 !: refernce depth at u- and v-points (meters) 145 155 146 156 INTEGER, PUBLIC :: nla10 !: deepest W level Above ~10m (nlb10 - 1) … … 149 159 !! z-coordinate with full steps (also used in the other cases as reference z-coordinate) 150 160 !! =-----------------====------ 151 REAL(wp), PUBLIC, DIMENSION(jpk) :: gdept_0, gdepw_0!: reference depth of t- and w-points (m)152 REAL(wp), PUBLIC, DIMENSION(jpk) :: e3t_0 , e3w_0!: reference vertical scale factors at T- and W-pts (m)153 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: e3tp , e3wp!: ocean bottom level thickness at T and W points161 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: gdept_0, gdepw_0 !: reference depth of t- and w-points (m) 162 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: e3t_0 , e3w_0 !: reference vertical scale factors at T- and W-pts (m) 163 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e3tp , e3wp !: ocean bottom level thickness at T and W points 154 164 155 165 !! s-coordinate and hybrid z-s-coordinate 156 166 !! =----------------======--------------- 157 REAL(wp), PUBLIC, DIMENSION(jpk) :: gsigt, gsigw !: model level depth coefficient at t-, w-levels (analytic)158 REAL(wp), PUBLIC, DIMENSION(jpk) :: gsi3w !: model level depth coefficient at w-level (sum of gsigw)159 REAL(wp), PUBLIC, DIMENSION(jpk) :: esigt, esigw !: vertical scale factor coef. at t-, w-levels160 161 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: hbatv , hbatf !: ocean depth at the vertical of V--F162 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: hbatt , hbatu !: T--U points (m)163 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: scosrf, scobot !: ocean surface and bottom topographies164 ! 165 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: hifv , hiff !: interface depth between stretching at V--F166 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: hift , hifu !: and quasi-uniform spacing T--U points (m)167 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: gsigt, gsigw !: model level depth coefficient at t-, w-levels (analytic) 168 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: gsi3w !: model level depth coefficient at w-level (sum of gsigw) 169 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: esigt, esigw !: vertical scale factor coef. at t-, w-levels 170 171 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hbatv , hbatf !: ocean depth at the vertical of V--F 172 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hbatt , hbatu !: T--U points (m) 173 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: scosrf, scobot !: ocean surface and bottom topographies 174 ! ! (if deviating from coordinate surfaces in HYBRID) 175 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hifv , hiff !: interface depth between stretching at V--F 176 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hift , hifu !: and quasi-uniform spacing T--U points (m) 167 177 168 178 !!---------------------------------------------------------------------- 169 179 !! masks, bathymetry 170 180 !! --------------------------------------------------------------------- 171 INTEGER , PUBLIC, DIMENSION(jpi,jpj) :: mbathy !: number of ocean level (=0, 1, ... , jpk-1)172 INTEGER , PUBLIC, DIMENSION(jpi,jpj) :: mbkt !: vertical index of the bottom last T- ocean level173 INTEGER , PUBLIC, DIMENSION(jpi,jpj) :: mbku, mbkv !: vertical index of the bottom last U- and W- ocean level174 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: bathy !: ocean depth (meters)175 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: tmask_i !: interior domain T-point mask176 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: bmask !: land/ocean mask of barotropic stream function177 178 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::tmask, umask, vmask, fmask !: land/ocean mask at T-, U-, V- and F-pts181 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mbathy !: number of ocean level (=0, 1, ... , jpk-1) 182 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mbkt !: vertical index of the bottom last T- ocean level 183 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mbku, mbkv !: vertical index of the bottom last U- and W- ocean level 184 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: bathy !: ocean depth (meters) 185 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmask_i !: interior domain T-point mask 186 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: bmask !: land/ocean mask of barotropic stream function 187 188 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tmask, umask, vmask, fmask !: land/ocean mask at T-, U-, V- and F-pts 179 189 180 190 REAL(wp), PUBLIC, DIMENSION(jpiglo) :: tpol, fpol !: north fold mask (jperio= 3 or 4) 181 191 182 192 #if defined key_noslip_accurate 183 INTEGER, PUBLIC, DIMENSION (4,jpk) :: npcoa!: ???184 INTEGER, PUBLIC, DIMENSION(2*(jpi+jpj),4,jpk) :: nicoa, njcoa!: ???193 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,: ) :: npcoa !: ??? 194 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: nicoa, njcoa !: ??? 185 195 #endif 186 196 … … 215 225 LOGICAL, PUBLIC, PARAMETER :: lk_mpp_rep = .FALSE. !: agrif flag 216 226 #endif 227 217 228 !!---------------------------------------------------------------------- 218 229 !! agrif domain … … 222 233 #else 223 234 LOGICAL, PUBLIC, PARAMETER :: lk_agrif = .FALSE. !: agrif flag 224 235 #endif 236 237 !!---------------------------------------------------------------------- 238 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 239 !! $Id$ 240 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 241 !!---------------------------------------------------------------------- 225 242 CONTAINS 243 244 #if ! defined key_agrif 245 !!---------------------------------------------------------------------- 246 !! NOT 'key_agrif' dummy function No AGRIF zoom 247 !!---------------------------------------------------------------------- 226 248 LOGICAL FUNCTION Agrif_Root() 227 249 Agrif_Root = .TRUE. … … 229 251 230 252 CHARACTER(len=3) FUNCTION Agrif_CFixed() 231 Agrif_CFixed = '0'253 Agrif_CFixed = '0' 232 254 END FUNCTION Agrif_CFixed 233 255 #endif 234 !!---------------------------------------------------------------------- 235 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 236 !! $Id$ 237 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 256 257 INTEGER FUNCTION dom_oce_alloc() 258 !!---------------------------------------------------------------------- 259 INTEGER, DIMENSION(11) :: ierr 260 !!---------------------------------------------------------------------- 261 ierr(:) = 0 262 ! 263 ALLOCATE( rdttra(jpk), r2dtra(jpk), mig(jpi), mjg(jpj), STAT=ierr(1) ) 264 ! 265 ALLOCATE( nimppt(jpnij) , ibonit(jpnij) , nlcit(jpnij) , nlcjt(jpnij) , & 266 & njmppt(jpnij) , ibonjt(jpnij) , nldit(jpnij) , nldjt(jpnij) , & 267 & nleit(jpnij) , nlejt(jpnij) , STAT=ierr(2) ) 268 ! 269 ALLOCATE( glamt(jpi,jpj) , gphit(jpi,jpj) , e1t(jpi,jpj) , e2t(jpi,jpj) , & 270 & glamu(jpi,jpj) , gphiu(jpi,jpj) , e1u(jpi,jpj) , e2u(jpi,jpj) , & 271 & glamv(jpi,jpj) , gphiv(jpi,jpj) , e1v(jpi,jpj) , e2v(jpi,jpj) , e1e2t(jpi,jpj) , & 272 & glamf(jpi,jpj) , gphif(jpi,jpj) , e1f(jpi,jpj) , e2f(jpi,jpj) , ff (jpi,jpj) , STAT=ierr(3) ) 273 ! 274 ALLOCATE( gdep3w(jpi,jpj,jpk) , e3v(jpi,jpj,jpk) , e3f (jpi,jpj,jpk) , & 275 & gdept (jpi,jpj,jpk) , e3t(jpi,jpj,jpk) , e3u (jpi,jpj,jpk) , & 276 & gdepw (jpi,jpj,jpk) , e3w(jpi,jpj,jpk) , e3vw(jpi,jpj,jpk) , e3uw(jpi,jpj,jpk) , STAT=ierr(4) ) 277 ! 278 #if defined key_vvl 279 ALLOCATE( gdep3w_1(jpi,jpj,jpk) , e3v_1(jpi,jpj,jpk) , e3f_1 (jpi,jpj,jpk) , & 280 & gdept_1 (jpi,jpj,jpk) , e3t_1(jpi,jpj,jpk) , e3u_1 (jpi,jpj,jpk) , & 281 & gdepw_1 (jpi,jpj,jpk) , e3w_1(jpi,jpj,jpk) , e3vw_1(jpi,jpj,jpk) , e3uw_1(jpi,jpj,jpk) , & 282 & e3t_b (jpi,jpj,jpk) , e3u_b(jpi,jpj,jpk) , e3v_b (jpi,jpj,jpk) , STAT=ierr(5) ) 283 #endif 284 ! 285 ALLOCATE( hu(jpi,jpj) , hur(jpi,jpj) , hu_0(jpi,jpj) , & 286 & hv(jpi,jpj) , hvr(jpi,jpj) , hv_0(jpi,jpj) , STAT=ierr(6) ) 287 ! 288 ALLOCATE( gdept_0(jpk) , gdepw_0(jpk) , & 289 & e3t_0 (jpk) , e3w_0 (jpk) , e3tp (jpi,jpj), e3wp(jpi,jpj) , & 290 & gsigt (jpk) , gsigw (jpk) , gsi3w(jpk) , & 291 & esigt (jpk) , esigw (jpk) , STAT=ierr(7) ) 292 ! 293 ALLOCATE( hbatv (jpi,jpj) , hbatf (jpi,jpj) , & 294 & hbatt (jpi,jpj) , hbatu (jpi,jpj) , & 295 & scosrf(jpi,jpj) , scobot(jpi,jpj) , & 296 & hifv (jpi,jpj) , hiff (jpi,jpj) , & 297 & hift (jpi,jpj) , hifu (jpi,jpj) , STAT=ierr(8) ) 298 299 ALLOCATE( mbathy(jpi,jpj) , bathy(jpi,jpj) , & 300 & tmask_i(jpi,jpj) , bmask(jpi,jpj) , & 301 & mbkt (jpi,jpj) , mbku (jpi,jpj) , mbkv(jpi,jpj) , STAT=ierr(9) ) 302 303 ALLOCATE( tmask(jpi,jpj,jpk) , umask(jpi,jpj,jpk), & 304 & vmask(jpi,jpj,jpk) , fmask(jpi,jpj,jpk), STAT=ierr(10) ) 305 306 #if defined key_noslip_accurate 307 ALLOCATE( npcoa(4,jpk), nicoa(2*(jpi+jpj),4,jpk), njcoa(2*(jpi+jpj),4,jpk), STAT=ierr(11) ) 308 #endif 309 ! 310 dom_oce_alloc = MAXVAL(ierr) 311 ! 312 END FUNCTION dom_oce_alloc 313 238 314 !!====================================================================== 239 315 END MODULE dom_oce -
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domcfg.F90
r2528 r2715 24 24 !! NEMO/OPA 3.2 , LODYC-IPSL (2009) 25 25 !! $Id$ 26 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)26 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 27 27 !!---------------------------------------------------------------------- 28 29 28 CONTAINS 30 29 -
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90
r2528 r2715 14 14 !! use of parameters in par_CONFIG-Rxx.h90, not in namelist 15 15 !! - ! 2004-05 (A. Koch-Larrouy) Add Gyre configuration 16 !! 4.0 ! 2011-02 (G. Madec) add cell surface (e1e2t) 16 17 !!---------------------------------------------------------------------- 17 18 … … 33 34 34 35 !!---------------------------------------------------------------------- 35 !! NEMO/OPA 3.3 , NEMO Consortium (2010)36 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 36 37 !! $Id$ 37 38 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 448 449 449 450 END SELECT 451 452 ! T-cell surface 453 ! -------------- 454 e1e2t(:,:) = e1t(:,:) * e2t(:,:) 450 455 451 456 -
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90
r2528 r2715 34 34 PRIVATE 35 35 36 PUBLIC dom_msk ! routine called by inidom.F90 36 PUBLIC dom_msk ! routine called by inidom.F90 37 PUBLIC dom_msk_alloc ! routine called by nemogcm.F90 37 38 38 39 ! !!* Namelist namlbc : lateral boundary condition * 39 40 REAL(wp) :: rn_shlat = 2. ! type of lateral boundary condition on velocity 40 41 42 INTEGER, ALLOCATABLE, SAVE, DIMENSION(:,:) :: icoord ! Workspace for dom_msk_nsa() 43 41 44 !! * Substitutions 42 45 # include "vectopt_loop_substitute.h90" … … 48 51 CONTAINS 49 52 53 INTEGER FUNCTION dom_msk_alloc() 54 !!--------------------------------------------------------------------- 55 !! *** FUNCTION dom_msk_alloc *** 56 !!--------------------------------------------------------------------- 57 dom_msk_alloc = 0 58 #if defined key_noslip_accurate 59 ALLOCATE(icoord(jpi*jpj*jpk,3), STAT=dom_msk_alloc) 60 #endif 61 IF( dom_msk_alloc /= 0 ) CALL ctl_warn('dom_msk_alloc: failed to allocate icoord array') 62 ! 63 END FUNCTION dom_msk_alloc 64 65 50 66 SUBROUTINE dom_msk 51 67 !!--------------------------------------------------------------------- … … 109 125 !! tmask_i : interior ocean mask 110 126 !!---------------------------------------------------------------------- 127 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released, iwrk_in_use, iwrk_not_released 128 USE wrk_nemo, ONLY: zwf => wrk_2d_1 ! 2D real workspace 129 USE wrk_nemo, ONLY: imsk => iwrk_2d_1 ! 2D integer workspace 130 ! 111 131 INTEGER :: ji, jj, jk ! dummy loop indices 112 INTEGER :: iif, iil, ii0, ii1, ii 113 INTEGER :: ijf, ijl, ij0, ij1 114 INTEGER , DIMENSION(jpi,jpj) :: imsk 115 REAL(wp), DIMENSION(jpi,jpj) :: zwf 132 INTEGER :: iif, iil, ii0, ii1, ii ! local integers 133 INTEGER :: ijf, ijl, ij0, ij1 ! - - 116 134 !! 117 135 NAMELIST/namlbc/ rn_shlat 118 136 !!--------------------------------------------------------------------- 119 137 138 IF( wrk_in_use(2, 1) .OR. iwrk_in_use(2, 1) ) THEN 139 CALL ctl_stop('dom_msk: requested workspace arrays unavailable') ; RETURN 140 ENDIF 141 120 142 REWIND( numnam ) ! Namelist namlbc : lateral momentum boundary condition 121 143 READ ( numnam, namlbc ) … … 414 436 ENDIF 415 437 ! 438 IF( wrk_not_released(2, 1) .OR. & 439 iwrk_not_released(2, 1) ) CALL ctl_stop('dom_msk: failed to release workspace arrays') 440 ! 416 441 END SUBROUTINE dom_msk 417 442 … … 431 456 !! ** Action : 432 457 !!---------------------------------------------------------------------- 433 INTEGER :: ji, jj, jk, jl ! dummy loop indices458 INTEGER :: ji, jj, jk, jl ! dummy loop indices 434 459 INTEGER :: ine, inw, ins, inn, itest, ierror, iind, ijnd 435 460 REAL(wp) :: zaa 436 INTEGER, DIMENSION(jpi*jpj*jpk,3) :: icoord437 461 !!--------------------------------------------------------------------- 438 439 440 IF(lwp)WRITE(numout,*) 441 IF(lwp)WRITE(numout,*) 'dom_msk_nsa : noslip accurate boundary condition' 442 IF(lwp)WRITE(numout,*) '~~~~~~~~~~~ using Schchepetkin and O Brian scheme' 443 IF( lk_mpp ) CALL ctl_stop( ' mpp version is not yet implemented' ) 462 463 IF(lwp) WRITE(numout,*) 464 IF(lwp) WRITE(numout,*) 'dom_msk_nsa : noslip accurate boundary condition' 465 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ using Schchepetkin and O Brian scheme' 466 IF( lk_mpp ) CALL ctl_stop( ' mpp version is not yet implemented' ) 444 467 445 468 ! mask for second order calculation of vorticity … … 596 619 CALL ctl_stop( 'We stop...' ) 597 620 ENDIF 598 621 ! 599 622 END SUBROUTINE dom_msk_nsa 600 623 -
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domngb.F90
r2528 r2715 8 8 9 9 !!---------------------------------------------------------------------- 10 !! dom_ngb : find the closest grid point from a given on/lat position10 !! dom_ngb : find the closest grid point from a given lon/lat position 11 11 !!---------------------------------------------------------------------- 12 USE dom_oce 13 USE lib_mpp 12 USE dom_oce ! ocean space and time domain 13 USE lib_mpp ! for mppsum 14 14 15 15 IMPLICIT NONE 16 16 PRIVATE 17 17 18 PUBLIC dom_ngb 18 PUBLIC dom_ngb ! routine called in iom.F90 module 19 19 20 20 !!---------------------------------------------------------------------- 21 21 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 22 22 !! $Id$ 23 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)23 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 24 24 !!---------------------------------------------------------------------- 25 26 25 CONTAINS 27 26 … … 30 29 !! *** ROUTINE dom_ngb *** 31 30 !! 32 !! ** Purpose : find the closest grid point from a given on/lat position31 !! ** Purpose : find the closest grid point from a given lon/lat position 33 32 !! 34 33 !! ** Method : look for minimum distance in cylindrical projection 35 34 !! -> not good if located at too high latitude... 36 !!37 35 !!---------------------------------------------------------------------- 36 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 37 USE wrk_nemo, ONLY: zglam => wrk_2d_2 , zgphi => wrk_2d_3 , zmask => wrk_2d_4 , zdist => wrk_2d_5 38 ! 38 39 REAL(wp) , INTENT(in ) :: plon, plat ! longitude,latitude of the point 39 40 INTEGER , INTENT( out) :: kii, kjj ! i-,j-index of the closes grid point 40 41 CHARACTER(len=1), INTENT(in ) :: cdgrid ! grid name 'T', 'U', 'V', 'W' 41 !! 42 INTEGER , DIMENSION(2) :: iloc 43 REAL(wp), DIMENSION(jpi,jpj) :: zglam, zgphi, zmask, zdist 44 REAL(wp) :: zlon 45 REAL(wp) :: zmini 42 ! 43 INTEGER , DIMENSION(2) :: iloc 44 REAL(wp) :: zlon, zmini 46 45 !!-------------------------------------------------------------------- 47 48 zmask(:,:) = 0. 46 ! 47 IF( wrk_in_use(2, 2,3,4,5) ) CALL ctl_stop('dom_ngb: Requested workspaces already in use') 48 ! 49 zmask(:,:) = 0._wp 49 50 SELECT CASE( cdgrid ) 50 51 CASE( 'U' ) ; zglam(:,:) = glamu(:,:) ; zgphi(:,:) = gphiu(:,:) ; zmask(nldi:nlei,nldj:nlej) = umask(nldi:nlei,nldj:nlej,1) … … 70 71 kjj = iloc(2) + njmpp - 1 71 72 ENDIF 72 73 ! 74 IF( wrk_not_released(2, 2,3,4,5) ) CALL ctl_stop('dom_ngb: error releasing workspaces') 75 ! 73 76 END SUBROUTINE dom_ngb 74 77 -
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domstp.F90
r2528 r2715 8 8 !! dom_stp : ocean time domain initialization 9 9 !!---------------------------------------------------------------------- 10 !! History : 11 !! ! 90-10 (O. Marti) Original code 12 !! ! 96-01 (G. Madec) terrain following coordinates 13 !! 8.5 ! 02-08 (G. Madec) F90: Free form and module 10 !! History : OPA ! 1990-10 (O. Marti) Original code 11 !! ! 1996-01 (G. Madec) terrain following coordinates 12 !! NEMO 1.0 ! 2002-08 (G. Madec) F90: Free form and module 14 13 !!---------------------------------------------------------------------- 15 !! * Modules used16 USE oce ! ocean dynamics and tracers17 USE dom_oce ! ocean space and time domain18 USE in_out_manager ! I/O manager14 USE oce ! ocean dynamics and tracers 15 USE dom_oce ! ocean space and time domain 16 USE in_out_manager ! I/O manager 17 USE lib_mpp ! MPP library 19 18 20 19 IMPLICIT NONE 21 20 PRIVATE 22 21 23 !! * routine accessibility 24 PUBLIC dom_stp ! routine called by inidom.F90 22 PUBLIC dom_stp ! routine called by inidom.F90 25 23 26 24 !! * Substitutions … … 29 27 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 30 28 !! $Id$ 31 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)29 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 32 30 !!---------------------------------------------------------------------- 33 34 31 CONTAINS 35 32 … … 59 56 !! - atfp1 : = 1 - 2*atfp 60 57 !! 61 !! References : 62 !! Bryan, K., 1984, J. Phys. Oceanogr., 14, 666-673. 58 !! References : Bryan, K., 1984, J. Phys. Oceanogr., 14, 666-673. 63 59 !!---------------------------------------------------------------------- 64 60 INTEGER :: jk ! dummy loop indice -
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
r2528 r2715 24 24 PRIVATE 25 25 26 PUBLIC dom_vvl ! called by domain.F90 27 28 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: ee_t, ee_u, ee_v, ee_f !: ??? 29 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: mut, muu, muv, muf !: ??? 30 31 REAL(wp), DIMENSION(jpk) :: r2dt ! vertical profile time-step, = 2 rdttra 32 ! ! except at nit000 (=rdttra) if neuler=0 26 PUBLIC dom_vvl ! called by domain.F90 27 PUBLIC dom_vvl_alloc ! called by nemogcm.F90 28 29 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ee_t, ee_u, ee_v, ee_f !: ??? 30 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: mut , muu , muv , muf !: ??? 31 32 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: r2dt ! vertical profile time-step, = 2 rdttra 33 ! ! except at nit000 (=rdttra) if neuler=0 33 34 34 35 !! * Substitutions … … 36 37 # include "vectopt_loop_substitute.h90" 37 38 !!---------------------------------------------------------------------- 38 !! NEMO/OPA 3.3 , NEMO Consortium (2010)39 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 39 40 !! $Id$ 40 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 41 !!---------------------------------------------------------------------- 42 41 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 42 !!---------------------------------------------------------------------- 43 43 CONTAINS 44 45 INTEGER FUNCTION dom_vvl_alloc() 46 !!---------------------------------------------------------------------- 47 !! *** ROUTINE dom_vvl_alloc *** 48 !!---------------------------------------------------------------------- 49 ! 50 ALLOCATE( mut (jpi,jpj,jpk) , muu (jpi,jpj,jpk) , muv (jpi,jpj,jpk) , muf (jpi,jpj,jpk) , & 51 & ee_t(jpi,jpj) , ee_u(jpi,jpj) , ee_v(jpi,jpj) , ee_f(jpi,jpj) , & 52 & r2dt (jpk) , STAT=dom_vvl_alloc ) 53 ! 54 IF( lk_mpp ) CALL mpp_sum ( dom_vvl_alloc ) 55 IF( dom_vvl_alloc /= 0 ) CALL ctl_warn('dom_vvl_alloc: failed to allocate arrays') 56 ! 57 END FUNCTION dom_vvl_alloc 58 44 59 45 60 SUBROUTINE dom_vvl … … 50 65 !! ssh over the whole water column (scale factors) 51 66 !!---------------------------------------------------------------------- 52 INTEGER :: ji, jj, jk 53 REAL(wp) :: zcoefu , zcoefv , zcoeff ! temporary scalars 54 REAL(wp) :: zv_t_ij, zv_t_ip1j, zv_t_ijp1, zv_t_ip1jp1 ! - - 55 REAL(wp), DIMENSION(jpi,jpj) :: zs_t, zs_u_1, zs_v_1 ! - 2D workspace 56 !!---------------------------------------------------------------------- 57 58 IF(lwp) THEN 67 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 68 USE wrk_nemo, ONLY: zs_t => wrk_2d_1 , zs_u_1 => wrk_2d_2 , zs_v_1 => wrk_2d_3 ! 2D workspace 69 ! 70 INTEGER :: ji, jj, jk ! dummy loop indices 71 REAL(wp) :: zcoefu , zcoefv , zcoeff ! local scalars 72 REAL(wp) :: zv_t_ij, zv_t_ip1j, zv_t_ijp1, zv_t_ip1jp1 ! - - 73 !!---------------------------------------------------------------------- 74 75 IF( wrk_in_use(2, 1,2,3) ) THEN 76 CALL ctl_stop('dom_vvl: requested workspace arrays unavailable') ; RETURN 77 ENDIF 78 79 IF(lwp) THEN 59 80 WRITE(numout,*) 60 WRITE(numout,*) 'dom_vvl : Variable volume activated'81 WRITE(numout,*) 'dom_vvl : Variable volume initialization' 61 82 WRITE(numout,*) '~~~~~~~~ compute coef. used to spread ssh over each layers' 62 83 ENDIF 63 84 85 IF( dom_vvl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dom_vvl : unable to allocate arrays' ) 64 86 65 87 fsdept(:,:,:) = gdept (:,:,:) … … 167 189 fse3v_b(:,:,:) = fse3v_b(:,:,:) + fse3v_0(:,:,:) 168 190 ! 191 IF( wrk_not_released(2, 1,2,3) ) CALL ctl_stop('dom_vvl: failed to release workspace arrays') 192 ! 169 193 END SUBROUTINE dom_vvl 170 194 -
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90
r2528 r2715 2 2 !!====================================================================== 3 3 !! *** MODULE domwri *** 4 !! Ocean initialization : write the ocean domain mesh askfile(s)4 !! Ocean initialization : write the ocean domain mesh file(s) 5 5 !!====================================================================== 6 6 !! History : OPA ! 1997-02 (G. Madec) Original code 7 7 !! 8.1 ! 1999-11 (M. Imbard) NetCDF FORMAT with IOIPSL 8 8 !! NEMO 1.0 ! 2002-08 (G. Madec) F90 and several file 9 !! 3.0 ! 2008-01 (S. Masson) add dom_uniq 10 !! 4.0 ! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation 9 11 !!---------------------------------------------------------------------- 10 12 11 13 !!---------------------------------------------------------------------- 12 14 !! dom_wri : create and write mesh and mask file(s) 13 !! nmsh = 1 : mesh_mask file 14 !! = 2 : mesh and mask file 15 !! = 3 : mesh_hgr, mesh_zgr and mask 15 !! dom_uniq : 16 16 !!---------------------------------------------------------------------- 17 17 USE dom_oce ! ocean space and time domain … … 63 63 !! masks, depth and vertical scale factors 64 64 !!---------------------------------------------------------------------- 65 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 66 USE wrk_nemo, ONLY: zprt => wrk_2d_1 , zprw => wrk_2d_2 ! 2D workspace 67 USE wrk_nemo, ONLY: zdepu => wrk_3d_1 , zdepv => wrk_3d_2 ! 3D - 68 !! 65 69 INTEGER :: inum0 ! temprary units for 'mesh_mask.nc' file 66 70 INTEGER :: inum1 ! temprary units for 'mesh.nc' file … … 74 78 CHARACTER(len=21) :: clnam4 ! filename (vertical mesh informations) 75 79 INTEGER :: ji, jj, jk ! dummy loop indices 76 REAL(wp), DIMENSION(jpi,jpj) :: zprt , zprw ! 2D workspace 77 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdepu, zdepv ! 3D workspace 78 !!---------------------------------------------------------------------- 80 !!---------------------------------------------------------------------- 81 82 IF( wrk_in_use(2, 1,2) .OR. wrk_in_use(3, 1,2) )THEN 83 CALL ctl_stop('dom_wri: requested workspace arrays unavailable') ; RETURN 84 END IF 79 85 80 86 IF(lwp) WRITE(numout,*) … … 122 128 CALL iom_rstput( 0, 0, inum2, 'fmask', fmask, ktype = jp_i1 ) 123 129 124 125 zprt = tmask(:,:,1) * dom_uniq('T')! ! unique point mask130 CALL dom_uniq( zprw, 'T' ) 131 zprt = tmask(:,:,1) * zprw ! ! unique point mask 126 132 CALL iom_rstput( 0, 0, inum2, 'tmaskutil', zprt, ktype = jp_i1 ) 127 zprt = umask(:,:,1) * dom_uniq('U') 133 CALL dom_uniq( zprw, 'U' ) 134 zprt = umask(:,:,1) * zprw 128 135 CALL iom_rstput( 0, 0, inum2, 'umaskutil', zprt, ktype = jp_i1 ) 129 zprt = vmask(:,:,1) * dom_uniq('V') 136 CALL dom_uniq( zprw, 'V' ) 137 zprt = vmask(:,:,1) * zprw 130 138 CALL iom_rstput( 0, 0, inum2, 'vmaskutil', zprt, ktype = jp_i1 ) 131 zprt = fmask(:,:,1) * dom_uniq('F') 139 CALL dom_uniq( zprw, 'F' ) 140 zprt = fmask(:,:,1) * zprw 132 141 CALL iom_rstput( 0, 0, inum2, 'fmaskutil', zprt, ktype = jp_i1 ) 133 142 … … 251 260 END SELECT 252 261 ! 262 IF( wrk_not_released(2, 1,2) .OR. & 263 wrk_not_released(3, 1,2) ) CALL ctl_stop('dom_wri: failed to release workspace arrays') 264 ! 253 265 END SUBROUTINE dom_wri 254 266 255 267 256 FUNCTION dom_uniq( cdgrd ) RESULT( puniq)268 SUBROUTINE dom_uniq( puniq, cdgrd ) 257 269 !!---------------------------------------------------------------------- 258 270 !! *** ROUTINE dom_uniq *** … … 263 275 !! 2) check which elements have been changed 264 276 !!---------------------------------------------------------------------- 265 CHARACTER(len=1) , INTENT(in ) :: cdgrd ! 266 REAL(wp), DIMENSION(jpi,jpj) :: puniq ! 267 ! 268 REAL(wp), DIMENSION(jpi,jpj ) :: ztstref ! array with different values for each element 269 REAL(wp) :: zshift ! shift value link to the process number 270 LOGICAL , DIMENSION(jpi,jpj,1) :: lldbl ! is the point unique or not? 271 INTEGER :: ji ! dummy loop indices 272 !!---------------------------------------------------------------------- 273 ! 277 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 278 USE wrk_nemo, ONLY: ztstref => wrk_2d_3 ! array with different values for each element 279 ! 280 CHARACTER(len=1) , INTENT(in ) :: cdgrd ! 281 REAL(wp), DIMENSION(:,:), INTENT(inout) :: puniq ! 282 ! 283 REAL(wp) :: zshift ! shift value link to the process number 284 INTEGER :: ji ! dummy loop indices 285 LOGICAL, DIMENSION(SIZE(puniq,1),SIZE(puniq,2),1) :: lldbl ! store whether each point is unique or not 286 !!---------------------------------------------------------------------- 287 288 IF( wrk_in_use(2, 3) ) THEN 289 CALL ctl_stop('dom_uniq: requested workspace array unavailable') ; RETURN 290 ENDIF 291 274 292 ! build an array with different values for each element 275 293 ! in mpp: make sure that these values are different even between process … … 286 304 puniq(nldi:nlei,nldj:nlej) = REAL( COUNT( lldbl(nldi:nlei,nldj:nlej,:), dim = 3 ) , wp ) 287 305 ! 288 END FUNCTION dom_uniq 306 IF( wrk_not_released(2, 3) ) CALL ctl_stop('dom_uniq: failed to release workspace array') 307 ! 308 END SUBROUTINE dom_uniq 289 309 290 310 !!====================================================================== -
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r2712 r2715 42 42 PRIVATE 43 43 44 PUBLIC dom_zgr ! called by dom_init.F9044 PUBLIC dom_zgr ! called by dom_init.F90 45 45 46 46 ! !!* Namelist namzgr_sco * … … 54 54 ! ! ( rn_bb=0; top only, rn_bb =1; top and bottom) 55 55 REAL(wp) :: rn_hc = 150._wp ! Critical depth for s-sigma coordinates 56 57 56 57 !! * Substitutions 58 58 # include "domzgr_substitute.h90" 59 59 # include "vectopt_loop_substitute.h90" 60 60 !!---------------------------------------------------------------------- 61 !! NEMO/OPA 3.3 , NEMO Consortium (2010)61 !! NEMO/OPA 3.3.1 , NEMO Consortium (2011) 62 62 !! $Id$ 63 63 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 121 121 ! 122 122 ! 123 123 124 IF( nprint == 1 .AND. lwp ) THEN 124 125 WRITE(numout,*) ' MIN val mbathy ', MINVAL( mbathy(:,:) ), ' MAX ', MAXVAL( mbathy(:,:) ) … … 588 589 !! - update bathy : meter bathymetry (in meters) 589 590 !!---------------------------------------------------------------------- 591 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 592 USE wrk_nemo, ONLY: zbathy => wrk_2d_1 593 !! 590 594 INTEGER :: ji, jj, jl ! dummy loop indices 591 595 INTEGER :: icompt, ibtest, ikmax ! temporary integers 592 REAL(wp), DIMENSION(jpi,jpj) :: zbathy ! temporary workspace 593 !!---------------------------------------------------------------------- 596 !!---------------------------------------------------------------------- 597 598 IF( wrk_in_use(2, 1) ) THEN 599 CALL ctl_stop('zgr_bat_ctl: requested workspace array unavailable') ; RETURN 600 ENDIF 594 601 595 602 IF(lwp) WRITE(numout,*) … … 695 702 ENDIF 696 703 ! 704 IF( wrk_not_released(2, 1) ) CALL ctl_stop('zgr_bat_ctl: failed to release workspace array') 705 ! 697 706 END SUBROUTINE zgr_bat_ctl 698 707 … … 710 719 !! (min value = 1 over land) 711 720 !!---------------------------------------------------------------------- 721 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 722 USE wrk_nemo, ONLY: zmbk => wrk_2d_1 723 !! 712 724 INTEGER :: ji, jj ! dummy loop indices 713 REAL(wp), DIMENSION(jpi,jpj) :: zmbk ! 2D workspace 714 !!---------------------------------------------------------------------- 725 !!---------------------------------------------------------------------- 726 ! 727 IF( wrk_in_use(2, 1) ) THEN 728 CALL ctl_stop('zgr_bot_level: requested 2D workspace unavailable') ; RETURN 729 ENDIF 715 730 ! 716 731 IF(lwp) WRITE(numout,*) … … 729 744 zmbk(:,:) = REAL( mbku(:,:), wp ) ; CALL lbc_lnk(zmbk,'U',1.) ; mbku (:,:) = MAX( INT( zmbk(:,:) ), 1 ) 730 745 zmbk(:,:) = REAL( mbkv(:,:), wp ) ; CALL lbc_lnk(zmbk,'V',1.) ; mbkv (:,:) = MAX( INT( zmbk(:,:) ), 1 ) 746 ! 747 IF( wrk_not_released(2, 1) ) CALL ctl_stop('zgr_bot_level: failed to release workspace array') 731 748 ! 732 749 END SUBROUTINE zgr_bot_level … … 805 822 !! Reference : Pacanowsky & Gnanadesikan 1997, Mon. Wea. Rev., 126, 3248-3270. 806 823 !!---------------------------------------------------------------------- 824 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 825 USE wrk_nemo, ONLY: zprt => wrk_3d_1 826 !! 807 827 INTEGER :: ji, jj, jk ! dummy loop indices 808 828 INTEGER :: ik, it ! temporary integers … … 813 833 REAL(wp) :: zdiff ! temporary scalar 814 834 REAL(wp) :: zrefdep ! temporary scalar 815 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprt ! 3D workspace816 835 !!--------------------------------------------------------------------- 836 ! 837 IF( wrk_in_use(3, 1) ) THEN 838 CALL ctl_stop('zgr_zps: requested workspace unavailable.') ; RETURN 839 ENDIF 817 840 818 841 IF(lwp) WRITE(numout,*) … … 822 845 823 846 ll_print = .FALSE. ! Local variable for debugging 824 !! ll_print = .TRUE.825 847 826 848 IF(lwp .AND. ll_print) THEN ! control print of the ocean depth … … 1006 1028 ENDIF 1007 1029 ! 1030 IF( wrk_not_released(3, 1) ) CALL ctl_stop('zgr_zps: failed to release workspace') 1031 ! 1008 1032 END SUBROUTINE zgr_zps 1009 1033 … … 1092 1116 !! Reference : Madec, Lott, Delecluse and Crepon, 1996. JPO, 26, 1393-1408. 1093 1117 !!---------------------------------------------------------------------- 1118 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 1119 USE wrk_nemo, ONLY: zenv => wrk_2d_1 , ztmp => wrk_2d_2 , zmsk => wrk_2d_3 1120 USE wrk_nemo, ONLY: zri => wrk_2d_4 , zrj => wrk_2d_5 , zhbat => wrk_2d_6 1121 USE wrk_nemo, ONLY: gsigw3 => wrk_3d_1 1122 USE wrk_nemo, ONLY: gsigt3 => wrk_3d_2 1123 USE wrk_nemo, ONLY: gsi3w3 => wrk_3d_3 1124 USE wrk_nemo, ONLY: esigt3 => wrk_3d_4 1125 USE wrk_nemo, ONLY: esigw3 => wrk_3d_5 1126 USE wrk_nemo, ONLY: esigtu3 => wrk_3d_6 1127 USE wrk_nemo, ONLY: esigtv3 => wrk_3d_7 1128 USE wrk_nemo, ONLY: esigtf3 => wrk_3d_8 1129 USE wrk_nemo, ONLY: esigwu3 => wrk_3d_9 1130 USE wrk_nemo, ONLY: esigwv3 => wrk_3d_10 1131 ! 1094 1132 INTEGER :: ji, jj, jk, jl ! dummy loop argument 1095 1133 INTEGER :: iip1, ijp1, iim1, ijm1 ! temporary integers 1096 1134 REAL(wp) :: zcoeft, zcoefw, zrmax, ztaper ! temporary scalars 1097 REAL(wp), DIMENSION(jpi,jpj) :: zenv, ztmp, zmsk ! 2D workspace 1098 REAL(wp), DIMENSION(jpi,jpj) :: zri , zrj , zhbat ! - - 1099 !! 1100 REAL(wp), DIMENSION(jpi,jpj,jpk) :: gsigw3 1101 REAL(wp), DIMENSION(jpi,jpj,jpk) :: gsigt3 1102 REAL(wp), DIMENSION(jpi,jpj,jpk) :: gsi3w3 1103 REAL(wp), DIMENSION(jpi,jpj,jpk) :: esigt3 1104 REAL(wp), DIMENSION(jpi,jpj,jpk) :: esigw3 1105 REAL(wp), DIMENSION(jpi,jpj,jpk) :: esigtu3 1106 REAL(wp), DIMENSION(jpi,jpj,jpk) :: esigtv3 1107 REAL(wp), DIMENSION(jpi,jpj,jpk) :: esigtf3 1108 REAL(wp), DIMENSION(jpi,jpj,jpk) :: esigwu3 1109 REAL(wp), DIMENSION(jpi,jpj,jpk) :: esigwv3 1110 !! 1135 ! 1136 1111 1137 NAMELIST/namzgr_sco/ rn_sbot_max, rn_sbot_min, rn_theta, rn_thetb, rn_rmax, ln_s_sigma, rn_bb, rn_hc 1112 1138 !!---------------------------------------------------------------------- 1113 1139 1114 REWIND( numnam ) ! Read Namelist namzgr_sco : sigma-stretching parameters 1140 IF( wrk_in_use(2, 1,2,3,4,5,6) .OR. wrk_in_use(3, 1,2,3,4,5,6,7,8,9,10) ) THEN 1141 CALL ctl_stop('zgr_sco: ERROR - requested workspace arrays unavailable') ; RETURN 1142 ENDIF 1143 1144 REWIND( numnam ) ! Read Namelist namzgr_sco : sigma-stretching parameters 1115 1145 READ ( numnam, namzgr_sco ) 1116 1146 1117 IF(lwp) THEN 1147 IF(lwp) THEN ! control print 1118 1148 WRITE(numout,*) 1119 1149 WRITE(numout,*) 'dom:zgr_sco : s-coordinate or hybrid z-s-coordinate' … … 1146 1176 DO jj = 1, jpj 1147 1177 DO ji = 1, jpi 1148 IF( bathy(ji,jj) > 0._wp ) THEN 1149 bathy(ji,jj) = MAX( rn_sbot_min, bathy(ji,jj) ) 1150 ENDIF 1178 IF( bathy(ji,jj) > 0._wp ) bathy(ji,jj) = MAX( rn_sbot_min, bathy(ji,jj) ) 1151 1179 END DO 1152 1180 END DO … … 1372 1400 END DO ! for all ji's 1373 1401 1374 DO ji = 1, jpi 1375 DO jj = 1, jpj 1402 DO ji = 1, jpim1 1403 DO jj = 1, jpjm1 1376 1404 DO jk = 1, jpk 1377 1405 esigtu3(ji,jj,jk) = ( hbatt(ji,jj)*esigt3(ji,jj,jk)+hbatt(ji+1,jj)*esigt3(ji+1,jj,jk) ) & … … 1398 1426 END DO 1399 1427 END DO 1428 1429 CALL lbc_lnk( e3t , 'T', 1._wp ) 1430 CALL lbc_lnk( e3u , 'U', 1._wp ) 1431 CALL lbc_lnk( e3v , 'V', 1._wp ) 1432 CALL lbc_lnk( e3f , 'F', 1._wp ) 1433 CALL lbc_lnk( e3w , 'W', 1._wp ) 1434 CALL lbc_lnk( e3uw, 'U', 1._wp ) 1435 CALL lbc_lnk( e3vw, 'V', 1._wp ) 1436 1400 1437 ! 1401 1438 ELSE ! not ln_s_sigma … … 1553 1590 !!gm bug #endif 1554 1591 ! 1592 IF( wrk_not_released(2, 1,2,3,4,5,6) .OR. wrk_not_released(3, 1,2,3,4,5,6,7,8,9,10) ) & 1593 & CALL ctl_stop('dom:zgr_sco: failed to release workspace arrays') 1594 ! 1555 1595 END SUBROUTINE zgr_sco 1556 1557 1596 1558 1597 !!====================================================================== -
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90
r2528 r2715 43 43 USE dynspg_ts ! pressure gradient schemes 44 44 USE traswp ! Swap arrays (tra_swp routine) 45 45 USE lib_mpp ! MPP library 46 46 47 IMPLICIT NONE 47 48 PRIVATE … … 55 56 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 56 57 !! $Id$ 57 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)58 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 58 59 !!---------------------------------------------------------------------- 59 60 60 CONTAINS 61 61 … … 446 446 !! p=integral [ rau*g dz ] 447 447 !!---------------------------------------------------------------------- 448 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 449 USE wrk_nemo, ONLY: zprn => wrk_3d_1 ! 3D workspace 450 448 451 USE dynspg ! surface pressure gradient (dyn_spg routine) 449 452 USE divcur ! hor. divergence & rel. vorticity (div_cur routine) … … 453 456 INTEGER :: indic ! ??? 454 457 REAL(wp) :: zmsv, zphv, zmsu, zphu, zalfg ! temporary scalars 455 REAL(wp), DIMENSION (jpi,jpj,jpk) :: zprn ! workspace 456 !!---------------------------------------------------------------------- 458 !!---------------------------------------------------------------------- 459 460 IF(wrk_in_use(3, 1) ) THEN 461 CALL ctl_stop('istage_uvg: requested workspace array unavailable') ; RETURN 462 ENDIF 457 463 458 464 IF(lwp) WRITE(numout,*) … … 551 557 rotb (:,:,:) = rotn (:,:,:) ! set the before to the now value 552 558 ! 559 IF( wrk_not_released(3, 1) ) THEN 560 CALL ctl_stop('istage_uvg: failed to release workspace array') 561 ENDIF 562 ! 553 563 END SUBROUTINE istate_uvg 554 564
Note: See TracChangeset
for help on using the changeset viewer.
