Changeset 4223
- Timestamp:
- 2013-11-15T18:21:46+01:00 (11 years ago)
- Location:
- branches/2013/dev_r3867_MERCATOR1_DYN/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 13 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_r3867_MERCATOR1_DYN/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90
r3651 r4223 29 29 REAL , POINTER, DIMENSION(:,:) :: nbw 30 30 REAL , POINTER, DIMENSION(:,:) :: nbd 31 REAL , POINTER, DIMENSION(:) :: flagu 32 REAL , POINTER, DIMENSION(:) :: flagv 31 REAL , POINTER, DIMENSION(:,:) :: nbdout 32 REAL , POINTER, DIMENSION(:,:) :: flagu 33 REAL , POINTER, DIMENSION(:,:) :: flagv 33 34 END TYPE OBC_INDEX 34 35 36 !! Logicals in OBC_DATA structure are true if the chosen algorithm requires this 37 !! field as external data. If true the data can come from external files 38 !! or model initial conditions. If false then no "external" data array 39 !! is required for this field. 40 35 41 TYPE, PUBLIC :: OBC_DATA !: Storage for external data 42 INTEGER, DIMENSION(2) :: nread 43 LOGICAL :: ll_ssh 44 LOGICAL :: ll_u2d 45 LOGICAL :: ll_v2d 46 LOGICAL :: ll_u3d 47 LOGICAL :: ll_v3d 48 LOGICAL :: ll_tem 49 LOGICAL :: ll_sal 36 50 REAL, POINTER, DIMENSION(:) :: ssh 37 51 REAL, POINTER, DIMENSION(:) :: u2d … … 42 56 REAL, POINTER, DIMENSION(:,:) :: sal 43 57 #if defined key_lim2 58 LOGICAL :: ll_frld 59 LOGICAL :: ll_hicif 60 LOGICAL :: ll_hsnif 44 61 REAL, POINTER, DIMENSION(:) :: frld 45 62 REAL, POINTER, DIMENSION(:) :: hicif … … 63 80 INTEGER :: nn_volctl !: = 0 the total volume will have the variability of the surface Flux E-P 64 81 ! ! = 1 the volume will be constant during all the integration. 65 INTEGER, DIMENSION(jp_bdy) :: nn_dyn2d! Choice of boundary condition for barotropic variables (U,V,SSH)66 INTEGER, DIMENSION(jp_bdy) :: nn_dyn2d_dta!: = 0 use the initial state as bdy dta ;82 CHARACTER(len=20), DIMENSION(jp_bdy) :: cn_dyn2d ! Choice of boundary condition for barotropic variables (U,V,SSH) 83 INTEGER, DIMENSION(jp_bdy) :: nn_dyn2d_dta !: = 0 use the initial state as bdy dta ; 67 84 !: = 1 read it in a NetCDF file 68 85 !: = 2 read tidal harmonic forcing from a NetCDF file 69 86 !: = 3 read external data AND tidal harmonic forcing from NetCDF files 70 INTEGER, DIMENSION(jp_bdy) :: nn_dyn3d! Choice of boundary condition for baroclinic velocities71 INTEGER, DIMENSION(jp_bdy) :: nn_dyn3d_dta!: = 0 use the initial state as bdy dta ;87 CHARACTER(len=20), DIMENSION(jp_bdy) :: cn_dyn3d ! Choice of boundary condition for baroclinic velocities 88 INTEGER, DIMENSION(jp_bdy) :: nn_dyn3d_dta !: = 0 use the initial state as bdy dta ; 72 89 !: = 1 read it in a NetCDF file 73 INTEGER, DIMENSION(jp_bdy) :: nn_tra! Choice of boundary condition for active tracers (T and S)74 INTEGER, DIMENSION(jp_bdy) :: nn_tra_dta!: = 0 use the initial state as bdy dta ;90 CHARACTER(len=20), DIMENSION(jp_bdy) :: cn_tra ! Choice of boundary condition for active tracers (T and S) 91 INTEGER, DIMENSION(jp_bdy) :: nn_tra_dta !: = 0 use the initial state as bdy dta ; 75 92 !: = 1 read it in a NetCDF file 76 93 LOGICAL, DIMENSION(jp_bdy) :: ln_tra_dmp !: =T Tracer damping 77 94 LOGICAL, DIMENSION(jp_bdy) :: ln_dyn3d_dmp !: =T Baroclinic velocity damping 78 95 REAL, DIMENSION(jp_bdy) :: rn_time_dmp !: Damping time scale in days 96 REAL, DIMENSION(jp_bdy) :: rn_time_dmp_out !: Damping time scale in days at radiation outflow points 79 97 80 98 #if defined key_lim2 81 INTEGER, DIMENSION(jp_bdy) :: nn_ice_lim2! Choice of boundary condition for sea ice variables82 INTEGER, DIMENSION(jp_bdy) :: nn_ice_lim2_dta!: = 0 use the initial state as bdy dta ;83 !: = 1 read it in a NetCDF file99 CHARACTER(len=20), DIMENSION(jp_bdy) :: nn_ice_lim2 ! Choice of boundary condition for sea ice variables 100 INTEGER, DIMENSION(jp_bdy) :: nn_ice_lim2_dta !: = 0 use the initial state as bdy dta ; 101 !: = 1 read it in a NetCDF file 84 102 #endif 85 103 ! … … 88 106 !! Global variables 89 107 !!---------------------------------------------------------------------- 90 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: bdytmask !: Mask defining computational domain at T-points91 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: bdyumask !: Mask defining computational domain at U-points92 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: bdyvmask !: Mask defining computational domain at V-points108 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET :: bdytmask !: Mask defining computational domain at T-points 109 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET :: bdyumask !: Mask defining computational domain at U-points 110 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET :: bdyvmask !: Mask defining computational domain at V-points 93 111 94 112 REAL(wp) :: bdysurftot !: Lateral surface of unstructured open boundary 95 113 96 REAL(wp), POINTER, DIMENSION(:,:) :: pssh !:97 REAL(wp), POINTER, DIMENSION(:,:) :: phur !:98 REAL(wp), POINTER, DIMENSION(:,:) :: phvr !: Pointers for barotropic fields99 REAL(wp), POINTER, DIMENSION(:,:) :: pu 2d!:100 REAL(wp), POINTER, DIMENSION(:,:) :: pv 2d!:114 REAL(wp), POINTER, DIMENSION(:,:) :: pssh !: 115 REAL(wp), POINTER, DIMENSION(:,:) :: phur !: 116 REAL(wp), POINTER, DIMENSION(:,:) :: phvr !: Pointers for barotropic fields 117 REAL(wp), POINTER, DIMENSION(:,:) :: pub2d, pun2d, pua2d !: 118 REAL(wp), POINTER, DIMENSION(:,:) :: pvb2d, pvn2d, pva2d !: 101 119 102 120 !!---------------------------------------------------------------------- … … 109 127 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET :: dta_global2 !: workspace for reading in global data arrays (struct. bdy) 110 128 TYPE(OBC_INDEX), DIMENSION(jp_bdy), TARGET :: idx_bdy !: bdy indices (local process) 111 TYPE(OBC_DATA) , DIMENSION(jp_bdy) 129 TYPE(OBC_DATA) , DIMENSION(jp_bdy), TARGET :: dta_bdy !: bdy external data (local process) 112 130 113 131 !!---------------------------------------------------------------------- … … 125 143 !!---------------------------------------------------------------------- 126 144 ! 127 ALLOCATE( bdytmask(jpi,jpj) , bdyumask(jpi,jpj), bdyvmask(jpi,jpj), 145 ALLOCATE( bdytmask(jpi,jpj) , bdyumask(jpi,jpj), bdyvmask(jpi,jpj), & 128 146 & STAT=bdy_oce_alloc ) 129 147 ! -
branches/2013/dev_r3867_MERCATOR1_DYN/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_par.F90
r3294 r4223 23 23 # endif 24 24 INTEGER, PUBLIC, PARAMETER :: jp_bdy = 10 !: Maximum number of bdy sets 25 INTEGER, PUBLIC, PARAMETER :: jpbtime = 1000 !: Max number of time dumps per file26 25 INTEGER, PUBLIC, PARAMETER :: jpbgrd = 3 !: Number of horizontal grid types used (T, U, V) 27 26 28 !! Flags for choice of schemes29 INTEGER, PUBLIC, PARAMETER :: jp_none = 0 !: Flag for no open boundary condition30 INTEGER, PUBLIC, PARAMETER :: jp_frs = 1 !: Flag for Flow Relaxation Scheme31 INTEGER, PUBLIC, PARAMETER :: jp_flather = 2 !: Flag for Flather32 27 #else 33 28 !!---------------------------------------------------------------------- -
branches/2013/dev_r3867_MERCATOR1_DYN/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90
r3970 r4223 84 84 INTEGER, DIMENSION(jpbgrd) :: ilen1 85 85 INTEGER, POINTER, DIMENSION(:) :: nblen, nblenrim ! short cuts 86 TYPE(OBC_DATA), POINTER :: dta ! short cut 86 87 !! 87 88 !!--------------------------------------------------------------------------- … … 95 96 ! Calculate depth-mean currents 96 97 !----------------------------- 97 CALL wrk_alloc(jpi,jpj,pu2d,pv2d) 98 99 pu2d(:,:) = 0.e0 100 pv2d(:,:) = 0.e0 101 98 CALL wrk_alloc(jpi,jpj,pun2d,pvn2d) 99 100 pun2d(:,:) = 0.e0 101 pvn2d(:,:) = 0.e0 102 102 DO ik = 1, jpkm1 !! Vertically integrated momentum trends 103 pu 2d(:,:) = pu2d(:,:) + fse3u(:,:,ik) * umask(:,:,ik) * un(:,:,ik)104 pv 2d(:,:) = pv2d(:,:) + fse3v(:,:,ik) * vmask(:,:,ik) * vn(:,:,ik)103 pun2d(:,:) = pun2d(:,:) + fse3u(:,:,ik) * umask(:,:,ik) * un(:,:,ik) 104 pvn2d(:,:) = pvn2d(:,:) + fse3v(:,:,ik) * vmask(:,:,ik) * vn(:,:,ik) 105 105 END DO 106 pu 2d(:,:) = pu2d(:,:) * hur(:,:)107 pv 2d(:,:) = pv2d(:,:) * hvr(:,:)106 pun2d(:,:) = pun2d(:,:) * hur(:,:) 107 pvn2d(:,:) = pvn2d(:,:) * hvr(:,:) 108 108 109 109 DO ib_bdy = 1, nb_bdy … … 111 111 nblen => idx_bdy(ib_bdy)%nblen 112 112 nblenrim => idx_bdy(ib_bdy)%nblenrim 113 114 IF( nn_dyn2d(ib_bdy) .gt. 0 .and. nn_dyn2d_dta(ib_bdy) .eq. 0 ) THEN 113 dta => dta_bdy(ib_bdy) 114 115 IF( nn_dyn2d_dta(ib_bdy) .eq. 0 ) THEN 115 116 ilen1(:) = nblen(:) 116 igrd = 1 117 DO ib = 1, ilen1(igrd) 118 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 119 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 120 dta_bdy(ib_bdy)%ssh(ib) = sshn(ii,ij) * tmask(ii,ij,1) 121 END DO 122 igrd = 2 123 DO ib = 1, ilen1(igrd) 124 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 125 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 126 dta_bdy(ib_bdy)%u2d(ib) = pu2d(ii,ij) * umask(ii,ij,1) 127 END DO 128 igrd = 3 129 DO ib = 1, ilen1(igrd) 130 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 131 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 132 dta_bdy(ib_bdy)%v2d(ib) = pv2d(ii,ij) * vmask(ii,ij,1) 133 END DO 134 ENDIF 135 136 IF( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 0 ) THEN 137 ilen1(:) = nblen(:) 138 igrd = 2 139 DO ib = 1, ilen1(igrd) 140 DO ik = 1, jpkm1 117 IF( dta%ll_ssh ) THEN 118 igrd = 1 119 DO ib = 1, ilen1(igrd) 141 120 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 142 121 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 143 dta_bdy(ib_bdy)% u3d(ib,ik) = ( un(ii,ij,ik) - pu2d(ii,ij) ) * umask(ii,ij,ik)144 END DO 145 END DO146 igrd = 3147 DO ib = 1, ilen1(igrd)148 DO i k = 1, jpkm1122 dta_bdy(ib_bdy)%ssh(ib) = sshn(ii,ij) * tmask(ii,ij,1) 123 END DO 124 END IF 125 IF( dta%ll_u2d ) THEN 126 igrd = 2 127 DO ib = 1, ilen1(igrd) 149 128 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 150 129 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 151 dta_bdy(ib_bdy)%v3d(ib,ik) = ( vn(ii,ij,ik) - pv2d(ii,ij) ) * vmask(ii,ij,ik) 152 END DO 153 END DO 154 ENDIF 155 156 IF( nn_tra(ib_bdy) .gt. 0 .and. nn_tra_dta(ib_bdy) .eq. 0 ) THEN 157 ilen1(:) = nblen(:) 158 igrd = 1 ! Everything is at T-points here 159 DO ib = 1, ilen1(igrd) 160 DO ik = 1, jpkm1 130 dta_bdy(ib_bdy)%u2d(ib) = pun2d(ii,ij) * umask(ii,ij,1) 131 END DO 132 END IF 133 IF( dta%ll_v2d ) THEN 134 igrd = 3 135 DO ib = 1, ilen1(igrd) 161 136 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 162 137 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 163 dta_bdy(ib_bdy)%tem(ib,ik) = tsn(ii,ij,ik,jp_tem) * tmask(ii,ij,ik) 164 dta_bdy(ib_bdy)%sal(ib,ik) = tsn(ii,ij,ik,jp_sal) * tmask(ii,ij,ik) 165 END DO 166 END DO 138 dta_bdy(ib_bdy)%v2d(ib) = pvn2d(ii,ij) * vmask(ii,ij,1) 139 END DO 140 END IF 141 ENDIF 142 143 IF( nn_dyn3d_dta(ib_bdy) .eq. 0 ) THEN 144 ilen1(:) = nblen(:) 145 IF( dta%ll_u3d ) THEN 146 igrd = 2 147 DO ib = 1, ilen1(igrd) 148 DO ik = 1, jpkm1 149 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 150 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 151 dta_bdy(ib_bdy)%u3d(ib,ik) = ( un(ii,ij,ik) - pun2d(ii,ij) ) * umask(ii,ij,ik) 152 END DO 153 END DO 154 END IF 155 IF( dta%ll_v3d ) THEN 156 igrd = 3 157 DO ib = 1, ilen1(igrd) 158 DO ik = 1, jpkm1 159 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 160 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 161 dta_bdy(ib_bdy)%v3d(ib,ik) = ( vn(ii,ij,ik) - pvn2d(ii,ij) ) * vmask(ii,ij,ik) 162 END DO 163 END DO 164 END IF 165 ENDIF 166 167 IF( nn_tra_dta(ib_bdy) .eq. 0 ) THEN 168 ilen1(:) = nblen(:) 169 IF( dta%ll_tem ) THEN 170 igrd = 1 171 DO ib = 1, ilen1(igrd) 172 DO ik = 1, jpkm1 173 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 174 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 175 dta_bdy(ib_bdy)%tem(ib,ik) = tsn(ii,ij,ik,jp_tem) * tmask(ii,ij,ik) 176 END DO 177 END DO 178 END IF 179 IF( dta%ll_sal ) THEN 180 igrd = 1 181 DO ib = 1, ilen1(igrd) 182 DO ik = 1, jpkm1 183 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 184 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 185 dta_bdy(ib_bdy)%sal(ib,ik) = tsn(ii,ij,ik,jp_sal) * tmask(ii,ij,ik) 186 END DO 187 END DO 188 END IF 167 189 ENDIF 168 190 169 191 #if defined key_lim2 170 IF( nn_ice_lim2 (ib_bdy) .gt. 0 .and. nn_ice_lim2_dta(ib_bdy) .eq. 0 ) THEN192 IF( nn_ice_lim2_dta(ib_bdy) .eq. 0 ) THEN 171 193 ilen1(:) = nblen(:) 172 igrd = 1 ! Everything is at T-points here 173 DO ib = 1, ilen1(igrd) 174 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 175 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 176 dta_bdy(ib_bdy)%frld(ib) = frld(ii,ij) * tmask(ii,ij,1) 177 dta_bdy(ib_bdy)%hicif(ib) = hicif(ii,ij) * tmask(ii,ij,1) 178 dta_bdy(ib_bdy)%hsnif(ib) = hsnif(ii,ij) * tmask(ii,ij,1) 179 END DO 194 IF( dta%ll_frld ) THEN 195 igrd = 1 196 DO ib = 1, ilen1(igrd) 197 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 198 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 199 dta_bdy(ib_bdy)%frld(ib) = frld(ii,ij) * tmask(ii,ij,1) 200 END DO 201 END IF 202 IF( dta%ll_hicif ) THEN 203 igrd = 1 204 DO ib = 1, ilen1(igrd) 205 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 206 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 207 dta_bdy(ib_bdy)%hicif(ib) = hicif(ii,ij) * tmask(ii,ij,1) 208 END DO 209 END IF 210 IF( dta%ll_hsnif ) THEN 211 igrd = 1 212 DO ib = 1, ilen1(igrd) 213 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 214 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 215 dta_bdy(ib_bdy)%hsnif(ib) = hsnif(ii,ij) * tmask(ii,ij,1) 216 END DO 217 END IF 180 218 ENDIF 181 219 #endif … … 183 221 ENDDO ! ib_bdy 184 222 185 CALL wrk_dealloc(jpi,jpj,pu 2d,pv2d)223 CALL wrk_dealloc(jpi,jpj,pun2d,pvn2d) 186 224 187 225 ENDIF ! kt .eq. nit000 … … 192 230 jstart = 1 193 231 DO ib_bdy = 1, nb_bdy 232 dta => dta_bdy(ib_bdy) 194 233 IF( nn_dta(ib_bdy) .eq. 1 ) THEN ! skip this bit if no external data required 195 234 … … 197 236 ! Update barotropic boundary conditions only 198 237 ! jit is optional argument for fld_read and bdytide_update 199 IF( nn_dyn2d(ib_bdy) .gt. 0) THEN238 IF( cn_dyn2d(ib_bdy) /= 'none' ) THEN 200 239 IF( nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays 201 dta_bdy(ib_bdy)%ssh(:) = 0.0202 dta_bdy(ib_bdy)%u2d(:) = 0.0203 dta_bdy(ib_bdy)%v2d(:) = 0.0240 IF( dta%ll_ssh ) dta%ssh(:) = 0.0 241 IF( dta%ll_u2d ) dta%u2d(:) = 0.0 242 IF( dta%ll_u3d ) dta%v2d(:) = 0.0 204 243 ENDIF 205 IF (nn_tra(ib_bdy).ne.4) THEN 206 IF( nn_dyn2d_dta(ib_bdy) .EQ. 1 .OR. nn_dyn2d_dta(ib_bdy) .EQ. 3 .OR. & 207 & (ln_full_vel_array(ib_bdy) .AND. nn_dyn3d_dta(ib_bdy).eq.1) )THEN 208 209 ! For the runoff case, no need to update the forcing (already done in the baroclinic part) 210 jend = nb_bdy_fld(ib_bdy) 211 IF ( nn_tra(ib_bdy) .GT. 0 .AND. nn_tra_dta(ib_bdy) .GE. 1 ) jend = jend - 2 244 IF (cn_tra(ib_bdy) /= 'runoff') THEN 245 IF( nn_dyn2d_dta(ib_bdy) .EQ. 1 .OR. nn_dyn2d_dta(ib_bdy) .EQ. 3 ) THEN 246 247 jend = jstart + dta%nread(2) - 1 212 248 CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend), & 213 249 & kit=jit, kt_offset=time_offset ) 214 IF ( nn_tra(ib_bdy) .GT. 0 .AND. nn_tra_dta(ib_bdy) .GE. 1 ) jend = jend + 2 215 216 ! If full velocities in boundary data then split into barotropic and baroclinic data 250 251 ! If full velocities in boundary data then extract barotropic velocities from 3D fields 217 252 IF( ln_full_vel_array(ib_bdy) .AND. & 218 253 & ( nn_dyn2d_dta(ib_bdy) .EQ. 1 .OR. nn_dyn2d_dta(ib_bdy) .EQ. 3 .OR. & … … 220 255 221 256 igrd = 2 ! zonal velocity 222 dta _bdy(ib_bdy)%u2d(:) = 0.0257 dta%u2d(:) = 0.0 223 258 DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 224 259 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 225 260 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 226 261 DO ik = 1, jpkm1 227 dta _bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) &228 & + fse3u(ii,ij,ik) * umask(ii,ij,ik) * dta _bdy(ib_bdy)%u3d(ib,ik)262 dta%u2d(ib) = dta%u2d(ib) & 263 & + fse3u(ii,ij,ik) * umask(ii,ij,ik) * dta%u3d(ib,ik) 229 264 END DO 230 dta_bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) * hur(ii,ij) 231 DO ik = 1, jpkm1 232 dta_bdy(ib_bdy)%u3d(ib,ik) = dta_bdy(ib_bdy)%u3d(ib,ik) - dta_bdy(ib_bdy)%u2d(ib) 233 END DO 265 dta%u2d(ib) = dta%u2d(ib) * hur(ii,ij) 234 266 END DO 235 267 igrd = 3 ! meridional velocity 236 dta _bdy(ib_bdy)%v2d(:) = 0.0268 dta%v2d(:) = 0.0 237 269 DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 238 270 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 239 271 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 240 272 DO ik = 1, jpkm1 241 dta _bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) &242 & + fse3v(ii,ij,ik) * vmask(ii,ij,ik) * dta _bdy(ib_bdy)%v3d(ib,ik)273 dta%v2d(ib) = dta%v2d(ib) & 274 & + fse3v(ii,ij,ik) * vmask(ii,ij,ik) * dta%v3d(ib,ik) 243 275 END DO 244 dta_bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) * hvr(ii,ij) 245 DO ik = 1, jpkm1 246 dta_bdy(ib_bdy)%v3d(ib,ik) = dta_bdy(ib_bdy)%v3d(ib,ik) - dta_bdy(ib_bdy)%v2d(ib) 247 END DO 276 dta%v2d(ib) = dta%v2d(ib) * hvr(ii,ij) 248 277 END DO 249 278 ENDIF 250 279 ENDIF 251 280 IF( nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN ! update tidal harmonic forcing 252 CALL bdytide_update( kt=kt, idx=idx_bdy(ib_bdy), dta=dta _bdy(ib_bdy), td=tides(ib_bdy), &281 CALL bdytide_update( kt=kt, idx=idx_bdy(ib_bdy), dta=dta, td=tides(ib_bdy), & 253 282 & jit=jit, time_offset=time_offset ) 254 283 ENDIF … … 256 285 ENDIF 257 286 ELSE 258 IF ( nn_tra(ib_bdy).eq.4) then ! runoff condition287 IF (cn_tra(ib_bdy) == 'runoff') then ! runoff condition 259 288 jend = nb_bdy_fld(ib_bdy) 260 289 CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), & … … 265 294 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 266 295 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 267 dta _bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) )296 dta%u2d(ib) = dta%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) ) 268 297 END DO 269 298 ! … … 272 301 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 273 302 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 274 dta _bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) )303 dta%v2d(ib) = dta%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) ) 275 304 END DO 276 305 ELSE 277 IF( nn_dyn2d (ib_bdy) .gt. 0 .and. nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays278 dta_bdy(ib_bdy)%ssh(:) = 0.0279 dta_bdy(ib_bdy)%u2d(:) = 0.0280 dta_bdy(ib_bdy)%v2d(:) = 0.0306 IF( nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays 307 IF( dta%ll_ssh ) dta%ssh(:) = 0.0 308 IF( dta%ll_u2d ) dta%u2d(:) = 0.0 309 IF( dta%ll_v2d ) dta%v2d(:) = 0.0 281 310 ENDIF 282 IF( nb_bdy_fld(ib_bdy) .gt. 0 ) THEN ! update external data283 jend = nb_bdy_fld(ib_bdy)311 IF( dta%nread(1) .gt. 0 ) THEN ! update external data 312 jend = jstart + dta%nread(1) - 1 284 313 CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), & 285 314 & map=nbmap_ptr(jstart:jend), kt_offset=time_offset ) … … 290 319 & nn_dyn3d_dta(ib_bdy) .EQ. 1 ) ) THEN 291 320 igrd = 2 ! zonal velocity 292 dta _bdy(ib_bdy)%u2d(:) = 0.0321 dta%u2d(:) = 0.0 293 322 DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 294 323 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 295 324 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 296 325 DO ik = 1, jpkm1 297 dta _bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) &298 & + fse3u(ii,ij,ik) * umask(ii,ij,ik) * dta _bdy(ib_bdy)%u3d(ib,ik)326 dta%u2d(ib) = dta%u2d(ib) & 327 & + fse3u(ii,ij,ik) * umask(ii,ij,ik) * dta%u3d(ib,ik) 299 328 END DO 300 dta _bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) * hur(ii,ij)329 dta%u2d(ib) = dta%u2d(ib) * hur(ii,ij) 301 330 DO ik = 1, jpkm1 302 dta _bdy(ib_bdy)%u3d(ib,ik) = dta_bdy(ib_bdy)%u3d(ib,ik) - dta_bdy(ib_bdy)%u2d(ib)331 dta%u3d(ib,ik) = dta%u3d(ib,ik) - dta%u2d(ib) 303 332 END DO 304 333 END DO 305 334 igrd = 3 ! meridional velocity 306 dta _bdy(ib_bdy)%v2d(:) = 0.0335 dta%v2d(:) = 0.0 307 336 DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 308 337 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 309 338 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 310 339 DO ik = 1, jpkm1 311 dta _bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) &312 & + fse3v(ii,ij,ik) * vmask(ii,ij,ik) * dta _bdy(ib_bdy)%v3d(ib,ik)340 dta%v2d(ib) = dta%v2d(ib) & 341 & + fse3v(ii,ij,ik) * vmask(ii,ij,ik) * dta%v3d(ib,ik) 313 342 END DO 314 dta _bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) * hvr(ii,ij)343 dta%v2d(ib) = dta%v2d(ib) * hvr(ii,ij) 315 344 DO ik = 1, jpkm1 316 dta _bdy(ib_bdy)%v3d(ib,ik) = dta_bdy(ib_bdy)%v3d(ib,ik) - dta_bdy(ib_bdy)%v2d(ib)345 dta%v3d(ib,ik) = dta%v3d(ib,ik) - dta%v2d(ib) 317 346 END DO 318 347 END DO 319 348 ENDIF 320 ! bg jchanut tschanges 321 !IF( nn_dyn2d(ib_bdy) .gt. 0 .and. nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN ! update tidal harmonic forcing 322 ! CALL bdytide_update( kt=kt, idx=idx_bdy(ib_bdy), dta=dta_bdy(ib_bdy), & 323 ! & td=tides(ib_bdy), time_offset=time_offset ) 324 !ENDIF 325 ! end jchanut tschanges 326 ENDIF 327 ENDIF 328 jstart = jend+1 349 350 ENDIF 351 ENDIF 352 jstart = jstart + dta%nread(1) 329 353 END IF ! nn_dta(ib_bdy) = 1 330 354 END DO ! ib_bdy … … 339 363 IF ( ln_apr_obc ) THEN 340 364 DO ib_bdy = 1, nb_bdy 341 IF ( nn_tra(ib_bdy).NE.4)THEN365 IF (cn_tra(ib_bdy) /= 'runoff')THEN 342 366 igrd = 1 ! meridional velocity 343 367 DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) … … 362 386 !! for open boundary conditions 363 387 !! 364 !! ** Method : Use fldread.F90388 !! ** Method : 365 389 !! 366 390 !!---------------------------------------------------------------------- … … 374 398 ! =F => baroclinic velocities in 3D boundary data 375 399 INTEGER :: ilen_global ! Max length required for global bdy dta arrays 376 INTEGER, DIMENSION(jpbgrd) :: ilen0 ! size of local arrays377 400 INTEGER, ALLOCATABLE, DIMENSION(:) :: ilen1, ilen3 ! size of 1st and 3rd dimensions of local arrays 378 401 INTEGER, ALLOCATABLE, DIMENSION(:) :: ibdy ! bdy set for a particular jfld 379 402 INTEGER, ALLOCATABLE, DIMENSION(:) :: igrid ! index for grid type (1,2,3 = T,U,V) 380 403 INTEGER, POINTER, DIMENSION(:) :: nblen, nblenrim ! short cuts 404 TYPE(OBC_DATA), POINTER :: dta ! short cut 381 405 TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: blf_i ! array of namelist information structures 382 406 TYPE(FLD_N) :: bn_tem, bn_sal, bn_u3d, bn_v3d ! … … 416 440 nb_bdy_fld(:) = 0 417 441 DO ib_bdy = 1, nb_bdy 418 IF( nn_dyn2d(ib_bdy) .gt. 0.and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) THEN442 IF( cn_dyn2d(ib_bdy) /= 'none' .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) THEN 419 443 nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 3 420 444 ENDIF 421 IF( nn_dyn3d(ib_bdy) .gt. 0.and. nn_dyn3d_dta(ib_bdy) .eq. 1 ) THEN445 IF( cn_dyn3d(ib_bdy) /= 'none' .and. nn_dyn3d_dta(ib_bdy) .eq. 1 ) THEN 422 446 nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 2 423 447 ENDIF 424 IF( nn_tra(ib_bdy) .gt. 0.and. nn_tra_dta(ib_bdy) .eq. 1 ) THEN448 IF( cn_tra(ib_bdy) /= 'none' .and. nn_tra_dta(ib_bdy) .eq. 1 ) THEN 425 449 nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 2 426 450 ENDIF 427 451 #if defined key_lim2 428 IF( nn_ice_lim2(ib_bdy) .gt. 0.and. nn_ice_lim2_dta(ib_bdy) .eq. 1 ) THEN452 IF( cn_ice_lim2(ib_bdy) /= 'none' .and. nn_ice_lim2_dta(ib_bdy) .eq. 1 ) THEN 429 453 nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 3 430 454 ENDIF … … 484 508 nblen => idx_bdy(ib_bdy)%nblen 485 509 nblenrim => idx_bdy(ib_bdy)%nblenrim 510 dta => dta_bdy(ib_bdy) 511 dta%nread(2) = 0 486 512 487 513 ! Only read in necessary fields for this set. 488 514 ! Important that barotropic variables come first. 489 IF( nn_dyn2d(ib_bdy) .gt. 0 .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) THEN 490 491 IF( nn_dyn2d(ib_bdy) .ne. jp_frs .and. nn_tra(ib_bdy) .ne. 4 ) THEN ! runoff condition : no ssh reading 515 IF( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) THEN 516 517 IF( dta%ll_ssh ) THEN 518 if(lwp) write(numout,*) '++++++ reading in ssh field' 492 519 jfld = jfld + 1 493 520 blf_i(jfld) = bn_ssh … … 496 523 ilen1(jfld) = nblen(igrid(jfld)) 497 524 ilen3(jfld) = 1 498 ENDIF 499 500 IF( .not. ln_full_vel_array(ib_bdy) ) THEN 525 dta%nread(2) = dta%nread(2) + 1 526 ENDIF 527 528 IF( dta%ll_u2d .and. .not. ln_full_vel_array(ib_bdy) ) THEN 529 if(lwp) write(numout,*) '++++++ reading in u2d field' 501 530 jfld = jfld + 1 502 531 blf_i(jfld) = bn_u2d … … 505 534 ilen1(jfld) = nblen(igrid(jfld)) 506 535 ilen3(jfld) = 1 507 536 dta%nread(2) = dta%nread(2) + 1 537 ENDIF 538 539 IF( dta%ll_v2d .and. .not. ln_full_vel_array(ib_bdy) ) THEN 540 if(lwp) write(numout,*) '++++++ reading in v2d field' 508 541 jfld = jfld + 1 509 542 blf_i(jfld) = bn_v2d … … 512 545 ilen1(jfld) = nblen(igrid(jfld)) 513 546 ilen3(jfld) = 1 514 ENDIF 515 516 ENDIF 517 518 ! baroclinic velocities 519 IF( ( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 1 ) .or. & 520 & ( ln_full_vel_array(ib_bdy) .and. nn_dyn2d(ib_bdy) .gt. 0 .and. & 521 & ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) ) THEN 522 523 jfld = jfld + 1 524 blf_i(jfld) = bn_u3d 525 ibdy(jfld) = ib_bdy 526 igrid(jfld) = 2 527 ilen1(jfld) = nblen(igrid(jfld)) 528 ilen3(jfld) = jpk 529 530 jfld = jfld + 1 531 blf_i(jfld) = bn_v3d 532 ibdy(jfld) = ib_bdy 533 igrid(jfld) = 3 534 ilen1(jfld) = nblen(igrid(jfld)) 535 ilen3(jfld) = jpk 547 dta%nread(2) = dta%nread(2) + 1 548 ENDIF 549 550 ENDIF 551 552 ! read 3D velocities if baroclinic velocities require OR if 553 ! barotropic velocities required and ln_full_vel set to .true. 554 IF( nn_dyn3d_dta(ib_bdy) .eq. 1 .or. & 555 & ( ln_full_vel_array(ib_bdy) .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) ) THEN 556 557 IF( dta%ll_u3d .or. ( ln_full_vel_array(ib_bdy) .and. dta%ll_u2d ) ) THEN 558 if(lwp) write(numout,*) '++++++ reading in u3d field' 559 jfld = jfld + 1 560 blf_i(jfld) = bn_u3d 561 ibdy(jfld) = ib_bdy 562 igrid(jfld) = 2 563 ilen1(jfld) = nblen(igrid(jfld)) 564 ilen3(jfld) = jpk 565 IF( ln_full_vel_array(ib_bdy) .and. dta%ll_u2d ) dta%nread(2) = dta%nread(2) + 1 566 ENDIF 567 568 IF( dta%ll_v3d .or. ( ln_full_vel_array(ib_bdy) .and. dta%ll_v2d ) ) THEN 569 if(lwp) write(numout,*) '++++++ reading in v3d field' 570 jfld = jfld + 1 571 blf_i(jfld) = bn_v3d 572 ibdy(jfld) = ib_bdy 573 igrid(jfld) = 3 574 ilen1(jfld) = nblen(igrid(jfld)) 575 ilen3(jfld) = jpk 576 IF( ln_full_vel_array(ib_bdy) .and. dta%ll_v2d ) dta%nread(2) = dta%nread(2) + 1 577 ENDIF 536 578 537 579 ENDIF 538 580 539 581 ! temperature and salinity 540 IF( nn_tra(ib_bdy) .gt. 0 .and. nn_tra_dta(ib_bdy) .eq. 1 ) THEN 541 542 jfld = jfld + 1 543 blf_i(jfld) = bn_tem 544 ibdy(jfld) = ib_bdy 545 igrid(jfld) = 1 546 ilen1(jfld) = nblen(igrid(jfld)) 547 ilen3(jfld) = jpk 548 549 jfld = jfld + 1 550 blf_i(jfld) = bn_sal 551 ibdy(jfld) = ib_bdy 552 igrid(jfld) = 1 553 ilen1(jfld) = nblen(igrid(jfld)) 554 ilen3(jfld) = jpk 582 IF( nn_tra_dta(ib_bdy) .eq. 1 ) THEN 583 584 IF( dta%ll_tem ) THEN 585 if(lwp) write(numout,*) '++++++ reading in tem field' 586 jfld = jfld + 1 587 blf_i(jfld) = bn_tem 588 ibdy(jfld) = ib_bdy 589 igrid(jfld) = 1 590 ilen1(jfld) = nblen(igrid(jfld)) 591 ilen3(jfld) = jpk 592 ENDIF 593 594 IF( dta%ll_sal ) THEN 595 if(lwp) write(numout,*) '++++++ reading in sal field' 596 jfld = jfld + 1 597 blf_i(jfld) = bn_sal 598 ibdy(jfld) = ib_bdy 599 igrid(jfld) = 1 600 ilen1(jfld) = nblen(igrid(jfld)) 601 ilen3(jfld) = jpk 602 ENDIF 555 603 556 604 ENDIF … … 558 606 #if defined key_lim2 559 607 ! sea ice 560 IF( nn_ice_lim2(ib_bdy) .gt. 0 .and. nn_ice_lim2_dta(ib_bdy) .eq. 1 ) THEN 561 562 jfld = jfld + 1 563 blf_i(jfld) = bn_frld 564 ibdy(jfld) = ib_bdy 565 igrid(jfld) = 1 566 ilen1(jfld) = nblen(igrid(jfld)) 567 ilen3(jfld) = 1 568 569 jfld = jfld + 1 570 blf_i(jfld) = bn_hicif 571 ibdy(jfld) = ib_bdy 572 igrid(jfld) = 1 573 ilen1(jfld) = nblen(igrid(jfld)) 574 ilen3(jfld) = 1 575 576 jfld = jfld + 1 577 blf_i(jfld) = bn_hsnif 578 ibdy(jfld) = ib_bdy 579 igrid(jfld) = 1 580 ilen1(jfld) = nblen(igrid(jfld)) 581 ilen3(jfld) = 1 608 IF( nn_ice_lim2_dta(ib_bdy) .eq. 1 ) THEN 609 610 IF( dta%ll_frld ) THEN 611 jfld = jfld + 1 612 blf_i(jfld) = bn_frld 613 ibdy(jfld) = ib_bdy 614 igrid(jfld) = 1 615 ilen1(jfld) = nblen(igrid(jfld)) 616 ilen3(jfld) = 1 617 ENDIF 618 619 IF( dta%ll_hicif ) THEN 620 jfld = jfld + 1 621 blf_i(jfld) = bn_hicif 622 ibdy(jfld) = ib_bdy 623 igrid(jfld) = 1 624 ilen1(jfld) = nblen(igrid(jfld)) 625 ilen3(jfld) = 1 626 ENDIF 627 628 IF( dta%ll_hsnif ) THEN 629 jfld = jfld + 1 630 blf_i(jfld) = bn_hsnif 631 ibdy(jfld) = ib_bdy 632 igrid(jfld) = 1 633 ilen1(jfld) = nblen(igrid(jfld)) 634 ilen3(jfld) = 1 635 ENDIF 582 636 583 637 ENDIF … … 594 648 ENDIF 595 649 650 dta%nread(1) = nb_bdy_fld(ib_bdy) 651 596 652 ENDIF ! nn_dta .eq. 1 597 653 ENDDO ! ib_bdy … … 622 678 623 679 nblen => idx_bdy(ib_bdy)%nblen 624 nblenrim => idx_bdy(ib_bdy)%nblenrim 625 626 IF (nn_dyn2d(ib_bdy) .gt. 0) THEN 627 IF( nn_dyn2d_dta(ib_bdy) .eq. 0 .or. nn_dyn2d_dta(ib_bdy) .eq. 2 .or. ln_full_vel_array(ib_bdy) ) THEN 628 ilen0(1:3) = nblen(1:3) 629 ALLOCATE( dta_bdy(ib_bdy)%u2d(ilen0(2)) ) 630 ALLOCATE( dta_bdy(ib_bdy)%v2d(ilen0(3)) ) 631 IF ( nn_dyn2d(ib_bdy) .ne. jp_frs .and. (nn_dyn2d_dta(ib_bdy).eq.1.or.nn_dyn2d_dta(ib_bdy).eq.3) ) THEN 632 jfld = jfld + 1 633 dta_bdy(ib_bdy)%ssh => bf(jfld)%fnow(:,1,1) 680 dta => dta_bdy(ib_bdy) 681 682 if(lwp) then 683 write(numout,*) '++++++ dta%ll_ssh = ',dta%ll_ssh 684 write(numout,*) '++++++ dta%ll_u2d = ',dta%ll_u2d 685 write(numout,*) '++++++ dta%ll_v2d = ',dta%ll_v2d 686 write(numout,*) '++++++ dta%ll_u3d = ',dta%ll_u3d 687 write(numout,*) '++++++ dta%ll_v3d = ',dta%ll_v3d 688 write(numout,*) '++++++ dta%ll_tem = ',dta%ll_tem 689 write(numout,*) '++++++ dta%ll_sal = ',dta%ll_sal 690 endif 691 692 IF ( nn_dyn2d_dta(ib_bdy) .eq. 0 .or. nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN 693 if(lwp) write(numout,*) '++++++ dta%ssh/u2d/u3d allocated space' 694 IF( dta%ll_ssh ) ALLOCATE( dta%ssh(nblen(1)) ) 695 IF( dta%ll_u2d ) ALLOCATE( dta%u2d(nblen(2)) ) 696 IF( dta%ll_v2d ) ALLOCATE( dta%v2d(nblen(3)) ) 697 ENDIF 698 IF ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) THEN 699 IF( dta%ll_ssh ) THEN 700 if(lwp) write(numout,*) '++++++ dta%ssh pointing to fnow' 701 jfld = jfld + 1 702 dta%ssh => bf(jfld)%fnow(:,1,1) 703 ENDIF 704 IF ( dta%ll_u2d ) THEN 705 IF ( ln_full_vel_array(ib_bdy) ) THEN 706 if(lwp) write(numout,*) '++++++ dta%u2d allocated space' 707 ALLOCATE( dta%u2d(nblen(2)) ) 634 708 ELSE 635 ALLOCATE( dta_bdy(ib_bdy)%ssh(nblen(1)) ) 636 ENDIF 637 ELSE 638 IF( nn_dyn2d(ib_bdy) .ne. jp_frs ) THEN 639 jfld = jfld + 1 640 dta_bdy(ib_bdy)%ssh => bf(jfld)%fnow(:,1,1) 641 ENDIF 709 if(lwp) write(numout,*) '++++++ dta%u2d pointing to fnow' 710 jfld = jfld + 1 711 dta%u2d => bf(jfld)%fnow(:,1,1) 712 ENDIF 713 ENDIF 714 IF ( dta%ll_v2d ) THEN 715 IF ( ln_full_vel_array(ib_bdy) ) THEN 716 if(lwp) write(numout,*) '++++++ dta%v2d allocated space' 717 ALLOCATE( dta%v2d(nblen(3)) ) 718 ELSE 719 if(lwp) write(numout,*) '++++++ dta%v2d pointing to fnow' 720 jfld = jfld + 1 721 dta%v2d => bf(jfld)%fnow(:,1,1) 722 ENDIF 723 ENDIF 724 ENDIF 725 726 IF ( nn_dyn3d_dta(ib_bdy) .eq. 0 ) THEN 727 if(lwp) write(numout,*) '++++++ dta%u3d/v3d allocated space' 728 IF( dta%ll_u3d ) ALLOCATE( dta_bdy(ib_bdy)%u3d(nblen(2),jpk) ) 729 IF( dta%ll_v3d ) ALLOCATE( dta_bdy(ib_bdy)%v3d(nblen(3),jpk) ) 730 ENDIF 731 IF ( nn_dyn3d_dta(ib_bdy) .eq. 1 .or. & 732 & ( ln_full_vel_array(ib_bdy) .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) ) THEN 733 IF ( dta%ll_u3d .or. ( ln_full_vel_array(ib_bdy) .and. dta%ll_u2d ) ) THEN 734 if(lwp) write(numout,*) '++++++ dta%u3d pointing to fnow' 642 735 jfld = jfld + 1 643 dta_bdy(ib_bdy)%u2d => bf(jfld)%fnow(:,1,1) 736 dta_bdy(ib_bdy)%u3d => bf(jfld)%fnow(:,1,:) 737 ENDIF 738 IF ( dta%ll_v3d .or. ( ln_full_vel_array(ib_bdy) .and. dta%ll_v2d ) ) THEN 739 if(lwp) write(numout,*) '++++++ dta%v3d pointing to fnow' 644 740 jfld = jfld + 1 645 dta_bdy(ib_bdy)%v2d => bf(jfld)%fnow(:,1,1) 646 ENDIF 647 ENDIF 648 649 IF ( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 0 ) THEN 650 ilen0(1:3) = nblen(1:3) 651 ALLOCATE( dta_bdy(ib_bdy)%u3d(ilen0(2),jpk) ) 652 ALLOCATE( dta_bdy(ib_bdy)%v3d(ilen0(3),jpk) ) 653 ENDIF 654 IF ( ( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 1 ).or. & 655 & ( ln_full_vel_array(ib_bdy) .and. nn_dyn2d(ib_bdy) .gt. 0 .and. & 656 & ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) ) THEN 657 jfld = jfld + 1 658 dta_bdy(ib_bdy)%u3d => bf(jfld)%fnow(:,1,:) 659 jfld = jfld + 1 660 dta_bdy(ib_bdy)%v3d => bf(jfld)%fnow(:,1,:) 661 ENDIF 662 663 IF (nn_tra(ib_bdy) .gt. 0) THEN 664 IF( nn_tra_dta(ib_bdy) .eq. 0 ) THEN 665 ilen0(1:3) = nblen(1:3) 666 ALLOCATE( dta_bdy(ib_bdy)%tem(ilen0(1),jpk) ) 667 ALLOCATE( dta_bdy(ib_bdy)%sal(ilen0(1),jpk) ) 668 ELSE 741 dta_bdy(ib_bdy)%v3d => bf(jfld)%fnow(:,1,:) 742 ENDIF 743 ENDIF 744 745 IF( nn_tra_dta(ib_bdy) .eq. 0 ) THEN 746 if(lwp) write(numout,*) '++++++ dta%tem/sal allocated space' 747 IF( dta%ll_tem ) ALLOCATE( dta_bdy(ib_bdy)%tem(nblen(1),jpk) ) 748 IF( dta%ll_sal ) ALLOCATE( dta_bdy(ib_bdy)%sal(nblen(1),jpk) ) 749 ELSE 750 IF( dta%ll_tem ) THEN 751 if(lwp) write(numout,*) '++++++ dta%tem pointing to fnow' 669 752 jfld = jfld + 1 670 753 dta_bdy(ib_bdy)%tem => bf(jfld)%fnow(:,1,:) 754 ENDIF 755 IF( dta%ll_sal ) THEN 756 if(lwp) write(numout,*) '++++++ dta%sal pointing to fnow' 671 757 jfld = jfld + 1 672 758 dta_bdy(ib_bdy)%sal => bf(jfld)%fnow(:,1,:) … … 677 763 IF (nn_ice_lim2(ib_bdy) .gt. 0) THEN 678 764 IF( nn_ice_lim2_dta(ib_bdy) .eq. 0 ) THEN 679 ilen0(1:3) = nblen(1:3) 680 ALLOCATE( dta_bdy(ib_bdy)%frld(ilen0(1)) ) 681 ALLOCATE( dta_bdy(ib_bdy)%hicif(ilen0(1)) ) 682 ALLOCATE( dta_bdy(ib_bdy)%hsnif(ilen0(1)) ) 765 ALLOCATE( dta_bdy(ib_bdy)%frld(nblen(1)) ) 766 ALLOCATE( dta_bdy(ib_bdy)%hicif(nblen(1)) ) 767 ALLOCATE( dta_bdy(ib_bdy)%hsnif(nblen(1)) ) 683 768 ELSE 684 769 jfld = jfld + 1 -
branches/2013/dev_r3867_MERCATOR1_DYN/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn.F90
r4193 r4223 30 30 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 31 31 USE in_out_manager ! 32 USE domvvl ! variable volume32 USE domvvl 33 33 34 34 IMPLICIT NONE … … 57 57 LOGICAL, INTENT( in ), OPTIONAL :: dyn3d_only ! T => only update baroclinic velocities 58 58 !! 59 INTEGER :: jk,ii,ij,ib ,igrd ! Loop counter60 LOGICAL :: ll_dyn2d, ll_dyn3d 59 INTEGER :: jk,ii,ij,ib_bdy,ib,igrd ! Loop counter 60 LOGICAL :: ll_dyn2d, ll_dyn3d, ll_orlanski 61 61 !! 62 62 … … 70 70 ENDIF 71 71 72 ll_orlanski = .false. 73 DO ib_bdy = 1, nb_bdy 74 IF ( cn_dyn2d(ib_bdy) == 'orlanski' .or. cn_dyn2d(ib_bdy) == 'orlanski_npo' & 75 & .or. cn_dyn3d(ib_bdy) == 'orlanski' .or. cn_dyn3d(ib_bdy) == 'orlanski_npo') ll_orlanski = .true. 76 ENDDO 77 72 78 !------------------------------------------------------- 73 79 ! Set pointers … … 77 83 phur => hur 78 84 phvr => hvr 79 CALL wrk_alloc(jpi,jpj,pu2d,pv2d) 85 CALL wrk_alloc(jpi,jpj,pua2d,pva2d) 86 IF ( ll_orlanski ) CALL wrk_alloc(jpi,jpj,pub2d,pvb2d) 80 87 81 88 !------------------------------------------------------- … … 83 90 !------------------------------------------------------- 84 91 85 pu2d(:,:) = 0.e0 86 pv2d(:,:) = 0.e0 92 ! "After" velocities: 87 93 94 pua2d(:,:) = 0.e0 95 pva2d(:,:) = 0.e0 96 88 97 IF (lk_vvl) THEN 89 98 DO jk = 1, jpkm1 90 pu 2d(:,:) = pu2d(:,:) + fse3u_a(:,:,jk) * umask(:,:,jk) * ua(:,:,jk)91 pv 2d(:,:) = pv2d(:,:) + fse3v_a(:,:,jk) * vmask(:,:,jk) * va(:,:,jk)99 pua2d(:,:) = pua2d(:,:) + fse3u_a(:,:,jk) * umask(:,:,jk) * ua(:,:,jk) 100 pva2d(:,:) = pva2d(:,:) + fse3v_a(:,:,jk) * vmask(:,:,jk) * va(:,:,jk) 92 101 END DO 93 pu 2d(:,:) = pu2d(:,:) / ( hu_0(:,:) + sshu_a(:,:) + 1._wp - umask(:,:,1) )94 pv 2d(:,:) = pv2d(:,:) / ( hv_0(:,:) + sshv_a(:,:) + 1._wp - vmask(:,:,1) )102 pua2d(:,:) = pua2d(:,:) / ( hu_0(:,:) + sshu_a(:,:) + 1._wp - umask(:,:,1) ) 103 pva2d(:,:) = pva2d(:,:) / ( hv_0(:,:) + sshv_a(:,:) + 1._wp - vmask(:,:,1) ) 95 104 ELSE 96 105 DO jk = 1, jpkm1 97 pu 2d(:,:) = pu2d(:,:) + fse3u(:,:,jk) * umask(:,:,jk) * ua(:,:,jk)98 pv 2d(:,:) = pv2d(:,:) + fse3v(:,:,jk) * vmask(:,:,jk) * va(:,:,jk)106 pua2d(:,:) = pua2d(:,:) + fse3u(:,:,jk) * umask(:,:,jk) * ua(:,:,jk) 107 pva2d(:,:) = pva2d(:,:) + fse3v(:,:,jk) * vmask(:,:,jk) * va(:,:,jk) 99 108 END DO 100 pu 2d(:,:) = pu2d(:,:) * phur(:,:)101 pv 2d(:,:) = pv2d(:,:) * phvr(:,:)109 pua2d(:,:) = pua2d(:,:) * phur(:,:) 110 pva2d(:,:) = pva2d(:,:) * phvr(:,:) 102 111 ENDIF 103 112 104 113 DO jk = 1 , jpkm1 105 ua(:,:,jk) = ua(:,:,jk) - pu 2d(:,:) * umask(:,:,jk)106 va(:,:,jk) = va(:,:,jk) - pv 2d(:,:) * vmask(:,:,jk)114 ua(:,:,jk) = ua(:,:,jk) - pua2d(:,:) 115 va(:,:,jk) = va(:,:,jk) - pva2d(:,:) 107 116 END DO 117 118 ! "Before" velocities (required for Orlanski condition): 119 120 IF ( ll_orlanski ) THEN 121 pub2d(:,:) = 0.e0 122 pvb2d(:,:) = 0.e0 123 124 IF (lk_vvl) THEN 125 DO jk = 1, jpkm1 !! Vertically integrated momentum trends 126 pub2d(:,:) = pub2d(:,:) + fse3u_b(:,:,jk) * umask(:,:,jk) * ub(:,:,jk) 127 pvb2d(:,:) = pvb2d(:,:) + fse3v_b(:,:,jk) * vmask(:,:,jk) * vb(:,:,jk) 128 END DO 129 pub2d(:,:) = pub2d(:,:) / ( hu_0(:,:) + sshu_b(:,:) + 1._wp - umask(:,:,1) ) 130 pvb2d(:,:) = pvb2d(:,:) / ( hv_0(:,:) + sshv_b(:,:) + 1._wp - vmask(:,:,1) ) 131 ELSE 132 DO jk = 1, jpkm1 !! Vertically integrated momentum trends 133 pub2d(:,:) = pub2d(:,:) + fse3u(:,:,jk) * umask(:,:,jk) * ub(:,:,jk) 134 pvb2d(:,:) = pvb2d(:,:) + fse3v(:,:,jk) * vmask(:,:,jk) * vb(:,:,jk) 135 END DO 136 pub2d(:,:) = pub2d(:,:) * phur(:,:) 137 pvb2d(:,:) = pvb2d(:,:) * phvr(:,:) 138 ENDIF 139 140 DO jk = 1 , jpkm1 141 ub(:,:,jk) = ub(:,:,jk) - pub2d(:,:) 142 vb(:,:,jk) = vb(:,:,jk) - pvb2d(:,:) 143 END DO 144 END IF 108 145 109 146 !------------------------------------------------------- … … 121 158 122 159 DO jk = 1 , jpkm1 123 ua(:,:,jk) = ( ua(:,:,jk) + pu 2d(:,:) ) * umask(:,:,jk)124 va(:,:,jk) = ( va(:,:,jk) + pv 2d(:,:) ) * vmask(:,:,jk)160 ua(:,:,jk) = ( ua(:,:,jk) + pua2d(:,:) ) * umask(:,:,jk) 161 va(:,:,jk) = ( va(:,:,jk) + pva2d(:,:) ) * vmask(:,:,jk) 125 162 END DO 126 163 127 CALL wrk_dealloc(jpi,jpj,pu2d,pv2d) 164 IF ( ll_orlanski ) THEN 165 DO jk = 1 , jpkm1 166 ub(:,:,jk) = ( ub(:,:,jk) + pub2d(:,:) ) * umask(:,:,jk) 167 vb(:,:,jk) = ( vb(:,:,jk) + pvb2d(:,:) ) * vmask(:,:,jk) 168 END DO 169 END IF 170 171 CALL wrk_dealloc(jpi,jpj,pua2d,pva2d) 172 IF ( ll_orlanski ) CALL wrk_dealloc(jpi,jpj,pub2d,pvb2d) 128 173 129 174 IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn') -
branches/2013/dev_r3867_MERCATOR1_DYN/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90
r3970 r4223 12 12 !! 'key_bdy' : Unstructured Open Boundary Condition 13 13 !!---------------------------------------------------------------------- 14 !! bdy_dyn2d : Apply open boundary conditions to barotropic variables. 15 !! bdy_dyn2d_fla : Apply Flather condition 14 !! bdy_dyn2d : Apply open boundary conditions to barotropic variables. 15 !! bdy_dyn2d_frs : Apply Flow Relaxation Scheme 16 !! bdy_dyn2d_fla : Apply Flather condition 17 !! bdy_dyn2d_orlanski : Orlanski Radiation 18 !! bdy_ssh : Duplicate sea level across open boundaries 16 19 !!---------------------------------------------------------------------- 17 20 USE timing ! Timing … … 19 22 USE dom_oce ! ocean space and time domain 20 23 USE bdy_oce ! ocean open boundary conditions 24 USE bdylib ! BDY library routines 21 25 USE dynspg_oce ! for barotropic variables 22 26 USE phycst ! physical constants … … 27 31 PRIVATE 28 32 29 PUBLIC bdy_dyn2d 33 PUBLIC bdy_dyn2d ! routine called in dynspg_ts and bdy_dyn 30 34 PUBLIC bdy_ssh ! routine called in dynspg_ts or sshwzv 31 35 … … 50 54 DO ib_bdy=1, nb_bdy 51 55 52 SELECT CASE( nn_dyn2d(ib_bdy) )53 CASE( jp_none)56 SELECT CASE( cn_dyn2d(ib_bdy) ) 57 CASE('none') 54 58 CYCLE 55 CASE( jp_frs)59 CASE('frs') 56 60 CALL bdy_dyn2d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy ) 57 CASE( jp_flather)61 CASE('flather') 58 62 CALL bdy_dyn2d_fla( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy ) 63 CASE('orlanski') 64 CALL bdy_dyn2d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.false. ) 65 CASE('orlanski_npo') 66 CALL bdy_dyn2d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.true. ) 59 67 CASE DEFAULT 60 68 CALL ctl_stop( 'bdy_dyn2d : unrecognised option for open boundaries for barotropic variables' ) … … 91 99 ij = idx%nbj(jb,igrd) 92 100 zwgt = idx%nbw(jb,igrd) 93 pu 2d(ii,ij) = ( pu2d(ii,ij) + zwgt * ( dta%u2d(jb) - pu2d(ii,ij) ) ) * umask(ii,ij,1)101 pua2d(ii,ij) = ( pua2d(ii,ij) + zwgt * ( dta%u2d(jb) - pua2d(ii,ij) ) ) * umask(ii,ij,1) 94 102 END DO 95 103 ! … … 99 107 ij = idx%nbj(jb,igrd) 100 108 zwgt = idx%nbw(jb,igrd) 101 pv 2d(ii,ij) = ( pv2d(ii,ij) + zwgt * ( dta%v2d(jb) - pv2d(ii,ij) ) ) * vmask(ii,ij,1)109 pva2d(ii,ij) = ( pva2d(ii,ij) + zwgt * ( dta%v2d(jb) - pva2d(ii,ij) ) ) * vmask(ii,ij,1) 102 110 END DO 103 CALL lbc_bdy_lnk( pu 2d, 'U', -1., ib_bdy )104 CALL lbc_bdy_lnk( pv 2d, 'V', -1., ib_bdy) ! Boundary points should be updated111 CALL lbc_bdy_lnk( pua2d, 'U', -1., ib_bdy ) 112 CALL lbc_bdy_lnk( pva2d, 'V', -1., ib_bdy) ! Boundary points should be updated 105 113 ! 106 114 IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn2d_frs') … … 135 143 INTEGER :: jb, igrd ! dummy loop indices 136 144 INTEGER :: ii, ij, iim1, iip1, ijm1, ijp1 ! 2D addresses 145 REAL(wp), POINTER :: flagu, flagv ! short cuts 137 146 REAL(wp) :: zcorr ! Flather correction 138 147 REAL(wp) :: zforc ! temporary scalar … … 165 174 ii = idx%nbi(jb,igrd) 166 175 ij = idx%nbj(jb,igrd) 167 iim1 = ii + MAX( 0, INT( idx%flagu(jb) ) ) ! T pts i-indice inside the boundary 168 iip1 = ii - MIN( 0, INT( idx%flagu(jb) ) ) ! T pts i-indice outside the boundary 176 flagu => idx%flagu(jb,igrd) 177 iim1 = ii + MAX( 0, INT( flagu ) ) ! T pts i-indice inside the boundary 178 iip1 = ii - MIN( 0, INT( flagu ) ) ! T pts i-indice outside the boundary 169 179 ! 170 zcorr = - idx%flagu(jb) * SQRT( grav * phur(ii, ij) ) * ( pssh(iim1, ij) - spgu(iip1,ij) ) 171 ! bg jchanut tschanges: Set zflag to 0 below to revert to Flather scheme 172 !! zforc = dta%u2d(jb) 173 zflag = ABS(idx%flagu(jb)) 174 iim1 = ii + idx%flagu(jb) 175 zforc = dta%u2d(jb) * (1._wp - z1_2*zflag) + z1_2 * zflag * pu2d(iim1,ij) 176 pu2d(ii,ij) = zforc + (1._wp - z1_2*zflag) * zcorr * umask(ii,ij,1) 177 ! end jchanut tschanges 180 zcorr = - flagu * SQRT( grav * phur(ii, ij) ) * ( pssh(iim1, ij) - spgu(iip1,ij) ) 181 182 ! jchanut tschanges: Set zflag to 0 below to revert to Flather scheme 183 ! Use characteristics method instead 184 zflag = ABS(flagu) 185 zforc = dta%u2d(jb) * (1._wp - z1_2*zflag) + z1_2 * zflag * pua2d(iim1,ij) 186 pua2d(ii,ij) = zforc + (1._wp - z1_2*zflag) * zcorr * umask(ii,ij,1) 178 187 END DO 179 188 ! … … 183 192 ii = idx%nbi(jb,igrd) 184 193 ij = idx%nbj(jb,igrd) 185 ijm1 = ij + MAX( 0, INT( idx%flagv(jb) ) ) ! T pts j-indice inside the boundary 186 ijp1 = ij - MIN( 0, INT( idx%flagv(jb) ) ) ! T pts j-indice outside the boundary 194 flagv => idx%flagv(jb,igrd) 195 ijm1 = ij + MAX( 0, INT( flagv ) ) ! T pts j-indice inside the boundary 196 ijp1 = ij - MIN( 0, INT( flagv ) ) ! T pts j-indice outside the boundary 187 197 ! 188 zcorr = - idx%flagv(jb) * SQRT( grav * phvr(ii, ij) ) * ( pssh(ii, ijm1) - spgu(ii,ijp1) ) 189 ! bg jchanut tschanges: Set zflag to 0 below to revert to std Flather scheme 190 !! zforc = dta%v2d(jb) 191 zflag = ABS(idx%flagv(jb)) 192 ijm1 = ij + idx%flagv(jb) 193 zforc = dta%v2d(jb) * (1._wp - z1_2*zflag) + z1_2 * zflag * pv2d(ii,ijm1) 194 pv2d(ii,ij) = zforc + (1._wp - z1_2*zflag) * zcorr * vmask(ii,ij,1) 195 ! end jchanut tschanges 196 END DO 197 CALL lbc_bdy_lnk( pu2d, 'U', -1., ib_bdy ) ! Boundary points should be updated 198 CALL lbc_bdy_lnk( pv2d, 'V', -1., ib_bdy ) ! 198 zcorr = - flagv * SQRT( grav * phvr(ii, ij) ) * ( pssh(ii, ijm1) - spgu(ii,ijp1) ) 199 200 ! jchanut tschanges: Set zflag to 0 below to revert to std Flather scheme 201 ! Use characteristics method instead 202 zflag = ABS(flagv) 203 zforc = dta%v2d(jb) * (1._wp - z1_2*zflag) + z1_2 * zflag * pva2d(ii,ijm1) 204 pva2d(ii,ij) = zforc + (1._wp - z1_2*zflag) * zcorr * vmask(ii,ij,1) 205 END DO 206 CALL lbc_bdy_lnk( pua2d, 'U', -1., ib_bdy ) ! Boundary points should be updated 207 CALL lbc_bdy_lnk( pva2d, 'V', -1., ib_bdy ) ! 199 208 ! 200 209 IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn2d_fla') 201 210 ! 202 211 END SUBROUTINE bdy_dyn2d_fla 212 213 214 SUBROUTINE bdy_dyn2d_orlanski( idx, dta, ib_bdy, ll_npo ) 215 !!---------------------------------------------------------------------- 216 !! *** SUBROUTINE bdy_dyn2d_orlanski *** 217 !! 218 !! - Apply Orlanski radiation condition adaptively: 219 !! - radiation plus weak nudging at outflow points 220 !! - no radiation and strong nudging at inflow points 221 !! 222 !! 223 !! References: Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001) 224 !!---------------------------------------------------------------------- 225 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 226 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data 227 INTEGER, INTENT(in) :: ib_bdy ! number of current open boundary set 228 LOGICAL, INTENT(in) :: ll_npo ! flag for NPO version 229 230 INTEGER :: ib, igrd ! dummy loop indices 231 INTEGER :: ii, ij, iibm1, ijbm1 ! indices 232 !!---------------------------------------------------------------------- 233 234 IF( nn_timing == 1 ) CALL timing_start('bdy_dyn2d_orlanski') 235 ! 236 igrd = 2 ! Orlanski bc on u-velocity; 237 ! 238 CALL bdy_orlanski_2d( idx, igrd, pub2d, pua2d, dta%u2d, ll_npo ) 239 240 igrd = 3 ! Orlanski bc on v-velocity 241 ! 242 CALL bdy_orlanski_2d( idx, igrd, pvb2d, pva2d, dta%v2d, ll_npo ) 243 ! 244 IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn2d_orlanski') 245 ! 246 CALL lbc_bdy_lnk( pua2d, 'U', -1., ib_bdy ) ! Boundary points should be updated 247 CALL lbc_bdy_lnk( pva2d, 'V', -1., ib_bdy ) ! 248 ! 249 IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn2d_orlanski') 250 ! 251 END SUBROUTINE bdy_dyn2d_orlanski 203 252 204 253 SUBROUTINE bdy_ssh( zssh ) … … 248 297 249 298 END SUBROUTINE bdy_ssh 299 250 300 #else 251 301 !!---------------------------------------------------------------------- … … 255 305 SUBROUTINE bdy_dyn2d( kt ) ! Empty routine 256 306 INTEGER, intent(in) :: kt 257 WRITE(*,*) 'bdy_dyn2 : You should not have seen this print! error?', kt307 WRITE(*,*) 'bdy_dyn2d: You should not have seen this print! error?', kt 258 308 END SUBROUTINE bdy_dyn2d 259 309 -
branches/2013/dev_r3867_MERCATOR1_DYN/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90
r3703 r4223 19 19 USE dom_oce ! ocean space and time domain 20 20 USE bdy_oce ! ocean open boundary conditions 21 USE bdylib ! for orlanski library routines 21 22 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 22 23 USE in_out_manager ! … … 52 53 DO ib_bdy=1, nb_bdy 53 54 54 !!$ IF ( using Orlanski radiation conditions ) THEN 55 !!$ CALL bdy_rad( kt, bdyidx(ib_bdy) ) 56 !!$ ENDIF 57 58 SELECT CASE( nn_dyn3d(ib_bdy) ) 59 CASE(jp_none) 55 SELECT CASE( cn_dyn3d(ib_bdy) ) 56 CASE('none') 60 57 CYCLE 61 CASE( jp_frs)58 CASE('frs') 62 59 CALL bdy_dyn3d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 63 CASE( 2)60 CASE('specified') 64 61 CALL bdy_dyn3d_spe( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 65 CASE( 3)62 CASE('zero') 66 63 CALL bdy_dyn3d_zro( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 64 CASE('orlanski') 65 CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.false. ) 66 CASE('orlanski_npo') 67 CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.true. ) 67 68 CASE DEFAULT 68 69 CALL ctl_stop( 'bdy_dyn3d : unrecognised option for open boundaries for baroclinic velocities' ) … … 109 110 END DO 110 111 END DO 111 CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy ) ; CALL lbc_bdy_lnk( va, 'V', -1.,ib_bdy ) ! Boundary points should be updated 112 CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy ) ! Boundary points should be updated 113 CALL lbc_bdy_lnk( va, 'V', -1., ib_bdy ) 112 114 ! 113 115 IF( kt .eq. nit000 ) CLOSE( unit = 102 ) … … 204 206 END DO 205 207 END DO 206 CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy ) ; CALL lbc_bdy_lnk( va, 'V', -1.,ib_bdy ) ! Boundary points should be updated 208 CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy ) ! Boundary points should be updated 209 CALL lbc_bdy_lnk( va, 'V', -1., ib_bdy ) 207 210 ! 208 211 IF( kt .eq. nit000 ) CLOSE( unit = 102 ) … … 211 214 212 215 END SUBROUTINE bdy_dyn3d_frs 216 217 SUBROUTINE bdy_dyn3d_orlanski( idx, dta, ib_bdy, ll_npo ) 218 !!---------------------------------------------------------------------- 219 !! *** SUBROUTINE bdy_dyn3d_orlanski *** 220 !! 221 !! - Apply Orlanski radiation to baroclinic velocities. 222 !! - Wrapper routine for bdy_orlanski_3d 223 !! 224 !! 225 !! References: Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001) 226 !!---------------------------------------------------------------------- 227 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 228 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data 229 INTEGER, INTENT(in) :: ib_bdy ! BDY set index 230 LOGICAL, INTENT(in) :: ll_npo ! switch for NPO version 231 232 INTEGER :: jb, igrd ! dummy loop indices 233 !!---------------------------------------------------------------------- 234 235 IF( nn_timing == 1 ) CALL timing_start('bdy_dyn3d_orlanski') 236 ! 237 !! Note that at this stage the ub and ua arrays contain the baroclinic velocities. 238 ! 239 igrd = 2 ! Orlanski bc on u-velocity; 240 ! 241 CALL bdy_orlanski_3d( idx, igrd, ub, ua, dta%u3d, ll_npo ) 242 243 igrd = 3 ! Orlanski bc on v-velocity 244 ! 245 CALL bdy_orlanski_3d( idx, igrd, vb, va, dta%v3d, ll_npo ) 246 ! 247 CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy ) ! Boundary points should be updated 248 CALL lbc_bdy_lnk( va, 'V', -1., ib_bdy ) 249 ! 250 IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_orlanski') 251 ! 252 END SUBROUTINE bdy_dyn3d_orlanski 253 213 254 214 255 SUBROUTINE bdy_dyn3d_dmp( kt ) … … 232 273 ! Remove barotropic part from before velocity 233 274 !------------------------------------------------------- 234 CALL wrk_alloc(jpi,jpj,pu 2d,pv2d)235 236 pu 2d(:,:) = 0.e0237 pv 2d(:,:) = 0.e0275 CALL wrk_alloc(jpi,jpj,pub2d,pvb2d) 276 277 pub2d(:,:) = 0.e0 278 pvb2d(:,:) = 0.e0 238 279 239 280 DO jk = 1, jpkm1 240 281 #if defined key_vvl 241 pu 2d(:,:) = pu2d(:,:) + fse3u_b(:,:,jk)* ub(:,:,jk) *umask(:,:,jk)242 pv 2d(:,:) = pv2d(:,:) + fse3v_b(:,:,jk)* vb(:,:,jk) *vmask(:,:,jk)282 pub2d(:,:) = pub2d(:,:) + fse3u_b(:,:,jk)* ub(:,:,jk) *umask(:,:,jk) 283 pvb2d(:,:) = pvb2d(:,:) + fse3v_b(:,:,jk)* vb(:,:,jk) *vmask(:,:,jk) 243 284 #else 244 pu 2d(:,:) = pu2d(:,:) + fse3u_0(:,:,jk) * ub(:,:,jk) * umask(:,:,jk)245 pv 2d(:,:) = pv2d(:,:) + fse3v_0(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk)285 pub2d(:,:) = pub2d(:,:) + fse3u_0(:,:,jk) * ub(:,:,jk) * umask(:,:,jk) 286 pvb2d(:,:) = pvb2d(:,:) + fse3v_0(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk) 246 287 #endif 247 288 END DO 248 289 249 290 IF( lk_vvl ) THEN 250 pu 2d(:,:) = pu2d(:,:) * umask(:,:,1) / ( hu_0(:,:) + sshu_b(:,:) + 1._wp - umask(:,:,1) )251 pv 2d(:,:) = pv2d(:,:) * vmask(:,:,1) / ( hv_0(:,:) + sshv_b(:,:) + 1._wp - vmask(:,:,1) )291 pub2d(:,:) = pub2d(:,:) * umask(:,:,1) / ( hu_0(:,:) + sshu_b(:,:) + 1._wp - umask(:,:,1) ) 292 pvb2d(:,:) = pvb2d(:,:) * vmask(:,:,1) / ( hv_0(:,:) + sshv_b(:,:) + 1._wp - vmask(:,:,1) ) 252 293 ELSE 253 pu 2d(:,:) = pv2d(:,:) * hur(:,:)254 pv 2d(:,:) = pu2d(:,:) * hvr(:,:)294 pub2d(:,:) = pvb2d(:,:) * hur(:,:) 295 pvb2d(:,:) = pub2d(:,:) * hvr(:,:) 255 296 ENDIF 256 297 257 298 DO ib_bdy=1, nb_bdy 258 IF ( ln_dyn3d_dmp(ib_bdy) .and.nn_dyn3d(ib_bdy).gt.0) THEN299 IF ( ln_dyn3d_dmp(ib_bdy) .and. cn_dyn3d(ib_bdy) /= 'none' ) THEN 259 300 igrd = 2 ! Relaxation of zonal velocity 260 301 DO jb = 1, idx_bdy(ib_bdy)%nblen(igrd) … … 264 305 DO jk = 1, jpkm1 265 306 ua(ii,ij,jk) = ( ua(ii,ij,jk) + zwgt * ( dta_bdy(ib_bdy)%u3d(jb,jk) - & 266 ub(ii,ij,jk) + pu 2d(ii,ij)) ) * umask(ii,ij,jk)307 ub(ii,ij,jk) + pub2d(ii,ij)) ) * umask(ii,ij,jk) 267 308 END DO 268 309 END DO … … 275 316 DO jk = 1, jpkm1 276 317 va(ii,ij,jk) = ( va(ii,ij,jk) + zwgt * ( dta_bdy(ib_bdy)%v3d(jb,jk) - & 277 vb(ii,ij,jk) + pv 2d(ii,ij)) ) * vmask(ii,ij,jk)318 vb(ii,ij,jk) + pvb2d(ii,ij)) ) * vmask(ii,ij,jk) 278 319 END DO 279 320 END DO … … 281 322 ENDDO 282 323 ! 283 CALL wrk_dealloc(jpi,jpj,pu 2d,pv2d)324 CALL wrk_dealloc(jpi,jpj,pub2d,pvb2d) 284 325 ! 285 326 CALL lbc_lnk( ua, 'U', -1. ) ; CALL lbc_lnk( va, 'V', -1. ) ! Boundary points should be updated -
branches/2013/dev_r3867_MERCATOR1_DYN/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim2.F90
r4193 r4223 50 50 DO ib_bdy=1, nb_bdy 51 51 52 SELECT CASE( nn_ice_lim2(ib_bdy) )53 CASE( jp_none)52 SELECT CASE( cn_ice_lim2(ib_bdy) ) 53 CASE('none') 54 54 CYCLE 55 CASE( jp_frs)55 CASE('frs') 56 56 CALL bdy_ice_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy ) 57 57 CASE DEFAULT -
branches/2013/dev_r3867_MERCATOR1_DYN/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90
r4193 r4223 21 21 !! bdy_init : Initialization of unstructured open boundaries 22 22 !!---------------------------------------------------------------------- 23 USE wrk_nemo ! Memory Allocation 23 24 USE timing ! Timing 24 25 USE oce ! ocean dynamics and tracers variables … … 79 80 INTEGER :: jpbdtau, jpbdtas ! - - 80 81 INTEGER :: ib_bdy1, ib_bdy2, ib1, ib2 ! - - 82 INTEGER :: i_offset, j_offset ! - - 81 83 INTEGER, POINTER :: nbi, nbj, nbr ! short cuts 82 REAL , POINTER :: flagu, flagv ! - - 84 REAL(wp), POINTER :: flagu, flagv ! - - 85 REAL(wp), POINTER, DIMENSION(:,:) :: pmask ! pointer to 2D mask fields 83 86 REAL(wp) :: zefl, zwfl, znfl, zsfl ! local scalars 84 87 INTEGER, DIMENSION (2) :: kdimsz … … 90 93 INTEGER :: com_east_b, com_west_b, com_south_b, com_north_b ! Flags for boundaries receiving 91 94 INTEGER :: iw_b(4), ie_b(4), is_b(4), in_b(4) ! Arrays for neighbours coordinates 95 REAL(wp), POINTER, DIMENSION(:,:) :: zfmask ! temporary fmask array excluding coastal boundary condition (shlat) 92 96 93 97 !! 94 NAMELIST/nambdy/ nb_bdy, ln_coords_file, cn_coords_file, &95 & ln_mask_file, cn_mask_file, nn_dyn2d, nn_dyn2d_dta,&96 & nn_dyn3d, nn_dyn3d_dta, nn_tra, nn_tra_dta,&97 & ln_tra_dmp, ln_dyn3d_dmp, rn_time_dmp, 98 NAMELIST/nambdy/ nb_bdy, ln_coords_file, cn_coords_file, & 99 & ln_mask_file, cn_mask_file, cn_dyn2d, nn_dyn2d_dta, & 100 & cn_dyn3d, nn_dyn3d_dta, cn_tra, nn_tra_dta, & 101 & ln_tra_dmp, ln_dyn3d_dmp, rn_time_dmp, rn_time_dmp_out, & 98 102 #if defined key_lim2 99 & nn_ice_lim2, nn_ice_lim2_dta,&103 & cn_ice_lim2, nn_ice_lim2_dta, & 100 104 #endif 101 105 & ln_vol, nn_volctl, nn_rimwidth … … 128 132 ln_mask_file = .false. 129 133 cn_mask_file(:) = '' 130 nn_dyn2d(:) = 0134 cn_dyn2d(:) = '' 131 135 nn_dyn2d_dta(:) = -1 ! uninitialised flag 132 nn_dyn3d(:) = 0136 cn_dyn3d(:) = '' 133 137 nn_dyn3d_dta(:) = -1 ! uninitialised flag 134 nn_tra(:) = 0138 cn_tra(:) = '' 135 139 nn_tra_dta(:) = -1 ! uninitialised flag 136 140 ln_tra_dmp(:) = .false. … … 138 142 rn_time_dmp(:) = 1. 139 143 #if defined key_lim2 140 nn_ice_lim2(:) = 0144 cn_ice_lim2(:) = '' 141 145 nn_ice_lim2_dta(:)= -1 ! uninitialised flag 142 146 #endif … … 161 165 162 166 DO ib_bdy = 1,nb_bdy 163 icount = 0 ! flag to set max rimwidth to 1 if no relaxation164 167 IF(lwp) WRITE(numout,*) ' ' 165 168 IF(lwp) WRITE(numout,*) '------ Open boundary data set ',ib_bdy,'------' … … 173 176 174 177 IF(lwp) WRITE(numout,*) 'Boundary conditions for barotropic solution: ' 175 SELECT CASE( nn_dyn2d(ib_bdy) ) 176 CASE(jp_none) ; IF(lwp) WRITE(numout,*) ' no open boundary condition' 177 CASE(jp_frs) ; IF(lwp) WRITE(numout,*) ' Flow Relaxation Scheme' 178 icount = icount + 1 179 CASE(jp_flather) ; IF(lwp) WRITE(numout,*) ' Flather radiation condition' 180 CASE DEFAULT ; CALL ctl_stop( 'unrecognised value for nn_dyn2d' ) 178 SELECT CASE( cn_dyn2d(ib_bdy) ) 179 CASE('none') 180 IF(lwp) WRITE(numout,*) ' no open boundary condition' 181 dta_bdy(ib_bdy)%ll_ssh = .false. 182 dta_bdy(ib_bdy)%ll_u2d = .false. 183 dta_bdy(ib_bdy)%ll_v2d = .false. 184 CASE('frs') 185 IF(lwp) WRITE(numout,*) ' Flow Relaxation Scheme' 186 dta_bdy(ib_bdy)%ll_ssh = .false. 187 dta_bdy(ib_bdy)%ll_u2d = .true. 188 dta_bdy(ib_bdy)%ll_v2d = .true. 189 CASE('flather') 190 IF(lwp) WRITE(numout,*) ' Flather radiation condition' 191 dta_bdy(ib_bdy)%ll_ssh = .true. 192 dta_bdy(ib_bdy)%ll_u2d = .true. 193 dta_bdy(ib_bdy)%ll_v2d = .true. 194 CASE('orlanski') 195 IF(lwp) WRITE(numout,*) ' Orlanski (fully oblique) radiation condition with adaptive nudging' 196 dta_bdy(ib_bdy)%ll_ssh = .false. 197 dta_bdy(ib_bdy)%ll_u2d = .true. 198 dta_bdy(ib_bdy)%ll_v2d = .true. 199 CASE('orlanski_npo') 200 IF(lwp) WRITE(numout,*) ' Orlanski (NPO) radiation condition with adaptive nudging' 201 dta_bdy(ib_bdy)%ll_ssh = .false. 202 dta_bdy(ib_bdy)%ll_u2d = .true. 203 dta_bdy(ib_bdy)%ll_v2d = .true. 204 CASE DEFAULT ; CALL ctl_stop( 'unrecognised value for cn_dyn2d' ) 181 205 END SELECT 182 IF( nn_dyn2d(ib_bdy) .gt. 0) THEN206 IF( cn_dyn2d(ib_bdy) /= 'none' ) THEN 183 207 SELECT CASE( nn_dyn2d_dta(ib_bdy) ) ! 184 208 CASE( 0 ) ; IF(lwp) WRITE(numout,*) ' initial state used for bdy data' … … 195 219 196 220 IF(lwp) WRITE(numout,*) 'Boundary conditions for baroclinic velocities: ' 197 SELECT CASE( nn_dyn3d(ib_bdy) ) 198 CASE(jp_none) ; IF(lwp) WRITE(numout,*) ' no open boundary condition' 199 CASE(jp_frs) ; IF(lwp) WRITE(numout,*) ' Flow Relaxation Scheme' 200 icount = icount + 1 201 CASE( 2 ) ; IF(lwp) WRITE(numout,*) ' Specified value' 202 CASE( 3 ) ; IF(lwp) WRITE(numout,*) ' Zero baroclinic velocities (runoff case)' 203 CASE DEFAULT ; CALL ctl_stop( 'unrecognised value for nn_dyn3d' ) 221 SELECT CASE( cn_dyn3d(ib_bdy) ) 222 CASE('none') 223 IF(lwp) WRITE(numout,*) ' no open boundary condition' 224 dta_bdy(ib_bdy)%ll_u3d = .false. 225 dta_bdy(ib_bdy)%ll_v3d = .false. 226 CASE('frs') 227 IF(lwp) WRITE(numout,*) ' Flow Relaxation Scheme' 228 dta_bdy(ib_bdy)%ll_u3d = .true. 229 dta_bdy(ib_bdy)%ll_v3d = .true. 230 CASE('specified') 231 IF(lwp) WRITE(numout,*) ' Specified value' 232 dta_bdy(ib_bdy)%ll_u3d = .true. 233 dta_bdy(ib_bdy)%ll_v3d = .true. 234 CASE('zero') 235 IF(lwp) WRITE(numout,*) ' Zero baroclinic velocities (runoff case)' 236 dta_bdy(ib_bdy)%ll_u3d = .false. 237 dta_bdy(ib_bdy)%ll_v3d = .false. 238 CASE('orlanski') 239 IF(lwp) WRITE(numout,*) ' Orlanski (fully oblique) radiation condition with adaptive nudging' 240 dta_bdy(ib_bdy)%ll_u3d = .true. 241 dta_bdy(ib_bdy)%ll_v3d = .true. 242 CASE('orlanski_npo') 243 IF(lwp) WRITE(numout,*) ' Orlanski (NPO) radiation condition with adaptive nudging' 244 dta_bdy(ib_bdy)%ll_u3d = .true. 245 dta_bdy(ib_bdy)%ll_v3d = .true. 246 CASE DEFAULT ; CALL ctl_stop( 'unrecognised value for cn_dyn3d' ) 204 247 END SELECT 205 IF( nn_dyn3d(ib_bdy) .gt. 0) THEN248 IF( cn_dyn3d(ib_bdy) /= 'none' ) THEN 206 249 SELECT CASE( nn_dyn3d_dta(ib_bdy) ) ! 207 250 CASE( 0 ) ; IF(lwp) WRITE(numout,*) ' initial state used for bdy data' … … 212 255 213 256 IF ( ln_dyn3d_dmp(ib_bdy) ) THEN 214 IF ( nn_dyn3d(ib_bdy).EQ.0) THEN257 IF ( cn_dyn3d(ib_bdy) == 'none' ) THEN 215 258 IF(lwp) WRITE(numout,*) 'No open boundary condition for baroclinic velocities: ln_dyn3d_dmp is set to .false.' 216 259 ln_dyn3d_dmp(ib_bdy)=.false. 217 ELSEIF ( nn_dyn3d(ib_bdy).EQ.1) THEN260 ELSEIF ( cn_dyn3d(ib_bdy) == 'frs' ) THEN 218 261 CALL ctl_stop( 'Use FRS OR relaxation' ) 219 262 ELSE 220 icount = icount + 1221 263 IF(lwp) WRITE(numout,*) ' + baroclinic velocities relaxation zone' 222 264 IF(lwp) WRITE(numout,*) ' Damping time scale: ',rn_time_dmp(ib_bdy),' days' 223 265 IF((lwp).AND.rn_time_dmp(ib_bdy)<0) CALL ctl_stop( 'Time scale must be positive' ) 266 dta_bdy(ib_bdy)%ll_u3d = .true. 267 dta_bdy(ib_bdy)%ll_v3d = .true. 224 268 ENDIF 225 269 ELSE … … 229 273 230 274 IF(lwp) WRITE(numout,*) 'Boundary conditions for temperature and salinity: ' 231 SELECT CASE( nn_tra(ib_bdy) ) 232 CASE(jp_none) ; IF(lwp) WRITE(numout,*) ' no open boundary condition' 233 CASE(jp_frs) ; IF(lwp) WRITE(numout,*) ' Flow Relaxation Scheme' 234 icount = icount + 1 235 CASE( 2 ) ; IF(lwp) WRITE(numout,*) ' Specified value' 236 CASE( 3 ) ; IF(lwp) WRITE(numout,*) ' Neumann conditions' 237 CASE( 4 ) ; IF(lwp) WRITE(numout,*) ' Runoff conditions : Neumann for T and specified to 0.1 for salinity' 238 CASE DEFAULT ; CALL ctl_stop( 'unrecognised value for nn_tra' ) 275 SELECT CASE( cn_tra(ib_bdy) ) 276 CASE('none') 277 IF(lwp) WRITE(numout,*) ' no open boundary condition' 278 dta_bdy(ib_bdy)%ll_tem = .false. 279 dta_bdy(ib_bdy)%ll_sal = .false. 280 CASE('frs') 281 IF(lwp) WRITE(numout,*) ' Flow Relaxation Scheme' 282 dta_bdy(ib_bdy)%ll_tem = .true. 283 dta_bdy(ib_bdy)%ll_sal = .true. 284 CASE('specified') 285 IF(lwp) WRITE(numout,*) ' Specified value' 286 dta_bdy(ib_bdy)%ll_tem = .true. 287 dta_bdy(ib_bdy)%ll_sal = .true. 288 CASE('neumann') 289 IF(lwp) WRITE(numout,*) ' Neumann conditions' 290 dta_bdy(ib_bdy)%ll_tem = .false. 291 dta_bdy(ib_bdy)%ll_sal = .false. 292 CASE('runoff') 293 IF(lwp) WRITE(numout,*) ' Runoff conditions : Neumann for T and specified to 0.1 for salinity' 294 dta_bdy(ib_bdy)%ll_tem = .false. 295 dta_bdy(ib_bdy)%ll_sal = .false. 296 CASE('orlanski') 297 IF(lwp) WRITE(numout,*) ' Orlanski (fully oblique) radiation condition with adaptive nudging' 298 dta_bdy(ib_bdy)%ll_tem = .true. 299 dta_bdy(ib_bdy)%ll_sal = .true. 300 CASE('orlanski_npo') 301 IF(lwp) WRITE(numout,*) ' Orlanski (NPO) radiation condition with adaptive nudging' 302 dta_bdy(ib_bdy)%ll_tem = .true. 303 dta_bdy(ib_bdy)%ll_sal = .true. 304 CASE DEFAULT ; CALL ctl_stop( 'unrecognised value for cn_tra' ) 239 305 END SELECT 240 IF( nn_tra(ib_bdy) .gt. 0) THEN306 IF( cn_tra(ib_bdy) /= 'none' ) THEN 241 307 SELECT CASE( nn_tra_dta(ib_bdy) ) ! 242 308 CASE( 0 ) ; IF(lwp) WRITE(numout,*) ' initial state used for bdy data' … … 247 313 248 314 IF ( ln_tra_dmp(ib_bdy) ) THEN 249 IF ( nn_tra(ib_bdy).EQ.0) THEN315 IF ( cn_tra(ib_bdy) == 'none' ) THEN 250 316 IF(lwp) WRITE(numout,*) 'No open boundary condition for tracers: ln_tra_dmp is set to .false.' 251 317 ln_tra_dmp(ib_bdy)=.false. 252 ELSEIF ( nn_tra(ib_bdy).EQ.1) THEN318 ELSEIF ( cn_tra(ib_bdy) == 'frs' ) THEN 253 319 CALL ctl_stop( 'Use FRS OR relaxation' ) 254 320 ELSE 255 icount = icount + 1256 321 IF(lwp) WRITE(numout,*) ' + T/S relaxation zone' 257 322 IF(lwp) WRITE(numout,*) ' Damping time scale: ',rn_time_dmp(ib_bdy),' days' 323 IF(lwp) WRITE(numout,*) ' Outflow damping time scale: ',rn_time_dmp_out(ib_bdy),' days' 258 324 IF((lwp).AND.rn_time_dmp(ib_bdy)<0) CALL ctl_stop( 'Time scale must be positive' ) 325 dta_bdy(ib_bdy)%ll_tem = .true. 326 dta_bdy(ib_bdy)%ll_sal = .true. 259 327 ENDIF 260 328 ELSE … … 265 333 #if defined key_lim2 266 334 IF(lwp) WRITE(numout,*) 'Boundary conditions for sea ice: ' 267 SELECT CASE( nn_ice_lim2(ib_bdy) ) 268 CASE( 0 ) ; IF(lwp) WRITE(numout,*) ' no open boundary condition' 269 CASE( 1 ) ; IF(lwp) WRITE(numout,*) ' Flow Relaxation Scheme' 270 icount = icount + 1 271 CASE DEFAULT ; CALL ctl_stop( 'unrecognised value for nn_tra' ) 335 SELECT CASE( cn_ice_lim2(ib_bdy) ) 336 CASE('none') 337 IF(lwp) WRITE(numout,*) ' no open boundary condition' 338 dta_bdy(ib_bdy)%ll_frld = .false. 339 dta_bdy(ib_bdy)%ll_hicif = .false. 340 dta_bdy(ib_bdy)%ll_hsnif = .false. 341 CASE('frs') 342 IF(lwp) WRITE(numout,*) ' Flow Relaxation Scheme' 343 dta_bdy(ib_bdy)%ll_frld = .true. 344 dta_bdy(ib_bdy)%ll_hicif = .true. 345 dta_bdy(ib_bdy)%ll_hsnif = .true. 346 CASE DEFAULT ; CALL ctl_stop( 'unrecognised value for cn_ice_lim2' ) 272 347 END SELECT 273 IF( nn_ice_lim2(ib_bdy) .gt. 0) THEN348 IF( cn_ice_lim2(ib_bdy) /= 'none' ) THEN 274 349 SELECT CASE( nn_ice_lim2_dta(ib_bdy) ) ! 275 350 CASE( 0 ) ; IF(lwp) WRITE(numout,*) ' initial state used for bdy data' … … 280 355 IF(lwp) WRITE(numout,*) 281 356 #endif 282 IF ( icount>0 ) THEN 283 IF(lwp) WRITE(numout,*) ' Width of relaxation zone = ', nn_rimwidth(ib_bdy) 284 IF(lwp) WRITE(numout,*) 285 ELSE 286 nn_rimwidth(ib_bdy) = 1 ! no relaxation 287 ENDIF 357 358 IF(lwp) WRITE(numout,*) ' Width of relaxation zone = ', nn_rimwidth(ib_bdy) 359 IF(lwp) WRITE(numout,*) 288 360 289 361 ENDDO … … 401 473 ENDDO 402 474 CALL iom_close( inum ) 475 403 476 ENDIF 404 477 … … 407 480 IF (nb_bdy>0) THEN 408 481 jpbdta = MAXVAL(nblendta(1:jpbgrd,1:nb_bdy)) 482 409 483 ! Allocate arrays 410 484 !--------------- … … 454 528 ENDIF 455 529 456 ENDDO 530 ENDDO 457 531 458 532 ! 2. Now fill indices corresponding to straight open boundary arrays: … … 752 826 IF(lwp) THEN ! Since all procs read global data only need to do this check on one proc... 753 827 IF( nbrdta(ib,igrd,ib_bdy) < nbrdta(ibm1,igrd,ib_bdy) ) THEN 754 CALL ctl_stop('bdy_init : ERROR : boundary data in file & 755 must be defined in order of distance from edge nbr.', & 756 'A utility for re-ordering boundary coordinates and data & 757 files exists in the TOOLS/OBC directory') 828 CALL ctl_stop('bdy_init : ERROR : boundary data in file must be defined in order of distance from edge nbr.', & 829 'A utility for re-ordering boundary coordinates and data files exists in the TOOLS/OBC directory') 758 830 ENDIF 759 831 ENDIF 760 832 ! check if point is in local domain 761 833 IF( nbidta(ib,igrd,ib_bdy) >= iw .AND. nbidta(ib,igrd,ib_bdy) <= ie .AND. & 762 & nbjdta(ib,igrd,ib_bdy) >= is .AND. nbjdta(ib,igrd,ib_bdy) <= in .AND. & 763 & nbrdta(ib,igrd,ib_bdy) <= nn_rimwidth(ib_bdy) ) THEN 834 & nbjdta(ib,igrd,ib_bdy) >= is .AND. nbjdta(ib,igrd,ib_bdy) <= in ) THEN 764 835 ! 765 836 icount = icount + 1 … … 774 845 ! Allocate index arrays for this boundary set 775 846 !-------------------------------------------- 776 777 ilen1 = MAXVAL(idx_bdy(ib_bdy)%nblen(1:jpbgrd)) 778 ilen1 = MAX(1,ilen1) 847 ilen1 = MAXVAL(idx_bdy(ib_bdy)%nblen(:)) 779 848 ALLOCATE( idx_bdy(ib_bdy)%nbi(ilen1,jpbgrd) ) 780 849 ALLOCATE( idx_bdy(ib_bdy)%nbj(ilen1,jpbgrd) ) 781 850 ALLOCATE( idx_bdy(ib_bdy)%nbr(ilen1,jpbgrd) ) 782 851 ALLOCATE( idx_bdy(ib_bdy)%nbd(ilen1,jpbgrd) ) 852 ALLOCATE( idx_bdy(ib_bdy)%nbdout(ilen1,jpbgrd) ) 783 853 ALLOCATE( idx_bdy(ib_bdy)%nbmap(ilen1,jpbgrd) ) 784 854 ALLOCATE( idx_bdy(ib_bdy)%nbw(ilen1,jpbgrd) ) 785 ALLOCATE( idx_bdy(ib_bdy)%flagu(ilen1 ) )786 ALLOCATE( idx_bdy(ib_bdy)%flagv(ilen1 ) )855 ALLOCATE( idx_bdy(ib_bdy)%flagu(ilen1,jpbgrd) ) 856 ALLOCATE( idx_bdy(ib_bdy)%flagv(ilen1,jpbgrd) ) 787 857 788 858 ! Dispatch mapping indices and discrete distances on each processor … … 952 1022 ENDDO 953 1023 ENDDO 1024 954 1025 ! definition of the i- and j- direction local boundaries arrays 955 1026 ! used for sending the boudaries … … 1006 1077 idx_bdy(ib_bdy)%nbd(ib,igrd) = 1. / ( rn_time_dmp(ib_bdy) * rday ) & 1007 1078 & *(FLOAT(nn_rimwidth(ib_bdy)+1-nbr)/FLOAT(nn_rimwidth(ib_bdy)))**2. ! quadratic 1079 idx_bdy(ib_bdy)%nbdout(ib,igrd) = 1. / ( rn_time_dmp_out(ib_bdy) * rday ) & 1080 & *(FLOAT(nn_rimwidth(ib_bdy)+1-nbr)/FLOAT(nn_rimwidth(ib_bdy)))**2. ! quadratic 1008 1081 END DO 1009 1082 END DO … … 1019 1092 ! bdytmask = 1 on the computational domain AND on open boundaries 1020 1093 ! = 0 elsewhere 1021 bdytmask(:,:) = 1.e0 1022 bdyumask(:,:) = 1.e0 1023 bdyvmask(:,:) = 1.e0 1024 1094 1025 1095 IF( ln_mask_file ) THEN 1026 1096 CALL iom_open( cn_mask_file, inum ) … … 1110 1180 ENDDO 1111 1181 1182 ! For the flagu/flagv calculation below we require a version of fmask without 1183 ! the land boundary condition (shlat) included: 1184 CALL wrk_alloc(jpi,jpj,zfmask) 1185 DO ij = 2, jpjm1 1186 DO ii = 2, jpim1 1187 zfmask(ii,ij) = tmask(ii,ij ,1) * tmask(ii+1,ij ,1) & 1188 & * tmask(ii,ij+1,1) * tmask(ii+1,ij+1,1) 1189 END DO 1190 END DO 1191 1112 1192 ! Lateral boundary conditions 1193 CALL lbc_lnk( zfmask , 'F', 1. ) 1113 1194 CALL lbc_lnk( fmask , 'F', 1. ) ; CALL lbc_lnk( bdytmask(:,:), 'T', 1. ) 1114 1195 CALL lbc_lnk( bdyumask(:,:), 'U', 1. ) ; CALL lbc_lnk( bdyvmask(:,:), 'V', 1. ) … … 1116 1197 DO ib_bdy = 1, nb_bdy ! Indices and directions of rim velocity components 1117 1198 1118 idx_bdy(ib_bdy)%flagu(: ) = 0.e01119 idx_bdy(ib_bdy)%flagv(: ) = 0.e01199 idx_bdy(ib_bdy)%flagu(:,:) = 0.e0 1200 idx_bdy(ib_bdy)%flagv(:,:) = 0.e0 1120 1201 icount = 0 1121 1202 1122 !flagu = -1 : u component is normal to the dynamical boundary but its direction is outward 1123 !flagu = 0 : u is tangential 1124 !flagu = 1 : u is normal to the boundary and is direction is inward 1203 ! Calculate relationship of U direction to the local orientation of the boundary 1204 ! flagu = -1 : u component is normal to the dynamical boundary and its direction is outward 1205 ! flagu = 0 : u is tangential 1206 ! flagu = 1 : u is normal to the boundary and is direction is inward 1125 1207 1126 igrd = 2 ! u-component 1127 DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 1128 nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 1129 nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 1130 zefl = bdytmask(nbi ,nbj) 1131 zwfl = bdytmask(nbi+1,nbj) 1132 IF( zefl + zwfl == 2 ) THEN 1133 icount = icount + 1 1134 ELSE 1135 idx_bdy(ib_bdy)%flagu(ib)=-zefl+zwfl 1136 ENDIF 1208 DO igrd = 1,jpbgrd 1209 SELECT CASE( igrd ) 1210 CASE( 1 ) 1211 pmask => umask(:,:,1) 1212 i_offset = 0 1213 CASE( 2 ) 1214 pmask => bdytmask 1215 i_offset = 1 1216 CASE( 3 ) 1217 pmask => zfmask(:,:) 1218 i_offset = 0 1219 END SELECT 1220 icount = 0 1221 DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 1222 nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 1223 nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 1224 zefl = pmask(nbi+i_offset-1,nbj) 1225 zwfl = pmask(nbi+i_offset,nbj) 1226 ! This error check only works if you are using the bdyXmask arrays 1227 IF( i_offset == 1 .and. zefl + zwfl == 2 ) THEN 1228 icount = icount + 1 1229 IF(lwp) WRITE(numout,*) 'Problem with igrd = ',igrd,' at (global) nbi, nbj : ',mig(nbi),mjg(nbj) 1230 ELSE 1231 idx_bdy(ib_bdy)%flagu(ib,igrd) = -zefl + zwfl 1232 ENDIF 1233 END DO 1234 IF( icount /= 0 ) THEN 1235 IF(lwp) WRITE(numout,*) 1236 IF(lwp) WRITE(numout,*) ' E R R O R : Some ',cgrid(igrd),' grid points,', & 1237 ' are not boundary points (flagu calculation). Check nbi, nbj, indices for boundary set ',ib_bdy 1238 IF(lwp) WRITE(numout,*) ' ========== ' 1239 IF(lwp) WRITE(numout,*) 1240 nstop = nstop + 1 1241 ENDIF 1137 1242 END DO 1138 1243 1139 !flagv = -1 : u component is normal to the dynamical boundary but its direction is outward 1140 !flagv = 0 : u is tangential 1141 !flagv = 1 : u is normal to the boundary and is direction is inward 1142 1143 igrd = 3 ! v-component 1144 DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 1145 nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 1146 nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 1147 znfl = bdytmask(nbi,nbj ) 1148 zsfl = bdytmask(nbi,nbj+1) 1149 IF( znfl + zsfl == 2 ) THEN 1150 icount = icount + 1 1151 ELSE 1152 idx_bdy(ib_bdy)%flagv(ib) = -znfl + zsfl 1153 END IF 1244 ! Calculate relationship of V direction to the local orientation of the boundary 1245 ! flagv = -1 : v component is normal to the dynamical boundary but its direction is outward 1246 ! flagv = 0 : v is tangential 1247 ! flagv = 1 : v is normal to the boundary and is direction is inward 1248 1249 DO igrd = 1,jpbgrd 1250 SELECT CASE( igrd ) 1251 CASE( 1 ) 1252 pmask => vmask(:,:,1) 1253 j_offset = 0 1254 CASE( 2 ) 1255 pmask => zfmask(:,:) 1256 j_offset = 0 1257 CASE( 3 ) 1258 pmask => bdytmask 1259 j_offset = 1 1260 END SELECT 1261 icount = 0 1262 DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 1263 nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 1264 nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 1265 znfl = pmask(nbi,nbj+j_offset-1 ) 1266 zsfl = pmask(nbi,nbj+j_offset) 1267 ! This error check only works if you are using the bdyXmask arrays 1268 IF( j_offset == 1 .and. znfl + zsfl == 2 ) THEN 1269 IF(lwp) WRITE(numout,*) 'Problem with igrd = ',igrd,' at (global) nbi, nbj : ',mig(nbi),mjg(nbj) 1270 icount = icount + 1 1271 ELSE 1272 idx_bdy(ib_bdy)%flagv(ib,igrd) = -znfl + zsfl 1273 END IF 1274 END DO 1275 IF( icount /= 0 ) THEN 1276 IF(lwp) WRITE(numout,*) 1277 IF(lwp) WRITE(numout,*) ' E R R O R : Some ',cgrid(igrd),' grid points,', & 1278 ' are not boundary points (flagv calculation). Check nbi, nbj, indices for boundary set ',ib_bdy 1279 IF(lwp) WRITE(numout,*) ' ========== ' 1280 IF(lwp) WRITE(numout,*) 1281 nstop = nstop + 1 1282 ENDIF 1154 1283 END DO 1155 1284 1156 IF( icount /= 0 ) THEN 1157 IF(lwp) WRITE(numout,*) 1158 IF(lwp) WRITE(numout,*) ' E R R O R : Some data velocity points,', & 1159 ' are not boundary points. Check nbi, nbj, indices for boundary set ',ib_bdy 1160 IF(lwp) WRITE(numout,*) ' ========== ' 1161 IF(lwp) WRITE(numout,*) 1162 nstop = nstop + 1 1163 ENDIF 1164 1165 ENDDO 1285 END DO 1166 1286 1167 1287 ! Compute total lateral surface for volume correction: … … 1175 1295 nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 1176 1296 nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 1177 flagu => idx_bdy(ib_bdy)%flagu(ib )1297 flagu => idx_bdy(ib_bdy)%flagu(ib,igrd) 1178 1298 bdysurftot = bdysurftot + hu (nbi , nbj) & 1179 1299 & * e2u (nbi , nbj) * ABS( flagu ) & … … 1188 1308 nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 1189 1309 nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 1190 flagv => idx_bdy(ib_bdy)%flagv(ib )1310 flagv => idx_bdy(ib_bdy)%flagv(ib,igrd) 1191 1311 bdysurftot = bdysurftot + hv (nbi, nbj ) & 1192 1312 & * e1v (nbi, nbj ) * ABS( flagv ) & … … 1204 1324 DEALLOCATE(nbidta, nbjdta, nbrdta) 1205 1325 ENDIF 1326 1327 CALL wrk_dealloc(jpi,jpj,zfmask) 1206 1328 1207 1329 IF( nn_timing == 1 ) CALL timing_stop('bdy_init') … … 1598 1720 itest = 0 1599 1721 1600 IF ( nn_dyn2d(ib1)/=nn_dyn2d(ib2)) itest = itest + 11601 IF ( nn_dyn3d(ib1)/=nn_dyn3d(ib2)) itest = itest + 11602 IF ( nn_tra(ib1)/=nn_tra(ib2)) itest = itest + 11722 IF (cn_dyn2d(ib1)/=cn_dyn2d(ib2)) itest = itest + 1 1723 IF (cn_dyn3d(ib1)/=cn_dyn3d(ib2)) itest = itest + 1 1724 IF (cn_tra(ib1)/=cn_tra(ib2)) itest = itest + 1 1603 1725 ! 1604 1726 IF (nn_dyn2d_dta(ib1)/=nn_dyn2d_dta(ib2)) itest = itest + 1 -
branches/2013/dev_r3867_MERCATOR1_DYN/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90
r3970 r4223 132 132 ! JC: If FRS scheme is used, we assume that tidal is needed over the whole 133 133 ! relaxation area 134 IF( nn_dyn2d(ib_bdy) .eq. jp_frs) THEN134 IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN 135 135 ilen0(:)=nblen(:) 136 136 ELSE … … 414 414 415 415 ! line below should be simplified (runoff case) 416 IF (( nn_dyn2d_dta(ib_bdy) .ge. 2 ).AND.(nn_tra(ib_bdy).NE.4)) THEN 416 !! CHANUT: TO BE SORTED OUT 417 !! IF (( nn_dyn2d_dta(ib_bdy) .ge. 2 ).AND.(nn_tra(ib_bdy).NE.4)) THEN 418 IF ( nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN 417 419 418 420 nblen(1:jpbgrd) = idx_bdy(ib_bdy)%nblen(1:jpbgrd) 419 421 nblenrim(1:jpbgrd) = idx_bdy(ib_bdy)%nblenrim(1:jpbgrd) 420 422 421 IF( nn_dyn2d(ib_bdy) .eq. jp_frs) THEN423 IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN 422 424 ilen0(:)=nblen(:) 423 425 ELSE -
branches/2013/dev_r3867_MERCATOR1_DYN/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90
r3777 r4223 20 20 USE dom_oce ! ocean space and time domain variables 21 21 USE bdy_oce ! ocean open boundary conditions 22 USE bdylib ! for orlanski library routines 22 23 USE bdydta, ONLY: bf 23 24 USE lbclnk ! ocean lateral boundary conditions (or mpp link) … … 51 52 DO ib_bdy=1, nb_bdy 52 53 53 SELECT CASE( nn_tra(ib_bdy) )54 CASE( jp_none)54 SELECT CASE( cn_tra(ib_bdy) ) 55 CASE('none') 55 56 CYCLE 56 CASE( jp_frs)57 CASE('frs') 57 58 CALL bdy_tra_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 58 CASE( 2)59 CASE('specified') 59 60 CALL bdy_tra_spe( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 60 CASE( 3)61 CASE('neumann') 61 62 CALL bdy_tra_nmn( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 62 CASE(4) 63 CASE('orlanski') 64 CALL bdy_tra_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ll_npo=.false. ) 65 CASE('orlanski_npo') 66 CALL bdy_tra_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ll_npo=.true. ) 67 CASE('runoff') 63 68 CALL bdy_tra_rnf( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 64 69 CASE DEFAULT … … 196 201 ! 197 202 END SUBROUTINE bdy_tra_nmn 203 204 205 SUBROUTINE bdy_tra_orlanski( idx, dta, ll_npo ) 206 !!---------------------------------------------------------------------- 207 !! *** SUBROUTINE bdy_tra_orlanski *** 208 !! 209 !! - Apply Orlanski radiation to temperature and salinity. 210 !! - Wrapper routine for bdy_orlanski_3d 211 !! 212 !! 213 !! References: Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001) 214 !!---------------------------------------------------------------------- 215 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 216 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data 217 LOGICAL, INTENT(in) :: ll_npo ! switch for NPO version 218 219 INTEGER :: igrd ! grid index 220 !!---------------------------------------------------------------------- 221 222 IF( nn_timing == 1 ) CALL timing_start('bdy_tra_orlanski') 223 ! 224 igrd = 1 ! Orlanski bc on temperature; 225 ! 226 CALL bdy_orlanski_3d( idx, igrd, tsb(:,:,:,jp_tem), tsa(:,:,:,jp_tem), dta%tem, ll_npo ) 227 228 igrd = 1 ! Orlanski bc on salinity; 229 ! 230 CALL bdy_orlanski_3d( idx, igrd, tsb(:,:,:,jp_sal), tsa(:,:,:,jp_sal), dta%sal, ll_npo ) 231 ! 232 IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_orlanski') 233 ! 234 235 END SUBROUTINE bdy_tra_orlanski 236 198 237 199 238 SUBROUTINE bdy_tra_rnf( idx, dta, kt ) -
branches/2013/dev_r3867_MERCATOR1_DYN/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90
r3294 r4223 104 104 ii = idx%nbi(jb,jgrd) 105 105 ij = idx%nbj(jb,jgrd) 106 zubtpecor = zubtpecor + idx%flagu(jb ) * ua(ii,ij, jk) * e2u(ii,ij) * fse3u(ii,ij,jk)106 zubtpecor = zubtpecor + idx%flagu(jb,jgrd) * ua(ii,ij, jk) * e2u(ii,ij) * fse3u(ii,ij,jk) 107 107 END DO 108 108 END DO … … 112 112 ii = idx%nbi(jb,jgrd) 113 113 ij = idx%nbj(jb,jgrd) 114 zubtpecor = zubtpecor + idx%flagv(jb ) * va(ii,ij, jk) * e1v(ii,ij) * fse3v(ii,ij,jk)114 zubtpecor = zubtpecor + idx%flagv(jb,jgrd) * va(ii,ij, jk) * e1v(ii,ij) * fse3v(ii,ij,jk) 115 115 END DO 116 116 END DO … … 136 136 ii = idx%nbi(jb,jgrd) 137 137 ij = idx%nbj(jb,jgrd) 138 ua(ii,ij,jk) = ua(ii,ij,jk) - idx%flagu(jb ) * zubtpecor * umask(ii,ij,jk)139 ztranst = ztranst + idx%flagu(jb ) * ua(ii,ij,jk) * e2u(ii,ij) * fse3u(ii,ij,jk)138 ua(ii,ij,jk) = ua(ii,ij,jk) - idx%flagu(jb,jgrd) * zubtpecor * umask(ii,ij,jk) 139 ztranst = ztranst + idx%flagu(jb,jgrd) * ua(ii,ij,jk) * e2u(ii,ij) * fse3u(ii,ij,jk) 140 140 END DO 141 141 END DO … … 145 145 ii = idx%nbi(jb,jgrd) 146 146 ij = idx%nbj(jb,jgrd) 147 va(ii,ij,jk) = va(ii,ij,jk) -idx%flagv(jb ) * zubtpecor * vmask(ii,ij,jk)148 ztranst = ztranst + idx%flagv(jb ) * va(ii,ij,jk) * e1v(ii,ij) * fse3v(ii,ij,jk)147 va(ii,ij,jk) = va(ii,ij,jk) -idx%flagv(jb,jgrd) * zubtpecor * vmask(ii,ij,jk) 148 ztranst = ztranst + idx%flagv(jb,jgrd) * va(ii,ij,jk) * e1v(ii,ij) * fse3v(ii,ij,jk) 149 149 END DO 150 150 END DO -
branches/2013/dev_r3867_MERCATOR1_DYN/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
r3970 r4223 117 117 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: gphit, gphiu !: latitude of t-, u-, v- and f-points (degre) 118 118 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: gphiv, gphif !: 119 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e1t, e2t !: horizontal scale factors at t-point (m)120 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e1u, e2u !: horizontal scale factors at u-point (m)121 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e1v, e2v !: horizontal scale factors at v-point (m)122 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e1f, e2f !: horizontal scale factors at f-point (m)119 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1t, e2t !: horizontal scale factors at t-point (m) 120 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1u, e2u !: horizontal scale factors at u-point (m) 121 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1v, e2v !: horizontal scale factors at v-point (m) 122 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1f, e2f !: horizontal scale factors at f-point (m) 123 123 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e1e2t !: surface at t-point (m2) 124 124 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ff !: coriolis factor (2.*omega*sin(yphi) ) (s-1) … … 196 196 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: bmask !: land/ocean mask of barotropic stream function 197 197 198 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tmask, umask, vmask, fmask !: land/ocean mask at T-, U-, V- and F-pts198 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: tmask, umask, vmask, fmask !: land/ocean mask at T-, U-, V- and F-pts 199 199 200 200 REAL(wp), PUBLIC, DIMENSION(jpiglo) :: tpol, fpol !: north fold mask (jperio= 3 or 4) -
branches/2013/dev_r3867_MERCATOR1_DYN/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r4221 r4223 766 766 phur => hur_e 767 767 phvr => hvr_e 768 pu2d => ua_e 769 pv2d => va_e 768 pua2d => ua_e 769 pva2d => va_e 770 pub2d => zun_e 771 pvb2d => zvn_e 770 772 771 773 IF( lk_bdy ) CALL bdy_dyn2d( kt ) ! open boundaries
Note: See TracChangeset
for help on using the changeset viewer.