Changeset 2590 for branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM
- Timestamp:
- 2011-02-18T13:49:27+01:00 (13 years ago)
- Location:
- branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM
- Files:
-
- 7 edited
-
dom_oce.F90 (modified) (8 diffs)
-
dommsk.F90 (modified) (5 diffs)
-
domngb.F90 (modified) (3 diffs)
-
domvvl.F90 (modified) (4 diffs)
-
domwri.F90 (modified) (8 diffs)
-
domzgr.F90 (modified) (12 diffs)
-
istate.F90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
r2528 r2590 49 49 INTEGER , PUBLIC :: neuler = 0 !: restart euler forward option (0=Euler) 50 50 REAL(wp), PUBLIC :: atfp1 !: asselin time filter coeff. (atfp1= 1-2*atfp) 51 REAL(wp), PUBLIC, DIMENSION(jpk) :: rdttra!: vertical profile of tracer time step51 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: rdttra !: vertical profile of tracer time step 52 52 53 53 ! !!* Namelist namcla : cross land advection … … 83 83 INTEGER, PUBLIC :: nidom !: ??? 84 84 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?85 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: mig !: local ==> global domain i-index 86 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: mjg !: local ==> global domain j-index 87 INTEGER, PUBLIC, DIMENSION(jpidta) :: mi0, mi1 !: global ==> local domain i-index !!bug ==> other solution? 88 88 ! ! (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?89 INTEGER, PUBLIC, DIMENSION(jpjdta) :: mj0, mj1 !: global ==> local domain j-index !!bug ==> other solution? 90 90 ! ! (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-domain91 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: nimppt, njmppt !: i-, j-indexes for each processor 92 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ibonit, ibonjt !: i-, j- processor neighbour existence 93 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: nlcit , nlcjt !: dimensions of every subdomain 94 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: nldit , nldjt !: first, last indoor index for each i-domain 95 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: nleit , nlejt !: first, last indoor index for each j-domain 96 96 97 97 !!---------------------------------------------------------------------- 98 98 !! horizontal curvilinear coordinate and scale factors 99 99 !! --------------------------------------------------------------------- 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)100 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: glamt, glamu !: longitude of t-, u-, v- and f-points (degre) 101 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: glamv, glamf !: 102 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: gphit, gphiu !: latitude of t-, u-, v- and f-points (degre) 103 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: gphiv, gphif !: 104 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e1t, e2t !: horizontal scale factors at t-point (m) 105 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e1u, e2u !: horizontal scale factors at u-point (m) 106 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e1v, e2v !: horizontal scale factors at v-point (m) 107 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e1f, e2f !: horizontal scale factors at f-point (m) 108 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ff !: coriolis factor (2.*omega*sin(yphi) ) (s-1) 109 109 110 110 !!---------------------------------------------------------------------- … … 118 118 !! All coordinates 119 119 !! --------------- 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)120 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdep3w !: depth of T-points (sum of e3w) (m) 121 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdept , gdepw !: analytical depth at T-W points (m) 122 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3v , e3f !: analytical vertical scale factors at V--F 123 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3t , e3u !: T--U points (m) 124 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3vw !: analytical vertical scale factors at VW-- 125 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3w , e3uw !: W--UW points (m) 126 126 #if defined key_vvl 127 127 LOGICAL, PUBLIC, PARAMETER :: lk_vvl = .TRUE. !: variable grid flag … … 129 129 !! All coordinates 130 130 !! --------------- 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)131 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdep3w_1 !: depth of T-points (sum of e3w) (m) 132 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdept_1, gdepw_1 !: analytical depth at T-W points (m) 133 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3v_1 , e3f_1 !: analytical vertical scale factors at V--F 134 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3t_1 , e3u_1 !: T--U points (m) 135 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3vw_1 !: analytical vertical scale factors at VW-- 136 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3w_1 , e3uw_1 !: W--UW points (m) 137 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3t_b !: before - - - - T points (m) 138 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3u_b , e3v_b !: - - - - - U--V points (m) 139 139 #else 140 140 LOGICAL, PUBLIC, PARAMETER :: lk_vvl = .FALSE. !: fixed grid flag 141 141 #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)142 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hur , hvr !: inverse of u and v-points ocean depth (1/m) 143 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu , hv !: depth at u- and v-points (meters) 144 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu_0 , hv_0 !: refernce depth at u- and v-points (meters) 145 145 146 146 INTEGER, PUBLIC :: nla10 !: deepest W level Above ~10m (nlb10 - 1) … … 149 149 !! z-coordinate with full steps (also used in the other cases as reference z-coordinate) 150 150 !! =-----------------====------ 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 points151 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: gdept_0, gdepw_0 !: reference depth of t- and w-points (m) 152 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: e3t_0 , e3w_0 !: reference vertical scale factors at T- and W-pts (m) 153 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e3tp , e3wp !: ocean bottom level thickness at T and W points 154 154 155 155 !! s-coordinate and hybrid z-s-coordinate 156 156 !! =----------------======--------------- 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)157 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: gsigt, gsigw !: model level depth coefficient at t-, w-levels (analytic) 158 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: gsi3w !: model level depth coefficient at w-level (sum of gsigw) 159 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: esigt, esigw !: vertical scale factor coef. at t-, w-levels 160 161 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hbatv , hbatf !: ocean depth at the vertical of V--F 162 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hbatt , hbatu !: T--U points (m) 163 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: scosrf, scobot !: ocean surface and bottom topographies 164 ! ! (if deviating from coordinate surfaces in HYBRID) 165 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hifv , hiff !: interface depth between stretching at V--F 166 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hift , hifu !: and quasi-uniform spacing T--U points (m) 167 167 168 168 !!---------------------------------------------------------------------- 169 169 !! masks, bathymetry 170 170 !! --------------------------------------------------------------------- 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-pts171 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mbathy !: number of ocean level (=0, 1, ... , jpk-1) 172 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mbkt !: vertical index of the bottom last T- ocean level 173 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mbku, mbkv !: vertical index of the bottom last U- and W- ocean level 174 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: bathy !: ocean depth (meters) 175 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmask_i !: interior domain T-point mask 176 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: bmask !: land/ocean mask of barotropic stream function 177 178 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tmask, umask, vmask, fmask !: land/ocean mask at T-, U-, V- and F-pts 179 179 180 180 REAL(wp), PUBLIC, DIMENSION(jpiglo) :: tpol, fpol !: north fold mask (jperio= 3 or 4) 181 181 182 182 #if defined key_noslip_accurate 183 INTEGER, PUBLIC, DIMENSION (4,jpk) :: npcoa!: ???184 INTEGER, PUBLIC, DIMENSION(2*(jpi+jpj),4,jpk) :: nicoa, njcoa!: ???183 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,: ) :: npcoa !: ??? 184 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: nicoa, njcoa !: ??? 185 185 #endif 186 186 … … 215 215 LOGICAL, PUBLIC, PARAMETER :: lk_mpp_rep = .FALSE. !: agrif flag 216 216 #endif 217 218 PUBLIC dom_oce_alloc ! Called from nemogcm.F90 219 217 220 !!---------------------------------------------------------------------- 218 221 !! agrif domain … … 222 225 #else 223 226 LOGICAL, PUBLIC, PARAMETER :: lk_agrif = .FALSE. !: agrif flag 227 #endif 224 228 225 229 CONTAINS 230 231 #if ! defined key_agrif 226 232 LOGICAL FUNCTION Agrif_Root() 227 233 Agrif_Root = .TRUE. … … 232 238 END FUNCTION Agrif_CFixed 233 239 #endif 240 241 FUNCTION dom_oce_alloc() 242 !!---------------------------------------------------------------------- 243 USE par_oce, Only: jpi, jpj, jpk, jpnij 244 IMPLICIT none 245 INTEGER :: dom_oce_alloc 246 INTEGER, DIMENSION(11) :: ierr 247 248 ierr(:) = 0 249 250 ALLOCATE(rdttra(jpk), mig(jpi), mjg(jpj), Stat=ierr(1)) 251 252 ALLOCATE(nimppt(jpnij), njmppt(jpnij), & 253 ibonit(jpnij), ibonjt(jpnij), & 254 nlcit(jpnij), nlcjt(jpnij), & 255 nldit(jpnij), nldjt(jpnij), & 256 nleit(jpnij), nlejt(jpnij), Stat=ierr(2)) 257 258 ALLOCATE(glamt(jpi,jpj), glamu(jpi,jpj), & 259 glamv(jpi,jpj), glamf(jpi,jpj), & 260 gphit(jpi,jpj), gphiu(jpi,jpj), & 261 gphiv(jpi,jpj), gphif(jpi,jpj), & 262 e1t(jpi,jpj), e2t(jpi,jpj), & 263 e1u(jpi,jpj), e2u(jpi,jpj), & 264 e1v(jpi,jpj), e2v(jpi,jpj), & 265 e1f(jpi,jpj), e2f(jpi,jpj), & 266 ff(jpi,jpj), Stat=ierr(3)) 267 268 !IF( .not. lk_zco )THEN 269 ALLOCATE(gdep3w(jpi,jpj,jpk), & 270 gdept(jpi,jpj,jpk) , gdepw(jpi,jpj,jpk), & 271 e3v(jpi,jpj,jpk) , e3f(jpi,jpj,jpk) , & 272 e3t(jpi,jpj,jpk) , e3u(jpi,jpj,jpk) , & 273 e3vw(jpi,jpj,jpk) , & 274 e3w(jpi,jpj,jpk) , e3uw(jpi,jpj,jpk) , Stat=ierr(4)) 275 !END IF 276 277 #if defined key_vvl 278 ALLOCATE(gdep3w_1(jpi,jpj,jpk) , & 279 gdept_1(jpi,jpj,jpk), gdepw_1(jpi,jpj,jpk), & 280 e3v_1(jpi,jpj,jpk) , e3f_1(jpi,jpj,jpk) , & 281 e3t_1(jpi,jpj,jpk) , e3u_1(jpi,jpj,jpk) , & 282 e3vw_1(jpi,jpj,jpk) , & 283 e3w_1(jpi,jpj,jpk) , e3uw_1(jpi,jpj,jpk), & 284 e3t_b(jpi,jpj,jpk) , & 285 e3u_b(jpi,jpj,jpk) , e3v_b(jpi,jpj,jpk), & 286 Stat=ierr(5)) 287 #endif 288 289 ALLOCATE(hur(jpi,jpj), hvr(jpi,jpj), & 290 hu(jpi,jpj), hv(jpi,jpj), & 291 hu_0(jpi,jpj), hv_0(jpi,jpj),& 292 Stat=ierr(6)) 293 ! 294 ALLOCATE(gdept_0(jpk), gdepw_0(jpk), e3t_0(jpk), & 295 e3w_0(jpk) , e3tp(jpi,jpj), e3wp(jpi,jpj), & 296 gsigt(jpk) , gsigw(jpk) , gsi3w(jpk), & 297 esigt(jpk) , esigw(jpk) , Stat=ierr(7)) 298 ! 299 ALLOCATE(hbatv(jpi,jpj) , hbatf(jpi,jpj) , & 300 hbatt(jpi,jpj) , hbatu(jpi,jpj) , & 301 scosrf(jpi,jpj), scobot(jpi,jpj), & 302 hifv(jpi,jpj) , hiff(jpi,jpj) , & 303 hift(jpi,jpj) , hifu(jpi,jpj) , & 304 Stat=ierr(8)) 305 ! 306 ALLOCATE(mbathy(jpi,jpj), & 307 mbkt(jpi,jpj), mbku(jpi,jpj), mbkv(jpi,jpj), & 308 bathy(jpi,jpj), & 309 tmask_i(jpi,jpj),bmask(jpi,jpj), & 310 Stat=ierr(9)) 311 312 ALLOCATE(tmask(jpi,jpj,jpk), umask(jpi,jpj,jpk), & 313 vmask(jpi,jpj,jpk), fmask(jpi,jpj,jpk), & 314 Stat=ierr(10)) 315 316 #if defined key_noslip_accurate 317 ALLOCATE(npcoa(4,jpk), nicoa(2*(jpi+jpj),4,jpk), njcoa(2*(jpi+jpj),4,jpk), & 318 Stat=ierr(11)) 319 #endif 320 321 dom_oce_alloc = MAXVAL(ierr) 322 323 END FUNCTION dom_oce_alloc 324 234 325 !!---------------------------------------------------------------------- 235 326 !! NEMO/OPA 3.3 , NEMO Consortium (2010) -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90
r2528 r2590 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 FUNCTION dom_msk_alloc() 54 !!--------------------------------------------------------------------- 55 !! *** ROUTINE dom_msk_alloc *** 56 !!--------------------------------------------------------------------- 57 INTEGER :: dom_msk_alloc 58 59 dom_msk_alloc = 0 60 61 #if defined key_noslip_accurate 62 ALLOCATE(icoord(jpi*jpj*jpk,3), Stat=dom_msk_alloc) 63 #endif 64 65 IF(dom_msk_alloc /= 0)THEN 66 CALL ctl_warn('dom_msk_alloc: failed to allocate icoord array.') 67 END IF 68 69 END FUNCTION dom_msk_alloc 70 71 50 72 SUBROUTINE dom_msk 51 73 !!--------------------------------------------------------------------- … … 109 131 !! tmask_i : interior ocean mask 110 132 !!---------------------------------------------------------------------- 133 USE wrk_nemo, ONLY: wrk_use, wrk_release, iwrk_use, iwrk_release 134 USE wrk_nemo, ONLY: zwf => wrk_2d_1 135 USE wrk_nemo, ONLY: imsk => iwrk_2d_1 136 !! 111 137 INTEGER :: ji, jj, jk ! dummy loop indices 112 138 INTEGER :: iif, iil, ii0, ii1, ii 113 139 INTEGER :: ijf, ijl, ij0, ij1 114 INTEGER , DIMENSION(jpi,jpj) :: imsk115 REAL(wp), DIMENSION(jpi,jpj) :: zwf116 140 !! 117 141 NAMELIST/namlbc/ rn_shlat 118 142 !!--------------------------------------------------------------------- 119 143 144 IF( (.not. wrk_use(2,1)) .OR. (.not. iwrk_use(2,1)) )THEN 145 CALL ctl_stop('dom_msk: ERROR: requested workspace arrays unavailable.') 146 RETURN 147 END IF 148 120 149 REWIND( numnam ) ! Namelist namlbc : lateral momentum boundary condition 121 150 READ ( numnam, namlbc ) … … 414 443 ENDIF 415 444 ! 445 IF( (.not. wrk_release(2,1)) .OR. (.not. iwrk_release(2,1)) )THEN 446 CALL ctl_stop('dom_msk: ERROR: failed to release workspace arrays.') 447 END IF 448 ! 416 449 END SUBROUTINE dom_msk 417 450 … … 434 467 INTEGER :: ine, inw, ins, inn, itest, ierror, iind, ijnd 435 468 REAL(wp) :: zaa 436 INTEGER, DIMENSION(jpi*jpj*jpk,3) :: icoord437 469 !!--------------------------------------------------------------------- 438 470 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/domngb.F90
r2528 r2590 36 36 !! 37 37 !!---------------------------------------------------------------------- 38 USE in_out_manager, ONLY: ctl_stop 39 USE wrk_nemo, ONLY: wrk_use, wrk_release 40 USE wrk_nemo, ONLY: zglam => wrk_2d_2, & 41 zgphi => wrk_2d_3, & 42 zmask => wrk_2d_4, & 43 zdist => wrk_2d_5 44 IMPLICIT none 38 45 REAL(wp) , INTENT(in ) :: plon, plat ! longitude,latitude of the point 39 46 INTEGER , INTENT( out) :: kii, kjj ! i-,j-index of the closes grid point … … 41 48 !! 42 49 INTEGER , DIMENSION(2) :: iloc 43 REAL(wp), DIMENSION(jpi,jpj) :: zglam, zgphi, zmask, zdist44 50 REAL(wp) :: zlon 45 51 REAL(wp) :: zmini 46 52 !!-------------------------------------------------------------------- 47 53 54 IF(.not. wrk_use(2, 2, 3, 4, 5))THEN 55 CALL ctl_stop('dom_ngb: Requested workspaces already in use.') 56 END IF 57 48 58 zmask(:,:) = 0. 49 59 SELECT CASE( cdgrid ) … … 71 81 ENDIF 72 82 83 IF(.not. wrk_release(2, 2,3,4,5))THEN 84 CALL ctl_stop('dom_ngb: error releasing workspaces.') 85 ENDIF 86 73 87 END SUBROUTINE dom_ngb 74 88 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
r2528 r2590 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 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 32 33 ! ! except at nit000 (=rdttra) if neuler=0 33 34 … … 42 43 43 44 CONTAINS 45 46 FUNCTION dom_vvl_alloc() 47 !!---------------------------------------------------------------------- 48 !! *** ROUTINE dom_vvl_alloc *** 49 !!---------------------------------------------------------------------- 50 IMPLICIT none 51 INTEGER :: dom_vvl_alloc 52 !!---------------------------------------------------------------------- 53 54 ALLOCATE(mut(jpi,jpj,jpk), muu(jpi,jpj,jpk), muv(jpi,jpj,jpk), & 55 muf(jpi,jpj,jpk), & 56 ee_t(jpi,jpj), ee_u(jpi,jpj), ee_v(jpi,jpj), ee_f(jpi,jpj), & 57 r2dt(jpk), Stat=dom_vvl_alloc) 58 59 IF(dom_vvl_alloc /= 0)THEN 60 CALL ctl_warn('dom_vvl_alloc: failed to allocate arrays') 61 END IF 62 63 END FUNCTION dom_vvl_alloc 64 44 65 45 66 SUBROUTINE dom_vvl … … 50 71 !! ssh over the whole water column (scale factors) 51 72 !!---------------------------------------------------------------------- 73 USE wrk_nemo, ONLY: wrk_use, wrk_release 74 USE wrk_nemo, ONLY: zs_t => wrk_2d_1, zs_u_1 => wrk_2d_2, & 75 zs_v_1 => wrk_2d_3 76 !! 52 77 INTEGER :: ji, jj, jk 53 78 REAL(wp) :: zcoefu , zcoefv , zcoeff ! temporary scalars 54 79 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 !!---------------------------------------------------------------------- 80 !!---------------------------------------------------------------------- 81 82 IF(.not. wrk_use(2, 1,2,3))THEN 83 CALL ctl_stop('dom_vvl: ERROR - requested workspace arrays unavailable.') 84 RETURN 85 END IF 57 86 58 87 IF(lwp) THEN … … 167 196 fse3v_b(:,:,:) = fse3v_b(:,:,:) + fse3v_0(:,:,:) 168 197 ! 198 IF(.not. wrk_release(2, 1,2,3))THEN 199 CALL ctl_stop('dom_vvl: ERROR - failed to release workspace arrays.') 200 END IF 201 ! 169 202 END SUBROUTINE dom_vvl 170 203 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90
r2528 r2590 25 25 26 26 PUBLIC dom_wri ! routine called by inidom.F90 27 PUBLIC dom_wri_alloc ! routine called by nemogcm.F90 28 29 LOGICAL, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: lldbl ! Used in dom_uniq to store whether each point is unique or not 27 30 28 31 !! * Substitutions … … 34 37 !!---------------------------------------------------------------------- 35 38 CONTAINS 39 40 FUNCTION dom_wri_alloc() 41 !!---------------------------------------------------------------------- 42 !! *** ROUTINE dom_wri_alloc *** 43 !!---------------------------------------------------------------------- 44 INTEGER :: dom_wri_alloc 45 !!---------------------------------------------------------------------- 46 47 ALLOCATE(lldbl(jpi,jpj,1), Stat = dom_wri_alloc) 48 49 END FUNCTION dom_wri_alloc 50 36 51 37 52 SUBROUTINE dom_wri … … 63 78 !! masks, depth and vertical scale factors 64 79 !!---------------------------------------------------------------------- 80 USE wrk_nemo, ONLY: wrk_use, wrk_release 81 USE wrk_nemo, ONLY: zprt => wrk_2d_1, zprw => wrk_2d_2 82 USE wrk_nemo, ONLY: zdepu => wrk_3d_1, zdepv => wrk_3d_2 83 !! 65 84 INTEGER :: inum0 ! temprary units for 'mesh_mask.nc' file 66 85 INTEGER :: inum1 ! temprary units for 'mesh.nc' file … … 74 93 CHARACTER(len=21) :: clnam4 ! filename (vertical mesh informations) 75 94 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 !!---------------------------------------------------------------------- 95 !!---------------------------------------------------------------------- 96 97 IF( (.not. wrk_use(2, 1,2)) .OR. (.not. wrk_use(3, 1,2)) )THEN 98 CALL ctl_stop('dom_wri: ERROR - requested workspace arrays unavailable.') 99 RETURN 100 END IF 79 101 80 102 IF(lwp) WRITE(numout,*) … … 122 144 CALL iom_rstput( 0, 0, inum2, 'fmask', fmask, ktype = jp_i1 ) 123 145 124 125 zprt = tmask(:,:,1) * dom_uniq('T')! ! unique point mask146 CALL dom_uniq(zprw, 'T') 147 zprt = tmask(:,:,1) * zprw ! ! unique point mask 126 148 CALL iom_rstput( 0, 0, inum2, 'tmaskutil', zprt, ktype = jp_i1 ) 127 zprt = umask(:,:,1) * dom_uniq('U') 149 CALL dom_uniq(zprw, 'U') 150 zprt = umask(:,:,1) * zprw 128 151 CALL iom_rstput( 0, 0, inum2, 'umaskutil', zprt, ktype = jp_i1 ) 129 zprt = vmask(:,:,1) * dom_uniq('V') 152 CALL dom_uniq(zprw, 'V') 153 zprt = vmask(:,:,1) * zprw 130 154 CALL iom_rstput( 0, 0, inum2, 'vmaskutil', zprt, ktype = jp_i1 ) 131 zprt = fmask(:,:,1) * dom_uniq('F') 155 CALL dom_uniq(zprw, 'F') 156 zprt = fmask(:,:,1) * zprw 132 157 CALL iom_rstput( 0, 0, inum2, 'fmaskutil', zprt, ktype = jp_i1 ) 133 158 … … 251 276 END SELECT 252 277 ! 278 IF( (.not. wrk_release(2, 1,2)) .OR. (.not. wrk_release(3, 1,2)) )THEN 279 CALL ctl_stop('dom_wri: ERROR - failed to release workspace arrays.') 280 END IF 281 ! 253 282 END SUBROUTINE dom_wri 254 283 255 284 256 FUNCTION dom_uniq( cdgrd ) RESULT( puniq)285 SUBROUTINE dom_uniq(puniq, cdgrd ) 257 286 !!---------------------------------------------------------------------- 258 287 !! *** ROUTINE dom_uniq *** … … 263 292 !! 2) check which elements have been changed 264 293 !!---------------------------------------------------------------------- 294 !! 295 USE wrk_nemo, ONLY: wrk_use, wrk_release 296 USE wrk_nemo, ONLY: ztstref => wrk_2d_1 ! array with different values for each element 297 !! 265 298 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 299 REAL(wp), DIMENSION(:,:) , INTENT(inout) :: puniq ! 300 ! 269 301 REAL(wp) :: zshift ! shift value link to the process number 270 LOGICAL , DIMENSION(jpi,jpj,1) :: lldbl ! is the point unique or not?271 302 INTEGER :: ji ! dummy loop indices 272 303 !!---------------------------------------------------------------------- 273 ! 304 305 IF(.not. wrk_use(2, 1))THEN 306 CALL ctl_stop('dom_uniq: ERROR - requested workspace array unavailable.') 307 RETURN 308 END IF 309 274 310 ! build an array with different values for each element 275 311 ! in mpp: make sure that these values are different even between process … … 286 322 puniq(nldi:nlei,nldj:nlej) = REAL( COUNT( lldbl(nldi:nlei,nldj:nlej,:), dim = 3 ) , wp ) 287 323 ! 288 END FUNCTIONdom_uniq324 END SUBROUTINE dom_uniq 289 325 290 326 !!====================================================================== -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r2536 r2590 42 42 PRIVATE 43 43 44 PUBLIC dom_zgr ! called by dom_init.F90 44 PUBLIC dom_zgr ! called by dom_init.F90 45 PUBLIC dom_zgr_alloc ! called by nemo_alloc in nemogcm.F90 45 46 46 47 ! !!* Namelist namzgr_sco * … … 54 55 ! ! ( rn_bb=0; top only, rn_bb =1; top and bottom) 55 56 REAL(wp) :: rn_hc = 150._wp ! Critical depth for s-sigma coordinates 56 57 58 !! Arrays used in zgr_sco 59 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gsigw3 60 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gsigt3 61 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gsi3w3 62 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: esigt3 63 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: esigw3 64 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: esigtu3 65 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: esigtv3 66 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: esigtf3 67 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: esigwu3 68 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: esigwv3 69 57 70 !! * Substitutions 58 71 # include "domzgr_substitute.h90" … … 64 77 !!---------------------------------------------------------------------- 65 78 CONTAINS 79 80 FUNCTION dom_zgr_alloc() 81 !!---------------------------------------------------------------------- 82 !! *** FUNCTION dom_zgr_alloc *** 83 !!---------------------------------------------------------------------- 84 INTEGER :: dom_zgr_alloc 85 !!---------------------------------------------------------------------- 86 87 ALLOCATE(gsigw3(jpi,jpj,jpk), gsigt3(jpi,jpj,jpk), & 88 esigt3(jpi,jpj,jpk), esigw3(jpi,jpj,jpk), & 89 esigtu3(jpi,jpj,jpk), esigtv3(jpi,jpj,jpk), & 90 esigtf3(jpi,jpj,jpk), esigwu3(jpi,jpj,jpk), & 91 esigwv3(jpi,jpj,jpk), Stat=dom_zgr_alloc) 92 93 IF(dom_zgr_alloc /= 0)THEN 94 CALL ctl_warn('dom_zgr_alloc: failed to allocate arrays.') 95 END IF 96 97 END FUNCTION dom_zgr_alloc 98 66 99 67 100 SUBROUTINE dom_zgr … … 586 619 !! - update bathy : meter bathymetry (in meters) 587 620 !!---------------------------------------------------------------------- 621 USE wrk_nemo, ONLY: wrk_use, wrk_release 622 USE wrk_nemo, ONLY: zbathy => wrk_2d_1 623 !! 588 624 INTEGER :: ji, jj, jl ! dummy loop indices 589 625 INTEGER :: icompt, ibtest, ikmax ! temporary integers 590 REAL(wp), DIMENSION(jpi,jpj) :: zbathy ! temporary workspace 591 !!---------------------------------------------------------------------- 626 !!---------------------------------------------------------------------- 627 628 IF(.not. wrk_use(2, 1))THEN 629 CALL ctl_stop('zgr_bat_ctl: ERROR: requested workspace array unavailable.') 630 RETURN 631 END IF 592 632 593 633 IF(lwp) WRITE(numout,*) … … 693 733 ENDIF 694 734 ! 735 IF(.not. wrk_release(2, 1))THEN 736 CALL ctl_stop('zgr_bat_ctl: ERROR: failed to release workspace array.') 737 RETURN 738 END IF 739 ! 695 740 END SUBROUTINE zgr_bat_ctl 696 741 … … 708 753 !! (min value = 1 over land) 709 754 !!---------------------------------------------------------------------- 755 USE wrk_nemo, ONLY: wrk_use, wrk_release 756 USE wrk_nemo, ONLY: zmbk => wrk_2d_1 757 !! 710 758 INTEGER :: ji, jj ! dummy loop indices 711 REAL(wp), DIMENSION(jpi,jpj) :: zmbk ! 2D workspace 712 !!---------------------------------------------------------------------- 759 !!---------------------------------------------------------------------- 760 ! 761 IF( .not. wrk_use(2, 1))THEN 762 CALL ctl_stop('zgr_bot_level: ERROR - requested 2D workspace unavailable.') 763 RETURN 764 END IF 713 765 ! 714 766 IF(lwp) WRITE(numout,*) … … 727 779 zmbk(:,:) = REAL( mbku(:,:), wp ) ; CALL lbc_lnk(zmbk,'U',1.) ; mbku (:,:) = MAX( INT( zmbk(:,:) ), 1 ) 728 780 zmbk(:,:) = REAL( mbkv(:,:), wp ) ; CALL lbc_lnk(zmbk,'V',1.) ; mbkv (:,:) = MAX( INT( zmbk(:,:) ), 1 ) 781 ! 782 IF( .not. wrk_release(2, 1))THEN 783 CALL ctl_stop('zgr_bot_level: ERROR - failed to release workspace array.') 784 RETURN 785 END IF 729 786 ! 730 787 END SUBROUTINE zgr_bot_level … … 803 860 !! Reference : Pacanowsky & Gnanadesikan 1997, Mon. Wea. Rev., 126, 3248-3270. 804 861 !!---------------------------------------------------------------------- 862 USE wrk_nemo, ONLY: wrk_use, wrk_release 863 USE wrk_nemo, ONLY: zprt => wrk_3d_1 864 !! 805 865 INTEGER :: ji, jj, jk ! dummy loop indices 806 866 INTEGER :: ik, it ! temporary integers … … 811 871 REAL(wp) :: zdiff ! temporary scalar 812 872 REAL(wp) :: zrefdep ! temporary scalar 813 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zprt ! 3D workspace814 873 !!--------------------------------------------------------------------- 874 ! 875 IF( .not. wrk_use(3, 1))THEN 876 CALL ctl_stop('zgr_zps: ERROR - requested workspace unavailable.') 877 RETURN 878 END IF 815 879 816 880 IF(lwp) WRITE(numout,*) … … 1004 1068 ENDIF 1005 1069 ! 1070 IF( .not. wrk_release(3, 1))THEN 1071 CALL ctl_stop('zgr_zps: ERROR - failed to release workspace.') 1072 RETURN 1073 END IF 1074 ! 1006 1075 END SUBROUTINE zgr_zps 1007 1076 … … 1090 1159 !! Reference : Madec, Lott, Delecluse and Crepon, 1996. JPO, 26, 1393-1408. 1091 1160 !!---------------------------------------------------------------------- 1161 USE wrk_nemo, ONLY: wrk_use, wrk_release 1162 USE wrk_nemo, ONLY: zenv => wrk_2d_1, ztmp => wrk_2d_2, zmsk => wrk_2d_3, & 1163 zri => wrk_2d_4, zrj => wrk_2d_5, zhbat => wrk_2d_6 1164 !! 1092 1165 INTEGER :: ji, jj, jk, jl ! dummy loop argument 1093 1166 INTEGER :: iip1, ijp1, iim1, ijm1 ! temporary integers 1094 1167 REAL(wp) :: zcoeft, zcoefw, zrmax, ztaper ! temporary scalars 1095 REAL(wp), DIMENSION(jpi,jpj) :: zenv, ztmp, zmsk ! 2D workspace1096 REAL(wp), DIMENSION(jpi,jpj) :: zri , zrj , zhbat ! - -1097 !!1098 REAL(wp), DIMENSION(jpi,jpj,jpk) :: gsigw31099 REAL(wp), DIMENSION(jpi,jpj,jpk) :: gsigt31100 REAL(wp), DIMENSION(jpi,jpj,jpk) :: gsi3w31101 REAL(wp), DIMENSION(jpi,jpj,jpk) :: esigt31102 REAL(wp), DIMENSION(jpi,jpj,jpk) :: esigw31103 REAL(wp), DIMENSION(jpi,jpj,jpk) :: esigtu31104 REAL(wp), DIMENSION(jpi,jpj,jpk) :: esigtv31105 REAL(wp), DIMENSION(jpi,jpj,jpk) :: esigtf31106 REAL(wp), DIMENSION(jpi,jpj,jpk) :: esigwu31107 REAL(wp), DIMENSION(jpi,jpj,jpk) :: esigwv31108 1168 !! 1109 1169 NAMELIST/namzgr_sco/ rn_sbot_max, rn_sbot_min, rn_theta, rn_thetb, rn_rmax, ln_s_sigma, rn_bb, rn_hc 1110 1170 !!---------------------------------------------------------------------- 1171 1172 IF(.not. wrk_use(2, 1,2,3,4,5,6))THEN 1173 CALL ctl_stop('zgr_sco: ERROR - requested workspace arrays unavailable') 1174 RETURN 1175 END IF 1111 1176 1112 1177 REWIND( numnam ) ! Read Namelist namzgr_sco : sigma-stretching parameters … … 1551 1616 !!gm bug #endif 1552 1617 ! 1618 IF(.not. wrk_release(2, 1,2,3,4,5,6))THEN 1619 CALL ctl_stop('zgr_sco: ERROR - failed to release workspace arrays') 1620 END IF 1621 ! 1553 1622 END SUBROUTINE zgr_sco 1554 1623 -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90
r2528 r2590 446 446 !! p=integral [ rau*g dz ] 447 447 !!---------------------------------------------------------------------- 448 USE wrk_nemo, ONLY: wrk_use, wrk_release 449 USE wrk_nemo, ONLY: zprn => wrk_3d_1 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(.NOT. wrk_use(3, 1))THEN 461 CALL ctl_stop('istage_uvg: requested workspace array unavailable.') 462 RETURN 463 END IF 457 464 458 465 IF(lwp) WRITE(numout,*) … … 551 558 rotb (:,:,:) = rotn (:,:,:) ! set the before to the now value 552 559 ! 560 IF(.NOT. wrk_release(3, 1))THEN 561 CALL ctl_stop('istage_uvg: failed to release workspace array.') 562 END IF 563 ! 553 564 END SUBROUTINE istate_uvg 554 565
Note: See TracChangeset
for help on using the changeset viewer.
