Changeset 467 for trunk/NEMO/OPA_SRC
- Timestamp:
- 2006-05-10T19:44:38+02:00 (18 years ago)
- Location:
- trunk/NEMO/OPA_SRC
- Files:
-
- 10 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/cla_div.F90
r247 r467 104 104 !! surface depth 105 105 !! The now divergence is given by : 106 !! * z-coordinate (default key) and partial steps (key_partial_steps)107 106 !! hdivn = 1/(e1t*e2t) [ di(e2u un) + dj(e1v vn) ] 108 107 !! -
trunk/NEMO/OPA_SRC/eosbn2.F90
r258 r467 489 489 DO jj = 1, jpjm1 490 490 !CDIR NOVERRCHK 491 #if defined key_ autotasking491 #if defined key_mpp_omp 492 492 DO ji = 1, jpim1 493 493 #else … … 501 501 DO jj = 1, jpjm1 ! Horizontal slab 502 502 ! ! =============== 503 #if defined key_ autotasking503 #if defined key_mpp_omp 504 504 DO ji = 1, jpim1 505 505 #else … … 556 556 DO jj = 1, jpjm1 ! Horizontal slab 557 557 ! ! =============== 558 #if defined key_ autotasking558 #if defined key_mpp_omp 559 559 DO ji = 1, jpim1 560 560 #else … … 573 573 DO jj = 1, jpjm1 ! Horizontal slab 574 574 ! ! =============== 575 #if defined key_ autotasking575 #if defined key_mpp_omp 576 576 DO ji = 1, jpim1 577 577 #else -
trunk/NEMO/OPA_SRC/istate.F90
r434 r467 264 264 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 265 265 266 zh1 = gdept ( 1 )267 zh2 = gdept (jpkm1)266 zh1 = gdept_0( 1 ) 267 zh2 = gdept_0(jpkm1) 268 268 269 269 zslope = ( zt1 - zt2 ) / ( zh1 - zh2 ) … … 534 534 WRITE(numout,*) 535 535 WRITE(numout,*) ' Initial temperature and salinity profiles:' 536 WRITE(numout, "(9x,' level gdept temperature salinity ')" )537 WRITE(numout, "(10x, i4, 3f10.2)" ) ( jk, gdept (jk), tn(2,2,jk), sn(2,2,jk), jk = 1, jpk )536 WRITE(numout, "(9x,' level gdept_0 temperature salinity ')" ) 537 WRITE(numout, "(10x, i4, 3f10.2)" ) ( jk, gdept_0(jk), tn(2,2,jk), sn(2,2,jk), jk = 1, jpk ) 538 538 ENDIF 539 539 -
trunk/NEMO/OPA_SRC/mppini_2.h90
r392 r467 115 115 116 116 ! open the file 117 IF ( lk_zps ) THEN 117 IF ( ln_zco ) THEN 118 clname = 'bathy_level.nc' ! Level bathymetry 119 clvar = 'Bathy_level' 120 ELSE 118 121 clname = 'bathy_meter.nc' ! Meter bathy in case of partial steps 119 122 clvar = 'Bathymetry' 120 ELSE121 clname = 'bathy_level.nc' ! Level bathymetry122 clvar = 'Bathy_level'123 123 ENDIF 124 124 #if defined key_agrif … … 152 152 ! land/sea mask over the global/zoom domain 153 153 154 imask(:,:) =1154 imask(:,:) = 1 155 155 WHERE ( zdta(jpizoom:(jpizoom+jpiglo-1),jpjzoom:(jpjglo+jpjzoom-1)) <= 0. ) imask = 0 156 156 -
trunk/NEMO/OPA_SRC/oce.F90
r359 r467 42 42 !! ----------------------- 43 43 CHARACTER(len=3), PUBLIC :: l_adv !: 'ce2' centre scheme used 44 !!: 'tvd' TVD scheme used45 !!: 'mus' MUSCL scheme used46 !!: 'mu2' MUSCL2 scheme used44 ! !: 'tvd' TVD scheme used 45 ! !: 'mus' MUSCL scheme used 46 ! !: 'mu2' MUSCL2 scheme used 47 47 48 48 !! surface pressure gradient … … 51 51 spgu, spgv !: horizontal surface pressure gradient 52 52 53 #if defined key_partial_steps || defined key_esopa 54 !! interpolated gradient 53 !! interpolated gradient (only used in zps case) 55 54 !! --------------------- 56 55 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & !: 57 56 gtu, gsu, gru, & !: t-, s- and rd horizontal gradient at u- and 58 57 gtv, gsv, grv !: v-points at bottom ocean level 59 #else60 REAL(wp), PUBLIC :: & !:61 gtu, gsu, gru, & !: dummy scalars62 gtv, gsv, grv !:63 #endif64 58 65 59 !! free surface 66 60 !! ------------ 67 61 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & !: 68 sshb, sshn, & !: before, now sea surface height (meters) 69 hu , hv , & !: depth at u- and v-points (meters) 70 hur , hvr !: inverse of u and v-points ocean depth (1/m) 71 #if defined key_obc 72 REAL(wp), PUBLIC :: & !: 73 obcsurftot !: Total lateral surface of open boundaries 74 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & !: 75 obcumask, obcvmask !: u-, v- Force filtering mask for the open 76 ! ! boundary condition on grad D 77 #endif 62 sshb, sshn !: before, now sea surface height (meters) 78 63 79 64 #if defined key_dynspg_rl || defined key_esopa -
trunk/NEMO/OPA_SRC/opa.F90
r440 r467 7 7 !!---------------------------------------------------------------------- 8 8 !! opa_model : solve ocean dynamics, tracer and/or sea-ice 9 !! opa_init : initialization of the opa model 9 10 !! opa_flg : initialisation of algorithm flag 10 11 !! opa_closefile : close remaining files 12 !!---------------------------------------------------------------------- 13 !! History : 14 !! 4.0 ! 90-10 (C. Levy, G. Madec) Original code 15 !! 7.0 ! 91-11 (M. Imbard, C. Levy, G. Madec) 16 !! 7.1 ! 93-03 (M. Imbard, C. Levy, G. Madec, O. Marti, 17 !! M. Guyon, A. Lazar, P. Delecluse, C. Perigaud, 18 !! G. Caniaux, B. Colot, C. Maes ) release 7.1 19 !! ! 92-06 (L.Terray) coupling implementation 20 !! ! 93-11 (M.A. Filiberti) IGLOO sea-ice 21 !! 8.0 ! 96-03 (M. Imbard, C. Levy, G. Madec, O. Marti, 22 !! M. Guyon, A. Lazar, P. Delecluse, L.Terray, 23 !! M.A. Filiberti, J. Vialar, A.M. Treguier, 24 !! M. Levy) release 8.0 25 !! 8.1 ! 97-06 (M. Imbard, G. Madec) 26 !! 8.2 ! 99-11 (M. Imbard, H. Goosse) LIM sea-ice model 27 !! ! 99-12 (V. Thierry, A-M. Treguier, M. Imbard, M-A. Foujols) OPEN-MP 28 !! ! 00-07 (J-M Molines, M. Imbard) Open Boundary Conditions (CLIPPER) 29 !! 9.0 ! 02-08 (G. Madec) F90: Free form and modules 30 !! " ! 04-08 (C. Talandier) New trends organization 31 !! " ! 05-06 (C. Ethe) Add the 1D configuration possibility 32 !! " ! 05-11 (V. Garnier) Surface pressure gradient organization 33 !! " ! 06-03 (L. Debreu, C. Mazauric) Agrif implementation 34 !! " ! 06-04 (G. Madec, R. Benshila) Step reorganization 11 35 !!---------------------------------------------------------------------- 12 36 !! * Modules used … … 30 54 31 55 ! ocean physics 32 USE traqsr ! solar radiation penetration (tra_qsr_init routine)33 56 USE ldfdyn ! lateral viscosity setting (ldfdyn_init routine) 34 57 USE ldftra ! lateral diffusivity setting (ldftra_init routine) … … 59 82 PRIVATE 60 83 84 !! * Module variables 85 CHARACTER (len=64) :: & 86 cform_aaa="( /, 'AAAAAAAA', / ) " ! flag for output listing 87 61 88 !! * Routine accessibility 62 89 PUBLIC opa_model ! called by model.F90 … … 65 92 !! OPA 9.0 , LOCEAN-IPSL (2005) 66 93 !! $Header$ 67 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt94 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 68 95 !!---------------------------------------------------------------------- 69 96 … … 83 110 !! Madec, Delecluse,Imbard, and Levy, 1997: reference manual. 84 111 !! internal report, IPSL. 85 !! 86 !! History : 87 !! 4.0 ! 90-10 (C. Levy, G. Madec) Original code 88 !! 7.0 ! 91-11 (M. Imbard, C. Levy, G. Madec) 89 !! 7.1 ! 93-03 (M. Imbard, C. Levy, G. Madec, O. Marti, 90 !! M. Guyon, A. Lazar, P. Delecluse, C. Perigaud, 91 !! G. Caniaux, B. Colot, C. Maes ) release 7.1 92 !! ! 92-06 (L.Terray) coupling implementation 93 !! ! 93-11 (M.A. Filiberti) IGLOO sea-ice 94 !! 8.0 ! 96-03 (M. Imbard, C. Levy, G. Madec, O. Marti, 95 !! M. Guyon, A. Lazar, P. Delecluse, L.Terray, 96 !! M.A. Filiberti, J. Vialar, A.M. Treguier, 97 !! M. Levy) release 8.0 98 !! 8.1 ! 97-06 (M. Imbard, G. Madec) 99 !! 8.2 ! 99-11 (M. Imbard, H. Goosse) LIM sea-ice model 100 !! ! 99-12 (V. Thierry, A-M. Treguier, M. Imbard, M-A. Foujols) OPEN-MP 101 !! ! 00-07 (J-M Molines, M. Imbard) Open Boundary Conditions (CLIPPER) 102 !! 9.0 ! 02-08 (G. Madec) F90: Free form and modules 103 !! " ! 04-08 (C. Talandier) New trends organization 104 !! " ! 05-06 (C. Ethe) Add the 1D configuration possibility 105 !! " ! 05-11 (V. Garnier) Surface pressure gradient organization 106 !!---------------------------------------------------------------------- 107 !! * Local declarations 112 !!---------------------------------------------------------------------- 108 113 INTEGER :: istp ! time step index 109 CHARACTER (len=64) :: &110 cform_aaa="( /, 'AAAAAAAA', / ) " ! flag for output listing111 114 !!---------------------------------------------------------------------- 112 115 113 116 #if defined key_agrif 114 115 Call Agrif_Init_Grids() 117 CALL Agrif_Init_Grids() 116 118 #endif 117 119 118 C allopa_init ! Initializations119 120 IF( lk_cfg_1d )THEN120 CALL opa_init ! Initializations 121 122 IF( lk_cfg_1d ) THEN 121 123 istp = nit000 122 124 DO WHILE ( istp <= nitend .AND. nstop == 0 ) … … 156 158 157 159 160 SUBROUTINE opa_init 161 !!---------------------------------------------------------------------- 162 !! *** ROUTINE opa_init *** 163 !! 164 !! ** Purpose : initialization of the opa model 165 !! 166 !!---------------------------------------------------------------------- 167 #if defined key_coupled 168 INTEGER :: itro, istp0 ! ??? 169 #endif 170 CHARACTER (len=20) :: namelistname 171 CHARACTER (len=28) :: file_out 172 !!---------------------------------------------------------------------- 173 174 ! Initializations 175 ! =============== 176 177 file_out = 'ocean.output' 178 179 ! open listing and namelist units 180 IF ( numout /= 0 .AND. numout /= 6 ) THEN 181 CALL ctlopn( numout, file_out, 'UNKNOWN', 'FORMATTED', & 182 & 'SEQUENTIAL', 1, numout, .FALSE., 1 ) 183 ENDIF 184 185 namelistname = 'namelist' 186 CALL ctlopn( numnam, namelistname, 'OLD', 'FORMATTED', 'SEQUENTIAL', & 187 & 1, numout, .FALSE., 1 ) 188 189 WRITE(numout,*) 190 WRITE(numout,*) ' L O D Y C - I P S L' 191 WRITE(numout,*) ' O P A model' 192 WRITE(numout,*) ' Ocean General Circulation Model' 193 WRITE(numout,*) ' version OPA 9.0 (2005) ' 194 WRITE(numout,*) 195 WRITE(numout,*) 196 197 ! Nodes selection 198 narea = mynode() 199 narea = narea + 1 ! mynode return the rank of proc (0 --> jpnij -1 ) 200 lwp = narea == 1 201 202 ! ! ============================== ! 203 ! ! Model general initialization ! 204 ! ! ============================== ! 205 206 IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA 207 208 ! Domain decomposition 209 IF( jpni*jpnj == jpnij ) THEN 210 CALL mpp_init ! standard cutting out 211 ELSE 212 CALL mpp_init2 ! eliminate land processors 213 ENDIF 214 215 CALL phy_cst ! Physical constants 216 217 CALL dom_cfg ! Domain configuration 218 219 CALL dom_init ! Domain 220 221 IF( ln_ctl ) CALL prt_ctl_init ! Print control 222 223 IF( lk_cfg_1d ) CALL fcorio_1d ! redefine Coriolis at T-point 224 225 IF( lk_obc ) CALL obc_init ! Open boundaries 226 227 CALL day( nit000 ) ! Calendar 228 229 CALL istate_init ! ocean initial state (Dynamics and tracers) 230 231 IF( lk_dynspg_flt .OR. lk_dynspg_rl ) THEN 232 CALL solver_init( nit000 ) ! Elliptic solver 233 ENDIF 234 235 !!add 236 CALL eos( tb, sb, rhd, rhop ) ! before potential and in situ densities 237 238 CALL bn2( tb, sb, rn2 ) ! before Brunt-Vaisala frequency 239 240 IF( ln_zps .AND. .NOT. lk_cfg_1d ) & 241 & CALL zps_hde( nit000, tb, sb, rhd, & ! Partial steps: before Horizontal DErivative 242 gtu, gsu, gru, & ! of t, s, rd at the bottom ocean level 243 gtv, gsv, grv ) 244 !!add 245 246 CALL oc_fz_pt ! Surface freezing point 247 248 #if defined key_ice_lim 249 CALL ice_init ! Sea ice model 250 #endif 251 252 ! ! Ocean scheme 253 254 CALL opa_flg ! Choice of algorithms 255 256 ! ! Ocean physics 257 258 CALL ldf_dyn_init ! Lateral ocean momentum physics 259 260 CALL ldf_tra_init ! Lateral ocean tracer physics 261 262 CALL zdf_init ! Vertical ocean physics 263 264 ! ! Ocean trends 265 ! Control parameters 266 IF( lk_trdtra .OR. lk_trdmld ) l_trdtra = .TRUE. 267 IF( lk_trddyn .OR. lk_trdvor ) l_trddyn = .TRUE. 268 269 IF( lk_trddyn .OR. lk_trdtra ) & 270 & CALL trd_icp_init ! active tracers and/or momentum 271 272 IF( lk_trdmld ) CALL trd_mld_init ! mixed layer 273 274 IF( lk_trdvor ) CALL trd_vor_init ! vorticity 275 276 #if defined key_passivetrc 277 CALL ini_trc ! Passive tracers 278 #endif 279 280 #if defined key_coupled 281 itro = nitend - nit000 + 1 ! Coupled 282 istp0 = NINT( rdt ) 283 CALL cpl_init( itro, nexco, istp0 ) ! Signal processing and process id exchange 284 #endif 285 286 CALL flx_init ! Thermohaline forcing initialization 287 288 CALL flx_fwb_init ! FreshWater Budget correction 289 290 CALL dia_ptr_init ! Poleward TRansports initialization 291 292 ! ! =============== ! 293 ! ! time stepping ! 294 ! ! =============== ! 295 296 IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA 297 298 IF( lk_cfg_1d ) THEN 299 CALL init_1d 300 ENDIF 301 302 END SUBROUTINE opa_init 303 304 158 305 SUBROUTINE opa_flg 159 306 !!---------------------------------------------------------------------- … … 173 320 !!---------------------------------------------------------------------- 174 321 175 ! Read Namelist namflg : algorithm FLaG 322 ! Read Namelist namflg : algorithm FLaG 176 323 ! -------------------- 177 324 REWIND ( numnam ) … … 193 340 END SUBROUTINE opa_flg 194 341 342 195 343 SUBROUTINE opa_closefile 196 344 !!---------------------------------------------------------------------- … … 198 346 !! 199 347 !! ** Purpose : Close the files 200 !! 201 !! ** Method : 348 !! 349 !! ** Method : 202 350 !! 203 351 !! History : … … 236 384 237 385 !!====================================================================== 238 SUBROUTINE opa_init239 !!----------------------------------------------------------------------240 !! *** ROUTINE opa_init ***241 !!242 !! ** Purpose : initialization of the opa model243 !!244 !! ** Method :245 !!246 !! References :247 !!----------------------------------------------------------------------248 !! * Local declarations249 250 #if defined key_coupled251 INTEGER :: itro, istp0 ! ???252 #endif253 CHARACTER (len=64) :: &254 cform_aaa="( /, 'AAAAAAAA', / ) " ! flag for output listing255 CHARACTER (len=20) :: namelistname256 CHARACTER (len=28) :: file_out257 !!----------------------------------------------------------------------258 259 ! Initializations260 ! ===============261 262 file_out = 'ocean.output'263 264 ! open listing and namelist units265 IF ( numout /= 0 .AND. numout /= 6 ) THEN266 CALL ctlopn(numout,file_out,'UNKNOWN', 'FORMATTED', &267 'SEQUENTIAL',1,numout,.FALSE.,1)268 ! OPEN( UNIT=numout, FILE=TRIM(file_out), FORM='FORMATTED' )269 ENDIF270 271 namelistname = 'namelist'272 CALL ctlopn(numnam,namelistname,'OLD', 'FORMATTED', 'SEQUENTIAL', &273 1,numout,.FALSE.,1)274 !!!! OPEN( UNIT=numnam, FILE='namelist', FORM='FORMATTED', STATUS='OLD' )275 276 WRITE(numout,*)277 WRITE(numout,*) ' L O D Y C - I P S L'278 WRITE(numout,*) ' O P A model'279 WRITE(numout,*) ' Ocean General Circulation Model'280 WRITE(numout,*) ' version OPA 9.0 (2005) '281 WRITE(numout,*)282 WRITE(numout,*)283 284 ! Nodes selection285 narea = mynode()286 narea = narea + 1 ! mynode return the rank of proc (0 --> jpnij -1 )287 lwp = narea == 1288 289 ! ! ============================== !290 ! ! Model general initialization !291 ! ! ============================== !292 293 IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA294 295 ! Domain decomposition296 IF( jpni*jpnj == jpnij ) THEN297 CALL mpp_init ! standard cutting out298 ELSE299 CALL mpp_init2 ! eliminate land processors300 ENDIF301 302 CALL phy_cst ! Physical constants303 304 CALL dom_cfg ! Domain configuration305 306 CALL dom_init ! Domain307 IF( ln_ctl ) CALL prt_ctl_init ! Print control308 309 IF( lk_cfg_1d ) CALL fcorio_1d ! redefine Coriolis at T-point310 311 IF( lk_obc ) CALL obc_init ! Open boundaries312 313 CALL day( nit000 ) ! Calendar314 315 CALL istate_init ! ocean initial state (Dynamics and tracers)316 317 IF( lk_dynspg_flt .OR. lk_dynspg_rl ) THEN318 CALL solver_init( nit000 ) ! Elliptic solver319 ENDIF320 321 !!add322 CALL eos( tb, sb, rhd, rhop ) ! before potential and in situ densities323 324 CALL bn2( tb, sb, rn2 ) ! before Brunt-Vaisala frequency325 326 IF( lk_zps .AND. .NOT. lk_cfg_1d ) &327 & CALL zps_hde( nit000, tb, sb, rhd, & ! Partial steps: before Horizontal DErivative328 gtu, gsu, gru, & ! of t, s, rd at the bottom ocean level329 gtv, gsv, grv )330 331 !!add332 333 CALL oc_fz_pt ! Surface freezing point334 335 #if defined key_ice_lim336 CALL ice_init ! Sea ice model337 #endif338 339 ! ! Ocean scheme340 341 CALL opa_flg ! Choice of algorithms342 343 ! ! Ocean physics344 345 CALL tra_qsr_init ! Solar radiation penetration346 347 CALL ldf_dyn_init ! Lateral ocean momentum physics348 349 CALL ldf_tra_init ! Lateral ocean tracer physics350 351 CALL zdf_init ! Vertical ocean physics352 353 ! ! Ocean trends354 ! Control parameters355 IF( lk_trdtra .OR. lk_trdmld ) l_trdtra = .TRUE.356 IF( lk_trddyn .OR. lk_trdvor ) l_trddyn = .TRUE.357 358 IF( lk_trddyn .OR. lk_trdtra ) &359 & CALL trd_icp_init ! active tracers and/or momentum360 361 IF( lk_trdmld ) CALL trd_mld_init ! mixed layer362 363 IF( lk_trdvor ) CALL trd_vor_init ! vorticity364 365 #if defined key_passivetrc366 CALL ini_trc ! Passive tracers367 #endif368 369 #if defined key_coupled370 itro = nitend - nit000 + 1 ! Coupled371 istp0 = NINT( rdt )372 CALL cpl_init( itro, nexco, istp0 ) ! Signal processing and process id exchange373 #endif374 375 CALL flx_init ! Thermohaline forcing initialization376 377 CALL flx_fwb_init ! FreshWater Budget correction378 379 CALL dia_ptr_init ! Poleward TRansports initialization380 381 ! ! =============== !382 ! ! time stepping !383 ! ! =============== !384 385 IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA386 387 IF( lk_cfg_1d ) THEN388 CALL init_1d389 ENDIF390 END SUBROUTINE opa_init391 !!======================================================================392 386 END MODULE opa -
trunk/NEMO/OPA_SRC/par_oce.F90
r392 r467 209 209 #endif 210 210 211 #if defined key_ autotasking211 #if defined key_mpp_omp 212 212 LOGICAL, PUBLIC, PARAMETER :: lk_jki = .TRUE. !: j-k-i loop flag 213 213 #else -
trunk/NEMO/OPA_SRC/restart.F90
r392 r467 22 22 USE flx_oce ! sea-ice/ocean forcings variables 23 23 USE dynspg_oce ! free surface time splitting scheme variables 24 USE cpl_oce, 24 USE cpl_oce, ONLY : lk_cpl ! 25 25 26 26 IMPLICIT NONE … … 151 151 itime = 0 152 152 CALL ymds2ju( nyear, nmonth, nday, 0.e0, zdate0 ) 153 CALL restini( 'NONE', jpi, jpj, glamt, gphit, jpk, gdept , clname, &153 CALL restini( 'NONE', jpi, jpj, glamt, gphit, jpk, gdept_0, clname, & 154 154 itime, zdate0, rdt*nstock ,numwrs, domain_id=nidom ) 155 155 -
trunk/NEMO/OPA_SRC/restart_dimg.h90
r392 r467 108 108 ! 'before' fields 109 109 DO jk = 1, jpk 110 WRITE(inum,REC=irec) ub (:,:,jk) ; irec = irec +1111 END DO 112 DO jk = 1, jpk 113 WRITE(inum,REC=irec) vb (:,:,jk) ; irec = irec +1114 END DO 115 DO jk = 1, jpk 116 WRITE(inum,REC=irec) tb (:,:,jk) ; irec = irec +1117 END DO 118 DO jk = 1, jpk 119 WRITE(inum,REC=irec) sb (:,:,jk) ; irec = irec +1120 END DO 121 DO jk = 1, jpk 122 WRITE(inum,REC=irec) rotb (:,:,jk) ; irec = irec +1110 WRITE(inum,REC=irec) ub (:,:,jk) ; irec = irec +1 111 END DO 112 DO jk = 1, jpk 113 WRITE(inum,REC=irec) vb (:,:,jk) ; irec = irec +1 114 END DO 115 DO jk = 1, jpk 116 WRITE(inum,REC=irec) tb (:,:,jk) ; irec = irec +1 117 END DO 118 DO jk = 1, jpk 119 WRITE(inum,REC=irec) sb (:,:,jk) ; irec = irec +1 120 END DO 121 DO jk = 1, jpk 122 WRITE(inum,REC=irec) rotb (:,:,jk) ; irec = irec +1 123 123 END DO 124 124 DO jk = 1, jpk … … 128 128 ! 'now' fields 129 129 DO jk = 1, jpk 130 WRITE(inum,REC=irec) un (:,:,jk) ; irec = irec +1131 END DO 132 DO jk = 1, jpk 133 WRITE(inum,REC=irec) vn (:,:,jk) ; irec = irec +1134 END DO 135 DO jk = 1, jpk 136 WRITE(inum,REC=irec) tn (:,:,jk) ; irec = irec +1137 END DO 138 DO jk = 1, jpk 139 WRITE(inum,REC=irec) sn (:,:,jk) ; irec = irec +1140 END DO 141 DO jk = 1, jpk 142 WRITE(inum,REC=irec) rotn (:,:,jk) ; irec = irec +1130 WRITE(inum,REC=irec) un (:,:,jk) ; irec = irec +1 131 END DO 132 DO jk = 1, jpk 133 WRITE(inum,REC=irec) vn (:,:,jk) ; irec = irec +1 134 END DO 135 DO jk = 1, jpk 136 WRITE(inum,REC=irec) tn (:,:,jk) ; irec = irec +1 137 END DO 138 DO jk = 1, jpk 139 WRITE(inum,REC=irec) sn (:,:,jk) ; irec = irec +1 140 END DO 141 DO jk = 1, jpk 142 WRITE(inum,REC=irec) rotn (:,:,jk) ; irec = irec +1 143 143 END DO 144 144 DO jk = 1, jpk … … 147 147 148 148 ! elliptic solver arrays 149 WRITE(inum,REC=irec ) gcx (1:jpi,1:jpj) ; irec = irec +1149 WRITE(inum,REC=irec ) gcx (1:jpi,1:jpj) ; irec = irec +1 150 150 WRITE(inum,REC=irec ) gcxb(1:jpi,1:jpj) ; irec = irec +1 151 151 #if defined key_dynspg_rl … … 173 173 #if defined key_zdftke 174 174 DO jk = 1, jpk 175 WRITE(inum,REC=irec) en(:,:,jk) ;irec = irec + 1175 WRITE(inum,REC=irec) en(:,:,jk) ; irec = irec + 1 176 176 END DO 177 177 #endif … … 179 179 #if defined key_ice_lim 180 180 zfice(1) = FLOAT( nfice ) ! Louvain La Neuve Sea Ice Model 181 WRITE(inum,REC=irec) zfice(:) ; irec = irec + 1182 WRITE(inum,REC=irec) sst_io(:,:) ; irec = irec + 1183 WRITE(inum,REC=irec) sss_io(:,:) ; irec = irec + 1184 WRITE(inum,REC=irec) u_io (:,:) ; irec = irec + 1185 WRITE(inum,REC=irec) v_io (:,:) ; irec = irec + 1181 WRITE(inum,REC=irec) zfice(:) ; irec = irec + 1 182 WRITE(inum,REC=irec) sst_io(:,:) ; irec = irec + 1 183 WRITE(inum,REC=irec) sss_io(:,:) ; irec = irec + 1 184 WRITE(inum,REC=irec) u_io (:,:) ; irec = irec + 1 185 WRITE(inum,REC=irec) v_io (:,:) ; irec = irec + 1 186 186 # if defined key_coupled 187 WRITE(inum,REC=irec) alb_ice(:,:) ;irec = irec + 1187 WRITE(inum,REC=irec) alb_ice(:,:) ; irec = irec + 1 188 188 # endif 189 189 #endif 190 190 # if defined key_flx_bulk_monthly || defined key_flx_bulk_daily 191 191 zfblk(1) = FLOAT( nfbulk ) ! Bulk 192 WRITE(inum,REC=irec) zfblk(:) ;irec = irec + 1193 WRITE(inum,REC=irec) gsst (:,:) ;irec = irec + 1192 WRITE(inum,REC=irec) zfblk(:) ; irec = irec + 1 193 WRITE(inum,REC=irec) gsst (:,:) ; irec = irec + 1 194 194 # endif 195 195 … … 288 288 289 289 READ(inum,REC=1) irecl8, ino1, it1, isor1, ipcg1, itke1, & 290 &iice1, ibulk1, ios1, ios2, ios3, ios4, &291 &idast1, adatrj0, ipi,ipj,ipk,ipni,ipnj,ipnij,iarea290 & iice1, ibulk1, ios1, ios2, ios3, ios4, & 291 & idast1, adatrj0, ipi,ipj,ipk,ipni,ipnj,ipnij,iarea 292 292 293 293 ! Performs checks on the file … … 364 364 ! 'before' fields 365 365 DO jk = 1, jpk 366 READ(inum,REC=irec) ub (:,:,jk) ; irec = irec +1367 END DO 368 DO jk = 1, jpk 369 READ(inum,REC=irec) vb (:,:,jk) ; irec = irec +1370 END DO 371 DO jk = 1, jpk 372 READ(inum,REC=irec) tb (:,:,jk) ; irec = irec +1373 END DO 374 DO jk = 1, jpk 375 READ(inum,REC=irec) sb (:,:,jk) ; irec = irec +1376 END DO 377 DO jk = 1, jpk 378 READ(inum,REC=irec) rotb (:,:,jk) ; irec = irec +1366 READ(inum,REC=irec) ub (:,:,jk) ; irec = irec +1 367 END DO 368 DO jk = 1, jpk 369 READ(inum,REC=irec) vb (:,:,jk) ; irec = irec +1 370 END DO 371 DO jk = 1, jpk 372 READ(inum,REC=irec) tb (:,:,jk) ; irec = irec +1 373 END DO 374 DO jk = 1, jpk 375 READ(inum,REC=irec) sb (:,:,jk) ; irec = irec +1 376 END DO 377 DO jk = 1, jpk 378 READ(inum,REC=irec) rotb (:,:,jk) ; irec = irec +1 379 379 END DO 380 380 DO jk = 1, jpk … … 384 384 ! 'now' fields 385 385 DO jk = 1, jpk 386 READ(inum,REC=irec) un (:,:,jk) ; irec = irec +1387 END DO 388 DO jk = 1, jpk 389 READ(inum,REC=irec) vn (:,:,jk) ; irec = irec +1390 END DO 391 DO jk = 1, jpk 392 READ(inum,REC=irec) tn (:,:,jk) ; irec = irec +1393 END DO 394 DO jk = 1, jpk 395 READ(inum,REC=irec) sn (:,:,jk) ; irec = irec +1396 END DO 397 DO jk = 1, jpk 398 READ(inum,REC=irec) rotn (:,:,jk) ; irec = irec +1386 READ(inum,REC=irec) un (:,:,jk) ; irec = irec +1 387 END DO 388 DO jk = 1, jpk 389 READ(inum,REC=irec) vn (:,:,jk) ; irec = irec +1 390 END DO 391 DO jk = 1, jpk 392 READ(inum,REC=irec) tn (:,:,jk) ; irec = irec +1 393 END DO 394 DO jk = 1, jpk 395 READ(inum,REC=irec) sn (:,:,jk) ; irec = irec +1 396 END DO 397 DO jk = 1, jpk 398 READ(inum,REC=irec) rotn (:,:,jk) ; irec = irec +1 399 399 END DO 400 400 DO jk = 1, jpk … … 403 403 404 404 ! elliptic solver arrays 405 READ(inum,REC=irec ) gcx (1:jpi,1:jpj) ; irec = irec +1405 READ(inum,REC=irec ) gcx (1:jpi,1:jpj) ; irec = irec +1 406 406 READ(inum,REC=irec ) gcxb(1:jpi,1:jpj) ; irec = irec +1 407 407 #if defined key_dynspg_rl … … 443 443 ! check if it was in the previous run 444 444 IF ( ios1 == 1 ) THEN 445 READ(inum,REC=irec) zfice (:) ;irec = irec + 1446 READ(inum,REC=irec) sst_io(:,:) ;irec = irec + 1447 READ(inum,REC=irec) sss_io(:,:) ;irec = irec + 1448 READ(inum,REC=irec) u_io (:,:) ;irec = irec + 1449 READ(inum,REC=irec) v_io (:,:) ;irec = irec + 1445 READ(inum,REC=irec) zfice (:) ; irec = irec + 1 446 READ(inum,REC=irec) sst_io(:,:) ; irec = irec + 1 447 READ(inum,REC=irec) sss_io(:,:) ; irec = irec + 1 448 READ(inum,REC=irec) u_io (:,:) ; irec = irec + 1 449 READ(inum,REC=irec) v_io (:,:) ; irec = irec + 1 450 450 # if defined key_coupled 451 READ(inum,REC=irec) alb_ice(:,:) ;irec = irec + 1451 READ(inum,REC=irec) alb_ice(:,:) ; irec = irec + 1 452 452 # endif 453 453 ENDIF … … 472 472 ! bulk forcing 473 473 IF( ios2 == 1 ) THEN 474 READ(inum,REC=irec) zfblk(:) ;irec = irec + 1475 READ(inum,REC=irec) gsst (:,:) ;irec = irec + 1474 READ(inum,REC=irec) zfblk(:) ; irec = irec + 1 475 READ(inum,REC=irec) gsst (:,:) ; irec = irec + 1 476 476 ENDIF 477 477 IF( zfblk(1) /= FLOAT(nfbulk) .OR. ios2 == 0 ) THEN … … 480 480 IF(lwp) WRITE(numout,*) 481 481 gsst(:,:) = 0.e0 482 gsst(:,:) = gsst(:,:) + ( nfbulk-1 ) *( tn(:,:,1) + rt0 )482 gsst(:,:) = gsst(:,:) + ( nfbulk-1 ) * ( tn(:,:,1) + rt0 ) 483 483 ENDIF 484 484 #endif 485 485 CLOSE(inum) 486 486 ! In case of restart with neuler = 0 then put all before fields = to now fields 487 IF 488 tb(:,:,:)=tn(:,:,:)489 sb(:,:,:)=sn(:,:,:)490 ub(:,:,:)=un(:,:,:)491 vb(:,:,:)=vn(:,:,:)492 rotb(:,:,:)=rotn(:,:,:)493 hdivb(:,:,:)=hdivn(:,:,:)487 IF( neuler == 0 ) THEN 488 tb(:,:,:) = tn(:,:,:) 489 sb(:,:,:) = sn(:,:,:) 490 ub(:,:,:) = un(:,:,:) 491 vb(:,:,:) = vn(:,:,:) 492 rotb (:,:,:) = rotn (:,:,:) 493 hdivb(:,:,:) = hdivn(:,:,:) 494 494 #if defined key_dynspg_rl 495 bsfb(:,:)=bsfn(:,:) ! rigid lid495 bsfb(:,:)=bsfn(:,:) ! rigid lid 496 496 #else 497 sshb(:,:)=sshn(:,:) ! free surface formulation (eta) 498 #endif 499 ENDIF 500 501 502 END SUBROUTINE rst_read 497 sshb(:,:)=sshn(:,:) ! free surface formulation (eta) 498 #endif 499 ENDIF 500 501 END SUBROUTINE rst_read -
trunk/NEMO/OPA_SRC/step.F90
r445 r467 4 4 !! Time-stepping : manager of the ocean, tracer and ice time stepping 5 5 !!====================================================================== 6 6 !! History : 7 !! ! 91-03 () Original code 8 !! ! 91-11 (G. Madec) 9 !! ! 92-06 (M. Imbard) add a first output record 10 !! ! 96-04 (G. Madec) introduction of dynspg 11 !! ! 96-04 (M.A. Foujols) introduction of passive tracer 12 !! 8.0 ! 97-06 (G. Madec) new architecture of call 13 !! 8.2 ! 97-06 (G. Madec, M. Imbard, G. Roullet) free surface 14 !! 8.2 ! 99-02 (G. Madec, N. Grima) hpg implicit 15 !! 8.2 ! 00-07 (J-M Molines, M. Imbard) Open Bondary Conditions 16 !! 9.0 ! 02-06 (G. Madec) free form, suppress macro-tasking 17 !! " ! 04-08 (C. Talandier) New trends organization 18 !! " ! 05-01 (C. Ethe) Add the KPP closure scheme 19 !! " ! 05-11 (V. Garnier) Surface pressure gradient organization 20 !! " ! 05-11 (G. Madec) Reorganisation of tra and dyn calls 7 21 !!---------------------------------------------------------------------- 8 22 !! stp : OPA system time-stepping … … 12 26 USE dom_oce ! ocean space and time domain variables 13 27 USE zdf_oce ! ocean vertical physics variables 14 USE ldftra_oce 15 USE ldfdyn_oce 28 USE ldftra_oce ! ocean tracer - trends 29 USE ldfdyn_oce ! ocean dynamics - trends 16 30 USE cpl_oce ! coupled ocean-atmosphere variables 17 31 USE in_out_manager ! I/O manager … … 34 48 USE trcstp ! passive tracer time-stepping (trc_stp routine) 35 49 36 USE dynhpg ! hydrostatic pressure grad. (dyn_hpg routine) 37 USE dynhpg_atsk ! hydrostatic pressure grad. (dyn_hpg_atsk routine) 38 USE dynspg_oce ! surface pressure gradient (dyn_spg routine) 39 USE dynspg ! surface pressure gradient (dyn_spg routine) 40 USE dynkeg ! kinetic energy gradient (dyn_keg routine) 41 USE dynvor ! vorticity term (dyn_vor_... routines) 42 USE dynzad ! vertical advection (dyn_adv routine) 43 USE dynldf_bilapg ! lateral mixing (dyn_ldf_bilapg routine) 44 USE dynldf_bilap ! lateral mixing (dyn_ldf_bilap routine) 45 USE dynldf_iso ! lateral mixing (dyn_ldf_iso routine) 46 USE dynldf_lap ! lateral mixing (dyn_ldf_lap routine) 47 USE dynzdf_imp ! vertical diffusion: implicit (dyn_zdf routine) 48 USE dynzdf_imp_atsk ! vertical diffusion: implicit (dyn_zdf routine) 49 USE dynzdf_iso ! vertical diffusion: isopycnal (dyn_zdf routine) 50 USE dynzdf_exp ! vertical diffusion: explicit (dyn_zdf_exp routine) 51 USE dynnxt ! time-stepping (dyn_nxt routine) 52 50 USE traqsr ! solar radiation penetration (tra_qsr routine) 51 USE trasbc ! surface boundary condition (tra_sbc routine) 53 52 USE trabbc ! bottom boundary condition (tra_bbc routine) 54 53 USE trabbl ! bottom boundary layer (tra_bbl routine) 55 54 USE tradmp ! internal damping (tra_dmp routine) 56 USE tra ldf_bilapg ! lateral mixing (tra_ldf_bilapgroutine)57 USE traldf _bilap ! lateral mixing (tra_ldf_bilaproutine)58 USE traldf_iso ! lateral mixing (tra_ldf_isoroutine)59 USE traldf_iso_zps ! lateral mixing (tra_ldf_iso_zpsroutine)60 USE tra ldf_lap ! lateral mixing (tra_ldf_laproutine)61 USE tra qsr ! solar radiation penetration (tra_qsrroutine)55 USE traadv ! advection scheme control (tra_adv_ctl routine) 56 USE traldf ! lateral mixing (tra_ldf routine) 57 USE cla ! cross land advection (tra_cla routine) 58 ! zdfkpp ! KPP non-local tracer fluxes (tra_kpp routine) 59 USE trazdf ! vertical mixing (tra_zdf routine) 60 USE tranxt ! time-stepping (tra_nxt routine) 62 61 USE tranpc ! non-penetrative convection (tra_npc routine) 63 USE tranxt ! time-stepping (tra_nxt routine)64 USE traadv_ctl ! advection scheme control (tra_adv_ctl routine)65 USE traadv_cen2 ! 2nd order centered scheme (tra_adv_cen2 routine)66 USE traadv_tvd ! TVD scheme (tra_adv_tvd routine)67 USE traadv_muscl ! MUSCL scheme (tra_adv_muscl routine)68 USE traadv_muscl2 ! MUSCL2 scheme (tra_adv_muscl2 routine)69 USE cla ! cross land advection (tra_cla routine)70 USE trazdf_exp ! vertical diffusion: explicit (tra_zdf_exp routine)71 USE trazdf_imp ! vertical diffusion: implicit (tra_zdf_imp routine)72 USE trazdf_iso ! vertical diffusion (tra_zdf_exp routine)73 USE trazdf_iso_vopt ! vertical diffusion (tra_zdf_exp routine)74 USE trasbc ! surface boundary condition (tra_sbc routine)75 62 76 63 USE eosbn2 ! equation of state (eos_bn2 routine) 64 65 USE dynhpg ! hydrostatic pressure grad. (dyn_hpg routine) 66 USE dynkeg ! kinetic energy gradient (dyn_keg routine) 67 USE dynvor ! vorticity term (dyn_vor routine) 68 USE dynzad ! vertical advection (dyn_adv routine) 69 USE dynldf ! lateral momentum diffusion (dyn_ldf routine) 70 USE dynzdf ! vertical diffusion (dyn_zdf routine) 71 USE dynspg_oce ! surface pressure gradient (dyn_spg routine) 72 USE dynspg ! surface pressure gradient (dyn_spg routine) 73 USE dynnxt ! time-stepping (dyn_nxt routine) 77 74 78 75 USE obc_par ! open boundary condition variables … … 91 88 USE zdfbfr ! bottom friction (zdf_bfr routine) 92 89 USE zdftke ! TKE vertical mixing (zdf_tke routine) 90 USE zdftke_jki ! TKE vertical mixing (zdf_tke routine) 93 91 USE zdfkpp ! KPP vertical mixing (zdf_kpp routine) 94 92 USE zdfddm ! double diffusion mixing (zdf_ddm routine) … … 140 138 CONTAINS 141 139 142 SUBROUTINE stp( &143 140 #if !defined key_agrif 144 kstp & 145 #endif 146 ) !!---------------------------------------------------------------------- 141 SUBROUTINE stp( kstp ) 142 #else 143 SUBROUTINE stp( ) 144 #endif 145 !!---------------------------------------------------------------------- 147 146 !! *** ROUTINE stp *** 148 147 !! … … 160 159 !! -8- Outputs and diagnostics 161 160 !! 162 !! History :163 !! ! 91-03 () Original code164 !! ! 91-11 (G. Madec)165 !! ! 92-06 (M. Imbard) add a first output record166 !! ! 96-04 (G. Madec) introduction of dynspg167 !! ! 96-04 (M.A. Foujols) introduction of passive tracer168 !! 8.0 ! 97-06 (G. Madec) new architecture of call169 !! 8.2 ! 97-06 (G. Madec, M. Imbard, G. Roullet) free surface170 !! 8.2 ! 99-02 (G. Madec, N. Grima) hpg implicit171 !! 8.2 ! 00-07 (J-M Molines, M. Imbard) Open Bondary Conditions172 !! 9.0 ! 02-06 (G. Madec) free form, suppress macro-tasking173 !! " ! 04-08 (C. Talandier) New trends organization174 !! " ! 05-01 (C. Ethe) Add the KPP closure scheme175 !! " ! 05-11 (V. Garnier) Surface pressure gradient organization176 161 !!---------------------------------------------------------------------- 177 162 !! * Arguments 178 INTEGER &179 163 #if !defined key_agrif 180 , INTENT( in ) & 164 INTEGER, INTENT( in ) :: kstp ! ocean time-step index 165 #else 166 INTEGER :: kstp ! ocean time-step index 181 167 #endif 182 :: kstp ! ocean time-step index183 168 184 169 !! * local declarations … … 206 191 IF( lk_dtasst ) CALL dta_sst( kstp ) ! Sea Surface Temperature data 207 192 208 IF( lk_dtasss ) CALL dta_sss( kstp ) ! Sea Surface salinity data193 IF( lk_dtasss ) CALL dta_sss( kstp ) ! Sea Surface Salinity data 209 194 210 195 IF( lk_obc ) CALL obc_dta( kstp ) ! update dynamic and tracer data at open boundaries … … 258 243 ! ! Vertical eddy viscosity and diffusivity coefficients 259 244 IF( lk_zdfric ) CALL zdf_ric( kstp ) ! Richardson number dependent Kz 245 #if defined key_mpp_omp 246 IF( lk_zdftke ) CALL zdf_tke_jki( kstp ) ! TKE closure scheme for Kz - j-k-i loops 247 #else 260 248 IF( lk_zdftke ) CALL zdf_tke( kstp ) ! TKE closure scheme for Kz 249 #endif 261 250 IF( lk_zdfkpp ) CALL zdf_kpp( kstp ) ! KPP closure scheme for Kz 251 262 252 IF( lk_zdfcst ) avt (:,:,:) = avt0 * tmask(:,:,:) ! Constant Kz (reset avt to the background value) 263 253 … … 266 256 CASE ( 05 ) ! ORCA R2 configuration 267 257 avt (:,:,2) = avt (:,:,2) + 1.e-3 * upsrnfh(:,:) ! increase diffusivity of rivers mouths 258 CASE ( 025 ) ! ORCA R025 configuration 259 avt (:,:,2) = avt (:,:,2) + 2.e-3 * upsrnfh(:,:) ! increase diffusivity of rivers mouths 268 260 END SELECT 269 261 ENDIF … … 310 302 !----------------------------------------------------------------------- 311 303 312 ta(:,:,:) = 0.e0 ! set tracer trends to zero 313 sa(:,:,:) = 0.e0 314 315 CALL tra_sbc( kstp ) ! surface boundary condition 316 317 IF( ln_traqsr ) CALL tra_qsr( kstp ) ! penetrative solar radiation qsr 318 319 IF( lk_trabbc ) CALL tra_bbc( kstp ) ! bottom heat flux 320 321 IF( lk_trabbl_dif ) CALL tra_bbl_dif( kstp ) ! diffusive bottom boundary layer scheme 322 IF( lk_trabbl_adv ) CALL tra_bbl_adv( kstp ) ! advective (and/or diffusive) bottom boundary layer scheme 323 324 IF( lk_tradmp ) CALL tra_dmp( kstp ) ! internal damping trends 325 326 ! ! horizontal & vertical advection 327 IF( kstp == nit000 ) CALL tra_adv_ctl ! chose/control the scheme used 328 IF( ln_traadv_cen2 ) CALL tra_adv_cen2 ( kstp ) ! 2nd order centered scheme 329 IF( ln_traadv_tvd ) CALL tra_adv_tvd ( kstp ) ! TVD scheme 330 IF( ln_traadv_muscl ) CALL tra_adv_muscl ( kstp ) ! MUSCL scheme 331 IF( ln_traadv_muscl2 ) CALL tra_adv_muscl2( kstp ) ! MUSCL2 scheme 332 333 IF( n_cla == 1 ) CALL tra_cla( kstp ) ! Cross Land Advection (Update Hor. advection) 334 335 ! ! lateral mixing 336 IF( l_traldf_lap ) CALL tra_ldf_lap ( kstp ) ! iso-level laplacian 337 IF( l_traldf_bilap ) CALL tra_ldf_bilap ( kstp ) ! iso-level bilaplacian 338 IF( l_traldf_bilapg ) CALL tra_ldf_bilapg ( kstp ) ! s-coord. horizontal bilaplacian 339 IF( l_traldf_iso ) CALL tra_ldf_iso ( kstp ) ! iso-neutral/geopot. laplacian 340 IF( l_traldf_iso_zps ) CALL tra_ldf_iso_zps( kstp ) ! partial step iso-neutral/geopot. laplacian 341 304 ta(:,:,:) = 0.e0 ! set tracer trends to zero 305 sa(:,:,:) = 0.e0 306 307 CALL tra_sbc ( kstp ) ! surface boundary condition 308 309 IF( ln_traqsr ) CALL tra_qsr ( kstp ) ! penetrative solar radiation qsr 310 311 IF( lk_trabbc ) CALL tra_bbc ( kstp ) ! bottom heat flux 312 313 IF( lk_trabbl_dif ) CALL tra_bbl_dif( kstp ) ! diffusive bottom boundary layer scheme 314 IF( lk_trabbl_adv ) CALL tra_bbl_adv( kstp ) ! advective (and/or diffusive) bottom boundary layer scheme 315 316 IF( lk_tradmp ) CALL tra_dmp ( kstp ) ! internal damping trends 317 318 CALL tra_adv ( kstp ) ! horizontal & vertical advection 319 320 IF( n_cla == 1 ) CALL tra_cla ( kstp ) ! Cross Land Advection (Update Hor. advection) 321 322 IF( lk_zdfkpp ) CALL tra_kpp ( kstp ) ! KPP non-local tracer fluxes 323 324 CALL tra_ldf ( kstp ) ! lateral mixing 342 325 #if defined key_agrif 343 326 IF (.NOT. Agrif_Root()) CALL Agrif_Sponge_tra( kstp ) ! tracers sponge 344 327 #endif 345 ! ! vertical diffusion 346 IF( l_trazdf_exp ) CALL tra_zdf_exp ( kstp ) ! explicit time stepping (time splitting scheme) 347 IF( l_trazdf_imp ) CALL tra_zdf_imp ( kstp ) ! implicit time stepping (euler backward) 348 IF( l_trazdf_iso ) CALL tra_zdf_iso ( kstp ) ! isopycnal 349 IF( l_trazdf_iso_vo ) CALL tra_zdf_iso_vopt( kstp ) ! vector opt. isopycnal 350 351 CALL tra_nxt( kstp ) ! tracer fields at next time step 352 353 IF( ln_zdfnpc ) CALL tra_npc( kstp ) ! update the new (t,s) fields by non 354 ! ! penetrative convective adjustment 355 356 IF( ln_dynhpg_imp ) THEN ! semi-implicit hpg 357 CALL eos( ta, sa, rhd, rhop ) ! Time-filtered in situ density used in dynhpg module 358 IF( lk_zps ) CALL zps_hde( kstp, ta, sa, rhd, & ! Partial steps: time filtered hor. gradient 359 & gtu, gsu, gru, & ! of t, s, rd at the bottom ocean level 360 & gtv, gsv, grv ) 361 ELSE ! centered hpg (default case) 362 CALL eos( tb, sb, rhd, rhop ) ! now (swap=before) in situ density for dynhpg module 363 IF( lk_zps ) CALL zps_hde( kstp, tb, sb, rhd, & ! Partial steps: now horizontal gradient 364 & gtu, gsu, gru, & ! of t, s, rd at the bottom ocean level 365 & gtv, gsv, grv ) 328 CALL tra_zdf ( kstp ) ! vertical mixing 329 330 CALL tra_nxt( kstp ) ! tracer fields at next time step 331 332 IF( ln_zdfnpc ) CALL tra_npc( kstp ) ! update the new (t,s) fields by non 333 ! ! penetrative convective adjustment 334 335 IF( ln_dynhpg_imp ) THEN ! semi-implicit hpg 336 CALL eos( ta, sa, rhd, rhop ) ! Time-filtered in situ density used in dynhpg module 337 IF( ln_zps ) CALL zps_hde( kstp, ta, sa, rhd, & ! Partial steps: time filtered hor. gradient 338 & gtu, gsu, gru, & ! of t, s, rd at the bottom ocean level 339 & gtv, gsv, grv ) 340 ELSE ! centered hpg (default case) 341 CALL eos( tb, sb, rhd, rhop ) ! now (swap=before) in situ density for dynhpg module 342 IF( ln_zps ) CALL zps_hde( kstp, tb, sb, rhd, & ! Partial steps: now horizontal gradient 343 & gtu, gsu, gru, & ! of t, s, rd at the bottom ocean level 344 & gtv, gsv, grv ) 366 345 ENDIF 367 346 … … 371 350 ! N.B. ta, sa arrays are used as workspace in this section 372 351 !----------------------------------------------------------------------- 352 373 353 374 354 ua(:,:,:) = 0.e0 ! set dynamics trends to zero … … 377 357 CALL dyn_keg( kstp ) ! horizontal gradient of kinetic energy 378 358 379 ! ! vorticity term including Coriolis 380 IF( kstp == nit000 ) CALL dyn_vor_ctl ! chose/control the scheme used 381 IF( ln_dynvor_ens ) CALL dyn_vor_enstrophy( kstp ) ! enstrophy conserving scheme 382 IF( ln_dynvor_ene ) CALL dyn_vor_energy ( kstp ) ! energy conserving scheme 383 IF( ln_dynvor_mix ) CALL dyn_vor_mixed ( kstp ) ! mixed energy/enstrophy conserving scheme 384 IF( ln_dynvor_een ) CALL dyn_vor_ene_ens ( kstp ) ! combined energy/enstrophy conserving scheme 385 386 ! ! lateral mixing 387 IF( l_dynldf_lap ) CALL dyn_ldf_lap ( kstp ) ! iso-level laplacian 388 IF( l_dynldf_bilap ) CALL dyn_ldf_bilap ( kstp ) ! iso-level bilaplacian 389 IF( l_dynldf_bilapg ) CALL dyn_ldf_bilapg ( kstp ) ! s-coord. horizontal bilaplacian 390 IF( l_dynldf_iso ) CALL dyn_ldf_iso ( kstp ) ! iso-neutral laplacian 391 359 CALL dyn_vor( kstp ) ! vorticity term including Coriolis 360 361 CALL dyn_ldf( kstp ) ! lateral mixing 392 362 #if defined key_agrif 393 363 IF (.NOT. Agrif_Root()) CALL Agrif_Sponge_dyn( kstp ) ! momemtum sponge 394 364 #endif 395 ! ! horizontal gradient of Hydrostatic pressure 396 IF ( lk_jki ) THEN 397 CALL dyn_hpg_atsk( kstp ) ! autotask case (j-k-i loop) 398 ELSE 399 CALL dyn_hpg ( kstp ) ! default case (k-j-i loop) 400 ENDIF 401 402 CALL dyn_zad ( kstp ) ! vertical advection 403 404 ! ! vertical diffusion 405 IF( l_dynzdf_exp ) CALL dyn_zdf_exp ( kstp ) ! explicit time stepping (time splitting scheme) 406 IF( l_dynzdf_imp ) CALL dyn_zdf_imp ( kstp ) ! implicit time stepping (euler backward) 407 IF( l_dynzdf_imp_tsk ) CALL dyn_zdf_imp_tsk( kstp ) ! autotask implicit time stepping (euler backward) 408 IF( l_dynzdf_iso ) CALL dyn_zdf_iso ( kstp ) ! iso-neutral case 409 410 IF( lk_dynspg_rl ) THEN 365 CALL dyn_hpg( kstp ) ! horizontal gradient of Hydrostatic pressure 366 367 CALL dyn_zad( kstp ) ! vertical advection 368 369 CALL dyn_zdf( kstp ) ! vertical diffusion 370 371 IF( lk_dynspg_rl ) THEN 411 372 IF( lk_obc ) CALL obc_spg( kstp ) ! surface pressure gradient at open boundaries 412 373 ENDIF … … 417 378 CALL dyn_spg( kstp, indic ) ! surface pressure gradient 418 379 419 CALL dyn_nxt( kstp ) ! velocity at next time step380 CALL dyn_nxt( kstp ) ! lateral velocity at next time step 420 381 421 382
Note: See TracChangeset
for help on using the changeset viewer.