Changeset 4354
- Timestamp:
- 2014-01-17T17:56:32+01:00 (10 years ago)
- Location:
- branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 14 edited
-
BDY/bdy_oce.F90 (modified) (3 diffs)
-
BDY/bdydta.F90 (modified) (9 diffs)
-
BDY/bdydyn.F90 (modified) (6 diffs)
-
BDY/bdydyn2d.F90 (modified) (9 diffs)
-
BDY/bdydyn3d.F90 (modified) (6 diffs)
-
BDY/bdyini.F90 (modified) (1 diff)
-
BDY/bdytides.F90 (modified) (1 diff)
-
DOM/istate.F90 (modified) (3 diffs)
-
DYN/dynnxt.F90 (modified) (3 diffs)
-
DYN/dynspg_oce.F90 (modified) (2 diffs)
-
DYN/dynspg_ts.F90 (modified) (10 diffs)
-
DYN/dynzdf_imp.F90 (modified) (1 diff)
-
nemogcm.F90 (modified) (3 diffs)
-
oce.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90
r4333 r4354 120 120 REAL(wp) :: bdysurftot !: Lateral surface of unstructured open boundary 121 121 122 REAL(wp), POINTER, DIMENSION(:,:) :: pssh !:123 REAL(wp), POINTER, DIMENSION(:,:) :: phur !:124 REAL(wp), POINTER, DIMENSION(:,:) :: phvr !: Pointers for barotropic fields125 REAL(wp), POINTER, DIMENSION(:,:) :: pub2d, pun2d, pua2d !:126 REAL(wp), POINTER, DIMENSION(:,:) :: pvb2d, pvn2d, pva2d !:127 128 122 !!---------------------------------------------------------------------- 129 123 !! open boundary data variables … … 134 128 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: dta_global !: workspace for reading in global data arrays (unstr. bdy) 135 129 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: dta_global2 !: workspace for reading in global data arrays (struct. bdy) 130 !$AGRIF_DO_NOT_TREAT 136 131 TYPE(OBC_INDEX), DIMENSION(jp_bdy), TARGET :: idx_bdy !: bdy indices (local process) 137 132 TYPE(OBC_DATA) , DIMENSION(jp_bdy), TARGET :: dta_bdy !: bdy external data (local process) 138 133 !$AGRIF_END_DO_NOT_TREAT 139 134 !!---------------------------------------------------------------------- 140 135 !! NEMO/OPA 4.0 , NEMO Consortium (2011) … … 153 148 ALLOCATE( bdytmask(jpi,jpj) , bdyumask(jpi,jpj), bdyvmask(jpi,jpj), & 154 149 & STAT=bdy_oce_alloc ) 155 ! 150 ! 151 ! Initialize masks 152 bdytmask(:,:) = 1._wp 153 bdyumask(:,:) = 1._wp 154 bdyvmask(:,:) = 1._wp 155 ! 156 156 IF( lk_mpp ) CALL mpp_sum ( bdy_oce_alloc ) 157 157 IF( bdy_oce_alloc /= 0 ) CALL ctl_warn('bdy_oce_alloc: failed to allocate arrays.') -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90
r4333 r4354 20 20 !! bdy_dta_init : initialise arrays etc for reading of external data 21 21 !!---------------------------------------------------------------------- 22 USE wrk_nemo ! Memory Allocation23 22 USE timing ! Timing 24 23 USE oce ! ocean dynamics and tracers … … 51 50 LOGICAL, DIMENSION(jp_bdy) :: ln_full_vel_array ! =T => full velocities in 3D boundary conditions 52 51 ! =F => baroclinic velocities in 3D boundary conditions 53 52 !$AGRIF_DO_NOT_TREAT 54 53 TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:), TARGET :: bf ! structure of input fields (file informations, fields read) 55 54 !$AGRIF_END_DO_NOT_TREAT 56 55 TYPE(MAP_POINTER), ALLOCATABLE, DIMENSION(:) :: nbmap_ptr ! array of pointers to nbmap 57 56 … … 103 102 ! Calculate depth-mean currents 104 103 !----------------------------- 105 CALL wrk_alloc(jpi,jpj,pun2d,pvn2d)106 107 pun2d(:,:) = 0.e0108 pvn2d(:,:) = 0.e0109 DO ik = 1, jpkm1 !! Vertically integrated momentum trends110 pun2d(:,:) = pun2d(:,:) + fse3u(:,:,ik) * umask(:,:,ik) * un(:,:,ik)111 pvn2d(:,:) = pvn2d(:,:) + fse3v(:,:,ik) * vmask(:,:,ik) * vn(:,:,ik)112 END DO113 pun2d(:,:) = pun2d(:,:) * hur(:,:)114 pvn2d(:,:) = pvn2d(:,:) * hvr(:,:)115 104 116 105 DO ib_bdy = 1, nb_bdy … … 135 124 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 136 125 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 137 dta_bdy(ib_bdy)%u2d(ib) = pun2d(ii,ij) * umask(ii,ij,1)126 dta_bdy(ib_bdy)%u2d(ib) = un_b(ii,ij) * umask(ii,ij,1) 138 127 END DO 139 128 END IF … … 143 132 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 144 133 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 145 dta_bdy(ib_bdy)%v2d(ib) = pvn2d(ii,ij) * vmask(ii,ij,1)134 dta_bdy(ib_bdy)%v2d(ib) = vn_b(ii,ij) * vmask(ii,ij,1) 146 135 END DO 147 136 END IF … … 156 145 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 157 146 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 158 dta_bdy(ib_bdy)%u3d(ib,ik) = ( un(ii,ij,ik) - pun2d(ii,ij) ) * umask(ii,ij,ik)147 dta_bdy(ib_bdy)%u3d(ib,ik) = ( un(ii,ij,ik) - un_b(ii,ij) ) * umask(ii,ij,ik) 159 148 END DO 160 149 END DO … … 166 155 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 167 156 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 168 dta_bdy(ib_bdy)%v3d(ib,ik) = ( vn(ii,ij,ik) - pvn2d(ii,ij) ) * vmask(ii,ij,ik)157 dta_bdy(ib_bdy)%v3d(ib,ik) = ( vn(ii,ij,ik) - vn_b(ii,ij) ) * vmask(ii,ij,ik) 169 158 END DO 170 159 END DO … … 262 251 ENDDO ! ib_bdy 263 252 264 CALL wrk_dealloc(jpi,jpj,pun2d,pvn2d)265 253 266 254 ENDIF ! kt .eq. nit000 … … 919 907 !!============================================================================== 920 908 END MODULE bdydta 909 910 -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn.F90
r4317 r4354 60 60 LOGICAL :: ll_dyn2d, ll_dyn3d, ll_orlanski 61 61 !! 62 REAL(wp), POINTER, DIMENSION(:,:) :: phur1, phvr1 ! inverse depth at u and v points 62 REAL(wp), POINTER, DIMENSION(:,:) :: pua2d, pva2d ! after barotropic velocities 63 REAL(wp), POINTER, DIMENSION(:,:) :: phura, phvra ! after inverse depth at u and v points 63 64 64 65 IF( nn_timing == 1 ) CALL timing_start('bdy_dyn') … … 81 82 !------------------------------------------------------- 82 83 83 pssh => sshn 84 phur => hur 85 phvr => hvr 86 CALL wrk_alloc(jpi,jpj,pua2d,pva2d) 87 IF ( ll_orlanski ) CALL wrk_alloc(jpi,jpj,pub2d,pvb2d,phur1,phvr1) 84 CALL wrk_alloc(jpi,jpj,pua2d,pva2d,phura,phvra) 88 85 89 86 !------------------------------------------------------- … … 97 94 98 95 IF (lk_vvl) THEN 99 phur (:,:) = 0.100 phvr (:,:) = 0.96 phura(:,:) = 0. 97 phvra(:,:) = 0. 101 98 DO jk = 1, jpkm1 102 phur (:,:) = phur(:,:) + fse3u_a(:,:,jk) * umask(:,:,jk)103 phvr (:,:) = phvr(:,:) + fse3v_a(:,:,jk) * vmask(:,:,jk)99 phura(:,:) = phura(:,:) + fse3u_a(:,:,jk) * umask(:,:,jk) 100 phvra(:,:) = phvra(:,:) + fse3v_a(:,:,jk) * vmask(:,:,jk) 104 101 pua2d(:,:) = pua2d(:,:) + fse3u_a(:,:,jk) * umask(:,:,jk) * ua(:,:,jk) 105 102 pva2d(:,:) = pva2d(:,:) + fse3v_a(:,:,jk) * vmask(:,:,jk) * va(:,:,jk) 106 103 END DO 107 phur(:,:) = umask(:,:,1) / ( phur(:,:) + 1. - umask(:,:,1) ) 108 phvr(:,:) = vmask(:,:,1) / ( phvr(:,:) + 1. - vmask(:,:,1) ) 109 pua2d(:,:) = pua2d(:,:) * phur(:,:) 110 pva2d(:,:) = pva2d(:,:) * phvr(:,:) 104 phura(:,:) = umask(:,:,1) / ( phura(:,:) + 1. - umask(:,:,1) ) 105 phvra(:,:) = vmask(:,:,1) / ( phvra(:,:) + 1. - vmask(:,:,1) ) 111 106 ELSE 107 phura(:,:) = hur(:,:) 108 phvra(:,:) = hvr(:,:) 112 109 DO jk = 1, jpkm1 113 110 pua2d(:,:) = pua2d(:,:) + fse3u(:,:,jk) * umask(:,:,jk) * ua(:,:,jk) 114 111 pva2d(:,:) = pva2d(:,:) + fse3v(:,:,jk) * vmask(:,:,jk) * va(:,:,jk) 115 112 END DO 116 pua2d(:,:) = pua2d(:,:) * phur(:,:)117 pva2d(:,:) = pva2d(:,:) * phvr(:,:)118 113 ENDIF 114 pua2d(:,:) = pua2d(:,:) * phura(:,:) 115 pva2d(:,:) = pva2d(:,:) * phvra(:,:) 119 116 120 117 DO jk = 1 , jpkm1 … … 126 123 127 124 IF ( ll_orlanski ) THEN 128 pub2d(:,:) = 0.e0129 pvb2d(:,:) = 0.e0130 131 IF (lk_vvl) THEN132 phur1(:,:) = 0.133 phvr1(:,:) = 0.134 DO jk = 1, jpkm1 !! Vertically integrated momentum trends135 phur1(:,:) = phur1(:,:) + fse3u_b(:,:,jk) * umask(:,:,jk)136 phvr1(:,:) = phvr1(:,:) + fse3v_b(:,:,jk) * vmask(:,:,jk)137 pub2d(:,:) = pub2d(:,:) + fse3u_b(:,:,jk) * umask(:,:,jk) * ub(:,:,jk)138 pvb2d(:,:) = pvb2d(:,:) + fse3v_b(:,:,jk) * vmask(:,:,jk) * vb(:,:,jk)139 END DO140 phur1(:,:) = umask(:,:,1) / ( phur1(:,:) + 1. - umask(:,:,1) )141 phvr1(:,:) = vmask(:,:,1) / ( phvr1(:,:) + 1. - vmask(:,:,1) )142 pub2d(:,:) = pub2d(:,:) * phur1(:,:)143 pvb2d(:,:) = pvb2d(:,:) * phvr1(:,:)144 ELSE145 DO jk = 1, jpkm1 !! Vertically integrated momentum trends146 pub2d(:,:) = pub2d(:,:) + fse3u(:,:,jk) * umask(:,:,jk) * ub(:,:,jk)147 pvb2d(:,:) = pvb2d(:,:) + fse3v(:,:,jk) * vmask(:,:,jk) * vb(:,:,jk)148 END DO149 pub2d(:,:) = pub2d(:,:) * phur(:,:)150 pvb2d(:,:) = pvb2d(:,:) * phvr(:,:)151 ENDIF152 153 125 DO jk = 1 , jpkm1 154 ub(:,:,jk) = (ub(:,:,jk) - pub2d(:,:)) * umask(:,:,jk)155 vb(:,:,jk) = (vb(:,:,jk) - pvb2d(:,:)) * vmask(:,:,jk)126 ub(:,:,jk) = (ub(:,:,jk) - ub_b(:,:)) * umask(:,:,jk) 127 vb(:,:,jk) = (vb(:,:,jk) - vb_b(:,:)) * vmask(:,:,jk) 156 128 END DO 157 129 END IF … … 162 134 !------------------------------------------------------- 163 135 164 IF( ll_dyn2d ) CALL bdy_dyn2d( kt )136 IF( ll_dyn2d ) CALL bdy_dyn2d( kt, pua2d, pva2d, ub_b, vb_b, phura, phvra, ssha ) 165 137 166 138 IF( ll_dyn3d ) CALL bdy_dyn3d( kt ) … … 177 149 IF ( ll_orlanski ) THEN 178 150 DO jk = 1 , jpkm1 179 ub(:,:,jk) = ( ub(:,:,jk) + pub2d(:,:) ) * umask(:,:,jk)180 vb(:,:,jk) = ( vb(:,:,jk) + pvb2d(:,:) ) * vmask(:,:,jk)151 ub(:,:,jk) = ( ub(:,:,jk) + ub_b(:,:) ) * umask(:,:,jk) 152 vb(:,:,jk) = ( vb(:,:,jk) + vb_b(:,:) ) * vmask(:,:,jk) 181 153 END DO 182 154 END IF 183 155 184 CALL wrk_dealloc(jpi,jpj,pua2d,pva2d) 185 IF ( ll_orlanski ) CALL wrk_dealloc(jpi,jpj,pub2d,pvb2d,phur1,phvr1) 156 CALL wrk_dealloc(jpi,jpj,pua2d,pva2d,phura,phvra) 186 157 187 158 IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn') -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90
r4292 r4354 41 41 CONTAINS 42 42 43 SUBROUTINE bdy_dyn2d( kt )43 SUBROUTINE bdy_dyn2d( kt, pua2d, pva2d, pub2d, pvb2d, phur, phvr, pssh ) 44 44 !!---------------------------------------------------------------------- 45 45 !! *** SUBROUTINE bdy_dyn2d *** … … 49 49 !!---------------------------------------------------------------------- 50 50 INTEGER, INTENT(in) :: kt ! Main time step counter 51 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pua2d, pva2d 52 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pub2d, pvb2d 53 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: phur, phvr 54 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pssh 51 55 !! 52 56 INTEGER :: ib_bdy ! Loop counter … … 58 62 CYCLE 59 63 CASE('frs') 60 CALL bdy_dyn2d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy )64 CALL bdy_dyn2d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, pua2d, pva2d ) 61 65 CASE('flather') 62 CALL bdy_dyn2d_fla( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy )66 CALL bdy_dyn2d_fla( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, pua2d, pva2d, pssh, phur, phvr ) 63 67 CASE('orlanski') 64 CALL bdy_dyn2d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.false. ) 68 CALL bdy_dyn2d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, & 69 & pua2d, pva2d, pub2d, pvb2d, ll_npo=.false.) 65 70 CASE('orlanski_npo') 66 CALL bdy_dyn2d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.true. ) 71 CALL bdy_dyn2d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, & 72 & pua2d, pva2d, pub2d, pvb2d, ll_npo=.true. ) 67 73 CASE DEFAULT 68 74 CALL ctl_stop( 'bdy_dyn2d : unrecognised option for open boundaries for barotropic variables' ) … … 72 78 END SUBROUTINE bdy_dyn2d 73 79 74 SUBROUTINE bdy_dyn2d_frs( idx, dta, ib_bdy )80 SUBROUTINE bdy_dyn2d_frs( idx, dta, ib_bdy, pua2d, pva2d ) 75 81 !!---------------------------------------------------------------------- 76 82 !! *** SUBROUTINE bdy_dyn2d_frs *** … … 86 92 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data 87 93 INTEGER, INTENT(in) :: ib_bdy ! BDY set index 94 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pua2d, pva2d 88 95 !! 89 96 INTEGER :: jb, jk ! dummy loop indices … … 118 125 119 126 120 SUBROUTINE bdy_dyn2d_fla( idx, dta, ib_bdy )127 SUBROUTINE bdy_dyn2d_fla( idx, dta, ib_bdy, pua2d, pva2d, pssh, phur, phvr ) 121 128 !!---------------------------------------------------------------------- 122 129 !! *** SUBROUTINE bdy_dyn2d_fla *** … … 140 147 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data 141 148 INTEGER, INTENT(in) :: ib_bdy ! BDY set index 149 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pua2d, pva2d 150 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pssh, phur, phvr 142 151 143 152 INTEGER :: jb, igrd ! dummy loop indices … … 212 221 213 222 214 SUBROUTINE bdy_dyn2d_orlanski( idx, dta, ib_bdy, ll_npo )223 SUBROUTINE bdy_dyn2d_orlanski( idx, dta, ib_bdy, pua2d, pva2d, pub2d, pvb2d, ll_npo ) 215 224 !!---------------------------------------------------------------------- 216 225 !! *** SUBROUTINE bdy_dyn2d_orlanski *** … … 226 235 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data 227 236 INTEGER, INTENT(in) :: ib_bdy ! number of current open boundary set 237 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pua2d, pva2d 238 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pub2d, pvb2d 228 239 LOGICAL, INTENT(in) :: ll_npo ! flag for NPO version 229 240 -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90
r4317 r4354 15 15 !!---------------------------------------------------------------------- 16 16 USE timing ! Timing 17 USE wrk_nemo ! Memory Allocation18 17 USE oce ! ocean dynamics and tracers 19 18 USE dom_oce ! ocean space and time domain … … 266 265 REAL(wp) :: zwgt ! boundary weight 267 266 INTEGER :: ib_bdy ! loop index 268 REAL(wp), POINTER, DIMENSION(:,:) :: phur1, phvr1 ! inverse depth at u and v points269 267 !!---------------------------------------------------------------------- 270 268 ! … … 272 270 ! 273 271 !------------------------------------------------------- 274 ! Remove barotropic part from before velocity275 !-------------------------------------------------------276 CALL wrk_alloc(jpi,jpj,pub2d,pvb2d,phur1,phvr1)277 278 pub2d(:,:) = 0.e0279 pvb2d(:,:) = 0.e0280 281 phur1(:,:) = 0.282 phvr1(:,:) = 0.283 DO jk = 1, jpkm1284 #if defined key_vvl285 phur1(:,:) = phur1(:,:) + fse3u_a(:,:,jk) * umask(:,:,jk)286 phvr1(:,:) = phvr1(:,:) + fse3v_a(:,:,jk) * vmask(:,:,jk)287 pub2d(:,:) = pub2d(:,:) + fse3u_b(:,:,jk)* ub(:,:,jk) *umask(:,:,jk)288 pvb2d(:,:) = pvb2d(:,:) + fse3v_b(:,:,jk)* vb(:,:,jk) *vmask(:,:,jk)289 #else290 pub2d(:,:) = pub2d(:,:) + fse3u(:,:,jk) * ub(:,:,jk) * umask(:,:,jk)291 pvb2d(:,:) = pvb2d(:,:) + fse3v(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk)292 #endif293 END DO294 295 IF( lk_vvl ) THEN296 phur1(:,:) = umask(:,:,1) / ( phur1(:,:) + 1. - umask(:,:,1) )297 phvr1(:,:) = vmask(:,:,1) / ( phvr1(:,:) + 1. - vmask(:,:,1) )298 pub2d(:,:) = pub2d(:,:) * umask(:,:,1) * phur1(:,:)299 pvb2d(:,:) = pvb2d(:,:) * vmask(:,:,1) * phvr1(:,:)300 ELSE301 pub2d(:,:) = pvb2d(:,:) * hur(:,:)302 pvb2d(:,:) = pub2d(:,:) * hvr(:,:)303 ENDIF304 272 305 273 DO ib_bdy=1, nb_bdy … … 312 280 DO jk = 1, jpkm1 313 281 ua(ii,ij,jk) = ( ua(ii,ij,jk) + zwgt * ( dta_bdy(ib_bdy)%u3d(jb,jk) - & 314 ub(ii,ij,jk) + pub2d(ii,ij)) ) * umask(ii,ij,jk)282 ub(ii,ij,jk) + ub_b(ii,ij)) ) * umask(ii,ij,jk) 315 283 END DO 316 284 END DO … … 323 291 DO jk = 1, jpkm1 324 292 va(ii,ij,jk) = ( va(ii,ij,jk) + zwgt * ( dta_bdy(ib_bdy)%v3d(jb,jk) - & 325 vb(ii,ij,jk) + pvb2d(ii,ij)) ) * vmask(ii,ij,jk)293 vb(ii,ij,jk) + vb_b(ii,ij)) ) * vmask(ii,ij,jk) 326 294 END DO 327 295 END DO … … 329 297 ENDDO 330 298 ! 331 CALL wrk_dealloc(jpi,jpj,pub2d,pvb2d,phur1,phvr1)332 !333 299 CALL lbc_lnk( ua, 'U', -1. ) ; CALL lbc_lnk( va, 'V', -1. ) ! Boundary points should be updated 334 300 ! -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90
r4333 r4354 110 110 111 111 IF( nn_timing == 1 ) CALL timing_start('bdy_init') 112 113 IF( bdy_oce_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'bdy_init : unable to allocate oce arrays' )114 112 115 113 IF(lwp) WRITE(numout,*) -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90
r4292 r4354 51 51 END TYPE TIDES_DATA 52 52 53 !$AGRIF_DO_NOT_TREAT 53 54 TYPE(TIDES_DATA), PUBLIC, DIMENSION(jp_bdy), TARGET :: tides !: External tidal harmonics data 55 !$AGRIF_END_DO_NOT_TREAT 54 56 TYPE(OBC_DATA) , PRIVATE, DIMENSION(jp_bdy) :: dta_bdy_s !: bdy external data (slow component) 55 57 -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90
r4313 r4354 71 71 !!---------------------------------------------------------------------- 72 72 ! - ML - needed for initialization of e3t_b 73 INTEGER :: jk ! dummy loop indice 73 INTEGER :: ji,jj,jk ! dummy loop indices 74 REAL(wp), POINTER, DIMENSION(:,:) :: zhur_b, zhvr_b ! U & Inverse of before depths 74 75 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zuvd ! U & V data workspace 75 76 !!---------------------------------------------------------------------- … … 155 156 ENDIF 156 157 ! 158 ! 159 ! Initialize "now" and "before" barotropic velocities: 160 ! Do it whatever the free surface method, these arrays 161 ! being eventually used 162 ! 163 IF (lk_vvl) THEN 164 CALL wrk_alloc( jpi, jpj, zhur_b, zhvr_b ) 165 zhur_b(:,:) = 0._wp 166 zhvr_b(:,:) = 0._wp 167 DO jk = 1, jpk 168 zhur_b(:,:) = zhur_b(:,:) + fse3u_b(:,:,jk) * umask(:,:,jk) 169 zhvr_b(:,:) = zhvr_b(:,:) + fse3v_b(:,:,jk) * vmask(:,:,jk) 170 END DO 171 zhur_b(:,:) = umask(:,:,1) / ( zhur_b(:,:) + 1._wp - umask(:,:,1) ) 172 zhvr_b(:,:) = vmask(:,:,1) / ( zhvr_b(:,:) + 1._wp - vmask(:,:,1) ) 173 ENDIF 174 ! 175 un_b(:,:) = 0._wp ; vn_b(:,:) = 0._wp 176 ub_b(:,:) = 0._wp ; vb_b(:,:) = 0._wp 177 ! 178 DO jk = 1, jpkm1 179 #if defined key_vectopt_loop 180 DO jj = 1, 1 !Vector opt. => forced unrolling 181 DO ji = 1, jpij 182 #else 183 DO jj = 1, jpj 184 DO ji = 1, jpi 185 #endif 186 un_b(ji,jj) = un_b(ji,jj) + fse3u_n(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk) 187 vn_b(ji,jj) = vn_b(ji,jj) + fse3v_n(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk) 188 ! 189 ub_b(ji,jj) = ub_b(ji,jj) + fse3u_b(ji,jj,jk) * ub(ji,jj,jk) * umask(ji,jj,jk) 190 vb_b(ji,jj) = vb_b(ji,jj) + fse3v_b(ji,jj,jk) * vb(ji,jj,jk) * vmask(ji,jj,jk) 191 END DO 192 END DO 193 END DO 194 ! 195 un_b(:,:) = un_b(:,:) * hur(:,:) 196 vn_b(:,:) = vn_b(:,:) * hvr(:,:) 197 ! 198 IF( lk_vvl ) THEN 199 ub_b(:,:) = ub_b(:,:) * zhur_b(:,:) 200 vb_b(:,:) = vb_b(:,:) * zhvr_b(:,:) 201 ELSE 202 ub_b(:,:) = ub_b(:,:) * hur(:,:) 203 vb_b(:,:) = vb_b(:,:) * hvr(:,:) 204 ENDIF 205 ! 206 IF (lk_vvl) CALL wrk_dealloc( jpi, jpj, zhur_b, zhvr_b ) 207 ! 157 208 IF( nn_timing == 1 ) CALL timing_stop('istate_init') 158 209 ! … … 537 588 !!===================================================================== 538 589 END MODULE istate 590 -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90
r4338 r4354 102 102 REAL(wp) :: zue3a, zue3n, zue3b, zuf, zec ! local scalars 103 103 REAL(wp) :: zve3a, zve3n, zve3b, zvf ! - - 104 REAL(wp), POINTER, DIMENSION(:,:) :: zua, zva, zhura, zhvra 104 REAL(wp), POINTER, DIMENSION(:,:) :: zua, zva, zhura, zhvra, zhurb, zhvrb 105 105 REAL(wp), POINTER, DIMENSION(:,:,:) :: ze3u_f, ze3v_f 106 106 !!---------------------------------------------------------------------- … … 339 339 ! 340 340 ENDIF ! neuler =/0 341 341 ! 342 ! Set "now" and "before" barotropic velocities for next time step: 343 ! JC: Would be more clever to swap variables than to make a full vertical 344 ! integration 345 ! 346 IF (lk_vvl) THEN 347 CALL wrk_alloc( jpi, jpj, zhurb, zhvrb ) 348 zhurb(:,:) = 0._wp 349 zhvrb(:,:) = 0._wp 350 DO jk = 1, jpk 351 zhurb(:,:) = zhurb(:,:) + fse3u_b(:,:,jk) * umask(:,:,jk) 352 zhvrb(:,:) = zhvrb(:,:) + fse3v_b(:,:,jk) * vmask(:,:,jk) 353 END DO 354 zhurb(:,:) = umask(:,:,1) / ( zhurb(:,:) + 1._wp - umask(:,:,1) ) 355 zhvrb(:,:) = vmask(:,:,1) / ( zhvrb(:,:) + 1._wp - vmask(:,:,1) ) 356 ENDIF 357 ! 358 un_b(:,:) = 0._wp ; vn_b(:,:) = 0._wp 359 ub_b(:,:) = 0._wp ; vb_b(:,:) = 0._wp 360 ! 361 DO jk = 1, jpkm1 362 #if defined key_vectopt_loop 363 DO jj = 1, 1 !Vector opt. => forced unrolling 364 DO ji = 1, jpij 365 #else 366 DO jj = 1, jpj 367 DO ji = 1, jpi 368 #endif 369 un_b(ji,jj) = un_b(ji,jj) + fse3u_n(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk) 370 vn_b(ji,jj) = vn_b(ji,jj) + fse3v_n(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk) 371 ! 372 ub_b(ji,jj) = ub_b(ji,jj) + fse3u_b(ji,jj,jk) * ub(ji,jj,jk) * umask(ji,jj,jk) 373 vb_b(ji,jj) = vb_b(ji,jj) + fse3v_b(ji,jj,jk) * vb(ji,jj,jk) * vmask(ji,jj,jk) 374 END DO 375 END DO 376 END DO 377 ! 378 un_b(:,:) = un_b(:,:) * hur(:,:) 379 vn_b(:,:) = vn_b(:,:) * hvr(:,:) 380 ! 381 IF( lk_vvl ) THEN 382 ub_b(:,:) = ub_b(:,:) * zhurb(:,:) 383 vb_b(:,:) = vb_b(:,:) * zhvrb(:,:) 384 ELSE 385 ub_b(:,:) = ub_b(:,:) * hur(:,:) 386 vb_b(:,:) = vb_b(:,:) * hvr(:,:) 387 ENDIF 388 ! 389 IF (lk_vvl) CALL wrk_dealloc( jpi, jpj, zhurb, zhvrb ) 390 ! 342 391 IF(ln_ctl) CALL prt_ctl( tab3d_1=un, clinfo1=' nxt - Un: ', mask1=umask, & 343 392 & tab3d_2=vn, clinfo2=' Vn: ' , mask2=vmask ) … … 352 401 !!========================================================================= 353 402 END MODULE dynnxt 403 -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_oce.F90
r4292 r4354 39 39 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET :: hur_e , hvr_e ! inverse of hu_e and hv_e 40 40 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET :: sshn_b ! before field without time-filter 41 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ua_b, va_b ! after averaged velocities42 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: un_b, vn_b ! now averaged velocities43 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ub_b, vb_b ! before averaged velocities44 41 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: un_adv, vn_adv ! Advection vel. at "now" barocl. step 45 42 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ub2_b, vb2_b ! Advection vel. at "now-0.5" barocl. step … … 58 55 ALLOCATE( sshn_e(jpi,jpj) , ua_e(jpi,jpj) , hu_e(jpi,jpj) , hur_e(jpi,jpj) , & 59 56 & ssha_e(jpi,jpj) , va_e(jpi,jpj) , hv_e(jpi,jpj) , hvr_e(jpi,jpj) , & 60 & ub_b(jpi,jpj) , vb_b(jpi,jpj) , un_b(jpi,jpj) , vn_b(jpi,jpj) , &61 & ua_b(jpi,jpj) , va_b(jpi,jpj) , &62 57 & ub2_b(jpi,jpj) , vb2_b(jpi,jpj) , & 63 58 & un_adv(jpi,jpj) , vn_adv(jpi,jpj) , & -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r4292 r4354 201 201 IF(lwp) WRITE(numout,*) 'dyn_spg_ts : surface pressure gradient trend' 202 202 IF(lwp) WRITE(numout,*) '~~~~~~~~~~ free surface with time splitting' 203 IF(lwp) WRITE(numout,*) ' Number of sub cycle in 1 time-step (2 rdt) : icycle = ', 2*nn_baro203 IF(lwp) WRITE(numout,*) 204 204 ! 205 205 IF (neuler==0) ll_init=.TRUE. … … 317 317 ! ----------------------------------------------------------------------------- 318 318 ! 319 ! Some vertical sums (at now and before time steps) below could be suppressed 320 ! if one swap barotropic arrays somewhere 321 ! 322 ! !* e3*d/dt(Ua), e3*Ub, e3*Vn (Vertically integrated) 319 ! 320 ! !* e3*d/dt(Ua) (Vertically integrated) 323 321 ! ! -------------------------------------------------- 324 zu_frc(:,:) = 0._wp ; ub_b(:,:) = 0._wp ; un_b(:,:) = 0._wp325 zv_frc(:,:) = 0._wp ; vb_b(:,:) = 0._wp ; vn_b(:,:) = 0._wp322 zu_frc(:,:) = 0._wp 323 zv_frc(:,:) = 0._wp 326 324 ! 327 325 DO jk = 1, jpkm1 … … 332 330 DO jj = 1, jpj 333 331 DO ji = 1, jpi 334 #endif 335 ! ! now trend: 332 #endif 336 333 zu_frc(ji,jj) = zu_frc(ji,jj) + fse3u(ji,jj,jk) * ua(ji,jj,jk) * umask(ji,jj,jk) 337 334 zv_frc(ji,jj) = zv_frc(ji,jj) + fse3v(ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk) 338 ! ! now bt transp:339 un_b(ji,jj) = un_b(ji,jj) + fse3u(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk)340 vn_b(ji,jj) = vn_b(ji,jj) + fse3v(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk)341 ! ! before bt transp:342 ub_b(ji,jj) = ub_b(ji,jj) + fse3u_b(ji,jj,jk) * ub(ji,jj,jk) * umask(ji,jj,jk)343 vb_b(ji,jj) = vb_b(ji,jj) + fse3v_b(ji,jj,jk) * vb(ji,jj,jk) * vmask(ji,jj,jk)344 335 END DO 345 336 END DO … … 349 340 zv_frc(:,:) = zv_frc(:,:) * hvr(:,:) 350 341 ! 351 IF( lk_vvl ) THEN352 ub_b(:,:) = ub_b(:,:) * zhur_b(:,:)353 vb_b(:,:) = vb_b(:,:) * zhvr_b(:,:)354 ELSE355 ub_b(:,:) = ub_b(:,:) * hur(:,:)356 vb_b(:,:) = vb_b(:,:) * hvr(:,:)357 ENDIF358 342 ! 359 343 ! !* baroclinic momentum trend (remove the vertical mean trend) … … 368 352 ! !* barotropic Coriolis trends (vorticity scheme dependent) 369 353 ! ! -------------------------------------------------------- 370 zwx(:,:) = un_b(:,:) * e2u(:,:) ! now transport371 zwy(:,:) = vn_b(:,:) * e1v(:,:)354 zwx(:,:) = un_b(:,:) * hu(:,:) * e2u(:,:) ! now fluxes 355 zwy(:,:) = vn_b(:,:) * hv(:,:) * e1v(:,:) 372 356 ! 373 357 IF( ln_dynvor_ene .OR. ln_dynvor_mix ) THEN ! energy conserving or mixed scheme … … 412 396 ENDIF 413 397 ! 414 un_b (:,:) = un_b(:,:) * hur(:,:) ! Revert now transport to barotropic velocities415 vn_b (:,:) = vn_b(:,:) * hvr(:,:)416 398 ! !* Right-Hand-Side of the barotropic momentum equation 417 399 ! ! ---------------------------------------------------- … … 511 493 ! ! ==================== ! 512 494 ! Initialize barotropic variables: 513 IF (ln_bt_fw) THEN ! FORWARD integration: 495 IF (ln_bt_fw) THEN ! FORWARD integration: start from NOW fields 514 496 sshn_e (:,:) = sshn (:,:) 515 497 zun_e (:,:) = un_b (:,:) 516 498 zvn_e (:,:) = vn_b (:,:) 517 ELSE ! CENT ERED integration: start from BEFORE fields499 ELSE ! CENTRED integration: start from BEFORE fields 518 500 sshn_e (:,:) = sshb (:,:) 519 501 zun_e (:,:) = ub_b (:,:) … … 807 789 808 790 #if defined key_bdy 809 810 pssh => ssha_e 811 phur => hur_e 812 phvr => hvr_e 813 pua2d => ua_e 814 pva2d => va_e 815 pub2d => zun_e 816 pvb2d => zvn_e 817 818 IF( lk_bdy ) CALL bdy_dyn2d( kt ) ! open boundaries 791 ! open boundaries 792 IF( lk_bdy ) CALL bdy_dyn2d( jn, ua_e, va_e, zun_e, zvn_e, hur_e, hvr_e, ssha_e ) 819 793 #endif 820 794 #if defined key_agrif … … 1118 1092 IF(lwp) WRITE(numout,*) ' ln_bt_fw=.true. => Forward integration of barotropic variables ' 1119 1093 ELSE 1120 IF(lwp) WRITE(numout,*) ' ln_bt_fw =.false.=> Cent ered integration of barotropic variables '1094 IF(lwp) WRITE(numout,*) ' ln_bt_fw =.false.=> Centred integration of barotropic variables ' 1121 1095 ENDIF 1122 1096 ! … … 1168 1142 !!====================================================================== 1169 1143 END MODULE dynspg_ts 1144 -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
r4292 r4354 26 26 USE timing ! Timing 27 27 USE dynadv ! dynamics: vector invariant versus flux form 28 USE dynspg_oce, ONLY: lk_dynspg_ts , ua_b, va_b28 USE dynspg_oce, ONLY: lk_dynspg_ts 29 29 USE dynspg_ts 30 30 -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r4328 r4354 618 618 USE diadct , ONLY: diadct_alloc 619 619 #endif 620 #if defined key_bdy 621 USE bdy_oce , ONLY: bdy_oce_alloc 622 #endif 620 623 ! 621 624 INTEGER :: ierr … … 634 637 ierr = ierr + diadct_alloc () ! 635 638 #endif 639 #if defined key_bdy 640 ierr = ierr + bdy_oce_alloc () ! bdy masks (incl. initialization) 641 #endif 636 642 ! 637 643 IF( lk_mpp ) CALL mpp_sum( ierr ) … … 819 825 !!====================================================================== 820 826 END MODULE nemogcm 827 828 -
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/OPA_SRC/oce.F90
r4292 r4354 35 35 36 36 !! free surface ! before ! now ! after ! 37 !! ------------ ! fields ! fields ! trends ! 38 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET :: sshb , sshn , ssha !: sea surface height at t-point [m] 37 !! ------------ ! fields ! fields ! fields ! 38 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ub_b , un_b , ua_b !: Barotropic velocities at u-point [m/s] 39 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vb_b , vn_b , va_b !: Barotropic velocities at v-point [m/s] 40 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sshb , sshn , ssha !: sea surface height at t-point [m] 39 41 ! 40 42 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: spgu, spgv !: horizontal surface pressure gradient … … 83 85 ALLOCATE(rhd (jpi,jpj,jpk) , & 84 86 & rhop(jpi,jpj,jpk) , & 85 & sshb (jpi,jpj) , sshn (jpi,jpj) , ssha (jpi,jpj) , & 87 & sshb(jpi,jpj) , sshn(jpi,jpj) , ssha(jpi,jpj) , & 88 & ub_b(jpi,jpj) , un_b(jpi,jpj) , ua_b(jpi,jpj) , & 89 & vb_b(jpi,jpj) , vn_b(jpi,jpj) , va_b(jpi,jpj) , & 86 90 & spgu (jpi,jpj) , spgv(jpi,jpj) , & 87 91 & gtsu(jpi,jpj,jpts), gtsv(jpi,jpj,jpts), &
Note: See TracChangeset
for help on using the changeset viewer.
