Changeset 2715 for trunk/NEMOGCM/NEMO/OPA_SRC/LDF
- Timestamp:
- 2011-03-30T17:58:35+02:00 (13 years ago)
- Location:
- trunk/NEMOGCM/NEMO/OPA_SRC/LDF
- Files:
-
- 12 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn.F90
r2528 r2715 38 38 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 39 39 !! $Id$ 40 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 41 !!---------------------------------------------------------------------- 42 40 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 41 !!---------------------------------------------------------------------- 43 42 CONTAINS 44 43 … … 63 62 !!---------------------------------------------------------------------- 64 63 INTEGER :: ioptio ! ??? 65 LOGICAL :: ll_print = .FALSE. ! Logical flag for printing viscosity coef.64 LOGICAL :: ll_print = .FALSE. ! Logical flag for printing viscosity coef. 66 65 !! 67 66 NAMELIST/namdyn_ldf/ ln_dynldf_lap , ln_dynldf_bilap, & … … 207 206 REAL(wp), INTENT(in ) :: pwam ! width of inflection 208 207 REAL(wp), INTENT(in ) :: pbot ! bottom value (0<pbot<= 1) 209 REAL(wp), INTENT(in ), DIMENSION (jpk) :: pdep ! depth of the gridpoint (T, U, V, F)210 REAL(wp), INTENT(inout), DIMENSION (jpi,jpj,jpk) :: pah ! adimensional vertical profile208 REAL(wp), INTENT(in ), DIMENSION (:) :: pdep ! depth of the gridpoint (T, U, V, F) 209 REAL(wp), INTENT(inout), DIMENSION (:,:,:) :: pah ! adimensional vertical profile 211 210 !! 212 211 INTEGER :: jk ! dummy loop indices … … 249 248 REAL(wp), INTENT(in ) :: pwam ! width of inflection 250 249 REAL(wp), INTENT(in ) :: pbot ! bottom value (0<pbot<= 1) 251 REAL(wp), INTENT(in ), DIMENSION (jpi,jpj,jpk) :: pdep ! dep of the gridpoint (T, U, V, F)252 REAL(wp), INTENT(inout), DIMENSION (jpi,jpj,jpk) :: pah ! adimensional vertical profile250 REAL(wp), INTENT(in ), DIMENSION (:,:,:) :: pdep ! dep of the gridpoint (T, U, V, F) 251 REAL(wp), INTENT(inout), DIMENSION (:,:,:) :: pah ! adimensional vertical profile 253 252 !! 254 253 INTEGER :: jk ! dummy loop indices -
trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c1d.h90
r2528 r2715 24 24 !! 25 25 !!---------------------------------------------------------------------- 26 !! * Arguments 27 LOGICAL, INTENT (in) :: ld_print ! If true, output arrays on numout 28 29 !! * Local variables 26 LOGICAL, INTENT(in) :: ld_print ! If true, output arrays on numout 27 ! 30 28 INTEGER :: jk ! dummy loop indice 31 29 REAL(wp) :: zdam, zwam, zm00, zm01, zmhf, zmhs … … 37 35 IF(lwp) WRITE(numout,*) 'inildf: 1D eddy viscosity coefficient' 38 36 IF(lwp) WRITE(numout,*) '~~~~~~ --' 39 IF(lwp) WRITE(numout,*)40 37 41 38 ! Set ahm1 for laplacian (always at t-level) … … 124 121 ENDIF 125 122 9120 FORMAT(' jk ahm ',' depth w-level ' ) 126 123 ! 127 124 END SUBROUTINE ldf_dyn_c1d -
trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c2d.h90
r2528 r2715 32 32 !! 33 33 !!---------------------------------------------------------------------- 34 !! * Arguments35 34 LOGICAL, INTENT (in) :: ld_print ! If true, output arrays on numout 36 37 !! * Local variables 38 INTEGER :: ji, jj 35 ! 36 INTEGER :: ji, jj 39 37 REAL(wp) :: za00, zd_max, zetmax, zeumax, zefmax, zevmax 40 38 !!---------------------------------------------------------------------- … … 43 41 IF(lwp) WRITE(numout,*) 'ldf_dyn_c2d : 2d lateral eddy viscosity coefficient' 44 42 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 45 IF(lwp) WRITE(numout,*)46 43 47 44 ! harmonic operator (ahm1, ahm2) : ( T- and F- points) (used for laplacian operators … … 123 120 ENDIF 124 121 ENDIF 125 126 122 ! 127 123 END SUBROUTINE ldf_dyn_c2d 128 124 … … 143 139 !! 144 140 !!---------------------------------------------------------------------- 145 !! * Modules used146 USE ldftra_oce, ONLY : aht0147 148 ! ! * Arguments141 USE ldftra_oce, ONLY: aht0 142 USE wrk_nemo , ONLY: iwrk_in_use, iwrk_not_released 143 USE wrk_nemo , ONLY: icof => iwrk_2d_1 144 ! 149 145 LOGICAL, INTENT (in) :: ld_print ! If true, output arrays on numout 150 151 !! * Local variables152 INTEGER :: ji, jj, jn ! dummy loop indices153 INTEGER :: inum ! temporary logical unit154 INTEGER :: iim, ijm155 INTEGER :: ifreq, il1, il2, ij, ii146 ! 147 INTEGER :: ji, jj, jn ! dummy loop indices 148 INTEGER :: inum, iim, ijm ! local integers 149 INTEGER :: ifreq, il1, il2, ij, ii 150 REAL(wp) :: zahmeq, zcoft, zcoff, zmsk 151 CHARACTER (len=15) :: clexp 156 152 INTEGER, DIMENSION(jpidta,jpidta) :: idata 157 INTEGER, DIMENSION(jpi ,jpj ) :: icof 158 159 REAL(wp) :: zahmeq, zcoft, zcoff, zmsk 160 161 CHARACTER (len=15) :: clexp 162 !!---------------------------------------------------------------------- 153 !!---------------------------------------------------------------------- 154 155 IF( iwrk_in_use(2, 1) )THEN 156 CALL ctl_stop('ldf_dyn_c2d_orca: requested workspace array is unavailable') ; RETURN 157 ENDIF 163 158 164 159 IF(lwp) WRITE(numout,*) 165 160 IF(lwp) WRITE(numout,*) 'inildf: 2d eddy viscosity coefficient' 166 161 IF(lwp) WRITE(numout,*) '~~~~~~ --' 167 IF(lwp) WRITE(numout,*) 168 IF(lwp) WRITE(numout,*) ' orca ocean model' 169 IF(lwp) WRITE(numout,*) 162 IF(lwp) WRITE(numout,*) ' orca ocean configuration' 170 163 171 164 #if defined key_antarctic … … 288 281 ENDIF 289 282 283 IF( iwrk_not_released(2, 1) ) CALL ctl_stop('ldf_dyn_c2d_orca: failed to release workspace array') 284 ! 290 285 END SUBROUTINE ldf_dyn_c2d_orca 286 291 287 292 288 SUBROUTINE ldf_dyn_c2d_orca_R1( ld_print ) … … 305 301 !! 306 302 !!---------------------------------------------------------------------- 307 !! * Modules used308 USE ldftra_oce, ONLY : aht0309 310 ! ! * Arguments303 USE ldftra_oce, ONLY: aht0 304 USE wrk_nemo , ONLY: iwrk_in_use, iwrk_not_released 305 USE wrk_nemo , ONLY: icof => iwrk_2d_1 306 ! 311 307 LOGICAL, INTENT (in) :: ld_print ! If true, output arrays on numout 312 313 !! * Local variables 308 ! 314 309 INTEGER :: ji, jj, jn ! dummy loop indices 315 310 INTEGER :: inum ! temporary logical unit 316 311 INTEGER :: iim, ijm 317 312 INTEGER :: ifreq, il1, il2, ij, ii 313 REAL(wp) :: zahmeq, zcoft, zcoff, zmsk, zam20s 314 CHARACTER (len=15) :: clexp 318 315 INTEGER, DIMENSION(jpidta,jpidta) :: idata 319 INTEGER, DIMENSION(jpi ,jpj ) :: icof 320 321 REAL(wp) :: zahmeq, zcoft, zcoff, zmsk, zam20s 322 323 CHARACTER (len=15) :: clexp 324 !!---------------------------------------------------------------------- 316 !!---------------------------------------------------------------------- 317 318 IF( iwrk_in_use(2, 1) ) THEN 319 CALL ctl_stop('ldf_dyn_c2d_orca_R1: requested workspace array is unavailable') ; RETURN 320 ENDIF 325 321 326 322 IF(lwp) WRITE(numout,*) 327 323 IF(lwp) WRITE(numout,*) 'inildf: 2d eddy viscosity coefficient' 328 324 IF(lwp) WRITE(numout,*) '~~~~~~ --' 329 IF(lwp) WRITE(numout,*) 330 IF(lwp) WRITE(numout,*) ' orca_r1 ocean model' 331 IF(lwp) WRITE(numout,*) 325 IF(lwp) WRITE(numout,*) ' orca_r1 configuration' 332 326 333 327 #if defined key_antarctic … … 457 451 ENDIF 458 452 453 IF( iwrk_not_released(2, 1) ) CALL ctl_stop('ldf_dyn_c2d_orca_R1: failed to release workspace array') 454 ! 459 455 END SUBROUTINE ldf_dyn_c2d_orca_R1 -
trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c3d.h90
r2528 r2715 26 26 !! ??? explanation of the default is missing 27 27 !!---------------------------------------------------------------------- 28 USE ldftra_oce, ONLY : aht029 !!30 LOGICAL, INTENT (in) :: ld_print ! If true, output arrays on numout31 !! 32 INTEGER :: ji, jj, jk ! dummy loop indices33 REAL(wp) :: &34 zr = 0.2 , & ! maximum of the reduction factor at the bottom ocean35 ! !( 0 < zr < 1 )36 zh = 500., &! depth of at which start the reduction ( > dept(1) )37 zd_max , &! maximum grid spacing over the global domain38 za00, zc, zd ! temporaryscalars39 REAL(wp) :: &40 zetmax, zefmax, & 41 zeumax, zevmax42 REAL(wp), DIMENSION(jpk) :: zcoef ! temporary workspace43 !!----------------------------------------------------------------------28 USE ldftra_oce, ONLY : aht0 29 USE wrk_nemo , ONLY: wrk_in_use, wrk_not_released 30 USE wrk_nemo , ONLY: zcoef => wrk_1d_2 31 !! 32 LOGICAL, INTENT (in) :: ld_print ! If true, output arrays on numout 33 !! 34 INTEGER :: ji, jj, jk ! dummy loop indices 35 REAL(wp) :: zr = 0.2 ! maximum of the reduction factor at the bottom ocean ( 0 < zr < 1 ) 36 REAL(wp) :: zh = 500. ! depth of at which start the reduction ( > dept(1) ) 37 REAL(wp) :: zd_max ! maximum grid spacing over the global domain 38 REAL(wp) :: za00, zc, zd, zetmax, zefmax, zeumax, zevmax ! local scalars 39 !!---------------------------------------------------------------------- 40 41 IF( wrk_in_use(1,2) ) THEN 42 CALL ctl_stop('ldf_dyn_c3d: requested workspace array unavailable') ; RETURN 43 ENDIF 44 44 45 45 IF(lwp) WRITE(numout,*) … … 181 181 ENDIF 182 182 ENDIF 183 183 ! 184 IF( wrk_not_released(1,2) ) CALL ctl_stop('ldf_dyn_c3d: failed to release workspace array') 185 ! 184 186 END SUBROUTINE ldf_dyn_c3d 185 187 … … 193 195 !! ** Method : blah blah blah .... 194 196 !!---------------------------------------------------------------------- 195 USE ldftra_oce, ONLY : aht0 196 !! 197 LOGICAL, INTENT (in) :: ld_print ! If true, output arrays on numout 197 USE ldftra_oce, ONLY: aht0 198 USE wrk_nemo , ONLY: wrk_in_use, wrk_not_released, iwrk_in_use, iwrk_not_released 199 USE wrk_nemo , ONLY: icof => iwrk_2d_1 200 USE wrk_nemo , ONLY: zahm0 => wrk_2d_1 201 USE wrk_nemo , ONLY: zcoef => wrk_1d_1 202 !! 203 LOGICAL, INTENT(in) :: ld_print ! If true, output arrays on numout 198 204 !! 199 205 INTEGER :: ji, jj, jk, jn ! dummy loop indices 200 INTEGER :: ii0, ii1, ij0, ij1 ! temporary integers 201 INTEGER :: inum ! temporary logical unit 202 INTEGER :: iim, ijm 206 INTEGER :: ii0, ii1, ij0, ij1 ! local integers 207 INTEGER :: inum, iim, ijm ! 203 208 INTEGER :: ifreq, il1, il2, ij, ii 204 209 INTEGER, DIMENSION(jpidta, jpjdta) :: idata 205 INTEGER, DIMENSION(jpi , jpj ) :: icof 206 207 REAL(wp) :: & 208 zahmeq, zcoff, zcoft, zmsk, & ! ??? 209 zemax, zemin, zeref, zahmm 210 REAL(wp), DIMENSION(jpi,jpj) :: zahm0 211 REAL(wp), DIMENSION(jpk) :: zcoef 212 210 211 REAL(wp) :: zahmeq, zcoff, zcoft, zmsk ! local scalars 212 REAL(wp) :: zemax , zemin, zeref, zahmm 213 213 CHARACTER (len=15) :: clexp 214 214 !!---------------------------------------------------------------------- 215 216 IF( iwrk_in_use(2,1) .OR. wrk_in_use(2,1) .OR. wrk_in_use(1,1) ) THEN 217 CALL ctl_stop('ldf_dyn_c3d_orca: requested workspace arrays are unavailable') ; RETURN 218 ENDIF 215 219 216 220 IF(lwp) WRITE(numout,*) 217 221 IF(lwp) WRITE(numout,*) 'ldfdyn_c3d_orca : 3D eddy viscosity coefficient' 218 222 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~' 219 IF(lwp) WRITE(numout,*) 220 IF(lwp) WRITE(numout,*) ' orca R1, R2 or R4 ocean model' 221 IF(lwp) WRITE(numout,*) ' reduced in the surface Eq. strip ' 222 IF(lwp) WRITE(numout,*) 223 IF(lwp) WRITE(numout,*) ' orca R1, R2 or R4 configuration: reduced in the surface Eq. strip ' 223 224 224 225 ! Read 2d integer array to specify western boundary increase in the … … 457 458 ENDIF 458 459 460 IF( iwrk_not_released(2,1) .OR. & 461 wrk_not_released(2,1) .OR. & 462 wrk_not_released(1,1) ) CALL ctl_stop('ldf_dyn_c3d_orca: failed to release workspace arrays') 463 ! 459 464 END SUBROUTINE ldf_dyn_c3d_orca -
trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_oce.F90
r2528 r2715 6 6 !! History : 1.0 ! 2002-11 (G. Madec) F90: Free form and module 7 7 !!---------------------------------------------------------------------- 8 USE par_oce ! ocean parameters 8 USE par_oce ! ocean parameters 9 USE in_out_manager ! I/O manager 10 USE lib_mpp ! MPP library 9 11 10 12 IMPLICIT NONE … … 20 22 REAL(wp), PUBLIC :: rn_ahmb_0 = 0._wp !: lateral laplacian background eddy viscosity (m2/s) 21 23 REAL(wp), PUBLIC :: rn_ahm_0_blp = 0._wp !: lateral bilaplacian eddy viscosity (m4/s) 22 REAL(wp), PUBLIC :: ahm0, ahmb0, ahm0_blp ! OLD namelist names24 REAL(wp), PUBLIC :: ahm0, ahmb0, ahm0_blp !: OLD namelist names 23 25 26 ! !!! eddy coeff. at U-,V-,W-pts [m2/s] 24 27 #if defined key_dynldf_c3d 25 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: ahm1, ahm2, ahm3, ahm4 !** 3D coefficients **28 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ahm1, ahm2, ahm3, ahm4 !: ** 3D coefficients ** 26 29 #elif defined key_dynldf_c2d 27 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: ahm1, ahm2, ahm3, ahm4 !** 2D coefficients **30 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ahm1, ahm2, ahm3, ahm4 !: ** 2D coefficients ** 28 31 #elif defined key_dynldf_c1d 29 REAL(wp), PUBLIC, DIMENSION(jpk) :: ahm1, ahm2, ahm3, ahm4 !** 2D coefficients **32 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ahm1, ahm2, ahm3, ahm4 !: ** 2D coefficients ** 30 33 #else 31 REAL(wp), PUBLIC :: ahm1, ahm2, ahm3, ahm4 !** 0D coefficients **34 REAL(wp), PUBLIC :: ahm1, ahm2, ahm3, ahm4 !: ** 0D coefficients ** 32 35 #endif 33 36 34 37 !!---------------------------------------------------------------------- 35 !! NEMO/OPA 3.3 , NEMO Consortium (2010)38 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 36 39 !! $Id$ 37 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 40 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 41 !!---------------------------------------------------------------------- 42 CONTAINS 43 44 INTEGER FUNCTION ldfdyn_oce_alloc() 45 !!---------------------------------------------------------------------- 46 !! *** FUNCTION ldfdyn_oce_alloc *** 47 !!---------------------------------------------------------------------- 48 ldfdyn_oce_alloc = 0 49 #if defined key_dynldf_c3d 50 ALLOCATE( ahm1(jpi,jpj,jpk) , ahm2(jpi,jpj,jpk) , ahm3(jpi,jpj,jpk) , ahm4(jpi,jpj,jpk) , STAT=ldfdyn_oce_alloc ) 51 #elif defined key_dynldf_c2d 52 ALLOCATE( ahm1(jpi,jpj ) , ahm2(jpi,jpj ) , ahm3(jpi,jpj ) , ahm4(jpi,jpj ) , STAT=ldfdyn_oce_alloc ) 53 #elif defined key_dynldf_c1d 54 ALLOCATE( ahm1( jpk) , ahm2( jpk) , ahm3( jpk) , ahm4( jpk) , STAT=ldfdyn_oce_alloc ) 55 #endif 56 IF( ldfdyn_oce_alloc /= 0 ) CALL ctl_warn('ldfdyn_oce_alloc: failed to allocate arrays') 57 ! 58 END FUNCTION ldfdyn_oce_alloc 59 38 60 !!====================================================================== 39 61 END MODULE ldfdyn_oce -
trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfeiv.F90
r2528 r2715 53 53 !! - wslpi, wslpj : i- and j-slopes of neutral surfaces at w-points. 54 54 !!---------------------------------------------------------------------- 55 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 56 USE wrk_nemo, ONLY: zn => wrk_2d_1 , zah => wrk_2d_2 ! 2D workspace 57 USE wrk_nemo, ONLY: zhw => wrk_2d_3 , zross => wrk_2d_4 58 ! 55 59 INTEGER, INTENT(in) :: kt ! ocean time-step inedx 56 ! !60 ! 57 61 INTEGER :: ji, jj, jk ! dummy loop indices 58 62 REAL(wp) :: zfw, ze3w, zn2, zf20, zaht, zaht_min ! temporary scalars 59 REAL(wp), DIMENSION(jpi,jpj) :: zn, zah, zhw, zross ! 2D workspace60 63 !!---------------------------------------------------------------------- 61 64 65 IF( wrk_in_use(2, 1,2,3,4) ) THEN 66 CALL ctl_stop('ldf_eiv: requested workspace arrays are unavailable.') ; RETURN 67 ENDIF 68 62 69 IF( kt == nit000 ) THEN 63 70 IF(lwp) WRITE(numout,*) … … 235 242 CALL iom_put( "aht2d" , ahtw ) ! lateral eddy diffusivity 236 243 CALL iom_put( "aht2d_eiv", aeiw ) ! EIV lateral eddy diffusivity 244 ! 245 IF( wrk_not_released(2, 1,2,3,4) ) CALL ctl_stop('ldf_eiv: failed to release workspace arrays') 237 246 ! 238 247 END SUBROUTINE ldf_eiv … … 244 253 CONTAINS 245 254 SUBROUTINE ldf_eiv( kt ) ! Empty routine 255 INTEGER :: kt 246 256 WRITE(*,*) 'ldf_eiv: You should not have seen this print! error?', kt 247 257 END SUBROUTINE ldf_eiv -
trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90
r2605 r2715 41 41 LOGICAL , PUBLIC, PARAMETER :: lk_ldfslp = .TRUE. !: slopes flag 42 42 ! !! Madec operator 43 REAL(wp), PUBLIC, DIMENSION(:,:,:) , ALLOCATABLE :: uslp, wslpi !: i_slope at U- and W-points 44 REAL(wp), PUBLIC, DIMENSION(:,:,:) , ALLOCATABLE :: vslp, wslpj !: j-slope at V- and W-points 45 ! !! Griffies operator 46 REAL(wp), PUBLIC, DIMENSION(:,:,:) , ALLOCATABLE :: wslp2 !: wslp**2 from Griffies quarter cells 47 REAL(wp), PUBLIC, DIMENSION(:,:,:,:,:), ALLOCATABLE :: triadi_g, triadj_g !: skew flux slopes relative to geopotentials 48 REAL(wp), PUBLIC, DIMENSION(:,:,:,:,:), ALLOCATABLE :: triadi , triadj !: isoneutral slopes relative to model-coordinate 43 ! Arrays allocated in ldf_slp_init() routine once we know whether we're using the Griffies or Madec operator 44 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: uslp, wslpi !: i_slope at U- and W-points 45 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: vslp, wslpj !: j-slope at V- and W-points 46 ! !! Griffies operator 47 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wslp2 !: wslp**2 from Griffies quarter cells 48 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) :: triadi_g, triadj_g !: skew flux slopes relative to geopotentials 49 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) :: triadi , triadj !: isoneutral slopes relative to model-coordinate 49 50 50 51 ! !! Madec operator 51 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: omlmask ! mask of the surface mixed layer at T-pt 52 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: uslpml, wslpiml ! i_slope at U- and W-points just below the mixed layer 53 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: vslpml, wslpjml ! j_slope at V- and W-points just below the mixed layer 52 ! Arrays allocated in ldf_slp_init() routine once we know whether we're using the Griffies or Madec operator 53 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: omlmask ! mask of the surface mixed layer at T-pt 54 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: uslpml, wslpiml ! i_slope at U- and W-points just below the mixed layer 55 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: vslpml, wslpjml ! j_slope at V- and W-points just below the mixed layer 54 56 55 57 REAL(wp) :: repsln = 1.e-25_wp ! tiny value used as minium of di(rho), dj(rho) and dk(rho) 58 59 ! Workspace arrays for ldf_slp_grif. These could be replaced by several 3D and 2D workspace 60 ! arrays from the wrk_nemo module with a bit of code re-writing. The 4D workspace 61 ! arrays can't be used here because of the zero-indexing of some of the ranks. ARPDBG. 62 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: zdzrho , zdyrho, zdxrho ! Horizontal and vertical density gradients 63 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: zti_mlb, ztj_mlb ! for Griffies operator only 56 64 57 65 !! * Substitutions … … 61 69 # include "vectopt_loop_substitute.h90" 62 70 !!---------------------------------------------------------------------- 63 !! NEMO/OPA 3.3 , NEMO Consortium (2010)71 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 64 72 !! $Id$ 65 73 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 66 74 !!---------------------------------------------------------------------- 67 75 CONTAINS 76 77 INTEGER FUNCTION ldf_slp_alloc() 78 !!---------------------------------------------------------------------- 79 !! *** FUNCTION ldf_slp_alloc *** 80 !!---------------------------------------------------------------------- 81 ! 82 ALLOCATE( zdxrho (jpi,jpj,jpk,0:1) , zti_mlb(jpi,jpj,0:1,0:1) , & 83 & zdyrho (jpi,jpj,jpk,0:1) , ztj_mlb(jpi,jpj,0:1,0:1) , & 84 & zdzrho (jpi,jpj,jpk,0:1) , STAT=ldf_slp_alloc ) 85 ! 86 IF( lk_mpp ) CALL mpp_sum ( ldf_slp_alloc ) 87 IF( ldf_slp_alloc /= 0 ) CALL ctl_warn('ldf_slp_alloc : failed to allocate arrays.') 88 ! 89 END FUNCTION ldf_slp_alloc 90 68 91 69 92 SUBROUTINE ldf_slp( kt, prd, pn2 ) … … 92 115 !! of now neutral surfaces at u-, w- and v- w-points, resp. 93 116 !!---------------------------------------------------------------------- 94 USE oce , zgru => ua ! use ua as workspace95 USE oce , zgrv => va ! use vaas workspace96 USE oce , zww => ta ! use taas workspace97 USE oce , zwz => sa ! use sa asworkspace98 !! 99 INTEGER , INTENT(in) 100 REAL(wp), INTENT(in), DIMENSION( jpi,jpj,jpk) :: prd ! in situ density101 REAL(wp), INTENT(in), DIMENSION( jpi,jpj,jpk) :: pn2 ! Brunt-Vaisala frequency (locally ref.)117 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 118 USE oce , ONLY: zgru => ua , zww => va ! (ua,va) used as workspace 119 USE oce , ONLY: zgrv => ta , zwz => sa ! (ta,sa) used as workspace 120 USE wrk_nemo, ONLY: zdzr => wrk_3d_1 ! 3D workspace 121 !! 122 INTEGER , INTENT(in) :: kt ! ocean time-step index 123 REAL(wp), INTENT(in), DIMENSION(:,:,:) :: prd ! in situ density 124 REAL(wp), INTENT(in), DIMENSION(:,:,:) :: pn2 ! Brunt-Vaisala frequency (locally ref.) 102 125 !! 103 126 INTEGER :: ji , jj , jk ! dummy loop indices … … 108 131 REAL(wp) :: zcj, zfj, zav, zbv, zaj, zbj ! - - 109 132 REAL(wp) :: zck, zfk, zbw ! - - 110 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdzr ! 3D workspace 111 !!---------------------------------------------------------------------- 112 133 !!---------------------------------------------------------------------- 134 135 IF( wrk_in_use(3, 1) ) THEN 136 CALL ctl_stop('ldf_slp: requested workspace arrays are unavailable') ; RETURN 137 ENDIF 138 113 139 zeps = 1.e-20_wp !== Local constant initialization ==! 114 140 z1_16 = 1.0_wp / 16._wp … … 342 368 ENDIF 343 369 344 345 370 ! IV. Lateral boundary conditions 346 371 ! =============================== … … 354 379 ENDIF 355 380 ! 381 IF( wrk_not_released(3, 1) ) CALL ctl_stop('ldf_slp: failed to release workspace arrays') 382 ! 356 383 END SUBROUTINE ldf_slp 357 384 … … 371 398 !! - wslp2 squared slope of neutral surfaces at w-points. 372 399 !!---------------------------------------------------------------------- 373 USE oce, zdit => ua ! use ua as workspace 374 USE oce, zdis => va ! use va as workspace 375 USE oce, zdjt => ta ! use ta as workspace 376 USE oce, zdjs => sa ! use sa as workspace 377 !! 378 INTEGER, INTENT( in ) :: kt ! ocean time-step index 379 !! 400 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 401 USE oce , ONLY: zdit => ua , zdis => va ! (ua,va) used as workspace 402 USE oce , ONLY: zdjt => ta , zdjs => sa ! (ta,sa) used as workspace 403 USE wrk_nemo, ONLY: zdkt => wrk_3d_2 , zdks => wrk_3d_3 ! 3D workspace 404 USE wrk_nemo, ONLY: zalpha => wrk_3d_4 , zbeta => wrk_3d_5 ! alpha, beta at T points, at depth fsgdept 405 USE wrk_nemo, ONLY: z1_mlbw => wrk_2d_1 406 ! 407 INTEGER, INTENT( in ) :: kt ! ocean time-step index 408 ! 380 409 INTEGER :: ji, jj, jk, jl, ip, jp, kp ! dummy loop indices 381 INTEGER :: iku, ikv ! temporaryinteger410 INTEGER :: iku, ikv ! local integer 382 411 REAL(wp) :: zfacti, zfactj, zatempw,zatempu,zatempv ! local scalars 383 REAL(wp) :: zbu, zbv, zbti, zbtj 412 REAL(wp) :: zbu, zbv, zbti, zbtj ! - - 384 413 REAL(wp) :: zdxrho_raw, zti_coord, zti_raw, zti_lim, zti_lim2, zti_g_raw, zti_g_lim 385 414 REAL(wp) :: zdyrho_raw, ztj_coord, ztj_raw, ztj_lim, ztj_lim2, ztj_g_raw, ztj_g_lim 386 415 REAL(wp) :: zdzrho_raw 387 REAL(wp), DIMENSION(jpi,jpj,jpk,0:1) :: zdzrho, zdyrho, zdxrho ! Horizontal and vertical density gradients 388 REAL(wp), DIMENSION(jpi,jpj,0:1,0:1) :: zti_mlb, ztj_mlb 389 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdkt, zdks 390 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zalpha, zbeta ! alpha, beta at T points, at depth fsgdept 391 REAL(wp), DIMENSION(jpi,jpj) :: z1_mlbw 392 !!---------------------------------------------------------------------- 416 !!---------------------------------------------------------------------- 417 418 IF( wrk_in_use(3, 2,3,4,5) .OR. wrk_in_use(2, 1) )THEN 419 CALL ctl_stop('ldf_slp_grif: requested workspace arrays are unavailable') ; RETURN 420 ENDIF 393 421 394 422 !--------------------------------! … … 572 600 CALL lbc_lnk( wslp2, 'W', 1. ) ! lateral boundary confition on wslp2 only ==>>> gm : necessary ? to be checked 573 601 ! 602 IF( wrk_not_released(3, 2,3,4,5) .OR. & 603 wrk_not_released(2, 1) ) CALL ctl_stop('ldf_slp_grif: failed to release workspace arrays') 604 ! 574 605 END SUBROUTINE ldf_slp_grif 575 606 … … 591 622 !! omlmask : mixed layer mask 592 623 !!---------------------------------------------------------------------- 593 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT(in) :: prd ! in situ density594 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT(in) :: pn2 ! Brunt-Vaisala frequency (locally ref.)595 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT(in) :: p_gru, p_grv ! i- & j-gradient of density (u- & v-pts)596 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT(in) :: p_dzr ! z-gradient of density (T-point)624 REAL(wp), DIMENSION(:,:,:), INTENT(in) :: prd ! in situ density 625 REAL(wp), DIMENSION(:,:,:), INTENT(in) :: pn2 ! Brunt-Vaisala frequency (locally ref.) 626 REAL(wp), DIMENSION(:,:,:), INTENT(in) :: p_gru, p_grv ! i- & j-gradient of density (u- & v-pts) 627 REAL(wp), DIMENSION(:,:,:), INTENT(in) :: p_dzr ! z-gradient of density (T-point) 597 628 !! 598 629 INTEGER :: ji , jj , jk ! dummy loop indices … … 704 735 !! 705 736 !! ** Method : read the nammbf namelist and check the parameter 706 !! values called by tra_dmp at the first timestep (nit000)737 !! values called by tra_dmp at the first timestep (nit000) 707 738 !!---------------------------------------------------------------------- 708 739 INTEGER :: ji, jj, jk ! dummy loop indices … … 719 750 ALLOCATE( triadi_g(jpi,jpj,jpk,0:1,0:1) , triadj_g(jpi,jpj,jpk,0:1,0:1) , wslp2(jpi,jpj,jpk) , STAT=ierr ) 720 751 ALLOCATE( triadi (jpi,jpj,jpk,0:1,0:1) , triadj (jpi,jpj,jpk,0:1,0:1) , STAT=ierr ) 721 IF( ierr > 0 ) THEN 722 CALL ctl_stop( 'ldf_slp_init : unable to allocate Griffies operator slope ' ) ; RETURN 723 ENDIF 752 IF( ierr > 0 ) CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate Griffies operator slope' ) 753 IF( ldf_slp_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate workspace arrays' ) 724 754 ! 725 755 IF( ln_dynldf_iso ) CALL ctl_stop( 'ldf_slp_init: Griffies operator on momentum not supported' ) 726 756 ! 727 IF( ( ln_traldf_hor .AND. ln_dynldf_hor ) .AND. ln_sco ) & 728 & CALL ctl_stop( 'ldf_slp_init: horizontal Griffies operator ', & 729 & 'in s-coordinate not supported' ) 757 IF( ( ln_traldf_hor .OR. ln_dynldf_hor ) .AND. ln_sco ) & 758 CALL ctl_stop( 'ldf_slp_init: horizontal Griffies operator in s-coordinate not supported' ) 730 759 ! 731 760 ELSE ! Madec operator : slopes at u-, v-, and w-points 732 761 ALLOCATE( uslp(jpi,jpj,jpk) , vslp(jpi,jpj,jpk) , wslpi(jpi,jpj,jpk) , wslpj(jpi,jpj,jpk) , & 733 762 & omlmask(jpi,jpj,jpk) , uslpml(jpi,jpj) , vslpml(jpi,jpj) , wslpiml(jpi,jpj) , wslpjml(jpi,jpj) , STAT=ierr ) 734 IF( ierr > 0 ) THEN 735 CALL ctl_stop( 'ldf_slp_init : unable to allocate Madec operator slope ' ) ; RETURN 736 ENDIF 763 IF( ierr > 0 ) CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate Madec operator slope ' ) 737 764 738 765 ! Direction of lateral diffusion (tracers and/or momentum) … … 745 772 !!gm I no longer understand this..... 746 773 IF( (ln_traldf_hor .OR. ln_dynldf_hor) .AND. .NOT. (lk_vvl .AND. ln_rstart) ) THEN 747 IF(lwp) THEN 748 WRITE(numout,*) ' Horizontal mixing in s-coordinate: slope = slope of s-surfaces' 749 ENDIF 774 IF(lwp) WRITE(numout,*) ' Horizontal mixing in s-coordinate: slope = slope of s-surfaces' 750 775 751 776 ! geopotential diffusion in s-coordinates on tracers and/or momentum … … 765 790 END DO 766 791 END DO 767 ! Lateral boundary conditions on the slopes 768 CALL lbc_lnk( uslp , 'U', -1. ) ; CALL lbc_lnk( vslp , 'V', -1. ) 769 CALL lbc_lnk( wslpi, 'W', -1. ) ; CALL lbc_lnk( wslpj, 'W', -1. ) 792 CALL lbc_lnk( uslp , 'U', -1. ) ; CALL lbc_lnk( vslp , 'V', -1. ) ! Lateral boundary conditions 793 CALL lbc_lnk( wslpi, 'W', -1. ) ; CALL lbc_lnk( wslpj, 'W', -1. ) 770 794 ENDIF 771 ENDIF ! 795 ENDIF 796 ! 772 797 END SUBROUTINE ldf_slp_init 773 798 -
trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90
r2528 r2715 36 36 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 37 37 !! $Id$ 38 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)38 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 39 39 !!---------------------------------------------------------------------- 40 41 40 CONTAINS 42 41 -
trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c1d.h90
r2528 r2715 6 6 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 7 7 !! $Id$ 8 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)8 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 9 9 !!---------------------------------------------------------------------- 10 10 … … 28 28 !! always harmonic : aeiu = aeiv defined at T-level 29 29 !! aeiw defined at w-level 30 !!31 30 !!---------------------------------------------------------------------- 32 !! * Arguments 33 LOGICAL, INTENT (in) :: ld_print ! If true, print arrays in numout 34 35 !! * Local variables 36 INTEGER :: jk ! dummy loop indices 37 REAL(wp) :: & 38 zkah, zahr, za00 , za01, & ! temporary scalars 39 zahf, zahs, zahtf, zahts 31 LOGICAL, INTENT (in) :: ld_print ! If true, print arrays in numout 32 ! 33 INTEGER :: jk ! dummy loop indices 34 REAL(wp) :: zkah, zahr, za00 , za01 ! local scalars 35 REAL(wp) :: zahf, zahs, zahtf, zahts ! - - 40 36 !!---------------------------------------------------------------------- 41 37 … … 130 126 ENDIF 131 127 #endif 132 128 ! 133 129 END SUBROUTINE ldf_tra_c1d -
trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c2d.h90
r2528 r2715 25 25 !! eddy induced velocity 26 26 !! always harmonic : aeiu, aeiv, aeiw defined at u-, v-, w-pts 27 !!28 27 !!---------------------------------------------------------------------- 29 !! * Arguments 30 LOGICAL, INTENT (in) :: ld_print ! If true, print arrays in numout 31 32 !! * Local variables 33 INTEGER :: ji, jj ! dummy loop indices 28 LOGICAL, INTENT (in) :: ld_print ! If true, print arrays in numout 29 ! 30 INTEGER :: ji, jj ! dummy loop indices 34 31 # if defined key_orca_r4 35 32 INTEGER :: i1, i2, j1, j2 36 33 # endif 37 34 REAL(wp) :: za00, zd_max, zeumax, zevmax, zetmax 38 39 35 !!---------------------------------------------------------------------- 40 36 … … 43 39 IF(lwp) WRITE(numout,*) ' ldf_tra_c2d : 2D eddy diffusivity and eddy' 44 40 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~ -- induced velocity coefficients' 45 IF(lwp) WRITE(numout,*)46 41 ELSE 47 42 IF(lwp) WRITE(numout,*) 48 43 IF(lwp) WRITE(numout,*) ' ldf_tra2d : 2D eddy diffusivity coefficient' 49 44 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~ --' 50 IF(lwp) WRITE(numout,*)51 45 ENDIF 52 46 … … 57 51 ! ================== 58 52 IF( ln_traldf_lap ) THEN 59 53 ! 60 54 za00 = aht0 / zd_max 61 55 ! 62 56 DO jj = 1, jpj 63 57 DO ji = 1, jpi … … 167 161 CALL prihre(aeiw,jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout) 168 162 ENDIF 169 170 163 # endif 171 164 ! 172 165 END SUBROUTINE ldf_tra_c2d -
trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_c3d.h90
r2528 r2715 6 6 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 7 7 !! $Id$ 8 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)8 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 9 9 !!---------------------------------------------------------------------- 10 10 … … 29 29 !! eddy induced velocity 30 30 !! always harmonic : aeiu, aeiv, aeiw defined at u-, v-, w-pts 31 !!32 31 !!---------------------------------------------------------------------- 33 !! * Modules used34 32 USE ioipsl 35 36 !! * Arguments 37 LOGICAL, INTENT (in) :: ld_print ! If true, output arrays on numout 38 33 ! 34 LOGICAL, INTENT (in) :: ld_print ! If true, output arrays on numout 39 35 !!---------------------------------------------------------------------- 40 36 … … 44 40 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~ -- ' 45 41 IF(lwp) WRITE(numout,*) ' Coefficients set to constant' 46 IF(lwp) WRITE(numout,*)47 42 ELSE 48 43 IF(lwp) WRITE(numout,*) … … 50 45 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~ -- ' 51 46 IF(lwp) WRITE(numout,*) ' Coefficients set to constant' 52 IF(lwp) WRITE(numout,*)53 47 ENDIF 54 48 … … 127 121 CALL prihre(aeiw(:,:,1),jpi,jpj,1,jpi,1,1,jpj,1,1.e-3,numout) 128 122 ENDIF 129 130 END SUBROUTINE ldf_tra_c3d123 ! 124 END SUBROUTINE ldf_tra_c3d -
trunk/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_oce.F90
r2528 r2715 4 4 !! Ocean physics : lateral tracer mixing coefficient defined in memory 5 5 !!===================================================================== 6 !! History : 9.0 ! 02-11 (G. Madec) Original code6 !! History : 9.0 ! 2002-11 (G. Madec) Original code 7 7 !!---------------------------------------------------------------------- 8 USE par_oce ! ocean parameters 8 USE par_oce ! ocean parameters 9 USE in_out_manager ! I/O manager 10 USE lib_mpp ! MPP library 9 11 10 12 IMPLICIT NONE 11 13 PRIVATE 14 15 PUBLIC ldftra_oce_alloc ! called by nemo_init->nemo_alloc, nemogcm.F90 12 16 13 17 !!---------------------------------------------------------------------- … … 32 36 33 37 #if defined key_traldf_c3d 34 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: ahtt, ahtu, ahtv, ahtw !: ** 3D coefficients ** at T-, U-, V-,W-points38 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ahtt, ahtu, ahtv, ahtw !: ** 3D coefficients ** at T-,U-,V-,W-points 35 39 #elif defined key_traldf_c2d 36 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: ahtt, ahtu, ahtv, ahtw !: ** 2D coefficients ** at T-, U-, V-,W-points40 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ahtt, ahtu, ahtv, ahtw !: ** 2D coefficients ** at T-,U-,V-,W-points 37 41 #elif defined key_traldf_c1d 38 REAL(wp), PUBLIC, DIMENSION(jpk) :: ahtt, ahtu, ahtv, ahtw !: ** 1D coefficients ** at T-, U-, V-,W-points42 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ahtt, ahtu, ahtv, ahtw !: ** 1D coefficients ** at T-,U-,V-,W-points 39 43 #else 40 REAL(wp), PUBLIC :: ahtt, ahtu, ahtv, ahtw !: ** 0D coefficients ** at T-, U-, V-,W-points44 REAL(wp), PUBLIC :: ahtt, ahtu, ahtv, ahtw !: ** 0D coefficients ** at T-,U-,V-,W-points 41 45 #endif 42 43 46 44 47 #if defined key_traldf_eiv … … 47 50 !!---------------------------------------------------------------------- 48 51 LOGICAL, PUBLIC, PARAMETER :: lk_traldf_eiv = .TRUE. !: eddy induced velocity flag 49 52 53 ! !!! eddy coefficients at U-, V-, W-points [m2/s] 50 54 # if defined key_traldf_c3d 51 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: aeiu, aeiv, aeiw !: ** 3D coefficients ** at U-, V-, W-points [m2/s]55 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: aeiu , aeiv , aeiw !: ** 3D coefficients ** 52 56 # elif defined key_traldf_c2d 53 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: aeiu, aeiv, aeiw !: ** 2D coefficients ** at U-, V-, W-points [m2/s]57 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: aeiu , aeiv , aeiw !: ** 2D coefficients ** 54 58 # elif defined key_traldf_c1d 55 REAL(wp), PUBLIC, DIMENSION(jpk) :: aeiu, aeiv, aeiw !: ** 1D coefficients ** at U-, V-, W-points [m2/s]59 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: aeiu , aeiv , aeiw !: ** 1D coefficients ** 56 60 # else 57 REAL(wp), PUBLIC :: aeiu, aeiv, aeiw !: ** 0D coefficients ** at U-, V-, W-points [m2/s]61 REAL(wp), PUBLIC :: aeiu , aeiv , aeiw !: ** 0D coefficients ** 58 62 # endif 59 63 # if defined key_diaeiv 60 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: u_eiv, v_eiv, w_eiv !: eddy induced velocity [m/s]64 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: u_eiv, v_eiv, w_eiv !: eddy induced velocity [m/s] 61 65 # endif 62 66 … … 73 77 !! $Id$ 74 78 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 79 !!---------------------------------------------------------------------- 80 CONTAINS 81 82 INTEGER FUNCTION ldftra_oce_alloc() 83 !!---------------------------------------------------------------------- 84 !! *** FUNCTION ldftra_oce_alloc *** 85 !!---------------------------------------------------------------------- 86 INTEGER, DIMENSION(3) :: ierr 87 !!---------------------------------------------------------------------- 88 ierr(:) = 0 89 90 #if defined key_traldf_c3d 91 ALLOCATE( ahtt(jpi,jpj,jpk) , ahtu(jpi,jpj,jpk) , ahtv(jpi,jpj,jpk) , ahtw(jpi,jpj,jpk) , STAT=ierr(1) ) 92 #elif defined key_traldf_c2d 93 ALLOCATE( ahtt(jpi,jpj ) , ahtu(jpi,jpj ) , ahtv(jpi,jpj ) , ahtw(jpi,jpj ) , STAT=ierr(1) ) 94 #elif defined key_traldf_c1d 95 ALLOCATE( ahtt( jpk) , ahtu( jpk) , ahtv( jpk) , ahtw( jpk) , STAT=ierr(1) ) 96 #endif 97 ! 98 #if defined key_traldf_eiv 99 # if defined key_traldf_c3d 100 ALLOCATE( aeiu(jpi,jpj,jpk) , aeiv(jpi,jpj,jpk) , aeiw(jpi,jpj,jpk) , STAT=ierr(2) ) 101 # elif defined key_traldf_c2d 102 ALLOCATE( aeiu(jpi,jpj ) , aeiv(jpi,jpj ) , aeiw(jpi,jpj ) , STAT=ierr(2) ) 103 # elif defined key_traldf_c1d 104 ALLOCATE( aeiu( jpk) , aeiv( jpk) , aeiw( jpk) , STAT=ierr(2) ) 105 # endif 106 # if defined key_diaeiv 107 ALLOCATE( u_eiv(jpi,jpj,jpk), v_eiv(jpi,jpj,jpk), w_eiv(jpi,jpj,jpk), STAT=ierr(3)) 108 # endif 109 #endif 110 ldftra_oce_alloc = MAXVAL( ierr ) 111 IF( ldftra_oce_alloc /= 0 ) CALL ctl_warn('ldftra_oce_alloc: failed to allocate arrays') 112 ! 113 END FUNCTION ldftra_oce_alloc 114 75 115 !!===================================================================== 76 116 END MODULE ldftra_oce
Note: See TracChangeset
for help on using the changeset viewer.