Changeset 5965 for branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90
- Timestamp:
- 2015-12-01T16:35:30+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90
r4370 r5965 34 34 USE dtatsd ! data temperature and salinity (dta_tsd routine) 35 35 USE dtauvd ! data: U & V current (dta_uvd routine) 36 USE in_out_manager ! I/O manager37 USE iom ! I/O library38 36 USE zpshde ! partial step: hor. derivative (zps_hde routine) 39 37 USE eosbn2 ! equation of state (eos bn2 routine) … … 42 40 USE dynspg_flt ! filtered free surface 43 41 USE sol_oce ! ocean solver variables 42 ! 43 USE in_out_manager ! I/O manager 44 USE iom ! I/O library 44 45 USE lib_mpp ! MPP library 45 46 USE restart ! restart … … 56 57 # include "vectopt_loop_substitute.h90" 57 58 !!---------------------------------------------------------------------- 58 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)59 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 59 60 !! $Id$ 60 61 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 68 69 !! ** Purpose : Initialization of the dynamics and tracer fields. 69 70 !!---------------------------------------------------------------------- 70 ! - ML - needed for initialization of e3t_b 71 INTEGER :: ji,jj,jk ! dummy loop indices 72 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zuvd ! U & V data workspace 73 !!---------------------------------------------------------------------- 74 ! 75 IF( nn_timing == 1 ) CALL timing_start('istate_init') 76 ! 77 78 IF(lwp) WRITE(numout,*) 71 INTEGER :: ji, jj, jk ! dummy loop indices 72 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zuvd ! U & V data workspace 73 !!---------------------------------------------------------------------- 74 ! 75 IF( nn_timing == 1 ) CALL timing_start('istate_init') 76 ! 77 78 IF(lwp) WRITE(numout,*) ' ' 79 79 IF(lwp) WRITE(numout,*) 'istate_ini : Initialization of the dynamics and tracers' 80 80 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' … … 83 83 IF( lk_c1d ) CALL dta_uvd_init ! Initialization of U & V input data 84 84 85 rhd (:,:,: ) = 0. e086 r hop (:,:,: ) = 0.e087 rn2 (:,:,: ) = 0.e088 tsa (:,:,:,:) = 0.e085 rhd (:,:,: ) = 0._wp ; rhop (:,:,: ) = 0._wp ! set one for all to 0 at level jpk 86 rn2b (:,:,: ) = 0._wp ; rn2 (:,:,: ) = 0._wp ! set one for all to 0 at levels 1 and jpk 87 tsa (:,:,:,:) = 0._wp ! set one for all to 0 at level jpk 88 rab_b(:,:,:,:) = 0._wp ; rab_n(:,:,:,:) = 0._wp ! set one for all to 0 at level jpk 89 89 90 90 IF( ln_rstart ) THEN ! Restart from a file … … 129 129 CALL eos( tsb, rhd, rhop, gdept_0(:,:,:) ) ! before potential and in situ densities 130 130 #if ! defined key_c1d 131 IF( ln_zps ) CALL zps_hde( nit000, jpts, tsb, gtsu, gtsv, & ! zps: before hor. gradient 132 & rhd, gru , grv ) ! of t,s,rd at ocean bottom 131 IF( ln_zps .AND. .NOT. ln_isfcav) & 132 & CALL zps_hde ( nit000, jpts, tsb, gtsu, gtsv, & ! Partial steps: before horizontal gradient 133 & rhd, gru , grv ) ! of t, s, rd at the last ocean level 134 IF( ln_zps .AND. ln_isfcav) & 135 & CALL zps_hde_isf( nit000, jpts, tsb, gtsu, gtsv, & ! Partial steps for top cell (ISF) 136 & rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv , & 137 & gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi ) ! of t, s, rd at the last ocean level 133 138 #endif 134 139 ! … … 162 167 ! 163 168 DO jk = 1, jpkm1 164 #if defined key_vectopt_loop165 DO jj = 1, 1 !Vector opt. => forced unrolling166 DO ji = 1, jpij167 #else168 169 DO jj = 1, jpj 169 170 DO ji = 1, jpi 170 #endif171 171 un_b(ji,jj) = un_b(ji,jj) + fse3u_n(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk) 172 172 vn_b(ji,jj) = vn_b(ji,jj) + fse3v_n(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk) … … 185 185 ! 186 186 ! 187 IF( nn_timing == 1 ) CALL timing_stop('istate_init')187 IF( nn_timing == 1 ) CALL timing_stop('istate_init') 188 188 ! 189 189 END SUBROUTINE istate_init 190 190 191 191 192 SUBROUTINE istate_t_s … … 219 220 END SUBROUTINE istate_t_s 220 221 222 221 223 SUBROUTINE istate_eel 222 224 !!---------------------------------------------------------------------- … … 233 235 USE divcur ! hor. divergence & rel. vorticity (div_cur routine) 234 236 USE iom 235 237 ! 236 238 INTEGER :: inum ! temporary logical unit 237 239 INTEGER :: ji, jj, jk ! dummy loop indices … … 244 246 REAL(wp), DIMENSION(jpiglo,jpjglo) :: zssh ! initial ssh over the global domain 245 247 !!---------------------------------------------------------------------- 246 248 ! 247 249 SELECT CASE ( jp_cfg ) 248 250 ! ! ==================== … … 375 377 INTEGER, PARAMETER :: ntsinit = 0 ! (0/1) (analytical/input data files) T&S initialization 376 378 !!---------------------------------------------------------------------- 377 379 ! 378 380 SELECT CASE ( ntsinit) 379 381 ! 380 382 CASE ( 0 ) ! analytical T/S profil deduced from LEVITUS 381 383 IF(lwp) WRITE(numout,*) 382 384 IF(lwp) WRITE(numout,*) 'istate_gyre : initial analytical T and S profil deduced from LEVITUS ' 383 385 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 384 386 ! 385 387 DO jk = 1, jpk 386 388 DO jj = 1, jpj … … 407 409 END DO 408 410 END DO 409 411 ! 410 412 CASE ( 1 ) ! T/S data fields read in dta_tem.nc/data_sal.nc files 411 413 IF(lwp) WRITE(numout,*) … … 431 433 tsn(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) * tmask(:,:,:) 432 434 tsb(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) 433 435 ! 434 436 END SELECT 435 437 ! 436 438 IF(lwp) THEN 437 439 WRITE(numout,*) … … 440 442 WRITE(numout, "(10x, i4, 3f10.2)" ) ( jk, gdept_1d(jk), tsn(2,2,jk,jp_tem), tsn(2,2,jk,jp_sal), jk = 1, jpk ) 441 443 ENDIF 442 444 ! 443 445 END SUBROUTINE istate_gyre 446 444 447 445 448 SUBROUTINE istate_uvg … … 457 460 USE divcur ! hor. divergence & rel. vorticity (div_cur routine) 458 461 USE lbclnk ! ocean lateral boundary condition (or mpp link) 459 462 ! 460 463 INTEGER :: ji, jj, jk ! dummy loop indices 461 464 INTEGER :: indic ! ??? … … 567 570 !!===================================================================== 568 571 END MODULE istate 569
Note: See TracChangeset
for help on using the changeset viewer.
