Changeset 503 for trunk/NEMO/OPA_SRC/TRA/tranpc.F90
- Timestamp:
- 2006-09-27T10:52:29+02:00 (18 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/TRA/tranpc.F90 (modified) (16 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/TRA/tranpc.F90
r247 r503 4 4 !! Ocean active tracers: non penetrative convection scheme 5 5 !!============================================================================== 6 !! History : 1.0 ! 90-09 (G. Madec) Original code 7 !! ! 91-11 (G. Madec) 8 !! ! 92-06 (M. Imbard) periodic conditions on t and s 9 !! ! 93-03 (M. Guyon) symetrical conditions 10 !! ! 96-01 (G. Madec) statement function for e3 11 !! suppression of common work arrays 12 !! 8.5 ! 02-06 (G. Madec) free form F90 13 !!---------------------------------------------------------------------- 6 14 7 15 !!---------------------------------------------------------------------- … … 9 17 !! tra_npc_init : initialization and control of the scheme 10 18 !!---------------------------------------------------------------------- 11 !! * Modules used12 19 USE oce ! ocean dynamics and active tracers 13 20 USE dom_oce ! ocean space and time domain … … 21 28 PRIVATE 22 29 23 !! * Routine accessibility 24 PUBLIC tra_npc ! routine called by step.F90 25 26 !! * Module variable 27 INTEGER :: & 28 nnpc1 = 1, & ! nnpc1 non penetrative convective scheme frequency 29 nnpc2 = 15 ! nnpc2 non penetrative convective scheme print frequency 30 PUBLIC tra_npc ! routine called by step.F90 31 32 !!* Namelist namnpc: non penetrative convection algorithm 33 INTEGER :: nnpc1 = 1 ! nnpc1 non penetrative convective scheme frequency 34 INTEGER :: nnpc2 = 15 ! nnpc2 non penetrative convective scheme print frequency 35 NAMELIST/namnpc/ nnpc1, nnpc2 30 36 31 37 !! * Substitutions … … 34 40 !! OPA 9.0 , LOCEAN-IPSL (2005) 35 41 !! $Header$ 36 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt42 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 37 43 !!---------------------------------------------------------------------- 38 44 … … 50 56 !! iterations. instabilities are treated when the vertical density 51 57 !! gradient is less than 1.e-5. 52 !! 53 !! 'key_trdtra' defined: the trend associated with this 54 !! algorithm is saved. 55 !! 56 !! macro-tasked on vertical slab (jj-loop) 58 !! l_trdtra=T: the trend associated with this algorithm is saved. 57 59 !! 58 60 !! ** Action : - (tn,sn) after the application od the npc scheme 59 61 !! - save the associated trends (ttrd,strd) ('key_trdtra') 60 62 !! 61 !! References : 62 !! Madec, et al., 1991, JPO, 21, 9, 1349-1371. 63 !! 64 !! History : 65 !! 1.0 ! 90-09 (G. Madec) Original code 66 !! ! 91-11 (G. Madec) 67 !! ! 92-06 (M. Imbard) periodic conditions on t and s 68 !! ! 93-03 (M. Guyon) symetrical conditions 69 !! ! 96-01 (G. Madec) statement function for e3 70 !! suppression of common work arrays 71 !! 8.5 ! 02-06 (G. Madec) free form F90 72 !! 9.0 ! 04-08 (C. Talandier) New trends organization 73 !!---------------------------------------------------------------------- 74 !! * Modules used 75 USE oce, ONLY : ztdta => ua, & ! use ua as 3D workspace 76 ztdsa => va ! use va as 3D workspace 77 78 !! * Arguments 79 INTEGER, INTENT( in ) :: kt ! ocean time-step index 80 81 !! * Local declarations 82 INTEGER :: ji, jj, jk ! dummy loop indices 83 INTEGER :: & 84 inpcc , & ! number of statically instable water column 85 inpci , & ! number of iteration for npc scheme 86 jiter, jkdown, jkp, & ! ??? 87 ikbot, ik, ikup, ikdown ! ??? 88 REAL(wp) :: & ! temporary arrays 89 ze3tot, zta, zsa, zraua, ze3dwn 90 REAL(wp), DIMENSION(jpi,jpk) :: & 91 zwx, zwy, zwz ! temporary arrays 92 REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 93 zrhop ! temporary arrays 94 !!---------------------------------------------------------------------- 95 96 IF( kt == nit000 ) CALL tra_npc_init 97 63 !! References : Madec, et al., 1991, JPO, 21, 9, 1349-1371. 64 !!---------------------------------------------------------------------- 65 USE oce, ONLY : ztrdt => ua ! use ua as 3D workspace 66 USE oce, ONLY : ztrds => va ! use va as 3D workspace 67 !! 68 INTEGER, INTENT(in) :: kt ! ocean time-step index 69 !! 70 INTEGER :: ji, jj, jk ! dummy loop indices 71 INTEGER :: inpcc ! number of statically instable water column 72 INTEGER :: inpci ! number of iteration for npc scheme 73 INTEGER :: jiter, jkdown, jkp ! ??? 74 INTEGER :: ikbot, ik, ikup, ikdown ! ??? 75 REAL(wp) :: ze3tot, zta, zsa, zraua, ze3dwn 76 REAL(wp), DIMENSION(jpi,jpk) :: zwx, zwy, zwz ! 2D arrays 77 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zrhop ! 3D arrays 78 !!---------------------------------------------------------------------- 79 80 IF( kt == nit000 ) CALL tra_npc_init ! Initialisation 98 81 99 82 IF( MOD( kt, nnpc1 ) == 0 ) THEN … … 102 85 inpci = 0 103 86 104 ! 0. Potential density 105 ! -------------------- 106 107 CALL eos( tn, sn, rhd, zrhop ) 108 109 ! Save tn and sn trends 110 IF( l_trdtra ) THEN 111 ztdta(:,:,:) = tn(:,:,:) 112 ztdsa(:,:,:) = sn(:,:,:) 87 CALL eos( tn, sn, rhd, zrhop ) ! Potential density 88 89 90 IF( l_trdtra ) THEN ! Save tn and sn trends 91 ztrdt(:,:,:) = tn(:,:,:) 92 ztrds(:,:,:) = sn(:,:,:) 113 93 ENDIF 114 94 … … 116 96 DO jj = 1, jpj ! Vertical slab 117 97 ! ! =============== 118 119 ! 1. Static instability pointer 120 ! ----------------------------- 121 98 ! Static instability pointer 99 ! ---------------------------- 122 100 DO jk = 1, jpkm1 123 101 DO ji = 1, jpi … … 134 112 END DO 135 113 ! even if south-symmetric b. c. used, do not considere jj=1 136 IF( jj == 1 ) zwx(:,:) = 0.e0114 IF( jj == 1 ) zwx(:,:) = 0.e0 137 115 138 116 DO jk = 1, jpkm1 139 117 DO ji = 1, jpi 140 118 zwx(ji,jk) = 1. 141 IF( zwx(ji,jk) < 1.e-5 ) zwx(ji,jk) =0.142 END DO 143 END DO 144 145 zwy(:,1) = 0. 119 IF( zwx(ji,jk) < 1.e-5 ) zwx(ji,jk) = 0.e0 120 END DO 121 END DO 122 123 zwy(:,1) = 0.e0 146 124 DO ji = 1, jpi 147 125 DO jk = 1, jpkm1 … … 150 128 END DO 151 129 152 zwz(1,1) = 0. 130 zwz(1,1) = 0.e0 153 131 DO ji = 1, jpi 154 132 zwz(1,1) = zwz(1,1) + zwy(ji,1) … … 161 139 ! ------------------------------------------------------------------ 162 140 163 IF (zwz(1,1) /= 0.) THEN 164 165 ! -->> the density profil is statically instable : 166 141 IF( zwz(1,1) /= 0.e0 ) THEN ! -->> the density profil is statically instable : 167 142 DO ji = 1, jpi 168 IF( zwy(ji,1) /= 0. ) THEN 169 170 ! ikbot: ocean bottom level 171 172 ikbot = mbathy(ji,jj) 173 174 ! vertical iteration 175 176 DO jiter = 1, jpk 177 143 IF( zwy(ji,1) /= 0.e0 ) THEN 144 ! 145 ikbot = mbathy(ji,jj) ! ikbot: ocean bottom level 146 ! 147 DO jiter = 1, jpk ! vertical iteration 148 ! 178 149 ! search of ikup : the first static instability from the sea surface 179 150 ! 180 151 ik = 0 181 152 220 CONTINUE … … 183 154 IF( ik >= ikbot-1 ) GO TO 200 184 155 zwx(ji,ik) = zrhop(ji,jj,ik) - zrhop(ji,jj,ik+1) 185 IF( zwx(ji,ik) <= 0. ) GO TO 220156 IF( zwx(ji,ik) <= 0.e0 ) GO TO 220 186 157 ikup = ik 187 158 ! the density profil is instable below ikup 188 189 159 ! ikdown : bottom of the instable portion of the density profil 190 191 160 ! search of ikdown and vertical mixing from ikup to ikdown 192 161 ! 193 162 ze3tot= fse3t(ji,jj,ikup) 194 163 zta = tn (ji,jj,ikup) 195 164 zsa = sn (ji,jj,ikup) 196 165 zraua = zrhop(ji,jj,ikup) 197 166 ! 198 167 DO jkdown = ikup+1, ikbot-1 199 168 IF( zraua <= zrhop(ji,jj,jkdown) ) THEN … … 210 179 ikdown = ikbot-1 211 180 240 CONTINUE 212 181 ! 213 182 DO jkp = ikup, ikdown-1 214 183 tn(ji,jj,jkp) = zta … … 221 190 zrhop(ji,jj,ikdown) = zraua 222 191 ENDIF 223 224 192 END DO 225 193 ENDIF 226 194 200 CONTINUE 227 195 END DO 228 229 196 ! <<-- no more static instability on slab jj 230 231 197 ENDIF 232 198 ! ! =============== 233 199 END DO ! End of slab 234 200 ! ! =============== 235 236 237 ! save the trends for diagnostic 238 ! Non penetrative mixing trends 239 IF( l_trdtra ) THEN 240 ztdta(:,:,:) = tn(:,:,:) - ztdta(:,:,:) 241 ztdsa(:,:,:) = sn(:,:,:) - ztdsa(:,:,:) 242 243 CALL trd_mod(ztdta, ztdsa, jpttdnpc, 'TRA', kt) 201 ! 202 IF( l_trdtra ) THEN ! save the Non penetrative mixing trends for diagnostic 203 ztrdt(:,:,:) = tn(:,:,:) - ztrdt(:,:,:) 204 ztrds(:,:,:) = sn(:,:,:) - ztrds(:,:,:) 205 CALL trd_mod(ztrdt, ztrds, jptra_trd_npc, 'TRA', kt) 244 206 ENDIF 245 207 … … 252 214 ! 2. non penetrative convective scheme statistics 253 215 ! ----------------------------------------------- 254 255 216 IF( nnpc2 /= 0 .AND. MOD( kt, nnpc2 ) == 0 ) THEN 256 217 IF(lwp) WRITE(numout,*)' kt=',kt, ' number of statically instable', & 257 ' water column : ',inpcc, ' number of iteration : ',inpci218 & ' water column : ',inpcc, ' number of iteration : ',inpci 258 219 ENDIF 259 220 ! 260 221 ENDIF 261 222 ! 262 223 END SUBROUTINE tra_npc 263 224 … … 268 229 !! 269 230 !! ** Purpose : initializations of the non-penetrative adjustment scheme 270 !! 271 !! History : 272 !! 8.5 ! 02-12 (G. Madec) F90 : free form 273 !!---------------------------------------------------------------------- 274 !! * Namelist 275 NAMELIST/namnpc/ nnpc1, nnpc2 276 !!---------------------------------------------------------------------- 277 278 ! Namelist namzdf : vertical diffusion 279 REWIND( numnam ) 231 !!---------------------------------------------------------------------- 232 ! 233 REWIND( numnam ) ! Namelist namzdf : vertical diffusion 280 234 READ ( numnam, namnpc ) 281 282 ! Parameter print 283 ! --------------- 284 IF(lwp) THEN 235 ! 236 IF(lwp) THEN ! Namelist print 285 237 WRITE(numout,*) 286 238 WRITE(numout,*) 'tra_npc_init : Non Penetrative Convection (npc) scheme' 287 239 WRITE(numout,*) '~~~~~~~~~~~~' 288 WRITE(numout,*) ' Namelist namnpc : set npc scheme parameters' 289 WRITE(numout,*) 290 WRITE(numout,*) ' npc scheme frequency nnpc1 = ', nnpc1 291 WRITE(numout,*) ' npc scheme print frequency nnpc2 = ', nnpc2 292 WRITE(numout,*) 240 WRITE(numout,*) ' Namelist namnpc : set npc scheme parameters' 241 WRITE(numout,*) ' npc scheme frequency nnpc1 = ', nnpc1 242 WRITE(numout,*) ' npc scheme print frequency nnpc2 = ', nnpc2 293 243 ENDIF 294 295 296 ! Parameter controls 297 ! ------------------ 298 IF ( nnpc1 == 0 ) THEN 244 ! 245 IF ( nnpc1 == 0 ) THEN ! Parameter controls 299 246 IF(lwp) WRITE(numout,cform_war) 300 247 IF(lwp) WRITE(numout,*) ' nnpc1 = ', nnpc1, ' is forced to 1' … … 302 249 nwarn = nwarn + 1 303 250 ENDIF 304 251 ! 305 252 END SUBROUTINE tra_npc_init 306 253
Note: See TracChangeset
for help on using the changeset viewer.
