Changeset 4990 for trunk/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90
- Timestamp:
- 2014-12-15T17:42:49+01:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90
r4370 r4990 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) … … 73 74 !!---------------------------------------------------------------------- 74 75 ! 75 IF( nn_timing == 1 ) CALL timing_start('istate_init')76 ! 77 78 IF(lwp) WRITE(numout,*) 76 IF( nn_timing == 1 ) CALL timing_start('istate_init') 77 ! 78 79 IF(lwp) WRITE(numout,*) ' ' 79 80 IF(lwp) WRITE(numout,*) 'istate_ini : Initialization of the dynamics and tracers' 80 81 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' … … 83 84 IF( lk_c1d ) CALL dta_uvd_init ! Initialization of U & V input data 84 85 85 rhd (:,:,: ) = 0.e0 86 rhop (:,:,: ) = 0.e0 87 rn2 (:,:,: ) = 0.e0 88 tsa (:,:,:,:) = 0.e0 86 rhd (:,:,: ) = 0._wp 87 rhop (:,:,: ) = 0._wp 88 rn2 (:,:,: ) = 0._wp 89 tsa (:,:,:,:) = 0._wp 90 rab_b(:,:,:,:) = 0._wp 91 rab_n(:,:,:,:) = 0._wp 89 92 90 93 IF( ln_rstart ) THEN ! Restart from a file … … 110 113 ELSEIF( cp_cfg == 'gyre' ) THEN 111 114 CALL istate_gyre ! GYRE configuration : start from pre-defined T-S fields 115 ELSEIF( cp_cfg == 'isomip' .OR. cp_cfg == 'isomip2') THEN 116 IF(lwp) WRITE(numout,*) 'Initialization of T+S for ISOMIP domain' 117 tsn(:,:,:,jp_tem)=-1.9*tmask(:,:,:) ! ISOMIP configuration : start from constant T+S fields 118 tsn(:,:,:,jp_sal)=34.4*tmask(:,:,:) 119 tsb(:,:,:,:)=tsn(:,:,:,:) 112 120 ELSE ! Initial T-S, U-V fields read in files 113 121 IF ( ln_tsd_init ) THEN ! read 3D T and S data at nit000 … … 129 137 CALL eos( tsb, rhd, rhop, gdept_0(:,:,:) ) ! before potential and in situ densities 130 138 #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 139 IF( ln_zps ) CALL zps_hde( nit000, jpts, tsb, gtsu, gtsv, & ! Partial steps: before horizontal gradient 140 & rhd, gru , grv, aru, arv, gzu, gzv, ge3ru, ge3rv, & ! 141 & gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi ) ! of t, s, rd at the last ocean level 133 142 #endif 134 143 ! … … 162 171 ! 163 172 DO jk = 1, jpkm1 164 #if defined key_vectopt_loop165 DO jj = 1, 1 !Vector opt. => forced unrolling166 DO ji = 1, jpij167 #else168 173 DO jj = 1, jpj 169 174 DO ji = 1, jpi 170 #endif171 175 un_b(ji,jj) = un_b(ji,jj) + fse3u_n(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk) 172 176 vn_b(ji,jj) = vn_b(ji,jj) + fse3v_n(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk) … … 185 189 ! 186 190 ! 187 IF( nn_timing == 1 ) CALL timing_stop('istate_init')191 IF( nn_timing == 1 ) CALL timing_stop('istate_init') 188 192 ! 189 193 END SUBROUTINE istate_init 194 190 195 191 196 SUBROUTINE istate_t_s … … 219 224 END SUBROUTINE istate_t_s 220 225 226 221 227 SUBROUTINE istate_eel 222 228 !!---------------------------------------------------------------------- … … 233 239 USE divcur ! hor. divergence & rel. vorticity (div_cur routine) 234 240 USE iom 235 241 ! 236 242 INTEGER :: inum ! temporary logical unit 237 243 INTEGER :: ji, jj, jk ! dummy loop indices … … 244 250 REAL(wp), DIMENSION(jpiglo,jpjglo) :: zssh ! initial ssh over the global domain 245 251 !!---------------------------------------------------------------------- 246 252 ! 247 253 SELECT CASE ( jp_cfg ) 248 254 ! ! ==================== … … 375 381 INTEGER, PARAMETER :: ntsinit = 0 ! (0/1) (analytical/input data files) T&S initialization 376 382 !!---------------------------------------------------------------------- 377 383 ! 378 384 SELECT CASE ( ntsinit) 379 385 ! 380 386 CASE ( 0 ) ! analytical T/S profil deduced from LEVITUS 381 387 IF(lwp) WRITE(numout,*) 382 388 IF(lwp) WRITE(numout,*) 'istate_gyre : initial analytical T and S profil deduced from LEVITUS ' 383 389 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 384 390 ! 385 391 DO jk = 1, jpk 386 392 DO jj = 1, jpj … … 407 413 END DO 408 414 END DO 409 415 ! 410 416 CASE ( 1 ) ! T/S data fields read in dta_tem.nc/data_sal.nc files 411 417 IF(lwp) WRITE(numout,*) … … 431 437 tsn(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) * tmask(:,:,:) 432 438 tsb(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) 433 439 ! 434 440 END SELECT 435 441 ! 436 442 IF(lwp) THEN 437 443 WRITE(numout,*) … … 440 446 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 447 ENDIF 442 448 ! 443 449 END SUBROUTINE istate_gyre 450 444 451 445 452 SUBROUTINE istate_uvg … … 457 464 USE divcur ! hor. divergence & rel. vorticity (div_cur routine) 458 465 USE lbclnk ! ocean lateral boundary condition (or mpp link) 459 466 ! 460 467 INTEGER :: ji, jj, jk ! dummy loop indices 461 468 INTEGER :: indic ! ??? … … 567 574 !!===================================================================== 568 575 END MODULE istate 569
Note: See TracChangeset
for help on using the changeset viewer.