Changeset 2715 for trunk/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90
- Timestamp:
- 2011-03-30T17:58:35+02:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
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
Note: See TracChangeset
for help on using the changeset viewer.