Changeset 703
- Timestamp:
- 2007-10-10T10:14:32+02:00 (16 years ago)
- Location:
- trunk/NEMO/OPA_SRC
- Files:
-
- 6 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/DOM/closea.F90
r699 r703 2 2 !!====================================================================== 3 3 !! *** MODULE closea *** 4 !! Closed Seas : 4 !! Closed Seas : specific treatments associated with closed seas 5 5 !!====================================================================== 6 !! History : 8.2 ! 00-05 (O. Marti) Original code 7 !! 8.5 ! 02-06 (E. Durand, G. Madec) F90 8 !! 9.0 ! 06-07 (G. Madec) add clo_rnf, clo_ups, clo_bat 9 !!---------------------------------------------------------------------- 6 10 7 11 !!---------------------------------------------------------------------- 8 12 !! dom_clo : modification of the ocean domain for closed seas cases 9 !! flx_clo : Special handling of closed seas 10 !!---------------------------------------------------------------------- 11 !! * Modules used 13 !! sbc_clo : Special handling of closed seas 14 !! clo_rnf : set close sea outflows as river mouths (see sbcrnf) 15 !! clo_ups : set mixed centered/upstream scheme in closed sea (see traadv_cen2) 16 !! clo_bat : set to zero a field over closed sea (see domzrg) 17 !!---------------------------------------------------------------------- 12 18 USE oce ! dynamics and tracers 13 19 USE dom_oce ! ocean space and time domain 14 20 USE in_out_manager ! I/O manager 15 USE ocesbc ! ocean surface boundary conditions (fluxes) 16 USE flxrnf ! runoffs 21 USE sbc_oce ! ocean surface boundary conditions 17 22 USE lib_mpp ! distributed memory computing library 18 23 USE lbclnk ! ??? … … 21 26 PRIVATE 22 27 23 !! * Accessibility 24 PUBLIC dom_clo ! routine called by dom_init 25 PUBLIC flx_clo ! routine called by step 26 27 !! * Share module variables 28 INTEGER, PUBLIC, PARAMETER :: & !: 29 jpncs = 4 !: number of closed sea 30 INTEGER, PUBLIC :: & !!: namclo : closed seas and lakes 31 nclosea = 0 !: = 0 no closed sea or lake 32 ! ! = 1 closed sea or lake in the domain 33 INTEGER, PUBLIC, DIMENSION (jpncs) :: & !: 34 ncstt, & !: Type of closed sea 35 ncsi1, ncsj1, & !: closed sea limits 36 ncsi2, ncsj2, & !: 37 ncsnr !: number of point where run-off pours 38 INTEGER, PUBLIC, DIMENSION (jpncs,4) :: & 39 ncsir, ncsjr !: Location of run-off 40 41 !! * Module variable 42 REAL(wp), DIMENSION (jpncs+1) :: & 43 surf ! closed sea surface 28 PUBLIC dom_clo ! routine called by domain module 29 PUBLIC sbc_clo ! routine called by step module 30 PUBLIC clo_rnf ! routine called by sbcrnf module 31 PUBLIC clo_ups ! routine called in traadv_cen2(_jki) module 32 PUBLIC clo_bat ! routine called in domzgr module 33 34 !!* Namelist namclo : closed seas and lakes 35 INTEGER, PUBLIC :: nclosea = 0 !: = 0 no closed sea or lake 36 ! ! = 1 closed sea or lake in the domain 37 38 INTEGER, PUBLIC, PARAMETER :: jpncs = 4 !: number of closed sea 39 INTEGER, PUBLIC, DIMENSION(jpncs) :: ncstt !: Type of closed sea 40 INTEGER, PUBLIC, DIMENSION(jpncs) :: ncsi1, ncsj1 !: south-west closed sea limits (i,j) 41 INTEGER, PUBLIC, DIMENSION(jpncs) :: ncsi2, ncsj2 !: north-east closed sea limits (i,j) 42 INTEGER, PUBLIC, DIMENSION(jpncs) :: ncsnr !: number of point where run-off pours 43 INTEGER, PUBLIC, DIMENSION(jpncs,4) :: ncsir, ncsjr !: Location of runoff 44 45 REAL(wp), DIMENSION (jpncs+1) :: surf ! closed sea surface 44 46 45 47 !! * Substitutions 46 48 # include "vectopt_loop_substitute.h90" 47 49 !!---------------------------------------------------------------------- 48 !! OPA 9.0 , LOCEAN-IPSL (200 5)50 !! OPA 9.0 , LOCEAN-IPSL (2006) 49 51 !! $Id$ 50 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt52 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 51 53 !!---------------------------------------------------------------------- 52 54 … … 60 62 !! 61 63 !! ** Method : if a closed sea is located only in a model grid point 62 !! just the thermodynamic processes are applied. 63 !! 64 !! ** Action : ncsi1(), ncsj1() : south-west closed sea limits (i,j) 65 !! ncsi2(), ncsj2() : north-east Closed sea limits (i,j) 66 !! ncsir(), ncsjr() : Location of runoff 67 !! ncsnr : number of point where run-off pours 68 !! ncstt : Type of closed sea 69 !! =0 spread over the world ocean 70 !! =2 put at location runoff 71 !! 72 !! History : 73 !! ! 01-04 (E. Durand) Original code 74 !! 8.5 ! 02-06 (G. Madec) F90: Free form and module 75 !!---------------------------------------------------------------------- 76 !! * Local variables 64 !! just the thermodynamic processes are applied. 65 !! 66 !! ** Action : ncsi1(), ncsj1() : south-west closed sea limits (i,j) 67 !! ncsi2(), ncsj2() : north-east Closed sea limits (i,j) 68 !! ncsir(), ncsjr() : Location of runoff 69 !! ncsnr : number of point where run-off pours 70 !! ncstt : Type of closed sea 71 !! =0 spread over the world ocean 72 !! =2 put at location runoff 73 !!---------------------------------------------------------------------- 77 74 INTEGER :: jc ! dummy loop indices 78 75 !!---------------------------------------------------------------------- … … 90 87 91 88 IF( cp_cfg == "orca" ) THEN 92 89 ! 93 90 SELECT CASE ( jp_cfg ) 94 91 ! ! ======================= 95 92 CASE ( 2 ) ! ORCA_R2 configuration 96 93 ! ! ======================= 97 98 94 ! ! Caspian Sea 99 95 ncsnr(1) = 1 ; ncstt(1) = 0 ! spread over the globe … … 116 112 ncsi2(4) = 6 ; ncsj2(4) = 112 117 113 ncsir(4,1) = 171 ; ncsjr(4,1) = 106 118 119 114 ! ! ======================= 120 115 CASE ( 4 ) ! ORCA_R4 configuration 121 116 ! ! ======================= 122 123 117 ! ! Caspian Sea 124 118 ncsnr(1) = 1 ; ncstt(1) = 0 … … 144 138 ncsi2(4) = 76 ; ncsj2(4) = 61 145 139 ncsir(4,1) = 84 ; ncsjr(4,1) = 59 146 147 140 ! ! ======================= 148 141 CASE ( 025 ) ! ORCA_R025 configuration … … 157 150 ncsi2(2) = 1304 ; ncsj2(2) = 747 158 151 ncsir(2,1) = 1 ; ncsjr(2,1) = 1 159 152 ! 160 153 END SELECT 161 154 ! 162 155 ENDIF 163 156 … … 171 164 ncsj2(jc) = mj1( ncsj2(jc) ) 172 165 END DO 173 174 166 ! 175 167 END SUBROUTINE dom_clo 176 168 177 169 178 SUBROUTINE flx_clo( kt )179 !!--------------------------------------------------------------------- 180 !! *** ROUTINE flx_clo ***170 SUBROUTINE sbc_clo( kt ) 171 !!--------------------------------------------------------------------- 172 !! *** ROUTINE sbc_clo *** 181 173 !! 182 174 !! ** Purpose : Special handling of closed seas … … 186 178 !! put as run-off in open ocean. 187 179 !! 188 !! ** Action : 189 !! 190 !! History : 191 !! 8.2 ! 00-05 (O. Marti) Original code 192 !! 8.5 ! 02-07 (G. Madec) Free form, F90 193 !!---------------------------------------------------------------------- 194 !! * Arguments 195 INTEGER, INTENT (in) :: kt 196 197 !! * Local declarations 198 REAL(wp), DIMENSION (jpncs) :: zemp 199 INTEGER :: ji, jj, jc, jn 200 REAL(wp) :: zze2 201 !!---------------------------------------------------------------------- 202 203 ! 1 - Initialisation 204 ! ------------------ 205 206 IF( kt == nit000 ) THEN 180 !! ** Action : emp, emps updated surface freshwater fluxes at kt 181 !!---------------------------------------------------------------------- 182 INTEGER, INTENT(in) :: kt ! ocean model time step 183 ! 184 INTEGER :: ji, jj, jc, jn ! dummy loop indices 185 REAL(wp) :: zze2 186 REAL(wp), DIMENSION (jpncs) :: zemp 187 !!---------------------------------------------------------------------- 188 ! 189 ! !------------------! 190 IF( kt == nit000 ) THEN ! Initialisation ! 191 ! !------------------! 207 192 IF(lwp) WRITE(numout,*) 208 IF(lwp) WRITE(numout,*)' flx_clo : closed seas '193 IF(lwp) WRITE(numout,*)'sbc_clo : closed seas ' 209 194 IF(lwp) WRITE(numout,*)'~~~~~~~' 210 195 … … 216 201 DO jj = ncsj1(jc), ncsj2(jc) 217 202 DO ji = ncsi1(jc), ncsi2(jc) 218 ! surface of closed seas 219 surf(jc) = surf(jc) + e1t(ji,jj)*e2t(ji,jj)*tmask_i(ji,jj) 220 ! upstream in closed seas 221 upsadv(ji,jj) = 0.5 203 surf(jc) = surf(jc) + e1t(ji,jj) * e2t(ji,jj) * tmask_i(ji,jj) ! surface of closed seas 222 204 END DO 223 205 END DO 224 ! upstream at closed sea outflow225 IF( ncstt(jc) >= 1 ) THEN226 DO jn = 1, 4227 ji = mi0( ncsir(jc,jn) )228 jj = mj0( ncsjr(jc,jn) )229 upsrnfh(ji,jj) = MAX( upsrnfh(ji,jj), 1.0 )230 END DO231 ENDIF232 206 END DO 233 207 IF( lk_mpp ) CALL mpp_sum ( surf, jpncs+1 ) ! mpp: sum over all the global domain … … 235 209 IF(lwp) WRITE(numout,*)' Closed sea surfaces' 236 210 DO jc = 1, jpncs 237 IF(lwp) WRITE(numout,FMT='(1I3,4I4,5X,F16.2)') & 238 jc, ncsi1(jc), ncsi2(jc), ncsj1(jc), ncsj2(jc), surf(jc) 211 IF(lwp)WRITE(numout,FMT='(1I3,4I4,5X,F16.2)') jc, ncsi1(jc), ncsi2(jc), ncsj1(jc), ncsj2(jc), surf(jc) 239 212 END DO 240 213 … … 243 216 surf(jpncs+1) = surf(jpncs+1) - surf(jc) 244 217 END DO 245 218 ! 246 219 ENDIF 247 248 ! 2 - Computation 249 ! --------------- 250 zemp = 0.e0 251 220 ! !--------------------! 221 ! ! update emp, emps ! 222 zemp = 0.e0 !--------------------! 252 223 DO jc = 1, jpncs 253 224 DO jj = ncsj1(jc), ncsj2(jc) … … 257 228 END DO 258 229 END DO 259 IF( lk_mpp ) CALL mpp_sum ( zemp , jpncs ) ! mpp: sum over all the global domain230 IF( lk_mpp ) CALL mpp_sum ( zemp(:) , jpncs ) ! mpp: sum over all the global domain 260 231 261 232 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! Black Sea case for ORCA_R2 configuration … … 266 237 267 238 DO jc = 1, jpncs 268 239 ! 269 240 IF( ncstt(jc) == 0 ) THEN 270 241 ! water/evap excess is shared by all open ocean … … 303 274 ENDIF 304 275 ENDIF 305 276 ! 306 277 DO jj = ncsj1(jc), ncsj2(jc) 307 278 DO ji = ncsi1(jc), ncsi2(jc) … … 310 281 END DO 311 282 END DO 312 283 ! 313 284 END DO 314 315 316 ! 5. Boundary condition on emp and emps 317 ! ------------------------------------- 285 ! 318 286 CALL lbc_lnk( emp , 'T', 1. ) 319 287 CALL lbc_lnk( emps, 'T', 1. ) 320 321 END SUBROUTINE flx_clo 288 ! 289 END SUBROUTINE sbc_clo 290 291 292 SUBROUTINE clo_rnf( p_rnfmsk ) 293 !!--------------------------------------------------------------------- 294 !! *** ROUTINE sbc_rnf *** 295 !! 296 !! ** Purpose : allow the treatment of closed sea outflow grid-points 297 !! to be the same as river mouth grid-points 298 !! 299 !! ** Method : set to 1 the runoff mask (mskrnf, see sbcrnf module) 300 !! at the closed sea outflow grid-point. 301 !! 302 !! ** Action : update (p_)mskrnf (set 1 at closed sea outflow) 303 !!---------------------------------------------------------------------- 304 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: p_rnfmsk ! river runoff mask (rnfmsk array) 305 ! 306 INTEGER :: jc, jn ! dummy loop indices 307 INTEGER :: ii, ij ! temporary integer 308 !!---------------------------------------------------------------------- 309 ! 310 DO jc = 1, jpncs 311 IF( ncstt(jc) >= 1 ) THEN ! runoff mask set to 1 at closed sea outflows 312 DO jn = 1, 4 313 ii = mi0( ncsir(jc,jn) ) 314 ij = mj0( ncsjr(jc,jn) ) 315 p_rnfmsk(ii,ij) = MAX( p_rnfmsk(ii,ij), 1.0 ) 316 END DO 317 ENDIF 318 END DO 319 ! 320 END SUBROUTINE clo_rnf 321 322 323 SUBROUTINE clo_ups( p_upsmsk ) 324 !!--------------------------------------------------------------------- 325 !! *** ROUTINE sbc_rnf *** 326 !! 327 !! ** Purpose : allow the treatment of closed sea outflow grid-points 328 !! to be the same as river mouth grid-points 329 !! 330 !! ** Method : set to 0.5 the upstream mask (upsmsk, see traadv_cen2 331 !! module) over the closed seas. 332 !! 333 !! ** Action : update (p_)upsmsk (set 0.5 over closed seas) 334 !!---------------------------------------------------------------------- 335 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: p_upsmsk ! upstream mask (upsmsk array) 336 ! 337 INTEGER :: jc, ji, jj ! dummy loop indices 338 !!---------------------------------------------------------------------- 339 ! 340 DO jc = 1, jpncs 341 DO jj = ncsj1(jc), ncsj2(jc) 342 DO ji = ncsi1(jc), ncsi2(jc) 343 p_upsmsk(ji,jj) = 0.5 ! mixed upstream/centered scheme over closed seas 344 END DO 345 END DO 346 END DO 347 ! 348 END SUBROUTINE clo_ups 349 350 351 SUBROUTINE clo_bat( pbat, kbat ) 352 !!--------------------------------------------------------------------- 353 !! *** ROUTINE clo_bat *** 354 !! 355 !! ** Purpose : suppress closed sea from the domain 356 !! 357 !! ** Method : set to 0 the meter and level bathymetry (given in 358 !! arguments) over the closed seas. 359 !! 360 !! ** Action : set pbat=0 and kbat=0 over closed seas 361 !!---------------------------------------------------------------------- 362 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pbat ! bathymetry in meters (bathy array) 363 INTEGER , DIMENSION(jpi,jpj), INTENT(inout) :: kbat ! bathymetry in levels (mbathy array) 364 ! 365 INTEGER :: jc, ji, jj ! dummy loop indices 366 !!---------------------------------------------------------------------- 367 ! 368 DO jc = 1, jpncs 369 DO jj = ncsj1(jc), ncsj2(jc) 370 DO ji = ncsi1(jc), ncsi2(jc) 371 pbat(ji,jj) = 0.e0 372 kbat(ji,jj) = 0 373 END DO 374 END DO 375 END DO 376 ! 377 END SUBROUTINE clo_bat 322 378 323 379 !!====================================================================== -
trunk/NEMO/OPA_SRC/SBC/albedo.F90
r699 r703 4 4 !! Ocean forcing: bulk thermohaline forcing of the ocean (or ice) 5 5 !!===================================================================== 6 !!---------------------------------------------------------------------- 7 !! flx_blk_albedo : albedo for ocean and ice (clear and overcast skies) 8 !!---------------------------------------------------------------------- 9 !! * Modules used 6 !! History : 8.0 ! 01-04 (LIM 1.0) 7 !! 8.5 ! 03-07 (C. Ethe, G. Madec) Optimization (old name:shine) 8 !! 9.0 ! 04-11 (C. Talandier) add albedo_init 9 !! 9.0 ! 06-08 (G. Madec) cleaning for surface module 10 !!---------------------------------------------------------------------- 11 12 !!---------------------------------------------------------------------- 13 !! blk_albedo : albedo for ocean and ice (clear and overcast skies) 14 !! albedo_init : initialisation 15 !!---------------------------------------------------------------------- 10 16 USE oce ! ocean dynamics and tracers 11 USE dom_oce ! ocean space and time domain12 USE cpl_oce ! ???13 17 USE phycst ! physical constants 14 USE daymod15 USE blk_oce ! bulk variables16 USE flx_oce ! forcings variables17 USE ocfzpt ! ???18 18 USE in_out_manager 19 USE lbclnk20 19 21 20 IMPLICIT NONE 22 21 PRIVATE 23 22 24 !! * Accessibility25 PUBLIC flx_blk_albedo ! routine called by limflx.F90 in coupled 26 ! and in flxblk.F90 in forced27 !! * Module variables 28 INTEGER :: & !: nameos : ocean physical parameters29 albd_init = 0 !: control flag for initialization30 31 REAL(wp) :: & ! constantvalues32 zzero = 0.e0 , &33 zone = 1.034 35 !! * constants for albedo computation (flx_blk_albedo)23 PUBLIC blk_albedo ! routine called by sbcice_lim module 24 25 INTEGER :: albd_init = 0 !: control flag for initialization 26 27 REAL(wp) :: zzero = 0.e0 ! constant values 28 REAL(wp) :: zone = 1.e0 ! " " 29 30 REAL(wp) :: c1 = 0.05 ! constants values 31 REAL(wp) :: c2 = 0.10 ! " " 32 REAL(wp) :: cmue = 0.40 ! cosine of local solar altitude 33 34 !!* namelist namalb 36 35 REAL(wp) :: & 37 c 1 = 0.05 , & ! constants values38 c2 = 0.10 , &36 cgren = 0.06 , & ! correction of the snow or ice albedo to take into account 37 ! ! effects of cloudiness (Grenfell & Perovich, 1984) 39 38 albice = 0.50 , & ! albedo of melting ice in the arctic and antarctic (Shine & Hendersson-Sellers) 40 cgren = 0.06 , & ! correction of the snow or ice albedo to take into account41 ! effects of cloudiness (Grenfell & Perovich, 1984)42 39 alphd = 0.80 , & ! coefficients for linear interpolation used to compute 43 40 alphdi = 0.72 , & ! albedo between two extremes values (Pyane, 1972) 44 alphc = 0.65 , &45 zmue = 0.40 ! cosine of local solar altitude46 47 !!---------------------------------------------------------------------- 48 !! OPA 9.0 , LOCEAN-IPSL (200 5)41 alphc = 0.65 42 NAMELIST/namalb/ cgren, albice, alphd, alphdi, alphc 43 44 !!---------------------------------------------------------------------- 45 !! OPA 9.0 , LOCEAN-IPSL (2006) 49 46 !! $Id$ 50 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt47 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 51 48 !!---------------------------------------------------------------------- 52 49 … … 58 55 !!---------------------------------------------------------------------- 59 56 60 SUBROUTINE flx_blk_albedo( palb , palcn , palbp , palcnp )61 !!---------------------------------------------------------------------- 62 !! *** ROUTINE flx_blk_albedo ***57 SUBROUTINE blk_albedo( palb , palcn , palbp , palcnp ) 58 !!---------------------------------------------------------------------- 59 !! *** ROUTINE blk_albedo *** 63 60 !! 64 61 !! ** Purpose : Computation of the albedo of the snow/ice system 65 !! as well as the ocean one62 !! as well as the ocean one 66 63 !! 67 64 !! ** Method : - Computation of the albedo of snow or ice (choose the 68 !! rignt one by a large number of tests65 !! rignt one by a large number of tests 69 66 !! - Computation of the albedo of the ocean 70 67 !! 71 !! References : 72 !! Shine and Hendersson-Sellers 1985, JGR, 90(D1), 2243-2250. 73 !! 74 !! History : 75 !! 8.0 ! 01-04 (LIM 1.0) 76 !! 8.5 ! 03-07 (C. Ethe, G. Madec) Optimization (old name:shine) 77 !!---------------------------------------------------------------------- 78 !! * Modules used 79 USE ice ! ??? 80 81 !! * Arguments 82 REAL(wp), DIMENSION(jpi,jpj), INTENT(out) :: & 83 palb , & ! albedo of ice under overcast sky 84 palcn , & ! albedo of ocean under overcast sky 85 palbp , & ! albedo of ice under clear sky 86 palcnp ! albedo of ocean under clear sky 87 88 !! * Local variables 89 INTEGER :: & 90 ji, jj ! dummy loop indices 91 REAL(wp) :: & 92 zmue14 , & ! zmue**1.4 68 !! References : Shine and Hendersson-Sellers 1985, JGR, 90(D1), 2243-2250. 69 !!---------------------------------------------------------------------- 70 USE ice ! ??? 71 !! 72 REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: palb ! albedo of ice under overcast sky 73 REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: palcn ! albedo of ocean under overcast sky 74 REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: palbp ! albedo of ice under clear sky 75 REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: palcnp ! albedo of ocean under clear sky 76 !! 77 INTEGER :: ji, jj ! dummy loop indices 78 REAL(wp) :: zcoef, & ! temporary scalar 93 79 zalbpsnm , & ! albedo of ice under clear sky when snow is melting 94 80 zalbpsnf , & ! albedo of ice under clear sky when snow is freezing … … 99 85 zihsc1 , & ! = 1 hsn <= c1 ; = 0 hsn > c1 100 86 zihsc2 ! = 1 hsn >= c2 ; = 0 hsn < c2 101 REAL(wp), DIMENSION(jpi,jpj) :: & 102 zalbfz , & ! ( = alphdi for freezing ice ; = albice for melting ice ) 103 zficeth ! function of ice thickness 104 LOGICAL , DIMENSION(jpi,jpj) :: & 105 llmask 87 LOGICAL , DIMENSION(jpi,jpj) :: llmask ! 88 REAL(wp), DIMENSION(jpi,jpj) :: zalbfz ! ( = alphdi for freezing ice ; = albice for melting ice ) 89 REAL(wp), DIMENSION(jpi,jpj) :: zficeth ! function of ice thickness 106 90 !!--------------------------------------------------------------------- 107 91 108 ! initialization 109 IF( albd_init == 0 ) CALL albedo_init 110 111 !------------------------- 92 IF( albd_init == 0 ) CALL albedo_init ! initialization 93 94 !--------------------------- 112 95 ! Computation of zficeth 113 !-------------------------- 96 !--------------------------- 114 97 115 98 llmask = (hsnif == 0.e0) .AND. ( sist >= rt0_ice ) … … 175 158 !-------------------------- ----------------- 176 159 177 ! Parameterization of Briegled and Ramanathan, 1982 178 zmue14 = zmue**1.4 179 palcnp(:,:) = 0.05 / ( 1.1 * zmue14 + 0.15 ) 180 181 ! Parameterization of Kondratyev, 1969 and Payne, 1972 182 palcn(:,:) = 0.06 183 184 END SUBROUTINE flx_blk_albedo 160 zcoef = 0.05 / ( 1.1 * cmue**1.4 + 0.15 ) ! Parameterization of Briegled and Ramanathan, 1982 161 palcnp(:,:) = zcoef 162 palcn(:,:) = 0.06 ! Parameterization of Kondratyev, 1969 and Payne, 1972 163 ! 164 END SUBROUTINE blk_albedo 185 165 186 166 # else … … 189 169 !!---------------------------------------------------------------------- 190 170 191 SUBROUTINE flx_blk_albedo( palb , palcn , palbp , palcnp )192 !!---------------------------------------------------------------------- 193 !! *** ROUTINE flx_blk_albedo ***171 SUBROUTINE blk_albedo( palb , palcn , palbp , palcnp ) 172 !!---------------------------------------------------------------------- 173 !! *** ROUTINE blk_albedo *** 194 174 !! 195 !! ** Purpose : Computation of the albedo of the snow/ice system 196 !! as well as the ocean one 197 !! 198 !! ** Method : Computation of the albedo of snow or ice (choose the 199 !! wright one by a large number of tests Computation of the albedo 200 !! of the ocean 201 !! 202 !! History : 203 !! 8.0 ! 01-04 (LIM 1.0) 204 !! 8.5 ! 03-07 (C. Ethe, G. Madec) Optimization (old name:shine) 205 !!---------------------------------------------------------------------- 206 !! * Arguments 207 REAL(wp), DIMENSION(jpi,jpj), INTENT(out) :: & 208 palb , & ! albedo of ice under overcast sky 209 palcn , & ! albedo of ocean under overcast sky 210 palbp , & ! albedo of ice under clear sky 211 palcnp ! albedo of ocean under clear sky 212 213 REAL(wp) :: & 214 zmue14 ! zmue**1.4 215 !!---------------------------------------------------------------------- 216 217 !-------------------------------------------- 218 ! Computation of the albedo of the ocean 219 !-------------------------- ----------------- 220 221 ! Parameterization of Briegled and Ramanathan, 1982 222 zmue14 = zmue**1.4 223 palcnp(:,:) = 0.05 / ( 1.1 * zmue14 + 0.15 ) 224 225 ! Parameterization of Kondratyev, 1969 and Payne, 1972 226 palcn(:,:) = 0.06 227 228 palb (:,:) = palcn(:,:) 229 palbp(:,:) = palcnp(:,:) 230 231 END SUBROUTINE flx_blk_albedo 175 !! ** Purpose : Computation of the albedo of the ocean 176 !! 177 !! ** Method : .... 178 !!---------------------------------------------------------------------- 179 REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: palb ! albedo of ice under overcast sky 180 REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: palcn ! albedo of ocean under overcast sky 181 REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: palbp ! albedo of ice under clear sky 182 REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: palcnp ! albedo of ocean under clear sky 183 !! 184 REAL(wp) :: zcoef ! temporary scalar 185 !!---------------------------------------------------------------------- 186 ! 187 zcoef = 0.05 / ( 1.1 * cmue**1.4 + 0.15 ) 188 189 palcnp(:,:) = zcoef ! Parameterization of Briegled and Ramanathan, 1982 190 palcn(:,:) = 0.06 ! Parameterization of Kondratyev, 1969 and Payne, 1972 191 192 palb (:,:) = zcoef ! ice overcast albedo set to oceanvalue 193 palbp(:,:) = 0.06 ! ice clear sky albedo set to oceanvalue 194 ! 195 END SUBROUTINE blk_albedo 232 196 233 197 #endif … … 240 204 !! 241 205 !! ** Method : Read the namelist namalb 242 !! 243 !! ** Action : 244 !! 245 !! 246 !! History : 247 !! 9.0 ! 04-11 (C. Talandier) Original code 248 !!---------------------------------------------------------------------- 249 NAMELIST/namalb/ cgren, albice, alphd, alphdi, alphc 250 !!---------------------------------------------------------------------- 251 !! OPA 9.0, LODYC-IPSL (2004) 252 !!---------------------------------------------------------------------- 253 254 ! set the initialization flag to 1 255 albd_init = 1 ! indicate that the initialization has been done 256 257 ! Read Namelist namalb : albedo parameters 258 REWIND( numnam ) 206 !!---------------------------------------------------------------------- 207 ! 208 albd_init = 1 ! set the initialization flag to 1 (done) 209 210 REWIND( numnam ) ! Read Namelist namalb : albedo parameters 259 211 READ ( numnam, namalb ) 260 212 261 ! Control print 262 IF(lwp) THEN 213 IF(lwp) THEN ! Control print 263 214 WRITE(numout,*) 264 WRITE(numout,*) 'albedo_init : albedo'215 WRITE(numout,*) 'albedo_init : set albedo parameters from namelist namalb' 265 216 WRITE(numout,*) '~~~~~~~~~~~' 266 WRITE(numout,*) ' Namelist namalb : set albedo parameters' 267 WRITE(numout,*) 268 WRITE(numout,*) ' correction of the snow or ice albedo to take into account cgren = ', cgren 269 WRITE(numout,*) ' albedo of melting ice in the arctic and antarctic albice = ', albice 270 WRITE(numout,*) ' coefficients for linear alphd = ', alphd 271 WRITE(numout,*) ' interpolation used to compute albedo alphdi = ', alphdi 272 WRITE(numout,*) ' between two extremes values (Pyane, 1972) alphc = ', alphc 273 WRITE(numout,*) 217 WRITE(numout,*) ' correction for snow and ice albedo cgren = ', cgren 218 WRITE(numout,*) ' albedo of melting ice in the arctic and antarctic albice = ', albice 219 WRITE(numout,*) ' coefficients for linear alphd = ', alphd 220 WRITE(numout,*) ' interpolation used to compute albedo alphdi = ', alphdi 221 WRITE(numout,*) ' between two extremes values (Pyane, 1972) alphc = ', alphc 274 222 ENDIF 275 223 ! 276 224 END SUBROUTINE albedo_init 225 277 226 !!====================================================================== 278 227 END MODULE albedo -
trunk/NEMO/OPA_SRC/daymod.F90
r699 r703 4 4 !! Ocean : calendar 5 5 !!===================================================================== 6 !! History : ! 94-09 (M. Pontaud M. Imbard) Original code 7 !! ! 97-03 (O. Marti) 8 !! ! 97-05 (G. Madec) 9 !! ! 97-08 (M. Imbard) 10 !! 9.0 ! 03-09 (G. Madec) F90 + nyear, nmonth, nday 11 !! ! 04-01 (A.M. Treguier) new calculation based on adatrj 12 !! ! 06-08 (G. Madec) surface module major update 13 !!---------------------------------------------------------------------- 6 14 7 15 !!---------------------------------------------------------------------- 8 16 !! day : calendar 9 17 !!---------------------------------------------------------------------- 10 !! * Modules used11 18 USE dom_oce ! ocean space and time domain 12 19 USE phycst ! physical constants … … 17 24 PRIVATE 18 25 19 !! * Routine accessibility20 26 PUBLIC day ! called by step.F90 21 27 22 !! * Shared module variables 23 INTEGER , PUBLIC :: & !: 24 nyear , & !: current year 25 nmonth , & !: current month 26 nday , & !: current day of the month 27 nday_year , & !: curent day counted from jan 1st of the current year 28 ndastp !: time step date in year/month/day aammjj 29 REAL(wp), PUBLIC :: & !: 30 adatrj , & !: number of elapsed days since the begining of the run 31 adatrj0 !: value of adatrj at nit000-1 (before the present run). 32 ! ! it is the accumulated duration of previous runs 33 ! ! that may have been run with different time steps. 28 INTEGER , PUBLIC :: nyear !: current year 29 INTEGER , PUBLIC :: nmonth !: current month 30 INTEGER , PUBLIC :: nday !: current day of the month 31 INTEGER , PUBLIC :: nday_year !: current day counted from jan 1st of the current year 32 REAL(wp), PUBLIC :: rsec_year !: current time step counted in second since 00h jan 1st of the current year 33 REAL(wp), PUBLIC :: rsec_month !: current time step counted in second since 00h 1st day of the current month 34 REAL(wp), PUBLIC :: rsec_day !: current time step counted in second since 00h of the current day 35 INTEGER , PUBLIC :: ndastp !: time step date in year/month/day aammjj 36 37 !!gm supprimer adatrj et adatrj0 ==> remplacer par rsecday..... 38 REAL(wp), PUBLIC :: adatrj !: number of elapsed days since the begining of the run 39 REAL(wp), PUBLIC :: adatrj0 !: value of adatrj at nit000-1 (before the present run). 40 ! ! it is the accumulated duration of previous runs 41 ! ! that may have been run with different time steps. 42 INTEGER , PUBLIC, DIMENSION(0:13) :: nmonth_len !: length of the current year 43 44 INTEGER, PUBLIC, DIMENSION(12) :: nbiss = (/ 31, 29, 31, 30, 31, 30, & !: number of days per month 45 & 31, 31, 30, 31, 30, 31 /) !: (leap-year) 46 INTEGER, PUBLIC, DIMENSION(12) :: nobis = (/ 31, 28, 31, 30, 31, 30, & !: number of days per month 47 & 31, 31, 30, 31, 30, 31 /) !: (365 days a year) 48 49 REAL(wp), PUBLIC, DIMENSION(0:14) :: rmonth_half(0:14) 50 34 51 !!---------------------------------------------------------------------- 35 !! OPA 9.0 , LOCEAN-IPSL (200 5)52 !! OPA 9.0 , LOCEAN-IPSL (2006) 36 53 !! $Id$ 37 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt54 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 38 55 !!---------------------------------------------------------------------- 39 56 … … 54 71 !! - ndastp : =nyear*10000+nmonth*100+nday 55 72 !! - adatrj : date in days since the beginning of the run 56 !! 57 !! History : 58 !! ! 94-09 (M. Pontaud M. Imbard) Original code 59 !! ! 97-03 (O. Marti) 60 !! ! 97-05 (G. Madec) 61 !! ! 97-08 (M. Imbard) 62 !! 9.0 ! 03-09 (G. Madec) F90 + nyear, nmonth, nday 63 !! ! 04-01 (A.M. Treguier) new calculation based on adatrj 73 !! - rsec_year : current time of the year (in second since 00h, jan 1st) 64 74 !!---------------------------------------------------------------------- 65 !! * Arguments 66 INTEGER, INTENT( in ) :: kt ! ocean time-step indices 67 68 !! * Local declarations 69 INTEGER :: js ! dummy loop indice 70 INTEGER :: iend, iday0, iday1 ! temporary integers 71 REAL(wp) :: zadatrjn, zadatrjb ! adatrj at timestep kt-1 and kt-2 72 CHARACTER (len=25) :: charout 75 INTEGER, INTENT(in) :: kt ! ocean time-step indices 76 ! 77 INTEGER :: js, jm ! dummy loop indice 78 CHARACTER (len=25) :: charout 73 79 !!---------------------------------------------------------------------- 74 80 … … 77 83 !----------------------------------------------------------------- 78 84 79 IF( kt == nit000 ) THEN 80 85 ! ! ---------------- ! 86 IF( kt == -1 ) THEN ! Initialisation ! 87 ! ! ---------------- ! 88 ! 81 89 IF( .NOT.ln_rstart ) adatrj0 = 0.e0 ! adatrj0 initialized in rst_read when restart 82 90 83 adatrj = adatrj0 91 ! set the calandar from adatrj0 and ndastp (read in restart file and namelist) 92 adatrj = adatrj0 !???? bug.... toujours rest !!gm 84 93 nyear = ndastp / 10000 85 94 nmonth = ( ndastp - (nyear * 10000) ) / 100 86 95 nday = ndastp - (nyear * 10000) - ( nmonth * 100 ) 87 96 88 ! Calculates nday_year, day since january 1st (useful to read daily forcing fields) 97 ! length of the month of the current year (from nleapy, read in namelist) 98 nmonth_len(0) = nbiss(12) ; nmonth_len(13) = nbiss(1) 99 SELECT CASE( nleapy ) 100 CASE( 1 ) 101 IF( MOD( nyear, 4 ) == 0 ) THEN 102 ; nmonth_len(1:12) = nbiss(:) ! 366 days per year (leap year) 103 ELSE 104 ; nmonth_len(1:12) = nobis(:) ! 365 days per year 105 ENDIF 106 CASE( 0 ) ; nmonth_len(1:12) = nobis(:) ! 365 days per year 107 CASE( 2: ) ; nmonth_len(1:13) = nleapy ! 12*nleapy days per year 108 END SELECT 109 110 ! half month in second since the bigining of the year 111 rmonth_half(0) = - 0.5 * rday * REAL( nmonth_len( 0 ) ) 112 DO jm = 1, 12 113 rmonth_half(jm) = rmonth_half(jm-1) + 0.5 * rday * REAL( nmonth_len(jm-1) + nmonth_len(jm) ) 114 END DO 115 rmonth_half(13) = rmonth_half( 1 ) + 365. * rday 116 rmonth_half(14) = rmonth_half( 2 ) + 365. * rday 117 118 ! day since january 1st (useful to read daily forcing fields) 89 119 nday_year = nday 90 ! ! accumulates days of previous months of this year 91 DO js = 1, nmonth-1 92 IF( nleapy == 1 .AND. MOD( nyear, 4 ) == 0 ) THEN 93 nday_year = nday_year + nbiss(js) 94 ELSE 95 nday_year = nday_year + nobis(js) 96 ENDIF 120 DO js = 1, nmonth - 1 ! accumulates days of previous months of this year 121 nday_year = nday_year + nmonth_len(js) 97 122 END DO 98 123 99 ENDIF 124 ! number of seconds since... 125 rsec_year = REAL( nday_year - 1 ) * rday - rdttra(1) ! 00h 1st day of the current year 126 rsec_day = REAL( nday - 1 ) * rday - rdttra(1) ! 00h 1st day of the current month 127 rsec_month = - rdttra(1) ! 00h of the current day 100 128 101 ! I. calculates adatrj, zadatrjn, zadatrjb. 102 ! ------------------------------------------------------------------ 129 ! control print 130 IF(lwp) WRITE(numout,*)' ==============>> time-step =', kt, ' Initial DATE= ', & 131 & nyear, '/', nmonth, '/', nday, ' rsec_day:', rsec_day 103 132 104 adatrj = adatrj0 + ( kt - nit000 + 1 ) * rdttra(1) / rday 105 zadatrjn = adatrj0 + ( kt - nit000 ) * rdttra(1) / rday 106 zadatrjb = adatrj0 + ( kt - nit000 - 1 ) * rdttra(1) / rday 133 ! 134 ! ! -------------------------------- ! 135 ELSE ! Model calendar at time-step kt ! 136 ! ! -------------------------------- ! 107 137 138 rsec_year = rsec_year + rdttra(1) ! New time-step 139 rsec_month = rsec_month + rdttra(1) ! New time-step 140 rsec_day = rsec_day + rdttra(1) ! New time-step 108 141 109 ! II. increment the date. The date corresponds to 'now' variables (kt-1), 110 ! which is the time step of forcing fields. 111 ! Do not do this at nit000 unless nrstdt= 2 112 ! In that case ndastp (read in restart) was for step nit000-2 113 ! ------------------------------------------------------------------- 142 adatrj = adatrj0 + ( kt - nit000 + 1 ) * rdttra(1) / rday 114 143 115 iday0 = INT( zadatrjb ) 116 iday1 = INT( zadatrjn ) 144 IF( rsec_day >= rday ) THEN 145 ! 146 rsec_day = 0.e0 ! NEW day 147 nday = nday + 1 148 nday_year = nday_year + 1 149 ! 150 IF( nday == nmonth_len(nmonth) + 1 ) THEN ! NEW month 151 nday = 1 152 rsec_month = 0.e0 153 nmonth = nmonth + 1 154 IF( nmonth == 13 ) THEN ! NEW year 155 nyear = nyear + 1 156 nmonth = 1 157 nday_year = 1 158 rsec_year = 0.e0 159 ! ! update the length of the month 160 IF( nleapy == 1 ) THEN ! of the current year (if necessary) 161 IF( MOD( nyear, 4 ) == 0 ) THEN 162 nmonth_len(1:12) = nbiss(:) ! 366 days per year (leap year) 163 ELSE 164 nmonth_len(1:12) = nobis(:) ! 365 days per year 165 ENDIF 166 ! half month in second since the bigining of the year 167 rmonth_half(0) = - 0.5 * rday * REAL( nmonth_len( 0 ) ) 168 DO jm = 1, 12 169 rmonth_half(jm) = rmonth_half(jm-1) + 0.5 * rday * REAL( nmonth_len(jm-1) + nmonth_len(jm) ) 170 END DO 171 rmonth_half(13) = rmonth_half( 1 ) + 365. * rday 172 rmonth_half(14) = rmonth_half( 2 ) + 365. * rday 173 ENDIF 174 ENDIF 175 ENDIF 117 176 118 IF( iday1 - iday0 >= 1 .AND. ( kt /= nit000 .OR. nrstdt == 2 ) ) THEN 177 ! 178 ndastp = nyear * 10000 + nmonth * 100 + nday ! NEW date 179 ! 180 ! IF(lwp) WRITE(numout,'(a,i8,a,i4,a,i2,a,i2,a,i3)') '======>> time-step =', kt, & 181 ! & ' New day, DATE= ', nyear, '/', nmonth, '/', nday, ' nday_year = ', nday_year 182 ! IF(lwp) WRITE(numout,'(a,F9.0,a,F9.0,a,F9.0)') ' rsec_year = ', rsec_year, & 183 ! & ' rsec_month = ', rsec_month, ' rsec_day = ', rsec_day 184 ENDIF 119 185 120 ! increase calendar 121 nyear = ndastp / 10000 122 nmonth = ( ndastp - (nyear * 10000) ) / 100 123 nday = ndastp - (nyear * 10000) - ( nmonth * 100 ) 124 nday = nday + 1 125 IF( nleapy == 1 .AND. MOD( nyear, 4 ) == 0 ) THEN 126 iend = nbiss(nmonth) 127 ELSEIF( nleapy > 1 ) THEN 128 iend = nleapy 129 ELSE 130 iend = nobis(nmonth) 186 IF(ln_ctl) THEN 187 WRITE(charout,FMT="('kt =', I4,' d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear 188 CALL prt_ctl_info(charout) 131 189 ENDIF 132 IF( nday == iend + 1 ) THEN 133 nday = 1 134 nmonth = nmonth + 1 135 IF( nmonth == 13 ) THEN 136 nmonth = 1 137 nyear = nyear + 1 138 ENDIF 139 ENDIF 140 ndastp = nyear * 10000 + nmonth * 100 + nday 141 142 ! Calculates nday_year, day since january 1st (useful to read daily forcing fields) 143 nday_year = nday 144 ! ! accumulates days of previous months of this year 145 DO js = 1, nmonth-1 146 IF( nleapy == 1 .AND. MOD( nyear, 4 ) == 0 ) THEN 147 nday_year = nday_year + nbiss(js) 148 ELSE 149 nday_year = nday_year + nobis(js) 150 ENDIF 151 END DO 152 153 IF(lwp) WRITE(numout,*)' ==============>> time-step =', kt, ' New day, DATE= ', & 154 & nyear, '/', nmonth, '/', nday, 'nday_year:', nday_year 155 ENDIF 156 157 IF(ln_ctl) THEN 158 WRITE(charout,FMT="('kt =', I4,' d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear 159 CALL prt_ctl_info(charout, itime=kt) 190 ! 160 191 ENDIF 161 192 -
trunk/NEMO/OPA_SRC/eosbn2.F90
r699 r703 5 5 !! - Brunt-Vaisala frequency 6 6 !!============================================================================== 7 !! History : ! 89-03 (O. Marti) Original code 8 !! 6.0 ! 94-07 (G. Madec, M. Imbard) add bn2 9 !! 6.0 ! 94-08 (G. Madec) Add Jackett & McDougall eos 10 !! 7.0 ! 96-01 (G. Madec) statement function for e3 11 !! 8.1 ! 97-07 (G. Madec) introduction of neos, OPA8.1 12 !! 8.1 ! 97-07 (G. Madec) density instead of volumic mass 13 !! ! 99-02 (G. Madec, N. Grima) semi-implicit pressure gradient 14 !! ! 01-09 (M. Ben Jelloul) bugfix onlinear eos 15 !! 8.5 ! 02-10 (G. Madec) add eos_init 16 !! 8.5 ! 02-11 (G. Madec, A. Bozec) partial step, eos_insitu_2d 17 !! 9.0 ! 03-08 (G. Madec) F90, free form 18 !! 9.0 ! 06-08 (G. Madec) add tfreez function 19 !!---------------------------------------------------------------------- 7 20 8 21 !!---------------------------------------------------------------------- … … 13 26 !! eos_insitu_2d : Compute the in situ density for 2d fields 14 27 !! eos_bn2 : Compute the Brunt-Vaisala frequency 28 !! tfreez : Compute the surface freezing temperature 15 29 !! eos_init : set eos parameters (namelist) 16 30 !!---------------------------------------------------------------------- 17 !! * Modules used18 31 USE dom_oce ! ocean space and time domain 19 32 USE phycst ! physical constants … … 33 46 END INTERFACE 34 47 35 !! * Routine accessibility 36 PUBLIC eos ! called by step.F90, inidtr.F90, tranpc.F90 and intgrd.F90 37 PUBLIC bn2 ! called by step.F90 38 PUBLIC eos_init ! called by step.F90 39 40 !! * Share module variables 41 INTEGER , PUBLIC :: & !: nameos : ocean physical parameters 42 neos = 0, & !: = 0/1/2 type of eq. of state and Brunt-Vaisala frequ. 43 neos_init = 0 !: control flag for initialization 44 45 REAL(wp), PUBLIC :: & !: nameos : ocean physical parameters 46 ralpha = 2.0e-4, & !: thermal expension coeff. (linear equation of state) 47 rbeta = 7.7e-4 !: saline expension coeff. (linear equation of state) 48 PUBLIC eos ! called by step, istate, tranpc and zpsgrd modules 49 PUBLIC bn2 ! called by step module 50 PUBLIC tfreez ! called by sbcice_... modules 51 52 !!* Namelist (nameos) 53 INTEGER , PUBLIC :: neos = 0 !: = 0/1/2 type of eq. of state and Brunt-Vaisala frequ. 54 REAL(wp), PUBLIC :: ralpha = 2.0e-4 !: thermal expension coeff. (linear equation of state) 55 REAL(wp), PUBLIC :: rbeta = 7.7e-4 !: saline expension coeff. (linear equation of state) 56 NAMELIST/nameos/ neos, ralpha, rbeta 48 57 58 INTEGER :: neos_init = 0 !: control flag for initialization 59 49 60 !! * Substitutions 50 61 # include "domzgr_substitute.h90" 51 62 # include "vectopt_loop_substitute.h90" 52 63 !!---------------------------------------------------------------------- 53 !! OPA 9.0 , LOCEAN-IPSL (200 5)64 !! OPA 9.0 , LOCEAN-IPSL (2006) 54 65 !! $Id$ 55 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt66 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 56 67 !!---------------------------------------------------------------------- 57 68 58 69 CONTAINS 59 70 60 SUBROUTINE eos_insitu 71 SUBROUTINE eos_insitu( ptem, psal, prd ) 61 72 !!---------------------------------------------------------------------- 62 73 !! *** ROUTINE eos_insitu *** … … 92 103 !! ** Action : compute prd , the in situ density (no units) 93 104 !! 94 !! References : 95 !! Jackett, D.R., and T.J. McDougall. J. Atmos. Ocean. Tech., 1994 96 !! 97 !! History : 98 !! ! 89-03 (o. Marti) Original code 99 !! ! 94-08 (G. Madec) 100 !! ! 96-01 (G. Madec) statement function for e3 101 !! ! 97-07 (G. Madec) introduction of neos, OPA8.1 102 !! ! 97-07 (G. Madec) density instead of volumic mass 103 !! ! 99-02 (G. Madec, N. Grima) semi-implicit pressure gradient 104 !! ! 01-09 (M. Ben Jelloul) bugfix 105 !!---------------------------------------------------------------------- 106 !! * Arguments 107 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) :: & 108 ptem, & ! potential temperature 109 psal ! salinity 110 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) :: & 111 prd ! potential density (surface referenced) 112 113 !! * Local declarations 105 !! References : Jackett and McDougall, J. Atmos. Ocean. Tech., 1994 106 !!---------------------------------------------------------------------- 107 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: ptem ! potential temperature [Celcius] 108 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: psal ! salinity [psu] 109 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out) :: prd ! in situ density 110 !! 114 111 INTEGER :: ji, jj, jk ! dummy loop indices 115 112 REAL(wp) :: & … … 119 116 zd , zc , zaw, za , & ! " " 120 117 zb1, za1, zkw, zk0 ! " " 121 REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 122 zws ! temporary workspace 123 !!---------------------------------------------------------------------- 124 125 126 ! initialization (in not already done) 127 IF( neos_init == 0 ) CALL eos_init 128 118 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zws ! temporary workspace 119 !!---------------------------------------------------------------------- 120 121 IF( neos_init == 0 ) CALL eos_init ! initialization (in not already done) 129 122 130 123 SELECT CASE ( neos ) 131 124 ! 132 125 CASE ( 0 ) ! Jackett and McDougall (1994) formulation 133 126 ! 134 127 !CDIR NOVERRCHK 135 128 zws(:,:,:) = SQRT( ABS( psal(:,:,:) ) ) 136 137 129 ! ! =============== 138 130 DO jk = 1, jpkm1 ! Horizontal slab … … 181 173 END DO ! End of slab 182 174 ! ! =============== 183 184 175 ! 185 176 CASE ( 1 ) ! Linear formulation function of temperature only 186 177 ! 187 178 ! ! =============== 188 179 DO jk = 1, jpkm1 ! Horizontal slab … … 199 190 END DO ! End of slab 200 191 ! ! =============== 201 202 192 ! 203 193 CASE ( 2 ) ! Linear formulation function of temperature and salinity 204 194 ! 205 195 ! ! =============== 206 196 DO jk = 1, jpkm1 ! Horizontal slab … … 217 207 END DO ! End of slab 218 208 ! ! =============== 219 209 ! 220 210 CASE DEFAULT 221 211 ! 222 212 WRITE(ctmp1,*) ' bad flag value for neos = ', neos 223 213 CALL ctl_stop( ctmp1 ) 224 214 ! 225 215 END SELECT 226 227 IF(ln_ctl) THEN 228 CALL prt_ctl(tab3d_1=prd, clinfo1=' eos : ', ovlap=1, kdim=jpk) 229 ENDIF 230 216 ! 217 IF(ln_ctl) CALL prt_ctl(tab3d_1=prd, clinfo1=' eos : ', ovlap=1, kdim=jpk) 218 ! 231 219 END SUBROUTINE eos_insitu 232 220 233 221 234 SUBROUTINE eos_insitu_pot ( ptem, psal, prd, prhop)222 SUBROUTINE eos_insitu_pot( ptem, psal, prd, prhop ) 235 223 !!---------------------------------------------------------------------- 236 224 !! *** ROUTINE eos_insitu_pot *** … … 275 263 !! - prhop, the potential volumic mass (Kg/m3) 276 264 !! 277 !! References : 278 !! Jackett, D.R., and T.J. McDougall. J. Atmos. Ocean. Tech., 1994 279 !! Brown, J. A. and K. A. Campana. Mon. Weather Rev., 1978 280 !! 281 !! History : 282 !! 4.0 ! 89-03 (O. Marti) 283 !! ! 94-08 (G. Madec) 284 !! ! 96-01 (G. Madec) statement function for e3 285 !! ! 97-07 (G. Madec) introduction of neos, OPA8.1 286 !! ! 97-07 (G. Madec) density instead of volumic mass 287 !! ! 99-02 (G. Madec, N. Grima) semi-implicit pressure gradient 288 !! ! 01-09 (M. Ben Jelloul) bugfix 289 !! 9.0 ! 03-08 (G. Madec) F90, free form 290 !!---------------------------------------------------------------------- 291 !! * Arguments 292 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) :: & 293 ptem, & ! potential temperature 294 psal ! salinity 295 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) :: & 296 prd, & ! potential density (surface referenced) 297 prhop ! potential density (surface referenced) 298 299 !! * Local declarations 265 !! References : Jackett and McDougall, J. Atmos. Ocean. Tech., 1994 266 !! Brown and Campana, Mon. Weather Rev., 1978 267 !!---------------------------------------------------------------------- 268 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: ptem ! potential temperature [Celcius] 269 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: psal ! salinity [psu] 270 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out) :: prd ! in situ density 271 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out) :: prhop ! potential density (surface referenced) 272 300 273 INTEGER :: ji, jj, jk ! dummy loop indices 301 274 REAL(wp) :: & ! temporary scalars 302 275 zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw, & 303 276 zb, zd, zc, zaw, za, zb1, za1, zkw, zk0 304 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zws 305 !!---------------------------------------------------------------------- 306 307 ! initialization (in not already done) 308 IF( neos_init == 0 ) CALL eos_init 309 277 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zws 278 !!---------------------------------------------------------------------- 279 280 IF( neos_init == 0 ) CALL eos_init ! initialization (in not already done) 310 281 311 282 SELECT CASE ( neos ) 312 283 ! 313 284 CASE ( 0 ) ! Jackett and McDougall (1994) formulation 314 285 ! 315 286 !CDIR NOVERRCHK 316 287 zws(:,:,:) = SQRT( ABS( psal(:,:,:) ) ) 317 318 288 ! ! =============== 319 289 DO jk = 1, jpkm1 ! Horizontal slab … … 326 296 zh = fsdept(ji,jj,jk) 327 297 ! square root salinity 328 !!Edmee zsr= SQRT( ABS( zs ) )329 298 zsr= zws(ji,jj,jk) 330 299 ! compute volumic mass pure water at atm pressure … … 366 335 END DO ! End of slab 367 336 ! ! =============== 368 369 337 ! 370 338 CASE ( 1 ) ! Linear formulation function of temperature only 371 339 ! 372 340 ! ! =============== 373 341 DO jk = 1, jpkm1 ! Horizontal slab … … 385 353 END DO ! End of slab 386 354 ! ! =============== 387 388 355 ! 389 356 CASE ( 2 ) ! Linear formulation function of temperature and salinity 390 357 ! 391 358 ! ! =============== 392 359 DO jk = 1, jpkm1 ! Horizontal slab … … 404 371 END DO ! End of slab 405 372 ! ! =============== 406 373 ! 407 374 CASE DEFAULT 408 375 ! 409 376 WRITE(ctmp1,*) ' bad flag value for neos = ', neos 410 377 CALL ctl_stop( ctmp1 ) 411 378 ! 412 379 END SELECT 413 414 IF(ln_ctl) THEN 415 CALL prt_ctl(tab3d_1=prd, clinfo1=' eos-p: ', tab3d_2=prhop, clinfo2=' pot : ', ovlap=1, kdim=jpk) 416 ENDIF 417 380 ! 381 IF(ln_ctl) CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-p: ', tab3d_2=prhop, clinfo2=' pot : ', ovlap=1, kdim=jpk ) 382 ! 418 383 END SUBROUTINE eos_insitu_pot 419 384 420 SUBROUTINE eos_insitu_2d ( ptem, psal, pdep, prd ) 385 386 SUBROUTINE eos_insitu_2d( ptem, psal, pdep, prd ) 421 387 !!---------------------------------------------------------------------- 422 388 !! *** ROUTINE eos_insitu_2d *** … … 452 418 !! ** Action : - prd , the in situ density (no units) 453 419 !! 454 !! References : 455 !! Jackett, D.R., and T.J. McDougall. J. Atmos. Ocean. Tech., 1994 456 !! 457 !! History : 458 !! 8.5 ! 02-11 (G. Madec, A. Bozec) partial step 459 !!---------------------------------------------------------------------- 460 !! * Arguments 461 REAL(wp), DIMENSION(jpi,jpj), INTENT( in ) :: & 462 ptem, & ! potential temperature 463 psal, & ! salinity 464 pdep ! depth 465 REAL(wp), DIMENSION(jpi,jpj), INTENT( out ) :: & 466 prd ! potential density (surface referenced) 467 468 !! * Local declarations 469 INTEGER :: ji, jj ! dummy loop indices 420 !! References : Jackett and McDougall, J. Atmos. Ocean. Tech., 1994 421 !!---------------------------------------------------------------------- 422 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: ptem ! potential temperature [Celcius] 423 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: psal ! salinity [psu] 424 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pdep ! depth [m] 425 REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: prd ! in situ density 426 !! 427 INTEGER :: ji, jj ! dummy loop indices 470 428 REAL(wp) :: & ! temporary scalars 471 429 zt, zs, zh, zsr, zr1, zr2, zr3, zr4, zrhop, ze, zbw, & 472 430 zb, zd, zc, zaw, za, zb1, za1, zkw, zk0, & 473 431 zmask 474 REAL(wp), DIMENSION(jpi,jpj) :: zws 475 !!---------------------------------------------------------------------- 476 477 478 ! initialization (in not already done) 479 IF( neos_init == 0 ) CALL eos_init 432 REAL(wp), DIMENSION(jpi,jpj) :: zws 433 !!---------------------------------------------------------------------- 434 435 IF( neos_init == 0 ) CALL eos_init ! initialization (in not already done) 480 436 481 437 prd(:,:) = 0.e0 482 438 483 439 SELECT CASE ( neos ) 484 440 ! 485 441 CASE ( 0 ) ! Jackett and McDougall (1994) formulation 486 442 ! 487 443 !CDIR NOVERRCHK 488 444 DO jj = 1, jpjm1 … … 496 452 END DO 497 453 END DO 498 499 454 ! ! =============== 500 455 DO jj = 1, jpjm1 ! Horizontal slab … … 505 460 DO ji = 1, fs_jpim1 ! vector opt. 506 461 #endif 507 508 462 zmask = tmask(ji,jj,1) ! land/sea bottom mask = surf. mask 509 463 … … 543 497 ! masked in situ density anomaly 544 498 prd(ji,jj) = ( zrhop / ( 1.0 - zh / ( zk0 - zh * ( za - zh * zb ) ) ) - rau0 ) & 545 / rau0 * zmask 546 END DO 547 ! ! =============== 548 END DO ! End of slab 549 ! ! =============== 550 551 499 & / rau0 * zmask 500 END DO 501 ! ! =============== 502 END DO ! End of slab 503 ! ! =============== 504 ! 552 505 CASE ( 1 ) ! Linear formulation function of temperature only 553 506 ! 554 507 ! ! =============== 555 508 DO jj = 1, jpjm1 ! Horizontal slab … … 565 518 END DO ! End of slab 566 519 ! ! =============== 567 568 520 ! 569 521 CASE ( 2 ) ! Linear formulation function of temperature and salinity 570 522 ! 571 523 ! ! =============== 572 524 DO jj = 1, jpjm1 ! Horizontal slab … … 582 534 END DO ! End of slab 583 535 ! ! =============== 584 536 ! 585 537 CASE DEFAULT 586 538 ! 587 539 WRITE(ctmp1,*) ' bad flag value for neos = ', neos 588 540 CALL ctl_stop( ctmp1 ) 589 541 ! 590 542 END SELECT 591 543 592 IF(ln_ctl) CALL prt_ctl( tab2d_1=prd, clinfo1=' eos2d: ')593 544 IF(ln_ctl) CALL prt_ctl( tab2d_1=prd, clinfo1=' eos2d: ' ) 545 ! 594 546 END SUBROUTINE eos_insitu_2d 595 547 … … 623 575 !! ** Action : - pn2 : the brunt-vaisala frequency 624 576 !! 625 !! References : 626 !! McDougall, T. J., J. Phys. Oceanogr., 17, 1950-1964, 1987. 627 !! 628 !! History : 629 !! 6.0 ! 94-07 (G. Madec, M. Imbard) Original code 630 !! 8.0 ! 97-07 (G. Madec) introduction of statement functions 631 !! 8.5 ! 02-07 (G. Madec) Free form, F90 632 !! 8.5 ! 02-08 (G. Madec) introduction of arguments 633 !!---------------------------------------------------------------------- 634 !! * Arguments 635 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) :: & 636 ptem, & ! potential temperature 637 psal ! salinity 638 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) :: & 639 pn2 ! Brunt-Vaisala frequency 640 641 !! * Local declarations 577 !! References : McDougall, J. Phys. Oceanogr., 17, 1950-1964, 1987. 578 !!---------------------------------------------------------------------- 579 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: ptem ! potential temperature [Celcius] 580 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: psal ! salinity [psu] 581 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out) :: pn2 ! Brunt-Vaisala frequency [s-1] 582 642 583 INTEGER :: ji, jj, jk ! dummy loop indices 643 REAL(wp) :: & 644 zgde3w, zt, zs, zh, & ! temporary scalars 645 zalbet, zbeta ! " " 584 REAL(wp) :: zgde3w, zt, zs, zh, & ! temporary scalars 585 & zalbet, zbeta ! " " 646 586 #if defined key_zdfddm 647 587 REAL(wp) :: zds ! temporary scalars 648 588 #endif 649 589 !!---------------------------------------------------------------------- 650 !! OPA8.5, LODYC-IPSL (2002)651 !!----------------------------------------------------------------------652 590 653 591 ! pn2 : first and last levels … … 660 598 661 599 SELECT CASE ( neos ) 662 600 ! 663 601 CASE ( 0 ) ! Jackett and McDougall (1994) formulation 664 602 ! 665 603 ! ! =============== 666 604 DO jk = 2, jpkm1 ! Horizontal slab … … 712 650 END DO ! End of slab 713 651 ! ! =============== 714 715 652 ! 716 653 CASE ( 1 ) ! Linear formulation function of temperature only 717 654 ! 718 655 ! ! =============== 719 656 DO jk = 2, jpkm1 ! Horizontal slab … … 728 665 END DO ! End of slab 729 666 ! ! =============== 730 731 667 ! 732 668 CASE ( 2 ) ! Linear formulation function of temperature and salinity 733 669 ! 734 670 ! ! =============== 735 671 DO jk = 2, jpkm1 ! Horizontal slab … … 756 692 END DO ! End of slab 757 693 ! ! =============== 758 694 ! 759 695 CASE DEFAULT 760 696 ! 761 697 WRITE(ctmp1,*) ' bad flag value for neos = ', neos 762 698 CALL ctl_stop( ctmp1 ) 763 699 ! 764 700 END SELECT 765 701 766 IF(ln_ctl) THEN 767 CALL prt_ctl(tab3d_1=pn2, clinfo1=' bn2 : ', ovlap=1, kdim=jpk) 702 IF(ln_ctl) CALL prt_ctl(tab3d_1=pn2, clinfo1=' bn2 : ', ovlap=1, kdim=jpk) 768 703 #if defined key_zdfddm 769 CALL prt_ctl(tab3d_1=rrau, clinfo1=' rrau : ', ovlap=1, kdim=jpk)704 IF(ln_ctl) CALL prt_ctl(tab3d_1=rrau, clinfo1=' rrau : ', ovlap=1, kdim=jpk) 770 705 #endif 771 ENDIF 772 706 ! 773 707 END SUBROUTINE eos_bn2 774 708 775 709 710 FUNCTION tfreez( psal ) RESULT( ptf ) 711 !!---------------------------------------------------------------------- 712 !! *** ROUTINE eos_init *** 713 !! 714 !! ** Purpose : Compute the sea surface freezing temperature [Celcius] 715 !! 716 !! ** Method : UNESCO freezing point at the surface (pressure = 0???) 717 !! freezing point [Celcius]=(-.0575+1.710523e-3*sqrt(abs(s))-2.154996e-4*s)*s-7.53e-4*p 718 !! checkvalue: tf= -2.588567 Celsius for s=40.0psu, p=500. decibars 719 !! 720 !! Reference : UNESCO tech. papers in the marine science no. 28. 1978 721 !!---------------------------------------------------------------------- 722 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: psal ! salinity [psu] 723 REAL(wp), DIMENSION(jpi,jpj) :: ptf ! freezing temperature [Celcius] 724 !!---------------------------------------------------------------------- 725 ptf(:,:) = ( - 0.0575 + 1.710523e-3 * SQRT( psal(:,:) ) & 726 & - 2.154996e-4 * psal(:,:) ) * psal(:,:) 727 END FUNCTION tfreez 728 729 776 730 SUBROUTINE eos_init 777 731 !!---------------------------------------------------------------------- … … 780 734 !! ** Purpose : initializations for the equation of state 781 735 !! 782 !! ** Method : Read the namelist nameos 783 !! 784 !! ** Action : blahblah.... 785 !! 786 !! History : 787 !! 8.5 ! 02-10 (G. Madec) Original code 788 !!---------------------------------------------------------------------- 789 NAMELIST/nameos/ neos, ralpha, rbeta 790 !!---------------------------------------------------------------------- 791 !! OPA 8.5, LODYC-IPSL (2002) 792 !!---------------------------------------------------------------------- 793 794 ! set the initialization flag to 1 795 neos_init = 1 ! indicate that the initialization has been done 796 797 ! namelist nameos : ocean physical parameters 798 799 ! Read Namelist nameos : equation of state 800 REWIND( numnam ) 736 !! ** Method : Read the namelist nameos and control the parameters 737 !!---------------------------------------------------------------------- 738 739 neos_init = 1 ! indicate that the initialization has been done 740 741 REWIND( numnam ) ! Read Namelist nameos : equation of state 801 742 READ ( numnam, nameos ) 802 743 … … 807 748 WRITE(numout,*) '~~~~~~~~' 808 749 WRITE(numout,*) ' Namelist nameos : set eos parameters' 809 WRITE(numout,*)810 750 WRITE(numout,*) ' flag for eq. of state and N^2 neos = ', neos 811 751 WRITE(numout,*) ' thermal exp. coef. (linear) ralpha = ', ralpha 812 752 WRITE(numout,*) ' saline exp. coef. (linear) rbeta = ', rbeta 813 WRITE(numout,*)814 753 ENDIF 815 754 … … 817 756 818 757 CASE ( 0 ) ! Jackett and McDougall (1994) formulation 819 758 IF(lwp) WRITE(numout,*) 820 759 IF(lwp) WRITE(numout,*) ' use of Jackett & McDougall (1994) equation of state and' 821 760 IF(lwp) WRITE(numout,*) ' McDougall (1987) Brunt-Vaisala frequency' 822 761 ! 823 762 CASE ( 1 ) ! Linear formulation function of temperature only 824 763 IF(lwp) WRITE(numout,*) 825 764 IF(lwp) WRITE(numout,*) ' use of linear eos rho(T) = rau0 * ( 1.0285 - ralpha * T )' 826 765 IF( lk_zdfddm ) CALL ctl_stop( ' double diffusive mixing parameterization requires', & 827 766 & ' that T and S are used as state variables' ) 828 767 ! 829 768 CASE ( 2 ) ! Linear formulation function of temperature and salinity 830 769 IF(lwp) WRITE(numout,*) 831 770 IF(lwp) WRITE(numout,*) ' use of linear eos rho(T,S) = rau0 * ( rbeta * S - ralpha * T )' 832 833 CASE DEFAULT 834 771 ! 772 CASE DEFAULT ! E R R O R in neos 835 773 WRITE(ctmp1,*) ' bad flag value for neos = ', neos 836 774 CALL ctl_stop( ctmp1 ) 837 838 775 END SELECT 839 776 -
trunk/NEMO/OPA_SRC/phycst.F90
r699 r703 4 4 !! Definition of of both ocean and ice parameters used in the code 5 5 !!===================================================================== 6 !! * Modules used 6 !! History : ! 90-10 (C. Levy - G. Madec) Original code 7 !! ! 91-11 (G. Madec) 8 !! ! 91-12 (M. Imbard) 9 !! 8.5 ! 02-08 (G. Madec, C. Ethe) F90, add ice constants 10 !! 9.0 ! 06-08 (G. Madec) style 11 !!---------------------------------------------------------------------- 12 13 !!---------------------------------------------------------------------- 14 !! phy_cst : define and print physical constant and domain parameters 15 !!---------------------------------------------------------------------- 7 16 USE par_oce ! ocean parameters 8 17 USE in_out_manager ! I/O manager … … 11 20 PRIVATE 12 21 13 !! * Routine accessibility 14 PUBLIC phy_cst ! routine called by inipar.F90 22 PUBLIC phy_cst ! routine called by inipar.F90 15 23 16 !! * Shared module variables 17 INTEGER, PUBLIC, DIMENSION(12) :: & !: 18 nbiss = (/ 31, 29, 31, 30, 31, 30, & !: number of days per month 19 & 31, 31, 30, 31, 30, 31 /) , & ! (leap-year) 20 nobis = (/ 31, 28, 31, 30, 31, 30, & !: number of days per month 21 & 31, 31, 30, 31, 30, 31 /) ! (365 days a year) 22 23 REAL(wp), PUBLIC :: & !: 24 rpi = 3.141592653589793_wp , & !: pi 25 rad = 3.141592653589793_wp / 180._wp , & !: conversion from degre into radian 26 rsmall = 0.5 * EPSILON( 1. ) !: smallest real computer value 24 REAL(wp), PUBLIC :: rpi = 3.141592653589793_wp !: pi 25 REAL(wp), PUBLIC :: rad = 3.141592653589793_wp / 180._wp !: conversion from degre into radian 26 REAL(wp), PUBLIC :: rsmall = 0.5 * EPSILON( 1. ) !: smallest real computer value 27 27 28 28 REAL(wp), PUBLIC :: & !: … … 61 61 xlic = 300.33e+6_wp , & !: volumetric latent heat fusion of ice 62 62 xsn = 2.8e+6 , & !: latent heat of sublimation of snow 63 rhoic = 900._wp , & !: densityof sea ice (kg/m3)64 rhosn = 330._wp , & !: densityof snow (kg/m3)63 rhoic = 900._wp , & !: volumic mass of sea ice (kg/m3) 64 rhosn = 330._wp , & !: volumic mass of snow (kg/m3) 65 65 emic = 0.97_wp , & !: emissivity of snow or ice 66 66 sice = 6.0_wp , & !: salinity of ice (psu) … … 70 70 vkarmn = 0.4_wp , & !: von Karman constant 71 71 stefan = 5.67e-8_wp !: Stefan-Boltzmann constant 72 !!---------------------------------------------------------------------- 73 !! OPA 9.0 , LOCEAN-IPSL (2005) 74 !! $Id$ 75 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 76 !!---------------------------------------------------------------------- 72 73 !!---------------------------------------------------------------------- 74 !! OPA 9.0 , LOCEAN-IPSL (2006) 75 !! $Id$ 76 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 77 !!---------------------------------------------------------------------- 77 78 78 79 CONTAINS … … 83 84 !! 84 85 !! ** Purpose : Print model parameters and set and print the constants 85 !!86 !! ** Method : no87 !!88 !! History :89 !! ! 90-10 (C. Levy - G. Madec) Original code90 !! ! 91-11 (G. Madec)91 !! ! 91-12 (M. Imbard)92 !! 8.5 ! 02-08 (G. Madec, C. Ethe) F90, add ice constants93 86 !!---------------------------------------------------------------------- 94 !! * Local variables 95 CHARACTER (len=64) :: cform = "(A9, 3(A13, I7) )" 87 CHARACTER (len=64) :: cform = "(A12, 3(A13, I7) )" 96 88 !!---------------------------------------------------------------------- 97 89 … … 103 95 ! ---------------- 104 96 IF(lwp) THEN 105 WRITE(numout,*) ' parameter file' 106 WRITE(numout,*) 97 WRITE(numout,*) ' Domain info' 107 98 WRITE(numout,*) ' dimension of model' 108 WRITE(numout,*) ' Local domain Global domain Data domain ' 109 WRITE(numout,cform) ' ',' jpi : ', jpi, ' jpiglo : ', jpiglo, ' jpidta : ', jpidta 110 WRITE(numout,cform) ' ',' jpj : ', jpj, ' jpjglo : ', jpjglo, ' jpjdta : ', jpjdta 111 WRITE(numout,cform) ' ',' jpk : ', jpk, ' jpk : ', jpk , ' jpkdta : ', jpkdta 112 WRITE(numout,*) ' ',' jpij : ', jpij 113 WRITE(numout,*) 99 WRITE(numout,*) ' Local domain Global domain Data domain ' 100 WRITE(numout,cform) ' ',' jpi : ', jpi, ' jpiglo : ', jpiglo, ' jpidta : ', jpidta 101 WRITE(numout,cform) ' ',' jpj : ', jpj, ' jpjglo : ', jpjglo, ' jpjdta : ', jpjdta 102 WRITE(numout,cform) ' ',' jpk : ', jpk, ' jpk : ', jpk , ' jpkdta : ', jpkdta 103 WRITE(numout,*) ' ',' jpij : ', jpij 114 104 WRITE(numout,*) ' mpp local domain info (mpp)' 115 105 WRITE(numout,*) ' jpni : ', jpni, ' jpreci : ', jpreci 116 106 WRITE(numout,*) ' jpnj : ', jpnj, ' jprecj : ', jprecj 117 107 WRITE(numout,*) ' jpnij : ', jpnij 118 119 WRITE(numout,*)120 108 WRITE(numout,*) ' lateral domain boundary condition type : jperio = ', jperio 121 WRITE(numout,*) ' domain island (use in rigid-lid case) : jpisl = ', jpisl 122 WRITE(numout,*) ' jpnisl = ', jpnisl 109 WRITE(numout,*) ' domain island (use in rigid-lid case) : jpisl = ', jpisl, ' jpnisl = ', jpnisl 123 110 ENDIF 124 111 … … 126 113 ! ---------------- 127 114 IF(lwp) WRITE(numout,*) 128 IF(lwp) WRITE(numout,*) ' constants'115 IF(lwp) WRITE(numout,*) ' Constants' 129 116 130 117 IF(lwp) WRITE(numout,*) -
trunk/NEMO/OPA_SRC/step.F90
r699 r703 4 4 !! Time-stepping : manager of the ocean, tracer and ice time stepping 5 5 !!====================================================================== 6 !! History : ! 91-03 () Original code 7 !! ! 91-11 (G. Madec) 6 !! History : ! 91-03 (G. Madec) Original code 8 7 !! ! 92-06 (M. Imbard) add a first output record 9 8 !! ! 96-04 (G. Madec) introduction of dynspg … … 20 19 !! " " ! 06-01 (L. Debreu, C. Mazauric) Agrif implementation 21 20 !! " " ! 06-07 (S. Masson) restart using iom 21 !! " " ! 06-08 (G. Madec) surface module 22 !!---------------------------------------------------------------------- 23 22 24 !!---------------------------------------------------------------------- 23 25 !! stp : OPA system time-stepping … … 30 32 USE cpl_oce ! coupled ocean-atmosphere variables 31 33 USE in_out_manager ! I/O manager 32 USE iom 34 USE iom ! 33 35 USE lbclnk 34 36 … … 37 39 USE dtatem ! ocean temperature data (dta_tem routine) 38 40 USE dtasal ! ocean salinity data (dta_sal routine) 39 USE dtasst ! ocean sea surface temperature (dta_sst routine) 40 USE dtasss ! ocean sea surface salinity (dta_sss routine) 41 USE taumod ! surface stress (tau routine) 42 USE flxmod ! thermohaline fluxes (flx routine) 43 USE ocesbc ! thermohaline fluxes (oce_sbc routine) 44 USE flxrnf ! runoffs (flx_rnf routine) 45 USE flxfwb ! freshwater budget correction (flx_fwb routine) 46 USE closea ! closed sea freshwater budget (flx_clo routine) 41 USE sbcmod ! surface boundary condition (sbc routine) 42 USE sbcrnf ! surface boundary condition: runoff variables 47 43 USE ocfzpt ! surface ocean freezing point (oc_fz_pt routine) 48 44 … … 161 157 !! -8- Outputs and diagnostics 162 158 !!---------------------------------------------------------------------- 163 !! * Arguments164 159 #if defined key_agrif 165 INTEGER ::kstp ! ocean time-step index160 INTEGER :: kstp ! ocean time-step index 166 161 #else 167 INTEGER, INTENT( in ) ::kstp ! ocean time-step index162 INTEGER, INTENT(in) :: kstp ! ocean time-step index 168 163 #endif 169 170 !! * local declarations 164 INTEGER :: jk ! dummy loop indice 171 165 INTEGER :: indic ! error indicator if < 0 172 166 !! --------------------------------------------------------------------- … … 179 173 indic = 1 ! reset to no error condition 180 174 175 !!gm: attention n'est plus ds le step de gm 181 176 adatrj = adatrj + rdt/86400._wp 177 !!gm: attention n'est plus ds le step de gm 182 178 183 179 CALL day( kstp ) ! Calendar … … 186 182 187 183 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 188 ! Update data, open boundaries and Forcings184 ! Update data, open boundaries, surface boundary condition (including sea-ice) 189 185 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 190 186 191 187 IF( lk_dtatem ) CALL dta_tem( kstp ) ! update 3D temperature data 192 193 IF( lk_dtasal ) CALL dta_sal( kstp ) ! Salinity data 194 195 IF( lk_dtasst ) CALL dta_sst( kstp ) ! Sea Surface Temperature data 196 197 IF( lk_dtasss ) CALL dta_sss( kstp ) ! Sea Surface Salinity data 188 IF( lk_dtasal ) CALL dta_sal( kstp ) ! update 3D salinity data 189 190 CALL sbc ( kstp ) ! Sea Boundary Condition (including sea-ice) 198 191 199 192 IF( lk_obc ) CALL obc_dta( kstp ) ! update dynamic and tracer data at open boundaries 200 201 193 IF( lk_obc ) CALL obc_rad( kstp ) ! compute phase velocities at open boundaries 202 194 203 IF( .NOT. lk_core ) CALL tau( kstp ) ! wind stress 204 205 CALL flx_rnf( kstp ) ! runoff data 206 207 CALL flx( kstp ) ! heat and freshwater fluxes 208 209 IF( lk_ice_lim ) CALL ice_stp( kstp ) ! sea-ice model (Update stress & fluxes) 210 211 CALL oce_sbc( kstp ) ! ocean surface boudaries 212 213 IF( ln_fwb ) CALL flx_fwb( kstp ) ! freshwater budget 214 215 IF( nclosea == 1 ) CALL flx_clo( kstp ) ! closed sea in the domain (update freshwater fluxes) 216 217 IF( kstp == nit000 ) THEN 218 IF( ninist == 1 ) THEN ! Output the initial state and forcings 219 CALL dia_wri_state( 'output.init' ) 220 ENDIF 221 ENDIF 222 223 IF(ln_ctl) THEN ! print mean trends (used for debugging) 224 CALL prt_ctl(tab2d_1=emp , clinfo1=' emp - : ', mask1=tmask, ovlap=1) 225 CALL prt_ctl(tab2d_1=emps , clinfo1=' emps - : ', mask1=tmask, ovlap=1) 226 CALL prt_ctl(tab2d_1=qt , clinfo1=' qt - : ', mask1=tmask, ovlap=1) 227 CALL prt_ctl(tab2d_1=qsr , clinfo1=' qsr - : ', mask1=tmask, ovlap=1) 228 CALL prt_ctl(tab2d_1=runoff , clinfo1=' runoff : ', mask1=tmask, ovlap=1) 229 CALL prt_ctl(tab3d_1=tmask , clinfo1=' tmask : ', mask1=tmask, ovlap=1, kdim=jpk) 230 CALL prt_ctl(tab3d_1=tn , clinfo1=' sst - : ', mask1=tmask, ovlap=1, kdim=1) 231 CALL prt_ctl(tab3d_1=sn , clinfo1=' sss - : ', mask1=tmask, ovlap=1, kdim=1) 232 CALL prt_ctl(tab2d_1=taux , clinfo1=' tau - x : ', mask1=umask, & 233 & tab2d_2=tauy , clinfo2=' - y : ', mask2=vmask,ovlap=1) 195 IF( ninist == 1 ) THEN ! Output the initial state and forcings 196 CALL dia_wri_state( 'output.init' ) 197 ninist = 0 234 198 ENDIF 235 199 … … 244 208 !----------------------------------------------------------------------- 245 209 246 CALL bn2( tb, sb, rn2 ) ! before Brunt-Vaisala frequency210 CALL bn2( tb, sb, rn2 ) ! before Brunt-Vaisala frequency 247 211 248 212 ! ! Vertical eddy viscosity and diffusivity coefficients … … 261 225 ENDIF 262 226 263 IF( cp_cfg == "orca" ) THEN ! ORCA: Reduce vertical mixing in some specific areas 264 SELECT CASE ( jp_cfg ) 265 CASE ( 05 ) ! ORCA R2 configuration 266 avt (:,:,2) = avt (:,:,2) + 1.e-3 * upsrnfh(:,:) ! increase diffusivity of rivers mouths 267 CASE ( 025 ) ! ORCA R025 configuration 268 avt (:,:,2) = avt (:,:,2) + 2.e-3 * upsrnfh(:,:) ! increase diffusivity of rivers mouths 269 END SELECT 227 IF( nn_runoff /=0 ) THEN ! increase diffusivity at rivers mouths 228 DO jk = 2, nkrnf ; avt(:,:,jk) = avt(:,:,jk) + rn_avt_rnf * rnfmsk(:,:) ; END DO 270 229 ENDIF 271 230 272 231 IF( ln_zdfevd ) CALL zdf_evd( kstp ) ! enhanced vertical eddy diffusivity 273 232 274 IF( lk_zdfddm .AND. .NOT. lk_zdfkpp ) &233 IF( lk_zdfddm .AND. .NOT. lk_zdfkpp ) & 275 234 & CALL zdf_ddm( kstp ) ! double diffusive mixing 276 235 … … 285 244 ! N.B. ua, va, ta, sa arrays are used as workspace in this section 286 245 !----------------------------------------------------------------------- 287 288 246 IF( lk_ldfslp ) CALL ldf_slp( kstp, rhd, rn2 ) ! before slope of the lateral mixing 289 290 247 #if defined key_traldf_c2d 291 248 IF( lk_traldf_eiv ) CALL ldf_eiv( kstp ) ! eddy induced velocity coefficient 292 249 #endif 293 250 294 295 251 #if defined key_passivetrc 296 252 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> … … 299 255 ! N.B. ua, va, ta, sa arrays are used as workspace in this section 300 256 !----------------------------------------------------------------------- 301 302 257 CALL trc_stp( kstp, indic ) ! time-stepping 303 304 #endif 305 258 #endif 306 259 307 260 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> … … 310 263 ! N.B. ua, va arrays are used as workspace in this section 311 264 !----------------------------------------------------------------------- 312 313 265 ta(:,:,:) = 0.e0 ! set tracer trends to zero 314 266 sa(:,:,:) = 0.e0 315 267 316 268 CALL tra_sbc ( kstp ) ! surface boundary condition 317 318 269 IF( ln_traqsr ) CALL tra_qsr ( kstp ) ! penetrative solar radiation qsr 319 320 270 IF( lk_trabbc ) CALL tra_bbc ( kstp ) ! bottom heat flux 321 322 271 IF( lk_trabbl_dif ) CALL tra_bbl_dif( kstp ) ! diffusive bottom boundary layer scheme 323 272 IF( lk_trabbl_adv ) CALL tra_bbl_adv( kstp ) ! advective (and/or diffusive) bottom boundary layer scheme 324 325 273 IF( lk_tradmp ) CALL tra_dmp ( kstp ) ! internal damping trends 326 327 274 CALL tra_adv ( kstp ) ! horizontal & vertical advection 328 329 275 IF( n_cla == 1 ) CALL tra_cla ( kstp ) ! Cross Land Advection (Update Hor. advection) 330 331 276 IF( lk_zdfkpp ) CALL tra_kpp ( kstp ) ! KPP non-local tracer fluxes 332 333 277 CALL tra_ldf ( kstp ) ! lateral mixing 334 278 #if defined key_agrif … … 336 280 #endif 337 281 CALL tra_zdf ( kstp ) ! vertical mixing 338 339 282 CALL tra_nxt( kstp ) ! tracer fields at next time step 340 341 283 IF( ln_zdfnpc ) CALL tra_npc( kstp ) ! update the new (t,s) fields by non 342 284 ! ! penetrative convective adjustment … … 359 301 ! N.B. ta, sa arrays are used as workspace in this section 360 302 !----------------------------------------------------------------------- 361 362 363 303 ua(:,:,:) = 0.e0 ! set dynamics trends to zero 364 304 va(:,:,:) = 0.e0 365 305 366 306 CALL dyn_adv( kstp ) ! advection (vector or flux form) 367 368 307 CALL dyn_vor( kstp ) ! vorticity term including Coriolis 369 370 308 CALL dyn_ldf( kstp ) ! lateral mixing 371 309 #if defined key_agrif … … 373 311 #endif 374 312 CALL dyn_hpg( kstp ) ! horizontal gradient of Hydrostatic pressure 375 376 313 CALL dyn_zdf( kstp ) ! vertical diffusion 377 378 314 IF( lk_dynspg_rl ) THEN 379 315 IF( lk_obc ) CALL obc_spg( kstp ) ! surface pressure gradient at open boundaries 380 316 ENDIF 381 indic=0 382 !i bug lbc sur emp 383 CALL lbc_lnk( emp, 'T', 1. ) 384 !i 317 indic=0 385 318 CALL dyn_spg( kstp, indic ) ! surface pressure gradient 386 387 319 CALL dyn_nxt( kstp ) ! lateral velocity at next time step 388 389 320 IF( lk_vvl ) CALL dom_vvl ! vertical mesh at next time step 390 321 … … 395 326 ! N.B. ua, va, ta, sa arrays are used as workspace in this section 396 327 !----------------------------------------------------------------------- 397 398 328 CALL oc_fz_pt ! ocean surface freezing temperature 399 400 329 CALL div_cur( kstp ) ! Horizontal divergence & Relative vorticity 401 402 330 IF( n_cla == 1 ) CALL div_cla( kstp ) ! Cross Land Advection (Update Hor. divergence) 403 404 331 CALL wzv( kstp ) ! Vertical velocity 405 332 406 407 408 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 409 ! Control, and restarts 410 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 411 ! N.B. ua, va, ta, sa arrays are used as workspace in this section 412 !----------------------------------------------------------------------- 413 ! ! Time loop: control and print 333 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 334 ! Control and restarts 335 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 414 336 CALL stp_ctl( kstp, indic ) 415 337 IF( indic < 0 ) CALL ctl_stop( 'step: indic < 0' ) 416 417 338 IF( kstp == nit000 ) CALL iom_close( numror ) ! close input ocean restart file 418 339 IF( lrst_oce ) CALL rst_write ( kstp ) ! write output ocean restart file … … 425 346 !----------------------------------------------------------------------- 426 347 427 IF ( nstop == 0 ) THEN ! Diagnostics348 IF( nstop == 0 ) THEN ! Diagnostics: 428 349 IF( lk_floats ) CALL flo_stp( kstp ) ! drifting Floats 429 350 IF( lk_trddyn ) CALL trd_dwr( kstp ) ! trends: dynamics … … 437 358 IF( lk_diafwb ) CALL dia_fwb( kstp ) ! Fresh water budget diagnostics 438 359 IF( ln_diaptr ) CALL dia_ptr( kstp ) ! Poleward TRansports diagnostics 439 440 ! ! Outputs 441 CALL dia_wri ( kstp, indic ) ! ocean model: outputs 360 ! ! outputs 361 CALL dia_wri( kstp, indic ) ! ocean model: outputs 442 362 ENDIF 443 363
Note: See TracChangeset
for help on using the changeset viewer.