Changeset 3294 for trunk/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90
- Timestamp:
- 2012-01-28T17:44:18+01:00 (12 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90 (modified) (21 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90
r2777 r3294 13 13 !! 2.0 ! 2006-07 (S. Masson) distributed restart using iom 14 14 !! 3.3 ! 2010-10 (C. Ethe) merge TRC-TRA 15 !! 3.4 ! 2011-04 (G. Madec) Merge of dtatem and dtasal & suppression of tb,tn/sb,sn 15 16 !!---------------------------------------------------------------------- 16 17 … … 30 31 USE zdf_oce ! ocean vertical physics 31 32 USE phycst ! physical constants 32 USE dtatem ! temperature data (dta_tem routine) 33 USE dtasal ! salinity data (dta_sal routine) 33 USE dtatsd ! data temperature and salinity (dta_tsd routine) 34 34 USE restart ! ocean restart (rst_read routine) 35 35 USE in_out_manager ! I/O manager … … 42 42 USE dynspg_exp ! pressure gradient schemes 43 43 USE dynspg_ts ! pressure gradient schemes 44 USE traswp ! Swap arrays (tra_swp routine)45 44 USE lib_mpp ! MPP library 45 USE wrk_nemo ! Memory allocation 46 USE timing ! Timing 46 47 47 48 IMPLICIT NONE … … 68 69 ! - ML - needed for initialization of e3t_b 69 70 INTEGER :: jk ! dummy loop indice 71 !!---------------------------------------------------------------------- 72 ! 73 IF( nn_timing == 1 ) CALL timing_start('istate_init') 74 ! 70 75 71 76 IF(lwp) WRITE(numout,*) … … 73 78 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 74 79 75 rhd (:,:,:) = 0.e0 76 rhop (:,:,:) = 0.e0 77 rn2 (:,:,:) = 0.e0 78 ta (:,:,:) = 0.e0 79 sa (:,:,:) = 0.e0 80 CALL dta_tsd_init ! Initialisation of T & S input data 81 82 rhd (:,:,: ) = 0.e0 83 rhop (:,:,: ) = 0.e0 84 rn2 (:,:,: ) = 0.e0 85 tsa (:,:,:,:) = 0.e0 80 86 81 87 IF( ln_rstart ) THEN ! Restart from a file … … 83 89 neuler = 1 ! Set time-step indicator at nit000 (leap-frog) 84 90 CALL rst_read ! Read the restart file 85 CALL tra_swap ! swap 3D arrays (t,s) in a 4D array (ts) 91 ! ! define e3u_b, e3v_b from e3t_b read in restart file 92 CALL dom_vvl_2( nit000, fse3u_b(:,:,:), fse3v_b(:,:,:) ) 86 93 CALL day_init ! model calendar (using both namelist and restart infos) 87 94 ELSE … … 92 99 CALL day_init ! model calendar (using both namelist and restart infos) 93 100 ! ! Initialization of ocean to zero 94 ! before fields ! now fields 95 sshb (:,:) = 0.e0 ; sshn (:,:) = 0.e0 96 ub (:,:,:) = 0.e0 ; un (:,:,:) = 0.e0 97 vb (:,:,:) = 0.e0 ; vn (:,:,:) = 0.e0 98 rotb (:,:,:) = 0.e0 ; rotn (:,:,:) = 0.e0 99 hdivb(:,:,:) = 0.e0 ; hdivn(:,:,:) = 0.e0 101 ! before fields ! now fields 102 sshb (:,:) = 0._wp ; sshn (:,:) = 0._wp 103 ub (:,:,:) = 0._wp ; un (:,:,:) = 0._wp 104 vb (:,:,:) = 0._wp ; vn (:,:,:) = 0._wp 105 rotb (:,:,:) = 0._wp ; rotn (:,:,:) = 0._wp 106 hdivb(:,:,:) = 0._wp ; hdivn(:,:,:) = 0._wp 107 ! 108 ! ! define e3u_b, e3v_b from e3t_b initialized in domzgr 109 CALL dom_vvl_2( nit000, fse3u_b(:,:,:), fse3v_b(:,:,:) ) 100 110 ! 101 111 IF( cp_cfg == 'eel' ) THEN … … 103 113 ELSEIF( cp_cfg == 'gyre' ) THEN 104 114 CALL istate_gyre ! GYRE configuration : start from pre-defined T-S fields 105 ELSE 106 ! ! Other configurations: Initial T-S fields 107 #if defined key_dtatem 108 CALL dta_tem( nit000 ) ! read 3D temperature data 109 tb(:,:,:) = t_dta(:,:,:) ; tn(:,:,:) = t_dta(:,:,:) 110 111 #else 112 IF(lwp) WRITE(numout,*) ! analytical temperature profile 113 IF(lwp) WRITE(numout,*)' Temperature initialization using an analytic profile' 114 CALL istate_tem 115 #endif 116 #if defined key_dtasal 117 CALL dta_sal( nit000 ) ! read 3D salinity data 118 sb(:,:,:) = s_dta(:,:,:) ; sn(:,:,:) = s_dta(:,:,:) 119 #else 120 ! No salinity data 121 IF(lwp)WRITE(numout,*) ! analytical salinity profile 122 IF(lwp)WRITE(numout,*)' Salinity initialisation using a constant value' 123 CALL istate_sal 124 #endif 115 ELSEIF( ln_tsd_init ) THEN ! Initial T-S fields read in files 116 CALL dta_tsd( nit000, tsb ) ! read 3D T and S data at nit000 117 tsn(:,:,:,:) = tsb(:,:,:,:) 118 ! 119 ELSE ! Initial T-S fields defined analytically 120 CALL istate_t_s 125 121 ENDIF 126 122 ! 127 CALL tra_swap ! swap 3D arrays (tb,sb,tn,sn) in a 4D array128 123 CALL eos( tsb, rhd, rhop ) ! before potential and in situ densities 129 124 #if ! defined key_c1d … … 148 143 ENDIF 149 144 ! 145 IF( nn_timing == 1 ) CALL timing_stop('istate_init') 146 ! 150 147 END SUBROUTINE istate_init 151 148 152 153 SUBROUTINE istate_tem 149 SUBROUTINE istate_t_s 154 150 !!--------------------------------------------------------------------- 155 !! *** ROUTINE istate_t em***151 !! *** ROUTINE istate_t_s *** 156 152 !! 157 153 !! ** Purpose : Intialization of the temperature field with an 158 154 !! analytical profile or a file (i.e. in EEL configuration) 159 155 !! 160 !! ** Method : Use Philander analytic profile of temperature 156 !! ** Method : - temperature: use Philander analytic profile 157 !! - salinity : use to a constant value 35.5 161 158 !! 162 159 !! References : Philander ??? 163 160 !!---------------------------------------------------------------------- 164 INTEGER :: ji, jj, jk 161 INTEGER :: ji, jj, jk 162 REAL(wp) :: zsal = 35.50 165 163 !!---------------------------------------------------------------------- 166 164 ! 167 165 IF(lwp) WRITE(numout,*) 168 IF(lwp) WRITE(numout,*) 'istate_t em :initial temperature profile'169 IF(lwp) WRITE(numout,*) '~~~~~~~~~~ '166 IF(lwp) WRITE(numout,*) 'istate_t_s : Philander s initial temperature profile' 167 IF(lwp) WRITE(numout,*) '~~~~~~~~~~ and constant salinity (',zsal,' psu)' 170 168 ! 171 169 DO jk = 1, jpk 172 DO jj = 1, jpj 173 DO ji = 1, jpi 174 tn(ji,jj,jk) = ( ( ( 7.5 - 0.*ABS(gphit(ji,jj))/30. ) & 175 & *( 1.-TANH((fsdept(ji,jj,jk)-80.)/30.) ) & 176 & + 10.*(5000.-fsdept(ji,jj,jk))/5000.) ) * tmask(ji,jj,jk) 177 tb(ji,jj,jk) = tn(ji,jj,jk) 178 END DO 179 END DO 170 tsn(:,:,jk,jp_tem) = ( ( ( 7.5 - 0. * ABS( gphit(:,:) )/30. ) * ( 1.-TANH((fsdept(:,:,jk)-80.)/30.) ) & 171 & + 10. * ( 5000. - fsdept(:,:,jk) ) /5000.) ) * tmask(:,:,jk) 172 tsb(:,:,jk,jp_tem) = tsn(:,:,jk,jp_tem) 180 173 END DO 181 ! 182 IF(lwp) CALL prizre( tn , jpi , jpj , jpk , jpj/2 , & 183 & 1 , jpi , 5 , 1 , jpk , & 184 & 1 , 1. , numout ) 185 ! 186 END SUBROUTINE istate_tem 187 188 189 SUBROUTINE istate_sal 190 !!--------------------------------------------------------------------- 191 !! *** ROUTINE istate_sal *** 192 !! 193 !! ** Purpose : Intialize the salinity field with an analytic profile 194 !! 195 !! ** Method : Use to a constant value 35.5 196 !! 197 !! ** Action : Initialize sn and sb 198 !!---------------------------------------------------------------------- 199 REAL(wp) :: zsal = 35.50_wp 200 !!---------------------------------------------------------------------- 201 ! 202 IF(lwp) WRITE(numout,*) 203 IF(lwp) WRITE(numout,*) 'istate_sal : initial salinity : ', zsal 204 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 205 ! 206 sn(:,:,:) = zsal * tmask(:,:,:) 207 sb(:,:,:) = sn(:,:,:) 208 ! 209 END SUBROUTINE istate_sal 174 tsn(:,:,:,jp_sal) = zsal * tmask(:,:,:) 175 tsb(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) 176 ! 177 END SUBROUTINE istate_t_s 210 178 211 179 … … 254 222 ! 255 223 DO jk = 1, jpk 256 t n(:,:,jk) = ( zt2 + zt1 * exp( - fsdept(:,:,jk) / 1000 ) ) * tmask(:,:,jk)257 t b(:,:,jk) = tn(:,:,jk)224 tsn(:,:,jk,jp_tem) = ( zt2 + zt1 * exp( - fsdept(:,:,jk) / 1000 ) ) * tmask(:,:,jk) 225 tsb(:,:,jk,jp_tem) = tsn(:,:,jk,jp_tem) 258 226 END DO 259 227 ! 260 IF(lwp) CALL prizre( t n, jpi , jpj , jpk , jpj/2 , &261 & 1 , jpi , 5 , 1 , jpk , &262 & 1 , 1. , numout )228 IF(lwp) CALL prizre( tsn(:,:,:,jp_tem), jpi , jpj , jpk , jpj/2 , & 229 & 1 , jpi , 5 , 1 , jpk , & 230 & 1 , 1. , numout ) 263 231 ! 264 232 ! set salinity field to a constant value … … 268 236 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 269 237 ! 270 sn(:,:,:) = zsal * tmask(:,:,:)271 sb(:,:,:) = sn(:,:,:)238 tsn(:,:,:,jp_sal) = zsal * tmask(:,:,:) 239 tsb(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) 272 240 ! 273 241 ! set the dynamics: U,V, hdiv, rot (and ssh if necessary) … … 323 291 ! 324 292 CALL iom_open ( 'eel.initemp', inum ) 325 CALL iom_get ( inum, jpdom_data, 'initemp', t b) ! read before temprature (tb)293 CALL iom_get ( inum, jpdom_data, 'initemp', tsb(:,:,:,jp_tem) ) ! read before temprature (tb) 326 294 CALL iom_close( inum ) 327 295 ! 328 t n(:,:,:) = tb(:,:,:) ! set nox temperature to tb329 ! 330 IF(lwp) CALL prizre( t n, jpi , jpj , jpk , jpj/2 , &331 & 1 , jpi , 5 , 1 , jpk , &332 & 1 , 1. , numout )296 tsn(:,:,:,jp_tem) = tsb(:,:,:,jp_tem) ! set nox temperature to tb 297 ! 298 IF(lwp) CALL prizre( tsn(:,:,:,jp_tem), jpi , jpj , jpk , jpj/2 , & 299 & 1 , jpi , 5 , 1 , jpk , & 300 & 1 , 1. , numout ) 333 301 ! 334 302 ! set salinity field to a constant value … … 338 306 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 339 307 ! 340 sn(:,:,:) = zsal * tmask(:,:,:)341 sb(:,:,:) = sn(:,:,:)308 tsn(:,:,:,jp_sal) = zsal * tmask(:,:,:) 309 tsb(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) 342 310 ! 343 311 ! ! =========================== … … 377 345 DO jj = 1, jpj 378 346 DO ji = 1, jpi 379 t n(ji,jj,jk) = ( 16. - 12. * TANH( (fsdept(ji,jj,jk) - 400) / 700 ) ) &347 tsn(ji,jj,jk,jp_tem) = ( 16. - 12. * TANH( (fsdept(ji,jj,jk) - 400) / 700 ) ) & 380 348 & * (-TANH( (500-fsdept(ji,jj,jk)) / 150 ) + 1) / 2 & 381 349 & + ( 15. * ( 1. - TANH( (fsdept(ji,jj,jk)-50.) / 1500.) ) & … … 383 351 & + 7. * (1500. - fsdept(ji,jj,jk)) / 1500. ) & 384 352 & * (-TANH( (fsdept(ji,jj,jk) - 500) / 150) + 1) / 2 385 t n(ji,jj,jk) = tn(ji,jj,jk) * tmask(ji,jj,jk)386 t b(ji,jj,jk) = tn(ji,jj,jk)387 388 sn(ji,jj,jk) = ( 36.25 - 1.13 * TANH( (fsdept(ji,jj,jk) - 305) / 460 ) ) &353 tsn(ji,jj,jk,jp_tem) = tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk) 354 tsb(ji,jj,jk,jp_tem) = tsn(ji,jj,jk,jp_tem) 355 356 tsn(ji,jj,jk,jp_sal) = ( 36.25 - 1.13 * TANH( (fsdept(ji,jj,jk) - 305) / 460 ) ) & 389 357 & * (-TANH((500 - fsdept(ji,jj,jk)) / 150) + 1) / 2 & 390 358 & + ( 35.55 + 1.25 * (5000. - fsdept(ji,jj,jk)) / 5000. & … … 393 361 & + 0.2 * TANH( (fsdept(ji,jj,jk) - 1000.) / 5000.) ) & 394 362 & * (-TANH((fsdept(ji,jj,jk) - 500) / 150) + 1) / 2 395 sn(ji,jj,jk) = sn(ji,jj,jk) * tmask(ji,jj,jk)396 sb(ji,jj,jk) = sn(ji,jj,jk)363 tsn(ji,jj,jk,jp_sal) = tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 364 tsb(ji,jj,jk,jp_sal) = tsn(ji,jj,jk,jp_sal) 397 365 END DO 398 366 END DO … … 408 376 ! ---------------------- 409 377 CALL iom_open ( 'data_tem', inum ) 410 CALL iom_get ( inum, jpdom_data, 'votemper', t n)378 CALL iom_get ( inum, jpdom_data, 'votemper', tsn(:,:,:,jp_tem) ) 411 379 CALL iom_close( inum ) 412 380 413 t n(:,:,:) = tn(:,:,:) * tmask(:,:,:)414 t b(:,:,:) = tn(:,:,:)381 tsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) * tmask(:,:,:) 382 tsb(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) 415 383 416 384 ! Read salinity field 417 385 ! ------------------- 418 386 CALL iom_open ( 'data_sal', inum ) 419 CALL iom_get ( inum, jpdom_data, 'vosaline', sn)387 CALL iom_get ( inum, jpdom_data, 'vosaline', tsn(:,:,:,jp_sal) ) 420 388 CALL iom_close( inum ) 421 389 422 sn(:,:,:) = sn(:,:,:) * tmask(:,:,:)423 sb(:,:,:) = sn(:,:,:)390 tsn(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) * tmask(:,:,:) 391 tsb(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) 424 392 425 393 END SELECT … … 429 397 WRITE(numout,*) ' Initial temperature and salinity profiles:' 430 398 WRITE(numout, "(9x,' level gdept_0 temperature salinity ')" ) 431 WRITE(numout, "(10x, i4, 3f10.2)" ) ( jk, gdept_0(jk), t n(2,2,jk), sn(2,2,jk), jk = 1, jpk )399 WRITE(numout, "(10x, i4, 3f10.2)" ) ( jk, gdept_0(jk), tsn(2,2,jk,jp_tem), tsn(2,2,jk,jp_sal), jk = 1, jpk ) 432 400 ENDIF 433 401 … … 446 414 !! p=integral [ rau*g dz ] 447 415 !!---------------------------------------------------------------------- 448 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released449 USE wrk_nemo, ONLY: zprn => wrk_3d_1 ! 3D workspace450 451 416 USE dynspg ! surface pressure gradient (dyn_spg routine) 452 417 USE divcur ! hor. divergence & rel. vorticity (div_cur routine) … … 456 421 INTEGER :: indic ! ??? 457 422 REAL(wp) :: zmsv, zphv, zmsu, zphu, zalfg ! temporary scalars 458 !!---------------------------------------------------------------------- 459 460 IF(wrk_in_use(3, 1) ) THEN 461 CALL ctl_stop('istate_uvg: requested workspace array unavailable') ; RETURN 462 ENDIF 463 423 REAL(wp), POINTER, DIMENSION(:,:,:) :: zprn 424 !!---------------------------------------------------------------------- 425 ! 426 CALL wrk_alloc( jpi, jpj, jpk, zprn) 427 ! 464 428 IF(lwp) WRITE(numout,*) 465 429 IF(lwp) WRITE(numout,*) 'istate_uvg : Start from Geostrophy' … … 557 521 rotb (:,:,:) = rotn (:,:,:) ! set the before to the now value 558 522 ! 559 IF( wrk_not_released(3, 1) ) THEN 560 CALL ctl_stop('istate_uvg: failed to release workspace array') 561 ENDIF 523 CALL wrk_dealloc( jpi, jpj, jpk, zprn) 562 524 ! 563 525 END SUBROUTINE istate_uvg
Note: See TracChangeset
for help on using the changeset viewer.
