Changeset 32 for trunk/NEMO/OPA_SRC/OBC
- Timestamp:
- 2004-02-17T10:20:15+01:00 (20 years ago)
- Location:
- trunk/NEMO/OPA_SRC/OBC
- Files:
-
- 9 edited
-
obc_oce.F90 (modified) (2 diffs)
-
obc_par.F90 (modified) (3 diffs)
-
obcdom.F90 (modified) (3 diffs)
-
obcdyn.F90 (modified) (4 diffs)
-
obcrad.F90 (modified) (26 diffs)
-
obcrst.F90 (modified) (30 diffs)
-
obcspg.F90 (modified) (19 diffs)
-
obctra.F90 (modified) (7 diffs)
-
obcvol.F90 (modified) (10 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/OBC/obc_oce.F90
r3 r32 25 25 !!General variables for open boundaries: 26 26 !!-------------------------------------- 27 INTEGER :: & 28 numrob = 51 , & ! logical units for open boundary input restart files 29 numwob = 52 , & ! logical units for open boundary output restart files 30 ! 31 nbobc , & ! number of open boundaries ( 1=< nbobc =< 4 ) 32 nobc_dta , & ! = 0 use the initial state as obc data 33 ! ! = 1 read obc data in obcxxx.dta files 34 nmoisold , & ! number of the last read month on the OBC 35 nbef, naft ! index of the aftera and before fields on the OBC 36 37 REAL(wp) :: & !!! open boundary namelist (namobc) 38 rdpein = 1. , & ! damping time scale for inflow at East open boundary 39 rdpwin = 1. , & ! " " at West open boundary 40 rdpsin = 1. , & ! " " at South open boundary 41 rdpnin = 1. , & ! " " at North open boundary 42 rdpeob = 15. , & ! damping time scale for the climatology at East open boundary 43 rdpwob = 15. , & ! " " at West open boundary 44 rdpsob = 15. , & ! " " at South open boundary 45 rdpnob = 15. , & ! " " at North open boundary 46 volemp = 1. ! = 0 the total volume will have the variability of the 47 ! surface Flux E-P else (volemp = 1) the volume will be constant 48 ! = 1 the volume will be constant during all the integration. 49 50 LOGICAL :: & 51 lfbceast, lfbcwest, & ! logical flag for a fixed East and West open boundaries 52 lfbcnorth, lfbcsouth ! logical flag for a fixed North and South open boundaries 53 ! These logical flags are set to 'true' if damping time 54 ! scale are set to 0 in the namelist, for both inflow and outflow). 55 56 REAL(wp), DIMENSION(jpi,jpj) :: & 57 obctmsk ! mask array identical to tmask, execpt along OBC where it is set to 0 58 ! it used to calculate the cumulate flux E-P in the obcvol.F90 routine 27 INTEGER :: & !: * namelist ??? * 28 nbobc = 1 , & !: number of open boundaries ( 1=< nbobc =< 4 ) 29 nobc_dta = 0 , & !: = 0 use the initial state as obc data 30 ! ! = 1 read obc data in obcxxx.dta files 31 nmoisold , & !: number of the last read month on the OBC 32 nbef, naft !: index of the aftera and before fields on the OBC 33 34 REAL(wp) :: & !!: open boundary namelist (namobc) 35 rdpein = 1. , & !: damping time scale for inflow at East open boundary 36 rdpwin = 1. , & !: " " at West open boundary 37 rdpsin = 1. , & !: " " at South open boundary 38 rdpnin = 1. , & !: " " at North open boundary 39 rdpeob = 15. , & !: damping time scale for the climatology at East open boundary 40 rdpwob = 15. , & !: " " at West open boundary 41 rdpsob = 15. , & !: " " at South open boundary 42 rdpnob = 15. , & !: " " at North open boundary 43 volemp = 1. !: = 0 the total volume will have the variability of the 44 ! surface Flux E-P else (volemp = 1) the volume will be constant 45 ! = 1 the volume will be constant during all the integration. 46 47 LOGICAL :: & !: 48 lfbceast, lfbcwest, & !: logical flag for a fixed East and West open boundaries 49 lfbcnorth, lfbcsouth !: logical flag for a fixed North and South open boundaries 50 ! ! These logical flags are set to 'true' if damping time 51 ! ! scale are set to 0 in the namelist, for both inflow and outflow). 52 53 REAL(wp), DIMENSION(jpi,jpj) :: & !: 54 obctmsk !: mask array identical to tmask, execpt along OBC where it is set to 0 55 ! ! it used to calculate the cumulate flux E-P in the obcvol.F90 routine 59 56 60 !!---------------- ---------------------------------------------------------------------------57 !!---------------- 61 58 !! Rigid lid case: 62 59 !!---------------- 63 INTEGER :: nbic ! number of isolated coastlines ( 0 <= nbic <= 3 )60 INTEGER :: nbic !: number of isolated coastlines ( 0 <= nbic <= 3 ) 64 61 65 INTEGER, DIMENSION(jpnic,0:4,3) :: & 66 miic, mjic ! position of isolated coastlines points67 68 INTEGER, DIMENSION(0:4,3) :: & 69 mnic ! number of points on isolated coastlines70 71 REAL(wp), DIMENSION(jpi,jpj) :: & 72 gcbob ! right hand side of the barotropic elliptic equation associated73 !with the OBC62 INTEGER, DIMENSION(jpnic,0:4,3) :: & !: 63 miic, mjic !: position of isolated coastlines points 64 65 INTEGER, DIMENSION(0:4,3) :: & !: 66 mnic !: number of points on isolated coastlines 67 68 REAL(wp), DIMENSION(jpi,jpj) :: & !: 69 gcbob !: right hand side of the barotropic elliptic equation associated 70 ! ! with the OBC 74 71 75 REAL(wp), DIMENSION(jpi,jpj,3) :: & 76 gcfobc ! coef. associated with the contribution of isolated coastlines77 !to the right hand side of the barotropic elliptic equation78 79 REAL(wp), DIMENSION(3) :: & 80 gcbic ! time variation of the barotropic stream function along the81 !isolated coastlines82 83 REAL(wp), DIMENSION(1) :: & 84 bsfic0 ! barotropic stream function on isolated coastline72 REAL(wp), DIMENSION(jpi,jpj,3) :: & !: 73 gcfobc !: coef. associated with the contribution of isolated coastlines 74 ! ! to the right hand side of the barotropic elliptic equation 75 76 REAL(wp), DIMENSION(3) :: & !: 77 gcbic !: time variation of the barotropic stream function along the 78 ! ! isolated coastlines 79 80 REAL(wp), DIMENSION(1) :: & !: 81 bsfic0 !: barotropic stream function on isolated coastline 85 82 86 REAL(wp), DIMENSION(3) :: & 87 bsfic ! barotropic stream function on isolated coastline83 REAL(wp), DIMENSION(3) :: & !: 84 bsfic !: barotropic stream function on isolated coastline 88 85 89 !!-------------------- -----------------------------------------------------------------------86 !!-------------------- 90 87 !! East open boundary: 91 88 !!-------------------- 92 INTEGER :: nie0 , nie1 ! do loop index in mpp case for jpieob93 INTEGER :: nie0p1, nie1p1 ! do loop index in mpp case for jpieob+194 INTEGER :: nie0m1, nie1m1 ! do loop index in mpp case for jpieob-195 INTEGER :: nje0 , nje1 ! do loop index in mpp case for jpjed, jpjef96 INTEGER :: nje0p1, nje1m1 ! do loop index in mpp case for jpjedp1,jpjefm197 INTEGER :: nje1m2, nje0m1 ! do loop index in mpp case for jpjefm1-1,jpjed98 99 REAL(wp), DIMENSION(jpj) :: & 100 bsfeob ! now barotropic stream fuction computed at the OBC. The corres-101 102 103 REAL(wp), DIMENSION(jpj,3,3) :: & 104 bebnd ! east boundary barotropic streamfunction over 3 rows105 106 107 REAL(wp), DIMENSION(jpjed:jpjef) :: & 108 bfoe ! now climatology of the east boundary barotropic stream function89 INTEGER :: nie0 , nie1 !: do loop index in mpp case for jpieob 90 INTEGER :: nie0p1, nie1p1 !: do loop index in mpp case for jpieob+1 91 INTEGER :: nie0m1, nie1m1 !: do loop index in mpp case for jpieob-1 92 INTEGER :: nje0 , nje1 !: do loop index in mpp case for jpjed, jpjef 93 INTEGER :: nje0p1, nje1m1 !: do loop index in mpp case for jpjedp1,jpjefm1 94 INTEGER :: nje1m2, nje0m1 !: do loop index in mpp case for jpjefm1-1,jpjed 95 96 REAL(wp), DIMENSION(jpj) :: & !: 97 bsfeob !: now barotropic stream fuction computed at the OBC. The corres- 98 ! ! ponding bsfn will be computed by the forward time step in dynspg. 99 100 REAL(wp), DIMENSION(jpj,3,3) :: & !: 101 bebnd !: east boundary barotropic streamfunction over 3 rows 102 ! ! and 3 time step (now, before, and before before) 103 104 REAL(wp), DIMENSION(jpjed:jpjef) :: & !: 105 bfoe !: now climatology of the east boundary barotropic stream function 109 106 110 REAL(wp), DIMENSION(jpj,jpk) :: & 111 ufoe, vfoe, & ! now climatology of the east boundary velocities112 tfoe, sfoe, & ! now climatology of the east boundary temperature and salinity113 uclie ! baroclinic componant of the zonal velocity after radiation114 115 116 REAL(wp), DIMENSION(jpjglo,jpk,1) :: & 117 uedta, tedta, sedta ! array used for interpolating monthly data on the east boundary118 119 !!------------------------------- ------------------------------------------------------------107 REAL(wp), DIMENSION(jpj,jpk) :: & !: 108 ufoe, vfoe, & !: now climatology of the east boundary velocities 109 tfoe, sfoe, & !: now climatology of the east boundary temperature and salinity 110 uclie !: baroclinic componant of the zonal velocity after radiation 111 ! ! in the obcdyn.F90 routine 112 113 REAL(wp), DIMENSION(jpjglo,jpk,1) :: & !: 114 uedta, tedta, sedta !: array used for interpolating monthly data on the east boundary 115 116 !!------------------------------- 120 117 !! Arrays for radiative East OBC: 121 118 !!------------------------------- 122 !! 123 REAL(wp), DIMENSION(jpj,jpk,3,3) :: & 124 uebnd, vebnd ! baroclinic u & v component of the velocity over 3 rows 119 REAL(wp), DIMENSION(jpj,jpk,3,3) :: & !: 120 uebnd, vebnd !: baroclinic u & v component of the velocity over 3 rows 125 121 ! and 3 time step (now, before, and before before) 126 122 127 REAL(wp), DIMENSION(jpj,jpk,2,2) :: & 128 tebnd, sebnd ! East boundary temperature and salinity over 2 rows123 REAL(wp), DIMENSION(jpj,jpk,2,2) :: & !: 124 tebnd, sebnd !: East boundary temperature and salinity over 2 rows 129 125 ! and 2 time step (now and before) 130 126 131 REAL(wp), DIMENSION(jpj,jpk) :: & 132 u_cxebnd, v_cxebnd ! Zonal component of the phase speed ratio computed with127 REAL(wp), DIMENSION(jpj,jpk) :: & !: 128 u_cxebnd, v_cxebnd !: Zonal component of the phase speed ratio computed with 133 129 ! radiation of u and v velocity (respectively) at the 134 130 ! east open boundary (u_cxebnd = cx rdt ) 135 131 136 REAL(wp), DIMENSION(jpj,jpk) :: & 137 uemsk, vemsk, temsk ! 2D mask for the East OB132 REAL(wp), DIMENSION(jpj,jpk) :: & !: 133 uemsk, vemsk, temsk !: 2D mask for the East OB 138 134 139 135 ! Note that those arrays are optimized for mpp case 140 136 ! (hence the dimension jpj is the size of one processor subdomain) 141 137 142 !!-------------------------------------------------------------------------------------------143 !! West open boundary:144 138 !!-------------------- 145 INTEGER :: niw0 , niw1 ! do loop index in mpp case for jpiwob146 INTEGER :: niw0p1, niw1p1 ! do loop index in mpp case for jpiwob+1147 INTEGER :: n jw0 , njw1 ! do loop index in mpp case for jpjwd, jpjwf148 INTEGER :: n jw0p1, njw1m1 ! do loop index in mpp case for jpjwdp1,jpjwfm1149 INTEGER :: njw 1m2, njw0m1 ! do loop index in mpp case for jpjwfm2,jpjwd150 151 REAL(wp), DIMENSION(jpj) :: &152 bsfwob ! now barotropic stream fuction computed at the OBC. The corres- 153 ! ponding bsfn will be computed by the forward time step in dynspg.154 155 REAL(wp), DIMENSION(jpj,3,3) :: &156 bwbnd ! West boundary barotropic streamfunction over 157 ! 3 rows and 3 time step (now, before, and before before)158 159 REAL(wp), DIMENSION(jpjwd:jpjwf) :: &160 bfow ! now climatology of the west boundary barotropic stream function 161 162 REAL(wp), DIMENSION(jpj,jpk) :: &163 ufow, vfow, & ! now climatology of the west velocities 164 tfow, sfow, & ! now climatology of the west temperature and salinity165 u cliw ! baroclinic componant of the zonal velocity after the radiation166 ! in the obcdyn.F90 routine167 168 REAL(wp), DIMENSION(jpjglo,jpk,1) :: &169 uwdta, twdta, swdta ! array used for interpolating monthly data on the west boundary 170 171 !!-------------------------------------------------------------------------------------------172 !! Arrays for radiative West OBC: 139 !! West open boundary 140 !!-------------------- 141 INTEGER :: niw0 , niw1 !: do loop index in mpp case for jpiwob 142 INTEGER :: niw0p1, niw1p1 !: do loop index in mpp case for jpiwob+1 143 INTEGER :: njw0 , njw1 !: do loop index in mpp case for jpjwd, jpjwf 144 INTEGER :: njw0p1, njw1m1 !: do loop index in mpp case for jpjwdp1,jpjwfm1 145 INTEGER :: njw1m2, njw0m1 !: do loop index in mpp case for jpjwfm2,jpjwd 146 147 REAL(wp), DIMENSION(jpj) :: & !: 148 bsfwob !: now barotropic stream fuction computed at the OBC. The corres- 149 ! ! ponding bsfn will be computed by the forward time step in dynspg. 150 151 REAL(wp), DIMENSION(jpj,3,3) :: & !: 152 bwbnd !: West boundary barotropic streamfunction over 153 ! ! 3 rows and 3 time step (now, before, and before before) 154 155 REAL(wp), DIMENSION(jpjwd:jpjwf) :: & !: 156 bfow !: now climatology of the west boundary barotropic stream function 157 158 REAL(wp), DIMENSION(jpj,jpk) :: & !: 159 ufow, vfow, & !: now climatology of the west velocities 160 tfow, sfow, & !: now climatology of the west temperature and salinity 161 ucliw !: baroclinic componant of the zonal velocity after the radiation 162 ! ! in the obcdyn.F90 routine 163 164 REAL(wp), DIMENSION(jpjglo,jpk,1) :: & !: 165 uwdta, twdta, swdta !: array used for interpolating monthly data on the west boundary 166 173 167 !!------------------------------- 174 !! 175 REAL(wp), DIMENSION(jpj,jpk,3,3) :: & 176 uwbnd, vwbnd ! baroclinic u & v components of the velocity over 3 rows 177 ! and 3 time step (now, before, and before before) 178 179 REAL(wp), DIMENSION(jpj,jpk,2,2) :: & 180 twbnd, swbnd ! west boundary temperature and salinity over 2 rows and 181 ! 2 time step (now and before) 182 183 REAL(wp), DIMENSION(jpj,jpk) :: & 184 u_cxwbnd, v_cxwbnd ! Zonal component of the phase speed ratio computed with 185 ! radiation of zonal and meridional velocity (respectively) 186 ! at the west open boundary (u_cxwbnd = cx rdt ) 187 188 REAL(wp), DIMENSION(jpj,jpk) :: & 189 uwmsk, vwmsk, twmsk ! 2D mask for the West OB 168 !! Arrays for radiative West OBC 169 !!------------------------------- 170 REAL(wp), DIMENSION(jpj,jpk,3,3) :: & !: 171 uwbnd, vwbnd !: baroclinic u & v components of the velocity over 3 rows 172 ! ! and 3 time step (now, before, and before before) 173 174 REAL(wp), DIMENSION(jpj,jpk,2,2) :: & !: 175 twbnd, swbnd !: west boundary temperature and salinity over 2 rows and 176 ! ! 2 time step (now and before) 177 178 REAL(wp), DIMENSION(jpj,jpk) :: & !: 179 u_cxwbnd, v_cxwbnd !: Zonal component of the phase speed ratio computed with 180 ! ! radiation of zonal and meridional velocity (respectively) 181 ! ! at the west open boundary (u_cxwbnd = cx rdt ) 182 183 REAL(wp), DIMENSION(jpj,jpk) :: & !: 184 uwmsk, vwmsk, twmsk !: 2D mask for the West OB 190 185 191 186 ! Note that those arrays are optimized for mpp case 192 187 ! (hence the dimension jpj is the size of one processor subdomain) 193 188 194 !!-------------------------------------------------------------------------------------------195 !! North open boundary:196 189 !!--------------------- 197 INTEGER :: nin0 , nin1 ! do loop index in mpp case for jpind, jpinf 198 INTEGER :: nin0p1, nin1m1 ! do loop index in mpp case for jpindp1, jpinfm1 199 INTEGER :: nin1m2, nin0m1 ! do loop index in mpp case for jpinfm1-1,jpind 200 INTEGER :: njn0 , njn1 ! do loop index in mpp case for jpnob 201 INTEGER :: njn0p1, njn1p1 ! do loop index in mpp case for jpnob+1 202 INTEGER :: njn0m1, njn1m1 ! do loop index in mpp case for jpnob-1 203 204 REAL(wp), DIMENSION(jpi) :: & 205 bsfnob ! now barotropic stream fuction computed at the OBC. The corres- 206 ! ponding bsfn will be computed by the forward time step in dynspg. 207 208 REAL(wp), DIMENSION(jpi,3,3) :: & 209 bnbnd ! north boundary barotropic streamfunction over 210 ! 3 rows and 3 time step (now, before, and before before) 211 212 REAL(wp), DIMENSION(jpind:jpinf) :: & 213 bfon ! now climatology of the north boundary barotropic stream function 214 215 REAL(wp), DIMENSION(jpi,jpk) :: & 216 ufon, vfon, & ! now climatology of the north boundary velocities 217 tfon, sfon, & ! now climatology of the north boundary temperature and salinity 218 vclin ! baroclinic componant of the meridian velocity after the radiation 219 ! in yhe obcdyn.F90 routine 220 221 REAL(wp), DIMENSION(jpiglo,jpk,1) :: & 222 vndta, tndta, sndta ! array used for interpolating monthly data on the north boundary 223 224 !!------------------------------------------------------------------------------------------- 225 !! Arrays for radiative North OBC: 190 !! North open boundary 191 !!--------------------- 192 INTEGER :: nin0 , nin1 !: do loop index in mpp case for jpind, jpinf 193 INTEGER :: nin0p1, nin1m1 !: do loop index in mpp case for jpindp1, jpinfm1 194 INTEGER :: nin1m2, nin0m1 !: do loop index in mpp case for jpinfm1-1,jpind 195 INTEGER :: njn0 , njn1 !: do loop index in mpp case for jpnob 196 INTEGER :: njn0p1, njn1p1 !: do loop index in mpp case for jpnob+1 197 INTEGER :: njn0m1, njn1m1 !: do loop index in mpp case for jpnob-1 198 199 REAL(wp), DIMENSION(jpi) :: & !: 200 bsfnob !: now barotropic stream fuction computed at the OBC. The corres- 201 ! ! ponding bsfn will be computed by the forward time step in dynspg. 202 203 REAL(wp), DIMENSION(jpi,3,3) :: & !: 204 bnbnd !: north boundary barotropic streamfunction over 205 ! ! 3 rows and 3 time step (now, before, and before before) 206 207 REAL(wp), DIMENSION(jpind:jpinf) :: & !: 208 bfon !: now climatology of the north boundary barotropic stream function 209 210 REAL(wp), DIMENSION(jpi,jpk) :: & !: 211 ufon, vfon, & !: now climatology of the north boundary velocities 212 tfon, sfon, & !: now climatology of the north boundary temperature and salinity 213 vclin !: baroclinic componant of the meridian velocity after the radiation 214 ! ! in yhe obcdyn.F90 routine 215 216 REAL(wp), DIMENSION(jpiglo,jpk,1) :: & !: 217 vndta, tndta, sndta !: array used for interpolating monthly data on the north boundary 218 219 !!-------------------------------- 220 !! Arrays for radiative North OBC 226 221 !!-------------------------------- 227 222 !! 228 REAL(wp), DIMENSION(jpi,jpk,3,3) :: & 229 unbnd, vnbnd ! baroclinic u & v components of the velocity over 3230 !rows and 3 time step (now, before, and before before)231 232 REAL(wp), DIMENSION(jpi,jpk,2,2) :: & 233 tnbnd, snbnd ! north boundary temperature and salinity over234 !2 rows and 2 time step (now and before)235 236 REAL(wp), DIMENSION(jpi,jpk) :: & 237 u_cynbnd, v_cynbnd ! Meridional component of the phase speed ratio compu-238 !ted with radiation of zonal and meridional velocity239 !(respectively) at the north OB (u_cynbnd = cx rdt )240 241 REAL(wp), DIMENSION(jpi,jpk) :: & 242 unmsk, vnmsk, tnmsk ! 2D mask for the North OB223 REAL(wp), DIMENSION(jpi,jpk,3,3) :: & !: 224 unbnd, vnbnd !: baroclinic u & v components of the velocity over 3 225 ! ! rows and 3 time step (now, before, and before before) 226 227 REAL(wp), DIMENSION(jpi,jpk,2,2) :: & !: 228 tnbnd, snbnd !: north boundary temperature and salinity over 229 ! ! 2 rows and 2 time step (now and before) 230 231 REAL(wp), DIMENSION(jpi,jpk) :: & !: 232 u_cynbnd, v_cynbnd !: Meridional component of the phase speed ratio compu- 233 ! ! ted with radiation of zonal and meridional velocity 234 ! ! (respectively) at the north OB (u_cynbnd = cx rdt ) 235 236 REAL(wp), DIMENSION(jpi,jpk) :: & !: 237 unmsk, vnmsk, tnmsk !: 2D mask for the North OB 243 238 244 239 ! Note that those arrays are optimized for mpp case 245 240 ! (hence the dimension jpj is the size of one processor subdomain) 246 241 247 !!-------------------------------------------------------------------------------------------248 !! South open boundary:249 242 !!--------------------- 250 INTEGER :: nis0 , nis1 ! do loop index in mpp case for jpisd, jpisf 251 INTEGER :: nis0p1, nis1m1 ! do loop index in mpp case for jpisdp1, jpisfm1 252 INTEGER :: nis1m2, nis0m1 ! do loop index in mpp case for jpisfm1-1,jpisd 253 INTEGER :: njs0 , njs1 ! do loop index in mpp case for jpsob 254 INTEGER :: njs0p1, njs1p1 ! do loop index in mpp case for jpsob+1 255 256 REAL(wp), DIMENSION(jpi) :: & 257 bsfsob ! now barotropic stream fuction computed at the OBC.The corres- 258 ! ponding bsfn will be computed by the forward time step in dynspg. 259 REAL(wp), DIMENSION(jpi,3,3) :: & 260 bsbnd ! south boundary barotropic stream function over 261 ! 3 rows and 3 time step (now, before, and before before) 262 263 REAL(wp), DIMENSION(jpisd:jpisf) :: & 264 bfos ! now climatology of the south boundary barotropic stream function 265 266 REAL(wp), DIMENSION(jpi,jpk) :: & 267 ufos, vfos, & ! now climatology of the south boundary velocities 268 tfos, sfos, & ! now climatology of the south boundary temperature and salinity 269 vclis ! baroclinic componant of the meridian velocity after the radiation 270 ! in the obcdyn.F90 routine 271 272 REAL(wp), DIMENSION(jpiglo,jpk,1) :: & 273 vsdta, tsdta, ssdta ! array used for interpolating monthly data on the south boundary 274 275 !!------------------------------------------------------------------------------------------- 276 !! Arrays for radiative South OBC: 243 !! South open boundary 244 !!--------------------- 245 INTEGER :: nis0 , nis1 !: do loop index in mpp case for jpisd, jpisf 246 INTEGER :: nis0p1, nis1m1 !: do loop index in mpp case for jpisdp1, jpisfm1 247 INTEGER :: nis1m2, nis0m1 !: do loop index in mpp case for jpisfm1-1,jpisd 248 INTEGER :: njs0 , njs1 !: do loop index in mpp case for jpsob 249 INTEGER :: njs0p1, njs1p1 !: do loop index in mpp case for jpsob+1 250 251 REAL(wp), DIMENSION(jpi) :: & !: 252 bsfsob !: now barotropic stream fuction computed at the OBC.The corres- 253 ! ! ponding bsfn will be computed by the forward time step in dynspg. 254 REAL(wp), DIMENSION(jpi,3,3) :: & !: 255 bsbnd !: south boundary barotropic stream function over 256 ! ! 3 rows and 3 time step (now, before, and before before) 257 258 REAL(wp), DIMENSION(jpisd:jpisf) :: & !: 259 bfos !: now climatology of the south boundary barotropic stream function 260 261 REAL(wp), DIMENSION(jpi,jpk) :: & !: 262 ufos, vfos, & !: now climatology of the south boundary velocities 263 tfos, sfos, & !: now climatology of the south boundary temperature and salinity 264 vclis !: baroclinic componant of the meridian velocity after the radiation 265 ! ! in the obcdyn.F90 routine 266 267 REAL(wp), DIMENSION(jpiglo,jpk,1) :: & !: 268 vsdta, tsdta, ssdta !: array used for interpolating monthly data on the south boundary 269 270 !!-------------------------------- 271 !! Arrays for radiative South OBC 277 272 !!-------------------------------- 278 273 !! computed by the forward time step in dynspg. 279 REAL(wp), DIMENSION(jpi,jpk,3,3) :: & 280 usbnd, vsbnd ! baroclinic u & v components of the velocity over 3281 !rows and 3 time step (now, before, and before before)282 283 REAL(wp), DIMENSION(jpi,jpk,2,2) :: & 284 tsbnd, ssbnd ! south boundary temperature and salinity over285 !2 rows and 2 time step (now and before)286 287 REAL(wp), DIMENSION(jpi,jpk) :: & 288 u_cysbnd, v_cysbnd ! Meridional component of the phase speed ratio compu-289 !ted with radiation of zonal and meridional velocity290 !(repsectively) at the south OB (u_cynbnd = cx rdt )291 292 REAL(wp), DIMENSION(jpi,jpk) :: & 293 usmsk, vsmsk, tsmsk ! 2D mask for the South OB274 REAL(wp), DIMENSION(jpi,jpk,3,3) :: & !: 275 usbnd, vsbnd !: baroclinic u & v components of the velocity over 3 276 ! ! rows and 3 time step (now, before, and before before) 277 278 REAL(wp), DIMENSION(jpi,jpk,2,2) :: & !: 279 tsbnd, ssbnd !: south boundary temperature and salinity over 280 ! ! 2 rows and 2 time step (now and before) 281 282 REAL(wp), DIMENSION(jpi,jpk) :: & !: 283 u_cysbnd, v_cysbnd !: Meridional component of the phase speed ratio compu- 284 ! ! ted with radiation of zonal and meridional velocity 285 ! ! (repsectively) at the south OB (u_cynbnd = cx rdt ) 286 287 REAL(wp), DIMENSION(jpi,jpk) :: & !: 288 usmsk, vsmsk, tsmsk !: 2D mask for the South OB 294 289 295 290 ! Note that those arrays are optimized for mpp case … … 301 296 !!---------------------------------------------------------------------- 302 297 #endif 298 303 299 !!====================================================================== 304 300 END MODULE obc_oce -
trunk/NEMO/OPA_SRC/OBC/obc_par.F90
r3 r32 18 18 PUBLIC 19 19 20 LOGICAL, PUBLIC, PARAMETER :: lk_obc = .TRUE. ! Ocean Boundary Condition flag20 LOGICAL, PUBLIC, PARAMETER :: lk_obc = .TRUE. !: Ocean Boundary Condition flag 21 21 22 22 # if defined key_eel_r5 … … 31 31 !!--------------------------------------------------------------------- 32 32 !! * EAST open boundary 33 LOGICAL, PARAMETER :: & 34 lpeastobc = .FALSE. ! to active or not the East open boundary35 INTEGER, PARAMETER :: & 36 jpieob = jpiglo-2, & ! i-localization of the East open boundary (must be ocean U-point)37 jpjed = 2, & ! j-starting indice of the East open boundary (must be land T-point)38 jpjef = jpjglo-1, & ! j-ending indice of the East open boundary (must be land T-point)39 jpjedp1 = jpjed+1, & ! first ocean point " "40 jpjefm1 = jpjef-1 ! last ocean point " "33 LOGICAL, PARAMETER :: & !: 34 lpeastobc = .FALSE. !: to active or not the East open boundary 35 INTEGER, PARAMETER :: & !: 36 jpieob = jpiglo-2, & !: i-localization of the East open boundary (must be ocean U-point) 37 jpjed = 2, & !: j-starting indice of the East open boundary (must be land T-point) 38 jpjef = jpjglo-1, & !: j-ending indice of the East open boundary (must be land T-point) 39 jpjedp1 = jpjed+1, & !: first ocean point " " 40 jpjefm1 = jpjef-1 !: last ocean point " " 41 41 42 42 !! * WEST open boundary 43 LOGICAL, PARAMETER :: & 44 lpwestobc = .FALSE. ! to active or not the West open boundary45 INTEGER, PARAMETER :: & 46 jpiwob = 2, & ! i-localization of the West open boundary (must be ocean U-point)47 jpjwd = 2, & ! j-starting indice of the West open boundary (must be land T-point)48 jpjwf = jpjglo-1, & ! j-ending indice of the West open boundary (must be land T-point)49 jpjwdp1 = jpjwd+1, & ! first ocean point " "50 jpjwfm1 = jpjwf-1 ! last ocean point " "43 LOGICAL, PARAMETER :: & !: 44 lpwestobc = .FALSE. !: to active or not the West open boundary 45 INTEGER, PARAMETER :: & !: 46 jpiwob = 2, & !: i-localization of the West open boundary (must be ocean U-point) 47 jpjwd = 2, & !: j-starting indice of the West open boundary (must be land T-point) 48 jpjwf = jpjglo-1, & !: j-ending indice of the West open boundary (must be land T-point) 49 jpjwdp1 = jpjwd+1, & !: first ocean point " " 50 jpjwfm1 = jpjwf-1 !: last ocean point " " 51 51 52 52 !! * NORTH open boundary 53 LOGICAL, PARAMETER :: &54 lpnorthobc = .FALSE. ! to active or not the North open boundary55 INTEGER, PARAMETER :: & 56 jpjnob = jpjglo-2, & ! j-localization of the North open boundary (must be ocean V-point)57 jpind = 2, & ! i-starting indice of the North open boundary (must be land T-point)58 jpinf = jpiglo-1, & ! i-ending indice of the North open boundary (must be land T-point)59 jpindp1 = jpind+1, & ! first ocean point " "60 jpinfm1 = jpinf-1 ! last ocean point " "53 LOGICAL, PARAMETER :: & !: 54 lpnorthobc = .FALSE. !: to active or not the North open boundary 55 INTEGER, PARAMETER :: & !: 56 jpjnob = jpjglo-2, & !: j-localization of the North open boundary (must be ocean V-point) 57 jpind = 2, & !: i-starting indice of the North open boundary (must be land T-point) 58 jpinf = jpiglo-1, & !: i-ending indice of the North open boundary (must be land T-point) 59 jpindp1 = jpind+1, & !: first ocean point " " 60 jpinfm1 = jpinf-1 !: last ocean point " " 61 61 62 62 !! * SOUTH open boundary 63 LOGICAL, PARAMETER :: & 64 lpsouthobc = .FALSE. ! to active or not the South open boundary65 INTEGER, PARAMETER :: & 66 jpjsob = 2, & ! j-localization of the South open boundary (must be ocean V-point)67 jpisd = 2, & ! i-starting indice of the South open boundary (must be land T-point)68 jpisf = jpiglo-1, & ! i-ending indice of the South open boundary (must be land T-point)69 jpisdp1 = jpisd+1, & ! first ocean point " "70 jpisfm1 = jpisf-1 ! last ocean point " "63 LOGICAL, PARAMETER :: & !: 64 lpsouthobc = .FALSE. !: to active or not the South open boundary 65 INTEGER, PARAMETER :: & !: 66 jpjsob = 2, & !: j-localization of the South open boundary (must be ocean V-point) 67 jpisd = 2, & !: i-starting indice of the South open boundary (must be land T-point) 68 jpisf = jpiglo-1, & !: i-ending indice of the South open boundary (must be land T-point) 69 jpisdp1 = jpisd+1, & !: first ocean point " " 70 jpisfm1 = jpisf-1 !: last ocean point " " 71 71 72 INTEGER, PARAMETER :: & 73 jpnic = 2700 ! maximum number of isolated coastlines points72 INTEGER, PARAMETER :: & !: 73 jpnic = 2700 !: maximum number of isolated coastlines points 74 74 75 75 # endif … … 79 79 !! Default option : NO open boundary condition 80 80 !!---------------------------------------------------------------------- 81 LOGICAL, PUBLIC, PARAMETER :: lk_obc = .FALSE. ! Ocean Boundary Condition flag81 LOGICAL, PUBLIC, PARAMETER :: lk_obc = .FALSE. !: Ocean Boundary Condition flag 82 82 #endif 83 83 -
trunk/NEMO/OPA_SRC/OBC/obcdom.F90
r3 r32 13 13 USE phycst ! physical constants 14 14 USE obc_oce ! ocean open boundary conditions 15 USE in_out_manager ! I/O manager 16 USE lib_mpp ! distributed memory computing library 15 17 16 18 IMPLICIT NONE … … 154 156 ! in case of zoom, icoast must be set to 0 on the domain border 155 157 ! it must be the same for the bathymetry 156 IF (lzoom -w) icoast(jpiglo ,:) = 0157 IF (lzoom -e) icoast(jpiglo +jpizoom -1,:) = 0158 IF (lzoom -s) icoast(:,jpjzoom ) = 0159 IF (lzoom -n) icoast(:,jpjglo+jpjzoom -1 ) = 0158 IF (lzoom_w) icoast(jpiglo ,:) = 0 159 IF (lzoom_e) icoast(jpiglo +jpizoom -1,:) = 0 160 IF (lzoom_s) icoast(:,jpjzoom ) = 0 161 IF (lzoom_n) icoast(:,jpjglo+jpjzoom -1 ) = 0 160 162 161 163 DO jj = 1, jpjglo … … 179 181 END DO 180 182 END DO 181 # if defined key_mpp 182 CALL mpp_sum(icheck) 183 # endif 183 IF( lk_mpp ) CALL mpp_sum(icheck) ! sum over the global domain 184 184 185 IF( icheck /= 0 ) THEN 185 186 IF(lwp) WRITE(numout,cform_err) -
trunk/NEMO/OPA_SRC/OBC/obcdyn.F90
r3 r32 20 20 USE phycst ! physical constants 21 21 USE obc_oce ! ocean open boundary conditions 22 USE lbclnk ! ??? 22 23 USE lib_mpp ! ??? 23 24 USE obccli ! ocean open boundary conditions: climatology … … 125 126 END IF 126 127 127 # if defined key_mpp 128 !!bug ???129 IF( kt >= nit000+3 .AND. ln_rstart ) THEN130 CALL mpp_lnk_3d( ub, 'U', -1. )131 CALL mpp_lnk_3d( vb, 'V', -1. )132 END IF133 CALL mpp_lnk_3d( ua, 'U', -1. )134 CALL mpp_lnk_3d( va, 'V', -1. )135 # endif 128 IF( lk_mpp ) THEN 129 IF( kt >= nit000+3 .AND. ln_rstart ) THEN 130 CALL lbc_lnk( ub, 'U', -1. ) 131 CALL lbc_lnk( vb, 'V', -1. ) 132 END IF 133 CALL lbc_lnk( ua, 'U', -1. ) 134 CALL lbc_lnk( va, 'V', -1. ) 135 ENDIF 136 136 137 END SUBROUTINE obc_dyn 137 138 139 138 140 SUBROUTINE obc_dyn_east ( kt ) 139 141 !!------------------------------------------------------------------------------ 140 !! SUBROUTINE obc_dyn_east141 !! *************************142 !! *** SUBROUTINE obc_dyn_east *** 143 !! 142 144 !! ** Purpose : 143 145 !! Apply the radiation algorithm on east OBC velocities ua, va using the … … 157 159 !! * Local declaration 158 160 REAL(wp) :: z05cx, ztau, zin 159 160 !!------------------------------------------------------------------------------161 !! OPA 8.5, LODYC-IPSL (2002)162 161 !!------------------------------------------------------------------------------ 163 162 … … 484 483 !! * Local declaration 485 484 REAL(wp) :: z05cx, ztau, zin 486 487 !!------------------------------------------------------------------------------488 !! OPA 8.5, LODYC-IPSL (2002)489 485 !!------------------------------------------------------------------------------ 490 486 -
trunk/NEMO/OPA_SRC/OBC/obcrad.F90
r3 r32 71 71 !!---------------------------------------------------------------------- 72 72 73 ! 1. East open boundary 74 ! --------------------- 75 76 IF( lpeastobc .AND. ( .NOT. lfbceast ) ) THEN 77 CALL obc_rad_east( kt ) 78 END IF 79 80 ! 2. West open boundary 81 ! --------------------- 82 83 IF( lpwestobc .AND. ( .NOT. lfbcwest ) ) THEN 84 CALL obc_rad_west( kt ) 85 END IF 86 87 ! 3. North open boundary 88 ! --------------------- 89 90 IF( lpnorthobc .AND. ( .NOT. lfbcnorth ) ) THEN 91 CALL obc_rad_north( kt ) 92 END IF 93 94 ! 4. South open boundary 95 ! --------------------- 96 97 IF( lpsouthobc .AND. ( .NOT. lfbcsouth ) ) THEN 98 CALL obc_rad_south( kt ) 99 END IF 73 IF( lpeastobc .AND. .NOT.lfbceast ) CALL obc_rad_east ( kt ) ! East open boundary 74 75 IF( lpwestobc .AND. .NOT.lfbcwest ) CALL obc_rad_west ( kt ) ! West open boundary 76 77 IF( lpnorthobc .AND. .NOT.lfbcnorth ) CALL obc_rad_north( kt ) ! North open boundary 78 79 IF( lpsouthobc .AND. .NOT.lfbcsouth ) CALL obc_rad_south( kt ) ! South open boundary 100 80 101 81 END SUBROUTINE obc_rad 102 82 83 103 84 SUBROUTINE obc_rad_east ( kt ) 104 85 !!------------------------------------------------------------------------------ 105 !! SUBROUTINE obc_rad_east106 !! *************************86 !! *** SUBROUTINE obc_rad_east *** 87 !! 107 88 !! ** Purpose : 108 89 !! Perform swap of arrays to calculate radiative phase speeds at the open … … 121 102 122 103 !! * Local declarations 123 INTEGER :: ij, ii 124 104 INTEGER :: ij 125 105 REAL(wp) :: z05cx, zdt, z4nor2, z2dx, z2dy 126 106 REAL(wp) :: zucb, zucbm, zucbm2 127 128 !!------------------------------------------------------------------------------129 !! OPA 8.5, LODYC-IPSL (2002)130 107 !!------------------------------------------------------------------------------ 131 108 … … 178 155 END DO 179 156 END DO 180 # ifdef key_mpp 181 CALL mppobc(uebnd,jpjed,jpjef,jpieob,jpk*3*3,2,jpj) 182 # endif 157 IF( lk_mpp ) CALL mppobc(uebnd,jpjed,jpjef,jpieob,jpk*3*3,2,jpj) 158 183 159 ! ... extremeties nie0, nie1 184 160 ij = jpjed +1 - njmpp … … 221 197 END DO 222 198 END DO 223 # ifdef key_mpp 224 CALL mppobc(vebnd,jpjed,jpjef,jpieob+1,jpk*3*3,2,jpj) 225 # endif 199 IF( lk_mpp ) CALL mppobc(vebnd,jpjed,jpjef,jpieob+1,jpk*3*3,2,jpj) 200 226 201 !... extremeties nie0, nie1 227 202 ij = jpjed +1 - njmpp … … 263 238 END DO 264 239 END DO 265 # ifdef key_mpp 266 CALL mppobc(tebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj) 267 CALL mppobc(sebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj) 268 # endif 240 IF( lk_mpp ) CALL mppobc(tebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj) 241 IF( lk_mpp ) CALL mppobc(sebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj) 242 269 243 ! ... extremeties nie0, nie1 270 244 ij = jpjed +1 - njmpp … … 365 339 END DO 366 340 END DO 367 # if defined key_mpp 368 CALL mppobc(v_cxebnd,jpjed,jpjef,jpieob+1,jpk,2,jpj) 369 # endif 341 IF( lk_mpp ) CALL mppobc(v_cxebnd,jpjed,jpjef,jpieob+1,jpk,2,jpj) 342 370 343 ! ... extremeties nie0, nie1 371 344 ij = jpjed +1 - njmpp … … 386 359 END SUBROUTINE obc_rad_east 387 360 361 388 362 SUBROUTINE obc_rad_west ( kt ) 389 363 !!------------------------------------------------------------------------------ 390 !! SUBROUTINE obc_rad_west391 !! *************************364 !! *** SUBROUTINE obc_rad_west *** 365 !! 392 366 !! ** Purpose : 393 367 !! Perform swap of arrays to calculate radiative phase speeds at the open … … 406 380 407 381 !! * Local declarations 408 INTEGER :: ij, ii 409 382 INTEGER :: ij 410 383 REAL(wp) :: z05cx, zdt, z4nor2, z2dx, z2dy 411 384 REAL(wp) :: zucb, zucbm, zucbm2 412 413 !!------------------------------------------------------------------------------414 !! OPA 8.5, LODYC-IPSL (2002)415 385 !!------------------------------------------------------------------------------ 416 386 … … 465 435 END DO 466 436 END DO 467 # if defined key_mpp 468 CALL mppobc(uwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj) 469 # endif 437 IF( lk_mpp ) CALL mppobc(uwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj) 438 470 439 ! ... extremeties niw0, niw1 471 440 ij = jpjwd +1 - njmpp … … 508 477 END DO 509 478 END DO 510 # if defined key_mpp 511 CALL mppobc(vwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj) 512 # endif 479 IF( lk_mpp ) CALL mppobc(vwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj) 480 513 481 ! ... extremeties niw0, niw1 514 482 ij = jpjwd +1 - njmpp … … 550 518 END DO 551 519 END DO 552 # if defined key_mpp 553 CALL mppobc(twbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj) 554 CALL mppobc(swbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj) 555 # endif 520 IF( lk_mpp ) CALL mppobc(twbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj) 521 IF( lk_mpp ) CALL mppobc(swbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj) 522 556 523 ! ... extremeties niw0, niw1 557 524 ij = jpjwd +1 - njmpp … … 655 622 END DO 656 623 END DO 657 # if defined key_mpp 658 CALL mppobc(v_cxwbnd,jpjwd,jpjwf,jpiwob,jpk,2,jpj) 659 # endif 624 IF( lk_mpp ) CALL mppobc(v_cxwbnd,jpjwd,jpjwf,jpiwob,jpk,2,jpj) 625 660 626 ! ... extremeties niw0, niw1 661 627 ij = jpjwd +1 - njmpp … … 676 642 END SUBROUTINE obc_rad_west 677 643 644 678 645 SUBROUTINE obc_rad_north ( kt ) 679 646 !!------------------------------------------------------------------------------ 680 !! SUBROUTINE obc_rad_north681 !! *************************647 !! *** SUBROUTINE obc_rad_north *** 648 !! 682 649 !! ** Purpose : 683 650 !! Perform swap of arrays to calculate radiative phase speeds at the open … … 696 663 697 664 !! * Local declarations 698 INTEGER :: ij, ii 699 665 INTEGER :: ii 700 666 REAL(wp) :: z05cx, zdt, z4nor2, z2dx, z2dy 701 667 REAL(wp) :: zvcb, zvcbm, zvcbm2 702 703 !!------------------------------------------------------------------------------704 !! OPA 8.5, LODYC-IPSL (2002)705 668 !!------------------------------------------------------------------------------ 706 669 … … 736 699 END DO 737 700 END DO 738 # if defined key_mpp 739 CALL mppobc(unbnd,jpind,jpinf,jpjnob+1,jpk*3*3,1,jpi) 740 # endif 701 IF( lk_mpp ) CALL mppobc(unbnd,jpind,jpinf,jpjnob+1,jpk*3*3,1,jpi) 702 741 703 ! ... extremeties njn0,njn1 742 704 ii = jpind + 1 - nimpp … … 798 760 END DO 799 761 END DO 800 # if defined key_mpp 801 CALL mppobc(vnbnd,jpind,jpinf,jpjnob,jpk*3*3,1,jpi) 802 # endif 762 IF( lk_mpp ) CALL mppobc(vnbnd,jpind,jpinf,jpjnob,jpk*3*3,1,jpi) 763 803 764 ! ... extremeties njn0,njn1 804 765 ii = jpind + 1 - nimpp … … 840 801 END DO 841 802 END DO 842 # if defined key_mpp 843 CALL mppobc(tnbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi) 844 CALL mppobc(snbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi) 845 # endif 803 IF( lk_mpp ) CALL mppobc(tnbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi) 804 IF( lk_mpp ) CALL mppobc(snbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi) 805 846 806 ! ... extremeties njn0,njn1 847 807 ii = jpind + 1 - nimpp … … 908 868 END DO 909 869 END DO 910 # if defined key_mpp 911 CALL mppobc(u_cynbnd,jpind,jpinf,jpjnob+1,jpk,1,jpi) 912 # endif 870 IF( lk_mpp ) CALL mppobc(u_cynbnd,jpind,jpinf,jpjnob+1,jpk,1,jpi) 871 913 872 ! ... extremeties njn0,njn1 914 873 ii = jpind + 1 - nimpp … … 973 932 END SUBROUTINE obc_rad_north 974 933 934 975 935 SUBROUTINE obc_rad_south ( kt ) 976 936 !!------------------------------------------------------------------------------ 977 !! SUBROUTINE obc_rad_south978 !! *************************937 !! *** SUBROUTINE obc_rad_south *** 938 !! 979 939 !! ** Purpose : 980 940 !! Perform swap of arrays to calculate radiative phase speeds at the open … … 993 953 994 954 !! * Local declarations 995 INTEGER :: ij, ii 996 955 INTEGER :: ii 997 956 REAL(wp) :: z05cx, zdt, z4nor2, z2dx, z2dy 998 957 REAL(wp) :: zvcb, zvcbm, zvcbm2 999 1000 !!------------------------------------------------------------------------------1001 !! OPA 8.5, LODYC-IPSL (2002)1002 958 !!------------------------------------------------------------------------------ 1003 959 … … 1033 989 END DO 1034 990 END DO 1035 # if defined key_mpp 1036 CALL mppobc(usbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi) 1037 # endif 991 IF( lk_mpp ) CALL mppobc(usbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi) 992 1038 993 ! ... extremeties njs0,njs1 1039 994 ii = jpisd + 1 - nimpp … … 1093 1048 END DO 1094 1049 END DO 1095 # if defined key_mpp 1096 CALL mppobc(vsbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi) 1097 # endif 1050 IF( lk_mpp ) CALL mppobc(vsbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi) 1051 1098 1052 ! ... extremeties njs0,njs1 1099 1053 ii = jpisd + 1 - nimpp … … 1135 1089 END DO 1136 1090 END DO 1137 # if defined key_mpp 1138 CALL mppobc(tsbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi) 1139 CALL mppobc(ssbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi) 1140 # endif 1091 IF( lk_mpp ) CALL mppobc(tsbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi) 1092 IF( lk_mpp ) CALL mppobc(ssbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi) 1093 1141 1094 ! ... extremeties njs0,njs1 1142 1095 ii = jpisd + 1 - nimpp … … 1203 1156 END DO 1204 1157 END DO 1205 # if defined key_mpp 1206 CALL mppobc(u_cysbnd,jpisd,jpisf,jpjsob,jpk,1,jpi) 1207 # endif 1158 IF( lk_mpp ) CALL mppobc(u_cysbnd,jpisd,jpisf,jpjsob,jpk,1,jpi) 1159 1208 1160 ! ... extremeties njs0,njs1 1209 1161 ii = jpisd + 1 - nimpp … … 1263 1215 END DO 1264 1216 1265 END 1217 ENDIF 1266 1218 1267 1219 END SUBROUTINE obc_rad_south 1220 1268 1221 #else 1269 1222 !!================================================================================= … … 1274 1227 SUBROUTINE obc_rad( kt ) ! No open boundaries ==> empty routine 1275 1228 INTEGER, INTENT(in) :: kt 1276 WRITE(*,*) kt1229 WRITE(*,*) 'obc_rad: You should not have seen this print! error?', kt 1277 1230 END SUBROUTINE obc_rad 1278 1231 #endif -
trunk/NEMO/OPA_SRC/OBC/obcrst.F90
r3 r32 25 25 26 26 !!--------------------------------------------------------------------------------- 27 !! OPA 9.0 , LODYC-IPSL (2003) 28 !!--------------------------------------------------------------------------------- 27 29 28 30 CONTAINS … … 30 32 SUBROUTINE obc_rst_wri ( kt ) 31 33 !!-------------------------------------------------------------------------------- 32 !! SUBROUTINE obc_rst_wri 33 !! ************************ 34 !! ** Purpose : 35 !! Write restart fields in numwob for open boundaries 34 !! *** SUBROUTINE obc_rst_wri *** 35 !! 36 !! ** Purpose : Write open boundary restart fields in restart.obc.output file 36 37 !! 37 !! ** Method : 38 !! numwob file: Direct access non formatted file. 38 !! ** Method : restart.obc.output file: Direct access non formatted file. 39 39 !! Each nstock time step , save fields which are necessary for restart. 40 40 !! - This routine is called if at least the key_obc is defined. It is called … … 58 58 !! 8.5 ! 02-10 (C. Talandier, A-M. Treguier) F90 59 59 !! ! 03-06 (J.M. Molines) Bug fix for adjacent processors 60 !! 9.0 ! 04-02 (G. Madec) suppression of numwob, use inum 60 61 !!----------------------------------------------------------------------------------- 61 62 !! * Arguments … … 64 65 !! * Local declarations 65 66 INTEGER :: ji, jj, jk, ios 67 INTEGER :: inum = 11 ! temporary logical unit 66 68 INTEGER :: ibloc, nreclo, jrec, jt, jb 67 69 INTEGER :: jfoe, jfow, ifon, ifos 68 70 INTEGER :: ino0, it0 69 71 !!----------------------------------------------------------------------------- 70 !! OPA 8.5, LODYC-IPSL (2002) 71 !!----------------------------------------------------------------------------- 72 73 ! 1. Output of restart fields (numwob) 72 73 ! 1. Output of restart fields (inum) 74 74 ! ------------------------------------ 75 75 … … 82 82 WRITE(numout,*) 'obcrst: OBC output for restart with obc_rst_wri routine' 83 83 WRITE(numout,*) '~~~~~~' 84 WRITE(numout,*) ' output done in numwob = ', numwob,' at it= ',kt, & 85 ' date= ',ndastp 84 WRITE(numout,*) ' output done in restart.obc.output file at it= ', kt, ' date= ', ndastp 86 85 END IF 87 86 … … 95 94 ! 1.1 Open file 96 95 ! ------------- 97 OPEN( UNIT = numwob,&96 OPEN( UNIT = inum, & 98 97 IOSTAT = ios, & 99 98 FILE = 'restart.obc.output', & … … 110 109 ! 1.2 Write header 111 110 ! ---------------- 112 WRITE ( numwob,REC=1) ino0,it0,nbobc,jpieob,jpiwob,jpjnob,jpjsob, &111 WRITE (inum,REC=1) ino0,it0,nbobc,jpieob,jpiwob,jpjnob,jpjsob, & 113 112 jpjed,jpjef,jpjwd,jpjwf,jpind,jpinf,jpisd,jpisf 114 113 … … 128 127 jfoe = jpjed - njmpp + 1 129 128 PRINT *,'Narea =',narea,' write jrec =2 east' 130 WRITE( numwob,REC=jrec) &129 WRITE(inum,REC=jrec) & 131 130 # if ! defined key_dynspg_fsc 132 131 (( bebnd(jfoe, jb,jt), jb=1,3),jt=1,3), & … … 143 142 jfoe = jj 144 143 jrec = 2 + jj + njmpp -1 -jpjed 145 WRITE ( numwob,REC=jrec) &144 WRITE (inum,REC=jrec) & 146 145 # if ! defined key_dynspg_fsc 147 146 (( bebnd(jfoe, jb,jt), jb=1,3),jt=1,3), & … … 173 172 jfow = jpjwd -njmpp + 1 174 173 PRINT *,'Narea =',narea,' write jrec =',jrec,' west' 175 WRITE ( numwob,REC=jrec) &174 WRITE (inum,REC=jrec) & 176 175 # if ! defined key_dynspg_fsc 177 176 (( bwbnd(jfow, jb,jt), jb=1,3),jt=1,3), & … … 188 187 jfow = jj 189 188 jrec = 3 + jpjef -jpjed + jj + njmpp -1 -jpjwd 190 WRITE ( numwob,REC=jrec) &189 WRITE (inum,REC=jrec) & 191 190 # if ! defined key_dynspg_fsc 192 191 (( bwbnd(jfow, jb,jt), jb=1,3),jt=1,3), & … … 217 216 ! ifon = jpind 218 217 ifon = jpind -nimpp +1 219 WRITE ( numwob,REC=jrec) &218 WRITE (inum,REC=jrec) & 220 219 # if ! defined key_dynspg_fsc 221 220 (( bnbnd(ifon, jb,jt), jb=1,3),jt=1,3), & … … 232 231 ifon = ji 233 232 jrec = 4 + jpjef -jpjed + jpjwf -jpjwd +ji + nimpp -1 -jpind 234 WRITE ( numwob,REC=jrec) &233 WRITE (inum,REC=jrec) & 235 234 # if ! defined key_dynspg_fsc 236 235 (( bnbnd(ifon, jb,jt), jb=1,3),jt=1,3), & … … 262 261 ! ifos = jpisd 263 262 ifos = jpisd -nimpp + 1 264 WRITE ( numwob,REC=jrec) &263 WRITE (inum,REC=jrec) & 265 264 # if ! defined key_dynspg_fsc 266 265 (( bsbnd(ifos, jb,jt), jb=1,3),jt=1,3), & … … 278 277 jrec = 5 + jpjef -jpjed + jpjwf -jpjwd +jpinf -jpind + & 279 278 ji + nimpp -1 -jpisd 280 WRITE ( numwob,REC=jrec) &279 WRITE (inum,REC=jrec) & 281 280 # if ! defined key_dynspg_fsc 282 281 (( bsbnd(ifos, jb,jt), jb=1,3),jt=1,3), & … … 292 291 END IF 293 292 END IF 294 CLOSE( numwob)293 CLOSE(inum) 295 294 296 295 END SUBROUTINE obc_rst_wri 296 297 297 298 298 SUBROUTINE obc_rst_lec 299 299 !!---------------------------------------------------------------------------- 300 !! SUBROUTINE obc_rst_lec 301 !! ************************ 302 !! ** Purpose : 303 !! Read files for restart at open boundaries 300 !! *** SUBROUTINE obc_rst_lec *** 301 !! 302 !! ** Purpose : Read files for restart at open boundaries 304 303 !! 305 !! ** Method : 306 !! Read the previous boundary arrays on unit numrob 304 !! ** Method : Read the previous boundary arrays on unit inum 307 305 !! The first record indicates previous characterics 308 306 !! … … 312 310 !!---------------------------------------------------------------------------- 313 311 !! * Local declarations 312 INTEGER :: inum = 11 ! temporary logical unit 314 313 INTEGER :: ji,jj,jk,ios 315 314 INTEGER :: ino0,it0,nbobc0,jpieob0,jpiwob0,jpjnob0,jpjsob0 … … 320 319 INTEGER :: jfoe, jfow, ifon, ifos 321 320 !!----------------------------------------------------------------------------- 322 !! OPA 8.5, LODYC-IPSL (2002)323 !!-----------------------------------------------------------------------------324 321 325 322 ! 0. Initialisations … … 358 355 ! 0.1 Open files 359 356 ! --------------- 360 OPEN( UNIT = numrob, &357 OPEN( UNIT = inum, & 361 358 IOSTAT = ios, & 362 359 FILE = 'restart.obc', & … … 374 371 ! 1.1 First record 375 372 ! ----------------- 376 READ( numrob,REC=1) ino1,it1,nbobc1,jpieob1,jpiwob1,jpjnob1, &373 READ(inum,REC=1) ino1,it1,nbobc1,jpieob1,jpiwob1,jpjnob1, & 377 374 jpjsob1,ied1,ief1,iwd1,iwf1,ind1,inf1,isd1,isf1 378 375 379 376 IF(lwp) THEN 380 377 WRITE(numout,*) ' ' 381 WRITE(numout,*) ' READ numrobwith number job : ',ino1,' with the time it: ',it1378 WRITE(numout,*) ' READ inum with number job : ',ino1,' with the time it: ',it1 382 379 WRITE(numout,*) ' ' 383 380 END IF … … 520 517 ! jfoe = jpjed 521 518 jfoe = jpjed -njmpp + 1 522 READ ( numrob,REC=jrec) &519 READ (inum,REC=jrec) & 523 520 # if ! defined key_dynspg_fsc 524 521 (( bebnd(jfoe, jb,jt), jb=1,3),jt=1,3), & … … 535 532 jfoe = jj 536 533 jrec = 2 + jj + njmpp -1 -jpjed 537 READ ( numrob,REC=jrec) &534 READ (inum,REC=jrec) & 538 535 # if ! defined key_dynspg_fsc 539 536 (( bebnd(jfoe, jb,jt), jb=1,3),jt=1,3), & … … 562 559 ! jfow = jpjwd 563 560 jfow = jpjwd -njmpp + 1 564 READ ( numrob,REC=jrec) &561 READ (inum,REC=jrec) & 565 562 # if ! defined key_dynspg_fsc 566 563 (( bwbnd(jfow, jb,jt), jb=1,3),jt=1,3), & … … 577 574 jfow = jj 578 575 jrec = 3 + jpjef -jpjed + jj + njmpp -1 -jpjwd 579 READ ( numrob,REC=jrec) &576 READ (inum,REC=jrec) & 580 577 # if ! defined key_dynspg_fsc 581 578 (( bwbnd(jfow, jb,jt), jb=1,3),jt=1,3), & … … 604 601 ! ifon = jpind 605 602 ifon = jpind -nimpp +1 606 READ ( numrob,REC=jrec) &603 READ (inum,REC=jrec) & 607 604 # if ! defined key_dynspg_fsc 608 605 (( bnbnd(ifon, jb,jt), jb=1,3),jt=1,3), & … … 619 616 ifon = ji 620 617 jrec = 4 + jpjef -jpjed + jpjwf -jpjwd +ji + nimpp -1 -jpind 621 READ ( numrob,REC=jrec) &618 READ (inum,REC=jrec) & 622 619 # if ! defined key_dynspg_fsc 623 620 (( bnbnd(ifon, jb,jt), jb=1,3),jt=1,3), & … … 646 643 ! ifos = jpisd 647 644 ifos = jpisd -nimpp + 1 648 READ ( numrob,REC=jrec) &645 READ (inum,REC=jrec) & 649 646 # if ! defined key_dynspg_fsc 650 647 (( bsbnd(ifos, jb,jt), jb=1,3),jt=1,3), & … … 662 659 jrec = 5 + jpjef -jpjed + jpjwf -jpjwd +jpinf -jpind + & 663 660 ji + nimpp -1 -jpisd 664 READ ( numrob,REC=jrec) &661 READ (inum,REC=jrec) & 665 662 # if ! defined key_dynspg_fsc 666 663 (( bsbnd(ifos, jb,jt), jb=1,3),jt=1,3), & … … 677 674 678 675 END IF 679 CLOSE(numrob) 680 681 # if defined key_mpp 682 IF( lpeastobc ) THEN 683 CALL mppobc(bebnd,jpjed,jpjef,jpieob,3*3,2,jpj) 684 CALL mppobc(uebnd,jpjed,jpjef,jpieob,jpk*3*3,2,jpj) 685 CALL mppobc(vebnd,jpjed,jpjef,jpieob+1,jpk*3*3,2,jpj) 686 CALL mppobc(tebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj) 687 CALL mppobc(sebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj) 688 END IF 689 IF( lpwestobc ) THEN 690 CALL mppobc(bwbnd,jpjwd,jpjwf,jpiwob,3*3,2,jpj) 691 CALL mppobc(uwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj) 692 CALL mppobc(vwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj) 693 CALL mppobc(twbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj) 694 CALL mppobc(swbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj) 695 END IF 696 IF( lpnorthobc ) THEN 697 CALL mppobc(bnbnd,jpind,jpinf,jpjnob ,3*3 ,1,jpi) 698 CALL mppobc(unbnd,jpind,jpinf,jpjnob+1,jpk*3*3,1,jpi) 699 CALL mppobc(vnbnd,jpind,jpinf,jpjnob ,jpk*3*3,1,jpi) 700 CALL mppobc(tnbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi) 701 CALL mppobc(snbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi) 702 END IF 703 IF( lpsouthobc ) THEN 704 CALL mppobc(bsbnd,jpisd,jpisf,jpjsob, 3*3,1,jpi) 705 CALL mppobc(usbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi) 706 CALL mppobc(vsbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi) 707 CALL mppobc(tsbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi) 708 CALL mppobc(ssbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi) 709 END IF 710 # endif 676 CLOSE(inum) 677 678 IF( lk_mpp ) THEN 679 IF( lpeastobc ) THEN 680 # if ! defined key_dynspg_fsc 681 CALL mppobc(bebnd,jpjed,jpjef,jpieob,3*3,2,jpj) 682 # endif 683 CALL mppobc(uebnd,jpjed,jpjef,jpieob,jpk*3*3,2,jpj) 684 CALL mppobc(vebnd,jpjed,jpjef,jpieob+1,jpk*3*3,2,jpj) 685 CALL mppobc(tebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj) 686 CALL mppobc(sebnd,jpjed,jpjef,jpieob+1,jpk*2*2,2,jpj) 687 ENDIF 688 IF( lpwestobc ) THEN 689 # if ! defined key_dynspg_fsc 690 CALL mppobc(bwbnd,jpjwd,jpjwf,jpiwob,3*3,2,jpj) 691 # endif 692 CALL mppobc(uwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj) 693 CALL mppobc(vwbnd,jpjwd,jpjwf,jpiwob,jpk*3*3,2,jpj) 694 CALL mppobc(twbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj) 695 CALL mppobc(swbnd,jpjwd,jpjwf,jpiwob,jpk*2*2,2,jpj) 696 ENDIF 697 IF( lpnorthobc ) THEN 698 # if ! defined key_dynspg_fsc 699 CALL mppobc(bnbnd,jpind,jpinf,jpjnob ,3*3 ,1,jpi) 700 # endif 701 CALL mppobc(unbnd,jpind,jpinf,jpjnob+1,jpk*3*3,1,jpi) 702 CALL mppobc(vnbnd,jpind,jpinf,jpjnob ,jpk*3*3,1,jpi) 703 CALL mppobc(tnbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi) 704 CALL mppobc(snbnd,jpind,jpinf,jpjnob+1,jpk*2*2,1,jpi) 705 ENDIF 706 IF( lpsouthobc ) THEN 707 # if ! defined key_dynspg_fsc 708 CALL mppobc(bsbnd,jpisd,jpisf,jpjsob, 3*3,1,jpi) 709 # endif 710 CALL mppobc(usbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi) 711 CALL mppobc(vsbnd,jpisd,jpisf,jpjsob,jpk*3*3,1,jpi) 712 CALL mppobc(tsbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi) 713 CALL mppobc(ssbnd,jpisd,jpisf,jpjsob,jpk*2*2,1,jpi) 714 ENDIF 715 ENDIF 711 716 712 717 END SUBROUTINE obc_rst_lec … … 719 724 SUBROUTINE obc_rst_wri( kt ) ! No Open boundary ==> empty routine 720 725 INTEGER,INTENT(in) :: kt 721 WRITE(*,*) kt726 WRITE(*,*) 'obc_rst_wri: You should not have seen this print! error?', kt 722 727 END SUBROUTINE obc_rst_wri 723 728 SUBROUTINE obc_rst_lec ! No Open boundary ==> empty routine -
trunk/NEMO/OPA_SRC/OBC/obcspg.F90
r3 r32 5 5 !! open boundary 6 6 !!====================================================================== 7 #if defined key_obc &&defined key_dynspg_rl7 #if defined key_obc && defined key_dynspg_rl 8 8 !!---------------------------------------------------------------------- 9 9 !! 'key_obc' and Open Boundary Condition … … 86 86 !!---------------------------------------------------------------------- 87 87 88 ! 0. Local constant initialization 89 ! -------------------------------- 90 91 IF( kt == nit000 .OR. ln_rstart ) THEN 88 IF( kt == nit000 .OR. ln_rstart ) THEN ! Initialization 92 89 ! ... Boundary restoring coefficient 93 90 rtaue = 2. * rdt / rdpeob … … 100 97 rtaunin = 2. * rdt / rdpnin 101 98 rtausin = 2. * rdt / rdpsin 102 END IF 103 104 ! ... right hand side of the barotropic elliptic equation 99 ENDIF 100 101 ! right hand side of the barotropic elliptic equation 102 ! --------------------------------------------------- 103 104 ! Isolated coastline contribution to the RHS of the barotropic Eq. 105 105 gcbob(:,:) = 0.e0 106 107 ! 1. Isolated coastline contribution to the RHS of the barotropic Eq.108 ! -------------------------------------------------------------------109 106 DO jnic = 1, nbobc-1 110 DO jj = 1, jpj 111 DO ji = 1, jpi 112 gcbob(ji,jj) = gcbob(ji,jj) + gcfobc(ji,jj,jnic) * gcbic(jnic) 113 END DO 114 END DO 107 gcbob(:,:) = gcbob(:,:) + gcfobc(:,:,jnic) * gcbic(jnic) 115 108 END DO 116 109 117 ! 2. East open boundary 118 ! --------------------- 119 120 IF( lpeastobc ) THEN 121 CALL obc_spg_east( kt ) 122 END IF 123 124 ! 3. West open boundary 125 ! --------------------- 126 127 IF( lpwestobc ) THEN 128 CALL obc_spg_west( kt ) 129 END IF 130 131 ! 4. North open boundary 132 ! ---------------------- 133 134 IF( lpnorthobc ) THEN 135 CALL obc_spg_north( kt ) 136 END IF 137 138 ! 5. South open boundary 139 ! ---------------------- 140 141 IF( lpsouthobc ) THEN 142 CALL obc_spg_south( kt ) 143 END IF 144 145 # if defined key_mpp 146 CALL mpp_lnk_2d( gcbob, 'G', 1. ) 147 # endif 110 IF( lpeastobc ) CALL obc_spg_east ( kt ) ! East open boundary 111 112 IF( lpwestobc ) CALL obc_spg_west ( kt ) ! West open boundary 113 114 IF( lpnorthobc ) CALL obc_spg_north( kt ) ! North open boundary 115 116 IF( lpsouthobc ) CALL obc_spg_south( kt ) ! South open boundary 117 118 IF( lk_mpp ) CALL lbc_lnk( gcbob, 'G', 1. ) 148 119 149 120 END SUBROUTINE obc_spg 150 121 122 151 123 SUBROUTINE obc_spg_east ( kt ) 152 124 !!------------------------------------------------------------------------------ 153 !! SUBROUTINE obc_spg_east 154 !! ************************* 155 !! ** Purpose : 156 !! Apply the radiation algorithm on east OBC stream function. 157 !! If the logical lfbceast is .TRUE., there is no radiation but only fixed OBC 125 !! *** SUBROUTINE obc_spg_east *** 126 !! 127 !! ** Purpose : Apply the radiation algorithm on east OBC stream function. 128 !! If lfbceast=T , there is no radiation but only fixed OBC 158 129 !! 159 130 !! History : … … 169 140 !! * Local declarations 170 141 INTEGER :: ij 171 172 142 REAL(wp) :: z2dtr, ztau, zin 173 143 REAL(wp) :: z05cx, zdt, z4nor2, z2dx, z2dy 174 175 !!------------------------------------------------------------------------------176 !! OPA 8.5, LODYC-IPSL (2002)177 144 !!------------------------------------------------------------------------------ 178 145 … … 229 196 IF(lwp) WRITE(numout,*)' PB dans obc_spg_east au pt ',jj,' : z4nor=0' 230 197 z4nor2 = 0.001 231 END 198 ENDIF 232 199 z05cx = zdt * z2dx / z4nor2 * bmask(ji,jj) 233 200 z05cx = z05cx / e1v(ji+1,jj) … … 249 216 END DO 250 217 251 END IF 252 # if defined key_mpp 253 CALL mppobc(bsfeob,jpjed,jpjef,jpieob-1,1,2,jpj) 254 # endif 218 ENDIF 219 IF( lk_mpp ) CALL mppobc(bsfeob,jpjed,jpjef,jpieob-1,1,2,jpj) 220 255 221 256 222 ! 3. right hand side of the barotropic elliptic equation … … 258 224 259 225 IF( ( neuler == 0 ) .AND. ( kt == nit000 ) ) THEN 260 z2dtr =1./rdt226 z2dtr = 1.0 / rdt 261 227 ELSE 262 z2dtr =1./2./rdt263 END 228 z2dtr = 0.5 / rdt 229 ENDIF 264 230 DO ji = fs_nie0-1, fs_nie1-1 ! Vector opt. 265 231 DO jj = nje0m1, nje1 … … 351 317 IF(lwp) WRITE(numout,*)' PB dans obc_spg_west au pt ',jj,' : z4nor =0' 352 318 z4nor2=0.0001 353 END 319 ENDIF 354 320 z05cx = zdt * z2dx / z4nor2 * bmask(ji,jj) 355 321 z05cx = z05cx / e1v(ji,jj) … … 368 334 END DO 369 335 370 END IF 371 # if defined key_mpp 372 CALL mppobc(bsfwob,jpjwd,jpjwf,jpiwob+1,1,2,jpj) 373 # endif 336 ENDIF 337 IF( lk_mpp ) CALL mppobc(bsfwob,jpjwd,jpjwf,jpiwob+1,1,2,jpj) 338 374 339 375 340 ! 3. right hand side of the barotropic elliptic equation … … 377 342 378 343 IF( ( neuler == 0 ) .AND. ( kt == nit000 ) ) THEN 379 z2dtr =1./rdt344 z2dtr = 1.0 / rdt 380 345 ELSE 381 z2dtr =1./2./rdt382 END 346 z2dtr = 0.5 / rdt 347 ENDIF 383 348 DO ji = fs_niw0+1, fs_niw1+1 ! Vector opt. 384 349 DO jj = njw0m1, njw1 … … 392 357 SUBROUTINE obc_spg_north ( kt ) 393 358 !!------------------------------------------------------------------------------ 394 !! SUBROUTINE obc_spg_north 395 !! ************************* 396 !! ** Purpose : 397 !! Apply the radiation algorithm on north OBC stream function. 398 !! If the logical lfbcnorth is .TRUE., there is no radiation but only fixed OBC 359 !! *** SUBROUTINE obc_spg_north *** 360 !! 361 !! ** Purpose : Apply the radiation algorithm on north OBC stream function. 362 !! If lfbcnorth=T, there is no radiation but only fixed OBC 399 363 !! 400 364 !! History : … … 410 374 !! * Local declarations 411 375 INTEGER :: ii 412 413 376 REAL(wp) :: z2dtr, ztau, zin 414 377 REAL(wp) :: z05cx, zdt, z4nor2, z2dx, z2dy 415 416 !!------------------------------------------------------------------------------417 !! OPA 8.5, LODYC-IPSL (2002)418 378 !!------------------------------------------------------------------------------ 419 379 … … 475 435 IF( z4nor2 == 0 ) THEN 476 436 IF(lwp) WRITE(numout,*)' PB dans obc_spg_north au pt',ji,' : z4nor =0' 477 END 437 ENDIF 478 438 z05cx = zdt * z2dx / z4nor2 * bmask(ji,jj) 479 439 z05cx = z05cx / e2u(ji,jj+1) … … 492 452 END DO 493 453 494 END IF 495 # if defined key_mpp 496 call mppobc(bsfnob,jpind,jpinf,jpjnob-1,1,1,jpi) 497 # endif 454 ENDIF 455 IF( lk_mpp ) CALL mppobc(bsfnob,jpind,jpinf,jpjnob-1,1,1,jpi) 456 498 457 499 458 ! 3. right hand side of the barotropic elliptic equation … … 501 460 502 461 IF( ( neuler == 0 ) .AND. ( kt == nit000 ) ) THEN 503 z2dtr =1./rdt462 z2dtr = 1.0 / rdt 504 463 ELSE 505 z2dtr =1./2./rdt506 END 464 z2dtr = 0.5 / rdt 465 ENDIF 507 466 DO jj = fs_njn0-1, fs_njn1-1 ! Vector opt. 508 467 DO ji = nin0m1, nin1 … … 514 473 END SUBROUTINE obc_spg_north 515 474 475 516 476 SUBROUTINE obc_spg_south ( kt ) 517 477 !!------------------------------------------------------------------------------ 518 !! SUBROUTINE obc_spg_south 519 !! ************************* 520 !! ** Purpose : 521 !! Apply the radiation algorithm on south OBC stream function. 522 !! If the logical lfbcsouth is .TRUE., there is no radiation but only fixed OBC 478 !! *** SUBROUTINE obc_spg_south *** 479 !! 480 !! ** Purpose : Apply the radiation algorithm on south OBC stream function. 481 !! If lfbcsouth=T, there is no radiation but only fixed OBC 523 482 !! 524 483 !! History : … … 596 555 IF( z4nor2 == 0 ) THEN 597 556 IF(lwp) WRITE(numout,*)' PB dans obc_spg_south au pt ',ji,' : z4nor =0' 598 END 557 ENDIF 599 558 z05cx = zdt * z2dx / z4nor2 * bmask(ji,jj) 600 559 z05cx = z05cx / e2u(ji,jj) … … 613 572 END DO 614 573 615 END IF 616 # if defined key_mpp 617 CALL mppobc(bsfsob,jpisd,jpisf,jpjsob+1,1,1,jpi) 618 # endif 574 ENDIF 575 IF( lk_mpp ) CALL mppobc(bsfsob,jpisd,jpisf,jpjsob+1,1,1,jpi) 576 619 577 620 578 ! 3. right hand side of the barotropic elliptic equation 621 579 ! ------------------------------------------------------- 622 580 623 IF( ( neuler == 0 ) . and. ( kt == nit000 ) ) THEN624 z2dtr =1./rdt581 IF( ( neuler == 0 ) .AND. ( kt == nit000 ) ) THEN 582 z2dtr = 1.0 / rdt 625 583 ELSE 626 z2dtr =1./2./rdt627 END 584 z2dtr = 0.5 / rdt 585 ENDIF 628 586 DO jj = fs_njs0+1, fs_njs1+1 ! Vector opt. 629 587 DO ji = nis0m1, nis1 … … 642 600 SUBROUTINE obc_spg( kt ) ! Empty routine 643 601 INTEGER, INTENT( in ) :: kt 644 WRITE(*,*) kt602 WRITE(*,*) 'obc_spg: You should not have seen this print! error?', kt 645 603 END SUBROUTINE obc_spg 646 604 #endif -
trunk/NEMO/OPA_SRC/OBC/obctra.F90
r3 r32 20 20 USE obc_oce ! ocean open boundary conditions 21 21 USE lib_mpp ! ??? 22 USE lbclnk ! ??? 22 23 USE in_out_manager ! I/O manager 23 24 … … 29 30 30 31 !! * Module variables 31 INTEGER :: ji, jj, jk ! dummy loop indices32 33 32 INTEGER :: & ! ... boundary space indices 34 33 nib = 1, & ! nib = boundary point … … 90 89 END IF 91 90 92 ! 1. East open boundary 93 ! --------------------- 94 95 IF( lpeastobc )THEN 96 CALL obc_tra_east( kt ) 97 END IF 98 99 ! 2. West open boundary 100 ! --------------------- 101 102 IF( lpwestobc )THEN 103 CALL obc_tra_west( kt ) 104 END IF 105 106 ! 3. North open boundary 107 ! --------------------- 108 109 IF( lpnorthobc )THEN 110 CALL obc_tra_north( kt ) 111 END IF 112 113 ! 4. South open boundary 114 ! --------------------- 115 116 IF( lpsouthobc )THEN 117 CALL obc_tra_south( kt ) 118 END IF 119 120 # if defined key_mpp 121 !! bug ??? 122 IF( kt >= nit000+3 .AND. ln_rstart ) THEN 123 CALL mpp_lnk_3d( tb, 'T', 1. ) 124 CALL mpp_lnk_3d( sb, 'T', 1. ) 125 END IF 126 CALL mpp_lnk_3d( ta, 'T', 1. ) 127 CALL mpp_lnk_3d( sa, 'T', 1. ) 128 # endif 91 IF( lpeastobc ) CALL obc_tra_east ( kt ) ! East open boundary 92 93 IF( lpwestobc ) CALL obc_tra_west ( kt ) ! West open boundary 94 95 IF( lpnorthobc ) CALL obc_tra_north( kt ) ! North open boundary 96 97 IF( lpsouthobc ) CALL obc_tra_south( kt ) ! South open boundary 98 99 IF( lk_mpp ) THEN !!bug ??? 100 IF( kt >= nit000+3 .AND. ln_rstart ) THEN 101 CALL lbc_lnk( tb, 'T', 1. ) 102 CALL lbc_lnk( sb, 'T', 1. ) 103 END IF 104 CALL lbc_lnk( ta, 'T', 1. ) 105 CALL lbc_lnk( sa, 'T', 1. ) 106 ENDIF 129 107 130 108 END SUBROUTINE obc_tra … … 151 129 152 130 !! * Local declaration 131 INTEGER :: ji, jj, jk ! dummy loop indices 153 132 REAL(wp) :: z05cx, ztau, zin 154 155 !!------------------------------------------------------------------------------156 !! OPA 8.5, LODYC-IPSL (2002)157 133 !!------------------------------------------------------------------------------ 158 134 … … 253 229 254 230 !! * Local declaration 231 INTEGER :: ji, jj, jk ! dummy loop indices 255 232 REAL(wp) :: z05cx, ztau, zin 256 233 !!------------------------------------------------------------------------------ … … 351 328 352 329 !! * Local declaration 330 INTEGER :: ji, jj, jk ! dummy loop indices 353 331 REAL(wp) :: z05cx, ztau, zin 354 332 !!------------------------------------------------------------------------------ … … 452 430 453 431 !! * Local declaration 432 INTEGER :: ji, jj, jk ! dummy loop indices 454 433 REAL(wp) :: z05cx, ztau, zin 455 434 !!------------------------------------------------------------------------------ -
trunk/NEMO/OPA_SRC/OBC/obcvol.F90
r3 r32 2 2 !!================================================================================= 3 3 !! *** MODULE obcvol *** 4 !! Ocean dynamic : Volume constraint when OBC and Free surface are activated4 !! Ocean dynamic : Volume constraint when OBC and Free surface are used 5 5 !!================================================================================= 6 #if defined key_obc &&defined key_dynspg_fsc6 #if defined key_obc && defined key_dynspg_fsc 7 7 !!--------------------------------------------------------------------------------- 8 8 !! 'key_obc' and open boundary conditions … … 73 73 !! 74 74 !! History : 75 !! 8.5 ! 02-10 (C. Talandier, A-M. Treguier) Original 75 !! 8.5 ! 02-10 (C. Talandier, A-M. Treguier) Original code 76 76 !!---------------------------------------------------------------------------- 77 77 !! * Arguments … … 102 102 END DO 103 103 END DO 104 105 # if defined key_mpp 106 CALL mpp_sum( zCflxemp ) 107 # endif 104 IF( lk_mpp ) CALL mpp_sum( zCflxemp ) ! sum over the global domain 108 105 109 106 ! 2. Barotropic velocity for each open boundary … … 113 110 114 111 ! ... West open boundary 115 IF( lpwestobc ) THEN 116 117 ! ... Total transport through the West OBC 112 IF( lpwestobc ) THEN ! ... Total transport through the West OBC 118 113 DO ji = fs_niw0, fs_niw1 ! Vector opt. 119 114 DO jk = 1, jpkm1 120 115 DO jj = 1, jpj 121 zubtpecor = zubtpecor + ua(ji,jj,jk)*e2u(ji,jj)*fse3u(ji,jj,jk) & 122 * uwmsk(jj,jk) 123 END DO 124 END DO 125 END DO 126 116 zubtpecor = zubtpecor + ua(ji,jj,jk)*e2u(ji,jj)*fse3u(ji,jj,jk) * uwmsk(jj,jk) 117 END DO 118 END DO 119 END DO 127 120 END IF 128 121 129 122 ! ... East open boundary 130 IF( lpeastobc ) THEN 131 132 ! ... Total transport through the East OBC 123 IF( lpeastobc ) THEN ! ... Total transport through the East OBC 133 124 DO ji = fs_nie0, fs_nie1 ! Vector opt. 134 125 DO jk = 1, jpkm1 135 126 DO jj = 1, jpj 136 zubtpecor = zubtpecor - ua(ji,jj,jk)*e2u(ji,jj)*fse3u(ji,jj,jk) & 137 * uemsk(jj,jk) 138 END DO 139 END DO 140 END DO 141 127 zubtpecor = zubtpecor - ua(ji,jj,jk)*e2u(ji,jj)*fse3u(ji,jj,jk) * uemsk(jj,jk) 128 END DO 129 END DO 130 END DO 142 131 END IF 143 132 144 133 ! ... North open boundary 145 IF( lpnorthobc ) THEN 146 147 ! ... Total transport through the North OBC 134 IF( lpnorthobc ) THEN ! ... Total transport through the North OBC 148 135 DO jj = fs_njn0, fs_njn1 ! Vector opt. 149 136 DO jk = 1, jpkm1 150 137 DO ji = 1, jpi 151 zubtpecor = zubtpecor - va(ji,jj,jk)*e1v(ji,jj)*fse3v(ji,jj,jk) & 152 * vnmsk(ji,jk) 153 END DO 154 END DO 155 END DO 156 138 zubtpecor = zubtpecor - va(ji,jj,jk)*e1v(ji,jj)*fse3v(ji,jj,jk) * vnmsk(ji,jk) 139 END DO 140 END DO 141 END DO 157 142 END IF 158 143 159 144 ! ... South open boundary 160 IF( lpsouthobc ) THEN 161 162 ! ... Total transport through the South OBC 145 IF( lpsouthobc ) THEN ! ... Total transport through the South OBC 163 146 DO jj = fs_njs0, fs_njs1 ! Vector opt. 164 147 DO jk = 1, jpkm1 165 148 DO ji = 1, jpi 166 zubtpecor = zubtpecor + va(ji,jj,jk)*e1v(ji,jj)*fse3v(ji,jj,jk) & 167 * vsmsk(ji,jk) 168 END DO 169 END DO 170 END DO 171 172 END IF 173 174 # if defined key_mpp 175 CALL mpp_sum( zubtpecor ) 176 # endif 149 zubtpecor = zubtpecor + va(ji,jj,jk)*e1v(ji,jj)*fse3v(ji,jj,jk) * vsmsk(ji,jk) 150 END DO 151 END DO 152 END DO 153 END IF 154 155 IF( lk_mpp ) CALL mpp_sum( zubtpecor ) ! sum over the global domain 156 177 157 178 158 ! 3. The normal velocity correction … … 181 161 zubtpecor = (zubtpecor - zCflxemp*volemp)*(1./obcsurftot) 182 162 183 IF( lwp . and. mod( kt, nwrite ) == 0) THEN163 IF( lwp .AND. MOD( kt, nwrite ) == 0) THEN 184 164 IF(lwp) WRITE(numout,*)' ' 185 165 IF(lwp) WRITE(numout,*)'obc_vol : time step :', kt … … 214 194 END DO 215 195 216 # if defined key_mpp 217 CALL mpp_sum( ztransw ) 218 # endif 219 220 IF( lwp .and. mod( kt, nwrite ) == 0) THEN 196 IF( lk_mpp ) CALL mpp_sum( ztransw ) ! sum over the global domain 197 198 IF( lwp .AND. MOD( kt, nwrite ) == 0) THEN 221 199 IF(lwp) WRITE(numout,*)' West OB transport ztransw :', ztransw,'(m3/s)' 222 200 END IF … … 236 214 END DO 237 215 238 # if defined key_mpp 239 CALL mpp_sum( ztranse ) 240 # endif 241 242 IF( lwp .and. mod( kt, nwrite ) == 0) THEN 216 IF( lk_mpp ) CALL mpp_sum( ztranse ) ! sum over the global domain 217 218 IF( lwp .AND. MOD( kt, nwrite ) == 0) THEN 243 219 IF(lwp) WRITE(numout,*)' East OB transport ztranse :', ztranse,'(m3/s)' 244 220 END IF … … 257 233 END DO 258 234 END DO 259 260 # if defined key_mpp 261 CALL mpp_sum( ztransn ) 262 # endif 263 264 IF( lwp .and. mod( kt, nwrite ) == 0) THEN 235 IF( lk_mpp ) CALL mpp_sum( ztransn ) ! sum over the global domain 236 237 IF( lwp .AND. MOD( kt, nwrite ) == 0) THEN 265 238 IF(lwp) WRITE(numout,*)' North OB transport ztransn :', ztransn,'(m3/s)' 266 239 END IF … … 279 252 END DO 280 253 END DO 281 282 # if defined key_mpp 283 CALL mpp_sum( ztranss ) 284 # endif 285 286 IF( lwp .and. mod( kt, nwrite ) == 0) THEN 254 IF( lk_mpp ) CALL mpp_sum( ztranss ) ! sum over the global domain 255 256 IF( lwp .AND. MOD( kt, nwrite ) == 0) THEN 287 257 IF(lwp) WRITE(numout,*)' South OB transport ztranss :', ztranss,'(m3/s)' 288 258 END IF … … 296 266 ztranst = ztransw - ztranse + ztranss - ztransn 297 267 298 IF( lwp . and. mod( kt, nwrite ) == 0) THEN268 IF( lwp .AND. MOD( kt, nwrite ) == 0) THEN 299 269 IF(lwp) WRITE(numout,*)' ' 300 270 IF(lwp) WRITE(numout,*)' Cumulate transport ztranst =', ztranst,'(m3/s)'
Note: See TracChangeset
for help on using the changeset viewer.
