Changeset 2715 for trunk/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90
- Timestamp:
- 2011-03-30T17:58:35+02:00 (13 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90 (modified) (12 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90
r2528 r2715 33 33 USE dom_oce ! ocean space and time domain 34 34 USE phycst ! physical constants 35 USE zdfddm ! vertical physics: double diffusion 35 36 USE in_out_manager ! I/O manager 36 USE zdfddm ! vertical physics: double diffusion37 USE lib_mpp ! MPP library 37 38 USE prtctl ! Print control 38 39 … … 107 108 !! References : Jackett and McDougall, J. Atmos. Ocean. Tech., 1994 108 109 !!---------------------------------------------------------------------- 109 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celcius] 110 ! ! 2 : salinity [psu] 111 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: prd ! in situ density 110 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 111 USE wrk_nemo, ONLY: zws => wrk_3d_1 ! 3D workspace 112 !! 113 REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pts ! 1 : potential temperature [Celcius] 114 ! ! 2 : salinity [psu] 115 REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: prd ! in situ density [-] 112 116 !! 113 117 INTEGER :: ji, jj, jk ! dummy loop indices 114 REAL(wp) :: zt , zs , zh , zsr ! temporary scalars 115 REAL(wp) :: zr1, zr2, zr3, zr4 ! - - 116 REAL(wp) :: zrhop, ze, zbw, zb ! - - 117 REAL(wp) :: zd , zc , zaw, za ! - - 118 REAL(wp) :: zb1, za1, zkw, zk0 ! - - 119 REAL(wp) :: zrau0r ! - - 120 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zws ! temporary workspace 121 !!---------------------------------------------------------------------- 118 REAL(wp) :: zt , zs , zh , zsr ! local scalars 119 REAL(wp) :: zr1, zr2, zr3, zr4 ! - - 120 REAL(wp) :: zrhop, ze, zbw, zb ! - - 121 REAL(wp) :: zd , zc , zaw, za ! - - 122 REAL(wp) :: zb1, za1, zkw, zk0 ! - - 123 REAL(wp) :: zrau0r ! - - 124 !!---------------------------------------------------------------------- 125 126 IF( wrk_in_use(3, 1) ) THEN 127 CALL ctl_stop('eos_insitu: requested workspace array unavailable') ; RETURN 128 ENDIF 122 129 123 130 SELECT CASE( nn_eos ) … … 183 190 ! 184 191 IF(ln_ctl) CALL prt_ctl( tab3d_1=prd, clinfo1=' eos : ', ovlap=1, kdim=jpk ) 192 ! 193 IF( wrk_not_released(3, 1) ) CALL ctl_stop('eos_insitu: failed to release workspace array') 185 194 ! 186 195 END SUBROUTINE eos_insitu … … 233 242 !! Brown and Campana, Mon. Weather Rev., 1978 234 243 !!---------------------------------------------------------------------- 235 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celcius] 236 ! ! 2 : salinity [psu] 237 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( out) :: prd ! in situ density 244 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 245 USE wrk_nemo, ONLY: zws => wrk_3d_1 ! 3D workspace 246 !! 247 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celcius] 248 ! ! 2 : salinity [psu] 249 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( out) :: prd ! in situ density [-] 238 250 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( out) :: prhop ! potential density (surface referenced) 239 251 ! 240 252 INTEGER :: ji, jj, jk ! dummy loop indices 241 REAL(wp) :: zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw ! temporary scalars 242 REAL(wp) :: zb, zd, zc, zaw, za, zb1, za1, zkw, zk0, zrau0r ! - - 243 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zws ! 3D workspace 244 !!---------------------------------------------------------------------- 253 REAL(wp) :: zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw ! local scalars 254 REAL(wp) :: zb, zd, zc, zaw, za, zb1, za1, zkw, zk0, zrau0r ! - - 255 !!---------------------------------------------------------------------- 256 257 IF( wrk_in_use(3, 1) ) THEN 258 CALL ctl_stop('eos_insitu_pot: requested workspace array unavailable') ; RETURN 259 ENDIF 245 260 246 261 SELECT CASE ( nn_eos ) … … 311 326 ! 312 327 IF(ln_ctl) CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-p: ', tab3d_2=prhop, clinfo2=' pot : ', ovlap=1, kdim=jpk ) 328 ! 329 IF( wrk_not_released(3, 1) ) CALL ctl_stop('eos_insitu_pot: failed to release workspace array') 313 330 ! 314 331 END SUBROUTINE eos_insitu_pot … … 351 368 !! References : Jackett and McDougall, J. Atmos. Ocean. Tech., 1994 352 369 !!---------------------------------------------------------------------- 370 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 371 USE wrk_nemo, ONLY: zws => wrk_2d_5 ! 2D workspace 372 !! 353 373 REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celcius] 354 374 ! ! 2 : salinity [psu] … … 359 379 REAL(wp) :: zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw ! temporary scalars 360 380 REAL(wp) :: zb, zd, zc, zaw, za, zb1, za1, zkw, zk0, zmask ! - - 361 REAL(wp), DIMENSION(jpi,jpj) :: zws ! 2D workspace 362 !!---------------------------------------------------------------------- 363 364 prd(:,:) = 0.e0 381 !!---------------------------------------------------------------------- 382 383 IF( wrk_in_use(2, 5) ) THEN 384 CALL ctl_stop('eos_insitu_2d: requested workspace array unavailable') ; RETURN 385 ENDIF 386 387 prd(:,:) = 0._wp 365 388 366 389 SELECT CASE( nn_eos ) … … 434 457 IF(ln_ctl) CALL prt_ctl( tab2d_1=prd, clinfo1=' eos2d: ' ) 435 458 ! 459 IF( wrk_not_released(2, 5) ) CALL ctl_stop('eos_insitu_2d: failed to release workspace array') 460 ! 436 461 END SUBROUTINE eos_insitu_2d 437 462 … … 469 494 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celcius] 470 495 ! ! 2 : salinity [psu] 471 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pn2 ! Brunt-Vaisala frequency[s-1]496 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pn2 ! Brunt-Vaisala frequency [s-1] 472 497 !! 473 498 INTEGER :: ji, jj, jk ! dummy loop indices 474 REAL(wp) :: zgde3w, zt, zs, zh, zalbet, zbeta ! temporaryscalars499 REAL(wp) :: zgde3w, zt, zs, zh, zalbet, zbeta ! local scalars 475 500 #if defined key_zdfddm 476 REAL(wp) :: zds ! temporaryscalars501 REAL(wp) :: zds ! local scalars 477 502 #endif 478 503 !!---------------------------------------------------------------------- … … 488 513 DO ji = 1, jpi 489 514 zgde3w = grav / fse3w(ji,jj,jk) 490 zt = 0.5 * ( pts(ji,jj,jk,jp_tem) + pts(ji,jj,jk-1,jp_tem) ) ! potential temperature at w-point491 zs = 0.5 * ( pts(ji,jj,jk,jp_sal) + pts(ji,jj,jk-1,jp_sal) ) - 35.0 ! salinity anomaly (s-35) at w-point492 zh = fsdepw(ji,jj,jk) ! depth in meters at w-point515 zt = 0.5 * ( pts(ji,jj,jk,jp_tem) + pts(ji,jj,jk-1,jp_tem) ) ! potential temperature at w-pt 516 zs = 0.5 * ( pts(ji,jj,jk,jp_sal) + pts(ji,jj,jk-1,jp_sal) ) - 35.0 ! salinity anomaly (s-35) at w-pt 517 zh = fsdepw(ji,jj,jk) ! depth in meters at w-point 493 518 ! 494 519 zalbet = ( ( ( - 0.255019e-07_wp * zt + 0.298357e-05_wp ) * zt & ! ratio alpha/beta … … 586 611 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature & salinity 587 612 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: palph, pbeta ! thermal & haline expansion coeff. 588 ! !613 ! 589 614 INTEGER :: ji, jj, jk ! dummy loop indices 590 615 REAL(wp) :: zt, zs, zh ! local scalars … … 661 686 !!---------------------------------------------------------------------- 662 687 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: psal ! salinity [psu] 688 ! Leave result array automatic rather than making explicitly allocated 663 689 REAL(wp), DIMENSION(jpi,jpj) :: ptf ! freezing temperature [Celcius] 664 690 !!----------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.
